perm filename E[CSP,SYS] blob
sn#877351 filedate 1989-09-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00386 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00060 00002 FTF2 FTCCRMA FTRP07 DDLOSS FTGSPL DATOK TMPMRK FTHID FTBUF FTMACL FTUNHID DECSW DATOK MSGPPN MAISYS DOCPPN ERRPPN RMDSYS MSGPPN MAISYS DOCPPN ERRPPN IRCSW PHUSET GARBIT PHUSET GARBIT RAQBIT RAQMOD NCACHE NBUFS NBUFS
C00066 00003 Recent history of changes to E
C00098 00004 Documentation. How to put up a new E.
C00120 00005 Dispatch tables listed
C00122 00006 F A B C D E G H I DSP J K Q T TT P COPNUM SRSIZ LPDL DPYBSZ MAXARG NBLOAT MAINTMODE TTYLOK DSKI DSKO SWP DSKSP DSKCH RPGO DSKM ... TXTPOG CRSPOG SEAPOG ARRPOG RAIPOG CT1 CTMT3 EXT1 DATE2 PPN3
C00126 00007 REDNLY COPY DIROK UPDTXT WRITE EOF EDDIR ARG DSPSCR DSPALL FILLUZ REL NEG EDITM EDBRK XPAGE UPDIR ATTMOD ENTRD CLRBF NOSHUF NOCHK OFFEND NULLIN DSPLIN TF1 PMLIN OKF TF2 TF3 DSPTRL LINSM FSCHKF NGPUSE SELFGS
C00130 00008 Char table flags, command dispatch flags, misc flags and values NSPEC FSPC LSPC NUMF DSPC LETF LT2F SSP1 SSP2 EDOK NOEDIT DOEDIT RE.ED NOATT NORDO SACMD SSCMD MSGCMD RDONEG RDOZER RDODIR DIRREC DIRFLG DIRWIN LPDESC DPBIT D1BIT RPMASK RPBYTE DIRXTR EDCHRL EDWRDL TXTCNT TXTFLG TXTSER TXTWIN LLDESC PMARK ARRBIT WINBIT PMLINK PMSIZE PMRCNT PMRBTS PMRPOS PMCCNT PMCBTS PMCPOS PMLNBR PMXTRA PMSIZE PMRCNT PMRBTS PMRPOS PMLNBR PMCCNT PMCBTS PMCPOS PMXTRA LOKBIT FRDPAR FRDNAM FRDEXT FRDPRJ FRDPRG FRDDEV FRDGRT FRDDOT FRDADD FRDTMP FRDRUN FRDALL FRDAL2
C00142 00009 Bits for GETLIN, SETACT, DEVCHR. S 136 and S 137 code. DD DM III PTY SPCACT SUPCCR EMODE BSACT ALLACT SUPERS SUPEOL SUPLFE DVDSK DVUDP MININT ADRSIZ CAN BLINK ZZ SAVOK ESTART ESTERR SORRY FATAL SORRX SORRJ SORRF
C00149 00010 GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
C00154 00011 BEG BEGSYS BEGACT BEGRPT BEGRP2 BEGDBG
C00158 00012 BEGRPG RPGACS RPGPPN RPGEXT RPGFIL RPGLIN RPGPAG
C00161 00013 BEG0 BEG0A BEG1 BEGSY2 BEGSY3 BEGS3A BEGSY4 BEG1A BEG2A BEG2 FNERR FLOSE FNERR0 BEGBKP BEGSY1 BEGSY5 TYEDFL
C00174 00014 BEG3 BEG4 BEG4B BEG4A NOXDIR BEG6 BEG5A BEG5 DPYOK
C00184 00015 MAIN MAIN1 MAIN2 MAINRT FNF FNF00 FNFYES FNFHUH FNF0A FNF0C FNF0B FNF0 FNF1 FNF2
C00193 00016 CMDIN CMDEX CMDEXS CMDLU2 CMDEDR XCMDX CMDX CMDX3 CMDX2 CMDLUP ILLATT ILLAT1
C00199 00017 CMDEDX CMDED CMDRD0 CMDRD CMRTR3 CMRTRY CMRTR2 MINUS PLUS NUMS INFIN ALTSET CONTRO METACO CHARAC CHARER
C00207 00018 CMDERR ERR ERR0 PPJ1CR CPOPJ1 POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLDI1 ILLDI2 ILFLUZ ILLBK ILLMES ILLMS2 PRDOT1 ERRX PRNTCH PRNTC3 PRNTC4 PRNTC2
C00210 00019 INIT INIT0 REDATE INI1 NOTPUR WININI SWINBR WINFST RWINBR UPSEGE INIT1 INIT1A
C00225 00020 main command dispatch table CRDSP FFDSP CMDSP CMFLAG CMDSP
C00236 00021 XCMDS XDISP MCMDS MDISP
C00243 00022 EXTEND EXTEN1 EXTEN2 EXTL3 GETWRD EXTL0 EXTL0A EXTL EXTL1 EXTLK0 EXTLK EXACTM
C00248 00023 EXTAMX EXTNF EXTNF0 EXTNF2 EXTAM3 FIXEXT ENDEXT EXTNU0 EXTNUL MACABT XTDACT XTDLIN XTDLI2 XTDLMT XTDBEG XTDEND SPLJOB SPLEXT SPLNAM EXTBUF EXTBFE
C00258 00024 READON ROSET READWR NORDOW NORDWR NORDW2 THISPA THISP2 CANCEL DPYALW DPYSKI DPYALW DPYSKI
C00263 00025 DDTLUZ WRTABL DDTDDT DDTGO DDTOK DDTRET DRAW0 DRAW DRAWXL DRAWX DRAWM LINCNT LINCN4 LINCN3 LINCN2 LINCN5 TRAILE HEADER HEADE2
C00272 00026 NOEXIT GETOUT GETOU2 GETOU0 GETOU1 REOLUZ REWLUZ FINISH FINI1 FINI3 FINI01 FINI0 FINI02 FINI5 FINI6 FINI7 FINI8 FINNDL FINI4 FINI2 GORPG GODRD GORPG2 CLSFIN CLSFI2 QUIT1 CLOSIT CLOSDO REOPEN REOPE2
C00288 00027 NEWPAG NEWPG0 NEWPG7 NEWPG6 NEWPG1 PGINIT PGERR1 PGERR2 PGERR NEWPG2 NEWPG5 NEWPG3 NEWPG8 NEWPG4
C00295 00028 VERTAB VERTB2 FORMF FORMF2 FINSRT UNWIND WIND0B VERTB3 WIND WIND0 WIND0A WIND1
C00299 00029 LT GT LTE GTE TOP TOP1 BOT BOT1 MIDDLE
C00303 00030 JMPGL JMP JMP0 JMPJMP JMP1 JMP2 JMP2A CHKMOV CHKMV2 CHKMV3 UPARR DWNARR EDTEND SEMICO COLON COLON2 COLON3 COLON4
C00310 00031 NMARKS XXPAGE XXLINE XMARK XMAROO XCOUNT XXNONE XXNON2 XXNON1 XTHERE XNOTF
C00313 00032 XMARK1 XMARK3 XMARK2 XMOVE XMOVE5 XBACK XBACK1 ZMARKS XWRITE XWRIT0
C00318 00033 XDEL0 XDEL0B XDELET XDEL0A XDEL4 XMARK0 XMARKA XMARKB XMARKC XXADD XXSUB
C00322 00034 XLALL XLALL1 XLALL2 XLALL3 XPADD XPADD1 XPADD3 XPSUB XPSUB1
C00326 00035 DELLIN DELLI2 DELPOS
C00328 00036 DELLP DELPR DELPR1 DELPR2 DELL2 DELDSP
C00335 00037 DELPM DELPMA DELPM1 DELPM2 DELPM3
C00340 00038 DELPAG DELPG1 DELPG2 DELPG3 ADJPG ADJPG3 ADJPG2 ADJPGL
C00346 00039 RCOMP RCOMP1 RCOMP2 RCOMPX
C00349 00040 DELETE DELETB DELETC DELET1 DELET2 DELET3 ADDPAG
C00353 00041 APPEND APPEN1 APPEN0 APPLUZ POPUP1
C00357 00042 APPEN2 APPFIN PMTXT PMPAG LPMTXT
C00359 00043 INSERT
C00362 00044 INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
C00367 00045 INSER8 DIRADD DIRAD0 DIRAD1
C00374 00046 INSER6 INSER7 MARK MARK2 MARK3 MARK4
C00377 00047 CONTQ
C00384 00048 ATTACH ATTCH1 ARGCHK ARGCHN
C00386 00049 ATTDO ATTDO0 ATTOK ATTDO3 ATTDO2 ATTDO1 ATTCHK
C00389 00050 ATTREP ATTRE3 ATTRE4 ATTEX0 ATTEX2 ATTCHP ATTRE5 ATTEX
C00396 00051 ATTKIL ATTKAL ATTKL2 ATTKL ATTUPD ATTSRC GPAGL GPAGL0 GPAGL1 GPAGL2 GPAGL3 GPAGL4 ATTWRT
C00401 00052 ATTCOP CHECKA ATTCPP ATTCP1 ATTCP4 ATTCP
C00408 00053 ATTCP0 ATTCPL ATCMOR ATTCP2 ATTCP3
C00411 00054 LETEST EDIT EDIT1 LINED LINL1 EDDSP EDALT EDARG EDARGX
C00415 00055 EDFULL EDFUL2 EDTAB EDNUL EDCR AGAIN0 AGAIN EDRP0
C00419 00056 EDGL MACLEX TTYPTX EDGL2 EDGL2B EDGL2A EDGSET
C00424 00057 EDGL3 EDGL3A EDGL4 REEDIT REEDT2 EDTMR2 EDTMOR REEDT3 EDGL5 EDCERR EDTMR3 EDLF EDTAB2 ALTFIX ALTCHK EDGDSP INCHA2 INCHAR PT79 PTPNT
C00433 00058 EDCR2 EDLF2 EDACT EDACT4 EDACT5 EDACT3 EDACT6 EDACT2 EDACT1 EDITIT FNEDIT UNINS UNINS2 FNEDT0 POPBCJ REPLIN PUTBAK
C00440 00059 EDPLUZ EDPUT EDPLR
C00443 00060 EDPS0 EDPS EDPL EDPL1 EDPL2 EDPNUL EDPCOP TTTBAJ
C00447 00061 PREVED PREVER
C00449 00062 CRDSP REGCR REGCR1 REGCR2
C00451 00063 CONTCR CNTCR2 METAC2 METAC3 METACR REPRST REPRS2
C00454 00064 LECR DUBLI DUBLCE DUBLCR DBLTB2 DBLTAB DBLTTY DUBCR6 DUBCR1 DUBCR5 DUBCR3
C00460 00065 INSONA INSONE INSNUL INSNLP
C00463 00066 LINSDO LININS LININ LININ4 LININ5 LININ3 LININ2 LINSUB LININ1 LININ0 DOINS AUTOWR AUTOW2 AUTOW3
C00469 00067 PPSET IPPSET DPPSET CMDCRL ABCRLF ABCRL3 ABCRL2 ABCRL0
C00472 00068 OCT3ST NUMSTD NUMSTR OCTSTR NUMSIX
C00474 00069 IDIOT IDIOT0 IDIOTX IDIOT2 SETWRT SETWR0 SETWR2 SETWRX CLEARX CLERX0 BTAB
C00479 00070 FRD FRD0B FRD0 FRD0A FRD0CR FRDHOM SETDEV FRD2 FRD2A FRD1 NOEXT NOEXT2 NOPRG NOPPN NOPP1 FLHAK9 FRDQR2 NOPP2 SWLOP SWLOP2 FRDX FRDX2 FRDX3 FRDX4 FRDMOR FRDMO2 FRDMOK FRDMLZ NPFRDM
C00490 00071 SWIT1 NOSWIT SWITL FRDQRY FRDMSG FRDMS2 FLHACK HAKPRG DECMSG FLHAKE FLHAKB FLHAKA FLHAK0 FLHAK1 FLHAK5 FLHAK2
C00497 00072 SIXOUT SIXOU1 $MAIL $DAY $GRIPE $GOLD $BBD $MAINT $NOTIC $NAP $PLAN $DIGES $FORW $NEWS $CSD $AUDIO $HARDW HAKTAB HAKLEN HAKDSP
C00500 00073 GETNAM GETNML GETP GETPL DTYI1 DTYIS DTYI DTYI2
C00503 00074 DOSWIT SWABRT DOSWI2 SAMPLC SAMPL2 DOSMRK NTYI NTYIL NTYINF NTYIM NTYICM EDFIL2 SRCFIL DSTFIL NOT1PG
C00512 00075 RSCAN RSCAN0 RSCN0A RSCAN1 RSCAN2 RSCANX RSCAN3 RSCN4D RSCAN4 RSCN4B RSCN4C RSCN4A
C00517 00076 RSCAN5 RSCAN6 RSCAN7 RSCAN8 SYSCCK CRECHK
C00520 00077 RSTYI RSTYI0 RSTYI1 UCASE TYI4 POPUP TYICHK TYI5 TYI1 TYI3 TYI6 TYI7 POPCJ CTYI1 CTYI2 CSTYIM CSTYI1
C00524 00078 TYI TYIT TYIU GTYI GTYI1 SKIPIN SKPSUB skipil SKIPI2
C00529 00079 TMPRED TMPRDY TMPRD1 TMPRD2 TMPRDX RPGRED RPGRD1 BKPRED BKPRD0 BKPLKP BKPRD2 BKPRD1
C00535 00080 TMPNFL TMPCR TMPWRT TMPCR2 TMPBKL TMPNOP TMPFLL TMPFOL TMPNFO TMPNHM TMPPGL TMPLMK TMPEND BKPWRT BKPWR1 BKPWR2
C00545 00081 FILERR FILTYP FILSTR FILST3 DEVTYO FILST4 DEVPPN PPNTYP PPNTY2 FILETB NFLERS
C00549 00082 MACTYO SIXTYO SIXTYL SIXTY2 SIXTYN SIXTNL SIXTNN PNTYO PNTYOL PNTOO PNTOOC PNTOOL PPNTST PPNTYO PRGSXT PPNOTY PRGOTY PRGTYO
C00552 00083 UUOH UUODSP UFCE UTYPCH UTYPC2 UTYPDE UTYPOC
C00553 00084 UTYPR UTYPR0 UTYPR1 UTYPRT UTYPSI UTYPMA USORRF USORRY USORR2 USHORT USHOR2 USHOR3 USORRX USORRJ USORR0 USORR1 POPTJ1 USORRQ
C00558 00085 TELL0 TELL1 TELL2 TELL3 TELL4 TELL5 TELL6 TELL7 TELL8 TELL9 TELLD TELLZ TELLO NOCORE SAVHIM TELLX UFATAL UFATAX PANIC TELLX2 TELLX3
C00563 00086 SETCHN OPENI OPNOI IOPEN SETI SETI2 SETRLD SETI1 SETI0 %OPEN %RELS %LKUP %IN %SETI %STAT %CSTAT %MTAPE %MTAP2 %BSETI %BIN %OFFS %OFFG %%OFFS %%OFFG HIDDEN OPNBLK IBFPNT LKUP OPNDEV OPNDOK OPNDL4 OPNDL3 OPNDL2 OPNDL1 OPNDL0 OPNDLZ RELDEV OPNLUZ DECLKP DECLK1 DECLK2 DECLK6 DECLK7 DECLK8 DECLK9 DECLKB
C00575 00087 RLD RLD1 RLD2 RLDX RLDLUZ FIXEOF FIXEF1 ENTLUZ ENTL2
C00581 00088 EXTCHK EXTCHG EXTCH0 EXTCH1 EXTCH2 EXTRE2 EXTCH3 EXTRED EXTGRT EXTGRD EXTGR3 EXTGR2 EXTCH4 EXTTAB DEXTAB DOCS DOCS1 NDOCS GETDOC GETDO2 GETDO8 GETDO3 GETDO9 GETDOE GETDO4 GETDO5 GETDO7 GETDO6 EXTOPN CHKGRT GETGRX GETGRT INCG01 INCG02 INCGR1 INCGR2 INCGR3 INCGRX
C00599 00089 OPENIT OPENI2 OPENC OPENI2 OPENWE OPENW OPENO OPENC2 OPENO2 CLOBUF SETO FPAUSE PAUSE PAUS2 BYE WHOREA WHOREF WHORE0 WHORE2 WHORE3 WHLOOO WHLOOP WHOEND ESCOCT ESCOC2
C00609 00090 CLOSO2 CLOSO WRBUF WRBF1 WRBF2 WRBF3 ENTR OBUF IBUF IBFE WHOBLK JOBLST
C00612 00091 TSINT INTLUZ INTDSP MAXINT INTTTI INTTTC INTTTY INTMAI INTPTO TSNINT TSNESC TSNES2 TSNES4 TSNES3 TSINT3 TSINT2
C00617 00092 JBICNI JBITPC JBIAPR ESCIEN ESCI2 IFND IFND1 IFND2 IFND3 PDLOV TRYPSH PDLUNK PDLOV2 ISAV
C00620 00093 FSINI FSINI1 MORCOR POPCO2 MORCXT POPCOR INTPOV INTERR INTX2 INTX
C00625 00094 FSUSED FSGET FSLUP0 FSLUP FSGRAB FSXIT
C00628 00095 FSNEWT FSNEWP FSNEW
C00630 00096 FSTSML FSNEXT FSHRET FSLLUZ
C00633 00097 FSLSCN FSLSCL FSLFR FSLSHF FSLSLP FSLMOV FSLDON
C00641 00098 FSHSCN FSHSCL FSHSC2 FSHFR FSHSHF FSHSLP FSHSR FSHSX FSHMOV
C00644 00099 FSBLT POPTJ FSBLT1
C00646 00100 FSBLT2 FSBLT3 FSHBLT FSHBL2
C00648 00101 PNTREL SHFTB MXSHF STDSH1 STDSHF DELSHF LSTSHF LSTSH1 RELOC RELOCL
C00651 00102 FSGIVE FSGIV0 FSGIV1 FSGIV2 FSTEXT FSGIVL DELSMX UNDELE UNDERR UNDEL0 UNDELL UNDTEL UNDSET UNDSE2
C00660 00103 CORCHK CORCH2 CRUNCH CMPACT
C00663 00104 ENDSET ENDSE2 ENDFIX
C00665 00105 FSCHK FSCHK1 FCLUP1 FCLUP2 FCFR FCDON
C00667 00106 FUCHK MOVIT MOVTX
C00673 00107 PURINI PLCHK PL2CHK PLCHKL PLSCN0 PLSCN PLSCN1 PLSCN2 PLSCN3
C00675 00108 PURCHK PURCH1 PURCH2 PURCH3
C00677 00109 PURCH4 PURCH5 PURCH6 PURCH7 PURCLC TYPHW TYPHW2 PURCK PLCHK1 PLCHK2 PURFLG BPTINS LOGFIL SAVFIL
C00679 00110 CHECK CHECK1 CHECK2
C00680 00111 CHKDIR CHKDPL CDDSP
C00682 00112 CHKDR1 CHKDR2 CHKDR3 CHKDR4 CHKD4A
C00686 00113 CHKLST CHKFSL CHKFS2 CHKPNT CHKPN2
C00688 00114 CHKPAG CHKPGP
C00689 00115 CHKPG1 CHKPG2 CPDSP CHKPGT CHKPTL
C00691 00116 CHKPG3 CHKPG4 CHKPG5 CHKPG6
C00694 00117 CHKATT CHKNAT SHFMOD CHKMOD
C00695 00118 CTAB 0-37
C00699 00119 CTAB 40-77
C00701 00120 CTAB 100-137
C00703 00121 CTAB 140-177
C00705 00122 GETDIR DIRSOS DIRSO2
C00708 00123 DIRCL2 DIRCL DIRCL1 GETD1A
C00711 00124 DIRLIN DIRLN0 DIRLN2 DIRLUP DIRLF FINDI0 FINDIR FINDI2 FINDI3 NOBLOA XDIRNX XDIRLN XDIRIL XDRDSP XDCRLF XDCRL2 XDIRFF XDIRF1 DIRLF1 DIRLF2 GDIRX
C00724 00125 BLTDIR BLTDER BLTDE2 BLTDE3 IGNDIR UGHDIR SHTDIR LOSDIR BADDIR BADDI2 BADDI3 DIRFLS DIR1PG DIR1P3 DIR1P2 DIR1PL DIR1P4 DIR1P5 BADDI4 DELDIR NODIR PRORED
C00734 00126 FLSDIR FLSDI2 DIRNUM GDDSP LSKP1 LSKP2A LSKP2 DIRSHF
C00737 00127 COPFIL COPFL0 COPDO COPYX COPDAT COPLUP COPDA3
C00740 00128 COPCOR COPCHK COPCH2 ENTLUN YESCHK YESCH0 YESCH2 COPCMD COPCM2
C00743 00129 FORMAT FORASK FORMT4 HOWRED FORMT5 FORMT6 FMTOK FMTOK2 FMTDSP FLDISK FLDIS2
C00750 00130 NEWDIR NEWDLP SKPDSP NEWDFF OPUT OSET
C00752 00131 MAKDIR MAKDR0 MAKDR1 MAKDOL MDOL1
C00755 00132 MDIL1 MDIL1A MDIL2 MDIL2A MDCSRC MDCSR1 MD1DSP
C00758 00133 MDIL1B MAKDFF MAKDLF MDFF1 MDFF4 MDFF2 MDFF3 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCKX RLDCK2 RLDCK3
C00765 00134 MD1CR MD2CR MD3CR MD4CR0 MD3CR0 MD3CR1 MDIL3 MD4CR MD5CR MDLFCK MDCRCK MDFIX MDFIXE
C00770 00135 CREATE CREAT2 CTEXT LCTEXT CREGRT
C00773 00136 RDSPA2 RDSPA4 RDSPA5 RDPAGE RDPGSV RDPGOK RDSPAG RDPAG0
C00777 00137 RDPAG2 PSEUDO RDPAG1 RDLINE RDLIN2 RDLLP RDLTAB TELLD1 TELLDM LOOKON
C00781 00138 RDLCR0 RDLCR RDLCR2 RDLLF RDLONG
C00783 00139 RDLFF RDLDON LINSE2 LINSET LINSE3 RDLFF2 RPDSP RPDSP2 RDLNUL
C00786 00140 RDPGLZ SOSTST SOSTS2 SOSCHK SOSCK2 PGMK PGMK2
C00789 00141 DIRCHK TELLD2 DIRCHM DIRNEW DIRNW2 DIRNW1 TXTSHF
C00794 00142 FNDPAG FNDLIN FNDLN1 FNDLN2 FNDLN3
C00797 00143 FNDPT1 FNDPT2
C00798 00144 DIRGET DIRGL DGEND DRGSET
C00801 00145 NUM5 NUM5A DIRHED DIRHD2 DIRTXT DIREMK VBUF DIRUNK DGDSP
C00803 00146 OUTDIR ODOLP OUTDLP ODPCNT ODDSP ODDON ODDON2 ODDONX ODEXP
C00807 00147 INSDIR INSD4 INSD5 IDDSP0 IDDSP IDTAB
C00810 00148 SCOMS SCOMS2 INSD1 DCLP1 DCLP1A DCLP2 DCNG INSDL
C00813 00149 IDTAB0 IDNUL IDDON IDDON0
C00816 00150 DIRSET DIRST1 DIRUP DIRUP1 DIRUP2 DIRUP3
C00819 00151 DIRFIX DIRFX1 DIRFX2 DIRFX3 DIRFX5 DIRFX4 DIRFXN
C00825 00152 MAXLIN PPMIN TXTMIN ATTMXM ATTMXD SCRTPD PPSIZD NTITLE XCESS NLINES MAXWID ATTMAD ATTMAX ATTMX2 PPSIZ WHOJOB WHOTIM DPYWID DPY DMLINE LINMAX DDCOLS ARRPOS ddcl0 AR2POS ddcl1 ARPOS2 ddcl2 ARRBUF IIICUR IIICU2 LIIICU LDDCUR
C00831 00153 FIRWRD DISPI WIPI DBLTI PCOMP P2COMP DDWAIT DISPAI DDISPI DCURI SRCDP4 SRCDP5
C00834 00154 LINECI DISPXA DISP1A DISP2I LEPREP LETST SPCOUT MASK DDFNCN SHFHDR DMLHDR BOTAPS BOTID BOTAR3 LBOTAP DPYHED DDACT DPYBUF DPYTAB DPYLOC DPYWIN DPYOLD DPYNEW BRKTAB
C00838 00155 (empty page)
C00839 00156 DUMSER DUMMY LDUMMY DUMDOT LDUMDO DUMSTR LDUMST DOTS LDOTS
C00841 00157 MTLINE LOADM0 LOADMT DPYINI DPYCHG DPYCHK DPYCH2 DDBOG
C00848 00158 DPYI6 DPYI7 DPYI9 DPYI9A DPYI8 NODPY DPYI2 DPYI3A DPYI3 DPYI5 DPYI5A DPYI4 WHOOFF WHOON WHOON2 GETTIM SEMODE SETSCR ATTSXT EXSETA EXSETB
C00863 00159 WIPE IWIPE DMWIPE WIPER WIPER2
C00867 00160 GOLINE GOLIN1 GOLIN3 GOLIN5 GOLIN4 GOLIN2 NMVAR1 NMVARR MOVARR SETARR
C00871 00161 GPGLS GPGLS3 GPGLS5 GPGLS2 GPGLS4 TRAILS TRAIL6 TRAIL7 TRAIL8 TRAIL9 SETWR4 SETWR5 TRAI11 SETWR6 SETWR7 TRAI10 DSTRL HEADS HEADS0 HEADS3 HEADS4 HEADS5 HEADS6 HEADSU HEADST POPCAJ GPGLS GPGLS3 GPGLS5 GPGLS2 GPGLS4 TRAILS TRAIL0 TRAIL6 TRAIL7 TRAIL8 TRAIL9 SETWR4 SETWR5 TRAI11 SETWR6 SETWR7 HEADS HEADS0 HEADS3 HEADS4 HEADS5 HEADS6 HEADSU HEADST POPCAJ
C00883 00162 GLUP GLDOWN POPWIN SETWIN WINCHK WINCH2 DWNWIN CENWIN REWIN
C00887 00163 DISP DISP0 DISP00 DISPT2 DISPT3 DISPTC PSHINI DISP1 DISP1B DISP2 DISP2A DISP2M
C00895 00164 DISP3 DISP4 DISP5 DISP5A DISP5B DISP5C EXTST EXCLR EXSET OWDISP SOWDSP OWDSPS OWDIS0 OWDIS1 OWDIS7 OWDIS6 OWDIS8 OWDIS9 OWDUP OWDWIN OWDDWN OWDIS2 OWDISN OWDBLA OWDIS5 OWDIS3 OWDIS4
C00911 00165 DISPAT DISPAX
C00915 00166 DDISPX DDSPX2 DDDONE DMDONE MDDISP MDDIS3 MDDIS4 MDDIS2 MDISPX MDSPX2 DMDON0 ALLCHG ALLCH0 ALLCH2 WIPI3 WIPL WIPL2
C00924 00167 DDCOP LINRL2 LINREL LINRLL IDISP IDISP4 IDISP2
C00929 00168 IIIARR IIIAR2 IIIAR3 GTRLIN GTRLI2 DMARRL CNTNUL CNTNU2 IDMTAB
C00936 00169 LESET LESET0 LESET2 LEADDM LEADJ LEADJ2 LECLR LECLR2
C00940 00170 DBLTC DBLT DBLT4 DBLT6 DBLT2 DBLT8 DBLT3 DBLT7 DBLT5 IDISPX IDISP9 DISPX PPBAJ2 PPBAJ1 PPCBAJ POPBAJ POPAJ
C00945 00171 PCOMPD PCOMPI PCOMPM PCOMPS P2CMPD P2CMPI P2CMPM PCMPID
C00947 00172 DDISP DMARR DDISP2 DDISP3
C00950 00173 DOARR DOAR2 OFFARR ONARR
C00953 00174 DDISPS DDSPS2 DDSPS3 DDSPSX DDSPS6 DDSPS7 DDSPS4 DDSPS5
C00959 00175 DSPSAT DSPSAX
C00961 00176 SHFT SHFTEL SHFTE2 SHFTE3 HDTRSV SHMNSV SHIFT DMSPS2 DMSPS3 DMSPSX SHIFT1 SHIFT2 SHIFT3 SHIFT7 SHIFT8 SHIFT4 SHIFT9 SHIF9B SHTEST SHTST1 SHTST2 SHIF12 SHIF13 SHIF11 SHIF14 SHIF10 SHIF17 SHIF21 SHIF18 SHIF19 SHIF20 SHIF22 SHIF23 SHIF24 SHIF26 SHIF27 SHIF28 SHIF29
C00986 00177 DELRWS ADDRWS PUTDMA PUTDM3 PUTDM2 POPBJ DMSPS4 DMPSAT DMPSAX DMBLTS DMBLT3 DMBLA
C00991 00178 DBLTS0 DBLTS DBLTS2 DBLTSN DBLTS3 DBLTS1 DBLTSA DBLTSB DBLTA DBLTA0 DBLTA2
C00996 00179 TDISP TDISP0 TDISPC TDISP1 TDISP7 TDISP2 TDISP3 TDISPE TDISPI
C00999 00180 TDISP4 TDISP6 TDISP5 TYPE TYPEL PRINT PRINTL TDLIN2 TDLINE NBRLIN
C01002 00181 WRPAGW WRPAGG WRPAGH WRPAGI WRPAGC WRPAG0 WRPAGD WRPAGB WRPGER WRPAGA WRPAGE WRPAG3 WRPAG2 WRPAG8 WRPAG5 WRPAG6 WRPAG7 SETUFG
C01014 00182 WRPXBP WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2
C01017 00183 WRPX3 WRPX3B WRPX4
C01025 00184 WRPOK WRTIT WRT0
C01027 00185 WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO4 WRRDO3 ABOR
C01031 00186 WRDSP WRTAB WRCHK WRDONE WRDON2 WRDON3
C01034 00187 WRPM BTAB2
C01036 00188 FLSPG0 FLSPAG FLSPGL FLSPG2 CLRWRT CLRWR2 DSHED
C01038 00189 FILWRD DEVWRD RSYS RUN RUN1 CHKFII CHKFIL GETRUN
C01043 00190 RUNILL RUNNON RUNFNF EXEFN2 RUNDEV RUNFIL
C01045 00191 SEARCH ROUTINES SDELIM SBKWDS OFFPAG SRCFLG SRCSIZ SRCBUF SUBFLG SUBSIZ SUBTYP SUBDEL SRFLG2 SUBBUF SUBDIF SFSNUM NOTOP INFOP OROP ANDOP BINOP ENDOP CROP CLOSOP ORCHR ANDCHR SGBBIT SGEBIT NLDBIT NOTBT XFRSAV INDTST REMTST LSBLK
C01048 00192 SREAD SREAD0 SRELOD SREAD1 SREA10 SREA11 SREAD7 SREAD8 SREAD9 SREAD2 SREAD3 SREAD4 LODFND SRSTOR SRSTR2
C01055 00193 QREAD QREADY QREADX QREAD0 QREAD1 QREAD2 QNOFF QNOFF2 QRDATT QREAD4 QABORT LODSUB QRED4A
C01065 00194 QRACT QRACT0 QRA0 QRACT1 QRA1 QRACT2 QRA2 QRACT3 QREADR
C01069 00195 SRCLUZ SRACT SREAD5 SREAD6 SDSCHK SDSCH2 SRALT SRALT2 SRALUZ FFINDE FFINDC FXFIND FFIND FFIND2 ASTER BLAS5 ASTERX ASTSAY
C01077 00196 BSLAS BLAS2 BLAS3 BLAS1 BSLXCT BSLXC3
C01082 00197 FINDIT FNDBS0 FNDBSL FOUND FND2 FND2A SETJMP FNDMOV FINSET FINSE2 SUBCNT
C01087 00198 FNDERR FNDER2 FNDWHT FNDER3 FNDER5 FNDER6 FNDER4 DELIM CASEM SUBERR SBONLY SUBSTP BSLSAY SUBSP2 SUBSP4 SUBSP3
C01092 00199 FIND FINBS0 FINBSL FINBS2 FINBS3
C01097 00200 DIRSRC DIRSR2 DIRSR4 DIRFND DIRSR3 DFERR DFERR4 SRCDF SDFCR
C01103 00201 EXACT EXACT1 EXACT2 SSET SSET2 SCONTB
C01106 00202 SCOMP SFLSH2 SFLUSH SFLSH1 SFLSL NOSRCH
C01109 00203 SBARF SBARF1 SBARF2 DIRRGH SARRGH SFSGT SFSGET SFSPUT SFSPTL
C01112 00204 SPARSE
C01114 00205 SPARS1 SPARS2 SPDSP SSCAN SSCANA SSCANX
C01116 00206 SSCAN1 SSCN1A SSCN1B SSCQT SSCBIN SSCINF SSCNOT SSCUOP SSCVB
C01118 00207 SSCLP SSCDSP FABITS
C01120 00208 SGRAPH SGRPH1 SGRPH2 SGRPHX SGDO1 SGDO1X SGDOX2 SGDSP SGDO1B
C01122 00209 SGNOT
C01123 00210 SBACK SBACK1 SBACK2 SBACK3 SBACK4
C01125 00211 SBBRCH SBBR2
C01126 00212 SBCALC SBCAL0 SBCAL1 SBCAL2 SBCL2A SBCAL3
C01137 00213 SBCAL4 SBCNON SBCX SBCOPL SBCOP2 SBCEND SBCEN2 SBCFIX SBCFXL SBCFXE POPJ2T
C01139 00214 SBCOK SBCEN1 SBCLUZ SBCLZ1 SBCNXT SBCBP SBCBPL
C01141 00215 SBCCB SBCCB1 SBCCB2 SBCCB8 SBCCB3 SBCCB4 SBCCB5
C01143 00216 SBCCB6 SBCCB7 BITCNT BITCN1
C01144 00217 NEWBIT NEWBT0 NEWBT1 NEWBT2 NEWBT3 NEWBT4 NEWBT5
C01146 00218 NEWBTC NEWBC1 NEWBC2 NEWBC3 NEWBNC NEWBN1 NEWBN2 NEWBN3 NEWBCZ NEWBNZ
C01148 00219 SCCOM SCCNOT
C01149 00220 SCCBIT
C01150 00221 MAKBIT MAKBT0 MAKBT1 MAKBTX MAKBTN MAKBN2 MAKBTB MAKBB3 BITTAB
C01152 00222 MAKBNB MAKBBT MAKBB2 MBDSP MBIND MBIND2
C01154 00223 SCGEN
C01155 00224 SCGEN1 SCGEN2 SCGEN3 SCGEN4 SCGEN5
C01157 00225 SCGTST SCGT2 SCGT3 SCGDSP SCGCN SCGCN2 SCGBTN SCGBT
C01159 00226 SCGE SCGE2 SCGEL SCGBAK SCGBK1 SCGBK2 SCGBK3 SCGFA SCGNC SCGNFA
C01161 00227 SCGHB SCGHB0 SCGHB5 SCGHB1 SCGHB2 SCGHB3 SCGHB4 SCGHBX SCGHX2
C01163 00228 SCGCB SCGCB0 SCGCB1 SCGCB2 SCGCNO SCGCB3 SCGCB4 SCGCB5 SCGHCB
C01165 00229 SBTMAK SBTMK1 SBTMK2 SBTMK3 SBTMK4 SSVINS SBKINS SBKNW SBKNWA SBKNWR SBKNWX SBKDSP
C01167 00230 SRCLBL SRCPAG SRCPG1 SRCPG3 SRCPG5 SPFIN SPFL SPFL2 SPFX NOSRC2
C01171 00231 GBYTP GBYTPL GBPTX GBPNEG GBPDSP GBPTAB BTAB3
C01173 00232 SRCPGF SPFTAB SPFFF SPFCR SSPAGE SSLINE SSLIN4 SSLIN5 SSLIN3 SSLINT SSSTOP SSNAME SSADD SSPAGT SSPADD
C01177 00233 SRCPGB SPBTAB SBKNL SBKNUL
C01179 00234 SRCSET SRCST1 SRCSTL SRCST2
C01180 00235 SCALL SRCHX SRCHLX ESCSTP ESCIST
C01182 00236 SCNBAK SCNBKL SCBDSP
C01184 00237 SCONTF SRCFNP SRCHED SRCDD SRCPGD SRCDPY SRCDP3
C01187 00238 SRCFP2 SRCFPP SRCIII NOSRCP SRCFP3 SRCFNB SFNB2 SFNB3 SIOCH3 SFNB4 SFRETR SIOCHK
C01193 00239 SRCFF SFFNUL SGTACS SRTACS SOOPS
C01194 00240 SRCFB SFBNUL SBKNB SBKNB2 SIOERR SENDIR SBKNP
C01196 00241 MINTXT TJSCNT TABCNT JPTAB JPT1 JPT2 JETST JLPTR JCPTR JARTST JWRT JLTPT JEXIT JATAB JUSF JALL JTBF JCRF MACF JCTAB
C01205 00242 TABFLG PMAR LMAR RMAR BNUM PMARO LMARO RMARO BNUMO JPMAR JLMAR JRMAR JBNUM JPMARO JLMARO JRMARO JBNUMO GPMAR GLMAR GRMAR GBNUM TPMAR TLMAR TRMAR TBNUM TPMARO TLMARO TRMARO TBNUMO INMAR AMAR AMARS TABOLD TABTAB BREAKV JCNT JCNTC JPTR JPTRC JRPT JWCOL JSCNT JBUGR JWPT JSINC JSIZE JMARG
C01209 00243 J2CR J2CR1 J2CR2 J2CR4 J1SP J2TAB J2SP J2SP2 JUSPA1 J2PUN
C01213 00244 J3CR J3CR2 J3SP J3TAB J3SP0 J3SP2 J3SP3
C01216 00245 J1CH J1DSP J2DSP J3DSP J4SP J4CH J4CHD J4CHX J4CH0 J4CH1 J4CH2 J4CH3 J4CH3A J4CH3B J4CH4
C01220 00246 J5CR J5TAB J5TAB2 J5TAB3 J4DSP J5DSP
C01223 00247 PARGET PARG0A PARG0 PARG1A PARG2 PARG4 NEXTLI ADJARG JNEW JMORE
C01229 00248 JUFIX JBLANK JMSTRT J2PAS0 J2PAS1 J2PAS3 J2PAS4 J2PAS5
C01233 00249 JSTART JSTAR1 JSTAR2 JSTAR4 JSTAR3 JSTAR5 JSTAR7 JSTAR6 JSTAR9 JSTAR8 JSTARX JSTAR0 JSTA00
C01239 00250 JINIT JINIT3 JINIT2 JPARAM JPARAS JPARAI JPARNN JPARN2 JPAR1 JPAR2 JPAR3 JMREAD JMREA1 JMREA4 JMREA5 JMRDCR JMRNEG JMRERR JMRERL JMRERS JMRUP1 JMRXIT JMRXCT JMRCHK
C01249 00251 JUDATA JUS6A JGET JGET1 JGET2 JUTYPE JUTYPO JUTYP3 JUTYP2
C01252 00252 TJ1CR TJ1CR7 TJ1CR0 TJ1CR2 TJROOM TJROM1 TJROM2 TJROM3
C01254 00253 TJ1CR4 TJ1CR5 TJ1CR6 TJ1TAB TJ1CH TJ2TAB TJ2SP TJ2SP1 TJ2SP2 TJ1DSP TJ2DSP TJ2PUN TJ3TAB TJ3CH TJ3DSP
C01258 00254 TABLE TJFILL TJUST TJUST0 TJDATA TJUS6 TJUS7 TJUS9 TJUS10
C01261 00255 SJFILL SJUST JFILL JUST JUST0 JUST2 JU1A JU1B JU1D
C01265 00256 JU1E JU1F JU2 JU3 JU3A1 JU3AA JU3A JU3BB JU3B JU3D JU3E
C01270 00257 JU4 JU4A JU4B JU5 JU5A JU5B JU5E JU5F JU5C JU5D JU6 JU6D JU7 JU8 JU8L JU8X JUDONE JUDON2 JUDONX
C01275 00258 IND IND0 IND2 IND3 IND4 IND4A IND5 IND6 IND7 INDTYP INDTY2 INDENT INREAD INREA8 INREA0 INREA9 INRE6A INREA6 INREA4 INREA2 INREA3 INREA7 INREA5
C01285 00259 CENTER CENT3 ALIGN RTARR LFARR
C01287 00260 TB1SP TB1SP8 TB1SP3 TB1SP4 TB1SP1 TB1SP2 TBISP5 TB1SP6 TB1SP7 TB1TAB TB1TB1 TB1TB2 TB1TB3
C01290 00261 TB1DSP TIN SIN TB1 TB3A TB3B TB3D TB3E TB4 TB4A TB4B TB5 TOUT3 TOUT4
C01294 00262 JGINIT JGINI2 JGB0 JGB JGB1 JGB1A JGB1B JGB2 JGB3 JGB4 JGIND JGIND1 JGMAR JGMA
C01300 00263 TJREAD TJR2 TJR5B TJR6 TJRXIT TJRMUL TJR3 TJR3A TJRRGT TJR8 TJR7 CLRTYI TJADJ TJADJ1 TJADJ2 TJADJ3 TJADJ4
C01307 00264 TGET TJGET TJGET1 TJGET2 TJ4TAB TJ4SP TJ4DSP TJ5DSP TJG1 TJG2 TJG3 TJG4 TJG5 TJG6 TJG7 TJG9 TJG10 TJG13 TJG15
C01312 00265 TJTYPE TJTYPO TJTYP7 TJTYP8 TJTYP9 TJG20 TJG20A TJG20B TJG20C TJG22 TJG24 TJG25 TJG23
C01315 00266 BREAK BRKERR
C01317 00267 JOINPM NEGATT JOIN JOIN0 JOIN0A JOIN0B JOINA JOINA1 JOINB JOIN1A JOIN1 JOIN2 JOIN3 JOIN2A JOIN4
C01323 00268 JOIN5 JOIN5A JOIN6 JOIN6A JOIN7 JOIN8 JOIN9
C01328 00269 TJU1 TJU1B TJU2 TJU3 TJU3B TJU3C TJU4A TJU4B TJU4C TJU4G
C01331 00270 TJU4D TJU4F TJU4E TJU5 TJU5A TJU6 TJU7A TJU7B TJU8 TJU8A TJU8B TJU9 TJU9A
C01334 00271 OLDFIX OLDFI2 OLDFI3 OLDFI4 OLDFI5 ZLINES OLDLOC OLDLIN OLDLI2 OLDLI0 OLDWIN OLDLI7 SETAR0 OLDLI4 OLDLI5 OLDL5L OLDLI3 OLDSA0 OLDSAV OLDSA2 OLDSA3 OLDSA4 OLDFL2 OLDFL3 OLDFL0 OLDFL5 OLDFLS OLDFL4 OLDFL6 OLDFL7
C01350 00272 NBACK ZBACKL ZPAGL ZFLAGS ZFRDWN ZBACK ZWIND ZMARK ZENT ZNUM MAXWNS ZSIZE ZDATA ADDFIL
C01355 00273 ZSAVE ZSAVIT ZSAVE0 ZSTORE ZFLDIR ZFLDI1 ZFLDI2
C01361 00274 ZFINDQ POPJ2 ZFIND ZFIND1 ZFIND3 ZFIND2 ZLIST ZLIST0 ZLIST2 ZLIS21 ZLIS23 ZLIS22 ZLIST3 ZLIST5 ZLIST6 ZRSTOR
C01371 00275 ZFILES ZFILEL ZFILEX ZFILW ZFILW2 ZFILC ZFILM ZFILM4 ZFILM7 ZFILM6 ZFILM8 ZFILM5 ZFILM2 ZFILM3 LAMEP0 EXIST0 EXIST1 EXIST3 EXIS3A EXIS3B
C01381 00276 EXIST EXIST LAMEPS LAMEPE LAMEP3 EXISTE LAMEP4 LAMBDA EPSIL EPSIL0 EPSIL1 EPSIL2 EPSILP EPSIL4 EPSIL3 EPSIL6
C01391 00277 ZINUSE HOMPLC HOMMAX HOMDBL HOMSAV HOMSAD HOMSA2 HOMSA0 HOMSA3 HOMSA4 HOMSA5 HOMSA6 HOMFIL HOMFI2 HOMFI9 HOMFI8 HOMFI7 HOMFI6 HOMROT HOMFI3 HOMFI4 HOMFI5 HOMTE2 WINSTY HOMF5L HOMEF HOMEF2 HOMEF3 DBWINC DBWIN2 DBWIN3 DBWIN8 DBWIN4 DBWIN5 DBWIN6 DBWIN7 HSWTCH HSWTC2 HSWTC3 QUERY QUERY4 QUERY3 QUERY5 QUERY2
C01412 00278 PIERR POINTE PICMD4 PICMD0 PICMD2 PICMD3 PICMD5 PIPPN PICOP0 PICOPY PILOOP PILOP2 PIFILE PIFIL3 PIFIL4 PITYPE PSWLOP PNOSWI PSWITL PISWIT PISCAN PISCCR PISCN1 PILSPC PILSP2 PIEXT PINAM0 PINAME PINAM2 PINAMX PIHACK PIHAK2 PITYIX PICHAR
C01431 00279 SUBSTR SUBST6 SUBST1 SUBST0 SUBST2 SUBST3 EATTAB SUBTAB FIXTAB
C01435 00280 SUBOVE SUBST4 SUBST5 QFAST3 QFAST4 QFAST5 SUBSAY
C01440 00281 SPOOLD NOSPOO XSPOOL SPOOLC DOVER BOISE IMPRINT ESPOOL ROVER PLOVER STRUDE PANCAK LATHRO SPOOL0 SPOOL1 SPOOL2 SPOOLL SPOOLE SPLINI MWRBUF SCLOBF MAIOUT MAIOU2 MAIOUL MAIOU3 XWRDON SPOOLW SPLCHK
C01452 00282 MAISPL MAISP3 MAISP5 MAISP4 MAISP6 AFOO MAISP8 MAISP2 MAIS9A XWRNXT MAISP9 XWRLIN XWRLUP XWRLP2 XWRDSP XWRTAB
C01458 00283 XCLOSO XWRBUF XWRBF3 XWRPM XWRPM2
C01460 00284 SPLWAK SPLPPN SPLJBN RETADD XGPFLG RQIOWD XFNTCM SPLEXT SPLCM2 SPLJOB CFORM RQNAM RQJOB FDEV DEVMOD FSIZE RQTIME FNAME FPPN CBITS PSPEC SPALL RETURN
C01464 00285 SPOOLZ NOLOOK STASH SAGAIN DWNCHK
C01470 00286 SPLSTS INTSPL INTSPS NOPRNT NODISK OUTERR INTCFN MULSPL NOWAKE NOSPLR
C01474 00287 FBISPC FBICMD FBIFRM ADRS FBINAM SAVCHR SAVCH3
C01478 00288 MAPILE CHFILE CHUSET TELFL3 TELSIZ FBICNT FBIBUF FBIPNT LTELBF TMPMAX SAVEAC LEDGBF FFBUF QLPDL QLEPDL TCBUF EDGBF ZTMPBF OLDBUF MAILBK CMDBUF LMACBF MACBUF TELBUF TMPBUF TM2BUF
C01482 00289 CHEXT CHEXTA CHEXTM CHPPN CHKUP MONTH WKDAY SUMERR CHREGE CHINDE CHADDR CHADDC CHOUTB CHPDLM CHREG2 CHRETU CHALIA
C01484 00290 CHTEXT CHCRLF CHOUT3 CHOUT6 LHOCTS
C01486 00291 CHECKU STOPJC
C01488 00292 TELLME FILEID
C01492 00293 FBI MAINTMODE FBI1 FBI1A CHSUME CHSUM2 FBI2 FBI2A FBI3 FBI3A FBI3B
C01499 00294 FBNINE FBI3C FBI3D FBI3E FBI4 FBI4Z
C01501 00295 CHMACR CHMAC2 CHMAC3 CHMAC4 CHMAC5 FBI5 FBI5B FBI5E FBI5C
C01504 00296 FBI5D FBI6 FBI7 FBI7A FBI7B FBI8 FBI8A FBI8B
C01507 00297 FBIDSP FBIPIC FBIFUL FBIADD FBIOCT FBIDEC FBIASC FBIAS2 FBISIX FBISI2 FBI9 FBI9A FBI9B
C01510 00298 CHEND FBI10 FBI10A FBI11 FBI11A FBI12 FBI13 WRITIT WRITT4 MRET WRITT2 WRITT3
C01513 00299 MAPMES MAPHED DSKMAP MAPEXT MAPPPN MAPCR MAPCR2 MAPT2 MAP MAPIT MAP1 MAP2 MAP3 MAP3A MAP4 MAP4B MAP4W MAP4Q MAP4N MAP4M MAP4A MAP5 MAP6 MAP7 MAP8 MAP9 MAP10
C01522 00300 PARSYM PAREN PARENB PAREN1 PAREND PARENC PARENA
C01525 00301 LEFTC RITEC PARMAX PARMIN PARGDP PARLDP PARTMS PARTML PARCT PARLN PARDEF PARPRS PARTOT PARPGL PAROFF PARX
C01527 00302 PARSAV RPAREN PARR LPAREN PARL PARL2 PAR PAR0
C01531 00303 PA1DSP PARDSP PAXDSP PACDSP PARESC PARES2 PARFF
C01535 00304 PARXCR PARXCA PARXCB PARXC1 PARXC2 PAR1X PAR1CR PARCR PAR1 PAR1B PAR1A
C01539 00305 PAR2 PAR3 PAR2A PAR2B PARFND PARNOT PARTY5
C01543 00306 PINFO PARTY0 PARTY1 PARTY3 PARTY2 PART2A PARTY7 PARTY8 PARTY9 PARER1 PARERR
C01546 00307 PAREX PAREXX PAREX2 PAREX3 PARB PARB2 PAREXT PARRCD PARRC2 PARNUL
C01552 00308 BAKADD BAKAD2 BAKSUB BAKSU2 BAKSAV BAKSA0 BAKSA2 BAKSA3 BAKSA4 BAKSA5 BAKSA6 ZPAGES BACKGO BACKG2 BACKG5 BACKG8 BACKG7 BACKG3 BACKG6 BACK6L BACKG4 NOHDEF NOHSTK NOHST2 NOHSOV
C01566 00309 EXCL MSG MSG0B MSG0 MSG0C MSG0A MSG1 MSG2 PARAGR MSGLUZ MSGBK MSGBK0 MSG5 MSG6 MSG7 CHKMS0 CHKMSG CHKMS2
C01577 00310 BRPTHR BURPEX BLOAT BURP BLOAT2 BLOAT3 BLOAT4 BLOAT5 AUTOBU AUTOB3 AUTOB4 AUTOB2 STBURP UPDATE UPDAT0 UPDAT9 UPDAT2 UPDINI NOXPAG NOXREC UPDIN2 UPDAT3 UPDAT4 CHKER CHKER2
C01588 00311 PROTEC PROTE0 PROTE1 PROTE2 PROTE3 PROTE4 PROTE6 PROTE5 RENAM RENAM0 RENAM2 RENAM5 RENAM3 RENAM4 RENAM6 RENAM7 RENDEV FILDEA NOFDE2 NOFDEL FILDTE FILDT2 FILDEL FILDE2
C01606 00312 MAIFIL MAIPPN MAIFLG MAISWP DFISWP DFIND SEND TEST MAIL REMIND DFIND2 MAILUP MAILU2 MAIABT MAILUZ CHKDSK CHKDER DFIJOB DFILU2 DFIJOK DFILUZ
C01616 00313 ALIAS ALIAS0 ALIASE ALIAS4 ALIAS2 ALIAS3 ALIAS5 ALIAS6 PP0TYP SETHD3 SETHD2 SETHED SETHD0
C01623 00314 SAVFIL SAVERR REENT SAVE1 SAVE0 SAVE0M SAVWIN SAVE3 SAVE2 SAVEX SPLSTR SPLST2
C01629 00315 LBLERR LBLSRC LBLSR2 LBLOOP LBLFND
C01632 00316 HEIGHT HEIGH7 HEIGH8 HEIGH4 TOPPER SCOUNT SDEFLT SMINIM SSTORE SWINDW BOTTER ATTTER ATTSET GSCBTM GSCBT2 BOTFIX BOTSET TOPSE2 ATTSE2 TOPSET CHKHG0 CHKHG2 CHKHG3 CHKHGH CHKHGY CHKHGX RAISEW
C01646 00317 REQWIN REQWER REQWE0 REQSML REQWI2 REQWI3 REQWI4 REQWI5 MAKWCK MAKWOO MAKWO4 MAKWOV ADDWIN FNOWCK FNOWCL FNOWC2 ABTWIN ABTWI0 ABTWI2 ABTWI3
C01666 00318 FNDWIN FNDWI2 FNSWIN FNSWI2 LNKWIN LNKWI0 LNKWI2 LNKWI3 SELWIN SELW00 RSELWN
C01677 00319 WINSHF WRELOC WRELO2 WRELO3 WREL3A WRELO4 WRELO5 WINBLT
C01683 00320 CLSWIG CLSWIN CLSWIQ DEDWCK DEDFLS FLSWIN CONTEL CONTE0 CONTE2 CONTIS CONTIB CONTIN CONTIE TRADE2 TRADE4 TRADE5 TRADE3 TRADEW TRADE0 TRADER
C01699 00321 CLSALL QUIT CLSALX CLSALY CLSALZ CLSAL3 CLSAL2 CLSEM CLSEM2 CLSEM3 CLSEM4 LINGIV LING2 LING3 LING4 LING5 LING6 LING7 LING8 LING9 LING13 LING10 LING11 LING12 LING20 LING21 LING22 LING23
C01718 00322 WINSAV WINSA2 WINSA3 WINSA4 WINSA5 WINSA6 WINDGO WINDG2 WINDG5 WINDG8 WINDG9 WINDG7 WINDG3 WINDG6 WINDG4
C01726 00323 NXTWIN NXTWI3 NXTWI2 NXTWI6 NXTWI4 NXTWI5 NXTWI8 NXTWI7 DPYWST DPYWS2 DPYWS6 DPYWS4 DPYWS7 DPYWS8 DPYWS3 DPYWS5 DPYWS9 DPYW11 DPYW10 DPYW12 SLSRCP DPYWFL DPYWF2 GRTWIN GRTWI2 GRTWI3 GRTWI4 MWCHK MWCHKL MWCHKX IOID WINSTK WINDBL
C01742 00324 NEWDLF NEWDLS NEWDL1 NEWDL2 NEWDL4 NDFSAY NOTEX2 NOTEXT PPEMPT RDFAIL RDFAI0 RDFAI2 RDFAI3 RDFAI7 RDFA77 RDFAI9 RDFAI8 RDFAI6 RDFA10 RDFAIT NDFAIL NEWD4A RDFAI5 RDFAI4 NEWD1 NEWD2 NEWD2B NEWD2A NEWD3 NEWD3A NEWD4 NDFIN NDFIN0 NEWD5 NEWD5A
C01763 00325 NDSAIL NDSA0 NDSA1 NDSA3 NDSA4 NDSA5 NDSA6 NDSA8 NDSA9 NDS9A NDSA9B NDSA10 NDSA11
C01767 00326 NDSWRD NDSWD0 NDSA17 NDS11A NDSA13 NDS13A NDSA14 NDS14A NDS14B NDSA22 NDSA15 NDSAY NDSAY0
C01770 00327 LOKBLK LOKBL0 LOKBL1 LOKBL2 BEGS BEGS2 BEGS2A BEGSDD BEGS3 BEGS4 BEGS5 BCRLF BEGS6 BEGS7 BEGS8 BEGS9 BEGS10 BEGS11 BEGS12
C01775 00328 FNDWRT WRITTE TYP2DG WRTTEN
C01778 00329 EMPTEL EMPTE2 EMPTE3 EMPTY NONEMP EMPTY3 EMPTY2 EMPTY4 EMPTYE EMPTYX
C01781 00330 MACLNK MACNAM MACFLG MACTXT MBYTE MREPT MPOINT
C01785 00331 MACINI MACIN0 ANYMAC MACLST MACLS0 MACLS3
C01787 00332 CASE CASEL CASERR MACCAL ZMACRO ZMAC0 ZMAC1 MQUICK LOADZM LOADZL LOADZ2 ZMAC2 ZMAC2A ZMAC2B ZMAC3 ZMAC3A ZMAC4 ZMAC5
C01795 00333 MALTMO MALTM2 MACCHR MACCH0 MACCH2 MACCH3 MACPOP NOMACS SAYEND MACSAR MACSAY MACSR2 MACRPT
C01800 00334 STOPZE STOPAL STOPON STOPHO MACSTP MACSTO MACBRK MACST4 MACST3 MACESC MACSTA MACST5 MACST6 MACSTS MACSTX MACPOV
C01805 00335 RESUME RESUM2 CONTNO CONTI2 CONTI3
C01808 00336 ABORT ABORT5 ABORT6 ABORT2 ABORT4 ABORT3
C01811 00337 MACDEF MACDE2 MACDE3 MACDE4 MACAB0 CTMTLF MACCHK MACB00 MACBN0 MACBNM
C01815 00338 MACSET MACFIN MACFI0 MACFI1 MACFI2 YSET
C01820 00339 GETMAC GETMA2 GETMA0 GETMA3 MACSHF MACSH2 MACSH3 FMUNDF FMUNDL FMUND0
C01823 00340 MACUN0 MACUND MACUDF MUNDEF MACUD0 MACUD1 MACUD3 MACUD4
C01826 00341 FNDMAC FNDMA2 FNDMA3 MACTY0 MACTYP PPJ1SP OUTSPC UNDEFM MACBEG MACEND TTYPNT MACDFL MACFIL EINITF
C01829 00342 MACLIN MACL02 MACL05 MACL03 MACL04 MACL01 MACLN0 MACLN1 MACLN4 MACLN8 MACL4C MACL8C MACL84 MACKLD MACLN7 MACLN2 MACLN3 MACLN5 MACLN6 MACLT2 MACLTT
C01839 00343 OMFILE EXETYP SKPDIR SKPDI2 SKPDI3
C01843 00344 EXECUT EXECUN EXECUX EINFIN LCMFIN GENMCN GENMCL EXGETC EXEERR EXEER1 EXEFNF
C01847 00345 GETDEF GETDE0 GETDE1 GETDE2 GETDE3 GETDER GETDEC GETDEB GETDEX GETDX2
C01852 00346 GRANGE GNUM GNUM0 GNUM2 GNUM3 SKPSPC SKPSP2 MFINI0 MFINIT
C01855 00347 MFGETC MFGETR MFGET0 MFGET1 MFGET2 MFLUZ MFPSTR MFPST2 MFPUTT MFPUTR
C01858 00348 MFCHK PUTDEF PUTDE2 MFLINE MFLIN0
C01861 00349 PUTMAC PUTMA0 PUTMAL PUTMA1
C01865 00350 XAttach command MEDIT MEDITX MEDITR MEDIT0 MEDITS MEDITN MEINIT MEDCHR MEDLIN MEDLN0
C01871 00351 REDEFI REDERR REDBAK PGCONV REDPG2 REDAT2 REDPAG REDATT PGCON0 PGCHER PGCONX PGCONE PGCONL PGCON2 PGCHAR PGCHLF PGCHA0 PGCHA3 PGCHA5 PGCHA2 PGCHA6 PGCHAB PGCHA4
C01883 00352 NXTTAB NEXTCH NEXTLN NEXTL0
C01885 00353 LBS LBS4 ARGUM2 LBS2
C01888 00354 EINAME EINRED EINBIG EINCHR
C01891 00355 HIDE HIDCHK HIDEIT HIDNEW HIDLUZ HIDE0 HIDE1 HIDE2 HIDERR
C01894 00356 CACHE0 CACCHN CACMIN CACRED CACWRT PCACHE CFSGET CFSGEL CFSGIV CFSGIL
C01897 00357 CACGE0 CACGET CACGEL CACFND CACFNL CACFIT CACSET CACFI2 CACRLC CACRLI CACRLO CACRLT CACRLL
C01901 00358 CACCLS CACOUT CACOUL CACOU0
C01905 00359 BOUT BINFIN PPCBA1
C01917 00360 BIN BINOK BINGET PPCBA2 BINGE2 BINFIX BINFI2 BINFI3
C01923 00361 PROGRP PROCHK PROCH1 PROCH2 PROCH3 PROTEL PROTL2 PROXCT
C01928 00362 QLSYMS QLTBL QLLSEM QLASEM QLLSXP QLASXP QLLPAR QLAPAR QLLIND QLAIND QLCNT QLCHG
C01934 00363 QLIND QLIN01 QLIN00 QLIND0 QLIN1 QLIN1A QLIN2 QLIN3 QLIN30 QLIN3A QLIN3D QLIN3H QLIN4 QLIN4B QLIN4F QLIN4H QLIN4J QLIN4K QLIN4L QLIN4M QLIN4P QLIN4R QLIN4T QLIN5 QLIN6 QLIN6A QLIN7 QLIN7A QLIN8
C01949 00364 QLSTEP QLSTP1 QLSTP2 QLST2A QLSTP3 QLSTP4 QLSTP5 QLSTP6 QLSTP7 QLST7A QLST7B
C01955 00365 QLLINE QLLIN2 QLLIN4 QLLIN6
C01958 00366 QLMTSX QLMT1 QLMT1A QLMT2 QLMT4 QLMT5 QLMT8
C01962 00367 QLMRSX QLMR1 QLMR1A QLMR4 QLMR6 QLMR7 QLMR8
C01966 00368 LISPSY LISPS2 LISPTL LISPT2 LISPER LISPE2 LISPRS OCTIN OCTINL OCTINX
C01971 00369 BEEPME BEEPM2 VERBOS TERSE VERSAY SILENT ECHO IECHO IECHO2 ECHO2 ECHO3 SAY SAY2 CVTALS CVTALT CVTAL0 CVTAL2
C01977 00370 Readonly variables, numeric macro calculations. MACEVL MACEV2 MACEV0 MACEV3 MACEV4 MACEV5 MACEV6 MACEV7 SET SETXL SETXL0 SETX SETX2 SETX2S SETXNM SETSTR SETSTL SET0 SET0S SET2 SET0X SETDIG SUBTRA ADD MINIM2 MAXIM2 MINIMU MAXIMU REMAI2 REMAIN ARGUND ARGBAD RDVUM2 RDVUND RDVSTE ARGUME DIVIDE MULTIP MULTI2 MACHA0 MACHA6 MACHA5 MACHAK MACHA2 TSTTAB TSTTB2 IFLT IFGT IFEQ IFNE IFLEQ IFGEQ TESTER TESTE2 GSLISP GSLIS2 GSLIS3 GSUBJB GSUBJ2 GSUBJ4 GSUBJ3 GSUBJR GSUBSK GSUBTP RDVLIN RDVLNS RDVPAG RDVPA2 RDVCOL RDVCLS CHRNUM CHRCNT RDVCHR RDVSIX RDVEFL RDVWFL RDVRFL RDVIFL RDVNOD RDVSTP RDVROM NFOUND FINDEX RDVFNM RDVFPL RDVSTX RDVDAT RDVTIS RDVDTS RDVDYT RDVDYS RDVDAY RDVDTM RDVTIM RDVDA2 RDVWDL RDVNDA RDVMOL RDVTI2 RDVTYP RDVTY2 RDVTY3 VALTYP LENSKP RDVAR NRDVAR RDVARP
C02016 00371 RAPID RAPID0 MACLED MACLE7 MACLE5 MACLE2 MACLE4 MACLE8 MACLE6 MACLE3 BTAB4 MACLOK MACL2 MACL2A MACL2B MACLTB MACLAC
C02023 00372 SKPSP5 SKPSP3 SKPSP4 GETNUM GETNUI GETNUL GETNU0 GETNUB GETNER GETNU2 GETNUX GETNUR
C02028 00373 MACDSL MACDS7 MACDS6 MACDS2 MACDS3 MACD3B MACDST MACDS8 MACDS9 MACD5A MACDS5 MACD5B MACDS4 MCURS MCURS2 DCURS DCURS5 DCURS2 DCURS1 DCURS0 ICURS ICURS2 REMCUR
C02041 00374 STEPCK STEPC2 DISP6 DISP6A DISP7 AUTOST AUTOS0 AUTOS2 STEPQ STEP STEPQ2
C02046 00375 NDBBOA NDBB0 NDBB2 NDBB22 NDBB3 NDBB33 NDBB4 NDBB66 NDBB6 NDBB5 NDBB44 NDBB55 NDBGET DATPRG DATPR0 DATPR2 DATPR3 DATPR4 NDB2DG NDBPUT
C02053 00376 OTHERC UPPERC LOWERC LOWER2 UPLOGO UPLOLL UPLOCL MAKOTH UPLOCX UPLOC2 UPLOLX UPLOAT UPLOAN UPLOA2 UPLOWD UPLBWL UPLOWF UPLFWL UPLOXX CASCHK MAKOT2 UPLFWD UPLBWD UPLCHL TOLET TONLET BACKBP FORWBP
C02067 00377 LSPRUN LSPPPN LSPIN2 MLLEN QMMAXC LSPINI LSPMAI LSPMBF LSPSTR LSPST2 LSPLEN PTYNBR PTYBLK INTBTS INTLSP INTPTY LSPJ PLOGIN XON FULTWX SUBJOB SUBJO2 JBTLIN JOBN1 JNA SUJOB1 SUJOBJ OCTARG OCTAR1 OCTAR2 SUJOB3 SUJOB0 SUJOBK SUJOBF SUJOB2 SUJOE1 SUJOE2 SUJOE4 EECHO EECHO2 SUBECH SUECHI SUBLST SUBLC2 SUBLCL SUECH2 XONON XONOFF EXONOF EXONON SULISP SLISP SLISP2 SLISPZ SLISPJ SLISJ2 SLISPY SLISP0 SUJOB4 SLISPX SLISP8 SUBLIN SUBLI0 SUBLI5 SUBLI6 SUBLI7 SUBFIN SUBFI2 SUBFI3 SUBFI4 SCREEN SNDMAI SNDAGN LSPGON SNDFUL SNDLUZ SNDLUI GETMAI GETAGN POPAJ1 GETMAL WAITCT GETNUN GETNUW GETWAI GETLUZ GETLUI SUBWAI SUBWA0 CHKMAI CHKMA2 LSPTCK LSPTC2 LSPWCH LSPWC2 LSPWC3 LSPWC5 LSPWC4 PTOCHK UNQMAI QUEMAI QUEMA2 QMINI QMINI2 QMFLS QUESHF
C02106 00378 LSCHK LSCH0 LSCH2 LSCH2A LSCH3 LSCH4 LSPTY LSCH5 LSPT2 LSESCI LSREAD LSMA3 LSMA2 lsgo HLDNOW LCBCNT LCDSP LCMAX LSMAI LSUNDO LSUND2 LCRDV LCMAC LCANS LCDATA RLSTRG RLSTR2 LCNCHK LCNCLR DOJBRD DOJBRX DOJBRE LSEND
C02127 00379 LATTAC LTYPE LFILE LPEND2 LPEND LMTELL PLXCT PLMMAX PLTELL SOMODT SOMODS PLTEND PLTEN2 PLTEXP PLTEXT LTXTYP LTXTY2 LTXTY3 LRECEI LRECEM LRECE2 LRECEX LRECE0 LRECE3 LRECE4 LCRDV2 LCRDV3 LCRDV4
C02142 00380 LTXEND LTXER1 LTXER3 LTXER2 LTXFIL LTXEN2 LTXAT3 LTXATT LTXAT2 LTXFI2 LTXEN3 FAKLUP FAKEND LTXLIN LTXLUP LTXNU2 LTXCR1 LTXCR0 LTXCR LTXCR2 LTXLF LTXLF2 DELFAK LTXTAB LTXDSP LTXNUL LTXCO3 LTXLUZ LTXDLY LTXCON LTXCO2 LCMAC3 LCMACX LMCHAR
C02165 00381 LSPSHT LSPCON LSPMAX LSBYSZ LSBYWD LSIBPT LMJOB LMCMD LMBMA LMTXT EQUALS EQUALX EQUAL2 EQUAL3 LLGETX LLGETY EQUALF EQUALE EQUALL LSPLIN LSPLUP LSPTAB LSPFF LSPNXT LSPDSP SNDLSP SNDLS2 SNDLER sndpty sndppc LLGET LLGET1 LLGET2 LLGET3 LLGETE
C02181 00382 LINTER LINTE3 LINTE2 EVAL EVALUP EVALXT REEVAL
C02188 00383 JOBNAM PRJPRG NSUBJ OLDJOB JOBMAX JOBDBL SUCONN SUWARN SUBSAV SUBSA2 SUBSA9 SUBSA0 SUBSAD SUBSA4 SUBSA5 SUBSA6 RECONN RECON2 RECONK RECONX RECON7 RECON8 RECON3 RECON4 RECON5 RECO5L RECONT RECOP2 RECONP LSPJCK LSPJCL LSPJC2 LSPWRN LSPWRC LSPWRJ JOBCHK SUBKIL SUBKI0 SUBKI2 SUBKI PTDETC SUBDET SUBDE0 SUBDE2 SUBDE3 REEDET REEDEL REEDEX REEDE0 REEDE1
C02208 00384 Would-be Per-open-file data (whole page).
C02211 00385 WINDAT ZWIN WINSER WINFGS SCRBOT NEEDHD DLINES DARRL DCURPG DPAGES DBLOAT DROOM OLINES OCHRS XPAGES XCHRS XPLST XPLSTE EDLINE EDSER EDCNM2 BKPSW BOOKSW DIRP1 CHARS DIRPT RELPGN ROOM PAGE WINMAX DPLST LSTARR LSTPAG NLINEU NLINER SCRSIZ ARRLIN HEDBLK TRLBLK BOTWIN OFFSET WINLIN SLNSTP SPGSTP TOPWI2 DIRPAG FILWC FILLEN IBLK OBLK DIROVH DIRSIZ EDIRSZ ODSIZ NODUPD XDIRFG WRTPRO DELFIL DELFI2 DELFI3 DIR DIREND EWIN ARRON EDFIL MARKS BAKPLC BAKWIN BAKMAX BAKDBL SCRTOP LPTRTB ARRL TOPWIN LINES LPTRT2 DPTRTB CURPAG FIRPAG PAGES DPTRT2 TOPSTR HED3PG HEDPAG HED5PG HEDNAM ROFLG AFLAG WFLAG UIFLG EMFLG HWFLG SOMOD LTPSTR TOPDSH HEDLIN HED4PG HED2PG HED6PG HED2NM ROFLG2 AFLAG2 WFLAG2 UIFLG2 EMFLG2 HWFLG2 SOMOD2 LTPDSH BOTSTR BOTLX BOTARR BOTARO BOTLN5 BOTPG2 BOTPGO BOTPG3 RFLAG3 WFLAG3 LBTSTR BOTDSH BOTLX2 BOTAR2 BOTLN4 BOTPG4 BOTPG5 RFLAG4 WFLAG4 LBTDSH NEARBY NOLD OLDPLC OLDMAX OLDDBL ZINDEX WINNBR DQINFB WRTTEN WRTJOB WRTPPN WRTFI1 WRTFI2 WRTPPN WRTFI1 WRTFI2 LWINDT
C02226 00386 PDL EPDL TYIPNT TCPNT SYSCMD ZVARS FNDTBF FNDBUF SRDUMY BITBF1 BITBF2 SBBUF MBBUF VBBITS SBLST BUF BUF2 PBUFE RBUF RSPNT EVARS PATCH PAT LEGTAB ENDPUR CHKSUM ENDLOC
C02228 ENDMK
C⊗;
;FTF2 FTCCRMA ;⊗ FTRP07 DDLOSS FTGSPL DATOK TMPMRK FTHID FTBUF FTMACL FTUNHID DECSW DATOK MSGPPN MAISYS DOCPPN ERRPPN RMDSYS MSGPPN MAISYS DOCPPN ERRPPN IRCSW PHUSET GARBIT PHUSET GARBIT RAQBIT RAQMOD NCACHE NBUFS NBUFS
;E -- DISPLAY EDITOR FOR STANFORD AI LAB
;Written by Frederick H.G. Wright II
;with modifications by D. Poole, Art Samuel, Stan Kugell, and Martin Frost.
;Define FTF2, FTCCRMA, etc., appropriately for the system we're compiling on.
;(Set non-zero to make bigger cache for F2 version of E.
;and to avoid second DD field on Grinnell transfers.)
;To cross-compile for another WAITS system, see the following file:
.INSERT WATSIT[S,SYS]
FTRP07←←1 ;nonzero to use smaller number of NBUFS at SU-AI (RP07 disks)
DDLOSS←←0 ;Set non-zero to insert extra CR after CRLF for losing DD
↓FTGSPL←←1 ;Set non-zero to use new SPOOLR UUO, any printer name is spool cmd
DATOK←←1 ;Set non-zero to allow system to handle setting of files date/time
TMPMRK←←1 ;Set non-zero to save/restore marks via TMPCOR file
FTHID←←1 ;Set non-zero to enable hidden directories (needs fixing for DECSW)
FTBUF←←1 ;Set non-zero to cause main dump-mode disk I/O to be buffered by E.
FTMACL←←1 ;Set non-zero to display pseudo line editor during macros
FTUNHID←←1 ;Set non-zero for TEMPORARY KLUDGE to make XHIDE always UNHIDE dir.
IFNDEF SPCWAR,<↓DECSW←←1>
IFNDEF DECSW,<↓DECSW←←0>;This allows loading TTY:+DSK:E at Stanford to test DECSW
↓DECSW←←DECSW
IFN DECSW,<
SEARCH DPYUUO ;DEFINE DEC VERSIONS OF DISPLAY UUOS
DATOK←←0 ;Apparently DATOK doesn't work in DEC
OPDEF GETLCH [TTCALL 6,];DEFINE SOME DEC UUOS
OPDEF SKPINC [TTCALL 13,]
OPDEF SKPINL [TTCALL 14,]
OPDEF HIBER [CALLI 72]
OPDEF CHGPPN [CALLI 74]
OPDEF TRMOP. [CALLI 116]
OPDEF PIINI. [CALLI 135]
OPDEF PISYS. [CALLI 136]
OPDEF DEBRK. [CALLI 137]
OPDEF FILOP. [CALLI 155]
MSGPPN←←<3,,3> ;PPN of message files
MAISYS←←<'MAISYS'>-400000400000 ;PPN of FORWRD.TXT
DOCPPN←←<' UPDOC'>-400000 ;PPN of E.ALS documentation file
ERRPPN←←<' EALS'>-400000 ;PPN of error log files
>;DECSW
IFE DECSW,<
RMDSYS←←<'RMDSYS'>
MSGPPN←←<' 2 2'>
MAISYS←←<'MAISYS'>
DOCPPN←←<' UPDOC'>
ERRPPN←←<'ERRSYS'>
>;NOT DECSW
IRCSW←←DECSW ;SET TO ZERO FOR DEC-STYLE OCTAL PPNS
IFNDEF CURSOR <OPDEF CURSOR [JFCL]>; If CURSOR UUO not defined yet, don't call it.
IFNDEF RDLINE,<FTRDLINE←←0;> FTRDLINE←←-1 ;Set to -1 to use RDLINE UUO at EDGL
IFN DECSW,<ALTMOD←←33;>ALTMOD←←175
IFN DECSW,<DMPMOD←←417;>DMPMOD←←17
IFN DECSW,<
IFN FTHID,<.FATAL> ;DECSW version of PHUSET not defined yet!
PHUSET←←0 ;Put DECSW bit value here someday
GARBIT←←0 ;No such feature in DEC
>;IFN DECSW
IFE DECSW,<
PHUSET←←100 ;Disk IOS bit for physical USETs/LOOKUPs
GARBIT←←200 ;Take error return on bad retr or disk full
RAQBIT←←1000 ;Suppress update of retrieval upon RA check when rippling
RAQMOD←←DMPMOD!PHUSET!RAQBIT!GARBIT ;Disable update of retrieval upon entering RA mode
>;IFE DECSW
IFN FTBUF,<
NCACHE←←2 ;Number of caches. Must be at least 1.
IFN DECSW,<NBUFS←←3;>NBUFS←←=18 ;Number of records of disk data buffered together.
IFN FTF2,<
PRINTX You are compiling the F2 version of E.
NBUFS←←=31 ;Bigger disk on the F2
>;IFN FTF2
IFN FTSUAI,<
IFN FTRP07,<
NBUFS←←=8 ;number of records per block (on RP07 disks)
>;IFN FTRP07
>;IFN FTSUAI
>;IFN FTBUF
;Now we define the way EDGL gets characters of edited line from the system.
IFN FTRDLINE,< DEFINE CHARIN <PUSHJ P,INCHAR>; > DEFINE CHARIN < INCHWL C >
IFNDEF PURESW<PURESW←←1> ;DEFAULT TO SHARABLE PURE UPPER SEGMENT
IFNDEF DEBSW<DEBSW←←1>
IFNDEF BOOKMD<BOOKMD←←1>
;BOOKMD NON-ZERO PERMITS /B MODE FOR READING BOOKS. 0 DISABLES /B MODE.
;Recent history of changes to E
TITLE E -- DISPLAY EDITOR FOR STANFORD↔SUBTTL FREDERICK H.G. WRIGHT II
PRINTS / You are assembling E, the Stanford A.I. Lab Display Editor.
/
COMMENT `
UP 9 Aug 82
Fixed CLSALL (EXIT) to erase top line properly (CLSEM2 clobbers E).
UP 11 Aug 82
MDDISP forces out blank lines if useful to enable flushing prev output.
UP 12 Aug 82
Moved XDIRFG to WINDAT window data area, to be preserved per file open.
UP 16 Sep 82
DISPT2 and MACLEX remember line editor that wraps around early, to make
sure following line gets redrawn accordingly.
UP 20 Sep 82
απ tries to find given file in old window before creating new one.
αβπ forces new window to be created for file.
UP 21 Sep 82
Fix to FNOWCK to ignore dead windows.
UP 22 Sep 82
CLSWIN sets WINNBR negative in window being closed, before calling WINDG2,
so that DPYWST will ignore window being closed in counting hidden windows.
DPYW12 puts hmwn on header line meaning m hidden windows and n hidden W flags.
Fixed DPYW10 to use ASCID for new flags; omits counts when 1.
Commented out the code that displays the actual numbers of hidden windows
and of W flags on. Just displays " h" or " hw" now.
All file switching commands that abort if given file is open in another
window now just switch to that window if απ preceded the command.
αβE closes all windows and exits, just like ⊗XEXIT.
UP 25 Sep 82
Changing display type corrects HGHWRD (if not window size).
DPYI2/4 rearranged to make it fix up screen size and position for all windows
upon user changing to different size display, especially to a larger one.
UP 30 Oct 82
DMDON0 doesn't remember empty display program's output line, since not run.
Makes αPα*α* no longer flush updating of screen caused by the αP.
ATTEX0 doesn't bother checking for "enough lines above" if arg is positive,
and GETOUT doesn't clear ATTMOD before going to ATTEX0.
UP 15 Nov 82
Fixed /S to work even when new file is in brand new window.
UP 22 Nov 82
⊗E and ⊗. simulate ⊗XOPEN to ensure getting file open OK.
WRRDO avoids asking about same window twice in same cmd.
IDIOT avoids warning about same window twice in same cmd.
NEWPG0 avoids trying to write out page if file can't be opened.
Routines PARTY7/8, CHKMSG, ATTREP, DIRSR4, PARB, THISPA, CANCEL,
VERTAB, MARK, BACKGO, XMARK, ATTREP
all check for success by NEWPGx and take appropriate action on failure.
Routines DELETE, LININ, FINBSL, BLOAT, BLOAT2, UPDATE
all check to make sure WRPAGE can really open the file, if necessary.
TRADEW ensures can open file (or aborts cmd), allows CLSWIG to skip on failure.
CLSEM skips on success, allows for CLSWIN to skip on failure to open window.
Routines GETOU0, CLSALL, CLSWIN/G skip on error, if can't open file.
Routines FINI0, FINISH, ZSAVE skip on success, unless can't open file.
All the file switching routines that call FINI0 at some point allow for
failure if can't open file to write it out. Generally, cmds are aborted
at the point where the failure is detected.
WRRDO says "OK, text Not written out" if readonly mode is confirmed, and
now allows ABORT response to abort current command.
UP 9 Jan 83
⊗-⊗XIECHO turns off all echoing of input to E.
⊗XPRINT types out current line and moves to next, w/o page number, without
leading CRLF, without saying OK (LGC special).
Readonly variable IECHO gives state of input echoing, like ECHO for line ed.
UP 17 Jan 83
⊗XYSET <macro name> sets up the named macro as that called by ⊗Y.
⊗0⊗XYSET types name of ⊗Y macro (no macro name argument parsed in this version).
UP 18 Jan 83
⊗XRENAME <newname> renames current file being edited to new name given.
Old filename is removed from file list, replaced by new; if new was
already in list, it's old list entry is flushed.
⊗XSEND is illegal with argument specifying number of lines to send, except
in attach mode (no arg means send whole attach buffer).
⊗XRDFAIL is like ⊗XNDFAIL but replaces old directory line, maintaining
text preceding ";⊗", and leaves arrow unmoved. Also, NDFAIL and RDFAIL
start label listing with ";⊗ ".
GRTWI3 fixed to avoid returning ptr to a closed window (⊗≠ cmd).
Fixed REQWIN to negate arg in A if ⊗-⊗# specified (this is an "immediate" cmd).
⊗XFILEDELETE marks the file to be deleted (with DELFI2) when it is exited
(e.g., with ⊗H, ⊗λ or ⊗E, but not with ⊗G). When the file is actually
deleted, it is moved to the bottom of the file stack.
DELFIL cell moved to WINDAT's window-dependent data area.
DELFIx flags are cleared by FINI4 in case doing a QUIT or equivalent without
trying to write out the flag (e.g., FINI0 isn't called).
⊗XRENAME allows option of replacing old file that has conflicting name.
MAXWNS is now one less than ZNUM temporarily to try to avoid some bug
that causes two windows to think they have the same filename (they
don't) when running out of windows and filelist spots.
UP 23 Mar 83
Added more cmd dispatch bits. FF and VT now legal (when you manage to type it)
from the line editor. FF uses indirect dispatch. Additional dispatch bits:
RDONEG, RDOZER, RDODIR: all applied to FileDelete,Open,Update extended cmds.
FileDelete command says "...no longer marked..." when clearing DELFI2 that
was previously set. Similarly for NEWPG1 and SETWRT.
Changing to ReadOnly mode clears DELFI2.
UP 24 Mar 83
⊗XRENAME now legal from directory page.
UP 28 Mar 83
Modified /H (and /0H) to refer to latest file iff part of a filename preceded
the /H; otherwise, /H (by itself, since no filename preceded it) means /1H.
Made all forms of /nH imply using the exact extension of the referenced file,
if no explicit extension preceded the /nH (thus, flushed printx).
UP 2 Apr 83
Added .PAC(ked file) to bad extension list.
⊗XRDFAIL warns if old dir line didn't already contain "⊗;".
⊗XRDFAIL no longer sets D or redraws any screen lines if no change to dir line.
UP 13 Jun 83
Merged CCRMA changes. Uses WATSIT[S,SYS] for configuration stuff.
DO E(E) makes an E, DO E(ERAID) makes an ERAID (credit to DON).
Added DVI to bad extension list and LOG and SLO (F2 microcode) to good.
Fix to ⊗XRENAME cmd to preserve high-order bits of file's date written.
UP 20 Jun 83
FBI doesn't write out error report if system is in maintenance mode.
SAVE0 doesn't write out incore text in emergency file in maint mode
unless user insists.
UP 6 Aug 83
⊗X BOISE command sends text to BOISE spooler.
UP 1 Dec 83
Fix to ⊗0⊗XCVTALTMODES to report state of altmode conversion correctly.
Fixed GORPG, GODRD, RUN and RSYS to save TMPCOR file with state of the
file stack before any windows are closed (made subroutine CLSFIN).
UP 8 Jan 84
Fixed NDFIN to adjust TOPWIN if line just added was above top of window.
Made sure it kept window at same position, cleaned up by adding subroutine.
RDFAI8 sets OLDFAS to preserve line stack during insertion of new line.
Fixed ⊗xTELLME to PUSHJ instead of JRST to FBI, since FBI looks up stack
to get address of caller's caller.
Fixed DELL2 to adjust TOPWIN if deleted lines are at or above top of window.
Cleaned up coding style in a couple of places.
UP 26 Jan 84
\AUDIO and \HARDWARE (and \MAINT duplicate) filehacks added under FTCCRMA.
FNF2 exits if no file has ever been edited (tests ZATT).
FILDEL doesn't require confirmation to delete a file unless 200 bit is on
in file protection (delete protection); also avoids msg in terse mode.
UP 6 Mar 84
Flushed duplicate \MAINT filehack under FTCCRMA.
Change the PTY subjob code so that LISPJB and OLDJOB hold, for PTY subjobs,
the negated PTY line number instead of the negated number of job on the PTY.
The ⊗#⊗XSUBJOB command as a result now take the "octal" PTY line number,
interpreted as if decimal as far as the user is concerned.
JOBCHK fixed to make sure job number in range before doing JBTSTS; else
/123456J would crash with ill uuo at JBTSTS there.
UP 25 Mar 84
NEWPG5 fixed not to go beyond last line of given page in case there are
several pages in core and the marked line number is greater than the
number of lines on the given page (e.g., from CKSUM).
UP 5 July 84
E no longer ripples unnecessarily in /-U mode when writing out a directory
(because of changes to the unextended part) (e.g., when deleting a new
page that is among several new messages that have arrived and extended
the directory. Rippling is avoided at: WRPAG2-3; OUTDIR.
GETDIR (MDFIXE) maintains EDIRSZ, the number of characters not to be written
out from the directory (representing the added pages to the file).
The following four places adjust EDIRSZ: DELPG2, DIRADD, IDDON, DIRFX3.
SWLOP2 skips over spaces between the filename and any switches.
OPNDEV checks for unassigned UDP and gives error instead of getting
system error. Device-not-disk types only device name.
UPDATE doesn't clear RH of NODUPD if takes error return early (e.g., on dir).
Also, UPDATE calls WRPAGI/IDIOT0, which allows writing file from dir page.
Flushed FTNDSP (new dispatch table bits are now permanent).
UP 16 July 84
Fixed ZSAVE to Release the channel in case user proceeds to change devices.
This fixes ⊗εU:FOO/C pre-existence check if prev device wasn't U.
FORMT6 clears ALTPPN so that if user says /R or /N after E says file found
on previous PPN, E won't require a further confirmation because of the
file's being on the previous PPN.
UP 4 Sept 84
Fixed XWRITE/XWRIT0 to check for mark already existing before checking
for mark table full.
UP 16 Oct 84
⊗XIMPRINT command spools on IMPRINT/Canon printer.
UP 9 Nov 84
Fix to SRCDP3 to erase Grinnell POG that search page number is on.
UP 27 Nov 84 at CCRMA
⊗∀ command does αN if any old line to go to, else αO.
UP 11 Dec 84
DISP and DPYCHK pick up DD color bit from PPINFO, so that reverse video can
be done on DDs.
Fixed bug at DISPTC that would clobber TOPWIN/BOTWIN at DPYCHK if the terminal
type had changed, thus causing first text display on new tty to be screwed
up and to clobber incore data structures, including DPYWIN.
UP 19 Dec 84
Added .SAM to bad extension list.
SPOOLZ checks lowcore 357 for bit of requested spooler to see if it exists.
⊗XDraw will force screen to be redrawn even inside macro (unlike ⊗V).
SPOOLC, etc., check 357 before writing file on [SPL,SYS].
UP 25 Dec 84
MAISP8 fixed to say ALL INCORE TEXT given to MAIL (not WHOLE PAGE).
Added readonly variables:
SUBOUT (subjob output mode: -1 to 2)
SUBTOP (job number or -PTY number ("decimal") of current subjob)
SUBSTK (number of subjobs in the subjob stack)
SLISP (job number of first Lisp subjob in subjob stack, negative if not at top)
SUBJOB (PTY number of first PTY subjob in subjob stack, negative if not at top)
UP 28 Dec 84
⊗XIECHO now legal from line editor (was oversight).
⊗XFFIND exchanges local and extended search strings, then does extended search
(unless arg is zero). ⊗XFXFIND exchanges local and extended search
strings, then does local search (unless arg is zero). Range of default
substitution string changes between local and extended if ⊗XFFIND or
⊗XFXFIND command given (changing range of corresponding search string).
⊗Fα<lf> and ⊗XFα<lf> load line editor with old search string of corresponding
type and allow user to edit and search (same type search) for edited string.
Similarly, ⊗F...⊗\α<lf> and ⊗XF...⊗\α<lf> load the line editor with the
old substitution string of corresponding type, allowing user to edit and
resubmit it (note: this may be useful for "reactivating" an old subst string
that is unusable otherwise because the other type of subst has been done since.
⊗Zα<cr> loads line editor with last macro name typed in ⊗Z cmd, for editing.
UP 2 Jan 85
RENAM6 fixed to type filename properly upon failure to delete old file.
Fixed DIRSRC to start dir search from first page after arrow page, even
when multiple pages are in core.
UP 5 Jan 85
⊗XESPOOL command for spooling on ESP spooler (Imagen/Canon 300 dot per inch).
UP 18 Feb 85
Fix to ⊗XRUN and ⊗XRSYS commands to set up RUNFIL+2 (core size,,start addr inc),
which ⊗XRENAME has been clobbering.
UP 22 Mar 85
Fix to ATTEX to make sure text came from current window if we're going to
turn off the W flag.
UP 23 Mar 85
Reorganized end of TRAILS so that SELWIN won't ever call what used to be
called DSTRL. To make this work, we remember for the deselected
window that it's trailer line text is wrong on the screen, by
restoring DSPTRL with the window at RSELWN (SELWIN) and by diddling
DLINES at SELWIN if DSPTRL is still on then. This avoids redrawing
a window's trailer line if you switch to another window and back without
updating the display (e.g., in a macro). Now, how to avoid redrawing
the header line in such a case: problem here is that RDSPAG calls CLRWR2
which falls into DSHED for the new window, even though that window may
never get displayed.
GETDOC avoids selecting .DIS[P,DOC] files in response to READ FOO or FOO/D.
UP 9 Apr 85
⊗XROVER command spools to the Rover printer.
UP 19 Jul 85
In SPOOLZ, moved call to SPLSTS to after closure of cmd file, matching
the change made to SPSUB. INTSPS only waits 5 seconds (not 24) for spooler.
UP 20 Jan 86
Added ⊗XPlover and ⊗XStrudel spooling commands.
UP 7 Feb 86
Added ⊗XPancake and ⊗XLathrop spooling commands.
UP 12 Feb 86
WRITT2 fixed to not loop unless ENTER error is file busy. Avoids infinite
loop if [ERR,SYS] doesn't exist.
UP 28 Feb 86
MAISP8 improvements.
UP 20 Mar 86
TDISPC says "Page 1 of 8, line 2 of 4" (formerly "Page 1 line 2 of 4").
UP 26 Mar 86
⊗#⊗XALIAS sets alias to PPN of #th file in filestack. ⊗#⊗XALIAS FOO sets
alias project to FOO and programmer name that of #th file.
UP 27 Apr 86
RENAME failure no longer says SORRY if caused by existing file with new name.
UP 30 Jun 86
Added [BB,DOC] to the list of directories searched by the READ command.
UP 29 Jul 86
Make ⊗XPointer command accept filenames that start with a device name (still
must contain some part of filename beyond first name of file).
Updated list of undefined spoolers (LATHRO←←ERR, etc.) at CCRMA.
UP 7 Aug 86
Fixed bug in ⊗XPointer for devices (previously detected bug, but apparently
failed to edit correction into code).
UP 12 Aug 86
Made table of entry points for various spooling commands, using JSP T,SPOOL0,
removing former conditionals. Now low core 357 is used everywhere instead.
UP 20 Aug 86
MAIL, SEND, REMIND, DFIND and the spool commands all check for logical
device DSK being physical DSK, giving error message if it isn't.
⊗XPointer command requires something other than switches in addition to a
filename; also, doesn't allow switches in parentheses.
UP 2 Sep 86
Fix in DIRCHK to avoid saving a byte pointer like 530700,,x which
doesn't work with KL version 400 microcode. Also, installed TESTBP macro
wherever a byte pointer is being backed up, to make sure that the byte
pointer has previously been backed up -- calls FBI if it has, but continues.
UP 4 Sep 86
Flushed \CSD filehack.
Made extended spooler commands use the SPOOLR UUO, under FTGSPL, in order
to know which spoolers are available in current system (lowcore 357 is
no longer used, with FTGSPL turned on).
UP 31 Oct 86
Another fix to DIRCHK to avoid storing an invalid page ptr in DIRREC (in
/r/f mode where the nth CRLF is last text in a record).
UP 11 Nov 86
Added .TXT to good extension list (DEXTAB) when looking for document file (/D).
UP 6 Jan 87
Changed FFDSP dispatch for β<formfeed> to allow it in readonly mode; same for
⊗XINSERT.
⊗XAPPEND allowed in unformatted file; to make this work, moved the AOS
XPAGES at APPEN1 until after call to ADDPAG at APPEN0 (ADDPAG calls
RDPAG0, which ends up calling INSDIR, which looks at XPAGES before
APPEN2 has fixed up XPLST list of extra incore pages).
Deleting a pagemark (e.g., with αβD) allowed at DELPM even in /R mode.
UP 17 Feb 87
Fixed SPLCHK to backup EXTPNT so that when an unnamed spooler such as Maple
is requested and SPLCHK is called twice (including at EXTNF), EXTPNT won't
have been advanced too far. Also added a check for spooler switches and
abort command if any found.
Changed PTY routines not to remember PTY line characteristics (LH PTYNBR), but
to set and clear individual bits using TTYSET (fixes UEDDT spcl act bug).
UP 24 Mar 87
αβ<cr> won't allow an arg bigger than 2000, to avoid running out of core.
UP 27 Mar 87
α<cr> response to "File?" prompt loads line editor with name of last file.
This is true even if the α<cr> end a non-empty line.
UP 20 Apr 87
Converted some absolute indexing for pagemarks to use symbol PMSIZE instead
of "1" and then parameterized references to record count and excess char
count bytes in PMSIZE word. New refs are to PMRCNT and PMCCNT words.
Then increased PMXTRA to 3, inserting word for PMRCNT and PMCCNT. This
allows PMRBTS to be bigger than 8 (incore page to be more than 256 records).
I hope there are no non-symbolic refs to the words that have thus been moved.
Loop at INSER4 (inserting pagemark) counts total characters in full word,
instead of a half word.
UP 28 Jun 87
⊗XTEST command hands text to SYS:TEST.DMP, a version of MAIL.
UP 2 Sept 87
Fixed FRDQRY not to set FRDDEV, in order to allow FRDQR2 to set up default
device (fixes case of ET UDP1:FOO<cr>αe ET?<cr>).
Commented out the ⊗XTEST command.
UP 14 Jan 88
WRPX3 updates the display before actual rippling of file data.
CHKMSG temporarily suppresses directory updates if deleting last page of file.
UP 22 Jan 88
Fix to WRPX3 not to update display if WINLIN contains zero (no incore page
yet -- rippling during initial formatting of file).
Fix to CHKMSG not to restore RH of NODUPD after calling UPDAT3, since RH
flags whether the directory needs to be updated.
UP 23 Jan 88
Display updating during rippling is now limited to calls from DELET1,
since display updating isn't useful for any other callers of WRPAGE.
UP 24 Jan 88
For /H, we do extension searching if implied extension not found.
Added null extension to EXTTAB (good extension list) for case of /H used
without explicit extension, so we'll take null extension first.
UP 30 Jan 88
Moved good extensions TEX and MSS ahead of PUB and POX.
UP 31 Jan 88
Removed ESPOOL command (use Maple).
UP 25 Mar 88
⊗N⊗XSHIFT command added for disabling line insertion/deletion on DM terminals
for any distance greater than N lines.
UP 23 Aug 88
Readonly variable FINDEX. is index of current file (0 to 7) in the file list.
UP 4 Jan 89
Fix to ⊗XPOINTER to avoid backing up an uninitialized byte pointer (and hence
hitting a bug trap in TESTBP macro). ⊗0⊗∃ is now just like ⊗∃ (report info),
and the file numbers typed by ⊗∃ now run from 1 to 8 instead of 0 to 7.
Readonly variable FINDEX. fixed also to report value from 1 to 8.
Fix to make readonly variable NFOUND. valid (0) after an ⊗XFIND command
with no extended search string ever given (initialize SRCN1 at FINSE2).
NFIND. is set to zero if no search string has been given for a search.
UP 19 Jan 89
Fix to LAMEPS (⊗λ and ⊗ε) to make it consistent with new ⊗∃ command.
Made ⊗∃ command use common subroutine used by ⊗λ and ⊗ε.
UP 2 Feb 89
Added new type of readonly variable: the string readonly variable.
This type can only be used in the ⊗XSET command and in ⊗0⊗Z command.
Added string readonly variables: FILE, FILEPL, TIME, DATE, DAY,
TIMSEC, DATSEC, DATTIM, DAYTIM, DAYSEC.
UP 23 Feb 89
Added option "2" to spooler commands to flag two-sided printing (kludge).
E.g., ⊗XOAK 2<return>.
UP 26 Sep 89
history: add news above here. end of comment `
;Documentation. How to put up a new E.
COMMENT ⊗ TO PUT UP A NEW E WITH AN UPPER SEGMENT, USE THE COMMANDS:
IFE DECSW,<
SU-AI VERSION TO PUT UP A NEW E ("DO E(E)") |E:
.LOAD %SE[CSP,SYS](R)%1< ↔
.S 137 ;Writes out upper as SYS:E.SEG and lower as SYS:E.DMP. |
;and then starts lower to test.
;Do not do a SSAVE or a SAVE!
;Now E will ask if you really want to put it on the System. Say "Y" if you do.
TO PUT UP A NEW ERAID (E WITH RAID AND SYMBOLS), "DO E(ERAID)") |ERAID:
.LOAD %V%S%BE[CSP,SYS](R) ↔
.S 137 ;Write SYS:ERAID.SEG and SYS:ERAID.DMP. |
;Do not do a SSAVE or SAVE.
;Now E will ask if you really want to put it on the System. Say "Y" if you do.
*** TO TEST ONLY DO AN S 136. ***
.S 136 ;Saves new lower and upper in your own disk area without
;affecting the system version.
You can also just do an SSAVE ERAID instead of the S 136, and if you want
DDT instead of RAID (to make debugging the display code more easily),
change the %V above to %D and make the following patches to avoid getting
screwed by having E see extra 400s (input chars) when proceding from DDT:
CMDSP/600000,,ALTSET (makes the 400s act like altmodes)
and EDACT+4/JRST EDGL2 (makes 400s be ignored when seen before any
activator for proceding from a breakpoint in the line editing routines (EDIT)).
>;NOT DECSW
IFN DECSW,< ;DEC VERSION TO PUT UP A NEW E
.LOAD %SE[CSP,SYS]%1<
.S 137 ;RENAMES UPPER, WRITE PROTECTS AND SETS ITS PROTECTION CONSTANT
.SSAVE SYS: E ;BE SURE TO SSave (to keep the UPPER SEGMENT around)
TO PUT UP A NEW ERAID (E WITH RAID AND SYMBOLS), DO THIS:
.LOAD %V%S%BE[CSP,SYS]
.S 137 ;RENAMES UPPER TO ERAID AND PROTECTS IT
.SSAVE SYS: ERAID
>;DECSW
ON WRITING CODE IN E THAT CHANGES TEXT
E keeps careful track of how many characters there are on each incore page
of text. Therefore, any routine that changes the incore text must update
this character count data. The normal way of doing that is to update the
cells CHARS, which counts total characters in the incore text (as the text
and pagemarks would appear on the disk, including nulls on non-final
incore pages), and LINES, which counts total incore lines. Then when the
routine has finished changing the text, it should call SETWRT, which will
update various things, including the per-incore-page character counts and
the W and D flags (which appear on the top line). When this procedure is
followed there is one critical rule to follow: TEXT CHANGES MUST ONLY BE
MADE AT (AND BELOW) THE CURRENT ARROW LINE AND MUST OCCUR ALL ON ONE
INCORE PAGE. If the arrow needs to be moved after changing the text, then
SETWRT must, repeat, MUST be called after the text is changed and BEFORE
the arrow is subsequently moved. Otherwise, a FATAL (or formerly FATAL)
error will very likely occur because of inconsistent character counts,
especially if two or more pages are in core. Also, if this standard
procedure is followed, then the text changing routine should not try to
set the WRITE or UPDTXT flags, since SETWRT will take care of those flags.
If changes need to be made to several incore pages, or to several
discontiguous sections of text, then SETWRT should be called once for each
change to a contiguous one-incore-page range of text at the current arrow
line.
DATA STRUCTURE.
Memory management is done in E by allocating variable amounts of
memory from free storage (FS), which is expandable upward from a fixed
lower bound. A block so allocated can have any positive number of data
words. The data words are surrounded by two overhead words used by the FS
system. The FS leader word for a block in use contains, in the left half,
a code indicating the use of this block, and, in the right half, the
number of words in the block, including the two overhead words. The FS
trailer word for a block in use contains zero in the left half and the
size of the block (in words) in the right half (just like the header
word). For FS blocks that are not currently in use, the header and
trailer words (which are the SAME WORD for blocks of one word) contain the
same information, namely -1 in the left half and the size of the block in
words in the right half. The normal pointer to an in-use block of FS
points to the first data word in the block (which is usually a word of
forward and backward links, but is dependent on the block's use).
Free storage is maintained in a form that can be shuffled for
compaction. For each type of FS, there is a routine that knows what needs
to be done to relocate a block of that type. Free storage is liable to be
shuffled during any call to FSGET (get a free storage block) or FSGIVE
(return a no-longer-needed free storage block) or CORCHK (core down if
possible) and possibly other routines. The bits NOCHK and NOSHUF can be
used to prevent shuffling while the calling routine has its own (non
global) pointers to any pieces of free storage. FSGET (via CORCHK) may
shuffle free storage in order to allow the job to release unneeded core to
make the job smaller. Generally, NOCHK is used (if necessary) when
calling FSGIVE and NOSHUF is used (if necessary) when calling FSGET.
The official types of FS blocks are defined in the table at SHFTB.
The currently defined types are:
Directory data for some page
Text line
Deleted text line
Macro definition
Queued Lisp mail buffer
Window
Any user of free storage that does not have a code defined at SHFTB must
lock down its free storage by turning on LOKBIT in the left half of the FS
leader word (instead of putting the use code there). The LOKBIT will
prevent the FS shuffler from trying to shuffle that FS block, so this type
of free storage should only be used temporarily. Currently the only users
of this type of FS are the search routines and CFSGET (gets a temporary
second disk cache while formatting a file).
When a routine wants to create an arbitrarily long piece of free
storage (such as a text line), it can call ENDSET which sets up free
storage expanding from the end of core. When the size of a block is
known, the macro FSFIX is used to close it up; this macro can be used
repeatedly to close off successive contiguous pieces of free storage.
When no more expandable free storage is needed ENDFIX is called to undo
the ENDSET.
INCORE TEXT REPRESENTATION
A page of text is represented in memory as a doubly-linked list of
FS blocks, each representing a single line of text. Each such FS text
block contains LLDESC (four) words of header information, followed by the
text of the line in question. If the line is an incore pagemark, there is
an additional block of data after the line's text. See pagemark data
structure below. The code in the left half of the FS leader word for text
lines is TXTCOD.
The first data word of a text FS block is a pointer word. It
contains a backward pointer in the left half pointing to the location of
the pointer word of the previous item and in the right half a forward
pointer to the location of the pointer word of the next item. The word
called PAGE contains the address of the FS block for the first line in
core; the left half of PAGE is zero. The backward pointer for the first
line points back to PAGE. The last line in core points to the word
BOTSTR, which points back to this last line in core and forward to itself.
When in the ATTACH mode, the right half of location ATTBUF points to the
first attached line and the left half of ATTBUF points to the last
attached line. When not in ATTACH mode, the word ATTBUF may contain
left over garbage.
The word which is TXTCNT words after the pointer word contains the
character counts for the line of text. The left half of the TXTCNT word
contains the total count of the characters as the line is stored on the
disk, where a TAB symbol counts 1 and the terminating CR and LF are
counted. The right half of the TXTCNT word contains the count of the
characters as they are displayed where a TAB is counted as the number of
spaces it produces and the terminating CR and LF are not counted.
Routines that want to stop processing text lines at the end of a page
(including at an incore pagemark) can test the TXTCNT word for zero; zero
means the text marks the end of a page (the line is either a pagemark or
the row of stars (BOTSTR) at the end of all incore text).
The left half of the word which is TXTFLG words after the pointer
word contains some flags. Here are the meanings of the flags that are
currently used:
PMLIN (must be sign bit) This line is an incore pagemark.
ARRBIT This is the current line (also called the arrow line).
The FS address of this line will be found in ARRLIN.
The number of this line, relative to all incore text,
will be found in ARRL (first incore line is line 1).
WINBIT This is the first line on the window (screen). The FS
address of this line will be found in WINLIN. The number
of this line, relative to all incore text, will be found
in TOPWIN (first incore line is line 1).
The right half of the word which is TXTSER words after the pointer
word contains the serial number of this text free storage block. The
serial number must be changed each time the text of the line is changed
and bears no relationship to the position of the line on the page. The
serial number is used only for figuring out which lines need to have their
display updated on the screen.
The right half of the word which is TXTWIN words after the pointer
word is used to hold the FS address of the window this line is in while
that window is deselected (moved out of WINDAT to FS). The window pointer
is stored only for lines pointed to by ARRLIN, WINLIN or XPLSTE; the pointer
is stored when the window is deselected and is updated if the window FS
itself is shuffled. The pointer is used for finding the ARRLIN, WINLIN
or XPLSTE header word in the window FS when the FS for this line is being
shuffled.
The word which is LLDESC words after the pointer word is where the
text of the line starts, stored in 7-bit bytes. Each word of text MUST
have the low order bit on (for the display UUOs to display correctly).
TABs in the text are stored as 1 to 8 spaces (the number of spaces which
the tab represents) preceded by and followed by a tab. The text of a line
always ends with a CR and a LF and then 0 to 4 nulls. An empty line
(nothing but a CR and LF) is stored as a SPACE followed by a CR and a LF
(to make sure the text erases its line on the screen when displayed).
Whether a line is actually empty or not can be detected by looking at
the display column count in the right half of the TXTCNT word.
PAGEMARK DATA STRUCTURE
Text lines that represent incore pagemarks have a slightly
different structure from that of normal text lines. The header block is
the same, and the text block is the same (but is of a fixed length for
pagemarks: LPMTXT), but an additional 3-word block is added after the
text and before the trailer (free storage word). [Formerly, the left half
of the FS trailer word was also used for data in a pagemark line, but
we needed another half word, so the FS word is moved down by one word.]
repeat 0,< ;old, before June 87
PMLINK: <ptr to previous incore pagemark>,,<ptr to next incore pagemark>
PMSIZE: BYTE (8)<# of records> (10)<# of chars> (18)page number
PMLNBR: BYTE (18)line number of pagemark line among all incore pages
>;repeat 0
PMLINK: <ptr to previous incore pagemark>,,<ptr to next incore pagemark>
PMSIZE: BYTE (18)<# of records> (18)page number
PMLNBR: BYTE (18)incore line nbr of pagemark line (8)unused (10)excess char cnt
[Obsolete:
PMLNBR is really the FS trailer word. The contents of the left half are
indicated above, and the right half contains the FS block length, as in
all FS blocks. The left half must be less then 400000 (octal) or the
FS block will look to the FS routines like it is not in use.]
PMLINK←←0 ;Unfortunately, these symbols are not always used in the source
PMSIZE←←1 ;code to reference these words. Instead, sometimes the numeric
PMLNBR←←2 ;values 0,1, and 2 are used. This should get fixed someday.
;[Jun 87 -- I hope it has been fixed. Bytes have been moved.]
The pointers in the PMLINK word point to the PMLINK word of
other pagemarks, if any. The first incore pagemark is pointed to by the
right half of the cell XPLST (left half of XPLST is zero); if there are
no incore pagemarks, XPLST will be zero. The last incore pagemark is
pointed to by the left half of the cell XPLSTE (right half is zero). If
there is no previous incore pagemark, the left half of the PMLINK word
contains XPLST. If there is no next incore pagemark, the right half of
the PMLINK word will contain zero.
The numbers of records and excess chars (less than 640) in the
PMSIZE and PMLNBR words represent the total amount of space needed by
the text on the page that ENDS with this pagemark, not counting nulls
to pad to the end of a record. The page number in the same word is the
number of the following page.
The variable XCHRS contains the total number of characters plus
nulls needed to pad out each of the incore pages except the last one.
The variable CHARS contains this same value plus the number of chars
(not including nulls) on the last incore page.
end of comment ⊗
COMMENT ⊗Dispatch tables listed
Dispatch tables are used to handle commands and for character dispatching.
A list of these follows. DSP is used as the index register for references
to these tables. This reference is often indirect,- example XCT @CTAB(C)
will be directed to a command indexed by DSP.
Note: THE PAGES LISTED BELOW ARE OUT OF DATE.
Page Page
Table Inited on Usage Unusual features
DELDSP 27 27 CONTROL D command
EDDSP 45 45 Editing
EDGDSP 47 48 Editing
CMDSP 48 16 Main command loop
CDDSP 99 99 Check directory
CPDSP 102 103 Check page
XDRDSP 112 112 Extending directory Uses B as flag for doing dir line
GDDSP 110 113 Get directory
SKPDSP 117 117 In NEWDIR routine
MD1DSP 118 119 Make directory
MD2DSP 119 120 Make directory
MDCRCK 121 121
MDLFCK 120 121
RPDSP 127 126 Read page Contains JUMPGE T, entries
RPDSP2 127 126 Pseudo FF in Read page
DGDSP 131
ODDSP 133 133 Output directory
IDDSP 134
WRDSP 165 Write page
SSCDSP 181 Search string special characters
GBPDSP 213 213
JDISP 225 217 Justify
JNDISP 225 217
JDISP 225 217
JDISP2 222 222
JADISP 222
XWRDAP 234 234 Spooling
end of comment ⊗
;F A B C D E G H I DSP J K Q T TT P COPNUM SRSIZ LPDL DPYBSZ MAXARG NBLOAT MAINTMODE TTYLOK DSKI DSKO SWP DSKSP DSKCH RPGO DSKM ... TXTPOG CRSPOG SEAPOG ARRPOG RAIPOG CT1 CTMT3 EXT1 DATE2 PPN3
;ACs, some assembly constants, I/O channels
NOLIT
;Register Most common usage
F←0 ;Flag bits
A←1 ;Argument value
B←2 ;CONTROL and META bits as stripped from command character.
C←3 ;Character
D←4 ;Dispatch table entry
E←5 ;Table location.
G←6
H←7
I←10
DSP←11 ;Dispatch table address
J←12
K←13
Q←14
T←15 ;temporary
TT←16 ;temporary
P←17 ;Always reserved as PDL pointer. (except in search routines?)
;The following macro appears in the FS checking routines to report errors.
DEFINE STOPJ
<PUSHJ P,STOPJC
>
COPNUM←←3 ;LOG OF # K OF CORE FOR TEMP COPY BUFFER
SRSIZ←←40 ;SIZE OF SEARCH STRING BUFFER
LPDL←←69
DPYBSZ←←=838*2 ;Allows two copies of text for 2 DD fields (used to be =660*2).
MAXARG←←377770 ;Maximum repeat arg. Must be less than 400000 for AOBJN counters.
NBLOAT←←3 ;Default number of records of nulls added per page for /X bloating
IFE DECSW,<
MAINTMODE←←254 ;Absolute monitor location of flag indicating sys maintenance
TTYLOK←←253 ;Same for flag locking out TTYs
>;IFE DECSW
;I/O channels
DSKI←←1
DSKO←←2
SWP←←3
DSKSP←←4 ;Used for spooling file, deleting file being renamed onto
DSKCH←←5 ;Used to write into bug file TELLME.001[ERRPPN], .002 etc.
IFN BOOKMD, <
RPGO←←4 ;CHANNEL USED TO WRITE OUT .BKP FILE IN BKPSW MODE
>;END BOOKMD
DSKM←←6 ;Channel used to read indirect file into macro definition
...←←0 ;used for parts of instructions modified at runtime
;Type of display (kept in cell called DPY)
;TTY ←← 0 ;Teletype kludge
;DD ←← 1 ;Datadisk video display
;III ←← 2 ;III vector display
;DM ←← 3 ;Datamedia video display
;III piece of glass numbers
;Pog 0 is "used" supposedly only in DD/DM DPYOUTs.
TXTPOG←←1 ;For main text
CRSPOG←←14 ;For special cursor (simulated line editor)
SEAPOG←←15 ;For search page number
ARRPOG←←16 ;For arrow
RAIPOG←←17 ;For RAID
CT1←←1 ;bucky bit value for just CONTROL
CTMT3←←3 ;bucky bit value for CONTROL-META
;offsets from beginning of LOOKUP/ENTER/RENAME block
EXT1←←1 ;extension word
DATE2←←2 ;date word
PPN3←←3 ;PPN/length word
;REDNLY COPY DIROK UPDTXT WRITE EOF EDDIR ARG DSPSCR DSPALL FILLUZ REL NEG EDITM EDBRK XPAGE UPDIR ATTMOD ENTRD CLRBF NOSHUF NOCHK OFFEND NULLIN DSPLIN TF1 PMLIN OKF TF2 TF3 DSPTRL LINSM FSCHKF NGPUSE SELFGS
;F flags, Char dispatch displacements
;RIGHT HALF FLAGS
REDNLY←←1 ;READ ONLY MODE FOR FILE BEING EDITED
COPY←←2 ;NEED TO DO COPY (← OR →)
DIROK←←4 ;HAVE COMPLETE DIR
UPDTXT←←10 ;LINE 1 CHANGED - UPDATE DIR AT WRPAGE
WRITE←←20 ;SOMETHING CHANGED - NEED TO WRITE IT
EOF←←40 ;INPUT EOF DETECTED - DO ANOTHER LOOKUP (LOSING SYSTEM!)
EDDIR←←100 ;EDITING THE DIRECTORY PAGE
ARG←←200 ;ARG WAS TYPED TO COMMAND
DSPSCR←←400 ;REDISPLAY SCREEN
DSPALL←←1000 ;REDISPLAY WHOLE SCREEN
FILLUZ←←2000 ;Editing nonstandard format file
REL←←4000 ;RELATIVE ARG (+ OR -)
NEG←←10000 ;NEGATIVE ARG
EDITM←←20000 ;DISPATCH IS FROM LINE EDIT
EDBRK←←40000 ;(WITH EDITM) COMMAND TYPED IN MIDDLE OF LINE
XPAGE←←100000 ;WILL EXPAND FILE FOR PAGE
UPDIR←←200000 ;NON-TEXT CHANGE TO DIR
ATTMOD←←400000 ;IN ATTACH MODE
;LEFT HALF FLAGS
ENTRD←←1 ;EDIT FILE HAS BEEN ENTERED
CLRBF←←2 ;CLEAR OBUF AFTER OUTPUT
NOSHUF←←4 ;DON'T SHUFFLE FREE STORAGE during FSGET (or FSGIVE)
NOCHK←←10 ;DON'T TRY TO CORE DOWN (or shuffle) during FSGIVE
OFFEND←←20 ;ARROW ON LINE N+1
NULLIN←←40 ;CURRENT LINE IS EMPTY
DSPLIN←←100 ;Number of arrow line has changed.
TF1←←200 ;TEMP FLAG
PMLIN←←400 ;CURRENT LINE IS PAGE MARK
OKF←←1000 ;SHOULD TYPE "OK"
;New flags added by ALS and ME
TF2←←2000 ;Temp flag. Used by justify routines, GETDIR, PGCHAR, CLSEM/ALL
TF3←←4000 ;Temp flag. Used by justify routines, PGCHAR (which calls DISP)
DSPTRL←←40000 ;Trailer line needs to be recalculated
LINSM←←100000 ;Line insert mode
FSCHKF←←200000 ;Free storage has been changed by FSGIVE or FSGET
NGPUSE←←400000 ;Network Graphic User (unused)
;Flags restored at SELWIN -- all file and window specific flags!
SELFGS←←<ENTRD!OFFEND!NULLIN!PMLIN!DSPTRL,,REDNLY!DIROK!UPDTXT!WRITE!EOF!EDDIR!FILLUZ!XPAGE!UPDIR>
; E character dispatch displacements:
; 0 null NSPEC
; 1 rubout NSPEC
; 2 CR LSPC
; 3 LF LSPC
; 4 TAB LSPC
; 5 FF LSPC
; 6 ALT LSPC
; 7 misc
; 10 ⊗;
; 11 digit NUMF
;Char table flags, command dispatch flags, misc flags and values ;⊗ NSPEC FSPC LSPC NUMF DSPC LETF LT2F SSP1 SSP2 EDOK NOEDIT DOEDIT RE.ED NOATT NORDO SACMD SSCMD MSGCMD RDONEG RDOZER RDODIR DIRREC DIRFLG DIRWIN LPDESC DPBIT D1BIT RPMASK RPBYTE DIRXTR EDCHRL EDWRDL TXTCNT TXTFLG TXTSER TXTWIN LLDESC PMARK ARRBIT WINBIT PMLINK PMSIZE PMRCNT PMRBTS PMRPOS PMCCNT PMCBTS PMCPOS PMLNBR PMXTRA PMSIZE PMRCNT PMRBTS PMRPOS PMLNBR PMCCNT PMCBTS PMCPOS PMXTRA LOKBIT FRDPAR FRDNAM FRDEXT FRDPRJ FRDPRG FRDDEV FRDGRT FRDDOT FRDADD FRDTMP FRDRUN FRDALL FRDAL2
;Character table flags (LH of CTAB).
NSPEC←←400000 ;STANDARD SPECIAL CHAR (NULL OR RUBOUT) - MUST BE SIGN
FSPC←←200000 ;FILE NAME DELIMITER
LSPC←←100000 ;SPECIAL CHAR IN LINE
NUMF←←40000 ;DIGIT
DSPC←←20000 ;SPECIAL DIR CHAR
LETF←←10000 ;LETTER - WITH LT2F => LOWER CASE
LT2F←←4000 ;ALONE => $%_ (not a delimiter in searches)
SSP1←←2000 ;TYPE 1 SPECIAL SEARCH STRING CHAR
SSP2←←1000 ; " 2 " ...
;740 ;ref'd via EDOK below
EDOK←←40 ;RIGHTMOST OF 4 BITS (SHIFT BY CONTROL BITS) FOR LINE EDITOR LEGALITY
;37 ;not available for flags -- always used for indexing with (DSP).
;Command Dispatch Flags (LH of table pointed to by DSP: CMDSP or XCMDSP)
;400000 ;(sign bit) means immediate command, dispatches quickly w/no checks
NOEDIT←←200000 ;DISPATCH DIRECTLY FROM LINE EDIT WITHOUT REPLACING LINE
DOEDIT←←100000 ;REPLACE LINE BEFORE DISPATCHING FROM LINE EDIT
;If neither of the above, re-edit line at same cursor pos (cmd is illegal)
RE.ED←←NOEDIT!DOEDIT ;Both bits on means execute command, then re-edit line.
NOATT←←40000 ;ILLEGAL IN ATTACH MODE
NORDO←←20000 ;ILLEGAL IF READ-ONLY
;10000 ;USER MODE BIT MUST BE UNUSED
SACMD←←4000 ;Uses distance to found string in search as numeric arg to cmd
SSCMD←←2000 ;SSCMD without SACMD means XCT -1(D) before returning from SREAD
;SSCMD with SACMD means XCT -1(D) after successful search, at FOUND
MSGCMD←←1000 ;SPECIAL ACTION WHEN entered FROM MSG COMMAND (PARTIAL SIGN)
;740 ;ref'd via EDOK shifted by bucky bit value -- on means cmd illegal
;37 ;used to indicated indirecting to another table (e.g., for CR cmd)
;Additional Flags for command dispatching -- from Additional Flag tables
;Left Half flags (no Right Half flags yet)
RDONEG←←200000 ;Ignore NORDO (cmd legal) if arg is negative
RDOZER←←100000 ;Ignore NORDO (cmd legal) if arg is zero
RDODIR←←40000 ;(w/NORDO) Command legal on directory page if not /R
;Offsets within directory entry from the link word
DIRREC←←1 ;record number where this page starts (high bits are byte and word)
DIRFLG←←2 ;flags,,length of text for this directory line (after required nbrs)
DIRWIN←←3 ;right half may hold ptr to window FS for window this page is in
LPDESC←←4 ;beginning of text
;Bits in DIRFLG LH
DPBIT←←400000 ;DIRPT ENTRY (last incore page) (must be sign bit)
D1BIT←←200000 ;DIRP1 ENTRY (first incore page)
RPMASK←←77 ;MASK FOR RELATIVE PAGE # FIELD (for incore pagemarks)
RPBYTE←←<220600,,> ;BYTE PNTR FOR ABOVE
DIRXTR←←=12 ;number of extra chars per line of directory (C00001 00001)
EDCHRL←←=126 ;Assumed safe display char. count for line editor
;140 less 2 for CRLF and less 12 for 6 TAB's
EDWRDL←←=32 ;Max. words in core per line for line editor (135)/5+5
;Offsets from the ptr word in a text line's FS block
TXTCNT←←1 ;Char counts: chars as on disk,,columns used by text line
TXTFLG←←2 ;Flags (in left half)
TXTSER←←2 ;Serial number (in right half)
TXTWIN←←3 ;Right half may hold ptr to window FS for window this line is in
LLDESC←←4 ;Beginning of text
;If you CHANGE ANY of the ABOVE 4 VALUES, FIX THE BLOCKS called DUMMY,DOTS,DUMSTR,DUMDOT.
;(Formerly TXTFLG was 1, others same as now)
;The following bits are set in left half of word at TXTFLG offset from pointer word.
;(The right half of this word is now used for the serial number.)
PMARK←←400000 ;THIS LINE IS A PAGE MARK (must be sign bit)
ARRBIT←←200000 ;LINE IS ARRLIN (line number is in ARRL)
WINBIT←←100000 ;LINE IS WINLIN (line number is in TOPWIN)
;The following are offsets within the extra words at the end of pagemark line.
;See documentation of these on page 4.
PMLINK←←0 ;<ptr to previous incore pagemark>,,<ptr to next incore pagemark>
repeat 0,< ;old values
PMSIZE←←1 ;BYTE (8)<# of records> (10)<# of chars> (18)page number
PMRCNT←←1 ;word holding #-of-records count for page mark
PMRBTS←←=8 ;number of bits in #-of-records byte in PMRCNT
PMRPOS←←=7 ;last bit in #-of-records byte in PMRCNT
PMCCNT←←1 ;word holding #-of-chars count for page mark
PMCBTS←←=10 ;number of bits in #-of-chars byte in PMCCNT
PMCPOS←←=17 ;last bit in #-of-chars byte in PMCCNT
PMLNBR←←2 ;BYTE (18)line number of pagemark line among all incore pages
PMXTRA←←2 ;number of extra words after text before FS trlr
>;repeat 0
repeat 1,< ;new values
PMSIZE←←1 ;BYTE (18)<# of records> (18)page number
PMRCNT←←1 ;word holding #-of-records count for page mark
PMRBTS←←=18 ;number of bits in #-of-records byte in PMRCNT
PMRPOS←←=17 ;last bit in #-of-records byte in PMRCNT
PMLNBR←←2 ;BYTE(18)incore line nbr of pagemark line (8)unused (10)char cnt
PMCCNT←←2 ;word holding excess char count for page mark
PMCBTS←←=10 ;nbr of bits in excess-char-cnt byte in PMCCNT (byte always ≤ =637)
PMCPOS←←=35 ;last bit in excess-char-cnt byte in PMCCNT
PMXTRA←←3 ;number of extra words after text before FS trlr
>;repeat 1
LOKBIT←←200000 ;LOCKS DOWN FS BLOCK (CAN'T BE SHUFFLED)
;Flags used in left half of D in FRD and related file-specification code
;;;;;;;;37 bits must be unused to allow indirect addressing.
; except for flags to tell FRD0 how to parse special filenames (SLISP),
; provided caller doesn't use indirection through D.
;Special flags, cannot be set by FRD, only can be tested by FRD:
FRDPAR←←20 ;Filename can end with a left or right paren.
;Regular flags:
FRDNAM←←40 ;A new name was typed
FRDEXT←←100 ;An extension was typed
FRDPRJ←←200 ;A project name was typed
FRDPRG←←400 ;A programmer name was typed
FRDDEV←←1000 ;A device was specified
FRDGRT←←2000 ;Extension was greater-than sign--find largest numeric ext.
FRDDOT←←40000 ;Force FILSTR to output extension even if null
FRDADD←←100000 ;Reading this name to insert in filelist, not to edit now
FRDTMP←←200000 ;TMPCOR has been read and may have to be overruled
;FRDRUN must be sign bit.
FRDRUN←←400000 ;Used by XRUN command to get filename without switches
;Also used by FILSTR to suppress typing of switches
FRDALL←←FRDNAM!FRDEXT!FRDPRJ!FRDPRG!FRDDEV ;Flags for whole filename given
FRDAL2←←FRDNAM!FRDEXT!FRDPRJ!FRDPRG ;Flags for whole filename, less device
;Bits for GETLIN, SETACT, DEVCHR. S 136 and S 137 code. ;⊗ DD DM III PTY SPCACT SUPCCR EMODE BSACT ALLACT SUPERS SUPEOL SUPLFE DVDSK DVUDP MININT ADRSIZ CAN BLINK ZZ SAVOK ESTART ESTERR SORRY FATAL SORRX SORRJ SORRF
IFE DECSW,<
DD←←20000 ;RUNNING ON DATA DISK (BITS FROM GETLIN)
DM←←40000 ; " " DATAMEDIA
III←←400000 ; " " III
PTY←←4000 ; " " PTY
>;NOT DECSW
SPCACT←←100 ;GETLIN bit that enables special activation mode
SUPCCR←←2 ;BREAK TABLE BIT TO SUPPRESS CTRL1-CR HACK
EMODE←←10 ;Break table bit to place 400 after last char when activating
BSACT←←20 ;Break table bit to activate on BS in empty line, for EVALUP
ALLACT←←40 ;Break table bit to make all ctrl chars and BS active unless re-editing
SUPERS←←100 ;Break table bit to suppress erasure of line editor after activation
SUPEOL←←400 ;Break table bit to suppress activation by line ed cmd at eol
SUPLFE←←2000 ;Break table bit to suppress echo of LF inserted after CR
DVDSK←←200000 ;DISK BIT FROM DEVCHR
DVUDP←←100000 ;UDP bit from DEVCHR
MININT←←23 ;LOWEST INT BIT #
ADRSIZ←←17 ;# BITS NEEDED TO ADDRESS PERMANENT CODE
CAN←←30 ;DM control character CANCEL
BLINK←←16 ; " " "
ZZ←←.
IFE DECSW,<
;This code changed drastically 2/16/77 to save an upper segment called E.SEG etc.
;Use S 137 to reload the system E. Note: NO SSAVE!
;Use S 137 with a DO DOE(2) load to reload system ERAID.
;Use S 136 for test purposes. This puts the code in your own area.
;The lower is started at BEGS and it in turn reloads the upper.
LOC 136
JRST [ MOVE T,['DSK ']
MOVEM T,ESTART ;For saving upper on DSK not as SYS
MOVEM T,LOKBL0 ;For saving lower on DSK not as SYS
MOVEM T,BEGS2A ;For reloading upper on an RU start
OUTSTR [ASCIZ/Saving on your own area./]
JRST 137]
LOC 137
IFN PURESW,<
JRST [ MOVSI 'E ' ;UPPER NAME ONCE SYSTEMIFIED
SKIPE JOBDDT↑
MOVE ['ERAID '] ;UPPER NAME FOR VERSION WITH RAID
MOVEM LOKBLK ;Used to write upper
MOVEM LOKBL1 ;Used to write lower
MOVEM LOKBL2 ;Used by the retrieval code at BEGS
MOVE P,[-LPDL+1,,PDL] ;Temp stack for checksum compute
MOVS T,ESTART
CAIE T,'SYS'
JRST SAVOK ;Save device not SYS
OUTSTR [ASCIZ/Type Y to save on the system? /]
PUSHJ P,YESCHK
JRST SAVOK
EXIT ;Nope
SAVOK: PUSHJ P,CHKUP ;Check upper segment before setpro
MOVEM T,CHKSUM
INIT DSKO,17
ESTART: SIXBIT /SYS/ ;Replaced by SIXBIT /DSK/ if an S 136 start for test.
0
JRST ESTERR
MOVEI T,0
DSKPPN T,
MOVEM T,LOKBLK+PPN3 ;Remember PPN where segment is gonna be stored
MOVEM T,LOKBL1+PPN3
MOVEM T,LOKBL2+PPN3
SETZM LOKBLK+DATE2
HLLZS LOKBLK+EXT1
ENTER DSKO,LOKBLK
JRST ESTERR
MOVE T,JOBHRL↑
SUBI T,377777
MOVNI T,(T)
MOVSI T,(T)
HRRI T,377777
SETZ T+1,
OUT DSKO,T ;Write out the upper as .SEG
SKIPA
JRST ESTERR
RELEAS DSKO,
SETZM JOBJDA+DSKO
OUTSTR [ASCIZ/
Upper .SEG saved.
E/]
SKIPE JOBDDT↑
OUTSTR [ASCIZ/RAID/]
MOVSI T,LOKBL0
SWAP T,
OUTSTR [ASCIZ/.DMP saved./]
EXIT]
>;PURESW
ESTERR: OUTSTR [ASCIZ/137 TROUBLE, BEWARE!/]
JRST 4,137
IFG DEBSW-PURESW,<
JRST [ JSP E,PURINI
EXIT]
>;DEBSW-PURESW
>;NOT DECSW
IFN DECSW,<
LOC 137
IFN PURESW,<
JRST [ MOVSI 'E ' ;UPPER NAME ONCE SYSTEMIFIED
SKIPE JOBDDT↑
MOVE ['ERAID '] ;UPPER NAME FOR VERSION WITH RAID
SETNAM
MOVEI 0
SETUWP ;Write enable upper for checksum
JRST 4,137 ;Not privileged
MOVE P,[-LPDL+1,,PDL] ;Temp stack for checksum compute
PUSHJ P,CHKUP ;Check upper segment before setpro
MOVEM T,CHKSUM
MOVNI 1
SETUWP
JRST 4,137
CALLI 12]
>
IFG DEBSW-PURESW,<
JRST [ JSP E,PURINI
CALLI 12]
>;DEBSW-PURESW
>;DECSW
ORG ZZ
FOR @! FOO IN(SORRY,FATAL,SORRX,SORRJ,SORRF)
<DEFINE FOO(X)
< FOO!U [ASCIZ ∂X∂]>
>
Comment ⊗
SORRY← types out a message and returns
FATAL← types out a message, writes an error report and halts
SORRX← types out a message and skips unless the message was suppressed by SILENCE
SORRJ← types out a message and returns unless the msg was suppressed, in which
case SORRJ pops up a level
SORRF← types out a message and forces all macros to be aborted no matter what.
end of comment ⊗
;GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
;Macro to test a byte ptr that is about to be backed up, to make sure
;it hasn't already been backed up off the high-end of the word.
;Assumes we're dealing with standard 7-bit byte pointers.
;Makes an error report if byte ptr about to become doubly backed up.
DEFINE TESTBP(X)
<SKIPGE X
PUSHJ P,FBI>
DEFINE GETCHR(X)
<ILDB C,INPNT
SKIPGE X,CTAB(C)
XCT @CTAB(C)>
DEFINE GETCH1(X)
<ILDB C,INPNT
TDNE X,CTAB(C)
XCT @CTAB(C)>
DEFINE GETCH2(X,Y)
< ILDB C,Y
TDNE X,CTAB(C)
XCT @CTAB(C)>
DEFINE FSFIX(X,Y)
< HRRI Y,(X)
SUB Y,FSEND
LEG MOVEM Y,@FSEND
LEG HRRZM Y,-1(X)
HRRZM X,FSEND>
IFN DEBSW<DEFINE TSTSHF
< SKIPE SHFMOD
PUSHJ P,MOVIT>>
IFE DEBSW<DEFINE TSTSHF<>>
DEFINE CW(C1,D1,C2,D2,C3,D3)<BYTE(8)D1,D2,D3(3)C1,C2,C3,4>
;THESE MACROS MAKE A LINKED LIST AROUND AND THROUGH
;PURE AND UNPURE PARTS FOR CHECKSUMING THE PURE PARTS
;AN ERROR WILL RESULT IF THE SAME MACRO IS CALLED
;TWICE WITHOUT CALLING THE OTHER MACRO.
%SEG←←0
IFE PURESW<
DEFINE PURE<IFN %SEG<!> %SEG←←1 PURBEG←←.>
DEFINE IMPURE<IFE %SEG<!> %SEG←←0
PURBEG,,PURLK2↔PURLK2←←.-1
PURBEG,,PURLNK↔PURLNK←←.-1>
PURLNK←←PURLK2←←0>
;THESE MACROS SET RELOCATION TO THE PROPER SEGMENT FOR PURE OR UNPURE CODE
;AN ERROR MESSAGE WILL RESULT IF THE SAME MACRO IS CALLED TWICE WITHOUT
;CALLING THE OTHER MACRO.
IFN PURESW<
TWOSEG
RELOC 400000
RELOC
DEFINE PURE<IFN %SEG<!> %SEG←←1 RELOC>
DEFINE IMPURE<IFE %SEG<!> %SEG←←0 RELOC>>
;THIS MACRO SHOULD PRECEDE A LINE OF CODE WHICH CAN
;GENERATE A LEGAL ILL MEM REF.
LEGNUM←←0
DEFINE LEG<FOR @! X←LEGNUM,LEGNUM<LEG!X←←.> LEGNUM←←LEGNUM+1
>
DEFINE UUOS<FOR @! X IN(TYPCHR,TYPDEC,TYPOCT,TYPSIX,TYPMAC,SORRYU,<FATALU>
,SORRXU,SORRJU,SORRFU)>
ZZ←←0
UUOS<ZZ←←ZZ+1
OPDEF X[ZZ⊗33]
>
NUUOS←←ZZ+1
EXTERN JOBREL,JOBFF,JOBAPR,JOBTPC,JOBDDT,JOBREN,JOBOPC,JOBCNI,JOBHRL
IFE DECSW,<
EXTERN JOBJDA,JOBHCU,JOBENB
>
IFN DECSW,<
JOBENB←←43 ;DEC IN THEIR INFINITE WISDOM
JOBHCU←←72 ;DOESN'T THINK WE NEED TO KNOW THESE.
JOBJDA←←75 ;THEY MUST NOT HAVE MET FRED WRIGHT.
DEFINE INWAIT<
PUSH P,TT
MOVSI TT,24
HIBER TT,
JFCL ;NOT IMPLEMENTED
POP P,TT
>
DEFINE DPYOUT (X,Y)<
IFDIF <Y><><
UPGIOT Y
>
IFIDN <Y><><
UPGIOT X
>
>
DEFINE OUTFIV (X)<
PUSH P,X
PUSH P,[0]
OUTSTR -1(P)
SUB P,[2,,2]
>
DEFINE LKPMAC (LKP)<
PUSHJ P,DECLKP
JRST .+2
LKP
>
;This macro replaces LOOKUP UUOs or XCTs of LOOKUPs with a subroutine call
;which does an extended LOOKUP and puts the (sigh) negative swapped word
;count where Fred expects it. It is designed to deal with things like a
;skip instruction before the LOOKUP.
>;DECSW
IFE DECSW,<
DEFINE LKPMAC (LKP)<
LKP
>
>;NOT DECSW
PURE
;BEG BEGSYS BEGACT BEGRPT BEGRP2 BEGDBG
;Here are a bunch of pointers for JFR's hopeless program to find things via.
0,,PAGE ;data structure headers and trailers
BOTSTR
ATTBUF
IFE DECSW,<
JBICNI ;interrupt block and ESCIEN flag
>
IFN DECSW,<
0
>
FSGET ;storage allocation
FSGIVE
DRAW ;display routine
IFE DEBSW,<JRST 4,.>
IFN DEBSW,<JRST BEGDBG>
JRST BEGRPT
BEG: JRST BEG0 ;RUN OR ET COMMAND
JRST BEGRPG ;RPG START. AC'S CONTAIN PARAMS
MOVEM 16,EPDL ;SYSTEM AXXCOM START
MOVEM 17,EPDL2 ;17[SIXBIT COMMAND, 16[ASCII DELIM
JSP P,INIT ;INITIALIZE
MOVE T,EPDL2 ;GET COMMAND NAME
MOVEM T,SYSCMD ;STOW IT
MOVE A,[440700,,BUF] ;INITIAL BYTE pointer
MOVE C,EPDL ;INITIAL CHARACTER IN "SCAN"
; PUSHJ P,TYIT
; JRST BEGACT
INWAIT
HRLOI T,377777 ;SET T INFINITE
PUSHJ P,RSCN4A ;SCAN REMAINER OF COMMAND FOR ARGS
BEGSYS: LDB C,[301400,,SYSCMD] ;GET 2 CHARACTERS OF COMMAND NAME
PUSHJ P,SYSCCK ;DO WE KNOW THEM
JRST BEG1 ;YES. NOW WE READ FILE NAME FROM TTY
JRST BEG0 ;DONT UNDERSTAND COMMAND. RESCAN.
BEGACT: MOVE T,[440700,,[ASCIZ /
/]]
MOVEM T,TYIPNT
JRST BEGSYS
;Here from S-1 startup -- edit file given in tmpcor file.
BEGRPT: JSP P,INIT ;INITIALIZE
;Enter below from S+1 (RPG) startup with null filename given in AC.
BEGRP2: PUSHJ P,TMPRED ;TRY TO READ TMPCORE FILE
JRST BEG0A ;FAILED
PUSH P,TYIPNT ;SAVE pointer TO ARGS
MOVEM G,TYIPNT ;POINT TO COMMAND
PUSHJ P,GETNAM ;AND READ IT
MOVEM A,SYSCMD
POP P,TYIPNT ;NOW POINT TO ARGS AGAIN
MOVE H,[440700,,[ASCIZ /
/]] ;Pretend user typed ET<cr>
LDB C,[301400,,SYSCMD] ;GET 2 CHARACTERS OF COMMAND NAME
MOVEI D,EDFIL ;Place to put filename
SETZM BAKPLC ;Clear the page stack
PUSHJ P,SYSCCK ;DO WE KNOW THEM
JRST BEGSY5 ;Yes, read filename(s) from tmpcor
JRST BEG0 ;DONT UNDERSTAND COMMAND. RESCAN.
IFN DEBSW,<
;Here from S-2 startup for debugging.
;Read simulated monitor command line from TTY.
BEGDBG: JSP P,INIT ;HERE FOR DEBUGGING. INITIALIZE
INWAIT ;WAIT FOR SOMETHING TO BE TYPED
HRLOI T,377777 ;SET CHARACTER COUNT TO INFINITE
PUSHJ P,RSCAN0 ;READ COMMAND, AVOID RESCAN
JRST BEG0A ;ACT NORMAL
>
;BEGRPG RPGACS RPGPPN RPGEXT RPGFIL RPGLIN RPGPAG
COMMENT ⊗
Here are the RPG mode startup flags (right half of extension word in ACs):
Flags Meaning other→ F-Flag Word flag
100000 /N no directory EDFIL+4
200000 /R readonly REDNLY←←1 RDONLY
400000 /C creating CREASW
END OF COMMENT ⊗
;HERE AT RPG STARTUP.
BEGRPG: MOVEM 17,RPGACS+17
MOVEI 17,RPGACS
BLT 17,RPGACS+16 ;SAVE RPG PARAMETERS
JSP P,INIT0 ;INITIALIZE
HRRZ T,RPGLIN
CAILE T,=9999
SETZB T,RPGLIN
MOVEM T,SLINE ;STARTING LINE NUMBER
SKIPGE T,RPGPAG
MOVEI T,0
MOVEM T,SPAGE ;STARTING PAGE NUMBER
MOVE T,RPGDEV ;Get device
DEVCHR T, ;Legal device?
JUMPE T,.+2 ;No, ignore it
SKIPA T,RPGDEV ;Yes, use it
MOVSI T,'DSK'
MOVEM T,EDFIL-1 ;DEVICE
SKIPN T,RPGFIL
JRST BEGRP2 ;NO FILE NAME - LOOK IN TMPCOR FILE.
MOVEM T,EDFIL ;SAVE EDIT FILE NAME
SKIPN T,RPGPPN
MOVE T,PPN
MOVEM T,EDFIL+PPN3 ;EDIT FILE PPN
MOVE T,RPGEXT
HLLZM T,EDFIL+EXT1 ;EDIT FILE EXT
SETZM EDFIL+DATE2
SETZM EDFIL+4
TRNE T,200000 ;INSPECT MODE FLAGS
SETOM RDONLY ;/R READONLY
HRLOI TT,1
ANDCM TT,RDONLY ;Don't set /N flag in /R mode
TRNE T,100000
MOVEM TT,EDFIL+4 ;SET /N NO DIRECTORY
TRNE T,400000
SETOM CREASW ;CREATING
JRST BEG3
IMPURE
RPGACS: BLOCK 11;0:10 ;PLACE TO SAVE RPG PARAMETERS
RPGPPN: 0 ;11
RPGDEV: 0 ;12
RPGEXT: 0 ;13
RPGFIL: 0 ;14
RPGLIN: 0 ;15
RPGPAG: 0 ;16
0 ;17
PURE
;⊗ BEG0 BEG0A BEG1 BEGSY2 BEGSY3 BEGS3A BEGSY4 BEG1A BEG2A BEG2 FNERR FLOSE FNERR0 BEGBKP BEGSY1 BEGSY5 TYEDFL
;Here from normal startup.
BEG0: JSP P,INIT ;INITIALIZE
PUSHJ P,RSCAN ;RESCAN TTY
BEG0A: SKIPN TYIPNT ;WAS THERE ANYTHING THERE?
OUTSTR [ASCIZ /
File? /] ;NO. ASK FOR SOME.
BEG1: MOVEI D,EDFIL ;Place to put filename (enter here from FNF2)
SETZM BAKPLC ;Clear the page stack
SKIPE ZATT ;Are we coming from E command or monitor command?
JRST BEGSY2 ;E command, ignore TMPCOR
LDB C,[301400,,SYSCMD] ;GET THE COMMAND NAME
PUSHJ P,CRECHK ;WAS IT CREATE?
SETOM CREASW ;YES. SET FLAG
IFN BOOKMD,<
CAIN C,'BO' ;"BOOK" COMMAND?
JRST BEGBKP ;YES
>;END BOOKMD
CAIN C,'RE' ;"READ" COMMAND?
SETOM READSW ;YES, THAT MEANS DOCUMENT READING MODE
JUMPN C,BEGSY1 ;WAS IT SOME SORT OF COMMAND AT ALL?
BEGSY2: PUSHJ P,FRD ;READ FILE NAME (TTY OR RESCANNED DATA)
JRST FNERR ;OOPS.
BEGSY3: SKIPN EDFIL
EXIT ;No name, no edit
SKIPE ZATT ;Are we coming from E command or monitor command?
JRST BEGS3A ;E command, ignore original monitor command
LDB TT,[301400,,SYSCMD] ;Get the monitor command name
CAIN TT,'ER' ;"EREAD" COMMAND?
SETOM RDONLY ;YES, THAT MEANS READONLY MODE
BEGS3A: HLLM D,SRCFIL
HLLM D,DSTFIL
IFN BOOKMD,<
SKIPN BKPSW ;"BOOK" COMMAND USED?
JRST BEGSY4 ;NO
PUSH P,C
PUSHJ P,BKPRED ;LOOK FOR <FILENM>.BKP FILE (LIKE RPG FILE)
POP P,C
SETOM BOOKSW ;BKPSW IMPLIES BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY
JRST BEG2A ;Ignore additional filenames
BEGSY4:
>;END BOOKMD
SETZM TRMCHR ;Assume no arrow after filename
CAIE C,"←"
CAIN C,"→"
TROA F,COPY
JRST BEG1A
MOVEM C,TRMCHR#
MOVEI D,EDFIL2
PUSHJ P,FRD
JRST FNERR
SETZM CREASW ;We're making a copy anyway, so don't screw him
MOVE A,TRMCHR ;Get back the arrow
MOVE G,[,SRCFIL-EDFIL2(A)]
CAIN A,"→" ;Is the second file named really the destination?
HRRI G,DSTFIL-EDFIL2 ;Yes
MOVE A,[-7,,EDFIL2-2]
HRRZM A,@G
AOBJN A,.-1
HLLM D,EDFIL2(G)
MOVEI A,0
EXCH A,@SRCFIL-2 ;Any /F given for source file really goes on
SKIPN @DSTFIL-2 ; dest file, unless there is one there already
MOVEM A,@DSTFIL-2 ;Indicate /F count in dest file
SKIPE EDFIL2-2 ;Does second (dest) file want /F?
HRLOM D,EDFIL+4 ;Yes, can't do that (force illegal formatting)
SKIPE EDFIL2-2
SETOM QUIETF ;Also suppress any questions in the mean time
SKIPN @SRCFIL
SETOM CREASW
BEG1A: CAIE C,","
JRST BEG2A ;Save some BLTs if no additional filenames
MOVSI TT,MARKS
HRRI TT,ZTMPBF
BLT TT,ZTMPBF+NMARKS-1 ;Save edit file's typed-in marks during FRDMOR
MOVSI TT,BAKPLC
HRRI TT,ZTMPBF+NMARKS
BLT TT,ZTMPBF+NMARKS+NBACK+NBACK ;Save page stack (and windows) and size
PUSHJ P,FRDMOR ;See if more than one filename was typed
JRST FNERR ;Bad subsequent filename
MOVSI TT,ZTMPBF
HRRI TT,MARKS
BLT TT,MARKS+NMARKS-1 ;Restore typed-in marks
MOVSI TT,ZTMPBF+NMARKS
HRRI TT,BAKPLC
BLT TT,BAKPLC+NBACK+NBACK ;Restore page stack, windows, and stack size
BEG2A: PUSHJ P,TYIT
JRST BEG3
BEG2: PUSHJ P,TYI ;Gobble rest of input till activator
JRST BEG3
JRST BEG2
FNERR: CAIN C,215 ;maybe we saw αCR
SKIPLE CURMAC ;yup, skip unless expanding macro
JRST FNERR0 ;no αCR or macro in progress, no free PTLOAD
SKIPL D,ZINDEX ;get ptr to latest file, skip if none
SKIPN ZDATA(D) ;make sure we have a filename
JRST FNERR0 ;must not have been editing yet
ADDI D,ZDATA ;ptr to latest filename
HRLI D,FRDRUN ;suppress switches in generated filename text
MOVE A,[POINT 7,BUF] ;place to put text of filename
MOVEM A,TYOPNT ;don't type filename, store in buffer
PUSHJ P,FILSTR ;generate text of filename, without switches
MOVEI A,15
IDPB A,TYOPNT ;terminate string
PTLOAD [0↔BUF] ;load line editor with previous filename
SETZM PIFLAG ;don't abort automatically right now
SETZM SUPILF ;clear /? flag, just in case
JRST FNF2 ;go read filename
FLOSE: SUB P,[1,,1]
FNERR0: AOSE SUPILF ;skip if suppressing this message (from "/?")
OUTSTR [ASCIZ / Illegal file specification./]
SETZM PIFLAG ;Don't let us abort automatically
JRST FNF1
IFN BOOKMD,<
BEGBKP: SETOM BKPSW ;BKPSW MEANS WE WERE STARTED BY "BOOK" CMD TO USE .BKP FILE
SETOM BOOKSW ;BOOKSW MEANS WE ARE IN /B MODE--NO FILE MODIFYING ALLOWED
>;END BOOKMD
BEGSY1: MOVE H,TYIPNT ;Save pointer to typed string
SKIPN TCPNT
PUSHJ P,TMPRED ;Read tmpcor file
JRST BEGSY2 ;No tmpcor file
BEGSY5: PUSHJ P,FRD ;Read filename from tmpcor file
SETZM SUPILF ;Bad format in tmpcor -- shouldn't happen
PUSHJ P,ZSTORE ;Store filename,modes,page,line,page stack,marks
LDB T,TYIPNT ;See what the last char read was (if byte ptr there)
MOVEI TT,15
CAIN T,","
DPB TT,TYIPNT ;Replace comma with CR to terminate PTLOAD of TCPNT
PUSHJ P,FRDMOR ;Read more filenames from tmpcor
SETZM SUPILF ;Bad format in tmpcor -- shouldn't happen
MOVEM H,TYIPNT ;Restore pointer to typed string
SETZM NODUPD ;Clear /-U switch to allow directory updating
SETOM SBLOAT ;Assume not bloating file
SETOM SPAGE ;Use default starting page and line, which may come
SETOM SLINE ; from filelist if editing file listed in tmpcor
SETOM SWIND ;Also default starting window
SETOM SPROT ;No protection change for copying file yet
MOVE D,[FRDTMP,,EDFIL] ;Flag that we're overriding tmpcor filename
PUSHJ P,FRD0 ;Read filename from tty
JRST FNERR ;Bad format
TLNE D,FRDNAM ;Skip if no file name given from tty
JRST BEGSY3
TLO D,FRDALL ;Tmpcor filename had to have included everything
SETZM CREASW ;Creating file named in tmpcor is not permitted
HRRZS LAMFLG ;Flag no explicit filename typed
JRST BEGSY3
;Tell non-display user what file he's editing.
TYEDFL: SETOM LSTPAG ;Force display of page number on TTYs
SKIPE DPY ;Don't need to tell display user the file's name
POPJ P,
OUTSTR [ASCIZ /Editing /]
MOVEI D,EDFIL ;Pointer to filename to type out
PUSHJ P,FILTYP ;Type filename (including any /F or /N switch)
MOVEI A,"/R"
IFN BOOKMD,<
SKIPE BOOKSW
MOVEI A,"/B"
>;END BOOKMD
TRNE F,REDNLY
TYPCHR (A)
TYPCHR "
"
POPJ P,
;BEG3 BEG4 BEG4B BEG4A NOXDIR BEG6 BEG5A BEG5 DPYOK
COMMENT ⊗ The word at EDFIL+4 (or EDFIL2+4) is used to hold the /N flag (X,,-1).
The word at EDFIL+5 (or EDFIL2+5) is used to hold several possible values:
X,,-1 means /N given, where X is positive (high-order bit off, non-zero).
0,,-1 means no directory in file.
-1,,-1 means should discard old directory when formatting file.
⊗
BEG3:
IFE DECSW,<
SKIPE READSW ;READ command or /D?
PUSHJ P,GETDOC ;Yes, wants to read a documentation file
>;DECSW
PUSHJ P,CHKGRT ;Check for greater-than sign as extension
SKIPE CREASW
PUSHJ P,CREATE
SETZM DEFPGL# ;Assume not using old page and line
SETOM GETWRT# ;Make FNDWRT remember who last wrote this file
SETZM ALTPPN# ;Assume file isn't on alternate PPN
BEG4: MOVEI D,@SRCFIL
MOVEI A,1
PUSHJ P,OPENI
JRST FNF
BEG4B: PUSHJ P,FNDWRT ;Remember who last wrote this file, and when
MOVE T,@SRCFIL+4 ;EDFIL(2)+4 is /N flag
AOS SRCFIL+4
MOVEM T,@SRCFIL+4 ;EDFIL(2)+5 is OR of /N flag and no-valid-dir flag
SKIPL SPAGE ;Any explicit starting page given?
JRST BEG4A ;Yes, don't change either it or starting line
MOVE D,[FRDALL,,EDFIL] ;Pointer to, and bits for name of, filename to list
PUSHJ P,ZFINDQ ;See if this file has old entry in filelist
JRST BEG4A ;Nope, but there is empty slot in filelist
JRST BEG4A ;Nope, and filelist is full
SKIPGE LAMFLG ;Don't skip if explicit filename typed (or CONTINUE)
SETOM DEFPGL ;Flag extended file default page to override SPAGE
MOVE A,ZDATA+ZPAGL(T) ;Page,,line where we were previously in this file
HLREM A,SPAGE ;Use previous page (no new one given)
SKIPL SLINE ;Any explicit starting line given?
JRST BEG4A ;Yes, don't override it
HRREM A,SLINE ;No, use previous line
MOVE A,ZDATA+ZFRDWN(T) ;Last window setting in file
HRREM A,SWIND ;Use it, too
BEG4A: MOVEI T,NBLOAT ;Default number of records for bloating
SKIPN SBLOAT ;/X given without arg?
MOVEM T,SBLOAT ;Yes, use default arg
MOVEI A,0 ;Value used to disable auto burping
SKIPLE SBLOAT ;Skip if not bloating
PUSHJ P,STBURP ;Along with bloating file, disable auto burping
SKIPN DIR ;skip if already have directory in core
PUSHJ P,GETDIR ;read directory in, if any, check dir format
MOVE T,EDFIL+4
TRNN F,COPY
IOR T,@SRCFIL+4
ADDI T,1
HRRZM T,DIRPAG
PUSHJ P,COPFIL ;see if want to copy file to new file
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI ;open file on normal channel (DSKO)
PUSHJ P,OPNLUZ
TRZE F,UPDTXT
PUSHJ P,OUTDIR ;GETDIR asking for output of newly made directory
SKIPE RDONLY
TRO F,REDNLY
MOVEI T,1 ;Standard default page to start with
IFN BOOKMD,<
SKIPE NEWBKP ;Reading new book?
ADD T,DIRPAG ;Start on page 2 if there is a directory
>;IFN BOOKMD
MOVE B,PAGES ;Number of pages in file
SKIPE A,XDIRFG ;Was directory extended?
CAIG B,1(A) ;And were any pages added?
JRST NOXDIR ;No
MOVEI T,2(A) ;Yes, default position in file is first new page.
SKIPN DEFPGL ;Are starting page & line old ones?
JRST NOXDIR
SETOM SPAGE ;Yes, but use extended place instead
SETOM SLINE ; since filename was given explicitly
SETOM SWIND ;Also window
NOXDIR: CAIN B,2 ;Exactly 2 pages?
MOVEI T,2 ;Yes, default is page 2
SKIPGE A,SPAGE ;Particular starting page requested?
MOVEI A,-1(T) ;No, use default
ADD A,DIRPAG
SKIPE NOT1PG ;If one-page free /N feature going, want page 1
JUMPG A,.+2
MOVEI A,1
PUSHJ P,RDPAGE ;read initial page into core
JFCL
SKIPN NOT1PG ;One page free /N feature going?
JRST BEG5A ;Yup
TRNE F,REDNLY!DIROK
JRST BEG5
TRO F,COPY
JRST BEG4
BEG6: PUSHJ P,ZFLDIR ;Flush the partial directory we got already
PUSHJ P,FBI ;Report this strange situation, although no harm done
JRST BEG4 ;Now try again to open the file, with free /N disabled
;Here to try to apply free one-page /N feature
BEG5A: SETZM RDONLY ;Not really in /R mode
TRZ F,REDNLY
MOVE T,PAGES ;Better not have seen a second page yet
TRNE F,DIROK ;And better have gotten the whole directory
CAIE T,1 ;1 page only!
JRST BEG6 ;Lose (shouldn't happen -- see DIR1PL)
HRLOI T,1
MOVEM T,EDFIL+4 ;Mark file as /N
TRZ F,FILLUZ ;And formatted
BEG5: PUSHJ P,SETHED ;Put filename into header blocks for displaying
SETZM LAMFLG ;No longer doing a ⊗λ command, no explicit filename typed
SETZM DELFIL ;Don't want to delete file because of ∂ yet.
SETZM PARPGL ;No place to go back to in new file (double arrow cmd).
SETZM TYIPNT
SETZM TYOPNT
SETZM PIFLAG ;Clear automatic-abort-of-fileswitch-on-error flag
MOVSI T,400000 ;Very unlikely value will force this one out
MOVEM T,DBLOAT
TLO F,OKF ;Say OK when ready initially and when switching files
PUSHJ P,DPYCHK ;Initialize display unless just switching files
PUSHJ P,PGINIT
PUSHJ P,ABCRLF ;Maybe put out CRLF -- must come AFTER call to DPYCHK
SKIPE DPY
PUSHJ P,SEMODE ;Make sure EMODE and other special dpy bits are on
PUSHJ P,TYEDFL ;maybe type name of file being edited
DPYOK:
;; SETOM ZABORT ;no longer have any special file to "abort" to (FILDEL)
MOVE D,[FRDALL,,EDFIL] ;Pointer to, and bits for name of, filename to list
PUSHJ P,ZLIST ;Make or update filelist entry for file being edited
PUSHJ P,MWCHK ;if this file is open in two or more windows, warn user
IFE DECSW,<
SKIPGE EDFIL+2
OUTSTR [ASCIZ /File has protection bit 400 on and so will not be saved by DART.
/]
PUSHJ P,PROCHK ;See if file is write protected against this user
PUSHJ P,PROTEL ; and if so, tell him.
>;NOT DECSW
PUSHJ P,UPDINI ;Tell user if file extended beyond dir, maybe set /-U
PUSHJ P,TMPWRT
IFN BOOKMD,<
SKIPGE A,NEWBKP
OUTSTR [ASCIZ /Will create .BKP file.
/]
>;END BOOKMD
SKIPE EINITF ;Do we need to read EIN[login area] tmpcor file?
PUSHJ P,EINRED ;Yes, read EIN, define macro, setup its execution
JFCL ;Command routine, may skip
MOVE T,ZATT ;get flag indicating if have been in any files already
SETOM ZATT# ;set same flag (now in a file)
HLRZ A,RPGLIN
TRNE A,376000
JRST MAIN ;All done with setting up file
TRZN A,400000
JUMPG A,[ MOVEM A,EDMOV ;Move into line editor on starting line
MOVE D,CMDSP-1
MOVEI A,0
JRST MAIN2]
SKIPN T ;Don't clear attach buf if switching files
PUSHJ P,ATTACH ;Init attach buf, this is our first file
JFCL
;MAIN MAIN1 MAIN2 MAINRT FNF FNF00 FNFYES FNFHUH FNF0A FNF0C FNF0B FNF0 FNF1 FNF2
;fell thru from previous page
MAIN:
IFN DEBSW,<
SKIPGE CHKFLG# ;Does user want free storage checked?
JRST MAIN1 ;No, don't do any checking
SKIPE CHKMOD ;want to check everything?
PUSHJ P,CHECK ;yes, make consistency checks
SKIPE CHKMOD ;did we check everything?
JRST MAIN1 ;yes, don't bother checking FS again
TLZE F,FSCHKF ;no, has free storage been changed?
PUSHJ P,FSCHK ;yes, check it for consistency
JFCL
SKIPN SHFMOD ;shuffle mode checking wanted?
JRST MAIN1 ;no
PUSHJ P,MOVIT ;yes, shuffle free storage
PUSHJ P,FSCHK ;and check it again
JFCL
MAIN1:>
MOVE T,DELNUM ;Current number of saved deleted lines
MOVEM T,DELOLD ; is max number of deleted lines next cmd can flush
TRZ F,EDITM!EDBRK
SKIPLE CURMAC ;Macro expansion in progress?
TLZ F,OKF ;Yes, don't say OK
TLZE F,OKF
OUTSTR [ASCIZ/ OK /]
MOVEI DSP,CMDSP
PUSHJ P,CMDIN
JFCL
TLZ F,TF1 ;I don't think anyone counts on this except maybe justify routines
MAIN2: PUSHJ P,(D) ;Note that LININS and EDIT also call command
MAINRT: TLO F,OKF ; routines (through EDGL3) and know of only
JRST 2,@[MAIN] ; three possible returns (direct, skip, and
JRST MAIN2 ; double skip)
;Here if initial LOOKUP on source edit file failed.
FNF: HRRZ T,LKUP+1 ;Don't look for other file (different ext or PPN)
CAIN T,1 ; if the file seems actually to exist.
JRST FNF00 ;PPN doesn't exist, skip extension checking
JUMPN T,FNF0 ;Jump if error indicates file exists
PUSHJ P,EXTCHK ;If no extension given, look for best extension
JRST BEG4 ;Found the file after all
FNF00: MOVE A,SRCFIL ;See if any PPN was given
TLNN A,FRDPRG!FRDPRJ ;If either project or programmer given,
SKIPN T,LSTPPN ; or if no previous file edited,
JRST FNF0 ; then don't look on PPN of previous file
MOVE TT,LSTDEV ;Get device that last PPN was on
CAMN T,@SRCFIL+PPN3 ;No use looking on same PPN twice
MOVE TT,LSTDV2 ;Using 2nd prev PPN, get its device
CAME TT,LKUP-1 ;Is device different for alternate PPN?
TLNN A,FRDDEV ;Yes, did user give device explicitly?
SKIPE CURMAC ;No, but alternate PPN not allowed from macro
JRST FNF0 ;Don't contradict explicit device named
CAMN T,@SRCFIL+PPN3 ;No use looking on same PPN twice
SKIPE T,LSTPP2 ;So try 2nd previous PPN, if any
CAMN T,@SRCFIL+PPN3 ;No use looking on same PPN twice
JRST FNF0 ;Don't try old PPN
PUSH P,@SRCFIL+PPN3 ;Save (implicit) PPN
PUSH P,@SRCFIL-1 ;Save original device
PUSH P,LKUP-1 ;Save device used
PUSH P,LKUP+1 ;Save original lookup error (either 0 or 1)
MOVEM T,@SRCFIL+PPN3 ;Try PPN last edit file had
MOVEM TT,@SRCFIL-1 ;Use device that PPN was on
RELEAS DSKI, ;Make sure we re-INIT in case gives different device
SETZM JOBJDA+DSKI
PUSHJ P,CHKGRT ;Check for greater-than sign as extension
MOVEI D,@SRCFIL ;Simulate BEG4 trying to open source file
MOVEI A,1
PUSHJ P,OPENI ;Try to open file from alternate PPN
JRST FNF0A ;That didn't work either
SKIPA T,[BEG4B] ;Address to POPJ to after saying found file
FNFYES: MOVEI T,BEG4 ;EXTCHK worked on alternate PPN, BEG4 opens file
FNFHUH: SUB P,[2,,2] ;Flush original lookup error code, orig device
POP P,TT ;Original device from SRCFIL-1
MOVEM T,(P) ;Flush implicit PPN with dispatch for POPJ
SETOM ALTPPN ;Remember that file was found on alternate PPN
PUSHJ P,ABCRLF ;Prepare for warning message (preserve T)
OUTSTR [ASCIZ/File found on previous /]
CAME TT,@SRCFIL-1 ;Did we change device?
OUTSTR [ASCIZ/Device & /]
OUTSTR [ASCIZ/PPN: /]
SETZM TYOPNT
MOVE A,@SRCFIL-1 ;Get real file's device
CAME A,TT ;Did we change device?
PUSHJ P,DEVTYO ;Yes, type device found file on
PUSHJ P,PPNTY2 ;Type out PPN where we found the file (ptr in D)
OUTSTR [ASCIZ/
/]
POPJ P, ;Dispatch to BEG4B or to FNF0
;Here if plain file not found on alternate PPN. Try other extensions.
FNF0A: HRRZ T,LKUP+1 ;Don't look for other file (different ext) if
CAIN T,1 ; file seems to exist
JRST FNF0C ;Alternate PPN doesn't exist, skip ext checking
JUMPN T,FNF0B ;Jump if lookup error wasn't "file not found"
PUSHJ P,EXTCHK ;If no extension given, look for best extension
JRST FNFYES ;Found the file after all
FNF0C: POP P,LKUP+1 ;Restore original lookup error code
POP P,LKUP-1 ;Restore original device used
POP P,@SRCFIL-1 ;Restore original device specified
POP P,T
MOVEM T,@SRCFIL+PPN3 ;Restore original (implicit) PPN
MOVEM T,LKUP+PPN3 ;Make error message mention the first PPN tried
JRST FNF0 ;Say what happened
FNF0B: JSP T,FNFHUH ;Say file found on previous PPN
FNF0: PUSHJ P,ABCRLF
MOVE D,[FRDRUN,,LKUP]
PUSHJ P,FILERR ;Tell him we didn't find the file and why
IFE DECSW,<
PUSHJ P,WHOREF ;If file busy, tell who is using it
>;IFE DECSW
FNF1: TRZ F,COPY
CLRBFI
FNF2: JSP P,INIT1 ;Now we always do this to re-initialize things
RELEAS DSKI, ;Make sure we re-INIT in case gives different device
SETZM JOBJDA+DSKI
IFN FTBUF,<
PUSHJ P,CACRLI ;Release cache from input channel
>;FTBUF
SKIPE PIFLAG ;Skip unless want to abort
PUSHJ P,EPSIL4 ;Return to previous file. This PUSHJ won't return.
PUSHJ P,MACSTP ;Terminate any macro expansion.
SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
SKIPN ZATT ;if no file edited yet, return to monitor
EXIT ;let him use control-return of monitor cmd
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Try again (ALT to abort). File? /]
SKIPN TYIPNT
JRST BEG1
SETZB T,TYIPNT
SKIPN TT,RSPNT
SKIPE TT,TCPNT
PTLOAD T
CLRBFI ;Kludge to avoid loading line, but make αCR not load "ET"
JRST BEG1
;CMDIN CMDEX CMDEXS CMDLU2 CMDEDR XCMDX CMDX CMDX3 CMDX2 CMDLUP ILLATT ILLAT1
;Here from MAIL or from MSG. DSP points to CMDSP in either case.
CMDIN: TRZ F,ARG!REL!NEG
SETZB A,C ;Clear accumulated arg (A)
EXCH C,COMCHR# ;Get and clear saved cmd char (COMCHR)
JUMPN C,CMDEX ;Jump if we have a saved command char to use
PUSHJ P,CMDRD ;Read a new command char
CMDEX: TLZA F,TF1 ;Not from search string activation (here from EDGL4)
CMDEXS: TLO F,TF1 ;Here from SRACT with activator--flag it
AOS OLDMOV# ;Flag for VT/FF cmds that another cmd has gone by
AOS NCMDS# ;count another command seen
CMDLU2: LDB B,[70200,,C] ;Get its ctrl bits.
TRZ C,¬177
MOVSI E,EDOK ;make a bit representing the bucky bits used
LSH E,(B)
TDNE E,CTAB(C) ;Is it a line editor cmd with these bucky bits?
JRST CMDED ;Yes.
;Return here from CMDED if don't want to simply call line editor
CMDEDR: PUSH P,DSP ;save ptr to dispatch table
MOVE DSP,-2(DSP) ;get ptr to corresponding flag table
MOVE T,@CTAB(C) ;get additional flags for this command char
POP P,DSP ;restore dispatch table ptr
SKIPA D,@CTAB(C) ;Get dispatch table entry.
;Return here after immediate dispatch to EXTEND (⊗X cmd), to make final dispatch.
;D (dispatch) and T (additional flags) must be set up already.
XCMDX: MOVEI E,0 ;make legal for all bucky bit combinations
;Return here only from CMDED to enter line editor.
;D (dispatch) and T (additional flags) must be set up already.
CMDX: TLNE T,37 ;Is this a 2-level flag retrieval?
MOVE T,@T ;Yes, get real flags
TLNE D,37 ;Is this a 2-level dispatch?
MOVE D,@D ;Yes. Get final dispatch entry
TDNE E,D ;E has bit representing cmd bucky bits.
JRST CMDERR ;Cmd is illegal with given bucky-bit combination.
JUMPL D,(D) ;Dispatch immediately on some commands.
TRNN F,ARG
MOVEI A,1 ;If no repeat argument typed, assume 1.
CAILE A,MAXARG
MOVEI A,MAXARG ;Maximum allowable repeat arg
TRNE F,NEG
MOVN A,A
TLNN D,NORDO ;Is this command illegal in READONLY mode?
JRST CMDX2 ;No.
TLNE T,RDONEG ;yes, but maybe legal with negative arg
JUMPL A,CMDX2 ;legal with neg arg, jump if have neg arg
TLNE T,RDOZER ;maybe legal with zero arg
JUMPE A,CMDX2 ;legal with zero arg, jump if have zero arg
TLNE T,RDODIR ;maybe legal from directory page (if not /R)
JRST CMDX3 ;yes, don't test for being on dir page
TRNE F,EDDIR ;Are we editing the directory page?
JRST ILLDIR ;Yes
CMDX3: TRNE F,REDNLY ;No, are we in READONLY mode?
JRST ILLRDO ;Yes
CMDX2: TLNE D,NOATT
TRNN F,ATTMOD
JRST POPJ1
TLNE F,TF1 ;Here with search string activator?
CAME D,CMDSP+%COLON ;Yes, is this the colon command?
JRST ILLATT ;No, illegal in attach mode
JRST POPJ1 ;Currently here only with ⊗F⊗: in attach mode
CMDLUP: PUSHJ P,CMDRD0 ;Here after arg--read next char of command
JRST CMDLU2
ILLATT: JSP A,ILLMES
ILLAT1: ASCIZ /in attach mode/
;CMDEDX CMDED CMDRD0 CMDRD CMRTR3 CMRTRY CMRTR2 MINUS PLUS NUMS INFIN ALTSET CONTRO METACO CHARAC CHARER
;Here with line-editor-entering command from line editor!
;Must have given decimal arg or been at end of line.
CMDEDX:
IFN 1,< ;New version to make ⊗XCHAR, ⊗XARG, and αβ#<LE entering cmd> work from LE
MOVE D,[NOEDIT,,EDTMR3] ;Set up dispatch to carry out cmd inside line editor
MOVEI T,0 ;Set up addition flags for this command
CAIE B,1 ;Maybe this is αD or αI at end of line!
JRST CMDX ;No, let line editor handle it
MOVEI TT,(C) ;Copy char
TRZ TT,40 ;Force upper case if letter
CAIE TT,"D"
CAIN TT,"I"
SKIPA TT,EDPOS ;αD or αI, but see if at end of line
JRST CMDX ;Let line editor handle it
CAME TT,EDCOLS
JRST CMDX ;Not at end, let line editor handle this cmd
JRST CMDEDR ;Call command routine to handle αD or αI
>;IFN 1
REPEAT 0,< ;Old version, which didn't allow activated LE cmds from LE
JUMPE B,CMDERR ;No bits, no command
JRST CMDEDR ;With bits you get command
>;REPEAT 0
;Here with line-editor-entering command.
CMDED: SKIPN DPY ;We have a command to be passed to the line editor.
JRST CMDEDR ;Has to be a display.
JUMPL DSP,CMDEDX ;Jump if coming from line editor
MOVE D,-1(DSP) ;Get line editor dispatch entry
MOVE T,-2(DSP) ;Get ptr to additional flag table
MOVE T,-1(T) ;Get additional flags for line editor dispatch
TLNE F,TF1 ;Here with search string activator?
JRST CMDX ;Yes, line editor command is okay
TLNE F,PMLIN!OFFEND ;If this is end of page,
JUMPN B,CMDERR ; and there were control bits, then forget it
JRST CMDX
CMDRD0: JUMPL DSP,CTYI1 ;Don't update display if coming from line editor
SETOM NOSTEP ;Suppress update of display for macro step this time
CMDRD: JUMPL DSP,CTYI1 ;Don't update display if coming from line editor
SETZM LINFLG# ;zero means read char, nonzero means read line
SETZM LINFL2# ;zero means don't change LINFLG upon ESC I
SETZM NOCRL2# ;don't really suppress CRLF yet
CMRTR3: PUSHJ P,DISP ;Update display, if needed.
PUSHJ P,SKIPIN ;Arg. to DISP (skip if input ready, char or line mode)
TRNN F,ARG!REL ;Don't output CRLF in middle of arg
AOSN NOCRLF# ;Skip unless coming from partial-sign cmd
JRST GTYI1 ;Suppress CRLF, get input char
SKIPN NOCRL2 ;skip if want just to suppress the crlf
PUSHJ P,CMDCRL ;See if we need a CRLF
SKIPE LISPJB ;skip unless connected to lisp job or pty
SKIPLE LMBUSY ;skip if no mail already waiting for user to eat manually
JRST GTYI1 ;Read a character from TTY (in char mode) or ascii string
MOVE T,CURMAC ;special check in case macro ends suddenly, w/o altmode
PUSHJ P,TYICHK ;Maybe get char from macro or byte pointer & return uplevel
JUMPG T,CMRTR3 ;didn't get macro char, jump back if we WERE in macro
PUSH P,DSP ;Save the crucial ACs (dispatch table ptr)
PUSH P,A ;(argument so far; maybe always 0)
PUSHJ P,LSCHK ;wait for TTY or Lisp int, skip return if read TTY
JRST CMRTRY ;may have changed display, called macro, diddled LMBUSY
POP P,A ;restore ACs
POP P,DSP
JRST TYI3 ;process char just read from TTY
CMRTRY: POP P,A ;restore ACs
POP P,DSP
CMRTR2: SETOM NOCRL2 ;don't think about CRLFs again until next real cmd is done
JRST CMRTR3 ;now loop back to see what there is to do
MINUS: TRC F,NEG
PLUS: TRO F,REL
JRST CMDLUP ;Loop back to get actual command.
NUMS: TRO F,ARG
IMULI A,12
ADDI A,-"0"(C)
JRST CMDLUP
INFIN: TRO F,ARG
MOVEI A,-1
JRST CMDLUP
ALTSET: MOVEI D,CPOPJ
POPJ P,
CONTRO: SKIPA B,[CT1] ;Give next command just the CONTROL bit
METACO: MOVEI B,CTMT3 ;Give next command META and CONTROL bits
SETOM NOCRLF ;Prevent CRLF typeout, avoid LSCHK call
PUSHJ P,CMDRD0 ;Get next command char
DPB B,[70200,,C] ;Insert bucky bits.
JRST CMDLU2 ;Now process command
CHARAC: PUSHJ P,XTDBEG ;Get first char of extended command arg
PUSHJ P,GETNUI ;Read a number (constant, RDV, or macro value)
MOVE TT,OLDCHR# ;No number found, use previous character generated
PUSHJ P,XTDEND ;Make sure no extraeous text in cmd line
TDNN TT,[-1,,777000] ;Is the result a valid char?
TRNN TT,177 ;And not a null?
JRST CHARER ;Invalid constructed char
MOVEM TT,OLDCHR ;Remember for next time
MOVE C,TT ;Set up for CMDEX
JRST CMDLU2
CHARER: JSP D,CPOPJ ;Set up error dispatch to here
SORRJ Invalid value for constructed char --
SETZM TYOPNT
TYPOCT TT
OUTSTR [ASCIZ/ octal (= /]
TYPDEC TT
OUTSTR [ASCIZ/ decimal)/]
JRST PPJ1CR
;CMDERR ERR ERR0 PPJ1CR CPOPJ1 POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLDI1 ILLDI2 ILFLUZ ILLBK ILLMES ILLMS2 PRDOT1 ERRX PRNTCH PRNTC3 PRNTC4 PRNTC2
CMDERR: JSP D,ERRX
ERR: SORRF Unrecognized command character --
ERR0: TRNE B,1
OUTSTR [ASCIZ /<ctrl>/]
TRNE B,2
OUTSTR [ASCIZ /<meta>/]
PUSHJ P,PRNTCH ;Print character in C using ICHTAB if non-printing char.
PPJ1CR: OUTSTR [ASCIZ /
/]
CPOPJ1:: ;Occasionally someone uses the wrong name for this.
POPJ1: AOS (P)
CPOPJ: POPJ P,
ICHTAB: FOR X IN (tab,lf,vt,ff,cr)<[ASCIZ /<X>/]
>
ILLRDO:
IFN BOOKMD,<
SKIPE BOOKSW
JRST ILLBK
>;END BOOKMD
JSP A,ILLMES
ASCIZ \in /R mode\
ILLDIR: JSP A,ILLMES
ILLDI1: ASCIZ /on Directory page/
ILLDI2: MOVEI A,ILLDI1
JRST ILLMS2
ILFLUZ: MOVEI A,[ASCIZ/in unformatted file/]
JRST ILLMS2
IFN BOOKMD,<
ILLBK: JSP A,ILLMES
ASCIZ \in /B mode\
>;END BOOKMD
ILLMES: JSP D,ERRX
ILLMS2: SORRJ Illegal
OUTSTR (A)
PRDOT1: OUTSTR [ASCIZ /.
/]
JRST POPJ1
ERRX: POPJ P,
PRNTCH: MOVEI B,(C) ;Jim Dandy way to print a character, even
ROT B,-7 ; if it is a non-printing char.
CAIG C,15
CAIGE C,11
TROA B,B
HRRI B,@ICHTAB-11(C)
SKIPE SPACOK# ;Okay to print space as " "?
JRST PRNTC3 ;Yes
CAIN C,40
HRRI B,[ASCIZ /<space>/]
PRNTC3: CAIN C,177
HRRI B,[ASCIZ /<bs>/]
CAIN C,0
HRRI B,[ASCIZ /<null>/]
CAIN C,"α"
HRRI B,[ASCIZ /<alpha>/]
CAIN C,"β"
HRRI B,[ASCIZ /<beta>/]
OUTSTR (B)
POPJ P,
;Routine to type out any 9-bit char in C. Preserves all ACs.
PRNTC4: SETOM SPACOK# ;Print space as " "
PRNTC2: PUSH P,C
PUSH P,B
LDB C,[POINT 2,C,28] ;Get bucky bits
OUTSTR (C)[0 ;No bits
ASCII /α/
ASCII /β/
ASCII /αβ/]
LDB C,[POINT 7,-1(P),35] ;Get char w/o bucky bits
PUSHJ P,PRNTCH ;Print 7-bit char
SETZM SPACOK
JRST POPBCJ ;Restore the ACs and return
;INIT INIT0 REDATE INI1 NOTPUR WININI SWINBR WINFST RWINBR UPSEGE INIT1 INIT1A
INIT: SETZM RPGACS
MOVE [RPGACS,,RPGACS+1]
BLT RPGACS+17 ;CLEAR ACS FROM ALL BUT RPG STARTUP
SETOM EINITF ;Set flag requesting EIN tmpcor read
INIT0: SETZM TYIPNT
SETZM TCPNT
SETZM SYSCMD
SETZM ZDATA ;This avoids a needless message on ET starts
SETZM ESCI2 ;Haven't been interrupted by ESC I.
SETZM FBIBUF ;clear out "Y" from "save on sys:" question
MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVEI
MOVEI 17,1
BLT 17,17 ;CLEAR REAL AC'S
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
RESET ;CLEAN UP SYSTEM ASPECTS OF JOBS
MOVEI A,REENT
MOVEM A,JOBREN ;Reentry address to save incore text
MOVE A,[ZVARS,,ZVARS+1]
BLT A,EVARS ;zero all the variables
;; MOVE A,[ZDIR,,ZDIR+1]
;; BLT A,EDIR ;clear directory header/trailer
MOVEI A,MAXARG
MOVEM A,NOSHFT# ;effectively, no limit on DM line shifting
MOVE A,[WINHED,,WINHED]
MOVEM A,WINHED# ;make an empty window list
MOVEI A,WINDAT ;ptr to window to initialize
PUSHJ P,WININI ;initialize data for first window
MOVEI A,1
MOVEM A,SOMOD ;clear display of subjob mode
HRROS LAMFLG ;Assume explicit filename will be typed
SETZM HOMPLC ;File stack is empty
SETZM OLDJOB ;subjob stack is empty
SETOM SBLOAT ;Not bloating first file
SETOM SPROT ;Not changing protection for file copy
SETOM ZINDEX ;Note no files to remember
SETZM ZDATA-2
MOVE A,[ZDATA-2,,ZDATA-1]
BLT A,ZDATA-2+ZSIZE-1 ;Clear the file list
PUSHJ P,MACINI ;Init the macro list
MOVEI A,-1 ;start with big screen-line number so that
MOVEM A,SCRHGH ; SETSCR will store first SCRTOP here
PUSHJ P,DPYSKI ;Don't update display when typeahead present
PUSHJ P,CVTAL0 ;Make altmodes in files get converted
MOVE T,[PUSHJ P,UUOH] ;OUR UUO HANDLER
MOVEM T,41
MOVEI T,TSINT ;ADDRESS OF INTERRUPT HANDLER
MOVEM T,JOBAPR
IFE DECSW,<
MOVEI T,JBICNI ;USE DIFFERENT THREE WORDS FOR NEW INTS
MOVEM T,JOBINT↑
>;NOT DECSW
MOVE T,[JRST WRBF3]
MOVEM T,XSETO
SETOM OLDTRL ;make first DSTRL clear RH of DPYTAB-1
SETOM COLPOS ;Flag no αβ; or αβ: cmd typed yet
SETOM TTYNUM ;Force DPYCHK to initialize terminal
SETOM DPY ; "
MOVEI T,220000!IFN DECSW,<400000;>0 ;ENABLE FOR PDLOV AND MPV
APRENB T,
IFE DECSW,<
MOVSI T,INTTTI!INTTTC ;Enable ESC I and terminal-type-change
INTENB T, ; interrupts with new interrupt system
IFE DATOK,<
ACCTIM T, ;Get date (left half) and time (right half)
MOVEM T,DATBLK# ;Date is OK as is
HRRZS T ;but must fix time.
IDIVI T,=60 ;Convert to minutes
HRRM T,DATBLK
>;IFE DATOK
MOVEI T, ;AND USER'S REAL NAME
GETPPN T,
MOVEM T,RPPN#
MOVEM T,MACDFL+PPN3 ;THIS IS DEFAULT PPN FOR EXECUTE FILE
MOVEI T, ;AND USER'S ALIAS
DSKPPN T,
>;NOT DECSW
IFN DECSW,<
MOVEI T,DECINT ;New DEC style interrupt block
PIINI. T,
JFCL ;Not implemented
MOVE T,[144000,,[-2↔0↔0]]
PISYS. T,
JFCL ;ditto
IFE DATOK,<
DATE T,
REDATE: HRLZM T,DATBLK#
MSTIME T,
IDIVI T,=60000 ;CONVERT TO MINUTES
HRRM T,DATBLK
DATE T,
HLRZ TT,DATBLK ;GET DATE WE JUST STORED
CAME T,TT
JRST REDATE ;IT CHANGED, TRY AGAIN ON MINUTES
>;IFE DATOK
HRROI T,2
GETTAB T,
GETPPN T, ;IF GETTAB ISN'T IMPLEMENTED, GO GETPPN
JFCL ; AND IF JACCT IS ON (HA, HA), GETPPN MAY SKIP
MOVEM T,RPPN#
MOVEM T,MACDFL+PPN3 ;THIS IS DEFAULT PPN FOR EXECUTE FILE
GETPPN T,
JFCL
>;DECSW
MOVEM T,PPN# ;remember alias
IFN FTBUF,<
MOVEI T,CACHE0 ;First cache is compiled in
HRROM T,PCACHE ;Set up pointer to compiled-in cache
SETOM CACCHN ;First cache isn't in use by any I/O channel
FOR I←1,NCACHE-1
< SETZM PCACHE+I ;Cache doesn't exist
SETOM CACCHN+I ;Cache not in use
>
>;FTBUF
MOVE T,PARSYM ;Get default parenthesis symbols.
HLRZM T,LEFTC
HRRZM T,RITEC
SETZM DIR
SETO T, ;See what kind of processor we have
AOBJN T,.+1
SETCAM T,SUBONE# ;-1 if KL-10. -2,,-1 if KA-10. For substitution.
;SETUP TABLE VBBITS TO HAVE A BIT ON FOR EACH CHARACTER WHICH DOESN'T HAVE
;ONE OF THE FOLLOWING BITS ON: LETF, LT2F, NUMF
;TABLE IS THE LEFTMOST 32 BITS OF 4 WORDS
MOVSI A,LETF!LT2F!NUMF
MOVEI B,40
MOVEI C,176
MOVEI E,VBBITS+4-1
INI1: TDNN A,CTAB(C)
IORM B,1(E)
JUMPL B,[MOVEI B,20↔SOJA E,.+2]
LSH B,1
SOJG C,INI1
MOVE T,FABITS+1
ANDM T,VBBITS+1
PUSHJ P,BITCNT
HRLZM T,VBBITS
MOVE T,[[LETF!LT2F!NUMF,,]-BEG+400000,,CTAB]
MOVEM T,5(E)
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
SETOM NOT1PG ;Not trying one-page free /N feature yet
IFN PURESW,<
SKIPL JOBHRL↑
JRST NOTPUR
PUSHJ P,CHKUP ;Make sure upper segment is OK before we start
CAME T,CHKSUM
PUSHJ P,UPSEGE
NOTPUR:
>;PURESW
IFG DEBSW-PURESW,<
SKIPN PURFLG
JSP E,PURINI
>
JRST FSINI ;GO INITIALIZE FREE STORAGE
;Initialize data for this window. Called by INIT above and by CREWIN.
;Call with A containing ptr to window data block (WINDAT or FS address).
WININI: HRLI A,(A) ;duplicate ptr in LH for adding to BLT ACs
FOR X IN (BOTDSH,BOTSTR,TOPDSH,TOPSTR) ;Headers and trailers
< AOS T,TXTNUM ;Generate new serial numbers
HRRZM T,X-WINDAT+TXTSER(A) ; for the various header and trailer blocks
>
SETZM MARKS-WINDAT(A)
MOVE T,[MARKS-WINDAT,,MARKS-WINDAT+1]
ADD T,A ;relocate BLT AC ptrs
BLT T,MARKS-WINDAT+NMARKS-1(A) ;Init. the marks array.
MOVE T,[ZWIN-WINDAT,,ZWIN-WINDAT+1]
ADD T,A ;relocate BLT AC ptrs
BLT T,EWIN-WINDAT(A) ;zero lots of per window data
MOVEI T,1
MOVEM T,UIFLG-WINDAT(A) ;clear possible left over text in hdr
MOVEM T,EMFLG-WINDAT(A) ; line flags, in case of restart
MOVEM T,HWFLG-WINDAT(A)
SETOM FIRPAG-WINDAT(A) ;no page in core
MOVEI T,"→"*2+1
MOVEM T,ARRON-WINDAT(A)
AOS T,WINNUM# ;get a serial number for this window
MOVEM T,WINSER-WINDAT(A) ;save it for IOPUSH to use
SETOM DLINES-WINDAT(A) ;Make sure trailer values get set later by TRAILS
SETOM DCURPG-WINDAT(A)
SETOM DPAGES-WINDAT(A)
SETOM DBLOAT-WINDAT(A)
SETOM DROOM-WINDAT(A)
SETOM DARRL-WINDAT(A)
SETZM SCRBOT-WINDAT(A) ;trlr line number not set yet
SETZM ARRL-WINDAT(A)
SETZM TOPWIN-WINDAT(A)
SETZM LINES-WINDAT(A) ;no lines in core yet (needed for FLSPAG)
SETZM CURPAG-WINDAT(A) ;no pages in core yet
SETZM FIRPAG-WINDAT(A) ;no pages in core yet
SETZM PAGES-WINDAT(A) ;no pages in core yet
SETZM WINFGS-WINDAT(A) ;clear all the saved flags
;Find an unused number for window pointed to by A.
;NOTE: Window numbers are required for window stack.
SWINBR: SETCM T,WINMSK ;pick up complemented mask of window numbers in use
JFFO T,.+2 ;find first previously unused bit
PUSHJ P,TELLZ ;all numbers are in use, never supposed to happen
MOVSI T,400000 ;a bit for turning on this number's mask bit
MOVN TT,TT ;make shift go to right
LSH T,(TT) ;shift bit to place for window number
IORM T,WINMSK# ;turn on the nbr's bit (sign bit is for nbr WINFST)
MOVN TT,TT ;non-negative bit number again
ADDI TT,WINFST ;offset by amt of lowest numbered window
MOVEM TT,WINNBR-WINDAT(A) ;save in the window
POPJ P,
WINFST←←1 ;first number used for active windows, must be positive for stack.
;Release the window number used by current window
RWINBR: MOVE TT,WINNBR ;get number this window was using
SUBI TT,WINFST ;remove offset between number and bit number
MOVSI T,400000 ;a bit for turning off this nbr's mask bit
MOVN TT,TT ;make shift go to right
LSH T,(TT) ;shift bit to place for nbr
ANDCAM T,WINMSK# ;turn off the nbr's bit (sign bit for nbr WINFST)
POPJ P,
IFN PURESW,<
UPSEGE: OUTSTR [ASCIZ/
***** UPPER SEGMENT CHECKSUM FAILURE!!!! *****
I suggest you KILL the upper segment and announce this publicly.
Perhaps then find a wizard. Type CONTINUE to continue at your own risk.
(Checksum difference in AC 15; negative difference in AC 16.)
/]
SETO TT,
BEEP TT,
CLRBFI
SUB T,CHKSUM ;Leave difference in an AC
MOVN TT,T ;Other difference in another AC
EXIT 1,
POPJ P,
>;PURESW
;Get here if COPCHK failed or if user refuses to let us reformat a file
;or if file not found.
INIT1: MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
SETZM DIR ;Make sure GETDIR is called by BEG4
SETOM SWIND
SETOM SPROT ;No protection change for copying file yet
SETOM SLINE
SETOM SPAGE
SETOM SBLOAT ;Assume not bloating file
SETZM NODUPD ;Clear /-U switch to allow directory updating
SETZM BAKPLC ;Clear page stack
SETZM MARKS ;Clear line marks
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1
ANDI F,ATTMOD ;Clear all flags but attach mode flag
HRROS A,LAMFLG ;Note explicit filename will be typed
HRREM A,RDONLY ;Set flag to -1 if doing ⊗λ command, 0 otherwise
INIT1A: SETZM QUIETF ;Don't assume quiet mode for new file
SETOM NOT1PG ;Not yet trying one-page /N kludge mode
SETZM CREASW ;Don't want to be in CREATE mode for sure.
SETZM BOOKSW
SETZM READSW
SETZM BKPSW
SETZM QUERYF ;Assume not going to E.ALS
POPJ P,
;main command dispatch table ;⊗ CRDSP FFDSP CMDSP CMFLAG CMDSP
;See COMMAND DISPATCH FLAGS and their explanations early in this file.
;The CC macro, as here defined, is used to associate relative table addresses
;with the associated command characters. For a more detailed explanation see
;the comment at CTAB.
;First, a couple of second level dispatch tables, for cmds that dispatch
;on the bucky bits in the command.
;CR cmd
CRDSP: NOEDIT!SACMD!SSCMD,,REGCR
DOEDIT!NOATT!SSCMD,,CONTCR
NOEDIT!NOATT,,METACR
NOEDIT!NOATT,,DUBLCR
;FF cmd
FFDSP: DOEDIT,,WIND ;no bucky bits
DOEDIT,,FORMF ;control
; NOATT!NORDO,,INSERT ;meta
NOATT,,INSERT ;meta
DOEDIT,,FORMF ;control-meta
DEFINE CMCMDS <
XX 400000,0,0,CMDERR ;0 nul
XX DOEDIT!SSCMD,0,0,NMVAR1 ;1 rubout
XX B,0,0,CRDSP ;2 CR index reg B in LH
XX 400000,0,0,CMDERR ;3 LF
XX NOEDIT!NOATT,0,0,DBLTAB ;4 TAB
XX B,0,0,FFDSP ;5 FF index reg B in LH
XX 400000!NOEDIT,0,0,ALTSET ;6 ALT
XX 400000,0,0,CMDERR ;7 letter
XX NOEDIT!NOATT,0,0,SEMICO ;10 ;⊗
XX 400000,0,0,NUMS ;11 digits
XX DOEDIT,0,0,TOP ;12 ∧
XX 400000,0,0,CMDERR ;13 ¬
XX RE.ED,0,0,MQUICK ;14 ⊂
XX RE.ED,0,0,MQUICK ;15 ⊃
XX 0,0,0,OLDLOC ;16 ∀
XX RE.ED,0,0,MQUICK ;17 ≡
XX DOEDIT,0,0,BOT ;20 ∨
XX 400000,0,0,INFIN ;21 ∞
XX 400000,0,0,CMDERR ;22 |
CC(A) XX DOEDIT!SACMD!SSCMD!MSGCMD,0,0,ATTACH
CC(B) XX RE.ED,0,0,GLUP
CC(C) XX DOEDIT!SACMD!SSCMD,0,0,ATTCOP
CC(D) XX SACMD!NOEDIT!NOATT,0,0,DELLIN
CC(E) XX 0,0,0,GETOUT
CC(F) XX DOEDIT,0,0,FINDIT
CC(G) XX 0,0,0,WINDGO
CC(H) XX 0,0,0,HOMFIL
CC(I) XX NOEDIT!NOATT,0,0,DUBLI
CC(J) XX RE.ED,0,0,JMP
CC(K) XX 0,0,0,ATTKIL
CC(L) XX DOEDIT,0,0,GOLINE
CC(M) XX 0,0,0,XMARK
CC(N) XX 0,0,0,OLDLIN
CC(O) XX 0,0,0,BACKGO
CC(P) XX SSCMD,0,0,NEWPAG
CC(Q) XX DOEDIT!NOATT,0,0,CONTQ
CC(R) XX 0,0,0,ATTREP
CC(S) XX NOEDIT!NOATT,0,0,PREVED
CC(T) XX RE.ED,0,0,GLDOWN
CC(U) XX SSCMD!DOEDIT,0,0,NMVAR1
CC(V) XX RE.ED,0,0,DRAW
CC(W) XX DOEDIT,0,0,WIND
CC(X) XX 400000,0,0,EXTEND
CC(Y) XX RE.ED,0,0,MACCAL
CC(Z) XX RE.ED,0,0,ZMACRO
CC(VT) XX DOEDIT,0,0,VERTAB
CC(PLS) XX 400000,0,0,PLUS
CC(MIN) XX 400000,0,0,MINUS
CC(LT) XX DOEDIT,0,0,LT
CC(GT) XX DOEDIT,0,0,GT
CC(LE) XX DOEDIT,0,0,LTE
CC(GE) XX DOEDIT,0,0,GTE
CC(DA) XX NOEDIT!NOATT,0,0,DWNARR
CC(UA) XX NOEDIT!NOATT,0,0,UPARR
CC(.) XX NOEDIT,0,0,WRPAG0
CC(LA) XX SACMD,0,0,LFARR
CC(RA) XX SACMD,0,0,RTARR
CC(EPSIL) XX 0,0,0,EPSIL
CC(LAMBDA) XX 0,0,0,LAMBDA
CC(QUERY) XX 0,0,0,QUERY
CC(EXIST) XX RE.ED,0,0,EXIST
CC(BSLAS) XX NOATT!DOEDIT,0,0,BSLAS
CC(ASTER) XX DOEDIT,0,0,ASTER
CC(COLON) XX SSCMD!NOEDIT!NOATT,0,0,COLON
CC(PARL) XX NOEDIT!NOATT,0,0,PARL ;Left paren
CC(PARR) XX NOEDIT!NOATT,0,0,PARR ;Right paren
CC(PARB) XX NOEDIT!NOATT,0,0,PARB ;Double arrow cmd
CC(MSG) XX DOEDIT,0,0,MSG ;Partial-sign command to diddle messages.
CC(LBS) XX 400000,0,0,LBS ;This is ⊗# command--Get arg given to last macro
CC(EXCL) XX DOEDIT,0,0,EXCL ;Exclamation-point command to diddle paragraphs.
CC(SLASH) XX NOEDIT!SACMD,0,0,QLIND ;Slash is a lisp indenting command
CC(AMP) XX RE.ED,0,0,STEPQ ;Ampersand is a macro stepping cmd
CC(INTER) XX RE.ED,0,0,MQUICK ;Intersection calls a macro
CC(UNION) XX RE.ED,0,0,MQUICK ;Union calls a macro
CC(UNDER) XX RE.ED,0,0,MQUICK ;Underscore calls a macro
CC(TILDE) XX RE.ED,0,0,MQUICK ;Tilde calls a macro
CC(DOL) XX RE.ED,0,0,MQUICK ;Dollar-sign calls a macro
CC(PER) XX RE.ED,0,0,MQUICK ;Percent-sign calls a macro
CC(EQ) XX SACMD!RE.ED,0,0,EQUALS ;Equals-sign sends text to Lisp
CC(NOTEQ) XX 0,0,0,NXTWIN ;Not-equals moves to next window down the screen
CC(PI) XX 400000,0,0,REQWIN ;Pi cmd makes new window on next cmd (if file cmd)
>;DEFINE CMCMDS
DEFINE CC !(A)<%!A←←.-CMDSP> ;TAGS FOR CTAB (PHASE 0 WOULD DO IF :: WORKED)
DEFINE XX(CMBITS,LBITS,RBITS,DSP)<CMBITS,,DSP>
CMFLAG ;pointer to table of additional flags, must be at -2(DSP)
NOATT,,EDIT ;line editor cmd dispatch, uses index of -1
CMDSP: CMCMDS ;dispatch table: entry = flags,,dispatch adr
DEFINE CC (A)<> ;ignore CC's this time
DEFINE XX(CMBITS,LBITS,RBITS,DSP)<LBITS,,RBITS>
0 ;line editor cmd extra bits, uses index of -1
CMFLAG: CMCMDS ;additional-flags table: entry = more flags,,yet more flags
;XCMDS XDISP MCMDS MDISP
BEGIN XDISPS ;TO FLUSH MACROS
GLOBAL D ;GRRRR
;EXTEND MODE COMMAND TABLE (commands must be in alphabetical order!!!)
;See COMMAND DISPATCH FLAGS and their explanations early in this file.
DEFINE XCMD<FOR X IN (<ABORT,RE.ED>
,<ADD,RE.ED>,<AL,,ALIAS>,ALIAS,<ALIGN,SACMD>,<APPEND,NOATT>,<ARGUMENT,400000>
,<ATTACH,NOATT,MEDIT>,<ATTSET,RE.ED>
,<AUTOBURP,RE.ED>,<AUTOSTEP,RE.ED>,<AUTOWRITE,RE.ED>
,BACKGO,<BEEPME,RE.ED>,BLOAT,<BOISE,SACMD>
,BOTSET,<BREAK,SACMD>,<BURP>
,<CA,DOEDIT,CANCEL>,<CANCEL,DOEDIT>,<CASE,RE.ED>,<CENTER,SACMD>
,<CHARACTER,400000>,<CHECK,RE.ED,CHKER>,<CLOSE,,CLOSIT>,<COMMEN,RE.ED,CPOPJ>
,<CONTINUE>,<CONTROL,400000>
,<CORCHK,RE.ED>,<CVTALTMODES,RE.ED>
,<DDTGO,RE.ED>,<DEFINE,RE.ED,MACDEF>,<DELETE,NOATT!NORDO>,<DFIND,RE.ED>
,<DIRED,NOATT,GODRD>,<DIVIDE,RE.ED>,<DOVER,SACMD>,DPYALWAYS,<DPYSKIP>
,<DRAW0,RE.ED>,<DRD,NOATT,GODRD>,<ECHO,RE.ED>,<EECHO,RE.ED>
,<EMPTY,DOEDIT>,<ENTER,,EPSIL>,<EPSILON,,EPSIL>,<EVAL,RE.ED>
,<EXACT,RE.ED>,<EXECUTE,RE.ED>,<EXIST,RE.ED>,<EXIT,NOATT,CLSALL>
,<F,DOEDIT,FIND>,<FFIND,DOEDIT>
,<FILE,,FILDEA>,<FILED,,FILDEA>,<FILEDELETE,NORDO,FILDEL,RDONEG!RDOZER!RDODIR>
,<FIND,DOEDIT>,<FXFIND,DOEDIT>
,<GORPG,NOATT>
,HEADER,HEIGHT,HIDE,<HOME,,HOMEF>,<IECHO,RE.ED>
,<IFEQ,RE.ED>,<IFGE,RE.ED,IFGEQ>,<IFGT,RE.ED>
,<IFLE,RE.ED,IFLEQ>,<IFLT,RE.ED>,<IFNE,RE.ED>,<IMPRINT,SACMD>
,<INDENT,SACMD>,<INSERT,↑INSCMD::NOATT>,<INTERRUPT,RE.ED,LINTER>
,<JFILL,SACMD>,<JGET,SACMD>,<JOIN,SACMD>,<JUST,SACMD>,<LAMBDA>
,<LATHROP,SACMD>
,<LATTACH,RE.ED>,LETEST,<LFILE,RE.ED>,LINCNT,<LISPSYNTAX,RE.ED>
,<LOOKUP,,LAMBDA>,<LOWERCASE,SACMD!RE.ED>
,<LPAREN,NOEDIT!NOATT>,<LPEND,RE.ED>,<LRECEIVE,RE.ED>,<LTYPE,RE.ED>
,<M,NORDO,MARK>,<MAIL,SACMD>,<MALTMODE,RE.ED>,<MARK,NORDO>,<MAXIMUM,RE.ED>
,<METACONTROL,400000>,<MINIMUM,RE.ED>,<MSG,DOEDIT>,<MULTIPLY,RE.ED>
,<NDBBOARD,NOATT>,<NDFAIL,NOATT>,<NDSAIL,NOATT>,<NONEMPTY,DOEDIT>
,<NUMBERS,RE.ED,NBRLIN>
,<OPEN,↑OPNCMD:NORDO,OPENIT,RDONEG!RDOZER!RDODIR>,<OTHERCASE,SACMD!RE.ED>
,<PANCAKE,SACMD>
,<PAREN,RE.ED>,<PARTIAL,DOEDIT,MSG>,<PINFO,RE.ED>,<PLOVER,SACMD>
,POINTER,PPSET,<PRINT,DOEDIT>,PROTEC,<PUTDEF,RE.ED>
,<QUIT,DOEDIT>
,<RAISEWINDOW,RE.ED>
,<RAPID,RE.ED>,<RDFAIL>
,READONLY,READWRITE,<RECONNECT,RE.ED>,<REDEFINE,SACMD>
,<REEVAL,SACMD>,<REMAINDER,RE.ED>,<REMIND,SACMD>,<RENAME,NORDO,RENAM,RDODIR>
,<RESUME,RE.ED>,<ROVER,SACMD>
,<RPAREN,NOEDIT!NOATT>,<RSYS,DOEDIT>,<RUN,DOEDIT>
,<SAVE,,SAVE1>,<SAY,RE.ED>,<SCREEN,DOEDIT>,<SEND,SACMD>,<SET,RE.ED!SACMD>
,<SHIFT,RE.ED,SHFT>
,<SILENT,RE.ED>,<SIN,SACMD>,<SJFILL,SACMD>,<SJUST,SACMD>,<SLISP,RE.ED>
,<SPOOLC,↑SPLCMD:SACMD>,<SSLINE,RE.ED>,<SSPAGE,RE.ED>
,<STEP,RE.ED>,<STOPALL,RE.ED>,<STOPHOW,RE.ED>,<STOPONE,RE.ED>,<STOPZERO,RE.ED>
,<STRUDEL,SACMD>
,<SUBDETACH,RE.ED>,<SUBECHO,RE.ED>,<SUBFIND,RE.ED>,<SUBJOB,RE.ED>
,<SUBK,RE.ED,SUBKI>,<SUBKI,RE.ED>,<SUBKILL,RE.ED>
,<SUBLINK,RE.ED>,<SUBTRACT,RE.ED>,<SUBWAIT,RE.ED>,<SULISP,RE.ED>
,<TABLE,SACMD>,<TELLME,RE.ED>,<TERSE,RE.ED>
,<TGET,SACMD>,THISPAGE,<TIN,SACMD>,<TJFILL,SACMD>,<TJGET,SACMD>,<TJUST,SACMD>
,<TMPCOR,RE.ED,TMPCR>,TOPSET,TRADEWINDOW,TRAILER,<TYPE,SACMD>
,UNDELETE,<UPDATE,↑UPDCMD::NORDO,,RDONEG!RDOZER!RDODIR>,<UPPERCASE,SACMD!RE.ED>
,<VERBOSE,RE.ED>
,<WRITTEN,RE.ED>
,<XSPOOL,SACMD>
,<YSET,RE.ED>
,ZFILES,ZLINES,ZMARKS,ZPAGES)>
;,<TEST,SACMD> (disabled cmd)
DEFINE MCMD<FOR X IN (ABOR,<ABORT,,ABOR>,READONLY,READWRITE)>
DEFINE CMDM(A,B,C,D,E)<<SIXBIT /A/>
IFLE <SIXBIT /A/>-LASTCM,<.FATAL Extended command names out of alphabetical order.>
LASTCM←←<SIXBIT /A/>
>;DEFINE CMDM
DEFINE DISPM(A,B,C,D,E)<B,,IFIDN <C><><A;>C
>;DEFINE DISPM
DEFINE FLAGM(A,B,C,D,E)<D,,E>
FOR @! Y IN (X,M)
< LASTCM←←<400000,,0>
,Y!FLAG-Y!CMDS(D) ;2nd word before name table is indirect ptr to flag table
,Y!DISP-Y!CMDS(D) ;word before name table is indirect ptr to dispatch table
↑Y!CMDS:Y!CMD
< CMDM X
>↑N!Y!CMDS←←.-Y!CMDS
↑Y!DISP:Y!CMD
< DISPM X
>IFN .-Y!DISP-N!Y!CMDS<!>
↑Y!FLAG:Y!CMD
< FLAGM X
>IFN .-Y!FLAG-N!Y!CMDS<!>
>;FOR
BEND XDISPS
;EXTEND EXTEN1 EXTEN2 EXTL3 GETWRD EXTL0 EXTL0A EXTL EXTL1 EXTLK0 EXTLK EXACTM
EXTEND: MOVE E,[-NXCMDS,,XCMDS]
EXTEN1: SETOM XLAST# ;Flag last command as extended command (from WRRDO2)
SKIPE DPY
PUSHJ P,CMDCRL ;Put out CRLF if line long on display
PUSHJ P,LOADM0 ;Make sure ALLACT is ignored in line editor.
EXTEN2: OUTSTR [ASCIZ/ Command? /]
JUMPGE DSP,.+2 ;From line editor?
TRO F,EDITM ;Yes, force DISP to set up line editor
PUSHJ P,DISP
XCT LINTST
TRZ F,EDITM ;We are never supposed to have EDITM on here
MOVE Q,[440700,,EXTBUF] ;Byte pointer for saving ascii text of line
PUSHJ P,GETWRD ;Read command
JRST EXTNU0 ;No command given
JRST EXTLK0 ;Terminating char of command was activator
MOVEM Q,EXTPNT#
MOVSI T,70000
ADDM T,EXTPNT ;back up byte pointer to final char of cmd
EXTL3: PUSHJ P,TYI ;Loop collecting remainder of line in EXTBUF
JRST EXTLK
CAME Q,[100700,,EXTBFE-1]
IDPB C,Q
JRST EXTL3
GETWRD: MOVE D,[440600,,TT] ;Byte pointer for saving sixbit word
MOVEI TT,0 ;Sixbit word found
MOVE G,[440600,,XMSK] ;Byte pointer for saving mask
SETZM XMSK# ;Mask
MOVEI T,77
EXTL0: PUSHJ P,TYIU
POPJ P, ;No word found
TLNN T,LETF!NUMF
JRST EXTL0A
AOS (P)
JRST EXTL1
EXTL0A: CAIE C,40 ;Ignore leading spaces
CAIN C,13 ; and vertical tabs
JRST EXTL0
TLNE T,LSPC ;Ignore tabs and FFs (other specials activate)
JRST EXTL0 ;Ignore this char
IDPB C,Q ;Maybe save in EXTBUF
MOVEI TT,(C) ;Return right-justified ascii char
SETOM XMSK ;Make it look like 6-char word typed
JRST POPJ2 ;Double skip since terminator is not activator
EXTL: PUSHJ P,TYIU
POPJ P, ;Single skip if terminator is activator
EXTL1: CAME Q,[100700,,EXTBFE-1] ;DON'T CAUSE CLOBBERAGE IF HE'S VERBOSE
IDPB C,Q
TLNN T,LETF!NUMF
JRST POPJ1 ;Double skip if terminator is not activator
TLNN D,770000
JRST EXTL ;IGNORE AFTER 6
SUBI C,40
IDPB C,D
IDPB T,G ;GENERATE MASK
JRST EXTL
;here with activator immediately following cmd
EXTLK0: MOVEM Q,EXTPNT ;save byte pointer pointing to last char of cmd
EXTLK: MOVEI T,
IDPB T,Q ;Make sure input from EXTBUF via TYIPNT stops somewhere
MOVEM Q,EXTPN2# ;Save pointer to end of string, for EXTNU0
CAIN C,ALTMOD
JRST EXTNUL
MOVE D,E
CAMLE TT,(D) ;FIND FIRST COMMAND ≥ HIS
AOBJN D,.-1
JUMPGE D,EXTNF ;NONE
CAMN TT,(D) ;Is it an exact match?
JRST EXACTM ;Yes, win quick
MOVE T,XMSK
AND T,(D)
CAME T,TT
JRST EXTNF ;DOESN'T MATCH - HE LOSES
MOVE T,XMSK
AND T,1(D) ;See if typed name also matches next command in table
CAMN T,TT
JRST EXTAMX ;Ambiguous cmd
EXACTM: MOVE T,@-2(E) ;2nd word ahead of cmd name table pts to add-flag table
MOVE D,@-1(E) ;word ahead of cmd name table points to cmd dsp table
JRST XCMDX ; so we now have the dispatch table word and flag word
;⊗ EXTAMX EXTNF EXTNF0 EXTNF2 EXTAM3 FIXEXT ENDEXT EXTNU0 EXTNUL MACABT XTDACT XTDLIN XTDLI2 XTDLMT XTDBEG XTDEND SPLJOB SPLEXT SPLNAM EXTBUF EXTBFE
EXTAMX: JSP D,CPOPJ
SORRF Ambiguous command --
JRST EXTAM3
;Here if extended command name not found in table.
;See if there is a spooler by this name.
EXTNF:
IFN FTGSPL,< ;generic spooling command lookup in system
PUSHJ P,SPLCHK ;check command name against printer names
JRST EXTNF0 ;no match
MOVEI D,XCMDS+SPLCMD-XDISP ;set up pointer to extended SPOOL command
JRST EXACTM ;go dispatch
EXTNF0:
>;IFN FTGSPL
JSP D,CPOPJ
EXTNF2: SORRF Unknown command --
EXTAM3: PUSHJ P,ENDEXT ;terminate command name with null (saving text)
OUTSTR EXTBUF ;type back command name given
PUSHJ P,FIXEXT ;restore buffer text following command name
JRST PPJ1CR
FIXEXT: MOVE T,EXTSAV ;restore text of command line
MOVEM T,@EXTPNT ;flushes null we had inserted
POPJ P,
ENDEXT: IBP EXTPNT ;advance past cmd name
MOVE T,@EXTPNT ;Save delimiter
MOVEM T,EXTSAV#
MOVEI T,0
DPB T,EXTPNT ;terminate command name with null, making ASCIZ string
POPJ P,
EXTNU0: CAIN C,215 ;α<cr> means load line editor with last X command line
SKIPN DPY ;Can only load line editor if on display
JRST EXTNUL
SKIPLE CURMAC ;And this isn't currently allowed from a macro
JRST EXTNUL
MOVEI T,15
DPB T,EXTPN2 ;Replace null at end of command line with CR
PTLOAD [0↔EXTBUF] ;Load line editor with previous command
JRST EXTEN2 ;Now read it back after he edits it
EXTNUL: JSP D,CPOPJ
ANDI C,177
CAIN C,15
POPJ P,
MACABT: OUTSTR [ASCIZ / Aborted. /]
PUSHJ P,MACSTP ;Terminate macro expansion
JRST POPJ1
;Call here to stuff char in C back into input pointer to be reread later.
XTDACT: SKIPA T,[1] ;make tyipnt nonzero but return zero byte
;Routine called by Extended command routines to prepare to reread command line.
;Normally you get to reread the cmd delimiter, but you can avoid that (like FIND
;does) by calling XTDLMT before calling XTDLIN.
XTDLIN: MOVE T,EXTPNT ;Get pointer to text following command name
XTDLI2: MOVEM T,TYIPNT ; and use it for text input
HRLI C,(<MOVEI C,>) ;Make end of line return original cmd activator
MOVEM C,TYIINS
POPJ P,
;Call this routine to skip non-activator delimiter of extended cmd name (like
;FIND does). Call before calling XTDLIN above.
XTDLMT: MOVE TT,EXTPNT
ILDB T,TT ;check char after command name
JUMPE T,CPOPJ ;return quick if activator
IBP EXTPNT ;else skip over that delimiter
POPJ P,
;Routine to begin reading extended command line, returns first char in C.
;Skip returns iff first char is activator.
XTDBEG: PUSHJ P,XTDLIN
PUSHJ P,TYI
AOS (P)
POPJ P,
;Routine called to make sure everything in extended command line was parsed.
;Doesn't return if error.
XTDEND: SKIPN TYIPNT ;Did whole line get read?
POPJ P, ;Yup
PUSH P,TYIPNT ;Get pointer to remaining text
SETZM TYIPNT ;Don't read any more from command line
CAIN C,";" ;Allow semicolon to mark comments on extended command line
JRST POPUP ;Flush data from stack and return
POP P,TT ;Get back byte pointer
SORRF Syntax error in extended command line --
MOVSI T,'TTY' ;Type out to self
ADD TT,[70000,,0] ;Back up over first offending character
TLZ TT,7777 ;Type up to null
MOVEI D,T
TTYMES D, ;Type message to self
JFCL ;Can't happen, always waits for self
JRST POPUP1
IMPURE
IFN FTGSPL,<
;Following three labels must be in this order for SPOOLR UUO.
SPLJOB: 0 ;job name of spooler phantom returned here
SPLEXT: 0 ;command file ext for spooler returned here
SPLNAM: EXTBUF ;pointer to place where printer name appears
>;IFN FTGSPL
EXTBUF: BYTE (7)15 ;CR to make initial ⊗Xα<cr> load an empty line
BLOCK 37
EXTBFE←←.
PURE
;READON ROSET READWR NORDOW NORDWR NORDW2 THISPA THISP2 CANCEL DPYALW DPYSKI DPYALW DPYSKI
READON: PUSHJ P,NOFDEL ;make sure file isn't marked for deletion
IFN BOOKMD,<
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READONLY FROM /B MODE
>;END BOOKMD
TRNE F,REDNLY
POPJ P,
PUSHJ P,CLOSIT
SETOM RDONLY
TRO F,REDNLY
MOVEI T,<BYTE(7),,,"/","R"(1)1>
ROSET: MOVEM T,ROFLG
EXCH T,ROFLG2
CAME T,ROFLG2
PUSHJ P,DSHED ;Force display of header line
IFE DECSW,<
JRST PROTEL ;Tell user if file is write-protected unless /R
>
IFN DECSW,<
POPJ P,
>
READWR:
IFN BOOKMD,<
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READWRITE FROM /B MODE
>;END BOOKMD
TRNE F,FILLUZ
JRST NORDWR
SETZM RDONLY
MOVEI T,1
TRZE F,REDNLY
JRST ROSET
POPJ P,
IFN BOOKMD,<
NORDOW: SORRY Cannot change from BOOKMODE (/B).
JRST POPJ1
>;END BOOKMD
NORDWR: MOVEI T,1
CAMN T,PAGES ;If file is only one page,
TRNN F,DIROK ; and we have seen all of file,
JRST NORDW2
HRLOI T,1 ; then let him change to READWRITE mode.
MOVEM T,EDFIL+4 ;Mark file as /N
MOVEM T,DROOM ;Strange number to force trailer R recomputation
MOVEM T,DBLOAT ; " " " " " C,X,B "
TRZ F,FILLUZ ;And formatted
TLO F,DSPTRL ;Now redisplay trailer line
PUSHJ P,SETHD2 ;Update filename and /N in header
JRST READWR
NORDW2: SORRY File not formatted.
JRST POPJ1
;Command routine for XTHISPAGE command.
;Write out page and keep only arrow page in core.
THISPA: PUSHJ P,GPAGL ;Find out what page and line we're at
HLRZM T,SLINE ;Set up starting line
MOVEI A,(T) ;Number of sole page we want in core
MOVE B,TOPWIN ;We want to preserve the window setting
CAMN A,FIRPAG ;Is page we want the first one currently in core?
JRST THISP2 ;Yes, use window setting as is
HLRZ TT,PMLNBR(TT) ;Get line number of pagemark for arrow page
SUB B,TT ;Make window line relative to arrow page
THISP2: MOVEM B,SWIND ;Save window for restoring later
JRST NEWPG0 ;Read one page in (after writing current text out)
CANCEL: MOVE T,ZINDEX ;Restore marks to last saved values
HRLI TT,ZDATA+ZMARK(T)
HRRI TT,MARKS
BLT TT,MARKS+NMARKS-1
MOVE A,ARRL
MOVEM A,SLINE
MOVE A,TOPWIN
MOVEM A,SWIND ;Starting window is same as now
PUSHJ P,FLSPG0 ;Remember where coming from, flush incore page(s)
SETOM OLDFAS ;Prevent OLDSAV from changing line stack
MOVE A,FIRPAG
JRST NEWPG1 ;Read the first page back in again
IFE DECSW,<
DPYALW: SKIPA T,[¬<JFCL>] ;ALWAYS UPDATE DISPLAY
DPYSKI: HRLOI T,<(¬<INSKIP>)> ;ONLY UPDATE DISPLAY IF NO INPUT READY
SETCAM T,CHRTST#
MOVNM T,LINTST#
POPJ P,
>;NOT DECSW
IFN DECSW,<
DPYALW: MOVSI T,(<JFCL>)
MOVEM T,CHRTST#
MOVEM T,LINTST#
POPJ P,
DPYSKI: MOVSI T,(<SKPINC>)
MOVEM T,CHRTST#
MOVSI T,(<SKPINL>)
MOVEM T,LINTST#
POPJ P,
>;DECSW
;⊗ DDTLUZ WRTABL DDTDDT DDTGO DDTOK DDTRET DRAW0 DRAW DRAWXL DRAWX DRAWM LINCNT LINCN4 LINCN3 LINCN2 LINCN5 TRAILE HEADER HEADE2
DDTLUZ: SORRY Couldn't unpurify upper segment.
JRST POPJ1
WRTABL: AOS (P) ;Will skip if can allow writing in upper segment
IFN DECSW,<
MOVEI T,0
SETUWP T,
>
IFE DECSW,<
UNPURE
>
SOS (P) ;Still write protected--lose
POPJ P,
DDTDDT: PUSHJ P,WRTABL ;Debugger is DDT, not RAID, so try UNPURE now
JFCL
JRST @JOBDDT ;Also, no need to erase screen and redraw later
DDTGO: SKIPN TT,JOBDDT
JRST EXTNF2 ;No DDT
TRNN TT,400000
JRST DDTOK
PUSHJ P,WRTABL ;DDT in upper segment, so make it writable segment
JRST DDTLUZ
DDTOK: MOVE T,[10000,,CPOPJ] ;RETURN FROM RAID or DDT VIA <CTRL>P or $P
MOVEM T,JOBOPC
LDB T,[331100,,2(TT)]
CAIN T,<PUSHJ>⊗-33 ;Is the debugger RAID?
JRST DDTDDT ;No, it's DDT
IFE DECSW,< ;Clearly DEC doesn't have Data Discs
HRRZ TT,-3(TT) ;Get ptr to $M at DDT-3
MOVE T,MASK ;This is the mask for DD command words in
MOVEM T,1(TT) ; byte size 0 ($M+1)
SETOM -3(TT) ;disable RAID's diddling of PP position! ($M-3)
MOVEI T,1
MOVEM T,-2(TT) ;make RAID select PP number 1 ($M-2)
PGACT ;Zero address field means invisible glass
>;NOT DECSW
PPSEL 1 ;Select piece of paper 1
HRRZ T,JOBDDT
SKIPE DMLINE
DPYOUT [1000,,0↔0] ;flush DM output
PUSHJ P,(T) ↔R←←CPOPJ
DDTRET: DPYOUT RAIPOG,[1000,,0↔0] ;Flush RAID's display on III and on DM
IFG DEBSW-PURESW,<PUSHJ P,PURCLC>
POPJ P, ;no longer force whole redisplay
DRAW0: TLOA F,TF1 ;extended cmd, redraw even if in macro
DRAW: TLZ F,TF1 ;normal cmd
PUSHJ P,DPYCHK
PUSHJ P,@PPSET
MOVE T,NODISP ;remember old setting of display suppression
MOVEM A,NODISP ;set or clear display suppress flag (neg is set)
MOVEI TT,1
SKIPGE A
MOVEI TT," V"⊗1+1 ;V on hdr means display updating is suppressed
HRRM TT,EMFLG ;store for DISP
SETOM NEEDHD ;set flag to make HEADS think about hdr line
IOR T,A ;OR of previous and current suppression states
CAIE B,CTMT3 ;explicit αβV means really erase (unless in macro)
JUMPL T,DRAWM ;if entering or leaving suppression mode, just update
TLNN F,TF1 ;skip if extended cmd, ignore macro check
SKIPG CURMAC ;skip if in macro
CAIA ;extended cmd or not in macro, redraw screen
JRST DRAWM ;Called from inside macro, just update screen.
SKIPN DPY
JRST DRAWX
IFE DECSW,<
HRROI TT,[004000,,"P"] ;Do ESC P to redraw PP
CAIN B,CTMT3 ;Is this double bucky cmd?
HRROI TT,[004000,,400+"P"] ;Do BRK P to erase all and redraw PP
TTYSET TT,
>
IFN DECSW,<
CAIN B,CTMT3 ;Is this double bucky cmd?
SKIPA TT,[3,,[.TOESC ↔ 0 ↔ <400000+"P",,0>]] ;BRK P
MOVE TT,[3,,[.TOESC ↔ 0 ↔ <"P",,0>]] ;ESC P
TRMOP. TT,
JFCL
>
DRAWXL: MOVEI TT,0 ;Wait for the erase
SLEEP TT,
CAIE B,CTMT3
JRST DRAWX ;One sleep if not erasing
PPINFO RBUF ;We have to wait for erase or DISP will redraw again
MOVE T,RBUF+2
JUMPL T,DRAWX ;No more waiting if III
SLEEP TT, ;Try to avoid making the ESC P lose
TLNN T,200000 ;ESC C (or similar) typed?
JRST DRAWXL ;No, wait some more
DRAWX: TRO F,DSPALL ;Force redisplaying everything
SETOM LEPOS
DRAWM: PUSHJ P,DISP0
JFCL ;Force display out now
SKIPLE CURMAC
DPYOUT [0↔0] ;Wait for display to finish going out
JUMPLE A,CPOPJ
TRNE F,ARG!REL ;Positive arg means wait that long after displaying
SLEEP A, ;Then wait number of seconds requested
POPJ P,
LINCNT: PUSHJ P,ABCRLF
PUSHJ P,GPGLS ;TT ← <line>,,<page>; T ← <lines>
SETZM TYOPNT
OUTSTR [ASCIZ /Line /]
HLRZ C,TT
TYPDEC C ;Line number
OUTSTR [ASCIZ / of /]
TYPDEC T ;Number of lines on current page
OUTSTR [ASCIZ / prints /]
MOVE C,ARRLIN
HRRZ C,TXTCNT(C)
TYPDEC C
OUTSTR [ASCIZ / columns. /]
MOVE TT,CURPAG
MOVE T,CHARS
SKIPN G,XPLST
JRST LINCN2 ;Only one page in core
LINCN4: HLRZ B,PMLNBR(G) ;Get line number of pagemark
CAML B,ARRL
JRST LINCN3
HRRZ G,(G) ;Next pagemark
JUMPN G,LINCN4
MOVE T,CHARS ;Pointing to final in-core page
SUB T,XCHRS ;XCHRS is chars in non-final pages
JRST LINCN2
;INCN3: LDB T,[341000,,1(G)] ;Get record count for this page
LINCN3: LDB T,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;Get record count for this page
IMULI T,200*5
; LDB TT,[221200,,PMSIZE(G)] ;Get excess char count
LDB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;Get excess char count
ADDI T,(TT)
HRRZ TT,PMSIZE(G) ;Get page number
SUBI TT,1 ;This is chars for prev page
LINCN2: TYPDEC T
OUTSTR [ASCIZ / chars on page /]
TYPDEC TT
OUTSTR [ASCIZ /. /]
TRNE F,ATTMOD
JRST LINCN5
JRST POPJ1
LINCN5: SKIPN DPY
OUTSTR [ASCIZ/
/]
TYPDEC ATTNUM
OUTSTR [ASCIZ/ lines attached.
/]
JRST POPJ1
;Extended command routine.
TRAILE: TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAILS ;Yes, do it so we can use data from it
MOVE TT,TRLBLK ;Address of current trailer block
JRST HEADE2
HEADER: PUSHJ P,HEADS ;Set proper hdr text for UIAML, subjob flags, line
MOVE TT,HEDBLK ;Address of current header block
HEADE2: MOVE A,-1(TT) ;Get length of block in words+2
SUBI A,2+LLDESC ;Make it length of text in words
IMULI A,5 ;Convert to bytes
HRLI TT,(A) ;Byte count for UUO
ADD TT,[440000,,LLDESC] ;Skip over non-text of line's FS-like block
MOVSI T,'TTY'
MOVEI A,T ;Address of args for UUO
NULMES A,
JFCL ;Error can't happen since typing on own TTY
JRST CPOPJ1
;⊗ NOEXIT GETOUT GETOU2 GETOU0 GETOU1 REOLUZ REWLUZ FINISH FINI1 FINI3 FINI01 FINI0 FINI02 FINI5 FINI6 FINI7 FINI8 FINNDL FINI4 FINI2 GORPG GODRD GORPG2 CLSFIN CLSFI2 QUIT1 CLOSIT CLOSDO REOPEN REOPE2
NOEXIT: SORRF <Can't exit with ⊗E cmd while expanding a macro--use ⊗#⊗XEXIT or ⊗XQUIT.>
JRST POPJ1
;Here from ⊗E command; either exit (if no arg, no lines attached) or diddle
;attach buffer.
GETOUT: JUMPE A,CPOPJ ;Zero arg is no-op
TRNE F,ATTMOD
JRST ATTEX0 ;Put down some or all attached lines instead of exiting
TRNE F,ARG!REL ;Negative arg means attach previous lines, like -#A
JUMPL A,ATTACH ;Go attach as if command were ⊗A instead of ⊗E
TRNE F,ARG!REL
JRST ERR ;Positive arg with no lines attached is illegal
SKIPE CURMAC
JRST NOEXIT ;Can't exit while inside a macro
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST GETOU2 ;can't write it or don't need to, WRPAGE will succeed
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPJ1 ;can't open file (typed error msg) (or ABORT given)
GETOU2: CAIN B,3 ;αβE closes all windows and exits just like ⊗XEXIT
JRST CLSALL ;close up shop
SKIPE NWINS ;Are there multiple windows?
JRST CLSWIG ;yes, close and write window, select previous window
GETOU0: PUSHJ P,FINISH ;Write page, maybe delete file, close file, TMPCOR, erase
JRST POPJ1 ;failed to open file to write it out. back to E, no OK.
GETOU1: PUSH P,TOPWIN
SETZM BRKTAB+3 ;No special bits now.
SETACT [BRKTAB] ;Clear EMODE before returning to monitor.
OUTSTR [ASCIZ/Bye/]
PUSHJ P,CLOSDO ;Flush DSKO channel
PUSHJ P,BYE ;Do an EXIT 1,--come back if he types CONTINUE
JFCL ;BYE skips
HLLOS SCRHGH ;make this cell big to force SETSCR/CHKHGH to fix it
PUSHJ P,REOPEN ;Get the edit file open again
JRST REOLUZ ;The file changed, can't continue the quick way
PUSHJ P,DPYINI ;Now restore display
POP P,A ;Get saved TOPWIN
JRST SETWIN ;And restore window position
REOLUZ: SETOM TTYNUM ;Force DPYCHK to initialize terminal
SETOM DPY ; "
;Enter here from CONTIN failing to reopen file that was in old window.
REWLUZ: PUSHJ P,CLOSDO ;Flush DSKO channel that we just opened
TRZE F,WRITE
PUSHJ P,SAVE0 ;He must have done an XQUIT--save copy of changed text
PUSHJ P,ZSAVE ;Save marks and position in file, flush FS
PUSHJ P,TELLZ ;ZSAVE has to skip since WRITE was off!
HRROS LAMFLG ;If file extended, make us edit at new part
JRST EPSIL3 ;Now act like we are aborting a fileswitch (quietly)
;Write out file, close file, erase screen, restore wholine.
;Skips if successful, error (direct) return taken if can't open file to write.
FINISH: PUSHJ P,FINI0 ;Write out current page, maybe delete file
POPJ P, ;failed to open file
AOS (P) ;now always take success return
FINI1: PUSHJ P,FINI4 ;Close the file, release cache, write TMPCOR file
FINI3: PUSHJ P,FINI2 ;Erase the whole screen
DPYCLR ;Back to normal PP
PUSHJ P,WHOON ;Restore wholine, if we had turned it off
JRST ABCRLF ;Put out CRLF if needed
;Write out file and maybe delete it.
;Skips unless fails to open file when needed to write it out.
FINI01: HRRZS (P) ;flag not coming from FINISH, no PPSEL even if deleting
JRST FINI02
;Entry point from FINISH, otherwise just like FINI01
FINI0: HRROS (P) ;set flag as coming from FINISH, do PPSEL if deleting
FINI02: PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST FINI5 ;can't write it or don't need to, WRPAGE will succeed
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
POPJ P, ;can't open file (typed error msg), don't write out
FINI5: AOS (P) ;skip on expected success for any needed file opening
PUSHJ P,WRPAGE ;Write out current page if needed
SKIPE DELFI2 ;Explicit delete requested?
JRST FINI6 ;Yes
TRNN F,REDNLY ;Now see if we should delete this file (and do it, if so)
SKIPN DELFIL ;Was last text of file deleted by ∂ command?
POPJ P, ;No
SETZM DELFIL ;Make sure we don't screw someone later somehow
HLRZ TT,EDFIL+1 ;Yes
MOVE T,EDFIL+PPN3
CAIN TT,'MSG' ;Is this a .MSG[2,2] file?
CAME T,[MSGPPN]
POPJ P, ;No
JRST FINI7 ;go delete file
;here to satisfy an explicit request to delete the file being edited
FINI6: MOVS T,DELFI2 ;before we delete the file, do some redundancy checks
CAME T,EDFIL ;does delete flag have right form (match filename)?
PUSHJ P,TELLZ ;nope, bomb out instead of accidentally deleting file
MOVS T,DELFI3 ;check /Q switch
JUMPE T,FINI7 ;jump if was off
CAME T,EDFIL+PPN3 ;should match the PPN
PUSHJ P,TELLZ ;no match, bomb out, something is wrong
FINI7: SETZM DELFIL ;clear ⊗∂αβD implicit-delete flag
SETZM DELFI2 ;clear explicit-delete flag
MOVE T,EDFIL+PPN3 ;need proper PPN for delete
MOVEM T,LKUP+PPN3 ;store in Rename block
SETZM LKUP ;make first word zero to delete file
RENAME DSKO,LKUP ;delete whole file now
JRST FINNDL ;failed
MOVE A,[ASCII/ Dele/] ;start out w/"deleted" message at BUF
MOVEM A,BUF
MOVE A,[ASCII/ted: /]
MOVEM A,BUF+1
MOVE A,[POINT 7,BUF+1,34]
MOVEM A,TYOPNT ;byte ptr for continuing msg in BUF
MOVE D,[FRDRUN,,EDFIL]
PUSHJ P,FILSTR ;output name of file that was deleted
PUSHJ P,PP0TYP ;type whole msg on current PP and on PP 0, w/crlf
;now move deleted file to bottom of file stack
FINI8: MOVE TT,HOMMAX ;get size of file stack, - 1
CAIL TT,ZNUM ;make sure room at the bottom
POPJ P, ;this shouldn't happen..
MOVE T,ZINDEX ;put deleted file at bottom of stack
TLO T,ZINUSE ;make sure stack entry is nonzero
MOVEM T,HOMPLC(TT) ;insert at bottom of stack
AOS HOMMAX ;note stack is "bigger"
SETOM HOMFAS ;keep HOMSAV from saving prev file in stack
POPJ P,
;Here if file delete failed, say why.
FINNDL: SORRF File deletion FAILED --
MOVE T,EDFIL-1 ;get device name
MOVEM T,LKUP-1 ;make FILERR type whole filename right
MOVE T,EDFIL
MOVEM T,LKUP ;make FILERR type the whole filename
MOVE T,EDFIL+EXT1
HLLM T,LKUP+EXT1 ;these weren't set up before the rename
MOVE D,[FRDRUN,,LKUP]
PUSHJ P,FILERR ;type error msg and name of file
TYPCHR " "
JRST FINI8 ;assume was already deleted (e.g., by someone else)
FINI4: TLZE F,ENTRD
CLOSE DSKO, ;MAKE SURE THE FILE GETS OUT
SETZM DELFIL ;In case from ⊗XQUIT, clear the flags that would
SETZM DELFI2 ; have had us delete the file.
IFN FTBUF,<
PUSHJ P,CACRLO ;Release cache from output channel
>;FTBUF
PUSHJ P,TMPWRT
IFN BOOKMD,<
SKIPE BKPSW ;STARTED BY "BOOK" COMMAND?
PUSHJ P,BKPWRT ;YES, WRITE OUT <FILENM>.BKP FILE
>;END BOOKMD
POPJ P,
;Erase all of screen we're using
FINI2: SKIPLE DPY ;XHEIGHT command enters here to clear whole screen
PPACT ;STOP ANDY FROM WRITING
MOVN T,PPPOS ;negative of line number of first PP line
SUB T,PPSIZ ;make it number of line after PP
ADD T,SCRHGH ;minus number of highest line used on screen is nbr of lines
HRL T,SCRHGH ;highest line is place to start erase
MOVSM T,NWIPE# ;flag special erase for WIPE
SKIPE DDACT ;skip unless last display output hasn't finished
DPYOUT [1000,,0↔0] ;wait for DD display, flush pending DM display
PUSHJ P,WIPE ;BLAST THE SCREEN
SETZM NWIPE ;special erase done
SKIPE DDACT ;WAIT FOR WIPE
DPYOUT [0↔0]
POPJ P,
;Swap to Snail
GORPG:
IFE DECSW,<
MOVEI A,[SIXBIT /SYS SNAIL DMP/↔1↔0]
>;IFE DECSW
IFN DECSW,<
MOVEI A,[1,,[SIXBIT /SYS COMPIL/ ↔ 0 ↔ 0 ↔ 0 ↔ 0]]
>;IFN DECSW
JRST GORPG2
;Swap to Dired
GODRD:
IFE DECSW,<
MOVEI A,[SIXBIT /SYS DIRED DMP/ ↔ 1 ↔ 0]
>;IFE DECSW
IFN DECSW,<
MOVEI A,[1,,[SIXBIT /SYS DIRED / ↔ 0 ↔ 0 ↔ 0 ↔ 0]]
>;IFN DECSW
GORPG2: MOVEM A,SWAPTR# ;save ptr to SWAP or RUN UUO block
PUSHJ P,CLSFIN ;write TMPCOR, close files and windows
JRST POPJ1 ;failed to open a window or file to write it out, no OK
MOVEI
MOVEI 17,1
BLT 17,17
MOVE A,SWAPTR ;get ptr to SWAP or RUN block
IFE DECSW,<
SWAP A,
>
IFN DECSW,<
RUN A, ;SOMEDAY WORRY ABOUT PASSING THE ACS
>
PUSHJ P,TELLZ
;Here when exiting possibly with multiple windows open.
;We write out the TMPCOR file, close all the windows and skip on success.
;If a file can't be written out, takes the direct return.
CLSFIN: PUSHJ P,TMPWRT ;write out TMPCOR file, if appropriate
PUSH P,SYSCMD ;save this so we can zap it for now
SETZM SYSCMD ;prevent closing routines from writing TMPCOR
PUSHJ P,CLSEM ;close all but one window (write each out)
JRST CLSFI2 ;failed to open some window's file to write it out
PUSHJ P,FINISH ;close last window (write out and erase screen)
JRST CLSFI2 ;failed to open file to write it out.
POP P,SYSCMD ;restore TMPCOR flag on general principles
PUSHJ P,LSPWRC ;warn of detached lisp subjobs
JRST POPJ1 ;skip on success
CLSFI2: POP P,SYSCMD ;restore flag for TMPCOR
POPJ P, ;we failed somewhere, take error return
QUIT1: PUSHJ P,FINI1 ;Close the file without writing out any changes
JRST GETOU1 ;Exit but allow him to get back into E by CONTINUE
CLOSIT: TLZN F,ENTRD
POPJ P,
PUSHJ P,CLOSDO ;Flush DSKO channel
PUSHJ P,REOPEN ;Now get the edit file open again
PUSHJ P,TELLO ;Oops, it must have changed in the meantime
POPJ P,
CLOSDO: RELEAS DSKO,
SETZM JOBJDA+DSKO
IFN FTBUF,<
PUSHJ P,CACRLO ;Release cache from output channel
>;FTBUF
POPJ P,
REOPEN: MOVE C,ICHN ;Get channel being used for input
CAIE C,DSKO ;Is it same as channel used for output?
JRST POPJ1 ;No, take success return quickly
MOVE A,IBLK ;This is USET value we want to be open at
REOPE2: PUSH P,EDFIL+2 ;Save current file's date/time written plus prot and mode
PUSH P,FILWC ;Save file's word count
MOVEI D,EDFIL ;Re-open the file we were editing
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
POP P,TT
POP P,T
CAME TT,FILWC ;See if file's word count changed while we were gone
POPJ P, ;It changed! Error return.
IFN DATOK,<
CAME T,EDFIL+2 ;See if file's time written changed while we were gone
POPJ P, ;Date/time change! Error return
>;DATOK
JRST POPJ1 ;No change, success return
;⊗ NEWPAG NEWPG0 NEWPG7 NEWPG6 NEWPG1 PGINIT PGERR1 PGERR2 PGERR NEWPG2 NEWPG5 NEWPG3 NEWPG8 NEWPG4
;We enter here when we ask for a new page. This requires a DIRECTORY lookup.
;The start of the directory is pointed to by DIR and its end by DIREND while
;the current page is pointed to by DIRPT.
;** NOTE ** These routines do not guarantee actually writing out the current page!
;If the file cannot be opened now (file busy), then the page won't be written
;out and we'll skip (skip return usually means No Such Page as that requested).
;Caller must check for WRITE bit being off if must have the page written out
;before continuing. Cmd routines that jump here, however, don't have to worry
;since they don't assume the page actually got written. The user will see
;the error msg, File Can't Be Opened, if the page isn't written. (Entries
;NEWPG2/5 don't even try to write out the page if new page is already in core.)
JRST DIRSRC
NEWPAG: CAIE B,CTMT3 ;αβ means force out current page(s) no matter what.
JRST NEWPG2 ;Get to line 1 of given page, which might be in core already
TRNE F,NEG
SUB A,XPAGES
TRNE F,ARG
TRNE F,REL
ADD A,CURPAG
NEWPG0: PUSH P,A
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file and WRITE on
JRST NEWPG7 ;can't write it or don't need to
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPAJ1 ;can't open file (typed error msg), or ABORT given
NEWPG7: PUSHJ P,WRPAGE ;OUT WITH THE BAD PAGE
MOVE A,(P) ;Page he asked for
CAMLE A,PAGES ;Is there such a page?
TRNN F,DIROK ;(might be, if haven't seen all yet)
JRST NEWPG6 ;Yes
MOVE T,CURPAG ;No, see where we are
CAMN T,PAGES ;Do we already have the last page in core?
JRST PGERR2 ;Yes, don't reread the same page in again
NEWPG6: PUSHJ P,FLSPG0 ;Remember where coming from, flush incore page(s).
POP P,A
NEWPG1: SETZM DELFIL ;Don't delete this file--for CANCEL and maybe others
SKIPN DELFI3 ;skip if want to delete file even after diddling around
PUSHJ P,NOFDEL ;turn off explicit file-delete flag (changing pages)
PUSHJ P,RDPAGE ;AND IN WITH THE GOOD
PUSH P,[PGERR]
PUSHJ P,CORCHK ;maybe core down
PGINIT: MOVEI A,1
EXCH A,SLINE ;Get starting line number, reset for next time
PUSH P,OLDFAS ;Save this flag
PUSHJ P,SETARR ;Position the arrow to right line
SKIPN (P) ;Skip if we are supposed to preserve line stack
SETZM OLDPLC ;No old line to go back to
SUB P,[1,,1]
TRO F,DSPSCR
MOVEI A,1
EXCH A,SWIND ;Get starting window, reset for next time
JRST SETWIN ;Position the window as requested, and return
PGERR1: PUSHJ P,APPFIN ;Here from append--finish any appending we did
PGERR2: SUB P,[1,,1] ;Flush data from stack
PGERR: SORRY No such page.
JRST POPJ1
;Here to see if the page he wants is already in core.
NEWPG2: PUSHJ P,GPAGL ;Find out what page we are really on
TRNE F,ARG
TRNE F,REL
ADDI A,(T) ;Relative to "arrow page"
NEWPG5: CAMG A,CURPAG ;Here to go to line SLINE of page A, maybe in core
CAMGE A,FIRPAG
JRST NEWPG0 ;Not in core, flush current page, get new one
;Now we set A to the number of the incore line BEGINNING the page of interest
;(in case of multiple incore pages). We'll position relative to there.
SUB A,FIRPAG ;Find relative page in core desired
MOVEI G,XPLST ;initialize ptr into list of incore pagemarks
JUMPE A,NEWPG3 ;jump if desired page is first one in core
HRRZ G,(G) ;Pointer to next pagemark
JUMPE G,NEWPG4 ;Better be a pagemark there
SOJG A,.-2 ;Count down till we get to right pagemark
HLRZ A,PMLNBR(G) ;Get line number of pagemark
;Now we set TT to the number of the incore line ENDING the page of interest
;(in case of multiple incore pages). That'll be limit of positioning.
NEWPG3: HRRZ G,(G) ;next pagemark (if any) indicates max line of page
MOVEI TT,-1 ;limit (none) to line number if want last page in core
JUMPE G,NEWPG8 ;jump if no more pagemarks
HLRZ TT,PMLNBR(G) ;get line number of next pagemark
NEWPG8: MOVEI T,1 ;re-initialize starting line number for next time
EXCH T,SLINE ;Pick up and reset starting line number
ADD A,T ;Make it line number of all incore text
CAILE A,(TT) ;given page have enough lines?
MOVEI A,(TT) ;no, go (only) to end of given page
JRST SETARR ;Move arrow to requested line of requested page
NEWPG4: FATAL <Page supposedly in core already, but I can't find it!!>
;VERTAB VERTB2 FORMF FORMF2 FINSRT UNWIND WIND0B VERTB3 WIND WIND0 WIND0A WIND1
VERTAB: JUMPE B,UNWIND ;With no control bits, just like -W
TRNE F,ARG!EDITM ;Any arg or from line editor means do -nW
JRST UNWIND ;don't cross page boundary
TRNE F,NEG
JRST FORMF2 ;-VT means FF
VERTB2: MOVE A,TOPWIN ;Back up a window, possibly crossing page boundary
MOVE T,FIRPAG
CAMLE T,DIRPAG ;Can't backup beyond directory page.
CAILE A,1 ;Skip if we are currently viewing top of page.
JRST VERTB3
HRLOI A,377777 ;Very large positive number for
MOVEM A,SLINE ; starting line number for NEWPG0
MOVE A,FIRPAG
SUBI A,1
PUSHJ P,NEWPG0 ;Back to previous page
JFCL ;NEWPG0 skips on error, although that shouldn't happen here
POPJ P, ;(can happen if can't open file to write old page)
FORMF: TRNE F,ARG!EDITM
JRST WIND ;With arg or from line editor, just do W
TRNE F,NEG ;Does he want -FF?
JRST VERTB2 ;Yes
FORMF2: MOVE A,BOTWIN ;Forward a window, possibly crossing page boundary
MOVE T,CURPAG
CAMGE T,PAGES
CAMG A,LINES
SOJA A,WIND1 ;Just advance a window
MOVE A,CURPAG
AOJA A,NEWPG0 ;Go to beginning of next page
UNWIND: MOVNS A
JUMPN A,WIND0
WIND0B: TRNE F,NEG ;-0<vt> is really 0<ff> (and vice versa)
ADDI A,1 ;0<ff> or 0W moves forward a half window
PUSHJ P,WIND0A ;0<vt> moves back a half window
JRST JMPJMP ;Make it a half-window move
VERTB3: MOVNI A,1
WIND: TRC F,NEG ;Just for 0 arg, invert sense of test at WIND0B
JUMPE A,WIND0B ;Jump if 0 arg
WIND0: JUMPGE A,WIND0A
ADDI A,1 ;End point is relative to TOPWIN--VT goes to TOPWIN
WIND0A: MOVE B,ATTNUM ;To allow for space occupied by ATTACH
CAMLE B,ATTMAX ;which may be 0 but
MOVE B,ATTMAX ;which is never more than some max
MOVNS B
ADD B,SCRSIZ ;Number of non-attached text lines in window
CAIE A,1 ;Special treatment for this case only.
SKIPA T,SCRSIZ ;Normally move by whole window size
MOVE T,B ;Only move by amount of unattached text in window
IMULI A,-3(T) ;Times one less than nbr of text lines in window
ADD A,TOPWIN
WIND1: CAML A,LINES
ADDI A,1
SKIPN OLDMOV# ;Are we in middle of multiple FFs and VTs?
SETOM OLDFAS ;Yes, don't remember where we came from
SETOM OLDMOV ;We are now middle of such cmds at least
PUSHJ P,SETARR
CAMG A,TOPWIN
SUBI A,-3(B) ;Moving up, position us at bottom of new window
JRST SETWIN
;LT GT LTE GTE TOP TOP1 BOT BOT1 MIDDLE
LT: MOVNS A
GT: ASH A,2
AOS (P)
JRST MOVARR
;move by (multiples of) half window size
LTE: MOVNS A
GTE: MOVE T,SCRSIZ ;get screen size
LSH T,-1 ;half screen size
SOJ T, ;not counting hdr/trlr
IMUL A,T ;times numeric argument used, if any
JRST MOVARR ;move that far
TOP: JUMPL A,BOT1 ;-5∧ means 5∨
JUMPE A,MIDDLE ;Zero means middle of screen
TOP1: MOVM A,A
ADD A,TOPWIN
CAMLE A,BOTWIN
MOVE A,BOTWIN
SOJA A,SETARR
BOT: JUMPL A,TOP1 ;-5∨ means 5∧
JUMPE A,MIDDLE ;Zero means middle
BOT1: MOVM A,A
MOVN A,A
ADD A,BOTWIN
CAMGE A,TOPWIN
MOVE A,TOPWIN
JRST SETARR
MIDDLE: MOVE A,BOTWIN ;Position arrow at middle of current screen
SUB A,TOPWIN
ASH A,-1 ;DIVIDE BY 2
ADD A,TOPWIN
JRST SETARR
;JMPGL JMP JMP0 JMPJMP JMP1 JMP2 JMP2A CHKMOV CHKMV2 CHKMV3 UPARR DWNARR EDTEND SEMICO COLON COLON2 COLON3 COLON4
JMPGL: TRO F,ARG ;Here from glitching command given from line editor,
MOVN A,B ; which means we shouldn't glitch arrow off screen
JMP: JUMPLE A,JMP1
TRNN F,ARG
JRST JMP0
ADD A,TOPWIN
CAMLE A,ARRL
JMP0: MOVE A,ARRL
JRST SETWIN
JMPJMP: MOVEI A,0 ;Center the window around the arrow
JMP1: MOVE B,EXTRA ;Extra lines from attachment or wraparound line ed.
JUMPL A,JMP2
MOVN A,SCRSIZ ;Here with zero arg--move arrow to middle
SUB A,EXTRA ;Pretend screen is smaller if text attached
SUBI A,3 ;If even screen size, pretend one bigger. Fudge too.
ASH A,-1 ;Half of screen size
ADD A,ARRL
ADDI A,3(B)
JRST SETWIN
JMP2: TRNN F,ARG
MOVNI A,-1 ;Move arrow line to bottom if no arg
TRNN F,EDITM ;Are we gonna go back to line editor?
JRST JMP2A ;No
MOVE TT,ARRLIN ;Yes
HRRZ T,TXTCNT(TT)
XCT LETST ;Is line editor gonna wrap around now?
TDZA B,B ;Nope
MOVEI B,1 ;Yup, need an extra blank line
JMP2A: ADD A,TOPWIN ;See what new bottom line number will be
ADD A,SCRSIZ ;Add distance from top to bottom + 3
SUBI A,3(B) ;Extra lines mean lower-numbered line is at bottom
CAMGE A,ARRL ;Would bottom line be ABOVE arrow?
MOVE A,ARRL ;Yes, only move arrow to bottom
ADDI A,3(B)
SUB A,SCRSIZ
JRST SETWIN
;Routine to check arg for ↑↓;: cmds and move to new line. Call with JSP TT,CHKMOV
;Doesn't return on attempt to move up from first incore line.
;Doesn't clear line insert mode, in case caller want to preserve it, so
;caller should clear line insert mode if not going back into it.
CHKMOV: JUMPGE A,CHKMV2 ;Jump unless attempting to move up
MOVE T,ARRL
SOJG T,CHKMV2 ;Jump if there are any lines above here
TRNN F,EDITM ;Trying to move up from first line--pop up a level
POPJ P, ;Do nothing if not from line editor
JRST REEDIT ;Go back to line editor
CHKMV2: PUSH P,TT ;Save return address
TRNE F,EDITM
PUSHJ P,FNEDT0 ;Finish edit by storing line's edited version.
JRST MOVARR ;Get to correct line
;Routine to see if we should edit a line for ↑↓;: cmds. Doesn't return if not.
;Call with JSP TT,CHKMV3.
CHKMV3: SKIPE DPY ;Don't try to edit on TTY
TLNE F,OFFEND!PMLIN!NULLIN ;Don't edit if no such real line
POPJ P, ;Don't edit anything, pop up a level
JRST (TT) ;Okay to edit, return to caller
UPARR: MOVNS A
DWNARR: JSP TT,CHKMOV ;Move to indicated line -- may not return
CAIN B,CTMT3
JRST DBLTB2 ;αβ↑ and αβ↓ means go into line insert mode
PUSHJ P,UNINS ;Clear line insert mode if in it
JSP TT,CHKMV3 ;Should we edit this line? Don't return if not.
EDTEND: PUSH P,[1] ;Enter here to edit current line at end
PUSH P,[211] ;SET FOR CTRL1-TAB
TLNE F,NULLIN
SETZM -1(P) ;ONLY CRLF - FLUSH THE CTRL-TAB (WILL LOSE AT END OF LINE)
JRST EDIT1
SEMICO: MOVNS A
CAIN C,";" ;Circle-x dispatches to here too, but is illegal
JRST COLON
TRNN F,EDITM
JRST ERR ;Not from line editor--say illegal
PUSHJ P,ERR ;Give error message
JFCL ;Ignore skip return
JRST REEDT2 ;Go back to line editor
JRST LBLSRC ;FIND dispatches thru here if ⊗: ends search string
COLON: JSP TT,CHKMOV ;Move to indicated line -- may not return
PUSHJ P,UNINS ;Clear line insert mode if in it
TRNN F,EDITM
JRST COLON2 ;Not from LE, don't store column zero
MOVE TT,EDPOS
CAIN B,CTMT3 ;Double bucky?
MOVEM TT,COLPOS# ;Yes, use current col as col desired
COLON2: JSP TT,CHKMV3 ;Should we edit this line? Don't return if not
HRRZ A,ARRLIN ;Pointer to new line to edit
ADD A,[440700,,LLDESC] ;Make byte pointer to its text.
SETZB B,TT ;B counts display columns, TT control-spaces needed
COLON3: CAML B,COLPOS
JRST COLON4 ;That's far enough.
ILDB C,A
CAIN C,15 ;End of line?
JRST COLON4 ;Line not long enough, go to its end.
ADDI TT,1
CAIE C,11 ;Tabs move several columns
AOJA B,COLON3
ILDB C,A
CAIE C,11 ;Loop till found matching tab
AOJA B,.-2
CAMG B,COLPOS ;Did we pass the right column inside the tab?
JRST COLON3 ;No
SUBI TT,1 ;Yes, back up to beginning of the tab
COLON4: PUSH P,TT ;Number of control-spaces to position us in line.
PUSH P,[240] ;Control-space char
JRST EDIT1 ;Now go edit line
;⊗ NMARKS XXPAGE XXLINE XMARK XMAROO XCOUNT XXNONE XXNON2 XXNON1 XTHERE XNOTF
NMARKS←←27 ;Maximum number of marks per file
IMPURE
XXPAGE: 0 ;Holds page number at insertion or deletion point
XXLINE: 0 ;Holds line number at insertion or deletion point
PURE
XMARK: JUMPE A,XCOUNT ;Zero arg means report current number of marks
TRNE B,2 ;Is it a make or remove mark?
JRST XWRITE ;Make (double-bucky)
SKIPN MARKS ;Are there any marks?
JRST XXNON1 ;No
PUSHJ P,GPGLS ;Get current line,,page into TT, lines on this page in T
MOVS D,TT ;Get into MARKS format (page,,line)
SKIPLE MARKS ;Is there at least one mark?
SKIPE MARKS+1 ;And is it the only one?
JRST XMARK1 ;No
CAMN D,MARKS ;Are we at the only mark?
JRST XMAROO ;Yes
HLRZ E,MARKS ;Get page number of only mark
TLNE F,PMLIN!OFFEND ;Are we at end of page?
CAIE E,(TT) ;And is only mark on current page?
JRST XMARK1 ;No to one of these
HRRZ E,MARKS ;Get line number of only mark
CAIGE E,(T) ;Is only mark at or beyond end of this page?
JRST XMARK1 ;No, got position to the mark
XMAROO: SKIPGE BLAB ;Already at only mark, want to be quiet about it?
POPJ P, ;Yes, no message
OUTSTR [ASCIZ /
Only one MARK and you are there!/]
JRST PPJ1CR
XCOUNT: MOVSI TT,-NMARKS ;Aobjn ptr to count marks
SKIPLE MARKS(TT)
AOBJN TT,.-1 ;Count marks in table
MOVEI TT,(TT)
JUMPE TT,XXNON2 ;Jump if no marks
SETZM TYOPNT
OUTSTR [ASCIZ/ There are /]
TYPDEC TT
OUTSTR [ASCIZ/ marks. /]
JRST POPJ1
XXNONE: SKIPGE BLAB
POPJ P,
XXNON2: OUTSTR [ASCIZ / There are no marks! /]
JRST POPJ1 ;Here from ⊗0⊗M and from XZMARKS
XXNON1: SORRY There are no marks!
JRST POPJ1 ;Here from αM
XTHERE: SKIPGE BLAB
POPJ P,
OUTSTR [ASCIZ / Already marked! /]
JRST POPJ1
XNOTF: SKIPGE BLAB
POPJ P,
OUTSTR [ASCIZ / Not marked! /]
JRST POPJ1
;XMARK1 XMARK3 XMARK2 XMOVE XMOVE5 XBACK XBACK1 ZMARKS XWRITE XWRIT0
XMARK1: MOVEI E,0
TRNE F,NEG ;Backward search?
JRST XBACK ;Yes
TLNN F,PMLIN!OFFEND ;If this is the end of a page,
JRST XMARK3
HLRZ TT,D ; then really find first mark on next page
CAML TT,PAGES ;Are we at end of last page of the file
HRLI D,377777 ;Note that we are really on the last page
HRRI D,-1 ;And really on the last line
XMARK3: CAML D,MARKS(E) ;Is D larger or equal to the largest?
XMARK2: MOVEI D,0 ;Yes so start over
CAMGE D,MARKS+1(E)
AOJA E,.-1 ;Stops because marks block is terminated by a -1
SOJLE A,XMOVE ;Do we need to go further?
SOJGE E,.-1 ;Back up another one
AOJA E,XMARK2 ;Woops, off upper end of table
XMOVE: HRRZ TT,MARKS(E) ;Get number of line where we want to be
HLRZ A,MARKS(E) ;Page number
CAMGE A,DIRPAG
JRST [ SETZ TT, ;Go to beginning of
MOVE A,DIRPAG ; directory page
JRST XMOVE5]
TRNN F,DIROK ;Do we know how many pages there really are?
JRST XMOVE5 ;No, allow going to page we haven't seen yet
CAMLE A,PAGES
JRST [ MOVEI TT,-1 ;Go to end of
MOVE A,PAGES ; last page
JRST XMOVE5]
XMOVE5: MOVEM TT,SLINE ;Set up starting line number for NEWPG5
PUSHJ P,NEWPG5 ;Go to desired line of desired page
POPJ P, ;success, say OK
JRST POPJ1 ;can't open file or didn't find right page, no OK
XBACK: HRLZ TT,DIRPAG
HRRI TT,1
CAMG D,TT ;If we are at beginning of directory page,
SETZ D, ; then make sure we aren't stuck here
CAMG D,MARKS(E)
AOJA E,.-1
XBACK1: SKIPG MARKS(E) ;Is this a legitimate entry?
MOVEI E,0 ;No so go to the top of the list
AOJGE A,XMOVE ;Do we need to go further?
AOJA E,XBACK1 ;Go down 1 and test if off bottom of active list
ZMARKS: SKIPN MARKS ;Are there any marks?
JRST XXNONE ;No
TRNE F,NEG
JRST XMARK0 ;Clear MARKS on this page only
;; SETZM XXPAGE
;; SETZM XXLINE
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;clear whole MARKS array
SKIPGE BLAB
POPJ P,
OUTSTR [ASCIZ / All marks have been cleared. /]
JRST POPJ1
XWRITE: TRNE F,NEG ;Is it a delete?
JRST XDELET ;Yes
;; SKIPLE MARKS+NMARKS-1 ;Is table full? (now checked in XWRIT0)
;; JRST XFULL ;Yes
PUSHJ P,GPAGL
MOVS D,T
PUSHJ P,XWRIT0 ;enter mark in table (double skip if full)
POPJ P, ;success
JRST XTHERE ;already marked
SORRY MARK table is full!
JRST POPJ1
;Add a mark at line&page indicated by (D).
;Direct return if successful.
;One skip if was already marked.
;Two skips if wasn't marked and still isn't because table is full.
XWRIT0: MOVEI E,0
CAMGE D,MARKS(E)
AOJA E,.-1
CAMG D,MARKS(E)
JRST POPJ1 ;A mark is already there
SKIPLE MARKS+NMARKS-1 ;Is table full?
JRST POPJ2 ;Yes, double skip
EXCH D,MARKS(E) ;Make room
SKIPLE D
AOJA E,.-2
POPJ P, ;success return (direct)
;XDEL0 XDEL0B XDELET XDEL0A XDEL4 XMARK0 XMARKA XMARKB XMARKC XXADD XXSUB
XDEL0: TLNN F,OFFEND!PMLIN
JRST XDEL0B ;Not end of some page
JUMPE E,XDEL0B
HLRZ TT,MARKS-1(E) ;See if next mark is on right page (or beyond eof)
HLRZ T,D ;Current page number
CAML T,PAGES
CAMGE TT,PAGES ;We're at eof--delete first mark beyond eof
CAMN TT,T ;Delete first mark on this page beyond last line
SOJA E,XDEL0A ;Delete mark cause we can't get to that line
XDEL0B: HRLZ TT,DIRPAG
HRRI TT,1
SKIPE MARKS(E) ;Is there really a mark here?
CAME TT,D ;Are we at the beginning of the directory page?
JRST XNOTF ;No
JRST XDEL0A ;Yes, delete mark since we can't really get there
XDELET: MOVEI E,0
PUSHJ P,GPAGL
MOVS D,T
CAMGE D,MARKS(E) ;Find entry
AOJA E,.-1 ;Try again
CAME D,MARKS(E)
JRST XDEL0 ;It was not marked
XDEL0A: HLRZ T,MARKS(E) ;Get page number of mark being deleted
HLRZ TT,MARKS-1(E) ;and page numbers of marks before and after
MOVS D,MARKS+1(E)
SKIPGE BLAB
JRST XDEL4
TLZN D,-1 ;Is there really a mark behind us?
TLO D,-1 ;No, make sure we compare unequal
JUMPE E,.+2 ;If mark index is zero, no mark ahead of it
CAME T,TT
CAMN T,D
JRST XDEL4
OUTSTR [ASCIZ/ Removing last MARK on page /]
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/. /]
XDEL4: MOVE D,MARKS+1(E) ;Close ranks
MOVEM D,MARKS(E)
SKIPE D
AOJA E,XDEL4
POPJ P,
;New code to cancel marks on current page
XMARK0: PUSH P,E
MOVEI E,0
PUSHJ P,GPAGL
SKIPL BLAB
OUTSTR [ASCIZ/ MARKS on this page only have been cleared. /]
XMARKA: HLRZ TT,MARKS(E)
CAMGE TT,XXPAGE
JRST XMARKC ;Before page of interest
CAME TT,XXPAGE
AOJA E,XMARKA
PUSH P,E
XMARKB: MOVE TT,MARKS+1(E) ;Close ranks after each deletion
MOVEM TT,MARKS(E)
SKIPLE TT
AOJA E,XMARKB
POP P,E
JRST XMARKA
XMARKC: POP P,E
POPJ P,
;To handle a single line addition (preserves T)
XXADD: PUSH P,T
PUSH P,[1] ;number of lines being added is arg on stack
PUSHJ P,XLALL
SUB P,[1,,1] ;fix stack
JRST POPTJ
;To make a single line removal (clobbers T)
XXSUB: PUSH P,[-1] ;number of lines being deleted is arg on stack
PUSHJ P,XLALL
POP P,T ;fix stack
POPJ P,
;XLALL XLALL1 XLALL2 XLALL3 XPADD XPADD1 XPADD3 XPSUB XPSUB1
;New code to handle deletions and additions. Clobbers T,TT.
;Here with -1(P) containing number of lines inserted (negative for deletions).
XLALL: PUSH P,A
PUSHJ P,OLDFIX ;Fix up line stack
SKIPG MARKS
JRST POPAJ ;There are no marks to fix
PUSHJ P,GPAGL ;Set up XXPAGE and XXLINE with current place
MOVEI A,0
MOVE TT,-2(P) ;number of lines inserted
XLALL1: HLRZ T,MARKS(A)
CAMGE T,XXPAGE
JRST XLALL2 ;Before page of interest
CAME T,XXPAGE
AOJA A,XLALL1
HRRZ T,MARKS(A)
CAMGE T,XXLINE
JRST XLALL2 ;Before location of interest
ADD T,TT
CAMGE T,XXLINE
MOVE T,XXLINE
HRRM T,MARKS(A)
AOJA A,XLALL1
XLALL2: JUMPGE TT,POPAJ ;No duplications possible on an insertion
MOVEI A,0
MOVEI TT,1(A)
XLALL3: MOVE T,MARKS(TT)
CAMN T,MARKS(A)
AOJA TT,XLALL3
MOVEM T,MARKS+1(A)
JUMPLE T,POPAJ
ADDI A,1
AOJA TT,XLALL3
;This routine handles page mark insertions. Clobbers B,T,TT.
XPADD: PUSH P,[1]
PUSH P,. ;Adjust stack for OLDFIX -- data is irrelevant
PUSH P,A ;Preserve A
PUSHJ P,OLDFIX ;Adjust line stack for 1 line insertion
POP P,A
SUB P,[2,,2]
SKIPG MARKS ;Any marks?
POPJ P, ;No
PUSHJ P,GPAGL ;Get place where insertion will be made
MOVEI B,0
XPADD1: HLRZ T,MARKS(B) ;Get page number of next mark
CAMGE T,XXPAGE ;Is it on or after page where insertion will go?
POPJ P, ;No, all done
CAME T,XXPAGE ;Is it on the split page?
JRST XPADD3 ;No, so only page value needs to be changed
HRRZ T,MARKS(B) ;Now attend to line number
SUB T,XXLINE ;Where is it with respect to insertion
ADDI T,1
JUMPLE T,CPOPJ ;It was before so we are through
HRRM T,MARKS(B) ;Fix line number
XPADD3: MOVE T,[1,,0]
ADDM T,MARKS(B)
AOJA B,XPADD1 ;Safe because table terminates with -1
;This routine handles page mark deletions
XPSUB: HRRZ TT,XXLINE
MOVEI E,0
XPSUB1: HLRZ T,MARKS(E)
SUBI T,1 ;Prepare to decrease page number
CAMGE T,XXPAGE
POPJ P, ;The rest are OK.
CAMG T,XXPAGE ;Is it on the adjoined portion?
ADDM TT,MARKS(E) ;Yes, so add to line number
HRLM T,MARKS(E) ;Reducing page number by 1
AOJA E,XPSUB1 ;Safe because table terminates with -1
;⊗ DELLIN DELLI2 DELPOS
;DELLIN DELETES C(A) LINES AT THE pointer
DELLIN: TRNN F,EDITM ;skip if here from line editor (delete CRLF)
JRST DELLI2 ;not from line editor, want to delete some lines
CAIN B,1 ;skip if not just CONTROL(-D)
TDNE F,[PMLIN!OFFEND,,EDBRK] ;No funny business, please
JRST REEDIT ;FROM EDITOR AND NOT αD, or this line is end of page line
MOVEI A,1 ;Ignore argument to control-d
DELLI2: PUSH P,TOPWIN
MOVEM A,SAVARG# ;SAVE ARGUMENT TO SEE IF WE'RE FROM MSG
JUMPGE A,DELPOS
MOVNS A ;MINUS DELETE - BACK UP THE ARROW, THEN TREAT AS PLUS
AOJ A,
CAMLE A,ARRL ;NMVARR WILL MAKE THIS CHECK,
MOVE A,ARRL ;BUT WE SHOULD ALSO LIMIT OUR DELETE
SOJ A,
PUSH P,A
PUSHJ P,NMVARR
MOVN A,(P)
ADDM A,-1(P) ;ADJUST WINDOW BY AMOUNT FLUSHED
POP P,A
DELPOS: SETZM DELPGS# ;no pagemarks deleted yet
MOVE B,LINES
SUB B,ARRL
CAILE A,1(B)
MOVEI A,1(B) ;LIMIT US TO WHAT WE'VE GOT
JUMPE A,CHKMS0 ;Maybe delete page even if no text there
PUSH P,[0]
TLO F,NOCHK
MOVE B,ARRLIN
HLRZ G,(B) ;save ptr to line before first deleted
MOVE C,A ;number of lines to delete
PUSH P,C
;⊗ DELLP DELPR DELPR1 DELPR2 DELL2 DELDSP
DELLP: SKIPGE T,TXTFLG(B)
JRST DELPM ;Current line is page mark.
DELPR: TRNN F,EDITM
JRST DELPR2
HRRZ TT,(B) ;Pointer to next line.
SKIPL TXTFLG(TT) ;Don't combine lines if next line is page mark
CAIN TT,BOTSTR ; or if it is line of asterisks at end of page
JRST DELPR1
HRRZ TT,-1(TT) ;Get words occupied by second line in core
SUBI TT,5 ;Extra words not occupied by text
IMULI TT,5 ;Convert to chars. (includes allowance for TAB's)
ADD TT,EDTBS ;TABS are not counted in EDPOS but equiv. spaces are
ADD TT,EDTBS ;so add EDTBS twice
ADD TT,EDPOS ;Add length of current line
CAIG TT,EDCHRL+12 ;Allowance already made for TAB's in second line
JRST DELPR2 ;but allow room to split line with a β<cr>
SORRY Line would be too long.
SUB P,[3,,3]
JRST REEDT2 ;Don't say HUH
DELPR1: SUB P,[3,,3] ;Here if next line is OFFEND or PMLIN
MOVEI B,1
MOVEI C,"D" ;Set up command char for error typeout
JRST REEDIT ;Go back to line editor
DELPR2: TLNE T,WINBIT ;is line being deleted the top line of window?
SETZM WINLIN ;yes, won't be any more
PUSHJ P,XXSUB ;Adjust line marks on this page for deleted line
HLRZ T,TXTCNT(B) ;Get char count as stored
MOVN T,T ;negative char count of line
ADDM T,CHARS ;adjust count of chars in core for deleted line
MOVEI A,(B) ;ptr to FS for FSGIVE to free up
HRRZ B,(B) ;save ptr to next line
PUSHJ P,FSGIVE ;give back FS of deleted line
SOJG C,DELLP ;loop until deleted enough lines
TLZ F,PMLIN!NOCHK
SKIPGE TXTFLG(B) ;Is the new line a page mark?
TLO F,PMLIN ;Yup
DELL2: HRRZM B,ARRLIN ;first line after last deleted is new arrow line
HRRM B,(G) ;make line before deletions point to one after
HRLM G,(B) ;make line after deletions point to one before
MOVSI T,ARRBIT ;line after is new arrow line
IORM T,TXTFLG(B) ;Flag this FS as the arrow line
HRRZ T,TXTCNT(B)
SKIPE T ;Is this a null line?
TLZA F,NULLIN ;no
TLO F,NULLIN ;yes
SUB C,(P)
SUB P,[1,,1]
ADDM C,LINES
MOVE T,ARRL ;see where we've deleted these lines
CAMG T,TOPWIN ;deleted lines above or at top of visible window?
ADDM C,TOPWIN ;yes, top visible line now has lower line nbr
POP P,T
SKIPE E,DELPGS ;get number of pagemarks deleted, skip if none
PUSHJ P,ADJPG ;fix up any following pagemarks
PUSHJ P,LINSET
PUSHJ P,SETWRT
POP P,A ;Old value of TOPWIN
PUSHJ P,SETWIN ;Recompute same window as before
TLO F,DSPTRL ;Force recalculation of trailer values
TRO F,DSPSCR+WRITE
TRNN F,EDITM ;Was this a control-d?
JRST CHKMSG ;No
PUSHJ P,UNINS ;Leave line insert mode if in it
PUSH P,EDCNM ;SET TO SPACE OUT TO OLD CURSOR POS
PUSH P,[240]
MOVE D,EDPNT
ADD D,[160000,,] ;BACK UP PNTR OVER CRLF
JUMPGE D,.+2
SUB D,[XOR 1]
MOVE B,EDPOS ;starting column for new line
MOVE A,ARRLIN ;new line (old line is in BUF)
HLRZ T,TXTCNT(A)
SUBI T,2 ; Not counting CRLF.
ADDM T,EDCNM ;Make new real character count for joined line.
MOVEI TT, ;LINED will count TABs in TT
MOVEI DSP,DELDSP-2 ;Our own table--see below
PUSHJ P,LINED ;Copy new line into BUF following old line
MOVEI T,(B) ;Total number of columns for line
PUSH P,T
ADD T,TT ;Plus twice the number of tabs from new part
ADD T,TT
ADD T,EDTTBS ;Plus twice the number of tabs from old part
ADD T,EDTTBS
PUSH P,D ;Save pointer to end of line in BUF
PUSHJ P,PUTBAK ;Replace new line with joined version
POP P,D
POP P,T ;Display length of line
PUSHJ P,EXTST ;Move following lines down if will wrap around on DD
JRST EDNUL ;Go edit combined line.
PUSHJ P,TELL0 ;Should never get here
PUSHJ P,TELL1 ; ditto
DELDSP: POPJ P, ;Just return upon seeing CR
PUSHJ P,TELL3 ;Shouldn't get here
AOJA TT,EDTAB ;Count a TAB and process it
;⊗ DELPM DELPMA DELPM1 DELPM2 DELPM3
DELPM:
; TRNE F,REDNLY+EDDIR
; JRST [TLO F,PMLIN↔JRST DELL2] ;Can't delete a pagemark in readonly mode
TRNE F,EDDIR
JRST [TLO F,PMLIN↔JRST DELL2] ;Can't delete a from directory page
SKIPN MARKS ;Are there any line marks?
JRST DELPMA
PUSHJ P,GPAGL ;Yes, find out where we are and fix 'em up
PUSHJ P,XPSUB ;Note, this leaves a final correction to DELPR2
DELPMA: HRRZ A,LLDESC+LPMTXT+PMSIZE(B) ;Get page number from mark being deleted
PUSHJ P,BAKSUB ;Correct page stack for pagemark deletion
; LDB T,[221200,,LLDESC+LPMTXT+PMSIZE(B)] ;get char count
LDB T,[POINT PMCBTS,LLDESC+LPMTXT+PMCCNT(B),PMCPOS] ;get char count
; LDB TT,[341000,,LLDESC+LPMTXT+1(B)]
LDB TT,[POINT PMRBTS,LLDESC+LPMTXT+PMRCNT(B),PMRPOS] ;get record count
IMULI TT,200*5
ADDI TT,(T)
CAILE A,2 ;Skip if no FF was counted in deleted pagemark
SOS -1(P) ;Don't count the FF as moved to next pagemark
ADDM TT,-1(P) ;This many chars will be counted with next pagemark
MOVN TT,TT
ADDM TT,XCHRS ;Uncount chars and FF (if any) gone from non-final pages
SOJL T,.+2 ;Count the FF gone
SUBI T,200*5 ;Uncount the NULLS that are going away
ADDM T,CHARS
ADDM T,OCHRS ;KEEP RCOMP FROM HACKING
ADDM T,XCHRS ;Uncount the NULLS and FF from non-final pages
AOS XCHRS ;We uncounted the FF one too many times
MOVE T,LLDESC+LPMTXT(B) ;Get link word for pagemarks
TRNE T,-1
HLLM T,(T) ;Link back from next pagemark to prev one
TRNN T,-1
MOVEM T,XPLSTE
MOVS T,T
HLRM T,(T) ;Link forward from prev pagemark to next one
HLLM T,DELPGS ;Remember first pagemark beyond last one deleted
TRO F,UPDIR
HRRZ A,LLDESC+LPMTXT+PMSIZE(B) ;Get page number of pagemark disappearing
SUB A,DELPGS ;Account for pages already partially deleted
PUSHJ P,DELPAG
AOS DELPGS ;Remember how many pages are being deleted
SOS XPAGES
MOVSI TT,DPBIT!D1BIT
ANDCAB TT,DIRFLG(A) ;clear the flags for this directory entry
TLNN TT,RPMASK ;skip if this page was already in the directory
JRST [PUSHJ P,FSGIVE↔JRST DELPM3] ;this was a newly added page not in dir
SKIPN T,DPLST ;link this pagemark into the list of deleted pages
JRST [MOVEI T,DPLST↔HRLZM T,DPLST↔JRST DELPM2]
DELPM1: MOVE TT,DIRFLG(T) ;keep deleted pages in order by RPMASK contents
CAML TT,DIRFLG(A) ;is new page earlier than prev deleted page?
JRST DELPM2 ;yes, insert in list here
HRRZ T,(T) ;no, advance down deleted-page list
CAIE T,DPLST ;skip if end of list--insert there
JRST DELPM1 ;loop and see if this is far enough down list
DELPM2: HLL T,(T)
MOVEM T,(A) ;Put deleted page into list for returning FS later
HRLM A,(T)
MOVS T,T
HRRM A,(T)
DELPM3: MOVE T,TXTFLG(B) ;Get line's flags
JRST DELPR
;⊗ DELPAG DELPG1 DELPG2 DELPG3 ADJPG ADJPG3 ADJPG2 ADJPGL
DELPAG: PUSHJ P,FNDPAG ;Find dir entry for page being deleted
MOVEI A,(T)
;Enter here only from DIRFXN.
DELPG1: MOVS T,(A) ;Get link word from dir entry
MOVSI TT,DPBIT
SKIPL DIRFLG(A) ;skip if DPBIT is on (last incore page)
JRST DELPG2
HRRZM T,DIRPT ;Deleting last page in core (CURPAG)--save ptr
IORM TT,DIRFLG(T) ; to prev page and mark it as last in core
DELPG2: HLRM T,(T) ;Link forward around deleted entry
MOVS T,T
HLLM T,(T) ;Link backward around deleted entry
;begin fix to EDIRSZ here for pages at or after XDIRFG
MOVEI TT,0 ;count how many pages after this in core
SKIPA T,A ;copy ptr to pagemark being deleted
DELPG3: MOVE T,(T) ;next pagemark
SKIPL DIRFLG(T) ;skip if this is last incore page
SOJA TT,DELPG3 ;count following incore pages
ADD TT,CURPAG ;make the number of the pagemark we've deleted
;end EDIRSZ fix
HRRZ T,DIRFLG(A) ;get char count for this deleted directory line
MOVNI T,DIRXTR(T) ;amount of space this line used on dir page
ADDM T,DIRSIZ ;update space needed for directory
;begin EDIRSZ fix
CAMGE TT,XDIRFG ;if deleted pagemark before extended dir,
SOSA XDIRFG ;then we have less pages before extended part
ADDM T,EDIRSZ ;else update size of dir extension for deletion
;end fix
SOS PAGES ;one less page in file
SOS CURPAG ;one less page in core
TRO F,UPDIR ;directory needs updating now
TLO F,DSPTRL ;Force recalculation of trailer values
SETOM LSTPAG ;Force page/line number typeout on non-displays
POPJ P,
;Get here after deleting one or more pagemarks to fix record & char counts in
;next pagemark, which is pointed to now by LH of E.
;RH of E is number of pagemarks deleted.
;T has count of chars formerly counted in the deleted pagemarks.
ADJPG: PUSH P,T
PUSHJ P,RDSPA4
PUSHJ P,DSHED
POP P,T
HLRZ G,E
JUMPE G,CPOPJ ;jump if no more pagemarks after last one deleted
; LDB A,[341000,,PMSIZE(G)] ;Old record count for pagemark
LDB A,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;Old record count for pagemark
IMULI A,200*5
; LDB TT,[221200,,PMSIZE(G)] ;Old excess char count
LDB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;Old excess char count
ADDI T,(TT)
ADD T,A ;Now T has new total char count for this pagemark
JUMPE TT,ADJPG3
ADDI A,(TT)
SUBI TT,200*5
ADDM TT,XCHRS ;Uncount old NULLs everywhere
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG3: MOVN A,A
ADDM A,XCHRS ;Uncount old total chars for this pagemark
HRRZ A,PMSIZE(G) ;Get page number (old) of this pagemark
CAIG A,2(E) ;Is there a FF on previous page?
SUBI T,1 ;No, but FF was previously counted in this pagemark
ADDM T,XCHRS ;Count new chars for this pagemark
IDIVI T,200*5
; DPB TT,[221200,,PMSIZE(G)] ;New number of excess chars
DPB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;New number of excess chars
; DPB T,[341000,,PMSIZE(G)] ;New number of records for this pagemark
DPB T,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;New number of records for this pagemark
JUMPE TT,ADJPG2 ;Jump if no nulls here
SUBI TT,200*5
MOVN TT,TT
ADDM TT,XCHRS ;Count nulls needed for this pagemark
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG2: MOVNI E,(E)
ADJPGL: ADDM E,PMSIZE(G) ;Reduce page number of all following pagemarks
HRRZ T,PMSIZE(G)
MOVE A,[440700,,H]
MOVEI H,1
PUSHJ P,NUMSTR
MOVEM H,PMPAG-PMTXT-LPMTXT(G)
AOS T,TXTNUM
HRRM T,TXTSER-LLDESC-LPMTXT(G)
SETZM TXTWIN-LLDESC-LPMTXT(G) ;clear window ptr for line in current window
HRRZ G,(G)
JUMPN G,ADJPGL
POPJ P,
;RCOMP RCOMP1 RCOMP2 RCOMPX
;RCOMP is called only from SETWRT and then only when two or more pages are in core.
;This routine updates the number of records and chars now needed by the first
;pagemark following the arrow line, assuming all text changes were together.
RCOMP: HLRZ T,PMLNBR(G) ;line number of this pagemark
CAML T,ARRL ;Find first pagemark beyond arrow line
JRST RCOMP1 ;That pagemark's preceding page has more chars in it
HRRZ G,(G)
JUMPN G,RCOMP
JRST RCOMPX
RCOMP1: MOVE T,CHARS
SUB T,OCHRS ;This gives us number of characters added to page
ADDM T,XCHRS ;XCHRS is number of chars+nulls before final pagemark
; LDB H,[221200,,PMSIZE(G)]
LDB H,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;get char count
ADDI T,(H)
IDIVI T,200*5
JUMPL TT,[ADDI TT,200*5 ↔ SOJA T,.+1] ;Make remainder char count positive.
; DPB TT,[221200,,PMSIZE(G)]
DPB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;update char count
; LSH T,12+22 ;shift to right position in LH
; LSH T,=36-PMRBTS ;shift to right position in LH
; ADDM T,PMSIZE(G) ;Adjust number of records taken up by preceding page
PUSH P,A
LDB A,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;get old record count
ADD T,A ;adjust by additional number of records
DPB T,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;save adjusted record count
POP P,A
JUMPE H,.+2
SUBI H,200*5 ;Negative of amt of room there used to be in page
JUMPE TT,.+2
SUBI TT,200*5 ;Negative of amt of room in page now
SUB H,TT ;Additional amount of room needed for new nulls
ADDM H,CHARS
ADDM H,XCHRS
MOVE T,LINES
SUB T,OLINES ;Number of lines added at arrow affects the line
HRLZS T ; number of each pagemark line below
RCOMP2: ADDM T,PMLNBR(G) ;increase line number of this pagemark
HRRZ G,(G) ;next pagemark
JUMPN G,RCOMP2 ;jump if any
RCOMPX: MOVE T,CHARS
MOVEM T,OCHRS
MOVE T,LINES
MOVEM T,OLINES
POPJ P,
;DELETE DELETB DELETC DELET1 DELET2 DELET3 ADDPAG
DELETE: MOVE A,CURPAG
AOJ A,
CAMLE A,PAGES
JRST PGERR
PUSHJ P,WRPAGH ;skip if readwrite mode and formatted file
JRST POPJ1 ;can't write it, abort quick (err msg already typed)
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPJ1 ;can't open file (typed error msg), don't write out
SKIPN MARKS ;Are there line marks?
JRST DELETC
MOVE T,CURPAG
HRRZM T,XXPAGE ;Number of last page in core
SUB T,FIRPAG
JUMPE T,DELETB
MOVEI G,XPLST
HRRZ G,(G)
JUMPE G,NEWPG4
SOJG T,.-2
HLRZ TT,PMLNBR(G) ;Line number for last pagemark in core
MOVNS TT
ADD TT,LINES
SKIPA
DELETB: MOVE TT,LINES
HRRZM TT,XXLINE
PUSHJ P,XPSUB
DELETC: PUSH P,LINES
JSP B,ADDPAG
SOS CHARS ;-1 FF
POP P,T ;Get link word PUSHed by ADDPAG
MOVSI TT,ARRBIT!WINBIT
AND TT,BOTSTR+TXTFLG
ANDCAM TT,BOTSTR+TXTFLG ;Arrow could have been pointing at BOTSTR
IORB TT,TXTFLG(T)
TLNN TT,ARRBIT
JRST DELET1
PUSH P,TT
HRRZ TT,TXTCNT(T)
SKIPE TT ;Is this a null line?
TLZ F,NULLIN ;No
POP P,TT
HRRZM T,ARRLIN
DELET1: TLNE TT,WINBIT
HRRZM T,WINLIN
HLLM T,(T)
MOVS T,T
HLRM T,(T)
POP P,T ;Get back old number of lines
ADDB T,LINES ;Plus lines on new page
MOVEM T,OLINES ;Make RCOMP think nothing happened
MOVE T,CHARS
MOVEM T,OCHRS
MOVE A,CURPAG
PUSHJ P,DELPAG ;Unlink directory entry for page deleted
PUSHJ P,FSGIVE
PUSHJ P,LINSET
PUSHJ P,SETWRT
TLO F,DSPTRL ;Force recalculation of trailer values
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header line to be redisplayed
SETOM RIPDIS ;request display update if writing causes ripple
PUSHJ P,WRPAGE ;write out incore text (already ensured file open)
SETZM RIPDIS ;re-disable display updating on rippling
MOVE A,CURPAG
AOJA A,BAKSUB ;Update page stack for pagemark deletion
ADDPAG: MOVE T,PAGE
HLL T,BOTSTR
PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
PUSH P,B ;Put our return addr on stack so we can POPJ
PUSHJ P,RDPAG0
HRRZ T,-1(P)
CAIN T,BOTSTR
MOVEI T,-1(P)
MOVEI TT,PAGE
HRLM TT,(T)
EXCH T,PAGE
HRRM T,-1(P)
TRO F,DSPSCR
POPJ P,
;⊗ APPEND APPEN1 APPEN0 APPLUZ POPUP1
APPEND: TRNE F,EDDIR
JRST ILLDI2 ;Not legal on directory page
; TRNE F,FILLUZ
; JRST ILFLUZ ;Not legal in unformatted file
APPEN1: PUSH P,A
MOVE A,CURPAG ;Actual number of last page in core
AOS T,A ;New page we want to add
CAMLE A,PAGES ;Is there such a page?
JRST PGERR1 ;Nope
SUB T,FIRPAG ;Number of pages in core now
MOVE TT,RELPGN ;Number of "real" (appended) pages already in core
CAIGE TT,RPMASK ;Max relative page number allowed
CAIL T,RPMASK
JRST APPLUZ ;No room for higher relatively-numbered pages in core
PUSHJ P,BAKSA3 ;Flush to-be-appended page from page stack
PUSH P,LINES
MOVE T,CHARS
PUSH P,T
IDIVI T,200*5
JUMPE TT,APPEN0
MOVN TT,TT
ADDI TT,200*5
APPEN0: PUSH P,TT
JSP B,ADDPAG ;Read in next page
AOS XPAGES ;Count another extra page in core
HRLM P,(T) ;Make new page point back to new pagemark line (on stack)
MOVEI B,LLDESC+LPMTXT+PMXTRA ;nbr of words of FS needed for pagemark
PUSHJ P,FSGET ;get some FS
MOVSI T,TXTCOD ;mark this FS as text
HLLM T,-1(A) ;store FS flag for new pagemark line
POP P,T ;pointers back to end of old page, forw to new page
MOVEM T,(A) ;store line links in new pagemark line FS block
HRLM A,(T) ;make new page point back to new pagemark line
MOVS T,T
HRRM A,(T) ;make end of old page point forw to new pagemark line
POP P,E
ADDM E,CHARS ;count nulls needed to pad prev page to full record
POP P,T ;prev value of CHARS before new page read in
SUB T,XCHRS
ADD E,T
ADDM E,XCHRS
IDIVI T,200*5 ;records to T, excess chars to TT
; DPB T,[121000,,TT] ;insert record count in RH (usually in LH) w/chars
; HRL TT,CURPAG ; and page number in LH (usually in RH)
; MOVSM TT,LLDESC+LPMTXT+PMSIZE(A) ;save rec cnt, char cnt, page nbr
DPB TT,[POINT PMCBTS,LLDESC+LPMTXT+PMCCNT(A),PMCPOS] ;store excess char cnt
DPB T,[POINT PMRBTS,LLDESC+LPMTXT+PMRCNT(A),PMRPOS] ;store record count
MOVE TT,CURPAG
HRRM TT,LLDESC+LPMTXT+PMSIZE(A) ;store page number
POP P,E ;prev value of LINES before new page read in
AOJA E,APPEN2 ;count the new pagemark in total LINES
APPLUZ: SORRY Cannot have any more pages in core.
PUSHJ P,APPFIN ;Fix up things in case we did some appending
POPUP1: SUB P,[1,,1] ;Flush arg from stack
JRST POPJ1
;⊗ APPEN2 APPFIN PMTXT PMPAG LPMTXT
APPEN2: ADDM E,LINES
HRLM E,LLDESC+LPMTXT+PMLNBR(A) ;store incore line number of new pagemark
MOVEI T,LLDESC+LPMTXT(A)
SKIPN D,XPLST ;update list of all incore pagemarks
TROA D,XPLST
HLRZ D,XPLSTE
HRLZM D,(T)
HRRM T,(D)
HRLZM T,XPLSTE
MOVSI T,ARRBIT!WINBIT
AND T,BOTSTR+TXTFLG
ANDCAM T,BOTSTR+TXTFLG ;Remove bits if arrow or window was at BOTSTR
TLO T,PMARK
HLLM T,TXTFLG(A) ;Flag this line as an incore pagemark
SETZM TXTCNT(A)
TLNE T,ARRBIT
MOVEM A,ARRLIN
TLNE T,ARRBIT
TLO F,PMLIN ;Arrow was on stars, so is now on pagemark
TLNE T,WINBIT
MOVEM A,WINLIN
AOS T,TXTNUM
HRRM T,TXTSER(A) ;New serial number for pagemark line
SETZM TXTWIN(A) ;clear window ptr for line in current window
ADD A,[PMTXT,,LLDESC]
MOVE B,A
BLT B,LPMTXT-1(A) ;Put pagemark text into pagemark line
ADD A,[440700-PMTXT,,PMPAG-PMTXT]
MOVE T,CURPAG
PUSHJ P,NUMSTR
MOVE T,CHARS
MOVEM T,OCHRS
MOVE T,LINES
MOVEM T,OLINES
POP P,A
SOJG A,APPEN1
APPFIN: PUSHJ P,CLEARX ;See if X on top line should be off now
JRST LINSE2
PMTXT: ASCID/|||||||| PAGE /
PMPAG: 1
ASCID/ ||||||||
/
LPMTXT←←.-PMTXT
;INSERT
;Insert a pagemark
INSERT: PUSHJ P,XPADD ;Fix up line marks
PUSHJ P,BAKADD ;Fix up places for BACKGO command
; MOVEI B,LLDESC+LPMTXT+2
MOVEI B,LLDESC+LPMTXT+PMXTRA
PUSHJ P,FSGET ;get FS for incore pagemark line
MOVSI T,TXTCOD
HLLM T,-1(A) ;its a text line
MOVE T,ARRLIN ;get ptr to following line (old arrow line)
HLL T,(T) ;get back-ptr to old previous line
MOVEM T,(A) ;store forward and backward links in new FS
HRLM A,(T) ;make old arrow line point back to new FS
MOVSI TT,ARRBIT!WINBIT
AND TT,TXTFLG(T)
ANDCAM TT,TXTFLG(T) ;clear arrow and window bits in old arrow line
TLO TT,PMARK ;add pagemark bit to arrow and window bits
HLLM TT,TXTFLG(A) ; and store in new pagemark line's FS
SETZM TXTCNT(A) ;indicate no text in pagemark line
MOVEM A,ARRLIN ;pagemark line is new arrow line
TLNE TT,WINBIT ;is it top of window?
MOVEM A,WINLIN ;yes, remember that too
MOVS T,T ;get ptr to prev line in RH
HRRM A,(T) ;make prev line point to new pagemark line
HLLZS TXTSER(A) ;clear serial number for pagemark line
ADD A,[PMTXT,,LLDESC] ;make BLT ptr for constant pagemark text
MOVE B,A
BLT B,LPMTXT-1(A) ;move the ||| PAGE ||| text into pagemark FS
ADDI A,LPMTXT ;advance FS pointer to special words after pm text
AOS CHARS ;count the pagemark's formfeed in char count
AOS T,LINES ;count a new line on the page
SKIPN G,XPLST ;Skip if more than one page already in core
SOJA T,INSER6
;⊗ INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
;falls thru
INSER1: HLRZ T,PMLNBR(G) ;get incore line number of this pagemark
CAML T,ARRL ;Look for first pagemark past line for new one
JRST [HLL G,(G)↔HRLM A,(G)↔JRST INSER2]
HRRZ G,(G)
JUMPN G,INSER1
MOVE G,XPLSTE ;Pointer to last pagemark in core (LH)
HRLZM A,XPLSTE ;Store new last pagemark in core
INSER2: HLRZ T,G ;Pointer to pagemark just before new one
CAIN T,XPLST
JRST INSER7 ;No pagemark before new one
HRRZ B,PMSIZE(T) ;Number of page this new pagemark ends
HLRZ C,PMLNBR(T) ;incore line number of this pagemark
INSER3: MOVEM G,(A) ;store forward and backward ptrs in new pagemark
HRRM A,(T) ;store forward ptr in previous pagemark to new one
MOVE TT,ARRL
HRLM TT,PMLNBR(A) ;Store line number of new pagemark in its FS
HLRZ E,-LLDESC-LPMTXT(A) ;Get pointer to last line left on prev page
CAIG B,1 ;Skip unless prev page is page 1
TDZA D,D ;No FF on page 1 -- cnt chars on prev incore pages
MOVEI D,1 ;FF is 1 char -- count chars on prev incore pages
; MOVSI D,1 ;Count FF as 1 char, count chars in LH
SUB C,ARRL ;negative distance from prev pagemark to new one
AOJGE C,INSER5 ;jump if no lines on page just before new pagemark
;Count chars on page before this pagemark
INSER4: HLRZ T,TXTCNT(E) ;char cnt from line somewhere above pagemark
ADD D,T ;make total char count of such lines (full word cnt)
; ADD D,TXTCNT(E) ;Assuming that the halves will not overflow
HLRZ E,(E) ;back up to previous line
AOJL C,INSER4
INSER5:
; HLRZS D ;To right for processing
MOVN C,D ;Save negative char count of new pagemark
ADDM D,XCHRS
IDIVI D,200*5 ;Full-record count left in D, remainder in E
; HRLI B,(E)
; DPB D,[341000,,B]
; DPB D,[POINT 8,B,7]
; MOVEM B,PMSIZE(A) ;Store records, chars, page number for new pagemark.
DPB E,[POINT PMCBTS,PMCCNT(A),PMCPOS] ;store excess char cnt
DPB D,[POINT PMRBTS,PMRCNT(A),PMRPOS] ;store record count
HRRM B,PMSIZE(A) ;store page number
JUMPE E,INSER9
MOVN E,E
ADDI E,200*5 ;Number of nulls needed for new pagemark
ADDM E,XCHRS
ADDM E,CHARS
INSER9: TRNN G,-1 ;Any following pagemark?
JRST INSER8 ;No
; LDB T,[341000,,PMSIZE(G)] ;Old record count of next pagemark
LDB T,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;Old record count of next pagemark
IMULI T,200*5
; LDB TT,[221200,,PMSIZE(G)] ;Old char count
LDB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;Old excess char count
JUMPE TT,INSE10
ADDI T,(TT) ;Old total chars
SUBI TT,200*5 ;Negative number of old nulls
ADDM TT,CHARS
ADDM TT,XCHRS
INSE10: ADDI C,1 ;Don't count the FF in C as moved to other page
ADDM C,XCHRS ;These real chars were already counted--uncount them
ADD T,C ;New number of chars on second pagemark
IDIVI T,200*5
; DPB TT,[221200,,PMSIZE(G)] ;New char count
DPB TT,[POINT PMCBTS,PMCCNT(G),PMCPOS] ;New excess char count
; DPB T,[341000,,PMSIZE(G)] ;New record count
DPB T,[POINT PMRBTS,PMRCNT(G),PMRPOS] ;New record count
JUMPE TT,INSER8 ;Jump if no nulls now
MOVN TT,TT
ADDI TT,200*5 ;New number of nulls
ADDM TT,CHARS
ADDM TT,XCHRS
;⊗ INSER8 DIRADD DIRAD0 DIRAD1
;FALL THRU FROM PREV PAGE
INSER8: MOVE E,CHARS
MOVEM E,OCHRS ;Make RCOMP think nothing has happened
AOS XPAGES
MOVEI E,1
MOVEI G,(A)
PUSHJ P,ADJPGL
MOVEI A,(B)
PUSHJ P,FNDPAG ;Put into T the FS adr of page whose nbr is in A
PUSHJ P,DIRADD ;Add entry here to directory list of pages
MOVSI TT,DPBIT
AND TT,DIRFLG(T) ;make copy of DPBIT of directory entry
ANDCAM TT,DIRFLG(T) ;turn off bit in directory entry
JUMPE TT,.+2
HRRZM A,DIRPT ;bit is on, store ptr to new last incore page
HLLM TT,DIRFLG(A) ;store flags for new directory entry
AOS CURPAG
TDO F,[PMLIN!NULLIN,,UPDIR!UPDTXT]
PUSHJ P,SETWRT
PUSHJ P,LINSET
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header to be redisplayed
MOVE B,ARRLIN
MOVE A,ARRL
HRLM A,LLDESC+LPMTXT+PMLNBR(B) ;GOT AOSED BY RCOMP--fix line nbr of pagemark
AOJA A,SETARR
;Insert a new page (directory entry) after the page pointed to by T.
DIRADD: HRL T,(T) ;get forward ptr for old page
MOVS T,T ;this will be link word for new page: old,,next
;fix to adjust EDIRSZ if new page inserted after XDIRFG
MOVS TT,T ;get ptr to page we'll insert after, in RH
TDZA B,B ;count following incore pages (to get page number)
DIRAD0: MOVE TT,(TT) ;next incore page
SKIPL DIRFLG(TT) ;skip if this is last incore page
SOJA B,DIRAD0 ;count following incore pages
ADD B,CURPAG ;make number of page we'll insert after
PUSH P,B
PUSHJ P,DIRAD1 ;insert page in directory
POP P,B ;get back page we inserted after
CAMGE B,XDIRFG ;insert into extended part of directory?
AOSA XDIRFG ;no, extended part now starts one page later
ADDM TT,EDIRSZ ;yup, update its size
POPJ P,
;end fix
DIRAD1: PUSH P,T
HRLM P,(T) ;insert stacked link word in list: back from next
MOVS T,T ;make it next,,old
HRRM P,(T) ;store forward ptr to stack from old
MOVEI B,LPDESC+1 ;amt of FS for initial directory entry
PUSHJ P,FSGET ;get some FS for new page
MOVSI T,DIRCOD
HLLM T,-1(A) ;mark FS as directory type
POP P,T ;get back link word for new entry
MOVEM T,(A) ;store link word in new entry
HRLM A,(T) ;fix up ptrs to new entry: back from next
MOVS T,T ;make it next,,old
HRRM A,(T) ;store forward ptr to new from old
SETZM DIRREC(A) ;clear the record ptr (means unknown)
MOVEI TT,2 ;number of chars in initial directory entry text
MOVEM TT,DIRFLG(A) ;store char count for dir line, no flags in LH
SETZM DIRWIN(A) ;clear the window ptr in directory entry
MOVE TT,[BYTE (7)15,12,177] ;initial text of dir line
MOVEM TT,LPDESC(A) ;set up text in FS
AOS PAGES ;count another page in directory list
MOVEI TT,DIRXTR+2 ;count more space needed for
ADDM TT,DIRSIZ ; directory page
POPJ P,
;⊗ INSER6 INSER7 MARK MARK2 MARK3 MARK4
;Here when inserting first incore pagemark
INSER6: MOVEM T,OLINES ;remember how many lines there used to be
HRLZM A,XPLSTE ;save pointer to last incore pagemark
MOVSI G,XPLST ;pagemark's back pointer, w/zero forward ptr
MOVEI T,XPLST ;previous ptr word to fix up pointing to new pm
INSER7: MOVE B,FIRPAG ;prev page is first one in core
MOVEI C,0 ;no previous incore pagemark, so enable counting
JRST INSER3 ; all incore text preceding new pagemark
MARK: TRZN F,ATTMOD ;If anything attached, put it down first
JRST MARK2
MOVE T,ARRLIN
HLRZ T,(T) ;Get pointer to previous line
CAIN T,PAGE ;At top of page?
JRST MARK3 ;Yes
SKIPGE TXTFLG(T) ;Is it a pagemark?
JRST MARK4 ;Yes
PUSHJ P,ATTEX ;Put down attach buffer, then insert pagemark
MARK2: PUSHJ P,INSERT ;Insert pagemark (also fixes line MARKS)
HRRZ A,LLDESC+LPMTXT+PMSIZE(B) ;get number of page this mark is for
JRST NEWPG0 ;go read in that page
MARK3: SKIPA TT,FIRPAG ;Get number of starting page in core
MARK4: HRRZ TT,LLDESC+LPMTXT+PMSIZE(T) ;Get number of pagemark
PUSH P,TT
PUSH P,ATTNUM ;Save number of lines down to insert pagemark
PUSHJ P,ATTEX
POP P,A
PUSHJ P,MOVARR
PUSHJ P,INSERT ;Insert pagemark beyond put-down attach buf
POP P,A
JRST NEWPG0
;CONTQ
CONTQ: SKIPN DPY ;This is illegal on TTYs
JRST ERR
HLRZ B,@ARRLIN
CAIE B,PAGE
SKIPGE TXTFLG(B) ;Better not be a pagemark he's trying to copy
POPJ P,
HRRZ B,-1(B) ;Get size of free storage block for this line
SUBI B,2 ;Not counting FS overhead
PUSHJ P,FSGET ;Get FS for new copy of line
MOVSI T,TXTCOD
HLLM T,-1(A) ;Mark FS as text block
HLRZ T,@ARRLIN ;Pointer to line we're copying
HRL T,ARRLIN ;Pointer to current line
MOVSM T,(A) ;Insert new line between previous and current lines
HRRM A,(T) ;Make previous lines point to new one
HRLM A,@ARRLIN ;Make current line point back to new one
MOVEM A,ARRLIN ;Make new line the arrow line
AOS LINES ;Count another line on the page
PUSHJ P,XXADD ;Fix up line marks
MOVSI B,1(T) ;Blt everything from old line to new one
HRRI B,1(A) ; except the pointer word
MOVE T,B
ADD B,-1(A) ;Add in size of block
BLT T,-1-1-2(B) ;1 for pointer word, 2 for overhead words, 1 for end
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Give new line a new serial number
SETZM TXTWIN(A) ;clear window ptr for line in current window
HLRZ T,TXTCNT(A)
ADDM T,CHARS ;Count additional characters on page
CAIG T,2
TLOA F,NULLIN ;New line is empty
TLZA F,NULLIN!PMLIN
TLZ F,PMLIN ;New line definitely isn't a pagemark
HRRZ B,(A) ;Pointer to former arrow line
MOVSI T,ARRBIT!WINBIT
AND T,TXTFLG(B) ;Get arrow and window bits from former arrow line
TLNE T,WINBIT
MOVEM A,WINLIN
ANDCAM T,TXTFLG(B) ;Turn off arrow and window bits in former arrow line
HLLM T,TXTFLG(A) ;And turn them on as appropriate in new line
PUSHJ P,LINSET
PUSHJ P,SETWRT
TLNE F,NULLIN
POPJ P,
PUSH P,[0]
AOBJN P,EDIT1
PUSHJ P,TELLZ
;ATTACH ATTCH1 ARGCHK ARGCHN
PUSHJ P,ATTSRC
ATTACH: MOVEM A,SAVARG ;Save argument to tell if came from MSG
PUSHJ P,ATTDO
PUSHJ P,ATTEX
PUSHJ P,ATTCH1
HRLM G,(C)
HRRM C,(G)
MOVSI T,ARRBIT
IORB T,TXTFLG(C)
TLNE T,PMARK ;Is new arrow line a pagemark?
TLOA F,PMLIN ;Yes
TLZ F,PMLIN ;No
HRRZ T,TXTCNT(C)
SKIPN T
TLOA F,NULLIN
TLZ F,NULLIN
MOVSI T,ARRBIT
EXCH C,ARRLIN
ANDCAM T,TXTFLG(C)
SKIPN WINLIN
SETOM BOTWIN
MOVN T,ATTSIZ
ADDM T,CHARS
MOVN T,ATTNUM
ADDM T,LINES
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
PUSHJ P,LINSET
PUSHJ P,GPAGL
MOVEM T,ATTLOC#
MOVE T,ZINDEX ;Remember what file he attached the stuff in
MOVEM T,ATTFIL#
SETZM ATTPOS
PUSHJ P,SETWRT
PUSHJ P,CHECKA ;Make sure the "A" appears on header line
JRST CHKMSG ;See if we now need to delete a page mark
ATTCH1: MOVEI A,(C)
SKIPGE T,TXTFLG(A)
PUSHJ P,TELLZ
TLZN T,WINBIT
POPJ P,
SETZM WINLIN
HLLM T,TXTFLG(A)
POPJ P,
ARGCHK: JUMPLE A,ARGCHN
MOVE T,LINES
SUB T,ARRL
CAILE A,1(T)
MOVEI A,1(T)
POPJ P,
ARGCHN: JUMPE A,CPOPJ
MOVN A,A
MOVE T,ARRL
CAILE A,-1(T)
MOVEI A,-1(T)
PUSH P,A
PUSHJ P,NMVARR
JRST POPAJ
;ATTDO ATTDO0 ATTOK ATTDO3 ATTDO2 ATTDO1 ATTCHK
ATTDO: TRNE F,REL
ADD A,ATTNUM
TRZE F,ATTMOD
XCT @(P)
ATTDO0: AOS (P)
PUSHJ P,ARGCHK
MOVEM A,ATTMOV#
SKIPG D,A
JRST POPAJ
SKIPE XPAGES ;Skip unless multiple pages in core
JSP G,ATTCHK ;See if whole attachment is on same page
ATTOK: HLRZ G,@ARRLIN
MOVEM F,ATTFLG#
TRO F,ATTMOD
SETZM ATTSIZ
ATTDO3: MOVEI E,ATTBUF
ATTDO2: HRRZ C,ARRLIN
ADDB A,ATTNUM
MOVEI T,(A)
PUSHJ P,EXSETB ;Set number of EXTRA attached lines to display
ATTDO1: XCT @(P)
HRRM A,(E)
HRLM E,(A)
MOVEI E,(A)
HLRZ T,TXTCNT(A)
ADDM T,ATTSIZ#
HRRZ C,(C)
SOJG D,ATTDO1
MOVEI A,ATTBUF
HRRM A,(E)
HRLM E,ATTBUF
JRST POPJ1
;Routine to make sure not attaching across incore pagemark.
;Call by JSP G,ATTCHK. Returns up two levels on error (i.e., returns to
;caller of caller of caller, which should be back to MAIN cmd dispatch).
ATTCHK: PUSHJ P,GPAGL ;Get current line,,page into T
HRL T,ARRL ;Remember arrow line and actual current page
PUSH P,T
ADDM A,ARRL ;Make it look like we're moving by (A) lines
PUSHJ P,GPAGL ;See what page that would leave us on
ANDI T,-1 ;Just the page number
POP P,TT
HLRZM TT,ARRL ;Restore correct ARRL
CAIN T,(TT) ;Skip if the move would change pages
JRST [TLO F,DSPTRL↔JRST (G)] ;Force recalculation of trailer numbers
SORRY Multi-Page attach not implemented.
JRST POPUP1 ;Return up a level and skip
;ATTREP ATTRE3 ATTRE4 ATTEX0 ATTEX2 ATTCHP ATTRE5 ATTEX
ATTREP: TRNN F,ATTMOD
JRST ERR
SKIPN A,ATTLOC ;ATTLOC=<line>,,<page> where attach buffer came from
JRST ATTKAL
SKIPL T,ATTFIL ;Get index of file text was attached from
CAME T,ZINDEX ;Skip if we're in that file now
JRST ATTRE4 ;Not currently in the file from which text came
HLRZM A,SLINE ;Line we want to be at
ANDI A,-1
PUSHJ P,NEWPG5 ;Get to right line and page
JRST ATTRE5 ;Okay, got right page
TRNE F,WRITE ;failed to go to right page, skip unless
JRST POPJ1 ; can't open file (should never have needed to!)
MOVEI A,-1 ;Got wrong page read in, go to end of page
PUSHJ P,SETARR ;Get to edge of closest page
SORRF Cannot find page from which attach buffer came.
JRST POPJ1
ATTRE3: OUTSTR [ASCIZ/and that file
is no longer in the file list. /]
JRST POPJ1
ATTRE4: SORRJ Attach buffer came from different file
JUMPL T,ATTRE3 ;Jump if file's index number has been reassigned
OUTSTR [ASCIZ/-- #/]
IDIVI T,ZENT ;Get real file number
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/
/]
JRST POPJ1
;Here from ⊗E command when in attach mode.
;⊗#⊗E means put down first # lines of attach buffer and move past them.
;⊗-⊗#⊗E means add previously # lines to front of attach buffer.
;⊗E means put down whole attach buffer.
ATTEX0: TRNE F,ARG!REL ;Without any argument (or sign), release everything
CAML A,ATTNUM ;Can only release as many lines as are attached
JRST ATTRE5 ;Put down whole attach buffer
JUMPGE A,ATTEX2 ;If positive arg, no check -- putting down lines
PUSHJ P,ATTCHP ;Check for enough previous lines, no pagemark
ATTEX2: PUSH P,ATTNUM ;Remember how many lines were attached
PUSH P,A ;Remember number of lines to move past
PUSHJ P,ATTRE5 ;Put down everything
POP P,A ;Amount to move down
MOVN T,A
ADDM T,(P) ;Figure new number of lines to re-attach after move
PUSHJ P,MOVARR ;Move past lines requested to be put down
POP P,A ;Get back number of lines to re-attach
JRST ATTACH ;Re-attach (more than, less then, or same as before)
;Check to see if enough previous lines to attach or copy, limit count thusly.
;Returns uplevel and skips (out of cmd routine) if there is a pagemark in the way.
ATTCHP: MOVN T,ARRL ;For negative arg, can only add as many lines
CAMG A,T ; as there are before arrow.
AOS A,T ;Limit negative arg to 1-(ARRL) (lines to be added)
JSP G,ATTCHK ;Return uplevel if pagemark in way of att/copy
POPJ P,
ATTRE5: TRZN F,ATTMOD ;Here with correct page in core
PUSHJ P,TELLZ
ATTEX: PUSHJ P,EXCLR
MOVEI T,
EXCH T,ATTNUM
ADDM T,LINES
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
MOVE T,ATTSIZ
ADDM T,CHARS
MOVS T,ATTBUF
MOVE TT,ARRLIN
HLL TT,(TT)
HRLM T,(TT)
HRRM TT,(T)
MOVS T,T
MOVS TT,TT
HRRM T,(TT)
HRLM TT,(T)
ANDI T,-1
MOVSI TT,ARRBIT
IORB TT,TXTFLG(T)
TLNE TT,PMARK ;Is this a pagemark?
TLOA F,PMLIN ;Yes (multipage attach mode must be implemented!)
TLZ F,PMLIN ;No
HRRZ TT,TXTCNT(T)
SKIPN TT ;Is this a null line?
TLOA F,NULLIN ;Yes
TLZ F,NULLIN
MOVSI TT,ARRBIT
EXCH T,ARRLIN
ANDCAM TT,TXTFLG(T)
PUSHJ P,LINSET
PUSHJ P,CHECKA ;Make sure the "A" is gone from header line
MOVEI B,
EXCH B,ATTLOC ;Get and clear line and page that text is from
SETZM ATTPOS
SKIPL TT,ATTFIL ;get index of file the text came from
CAME TT,ZINDEX ;skip if we're in that file now
JRST SETWRT ;not in that file, must set W flag
PUSHJ P,GPAGL ;see where we just put the text down
MOVE TT,ATTFLG ;get flags at time we picked up the text
CAMN T,B ;is this text's source page and line (and file)?
TRNE TT,WRITE ;yes, skip if page was previously altered
JRST SETWRT ;set W flag
TRNE F,WRITE ;text is back where it was. file altered now?
PUSH P,[CLRWRT] ;yes, undo W flag set at time of text pickup
JRST SETWRT ;must set W momentarily to update incore page char counts
;ATTKIL ATTKAL ATTKL2 ATTKL ATTUPD ATTSRC GPAGL GPAGL0 GPAGL1 GPAGL2 GPAGL3 GPAGL4 ATTWRT
;Here from ⊗K command, possibly with argument.
;⊗-⊗#⊗K means copy # previously lines into front of attach buffer.
ATTKIL: JUMPL A,ATTCPP ;Copy previous lines to front of buffer
TRNN F,ATTMOD
JRST ERR
MOVE C,A ;How many he wants to kill
CAMG C,ATTNUM ;You can only kill as many as there are
TRNN F,ARG!REL ;No arg means kill all
ATTKAL: MOVE C,ATTNUM ;Kill 'em all
JUMPE C,CPOPJ
MOVN A,C
ADDB A,ATTNUM
JUMPN A,ATTKL2 ;Jump if anything left attached
SETZM ATTLOC
SETZM ATTPOS
TRZA F,ATTMOD
ATTKL2: PUSHJ P,ATTWRT ;We've changed the attach buffer
HRRZ A,ATTBUF
TLO F,NOCHK
ATTKL: HRRZ B,(A)
HLRZ T,TXTCNT(A) ;Number of chars in line being killed
MOVN T,T
ADDM T,ATTSIZ# ;Subtract from total chars attached
PUSHJ P,FSGIVE
MOVEI A,(B)
SOJG C,ATTKL
HRRM A,ATTBUF ;Point header at first remaining attached line
MOVEI B,ATTBUF
HRLM B,(A) ;Point new first line back at header
TLZ F,NOCHK
PUSHJ P,CORCHK ;maybe core down
;(enter here from UNDELETE and MEDIT)
ATTUPD: PUSHJ P,EXSETA ;Set number of EXTRA attached lines to display
JRST CHECKA ;See if need to clear "A" from header line
ATTSRC: TRNE F,ARG
TRNE F,REL
JUMPGE A,[AOJA A,CPOPJ]
POPJ P,
;Routine to return <line>,,<page> in T for current line, even in multipage mode.
;In multipage mode, ptr to incore pagemark for current page is returned in TT,
;unless arrow is on first incore page, in which case TT is returned pointing
;to the first incore pagemark (i.e., the one for the page AFTER the current
;page). If only one page is in core, zero is returned in TT.
GPAGL: SKIPE TT,XPLST
JRST GPAGL1
GPAGL0: MOVE T,FIRPAG
HRL T,ARRL
JRST GPAGL4
GPAGL1: HLRZ T,PMLNBR(TT) ;Get line number of first incore pagemark
CAML T,ARRL
JRST GPAGL0 ;Arrow is on first page in core
GPAGL2: HLRZ T,PMLNBR(TT) ;Get line number of this incore pagemark
CAML T,ARRL
JRST GPAGL3 ;This is the page we're on
HRRZ TT,(TT) ;Arrow is beyond pagemark, find next pagemark
JUMPN TT,GPAGL2
MOVEI TT,XPLSTE ;Arrow is after last pagemark
GPAGL3: HLRZ TT,(TT) ;Get ptr to pagemark starting page with arrow
HRLO T,ARRL ;-1 in RH makes sure RH doesn't borrow from LH of T in SUB
SUB T,PMLNBR(TT) ;Calculate location of arrow within this page
HRR T,PMSIZE(TT) ;Get real page number in RH
GPAGL4: HRRZM T,XXPAGE ;Needed by XMARK routines (added 1/18/77 by ALS)
HLRZM T,XXLINE
POPJ P,
ATTWRT: MOVEI T,WRITE
IORM T,ATTFLG
SKIPE DPY ;Don't cause spurious retyping of line on non-display.
TRO F,DSPSCR
POPJ P,
;ATTCOP CHECKA ATTCPP ATTCP1 ATTCP4 ATTCP
PUSHJ P,ATTSRC
ATTCOP: MOVSI T,ATTBUF
TRNN F,ATTMOD
MOVEM T,ATTBUF
PUSHJ P,ATTDO
JRST ATTCP ;ATTDO XCTs this if already in attach mode
PUSHJ P,ATTCP1
SKIPE A,ATTMOV
PUSHJ P,MOVARR
SKIPE T,ATTMOV
PUSHJ P,GPAGL
MOVEM T,ATTPOS#
CHECKA: MOVEI T,1 ;Check for needing the "A" on the header line
TRNE F,ATTMOD
MOVEI T," A"⊗1+1
HRRM T,UIFLG ;DISP routine will copy to UIFLG2 and force out hdr
SETOM NEEDHD ;set flag to make HEADS think about hdr line
POPJ P,
;Here from ⊗-⊗#⊗K to add # previous lines to front of att buf
ATTCPP: TRNN F,ATTMOD ;If not in att mode,
JRST ATTCOP ; just do ⊗-⊗#⊗C
PUSHJ P,ATTCHP ;Check for enough previous lines, no pagemark
JUMPE A,CPOPJ ;Jump if no lines to add
MOVMM A,ATTMOV ;We're moving up, remember to move back down
PUSHJ P,MOVARR ;Move up to first of new lines to copy
TRO F,DSPSCR ;Make attach buffer display get updated
MOVE A,ATTMOV ;Get back number of lines to copy
MOVE D,A ;ATTDO3 needs number of lines in both D and A
;Note: This copying and linking is a little tricky, because any call to FSGET
;to create a new FS block may cause shuffling, thus invalidating any FS ptrs
;lying around in ACs. The shuffling guarantees to update pointers in the
;lists headed by PAGE and ATTBUF, and it also updates the one pointer stored
;in FSBLK. This means we have to do the copy without maintaining any more than
;one FS ptr in an AC as we go. The one ptr in an AC is in C, and points to
;the list of lines we are copying, and ATTCP4 saves it in FSBLK during FSGET.
;Now, what we're going to do is: Copy the lines and insert them at the
;END of the attach buffer instead of at the BEGINNING where we want them.
;The ATTDO3 routine is set up to make this easy. Then when we're done,
;we'll go remove the new piece of the list from the end of the attach buffer
;and insert it at the beginning, with no worry about FSGET being called then.
;The positive length of the piece we have to move is currently saved in ATTMOV.
PUSHJ P,ATTDO3 ;Loop through lines, copying into attach buf
PUSHJ P,ATTCP1 ;For each line, make a copy in new FS block
;Now it's time to move the last N lines in the attach buf to the front of the buf.
MOVE G,ATTMOV ;Get back number of lines we just copied
MOVEI A,ATTBUF ;Move backward from end of attach buffer
HLRZ A,(A) ;Back up one line in buffer
SOJG G,.-1 ;Loop unless found first new line
HLRZ B,ATTBUF ;Get pointer to last line in piece being moved
HLRZ T,(A) ;Get pointer to previous final buffer line
MOVEI TT,ATTBUF ;Make previous final line final line again
HRRM TT,(T) ;Point old final line on to header
HRLM T,ATTBUF ;Point header back to final line
HRRZ T,ATTBUF ;Get pointer to old first line in buffer
HRRM A,ATTBUF ;Make hdr point forward to beginning of new piece
HRLM TT,(A) ;Make beginning of new piece pt back to hdr
HRRM T,(B) ;Make end of new piece pt on to old first line
HRLM B,(T) ;Make old first line pt back to end of new piece
SETZM ATTPOS ;Disable automatic movement after +-C cmds
MOVE A,ATTMOV
JRST MOVARR ;Move arrow back to where we started, all done
;Copy FS text block pointed to by C. Return new FS ptr in A.
;Ptr to previous last buffer line returned in E, new copy is now last buffer line.
ATTCP1: PUSHJ P,ATTCP4 ;Copy a line's text into new FS block
MOVSI TT,ARRBIT!WINBIT
ANDCAM TT,TXTFLG(A)
HLRZ E,ATTBUF
HRLM A,ATTBUF
MOVEI T,ATTBUF
MOVEM T,(A)
POPJ P,
;Copy FS block for line pointed to by C. Copy's FS address returned in A.
;C is updated in case original line gets shuffled in FS.
ATTCP4: SUBI C,1
MOVEM C,FSBLK
HRRZ B,(C) ;Get length of FS block
SUBI B,2 ;Discount overhead words
PUSHJ P,FSGET ;Get duplicate size block
AOS C,FSBLK
MOVSI TT,-1(C)
HRRI TT,-1(A)
BLT TT,-1(T) ;Copy original line, including FS hdr and trlr wds
AOS TT,TXTNUM
HRRM TT,TXTSER(A) ;Give new version of line new serial nbr
SETZM TXTWIN(A) ;clear window ptr for line in current window
POPJ P,
ATTCP: TRNE F,REL
JRST ATTCP0 ;Cmd was ⊗+⊗#⊗C or ⊗-⊗#⊗C
TRNN F,ARG
MOVE A,ATTNUM
PUSHJ P,ATTEX
JRST ATTCP3
;ATTCP0 ATTCPL ATCMOR ATTCP2 ATTCP3
;Here if some lines attached when cmd ⊗+⊗#⊗C or ⊗-⊗#⊗C given.
ATTCP0: TRO F,ATTMOD!DSPSCR ;In attach mode and need to update screen
JUMPLE A,ATTCP2 ;Jump if we want no lines to be in attach buffer.
CAMN A,ATTNUM
JRST POPAJ ;Right number of lines attached, pop up a level
AOS (P)
CAML A,ATTNUM
JRST ATCMOR
PUSHJ P,ATTWRT ;We are changing the attach buffer
MOVEI T,(A) ;Cmd was ⊗-⊗#⊗C to flush some lines from attach buf
PUSHJ P,EXSETB ;Set number of EXTRA attached lines to display
SUB A,ATTNUM
ADDM A,ATTNUM
PUSHJ P,GPAGL
CAMN T,ATTPOS
SKIPA T,A
MOVEI T,
MOVEM T,ATTMOV
JUMPGE A,POPJ1
MOVN C,A
MOVEI B,ATTBUF
ATTCPL: HLRZ A,ATTBUF
HLRZ T,(A)
HRRM B,(T)
HRLM T,ATTBUF
HLRZ T,TXTCNT(A)
MOVN T,T
ADDM T,ATTSIZ
PUSHJ P,FSGIVE
SOJG C,ATTCPL
JRST POPJ1
;Here to copy some more lines into attach buffer
ATCMOR: SUB A,ATTNUM
PUSHJ P,ARGCHK
SKIPG D,A
JRST POPAJ ;No lines available to add to attach, pop up a level
PUSHJ P,ATTWRT ;We have changed the attach buffer
MOVEM A,ATTMOV
JRST ATTDO2
;Here when -#C given with # or less lines in attach buffer.
ATTCP2: PUSHJ P,ATTKAL ;Kill everything in attach buffer.
MOVEI A,0 ;Don't attach anything new now.
ATTCP3: MOVSI T,ATTBUF ;Attach buffer is now empty.
MOVEM T,ATTBUF
JRST ATTDO0
;LETEST EDIT EDIT1 LINED LINL1 EDDSP EDALT EDARG EDARGX
;Command to test to see if entering the line editor on the current line would work.
LETEST: MOVE A,ARRLIN
HRRZ T,-1(A) ;Words of characters as expanded (for displays)
HLRZ TT,TXTCNT(A)
CAIGE T,EDWRDL ;See if too long for line editor
POPJ P, ;OK, can be edited
SORRJ <Line too long, prints>
JRST EDFUL2 ;Too long, finish msg
;HERE IS WHERE WE GIVE THE CURRENT LINE TO THE LINE EDITOR
;AND LET THE SYSTEM WORRY ABOUT IT
EDIT: PUSH P,A ;SAVE REPEAT COUNT
DPB B,[70200,,C] ;GET BACK CONTROL BITS
PUSH P,C ;SAVE CHAR
EDIT1: MOVE D,[440700,,BUF] ;PLACE TO COPY TEXT TO
TLNE F,OFFEND+PMLIN
JRST EDNUL ;TRYING TO EDIT AT BOTTOM OF PAGE - EXTEND IT
MOVE A,ARRLIN
HRRZ T,-1(A) ;Words of characters as expanded (for displays)
HLRZ TT,TXTCNT(A)
CAIL T,EDWRDL ;See if too long for line editor
JRST EDFULL ;Too long
HRRZ T,TXTCNT(A)
MOVEI B, ;B will count display position for TABs
MOVEI DSP,EDDSP-2
PUSHJ P,EXTST ;If wrap around on DD (check T), move display down.
LINED: ADD A,[440700,,LLDESC]
TLNE F,NULLIN
HRLI A,350700 ;Skip the space in empty lines.
MOVSI E,LSPC
LINL1: ILDB C,A ;Copy text into BUF (mainly to fix tabs)
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,D
AOJA B,LINL1
;Dispatch table for setting up string from current line to give to line editor
PUSHJ P,TELL0 ;NULL We should never get here
PUSHJ P,TELL1 ;RUBOUT ditto
EDDSP: JRST EDCR ;CR DONE WITH LINE
PUSHJ P,TELL3 ;LF
JRST EDTAB ;TAB - SKIP EXTRA SPACES
PUSHJ P,TELL5 ;FF
PUSHJ P,EDALT ;ALTMODE (formerly TELL6)
EDALT: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Warning: Not aborting this line edit will turn its altmode(s) into brace(s).
/]
MOVEI C,"}"
POPJ P,
EDARG: IDIVI A,=10
MOVEI T,200+"0"(B)
JUMPE A,EDARGX
IDIVI A,=10
HRROI A,200+"0"(A)
TRNE A,17
IDPB A,D
ADDI B,200+"0"
IDPB B,D
EDARGX: IDPB T,D
POPJ P,
;EDFULL EDFUL2 EDTAB EDNUL EDCR AGAIN0 AGAIN EDRP0
EDFULL: SUB P,[2,,2]
SORRF <Line too long, prints>
EDFUL2: MOVE Q,ARRLIN
HRRZ Q,TXTCNT(Q)
SETZM TYOPNT
TYPDEC Q
OUTSTR [ASCIZ / columns. /]
AOS (P)
SETZM EDMOV ;Clear count of position to start at in this line
JRST UNINS ;Get out of line insert mode, if in it
EDTAB: IDPB C,D ;COPY THE TAB
ILDB C,A
CAIE C,11 ;Skip to second tab
JRST .-2
TRO B,7 ;Adjust count to position before next tab column
AOJA B,LINL1
EDNUL: MOVEI C,15
EDCR: IDPB C,D ;END OF LINE - STORE CR
MOVEI C,12
IDPB C,D ;AND LF
SKIPG CURMAC
JRST AGAIN0 ;Don't care about character count unless in macro
MOVEI C,(D)
SUBI C,BUF-1 ;See how many words we used (including partial final one)
IMULI C,5 ;Actually, we want chars in line
LDB T,[POINT 6,D,5] ;Get position field from byte pointer
IDIVI T,7 ;See how many bytes are left over
SUBI C,2(T) ;Uncount final nulls and the CRLF
MOVEM C,EDSIZ ;Now we know exact number of chars in line
AGAIN0: MOVEI C,
IDPB C,D ;AND NULL
AGAIN: TLNE D,760000
JRST .-2 ;GET TO WORD BOUNDARY
ADD D,[430200,,1] ;SET TO NEXT WORD - MAKE IT 9 BITS
HRRZM D,PTPNT ;SAVE PNTR FOR LATER
XCT LEPREP ;DO LEYPOS NOW ON DD/DM (SO PTLOAD WILL MAKE CORRECT TABS)
SKIPN A,EDMOV# ;Do we want to position the cursor out in the line somewhere ?
JRST EDRP0 ;No.
SETZM EDMOV
PUSHJ P,EDARG
MOVEI C,240 ;α<space>
IDPB C,D
EDRP0: POP P,C ;GET CHAR
POP P,A ;& # TIMES TO PUT IT IN
CAILE A,=200
MOVEI A,=200 ;LET'S NOT BE RIDICULOUS
JUMPLE A,[SETZ C,↔JRST EDGL] ;DON'T STORE IF NONE and don't confuse MACLIN
TRNE C,200 ;If a ctrl chr.,
PUSHJ P,EDARG ; store the repeat arg.
CAILE A,=99
MOVEI A,=99
IDPB C,D
SOJG A,.-1 ;STORE IT N TIMES (If we have just been to EDARG, A≤0.)
;EDGL MACLEX TTYPTX EDGL2 EDGL2B EDGL2A EDGSET
;HERE WE GIVE THE TEXT TO THE SYSTEM, FOLLOWED BY N COPIES OF THE INITIAL CHAR
EDGL: SKIPLE QCHR# ;Set to 1 if an edit form of substitution command given
PUSHJ P,BSLXCT ;Do line-editor substitution. 377 in C won't confuse MACLIN
SKIPLE CURMAC ;Macro expansion in progress?
PUSHJ P,MACLIN ;Yes, get everything up to first activator.
TRO F,EDITM
SETZB C,NOECH2# ;Assume normal echoing
IDPB C,D ;MAKE SURE 9-BIT STRING ENDS WITH NULL
SKIPN DPY ;Skip if on display
JRST [ TRO F,DSPSCR ;Force output of line number (unless suppressed)
PUSHJ P,DISP ;Maybe output line number
JFCL ;Ignore typeahead--don't "optimize", this is XCTed!
JRST TTYPTX ] ;Rejoin display terminal code
SKIPGE NOIECH ;if all echoing is off, don't diddle echoing here
JRST EDGL0 ;all echoing is off
SKIPL NOECHO ;Skip if user is suppressing echoing
SKIPLE CURMAC ;Turn off echoing of macro-edited stuff.
SETOM NOECH2 ;Remember that edited text isn't getting echoed
EDGL0: SKIPLE CURMAC ;Still expanding macro?
JRST MACLED ;Yes, see if we can avoid using the actual line editor
MACLEX:
IFN DECSW,<
MOVE C,[3,,[.TOSST ↔ 0 ↔ 200]]
SKIPE NOECH2 ;Skip unless echoing being suppressed
TRMOP. C,
JFCL
>
IFE DECSW,<
SKIPE NOECH2 ;Skip unless echoing being suppressed
PTJOBX [0↔3]
>
SKIPN NOECH2 ;Don't output CRLF if echoing is suppressed
SKIPGE NOIECH ;skip unless all input echoing is turned off
CAIA ;not echoing, don't need CRLF
PUSHJ P,ABCRLF ;Make echo of line start at left margin unless in macro
PTL7W9 PT79 ;LOAD LINE EDITOR AND PASS ALONG SIMULATED "TYPE AHEAD"
SETOM NOLEDS ;Suppress our LE display at MACDSL
SETOM NOSTEP ;Suppress display update here if stepping macros
SETZM DIDWR2 ;assume line editor hasn't wrapped around (set by DISP)
PUSHJ P,DISP ;Update display.
XCT LINTST
SKIPE DIDWR2 ;skip unless line editor has already wrapped around
SETOM DIDWR1 ;tell DISP next time that line editor previous wrapped
SETZM NOLEDS
INWAIT ;Wait for activator before restoring echoing
IFN DECSW,<
MOVE C,[3,,[.TOCST ↔ 0 ↔ 200]]
SKIPE NOECH2 ;Skip unless echoing being suppressed
TRMOP. C,
JFCL
>
IFE DECSW,<
SKIPE NOECH2 ;Skip unless echoing being suppressed
PTJOBX [0↔4] ;Turn echoing back on.
>
TTYPTX: MOVEI DSP,EDGDSP-2
MOVSI E,LSPC!NSPEC ;Char bits to do something special on
PUSHJ P,EDGSET ;Prepare to count and store as line comes back
IFN FTRDLINE,< SETZM EDGLBP > ;Force INCHAR to do a RDLINE UUO first time
EDGL2: CHARIN ;READ CHAR INTO C
EDGL2B: TRNE C,600
JRST EDACT ;ANYTHING WITH BUCKY BITS IS AN ACTIVATOR
TDNE E,CTAB(C)
XCT @CTAB(C) ;As well as selected other chars
EDGL2A: IDPB C,D
AOJ B, ;Count columns
AOJA T,EDGL2 ;Count characters
EDGSET: SETZB B,TT ;B counts columns, TT counts tabs
SETZB T,EDCHR ;T WILL COUNT CHARACTERS READ FROM LINE EDITOR
MOVE D,[440700,,BUF] ;WHERE TO STORE AS WE GOBBLE IT BACK
TRO F,DSPSCR
TRZ F,EDBRK
POPJ P,
;EDGL3 EDGL3A EDGL4 REEDIT REEDT2 EDTMR2 EDTMOR REEDT3 EDGL5 EDCERR EDTMR3 EDLF EDTAB2 ALTFIX ALTCHK EDGDSP INCHA2 INCHAR PT79 PTPNT
;HERE WE HAVE FINISHED THE LINE AND NOW HAVE TO DISPATCH ON THE ACTIVATION CHAR
EDGL3: MOVEI C,15 ;TERMINATE IT IN CASE WE HAVE TO RE-EDIT
IDPB C,D
EDGL3A: MOVEM T,EDSIZ# ;Remember number of chars in line
MOVEI A,0 ;AC A holds the command argument for CMDEX below
IDPB A,D
MOVEM D,EDPNT#
MOVEM B,EDCOLS# ;SAVE TOTAL DISPLAY COLUMNS
MOVEM TT,EDTTBS#;& # TABS
SKIPGE STEPLE ;Is this an extra time through LE for macro stepping?
JRST REEDT2 ;Yes, go right back into LE (we have to keep EDITM on)
PUSHJ P,EXCLR ;Clear extra DD line used by line editor.
TRZ F,ARG+REL+NEG+EDITM
HRRZ C,EDCHR ;HERE WE GO THROUGH THE COMMAND DISPATCH PROCEDURE
SKIPE NOECH2 ;Skip unless echoing is suppressed
SKIPLE CURMAC ;Don't type out char if still in macro
JRST EDGL4
PUSHJ P,PRNTC2 ;Type activation character including bucky bits
EDGL4: SKIPG CURMAC ;If we are inside a macro, this activator is already stored
PUSHJ P,SAVCHR ;Save char for FBI
HRROI DSP,CMDSP
SETZM XLAST ;Haven't seen an extended command yet this time
PUSHJ P,CMDEX ;Get dispatch word for command in D
JRST ALTCHK
TRO F,EDITM ;FLAG THAT WE CAME FROM LINE EDIT
TLNE D,NOEDIT ;OR IF WE SHOULD GO TO THIS COMMAND IMMEDIATELY
JRST EDGL5 ;Dispatch without storing away line's edit
TLNE D,DOEDIT
JRST EDITIT ;THIS ONE WANTS TO COMPLETE THE EDIT FIRST
REEDIT: SORRF Command illegal from line editor here --
MOVEI T,ERR0 ;Routine to type command char
SKIPE XLAST ;Skip unless we just saw an extended command
MOVEI T,EXTAM3 ;Routine to type bad extended command name
PUSHJ P,(T) ;Type the illegal command char or extended command name
JFCL ;Always skips
REEDT2: PUSH P,EDCNM ;WE DON'T LIKE THIS - EDIT IT AGAIN AT THE SAME CURSOR POS
EDTMR2: PUSH P,[240] ;THIS SHOULD GET US THERE
EDTMOR: MOVEI C, ;IN CASE WE NEED NULLS
MOVE T,EDCOLS
PUSHJ P,EXTST
MOVE D,EDPNT
SKIPGE EDCHR ;DID WE SEE CR AND LF?
SOS EDSIZ ;YES, FUDGE FOR LF (IF PRESENT)
SOS EDSIZ ;AS WELL AS FOR ACTIVATION CHAR
JRST AGAIN ;Now EDSIZ has right character count for line to be edited
;Come here after calling FNEDT0 when want to reedit line at same place.
REEDT3: SETZM EDCHR ;Kludge to cancel the coming second SOSing of EDSIZ,
AOS EDSIZ ;because FNEDT0 already did it and REEDT2 will again!
JRST REEDT2
EDGL5: TLNN D,DOEDIT ;Want to dispatch and return here?
JRST (D) ;No. Just go.
EDCERR: PUSHJ P,(D) ;Yes, execute routine and return to reedit line
SKIPLE CURMAC ;Don't type CRLF and OK if executing a macro
JRST REEDT2 ;Skip return suppresses OK
SKIPN NOECH2 ;Forget CRLF if echoing was suppressed
SKIPGE NOIECH ;skip unless all input echoing is turned off
CAIA
OUTSTR [ASCIZ /
/] ;Command cannot have been CR, so output CRLF
OUTSTR [ASCIZ / OK /]
JRST REEDT2 ;Should never take double skip return, I hope!!!
EDTMR3: MOVE T,EDCNM
MOVEM T,EDMOV ;Get us back out to where we came from in line
PUSH P,A ;Repeat arg for line editor cmd
DPB B,[70200,,C] ;Put back control bits
PUSH P,C ;Line editor cmd
JRST EDTMOR
EDLF: SKIPN DPY
JRST EDLF2 ;Turn LF into CR on TTY
JRST EDACT2
EDTAB2: SKIPGE EDTABP
MOVEM B,EDTABP# ;REMEMBER POS OF FIRST TAB FOR REPRST
TRO B,7 ;DIDDLE COL POS
AOJA TT,EDGL2A ;& COUNT TABS
REPEAT 0,< ;Fix at DPSPS4 should make this unnecessary
ALTFIX: MOVE T,ARRL
SUB T,TOPWIN
ADD T,SCRTOP ;Figure out screen line number of line edited
JUMPLE T,.+2
HLLZS DPYTAB+1(T) ;Force line edited to be redrawn
POPJ P,
>;REPEAT 0
ALTCHK: TLNE D,10000 ;Was user mode bit set by JSP D,CPOPJ or JSP D,ERRX?
JRST EDCERR ;Yes, error, type message
SKIPN NOECH2 ;Forget CRLF if echoing was suppressed
SKIPGE NOIECH ;skip unless all input echoing is turned off
CAIA
OUTSTR [ASCIZ/
/]
TLZN F,LINSM ;Leave line insert mode if was in it
POPJ P, ;Wasn't in line insert mode
PUSHJ P,UNINS2 ;Clear the "I" on the header line and fix the arrow.
AOS EDCNM ;Fake things for REPLIN
MOVE T,EDSIZ ;Did altmode come in empty line?
SOJG T,REPLIN ;No, keep final edited text of that line
SKIPGE NLININ ;Yes, are we in "funny" mode (e.g., just did a αβ.)?
POPJ P, ;Yup, in that case, keep the saved version of the line
MOVEI A,1 ;Altmode came with line empty -- delete last line inserted
TRZ F,EDITM
SETOM NOSAVE# ;Prevent FSTEXT from saving this empty line we're deleting
PUSHJ P,DELLIN
SOS INSCNT ;Count one less line actually inserted among incore text
SKIPE NLININ ;Were any lines actually inserted in this group?
POPJ P, ;Yes, leave WRITE flag alone
MOVE T,FSAV ;No, see if WRITE flag was on when we started
TRNN T,WRITE ;Was it?
JRST CLRWRT ;No, then turn it back off
POPJ P, ;Yes, leave it alone now
JRST EDGL2 ;NULL. Should never happen. Ignore it.
AOJA C,EDACT2 ;BS. Make it a 200, ie, an illegal command
EDGDSP: JRST EDCR2 ;SPECIAL THINGS FOR CR
JRST EDLF ;LF
JRST EDTAB2 ;TAB
JRST EDGL2 ;FF
JRST EDACT2 ;ALTMODE
IFN FTRDLINE,<
INCHA2: MOVE C,[LEDGBF*4-1,,EDGBF-1]
RDLINE C, ;Read whole line into our buffer
MOVE C,[POINT 9,EDGBF]
MOVEM C,EDGLBP
INCHAR: ILDB C,EDGLBP ;Any chars already read from system?
JUMPE C,INCHA2 ;NO
POPJ P, ;YES
>;FTRDLINE
IMPURE
PT79: 0
BUF
PTPNT: 0
PURE
;EDCR2 EDLF2 EDACT EDACT4 EDACT5 EDACT3 EDACT6 EDACT2 EDACT1 EDITIT FNEDIT UNINS UNINS2 FNEDT0 POPBCJ REPLIN PUTBAK
EDCR2: CHARIN ;GET LF (CR'S ALWAYS HAVE LF'S) INTO C
EDLF2: MOVEM T,EDCNM ;Save number of chars before activator
MOVEM T,EDCNMR ;Save also for cmd to get back into line
TDC C,[-1,,15≥12] ;MAKE IT A CR (WITH BITS FROM LF)
AOJA T,EDACT1 ;Count CR. LF will be counted below.
EDACT: CAIE C,400 ;END OF LINE?
JRST EDACT2 ;NO
SKIPE EDCHR ;Seen an activation character yet?
JRST EDGL3 ;Yes
SORRF <
Line editor has filled up and activated. No more text can be added to this line.
Please type activation character you want.>
SETO C,
BEEP C, ;Catch his attention to the msg
MOVEM T,EDCNMR ;Save also for cmd to get back into line
MOVEM T,EDCNM ;Pretend activator came here and discard subsequent text
MOVEM B,EDPOS ; except for actual activation character
MOVEM TT,EDTBS
EDACT4: INCHWL C
TRNE C,600 ;Any control bits means its an activation char
JRST EDACT3 ;Got it
CAIN C,15 ;CR
JRST EDACT5 ;Go get bits from LF
CAIE C,ALTMOD ;Altmode
CAIN C,12 ;LF
JRST EDACT6
JRST EDACT4 ;Nothing special here
EDACT5: INCHRS C ;Get the LF that must follow a CR
PUSHJ P,TELLZ
TDC C,[-1,,15≥12] ;Turn the LF into a CR with same control bits
AOJA T,EDACT6 ;Count the CR
EDACT3: CAIN C,400 ;Is it really an activator this time?
JRST EDACT4 ;No, go back for more
EDACT6: MOVEM C,EDCHR ;Save activation character
INCHWL C
CAIE C,400 ;We have the activator, now skip to the 400 at end of line
JRST .-2
AOJA T,EDGL3 ;Done with line at last (Count the activator)
EDACT2: MOVEM T,EDCNM# ;Chr. position.
MOVEM T,EDCNMR# ;Save also for cmd to get back into line
EDACT1: MOVEM B,EDPOS# ;SAVE ALL KINDS OF CRAP ABOUT IT - B has horiz. position.
MOVEM C,EDCHR# ;Chr.
MOVEM TT,EDTBS# ;No. of tabs before it.
SKIPN DPY ;Skip unless on TTY
AOJA T,EDGL3 ;Must be end of line from TTY
CHARIN ;GET NEXT CHAR INTO C
MOVEM C,EDNEXT# ;Remember char after activator for RDVCHR
CAIN C,400 ;END OF LINE?
AOJA T,EDGL3 ;yes
TRO F,EDBRK ;NOPE - FLAG IT AS A BROKEN LINE
SETOM EDTABP ;PREPARE TO LOCATE TAB
AOJA T,EDGL2B ;AND GET MORE
EDITIT: SKIPN NOECH2 ;Forget CRLF if echoing was suppressed
SKIPGE NOIECH ;skip unless all input echoing is turned off
CAIA
OUTSTR [ASCIZ /
/]
PUSH P,D ;Will POPJ to dispatch
FNEDIT: PUSHJ P,FNEDT0 ;Accept edited version of line
UNINS: TLZN F,LINSM ;Get out of line insert mode, if in it
POPJ P,
UNINS2: MOVEI T,1 ;We have just left line insert mode
HRRM T,UIFLG ;Clear the "I" from header line
SETOM NEEDHD ;set flag to make HEADS think about hdr line
MOVEI T,"→"
DPB T,[10700,,ARRON]
POPJ P,
FNEDT0: PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,EDCNM ;Save location of activator in line
PUSHJ P,REPLIN
POP P,EDCNM
POP P,A
POPBCJ: POP P,B
POP P,C
POPJ P,
REPLIN: SKIPGE EDCHR ;HERE WE REPLACE THE CURRENT LINE TEXT WITH THE EDITED VERSION
SOS EDSIZ ;FUDGE FOR LF (IF PRESENT)
SOS T,EDSIZ ;AS WELL AS FOR ACTIVATION CHAR
MOVEM T,EDCNM ;A RANDOM PLACE TO SAVE IT
MOVE T,EDTTBS
LSH T,1
ADD T,EDCOLS ;# cols + 2 * # tabs = total # chars with expanded tabs
PUTBAK: PUSHJ P,EDPUT ;Copy the text (shuffles assuming C(T) chars)
SKIPN EDCNM
JRST [ MOVEI C,40 ;EMPTY LINE - PUT IN A SPACE FOR DD
IDPB C,A
JRST .+1]
FOR X IN(15,12) ;TERMINATE IT
< MOVEI C,X
IDPB C,A
> TDZA C,C
IDPB C,A
TLNE A,760000
JRST .-2 ;FLUSH ANY GARBAGE IN THE REST OF THE WORD
MOVE T,ARRL
MOVEM T,EDLINE ;Remember this line's number
HRRZ T,TXTSER(D)
MOVEM T,EDSER ;Remember this line's serial number
MOVE T,EDCNMR
MOVEM T,EDCNM2 ;Remember position of this line's activator
MOVE T,EDCNM ;# chars
ADDI T,2 ;ACCOUNT FOR CRLF
HRL TT,T
HLRZ C,TXTCNT(D)
SUB T,C
ADDM T,CHARS ;UPDATE COUNT BY DIFFERENCE
MOVEM TT,TXTCNT(D)
TLZE F,TF1 ;Has anything been changed?
JRST SETWRT ;Yes
POPJ P, ;No
;EDPLUZ EDPUT EDPLR
EDPLUZ: PUSH P,T ;HERE AFTER EDITING LINE N+1 (PHONY NULL LINE MADE AT EDNUL)
PUSHJ P,INSONA ;MAKE A REAL LINE
POP P,T ;RESTORE # WORDS
SETOM NOSAVE ;Don't let FSTEXT save this empty line we just made
PUSHJ P,EDPLR ;Put new text into new line
SETZM NOSAVE ;In case new line was empty and we never called FSGIVE
POPJ P,
;EDPUT adjusts buffer to take C(T)+3 (CR-LF-NUL) chars instead of the current line,
;then copies C(EDCNM) chars from BUF, expanding tabs
EDPUT: ADDI T,4+2+5*LLDESC ;<ROUND UP>+<CR-LF>+<EXTRA WDS>
IDIVI T,5 ;# WDS
TLNE F,OFFEND+PMLIN
JRST EDPLUZ ;OOPS - IT'S A PHONY LINE
EDPLR: MOVE A,ARRLIN
HRRZ B,-1(A) ;OLD # WDS, including 2 FS overhead words
CAIN T,-2(B) ;We can reuse same FS block if old same size as new
JRST EDPS ;Right, reuse old block
CAIL T,-2(B) ;If new block is smaller than old one, then new
TLO F,NOCHK ; block can be carved out of old one (freeing rest)
MOVE B,T ;Argument of number of words for FSGET
PUSH P,TXTFLG(A)
PUSH P,TXTCNT(A)
MOVE T,(A)
PUSH P,T ;Save links from old FS block
HRLM P,(T) ;Link stack word into list in place of old block
MOVS T,T
HRRM P,(T)
PUSHJ P,FSGIVE ;Give up old block (goes into deleted line list)
TLZ F,NOCHK
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
MOVEM A,ARRLIN
POP P,T
MOVEM T,(A) ;Restore links from old FS block into new block
HRLM A,(T) ;Make prev and next lines point to new block
MOVS T,T
HRRM A,(T)
POP P,TXTCNT(A) ;Old text counts
POP P,T ;Old text flags
HLLM T,TXTFLG(A)
TLNE T,WINBIT
MOVEM A,WINLIN
SETOM LLDESC(A) ;Make sure low-order bit is on in text words
CAIG B,LLDESC+1
JRST EDPS0 ;There's only one text word
MOVSI T,LLDESC(A)
HRRI T,LLDESC+1(A)
ADDI B,(A)
BLT T,-1(B) ;Set low-order bit in all text words
;FALLS THRU
;EDPS0 EDPS EDPL EDPL1 EDPL2 EDPNUL EDPCOP TTTBAJ
;Fell through too
EDPS0: TLOA F,TF1 ;Line has already changed and been deleted
EDPS: TLZ F,TF1 ;Used to detect if anything changed on the line
AOS T,TXTNUM
HRRM T,TXTSER(A)
SETZM TXTWIN(A) ;clear window ptr for line in current window
MOVEI D,(A)
ADD A,[440700,,LLDESC]
MOVE B,[440700,,BUF]
MOVEI TT,0 ;Count columns for filling tabs with spaces
SKIPN T,EDCNM
JRST EDPNUL ;The new line is empty
TLZE F,NULLIN
TLO F,TF1 ;Was empty but isn't now, so must be different
EDPL: ILDB C,B
TLNN F,TF1 ;Has line already been different?
JRST [ ILDB Q,A ;No
CAMN C,Q ;Has character changed?
JRST EDPL1 ;No, so do not bother to store it
PUSHJ P,EDPCOP ;Copy old line to new FS block and "delete" it
DPB C,A ;Change it and
TLO F,TF1 ; set flag to remember line has changed
JRST EDPL1 ]
IDPB C,A
EDPL1: CAIE C,11 ;THE ONLY THING WE WORRY ABOUT
AOJA TT,EDPL2
MOVEI C,40 ;TAB - APPEND SOME SPACES
HRLS TT
TLO TT,-10
IDPB C,A
AOBJN TT,.-1
MOVEI C,11
IDPB C,A
EDPL2: SOJG T,EDPL
MOVE Q,A ;Copy byte pointer so we won't destroy it.
ILDB C,Q
CAIE C,15 ;Does old line end here?
TLO F,TF1 ;No, lines are different
POPJ P,
EDPNUL: TLON F,NULLIN ;The new line is empty.
TLOE F,TF1 ;But the old one wasn't.
POPJ P,
EDPCOP: PUSH P,A ;Copy old line to new FS block and "delete" it
PUSH P,B
PUSH P,T
PUSH P,TT
HRRZ B,-1(D) ;Get size of FS block including 2 overhead words
MOVEI B,-2(B) ;Arg for routine doesn't include overhead
TLO F,NOSHUF!NOCHK ;Don't let our FS get shuffled on us
PUSHJ P,FSGET ;Get a block of the same size
MOVEI T,-1(A) ;Address of new block's leading FS word
HRLI T,-1(D) ;Same for old block
ADDI B,-1(A) ;End address (of text) of brand new block
BLT T,(B) ;Copy the works of old line (including FS leader)
PUSHJ P,FSGIVE ;Now make the FS go into the deleted line list
TLZ F,NOSHUF!NOCHK ;NOSHUF was for FSGET, NOCHK for FSGIVE
TTTBAJ: POP P,TT
POP P,T
JRST POPBAJ
;PREVED PREVER
;Command routine to put us back in the line editor at the location
; where we last came out of it, not counting this particular instance
; of this command in case it was given from the line editor.
PREVED: HRRZ A,EDLINE ;Get number of line we want to go to
MOVE B,EDSER ;And its serial number
MOVE C,EDCNM2 ;And char position we want
TRNE F,EDITM
PUSHJ P,FNEDIT ;Store away newly edited line (sets new EDLINE, etc)
PUSHJ P,FNDLIN ;Find remembered line's FS
HRRZ TT,TXTSER(T)
CAMN TT,B ;Is this the right line (same serial number)?
CAMLE A,LINES ;Yes, is there really such a line in core?
JRST PREVER ;No! The line must have been deleted or something.
PUSHJ P,SETARR ;Go to previous line edited
SKIPN DPY
POPJ P, ;No editing on non-display
PUSH P,C ;Character position we want
PUSH P,[240] ;CONTROL-space to get us there
JRST EDIT1
PREVER: SORRY No line to re-edit.
JRST POPJ1
;CRDSP REGCR REGCR1 REGCR2
TLO F,OKF
REGCR: TRNN F,EDITM ;Regular CR - No bucky bits
JRST REGCR1 ;Just move arrow.
TRNE F,REL!ARG ;If any argument, pretend CR came at end of line
TRZ F,EDBRK
PUSHJ P,LECR ;See if CR came in middle of line being edited.
JRST REGCR2 ;No, just move arrow
; PUSH P,D
PUSHJ P,REPRST
; POP P,D
PUSH P,[1]
PUSH P,[311] ;SET UP INSERT MODE FOR NEW LINE
JRST EDTMOR
REGCR1: MOVE B,ARRL
CAMLE B,LINES
JUMPGE A,CPOPJ ;Don't let plain CR at end of page create new line anymore.
AOS (P)
REGCR2: TRNE F,ATTMOD
JRST MOVARR ;Move arrow to new line in attach mode
MOVE B,ARRL ;HERE WE'RE JUST MOVING - SEE WHERE TO
CAMLE B,LINES
JUMPG A,INSONE ;GOING OFF THE BOTTOM - ADD A LINE
JRST MOVARR ;Move arrow to new line
;CONTCR CNTCR2 METAC2 METAC3 METACR REPRST REPRS2
PUSHJ P,CNTCR2
CONTCR: TRNE F,EDITM
POPJ P,
SKIPGE A,SRCOFF
JRST POPJ1 ;No search string found
HRRZM A,EDMOV
MOVEI A,
JRST EDIT
CNTCR2: MOVEI D,EDIT ;Make FNDMOV set EDMOV and then enter line editor
MOVEI A,
POPJ P,
METAC2: PUSHJ P,LECR ;TAKE APPROPRIATE ACTION
JRST REGCR2 ;Not in middle of line, just move down a line
; PUSH P,D
PUSHJ P,REPRST
; POP P,D
SETOM NLININ ;Force "funny" line insert mode
PUSH P,[0] ;No special type-ahead needed.
JRST EDTMR2
METAC3: MOVEI A,1
PUSHJ P,MOVARR ;Down a line so that we will be pointing to new empty line
JRST INSONA ;Insert new empty line
METACR: TLNE F,LINSM
JRST METAC2 ;In line insert mode: keep second half of line in line editor
TRNN F,EDITM
JRST INSONE ;Not from editor, just add blank line above current one.
PUSHJ P,LECR ;DO LINE EDIT STUFF IF NECESSARY
JRST METAC3 ;NOT MIDDLE OF LINE - JUST ADD BLANK LINE
REPRST: MOVN T,EDCNM ;HERE WE STORE THE REST OF THE LINE AFTER THE ACTIVATOR
ADDM T,EDSIZ ;BY UPDATING ALL THE PARAMS BY THE AMOUNT ALREADY DONE
AOSG T,EDTABP
JRST REPRS2
SOS TT,T ;HERE WE FUDGE FOR THE TAB WHOSE POSITION
SUB TT,EDPOS ;(AND HENCE SIZE) IS CHANGING (SIGH)
ORCMI T,7
ORCMI TT,7
SUB T,TT
REPRS2: SUB T,EDPOS
ADDM T,EDCOLS
MOVN T,EDTBS
ADDM T,EDTTBS
PUSH P,EDSER ;Don't clobber serial number of last line edited
PUSH P,EDLINE ;Nor its line number
PUSHJ P,REPLIN
POP P,EDLINE
POP P,EDSER
POPJ P,
;⊗ LECR DUBLI DUBLCE DUBLCR DBLTB2 DBLTAB DBLTTY DUBCR6 DUBCR1 DUBCR5 DUBCR3
;HERE WE HANDLE ALL FLAVORS OF CR FROM THE LINE EDITOR
;IF IT'S AT THE END WE JUST REPLACE THE TEXT AND RETURN
;IF IT'S IN THE MIDDLE WE REPLACE UP TO THE BREAK, MAKE A NEW LINE,
;MOVE THE REMAINING TEXT DOWN IN BUF, AND SKIP RETURN
;Skip return if activator (CR) came in middle of line
LECR: PUSH P,A ;Save argument to command
TRNN F,EDBRK ;MIDDLE OF LINE?
JRST [ PUSHJ P,REPLIN ;NO - REPLACE WHOLE LINE
POP P,A
POPJ P,] ;& RETURN
SKIPN NOECH2 ;Forget CRLF if echoing was suppressed
SKIPGE NOIECH ;skip unless all input echoing is turned off
CAIA
OUTSTR [ASCIZ/
/]
AOS -1(P) ;TELL CALLER WE'RE SPLITTING A LINE
MOVE T,EDTBS
LSH T,1 ;2 TABS/TAB
ADD T,EDPOS
PUSH P,C
PUSHJ P,PUTBAK ;PUT FIRST PART BACK
PUSH P,B
MOVEI A,1
PUSHJ P,MOVARR ;TO THE NEXT LINE
PUSHJ P,INSONA ;AND MAKE A NEW ONE
POP P,B
MOVE D,[440700,,BUF]
ILDB C,B ;COPY REST OF TEXT DOWN WHERE REPLACER EXPECTS IT
IDPB C,D
JUMPN C,.-2
POP P,C
POP P,A
POPJ P,
;Here for αβI command (and αI at end of line editor).
DUBLI: TRNN F,ARG ;If any arg typed,
TRNN F,EDITM ;or if command not given from line editor,
JRST DUBLCR ;then αβI is same as αβ<cr>
PUSHJ P,FNEDT0 ;Save away edited text
MOVEI TT,REEDT3 ;Re-edit current line at same cursor position
JRST LINSDO ;Just enter "funny" line insert mode on old line
DUBLCE: SORRF Maximum line insertion count is 2000.
JRST POPJ1 ;no OK
;Here for αβ<cr> command.
DUBLCR: CAILE A,=2000 ;prevent ⊗∞αβ<cr> from running out of core
JRST DUBLCE ;arg too big
TRNN F,EDITM
JRST DUBCR1 ;Enter line insert mode unless arg given
SKIPN EDCNM ;Did αβ<cr> come at beginning of line?
JRST DUBCR6 ;Yes, don't use "funny" line insert mode
PUSHJ P,LECR ;See if αβ<cr> came in middle of line
JRST DUBCR3 ;Nope, came at end -- we've already stored edited text
TRZ F,EDITM+EDBRK
PUSH P,A
PUSH P,EDCNM ;Remember where we want the cursor when we go back to line
PUSHJ P,REPRST ;Store the second part of the edited text
POP P,EDCNM ;Restore cursor position of activation
POP P,A
TRNE F,ARG
JRST DUBCR5 ;Any arg means just make N new lines
SETO A, ;Otherwise, move back up to first part of broken line
PUSHJ P,MOVARR
DBLTB2: SKIPN DPY ;Can't edit at end of line on non-display
JRST DBLTTY ;So use normal line insert mode instead
MOVEI TT,EDTEND ;Edit current line at end
JRST LINSDO ;Edit that line (at end) in "funny" line insert mode
DBLTAB: TRNE F,EDITM ;If came from line editor, then
PUSHJ P,FNEDT0 ; accept edited version of line
JRST DBLTB2 ;Go into line insert mode
DBLTTY: MOVEI A,1 ;Can't edit at end of this line on non-display
PUSHJ P,MOVARR ;So go into line insert mode after this line
JRST LININS
;Here when αβ<cr> came at beginning of line editor
DUBCR6: PUSH P,A ;Save possible arg
PUSHJ P,REPLIN ;Store away edited text before entering line insert mode
POP P,A
DUBCR1: TRNN F,ARG
JRST LININS ;NO ARG - enter LINE INSERT MODE
DUBCR5: MOVNS A ;INVERT SENSE OF ARROW MOVING
JRST INSNUL ;ARG GIVEN - INSERT N BLANK LINES
;Here when αβ<cr> given at end of line being edited
DUBCR3: PUSH P,A ;Save arg if any
MOVEI A,1
SKIPE EDCNM ;If line was completely blank, enter insert mode above it
PUSHJ P,MOVARR ;Otherwise, go into insert mode below it
POP P,A
JRST DUBCR1
;INSONA INSONE INSNUL INSNLP
;INSNUL INSERTS |C(A)| NULL LINES BEFORE (+) OR AFTER (-) THE ARROW
INSONA: SKIPA A,[-1]
INSONE: MOVEI A,1
INSNUL: MOVM D,A ;# TO INSERT
JUMPE D,CPOPJ
PUSH P,A
ADDM D,LINES
PUSH P,D
PUSHJ P,XLALL ;Fix up marks
POP P,D
PUSHJ P,LINSET ;# LINES HAS CHANGED
MOVEI B,(D)
LSH B,1
ADDM B,CHARS ;Count a CR and a LF for each new line
MOVSI T,WINBIT
SKIPE A,WINLIN
ANDCAM T,TXTFLG(A)
SETZM WINLIN
MOVEI B,LLDESC+1
MOVSI C,TXTCOD
MOVSI E,ARRBIT
MOVSI G,2 ;Count of 2,,0 for a null line
MOVE H,[ASCID/
/]
INSNLP: PUSHJ P,FSGET
HLLM C,-1(A) ;Mark new FS block as text
MOVE T,ARRLIN ;Get old arrow's FS ptr
HLL T,(T) ;Get ptr to line before old arrow
MOVEM T,(A) ;Insert new line just above old arrow
HRLM A,(T) ;Make old arrow line point back to new line
ANDCAM E,TXTFLG(T) ;Clear arrow bit in old line
MOVS T,T ;Now RH T points to line before old arrow
HRRM A,(T) ;Make line before old arrow point forward to new one
MOVEM A,ARRLIN
MOVEM G,TXTCNT(A)
HLLM E,TXTFLG(A)
AOS T,TXTNUM
HRRM T,TXTSER(A)
SETZM TXTWIN(A) ;clear window ptr for line in current window
MOVEM H,LLDESC(A)
SOJG D,INSNLP
PUSHJ P,SETWRT
MOVE A,TOPWIN
SKIPL (P)
ADD A,(P) ;MOVE WINDOW INSTEAD OF ARROW
PUSHJ P,SETWIN ;RECOMPUTE
POP P,A ;ORIGINAL ARG
JUMPGE A,MOVARR
TLO F,NULLIN
TLZ F,PMLIN
POPJ P,
;LINSDO LININS LININ LININ4 LININ5 LININ3 LININ2 LINSUB LININ1 LININ0 DOINS AUTOWR AUTOW2 AUTOW3
;Here from αβ<cr> or αβI inside line editor to enter "funny" line insert mode.
LINSDO: PUSHJ P,DOINS ;Enter line insert mode
JRST (TT) ;Already in it, just go back to line editor
JRST LINSUB ;Jump into line insert mode loop
;Here for normal αβ<cr> to enter line insert mode on new line.
LININS: PUSHJ P,DOINS ;Enter line insert mode
POPJ P, ;Already in it
LININ: AOS INSCNT# ;Count another line inserted among incore text
AOSN NLININ ;Count a line inserted in current group
JRST LININ3 ;Avoid autowrite before first inserted line
SKIPLE TT,INSMAX# ;Skip if autowrite is disabled
CAMLE TT,INSCNT ;Skip if enough lines inserted to cause autowrite
JRST LININ2
OUTSTR [ASCIZ /(Autowrite) /]
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST LININ4 ;can't write it or don't need to, WRPAGE will succeed
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST LININ5 ;can't open file (typed error msg), don't write out
LININ4: PUSHJ P,WRPAGE ;Write out incore page
LININ5: SKIPL INSCNT ;Skip unless we didn't actually write it out
JRST LININ2 ;No write occurred
SETZM INSCNT ;Reset counter to count to threshold again
SETZM NLININ ;Starting over with new group after writing
LININ3: MOVEM F,FSAV# ;Save WRITE flag before first inserted line
LININ2: PUSHJ P,INSONA ;Create the line
MOVEI A, ;Zero repeat arg
MOVEI TT,EDIT ;Edit (new) current line at beginning
LINSUB: PUSHJ P,(TT) ;Edit line somehow (EDIT, REEDT2, EDTEND)
JRST LININ0
JRST LININ1
TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ2T
LININ1: TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ1
LININ0: TLNE F,LINSM
JRST LININ ;Another line please
POPJ P,
DOINS: SETOM NLININ# ;No lines inserted yet
TLOE F,LINSM ;Now in line insert mode
POPJ P, ;We were already in line insert mode, don't recur
MOVEI T," I"⊗1+1
HRRM T,UIFLG ;Put "I" on header line to flag line insert mode
SETOM NEEDHD ;set flag to make HEADS think about hdr line
MOVEI T,"↔"
DPB T,[10700,,ARRON]
JRST POPJ1
;Command to set and/or read autowrite threshold
AUTOWR: JUMPE A,AUTOW2
TRNN F,ARG
JUMPGE A,AUTOW2 ;Negative arg disables
MOVEM A,INSMAX ;Set autowrite threshold
SKIPGE BLAB
POPJ P, ;Terse mode
AUTOW2: OUTSTR [ASCIZ/ Auto Write /]
SKIPLE INSMAX
JRST AUTOW3 ;Enabled
OUTSTR [ASCIZ/is disabled. /]
JRST POPJ1
AUTOW3: SETZM TYOPNT
OUTSTR [ASCIZ/threshold is /]
TYPDEC INSMAX
OUTSTR [ASCIZ/ lines. /]
JRST POPJ1
;PPSET IPPSET DPPSET CMDCRL ABCRLF ABCRL3 ABCRL2 ABCRL0
IMPURE
PPSET: 0 ;MAIN, EDIT may dispatch to here, others PUSHJ P,@PPSET
JRST CPOPJ ;TTY
JRST DPPSET ;DD
JRST IPPSET ;III
JRST DPPSET ;DM
PURE
IPPSET: PPSEL
DPYPOS -1400 ;Move regular III page printer off the page
DPPSET: PPSEL 1
DPYSIZ @DPPSIZ ;DPPSIZ contains G=PPSIZ L=1
DPYPOS @DPPPOS
POPJ P,
CMDCRL: SKIPLE CURMAC
POPJ P, ;Expanding macro--don't do anything
IFE DECSW,<
HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
>
IFN DECSW,<
MOVE T,[2,,[.TOWHP ↔ 0]]
TRMOP. T,
MOVEI T,100 ;IF IT FAILS, BE CONSERVATIVE
>
JUMPE T,CPOPJ ;Jump if at left margin
SKIPN DPY ;If not on display, ensure very close to left margin
CAIG T,=10 ;Max horiz position for cmd on non-display
CAILE T,=35 ;Don't let horiz pos get beyond this on a display
OUTSTR [ASCIZ/
/]
POPJ P,
ABCRLF: SKIPN DPY
JRST ABCRL3 ;On non-display, this TTYSET never waits, so do it always
SKIPLE CURMAC
JRST ABCRL2 ;Expanding macro--avoid wait--put out CRLF without checking
ABCRL3:
IFE DECSW,<
HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
>
IFN DECSW,<
MOVE T,[2,,[.TOWHP ↔ 0]]
TRMOP. T,
MOVEI T,100 ;IF IT FAILS, BE CONSERVATIVE
>
JUMPE T,CPOPJ ;Jump if already to left margin
ABCRL2: OUTSTR [ASCIZ/
/]
POPJ P,
ABCRL0: PUSH P,T ;Don't clobber any ACs!
PUSHJ P,ABCRLF
JRST POPTJ
;OCT3ST NUMSTD NUMSTR OCTSTR NUMSIX
;Converts 3 octal digits only into ASCIZ
;Initial value in T, results in C, using A for pointer
OCT3ST: MOVE A,[440700,,C]
MOVEI C,0
MOVEI B,3
IDIVI T,10
HRLM TT,(P)
SOJLE B,.+2
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
;Conversion routine for ASCII and ASCID
;Depends on arg in T fitting in 5 decimal digits, else clobbers something!
NUMSTD: MOVEI C,1 ;This entry used if ASCID is required
MOVE A,[440700,,C] ;and results are left in C
NUMSTR: IDIVI T,=10 ;Converts to decimal ASCII, value in T, ptr in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,NUMSTR
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
OCTSTR: JUMPGE T,.+4
MOVEI TT,55
IDPB TT,A
MOVNS T
IDIVI T,10 ;Represents OCT in ASCII, value in T, pointer in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
NUMSIX: IDIVI T,=10 ;Produces six-bit representation of DEC. value
JUMPE T,.+4
HRLM TT,(P)
PUSHJ P,NUMSIX
HLRZ TT,(P)
ADDI TT,'0'
IDPB TT,A
POPJ P,
;⊗ IDIOT IDIOT0 IDIOTX IDIOT2 SETWRT SETWR0 SETWR2 SETWRX CLEARX CLERX0 BTAB
;Routine to see if we are allowed to write out this file.
;Takes skip return if can write file.
;Only WRPAGI, from UPDATE, enters at IDIOT0.
IDIOT: TRNN F,EDDIR ;Editing directory?
IDIOT0: SKIPE BOOKSW ;Or book mode?
JRST IDIOT2
TRNN F,FILLUZ ;Unformatted file?
JRST IDIOTX ;No, all OK
MOVEI T,1
CAMN T,PAGES ;All OK if file is only one page,
TRNN F,DIROK ; and we have seen all of file
JRST IDIOT2 ;Multipage unformatted file, can't write it
IDIOTX: AOS (P) ;Not idiot, take success return
IFE DECSW,<
JRST PROTL2 ;Tell user if file is write protected
>
IFN DECSW,<
POPJ P,
>
IDIOT2: MOVE T,NCMDS ;see if we've already given warning for this cmd
HRL T,WINSER ;and for this window
CAMN T,IDIOTF ;skip unless already warned
POPJ P,
MOVEM T,IDIOTF# ;remember that we've warned of nonwritable file
PUSHJ P,ABCRLF
MOVEI T,MACSTA ;Address of routine to stop all macros
HRRM T,MACINS ;Make any macros stop for sure
OUTSTR [ASCIZ/*** Warning: Cannot write out text /]
MOVEI T,[ASCIZ⊗on directory page⊗]
SKIPE BOOKSW
MOVEI T,[ASCIZ⊗in BOOKMODE (/B)⊗]
TRNE F,FILLUZ
MOVEI T,[ASCIZ⊗in non-formatted file⊗]
OUTSTR (T)
OUTSTR [ASCIZ/. ***
/]
SETO T,
BEEP T, ;Beep the idiot
POPJ P,
SETWRT: SETZM DELFIL ;File has changed so don't delete it because of ∂.
SKIPN DELFI3 ;skip if want to delete file even after diddling around
PUSHJ P,NOFDEL ;turn off explicit file-delete flag (altering text)
SKIPE G,XPLST
PUSHJ P,RCOMP
TRO F,DSPSCR
TLO F,DSPTRL ;Force recalculation of trailer values
MOVE H,WFLAG
TRON F,WRITE
SKIPLE CURMAC ;If we're in a macro, we'll let him fool with text
JRST SETWR0 ;Flag already on, or in macro, no warning
PUSHJ P,IDIOT ;See if this guy is an idiot--can't write out stuff
JFCL ;Yup, an idiot indeed
SETWR0: TLO H,"W"⊗13
TRNE F,FILLUZ
JRST SETWR2
MOVE T,CHARS
CAMLE T,ROOM
JRST [ TRO F,XPAGE
TLO H,"X"⊗4
JRST SETWR2]
TRZ F,XPAGE
TLZ H,3760
SETWR2: HLRZ T,@ARRLIN
CAIN T,PAGE ;If arrow is at top of incore text,
TLOA T,PMARK ; then must update directory text for this page
HLL T,TXTFLG(T) ;Also must update directory text if
TLNE T,PMARK ; arrow points to line following incore pagemark
TROA F,UPDTXT ;Remember that text of directory line has changed
TRNE F,UPDIR+UPDTXT
TRO H," D"⊗1 ;D on header line means directory needs updating
SETWRX: CAMN H,WFLAG
POPJ P,
MOVEM H,WFLAG
MOVEM H,WFLAG2
MOVE G,SCRTOP
HLLZS DPYTAB(G)
POPJ P,
;Called by APPEND when done--in case X was on before but needn't be now.
CLEARX: PUSHJ P,DSHED ;Put out header line in case added pages
CLERX0: MOVE H,WFLAG
MOVE T,CHARS
CAMLE T,ROOM
POPJ P, ;X must have already been on
TRZ F,XPAGE
TLZ H,3760 ;Turn off "X"
JRST SETWRX
BTAB: 0↔@↔5↔3↔1↔@↔4↔2
;FRD FRD0B FRD0 FRD0A FRD0CR FRDHOM SETDEV FRD2 FRD2A FRD1 NOEXT NOEXT2 NOPRG NOPPN NOPP1 FLHAK9 FRDQR2 NOPP2 SWLOP SWLOP2 FRDX FRDX2 FRDX3 FRDX4 FRDMOR FRDMO2 FRDMOK FRDMLZ NPFRDM
;Read filename and skip on success
;FRDxxx flags used in left half of D in FRD and related file-specification code
;Callers who come here with FRDRUN off should, upon getting error return, either
;call FNERR or SETZM SUPILF to avoid error msg of later call being suppressed.
FRD: TRZ F,FILLUZ ;Assume new file will be okay
FRD0B: SETZM (D) ;Enter here to read additional filenames for list
SETZM EXT1(D)
SETZM DATE2(D)
MOVE T,PPN
MOVEM T,PPN3(D)
MOVSI T,'DSK'
MOVEM T,-1(D) ;Set default device
SETZM -2(D) ;When non-zero used to introduce FF's after # lines
SETZM 4(D)
FRD0: TLZ F,TF1 ;Clear the quote flag. (Set by down-arrow in name.)
TLZ D,FRDALL ;No parts of name seen yet.
;we come back here after seeing device name
FRD0A: PUSHJ P,GETNAM
JUMPN A,FRD2 ;Jump if name given.
JUMPL D,FRD2 ;Jump if from XRUN command looking for program name.
CAIN C,"∂"
JRST FRDMSG ;MSG file name coming.
CAIN C,"\"
JRST FLHACK ;Filehack name coming
TLNE D,FRDADD ;Reading additional filename for list?
JRST FRD2 ;Yes, can neither add ? file nor abort here
CAIE C,"/"
CAIN C,"("
JRST FRDHOM ;Wants to add switches to "home" file
CAIN C,"?"
JRST FRDQRY ;Wants to edit the E manual
CAIN C,15 ;carriage return already?
JRST FRD0CR ;yes
CAIE C,ALTMOD
JRST FRD2 ;Don't abort unless he said ALT
CLRBFI ;Don't leave part of filename in input buffer
SKIPE ZATT ;Is there an ε or λ command to be aborted?
JRST EPSIL4 ;Yes, abort and go back to previous file/window
EXIT ;We haven't edited any files, so abort the easy way.
;Here if see CR at beginning of filename scan
FRD0CR: TLNN D,FRDTMP ;yes, go on if overriding TMPCOR filename
SKIPN ZATT ;else if have edited anything, can't use null name
JRST FRD2 ;first filename -- null is OK, work way to FRDX3
POPJ P, ;error, don't use name of last file edited
FRDHOM: SKIPE ZATT
SKIPGE TT,ZINDEX ;Get index of file we were just in
JRST FRD2 ;Haven't edited anything, no filename to use
JRST SWLOP ;Now parse the switches
SETDEV: MOVEM A,-1(D)
TLO D,FRDDEV
JRST FRD0A
FRD2: CAIN C,":"
JRST SETDEV
JUMPE A,FRD1
TLNE D,FRDTMP
SETZM EXT1(D) ;Clear any extension read from TMPCOR file
TLO D,FRDNAM
FRD2A: MOVEM A,(D)
FRD1: CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM ;(this "<" matches closing bracket on next line)
CAMN A,['> '] ;Want largest numeric extension?
TLO D,FRDGRT ;Yes, flag it
HLLZM A,EXT1(D)
TLO D,FRDEXT
NOEXT: CAIE C,"["
JRST NOPPN
PUSHJ P,GETP
JUMPE A,NOEXT2
HRLM A,PPN3(D)
TLO D,FRDPRJ ;Project seen
NOEXT2: CAIE C,","
JRST NOPRG
PUSHJ P,GETP
JUMPE A,NOPRG
HRRM A,PPN3(D)
TLO D,FRDPRG ;Programmer name found
NOPRG: CAIE C,"]"
JRST NOPPN
PUSHJ P,TYI
JFCL ;used to be JRST FRDX, which didn't initialize flags, page & line.
NOPPN: TLNE D,FRDTMP ;If overriding TMPCOR filename, initialize things
TLNN D,FRDALL ;Any part of name seen?
JRST SWLOP ;No
TLNN D,FRDNAM!FRDPRG!FRDPRJ
JRST NOPP1 ;If only DEV or EXT given, use PPN from TMPCOR
MOVE T,PPN
TLNN D,FRDPRJ ;Any project given?
HLLM T,PPN3(D) ;No, use default
TLNN D,FRDPRG ;Any programmer given?
HRRM T,PPN3(D) ;No, use default
NOPP1: JUMPL D,NOPP2 ;Jump if from EXECUTE command
SETZM RDONLY
FLHAK9: SETOM SLINE ;Clear any values from TMPCOR file
SETOM SPAGE
SETOM SWIND
SETOM SPROT ;No protection change for copying file yet
SETOM SBLOAT ;Assume not bloating file
SETZM NODUPD ;Clear /-U switch to allow directory updating
IFN BOOKMD,<
SETZM BOOKSW
>;END BOOKMD
FRDQR2: TRZ F,FILLUZ
; SETZM CREASW ;Clear /C switch
SETOM NOT1PG ;Not yet trying one-page /N kludge mode
SETZM QUIETF ;Clear /Q switch
SETZM -2(D) ;Clear /F switch
SETZM 4(D) ;Clear /N switch
SETZM BAKPLC ;Clear the page stack
IFN TMPMRK,<
SETZM MARKS
MOVE T,[MARKS,,MARKS+1]
BLT T,MARKS+NMARKS-1 ;Clear the marks array.
>;TMPMRK
NOPP2: MOVSI T,'DSK'
TLNN D,FRDDEV ;Use DSK if no device name seen
MOVEM T,-1(D)
SWLOP: JUMPL D,FRDX3 ;No filename required, no switches allowed for XRUN
SWLOP2: PUSHJ P,SKPSPC ;skip any spaces before switches
CAIN C,"("
JRST SWITL
CAIN C,"/"
JRST SWIT1
FRDX: SKIPN -2(D) ;/F switch given?
JRST FRDX2 ;No
SKIPE RDONLY ;Yes. /R also?
HRLOM D,4(D) ;/R/F implies /N
FRDX2: TLNN D,FRDADD ;Skip if reading an additional filename
SKIPE ZATT ;Skip if we're reading first edit filename
SKIPE (D) ;Did we see a filename?
JRST FRDX3 ;Yes, or no filename required
SKIPL TT,ZINDEX ;Get index of file we were just in, skip if none
TLNE D,FRDALL ;skip if no part of filename seen
POPJ P, ;error, must give primary name of file
;here if no filename specified, probably just switches
SKIPN T,ZDATA-1(TT) ;Get file's device
POPJ P, ;hmm, no filename after all
MOVEM T,-1(D) ;Return it
MOVE T,ZDATA(TT) ;Get filename
MOVEM T,(D)
MOVE T,ZDATA+EXT1(TT) ;Get extension
HLLZM T,EXT1(D)
MOVE T,ZDATA+PPN3(TT) ;Get PPN
MOVEM T,PPN3(D)
TLO D,FRDALL ;Signal all parts of filename seen
FRDX3: CAIE C,15
CAIN C,";"
JRST POPJ1
CAIE C,"←"
CAIN C,"→"
JRST POPJ1
TLNN D,FRDPAR ;filename allowed to end with parens?
JRST FRDX4 ;no
CAIE C,"(" ;yes, does it?
CAIN C,")"
JRST POPJ1 ;yes, ok
FRDX4: CAIN C,"," ;Another filename coming?
JUMPGE D,POPJ1 ;Yes, success unless not reading edit filename(s)
CAIE C,40
CAIN C,11
JRST .+2 ;SKIP SPACES AT END OF NAME
POPJ P,
PUSHJ P,TYI
JRST FRDX3 ;Check again
JRST FRDX3 ;May skip
;Routine to read additional filenames after the first (from tmpcor or tty).
;Skips if no filename syntax error detected.
FRDMOR: PUSH P,RDONLY ;Save some data about edit file while
PUSH P,SPAGE ; we read some more filenames
PUSH P,SLINE
PUSH P,SWIND
PUSH P,SPROT
PUSH P,SBLOAT ;Remember if bloating edit file, don't care about others
PUSH P,NODUPD
FRDMO2: CAIE C,","
JRST FRDMOK ;No more filenames
SETZM RDONLY ;Initialize data for new filename
SETOM SPAGE
SETOM SLINE
SETOM SWIND
SETZM BAKPLC ;No page stack collected yet
SETZM MARKS
MOVE T,[MARKS,,MARKS+1]
BLT T,MARKS+NMARKS-1 ;No marks collected yet
MOVE D,[FRDADD,,ADDFIL] ;Collect additional filename at ADDFIL
PUSHJ P,FRD0B ;Read a filename into ADDFIL
JRST FRDMLZ ;Illegal filename
CAIE C,"←"
CAIN C,"→"
JRST FRDMLZ ;Can't copy additional files -- error return
PUSHJ P,ZSTORE ;Store filename,modes,page,line,page stack,marks
JRST FRDMO2 ;Look for another filename
FRDMOK: AOS -NPFRDM(P) ;Success return
FRDMLZ: POP P,NODUPD
POP P,SBLOAT ;Restore date for edit file
POP P,SPROT
POP P,SWIND
POP P,SLINE
POP P,SPAGE
POP P,RDONLY
NPFRDM←←.-FRDMLZ ;Number of things pushed
POPJ P,
;SWIT1 NOSWIT SWITL FRDQRY FRDMSG FRDMS2 FLHACK HAKPRG DECMSG FLHAKE FLHAKB FLHAKA FLHAK0 FLHAK1 FLHAK5 FLHAK2
SWIT1: PUSHJ P,DOSWIT
NOSWIT: PUSHJ P,TYI
JRST FRDX
JRST SWLOP2
SWIT2: CAIN C,")"
JRST NOSWIT
TLNE T,FSPC
JRST SWLOP2
SWITL: PUSHJ P,DOSWIT
JRST SWIT2
JRST FRDX ;Illegal ALT or CR as switch char. C hold ALT.
;Here with filename of "?", which represents E.ALS[UP,DOC]/2P/5L/R
FRDQRY: PUSHJ P,TYI ;Get next char
JFCL ;(activator)
HLRZ A,ZDATA+ZPAGL+ZSIZE ;Get starting page for ? file
MOVEM A,SPAGE
HRRZ A,ZDATA+ZPAGL+ZSIZE ;Get starting line for ? file
MOVEM A,SLINE
MOVE A,ZDATA+ZSIZE ;Get primary name of ? file
MOVEM A,(D)
HLLZ B,ZDATA+EXT1+ZSIZE ;Get extension
MOVEM B,EXT1(D)
MOVE B,ZDATA+PPN3+ZSIZE ;Get PPN
MOVEM B,PPN3(D)
SETOM RDONLY
SETOM QUERYF
SETZM CREASW
SETOM NOT1PG ;Not trying one-page directoryless kludge
TLO D,FRDAL2 ;Have all parts of filename now, default device
TLNN D,FRDTMP ;Skip if overriding tmpcor defaults
JRST SWLOP
JRST FRDQR2
FRDMSG: PUSHJ P,GETP ;Get programmer name right justified.
JUMPN A,FRDMS2
HRRZ A,RPPN ;Default msg file name--logged in programmer name
FRDMS2:
IFN DECSW,<
PUSHJ P,DECMSG ;Make IRCAM message file name from programmer name
>;DECSW
MOVSI B,'MSG'
MOVEM B,EXT1(D) ;Default msg extension
MOVE B,[MSGPPN]
MOVEM B,PPN3(D) ;Default msg PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
JRST FRD2A
FLHACK: PUSHJ P,FLHAK0 ;Search filehack table
JRST FLHAKE ;No unique match found
;Here when we have found a unique filehack match
MOVE T,HAKDSP-HAKTAB(T) ;Get pointer to filename
SKIPN A,(T)
PUSHJ P,HAKPRG ;Get someone's programmer name
MOVEM A,(D) ;Store file name
MOVE TT,EXT1(T)
HLLZM TT,EXT1(D) ;Extension
TLNE D,FRDTMP ;Are we overriding TMPCOR filename?
SETZM RDONLY ;Yes, initialize this flag
TRNE TT,770000 ;Is the default readonly?
SETOM RDONLY ;Yes
TRNE TT,7700 ;Explicit PPN?
SKIPA TT,2(T) ;Yes, use PPN of filehack
MOVE TT,[MSGPPN] ;No, use message PPN
MOVEM TT,PPN3(D) ;PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
TLNN D,FRDTMP ;Skip if overriding tmpcor defaults
JRST SWLOP
JRST FLHAK9
HAKPRG: HRRZ A,RPPN ;Get our own login programmer name
CAIN C,":" ;Specifying someone else's name?
PUSHJ P,GETP ;Yes, read a programmer name
IFN DECSW,<
DECMSG:
IFN IRCSW,<
TRNE A,770000 ;No reason to use silly IRCAM format
TRO A,400000 ; in the mail file names
>;IRCSW
HRLI A,'***' ;DEC CAN'T LOOK UP A FILE WITH 0 LH
>;DECSW
POPJ P,
FLHAKE: JUMPN B,FLHAKA ;Jump if found any matches (ambiguous)
SORRJ <Unrecognized filehack: >
FLHAKB: PUSHJ P,SIXOUT ;Type sixbit name in A
OUTSTR [ASCIZ/. /]
POPJ P, ;Take failure return from FRD
FLHAKA: JUMPE A,CPOPJ ;Jump if no name given
SORRJ <Ambiguous filehack: >
JRST FLHAKB
;Filehack table searching routine.
;Direct return if not found uniquely in table. B will be non-zero if ambiguous.
;Skips if found. Index in T.
FLHAK0: PUSHJ P,GETNAM ;Get filehack name
HRRI B,FHMASK# ;Change byte pointer address to FHMASK
MOVEI TT,77 ; for making mask
SETZM FHMASK
SKIPA T,[-HAKLEN,,HAKTAB] ;Aobjn pointer to filehack name table
IDPB TT,B ;Generate complemented mask in FHMASK
TLNE B,770000
JRST .-2
MOVEI B,0 ;Used to store pointer to unique name, if found
FLHAK1: CAMN A,(T) ;Exact match?
JRST POPJ1 ;Yes, success return
MOVE TT,FHMASK ;Get mask
ANDCA TT,(T) ;Get corresponding chars of name from table
CAMN A,TT ;Match?
JRST FLHAK2 ;Yes
FLHAK5: AOBJN T,FLHAK1
MOVE T,B ;Get index to any match found
JUMPN T,POPJ1 ;Success return if found unique match
POPJ P, ;Filehack not found
FLHAK2: JUMPN B,CPOPJ ;Jump if ambiguous filehack (possibly null)
MOVE B,T ;Save index of first match
JRST FLHAK5 ;Look for more
;⊗ SIXOUT SIXOU1 $MAIL $DAY $GRIPE $GOLD $BBD $MAINT $NOTIC $NAP $PLAN $DIGES $FORW $NEWS $CSD $AUDIO $HARDW HAKTAB HAKLEN HAKDSP
SIXOUT: MOVE B,A ;Put sixbit name in B
SIXOU1: JUMPE B,CPOPJ
MOVEI A,
LSHC A,6
ADDI A,40
OUTCHR A
JRST SIXOU1
;"R" following extension means readonly is default. See FLHAK6.
;"P" means use explicit PPN. See FLHAK6.
$MAIL: SIXBIT / MSG/
$DAY: SIXBIT /DAY TXTR/
$GRIPE: SIXBIT /GRIPESTXT/
$GOLD: SIXBIT /GRIPESOLD/
$BBD: SIXBIT /BBOARDTXT/
$MAINT: SIXBIT /MAINT TXTR/
$NOTIC: SIXBIT /NOTICETXTR/
$NAP: SIXBIT / NAPR/
$PLAN: SIXBIT / PLNR/
$DIGES: SIXBIT /DIGEST R/
$FORW: SIXBIT /FORWRDTXTRP/ ↔ MAISYS
$NEWS: SIXBIT /NEWS R/
;;$CSD: SIXBIT /CSD BBDRP/ ↔ 'INFCSD'
IFN FTCCRMA,<
$AUDIO: SIXBIT /AUDIO LOGRP/ ↔ ' HDOC'
$HARDW: SIXBIT /MAINT LOGRP/ ↔ ' HDOC'
>;IFN FTCCRMA
DEFINE HACKS
<
IFN FTCCRMA,<
HAKMAC AUDIO,$AUDIO
>;IFN FTCCRMA
HAKMAC BBOARD,$BBD
;; HAKMAC CSD,$CSD
HAKMAC DAY,$DAY
HAKMAC DOWN,$MAINT
HAKMAC DIGEST,$DIGEST
HAKMAC FORWAR,$FORW ;MAIL forwarding file
HAKMAC GRIPES,$GRIPE
HAKMAC G,$GRIPE
HAKMAC GOLD,$GOLD
IFN FTCCRMA,<
HAKMAC HARDWA,$HARDW
>;IFN FTCCRMA
HAKMAC M,$MAIL
HAKMAC MSG,$MAIL
HAKMAC MAIL,$MAIL
HAKMAC NEWS,$NEWS ;NYT NEWS SUMMARY
HAKMAC NOTICE,$NOTICE
HAKMAC NAP,$NAP
HAKMAC NS,$NAP
; HAKMAC OPTION,$OPTION
HAKMAC P,$PLAN ;BECAUSE \PLAN MAKES \P, \PL AMBIGUOUS
HAKMAC PL,$PLAN ;(SHORTER FORMS MUST BE LISTED HERE FIRST)
HAKMAC PLAN,$PLAN
HAKMAC PLN,$PLAN
; HAKMAC RPG,$RPG
>
DEFINE HAKMAC(A,B)
< SIXBIT/A/
>
HAKTAB: HACKS
HAKLEN←←.-HAKTAB
DEFINE HAKMAC(A,B)
< B
>
HAKDSP: HACKS
;GETNAM GETNML GETP GETPL DTYI1 DTYIS DTYI DTYI2
;ACCUMULATE LEFT-ADJUSTED SIXBIT. FROM TTY. TO A.
GETNAM: MOVE B,[440600,,A] ;ACCUMULATE SIXBIT IN A
MOVEI A,0
GETNML: PUSHJ P,DTYI ;GET A CHARACTER
POPJ P, ;SOME SORT OF DELIMITER
SUBI C,40 ;MAKE IT SIXBIT
TLNE B,770000
IDPB C,B ;STUFF SIXBIT UNLESS OVERFLOWING
JRST GETNML ;GATHER MORE
;ACCUMULATE RIGHT ADJUSTED SIXBIT. FROM TTY. TO A.
GETP: MOVEI A, ;ACCUMULATE IN A.
IFE IRCSW,<
GETPL:
>;IFE IRCSW
PUSHJ P,DTYI ;GOBBLE.
POPJ P, ;DELIMITER SEEN
IFN DECSW,<
IFN IRCSW,<
CAIL C,"0" ;IRCAM PPNS, BEST OF BOTH WORLDS
CAILE C,"7"
JRST GETPSX ;THIS ONE IS SIXBIT
>;IRCSW
GETPOL: TRNE A,700000 ;FULL YET?
JRST GETPOC ;YES, SEARCH FOR DELIM
LSH A,3 ;OCTAL CONVERSION
IORI A,-"0"(C)
GETPOC: PUSHJ P,DTYI ;GET NEXT CHAR (NOT AT GETPL FOR IRCSW)
POPJ P,
CAIL C,"0"
CAILE C,"7"
POPJ P, ;A NONDIGIT IS A DELIMITER IT SAYS HERE
JRST GETPOL
>;DECSW
IFE IRCSW-DECSW,< ;THIS CODE FOR SAIL AND IRCAM ONLY
GETPSX: TRNE A,770000 ;FULL YET?
JRST GETPL ;YES. WAIT FOR DELIM
LSH A,6 ;MAKE ROOM
IORI A,-40(C) ;ADD THIS CHARACTER
JRST GETPL ;LOOP
>;IFE IRCSW-DECSW
IFN IRCSW,<
GETPL: PUSHJ P,DTYI
TRZA A,400000
JRST GETPSX
POPJ P,
>;IRCSW
DTYI1: TLCA F,TF1 ;TOGGLE ESCAPE FLAG
DTYIS: JUMPN A,CPOPJ
DTYI: PUSHJ P,TYIU ;READ TTY OR RESCANNED DATA
POPJ P, ;NONE LEFT
CAIN C,"_" ;Quoting a space with underbar?
JRST [MOVEI C,40↔JRST POPJ1] ;Yes
CAIN C,"↓" ;TOGGLE ESCAPE MODE?
JRST DTYI1 ;YES. DO IT
TLNE F,TF1 ;IN ESCAPE MODE?
JRST DTYI2 ;YES. NEARLY ANYTHING GOES.
TLNE T,FSPC ;IS CHARACTER A SPECIAL?
POPJ P, ;YES. RETURN IT
CAIE C,11
CAIN C,40
JRST DTYIS ;IGNORE SPACES AND TABS
DTYI2: CAIGE C,40 ;LEGAL?
TLZ F,TF1 ;NO! CLEAR QUOTE MODE FLAG.
JRST POPJ1 ;RETURN THIS AS LEGAL CHARACTER
;DOSWIT SWABRT DOSWI2 SAMPLC SAMPL2 DOSMRK NTYI NTYIL NTYINF NTYIM NTYICM EDFIL2 SRCFIL DSTFIL NOT1PG
;Store requested switch setting.
;(The following alphabetic switches are not yet used: GTY).
DOSWIT: PUSHJ P,NTYI
JUMPL D,CPOPJ
CAIN C,"W"
MOVEM A,SWIND# ;Starting window
CAIN C,"L"
MOVEM A,SLINE# ;Starting line number
CAIN C,"P"
MOVEM A,SPAGE# ;Starting page
CAIN C,"X"
MOVEM A,SBLOAT# ;Bloating amount
CAIN C,"K"
MOVEM A,SPROT# ;Protection for file from copy
CAIN C,"J"
JUMPG A,[ ;not allowed to set PTY job number, must be lisp job
SETZM PLMODE ;use default mode upon starting/connecting to lisp
PUSHJ P,SOMODS ;set hdr to display subjob output mode
PUSHJ P,JOBCHK ;see if job in A exists and has our PPN
POPJ P, ;didn't match
PUSHJ P,SUBSAV ;set up lisp job number
SETZM LSPWAI ;don't wait for lisp init
POPJ P, ]
CAIN C,"A"
JRST [ SKIPN A
MOVEI A,BRPTHR ;Zero arg gets default auto-burp threshold
JRST STBURP ] ;Set threshold
CAIN C,"U"
HRLM A,NODUPD ;/-U suppresses updating directory
CAIN C,"N"
HRLOM D,4(D)
CAIN C,"H"
JRST HSWTCH ;use name of nth home file for edit filename
CAIN C,"R"
SETCAM A,RDONLY#
CAIN C,"I"
SETCAM A,EINITF ;Force execution of EIN tmpcor file in new file
CAIN C,"S"
JRST SAMPLC ;go to same place in new file as in old
CAIN C,"Z" ;TEMP PAGE,LINE HACK
JRST [ MOVEM A,SPAGE#
MOVEM B,SLINE#
POPJ P,]
IFN TMPMRK,<
CAIN C,"M"
JRST DOSMRK ;Plant a line mark
>;TMPMRK
CAIN C,"E"
JRST [ MOVEM A,SPAGE ;Arg is page number to start at end of.
MOVEI B,MAXARG ;Big line and/or page number.
MOVEM B,SLINE
JUMPN A,CPOPJ
MOVEM B,SPAGE ;No arg means start up at end of last page of file.
POPJ P,]
CAIN C,"O"
JRST [ PUSH P,C
MOVE T,A ;Page number
HRL T,B ;Line number
MOVEI A,-1 ;Prevent match of "page we're going to"
PUSHJ P,BAKSA0 ;Push this line,,page onto the page stack
POP P,C
POPJ P,]
CAIN C,"V"
JRST CVTALS ;specify whether altmodes get converted
CAIN C,"?"
JRST [ PUSH P,E
PUSH P,D
PUSHJ P,ABCRLF
OUTSTR [ASCIZ\File stack (use /nH): (-1)\]
PUSHJ P,HOMTE2 ;type file stack, clobbers A,B,C,D,E,T,TT
JFCL ;cmd routine skips
POP P,D
POP P,E
SETOM SUPILF# ;suppress error msg
JRST SWABRT] ;force error return for another try
CAIE C,15 ;Shouldn't see CR of LF while processing switches
CAIN C,12
SWABRT: MOVEI C,ALTMOD ;Line illegally ended in middle of switch
CAIN C,ALTMOD ;Altmode shouldn't be switch character
JRST POPJ1 ;Pass back an altmode and take error return
TLNE D,FRDADD ;Skip unless this is an additional filename
JRST DOSWI2 ;Don't test for switches not allowed here
CAIN C,"C"
SETCAM A,CREASW#
IFN BOOKMD,<
CAIN C,"B"
SETCAM A,BOOKSW
SKIPE BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY ALSO
>;END BOOKMD
CAIN C,"D" ;Document file
SETCAM A,READSW#
CAIN C,"Q"
SETCAM A,QUIETF#
IFE DECSW,<
CAIN C,"!"
JRST [ MOVSI A,REAPRV!PROPRV!WRTPRV
SETPRV A,
POPJ P,]
>;IFE DECSW
DOSWI2: CAIE C,"F"
POPJ P,
JUMPG A,.+2
MOVEI A,=33 ;Default number of lines/page in /F mode.
HRRZM A,-2(D) ;/F means insert FFs every so many lines.
POPJ P,
;open new file at same place as old one open at.
SAMPLC: SKIPLE ZATT ;have we just created a new window?
JRST SAMPL2 ;yes, get old file's parameters from diff place
MOVE A,ARRL
MOVEM A,SLINE ;make starting line be old arrow line
MOVE A,TOPWIN
MOVEM A,SWIND ;make starting window top same as old
MOVE A,FIRPAG
MOVEM A,SPAGE ;make starting page be old first page in core
POPJ P,
SAMPL2: MOVE A,OLDARL ;get line saved when new window created
MOVEM A,SLINE ;start there
MOVE A,OLDTWN ;similarly for old window's top line
MOVEM A,SWIND
MOVE A,OLDFPG ;and for old first page in core
MOVEM A,SPAGE
POPJ P,
IFN TMPMRK,<
DOSMRK: JUMPG B,.+2
MOVEI B,1 ;Min line number is 1
TRNE A,400000
TLZA B,B ;Min page number is 0
HRL B,A
PUSH P,D
PUSH P,E
MOVE D,B
;; SKIPG MARKS+NMARKS-1 ;Skip if table already full
PUSHJ P,XWRIT0 ;PLANT A MARK (double skips if table full)
JFCL ;success
JFCL ;Do nothing if table full or line already marked
POP P,E
POP P,D
POPJ P,
>;TMPMRK
NTYI: SETZB A,B ;Initialize both switch args
NTYIL: PUSHJ P,TYIU
POPJ P,
TLNN T,NUMF ;Did we get a number?
JRST NTYIM ;No
IMULI A,12 ;Yes, shift previous decimal number left one digit
ADDI A,-"0"(C) ;And add in new digit
JRST NTYIL
NTYINF: CAIE C,"∞" ;Maybe wants large argument
JRST NTYICM ;Nope
MOVEI A,MAXARG ;Give him a very large arg for this switch
PUSHJ P,TYIU
POPJ P, ;May skip, but we don't care
POPJ P,
;- CAUSES NTYI TO CALL ITSELF FOR |NUMBER|. COMMA CAUSES CALL TO SELF FOR Y OF X,Y
NTYIM: JUMPN A,NTYICM ;Can't have minus sign or infinity AFTER a number
CAIE C,"-"
JRST NTYINF ;Check for infinity arg
PUSHJ P,NTYIL ;Read rest of switch
MOVN A,A ;Minus sign makes number negative
JUMPN A,NTYICM
MOVNI A,1 ;Minus sign without a number means -1
NTYICM: CAIE C,","
POPJ P,
PUSH P,A ;, MEANS WE HAVE X OF X,Y IN A. SAVE IT AND GET Y
PUSHJ P,NTYI
MOVE B,A
POP P,A
POPJ P,
IMPURE
0
0
EDFIL2: BLOCK 6
0
0
SRCFIL: BLOCK 5
0
0
DSTFIL: BLOCK 5
NOT1PG: 0 ;Zero when trying one-page free /N feature
PURE
;RSCAN RSCAN0 RSCN0A RSCAN1 RSCAN2 RSCANX RSCAN3 RSCN4D RSCAN4 RSCN4B RSCN4C RSCN4A
;CALLED FROM BEG0. RESCAN TTY.
; RETURNS RSPNT,TYIPNT, AND SYSCMD
; TYIPNT = BYTE pointer TO FILE NAME PORTION OF COMMAND LINE.
; SYSCMD = SIXBIT COMMAND NAME (2 LETTERS) FOR EDITOR COMMANDS
RSCAN:
IFE DECSW,<
RESCAN T ;RESCAN TTY (HERE AT NORMAL START)
>
IFN DECSW,<
MOVEI T,0
RESCAN 1
HRLOI T,377777 ;PRETEND INFINITE COUNT IF ANYTHING
>
JUMPLE T,CPOPJ ;NOTHING THERE?
;Enter HERE FOR DEBUGGER (DON'T DO RESCAN, SET T INFINITE)
RSCAN0: PUSHJ P,RSTYI1 ;READ CHARACTER FROM TTY. UPPER CASE
POPJ P, ;NONE THERE
SOJLE T,CPOPJ ;DECREMENT COUNT. RETURN IF RUN OUT
CAIE C," "
CAIN C,11
JRST RSCAN0 ;IGNORE LEADING BLANKS AND TABS
MOVE A,[440700,,BUF] ;INITIALIZE BYTE pointer
CAIN C,"S"
JRST RSCAN3 ;S OR START COMMAND
MOVEI B,-40(C) ;CONVERT CHARACTER TO SIXBIT
PUSHJ P,RSTYI1 ;GET ANOTHER CHARACTER
POPJ P,
CAIN B,'R'
CAIN C,"E"
JRST RSCN0A
MOVEI TT,RSCAN3+1 ;R OR RUN COMMAND
JRST RSTYI0
RSCN0A: SOJLE T,CPOPJ
SUBI C,40 ;CONVERT TO SIXBIT
DPB B,[60600,,C] ;SAVE FIRST SIXBIT CHARACTER.
PUSHJ P,SYSCCK ;CHECK TWO RIGHT ADUSTED SIXBIT CHRS
JRST RSCAN6 ;CEtv, ETv, EDit, CReate, REad, BOok cmd
RSCAN1:
IFE DECSW,<
TLNN T,-1 ;DON'T UNDERSTAND. COMMAND. FLUSH!
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P, ;IF T bigger than 777777 THEN RETURN NOW!
RSCAN2: SOJG T,RSCAN1 ;read in and ignore rest of faulty command
>
IFN DECSW,<
RSCAN2: CLRBFI ;FLUSH TYPEAHEAD TOO IF BAD COMMAND
>
RSCANX: SETZM SYSCMD
SETZM RSPNT
POPJ P,
;HERE IF SYSTEM START/RUN COMMAND SEEN. READ TO ";" THEN READ FILE NAME.
RSCAN3: JSP TT,RSTYI ;GET NEXT. WE SAW A MONITOR RUN COMMAND
JRST RSCAN2 ;WAS CR
SOJG T,RSCN4D ;WAS ";" READ FILE NAME NEXT
SOJG T,RSCAN3 ;WAS LEGAL, IGNORE IT
POPJ P, ;(RAN OUT OF TEXT)
;HERE TO GOBBLE FILE NAME. STOW IT USING "A" AS A BYTE pointer
RSCN4D: MOVEM A,RSPNT ;pointer TO FIRST BYTE OF FILE NAME.
RSCAN4: JSP TT,RSTYI ;GOBBLE TEXT
JRST RSCAN5 ;CR ENDS SCAN
SOJG T,RSCAN8 ;FLUSH AFTER SEMI-COLON
RSCN4B: IDPB C,A ;STOW TEXT
SOJG T,RSCAN4 ;GOBBLE MORE TEXT
JRST RSCANX ;UNEXPECTED END OF DATA, ACT UNHAPPY
;AT RSCN4A TO FLUSH BLANKS AND TABS BEFORE SCANNING NAMES.
RSCN4C: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN
SOJG T,RSCAN8 ;SEMI-COLON SEEN. FLUSH THE REST. BE HAPPY.
RSCN4A: CAIE C," " ;IGNORE BLANKS AND TABS
CAIN C,11
SOJG T,RSCN4C ;IGNORE BLANKS AND TABS
MOVEM A,RSPNT ;SOME NON-BLANK SEEN
JRST RSCN4B ;SET pointer AND GOBBLE TEXT
;RSCAN5 RSCAN6 RSCAN7 RSCAN8 SYSCCK CRECHK
RSCAN5: IDPB C,A ;CR SEEN. STOW IT
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
JRST RSCANX
SOJLE T,RSCANX ;VARIOUS WAYS TO BE UNHAPPY
CAIE C,12
JRST RSCANX
IDPB C,A ;STOW LF AND NULL
MOVEI C,
IDPB C,A
TLNN T,-1 ;SKIP IF T>777777 (NOT RESCAN)
SOJG T,RSCAN1 ;IF THERE'S MORE, UNHAPPY
MOVE A,[440700,,BUF]
MOVEM A,TYIPNT ;SET UP pointer TO TEXT
POPJ P, ;RETURN HAPPY
;HERE WHEN EDIT COMMAND SEEN.
RSCAN6: LSH C,6 ;MOVE COMMAND TO L.ADJ IN RIGHT HALF
HRLZM C,SYSCMD ;SAVE 6BIT COMMAND LEFT ADJUSTED
RSCAN7: JSP TT,RSTYI ;GOBBLE
JRST RSCAN5 ;END OF TEXT. ACT HAPPY. (E.G., "ET<CR>")
SOJG T,RSCAN8 ;SEMICOLON MEANS COMMENT HERE
CAIL C,"A"
CAILE C,"Z"
JRST RSCN4A ;SOME NON-LETTER SEEN. GOBBLE FILE NAME
SOJG T,RSCAN7 ;FLUSH UNTIL A DELIMITER SEEN
JRST RSCANX
;FLUSH INPUT THROUGH CR. ";" SEEN AFTER FILE NAME SCAN BEGAN.
RSCAN8: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN. BE HAPPY
SOJG T,RSCAN8
SOJG T,RSCAN8
JRST RSCANX
SYSCCK: CAIE C,'ET'
CAIN C,'ED'
POPJ P,
IFN BOOKMD,<
CAIE C,'BO' ;"BOOK" COMMAND LETS YOU READ A BOOK
>;END BOOKMD
CAIN C,'RE'
POPJ P,
CAIN C,'ER' ;EREAD COMMAND MEANS /R MODE
POPJ P,
CRECHK: CAIE C,'CE'
CAIN C,'CR'
POPJ P,
JRST POPJ1
;RSTYI RSTYI0 RSTYI1 UCASE TYI4 POPUP TYICHK TYI5 TYI1 TYI3 TYI6 TYI7 POPCJ CTYI1 CTYI2 CSTYIM CSTYI1
;READ TTY. RETURN CHARACTER IN C.
;RETURN +1 ON CR, +2 ON ";" AND +3 ON OTHERS,
; EXCEPT, NO DATA RETURNS TO RSCANX, ILLEGAL CHAR RETURNS TO RSCAN2
RSTYI: PUSHJ P,RSTYI1
JRST RSCANX
RSTYI0: CAIN C,15
JRST (TT)
CAIN C,";"
JRST 1(TT)
CAIN C,11
JRST 2(TT)
CAIE C,"→"
CAIN C,"↓"
JRST 2(TT)
CAIE C,"∂" ;Legal to mean MSG file
CAIN C,"_" ;Legal to mean quoted space
JRST 2(TT)
CAIE C,"?" ;Legal to mean E.ALS[UP,DOC] file
CAIN C,"∞" ;Legal as arg to switch
JRST 2(TT)
CAIL C,40
TRNE C,600
JRST RSCAN2
JRST 2(TT)
;READ TTY, SKIP RETURN UPPER CASE ONLY IN "C".
RSTYI1: PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P,
AOS (P)
UCASE: CAIGE C,"a"
POPJ P,
CAIG C,"z"
SUBI C,"a"-"A"
POPJ P,
TYI4: ILDB C,TYIPNT
JUMPN C,POPUP
SETZM TYIPNT
SKIPN TYIINS#
JRST POPUP
XCT TYIINS
SETZM TYIINS
POPUP: SUB P,[1,,1] ;Return up a level
POPJ P,
;Routine to check byte pointers for input character.
;Returns up a level with character in C if successful.
TYICHK: SKIPE TYIPNT
JRST TYI4
TYI5: SKIPLE CURMAC ;Macro expansion in progress?
JRST MACCHR ;Yes
POPJ P,
;Below are the only routines authorized to do TTY input,
;except for the EDIT routine. This is because of the EMODE 400s.
;Routine to read a character in line mode.
TYI1: PUSHJ P,TYICHK ;If byte ptr set up, get char and return up a level.
INCHWL C ;Read from TTY.
TYI3: CAIE C,15
JRST TYI6
INCHWL C ;Read the LF following the CR.
XORI C,15≥12 ;Turn LF into CR, maintaining bits.
TYI6: PUSHJ P,SAVCHR
TYI7: PUSH P,C
SNEAKS C, ;Check for a 400 lurking in the shadows.
JRST POPCJ ;Nothing at all lurking.
CAIN C,400
INCHRW C ;Gobble the 400 and discard it.
POPCJ: POP P,C
POPJ P,
;Routine to read a character in character mode.
CTYI1: PUSHJ P,TYICHK ;Check for byte ptr first
CTYI2: INCHRW C ;enter here from YESCHK
JRST TYI3 ;Go check for a CRLF and a following 400.
;Routine to check for macro char or tty char, and skip if got one.
;doesn't read tty's LF after CR
CSTYIM: AOS (P) ;skip if find macro char
PUSHJ P,TYICHK ;check byte ptr and macro for char (returns uplevel)
SOS (P) ;didn't find any, look at tty
;Routine to read a single character and skip if got one. No special action on CR.
CSTYI1: INCHRS C
POPJ P,
AOS (P)
JRST TYI7
;TYI TYIT TYIU GTYI GTYI1 SKIPIN SKPSUB skipil SKIPI2
;Routine to read a character and Skip unless char is an activator
TYI: PUSHJ P,TYI1 ;Read a char
TYIT: TRNE C,600
POPJ P, ;Direct return for activation character.
HLL T,CTAB(C)
TLNN T,LSPC!NSPEC
JRST POPJ1 ;Skip return for normal character.
JUMPE C,TYI
PUSH P,T
MOVN T,CTAB(C) ;Get dispatch displacement for this character.
HRLI T,400000
LSH T,(T)
TLNN T,744000 ;Skip for NULL, RUBOUT, CR, LF, ALTMODE
AOS -1(P) ;Not an activation char.
POP P,T
POPJ P,
TYIU: PUSHJ P,TYI
POPJ P,
TLNE T,LETF
TLNN T,LT2F
JRST POPJ1
SUBI C,40
JRST POPJ1
;General routine to read a char, in line or char mode as indicated by LINFLG.
;In line mode, skips if char is not activator.
GTYI: SKIPE LINFLG ;Skip unless want line mode input
JRST TYI ;read a char in line mode, take skip return if not activator
JRST CTYI1 ;read a char in char mode, never take skip return
;General routine to read a char, in line or char mode as indicated by LINFLG.
GTYI1: SKIPE LINFLG ;Skip unless want line mode input
JRST TYI1 ;read a char in line mode, never take skip return
JRST CTYI1 ;read a char in char mode, never take skip return
;Routine to skip if tty input waiting. Checks for line or char mode
;input as indicated by LINFLG.
SKIPIN: SKIPE LINFLG ;zero means check for char input
JRST SKIPI2
XCT CHRTST ;skip if char already typed (unless XDPYALWAYS)
CAIA
JRST POPJ1 ;char typed, don't update display this time
;no char typed, maybe check for mail from lisp already waiting
;we don't do this display-update-suppress check for line mode because
;line mode doesn't happen much (not from MAIN loop), so display won't be
;getting updated rapidly that way while Lisp is sending cmds to E (which
;it does using macros, during which DISP suppresses any display update.
SKIPE LISPJB ;skip unless connected to lisp job or pty
SKIPLE LMBUSY ;skip if we currently allowed to eat Lisp mail
POPJ P, ;we're gonna have to wait for user (update display now)
TRNN F,ARG!REL ;Don't output CRLF in middle of arg
SKIPGE NOCRLF# ;Skip unless coming from partial-sign cmd, etc.
POPJ P, ;in middle of cmd, don't look for lisp mail
SKPSUB: SKIPE LMBUSY ;skip unless already have subjob text to process
JRST POPJ1 ;already have text, no need to wait, don't update dpy
SKIPL LISPJB ;skip if connected to pty
JRST SKIPIL ;look for mail from lisp
SKIPL LMBUSY ;skip if already have read pty output
PUSHJ P,PTOCHK ;check for pty output waiting already
AOSA (P) ;got some, take skip return to suppress display update
POPJ P,
SETOM PTREAD# ;flag pty output already read, waiting to be processed
POPJ P,
SKIPIL: SKPME ;skip if mail waiting
POPJ P,
JRST POPJ1 ;skip return to indicate we're not going to wait
SKIPI2: XCT LINTST ;skip if line already typed (unless XDPYALWAYS)
SKIPE TYIPNT ;nothing typed, maybe extended cmd line or macro has some
JRST POPJ1 ;typeahead ready
SKIPLE CURMAC ;any macro text left?
JRST POPJ1 ;yes, can use it
POPJ P,
;TMPRED TMPRDY TMPRD1 TMPRD2 TMPRDX RPGRED RPGRD1 BKPRED BKPRD0 BKPLKP BKPRD2 BKPRD1
TMPRED: MOVE T,[1,,['ED '↔-TMPMAX,,TCBUF-1]]
IFN BOOKMD,<
SKIPE BOOKSW ;use different tmpcor filename in /B mode
MOVE T,[1,,['BK '↔-TMPMAX,,TCBUF-1]]
>;END BOOKMD
TMPCOR T, ;SEEK TMPCOR FILE
JRST RPGRED ;NONE. TRY TO READ QQSVED.RPG
TMPRDY: JUMPLE T,CPOPJ ;NO DATA?
CAILE T,TMPMAX ;OVERFLOW?
POPJ P, ;YES. THAT'S TOO MUCH WORK.
SETZM TCBUF(T) ;MAKE SURE WE STOP.
MOVE T,[440700,,TCBUF]
TMPRD1: MOVE G,T ;G←pointer TO BYTE BEFORE THE FIRST REAL CHARACTER.
ILDB C,T ;GET A CHARACTER
CAILE C,40 ;DELIM?
JRST TMPRD2 ;NO. REAL.
JUMPN C,TMPRD1 ;LOOP UNTIL A REAL CHARACTER IS SEEN.
POPJ P, ;BUT IF THERE AREN'T ANY, WE QUIT
TMPRD2: ILDB C,T ;NOW, WE SKIP UNTIL WE SEE SOME REAL STUFF.
CAIG C,40 ;REAL CHARACTER?
JRST TMPRDX ;NO. WE HAVE SKIPPED THE ET OR CET PART.
JUMPN C,TMPRD2 ;WHILE WE'RE STILL IN BUSINESS.
POPJ P, ;OOPS.
TMPRDX: MOVEM T,TYIPNT ;THIS POINTS TO THE ARGUMENT PORTION.
MOVEM T,TCPNT ;(G POINTS TO THE COMMAND NAME)
JRST POPJ1 ;INDICATES WE WON.
RPGRED: MOVE T,[['DSK '↔'QQSVED'↔'RPG '↔0↔0],,LKUP-1]
IFN BOOKMD,<
SKIPE BOOKSW ;LOOK FOR DIFFERENT RPG FILE IN /B MODE
MOVE T,[['DSK '↔'QQBKP '↔'RPG '↔0↔0],,LKUP-1]
>;END BOOKMD
MOVEI C,DSKI
PUSHJ P,OPNDEV ;NOTE THAT OPNDEV SKIPS ON FAILURE
LKPMAC <LOOKUP DSKI,LKUP>
JRST RELDEV
IFN BOOKMD,<
RPGRD1: ;BKPRED (SEE BELOW) ENTERS HERE TO READ .BKP FILE
>;END BOOKMD
INPUT DSKI,[-TMPMAX,,TCBUF-1↔0]
PUSHJ P,RELDEV
MOVS T,LKUP+PPN3
MOVN T,T ;SET UP POSITIVE WORD COUNT
JRST TMPRDY
IFN BOOKMD,<
BKPRED: TLNN D,FRDNAM!FRDEXT!FRDPRJ!FRDPRG ;FILENAME SPECIFIED?
JRST BKPRD0 ;NO, LOOK FOR .BKP FILE
SKIPG SLINE ;YES. /#L OR /#P SPECIFIED?
SKIPLE SPAGE ;
JRST BKPRD1 ;YES. IGNORE .BKP FILE
BKPRD0: MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,LKUP-1]
MOVEI C,DSKI
PUSHJ P,OPNDEV ;OPNDEV skips on failure
SKIPN T,EDFIL ;LOOK FOR .BKP FILE WITH SAME FIRST NAME AS BOOK FILE
JRST BKPRD2 ;RELEASE DSK. (SHOULD NEVER BE HERE)
MOVEM T,LKUP ;USE EDIT FILE'S NAME FOR .BKP FILE
MOVE T,EDFIL+PPN3 ;PICK UP PPN FROM COMMAND
JSP TT,BKPLKP ;LOOKUP .BKP FILE ON PPN GIVEN IN COMMAND
MOVE T,PPN ;NOT FOUND. TRY AGAIN ON USER'S CURRENT AREA
JSP TT,BKPLKP
MOVE T,RPPN ;NOT FOUND. TRY AGAIN ON USER'S LOGGED IN PPN
JSP TT,BKPLKP
JRST BKPRD2 ;NOT FOUND THERE EITHER
BKPLKP: MOVEM T,BKPPPN# ;SAVE PPN OF .BKP FILE
MOVEM T,LKUP+PPN3
LKPMAC <LOOKUP DSKI,LKUP>
JRST (TT) ;DIRECT RETURN ON FAILURE
PUSHJ P,RPGRD1 ;READ IN FILE AND SCAN PAST "ET" PART. RELEASE DSK.
JRST BKPRD1 ;Illegal format, ignore .BKP file
MOVEI D,EDFIL2
PUSHJ P,FRD ;GET FILENAME FROM .BKP FILE
JRST BKPRD1 ;Illegal format, ignore .BKP file
MOVE T,BKPPPN ;GET PPN OF .BKP FILE
TLNN D,FRDPRJ!FRDPRG ;DID .BKP FILE SPECIFY A PPN?
MOVEM T,EDFIL2+PPN3 ;NO. USE .BKP FILE'S PPN FOR ACTUAL BOOK FILE
MOVE T,[EDFIL2-1,,EDFIL-1]
BLT T,EDFIL+5 ;NO. MAKE FILENAME FROM .BKP FILE THE FILE TO EDIT
POPJ P,
BKPRD2: PUSHJ P,RELDEV ;NO .BKP FILE FOUND
SETZM BKPPPN
TLNE D,FRDNAM!FRDEXT!FRDPRJ!FRDPRG ;FILENAME SPECIFIED?
SETOM NEWBKP# ;YES, FLAG TO TELL USER WE WILL CREATE A .BKP FILE
TLNN D,FRDNAM!FRDEXT!FRDPRJ!FRDPRG ;FILENAME SPECIFIED?
BKPRD1: SETZM BKPSW ;NO. DON'T WRITE .BKP FILE
SETZM SUPILF ;avoid future suppressions of filename syntax msg
POPJ P,
>;END BOOKMD
;TMPNFL TMPCR TMPWRT TMPCR2 TMPBKL TMPNOP TMPFLL TMPFOL TMPNFO TMPNHM TMPPGL TMPLMK TMPEND BKPWRT BKPWR1 BKPWR2
TMPNFL←←2 ;Max number of files (besides edit file) listed in tmpcor
;Write TMPCOR file if appropriate.
;Clobbers A,B,C,D,T,TT.
TMPCR: MOVEI TT,'ET ' ;Force writing of tmpcor file hereafter
MOVSM TT,SYSCMD ; as if user had originally given ETV cmd
TMPWRT: SKIPN SYSCMD
POPJ P,
TMPCR2: SETZM TCBUF
MOVE T,[TCBUF,,TCBUF+1]
BLT T,TCBUF+TMPMAX-1
MOVE T,[440700,,TCBUF]
MOVEM T,TYOPNT
TYPCHR "ET"
TYPCHR " "
MOVE D,[FRDDOT,,EDFIL] ;Force output of "."
PUSHJ P,FILSTR ;Output filename including any /N or /F switch
PUSH P,TYOPNT
TYPCHR "("
IFN BOOKMD,<
SKIPE BOOKSW
TYPCHR "B"
>;END BOOKMD
TRNE F,REDNLY
TYPCHR "R"
SKIPL BURPEX ;Is auto burping enabled?
TYPCHR "-A" ;No, remember that
MOVE T,SPAGE ;Starting page
HRL T,SLINE ;Starting line,,starting page
SKIPE PAGE ;If nothing in core, use starting line and page
PUSHJ P,GPAGL ;Get current line,,page
MOVE TT,SWIND ;Starting window
SKIPE PAGE
MOVE TT,TOPWIN ;Starting window if page in core
PUSHJ P,TMPPGL ;Output page, line and window switches
SKIPN BAKPLC ;Skip if anything in page stack
JRST TMPNOP
MOVE TT,BAKMAX ;Size of page stack
CAILE TT,ZBACKL ;Don't output more of page stack than we
MOVEI TT,ZBACKL ; save when switching files
TMPBKL: HRRZ T,BAKPLC-1(TT) ;Get page number from page stack entry
TYPDEC T ;Output page number
TYPCHR ","
HLRZ T,BAKPLC-1(TT) ;Get line number of same entry
TYPDEC T ;Output line number
TYPCHR "O"
SOJG TT,TMPBKL
TMPNOP:
IFN TMPMRK,<
MOVE TT,[-NMARKS,,MARKS] ;Aobjn pointer to line marks
PUSHJ P,TMPLMK ;Output line mark switches
>;TMPMRK
PUSH P,B
MOVEI B,[ ;routine to call for each lisp job
TYPDEC T ;put job number into switch that
TYPCHR "J" ; will remember detached lisp job
POPJ P, ]
PUSHJ P,LSPJCK ;call (B) routine for each detached lisp job
POP P,B
JSP TT,TMPEND ;Insert closing parenthesis for edit file's switches
;We have finished with edit file's filename string and switches.
SKIPN HOMPLC ;Now output top part of file stack
JRST TMPNHM ;No file stack
MOVE C,HOMMAX ;Size of file stack
CAILE C,TMPNFL
MOVEI C,TMPNFL ;This is max number of files we list in tmpcor
TMPFLL: HRRZ T,TYOPNT
CAIL T,TCBUF+TMPMAX-100 ;Make sure there is enough room for another filename
JRST TMPNHM ;Not enough room in buffer
HRRZ D,HOMPLC-1(C) ;Get index of a file from file stack
ADD D,[FRDDOT,,ZDATA] ;Make absolute pointer to filename
TYPCHR "," ;Separate filenames in tmpcor with commas
PUSH P,C
PUSHJ P,FILSTR ;Output name of file
POP P,C
PUSH P,TYOPNT ;Save output byte pointer for TMPEND
TYPCHR "(" ;Switches go in global parentheses
MOVE T,ZFLAGS(D) ;Get flags for this file
TRNE T,REDNLY ;Were we in readonly mode?
TYPCHR "R" ;Yes
MOVS T,ZPAGL(D) ;Get line,,page position in file
HRRE TT,ZFRDWN(D) ;Get window in file
PUSHJ P,TMPPGL ;Output page, line and window switches
MOVEI TT,ZBACK(D) ;Pointer to file's page stack
HRLI TT,-ZBACKL ;Max page stack preserved upon file switching
SKIPE (TT) ;See how much page stack there is
AOBJN TT,.-1 ;Count a page stack entry
ADD TT,[ZBACKL-1,,0] ;Make LH be count of page stack entries to output
JUMPL TT,TMPNFO ;Jump if no page stack
TMPFOL: HRRZ T,-1(TT) ;Get page number from page stack entry
TYPDEC T ;Output page number
TYPCHR ","
HLRZ T,-1(TT) ;Get line number from same entry
TYPDEC T ;Output line number
TYPCHR "O"
SUB TT,[1,,1] ;This is a SOBJN loop
JUMPGE TT,TMPFOL ;Go back for another page stack entry
TMPNFO:
IFN TMPMRK,<
MOVEI TT,ZMARK(D) ;Absolute pointer to line marks
HRLI TT,-NMARKS ;Max number of line marks
PUSHJ P,TMPLMK ;Output line mark switches
>
JSP TT,TMPEND ;Output closing parenthesis
SOJG C,TMPFLL ;Go back for another file stack entry
TMPNHM: TYPCHR "
" ;CRLF at end of tmpcor command string
MOVE T,TYOPNT
TDZA C,C
IDPB C,T ;Fill out to end of word with nulls
TLNE T,760000
JRST .-2
MOVNI TT,-TCBUF+1(T)
MOVSI TT,(TT)
HRRI TT,TCBUF-1
MOVSI T,'ED '
IFN BOOKMD,<
SKIPE BOOKSW ;USE DIFFERENT TMPCOR FILENAME IN /B MODE
MOVSI T,'BK '
>;END BOOKMD
MOVE A,[3,,T]
TMPCOR A, ;Write the tmpcor file
JFCL ;So what if it fails
POPJ P,
;Output page and line switches from line,,page in T.
TMPPGL: PUSH P,TT ;Save window
HRRE TT,T ;Page
JUMPL TT,.+3
TYPDEC TT ;Page number
TYPCHR "P"
HLRE TT,T ;Line
JUMPL TT,.+3
TYPDEC TT ;Line number
TYPCHR "L"
POP P,TT
JUMPL TT,.+3
TYPDEC TT ;Top line of window
TYPCHR "W"
POPJ P,
;Output line mark switches
TMPLMK: SKIPN T,(TT)
POPJ P, ;End of marks list
HLRZ T,T
TYPDEC T ;Page number of a mark
TYPCHR ","
HRRZ T,(TT)
TYPDEC T ;Line number
TYPCHR "M"
AOBJN TT,TMPLMK
POPJ P,
;Output closing parenthesis
TMPEND: LDB T,TYOPNT
TYPCHR ")"
EXCH TT,(P) ;Get original byte pointer, save return address
CAIN T,"("
MOVEM TT,TYOPNT ;We didn't put out any switches, flush parens
POPJ P,
IFN BOOKMD,<
BKPWRT: PUSH P,TT ;SAVE DUMP MODE OUTPUT COMMAND
MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,ENTR-1]
MOVEI C,RPGO
PUSHJ P,OPNDEV ;skips on failure
JRST BKPWR2 ;DSK OPENED
BKPWR1: SUB P,[1,,1] ;CANT OPEN DISK OR CANT ENTER .BKP FILE
JRST RELDEV
BKPWR2: MOVE T,EDFIL ;PICK UP PRIMARY NAME OF FILE BEING EDITED
MOVEM T,ENTR ;AND USE IT FOR .BKP FILE'S PRIMARY NAME
MOVE T,BKPPPN ;REMEMBER WHAT DISK AREA THE .BKP FILE IS TO BE ON
MOVEM T,ENTR+PPN3
ENTER RPGO,ENTR ;MAKE <FILENM>.BKP FILE
JRST BKPWR1
POP P,T ;RETRIEVE DUMP MODE COMMAND
SETZ TT,
OUTPUT RPGO,T
MOVE T,CURPAG
CAME T,PAGES ;ARE WE ON THE LAST PAGE OF THE BOOK?
JRST RELDEV ;NO
CLOSE RPGO, ;YES, DELETE .BKP FILE
SETZM ENTR
MOVE T,BKPPPN
MOVEM T,ENTR+PPN3
RENAME RPGO,ENTR ;HIE THEE AWAY
JFCL
JRST RELDEV
>;END BOOKMD
;FILERR FILTYP FILSTR FILST3 DEVTYO FILST4 DEVPPN PPNTYP PPNTY2 FILETB NFLERS
FILERR: HRRE T,EXT1(D) ;get error code from extension word
CAIGE T,NFLERS
SKIPA TT,FILETB(T)
MOVEI TT,[ASCIZ \Unrecognized LOOKUP/ENTER error: \]
OUTSTR (TT)
SETZM TYOPNT
MOVE A,-1(D)
HLRZ T,TT
JUMPN T,(T)
FILTYP: SETZM TYOPNT
FILSTR: MOVE A,-1(D) ;get device
CAME A,['DSK '] ;Omit device if normal file disk
PUSHJ P,DEVTYO ;Type device name and colon
MOVE A,(D)
PUSHJ P,SIXTYO
HLLZ A,EXT1(D)
TLNN D,FRDDOT ;Skip if want to output extension even if blank
JUMPE A,FILST3
TYPCHR "."
PUSHJ P,SIXTYO
FILST3: PUSHJ P,PPNTYP
JUMPL D,CPOPJ ;Return now if no switches wanted in output
SKIPN -2(D) ;/F mode?
JRST FILST4 ;No.
TYPCHR "/" ;Yes, then can't also be /N mode
TYPDEC -2(D)
TYPCHR "F"
POPJ P,
FILST4: SKIPE 4(D) ;/N mode?
TYPCHR "/N" ;Yup
POPJ P,
DEVTYO: PUSHJ P,SIXTYO ;Type the device name from A
TYPCHR ":" ;Type a colon
POPJ P,
DEVPPN: MOVE A,-1(D) ;Type device if not disk
CAME A,['DSK ']
PUSHJ P,DEVTYO ;Type device name and colon
JRST PPNTY2
PPNTYP: SKIPE A,PPN3(D)
CAMN A,PPN
POPJ P,
PPNTY2: MOVE A,PPN3(D)
TYPCHR "["
IFN IRCSW,<
PUSHJ P,PPNTYO
>;IRCSW
IFE IRCSW,<
HLLZS A
PUSHJ P,PNTYO
TYPCHR ","
HRLZ A,PPN3(D)
PUSHJ P,PNTYO
>;NOT IRCSW
TYPCHR "]"
POPJ P,
SIXTYO,,[ASCIZ /No such device: /] ;-4
SIXTYO,,[ASCIZ /Device must be ASSIGNed: /] ;-3
SIXTYO,,[ASCIZ /Device not disk: /] ;-2
SIXTYO,,[ASCIZ /Device can't be opened: /] ;-1
FILETB: [ASCIZ /File not found: /] ;0
DEVPPN,,[ASCIZ /User area doesn't exist: /] ;1
[ASCIZ /Protection failure: /] ;2
[ASCIZ /File in use: /] ;3
RENEX←←.-FILETB
[ASCIZ /File already exists: /] ;4 (RENAME error)
[ASCIZ /Impossible LOOKUP-ENTER error (5): /] ;5 E error if happens
[ASCIZ /Impossible LOOKUP-ENTER error (6): /] ;6 E error if happens
[ASCIZ /Impossible LOOKUP-ENTER error (7): /] ;7 sys error if happens
[ASCIZ /Bad retrieval: /] ;10
[ASCIZ /Bad retrieval: /] ;11
[ASCIZ /Disk is full: /] ;12
NFLERS←←.-FILETB
;MACTYO SIXTYO SIXTYL SIXTY2 SIXTYN SIXTNL SIXTNN PNTYO PNTYOL PNTOO PNTOOC PNTOOL PPNTST PPNTYO PRGSXT PPNOTY PRGOTY PRGTYO
;Typeout macro name in A, which contains sixbit if LH is nonzero, else
;contains right justified ascii.
MACTYO: TLNE A,-1
JRST SIXTYO ;Just type out sixbit name
TYPCHR (A) ;Just type right half as ascii
MOVEI T,5 ;Assume 1 ascii char, with 5 suppressed spaces
POPJ P,
;Typeout sixbit value in A. Null bytes followed by non-null byte type as "_".
SIXTYO: MOVE B,[440600,,A]
SIXTYL: ILDB C,B
JUMPE C,SIXTYN
SIXTY2: TYPCHR 40(C)
TLNE B,770000
JRST SIXTYL
POPJ P,
SIXTYN: MOVEI T,1
SIXTNL: TLNN B,770000
POPJ P,
ILDB C,B
JUMPN C,SIXTNN
AOJA T,SIXTNL
SIXTNN: TYPCHR "_"
SOJG T,.-1
JRST SIXTY2
IFE IRCSW-DECSW,<
PNTYO: JUMPE A,CPOPJ
MOVE B,[440600,,A]
ILDB C,B
JUMPE C,.-1
PNTYOL: JUMPN C,.+2
MOVEI C,"_"-40
TYPCHR 40(C)
TLNN B,500000
POPJ P,
ILDB C,B
JRST PNTYOL
>;CODE FOR IRCAM AND SAIL BUT NOT DEC
IFN DECSW,<
IFE IRCSW,<PNTYO:>
PNTOO: JUMPE A,CPOPJ
HRRI A,400000 ;FOR END TEST
PNTOOC: MOVEI B,0
ROTC A,3
JUMPE B,PNTOOC
PNTOOL: TYPCHR "0"(B)
MOVEI B,0
ROTC A,3
JUMPN A,PNTOOL
POPJ P,
>;DECSW
IFN IRCSW,<
PPNTST: TLNE A,777740
TRNN A,777740
POPJ P, ;OCTAL PPN
TLNN A,77
POPJ P, ;OLD OCTAL PPN
TLNE A,770000
TLO A,400000 ;CONVERT SIXBIT PPN TO REAL SIXBIT
TRNE A,770000
TRO A,400000
JRST POPJ1
PPNTYO: PUSHJ P,PPNTST
JRST PPNOTY ;OCTAL PPN
PUSH P,A
HLLZS A
PUSHJ P,PNTYO
TYPCHR ","
POP P,A
PRGSXT: HRLZS A
JRST PNTYO
PPNOTY: PUSH P,A
HLLZS A
PUSHJ P,PNTOO
TYPCHR ","
POP P,A
PRGOTY: HRLZS A
JRST PNTOO
PRGTYO: PUSHJ P,PPNTST
JRST PRGOTY
JRST PRGSXT
>;IRCSW
;UUOH UUODSP UFCE UTYPCH UTYPC2 UTYPDE UTYPOC
UUOH: PUSH P,T
LDB T,[331100,,40]
CAIG T,NUUOS
SKIPGE T,UUODSP(T)
PUSHJ P,TELLZ
EXCH T,(P)
POPJ P,
UUODSP: -1
UUOS<,U!X
>
UFCE: HRRZ T,40
CAIN T,T
SKIPA T,-1(P)
MOVE T,(T)
POPJ P,
UTYPCH: EXCH T,40
ROT T,-7
TRNE T,177
PUSHJ P,UTYPC2
ROT T,7
PUSHJ P,UTYPC2
MOVE T,40
POPJ P,
UTYPC2: SKIPE TYOADR# ;Allows us to call a subroutine for each char
JRST @TYOADR
SKIPN TYOPNT
OUTCHR T
SKIPE TYOPNT
IDPB T,TYOPNT#
POPJ P,
UTYPDE: PUSHJ P,UTYPR
POPJ P,12
UTYPOC: PUSHJ P,UTYPR
POPJ P,10
;UTYPR UTYPR0 UTYPR1 UTYPRT UTYPSI UTYPMA USORRF USORRY USORR2 USHORT USHOR2 USHOR3 USORRX USORRJ USORR0 USORR1 POPTJ1 USORRQ
UTYPR: PUSH P,T
HRRZ T,@-1(P)
MOVEM T,RADIX#
PUSHJ P,UFCE
JUMPGE T,UTYPR0
MOVM T,T
PUSH P,T
MOVEI T,"-"
PUSHJ P,UTYPC2 ;type one char from T
POP P,T
UTYPR0: PUSHJ P,UTYPR1
POP P,T
POPJ P,
UTYPR1: PUSH P,TT
IDIV T,RADIX
JUMPE T,.+2
PUSHJ P,UTYPR1
MOVEI T,"0"(TT)
PUSHJ P,UTYPC2
POP P,TT
POPJ P,
;Here to type out a decimal number in T. Preserves all ACs but T.
UTYPRT: PUSH P,TT
IDIVI T,=10
JUMPE T,.+2
PUSHJ P,UTYPRT
MOVEI T,"0"(TT)
OUTCHR T
POP P,TT
POPJ P,
UTYPSI: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,T
PUSHJ P,UFCE ;Get sixbit arg
MOVE A,T ;Sixbit arg
PUSHJ P,SIXTYO ;Output sixbit word, suppressing final spaces
POP P,T
JRST PPCBAJ ;Restore C,B,A and POPJ
UTYPMA: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,T
PUSHJ P,UFCE ;Get sixbit arg
MOVE A,T ;Sixbit arg
PUSHJ P,MACTYO ;Output macro name, suppressing final spaces
POP P,T
JRST PPCBAJ ;Restore C,B,A and POPJ
USORRF: PUSH P,T
MOVEI T,MACSTA ;Address of routine to stop all macros
HRRM T,MACINS ;Make macros stop for sure
POP P,T
JRST USORR2 ;Now output error message
USORRY: PUSHJ P,USORR0 ;Skips unless suppressing error msgs inside macro
POPJ P, ;Suppress error message
USORR2: PUSHJ P,ABCRL0 ;Get to left margin, preserving ACs
OUTSTR [ASCIZ /Sorry -- /]
SKIPE SHTSTP ;Was a search stopped short?
PUSHJ P,USHORT ;Yes, say so and clear flag
OUTSTR @40
OUTSTR [ASCIZ / /]
POPJ P,
USHORT: PUSH P,T
MOVEI T,0
EXCH T,SHTSTP ;Clear flag, get page,,0 or 0,,line where stopped
TLNN T,-1
JRST USHOR2 ;Stopped at line
OUTSTR [ASCIZ /Before page /]
HLRZ T,T
JRST USHOR3
USHOR2: OUTSTR [ASCIZ /Before incore line /]
USHOR3: PUSHJ P,UTYPRT ;Type decimal number
OUTSTR [ASCIZ / -- /]
JRST POPTJ
USORRX: PUSHJ P,USORR0 ;Skips unless suppressing error msgs inside macro
POPJ P, ;Suppress error message
AOS (P) ;This user UUO skips when not suppressing msg
JRST USORR2 ;Output error msg
USORRJ: PUSHJ P,USORR0 ;Skips unless suppressing error msgs inside macro
JRST POPUP ;Suppress error message and pop up a level
JRST USORR2 ;Output error msg
USORR0: PUSHJ P,MACSTP ;Probably terminate macro expansion
USORR1: SKIPE CURMAC ;Are (were) we inside a macro?
SKIPG SILENC# ;And suppressing "sorry" msgs?
JRST POPJ1 ;No
PUSH P,T ;Yes, but see if this error will stop all macros
SKIPN T,STPADR ;Any macro action on error?
JRST USORRQ ;No, suppress msg
TRNE T,-1 ;Stop all macros?
JRST POPTJ1 ;Yes, output error message
MOVE T,CURMAC ;No, but maybe there's only one macro to stop
CAIN T,1 ;Suppress msg unless only one macro in progress
POPTJ1: AOSA -1(P) ;Don't suppress msg
USORRQ: SETZM SHTSTP ;Suppressing message, clear short stop search flag
JRST POPTJ
;TELL0 TELL1 TELL2 TELL3 TELL4 TELL5 TELL6 TELL7 TELL8 TELL9 TELLD TELLZ TELLO NOCORE SAVHIM TELLX UFATAL UFATAX PANIC TELLX2 TELLX3
;To replace former JRST 4,. 's in dispatch tables by PUSHJ P,TELL#
TELL0: PUSHJ P,TELLX
ASCIZ /NUL character in text/
TELL1: PUSHJ P,TELLX
ASCIZ /RUBOUT character in text/
TELL2: PUSHJ P,TELLX
ASCIZ /CR out of place/
TELL3: PUSHJ P,TELLX
ASCIZ /LF out of place/
TELL4: PUSHJ P,TELLX
ASCIZ /TAB out of place/
TELL5: PUSHJ P,TELLX
ASCIZ /FF out of place/
TELL6: PUSHJ P,TELLX
ASCIZ /ALT MODE in text/
TELL7: PUSHJ P,TELLX
ASCIZ /Unexpected non-special character/
TELL8: PUSHJ P,TELLX
ASCIZ /Unexpected ; or ⊗/
TELL9: PUSHJ P,TELLX
ASCIZ /Unexpected digit/
TELLD: PUSHJ P,TELLX ;Used on page 99 and following
ASCIZ /DIRECTORY trouble/
TELLZ: PUSHJ P,TELLX
ASCIZ /Unknown error/
TELLO: PUSHJ P,SAVHIM ;No error report, just save user text in file
ASCIZ /
File was changed by someone while you had it closed.
Incore data about file is invalid. Cannot continue.
/
;Here if can't core up.
NOCORE: PUSHJ P,SAVHIM ;No error report, just save user text in file
ASCIZ\
*** Can't get enough additional core to continue! ***
Maybe you should use the /F switch (or /F/R) to break up large pages, thus
allowing E to run in a smaller amount of core. See E.ALS[UP,DOC]/20P.
(Or maybe you have too many windows open with too much text.)
\
SAVHIM: PPSEL 0 ;Normalize page printer
OUTSTR @(P) ;Type error message
SUB P,[1,,1] ;Flush error message address
PUSH P,[UFATAX]
POP P,PANIC ;Fake out return address to simulate JSR
JRST TELLX3 ;Save incore text, but don't call FBI
TELLX: POP P,40 ;Get address of error message into location 40
UFATAL: JSR PANIC
UFATAX: JRST 4,. ;Stop until I know what to do
IMPURE
PANIC: 0
JRST TELLX2
PURE
TELLX2: PUSH P,40 ;FBI clobbers 40
POP P,CRASH2#
SETOM TELFL2#
PUSHJ P,FBI
PPSEL 0
OUTSTR [ASCIZ /
A fatal error has been detected and reported: /]
OUTSTR @CRASH2#
OUTSTR [ASCIZ/
/]
SKIPE CRASH#
JRST 2,@PANIC ;Don't recur through here
SKIPE DIRERR# ;Skip unless we found error in directory
OUTSTR [ASCIZ/Possibly some text has been garbaged on or near the current
page. You should copy this file and make sure that all the text
is okay. Then you should reformat the file to force generation
of a new directory, since the current one seems to be wrong.
/]
TELLX3: SETOM CRASH#
OUTSTR [ASCIZ/Trying to save your text in an emergency file...
/]
MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE 17,SAVEAC+17
PUSHJ P,SAVE0 ;Try to save user's text in emergency file
PUSHJ P,REEDET ;detach any PTY subjobs
MOVSI 17,SAVEAC
BLT 17,17 ;Restore ACs
JRST 2,@PANIC
;⊗ SETCHN OPENI OPNOI IOPEN SETI SETI2 SETRLD SETI1 SETI0 %OPEN %RELS %LKUP %IN %SETI %STAT %CSTAT %MTAPE %MTAP2 %BSETI %BIN %OFFS %OFFG %%OFFS %%OFFG HIDDEN OPNBLK IBFPNT LKUP OPNDEV OPNDOK OPNDL4 OPNDL3 OPNDL2 OPNDL1 OPNDL0 OPNDLZ RELDEV OPNLUZ DECLKP DECLK1 DECLK2 DECLK6 DECLK7 DECLK8 DECLK9 DECLKB
SETCHN: DPB C,[270400,,%LKUP]
DPB C,[270400,,%IN]
DPB C,[270400,,%SETI]
DPB C,[270400,,%STAT]
IFE DECSW,<
DPB C,[270400,,%MTAPE] ;MTAPE to read group access bit and UFD protection
DPB C,[270400,,%MTAP2] ;MTAPE to get last writter
>
IFN FTHID,<
DPB C,[270400,,%OFFS]
DPB C,[270400,,%OFFG]
>
IFN FTBUF,<
DPB C,[270400,,%BSETI]
DPB C,[270400,,%BIN]
>
MOVEM C,ICHN#
MOVE T,[JRST WRBF3] ;For channel DSKI don't set IBLK when setting OBLK
CAIE C,DSKI
MOVE T,[MOVE T,OBLK] ;For channel DSKO, IBLK must be set to OBLK-1
MOVEM T,XSETO#
MOVEI T,(C)
XORI T,DSKI≥DSKO
DPB T,[270400,,%RELS]
XCT %RELS ;release other channel
SETZM JOBJDA(T) ;Don't let OPNDEV think this channel is open!
IFN FTBUF,<
PUSHJ P,CACRLT ;Release cache from channel released
>
POPJ P,
;Note possible skip return
OPENI: MOVEI C,DSKI
TLZA F,ENTRD
OPNOI: MOVEI C,DSKO
PUSHJ P,SETCHN ;Put channel into I/O UUOs XCTed
IOPEN: MOVSI T,-1(D)
HRRI T,LKUP-1
PUSHJ P,OPNDEV ;skips on failure, with error in LOOKUP block
LKPMAC <XCT %LKUP>
POPJ P,
IFN FTHID,<
XCT %OFFG ;Get file offset
SOS HIDDEN ;Normalize offset--zero now means dir not hidden
>
SETZM IBLK
MOVS T,LKUP+PPN3
MOVNM T,FILWC
ASH T,-7
MOVNM T,FILLEN
IFE DATOK,<
HLLZ T,LKUP+2
TLZ T,37
; IOR T,DATBLK ;MUST FIX ****** FOR ACCTIM NOT DSKTIM
MOVEM T,DATE2(D)
LDB T,[POINT 12,DATBLK,17] ;Get 12 low ordeer bits of date
DPB T,[POINT 12,DATE2(D),35]
LDB T,[POINT 11,DATBLK,35] ;Now the time in minutes
DPB T,[POINT 11,DATE2(D),23]
HRRZ T,LKUP+EXT1
HRRM T,EXT1(D)
LDB T,[POINT 3,DATBLK,5] ;But don't forget the 3 high order bits
DPB T,[POINT 3,EXT1(D),20]
>;IFE DATOK
IFN DATOK,<
HRRZ T,LKUP+EXT1
HRRM T,EXT1(D)
MOVE T,LKUP+DATE2
MOVEM T,DATE2(D)
>;DATOK
AOS (P)
SETI: TRZ F,EOF
MOVE T,IBLK
CAIN T,-1(A)
JRST SETI2
HRRZM A,IBLK
SOS IBLK
XCT %SETI
SETI2: HLLZ T,A
ROT T,7
ADD T,IBFPNT
MOVEM T,NEWPNT#
SETRLD: MOVE T,[440700,,IBFE]
HRRZM T,ABFEND ;SET UP ADDRESS OF THE END OF THE BUFFER.
MOVEM T,INPNT#
POPJ P,
SETI1: MOVEI A,1 ;Want to start reading at record 1
SETI0:
IFE DECSW,<
MOVEI T,DSKI
SHOWIT T, ;Turn on wholine filestatus while copying
>;NOT DECSW
IFN DECSW,<
SHOWIT DSKI, ;Someday maybe we'll get it together
JFCL
>;DECSW
JRST SETI
IMPURE
%OPEN: OPEN OPNBLK
%RELS: RELEAS
%LKUP: LOOKUP LKUP
%IN: IN [-200,,IBUF-1↔0]
%SETI: USETI (A)
%STAT: GETSTS C
%CSTAT: CHNSTS TT
IFE DECSW,<
%MTAPE: MTAPE PROGRP ;UUO to read group access bits and UFD protection
%MTAP2: MTAPE ['GODMOD'↔14↔IOWD DQINFB+2,WRTTEN] ;find out last writer of file
>
IFN FTBUF,<
%BSETI: USETI @CACMIN
%BIN: IN [IOWD NBUFS*200,CACHE0↔0] ;Command to fill up whole cache
>
IFN FTHID,<
%OFFS: MTAPE %%OFFS
%OFFG: MTAPE %%OFFG
%%OFFS: SIXBIT/GODMOD/
21 ;Set disk record offset
0
%%OFFG: SIXBIT/GODMOD/
20 ;Get disk record offset
HIDDEN: 0 ;Record offset goes here (SOSed after the UUO)
0 ;Thus HIDDEN is zero if dir not hidden
>;FTHID
OPNBLK: DMPMOD!PHUSET!GARBIT↔0↔0 ;Make USETs use physical record numbers
IBFPNT: 440700,,IBUF
0 ;/F switch cell (just in case)
0 ;Device name goes here
LKUP: BLOCK 4
0 ;/N switch cell (for FILERR)
PURE
;BLT filename into LOOKUP or ENTER block and then OPEN channel unless already open.
;Skips on failure, with error returned in LOOKUP/ENTER block.
OPNDEV: MOVE TT,T
BLT TT,PPN3+1(T)
IFN DECSW,<
IFN DATOK,<
HLLZS EXT1+1(T) ;Zero the creation date in case this is an ENTER
HLLZ TT,DATE2+1(T) ;Preserve the protection and mode
TLZ TT,37 ; but zero the date/time written
MOVEM TT,DATE2+1(T) ; in case this is an ENTER
>;DATOK
>;DECSW
CAMLE C,JOBHCU
JRST .+3
SKIPGE JOBJDA(C)
POPJ P,
DPB C,[270400,,%CSTAT]
XCT %CSTAT
TRNE TT,400000
POPJ P,
DPB C,[270400,,%OPEN]
IFN FTBUF,<
CAMN C,CACCHN ;Cache better not have this channel claimed
PUSHJ P,TELLZ
>;FTBUF
MOVE TT,(T) ;get device name
MOVEM TT,OPNBLK+1 ;store in OPEN block
DEVCHR TT, ;check device characteristics
TLNN TT,-1 ;skip if any device chars (e.g., can do I/O)
JRST OPNDL4 ;give error code -4, no such device
TLNN TT,DVDSK ;skip if disk
JRST OPNDL2 ;give error code -2, not disk
TLNN TT,DVUDP ;skip if new style UDP
JRST OPNDOK ;doesn't need to be ASSIGNed
MOVE TT,OPNBLK+1 ;get device name again
DEVUSE TT, ;see if UDP has been assigned
TLNN TT,600000 ;skip if assigned or INITed somewhere
JRST OPNDL3 ;give error code -3, must ASSIGN device
OPNDOK: XCT %OPEN
JRST OPNDL1 ;give error code -1, OPEN failed
; JRST [HLLOS EXT1+1(T)↔JRST POPJ1] ;return error of -1 for OPEN failed
POPJ P,
OPNDL4: JSP TT,OPNDL0
OPNDL3: JSP TT,OPNDL0
OPNDL2: JSP TT,OPNDL0
OPNDL1: JSP TT,OPNDL0
OPNDL0: SUBI TT,.+1 ;calculate negative error code in TT
OPNDLZ: HRRM TT,EXT1+1(T) ;store negative error code
AOS (P) ;take skip return for error in OPNDEV
RELDEV: DPB C,[270400,,%RELS]
XCT %RELS
SETZM JOBJDA(C)
IFN FTBUF,<
PUSHJ P,CACRLC ;Release cache from channel released
>;FTBUF
POPJ P,
OPNLUZ: PUSH P,A
MOVE D,[FRDRUN,,LKUP] ;For typing filename and error without any switches
PUSHJ P,FPAUSE
OUTSTR [ASCIZ /LOOKUP./]
MOVEI D,EDFIL
POP P,A
SOS (P)
JRST IOPEN
IFN DECSW,<
DECLKP: PUSH P,A
PUSH P,B
AOS -2(P) ;POINTS TO THE LOOKUP OR XCT
SKIPA A,@-2(P) ;GET THE INSTRUCTION
DECLK1: MOVE A,@A ;GET ANOTHER ONE
LDB B,[POINT 9,A,8] ;GET THE OPCODE
CAIN B,256 ;XCT?
JRST DECLK1 ;YES, FIND THE REAL LOOKUP
PUSHJ P,DECLK7 ;GOT THE LOOKUP, NOW GET THE ARGS
MOVEM B,DECLKB+2 ;FILENAME
ADDI A,1 ;BE CONSERVATIVE IN CASE OF LOOKUP (X)
PUSHJ P,DECLK7
MOVEM B,DECLKB+3 ;EXT
MOVEI B,@A ;ADDR OF EXT
MOVEM B,DECLK9 ;SAVE FOR RESTORING RESULTS LATER
ADDI A,2
PUSHJ P,DECLK7
MOVEM B,DECLKB+1 ;PPN
TLZ A,37 ;FLUSH @ AND XR
HRRI A,DECLKB
AOS -2(P) ;SKIP OVER THE LOOKUP
XCT A ;DO OUR LOOKUP
JRST DECLK2 ;FAILED
AOS -2(P) ;TAKE SKIP RETURN
MOVE B,DECLKB+3 ;GIVE BACK THE DATES AND SO ON
PUSHJ P,DECLK6
MOVE B,DECLKB+4
PUSHJ P,DECLK6
MOVN B,DECLKB+5 ;FIX UP THE SAIL-STYLE LENGTH
MOVS B,B
PUSHJ P,DECLK6
DECLK2: POP P,B
POP P,A
POPJ P,
DECLK6: PUSH P,B ;DATUM TO RETURN ONTO PDL
MOVE A,-3(P) ;RESTORE ACS
MOVE B,-2(P)
POP P,@DECLK9 ;RESTORE, MAYBE INTO AN AC
MOVEM A,-2(P)
MOVEM B,-1(P)
AOS DECLK9 ;PREPARE FOR NEXT RESTORE
POPJ P,
DECLK7: MOVEM A,DECLK8 ;SAVE ADDR FROM A
MOVE B,-1(P) ;JUST IN CASE LOOKUP ARGS ARE IN ACS
MOVE A,-2(P)
MOVE B,@DECLK8 ;GET THE DATUM
MOVE A,DECLK8 ;RESTORE A
POPJ P,
IMPURE
DECLK8: 0
DECLK9: 0
DECLKB: 26 ;DEC-STYLE EXTENDED LOOKUP BLOCK
BLOCK 26
PURE
>;DECSW
;RLD RLD1 RLD2 RLDX RLDLUZ FIXEOF FIXEF1 ENTLUZ ENTL2
;HERE IF WE FOUND A RUBOUT IN THE INPUT FILE.
;USUALLY THIS MEANS WE'RE AT END OF RECORD, BUT IT MAY HAVE BEEN
;A RUBOUT FROM THE FILE ITSELF.
;CALLING SEQUENCE IS:
; ILDB C,BADR
; SKIPG CTAB(C)
; XCT @CTAB(C) ;SUBJECT INSTRUCTION IS: PUSHJ P,RLD
RLD: MOVE C,(P) ;CALLER'S ADDRESS.
HRRZ C,@-3(C) ;ADDRESS PART OF BYTE pointer
CAME C,ABFEND# ;IS THIS THE LAST WORD OF THE BUFFER?
JRST [AOS RLDRUB#↔POP P,C↔JRST -3(C)]
;NO. WAS RUBOUT FROM FILE. RETURN AND IGNORE.
IFN FTBUF,<
PUSHJ P,BIN ;Get a record of input from the cache if possible
>
XCT %IN ;TIME TO READ MORE. (IN UUO)
RLD1: AOSA C,IBLK ;COUNT A BLOCK READ
JRST RLDLUZ ;HERE WE HAVE EOF OR ERROR (IN UUO SKIPPED)
CAMN C,TSTBLK# ;Did extended search cause us to move to new page?
PUSHJ P,@TSTSET# ;Yes, this block contains the found search string
RLD2: MOVE C,IBFPNT
EXCH C,NEWPNT ;FANCY NEW pointer WILL NEXT TIME BE NORMAL
RLDX: EXCH C,(P) ;STORE pointer SO
POP P,@-3(C) ;THE POP CLOBBERS THROUGH THE ILDB
JRST -3(C) ;RETURN TO THE ILDB
RLDLUZ: XCT %STAT ;GET STATUS (INTO C)
TRNN C,20000 ;EOF?
PUSHJ P,TELLZ ;NO. BARF. SOME REAL ERROR
MOVE C,IBLK ;GET THE NUMBER OF SUCCESSFULLY READ BLOCKS
LSH C,7 ;LAST SUCCESSFULLY READ WORD
CAMGE C,FILWC ;BIGGER THAN FILE WORD COUNT?
JRST FIXEOF ;NO. WE HAVE JUST READ A PARTIAL BUFFER.
TRNN F,REDNLY ;Don't clear /F mode count in /R mode.
SETZM EDFIL-2 ;No longer in /F mode, so clear
TROE F,EOF ;SET FLAG FOR EOF
JRST RLD2 ;WE WERE THROUGH HERE BEFORE.
MOVE C,[BYTE (7)14] ;PUT FF WHERE WE'LL SEE IT
MOVEM C,IBUF
MOVEI C,1 ;NOW ARRANGE FOR SOME RUB OUTS
JRST FIXEF1
FIXEOF: SUB C,FILWC
MOVN C,C
FIXEF1: PUSH P,IBFE
POP P,IBUF(C)
MOVEI C,IBUF(C)
MOVEM C,ABFEND ;SET END OF BUFFER'S ADDRESS
JRST RLD1
;Here when any ENTER lost.
ENTLUZ: MOVEI C,DSKO
PUSHJ P,RELDEV ;Release output device
SKIPGE (P) ;Skip unless ENTER lost while creating file
JRST ENTLUN ;ENTER lost during create, type msg and abort
PUSH P,A
PUSH P,D
MOVE D,[FRDRUN,,ENTR]
PUSHJ P,FPAUSE ;Tell user we lost and why, wait for CONTINUE cmd
OUTSTR [ASCIZ /ENTER./]
PUSHJ P,REOPEN ;Re-open input on output channel if appropriate
PUSHJ P,TELLO ;Oop, file has changed since we were last in it!!
REPEAT 0,<
MOVE T,ICHN
CAIE T,DSKO
JRST ENTL2
MOVE A,IBLK
MOVEI D,EDFIL
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
ENTL2:
>
POP P,D
POP P,A
MOVEI E,EDFIL
JRST OPENO
;⊗ EXTCHK EXTCHG EXTCH0 EXTCH1 EXTCH2 EXTRE2 EXTCH3 EXTRED EXTGRT EXTGRD EXTGR3 EXTGR2 EXTCH4 EXTTAB DEXTAB DOCS DOCS1 NDOCS GETDOC GETDO2 GETDO8 GETDO3 GETDO9 GETDOE GETDO4 GETDO5 GETDO7 GETDO6 EXTOPN CHKGRT GETGRX GETGRT INCG01 INCG02 INCGR1 INCGR2 INCGR3 INCGRX
;Enter here to look for file with best extension and right primary name.
EXTCHK: SETZM EXTDSP# ;Normal dispatch at EXTCH2
MOVEI E,SRCFIL ;Look for match of source file name
MOVE T,(E)
TLNE T,FRDGRT ;Don't look for any non-numeric extensions
JRST POPJ1 ; if greater-than sign specified.
EXTCHG: MOVE T,@PPN3(E) ;Enter here from GETGRT, get PPN to search
SETOM EXTIGN# ;no special extension to ignore
EXTCH0: MOVEM T,OBUF ;Enter here from GETDOC to search some DOC UFD
MOVSI T,'UFD'
MOVEM T,OBUF+1
IFE DECSW,<
MOVE T,['1 1']
>
IFN DECSW,<
MOVEI T,16 ;LET'S DO IT RIGHT
GETTAB T,
MOVE T,[1,,1] ;WELL I TRIED
>
MOVEM T,OBUF+PPN3
MOVE T,(E) ;Get filename bits
TLNN T,FRDGRT ;Ignore explicit extension if greater-than-sign
TLNN T,FRDEXT ;Don't do this if explicit extension typed.
LKPMAC <LOOKUP DSKI,OBUF>
JRST POPJ1
IFN FTBUF,<
SETZM IBLK ;Initialize record number for cacheing UFD input
MOVS T,OBUF+PPN3
MOVNM T,FILWC
ASH T,-7
MOVNM T,FILLEN
>;FTBUF
MOVNS T,OBUF+PPN3
MOVE B,@(E) ;Get primary filename to match
MOVEI C,-1 ;Very bad (high number) "best priority" found so far
EXTCH1: MOVN T,OBUF+PPN3
JUMPGE T,EXTCH4
CAMGE T,[-200,,]
MOVSI T,-200
ADDM T,OBUF+PPN3
HRRI T,IBUF-1
MOVE A,T
MOVEI TT,
IFN FTBUF,<
PUSHJ P,BIN ;Get input record from cache if possible
> ;Should never double skip
INPUT DSKI,T
IFN FTBUF,<
AOS IBLK ;Keep track of how much we've read for BIN
>
EXTCH2: CAME B,1(A) ;primary name match?
JRST EXTCH3 ;no
HLRZ T,EXT1+1(A) ;yes, get extension
CAMN T,EXTIGN ;want to ignore this extension?
JRST EXTCH3 ;yes, pretend we didn't see filename match at all
SKIPE EXTDSP#
JRST @EXTDSP# ;Check different extension list
MOVSI TT,-NEXTS
CAIE T,@EXTTAB(TT)
AOBJN TT,.-1
SKIPGE EXTTAB(TT)
ADDI TT,NEXTS+1 ;Bad extension, give it (arbitrarily) lower priority
EXTRE2: CAIG C,(TT) ;Is the UFD entry better than previous best?
JRST EXTCH3 ;No
MOVEI C,(TT) ;Save priority of best extension so far
HRLZM T,@EXT1(E) ;Put extension into filename block
MOVSI T,FRDEXT
IORM T,(E) ;mark extension seen in this filename now
EXTCH3:
IFE DECSW,<
ADD A,[20,,20] ;20 words per file entry in UFD
>
IFN DECSW,<
ADD A,[2,,2] ;EXCEPT IN THE REAL WORLD
>
JUMPL A,EXTCH2
JRST EXTCH1
EXTRED: CAMN B,['PRUNE ']
CAIE T,'DAT'
JRST .+2
JRST EXTCH3 ;Ignore PRUNE.DAT files on DOC areas
MOVSI TT,-NDEXTS
CAIE T,@DEXTAB(TT)
AOBJN TT,.-1
SKIPGE DEXTAB(TT)
ADDI TT,NDEXTS+1 ;Bad extension, give it lower priority
JRST EXTRE2
;Here to see if the current file entry in the UFD has a purely numeric ext.
;There can be only digits and optional trailing (not leading) spaces.
EXTGRT: MOVEI TT,0 ;Numeric value of extension collected here
CAIN T,'> ' ;Is this really a greater-than sign in extension?
JRST EXTRE2 ;Yes, give it top priority
JUMPE T,EXTCH3 ;Ignore null extension
LDB D,[POINT 6,T,23] ;Get first char of extension
PUSHJ P,EXTGRD ;See if it's a digit
LDB D,[POINT 6,T,29] ;Same for second digit
PUSHJ P,EXTGRD
LDB D,[POINT 6,T,35] ;Same for third digit
PUSHJ P,EXTGRD ;(doesn't return if not a digit or space)
PUSHJ P,EXTGR3 ;Make priority positive
JRST EXTRE2
EXTGRD: CAIN D,' ' ;Ignore space in extension
JRST EXTGR3
JUMPG TT,EXTGR2 ;Lose if space seen before this non-space
CAIL D,'0'
CAILE D,'9'
JRST EXTGR2 ;Not a numeric extension
IMULI TT,=10
SUBI TT,-'0'(D) ;Collect negative value of extension
POPJ P,
EXTGR3: JUMPG TT,CPOPJ ;Jump if already have seen a space
ADDI TT,=1000 ;Make priority positive, flagging space seen
POPJ P,
EXTGR2: SUB P,[1,,1]
JRST EXTCH3 ;Char in extension is neither digit nor space
EXTCH4:
IFN FTBUF,<
PUSHJ P,CACRLI ;Release cache from input channel (and UFD)
>
CAIL C,-1
AOS (P) ;Didn't find anything, skip return on failure
MOVSI T,400000
HLLM T,EXT1(E) ;Flag extension check done (E is SRCFIL or DSTFIL)
POPJ P,
;Extension priorities when no extension given.
;First extensions in the list have the highest priority.
;Extensions with fourth character "X" are "bad" extensions to avoid.
;Null extension is first for case of /H switch given with no explicit extension.
EXTTAB: FOR X IN(< >,FAI,S1,SAI,FOR,F4,LSP,WEB,TEX,MSS,PUB,POX,MAC,<MID>
,VLI,LAP,PAL,AL,MF,PL,MIC,SLO,<WRU>
,NSA,OSA,PSC,PAS,LST,PPR,LOG,CMD,MSG,TXT,DO,INI,NS,<DIS>
,RELX,DMPX,XGPX,FNTX,CFTX,TFXX,DRWX,WD X,PC X,WPCX,PLTX,PCPX,<PLXX>
,DVIX,PACX,SPIX,TFMX,VNTX,ANTX,<PXLX>
,LDIX,RIMX,FASX,VRNX,PICX,BINX,WL X,WLSX,PREX,PRSX,CRUX,PRFX,SAMX)
< (<SIXBIT /X/>)
>NEXTS←←.-EXTTAB
0 ;Sign bit off (good extension) for no match at all
;Extensions to consider when looking for documentation file (/D or READ)
;First extensions in the list have the highest priority.
;Extensions with fourth character "X" are "bad" extensions to avoid.
DEXTAB: FOR X IN (<TXT>
,RELX,DMPX,XGPX,<FNTX>
,OLDX,PUBX,POXX,UPDX)
< (<SIXBIT /X/>)
>NDEXTS←←.-DEXTAB
0 ;Sign bit off (good extension) for no match at all
IFE DECSW,< ;This could work for DECSW, just needs PPN fixing for IRCSW
;List of documentation areas searched by READ command.
;Lowest priority documentation area is first in this list, highest last.
DOCS: ' 11DOC'
'HADDOC'
' 3 2'
'ARTDOC'
'MUSDOC'
' HDOC'
'LIBDOC'
'BIBDOC'
'AIMDOC'
' PDOC'
' BBDOC'
' UPDOC'
DOCS1: ' SDOC' ;Highest priority documentation area
NDOCS←←.-DOCS
;Here to look for first document file matching given filename, from READ cmd.
GETDOC: SETOM RDONLY ;Make this a readonly edit
SETZM CREASW ;Let's not let him replace a documentation file
MOVEI E,SRCFIL ;Search for document matching source filename
MOVE TT,SRCFIL
TLNN TT,FRDPRG ;Did he give an explicit programmer name?
PUSHJ P,EXTOPN ;No, open the device
POPJ P, ;Explicit programmer name or can't open device
MOVEI T,EXTRED
MOVEM T,EXTDSP# ;Special dispatch for EXTCH2
MOVE T,DOCS1
MOVEM T,OBUF+4 ;Remember first PPN checked in case of failure
MOVEI D,NDOCS-1
MOVE TT,SRCFIL
TLNE TT,FRDEXT ;Explicit extension given?
JRST GETDOE ;Yes, just try LOOKUPs
TLNN TT,FRDPRJ ;Explicit project given?
JRST GETDO2 ;No, check 'em all
HLL T,@SRCFIL+PPN3 ;Yes, get it
HLLM T,OBUF+4 ;Remember PPN we looked at in case of failure
TDZA D,D ;Only check one area
GETDO2: MOVE T,DOCS(D) ;Get PPN to read
MOVNI TT,1 ;assume no special extensions to ignore
CAMN T,[' PDOC'] ;special PPN?
MOVEI TT,'DIS' ;yes, ignore files with this extension
MOVEM TT,EXTIGN ;-1 or extension to ignore in RH
PUSHJ P,EXTCH0 ;Is there is a file like this on this PPN?
JRST GETDO3 ;Yes, edit it
SOJGE D,GETDO2 ;No, try another PPN
GETDO8: SKIPA T,OBUF+4 ;Get first PPN tried
GETDO3: MOVE T,OBUF ;Get back successful PPN
GETDO9: MOVEM T,@SRCFIL+PPN3
MOVSI T,FRDEXT ;Suppress calling EXTCHK
IORM T,SRCFIL
POPJ P,
GETDOE: TLNN TT,FRDPRJ ;Explicit project given?
JRST GETDO4 ;No, check 'em all
HRRM T,@SRCFIL+PPN3 ;Yes, let normal LOOKUP routine do the work
POPJ P,
GETDO4: MOVE B,@SRCFIL
MOVEM B,OBUF
HLLZ B,@SRCFIL+1
MOVEM B,OBUF+1
GETDO5: MOVE T,DOCS(D) ;Get PPN
MOVEM T,OBUF+PPN3
LKPMAC <LOOKUP DSKI,OBUF>
JRST GETDO6 ;See why LOOKUP failed
GETDO7: CLOSE DSKI, ;For safety
MOVE T,DOCS(D) ;Get PPN again
JRST GETDO9 ;We found it, now set up PPN in filename block
GETDO6: HRRZ T,OBUF+1 ;Get error code
CAIE T,2 ;Protection violation?
CAIN T,3 ;Or file busy?
JRST GETDO7 ;Yes, then assume file is really there
SOJGE D,GETDO5 ;No, try another PPN
JRST GETDO8 ;Not anywhere to be found
>;NOT DECSW
EXTOPN: MOVEI C,DSKI ;Channel to open
PUSHJ P,SETCHN ;Put channel number into I/O UUOs XCTed
MOVSI T,@-1(E) ;Address of device/filename block
HRRI T,OBUF+5 ;Harmless place for OPNDEV to BLT filename to
PUSHJ P,OPNDEV ;Make sure device is open (skips on error)
AOS (P) ;Skip on success
POPJ P,
;Here we apply the ".>" extension hack to separate source and destination files,
;making sure we don't apply it twice if source and dest file specs are same spec.
CHKGRT: MOVEI E,SRCFIL ;If source file extension was greater-than sign,
SKIPN CREASW ; and we're not actually creating that file new,
PUSHJ P,GETGRT ; then find max numeric extension
MOVEI E,DSTFIL ;If output file extension was greater-than sign,
MOVEI T,@SRCFIL ; and we ARE actually creating that file,
SKIPN CREASW ; either explicitly or by copying
CAIE T,@DSTFIL ; (skip if no create),
PUSHJ P,GETGRT ; then increment max numeric extension found
POPJ P,
GETGRX: MOVSI T,FRDGRT
ANDCAM T,(E) ;Prevent EXTCHK from looking any more
POPJ P,
;Here to find file on given PPN with largest numeric extension
GETGRT: MOVE T,(E) ;Get filename bits
TLNN T,FRDGRT ;Skip if greater-than sign was extension
POPJ P,
HLRZ T,@EXT1(E)
CAIN T,'> ' ;Don't mess with numeric extension already found
PUSHJ P,EXTOPN ;Open the device
JRST GETGRX ;Failed, or already converted to numeric ext
MOVEI T,EXTGRT
MOVEM T,EXTDSP# ;Special dispatch for EXTCH2
PUSHJ P,EXTCHG ;Search UFD for biggest extension
CAIA ;Found something
POPJ P, ;Nothing found, leave FRDGRT bit on
PUSHJ P,GETGRX ;Clear FRDGRT bit
CAIE E,DSTFIL ;If creating file, increment numeric extension
POPJ P, ;Not creating
HLRZ T,@DSTFIL+1 ;Get best extension found, wanna increment it
CAIN T,'> ' ;Is this really a greater-than sign in extension?
POPJ P, ;Not numeric after all!
TRNE T,20 ;Last ext char a digit (alternative is space)?
JRST INCGR1 ;Yes, bump it
INCG01: TRNE T,2000 ;Middle char a digit?
JRST INCGR2 ;Yes, bump it
INCG02: TRNE T,200000 ;Any digit here at all?
JRST INCGR3 ;Yes, bump top digit
POPJ P, ;I give up, this can't happen
INCGR1: ADDI T,1 ;Increment low digit
TRNE T,10
TRNN T,2 ;Did a 9 just overflow?
JRST INCGRX ;No, store incremented extension
TRZ T,12 ;Yes, reset this digit to zero
JRST INCG01
INCGR2: ADDI T,100 ;Increment middle digit
TRNE T,1000
TRNN T,200 ;Did a 9 just overflow?
JRST INCGRX ;No, store incremented extension
TRZ T,1200 ;Yes, reset digit to zero
JRST INCG02
INCGR3: ADDI T,10000 ;Increment high digit
TRNE T,100000
TRNN T,20000 ;Did a 9 just overflow?
JRST INCGRX ;No, store incremented extension
TRZ T,120000 ;Yes, reset digit to zero
TRNE T,77 ;Is low char a space?
JRST INCGRX ;No, let 999 wraparound to 000
LSH T,-6 ;Yes, shift out the low space
ADDI T,210000 ;Put a "1" in the high-order position
INCGRX: HRLM T,@DSTFIL+1 ;Store incremented numeric extension
POPJ P,
;OPENIT OPENI2 OPENC OPENI2 OPENWE OPENW OPENO OPENC2 OPENO2 CLOBUF SETO FPAUSE PAUSE PAUS2 BYE WHOREA WHOREF WHORE0 WHORE2 WHORE3 WHLOOO WHLOOP WHOEND ESCOCT ESCOC2
;Command routine to open file in RA mode if not so open already.
OPENIT: JUMPLE A,WHOREA ;Zero arg just tells if anyone else reading file
TLNN F,ENTRD ;Is file already open?
JRST OPENI2 ;No, open it now
;note: under DECSW, OPENI2 is same as OPENWE (no uuo to see if we'll win)
SKIPGE BLAB
POPJ P, ;Suppress message in terse mode
OUTSTR [ASCIZ/ Already open. /]
JRST POPJ1
IFE DECSW,<
OPENI2: PUSHJ P,WHORE0 ;See if we're gonna succeed to open the file
JRST OPENWE ;No one reading it, now open it
SORRY Can't open file now.
JRST POPJ1
>;IFE DECSW
OPENC: HRROS (P) ;Set flag: here creating a file
PUSHJ P,CREGRT ;If creating file w/ext ">", use "1" instead
PUSHJ P,CLOSDO ;Close output channel in case changing devices
SKIPGE T,SPROT ;Protection specified for copy?
JRST OPENC2 ;No, go create new file using old file's prot
CAIG T,=777 ;Skip if protection specified is bigger than max
PUSHJ P,ESCOCT ;Convert number read as decimal (in T) to octal
MOVEI T,0 ;Illegal digit (8 or 9) or number too big
DPB T,[POINT 9,DATE2(E),8] ;Store protection where ENTER will copy it
JRST OPENC2
IFN DECSW,<
OPENI2:
>;IFN DECSW
OPENWE: MOVEI E,EDFIL ;Open edit file for writing
OPENW: TRNN F,REDNLY
TLOE F,ENTRD
JRST OPENO2
OPENO: HRRZS (P) ;Clear flag: not here creating a file
OPENC2: MOVSI T,-1(E)
HRRI T,ENTR-1
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
ENTER DSKO,ENTR
JRST ENTLUZ
IFN DATOK,<
HRRZ T,ENTR+EXT1
HRRM T,EXT1(E)
MOVE T,ENTR+DATE2
MOVEM T,DATE2(E)
>;DATOK
SETZM OBLK
OPENO2: PUSHJ P,WRBF1
CLOBUF: MOVE T,[OBUF-1,,OBUF]
TLNN F,CLRBF ;ALREADY DONE?
BLT T,OBUF+177
POPJ P,
SETO: HRRZM A,OBLK
USETO DSKO,(A)
JRST WRBF2
FPAUSE: HRRE T,EXT1(D)
JUMPGE T,PAUSE ;check error code
PUSHJ P,PAUSE
OUTSTR [ASCIZ /OPEN./]
POPJ P,
PAUSE: SKIPG DPY
JRST PAUS2
PUSH P,G
PUSHJ P,FINI2 ;clear the screen
PPSEL 1
IFE DECSW,<
HRROI G,[004000,,"N"] ;Do ESC N to normalize PP
TTYSET G,
>
IFN DECSW,<
MOVE G,[3,,[.TOESC ↔ 0 ↔ <"N",,0>]]
TRMOP. G,
JFCL
>
POP P,G
PAUS2: SETZM TYOPNT
TYPCHR 15*200+12
PUSHJ P,FILERR ;Type filename and reason for UUO failure
IFE DECSW,<
PUSHJ P,WHOREF ;If file busy, then tell who is using it
>;IFE DECSW
OUTSTR [ASCIZ /
Type CONTINUE to retry /]
XCT @(P) ;Type name of uuo that lost
SETO T,
BEEP T, ;Beep the fool to make him read the message
CLRBFI ;Flush type-ahead
OUTSTR [ASCIZ/
(Or type REENTER to save incore text in E$SAVE.TXT.)/]
BYE: PUSHJ P,LOADMT ;Fix up his line editor.
JFCL ;LOADMT skips if expanding a macro
PUSHJ P,WHOON ;Turn wholine back on if turned it off
PUSHJ P,LSPWRN ;warn about any detached lisp jobs
EXIT 1,
PUSHJ P,TYI7 ;Gobble any extra 400 floating around.
JRST POPJ1
;Here from ⊗0⊗XOPEN command to tell who else is reading the file we're editing.
WHOREA:
IFN DECSW,<
JRST EXTNF2 ;No such command in DEC version
>;IFN DECSW
IFE DECSW,<
AOS (P) ;Never say OK, we always type something
PUSHJ P,ABCRLF
PUSHJ P,WHORE0 ;See if anyone is reading the file
OUTSTR [ASCIZ/File not open elsewhere. /] ;No one has file open
POPJ P,
;Here when LOOKUP or ENTER (or OPEN) has failed. See if that's because
;someone else is using the file, and if so, report who has file open now.
WHOREF: HRRZ T,EXT1(D) ;Get error code
CAIE T,3 ;File busy?
POPJ P, ;No, no use seeing if anyone else has file open
OUTSTR [ASCIZ/
/]
PUSHJ P,WHORE2 ;Find out who is reading the file, type wholines
OUTSTR [ASCIZ/(File no longer open by any jobs.)
/] ;No one is reading file now
POPJ P,
;Here from OPEN or 0XOPEN to find out who has file open BESIDES ourselves.
WHORE0: PJOB T, ;Get our job number
MOVEI D,EDFIL ;Find out who is using the file we're editing
PUSHJ P,WHORE3 ;see if anyone ELSE has the file open
JFCL
PUSH P,A
PUSHJ P,MWCHK ;check for file being open in multiple windows
POP P,T ;T/-1 if no other users; A/0 if not in other windows
JUMPGE T,CPOPJ1 ;skip return if other jobs have this file open
JUMPG A,CPOPJ1 ;skip return if file open in multiple windows
POPJ P, ;file open only by self once
;Here after LOOKUP/ENTER failure to find out who has file open (we don't,
;at least in current window).
WHORE2: MOVNI T,1 ;avoid matching any job number (list own job)
WHORE3: PUSH P,T ;store our job number or -1
PUSH P,DATE2(D) ;Save date/time/protection word
MOVEI T,JOBLST ;Address for return of joblist by UUO
MOVEM T,DATE2(D) ;Make LOOKUP block into FILUSR block
MOVEI T,-1(D)
FILUSR T, ;Find out who is using this file
SETZM JOBLST ;Not disk device!
POP P,DATE2(D)
MOVNI A,1 ;Haven't typed out any job wholines yet
SKIPA T,[POINT 18,JOBLST] ;Byte pointer to list of jobs
WHLOOO: SETOM (P) ;flush our job nbr, lest file open in other window
WHLOOP: ILDB TT,T
JUMPE TT,WHOEND ;End of list
ANDI TT,7777 ;Flush bits, leave only the job number
CAMN TT,(P) ;Is this job us?
JRST WHLOOO ;Yes, ignore first such copy of us, no more
MOVSI TT,(TT)
HRRI TT,WHOBLK
WHO TT,
AOSN A ;First job?
OUTSTR [ASCIZ/File in use by:
/]
OUTSTR WHOBLK ;Type out wholine of job using file
JRST WHLOOP
WHOEND: SUB P,[1,,1]
JUMPGE A,CPOPJ1 ;Skip return if we listed any jobs
POPJ P,
>;IFE DECSW
;REMEMBER THAT ARG WE READ IN IN DECIMAL? WELL, WE REALLY WANTED
;TO READ IT IN OCTAL, SEE, SO . . .
;Skips on success (no 8's or 9's).
ESCOCT: IDIVI T,=10 ;Find a digit
HRLM TT,(P) ;Save remainder digit
JUMPE T,ESCOC2 ;If no more number, start back with T zero
PUSHJ P,ESCOCT ;Collect higher order octal digits into T
POPJ P, ;Illegal digit, propagate error return up
ESCOC2: LSH T,3 ;Shift higher-order digits over
HLRZ TT,(P) ;Get back digit
ADDI T,(TT) ;Include new digit
CAIG TT,7 ;Reasonable digit?
AOS (P) ;Yes, take success return
POPJ P, ;If not, take error return
;CLOSO2 CLOSO WRBUF WRBF1 WRBF2 WRBF3 ENTR OBUF IBUF IBFE WHOBLK JOBLST
CLOSO2: MOVE D,OPNT
CAMN D,[700,,OBUF-1]
JRST POPUP ;No partial buffer to output
TDZA T,T
IDPB T,D
TLNE D,760000
JRST .-2
HRLI D,1(D)
ADDI D,2
CAMG D,[OBUF+177,,OBUF+200]
SETZM -1(D)
CAMGE D,[OBUF+177,,OBUF+200]
BLT D,OBUF+177
POPJ P,
CLOSO: PUSHJ P,CLOSO2 ;See if there is partial buffer left to output
WRBUF:
IFN FTBUF,<
PUSHJ P,BOUT ;Output a record through the cache
>;FTBUF
OUT DSKO,[-200,,OBUF-1↔0]
WRBF1: AOSA OBLK
PUSHJ P,TELLZ
WRBF2: PUSH P,T
XCT XSETO ;JRST WRBF3 or MOVE T,OBLK
SUBI T,1 ;Input channel is same, so copy output block
MOVEM T,IBLK ; pointer to input block pointer.
WRBF3: MOVEI T,200*5
MOVEM T,OCNT#
MOVE T,[700,,OBUF-1]
MOVEM T,OPNT#
MOVE T,[OBUF-1,,OBUF]
TLNE F,CLRBF
BLT T,OBUF+177
POP P,T
POPJ P,
IMPURE
0 ;/F switch cell for FILERR
0 ;Device goes here
ENTR: BLOCK 4
0 ;/N switch cell for FILERR
0 ;For buffer-clearing BLT
OBUF: BLOCK 200
0 ;Warning--CREATE puts FF here and writes 400 words
0 ;Guard for backed up pointer case
IBUF: BLOCK 200
IBFE: -2
IFE DECSW,<
WHOBLK: BLOCK 22 ;For wholine of each job with file open
JOBLST: BLOCK 20 ;For list of jobs with file open
>;IFE DECSW
PURE
;TSINT INTLUZ INTDSP MAXINT INTTTI INTTTC INTTTY INTMAI INTPTO TSNINT TSNESC TSNES2 TSNES4 TSNES3 TSINT3 TSINT2
TSINT: MOVEM T,ISAV ;HERE FOR INTERRUPT (OLD DEC STYLE)
MOVEM TT,ISAV+1 ;SAVE SOME AC'S
MOVE T,JOBCNI ;THIS IS THE REASON WE'RE HERE
JFFO T,.+1 ;CONVERT BIT NUMBER TO INDEX (WHOOPEE!)
CAIL TT,MININT ;IN RANGE?
CAILE TT,MAXINT
INTLUZ: PUSHJ P,TELLZ ;UNEXPECTED TYPE OF INTERRUPT
JRST 2,@INTDSP-MININT(TT) ;DISPATCH TO PARTICULAR INTERRUPT SERVER
INTDSP: PDLOV
INTLUZ
INTLUZ
MORCOR
MAXINT←←.-INTDSP+MININT
;left half interrupt bits
INTTTI←←4 ;ESC I interrupt bit
INTTTC←←100000 ;Terminal-type-change interrupt bit
INTTTY←←20000 ;Terminal-input interrupt bit
INTMAI←←4000 ;mail-received interrupt bit
INTPTO←←1000 ;pty output interrupt bit
TSNINT:
IFE DECSW,<
MOVE T,JBICNI ;FIGURE OUT WHY WE WERE INTED
TLNE T,INTTTI ;Is it ESC I?
JRST TSNESC ;Yes
TLNE T,INTTTC ;Is it terminal-type change?
SETOM TTYNUM ;Yes, make DPYCHK see if the terminal type changed
TLNN T,INTPTO ;pty output int?
DISMIS ;no
HRRZ T,JOBTPC ;get trap PC, to check for PTWR9S deadlock
CAIE T,SNDPPC ;is main level trying to type at pty?
DISMIS ;nope
setom hanger# ;just for debugging to tell us it happened, flush later
... ;yup, better read some PTY output now!
DISMIS
TSNESC: MOVE TT,10 ;Get escape arg
>
IFN DECSW,<
MOVE TT,DECINT+3 ;Get escape arg
>
TRNN TT,-1 ;Skip if ESC/BRK n I, which doesn't affect searches
SETOM ESCIEN
TRNN TT,-1
MOVEM TT,ESCIE2# ;remember whether saw ESC or BRK, for LSCHK
JUMPL TT,TSINT3 ;Jump if BRK I
CAIL TT,=1000 ;skip if small arg
JRST TSNES2
MOVEI T,MACESC ;Address of routine to stop all macros
MOVEM T,MACINS
JRST TSINT2
TSNES2:
IFE DECSW,<
CAIE TT,=2718 ;start?
JRST TSNES3
MOVEI T,1 ;yes, set starting state
MOVEM T,QCKSTT#
JRST TSINT2 ;exit
TSNES4: MOVE T,JOBTPC ;Save this before goddamn UWAIT clobbers it!
MOVEM T,SAVTPC#
UWAIT ;Wake up any SLEEP in progress
MOVE T,SAVTPC
MOVEM T,JOBTPC
MOVSI T,(1B12)
SETOM QCKSTT
DISMIS T,
TSNES3: MOVEI T,0
EXCH T,QCKSTT# ;clear state, get old one
CAIN TT,=3142 ;end?
JRST TSNES4 ;yes
>;IFE DECSW
JRST TSINT2 ;no, exit
TSINT3: MOVE T,MACINS
TLNN T,-1 ;Is there already a low-priority macro interrupt?
HRLI T,MACBRK ;No, make one to stop current macro
MOVEM T,MACINS
TSINT2:
IFE DECSW,<
MOVE T,JOBTPC ;Save this before goddamn UWAIT clobbers it!
MOVEM T,SAVTPC#
UWAIT ;Wake up any SLEEP in progress
MOVE T,SAVTPC
MOVEM T,JOBTPC
DISMIS
>
IFN DECSW,<
DEBRK.
>
;JBICNI JBITPC JBIAPR ESCIEN ESCI2 IFND IFND1 IFND2 IFND3 PDLOV TRYPSH PDLUNK PDLOV2 ISAV
IMPURE
IFE DECSW,<
JBICNI: 0 ;THIS THREE CONSECUTIVE WORDS USED INSTEAD OF .JBCNI, TPC, AND APR
JBITPC: 0 ;FOR NEW INTS (I.E. ESC I INTS)
JBIAPR: TSNINT ;GO TO TSNINT FOR NEW STYLE INTS
>
IFN DECSW,<
DECINT: TSNINT ;PSISER BLOCK: NEW PC
0 ;OLD ONE
20000,,0;FLUSH ESC-I DURING ESC-I PROCESSING
0 ;USER'S ESC ARG RETURNED HERE
>
ESCIEN: 0 ;NON ZERO WHEN EXTENDED SEARCH SHOULD GRIND TO A HALT
ESCI2: 0 ;Flag saying we have just been interrupted by ESC I
PURE
IFND: MOVEM TT,IFRET#
IFND1: CAIL T,BEG
CAMLE T,JOBREL
JRST IFND3
IFND2: MOVE T,(T)
MOVEM T,INTINS#
MOVE T,ISAV
MOVE TT,ISAV+1
MOVEI T,@INTINS
HLRZ TT,INTINS
ANDI TT,777000
CAIN TT,(<XCT>)
JRST IFND1
LDB TT,[270400,,INTINS]
CAIE TT,T
CAIN TT,TT
ADDI TT,ISAV-T
MOVEM TT,IFACP#
HLRZ TT,INTINS
ANDI TT,¬37
AOS IFRET
JRST @IFRET
IFND3: CAMLE T,JOBHRL↑
JRST @IFRET
JRST IFND2
PDLOV: SKIPE SFSPNT
JSP SBARF
TLNN P,-1
CAMLE P,JOBREL
JRST TRYPSH
HLRZ T,(P)
ANDI T,357637
CAIE T,310000
CAIN T,10000
JRST PDLOV2
TRYPSH: SOS T,JOBTPC
JSP TT,IFND
JRST PDLUNK
ANDI TT,777000
CAIE TT,(<PUSH>)
PDLUNK: PUSHJ P,TELLZ
MOVE T,@IFACP
HLRZ T,(T)
JUMPN T,PDLUNK
MOVN TT,[1,,1]
ADDM TT,@IFACP
JRST INTPOV
PDLOV2: SUB P,[1,,1]
HRRZ T,1(P)
SUBI T,1
JSP TT,IFND
AOBJP P,TRYPSH
CAIN TT,(<PUSHJ P,>)
CAIE T,@JOBTPC
AOBJP P,TRYPSH
SOS T,1(P)
MOVEM T,JOBTPC
JRST INTPOV
IMPURE
ISAV: BLOCK 3
PURE
;FSINI FSINI1 MORCOR POPCO2 MORCXT POPCOR INTPOV INTERR INTX2 INTX
FSINI: MOVE T,JOBREL
CAMLE T,JOBFF
JRST FSINI1
ADDI T,2000
CORE T,
PUSHJ P,NOCORE ;Can't core up!
MOVE T,JOBREL
FSINI1: AOJ T,
MOVEM T,FSMAX# ;Address of first word beyond end of FS
SUB T,JOBFF
HRROM T,@JOBREL ;Put size into end of initial big free FS block
HRROM T,@JOBFF ;Put size into beginning too
MOVEM T,FSFREE# ;Number of free FS words
MOVE T,JOBFF
MOVEM T,FSMIN# ;Address of beginning of FS
MOVEM T,FSBEG# ;Address of lowest free FS block
SETZM FSUSE# ;No FS words in use
POPJ P,
MORCOR: HRRZ T,JOBTPC ;HERE FOR ILL MEM REF
MOVSI TT,-LEGCNT
CAME T,LEGTAB(TT) ;IS INTERRUPT PC= TO ONE OF LEGAL VALUES?
AOBJN TT,.-1
JUMPGE TT,INTERR ;JUMP IF NOT A MEMBER OF LEGTAB
MOVE T,JOBREL ;LET'S GET MORE CORE.
ADDI T,2000
repeat 0,<
CAILE T,377777 ;MAKE SURE WE DON'T GET TOO BLOATED
JRST [ DPYCLR
OUTSTR [ASCIZ/I just got too bloated.
/]
HALT MORCOR]
>;repeat 0
CORE T,
PUSHJ P,NOCORE ;Can't core up
MOVE T,SUBONE ;Processor flag: KL/KI v. KA.
AOJE T,INTX ;Jump if not KA
;REG 1/1/74 to fix AC of PUSH that got ILM
LDB T,[POINT 9,@JOBTPC,8] ;GET OP CODE
IFN FTF2,<
IFN FTCCRMA,<
printx This fix of the POP AC on ILM interrupt MIGHT be different for an F4.
>;IFN FTCCRMA
;Must fix AC of POP that got ILM too.
CAIN T,(<POP>⊗-9) ;IS THIS A POP?
JRST POPCOR ;yes, fix up the POP AC (prematurely decremented)
>;IFN FTF2
CAIE T,(<PUSH>⊗-9) ;IS THIS A PUSH?
JRST INTX ;NO. EXIT NOW.
MOVE T,@JOBTPC ;GET LOSING PUSH.
HRRI T,ISAV ;CHANGE ADDRESS PART TO CLOBBER USELESS CELL
TLC T,(<PUSH>≥<POP>) ;CHANGE PUSH TO A POP
POPCO2: MOVEM T,ISAV+2 ;SAVE IT WHERE WE'LL XCT IT.
MOVE T,ISAV
MOVE TT,ISAV+1
XCT ISAV+2 ;RESTORE T AND TT, THEN FIX THE PUSH AC
MORCXT: JRST 2,@JOBTPC
IFN FTF2,<
;The KA version didn't have this, so I suppose only the F2 needs it.
;Fix up stack ptr to retry a POP that got an ill mem ref.
POPCOR: LDB T,[POINT 4,@JOBTPC,12] ;Get POP AC
LSH T,5+=18 ;Put POP AC into AC field
IOR T,[AOBJN MORCXT] ;make instruction to adjust POP AC
JRST POPCO2
>;IFN FTF2
;We don't try to report PDL OVs nor do we try to save incore text--no stack space
INTPOV: MOVE T,JOBENB
MOVEM T,ISAV+2
MOVEI TT,0
APRENB TT,
JRST INTX2 ;Cause the PDL OV again without interrupts
INTERR: MOVEI TT,[ASCIZ/Ill mem ref/]
MOVEM TT,40
MOVE T,JOBENB
MOVEM T,ISAV+2
MOVE TT,JOBTPC
MOVEM TT,ILMADR# ;SAVE ADDRESS OF LOSING INSTRUCTION FOR FBI
MOVEI TT,0
APRENB TT,
MOVE T,ISAV ;Make sure FBI reports the
MOVE TT,ISAV+1 ; right contents of T and TT
JSR PANIC ;Report the error and try to write out text
INTX2: MOVEI TT,0
SLEEP TT,
MOVE T,ISAV+2
MOVEM T,JOBENB
INTX: MOVE T,ISAV
MOVE TT,ISAV+1
JRST 2,@JOBTPC ;Re-execute the losing instruction, for better or worse
;FSUSED FSGET FSLUP0 FSLUP FSGRAB FSXIT
FSUSED: ADDI A,(T) ;Skip block in use
MOVEM A,FSBEG ;FSBEG was wrong, so fix it--lowest free FS
JRST FSLUP0
;Routine to get (B) words of free storage (not counting 2 overhead FS words).
;Returns FS ptr (to first data word) in A.
;Returns pointer to word beyond end of block in T.
FSGET: TLO F,FSCHKF ;Set flag so free storage will be checked
TSTSHF
MOVEI T,2(B) ;Amount of FS needed including 2 overhead words
CAMLE T,FSFREE
SOJA T,FSNEW ;There isn't enough free FS for our request--grab off top
MOVEI TT,
MOVE A,FSBEG ;Look through all FS for big enough block
FSLUP0: SKIPL T,(A)
JRST FSUSED ;This block in use
FSLUP: SKIPL T,(A)
JRST FSNEXT ;Block in use, skip to next one, if any more
CAIG B,-2(T) ;Big enough block?
TRNN T,-2 ;Seems so, but is it really bigger than one word?
JRST FSTSML ;No, too small, but remember biggest block we've seen
FSGRAB: HRRZ TT,T
ADDI T,(A)
CAIN B,-2(TT) ;Is this block exactly the right size?
JRST FSXIT ;Yes, amazing
SUBI TT,2(B) ;No, figure amount left over
HRROM TT,-1(T) ;And mark remaining block as free--ending FS word
SUBI T,(TT)
HRROM TT,(T) ;Mark beginning FS word free with size
MOVEI TT,2(B) ;Actual total size of block we are claiming
FSXIT: CAMN A,FSBEG
HRRZM T,FSBEG ;This was the lowest free FS, so remember new lowest FS
MOVEM TT,-1(T) ;Mark size of FS and mark FS as in use in ending FS word
MOVEM TT,(A) ;Same for beginning word
ADDM TT,FSUSE ;Using more FS
MOVNS TT
ADDM TT,FSFREE ;Less free FS
AOJA A,CPOPJ ;Return pointer to first data word in block
;FSNEWT FSNEWP FSNEW
;We get here if we can't compact core enough to get the size FS block we need.
;Here we grab it off the top of FS.
FSNEWT: MOVEI T,1(B) ;Size of needed FS block plus one overhead word
FSNEWP: POP P,D
POP P,C
FSNEW: MOVE TT,FSMAX ;Address of new core to be added to FS
SKIPGE -1(TT) ;Is top FS block free?
SUB TT,-1(TT) ;Yes, include it in block of new core
ADDI T,(TT) ;Form address of end of new core block
CAMG T,JOBREL ;We're supposed to absolutely need more core
STOPJ
CORE T, ;Get more core
PUSHJ P,NOCORE ;Can't core up!!
MOVE A,FSMAX ;Address of new core
SKIPGE T,-1(A) ;If old top block was free,
SUBI A,(T) ; then start at its beginning
MOVE T,JOBREL
AOJ T, ;New address just above new FS block
MOVE TT,T
SUB TT,FSMAX
ADDM TT,FSMAX ;Update the pointer to the word above top FS
ADDM TT,FSFREE ;Update amount of free FS we have
SUBI T,(A) ;Length of (combined) new free FS block
HRROM T,(A) ;Insert length at beginning of block
HRROM T,@JOBREL ; and at end
JRST FSGRAB ;Claim amt of FS requested--free block adr in A, size in T
;FSTSML FSNEXT FSHRET FSLLUZ
;Get here looking for FS, but block we're looking at is too small
FSTSML: CAIL TT,(T) ;Is this biggest block we've seen?
JRST FSNEXT
HRRZ TT,T ;Yes, remember its size
MOVEM A,FSBIG# ; and address
FSNEXT: ADDI A,(T) ;Move on to next FS block
CAMGE A,FSMAX ;End of FS?
JRST FSLUP ;No
JUMPN TT,.+2
STOPJ ;Didn't even find one free block!
MOVEI T,40(B)
TLNN F,NOSHUF ;Can we shuffle now?
CAMLE T,FSFREE ;Are there at least 40 words more than we need free?
SOJA T,FSNEW ;No
PUSH P,C
PUSH P,D
SUBI TT,2(B) ;Negative of amount we need besides biggest block
MOVE A,FSBIG
PUSHJ P,FSLSCN ;Can we compact enough FS before the big block?
JRST FSLLUZ ;Nope
MOVEI T,2(B)
LSHC C,-2 ;Amount of text to move divided by 4
CAML C,T ;Is that less than amount we need?
SOJA T,FSNEWP ;No, too much trouble, get FS off end
LSHC C,2 ;Restore amount to move
PUSHJ P,FSLSHF ;Move it
FSHRET: POP P,D
POP P,C
JRST FSGRAB ;Claim amt of FS requested--free block adr in A, size in T
FSLLUZ: MOVEI T,100(B)
CAMLE T,FSFREE ;Less than 100 free FS words beyond what we need now?
SOJA T,FSNEWP ;Yes, don't bother shuffling
PUSHJ P,FSLSHF ;Compact FS below FSBIG (from FSBEG on up)
MOVNI TT,2(B) ;Amount of FS we need compacted
PUSHJ P,FSHSCN ;Can we compact enough FS from this compacted block on up?
JRST FSNEWT ;NO CAN DO - SOMETHING MUST BE LOCKED
MOVEI T,2(B) ;Amount of FS we need compacted
LSH C,-1 ;Amount of FS needing to be moved divided by 2
CAML C,T ;Is that more than we need?
SOJA T,FSNEWP ;Yes, too much trouble, get FS off end
PUSHJ P,FSHSHF ;Compact FS upward
JRST FSHRET
;FSLSCN FSLSCL FSLFR FSLSHF FSLSLP FSLMOV FSLDON
;FS Low SCaN. Look for free FS from (A) down to FSBEG.
;Call with TT containing negative amount of free FS wanted.
;Skips on return with A pointing to lowest
;free FS block we found (place to shuffle used FS down to).
FSLSCN: MOVEI C,0 ;amount of FS that will need to be moved
FSLSCL: CAMG A,FSBEG ;Any more free FS below us?
POPJ P, ;No, use failure return
MOVE T,-1(A) ;Size of block below us
SUBI A,(T) ;Address of block below
SKIPGE T,(A) ;Is this block free?
JRST FSLFR ;Yes
TLNE T,LOKBIT ;No, can we move it?
JRST [ADDI A,(T)↔POPJ P,] ;CAN'T MOVE IT
ADDI C,(T) ;Count amount of FS to be moved
JRST FSLSCL
FSLFR: ADDI TT,(T) ;TT is negative of amount of FS we still need
JUMPL TT,FSLSCL ;Look for more free FS below
JRST POPJ1 ;We have found enough FS
;Routine to shuffle used FS down toward (A) away from FSBIG (big FS block)
FSLSHF: CAMG A,FSBEG
ADDM C,FSBEG ;Gonna move C used words down to old FSBEG (first free FS)
MOVEI C,0 ;No free words collected yet
FSLSLP: CAML A,FSBIG ;Have we compacted everything up to the big block?
JRST FSLDON ;Yes
SKIPL T,(A) ;No, is this block free?
JRST FSLMOV ;No, move it down
SUBI C,(T) ;Yes, count negative of free words found
ADDI A,(T) ;Address of block above us
JRST FSLSLP
FSLMOV: HRRZS T ;Size of block
PUSHJ P,PNTREL ;Fix up the pointers to this block
PUSHJ P,FSBLT ;Move the block down
ADDI A,(T) ;Next block
JRST FSLSLP
FSLDON: CAML A,FSMAX ;Have we compacted all the way to end of FS?
TDZA T,T ;Yes, no additional block to include
HRRZ T,(A) ;No, get size of next block
MOVE TT,T
ADDI TT,-1(A) ;Address of end of block
SUB T,C ;Positive size of combined block
HRROM T,(TT) ;Store FS size word at end of new free block
ADD A,C ;Address of beginning of combined block
HRROM T,(A) ;Store FS size word at beg of new free block
POPJ P,
;FSHSCN FSHSCL FSHSC2 FSHFR FSHSHF FSHSLP FSHSR FSHSX FSHMOV
;FS High SCaN. Look for free FS from (A) up to FSMAX.
FSHSCN: MOVEI C,
FSHSCL: SKIPGE T,(A) ;Is this block free?
JRST FSHFR ;Yes
TLNE T,LOKBIT ;No, can we move it?
JRST [HRRZ T,-1(A)↔SUBI A,(T)↔POPJ P,] ;CAN'T MOVE
ADDI C,(T) ;Amount of FS we can move
FSHSC2: ADDI A,(T) ;Next FS block
CAMGE A,FSMAX ;Have we reached the top of all FS?
JRST FSHSCL ;No, look some more
POPJ P, ;Yes, take failure return
FSHFR: ADDI TT,(T) ;Count amount of free FS we have found
JUMPL TT,FSHSC2 ;Found as much as they asked for?
JRST POPJ1 ;Yes!
;Routine to shuffle used FS up toward (A) away from FSBIG (big free block)
FSHSHF: MOVEI C, ;Count amount of free FS collected
FSHSLP: SKIPL T,(A) ;Is this block free?
JRST FSHMOV ;No, move it up
ADDI C,(T) ;Yes, count free FS found
FSHSR: CAMG A,FSBIG ;Have we reached the big block?
JRST FSHSX ;Yes
MOVE T,-1(A) ;No, get size of block below us
SUBI A,(T) ;Get address of block below
JRST FSHSLP
FSHSX: SKIPN T,C
POPJ P, ;JUST IN CASE WE DIDN'T FIND ANY FREE FS
ADDI C,-1(A) ;End address of collected free FS
HRROM T,(C) ;Insert size at end of collected free block
HRROM T,(A) ;Insert size at beginning too
CAMGE A,FSBEG ;If this block is below old lowest free FS block,
MOVEM A,FSBEG ; then it is now the new lowest free FS block
POPJ P,
FSHMOV: ANDI T,-1
PUSHJ P,PNTREL ;Fix up the pointers to this block
PUSHJ P,FSBLT ;Move the block up
JRST FSHSR
;FSBLT POPTJ FSBLT1
;MOVES (T) WORDS LOCATED AT (A) A DISTANCE OF (C). CLOBBERS D & TT
FSBLT: CAILE T,(C) ;Are we gonna shuffle beyond end of the FS block?
JUMPGE C,FSBLT1 ;No, if shuffling up, can't just BLT into itself
JUMPLE T,CPOPJ ;Return quick if no words to shuffle
MOVE TT,A ;Source address of BLT
ADD TT,C ;Destination address
HRL TT,A ;Source address
PUSH P,T
ADDI T,(TT) ;Ending address plus one
BLT TT,-1(T) ;BLT FS down all at once
POPTJ: POP P,T
POPJ P,
;Here we are moving up into middle of original FS block
FSBLT1: CAILE C,5 ;Moving only a short distance?
JRST FSBLT2 ;No
JUMPE C,CPOPJ ;Return quick if not actually moving
PUSH P,B
PUSH P,E
MOVSI E,377777(T) ;Make a pdl pointer for POPing to shuffle words
HRRI E,(A) ;Beginning of old block
ADD E,T ;End of old block plus one
MOVSI B,(<POP E,(E)>) ;Make a two instruction AC loop to
HRRI B,(C) ; just POP words from old location to new
MOVE C,[JUMPL E,B]
MOVE D,[JRST .+2]
SOJA E,B ;Make E point to last word of old block--enter loop
HRRZ C,B ;Return here when AC loop finishes--restore C
POP P,E
POP P,B
POPJ P,
;FSBLT2 FSBLT3 FSHBLT FSHBL2
;Here to shuffle up (T) words of FS from (A) by a distance (C)>5.
FSBLT2: HRRM C,FSHBLT ;Set up main blt to move (C) words
SOS FSHBLT
HRLS C
MOVE D,A ;Address of old block
ADDI D,(C) ;Make it address of new block
PUSH P,T
IDIVI T,(C) ;We're gonna blt (C) words at a time, calculate odd words
MOVE T,(P) ;Number of words to shuffle
ADD T,A ;Address of last word in old block, plus one
HRLS T
ADDI T,(C) ;Address of last word in new block, plus one
JUMPE TT,FSBLT3 ;Jump if no odd words to move
HRRM TT,FSHBL2 ;Number of odd words
SOS FSHBL2 ; minus one
HRLS TT
SUBB T,TT ;Back up blt pointer over odd words
XCT FSHBL2 ;BLT the odd words at the end of the FS block
FSBLT3: SUB T,C ;Back up blt pointer over (C) words (both halves)
MOVE TT,T ;Copy blt pointer
XCT FSHBLT ;Shuffle (C) words
CAIGE D,(T) ;Have we backed all the way to the beginning of new block?
JRST FSBLT3 ;No, blt some more
HRRZS C ;Restore C to just the distance moved
JRST POPTJ
IMPURE
FSHBLT: BLT TT,(T)
FSHBL2: BLT TT,(T)
PURE
;PNTREL SHFTB MXSHF STDSH1 STDSHF DELSHF LSTSHF LSTSH1 RELOC RELOCL
;Routine to adjust pointers to FS block (A) of size (T) about to be moved by (C)
PNTREL: CAMN A,FSBLK#
JRST [ ADDM C,FSBLK
ADDM C,FSBL2#
JRST .+1]
HLRZ TT,(A) ;Get code indicating type of FS block
CAIL TT,MXSHF
PUSHJ P,TELLZ ;Illegal FS-type code!
MOVE D,A
ADD D,T
HLRZ D,-1(D) ;Left half of ending FS word
SKIPN C
AOSA (P) ;FS isn't actually moving
PUSHJ P,@SHFTB(TT) ;Call routine to handle this kind of FS
HRRZ T,(A) ;Get back FS block size
POPJ P,
DEFINE SHFCOD!(X)<X!COD←←.-SHFTB X!SHF>
;Dispatch table for relocating the pointers for different types of FS
;If you add another FS type here, you should make a test for it at MAP2.
SHFTB: STDSHF
SHFCOD (DIR) ;For directory entries
SHFCOD (TXT) ;For normal text lines
SHFCOD (MAC) ;For macro definitions
SHFCOD (DEL) ;For deleted lines
SHFCOD (QUE) ;For queued Lisp mail buffer
SHFCOD (WIN) ;For windows
MXSHF←←.-SHFTB
STDSH1: HLRZ T,D ;I don't know what this is really for--it can't
PUSHJ P,RELOC ; possibly do anything useful; in fact there is no
ANDI D,-1 ; possible way to get to STDSH1 with LH(D) nonzero.
STDSHF: JUMPN D,STDSH1
POPJ P,
DELSHF:
LSTSHF: MOVE T,1(A) ;Get pointer word from block being shuffled
LSTSH1: MOVSI C,(C) ;Put shuffle distance in LH for adjusting LH pointer
PUSHJ P,RELOCL ;Fix up FS that points back to us
MOVS T,T ;Make pointer to previous FS block in list
HLRE C,C ;Put shuffle distance back in RH
RELOC: SKIPA TT,(T) ;Get pointer word that points fwd to us
RELOCL: HLRZ TT,(T) ;Get LH pointer that points back to us
CAIE A,-1(TT) ;Does pointer really point to us (ie, to the block moving)?
PUSHJ P,TELLZ ;No! Screwed up FS list!
ADDM C,(T) ;Fix pointer (left or right half)
POPJ P,
;FSGIVE FSGIV0 FSGIV1 FSGIV2 FSTEXT FSGIVL DELSMX UNDELE UNDERR UNDEL0 UNDELL UNDTEL UNDSET UNDSE2
FSGIVE: PUSH P,A
PUSH P,B
CAMGE A,FSMAX
CAMGE A,FSMIN
STOPJ ;Fatal free storage error, address out of bounds
HLRZ TT,-1(A) ;Find out what kind of text this is
CAIN TT,TXTCOD ;Are we giving up some text?
SKIPGE TXTFLG(A) ;Yes, unless it is a pagemark line
JRST FSGIV0 ;Not plain text, just free up the FS
AOSE NOSAVE ;Skip if someone wants us not to save this line
JRST FSTEXT ;Save this deleted line for undeleting later
FSGIV0: TLO F,FSCHKF ;Set flag so free storage will be checked
HRROS TT,-1(A)
SOS B,A
ADDI B,(TT)
HRROS -1(B)
MOVNI TT,(TT)
ADDM TT,FSUSE
MOVN TT,TT
ADDM TT,FSFREE
CAMLE A,FSMIN
SKIPL T,-1(A)
JRST FSGIV1
SUBI A,(T)
ADDI TT,(T)
HRROM TT,(A)
ADDI T,(A)
HRROM TT,-1(B)
FSGIV1: CAMGE B,FSMAX
SKIPL T,(B)
JRST FSGIV2
ADDI TT,(T)
HRROM TT,(A)
ADDI B,(T)
HRROM TT,-1(B)
FSGIV2: CAMGE A,FSBEG
MOVEM A,FSBEG
TLNN F,NOCHK
PUSHJ P,CORCHK ;maybe core down
JRST POPBAJ
FSTEXT: SKIPN TT,DELHED# ;Pick up header of deleted line list
MOVEI TT,DELHED
HRLI TT,DELHED ;Backward pointer for newly deleted line
MOVEM TT,(A) ;Link in newly deleted line in front of older one
HRLM A,(TT) ;Make older one point back to new one
HRRM A,DELHED ;Make header point forward to newly deleted line
MOVEI TT,DELHED
MOVEI TT,DELCOD
HRLM TT,-1(A) ;Mark this FS block as deleted text
HRRZS TXTFLG(A) ;Clear the flags for this line
HLRZ TT,TXTCNT(A) ;Get char count from line
ADDM TT,DELSIZ# ;Count characters deleted
AOS TT,DELNUM# ;Count lines deleted
SUB TT,DELOLD# ; minus the number previously deleted
MOVEM TT,DELNEW# ; is the number just deleted (by current command)
FSGIVL: MOVE TT,DELSIZ ;See if we need to flush some old deleted lines
CAMLE TT,DELSMX ;Too many deleted chars?
SKIPG DELOLD ;Yes--any old lines that we are allowed to flush?
JRST POPBAJ ;Nope
SOS DELOLD ;Yes, flush one
SOS DELNUM ;One less deleted line in list
HLRZ A,DELHED ;Get pointer to oldest deleted line
HLRZ TT,(A) ;Get that line's pointer to previous deleted line
MOVEI T,DELHED
HRRM T,(TT) ;Make previous line point forward to header
HRLM TT,DELHED ;Make header point back to previous deleted line
HLRZ TT,TXTCNT(A) ;Get character count of deleted line
MOVN TT,TT
ADDM TT,DELSIZ ;Subtract from total chars in list
PUSHJ P,FSGIVE ;Really free this FS of a deleted line
JRST FSGIVL ;Now see if we need to flush more deleted lines
IMPURE
DELSMX: =5000 ;Number of deleted characters we keep around
PURE
;Command routine to undelete the most recently deleted lines
;Undeleted lines are put into the front of the attach buffer
UNDELE: JUMPLE A,UNDTEL ;Don't really undelete any lines
SKIPG DELNUM ;Skip if any lines can be undeleted
JRST UNDERR ;Nothing to be undeleted
TRNN F,ARG!REL ;No arg means undelete whole last group deleted
SKIPLE A,DELNEW ;Number of lines in last group deleted
JRST UNDEL0 ;Okay
SORRY <Last group deleted has already been undeleted.
Use an explicit arg to undelete more.>
JRST POPJ1
UNDERR: SORRY There are no lines to be undeleted.
JRST POPJ1
UNDEL0: TRNN F,ATTMOD
SETZM ATTSIZ ;Not in attach mode, so no chars attached
UNDELL: HRRZ B,DELHED ;Get pointer to most recently deleted line
HRRZ T,(B) ;Get pointer to 2nd such line
HRRM T,DELHED ;Make header point to 2nd line
MOVEI TT,DELHED
HRLM TT,(T) ;Make 2nd line point back to header
MOVEI TT,TXTCOD
HRLM TT,-1(B) ;Mark this FS block as text again
AOS TT,TXTNUM ;And give it a new serial number
HRRM TT,TXTSER(B)
SETZM TXTWIN(B) ;clear window ptr for line in current window
HLRZ TT,TXTCNT(B) ;Get char count for line being undeleted
ADDM TT,ATTSIZ ;Add in to attach buffer char count
MOVN TT,TT
ADDM TT,DELSIZ ;And subtract from deleted line char count
AOS ATTNUM ;Count another line attached
TROE F,ATTMOD ;Were we already in attach mode?
SKIPA TT,ATTBUF ;Get pointer to first line already attached
MOVEI TT,ATTBUF
HRLI TT,ATTBUF ;Backward pointer for new undeleted line
MOVEM TT,(B) ;Make new attach buffer line point to old first line
HRRM B,ATTBUF ;Make undeleted line new first line of attach buffer
HRLM B,(TT) ;Make old line point back to new one
SOS DELNEW ;Count one less line in last group deleted
SOSLE DELNUM ;One less deleted line available
SOJG A,UNDELL ;Undelete as many lines as requested
PUSHJ P,ATTWRT ;Note that attach buffer has been modified
JRST ATTUPD ;Fix up display of attach buffer and mode
UNDTEL: SETZM TYOPNT ;Tell him how many lines/chars he can undelete
JUMPL A,UNDSET ;Set number of deleted lines to be saved
PUSHJ P,ABCRLF
TYPDEC DELNUM
OUTSTR [ASCIZ/ lines (/]
TYPDEC DELSIZ
OUTSTR [ASCIZ/ chars) can be undeleted. /]
JRST UNDSE2
UNDSET: MOVNM A,DELSMX ;Set max number of deleted chars to save
SKIPGE BLAB
POPJ P, ;Flush msg in terse mode.
PUSHJ P,ABCRLF
UNDSE2: OUTSTR [ASCIZ/Deleted text saved up to /]
TYPDEC DELSMX
OUTSTR [ASCIZ/ chars.
/]
JRST CPOPJ1
;⊗ CORCHK CORCH2 CRUNCH CMPACT
CORCHK: TSTSHF
MOVE TT,FSFREE ;amount of free FS
TLNN F,NOSHUF ;skip if can't shuffle now
JRST CORCH2
MOVE T,FSMAX ;look at top piece of free FS
HRRZ TT,-1(T) ;its size
SKIPGE -1(T) ;skip if it's in use, no core down attempted
CORCH2: CAIGE TT,2200 ;not worth checking FS if can't core down by 1K or more
POPJ P, ;don't try to core down
TRZ TT,1777 ;truncate amt of FS to collect to multiple of 1K
MOVNS TT ;negative amount to collect (?)
PUSHJ P,CRUNCH ;collect free FS to top by shuffling used FS down
HRRO A,FSMAX
SKIPL T,-1(A) ;skip if top FS block is free, get size in RH
POPJ P, ;OOPS, top block is in use
SUBI T,200 ;LEAVE THIS MUCH ROOM
SUBB A,T ;new addr above remaining core
CORE T, ;core down
PUSHJ P,TELLZ ;Can't core down!!
MOVE T,JOBREL
AOS TT,T
SUB T,FSMAX ;calculate negative amount we've reduced core by
ADDM T,FSFREE ;less core is free because it's gone
ADDB T,FSMAX ;end of FS is lower too
SUBI TT,-200(A) ;new length of top free FS block
HRROM TT,-200(A) ;store in FS header
HRROM TT,-1(T) ; and in FS trailer
POPJ P,
;Called from ENDSET, CMPACT and CORCHK.
CRUNCH: MOVE A,FSMAX ;address above last piece of FS
MOVEM A,FSBIG ;place to start looking for FS
PUSH P,C
PUSH P,D
PUSH P,TT ;negative amount of free FS we want to collect
PUSHJ P,FSLSCN ;search FS down from top for amt free indicated by TT
JFCL ;SHOULDN'T HAPPEN UNLESS CORE LOCKED
POP P,T ;amount we wanted
CAME TT,T ;skip if we didn't find any at all
PUSHJ P,FSLSHF ;shuffle down to collect whatever free we found
POP P,D
POP P,C
POPJ P,
CMPACT: MOVN TT,FSFREE
JUMPE TT,CPOPJ
PUSH P,A
PUSHJ P,CRUNCH
JRST POPAJ
;ENDSET ENDSE2 ENDFIX
;Routine to allow us to continuously expand core chopping FS blocks off the top
ENDSET: SKIPE FSEND1
PUSHJ P,TELLZ ;Oops, we are already expanding core!!!
TLNE F,NOSHUF
JRST ENDSE2 ;Can't compact FS right now
MOVE A,FSMAX
SKIPL TT,-1(A)
MOVEI TT,
SUB TT,FSFREE
HRREI TT,200(TT) ;Don't compact FS unless we can get at least
JUMPGE TT,ENDSE2 ; 200 words out of the middle
PUSHJ P,CRUNCH
ENDSE2: MOVE A,FSMAX
SKIPGE T,-1(A)
SUBI A,(T)
MOVEM A,FSEND#
MOVEM A,FSEND1# ;Save starting place of core expansion
JUMPGE T,CPOPJ
MOVNI T,(T)
ADDM T,FSFREE
POPJ P,
;Routine to terminate condition set up by ENDSET (above).
ENDFIX: MOVEI TT,
EXCH TT,FSEND1 ;Zero here means we are not expanding core
JUMPN TT,.+2
PUSHJ P,TELLZ ;Oops, we weren't expanding core!!!
TLO F,FSCHKF ;Make sure FSCHK is run
MOVE T,FSEND
SUB T,TT ;Amount of core used up by expanding
ADDM T,FSUSE
ADD T,TT
MOVEM T,FSMAX
CAMLE T,JOBREL
POPJ P,
CAMN TT,FSBEG
MOVEM T,FSBEG
MOVE T,JOBREL
AOJ T,
MOVEM T,FSMAX
SUB T,FSEND
HRROM T,@FSEND
HRROM T,@JOBREL
ADDM T,FSFREE
POPJ P,
;FSCHK FSCHK1 FCLUP1 FCLUP2 FCFR FCDON
IFN DEBSW<
FSCHK: MOVE A,FSMAX
SOJ A,
CAME A,JOBREL
STOPJ ;Fatal error
FSCHK1: SETZB D,E
MOVE A,FSMIN
FCLUP1: CAMN A,FSBEG
JRST FCLUP2
CAML A,FSMAX
STOPJ
SKIPGE T,(A)
STOPJ
PUSHJ P,FUCHK
AOJA B,FCLUP1
FCLUP2: CAMN A,FSMAX
JRST FCDON
CAMLE A,FSMAX
STOPJ
SKIPGE T,(A)
JRST FCFR
PUSHJ P,FUCHK
AOJA B,FCLUP2
FCFR: HLRZ TT,T
CAIE TT,-1
STOPJ
ADDI A,(T)
MOVE TT,-1(A)
CAME TT,T
STOPJ
ADDI E,(T)
JRST FCLUP2
FCDON: CAME D,FSUSE
STOPJ
CAME E,FSFREE
STOPJ
IFE PURESW,<
SKIPL PURFLG
POPJ P,
PUSH P,B
PUSHJ P,PURCHK
POP P,B
>;NOT PURESW
JRST POPJ1
;FUCHK MOVIT MOVTX
FUCHK: XCT @-1(P)
HLRZ TT,T ;get left half of FS header: use code plus bits
TRZ TT,LOKBIT ;allow for locked-down FS block
CAIL TT,MXSHF ;check use-type code for validity
STOPJ ;illegal use code
ADDI A,(T) ;add length to FS origin, making next block's origin
HLRZ TT,-1(A) ;get LH of ending FS word
CAMLE TT,JOBREL ;can be a pointer to some data (used in PMLNBR not as ptr!)
STOPJ ;out of range
HRRZ TT,-1(A) ;get length from FS trailer
CAIE TT,(T) ;better match length in FS header
STOPJ ;lengths don't match
ADDI D,(T) ;count some more FS checked
POPJ P,
MOVIT: TLNE F,NOSHUF
POPJ P,
SETCMB T,MVPHAZ#
JUMPGE T,CMPACT
PUSH P,A
PUSH P,C
PUSH P,D
MOVE A,FSMIN
MOVEM A,FSBIG
MOVN TT,FSFREE
JUMPE TT,MOVTX
PUSHJ P,FSHSCN
JFCL
ADD TT,FSFREE
JUMPLE TT,MOVTX
PUSHJ P,FSHSHF
MOVTX: POP P,D
POP P,C
JRST POPAJ
;PURINI PLCHK PL2CHK PLCHKL PLSCN0 PLSCN PLSCN1 PLSCN2 PLSCN3
IFE PURESW,<
PURINI: JSP G,PLCHK
MOVEM A,PLCHK1
MOVEM B,PLCHK2
JSP G,PLSCN0
MOVEM A,PURCK
MOVSI H,-ADRSIZ
JSP G,PLSCN
MOVEM A,PURCK+1(H)
AOBJN H,.-2
SETOM PURFLG
SKIPE A,JOBDDT
TLNN A,-40
JRST (E)
MOVE A,-6(A) ;$I
HRLI A,(<JSR>)
MOVEM A,BPTINS
JRST (E)
PLCHK: MOVEI TT,PURLST
PL2CHK: SETZB A,B
PLCHKL: XOR A,(TT)
XOR B,-1(TT)
MOVEI T,(TT)
HRRZ TT,(TT)
CAIGE TT,(T)
JUMPN TT,PLCHKL
JRST (G)
PLSCN0: TDZA H,H
PLSCN: MOVEI B,@BITTAB+44-ADRSIZ(H)
MOVEI TT,PURLST
MOVEI A,
PLSCN1: HLRZ T,(TT)
HRLI T,1(T) ;ALLOW FOR CARRY
SUBI T,1(TT)
MOVS T,T
JUMPL H,PLSCN3
XOR A,(T)
AOBJN T,.-1
PLSCN2: HRRZ TT,-1(T)
JUMPN TT,PLSCN1
JRST (G)
PLSCN3: TRNE T,(B)
XOR A,(T)
AOBJN T,PLSCN3
JRST PLSCN2
;PURCHK PURCH1 PURCH2 PURCH3
PURCHK: JSP G,PLCHK
CAMN A,PLCHK1
JUMPE TT,PURCH1
MOVEI TT,PURLST-1
JSP G,PL2CHK
CAMN A,PLCHK2
JUMPE TT,PURCH4
FATAL BOTH PURE LISTS CLOBBERED
PURCH1: CAME B,PLCHK2
JRST PURCH7
PURCH2: JSP G,PLSCN0
CAMN A,PURCK
POPJ P,
MOVE C,A
XOR C,PURCK
MOVEI D,
MOVSI H,-ADRSIZ
PURCH3: JSP G,PLSCN
CAMN A,PURCK+1(H)
JRST .+4
XOR A,C
IORI D,(B)
CAMN A,PURCK+1(H)
AOBJN H,PURCH3
CAIGE D,ENDPUR
JUMPGE H,.+2
FATAL MULTIPLE LOCATIONS CLOBBERED
XOR C,(D)
MOVE T,(D)
CAME T,BPTINS
CAMN C,BPTINS
JRST PURCLC
PUSH P,TYOPNT
SETZM TYOPNT
OUTSTR [ASCIZ /
LOC /]
TYPOCT D
OUTSTR [ASCIZ / was clobbered from /]
MOVE T,C
PUSHJ P,TYPHW
OUTSTR [ASCIZ / to /]
MOVE T,(D)
PUSHJ P,TYPHW
POP P,TYOPNT
MOVEM C,(D)
TRO F,DSPALL
OUTSTR [ASCIZ /
It's fixed. Go on?/]
PUSHJ P,YESCHK
POPJ P, ;Yes
JRST 4,.-3
;PURCH4 PURCH5 PURCH6 PURCH7 PURCLC TYPHW TYPHW2 PURCK PLCHK1 PLCHK2 PURFLG BPTINS LOGFIL SAVFIL
PURCH4: MOVEI TT,PURLST-1
MOVEI A,1
PURCH5: MOVSI B,TT
HRRI B,(A)
PURCH6: MOVE T,(TT)
TRNE T,-1
ADD T,A
MOVEM T,@B
HRRZ TT,(TT)
JUMPN TT,PURCH6
JRST PURCH2
PURCH7: MOVEI TT,PURLST
MOVNI A,1
JRST PURCH5
PURCLC: SKIPN PURFLG
POPJ P,
FOR X IN(A,B,E,PURFLG)<PUSH P,X↔>
JSP E,PURINI
POP P,PURFLG
POP P,E
JRST POPBAJ
TYPHW: HLRZ TT,T
JUMPE TT,TYPHW2
TYPOCT TT
TYPCHR ","
TYPCHR ","
TYPHW2: MOVEI TT,(T)
TYPOCT TT
POPJ P,
IMPURE
PURCK: BLOCK ADRSIZ+1
PLCHK1: 0
PLCHK2: 0
PURFLG: 0
BPTINS: 0
LOGFIL: SIXBIT /ELOSERDMP )( S FW/
SAVFIL: SIXBIT /ELOSERFIL )( S FW/
PURE
>;NOT PURESW
;CHECK CHECK1 CHECK2
CHECK: MOVEI B,
PUSHJ P,FSCHK
JFCL
MOVEM B,FSCNT#
SKIPG CHKMOD
JRST CHECK2
PUSHJ P,CHECK2
PUSHJ P,MOVIT
PUSHJ P,CHECK1
PUSHJ P,MOVIT
CHECK1: MOVEI B,
PUSHJ P,FSCHK
JFCL
CAME B,FSCNT
STOPJ
CHECK2: ADD B,JOBREL
CORE B,
PUSHJ P,TELLZ
MOVE B,FSMAX
MOVEM B,FSPNT#
PUSHJ P,FSCHK1
HRLZM A,(B)
MOVN B,FSCNT
HRLZ B,B
HRR B,FSPNT
AOBJP B,.+3
HRRM B,-1(B)
AOBJN B,.-1
PUSHJ P,CHKDIR ;check directory list
PUSHJ P,CHKPAG ;check text list
PUSHJ P,CHKATT ;check attach buffer
SKIPE FSPNT
STOPJ
MOVE B,FSMAX
SOJ B,
CORE B,
PUSHJ P,TELLZ
POPJ P,
;CHKDIR CHKDPL CDDSP
;Check directory list for consistency
CHKDIR: MOVEI A,DIR ;start out with directory hdr
SETZM CHKCNT#
SETZM CHKTMP# ;word starting address of last page we've seen
MOVEI DSP,CDDSP
MOVSI H,NSPEC+LSPC+DSPC
MOVNI D,1 ;previous page number (dir hdr is for page 0)
PUSHJ P,CHKDR4 ;check record ptr and flags for directory header
MOVN D,PAGES
HRLZ D,D ;make aobjn counter for pages
PUSHJ P,CHKDR1 ;check each known page
AOBJN D,.-1
HRRZ T,(A)
CAIE T,DIREND
PUSHJ P,TELLD
MOVSI T,(A)
CAME T,DIREND
PUSHJ P,TELLD
TLNE DSP,D1BIT
TLNN DSP,DPBIT
PUSHJ P,TELLD
MOVE T,CHKCNT
ADD T,DIROVH
CAME T,DIRSIZ
PUSHJ P,TELLD
MOVEI A,DIREND
PUSHJ P,CHKD4A
SKIPN DPLST ;now check deleted-pages list, if any
POPJ P,
MOVEI A,DPLST
SETZM CHKTMP ;word starting address of last page we've seen
CHKDPL: PUSHJ P,CHKDR1
HRRZ T,(A)
CAIE T,DPLST
JRST CHKDPL
HLRZ T,DPLST
CAIE T,(A)
PUSHJ P,TELLD
POPJ P,
CDDSP: PUSHJ P,TELLD ;null
PUSHJ P,TELLD ;rubout
JRST CHKDR3 ;CR
PUSHJ P,TELLD ;LF
JFCL ;TAB
PUSHJ P,TELLD ;FF
PUSHJ P,TELLD ;ALT
PUSHJ P,TELLD ;misc
PUSHJ P,TELLD ;⊗;
;CHKDR1 CHKDR2 CHKDR3 CHKDR4 CHKD4A
CHKDR1: PUSHJ P,CHKLST ;advance to next directory entry, check ptrs
HLRZ T,-1(A) ;get FS type from FS hdr
CAIE T,DIRCOD ;better be directory type
PUSHJ P,TELLD ;oops
PUSHJ P,CHKDR4 ;check record ptr and flags for this page
TLZ E,RPMASK ;clear inserted relative page number field
TDNE E,[-1000] ;skip if no spurious flags on, text not too big
PUSHJ P,TELLD ;oops (hmm, 1000 chars seems arbitrary)
MOVEI T,DIRXTR(E) ;amt of space this line will take on dir page
ADDM T,CHKCNT ;update nbr of chars accounted for so far
MOVSI G,440700 ;make byte ptr
HRRI G,LPDESC(A) ; to dir line text
CHKDR2: GETCH2 H,G
SOJG E,CHKDR2 ;loop unless char count runs out
PUSHJ P,TELLD ;ran out before CR seen
CHKDR3: ILDB C,G ;here when CR seen in dir line
CAIE C,12 ;next char should be LF
PUSHJ P,TELLD ;oops
ILDB C,G ;and then next
CAIN C,177 ; should be rubout, and char count
CAIE E,2 ; should be 2 (for LF and rubout)
PUSHJ P,TELLD ;oops
HRRZ T,-1(A) ;get length of block from FS hdr word
ADDI T,-3(A) ;add to block address, minus 3 (FS hdr/trlr, link)
CAIE T,(G) ;and that should be where byte ptr ended
PUSHJ P,TELLD ;oops
POPJ P,
CHKDR4: PUSHJ P,CHKD4A ;check word/record ptr for this page
MOVE E,DIRFLG(A) ;get flags,,dir line text length
JSP B,CHKPNT ;make sure these three things are consistent
D1BIT,,
DIRP1
FIRPAG
TLZN E,DPBIT ;is this the last page in core?
POPJ P, ;no, forget it
TLNN DSP,D1BIT ;yes, then should have seen 1st page in core
PUSHJ P,TELLD ;oops
JSP B,CHKPN2 ;make sure these three things are consistent
DPBIT,,
DIRPT
CURPAG
POPJ P,
CHKD4A: SKIPN T,DIRREC(A) ;get record nbr for page, if any
POPJ P,
ROT T,7 ;rotate word offset into low 7 bits of RH
TLZ T,¬177 ;clear LH except low 7 bits just rotated in
CAMGE T,CHKTMP ;word locations of pages better be non-decreasing
PUSHJ P,TELLD ;oops
MOVEM T,CHKTMP ;remember latest page's word address
POPJ P,
;CHKLST CHKFSL CHKFS2 CHKPNT CHKPN2
;check ptrs in list, advance ptr in A to next element in list
CHKLST: MOVEI B,(A) ;save current ptr
HRRZ A,(A) ;get next
HLRZ T,(A) ;get prev of that next
CAIE T,(B) ;should be same as original
STOPJ ;oops
HRLOI T,-2(A) ;get adr of prev FS blocks trlr word in LH, -1 in RH
MOVEI C,FSPNT
SKIPN B,FSPNT
STOPJ
CHKFSL: CAMG T,(B)
JRST CHKFS2
MOVEI C,(B)
HRRZ B,(B)
JUMPN B,CHKFSL
STOPJ
CHKFS2: HLRZ T,(B)
CAIE T,-1(A)
STOPJ
HRRZ T,(B)
HRRM T,(C)
POPJ P,
CHKPNT: TDZN E,(B) ;if this bit (e.g., D1BIT) is off
JRST 3(B) ; nothing to check, return
CHKPN2: CAMN A,@1(B) ;else this ptr should match current FS block being checked
TDOE DSP,(B) ; and we shouldn't have seen this bit before (e.g., D1BIT)
STOPJ ;oops
MOVEI T,1(D)
CAME T,@2(B)
STOPJ
JRST 3(B) ;return past inline parameters
;CHKPAG CHKPGP
CHKPAG: MOVEI A,PAGE
SETZM CHKCNT
MOVEI DSP,CPDSP
MOVSI H,NSPEC+LSPC
MOVN D,LINES
JUMPE D,.+3
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,BOTSTR
PUSHJ P,TELLZ
HLRZ T,BOTSTR
CAIE T,(A)
PUSHJ P,TELLZ
MOVEI A,BOTSTR
MOVE E,BOTSTR+TXTFLG
PUSHJ P,CHKPGP
JUMPN E,[PUSHJ P,TELLZ]
SKIPN WINLIN
SKIPL BOTWIN
TLNE DSP,WINBIT
TLNN DSP,ARRBIT
PUSHJ P,TELLZ
MOVE A,CHKCNT
MOVE T,FIRPAG
SOJG T,[AOJA A,.+1]
CAME A,CHARS
PUSHJ P,TELLZ
POPJ P,
CHKPGP: JSP B,CHKPNT
ARRBIT,,
ARRLIN
ARRL
JSP B,CHKPNT
WINBIT,,
WINLIN
TOPWIN
POPJ P,
;CHKPG1 CHKPG2 CPDSP CHKPGT CHKPTL
CHKPG1: PUSHJ P,CHKLST
HLRZ T,-1(A)
CAIE T,TXTCOD
PUSHJ P,TELLZ
SKIPGE E,TXTFLG(A)
PUSHJ P,TELLZ
PUSHJ P,CHKPGP
TLNE E,-1
PUSHJ P,TELLZ
MOVE E,TXTCNT(A)
HLRZ T,E
ADDM T,CHKCNT
MOVSI G,440700
HRRI G,LLDESC(A)
MOVEI B,
TRNE E,777777
JRST CHKPG2
ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
CHKPG2: GETCH2 H,G
SUB E,[1,,1]
JUMPLE E,[PUSHJ P,TELLZ]
AOJA B,CHKPG2
;Dispatch table for checking incore page text
CPDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST CHKPG3 ;CR
PUSHJ P,TELL3 ;LF
JRST CHKPGT ;TAB
PUSHJ P,TELL5 ;FF
JFCL ;ALT (formerly TELL6)
CHKPGT: SUBI E,1000
HRL B,B
TLO B,-10
CHKPTL: ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
SOJLE E,[PUSHJ P,TELLZ]
AOBJN B,CHKPTL
ILDB C,G
CAIE C,11
PUSHJ P,TELLZ
JRST CHKPG2
;CHKPG3 CHKPG4 CHKPG5 CHKPG6
CHKPG3: ILDB C,G
CAIE C,12
PUSHJ P,TELLZ
CHKPG4: TLNN A,760000
JRST CHKPG5
ILDB C,G
JUMPE C,CHKPG4
PUSHJ P,TELLZ
CHKPG5: CAIE E,2000
PUSHJ P,TELLZ
HRRZ T,-1(A) ;get block length from FS hdr
ADDI T,-3(A) ;add to FS adr, minus 3 (FS hdr/trlr, link word)
SKIPGE TXTFLG(A) ;skip unless this is a pagemark line
SUBI T,PMXTRA ;pagemark line has this many extra words at end
CAIE T,(G) ;this should be where the byte ptr ended
PUSHJ P,TELLZ ;oops
SUBM A,G
MOVSI G,LLDESC-1(G)
HRRI G,LLDESC(A)
MOVEI T,1
CHKPG6: TDNN T,(G)
PUSHJ P,TELLZ
AOBJN G,CHKPG6
AOBJN D,CHKPG1
POPJ P,
;CHKATT CHKNAT SHFMOD CHKMOD
CHKATT: TRNN F,ATTMOD
JRST CHKNAT
SETZM CHKCNT
MOVEI A,ATTBUF
MOVE DSP,[ARRBIT!WINBIT,,CPDSP]
MOVSI H,NSPEC+LSPC
MOVN D,ATTNUM
JUMPE D,[PUSHJ P,TELLZ]
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,ATTBUF
PUSHJ P,TELLZ
HLRZ T,ATTBUF
CAIE T,(A)
PUSHJ P,TELLZ
MOVE T,CHKCNT
CAME T,ATTSIZ
PUSHJ P,TELLZ
POPJ P,
CHKNAT: SKIPE ATTNUM
PUSHJ P,TELLZ
POPJ P,
IMPURE
SHFMOD: 0
CHKMOD: 0
PURE
>;DEBSW
;CTAB 0-37
ED←←EDOK*5 EDCMD←←EDOK*7 EDDBL←←EDOK*17
COMMENT ⊗ CTAB is Fred's clever way of keeping track of the character
flags associated with each character (in the left half-word) and of
providing the relative address of the proper location in the CMDSP
(command dispatch) table, which is accessed by loading the DSP register
with the location of the first entry. CMDSP, in turn, contains, 1)
additional flags in the left half-word (in some cases) that further
delimit the use of the command and 2) addresses in the right half to
the appropiate code. In the case of <cr> the reference is doubly
indirect and CMDSP contains the location of yet another table CRDSP,
which is indexed on B to find still other flags and code locations
for the 4 cases depending on the CONTROL and META bits associated
with the <cr> when used.
Symbols beginning with % (thus %A) are numerically defined in terms
of the location in the CMDSP table of the associated command for the
rest of the symbol (in this case A) so as to identify the command and
its flags. Fred does this with the CC macro in CMDSP on page 16.
Clever!, but confusing until one knows what is happening. ⊗
CTAB: NSPEC,,(DSP) ;NUL 0
ED,,%DA(DSP) ;↓ 1
ED,,7(DSP) ;α 2
ED,,7(DSP) ;β 3
SSP2!ED,,12(DSP) ;∧ 4
SSP1!ED,,13(DSP) ;¬ 5
ED,,%EPSIL(DSP) ;ε 6
ED,,%PI(DSP) ;π 7
ED,,%LAMBDA(DSP) ;λ 10
LSPC!EDCMD,,4(DSP) ;TAB 11
LSPC,,3(DSP) ;LF 12
%VT(DSP) ;VT 13
SSP1!LSPC,,5(DSP) ;FF 14
SSP1!FSPC!LSPC,,2(DSP) ;CR 15
SSP1!ED,,21(DSP) ;∞ 16
FSPC!ED,,%MSG(DSP) ;∂ 17
SSP1!ED,,14(DSP) ;⊂ 20
SSP2!ED,,15(DSP) ;⊃ 21
ED,,%INTER(DSP) ;∩ 22
ED,,%UNION(DSP) ;∪ 23
SSP1!ED,,16(DSP) ;∀ 24
ED,,%EXIST(DSP) ;∃ 25
DSPC!ED,,10(DSP) ;⊗ 26
ED,,%PARB(DSP) ;↔ 27
LT2F!ED,,%UNDER(DSP) ;_ 30
FSPC!ED,,%RA(DSP) ;→ 31
IFE DECSW,<
ED,,%TILDE(DSP) ;TILDE 32
ED,,%NOTEQ(DSP) ;NOT EQ 33
>
IFN DECSW,<
ED,,%NOTEQ(DSP) ;NOT EQ 32
LSPC,,6(DSP) ;ALTMOD 33
>
ED,,%LE(DSP) ;≤ 34
ED,,%GE(DSP) ;≥ 35
SSP1!ED,,17(DSP) ;≡ 36
SSP2!ED,,20(DSP) ;∨ 37
;CTAB 40-77
EDDBL,,7(DSP) ;SP 40
ED,,%EXCL(DSP) ;! 41
ED,,7(DSP) ;" 42
ED,,%LBS(DSP) ;# 43
LT2F!ED,,%DOL(DSP) ;$ 44
LT2F!ED,,%PER(DSP) ;% 45
ED,,%AMP(DSP) ;& 46
ED,,7(DSP) ;' 47
FSPC!ED,,%PARL(DSP) ;( 50
FSPC!ED,,%PARR(DSP) ;) 51
ED,,%ASTER(DSP) ;* 52
ED,,%PLS(DSP) ;+ 53
FSPC!ED,,7(DSP) ;, 54
ED,,%MIN(DSP) ;- 55
FSPC!ED,,%.(DSP) ;. 56
FSPC!ED,,%SLASH(DSP) ;/ 57
NUMF!ED,,11(DSP) ;0 60
NUMF!ED,,11(DSP) ;1 61
NUMF!ED,,11(DSP) ;2 62
NUMF!ED,,11(DSP) ;3 63
NUMF!ED,,11(DSP) ;4 64
NUMF!ED,,11(DSP) ;5 65
NUMF!ED,,11(DSP) ;6 66
NUMF!ED,,11(DSP) ;7 67
NUMF!ED,,11(DSP) ;8 70
NUMF!ED,,11(DSP) ;9 71
FSPC!ED,,%COLON(DSP) ;: 72
FSPC!DSPC!ED,,10(DSP) ;; 73
ED,,%LT(DSP) ;< 74
ED,,%EQ(DSP) ;= 75
ED,,%GT(DSP) ;> 76
FSPC!ED,,%QUERY(DSP) ;? 77
;CTAB 100-137
ED,,7(DSP) ;@ 100
LETF!ED,,%A(DSP) ;A 101
LETF!ED,,%B(DSP) ;B 102
LETF!ED,,%C(DSP) ;C 103
LETF!EDCMD,,%D(DSP) ;D 104
LETF!ED,,%E(DSP) ;E 105
LETF!ED,,%F(DSP) ;F 106
LETF!ED,,%G(DSP) ;G 107
LETF!ED,,%H(DSP) ;H 110
LETF!EDCMD,,%I(DSP) ;I 111
LETF!ED,,%J(DSP) ;J 112
LETF!EDCMD,,%K(DSP) ;K 113
LETF!ED,,%L(DSP) ;L 114
LETF!ED,,%M(DSP) ;M 115
LETF!ED,,%N(DSP) ;N 116
LETF!ED,,%O(DSP) ;O 117
LETF!ED,,%P(DSP) ;P 120
LETF!ED,,%Q(DSP) ;Q 121
LETF!EDCMD,,%R(DSP) ;R 122
LETF!EDCMD,,%S(DSP) ;S 123
LETF!ED,,%T(DSP) ;T 124
LETF!ED,,%U(DSP) ;U 125
LETF!ED,,%V(DSP) ;V 126
LETF!ED,,%W(DSP) ;W 127
LETF!ED,,%X(DSP) ;X 130
LETF!ED,,%Y(DSP) ;Y 131
LETF!ED,,%Z(DSP) ;Z 132
FSPC!ED,,7(DSP) ;[ 133
FSPC!ED,,%BSLAS(DSP) ;\ 134
FSPC!ED,,7(DSP) ;] 135
ED,,%UA(DSP) ;↑ 136
FSPC!ED,,%LA(DSP) ;← 137
;CTAB 140-177
ED,,7(DSP) ;` 140
LETF!LT2F!ED,,%A(DSP) ;a 141
LETF!LT2F!ED,,%B(DSP) ;b 142
LETF!LT2F!ED,,%C(DSP) ;c 143
LETF!LT2F!EDCMD,,%D(DSP) ;d 144
LETF!LT2F!ED,,%E(DSP) ;e 145
LETF!LT2F!ED,,%F(DSP) ;f 146
LETF!LT2F!ED,,%G(DSP) ;g 147
LETF!LT2F!ED,,%H(DSP) ;h 150
LETF!LT2F!EDCMD,,%I(DSP) ;i 151
LETF!LT2F!ED,,%J(DSP) ;j 152
LETF!LT2F!EDCMD,,%K(DSP) ;k 153
LETF!LT2F!ED,,%L(DSP) ;l 154
LETF!LT2F!ED,,%M(DSP) ;m 155
LETF!LT2F!ED,,%N(DSP) ;n 156
LETF!LT2F!ED,,%O(DSP) ;o 157
LETF!LT2F!ED,,%P(DSP) ;p 160
LETF!LT2F!ED,,%Q(DSP) ;q 161
LETF!LT2F!EDCMD,,%R(DSP) ;r 162
LETF!LT2F!EDCMD,,%S(DSP) ;s 163
LETF!LT2F!ED,,%T(DSP) ;t 164
LETF!LT2F!ED,,%U(DSP) ;u 165
LETF!LT2F!ED,,%V(DSP) ;v 166
LETF!LT2F!ED,,%W(DSP) ;w 167
LETF!LT2F!ED,,%X(DSP) ;x 170
LETF!LT2F!ED,,%Y(DSP) ;y 171
LETF!LT2F!ED,,%Z(DSP) ;z 172
ED,,7(DSP) ;LFT BRACE 173
SSP1!ED,,22(DSP) ;| 174
IFE DECSW,<
LSPC,,6(DSP) ;ALT-MODE 175
ED,,7(DSP) ;RT BRACE 176
>
IFN DECSW,<
ED,,7(DSP) ;RT BRACE 175
ED,,%TILDE(DSP) ;TILDE 176
>
NSPEC,,1(DSP) ;RUBOUT 177
NSPEC,,-1(DSP) ;SEE RDPAG1, also XWRDSP
;GETDIR DIRSOS DIRSO2
GETDIR: MOVEI DSP,GDDSP ;Basic dispatch table used for reading directory
FOR X IN (DIR,XDIRFG,PAGES,FIRPAG,CURPAG,RLDRUB,SOSBIN#,SOSLIN#,SOSLI2#,SOSPAG#)<SETZM X↔>
HRRZ T,SRCFIL
CAIE T,EDFIL ;Are we trying to edit the source file?
TLOA F,TF2 ;No, suppress action by PRORED
TLZ F,TF2 ;Yes, let PRORED do its stuff if called
MOVEI T,XDIRCH
MOVEM T,DIROVH
MOVEM T,DIRSIZ
SETZM EDIRSZ ;no extended part of directory detected yet
PUSHJ P,ENDSET
MOVSI G,NSPEC+LSPC+NUMF ;For XCT @CTAB(C) on NUL,RUB,CR,LF,TAB,FF,ALT,digits
MOVE H,INPNT
SETZB A,Q
MOVE B,[440700,,[ASCIZ /COMMENT ⊗ xxVALID PAGES/]]
MOVE D,[160700,,Q]
ILDB C,H ;First character
SKIPGE CTAB(C) ;Dispatch on NULL, RUBOUT, 200. Sign bit is NSPEC.
XCT @CTAB(C) ;Special LINE-EDIT case
PUSHJ P,DIRSOS ;Check for SOS line number starting dir line
JRST DIRCL1 ;Continue reading directory beginning
JRST DIRCL ;Found line number, now read 1st real char
;Check beginning of dir line for SOS line number and skip if found one.
DIRSOS: MOVE T,(H)
AND T,[BYTE (7)160,160,160,160,160(1)1]
CAMN T,[ASCID /00000/]
JRST DIRSO2
CAME T,[ASCID / /]
POPJ P, ;No line number
DIRSO2: HLLOS @SRCFIL+4 ;Signal non-normal directory case
HRRZM P,NOT1PG ;With SOS line numbers, no free one-page /N
AOJA H,POPJ1 ;Advance byte pointer past line number and tab
;DIRCL2 DIRCL DIRCL1 GETD1A
DIRCL2: IDPB C,D
DIRCL: GETCH2 G,H ;Read character (checked for specials and digits)
DIRCL1: ILDB E,B ;Get expected character into E
CAIN C,(E)
JRST DIRCL ;It checks so try next
CAIN E,"x"
JRST DIRCL2
JUMPN E,DIR1PG ;Jump if didn't match entire expected dir start
MOVEI D,DIR
CAIN Q," "
JRST .+3
CAIE Q,"IN"
JRST NODIR ;Neither " VALID" nor "INVALID" directory
JUMPE A,NODIR ;A contains any number encountered (number of pages)
CAIE Q," "
HLLOS @SRCFIL+4 ;Flag invalid directory
MOVEM A,PAGES ;Save number of pages indicated by directory.
MOVNI B,(A) ;Now we will read directory lines, one per page.
CAIE C," "
TDZA E,E
MOVE E,[440700,,VBUF]
MOVSI G,LSPC!NSPEC ;For XCT @CTAB(C) ON NULL,RUBOUT,CR,LF,TAB,FF,ALT
MOVNI T,1
JSP TT,LSKP2 ;Get to end of first line, perhaps saving in VBUF.
JUMPE E,GETD1A ;LF will dispatch to here via (TT)
IDPB C,E ;Must have had some version stuff.
MOVEI C,177 ;Marks its end.
IDPB C,E
CAMN E,[100700,,VBUF] ;Skip unless version stuff really not significant.
GETD1A: SETZB T,VBUF
ADDB T,DIROVH ;Count version stuff in directory overhead.
MOVEM T,DIRSIZ
JSP TT,LSKP1 ;Now skip second line of directory (titles)
MOVE E,FSEND ;Put directory at end of free storage.
MOVEI TT,DIRLF ;Place LF will dispatch for main part of directory.
;DIRLIN DIRLN0 DIRLN2 DIRLUP DIRLF FINDI0 FINDIR FINDI2 FINDI3 NOBLOA XDIRNX XDIRLN XDIRIL XDRDSP XDCRLF XDCRL2 XDIRFF XDIRF1 DIRLF1 DIRLF2 GDIRX
;The code that actually checks up on the directory page
DIRLIN: GETCH2 G,H ;Skip C (or space) at beginning of dir line
PUSHJ P,DIRSOS ;Check for SOS line number on directory line
JRST DIRLN0 ;No line number
GETCH2 G,H ;Get real 1st char after line number
DIRLN0: MOVEI A, ;A will hold the collected record number.
MOVSI G,NSPEC+LSPC+NUMF
GETCH2 G,H ;Read record number.
DIRLN2: MOVEI E,1(E)
HRRM E,(D) ;Make previous line/page (or DIR) point to this one.
LEG HRLZM D,(E) ;And store backward pointer.
MOVEI D,(E) ;Advance to the new line/page entry.
LEG MOVEM A,DIRREC(D) ;Store record number for page.
ADD E,[440700,,LPDESC] ;Byte pointer for text
MOVSI G,NSPEC+LSPC ;Only specials are NULL,RUB,CR,LF,TAB,FF,ALT
REPEAT 5,<GETCH2 G,H> ;Skip page number (5 digits)
MOVEI Q,1 ;Count char in text, allowing here for the LF
DIRLUP: GETCH2 G,H
LEG IDPB C,E ;Collect text of line
AOJA Q,DIRLUP ; and count length
DIRLF: ;Here from LF at end of directory line.
LEG IDPB C,E ;Put LF into text.
MOVEI C,177 ;Followed by rubout.
LEG IDPB C,E
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T
HRRZM Q,DIRFLG(D) ;Store length of text part of directory line.
SETZM DIRWIN(D) ;clear the window ptr in directory entry
ADDM Q,DIRSIZ ;And include in directory size.
AOJL B,DIRLIN ;Have we done all pages in directory?
TRNE F,FILLUZ ;Yes
JRST GDIRX ;We've already been to NODIR -- just close off dir
GETCH2 G,H ;Get C for ENDMK line
MOVEM A,LSTPGR# ;Save record # for start of last page
PUSHJ P,DIRSOS ;Skip over any SOS line number
JRST FINDI0 ;No line number
GETCH2 G,H ;Really read C for ENDMK line
FINDI0: MOVEI A,
MOVSI G,NSPEC+LSPC+NUMF ;Special chars are: NULL,RUB,CR,LF,TAB,FF,ALT,DIGITS
GETCH2 G,H ;Collect record number of ENDMK
MOVEM A,DIREND+1 ; and store it.
MOVSI G,NSPEC ;RUBOUT, NULL
MOVE B,[POINT 7,[ASCIZ/ENDMK
C⊗;
/]]
FINDIR: GETCH2 G,H ;Get char from end of directory
FINDI2: ILDB E,B ;Get expected char
CAIN C,(E) ;Same?
JRST FINDIR ;Yes
CAIN E,"C" ;No. Permitted to differ?
JRST [ PUSHJ P,DIRSOS ;Check for SOS line number at beginning of line
JRST FINDI2 ;No line nbr, maybe TV file with no "C"
GETCH2 G,H ;Get real first char of line after line number
JRST FINDIR]
JUMPN E,NODIR ;No, jump if didn't match all the way to end.
CAIN C,14
JRST FINDI3 ;All ok
PUSHJ P,DIRSOS ;Check for SOS line number (blank) before FF
JRST NODIR ;No line number, so no FF at end of dir. Lose.
GETCH2 G,H ;Get real char after dir
CAIN C,14 ;Formfeed?
JRST FINDI3 ;Yes, dir ok
CAIE C,15 ;SOS puts a CR before the FF
JRST NODIR ;But no CR here, lose
GETCH2 G,H ;Last chance for an SOS pagemark
CAIE C,14 ;Better be a FF
JRST NODIR ;Directory not followed immediately by FF
;We have now verified that the directory is all there.
FINDI3: SKIPLE SBLOAT ;Are we gonna bloat this file?
JRST BLTDIR ;Yes (comes right back here if /R mode)
NOBLOA: SKIPE EDFIL-2 ;/F mode?
JRST IGNDIR ;Yes, tell user we're ignoring old dir
SKIPE @SRCFIL+4 ;Bad directory or /N indicated?
JRST BADDIR ;Yes
MOVE TT,DIR ;Pointer to 1st page
MOVE TT,(TT) ;Pointer to 2nd page
MOVE TT,DIRREC(TT) ;Record number where 2nd page is supposed to start.
CAMN TT,IBLK ;Reading correct record from file?
CAME H,[POINT 7,IBUF,6] ;And found FF at beginning of that record?
JRST LOSDIR ;No, bad directory.
;We have now verified that the directory is consistent and ends at the right place.
SUB A,FILLEN ;Compare reported length and real file length
SOJGE A,DIRLF1 ;Jump unless the file is longer than expected
;We have just discovered that the file is longer than the directory indicates
;so we will extend the directory (in core only at this point) provided that each
;subsequent FF occurs at the beginning of a record. The updated directory will
;be written out when any page of the file is to be actually written on the disk.
HRLZM A,XDIRFG ;Remember -<number of records added to file>
SOSG T,PAGES ;Uncount last page. MDFIX will count final pages.
JRST [ AOS PAGES ;Directory said only one page, so don't undo anything
MOVE E,FSEND ;Restore pointer to next block
ADD A,FILLEN ;Get back record number for start of page two.
AOJA A,XDIRNX]
MOVEI E,-1(D) ;Here we must undo the last FSFIX we did just above
MOVEM E,FSEND ;Reset pointers back to beginning of current FS blk
HLRZ D,(D) ;Back up back-pointer to previous blk
MOVN Q,Q
ADDM Q,DIRSIZ ;Uncount last page's directory line
SETZM EDIRSZ ;Prepare to count new dir lines' text
MOVE A,DIRREC+1(E) ;Get record number where last page starts
XDIRNX: HRRM T,XDIRFG ;Remember number of pages file used to have minus 1.
PUSHJ P,SETI ; and start reading file from there to check format
MOVEI DSP,XDRDSP ; new directory entries (lines) for new-found pages
MOVSI G,NSPEC ;RUBOUT and NULL are only specials
MOVE H,INPNT ;Byte pointer set up by SETI
GETCH2 G,H ;First char of page
CAIE C,14 ; better be a Formfeed
JRST UGHDIR ;Directory is useless
MOVSI G,NSPEC!LSPC!DSPC ;Now we check format of remainder of file and create
XDIRLN: MOVEI E,1(E) ;Pointer to forward/back pointers in FS blk
HRRM E,(D) ;Make previous blk point to this new one
LEG HRLZM D,(E) ;And make this one point back to previous one
MOVEI D,(E) ;Advance back pointer to this blk
MOVE T,IBLK ;Record number this page starts
LEG MOVEM T,DIRREC(D) ;Store record number in FS blk for this page
ADD E,[350700,,LPDESC] ;Make byte pointer to place for text of dir line
MOVSI T,(<BYTE (7)11>) ;Start dir line with a tab
LEG MOVEM T,(E)
MOVEI B,1 ;Count chars in directory line (already a tab there)
XDIRIL: GETCH2 G,H ;Char from first line of page
LEG IDPB C,E ;Place into directory line
;If we were gonna throw away "COMMENT" and "SUBTTL", we would do it here.
AOJA B,XDIRIL ;Loop till CR, LF, or FF
;Dispatch table for processing text in file extended beyond what dir knows about
XDRDSP: JSP C,[JRST -3(C)] ;NULL: Ignore, then get next char
PUSHJ P,RLD ;RUBOUT: Get more text if end of buffer
JUMPGE B,XDCRLF ;CR: Finish directory line if still on it
JUMPGE B,XDCRLF ;LF: Finish directory line if still on it
JFCL ;TAB
JRST XDIRFF ;FF: End of page
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
PUSHJ P,TELL7 ;misc not dispatched
JSP C,[JRST -3(C)] ;⊗ or ;--just ignore (don't put in dir line)
XDCRLF: MOVEI C,15
PUSHJ P,MDFIXE ;Put CRLF and 177 at end of dir line and do FSFIX
SETO B, ;Flag that we are not now generating dir line
XDCRL2: GETCH2 G,H ;Skip to next FF
JRST XDCRL2
XDIRFF: CAME H,[POINT 7,IBUF,6]
JRST UGHDIR ;FF found not at beginning of record, flush directory
JUMPL B,XDIRF1 ;Jump unless found FF in middle of dir line
MOVEI C,15
PUSHJ P,MDFIXE ;Finish up directory line
XDIRF1: TRNN F,EOF ;Was this FF really an EOF?
JRST XDIRLN ;No, go build next directory line
MOVE T,IBLK ;Yes, get record number for ENDMK
MOVEM T,DIREND+1 ; and store it
SOS SPAGE ;Directory page will be added to starting page later
PUSHJ P,GDIRX ;Finish directory and close up FS
TRO F,DIROK ;Directory all okay in core now, but not on disk
TRZ F,FILLUZ ;File formatted.
POPJ P,
DIRLF1: JUMPN A,SHTDIR ;Jump if file's length is not as expected
DIRLF2: SOS SPAGE ;Directory page will be added to starting page later
TRO F,DIROK ;Mark directory in core and okay
SKIPE @DSTFIL+4
TRO F,COPY
GDIRX: MOVEI E,DIREND
HRRM E,(D) ;Make last line/page entry point to ENDMK entry
HRLZM D,DIREND ;And vice versa backwards
PUSHJ P,ENDFIX ;Finish off free storage used for directory
MOVE T,PAGES
IMULI T,DIRXTR ;Chars/line for C00001 00001 stuff on directory.
ADDB T,DIRSIZ ;Include in size of directory.
MOVEM T,ODSIZ
SETZM DIREND+2
POPJ P,
;BLTDIR BLTDER BLTDE2 BLTDE3 IGNDIR UGHDIR SHTDIR LOSDIR BADDIR BADDI2 BADDI3 DIRFLS DIR1PG DIR1P3 DIR1P2 DIR1PL DIR1P4 DIR1P5 BADDI4 DELDIR NODIR PRORED
;Here for /X mode -- ignore old directory
BLTDIR: PUSHJ P,PRORED ;Force readonly mode if file write protected from us
SKIPE RDONLY
JRST BLTDE2 ;Not legal in /R mode
MOVEI T,<<0,,-1>⊗-7> ;Avoid making file bigger than 256K
SUB T,FILLEN ;Number of records to spare in the file
CAMLE T,FILLEN ;Don't let bloating make file more than twice as big
MOVE T,FILLEN ;Max bloating doubles size of file
IDIV T,PAGES ;Number of spare records per current page
JUMPLE T,BLTDER ;Jump if not enough room to expand every page
CAML T,SBLOAT ;User request more than room for?
JRST DELDIR ;No, give user what he asked for
MOVEM T,SBLOAT ;Yes, use max amount
PUSHJ P,ABCRLF
OUTSTR [ASCIZ ⊗Can't bloat as much as requested; will do /⊗]
SETZM TYOPNT
TYPDEC SBLOAT
OUTSTR [ASCIZ/X instead.
/]
JRST DELDIR
BLTDER: MOVEI TT,[ASCIZ/File too big to/]
JRST BLTDE3
BLTDE2: MOVEI TT,[ASCIZ ⊗In /R mode, file can't⊗]
BLTDE3: PUSHJ P,ABCRLF
OUTSTR (TT)
OUTSTR [ASCIZ ⊗ be bloated; /X ignored.
⊗]
SETOM SBLOAT ;Don't bloat after all
JRST NOBLOA
;Here for /F mode -- need to ignore old directory.
IGNDIR: PUSHJ P,PRORED ;Force readonly mode if file write protected from us
SKIPN RDONLY
JRST DELDIR ;In readwrite mode, just flush old dir
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /New directory is on page 0. Old INVALID directory starts on page 1.
/]
JRST NODIR ;Don't care about old directory
UGHDIR: MOVEI TT,[ASCIZ/File is longer than Directory indicates and extended part of file is
not properly formatted. File must be reformatted/]
SETZM XDIRFG ;Did not extend old directory after all.
MOVEI DSP,GDDSP ;Restore usual dispatch table for return to DIRLN2
JRST BADDI2
SHTDIR: PUSHJ P,PRORED ;Force readonly mode if file write protected from us
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /File is /] ;This should really say "FILENM.EXT[XYZ,ABC] is ".
SETZM TYOPNT
TYPDEC A ;Number of records file is short by.
MOVE A,FILLEN
AOJ A,
MOVEM A,DIREND+1
MOVEI TT,[ASCIZ / records shorter than directory indicates/]
JRST BADDI3 ;Figure out if he wants to flush old dir
LOSDIR: SKIPN PAGES
JRST NODIR
SKIPA TT,[-1,,[ASCIZ /Garbled directory/]]
BADDIR: HRROI TT,[ASCIZ /Invalid or undesired directory/]
BADDI2: PUSHJ P,PRORED ;Force readonly mode if file write protected from us
SKIPE QUIETF
JRST BADDI4 ;User said /Q (quiet) so don't ask or say anything
PUSHJ P,ABCRLF ;Get to left margin
BADDI3: OUTSTR (TT)
TRNN F,COPY ;If we're copying another file, ignore readonly flag
SKIPN RDONLY
JRST DIRFLS ;In readwrite mode, inquire about keeping old dir
JUMPL TT,.+2 ;Simplify some messages
OUTSTR [ASCIZ \.
Old directory\]
OUTSTR [ASCIZ \ kept as part of /R text.
\]
JRST NODIR
DIRFLS: OUTSTR [ASCIZ /.
Discard old directory text of /]
MOVEI D,@DSTFIL
TLO D,FRDRUN ;Suppress switches
PUSHJ P,FILTYP ;Type filename without switches
OUTSTR [ASCIZ/? /]
PUSHJ P,YESCHK
JRST DELDIR ;Yes (flush)
MOVE T,YESAVE
CAIE T,ALTMOD ;Skip if he said altmode to abort file edit
JRST NODIR
PUSHJ P,NODIR ;Close off expanding free storage for directory
JRST FNF2 ;Now go ask for another filename
DIR1PG: TRNN F,COPY ;If making a copy (FILE1←FILE2), no kludge needed
SKIPE QUIETF ; nor if user already gave /Q, meaning format w/dir
JRST DIR1P3 ; so disable one-page free /N
SKIPN EDFIL-2 ;If /F given, or
SKIPE RDONLY ; if already in readonly mode, then no kludge needed
DIR1P3: SETZM NOT1PG ; so prevent flag from being zero after next AOS
DIR1P2: AOSE NOT1PG ;Skip if want to try one-page free /N mode
JRST NODIR ;File has no directory, forget free /N
MOVSI G,NSPEC ;Special action on nulls and rubouts
JRST DIR1P4 ;Maybe the char we already have is a bad guy
DIR1PL: GETCH2 G,H ;Read character
DIR1P4: SKIPE RLDRUB ;If file has rubouts, then forget about free /N
JRST DIR1P5 ;No free /N for this one
CAIE C,14 ;Look for a FF (real one or EOF)
JRST DIR1PL ;Loop
TRNN F,EOF ;Skip if not a real FF (i.e., skip if one-page file)
DIR1P5: AOSA NOT1PG ;No free /N
SETOM RDONLY ;Force readonly mode temporarily
JRST NODIR
BADDI4: SKIPE RDONLY
JRST NODIR ;Readonly mode, don't force copying
DELDIR: SETOM @SRCFIL+4 ;Tell FORMAT to ignore old directory when making new one
SOS SPAGE ;Directory page will be added to starting page later.
TROA F,COPY
NODIR: HLLOS @SRCFIL+4
MOVEI D,DIR ;Ignore any directory FS we have generated
SETZM PAGES
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
SETZM EDIRSZ ;no extended part of directory detected yet
SETZM DIREND+1
SKIPN T,FSEND1 ;Get place where we started expanding FS
PUSHJ P,TELLZ ;Ugh! We already stopped expanding!!!!
MOVEM T,FSEND ;Pretend we haven't used up any yet
TRO F,FILLUZ ;Flag file as not formatted
TRZ F,UPDTXT ;Prevent BEG4A from outputting MAKDIR's new directory
PUSHJ P,PRORED ;If file is write protected from us, force readonly mode
SKIPN RDONLY
TROA F,COPY
JRST .+2 ;In readonly mode, we need at least one page of dir
JRST GDIRX
AOS PAGES
MOVE E,FSEND ;Now we go make a phony directory entry
MOVEI A,1 ;Record number to be stored for beginning of page 1
MOVEI B, ;This forces DIRLN2 not to look for more pages
MOVEI TT,DIRLF
MOVE H,[440700,,[ASCII /XXXXX
/]]
JRST DIRLN2
;Routine to force readonly mode if we try to edit a directoryless file
;that is write protected from us. Clobbers only T.
PRORED:
IFN DECSW,<
POPJ P, ;No-op routine for DEC version -- until PROCHK is done
>
IFE DECSW,<
TLON F,TF2 ;Have we checked this already, or are we prohibited from it?
SKIPE RDONLY ;Or are we already in readonly mode?
POPJ P, ;Yes to one of these
PUSHJ P,PROCHK ;Find out if file is write protected from us
SKIPN WRTPRO ;Is it write protected from us?
POPJ P,
SETOM RDONLY ;Yes, force readonly mode
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Forcing READONLY mode! /]
XCT PROXCT ;Tell him file is protected from him
JRST BEEPM2 ;Also beep him
>;NOT DECSW
;FLSDIR FLSDI2 DIRNUM GDDSP LSKP1 LSKP2A LSKP2 DIRSHF
FLSDIR: SETZM PAGES
SKIPN A,DIR
POPJ P,
TLO F,NOCHK ;Added by ALS, disable shuffling in FSGIVE
FLSDI2: HRRZ B,(A)
CAIE A,DIREND
PUSHJ P,FSGIVE
SKIPE A,B
JRST FLSDI2
TLZ F,NOCHK ;Added by ALS
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
SETZM EDIRSZ ;no extended part of directory detected yet
SETZM DIR
POPJ P,
DIRNUM: IMULI A,12
ADDI A,-"0"(C)
JRST -3(T)
;Dispatch table used by GETDIR for reading in the directory.
GDDSP: JSP C,[JRST -3(C)] ;null, just ignore
PUSHJ P,RLD ;rubout, maybe get more text
JFCL ;CR
JRST (TT) ;LF -- main character treated specially here
JFCL ;TAB
JRST LOSDIR ;FF in middle of directory is quite improper.
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
PUSHJ P,TELL7 ;misc -- not dispatched on
PUSHJ P,TELL8 ;⊗ or ; -- not dispatched on
JSP T,DIRNUM ;digit -- add to total and get next char
LSKP1: GETCH2 G,H
GETCH2 G,H
JRST LSKP1
LSKP2A: GETCH2 G,H
LSKP2: IDPB C,E
AOJA T,LSKP2A
;Here when shuffling a directory FS block. Block (A) of size (T) shuffled by (C).
DIRSHF: PUSHJ P,LSTSHF ;Fix neighbors' pointers in directory list
MOVE TT,DIRWIN+1(A) ;get window ptr
TRNN TT,-1 ;skip if ptr is there
MOVEI TT,WINDAT ;must be current window
SKIPGE T,DIRFLG+1(A) ;get flags, skip if DPBIT off
ADDM C,DIRPT-WINDAT(TT) ;Just moved dir FS for last incore page--fix ptr
TLNE T,D1BIT
ADDM C,DIRP1-WINDAT(TT) ;Just moved dir FS for first incore page--fix ptr
POPJ P,
;COPFIL COPFL0 COPDO COPYX COPDAT COPLUP COPDA3
COPFIL: TRZN F,COPY
POPJ P,
TLZ F,TF1 ;Assume not different source and dest files
MOVE A,@DSTFIL
MOVE B,@DSTFIL-1
CAMN B,@SRCFIL-1 ;Compare source and dest devices
CAME A,@SRCFIL ; and file names
JRST COPFL0 ;Different device or different file name
HLRZ B,@SRCFIL+1
HLRZ C,@DSTFIL+1
MOVE A,@DSTFIL+PPN3
CAIN B,(C) ;Compare source and dest extensions
CAME A,@SRCFIL+PPN3 ; and PPNs
COPFL0: PUSHJ P,COPCHK ;Dest file not same as source file. Does dest already exist?
MOVE T,@SRCFIL+2
MOVEM T,@DSTFIL+2 ;Copy PROTECTION, mode, time/date to new file
HRRZ T,@SRCFIL+1
HRRM T,@DSTFIL+1 ;Copy high-order part of date to new file
MOVEI E,@DSTFIL
PUSHJ P,OPENC ;Create a new file by ENTERing it
SKIPN @SRCFIL+4
SKIPE @DSTFIL+4
JRST FORMAT
IFN FTHID,<
XCT %OFFG ;Get offset of old file
MOVE A,HIDDEN
MOVEM A,%%OFFS+2
PUSHJ P,HIDNEW ;Set offset of new file to same value
SOS HIDDEN ;Normalize offset flag
>;FTHID
IFN FTBUF,<
SETOM IBLK ;Force SETI to do the USETI
>
PUSHJ P,SETI1 ;Start reading file at record 1
PUSHJ P,COPCOR
MOVS A,LKUP+PPN3
COPDO: PUSHJ P,COPDAT
COPYX: CLOSE DSKO,
RELEAS DSKO, ;SHIT-EATING SYSTEM!
SETZM JOBJDA+DSKO
IFN FTBUF,<
PUSHJ P,CACRLO ;Release cache from output channel
>
IFE DECSW,<
MOVEI A,600000
SHOWIT A, ;Turn off wholine filestatus and suppress erasure
>;NOT DECSW
IFN DECSW,<
UNSHOW ;Turn off wholine filestatus
>;DECSW
MOVE A,FSMAX
SUBI A,1
CORE A,
PUSHJ P,TELLZ ;Can't core down
POPJ P,
COPDAT: JUMPGE A,CPOPJ
DPB A,[221200+COPNUM*100,,COPCM2]
ASH A,-12-COPNUM
AOJGE A,COPDA3 ;Jump if have 8K or less stuff to copy
COPLUP: INPUT DSKI,COPCMD
OUTPUT DSKO,COPCMD
AOJL A,COPLUP
COPDA3: INPUT DSKI,COPCM2 ;Get final partial buffer
OUTPUT DSKO,COPCM2
POPJ P,
;COPCOR COPCHK COPCH2 ENTLUN YESCHK YESCH0 YESCH2 COPCMD COPCM2
COPCOR: MOVE T,JOBREL
HRRM T,COPCMD
HRRM T,COPCM2
ADDI T,2000⊗COPNUM
CORE T,
PUSHJ P,NOCORE ;Can't core up!!
POPJ P,
COPCHK: TLO F,TF1 ;Flag different source and dest files
SKIPE QUIETF
POPJ P,
MOVSI T,@DSTFIL
ADD T,[-1,,ENTR-1]
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
LKPMAC <LOOKUP DSKO,ENTR>
JRST COPCH2 ;Make sure we got the NO-SUCH-FILE error
CLOSE DSKO,
OUTSTR [ASCIZ/File already exists: /]
MOVEI D,@DSTFIL
TLO D,FRDRUN
PUSHJ P,FILTYP ;Type filename without switches
OUTSTR [ASCIZ/
Replace?/]
PUSHJ P,YESCHK
POPJ P, ;Yes
JRST FNF2
COPCH2: HRRZ TT,ENTR+1 ;Get error code
JUMPE TT,CPOPJ ;No such file
ENTLUN: MOVE D,[FRDRUN,,ENTR] ;Here if lost trying to create (or copy) a file
PUSHJ P,FILERR ;Tell him of strange error
IFE DECSW,<
PUSHJ P,WHOREF ;If file busy, then tell who is using it
>;IFE DECSW
JRST FNF1 ;Give up and ask for new file name
;Read single char and skip if neither Y nor y
YESCHK: CLRBFI
PUSH P,C ;Save C so this will be safe to use anywhere
PUSHJ P,CTYI2 ;Read single char from TTY
JRST YESCH2
;Same as YESCHK above except suppress typing CRLF if response is slash.
YESCH0: CLRBFI
PUSH P,C ;Save C so this will be safe to use anywhere
PUSHJ P,CTYI2 ;Read single char from TTY
CAIE C,"/" ;Suppress typing CRLF for slash
YESCH2: CAIN C,15
JRST .+2
OUTSTR [ASCIZ/
/]
MOVEM C,YESAVE# ;Save answer to yes or no question
CAIE C,"Y"
CAIN C,"y"
JRST POPCJ ;He said Yes, take direct return.
POP P,C
AOS (P)
JRST MACSTP ;Terminate macro expansion.
IMPURE
COPCMD: -2000⊗COPNUM,,
0
COPCM2: -2000⊗COPNUM,, ;For final (partial) buffer
0
PURE
;FORMAT FORASK FORMT4 HOWRED FORMT5 FORMT6 FMTOK FMTOK2 FMTDSP FLDISK FLDIS2
FORMAT: TLNN F,TF1 ;Skip if destination file different from source file
SKIPE CREASW ;If creating new file, don't ask
JRST FMTOK ;Format w/o asking
SKIPE ALTPPN ;Did we find this file on alternate PPN?
JRST FORASK ;Yes, ask to be sure, even if /Q
SKIPLE SBLOAT
JRST FMTOK ;Bloating a file -- don't ask
SKIPN QUIETF ;Don't require confirmation if he said /Q
SKIPE EDFIL-2
JRST FMTOK ;If /Q given or /F mode, don't ask.
HLLZ T,EDFIL+4
JUMPG T,FMTOK ;If /N requested, don't ask
FORASK: OUTSTR [ASCIZ /Need to reformat /]
MOVEI D,@DSTFIL
PUSHJ P,FILTYP ;Type filename (including /F or /N switch if bug!)
OUTSTR [ASCIZ ⊗. OK? (Y, N, /R or /N) ⊗]
PUSHJ P,YESCH0
JRST FMTOK ;Yes
FORMT4: MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
PUSHJ P,FLDISK ;Flush the output file, close input file.
SETZM DIR
JSP A,HOWRED ;See if he gave a special answer to Y/N question
OUTSTR [ASCIZ ⊗Would you settle for /R (Readonly) mode? (Y or N) ⊗]
PUSHJ P,YESCH0
JRST FORMT5 ;Yes
JSP A,HOWRED ;See if he gave a special answer to Y/N question
JRST FNF2 ;No, let him type another filename
;Routine to check for special response to Yes-or-No formatting question.
;Doesn't return if special response found.
HOWRED: EXCH A,YESAVE# ;Save return address, get response char
CAIN A,ALTMOD
JRST FNF2 ;Altmode gets you out of here quick
CAIE A,"/"
JRST @YESAVE ;Not a special response, return to caller
PUSHJ P,CTYI2 ;Read a single character from tty
CAIE C,15 ;Put out the CRLF we suppressed at YESCH0
OUTSTR [ASCIZ/
/]
ANDI C,137 ;Make upper case, ignore bucky bits
CAIN C,"N"
JRST FORMT6 ;Wants NO-DIRECTORY mode
CAIE C,"R"
JRST @YESAVE ;Illegal switch, ignore it and return to caller
FORMT5: SETOM RDONLY ;Give him /R mode
SETZM EDFIL+4 ;and don't give him /N
TRZA F,COPY ;Don't want to copy the file after all
FORMT6: HRLOM A,EDFIL+4 ;Give him /N mode
SETZM ALTPPN ;he said /N or /R, so don't need PPN confirmation
TRZ F,FILLUZ ;Don't make GETDIR think we've been to NODIR
HRRZ A,SRCFIL+3 ;If we're here from DIRFLS,
ADDI A,1 ; then we need to
MOVEM A,SRCFIL+4 ; undo the AOS done just beyond BEG4
SETZM DIR ;Force GETDIR to be called by BEG4
SUB P,[1,,1] ;Don't return to caller
JRST BEG4 ;But try to open file in new mode given
FMTOK: SKIPE @DSTFIL+4
OUTSTR [ASCIZ\ Formatting /N ...\]
SKIPG SBLOAT
JRST FMTOK2
OUTSTR [ASCIZ\ Bloating /\]
SETZM TYOPNT
TYPDEC SBLOAT
OUTSTR [ASCIZ\X ...\]
FMTOK2: PUSHJ P,CORCHK ;To simplify recovery if formatting is aborted
SETZM RLDFLG ;Used to limit repeating formatting check
MOVE A,@SRCFIL+4
ROT A,1
ANDI A,3 ;just look at two low bits (former high & low bits)
MOVE T,TRMCHR
CAIE T,"→"
XCT FMTDSP(A) ;do one of 4 things
OUTSTR [ASCIZ /
Requested format change mode not implemented.
/]
PUSHJ P,FLDISK ;Flush the output file, close input file.
JRST FNF2 ;Let him give another file specification
;@SRCFIL+4
FMTDSP: JFCL ; 0,,0
PUSHJ P,TELLZ ;-1,,0 ;ain't supposed to happen
JRST MAKDIR ; x,,-1 ;no old directory--make one
JRST NEWDIR ;-1,,-1 ;ignore old directory and make new one
;Routine to discard the file we had open for writing.
;Also closes input file and flushes the caches.
FLDISK:
IFN FTBUF,<
MOVEI A,DSKO
PUSHJ P,CACFND ;Find cache for output channel
JRST FLDIS2 ;None
SETZM CACWRT(C) ;No need to output since we're flushing file
PUSHJ P,CACRLO ;Release the cache from the output channel
FLDIS2: PUSHJ P,CFSGIV ;Return to free FS the cache we made from FS
>
IFE DECSW,<
RELEAS DSKO,1 ;Inhibit closing this open file
>
IFN DECSW,<
CLOSE DSKO,40 ;Inhibit deletion of old version
RELEAS DSKO,
>
SETZM JOBJDA+DSKO
CLOSE DSKI,
IFN FTBUF,<
PUSHJ P,CACRLI ;Release cache from input channel
>;FTBUF
POPJ P,
;NEWDIR NEWDLP SKPDSP NEWDFF OPUT OSET
;Ingore old directory by skipping everything in old file up to first Formfeed.
NEWDIR: PUSHJ P,SETI1 ;Start reading file from record 1
IFN FTBUF,<
PUSHJ P,CFSGET ;Set up a second cache to speed up formatting
>
MOVEI DSP,SKPDSP
MOVSI H,LSPC+NSPEC
MOVE G,INPNT
NEWDLP: GETCH2 H,G
GETCH2 H,G
JRST NEWDLP ;Read and ignore everything until FF seen
SKPDSP: JSP C,RDLNUL
PUSHJ P,RLD
JRST NEWDLP
JRST NEWDLP
JRST NEWDLP
JRST NEWDFF
JRST NEWDLP
;Now we have found the end of the directory page we were skipping
NEWDFF: SKIPE @DSTFIL+4 ;Do we need a directory in new file?
JRST MAKDR0 ;No
SKIPA T,IBLK ;Yes, leave as much room as there was in old dir
PUSHJ P,WRBUF
SOJG T,.-1
JRST MAKDR0
OPUT: PUSHJ P,WRBUF
OSET: MOVN A,OCNT
HRLI B,(A)
MOVE A,OPNT
POPJ P,
;MAKDIR MAKDR0 MAKDR1 MAKDOL MDOL1
MAKDIR: PUSHJ P,SETI1 ;Start reading file from record 1
IFN FTBUF,<
PUSHJ P,CFSGET ;Set up a second cache to speed up formatting
>
MOVE G,INPNT
MOVEI C,14
MAKDR0: PUSHJ P,FLSDIR
SKIPE @DSTFIL+4
JRST MAKDR1 ;The dir will not be written out in the file
MOVE T,[DIR,,DIREND]
PUSHJ P,DIRAD1 ;Make an entry in dir for the dir page itself
MOVNI T,DIRXTR
ADDM T,DIRSIZ ;DON'T COUNT DIR'S ENTRY FOR ITSELF TWICE
MOVEI T,1
MOVEM T,DIRREC(A) ;Dir's USET pointer is first record of file
SKIPA D,A
MAKDR1: MOVEI D,DIR
PUSHJ P,ENDSET ;Set up FS for gobbling pieces off end
MOVE E,FSEND ;Beginning of the end where we start gobbling
MAKDOL: PUSHJ P,OSET ;Init AOBJN count in B and the output BP in A
HRRI B, ;No chars on page yet
SKIPN PAGES
JRST MDOL1 ;First page, don't put out FF in front of it
IDPB C,A ;Put out FF
AOBJN B,.+2
PUSHJ P,OPUT
MDOL1: MOVEI E,1(E) ;Finish off the FS dir block pointed to by D
HRRM E,(D) ;Link forward from finished block to new FS
LEG HRLZM D,(E) ;Link backward from new block to old
MOVEI D,(E) ;Now point to new block
MOVE T,OBLK
LEG MOVEM T,DIRREC(D) ;Put USET pointer into new directory block
ADD E,[350700,,LPDESC] ;Make E be byte pointer for storing text of
MOVSI T,(<BYTE (7)11>) ; first line, which we will start with a tab
LEG MOVEM T,(E)
HRRI B,1 ;Count chars of text of dir line (incl tab)
MOVSI H,LSPC+DSPC+NSPEC
MOVEI DSP,MD1DSP ;Dispatch table for first line of page
MOVE T,[440700,,T] ;For saving first chars of page in T and TT
MOVEM T,INPNT ; so we can flush COMMENT, etc, from dir
SETZM FFLINE# ;Count lines on this page for /F.
SETZB T,TT
JSP Q,SOSCHK ;Look for SOS line number
;MDIL1 MDIL1A MDIL2 MDIL2A MDCSRC MDCSR1 MD1DSP
;fall thru from previous page--looking at first line of page
MDIL1: GETCH2 H,G
IDPB C,A ;Put char into output file
AOBJN B,.+2
PUSHJ P,OPUT
LEG IDPB C,E ;Put normal char into dir line text
CAIL C,140
SUBI C,40 ;Force upper case
IDPB C,INPNT ;Collect first chars of page in T and TT
CAIG C,40
JRST MDCSRC ;End of first "word" of page--check special words
HRRZ C,B ;Number of chars on directory line so far.
CAIG C,10 ;Is this first word too long to possibly need flushing?
JRST MDIL1 ;Not yet
MDIL1A: MOVEI DSP,MD2DSP ;We no longer are looking for a leading word to flush
MOVEI T,MD2CR ;This is the where we dispatch to on CR ending 1st line
MOVEM T,INPNT ;Also, byte size of 0 suppresses saving leading word
MDIL2: GETCH2 H,G
LEG IDPB C,E ;Save char in text of dir entry
MDIL2A: IDPB C,A ;Output char also
AOBJN B,MDIL2
PUSHJ P,OPUT
JRST MDIL2
MDCSRC: PUSHJ P,MDCSR1 ;Search table of leading words to omit from dir
JUMPGE DSP,MDIL1A
MOVSI E,350700 ;Want to omit leading word just seen
HRRI E,LPDESC(D) ;So reset byte pointer for saving dir text
HRRI B,400001 ;Count leading tab and force test for short
JRST MDIL1A ; leading word to fail above in MDIL1
MDCSR1: MOVSI DSP,-NSCOMS
DPB DSP,INPNT ;Zero out the ending byte in leading word
CAMN T,SCOMS(DSP) ;See if word, which is in T and TT, appears
CAME TT,SCOMS2(DSP) ; in table of words to omit from dir page
AOBJN DSP,.-2
POPJ P,
;Dispatch table for first part of first line of page during formatting.
MD1DSP: JSP C,RDLNUL ;NULL - Ignore
PUSHJ P,RLD ;RUBOUT - See if we need more input
JRST MD1CR ;CR
JRST MAKDLF ;LF
JFCL ;TAB
JRST MDFF1 ;FF - End of input page
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
PUSHJ P,TELL7 ;MISC - Cannot happen
JRST MDIL1B ;Circle-x or semicolon--flush from dir line
;MDIL1B MAKDFF MAKDLF MDFF1 MDFF4 MDFF2 MDFF3 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCKX RLDCK2 RLDCK3
;Here with circle-x or semicolon to omit from text of dir line
MDIL1B: IDPB C,A ;Output to file
AOBJN B,.+2
PUSHJ P,OPUT
SOJA B,MDIL1 ;But uncount char in directory line
;Here we found a FF beyond first line of page
MAKDFF: TRNN B,-2 ;Are we in the middle of a line?
JRST MDFF2 ;No
MAKDLF: TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,] ;Back up input byte pointer
MOVEI C,15 ;Now pretend we got a CR
JRST @2(DSP)
;Here we found a FF while looking at the first line of a page
MDFF1: TRNE B,-2 ;Are we at the beginning of a line?
JRST MAKDLF ;No
MOVEI C,15 ;MDFIX ends text of dir entry with this CR
PUSHJ P,MDFIX ;Finish up directory entry
MDFF4: MOVEI C,14
MDFF2:
;Here we check to see if it is indeed safe to reformat the file
TRNN F,REDNLY ;Are we in read only
SKIPE RLDFLG# ;Has the test been made yet
JRST .+2 ;Yes
PUSHJ P,RLDCHK ;No, so make test
JUMPE A,MDFF3
MOVEM A,OPNT
MOVE A,D
PUSHJ P,CLOSO ;Force out any partial buffer
SKIPLE D,SBLOAT ;Are we bloating the file?
TRNE F,EOF ;And are we in the middle of the file?
JRST MDFF3A ;No
PUSHJ P,CLOBUF ;Yes, clear OBUF buffer
PUSHJ P,WRBUF ;Output a record of nulls
SOJG D,.-1 ;Maybe output some more
MDFF3A: MOVE D,A
MDFF3: TRNN F,EOF
JRST MAKDOL
MOVE T,OBLK ;Store USET pointer to end of file
MOVEM T,DIREND+1
PUSHJ P,GDIRX ;Finish off the FS for the directory
IFN FTBUF,<
PUSHJ P,CACCLS ;Force cache to be written out as necessary
PUSHJ P,CACRLO ;Release the cache from the output channel
PUSHJ P,CFSGIV ;Return to free FS the cache we made from FS
>
TRO F,DIROK ;Got whole dir in core now
TRZ F,FILLUZ ;Formatted file now
SKIPN @DSTFIL+4 ;Skip if new file is /N
TRO F,UPDTXT ;Tell BEG4A we need to output our new directory
IFN FTHID,<
PUSHJ P,HIDEIT ;Hide new directory if old one was hidden
>
JRST COPYX
MDCEOL: PUSHJ P,MDCSR1 ;See if we found a leading word to omit
TRNE B,-2 ;Skip if we didn't find any text at all
JUMPGE DSP,CPOPJ ;Jump if leading word is not in table
MOVSI E,440700 ;Omit leading word (if any at all) including
HRRI E,LPDESC(D) ; the tab we usually insert--no text at all
HRRI B, ;No chars on dir line
POPJ P,
;Dispatch table for reading last part of first line of page while formatting.
MD2DSP: JSP C,RDLNUL ;NULL - ignore
PUSHJ P,RLD ;RUBOUT - see if need more text input
JRST @INPNT ;CR - dispatch differently for 1st line
JRST MAKDLF ;LF
JFCL ;TAB
JRST MAKDFF ;FF - end of page
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
PUSHJ P,TELL7
SOJA B,MDIL2A ;Circle-x or Semicolon to omit from dir line
;Here to check if it is really safe to complete the formatting of the file.
RLDCHK: SETZM TYOPNT ;Test last time always
MOVE T,RLDRUB
JUMPN T,RLDCK2
SKIPN T,SOSBIN
POPJ P, ;Seems to be a normal source file
SETOM RLDFLG ;Inhibit further questions
SUB T,SOSPAG
SUB T,SOSLIN
JUMPN T,RLDCK2 ;Not a simple SOS file
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /You are formatting an SOS file.
/]
RLDCK1: SKIPN T,EDFIL+PPN3 ;Get file PPN
MOVE T,PPN ;If no PPN check alias
PUSH P,A
HRRZ A,RPPN ;Check with users name
TLNN F,TF1 ;If dest file different from source,
CAIN A,(T) ; or if same programmer,
JRST POPAJ ; don't bother
OUTSTR [ASCIZ /Are you sure that /]
PUSH P,B
PUSH P,C
IFN IRCSW,<
MOVE A,T
PUSHJ P,PRGTYO ;Need entire PPN to decide how to type PRG
>;IRCSW
IFE IRCSW,<
HRLZ A,T
PUSHJ P,PNTYO
>;NOT IRCSW
POP P,C
POP P,B
POP P,A
OUTSTR [ASCIZ / will approve? (Y or N) /]
PUSHJ P,YESCH0
POPJ P, ;Yes
RLDCKX: MOVE P,[-70,,PDL] ;No
PUSHJ P,ENDFIX
PUSHJ P,FLSDIR
JRST FORMT4
RLDCK2: SETOM RLDFLG
MOVE T,SOSLI2
JUMPN T,RLDCK3
SKIPN RLDRUB
POPJ P,
OUTSTR [ASCIZ /
This file has rubouts (177s) in it and is probably an XGP or binary file.
Do you really want to garbage it? (Y or N) /]
SKIPA
RLDCK3: OUTSTR [ASCIZ /
This may be a binary file that would be hopelessly garbaged by formatting.
Do you really want to format it (Y or N)? /]
SETOM RLDFLG
PUSHJ P,YESCH0
JRST RLDCK1
JRST RLDCKX
;⊗ MD1CR MD2CR MD3CR MD4CR0 MD3CR0 MD3CR1 MDIL3 MD4CR MD5CR MDLFCK MDCRCK MDFIX MDFIXE
;Here with CR while still looking for leading word on first line to omit
MD1CR: IBP INPNT ;So MDCSR1 won't zero last byte of leading word
PUSHJ P,MDCEOL ;See if we need to flush a leading word
MD2CR: PUSHJ P,MDFIX ;Finish the FS block for directory entry
MOVSI H,LSPC+NSPEC
MOVEI T,MD3CR ;Come here on all future CRs
MOVEM T,INPNT
MD3CR: IDPB C,A ;Put CR into file
AOBJN B,.+2
PUSHJ P,OPUT
MOVEI C,12 ;Follow it with a LF
IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
HRRI B,1
SKIPE EDFIL-2 ;Are we inserting FFs for /F mode?
JRST MD4CR
MD4CR0: SKIPA DSP,[MDCRCK] ;If see LF, ignore it and reset to normal table
MD3CR0: MOVEI DSP,MD2DSP ;Normal dispatch table
MD3CR1: GETCH2 H,G
MOVEI DSP,MD2DSP
JSP Q,SOSCK2
MDIL3: GETCH2 H,G
IDPB C,A
AOBJN B,MDIL3
PUSHJ P,OPUT
JRST MDIL3
MD4CR: AOS DSP,FFLINE ;Count another line on this page.
CAMGE DSP,EDFIL-2 ;Time to insert another FF?
JRST MD4CR0 ;No.
MOVEI DSP,MDLFCK
GETCH2 H,G
CAIE C,12 ;Is this the LF we expected?
JRST MD5CR
GETCH2 H,G ;Get first character following the CRLF.
MD5CR: TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[070000,,0] ;Back up byte pointer to save char for next time.
JRST MDFF4 ;Go insert FF.
MDLFCK: JSP C,RDLNUL ;NULL
PUSHJ P,RLD ;RUBOUT
JFCL ;CR
JFCL ;LF
JFCL ;TAB
JRST MDFF2 ;FF
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
MDCRCK: JSP C,RDLNUL ;NULL - Ignore
PUSHJ P,RLD ;RUBOUT - Get more text
JRST MD3CR1 ;CR -- Ignore it (just seen a CR before)
JRST MD3CR0 ;LF -- Ignore (already put in LF), change table
JFCL ;TAB
JRST MDFF2 ;FF
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
;Here to finish text of directory line taken from first line of a page
MDFIX: MOVEI T,12
LEG IDPB C,E
LEG IDPB T,E
MOVEI T,177
LEG IDPB T,E ;End dir line text with CR LF RUBOUT
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T ;Break off finished piece of FS as dir line
LDB T,[2100,,B] ;Number of chars in dir line
ADDI T,2 ; plus CRLF
MOVEM T,DIRFLG(D)
ADDM T,DIRSIZ
SETZM DIRWIN(D) ;clear window ptr for dir entry (current window)
AOS PAGES ;Count another page's directory entry complete
POPJ P,
;Here to record how much text is in extended part of directory.
MDFIXE: HRRZ T,XDIRFG ;get number of pages file used to have
CAML T,PAGES ;is this a new page?
JRST MDFIX ;no, treat as usual
PUSHJ P,MDFIX ;yes, first finish the directory line
HRRZ T,DIRFLG(D) ;get length of new line
ADDI T,DIRXTR ;include constant part of dir line (C00001 00001)
ADDM T,EDIRSZ ;update size of extended part of directory
POPJ P,
;CREATE CREAT2 CTEXT LCTEXT CREGRT
CREATE: TRZ F,COPY
SKIPN @DSTFIL
JRST FLOSE
PUSHJ P,COPCHK
HLLZS @DSTFIL+1 ;Zero entire right half first
IFE DATOK,<
LDB T,[POINT 15,DATBLK,17] ;Now get date
DPB T,[POINT 15,@DSTFIL+1,35] ;and put it in creation date location
>
SETZM RDONLY ;Creating new file, flush READONLY mode
MOVEI E,@DSTFIL
PUSHJ P,OPENC ;Create a new file by ENTERing it
SKIPE @DSTFIL+4
JRST CREAT2 ;Creating a /N file, so no directory
MOVE A,[CTEXT,,OBUF]
BLT A,OBUF+LCTEXT-1
SETZM OBUF+LCTEXT
MOVE A,[OBUF+LCTEXT,,OBUF+LCTEXT+1]
BLT A,OBUF+377
MOVSI A,(<BYTE(7)14>)
MOVEM A,OBUF+200
OUTPUT DSKO,[-400,,OBUF-1↔0] ;Initial directory plus one empty page.
IFN FTHID,<
repeat 0,< ;no default hidden dirs please
MOVEI A,1
MOVEM A,HIDDEN ;Flag that directory is hidden
MOVEI A,2
MOVEM A,%%OFFS+2
PUSHJ P,HIDNEW ;Set initial record offset
>;repeat 0
>;FTHID
CREAT2: CLOSE DSKO,
MOVE A,[DSTFIL,,SRCFIL]
BLT A,SRCFIL+4
POPJ P,
CTEXT: ASCII/COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00003 ENDMK
C⊗;
/
LCTEXT←←.-CTEXT
;If creating a new file with extension '>', change extension to '1' first.
;CHKGRT must already have failed to find any numeric extensions.
CREGRT: MOVE T,DSTFIL ;Get filename bits
TLNN T,FRDGRT ;Skip if greater-than sign was extension
POPJ P,
HLRZ T,@DSTFIL+1
CAIE T,'> ' ;Don't mess with numeric extension already found
POPJ P,
MOVSI T,'1 '
HLLM T,@DSTFIL+1 ;Change extension
POPJ P,
;RDSPA2 RDSPA4 RDSPA5 RDPAGE RDPGSV RDPGOK RDSPAG RDPAG0
;Fixes up page info for the header line
RDSPA2: MOVEI T,(A) ;Start with the page number
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,HEDPAG ;Put it on asterisk heading line
MOVEM C,HED2PG ;and also on dash heading line
POPJ P,
RDSPA4: MOVE T,CURPAG
CAME T,FIRPAG ;Only one page in core?
JRST RDSPA5 ;No
MOVSI T,(<ASCII/ />)
HLLM T,HED3PG
HLLM T,HED4PG
MOVEI T,1 ;Make header say "PAGE X"
MOVEM T,HED5PG
MOVEM T,HED5PG+1
MOVEM T,HED6PG
MOVEM T,HED6PG+1
POPJ P,
RDSPA5: PUSHJ P,NUMSTD ;Convert number of final page in core to ASCID
MOVEM C,HED5PG+1
MOVEM C,HED6PG+1
MOVSI T,(<ASCII/:/>)
HLLM T,HED5PG
HLLM T,HED6PG
MOVSI T,(<ASCII/S />) ;Make header say "PAGES X:Y"
HLLM T,HED3PG
HLLM T,HED4PG
POPJ P,
;Note skip return
RDPAGE: TRZ F,UPDIR+WRITE+XPAGE+EDDIR
SETOM INSCNT ;No lines inserted (for autowrite)
SETZM FFLINE ;No lines read in yet. Used only with /F switch
MOVE B,A
CAMGE A,DIRPAG
HRRO A,DIRPAG
CAMLE A,PAGES
HRRO A,PAGES
JUMPL A,RDPGLZ
AOS (P)
RDPGSV: PUSHJ P,BAKSAV ;Remember place we're coming from
RDPGOK: CAMN A,FIRPAG
JRST RDSPAG
PUSHJ P,FNDPAG
JUMPN T,.+2
MOVEI T,DIR
MOVSI TT,D1BIT
IORM TT,DIRFLG(T)
EXCH T,DIRP1
JUMPE T,.+2
ANDCAM TT,DIRFLG(T)
HRRZM A,FIRPAG
RDSPAG: PUSHJ P,RDSPA2 ;Update page info for header line
PUSHJ P,CLRWR2 ;clear W flag, forces header line out again
SETZM CHARS
SETZM ROOM
SETZM RELPGN
MOVE A,FIRPAG
RDPAG0: SETZM LINES
TRNE A,-2
AOS CHARS ;FF ON MOST PAGES
MOVE B,A
PUSHJ P,FNDPAG
MOVEM A,CURPAG
PUSH P,T
PUSHJ P,RDSPA4 ;Update CURPAG entry on header
POP P,T
MOVE D,T
EXCH T,DIRPT
MOVSI TT,DPBIT
JUMPE T,.+2
ANDCAM TT,DIRFLG(T)
IORM TT,DIRFLG(D)
AOS TT,RELPGN
DPB TT,[RPBYTE+DIRFLG(D)]
MOVEI G,RLD ;Using G here ensures that GETCHR on next page won't
MOVEM G,RLDA# ; screw up on nulls because RDLNUL thinks G is byte pointer
CAMN B,DIRPAG
JRST DRGSET ;page to "read in" is the directory
JUMPE B,CPOPJ
CAMLE B,PAGES
POPJ P, ;no such page
MOVEI DSP,RPDSP
SKIPN A,DIRREC(D) ;get record number of page's location on disk
PUSHJ P,TELLZ
PUSHJ P,SETI
;RDPAG2 PSEUDO RDPAG1 RDLINE RDLIN2 RDLLP RDLTAB TELLD1 TELLDM LOOKON
TRNE F,FILLUZ
SKIPA T,[JSP Q,SOSTST]
RDPAG2: MOVE T,[SETZB B,TT] ;B will count columns, TT negative extra tab spaces
MOVEM T,RDLINS# ;Instruction executed at beginning of each line
HRRZ T,(D) ;get ptr to next page
HRRZ T,DIRREC(T) ;get its record number
SUBI T,(A) ;difference is number of records allocated to page
IMULI T,200*5 ;make it characters of space
ADDM T,ROOM
CAIG B,1
JRST RDPAG1 ;First page isn't expected to start with FF
GETCHR
CAIN C,14
JRST RDPAG1 ;Okay, page starts with FF
TRNN F,REDNLY
PUSHJ P,TELLD1 ;Fatal directory error
SKIPE EDFIL-2 ;No error if in /F/R
JRST PSEUDO
SORRFU TELLDM ;Make sure all macros stop now, type error msg
PUSHJ P,DILOOK ;You can look but you better not touch
PSEUDO: CAIN C,12 ;Was this the char causing a pseudo FF insertion?
JRST RDPAG1 ;Yes
TESTBP INPNT ;make sure byte ptr hasn't already been backed up
MOVE C,[070000,,0] ;No, back up pointer over this real character
ADDM C,INPNT
RDPAG1: MOVSI H,LSPC+NSPEC
PUSHJ P,ENDSET
AOS T,A ;MAKE T +
MOVE G,INPNT
MOVEI D,PAGE
MOVSI E,440700
HRRI E,LLDESC(A) ;SET UP FOR SSET2
ILDB C,G
SKIPGE CTAB(C)
XCT @CTAB(C)
DPB C,G ;IN CASE CLOBBERED BY SSET
TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,]
CAIE C,12
JRST RDLINE
MOVEM G,NEWPNT
SOS IBLK
MOVE G,[441100,,[BYTE (9)15,200]]
RDLINE: HRRM A,(D)
LEG HRLZM D,(A)
RDLIN2: MOVSI E,440700
HRRI E,LLDESC(A)
XCT RDLINS ;SETZB B,TT or JSP Q,SOSTST
RDLLP: GETCH2 H,G
LEG IDPB C,E
AOJA B,RDLLP
RDLTAB:
LEG IDPB C,E
HRROI D,-10
IORI D,(B)
SUB B,D
ADD TT,D ;Count negative of spaces generated by tabs
MOVEI T,40
JRST .+11(D)
REPEAT 10,<LEG IDPB T,E>
LEG IDPB C,E
AOJA TT,RDLLP ;Make the negative count be for "extra" spaces only
TELLD1: SETOM DIRERR# ;Make helpful message about dir be typed out
PUSHJ P,TELLX
TELLDM: ASCIZ /
*** DIRECTORY POINTER INVALID *** NO PAGEMARK AT BEGINNING OF CURRENT PAGE ***
/
LOOKON: ASCIZ/You can look at file but not write it. /
;RDLCR0 RDLCR RDLCR2 RDLLF RDLONG
RDLCR0: TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,]
MOVEI C,15
RDLCR: HRROI T,40
JUMPN B,.+2
LEG IDPB T,E
LEG IDPB C,E
GETCH2 H,G
RDLCR2: TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,]
MOVEI C,12
RDLLF: JUMPGE T,RDLCR0
LEG IDPB C,E
TDZA C,C
LEG IDPB C,E
TLNE E,760000
JRST .-2
CAIL B,377776 ;Don't let line be too long for data structure
JRST RDLONG
AOS LINES
ADDI TT,2(B) ;B has columns, TT has minus extra cols added by
ADDM TT,CHARS ; tabs, so sum is number of actual chars, plus CRLF
HRL B,TT
MOVEM B,TXTCNT(A)
HRRZS TXTFLG(A) ;Clear flags for this line
AOS T,TXTNUM#
HRRM T,TXTSER(A) ;Give line fresh serial number
SETZM TXTWIN(A) ;clear window ptr for line in current window
MOVEI D,(A)
MOVNI E,1(E)
ADDI E,LLDESC(A)
HRLI A,(E)
ADDI A,LLDESC+1
MOVEI T,1 ;make ASCID text
IORM T,-1(A) ;turn on low-order bit of text words in block
AOBJN A,.-1
MOVSI T,TXTCOD
FSFIX A,T
AOJA A,RDLINE
RDLONG: MOVE T,LLDESC(A)
CAME T,[ASCII /βββββ/]
CAMN T,[ASCID /βββββ/]
JRST RDLIN2
FATAL Line has more than 131070 chars.
;⊗ RDLFF RDLDON LINSE2 LINSET LINSE3 RDLFF2 RPDSP RPDSP2 RDLNUL
RDLFF: JUMPN B,RDLFF2
RDLDON:
; HRRZS CHARS ;Removed 11/14/78 by ME to allow over 2↑18 chars!
PUSHJ P,ENDFIX
HRLM D,BOTSTR
MOVEI T,BOTSTR
HRRM T,(D)
MOVEM G,INPNT
TRNN F,EDDIR
PUSHJ P,DIRCHK
TRNE F,FILLUZ
PUSHJ P,INSDIR
LINSE2: TLO F,DSPTRL ;Force recalculation of trailer values
LINSET: MOVE T,LINES
CAMGE T,ARRL
TLOA F,OFFEND
TLZ F,OFFEND
SUB T,SCRSIZ
ADDI T,3 ;correction to SCRSIZ for distance 'tween top and bot
ADD T,EXTRA
JUMPG T,LINSE3
MOVEI T,1 ;There are less lines in core than fill up window
SETOM BOTWIN ;Force recomputing of window
LINSE3: EXCH T,WINMAX
CAMN T,WINMAX
CAIG T,1
SETOM BOTWIN
POPJ P,
RDLFF2: MOVEI C,15 ;Here with FF in middle of line--insert CRLF
LEG IDPB C,E
SETO T, ;Flag that we already have a CR for the following LF
JRST RDLCR2 ;Now put in the LF
;Dispatch table
PUSHJ P,RLD1
RPDSP: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JUMPGE T,RDLCR ;CR
JRST RDLLF ;LF
JUMPGE T,RDLTAB ;TAB
JUMPGE T,RDLFF ;FF
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
repeat 1,<
;Dispatch table to test the characters after finding a pseudo FF position
PUSHJ P,RLD1
RPDSP2: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JFCL ;CR
JFCL ;LF
JFCL ;TAB
JUMPGE T,SOSTS2 ;A real FF here so restore DSP and proceed normally
XCT ALTCVT ;ALT - maybe convert (formerly always converted)
>
RDLNUL: SKIPE (G)
JRST -3(C)
HRLI G,700
SKIPN 1(G) ;quickly skip over multiple consecutive
AOJA G,.-1 ; words of nulls
JRST -3(C)
;RDPGLZ SOSTST SOSTS2 SOSCHK SOSCK2 PGMK PGMK2
RDPGLZ: ANDI A,-1
CAME A,DIRPAG ;Prevent infinite loop if want dir page
TRNE F,DIROK
JRST RDPGSV ;Save place we're coming from and go
PUSH P,B
PUSHJ P,RDPGOK ;Read in page to set up dir entry
PUSHJ P,FLSPAG ;Now throw it away
POP P,A
JRST RDPAGE ;Now read it for real
SOSTST: SETZB B,TT ;B counts columns, TT is negative extra tab spaces
AOS C,FFLINE ;Get updated line count
SKIPE EDFIL-2 ;Are we in /F mode?
CAMG C,EDFIL-2 ;Are there enough lines on this page?
JRST SOSCHK ;not time for pseudo FF
SETZM FFLINE
MOVEI DSP,RPDSP2 ;Special dispatch table on page 126
GETCH2 H,G
MOVEI C,14
TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,0]
; JUMPGE G,.+2 ;Commented out to fix a bug that occurred probably
; SUB G,[430000,,1] ; since IBFPNT was changed. See DIRCHK.
SOSTS2: SKIPA DSP,[RPDSP] ;Reset usual dispatch but don't pick up character.
;The above SKIPA skips over the first instruction GETCH2 expands to (ILDB C,G).
SOSCHK: GETCH2 H,G
SOSCK2: PUSH P,T
MOVEI T,1
AOS SOSBIN ;To count total references to SOSCK2
TDNN T,(G)
JRST [ POP P,T ↔ JRST 3(Q)]
POP P,T
MOVE C,(G)
CAMN C,[ASCID / /]
JRST PGMK
AND C,[BYTE (7)160,160,160,160,160(1)1]
CAME C,[ASCID /00000/]
JRST [AOS SOSLI2↔JRST 2,@[20000,,(Q)]]
AOS SOSLIN
AOJA G,.+2
IBP G
SKIPGE (G)
PUSHJ P,RLD
JRST (Q)
PGMK: HRLI G,10700
AOS SOSPAG ;To count SOS pages
SKIPGE (G)
PUSHJ P,RLD
PGMK2: ILDB C,G
CAIN C,14
JRST @5(DSP)
CAIN C,15
JRST PGMK2
JRST 1(Q)
;DIRCHK TELLD2 DIRCHM DIRNEW DIRNW2 DIRNW1 TXTSHF
DIRCHK: MOVE A,INPNT
;Attempt to avoid byte ptrs that back up two bytes off high end of word,
;which byte ptrs don't do what we expect on a KL with version 400 microcode.
JUMPGE A,.+2 ;jump unless about to backup too far off end.
SUB A,[430000,,1] ;avoid byte ptr of 530700,,x -- 440700,,x is OK.
;End of fix to avoid funny byte ptrs, which result from being previously backed
;up, e.g., at SOSCHK-1.
ADD A,[70000,,] ;Back up byte pointer so next ILDB gets the FF
SUB A,IBFPNT
;Another fix to avoid invalid byte pointer.
;If byte ptr now points before buffer beginning, use beginning of buffer (IBFPNT).
TRNE A,400000 ;negative word offset?
MOVEI A,0 ;yes, align at beginning of record.
;End of fix.
ROT A,-7
HRR A,IBLK
HRRZ E,@DIRPT
SKIPN DIRREC(E) ;any record ptr here?
JRST DIRNEW
CAMN A,DIRREC(E) ;yes, does it match our expected value
POPJ P, ;yes
TRNN F,REDNLY ;Let him continue if in /R mode
JRST TELLD2 ;Fatal directory error
SORRFU DIRCHM ;Stop all macros here, type error msg
DILOOK: TRON F,FILLUZ ;Allow continuing in /R, but mark file not formatted
OUTSTR LOOKON ; so he can't alter anything
POPJ P,
TELLD2: SETOM DIRERR ;Make helpful msg about dir be typed
PUSHJ P,TELLX ;Fatal error
DIRCHM: ASCIZ /
*** DIRECTORY POINTER TO FOLLOWING PAGE IS INCORRECT ** DO NOT EDIT ***
/
DIRNEW: TRNN F,EOF
JRST DIRNW1
TRO F,DIROK
TLO F,DSPTRL ;Force recalculation of trailer values
SETOM DPAGES ;Force redisplay of total number of pages
MOVEM A,ROOM
MOVEI A,-1(A)
IMULI A,200*5
EXCH A,ROOM
DIRNW2: MOVEM A,DIRREC(E) ;store record ptr for page
POPJ P,
DIRNW1: MOVE T,DIRPT
CAIE E,DIREND
JRST DIRNW2
PUSHJ P,DIRADD
JRST DIRCHK
;Here when shuffling FS for a text line. Block (A) of size (T) to be moved by (C).
TXTSHF: PUSHJ P,LSTSHF ;fix list ptrs back and fore
HLLZ T,TXTFLG+1(A) ;(A) points to FS word--get flag bits
MOVE TT,TXTWIN+1(A) ;get ptr to window (if in FS)
TRNN TT,-1 ;any window ptr?
HRRI TT,WINDAT ;no, must be current window
TLNE T,ARRBIT
ADDM C,ARRLIN-WINDAT(TT) ;We just moved the arrow line, fix its pointer
TLNE T,WINBIT
ADDM C,WINLIN-WINDAT(TT) ;Just moved top line of window
JUMPGE T,CPOPJ ;Jump unless this is a pagemark line
ADDI A,LLDESC+LPMTXT ;Just moved a pagemark line, get address of PM data
MOVE T,1(A) ;Get pointer word
TRNN T,-1 ;If there is no forward pointer, then let
HRRI T,XPLSTE-WINDAT(TT) ; relocating routine know who points back here
PUSHJ P,LSTSH1 ;Fix our neighbors' pointers in pagemark list
SUBI A,LLDESC+LPMTXT ;Restore A to point to FS header word
POPJ P,
;FNDPAG FNDLIN FNDLN1 FNDLN2 FNDLN3
;Get pointer to given page or line in T from page number or line number in A.
;Finds the page or line by first finding the closest known page or line
;and then walking up or down the page or line list from that point.
FNDPAG: SKIPA T,[DPTRTB,,DPTRT2] ;find page from number in A
FNDLIN: MOVE T,[LPTRTB,,LPTRT2] ;find line from number in A
HLRM T,FNDPT1 ;store ptr to table of known page or line numbers
HRRM T,FNDPT2 ;store ptr to table of instr's to get FS addresses
MOVE T,-1(T) ;get aobjn count in LH, zero in right
HRLOI TT,377777
MOVEM TT,FNDTM1# ;initialize minimum offset yet seen
FNDLN1: MOVEI TT,(A) ;number of page or line we want to find
SUB TT,@FNDPT1 ;distance from known place
MOVM TT,TT ;positive distance
CAMGE TT,FNDTM1 ;skip if this is closer than any previously seen
SKIPN @FNDPT2 ;IGNORE IF PNTR NOT SET
AOBJN T,FNDLN1 ;keep looking for closer item
JUMPGE T,FNDLN2 ;jump if no more entries in table of known items
MOVEM TT,FNDTM1 ;found a closer item than before, remember distance
MOVEM T,FNDTM2# ;remember pointer to table entry
AOBJN T,FNDLN1 ;keep looking for closer item
FNDLN2: MOVE T,FNDTM2 ;get best table entry
MOVEI TT,(A) ;desired item number
SUB TT,@FNDPT1 ;figure distance from closest known item
ADD T,FNDPT2 ;figure address of instr for best table entry
XCT (T) ;get address of best item
JUMPE TT,CPOPJ ;return if best item is desired one
JUMPL TT,FNDLN3 ;jump if best item is after desired one
HRRZ T,(T) ;best item is before desired one in list, advance
SOJG TT,.-1 ; until we've got desire one
POPJ P,
FNDLN3: HLRZ T,(T) ;back up in list until we've got
AOJL TT,.-1 ; the desired item
POPJ P,
;FNDPT1 FNDPT2
IMPURE
FNDPT1: (T)
FNDPT2: @(T)
PURE
;DIRGET DIRGL DGEND DRGSET
DIRGET: HRRZ T,DIR
MOVEM T,DIRGPT# ;BETTER THE HELL NOT CAUSE SHUFFLAGE
SETZM DIRGPG#
MOVE C,[170700,,DIRHED+3]
MOVEM C,INPNT
MOVE C,PAGES
XCT -3(DSP) ;Different page count if suppressing dir updates
PUSHJ P,NUM5 ;Tell how many pages in the file
MOVE C,[440700,,DIRHED]
JSP Q,RLDX
SKIPE VBUF
SKIPA C,[440700,,VBUF]
MOVE C,[440700,,[BYTE (7)15,12,177]]
JSP Q,RLDX
MOVE C,[440700,,DIRHD2]
DIRGL: JSP Q,RLDX
MOVE C,[350700,,DIRTXT]
MOVEM C,INPNT
MOVE C,DIRGPT
HRRZ C,DIRREC(C) ;get record number
PUSHJ P,NUM5 ;stuff text of rec number into DIRTXT block
IBP INPNT ;skip space after record number
AOS C,DIRGPG ;get page number
SKIPGE NODUPD ;Skip unless suppressing directory updates somewhat
XCT -2(DSP) ;CAME C,XDIRFG stops OUTDIR before first new page
CAMLE C,PAGES
JRST DGEND
PUSHJ P,NUM5 ;put text of page number into DIRTXT block
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
HRRZ C,DIRGPT
HRRZ Q,(C)
MOVEM Q,DIRGPT
ADD C,[440700,,LPDESC]
JRST DIRGL
DGEND: MOVEI C,177
IDPB C,INPNT
TRNN F,DIROK
SKIPA C,[440700,,DIRUNK]
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
MOVE C,[440700,,DIREMK]
JSP Q,RLDX
SUB P,[1,,1]
XCT -1(DSP)
;Here from RDPAGE/RDSPAG if want to "read in" the directory page.
;We do that by using a different dispatch table.
DRGSET: MOVEI Q,DIRGET
TRO F,EDDIR ;indicate that we're now editing directory page
MOVEI DSP,DGDSP
PUSHJ P,SETRLD
MOVEI A,1
JRST RDPAG2
;NUM5 NUM5A DIRHED DIRHD2 DIRTXT DIREMK VBUF DIRUNK DGDSP
NUM5: HRLI C,12*12*12*12*12/2
NUM5A: PUSH P,D
IDIVI C,12
TLNE C,-1
PUSHJ P,NUM5A
ADDI D,"0"
IDPB D,INPNT
POP P,D
POPJ P,
IMPURE
DIRHED: ASCII /COMMENT ⊗ VALID XXXXX PAGES/
BYTE (7)177
DIRHD2: ASCII /C REC PAGE DESCRIPTION
/
BYTE (7)177
DIRTXT: ASCII /Cxxxxx xxxxx/
BYTE (7)177
DIREMK: ASCII /ENDMK
C⊗;
/
BYTE (7)177
XDIRCH←←=77 ;# chars in first 2 & last lines
VBUF: BLOCK 10
PURE
DIRUNK: ASCII /
AND WHO KNOWS HOW MANY MORE . . .
/
BYTE (7)177
;This dispatch table is used by DIRGET w/(DSP)
JFCL
JFCL
JRST RDLDON
DGDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
JRST RDLCR ;CR
JRST RDLLF ;LF
JRST RDLTAB ;TAB
PUSHJ P,TELL5 ;FF
JFCL ;ALT, now we allow it in line (formerly TELL6)
;⊗ OUTDIR ODOLP OUTDLP ODPCNT ODDSP ODDON ODDON2 ODDONX ODEXP
OUTDIR: TRNN F,REDNLY
SKIPN DIRPAG
POPJ P,
MOVE A,DIRSIZ
SKIPGE NODUPD ;skip unless suppressing directory updates
SUB A,EDIRSZ ;won't be putting out this much text at end of dir
ADDI A,200*5-1+200*5 ;+1 TO GET REC #
IDIVI A,200*5
MOVEM A,NEWSIZ ;dir size in records, + 1
HRRZ B,@DIR
HRRZ B,DIRREC(B) ;record number of start of page 2
CAILE A,(B)
JRST ODEXP ;Must ripple to allow more room for directory
PUSHJ P,OPENWE ;Open edit file for writing
MOVEI A,1
PUSHJ P,SETO
MOVEI DSP,ODDSP
MOVEI Q,DIRGET
PUSHJ P,SETRLD
ODOLP: MOVE G,OPNT
MOVE E,OCNT
OUTDLP: GETCHR
IDPB C,G
SOJG E,OUTDLP
PUSHJ P,WRBUF
JRST ODOLP
ODPCNT: SKIPGE NODUPD ;Skip unless suppressing directory updates
CAMGE C,XDIRFG
POPJ P, ;Use normal page count
SKIPG C,XDIRFG ;Get first new page number
PUSHJ P,TELLZ ;Someone set NODUPD but not XDIRFG!!
SOJA C,CPOPJ ;But only tell about old number of pages
;Next three instructions are XCTed by DIRGET w/(DSP)
PUSHJ P,ODPCNT ;See how many pages we'll list in directory
CAME C,XDIRFG ;Stop outputting dir text at first new page in file
JRST ODDON
ODDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
ODDON: MOVNI T,1
PUSHJ P,WRCHK
SKIPGE NODUPD ;Skip unless suppressing directory updates
JRST [ CAMLE T,DIRSIZ ;We may not have actually written out whole dir but
JRST .+1 ; we shouldn't have written out more than there is!
JRST ODDON2] ;OK, didn't write out too too much
CAME T,DIRSIZ
FATAL DIRECTORY WRITER LOST
ODDON2: MOVEM T,ODSIZ
MOVEM G,OPNT
PUSHJ P,CLOSO ;Output any final partial record
IFN FTHID,<
PUSHJ P,HIDEIT ;Set record offset correctly for new dir
>
HRRZ T,@DIR
HRRZ T,DIRREC(T) ;record number of start of page 2
MOVE A,ODSIZ
ADDI A,200*5-1+200*5 ;+1 TO GET REC #
IDIVI A,200*5
SUB T,A ;See how many records we actually put out
JUMPLE T,ODDONX
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177 ;clear buffer to all nulls
PUSHJ P,WRBUF ;write records of nulls to fill out dir space
SOJG T,.-1
ODDONX:
IFN FTBUF,<
PUSHJ P,CACCLS ;Force cache to be written out as necessary
>
POPJ P,
ODEXP: SUBI A,(B) ;number of extra records needed in directory
TRNE F,EDDIR ;if we're on the directory page,
JRST WRPX0 ; then A is amount of extra room we'll get
TRNE F,WRITE ;else the incore page shouldn't have changed
PUSHJ P,TELLZ
MOVEI A,0 ;no extra room to indicate incore (not on dir)
JRST WRPX0
;INSDIR INSD4 INSD5 IDDSP0 IDDSP IDTAB
;Get the new directory line text for each pagemark in core.
INSDIR: TRNE F,EDDIR ;If the current page is the directory, then
POPJ P, ; there is nothing to worry about.
HRRZ D,PAGE ;Pointer to first line of current page.
MOVE A,DIRP1 ;Pointer to directory line for first incore page
TLO F,NOSHUF ;INSD1 has ptr to first line when it calls ENDSET
PUSHJ P,INSD1 ;Make new dir line for first incore page
SKIPN XPAGES
JRST INSD5 ;No extra pages in core
HRRZ A,@DIRP1 ;Get pointer to next dir entry
HRRZ D,XPLST ;Pointer to first incore pagemark
INSD4: PUSH P,A
PUSH P,D
HRRZ D,-LLDESC-LPMTXT(D);Pointer to pagemark line's FS block
PUSHJ P,INSD1 ;Make new dir line for this pagemark
POP P,D
POP P,A
HRRZ A,(A) ;Get next directory entry
HRRZ D,(D) ;Get next pagemark
JUMPN D,INSD4 ;Loop back unless no more pagemarks
INSD5: TLZ F,NOSHUF
POPJ P,
IDDSP0: ADD D,[70000,,] ;CR
PUSHJ P,TELLZ
JRST IDTAB0 ;TAB
PUSHJ P,TELLZ
IDDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST IDDON ;CR
PUSHJ P,TELL3
JRST IDTAB ;TAB
PUSHJ P,TELL5
JFCL ;ALT, now we allow altmode in file (formerly TELL6)
PUSHJ P,TELL7
AOJA B,INSDL ;⊗ or ; -- flush from directory
IDTAB:
LEG IDPB C,A ;Put tab into directory line (note: w/out spaces)
HRLS B
TLO B,-10
IBP D ;Skip over the spaces between tabs in line
AOBJN B,.-1
IBP D ;Skip over the ending tab
JRST INSDL
;SCOMS SCOMS2 INSD1 DCLP1 DCLP1A DCLP2 DCNG INSDL
SCOMS: ASCII/COMME/
ASCII/SUBTT/
NSCOMS←←.-SCOMS
SCOMS2: ASCII/NT/
ASCII/L/
INSD1: PUSH P,A
ADD D,[440700,,LLDESC]
MOVE T,TXTCNT-LLDESC(D) ;Was MOVE T,1-LLDESC(D)
TRNE T,777777 ;Is it a blank line?
TLNN T,777777 ;Is there a line here at all?
JRST IDNUL ;No, omit the tab that usually precedes dir text
MOVEI DSP,IDDSP
MOVE A,[440700,,T] ;Registers T and TT are used to save cap. version
SETZB T,TT
MOVNI B,8
PUSH P,D ;Save starting byte pointer
DCLP1: ILDB C,D
CAIL C,140
SUBI C,40 ;Make upper case for checking COMMENT and SUBTTL
IDPB C,A ;Save first "word" on line in T and TT
CAILE C,40
AOJL B,DCLP1
JUMPGE B,DCNG
MOVEI G,8+1(B) ;Length of "word" plus one
MOVE H,CTAB(C)
TLNE H,LSPC
XCT IDDSP0-2(H) ;Must be CR or TAB
DCLP1A: MOVSI B,-NSCOMS
DPB B,A ;Deposit Null over the "break" char after "word"
DCLP2: CAMN T,SCOMS(B)
CAME TT,SCOMS2(B) ;Is word in table of words to omit from dir?
AOBJN B,DCLP2 ;No
DCNG: POP P,T ;Byte pointer to text of first line of page
JUMPL B,.+2 ;Jump if we found word in table
TDZA B,B ;(B is used to read tabs from line)
SKIPA B,G ;Number of characters to omit (word+break char)
MOVE D,T ;Get byte pointer to beginning of line
MOVSI E,DSPC+LSPC+NSPEC
PUSHJ P,ENDSET ;Now expand core to collect new directory line
ADD A,[700,,LPDESC] ;Byte pointer for storing text in new dir entry
MOVEI C,11 ;Start dir line with a tab
LEG IDPB C,A
INSDL: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C) ;Get out of loop for TAB or CR
LEG IDPB C,A
AOJA B,INSDL
;⊗ IDTAB0 IDNUL IDDON IDDON0
IDTAB0: SUBI G,8+1+1
IBP D
AOJL G,.-1
JRST DCLP1A
IDNUL: PUSHJ P,ENDSET
ADD A,[700,,LPDESC]
MOVEI C,15
IDDON:
LEG IDPB C,A ;Dispatch here on CR in first line of page
MOVEI B,1
FOR X IN(12,177)<MOVEI C,X↔LEG IDPB C,A↔>
TLNE A,760000
AOJA B,.-2
MOVEI E,-LPDESC(A)
SUB E,FSEND ;Length in words of text for dir entry
IMULI E,5
SUB E,B ;Discount nulls and the 177
EXCH A,(P) ;Save ending byte ptr on stack, get old FS block
HRRZ T,DIRFLG(A)
SUBM E,T ;New size - old size of dir entry
ADDM T,DIRSIZ
;begin fix to EDIRSZ to adjust for text change to dir line in extended dir
MOVEI B,0 ;count number of incore pages after this one
SKIPA TT,A ;copy ptr to pagemark of interest (old FS)
IDDON0: MOVE TT,(TT) ;next pagemark
SKIPL DIRFLG(TT) ;skip if last incore pagemark
SOJA B,IDDON0 ;count following incore pagemarks
ADD B,CURPAG ;make number of pagemark whose text changed
CAML B,XDIRFG ;skip unless page in question is in extended dir
ADDM T,EDIRSZ ;update amount of text in extended part of dir
;end fix
HLL E,DIRFLG(A) ;Flags from old FS block
PUSH P,DIRREC(A) ;save record nbr
PUSH P,(A) ;Save old links
MOVE B,-2(P) ;New ending byte ptr
ADDI B,2 ;Make it point to next (non-ex) FS block
MOVEM A,-2(P) ;Save old FS block ptr
MOVE A,FSEND ;New FS block ptr
ADDI A,1 ;Skip over the header FS word
MOVSI T,DIRCOD
FSFIX B,T
POP P,T ;Old links
MOVEM T,(A) ;Into new FS block
HRLM A,(T) ;And make prev and next blocks point to new one
MOVS T,T
HRRM A,(T)
POP P,DIRREC(A) ;set up old record nbr
JUMPGE E,.+2
MOVEM A,DIRPT
TLNE E,D1BIT
MOVEM A,DIRP1
MOVEM E,DIRFLG(A) ;Flags and text size of new dir entry
SETZM DIRWIN(A) ;clear the window ptr in directory entry
PUSHJ P,ENDFIX ;Close up expanding FS
POP P,A ;Old FS block
PUSHJ P,FSGIVE ;Free it
POPJ P,
;⊗ DIRSET DIRST1 DIRUP DIRUP1 DIRUP2 DIRUP3
;Here from WRPAG3 when writing out incore text, with extra incore pagemarks.
;B contains pointer to first extra incore pagemark.
DIRSET: HRRZ A,DIRP1
HRRZ T,DIRREC(A) ;get disk record nbr of first page in core
PUSH P,C
DIRST1:
; HLLZ TT,1(B)
; HLLZ TT,PMSIZE(B) ;get record and char count
; ROT TT,8 ;shift record cnt to RH
; TLNE TT,-1 ;any excess char count?
; ADDI TT,1 ;yes, need one more record
LDB C,[POINT PMCBTS,PMCCNT(B),PMCPOS] ;get excess character count
LDB TT,[POINT PMRBTS,PMRCNT(B),PMRPOS] ;get record count
SKIPE C ;any excess chars?
ADDI TT,1 ;yes, need one more record
ADDI T,(TT) ;make rec nbr just beyond page ended by pagemark
HRRZ A,(A) ;next directory entry
CAME T,DIRREC(A)
TRO F,UPDIR
MOVEM T,DIRREC(A)
HRRZ B,(B)
JUMPN B,DIRST1
POP P,C
POPJ P,
;Update directory in core for non-text change. Here from WRPAGE;
;therefore changes to directory can no longer be canceled.
;We discard any deleted pagemarks and then we validate the remaining
;incore pagemarks.
DIRUP: SKIPN B,DPLST ;skip if any deleted pages
JRST DIRUP2
TLO F,NOCHK ;Don't let FS get shuffled
DIRUP1: MOVEI A,(B)
HRRZ B,(A)
PUSHJ P,FSGIVE ;give back FS of any deleted pagemarks
CAIE B,DPLST ;end of list of deleted pages?
JRST DIRUP1 ;no
SETZM DPLST ;yes, list is now empty
TLZ F,NOCHK ;restore FS shuffling
;Now we go through the remaining incore pagemarks and number them, thus
;indicating that they're now on the disk.
DIRUP2: HRRZ A,DIRP1
MOVEI B,1
DIRUP3: DPB B,[RPBYTE+DIRFLG(A)] ;number the "real pages" that are incore
SKIPGE DIRFLG(A) ;skip unless this was the last incore pagemark
POPJ P,
HRRZ A,(A) ;next pagemark
AOJA B,DIRUP3 ;give next one the next number
;⊗ DIRFIX DIRFX1 DIRFX2 DIRFX3 DIRFX5 DIRFX4 DIRFXN
;Here from FLSPAG. Clean up dir to match what's on the disk (not writing file).
;Flush any new pages that were added but not written out,
;and resurrect any old pages that were deleted (but not written out).
DIRFIX: HRRZ A,DIRP1 ;get ptr to first incore pagemark
TLO F,NOSHUF
SKIPN B,DPLST ;skip if there are any deleted pages to resurrect
JRST DIRFX4 ;none
DIRFX1: HLLZ T,DIRFLG(A) ;get real-page field (incore count)
TLNN T,RPMASK ;skip if directory already included this entry
PUSHJ P,DIRFXN ;this incore page (A) was invented--flush it
TLZ T,¬RPMASK ;leave only real-page field
CAML T,DIRFLG(B) ;compare RPMASK of incore page and deleted page
JRST DIRFX3 ;deleted page comes first, need to insert it here
SKIPGE DIRFLG(A) ;incore page is first, skip unless last incore page
JRST DIRFX2 ;last incore page, insert deleted page after it
HRRZ A,(A) ;get next incore page
JRST DIRFX1 ;loop to right spot for deleted page resurrection
;here if incore page is last incore page.
DIRFX2: MOVSI T,DPBIT ;clear mark of last incore page
ANDCAM T,DIRFLG(A) ; from old incore page
IORM T,DIRFLG(B) ;and add to resurrected page
HRRZM B,DIRPT ;remember pointer to new last incore page
HRRZ A,(A) ;get ptr to page to insert before
DIRFX3: HLL A,(A) ;make back,,forw ptrs for inserted page
HRRZ T,(B) ;save ptr to next deleted page
MOVEM A,(B) ;link deleted page back in with back,,forw
HRLM B,(A) ;make next page point back to deleted page
MOVS A,A ;make it forw,,back
HRRM B,(A) ;make prev page point forward to delete page
HRRZ A,DIRFLG(B) ;get char count for deleted directory entry
ADDI A,DIRXTR ;plus fixed size stuff at left of dir line
ADDM A,DIRSIZ ;adjust size of directory for resurrected page
;begin fix to EDIRSZ for pages at or after XDIRFG
LDB C,[RPBYTE+DIRFLG(B)] ;get relative page number of this incore page
ADD C,FIRPAG ;calculate page number +1 of resurrected page
SUBI C,1 ;make it resurrected page
CAMG C,XDIRFG ;resurrected page in extended part of directory?
AOSA XDIRFG ;no, then extended part starts one page later
ADDM A,EDIRSZ ;yes, update amt of text in extended dir
;end fix
AOS CURPAG ;one more page in core
AOS PAGES ;one more page in file
MOVEI A,(B) ;resurrected page is now the current incore page
MOVEI B,(T) ;set up ptr to next deleted page
CAIE B,DPLST ;end of deleted page list?
JRST DIRFX1 ;no, look for place to resurrect next one
SETZM DPLST ;yes, deleted-page list is now empty
DIRFX4: HLLZ T,DIRFLG(A) ;look for any further invented pages still incore
TLNN T,RPMASK ;skip if this is a real page
PUSHJ P,DIRFXN ;flush this invented page
HRRZ A,(A) ;next incore page
JUMPGE T,DIRFX4 ;loop unless that was the last incore page
TLZ F,NOSHUF ;OK to shuffle FS now
POPJ P,
DIRFXN: PUSHJ P,DELPG1 ;link this invented page out of dir list
HLRZ C,(A) ;get ptr to previous page
PUSHJ P,FSGIVE ;discard the FS of invented page
MOVEI A,(C) ;set up ptr to page before flushed invented one
HLLZ T,DIRFLG(A) ;get its real-page field
POPJ P,
;⊗ MAXLIN PPMIN TXTMIN ATTMXM ATTMXD SCRTPD PPSIZD NTITLE XCESS NLINES MAXWID ATTMAD ATTMAX ATTMX2 PPSIZ WHOJOB WHOTIM DPYWID DPY DMLINE LINMAX DDCOLS ARRPOS ddcl0 AR2POS ddcl1 ARPOS2 ddcl2 ARRBUF IIICUR IIICU2 LIIICU LDDCUR
MAXLIN←←=62 ;Maximum number of screen lines we allow for
PPMIN←←2 ;Minimum number of lines in page printer (PPSIZ)
TXTMIN←←2 ;Minimum number of non-attached lines visible
ATTMXM←←1 ;Minimum value of ATTMAX
ATTMXD←←8 ;Default ATTMAX
SCRTPD←←2 ;Default SCRTOP
PPSIZD←←3 ;Default PPSIZ
NTITLE←←2 ;Number of title lines: header and trailer lines
XCESS←←SCRTPD+PPSIZD+NTITLE ;Default extra lines on screen
;Default number of lines for text display
NLINES: =40-XCESS ;DD
=42-XCESS ;III
=24-XCESS ;DM
MAXWID←←=87 ;Max number of columns of text we need to display
IMPURE
ATTMAD: ATTMXD ;Desired max number of attached lines displayable
ATTMAX: ATTMXD ;Maximum number of attached lines displayed (fits in current window)
ATTMX2: ATTMXD/2 ;Half of ATTMAX
PPSIZ: PPSIZD ;Number of lines in page printer
WHOJOB: 0 ;Number of job whose wholine was on our display (0,,-1 in DECSW)
IFE DECSW,<
WHOTIM: 0 ;Login time of job whose wholine was on our display
>;IFE DECSW
DPYWID: =80 ;Line width of terminal
;DPY is E's opinion of what type of display the user is on.
DPY: 0 ;0 for TTY, 1 for DD, 2 for III, 3 for DM
DMLINE: 0 ;non-zero if on DM
;Max number of words of text from single line to BLT into dpy buffer.
;These counts have to allow for (doubled) tabs in the FS text because
;the tabs themselves do not display anything.
;The 2s below take into account the FS header and trailer words.
LINMAX: 0 ;TTYs don't use dpy buffer
=20+2+LLDESC ;DD displays =84 cols. W/=10*2 tabs is =104 bytes, so
; this should be =21+..., but with no tabs that can cause
; the display to fail (by hanging the controller?), so
; we try to avoid losing on long lines, at the cost of
; possibly not displaying the last four chars on lines
; that have =10 displayed tabs (or 2 chars if 9 tabs).
=23+2+LLDESC ;III displays =89 cols. W/=11*2 tabs is =111 bytes
=20+2+LLDESC ;DM displays =80 cols. W/=9*2 tabs is =98 bytes
;IFN DDLOSS
;Special instruction to insure against losing DD. Extra CR after CRLF.
DDCOLS: JFCL ;TTY
PUSH H,[BYTE (7)15,0,0,0,0(1)1] ;DD
JFCL ;III
JFCL ;DM
;IFN DDLOSS
;Position word for arrow on normal line.
ARRPOS: 0 ;TTY
ddcl0:: CW 1,46,3,1,3,1 ;DD color diddled in first byte
BYTE(11)<-24>,0(3)0,0(2)0,2(4)6 ;III
0 ;DM
;Position word for arrow on line being edited--don't erase rest of line
AR2POS: 0 ;TTY
ddcl1:: CW 1,66,3,1,3,1 ;DD color diddled in first byte
BYTE (11)<-24>,0(3)0,0(2)0,2(4)6;III
0 ;DM
;Position word for vertical bars in attach mode.
ARPOS2: 0 ;TTY
ddcl2:: CW 1,46,3,1,3,1 ;DD color diddled in first byte
BYTE (11)<-14>,0(3)0,0(2)0,2(4)6;III
0 ;DM
ARRBUF: BLOCK 5
IIICUR: 0
IIICU2: 0 ;Position word goes here
BYTE (11)11,<-1> (3)0,0(2)0,2(4)6 ;Relative vectors to draw
BYTE (11)<-7>,<-10>(3)0,0(2)0,0(4)6 ; cursor. Only first one
BYTE (11)16,0 (3)0,0(2)0,0(4)6 ; is invisible.
BYTE (11)<-7>,10 (3)0,0(2)0,0(4)6
LIIICU←←.-IIICUR
LDDCUR←←=8 ;4 DD words to erase old cursor, 4 to draw new cursor
;FIRWRD DISPI WIPI DBLTI PCOMP P2COMP DDWAIT DISPAI DDISPI DCURI SRCDP4 SRCDP5
;This is the one of FW's winning tables which is accessed with DPY-1
FIRWRD: CW 1,46,2,0,3,2 ;DD color diddled in first byte
0 ;III
0 ;DM
DISPI: 0
JRST TDISP ;TTY
PPINFO RBUF ;DD
PPINFO RBUF ;III
PPINFO RBUF ;DM
WIPI: POPJ P, ;In case WIPE called before DPYINI
POPJ P, ;TTY
PUSH P,A ;DD
JRST IWIPE ;III
JRST DMWIPE ;DM
;For erasing old arrow when redrawing a line.
DBLTI: 0
LDB T,[300700,,DPYTAB(G)] ;DD
JRST DBLT2 ;III
JRST DBLT5 ;DM
PCOMP: JRST CPOPJ ;TTY - MUST BE REASONABLE INSTR (must be JRST)
JRST PCOMPD ;DD
JRST PCOMPI ;III
JRST PCOMPM ;DM
P2COMP: POPJ P, ;TTY - MUST BE REASONABLE INSTR
JRST P2CMPD ;DD
JRST P2CMPI ;III
JRST P2CMPM ;DM
DDWAIT: 0
DPYOUT [0↔0] ;DD--wait for previous display output to finish
JFCL ;III
JFCL ;DM
;Used to display attach buffer
DISPAI: 0
SKIPA T,[JRST DBLT4] ;Force DBLT to output vertical bar for each line
SKIPA T,[JRST DBLT4] ;Force DBLT to output vertical bar for each line
MOVE T,[JRST DBLT7] ;Just mark line as blinking on DM
DDISPI: 0
JRST DDSPX2 ;DD -- put out doubled buffer
JFCL ;III -- never used
JRST DMDON0 ;DM -- put out buffer (remember changed lines)
DCURI: 0
PUSHJ P,DCURS ;DD - draw cursor
PUSHJ P,ICURS ;III - draw cursor
PUSHJ P,MCURS ;DM -- tell system where to leave cursor
;XCT'd by SLSRCP
SRCDP4: JFCL ;TTY
TRZ T,<CW 7,0,0,0,0,0> ;DD. remove extra line select
TLZ T,(<BYTE (11)<-1>>) ;III clear X position field
TDZ T,[BYTE(7)0,0,-1,0] ;DM clear X position field
;XCT'd by SLSRCP
SRCDP5: JFCL ;TTY
TDO T,[CW 3,=74,0,0,0,0] ;DD. position for search page number
TLO T,(<BYTE (11)530>) ;III select X position
TDO T,[<BYTE (7)0,0,50>] ;DM set X position
;⊗ LINECI DISPXA DISP1A DISP2I LEPREP LETST SPCOUT MASK DDFNCN SHFHDR DMLHDR BOTAPS BOTID BOTAR3 LBOTAP DPYHED DDACT DPYBUF DPYTAB DPYLOC DPYWIN DPYOLD DPYNEW BRKTAB
LINECI: 0
JFCL ;TTY
TLO F,DSPTRL ;DD
TLO F,DSPLIN ;III
TLO F,DSPLIN ;DM
DISPXA: 0 ;TTY
DDISPX ;DD
IFE DECSW,<
IDISPX ;III
>
IFN DECSW,<
0 ;FLUSH III CODE FOR DECSW
>
MDISPX ;DM
DISP1A: 0 ;TTY
DDISP ;DD
IDISP ;III
DDISP ;DM
DISP2I: 0
TRNE F,EDITM ;DD
JRST DISP3 ;III
JRST DISP2M ;DM
LEPREP: 0
JFCL ;TTY
PUSHJ P,LEADJ ;DD
JFCL ;III
PUSHJ P,LEADDM ;DM
LETST: 0
JFCL ;TTY
CAIG T,=84 ;DD
JFCL ;III
CAMG T,DPYWID ;DM
SPCOUT: 0
PUSH H,DDFNCN ;DD select function code
JFCL
JFCL
MASK: 0 ;TTY
CW(0,377,7,0,0,377)+3 ;DD
BYTE(11)3777,0(3)7,0(2)3,0(4)17 ;III
BYTE(7)177,0,177,0,177(1)0 ;DM
DDFNCN: CW 1,46,1,46,1,46 ;DD function select, this word set from 1 of next 2
CW 1,42,1,42,1,42 ;white on green ;DDCOLR 0
CW 1,46,1,46,1,46 ;green on white ;DDCOLR 100000
;Header for DPYOUT to shift screen around using DM hardware
SHFHDR: 502100,,DPYLOC ;Overlapped mode, quote everything, don't interrupt,
0 ; and suppress non UPG xfers
0 ;in progress flag, set by system
;Header for DPYOUT to update arrow line number on DM
DMLHDR: 500400,,BOTAPS ;Overlapped mode and quote everything in program
LBOTAP ;DMQUOT,PROTLE
0
BOTAPS: 0 ;DM position word goes here
BOTID: 0 ;Space deleting/inserting text goes here
BOTAR3: 0 ;New line number text goes here
LBOTAP←←.-BOTAPS
DPYHED: 454600,,DPYBUF ;Overlapped mode (DD,DM).
0 ;DM bits: TRUNCA,NOEEOB,BETWEE,PROTLE,<flush wholine>
DDACT: 0
DPYBUF: BLOCK DPYBSZ
100,, ;BLT'd into DPYTAB once to force clearing all leading cols
DPYTAB: BLOCK MAXLIN ;ptr to FS of text displayed on each screen line, plus arrow
DPYLOC: BLOCK MAXLIN ;ptr to DPYBUF location for each displayed line, for IIIs (also temp use for SHIFT)
0 ;DPYWIN-1 is zero for DPYWS2, permanently "unclaimed line"
DPYWIN: BLOCK MAXLIN ;serial number of window currently displayed on each line
DPYOLD: BLOCK MAXLIN ;-1 for each DM line being output in previous DPYOUT
DPYNEW: BLOCK MAXLIN ;-1 for each line needing redrawing in next DPYOUT
BRKTAB: BLOCK 4 ;For reading activation table
PURE
;(empty page)
;DUMSER DUMMY LDUMMY DUMDOT LDUMDO DUMSTR LDUMST DOTS LDOTS
DUMSER←←<0,,-6> ;serial number for blank line
;blank line with a space in it to erase DD line
LDUMMY+2
DUMMY: .,,.
2,,0 ;Not-so-phony character counts
0,,DUMSER ;Phony flags,,serial number
0 ;window this text is in
ASCID /
/
LDUMMY←←.-DUMMY
;dummy trailer text block for use in delimiting screen in mult window case
LDUMDO+2
DUMDOT: .,,.
13,,0 ;Not-so-phony character counts
0,,DUMSER-1 ;Phony flags and serial number
0 ;window this text is in
ASCID /.........
/
LDUMDO←←.-DUMDOT
;dummy trailer text block for use in delimiting screen in mult window case
LDUMST+2
DUMSTR: .,,.
13,,0 ;Not-so-phony character counts
0,,DUMSER-2 ;Phony flags and serial number
0 ;window this text is in
ASCID /*********
/
LDUMST←←.-DUMSTR
;elipsis for middle of big attach buffer being display
LDOTS+2
DOTS: 0
0
0,,DUMSER-3 ;Phony serial number and flags
0 ;window this text is in
ASCID / . . .
/
LDOTS←←.-DOTS
;⊗ MTLINE LOADM0 LOADMT DPYINI DPYCHG DPYCHK DPYCH2 DDBOG
MTLINE: 0 ;Do a PTLOAD MTLINE to avoid ALLACT activations.
[ASCIZ/
/]
LOADM0: SETOM NOSTEP ;Suppress next display update if stepping macros
LOADMT: SKIPLE CURMAC
JRST POPJ1 ;Expanding macro, take skip return.
SKIPLE DPY ;Don't do PTLOAD if not a display.
PTLOAD MTLINE ;Load null line to give us our 400s and disable ALLACT.
POPJ P,
DPYINI: MOVEI T,"→"*2+1
MOVEM T,ARRON
DPYCHG: SETOM TTYNUM ;force recalculation of display parameters by
SETOM DPY ; clearing remembered tty number and display type
DPYCHK: PUSH P,A
IFE DECSW,<
HRROI A,[15000,,A]
TTYSET A, ;Get display height from system
>
IFN DECSW,<
MOVE A,[2,,[.TODPH ↔ 0]]
TRMOP. A, ;get display height
MOVEI A,=24
>
CAMN A,DPYHGT# ;skip if display height changed
JRST DPYCH2 ;no change
SETOM TTYNUM ;changed height, force recalculation of parameters
SETOM DPY ; by clearing remembered tty number and display type
SETOM WINADJ# ;force all windows to get adjusted
DPYCH2:
IFE DECSW,<
HRROI A,[3000,,A]
TTYSET A, ;Get line characteristics into A
CAMN A,[-1] ;Skip unless detached
MOVEI A,-2 ;No bits, TTY number of -2 means detached
MOVEI DSP, ;0 means TTY
TLNE A,DD
MOVEI DSP,1 ;1 means Data Disc
TLNE A,III
MOVEI DSP,2 ;2 means III
TLNE A,DM
MOVEI DSP,3 ;3 means DM
SETZM DMLINE ;Assume not on DM
TLNE A,DM
SETOM DMLINE
>;NOT DECSW
IFN DECSW,<
SETZM DMLINE
MOVEI DSP,0
MOVE A,[2,,[.TOTTY ↔ 0]]
TRMOP. A,
MOVEI A,0
JUMPGE A,.+3
SETOM DMLINE
MOVEI DSP,3
MOVNI A,1
GETLCH A
>;DECSW
HRRZ A,A
CAMN A,TTYNUM
JRST POPAJ
MOVEM A,TTYNUM#
SKIPN NWIPE ;Skip if coming from TOPSET, etc.
TRO F,DSPALL ;force whole screen to be updated
CAMN DSP,DPY ;skip if display type changed
JRST POPAJ
PUSH P,B
PUSH P,T
PUSH P,TT ;we'll return via TTTBAJ to restore these ACs
MOVEM DSP,DPY
MOVEI T,-1 ;Force CHKHGH (via SETSCR) to fix up HGHWRD
MOVEM T,SCRHGH ; for new display type
MOVE T,PPSET+1(DSP) ;Routine to position PP and set up CRLF routines.
MOVEM T,PPSET
MOVE T,WIPI+1(DSP)
MOVEM T,WIPI
MOVE T,DISPI+1(DSP)
MOVEM T,DISPI
MOVE T,SRCDPY+1(DSP)
MOVEM T,SRCDPY ;For displaying search page number
MOVE T,SRCDP3+1(DSP)
MOVEM T,SRCDP3 ;For erasing search page number
MOVE T,LETST+1(DSP)
MOVEM T,LETST ;For moving page down when editing long line on DD.
MOVE T,LEPREP+1(DSP)
MOVEM T,LEPREP ;For moving page down when editing long line on DD.
MOVE T,LINECI+1(DSP)
MOVEM T,LINECI ;For incrementally updating line nbr in trailer
SOJL DSP,NODPY ;Decrement display type and jump if TTY
PUSHJ P,SEMODE ;Make sure EMODE and other special dpy bits are on
;At this point, DSP contains one less than display type
MOVN T,TTYNUM ;get negative tty line nbr
MOVS T,T ;-tty in LH
HRRI T,RBUF ;place for PPSPY stuff to go, in RH
PPSPY T, ;find out color of DD, in case we're on one
TDZA T,T ;shouldn't fail, but assume not on DD
MOVS T,RBUF+2
ANDI T,100000 ;just the green-on-black bit
MOVEM T,DDCOLR# ;remember initial color
LSH T,-=15 ;shift bit to low order position
MOVE TT,DDFNCN+1(T) ;get appropriate function select for given color
MOVEM TT,DDFNCN ;and store for normal display program use
MOVSI TT,(<<CW 0,4,0,0,0,0>-4>) ;get color bit to diddle in DD cmd words
FOR X IN(DDCL0,DDCL1,DDCL2,FIRWRD)
< IORM TT,X
>
JUMPN T,DDBOG ;jump if green on black
FOR X IN(DDCL0,DDCL1,DDCL2,FIRWRD)
< ANDCAM TT,X ;turn all these bits on
>
DDBOG: FOR X IN(ARRPOS,AR2POS,PCOMP,P2COMP,DISPXA,DBLTI,DISP1A,<DISP2I>
,SPCOUT,ARPOS2,MASK,DDWAIT,DISPAI,DDISPI,DCURI,LINMAX,DDCOLS,SRCDP4,<SRCDP5>)
< MOVE T,X+1(DSP)
MOVEM T,X
>
MOVE T,FIRWRD(DSP)
MOVEM T,DPYBUF
MOVEM T,SRCDD ;For displaying search page number
PUSHJ P,SLSRCP ;Set up SRCDD+1 with right position of screen
;DPYI6 DPYI7 DPYI9 DPYI9A DPYI8 NODPY DPYI2 DPYI3A DPYI3 DPYI5 DPYI5A DPYI4 WHOOFF WHOON WHOON2 GETTIM SEMODE SETSCR ATTSXT EXSETA EXSETB
;Fell thru
;Note that TTYs and DDs get here w/DSP=0 whereas other displays have DSP positive
;(I'm not sure if DSP is used hereafter, however.)
DPYI6: PUSH P,SCRLOW ;remember old bottom of display area
PUSHJ P,DPYI2 ;get display height from system, set PP position
MOVE T,(P) ;old display bottom
MOVE TT,SCRLOW ;new one
CAMN T,SCRBOT ;this window used to reach bottom of screen?
MOVEM TT,SCRBOT ;yes, make it still do so
PUSHJ P,DPYI5 ;set up window's position and parameters
PUSHJ P,DPYI3A ;erase screen if needed
AOSE WINADJ ;do we need to adjust all other windows?
JRST DPYI9A ;no, restore ACs and return
PUSH P,C ;save more ACs, clobbered by SELWIN
PUSH P,D
PUSH P,WINNBR ;yes, remember current window's number
PUSH P,NWINS ;number of other windows
DPYI7: SOSL T,(P) ;get index of next window in the window stack
JRST DPYI8 ;go fix up that window
SUB P,[1,,1] ;no more windows, flush count from stack
POP P,A ;get back number of original window
CAMN A,WINNBR ;already selected?
JRST DPYI9 ;yes
PUSHJ P,FNDWIN ;find original window from number in A
PUSHJ P,SELW00 ;reselect original window, from ptr in A
PUSHJ P,DPYWST ;claim window's screen lines
DPYI9: POP P,D
POP P,C
DPYI9A: SUB P,[1,,1] ;forget old SCRLOW value
JRST TTTBAJ ;restore TT,T,B,A and return
;Here with T holding stack depth of some window. We fix up the old windows
;from the bottom of the stack upward so that ones nearer the stack top will
;claim screen lines overriding claims of deeper windows in the stack.
DPYI8: HLRZ A,WINSTK(T) ;get number of this window from the stack
PUSHJ P,FNDWIN ;find window from window number in A
PUSHJ P,SELW00 ;select window whose ptr is in A
MOVE T,-4(P) ;old display bottom
MOVE TT,SCRLOW ;new one
CAMN T,SCRBOT ;this window used to reach bottom of screen?
MOVEM TT,SCRBOT ;yes, make it still do so
PUSHJ P,DPYI5 ;fix up the window for new display height
JRST DPYI7 ;loop through windows
NODPY: AOJA DSP,DPYI6 ;got here with DSP/-1 for non-display, make it 0 like DD
;get display height from system, set PP position
DPYI2:
IFE DECSW,<
HRROI TT,[6000,,DPYWID]
TTYSET TT, ;Store away the terminal's line width
HRROI TT,[15000,,TT]
TTYSET TT, ;Get display height from system
>;IFE DECSW
IFN DECSW,<
MOVEI TT,=80 ;I don't know how to do this for DEC, so fudge
MOVEM TT,DPYWID ;Store terminal's line width
MOVE TT,[2,,[.TODPH ↔ 0]]
TRMOP. TT, ;get display height
MOVEI TT,0 ;failed, use non-display height of zero
>;IFN DECSW
TLNE TT,-1
SETZ TT, ;Detached or something, unreasonable height
MOVEM TT,DPYHGT#
JUMPN TT,.+2
MOVEI TT,=40 ;Assume DD size for non-display
;Now we figure max size of text display area
SUB TT,PPSIZ ;display height - size of page printer
SUB TT,PPIGN# ;minus lines unused below page printer
MOVEM TT,PPPOS# ;store starting line of page printer
SUBI TT,1 ;trlr line is just above PP
MOVEM TT,SCRLOW# ;store number of multi-window trlr line
;mark all screen lines below text display area free (not in any window)
SETZM DPYWIN(TT) ;make sure lines below display area are unclaimed
MOVEI TT,DPYWIN+1(TT) ;BLT dest
HRLI TT,-1(TT) ;BLT source
BLT TT,DPYWIN+MAXLIN-1 ;unclaim all lines below display area
;now position page printer
MOVE G,PPPOS
PUSHJ P,P2COMP ;calculate vertical position of page printer
HRRZM T,DPPPOS# ;remember it
MOVE T,PPSIZ
LSH T,9
TRO T,1
MOVEM T,DPPSIZ#
JRST @PPSET ;position page printer and return
;erase screen if needed
DPYI3A: SKIPE NWIPE ;Did we just come from TOPSET, BOTSET, etc?
JRST DPYI3 ;Yes, don't erase anything, nor force redrawing all
MOVE T,[DPYTAB-1,,DPYTAB]
BLT T,DPYTAB+MAXLIN-1 ;force WIPIT (via WIPE) to erase all leading cols
MOVE T,[40,,DUMSER] ;serial number and leading char for blank line
SKIPLE TT,SCRHGH ;first line used on screen
MOVEM T,DPYTAB(TT) ;assume unused lines at top of screen are blank
SOJGE TT,.-1 ;usually this just marked two wholine lines blank
TRO F,DSPALL
PUSHJ P,WIPE ;erase whole screen
DPYI3: SETZM NWIPE ;Clear flag
IFN PURESW,<
IFE DECSW,<
SKIPL JOBHRL↑
>;NOT DECSW
IFN DECSW,<
MOVEI A,1
SETUWP A,
POPJ P,
TRNN A,1
>;DECSW
OUTSTR [ASCIZ/Upper segment not write protected.
/]
IFN DECSW,<
SETUWP A,
JFCL
>;DECSW
>;PURESW
POPJ P,
DPYI5: MOVE TT,SCRLOW ;multi-window trlr line nbr
SETOM LSTARR
SETOM LSTPAG ;force page and line numbers typed on non-display
CAMGE TT,SCRBOT ;is trlr line already set, but too low on screen?
MOVEM TT,SCRBOT ;yes, fix it (just above PP)
SKIPE SCRBOT ;ignore this cell if not set yet
MOVE TT,SCRBOT ;get trlr line number (maybe above some windows)
SUB TT,SCRTOP ;discount number of lines above window
SUBI TT,1 ;discount one line for header
SKIPE G,NLINEU ;User may have set this number of text display lines
CAMLE G,TT ;Can't have more lines than there are
SKIPA G,TT ;Use default screen size
CAML G,TT
SETZM NLINEU ;Now using default screen size
MOVEM G,NLINER ;Real number of lines being used
CAIL G,ATTMXM+TXTMIN ;Room for min attached lines + min others?
JRST DPYI4 ;Okay
MOVEI T,2 ;try for two line header (in case changed displays)
SKIPG WHOJOB ;don't leave room for wholine if we turned it off
CAML T,SCRTOP ;is this an improvement?
JRST DPYI5A ;no, try smaller top
MOVEM T,SCRTOP ;use two line top to leave room for wholine
JRST DPYI5 ;try atain with two line top
DPYI5A: MOVE T,TOPPER+SMINIM ;Shrink optional areas as far as possible
EXCH T,SCRTOP
CAME T,SCRTOP
JRST DPYI5 ;That may be enough. Now try again.
MOVE T,BOTTER+SMINIM ;Minimum PP size
EXCH T,PPSIZ
SETZM SCRBOT ;don't ignore any lines between window and PP
CAME T,PPSIZ
JRST DPYI5 ;Now try once more
FATAL Display screen is too small.
DPYI4: MOVE T,SCRLOW ;multi-window trlr line
SKIPN SCRBOT ;skip if trlr line already set
MOVEM T,SCRBOT ;set trlr line number
MOVE B,SCRBOT ;window's trlr position
MOVE A,SCRTOP ;set up for SETSCR
SUB B,A ;minus hdr position gives text lines+1
ADDI B,1 ;text lines+2 is SCRSIZ (includes hdr and trlr)
JRST SETSCR ;fix up window parameters
WHOOFF:
IFE DECSW,<
MOVE TT,[-2,,[42000,,TT ;Get job number in wholine
4000,,400+"W"]] ;BRK W to turn off wholine
TTYSET TT, ;Don't let wholine overwrite text display
JUMPLE TT,CPOPJ
MOVEM TT,WHOJOB ;Remember job number for turning back on
PUSHJ P,GETTIM ;Get login time of wholine job
MOVEM TT,WHOTIM ;Remember login time of wholine job
>;NOT DECSW
IFN DECSW,<
HLLOS WHOJOB ;Remember that we turned off the wholine
MOVE TT,[3,,[.TOESC ↔ 0 ↔ <400000+"W",,0>]] ;BRK W
TRMOP. TT,
JFCL
>;DECSW
POPJ P,
WHOON: SKIPG WHOJOB ;Turn wholine back on if turned it off before
POPJ P,
IFE DECSW,<
PUSHJ P,GETTIM ;Get login time of previous wholine job
CAME TT,WHOTIM ;Still same as when we turned off wholine?
JRST WHOON2 ;No, must be different job
HRROI TT,[42000,,TT] ;Find out wholine job number
TTYSET TT,
JUMPN TT,WHOON2 ;Jump if non-display or if wholine already on
MOVE TT,WHOJOB
LSH TT,9 ;Put ESC argument into bits 18:16
IOR TT,[4000,,200+"W"] ;Force explicit ESC n W command
MOVEM TT,WHOJOB
HRROI TT,WHOJOB
TTYSET TT, ;Turn on old job's wholine on our display
>;NOT DECSW
IFN DECSW,<
MOVE TT,[3,,[.TOESC ↔ 0 ↔ <"W",,0>]] ;ESC W
TRMOP. TT,
JFCL
>;DECSW
WHOON2: SETZM WHOJOB ;No longer have wholine off
POPJ P,
IFE DECSW,<
GETTIM: MOVEI TT,251
PEEK TT, ;Get address of JBTBTM
ADD TT,WHOJOB ;Make pointer to JBTBTM for wholine job
PEEK TT, ;Get login time for wholine job
POPJ P,
>;NOT DECSW
;Suppress ctrl cr and turn on EMODE for 400s plus other special dpy bits.
SEMODE: SETACT [BRKTAB,,[-1↔-1↔-1↔-1,,600000!SUPCCR!EMODE!ALLACT!SUPERS!SUPEOL]]
MOVE T,BRKTAB+3
TRNN T,EMODE ;If EMODE wasn't already on, and
SNEAKS TT, ;there is any typeahead, then need to do PTLOAD
POPJ P, ;No typeahead
PUSHJ P,LOADMT ;Load null line to give us our 400s!
POPJ P, ;LOADMT skips if expanding a macro
POPJ P,
;Calculate parameters dependent on window size. Call with SCRTOP's new value
;already set, w/SCRSIZ's new value-to-be in B, and w/SCRBOT already set.
SETSCR: MOVEM B,SCRSIZ ;Set count of lines in display, header thru trailer
PUSHJ P,CHKHGH ;see if SCRHGH and HGHWRD need fixing
PUSHJ P,ATTSXT ;set max attach buffer display size
;Now fix array that indicates which window each screen line is currently owned by.
PUSHJ P,DPYWST ;claim screen lines that this window will use
SKIPN PAGE
POPJ P,
PUSHJ P,LINSET
MOVEI A,1
JRST SETWIN
;Limit max att buffer display size to amt we have room for in window.
ATTSXT: MOVE A,ATTMAD ;Get desired att buf display max
MOVE B,NLINER ;number of text lines
CAILE A,-TXTMIN(B) ;make sure have min space for text on screen
MOVEI A,-TXTMIN(B) ;reduce max att buf display size
MOVEM A,ATTMAX ;set new effective max
LSH A,-1 ;Divide by 2
MOVEM A,ATTMX2 ;Remember half of max value
TRNN F,ATTMOD ;In attach mode, have to check max attach display
POPJ P,
EXSETA: MOVE T,ATTNUM ;Number of lines attached
EXSETB: CAMLE T,ATTMAX
MOVE T,ATTMAX ;New max number we will display
JRST EXSET
;WIPE IWIPE DMWIPE WIPER WIPER2
;Here to erase screen, or portion thereof.
WIPE: XCT WIPI ;DD: PUSH P,A; III: JRST IWIPE; DM: JRST DMWIPE.
PUSH P,B
PUSHJ P,WIPER ;Generate erase program
MOVEI T,0
IDPB T,POSLST ;No more DD line selects, mark end of list
IFE FTF2,< ;No second field on F2's Grinnell, don't bother w/inbetween lines
PUSHJ P,DDCOP ;CAN'T POSSIBLY SKIP ;Double the buffer for second field.
CAIA ;OK
PUSHJ P,TELLZ ;Wasn't enough room for doubled erase program
PUSHJ P,LINREL ;adjust field of copy of display program
MOVE B,TT ;Save size of one copy of erase program
PUSHJ P,DDCOP ; and double it again
CAIA ;OK
PUSHJ P,TELLZ ;Wasn't enough room for quadrupled erase program
PUSHJ P,LINRL2 ;Adjust 3rd quarter down by 2 scanlines
ADD TT,B
PUSHJ P,LINRL2 ;Adjust 4th quarter down by 2 scanlines
>;IFE FTF2
SETZM CUROLD ;No old special cursor to erase later
JRST DISPX ;Now put out dislay and POP A and B.
IWIPE:
IFE DECSW,< ;AVOID UNDEF OPCODE FOR III
SETZM DPYHED+1 ;make length of display program zero
DPYOUT TXTPOG,DPYHED ;flush text POG's display
>
POPJ P,
DMWIPE: PUSH P,A
PUSH P,B
PUSHJ P,WIPER ;Generate erase program
JRST DISPX
;Subroutine for WIPE to generate (if NWIPE/0) whole-screen erase program
;for DD and DM. Also called (via WIPE, with NWIPE/-N,,L) to erase N lines
;starting at line L.
WIPER: MOVE H,PSHINI ;Set up ptr depositing words in display program
MOVE T,[2200,,RBUF-1]
MOVEM T,POSLST ;Byte ptr for collecting DD position word locations
SKIPE NWIPE ;Here from TOPSET or BOTSET?
JRST WIPER2 ;Yes
SKIPE DDACT
DPYOUT [1000,,0↔0] ;Wait for DD display, flush pending DM display
PUSH H,HGHWRD ;Position to first screen line used by display area
IDPB H,POSLST ;Remember where DD line select commands are
MOVE T,SCRHGH ;first screen line used by display area
SUB T,PPPOS ;erase to end of display area
PUSHJ P,WIPI3 ;Erase all lines from top of screen to page printer
SETOM OLDARR
POPJ P,
;Here for TOPSET or BOTSET or HEIGHT requesting erase of a few lines
;LH of NWIPE is negative number of lines to erase, RH of NWIPE is line to start at
WIPER2: HRRZ G,NWIPE ;Line number to start erase at
SKIPE DDACT
XCT DDWAIT ;Wait for DD display before clobbering buffer
PUSHJ P,PCOMPS ;Position to right place
HLRE T,NWIPE ;Negative of number of lines to erase
PUSHJ P,WIPI3
SETOM OLDARR
POPJ P,
;GOLINE GOLIN1 GOLIN3 GOLIN5 GOLIN4 GOLIN2 NMVAR1 NMVARR MOVARR SETARR
;Go to specific line whose number is argument.
GOLINE: CAIE B,CTMT3 ;αβL means absolute line number of incore pages
GOLIN1: SKIPN XPLST
JRST GOLIN2
;Anything else means relative to "arrow page"
PUSHJ P,GPAGL ;Get <line>,,<page> for arrow line
HLRZ B,T ;Save line number
ANDI T,-1 ;Just page number for now
CAME T,FIRPAG ;Pointing to first incore page?
JRST GOLIN3
HLRZ T,PMLNBR(TT) ;Line number of first pagemark (below arrow)
JRST GOLIN4 ;T now holds max line number allowed to move to
GOLIN3: HLRZ T,PMLNBR(TT) ;Line number of pagemark beginning arrow page
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,GOLIN5
MOVEI T,-1 ;Arrow page is last one in core--no limit to line number
JRST GOLIN4
GOLIN5: HLRZ TT,PMLNBR(TT) ;Line number of pagemark ending arrow page
SUB TT,T ;Max line number accepted for arrow page
MOVE T,TT
GOLIN4: TRNE F,REL
ADDI A,(B) ;Relative to current line
JUMPG A,.+2
MOVEI A,1 ;Can't go back beyond line 1 of arrow page
CAMLE A,T
MOVE A,T ;Can't go beyond last line +1 of arrow page
SUBI A,(B) ;Amount to move
JRST MOVARR
GOLIN2: TRNN F,REL
JRST SETARR
JRST MOVARR
TRC T,SBKWDS ;XCTed if Find string ended with ⊗BS or ⊗U
NMVAR1: AOS (P)
NMVARR: MOVNS A
MOVARR: ADD A,ARRL
SETARR: MOVE T,LINES
CAIGE A,1
MOVEI A,1
CAILE A,1(T)
MOVEI A,1(T)
CAILE A,(T)
TLOA F,OFFEND
TLZ F,OFFEND
PUSHJ P,OLDSAV ;Remember line we're coming from
PUSHJ P,FNDLIN ;Gets new line pointer-location into T
MOVEM A,ARRL ;Save new arrow line
CAME A,SRCL
SETOM SRCOFF ;No search string found on this line
MOVSI TT,ARRBIT
EXCH T,ARRLIN ;Replaces ARRLIN value and gets old location into T
JUMPE T,.+2
ANDCAM TT,TXTFLG(T) ;Turns old ARRBIT off
MOVE T,ARRLIN ;Now go to new line
IORB TT,TXTFLG(T) ;and set its ARRBIT
TLNE TT,PMARK ;Is it a page mark?
TLOA F,PMLIN ;Yes (this makes the sign negative)
TLZ F,PMLIN ;No
HRRZ TT,TXTCNT(T) ;Is it a null line?
SKIPE TT
TLZA F,NULLIN ;No
TLO F,NULLIN ;Yes
TLO F,DSPTRL ;Force recalculation of trailer values
POPJ P,
;GPGLS GPGLS3 GPGLS5 GPGLS2 GPGLS4 TRAILS TRAIL6 TRAIL7 TRAIL8 TRAIL9 SETWR4 SETWR5 TRAI11 SETWR6 SETWR7 TRAI10 DSTRL HEADS HEADS0 HEADS3 HEADS4 HEADS5 HEADS6 HEADSU HEADST POPCAJ ;⊗ GPGLS GPGLS3 GPGLS5 GPGLS2 GPGLS4 TRAILS TRAIL0 TRAIL6 TRAIL7 TRAIL8 TRAIL9 SETWR4 SETWR5 TRAI11 SETWR6 SETWR7 HEADS HEADS0 HEADS3 HEADS4 HEADS5 HEADS6 HEADSU HEADST POPCAJ
;TT ← <line>,,<page>; T ← <lines on current page>
GPGLS: PUSHJ P,GPAGL
PUSH P,T ;Save <line>,,<page>
SKIPN XPLST
JRST GPGLS2 ;Only one page in core
MOVEI T,(T)
CAME T,FIRPAG
JRST GPGLS3
HLRZ T,PMLNBR(TT) ;Line number of first pagemark
SOJA T,GPGLS4
GPGLS3: HLRZ T,PMLNBR(TT) ;Line number of pagemark beginning pointed-to page
MOVN T,T
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,GPGLS5
ADD T,LINES ;Final page in core is pointed to
JRST GPGLS4
GPGLS5: HLRZ TT,PMLNBR(TT) ;Line number of next pagemark
ADDI T,-1(TT) ;Don't count pagemark line itself in line count
JRST GPGLS4
GPGLS2: MOVE T,LINES
GPGLS4: POP P,TT ;<line>,,<page>
POPJ P,
;Update trailer line's data. Clobbers A,T,TT. Expects DSPTRL to be off.
;Here from DISP.
TRAILS: PUSHJ P,TRAIL0 ;fix up trailer's text
TDNE F,[DSPTRL,,DSPALL] ;Don't update arrow line number if redrawing trailer
TLZ F,DSPLIN ; or if redrawing whole screen
TLZN F,DSPTRL ;Did we find anything had changed?
POPJ P, ;no
;Force redisplay of trailer line.
MOVE T,OLDTRL ;get line number where old trailer was
HLLZS DPYTAB(T) ;Force redisplay of trailer line
SKIPE DPY ;We only show trailer line on displays
TRO F,DSPSCR
POPJ P,
;Here from DISP and SELWIN.
;SELWIN doesn't want to call DSTRL.
TRAIL0: PUSH P,C
PUSHJ P,GPGLS ;TT ← <line>,,<page>; T ← <lines>
PUSH P,TT ;Save <line>,,<page>
CAMN T,DLINES
JRST TRAIL6 ;Number of lines hasn't changed
TLO F,DSPTRL
MOVEM T,DLINES
PUSHJ P,NUMSTD
MOVEM C,BOTLN4
MOVEM C,BOTLN5
TRAIL6: HLRZ T,(P) ;Get current line
CAMN T,DARRL
JRST TRAIL7
XCT LINECI ;TTY: JFCL. DD: TLO F,DSPTRL. Others: TLO F,DSPLIN
MOVEM T,DARRL
PUSHJ P,NUMSTD
MOVEM C,BOTARR
MOVEM C,BOTAR2
TRAIL7: POP P,T
MOVEI T,(T) ;Current page
CAMN T,DCURPG
JRST TRAIL8
TLO F,DSPTRL
MOVEM T,DCURPG
PUSHJ P,NUMSTD
MOVEM C,BOTPG2
MOVEM C,BOTPG4
TRAIL8: MOVE T,PAGES ;Now get the total number of pages
CAMN T,DPAGES
JRST TRAIL9
TLO F,DSPTRL
MOVEM T,DPAGES
PUSHJ P,NUMSTD ;Get ASCID equivalent
TRNN F,DIROK ;Is the directory okay?
MOVE C,[ASCID /? /] ;No, so say "? "
MOVEM C,BOTPG3 ;Deposit the total page count
MOVEM C,BOTPG5 ;on both types of bottom line
TRAIL9: MOVE T,ROOM ;Code to put C, B, and X values on trailer.
SUB T,CHARS
CAMN T,DBLOAT
JRST SETWR7
MOVEM T,DBLOAT
TRNE F,FILLUZ
JRST TRAI11 ;Record and bloat numbers are meaningless
SETZM WFLAG5#
JUMPGE T,SETWR4
SETOM WFLAG5 ;Flag is - if not enough room
MOVMS T
SETWR4: CAIG T,200*5
JRST SETWR5 ;Report difference as a + or - number
IDIVI T,200*5 ;But in this case as number of records
SKIPE WFLAG5
ADDI T,1 ;Minimum X value is 2
PUSHJ P,NUMSTD ;Convert to ASCID
SKIPE WFLAG5
TRO C,"X"⊗1
SKIPN WFLAG5
TRO C,"B"⊗1
JRST SETWR6
SETWR5: PUSHJ P,NUMSTD ;Convert to ASCID
LSH C,-7 ;Make room for sign
SKIPE WFLAG5
TLO C,"+"⊗13 ;Report needed space as +
SKIPN WFLAG5
TLO C,"-"⊗13 ;Report available space as -
TROA C,"C"⊗1!1 ;Add the letter C and make it ASCID
TRAI11: MOVEI C,1 ;No B/X/C field if file not formatted
SETWR6: CAMN C,WFLAG3
JRST SETWR7
TLO F,DSPTRL
MOVEM C,WFLAG3
MOVEM C,WFLAG4
SETWR7: MOVE T,ROOM ;Now figure out number of records available
CAMN T,DROOM
JRST POPCJ ;restore C and return
TLO F,DSPTRL
MOVEM T,DROOM
IDIVI T,200*5
PUSHJ P,NUMSTD
TRNE F,FILLUZ
MOVSI C,(<ASCII/ ?/>) ;File not formatted, say ?R
TRO C,"R "⊗1!1
MOVEM C,RFLAG3
MOVEM C,RFLAG4
JRST POPCJ ;restore C and return
;Update text of various flags plus line number in header line,
;in case they've changed. Clobbers only Q,T,TT. Here from DISP and HEADER.
HEADS: MOVEI Q,WINDAT ;use current window's hdr data
MOVE T,TOPWIN ;Line number of line at the top
PUSHJ P,HEADST ;set top line number into header, skip if no change
SETOM SOMOD2-WINDAT(Q) ;make header get forced out below
;Enter here from OWDISP, with window ptr in Q (preserved here).
HEADS0: MOVE TT,AFLAG-WINDAT(Q) ;Get new value of /-A switch on header line
CAMN TT,AFLAG2-WINDAT(Q) ;Same as before?
JRST HEADS3 ;Yes
MOVEM TT,AFLAG2 ;no, update it
SETOM SOMOD2-WINDAT(Q) ;Force header to be redisplayed below
HEADS3: MOVE TT,UIFLG-WINDAT(Q) ;Get new value of U, I, A flags on header line
CAMN TT,UIFLG2-WINDAT(Q) ;Same as before?
JRST HEADS4 ;Yes
MOVEM TT,UIFLG2-WINDAT(Q) ;no, remember new value in second version
SETOM SOMOD2-WINDAT(Q) ;Force header to be redisplayed below
HEADS4: MOVE TT,EMFLG-WINDAT(Q) ;Get new value of E, M, R, V flags on header line
CAMN TT,EMFLG2-WINDAT(Q) ;Same as before?
JRST HEADS5 ;Yes
MOVEM TT,EMFLG2-WINDAT(Q) ;no, remember new value in second version
SETOM SOMOD2-WINDAT(Q) ;Force header to be redisplayed below
HEADS5: MOVE TT,HWFLG-WINDAT(Q) ;Get new value of HW flag (hidden windows)
CAMN TT,HWFLG2-WINDAT(Q) ;Same as before?
JRST HEADS6 ;Yes
MOVEM TT,HWFLG2-WINDAT(Q) ;no, remember new value in second version
SETOM SOMOD2-WINDAT(Q) ;Force header to be redisplayed below
HEADS6: MOVE TT,SOMOD-WINDAT(Q) ;Get new value of subjob output char
CAMN TT,SOMOD2-WINDAT(Q) ;Same as before?
POPJ P, ;Yes
MOVEM TT,SOMOD2-WINDAT(Q) ;no, remember new value in second version
;Note: because of the way the above code forces hdr line to be output,
;SOMOD2 must be last in this list of cells checked!
HEADSU: CAIN Q,WINDAT ;current window?
JRST DSHED ;yes, force out header line
HLLZS DPYTAB(G) ;no, make this line get output (this is hdr line)
POPJ P,
;Here from HEADS above and from OWDIS1. Updates number of window's top line
;in hdr text. Skips if it hasn't changed.
HEADST: CAMN T,TOPWI2-WINDAT(Q) ;top line number change?
JRST POPJ1 ;nope
MOVEM T,TOPWI2-WINDAT(Q) ;yes, remember line number displayed in hdr
PUSH P,A
PUSH P,C
PUSHJ P,NUMSTD ;Get ASCID equivalent of T into C
MOVEM C,HEDLIN-WINDAT(Q) ;update line nbr in hdr text
POPCAJ: POP P,C
POP P,A
POPJ P,
;GLUP GLDOWN POPWIN SETWIN WINCHK WINCH2 DWNWIN CENWIN REWIN
;Glitch commands
GLUP: MOVN A,A ;Move text up
GLDOWN: MOVE B,A ;Numeric arg into B
ASH B,2 ;Four lines per somethingorother
TRNE F,EDITM ;If glitching while in line editor, don't want
JUMPN A,JMPGL ; to move arrow line, so use JMP routine
MOVE A,TOPWIN
SUB A,B
CAMLE A,WINMAX
MOVE A,WINMAX
JUMPG A,.+2
MOVEI A,1
CAMLE A,ARRL
PUSHJ P,SETARR ;Move arrow down to keep it on new window
PUSH P,A
ADD A,SCRSIZ ;Find number of new BOTWIN line
SUBI A,3 ;Correction to SCRSIZ for distance 'tween top and bot
MOVE B,ATTNUM ;Number of attach lines displayed decreases the
CAMLE B,ATTMAX ; size of the window
MOVE B,ATTMAX
SUB A,B
CAML A,LINES
JRST POPWIN
CAMGE A,ARRL
PUSHJ P,SETARR ;Move arrow up to keep it on new window
POPWIN: POP P,A
SETWIN: CAMLE A,WINMAX
MOVE A,WINMAX
CAIG A,1
SKIPA A,[1]
SKIPA B,[TOPDSH]
MOVEI B,TOPSTR
MOVEM B,HEDBLK
CAME A,WINMAX
SKIPA B,[BOTDSH]
MOVEI B,BOTSTR
MOVEM B,TRLBLK
CAME A,TOPWIN ;Don't force screen out if not really changing window
SKIPN DPY ;Don't cause spurious retyping of line on non-display.
JRST .+2
TRO F,DSPSCR ;If this is used we only redisplay text as required
SETOM NEEDHD ;set flag for HEADS to recompute line number in hdr
PUSH P,A
ADD A,SCRSIZ
SUB A,EXTRA
SUBI A,3
CAMLE A,LINES
MOVE A,LINES
AOJ A,
MOVEM A,BOTWIN
POP P,A
MOVEI T,-1(A)
SUB T,SCRTOP
MOVNM T,OFFSET
PUSHJ P,FNDLIN
MOVEM A,TOPWIN
MOVSI TT,WINBIT
SKIPE B,WINLIN
ANDCAM TT,TXTFLG(B)
MOVEM T,WINLIN
IORM TT,TXTFLG(T)
POPJ P,
WINCHK: MOVE A,ARRL
CAMGE A,TOPWIN
JRST CENWIN ;Arrow is above screen, center screen around window
WINCH2: CAML A,BOTWIN
JRST DWNWIN ;Arrow apparently below screen
POPJ P,
DWNWIN: CAMLE A,LINES
SOJA A,WINCH2 ;Arrow on extra line of stars, check again
SKIPGE BOTWIN ;Arrow is below screen
JRST REWIN ;Screen isn't really set up
CENWIN: MOVE B,SCRSIZ
SUB B,EXTRA ;Make screen look smaller if any extra lines
ASH B,-1 ;Half of screen size
SUBI A,(B)
AOJA A,SETWIN ;Center screen around arrow
REWIN: MOVE A,TOPWIN
PUSHJ P,SETWIN
MOVE A,ARRL
JRST WINCH2
;⊗ DISP DISP0 DISP00 DISPT2 DISPT3 DISPTC PSHINI DISP1 DISP1B DISP2 DISP2A DISP2M
;Routine to update display. Preserves A,B,C,D,DSP,Q. Clobbers G,H,T,TT.
DISP: SKIPL NODISP# ;Skip if display updating is suppressed
SKIPLE CURMAC ;Don't do anything if expanding macro now,
JRST DISP6 ; except set up window.
DISP0: PUSH P,Q ;preserve Q (DRAW and DISP6 enter here)
PUSHJ P,DISP00 ;do everything, including adjust DISP's return adr
CAIA ;didn't skip, means our return addr is fixed
AOS -1(P) ;skipped, means our return isn't fixed, fix it.
POP P,Q
POPJ P,
;Worker routine for updating display.
DISP00: PUSH P,A
PUSH P,B
SKIPE NOLEDS ;Clear line editor now unless from MACLEX
TRNN F,EDITM
PUSHJ P,LECLR
PUSHJ P,WINCHK
XCT @-4(P) ;Skip if don't need to update display now
AOSA -4(P) ;increment return addr to skip over XCT'd instr
JRST PPBAJ1
SETZM LESIM# ;Assume MACDSL isn't displaying our LE buf
SETZM NOTRLR# ;multiple windows assume current trlr at bottom
AOSN NEEDHD ;did something in hdr line change?
PUSHJ P,HEADS ;Set proper hdr text for UIAML, subjob flags, line
TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAILS ;Yes, do it
DISPT2: SKIPGE TTYNUM ;Did terminal type just change?
JRST DISPTC ;Yes
XCT DISPI ;TTY: JRST TDISP. Others: PPINFO RBUF.
MOVE T,RBUF+23 ;Get GWORD containing line editor wrapped bit
AOSE DIDWR1# ;skip if had wrapped last time at MACLEX
TLNE T,20000 ;has line editor wrapped around lately?
CAIA ;need to redraw line clobbered last time around
SETZM DPYCLB ;no, no need to redraw line after line editor
TLNE T,20000 ;has line editor wrapped around lately?
SETOM DIDWR2# ;set flag to remember next time if from MACLEX
SKIPLE T,DPYCLB ;Force line after last line editor line to be
HLLZS DPYTAB(T) ; redrawn this time.
SETZM DPYCLB ;forget about previously clobbered line
MOVS T,RBUF+2
TRNE T,200000 ;ESC C (or similar) typed?
TRO F,DSPALL ;Yes, redraw everything
TRNN T,20000 ;skip if we're a DD
JRST DISPT3
ANDI T,100000 ;leave just the green-on-black bit
CAMN T,DDCOLR# ;did color change?
JRST DISPT3 ;no
MOVEM T,DDCOLR ;remember new color
SETOM TTYNUM ;force recalculation of display parameters by
SETOM DPY ; clearing remembered tty number and display type
JRST DISPTC
DISPT3: HLRZ T,RBUF+3+1 ;Get Y position for piece of paper 1
TRNE T,2000
IORI T,-2000
CAIN T,@DPPPOS ;Y position correct?
SOSE RBUF+1 ;Yes, PP 1 selected?
DISPTC: TROA F,DSPALL ;No, redraw everything and reposition PP
JRST DISP1
PUSH P,DSP ;DPYCHK clobbers this
PUSH P,TOPWIN ;make sure window doesn't change in DPYCHK
PUSHJ P,DPYCHK ;Maybe he has changed terminals.
POP P,A ;window position to be fixed up
PUSHJ P,SETWIN ;fix up TOPWIN/BOTWIN
POP P,DSP
PUSHJ P,@PPSET ;Reposition PP
JRST DISPT2 ;Now look again in case terminal-type changed
PSHINI: -DPYBSZ+1,,DPYBUF
DISP1: MOVE H,PSHINI ;Init PUSH pointer for depositing into display buf
MOVE T,[2200,,RBUF-1]
MOVEM T,POSLST#
SKIPN DMLINE ;skip if DM
JRST DISP1B
SETZM DPYNEW ;clear table of flags for new lines being output
MOVE T,[DPYNEW,,DPYNEW+1]
BLT T,DPYNEW+MAXLIN-1 ;clear whole table
DISP1B: TRNN F,DSPALL
JRST @DISP1A ;DD: DDISP. III: IDISP. DM: DDISP.
SKIPN DDACT
JRST DISP2
DPYOUT [1000,,0↔0] ;Flush any DM prog in progress, wait for any DD prog
;display whole screen (all display types here)
DISP2: MOVE G,SCRHGH
PUSH H,HGHWRD ;Position display at top of screen
IDPB H,POSLST ;Remember all DD position words for diddling field
HRRZM H,DPYLOC(G) ;Save address in DPYBUF of pos word for line G (III)
SKIPN DMLINE ;skip if DM
JRST DISP2A
SETOM DPYNEW(G) ;all lines in display will be output this time
MOVEI T,DPYNEW+1(G) ;blt dest (assumes display is two or more lines)
HRLI T,-1(T) ;blt source is for first line in display
MOVE TT,SCRLOW ;last line used in text display (trailer)
BLT T,DPYNEW(TT) ;set flags for all lines in display
DISP2A: PUSHJ P,OWDISP ;generate display text for other windows at line G
MOVE A,HEDBLK
MOVEI B,1
PUSHJ P,DBLT ;Output header line
MOVE B,ARRL
SUB B,TOPWIN
MOVE A,WINLIN
JUMPLE B,.+2 ;Jump if arrow on top line
PUSHJ P,DBLT ;Output lines above arrow
TRNE F,ATTMOD
JRST DISPAT
XCT DISP2I ;DD: TRNE F,EDITM. DM: JRST DISP2M. III: JRST DISP3.
SKIPA T,AR2POS ;Don't erase this line since line editor is there
MOVE T,ARRPOS ;Erase this normal line
IFN FTMACL,<
SKIPE NOLEDS ;Display LE buf if awaiting rest of cmd
SKIPLE CURMAC ;If from LE in macro, need to display our LE buf
MOVE T,ARRPOS ; so want normal line erasing mode on DD
>;FTMACL
PUSH H,T
PUSH H,ARRON ;Output arrow
SKIPA T,ARRON
DISP2M: MOVEI T,1 ;Mark line as normal on DM
DPB T,[271000,,DPYTAB(G)] ;Remember char appearing in leading col on line G
;FALLS THRU
;DISP3 DISP4 DISP5 DISP5A DISP5B DISP5C EXTST EXCLR EXSET OWDISP SOWDSP OWDSPS OWDIS0 OWDIS1 OWDIS7 OWDIS6 OWDIS8 OWDIS9 OWDUP OWDWIN OWDDWN OWDIS2 OWDISN OWDBLA OWDIS5 OWDIS3 OWDIS4
;FELL THRU
;Here if displaying whole screen (DSPALL)
DISP3: TRNE F,EDITM
JRST DISP5
TLNE F,OFFEND
JRST DISP5B ;put out windows below and then trailer
PUSHJ P,DBLT2 ;Output arrow line
DISP4: MOVE B,BOTWIN
SUB B,ARRL
PUSHJ P,DBLT3 ;Output lines below arrow, if any
SKIPE DPYWIN(G) ;skip if can sneak trlr in here on empty screen line
PUSHJ P,OWDISP ;Put out lines before trailer line (other windows)
MOVEM G,OLDTRL# ;remember which screen line trlr is on
MOVE A,TRLBLK
PUSHJ P,DBLT ;Output trailer line
JRST @DISPXA ;DD: DDISPX. III: IDISPX. DM: MDISPX.
;Here if displaying whole screen (DSPALL) while editing line
DISP5: PUSHJ P,DOAR2 ;Take care of line editor line
HRRZM H,DPYLOC(G)
SKIPE LESIM ;Has MACDSL already done the extra lines?
JRST DISP5A ;Yes
MOVEI A,DUMMY
SKIPE B,EXTRA ;Does LE wrap around now?
PUSHJ P,DBLT ;Yes, output a blank line after arrow line
DISP5A: XCT SPCOUT ;DD: reset function to normal. III, DM: JFCL.
TLNE F,OFFEND ;If editing over the stars, we're all done
JRST DISP5C ;except maybe we need to update windows below
HRRZ A,@ARRLIN ;Otherwise, output lines below arrow line
JRST DISP4
;Here if displaying whole screen with arrow off end of page, maybe in line editor
DISP5B: SETOM DBLTAR# ;set flag to prevent DBLT from diddling new arrow
DISP5C: PUSHJ P,OWDISP ;Put out lines before trailer line (other windows)
MOVEM G,OLDTRL# ;remember which screen line trlr is on
MOVE A,TRLBLK
TRNE F,EDITM ;if not in line editor,
CAMLE G,SCRBOT ; or if there were windows under current one,
PUSHJ P,DBLT ; then display current trailer
JRST @DISPXA ;DD: DDISPX. III: IDISPX. DM: MDISPX.
EXTST: XCT LETST ;Is line editor gonna wrap around now?
EXCLR: TDZA T,T ;Nope
MOVEI T,1 ;Yup, need an extra blank line
EXSET: CAMN T,EXTRA
POPJ P,
MOVEM T,EXTRA#
TRO F,DSPSCR
MOVSI TT,WINBIT
SKIPE T,WINLIN
ANDCAM TT,TXTFLG(T)
SETZM WINLIN
SETOM BOTWIN
JRST LINSET
;Routines to insert into display buffer the text from other windows that appear
;starting at line (G), until reach line from current window or end of screen.
;At OWDISP with DSPALL set.
OWDISP: PUSH P,C ;preserve C
MOVEI Q,DBLTC ;routine to output all text encountered
PUSHJ P,OWDIS0 ;think about other windows here
POP P,C ;restore C
POPJ P,
;At SOWDSP from SHIFT to consider shifting text of non-active windows.
;At OWDSPS from DDISPS to update lines that have changed.
SOWDSP: SKIPA Q,[DMBLTS] ;set routine to call to consider each line
OWDSPS: MOVEI Q,DBLTS ;set routine to call to consider each line
OWDIS0: MOVEM Q,OWDBLT# ;set routine address for PUSHJ P,@OWDBLT
OWDIS1: MOVE Q,WINSER ;restore serial number of currently selected window
CAMGE G,SCRLOW ;quit if beyond end of display (ignore last trlr)
CAMN Q,DPYWIN(G) ;is this line claimed by a different window?
POPJ P, ;nope, let our caller (DISP) handle selected window
MOVEI C,1 ;in case we need a blank line here
SKIPN Q,DPYWIN(G) ;yes, remember new window
JRST OWDBLA ;line unclaimed, put out blank line(s)
MOVEM A,DUMTRL# ;remember type of spcl trlr prev window may need
PUSHJ P,FNSWIN ;find window (ptr to T) from serial number in Q
HRLZ Q,Q ;save serial nbr in LH Q
HRR Q,T ;ptr to window in RH Q
MOVE T,G
SUB T,OFFSET-WINDAT(Q) ;incore line number of place for display of hdr
CAMLE T,LINES-WINDAT(Q) ;skip unless hdr would occur at or below trlr pos
JRST OWDIS6 ;don't display hdr for completely covered window
ADDI T,1 ;line after hdr (first text line displayed)
PUSH P,T ;remember line number
PUSH P,D
MOVEI D,TOPDSH-WINDAT(Q) ;assume dots
CAIN T,1 ;top of incore text displayed?
MOVEI D,TOPSTR-WINDAT(Q) ;yes, display stars
printx fix owdis1 here
;there is still a problem here in that we only have one copy of TOPWI2 and there
;might be several headers displayed for this file if small window(s) occur in
;the middle of this one.
;Also, the line number in the header might be much bigger than the number of
;the last line of the page, which makes the hdr misleading. It should say
;something like Line End instead of Line 16 on a 3 line page.
PUSHJ P,HEADST ;update line nbr in hdr in case other windows moved
PUSHJ P,HEADSU ;hdr line nbr changed, force out hdr line
AOSN NEEDHD-WINDAT(Q) ;did something in hdr line change?
PUSHJ P,HEADS0 ;think about updating header line text
HRRZ A,D ;ptr to hdr line to display
POP P,D ;restore D
MOVEI C,1 ;output one line
PUSHJ P,@OWDBLT ;copy hdr line to display buffer
POP P,TT ;get back line number we start displaying at
;now check for short page (don't display more than LINES+1 lines, incl. trlr).
OWDIS7: HRROI B,[ASCID/ /] ;no more arrows after hdr (in case OWDSPS)
HLRZ T,Q ;window serial nbr
MOVE C,G ;current line
CAMN T,DPYWIN(C) ;count consecutive lines in same window
AOJA C,.-1
SUBI C,(G) ;number of text lines in window to display
MOVE T,LINES-WINDAT(Q) ;number of lines on page
SUBI T,(TT) ;distance from first to last line
ADDI T,2 ;include last line and trlr for possible display
;if T is negative now, then we don't have room for any text from this short page
;since all its text is overlapped by a previous window. In this case, we have
;to reduce the number of blank lines needed by the amt that T is currently negative.
PUSH P,[0] ;assume no blank line adjustment
JUMPGE T,.+2 ;jump unless need to adjust blank line count
MOVEM T,(P) ;store blank line adjustment (negative)
SUBM C,T ;T ← number of extra blank lines needed
JUMPLE T,.+2 ;jump if no blank lines
SUB C,T ;reduce amt of text by number of blank lines
ADDM T,(P) ;remember total blank line count
JUMPLE C,OWDISN ;jump if no room for any text lines
SKIPE T,WINLIN-WINDAT(Q) ;prepare to search window for proper line
JRST OWDWIN ;use top of window ptr
MOVE T,PAGE-WINDAT(Q) ;start counting lines from top of incore text
MOVE TT,G ;first screen line
SUB TT,OFFSET-WINDAT(Q) ;turn screen line into incore line number
SOJE TT,OWDIS2 ;if distance to line 1 is zero, we have FS
JUMPG TT,OWDDWN ;jump if need to go down from top of page
PUSHJ P,TELLZ ;have to go up! don't be silly, we're at top!
;here if we can't display anything in this window because it contains a short
;page that is completely obscured (except for possible trlr) by another window.
OWDIS6: MOVEI TT,-1 ;make it look like we start way down on the page
SKIPN T,DPYWIN-1(G) ;previous line in some window?
JRST OWDIS7 ;no, no spcl trlr needed here
;kludge time
CAME T,WINSER ;was previous line in current window?
JRST OWDIS8 ;no, then we have looped within OWDIS1, use DUMTRL
SKIPE NOTRLR ;skip unless current window's trlr is already done
JRST OWDIS7 ;no spcl trlr needed for window above
MOVE T,TRLBLK ;yes, find out what kind of trlr is needed
MOVEI A,DUMDOT ;assume dots
CAIN T,BOTSTR ;stars?
MOVEI A,DUMSTR ;yes, use different spcl trlr
JRST OWDIS9
;end kludge
OWDIS8: MOVE A,DUMTRL ;see which dummy trlr might be needed
OWDIS9: MOVEI C,1 ;one line to output, maybe
CAIE A,DUMSTR ;if its a dummy trlr,
CAIN A,DUMDOT ; of either kind,
PUSHJ P,@OWDBLT ; then output dummy trlr
JRST OWDIS7 ;fill window with blank lines as needed
OWDUP: HLRZ T,(T) ;go up a line
AOJL TT,.-1 ;found right line yet?
JRST OWDIS2 ;yup
OWDWIN: MOVE TT,G ;current screen line
SUB TT,OFFSET-WINDAT(Q) ;make incore line nbr of desired line
SUB TT,TOPWIN-WINDAT(Q) ;make nbr of lines below WINLIN of desired line
JUMPE TT,OWDIS2 ;jump if exactly right line
JUMPL TT,OWDUP ;jump if need to move up
OWDDWN: HRRZ T,(T) ;go down a line
SOJG TT,.-1 ;loop until right line
OWDIS2: MOVE A,T ;addr of first line to display (nbr already in C)
PUSHJ P,@OWDBLT ;copy lines to display buffer
OWDISN: POP P,C ;get back number of blank lines needed
JUMPL C,OWDIS5 ;jump if no blank lines needed, trlr not put out
OWDBLA: MOVEI A,DUMMY ;put out blank lines to fill window area
JUMPE C,OWDIS4 ;jump if no blank lines but trlr already put out
PUSHJ P,@OWDBLT ;fill window with blank lines
JRST OWDIS4 ;had blank lines at end, no spcl trlr, maybe erase
;no room for trlr precisely in window, but maybe line after window is unclaimed
;and we can sneak our trailer in there (if it is unused, then we Need to put
;trlr there to delimit the text area). If can't put trlr on following line,
;then check for which spcl trlr to use, if any, in case next line is end of screen.
;T has negative blank line count. -1 means one more line would end page.
OWDIS5: AOJN C,OWDIS3 ;jump if need "dots" trlr (some text not shown)
MOVEI A,DUMSTR ;use "stars" trlr (all text
JRST OWDIS4 ;put out spcl trlr if current window has own trlr
;check for special trailer to delimit end of window not delimited by next window.
;note that the SCRLOW line (last trlr line) on the screen is not claimed by
;any window, so DPYWIN(SCRLOW) is always zero.
OWDIS3: MOVEI A,DUMDOT ;maybe put out fake trlr at end of screen
OWDIS4: CAMN G,SCRLOW ;skip unless this is the end of the display area
SKIPE NOTRLR# ;skip unless current window has trlr w/out SCRLOW
SKIPE DPYWIN(G) ;skip if line is unclaimed, put spcl trlr here
JRST OWDIS1 ;go check for next window
MOVEI C,1 ;one line to output
PUSHJ P,@OWDBLT ;think about displaying special trailer
JRST OWDIS1
;DISPAT DISPAX
;Here to display attach buffer when displaying whole screen (DSPALL).
DISPAT: HRRZ A,ATTBUF# ;Address of attach buffer text
MOVE B,ATTNUM# ;Number of lines attached
CAMLE B,ATTMAX
MOVE B,ATTMX2 ;Only display limited number, half at top
PUSH P,DBLTI
XCT DISPAI ;DD,III: SKIPA T,[JRST DBLT4]. DM: MOVE T,[JRST DBLT7]
PUSH H,[BYTE (7) 177,BLINK] ;Display attach buffer as "blinking" on DM
MOVEM T,DBLTI
PUSH P,ARRPOS
MOVE T,ARPOS2 ;For vertical bar on III, use slightly
MOVEM T,ARRPOS ; different X position than normal for arrow
SKIPLE B ;Don't output anything if top "half" is null
PUSHJ P,DBLT ;Output top half or whole attach buffer
MOVE T,ATTNUM
CAMG T,ATTMAX
JRST DISPAX ;Whole attach buffer is displayed
SKIPN DMLINE
SKIPA T,[ASCID / . /] ;Put blank in leading col on DD/III
SKIPA T,[ASCID / . /] ;Don't worry about leading col on DM
PUSH H,ARRPOS
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
HRRZ B,DOTS+TXTSER
HRRM B,DPYTAB(G)
PUSH H,[ASCID /. .
/]
AOJ G,
HRRZM H,DPYLOC(G)
MOVN B,ATTMAX
ADD B,ATTMX2
MOVSI B,1(B)
JUMPGE B,DISPAX ;Don't output anything if bottom "half" is null
MOVEI A,ATTBUF
HLRZ A,(A) ;Find ptr to last few lines of attach buffer
AOBJN B,.-1
PUSHJ P,DBLT ;Display last few lines of attach buffer
DISPAX: POP P,ARRPOS ;Put these two cells back--we clobbered them
POP P,DBLTI ; for putting out attach buffer
SKIPE DMLINE
PUSH H,[BYTE (7)177,CAN] ;Back to normal display mode on DM
TLNE F,OFFEND
JRST DISP5C ;"Arrow line" is row of stars
HRRZ A,ARRLIN ;"Arrow line" is text
PUSHJ P,DBLT ;Output arrow line
JRST DISP4 ;Go output lines below arrow line, then trailer line
repeat 0,<
DISPAY: MOVEM G,OLDTRL# ;remember which screen line trlr is on
MOVE A,TRLBLK ;"Arrow line" is row of stars
PUSHJ P,DBLT ;Output arrow line
JRST @DISPXA ;DD: DDISPX. III: IDISPX. DM: MDISPX.
>;repeat 0
;DDISPX DDSPX2 DDDONE DMDONE MDDISP MDDIS3 MDDIS4 MDDIS2 MDISPX MDSPX2 DMDON0 ALLCHG ALLCH0 ALLCH2 WIPI3 WIPL WIPL2
;here when redrawing whole screen or
;from DDISPS to update changed lines, extra window lines already done
DDISPX: PUSHJ P,MDDISP ;finish up common DD/DM stuff, final lines of screen
DDSPX2:
IFE FTF2,< ;No second field on F2's Grinnell
MOVEI T,0
IDPB T,POSLST ;No more DD line selects
PUSHJ P,DDCOP ;Duplicate DD text for different field
JRST DDDONE ;Okay
SETZB TT,1(H) ;No offset for second copy, put halt in program.
MOVEI T,-DPYBUF+1+1(H) ;Length of first copy of display program
HRRZM T,DPYHED+1
DPYOUT DPYHED ;Not enough room in DPYBUF, output text twice, once
DPYOUT [0↔0] ; for each field--and wait until done first field.
DDDONE: PUSHJ P,LINREL ;Change all DD line selects to other field
>;IFE FTF2
DMDONE: XCT DCURI ;Check for special cursor
TRZ F,DSPSCR!DSPALL
;DPYCLB is now handled at start of DISP, to use PPINFO bit for line ed wrapping.
; SKIPE T,DPYCLB ;Force line after line editor line to be
; HLLZS DPYTAB(T) ; redrawn next time.
; SETZM DPYCLB
JRST DISPX
;Subroutine used by DD and DM. Here for both DSPALL and DSPSCR cases, also SHIFT.
;We no longer call PCOMPS here because we call the correct routine DBLT, DBLTS,
;or DMBLTS to output remaining text and blank lines,
;with B used in DBLTS as set up before.
MDDISP: PUSH P,C ;C and D must be preserved by DISP
PUSH P,D ;D may be diddled by DBLTS called from @OWDBLT
MOVE D,DDSPOS ;get back current position if from DDISPS
MOVE C,SCRBOT ;erase only to line before our trlr spot
CAMN C,SCRLOW ;any windows below?
ADDI C,1 ;no, erase to end of display area (one more line)
SUBI C,(G) ;number of lines to erase
JUMPLE C,MDDIS2
;now we think about requiring that these blank lines be output, in case that
;would allow us to flush any previous display output still going
SKIPE DDACT ;skip if last display output is done
SKIPN DMLINE ;not done, skip if on a DM
JRST MDDIS4 ;not DM or no prev output to maybe flush
TRNN F,DSPALL ;skip if all lines being output (or from SHIFT)
PUSHJ P,ALLCHG ;skip if not all prev output lines being redrawn
JRST MDDIS4 ;don't need to force blank lines out
CAIGE T,(G) ;skip if all lines before current being redrawn
JRST MDDIS4 ;won't be able to flush output anyway
MOVEI TT,-1(G) ;figure out location of last blank line we need
ADDI TT,(C) ;this makes last blank line being considered
MDDIS3: CAILE T,(TT) ;this previous output line (T) becoming blank?
JRST MDDIS4 ;no, it's beyond this group of blank lines
HLLZS DPYTAB(T) ;yes, force blank line to be output
PUSHJ P,ALLCH2 ;see if any more lines output last time
JRST MDDIS4 ;none, no need to force any more blank lines out
JRST MDDIS3 ;here's one, see if can fix with blank line
MDDIS4: MOVEI A,DUMMY ;ptr to blank line to be output
PUSHJ P,@OWDBLT ;put out blank lines as necessary (DBLTS or DBLT)
MDDIS2: SETOM NOTRLR ;trailer is done, maybe put spcl trlr at bottom
PUSHJ P,OWDIS1 ;maybe put out lines in windows below
MOVEI A,DUMMY ;put out blank lines to fill window area
MOVEI C,1 ;one final trailer line to blank out (not claimed)
CAMN G,SCRLOW ;skip if already handled multi-window trlr
PUSHJ P,@OWDBLT ;finish screen with blank line
MOVE A,ARRL
ADD A,OFFSET
MOVEM A,OLDARR
POP P,D
POP P,C
POPJ P,
;here if displaying whole screen or
;from DDISPS (updating only changed lines, extra windows done already)
MDISPX: PUSHJ P,MDDISP ;Finish up display buffer for DM
TRNE F,DSPSCR ;Did someone request update of arrow line number?
PUSHJ P,DMARRL ;Yes, do it
TLZ F,DSPLIN ;In case we didn't call DMARRL
TRNN F,DSPALL ;Skip if all lines were changed
SKIPN DDACT ;Skip if last transfer still going
JRST MDSPX2 ;previous transfer already flushed or finished
PUSHJ P,ALLCHG ;skip if not all prev output lines being redrawn
DPYOUT [1000,,0↔0] ;All lines being output, flush previous xfer
MDSPX2: MOVE T,BOTARR
MOVEM T,BOTAR3 ;Save for incremental update of line # on star line
SETOM CUROLD ;Force MCURS to set up cursor position
DMDON0: MOVE T,[DPYNEW,,DPYOLD]
CAME H,PSHINI ;anything in display program this time?
BLT T,DPYOLD+MAXLIN-1 ;yes, remember for next time the lines being output
JRST DMDONE
;Routine to check to see if we can flush old display output because all the lines
;it is drawing will be re-drawn by new output anyway.
;Skips iff can flush old output; direct return if still need old output, with
;first old line needed in T.
;Never here unless DDACT is on; therefore, previous display output can't have
;been from SHIFT, since it would leave DDACT off and cause SHFHDR+2 to be on.
ALLCHG: MOVE T,SCRHGH ;check entire display area, starting at top
ALLCH0: CAMLE T,SCRLOW ;finished checking display?
POPJ P, ;yes, can flush previous display output (yea!)
SKIPE DPYOLD(T) ;was this line output last time?
SKIPGE DPYNEW(T) ;yes, is it being output this time?
ALLCH2: AOJA T,ALLCH0 ;not output before, or being updated this time
JRST POPJ1 ;no, need prev output for this line, can't flush
;Enter at WIPI3 from WIPER/WIPER2 to erase given number of lines (neg count in T).
WIPI3: JUMPGE T,CPOPJ ;jump if want no blank lines
HRL G,T ;Make aobjn count for number of lines to erase
WIPL: MOVE T,[40,,DUMSER] ;serial number and leading char for blank line
EXCH T,DPYTAB(G)
TLNN T,17700 ;Was there a non-blank char in leading col this line
JRST WIPL2 ;No
PUSH H,ARRPOS ;Yes, position us to leading col to erase old char
WIPL2: PUSH H,[ASCID /
/]
IFN DDLOSS,<
XCT DDCOLS
>;IFN DDLOSS
AOBJN G,WIPL
POPJ P,
;DDCOP LINRL2 LINREL LINRLL IDISP IDISP4 IDISP2
IFE FTF2,< ;No second field for Grinnell on F2
;Routine to duplicate DD program in order to run once for each of the 2 fields.
;Skip returns if not enough room. Returns length of part copied in RH TT.
;Adjusts both halves of H (PUSH ptr for depositing dpy code in program).
;No longer sets up DPYHED+1 (program length), nor zeroes end of program;
;leaves those for DISPX (using H) and DDISPX.
DDCOP: MOVEI TT,-DPYBUF(H) ;Duplicate text in DPYBUF for second DD field
CAIL TT,DPYBSZ/2-1-LDDCUR ;Room for doubled display plus special cursor?
JRST POPJ1 ;No, won't fit, must do two display outputs
HRLI TT,(TT) ;Put length in each half
ADD H,TT ;Adjust pointer for depositing more display code
MOVE T,[DPYBUF+1,,DPYBUF+1]
ADDI T,(TT) ;Make blt pointer
BLT T,(H)
POPJ P,
LINRL2: SKIPA G,[20000] ;Move down two more lines, for erasing
LINREL: MOVEI G,10000 ;Turn on second field bit in all DD line selects
MOVE T,[2200,,RBUF-1] ;make byte ptr to list of position words
LINRLL: ILDB A,T ;get a position word address
JUMPE A,CPOPJ ;jump if no more position words
ADDI A,(TT) ;adjust position word address into copy of original
ADDM G,(A) ;Adjust position word down a scanline (or more)
JRST LINRLL
>;IFE FTF2
IDISP:
IFE DECSW,< ;ENTIRE III ROUTINE STANFORD-ONLY
IFN FTMACL,<
SKIPE NOLEDS ;Display LE buf if awaiting rest of cmd
SKIPLE CURMAC ;If from LE in macro, need to display our LE buf,
TRNN F,EDITM ; which means we have to redraw all for III
>;FTMACL
TRNE F,DSPSCR
JRST DISP2 ;Something has changed, so redraw whole screen
TRNE F,ATTMOD
JRST IDISP2
PUSHJ P,IIIARR ;Nothing except perhaps arrow has changed--output it
TLZN F,DSPLIN ;Has arrow line number changed?
JRST IDISP4 ;No, just check for flushing special cursor
MOVE T,BOTWIN ;Get screen line number of trailer line
CAMG T,LINES
SKIPA TT,[BOTAR2-BOTDSH-LLDESC+1];Displaying dashed trailer line
MOVEI TT,BOTARR-BOTSTR-LLDESC+1 ;Displaying starred trailer line
PUSHJ P,GTRLIN ;get trailer's line number in T
ADD TT,DPYLOC(T)
MOVE T,BOTARR ;New text for line number in trailer line
PGSEL TXTPOG ;Select piece of glass for this window's text
UPGMVM T,(TT) ;Update display program
IDISP4: PUSHJ P,ICURS ;Maybe flush special cursor
JRST POPBAJ ;That's all
;Here in attach mode on III, with neither DSPSCR nor DSPALL set
IDISP2: MOVE G,ARRL
ADD G,OFFSET
CAME G,OLDARR
JRST DISP2 ;Attach buffer has moved--redraw whole screen
JRST IDISP4
>;NOT DECSW
;IIIARR IIIAR2 IIIAR3 GTRLIN GTRLI2 DMARRL CNTNUL CNTNU2 IDMTAB
IFE DECSW,<
IIIARR: MOVE G,ARRL
ADD G,OFFSET
MOVEM G,OLDARR
TRNN F,EDITM!ATTMOD
JRST IIIAR2
TRNE F,ATTMOD
JRST [MOVNI G,20↔JRST IIIAR2] ;Flush arrow by drawing it off-screen
PUSHJ P,LESET
JFCL
TLNE F,NULLIN
TLNE F,OFFEND
JRST IIIAR3
IIIAR2: PUSHJ P,PCOMPI
MOVEM T,ARRBUF+1
MOVE T,ARRPOS
MOVEM T,ARRBUF+2
MOVE T,ARRON
MOVEM T,ARRBUF+3
DPYOUT ARRPOG,[ARRBUF↔5] ;Display the arrow on its own POG
POPJ P,
;We are now editing a previously non-blank line on
; a III, so we need to quit displaying that line
; so that only the line editor will be there.
IIIAR3: PGSEL TXTPOG ;Select piece of glass for this window's text
HRRZ TT,DPYLOC(G)
MOVE T,[ASCID /
/]
UPGMVM T,1(TT)
HRRZ T,DPYLOC+1(G)
CAIN T,1(TT)
JRST IIIAR2
MOVSI T,1(T)
HRRI T,20
UPGMVM T,2(TT)
JRST IIIAR2
>;NOT DECSW
;Get line number where trailer line is (or should go), realizing that there
;may be multiple windows. Return line number in T.
GTRLIN: MOVE T,BOTWIN ;Figure out where trailer line is
ADD T,EXTRA ;allow for attached lines or wraparound line ed
SUB T,TOPWIN ;This makes number of text lines displayed
CAMGE T,NLINER ;If room for trailer in text area, it's there
AOJA T,GTRLI2 ;Trlr is w/in window, adjust line nbr past text
MOVE T,SCRBOT ;Number of line following window
SKIPE DPYWIN(T) ;If it's an unclaimed line, it's where trlr is
MOVE T,SCRLOW ;Else trailer is after lower windows
POPJ P,
GTRLI2: ADD T,SCRTOP ;convert window line nbr to screen line number
POPJ P,
DMARRL: TLZN F,DSPLIN ;Has number of arrow line changed?
POPJ P, ;No
PUSH P,G
PUSHJ P,GTRLIN ;get trlr line number in T
MOVE G,T ;trlr line in G
PUSHJ P,PCOMPM ;Calculate in T DM position word to trailer line
HRRZM P,DPYNEW(G) ;note that partial output goes on this line
MOVE TT,BOTWIN
CAMG TT,LINES
SKIPA TT,[BOTLX2⊗=15] ;Adjust X pos for dashed trailer line
MOVE TT,[BOTLX⊗=15] ;Adjust X pos for starred trailer line
ADD T,TT
TDC T,[BYTE(7)177,0,0,0,20] ;Turn off 177 since using DMQUOT, enter ID mode
MOVEM T,BOTAPS ;Place in DM prog that will update trailer line
MOVE T,BOTAR3 ;Last line number that we have output
PUSHJ P,CNTNUL ;See how many nulls
PUSH P,TT
MOVE T,BOTARR ;New line number
MOVEM T,BOTAR3 ;Put into incremental dpy program
PUSHJ P,CNTNUL
MOVE T,TT
EXCH T,(P)
POP P,TT
SUB T,TT ;Number of spaces to insert (delete if negative)
MOVE TT,IDMTAB(T) ;Get proper string from table
MOVEM TT,BOTID ;And place in incremental dpy prog
DPYOUT DMLHDR
POP P,G
POPJ P,
CNTNUL: MOVEI TT,5 ;Count trailing nulls in ASCII/ASCID word
CNTNU2: TLNN T,774000
POPJ P,
LSH T,7
SOJG TT,CNTNU2
POPJ P,
BYTE (7)10,10,10,10,30 ;Delete some chars
BYTE (7)10,10,10,30
BYTE (7)10,10,30
BYTE (7)10,30
IDMTAB: BYTE (7)30 ;No change
BYTE (7)34,30
BYTE (7)34,34,30
BYTE (7)34,34,34,30
BYTE (7)34,34,34,34,30 ;Insert some spaces
;LESET LESET0 LESET2 LEADDM LEADJ LEADJ2 LECLR LECLR2
;Takes direct return only if either (1) actually positioning LE and
;no char typed ahead on null line or (2) NOLEDS is off.
;Otherwise, take skip return.
LESET: SKIPN NOLEDS ;Skip if LE display really needed in middle of text
POPJ P,
LESET0: PUSHJ P,P2COMP
TRO T,400000 ;This ensures a non-zero value without affecting position.
XCT LINTST ;Position Line Editor off screen if whole line typed ahead
SKIPLE CURMAC ;Position LE off screen if expanding a macro.
LESET2: MOVEI T,1400 ;Off screen position
CAMN T,LEPOS ;Is line editor already where we want it?
JRST POPJ1 ;Yes
MOVEM T,LEPOS# ;No, remember where we are leaving it
MOVEM G,LEPOS2# ;Remember screen line number for DCURS
CAIN T,1400
SETZM LEPOS2 ;Remember cursor isn't actually in text (off screen)
LEYPOS (T) ;Put it where we want it
TLNN F,NULLIN
AOSA (P)
IFE DECSW,<
INSKIP ;Don't take skip return if no char typed and on null line
>
IFN DECSW,<
SKPINC
>
POPJ P,
JRST POPJ1
LEADDM: PUSH P,D
PUSHJ P,WINCHK ;Make sure window set up correctly
TRO F,EDITM ;Tell SHIFT we are editing a line
SKIPG CURMAC ;Don't update display if still expanding macro
PUSHJ P,SHIFT ;Move appropriate screen text before positioning line editor
POP P,D
JRST LEADJ2 ;Make sure LE is at exactly correct position before DISP
LEADJ: SKIPE LEPOS
POPJ P,
LEADJ2: MOVE G,ARRL
ADD G,OFFSET
PUSHJ P,LESET0
POPJ P,
POPJ P,
LECLR: XCT LINTST ;Don't touch LE position if whole line typed ahead
SKIPN LEPOS ;Skip if LE positioned somewhere particular
POPJ P,
SKIPLE CURMAC ;If expanding a macro,
JRST LECLR2 ; then re-position LE off screen
LEYPOS
SETZM LEPOS
SETZM LEPOS2
POPJ P,
LECLR2: PUSHJ P,LESET2 ;Position off screen
POPJ P,
POPJ P, ;LECLR doesn't ever skip
;DBLTC DBLT DBLT4 DBLT6 DBLT2 DBLT8 DBLT3 DBLT7 DBLT5 IDISPX IDISP9 DISPX PPBAJ2 PPBAJ1 PPCBAJ POPBAJ POPAJ
;Routine (DBLT) to BLT display text into DPYBUF.
;Call with: A/ ptr to first such line, B/ number of consecutive lines to display,
;G/ screen line number, H/ stack ptr to buffer. Clobbers T,TT. Updates arguments.
DBLTC: MOVE B,C ;here from OWDISP. Put count where we expect it.
DBLT: AOSE T,DBLTAR# ;skip if we've just put arrow into buffer
XCT DBLTI ;DD: LDB T,[300700,,DPYTAB(G)]. III: JRST DBLT2. DM: JRST DBLT5
JUMPE T,DBLT2 ;For displaying attach buf, DBLTI is JRST DBLT4.
SKIPA T,[ASCID / /]
DBLT4: MOVEI T,"|"*2+1 ;Display vertical bar in leading col for attach buf
PUSH H,ARRPOS
PUSH H,T
DBLT6: DPB T,[271000,,DPYTAB(G)] ;Save character in leading col on this line
DBLT2: HRRZ T,TXTSER(A)
HRRM T,DPYTAB(G) ;Remember serial number of line displayed on line G
;; SETOM DPYNEW(G) ;remember that this line is being output
HRRZ TT,-1(A) ;get length of FS block
SKIPGE TXTFLG(A)
SUBI TT,PMXTRA ;We have here a pagemark line, which has bigger FS block
SKIPN TXTCNT(A) ;Is this a real text line?
JRST DBLT8 ;No, include all of its text
CAMLE TT,LINMAX ;No need to include all of long line in dpy buffer
HRRO TT,LINMAX ;Just display enough to fill screen
DBLT8: MOVSI T,LLDESC(A)
HRRI T,1(H)
ADDI H,-2-LLDESC(TT)
BLT T,(H) ;Move text of line to dpy buffer
JUMPGE TT,.+2
PUSH H,[ASCID /
/] ;We didn't put in whole line, so add CRLF now
IFN DDLOSS,<
XCT DDCOLS ;If on DD, put out explicit col sel
>;IFN DDLOSS
AOJ G,
HRRZ A,(A)
HRRZM H,DPYLOC(G) ;Remember address of next line in dpy buffer
DBLT3: SOJG B,DBLT
POPJ P,
DBLT7: TDZA T,T ;Mark this line as "blinking" on DM
DBLT5: MOVEI T,1 ;Mark this line as normal on DM
JRST DBLT6
IFE DECSW,<
;Here after setting up buffer to display whole screen on III
IDISPX: CAML G,SCRBOT ;skip if we have a short window of text
JRST IDISP9 ;already filled up window with text
MOVE G,SCRBOT
PUSHJ P,PCOMPI ;position to bottom line of current window
PUSH H,T ;put position word into program
IDISP9: SETOM NOTRLR ;trailer is done, maybe put spcl trlr at bottom
PUSHJ P,OWDISP ;output lines in windows below current window
PUSHJ P,IIIARR ;Output arrow on own POG
TDZ F,[DSPLIN,,DSPSCR!DSPALL]
PUSHJ P,ICURS ;Set up special cursor on III
>;NOT DECSW
DISPX: SETZM 1(H) ;Make DD program stop at end
CAMN H,PSHINI ;did we put anything in display program?
JRST POPBAJ ;nope, don't run it then
SUBI H,DPYBUF-1-1
HRRZM H,DPYHED+1 ;Store length of display program in header
DPYOUT TXTPOG,DPYHED ;Run display program
JRST POPBAJ
PPBAJ2: AOS -2(P) ;Double skip return
PPBAJ1: AOSA -2(P)
PPCBAJ: POP P,C
POPBAJ: POP P,B
POPAJ: POP P,A
POPJ P,
;PCOMPD PCOMPI PCOMPM PCOMPS P2CMPD P2CMPI P2CMPM PCMPID
PCOMPD: MOVEI T,14 ;Compute DD line number from screen text line number
IMUL T,G
DPB T,[400400,,T]
TRZ T,17
ROT T,20
TRO T,<CW 4,0,4,0,5,0>
POPJ P,
PCOMPI: MOVE T,[-30⊗16] ;Compute III vector from screen text line number
IMUL T,G
ADD T,[BYTE(11)<-1000>,770(3)2,2(2)1,2(4)6]
POPJ P,
PCOMPM: MOVEI T,(G) ;Compute DM position command from scr text line nbr
XORI T,140 ;Convert line number to DM format
LSH T,8
ADD T,[BYTE(7)177,14,140]
POPJ P,
PCMPID: PUSHJ P,PCOMPM
IORI T,20⊗1 ;Enter ID mode after position
PUSH D,T
MOVEI T,4
ADDM T,TOTSHF ;Count characters in line shifting program
POPJ P,
PCOMPS: PUSHJ P,@PCOMP ;Call DD or DM routine above
PUSH H,T
IDPB H,POSLST ;Remember where DD line select commands are
POPJ P,
P2CMPD: MOVEI T,1(G) ;Compute LEYPOS arg from scr text line number--DD
LSH T,7
IDIV T,[-5]
ADDI T,1000
POPJ P,
P2CMPI: MOVEI T,(G) ;Same as above--III
IMUL T,[-30]
ADDI T,770
POPJ P,
P2CMPM: MOVEI T,1(G) ;Same as above--DM
LSH T,7
IDIV T,[-3]
ADDI T,1000
POPJ P,
;DDISP DMARR DDISP2 DDISP3
DDISP: TRNE F,DSPSCR
JRST DDISPS ;Update only lines on screen that have changed
MOVE A,ARRL ;Only arrow can have changed.
ADD A,OFFSET
CAMN A,OLDARR
JRST DDISP2 ;Didn't change
TRNE F,ATTMOD
JRST DDISPS ;Attach mode, update changed lines
EXCH A,OLDARR#
SKIPE DMLINE
JRST DMARR ;Handle "arrow" on DM using just cursor
PUSH P,A
HRROI B,OFFARR
CAML A,OLDARR ;Is old arrow line or new one higher on screen?
HRROI B,ONARR ;New one--turn arrow on for that line
SUB A,OFFSET
PUSHJ P,FNDLIN
PUSH P,T
SKIPE DDACT
DPYOUT [0↔0]
PUSHJ P,DOARR ;Redraw higher line on screen of old or new arrow
TRC B,OFFARR≥ONARR
PUSHJ P,DOARR ;Redraw lower line of screen of old or new arrow
SUB P,[2,,2]
JRST DDSPX2
DMARR: SETOM CUROLD ;Position DM cursor to be set up by MCURS
PUSHJ P,DMARRL ;Update number of arrow line in trailer line
MOVE A,OLDARR ;Get actual line number of new place for arrow
DDISP2: TRNN F,EDITM
JRST DDISP3 ;Arrow hasn't moved, not in editor; chk spcl cursor
SKIPE DDACT
XCT DDWAIT ;DD: DPYOUT[0↔0]. Others: JFCL.
MOVE G,A
PUSHJ P,PCOMPS ;Position display at right line in case in macro
PUSHJ P,DOAR2 ;Position line editor, make line get redrawn later
SKIPG CURMAC ;If inside macro, or if coming from EDGL3,
SKIPN NOLEDS ; then MACDSL/DOAR2 put out text needing displaying.
XCT DDISPI ; DD: JRST DDSPX2 DM: JRST DMDON0 III: JFCL
DDISP3: MOVE H,PSHINI ;Reset pointer to beginning of dpy buffer
XCT DCURI ;Call DD or DM special cursor checking routine
CAME H,PSHINI ;Any output requested for cursor (DD only)
JRST DISPX ;Yes, do it
JRST POPBAJ ;No, no displaying needed this time
;DOARR DOAR2 OFFARR ONARR
DOARR: SKIPGE G,@(B)
POPJ P,
PUSHJ P,PCOMPS
TRNE F,EDITM
SKIPL 1(B) ;Skip if drawing arrow instead of erasing it
SKIPA T,ARRPOS ;Not in line editor, or just erasing arrow, erase old line
MOVE T,AR2POS ;Doing arrow for line where line editor is, don't erase line
IFN FTMACL,<
SKIPE NOLEDS ;Display LE buf if awaiting rest of cmd
SKIPLE CURMAC ;If from LE in macro, need to display our LE buf
MOVE T,ARRPOS ; so want normal line erasing mode on DD
>;FTMACL
PUSH H,T ;Position us to right column
MOVE T,@2(B) ;Get arrow or space
PUSH H,T ; and put it out
DPB T,[271000,,DPYTAB(G)] ;Remember char in first column on this line
MOVE A,@1(B) ;Get address of FS for line we're changing leading char in
TRNE F,EDITM ;If not in line editor,
SKIPL 1(B) ; or if erasing this arrow,
AOJA B,DBLT2 ; then redraw actual text of line
DOAR2: PUSHJ P,MACDSL ;If from LE inside macro, display text from our LE buf
PUSHJ P,LESET ;Position line editor
XCT SPCOUT ;Reset function to normal (erase line) if on DD
PUSH H,[ASCID /
/]
AOJ G,
IFN DDLOSS,<
XCT DDCOLS
>;IFN DDLOSS
SKIPE LESIM ;Can't be any LE clobberage with display of our LE buf
POPJ P, ;MACDSL has already forced sim'ed LE redrawing
HLLZS DPYTAB-1(G) ;Force line editor line to get redrawn next time
MOVEM G,DPYCLB# ;Force next line to be redrawn 'cause LE may wrap around
POPJ P,
OFFARR: ,-2(P) ;BOY DOES FAIL EVER EAT IT!
,-1(P)
[ASCID/ /]
ONARR: OLDARR
SETZ ARRLIN
ARRON
;DDISPS DDSPS2 DDSPS3 DDSPSX DDSPS6 DDSPS7 DDSPS4 DDSPS5
;Here for DD/DM to output lines that have changed.
DDISPS: SKIPE G,DPYCLB ;Do we need to redraw a special line?
HLLZS DPYTAB(G) ;Yes, force it out (should never happen?)
SETZM DPYCLB ;Don't do it again (DMDONE always handles this)
PUSH P,C
PUSH P,D
SKIPE DMLINE
PUSHJ P,SHIFT ;Maybe we can save some output by moving lines on DM
MOVEI G,0 ;start from top of screen, maybe to erase old window
SETOB C,D ;D/-1: no positioning done, C/-1: one line to output
SKIPE DDACT
XCT DDWAIT ;DD: DPYOUT[0↔0]. Others: JFCL.
TRO F,DSPSCR ;Force update of arrow line number in DM trailer
HRROI B,[ASCID/ /]
PUSHJ P,OWDSPS ;output text from non-current windows at top
MOVE A,HEDBLK
PUSHJ P,DBLTS ;Output header line
MOVE C,ARRL
SUB C,TOPWIN
MOVE A,WINLIN
JUMPLE C,.+2 ;Jump if arrow on top line
PUSHJ P,DBLTS ;Output lines above arrow that have changed
HRROI B,ARRON
SKIPE DMLINE
HRROI B,[1] ;Mark this line as a normal text line
TRNE F,EDITM!ATTMOD
JRST DDSPS4
DDSPS2: TLNE F,OFFEND
JRST DDSPSX ;No lines beyond arrow
PUSHJ P,DBLTS ;Output arrow line
HRROI B,[ASCID / /]
DDSPS3: MOVE C,BOTWIN
SUB C,ARRL
PUSHJ P,DBLTS3 ;output any lines between arrow and trailer line
DDSPSX: SKIPE DPYWIN(G) ;skip if can sneak trlr in here on empty screen line
PUSHJ P,OWDSPS ;output any lines needed here for other windows
MOVEM G,OLDTRL# ;remember which screen line trlr is on
MOVE A,TRLBLK
PUSH P,D ;Save current output line
SKIPE DDACT ;If previous output still going, and if on DM,
SKIPN DMLINE ; and if all lines in previous display output
JRST DDSPS6 ; will be re-displayed this time except trlr,
SKIPE DPYOLD(G) ; and if trailer's line is in prev display output,
PUSHJ P,ALLCHG ; then force trailer out. Skip if need old output.
JRST DDSPS6 ;trailer's line not output last time, no spcl output
CAIE T,(G) ;skip if need old stuff before trailer, can't flush
DDSPS6: PUSHJ P,DBLTS0 ;output trailer line only if necessary (skips)
DDSPS7: PUSHJ P,DBLTS1 ;Force trailer line out to allow flushing old output
HRROI B,[ASCID / /] ;avoid displaying arrow again later (mult windows)
POP P,C
CAME D,C ;Did current output line change?
TRZ F,DSPSCR ;Yes, outputing the trailer line; don't call DMARRL
MOVEM D,DDSPOS# ;remember final position for MDDISP's extra stuff
POP P,D
POP P,C
JRST @DISPXA ;DD: DDISPX. III: (never here) IDISPX. DM: MDISPX.
;Here if attach mode or in line editor
DDSPS4: TRNE F,ATTMOD ;skip if in line editor
JRST DSPSAT ;Attach mode
PUSHJ P,LESET ;Position line editor
SKIPA TT,ARRPOS ;Arrow positioning cmd to erase rest of line
MOVE TT,AR2POS ;Arrow positioning cmd to avoid erasing rest of line
IFN FTMACL,<
SKIPLE CURMAC ;If from LE in macro, need to display our LE buf
MOVE TT,ARRPOS ; so want normal line erasing mode on DD
>;FTMACL
PUSH P,TT
PUSH P,D
PUSHJ P,DBLTA ;ensure proper arrow char (display line if macro)
SKIPE LESIM ;Has MACDSL already taken care of extra lines?
JRST DDSPS5 ;Yes
;; HLLZS DPYTAB-1(G) ;Force line editor line to be redrawn later
MOVEM G,DPYCLB ;Remember number of line after arrow to get it
HRROI B,[ASCID / /] ; redrawn later because of line editor wrap around
SKIPE C,EXTRA
PUSHJ P,DBLTA ;Erase leading col of extra line because line wraps
DDSPS5: HRROI B,[ASCID / /] ;Char to appear in subsequent leading cols
POP P,T
CAME T,D
XCT SPCOUT ;Reset DD function to normal (erase line)
SUB P,[1,,1]
TLNE F,OFFEND
JRST DDSPSX ;Line editor is over row of stars--all done
HRRZ A,(A) ;Now output lines after arrow line, as needed
JRST DDSPS3
;DSPSAT DSPSAX
;Here to display attach buffer when outputting only changed lines
DSPSAT: SKIPE DMLINE
PUSH H,[BYTE (7)177,BLINK] ;Display attach buffer as "blinking"
HRRZ A,ATTBUF
MOVE C,ATTNUM
CAMLE C,ATTMAX
MOVE C,ATTMX2 ;Output only a few lines from top of att buffer
HRROI B,["|"*2+1] ;B negative makes DBLT (via DBLTS) do only one line
SKIPE DMLINE
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
SKIPLE C ;Don't output anything if top "half" is null
PUSHJ P,DBLTS ;Output top few or whole att buffer
MOVE T,ATTNUM
CAMG T,ATTMAX
JRST DSPSAX ;Whole att buffer displayed--all done
HRROI B,[ASCID / /]
MOVEI A,DOTS
PUSHJ P,DBLTS ;Output elipsis
MOVN C,ATTMAX
ADD C,ATTMX2
MOVSI C,1(C)
JUMPGE C,DSPSAX ;Don't output anything if bottom "half" is null
;;; MOVSI C,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN C,.-1
HRROI B,["|"*2+1]
SKIPE DMLINE
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DBLTS ;Output last few lines of attach buffer
DSPSAX: SKIPE DMLINE
PUSH H,[BYTE (7)177,CAN] ;Back to normal mode display on DM
HRRZ A,ARRLIN
HRROI B,[ASCID / /]
JRST DDSPS2 ;Now output lines after attach buffer
;⊗ SHFT SHFTEL SHFTE2 SHFTE3 HDTRSV SHMNSV SHIFT DMSPS2 DMSPS3 DMSPSX SHIFT1 SHIFT2 SHIFT3 SHIFT7 SHIFT8 SHIFT4 SHIFT9 SHIF9B SHTEST SHTST1 SHTST2 SHIF12 SHIF13 SHIF11 SHIF14 SHIF10 SHIF17 SHIF21 SHIF18 SHIF19 SHIF20 SHIF22 SHIF23 SHIF24 SHIF26 SHIF27 SHIF28 SHIF29
;Extended cmd to disable use of line insertion/deletion for movement distance
;of more than N lines on DM-like terminals. ⊗∞⊗Xshift enables all shifting.
SHFT: TRNN F,REL ;-0 means don't ever shift (limit is 0).
JUMPE A,SHFTEL ;report state
MOVM A,A ;make sure we have positive number
MOVEM A,NOSHFT ;arg specifies enabling or disabling
SKIPGE BLAB ;be quiet in terse mode
POPJ P,
SHFTEL: OUTSTR [ASCIZ/ Display line shifting is /]
MOVE T,NOSHFT ;get limit
CAIGE T,MAXARG ;effectively no limit if very big
JRST SHFTE2
OUTSTR [ASCIZ/not limited. /]
JRST SHFTE3
SHFTE2: OUTSTR [ASCIZ/limited to /]
SETZM TYOPNT ;force typeout
TYPDEC NOSHFT ;type limit
OUTSTR [ASCIZ/ lines. /]
SHFTE3: SKIPN DMLINE
OUTSTR [ASCIZ/ But that doesn't affect your terminal! /]
JRST CPOPJ1
HDTRSV←←=50 ;rough estimate of text on headers and trailers and pagemarks.
SHMNSV←←HDTRSV-16 ;minimum savings to make shifting worthwhile, enable shifting trlr
;Here for DM to see if we can save some output by shifting text lines on screen.
;In the following routine, movement of lines is calculated as OLD-NEW line numbers.
;Thus moving up means a positive movement, down is negative.
;Pass 1--Put serial number of each line to appear on new screen into DPYLOC(G).
; TMPBUF(G) ← number of chars in line (on screen)
; For blank lines, DPYLOC(G) is set to -1.
SHIFT: MOVEI G,0 ;maybe old window moved down, start at screen top
HRROI B,[1] ;Mark this line as a normal text line
PUSHJ P,SOWDSP ;check for windows above current one
MOVEI A,TOPSTR ;set up ptr to hdr FS
MOVE T,TOPWIN ;figure out which hdr to use
CAIE T,1 ;if top of window isn't first line incore,
MOVEI T,TOPDSH ; then use dotted hdr
MOVEI C,1 ;store one line's info
PUSHJ P,DMBLTS ;store address of hdr line in DPYLOC(G)
MOVE C,ARRL
SUB C,TOPWIN
MOVE A,WINLIN
JUMPLE C,.+2 ;Jump if arrow on top line
PUSHJ P,DMBLTS ;Store addresses of lines above arrow
TRNE F,EDITM!ATTMOD
JRST DMSPS4
DMSPS2: TLNE F,OFFEND
JRST DMSPSX ;No lines beyond arrow
PUSHJ P,DMBLTS ;Store address of arrow line
DMSPS3: MOVE C,BOTWIN
SUB C,ARRL
PUSHJ P,DMBLT3 ;Store addresses of any lines between arrow and trailer line
DMSPSX: SKIPE DPYWIN(G) ;skip if can sneak trlr in here on empty screen line
PUSHJ P,SOWDSP ;output any lines needed here for other windows
MOVE A,TRLBLK
PUSHJ P,DMBLTS ;trailer line goes here
TROE F,DSPALL ;set flag to suppress forcing out of blank lines
POPJ P, ;already outputting everything, no shift needed
PUSH P,OLDARR ;preserve this cell
PUSHJ P,MDDISP ;finish up screen (blank lines and windows below)
TRZ F,DSPALL ;clear flag we just set temporarily
POP P,OLDARR
;now G points to first line of PP
SETZM NOTRLR ;this was set by MDDISP, fix it for main DISP code
SETOM DPYLOC(G) ;Make sure we don't fall off DPYLOC table with
SETZM DPYLOC+1(G) ; all right halves equal
;Pass 2--find amt each new line will have moved to get there, if it already appears.
;For new lines not already on screen, DPYLOC(G) ← -1.
;For lines already on screen DPYLOC(G) ← chars,,movement needed to get here.
MOVN G,SCRLOW ;number of lines above final trlr line
MOVSI G,-1(G) ;make aobjn count include final trlr
MOVEM G,AOBSCR# ;hdr through trlr
SETZM DMSHPT# ;Haven't yet found any moving lines
SHIFT1: SKIPGE T,DPYLOC(G) ;skip unless blank line
JRST SHIFT3 ;blank line, ignore it
SETOM DPYLOC(G) ;Assume no match will be found
MOVE TT,AOBSCR ;AOBJN ptr (RH pts to line-1)
SHIFT2: CAME T,DPYTAB(TT) ;Is this where the new line (G) came from?
AOBJN TT,SHIFT2 ;No
JUMPGE TT,SHIFT3 ;Jump if no match
CAME TT,G ;Is this line fixed?
SETOM DMSHPT ;No, found a moving line
SUBI TT,(G) ;Amount of shift in RH TT
;disable shifting of lines by too much
HRRE T,TT ;signed movement distance
MOVM T,T ;positive absolute distance
CAMLE T,NOSHFT# ;would this line move too much?
JRST SHIFT3 ;yes, don't let it move
;end of shift disable code
HRL TT,TMPBUF(G) ;Pick up char count for this line
MOVEM TT,DPYLOC(G) ;remember chars,,movement for new position G
SHIFT3: AOBJN G,SHIFT1
SKIPN DMSHPT
POPJ P, ;No moving lines to avoid redrawing
;Pass 3--Find min total number of chars of moved lines that conflict w/1 moved line.
SETZM TOTSAV# ;Total output char count to be saved by moving lines
SETZM TOTSHF# ;Total count of chars needed to save above amount
;; SETZM TOTLIN# ;Total number of useful lines being moved
SHIFT7: MOVSI T,377777 ;LH DMSHPT will be min of conflicting chars/line
MOVEM T,DMSHPT
SETZM BESTG ;BESTG will be AOBJN value from G for best line
MOVSI A,400000 ;LH value to mark "accepted" lines to move
MOVE G,AOBSCR
SHIFT8: SKIPGE T,DPYLOC(G) ;skip if line previously on screen
JRST SHIFT4 ;This line didn't previously appear on screen
SETZ C, ;C counts chars conflicting with moving this line
PUSHJ P,SHTEST ;Look for conflicting moving lines
ADD C,B ;XCTed by SHTEST to total char count for conflicting lines
ADDI A,(C) ;Keep total conflicting char count for all lines
MOVS B,C ;Conflicting char total in LH B
CAML B,DMSHPT ;Less than previous best?
JRST SHIFT4 ;no
MOVEM B,DMSHPT# ;Yes, save new best char count and line number
MOVEM G,BESTG#
SHIFT4: AOBJN G,SHIFT8
SKIPL G,BESTG ;Best single line to accept now
JRST SHIF12 ;Didn't find any lines left to consider
HRRZ T,DPYLOC(G) ;Amount best line moves
SHIFT9: JUMPE T,SHIF9B ;We don't save anything if this line isn't moving
HLRZ TT,DPYLOC(G) ;Get char count for this line
ADDM TT,TOTSAV ;Count chars we save by moving this line
;; AOS TOTLIN ;Count useful lines to be moved
SHIF9B: HLLM A,DPYLOC(G) ;Mark this line as accepted for moving
HRRZ TT,DPYLOC+1(G) ;look ahead at next line
CAIN TT,(T) ;If next line moves same amount,
AOJA G,SHIFT9 ; then accept it also
TRNN A,-1 ;Was total conflicting char count zero?
JRST SHIF12 ;Yes, all done
MOVE G,BESTG ;Best line to move
PUSHJ P,SHTEST ;Look for conflicting lines
SETOM DPYLOC(TT) ;XCTed by SHTEST to reject all conflicting lines
JRST SHIFT7 ;Now get next best line
SHTEST: MOVE TT,AOBSCR
SHTST1: SKIPGE D,DPYLOC(TT) ;Get amount of movement for one other line
JRST SHTST2 ;Irrelevant line
HLRZ B,D ;Get char count
ADDI D,(TT)
SUBI D,(G) ;Check sign of RHs: D+TT-(G+T) to see if crossing
SUBI D,(T)
CAMLE G,TT ;Crossing test depends on which is higher, G or TT
MOVNI D,(D) ;Invert test so that 0 still wins
TRNE D,400000
XCT @(P) ;A conflicting line--may reference char cnt in B
SHTST2: AOBJN TT,SHTST1
JRST POPJ1
;Lines accepted now contain either <char count>,,<movement> or 400000,,<movement>
;Rejected or irrelevant lines now contain -1 in DPYLOC.
;Pass 4--Convert table of movements to index by old line nbr instead of new one:
;Sets TMPBUF(old line) ← movement needed to reposition correctly.
;For irrelevant old lines, TMPBUF(G) ← -1.
;TM2BUF(G) gets set to movement accumulated for this line during pass 5.
SHIF12: SETOM TMPBUF ;First we mark all lines as not kept around
MOVE TT,[TMPBUF,,TMPBUF+1]
MOVE T,SCRLOW
BLT TT,TMPBUF(T) ;Mark all lines as unused, including trlr
SETZM TMPBUF+1(T) ;Mark 1st line of PP as staying in place on screen
SETZM TM2BUF
MOVE TT,[TM2BUF,,TM2BUF+1]
BLT TT,TM2BUF+1(T) ;Mark all lines as unmoved including 1st PP line
MOVE TT,AOBSCR
SHIF13: MOVE T,DPYLOC(TT)
TLNE T,200000 ;Is this line to be moved?
JRST SHIF14 ;No
TLNN T,400000 ;This char count already counted in TOTSAV?
TRNN T,-1 ;Or this line actually staying in place?
JRST SHIF11 ;Yes
HLRZ D,T ;Char count (can't be 400000 now)
ADDM D,TOTSAV ;Count number of chars saved
;; AOS TOTLIN ;Count useful lines to be moved
SHIF11: MOVE G,T ;OLD-NEW movement
ADDI G,(TT) ;G is now old index
HRRZM T,TMPBUF(G) ;Mark old line as moving by signed amount in RH
SHIF14: AOBJN TT,SHIF13
;fix up number of a possibly moved line: line after line editor
SKIPE T,DPYCLB ;is there a possibly clobbered line?
SKIPG TT,TMPBUF(T) ;yes, is it moving?
JRST SHIF10 ;no, nothing to worry about
HRRE TT,TT ;extend to full word value
MOVN TT,TT ;make moving up give negative distance
ADDM TT,DPYCLB ;update cell to give new position of line
;fix up number of a possibly moved line: trailer line for current window
SHIF10: SKIPLE T,OLDTRL ;is there a remembered trailer line?
SKIPG TT,TMPBUF(T) ;yes, is it moving?
JRST SHIF17 ;no, nothing to worry about
HRRE TT,TT ;extend to full word value
MOVN TT,TT ;make moving up give negative distance
ADDM TT,OLDTRL ;update cell to give new position of line
;Pass 5--Delete all unneeded lines that occur between topmost line moving down and
;bottommost line staying on screen, making room for shifting lines down.
;Deletions are limited to max uncountered downward movement above each given line.
SHIF17: MOVE D,[-MAXLIN,,DPYLOC-1] ;Pointer used to PUSH display words into buffer
MOVSI B,-1 ;increase aobjn count by one
ADDB B,AOBSCR ;next couple of passes look at 1st PP line too
SETZB C,T ;Count number of lines deleted, deletions needed
SHIF21: SKIPGE TT,TMPBUF(B) ;skip if line stays
JRST SHIF18 ;line not kept, maybe delete some lines here
ADDM C,TM2BUF(B) ;Remember how far up we have already moved this line
HRRE TT,TT ;get full word signed movement
CAMGE TT,T ;this line moving down more than previous biggy?
MOVE T,TT ;yes, save biggest movement down to allow for below
JRST SHIF20
;here with unneeded line, maybe delete some lines.
SHIF18: MOVE A,B ;Place where we start deleting lines
MOVEI G,(B) ;Line where we start deleting
SKIPGE TT,TMPBUF+1(B) ;see how many consecutive lines to delete
AOBJN B,.-1 ;Delete this line too
SUBM B,A ;distance from first to last delete-able line
MOVEI A,1(A) ;Number of lines we can delete here
ADD T,A ;reduce nbr of deleted lines needed (negative)
JUMPLE T,SHIF19 ;jump if need all of these current deletes
SUB A,T ;limit number of deletions to those needed
MOVEI T,0 ;no more needed yet
SHIF19: JUMPLE A,SHIF20 ;jump if no deletes needed at all here
SUB G,C ;Delete from higher up if already have deleted some
ADD C,A ;Total number of lines to have been deleted
PUSHJ P,PCMPID ;Position to line in G and enter ID mode
PUSHJ P,PUTDMA ;Delete number of rows indicated by A
SHIF20: AOBJN B,SHIF21 ;This line is staying on screen
;Pass 6--Shift each line by final amount needed,
;generating last part of display program.
SHIF22: SETZ C, ;Total amount of movement during this pass
MOVE B,AOBSCR ;aobjn ptr to screen lines
SHIF23: SKIPGE A,TMPBUF(B) ;Care about this line?
JRST SHIF24 ;No
HRRE A,A ;Full word value of this line's needed movement
SUB A,TM2BUF(B) ;minus amt this line moved during previous pass
SUB A,C ;minus amt already moved during this pass
JUMPE A,SHIF24 ;Jump if already moved correct amount
MOVEI G,(B) ;Place where line was originally
SUB G,TM2BUF(B)
SUB G,C ;Where it is now
JUMPLE A,.+2
SUB G,A ;Moving up--must do it by deleting line(s) above
ADD C,A ;update total movement during this pass so far
PUSHJ P,PCMPID ;position to line G, enter ID mode
PUSHJ P,PUTDMA ;Move line by deleting rows or inserting them
SHIF24: AOBJN B,SHIF23
MOVE T,TOTSAV ;Amount of redrawing we're gonna save
SUBI T,SHMNSV ; less an arbitrary amount to make it worth it
;; SOSLE TOTLIN ;Skip unless more than one line being moved
CAMG T,TOTSHF ;If we're not gonna save much, forget it
POPJ P, ;Don't bother moving anything
SUBI D,DPYLOC-1 ;figure length of display program we just made
HRRZM D,SHFHDR+1 ;store length in program hdr
DPYOUT SHFHDR ;shift all useful lines to desired positions
;Pass 7--Update DPYTAB to reflect the lines that have moved and
;the lines that have been deleted.
SETZM TM2BUF ;TM2BUF will be new DPYTAB
MOVE TT,[TM2BUF,,TM2BUF+1]
MOVE T,SCRLOW
BLT TT,TM2BUF(T) ;Mark all lines as not there, through trlr line
MOVSI B,1
ADDB B,AOBSCR ;Don't include first line of PP any more
SHIF26: SKIPGE T,TMPBUF(B) ;Amount of movement of this line
JRST SHIF27 ;No longer on screen
MOVE TT,DPYTAB(B)
MOVN T,T ;Make positive movement be downward
ADDI T,(B)
MOVEM TT,TM2BUF(T) ;store new version of DPYTAB entry for this line
SHIF27: AOBJN B,SHIF26
;figure out the range of lines on the screen that are affected by the shifting,
;so that we can limit the changes to DPYTAB to that area of the screen.
;find first line affected.
MOVE B,AOBSCR ;find first and last lines affected by movement
SHIF28: SKIPG T,TMPBUF(B) ;skip if this line is moving
AOBJN B,SHIF28 ;there must be at least one line that moves
MOVEI TT,(B) ;old line number of topmost moving line
TRNN T,400000 ;positive movement (i.e., up)?
SUBI TT,(T) ;yes, use new position (higher) as 1st line affected
;now find last line affected
HLRE B,AOBSCR ;negative line count
MOVN B,B ;positive (we back up from bottom)
SHIF29: SKIPG T,TMPBUF-1(B) ;skip if this line is moving
SOJG B,SHIF29 ;must find a line that moves, must always jump
TRNE T,400000 ;negative movement (i.e., down)?
SUBI B,(T) ;yes, use new position (lower) as last line affected
;first line affected is in TT, last line plus one in B (RH).
CAIL TT,(B) ;make sure last line is below or at first line
PUSHJ P,TELLZ ;bad range calculated for lines affected!
HRLI TT,(TT) ;offsets for BLT ptr for first line
ADD TT,[TM2BUF,,DPYTAB] ;Set up BLT pointer
BLT TT,DPYTAB-1(B) ;make DPYTAB reflect positions of shifted lines
POPJ P,
;DELRWS ADDRWS PUTDMA PUTDM3 PUTDM2 POPBJ DMSPS4 DMPSAT DMPSAX DMBLTS DMBLT3 DMBLA
DELRWS: BYTE(7)32,32,32,32,32
BYTE(7)32
BYTE(7)32,32
BYTE(7)32,32,32
BYTE(7)32,32,32,32
ADDRWS: BYTE(7)12,12,12,12,12
BYTE(7)12
BYTE(7)12,12
BYTE(7)12,12,12
BYTE(7)12,12,12,12
;Routine to output some number |(A)| of delete-row chars or add-row chars
PUTDMA: PUSH P,B
MOVEI T,DELRWS ;assume deleting lines
JUMPGE A,PUTDM3
MOVEI T,ADDRWS ;inserting lines
MOVN A,A
ADDM A,TOTSHF ;Count padding chars for shifting program
ADDM A,TOTSHF
PUTDM3: ADDM A,TOTSHF# ;Count chars in shifting program
IDIVI A,=5
JUMPE A,PUTDM2 ;Less than 5 chars
PUSH D,(T) ;Output 5 chars
SOJG A,.-1
PUTDM2: JUMPE B,POPBJ
ADDI B,(T)
PUSH D,(B) ;Output 1 to 4 chars
POPBJ: POP P,B
POPJ P,
DMSPS4: TRNE F,ATTMOD
JRST DMPSAT ;Attach mode
PUSHJ P,DMBLA
HRROI B,[1] ;Redrawn later because of line editor wrap around
SKIPE C,EXTRA
PUSHJ P,DMBLA ;Erase leading col of extra line because line wraps
TLNE F,OFFEND
JRST DMSPSX ;Line editor is over row of stars--all done
HRRZ A,(A) ;Now store addresses of lines after arrow line
JRST DMSPS3
;Here to store addresses of attached lines being displayed
DMPSAT: HRRZ A,ATTBUF
MOVE C,ATTNUM
CAMLE C,ATTMAX
MOVE C,ATTMX2 ;Output only a few lines from top of att buffer
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
SKIPLE C ;Don't output anything if top "half" is null
PUSHJ P,DMBLTS ;Output top few or whole att buffer
MOVE T,ATTNUM
CAMG T,ATTMAX
JRST DMPSAX ;Whole att buffer displayed--all done
HRROI B,[1]
MOVEI A,DOTS
PUSHJ P,DMBLTS ;Output elipsis
MOVN C,ATTMAX
ADD C,ATTMX2
MOVSI C,1(C)
JUMPGE C,DMPSAX ;Don't output anything if top "half" is null
;;; MOVSI C,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN C,.-1
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DMBLTS ;Output last few lines of attach buffer
DMPSAX: HRRZ A,ARRLIN
HRROI B,[1]
JRST DMSPS2 ;Now output lines after attach buffer
DMBLTS: HRRZ T,TXTSER(A)
CAIN T,DUMSER ;is this a dummy blank line?
JRST DMBLA ;yes, force this line out later
MOVEM T,DPYLOC(G)
MOVE T,(B) ;Get flag indicating blinking mode or not
DPB T,[271000,,DPYLOC(G)] ;Remember char in leading column of line G
HLRZ T,TXTCNT(A) ;Get char count of line as stored on disk
JUMPN T,.+2
MOVEI T,HDTRSV ;hdr or trlr or pagemark, assume this much text
CAILE T,=82 ;Don't count more than =80 columns + 2 for CRLF
MOVEI T,=82
MOVEM T,TMPBUF(G)
ADDI G,1
HRRZ A,(A) ;Next line
DMBLT3: SOJG C,DMBLTS ;Done enough lines yet?
POPJ P, ;Yes
DMBLA: SETOM DPYLOC(G) ;Force this line to be output later
ADDI G,1
SOJG C,DMBLA ;Do more lines if requested
POPJ P,
;DBLTS0 DBLTS DBLTS2 DBLTSN DBLTS3 DBLTS1 DBLTSA DBLTSB DBLTA DBLTA0 DBLTA2
;Output all lines that have changed since display was updated.
;Call with: A/ ptr to first line to consider, B/ -1,,ptr to leading col ASCID,
;C/ number of lines to do, D/ screen line we're already positioned to,
;G/ screen line to start at, H/ buffer ptr. Clobbers T,TT, updates arguments.
DBLTS0: AOS (P) ;Always skip return
DBLTS: LDB T,[271000,,DPYTAB(G)] ;Check leading char or DM format
CAIE T,@(B) ;Is it correct?
JRST DBLTS1 ;No, output this line
HRRZ T,TXTSER(A) ;Get serial number of this line
CAIN T,@DPYTAB(G) ;Has this line changed?
AOJA G,DBLTSN ;No, next line
CAIE G,(D) ;Yes, are we positioned to this line?
PUSHJ P,PCOMPS ;No, get us there
DBLTS2: SETOM DPYNEW(G) ;note that this line is being output
PUSHJ P,DBLT2 ;Copy text of line into dpy buffer
ADDI B,1 ;DBLT2 SOJed B, so fix it
SKIPA D,G ;Remember in D line number where positioned
DBLTSN: HRRZ A,(A) ;Next line
DBLTS3: SOJG C,DBLTS ;Done enough lines yet?
POPJ P, ;Yes
DBLTS1: PUSHJ P,DBLTSA ;Output special char in leading column
PUSH H,ARRPOS ;XCTed by DBLTSA
JRST DBLTS2 ;Now output text of line
DBLTSA: CAIE G,(D) ;Are we positioned to this line?
PUSHJ P,PCOMPS ;No, get us there
SKIPE DMLINE
JRST DBLTSB ;No arrow drawing/erasing on DM
XCT @(P) ;Position to leading column
PUSH H,(B) ;Output leading char
DBLTSB: MOVE T,(B) ;Get special char in ASCID word
DPB T,[271000,,DPYTAB(G)] ;Remember char in leading column of line G
JRST POPJ1
;Check line editor line for correct arrow char, display new char if needed.
;Also displays simulated line editor if in macro or from partially typed cmd (⊗X).
DBLTA:
IFN FTMACL,<
SKIPE NOLEDS ;Display LE buf if awaiting rest of cmd
SKIPLE CURMAC ;If in macro, we display text from our LE buf
JRST DBLTA0
>;FTMACL
LDB T,[271000,,DPYTAB(G)] ;Get char in leading col of line
CAIN T,@(B) ;Is it what it's supposed to be now?
AOJA G,DBLTA2 ;Yes
DBLTA0: PUSHJ P,DBLTSA ;No, output correct special char
PUSH H,-3(P) ;XCTed by DBLTSA
IFN FTMACL,<
PUSHJ P,MACDSL ;If in macro, display text from our LE buf
>;FTMACL
PUSH H,[ASCID /
/]
AOS D,G ;Remember in D line number where positioned
IFN DDLOSS,<
XCT DDCOLS ;If on DD, put out explicit col sel
>;IFN DDLOSS
DBLTA2:
;; SKIPN LESIM ;Don't redraw following line if LE was simulated
;; HLLZS DPYTAB(G) ;Force this line to be output later
HLLZS DPYTAB-1(G) ;Force line editor line to be output later
SETOM DPYNEW-1(G) ;remember this line is being output (w/line editor)
SOJG C,DBLTA ;Do more lines if requested
POPJ P,
;TDISP TDISP0 TDISPC TDISP1 TDISP7 TDISP2 TDISP3 TDISPE TDISPI
TDISP: PUSHJ P,TDISP0
TRZ F,DSPSCR!DSPALL
JRST POPBAJ
TDISP0: SETZM TDPAGE# ;Permit page number typeout
TDISPC: SETZM TYOPNT
PUSHJ P,GPAGL
HLRZ TT,T
ANDI T,-1
CAMN T,LSTPAG
JRST TDISP5
MOVEM T,LSTPAG
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Page /]
TYPDEC LSTPAG
MOVEI T,['TTY '↔ 440012,,BOTPGO]
NULMES T, ;say " of nnn"
JFCL ;CAN'T HAPPEN
SKIPE TDPAGE
JRST TDISP1 ;XTYPE cmd suppresses "line 13 of 15" on new page
OUTSTR [ASCIZ /, line /]
MOVEI T,['TTY '↔ 440017,,BOTARR]
NULMES T,
JFCL ;CAN'T HAPPEN
TDISP1: MOVEM TT,LSTARR
TRNE F,EDITM
JRST TDISPE ;Here when entering text of line
PUSHJ P,ABCRLF
TDISP7: MOVE A,ARRLIN ;LGC special, typeout w/o leading CRLF.
SKIPL T,TXTFLG(A)
CAIN A,BOTSTR
JRST TDISP4
PUSHJ P,TDLINE ;Type out line number if user wants it
HRRZ T,TXTCNT(A) ;New to permit TXTCNT not equal TXTFLG
SKIPN T
TLOA A,350700
HRLI A,440700
ADDI A,LLDESC
TDISP2: ILDB T,A
TYPCHR (T)
CAIN T,11
JRST TDISP3 ;Skip to ending tab
CAIE T,12
JRST TDISP2
POPJ P, ;End of line
TDISP3: ILDB T,A
CAIE T,11
JRST TDISP3
JRST TDISP2
TDISPE: SKIPLE LINNBR ;Skip if user doesn't want line numbers
JRST TDISPI ;Type out line number
SKIPE NLININ ;Is this first line being inserted?
POPJ P, ;No, no prompt
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Inserting at line /]
TYPDEC LSTARR
OUTSTR [ASCIZ/:
/]
POPJ P,
TDISPI: PUSHJ P,ABCRLF
TYPDEC LSTARR ;Type out line number
TYPCHR ": " ;That's a colon and a tab
POPJ P, ;Don't display the line he is about to type
;TDISP4 TDISP6 TDISP5 TYPE TYPEL PRINT PRINTL TDLIN2 TDLINE NBRLIN
TDISP4: TYPCHR "("
PUSHJ P,TDLIN2 ;Type out line number if user wants it
JRST TDISP6 ;Typed line number
OUTSTR [ASCIZ/Line /]
TYPDEC LSTARR ;Type out line number whether user wants it or not
TYPCHR ": "
TDISP6: JUMPGE T,.+2
OUTSTR [ASCIZ/Pagemark -- /]
OUTSTR [ASCIZ/End of Page /]
TYPDEC LSTPAG
OUTSTR [ASCIZ/ of /]
TYPDEC PAGES
OUTSTR [ASCIZ/)
/]
POPJ P,
TDISP5: CAMN TT,LSTARR
TRNE F,DSPSCR!DSPALL
JRST TDISP1
POPJ P,
TYPE: TRNE F,ARG
JRST .+3
SKIPN DPY ;Default on display is one line
IMULI A,=10
PUSHJ P,ARGCHK
SKIPG D,A
POPJ P,
SETZM TDPAGE ;Allow typeout of starting page number
SKIPE DPY
TRO F,DSPSCR ;Force first line to be typed out always on display
TYPEL: PUSHJ P,TDISPC
SETOM TDPAGE ;Suppress page number typeout for remaining lines
MOVEI A,1
PUSHJ P,MOVARR
SOJG D,TYPEL
SKIPE DPY
POPJ P, ;Don't type out new arrow line if on display
PUSHJ P,TDISPC ;Force out last line now
TRZ F,DSPSCR!DSPALL
POPJ P,
;Special LGC command routine to type out # lines w/o any leading CRLF, doesn't
;even say OK. Won't type page numbers; line numbers are under usual control.
PRINT: SETZM TYOPNT ;force typeout to tty
PUSHJ P,ARGCHK
SKIPG D,A
POPJ P,
PRINTL: PUSHJ P,TDISP7 ;type out one line
MOVEI A,1
PUSHJ P,MOVARR ;move to next line
SOJG D,PRINTL
SKIPE DPY
JRST CPOPJ1 ;Don't type out new arrow line on display, no OK
PUSHJ P,TDISP7 ;Force out last line now
TRZ F,DSPSCR!DSPALL
JRST CPOPJ1 ;no OK
TDLIN2: SKIPG LINNBR
JRST POPJ1 ;Skip return if didn't type line number
TDLINE: SKIPG LINNBR ;Skip if user wants line numbers typed out
POPJ P,
TYPDEC LSTARR
TYPCHR 11
POPJ P,
NBRLIN: MOVEM A,LINNBR# ;Set flag determining whether we type line numbers
POPJ P,
;⊗ WRPAGW WRPAGG WRPAGH WRPAGI WRPAGC WRPAG0 WRPAGD WRPAGB WRPGER WRPAGA WRPAGE WRPAG3 WRPAG2 WRPAG8 WRPAG5 WRPAG6 WRPAG7 SETUFG
;routine to see if OK to write out the file (readwrite and formatted).
;direct return means: WRITE is off, or file not formatted, or /B, or on dir
; page, or /R confirmed, or won't need to write because opening new window
;single skip means in READWRITE mode now.
;double skip means user says to ABORT the command (still ReadOnly mode).
;clobbers T,C,D,E; preserves A,B.
WRPAGW: MOVE T,NCMDS ;see if just gave new-window cmd
CAMN T,WANTWN ;skip if no new window requested
POPJ P, ;new window opening, won't try to write out file
WRPAGG: TRNN F,WRITE ;If page hasn't changed,
POPJ P, ;there is no output to do
WRPAGH: SKIPA T,[IDIOT] ;normal routine to call, checks for editing dir
WRPAGI: MOVEI T,IDIOT0 ;enter here from UPDATE, OK to be on dir page
PUSHJ P,(T) ;See if we are allowed to write out the page
POPJ P, ;Don't try to write page (error msg typed)
PUSH P,A
PUSH P,B
TRNN F,REDNLY ;readonly mode?
JRST PPBAJ1 ;single skip for readwrite mode
PUSHJ P,WRRDO ;yes, see if wants to stay readonly
AOS -2(P) ;take double skip for ABORT given by user
AOS -2(P) ;take single skip for readwrite mode
JRST POPBAJ ;direct return means READONLY confirmed
;routine to skip if we have file open or can open it (usually call after WRPAGG)
;if doesn't skip, then error msg has been typed.
;clobbers T,TT,C,D,E,H; preserves A,B.
WRPAGC: TLNE F,ENTRD ;file already open?
JRST POPJ1 ;yup, go ahead
PUSH P,A
PUSH P,B
PUSHJ P,OPENI2 ;no, try to open the file
JFCL ;may type something and skip
TLNE F,ENTRD ;skip if we didn't really get the file open
AOS -2(P) ;success return, can write out now
JRST POPBAJ
;WRPAGE is entered whenever we want to write out the page to the disk.
;Called from FINI0 NEWPG0 DELET1 LININ WRPAG0/A FINBSL BLOAT2 UPDATE.
;WRPAG0 is called by ⊗. command via CMDSP, and by BLOAT
;Enter here for ⊗. command only.
WRPAG0: TRNN F,EDITM ;Coming from line editor?
JRST WRPAGA ;No, no special check for double bucky
CAIE B,CTMT3 ;Yes, gotta be double bucky
JRST WRPGER ;But it isn't!
PUSHJ P,FNEDT0 ;Okay, accept the line, w/out clearing line ins mode
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST WRPAGD ;can't write it or don't need to--save marks!
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST WRPAGB ;failed to open (typed error msg) or ABORT given
WRPAGD: PUSHJ P,WRPAGE ;Now write out the page
WRPAGB: SETOM NLININ ;If in line insert mode, make it "funny" version
JRST REEDT3 ;Now re-edit the line
WRPGER: SORRY Must use αβ. to write page from line editor.
JRST REEDT2
;Here for ⊗. command given when not in line editor.
WRPAGA: TRNN F,WRITE ;If page hasn't changed,
JRST WRPAGE ;there is no output to do, let WRPAGE say OK
PUSHJ P,WRPAGH ;skip if readwrite mode and formatted file
JRST [ AOS (P) ;can't write it (or don't need to), don't say OK
JRST WRPAGE] ;save marks, though (error msg typed)
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPJ1 ;failed to open (typed error msg) or ABORT given
;fall into WRPAGE ;file is open
;Subroutine to write out the current page. Never skips!
WRPAGE: MOVE T,ZINDEX ;Save MARKS always
HRLI TT,MARKS
HRRI TT,ZDATA+ZMARK(T)
BLT TT,ZDATA+ZMARK+NMARKS-1(T)
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
POPJ P, ;can't write or no need (used to be JRST CLRWRT)
CAIA ;readwrite
FATAL WRPAGE called without WRPAGG checking mode--too late to abort!
JFCL WRPAGE ;To report location WRPAGE in CHECKU
PUSHJ P,CHECKU ;checksum the upper segment
SKIPG NODUPD ;Skip if directory needs updating and not suppressed
JRST WRPAG3 ;Directory okay or updating suppressed
TRO F,UPDIR ;Yes, force output of updated directory
SETZM NODUPD ; but don't do it again.
HRRZS UIFLG ;Clear " U" from top line.
SETOM NEEDHD ;set flag to make HEADS think about hdr line
WRPAG3: TRNE F,UPDTXT ;Has the text of the dir line for this page changed?
PUSHJ P,INSDIR ;Yes, get new dir line
TRNE F,UPDIR
PUSHJ P,DIRUP ;fix up incore pagemarks, flush deleted pagemarks
SKIPE B,XPLST
PUSHJ P,DIRSET
MOVE A,CHARS
ADDI A,200*5-1
IDIVI A,200*5 ;Number of records needed to write out text
ADD A,BLOATS ;Number of extra records to bloat this page by
MOVEM A,NEWSIZ#
HRRZ C,@DIRPT
MOVE B,DIRREC(C) ;Record number of beginning of following page
HRRZ T,DIRP1 ;First page in core
SUB B,DIRREC(T) ;Calculate amount of disk space available
MOVEM B,OLDSIZ#
SUBI A,(B)
TRNN F,UPDIR
SKIPL NODUPD ;Skip if user wants no directory updating
SKIPN DIRPAG ;Skip if file has a disk directory
JRST WRPAG2 ;Not writing any directory, dir can't cause rippling
HRRZ TT,@DIR
MOVE TT,DIRREC(TT)
SOJ TT,
IMULI TT,200*5 ;figure out how much room we have for directory
SKIPGE NODUPD ;skip unless suppressing directory updates
ADD TT,EDIRSZ ;won't be writing this much of dir (fake more room)
CAML TT,DIRSIZ ;Directory need additional record(s)?
WRPAG2: SKIPE BURPIT ;Burping requested?
JRST WRPX0 ;Yes
SKIPL BURPEX ;Skip unless auto burping disabled
JRST WRPAG8
SKIPN DELFI2 ;skip if file will be deleted
SKIPE DELFIL ;Don't autoburp if file about to be deleted anyway
JRST WRPAG8 ;Don't consider autoburp this time
SKIPN BLOATF
SKIPGE NODUPD ;Skip unless user wants no directory updating
JRST WRPAG8 ;No auto burp in /-U mode, nor if bloating
CAMG A,BURPEX ;BURP if BURPEX is reached
JRST WRPXBP ;Auto burp now, page is too bloated
WRPAG8: MOVE TT,CURPAG
CAML TT,PAGES
JRST WRPAG5 ;Last page of file is in core, can extend file
JUMPLE A,WRPOK ;Jump if already enough disk space for text
SKIPE BLOATF ;Skip if not bloating
JRST WRPX0 ;Manually bloating, turn on XPAGE flag
JRST WRPX ;Must expand page(s) in middle of file--ripple
;Here when writing out text of last page of file. Make sure FILWC updated.
WRPAG5: JUMPG A,WRPAG6
SETZ A,
WRPAG6: MOVEI TT,(A) ;Can expand page(s) at end of file by extending file
ADDB TT,DIREND+1 ;Increase record number of ENDMK by amt needed
SOJ TT,
PUSH P,TT ;Save new last record in file
JUMPE A,WRPAG7
IMULI A,200*5
ADDM A,ROOM
SKIPL NODUPD ;Skip if suppressing directory updates
TROA F,UPDIR ;File longer means directory ENDMK must change
PUSHJ P,SETUFG ;Remember that directory on disk isn't current
WRPAG7: TRZ F,XPAGE
PUSHJ P,WRTIT ;Write out last page(s) of file
IFE DECSW,<
MTAPE DSKO,['GODMOD'↔17] ;Force retrieval out.
>
IFN DECSW,<
MOVE TT,[1,,[DSKO,,10]]
FILOP. TT,
JFCL
SETOM IBLK ;Stupid DEC usetos to eof on this filop!
SETOM OBLK
> ; so we tell E it doesn't know where it is at.
POP P,TT ;Get back new length
CAMG TT,FILLEN ;Did length change (grow) just now?
SKIPA TT,FILLEN ;No, get old length
MOVEM TT,FILLEN ;Update number of records in file
LSH TT,7
MOVEM TT,FILWC ;Update number of words in file
POPJ P,
;Here when LH NODUPD is -1 and incore directory is now different from that on disk.
SETUFG: MOVSI TT," U"⊗4
HLLM TT,UIFLG ;Flag it to user
SETOM NEEDHD ;set flag to make HEADS think about hdr line
HLLOS NODUPD ;Flag it to us
POPJ P,
;WRPXBP WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2
WRPXBP: OUTSTR [ASCIZ/ Auto Burp:/] ;Here to auto burp a page.
WRPX0: TRO F,XPAGE ;Expanding directory, or manually burping.
WRPX: TRNN F,XPAGE ;Recopy file to expand page(s) in the middle.
PUSHJ P,TELLZ
OUTSTR [ASCIZ / Rippling /]
IMULI A,200*5
ADDM A,ROOM
MOVEI I,1
SKIPN A,DIRPAG
JRST WRPX1A ;No directory on disk.
;Since we're already rippling anyway, we'll allow enough
;room in the directory area on disk for the entire dir,
;even though some of the dir may not get written for now (if /-U mode).
;Thus we make no adjustment for any value in EDIRSZ.
MOVE A,DIRSIZ
ADDI A,200*5-1+200*5
IDIVI A,200*5 ;Number of records dir need now
HRRZ B,@DIR
MOVE I,DIRREC(B) ;Number of records dir used to use
SUBI A,(I) ;Number of records by which whole file is shifted
MOVN C,DIRPAG
TRNN F,EDDIR ;may be rippling dir on UPDATE from dir page
TRNN F,WRITE
JRST WRPX1B ;Only the directory will need different amt of disk
ADD C,CURPAG
JUMPLE C,WRPX1A
WRPX1: ADDM A,DIRREC(B) ;Shift record numbers of pages up to current page
HRRZ B,(B)
SOJG C,WRPX1
WRPX1A: ADD A,NEWSIZ ;Add in change in record size of current page
SUB A,OLDSIZ
HRRZ B,@DIRPT
HRL I,DIRREC(B) ;Old record number of following page
MOVN C,CURPAG
WRPX1B: ADD C,PAGES
WRPX2: ADDM A,DIRREC(B) ;Shift record numbers of pages beyond current page
HRRZ B,(B)
SOJGE C,WRPX2
;⊗ WRPX3 WRPX3B WRPX4
;FELL THROUGH FROM PREVIOUS PAGE. NO REFERENCES TO WRPX3.
WRPX3:
repeat 1,<
AOSN RIPDIS# ;skip unless want display update before rippling
SKIPN WINLIN ;can't put out display if no page set up yet
JRST WRPX3B
PUSH P,G ;preserve ACs except T and TT
PUSH P,H
PUSHJ P,DISP ;Update display, if needed, before rippling
PUSHJ P,SKIPIN ;Arg. to DISP (skip if input ready, char or line mode)
POP P,H
POP P,G
WRPX3B:
>;repeat 1
PUSHJ P,COPCOR ;Get a lot of extra core for copying file
MOVE T,ICHN
CAIE T,DSKO
PUSHJ P,TELLZ ;Wrong channel is being used for input!!!
IFE DECSW,<
SETSTS DSKO,RAQMOD ;Suppress update of retrieval for this RA mode chk
>;NOT DECSW
PUSHJ P,OPENWE ;Make sure we have RA mode access to the file
TLZ F,ENTRD ;Simulate OPENI
MOVEI C,DSKI ; " "
PUSHJ P,SETCHN ;Put channel into I/O UUOs XCTed, release other chn
MOVEI A,1 ;Place for REOPE2 to position us to in file
PUSHJ P,REOPE2 ;Re-open the edit file on input channel
PUSHJ P,TELLO ;Oops, someone changed the file out from under us!
PUSH P,NEWSIZ
PUSHJ P,OUTDIR ;Write out the new directory
SKIPN DIRPAG
PUSHJ P,OPENWE ;OUTDIR opens output file for non /N case only
TRZ F,UPDIR!UPDTXT
POP P,NEWSIZ
MOVEI A,(I) ;Old record number of first page after dir
IFN FTBUF,<
SETOM IBLK ;Force SETI to do a USETI despite the cache
>
PUSHJ P,SETI0 ;Want to read from there, and turn on filestatus
MOVEI A,(I) ;Old record number of first page after dir
TRNN F,EDDIR ;may be rippling dir on UPDATE from dir page
TRNN F,WRITE
JRST WRPX4 ;No page changed (except dir)--do whole file at once
HRRZ B,DIR ;Get pointer to page 1 (directory page unless /N)
SKIPE DIRPAG ;/N?
HRRZ B,(B) ;No, get pointer to page after directory (page 2)
MOVE A,DIRREC(B) ;New record number of first page after dir
HRRZ B,DIRP1
SUB A,DIRREC(B) ;Subtract new record number of first page in core
ASH A,7
PUSHJ P,COPDAT ;Copy from old file to new
HRRZ T,DIRP1
PUSHJ P,WRTIT ;Write out current page
HLRZ A,I ;Former record number of following page
IFN FTBUF,<
SETOM IBLK ;Force SETI to do a USETI despite the cache
>
PUSHJ P,SETI ;Want to read old file from there
HLRZ A,I ;Former record number of following page
WRPX4: ASH A,7 ;Convert to words
SUB A,FILWC ;Make negative number of words to be written (Old WC)
SUBI A,200 ;Include first record of copy
PUSHJ P,COPDO ;Copy remainder of file to new file and close both.
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI ;Open new file for input.
FATAL Cannot reopen file after rippling.
TLZ F,ENTRD
PUSHJ P,OPENWE ;Open new file in R/A mode.
POPJ P,
;WRPOK WRTIT WRT0
WRPOK: TRNE F,XPAGE ;Get here if don't need to ripple
JRST WRPX ;Ripple anyway--this should never happen
WRTIT: SETOM INSCNT ;No lines inserted now (for autowrite)
PUSH P,T ;Here to write out in-core page(s)
PUSHJ P,OPENWE ;Open edit file for writing
SKIPN DIRPAG
TRZ F,UPDIR
TRNE F,UPDIR
TRNE F,XPAGE
JRST WRT0
MOVE D,ODSIZ
CAIL D,200*5+3 ; ;-CR-LF
SKIPA D,[170700,,DRIV2+3]
MOVE D,[170700,,DRIV1+3]
MOVEM D,INPNT
MOVE C,PAGES
PUSHJ P,NUM5
MOVEI A,1
PUSHJ P,SETO ;select record 1 for output
MOVE C,-3-1(D) ;get IOWD from just before "invalid" text
MOVEI D,
OUTPUT DSKO,C ;Temporarily mark directory as invalid
WRT0: HRRZ A,DIRP1
MOVE A,DIRREC(A) ;get record number where page starts
PUSH P,A
PUSHJ P,SETO
MOVEI A,PAGE
MOVEI DSP,WRDSP
MOVSI E,LSPC+NSPEC
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVE T,FIRPAG
SOJE T,WRLINE
;⊗ WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO4 WRRDO3 ABOR
WRP1: MOVEI C,14
IDPB C,G
AOBJN B,WRLINE
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
WRLINE: HRRZ A,(A)
CAIN A,BOTSTR
JRST WRDONE
SKIPGE T,TXTFLG(A)
JRST WRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
TRNN T,777777
TLOA D,350700
HRLI D,440700
HRRI B,
WRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
WRLP2: AOBJN B,WRLUP
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST WRLUP
;Here from WRPAGG upon attempt to write out file from readonly mode.
;Direct return if ABORT was selected by user.
;Single skip if ReadWrite selected.
;Double skip if ReadOnly selected.
WRRDO: MOVE D,NCMDS ;check for new cmd since we asked about this file
HRL D,WINSER ;check for same window, same cmd
CAMN D,WRRDOF ;skip if haven't asked about this window this cmd
JRST POPJ2 ;already asked, take still-readonly return
MOVEM D,WRRDOF ;assume says readonly (cleared below if readwrite)
SORRF Page has been altered -- please reaffirm mode for
MOVE D,[FRDRUN,,EDFIL] ;type edit file's name w/o switches
PUSHJ P,FILTYP ;type filename
OUTSTR [ASCIZ/.
/]
WRRDO2: MOVE E,[-NMCMDS,,MCMDS]
;Note: DSP is expected to be set up pointing to cmd dispatch table when
;we get to EXTEN1. Sign bit is used as line editor flag, so any caller
;of WRPAGE should have DSP set properly.
PUSHJ P,EXTEN1 ;Get command from TTY--READWRITE/READONLY/ABORT
JRST WRRDO3 ;Not one of above commands
PUSHJ P,(D) ;Execute the command (skips if ABORT)
AOSA (P) ;not ABORT, skip return AT LEAST once
POPJ P, ;ABORT, take direct return
TRNE F,REDNLY ;Did he say OK to write now?
JRST WRRDO4 ;still readonly
SETZM WRRDOF# ;didn't say readonly after all, clear flag
POPJ P, ;single skip (sic) return for readwrite
WRRDO4: OUTSTR [ASCIZ/OK, text Not written out. /]
JRST POPJ1 ;skip twice (sic) to indicate still readonly
WRRDO3: OUTSTR [ASCIZ /READONLY, READWRITE, or ABORT only: /]
JRST WRRDO2
;Here upon ABORT given instead of READONLY/READWRITE
ABOR: OUTSTR [ASCIZ/OK, aborting command. /]
JRST POPJ1
;WRDSP WRTAB WRCHK WRDONE WRDON2 WRDON3
WRDSP: JRST WRLINE
PUSHJ P,TELL1
JFCL ;CR
MOVEI D, ;LF ;KILL NEXT ILDB
JRST WRTAB ;TAB
PUSHJ P,TELL5 ;FF
JFCL ;ALT, now we allow altmode in file (formerly TELL6)
WRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,WRLP2
WRCHK: LDB E,[370300,,G] ;SEE HOW MANY CHARS WE WROTE (FROM BLK -C(T))
ADD T,OBLK
LSH T,7
ADDI T,-OBUF+1(G)
IMULI T,5
SUB T,BTAB(E)
POPJ P,
WRDONE: POP P,T
SUB P,[1,,1]
MOVNI T,(T)
PUSHJ P,WRCHK
SUB T,CHARS ;This should give zero -- if not this is a fatal
MOVEM T,CHRERR# ; error, which is postponed to check OBLK first
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVN T,NEWSIZ ;Negate number of records written so far
ADD T,BLOATS ;Bloat records are in NEWSIZ, but aren't written yet
TRNE F,XPAGE ;BEWARE OF SHRINKING BUBBLE
SKIPA T,BLOATS ;Rippling: write out this many records of nulls
ADD T,OLDSIZ ;Not rippling: gotta write out at least old amt
JUMPLE T,WRDON2
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177
PUSHJ P,WRBUF ;Write out records of nulls at end of current page
SOJG T,.-1
WRDON2: HRRZ T,@DIRPT
HRRZ T,DIRREC(T) ;get expected ending record number
CAME T,OBLK
FATAL <WRITE CODE ERROR FOR OBLK.
FILE MAY HAVE JUST BEEN CLOBBERED ON PAGE BEYOND FINAL INCORE TEXT.>
SKIPE CHRERR ;Skip unless someone screwed up the CHARS count
FATAL WRITE CODE ERROR FOR CHARS
MOVEI TT,SETUFG ;Routine merely to flag directory change to user
TRNN F,UPDIR ;This bit forces us to write out directory
SKIPL NODUPD ;Skip if suppressing directory updates
MOVEI TT,OUTDIR ;Normal routine to call if directory changed
TRNE F,UPDTXT!UPDIR ;Skip if directory didn't change
WRDON3: PUSHJ P,(TT) ;Call OUTDIR or SETUFG
IFN FTBUF,<
PUSHJ P,CACCLS ;Force cache to be written out as necessary
>
JRST CLRWRT
;WRPM BTAB2
WRPM: HRRZ B,-1(P)
MOVN T,DIRREC(B)
PUSHJ P,WRCHK
; LDB C,[341000,,LLDESC+LPMTXT+PMSIZE(A)]
LDB C,[POINT PMRBTS,LLDESC+LPMTXT+PMRCNT(A),PMRPOS] ;get nbr of records
IMULI C,200*5
; LDB E,[221200,,LLDESC+LPMTXT+PMSIZE(A)]
LDB E,[POINT PMCBTS,LLDESC+LPMTXT+PMCCNT(A),PMCPOS] ;get nbr of characters
ADDI C,(E)
SUB T,C ;This should give zero -- if not this is a fatal
MOVEM T,CHRERR# ; error, which is postponed to check OBLK first
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVE T,-1(P)
HRRZ T,(T)
MOVE C,OBLK
CAME C,DIRREC(T)
FATAL <WRITE CODE ERROR FOR OBLK WRPM
FILE MAY HAVE JUST BEEN CLOBBERED ON PAGE BEYOND FINAL INCORE TEXT.>
SKIPE CHRERR ;Skip unless someone screwed up the char count(s)
FATAL WRITE CODE ERROR FOR CHARS WRPM
MOVEM T,-1(P)
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC+NSPEC
JRST WRP1
BTAB2: -340000,,1
-250000,,1
-160000,,1
-70000,,1
1
-340000,,
-250000,,
-160000,,
IMPURE
DEFINE INV!(X,Y)<-L!X,,.
X: ASCII /COMMENT ⊗ INVALID XXXXX PAGES
Y
/
IFN <.-X>&1,<0> ;SUPER-WINNING CHANNEL
L!X←←.-X>
INV DRIV1,<⊗;>
INV DRIV2,THE REST OF THIS PAGE IS GARBAGE
PURE
;FLSPG0 FLSPAG FLSPGL FLSPG2 CLRWRT CLRWR2 DSHED
FLSPG0: PUSHJ P,GPAGL ;Get line,,page where we are now
MOVEM T,BAKPL2# ;Remember where we are before flushing page's lines
MOVE T,TOPWIN
MOVEM T,BAKWI2# ;Remember window position too
FLSPAG: TRNE F,UPDIR
PUSHJ P,DIRFIX ;fix up dir, flushing any temp new pages not written
SKIPN C,LINES
JRST FLSPG2
HRRZ B,PAGE
TLO F,NOCHK ;disable shuffling in FSGIVE
FLSPGL: MOVEI A,(B)
HRRZ B,(B)
SETOM NOSAVE ;Don't let FSGIVE save this text for undeleting
PUSHJ P,FSGIVE
SOJG C,FLSPGL
FLSPG2: TLZ F,NOCHK
SETZM SLNSTP ;Clear line number of short stop on search
SETZM ARRLIN
SETZM WINLIN
SETZM XPAGES
SETZM XPLST
SETZM XCHRS
HRRZS BOTSTR+TXTFLG
CLRWRT: TRZN F,WRITE!UPDIR!UPDTXT!XPAGE
POPJ P,
CLRWR2: MOVEI T,1
MOVEM T,WFLAG
MOVEM T,WFLAG2
TLO F,DSPTRL ;Force recalculation of trailer values
DSHED: MOVE T,SCRTOP ;Force redisplay of header line
HLLZS DPYTAB(T)
SKIPE DPY ;Don't cause spurious retyping of line on non-display.
TRO F,DSPSCR
POPJ P,
;FILWRD DEVWRD RSYS RUN RUN1 CHKFII CHKFIL GETRUN
FILWRD←←0 ;FOR PASSING RETURN FILNAM, ETC.
DEVWRD←←6 ;" (NOTE THIS STUFF IS SAME PLACE AS SYS PUTS IT)
RSYS: SKIPA T,['SYS ']
RUN: MOVSI T,'DSK'
MOVEM T,RUNFIL-1
SETZM RUNFIL
IFE DECSW,<
MOVSI T,'DMP'
MOVEM T,RUNFIL+EXT1 ;setup default extension
HLR T,RPGACS+FILWRD+EXT1 ;default extension for case w/no name given
TRNN T,-1 ;Is there an extension given for default RUN file?
HLLM T,RPGACS+FILWRD+EXT1 ;No, use DMP since SWAP will
MOVEI T,1
MOVEM T,RUNFIL+DATE2 ;set up starting address increment of 1 (RPG)
>
IFN DECSW,<
SETZM RUNFIL+EXT1
SETZM RUNFIL+DATE1
>
MOVE T,PPN
MOVEM T,RUNFIL+PPN3 ;alias is default PPN
PUSHJ P,GETRUN ;Get filename of dmp file
JRST RUNILL ;lost
CAIE C,15
JRST RUNILL ;filename didn't end with CR
TLNE D,FRDNAM
JRST RUN1
SKIPN RPGACS+FILWRD
JRST RUNNON
SKIPE T,RPGACS+DEVWRD
MOVEM T,RUNFIL-1
MOVE T,[RPGACS+FILWRD,,RUNFIL]
BLT T,RUNFIL+EXT1
MOVE T,RPGACS+FILWRD+PPN3
TLNN T,77
JRST RUN1
TRNE T,77
MOVEM T,RUNFIL+PPN3
RUN1: PUSHJ P,CHKFIL ;Make sure the file exists
JRST RUNFNF ;Nope
MOVE T,EDFIL-1
MOVEM T,RPGDEV
MOVE T,EDFIL
MOVEM T,RPGFIL
HLLZ T,EDFIL+EXT1
TRNE F,REDNLY
TRO T,200000
SKIPN DIRPAG
TRO T,100000
MOVEM T,RPGEXT
MOVE T,EDFIL+PPN3
CAMN T,PPN
MOVEI T,
MOVEM T,RPGPPN
PUSHJ P,GPAGL
HRRZM T,RPGPAG
HRR T,ATTNUM
TRNE F,ATTMOD
IORI T,400000 ;Flag attach mode to new program
TRNE F,EDITM
HRR T,EDCNM ;Give column position to new program
MOVSM T,RPGLIN
TRZE F,ATTMOD ;put anything in attach
PUSHJ P,ATTEX ; buffer down before we write file and swap
PUSHJ P,CLSFIN ;close all windows and files (write each out)
JRST POPJ1 ;failed to open a window or file. avoid saying OK.
MOVE T,[RUNFIL,,RPGACS+FILWRD]
BLT T,RPGACS+FILWRD+PPN3
MOVE T,RUNFIL-1
MOVEM T,RPGACS+DEVWRD
MOVSI 17,RPGACS
BLT 17,17
IFE DECSW,<
MOVEI A,RUNDEV
SWAP A,
>
IFN DECSW,<
MOVE A,[1,,RUNDEV]
RUN A,
>
PUSHJ P,TELLZ
;Routine to make sure a given file exists, filename in RUNFIL block.
;Skip on successful lookup, after closing the file.
CHKFII: SKIPA T,[LSPINI,,LKUP-1] ;Enter here to check file named in LSPINI
CHKFIL: MOVE T,[RUNFIL-1,,LKUP-1]
IFE DECSW,< ;TOO MANY CORE IMAGE FILE TYPES TO DO THIS for DEC
MOVEI C,SWP
PUSHJ P,OPNDEV ;skips on failure
LKPMAC <LOOKUP SWP,LKUP>
POPJ P, ;failed
PUSHJ P,RELDEV ;let go of file now that we know it's there
>;IFE DECSW
JRST CPOPJ1
;Subroutine to scan dmp file name in command line, skips on success.
GETRUN: PUSHJ P,XTDLIN ;Prepare to reread the command line
MOVE D,[FRDRUN!FRDPAR,,RUNFIL] ;allow filename to end with paren
PUSHJ P,FRD0 ;our caller should check ending char for fitness
POPJ P, ;Syntax error, take error return
JRST POPJ1 ;success
;RUNILL RUNNON RUNFNF EXEFN2 RUNDEV RUNFIL
RUNILL: SETZM TYIPNT ;Flush any unread part of filename string
SORRY Illegal file specification.
JRST POPJ1
RUNNON: SORRY There is no program to return to.
JRST POPJ1
RUNFNF: TLNN D,FRDNAM
JRST RUNNON
RUNFN2: RELEAS SWP,
SETZM JOBJDA+SWP
EXEFN2: SORRJ
MOVE D,[FRDRUN,,LKUP] ;For typing filename and error without switches
PUSHJ P,FILERR ;Type name of run or execute file we didn't find
OUTSTR [ASCIZ /
/]
JRST POPJ1
IMPURE
0
RUNDEV: 0
RUNFIL: BLOCK 2
IFE DECSW,<
1 ;Starting address increment--rpg startup
0
0 ;PPN word for phantom PPN for SLISP cmd
>
IFN DECSW,<
0
0
0
>
PURE
;SEARCH ROUTINES ;⊗ SDELIM SBKWDS OFFPAG SRCFLG SRCSIZ SRCBUF SUBFLG SUBSIZ SUBTYP SUBDEL SRFLG2 SUBBUF SUBDIF SFSNUM NOTOP INFOP OROP ANDOP BINOP ENDOP CROP CLOSOP ORCHR ANDCHR SGBBIT SGEBIT NLDBIT NOTBT XFRSAV INDTST REMTST LSBLK
;FLAGS
SDELIM←←1 ;delimited search
SBKWDS←←2 ;search backwards
;;SEXACT←←4 ;;ME--This bit no longer used--now location EXACTS contains flag
OFFPAG←←10 ;extended search didn't find the string among the incore text
;DATA BLOCKS, the AC E will contain FNDTBF (for 1 page) or FNDBUF (fon multipage)
SRCFLG←←0 ;Indexed by E to contain search string flag
SRCSIZ←←1 ; to contain search string size
SRCBUF←←2 ; to contain search string start
SUBFLG←←40 ;Indexed by E to contain substitution string flag
SUBSIZ←←41 ; to contain substitution string size
SUBTYP←←42 ; to contain type of associated search
SUBDEL←←43 ; to contain delete command string
;Cell reserved for deletion string overflow
SRFLG2←←45 ; To contain saved value of SRFLG for repeat
SUBBUF←←46 ; to contain substitution string start
SUBDIF←←SUBBUF-SRCBUF ;To permit simple stepping from SRCBUF to SUBBUF
;FREE STORAGE MACROS
DEFINE GETFS(X)
< SKIPN X,@SFSPNT
PUSHJ P,SFSGT
EXCH X,SFSPNT>
DEFINE RETFS(X)
< EXCH X,SFSPNT
HRRZM X,@SFSPNT>
SFSNUM←←8
;OPERATOR CODES (must fit in 4 bits (AC field at SSCDSP)).
NOTOP←←2
INFOP←←3
OROP←←5
ANDOP←←6
BINOP←←7
ENDOP←←7
CROP←←10
CLOSOP←←11
ORCHR←←12
ANDCHR←←13
SGBBIT←←400000
SGEBIT←←200000
NLDBIT←←100000
NOTBT←←2000
XFRSAV←←4
INDTST←←5
REMTST←←10
LSBLK←←5 ;unused
;⊗ SREAD SREAD0 SRELOD SREAD1 SREA10 SREA11 SREAD7 SREAD8 SREAD9 SREAD2 SREAD3 SREAD4 LODFND SRSTOR SRSTR2
;Called by FINDIT and FIND to read string from TTY
;String is assembled in BUF and must be shorter than 199 characters
SREAD: HRRZM C,SAVEFX#
HRLM B,SAVEFX ;Save temporarily for later test and possible save
PUSH P,F ;Save copy of EDITM bit
TRZ F,EDITM ;Force DISP to redraw current line if from line ed.
SKIPE TYIPNT ;Skip if reading from TTY.
JRST SREAD0 ;Reading from XFIND command string.
PUSHJ P,LOADM0 ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro.
PUSHJ P,DISP ;Update display, including line we came from, if any
XCT LINTST
SREAD0: POP P,T ;Get back EDITM flag
ANDI T,EDITM ; and nothing else
CAIN B,CTMT3 ;double bucky means delimited search
TRO T,SDELIM
JUMPGE A,.+2 ;negative repeat arg means backwards search
TRO T,SBKWDS
MOVEM T,SRFLG# ;save search flags (EDITM, SBKWDS, SDELIM)
MOVMM A,SRCNT# ;remember how many copies of string to search for
SRELOD: MOVE D,[440700,,BUF] ;here after α<lf> loads line ed w/old string
MOVNI B,SRSIZ*5-1
SETZM SRCSI2# ;Count non-text chars ¬ and ≡ for substitution
SETZM IDFLAG# ;To keep track of meaning of ¬ and ≡
TLZ F,TF1 ;String not (yet) delimited by LF's
PUSHJ P,TYI
JRST SREAD4 ;Find out the cause of activation
SREAD1: IDPB C,D
SKIPN IDFLAG
JRST SREAD9 ;Nothing special seen last
SKIPL IDFLAG
JRST SREAD8 ;Last seen ≡ means this char is normal text (quoted)
CAIE C,"≡" ;Last seen ¬
JRST SREAD8 ;This is a text char (negated)
HLRZS IDFLAG ;0,,-1 means have seen quoting ≡ ("¬≡x")
JRST SREAD7
SREA10: HLLOS IDFLAG ;0,,-1 means have seen quoting ≡
JRST SREAD7
SREA11: SETOM IDFLAG ;-1 means have seen negating ¬
SREAD7: AOSA SRCSI2 ;Count a non-text char in string
SREAD8: SETZM IDFLAG
JRST SREAD2
SREAD9: CAIN C,"≡"
JRST SREA10
CAIN C,"¬"
JRST SREA11
SREAD2: PUSHJ P,TYI
JRST SRACT ;Now act on extended string
SREAD3: AOJN B,SREAD1
SORRY Search string too long.
SETZB D,SRCNT
AOS -1(P)
JRST SREAD2
;SREAD4 is called if an activation character is received without any search string.
;It allows for ALT interruption. On a LF (used to quote a search string
;containing a CR) it returns to SREAD2 (with TF1 set in F to indicate quoting
;whole string) to allow for reading of rest of string from TTY.
;A "\" or number (with bucky bits) as the first character is not allowed
;and causes the command to be aborted.
;Any other activation character causes SREAD5 to be entered.
SREAD4: CAIN C,ALTMOD
JRST POPTJ ;An ALT abort
LDB TT,[POINT 7,C,35]
CAIE TT,"∞"
CAIN TT,"\"
JRST QREADR ;This means repeat last substitution
CAIL TT,"0"
CAILE TT,"9"
SKIPA
JRST QREADR ;Argument for a repeat substitution
SETZM QCHR ;Definitely not a substitution
CAIN C,212 ;α<lf> means load line ed with old string
JRST LODFND ;load line editor and restart SREAD
CAIE C,12 ;skip if quoting whole string with LFs
JRST SREAD5
TLO F,TF1
SKIPN TYIPNT ;Skip if not reading from TTY
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding macro
SOJA B,SREAD2
LODFND: MOVE T,SRCSIZ(E) ;get length of search string's text
IDIVI T,5 ;figure out where it ends in buffer
MOVEI D,SRCBUF(E) ;ptr to beginning of search string text
ADDI D,(T) ;make ptr to word containing null after string
HLL D,BTAB4(TT) ;make byte pointer from remainder
MOVEI T,15 ;insert CR at end of string
DPB T,D ; to make PTLOAD work right
MOVEI T,0 ;do PTLOAD to self
MOVEI TT,SRCBUF(E) ;ptr to old search string to load into line ed
SKIPE DPY ;forget line editor if not display
PTLOAD T ;load line editor with old search string
DPB T,D ;replace temp CR after string with normal null
JRST SRELOD ;read back edited search string
;SRSTOR stores the searched-for string away.
SRSTOR: JUMPLE D,SRSTR2
MOVEI TT,
IDPB TT,D
TLNE D,760000
JRST .-2
MOVSI TT,BUF
HRRI TT,SRCBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D)
ADDI B,SRSIZ*5-1+1
MOVEM B,SRCSIZ(E)
SRSTR2: SETZM SUBTYP(E) ;Will be reloaded from SAVEFX for a substitution
SETZM SUBFLG(E) ;A new substitution string must be given
JUMPN D,.+2
MOVEI E,SRDUMY
SETZM QCHR ;This may also be a simple FIND so fix this also
JRST (Q)
;⊗ QREAD QREADY QREADX QREAD0 QREAD1 QREAD2 QNOFF QNOFF2 QRDATT QREAD4 QABORT LODSUB QRED4A
;Entered from SRACT on the receipt of a \ or LF as the first string termination.
;QREAD sets up a 9-bit character string, an argument and delete command based on
;the size of the search string. This is stored at SUBDEL(E). Then the code accepts
;the substitution string and stores this temporarily in BUF. On the receipt of an
;activation character,the code then JRST's to QRACT, the string goes to SUBBUF(E),
;SAVEFX goes to SUBTYP(E), and QCHR and SUBFLG(E) ars set as requested
;by the activating character that terminates the substitution string.
QREAD: MOVEM A,QARG#
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro
LDB B,[70200,,C]
MOVEM B,SUBTMP# ;Save bucky bits temporarily
SETZM SUBDEL(E) ;To guarantee termination
SETZM SUBDEL+1(E) ;To guarantee termination
MOVE A,[POINT 9,SUBDEL(E)] ;We shift to 9-bit representation
MOVE D,[POINT 9,SUBDEL(E)]
MOVE T,SRCSIZ(E) ;Get size of searched-for string to set up deletes
SUB T,SRCSI2 ; The ¬ symbols do not count
HRLM T,SUBSIZ(E) ;actual number to delete put in left half
SOJN T,QREADY ;Leave one delete until later for LINE-EDIT case
MOVEI C,240 ;Just to be sure we enter LINE-EDITOR properly
IDPB C,D
MOVEI C,377
IDPB C,D ;Sure to be at first charaacter now
JRST QREADX
QREADY: PUSHJ P,NUMSTR
MOVEI C,0
IDPB C,A ;Temporary termination for number
;Now add CONTROL bits to this number
ILDB C,D
JUMPE C,.+4 ;Test for end of number
ADDI C,200 ;Add CONTROL bit
DPB C,D
JRST .-4
MOVEI C,304 ; Delete symbol replaces the temporary termination
DPB C,D
QREADX: MOVEI C,311 ;Readying the INSERT symbol
IDPB C,D
MOVEI C,0
IDPB C,D ;Now add final termination
IDPB C,D ;And an extra one for good measure
;Now read in the substitution string
QREAD0: MOVE D,[POINT 7,BUF] ;Go back to 7-bit for this
MOVNI B,SRSIZ*5-1 ;To count substitution characters
TLZ F,TF1
PUSHJ P,TYI
JRST QREAD4 ;Find out the cause of activation
QREAD1: CAIN C,14
JRST QNOFF ;Abort substitution 'cause can't insert a formfeed
IDPB C,D
QREAD2: PUSHJ P,TYI
JRST QRACT ;Now act on substitution string
AOJN B,QREAD1
SORRY Substitution string is too long.
JRST QNOFF2
QNOFF: SORRY Cannot substitute a Formfeed into the text.
QNOFF2: PUSHJ P,TYI ;Read rest of substitute string up to activator
JRST POPUP1 ;Skip return up a level
JRST QNOFF2
;We get here if trying a substitution while in attach mode
QRDATT: SUB P,[1,,1] ;Flush return from SREAD
MOVEI A,ILLAT1 ;Address of msg: IN ATTACH MODE
JRST ILLMS2 ;Type out error message
;Entered from QREAD if first character is an activator.
QREAD4: CAIN C,212 ;α<LF> means load line editor with old string
JRST LODSUB ;load line editor and loop back to read again
ANDI C,377 ;Clear β bit
CAIN C,ALTMOD
JRST POPTJ ;Still not too late to abort voluntarily.
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIN C,334 ;The ⊗\ may have stuttered or he may mean it
JRST QRED4A
CAIE C,15
CAIN C,215 ;May want LINE-EDIT case
SOJA B,QRACT
LDB TT,[POINT 7,C,35]
CAIL TT,"0"
CAILE TT,"9"
CAIN TT,"∞"
SOJA B,QRACT ;A false count has been made
QABORT: SORRY Illegal activation character -- Substitution ABORTED.
JRST POPUP1 ;Return up a level and skip return
;Here to load old substitution string into the line editor to allow user
;to edit it before we read it back.
LODSUB: HRRZ T,SUBSIZ(E) ;get length of subst string's text
IDIVI T,5 ;figure out where it ends in buffer
MOVEI D,SUBBUF(E) ;ptr to beginning of subst string text
ADDI D,(T) ;make ptr to word containing null after string
HLL D,BTAB4(TT) ;make byte pointer from remainder
MOVEI T,15 ;insert CR at end of string
DPB T,D ; to make PTLOAD work right
MOVEI T,0 ;do PTLOAD to self
MOVEI TT,SUBBUF(E) ;ptr to old subst string to load into line ed
SKIPE DPY ;forget line editor if not display
PTLOAD T ;load line editor with old subst string
DPB T,D ;replace temp CR after string with normal null
JRST QREAD0 ;read back edited search string
QRED4A: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Type Y to confirm your NULL substitution request? /]
PUSHJ P,YESCHK
SOJA B,QRACT ;Yes
CLRBFI
OUTSTR [ASCIZ /Type corrected substitution string or type <ALT> to abort.
/]
JRST QREAD0
;QRACT QRACT0 QRA0 QRACT1 QRA1 QRACT2 QRA2 QRACT3 QREADR
;We only get here if there is a substitution string.
QRACT: MOVEI A,0
TRZ F,ARG
QRACT0: LDB TT,[POINT 7,C,35]
CAIN TT,"∞"
JRST [MOVEI A,MAXARG↔JRST QRA0]
CAIL TT,"0"
CAILE TT,"9"
JRST QRACT1
IMULI A,=10
ADDI A,-"0"(TT)
QRA0: TRO F,ARG
PUSHJ P,TYI
JRST QRACT0
JRST QRACT0
QRACT1: LDB TT,[POINT 7,C,35]
CAIN TT,ALTMOD ;Still not too late to abort voluntarily.
JRST POPTJ
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIE TT,"\"
CAIN TT,15
JRST QRA1
JRST QABORT ;Illegal activation character--abort.
QRA1: CAIN C,600!"\"
MOVEI C,15 ;αβ\ at end of substitute string means CR.
TRZN F,ARG
JRST QRACT2
CAILE A,MAXARG ;Maximum repeat arg
MOVEI A,MAXARG ;Limit before requesting confirmation
MOVNS A
HRLZS A
CAIN C,15
JRST QRACT3
OUTSTR [ASCIZ/ ARGUMENT IGNORED! You can abort substitution with <ALT> /]
JRST QRA2 ;Force αCR (for αCR, αβCR, βCR, α\, β\)
QRACT2: MOVE A,SUBONE ;The correct value for QCHR if not ∞ or <CONT><CR>
CAIN C,200!"\" ;Accept α\ for αCR
QRA2: MOVEI C,215
CAIN C,215 ;Is command a <CONTROL><CR> ?
MOVEI A,1 ;This forces a LINE-EDIT type substitution
QRACT3: MOVEM E,SAVEE# ;It is now time to reset SAVEE
MOVEM A,QCHR ;Store aobjn value for repeated substitution
MOVEM A,SUBFLG(E) ;Enable substitution
TRZ F,ARG!REL ;Not wanted if a substitution
MOVEI TT,
IDPB TT,D ;Terminate the string
TLNE D,760000 ;Pad out with nulls
JRST .-2
MOVSI TT,BUF
HRRI TT,SUBBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D) ;Store string away in SUBBUF(E)
ADDI B,SRSIZ*5-1+1 ;To get insertion count
HRRM B,SUBSIZ(E) ;Must not bother deletion count in left half
MOVE TT,SAVEFX
MOVEM TT,SUBTYP(E) ;Validate type of search
JRST SREAD6
;This code is entered from SREAD4 when a \, ∞, or a # (with activation bits) is the
;first character showing that no new string is to be typed. This is NOT ACCEPTABLE.
QREADR: SORRY Not an acceptable command without a searched-for string.
JRST POPTJ
;⊗ SRCLUZ SRACT SREAD5 SREAD6 SDSCHK SDSCH2 SRALT SRALT2 SRALUZ FFINDE FFINDC FXFIND FFIND FFIND2 ASTER BLAS5 ASTERX ASTSAY
SRCLUZ: SUB P,[2,,2] ;Don't return to search command routine
JRST POPJ2T ;Go execute error routine immediately
SRACT: TLNE F,TF1
JRST SRALT ;quoting whole string, no ending LF seen yet
JSP Q,SRSTOR
SREAD5: LDB TT,[POINT 7,C,35]
CAIE TT,12 ;Linefeed or backslash ending search string
CAIN TT,"\" ; means substitute string is coming next
JRST QREAD
SETZM QCHR ;Safety measure to inhibit substitution
SREAD6: TRZ F,ARG!REL!NEG
MOVEI DSP,CMDSP
MOVEI A,
PUSH P,E
PUSHJ P,CMDEXS ;Get dispatch word for activator into D
JRST SRCLUZ ;Illegal command
POP P,E
JSP TT,SDSCHK ;Check search dispatch for special action
MOVEM T,SRFLG2(E) ;Save flags separately for repeating
POPJ P,
;Common routine for search/substitute cmds. Check dispatch for special action.
SDSCHK: MOVE T,SRFLG
MOVEM D,SDSP#
MOVEM A,SARG#
HRLI C,(B)
MOVEM C,SCHR#
TLNE D,SACMD
JRST SDSCH2
TLNE D,SSCMD
XCT -1(D) ;May pushj, jump (DIRSRC,LBLSRC), or diddle bit
SDSCH2: MOVEM T,SRFLG ;This seems to get clobbered during search
XCT (TT) ;May store flags or do nothing
TRNN T,EDITM
JRST 1(TT) ;Return
MOVE A,ARRLIN
HRRZ T,TXTSER(A)
MOVEM T,SRCNUM
MOVE T,EDCNM
HRRZM T,SRCOFF ;Make search start from col where command was given
JRST 1(TT) ;Return
SRALT: CAIN C,15
JRST SREAD3
CAIN C,ALTMOD
JRST POPTJ
CAIE C,12
JRST SRALUZ
JSP Q,SRSTOR
SRALT2: PUSHJ P,TYI
JRST SREAD5
JRST SRALT2
SRALUZ: MOVEM C,COMCHR
JRST POPTJ
FFINDE: SETZM TYIPNT ;flush any leftover text of extended cmd
SORRY <⊗XFFind & ⊗XFXFind do NOT take search strings -- they search after
exchanging old local & extended search strings.>
JRST POPJ1 ;don't say OK
FFINDC: SORRY <End ⊗XFFind & ⊗XFXFind with bare CR -- ⊗X bucky bits are like on ⊗*.>
JRST POPJ1 ;don't say OK
;Command routines to exchange local and extended search strings
;and then to do an extended or local search (unless arg is zero).
FXFIND: SKIPA E,[FNDTBF] ;set up local search to be repeated by ⊗*
FFIND: MOVEI E,FNDBUF ;set up extended search to be repeated by ⊗*
PUSHJ P,XTDLMT ;skip over the extended cmd name's delimiter
PUSHJ P,XTDBEG ;Get first char of extended command arg
JRST FFINDE ;found some text after cmd, error
CAIE C,15 ;activator must be plain CR
JRST FFINDC ;error
MOVEM E,SAVEF ;set up repeat search
SKIPN E,SAVEE ;skip if substitution string available
JRST FFIND2 ;no substituting
XORI E,FNDBUF≠FNDTBF ;substitution changes range with search string
CAIE E,FNDBUF ;result better be one of these
CAIN E,FNDTBF
MOVEM E,SAVEE ;store new substitution range
FFIND2: MOVE T,[FNDBUF,,FFBUF] ;copy one search buffer to temp space
BLT T,FFBUF+SUBBUF+SRSIZ-1
MOVE T,[FNDTBF,,FNDBUF] ;copy second search buffer to first
BLT T,FNDBUF+SUBBUF+SRSIZ-1
MOVE T,[FFBUF,,FNDTBF] ;copy temp buffer back to second search buffer
BLT T,FNDTBF+SUBBUF+SRSIZ-1 ;FALL INTO ASTER
;Repeats the last FIND command (whether single or multipaged)
;If <CONTROL>* one is left in the line editor.
;IF <META><CONTROL>* one is left at (but not in) the found line.
;A new argument may be specified.
ASTER: SKIPN E,SAVEF ;To see what was the last command
JRST ASTERX ;Woops, not properly primed.
JUMPLE A,ASTSAY ;Zero arg just tells what search string is
SETZM ESCIEN ;No ESCAPE I typed yet.
SETZM ESCI2 ;Haven't been interrupted.
SKIPE DPY ;Don't cause spurious retyping of line on non-display.
TRO F,DSPSCR ;Force display of header line to erase search page number
MOVEM A,SRCNT ;Set count of number to find
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
TRNN F,ATTMOD ;Interpret as <META><CONTROL> always if in ATTACH
CAIE B,1 ;Make dispatch be either αCR
MOVEI B,0 ; or plain CR
BLAS5: MOVEI C,15
TRZ F,ARG!REL!NEG
MOVE D,CRDSP(B) ;Get CR or αCR dispatch address
MOVEI A,1 ;Use arg of 1 w/dispatch
JSP TT,SDSCHK ;Check dispatch for special action
JFCL
MOVEI A,1 ;Arg for dispatch cmd
MOVE D,SDSP
CAIN E,FNDTBF
JRST FNDBS0 ;Single page search
CAIN E,FNDBUF
JRST FINBS0 ;Multi-page search
PUSHJ P,TELLZ
ASTERX: SORRY Repeat-find command not properly primed.
SETZM SAVEF ;Guard against another try
JRST POPJ1
ASTSAY: PUSHJ P,ABCRLF
MOVEI TT,0
CAIN E,FNDTBF
MOVEI TT,[ASCIZ/Local search finds /]
CAIN E,FNDBUF
MOVEI TT,[ASCIZ/Extended search finds /]
JUMPE TT,ASTERX
SKIPN SRCBUF(E)
JRST ASTERX ;No search string there
OUTSTR (TT)
MOVE T,SUBTYP(E)
MOVEM T,SAVEFX
PUSHJ P,DELIM
OUTSTR SRCBUF(E)
PUSHJ P,DELIM
PUSHJ P,CASEM
JRST POPJ1
;BSLAS BLAS2 BLAS3 BLAS1 BSLXCT BSLXC3
;This code responds to the \ command.
;<CONTROL>\ accepts the last substitution (if still unconfirmed) and goes
;on to show the next one using the slow LINE-EDIT mode which permits one to
;cancel the substitution by an ALT.
;<META><CONTROL>\ accepts the last unconfirmed substitution and makes
;a fast substitution. This command will accept an argument and then make the
;requested number of substitutions if there are that many available.
;It should be noted that only the last substitution (F or XF) is remembered.
;One can interpose an ordinary FIND command of the opposite type without
;obliterating the record of the remembered substitution (with entry via SAVEE).
BSLAS: SKIPN E,SAVEE
JRST BLAS1 ;No substitution to repeat
SKIPE SUBTYP(E) ;Are we still primed for a repeat?
SKIPN SUBFLG(E)
JRST BLAS1 ;Alas, no
JUMPLE A,BSLSAY ;Zero arg means just report search/subst strings
SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
SKIPE DPY ;Don't cause spurious retyping of line on non-display.
TRO F,DSPSCR ;Update screen after search to erase page number
MOVEI TT,1 ;Tell search routine to find first occurrence
MOVEM TT,SRCNT ; of the search string
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
CAIG A,1 ;Can't use line editor substitution for more than 1
CAIE B,1 ;Make dispatch be either αCR (line editor subst)
TDZA B,B ; or plain CR (non line editor)
JRST BLAS3 ;One line editor substitution please (A contains 1)
CAIG A,1
JRST BLAS2 ;One non line editor substitution
CAILE A,MAXARG
MOVEI A,MAXARG ;Can't do more than this many of anything
MOVNI A,(A) ;Make aobjn value
MOVSI A,(A)
CAIA
BLAS2: MOVE A,SUBONE ;Aobjn value for 1 depends on type of PDP-10
BLAS3: MOVEM A,QCHR ;Store aobjn value for repeated substitution
MOVEM A,SUBFLG(E) ;Enable substitution
JRST BLAS5 ;Jump into the repeat-search code
BLAS1: SORRY Repeat-substitute command is not properly primed.
SETZM QCHR
JRST POPJ1
;This is the code that actually does the substitution in EDGL if QCHR
;is positive. It must also be armed by having a positive value in SUBFLG(E).
BSLXCT: MOVE E,SAVEE
SKIPG SUBFLG(E) ;This must be ≥0 for a legal substitution
PUSHJ P,TELLZ
MOVEI TT,SUBDEL(E)
TLOA TT,441100 ;MAKE A BYTE pointer
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI TT,SUBBUF(E)
TLOA TT,440700 ;MAKE A BYTE pointer
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI C,304 ;CTRL D
IDPB C,D
MOVEI C,377 ;CTRL BS
IDPB C,D
PUSHJ P,SUBCNT ;Count a substitution for RDV
PUSHJ P,SUBSAY ;To type message and return
JFCL ;SUBSAY skip returns now
SETZM QCHR ;We do not want to go around again
POPJ P,
;FINDIT FNDBS0 FNDBSL FOUND FND2 FND2A SETJMP FNDMOV FINSET FINSE2 SUBCNT
;FINDIT is called by the F command (single page search)
FINDIT: SETZM ESCIEN ;Hasn't type ESC I yet (for substitutions)
MOVEI E,FNDTBF
JUMPE A,ASTSAY ;Zero arg just types out string
MOVEM E,SAVEF# ;Save for a possible * repeat
PUSHJ P,SREAD ;Read search string from TTY
FNDBS0: PUSHJ P,FINSET ;Remember number of occurrences searching for
FNDBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
SETZM DIRNOW ;Not doing a directory search
PUSHJ P,SCOMP
PUSHJ P,SRCPAG
JRST FNDERR ;Not found
FOUND: PUSHJ P,SPFIN
PUSHJ P,SFLUSH
FND2: MOVE D,SDSP
FND2A: HLRZ B,SCHR ;Come here from MSG6 with D set up
HRRZ C,SCHR
MOVE A,SARG
TRNE F,ARG
TRNE F,REL
TLNN D,SACMD
JRST FNDMOV
SETZM OLDFAS ;Make sure we remember old place next time
TRON F,ARG!REL
MOVEI A,
TLNE D,SSCMD
XCT -1(D)
SUB A,ARRL
ADD A,SRCL
SKIPN QCHR
JRST POPJ2T ;Normal FIND exit, go execute terminating cmd
;Here we have a substitution to do.
TLZ F,OKF ;Override FW's kludge to say OK for plain CR on find
MOVE B,ARRL
ADD A,ARRL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
JRST SUBSTR
SETJMP: PUSH P,A
PUSH P,B
PUSHJ P,SETARR ;Set arrow to specified line.
AOSN FNDUP ;Skip unless want arrow near top of window
SKIPA B,BOTWIN ;Allow BOTWIN to be negative, if window not set
HRRZ B,BOTWIN ;If BOTWIN is -1, pretend it is infinity.
CAML A,TOPWIN
CAML A,B ;BOTWIN marks star or dash line (but might be -1).
CAIA
JRST POPBAJ
SUBI A,1 ;In case FNDUP set, want arrow one line from top
MOVEI B,JMPJMP ;Routine to center line in window
SKIPN FNDUP# ;Skip unless specifically want found line
MOVEI B,SETWIN ; positioned at top, in which case do it
PUSHJ P,(B) ;Center line in window, or position w/arr at top
JRST POPBAJ
FNDMOV: JUMPGE D,.+2
TRNN F,REL
SKIPA A,SRCL
ADD A,SRCL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
MOVE A,SARG
SKIPG T,SRCOFF ;Skip if found string not at left margin
JRST POPJ2T ;(Negative if from MSG routine)
MOVEI TT,(D) ;Get dispatch address
CAIN TT,EDIT ;Skip unless going into line editor
MOVEM T,EDMOV ;Make AGAIN position us out into line editor
JRST POPJ2T ;Now execute command given in D
FINSET: MOVE TT,SRCNT ;Get search count
FINSE2: MOVEM TT,SRCN2# ;Remember how many searched for, for "NFIND."
MOVEM TT,SRCN1# ;All of them are unfound so far
SETZM NSUBST# ;No substitutions done yet.
SKIPN QCHR ;Skip if doing substitute
POPJ P,
SKIPL TT,QCHR ;Get aobjn count of substitutions to do
MOVSI TT,-1 ;Only doing one line editor type
HLROM TT,SRCN3# ;Remember negative count of substitutions
POPJ P,
SUBCNT: AOS NSUBST ;Count a substitution for readonly variable
SKIPGE TT,SRCN3 ;Is this first substitution?
MOVMM TT,SRCN2 ;Yes, remember how many asked for
SETZM SRCN3 ;Next one isn't first one
POPJ P,
;FNDERR FNDER2 FNDWHT FNDER3 FNDER5 FNDER6 FNDER4 DELIM CASEM SUBERR SBONLY SUBSTP BSLSAY SUBSP2 SUBSP4 SUBSP3
FNDERR: SKIPE ESCI2 ;Have we been interrupted by ESC I?
JRST FNDER3 ;Yes
SKIPE QCHR ;Were we trying to do a substitution
JRST SUBERR ;Yes
MOVE T,SRCNT
CAME T,SRCN1
JRST FNDER4
MOVEI T,[ASCIZ /Not found --/]
FNDER2: SORRXU (T)
JRST FNDER6 ;Suppressing error messages
JRST FNDER5
;Say what we were searching for.
FNDWHT: PUSHJ P,DELIM
MOVE B,SDATA
ADDI B,SRCBUF
OUTSTR (B)
PUSHJ P,DELIM
JRST CASEM ;Case message
;Here if search stopped by ESC/BRK I. First part of ESC/BRK msg is already out.
FNDER3: PUSHJ P,MACSTP ;Replace ESC I macro stoppage w/normal stop routine
OUTSTR [ASCIZ / while searching for /]
FNDER5: PUSHJ P,FNDWHT ;Type out what we searched for
FNDER7: OUTSTR [ASCIZ/
/]
FNDER6: SETZM ESCI2
PUSHJ P,SFLUSH
SETZM COMCHR
JRST POPJ1
FNDER4: SORRX Found only
JRST FNDER6 ;Suppressing error messages
SUB T,SRCN1
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ / instead of /]
MOVE T,SRCNT
TYPDEC T
OUTSTR [ASCIZ / examples of /]
JRST FNDER5
DELIM: HLRZ C,SAVEFX
CAIE C,CTMT3 ;double bucky means was delimited
OUTSTR [ASCIZ/\/]
CAIN C,CTMT3
OUTSTR [ASCIZ/|/]
POPJ P,
CASEM: SKIPLE EXACTS
OUTSTR [ASCIZ/ (EXACT case)/]
SKIPG EXACTS
OUTSTR [ASCIZ/ (ignoring case)/]
POPJ P,
;This message appears at end of a repeating substitution execution.
SUBERR: MOVE B,SDATA
ADDI B,SRCBUF
PUSHJ P,SFLUSH
SETZM QCHR
SORRJ
PUSH P,BLAB ;I don't like doing it this way either, but
SETOM BLAB ; this is the only way to shut us up
PUSHJ P,SUBSTP
PUSHJ P,SBONLY ;SUBSTP skips unless didn't find enough
JFCL ;SBONLY skips in verbose mode
POP P,BLAB ;Restore proper state
JRST POPJ1
SBONLY: OUTSTR [ASCIZ/Could only do /]
SKIPLE -1(P) ;Look at saved copy of BLAB
JRST SUBSP4 ;Verbose mode, tell him the strings
TYPDEC TT
OUTSTR [ASCIZ/ substitutions.
/]
POPJ P,
SUBSTP: SETZM QCHR
SETZM TYOPNT
MOVE E,SAVEE
MOVE T,SUBFLG(E)
HRRZ TT,T
CAIE T,1
CAMN T,SUBONE
SKIPA
JUMPG TT,SUBSP2
OUTSTR [ASCIZ/Could not replace /]
JRST SUBSP3
BSLSAY: MOVEI TT,0
CAIN E,FNDBUF
MOVEI TT,[ASCIZ/Extended substitution replaces /]
CAIN E,FNDTBF
MOVEI TT,[ASCIZ/Local substitution replaces /]
JUMPE TT,BLAS1
PUSHJ P,ABCRLF ;Put out crlf if needed
OUTSTR (TT)
MOVEI B,SRCBUF(E) ;Pointer to text
MOVE T,SUBTYP(E) ;Get bits from original command
MOVEM T,SAVEFX ;Make sure DELIM uses right data
JRST SUBSP3
SUBSP2: SKIPG BLAB ;Only explain in verbose mode
POPJ P,
PUSHJ P,ABCRL0 ;Put out CRLF if needed
OUTSTR [ASCIZ /After /]
SUBSP4: TYPDEC TT
OUTSTR [ASCIZ / replacements of /]
SUBSP3: PUSHJ P,DELIM
OUTSTR (B)
PUSHJ P,DELIM
PUSHJ P,CASEM
OUTSTR [ASCIZ / with \/]
ADDI B,SUBDIF ;To get to SUBBUF
OUTSTR (B)
OUTSTR [ASCIZ /\. /]
JRST POPJ1
;FIND FINBS0 FINBSL FINBS2 FINBS3
;This is the routine for the extended search command ⊗XFIND.
FIND: MOVEI E,FNDBUF
JUMPE A,ASTSAY ;Zero arg just types out string
SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
PUSHJ P,XTDLMT ;skip over the extended cmd name's delimiter
PUSHJ P,XTDLIN ;Set up to reread rest of the command line
MOVEM E,SAVEF ;Save for a possible * repeat
PUSHJ P,SREAD ;Read search string.
SETZM TYIPNT ;Make sure no left-over input
SKIPE DPY ;Don't cause spurious retyping of line on non-display.
TRO F,DSPSCR ;Force redisplay of header text (for DD).
FINBS0: PUSHJ P,FINSET ;Remember number of occurrences to search for
FINBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
SETZM DIRNOW ;Not doing a directory search
PUSHJ P,SCOMP
TRNE F,SBKWDS
SKIPA T,[SCONTB]
MOVEI T,SCONTF
PUSHJ P,SRCPG1
JRST FNDERR ;Not found
TRZN G,OFFPAG
JRST FOUND ;Found on current incore page
EXCH G
MOVEI D,-SBKDSP(G)
IDIVI D,3
HLLZ D,BTAB3(D)
HRRI D,@SBKNWA
MOVEM D,SCLOB# ;Save byte pointer to first char in found string
MOVE D,IBLK
MOVE T,SDIRPT
SUBI D,@DIRREC(T)
MOVEM D,TSTBLK
PUSHJ P,SFLUSH
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST FINBS2 ;can't write it or don't need to, WRPAGE will succeed
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST FINBS3 ;can't open file (typed error msg), don't write out
FINBS2: PUSHJ P,WRPAGE
PUSHJ P,FLSPG0 ;Remember where coming from, flush incore page(s).
MOVE A,SRCPG
PUSHJ P,FNDPAG
HRRZ T,DIRREC(T)
ADDM T,TSTBLK
MOVEI T,SSET ;Make RLD call SSET when reading in the
MOVEM T,TSTSET ; disk block in which the found string starts.
PUSHJ P,NEWPG1
SKIPA B,[400] ;NEWPG1 skips on error
JSP SARRGH
PUSHJ P,FSGET
HRRM A,SCXCT
MOVEI T,-1(T)
MOVEM T,SFSLST
MOVEM F,SSAVF
EXCH F,SRFLG
MOVE D,[SRCPGB,,SRCPGF]
MOVEM D,SRCTYP
MOVEI T,SBKNL
HRRM T,SBKNW
MOVE A,SRCL
PUSHJ P,FNDLIN
MOVE A,SRCLIN ;Get byte pointer distance set up by SSET2
MOVEM T,SRCLIN ;Store FS address of line containing found string
ADDI A,(T) ;Make byte pointer to beginnning of found string
MOVEI E,
PUSHJ P,SCNBAK
PUSHJ P,SPFIN
EXCH F,SRFLG
HRRZ A,SCXCT
PUSHJ P,FSGIVE
SKIPE QCHR
JRST FND2 ;Doing substitution, don't inhibit it
SETOM OLDFAS ;Don't remember top line of new page
MOVE D,SDSP ;Get command dispatch
CAMN D,CRDSP
MOVEI D,CPOPJ ;For CR, ensure not remembering top line
JRST FND2A
;Here if can't open file to write out page after found string off current page.
FINBS3: SETZM COMCHR ;no command to execute now
OUTSTR [ASCIZ/(Had found string on page /]
SETZM TYOPNT
TYPDEC SRCPG ;type page number where found
OUTSTR [ASCIZ/.) /]
JRST POPJ1 ;already typed error message for page movement
;DIRSRC DIRSR2 DIRSR4 DIRFND DIRSR3 DFERR DFERR4 SRCDF SDFCR
;Here from SDSCHK because SSCMD bit is on for command that terminates the
;search string. Search the directory and go to indicated page.
DIRSRC: SETOM LBLFOO# ;Flag not from label search
DIRSR2: SUB P,[1,,1]
SETOM DIRNOW# ;Suppress short stops during directory searches
MOVE D,F
TRNE D,NEG
TRZ D,REL
ANDI D,REL ;Relative (positive) command searches from next page
MOVEM D,DIRREL#
SETZM TYIPNT
TRZ T,SBKWDS
MOVEM T,SRFLG
MOVEM T,SRFLG2(E) ;Remember search flags for repeated finds
MOVEI D,CPOPJ
MOVEM D,SDSP
PUSHJ P,FINSET ;Remember search count for RDV
PUSHJ P,SCOMP
MOVEI D,SRCDF
PUSHJ P,SRCSET
SKIPE T,DIRREL ;skip unless relative arg (e.g., ⊗F⊗+⊗P)
PUSHJ P,GPAGL ;get current line,,page into T
MOVEI A,1(T) ;start dir search from page 1, or from p. N+1
MOVEM A,SRCPG
PUSHJ P,FNDPAG ;load T with ptr to page to start search on
MOVE A,T ;page pointer
; HRRZ A,DIR
; SKIPE DIRREL
; HRRZ A,@DIRPT ;Relative command looks at dir starting at next page
CAIN A,DIREND
JRST DFERR ;No pages to search
MOVEM A,SRCLIN
ADD A,[440700,,LPDESC]
ILDB C,A
MOVEI D,3
PUSHJ P,SCALL
JRST DFERR
MOVE A,SRCPG ;Get back page we're going to
CAMG A,CURPAG ;Is desired page already in core?
CAMGE A,FIRPAG
JRST DIRSR4 ;No
SKIPL BLAB ;be quiet if terse mode
OUTSTR [ASCIZ/ (incore page)/]
SETOM OLDMOV ;Completely suppress diddling of line stack
SETOM INCORE ;Flag for LBLFND that page was already in core
DIRSR4: EXCH F,SRFLG
PUSHJ P,NEWPG5 ;Get to line 1 of proper page, maybe already in core
SKIPA B,SCHR ;got the right page in
JSP DIRRGH ;NEWPG5 skips on error (can't open file or int'l err)
SETZM OLDMOV ;Re-enable flushing each new arrow line from stack
SKIPL LBLFOO ;Doing label search?
JRST LBLSR2 ;Yes
TLNN B,2
JRST SFLSH2 ;All done -- only wanted to be at top of page
EXCH F,SRFLG
MOVEI TT,2 ;Wants to end up at second occurrence of string
MOVEM TT,SRCN1
PUSHJ P,FINSE2 ;Store search count (TT) for RDV
SETOM SRCOFF ;No search string found yet.
PUSHJ P,SRCPAG
JRST DIRSR3 ;Didn't find 2 occurrences
DIRFND: SETOM OLDFAS ;Don't remember top line of this page
JRST FOUND
DIRSR3: PUSHJ P,OLDFL0 ;Flush new arrow line from line stack
MOVEI T,[ASCIZ /Found only once on page indicated by directory --/]
SOSLE SRCN1
MOVEI T,[ASCIZ /Not found on page indicated by directory (HUH?) --/]
JRST FNDER2
DFERR: MOVE T,SRCNT
CAME T,SRCN1 ;Skip if didn't find any occurrences
JRST DFERR4 ;Didn't find enough
MOVEI T,[ASCIZ /Not in directory --/]
SKIPE DIRREL
MOVEI T,[ASCIZ /Not found hereafter in directory --/]
JRST FNDER2
DFERR4: MOVEI T,[ASCIZ/Directory has only/]
SKIPE DIRREL ;Skip unless only search last part of dir
MOVEI T,[ASCIZ/Dir. hereafter has only/]
SORRXU (T) ;Sorry
JRST FNDER6 ;Suppressing error messages
MOVE T,SRCNT ;How many we wanted
SUB T,SRCN1 ;Minus how many we didn't find
SETZM TYOPNT
TYPDEC T ;How many we did find.
OUTSTR [ASCIZ / instead of /]
MOVE T,SRCNT
TYPDEC T
OUTSTR [ASCIZ / examples of /]
PUSHJ P,FNDWHT ;Say what we searched for
JRST FNDER7
SRCDF: 15↔JSP SDFCR
0↔JSP SARRGH
177↔JSP SARRGH
SDFCR: HRRZ A,@SRCLIN
CAIN A,DIREND
JRST SRCHLX
MOVEM A,SRCLIN
AOS SRCPG
ADD A,[350700,,LPDESC]
LDB C,A
JRST @
;EXACT EXACT1 EXACT2 SSET SSET2 SCONTB
;Here to read and/or set flag that determines if searches distinguish letter case.
EXACT: SKIPGE BLAB ;Be quiet in terse mode,
JUMPN A,EXACT1 ; unless specific request for info
OUTSTR [ASCIZ/ Searches /]
JUMPE A,EXACT2
EXACT1: MOVEM A,EXACTS# ;Set flag that decides if searches distinguish case
SKIPGE BLAB ;Don't say anything in terse mode
POPJ P,
OUTSTR [ASCIZ/will now /]
EXACT2: SKIPLE EXACTS
OUTSTR [ASCIZ/match only Exact /]
SKIPG EXACTS
OUTSTR [ASCIZ/ignore /]
OUTSTR [ASCIZ/case of letters.
/]
JRST POPJ1
;Here from RLD just after reading in the disk block containing found string
SSET: SETZM TSTBLK ;Don't come back again
LDB C,SCLOB ;Get first char of search string from disk record
MOVEM C,SRCOFF ;Save it for restoring below
MOVEI C,177 ;And clobber it so RDPAGE will
DPB C,SCLOB ; trap when getting to that spot
MOVEI C,SSET2 ;Make RDPAGE trap to routine below at that point
MOVEM C,RLDA
POPJ P,
SSET2: MOVE C,LINES ;Number of lines before line found on
ADDI C,1 ;Number of line on which string is found
MOVEM C,SRCL ;Search string line number
MOVE C,E
IBP C
SUBI C,(A) ;Calculate byte pointer distance from beginning
MOVEM C,SRCLIN ; of line to first char of string and save it
MOVEI C,RLD ;Restore normal dispatch on 177's to see
MOVEM C,RLDA ; if another input record is needed
POP P,C ;Return address
HRLI C,SRCOFF ;Location containing real first char of found string
JRA C,-2(C) ;Restore real char to C, return to instr after ILDB
;Here to continue extended backward search off the top of the incore text.
SCONTB: JSP SBARF
;SCOMP SFLSH2 SFLUSH SFLSH1 SFLSL NOSRCH
;Called by FINDIT, FIND, and DIRSRC.
SCOMP: MOVEM P,SSAVP#
MOVEM F,SSAVF#
MOVEM E,SDATA#
MOVEI T,[0]
MOVEM T,SFSPNT# ;initialize list pointing to a zero
SETZM SFSLST#
HLLZS VBBITS
MOVE B,SRCSIZ(E) ;get length of search string
ADDI B,1 ;allow for extra word in FS at end, for link
MOVE T,SRFLG
TRNE T,SDELIM
ADDI B,2 ;delimited search requires two extra chars to check
LSH B,1 ;need two words per char, of search FS
EXCH F,SRFLG
IOR F,SRCFLG(E)
PUSHJ P,SFSGET ;get some search FS, lock it, and put in SFSLST
JSP TT,SFSPUT ;fill even words with ptrs to .+2, link into SFSPNT
SKIPLE EXACTS ;Skip unless want exact upper/lower case match
TDZA TT,TT
SKIPA TT,[377777777000] ;a bit for each letter
TDZA T,T
MOVSI T,LETF ;every letter has this bit on in CTAB
MOVEM T,SLMODE#
MOVEM TT,SLMOD2#
SKIPE A,SRCNT ;skip if not actually going to search
PUSHJ P,SPARSE
JUMPE A,NOSRCH
PUSHJ P,SGRAPH
PUSHJ P,SBACK
JRST SCGEN
SFLSH2: PUSHJ P,OLDFL0 ;Flush arrow line from line stack
JRST SFLSH1
SFLUSH: EXCH F,SRFLG
SFLSH1: SETZM SFSPNT
TLO F,NOCHK
SKIPA A,SFSLST
SFLSL: MOVEI A,(C)
HLRZ C,(A)
HRRZ T,(A)
SUBI A,-2(T)
PUSHJ P,FSGIVE
JUMPN C,SFLSL
TLZ F,NOCHK
MOVE T,[PUSHJ P,UUOH]
MOVEM T,41
POPJ P,
NOSRCH: OUTSTR [ASCIZ / Null search not executed.
/]
SETZM SRCN2 ;indicate (to macros) that nothing was searched for
SETZM SRCN1 ;nothing found either, clearly
JRST SBARF2
;SBARF SBARF1 SBARF2 DIRRGH SARRGH SFSGT SFSGET SFSPUT SFSPTL
SBARF: OUTSTR [ASCIZ /Search string too complex.
/]
SUBI 1
SBARF1: MOVEM SBADR#
SBARF2: MOVE F,SSAVF
MOVE P,SSAVP
SUB P,[1,,1]
SETZM OLDMOV ;Re-enable flushing each new arrow line from stack
SKIPN T,FSEND1
JRST .+3
MOVEM T,FSEND
PUSHJ P,ENDFIX
PUSHJ P,SFLSH1
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
DIRRGH: MOVE T,SSAVF ;peek at saved flags for
TRNN T,WRITE ;skip if NEWPG5 skipped because can't open file
SARRGH: OUTSTR [ASCIZ / Internal search lossage.
/]
SOJA SBARF1
SFSGT: FOR X IN(A,B,T,TT)<PUSH P,X↔>
MOVNI T,2
ADDM T,-4(P)
CAML P,[-10,,PDL-1+LPDL-10]
JSP SBARF
MOVEI B,SFSNUM*2
PUSHJ P,SFSGET
JSP TT,SFSPUT
FOR X IN(TT,T,B,A)<POP P,X↔>
POPJ P,
;Get some FS for search routines.
SFSGET: EXCH F,SRFLG
PUSHJ P,FSGET
EXCH F,SRFLG
HRLI T,LOKBIT
HLLM T,-1(A) ;lock FS with this bit in LH of FS hdr word
MOVEI T,-1(T) ;ptr to last word of FS block
EXCH T,SFSLST ;store new block as first in list, get old first blk
HRLM T,@SFSLST ;make LH of last wd of new FS blk point to prev list
POPJ P,
;Fill each even word of FS block with ptr to .+2, leaving ptr to first in SFSPNT.
SFSPUT: LSH B,-1
SKIPA T,A
SFSPTL: HRRZM T,-2(T)
ADDI T,2
SOJG B,SFSPTL
EXCH A,SFSPNT ;store new first FS block addr in this list
HRRZM A,-2(T) ;make last even word of new block point to old list
JRST (TT)
;SPARSE
SPARSE: MOVSI A,440700
HRRI A,SRCBUF(E) ;Make byte pointer to search string
MOVSI H,NSPEC!SSP1
SETZM SLEV#
TRNE F,SBKWDS
SKIPA T,[HRRM B,(G)] ;Backwards search
SKIPA T,[HLRM G,(B)] ;Forwards
SKIPA TT,[MOVS G,G] ;Backwards
MOVSI TT,(<JFCL>) ;Forwards
MOVEM T,SSLINK#
MOVEM TT,SSSWAP#
MOVEI DSP,SSCDSP
MOVEI Q,ENDOP
PUSHJ P,SPARS1 ;parse the search string
CAIN Q,ENDOP ;better have ended with an end
SKIPE SLEV ; and at level zero
PUSHJ P,TELLZ ;error
MOVEI A,(G)
TRNN F,SDELIM
POPJ P, ;not doing a delimited search
JUMPE A,CPOPJ
GETFS T
MOVE A,[1,,VBBITS]
HLLZM A,(T)
HRRZM A,1(T)
HLRZ TT,G
HRRM T,(TT)
GETFS T
HRRZM A,1(T)
HLRE TT,(G)
JUMPL TT,.+2
ADDI TT,200
ANDI TT,¬77
HRLI G,1(TT)
MOVEM G,(T)
MOVEI A,(T)
POPJ P,
;SPARS1 SPARS2 SPDSP SSCAN SSCANA SSCANX
SPARS1: HRLM Q,(P) ;save search op at this point
PUSHJ P,SSCAN
SPARS2: HLRZ D,(P)
CAIG Q,(D)
POPJ P,
PUSH P,G
PUSHJ P,SPARS1
POP P,T
HRLI T,(G)
GETFS G
HRLI G,(G)
MOVSM T,1(G)
HLRZ T,(T)
LSH T,-6
CAIE T,(E)
SETOB T,E
LSH T,6
XCT SPDSP-BINOP(D)
HRLZM T,(G)
JRST SPARS2
SPDSP: PUSHJ P,TELLZ
IORI T,OROP
PUSHJ P,TELLZ
IORI T,OROP
IORI T,ANDOP
SSCAN: SETZB E,G
PUSHJ P,SSCAN1 ;scan one char or one group inside horseshoes
CAIL Q,BINOP
POPJ P,
JUMPE G,.-3 ;look again if didn't find anything
MOVS B,G ;first,,last
SSCANA: ANDI T,¬77
ADDI E,(T)
PUSHJ P,SSCAN1 ;scan one char or one group inside horseshoes
CAIL Q,BINOP
JRST SSCANX
JUMPE G,.-3 ;look again if didn't find anything
XCT SSLINK ;Backwards: HRRM B,(G). Forwards: HLRM G,(B).
HRRI B,(G) ;update "last" of first,,last in B
JRST SSCANA
SSCANX: HLR G,B
XCT SSSWAP ;Backwards: MOVS G,G. Forwards: JFCL.
LSH E,-6
DPB E,[301400,,(G)] ;store length in "first"
JUMPGE T,CPOPJ
IORM T,(G)
POPJ P,
;SSCAN1 SSCN1A SSCN1B SSCQT SSCBIN SSCINF SSCNOT SSCUOP SSCVB
SSCAN1: ILDB C,A ;Get char from search string
TDNE H,CTAB(C)
XCT @CTAB(C)
SSCN1A: MOVEI Q,0 ;a normal char gets op code 0
SSCN1B: MOVEI T,100
GETFS G ;get next two-word piece of FS
HRLI G,(G)
HRLZM Q,(G) ;store op code in first word
MOVEM C,1(G) ;store search char in second word
POPJ P,
SSCQT: ILDB C,A
JUMPN C,SSCN1A
SSCBIN: LDB Q,[270400,,@CTAB(C)] ;get opcode out of dispatch table AC field
POPJ P,
SSCINF: MOVEI Q,INFOP+400000
MOVSI T,-100
ILDB C,A
CAIN C,"∞"
AOJA Q,SSCUOP
JRST 2,@[20000,,SSCUOP]
SSCNOT: MOVEI Q,NOTOP
SSCUOP: HRLM Q,(P)
PUSHJ P,SSCAN1
CAIL Q,BINOP
POPJ P,
ANDI T,¬77
TSO T,(G)
HRLM T,(G)
HLRE Q,(P)
JUMPGE Q,.+4
ANDI Q,77
JUMPE G,.+2
MOVEI T,-100
MOVEI TT,(G)
GETFS G
HRLI G,(G)
MOVEM TT,1(G)
ANDI T,¬77
IORI T,(Q)
HRLZM T,(G)
POPJ P,
SSCVB: MOVEI C,VBBITS
MOVEI Q,1
JRST SSCN1B
;SSCLP SSCDSP FABITS
;Here when spotted left horseshoe in search string.
;Go up a level in the scan; make right horseshoe, "∧" and "∨" specials now.
SSCLP: AOS SLEV
MOVSI H,NSPEC!SSP1!SSP2 ;add SSP2 chars as specials
MOVEI Q,CLOSOP
HRLM E,(P)
PUSH P,B
PUSHJ P,SPARS1
POP P,B
HLRE E,(P)
SOSG SLEV
MOVSI H,NSPEC!SSP1 ;back to bottom level, remove SSP2 specials
TESTBP A ;make sure byte ptr hasn't already been backed up
CAIE Q,CLOSOP
ADD A,[70000,,]
SKIPN Q,G
TDZA T,T
LDB Q,[220600,,(G)]
XCT SSSWAP
POPJ P,
SSCDSP: JUMPA ENDOP,SSCBIN ;0 null
PUSHJ P,TELL1 ;1 BS
JUMPA CROP,SSCBIN ;2 CR
PUSHJ P,TELL3 ;3 LF
PUSHJ P,TELL4 ;4 TAB
JRST SSCAN1 ;5 FF
REPEAT 12-6,<PUSHJ P,TELLZ> ;6:11
JUMPA ANDCHR,SSCBIN ;12 and-sign
JRST SSCNOT ;13 not-sign
JRST SSCLP ;14 left horseshoe
JUMPA CLOSOP,SSCBIN ;15 right horseshoe
MOVSI C,NOTBT ;16 for-all-sign
JRST SSCQT ;17 equivalence-sign
JUMPA ORCHR,SSCBIN ;20 or-sign
JRST SSCINF ;21 infinity-sign
JRST SSCVB ;22 vertical-bar
FACNT←←174
FABITS: FACNT,,
377537,,-20
-20
-20
-40
;SGRAPH SGRPH1 SGRPH2 SGRPHX SGDO1 SGDO1X SGDOX2 SGDSP SGDO1B
SGRAPH: SETZM SSVNUM#
SETZM SSVMAX#
PUSHJ P,SGDO1
JUMPE B,CPOPJ
HRLM B,(P)
SGRPH1: HLRZ C,B
PUSHJ P,SGDO1
JUMPE B,SGRPHX
SGRPH2: MOVSI T,SGEBIT
ANDCAM T,1(C)
HRRZ TT,(C)
HRRM B,(C)
HRLM C,(B)
JUMPE TT,SGRPH1
MOVEI C,(TT)
; PUSHJ P,SGDUP
JRST SGRPH2
SGRPHX: MOVSI B,(C)
HLR B,(P)
POPJ P,
SGDO1: SKIPN B,A
POPJ P,
HRRZ A,(A)
LDB T,[220600,,(B)]
XCT SGDSP(T)
SGDO1X: IORB T,1(B)
SGDOX2: LDB TT,[301400,,(B)]
SETZM (B)
HRLI B,(B)
TLNN T,NOTBT
POPJ P,
AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
DPB T,[221100,,1(B)]
POPJ P,
SGDSP: MOVSI T,SGEBIT ;0
JRST SGDO1B ;1
JRST SGNOT ;2 NOT
REPEAT 4,<JSP SBARF> ;3,4,5,6
SGDO1B: AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
MOVSI T,SGEBIT!1000(T)
JRST SGDO1X
;SGNOT
SGNOT: HRLM A,(P)
HRRZ A,1(B)
RETFS B
PUSHJ P,SGDO1
HLRZ A,(P)
JUMPE B,CPOPJ
CAIE TT,1
JSP SBARF
MOVSI T,NOTBT
XORB T,1(B)
TLNE T,NOTBT
JRST SGDOX2
HLRZ T,T
ANDI T,777
CAMN T,SSVMAX
SOS SSVMAX
SOS SSVNUM
MOVSI T,777
ANDCAM T,1(B)
JRST SGDOX2
;SBACK SBACK1 SBACK2 SBACK3 SBACK4
SBACK: HRRZM B,SGPNT#
HLRZ A,B
MOVEI C,SGEND#
MOVSI T,INDTST⊗9
HLLOM T,SBLST+1
SETZM SGECNT#
SBACK1: GETFS T
HRRZM T,(C)
AOS SGECNT
MOVEI C,(T)
MOVEI B,(A)
SKIPL 1(B)
JRST .+4
HLRZ B,(B)
HRRZ T,1(B)
JUMPN T,.-2
HRLI A,(B)
MOVEM A,(C)
SETZM 1(C)
HRL C,(A)
PUSH P,C
PUSHJ P,SBCALC
PUSHJ P,[TLZN B,NLDBIT↔HLRZ B,(B)↔HLRZ G,(C)↔POPJ P,]
PUSHJ P,TELLZ
SKIPGE 1(B)
HRRZ B,(B)
HLRZ A,(C)
HRRZM A,1(C)
HRRM B,(A)
IORM B,(A)
HRRZ C,(C)
SBACK2: PUSHJ P,SBCALC
MOVEI G,(C)
JRST SBACK4
HLRZ T,(C)
SKIPGE 1(C)
JRST SBBRCH
SBACK3: SKIPGE 1(B)
HRR B,(B)
HRLM B,(C)
ANDCMI B,-1
IORM B,1(C)
SKIPE C,T
JRST SBACK2
SBACK4: POP P,C
HLRZ A,C
JUMPN A,SBACK1
SETZM (C)
POPJ P,
;SBBRCH SBBR2
SBBRCH: SKIPN A,T
TROA A,SGPNT
SKIPL 1(A)
JRST SBBR2
SKIPA A,(A)
HLRZ A,(A)
HRRZ TT,(A)
CAIE TT,(C)
JRST .-3
SBBR2: HRRZ TT,(C)
HRRM TT,(A)
MOVEI A,(C)
HRRZ C,1(C)
RETFS A
JRST SBACK3
;SBCALC SBCAL0 SBCAL1 SBCAL2 SBCL2A SBCAL3
SBCALC: SETZM SBLST
SKIPGE T,1(C)
JRST SBCBP
TLC T,NOTBT
SBCAL0: MOVEM T,SBTST#
HLRZ B,(C)
MOVSI D,(C)
HRRI D,SBLST1
SETZM SBLST1#
JUMPE B,SBCNON
HLRZ A,(B)
MOVEI B,(C)
TLZ F,TF1
SBCAL1: JUMPE A,SBCAL3
HLRZ G,(C)
MOVEI H,(A)
SBCAL2: JSP E,SCCOM
JRST SBCLUZ
JRST SBCCB
JRST SBCCB
SKIPA T,1(H)
SBCL2A: MOVE T,1(H)
TLNE T,777
TLO F,TF1
HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCAL2
SBCAL3: MOVEI G,SBTST-1
HLRZ H,(B)
JSP E,SCCOM
JRST SBCLUZ
JRST SBCAL4
JRST SBCAL4
SKIPA T,1(H)
MOVE T,1(H)
TLNN T,777
JRST SBCX
;FALLS THRU TO SBCAL4
;SBCAL4 SBCNON SBCX SBCOPL SBCOP2 SBCEND SBCEN2 SBCFIX SBCFXL SBCFXE POPJ2T
;fell thru from previous page
SBCAL4: MOVEI B,(H)
TLOA B,NLDBIT
SBCNON: HRRZ B,SGPNT
SBCX: XCT @(P)
TLZN F,TF1
JRST SBCEND
HLRZ H,(B)
JUMPE H,SBCEND
TLNE B,NLDBIT
HLRZ G,(G)
SBCOPL: MOVE T,1(H)
TLNN T,777
JRST SBCOP2
TLZ T,¬777
TLO T,XFRSAV⊗9
IOR T,B
HRRI T,(G)
GETFS TT
HRRZM B,(TT)
MOVEM T,1(TT)
MOVEI B,(TT)
SBCOP2: HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCOPL
SBCEND: SKIPN SBLST1
JRST SBCOK
TLNE B,NLDBIT
JRST SBCEN1
HRRM B,(D)
SBCEN2: MOVE B,SBLST1
SKIPN T,SBLST
MOVEI T,SBLST
SBCFIX: HLLZ TT,B
SBCFXL: LDB G,[3700,,1(T)]
CAML G,[INDTST⊗9,,]
TRNN G,-1
JRST SBCFXE
HRLM B,(T)
IORM TT,1(T)
HRRZ T,(T)
JUMPN T,SBCFXL
SBCFXE: HRRM B,SBLST
HLRZ B,D
SKIPE SBLST1
JRST SBCNXT
HLRZ B,SBLST
POPJ2T: POP P,T
JRST 2(T)
;SBCOK SBCEN1 SBCLUZ SBCLZ1 SBCNXT SBCBP SBCBPL
SBCOK: SKIPN T,SBLST
JRST POPJ2T
JRST SBCFIX
SBCEN1: GETFS T
HRLZM B,(T)
MOVSI B,INDTST⊗9!NLDBIT
MOVEM B,1(T)
HRRM T,(D)
JRST SBCEN2
SBCLUZ: SKIPN T,SBLST1
JRST SBCNXT
SBCLZ1: HRRZ TT,(T)
RETFS T
SKIPE T,TT
JRST SBCLZ1
SBCNXT: HLRZ B,(B)
MOVSI D,(B)
HRRI D,SBLST1
SETZM SBLST1
JUMPE B,SBCNON
HLRZ A,(B)
JUMPE A,SBCNON
HLRZ A,(A)
JRST SBCAL1
SBCBP: MOVSI T,-1
ADDB T,1(C)
TLNE T,777
JRST POPJ1
MOVE A,[FABITS+1,,SBBUF]
BLT A,SBBUF+3
SKIPA G,(C)
SBCBPL: MOVEI G,(T)
PUSHJ P,MAKBIT
ANDCAM TT,SBBUF(T)
HLRZ T,(G)
CAIE T,(C)
JRST SBCBPL
HRRM G,1(C)
MOVSI T,SGBBIT
ANDCAM T,1(G)
MOVE T,[1000,,SBBUF-1]
JRST SBCAL0
;SBCCB SBCCB1 SBCCB2 SBCCB8 SBCCB3 SBCCB4 SBCCB5
SBCCB: EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
ANDM TT,BITBF1(T)
SKIPN T,SBLST
JRST SBCCB3
LDB E,[221100,,1(G)]
JUMPN E,.+2
JSP SARRGH
PUSH P,G
HLRZ T,T
SBCCB1: LDB TT,[330400,,1(T)]
CAIGE TT,INDTST
JRST SBCCB8
MOVEI G,(T)
SBCCB2: LDB T,[221100,,1(G)]
CAIE T,(E)
JRST .+3
PUSHJ P,MAKBIT
ANDCAM TT,BITBF1(T)
HRRZ T,(G)
JUMPN T,SBCCB1
SBCCB8: HLRZ G,(G)
JUMPN G,SBCCB2
POP P,G
SBCCB3: MOVEI E,BITBF1-1
PUSHJ P,BITCNT
JUMPE T,SBCLUZ
CAIN T,1
JRST SBCCB7
CAIN T,2
JRST SBCCB6
SBCCB4: MOVSI E,INDTST⊗9
HRRI E,(H)
SBCCB5: GETFS T
HRRM T,(D)
HRRI D,(T)
SETZM (D)
LDB T,[221100,,1(G)]
TLO E,(T)
MOVEM E,1(D)
JRST SBCL2A
;SBCCB6 SBCCB7 BITCNT BITCN1
SBCCB6: SKIPE TT,3(E)
CAME TT,4(E)
JRST SBCCB4
TDNN TT,SLMOD2
JRST SBCCB4
SBCCB7: PUSHJ P,NEWBTC
TLO E,REMTST⊗9
JRST SBCCB5
BITCNT: SKIPE T,1(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,2(E)
PUSHJ P,BITCN1
ADD T,(P)
IDIVI T,77
MOVEM TT,(P)
SKIPE T,3(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,4(E)
PUSHJ P,BITCN1
POP P,TT
ADD T,TT
IDIVI T,77
POP P,T
ADD T,TT
POPJ P,
BITCN1: MOVE TT,T
LSH TT,-1
AND TT,[333333333333]
SUB T,TT
LSH TT,-1
AND TT,[333333333333]
SUBB T,TT
LSH TT,-3
ADD T,TT
AND T,[70707070707]
POPJ P,
;NEWBIT NEWBT0 NEWBT1 NEWBT2 NEWBT3 NEWBT4 NEWBT5
NEWBIT: CAIG T,2
JRST NEWBTC
CAIL T,FACNT-2
JRST NEWBNC
NEWBT0: HRLI E,T
PUSH P,E
PUSH P,T
HRRI E,VBBITS
NEWBT1: HLRZ TT,(E)
CAME TT,(P)
JRST NEWBT2
MOVE T,[-4,,1]
MOVE TT,@E
CAMN TT,@-1(P)
AOBJN T,.-2
JUMPGE T,NEWBT4
HLRZ TT,(E)
NEWBT2: ADD TT,(P)
CAIE TT,FACNT
JRST NEWBT3
MOVE T,[-4,,1]
MOVE TT,FABITS(T)
ANDCM TT,@E
CAMN TT,@-1(P)
AOBJN T,.-3
JUMPGE T,[HRLI E,NOTBT!1000↔JRST NEWBT5]
NEWBT3: HRR E,(E)
TRNE E,-1
JRST NEWBT1
PUSH P,A
PUSH P,B
MOVEI B,6
PUSHJ P,SFSGET
MOVEI E,(A)
HRRZ A,VBBITS
HRRM E,VBBITS
HRRZM A,(E)
POP P,B
POP P,A
MOVE T,(P)
HRLM T,(E)
MOVEI T,1
MOVSI T,@-1(P)
HRRI T,1(E)
BLT T,4(E)
SETZM 5(E)
NEWBT4: HRLI E,1000
NEWBT5: SUB P,[2,,2]
POPJ P,
;NEWBTC NEWBC1 NEWBC2 NEWBC3 NEWBNC NEWBN1 NEWBN2 NEWBN3 NEWBCZ NEWBNZ
NEWBTC: JUMPE T,NEWBCZ
CAIE T,2
JRST NEWBC1
SKIPE TT,3(E)
CAME TT,4(E)
JRST NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
NEWBC1: HRLI E,-4
SKIPE T,1(E)
JFFO T,NEWBC2
AOBJN E,.-2
JSP SARRGH
NEWBC2: HLRZ E,E
NEWBC3: HRRI E,4(E)
LSH E,5
ADDI E,(TT)
POPJ P,
NEWBNC: CAIL T,FACNT
JRST NEWBNZ
CAIE T,FACNT-2
JRST NEWBN1
MOVE TT,FABITS+3
ANDCM TT,3(E)
JUMPE TT,NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
XOR TT,4(E)
CAME TT,FABITS+4
JRST NEWBT0
NEWBN1: HRLI E,E
PUSH P,E
MOVE E,[-4,,1]
NEWBN2: MOVE T,FABITS(E)
ANDCM T,@(P)
JFFO T,NEWBN3
AOBJN E,NEWBN2
JSP SARRGH
NEWBN3: SUB P,[1,,1]
HRRI E,NOTBT⊗-5
MOVS E,E
JRST NEWBC3
NEWBCZ: TDZA E,E
NEWBNZ: MOVSI E,NOTBT
POPJ P,
;SCCOM SCCNOT
SCCOM: HLLZ T,1(G)
HLR T,1(H)
TDNE T,[405000,,405000]
JRST SCCBIT
MOVE T,1(G)
XOR T,1(H)
TDNN T,[NOTBT,,-1]
JRST 4(E)
MOVE TT,1(G)
HLR TT,CTAB(TT)
TLNE T,NOTBT
JRST SCCNOT
TSNN TT,SLMODE
JRST .+3
TRNN T,¬40
JRST 4(E)
TLNN TT,NOTBT
JRST (E)
HRRZ TT,1(G)
JUMPE TT,2(E)
HRRZ TT,1(H)
JUMPE TT,3(E)
JRST 1(E)
SCCNOT: TSNE TT,SLMODE
TRNE T,¬40
TRNN T,-1
JRST (E)
TLNE TT,NOTBT
JRST 2(E)
JRST 3(E)
;SCCBIT
SCCBIT: PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF2(T)
EXCH G,H
MOVSI T,-4
MOVE TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPGE T,(E)
MOVSI T,-4
SETCM TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPL T,.+2
ADDI E,1
MOVSI T,-4
SETCM TT,BITBF2(T)
TDNN TT,BITBF1(T)
AOBJN T,.-2
JUMPGE T,3(E)
JRST 1(E)
;MAKBIT MAKBT0 MAKBT1 MAKBTX MAKBTN MAKBN2 MAKBTB MAKBB3 BITTAB
MAKBIT: SKIPGE 1(G)
JRST MAKBBT
MAKBT0: LDB T,[330300,,1(G)]
XCT MBDSP(T)
SKIPG @(P)
JRST MAKBT1
MOVSI T,-4
XCT @(P)
AOBJN T,.-1
MAKBT1: HRRZ T,1(G)
LDB TT,[360100,,CTAB(T)]
ROTC T,-5
ROT TT,5
MOVE TT,BITTAB(TT)
MAKBTX: TDNN T,SLMODE
POPJ P,
XCT @(P)
XORI T,1
POPJ P,
MAKBTN: SKIPG @(P)
JRST MAKBN2
MOVSI T,-4
MOVE TT,FABITS+1(T)
XCT @(P)
AOBJN T,.-2
MAKBN2: HRRZ T,1(G)
MOVEI TT,
ROTC T,-5
ROT TT,5
SETCM TT,BITTAB(TT)
AND TT,FABITS+1(T)
JRST MAKBTX
MAKBTB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MAKBB3: MOVSI T,-4
MOVE TT,@G
XCT @-1(P)
AOBJN T,.-2
POP P,G
JRST POPJ1
BITTAB: FOR I←43,0,-1<1⊗I↔>
;MAKBNB MAKBBT MAKBB2 MBDSP MBIND MBIND2
MAKBNB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MOVSI T,-4
SETCM TT,@G
AND TT,FABITS+1(T)
XCT @-1(P)
AOBJN T,.-3
POP P,G
JRST POPJ1
MAKBBT: FOR I←0,3<SETZM MBBUF+I↔>
PUSH P,H
MOVE H,G
HRRZ G,(G)
MAKBB2: PUSHJ P,MAKBT0
IORM TT,MBBUF(T)
HLRZ G,(G)
CAIE G,(H)
JRST MAKBB2
EXCH H,(P)
MOVE G,[,MBBUF(T)]
JRST MAKBB3
MBDSP: MOVEI TT,
JRST MAKBTB
JRST MAKBTN
JRST MAKBNB
JRST POPJ1
JRST MBIND
JSP SBARF
JSP SBARF
MBIND: PUSH P,G
HRRZ G,1(G)
MOVSI T,(<XCT @>)
HRRI T,-1(P)
PUSH P,T
HRRI T,(P)
PUSH P,[JRST MBIND2]
PUSH P,T
JRST MAKBT0
MBIND2: SUB P,[2,,2]
POP P,G
JRST POPJ1
;SCGEN
SCGEN: HRRZ C,VBBITS
JUMPE C,.+2
PUSHJ P,SBTMAK
SKIPE B,SSVMAX
PUSHJ P,SFSGET
SUBI A,1
HRRM A,SSVINS
MOVEI B,440
PUSHJ P,SFSGET
HRLI A,(<XCT (C)>)
MOVEM A,SCXCT#
MOVE T,SRCNT
MOVEM T,SRCN1#
PUSHJ P,ENDSET
MOVEI T,1(A)
MOVEM T,SCODPT#
MOVSI T,(<JSP D,>)
HLLM T,SBKINS
MOVE B,SGPNT
TRNN F,SDELIM
TDZA E,E
MOVNI E,1
PUSHJ P,SCGEN1
MOVSI T,LOKBIT
MOVEI A,2(A)
FSFIX A,T
SUBI A,1
EXCH A,SFSLST
HRLM A,@SFSLST
JRST ENDFIX
;SCGEN1 SCGEN2 SCGEN3 SCGEN4 SCGEN5
SCGEN1: MOVEI C,
SCGEN2: SKIPGE 1(B)
JSP SARRGH
HLRZ D,(B)
MOVEI T,1(A)
HRLM T,(B)
LEG PUSH A,D
TRNN F,SBKWDS
JRST SCGEN3
LEG PUSH A,[LSHC B,-7]
LEG PUSH A,[ROT C,7]
SCGEN3: LDB G,[330400,,1(B)]
CAIL G,4
JSP SARRGH
HRRZ H,1(B)
JUMPE H,SCGFA
LDB T,[330400,,1(D)]
CAIL T,4
ADDI G,4
PUSHJ P,SCGTST
HLL D,1(B)
CAIL G,4
AOBJP A,SCGEN5
PUSHJ P,SCGBK1
CAIN G,2
JRST SCGNC
SCGEN4: LDB T,[221100,,1(B)]
JUMPE T,.+3
ADD T,SSVINS
LEG PUSH A,T
MOVE T,1(B)
TLNE T,SGEBIT
JRST SCGE
HLL C,(B)
EXCH C,(B)
EXCH C,B
MOVSI T,1000
HLLM T,SBKINS
AOJA E,SCGEN2
SCGEN5: PUSH P,A
PUSHJ P,SCGHB
MOVEI T,(A)
ADD T,SBKINS
POP P,TT
MOVEM T,(TT)
JRST SCGEN4
;SCGTST SCGT2 SCGT3 SCGDSP SCGCN SCGCN2 SCGBTN SCGBT
SCGTST: XCT SCGDSP(G)
TDNN T,SLMODE
JRST SCGT2
HRLI H,(<CAIN C,>)
LEG PUSH A,H
MOVSI T,(<JRST>)
HRRI T,3+1(A)
LEG PUSH A,T
TDCA H,[<CAIE>≥<CAIN 40>]
SCGT2: HRLI H,(<CAIE C,>)
SCGT3:
LEG PUSH A,H
POPJ P,
SCGDSP: MOVE T,CTAB(H)
JRST SCGBT
JRST SCGCN
JRST SCGBTN
JRST SCGCN
JRST SCGBTN
MOVE T,CTAB(H)
JRST SCGBT
SCGCN: MOVE T,CTAB(H)
TDNN T,SLMODE
JRST SCGCN2
HRLI H,(<CAIE C,>)
LEG PUSH A,H
TDCA H,[<CAIE>≥<CAIN 40>]
SCGCN2: HRLI H,(<CAIN C,>)
JRST SCGT3
SCGBTN: SKIPA T,[TDNE (C)]
SCGBT: MOVSI T,(<TDNN (C)>)
MOVS TT,5(H)
HLR T,TT
TRZE TT,400000
TLC T,(<TDNN>≥<TDNE>)
CAMG TT,[CTAB,,-1]
TRNE G,2
TDZA H,H
MOVSI H,NSPEC
IOR H,BEG(TT)
TRNN H,-1
TROA H,(<MOVSI>)
TLOA H,(<MOVEI>)
MOVS H,H
LEG PUSH A,H
LEG PUSH A,T
POPJ P,
;SCGE SCGE2 SCGEL SCGBAK SCGBK1 SCGBK2 SCGBK3 SCGFA SCGNC SCGNFA
SCGE: MOVSI T,(<MOVEI>)
HRRI T,(E)
LEG PUSH A,T
LEG PUSH A,[SOSG SRCN1]
LEG PUSH A,[JSP D,SRCHX]
HRRZ D,(B)
LDB G,[330400,,1(D)]
PUSHJ P,SCGBAK
SCGE2: MOVE D,SCXCT
HLRZ G,(B)
MOVE T,(G)
HRLM T,(B)
MOVEM D,(G)
JUMPE C,CPOPJ
SCGEL: EXCH C,B
HLRZ G,(B)
HRL C,(G)
MOVEM D,(G)
EXCH C,(B)
TRNE C,-1
JRST SCGEL
POPJ P,
SCGBAK: CAIL G,4
JRST SCGHB
SCGBK1: HLRZ T,(D)
ADD T,SBKINS
SCGBK2: TLNN D,NLDBIT
SOJA T,.+3
SCGBK3: TRNE F,SBKWDS
ADDI T,2
LEG PUSH A,T
POPJ P,
SCGFA: CAIGE G,2
JRST SCGNFA
SCGNC: MOVSI T,37740
HRRI T,2(A)
LEG PUSH A,T
JRST SCGEN4
SCGNFA:
LEG PUSH A,[JRST SRCHLX]
JRST SCGE2
;SCGHB SCGHB0 SCGHB5 SCGHB1 SCGHB2 SCGHB3 SCGHB4 SCGHBX SCGHX2
SCGHB: MOVEI T,(A)
LEG PUSH A,[MOVEM C,SBTST]
SCGHB0: HRLM T,(P)
LDB G,[330400,,1(D)]
CAIE G,XFRSAV
JRST SCGCB
SCGHB5: SUBI T,-774(A)
ROT T,-15
HRRI T,1+2(A)
LEG PUSH A,[MOVE C,SBTST]
LEG PUSH A,T
SCGHB1: HRRZ H,1(D)
LDB T,[221100,,1(H)]
JUMPN T,SCGHB3
MOVSI T,(<MOVEI C,>)
HRR T,1(H)
SCGHB2:
LEG PUSH A,T
LDB T,[221100,,1(D)]
ADD T,SSVINS
LEG PUSH A,T
HLL D,1(D)
HRR D,(D)
LDB G,[330400,,1(D)]
CAIGE G,4
JRST SCGHBX
CAIE G,XFRSAV
JSP SARRGH
JRST SCGHB1
SCGHB3: HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
JRST SCGHB2
SCGHB4: CAIL G,4
JRST SCGHB5
SCGHBX: HLRZ T,(P)
SCGHX2: SUBI T,-774(A)
ROT T,-15
HLR T,(D)
LEG PUSH A,[MOVE C,SBTST]
AOJA T,SCGBK2
;SCGCB SCGCB0 SCGCB1 SCGCB2 SCGCNO SCGCB3 SCGCB4 SCGCB5 SCGHCB
SCGCB: PUSH P,C
SCGCB0: MOVEI C,
SCGCB1: HRRZ H,1(D)
JUMPE H,[HLL D,1(D)↔HLR D,(D)↔JRST SCGCB3]
LDB T,[221100,,1(D)]
HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
LEG PUSH A,T
TRZE G,REMTST
JRST SCGCB2
CAIE G,INDTST
JSP SARRGH
LDB G,[330400,,1(H)]
HRRZ H,1(H)
SCGCB2: CAIL G,4
JSP SARRGH
PUSHJ P,SCGTST
LEG PUSH A,C
MOVEI C,(A)
SCGCNO: HLRZ T,(D)
HLL T,1(D)
HRRZ D,(D)
SCGCB3: LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB1
PUSH P,T
CAIL G,4
JRST SCGHCB
HLRZ T,-2(P)
PUSHJ P,SCGHX2
SCGCB4: MOVSI H,(<JRST>)
TROA H,1(A)
SCGCB5: MOVEI C,(T)
MOVE T,(C)
MOVEM H,(C)
JUMPN T,SCGCB5
POP P,D
LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB0
POP P,C
HLRZ T,(P)
JRST SCGHB4
SCGHCB: HLRZ T,-2(P)
PUSHJ P,SCGHB0
JRST SCGCB4
;SBTMAK SBTMK1 SBTMK2 SBTMK3 SBTMK4 SSVINS SBKINS SBKNW SBKNWA SBKNWR SBKNWX SBKDSP
SBTMAK: MOVEI B,200
PUSHJ P,SFSGET
MOVSI T,(A)
HRRI T,1(A)
SETZM (A)
BLT T,177(A)
MOVEI B,43
SBTMK1: HRLI A,BITTAB-BEG(B)
MOVEM A,5(C)
MOVE D,BITTAB(B)
HRLI C,-4
MOVSI G,TT
HRRI G,(A)
SBTMK2: SKIPE T,1(C)
JFFO T,SBTMK4
SBTMK3: ADDI G,40
AOBJN C,SBTMK2
HRRZ C,-4(C)
JUMPE C,CPOPJ
SOJGE B,SBTMK1
JRST SBTMAK
SBTMK4: IORM D,@G
ANDCM T,BITTAB(TT)
JFFO T,SBTMK4
JRST SBTMK3
IMPURE
SSVINS: MOVEM C,...
SBKINS: JSP D,1
SBKNW: SOJL A,...
SBKNWA: MOVE B,...(A)
SBKNWR: LSH B,-1
SBKNWX: JSP @
SBKDSP: REPEAT 4,<ADDI 3↔ROT C,7↔JSP @>
SBKNLX←.-1
JSP SBKNW
PURE
;SRCLBL SRCPAG SRCPG1 SRCPG3 SRCPG5 SPFIN SPFL SPFL2 SPFX NOSRC2
;Here to continue searching from last string found for LBLSRC
SRCLBL: MOVEI T,SRCHLX ;Routine to go to upon hitting end of search page
MOVEM T,SRCHLA
JRST SRCPG3
SRCPAG: MOVEI T,SRCHLX ;Entry from FINDIT (one page search)
SRCPG1: MOVEM T,SRCHLA# ;T has SCONTF not SRCHLX if from FIND (extended)
MOVE T,ARRLIN ;Start search from arrow line
MOVEM T,SRCLIN#
MOVE T,ARRL
MOVEM T,SRCL#
SRCPG3: MOVEI T,SBKNL
MOVE D,[SRCPGB,,SRCPGF]
PUSHJ P,SRCSET
MOVE A,SRCLIN ;Get FS pointer for line to start search from
HRRZ T,TXTSER(A)
CAME T,SRCNUM
SETOM SRCOFF# ;No search string found yet
TRNE F,SBKWDS
JRST NOSRC2
HRRE E,SRCOFF ;May be negative if searching from 1st char
TRNE F,SDELIM
SUBI E,1 ;Delimited search, start one character earlier
PUSHJ P,GBYTP ;Set up byte ptr for searching first line
SKIPA C,[15] ;we're at end of page, force advance to next line
ILDB C,A ;get char before search into C
;now C holds the char before the first char we'll search
MOVEI D,3
MOVE T,SRCL ;See if we're supposed to stop before starting!
CAMN T,SLNSTP ;Is this line number to stop at?
SKIPE DIRNOW ;Yes, but don't stop if doing dir search
JRST SRCPG5
HRRZM T,SHTSTP ;Flag a quick stop
POPJ P, ;Take not-found return
SRCPG5: PUSHJ P,SCALL
POPJ P, ;Not found
AOS (P) ;Success--skip return
MOVEM A,SAVEBP# ;Save byte pointer to end of string for LBLSRC
JRST SCNBAK
;This routine backs up from the beginning of the found string to the beginning
;of the line (actually to the end of the prev line) to figure out SRCOFF.
SPFIN: MOVEI T,SPFX
MOVEM T,SRCHLA
SPFL: XCT SCXCT
LSHC B,-7
ROT C,7
CAIE C,15 ;Have we gotten into prev line yet?
AOJA E,SPFL ;No, continue counting
MOVE G ;Yes
SPFL2: HRRZ T,@SRCLIN
MOVEM T,SRCLIN
AOS SRCL
SKIPGE TXTFLG(T)
JRST SPFL2 ;Skip over this pagemark
SPFX: HRRZM E,SRCOFF#
MOVE T,SRCLIN
HRRZ T,TXTSER(T)
MOVEM T,SRCNUM#
POPJ P,
NOSRC2: SORRY Reverse searches not implemented.
JRST SBARF2
;GBYTP GBYTPL GBPTX GBPNEG GBPDSP GBPTAB BTAB3
;GET BYTE PTR for beginning to search (called from SRCPAG).
;Skips with byte ptr in A to be ILDB'd to find character (E) chars into line (A).
;Takes direct return if given line is end of page, or if line not (E) long.
;Double skips with a space in C if E is negative, byte ptr set up to start of line.
;E/zero means first char in line.
GBYTP: CAIE A,BOTSTR ;skip if end of page
SKIPGE T,TXTFLG(A) ;skip unless pagemark
POPJ P,
HRRZ T,TXTCNT(A)
ADD A,[10700,,LLDESC-1]
SKIPN T
ADD A,[340000,,1]
JUMPE E,POPJ1 ;return byte ptr in A if wants first char in line
JUMPL E,GBPNEG ;double skip with space in C if want char before
MOVSI T,LSPC
MOVEI DSP,GBPDSP-2
GBYTPL: GETCH2 T,A
GBPTX: SOJG E,GBYTPL
JRST POPJ1
GBPNEG: MOVEI C,40
JRST POPJ2T
GBPDSP: POPJ P, ;CR hit end of line, take direct return
PUSHJ P,TELL3 ;LF error
JRST GBPTAB ;TAB gobble spaces up to ending tab
PUSHJ P,TELL5 ;FF error
GBPTAB: ILDB C,A
CAIE C,11
JRST GBPTAB
JRST GBPTX
BTAB3: 10700,,-10
100700,,-17
170700,,-26
260700,,-35
350700,,
;SRCPGF SPFTAB SPFFF SPFCR SSPAGE SSLINE SSLIN4 SSLIN5 SSLIN3 SSLINT SSSTOP SSNAME SSADD SSPAGT SSPADD
SRCPGF: 15↔JSP SPFCR
11↔JSP SPFTAB
177↔JSP SARRGH
0↔JSP SARRGH
SPFTAB: ILDB C,A
CAIE C,11
JRST .-2
ILDB C,A
JRST @
SPFFF: HRRZ B,LPMTXT+PMSIZE(A) ;Get number of page we just encountered
CAMN B,SPGSTP ;Supposed to stop search at this page?
SKIPE DIRNOW ;Yes, but don't stop if doing a dir search
JRST SPFCR ;Don't stop
MOVSM B,SHTSTP ;Stop here and remember page number
JRST @SRCHLA ;Early stop
SPFCR: MOVE A,SRCL ;Get number of next incore line
ADDI A,1
CAMN A,SLNSTP ;Are we supposed to stop at this line?
JRST [ SKIPE DIRNOW ;Yes, but not if we're doing a dir search
JRST .+1 ;Don't stop this dir search
HRRZM A,SHTSTP ;Yes, remember line where we stopped
JRST @SRCHLA] ;Go do an early stop
HRRZ A,@SRCLIN
CAIN A,BOTSTR
JRST @SRCHLA
MOVEM A,SRCLIN
AOS SRCL
SKIPGE B,TXTFLG(A) ;Pagemark?
JRST SPFFF ;Yes, now we're on next page
HRRZ B,TXTCNT(A) ;See if this is a blank line
SKIPN B
TLOA A,350700 ;Blank, skip phony space at beginning
HRLI A,440700
ADDI A,LLDESC
ILDB C,A
JRST @
SSPAGE: SKIPA B,[SSPAGT] ;Pointer to table for page-stopping
SSLINE: MOVEI B,SSLINT ;Pointer to table for line-stopping
TRNN F,REL!ARG ;If no arg at all,
SETO A, ; then disable stopping
TRNE F,REL ;Relative arg means add current place and set
JRST SSLIN4
JUMPN A,SSLIN5 ;Zero arg means report stopping place for search
PUSHJ P,ABCRLF
SKIPG @SSSTOP(B)
JRST SSLIN3
OUTSTR [ASCIZ /Searches will stop before /]
OUTFIV SSNAME(B)
SETZM TYOPNT
TYPDEC @SSSTOP(B)
OUTSTR [ASCIZ /. /]
JRST POPJ1
SSLIN4: XCT SSADD(B) ;Make stopping place relative to current
SSLIN5: MOVEM A,@SSSTOP(B) ;Store number place to stop at (neg disables)
POPJ P,
SSLIN3: OUTSTR [ASCIZ /No stopping /]
OUTFIV SSNAME(B)
OUTSTR [ASCIZ /for searches./]
JRST PPJ1CR
SSLINT: PHASE 0
SSSTOP::SLNSTP
SSNAME::ASCII/line /
SSADD:: ADD A,ARRL ;Relative to incore line number
DEPHASE
SSPAGT: SPGSTP
ASCII/page /
PUSHJ P,SSPADD ;Relative to current (arrow) page
SSPADD: PUSHJ P,GPAGL ;Get current page in RH T
ADDI A,(T) ;Add current page to increment
POPJ P,
;SRCPGB SPBTAB SBKNL SBKNUL
SRCPGB: 11↔JSP D,SPBTAB
0↔JSP SARRGH
SPBTAB: XCT @
LSHC B,-7
ROT C,7
CAIE C,11
JRST SPBTAB
MOVEI C,177
JRST -1(D)
SBKNL: HLRZ B,@SRCLIN
CAIN B,PAGE
JRST @SRCHLA
MOVEM B,SRCLIN
SOS SRCL
SKIPGE A,TXTFLG(B)
JRST SBKNL
HRRZ A,TXTCNT(B)
SKIPN A
JRST SBKNUL
MOVEI A,LLDESC(B)
HRRM A,SBKNWA
HRRZ A,-LLDESC-1(A)
SUBI A,LLDESC+2+1
XCT SBKNWA
LSH B,-1
LSHC B,-7
JUMPN C,[ROT C,7↔SOJA SBKNWX]
SUBI 1
FOR I←0,3<LSHC B,-7↔JUMPN C,SBKDSP+1+3*I
> JSP SARRGH
SBKNUL: MOVEI C,15
MOVEI A,
ADDI 2
JRST SBKNLX
;SRCSET SRCST1 SRCSTL SRCST2
SRCSET: HRRM T,SBKNW
MOVEM D,SRCTYP#
SRCST1: MOVE A,SCXCT
TRNE F,SBKWDS
SKIPA T,[XCT @]
SKIPA T,[ILDB C,A]
MOVS D,D
MOVEM T,1(A)
MOVSI T,1(A)
HRRI T,2(A)
BLT T,177(A)
MOVE T,[JRST @40]
MOVEM T,200(A)
MOVSI T,200(A)
HRRI T,201(A)
BLT T,377(A)
SRCSTL: MOVE C,(D)
CAIGE C,200
JRST SRCST2
MOVE T,[JSP D,SOOPS]
MOVEM T,@A
SUBI C,200
SRCST2: MOVE T,1(D)
MOVEM T,@A
ADDI D,2
JUMPN C,SRCSTL
POPJ P,
;SCALL SRCHX SRCHLX ESCSTP ESCIST
SCALL: MOVE T,SCXCT
ADDI T,200
MOVEM T,41
MOVEM 0,SBTST
HRRZ 0,SCXCT
ADDI 0,SSPACS+1
MOVEM 1,@
HRLI 0,2
AOS 1,0
BLT 0,16(1)
MOVE 0,SBTST
MOVEM 0,-2(1)
MOVE 1,-1(1)
ADD D,SCODPT
JRST @SCODPT
SRCHX: HRRZ 17,SCXCT
MOVE 16,SSPACS+P(17)
AOSA (16)
SRCHLX: HRRZ 17,SCXCT
MOVEM 0,SSPACS+E(17)
MOVE 0,SSPACS(17)
MOVSI 17,SSPACS+D(17)
HRRI 17,D
BLT 17,17
MOVE T,[PUSHJ P,UUOH]
MOVEM T,41
XCT SRCDP3 ;Clear search page number if on III.
SKIPN ESCI2 ;Have we been interrupted?
POPJ P, ;No
ESCSTP: PUSHJ P,ABCRLF ;Type CRLF (clobbers T).
OUTSTR ESCIST
SETZM TYOPNT
TYPDEC SRCPG ;Type out number of last page searched
POPJ P,
ESCIST: ASCIZ /ESC I stop at end of page /
;SCNBAK SCNBKL SCBDSP
SCNBAK: PUSH P,A
PUSH P,D
MOVE D,SRCTYP
TRC F,SBKWDS
PUSHJ P,SRCST1
POP P,D
POP P,A
TRCN F,SBKWDS
JSP SARRGH
LDB C,A ;Get first char of found string
CAIN C,11
MOVEI C,40 ;If tab, make it a space
MOVE B,(A)
TRNN F,OFFPAG
SKIPA T,SRCLIN ;FS address of line where string was found
SKIPA T,[IBUF] ;String was found in the input buffer
ADDI T,LLDESC ;Address of first text word of line's FS block
SUBI A,(T) ;Distance from beginning of FS text to first char
HRRM T,SBKNWA
LDB D,[370300,,A] ;Get piece of byte pointer position field
ANDI A,-1 ;Just address of first char
MOVE D,BTAB(D)
LSH B,@BTAB3(D)
IMULI D,3
MOVE G,
MOVEI SBKDSP(D)
MOVEI D,SCNBKL+5
MOVE T,SCXCT
MOVEM T,SCNBKL
MOVSI H,NSPEC!LSPC
MOVEI DSP,SCBDSP
JUMPN E,SCNBKL
POPJ P,
IMPURE
SCNBKL: XCT ...(C)
LSHC B,-7
ROT C,7
TDNE H,CTAB(C)
XCT @CTAB(C)
SOJG E,SCNBKL
POPJ P,
PURE
SCBDSP: JRST SCNBKL
JSP SARRGH
JFCL
JRST SCNBKL
JFCL
JRST SCNBKL
JFCL
;SCONTF SRCFNP SRCHED SRCDD SRCPGD SRCDPY SRCDP3
SCONTF: SKIPE SHTSTP ;Already been stopped short by incore search?
JRST SRCHLX ;Yes, then really stop search
MOVE D, ;Here in extended search after doing incore part
ADDI D,2
JSP A,SGTACS
PUSH P,T
PUSH P,D
MOVEI T,SBKNB
MOVE D,[SRCFB,,SRCFF]
PUSHJ P,SRCSET
POP P,D
POP P,T
TRO F,OFFPAG ;If we find the string, it wasn't found incore
MOVE A,DIRPT
MOVEM A,SDIRPT#
MOVE A,CURPAG
MOVEM A,SRCPG#
JSP A,SRTACS
SRCFNP: HRRZ A,@SDIRPT ;Get directory pointer to next page in file
CAIN A,DIREND ;Is this the end of the (known) file?
JRST SRCHLX ;Yes
SKIPN ESCIEN ;Has user typed ESC I? (Only place ESCIEN is tested)
JRST SRCFP2 ;Nope, go on.
SETOM ESCI2 ;We have now been interrupted by ESC I
JRST SRCHLX
IMPURE
SRCHED: 644000,,SRCDD
SRCDDL
0
SRCDD+1
SRCDD: CW 1,46,2,0,3,=74 ;DD color is diddled in first byte here
CW 3,=74,4,1,5,10
ASCID/Page /
SRCPGD: ASCID/000
/
0
SRCDDL←←.-SRCDD
SRCDPY: 0
JRST NOSRCP ;TTY
SKIPE SRCHED+2 ;DD
JRST SRCIII ;III
SKIPE SRCHED+2 ;DM
SRCDP3: 0
JFCL ;TTY
IFN FTCCRMA,<
DPYOUT SEAPOG,[0↔0] ;GRINNELL, flush search page number.
>;IFN FTCCRMA
IFE FTCCRMA,<
JFCL ;DD
>;IFE FTCCRMA
IFE DECSW,<
DPYOUT SEAPOG,[0↔0] ;III. Turn off search page number.
>
IFN DECSW,<
JFCL ;NO IIIS IN THE REAL WORLD
>
JFCL ;DM
PURE
;SRCFP2 SRCFPP SRCIII NOSRCP SRCFP3 SRCFNB SFNB2 SFNB3 SIOCH3 SFNB4 SFRETR SIOCHK
SRCFP2: PUSHJ P,SRCFPP ;To display page number during search
JRST SRCFP3
JRST SRCHLX ;Early stop
;Used in SRCFP2 above and by PARFF and PAREXT in the PAREN search code
;Skip returns if have reached page where search is supposed to stop.
SRCFPP: MOVEM A,SDIRPT
AOS A,SRCPG ;Now searching next page
CAMN A,SPGSTP ;Supposed to stop at this page?
JRST [ MOVSM A,SHTSTP# ;Yes, flag short stop at this page
JRST POPJ1] ;And skip return too
MOVEM B,BSAV# ;Who knows what evil lurks in the hearts of B!
SKIPN DDACT
XCT SRCDPY ;Depends on terminal type
JRST NOSRCP ;Last transfer still in progress--forget this one
MOVE B,SCRTOP
HLLZS DPYTAB(B) ;Force redisplay of top line
SRCIII: IDIVI A,=10
DPB B,[POINT 4,SRCPGD,20] ;Units place digit
IDIVI A,=10
DPB B,[POINT 4,SRCPGD,13] ;Tens place digit
DPB A,[POINT 4,SRCPGD,6] ;Hundreds place digit
DPYOUT SEAPOG,SRCHED ;Display number of page being searched
NOSRCP: MOVE B,BSAV ;Restore
MOVE A,SDIRPT ;Restore
POPJ P,
SRCFP3: SKIPN A,DIRREC(A) ;Get record and byte pointer for new page
JRST SIOERR ;Oops, none there
MOVEI C,-1(A)
CAME C,IBLK
XCT %SETI ;Make sure we read in first record of page
MOVEM C,IBLK
ANDCMI A,-1 ;Set up byte pointer to the FF beginning the page
ROT A,7
ADD A,IBFPNT
IBP A ;Make us skip the FF in the search
JRST SFNB2
;Here in forward search when need New Buffer of text to search
SRCFNB: HRRZ A,@SDIRPT
MOVE A,DIRREC(A) ;Get block number where next page starts
TLZN A,-1 ;Does current page go into that block?
SUBI A,1 ;No, this is last block number of current page
CAMG A,IBLK ;Are we ready for next page?
JRST SRCFNP ;Yes, figure out where Next Page starts
MOVE A,IBFPNT ;No, read another record of text from old page
SFNB2: HRRZ C,@SDIRPT ;Pointer to next page
SKIPN C,DIRREC(C) ;Record where it starts
JRST SENDIR ;That's as far as directory goes, I guess
MOVEI C,-1(C)
CAMLE C,IBLK ;Will new record have piece of next page in it?
JRST SFNB3 ;No, next page starts after next record
HRRZ C,@SDIRPT ;Pointer to next page
HLLZ C,DIRREC(C) ;Byte pointer offset where next page starts
ROT C,7
ADD C,IBFPNT ;Make byte pointer to FF for next page
SFNB3:
IFN FTBUF,<
PUSHJ P,BIN ;Get a record on input from the cache if possible
>
XCT %IN
SIOCH3: AOSA IBLK
JRST SIOCHK ;See why IN lost
TLNN C,-1 ;Do we want to ignore some of buffer?
JRST SFRETR ;No
JUMPL C,SFNB4 ;Jump if only need to clear whole words
PUSH P,A
SETZ A,
IDPB A,C ;Fill out remainder of word with nulls
TRNE C,760000
JRST .-2
POP P,A
ADDI C,1
SFNB4: ANDI C,-1
CAIGE C,IBFE
SETZM (C)
CAIL C,IBFE-1
JRST SFRETR
HRL C,C
HRRI C,1(C) ;Make blt pointer to clear rest of IBUF
BLT C,IBFE-1 ;Clear it
SFRETR: HLRZ C,-3(D)
CAIE C,(<XCT (C)>)
SOJA D,SFRETR
MOVEI C,40
JRST -3(D)
SIOCHK: XCT %STAT ;Get IO status into C
TRNN C,20000 ;EOF?
JRST SIOERR ;No, lose
MOVE C,IBLK
LSH C,7 ;Number of words successfully read
CAML C,FILWC ;Beyond EOF already?
JRST SIOERR ;Lose
SUB C,FILWC ;Negative of number of real words in last buffer
MOVN C,C
HRROI C,IBUF(C) ;Address of first word beyond valid data
JRST SIOCH3
;SRCFF SFFNUL SGTACS SRTACS SOOPS
SRCFF: 377↔JRST SRCFNB
212↔JRST SFRETR
200↔JRST SFFNUL
SFFNUL: SKIPE (A)
JRST SFRETR
SKIPN 1(A)
AOJA A,.-1 ;quickly skip over consecutive words of nulls
HRLI A,700
JRST SFRETR
SSPACS←←400
SSSACS←←420
SGTACS: EXCH A,SCXCT
MOVE F,SSPACS+F(A)
MOVEM P,SSSACS+P(A)
MOVE P,SSPACS+P(A)
EXCH A,SCXCT
JRST (A)
SRTACS: EXCH A,SCXCT
MOVEM F,SSPACS+F(A)
MOVE P,SSSACS+P(A)
EXCH A,SCXCT
JRST (A)
SOOPS: HLL D,40
TLNN D,¬1000
XCT SCXCT
LSH C,22-15
HLL C,D
ROT C,15
ADDI D,-774(C)
HLRZ C,C
XCT SCXCT
;SRCFB SFBNUL SBKNB SBKNB2 SIOERR SENDIR SBKNP
SRCFB: 14↔JRST SFBNUL
12↔JRST SFBNUL
0↔JRST SFBNUL
SFBNUL: HLRZ C,-5(D)
CAIE C,(<XCT (C)>)
SOJA D,SFBNUL
MOVEI C,177
JUMPN B,-5(D)
MOVEI -5(D)
SOJL A,SBKNB
SKIPN B,@SBKNWA
SOJGE A,.-1
JUMPGE A,SBKNWR
SBKNB: MOVE A,SDIRPT ;Here in backward search when need New Buffer
HRRZ A,DIRREC(A) ;See where currently being searched page starts
CAML A,IBLK ;Have we gotten back to beginning of page?
JRST SBKNP ;Yes, back up to previous page
SBKNB2: SOS A,IBLK ;No, read previous buffer for same page
XCT %SETI
MOVEI A,177
IFN FTBUF,<
SOS IBLK ;BIN expects IBLK to be one less than right record
PUSHJ P,BIN ;Get record of input from cache if possible
XCT %IN
JRST [AOS IBLK↔JRST SBKNWA] ;Got the input okay
AOS IBLK
>;FTBUF
IFE FTBUF,<
XCT %IN
JRST SBKNWA ;Got the input okay
>;NOT FTBUF
SIOERR: OUTSTR [ASCIZ \ Search I/O error.
\]
JRST SRCHLX
SENDIR: OUTSTR [ASCIZ \ Cannot search pages not listed in (incomplete) Directory.
\]
JRST SRCHLX
SBKNP: JSP SBARF
;MINTXT TJSCNT TABCNT JPTAB JPT1 JPT2 JETST JLPTR JCPTR JARTST JWRT JLTPT JEXIT JATAB JUSF JALL JTBF JCRF MACF JCTAB
COMMENT ⊗
Register assignments used in main section of JUST (and related routines)
A Input character pointer
B Input line address
C Current character
D Output character pointer
E Address of table defining data region
F Usual flag word
G Character count for output line (-x,,0 at start)
H Special flag word
I Address of line into which characters are going
J Input char count for TJ commands
K Output tab field termination position for TJ commands
DSP Current dispatch table address
P Stack pointer, as usual
Q Several counting jobs and to index TABOLD and TABTAB
T Temporary
TT Temporary
Special flag usage with F during JUST etc. (after initial normal usage)
Right half of F
NEG set to 0 for JUST, to 1 for JFILL
REL set to 0 for no par. break, to 1 for par. break
Left half of F
TF1 used in JPARAM and GETNUM to keep neg sign info and then
set to 0 for first pass, to 1 for second pass in JUST
TF2 set to 0 for JUST and JFILL, to 1 for TJUST and TFILL
TF3 set to 1 for SJFILL and SJUST commands
End of comment ⊗
MINTXT←←3 ;Minimum allowed text length or TAB field
TJSCNT←←2 ;Minimum number of spaces to terminate a TAB field
TABCNT←←40 ;Number of tab fields. MUST NOT EXCEED SIZE OF BUF2!
JPTAB: ;Table of Justify parameters for non-attach mode
PHASE 0 ;Define following offsets for justification parameters
JPT1:: ARRLIN ;Address of word containing ptr to starting line
JPT2:: ,PAGE ;Address of word containing ptr to first line
JETST:: BOTSTR ;Address to use for end test
JLPTR:: LINES ;Address of word containing count of lines
JCPTR:: CHARS ;Address of word containing count of chars
JARTST::CAIA ;XCTed instruction for lisp code
JWRT:: PUSHJ P,SETWRT ;XCTed by lisp code when text has been changed
JLTPT:: HLRZ B,@ARRLIN ;LTXLF: get ptr to text line to insert after
JEXIT:: PUSHJ P,LINSET ;Entry point to come to when done
PUSH P,JLCHG# ;Net number of lines inserted (+) or deleted (-)
PUSHJ P,XLALL ;Fix up line marks and line stack
SUB P,[1,,1]
HRRZ T,ARRLIN
HRRZ T,TXTCNT(T) ;Get number of chars in (maybe new) arrow line
TLZ F,NULLIN ;Assume not an empty line
JUMPN T,SETWRT
TLO F,NULLIN ;Empty line
JRST SETWRT
DEPHASE ;End of parameters. DON'T PUT LABELS AFTER JEXIT ABOVE
;Table of Justify parameters (parallel to JPTAB above) for attach mode
JATAB: ATTBUF
ATTBUF
ATTBUF
ATTNUM
ATTSIZ
CAMN A,ARRLIN ;XCTed instruction for lisp code
PUSHJ P,ATTWRT ;XCTed by lisp code when text has been changed
HLRZ B,ATTBUF ;LTXLIN: get ptr to text line to insert after
PUSHJ P,EXSETA ;(enter here) Set number of EXTRA attached lines to display
JRST ATTWRT
;Special flags tested against H (for use with JUST and related commands)
JUSF←←200000 ;CR, LF, VT, FF, SP, TAB, . ! ?
; LSPC←←100000 ;Special character, previously defined
; NUMF←←40000 ;Number " "
JALL←←20000 ;Dispatch on all characters
; LETF←←10000 ;Letter (with LT2F => lower case)
; LT2F←←4000 ;Alone=> $ % . _
JTBF←←2000 ;TAB
JCRF←←1000 ;CR, LF, FF, VT
MACF←←400 ;Top-digit on SU-AI keyboard can be macro call command
;Dispatch displacements used in following table
; 0 CR, LF, NUL, FF, ALT, RUBOUT
; 1 TAB (11)
; 2 Space (40)
; 3 Sentence terminating punctuation . ? ! :
; 4 Closures ) ] > } " '
; 5 All other normal characters
;Special character-dispatch table for use with JUST and related commands
JCTAB: JALL!JUSF,,(DSP) ;NUL 0
REPEAT 10<JALL,,5(DSP)> ;↓ α β ∧ ¬ ε π λ 1,2,3,4,5,6,7,10
JALL!JUSF!JTBF!LSPC,,1(DSP) ;TAB 11
JALL!JUSF!JCRF!LSPC,,(DSP) ;LF 12
JALL,,5(DSP) ;VT 13
REPEAT 2,<JALL!JUSF!JCRF!LSPC,,(DSP)> ;FF,CR 14,15
JALL,,5(DSP) ;∞ 16
JALL,,5(DSP) ;∂ 17
REPEAT 4,<JALL!MACF,,5(DSP)> ; 20 thru 23 ⊂⊃∩∪
REPEAT 4,<JALL,,5(DSP)> ; 24 thru 27
JALL!MACF,,5(DSP) ; 30 Underbar
JALL,,5(DSP) ; 31
IFE DECSW,<
JALL!MACF,,5(DSP) ; 32 TILDE
JALL,,5(DSP) ; 33 NOT-EQUAL
>
IFN DECSW,<
JALL,,5(DSP) ; 32 NOT-EQUAL
JALL!JUSF!LSPC,,(DSP) ; 33 ALTMODE
>
REPEAT 2,<JALL,,5(DSP)> ; 34,35
JALL!MACF,,5(DSP) ; 36 EQUIVALENCE-SIGN
JALL,,5(DSP) ; 37
JALL!JUSF,,2(DSP) ;SP 40
JALL!JUSF,,3(DSP) ;! 41
JALL,,4(DSP) ;" 42
JALL,,5(DSP) ;# 43
REPEAT 2,<JALL!MACF,,5(DSP)> ;$ % 44,45
JALL,,5(DSP) ;& 46
JALL,,4(DSP) ;' 47
JALL,,5(DSP) ;( 50
JALL,,4(DSP) ;) 51
REPEAT 4,<JALL,,5(DSP)> ;* + , - 52,53,54,55
JALL!JUSF,,3(DSP) ;. 56
JALL,,5(DSP) ;/ 57
REPEAT 12,<JALL!NUMF,,5(DSP)> ;0,1,2,3,4,5,6,7,8,9 60 thru 71
JALL!JUSF,,3(DSP) ; : 72
JALL,,5(DSP) ; ; 73
REPEAT 2,<JALL,,5(DSP)> ; < = 74,75
JALL,,4(DSP) ; > 76
JALL!JUSF,,3(DSP) ;? 77
JALL,,5(DSP) ;@ 100
REPEAT 32,<JALL!LETF,,5(DSP)> ;A to Z 101 thru 132
REPEAT 2,<JALL,,5(DSP)> ;[ \ 133,134
JALL,,4(DSP) ;] 135
REPEAT 3,<JALL,,5(DSP)> ;↑ ← ` 136,137,140
REPEAT 32,<JALL!LETF!LT2F,,5(DSP)> ;a th z 141 thru 172
JALL,,5(DSP) ;LFT BRACE 173
JALL,,5(DSP) ;| 174
IFE DECSW,<
JALL!JUSF!LSPC,,(DSP) ;175 ALTMODE
JALL,,4(DSP) ;176 RT BRACE
>
IFN DECSW,<
JALL,,4(DSP) ;175 RT BRACE
JALL!MACF,,5(DSP) ;176 TILDE
>
JALL!JUSF!NSPEC,,(DSP) ;RUBOUT 177
;TABFLG PMAR LMAR RMAR BNUM PMARO LMARO RMARO BNUMO JPMAR JLMAR JRMAR JBNUM JPMARO JLMARO JRMARO JBNUMO GPMAR GLMAR GRMAR GBNUM TPMAR TLMAR TRMAR TBNUM TPMARO TLMARO TRMARO TBNUMO INMAR AMAR AMARS TABOLD TABTAB BREAKV JCNT JCNTC JPTR JPTRC JRPT JWCOL JSCNT JBUGR JWPT JSINC JSIZE JMARG
; Locations to hold Margin specifications
IMPURE
TABFLG: 0 ;-1 means TABLE command
PMAR: 0 ;Paragraph margin indent
LMAR: 0 ;Left justifying margin indent
RMAR: =74 ;Right justifying margin.
BNUM: -1 ;Number of blank lines between paragraphs
PMARO: 0 ;Old values saved as old text indicators
LMARO: 0
RMARO: =74
BNUMO: -1
JPMAR: 0 ;Values typed in with command
JLMAR: 0
JRMAR: =74
JBNUM: -1
JPMARO: 0 ;Typed values intended for recognizing old paragraphs
JLMARO: 0
JRMARO: =74
JBNUMO: -1
GPMAR: 0 ;Values determined by JGETX
GLMAR: 0
GRMAR: =74
GBNUM: -1
TPMAR: 0 ;Margins for TJUST, etc., commands
TLMAR: 0
TRMAR: =74
TBNUM: -1
TPMARO: 0 ;Margins for recognizing old paragraphs for TJUST, etc.
TLMARO: 0
TRMARO: =74
TBNUMO: -1
INMAR: 4 ;INDENT indent value
AMAR: 0 ;Align indent value
AMARS: 0 ;ALIGN and INDENT flag: 0 for spaces, -1 for interior TABS
AMSTMP: 0 ;New value for AMARS, being read by INREAD
TABOLD: BLOCK TABCNT ;Old tabulations
-1 ;Guard cell
TABTAB: BLOCK TABCNT ;New tabulations
-1 ;Guard cell
BREAKV: =80 ;Break value (always sticky)
;Memory locations to hold other variables
JCNT: 0 ;Count of lines to be processed
JCNTC: 0 ;Current value of JCNT during first pass
JPTR: 0 ;Location of first line of text being processed
JPTRC: 0 ;Location of first line of group currently being handled
JRPT: 0 ;Next line after text being processed
JWCOL: 0 ;Char count at last word break
JSCNT: 0 ;Word break count
JBUGR: 0 ;Bugger factor to distribute extra spaces
JWPT: 0 ;Accumulated count of extra spaces added
JSINC: 0 ;Needed spaces times 8
JSIZE: 0 ;JSINC times number of breaks already processed
JMARG: 0 ;Current output line's left margin
PURE
;J2CR J2CR1 J2CR2 J2CR4 J1SP J2TAB J2SP J2SP2 JUSPA1 J2PUN
; Action on reaching a CR in the input text
J2CR: TLNN F,TF1 ;Is this the first pass
JRST J2CR2 ;Yes
SOSG JCNT
JRST POPJ1 ;We should never get here!
PUSHJ P,NEXTLI ;Finish off line and get next
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so change pointer
J2CR1: MOVEI C,40 ;Replace CR with a space and cont.
SOS (P) ;To interpret the CR
POPJ P,
; First pass treatment
J2CR2: PUSHJ P,PARGET ;To get correct par info.
TRNN F,REL
JRST J2CR1 ;No new par. so replace CR with space and continue
J2CR4: CAIN DSP,J1DSP ;Save data only after a non-space last char.
JRST POPJ1 ;Previous char was a space or tab
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
JRST POPJ1 ;Forces an exit from loop without incrementing G
; To eat all extra spaces and tabs
J1SP: MOVNI C,3
ADDM C,(P) ;This backs up to the ILDB command
POPJ P,
; Action at end of a word signalled by a space or tab
J2TAB: MOVEI C,40
J2SP: MOVEI DSP,J1DSP
MOVSI H,JALL
TLNE F,TF1 ;Test for pass
JRST J2SP2 ;Second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count to this word break
POPJ P,
; Second pass
J2SP2: TRNN F,NEG!REL ;Is this line to be justified?
SKIPN T,JSINC ;8 times the needed number of extra spaces
POPJ P, ;Exit if no extra spaces are required
; To introduce extra spaces as required to justify
ADDB T,JSIZE
IDIV T,JSCNT ;Divide by available-location count
ADD T,JBUGR ;Current bugger factor to distribute extra spaces
LSH T,-3 ;Divide by 8
SUB T,JWPT ;JWPT counts additions to date
ADDM T,JWPT
JUMPE T,CPOPJ
JUSPA1:
LEG IDPB C,D ;Add an extra space
AOBJP G,CPOPJ ;Should always be negative
SOJG T,JUSPA1
POPJ P,
; Action on receipt of a sentence-terminating type punctuation mark
J2PUN: MOVEI DSP,J3DSP
MOVSI H,JALL
POPJ P,
;J3CR J3CR2 J3SP J3TAB J3SP0 J3SP2 J3SP3
; Action on reaching a CR in the input text after a sentence-terminating
; punctuation mark
J3CR: HLRE T,G
ADDI T,2
JUMPGE T,J2CR ;No need for special treatment if not room
TLNN F,TF1 ;Is this the first pass
JRST J3CR2 ;Yes
PUSHJ P,NEXTLI ;Finish off line and get next
SOSG JCNT
JRST POPJ1 ;We should never get here, but just in case
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so change pointer
MOVEI C,40
LEG IDPB C,D ;Introduce an extra space always
MOVEI DSP,J1DSP
MOVSI H,JALL
AOBJN G,J2SP2
; First pass treatment
J3CR2: PUSHJ P,PARGET ;To get correct par info.
TRNE F,REL
JRST J2CR4 ;New par.
TLNE F,TF3 ;Skip unless SJFxxx command
JRST [ SETOM SJFAKE ;This is a fake paragraph for SJF
TRO F,REL
JRST J2CR4]
AOS JSCNT ;Add to word count
HRRZM G,JWCOL ;Save char count at word break then
MOVEI DSP,J1DSP
MOVSI H,JALL
AOBJN G,.+1 ;Allow for the second space
POPJ P,
; Action at end of sentence signalled by punctuation and space or tab
; or by punctuation then a closure then a space or tab
J3SP: MOVE T,A
ILDB TT,T
CAIE TT,40
CAIN TT,15
JRST J3SP0
JRST J2SP
J3TAB: MOVEI C,40
J3SP0: MOVEI DSP,J1DSP
TLNE F,TF1
JRST J3SP2 ;Its on the second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
TLNE F,TF3
JRST J3SP3 ;SJFxxx command. Woops! make this a par break
AOBJN G,CPOPJ ;Count for an extra space if possible
SUB G,[1,,1]
POPJ P,
J3SP2:
LEG IDPB C,D ;Introduce second space always
AOBJN G,J2SP2 ;(should always be okay)
POPJ P, ;Safety exit
J3SP3: TRO F,REL ;Signal end of par
SETOM SJFAKE ;Fake paragraph for SJF cmd
JRST POPJ1 ;Force exit from loop
;J1CH J1DSP J2DSP J3DSP J4SP J4CH J4CHD J4CHX J4CH0 J4CH1 J4CH2 J4CH3 J4CH3A J4CH3B J4CH4
; Action on normal character if using JIDSP or J3DSP
J1CH: MOVEI DSP,J2DSP
MOVSI H,JUSF
POPJ P,
;Special dispatch tables used with JCTAB (Table address in DSP)
; and using the above routines
; After a space with JALL flag used
J1DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J1SP ;Space (eaten)
PUSHJ P,J1CH ;Punctuation (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
PUSHJ P,J1CH ;Closure " "
PUSHJ P,J1CH ;Other character " "
; After a normal char. with JUSF flag used
J2DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J2TAB ;TAB (MOVEI DSP,J1DSP↔MOVSI H,JALL)
PUSHJ P,J2SP ;Space " "
PUSHJ P,J2PUN ;Punctuation (MOVEI DSP,J3DSP↔MOVSI H,JALL)
JFCL ;(Never used)
JFCL ;(Never used)
; After sentence-terminating punctuation with JALL flag used
J3DSP: PUSHJ P,J3CR ;CR
PUSHJ P,J3TAB ;TAB (Replaced by space and handled as such)
PUSHJ P,J3SP ;Space (Introduces extra space and MOVEI DSP,J1DSP)
JFCL ;Punctuation
JFCL ;Closure
PUSHJ P,J1CH ;Other character (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
; CENTER, INDENT, ALIGN, etc. routines and dispatch tables
; On finding a leading space
J4SP: AOJA T,J1SP ;Count then eat
; On finding the first non-space and non-tab
J4CH: CAILE Q,5
MOVEI Q,5
JRST @J4CHD(Q)
J4CHD: J4CH0 ;Go to appropiate code as determined by Q
J4CH1
J4CH2
J4CH3
J4CH4
J4CHX
; Set desired margin
J4CHX: MOVEI DSP,J5DSP
MOVSI H,JTBF!JCRF
PUSH P,C
PUSHJ P,JMSTRT ;Start line with appropiate margin
POP P,C
POPJ P,
; Get margin for INDENT
J4CH0: ADD T,INMAR
SKIPGE T
SETZ T,
JRST J4CHX
; Get margin for CENTER
J4CH1: SUB T,JWCOL ;Neg.of the number of text char. less initial spaces
ADD T,JSIZE
SKIPGE T
SETZ T,
LSH T,-1 ;Divide by 2
ADD T,LMAR
JRST J4CHX
; Get margin for ALIGN
J4CH2: MOVE T,AMAR
JRST J4CHX
; Get margin for RTARR
J4CH3: MOVE TT,INMAR
SKIPG TT
J4CH3A: MOVNS TT
J4CH3B: ADD T,TT
JUMPGE T,J4CHX
SETZ T,
JRST J4CHX
; Get margin for LFARR
J4CH4: MOVE TT,INMAR
JUMPG TT,J4CH3A
JRST J4CH3B
;J5CR J5TAB J5TAB2 J5TAB3 J4DSP J5DSP
; On finding a CR after some text
J5CR: MOVEI DSP,J4DSP
MOVSI H,JALL
JRST POPJ2 ;Skip the IDPB, and exit from the loop
; On finding an interior TAB
J5TAB: SKIPN JBUGR ;0 means use spaces, -1 means use TABs
JRST J1SP ;Eat it in this case
LEG IDPB C,D ;Write out first TAB when found
MOVSI T,1 ;TAB counts 1 in left of TXTCNT
ADDM T,TXTCNT(I)
HRRZ T,TXTCNT(I) ;Columns already accounted for
HRRZ TT,G ;Column count accumulating in G
ADD T,TT ;The actual column position
ANDI T,7 ;modulo 8
MOVEI TT,10
SUB TT,T
ADDM TT,TXTCNT(I)
MOVEI T,40
J5TAB2:
LEG IDPB T,D
SOJG TT,J5TAB2
LEG IDPB C,D ;Closing TAB
J5TAB3: ILDB C,A
CAIN C,40
JRST J5TAB3 ;Eat the spaces
CAIN C,11 ;Look for the closing TAB
JRST J1SP ;Eat it and go on
SOS (P)
SOS (P) ;Take a look at this character!
POPJ P, ;Should never get here, but just in case
; Initial dispatch table to eat spaces and tabs
J4DSP: PUSHJ P,J4CH ;CR (An all space line, maybe it is wanted)
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J4SP ;Space (counted then eaten)
PUSHJ P,J4CH ;Punctuation (MOVEI DSP,J5DSP↔MOVSI H,JTBF)
PUSHJ P,J4CH ;Closure " "
PUSHJ P,J4CH ;Other character " "
; In-text dispatch table to look for a TAB or a CR
J5DSP: PUSHJ P,J5CR ;CR
PUSHJ P,J5TAB ;TAB (special treatment depending on JBUGR setting)
JFCL
JFCL
JFCL
JFCL
;PARGET PARG0A PARG0 PARG1A PARG2 PARG4 NEXTLI ADJARG JNEW JMORE
; Subroutine to get new paragraph indicator from next line
PARGET: SOSLE JCNTC ;Running out of text?
JRST PARG0A ;No
TRO F,ARG!REL ;Yes, flag end of text and end of paragraph
POPJ P,
PARG0A: HRRZ B,(B) ;Get pointer to next line
PARG0: HRRZ T,TXTCNT(B)
SETZB TT,SJFAKE# ;No fake paragraph here for SJF command
JUMPE T,PARG2 ;Empty line means this is definitely a new paragraph
MOVE A,B
ADD A,[440700,,LLDESC]
TRZ F,REL ;Means no new par.
MOVE T,A ;We will have to test new line indent
PARG1A: ILDB C,T ;Count leading spaces
CAIN C,40
AOJA TT,PARG1A
CAIN C,11
AOJA D,PARG1A
TLNE F,TF2 ;Was this a TABLE or TJ command?
JRST PARG4
CAIN C,15
POPJ P, ;An all space line is ignored
CAMN TT,LMARO
POPJ P, ;Handles case where LMARO=PMARO
CAMN TT,PMARO ;If this line's indent matches the paragraph indent,
PARG2: TRO F,REL ;Then this line marks a new paragraph
POPJ P,
; TABLE or TJ case
PARG4: SKIPGE TABFLG
JRST PARG2 ;TABLE uses TPMARO always
CAMN TT,TLMARO
POPJ P, ;Handles case where TLMARO=TPMARO
CAMN TT,TPMARO ;Indent must match for new paragraph
TRO F,REL ;This line marks a new paragraph
POPJ P,
; For second pass when input line is exhausted
NEXTLI: HLRZ T,TXTCNT(B)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,@JCPTR(E) ;add this to # in CHARS or ATTSIZ.
SOS @JLPTR(E) ;Subtract 1 from # in LINES or ATTNUM.
SOS JLCHG ;Count a line gone
HRRZ B,(B) ;Get line forward pointer
MOVEM B,JPTR ;and put it in JPTR.
MOVSI T,JPTR ;with JPTR location in left half
HLLM T,(B) ;of pointer for line pointed to.
AOS JFREED
MOVE A,B
ADD A,[440700,,LLDESC]
POPJ P,
; Limit neg A so as not to back too far, MOVARR and set A pos
ADJARG: MOVNS A ;Make positive number of previous lines to work on
PUSHJ P,GPAGL ;Get line,,page for arrow
HLRZ T,T ;Get current line on arrow page
CAIL A,(T) ;Are we trying to go back too far?
MOVEI A,-1(T) ;Most we can do is number of previous lines on page
PUSH P,A
PUSHJ P,NMVARR ;Now back up
POP P,A ;Get positive count back
POPJ P,
; Get space for first new line
JNEW: PUSH P,Q
HRRZ Q,(B)
MOVEM Q,JRPT# ;Keep current next line address
HLLZ Q,TXTFLG(B) ;Save flags
HRRZ I,FSEND
ADDI I,1
MOVEM I,JLPT#
HLLZ TT,(B) ;Use the left half of old link for
LEG MOVEM TT,(I) ;left half of the new link word, zero right
HLRZ T,TT
HRRM I,(T) ;Fix earlier forward link to the new line
LEG HLLM Q,TXTFLG(I) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM I,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM I,WINLIN ;WINBIT can only be on if here from INDENT command
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so replace by I
POP P,Q
POPJ P,
; Get space for next output line
JMORE: HRRZ TT,FSEND ;So get space starting address
ADDI TT,1
HRRM TT,(I) ;Complete forward link in finished line
LEG HRLZM I,(TT) ;and back link new line
MOVEM TT,JLPT
MOVE I,JLPT
MOVEI TT,0
LEG HRLM TT,TXTFLG(I) ;This should always be safe
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so replace by I
POPJ P,
;JUFIX JBLANK JMSTRT J2PAS0 J2PAS1 J2PAS3 J2PAS4 J2PAS5
; Introduce CRLF and finish off the line
JUFIX: LDB C,D
CAIN C,15 ;Was last char. a CR?
MOVEI C,40 ;Keep one space in this line
DPB C,D
MOVEI C,15
LEG IDPB C,D ;The CR
MOVEI C,12
LEG IDPB C,D ;And a LF
TDZA C,C
LEG IDPB C,D ;And a null
TLNE D,760000
JRST .-2
MOVSI TT,2(G) ;2 for CRLF + char. count
ADDI TT,(G) ;but only char. count into right half
ADDM TT,TXTCNT(I) ;Record char counts
AOS @JLPTR(E) ;Add to line count (LINES or ATTNUM)
AOS JLCHG ;Count a line added
HLRZ T,TXTCNT(I)
ADDM T,@JCPTR(E) ;Add to char count (CHARS or ATTSIZ)
MOVE T,JLPT ;should be same as I
;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(D)
AOJA T,.-2
MOVEI TT,2(D)
MOVSI T,TXTCOD
FSFIX TT,T
POPJ P,
; To introduce a blank line
JBLANK:
LEG HRRZS TXTFLG(I) ;Zero flg portion
LEG SETZM TXTCNT(I) ;The 2,,0 will be added by JUFIX
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I)
LEG SETZM TXTWIN(I) ;clear window ptr for line in current window
SETZ G,
MOVE D,I
ADD D,[440700,,LLDESC]
MOVEI C,40
LEG IDPB C,D
PUSHJ P,JUFIX ;Finish off this line
POPJ P,
; To start new line with the proper margin
JMSTRT: AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I) ;Assign I new serial number
LEG SETZM TXTWIN(I) ;clear window ptr for line in current window
MOVE D,I ;Set up output char pointer
ADD D,[440700,,LLDESC]
IDIVI T,10 ;See if TABs are to be used
LEG HRLZM T,TXTCNT(I) ;Start new TXTCNT (with credit for any TABs)
JUMPE T,J2PAS3 ;No TABs
PUSH P,Q ;Save Q
MOVEI C,11
J2PAS0:
LEG IDPB C,D
MOVEI C,40
MOVEI Q,10 ;Temporary use only
ADDM Q,TXTCNT(I) ;Count as displayed chars. only
J2PAS1:
LEG IDPB C,D
SOJG Q,J2PAS1
MOVEI C,11
LEG IDPB C,D
SOJG T,J2PAS0
POP P,Q ;Restore Q
J2PAS3: JUMPE TT,J2PAS5 ;No extra spaces in JMARG
HRR T,TT
HRL T,TT
ADDM T,TXTCNT(I) ;Count both as stored and as displayed
MOVEI C,40
J2PAS4:
LEG IDPB C,D
SOJG TT,J2PAS4
J2PAS5: POPJ P,
;JSTART JSTAR1 JSTAR2 JSTAR4 JSTAR3 JSTAR5 JSTAR7 JSTAR6 JSTAR9 JSTAR8 JSTARX JSTAR0 JSTA00
JSTART: MOVE A,CHARS
MOVEM A,CHARS2# ;Remember how many chars there were on the page
TRNN F,ATTMOD
JRST JSTAR1
PUSHJ P,JSTAR0 ;Set up expandable FS and remember current place
JRST JSTAR9 ;No arg typed, do entire attach buffer
JUMPG A,JSTAR9
MOVNS A ;Negative argument ignored for attach buffer
JRST JSTAR9
;Here if not in attach mode.
JSTAR1: SKIPN TT,XPLST ;Are there any appended pages?
JRST JSTAR3 ;No
HLRZ T,PMLNBR(TT) ;line number of first pagemark
CAML T,ARRL
JRST JSTAR3 ;On first incore page
JSTAR2: MOVEI C,1(T) ;Line number of first line on page
MOVEI B,-LPMTXT-LLDESC(TT) ;Pointer to the first line
HRRZ TT,(TT)
JUMPE TT,JSTAR4
HLRZ T,PMLNBR(TT) ;line number of next pagemark
CAMGE T,ARRL
JRST JSTAR2 ;Try next page
JSTAR4: HRRZ T,(B)
SKIPN TXTCNT(T)
JRST PPEMPT ;Page is empty
PUSHJ P,JSTAR0 ;Set up expandable FS and remember current place
JRST JSTAR5 ;No arg typed, do entire page
JUMPG A,JSTAR9 ;Don't move arrow
MOVNM A,JCNT
ADD A,ARRL
CAML A,C ;Did he ask for more lines than on the page?
JRST JSTAR6 ;No
MOVE T,ARRL ;Yes, limit it to number on page
SUB T,C
JUMPLE T,JSTARX ;Jump if no text before here to work on
MOVEM T,JCNT
JRST JSTAR5
JSTAR3: HRRZ T,PAGE
SKIPN TXTCNT(T)
JRST PPEMPT ;Page is empty
PUSHJ P,JSTAR0 ;Set up expandable FS and remember current place
JRST JSTAR7 ;No arg typed, start at beginning of page
JUMPG A,JSTAR9
PUSHJ P,ADJARG ;Back up given amount, not beyond beginning of page
JUMPG A,JSTAR9 ;Jump unless no previous lines on this page
JRST JSTARX ;No text to work on
JSTAR5: SKIPA A,C ;Start at beginning of particular incore page
JSTAR7: MOVEI A,1 ;Start at beginning of only incore page
JSTAR6: PUSHJ P,SETARR ;Move to first line of range
CAIA ;Number of lines is already set to infinity
JSTAR9: MOVEM A,JCNT ;Tentative number of lines to work on
TRNE F,ATTMOD
JRST JSTAR8 ;In attach mode we don't care about the window
MOVSI TT,WINBIT
SKIPE T,WINLIN ;Skip if no current known window line
ANDCAM TT,TXTFLG(T)
SETZM WINLIN ;Don't know about window any more
SETOM BOTWIN ;Force window to be recomputed
JSTAR8: TRZ F,ARG ;This is used later to signal the end of data
PUSHJ P,JINIT ;Set E, get JPTR, and correct JCNT value
MOVE B,JPTR ;Return ptr to first line in B
HRLZM B,JFREED# ;Needed here if all blank lines
TRNN F,EDITM ;if coming from line editor, need not be real
SKIPE TXTCNT(B) ;Make sure first line is real text line
POPJ P, ;Okay
JSTARX: PUSHJ P,ENDFIX ;Undo our ENDSET
TLZ F,NOCHK ;Restore FS shuffling
JRST NOTEXT ;No text to work on--pagemark or end of incore text
;Routine to set up expanding FS, remember current arrow line, and skip if arg typed.
JSTAR0: PUSHJ P,JSTA00 ;Set up FS, save arr/win places, get arg
TRNE F,ARG
JRST CPOPJ1 ;Skip return if any arg typed
MOVEI A,-1 ;No arg, do whole page (or whole attach buffer)
MOVEM A,JCNT
POPJ P,
JSTA00: PUSHJ P,ENDSET ;Set up expandable FS
TLO F,NOCHK ;Don't let FS be shuffled on us
MOVE A,ARRLIN ;Remember address of line where arrow came from
MOVEM A,ARRLIS# ; so we can position arrow to same text when done
MOVE A,TOPWIN
MOVEM A,TOPWIS# ;Same for window position
MOVE A,JCNT ;Get number of lines to work on
POPJ P,
;JINIT JINIT3 JINIT2 JPARAM JPARAS JPARAI JPARNN JPARN2 JPAR1 JPAR2 JPAR3 JMREAD JMREA1 JMREA4 JMREA5 JMRDCR JMRNEG JMRERR JMRERL JMRERS JMRUP1 JMRXIT JMRXCT JMRCHK
; To determine E and get corrected JCNT and JPTR values
JINIT: TRNE F,ATTMOD ;Are we in ATTACH mode?
SKIPA E,[JATAB] ; Yes so put [JATAB] in E.
MOVEI E,JPTAB ; No so put [JPTAB] in E.
MOVE D,@JPT1(E) ;Put contents of ATTBUF or ARRLIN in D.
HRRZM D,JPTR# ;Location of first line to examine
MOVE A,@JLPTR(E) ;Number of lines
TRNE F,ATTMOD
JRST JINIT2
SKIPN XPLST ;Skip if more than one page in core
JRST JINIT3
PUSH P,T
PUSH P,TT
PUSHJ P,GPAGL ;Get line,,page of arrow line
MOVEI T,(T) ;Just page number
CAME T,FIRPAG ;Is arrow on first incore page?
HRRZ TT,(TT) ;No, get pointer to next pagemark
JUMPE TT,.+2 ;Jump unless we're on last incore page
HLRZ A,PMLNBR(TT) ;Incore line number of next pagemark
POP P,TT
POP P,T
JINIT3: SUB A,ARRL ;Number of following lines on this page
ADDI A,1 ;Count the current line
JINIT2: CAMGE A,JCNT
MOVEM A,JCNT ;Limit number of lines to the available ones
SETZM JLCHG#
POPJ P,
; Subroutine to read typed-in decimal numbers.
;Returns the number in A, the terminating character in C and a flag in B
;indicating whether or not a number was seen: B is positive if number seen.
; Direct return if nothing typed.
; Skip return if illegal number or name.
; Double skip on success, but not necessarily with any number (flag ret'd in B).
;Clobbers D,E,G,I,J,K,T,TT (mostly with GETNUM).
;Also clobbers Q if taking skip return (error).
JPARAM: SETZB A,B
JPARAS: PUSHJ P,TYI ;Get first character if any
POPJ P, ;Activator
CAIE C," "
CAIN C,11
JRST JPARAS ;Skip leading spaces and tabs
CAIE C,47 ;Single quote is allowed to mean octal number
CAIN C,"-" ;Minus sign means negative number
JRST JPARAI ;Go get number
CAIL C,"0"
CAILE C,"z"
JRST JPARN2 ;Can't be a number or macro, not a letter or digit
CAILE C,"9"
CAIL C,"a"
JRST JPARAI ;Starts with a digit or lower case letter
CAIL C,"A"
CAILE C,"Z"
JRST JPARN2 ;Not letter nor digit
JPARAI: MOVE A,Q ;Save important AC, can't push anything for GETNUM!
PUSHJ P,GETNUM ;Read a number, maybe a macro or rdv name
JRST JPARNN ;No number seen (GETNUM pops up level on error)
MOVE Q,A ;Restore AC
MOVE A,TT ;Return value in A
MOVEI B,1 ;Set B positive to indicate number seen
JRST POPJ2
JPARNN: MOVE Q,A ;Restore AC
JPARN2: SETZB A,B ;Clear flag (no number seen) and return zero value
JRST POPJ2 ;Success return, 'though no number found
REPEAT 0,<
CAIN C," "
JRST JPAR0 ;Extra space allowed here
AOS (P) ;Skip return if something typed
CAIE C,"-"
JRST JPAR2
TLO F,TF1 ;Signal for a neg number
JPAR1: PUSHJ P,TYI ;Get next character
JRST JPAR3 ;End of typing
JPAR2: CAIG C,71
CAIGE C,60
JRST JPAR3 ;Non numeric character
IMULI A,12
ADDI A,-"0"(C)
AOJA B,JPAR1 ;B used to indicate some number (may be zero)
JPAR3: TLZE F,TF1
MOVNS A
POPJ P,
>;REPEAT 0
; To read 4 margin values with possible additional old paragraph margin
;On error, pops up a level and skips, with error message already typed out.
JMREAD: MOVSI Q,-4
MOVSI A,-1 ;-1 may be typed, so initialize to -1,,0
MOVEM A,JPMAR(Q)
MOVEM A,JPMARO(Q) ;Flag that no margins have been typed yet
AOBJN Q,.-2
MOVSI Q,-4
PUSHJ P,XTDLIN ;Prepare to reread extended command line
PUSHJ P,JPARAM ;Read first parameter
JRST TJRXIT ;Nothing typed, make sure we see CR
JRST JMRUP1 ;Error, has already been reported to user
;Here to finish reading new justification margins
CAIE C,"/" ;Was a slash used, meaning JPMARO (old)
JRST JMREA4 ;No
JUMPE B,JMRERR ;Jump if no digits seen
JUMPL A,JMRNEG ;Gotta be non-negative
MOVEM A,JPMARO ;Store margin for recognizing old paragraphs
SETOM JLMARO ;Make left margin for old paragraphs different
JMREA1: PUSHJ P,JPARAM ;Read a parameter
JRST JMRDCR ;Nothing typed
JRST JMRUP1 ;Error, has already been reported to user
JMREA4: JUMPE B,JMREA5 ;B=0 means no number before symbol
MOVEM A,JPMAR(Q)
XCT JMRXCT(Q) ;Take special action for this margin
JMREA5: CAIE C,40 ;A space or a comma may be used
CAIN C,"," ;Any other symbol terminates JGINIT
AOBJN Q,JMREA1
JMRDCR: CAIN C,15
JRST JMRXIT
CAIN C,";" ;This precedes tab fields in TJ commands
TLNN F,TF2 ;Skip if this is TJ type command
JRST JMRERR
JRST JMRXIT
JMRNEG: SORRY Margin values can't be negative.
JRST JMRUP1
JMRERR: SORRX Bad syntax at or just before:
JRST JMRUP1 ;Message is suppressed
PUSHJ P,PRNTC4 ;Print char in C, specially if activator
SKIPN TYIPNT
JRST JMRERS ;Put out space after bad activator
SKIPA A,TYIPNT
JMRERL: OUTCHR C
ILDB C,A ;Loop typing out rest of cmd
JUMPN C,JMRERL
HRRZ C,TYIINS ;Get the activator
PUSHJ P,PRNTC4 ;Print it specially
JMRERS: OUTCHR [" "]
JMRUP1: SETZM TYIPNT ;Ignore rest of command
JRST POPUP1 ;Pop up a level and skip return
;Here when we're done scanning typed margins.
;Now see if we need to unforce the difference between LMARO and PMARO.
JMRXIT: MOVS T,JPMAR
MOVS TT,JLMARO ;This is being set if LMAR is begin set
CAIN TT,-1 ;Skip if input or output left margin begin set now
CAIN T,-1 ;Skip if output paragraph indent being set now
POPJ P, ;No diddling needed
MOVE T,[LMAR,,LMARO] ;PMAR given, but not LMARO nor LMAR
TLNE F,TF2 ;What kind of margins are about to be set?
MOVE T,[TLMAR,,TLMARO] ;Reference TJ margins
SKIPL (T) ;Skip if LMARO was previously forced different
POPJ P,
HLRZ T,T ;Address of output margin
MOVE TT,(T) ;Get current LMAR (not being changed)
MOVEM TT,JLMARO ;Don't force it different anymore (set input
POPJ P, ; from output margin)
;**** The first four words below are a table of words executed by JMREA4 above.
JMRXCT: JSP TT,.+2 ;PMAR is copied to PMARO
JSP TT,.+1 ;LMAR is copied to LMARO
JUMPL A,JMRNEG ;RMAR has to be non-negative (no "old" worries)
JFCL ;BMAR
JMRCHK: MOVS B,JPMARO(Q) ;See if old margin has already been set up
CAIN B,-1 ;Skip if already set up
MOVEM A,JPMARO(Q) ;Save new output margin as input margin
JRST (TT) ;Back to main loop or return
;JUDATA JUS6A JGET JGET1 JGET2 JUTYPE JUTYPO JUTYP3 JUTYP2
;Here to store newly typed margins.
JUDATA: MOVSI Q,-4
JUS6A: MOVE T,JPMARO(Q) ;Get any old-paragraph margin typed
CAML T,[-1] ;-1 or greater is acceptable
MOVEM T,PMARO(Q) ;Store it
MOVE T,JPMAR(Q) ;Get any new-paragraph margin typed
CAML T,[-1]
MOVEM T,PMAR(Q) ;Store it
AOBJN Q,JUS6A
POPJ P,
;JGET command gets typed-in margins from the specified text.
JGET: MOVEM A,JCNT ;Save arg
TLZ F,TF2 ;Flag that we're reading normal margins
PUSHJ P,JMREAD ;Read margins from command first
SKIPN A,JCNT ;Restore arg
JRST JGET2 ;Null arg means don't get margins from text
PUSHJ P,JGINIT
PUSHJ P,JGMAR ;Get margins by examining the text
SETOM BNUM ;Always give default handling of blank lines
MOVSI Q,-3
JGET1: MOVE T,GPMAR(Q) ;Get margins observed in text
MOVEM T,PMAR(Q) ;Make into output margins
MOVEM T,PMARO(Q) ;Make into input margins too
AOBJN Q,JGET1
JGET2: PUSHJ P,JUDATA ;Now override with any given in command
JUTYPE: AOS (P) ;Now type out margins and suppress OK
JUTYPO: SETZM TYOPNT ;Type out justification margins
OUTSTR [ASCIZ/Paragraph on blank line/]
MOVE TT,PMARO
CAMN TT,LMARO
JRST JUTYP3
OUTSTR [ASCIZ/ or on indent = /]
TYPDEC PMARO ;Tell what indentation indicates new paragraph
JUTYP3: OUTSTR [ASCIZ/. Margins (C,L,R,B) are /]
MOVSI Q,-4
SKIPA
JUTYP2: OUTSTR [ASCIZ/,/]
SKIPGE PMAR(Q)
OUTSTR [ASCIZ/-1/]
SKIPL PMAR(Q)
TYPDEC PMAR(Q)
AOBJN Q,JUTYP2
OUTSTR [ASCIZ/.
/]
POPJ P,
;TJ1CR TJ1CR7 TJ1CR0 TJ1CR2 TJROOM TJROM1 TJROM2 TJROM3
; To terminate on a CR
TJ1CR: TLNE F,TF1 ;Is this the first pass?
JRST TJ1CR4 ;No
TJ1CR7: PUSHJ P,PARGET ;Is next line to be considered?
TRNN F,REL
JRST TJ1CR2 ;Yes
TJ1CR0: HRRZM G,JWCOL ;For the second pass
AOS JSCNT
JRST JU3D
; Allow space to end of tab field
TJ1CR2: SKIPE TJADDF ;Is text to go on this line?
JRST TJ1CR0 ;No
PUSHJ P,TJROOM
JRST TJ1CR7 ;All-space line!!!
JRST TJ1CR0 ;Not enough room
ADD G,[2,,2] ;Must allow for at least 2 spaces
MOVE K,TABSPC
CAILE K,(G)
AOBJN G,.-1
HRRZM G,JWCOL
JRST JU2
; To verify that there is some text and room for 1 word
TJROOM: MOVE T,G
ADD T,[2,,2] ;Need 2 spaces for sure
TJROM1: CAILE K,(T) ;but do not start too soon
AOBJN T,TJROM1
JUMPGE T,POPJ1 ;2nd exit if not room
MOVE TT,A
TJROM2: ILDB C,TT
CAIN C,15
POPJ P, ;1st exit if no text here
CAIE C,40 ;Eat leading spaces
CAIN C,11 ;and TABs
JRST TJROM2
TJROM3: ILDB C,TT
CAIN C,40
JRST POPJ2 ;3rd exit if both text and room
CAIE C,11
CAIN C,15
JRST POPJ2
AOBJN T,TJROM3
JRST POPJ1
;TJ1CR4 TJ1CR5 TJ1CR6 TJ1TAB TJ1CH TJ2TAB TJ2SP TJ2SP1 TJ2SP2 TJ1DSP TJ2DSP TJ2PUN TJ3TAB TJ3CH TJ3DSP
; Second pass
TJ1CR4: TRNN F,REL
SKIPE TJADDF
JRST JU4A ;We are through
MOVEI C,40
LEG IDPB C,D ;Must have at least 2 spaces
LEG IDPB C,D
ADD G,[2,,2]
MOVE K,TABSPC
TJ1CR5: CAIG K,(G)
JRST TJ1CR6
LEG IDPB C,D
AOBJN G,TJ1CR5
TJ1CR6: MOVEI DSP,J1DSP
MOVSI H,JALL
JRST JU4
; To keep odd-even count on tabs and to eat them
TJ1TAB: MOVNS ODDEVN#
JRST J1SP ;MOVNI C,3↔ADDM C,(P)↔POPJ P,
TJ2TAB: ADD A,[70000,,0] ;Back up so odd-even count will work
CAIG A,0
SUB A,[430000,,1]
SOJA J,TJ2SP1 ;Correct for the AOJ which follows
; To test if there is more than 1 space (indicating the end of an entry)
TJ2SP: MOVE TT,A
ILDB C,TT ;Sneak look at the next character
CAIE C,40
CAIN C,11
JRST TJ2SP1
MOVEI C,40
POPJ P, ;Single spaces are allowed in tab fields
TJ2SP1: TLNN F,TF1 ;Which pass?
JRST TJ2SP2
MOVEI C,40 ;It could have been a tab
LEG IDPB C,D
LEG IDPB C,D
AOS (P) ;For the extra instruction in second-pass loop
TJ2SP2: AOBJN G,.+1 ;Count only 1 here and save second count until later
AOJA J,POPJ1 ;Also account for only 1 input char, and exit from loop
; Dispatch table to eat to next tab field
TJ1DSP: JRST TJ1CR ;CR
PUSHJ P,TJ1TAB ;TAB (odd-even checked then eaten)
AOS J ;Space (counted to TABENO)
PUSHJ P,POPJ2 ;Punctuation (exit from loop)
PUSHJ P,POPJ2 ;Closure " " "
PUSHJ P,POPJ2 ;Other character " " "
; In-text dispatch table to look for a TAB or a CR
TJ2DSP: JRST TJ1CR ;CR
PUSHJ P,TJ2TAB ;TAB
PUSHJ P,TJ2SP ;SP
PUSHJ P,TJ2PUN ;Punctuation (test for 3 spaces to end field)
JFCL
JFCL
TJ2PUN: MOVEI DSP,TJ3DSP
MOVSI H,JALL
POPJ P,
TJ3TAB: MOVEI DSP,TJ2DSP
MOVSI H,JUSF
MOVEI C,40
TLNE F,TF1
LEG IDPB C,D
AOS J
AOBJN G,TJ2TAB
JRST TJ2TAB
; To revert to normal if char. follows pun.
TJ3CH: MOVEI DSP,TJ2DSP
MOVSI H,JUSF
POPJ P,
; Dispatch table for use after punctuation
TJ3DSP: JRST TJ1CR ;CR
PUSHJ P,TJ3TAB ;TAB
PUSHJ P,TJ3CH ;SP (1st space after pun. treated as normal char.)
JFCL ;Punctuation
JFCL ;Closure
PUSHJ P,TJ3CH ;Normal char.
;TABLE TJFILL TJUST TJUST0 TJDATA TJUS6 TJUS7 TJUS9 TJUS10
; To reformat previously formatted files which have missing entries
TABLE: SETOM TABFLG ;Marks this as a TABLE command
SETZM TEXTRA# ;Extra text message flag
TRO F,NEG ;To be sure
JRST TJUST0
; To reformat tables with no missing entries (may have appended information)
TJFILL: TROA F,NEG
TJUST: TRZ F,NEG
SETZM TABFLG ;Marks these as TJF or TJU commands
TJUST0: TLO F,TF2 ;Signal that this is a T type command
TLZ F,TF3 ;But not a JSEPARATE
MOVEM A,JCNT ;Temporary value only
PUSHJ P,JMREAD ;Read typed margin values
PUSHJ P,TJREAD ;Read typed tab fields
PUSHJ P,TJDATA ;Store new margins and tab fields
SKIPN JCNT ;Is this for real or for show?
JRST TJTYPE ;Type out current margins
MOVE T,[TABTAB,,TABOLD]
SKIPLE TABOLD ;(KLUDGE) If no previous TABLE command, use new fields
SKIPL TABFLG ;Skip if TABLE command
BLT T,TABOLD+TABCNT-1 ;Copy current tab fields into "old" versions
JRST JUST2 ;Go do the justification
;Here before doing a TJustification to store any new margins/tabs fields typed.
TJDATA: SKIPN TJRFLG ;Were some TABTAB changes made?
JRST TJUS6
MOVE T,[TABTAB,,TABOLD]
SKIPGE TABFLG ;Skip unless TABLE command
BLT T,TABOLD+TABCNT-1 ;(KLUDGE) Save old tab fields
MOVE T,[BUF2,,TABTAB]
BLT T,TABTAB+TABCNT-1 ;Get new tab fields
TJUS6: MOVSI Q,-4
TJUS7: MOVE T,JPMAR(Q)
CAML T,[-1]
MOVEM T,TPMAR(Q)
MOVE T,JPMARO(Q)
CAML T,[-1]
MOVEM T,TPMARO(Q)
AOBJN Q,TJUS7
MOVE TT,TPMAR ;Start TJADJ off right
PUSHJ P,TJADJ ;Adjust them
SKIPL TABFLG ;Skip if TABLE command
POPJ P,
MOVSI Q,-TABCNT
TJUS9: SKIPG TABOLD(Q)
JRST TJUS10
SKIPLE TABTAB(Q)
AOBJN Q,TJUS9
SORRY Too few output fields specified.
JRST JMRUP1 ;Pop up a level and skip return
TJUS10: SKIPLE TABTAB(Q)
OUTSTR [ASCIZ/CAUTION, unequal field counts. /]
POPJ P,
;SJFILL SJUST JFILL JUST JUST0 JUST2 JU1A JU1B JU1D
; To separate text into individual sentences, either filled or justified
SJFILL: TROA F,NEG
SJUST: TRZ F,NEG
TLZ F,TF2 ;Not a TJ command
TLO F,TF3 ;Flag a sentence separating command
SETZM SJFAKE ;No fake paragraph for us yet
JRST JUST0
; To left margin justify and, alternatively, to justify both margins
JFILL: TROA F,NEG ;For JFILL case
JUST: TRZ F,NEG ;For JUST case
TLZ F,TF2!TF3 ;Neither a TJ nor a JS command
JUST0: MOVEM A,JCNT ;Preliminary value only
PUSHJ P,JMREAD ;Read typed margin values
PUSHJ P,JUDATA ;Accept typed values
SKIPN JCNT ;Is this for real or for show?
JRST JUTYPE ;Type out margins and return to main loop
JUST2: PUSHJ P,JSTART ;Set up expanding Free Storage, various pointers
; Procede with justification
MOVSI H,JALL ;Set to dispatch on all characters
MOVEI DSP,J1DSP ;Set dispatch for new output line
TRZ F,REL ;Means not new par. on first pass
TLNE F,TF2 ;But is it a XTA OR XTJ command?
TRO F,REL ;Yes, first line considered new par.
SETZM JBUGR ;Bugger factor that staggers inserted spaces
JU1A: SKIPN TXTCNT(B)
JRST JU8
HRRZ C,TXTCNT(B) ;Is this line blank?
JUMPN C,JU1B ;No
HRRZ B,(B) ;Skip over it
MOVEM B,JPTR ;Initial blank lines are left but signal new par
SOSG JCNT ;One less line to process
JRST JU8
TRO F,REL ;Means new par. indent to start
JRST JU1A
JU1B: HRLZM B,JFREED ;Start of storage to be freed and count in right
PUSHJ P,JNEW ;Get space for new lines and fix flags etc.
TRNN F,REL ;Already know that new par. indent is to be used
PUSHJ P,PARG0 ;Is this the start of a par?
MOVE A,B
ADD A,[440700,,LLDESC]
JU1D: TLNE F,TF2 ;Was this a TJ command
JRST JU1E ;Yes
; Get normal margins
MOVE G,LMAR
TRNE F,REL ;No new par indent if 0
MOVE G,PMAR
MOVEM G,JMARG ;Save as current margin for second pass
SUB G,RMAR
JRST JU1F
;JU1E JU1F JU2 JU3 JU3A1 JU3AA JU3A JU3BB JU3B JU3D JU3E
; Get TJ margins
JU1E: MOVE G,TLMAR
TRNE F,REL ;No new par indent if 0
MOVE G,TPMAR
MOVEM G,JMARG ;Save as current margin for second pass
SUB G,TRMAR
JU1F: MOVNM G,JSIZE ;The expected size of new line less margin
SUBI G,1 ;Go 1 char. beyond on the first pass
HRLZS G
MOVEM A,ASAVE
SETZM JSCNT ;To count word separators
MOVE C,JCNT
MOVEM C,JCNTC
TLNE F,TF2
TRNN F,REL
SKIPA
JRST TJU1 ;Go to TJ routine if TJ command and new par
JU2: MOVEI DSP,J1DSP ;Always eat initial spaces
MOVSI H,JALL
TLZ F,TF1 ;Set for first pass
TRZ F,REL ;Must be redetermined during first pass
;First pass
; Determine accepted-char. count, # of word separators and par. conditions
JU3: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be .-2, ., .+1 or .+2
AOBJN G,JU3
;Test for type of termination of first-pass loop
JU3A1: SKIPLE JSCNT ;Have we come to a word break?
JRST JU3AA ;Normal case
TRNE G,77777 ;Is there some text?
JRST JU3 ;Yes, impossible to break line so go on
;Special treatment for stand-alone line with only spaces and/or tabs
SETZM JWCOL
SETZM JMARG ;Don't try to indent an empty line
JRST JU3D
JU3AA: SETZM JSINC ;Safety precaution only
; Verify par. conditions
TRNE F,REL ;Have we already determined par. conditions?
JRST JU3D ;Yes
LDB C,A ;GET last char. back
CAIN C,15 ;Was it a CR?
JRST JU3B ;YES, so no further testing needed
SKIPA
JU3A: ILDB C,A
CAIE C,40
CAIN C,11
JRST JU3A ;Eat all spaces and TABs
CAIN C,15 ;Now do we find a CR?
PUSHJ P,PARGET ;Yes, so look at next line
JU3B: TRNN F,NEG!REL ;Is this a JFILL or a last line of par.
SOSG JSCNT ;Do not count final word ending
JRST JU3D ;Line must be left un-justified
; Prepare for justification
MOVE T,JSIZE
SUB T,JWCOL
LSH T,3 ;Multiply by 8
MOVEM T,JSINC
MOVN G,JSIZE
SETZM JSIZE ;Used in the J2SP2 routine for accumulated JSINC
SETZM JWPT ;Used in J2SP2 for accumulated insertions
SKIPA
JU3D: MOVN G,JWCOL ;Un-justified case
HRLZS G
; Prepare for the second pass
TLO F,TF1 ;Set for second pass
MOVE T,JMARG ;Get correct current margin value
PUSHJ P,JMSTRT ;Start new line with this margin
MOVE A,ASAVE
MOVE B,JPTR
MOVSI H,JALL
MOVEI DSP,J1DSP ;Always eat initial spaces
TLNE F,TF2
SKIPL TF2FLG ;Is set to -1 on first pass of table line
JRST JU3E
SETZM TF2FLG
JRST TJU1 ;For second pass on table line
JU3E: JUMPN G,JU4 ;Normal case
MOVEI C,40 ;Special treatment for line with only spaces or tabs
LEG IDPB C,D
JRST JU4A
;JU4 JU4A JU4B JU5 JU5A JU5B JU5E JU5F JU5C JU5D JU6 JU6D JU7 JU8 JU8L JU8X JUDONE JUDON2 JUDONX
; Main character transfering loop
JU4: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be to .-2, ., or .+1
LEG IDPB C,D
AOBJN G,JU4
JU4A: PUSHJ P,JUFIX ;Fix up line just finished
TRNE F,ARG ;Is text exhausted?
JRST JU6D ;Yes
TLZ F,TF1 ;Get set for new first pass
TLNE F,TF3 ;Was it a SJ command?
JRST JU5E ;Yes
TRNN F,REL ;Is it to be a new par?
JRST JU6 ;No
TLNE F,TF2 ;Is it a TJ command
MOVE Q,TBNUM ;Yes, so use proper value
TLNN F,TF2
JU4B: MOVE Q,BNUM
JUMPLE Q,JU5B
JU5: SOS Q
JU5A: PUSHJ P,JMORE ;Get space
PUSHJ P,JBLANK ;Introduce blank line
JU5B: PUSHJ P,NEXTLI
SKIPE TXTCNT(B) ;Maybe not a text line
SOSG JCNT
JRST JU7 ;No more text
HRRZ T,TXTCNT(B)
JUMPN T,JU5C
CAMN B,ARRLIS
MOVEM I,ARRLIS
JUMPG Q,JU5
JUMPL Q,JU5A
JRST JU5B
; Special treatment for XJS command
JU5E: SKIPE SJFAKE ;Skip unless this is fake paragraph
TRZ F,REL ;Use LMAR indent
MOVE T,A
JU5F: ILDB C,T ;Sneak look ahead
CAIE C,40
CAIN C,11
JRST JU5F
CAIE C,15
JRST JU6 ;Not a input line break
SETO Q, ;Flag no blank lines needed unless new paragraph
TRNN F,REL ;Is this really a new paragraph?
JRST JU5B ;No, only fake one for SJF
JRST JU4B
JU5C: JUMPLE Q,JU6
JU5D: PUSHJ P,JMORE
PUSHJ P,JBLANK
SOJG Q,JU5D
JU6: PUSHJ P,JMORE
JRST JU1D
JU6D: PUSHJ P,NEXTLI ;Give up final old line
;Complete the links to the following text
JU7: MOVE T,JLPT ;Now fix new right link
HRRM B,(T) ;A references next line
HRLM T,(B) ;And backward link to the new line
JU8: PUSHJ P,ENDFIX
;It should be safe to FSGIVE now
HLRZ A,JFREED
HRRZ Q,JFREED
JUMPE Q,JU8X
JU8L: HRRZ B,(A) ;Save pointer to next block
PUSHJ P,FSGIVE ;Give up one FS block
MOVEI A,(B)
SOJG Q,JU8L ;Do this for all the old lines
JU8X: TLZ F,NOCHK
SKIPG BLAB ;Verbose?
JRST JUDONE
MOVE T,CHARS ;Report change in CHARS
SUBB T,CHARS2
MOVMS T
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/ characters /]
SKIPL CHARS2
OUTSTR [ASCIZ/added. /]
SKIPGE CHARS2
OUTSTR [ASCIZ/removed. /]
AOS (P) ;Suppress the OK now
JUDONE: PUSHJ P,JEXIT(E) ;Fix up everything wrt changed text
TRNE F,ATTMOD
POPJ P, ;Arrow was not moved in attach mode
MOVEI B,PAGE ;Look for free storage with original arrow's text
MOVEI A,1 ;Count incore lines
JUDON2: HRRZ B,(B) ;Next line
CAMN B,ARRLIS ;Is this the line where original arrow's text is?
JRST JUDONX ;Yes, move arrow to this line
CAIE B,BOTSTR ;End of incore text?
AOJA A,JUDON2 ;No, keep looking
PUSHJ P,TELLZ ;We failed to find the right line for the arrow
JUDONX: PUSHJ P,SETARR ;Restore arrow to line where everything started
SETZM ARRLIS ;Force fatal error if this cell not set next time
MOVE A,TOPWIS
JRST SETWIN ;Restore window too
;IND IND0 IND2 IND3 IND4 IND4A IND5 IND6 IND7 INDTYP INDTY2 INDENT INREAD INREA8 INREA0 INREA9 INRE6A INREA6 INREA4 INREA2 INREA3 INREA7 INREA5
; Common routine jumped to from CENTER, INDENT, ALIGN with Q set up differently
IND: MOVE C,AMARS ;Get current tab/space indicator
MOVEM C,JBUGR ;Signal to J5TAB as to interior TAB treatment
IND0: MOVE A,CHARS ;CENTER enters here with JBUGR zeroed
MOVEM A,CHARS2
PUSHJ P,JSTA00 ;Set up expanding FS and save arr/win places
TRNE F,ATTMOD
JRST IND2
JUMPGE A,IND3
PUSHJ P,ADJARG ;Adjust argument and back up if neg
JUMPG A,IND3 ;Jump unless no previous lines on page
PUSHJ P,JSTARX ;No text to work on, this PUSHJ doesn't return!
IND2: SKIPGE A
MOVNS A ;NEG value has no meaning if in ATTACH
TRNN F,ARG
MOVEI A,-1 ;Do entire ATTACH buffer if no argument
IND3: MOVEM A,JCNT ;Tentative count of lines to process
PUSHJ P,JINIT ;Set E, get JPTR and correct JCNT
MOVE B,JPTR
HRLZM B,JFREED ;Needed here as well as in IND4A if all blank lines
IND4: SKIPN TXTCNT(B)
JRST JU8 ;A non-text line
HRRZ C,TXTCNT(B) ;Is this a blank line?
JUMPN C,IND4A
HRRZ B,(B)
SOSG JCNT
JRST JU8 ;No non-blank lines (finish off as in JUST)
JRST IND4 ;Delay starting until first non-blank line
IND4A: HRLZM B,JFREED ;Save starting location for FSGIVE
PUSHJ P,JNEW ;Get space for first line
IND5: SETZ T, ;Used to count leading spaces
MOVEM C,JWCOL ;Save character count for use in CENTER
MOVE A,B
ADD A,[440700,,LLDESC]
MOVSI G,-77777
MOVEI DSP,J4DSP
MOVSI H,JALL
SETZ T,
; Main loop
IND6: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
LEG IDPB C,D
AOBJN G,IND6
PUSHJ P,JUFIX ;Add CRLF and finish off this line
IND7: PUSHJ P,NEXTLI
SKIPE TXTCNT(B) ;A non-text line
SOSG JCNT
JRST JU7 ;No more lines (finish as for JUST)
PUSHJ P,JMORE ;Get space for nest line
HRRZ C,TXTCNT(B) ;Is the next line blank?
JUMPG C,IND5
PUSHJ P,JBLANK ;Put in the blank line
JRST IND7
; To report tab flag and value for INDENT or ALIGN
INDTYP: SETZM TYOPNT
PUSHJ P,ABCRLF
SKIPN Q
OUTSTR [ASCIZ/Default indent = /]
SKIPE Q
OUTSTR [ASCIZ/Default align margin = /]
MOVE C,AMAR ;Align margin
JUMPN Q,INDTY2 ;Jump if from ALIGN command
MOVE C,INMAR ;Indent margin
JUMPGE C,INDTY2
MOVNS C
OUTSTR [ASCIZ/-/]
INDTY2: TYPDEC C
SKIPE AMARS
OUTSTR [ASCIZ/; mode T: internal Tabs retained.
/]
SKIPN AMARS
OUTSTR [ASCIZ/; mode S: internal tabs changed to Spaces.
/]
JRST POPJ1
INDENT: MOVEM A,JCNT ;Save arg for later use
PUSHJ P,INREAD ;Read tab flag and argument, if any
MOVEM A,INMAR ;Store given indentation change
MOVEI Q,0 ;Signal to J4CH to use INDENT margin code
SKIPN JCNT
JRST INDTYP ;Report only
JRST IND
; To read tab flag letter and indentation value for ALIGN or INDENT
;Returns indentation value in A. B is positive iff a number was seen, else 0.
;If sees a T or S, sets AMARS accordingly (-1 is T, 0 if S) (unless error).
;On error, pops up a level and skips, with error message already typed out.
;Skips if no number seen.
INREAD: PUSHJ P,XTDLIN ;Prepare to reread extended command line
MOVE A,AMARS
MOVEM A,AMSTMP ;set "new" space/tab flag to old default
SETZM A,B ;Assume no number will be seen
PUSHJ P,SKPSP3 ;Read first char (TYI) and skip leading spaces
JRST INREA7 ;Activator
CAIE C,"T"
CAIN C,"t"
JRST INREA9 ;Kludge to see if this is delimited T or S
CAIE C,"S"
CAIN C,"s"
JRST INREA9
INREA8: PUSHJ P,JPARAI ;Read a decimal number into A, flag into B
CAIA ;Nothing typed
JRST JMRUP1 ;Error, already reported to user
PUSHJ P,TYIT ;Have we seen activator
JRST INREA7 ;Yes, finish off cmd line
INREA0: CAIE C,11 ;Ignore tab or space (maybe can't happen since
CAIN C," " ; JPARAM/GETNUM flush leading & trailing spaces)
JRST INREA4 ;Space may be followed by T/S flag and/or number
TRZ C,40 ;Force upper case
CAIE C,"T"
JRST INREA2
SETOM AMSTMP ;keep internal tabs
JRST INREA3
INREA9: MOVE TT,C ;Save first char (T or S)
PUSHJ P,TYI ;Get char after T or S
JRST INRE6A ;Activator, just had plain T or S
CAIE C," "
CAIN C,11
JRST INREA6 ;Delimited T or S, set flag
MOVE C,TT ;Restore first char
TESTBP TYIPNT ;make sure byte ptr hasn't already been backed up
MOVSI T,70000 ;Haven't finished reading cmd line, so this
ADDM T,TYIPNT ; will work to put back the char we peeked at.
JRST INREA8 ;Now see if the is a macro or rdv name
INRE6A: TDZA T,T ;Flag activator already seen
INREA6: MOVEI T,-1 ;No activator yet
TRZ TT,40 ;Force upper case
CAIN TT,"T"
SETOM AMSTMP ;Flag T mode, retain tabs
CAIN TT,"S"
SETZM AMSTMP ;Flag S mode, convert tabs to spaces
JUMPE T,INREA7 ;Jump if already seen activator, don't read more
PUSHJ P,JPARAM ;Look for an indent value now
JRST INREA7 ;Nothing typed, finish off cmd line
JRST JMRUP1 ;Error, already reported to user
JRST INREA7 ;Got number in A, finish up
INREA4: JUMPLE B,INREAD ;Start over if we haven't seen a number yet
PUSHJ P,TYI ;Get next char, thus ignoring the space
JRST INREA7 ;Activator, no more to read
JRST INREA0
INREA2: CAIE C,"S"
JRST INREA5
SETZM AMSTMP ;turn internal tabs to spaces
INREA3: PUSHJ P,TYI ;Get final char
JFCL
INREA7: CAIE C,11
CAIN C," "
JRST INREA3 ;Trailing spaces are okay and ignored
CAIE C,15 ;Better end with CR
JRST INREA5 ;Bad command syntax
PUSH P,AMSTMP ;OK, make space/tab flag permanent
POP P,AMARS ;This is the permanent cell
JUMPLE B,POPJ1 ;Skip if no number seen
POPJ P,
INREA5: SORRY Only S or T flag and/or one indentation value permitted.
JRST JMRUP1 ;Pop up a level and skip, clear input pointer
;CENTER CENT3 ALIGN RTARR LFARR
CENTER: MOVEM A,JCNT ;Save arg for later
SETZM JBUGR ;Center always replaces interior TABs with spaces
TLZ F,TF2 ;Flag reading routine to reference LMARO not TLMARO
PUSHJ P,JMREAD ;Read typed margin values
CAIE C,15
PUSHJ P,JMRERR ;Syntax error -- this pushj doesn't return!!
PUSHJ P,JUDATA ;Store typed-in values
SKIPG JCNT
JRST CENT3 ;Just type out the margins
MOVE T,RMAR
SUB T,LMAR
MOVEM T,JSIZE ;Use for centering
MOVEI Q,1 ;Signal to J4CR to use CENTER margin code
JRST IND0 ;use same routine as INDENT
CENT3: PUSHJ P,JUTYPO
JRST POPJ1
; ALIGN command aligns all specified lines at a fixed left margin
ALIGN: MOVEM A,JCNT ;Save arg for later
PUSHJ P,INREAD
MOVMM A,AMAR ;Store given margin, not allowed to be negative
MOVEI Q,2 ;Signal to J4CH to use code for ALIGN
SKIPN JCNT
JRST INDTYP ;Report only
JRST IND
; Moves the specified lines right by the (absolute) INMAR value
RTARR: MOVEM A,JCNT ;Save arg for later
MOVEI Q,3
JRST IND
; Moves the specified lines left by the (absolute) INMAR value
LFARR: MOVEM A,JCNT ;Save arg for later
MOVEI Q,4
JRST IND
;TB1SP TB1SP8 TB1SP3 TB1SP4 TB1SP1 TB1SP2 TBISP5 TB1SP6 TB1SP7 TB1TAB TB1TB1 TB1TB2 TB1TB3
;Routines used by TIN
;Action on finding a space
TB1SP: JUMPE Q,TB1SP1
AOS K
TB1SP8: AOS Q
TRNE K,7
JRST TB1SP2 ;Look further
MOVEI TT,11 ;We can use a TAB here
LEG IDPB TT,D
AOS TXTCNT(I) ;Account for the TAB
TB1SP3: ;Now put in the spaces that we have counted
LEG IDPB C,D
SOS TXTCNT(I)
AOBJN G,.+1
SOJLE Q,TB1SP4
IBP A ;Already indexed once so 1 less than Q
JRST TB1SP3
TB1SP4:
LEG IDPB TT,D ;Add the closing TAB
JRST TB4
TB1SP1: HRRZ K,G
AOS K
TRNN K,7
; JRST TB4A ;We do not use TABs for single spaces
JRST TB1SP6 ;Look into this case
AOS Q ;Count this space
MOVE J,A ;Sneak look ahead
TB1SP2: ILDB T,J
TDNE H,JCTAB(T)
XCT @JCTAB(T)
;A non-space occurred too soon so copy the spaces and go back to the main loop
TBISP5:
LEG IDPB C,D ;C was left with a space in it
AOBJN G,.+1
SOJLE Q,TB4
IBP A ;We had indexed once in the main loop
JRST TBISP5
;Space in TAB-end position requires more attention
TB1SP6: MOVE J,A
MOVEI TT,10 ;Sneak look 8 characters ahead
TB1SP7: ILDB T,J
CAIN T,11
JRST TB1SP8 ;Use TAB if single space is followed by a TAB
CAIE T,40
JRST TB4A ;Do not use a TAB in this case
SOJG TT,TB1SP7
JRST TB1SP8 ;Use TAB if followed by 8 more spaces
;Action on finding a TAB
TB1TAB:
JUMPE Q,TB1TB2 ;Maybe no leading spaces to be adsorbed
LEG IDPB T,D ;write the TAB out for sure
AOS TXTCNT(I)
TB1TB1:
LEG IDPB C,D ;C contained the first space to be adsorbed spaces
SOS TXTCNT(I)
AOBJN G,.+1
IBP A
SOJG Q,TB1TB1
JRST TB1TB3 ;Now for the inside spaces
;No preceding space case
TB1TB2:
LEG IDPB C,D ;This is the TAB
AOS TXTCNT(I)
TB1TB3: ILDB C,A
LEG IDPB C,D
CAIE C,40
JRST TB4 ;Back to the main loop
SOS TXTCNT(I)
AOBJN G,TB1TB3 ;Should always be neg.
;TB1DSP TIN SIN TB1 TB3A TB3B TB3D TB3E TB4 TB4A TB4B TB5 TOUT3 TOUT4
;Dispatch table for introducing TABs
TB1DSP: JRST TB4B ;CR we should never get here
JRST TB1TAB ;TAB
JRST TB1SP ;Space
JFCL
JFCL
JFCL
;Tabs IN and Spaces IN commands (TIN also removes trailing TABs/spaces from lines)
TIN: MOVSI H,JUSF
MOVEI DSP,TB1DSP
TLZA F,TF2
SIN: TLO F,TF2
MOVEM A,JCNT
PUSHJ P,JSTART ;Set up expanding Free Storage, various pointers
PUSHJ P,JNEW
MOVSI H,JUSF
TB1: MOVE A,B
ADD A,[440700,,LLDESC]
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I)
LEG SETZM TXTWIN(I) ;clear window ptr for line in current window
LEG SETZM TXTCNT(I)
MOVE D,I
ADD D,[440700,,LLDESC]
HRRZ T,TXTCNT(B) ;Get character count
MOVN G,T
JUMPE T,TB3D ;Blank lines handled the same for TIN and TOUT
TLNE F,TF2
JRST TOUT3 ;A TOUT command
;First trim trailing spaces/TABs
IDIVI T,5
ADD T,A ;Sure to be before the CR
TB3A: ILDB C,T ;Go forward to it
CAIE C,15
JRST TB3A
TB3B: ADD T,[70000,,0] ;Now back to last good character
SKIPGE T
SUB T,[430000,,1]
LDB C,T
CAIN C,40
AOJA G,TB3B
CAIN C,11
JRST TB3B
JUMPN G,TB3E
TB3D: MOVEI C,15 ;Signals JUFIX for empty line
LEG IDPB C,D
JRST TB5
TB3E: HRLZS G
SETZ Q,
;Replace spaces by TABs where feasable and desirable
TB4: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
TB4A:
LEG IDPB C,D
AOBJN G,TB4
;Last character has been processed (it will have been a non-space/tab)
TB4B: HRLZS TXTCNT(I) ;TABs less included spaces count
TB5: PUSHJ P,JUFIX ;Finish off the line
HRRZ T,(B)
SKIPE TXTCNT(T) ;Not a text line
SOSG JCNT ;Is there more text?
JRST JU6D ;No
PUSHJ P,JMORE ;Get space for next line
PUSHJ P,NEXTLI ;Get next input line
CAMN B,ARRLIS ;Is it old arrow line?
MOVEM I,ARRLIS ;Yes, remember output line for new arrow line
JRST TB1
TOUT3: HRLZS G
TOUT4: ILDB C,A
CAIN C,11
JRST TOUT4
LEG IDPB C,D
AOBJN G,TOUT4
JRST TB5
;JGINIT JGINI2 JGB0 JGB JGB1 JGB1A JGB1B JGB2 JGB3 JGB4 JGIND JGIND1 JGMAR JGMA
; Subroutine called by JGET and TJGET
;to clear PAR table and to read and store typed-in MAR values.
JGINIT: TRNN F,ARG
MOVEI A,-1 ;Use rest of page (or buffer) if no argument
MOVMM A,JCNT
JUMPGE A,JGINI2
PUSHJ P,ADJARG ;Back up for negative arg and limit to amt there
JUMPLE A,NOTEXT ;No previous text, abort command
MOVEM A,JCNT ;Remember adjusted arg (positive now)
JGINI2: JUMPE A,CPOPJ ;No text referencing
PUSHJ P,JINIT ;Set E and get proper JPTR and JCNT values
SKIPN TXTCNT(D) ;Is first line a non-text line?
JRST NOTEXT ;Yes, abort this command
MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE# ;May be needed again later
POPJ P,
; Subroutine called by JGMAR
;Will locate the first non-blank line after 1 or more blank lines and
;return the number of blank lines in B (B set to 0 before entry).
;Pointer to the first line of text in D and the specification of the number
;of lines of text (as a negative number) in the left of G.
JGB0: HRRZ D,(D)
JGB: HRRZ C,TXTCNT(D)
JUMPN C,JGB1
AOJA B,JGB2 ;Count blank lines for JBNUM
JGB1: CAMLE C,Q
MOVE Q,C ;Put largest in Q for JRMAR
JUMPE B,JGB2
MOVEM B,GBNUM ;Save it here always
MOVEM G,GSAVE ;May be needed twice
MOVEM D,DSAVE# ;Save new starting place in text
JRST JGB1B
JGB1A: HRRZ D,(D) ;Go to end for Q determination
HRRZ C,TXTCNT(D)
CAMLE C,Q
MOVE Q,C
JGB1B: AOBJN G,JGB1A ;Are we at the end?
MOVE G,GSAVE ;Reset for first line after blanks
MOVE D,DSAVE
POPJ P, ;Text found after a blank line
JGB2: AOBJN G,JGB0 ;Still looking
MOVE D,JPTR ;No text found after blank line, so reset
MOVE G,GSAVE
SETZ B, ;Use B now to count lines having same indent
MOVEM B,GBNUM ;This says no blank lines in text
PUSHJ P,JGIND ;Get first line indent
JFCL ;Blank line
HRRZ TT,T ;Save it
JGB3: AOBJP G,JGB4
HRRZ D,(D) ;Try the next line
PUSHJ P,JGIND
JFCL ;Blank line
CAIN TT,(T)
AOJA B,JGB3 ;Another line with the same indent
JUMPE B,JGB4 ;More than 1 line with same indent?
MOVEM G,GSAVE
MOVEM D,DSAVE
POPJ P,
JGB4: MOVE G,GSAVE ;Go back to first line if B still zero
MOVE D,JPTR
POPJ P,
;To get indentation
;Skips unless is blank line
JGIND: HRRZ T,TXTCNT(D)
JUMPE T,CPOPJ ;Return zero if blank line
MOVNS T
HRLZS T
MOVE A,D
ADD A,[440700,,LLDESC]
JGIND1: ILDB C,A
CAIN C,11 ;Is it a TAB?
JRST JGIND1 ;Ignore it (it'll have explicit spaces near it)
CAIN C," " ;Is it a space?
AOBJN T,JGIND1 ;Count it
JRST POPJ1
; Subroutine called by JGET and TJGET
;To determine margins from specified text
JGMAR: MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE ;May be needed twice
MOVE D,JPTR ;Pointer to the first line of text
SETZB B,Q ;B counts blank lines, Q gets JRMAR
PUSHJ P,JGB ;Find paragraph start
PUSHJ P,JGIND ;Get its indentation
JFCL ;Blank line
MOVEM T,INDCNT# ;May be needed for TJGET case
MOVEM A,ASAVE# ;and also pointer to first non-blank character
HRRZM T,GPMAR
AOBJP G,JGMA ;Trouble, not enough lines
HRRZ D,(D)
PUSHJ P,JGIND ;Get indentation of the next line
MOVE T,GPMAR ;Blank line, use PMAR for LMAR
JGMA: HRRZM T,GLMAR
MOVEM Q,GRMAR ;No, so save this value
POPJ P,
;TJREAD TJR2 TJR5B TJR6 TJRXIT TJRMUL TJR3 TJR3A TJRRGT TJR8 TJR7 CLRTYI TJADJ TJADJ1 TJADJ2 TJADJ3 TJADJ4
; To read typed tab values
;On error, pops up a level and skips, with error message already typed out.
TJREAD: SETZM TJRFLG
CAIE C,";"
JRST TJRXIT ;No typed TAB values, make sure we have a CR
SETOM TJRFLG#
HRLI T,TABTAB
HRRI T,BUF2
BLT T,BUF2+TABCNT-1 ;Use BUF2 temporarily
MOVSI Q,-TABCNT
HLLZS BUF2(Q) ;Zero indent values only
AOBJN Q,.-1
MOVSI Q,-TABCNT
TJR2: PUSHJ P,JPARAM ;Read a number or name
JRST TJRXIT ;No more data, better have found CR
JRST JMRUP1 ;Error, already reported to user
CAIN C,"@" ;Is this a multiple define?
JRST TJRMUL ;Yes
CAIN C,"!" ;Is this a rightmost col specification?
JRST TJRRGT ;Yes
JUMPL A,TJR8 ;Jump if found a negative width--end of fields
JUMPE A,TJR5B ;Was a number typed? If not, keep old field
JUMPG Q,TJR7 ;Jump if no field slots left
HRLZM A,BUF2(Q) ;Save it as a field length
TJR5B: AOBJN Q,.+1
TJR6: CAIN C,"," ;Any more fields
JRST TJR2 ;Yes
TJRXIT: CAIE C,15
JRST JMRERR ;Syntax error
POPJ P,
TJRMUL: JUMPLE A,JMRERR ;Repeat count must be positive or else error
MOVE H,A ;Yes, so save repetition number in H
PUSHJ P,JPARAM ;and get field size
JRST TJRXIT ;No value typed, means keep old fields, done
JRST JMRUP1 ;Error, already reported to user
JUMPL A,JMRERR ;Negative field size is illegal in multiple form
TJR3: JUMPE A,TJR3A ;A zero or missing value means leave unchanged
JUMPG Q,TJR7 ;Jump if have run out of field slots
HRLZM A,BUF2(Q) ;Store field width
TJR3A: AOBJN Q,.+1 ;Count another field slot used up
SOJG H,TJR3 ;Make as many identical fields as specified
JRST TJR6 ;See if there are any more
TJRRGT: JUMPG B,JMRERR ;"!" better not be preceded by number, else error
PUSHJ P,JPARAM ;Get indent value
JRST JMRERR ;Syntax error, no number after "!"
JRST JMRUP1 ;Error, already reported to user
JUMPLE A,JMRERR ;Rightmost column must be positive
HRRZM A,BUF2(Q) ;Store final column of field
JRST TJR5B ;Look for more fields
;Here if user gave negative field width, means end & flush remaining old fields.
TJR8: CAIE C,15 ;Must end with CR
JRST JMRERR ;Syntax error
JUMPG Q,CPOPJ ;Jump if already ran out of field slots
SETOM BUF2(Q) ;Mark end of tab fields
POPJ P,
TJR7: OUTSTR [ASCIZ/ Field table is full, will ignore rest. /]
CLRTYI: SETZM TYIPNT
POPJ P,
; To adjust right half fields of TABTAB to reflect all typed changes
;Must be entered with left margin indent in TT.
TJADJ:
; MOVSI Q,-TABCNT
; HLLZS TABTAB(Q)
; AOBJN Q,.-1
SETZM TYOPNT
MOVSI Q,-TABCNT
TJADJ1: SKIPG TABTAB(Q)
JRST TJADJ4
HLRZ T,TABTAB(Q)
JUMPG T,TJADJ3 ;A field length was specified
HRRZ T,TABTAB(Q) ;An indent was specified
SUB T,TT
CAIL T,MINTXT
JRST TJADJ2
OUTSTR [ASCIZ/ TAB field #/]
HRRZ C,Q
TYPDEC C
OUTSTR [ASCIZ/ set at min. length of /]
MOVEI T,MINTXT
TYPDEC T
OUTSTR [ASCIZ/. /]
TJADJ2: HRLM T,TABTAB(Q)
TJADJ3: ADD TT,T
HRRM TT,TABTAB(Q) ;May have been corrected
AOBJN Q,TJADJ1
TJADJ4: SETZM TJADDF# ;0 means text on tabulation line
MOVE T,TT
SUB T,TPMAR
MOVEM T,TABSPC# ;Space used by tabulation
TRNE Q,-1
CAMGE TT,TRMAR ;(camgE is necessary)
POPJ P, ;No fields specified
MOVEM TT,TRMAR
SETOM TJADDF ;-1 means no text on tabulation line
POPJ P,
;TGET TJGET TJGET1 TJGET2 TJ4TAB TJ4SP TJ4DSP TJ5DSP TJG1 TJG2 TJG3 TJG4 TJG5 TJG6 TJG7 TJG9 TJG10 TJG13 TJG15
;Get margins and TAB settings from text
TGET:
TJGET: MOVEM A,JCNT ;Save arg
TLO F,TF2 ;Flag that we're reading TJ margins
PUSHJ P,JMREAD ;Read margins from command first
PUSHJ P,TJREAD ;Read new tab fields
SKIPN A,JCNT ;Restore arg
JRST TJGET2 ;Null arg means don't get margins from text
TLZ F,TF2 ;To distinguish from TAB or TJ command
PUSHJ P,JGINIT ;Initialize
PUSHJ P,JGMAR ;Get margins by examining the text
CAMN T,GPMAR ;T contains GLMAR from JGMAR
SKIPE GBNUM
SKIPA
SETOM GLMAR ;Signals tabulation lines only
SETOM TBNUM
SKIPG B
MOVEM B,TBNUM
MOVSI Q,-3
TJGET1: MOVE T,GPMAR(Q) ;Get margins observed in text
MOVEM T,TPMAR(Q) ;Make into new output margins
MOVEM T,TPMARO(Q) ;Make into new input margins
AOBJN Q,TJGET1
PUSHJ P,TJG1 ;Get tabular values
TJGET2: PUSHJ P,TJDATA ;Override margins and tab fields with any typed
JRST TJTYPE ;Type out final margins and return from command
TJ4TAB: MOVEI DSP,TJ5DSP
AOJA H,TJG5 ;An extra 1 to H so TAB will always end field
TJ4SP: MOVEI DSP,TJ5DSP
AOJA H,TJG6
; Despatch table for TJG after a normal char.
TJ4DSP: JRST TJG7 ;CR
AOJA H,TJ4TAB ;TAB
JRST TJ4SP ;Space
SETO H, ;Punctuation
JFCL ;Closure
SETZ H, ;Normal char
; Dispatch table after a space or TAB
TJ5DSP: JRST TJG7 ;CR
AOJA H,TJG5 ;TAB
JRST TJ4SP ;Space
JRST TJG9 ;Punctuation
JRST TJG9 ;Closure
JRST TJG9 ;Normal char
; To get table data from text
TJG1: SETOM TABTAB
HRLI T,TABTAB
HRRI T,TABTAB+1
BLT T,TABTAB+TABCNT-1
MOVSI Q,-TABCNT
MOVE A,ASAVE ;Get back to the first non-space char in 1st line
MOVE G,INDCNT ;Get character counter for first non-space
SETZM TABMAX#
TJG2: SETZ T,
TJG3: SETZ H,
MOVEI DSP,TJ4DSP
TJG4: AOS T ;We start on the first char
TJG5: ILDB C,A
XCT @JCTAB(C)
TJG6: AOBJN G,TJG4
TJG7: TRNN Q,777 ;Were any fields found?
POPJ P, ;No
CAMLE T,TABMAX
JRST TJG15 ;Not a normal tab field
MOVE T,TABMAX ;Make last field as long as the max.
HRLZM T,TABTAB(Q)
JRST TJG15
TJG9: CAIL H,TJSCNT ;Were there JSCNT or more spaces?
JRST TJG13 ;Yes, so at end of this TAB field
AOBJN G,TJG3 ;Single spaces allowed within fields
JRST TJG15
TJG10: OUTSTR [ASCIZ/ Only /]
SETZM TYOPNT
MOVEI A,TABCNT
TYPDEC A
OUTSTR [ASCIZ/ TABS allowed. /]
JRST TJG15
TJG13: CAMLE T,TABMAX
MOVEM T,TABMAX
HRLZM T,TABTAB(Q) ;Save field length
AOBJP Q,TJG10
AOBJN G,TJG2
TJG15: MOVE TT,TPMAR
PUSHJ P,TJADJ ;Adjust all tab values to reflect corrections
POPJ P,
;TJTYPE TJTYPO TJTYP7 TJTYP8 TJTYP9 TJG20 TJG20A TJG20B TJG20C TJG22 TJG24 TJG25 TJG23
; To report on TAB and TJ margins and tabular settings
TJTYPE: AOS (P)
TJTYPO: OUTSTR [ASCIZ/"T" /]
SETZM TYOPNT
SKIPGE TABFLG
JRST TJTYP9 ;Jump if XTABLE cmd
OUTSTR [ASCIZ/Paragraph on blank line/]
MOVE TT,TPMARO
CAMN TT,TLMARO
JRST TJTYP7
OUTSTR [ASCIZ/ or on indent = /]
TYPDEC TPMARO ;Tell what indentation indicates new paragraph
TJTYP7: OUTSTR [ASCIZ/. Margins (C,L,R,B) are /]
MOVSI Q,-4 ;Report values
SKIPA
TJTYP8: OUTSTR [ASCIZ /,/]
SKIPL TPMAR(Q)
TYPDEC TPMAR(Q)
SKIPGE TPMAR(Q)
OUTSTR [ASCIZ/-1/]
AOBJN Q,TJTYP8
OUTSTR [ASCIZ/
/]
TJTYP9: SKIPG TABTAB ;Are there any TABS?
JRST TJG23
MOVSI Q,-TABCNT
SKIPLE TABTAB(Q)
AOBJN Q,.-1
ANDI Q,-1
TYPDEC Q
OUTSTR [ASCIZ / tab fields /]
MOVSI Q,-TABCNT
SKIPA
TJG20: OUTSTR [ASCIZ/,/]
SETZ H,
HLRZ T,TABTAB(Q)
TJG20A: HLRZ TT,TABTAB+1(Q)
CAME T,TT
JRST TJG20B
AOS H
AOBJN Q,TJG20A
TJG20B: JUMPE H,TJG20C
AOS H ;The first one was not counted
TYPDEC H ;Count of similar fields
OUTSTR [ASCIZ/@/]
TJG20C: TYPDEC T
SKIPLE TABTAB+1(Q)
AOBJN Q,TJG20
OUTSTR [ASCIZ/ indented /]
MOVE T,TPMAR
TYPDEC T
MOVSI Q,-TABCNT
TJG22: SKIPLE TABTAB+1(Q)
OUTSTR [ASCIZ/,/]
HRRZ T,TABTAB(Q)
SKIPG TABTAB+1(Q)
JRST TJG24
TYPDEC T
AOBJN Q,TJG22
TJG24: CAML T,TRMAR
JRST TJG25
OUTSTR [ASCIZ/, text /]
TYPDEC T
TJG25: OUTSTR [ASCIZ/. /]
POPJ P,
TJG23: OUTSTR [ASCIZ/No tab fields. /]
POPJ P,
;BREAK BRKERR
;To break a specified number of lines into fragments ≤BREAKV in length
BREAK: MOVEM A,JCNT ;Number of lines, default value is 1
PUSHJ P,XTDBEG ;Get first char of extended command arg
PUSHJ P,GETNUM ;Read a number (constant, RDV, or macro value)
MOVE TT,BREAKV ;No number, use old value
PUSHJ P,XTDEND ;Make sure nothing extraneous in command line
JUMPLE TT,BRKERR ;Make sure break value is positive
CAILE TT,MAXARG
MOVEI TT,MAXARG ;Maximum repeat arg
MOVEM TT,BREAKV ;Break value is always sticky
SKIPE A,JCNT ;Zero arg means just tell default value
JRST JOIN0 ;BREAK something now
OUTSTR [ASCIZ /Default BREAK length is now /]
SETZM TYOPNT
TYPDEC BREAKV
OUTSTR [ASCIZ /. /]
JRST POPJ1
BRKERR: SORRY BREAK length must be positive.
JRST POPJ1
;JOINPM NEGATT JOIN JOIN0 JOIN0A JOIN0B JOINA JOINA1 JOINB JOIN1A JOIN1 JOIN2 JOIN3 JOIN2A JOIN4
JOINPM: SORRY Cannot JOIN or BREAK a non-text line.
JRST POPJ1
NEGATT: SORRY Negative arg to JOIN or BREAK is meaningless in attach mode.
JRST POPJ1
;To join a specified number of lines into 1 continuous line
JOIN: TRNN F,ARG!REL
MOVEI A,2 ;Default is to join two lines
TROA F,NEG ;Flag as JOIN command
JOIN0: TRZ F,NEG ;Flag as BREAK command
JUMPE A,CPOPJ ;Zero arg means this is no-op
JUMPG A,JOIN0A
TRNE F,ATTMOD
JRST NEGATT ;Negative arg is meaningless in att mode
PUSHJ P,ADJARG ;Back up given amount, not beyond beginning of page
JUMPLE A,NOTEX2 ;Jump if no previous lines on this page
JOIN0A: MOVEM A,JCNT
TRNE F,ATTMOD ;Don't care about arrow line if doing attach buffer
JRST JOIN0B
TLNE F,PMLIN!OFFEND
JRST JOINPM ;Current line is pagemark
JOIN0B: PUSHJ P,ENDSET ;To guarentee that new line will be at the end of FS
TLO F,NOCHK ;Don't core down until through
PUSHJ P,JINIT ;Set up E and set max line count in JCNT
HRRZ A,D ;Address of first text line to handle
HLLZ Q,TXTFLG(A) ;Save flags
;Link up start of new area in place of the old
HRRZ H,FSEND
ADDI H,1
TRNE F,NEG ;Skip if doing BREAK cmd
JRST JOINB ;JOIN bypass
JOINA: SKIPN TXTCNT(A)
JRST JOINA1 ;A non-text line
HRRZ T,TXTCNT(A) ;Get size of the line
CAMLE T,BREAKV ;Is line short enough already?
JRST JOINB ;No
SETZ Q, ;Yes, next line cannot be ARRL
HRRZ A,(A) ;Go to it
MOVEM A,JPTR ;Reset for later FSGIVE
CAME A,JETST(E) ;Are we at the end?
SKIPGE TXTFLG(A)
JRST JOINA1
SOSLE JCNT ;or has count run out?
JRST JOINA ;Maybe better luck next time
JOINA1: PUSHJ P,ENDFIX
TLZ F,NOCHK
SKIPGE BLAB
POPJ P, ;No message if terse mode
OUTSTR [ASCIZ /No lines broken. /]
JRST POPJ1
JOINB:
LEG HLLM Q,TXTFLG(H) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM H,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM H,WINLIN
SETZ Q,
MOVEM H,JLPT
HLLZ TT,(A) ;Use the left half of old link for
LEG MOVEM TT,(H) ;left half of the new link word, zero right
HLRZ T,TT
HRRM H,(T) ;Fix earlier forward link to the new line
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
LEG SETZM TXTWIN(H) ;clear window ptr for line in current window
ADD H,[440700,,LLDESC] ;Pointer for depositing text
MOVN B,BREAKV ;Set for BREAK
TRNE F,NEG
MOVNI B,400000 ;Set very large for JOIN
MOVNM B,BRAKV2# ;S ave for future use
HRLZS B
SETZ G,
JOIN1A: SETZ I, ;To accumulate counts for null line detection
JOIN1: HRRZ T,TXTCNT(A) ;Is this a null line?
JUMPE T,JOIN4 ;Null line bypass
MOVE D,A
ADD D,[440700,,LLDESC] ;Pointer to read text
ADD I,T
JRST JOIN3
;Transfer text, counting chars and fixing up TABs
JOIN2:
LEG IDPB C,H
JOIN3: ILDB C,D
CAIN C,11 ;Is it a TAB?
JRST JOIN5 ;Yes
CAIN C,15
JRST JOIN4
AOBJN B,JOIN2
JOIN2A:
LEG IDPB C,H ;Not a CR so save it
MOVE TT,D
ILDB C,TT ;Sneak a look at next char
CAIE C,15 ;Is it a CR?
JRST JOIN6A ;No, so there is something to break off
TLO B,400000 ;Nothing willl be left so make B neg
JOIN4: AOS Q
;Test for end of text and fix up for next line
HRRZ A,(A) ;Look at next line
SKIPL TXTFLG(A)
CAMN A,JETST(E) ;Are we at BOTSTR or ATTBUF?
SETZM JCNT ;This is needed later
SOSLE JCNT ;Have we joined the specified number of lines?
TRNN F,NEG ;Or is it a CR for a BREAK?
JRST JOIN6 ;Yes
SKIPN TXTCNT(A)
JRST JOIN6 ;A non-text line
SOS @JLPTR(E) ;1 line removed from LINES or ATTNUM
SOS JLCHG ;Count a line gone
SOS @JCPTR(E) ;But correct CHARS or ATTSIZ now
SOS @JCPTR(E) ;for both CR and LF that will be deleted
JRST JOIN1
;JOIN5 JOIN5A JOIN6 JOIN6A JOIN7 JOIN8 JOIN9
;Routine for fixing TABs
JOIN5: TRNE F,NEG
JRST JOIN5A ;No bother if a JOIN command
HRRZ TT,B
JUMPE TT,JOIN5A ;Initial TAB could cause trouble if BREAKV≤10
ADDI TT,10
ANDI TT,-10
CAMG TT,BRAKV2
JRST JOIN5A
HRRZS B ;Neg. B is used to signal a line with no split
ADD D,[70000,,0] ;Back up so TAB will be reconsidered
JUMPG D,JOIN6A
SUB D,[430000,,1]
JRST JOIN6A ;And split the line early
JOIN5A: ILDB C,D ;Yes
CAIN C,40
JRST .-2 ;Eat original spaces
;Now put in correct number of spaces for deposited position in line
LEG IDPB C,H ;Deposit as initial TAB
HRROI TT,-10
IORI TT,(B)
MOVNS TT
HRLS TT ;So that B-left is properly updated
ADD B,TT
SUBI G,(TT)
ANDI TT,-1
MOVNS TT
MOVEI T,40
AOJA G,.+11(TT)
REPEAT 10,<LEG IDPB T,H>
JUMPL B,JOIN2 ;Jump if have room for more in this line
JRST JOIN2A
;JOIN6 finishes off the line
JOIN6: JUMPG I,JOIN6A ;Not a null line
MOVEI C,40
LEG IDPB C,H ;At least 1 char is required
MOVSI B,-1 ;Mark input line as used up, output line as empty
JOIN6A: MOVEI C,15
LEG IDPB C,H ;The CR
MOVEI C,12
LEG IDPB C,H ;And a LF
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
MOVE T,JLPT
ADDI G,2(B)
HRLZS G
ADDI G,(B)
LEG MOVEM G,TXTCNT(T) ;Record char counts
;Text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert text words to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
SKIPG JCNT ;Have we exhausted the input?
JRST JOIN7 ;Yes, (will always be so if here on a JOIN)
MOVE T,JLPT ;We will need more space
HRRZ H,FSEND
ADDI H,1 ;Get its start
HRRM H,(T) ;and link it to last piece
LEG HRLM T,(H)
MOVEM H,JLPT
MOVE T,B ;Save for test
MOVN B,BREAKV ;Reset counters
TRNN F,ARG!REL ;If no argument given to BREAK,
MOVNI B,400000 ; then make sure we don't break the line again
MOVNM B,BRAKV2
HRLZS B
SETZ G,
LEG HRLM G,TXTFLG(H) ;Broken-off piece or next line cannot be ARRL
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
LEG SETZM TXTWIN(H) ;clear window ptr for line in current window
ADD H,[440700,,LLDESC]
JUMPL T,JOIN1A ;There was at a CR in original text so reset
AOS @JLPTR(E) ;An extra line will be added
AOS JLCHG ;Count a line added
AOS @JCPTR(E) ;And 2 extra chars
AOS @JCPTR(E)
JRST JOIN3
;And complete the links to the following text
JOIN7: MOVE T,JLPT ;Now fix new right link
HRRM A,(T) ;A references next line
HRLM T,(A) ;And backward link to the new line
PUSHJ P,ENDFIX
;It should be safe to FSGIVE now, count is in Q
MOVE A,JPTR ;Get back address of first old line
JUMPE Q,JOIN9
JOIN8: HRRZ B,(A) ;Save pointer to next block
PUSHJ P,FSGIVE ;Give up one FS block
MOVEI A,(B)
SOJG Q,JOIN8 ;Do this for all the old lines
JOIN9: TLZ F,NOCHK
TRNE F,NEG ;No message on a break
SKIPG BLAB ;or if not VERBOSE
JRST JEXIT(E)
MOVE T,JLPT ;Restore T value
HRRZ B,TXTCNT(T) ;and check final length of joined line
SETZM TYOPNT
OUTSTR [ASCIZ /Line now has /]
TYPDEC B
OUTSTR [ASCIZ / chars. /]
AOS (P)
JRST JEXIT(E)
;TJU1 TJU1B TJU2 TJU3 TJU3B TJU3C TJU4A TJU4B TJU4C TJU4G
; Special treatment if new par for TJ case
TJU1: SETZB Q,J
SKIPG TABOLD(Q) ;Are tab fields expected?
JRST JU2 ;No
MOVE K,TPMAR
MOVEM K,TABEND#
TLNE F,TF1 ;Which pass?
JRST TJU1B
TRZ F,REL ;Must be redetermined during first pass
SKIPGE TABFLG
TRO F,REL ;All lines are table lines for TABLE command
SETOM TF2FLG# ;Signalling first pass on a table line
TJU1B: SETOM ODDEVN ;To keep odd-even check on tabs
MOVEI TT,77777
SKIPGE TABFLG
MOVE TT,TPMARO ;This is a TABLE command
MOVEM TT,TABENO#
JUMPE TT,TJU3B
TJU2: MOVEI DSP,TJ1DSP
MOVSI H,JALL
; Space eating loop (for both passes)
TJU3: ILDB C,A ;Eat spaces, odd-even check tabs, to next field
TLNE H,JCTAB(C)
XCT @JCTAB(C)
CAMGE J,TABENO
JRST TJU3
CAML J,TABENO ;Did we arrive at an entry too soon?
JRST TJU3B ;No
ADD A,[70000,,0] ;Yes, so back up
CAIG A,0
SUB A,[430000,,1]
JRST TJU3C
TJU3B: SKIPG ODDEVN ;Is there an unmatched tab?
JRST TJU3C ;No
MOVE T,A
ILDB C,T ;Sneak look at next char
CAIE C,11
JRST TJU3C ;Must be char for next field
ILDB C,A ;Eat it
MOVNS ODDEVN ;and account for it
TJU3C: TLNE F,TF1
JRST TJU6 ;Second pass
SKIPLE TT,TABOLD(Q)
JRST TJU4D ;Can continue
; Out of tab fields
SKIPGE TABFLG ;Warn only if TABLE
SKIPE TEXTRA ;Has warning been given?
JRST TJU4A
OUTSTR [ASCIZ/EXTRA FIELD! Format may be unsatisfactory./]
SETOM TEXTRA
; Is text to go on this line
TJU4A: PUSHJ P,TJROOM
JRST TJU4C ;No text on input line
JRST TJU4G ;Not enough room
TJU4B: CAILE K,(G)
AOBJN G,TJU4B
JRST JU2 ;Go read the text
TJU4C: PUSHJ P,PARGET
TRNN F,REL
JRST TJU4A ;There is text on the next line
TJU4G: HRRZM G,JWCOL ;Character count for second pass
SETZM JSINC ;To suppress any attempt to justify if no text
JRST JU3B ;Go to second pass
;TJU4D TJU4F TJU4E TJU5 TJU5A TJU6 TJU7A TJU7B TJU8 TJU8A TJU8B TJU9 TJU9A
TJU4D: JUMPE Q,TJU4F ;Initial indent is handled differently
CAILE K,(G)
AOBJN G,.-1 ;Allow for the normal field length
TJU4F: SKIPGE TABFLG
HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q) ;Establish the new output field termination
SUB K,TPMAR ;Remember that G right is to measure from TPMAR
JUMPG Q,TJU4E
TLNN F,TF1
HLLZS G ;First time fix so that G measures from TPMAR
TJU4E: AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
; First pass character count
TJU5: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
AOJA J,TJU5A ;Count input character and JUMP
AOBJN G,TJU2 ;Count second space here
MOVEI DSP,J1DSP
MOVSI H,JALL
JRST JU2 ;Let normal JUST or JFILL routine handle it
; Normal character portion of loop
TJU5A: AOBJN G,TJU5 ;Account for normal character
MOVEI DSP,J2DSP
MOVSI H,JUSF
JRST JU3A1
TJU6: SKIPLE TT,TABOLD(Q)
JRST TJU8
; There must be some text to follow
MOVEI C,40
TJU7A: CAIG K,(G) ;and pad to end of field
JRST TJU7B
LEG IDPB C,D
AOBJN G,TJU7A ;Should always index
TJU7B: MOVEI DSP,J1DSP ;Go read text
MOVSI H,JALL
JRST JU4
TJU8: JUMPE Q,TJU8B ;First indent handled by J2PASS
MOVEI C,40 ;Pad out with spaces to next field start
TJU8A: CAIG K,(G)
JRST TJU8B
LEG IDPB C,D
AOBJN G,TJU8A
TJU8B: SKIPGE TABFLG
HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q)
SUB K,TPMAR ;Remember that G is measured from TPMAR
AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
; Second pass character transfer
TJU9: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
LEG IDPB C,D
AOJA J,TJU9A ;Count input character and JUMP
AOBJN G,TJU2 ;Count second space here
JRST JU4A
TJU9A: AOBJN G,TJU9 ;Count transfered character
JRST JU4A
;⊗ OLDFIX OLDFI2 OLDFI3 OLDFI4 OLDFI5 ZLINES OLDLOC OLDLIN OLDLI2 OLDLI0 OLDWIN OLDLI7 SETAR0 OLDLI4 OLDLI5 OLDL5L OLDLI3 OLDSA0 OLDSAV OLDSA2 OLDSA3 OLDSA4 OLDFL2 OLDFL3 OLDFL0 OLDFL5 OLDFLS OLDFL4 OLDFL6 OLDFL7
;Here to fix line stack for line insertions or deletions. Clobbers T,TT,A.
;Here with -3(P) containing number of lines inserted (negative for deletions).
OLDFIX: MOVE T,-3(P) ;Get number of lines to be inserted
HRRZ TT,EDLINE ;First we adjust line number of last line edited
CAMN TT,ARRL ;If removing (e.g., attaching) the last line edited,
HRROS TT,EDLINE ; then flag that so we can re-edit when put back
CAMLE TT,ARRL ;Was insertion/deletion done above remembered line?
ADDM T,EDLINE ;Yes, the last line edited just moved up or down
HRRZ TT,SLNSTP ;Now adjust line number where searches stop
CAMLE TT,ARRL ;Was insertion/deletion above given line?
ADDM T,SLNSTP ;Yes, adjust search stopping line number
CAILE T,NEARBY ;Skip unless inserting non-trivial number of lines
PUSHJ P,OLDSA0 ;Save on the line stack the line beyond insertions
SKIPE T,OLDFAS ;Skip unless suppressing line stack changes
TRNE T,-1 ;Skip if suppressing all line stack changes!
SKIPN OLDPLC ;Skip if anything in line stack
POPJ P, ;Nothing in line stack or not supposed to diddle
MOVE A,ARRL
ADDI A,NEARBY ;Make number of line threshold distance away
MOVN T,OLDMAX ;Negative of size of stack
MOVSI T,(T) ;Make aobjn ptr to stack
OLDFI2: HRRZ TT,OLDPLC(T) ;Get old line number
CAMGE TT,ARRL ;Is this old line affected?
JRST OLDFI3 ;No
ADD TT,-3(P) ;Adjust by number of lines added
CAMG TT,A ;Has this old line now come near to arrow line?
JRST OLDFI4 ;Yes, flush it from line stack
HRRM TT,OLDPLC(T) ;No, store adjusted line number back on line stack
HLRZ TT,OLDPLC(T) ;Get window
CAMGE TT,ARRL ;Is this window affected?
JRST OLDFI3 ;No
ADD TT,-3(P) ;Adjust window by number of lines added
HRLM TT,OLDPLC(T) ;Store adjusted window back on line stack
OLDFI3: AOBJN T,OLDFI2 ;Loop through whole line stack
POPJ P,
OLDFI4: SOS OLDMAX ;Count one less entry in line stack
AOBJN T,OLDFI5 ;Jump unless this was last entry in stack
SETZM OLDPLC-1(T) ;Zero the old last entry in stack
POPJ P, ;End of stack
OLDFI5: MOVSI TT,OLDPLC(T) ;Move all following entries down by one
HRRI TT,OLDPLC-1(T) ;Blt destination is entry we want to flush
BLT TT,OLDPLC+NOLD-1-1 ;Blt to next-to-last slot in stack
SETZM OLDPLC+NOLD-1 ;Make sure there's a zero at end of stack
SOJA T,OLDFI2 ;Undo RH of aobjn we already did
ZLINES: SETZM OLDPLC ;Clear line stack
POPJ P,
;This is the routine for the ⊗∀ command.
;This command returns to the previous location, whether it is on the current
;page or not. That is, ⊗∀ is the same as ⊗N if ⊗N does anything, else it
;is the same as ⊗O. (Eventually, ⊗∀ should undo the last ⊗# movement cmds,
;doing this by remembering a stack of places, where each place includes:
;a window, a file, a page, a line (and maybe a TOPWIN). To do this right
;requires that, for each page in the page stack, we keep N lines in the
;line stack for that page (even when we're not on that page), for N about 4.)
OLDLOC: MOVEI B,0 ;for now, pretend no bucky bits (not αβ version)
JUMPE A,OLDLI4 ;Zero arg means tell current default for αβ command
MOVEI C,1 ;force "arg" of 1 (last place)
SKIPE OLDPLC ;Any old place remembered on this page?
JRST OLDLI0 ;yes, go there
JRST BACKG2 ;no, go to previous page, if any
;This is the routine for the ⊗N command.
OLDLIN: JUMPE A,OLDLI4 ;Zero arg means tell current default for αβ command
MOVM C,A ;Get positive index of desired old line
TRNE F,REL ;Relative arg?
JRST OLDLI7 ;Yes, wants to diddle stack or last arg
CAIE B,CTMT3 ;αβ command?
JRST OLDLI2 ;No
TRNE F,ARG ;Yes, any arg?
MOVMM C,OLDDBL ;Arg given with αβ means set default for αβ
MOVM C,OLDDBL ;Get default for αβ command
OLDLI2: SKIPN OLDPLC ;Any remembered lines at all?
JRST OLDLI3 ;No (this way we allow storing new default for αβ)
OLDLI0: CAMLE C,OLDMAX ;Range check old line index
MOVE C,OLDMAX ;Get index of oldest line
PUSH P,OLDPLC-1(C) ;Save old window
HRRZ A,OLDPLC-1(C) ;Get line number only
PUSHJ P,OLDFLS ;Flush that entry from line stack
PUSHJ P,SETARR ;Now go to that line
OLDWIN: POP P,A
HLRE A,A ;Get old window that might be restored
MOVE T,ARRL ;Think about restoring old window
CAML T,TOPWIN ;Is new arrow above current window?
CAML T,BOTWIN ;Or maybe below current window?
JRST SETWIN ;Yes to one of these, restore old window
POPJ P, ;No, new line is on same window
OLDLI7: SKIPN OLDPLC ;Is there really any place remembered?
JRST OLDLI3 ;No, forget it
MOVE TT,OLDMAX ;Arg for NOHSTK -- size of stack
CAILE C,(TT) ;Want to diddle stack by more than its size?
JRST NOHSOV ;Yes, that's silly
HRLI TT,OLDPLC ;Arg for NOHSTK -- stack's starting address
MOVE T,ARRL ;Another arg -- current place
PUSHJ P,NOHSTK ;Rotate line stack by (A)
PUSH P,A ;Save old window on stack
PUSH P,[OLDWIN] ;Maybe restore old window after moving arrow
MOVEI A,(A) ;Just line number we want to go to
SETAR0: SETOM OLDFAS# ;Tell SETARR not to save old line location
JRST SETARR ;NOHSTK returned new line in A -- now go there
;Here with ⊗0⊗N cmd.
OLDLI4: SOS OLDMOV ;Don't let this cmd terminate string of FFs/VTs
CAIE B,CTMT3 ;αβ cmd?
JRST OLDLI5 ;No, type out locations on stack
MOVEI A,[ASCIZ /N/] ;Command to type out
MOVE B,OLDDBL ;Current default for αβ command
JRST NOHDEF
;Here with ⊗0αN cmd.
OLDLI5: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Line stack: /]
SETZM TYOPNT
TYPDEC ARRL ;Current line is top of stack
SKIPN OLDPLC
JRST PPJ1CR ;No other lines in stack
MOVN C,OLDMAX
MOVSI C,(C) ;Make aobjn ptr
OLDL5L: OUTCHR [","]
HRRZ TT,OLDPLC(C) ;Get line number from line stack
TYPDEC TT ;Type a line number
AOBJN C,OLDL5L ;Loop through whole stack
JRST PPJ1CR ;Skip return and type crlf
OLDLI3: SORRY No old Line to return to.
JRST POPJ1
;Routine to update list of lines we've been at recently. Here from SETARR, OLDFIX.
;Called with line we're going to in A. Clobbers T,TT.
;Here we make sure no two entries in list are within NEARBY lines of each other.
;Enter at OLDSA0 to avoid flushing "new arrow line" from stack (clobbers A).
;For all entries, OLDMOV being negative prevents flushing from the stack
;entries for the line we're going to (A), and OLDFAS being non-zero prevents
;remembering the line we're leaving (ARRL).
OLDSA0: MOVEI A,-1 ;Pretend we're going somewhere far away
OLDSAV: SKIPE TT,OLDFAS# ;Skip unless not supposed to remember old place
JRST OLDFL5 ;Flush new line from stack unless from VT/FF cmd
PUSH P,A ;Remember new arrow line
MOVE A,ARRL ;Pick up old arrow line so we can add it to top of list
HRL A,TOPWIN ;Remember window setting too
MOVSI TT,-NOLD ;Make aobjn ptr to list of old lines
JRST OLDSA3
OLDSA2: JUMPE A,OLDSA4 ;Always remember end marker for list
MOVEI T,(A) ;Copy of old line number being remembered
SUB T,ARRL ;Distance from new line being remembered
MOVM T,T
CAIG T,NEARBY ;Are they close together?
JRST OLDFL2 ;Yes, don't remember old line any more
OLDSA3: SKIPGE OLDMOV ;Are we here from FF/VT cmd?
JRST OLDSA4 ;Yes, don't flush old line even if near new arrow
MOVEI T,(A) ;Copy of old line being remembered
SUB T,(P) ;Distance from new arrow line
MOVM T,T
CAIG T,NEARBY ;Are they close together
JRST OLDFL3 ;Yes, don't remember old line any more
OLDSA4: EXCH A,OLDPLC(TT) ;Remember new place and pick up older one
SKIPE OLDPLC(TT) ;Did we just move the end marker in the list?
AOBJN TT,OLDSA2 ;No, continue through list unless done
HRRZM TT,OLDMAX ;Store number of valid entries in list
JRST POPAJ
OLDFL2: SKIPL OLDMOV ;Skip if from FF/VT cmd
OLDFL3: SKIPN OLDPLC ;Skip if anything in stack
JRST POPAJ
JRST OLDFL4 ;Flush lines near new arrow line
OLDFL0: MOVE A,ARRL ;Here to flush arrow line from line stack
JRST OLDFLS
;Now flush lines near to number in A from the line stack, unless from FF/VT
;Also flush stack lines beyond end of incore lines. Clobbers T,TT.
OLDFL5: SETZM OLDFAS ;Be sure to remember old line next time
TRNN TT,-1 ;-1,,0 in OLDFAS means leave line stack alone
POPJ P, ; but we still have cleared OLDFAS
SKIPL OLDMOV ;Skip if have just come from FF/VT cmd (or RDFAIL)
OLDFLS: SKIPN OLDPLC ;Skip if anything in stack
POPJ P, ;Don't bother with stack
PUSH P,A ;Remember new arrow line
OLDFL4: PUSH P,B ;Save an AC
MOVN T,OLDMAX ;Get size of stack
MOVSI T,(T) ;Make aobjn ptr
MOVSI A,-1 ;LH is count-1, RH is offset in line stack of dest
OLDFL6: HRRZ TT,OLDPLC(T) ;Get line number of some place on stack
MOVEI B,-1(TT) ;Adjust line number for test against row of stars
SUB TT,-1(P) ;Distance from line that is not wanted on line stack
MOVM TT,TT ;Absolute distance
CAMG B,LINES ;Is this line beyond row of stars at bottom?
CAIG TT,NEARBY ;Or is it too close to place not wanted on stack?
AOBJP A,[SOJA A,OLDFL7] ;Yes, flush from stack -- always jumps!!!
AOJL A,OLDFL7 ;Jump if haven't diddled stack
MOVE TT,OLDPLC(T) ;Get back line number that is okay
MOVEM TT,OLDPLC-1(A) ;Move it past flushed entries in stack
OLDFL7: AOBJN T,OLDFL6 ;Continue through stack
JUMPL A,POPBAJ ;Return now if stack untouched
HLRZ A,A ;Number of entries flushed from stack
MOVNI A,1(A) ;Negative of number flushed
ADDB A,OLDMAX ;Adjust size of stack by number of entries flushed
SETZM OLDPLC(A) ;Make sure there's a zero at end of (reduced) stack
JRST POPBAJ
;NBACK ZBACKL ZPAGL ZFLAGS ZFRDWN ZBACK ZWIND ZMARK ZENT ZNUM MAXWNS ZSIZE ZDATA ADDFIL
COMMENT ⊗
ZDATA is used to hold records of data extracted from EDFIL when a file change
requested. The format of EDFIL, and hence of each record in ZDATA is as follows:
Word Contents
-2 Number of lines per page in /F mode.
-1 Name of device in SIXBIT (DSK, UDP etc)
0 File name in SIXBIT
1 Extension in SIXBIT,,DATE INFORMATION
Bits 18-20 are the high order bits of the date written
Bits 21-35 are the creation date
2 Used by RENAME and ENTER
Bits 0-8 protection key
Byts 9-12 Mode field
Bits 13-23 time
Bits 24-35 low bits of the date written
3 PPN in SIXBIT. This is overwritten in EDFIL by the LOOKUP routine.
4 Data from EDFIL+4: zero unless /N, in which case X,,-1 where X is positive.
Additional information in ZDATA that is not in EDFIL:
a) page,,line of last place we were at in the file
b) flags from F when we left the file
c) FRD flags telling which parts of filename were given,,column position within line
d) top part of page stack and corresponding window data
e) all line marks
END OF COMMENT ⊗
IMPURE
NBACK←←=20 ;Number of recently visited pages we remember (size of page stack)
ZBACKL←←4 ;Amount of page stack saved when switching files.
IFGE ZBACKL-NBACK,< .FATAL ZBACKL not less than NBACK -- see ZLIST5 >
;Words -2 through 4 of entry in file list are described in big comment above.
;Here are the offsets from the beginning of a file entry for rest of the words.
ZPAGL←←5 ;page,,line of arrow line upon leaving file
ZFLAGS←←6 ;copy of AC F upon leaving the file
ZFRDWN←←7 ;<FRDxxx flags (from D)>,,<window position>
ZBACK←←10 ;saved part of page stack. ZBACKL is its length.
ZWIND←←ZBACK+ZBACKL ;window data of page stack
ZMARK←←ZWIND+ZBACKL ;line marks
ZENT←←2+ZMARK+NMARKS ;number of words per file entry
ZNUM←←10 ;number of files for which data is kept, not counting ? file
;MAXWNS is made one less than ZNUM temporarily to try to avoid some bug that causes
;two windows to think they have the same filename (they don't) when running out
;of windows and filelist spots.
MAXWNS←←ZNUM-1 ;max nbr of windows, can't be more than ZNUM
ZSIZE←←ZNUM*ZENT ;number of words of file data, not counting ? file
;ZSIZE is also the index for the ? file
0 ;/F mode line count for first file in list
0 ;Device name of first file in list
ZDATA: BLOCK ZSIZE-2 ;Space for file names and data
0 ;Word -2 of ? file -- not in /F mode
IFE DECSW,<
SIXBIT /DSK/ ;Word -1 of ? file -- device
>;NOT DECSW
IFN DECSW,<
SIXBIT /DSKB/ ;Word -1 of ? file -- device
>;DECSW
SIXBIT /E/ ;Word 0 of ? file
SIXBIT /ALS/ ;Word 1
0 ;Word 2 -- protection and date/time
DOCPPN ;Word 3
0 ;Word 4
2,,5 ;Word 5 -- last page,,line we were at in ? file
BLOCK ZENT-(.-(ZDATA+ZSIZE)) ;Space for rest of QUERY (?-file) data
0 ;A random extra word for nothing particular, just in case
0 ;For /F flag
0 ;For device name
ADDFIL: BLOCK 5 ;Additional (not currently edited) filename being read
;(filename and /N flag word)
PURE
;ZSAVE ZSAVIT ZSAVE0 ZSTORE ZFLDIR ZFLDI1 ZFLDI2
;Write out and save info for current file, then flush it from core.
;Skips on success, take direct (error) return if can't open file to write it.
ZSAVE: PUSHJ P,FINI01 ;Write out current page, maybe delete file
POPJ P, ;failed to open file
AOS (P) ;now always take success return
CLOSE DSKO, ;Make sure file gets out safely
PUSHJ P,CLOSDO ;release channel and cache
PUSHJ P,ZSAVIT ;Save data about file state, esp. for tmpcor
PUSHJ P,TMPWRT ;Write out tmpcor file if appropriate (clob A,B,C,D)
PUSHJ P,FLSPAG ;Flush page without bothering ATTACH buffer.
PUSHJ P,ZFLDIR ;Make room if repeated switching is allowed
SETZM DIRPT ;Directory has been flushed
SETZM DIRP1 ;Directory has been flushed
SETZM SPGSTP ;Clear page number of short stop on search
MOVEI TT,EDFIL+4
MOVEM TT,SRCFIL+4 ;To circumvent old monkey business
ANDI F,ATTMOD ;Clear all flags but attach mode flag
JRST INIT1A ;Clear some file modes
;Save tmpcor-type info about file we're leaving. Clobbers only T and TT.
ZSAVIT: MOVE T,EDFIL-1 ;Remember device along with PPN
MOVE TT,EDFIL+PPN3 ;Remember PPN of file we're leaving
EXCH TT,LSTPPN# ; for use on next file if not found
EXCH T,LSTDEV# ;Make LSTDEV (device) go with LSTPPN (PPN)
CAME TT,LSTPPN ;Remember second previous PPN too
MOVEM TT,LSTPP2# ;But only if different from first previous PPN
CAME TT,LSTPPN ;Remember second previous PPN's device too
MOVEM T,LSTDV2# ; if remembering second previous PPN
PUSHJ P,GPAGL ;Get current line,,page in T
MOVS TT,T ;Make it page,,line
MOVE T,ZINDEX ;Get current file's offset in data area
MOVEM F,ZDATA+ZFLAGS(T) ;Save readonly flag (someday we may utilize others)
PUSHJ P,ZSAVE0 ;Save page, line, page stack, line marks
MOVE TT,TOPWIN ;Get window setting
HRRM TT,ZDATA+ZFRDWN(T) ;Save it
MOVE TT,EDFIL-2
MOVEM TT,ZDATA-2(T) ;Save final value of /F flag
MOVE TT,EDFIL+4
MOVEM TT,ZDATA+4(T) ;Save final value of /N flag
MOVS TT,SYSCMD
CAIN TT,'CE ' ;If he said CETV (create),
MOVEI TT,'ET ' ; then don't assume creating again
MOVSM TT,SYSCMD ;Put back
POPJ P,
ZSAVE0: MOVEM TT,ZDATA+ZPAGL(T) ;Store page and line number
MOVSI TT,BAKPLC
HRRI TT,ZDATA+ZBACK(T)
BLT TT,ZDATA+ZBACK+ZBACKL-1(T) ;Save top part of page stack
MOVSI TT,BAKWIN
HRRI TT,ZDATA+ZWIND(T)
BLT TT,ZDATA+ZWIND+ZBACKL-1(T) ;Save window data for top part of page stack
MOVSI TT,MARKS
HRRI TT,ZDATA+ZMARK(T)
BLT TT,ZDATA+ZMARK+NMARKS-1(T) ;Save all marks
POPJ P,
;Here after reading first TMPCOR filename or after reading an additional
; filename from TMPCOR or TTY. Store meanings of all switches into the
; filelist entry for this file (index currently in T).
ZSTORE: PUSH P,C
PUSHJ P,ZLIST0 ;Find or make filelist entry for this file
POP P,C
HRLZ TT,SPAGE ;Remember starting page
HRR TT,SLINE ;Remember starting line
PUSHJ P,ZSAVE0 ;Save page, line, page stack, line marks
MOVE TT,SWIND ;Remember starting window
HRRM TT,ZDATA+ZFRDWN(T) ;Save it
MOVEI TT,0
SKIPE RDONLY ;/R switch seen?
MOVEI TT,REDNLY ;Yes, mark this entry as readonly
MOVEM TT,ZDATA+ZFLAGS(T) ;Store setting of readonly flag
POPJ P,
;To free the directory space. FLSDIR does not seem to work with Z routines
ZFLDIR: SKIPN A,DIR
POPJ P,
MOVE C,PAGES
TLO F,NOCHK
ZFLDI1: CAIN A,DIREND
JRST ZFLDI2
HRRZ B,(A)
PUSHJ P,FSGIVE
SKIPE A,B
SOJG C,ZFLDI1
ZFLDI2: TLZ F,NOCHK
TRZ F,DIROK ;We don't want to fool anybody
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
MOVEM T,DIROVH
SETZM EDIRSZ ;no extended part of directory detected yet
SETZM DIR
POPJ P,
;ZFINDQ POPJ2 ZFIND ZFIND1 ZFIND3 ZFIND2 ZLIST ZLIST0 ZLIST2 ZLIS21 ZLIS23 ZLIS22 ZLIST3 ZLIST5 ZLIST6 ZRSTOR
;Routine to search filelist for slot containing filename pointed to by D.
;Direct return if found empty space (file not in list) -- index returned in T.
;Skip return if filelist is full (file not in list).
;Double skip return if found the file -- index returned in T.
ZFINDQ: SKIPN QUERYF ;Is this the ? file?
JRST ZFIND ;No, look through filelist for filename
MOVEI T,ZSIZE ;Yes, return its index
POPJ2: AOS (P) ;Double skip for success
JRST POPJ1
ZFIND: MOVEI T,0
ZFIND1: SKIPN TT,ZDATA(T)
POPJ P, ;Empty space found, so not in list.
CAME TT,(D) ;Compare current filename with filename in list
JRST ZFIND2 ;Not same file name
MOVE TT,ZDATA-1(T)
CAME TT,-1(D)
JRST ZFIND2 ;Not the same device
MOVE TT,ZDATA+ZFRDWN(T) ;Get FRDxxx flags for entry in filelist
TLNN TT,FRDEXT ;Explicit extension stored?
JRST ZFIND3 ;No, then extensions effectively match
HLLZ TT,EXT1(D)
HLLZ C,ZDATA+EXT1(T)
CAME TT,C
JRST ZFIND2 ;Not the same extension
ZFIND3: MOVE TT,ZDATA+PPN3(T)
CAMN TT,PPN3(D)
JRST POPJ2 ;Found slot in list, success return
;Here if current filelist entry doesn't match current file
ZFIND2: ADDI T,ZENT ;Go to next entry
CAIGE T,ZSIZE-1 ;But is there another?
JRST ZFIND1 ;Yes, go back and try again
JRST POPJ1 ;Filelist is full
;ZLIST is called by DPYOK and stores data about the file being opened for editing.
;The new file's name is first checked against the existing records, and if
;found in ZDATA, the old entry is updated with the current data.
;If the file is not already listed, a new entry is made, flushing the file
;on the bottom of the file stack if there are no unused entries.
;Call with D containing FRDxxx bits in LH and pointer to filename block in RH.
;Clobbers A,B,C,T,TT.
ZLIST: SKIPN QUERYF# ;Are we switching to E.ALS[UP,DOC]?
JRST ZLIST0 ;No, see if current file is already in list
SETZM QUERYF ;Yes, turn off indicator
MOVEI T,ZSIZE ;Set up index of the query file
PUSHJ P,ZRSTOR ;Restore line marks and page stack
JRST ZLIST6 ;Don't clobber ZDATA info for this file
;Enter here to find filelist place for file we may not be editing right now
ZLIST0: PUSHJ P,ZFIND ;See if this file is already in filelist
JRST ZLIST3 ;Not in list, found empty space (T)
JRST ZLIST2 ;Not in list, list is full
TLNN D,FRDADD ;Found file in list. Skip if not editing this file.
PUSHJ P,ZRSTOR ;Restore marks and page stack
JRST ZLIST5 ;Update info in filelist
ZLIST2: MOVE TT,HOMMAX ;Table full -- replace file on bottom of file stack
CAIL TT,ZNUM-1 ;Ought to be at least this many files on stack
ZLIS21: SKIPN A,HOMPLC-1(TT) ;And this position on stack ought to be in use
PUSHJ P,TELLZ ;This isn't supposed to happen!!!
MOVEI A,(A) ;Just the index
PUSHJ P,ZFILW ;skip if this file isn't current in any window
SOJG TT,ZLIS21 ;can't flush this file, walk back up the stack
JUMPG TT,ZLIS23 ;jump if have valid stack position
SKIPL A,ZINDEX ;no previous file entry in the world can be flushed!
PUSHJ P,ZFILW ;skip if latest file isn't current in another window
CAIA ;can't flush this file either! maybe flush window.
JRST ZLIS23 ;OK, use latest file's index
SKIPN NDEADW ;any previously dead windows?
PUSHJ P,TELLZ ;no, too many live windows' files!!
PUSHJ P,DEDFLS ;yes, flush one (or more) dead windows
JRST ZLIST2 ;now start over looking for a file entry
ZLIS23: MOVEI T,(A) ;index of file entry where we'll put this file
SKIPGE BLAB ;Suppress this message in terse mode
JRST ZLIS22 ;Terse mode
PUSH P,T
PUSH P,D
OUTSTR [ASCIZ /Fileswitch list full -- replacing /]
MOVEI D,ZDATA(T) ;Address of filename
TLO D,FRDRUN ;Suppress typeout of switches
PUSHJ P,FILTYP ;Type filename we are flushing
OUTSTR [ASCIZ/.
/]
POP P,D
POP P,T
ZLIS22: CAMN T,ATTFIL ;Reassigning index of original file for att buffer?
SETOM ATTFIL ;Yes, make sure we don't try to REPLACE att buffer
CAMN T,ANSFIL ;reassigning index of lisp answer text file?
SETOM ANSFIL ;yes, make sure we don't put text anywhere
ZLIST3: SETOM ZDATA+ZPAGL(T) ;No starting page and line seen yet
TLNN D,FRDADD ;Is this an additional filename (not edited)?
JRST ZLIST5 ;No
PUSH P,T
MOVE C,T ;Index of file to push on stack
MOVEI T,-1 ;Make sure no match for "file we're going to"
PUSHJ P,HOMSAD ;Push this new file's index on file stack
POP P,T
ZLIST5: MOVSI TT,-2(D) ;Copy file name and mode
HRRI TT,ZDATA-2(T) ; of file being edited
BLT TT,ZDATA+4(T) ; into filelist (thru /N flag)
HLLM D,ZDATA+ZFRDWN(T) ;Remember how much of filename was given
TLNE D,FRDADD ;Is this just an additional filename (not edited)?
POPJ P, ;Yes, all done (return index in T)
ZLIST6: PUSHJ P,HOMSAV ;Remember file we're coming from -- fix file stack
MOVEM T,ZINDEX ;Save index of current file's entry in list
POPJ P,
;Restore old page stack and line marks from filelist entry for current edit file.
ZRSTOR: MOVSI TT,ZDATA+ZBACK(T)
HRRI TT,BAKPLC
BLT TT,BAKPLC+ZBACKL-1 ;Restore old page stack
SETZM BAKPLC+ZBACKL ;Make sure there's a zero at end of page stack
MOVSI TT,ZDATA+ZWIND(T)
HRRI TT,BAKWIN
BLT TT,BAKWIN+ZBACKL-1 ;Restore window data of page stack
MOVSI TT,-ZBACKL
SKIPE BAKPLC(TT) ;Find end of restored page stack
AOBJN TT,.-1
HRRZM TT,BAKMAX ;Set up size of page stack
PUSH P,T ;In case we switched by explicit filename,
MOVS T,ZDATA+ZPAGL(T) ; remember last place we previously were at in file
TLNE T,400000 ;Don't remember default starting line of -1
HRLI T,1
MOVEI TT,0 ;ZDATA doesn't remember window -- fake window
MOVE A,CURPAG ;Page we went to at startup
TRNN T,400000 ;Don't remember default starting page of -1
PUSHJ P,BAKSA0 ;Put previous page on page stack, flush current page
POP P,T ;Restore index of current file
MOVSI TT,ZDATA+ZMARK(T)
HRRI TT,MARKS
BLT TT,MARKS+NMARKS-1 ;Restore old line marks
POPJ P,
;⊗ ZFILES ZFILEL ZFILEX ZFILW ZFILW2 ZFILC ZFILM ZFILM4 ZFILM7 ZFILM6 ZFILM8 ZFILM5 ZFILM2 ZFILM3 LAMEP0 EXIST0 EXIST1 EXIST3 EXIS3A EXIS3B
;Routine to clear the file stack except for the current file(s) (one per window,
;including dead windows not flushed yet).
ZFILES: MOVEI A,0 ;index of first file to check
MOVEI D,0 ;index of place we move file entry to
ZFILEL: PUSHJ P,ZFILC ;see if we have to keep this file (index (A))
ADDI A,ZENT ;next entry
CAIL A,ZDATA+ZSIZE ;more file blocks?
JRST ZFILEX ;no
SKIPE ZDATA(A) ;yes, any file here?
JRST ZFILEL ;yes
SETZM ZDATA-2(D) ;mark end of list with null filename
MOVSI T,ZDATA-2(D) ;BLT source, clear whole rest of file entry blocks
HRRI T,ZDATA-1(D) ;BLT dest
BLT T,ZDATA-2+ZSIZE-1 ;clear to end of file blocks
ZFILEX: SKIPGE BLAB ;skip unless terse mode
POPJ P,
PUSHJ P,ABCRLF ;maybe put out crlf
OUTSTR [ASCIZ/Remaining file stack: (0)/]
JRST HOMTE2 ;type out remaining files, in file stack
;routine to see if file given by index in A is current in any window, dead or alive.
;skip if not in any window, dead or alive (doesn't check current window).
ZFILW: MOVEI T,WINHED ;window list hdr
ZFILW2: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
JRST POPJ1 ;yes, given file not current in any window
CAME A,ZINDEX-WINDAT(T) ;is this the current file in that window?
JRST ZFILW2 ;no
POPJ P, ;yes, direct return indicates current in some window
;Routine to see if we can flush this file.
;If so, kills the file entry, else goes to ZFILM to move it down.
ZFILC: CAMN A,ZINDEX ;is this the current window's current file?
JRST ZFILM ;yes, can't flush it then.
PUSHJ P,ZFILW ;skip if file index A not current in any window
JRST ZFILM ;current in some window, can't flush, move it
;Here to kill this file entry, mainly we just avoid moving it down
CAMN A,ATTFIL ;is this the file att buf came from?
SETOM ATTFIL ;yes, can't ever return it there now
CAMN A,ANSFIL ;is this where subjob text goes?
SETOM ANSFIL ;yes, can't put any subjob text there now
MOVEI T,(A) ;index we're flushing for next routine
JRST HOMSA3 ;flush this index from file stack (clob B,C)
;Here to move current file entry down, adjusting various saved index values
ZFILM: CAIN A,(D) ;have we removed any files yet?
JRST ZFILM3 ;no, don't need to move this file or adj indices
MOVSI T,ZDATA-2(A) ;BLT source for file entry move
HRRI T,ZDATA-2(D) ;BLT dest
BLT T,ZDATA-2+ZENT-1(D) ;move file entry down in main list
CAME A,ZINDEX ;is this the current file?
JRST ZFILM4 ;no
MOVEM D,ZINDEX ;yes, update its index
JRST ZFILM5
;Now fix file stack's index ptr for file being moved.
ZFILM4: MOVN TT,HOMMAX ;Get size of stack
MOVSI TT,(TT) ;Make aobjn ptr
ZFILM7: HRRZ C,HOMPLC(TT) ;Get index of some file on stack
CAIN C,(A) ;Is that the file we're moving?
JRST ZFILM6 ;Yes, adjust index on file stack
AOBJN TT,ZFILM7 ;Loop through stack
PUSHJ P,TELLZ ;File wasn't in the file stack!
ZFILM6: HRRM D,HOMPLC(TT) ;update file's index on the file stack
;Now fix window stack's index ptr(s) for file being moved.
;If file is only pointed to by dead window(s), won't be in the window stack.
MOVN TT,NWINS ;Get size of stack
MOVSI TT,(TT) ;Make aobjn ptr
ZFILM8: HRRZ C,WINSTK(TT) ;Get index of some file on window stack
CAIN C,(A) ;Is that the file we're moving?
HRRM D,WINSTK(TT) ;yes, update file's index in the window stack
AOBJN TT,ZFILM8 ;Loop through stack (file may be here repeatedly)
ZFILM5: CAMN A,ATTFIL ;did attach buffer come from this file?
MOVEM D,ATTFIL ;yes, update index
CAMN A,ANSFIL ;is this where subjob text goes?
MOVEM D,ANSFIL ;yes, update index
MOVEI T,WINHED ;hdr of window list
ZFILM2: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
JRST ZFILM3 ;yes
CAMN A,ZINDEX-WINDAT(T) ;is this the file whose entry is being moved?
MOVEM D,ZINDEX-WINDAT(T) ;yes, update its index
JRST ZFILM2 ;loop through all windows, including dead ones
ZFILM3: ADDI D,ZENT ;increment output ptr
POPJ P,
;No argument case for reporting
LAMEP0: SUB P,[1,,1] ;here from LAMEPS, return up one extra level
EXIST0: OUTSTR [ASCIZ /
/]
SETZM TYOPNT
MOVE D,[FRDRUN,,ZDATA] ;For typing filenames without switches
MOVEI E,1 ;report numbers from 1 to 8 (formerly 0 to 7)
EXIST1: SKIPN (D) ;Any filename here?
JRST POPJ1 ;No, must be end of list (don't say OK)
MOVEI TT,-1(E) ;internal index is still zero based
IMULI TT,ZENT
TYPDEC E ;File's index number
CAME TT,ZINDEX ;Skip if this is the current file
JRST EXIST3
PUSHJ P,GPAGL ;Get current line,,page into T
MOVSM T,ZPAGL(D) ;Put current page and line numbers inte ZDATA
TYPCHR "] " ;Mark current file differently for convenience
JRST .+2
EXIST3: TYPCHR ") "
PUSHJ P,FILSTR ;Type filename without switches
TYPCHR " "
HLRE TT,ZPAGL(D) ;Get page number
JUMPL TT,EXIS3A
TYPDEC TT
TYPCHR "P"
EXIS3A: HRRE TT,ZPAGL(D) ;Get line number
JUMPL TT,EXIS3B
TYPDEC TT
TYPCHR "L"
EXIS3B: TYPCHR " "
ADDI D,ZENT ;Next file's entry
CAIL E,ZNUM ;End of file list?
JRST POPJ1 ;Yes (don't say OK)
CAIE E,<ZNUM/2> ;No, are we exactly halfway through list?
AOJA E,EXIST1 ;No
SKIPN TYOPNT ;Yes, if we're typing, maybe should put out CRLF
PUSHJ P,CMDCRL ;Put out CRLF if past mid screen
SKIPE TYOPNT ;If not typing, definitely put out CRLF
TYPCHR "
"
AOJA E,EXIST1 ;Now do next file entry
;⊗ EXIST EXIST LAMEPS LAMEPE LAMEP3 EXISTE LAMEP4 LAMBDA EPSIL EPSIL0 EPSIL1 EPSIL2 EPSILP EPSIL4 EPSIL3 EPSIL6
repeat 0,< ;old code not using LAMEPS
EXIST: TRNN F,ARG
JRST EXIST0 ;No number given, just report filenames/numbers
JUMPL A,EXISTE ;No negative file numbers
SOJL A,EXIST0 ;Zero arg means just report info
CAILE A,ZNUM ;QUERY is now just beyond and is included
JRST EXISTE ;Illegal number
IMULI A,ZENT
SKIPN ZDATA(A) ;Check file name
JRST EXISTE ;none
PUSH P,A ;save file index
JRST HOMFI9 ;join ⊗H code
>;repeat 0
;Show file list if no arg or zero arg.
;With positive arg, switch to given numbered file from file list.
EXIST: TRNE F,ARG ;skip if no numeric arg
PUSHJ P,LAMEPE ;Check validity of arg (skips or returns uplevel)
JRST EXIST0 ;No number given, just report filenames/numbers
PUSH P,A ;save file index
JRST HOMFI9 ;join ⊗H code to switch to given file
;Routine to validate arg to ⊗ε and ⊗λ.
;Doesn't return if illegal arg given or if just going to type out file list.
;Takes skip return if (valid) arg given, direct return if no arg given.
LAMEPS: TRNN F,ARG
JRST LAMEP4 ;No number given (will read filename from tty)
LAMEPE: JUMPL A,LAMEP3 ;No negative file numbers
SOJL A,LAMEP0 ;Zero arg means just report info
CAILE A,ZNUM ;QUERY is now just beyond and is included
JRST LAMEP3 ;Illegal number
IMULI A,ZENT ;convert arg to file index
SKIPE ZDATA(A) ;Check file name, skip if none
JRST POPJ1 ;Skip return to indicate numeric arg
LAMEP3: SUB P,[1,,1] ;pop up a level
EXISTE: OUTSTR [ASCIZ/ No such file entry. /]
JRST POPJ1 ;skip return
LAMEP4: SETOM NOSTEP ;Suppress updating display if stepping macro
PUSHJ P,DISP ;must be called before ZSAVE flushes incore file
XCT LINTST ;Update display unless whole line typed ahead
POPJ P,
;⊗λ opens a file in read-only mode.
LAMBDA: SETOM RDONLY ;Set for readonly mode in new file
JRST EPSIL0
;⊗ε opens a file in read-write mode.
EPSIL: SETZM RDONLY ;Set for readwrite mode in new file
EPSIL0: PUSHJ P,LAMEPS ;Check validity of arg and do common ε and λ stuff
JRST EPSIL2 ;Go read name of file to switch to
PUSH P,A ;save file index (from numeric arg, e.g., ⊗#⊗ε)
PUSHJ P,MAKWCK ;see if want new window, open one if so
JRST POPAJ1 ;failed to open file to write it out, abort cmd
POP P,T ;new file's index
;here with T holding index of file to switch to.
EPSIL1: SUB P,[1,,1] ;Get rid of last return address
MOVE A,ZDATA(T) ;Switching by number, new index in T. Get filename.
MOVEM A,EDFIL
SKIPE A,RDONLY ;Don't preserve /F flag in readwrite mode
MOVE A,ZDATA-2(T) ;Get /F mode line count
HRRZM A,EDFIL-2
MOVE A,ZDATA-1(T) ;Get device name
MOVEM A,EDFIL-1
HLLZ A,ZDATA+EXT1(T) ;Get extension
MOVEM A,EDFIL+EXT1
SETZM EDFIL+2
MOVE A,ZDATA+PPN3(T) ;Get PPN
MOVEM A,EDFIL+PPN3
SKIPN D,RDONLY ;If in readwrite and formerly /F, clear /N
SKIPN ZDATA-2(T) ;Test old /F flag
MOVE D,ZDATA+4(T)
MOVEM D,EDFIL+4
SETZM NODUPD ;Clear /-U switch to allow directory updating
SETOM SBLOAT ;Don't bloat the file
SETOM SPAGE ;Use default starting page and line, which
SETOM SLINE ; will usually be old page and line we were at
SETOM SWIND ;Also window
SETOM SPROT ;No protection change for copying file yet
MOVEI C,15 ;BEG3 expects CR at end of "filename"
MOVE TT,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL
HRRZM TT,SRCFIL-EDFIL(TT)
HRRZM TT,DSTFIL-EDFIL(TT)
AOBJN TT,.-2
MOVE TT,ZDATA+ZFRDWN(T) ;Get FRDxxx flags for filename
HLLM TT,SRCFIL ;And make it look like we just read the filename
MOVSI D,FRDALL ;have whole filename for FNOWCK
PUSHJ P,FNOWCK ;see if want to check for this file in old window
JRST BEG3
;Get here when ⊗ε or ⊗λ given no numeric arg, ask for file name
EPSIL2: PUSHJ P,MAKWCK ;see if want new window, open one if so
JRST POPJ1 ;failed to open file to write it out, abort cmd
SKIPE RDONLY ;if default for new file is readonly mode,
HLLOS LAMFLG ; then force readonly on retries
HRROS LAMFLG# ;Flag explicit filename typed
SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
;Give him back control-cr feature and undo ALLACT
PUSHJ P,ABCRLF
PUSHJ P,LOADMT ;So that ALLACT won't affect filename line type-ahead
OUTSTR [ASCIZ /File? /] ;LOADMT skips if expanding a macro.
SETZM TYIPNT ;Make FRD read filename from TTY.
EPSILP: SUB P,[1,,1] ;Get rid of last return address
SETOM SWIND ;Initialize starting window, line and page
SETOM SLINE
SETOM SPAGE
SETOM SPROT ;No protection change for copying file yet
SETOM SBLOAT ;No bloating requested yet
SETZM NODUPD ;Clear /-U switch to allow directory updating
;; SETZM XXPAGE
;; SETZM XXLINE
SETZM BAKPLC ;Clear the page stack
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
MOVEI D,EDFIL ;Make FRD put filename at EDFIL.
MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
PUSHJ P,FRD ;Read the filename
JRST FNERR ;Error
CAIN C,15 ;if filename not ended with CR, don't abort window
PUSHJ P,FNOWCK ;see if want to check for this file in old window
JRST BEGSY3 ;go process new filename
;Here when aborting a fileswitching operation. Return to previous file.
EPSIL4: SKIPLE ZATT ;skip if have edited any file in this new window
JRST ABTWIN ;abort new window, reselect old one fixed up
SETZM PIFLAG ;Clear automatic-abort flag
SETZM TYIPNT ;Clear left-over part of filename
SETZM QUERYF ;Clear flag that said we were going to ? file
HRRZS LAMFLG ;Clear flag that said explicit filename typed
OUTSTR [ASCIZ / Request aborted.
/]
;Enter here from REOLUZ when couldn't reopen file because it had changed.
EPSIL3: PUSHJ P,MACSTP ;Terminate macro expansion.
;; SKIPGE T,ZABORT ;any special file to go to? (e.g., from FILDEL)
MOVE T,ZINDEX ;Get index of file we just left, to go back to it
CAIN T,ZSIZE ;Are we going back to ? file?
SETOM QUERYF ;Yes, take note of that
;Enter here from ⊗H command and from ⊗#⊗∃.
EPSIL6: SETZM RDONLY ;Prepare to restore old readonly status
MOVE TT,ZDATA+ZFLAGS(T) ;Find out old readonly status
TRNE TT,REDNLY ;If we were in readonly mode before,
SETOM RDONLY ;then put us in readonly now
JRST EPSIL1
;⊗ ZINUSE HOMPLC HOMMAX HOMDBL HOMSAV HOMSAD HOMSA2 HOMSA0 HOMSA3 HOMSA4 HOMSA5 HOMSA6 HOMFIL HOMFI2 HOMFI9 HOMFI8 HOMFI7 HOMFI6 HOMROT HOMFI3 HOMFI4 HOMFI5 HOMTE2 WINSTY HOMF5L HOMEF HOMEF2 HOMEF3 DBWINC DBWIN2 DBWIN3 DBWIN8 DBWIN4 DBWIN5 DBWIN6 DBWIN7 HSWTCH HSWTC2 HSWTC3 QUERY QUERY4 QUERY3 QUERY5 QUERY2
IMPURE
;Bits in left half of HOMPLC
ZINUSE←←1 ;Bit to make sure entry in use is non-zero
HOMPLC: BLOCK ZNUM ;list of file numbers we've been in recently (oldest last)
HOMMAX: 0 ;number of valid entries in above list
HOMDBL: 2 ;number of files back we go on αβH command
PURE
;Routine to update stack of files we've been in recently.
;Here from ZLIST6 and SELWIN.
;Called with index of file we're going to in T. Clobbers B,C,TT.
;This routine makes sure that no two remembered files have same index.
HOMSAV: SKIPGE C,ZINDEX ;Get index of file we're coming from
POPJ P, ;Not coming from anywhere yet
SKIPE HOMFAS# ;Have we already remembered file we're coming from?
JRST HOMSA0 ;Yes, just flush from stack the one we're going to
CAIE C,(T) ;Are we coming from same file we're going to?
CAIN C,ZSIZE ;Or are we coming from E.ALS?
JRST HOMSA3 ;Yes, don't insert in stack, flush new file's entry
HOMSAD: MOVEI TT,(C) ;Save copy of old file's index
MOVSI B,-ZNUM ;AOBJN ptr to list of places we've been
TLOA C,ZINUSE ;Make sure entry in stack is non-zero
HOMSA2: CAIE TT,(C) ;Is this the file we just put at top of stack?
CAIN T,(C) ;Is this file same as file we're going to?
JUMPN C,CPOPJ ;Yes to one, don't remember any file twice
EXCH C,HOMPLC(B) ;Remember new place and pick up older place
SKIPE HOMPLC(B) ;Did we just move the end marker in the list?
AOBJN B,HOMSA2 ;No, continue through list unless done
HRRZM B,HOMMAX ;Store number of valid entries in list
POPJ P,
;Here to flush stack entry, if any, for file we're going to (T).
HOMSA0: SETZM HOMFAS# ;Make sure we remember old file next time
HOMSA3: SKIPN HOMPLC ;Skip if anything in stack at all
POPJ P, ;Don't bother with file stack
MOVN B,HOMMAX ;Get size of stack
MOVSI B,(B) ;Make aobjn ptr
HOMSA4: HRRZ C,HOMPLC(B) ;Get index of some file on stack
CAIN C,(T) ;Is that the file we're going to?
JRST HOMSA6 ;Yes, flush from stack
AOBJN B,HOMSA4 ;Look through stack
POPJ P, ;File we're going to wasn't in the stack
HOMSA5: MOVE C,HOMPLC(B)
MOVEM C,HOMPLC-1(B) ;Squeeze entry out of middle of stack
HOMSA6: AOBJN B,HOMSA5
SOS B,HOMMAX ;One less entry in stack
SETZM HOMPLC(B) ;Mark end of stack with a zero
POPJ P,
;New version of ⊗H command -- same significance of arg as ⊗N and ⊗O cmds.
HOMFIL: JUMPE A,HOMFI4 ;Zero arg means just report some info
MOVM C,A ;Get positive index of desired old file
TRNE F,REL ;Relative arg?
JRST HOMFI7 ;Yes, wants to diddle file stack
CAIE B,CTMT3 ;αβ command?
JRST HOMFI2 ;No
TRNE F,ARG ;Yes, any arg?
MOVMM C,HOMDBL ;Arg given with αβ means set default for αβ
MOVM C,HOMDBL ;Get default for αβ command
HOMFI2: SKIPN HOMPLC ;Any remembered places at all?
JRST HOMFI3 ;No (check here to allow storing default for αβ)
CAMLE C,HOMMAX ;Range check index
MOVE C,HOMMAX ;Out of range -- get index of oldest place
HRRZ T,HOMPLC-1(C) ;index of desired file
JSP TT,DBWINC ;make sure this file isn't already open in another window
PUSH P,HOMPLC-1(C) ;Save index of place to return to
HOMFI9: PUSHJ P,WRPAGW ;skip if readwrite mode, formatted file, and will write
JRST HOMFI8 ;can't write or don't need/want to - won't attempt open
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPAJ1 ;can't open file (typed error msg), abort cmd, no OK
HOMFI8: PUSHJ P,MAKWCK ;see if want new window, open one if so
FATAL Can't open file to write out before switching files
POP P,T ;Get index of return file
JRST EPSIL6 ;Now switch to this file with old readonly status
HOMFI7: SKIPN HOMPLC ;Is there really any place remembered?
JRST HOMFI3 ;No, forget it
MOVE TT,HOMMAX ;size of stack
CAILE C,(TT) ;Want to diddle stack by more than its size?
JRST NOHSOV ;Yes, that's silly
MOVN T,A ;change sign of arg
JUMPG T,.+2 ;jump if negative arg given (positive now)
ADDI T,1(TT) ;positive arg (negative now) measures from bottom of stack
HRRZ T,HOMPLC-1(T) ;get index of desired file
JSP TT,DBWINC ;make sure this file isn't already open in another window
PUSHJ P,WRPAGW ;skip if readwrite mode, formatted file, and will write
JRST HOMFI6 ;can't write or don't need/want to - won't attempt open
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST POPJ1 ;can't open file (typed error msg), abort cmd
HOMFI6: PUSHJ P,HOMROT ;rotate file stack by (A)
SETOM HOMFAS# ;Tell HOMSAV (called from ZLIST6) not to diddle file stack
PUSH P,A ;Save index and flags for return file
MOVE T,ZINDEX
CAIN T,ZSIZE ;Are we leaving E.ALS?
PUSHJ P,HOMSA3 ;Yes, flush its new entry from the file stack
AOS T,HOMMAX ;Put file we're going to on bottom of adjusted stack
MOVEM A,HOMPLC-1(T) ;It can't be E.ALS and there can't have been a
JRST HOMFI8 ; full stack, so HOMMAX is still within the limit
;Rotate file stack by amt in A. Here from above and from FILDEL.
;Returns stack entry of "new current" file in A.
HOMROT: MOVE TT,HOMMAX ;Arg for NOHSTK -- size of stack
HRLI TT,HOMPLC ;Arg for NOHSTK -- stack's starting address
MOVE T,ZINDEX ;Another arg -- current place
TLO T,ZINUSE ;Make the entry nonzero so it looks in use
JRST NOHSTK ;Rotate file stack by (A)
HOMFI3: SORRY No old File to return to.
JRST POPJ1
;Here with zero arg
HOMFI4: CAIE B,CTMT3 ;αβ command?
JRST HOMFI5 ;No, type out file stack
MOVEI A,[ASCIZ /H/] ;Command to type out
MOVE B,HOMDBL ;Current default for αβ command
JRST NOHDEF
HOMFI5: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/File stack: (0)/]
;Here from /? switch to show file stack for /nH switch.
;Also here from ZFILES to show remaining files.
HOMTE2: MOVN E,HOMMAX ;minus size of stack
MOVSI E,(E) ;make aobjn cnt
HRRI E,HOMPLC ;aobjn ptr to stack
WINSTY: MOVE D,ZINDEX ;current file index ptr
ADD D,[FRDRUN,,ZDATA] ;Make pointer to 4-word block with file name and
PUSHJ P,FILTYP ; type filename without switches
SKIPN (E) ;Any other files?
JRST PPJ1CR ;No
SETZM TYOPNT
PUSH P,Q
MOVEI Q,1 ;initial stack level
HOMF5L: OUTSTR [ASCIZ/ (/]
TYPDEC Q ;Type level
OUTCHR [")"]
HRRZ D,(E) ;Get index of file on stack
ADD D,[FRDRUN,,ZDATA] ;Make absolute pointer to 4-word block holding filename
PUSHJ P,FILTYP ;Type filename without switches
ADDI Q,1 ;increment stack depth count for typeout
AOBJN E,HOMF5L ;Loop through whole file stack
POP P,Q
JRST PPJ1CR
;The ⊗XHOME command allows one to return to the previous file
;at a specific relative or absolute page.
HOMEF: SKIPE T,HOMPLC ;Get index, if any, of home file
SKIPN ZDATA(T) ;Make sure there is a filename there
JRST HOMFI3 ;None
JSP TT,DBWINC ;make sure this file isn't already open in another window
TRNN F,ARG!REL ;Was an argument or sign typed?
JRST HOMEF3 ;No
TRNN F,REL ;Was a sign used?
JRST HOMEF2 ;No
HLRE C,ZDATA+ZPAGL(T) ;Get former page reference
ADD A,C
JUMPG A,HOMEF2 ;Can't go to non-positive page number
MOVEI A,1 ;Go to page 1
HOMEF2: HRLZM A,ZDATA+ZPAGL(T) ;Set specified page
AOS ZDATA+ZPAGL(T) ;Set to line 1
HOMEF3: PUSH P,T
JRST HOMFI9 ;Now join new ⊗H command code
;Here to see if user is trying to switch to file that's already open in
;another window. If so, abort current command by not returning to caller
;(pops up a level and skips to avoid OK for cmd).
;Call with JSP TT,DBWINC, with T containing index of desired new file.
;Doesn't clobber anything except TT iff it returns to caller.
DBWINC: PUSH P,TT ;save return addr, so we can just POPJ
MOVE TT,NCMDS ;see if just gave new-window cmd
CAMN TT,WANTWN ;skip unless new window requested
SKIPN FNOWIN ;skip if we'll automatically select old window anyway
SKIPN TT,NWINS ;get number of extra windows open
POPJ P, ;no extra windows to worry about
PUSH P,B ;save an AC
MOVNI TT,(TT) ;make aobjn cnt for window stack
MOVSI TT,(TT) ; in left half
DBWIN2: HRRZ B,WINSTK(TT) ;get file index from window stack
CAIN B,(T) ;is this the file we're checking for?
JRST DBWIN3 ;yes
AOBJN TT,DBWIN2 ;no, keep looking
JRST POPBJ ;restore B and return, file not open in any other window
DBWIN3: SORRX Already open in another window:
JRST PPBAJ1 ;suppressing error msgs, return from cmd, don't say OK
MOVEI D,ZDATA(T) ;get ptr to filename
HRLI D,FRDRUN ;suppress switch typeout
PUSH P,TT ;save aobjn ptr
PUSH P,T ;save file index
PUSHJ P,FILTYP ;type filename
OUTSTR [ASCIZ/; use /]
POP P,T ;file index
POP P,TT ;aobjn ptr
DBWIN8: MOVEI B,1(TT) ;stack depth of window containing desired file
CAIN B,1 ;arg of 1 can be omitted
JRST DBWIN4
OUTCHR ["⊗"]
TYPDEC B ;tell arg needed to select window
DBWIN4: OUTSTR [ASCIZ/αG /] ;report cmd user can type to get to this file
;now look for more windows with same file open
JRST DBWIN6
DBWIN5: HRRZ B,WINSTK(TT) ;get file index from window stack
CAIN B,(T) ;is this the file we're checking for?
JRST DBWIN7 ;yes
DBWIN6: AOBJN TT,DBWIN5 ;no, keep looking
JRST PPBAJ1 ;return from cmd (aborting it), don't say OK
;found a second window with given file open
DBWIN7: OUTSTR [ASCIZ/or /]
JRST DBWIN8
;Here for /nH switch, meaning use filename from nth home file (i.e., to make
;name of file to be edited now). /-H means latest file, /H or /1H means home file.
HSWTCH: SETZM -2(D) ;Clear /F switch
SETZM 4(D) ;Clear /N switch
JUMPG A,HSWTC2 ;jump if positive arg to switch, use nth home file
JUMPL A,HSWTC3 ;if index was negative, use latest file
TLNE D,FRDALL ;any part of filename given?
JRST HSWTC3 ;yes, fill in remainder of name from latest file
MOVEI A,1 ;use home file for zero or no arg
HSWTC2: CAMLE A,HOMMAX ;Range check index
MOVE A,HOMMAX ;Out of range -- get index of oldest place
SKIPLE A ;use latest file if no home file or negative arg given
SKIPA T,HOMPLC-1(A) ;get index of place to return to
HSWTC3: MOVE T,ZINDEX ;if no home files, must use latest
MOVE TT,ZDATA-1(T) ;get that file's device
TLON D,FRDDEV ;explicit device name seen?
MOVEM TT,-1(D) ;no, copy device name
MOVE TT,ZDATA(T) ;get that file's name
TLON D,FRDNAM ;explicit name seen?
MOVEM TT,(D) ;no, copy file name
HLLZ TT,ZDATA+EXT1(T) ;get that file's ext
; TLON D,FRDEXT ;explicit ext seen?
TLNN D,FRDEXT ;explicit ext seen?
HLLM TT,EXT1(D) ;no, copy explicit extension (even if null)
repeat 0,<
TLNN D,FRDEXT ;explicit ext seen? (don't assume same extension if null)
HLLM TT,EXT1(D) ;no, copy extension
printx Should /H force only the implied extension to be used?
jfcl; SKIPE TT
jfcl; TLO D,FRDEXT ;non-null extension means use only it, no others
>;repeat 0
MOVE TT,ZDATA+PPN3(T) ;get that file's project
TLON D,FRDPRJ ;explicit project seen?
HLLM TT,PPN3(D) ;no, copy project
MOVE TT,ZDATA+PPN3(T) ;get that file's programmer name
TLON D,FRDPRG ;explicit programmer name seen?
HRRM TT,PPN3(D) ;no, copy programmer name
POPJ P,
;QUERY allows you to reference the file E.ALS[UP,DOC] to check on some feature
;without losing your place in the file being edited. You get back home by the H
;command. On a second call, QUERY remembers where you were and returns there.
;QUERY will accept an argument specifying a desired page or a signed argument to
;specify a relative change from the previous page specification.
QUERY: MOVEI T,ZSIZE ;index of E.ALS in filelist
CAMN T,ZINDEX ;Are we already in E.ALS[UP,DOC]?
JRST QUERY2 ;Yes
JSP TT,DBWINC ;make sure this file isn't already open in another window
SETOM QUEWIN# ;any new window IS for question-mark file
TRNN F,ARG!REL ;Was an argument or sign typed
JRST QUERY3 ;No
TRNN F,REL ;Was a sign used?
JRST QUERY4 ;No
HLRE C,ZDATA+ZPAGL+ZSIZE ;Get former page reference
ADD A,C
SKIPG A
MOVEI A,1 ;Go to directory page in this case
QUERY4: HRLZM A,ZDATA+ZPAGL+ZSIZE ;Set specified page
AOS ZDATA+ZPAGL+ZSIZE ;Set to line 1
QUERY3: PUSHJ P,MAKWCK ;see if want new window, open one if so
JRST POPJ1 ;failed to open file to write out, abort cmd
QUERY5: SETOM RDONLY ;Specify readonly mode for ? file
SETOM QUERYF ;Set flag to prevent storing at ZLIST time
MOVEI T,ZSIZE
JRST EPSIL1 ;Switch by number
QUERY2: SORRY <You are already in E.ALS[UP,DOC]!>
JRST POPJ1
;PIERR POINTE PICMD4 PICMD0 PICMD2 PICMD3 PICMD5 PIPPN PICOP0 PICOPY PILOOP PILOP2 PIFILE PIFIL3 PIFIL4 PITYPE PSWLOP PNOSWI PSWITL PISWIT PISCAN PISCCR PISCN1 PILSPC PILSP2 PIEXT PINAM0 PINAME PINAM2 PINAMX PIHACK PIHAK2 PITYIX PICHAR
PIERR: SORRY No such filename in text.
JRST POPJ1
;Look for a filename in the text starting at the current line.
;Filename must be preceded by a space, a tab, or the beginning of the line.
;Filename can contain letters, digits, underbars, and (inside PPN only) spaces.
;Filename can be a filehack.
;Extension can be greater-than sign, but that char can't be doubled.
;Switches, if any, following filename are used followed by text, if any,
;that follows name of extended command.
POINTE: MOVEI D,PISCAN ;Set up address of coroutine to read chars from text
MOVMM A,JCNT ;Save arg
JRST PICMD0 ;don't need to backup uninitialized byte pointer
PICMD4: TESTBP PIENDP ;make sure byte ptr hasn't already been backed up
MOVE TT,[70000,,0] ;Here after finding one filename but needing more
ADDM TT,PIENDP ;Back up over filename delimiter
PICMD0: SETZM TYIPNT ;Don't let us accidentally read left over line text
PICMD2: JSP D,(D) ;Get char from line
JRST PICMD5 ;End of line, look for filename starting next line
JRST PIERR ;End of text, failed to find filename
PICMD3: CAIE A," " ;Is this a legal char to precede filename?
CAIN A,11
JRST PICMD5 ;Space and tab are legal
CAIN A,"#"
JRST PICMD5 ;Also number-sign, for MAIL destination filenames
CAIE A,"@" ;Also at-sign
CAIN A,42 ;Double quote is also legal
PICMD5: PUSHJ P,PICHAR ;Yes, get what might be first char of filename
JRST PICMD2 ;Not legal filename preceder, or end of text or line
MOVE G,PIENDP ;Save byte pointer to possible first char in filename
CAIN A,"\" ;Maybe this is a filehack coming
JRST PIHACK ;Yes, go see if it has valid name
MOVSI C,-6-1-1 ;Max length of primary file name (one extra char allowed)
JSP H,PINAME ;Try reading first name of file
MOVSI C,-6-1-1 ;Max length of primary file name (one extra char allowed)
CAIN A,":" ;Was this really a device name?
JSP H,PINAM0 ;Yes, now try reading real first name of file
MOVE I,PIENDP ;Remember byte pointer where first name ended
CAIN A,"." ;Skip unless extension coming
JSP H,PIEXT ;Try reading extension
CAIE A,"[" ;Skip if PPN coming
JRST PICOP0 ;No PPN, check for switches
PIPPN: JSP H,PILSPC ;Scan project, allowing leading spaces
CAIE A,"," ;Required ending char of project?
JRST PICMD3 ;Nope
JSP H,PILSPC ;Scan programmer, allowing leading spaces
CAIE A,"]" ;Required ending char of programmer?
JRST PICMD3 ;Nope
PUSHJ P,PICHAR ;Get char after right bracket
JFCL ;End of text is okay (but can't happen without CR first)
PICOP0: CAMN I,PIENDP ;must have seen something other then name, before switches
JRST PICMD3 ;not valid filename, keep scanning
PUSHJ P,PISWIT ;Now scan for switches
CAIA ;CAMN I,PIENDP ;Did we see anything but first name of file?
JRST PICMD3 ;No, or illegal switch -- not valid filename -- try again
MOVSI DSP,-40*5+3 ;Leave room for space, CR, and null. Count chars.
PICOPY: MOVE B,[POINT 7,BUF] ;Copy text between G and PIENDP into buffer
TESTBP G ;make sure byte ptr hasn't already been backed up
ADD G,[70000,,0] ;Back up over first char of filename
PILOOP: ILDB C,G ;Take char out of the line of text
IDPB C,B ;And put it into the buffer
CAME G,PIENDP ;Copy until come to filename end that we saw
AOBJN DSP,PILOOP ;But don't overflow the buffer
TRNN DSP,-4 ;Min legal length of filename is 4 unless filehack
JRST PICMD3 ;Too short (e.g., "F.E" or "F/S")
SOSLE JCNT ;Found enough filenames?
JRST PICMD4 ;No look for another
ILDB T,EXTPNT ;Get char ending extended command name
CAIN T," " ;Don't include leading space
ILDB T,EXTPNT ;Get first normal following char
JUMPE T,PIFILE
ILDB C,EXTPNT ;Get next char
JUMPE C,PIFILE ;Jump if ending char was activator
DPB T,B ;Include chars from command at end of filename
PILOP2: IDPB C,B
ILDB C,EXTPNT ;Next char from command
AOBJP DSP,.+2 ;Don't overflow the buffer
JUMPN C,PILOP2
IBP B ;Prevent clobberage of last char by DPB below
PIFILE: MOVEI C,40 ;Put space at end of filename in case name stopped
DPB C,B ; right after slash (clobber char ending filename)
MOVEI C,15
IDPB C,B ;End filename with normal CR
MOVEI C,0
IDPB C,B ;End the string with a null
TRNE F,ARG
TRNE F,REL ;2XPOINTER doesn't move to line found, just types filename
JRST PIFIL3 ;XPOINTER, +/- 2XPOINTER all move to nth filename found
SKIPL JCNT ;Skip for 0XPOINTER, which moves like -1XPOINTER
JRST PITYPE ;Type out filename without moving to line where found
PIFIL3: SKIPE A,PILINE ;Get number of lines we need to move to get to filename
PUSHJ P,MOVARR ;And move there before leaving this file
TRNN F,REL!ARG
JRST PIFIL4 ;XPOINTER switches files
TRNE F,REL ;So does +2XPOINTER, w/ or w/out the 2
TRNE F,NEG ;But -2XPOINTER just types out filename
JRST PITYPE
SKIPGE JCNT ;Skip unless arg was 0
JRST PITYPE ;+0XPOINTER moves arrow but doesn't switch files
PIFIL4: MOVEI DSP,0 ;Let WRPAGE (via MAKWCK) know we're not from line editor
PUSHJ P,MAKWCK ;see if want new window, open one if so
JRST POPJ1 ;failed to open file to write it out, abort cmd
SETOM PIFLAG# ;Flag FNF to abort fileswitching automatically if error
MOVE T,[POINT 7,BUF] ;pointer to filename to re-scan
MOVEM T,TYIPNT ;Make FRD read filename from the buffer
MOVEM T,RSPNT ;Load resultant string into line editor if get ill file spec
MOVE T,[JRST TYI5] ;instr executed after filename string used up
MOVEM T,TYIINS ;back to normal input (macro or TTY) after reading filename
SETOM RDONLY ;Default mode for named file is readonly
JRST EPSILP ;Go switch files
PITYPE: PUSHJ P,ABCRLF ;Get to left margin on typeout
OUTSTR BUF ;Type filename, ending in CR
OUTCHR [12] ;Then type a LF
JRST POPJ1
;Routine to check syntax of any switches following filename. Skips if all okay.
PSWLOP:
; CAIN C,"("
; JRST PSWITL
CAIE C,"/"
JRST POPJ1 ;Legal end of switches
PUSHJ P,NTYI ;Read number and upper-case letter of switch
CAIL C,"A"
CAILE C,"Z"
POPJ P, ;Illegal switch char isn't a letter
TLOA F,TF1 ;Just saw letter of switch
PNOSWI: TLZ F,TF1 ;Here after balanced parens
PUSHJ P,TYIU ;Get next upper-case char
JRST POPJ1 ;CR is legal end of switches
TLNE T,LETF!NUMF ;Is this a letter or digit?
TLNN F,TF1 ;Yes, skip if previous char a switch letter.
JRST PSWLOP ;Look for another switch
POPJ P, ;Illegal to have letter or digit follow switch letter
PSWITL: PUSHJ P,NTYI ;Read number and upper-case letter of switch
CAIN C,")"
JRST PNOSWI ;Filenames in text MUST have balanced parens
CAIL C,"A"
CAILE C,"Z"
POPJ P, ;Illegal switch char isn't a letter
JRST PSWITL
;Routine to scan for switches and skip return if illegal switch syntax found.
PISWIT: MOVE C,PIENDP ;Byte pointer to continue reading from
MOVEM C,TYIPNT ;Make TYI and NTYI read from incore text
MOVE C,A ;Put current char where routines expect it
PUSHJ P,PSWLOP ;Scan for switches
AOS (P) ;Illegal switch
PUSHJ P,PITYIX ;Restore our byte pointer and clear TYIPNT
POPJ P, ;End of line
POPJ P, ;Not end of line
;Coroutine to read chars from incore text, starting at current line.
;Call by JSP D,(D)
; Direct return on end of line.
; Skip return on end of text.
; Double skip on normal char in line.
PISCAN: SETOM PILINE# ;Count number of lines down we move to find filename
HLRZ A,@ARRLIN ;Get ptr to previous line
MOVEM A,PICURL# ;Save for advancing to next line
;Chars in this line ran out.
PISCCR: JSP D,(D) ;Return indicating end of line
HRRZ A,@PICURL ;Get the address of the next line
CAIN A,BOTSTR ;Skip unless this is end of page
AOJA D,PISCCR ;Force return meaning end of text
MOVEM A,PICURL# ;Save for advancing to next line
ADD A,[10700,,LLDESC-1] ;Make byte ptr to text of this line
MOVEM A,PIENDP# ;Set up byte pointer for scanning text of this line
MOVEM A,PIBEGP# ;Save byte pointer to beginning of line for backing up
AOS PILINE ;Keep track of how many lines we've looked at
PISCN1: ILDB A,PIENDP
CAIN A,15
JRST PISCCR ;End of line
JSP D,2(D) ;Take return for normal char
JRST PISCN1 ;Loop through all chars of line until we see CR
;Read name (part of PPN) that may have leading spaces
;Called by JSP H,PILSPC
PILSPC: MOVSI C,-3-1 ;Look for 3 chars including leading spaces
PILSP2: PUSHJ P,PICHAR ;Get char
JRST PICMD2 ;End of line or page
CAIE A," "
JRST PINAME ;Now look for letters/digits followed by delimiter
AOBJN C,PILSP2
JRST PICMD5 ;Too many spaces!
;Routine called when dot seen at end of first part of filename.
;Doesn't return if can't be filename extension here.
;Called by JSP H,PIEXT
PIEXT: PUSHJ P,PICHAR ;Get char after dot
JRST PICMD2 ;End of line, this can't be a filename after all
CAIN A,"["
JRST PIPPN ;Null extension is legal if PPN is coming
CAIN A,"/"
JRST PICOP0 ;Null extension also okay if switches coming
MOVSI C,-3-1 ;Max length of extension
CAIE A,">" ;Is this the numeric extension hack?
JRST PINAME ;No, scan for normal extension
PUSHJ P,PICHAR ;Yes, get following char
JRST (H) ;End of line is OK
CAIN A,">" ;Disallow PUB-like comments chars after sentence.
JRST PICMD2 ;Not a filename, maybe a PUB comment
JRST (H) ;Return with char in A
;Routine that returns only if it finds 1 to N letters, digits, underbars.
;N is aobjn counter in C.
;Called by JSP H,PINAME
PINAM0: PUSHJ P,PICHAR ;Get next char
JRST PINAMX ;End of line or page -- end of filename part
PINAME: CAIL A,"0"
CAILE A,"9"
CAIN A,"_" ;Underbar represents a quoted space
JRST PINAM2 ;Digit or underbar is okay
CAIL A,"A"
CAILE A,"Z"
JRST .+2
JRST PINAM2 ;Upper case
CAIL A,"a"
CAILE A,"z"
JRST PINAMX ;Neither a letter nor a digit nor an underbar
PINAM2: AOBJN C,PINAM0 ;Keep looping unless found too many letters/digits already
JRST PICMD2 ;Name too long, try again
PINAMX: TRNE C,-1 ;Did we find any legal filename chars?
JRST (H) ;Yes, return to caller
JRST PICMD3 ;Nope, back to main loop
PIHACK: MOVEM G,TYIPNT ;Read filehack from text of line
PUSHJ P,FLHAK0 ;Search filehack table for following name
JRST PICMD0 ;Not a legal filehack
MOVE DSP,[-40*5+3,,4] ;Leave room for space, CR, and null
PUSHJ P,PITYIX ;Restore our byte pointer and clear TYIPNT
JRST PICOPY ;End of line -- copy filename to buffer and go switch files
MOVE T,HAKDSP-HAKTAB(T) ;Get pointer to filename
SKIPN (T) ;Does this filehack take a programmer name?
CAIE A,":" ;Yes, is there a programmer name coming?
JRST PIHAK2 ;No
MOVSI C,-3-1 ;Max length of programmer name
JSP H,PINAM0 ;Read programmer name for filehack (no leading spaces!)
PIHAK2: PUSHJ P,PISWIT ;Scan for switches
JRST PICOPY ;Copy filename to buffer and go switch files
JRST PICMD3 ;Illegal switch
;Routine to restore our byte pointer and clear TYIPNT.
;Skip returns on normal char, returns direct on end of line or end of text.
;Called by PUSHJ P,PITYIX
PITYIX: MOVE TT,TYIPNT ;Get ptr to byte beyond name
SETZM TYIPNT ;Don't let us take any more input from text
TESTBP TT ;make sure byte ptr hasn't already been backed up
ADD TT,[70000,,] ;Back up over delimiter
MOVEM TT,PIENDP ;Continue reading line from end of name
MOVEI D,PISCN1 ;Re-read last char (delimiter)
;Routine to skip on normal char, return direct on end of line or end of text
;Called by PUSHJ P,PICHAR
PICHAR: JSP D,(D) ;Get next char
MOVEI D,PISCCR ;End of line -- make us see it again next time
POPJ P, ;End of text
JRST POPJ1 ;Normal char -- skip return
;SUBSTR SUBST6 SUBST1 SUBST0 SUBST2 SUBST3 EATTAB SUBTAB FIXTAB
SUBSTR: PUSHJ P,ENDSET ;Set up expandable free storage
TLO F,NOCHK
HRRZ H,FSEND
ADDI H,1
MOVE I,ARRLIN ;Set by SETARR to line for action
MOVE E,SAVEE ;This may have been changed
SETZB B,G
HLLZ Q,TXTFLG(I)
LEG HLLZM Q,TXTFLG(H)
MOVEM H,ARRLIN
TLNE Q,WINBIT
MOVEM H,WINLIN
MOVE A,I
MOVE TT,(A)
LEG MOVEM TT,(H)
HLRZ T,TT
HRRM H,(T)
HRLM H,(TT)
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
LEG SETZM TXTWIN(H) ;clear window ptr for line in current window
MOVEM TT,SRCNUM ;This will have been changed
ADD A,[440700,,LLDESC] ;Location where text starts
MOVE D,H
ADD D,[440700,,LLDESC]
MOVEI Q,SUBBUF(E) ;Substitution text location
ADD Q,[440700,,0]
HRRE T,SRCOFF ;Character position to start deletion
JUMPLE T,SUBST1 ;Substitution starts with the first character
SUBST6: ILDB C,A
LEG IDPB C,D ;Copy text to deletion point
CAIN C,11
PUSHJ P,SUBTAB ;We must do this to get G and B set right
AOS B
SOJG T,SUBST6
SUBST1: HLRZ T,SUBSIZ(E) ;Get count of text to delete
MOVEM A,ASAVE
SUBST0: ILDB C,A ;Index over replaced text
CAIN C,15
JRST SUBOVE ;Not allowed at present
CAIN C,11 ;TABs require special treatment
PUSHJ P,EATTAB
SOJG T,SUBST0 ;Count deletions
HRRZ T,SUBSIZ(E) ;Length of substitution string is here
JUMPE T,SUBST3 ;The null substitution case
SUBST2: ILDB C,Q
LEG IDPB C,D
CAIN C,11
PUSHJ P,FIXTAB ;Must fix TAB representation (note skip return)
AOS B
SOJG T,SUBST2 ;Count insertions
SUBST3: ILDB C,A ;Get rest of original text
CAIN C,15 ;Watch for the CR
JRST SUBST4
LEG IDPB C,D
CAIN C,11
PUSHJ P,SUBTAB ;Do proper thing for TABs (note skip return)
AOS B
JRST SUBST3 ;Go on anyway, test comes later
EATTAB: ILDB C,A ;Eat all blanks to the next TAB
CAIE C,11
JRST .-2
POPJ P,
;This routine eats old spaces associated with tabs and puts in the correct number.
;It also keeps the correct records in G and B.
SUBTAB: ILDB C,A
CAIE C,11 ;First eat all old spaces
JRST .-2
FIXTAB: ADDI G,(B)
HRLI B,(B)
TLO B,-10
MOVEI TT,40
LEG IDPB TT,D ;Insert correct number of spaces
AOBJN B,.-1
SUBI G,-1(B)
LEG IDPB C,D ;Deposit terminating TAB
AOS (P) ;Skip return as we have already updated B enough
POPJ P,
;SUBOVE SUBST4 SUBST5 QFAST3 QFAST4 QFAST5 SUBSAY
;Substitution for CR not allowed
SUBOVE: MOVE A,ASAVE ;Back up to start of deletion
SOS QCHR ;So count will be correct
SOS SUBFLG(E) ;for either answer below
OUTSTR [ASCIZ/
Replacing CR (line /]
SETZM TYOPNT
TYPDEC ARRL
OUTSTR [ASCIZ/, page /]
TYPDEC CURPAG
OUTSTR [ASCIZ/) not allowed. Type Y to skip and go on? /]
PUSHJ P,YESCHK
JRST SUBST3 ;Yes
HRRZS QCHR
JRST SUBST3
;We have come to the end of the line
SUBST4: HRRZ T,B ;Are there be any chars left?
JUMPN T,SUBST5 ;Yes
MOVEI T,40 ;Need at least 1 char
LEG IDPB T,D
TLO F,NULLIN ;No text in this line
SUBST5:
LEG IDPB C,D ;Now the CR
MOVEI C,12
LEG IDPB C,D
TDZA C,C ;Set C to zero and skip
LEG IDPB C,D
TLNE D,760000
JRST .-2 ;Pad out with nulls
;Text must be in ASCID
MOVEI T,LLDESC(H)
MOVEI TT,1
IORM TT,(T)
CAIGE T,(D)
AOJA T,.-2
;Now we must give up the space originally used by the line
HLRZ T,TXTCNT(I)
MOVNI T,(T) ;Substract old version's char count
ADDM T,CHARS ; from incore text's total
ADDI G,2(B) ;Allow for CR and LF in G count
ADDM G,CHARS ;Add new version's char count to incore total
HRLZS G
IORI G,(B)
LEG MOVEM G,TXTCNT(H) ;Store char counts in new version of line
MOVEI TT,2(D)
MOVSI T,TXTCOD ;Flag this free storage as a text line
FSFIX TT,T ;Finish up free storage of new version of line
PUSHJ P,ENDFIX ;Close off expandable free storage
MOVE A,I
PUSHJ P,FSGIVE ;Give up free storage for old version of line
TLZ F,NOCHK
PUSHJ P,SETWRT ;Note that text has changed
HRRZ TT,SUBSIZ(E)
ADD TT,SRCOFF
SUBI TT,1
HRRZM TT,SRCOFF ;Move to last character of substitution
;Update count and test for continuance
PUSHJ P,SUBCNT ;Count a substitution for RDV
MOVE TT,QCHR
AOBJP TT,QFAST4
SKIPE ESCIEN
JRST QFAST3
MOVEM TT,QCHR
MOVEM TT,SUBFLG(E)
MOVEI TT,1 ;Tell search routine to find next occurrence
MOVEM TT,SRCNT ; of the search string
TRZ F,ARG!REL
TLZ F,OKF
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
JRST FNDBSL ;Go to the page-only routine
QFAST3: PUSHJ P,ABCRL0
OUTSTR [ASCIZ /ESC I substitution stop /]
QFAST4: JUMPE TT,QFAST5
AOS SUBFLG(E)
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSTP ;To report on actual number replaced
QFAST5: SETZM QCHR ;Have done 1 substitution
SUBSAY: SKIPG BLAB ;Don't say anything except in verbose mode
POPJ P,
PUSHJ P,ABCRL0 ;Put out CRLF if needed
OUTSTR [ASCIZ /You have replaced /]
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSP3
;⊗ SPOOLD NOSPOO XSPOOL SPOOLC DOVER BOISE IMPRINT ESPOOL ROVER PLOVER STRUDE PANCAK LATHRO SPOOL0 SPOOL1 SPOOL2 SPOOLL SPOOLE SPLINI MWRBUF SCLOBF MAIOUT MAIOU2 MAIOUL MAIOU3 XWRDON SPOOLW SPLCHK
IMPURE
SPOOLD: BLOCK 21
PURE
NOSPOO: SORRX Only the following spoolers are available on this system:
JRST POPJ1
IFN FTGSPL,<
MOVE T,[-LTELBF,,SPLBUF]
SPOOLR T, ;get list of all spoolers
MOVEI T,0 ;indicate overflow (shouldn't happen)
OUTSTR [ASCIZ/
/]
OUTSTR SPLBUF ;type names
SKIPN T
OUTSTR [ASCIZ/.../] ;indicate overflow
>;IFN FTGSPL
JRST POPJ1
XSPOOL: JSP T,SPOOL0 ;-1 indicate XGP spooling
SPOOLC: JSP T,SPOOL0 ;0 indicate LPT spooling
DOVER: JSP T,SPOOL0 ;1 indicate DOVER spooling
BOISE: JSP T,SPOOL0 ;2 indicate BOISE spooling
IMPRINT:JSP T,SPOOL0 ;3 indicate IMPRINT spooling
ESPOOL: JSP T,SPOOL0 ;4 indicate ESP spooling
ROVER: JSP T,SPOOL0 ;5 indicate Rover spooling
PLOVER: JSP T,SPOOL0 ;6 indicate Plover spooling
STRUDE: JSP T,SPOOL0 ;7 indicate Strudel spooling
PANCAK: JSP T,SPOOL0 ;10 indicate Pancake spooling
LATHRO: JSP T,SPOOL0 ;11 indicate Lathrop spooling
SPOOL0: MOVEM A,SPLNBR# ;Save number of lines to spool
IFE FTGSPL,<
HRREI T,-SPOOLC-1(T) ;calculate offset, making 0 for LPT spooler
MOVEM T,XGPFLG ;remember what device we're spooling on
;Check bits for system's existing spoolers:
; 1(xgp),2(lpt),4(dover),10(boise),20(imprint),40(esp),100(rover),200(plover),
; 400(strudel),1000(pancake),2000(lathrop)
MOVEI A,357 ;get system bits indicating
PEEK A, ; which spoolers exist
MOVN B,XGPFLG ;get code indicating requested spooler
ROT A,-2(B) ;shift appropriate bit into sign bit
JUMPGE A,NOSPOO ;jump if no such spooler on this system
>;IFE FTGSPL
IFN FTGSPL,<
PUSHJ P,SPLCHK ;check for valid printer name in this system
JRST NOSPOO ;no such printer here
>;IFN FTGSPL
PUSHJ P,XTDLIN ;check extended command line for (useless) switches
SETZM TWOPAG ;assume no two-sided printing
SPOOL1: PUSHJ P,TYI ;any input?
JRST SPOOL2 ;activator -- no switches seen
CAIE C,"/" ;switch coming?
JRST SPOOL1 ;not yet
SETZM TYIPNT ;forget remaining command line
SORRY No switches permitted in spooling command -- aborted.
JRST POPJ1
SPOOL2: PUSHJ P,XTDBEG ;scan command line again for junk
PUSHJ P,SKPSPC ;allow spaces and tabs -- skip over them
CAIE C,"2" ;kludge for two-sided printing
JRST SPOOL3
SETOM TWOPAG ;wants two sided printing
PUSHJ P,SKPSP2 ;skip past "2" and any spaces or tabs
SPOOL3: PUSHJ P,XTDEND ;make sure nothing extraneous in spooling cmd
PUSHJ P,CHKDSK ;make sure logical device DSK is physical DSK
JRST PPJ1CR ;failed with error msg, no OK
SETZM MAIFLG ;Coming from SPOOL command, not MAIL nor DFIND
MOVE T,EDFIL
MOVEM T,SPOOLD+7 ;Start with first cha. of real name
MOVE T,FIRPAG
MOVE A,[POINT 6,SPOOLD+7,5] ;Use 1 character of name
PUSHJ P,NUMSIX ;Add the page number
MOVEI TT,'$'
SKIPA
IDPB TT,A
TLNE A,760000
JRST .-2 ;Fill out with '$' characters
MOVEI TT,20 ;Limit times to try
SPOOLL: MOVEI T,'LPT'
HRLZM T,SPOOLD+10 ;Six-bit file extension of source
MOVSI T,400000 ;Dump-never protection
MOVEM T,SPOOLD+11
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file
MOVE T,EDFIL
MOVEM T,SPOOLD+13 ;Alias name in six-bit
MOVE T,EDFIL+1
MOVEM T,SPOOLD+14 ;Alias extension in six-bit
MOVE T,EDFIL+PPN3
MOVEM T,SPOOLD+15 ;Alias PPN in six-bit
MOVE T,FIRPAG
HRLM T,SPOOLD+16 ;Alias page number in left half
MOVEI T,21
SKIPE TWOPAG# ;Skip unless wants two-sided printing
IORI T,100 ;Turn on 2-sided flag
HRRM T,SPOOLD+16 ;Flags to print headings and delete file
SETZM SPOOLD+17
SETZM SPOOLD+20
OPEN DSKSP,[DMPMOD↔'DSK '↔0]
PUSHJ P,TELLZ
LKPMAC <LOOKUP DSKSP,SPOOLD+7>
JRST SPOOLW ;Safe to use this name
CLOSE DSKSP,
MOVEI T,1
ADDM T,SPOOLD+7
SOJG TT,SPOOLL
SPOOLE: OUTSTR [ASCIZ /
Something is wrong with the spooler. Try again later.
/]
JRST POPJ1
;Initialize for text output for special commands
SPLINI: SETZM OBLK
PUSHJ P,XWRBF3 ;To set up OCNT and OPNT for first load
MOVEI DSP,XWRDSP
MOVSI E,LSPC+NSPEC
SKIPA G,OPNT ;set up byte ptr and then clear output buffer
;If someone later is going to write the buffer w/o filling it,
;then you must clear it. Here to write the buffer and clear it
MWRBUF: PUSHJ P,XWRBUF ;write out the buffer, then clear it
SCLOBF: MOVE T,[OBUF-1,,OBUF]
BLT T,OBUF+177 ;Clear buffer
POPJ P,
;Here from MAIL/SEND/REMIND/DFIND to copy cmd line to file.
;Skips unless cmd is aborted.
MAIOUT: PUSHJ P,SPLINI
SETO T,
GETLIN T ;Get our TTY line number for mail
MOVEI T,(T) ;Just our line number
SKIPG MAIFLG ;Skip if from DFIND (no TTYRET)
CAIN T,-1 ;Skip unless detached
JRST MAIOU2 ;Omit TTYRET
MOVEM G,TYOPNT ;Store byte pointer for using user uuos
MOVE A,['TTYRET']
PUSH P,C ;save cmd line activator
PUSHJ P,SIXTYO ;Type out cmd name for mail to return msg
POP P,C
TYPCHR " "
TYPOCT T ;Output octal number
TYPCHR " "
PUSHJ P,MWRBUF ;write out one record
MAIOU2: MOVE T,[440700,,EXTBUF] ;Copy extended command into file
PUSHJ P,XTDLI2 ;let us read entire extended cmd again
MOVEI T,[ASCIZ/Continue text (Alt=abort),/]
MOVEM T,PGCONA ;message to type out if line ends with LF
MOVEI T,POPUP ;address to jump out to upon abort in PGCHAR
MOVEM T,PGCHAX ;store for subroutine abort
MOVSI T," R"⊗4
HLLM T,EMFLG ;set "R" in hdr, indicating Ready for αβLF
SETOM NEEDHD ;set flag to make HEADS think about hdr line
TLZ F,TF1!TF2!TF3 ;flag not multi-line text yet, no LF needed yet
SETOM LINFLG ;read chars in line mode
SETZM LINFL2 ;and don't change mode upon ESC I
MAIOUL: PUSHJ P,PGCHAR ;get a char from line or beyond (after LF)
JRST MAIOU3 ;End of message
SOSG OCNT ;room in buffer for char? (leave one space for FF)
PUSHJ P,MWRBUF ;nope, write buffer and clear it
IDPB C,OPNT ;put char in buffer
JRST MAIOUL ;get next user char
;Here upon end of message.
MAIOU3: AOS (P) ;take success return now
MOVEI C,14 ;Command on first page, message on 2nd
SKIPLE SPLNBR ;Zero arg means no text from page/buffer
IDPB C,OPNT
PUSHJ P,XWRBUF ;Write out command in first record
MOVE G,OPNT
PUSHJ P,MAISPL ;Now output text
XWRDON: MOVEM G,OPNT
PUSHJ P,XCLOSO
RELEAS DSKSP,
SETZM JOBJDA+DSKSP
POPJ P,
SPOOLW: ENTER DSKSP,SPOOLD+7
JRST SPOOLE
PUSHJ P,SPLINI
PUSHJ P,MAISPL ;Put out page's text
PUSHJ P,XWRDON ;Close output file
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file being spooled
JRST SPALL ;CALL GORIN - ARGUMENTS IN SPOOLD BLOCK
IFN FTGSPL,<
;Check extended command name in EXTBUF again printer names in system.
;Skip if matches, with SPLJOB/SPLEXT set up as returned by system.
SPLCHK: PUSHJ P,ENDEXT ;terminate command with null, for lookup as printer name
MOVEI T,SPLJOB ;block for following UUO
SPOOLR T, ;see if this name matches a printer name
CAIA ;no such spooler
AOS (P) ;take skip return for success
MOVSI T,70000 ;undo IBP done in ENDEXT
ADDM T,EXTPNT ;back up to before the null that was inserted
JRST FIXEXT ;restore command buffer text on way back
>;IFN FTGSPL
;⊗ MAISPL MAISP3 MAISP5 MAISP4 MAISP6 AFOO MAISP8 MAISP2 MAIS9A XWRNXT MAISP9 XWRLIN XWRLUP XWRLP2 XWRDSP XWRTAB
;Common line setup and output routine for MAIL and SPOOL.
MAISPL: TRNE F,ATTMOD
JRST MAISP3
MOVE T,LINES
MOVEI A,PAGE
TRNN F,ARG
JRST MAISP4
MOVEI A,ARRLIN ;Spool number of lines from arrow onward
SUB T,ARRL
AOJA T,MAISP5
MAISP3: MOVE T,ATTNUM ;Max number of lines we can spool
MOVEI A,ATTBUF ;Spooling from attach buffer
TRNE F,ARG
MAISP5: CAMGE T,SPLNBR ;Arg given--are there that many lines available?
MAISP4: MOVEM T,SPLNBR# ;Spool max number of lines
SKIPL MAIFLG ;Skip if doing mail
JRST MAISP9
TRNN F,ARG
JRST MAISP8
SKIPLE SPLNBR
JRST MAISP6
OUTSTR [ASCIZ/Command line message/]
JRST MAISP2
MAISP6: SETZM TYOPNT
TYPDEC SPLNBR
OUTSTR [ASCIZ/ lines/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/ of attach buffer/]
JRST MAISP2
AFOO: [ASCIZ/WHOLE CRAZY IDEA tossed into the Bay./]
[ASCIZ/WHOLE SILLY SUGGESTION given to MAIL./]
[ASCIZ/WHOLE EARTH CATALOG given to MAIL./]
[ASCIZ/HOLY SMOKE, BATMAN, I gave it to MAIL./]
[ASCIZ/Attach buffer given to BAIL./]
[ASCIZ/Attach buffer given to SNAIL./]
[ASCIZ/Attach buffer given to FAIL./]
[ASCIZ/Uncensored buffer given to MAIL./]
MAISP8: DATE T,
PUSH P,TT
IDIVI T,=31*=12
MOVEI T,(TT)
POP P,TT
CAIN T,3*=31
JRST [ MSTIME T,
TRNE T,1400
JRST .+1
LSH T,-=10 ;use next few bits
ANDI T,3 ;limit to size of half the table
TRNE F,ATTMOD
TRO T,4 ;last half are for attach mode
OUTSTR @AFOO(T)
OUTSTR [ASCIZ/
/]
JRST MAIS9A]
TRNN F,ATTMOD
OUTSTR [ASCIZ/ALL INCORE TEXT/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/Attach buffer/]
MAISP2: OUTSTR [ASCIZ/ given to MAIL.
/]
MAIS9A: HRRZ B,(A) ;Point to first line of text being output
HRRZ T,TXTCNT(B) ;Char count to check for empty line (or pagemark)
JUMPN T,MAISP9 ;Not empty -- output this leading non-blank line
PUSHJ P,XWRNXT ;See if there is another line to do
POPJ P, ;Nope, no non-empty lines seen!
JRST MAIS9A ;Skip a leading empty line (or pagemark)
XWRNXT: SOSGE SPLNBR ;Output enough lines yet?
POPJ P, ;Yes
HRRZ A,(A)
CAIE A,ATTBUF ;Double check to avoid going past end of buffer
CAIN A,BOTSTR ; or end of page
POPJ P,
JRST POPJ1
MAISP9: MOVN B,OCNT
MOVSI B,(B)
SETOM EXAFLG ;Assume spool -- output pagemarks as FFs
SKIPE MAIFLG ;Skip if spool command
SETZM EXAFLG# ;Flag not to put pagemarks out as FF on rec boundary
;Fall into XWRLIN to output text
;Subroutine to put out SPLNBR lines whose header is pointed to by A
;EXAFLG, if sets, causes pagemarks to go out as FF's on record boundaries.
XWRLIN: PUSHJ P,XWRNXT ;See if there is another line to do
POPJ P, ;Nope, all done
SKIPGE T,TXTFLG(A) ;Is this a page mark?
JRST XWRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
SKIPN T
TLOA D,350700 ;Empty line--don't put out the empty line's space
HRLI D,440700
HRRI B,0 ;RH of B counts display position for skipping tabs
XWRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
XWRLP2: AOBJN B,XWRLUP
PUSHJ P,XWRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST XWRLUP
JRST XWRLIN ;200--previous char was a lf
XWRDSP: JRST XWRLUP ;null, should only occur in middle of pagemark text
PUSHJ P,TELL1 ;rubout
JFCL ;cr
MOVE D,[POINT 8,[BYTE (8)200]] ;lf--make next char get new line
JRST XWRTAB ;tab
PUSHJ P,TELL5 ;ff
JFCL ;alt, now we allow altmode in file (formerly TELL6)
XWRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,XWRLP2
;XCLOSO XWRBUF XWRBF3 XWRPM XWRPM2
XCLOSO: PUSHJ P,CLOSO2 ;See if there is partial buffer left to output
XWRBUF: OUT DSKSP,[-200,,OBUF-1↔0]
AOSA OBLK
PUSHJ P,TELLZ
XWRBF3: PUSH P,T
JRST WRBF3
XWRPM: SKIPN EXAFLG
JRST XWRPM2
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Force out partial buffer
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC!NSPEC
MOVEI C,14 ;Put out FF at beginning of new record
IDPB C,G
AOBJN B,XWRLIN
PUSHJ P,TELLZ ;One char can't fill up buffer!
XWRPM2: MOVE D,[440700,,LLDESC]
SKIPE MAIFLG ;(DFIND shouldn't get here)
TRCA D,LLDESC≥PMTXT ;MAIL--output the model pagemark w/o page number
ADDI D,(A) ;SPOOL--output the pagemark as displayed
JRST XWRLUP ;No need to set up RH of B--no tabs in pagemark text
;⊗ SPLWAK SPLPPN SPLJBN RETADD XGPFLG RQIOWD XFNTCM SPLEXT SPLCM2 SPLJOB CFORM RQNAM RQJOB FDEV DEVMOD FSIZE RQTIME FNAME FPPN CBITS PSPEC SPALL RETURN
BEGIN SPSUB
GLOBAL DSKSP,P,F,A,B,C,D,%SEG
;PDLEN←←20
IMPURE
;WAKEME block for spooler
SPLWAK: 0 ;spooler's jobname goes here
SPLPPN: 'SPLSYS' ;spooler's PPN
0 ;zero to wake up spooler now if necessary
SPLJBN: BLOCK 1
RETADD: BLOCK 1 ;SAVE HIS RETURN ADDRESS
IFE FTGSPL,<
↑XGPFLG:0 ;-1 for XGP, 0 LPT, 1 Dover, 2 Boise, 3 IMPRINT, 4 ESP
>;IFE FTGSPL
RQIOWD: IOWD 200,CMDBUF
IOWD 16,XFNTCM
0
XFNTCM: REPEAT 10,<-1>
0 ;Default font file name
0 ; and extension
0
0 ; and PPN
0
0
PURE
IFE FTGSPL,<
;spooler cmd file extension
'XSP ' ;XGP
SPLEXT: 'SPX ' ;LPT
'DSP ' ;Dover
'BSP ' ;Boise
'ISP ' ;IMPRINT
'ESP ' ;ESP
'RSP ' ;Rover
'PSP ' ;Plover
'SSP ' ;Strudel
'QSP ' ;Pancake
'LSP ' ;Lathrop
;second word of dump mode cmd list, maybe output second record or end list
IOWD 16,XFNTCM ;XGP
SPLCM2: 0 ;LPT
IOWD 16,XFNTCM ;Dover
IOWD 16,XFNTCM ;Boise
IOWD 16,XFNTCM ;IMPRINT
IOWD 16,XFNTCM ;ESP
IOWD 16,XFNTCM ;Rover
IOWD 16,XFNTCM ;Plover
IOWD 16,XFNTCM ;Strudel
IOWD 16,XFNTCM ;Pancake
IOWD 16,XFNTCM ;Lathrop
;jobname for each spooler
'[XSPL]' ;XGP
SPLJOB: '[LIST]' ;LPT
'DOVER!' ;Dover
'BOISE!' ;Boise
'[ISPL]' ;IMPRINT
'[ESP!]' ;ESP
'ROVER!' ;Rover
'PLOVE!' ;Plover
'STRUD!' ;Strudel
'PNCAK!' ;Pancake
'LATHR!' ;Lathrop
>;IFN FTGSPL
CFORM←←0
RQNAM←←1
RQJOB←←2
FDEV←←3
DEVMOD←←4
FSIZE←←5
RQTIME←←6
FNAME←←7
FPPN←←12
CBITS←←16
PSPEC←←20
↑SPALL: MOVEM 17,SAVEAC+17 ;SAVE AC 17
MOVEI 17,SAVEAC ;LOAD BLT pointer
BLT 17,SAVEAC+16 ;SAVE THE AC'S
MOVE P,SAVEAC+17 ;Restore pdl pointer
; MOVE P,[IOWD PDLEN,PDLIST] ;MAKE A PDL
PUSH P,[CAM MRET] ;SAVE RETURN ADDRESS
MOVEM P,RETADD ;SAVE PRESENT PDP.
SETZM CMDBUF
MOVE C,[CMDBUF,,CMDBUF+1]
BLT C,CMDBUF+177
MOVE D,[SPOOLD,,CMDBUF] ;BLT AC
BLT D,CMDBUF+PSPEC-1 ;LAST WORD OF DESTINATION
IFE DECSW,<
MOVEI D,0
DSKPPN D,
>
IFN DECSW,<
GETPPN D,
JFCL
>
SKIPN CMDBUF+FPPN ;IS THERE AN EXPLICIT FILE PPN?
MOVEM D,CMDBUF+FPPN ;NO. SET ONE.
PUSHJ P,SPOOLZ ;CALL COMMON PORTION
RETURN: MOVE P,RETADD
POPJ P,
;SPOOLZ NOLOOK STASH SAGAIN DWNCHK
SPOOLZ:
IFE FTGSPL,<
;Check bits for system's existing spoolers:
; 1(xgp),2(lpt),4(dover),10(boise),20(imprint),40(esp),100(rover)
MOVEI A,357 ;get system bits indicating
PEEK A, ; which spoolers exist
MOVN B,XGPFLG ;get code indicating requested spooler
ROT A,-2(B) ;shift appropriate bit into sign bit
JUMPGE A,NOPRNT ;jump if no such spooler on this system
;; PUSHJ P,SPLSTS ;MAKE SURE THE SPOOLER'S ALIVE.
>;IFE FTGSPL
SKIPN B,CMDBUF+FDEV ;ANY DEVICE THERE?
MOVSI B,'DSK' ;NO USE DISK
CAME B,['DSK ']
JRST NOLOOK ;DON'T DO LOOKUP IF NOT DISK.
MOVEI A,DMPMOD
SETZ C,
OPEN DSKSP,A
JRST NODISK
;LOOKUP THE FILE THAT HE GAVE ME.
MOVE D,[CMDBUF+FNAME,,A]
BLT D,D
HLLZ B,B
LKPMAC <LOOKUP DSKSP,A>
JRST [ OUTSTR [ASCIZ/Spool: lookup fails
/]
JRST RETURN]
MOVS D,D ;SIZE OF FILE
MOVM D,D ;GET MAGNITUDE
LSH D,-7 ;CONVERT TO BLOCKS
CLOSE DSKSP,
JRST STASH
NOLOOK: MOVEI D,100 ;HERE IF NOT DISK, ASSUME SIZE.
MOVEI A,DMPMOD
MOVSI B,'DSK' ;OPEN A DISK CHANNEL
SETZ C,
OPEN DSKSP,A
JRST NODISK
STASH: ;SETUP CMDBUF AND WRITE THE FILE
MOVEM D,CMDBUF+FSIZE ;STASH FILE SIZE
IFE DECSW,<
TIMER A, ;GET TIME
IDIVI A,74*74 ;MAKE MINUTES
>
IFN DECSW,< ;NOT IN FRANCE YOU DON'T
MSTIME A,
IDIVI A,=60000
>
DATE B, ;GET DATE
HRL A,B ;COMPUTE "NOW"
IFE DECSW,<
PUSHJ P,DWNCHK ;IS THE SYSTEM DOWN?
MOVE A,[1,,1] ;YES, GIVE HIGH PRIORITY
>
MOVEM A,CMDBUF+RQTIME ;SET TIME TO NOW.
IFE DECSW,<
GETPPN A, ;GET USER NAME
>
IFN DECSW,<
HRROI A,2
GETTAB A,
GETPPN A,
JFCL
>
MOVEM A,CMDBUF+RQNAM
MOVE A,['NP ',,1]
MOVEM A,CMDBUF+CFORM
SETO B,
GETLIN B
PJOB A,
HRL B,A
MOVEM B,CMDBUF+RQJOB ;SAVE JOB#,,LINE NUMBER OF REQUESTOR
DATE A,
TIMER B,
LSH A,30
OR A,B
SAGAIN:
IFE FTGSPL,<
MOVE B,XGPFLG ;get device code indicating which spooler
MOVE B,SPLEXT(B) ;get proper extension for spooler cmd file
>;IFE FTGSPL
IFN FTGSPL,<
MOVE B,SPLEXT ;get proper extension for spooler cmd file
>;IFN FTGSPL
SETZ C,
MOVE D,SPLPPN
LKPMAC <LOOKUP DSKSP,A>
JRST .+2
AOJA A,SAGAIN
IFE FTGSPL,<
MOVE B,XGPFLG ;get device code indicating which spooler
MOVE B,SPLEXT(B) ;get proper extension for spooler cmd file
>;IFE FTGSPL
IFN FTGSPL,<
MOVE B,SPLEXT ;get proper extension for spooler cmd file
>;IFN FTGSPL
MOVSI C,400000 ;Dump-never protection
MOVE D,SPLPPN
ENTER DSKSP,A
AOJA A,SAGAIN
IFE FTGSPL,<
MOVE A,XGPFLG ;get device code indicating which spooler
MOVE F,SPLCM2(A) ;get possible second disk iowd for cmd file
>;IFE FTGSPL
IFN FTGSPL,<
MOVE F,[IOWD 16,XFNTCM] ;cmd to write font info
>;IFN FTGSPL
MOVEM F,RQIOWD+1 ;store second iowd or zero (third word always zero)
OUTPUT DSKSP,RQIOWD ;write one or two records
STATZ DSKSP,740000
JRST OUTERR
CLOSE DSKSP,
RELEAS DSKSP,
SETZM JOBJDA+DSKSP
PUSHJ P,SPLSTS ;MAKE SURE THE SPOOLER'S ALIVE.
SETZM MAILBK
MOVE A,[XWD MAILBK,MAILBK+1]
BLT A,MAILBK+37
SKIPN A,SPLJBN
POPJ P, ;NO JOB NUMBER, NO MAIL
MOVEI B,MAILBK
IFE DECSW,< ;THE CRUX OF THE MATTER
SKPSEN A ;Don't ever let system stop job w/ err msg!
JFCL ;Ignore all 3 possible returns
JFCL
>
POPJ P,
IFE DECSW,<
DWNCHK: MOVEI B,MAINTMODE
PEEK B,
PEEK B, ;GET MAINTENANCE FLAG
JUMPN B,CPOPJ ;JUMP IF DOWN
MOVEI B,TTYLOK
PEEK B,
PEEK B, ;GET TTY LOCK FLAG
JUMPN B,CPOPJ ;JUMP IF DOWN
JRST POPJ1 ;SYSTEM IS UP -- SKIP RETURN
>;IFE DECSW
;⊗ SPLSTS INTSPL INTSPS NOPRNT NODISK OUTERR INTCFN MULSPL NOWAKE NOSPLR
SPLSTS:
IFE DECSW,< ;DO SOMETHING ABOUT THIS SOMEDAY
IFE FTGSPL,<
MOVE A,XGPFLG ;get device code indicating which spooler
MOVE A,SPLJOB(A) ;get spooler's name
>;IFE FTGSPL
IFN FTGSPL,<
MOVE A,SPLJOB ;get spooler's name
>;IFN FTGSPL
NAMEIN A,
PUSHJ P,INTSPL ;OUGHT TO INIT SPOOLER
MOVEM A,SPLJBN ;INTSPL ALSO RETURNS A.
JUMPE A,CPOPJ ;RETURN IF NO JOB FOUND
JBTSTS A,
TLNN A,20000
POPJ P, ;QUICK RETURN
OUTSTR [ASCIZ/
Spooler has crashed. Your output will be printed after it is restarted.
/]
>;NOT DECSW
POPJ P,
;SEE ABOUT STARTING A SPOOLER
IFE DECSW,<
INTSPL: TRNE A,2 ;SKIP IF NO JOBS LOGGED IN.
JRST MULSPL ;OOPS MORE THAN 1 SPOOLER ALREADY
IFE FTGSPL,<
MOVE A,XGPFLG ;get device code indicating which spooler
MOVE A,SPLJOB(A) ;get spooler's name
>;IFE FTGSPL
IFN FTGSPL,<
MOVE A,SPLJOB ;get spooler's name
>;IFN FTGSPL
MOVEM A,SPLWAK ;store jobname in WAKEME block
SETZM SPLWAK+2 ;set data to zero to force immediate wakeup
MOVEI A,SPLWAK ;ptr to block
WAKEME A,
JRST NOWAKE ;FAILURE
MOVEI B,5 ;WAIT FOR SPOOLER TO HAPPEN
INTSPS: MOVEI A,1
SLEEP A, ;SLEEP AND WAIT FOR SPOOLER TO BE ALIVE.
IFE FTGSPL,<
MOVE A,XGPFLG ;get device code indicating which spooler
MOVE A,SPLJOB(A) ;get spooler's name
>;IFE FTGSPL
IFN FTGSPL,<
MOVE A,SPLJOB ;get spooler's name
>;IFN FTGSPL
NAMEIN A,
SOJGE B,INTSPS
JUMPGE B,CPOPJ
JRST INTCFN ;CONFUSION. I JUST MADE A SPOOLER
>;NOT DECSW
;Fatal spooling errors.
NOPRNT: OUTSTR [ASCIZ/Spool: The requested printer is not available on this system!
/]
JRST RETURN ;Abort the spooling attempt
NODISK: OUTSTR [ASCIZ/Spool: Init failed on DSK
/]
JRST RETURN ;Abort the spooling attempt
OUTERR: OUTSTR [ASCIZ/Spool: Output error on DSK
/]
JRST RETURN ;Abort spooling attempt
;Three non-fatal errors.
INTCFN: OUTSTR [ASCIZ/Spool: I just made a spooler, but now I can't find it.
/]
JRST NOSPLR
MULSPL: OUTSTR [ASCIZ/Spool: There are multiple spoolers.
/]
JRST NOSPLR
NOWAKE: OUTSTR [ASCIZ/Spool: The WAKEME uuo to start the spooler failed.
/]
NOSPLR: OUTSTR [ASCIZ/File spooled anyway. /]
MOVEI A,0 ;No spooler job number
POPJ P,
BEND
;FBISPC FBICMD FBIFRM ADRS FBINAM SAVCHR SAVCH3
;EXTERNAL $ADTYP,$OPLOO
FBISIZ←←60 ;Number of words in FBIBUF block
FBISPC: ASCIZ /<SP>/
ASCIZ /<TB>/
ASCIZ /<LF>/
ASCIZ /<VT>/
ASCIZ /<FF>/
ASCIZ /<CR>/
ASCIZ /<BS>/
ASCIZ /<AL>/
ASCIZ /<β>/
ASCIZ /<α>/
FBICMD: ASCIZ /
Last 64 command chars as typed
/
FBIFRM: ASCIZ /Data as defined at FBINAM
/
;Format code for use in FBITAB below
NOZ←←1000 ;Signed octal with leading zeros suppressed
OCT←←2000 ;Full word octal (L,,R)
ADF←←3000 ;Address field only, in octal
DEC←←4000 ;Signed decimal
ASC←←5000 ;ASCIZ with nulls suppressed
SIX←←6000 ;SIXBIT
;NOTE: This still is not fixed as desired. Symbolic codes cannot be used.
;To cause any desired datum to be printed, add its name to the following list
;followed by a comma and the (octal) number of cells to be listed if more than 1,
;ored with the desired (numerical) format code as listed above. If no format is
;specified then output will be in octal, full word if |N|≥2**18 else signed octal.
;Note that if numbers 1 to 6 appear shifted 3 to left from positions noted
;above then an indirct reference is implied and the originally specified
;location is to be in the format specified by these numbers. Numbers in the
;locations shown above and the count then apply to the indirect data.
;Example ARRLIN,32004 means show the value in ARRLIN as an address only, then
;go to the address as so specified and display 4 locations in full word octal.
DEFINE FBITAB <
XX ZINDEX
XX HOMMAX,4000
XX NWINS
XX NDEADW
XX FDEADW
XX SCRBOT,4000
IFE DECSW,<
XX JOBDDT,3000
XX WRTJOB,6000
>;NOT DECSW
XX WRTPPN,6000
XX FIRPAG,4000
XX CURPAG,4000
XX IBLK
XX OBLK
XX CHARS
XX ARRLIN,12002
XX FSMIN
XX FSEND
XX FSBEG
XX FSMAX
XX JOBREL
XX SAVEAC,20
>
DEFINE XX(Y,Z),<
Z,,Y
>
ADRS: FBITAB
LADRS←←.-ADRS
DEFINE XX(Y,Z,W),<
SIXBIT /Y/
>
FBINAM: FBITAB
SAVCHR: CAIN C,400
POPJ P,
SOSG FBICNT
JRST [ MOVEM C,FBICNT
MOVE C,[POINT 9,FBIBUF]
MOVEM C,FBIPNT
MOVEI C,FBISIZ*4
EXCH C,FBICNT
JRST SAVCH3 ]
SAVCH3: IDPB C,FBIPNT
POPJ P,
;⊗ MAPILE CHFILE CHUSET TELFL3 TELSIZ FBICNT FBIBUF FBIPNT LTELBF TMPMAX SAVEAC LEDGBF FFBUF QLPDL QLEPDL TCBUF EDGBF ZTMPBF OLDBUF MAILBK CMDBUF LMACBF MACBUF TELBUF TMPBUF TM2BUF
IMPURE
MAPILE: SIXBIT /ETVMAP/
SIXBIT /001 /
0
SIXBIT / EALS/
SIXBIT /DSK/
CHFILE: SIXBIT /ERR/
SIXBIT /001 /
0
SIXBIT / EALS/
CHUSET: USETO DSKCH,1 ;Address field set by a UGETF
TELFL3: -1 ;Counter to cause checksum every N times
TELSIZ: TELBUF+LTELBF-7 ;To warn of approaching end of TELBUF
FBICNT: 0 ;Byte position in FBIBUF (counting down)
FBIBUF: BLOCK FBISIZ ;To hold 9-bit commands as issued (stored cyclicly)
FBIPNT: 0 ;Pointer to last byte stored
LTELBF←←400 ;Length of buffer for report trouble in FBI
TMPMAX←←LTELBF-1 ;Maximum size of tmpcor file
SAVEAC: BLOCK 20
;The following buffer at TELBUF is used by several different special routines,
;with the various symbols defined below being synonomous with TELBUF. Because
;of this, all of these routines must be mutually independent of each other and
;of the error reporting routines (FBI, TELLME, etc), except perhaps that an
;irrecoverable error (TELLZ, etc.) can probably afford to clobber data for one
;of the other routines using this buffer as that other routine won't run again.
IFN FTRDLINE,< EDGLBP: 0 > ;Byte pointer into EDGBF input buffer
LEDGBF←←100 ;Length of EDGBF buffer--arbitrary but less than or equal to LTELBF
FFBUF: ;buffer for exchanging search strings
QLPDL: ;PDL for lisp S-expr parsing
QLEPDL←←QLPDL+<LTELBF/2>*2 ;End of lisp pdl, which must be even number of wds
TCBUF: ;Buffer for holding tmpcor file
EDGBF: ;Buffer used by RDLINE UUO for EDGL input
ZTMPBF: ;Place to save line marks/page stack while in FRDMOR
OLDBUF: ;Working space for adjusting stacks for N,O,H cmds
MAILBK: ;block for mailer disk output
CMDBUF: ;Block for spooler disk output
LMACBF←←200
MACBUF: ;200-wd input buffer for getting macro def from file
SPLBUF: ;block for SPOOLR UUO getting names from system
TELBUF: BLOCK LTELBF ;Disk buffer for error reporting routine FBI
TMPBUF←←TELBUF ;Temporary buffer needed in addition to DPYLOC buffer for SHIFT.
TM2BUF←←TELBUF+100 ;2nd temporary buffer for SHIFT routine (called from DISP).
PURE
;⊗ CHEXT CHEXTA CHEXTM CHPPN CHKUP MONTH WKDAY SUMERR CHREGE CHINDE CHADDR CHADDC CHOUTB CHPDLM CHREG2 CHRETU CHALIA
CHEXT: SIXBIT /001 /
CHEXTA: SIXBIT /ALS /
CHEXTM: SIXBIT /ME1 /
CHPPN: ERRPPN
CHKUP: MOVEI T,0
MOVE TT,[400000-ENDPUR,,0]
ADD T,400000(TT)
AOBJN TT,.-1
JFCL
POPJ P,
MONTH: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
WKDAY: [ASCIZ/Wednesday/]
[ASCIZ/Thursday/]
[ASCIZ/Friday/]
[ASCIZ/Saturday/]
[ASCIZ/Sunday/]
[ASCIZ/Monday/]
[ASCIZ/Tuesday/]
SUMERR: ASCIZ /Checksum error /
CHREGE: ASCIZ / Accum. /
CHINDE: ASCIZ / Index /
CHADDR: ASCIZ / Eff.Address /
CHADDC: ASCIZ / held /
CHOUTB: ASCIZ / Out of bounds/
CHPDLM: ASCIZ /PDL addresses /
CHREG2: ASCIZ /
Flags /
CHRETU: ASCIZ /Return-2 /
CHALIA: ASCIZ / Alias /
;CHTEXT CHCRLF CHOUT3 CHOUT6 LHOCTS
;Copies text from location pointed to by B to location pointer to by A (80 chars.)
CHTEXT: MOVEI TT,120
ILDB C,B
JUMPE C,.+3
IDPB C,A
SOJG TT,.-3
POPJ P,
CHCRLF: MOVEI C,15
IDPB C,A
MOVEI C,12
IDPB C,A
POPJ P,
;Changes six-bit in D into ascii omitting blanks and stores at pointer A
CHOUT3: MOVEI T,3
SKIPA
CHOUT6: MOVEI T,6
MOVE B,[POINT 6,D]
ILDB C,B
JUMPE C,.+3
ADDI C,40 ;Convert to ASCII
IDPB C,A
SOJG T,.-4
POPJ P,
;Converts # in left half of TT into ascii and stores at pointer A
LHOCTS: MOVEI C,6
MOVEI T,0
LSHC T,3
ADDI T,60
IDPB T,A
SOJG C,.-4
POPJ P,
;CHECKU STOPJC
;This warns of trouble once and inhibits WRPAGE. If user persists,
;no further warning will be given but E may blow in other ways.
CHECKU: SKIPL 115 ;Check protection status of upper
POPJ P, ;Don't bother if upper is not write protected
AOS C,TELFL3 ;Add to WRPAGE count
TRNE C,7 ;Do a check sum only every 8 times
POPJ P, ;Not this time
SKIPE TELLFL#
POPJ P, ;One warning should be enough
SETOM TELLFL
PUSH P,T
PUSH P,TT
PUSHJ P,CHKUP
CAME T,CHKSUM
JRST .+4
POP P,TT
POP P,T
POPJ P,
POP P,TT
POP P,T
PUSHJ P,FBI
PUSHJ P,MACSTP
OUTSTR [ASCIZ /
***** UPPER SEGMENT CHECKSUM ERROR!!!! ***** TELL EVERYONE! KILL SEGMENT!! *****
Command aborted; next attempt to write out page will work but may garbage page./]
SETO A,
BEEP A, ;Beep poor guy to wake him up
CLRBFI ;Save him from himself
MOVE P,[-LPDL+1,,PDL]
JRST POPJ1
STOPJC: OUTSTR [ASCIZ/
One moment please--free storage error detected./]
PUSHJ P,MAP ;Make a free storage map
PUSHJ P,TELLX
ASCIZ/Free storage error/
;TELLME FILEID
TELLME: OUTSTR [ASCIZ / Error report being made... /]
PUSHJ P,FBI ;don't optimize! FBI looks up the stack!
POPJ P,
;Put date and time, programmer, file name, page and line numbers on first line
FILEID: DATE C, ;GET DATE
MOVEI D,0
IDIVI C,=31
MOVE T,D
ADDI T,1 ;This is the day
PUSHJ P,NUMSTR ;Get it in 7-bit
MOVEI E,40
MOVEI D,0
IDIVI C,=12
PUSH P,C ;Save year
MOVE C,MONTH(D) ;This is the month in 7-bit
MOVEM C,1(A)
ADDI A,2
HRLI A,440700
POP P,T
ADDI T,=64
PUSHJ P,NUMSTR ;Year
IDPB E,A ;A space
IFE DECSW,<
TIMER B, ;GET TIME
IDIVI B,74*74 ;MAKE MINUTES
>
IFN DECSW,<
MSTIME B,
IDIVI B,=60000
>
MOVEI C,0
IDIVI B,=60 ;Hour is in B and minutes in C
MOVE T,B
PUSHJ P,NUMSTR
MOVEI B,":"
IDPB B,A
MOVE T,C
PUSHJ P,NUMSTR
IDPB E,A
IDPB E,A
MOVE D,RPPN ;Get users name
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,PPN ;Get users alias
CAMN D,RPPN
JRST .+11
MOVE B,[POINT 7,CHALIA]
PUSHJ P,CHTEXT
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,EDFIL-1
CAMN D,['DSK ']
JRST .+5
PUSHJ P,CHOUT3
MOVEI C,":"
IDPB C,A
IDPB E,A
MOVE D,EDFIL ;Get file name
PUSHJ P,CHOUT6
HLLZ D,EDFIL+1 ;Get extension
JUMPE D,.+4 ;May be missing
MOVEI C,"."
IDPB C,A
PUSHJ P,CHOUT3
MOVE D,EDFIL+PPN3 ;Get file PPN
JUMPE D,.+12
MOVEI C,"["
IDPB C,A
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
MOVEI C,"]"
IDPB C,A
HRRZ C,EDFIL+4
CAIE C,777777
JRST .+5
MOVEI C,"/"
IDPB C,A
MOVEI C,"N"
IDPB C,A
IDPB E,A
IDPB E,A
MOVEI C,"P"
IDPB C,A
IDPB E,A
MOVE T,CURPAG ;Get page number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
IDPB E,A
MOVE T,PAGES
PUSHJ P,NUMSTR
IDPB E,A
IDPB E,A
MOVEI C,"L"
IDPB C,A
IDPB E,A
MOVE T,ARRL ;Get line number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
IDPB E,A
MOVE T,LINES
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
POPJ P,
;⊗ FBI MAINTMODE FBI1 FBI1A CHSUME CHSUM2 FBI2 FBI2A FBI3 FBI3A FBI3B
FBI: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+P ;No reason to make another push-down list
MAINTMODE←←254 ;lowcore pointer in monitor
MOVEI T,MAINTMODE ;see if we're in maintenance mode
PEEK T, ;get addr of cell
PEEK T, ;get value of flag
JUMPN T,[OUTSTR [ASCIZ/ (No error report made: system in maintenance mode.)
/]
JRST MRET]
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+LTELBF-1 ;Clear the buffer
MOVE A,[POINT 7,TELBUF]
MOVEI C,14 ;Put each entry on separate page
IDPB C,A
MOVEI C,"∂"
IDPB C,A
PUSHJ P,FILEID
MOVEI E,11
;Put fatal error message next if there is one
SKIPN TELFL2
JRST CHSUME
SETZM TELFL2
MOVE B,[POINT 7,0]
HRR B,40 ;Get starting address from JOBUUO
FBI1: ILDB C,B
JUMPE C,FBI1A
IDPB C,A
JRST FBI1
FBI1A: PUSHJ P,CHCRLF
;Put CHECKSUM error on the second line if one exists
CHSUME: PUSHJ P,CHKUP
SUB T,CHKSUM
JUMPE T,CHSUM2
MOVE B,[POINT 7,SUMERR]
PUSHJ P,CHTEXT
MOVE TT,T
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI E,40
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
MOVEI C,15 ;End CHKSUM line
IDPB C,A
MOVEI C,12
IDPB C,A
CHSUM2: PUSHJ P,CHCRLF
;Put blow-up location and instruction for reference on third line
MOVEI E,40
MOVE B,[POINT 7,CHRETU]
PUSHJ P,CHTEXT
IDPB E,A
MOVE T,SAVEAC+17 ;Get P value at entry time
HRRZ TT,-1(T) ;Get POPJ address
SUBI TT,2 ;We want location before PUSHJ
HRLZ TT,TT
SKIPE T,ILMADR# ;Was this an ill mem ref?
HRLZ TT,T ;Yes get address
HLRZ D,TT
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
IDPB E,A
MOVE TT,(D) ;Get the instruction itself
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right helf into OCT string
PUSHJ P,CHCRLF
;Report contents of specified register and effective address
MOVE B,[POINT 7,CHREGE]
PUSHJ P,CHTEXT
MOVE D,(D) ;Get instruction into D
MOVE B,[POINT 4,D,12]
LDB T,B ;Get register address
MOVEM T,TSAVE#
PUSHJ P,OCTSTR ;Report the register
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
MOVE T,SAVEAC(T) ;Get contents
PUSHJ P,OCTSTR ;Want it in OCTAL
MOVE B,[POINT 4,D,17] ;Pointer to index position
LDB T,B ;Get its number
MOVEM T,TSAVE# ;We will need this again
SETZM TTSAVE# ;Ready for no index case
JUMPE T,.+13
MOVE B,[POINT 7,CHINDE]
PUSHJ P,CHTEXT ;Write text
MOVE T,TSAVE ;Get index address back
PUSHJ P,OCTSTR ;The index
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE ;And again
HRRZ T,SAVEAC(T) ;Get contents of index
MOVEM T,TTSAVE ;Save to add to address
PUSHJ P,OCTSTR ;Report contents in OCT of index register
MOVE B,[POINT 18,D,35]
LDB TT,B
ADDB TT,TTSAVE
MOVE B,[POINT 7,CHADDR] ;Some text
PUSHJ P,CHTEXT
HRLZ TT,TTSAVE
PUSHJ P,LHOCTS ;Report effective address itself
MOVE TT,TTSAVE
CAIG TT,@JOBREL ;Is address above job's lower segment?
JRST .+4 ;No
CAIG TT,ENDPUR ;Is it beyond limit of upper segment?
CAIGE TT,400000 ;or maybe in between lower and upper?
JRST FBI2 ;It IS out of bounds
CAILE TT,17
MOVE T,(TT)
CAIG TT,17
MOVE T,SAVEAC(TT)
MOVEM T,TSAVE
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
PUSHJ P,OCTSTR ;Report OCT contents of effective address
JRST FBI2A
FBI2: MOVE B,[POINT 7,CHOUTB]
PUSHJ P,CHTEXT ;Report address out of bounds
FBI2A: PUSHJ P,CHCRLF
;To report the last n command characters (stored cyclicly)
MOVE B,[POINT 7,FBICMD]
PUSHJ P,CHTEXT
MOVEI E,2 ;α
MOVEI D,3 ;β
MOVE B,FBIPNT ;Pointer to FBIBUF
MOVEI Q,FBISIZ*4 ;Count of number reported (1 buffer-full)
MOVE T,FBICNT ;Current count position in FBIBUF
FBI3: MOVEI G,=74 ;Characters per line (may be exceeded by 6)
FBI3A: SOJL Q,FBI5
SOJG T,FBI3B
MOVE B,[POINT 9,FBIBUF]
MOVEI T,FBISIZ*4
FBI3B: ILDB C,B
JUMPE C,FBI3A ;Do not report nul's
CAIN C,400
JRST FBI3A ;or 400's only
PUSHJ P,FBNINE
SOJG G,FBI3A
PUSHJ P,CHCRLF
JRST FBI3
;FBNINE FBI3C FBI3D FBI3E FBI4 FBI4Z
FBNINE: TRZN C,200 ;Test for CONTROL bit
JRST FBI3C
IDPB E,A ;Put out an alpha
SOS G
FBI3C: TRZN C,400 ;Test for META bit
JRST FBI3D
IDPB D,A ;Put out a beta
SOS G
FBI3D: CAIN C,40 ;<CR>
JRST [SETZ C,↔JRST FBI3E]
CAIN C,177 ;<BS>
JRST [MOVEI C,6↔JRST FBI3E]
CAIN C,ALTMOD ;<ALT>
JRST [MOVEI C,7↔JRST FBI3E]
CAIN C,"α"
JRST [MOVEI C,10↔JRST FBI3E] ;<alpha>
CAIN C,"β"
JRST [MOVEI C,11↔JRST FBI3E] ;<beta>
CAIL C,11
CAILE C,15
JRST [IDPB C,A↔JRST FBI4Z]
SUBI C,10
FBI3E: MOVEM B,FBITMP#
MOVE B,[POINT 7,FBISPC]
ADD B,C
MOVEI TT,4
FBI4: ILDB C,B
IDPB C,A
SOJG TT,FBI4
MOVE B,FBITMP
SUBI G,3
FBI4Z: POPJ P,
;CHMACR CHMAC2 CHMAC3 CHMAC4 CHMAC5 FBI5 FBI5B FBI5E FBI5C
CHMACR: ASCIZ /Macro /
CHMAC2: ASCIZ / did /
CHMAC3: ASCIZ / of /
CHMAC4: ASCIZ /<****>/
CHMAC5: ASCIZ /: /
FBI5: PUSHJ P,CHCRLF
;Report macro if evoked
SKIPG D,CURMAC ;Any macro in progress?
JRST FBI5D ;No
PUSH P,MREPT(D) ;Save repeat count of macro call
PUSH P,MBYTE(D) ;Save current byte pointer into macro def
PUSHJ P,CHCRLF
MOVE B,[POINT 7,CHMACR]
PUSHJ P,CHTEXT
HRRZ E,MPOINT(D) ;Get pointer to current macro
MOVE D,MACNAM(E) ;Get name of macro
PUSHJ P,CHOUT6 ;Print name
MOVE B,[POINT 7,CHMAC5]
PUSHJ P,CHTEXT ;Print colon and space
MOVEI B,MACTXT(E)
PUSH P,B ;Save pointer to beginning of text
HRLI B,441100 ;Make byte pointer to macro text
MOVEI E,2
MOVEI D,3
MOVEI G,=66-6-2
FBI5B: MOVEI C,-100(B)
CAMLE C,(P) ;Only show first 500 octal chars of macro
JRST FBI5Q ;Long macro, don't show all
ILDB C,B
JUMPE C,FBI5C
PUSHJ P,FBNINE
CAME B,-1(P) ;Are we up to current point of macro expansion?
JRST FBI5E ;No
MOVE B,[POINT 7,CHMAC4] ;Yes, mark that spot
PUSHJ P,CHTEXT
MOVE B,-1(P) ;Now list rest of macro def
SUBI G,6
FBI5E: SOJG G,FBI5B
PUSHJ P,CHCRLF
MOVEI G,=72
JRST FBI5B
FBI5Q: MOVE B,[POINT 7,[ASCIZ/.../]] ;Print elipsis at end of macro text
HLLOS (P) ;Don't let us get back here
JRST FBI5B
FBI5C: MOVE B,[POINT 7,CHMAC2]
PUSHJ P,CHTEXT
HRRZ T,-2(P) ;Get number of repeated expansions finished
PUSHJ P,NUMSTR
MOVE B,[POINT 7,CHMAC3]
PUSHJ P,CHTEXT
HLRE T,-2(P)
MOVN T,T ;Get positive number of repeats left
ADD T,-2(P) ;Add in repeats finished
ANDI T,-1 ; which can only make a half-word value
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
SUB P,[3,,3] ;Flush macro call data from stack
JRST FBI5D
;FBI5D FBI6 FBI7 FBI7A FBI7B FBI8 FBI8A FBI8B
;Show the F register
FBI5D: MOVE B,[POINT 7,CHREG2]
PUSHJ P,CHTEXT
MOVEI E,40
IDPB E,A
HLRZ T,SAVEAC
PUSHJ P,OCTSTR
MOVEI E,","
IDPB E,A
IDPB E,A
HRRZ T,SAVEAC
PUSHJ P,OCTSTR
PUSHJ P,CHCRLF
;Put POPJ addresses from PDL on the next two lines
MOVEI E,11
MOVE B,[POINT 7,CHPDLM] ;Some text
PUSHJ P,CHTEXT
HRRZ T,SAVEAC+17
SUBI T,PDL
MOVNS T
HRLZ D,T
ADDI D,PDL
FBI6: HRRZ C,D
SUBI C,PDL
TRNN C,7
PUSHJ P,CHCRLF
HRLZ TT,(D) ;Get popj address
MOVEM TT,TTSAVE
PUSHJ P,LHOCTS
IDPB E,A
AOBJN D,FBI6
PUSHJ P,CHCRLF
PUSHJ P,CHCRLF
;To report all desired data as specified by FBITAB/FBINAM
MOVSI Q,-LADRS
JUMPE Q,FBI11A
MOVE B,[POINT 7,FBIFRM]
PUSHJ P,CHTEXT
MOVEI E,11 ;To store TAB
MOVEI I,"," ;To store a space
MOVEI H,10 ;To limit output line length
FBI7: CAILE H,1
SOJA H,FBI7A
MOVEI H,10
PUSHJ P,CHCRLF
FBI7A: HLRZ D,ADRS(Q)
LSH D,-9
MOVEM D,FBFORM#
HLRZ D,ADRS(Q)
ANDI D,777 ;Get count
MOVNS D
HRLZS D
HRRZ G,ADRS(Q)
MOVEI TT,6
MOVE B,[POINT 6,FBINAM]
ADDI B,(Q)
FBI7B: ILDB C,B
ADDI C,40
IDPB C,A
SOJG TT,FBI7B
MOVEI C,"/"
IDPB C,A
IDPB E,A
FBI8: CAIG G,@JOBREL ;Is address above job's lower segment?
JRST FBI8A ;No
CAIG G,ENDPUR ;Is it beyond limit of upper segment?
CAIGE G,400000 ;or maybe in between lower and upper?
JRST FBI8B ;It IS out of bounds
FBI8A: MOVE T,(G)
MOVE C,FBFORM
TRNN C,70
JRST @FBIDSP(C)
LSH C,-3 ;Indirect case, get format for original location
JRST @FBIDSP(C)
FBI8B: MOVE B,[POINT 7,CHOUTB] ;Out of bounds message
PUSHJ P,CHTEXT
MOVEI D,0
SUBI H,3
JRST FBI9
;FBIDSP FBIPIC FBIFUL FBIADD FBIOCT FBIDEC FBIASC FBIAS2 FBISIX FBISI2 FBI9 FBI9A FBI9B
;Dispatch for desired format
FBIDSP: FBIPIC ;Let E pick octal format
FBIOCT ;Octal with leading zeros suppressed
FBIFUL ;Full word octal (L,,R)
FBIADD ;Address field only, in octal
FBIDEC ;Signed decimal
FBIASC ;ASCIZ with nulls suppressed
FBISIX ;SIXBIT
;Let E pick suitable octal format
FBIPIC: HLRZ TT,(G)
JUMPE TT,FBIOCT ;Report with leading zeros suppressed
CAIN TT,777777
JRST FBIOCT ;Report as negative number
FBIFUL: HLLZ TT,(G)
PUSHJ P,LHOCTS
SOS H
IDPB I,A
IDPB I,A
HRLZ TT,(G) ;Entry here from FBIADD
PUSHJ P,LHOCTS
JRST FBI9
;To report address field only
FBIADD: MOVEI C,"A"
IDPB C,A
HRRZ T,(G)
;To report as signed octal with leading zeros suppressed
FBIOCT: PUSHJ P,OCTSTR
JRST FBI9
;To report as signed decimal
FBIDEC: PUSHJ P,NUMSTR
MOVEI C,"."
IDPB C,A
JRST FBI9
;To report as ASCIZ
FBIASC: MOVE B,[POINT 7,T]
MOVEI TT,5
FBIAS2: ILDB C,B
SKIPE C
IDPB C,A
SOJG TT,FBIAS2
JRST FBI9
;To report in SIXBIT
FBISIX: MOVE B,[POINT 6,T]
MOVEI TT,6
FBISI2: ILDB C,B
ADDI C,40
IDPB C,A
SOJG TT,FBISI2
FBI9: HRRZ C,A
CAML C,TELSIZ ;This allows for 7 more words
JRST FBI10 ;Out of space
MOVE C,FBFORM
TRZE C,70 ;Was an indirect bit set?
JRST FBI9B ;Yes
IDPB E,A
SOJG H,FBI9A
PUSHJ P,CHCRLF
MOVEI H,10
FBI9A: AOBJP D,FBI11
AOJA G,FBI8
FBI9B: MOVEM C,FBFORM
MOVE G,(G)
MOVEI C,"/"
IDPB C,A
IDPB E,A
SOJG H,FBI8
PUSHJ P,CHCRLF
MOVEI H,10
JRST FBI8
;⊗ CHEND FBI10 FBI10A FBI11 FBI11A FBI12 FBI13 WRITIT WRITT4 MRET WRITT2 WRITT3
CHEND: ASCIZ /
TELBUF is full/
;Action if buffer is getting full
FBI10: MOVE C,FBFORM
TRNE C,70 ;Is indirect bit set?
JRST FBI10A ;Yes, so report buffer full
SKIPL D ;Was another cell called for?
AOBJP Q,FBI11A ;No, then was this the last item?
FBI10A: MOVE B,[POINT 7,CHEND]
PUSHJ P,CHTEXT
JRST FBI12
FBI11: AOBJN Q,FBI7
PUSHJ P,CHCRLF
FBI11A: PUSHJ P,CHCRLF
HRRZ T,A
SUBI T,TELBUF-1
PUSHJ P,NUMSTR ;Report words used for record
FBI12: PUSHJ P,CHCRLF
HRRZ T,RPPN
CAMN T,[SIXBIT/ ALS/]
JRST [MOVE T,CHEXTA ;Start with extension of ALS
JRST FBI13]
CAMN T,[SIXBIT/ ME/] ;Start with EXT of ME1 in this case
SKIPA T,CHEXTM
MOVE T,CHEXT ;Start with EXT of 001
FBI13: MOVEM T,CHFILE+1
WRITIT: OPEN DSKCH,[DMPMOD↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,CHPPN
MOVEM T,CHFILE+PPN3 ;This must be reset
LKPMAC <LOOKUP DSKCH,CHFILE>
JRST .+2 ;Assume that it does not exist
MOVEM T,CHFILE+PPN3 ;This must be reset
ENTER DSKCH,CHFILE
JRST WRITT2
UGETF DSKCH,T
HRRM T,CHUSET
XCT CHUSET
OUTPUT DSKCH,[-LTELBF,,TELBUF-1↔0]
CLOSE DSKCH,
WRITT4: RELEAS DSKCH,
SETZM JOBJDA+DSKCH
MRET: MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
WRITT2: HRRZ T,CHFILE+1 ;get error code
CAIN T,3 ;busy?
JRST WRITT3 ;yes, try a different filename
MOVE D,[FRDRUN,,CHFILE] ;pointer to file block (no switch typeout)
PUSHJ P,FILERR ;report what happened
JRST WRITT4
WRITT3: MOVSI T,1 ;If file is busy create a new one
ADDM T,CHFILE+1
CLOSE DSKCH,
JRST WRITIT ;Try again
;MAPMES MAPHED DSKMAP MAPEXT MAPPPN MAPCR MAPCR2 MAPT2 MAP MAPIT MAP1 MAP2 MAP3 MAP3A MAP4 MAP4B MAP4W MAP4Q MAP4N MAP4M MAP4A MAP5 MAP6 MAP7 MAP8 MAP9 MAP10
MAPMES: ASCIZ /
FSUSE FSFREE FSTOT DIR PAGE ATT FSBEG
/
MAPHED: ASCIZ /
0 1 2 3 4 5 6 7
/
DSKMAP←←6
MAPEXT: SIXBIT /001 /
MAPPPN: ERRPPN
MAPCR: TYPCHR "
" ;New line needed
HRRZ D,TYOPNT
SUBI D,TELBUF ;How many words have been used?
CAIGE D,157 ;We reserve 17 words for each line
JRST MAPCR2 ;It is safe to add another line to map
OUTPUT DSKMAP,[-200,,TELBUF-1↔0];Empty buffer
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
MOVEM A,TYOPNT
SETZM TELBUF
MOVE G,[TELBUF,,TELBUF+1]
BLT G,TELBUF+177 ;Clear the buffer
MAPCR2: MOVEI D,100 ;Allow 64 cell symbols on a line
ADDI E,100
TRNN E,777
TYPCHR "
" ;An extra CR for readability
TYPOCT E
TYPCHR " " ;A TAB
POPJ P,
MAPT2: MOVE T,MAPILE+1 ;If file exists create a new name
ADD T,[1,,0]
MOVEM T,MAPILE+1
CLOSE DSKMAP,
JRST MAPIT ;Try again
;Code to make a map of free storage
MAP: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+17 ;No reason to make another push-down list
MOVE T,MAPEXT ;Start with EXT of 001
MOVEM T,MAPILE+1
MAPIT: OPEN DSKMAP,[DMPMOD↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,MAPPPN
MOVEM T,MAPILE+PPN3 ;This must be reset
LKPMAC <LOOKUP DSKMAP,MAPILE>
JRST .+2 ;Assume that it does not exist
JRST MAPT2 ;This name is already used
ENTER DSKMAP,MAPILE
JRST MAPT2
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+177 ;Clear the buffer
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
PUSHJ P,FILEID ;Get file identification data
MOVE B,[POINT 7,MAPMES]
PUSHJ P,CHTEXT ;Print labels
MOVE T,FSUSE ;Cells occupied
PUSHJ P,NUMSTR
MOVEI E,11
IDPB E,A
MOVE T,FSFREE ;Cells free
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,FSMAX
SUB T,FSMIN
PUSHJ P,NUMSTR ;Total number of cells in free storage
IDPB E,A
MOVE G,FSMIN
ADDI G,1
MOVE T,DIR
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of Directory cells
IDPB E,A
MOVE T,PAGE
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of page cells
IDPB E,A
HRRZ T,ATTBUF
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of ATTBUF
IDPB E,A
MOVE T,FSBEG
SUB T,FSMIN
PUSHJ P,OCTSTR ;Relative start of FRFREE
MOVE B,[POINT 7,MAPHED]
PUSHJ P,CHTEXT
MOVEM A,TYOPNT ;Prime for TYPCHR
MOVE B,FSMIN ;Start at beginning of free storage
MOVEI D,100 ;Allow 64 cells per line in map
MOVEI E,0 ;Used for cell count
TYPOCT E
TYPCHR " " ;A TAB
MAP1: HRRZ T,(B) ;Get the number of words for this line
HLRZ C,(B) ;and the identifier
CAIG C,2 ;Is this space occupied?
JRST [MOVE G,T↔JRST MAP2]
CAIE C,777777 ;Then it should be empty
JRST MAP3 ;Something is wrong
MOVE G,(B) ;It may be, so match entire word
MAP2: MOVE TT,B
ADD TT,T ;This will be the new B
CAML TT,FSMAX
JRST MAP10 ;We are at the end
CAME G,-1(TT) ;Check the two end counts
JRST MAP3 ;We're in trouble
CAIN C,DIRCOD ;Is it a directory line?
JRST MAP4 ;Yes
CAIN C,TXTCOD ;Or maybe text?
JRST MAP4A ;Yes
CAIN C,MACCOD ;Or maybe a macro?
JRST MAP4M ;Yes
CAIN C,DELCOD ;Or maybe deleted text?
JRST MAP4N ;Yes
CAIN C,QUECOD ;Or maybe queued-lisp answer block?
JRST MAP4Q ;Yes
CAIN C,WINCOD ;Or maybe window?
JRST MAP4W ;Yes
CAIN C,777777 ;Surely must be empty then?
JRST MAP6 ;Yes
;Something is wrong, try to fix
TYPCHR "?" ;Unknown identifier
SKIPA
MAP3:
IFE DECSW,<
TYPCHR 33 ;Counts are not equal
>
IFN DECSW,<
TYPCHR 32
>
MAP3A: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
AOS TT,B
CAML B,JOBREL
JRST MAP9
MOVE C,(B)
CAME C,[-1] ;Is it falsely labeled free storage?
JRST MAP1 ;It does not seem to be
TYPCHR " " ;Looks like it is
JRST MAP3A ;Keep looking
;Directory space
MAP4: TYPCHR "D"
SOJ T,
MAP4B: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "."
SOJG T,MAP4B
JRST MAP8
;Window block
MAP4W: TYPCHR "W"
SOJA T,MAP5 ;Finish like normal text
;Lisp queue block
MAP4Q: TYPCHR "Q"
SOJA T,MAP5 ;Finish like normal text
;Deleted text line
MAP4N: TYPCHR "X"
SOJA T,MAP5 ;Finish like normal text
;Macro storage
MAP4M: TYPCHR "M"
SOJA T,MAP5 ;Jump into text FS routine
;Text space
MAP4A: TYPCHR "T"
SOJ T,
MAP5: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "+"
SOJG T,MAP5
JRST MAP8
;Free storage space
MAP6: TYPCHR "F"
SOJ T,
MAP7: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR " "
SOJG T,MAP7
MAP8: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
MOVE B,TT
CAMGE B,JOBREL
JRST MAP1
MAP9: TYPCHR "
"
OUTPUT DSKMAP,[-200,,TELBUF-1↔0]
CLOSE DSKMAP,
RELEAS DSKMAP,
SETZM JOBJDA+DSKMAP
MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
MAP10: TYPCHR "E"
SUB TT,JOBREL
TYPOCT TT ;As a clue as to why
JRST MAP9
;PARSYM PAREN PARENB PAREN1 PAREND PARENC PARENA
PARSYM: "(",,")"
"→",,"←" ;Standard symbol table
"⊂",,"⊃"
"`",,"'"
"≤",,"≥"
IFE DECSW,<
173,,176 ;Left and right brace
>
IFN DECSW,<
173,,175 ;Left and right brace
>
"<",,">"
"[",,"]"
LPARSM←←.-PARSYM
;Extend command to accept specification of bracketing pair
PAREN: PUSHJ P,XTDLMT ;avoid reading the cmd name delimiter
PUSHJ P,XTDLIN ;Prepare to reread extended command line
PUSHJ P,TYI
JRST PAREND ;Use default values
MOVSI A,(C)
PUSHJ P,TYI
JRST PARENB ;Only got one char.
HRRI A,(C)
PUSHJ P,TYI
JRST PARENA ;Okay, no garbage followed the two chars
SETZM TYIPNT
SORRY Only two characters are allowed after command delimiter.
JRST PPJ1CR
PARENB: MOVEI TT,LPARSM-1
PAREN1: HLLZ D,PARSYM(TT) ;Pick up a left half symbol
CAMN A,D ;Is this the same?
JRST PARENC ;Yes
SOJGE TT,PAREN1
SORRJ Left symbol "
HLRZ C,A ;Get symbol that was typed in
PUSHJ P,PRNTCH ; and type it back out.
OUTSTR[ASCIZ/" not in table. Must type right symbol explicitly.
/]
JRST POPJ1
PAREND: SKIPA A,PARSYM ;Get default chars
PARENC: HRR A,PARSYM(TT) ;Get corresponding right-symbol from table
PARENA: HLRZM A,LEFTC ;Got exactly two chars--store the first.
HRRZM A,RITEC ;Store second one.
SETZM TYOPNT
SKIPG CURMAC ;Don't say anything if in macro
SKIPGE BLAB ;Nor if in terse mode
POPJ P, ;Just say OK
OUTSTR [ASCIZ /Using symbol pair /]
MOVE C,LEFTC
PUSHJ P,PRNTCH ;Print char using symbols for non-printing chars.
MOVE C,RITEC
PUSHJ P,PRNTCH ;Print right char.
OUTSTR [ASCIZ/
/]
JRST POPJ1
;LEFTC RITEC PARMAX PARMIN PARGDP PARLDP PARTMS PARTML PARCT PARLN PARDEF PARPRS PARTOT PARPGL PAROFF PARX
IMPURE
LEFTC: "(" ;Left-symbol
RITEC: ")" ;Right symbol
PARMAX: 77777 ;Desired maximum level
PARMIN: -77777 ;Desired minimum level
PARGDP: 0 ;Greatest level
PARLDP: 0 ;Lowest level
PARTMS: 0 ;Times at max level
PARTML: 0 ;Times at min level
PARCT: 0 ;Character count on line being studied
PARLN: 0 ;Line count when found
PARDEF: 0 ;Deficiency
PARPRS: 0 ;Pairs of bracketing symbols
PARTOT: 0 ;Total character count
PARPGL: 0 ;<line>,,<page> at time command was given
PAROFF: 0 ;Value of EDCNM when command was given
PARX: 0 ;Flag for Xtend command
PURE
comment ⊗
Register assignment
Register Contents
A Initial argument, then pointer
B Character count
C Character
D Current level
E Temporary ARRLIN for line being searched
G Times at minimum depth
H Flags for special characters
I Least level
DSP Dispatch table address
Q Line count
T Left symbol count
TT Times at greatest depth
end of comment ⊗
;PARSAV RPAREN PARR LPAREN PARL PARL2 PAR PAR0
;To save current position
PARSAV: PUSHJ P,GPAGL ;Get current line,,page into T
MOVEM T,PARPGL ;Save line,,page for double-arrow cmd
MOVE E,EDCNM
TLO E,1
TRNN F,EDITM
SETZ E,
MOVEM E,PAROFF
POPJ P,
;Right parenthesis search
RPAREN: SETOM PARX ;Set extend flag
SKIPA
PARR: SETZM PARX
MOVE C,LEFTC ;Is this a special case with
CAMN C,RITEC ;the left-symbol the same as the right-symbol?
JRST PARL2 ;All searches are for left symbols in this case
MOVEM A,PARMIN ;Testing for a desired minimum
MOVEI Q,77777 ;To prevent exit on left-symbols
MOVEM Q,PARMAX
SOS PARMIN ;Test is made after the symbol instead of before
JRST PAR
;Left parenthesis search
LPAREN: SETOM PARX ;Set extend flag
SKIPA
PARL: SETZM PARX
PARL2: MOVEM A,PARMAX ;Testing for a desired maximum
MOVNI Q,77777
MOVEM Q,PARMIN ;To prevent exit on right-symbols
PAR: MOVEM A,SARG ;Save argument for reporting
PUSHJ P,PARSAV ;To save present conditions
MOVE E,CURPAG
MOVEM E,SRCPG ;Will be updated as multi-page search progresses
SETZM TYOPNT
SETZM ESCIEN ;User has not typed ESC I yet
SETZM ESCI2
HRRZ E,ARRLIN ;Get line location in free storage
MOVEI A,LLDESC(E)
TLO A,440700
MOVEI DSP,PARDSP ;Dispatch table address for displayed page
MOVSI H,NSPEC!LSPC ;Set flags for special characters
SETZB B,PARTOT ;Characters on line, total characters
SETZB TT,PARGDP ;Number of times at greatest level, this level
SETZB G,PARLDP ;Minimum level count,lowest level
SETZB T,D ;Left-symbol count, current level
SETZB Q,I ;Q counts distance in lines to line where found
MOVE C,ARRL ;See if we are supposed to stop before starting
CAMN C,SLNSTP ;This the line we're supposed to stop at?
JRST [ HRRZM C,SHTSTP ;Yes, remember line number
JRST PAREXX] ;And stop quickly
TRNN F,EDITM ;In line edit mode?
JRST PAR1 ;No
MOVE B,EDCNM ;So positioning will be right in first line
MOVNM B,PARTOT ;but will not count in characters searched
MOVEI DSP,PA1DSP ;Special dispatch table if in line-editor
HRR A,[BUF] ;with data in BUF
JUMPE B,PAR0 ;Start at first character
MOVE G,B
IBP A ;We want A to point to starting position
SOJG G,.-1
PAR0: ILDB C,A ;Look at new first character
CAME C,RITEC ;Are we under a right-symbol?
JRST PAR1B ;We are not, so consider this character
AOJA B,PAR1 ;We are, so count and read another character
;PA1DSP PARDSP PAXDSP PACDSP PARESC PARES2 PARFF
;Dispatch table for Buf search (line-editor line)
PA1DSP: AOJA Q,PAR1CR ;Null we should never get here
AOJA B,PAR1 ;BS
AOJA Q,PAR1CR ;CR end of line-editor line
AOJA Q,PAR1CR ;LF treat as missing CR
AOJA B,PAR1 ;TAB TABs are tabs only in BUF
JFCL ;FF should not be in text
JFCL ;ALT should not be in text
;Dispatch table for first page PAREN search (but not line-editor line)
PARDSP: AOJA Q,PARCR ;null we should never get here
AOJA B,PAR1 ;BS we should never get here
AOJA Q,PARCR ;CR increment line count
AOJA Q,PARCR ;LF treat as missing CR
JRST PAR1A ;TAB special treatment on displayed page
JFCL ;FF should not be in text
AOJA B,PAR1 ;ALT should not be in text
;Dispatch table for extend PAREN search
PAXDSP: JRST PARNUL ;null
JRST PARRCD ;177 Normal end of buffer signal
AOJA Q,PARXCR ;CR
AOJA Q,PARXCR ;LF treat as missing CR
AOJA B,PAR1 ;TAB as any other char
JRST PARFF ;FF
AOJA B,PAR1 ;ALT
;Dispatch table for Xtent CR
PACDSP: JRST PARXC2 ;Null pass it on after resetting DSP
JRST PARRCD ;177 End of buffer just after a CR
AOJA Q,PARXC1 ;CR count it and still look for a LF
JRST [MOVEI DSP,PAXDSP
JRST PAR1] ;LF eat it and reset DSP
JRST PARXC2 ;TAB pass it on
JRST PARXC2 ;FF pass it on
JRST PARXC2 ;ALT pass it on
;To report ESC I interuption
PARESC: PUSHJ P,ESCSTP ;Tell him we got ESC I at end of certain page
OUTSTR [ASCIZ / while looking for /]
MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARES2 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY5
PARES2: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
JRST PARTY5
;Test for ESC I interruption
PARFF: SKIPE ESCIEN
JRST PARESC ;Interruption
;Code to update page count and display it after the second page
;on finding a FF in the text at any point
ADDM B,PARTOT ;Accumulate char count
SETZB B,Q ;and reset B and Q
PUSHJ P,SRCFPP ;Add to page count and display number
JRST PAR1
JRST PAREXX ;Early stop
;PARXCR PARXCA PARXCB PARXC1 PARXC2 PAR1X PAR1CR PARCR PAR1 PAR1B PAR1A
PARXCR: MOVEI DSP,PACDSP ;Special dispatch in this case
ADDM B,PARTOT ;Add to total character count
SETZ B, ;and start over
SKIPE EDFIL-2 ;Is this a /F/R file?
CAMGE Q,EDFIL-2 ;And is a pseudo FF indicated?
JRST PARXC1 ;No
SKIPE ESCIEN
JRST PARESC ;An ESC I interuption
PUSH P,A ;Save pointer
ILDB C,A
CAIN C,14 ;Is next char a FF?
JRST PARXCB ;Yes, so let nature take its course
CAIE C,12 ;Maybe it is a LF
JRST PARXCA ;No, so a pseudo FF is indicated
ILDB C,A ;In this case test the next char
CAIN C,14 ;It may be a FF
JRST PARXCB ;It is, so all is well
PARXCA: PUSHJ P,SRCFPP ;Add to page count and display it
TDZA Q,Q ;It is not, so reset line count
JRST PAREXX ;Early stop
PARXCB: POP P,A ;Restore A
PARXC1: ILDB C,A ;We must look at the next character
TDNE C,CTAB(C)
XCT @CTAB(C)
PARXC2: MOVEI DSP,PAXDSP ;Reset dispatch index
JRST PAR1B ;Already have next character
PAR1X: CAME DSP,[PACDSP] ;See where we came from
JRST PAR1 ;Normal return from new buffer load
JRST PARXC1 ;Must still look for a LF
PAR1CR: MOVEI DSP,PARDSP ;Not found on line-edit line
PARCR: ADDM B,PARTOT ;Add to total character count
SETZ B, ;Start count over
MOVE A,ARRL
ADD A,Q ;Calculate number of next line
CAMN A,SLNSTP ;Supposed to stop at this line?
JRST [ HRRZM A,SHTSTP ;Yes, remember line where we stopped
JRST PAREXX] ;Now do short stop
HRRZ E,(E) ;go to the next line of text
CAIN E,BOTSTR ;Are we at the end of the page?
JRST PAREX ;Yes
MOVEI A,LLDESC(E)
TLO A,440700
;Start of inner loop. Used for both displayed-page search and extended search
;DSP set to PARDSP, PAXDSP or PACDSP depending on circumstances
PAR1: ILDB C,A
PAR1B: TDNE H,CTAB(C)
XCT @CTAB(C)
CAMN C,LEFTC ;Are we at a LEFT-SYMBOL?
AOJA D,PAR2 ;Yes
CAMN C,RITEC ;Are we at a RIGHT-SYMBOL?
SOJA D,PAR2A ;Yes
AOJA B,PAR1 ;Go around again
;End of inner loop
;We've found a TAB (on the displayed page)
PAR1A: ILDB C,A
CAIE C,11
JRST .-2 ;Eat to next TAB
AOJA B,PAR1
;PAR2 PAR3 PAR2A PAR2B PARFND PARNOT PARTY5
;We've found a left-symbol
PAR2: AOJ T, ;Count as start of another pair
AOJ I, ;The old minimum no longer holds
CAMGE D,PARGDP ;Are we at less than the maximum level?
AOJA B,PAR1 ;Yes, so go to next character
CAMG D,PARGDP ;Have we been to this level before?
AOJA TT,PAR3 ;Yes, so add to count of number of times here
MOVEI TT,1 ;Start the count for number of times at this level
AOS PARGDP ;And add to the maximum level
CAML D,PARMAX ;Are we at the desired level?
JRST PARFND ;Yes
PAR3: AOJA B,PAR1 ;Go to next character
;We've found a right-symbol
PAR2A: CAMLE D,PARGDP ;Are we at greater than the minimum level?
JRST PAR2B ;Yes
CAML D,PARGDP ;Have we been at this level before?
AOJA G,PAR2B ;Yes, so add to count
MOVEI G,1 ;Start the count for this new level
SOS PARGDP ;and subtract from the minimum level
PAR2B: CAMGE D,PARMIN
AOJA B,PAR1
CAMGE D,I
MOVEM D,I
CAME D,PARMIN
AOJA B,PAR1
;We've found the desired right-symbol
PARFND: SETZM PARDEF
MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
PARNOT: MOVEM T,PARPRS ;Number of left-symbols found
MOVEM TT,PARTMS ;Times at this level
MOVEM B,PARCT
ADDM B,PARTOT
MOVEM Q,PARLN ;Free register
SKIPN PARDEF
JRST [ SKIPLE BLAB ;Found
PUSHJ P,PINFO
JRST PART2A
JRST PART2A] ;Skip return from PUSHJ
SORRX Not found
JRST PARTY5 ;Suppressing error messages
SKIPLE BLAB
JRST [ PUSHJ P,PARTY0
JFCL ;Allow for skip return
JRST PARTY5]
MOVE Q,PARMAX
CAIL Q,77777
MOVE C,RITEC
CAIGE Q,77777
MOVE C,LEFTC
TYPCHR 42⊗7(C)
TYPCHR 42⊗7+40 ;Surround char with double quotes
PARTY5: PUSHJ P,DSHED ;Force redisplay of header line
XCT SRCDP3 ;Clear search page number if on III
TRNN F,EDITM
JRST PPJ1CR ;Not from line editor--put our CRLF and don't say OK
JRST REEDT2 ;Don't say HUH
;PINFO PARTY0 PARTY1 PARTY3 PARTY2 PART2A PARTY7 PARTY8 PARTY9 PARER1 PARERR
;Subroutine to report PAREN results
PINFO: PUSHJ P,ABCRLF
SKIPE PARDEF
OUTSTR [ASCIZ/Not found /]
SKIPN PARDEF
OUTSTR [ASCIZ /Found /]
PARTY0: MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARTY1 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY3
PARTY1: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
PARTY3: OUTSTR [ASCIZ/ after /]
TYPDEC PARTOT
OUTSTR [ASCIZ / chars./]
SKIPN PARDEF ;Were we successful?
JRST PARTY2 ;Yes
OUTSTR [ASCIZ / Deficit /]
SKIPL PARDEF
JRST .+3
TYPCHR "↓"
MOVNS PARDEF
TYPDEC PARDEF
PARTY2: SKIPN PARX
JRST .+3
OUTSTR [ASCIZ / thru p. /]
TYPDEC SRCPG
OUTSTR [ASCIZ / /]
AOS (P)
POPJ P,
;We have been successful
PART2A: TRNN F,EDITM ;Did we come from line editor?
JRST PARTY8 ;No
SKIPE PARLN ;Yes, but are we in the same line?
JRST PARTY7 ;No
MOVE A,SRCPG ;Yes, but is it the
CAMN A,CURPAG ;same page?
JRST PARTY9 ;Yes, so simply move cursor
PARTY7: PUSHJ P,FNEDIT ;We must save the edited version of the line
PARTY8: MOVE A,SRCPG ;Desired page
CAME A,CURPAG ;Are we on it?
PUSHJ P,NEWPG0 ;Get to right line on right page
SKIPA A,PARLN ;MOVARR wants line count in A
JRST [ TRO F,DSPSCR ;NEWPG0 couldn't open file. erase search page nbr
JRST POPJ1] ;don't say OK
PUSHJ P,MOVARR ;Get to correct line
SKIPN DPY
JRST PPJ1CR ;No line editor--put out CRLF and take skip return
PUSH P,PARCT
PUSH P,[240]
JRST EDIT1
PARTY9: PUSH P,PARCT
JRST EDTMR2 ;Edit same line at required place
PARER1: SORRY Directory not complete.
JRST PAREXX
PARERR: SORRY Disk IO error!
JRST PAREXX
;PAREX PAREXX PAREX2 PAREX3 PARB PARB2 PAREXT PARRCD PARRC2 PARNUL
PAREX: SKIPGE PARX ;Is this an EXTEND case
JRST PAREXT ;Yes, we must now search the other pages
PAREXX: MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
MOVE Q,PARMAX
CAIL Q,77777
JRST PAREX2 ;We were looking for a right-symbol
MOVE G,PARMAX
SUB G,PARGDP
MOVEM G,PARDEF
JRST PARNOT
PAREX2: MOVE G,PARGDP
CAMG G,PARMIN ;Did we ever reach the desired level
JRST PAREX3 ;No
SUB I,PARMIN ;Yes, but how far did we miss getting back?
MOVEM I,PARDEF
JRST PARNOT
PAREX3: MOVE G,PARGDP
SUB G,PARMIN
SOJ G,
MOVEM G,PARDEF
JRST PARNOT
;This code puts you back from whence you came on the last (, ) or ↔ command
PARB: SKIPN PARPGL ;Any place saved to go back to?
JRST PARB2 ;Nope
PUSH P,PAROFF
PUSH P,PARPGL
PUSHJ P,PARSAV ;So we can get back here
TRNE F,EDITM ;Did we come from line editor?
PUSHJ P,FNEDIT ;Yes, save the edited version of the line
SKIPL BLAB
OUTSTR [ASCIZ / Going back. /]
POP P,A ;Line,,Page we want to be on
HLRZM A,SLINE ;Set up starting line
MOVEI A,(A) ;Just page number
PUSHJ P,NEWPG5
CAIA ;NEWPG5 skips on error
JRST POPAJ1 ;can't open file, or maybe old page is gone
SETZM TYOPNT
POP P,A ;Test offset
JUMPE A,CPOPJ ;Don't go to line editor if not called from there
SKIPN DPY
POPJ P, ;No line editor to go to
ANDI A,-1 ;We have a bit in left half, which EDIT doesn't want
PUSH P,A ;Put offset back on the stack
PUSH P,[240]
JRST EDIT1
PARB2: SORRY No place to go back to.
TRNN F,EDITM ;Are we from the line editor?
JRST POPJ1 ;No
JRST REEDT2 ;Yes, don't say HUH
;To get next block on finishing the displayed page
PAREXT: SKIPE ESCIEN
JRST PARESC
MOVE A,DIRPT
HRRZ C,(A)
CAMN C,DIREND
JRST PAREXX ;There are no more pages
SKIPN A,DIRREC(C) ;get record number where next page starts
JRST PARER1
MOVEI DSP,PAXDSP ;Set DSP for EXTEND search
SETZB B,Q ;B has probably been reset but just in case
HRRZ C,A
PUSHJ P,SRCFPP ;Update page number and display
CAIA
JRST PAREXX ;Early stop
ANDCMI A,-1
ROT A,7
ADD A,IBFPNT
IBP A
CAMN C,IBLK ;Don't USETI if already there
JRST PAR1
PUSH P,A
MOVE A,C
XCT %SETI
POP P,A
MOVEM C,IBLK
JRST PARRC2
;Reload when buffer is exhausted
PARRCD: SKIPLE PARX
JRST PAREXX ;Not found
MOVE A,[440700,,IBUF]
AOS IBLK
PARRC2:
IFN FTBUF,<
SOS IBLK ;BIN needs IBLK to point to block before one wanted
PUSHJ P,BIN ;Get record of input from the cache if possible
XCT %IN
JRST [AOS IBLK↔JRST PAR1X] ;Continue, but test if previous char was a CR
AOS IBLK
>;FTBUF
IFE FTBUF,<
XCT %IN
JRST PAR1X ;Continue, but test if previous char was a CR
>;NOT FTBUF
XCT %STAT
TRNN C,20000 ;EOF?
JRST PARERR ;No, something wrong
MOVE C,IBLK
SUBI C,1 ;Anticipated too soon
LSH C,7 ;Number of words successfully read
SUB C,FILWC ;Negative of number of real words in last buffer
JUMPGE C,PAREXX ;No more data
MOVN C,C ;Incomplete record case
SETZM IBUF(C) ;Fill rest of buffer with nulls
MOVEI C,IBUF+1(C)
HRLI C,-1(C) ;pointer to BLT rest of buffer with nulls
CAME C,[IBUF+177,,IBUF+200] ;Don't do BLT if only one word left
BLT C,IBUF+177
MOVEI C,777
MOVEM C,PARX ;Flag for no more text
JRST PAR1X ;Continue after test
;Fast handling of words full of nulls
PARNUL: CAMGE A,[100700,,0] ;Is the null at the end of a word?
SKIPE 1(A) ;Is next word all nulls?
JRST PAR1 ;No
AOJA A,.-2 ;Yes, so try with the next word
;BAKADD BAKAD2 BAKSUB BAKSU2 BAKSAV BAKSA0 BAKSA2 BAKSA3 BAKSA4 BAKSA5 BAKSA6 ZPAGES BACKGO BACKG2 BACKG5 BACKG8 BACKG7 BACKG3 BACKG6 BACK6L BACKG4 NOHDEF NOHSTK NOHST2 NOHSOV
;Here upon pagemark insertion.
BAKADD: PUSHJ P,GPAGL ;Get current line,,page
MOVSI TT,-NBACK
BAKAD2: HRRZ B,BAKPLC(TT) ;Get a remembered page number
CAILE B,(T) ;Is it after current page?
AOS BAKPLC(TT) ;Yes, update it
AOBJN TT,BAKAD2 ;Loop through whole list
POPJ P,
;Here upon pagemark deletion with A containing page whose mark is gone.
BAKSUB: PUSHJ P,BAKSA3 ;First remove page in A from page stack
MOVSI TT,-NBACK
BAKSU2: HRRZ T,BAKPLC(TT) ;Get a remembered page number
CAIL T,(A) ;Is it on or after page going away?
SOS BAKPLC(TT) ;Yes, update it
AOBJN TT,BAKSU2 ;Loop through list
POPJ P,
;Routine to update list of pages we've been on recently. Here from RDPGSV.
;Called with page we're going to in A. Clobbers B,C,T,TT.
;This routine makes sure that no two remembered pages are the same.
BAKSAV: SKIPN T,BAKPL2# ;Remember place we're coming from (set at FLSPG0)
POPJ P, ;Already remembered
SETZM BAKPL2
SKIPE BAKFAS# ;Has the page stack already been fixed?
POPJ P, ;Yes
BAKSA0: MOVEI C,(T) ;Save number of new page we're remembering
MOVSI B,-NBACK ;AOBJN ptr to list of places we've been
SKIPA TT,BAKWI2# ;Window setting we're coming from
BAKSA2: CAIE C,(T) ;Is this old page the one we just entered in list?
CAIN A,(T) ;Are we going to the page we're about to remember?
POPJ P, ;Yes to one, don't remember it except by being on it
EXCH T,BAKPLC(B) ;Remember new place and pick up older place
EXCH TT,BAKWIN(B) ;Same for window setting
SKIPE BAKPLC(B) ;Did we just move the end marker in the list?
AOBJN B,BAKSA2 ;No, continue through list unless done
HRRZM B,BAKMAX ;Store number of valid entries in list
POPJ P,
;Here to flush page whose number is in A from the page stack.
;Called by APPEND and BAKSUB (above).
BAKSA3: SKIPN BAKPLC ;Skip if anything in stack
POPJ P, ;Don't bother with stack
MOVN T,BAKMAX ;Get size of stack
MOVSI T,(T) ;Make aobjn ptr
BAKSA4: HRRZ TT,BAKPLC(T) ;Get page number of some place on stack
CAIN TT,(A) ;Is that the page we don't want on the stack?
JRST BAKSA6 ;Yes, flush from stack
AOBJN T,BAKSA4 ;Look through stack
POPJ P, ;Page wasn't in the stack
BAKSA5: MOVE TT,BAKPLC(T)
MOVEM TT,BAKPLC-1(T) ;Squeeze entry out of middle of stack
BAKSA6: AOBJN T,BAKSA5
SOS T,BAKMAX ;One less entry in stack
SETZM BAKPLC(T) ;Mark end of stack with a zero
POPJ P,
ZPAGES: SETZM BAKPLC ;Clear the page stack
POPJ P,
;Command routine to go back to some previously visited page.
;Arg indicates how many pages ago we visited the desired page.
BACKGO: JUMPE A,BACKG4 ;Zero arg means type out default arg for αβ cmd
MOVM C,A ;Get positive index of desired old page
TRNE F,REL ;Relative arg?
JRST BACKG7 ;Yes, wants to diddle stack
CAIE B,CTMT3 ;αβ command?
JRST BACKG2 ;Nope
TRNE F,ARG ;Yes, any arg?
MOVMM C,BAKDBL ;Arg given with αβ means set αβ default
MOVM C,BAKDBL ;Get default arg for αβ command
BACKG2: SKIPN BAKPLC ;Any remembered pages at all?
JRST BACKG3 ;No (check here to allow storing default for αβ)
CAMLE C,BAKMAX ;Range check old page index
MOVE C,BAKMAX ;Get index of oldest page
MOVE A,BAKPLC-1(C) ;Get line,,page of place to return to
HLRZM A,SLINE ;Tell NEWPG0 what line to start at
HRRZ A,A ;Page we're going to
;Here we flush the requested return page from the list if it is already in core.
CAML A,FIRPAG ;Is the requested page in core?
CAMLE A,CURPAG ;Maybe
JRST BACKG5 ;No
SETZM BAKPLC-1(C) ;Yes, flush its entry in remembered list
SOS BAKMAX ;One less entry in list
CAIN C,NBACK ;Is flushed entry the last in the list?
JRST BACKG2 ;Yes, try to return to place that isn't in core
MOVSI TT,BAKPLC(C) ;Source of blt
HRRI TT,BAKPLC-1(C) ;Destination of blt to compress out a word
BLT TT,BAKPLC+NBACK-2 ;Move each entry up by one
SETZM BAKPLC+NBACK-1 ;Make sure there is a zero at end of list
MOVSI TT,BAKWIN(C)
HRRI TT,BAKWIN-1(C)
BLT TT,BAKWIN+NBACK-2 ;Compress word out of window list too
JRST BACKG2 ;Try again to return to a place that isn't in core
BACKG5: MOVE T,BAKWIN-1(C) ;Get window setting we'll want
MOVEM T,SWIND ;Set it up as starting window
BACKG8: PUSHJ P,NEWPG0 ;Get to appropriate line of appropriate page
SOS (P) ;success, say OK
SETZM BAKFAS# ;Make sure we remember old page next time
JRST POPJ1 ;don't say OK if NEWPG0 couldn't open file
BACKG7: SKIPN BAKPLC ;Is there really any place remembered?
JRST BACKG3 ;No, forget it
PUSHJ P,GPAGL ;Get current place (line,,page) into T for NOHSTK
MOVE TT,BAKMAX ;Arg for NOHSTK -- size of stack
CAILE C,(TT) ;Want to diddle stack by more than its size?
JRST NOHSOV ;Yes, that's silly
PUSH P,A ;Save amount of stack adjustment
HRLI TT,BAKPLC ;Arg for NOHSTK -- stack's starting address
PUSHJ P,NOHSTK ;Rotate page stack by (A)
EXCH A,(P) ;Retrieve stack adjustment, save new place to go
MOVE T,TOPWIN ;Current window (so maybe wrong thing if multipage)
HRLI TT,BAKWIN ;ARG for NOHSTK -- window stack's starting address
PUSHJ P,NOHSTK ;Rotate window stack just like page stack was
MOVEM A,SWIND ;Set up starting window for new page
POP P,A ;Get new line,,page
HLRZM A,SLINE ;Set up starting line for new page
HRRZ A,A ;New page to go to
SETOM BAKFAS# ;avoid saving old location in BAKSAV from NEWPG0
JRST BACKG8 ;Go there
BACKG3: SORRY No old Page to return to.
JRST POPJ1
BACKG6: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Page stack: /]
PUSHJ P,GPAGL
MOVEI T,(T) ;Current page
SETZM TYOPNT
TYPDEC T
SKIPN BAKPLC ;Any other pages?
JRST PPJ1CR ;No
MOVN C,BAKMAX ;Make aobjn ptr
MOVSI C,(C)
BACK6L: OUTCHR [","]
HRRZ T,BAKPLC(C) ;Get page number
TYPDEC T
AOBJN C,BACK6L ;Loop though whole stack
JRST PPJ1CR
BACKG4: CAIE B,CTMT3 ;αβ cmd?
JRST BACKG6 ;No, type out page stack
MOVEI A,[ASCIZ /O/] ;Command name to type out
MOVE B,BAKDBL ;Current default for αβ command
NOHDEF: PUSHJ P,ABCRLF ;Enter here from 0N and 0H cmds
OUTSTR [ASCIZ/Default arg for /]
SKIPN DPY
OUTSTR [ASCIZ/META-CONTROL-/]
SKIPE DPY
OUTSTR [ASCIZ/αβ/]
OUTSTR (A)
OUTSTR [ASCIZ/ cmd is /]
SETZM TYOPNT
TYPDEC B ;Type default arg
OUTSTR [ASCIZ/. /]
JRST POPJ1
;Common routine to adjust stacks for N,O,H commands.
;Call: MOVE TT,[<stack's starting address>,,<current size of stack>]
; MOVE T,[<current place we're at (not kept in stack)>]
; MOVE A,[<amount to adjust stack by (user's arg)>]
;Returns in A the place we should go to, which is no longer on the stack.
;T and TT are preserved. Clobbers B,C.
NOHSTK: MOVE B,TT ;Set up source ptr for first blt to copy stack
HRRI B,OLDBUF ;Destination
MOVEI C,OLDBUF+1(TT) ;Destination address of blt for second copy of stack
BLT B,-2(C) ;Make first copy of place stack
MOVEM T,-1(C) ;Insert current place between copies of stack
MOVEI B,-1(C)
ADDI B,(TT) ;Address of end of second copy
HRLI C,OLDBUF ;Source of blt to make second consecutive copy
BLT C,(B) ;Make second copy of stack
MOVEI B,OLDBUF ;Now prepare to blt stack back to place we keep it
SUBI B,(A) ;Adjust source pointer by amount user requested
JUMPL A,NOHST2 ;If negative adjustment (pop), blt from near top of 1st copy
ADDI B,1(TT) ;Positive adjustment (re-push), blt from bottom of 1st copy
NOHST2: MOVE A,-1(B) ;Get place to go to (not explicitly left on stack)
MOVSI B,(B) ;Source of blt
HLR B,TT ;Destination is original stack data area
HLR C,TT
ADDI C,(TT) ;End of blt plus one
BLT B,-1(C) ;Put adjusted stack back into its official stack space
POPJ P,
;Common error routine for N,O,H commands.
NOHSOV: SETZM TYOPNT ;Here when tried to diddle stack by more than its size
SORRJ Only
TYPDEC TT
OUTSTR [ASCIZ/ previous places on stack. /]
JRST POPJ1
;EXCL MSG MSG0B MSG0 MSG0C MSG0A MSG1 MSG2 PARAGR MSGLUZ MSGBK MSGBK0 MSG5 MSG6 MSG7 CHKMS0 CHKMSG CHKMS2
;This is the exclamation-point commands, designed for handling
;paragraphs just like the partial-sign command handles messages.
EXCL: SKIPA T,[PUSHJ P,PARAGR] ;Delimiter of paragraphs is an empty line
;This is the partial-sign command, designed for handling
;MAIL messages (which are delimited by partial-signs).
MSG: MOVE T,[CAIN C,"∂"] ;Delimiter of messages is a line beginning thusly
MOVEM T,MSGXCT# ;Remember which command we came from
MOVEM A,SARG ;Save number of messages to find.
TRZ F,EDITM ;We've finished with line if were editing it
MOVEI DSP,CMDSP
SETZM DREGS#
JUMPE A,MSG0B ;If he said 0∂, then just move to top of current msg
CAIN B,CTMT3 ;αβ cmd?
SETOM DREGS ;Only wants rest of paragraph, not part above arrow
SETOM NOCRLF# ;Flag CMDRD not to call CMDCRL or LSCHK
SETOM NOSTEP ;Suppress display update here if stepping macro
PUSHJ P,CMDIN ;Read command from console.
JRST POPJ2T ;Illegal command. Type out message.
MOVEM D,SDSP
EXCH A,SARG
HRLI C,(B)
MOVEM C,SCHR
MSG0B: PUSH P,A ;Save arg to ∂ command
MOVEI E,0 ;Tell PARAGR we are currently backing up
MOVE B,ARRL ;Look backwards from current line for ∂ line
MOVE D,ARRLIN
JUMPG A,.+2
SUBI A,1 ;-#∂ means # msgs BEFORE current one.
SKIPE DREGS ;Skip unless he wants only remainder of paragraph
JRST MSG0C ;Pretend arrow line is beginning of paragraph
MSG0: LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
XCT MSGXCT
JRST MSG0C ;Found delimiting line
JRST MSG0A
MSG0C: TLNN B,-1 ;Got beginning
HRLI B,(B) ;Remember line number of first beginning seen.
AOJGE A,MSG1 ;Jump if found enough beginnings
MSG0A: HLRZ D,(D) ;Back up to previous line
SKIPL TXTFLG(D) ;Backing up to pagemark?
CAIN D,PAGE ; or to beginning of page?
JRST MSG1 ;Yup
SOJA B,MSG0 ;No
MSG1: PUSH P,B ;Save <start of current msg>,,<start of range>
SKIPG A,-1(P) ;Was original arg non-positive?
JRST MSGBK ;Yes
MOVEI E,1 ;Tell PARAGR we are currently looking forward
MOVE B,ARRL ;Now look forward from line beyond current for ∂
MOVE D,ARRLIN
MSG2: SKIPL TXTFLG(D) ;Is this a pagemark?
CAIN D,BOTSTR ;Or end of page?
SOJA B,MSG5 ;Yes--did not find ending ∂. B is end of range
HRRZ D,(D) ;Next line
LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
XCT MSGXCT ;Test for proper delimiter
SOJLE A,MSG5 ;Got beginning of new msg. Jump if found enough.
AOJA B,MSG2 ;Next line
;Routine dispatched to thru MSGXCT to check for beg/end of paragraph
PARAGR: SKIPE T,TXTCNT(D) ;Get char count for this line
TRNE T,-1 ;Is this a blank line?
AOSA (P) ;Not end of paragraph
SKIPA T,(D) ;Blank line, but if preceding another, pretend not
POPJ P,
SKIPE T,TXTCNT(T) ;If blank line is end of page, include in graf
TRNN T,-1 ;Is the next line also blank?
AOS (P) ;Yes, pretend current line isn't blank
POPJ P,
MSGLUZ: SORRY No such text found.
JRST POPJ1
MSGBK: JUMPE A,MSGBK0
HLRZ B,B
SOJA B,MSG5 ;Mark end of range as before current msg
MSGBK0: HLRZ A,B ;Get start of current msg
SUB P,[2,,2] ;Re-adjust stack
SKIPN A ;Did we find the beginning of the msg
MOVE A,B ;No, only go as far as we looked (might be pagemark)
JRST SETARR ;Go there, ignoring command.
WHOLEP←←765432 ;special value used as a flag to delete page mark.
MSG5: POP P,A ;<start of current msg>,,<start of range>
SUB P,[1,,1] ;Original arg
HLRZ D,A ;Start of current msg
MOVEI A,(A) ;Start of range
HRRZ T,MSGXCT
CAIN T,"∂" ;Only the partial-sign cmd can delete pages
CAIE A,1 ;Is range the whole page?
JRST MSG6 ;No
CAMN B,LINES ;Does range end at end of page?
MOVEI B,WHOLEP ;Yes, flag that to DELLIN and ATTACH
MSG6: EXCH D,SDSP ;Restore orginal dispatch, save start of current msg
ADDI B,1 ;Make sure we get whole message, including last line
MOVEM B,SRCL ;Save number of ending line in range
CAIG B,(A) ;End of range+1 > Start of range?
JRST MSGLUZ ;No, loser loses
SETOM SRCOFF ;Found ∂ at beginning of line.
SETZM QCHR ;Just in case, avoid any substitution.
CAML A,SDSP ;Are we searching backwards?
JRST MSG7 ;No
CAME D,CRDSP ;Is this a regular CR?
TLNN D,SACMD ;No, this command use search distance as arg?
MOVEM A,SRCL ;No, make sure we get to beginning of earliest msg
SKIPE B,ATTNUM ;Anything attached?
TLNN D,MSGCMD ;Yes, do we put down attach buffer for this cmd?
JRST MSG7 ;No
ADDM B,SRCL ;Make sure we include the text we are putting down
EXCH A,SDSP ;Get beginning of current msg, save beginning of range
PUSHJ P,SETAR0 ;Get to start of current msg preserving line stack
TRZ F,ATTMOD ;No longer in attach mode
PUSHJ P,ATTEX ;Put down attach buffer
MOVE A,SDSP ;Retrieve beginning of range
MSG7: CAME D,CRDSP ;Avoid spurious "remembering" top of paragraph
PUSHJ P,SETARR ;Move to beginning of range
TLZ D,SSCMD ;No special commands here
JRST FND2A ;Now go process command
CHKMS0: SUB P,[1,,1] ;Here from DELLIN with no lines deleted--fix stack
;Come here from end of DELLIN and ATTACH to see if need to delete page mark
CHKMSG: MOVE A,SAVARG
TRNN F,REDNLY!EDDIR ;No page deleting in /R mode or on directory page
CAIE A,WHOLEP ;Did we just now delete or attach whole page's text?
POPJ P, ;No
MOVE T,CURPAG ;Yes, delete next page mark if there is one
CAMGE T,PAGES
JRST DELETE
;No next page, delete previous page mark if can
MOVE A,FIRPAG
SUB A,DIRPAG
SOJLE A,CHKMS2 ;Jump if this is the only page except the directory
PUSHJ P,WINCHK ;Fix up the window pointers so -FF will work
PUSH P,NODUPD
PUSH P,XDIRFG
PUSHJ P,UPDAT3 ;temporarily suppress directory updating
PUSHJ P,VERTB2 ;Do a -FF to get to end of previous page
POP P,XDIRFG
POP P,T ;restore previous directory updating mode but
HLLM T,NODUPD ; don't screw up RH flag, which may have changed
TRNE F,WRITE ;did VERTB2 fail to open file maybe?
POPJ P, ;yes! quit now, don't try to delete pagemark
SKIPN A,ATTLOC
JRST DELETE ;Now delete page mark (deleting last page of file)
SUBI A,1 ;Since we just attached a page's text and
HRL A,ARRL ; we are deleting that page, pretend text picked up
MOVEM A,ATTLOC ; from end of previous page.
JRST DELETE ;Now go actually delete the last (empty) page of file
CHKMS2: CAMN T,FIRPAG ;Better be only one page in core
SETOM DELFIL ;Note that all text has been deleted with ∂ command
POPJ P,
;BRPTHR BURPEX BLOAT BURP BLOAT2 BLOAT3 BLOAT4 BLOAT5 AUTOBU AUTOB3 AUTOB4 AUTOB2 STBURP UPDATE UPDAT0 UPDAT9 UPDAT2 UPDINI NOXPAG NOXREC UPDIN2 UPDAT3 UPDAT4 CHKER CHKER2
BRPTHR←←23 ;Default threshhold for automatic burping
IMPURE
BURPEX: -BRPTHR ;negative of auto burp threshold in records of nulls
;Zero or a positive number disables auto burping
PURE
BLOAT: MOVE TT,CURPAG
CAML TT,PAGES ;If last page of file is in core, don't really bloat
JRST WRPAG0 ;Just write out current page.
MOVMM A,BLOATS# ;Set up number of records to bloat page by
SETOM BLOATF# ;Flag to add some records of nulls to page
MOVN A,BLOATS ;Get negated bloat amount
SKIPGE BURPEX ;Skip if autoburp is already disabled
CAMLE A,BURPEX ;Skip if bloat amount is as big as burp threshold
JRST BLOAT2 ;Don't diddle autoburp mode
PUSHJ P,AUTOB3 ;Yes, disable autoburp and report that to user
JFCL ;AUTOB3 skips if it types out anything
JRST BLOAT2
BURP: SETOM BURPIT# ;Force rippling no matter what
BLOAT2: PUSHJ P,WRPAGH ;skip if readwrite mode and formatted file
JRST BLOAT3 ;can't write it, forget it (error msg typed)
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST BLOAT3 ;can't open file (typed error msg), don't write out
TROA F,WRITE ;Force it to ripple to discard records of nulls
BLOAT3: AOSA (P) ;don't say OK (typed error msg already), don't write out
BLOAT4: PUSHJ P,WRPAGE ;write out incore text
BLOAT5: SETZM BURPIT ;No more free rippling
SETZM BLOATS ;No more free bloating
SETZM BLOATF ;Clear bloat flag
POPJ P,
AUTOBU: JUMPE A,AUTOB4 ;Zero arg means just type out threshold
TRNE F,ARG
JRST AUTOB3 ;Some arg specified, use it
JUMPL A,AUTOB3 ;Just "-" means disable
TRNN F,REL
JRST AUTOB4 ;No arg at all, just report threshold
MOVEI A,BRPTHR ;Just + enables with default threshold
AUTOB3: PUSHJ P,STBURP ;Set auto burping threshold
SKIPL BLAB ;Skip if terse mode, no report
SKIPLE CURMAC ;Skip if not in macro
POPJ P, ;Just say OK
AUTOB4: MOVN A,BURPEX ;Get new threshold
JUMPLE A,AUTOB2
OUTSTR [ASCIZ/Auto Burp threshold is /]
SETZM TYOPNT
TYPDEC A
OUTSTR [ASCIZ/ records of nulls.
/]
JRST POPJ1
AUTOB2: OUTSTR [ASCIZ/Auto Burping is disabled. /]
JRST POPJ1
STBURP: PUSH P,BURPEX ;Remember old setting
MOVNM A,BURPEX ;Set new auto burp threshold
POP P,A ;Get back old threshold
XOR A,BURPEX ;See if it changed
JUMPGE A,CPOPJ ;Didn't change unless sign bit is different now
SKIPL BURPEX ;Skip if enabled
SKIPA A,[ASCID ⊗/-A⊗] ;Disabled--display on header line
MOVEI A,1 ;Enabled--don't say anything
MOVEM A,AFLAG ;Put into display program
SETOM NEEDHD ;set flag to think about updating hdr
POPJ P,
;Command routine to force updated directory to be written to disk if needed.
;Negative arg prevents dir updates (except when record numbers updated).
UPDATE: JUMPE A,UPDAT0 ;Zero arg reports /-U status
JUMPL A,UPDAT2 ;Negative arg disables directory updating
HRRZS T,NODUPD ;No more dir update suppressing, get RH flag
JUMPE T,CPOPJ ;Jump unless directory needs updating on disk
PUSHJ P,WRPAGI ;skip if readwrite mode and formatted file
JRST CPOPJ1 ;can't write it (error msg typed), don't say OK
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST CPOPJ1 ;can't open file (typed error msg), don't write out
HRRZS UIFLG ;Don't display " U" anymore
SETOM NEEDHD ;set flag to make HEADS think about hdr line
SETZM XDIRFG ;File no longer extended
MOVEI T,WRPAGE ;assume will write out current page (plus dir)
TRNN F,EDDIR ;if editing directory page, just write dir
TRNN F,WRITE ;If incore text hasn't changed, just output dir
MOVEI T,OUTDIR ;just write out directory
PUSHJ P,(T) ;call routine to write out right part
SETZM NODUPD ;no longer need to update directory
PUSHJ P,CLERX0 ;clear the X in hdr if dir in core (now bigger)
TLO F,DSPTRL ;may have to update trailer line
POPJ P,
UPDAT0: MOVEI TT,CPOPJ
SKIPL NODUPD
OUTSTR [ASCIZ/ Normal directory updating. /]
SKIPGE NODUPD
UPDAT9: OUTSTR [ASCIZ/ Directory updating is suppressed. /]
AOS (P) ;Suppress OK
JRST (TT)
UPDAT2: JSP TT,UPDAT9 ;Report new status
JRST UPDAT3
;Here when beginning to edit new file.
;Tell user if file has been extended.
;Set /-U switch if now editing someone else's message file.
;In /-U mode, XDIRFG to hold number of first page to omit from directory.
;LH(NODUPD) is -1 in /-U mode. RH(NODUPD) is -1 when directory needs updating.
UPDINI: HRRZS UIFLG ;In case directory not updated -- clear U flag
SETOM NEEDHD ;set flag to make HEADS think about hdr line
SKIPN A,XDIRFG ;Directory updated in core for extended file?
JRST UPDIN2 ;No
MOVNI B,1(A) ;Subtract former number of pages from new total
ADD B,PAGES ;Number of new pages added.
OUTSTR [ASCIZ/Directory in core has been updated for /]
JUMPLE B,NOXPAG ;No pages added
TYPDEC B ;Number of pages added
OUTSTR [ASCIZ/ page/]
JRST NOXREC
NOXPAG: HLRE B,A ;Negative of number of records added.
MOVM B,B ;Make it positive
TYPDEC B
OUTSTR [ASCIZ/ record/]
NOXREC: SOJE B,.+2
OUTCHR ["s"]
OUTSTR [ASCIZ/ added to file.
/]
MOVE B,XDIRFG
MOVEI B,2(B) ;Clear LH record count
MOVEM B,XDIRFG ;Remember number of first new page, for ODDSP-2
PUSHJ P,SETUFG ;Let user know on header line that dir need updating
UPDIN2: SKIPGE NODUPD ;/-U switch already on?
JRST UPDAT4 ;Yes, remember first (potential) new page
SKIPN T,EDFIL+PPN3
MOVE T,PPN ;Get alias PPN
HLRZ TT,EDFIL+1 ;Extension
CAMN T,[MSGPPN]
CAIE TT,'MSG'
POPJ P, ;Not msg file
HRRZ T,RPPN ;Own msg file is okay
HRRZ TT,EDFIL ;RH of filename
CAIN TT,(T)
POPJ P, ;RH of filename is own programmer name
HLRZ T,EDFIL ;LH of filename
IFE DECSW,<
JUMPN T,CPOPJ
>;NOT DECSW
IFN DECSW,<
CAIE T,'***' ;DEC msg files have this LH
POPJ P,
>;DECSW
;Enter here from CHKMSG when temporarily suppressing updates.
UPDAT3: HRROS NODUPD ;Default for message files is no directory updates
UPDAT4: MOVE T,PAGES
ADDI T,1
SKIPN XDIRFG ;Skip if file already marked as extended
MOVEM T,XDIRFG ;Remember number of potential first new page
POPJ P,
CHKER: JUMPE A,.+2
SKIPL BLAB ;Don't say anything in Terse mode
OUTSTR [ASCIZ/ Checking of free storage is /]
JUMPE A,CHKER2
MOVEM A,CHKFLG# ;Set flag that decides if MAIN checks FS
SKIPGE BLAB
POPJ P, ;Terse mode
OUTSTR [ASCIZ/now /]
CHKER2: SKIPGE CHKFLG
OUTSTR [ASCIZ/disabled.
/]
SKIPL CHKFLG
OUTSTR [ASCIZ/enabled.
/]
JRST POPJ1
;⊗ PROTEC PROTE0 PROTE1 PROTE2 PROTE3 PROTE4 PROTE6 PROTE5 RENAM RENAM0 RENAM2 RENAM5 RENAM3 RENAM4 RENAM6 RENAM7 RENDEV FILDEA NOFDE2 NOFDEL FILDTE FILDT2 FILDEL FILDE2
;Code to report protection and to allow it to be changed.
PROTEC: SETZM TYOPNT
MOVEI G,[ASCIZ/ /] ;G is pointer to string to type when done
OUTSTR [ASCIZ / Protection /]
PUSHJ P,XTDLMT ;skip command name delimiter
PUSHJ P,XTDLIN ;Prepare to reread extended command line
PUSHJ P,TYI
JRST PROTE5 ;Report only
TRNE F,REDNLY
JRST PROTE2 ;Do not change if in readonly
SKIPN EDFIL
JRST PROTE5 ;To prevent deletion if bug exists
MOVEI A,0
MOVEI B,3 ;number of digits
PROTE0: CAIG C,71
CAIGE C,60
JRST PROTE1 ;No, can not change after all
LSH A,3
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST PROTE4 ;Last character found
SOJG B,PROTE0
PROTE1: OUTSTR [ASCIZ /(only 3 octal digits allowed) /]
JRST PROTE5
PROTE2: MOVEI G,[ASCIZ /; cannot be changed in READONLY mode. /]
JRST PROTE5
PROTE3: OUTSTR [ASCIZ /cannot be changed/]
PUSHJ P,REOPEN ;Re-open the output channel for input
PUSHJ P,TELLO ;Oops, file changed out from under us!!!
REPEAT 0,<
MOVE T,PROTEZ ;Get old value
DPB T,[331100,,EDFIL+DATE2] ;and restore it
MOVEI D,EDFIL ;RENAME failure closed the file, so must re-open
MOVEI A,1
PUSHJ P,OPNOI ;Open for input at least
PUSHJ P,TELLZ ;Better not lose
>
TLZE F,ENTRD ;If was open in RA mode, open again in RA mode
PUSHJ P,OPENWE ;Open edit file for writing
JRST PROTE6
PROTE4: LDB T,[331100,,EDFIL+DATE2]
MOVEM T,PROTEZ# ;Save for reporting and to restore if error
MOVE T,EDFIL ;Preserve file's name
MOVEM T,LKUP ;Use the LOOKUP block for the RENAME
HLLZ T,EDFIL+EXT1
MOVEM T,LKUP+EXT1 ;Preserve Extension
SETZM LKUP+DATE2 ;Don't change date/time written or mode
MOVE T,EDFIL+PPN3
MOVEM T,LKUP+PPN3 ;Preserve PPN
DPB A,[331100,,LKUP+DATE2] ;Set new protection desired
RENAME DSKO,LKUP ;Change protection
JRST PROTE3 ;Something is wrong
DPB A,[331100,,EDFIL+DATE2] ;Success, remember new protection
OUTSTR [ASCIZ /changed to /]
MOVE T,A
PUSHJ P,OCT3ST
OUTSTR C
PROTE6: OUTSTR [ASCIZ / from /]
PUSHJ P,PROCHK ;Now see if file is protected from us
SKIPA T,PROTEZ ;Restore data for reporting
PROTE5: LDB T,[331100,,EDFIL+DATE2]
PUSHJ P,OCT3ST
OUTSTR C ;Type 3-digit octal value
OUTSTR (G) ; and appropriate message
SETZM TYIPNT ;Make sure no longer reading chars from EXTBUF
JRST PPJ1CR
;Rename file to new name given.
RENAM: SETZM TYOPNT
MOVEI G,[ASCIZ/ /] ;G is pointer to string to type when done
MOVE T,[EDFIL-1,,RUNFIL-1] ;copy current name to new name's block
BLT T,RUNFIL+PPN3 ;this makes current name the default new name
PUSHJ P,GETRUN ;Get new filename to rename to into RUNFIL
JRST RUNILL ;bad filename
HRRZ T,EDFIL+EXT1 ;fix up RH of extension word (hi date written bits)
HRRM T,RUNFIL+EXT1 ;this half word zeroed by GETRUN/FRD0
SETZM TYIPNT ;quit reading from cmd line
TLNN D,FRDALL ;any part of filename given?
JRST RUNILL ;nope, that's meaningless
MOVE T,EDFIL-1 ;make sure not trying to change device name
CAME T,RUNFIL-1 ;skip if same device
JRST RENDEV ;can't rename across devices
RENAM0: MOVE T,[RUNFIL-1,,LKUP-1] ;copy name to rename block (note that old
BLT T,LKUP+PPN3 ; date, mode, etc., are here, from EDFIL above)
RENAME DSKO,LKUP ;Change filename
JRST RENAM3 ;Something is wrong
MOVE D,[FRDRUN,,EDFIL] ;suppress switches in filename
PUSHJ P,FILTYP ;type old filename
OUTSTR [ASCIZ / renamed to /]
MOVE T,[RUNFIL,,EDFIL]
BLT T,EDFIL+PPN3 ;use new filename as name of current edit file
MOVE D,[FRDRUN,,EDFIL] ;suppress switches in filename
PUSHJ P,FILTYP ;type new filename
MOVEI D,EDFIL ;ptr to new filename
MOVNI T,ZENT ;initialize file index ptr for search
RENAM2: PUSHJ P,ZFIND2 ;see if this file's already in file list
JRST RENAM5 ;filename not in list (hit empty slot)
JRST RENAM5 ;filename not in list (list full)
CAMN T,ZINDEX ;did we find own slot in list (rename to self)?
JRST RENAM2 ;yup, ignore it and keep searching
;now have an old slot T in filelist with same name as current file's new name.
;so we flush the old slot from the list (actually from the file stack),
;fixing any saved file indexes that indicated that file,
;and (with ZFILM) move the last filename in the list into the emptied slot,
;fixing up any saved ptrs to it to point to its new slot.
;since we know the new filename didn't exist (since the RENAME succeeded),
;there can't be any (live) windows that point to this filelist entry.
;that is, unless the rename didn't change the file's name, and then there
;can't be this addition copy of the same file in the list, unless there's
;a bug somewhere (which there probably is) that lets a file get listed twice.
CAMN T,ATTFIL ;attach buffer come from this file?
SETOM ATTFIL ;yup, forget where it came from
CAMN T,ANSFIL ;subjob output going there?
SETOM ANSFIL ;yup, but not any more
MOVE A,HOMMAX ;remember how many files there used to be
PUSHJ P,HOMSA3 ;flush old file from file stack
MOVEI D,(T) ;copy of index being re-assigned
IMULI A,ZENT ;make index of last file in list
CAME A,D ;skip if entry being flushed is the last one
PUSHJ P,ZFILM ;move list entry from (A) to (D), fix everything
SETZM ZDATA(A) ;clear last list entry's filename, freeing slot
RENAM5: MOVE T,ZINDEX ;get current file's index into list of files
MOVEI TT,ZDATA(T) ;BLT dest address is entry in list of files
HRLI TT,RUNFIL ;source is place we read name into
BLT TT,ZDATA+PPN3(T) ;store new filename in list
PUSHJ P,SETHD2 ;update hdr line with new filename, force it out
JRST PPJ1CR ;print crlf and take skip return
RENAM3: MOVEI T,MACSTA ;Address of routine to stop all macros
HRRM T,MACINS ;Make macros stop for sure
PUSHJ P,ABCRLF ;back to left margin
HRRZ T,LKUP+EXT1 ;error code
CAIE T,RENEX ;already exist?
SORRF <> ;no, say SORRY
OUTSTR [ASCIZ/RENAME failed -- /]
MOVE D,[FRDRUN,,LKUP] ;ptr to rename block that failed
PUSH P,LKUP+EXT1 ;save error code
PUSHJ P,FILERR ;tell why it failed (no switches)
PUSHJ P,REOPEN ;Re-open the output channel for input
PUSHJ P,TELLO ;Oops, file changed out from under us!!!
TLZE F,ENTRD ;If was open in RA mode, open again in RA mode
PUSHJ P,OPENWE ;Open edit file for writing
POP P,T ;get back error code
MOVEI T,(T) ;just code, flush extension from left half
CAIE T,RENEX ;"file already exists" error?
JRST POPJ1 ;nope, give up
PUSHJ P,ABCRLF ;maybe output crlf
OUTSTR [ASCIZ/Type Y to replace /]
MOVE D,[FRDRUN,,RUNFIL]
PUSHJ P,FILTYP ;type name of conflicting existing file
OUTSTR [ASCIZ/? /]
PUSHJ P,YESCHK ;Get Yes or No answer
SKIPA T,[RUNFIL-1,,LKUP-1] ;said Yes, get ptr to name of file to open
JRST MACABT ;said No, give up
MOVEI C,DSKSP ;channel to open conflicting file on
PUSHJ P,OPNDEV ;open device for conflicting file, skips on failure
LKPMAC <LOOKUP DSKSP,LKUP>
JRST RENAM4 ;open failed
SETZM LKUP ;clear filename to cause delete
RENAME DSKSP,LKUP ;delete the file
JRST RENAM7 ;failed
PUSHJ P,RELDEV ;OK, release that device (C)
JRST RENAM0 ;now go try the original rename again
RENAM4: SORRF LOOKUP for replacing failed --
RENAM6: MOVE D,[FRDRUN,,RUNFIL] ;ptr to filename block
MOVE T,LKUP+EXT1 ;get error code
HRRM T,RUNFIL+EXT1 ;store for next routine
PUSHJ P,FILERR ;say why it failed
PUSHJ P,RELDEV ;release device
JRST POPJ1 ;don't say OK
RENAM7: SORRF Delete of old file failed --
JRST RENAM6 ;go say why
RENDEV: SORRY Can't RENAME across devices.
JRST POPJ1
;Here if tried to abbreviate FILDEL command.
FILDEA: SORRF ⊗XFileDelete cannot be abbreviated to less than 6 letters (⊗XFileDe)
JRST POPJ1
NOFDE2: SKIPN DELFI2 ;here from non-confirmed FileDelete cmd or neg cmd
JRST FILDT2 ;wasn't marked for deletion, still isn't
AOS (P) ;don't say OK
NOFDEL: MOVEI T,0 ;here from NEWPG1, SETWRT to avoid deleting file
EXCH T,DELFI2 ;clear file-delete flag, get old value
JUMPE T,CPOPJ ;jump if wasn't marked for deletion
OUTSTR [ASCIZ/ File NO LONGER marked for deletion. /]
POPJ P,
FILDTE: MOVEI T,[ASCIZ/File is marked for deletion. /] ;here to report status
SKIPN DELFI2 ;skip if file to be deleted
FILDT2: MOVEI T,[ASCIZ/File is NOT marked for deletion. /]
OUTSTR (T) ;tell what current state is
JRST POPJ1 ;don't say OK
;Here from command to mark the current edit file for deletion when being closed.
FILDEL: JUMPE A,FILDTE ;zero arg means tell if marked for deletion
SETZM DELFIL ;clear ∂D file deletion flag
JUMPL A,NOFDE2 ;negative arg means just clear the delete flags
MOVE T,EDFIL+DATE2 ;get file's protection
TLNN T,200000 ;check for delete protection
JRST FILDE2 ;not delete protected
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/File is delete-protected -- /]
MOVE D,[FRDRUN,,EDFIL]
PUSHJ P,FILTYP ;type filename
OUTSTR [ASCIZ/ -- type Y to delete it anyway? /]
PUSHJ P,YESCHK ;read Yes or No answer
FILDE2: SKIPA T,EDFIL ;said Yes, get file name
JRST NOFDE2 ;said No, tell current state
MOVSM T,DELFI2 ;set explicit-file-delete flag
SETZM DELFI3 ;clear /Q switch for now
SKIPGE BLAB ;skip unless terse mode
POPJ P, ;just say OK
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/File /]
MOVE D,[FRDRUN,,EDFIL]
PUSHJ P,FILTYP ;type filename
OUTSTR [ASCIZ/ is marked for deletion. /]
JRST POPJ1
;⊗ MAIFIL MAIPPN MAIFLG MAISWP DFISWP DFIND SEND TEST MAIL REMIND DFIND2 MAILUP MAILU2 MAIABT MAILUZ CHKDSK CHKDER DFIJOB DFILU2 DFIJOK DFILUZ
IMPURE
0 ;For FILERR
'DSK ' ;For FILERR
MAIFIL: 'E$MAIL'
'TMP '
0
MAIPPN: 0 ;Will put login PPN here
0 ;For FILERR
MAIFLG: 0 ;Flag: -1 if from MAIL, 0 if from SPOOL, positive if DFIND
PURE ;move this above MAISWP if you flust TEST cmd, move below if TEST exists
MAISWP: 'SYS '
'MAIL '
'DMP',,14
0,,1 ;RPG startup
0
0
DFISWP: 'SYS '
'FIND '
'DMP',,14
0,,1 ;RPG startup
0
0
DFIND: HRRZM P,MAIFLG ;Flag DFIND cmd w/positive value in this cell
TRO F,ARG ;Pretend arg is 1 line
MOVEI A,1 ;Always pass one line of text for DFIND command
JRST DFIND2
;SEND command not allowed to send whole page any more--too many accidents.
SEND: TRNE F,ARG!ATTMOD ;⊗XSEND must have an argument unless attach mode
JRST MAIL ;argument given, or attach mode
SORRF ⊗XSEND requires argument specifying number of lines to SEND.
JRST POPJ1
repeat 0,< ;disabled until needed again (TEST is sometimes not a MAIL program)
;Test command is like mail, but uses test mailer.
;[If you flush this, move the PURE line to before MAISWP.]
TEST: PUSH P,MAISWP+1
MOVE T,['TEST ']
MOVEM T,MAISWP+1
PUSHJ P,MAIL
SOS -1(P)
POP P,MAISWP+1
JRST POPJ1
>;repeat 0
MAIL:
REMIND: SETOM MAIFLG ;Flag not to start spooler, skip leading empty lines
DFIND2: MOVEM A,SPLNBR ;Save number of lines of text to mail
PUSHJ P,CHKDSK ;make sure logical device DSK is physical DSK
JRST PPJ1CR ;failed with error msg, no OK
OPEN DSKSP,[DMPMOD↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,RPPN
MOVEM T,MAIPPN
SETZM MAIFIL+2 ;Zero protection field
ENTER DSKSP,MAIFIL
JRST MAILUZ
PUSHJ P,MAIOUT ;Use spooler output routine to write file
JRST MAIABT ;user is aborting cmd, flush file and return
MOVE 14,MAIFIL
HLLZ 13,MAIFIL+1
SETO 12,
IFE DECSW,<
GETLIN 12 ;Pass our TTY number to MAIL
>
IFN DECSW,<
GETLCH 12
>
HRLI 12,'RET' ;Tell MAIL to return error msg on failure
MOVE 11,RPPN
SKIPLE MAIFLG ;Skip unless DFIND cmd
JRST DFIJOB ;Start up DFIND job
IFE DECSW,< ;FIX THIS SOMEDAY
MOVE T,['ZORRO!']
MOVEM T,MAILBK ;Flag for MAIL-E debugger
MOVEI T,MAILBK+1
BLT T,MAILBK+20 ;Put the ACs into buffer for interjob mail
SKPSEN ['MAIL-E'↔MAILBK] ;Send mail to MAIL-E debugger
CAIA ;Mailbox full
JRST POPJ1 ;Success
JFCL ;Non ex name or number or ambiguous name
MOVEI T,MAISWP ;No MAIL-E debugger, start up MAIL on another job
SWAP T,
JUMPN T,POPJ1 ;Success
OPEN DSKSP,[DMPMOD↔'DSK '↔0] ;No job slots, try to rename to .FTP
PUSHJ P,TELLZ
MOVEI T,10 ;Number of different files we'll try on RMD,SYS
MOVS A,MAIFIL ;First find a non-ex filename on RMD,SYS
HRL A,RPPN ;Stick our programmer name in LH of filename
MOVSI B,'FTP'
MAILUP: MOVE TT,RPPN
MOVEM TT,MAIPPN
LOOKUP DSKSP,MAIFIL ;Find the file we just wrote
JRST MAILU2 ;Huh? Oh well, I give up
SETZ C, ;Protection of zero
MOVE D,[RMDSYS] ;PPN where remind phantom lives
RENAME DSKSP,A ;Here we go folks, give file to remind phantom
AOJA A,[MOVEI TT,(B) ;Try new filename -- first check error code
CAIN TT,4 ;Does new filename already exist?
SOJG T,MAILUP ;Yes, try again with different filename
JRST MAILU2] ;Give up after enough tries or if funny error code
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/No job slots for MAIL -- message queued for later delivery.
/]
RELEAS DSKSP,
SETZM JOBJDA+DSKSP
MOVEI T,['<RMND>'↔RMDSYS↔0] ;Wake up remind phantom to read FTP file
WAKEME T, ;Good luck, there were no job slots a sec ago!
JFCL ;Who cares if it fails.
JRST POPJ1
>;NOT DECSW
;DECSW falls thru into MAILU2
MAILU2: RELEAS DSKSP,
SETZM JOBJDA+DSKSP
SORRJ File
MOVE T,RPPN
MOVEM T,MAIPPN
MOVE D,[FRDRUN,,MAIFIL] ;For typing filename without switches
PUSHJ P,FILTYP ;Type name of file we wrote
IFE DECSW,<
OUTSTR [ASCIZ/ written but message will not be delivered
because no job slot for MAIL and queueing attempt failed.
/]
>
IFN DECSW,<
OUTSTR [ASCIZ/ written but message will not be delivered.
/]
>
JRST POPJ1
;Here to abort mail cmd. Flush the file we were writing.
MAIABT:
IFE DECSW,<
RELEAS DSKSP,1 ;Inhibit closing this open file
>
IFN DECSW,<
CLOSE DSKSP,40 ;Inhibit deletion of old version
RELEAS DSKSP,
>
SETZM JOBJDA+DSKSP
JRST POPJ1 ;Don't say OK (already said aborted)
MAILUZ: RELEAS DSKSP,
SETZM JOBJDA+DSKSP
SKIPG MAIFLG
SORRJ Cannot deliver message:
SKIPLE MAIFLG
SORRJ Cannot pass command to DFIND:
MOVE D,[FRDRUN,,MAIFIL] ;For typing filename without switches
PUSHJ P,FILERR ;Tell why ENTER lost
JRST PPJ1CR
;Skip if physical device DSK is available as DSK.
CHKDSK: MOVSI T,'DSK'
PNAME T, ;turn logical device name to physical device name
JRST CHKDER ;failed?
CAMN T,['DSK '] ;right device available for passing file to program?
JRST POPJ1
CHKDER: SORRY Can't do that with non-DSK device assigned as logical device DSK.
POPJ P,
DFIJOB: MOVEI T,DFISWP ;Start up DFIND job
SWAP T,
JUMPN T,DFIJOK ;Success
OPEN DSKSP,[DMPMOD↔'DSK '↔0] ;No job slots, flush file we wrote
PUSHJ P,TELLZ
MOVE TT,RPPN
MOVEM TT,MAIPPN
LOOKUP DSKSP,MAIFIL ;Find the file we just wrote
JRST DFILUZ ;Huh? Oh well, I give up
RENAME DSKSP,[0↔0↔0↔0] ;Delete file
JRST DFILUZ ;Huh
SORRY No job slots for DFIND job right now.
DFILU2: RELEAS DSKSP,
SETZM JOBJDA+DSKSP
JRST POPJ1
DFIJOK: OUTSTR [ASCIZ/ DFIND started OK... /]
JRST POPJ1
DFILUZ: SORRX <No job slots for DFIND (and failed to delete >
JRST DFILU2 ;Suppressing error message
MOVE D,[FRDRUN,,MAIFIL] ;For typing filename without switches
PUSHJ P,FILTYP ;Type filename
OUTSTR [ASCIZ/ file).
/]
JRST DFILU2
;⊗ ALIAS ALIAS0 ALIASE ALIAS4 ALIAS2 ALIAS3 ALIAS5 ALIAS6 PP0TYP SETHD3 SETHD2 SETHED SETHD0
;Routine to set alias (disk ppn).
ALIAS: TRNN F,ARG!REL ;any numeric arg?
JRST ALIAS0 ;no
MOVM A,A ;negative arg means same as positive arg
CAMLE A,HOMMAX ;Range check index
JRST ALIASE ;out of range
SKIPE A ;skip if referencing current file
SKIPA A,HOMPLC-1(A) ;get index of file of interest
MOVE A,ZINDEX ;index of current file
SKIPN K,ZDATA+PPN3(A) ;get PPN of file (should never be zero)
ALIAS0: MOVE K,RPPN ;default PPN is login PPN if no numeric arg
PUSHJ P,XTDLIN ;Prepare to reread extended command line
PUSHJ P,GETP ;Get project
JUMPN A,ALIAS2
MOVE A,K ;use default PPN
JRST ALIAS5
ALIASE: SORRY No such file-stack entry.
JRST POPJ1
ALIAS4: SETZM TYIPNT
SORRY Syntax error.
JRST POPJ1
ALIAS2: PUSH P,A ;Save project
HRRZ A,K ;maybe use default programmer name
CAIE C,","
JRST ALIAS3
PUSHJ P,GETP ;Get programmer
JUMPN A,ALIAS3
HRRZ A,PPN ;use old alias programmer name if ","
ALIAS3: POP P,B
HRL A,B ;Include project
ALIAS5: CAIE C,15
JRST ALIAS4
TLNE A,-1
TRNN A,-1
JRST ALIAS4
MOVE E,PPN ;remember old alias
MOVEM A,PPN ;Save new alias
IFE DECSW,<
DSKPPN A, ;Set alias
>
IFN DECSW,<
CHGPPN A,
JFCL
>
MOVE A,[ASCII/Alias/]
MOVEM A,BUF
MOVE A,[ASCII/ /]
MOVEM A,BUF+1
MOVE A,[POINT 7,BUF+1,6]
MOVEM A,TYOPNT
IFN IRCSW,<
MOVE A,PPN
PUSHJ P,PPNTYO
>;IRCSW
IFE IRCSW,<
HLLZ A,PPN
PUSHJ P,PNTYO ;Project to ASCII
TYPCHR ","
HRLZ A,PPN
PUSHJ P,PNTYO ;Programmer to ASCII
>;NOT IRCSW
PUSHJ P,PP0TYP ;type BUF out on PP#0 and current PP, w/CRLF
AOS (P) ;Don't say OK, but fall into SETHED
CAMN E,PPN ;did alias change?
POPJ P, ;no, no hdr output needed
MOVEI Q,WINDAT ;ptr to current window
ALIAS6: MOVE A,PPN
CAME A,EDFIL+PPN3-WINDAT(Q) ;this file on new alias area?
CAMN E,EDFIL+PPN3-WINDAT(Q) ;or old alias area?
PUSHJ P,SETHD3 ;yes, must update filename in header line
CAIN Q,WINDAT
MOVEI Q,WINHED
HRRZ Q,(Q) ;next window
CAIE Q,WINHED ;end of list?
JRST ALIAS6 ;no
POPJ P, ;yes
PP0TYP: TYPCHR "
" ;output CRLF (into BUF)
SETZ A,
IDPB A,TYOPNT ;terminate output string with null
SETO A,
GETLIN A
MOVEI T,(A) ;get our line number
MOVEI TT,BUF
MOVEI A,T
TTYMES A, ;This way, the string appears on PP 0, seen after exit
JFCL ;They say this can't happen
POPJ P,
SETHD3: MOVEI D,(Q) ;ptr to window to update filename in hdr of
PUSHJ P,SETHD0 ;update filename text
CAIN Q,WINDAT ;current window?
JRST DSHED ;yes, force hdr out this way
SETOM NEEDHD-WINDAT(Q) ;no, force hdr to be considered
SETOM SOMOD2-WINDAT(Q) ;and this will force hdr out for this window
SKIPE DPY ;Don't cause spurious retyping of line on non-dpy
TRO F,DSPSCR ;make DISP think about updating text
POPJ P,
SETHD2: PUSHJ P,DSHED ;Force redisplay of header line
SETHED: MOVEI A,<BYTE(7),,,"/","R"(1)1>
TRNN F,REDNLY ;Skip if in readonly mode
MOVEI A,1
IFN BOOKMD, <
SKIPE BOOKSW
MOVEI A,<BYTE(7),,,"/","B"(1)1>
>;END BOOKMD
MOVEM A,ROFLG
MOVEI D,WINDAT ;diddling hdr of current window
;now update filename text in hdr
SETHD0: MOVE A,[ASCID / /]
MOVEM A,HEDNAM-WINDAT(D)
HRRZM A,HEDNAM+1-WINDAT(D)
MOVE A,[HEDNAM+1-WINDAT,,HEDNAM+2-WINDAT]
HRLI D,(D) ;duplicate window ptr in LH
ADD A,D ;relocate within given window
BLT A,ROFLG-1-WINDAT(D) ;clear name text to nulls (low bit on each word)
MOVE A,[260700,,HEDNAM-WINDAT]
ADDI A,(D) ;relocate to given window
MOVEM A,TYOPNT
PUSH P,D
MOVEI D,EDFIL-WINDAT(D) ;get ptr to filename block
PUSHJ P,FILSTR ;Output filename including any /F or /N switch
MOVE A,[HEDNAM-WINDAT,,HED2NM-WINDAT]
POP P,D
ADD A,D ;relocate to within given window
BLT A,ROFLG2-WINDAT(D) ;duplicate filename in other version of hdr
POPJ P,
;⊗ SAVFIL SAVERR REENT SAVE1 SAVE0 SAVE0M SAVWIN SAVE3 SAVE2 SAVEX SPLSTR SPLST2
IMPURE
0 ;For FILERR (/F)
'DSK ' ;For FILERR
SAVFIL: 'E$SAVE'
'TXT '
0↔0
0 ;For FILERR (/N)
PURE
SAVERR: OUTSTR [ASCIZ/ENTER failed--/]
MOVE D,[FRDRUN,,SAVFIL] ;For typing filename without switches
PUSHJ P,FILERR ;Tell how/why he lost
JRST SAVEX
REENT: MOVE P,[-LPDL+1,,PDL] ;Set up a stack
DPYCLR ;Make sure he sees our message
PUSHJ P,SAVE0 ;Save incore text on reentry
PUSHJ P,REEDET ;detach any PTY subjobs
EXIT 1,
JRST REENT
;This is the routine for the ⊗XSAVE command.
SAVE1: AOS (P) ;Suppress OK
;Called here from various fatal errors.
SAVE0: MOVEI T,MAINTMODE ;see if we're in maintenance mode
PEEK T, ;get addr of cell
PEEK T, ;get value of flag
JUMPE T,SAVE0M ;jump if not maint mode
DPYCLR ;maintenance mode, get confirmation from user
OUTSTR [ASCIZ/
System is in maintenance mode. Do you want incore text saved in an
emergency file written on the disk? If so, type CONTINUE.
/]
JRST 4,SAVE0M ;halt and let user decide
SAVE0M: MOVE T,RPPN
MOVEM T,SAVFIL+PPN3
SETZM SAVFIL+DATE2
HLLZS SAVFIL+EXT1
OPEN DSKSP,[DMPMOD↔'DSK '↔0]
PUSHJ P,TELLZ
ENTER DSKSP,SAVFIL
JRST SAVERR
SETZM EXAFLG ;Non-formatted output
PUSHJ P,SPLINI ;Initialize output buffer
MOVN B,OCNT
MOVSI B,(B)
SETZM SPLNBR
PUSH P,Q
MOVEI Q,WINDAT ;start with current window, then get rest
;now loop through all the windows, saving each one's text in the emergency file
;we output non-current windows right from where they sit in FS somewhere.
SAVWIN: MOVE D,[POINT 7,TOPSTR+LLDESC-WINDAT(Q)]
PUSHJ P,XWRLUP ;Put out top star line
MOVEI A,PAGE-WINDAT(Q)
SETO T, ;In case no attach buffer
CAIN Q,WINDAT ;only show attach buffer with current window
TRNN F,ATTMOD
JRST SAVE2 ;No attach buffer to output
MOVE T,ARRL-WINDAT(Q)
SOJLE T,SAVE3
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines before attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
SAVE3: MOVEI TT,=24
MOVEI T,[ASCIZ/ Attach Buffer /]
PUSHJ P,SPLSTR
MOVE T,ATTNUM
MOVEM T,SPLNBR
MOVEI A,ATTBUF
PUSHJ P,XWRLIN ;Put out attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVEI TT,=22
MOVEI T,[ASCIZ/ End Attach Buffer /]
PUSHJ P,SPLSTR
MOVEI A,ARRLIN-WINDAT(Q)
MOVN T,ARRL-WINDAT(Q)
SAVE2: ADD T,LINES-WINDAT(Q)
ADDI T,1 ;Include arrow line
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines after attach buffer
MOVE D,[POINT 7,BOTSTR+LLDESC-WINDAT(Q)]
SETZM SPLNBR
PUSHJ P,XWRLUP ;Put out bottom stars
CAIN Q,WINDAT ;just finish current window?
MOVEI Q,WINHED ;yes, this is where ptr to next is
HRRZ Q,(Q) ;get ptr to next window
CAIE Q,WINHED ;back to list header?
JRST SAVWIN ;nope, save another window
;now we've done all the windows
POP P,Q
PUSHJ P,XWRDON
OUTSTR [ASCIZ/File written: /]
MOVE T,RPPN
MOVEM T,SAVFIL+PPN3
MOVE D,[FRDRUN,,SAVFIL]
PUSHJ P,FILTYP ;Type filename without switches
SAVEX: OUTSTR [ASCIZ/
/]
JRST TMPWRT ;Now write out TMPCOR file, maybe
;Routine to put out header or trailer line with surrounding stars
SPLSTR: PUSH P,TT ;Count of number of stars before & after
PUSHJ P,SPLST2 ;Put out some stars
TLOA T,440700 ;Make byte pointer to header text
IDPB C,G
ILDB C,T
JUMPN C,.-2
POP P,TT
PUSHJ P,SPLST2
MOVEI C,15
IDPB C,G
MOVEI C,12
IDPB C,G
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
POPJ P,
SPLST2: JUMPLE TT,CPOPJ ;Return if no stars wanted
MOVEI C,"*"
IDPB C,G
SOJG TT,.-1
POPJ P,
;LBLERR LBLSRC LBLSR2 LBLOOP LBLFND
LBLERR: PUSHJ P,OLDFL0 ;Flush arrow line from line stack
MOVEI T,[ASCIZ /Label not found on page indicated by directory --/]
JRST FNDER2
;Here from SDSCHK because SSCMD bit is on for command that terminates the
;search string. Search the directory and go to indicated page.
LBLSRC: SETZM ESCIEN
MOVE D,T ;Copy search flags
ANDI D,SDELIM ;Only flag of interest later
MOVEM D,LBLFOO ;Save delimiter flag and flag from label search
SETZM INCORE# ;Assume will be changing to new page not in core
JRST DIRSR2 ;Use most of old directory searching routine
;Here after getting to page indicated by directory
LBLSR2: EXCH F,SRFLG
SETOM SRCOFF ;No search string found yet.
MOVE T,ARRL
MOVEM T,SRCL
MOVE T,ARRLIN
MOVEM T,SRCLIN ;Start search from arrow line
LBLOOP: MOVEI TT,1
MOVEM TT,SRCN1 ;Find search string once
PUSHJ P,FINSE2 ;Store search count (TT) for RDV
PUSHJ P,SRCLBL ;Like SRCPAG, but searches from SRCLIN
JRST LBLERR ;Not found
SKIPN LBLFOO# ;Delimited search?
IBP SAVEBP ;No, advance to char after string
LDB T,SAVEBP# ;Get char after string
CAIN T,":"
JRST LBLFND ;Eureka!!
CAIE T,"="
CAIN T,"←"
JRST LBLFND ;Eureka!!
PUSHJ P,SPFIN ;Set up SRCOFF and SRCNUM for continuing
MOVE F,LBLFOO ;Restore SDELIM flag--only flag needed
SKIPN ESCIEN
JRST LBLOOP
PUSHJ P,MACSTP ;Terminate macro expansion
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /ESC I interruption while searching found page for label -- /]
PUSHJ P,OLDFL0 ;Flush arrow line from line stack
JRST FNDER5
LBLFND: MOVE T,SCHR
TLNN T,2 ;Skip if META bit
JRST DIRFND
SETOM FNDUP ;For CONTROL-META, position line at top of window
SKIPN INCORE ;Skip if label found in core
SETOM BOTWIN ;Force window to be set up by SETJMP
JRST DIRFND ;(FNDUP is tested in SETJMP, called from FNDMOV)
;HEIGHT HEIGH7 HEIGH8 HEIGH4 TOPPER SCOUNT SDEFLT SMINIM SSTORE SWINDW BOTTER ATTTER ATTSET GSCBTM GSCBT2 BOTFIX BOTSET TOPSE2 ATTSE2 TOPSET CHKHG0 CHKHG2 CHKHG3 CHKHGH CHKHGY CHKHGX RAISEW
;Command routine w/arg as number of lines to be used to display text.
HEIGHT: SKIPN T,DPY
POPJ P,
TRNE F,REL ;relative arg?
ADD A,NLINER ;yes, adjust previous text size by amt requested
TRNN F,ARG!REL ;skip if explicit size given
MOVEI A,-1 ;no arg, use max size screen
CAIGE A,TXTMIN+ATTMXM ;is it at least minimum window size?
MOVEI A,TXTMIN+ATTMXM ;no, use minimum size
SUB A,NLINER ;figure increase in window size
JUMPE A,CPOPJ ;jump if no change
JUMPL A,HEIGH7 ;jump if decreasing window size
MOVE T,SCRLOW ;figure max increase in window w/o moving PP,
SUB T,SCRBOT ; which is this amt of moving down to PP
CAMG A,T ;is that enough?
JRST HEIGH8 ;yes, just diddle SCRBOT and NLINEU
ADD T,PPIGN ;no, see if we can move the PP down for more room
CAMLE A,T ;is increase within this limit?
MOVE A,T ;no, limit it
JUMPE A,CPOPJ ;jump if no increase possible
SUB T,A ;make T be amt of unused-up PPIGN
MOVEM T,PPIGN ;set new number of unused lines after PP
JRST HEIGH8 ;now go adjust window size by amt in A
;here if requesting a decrease in window size, by negative amt indicated in A.
HEIGH7: PUSHJ P,GSCBTM ;get max SCRBOT among all other live windows (TT)
SUB TT,SCRLOW ;make negative max amt PP can move up
CAMGE TT,A ;does PP want to move up more than can?
MOVE TT,A ;no, adjust PP by amt desired?
MOVN TT,TT ;make it positive, to move PP up
ADDM TT,PPIGN ;move PP up as much as possible
HEIGH8: ADDM A,SCRBOT ;adjust bottom of window up or down
ADD A,NLINER ;adjust window size up or down too
MOVEM A,NLINEU ;store new display area size
PUSH P,TOPWIN ;try to preserve first line in window
;Enter here from TOPSET/BOTSET, as well as from HEIGHT. Fix up window.
HEIGH4: MOVE TT,DPYHGT ;get screen height
SUB TT,PPSIZ ;calculate new PP position (hgt-size-ignored below)
SUB TT,PPIGN ;this gives new PP position
MOVEM TT,NWIPE ;store starting line number of erase
SUB TT,PPPOS ;erase text lines between old and new PP position
HRLM TT,NWIPE ;this is negative number of lines to erase
PUSHJ P,WIPE ;erase lines if moved PP up (nothing if moved down)
SKIPE DDACT ;skip if erase done already
DPYOUT [0↔0] ;wait for erase lest it erase new PP
TRO F,DSPSCR ;Force redrawing of lines that may move
PUSHJ P,DPYCHG ;Set up new screen parameters (clears NWIPE)
POP P,A ;desired old TOPWIN value (possibly adjusted)
JRST SETWIN ;Try to preserve old window top
;Table of special things to handle when changing SCRTOP
TOPPER: PHASE 0
SCOUNT::SCRTOP ;Address of current count
SDEFLT::SCRTPD ;Default number of lines
SMINIM::0 ;Minimum number of lines
SSTORE::MOVEM A,NLINEU ;store new text size at end of change calculation
SWINDW::ADDM TT,(P) ;fix window top instead of blank line count
DEPHASE
;Table parallel to TOPPER above but for use when changing PPSIZ
BOTTER: BOTTOT ;Address of current count
PPSIZD ;Default number of lines
PPMIN ;Minimum number of lines
MOVEM A,NLINEU ;Special instruction at end of change calculation
PUSHJ P,BOTFIX ;fix PPSIZ and SCRBOT
;Table parallel to TOPPER/BOTTER above, but for use when changing ATTMAX
ATTTER: ATTMAD ;Address of desired count
ATTMXD ;Default value
ATTMXM ;Minimum value
JRST ATTSXT ;Special instruction jumps out of common routine
;The one remaining possible entry of ATTTER table is never referenced.
ATTSET: MOVEI B,ATTTER ;Address of special things when diddling ATTMAX
JRST ATTSE2
;Load TT with bigest SCRBOT of all live but unselected windows.
GSCBTM: MOVEI T,WINHED ;look through all live windows to set max PPSIZ
MOVEI TT,0 ;initial max SCRBOT (max SCRBOT implies max PPSIZ)
GSCBT2: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of window list?
POPJ P, ;yes
SKIPGE WINNBR-WINDAT(T) ;is this a closed window?
JRST GSCBT2 ;yes, ignore it
CAMGE TT,SCRBOT-WINDAT(T) ;this window have bigger SCRBOT?
MOVE TT,SCRBOT-WINDAT(T) ;yes, save it
JRST GSCBT2
;Split lines allocated below window between PP and area from PP to bottom of window.
BOTFIX: MOVE T,BOTTOT ;get new nbr of lines below window
CAMLE T,PPSIZM ;can page printer be this big?
MOVE T,PPSIZM ;no, use max size for PP
MOVEM T,PPSIZ ;store new PP size
MOVN TT,TT ;make decrease in text cause SCRBOT to move up
ADDM TT,SCRBOT ;adjust bottom of window up or down
POPJ P,
;Set position of end of window. (Give excess lines to page printer.)
BOTSET: PUSHJ P,GSCBTM ;get max SCRBOT among all other live windows (TT)
SUB TT,SCRLOW ;biggest SCRBOT-SCRLOW is most PPSIZ can increase
SUB TT,PPSIZ ;this makes biggest PPSIZ we can allow right now
MOVNM TT,PPSIZM# ;save positive max PPSIZ for code below
MOVE T,SCRLOW ;set up current number of lines unused at bottom
SUB T,SCRBOT ;this gives amt used by windows below
ADD T,PPSIZ ;plus size of page printer gives answer
MOVEM T,BOTTOT# ;save for adjustment calculations below
SKIPA B,[BOTTER] ;Addr of special things when diddling PPSIZ/SCRBOT
TOPSE2: MOVEI B,TOPPER ;Address of special things when diddling SCRTOP
ATTSE2: SKIPN T,DPY
POPJ P, ;Not a display
TRNN F,ARG!REL ;Without arg, this command resets to default
MOVE A,SDEFLT(B) ;Use default size
TRNE F,REL
ADD A,@SCOUNT(B) ;Relative to old amount
CAMGE A,SMINIM(B)
MOVE A,SMINIM(B) ;Can't be less than minimum number of lines
SUB A,@SCOUNT(B) ;Figure increase in number of lines in area
JUMPE A,CPOPJ ;No change requested
MOVE TT,NLINER ;Number of text display lines being used now
SUBM TT,A ;Take/give lines from display text to area
SUBI A,TXTMIN
CAMGE A,ATTTER+SMINIM
MOVE A,ATTTER+SMINIM ;Always leave at least this much space for att buf
ADDI A,TXTMIN
SUB TT,A ;Figure decrease in display text size
ADDM TT,@SCOUNT(B) ;Decrease in text is increase in the area size
JUMPE TT,CPOPJ ;No change is possible
XCT SSTORE(B) ;Maybe store new display text size, or go to ATTSXT
PUSH P,TOPWIN ;Current window
XCT SWINDW(B) ;adjust window or fix blank line count
JRST HEIGH4
;Command routines to set number of lines of screen above/below E's main display.
TOPSET: PUSH P,SCRTOP ;remember where we were
AOS -1(P) ;assume skip return
PUSHJ P,TOPSE2 ;set new top of screen
SOS -1(P) ;direct return after all
POP P,T ;get old top-of-window position
;enter here from CLSWIN to think about SCRHGH
CHKHG0: MOVE TT,SCRTOP ;get new top position
CAMGE TT,SCRHGH ;is this now the highest window?
JRST CHKHGY ;yes, remember top used line of screen
CAMGE T,TT ;skip if window didn't move its top down
CAMLE T,SCRHGH ;moved down, was this the top window on screen?
POPJ P, ;SCRHGH is still valid
MOVEI T,WINHED ;window list hdr location
CHKHG2: MOVEM TT,SCRHGH ;smallest SCRTOP of windows checked so far
CHKHG3: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
JRST CHKHGX ;yup
MOVE TT,SCRTOP-WINDAT(T) ;see where this extra window is
SKIPL WINNBR-WINDAT(T) ;skip if this is a closed window--ignore it
CAML TT,SCRHGH ;highest so far?
JRST CHKHG3 ;no
JRST CHKHG2 ;yes
;here after resurrecting previously closed window--see if SCRHGH needs fixing
;here also from SETSCR. Clobbers only T,TT.
CHKHGH: MOVE TT,SCRTOP ;get new top position
CAML TT,SCRHGH ;is this now the highest window?
POPJ P, ;no
CHKHGY: MOVEM TT,SCRHGH# ;yes, remember top used line of screen
;anyone changing SCRHGH must call this routine to turn wholine off/on and fix HGHWRD
CHKHGX: PUSH P,G
MOVE G,SCRHGH ;new top line of screen
MOVEI T,WHOON
CAIGE G,2 ;Turn off wholine iff using top lines for text
MOVEI T,WHOOFF
PUSHJ P,(T) ;Maybe turn wholine on or off (clobbers TT)
PUSHJ P,PCOMP ;calculate position word (uses G)
MOVEM T,HGHWRD# ;save for display routine
POP P,G
POPJ P,
;Cmd routine to raise current window n lines.
RAISEW: PUSH P,TOPWIN ;remember where window starts, to preserve that
PUSH P,A ;remember arg
MOVN A,A ;positive arg becomes negative adjustment to top
TRO F,ARG!REL ;pretend user gave relative arg to next routine
PUSHJ P,TOPSET ;adjust top of window up or down
JFCL ;cmd routine may skip?
POP P,A ;get back arg, positive arg is positive bot adj
PUSHJ P,BOTSET ;adjust bottom of window up or down
JFCL ;cmd routine may skip?
POP P,A ;get back original top line of window
JRST SETWIN ;try to use it as top line of new window
;REQWIN REQWER REQWE0 REQSML REQWI2 REQWI3 REQWI4 REQWI5 MAKWCK MAKWOO MAKWO4 MAKWOV ADDWIN FNOWCK FNOWCL FNOWC2 ABTWIN ABTWI0 ABTWI2 ABTWI3
;Immediate command routine to request a new window. Sets flag indicating that
;any file switching cmd seen as next cmd should create a new window.
REQWIN: MOVE T,NWINS# ;see if we can increase number of windows
ADDI T,1
CAIL T,MAXWNS ;would it be too many windows?
JRST REQWER ;yes, give error msg
SETZM FNOWIN#
CAIE B,CTMT3 ;αβπ means new window for sure
SETOM FNOWIN ;απ -- if file open in old window, select old window
MOVE T,NCMDS ;flag to file routines that want new window
MOVEM T,WANTWN# ; if file switching cmd seen right away
MOVEM F,WANTWF# ;remember flag bits for arg
TRNN F,ARG!REL ;skip if want to split current window
JRST REQWI5 ;new window will be same place and size as current
;will create new window in top or bottom half of current window, which shrinks
MOVE T,NLINER ;number of text lines in current window
LSH T,-1 ;divide by two to get default size of new window
JUMPE A,REQWI3 ;zero arg means half window (default size)
TRNN F,REL ;relative arg means add that much to default
JRST REQWI2 ;not relative
TRNE F,NEG ;negate arg if so requested
MOVN A,A
ADD A,T ;add amount desired
JRST REQWI4 ;try this size window
REQWER: JSP D,ERRX ;return quickly and set up dispatch to error msg
REQWE0: SORRF Can't have more live windows.
JRST POPJ1
REQSML: JSP D,ERRX ;return quickly and set up dispatch to error msg
SORRF Old or new window would be too small.
JRST POPJ1
REQWI2: TRNN F,ARG ;arg specified means use that size window
REQWI3: MOVE A,T ;no arg, use default size
REQWI4: CAIGE A,TXTMIN+ATTMXM ;this is minimum size for any window
MOVEI A,TXTMIN+ATTMXM ;use min txt size plus min max-att-buf-display size
MOVE T,NLINER ;original size of window we taking from
CAIGE T,2*<TXTMIN+ATTMXM>+1 ;must have room for new hdr and 2 windows
JRST REQSML ;not enough room
SUBI T,TXTMIN+ATTMXM+1(A) ;excess amt remaining in old window
JUMPGE T,.+2 ;jump if enough left in old window
ADD A,T ;reduce new window size by extra needed left in old
MOVEM A,WANTWA# ;remember size for new window
REQWI5: TRZ F,ARG!REL!NEG ;start collecting arg for (presumed) file cmd
MOVEI A,0 ;no arg seen yet
JRST CMDLUP ;read next command
;Subroutine for file-switching commands to check if new window requested.
;If so, this routine makes the new window with the size and position requested.
;If not making a new window, ZSAVE is called to close out the current file.
;MAKWCK skips unless ZSAVE can't open current file to write it out: we jump to
;ZSAVE and let it skip if successful or take direct return if can't open file.
MAKWCK: MOVE TT,NCMDS ;see if just gave new-window cmd
CAME TT,WANTWN ;skip if new window requested
JRST ZSAVE ;no new window, close out current file
AOS (P) ;skip return to indicate success
PUSHJ P,ADDWIN ;add a new window, if can (else fatal error)
MOVE TT,WANTWF ;get window cmd's flags
TRNE TT,ARG!REL ;argument means wants new file in new smaller window
JRST MAKWOO ;create new window out of old
;create new window exactly where current one is.
PUSH P,NLINER ;copy number of lines of text in window
PUSH P,SCRTOP ;copy number of top line in window
PUSH P,SCRBOT ;copy number of trlr line for window
JRST MAKWOV ;create new window exactly over old one
;creating window out of piece of old one, reducing size of old one
MAKWOO: AOS A,WANTWA ;make size of new window w/new header line
MOVE T,BOTWIN ;line number of bottom of window
SUB T,TOPWIN ;minus number at top of window is size of window
LSH T,-1 ;divided by two
ADD T,TOPWIN ;plus top give middle (approx.)
SUB T,ARRL ;compare with arrow position
PUSH P,A ;remember size of new window (including its hdr line)
SOS (P) ;forget hdr line, make it text lines in window
JUMPL T,MAKWO4 ;jump if arrow near bottom, put new window at top
;Here if new window is going into bottom part of old one
MOVE T,SCRBOT ;new window is at bottom, figure its top
SUBI T,(A) ;start where old trailer line is moving up to
PUSH P,T ;remember new window's top line
PUSH P,SCRBOT ;ignored-line count under new window is same as old
MOVN B,A ;negative of size of new window, incl header
ADDM B,SCRBOT ;move bottom of old window up leaving room for new
ADDM B,NLINER ;we'll use less lines for text
ADD B,SCRSIZ ;smaller total screen size
MOVE A,SCRTOP ;same old top position for old window
PUSH P,TOPWIN
PUSHJ P,SETSCR ;change old window's size parameters
POP P,A ;old TOPWIN
PUSHJ P,SETWIN ;preserve window's top text line
JRST MAKWOV
;Here if new window is going into top part of old one
MAKWO4: PUSH P,SCRTOP ;remember where to put new window (assume at top)
MOVE TT,SCRTOP ;figure out where new window ends
ADDI TT,(A) ;ends after hdr and text lines
PUSH P,TT ;save number of end line of new window
TRO F,ARG!REL ;fake arg of +n to BOTSET or TOPSET
PUSHJ P,TOPSET ;set top bigger leaving blank window there
JFCL ;may skip?
;here to make new window at location given by three values on stack:
;from top down: SCRBOT, SCRTOP, NLINER.
MAKWOV: MOVEI B,LWINDT ;get this much FS for new window's data
PUSHJ P,FSGET
MOVSI T,WINCOD ;get type code for window FS
HLLM T,-1(A) ;set FS hdr type word for new window's FS
MOVE T,A ;BLT dest
HRLI T,WINDAT ;BLT source is compiled in window data
BLT T,LWINDT-1(A) ;copy a window into new window's FS
PUSHJ P,WININI ;initialize the new window data pointed to by A
POP P,SCRBOT-WINDAT(A) ;set position of end line of new window
POP P,SCRTOP-WINDAT(A) ;set position of top line of new window
POP P,NLINER-WINDAT(A) ;set number of lines in new window
PUSHJ P,LNKWIN ;link new window into window list
PUSHJ P,ZSAVIT ;Save data about file state, esp. for tmpcor
PUSHJ P,INIT1A ;clear various file switch flags
PUSHJ P,SELWIN ;select new window (writes tmpcor)
;;The following instr shouldn't be needed since PGINIT (from BEG5) does this,
;;unless somehow changing the screen parameters (e.g., ⊗0⊗π⊗λ) requires this.
;; TRO F,DSPSCR ;make sure we update screen as needed
MOVE A,SCRTOP ;window top is arg for SETSCR
MOVE B,NLINER ;number of text display lines in window
ADDI B,NTITLE ;include title lines in SCRSIZ count
JRST SETSCR ;set up screen parameters for new window
;increment number of windows.
;fatal error if can't have more windows.
ADDWIN: AOS T,NWINS# ;increase number of windows
CAIL T,MAXWNS ;too many windows?
PUSHJ P,TELLZ ;yes, supposed to have already checked
MOVE T,FIRPAG ;remember current page and line for /S switch
MOVEM T,OLDFPG#
MOVE T,ARRL ;remember current page and line for /S switch
MOVEM T,OLDARL#
MOVE T,WINSER ;remember old window, in case fileswitch aborted
MOVEM T,OLDSER# ; for new window, which aborts whole window
MOVE T,SCRTOP ;remember old window's top and bottom, so that
MOVEM T,OLDTOP# ; we can restore them in case the user
MOVE T,SCRBOT ; aborts the fileswitch and therefore the
MOVEM T,OLDBOT# ; window switch.
MOVE T,TOPWIN ;remember position of text in window too
MOVEM T,OLDTWN# ; to minimize redrawing
HRRZS ZATT ;set flag positive meaning no file in new window
POPJ P,
;consider switching to old window with given file, instead of using new window.
;doesn't return if switching to old window and aborting the new one.
;call with file of interest in EDFIL (including device at offset of -1).
;also with LH of D containing FRDEXT bit iff user's filename specified it.
;Clobbers A,T,TT (more if it doesn't return).
FNOWCK: SKIPLE ZATT ;skip unless creating new window
SKIPN FNOWIN ;skip if want to check for same file in old windows
POPJ P, ;nothing special to do here
MOVEI T,WINHED ;window list hdr
FNOWCL: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
POPJ P, ;yes, no more windows
MOVE TT,EDFIL-WINDAT(T) ;primary name of file in that window
SKIPL WINNBR-WINDAT(T) ;ignore closed windows (skip if closed)
CAME TT,EDFIL ;match file of interest?
JRST FNOWCL ;no
TLNN D,FRDEXT ;is extension specified explicitly?
JRST FNOWC2 ;no, allow any extension to match
HLRZ TT,EDFIL+EXT1-WINDAT(T) ;extension of file in that window
HLRZ A,EDFIL+EXT1 ;file of interest
CAIE TT,(A) ;match file of interest?
JRST FNOWCL ;no
FNOWC2: MOVE TT,EDFIL+PPN3-WINDAT(T) ;PPN of file in that window
CAME TT,EDFIL+PPN3 ;match file of interest?
JRST FNOWCL ;no
SKIPN TT,EDFIL-1-WINDAT(T) ;device name of file in that window
MOVSI TT,'DSK'
PNAME TT, ;make it physical device name
JFCL ;skips on success
SKIPN A,EDFIL-1 ;device of file of interest
MOVSI A,'DSK'
PNAME A, ;make it physical device name
JFCL ;skips on success
CAME A,TT ;window's file device match file of interest?
JRST FNOWCL ;no
SUB P,[1,,1] ;OK, this is the file, don't return from FNOWCK
PUSH P,WINSER-WINDAT(T) ;remember which window this is
PUSHJ P,ABTWI0 ;abort the unused new window just created
POP P,Q ;get back serial number of desired window
CAMN Q,WINSER ;is this now the current window?
JRST MAINRT ;yes, all done
PUSHJ P,FNSWIN ;find window using serial number (may have moved)
MOVE A,T ;get ptr to window found into A
PUSHJ P,WINDG9 ;select that window
JRST MAINRT ;return to main loop, say OK
;Here from FRD when altmode typed upon attempt to edit first file in new window.
;Kill the new window and select the previous one, fixing its top and bottom.
ABTWIN: SUB P,[1,,1] ;flush return from FRD (or EPSIL4 to FNF)
OUTSTR [ASCIZ/ New window aborted. /]
PUSHJ P,ABTWI0 ;do all the work of restoring old window
JRST MAIN ;return to main loop, don't say OK
ABTWI0: SETOM ZATT ;don't come here again except for another new window
PUSHJ P,SEMODE ;set ALLACT, etc., line editor bits
AOS NDEDMX ;don't flush any old closed windows because of this
SETOM NOGIVE ;prevent CLSWIQ from giving lines away, we handle it
PUSHJ P,CLSWIQ ;close the brand new unused window, reselecting old
SOS NDEDMX ;restore normal count
MOVE A,FDEADW ;regenerate newest closed window number
SUB A,NDEADW ;this makes negative number for new closed window
SOS NDEADW ;uncount newest closed window
PUSHJ P,FNDWIN ;get ptr to window's FS block, in A
PUSHJ P,FLSWIN ;flush window pointed to by A, for good!
MOVE Q,OLDSER ;get previous window's serial number
CAME Q,WINSER ;is current window the right one?
PUSHJ P,TELLZ ;no!
MOVEI C,DSKO ;every window keeps file open on this channel
PUSHJ P,SETCHN ;Put channel into I/O UUOs XCTed
MOVE A,OLDTOP ;get old top of this window
SUB A,SCRTOP ;find amt it changed
JUMPE A,ABTWI2 ;jump if unchanged
TRO F,REL!ARG ;force relative arg to next routine
PUSHJ P,TOPSET ;adjust top to what it used to be
JFCL ;cmd routine may skip?
ABTWI2: MOVE A,SCRBOT ;get new bottom of this window
SUB A,OLDBOT ;find amt it changed by
JUMPE A,ABTWI3 ;jump if unchanged
TRO F,REL!ARG ;force relative arg to next routine
PUSHJ P,BOTSET ;adjust bottom to what it used to be
JFCL ;cmd routine may skip?
ABTWI3: MOVE A,OLDTWN ;get old TOPWIN
JRST SETWIN ;and restore it
;FNDWIN FNDWI2 FNSWIN FNSWI2 LNKWIN LNKWI0 LNKWI2 LNKWI3 SELWIN SELW00 RSELWN
;search window list for window whose number is in A. Return ptr in A.
FNDWIN: MOVEI T,WINHED ;search window list for given numbered window
FNDWI2: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
PUSHJ P,TELLZ ;shouldn't ever happen
CAME A,WINNBR-WINDAT(T) ;is this the window we want?
JRST FNDWI2 ;no, keep going down the llst
MOVE A,T ;ptr to window's FS, for selecting
POPJ P,
;search window list for window whose serial number is in Q. Return ptr in T.
FNSWIN: MOVEI T,WINHED ;search window list for given numbered window
FNSWI2: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
PUSHJ P,TELLZ ;shouldn't ever happen
CAME Q,WINSER-WINDAT(T) ;is this the window we want?
JRST FNSWI2 ;no, keep going down the llst
POPJ P,
;Link window FS in A into window list according to SCRTOP value.
LNKWIN: MOVEI T,WINHED ;list hdr location
LNKWI0: MOVE TT,SCRTOP-WINDAT(A) ;value to keep window list sorted by
LNKWI2: HRRZ T,(T) ;next window
CAIE T,WINHED ;end of list?
CAMGE TT,SCRTOP-WINDAT(T) ;or find bigger top position?
JRST LNKWI3 ;yes, insert before (T)
CAME TT,SCRTOP-WINDAT(T) ;equal tops?
JRST LNKWI2 ;no, loop
MOVE TT,SCRBOT-WINDAT(A) ;check bottoms
CAMGE TT,SCRBOT-WINDAT(T) ;find bigger bottom?
JRST LNKWI3 ;yes, insert before (T)
CAME TT,SCRBOT-WINDAT(T) ;equal bottoms?
JRST LNKWI0 ;no, keep scanning window list
MOVE TT,WINSER-WINDAT(A) ;check serial nbr, insert older window first
CAML TT,WINSER-WINDAT(T) ;skip if window A is older than window T
JRST LNKWI0 ;keep scanning list
JRST LNKWI3 ;insert window A before T
;insert window A into list before window T.
LNKWI3: HLL T,(T) ;get backward ptr of following window
MOVEM T,(A) ;make new window point forward/backward correctly
HRLM A,(T) ;make following window point back to new (A)
MOVS T,T
HRRM A,(T) ;make previous window point forward to new (A)
POPJ P,
;Here to select window whose FS pointer is in A.
;Returns with A pointing to just-retired window (different FS).
;Clobbers B,C,D,T,TT.
SELWIN: PUSH P,A ;Save ptr to new window
TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAIL0 ;Yes, do it so that saved FS is really current
TLNE F,DSPTRL ;will we need to update this on screen later?
SETOM DLINES ;yes, force TRAILS to call update trlr line
POP P,A ;Get back new window's ptr
MOVE T,WINNBR-WINDAT(A) ;get number of window we're switching to
PUSHJ P,WINSAV ;fix the window stack
MOVE T,ZINDEX-WINDAT(A) ;get index of file we're switching to
PUSHJ P,HOMSAV ;fix the file stack, to avoid duplicates
PUSHJ P,ZSAVIT ;remember tmpcor-type info about file we're leaving
;now we copy some window independent data (that's embedded in the window) from
;the retiring window (at WINDAT) to the newly selected one (which is still in FS)
MOVEI T,1 ;get and clear /-A switch in filename
EXCH T,AFLAG ;get current value of flag
CAIE T,1
SETOM NEEDHD ;old hdr is changing
EXCH T,AFLAG-WINDAT(A) ;store in window about to be activated
CAME T,AFLAG-WINDAT(A)
SETOM NEEDHD-WINDAT(A) ;new hdr is changing
HRRZ T,UIFLG ;get current value of flags
CAIE T,1 ;
SETOM NEEDHD ;old hdr is changing
MOVEI TT,1
HRRM TT,UIFLG ;clear I or A from old hdr
HRRZ TT,UIFLG-WINDAT(A)
HRRM T,UIFLG-WINDAT(A) ;store in window about to be activated
CAIE T,(TT)
SETOM NEEDHD-WINDAT(A) ;new hdr is changing
MOVEI T,1 ;get and clear EMRV flags
EXCH T,EMFLG ;get current value of flags
CAIE T,1
SETOM NEEDHD ;old hdr is changing
EXCH T,EMFLG-WINDAT(A) ;store in window about to be activated
CAME T,EMFLG-WINDAT(A)
SETOM NEEDHD-WINDAT(A) ;new hdr is changing
MOVEI T,1 ;get and clear HW flag
EXCH T,HWFLG ;get current value of flag
CAIE T,1
SETOM NEEDHD ;old hdr is changing
EXCH T,HWFLG-WINDAT(A) ;store in window about to be activated
CAME T,HWFLG-WINDAT(A)
SETOM NEEDHD-WINDAT(A) ;new hdr is changing
MOVEI T,1 ;get and clear subjob flags
EXCH T,SOMOD ;get current value of flags
CAIE T,1
SETOM NEEDHD ;old hdr is changing
EXCH T,SOMOD-WINDAT(A) ;store in window about to be activated
CAME T,SOMOD-WINDAT(A)
SETOM NEEDHD-WINDAT(A) ;new hdr is changing
SELW00: MOVE T,WINSER ;push state of disk file using window serial nbr
IOPUSH DSKO,IOID(T) ; with IOID added in to assure ID isn't zero.
FATAL IOPUSH stack overflow
SETZM JOBJDA+DSKO ;note that this channel is no longer open
IFN FTBUF,<
PUSHJ P,CACRLO ;release cache from output channel
>;IFN FTBUF
PUSH P,A ;save pointer to window about to be activated
MOVE T,(A) ;get window link word from to-be-activated window
HLLM T,(T) ;make following window point back to previous
MOVS T,T
HLRM T,(T) ;make previous window point on to next
TLO F,NOSHUF ;don't shuffle FS now, we have FS ptr on stack
MOVEI B,LWINDT ;amount of FS for window data
PUSHJ P,FSGET ;get new FS for retiring window
TLZ F,NOSHUF ;shuffling OK (when routine done, won't try before)
MOVSI T,WINCOD ;get type code for window FS
HLLM T,-1(A) ;set FS hdr type word for new window's FS
MOVEM F,WINFGS ;save all the F flags w/window, restore some later
;now we retire the current window block to the new FS block (A)
MOVEI B,WINDAT ;current location of window to be relocated
PUSHJ P,WRELOC ;fix (B) window's list ptrs for move to (A)
PUSHJ P,WINBLT ;move window from (B) to (A)
PUSHJ P,LNKWIN ;now link retiring window in at the right place
POP P,B ;address of new window to move (being selected)
;Now we activate a previous window from an old FS block pointed to by B.
;The block pointed to by B is already linked out of the window list, and is
;about to be returned to FS.
RSELWN: PUSH P,A ;save ptr to old window just retired (for FLSWIN)
MOVEI A,WINDAT ;destination of new window is main table
PUSHJ P,WRELOC ;fix (B) window's list ptrs for move to (A)
PUSHJ P,WINBLT ;move window from (B) to (A)
HRRZ A,B ;address of new window's old FS, no longer needed
TLO F,NOCHK ;don't shuffle, maybe here from TRADEW/CLSWIN/FLSWIN
PUSHJ P,FSGIVE ;free the window FS
TLZ F,NOCHK ;OK to shuffle when routines all done
PUSHJ P,ATTSXT ;set the max att buf display size we can allow
;now need to restore some file/window state flags from the restored window
MOVE T,WINFGS ;get saved flags
AND T,[SELFGS] ;clear all but relevant flags in saved versions
TDZ F,[SELFGS] ;clear in F all the relevant flags
IOR F,T ;set relevant flags back to saved states
PUSHJ P,TMPWRT ;write tmpcor file, if appropriate (clob A,B,C,D)
POP P,A ;return in A the ptr to window just retired (SELWIN)
MOVE T,WINSER ;restore state of disk file to active channel, using
IOPOP DSKO,IOID(T) ; window serial as ID. IOID ensures nonzero ID.
SKIPN PAGE ;nothing saved yet, skip if shoulda been there
POPJ P,
FATAL IOPOP failed to find old IOPUSH'd file
;WINSHF WRELOC WRELO2 WRELO3 WREL3A WRELO4 WRELO5 WINBLT
;Here from PNTREL when shuffling a window's FS. Have to fix up various ptrs.
;Window is at (A), will move by (C).
WINSHF: PUSHJ P,LSTSHF ;fix up ptrs to here from neighbors in window list
PUSH P,A
PUSH P,B
AOS B,A ;set up source for WRELOC, advance past FS hdr
ADD A,C ;make destination
PUSHJ P,WRELOC ;fix things that point into the window
JRST POPBAJ ;restore ACs and return
;Routine to fix some FS ptrs in window (B) for moving the window to (A).
;For lines ARRLIN, WINLIN and pages DIRPT, DIRP1 we stick ptr to new window
;in TXTWIN or DIRWIN of the line or page; if the new window is WINDAT, then
;this is OK even though zero is the default for new lines, because the WINDAT
;ptr in TXT/DIRWIN is actually correct and will be overwritten if necessary
;when this window gets deselected.
WRELOC: SKIPN PAGE-WINDAT(B) ;any text in this window?
JRST WRELO2 ;no, no text ptrs to fix
MOVS T,BOTSTR-WINDAT(B) ;save ptr to last incore text line before HRLM below
MOVEI TT,PAGE-WINDAT(A) ;new location of PAGE cell in FS
HRLM TT,@PAGE-WINDAT(B) ;fix back ptr in first line of page (maybe BOTSTR)
MOVEI TT,BOTSTR-WINDAT(A) ;new location of BOTSTR cell in FS
HRRM TT,(T) ;fix forward ptr of last line of page
WRELO2: SKIPN T,DPLST-WINDAT(B) ;Skip if any deleted pages around
JRST WRELO3
MOVEI TT,DPLST-WINDAT(A) ;new location of DPLST cell in FS
HRLM TT,(T) ;fix back ptr in first deleted page
MOVS T,T
HRRM TT,(T) ;fix forward ptr in last deleted page in list
WRELO3: SKIPN T,XPLST-WINDAT(B) ;skip if any extra pages in core
JRST WREL3A
MOVEI TT,XPLST-WINDAT(A) ;new location of XPLST cell in FS
HRLM TT,(T) ;fix backward ptr in first extra page
HLRZ T,XPLSTE-WINDAT(B) ;get ptr to last incore pagemark
HRRM A,-LPMTXT-LLDESC+TXTWIN(T) ;make its text FS point back to the window
WREL3A: SKIPN DIR-WINDAT(B) ;skip if any directory list
JRST WRELO4 ;no directory list to fix
MOVS T,DIREND-WINDAT(B) ;get ptr to last directory entry
MOVEI TT,DIR-WINDAT(A) ;new location of DIR cell in FS
HRLM TT,@DIR-WINDAT(B) ;fix back ptr for first directory entry
MOVEI TT,DIREND-WINDAT(A) ;new location of DIREND cell in FS
HRRM TT,(T) ;fix forward ptr for last directory entry
SKIPE T,DIRPT-WINDAT(B) ;skip if no directory ptr here
HRRM A,DIRWIN(T) ;make directory line point back to window
SKIPE T,DIRP1-WINDAT(B) ;skip if no directory ptr here
HRRM A,DIRWIN(T) ;make directory line point back to window
;We have to keep ARRLIN and WINLIN valid because they are used by OWDISP.
WRELO4: SKIPN T,ARRLIN-WINDAT(B) ;is there an arrow pointer here?
JRST WRELO5 ;no, none to maybe fix
MOVEI TT,BOTSTR-WINDAT(A) ;possible new ptr
CAIN T,BOTSTR-WINDAT(B) ;does it point to window's stars?
MOVEM TT,ARRLIN-WINDAT(B) ;yes, make it point to relocated place
HRRM A,TXTWIN(T) ;make this window's arrow line point to window
WRELO5: SKIPN T,WINLIN-WINDAT(B) ;is there a windowful pointer here?
POPJ P, ;no, none to maybe fix
MOVEI TT,BOTSTR-WINDAT(A) ;possible new ptr
CAIN T,BOTSTR-WINDAT(B) ;does it point to window's stars?
MOVEM TT,WINLIN-WINDAT(B) ;yes, make it point to relocated place
HRRM A,TXTWIN(T) ;make this window's window line point to window
POPJ P,
;Here to actually BLT the window from (B) to (A)
WINBLT: MOVSI T,1(B) ;BLT source is original window location
HRRI T,1(A) ;BLT dest is new location (we skip ZWIN cell)
BLT T,LWINDT-1(A) ;move window data to new location (FS or main table)
POPJ P,
;CLSWIG CLSWIN CLSWIQ DEDWCK DEDFLS FLSWIN CONTEL CONTE0 CONTE2 CONTIS CONTIB CONTIN CONTIE TRADE2 TRADE4 TRADE5 TRADE3 TRADEW TRADE0 TRADER
;Here to kill a window, but not so thoroughly that it can't be resurrected later.
;Here's what we do: If there's a previously closed window, we expunge that one
;(so it can never be resurrected) and give the current one a new closed-window number.
;The user can get back this closed window with ⊗XCONTINUE,
;just like CONTINUE from the monitor to get back into E. The closed window is
;still in the window list, but it's number (WINNBR) has gone negative and
;is used to remember the order in which the closed windows have died.
;The number of windows (NWINS) is reduced by one and the number of closed
;windows (NDEADW) is increased by one, except that before killing this window
;we first see if we must flush forever one or more previously closed windows
;(for each flushing of which we reduce NDEADW by one).
;Not allowed to come here if window list is empty.
;CLSWIN and CLSWIG skip on failure to open window in order to write it out.
CLSWIG: SETZM NOGIVE ;make window's lines get given away to other window
CLSWIN: PUSHJ P,FINI01 ;Write out current page, maybe delete file
JRST POPJ1 ;can't open file, pass error return on up
CLSWIQ: PUSHJ P,FINI4 ;Close the file, release cache, write TMPCOR file
PUSHJ P,CLOSDO ;Release disk channel (at most reading file)
PUSHJ P,DPYWFL ;release screen lines claimed by this window
SKIPN NOGIVE# ;skip if don't want to give those lines away
PUSHJ P,LINGIV ;give away our screen lines to deserving window
SKIPE A,NDEADW ;Any previously closed windows?
PUSHJ P,DEDWCK ;Yes, maybe need to flush one
PUSHJ P,RWINBR ;Free the number this window had used
MOVEI C,1 ;how far back on window stack to go
repeat 1,< ;new way (sets WINNBR negative before DPYWST gets called)
AOS T,NDEADW# ;count another closed window
SUB T,FDEADW# ;generate negative number for closed window
MOVNM T,WINNBR ;store negative number for closed window
PUSHJ P,WINDG2 ;select window from top of window stack
CAIA
PUSHJ P,TELLZ ;shouldn't ever skip (means stack was empty!)
MOVE T,SCRTOP-WINDAT(A) ;get nbr of top line of now-closed window
PUSHJ P,CHKHG0 ;see if SCRHGH needs fixing
MOVE A,WINNBR-WINDAT(A) ;number of window to flush from stack
>;repeat 1
repeat 0,< ;old way
PUSHJ P,WINDG2 ;select window from top of window stack
AOSA T,NDEADW# ;count another closed window
PUSHJ P,TELLZ ;shouldn't ever skip (means stack was empty!)
SUB T,FDEADW# ;generate negative number for closed window
PUSH P,WINNBR-WINDAT(A) ;closed window's number for stack flush at WINSA3
MOVNM T,WINNBR-WINDAT(A) ;store negative number for closed window
MOVE T,SCRTOP-WINDAT(A) ;get nbr of top line of now-closed window
PUSHJ P,CHKHG0 ;see if SCRHGH needs fixing
POP P,A ;number of window to flush from stack
>;repeat 0
JRST WINSA3 ;remove closed window from stack, SOS NWINS
;Here, with NDEADW in A, to consider forgetting oldest closed window(s) because
;another is dying. FDEADW is negative count of closed windows previously flushed.
DEDWCK: CAMG A,NDEDMX# ;too many closed windows? (cell value 0 means 1)
POPJ P, ;nope
PUSHJ P,DEDFLS ;yes, flush one, return with new NDEADW in A again
JRST DEDWCK ;see if we've flushed enough windows
;Here to flush exactly one closed window, the oldest one.
;Returns with new NDEADW in A.
DEDFLS: SOS A,FDEADW ;flush oldest closed window (with this negative nbr)
PUSHJ P,FNDWIN ;get ptr to window's FS block, in A
PUSHJ P,FLSWIN ;flush window pointed to by A
SOSGE A,NDEADW ;one less closed window now
PUSHJ P,TELLZ ;closed window count is negative!
POPJ P,
;Here to really flush forever the window pointed to by A.
;After flushing, we reselects the window that was current upon getting here.
FLSWIN: PUSHJ P,SELW00 ;select window being expunged, preserve stacks
PUSH P,A ;Save ptr to window just retired, to restore shortly
PUSHJ P,FLSPAG ;Flush page without bothering ATTACH buffer
PUSHJ P,FLSDIR ;Flush the directory entries
POP P,B ;get ptr to unlink the window being restored
;Now we want to link out of the window list the window just totally flushed
MOVE T,(B) ;Get forward and backward links from closed window
HLLM T,(T) ;Store backward ptr through forward one
MOVS T,T
HLRM T,(T) ;Store forward ptr through backward one
JRST RSELWN ;Reselect window pointed to by B, flush the FS
CONTEL: PUSHJ P,ABCRLF ;maybe output CRLF
SKIPN A,NDEDMX ;skip unless default value
JRST CONTE0
OUTSTR [ASCIZ/(Normal max = /]
SETZM TYOPNT
ADDI A,1
TYPDEC A
OUTSTR [ASCIZ/.) /]
CONTE0: MOVN A,NDEADW ;negative number of closed windows to report
AOJG A,CONTIE ;jump if no closed windows
OUTSTR [ASCIZ/Closed windows: /]
SETZM TYOPNT ;force typeout
CONTE2: PUSH P,A
OUTCHR ["("]
ADD A,NDEADW ;count up from 1 to NDEADW
TYPDEC A ;type positive number of window
OUTCHR [")"]
MOVE A,(P) ;counts up from 1-NDEADW to 0
ADD A,FDEADW ;offset count by number of closed-and-gone windows
SUBI A,1 ;now counts up from -NDEADW+FDEADW to -1+FDEADW (neg)
PUSHJ P,FNDWIN ;find window from negative number, get ptr in A
MOVEI D,EDFIL-WINDAT(A) ;ptr to name of file from closed window
HRLI D,FRDRUN ;limit typeout to filename
PUSHJ P,FILTYP ;type filename
OUTCHR [" "]
POP P,A
AOJLE A,CONTE2 ;loop till all closed windows listed
JRST POPJ1
CONTIS: ADDI A,1 ;-n meaning save n windows is stored as n-1
MOVNM A,NDEDMX ;set max number of closed windows we'll save
POPJ P,
;Someday we could make positive arg revive the nth closed window in closed stack.
CONTIB: SORRF Must revive most recently killed window first.
JRST POPJ1
;Here to resurrect a deleted window. We give the window a new number,
;select it, and call REOPEN like CONTINUE monitor command does.
CONTIN: JUMPE A,CONTEL ;tell names of files in closed windows
JUMPL A,CONTIS ;set max number of closed windows we'll keep
SOJG A,CONTIB ;jump if arg greater than 1 given, unimplemented
SOSGE A,NDEADW ;any closed windows?
JRST CONTIE ;no
SUB A,FDEADW ;include count of closed-and-gone windows
MOVNI A,1(A) ;closed window numbers are negative
PUSHJ P,FNDWIN ;find window from number in A, get ptr to A
AOS T,NWINS ;increase number of windows
CAIGE T,MAXWNS ;too many windows?
JRST TRADE2 ;no
AOS NDEADW ;yes, leave this one closed
SOS NWINS ;attempt to have too many windows, restore count
JRST REQWE0 ;give error message
CONTIE: SETZM NDEADW ;fix count
SORRF There are no closed windows.
JRST POPJ1
TRADE2: PUSHJ P,TRADE5 ;now select the closed window pointed to by A.
TRADE4: PUSHJ P,TYEDFL ;maybe type name of file being edited
PUSHJ P,REOPEN ;Get the old edit file open again
JRST REWLUZ ;The file changed, can't continue the quick way
POPJ P,
;now select the closed window pointed to by A (caller must reopen the file).
TRADE5: MOVE B,SCRLOW ;compare multi-window trlr line to this window's
CAML B,SCRBOT-WINDAT(A) ;is bottom of rebirthing window too low?
JRST TRADE3 ;no, all OK
SUB B,SCRBOT-WINDAT(A) ;yes, figure amount of change to move bottom up
ADDM B,SCRBOT-WINDAT(A) ;move bottom of new window up to limiting line
ADDM B,SCRSIZ-WINDAT(A) ;adjust window size smaller
ADDB B,NLINER-WINDAT(A) ;adjust text area size smaller
CAIL B,TXTMIN+ATTMXM ;is text area too small now?
JRST TRADE3 ;no, go select adjusted reborn window
SUBI B,TXTMIN+ATTMXM ;calculate negative amount adjustment needed
ADDM B,SCRTOP-WINDAT(A) ;adjust top up (can't go negative if last window OK)
MOVN B,B ;positive adjustment amount
ADDM B,SCRSIZ-WINDAT(A) ;adjust screen size bigger
ADDM B,NLINER-WINDAT(A) ;adjust text area size bigger
TRADE3: PUSHJ P,SWINBR ;get a number for this reactivated window A
PUSHJ P,SELWIN ;select new window from ptr in A
PUSHJ P,CHKHGH ;see if SCRHGH needs to be fixed
PUSHJ P,LINSET ;window may have shrunk, force recalculation
;We don't call SETWIN here because DISP will call WINCHK which will call SETWIN.
TRO F,DSPSCR ;make sure we update screen as needed
JRST DPYWST ;claim screen lines that this window will use
;Here to trade the current window for a deleted one, thus deleting the current one
TRADEW: SOSGE A,NDEADW ;any closed windows?
JRST CONTIE ;no
PUSHJ P,WRPAGG ;skip if readwrite mode and formatted file
JRST TRADE0 ;can't write it or don't need to, WRPAGE will "succeed"
PUSHJ P,WRPAGC ;readwrite, ensure we have the file open already
JRST TRADER ;can't open file (typed error msg), abort cmd quickly
TRADE0: SUB A,FDEADW ;include count of closed-and-gone windows
MOVNI A,1(A) ;closed window numbers are negative
PUSHJ P,FNDWIN ;find window from number in A, get ptr to A
AOS NWINS ;increase number of windows
PUSHJ P,TRADE5 ;select and fix closed window pointed to by A
MOVEI C,1 ;how far back on window stack to go
PUSHJ P,WINDG5 ;select window to die that was just saved on stack
CAIA ;OK
PUSHJ P,TELLZ ;shouldn't ever skip (means stack was empty!)
PUSHJ P,CLSWIG ;Close current window (write out and kill it)
JRST TRADE4 ;finally go reopen the resurrected window's file
;Failed to open the file to write it! We could just return to E's top level,
;but we haven't yet re-opened the formerly closed window that is now sitting as
;the top of the window stack (not counting current window we're trying to close)
;Since we check above to make sure we could open current file, we should never
;get here anyway.
FATAL Can't open current file to write out before closing window.
TRADER: AOS NDEADW ;undo the SOS we started with
JRST POPJ1 ;don't say OK (error msg already typed)
;CLSALL QUIT CLSALX CLSALY CLSALZ CLSAL3 CLSAL2 CLSEM CLSEM2 CLSEM3 CLSEM4 LINGIV LING2 LING3 LING4 LING5 LING6 LING7 LING8 LING9 LING13 LING10 LING11 LING12 LING20 LING21 LING22 LING23
;Here for ⊗XEXIT and ⊗XQUIT cmds to kill n windows, exiting if that's all of them.
;Exit not legal in attach mode.
;With a positive arg, we close that many windows from top of stack.
;All windows killed in one cmd can be unkilled with ⊗XCONTINUE.
CLSALL: TLOA F,TF2 ;force writing out of each window
QUIT: TLZ F,TF2 ;suppress writing out windows being closed
PUSH P,NWINS ;remember how many windows we had open
PUSH P,NDEDMX ;save max closed window allowance for monitor CONTINUE
PUSH P,A
PUSHJ P,TMPWRT ;write out TMPCOR file, if appropriate
POP P,A
PUSH P,SYSCMD ;save this so we can zap it for now
SETZM SYSCMD ;prevent closing routines from writing TMPCOR
TRNN F,ARG!REL ;skip if any arg, use it as nbr of windows to close
MOVEI A,-1 ;no arg, close all windows
SETZM NOGIVE ;assume not closing all windows, give lines away
CAMLE A,NWINS ;closing all windows (returning to monitor)?
SETOM NOGIVE ;yes, don't give dying windows lines away
PUSH P,SCRHGH ;remember top line used by display areas
PUSHJ P,CLSEM2 ;Close zero or more windows, but don't flush them
JRST CLSALX ;given arg used up, or can't open file
POP P,SCRHGH ;force erase to get all lines used lately
MOVEI TT,GETOU0 ;assume writing out
TLNN F,TF2 ;writing out each window?
MOVEI TT,QUIT1 ;no, use old quit code on final window, don't write
PUSHJ P,(TT) ;no extra windows left, use normal exit or quit code
JRST CLSAL3 ;everything worked, then user said CONTINUE
JRST CLSALY ;couldn't open final file to write out
;Here if didn't close all extra windows, either because didn't want to
;or because we failed to open some file along the way (it is left selected).
;Latter is indicatedby CLSEM2 returning directly with A still positive.
CLSALX: SUB P,[1,,1] ;flush saved SCRHGH from stack
JUMPLE A,CLSALZ ;jump unless failed to open some file to write
CLSALY: AOS -3(P) ;error msg already typed, don't say OK
CLSALZ: POP P,SYSCMD ;restore this flag for TMPCOR
POP P,NDEDMX ;restore max closed window count (maybe more closed now)
JRST POPAJ ;flush flushed-window count and return
;we return here if user says CONTINUE to monitor
CLSAL3: POP P,SYSCMD ;restore this flag for TMPCOR
POP P,NDEDMX ;restore max closed window count
CLSAL2: SOSGE (P) ;here after CONTINUE monitor cmd, reopen windows
JRST POPAJ ;all reopened
MOVEI A,1 ;simulate arg of 1 (or no arg)
PUSHJ P,CONTIN ;reopen a window
JRST CLSAL2 ;and loop until all re-opened
PUSHJ P,TELLZ ;not enough windows to reopen!
;Routine to close (A) windows. Temporarily diddles NDEDMX so that all windows
;so killed can be restored (although previously killed windows may go away).
;CLSEM writes out each window and skips unless couldn't open window to write
; (leaves un-openable window selected).
;CLSEM2 skip returns if arg indicated last window should be closed too.
; (also takes direct return with any un-openable window seleced).
CLSEM: TLO F,TF2 ;force writing out of each window
MOVEI A,-1 ;Nope, close all windows
SETOM NOGIVE ;don't give lines away from windows being closed
;Enter here from EXIT and QUIT commands (with possible argument).
CLSEM2: ADDM A,NDEDMX ;but don't worry about flushing any windows
CLSEM3: JUMPLE A,CPOPJ ;Nonpositive arg is no-op
SKIPN NWINS ;Do we have multiple windows?
JRST POPJ1 ;arg said close more than just the extra windows
PUSH P,A ;Save count
MOVEI TT,CLSWIN ;assume want to write out while closing
TLNN F,TF2 ;skip if writing out
MOVEI TT,CLSWIQ ;don't write out (here from QUIT cmd)
PUSHJ P,(TT) ;Close the window, maybe writing it out, erase it
JRST CLSEM4 ;success, window closed
JRST POPAJ ;couldn't open file, take error return
CLSEM4: POP P,A
SOJA A,CLSEM3 ;And loop until flushed enough windows
;Routine to give current windows lines to some other deserving window,
;since this window is dying. The lines will not be given to another window
;if any window already includes them (if some lines aren't used by any window,
;then those lines will be given away). The window that the lines will be
;given to is the smallest one that adjoins the lines. If two potential
;recipient windows are same size, the one nearest the top of the stack
;gets the lines. There is no great reasoning behind this; it is just a
;seemingly reasonable heuristic to save the user some work. It should
;at least do good things in the simple cases.
;If there are unused lines above and/or below the dying window, then they
;too will be given away to a deserving window.
;Clobbers A,B,C,T,TT.
;First, make a pass through the open windows seeing (1) if and any already use
;all lines of the current window which is dying and (2) which windows
;adjoin (or overlap) the dying window.
LINGIV: MOVE T,SCRTOP ;first line to give away
LING2: CAMG T,SCRHGH ;any lines above to think about?
JRST LING3 ;no
SKIPN DPYWIN-1(T) ;line above unclaimed?
SOJA T,LING2 ;yes, include in group to be given away
LING3: MOVE TT,SCRBOT ;one more than last line to give away
LING4: CAML TT,SCRLOW ;any lines below to think about?
JRST LING5 ;no
SKIPN DPYWIN+1(TT) ;line below unclaimed?
AOJA TT,LING4 ;yes, include in group to be given away
LING5: MOVEI A,WINHED ;window list header
MOVEI B,0 ;no potential recipients of giveaway lines yet
LING6: HRRZ A,(A) ;next window
CAIN A,WINHED ;end of list?
JRST LING20 ;yes
SKIPGE WINNBR-WINDAT(A) ;is this a closed window?
JRST LING6 ;yes, ignore it
CAML TT,SCRTOP-WINDAT(A) ;is open window non-adjoining below dying one?
CAMLE T,SCRBOT-WINDAT(A) ;is open window non-adjoining above dying one?
JRST LING6 ;yes, ignore it
;now we have an open window that adjoins or overlaps the dying window
CAMLE TT,SCRBOT-WINDAT(A) ;open window's bottom at or below dying bottom?
JRST LING7 ;no
CAMLE TT,SCRTOP-WINDAT(A) ;make bottom giveaway min of self and open top
MOVE TT,SCRTOP-WINDAT(A) ;don't give away lines inside top of open window
LING7: CAMGE T,SCRTOP-WINDAT(A) ;open window's top at or above dying top?
JRST LING8 ;no
CAMGE T,SCRBOT-WINDAT(A) ;make top giveaway max of self and open bottom
MOVE T,SCRBOT-WINDAT(A) ;don't give away lines inside top of open window
LING8: CAIL T,(TT) ;if giveaway top isn't above giveaway bottom,
POPJ P, ; then there is nothing left to give away!
;now see if open window is entirely within giveaway window (last remaining case)
CAMGE T,SCRTOP-WINDAT(A) ;is top below top?
CAMG TT,SCRBOT-WINDAT(A) ;yes, is bottom above bottom?
JRST LING9 ;no, not entirely within
;here we have an open window entirely within the giveaway area. We'll split
;the giveaway area into two parts, above and below the open window, and call
;ourselves recursively to give away those two parts!
PUSH P,TT ;save bottom of second giveaway part
PUSH P,SCRBOT-WINDAT(A) ;save top of second giveaway part
PUSH P,A ;remember spot in window list
PUSH P,B ;remember best previous candidate
MOVE TT,SCRTOP-WINDAT(A) ;set bottom of first giveaway part
PUSHJ P,LING9 ;finish giving away first part (above open window)
POP P,B ;best prev candidate
POP P,A ;current spot in window list (new candidate)
POP P,T ;top of second part
POP P,TT ;bottom of second part
;Finish giving away second part (below open window) by falling into LING9
;Here we have a potential recipient window (A) for some giveaway lines.
;See if it is more deserving than best so far, whose ptr is in B.
LING9: PUSH P,T ;save top giveaway line
JUMPE B,LING13 ;jump if no previous candidates, this is first one
CAME T,SCRBOT-WINDAT(B) ;see if previous candidate is no longer adjoining
CAMN TT,SCRTOP-WINDAT(B) ; giveaway lines
SKIPA T,SCRSIZ-WINDAT(A) ;old candidate still ok, see which window smaller
JRST LING13 ;old window is now disqualified (not adjoining)
CAMGE T,SCRSIZ-WINDAT(B) ;skip if previous window is smaller
LING13: SKIPA B,A ;new window is smaller, it wins over previous best
CAME T,SCRSIZ-WINDAT(B) ;
JRST LING12 ;old window is smaller, it continues as best
;windows are of equal size, give lines to window higher up on window stack
PUSH P,TT ;save bottom giveaway line
HRLZ T,WINNBR-WINDAT(A) ;get new window's number
HRR T,ZINDEX-WINDAT(A) ;make copy of window stack entry
HRLZ TT,WINNBR-WINDAT(B) ;get old window's number
HRR TT,ZINDEX-WINDAT(B) ;make copy of window stack entry
MOVN C,NWINS ;aobjn count for window stack
MOVSI C,(C) ;make aobjn ptr
LING10: CAMN T,WINSTK(C) ;is this stack entry that of new window?
SKIPA B,A ;yes, new window wins
CAMN TT,WINSTK(C) ;is this stack entry that of old window?
JRST LING11 ;yes, keep old
AOBJN C,LING10 ;loop till run out of stack
PUSHJ P,TELLZ ;neither window was in the stack!!!
LING11: POP P,TT ;restore bottom giveaway line nbr
LING12: POP P,T ;restore top giveaway line nbr
JRST LING6 ;go on to next window
;Get here when reached end of window list. B holds window winning the giveaway
;lines, which go from (T) to -1(TT).
LING20: SKIPN A,B ;get window to diddle into A
POPJ P, ;no window was even eligible
MOVE B,T
SUB B,TT ;number of lines to claim
MOVSI B,(B)
HRRI B,(T) ;make aobjn ptr to lines to claim
PUSH P,T
MOVE T,WINSER-WINDAT(A) ;get window's serial nbr for claiming screen lines
LING21: MOVEM T,DPYWIN(B) ;claim a giveaway line for display
AOBJN B,LING21 ;loop through all giveaways
POP P,T
CAME T,SCRBOT-WINDAT(A) ;are giveaway lines below bottom?
JRST LING22 ;no, must be above top
;here if adding lines to bottom of window
SUB TT,SCRBOT-WINDAT(A) ;yes, figure amount of change to move bottom down
ADDM TT,SCRBOT-WINDAT(A) ;move bottom of window down
PUSH P,[0] ;don't adjust window top
JRST LING23
;here if adding lines to top of window
LING22: CAME TT,SCRTOP-WINDAT(A) ;giveaway lines should be exactly at top
PUSHJ P,TELLZ ;oops, we miscalculated!!
SUB T,SCRTOP-WINDAT(A) ;figure change in top position
ADDM T,SCRTOP-WINDAT(A) ;adjust top up
PUSH P,T ;adjust window top up, to keep text unmoved if possible
MOVN TT,T ;positive adjustment amount
LING23: ADDM TT,SCRSIZ-WINDAT(A) ;adjust screen size bigger
ADDM TT,NLINER-WINDAT(A) ;adjust text area size bigger
PUSHJ P,SELW00 ;select window from ptr in A
EXCH A,(P) ;save ptr to window just deselected
ADD A,TOPWIN ;try to keep text unmoved on screen, fix window top
PUSH P,A ;save new adjusted window top line
PUSHJ P,CHKHGH ;see if SCRHGH needs to be fixed
PUSHJ P,LINSET ;window has grown, force recalculation
POP P,A ;get back adjusted window top
PUSHJ P,SETWIN ;fix up OFFSET for this window before deselecting
POP P,A ;dying window to reselect
JRST SELW00 ;reselect window pointed to by A, return from LINGIV
;WINSAV WINSA2 WINSA3 WINSA4 WINSA5 WINSA6 WINDGO WINDG2 WINDG5 WINDG8 WINDG9 WINDG7 WINDG3 WINDG6 WINDG4
;Now here are the window stack routines.
;Routine to update list of windows we've been in recently. Here from SELWIN.
;The values kept on the stack are: WINNBR,,ZINDEX ; each WINNBR
;is guaranteed unique while the window exists, and ZINDEX is for ⊗0⊗G typeout.
;Called with WINNBR of window we're going to in T. Clobbers B,C,TT.
;This routine makes sure that no two remembered windows are the same.
WINSAV: SKIPN TT,WINNBR ;Remember window we're coming from
PUSHJ P,TELLZ ;window number of zero is illegal
SKIPE WINFAS# ;Has the window stack already been fixed?
POPJ P, ;Yes
HRL TT,ZINDEX ;include ZINDEX in stack info
MOVEI C,(TT) ;Save number of new window we're remembering
MOVSI B,-MAXWNS ;AOBJN ptr to list of places we've been
CAIA
WINSA2: CAIE C,(TT) ;Is this old window the one we just entered in list?
CAIN T,(TT) ;Are we going to the window we're about to remember?
POPJ P, ;Yes to one, don't remember it except by being on it
MOVS TT,TT ;remember ZINDEX in RH, window nbr in LH
EXCH TT,WINSTK(B) ;Remember new place and pick up older place
MOVS TT,TT ;get ZINDEX in LH, window nbr in RH
SKIPE WINSTK(B) ;Did we just move the end marker in the list?
AOBJN B,WINSA2 ;No, continue through list unless done
MOVEI B,(B) ;just the window count
CAME B,NWINS ;make sure we agree about number of windows
PUSHJ P,TELLZ ;inconsistent window counts
POPJ P,
;Here to flush window whose number is in A from the window stack.
;Called by CLSWIN. SOSes NWINS.
WINSA3: SKIPN WINSTK ;Skip if anything in stack
PUSHJ P,TELLZ ;why were we called if nothing in the stack?
MOVN T,NWINS ;Get size of stack
MOVSI T,(T) ;Make aobjn ptr
WINSA4: HLRZ TT,WINSTK(T) ;get window number of place on stack
CAIN TT,(A) ;is this the window we want to flush?
JRST WINSA6 ;Yes, flush from stack
AOBJN T,WINSA4 ;Look through stack
PUSHJ P,TELLZ ;window wasn't in the stack, how come?
WINSA5: MOVE TT,WINSTK(T)
MOVEM TT,WINSTK-1(T) ;Squeeze entry out of middle of stack
WINSA6: AOBJN T,WINSA5
SOSGE T,NWINS ;One less entry in stack
PUSHJ P,TELLZ ;Hey, window count went negative!
SETZM WINSTK(T) ;Mark end of stack with a zero
POPJ P,
;Command routine to go back to some previous window.
;Arg indicates how many windows ago we visited the desired window.
WINDGO: JUMPE A,WINDG4 ;Zero arg means type out default arg for αβ cmd
MOVM C,A ;Get positive index of desired old window
TRNE F,REL ;Relative arg?
JRST WINDG7 ;Yes, wants to diddle stack
CAIE B,CTMT3 ;αβ command?
JRST WINDG2 ;Nope
TRNE F,ARG ;Yes, any arg?
MOVMM C,WINDBL ;Arg given with αβ means set αβ default
MOVM C,WINDBL ;Get default arg for αβ command
WINDG2: AOS (P) ;assume skip return
PUSHJ P,WINDG5 ;select desired window
SOS (P) ;didn't skip, pass success return to our caller
PUSH P,A ;save ptr to window just retired (used by CLSWIN)
PUSHJ P,TYEDFL ;maybe type name of file being edited
POP P,A ;ptr to window just retired
POPJ P,
WINDG5: SKIPN WINSTK ;Any remembered windows at all?
JRST WINDG3 ;No (check here to allow storing default for αβ)
CAMLE C,NWINS ;Range check old window index
MOVE C,NWINS ;Get index of oldest window
HLRZ A,WINSTK-1(C) ;Get window's number
WINDG8: PUSHJ P,FNDWIN ;find window from number in A, return ptr in A
;Enter here after aborting new window, to select old one with given file.
WINDG9: PUSHJ P,SELWIN ;yes, select this window pointed to be A
PUSHJ P,LINSET ;EXTRA may have changed, force window recalculation
TRO F,DSPSCR ;make sure we update screen as needed
PUSHJ P,DPYWST ;claim screen lines that this window will use
SETZM WINFAS# ;Make sure we remember old window next time
POPJ P, ;return A pointed to just-retired window
WINDG7: SKIPN WINSTK ;Is there really any place remembered?
JRST WINDG3 ;No, forget it
MOVE TT,NWINS ;Arg for NOHSTK -- size of stack
CAILE C,(TT) ;Want to diddle stack by more than its size?
JRST NOHSOV ;Yes, that's silly
HRLZ T,WINNBR ;Get current window number for NOHSTK
HRR T,ZINDEX ;RH of stack entries always has file index
HRLI TT,WINSTK ;Arg for NOHSTK -- stack's starting address
PUSHJ P,NOHSTK ;Rotate window stack by (A)
HLRZ A,A ;new window number in RH
SETOM WINFAS# ;Tell WINSAV not to save old window
JRST WINDG8 ;Go select window from number now in A
WINDG3: SORRY No old window to return to.
JRST POPJ1
WINDG6: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Window stack: (0)/]
MOVN E,NWINS ;negative size of stack
MOVSI E,(E) ;make aobjn cnt
HRRI E,WINSTK ;aobjn ptr to stack
JRST WINSTY ;type window stack as filenames
WINDG4: CAIE B,CTMT3 ;αβ cmd?
JRST WINDG6 ;No, type out window stack
MOVEI A,[ASCIZ /G/] ;Command name to type out
MOVE B,WINDBL ;Current default for αβ command
JRST NOHDEF ;Type default using common stack routine
;NXTWIN NXTWI3 NXTWI2 NXTWI6 NXTWI4 NXTWI5 NXTWI8 NXTWI7 DPYWST DPYWS2 DPYWS6 DPYWS4 DPYWS7 DPYWS8 DPYWS3 DPYWS5 DPYWS9 DPYW11 DPYW10 DPYW12 SLSRCP DPYWFL DPYWF2 GRTWIN GRTWI2 GRTWI3 GRTWI4 MWCHK MWCHKL MWCHKX IOID WINSTK WINDBL
;Routine to move down to the nth window below, where n is the given arg.
;An arg of zero means switch to the window (if any) whose top is right
;where the current window's top is.
;This code depends on the windows being sorted in the window list by
;SCRTOP values (smallest first).
NXTWIN: SKIPN TT,NWINS ;any windows at all?
JRST WINDG3 ;no other windows
MOVM C,A ;see how many windows we have to move
CAMLE C,TT ;are there that many windows?
JRST NOHSOV ;no, give error msg
;; MOVE E,A ;remember if had zero arg
PUSHJ P,GRTWIN ;find first window below current (wraps around)
MOVE D,[HRRZ B,(B)] ;instr to move down
JUMPG A,NXTWI2 ;jump if want to move down
MOVM A,A ;positive count to move up by
MOVE D,[HLRZ B,(B)] ;instr to move up a window
NXTWI3: XCT D ;next window
CAIE B,WINHED ;back to list hdr?
SKIPGE WINNBR-WINDAT(B) ;or find a closed window?
JRST NXTWI3 ;yes, keep going (don't count hdr or closed window)
NXTWI2: SOJG A,NXTWI3 ;jump if got window position we want
NXTWI6: MOVE A,B ;save window ptr
repeat 0,<
NXTWI4: XCT D ;next window
CAIE B,WINHED ;back to list hdr?
SKIPGE WINNBR-WINDAT(B) ;or find a closed window?
JRST NXTWI4 ;yes, keep going
MOVE TT,SCRTOP-WINDAT(A) ;see where we're ending up
CAIE A,(B) ;if back to first window, all done, select it
CAME TT,SCRTOP-WINDAT(B) ;is next window at same place?
JRST NXTWI7 ;no, select new window from A and return (ck 0 arg)
HRLZ T,WINNBR-WINDAT(A) ;get stack info for first window
HRR T,ZINDEX-WINDAT(A) ;index in RH
HRLZ TT,WINNBR-WINDAT(B) ;get stack info for 2nd window
HRR TT,ZINDEX-WINDAT(B) ;index in RH
MOVEI C,0 ;stack depth
NXTWI5: CAMN T,WINSTK(C) ;is this stack entry for first window?
JRST NXTWI4 ;yes, use it
CAME TT,WINSTK(C) ;no, for 2nd window?
AOJA C,NXTWI5 ;no, check next stack (must find in stack somewhere)
JRST NXTWI6 ;use 2nd window (closer to top of stack)
NXTWI8: SORRF No other window with same top line as current window.
JRST POPJ1
NXTWI7: CAME TT,SCRTOP ;new window at same spot as old?
JUMPE E,NXTWI8 ;jump if wanted exact same top spot, didn't find it
>;repeat 0
PUSHJ P,SELWIN ;select window
PUSHJ P,LINSET ;EXTRA may have changed, force window recalculation
TRO F,DSPSCR ;make sure we update screen as needed
PUSHJ P,DPYWST ;claim screen lines that this window will use
JRST TYEDFL ;maybe type name of file being edited
;Here to claim screen lines used by current window, disclaiming any no longer used.
DPYWST: PUSHJ P,DPYWFL ;clear screen lines claimed by this window
MOVE TT,SCRTOP ;get screen line nbr of top of window
ADDI TT,DPYWIN
HRLI TT,(TT) ;make blt ptr
ADDI TT,1 ; to spread window serial number through area
MOVEM T,-1(TT) ;store WINSER in screen-window loc for first line
MOVE T,SCRBOT ;get screen line nbr of bottom of window
BLT TT,DPYWIN-1(T) ;spread window serial throughout area used
PUSH P,A
PUSH P,Q
MOVE TT,SCRHGH ;now check for unclaimed lines on screen
SUB TT,SCRLOW ; from top possible line to line above final trlr
MOVSI TT,(TT) ;aobjn count of lines to check
HRR TT,SCRHGH ;line to start at
PUSH P,TT ;save copy of aobjn for later
DPYWS2: SKIPE DPYWIN(TT) ;this line unclaimed?
JRST DPYWS3 ;no
SKIPE Q,DPYWIN-1(TT) ;previous line claimed?
CAMN Q,WINSER ;by other than current window?
JRST DPYWS4 ;no
PUSHJ P,FNSWIN ;get window ptr in T from WINSER in Q
MOVE T,SCRBOT-WINDAT(T) ;see where previous line's window ends
DPYWS6: CAIG T,(TT) ;does window above include this unclaimed line?
JRST DPYWS4 ;no, look for window below
MOVEM Q,DPYWIN(TT) ;automatically claim this line for adjacent window
AOBJP TT,DPYWS5 ;next line, jump if no more
SKIPE DPYWIN(TT) ;this line unclaimed too?
JRST DPYWS3 ;no, back to main loop
JRST DPYWS6 ;yes, maybe give it to same adjacent window
DPYWS4: MOVEI A,(TT) ;remember first in group of unclaimed lines
DPYWS7: SKIPN Q,DPYWIN+1(TT) ;line below claimed?
AOBJN TT,DPYWS7 ;no, keep counting
JUMPGE TT,DPYWS5 ;didn't find anything claimed below, forget it
CAMN Q,WINSER ;don't bother if window below is current one
JRST DPYWS3 ;can't reclaim line(s)
PUSHJ P,FNSWIN ;get window ptr in T from WINSER in Q
MOVE T,SCRTOP-WINDAT(T) ;see where window below starts
CAILE T,(TT) ;any of these unclaimed lines lie in window below?
JRST DPYWS3 ;nope, too bad, can't reclaim them
CAILE T,(A) ;which comes first, first unclaimed line or window
MOVEI A,(T) ;window, only reclaim lines from top of window
DPYWS8: MOVEM Q,DPYWIN(A) ;reclaim this line for window below
CAIGE A,(TT) ;have we reached end of unclaimed lines?
AOJA A,DPYWS8 ;no, reclaim some more
DPYWS3: AOBJN TT,DPYWS2 ;loop until reach SCRLOW
DPYWS5:
;check here to see if there are any hidden windows, possibly with W flag(s) on.
;set HnWm display flags accordingly
MOVEI A,0 ;no hidden windows found yet
MOVEI T,WINHED ;window list header
DPYWS9: HRRZ T,(T) ;next window
CAIN T,WINHED ;skip unless end of list
JRST DPYW10 ;end of list, see if found hidden windows
SKIPGE WINNBR-WINDAT(T) ;ignore closed windows
JRST DPYWS9 ;closed window, on to the next
MOVE TT,(P) ;get back aobjn ptr to lines of display used
MOVE Q,WINSER-WINDAT(T) ;get this window's serial number
DPYW11: CAMN Q,DPYWIN(TT) ;skip unless this line visible for this window
JRST DPYWS9 ;this window is visible
AOBJN TT,DPYW11 ;loop through display lines
AOBJN A,.+1 ;count hidden window in LH, hidden W flags in RH
MOVE TT,WINFGS-WINDAT(T) ;see if W flag is on for this hidden window
TRNN TT,WRITE
SOJA A,DPYWS9 ;no W flag, uncount it (had counted with aobjn)
JRST DPYWS9 ;W flag set, leave it counted (from aobjn)
DPYW10: MOVEI T,1 ;assume no hidden windows at all
JUMPE A,DPYW12 ;jump if no hidden windows
; HLRZ T,A ;number of hidden windows
; SOJE T,DPYW13 ;omit number if is 1
; ADDI T,"0"+1 ;convert to ASCII digit
; LSH T,=15 ;shift number into correct position
;DPYW13:ADD T,[ASCID / h/] ;make ASCID for hm (number of hidden windows)
MOVE T,[ASCID / h/] ;display "h" in hdr, indicating hidden window(s)
MOVEI A,(A) ;count of hidden W flags hidden
JUMPE A,DPYW12 ;jump if none
; SOJE A,DPYW14 ;omit number if is 1
; ADDI A,"0"+1 ;convert to ASCII digit
; LSH A,1 ;shift number into correct position
;DPYW14:ADDI T,"w"⊗1(A) ;make ASCII for Wn
ADDI T,"w"⊗1 ;display "w" after the "h", for hidden W flag(s) set
DPYW12: MOVEM T,HWFLG ;store new value of HW flag in header
SETOM NEEDHD ;make header updating get considered
SUB P,[1,,1] ;flush aobjn count from stack
POP P,Q
POP P,A
;Here when changing top position. From DPYWST, which is called from SETSCR.
;Must adjust place where search page number is displayed. Clobbers only T.
SLSRCP: PUSH P,G ;Enter here from DPYCHK
MOVE G,SCRTOP
PUSHJ P,@PCOMP ;Get dpy instr to select proper line/col for search page
XCT SRCDP4 ;Clear piece of dpy instr in T
XCT SRCDP5 ;Insert new value in dpy instr in T
MOVEM T,SRCDD+1 ;Store in search page display program
POP P,G
POPJ P,
DPYWFL: MOVSI TT,-MAXLIN ;aobjn ptr to check for window lines
MOVE T,WINSER ;current window's serial number
DPYWF2: CAMN T,DPYWIN(TT) ;was this line claimed by this window?
SETZM DPYWIN(TT) ;yes forget that now (maybe reclaimed in DPYWST)
AOBJN TT,DPYWF2 ;loop through screen lines
POPJ P,
;Find first window below current one, wrapping around screen until have it.
;Ignores closed windows. Requires at least one open window in the list.
;Assumes windows are sorted in the window list by position on screen.
GRTWIN: MOVEI B,WINHED ;window list hdr location
MOVE C,SCRTOP ;see where current window is
MOVE TT,SCRBOT ;see where its bottom is
MOVE T,WINSER ;current window's serial nbr
GRTWI2: HRRZ B,(B) ;next window
CAIN B,WINHED ;end of list?
JRST GRTWI3 ;yes, return first window in list
SKIPL WINNBR-WINDAT(B) ;ignore closed windows
CAMLE C,SCRTOP-WINDAT(B) ;is this window below current one (C)
JRST GRTWI2 ;no
CAML C,SCRTOP-WINDAT(B) ;maybe, is its top at same spot?
CAMGE TT,SCRBOT-WINDAT(B) ;yes, does current window extend below this one?
POPJ P, ;no, return ptr in B
CAMG TT,SCRBOT-WINDAT(B) ;are windows in exactly same position?
CAML T,WINSER-WINDAT(B) ;yes, is current window older (lower serial nbr)?
JRST GRTWI2 ;no, say current window is lower, keep scanning list
POPJ P,
GRTWI3: HRRZ B,WINHED ;found all windows are above C, return first
GRTWI4: SKIPL WINNBR-WINDAT(B) ;ignore closed windows, though
POPJ P, ;return ptr to first open window in the list
HRRZ B,(B) ;skip closed window, go on to next
CAIN B,WINHED ;better not run out of windows in list
PUSHJ P,TELLZ ;no open windows in the list! yet NWINS positive
JRST GRTWI4 ;check to see if this window's open
;Check to see if newly opened file is already open in other window(s). Warn if so.
;Ignore closed windows. Returns A nonzero if file open in other windows.
MWCHK: MOVEI A,0 ;number of other windows file is open in so far
MOVEI T,WINHED ;window list header
MOVE TT,ZINDEX ;index of new file
MWCHKL: HRRZ T,(T) ;next window
CAIN T,WINHED ;end of list?
JRST MWCHKX ;yes
SKIPL WINNBR-WINDAT(T) ;skip if closed window, ignore it
CAME TT,ZINDEX-WINDAT(T) ;window's file have same index as current file?
JRST MWCHKL ;no
AOJA A,MWCHKL ;yes, count it
MWCHKX: JUMPE A,CPOPJ ;jump if file not open in other live windows
ADDI A,1 ;include current window in count reported
OUTSTR [ASCIZ/This file open in /]
SETZM TYOPNT ;force typeout
TYPDEC A ;number of windows
OUTSTR [ASCIZ/ windows! /]
POPJ P,
IMPURE
IOID←←100 ;random nonzero offset to ensure IO ID is nonzero in IOPUSH,IOPOP
WINSTK: BLOCK MAXWNS ;WINNBR,,ZINDEX of recently visited windows (oldest last)
WINDBL: 2 ;number of windows back we go on αβG command
PURE
;⊗ NEWDLF NEWDLS NEWDL1 NEWDL2 NEWDL4 NDFSAY NOTEX2 NOTEXT PPEMPT RDFAIL RDFAI0 RDFAI2 RDFAI3 RDFAI7 RDFA77 RDFAI9 RDFAI8 RDFAI6 RDFA10 RDFAIT NDFAIL NEWD4A RDFAI5 RDFAI4 NEWD1 NEWD2 NEWD2B NEWD2A NEWD3 NEWD3A NEWD4 NDFIN NDFIN0 NEWD5 NEWD5A
;Here from NDFAIL/RDFAIL.
NEWDLF: TLZ F,TF1!TF2
TRNE C,200 ;Was α used on <cr> ending X cmd line?
TLO F,TF1 ;That means list labels having at least one up-arrow
TRNE C,400 ;Was β used?
TLO F,TF2 ;αβ means list labels having two up-arrows
;Here from NDSAIL.
NEWDLS: SKIPN TT,XPLST ;Are there any appended pages?
JRST NEWDL2 ;No
HLRZ T,PMLNBR(TT) ;line number of first incore page
CAML T,ARRL
JRST NEWDL2 ;On the first page in core
NEWDL1: MOVEI A,1(T) ;Line number of first line on page
MOVEI B,-LPMTXT-LLDESC(TT) ;Pointer to the first line
HRRZ TT,(TT)
JUMPE TT,NEWDL4
HLRZ T,PMLNBR(TT) ;line number of next incore page
CAMGE T,ARRL
JRST NEWDL1 ;Try next page
JRST NEWDL4
NEWDL2: MOVEI A,1
MOVEI B,PAGE ;Start at top of page
NEWDL4: PUSHJ P,SETARR
HRRZ T,(B)
SKIPN TXTCNT(T) ;Is first line of page not a text line?
JRST PPEMPT ;Yes, pop up a level and report empty page
PUSH P,A
PUSHJ P,ENDSET ;To guarantee that new line will be at the end of FS
POP P,A
HRRZ H,FSEND
ADDI H,1
EXCH H,ARRLIN ;New line gets the arrow
MOVSI TT,ARRBIT
JUMPE H,.+2
ANDCAM TT,TXTFLG(H)
MOVE H,ARRLIN ;New line again
LEG HLLM TT,TXTFLG(H)
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
LEG SETZM TXTWIN(H) ;clear window ptr for line in current window
MOVEM TT,SRCNUM
HRRZ T,(B) ;Link up new area as first line on page
HRRM T,(H)
HRLM B,(H)
HRLM H,(T)
HRRM H,@B
MOVE I,H
ADD H,[440700,,LLDESC] ;Pointer for depositing text
SETZB Q,G ;Q counts labels, G counts columns
MOVEI K,0 ;K is negative count of "extra" spaces from tabs
POPJ P,
NDFSAY: OUTSTR [ASCIZ/Command has no arguments, but terminating <cr> lists all labels, α<cr> lists
all labels with 1 or more ↑'s, αβ<cr> lists all labels with 2 or more ↑'s./]
JRST POPJ1
NOTEX2: ADD P,[1,,1] ;Stack is okay, cancel SUB below
NOTEXT: SKIPA TT,[[ASCIZ/ No text to work on. /]]
PPEMPT: MOVEI TT,[ASCIZ/ Page is empty. /]
SUB P,[1,,1] ;Flush return from subroutine that lost
SKIPGE BLAB
POPJ P, ;Shhhh!
OUTSTR (TT)
JRST POPJ1
;This code replaces the page's first line, listing all labels (in FAIL format).
;CR termination lists all labels, α<cr> lists those with one ↑, αβ<cr> those with ↑↑
RDFAIL: JUMPE A,NDFSAY ;Zero arg reports some help info
MOVE D,ARRL ;save starting arrow line for getting back later
HRROS OLDFAS ;avoid changing line stack at all
PUSHJ P,NEWDLF ;Start-up routine (may return up level!)
PUSH P,TOPWIN ;remember top line of window
PUSH P,D ;remember line we came from (to return later)
PUSHJ P,RDFAI0 ;do the work of replacing directory line
CAIA ;didn't skip, we won't either
AOS -2(P) ;skipped, so will we
POP P,A ;get back initial arrow line number
HRROS OLDFAS ;avoid changing line stack at all
PUSHJ P,SETARR ;go back to line where we started
POP P,A ;get back initial window
JRST SETWIN ;and position window there again
RDFAI0: TLNE F,NULLIN ;old dir line empty?
JRST RDFA10 ;yes, don't insert leading space
HRRZ B,@ARRLIN ;get pointer to old first line of page
ADD B,[440700,,LLDESC] ;make ptr to text
;Here we loop, copying text from old dir line to new dir line, up to ";⊗"
RDFAI2: ILDB C,B ;get a char from old line
RDFAI3: CAIN C,15 ;end of line?
AOJA G,RDFAI6 ;yes, count a space added to end of line
LEG IDPB C,H ;no, copy to new line
CAIN C,11 ;tab?
AOJA K,RDFAIT ;handle tabs specially, adjust for leading tab
AOS G ;count chars in new line
CAIE C,";" ;is this the signal we're looking for?
JRST RDFAI2 ;no, loop till signal or end of line
ILDB C,B ;maybe, get following char
CAIE C,"⊗" ;second char of signal?
JRST RDFAI3 ;no, keep copying
;now we've found ";⊗" in old directory line -- discard rest of that line.
HRROS OLDFAS ;avoid changing line stack at all
PUSHJ P,RDFAI4 ;join NDFAIL code to put labels in new dir line
RDFAI7:
;Now we want the TXTCNT value that NDFIN will generate for the new line, so
;we can compare it with the old as the quick part of the test for changes
;in the line. To do this, we have to adjust the char count for any final
;space that will be omitted from the new line. And we want to insert a CR
;at the end of the new line, but we don't want to confuse NDFIN's calculation,
;which depends on adjusting the count depending on whether or not it finds
;a space to omit. So we're very careful to fudge NDFIN's count here so that
;it will come out right later (see ** below).
LDB TT,H ;flush any final space (like NDFIN)
CAIE TT,40
AOJA G,RDFA77 ;Initial semicolon was not counted
TESTBP H ;make sure byte ptr hasn't already been backed up
ADD H,[70000,,0] ;Overwrite last space which was counted
RDFA77: MOVE C,G ;duplicate NDFIN's calculation of TXTCNT
MOVE D,K ; by copying its G and K for use here
MOVEI T,15 ;end new line with CR for comparison below
MOVE TT,H ;copy the byte ptr, leaving NDFIN's version alone
IDPB T,TT ;append CR to line -- NDFIN won't find space, so
SUBI G,1 ; ** undo the AOJA G, that NDFIN will do
HRRZ A,ARRLIN ;get ptr to new dir line
HRRZ B,(A) ;get ptr to old dir line
ADDI D,2(C) ;G has columns, K has minus extra cols added by
HRL C,D ;C now has what would be TXTCNT of new line
CAME C,TXTCNT(B) ;skip if same length, check text for any changes
JRST RDFAI8 ;different length, something definitely changed
ADD A,[440700,,LLDESC] ;make byte ptr to new line
ADD B,[440700,,LLDESC] ;make byte ptr to old line
RDFAI9: ILDB C,A ;char from new line
ILDB D,B ;char from old line
CAIE C,(D) ;identical?
JRST RDFAI8 ;nope, line has changed, replace old with new
CAIE C,15 ;yes, matched to end of line?
JRST RDFAI9 ;no, keep checking
;here if it turned out that the new dir line is identical to the old one.
;so we flush the new one completely and leave the old one there.
;we have to undo the setting of ARRLIN/ARRBIT and the new line linking
;that NEWDLF did when we started up, and we have to flush the ENDSET.
HRRZ A,ARRLIN ;get ptr to new line again
HRRZ B,(A) ;get ptr to old line again
MOVSI TT,ARRBIT
IORM TT,TXTFLG(B) ;old dir line becomes arrow line for now
MOVEM B,ARRLIN ;store ptr to old line's FS block as arrow line
HLRZ T,(A) ;get new line's previous line
HRLM T,(B) ;make old line point back to it
HRRM B,(T) ;make that prev line point forward to old line
JRST ENDFIX ;close off expanding FS, didn't use any, return
;Here if new direcory line is different from old. Finish up new, delete old.
RDFAI8: HRROS OLDFAS ;make sure line stack isn't diddled
PUSHJ P,NEWD4A ;finish up the line, maybe type length
CAIA ;didn't skip, so we won't either
AOS (P) ;skip return if NDFAIL code skipped
MOVEI A,1 ;move down to old directory line
HRROS OLDFAS ;avoid changing line stack at all
PUSHJ P,MOVARR ;down one line
MOVEI A,1 ;simulate ⊗1αβD to delete old directory line
HRROS OLDFAS ;avoid changing line stack at all
JRST DELLIN ;delete a line and return from RDFAI0
;Here when old line didn't contain ";⊗" so we append to end of it.
RDFAI6: MOVEI C," " ;append space to old line
LEG IDPB C,H ; before adding ";⊗ "
;Enter here when old directory line was empty.
RDFA10: SKIPL BLAB ;skip if terse mode
OUTSTR [ASCIZ/(appending ";⊗...") /] ;tell him dir line may need fixing
PUSHJ P,RDFAI5 ;join NDFAIL code
JRST RDFAI7 ;now delete old dir line, maybe clear W flag
;Here on tab in old directory line. copy through ending tab
RDFAIT: ILDB C,B ;look for ending tab
LEG IDPB C,H ;copy to new line
SOS K ;count a tab space to adjust for later
CAIE C,11 ;this the ending tab?
AOJA G,RDFAIT ;no
AOJA K,RDFAI2 ;yes, back to main copy loop, adjust for final tab
;This code generates a new first line, listing all labels (in FAIL format).
;CR termination lists all labels, α<cr> lists those with one ↑, αβ<cr> those with ↑↑
NDFAIL: JUMPE A,NDFSAY ;Zero arg reports some help info
PUSHJ P,NEWDLS ;Start-up routine
PUSHJ P,RDFAI5 ;make ";⊗ <symbol list>"
;finish up new line and maybe type its length
NEWD4A: PUSHJ P,NDFIN ;Finish up line
SKIPG BLAB
POPJ P, ;Just say OK
PUSHJ P,ABCRLF ;Output CRLF if needed. Clobbers T.
HRRZ T,TXTCNT(I)
OUTSTR [ASCIZ/The new line of /]
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/ chars lists /]
TYPDEC Q
OUTSTR [ASCIZ/ items. /]
JRST POPJ1
RDFAI5: MOVEI C,";" ;Start with a semicolon
LEG IDPB C,H ;insert in line
AOS G ;count chars in line
MOVEI C,"⊗" ;follow with circle-x
RDFAI4:
LEG IDPB C,H ;insert in line
AOS G ;count chars in line
MOVEI C," " ;follow with space
LEG IDPB C,H
MOVEI E,40
HRRZ B,(I) ;Start on old first line
NEWD1: MOVSI T,-=20 ;Maximum length of symbol (arbitrary)
MOVE D,B
ADD D,[440700,,LLDESC]
NEWD2: MOVEM D,DSAVE#
ILDB C,D
CAIE C,40
CAIN C,11
JRST NEWD2 ;Ignore initial spaces and TABS
CAIN C,"↓"
JRST NEWD2 ;Ignore down-arrows
TLNN F,TF1 ;Skip if an up-arrow is required
JRST NEWD2A
CAIE C,"↑"
JRST NEWD4 ;Required up-arrow is missing
MOVEM D,DSAVE
ILDB C,D
TLNN F,TF2 ;Skip if two ↑'s required?
JRST NEWD2A
CAIE C,"↑"
JRST NEWD4 ;Second required up-arrow is missing
NEWD2B: MOVEM D,DSAVE
ILDB C,D
NEWD2A: CAIE C,"↓"
CAIN C,"↑"
JRST NEWD2B ;Discard all up-arrows and down-arrows from label
JRST NEWD3A
NEWD3: ILDB C,D ;Check line for a label
NEWD3A: CAIE C,"←" ;Skip if we've just seen a FAIL assignment
CAIN C,"=" ;Skip unless this is a MACRO assignment
JRST NEWD5 ;Assignment -- list symbol on dir line
CAIN C,":" ;Is it a colon?
JRST NEWD5 ;Go copy this label
MOVE TT,CTAB(C) ;Get bits for given character
CAIE C,"." ;Allow period in symbol
TLNE TT,LETF!LT2F!NUMF ;This char allowed in symbol?
AOBJN T,NEWD3 ;Yes, loop unless symbol too long
NEWD4: HRRZ B,(B) ;Go to the next line
SKIPE TXTCNT(B) ;skip if end of page
JRST NEWD1 ;and try again
POPJ P, ;pagemark or end of incore text--no more labels
NDFIN: LDB C,H
CAIE C,40
AOJA G,NDFIN0 ;Initial semicolon was not counted
TESTBP H ;make sure byte ptr hasn't already been backed up
ADD H,[70000,,0] ;Overwrite last space which was counted
NDFIN0: MOVEI C,15
LEG IDPB C,H
MOVEI C,12
LEG IDPB C,H
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
ADDI K,2(G) ;G has columns, K has minus extra cols added by
ADDM K,CHARS ; tabs, so sum is number of actual chars, plus CRLF
HRL G,K
MOVEM G,TXTCNT(I)
AOS LINES ;Add to line count
MOVE T,ARRL ;see where we've added this line
CAMG T,TOPWIN ;added line above or at top of visible window?
AOS TOPWIN ;yes, top visible line is now lower on page
MOVE T,I ;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
PUSHJ P,ENDFIX
PUSHJ P,LINSET
TLZ F,PMLIN!NULLIN ;Not pointing to a pagemark or empty line now
PUSHJ P,SETWRT
PUSHJ P,XXADD ;Fix up line marks
POPJ P,
NEWD5: HRRZ T,T ;Number of chars in label
JUMPE T,NEWD4 ;Can't have zero length label.
ADDI Q,1 ;Count another label
MOVE D,DSAVE ;Go back and copy this label
NEWD5A: ILDB C,D
LEG IDPB C,H
AOS G
SOJG T,NEWD5A
LEG IDPB E,H
AOJA G,NEWD4
;NDSAIL NDSA0 NDSA1 NDSA3 NDSA4 NDSA5 NDSA6 NDSA8 NDSA9 NDS9A NDSA9B NDSA10 NDSA11
;This code generates a new first line, for Sail programs
NDSAIL: PUSHJ P,XTDLIN ;Prepare to reread extended command line
MOVSI E,-4 ;4 permitted
NDSA0: PUSHJ P,TYI
JRST NDSA17 ;Use default names (or as modified)
CAIE C,40
CAIN C,11
JRST NDSA0 ;Ignore initial spaces and tabs
MOVE D,[440700,,BUF]
SETZM BUF
SETZM BUF+1
SETZM BUF+2
CAIE C,","
JRST NDSA1
ADDI E,2 ;3 words per name
AOBJN E,NDSA0 ;Use default
JRST NDSA4 ;No more allowed
NDSA1: CAIL C,140
CAILE C,172
JRST .+2
SUBI C,40 ;Make upper case
IDPB C,D
PUSHJ P,TYI ;Now read string
JRST NDSA3
CAIE C,","
JRST NDSA1
NDSA3: MOVE D,BUF
MOVEM D,NDSWRD(E)
MOVE D,BUF+1
MOVEM D,NDSWRD+1(E)
MOVE D,BUF+2
MOVEM D,NDSWRD+2(E)
CAIN C,15
JRST NDSA4
ADDI E,2
TRNE C,600 ;Bucky bit says zero rest of names
AOBJN E,[SETZM BUF
SETZM BUF+1
SETZM BUF+2
JRST NDSA3]
AOBJN E,NDSA0
NDSA4: JUMPE A,NDSAY ;Report only
SETZM TYIPNT ;Done with input
PUSHJ P,NEWDLS ;Start set-up
MOVE C,[ASCII/COMME/]
LEG MOVEM C,(H)
MOVE C,[ASCII/NT /]
LEG MOVEM C,1(H)
ADD H,[-250000,,1]
MOVEI G,7 ;Do not count space (to conform to NDFAIL usage)
HRRZ B,(I) ;Start with old first line
NDSA5: MOVE D,B
ADD D,[440700,,LLDESC]
NDSA6: ILDB C,D
CAIE C,40
CAIN C,11
JRST NDSA6 ;Ignore spaces and tabs
CAIE C,15
CAIN C,12
JRST NDSA10 ;Woops, at end of the line
SETZM BUF
SETZM BUF+1
SETZM BUF+2
MOVSI T,-240 ;This should be big enough
SKIPA E,[440700,,BUF]
NDSA8: ILDB C,D
CAIE C,40
CAIN C,11
JRST NDSA9
CAIN C,";"
JRST NDSA6 ;Maybe something else on this line, try again
CAIN C,15
JRST NDSA9 ;May be continued on next line
CAIL C,140
CAILE C,172
JRST .+2
SUBI C,40 ;Make upper case
IDPB C,E
AOBJN T,NDSA8
NDSA9: TRNE T,760 ;Only 15 chars. allowed
JRST NDSA6 ;So skip this word and look further
MOVSI T,-4
NDS9A: MOVE TT,BUF
CAME TT,NDSWRD(T)
JRST NDSA9B ;No match on first 5 chars.
MOVE TT,BUF+1
CAME TT,NDSWRD+1(T)
JRST NDSA9B ;nor on second lot of 5
MOVE TT,BUF+2
CAMN TT,NDSWRD+2(T)
AOJA Q,NDS11A ;A match
NDSA9B: ADDI T,2
AOBJN T,NDS9A ;Try against next word
CAIE C,15 ;Were we at the end of a line?
JRST NDSA6 ;No match so try again
NDSA10: HRRZ B,(B) ;Going to next line
SKIPE TXTCNT(B)
JRST NDSA5
NDSA11: MOVEI C,";"
DPB C,H
JRST NEWD4A
;NDSWRD NDSWD0 NDSA17 NDS11A NDSA13 NDS13A NDSA14 NDS14A NDS14B NDSA22 NDSA15 NDSAY NDSAY0
IMPURE
NDSWRD: 0
0
0
ASCII/RECORD!CLASS/
ASCII/RECORD_CLASS/
ASCII/PROCEDURE/
0
PURE
NDSWD0: 0
0
0
ASCII/RECORD!CLASS/
ASCII/RECORD_CLASS/
ASCII/PROCEDURE/
0
NDSA17: TRNN C,600
JRST NDSA4
MOVSI T,NDSWD0 ;Restore default values
HRRI T,NDSWRD
BLT T,NDSWRD+13
JRST NDSA4
;Something to report, but clear out superfluous spaces, tabs and cr's
NDS11A: TDZA T,T
NDSA13: ILDB C,D
CAIE C,40
CAIN C,11
JRST NDSA13 ;Ignore spaces here
CAIE C,15
JRST NDS14A
NDS13A: PUSHJ P,NDSA22 ;Catagory and name may even be on different lines
JRST NDSA13 ;Now continue on new line
JRST NDSA11 ;A false alarm, at end of page
;Now report it, but watch for teminating signals
NDSA14: ILDB C,D
NDS14A: CAIN C,";" ;For safety a ";" always ends consideration
JRST NDSA15 ;End of the expression
CAIN C,"="
AOJA T,NDSA14 ;not to be reported
CAIN C,"["
ADDI T,101 ;Only a limited depth allowed for
CAIN C,"]"
SUBI T,100
CAIN C,"("
ADDI T,1001
CAIN C,")"
SUBI T,1000
CAIE C,11
CAIN C,40
AOJA T,NDSA14 ;Report only 1 word and look for a "," or ";"
CAIN C,15
AOJA T,NDS13A ;Stop reporting but look at the next line
CAIGE T,100
CAIE C,","
JRST NDS14B
SETZ T,
LEG IDPB C,H
AOJA G,NDSA13
NDS14B: JUMPN T,NDSA14
LEG IDPB C,H
AOJA G,NDSA14
NDSA22: HRRZ B,(B) ;A CR found when not recording
CAIN B,BOTSTR
JRST POPJ1
MOVE D,B
ADD D,[440700,,LLDESC]
POPJ P,
NDSA15: MOVEI C,40
LEG IDPB C,H
AOJA G,NDSA6
NDSAY: MOVSI E,-4
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Categories are /]
SKIPA
NDSAY0: OUTSTR [ASCIZ/,/]
MOVEI B,NDSWRD
ADDI B,(E)
OUTSTR (B)
ADDI E,2
AOBJN E,NDSAY0
OUTSTR [ASCIZ/ /]
JRST POPJ1
;LOKBLK LOKBL0 LOKBL1 LOKBL2 BEGS BEGS2 BEGS2A BEGSDD BEGS3 BEGS4 BEGS5 BCRLF BEGS6 BEGS7 BEGS8 BEGS9 BEGS10 BEGS11 BEGS12
IFE DECSW,<
OPDEF INIERR [1B8] ;ERROR UUO FOR SEGMENT GETTING
IMPURE
LOKBLK:'E '↔'SEG '↔0↔0
LOKBL0:'SYS '
LOKBL1:'E '↔'DMP '↔0↔0↔0
LOKBL2:'E '↔'SEG '↔0↔0
;Code to save lower segment and to start it so that it will, in turn, reload
;the upper. Entered from S 137 code.
; Pre-BEG code to attach the upper segment E.SEG etc.
;Here are a bunch of pointers for JFR's hopeless program to find things via.
0,,PAGE ;data structure headers and trailers
BOTSTR
ATTBUF
JBICNI ;interrupt block and ESCIEN flag
FSGET ;storage allocation
FSGIVE
DRAW ;display routine
IFE DEBSW,<JRST 4,.>
IFN DEBSW,<JSR BEGS2>
JSR BEGS2
BEGS: JSR BEGS2 ;ENTRY -2 TO +2
JSR BEGS2
JSR BEGS2
BEGS2: 0
MOVEM 17,RPGACS+17 ;Save initial ACs
MOVEI 17,RPGACS
BLT 17,RPGACS+16
PJOB 1, ;Get our job number
HRLI 1,11000 ;Status-change protection for all but owner
SETPRO 1, ;Set upper seg protection, to keep write protected
CAI
RESET
SOS 17,BEGS2 ;Address where we entered
SKIPE JOBHRL ;Do we already hase an upper?
JRST BEGS3 ;Yes
LINKUP ;No, but does someone else have it?
SKIPA 1,BEGS4 ;No. Load temp UUO handler
JRST BEGS3 ;Yes
MOVEM 1,JOB41↑ ;Temp UUO handler
INIT DSKI,17 ;Dump mode
BEGS2A: 'SYS ' ;Replaced by 'DSK ' on a S 136 start
0
INIERR BEGS6
LOOKUP DSKI,LOKBL2
INIERR BEGS7
MOVS 1,LOKBL2+PPN3 ;-SIZE
MOVN 1,1
ADD 1,JOBFF↑
CORE 1,
INIERR BEGS8
SOS 1,JOBFF ;Construct IOWD
HLL 1,LOKBL2+PPN3
SETZ 2, ;End of dump mode command list
IN DSKI,1 ;Read in whole upper segment file
AOSA 1,JOBFF ;Correct for the SOS (restore JOBFF)
INIERR BEGS9
RELEAS DSKI,
SETZM JOBJDA+DSKI
MOVEI 2,ENDPUR∧¬400000(1) ;Last word in upper segment, as addressed in lower
CORE 2, ;Don't waste core beyond end of upper
INIERR BEGS12
BEGSDD: TLO 1,400000 ;Write protect
HRRI 1,-1(1) ;Last address in lower
REMAP 1,
INIERR BEGS10
MOVE 1,LOKBL2
SETNM2 1,
CAI
BEGS3: ADDI 17,1*BEG-BEGS
MOVEM 17,BEGS11
MOVSI 17,RPGACS
BLT 17,17
JRST @BEGS11
;User UUO dispatch instruction placed at JOB41
BEGS4: JRST BEGS5 ;Data can't be in literal (or would be in upper!)
BEGS5: OUTSTR BCRLF
OUTSTR @40
EXIT
BCRLF: ASCIZ/
/ ;This has to be in the lower!
BEGS6: ASCIZ/CANT INIT SYS:/
BEGS7: ASCIZ/CANT LOOKUP E.SEG/
BEGS8: ASCIZ/NO CORE TO READ SEGMENT/
BEGS9: ASCIZ/ERROR READING SEGMENT/
BEGS10: ASCIZ/REMAP FAILED/
BEGS11: 0
BEGS12: ASCIZ/CORE UUO FAILED AFTER READING IN SEGMENT/
PURE
>;NOT DECSW
;FNDWRT WRITTE TYP2DG WRTTEN
;Here when just starting to edit a file. Remember who last wrote this file.
FNDWRT: AOSE GETWRT
POPJ P, ;We've already done this
IFE DECSW,<
XCT %MTAP2 ;Find out who last wrote this file
SETZM WRTPPN ;Error on UUO, clear PPN of last writer
>;NOT DECSW
HRRZ T,LKUP+1 ;Get high-order part of date written
MOVEM T,WRTFI1
MOVE T,LKUP+2 ;Get rest of date/time written
MOVEM T,WRTFI2 ;Save it
IFN DECSW,<
MOVE T,DECLKB+26
MOVEM T,WRTPPN ;Get DEC version of writer
>;DECSW
POPJ P,
;Here for the extended command ⊗XWRITTEN
WRITTE: PUSHJ P,ABCRLF
SETZM TYOPNT
OUTSTR [ASCIZ/File previously written/]
OUTSTR [ASCIZ/ by /]
IFN IRCSW,<
MOVE A,WRTPPN
PUSHJ P,PPNTYO
>;IRCSW
IFE IRCSW,<
HLLZ A,WRTPPN
PUSHJ P,PNTYO ;Type out project
TYPCHR ","
HRLZ A,WRTPPN
PUSHJ P,PNTYO ;Type out programmer
>;NOT IRCSW
IFE DECSW,<
OUTSTR [ASCIZ/ using /]
MOVE A,WRTJOB
PUSHJ P,SIXTYO ;Type out program name
>;NOT DECSW
OUTSTR [ASCIZ/ on /]
HRRZ A,WRTFI2 ;Low-order part of date written
HRRZ B,WRTFI1 ;High-order part
LSH B,-=15
DPB B,[POINT 6,A,23] ;Insert high-order part into date
IDIVI A,=31 ;Day of month - 1 into B
ADDI B,1
TYPDEC B ;Day of month
IDIVI A,=12 ;Month - 1 into B
OUTFIV MONTH(B)
ADDI A,=64
TYPDEC A ;Year
OUTSTR [ASCIZ/ at /]
LDB A,[POINT 11,WRTFI2,23] ;Get time written
IDIVI A,=60
PUSH P,B
PUSHJ P,TYP2DG ;Type hours
POP P,A
PUSHJ P,TYP2DG ;Type minutes
OUTSTR [ASCIZ/
/]
JRST POPJ1
TYP2DG: IDIVI A,=10
LSH A,7
ADDI A,"0"⊗7 + "0"(B) ;Combine digits
TYPCHR (A)
POPJ P,
;EMPTEL EMPTE2 EMPTE3 EMPTY NONEMP EMPTY3 EMPTY2 EMPTY4 EMPTYE EMPTYX
EMPTEL: MOVEI B,[ASCIZ/Line is end of page./]
SKIPN C,TXTCNT(TT)
JRST EMPTE4 ;End-of-page line
TRNE C,-1
MOVEI B,[ASCIZ/Line is non-empty./]
TRNN C,-1
MOVEI B,[ASCIZ/Line is empty./]
XCT D ;Test for proper emptiness
POPJ P, ;Emptiness of line is as user said
EMPTE4: SORRYU (B) ;Wrong emptiness, tell him how
JRST POPJ1
EMPTY: SKIPA D,[TDNN T,TXTCNT(TT)] ;Look for empty lines
NONEMP: MOVE D,[TDNE T,TXTCNT(TT)] ;Look for non-empty lines
HRRZ TT,ARRLIN
MOVEI T,-1
JUMPE A,EMPTEL ;Zero arg, tell if current line is empty
SETZ C, ;E will count number of lines to move
JUMPG A,EMPTY4
SETO C, ;Will need to move up at least one line
EMPTY3: HLRZ TT,(TT) ;Backward loop
CAIE TT,PAGE
SKIPN TXTCNT(TT)
JRST EMPTYE ;Hit pagemark, lose
XCT D ;Test emptiness of line
AOJGE A,EMPTYX ;Proper emptiness--jump if got enough
SOJA C,EMPTY3
;Forward loop
EMPTY2: XCT D ;Test emptiness of line
SOJLE A,EMPTYX ;Proper emptiness--jump if got enough
EMPTY4: HRRZ TT,(TT) ;Next line
SKIPN TXTCNT(TT) ;Any more lines on this page?
JRST EMPTYE
AOJA C,EMPTY2
EMPTYE: CAMN D,@NONEMP
SORRY Not enough nonempty lines found.
CAMN D,@EMPTY
SORRY Not enough empty lines found.
JRST POPJ1
EMPTYX: MOVE A,C
JRST MOVARR ;Now move to line found
;MACLNK MACNAM MACFLG MACTXT MBYTE MREPT MPOINT
;Macro FS block defs
;MACLNK MUST BE ZERO FOR SHUFFLING ROUTINE (LSTSHF) TO FIND pointers
MACLNK←←0 ;Word containing <back>,,<forward> pointers to other macros
MACNAM←←1 ;Word containing sixbit name of macro, or one ascii char name
MACFLG←←2 ;LH has flags, RH is unused
MACTXT←←3 ;Offset where text of macro def starts (text ends with null byte)
FILMAC←←200000 ;This is a file macro--delete it when done
COMMENT ⊗ Here is what macro Free Storage looks like:
------------------------
| MACCOD | FS LENGTH | ;This is standard FS word.
|----------|-----------|
MACLNK: | PREV | NEXT | ;Pointers to (the pointer word of) the
|----------------------| ; previous and the next macro in list.
MACNAM: | SIXBIT NAME OF MACRO | ;Might be one ASCII char right justified
|----------------------|
MACFLG: | FLAGS | unused |
|----------------------|
MACTXT: | 9-BIT TEXT OF MACRO, |
| ENDING WILL NULL BYTE|
|----------------------|
| ZERO | FS LENGTH | ;Standard trailing FS word.
------------------------
Macros can be called recursively. That is, macros can call (any) macros.
The macro stack keeps track of which macros are currently being expanded.
The variable CURMAC is the pdl pointer for the macro stack; a value of zero
in this variable means no macro expansion is in progress.
There are three components of each entry in the macro calls stack.
These three parts are actually kept in three separate parallel stacks.
(1)Byte pointer into macro text in definition
(2)AOBJN word:
-<repeat count left, including current iteration>,,<iterations completed>
(3)Two half words: <RH F flags for call>,,<pointer to macro definition FS block>
These three blocks are defined below.
⊗;end of comment
IMPURE
MAXMAC←←60 ;Maximum nesting of macro calls
MBYTE: BLOCK MAXMAC ;Stack of byte pointers to macros being expanded
MREPT: BLOCK MAXMAC ;Stack of repeat args of macros being expanded
MPOINT: BLOCK MAXMAC ;Flags and pointers to FS blocks of macros being expanded
PURE
;MACINI MACIN0 ANYMAC MACLST MACLS0 MACLS3
;Macro initialization
MACINI: MOVEI C,MACEND ;Make an empty macro list
MOVEM C,MACBEG
MOVSI C,MACBEG ;Make end of list point back to header
HLLM C,MACEND+MACLNK
MACIN0: MOVEI C,MACSTA ;Default action on macro command error is
MOVEM C,STPADR ; to stop all macros in progress
POPJ P,
ANYMAC: MOVE D,MACBEG ;First macro in list
CAIE D,MACEND
JRST (E)
OUTSTR [ASCIZ/ No macros defined. /]
JRST POPJ1
MACLST: JSP E,ANYMAC ;Doesn't return if no macros
PUSHJ P,ABCRLF
SETZM TYOPNT ;Type out names of all defined macros.
OUTSTR [ASCIZ/Macros defined: /]
MOVEI E,=44
PUSHJ P,MACLS3 ;Loop through macro list, typing out each name
JFCL ;No other special action for each macro
POPJ P,
MACLS0: MOVE A,MACNAM(D)
SETZ T, ;T will be number of suppressed trailing blanks
PUSHJ P,MACTYO ;Type out sixbit name
SUBI E,7
ADD E,T ;Number of spaces not used (short name)
TYPCHR " "
POPJ P,
MACLS3: XCT @(P) ;See if we should list this macro
PUSHJ P,MACLS0 ;Yes, type out its name
HRRZ D,MACLNK(D) ;Next macro
CAIN D,MACEND
JRST POPJ1 ;End of macro list
JUMPG E,MACLS3
MOVEI E,=60 ;Max number of columns we'll use per line
PUSHJ P,ABCRLF
JRST MACLS3
;⊗ CASE CASEL CASERR MACCAL ZMACRO ZMAC0 ZMAC1 MQUICK LOADZM LOADZL LOADZ2 ZMAC2 ZMAC2A ZMAC2B ZMAC3 ZMAC3A ZMAC4 ZMAC5
;CASE command calls nth macro named in command line, where n is repeat arg.
;Counts macros names from left to right starting with 0.
CASE: JUMPL A,MACABT ;Arg must be non-negative
CAIE C,15 ;Terminating char must be CR
JRST MACABT
PUSHJ P,XTDLIN ;Prepare to reread extended command line
CASEL: SETZ Q, ;Don't save actual input
PUSHJ P,GETWRD ;Collect sixbit word in TT, mask in XMSK
JRST CASERR ;No word found
JUMPN A,CASERR ;Terminating char of word was activator
SOJGE A,CASEL
SETZM TYIPNT ;Don't read from command line any more
MOVEI A,1 ;Use this repeat arg for macro call
TRZ F,ARG!REL!NEG ;Make it look like no repeat arg was typed
JRST ZMAC3 ;Now call named macro
CASERR: SORRY Not enough macro names in CASE command.
JRST POPJ1
;Y command: Call the last macro that was called or defined from the top level.
MACCAL: MOVE TT,LSTMAC ;Get name of last macro called or defined
JRST ZMAC3 ;Now call this macro
;Z command: Call a named macro (cmd is ⊗Z<macro name><cr>).
ZMACRO: SKIPE DPY
PUSHJ P,CMDCRL ;Put out CRLF if line long on display
PUSHJ P,LOADM0 ;Make sure ALLACT is ignored in line editor.
ZMAC0: OUTSTR [ASCIZ/ Macro? /]
PUSHJ P,DISP
XCT LINTST
PUSHJ P,LECLR ;Make sure line editor is in page printer
SETZ Q, ;Don't collect text of line
PUSHJ P,GETWRD ;Get macro name into TT
JRST ZMAC2 ;No command given means use null macro name
JRST ZMAC2 ;Terminating char of command was activator
CAIN C,"." ;See if this is a readonly variable
SETO Q, ;Apparently, flag it for ZMAC2
ZMAC1: PUSHJ P,TYI ;Find activator
JRST ZMAC2
JRST ZMAC1
;Here for top-digit command to call macro of same name as command.
MQUICK: MOVEI TT,(C) ;Get name of macro from name of command
JRST ZMAC3 ;Try to call that macro
;load line editor with last macro name given in ⊗Z cmd. preserve A and B
;(arg and bucky bits).
LOADZM: MOVE TT,[POINT 7,C] ;collect ascii in C and D
MOVE T,[POINT 6,LSTZMC] ;read from last sixbit name
MOVEI Q,6
LOADZL: ILDB D,T ;get sixbit char
JUMPE D,LOADZ2 ;jump if end of name
ADDI D,40 ;make ascii
IDPB D,TT ;save ascii (last char goes into D!)
SOJG Q,LOADZL
LOADZ2: MOVEI Q,"." ;maybe it was a readonly variable name
SKIPE LSTZRD ;skip unless readonly variable (ended with dot)
IDPB Q,TT ;insert a dot for reedited line
MOVEI Q,15
IDPB Q,TT ;terminate ascii with CR
PTLOAD [0↔C] ;load line editor
JRST ZMAC0 ;go repeat ⊗Z's scan of edited macro name
ZMAC2: JUMPE TT,ZMAC2A ;don't clobber old name if no new one
MOVEM TT,LSTZMC# ;remember macro name for ⊗Zα<cr>
MOVEM Q,LSTZRD# ;save flag indicating if readonly var name seen
ZMAC2A: SKIPG CURMAC ;don't allow α<cr> from inside a macro
SKIPN DPY ;don't allow α<cr> to reload line if not dpy
JRST ZMAC2B ;in macro or not a display, no α<cr> allowed
CAIN C,215 ;α<cr>, with no name given?
JUMPE TT,LOADZM ;jump if so, load line with last macro name
ZMAC2B: CAIE C,15
JRST MACABT ;Macro call has to end with plain CR
JUMPN Q,RDVTYP ;This is a readonly variable ended with dot
ZMAC3: SKIPG CURMAC
SETZM NSTEP ;Calling macro at top level, flush step count
ZMAC3A: PUSHJ P,FNDMAC
JRST MACUND ;No such macro
JUMPE A,MACTYP ;Type out name and def
JUMPL A,MACABT ;Currently a noop
MOVEI T,0 ;Flag not calling a file macro
ZMAC4: AOSG C,CURMAC#
JRST [SETZM CURMAC↔JRST .-1] ;Don't let CURMAC be negative
CAIL C,MAXMAC
JRST MACPOV ;Macro PDL overflow
SETOM NOSTEP ;Suppress display update before first macro step
CAILE C,1
JRST ZMAC5 ;Not calling top level macro
SETZM NOALTM ;enable altmode at end of top level macro
IFE DECSW,<
SETOM ODDSCN ;Tell DCURS to avoid LE cursor's scanline once
>
SETZM MACINS# ;Calling macro at top level, no special action
JUMPN T,ZMAC5 ;Jump if calling a file macro
TLNN TT,-1
TRNN TT,-1 ;Don't remember single char ascii name
MOVEM TT,LSTMAC# ;Remember last macro called from outer level (for Y)
ZMAC5: SETZM SAVMAC# ;No interrupted macro to resume
MOVN A,A ;Negate repeat arg
HRLZM A,MREPT(C) ;And store in AOBJN form
MOVEI A,MACTXT(D) ;Make byte pointer to text of macro def
HRLI A,441100
MOVEM A,MBYTE(C) ;And store for this call
HRRZM D,MPOINT(C) ;Remember what macro we're calling
HRLM F,MPOINT(C) ;Also store the ARG,REL,NEG flag bits for this call
AOS (P) ;Don't say OK, especially if from line editor
SKIPG BLAB ;Suppress message unless verbose mode
POPJ P,
OUTSTR [ASCIZ/ Calling /]
JRST MACSAR ;Type out repeat arg and name of macro being called
;MALTMO MALTM2 MACCHR MACCH0 MACCH2 MACCH3 MACPOP NOMACS SAYEND MACSAR MACSAY MACSR2 MACRPT
;Here for ⊗X MALTMODE command to enable/disable altmode that comes at end of
;top level macro expansion.
MALTMO: JUMPE A,MALTM2 ;zero arg is status report
SKIPL A
SETZM NOALTM ;positive arg enables altmod
SKIPG A
SETOM NOALTM ;negative arg disables altmod
POPJ P,
MALTM2: SKIPL NOALTM ;skip if suppressed
OUTSTR [ASCIZ / Macro-ending altmode is Enabled. /]
SKIPGE NOALTM ;skip if enabled
OUTSTR [ASCIZ / Macro-ending altmode is Disabled. /]
JRST POPJ1
;Here to get next character from current macro.
MACCHR: SETZ C,
EXCH C,MACINS# ;Any special instructions for us?
JUMPE C,MACCH2
MACCH0: TRNN C,-1 ;Yes. RH is adr of top priority routine
MOVS C,C ;No RH adr, use LH adr
JRST (C)
MACCH2: SKIPG C,CURMAC
PUSHJ P,TELLZ ;Shouldn't happen--no macro call on macro stack
ILDB C,MBYTE(C) ;Get char from macro def
JUMPE C,MACCH3 ;Jump if end of macro
SKIPG NSTEP ;Skip if doing fixed number of steps
SKIPLE STEPIT ;Skip if not auto-stepping macros
PUSHJ P,PRNTC4 ;Stepping macros, type out char from macro
JRST POPUP ;Return up a level with char
MACCH3: PUSH P,A
MOVE C,CURMAC
MOVE A,[1,,1]
ADDB A,MREPT(C) ;Count an iteration done for this macro call
JUMPG A,MACPOP ;Jump if all requested iterations done
HRRZ A,MPOINT(C) ;Get pointer to current macro
ADD A,[441100,,MACTXT] ;And make a new byte pointer to its text
MOVEM A,MBYTE(C) ;Now execute current macro again
POP P,A
JRST MACCHR
MACPOP: POP P,A
SKIPLE BLAB ;Suppress message unless verbose mode
PUSHJ P,SAYEND ;Tell user macro ended
SOSLE C,CURMAC ;Pop up a level in macro stack
JRST MACCHR ;And get a char from uplevel macro
SKIPE NFLMAC# ;Any file macros still defined?
PUSHJ P,FMUNDF ;Yes, undefine them all now
SKIPE NOALTM# ;is the ending altmode being suppressed?
POPJ P, ;yes, return from TYICHK to read from TTY
NOMACS: MOVEI C,ALTMOD ;All macros done
JRST POPUP ;So return an altmode
SAYEND: OUTSTR [ASCIZ/ Ending /]
SKIPA C,CURMAC ;Get index of macro call ending, fall into MACSAY
MACSAR: PUSHJ P,MACRPT ;Type out remaining repeat count
MACSAY: PUSH P,T ;Routine to type out macro level and macro name.
PUSH P,TYOPNT
SETZM TYOPNT ;Force output to tty
OUTCHR ["("]
TYPDEC C ;Tell him level of macro call
OUTCHR [")"]
HRRZ T,MPOINT(C)
TYPMAC MACNAM(T) ;Type out macro's name
OUTCHR [" "]
MACSR2: POP P,TYOPNT ;Restore previously directed output
JRST POPTJ
MACRPT: PUSH P,T
PUSH P,TYOPNT
SETZM TYOPNT
HLRE T,MREPT(C) ;Get remaining repeat count
MOVN T,T
CAIG T,1
JRST MACSR2 ;Don't type out unitary repeat arg
TYPCHR "["
TYPDEC T ;Type out remaining repeat count
TYPCHR "X]"
JRST MACSR2
;STOPZE STOPAL STOPON STOPHO MACSTP MACSTO MACBRK MACST4 MACST3 MACESC MACSTA MACST5 MACST6 MACSTS MACSTX MACPOV
STOPZE: TRNE F,ARG!REL
JRST STOPHO
SETZM STPADR ;Set condition not to stop any macros on error
POPJ P,
STOPAL: SKIPA T,[MACSTA] ;Set condition to stop all macros on error
STOPON: MOVSI T,MACSTO ;Set condition to stop only current macro on error
TRNE F,ARG!REL
JRST STOPHO
MOVEM T,STPADR
POPJ P,
STOPHO: PUSHJ P,ABCRLF
MOVE T,STPADR ;Get the macro stopping dispatch address
MOVEI TT,[ASCIZ/ be ignored by macros (STOPZERO). /]
TLNE T,-1
MOVEI TT,[ASCIZ/ end the current macro (STOPONE). /]
TRNE T,-1
MOVEI TT,[ASCIZ/ abort all macros (STOPALL). /]
OUTSTR [ASCIZ/Any error will/]
OUTSTR (TT)
JRST POPJ1
MACSTP: PUSH P,T
SKIPN T,STPADR#
JRST POPTJ ;Don't stop any macros
TLNE T,-1
HLLM T,MACINS# ;Low priority interrupt (stop current macro)
TRNE T,-1
HRRM T,MACINS# ;High priority interrupt (stop all macros)
JRST POPTJ
;Subroutine to abort current level of macro expansion
MACSTO: SKIPGE BLAB ;Suppress message in terse mode
JRST MACST3 ;Shhhh!
JRST MACST4 ;Say something
MACBRK: OUTSTR [ASCIZ/ BRK I --/]
MACST4: OUTSTR [ASCIZ/ Aborting macro /]
MOVE C,CURMAC
PUSHJ P,MACSAR ;Type remaining repeat count and macro name
MACST3: SOSLE C,CURMAC
JRST MACCHR ;Get a char from next macro up
MOVEI C,1
MOVEM C,SAVMAC ;Let him resume if he fell out at top level
JRST NOMACS ;No macro expansions left
MACESC: OUTSTR [ASCIZ/ ESC I --/]
MACSTA: MOVE C,CURMAC
CAIN C,1
JRST MACST4 ;Only one macro to abort
OUTSTR [ASCIZ/ Aborting all macros in /]
MACST5: PUSHJ P,MACSAR ;Type remaining repeat count and macro name
MACST6: MOVEM C,SAVMAC# ;Save macro pdl pointer for resuming later
SETZM CURMAC ;Flush current macros
JRST NOMACS ;Return an altmode char
;Here when time to stop stepping macro
MACSTS: SKIPE MACIN2 ;Any saved instructions for us?
JRST MACSTX ;Yes, come back here later after doing other stuff
MOVE C,CURMAC
SKIPE NSTEP2 ;Never give message for ⊗& cmd
SKIPGE BLAB ;Suppress message in terse mode
JRST MACST6
OUTSTR [ASCIZ/ Stepping done, in /]
JRST MACST5
;Here from MACCHR via MACSTS, with C still containing MACSTS in RH.
MACSTX: EXCH C,MACINS ;Make us come back if still going after next routine
EXCH C,MACIN2 ;Pick up saved instructions and clear saved version
JRST MACCH0 ;Go execute saved instructions
MACPOV: SOS CURMAC ;Undo AOS we just did, flushing this new macro call
SORRF Macro pushdown list overflow on call to macro
SETZM TYOPNT
TYPMAC TT ;Type macro name
JRST PPJ1CR
;RESUME RESUM2 CONTNO CONTI2 CONTI3
;Here for XRESUME command to resume a macro execution stopped by ESC I, etc.
RESUME: SKIPG C,SAVMAC ;Any saved macro PDL pointer from interruption?
JRST CONTNO ;No
TRNE F,ARG!REL
JRST CONTI2 ;Just tell him what resuming will do
RESUM2: MOVEM C,CURMAC ;Yes, restore it so we can resume from there
SETOM NOSTEP ;Suppress display update before first macro step
SETZM SAVMAC ;Can't resume again unless stopped again
SETZM MACINS ;Haven't been interrupted now
POPJ P,
CONTNO: SORRY No macro expansion to resume.
JRST POPJ1
CONTI2: PUSHJ P,ABCRLF
MOVM A,A
SUB C,A
JUMPG C,.+2
MOVEI C,1 ;Can't type out anything beyond bottom of stack
CAME C,SAVMAC
OUTSTR [ASCIZ/Currently in /]
CAMN C,SAVMAC
OUTSTR [ASCIZ/Can resume /]
PUSHJ P,MACSAR ;Type remaining repeat count and macro name
MOVE B,MBYTE(C) ;Get byte pointer into macro
ILDB A,B
JUMPN A,CONTI3 ;Jump if any chars left in macro def
OUTSTR [ASCIZ/with no text left. /] ;Expansion has reached end of def
JRST POPJ1
CONTI3: OUTSTR [ASCIZ/at /]
SETOM MFROOM ;Don't put out any CRLFs in middle of def
SETZM TYOPNT ;Force typeout to TTY
PUSHJ P,PUTMA1 ;Type out remainder of macro def
JFCL ;Don't care about long output lines for def
JRST OUTSPC ;Type out a space and skip return
;ABORT ABORT5 ABORT6 ABORT2 ABORT4 ABORT3
ABORT: JUMPE A,CPOPJ ;Aborting zero levels of macros is easy
MOVM A,A
TRNN F,ARG!REL ;Any arg given?
MOVEI A,-1 ;No, flush all levels
SKIPG C,CURMAC ;Are we inside a macro?
JRST ABORT2 ;No, adjust SAVMAC
SUB C,A ;Flush some number of macro levels
JUMPLE C,ABORT3 ;Flush all levels
EXCH C,CURMAC
SUB C,CURMAC
MOVEI T,0
MOVE TT,CURMAC ;For typing out name of macro we were in
ABORT5: SKIPGE BLAB ;Suppress message if terse mode
POPJ P,
OUTSTR [ASCIZ/ Abort of /]
SETZM TYOPNT
TYPDEC C
SKIPE T
OUTSTR (T)
OUTSTR [ASCIZ/ macro/]
CAIE C,1
OUTCHR ["s"]
ADD C,TT ;Find index of top macro just flushed
ABORT6: OUTSTR [ASCIZ/ requested from /]
PUSHJ P,MACSAR ;Type remaining repeat count and macro name
JRST POPJ1
ABORT2: SKIPG C,SAVMAC ;Any resumable macro call?
JRST CONTNO ;No call to resume
SUB C,A ;Flush some number of macro levels for XRESUME
JUMPLE C,ABORT4 ;Doesn't make sense to flush all resumable levels
EXCH C,SAVMAC
SUB C,SAVMAC
MOVEI T,[ASCIZ/ resumable/]
MOVE TT,SAVMAC
JRST ABORT5
ABORT4: SORRY Cannot abort all levels of resumable macro stack.
JRST POPJ1
ABORT3: MOVE C,CURMAC ;Save macro pdl pointer
MOVEM C,SAVMAC ; so we can resume later
SETZM CURMAC
OUTSTR [ASCIZ/ Abort of all macros/]
JRST ABORT6
;MACDEF MACDE2 MACDE3 MACDE4 MACAB0 CTMTLF MACCHK MACB00 MACBN0 MACBNM
MACDEF:
IFN DECSW,< ;NO MACRO DEFS ALLOWED ON TTYS YET IN TOPS-10
SKIPN DPY
JRST EXTNF2
>
JUMPE A,MACLST ;Zero causes all defined macros to be listed
PUSHJ P,GETMAC ;Get name of macro into TT
JUMPL A,MACUDF ;Undefine this macro
PUSHJ P,MACCHK ;Do we have a valid macro name?
JRST MACBNM ;No, say bad name
PUSHJ P,MACSET ;Set up expandable FS for macro def
MOVSI TT," M"⊗4 ;yes
HLLM TT,EMFLG ;Flag to user that we're in macro defining mode
SETOM NEEDHD ;set flag to make HEADS think about hdr line
SETOM LINFLG ;Tell CMRTR2 that we want line mode input
SETZM LINFL2 ;And don't let ESC I change mode
MOVE A,E ;move byte ptr to AC not clobbered by CMRTR2
TRO F,ARG ;no CRLF typeout, avoid calling LSCHK, in CMRTR2
SKIPLE CURMAC
JRST MACDE3 ;Def is coming from macro expansion, don't prompt
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Type character string for macro /]
SETZM TYOPNT
TYPMAC MACNAM-MACTXT(A) ;Type macro name given
PUSHJ P,CTMTLF ;tell what to end def with
JRST MACDE3
MACDE2:
LEG IDPB C,A ;Store character of macro definition
MACDE3: PUSHJ P,CMRTR2 ;get line mode char, maybe update display
JUMPE C,MACDE4
CAIE C,612 ;↑Z OR αβ<LF> is end of def
JRST MACDE2
MACDE4: MOVE E,A ;get final byte ptr where we need it
HRRZS EMFLG ;Clear "M" from hdr line by time we get out
SETOM NEEDHD ;set flag to make HEADS think about hdr line
JUMPL E,MACAB0 ;Don't change any old def if no chars in new def
PUSHJ P,MACFIN ;Finish off macro def
JRST MACTY0 ;Type out name and new def
MACAB0: PUSHJ P,ENDFIX ;Close off expanding FS that we didn't use
JRST MACABT
CTMTLF: OUTSTR [ASCIZ/ ending with /]
SKIPN DPY
OUTSTR [ASCIZ/<control>Z
/]
SKIPE DPY
OUTSTR [ASCIZ/<CONTROL><META><LINEFEED>
/]
POPJ P,
;Routine to check macro name for validity. Skips if name is ok.
MACCHK: JUMPLE TT,POPJ1
CAIL TT,200 ;Is this a single char macro name?
JRST POPJ1 ;No
HLL TT,JCTAB(TT) ;Yes
TLNE TT,MACF ;Valid single char for macro name?
AOS (P) ;Yes
TLZ TT,-1 ;Restore TT
POPJ P,
MACB00: HRRZS EMFLG ;clear possible "R" from hdr line
SETOM NEEDHD ;set flag to make HEADS think about hdr line
MACBN0: SETZM TYIPNT ;Flush rereading of remainder of extended cmd line
MACBNM: SORRF Invalid macro name --
SETZM TYOPNT
TYPMAC TT ;Type out bad macro name
JRST OUTSPC ;Type out space and take skip return
;MACSET MACFIN MACFI0 MACFI1 MACFI2 YSET
MACSET: PUSH P,TT ;Save macro name
PUSHJ P,ENDSET ;Allow FS to expand off end of core
MOVE E,FSEND ;Get starting address of our macro FS block
COMMENT ⊗ Here is a temp kludge to avoid FS lossage resulting from a file
macro ending with an incomplete macro definition. That causes MACCHR to
call FMUNDF which undefines the file macro and calls FSGIVE to return the
FS, which FSGIVE may try to link up to a following free FS block, which
might be our expanding FS block. The next instruction makes our block
look used. ⊗
LEG HRRZS (E) ;a temp kludge
ADD E,[441100,,1+MACTXT];Make byte pointer for depositing text
LEG POP P,MACNAM-MACTXT(E) ;Place macro name into FS block
POPJ P,
;Routine to finish up macro FS and flush any old macro of the same name.
;File macros and numeric macros enter at MACFI0 to preserve default Y macro
MACFIN: TDZA C,C ;Defining normal macro, set default Y macro
MACFI0: MOVSI C,200000 ;Non-zero to avoid setting default Y macro
LEG IDPB C,E ;Mark end of macro def.
ADDI E,2
MOVSI T,MACCOD
FSFIX E,T
SUBI E,-1(T) ;Get pointer to beginning of FS blk
PUSHJ P,ENDFIX ;Close off expanding FS
SETZM MACFLG(E) ;No flags yet for this new macro
MOVE TT,MACNAM(E) ;Get name of this macro
JUMPN C,MACFI1 ;Jump if defining a file macro
TLNN TT,-1
TRNN TT,-1 ;Don't remember single ascii char macro name
JRST .+2
JRST MACFI1
SKIPG CURMAC ;Don't change default Y macro if defined by macro
MOVEM TT,LSTMAC# ;Remember last macro defined (for Y cmd)
MACFI1: PUSHJ P,FNDMAC ;Look for old macro of same name
JRST MACFI2 ;Name not already in list
MOVE T,MACLNK(D) ;Get link word for macro being replaced
MOVEM T,MACLNK(E) ;And place in new def
HRLM E,MACLNK(T) ;Make next macro point back to new version
MOVS T,T ;Get pointer to previous macro
HRRM E,MACLNK(T) ;Make previous macro point forward to new version
TLO F,NOCHK ;Don't let FSGIVE shuffle FS
PUSHJ P,MACUD0 ;Undefine the old version (pointed to by D)
TLZ F,NOCHK
POPJ P,
;Here if no old macro with name as new one. Ptr to macro to follow new one is in D.
;Pointer to new macro's FS is in E.
MACFI2: HLRZ T,MACLNK(D) ;Get pointer to macro that new one should follow
HRLM E,MACLNK(D) ;Make following macro point back to new one
HRRM E,MACLNK(T) ;Make previous macro point forward to new one
HRL T,D
MOVSM T,MACLNK(E) ;Make new macro point to its neighbors
POPJ P,
;Here for ⊗XYSET command to set name of macro called by ⊗Y command.
YSET: JUMPE A,YSET2 ;Zero arg means type out name of current ⊗Y macro
JUMPL A,MACABT ;negative arg is undefined
PUSHJ P,GETMAC ;Get name of macro into TT
PUSHJ P,MACCHK ;Do we have a valid macro name?
JRST MACBNM ;No, say bad name
MOVEM TT,LSTMAC# ;Remember last macro called from outer level (for Y)
POPJ P,
YSET2: OUTSTR [ASCIZ/Current ⊗Y macro is: /]
SETZM TYOPNT
SKIPE LSTMAC
TYPMAC LSTMAC ;type name of macro
SKIPN LSTMAC
OUTSTR [ASCIZ/<blank name>/] ;type name of macro
OUTCHR [" "]
JRST POPJ1
;GETMAC GETMA2 GETMA0 GETMA3 MACSHF MACSH2 MACSH3 FMUNDF FMUNDL FMUND0
;Routine to get macro name into TT from extended command buffer.
GETMAC: PUSHJ P,XTDLIN ;Prepare to reread extended command line
GETMA2: PUSHJ P,GETMA3 ;get name into TT
JFCL ;hit activator
SETZM TYIPNT
POPJ P,
;read macro name into TT, but don't flush remainder of cmd line.
;skip unless hit activator.
GETMA0: PUSHJ P,XTDLIN ;set up extended cmd line to be reread
GETMA3: SETZ Q, ;Don't save actual input
PUSHJ P,GETWRD ;Collect sixbit word in TT, mask in XMSK
POPJ P, ;No word found (hit activator)
POPJ P, ;Terminating char of word was activator
JRST POPJ1 ;no activator seen
;Here from FS shuffler to adjust FS pointers for macro FS
MACSHF: PUSHJ P,LSTSHF ;Fix up our neighbors' pointers within macro list
MOVE TT,[-MAXMAC+1,,1]
MACSH2: HRRZ T,MPOINT(TT)
CAIE T,1(A) ;Is this a call of the macro being shuffled?
JRST MACSH3 ;No
ADDM C,MPOINT(TT) ;Fix up the macro pointer
ADDM C,MBYTE(TT) ; and the byte pointer
MACSH3: AOBJN TT,MACSH2
POPJ P,
;Here to undefine all file macros
FMUNDF: PUSH P,A ;Save some ACs clobbered
PUSH P,D
PUSH P,T
PUSH P,TT ;(clobbered by FSGIVE)
PUSH P,F ;Save current state of NOCHK flag
TLO F,NOCHK ;Don't let FSGIVE shuffle FS
MOVE D,MACBEG ;Get pointer to first macro
JRST FMUND0
FMUNDL: MOVE A,MACFLG(D) ;Get this macro's flags
TLNE A,FILMAC ;Is it a file macro?
PUSHJ P,MUNDEF ;Yes, undefine it
HRRZ D,MACLNK(D) ;Get pointer to next macro
FMUND0: CAIE D,MACEND
JRST FMUNDL ;Check next macro in the list
SKIPE NFLMAC ;Should have no file macros left now
PUSHJ P,TELLZ ;Oops, we seem to have lost count of file macros
POP P,A
TLNN A,NOCHK ;Restore old state of NOCHK
TLZ F,NOCHK ;It was off, so turn if back off
POP P,TT
POP P,T
POP P,D
JRST POPAJ
;MACUN0 MACUND MACUDF MUNDEF MACUD0 MACUD1 MACUD3 MACUD4
MACUN0: PUSH P,TT ;Save macro name
PUSHJ P,ENDFIX ;Close expandable FS
POP P,TT
MACUND: SORRJ Macro
SETZM TYOPNT
TYPMAC TT
OUTSTR [ASCIZ/ not defined. /]
JRST POPJ1
MACUDF: PUSHJ P,FNDMAC ;Undefine macro whose name is in TT
JRST MACUND ;No such macro
MUNDEF: MOVE T,MACLNK(D) ;Remove element from macro list
HLLM T,MACLNK(T) ;Link back from next to prev
MOVS T,T
HLRM T,MACLNK(T) ;Link forward from prev to next
MACUD0: SKIPG C,CURMAC ;Is the macro stack in use?
SKIPLE C,SAVMAC ;Well, is it?
PUSHJ P,MACUD1 ;Yes, flush refs to this macro from macro stack
MOVE T,MACFLG(D)
TLNE T,FILMAC ;Was this a file macro?
SOS NFLMAC# ;Yes, count one less file macro around
MOVEI A,(D)
JRST FSGIVE ;Return the free storage
MACUD1: HRRZ T,MPOINT(C)
CAIN T,(D) ;Is macro that is being undefined currently running?
PUSHJ P,MACUD3 ;Yes, make it stop
SOJG C,MACUD1
POPJ P,
MACUD3: JUMPL D,MACUD4
SKIPGE BLAB ;Suppress message in terse mode
JRST MACUD4
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Calls on stack deleted for macro /]
PUSHJ P,MACSAY
HRLI D,-1 ;Don't say this again
MACUD4: MOVEI T,UNDEFM
MOVEM T,MPOINT(C) ;Replace macro name with special one
SETZM MBYTE(C) ;Flush byte pointer, thus terminating this expansion
HRROS MREPT(C) ;Flush repeat count
POPJ P,
;FNDMAC FNDMA2 FNDMA3 MACTY0 MACTYP PPJ1SP OUTSPC UNDEFM MACBEG MACEND TTYPNT MACDFL MACFIL EINITF
;Routine to find FS block of macro whose name is in TT.
;Skip returns if found. On either return, D contains first macro at or beyond TT.
FNDMAC: SKIPA D,MACBEG ;Get pointer to first macro def
FNDMA2: HRRZ D,MACLNK(D) ;Next macro
FNDMA3: CAMLE TT,MACNAM(D) ;FNDVAR enters here to search for variable
JRST FNDMA2
CAMN TT,MACNAM(D) ;Is there already a macro with this name?
AOS (P) ;Yes
POPJ P,
;Routine to type out name and maybe definition of macro pointed to by E.
MACTY0: MOVE D,E
SKIPLE CURMAC ;Defining macro inside a macro?
POPJ P,
;Routine to type out name and defintion of macro pointed to by D.
MACTYP: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Macro /]
SETZM TYOPNT
TYPMAC MACNAM(D)
OUTSTR [ASCIZ/ defined as: /]
PUSHJ P,PUTMA0 ;Type out macro definition in 7-bit representation
JFCL ;Instruction executed when output line gets long
PPJ1SP::
OUTSPC: OUTCHR [" "]
JRST POPJ1 ;Don't say OK
UNDEFM: .,,.
SIXBIT/.UNDEF/
0 ;No flags
0 ;No text
IMPURE
MACBEG: MACEND ;Pointer to first macro in list
MACEND: MACBEG,,. ;Final element in macro list--points to self
377777,,-1 ;Greatest possible macro name
0 ;No flags
0 ;Text of macro--nothing
TTYPNT: 0 ;These two words used by MACLIN
0 ;Byte ptr gets stuffed here for PTWRS9 on TTY.
0 ;/F switch cell for FILERR
'DSK ' ;Indirect device
MACDFL: 'EINIT ' ;Block for indirect filename--this is default file
'CMD ' ; for ⊗XEXECUTE and PUTDEFS
0
0
0 ;/N cell for FILERR
BLOCK 2 ;/F cell for FILERR and indirect file's device
MACFIL: BLOCK 5 ;Temporarly storage for indirect filename
EINITF: -1 ;Non-zero means execute EIN tmpcor file on startup
PURE
;MACLIN MACL02 MACL05 MACL03 MACL04 MACL01 MACLN0 MACLN1 MACLN4 MACLN8 MACL4C MACL8C MACL84 MACKLD MACLN7 MACLN2 MACLN3 MACLN5 MACLN6 MACLT2 MACLTT
;Here from EDGL to get chars from macro def that should go into line editor.
MACLIN: MOVEM D,TTYPNT+1 ;On TTY, we do PTWRITE of line.
MOVEM C,MACKLU ;No α<tab> seen yet, unless it was initial char
ANDI C,737 ;Make it upper case but preserve control bits
LDB TT,[POINT 7,BUF,6] ;Pick up first char of line to be edited
CAIE TT,15 ;If it is CR, then we have an empty line
JRST MACL02 ;Not empty line, no early activation
MOVEI TT,211 ;Empty line means we are definitely at end
MOVEM TT,MACKLU ;So indicate that by putting α<tab> into flag
CAIE C,200!"D"
CAIN C,200!"I"
POPJ P, ;αD or αI on empty line is activator already
MACL02: AOSN STEPLE# ;Did we just clean up the LE?
JRST MACL01 ;Yes, step the macro now!!
CAIE C,200!"K"
CAIN C,200!"S"
JRST MACL04 ;Initial αS or αK has to gobble arg before stepping
CAIE C,200!"L"
CAIN C,200!"B"
JRST MACL03 ;This shouldn't happen, since these are E cmds
CAIN C,200!"I" ;We can't stop after αI because that would
JRST MACLN0 ; accidentally get us out of LE insert mode
MACL05: MOVE C,MACKLU ;Have we managed to get to the end of line
CAIN C,211 ; with a α<tab> (or equivalent)?
JRST MACLN0 ;Yes, so can't stop now or we would forget that!
SKIPE DPY ;I'm not sure how macro stepping works on non-dpys
PUSHJ P,STEPCK ;See if time to step the macro
JRST MACLN0 ;No
SETOM STEPLE ;Flag that fake activator being stuffed in LE
MOVEI C,12 ;Use a LF as activator (anything works but CR)
IDPB C,D ;Put into "typeahead" buffer
POPJ P, ;Now wait for it to come back
MACL03: SKIPA T,[MACL4C] ;Backward search
MACL04: MOVEI T,MACL8C ;Forward search
PUSHJ P,(T) ;Get and store arg for LE search cmd
JRST MACL05 ;Now think about stepping macro (still in progress)
JRST MACLN3 ;Macro ended
MACL01: PUSHJ P,DISP6A ;All ready -- update display and pause
JFCL ;Always skips
MACLN0: MOVEI C,(D) ;Make sure we haven't overflowed buffer!
CAIL C,PBUFE-3 ;Leave a little room to spare
SORRF Macro text for line editor is too long.
PUSHJ P,TYI ;Get char from def
JRST MACLN2 ;Might be activator
MACLN1: IDPB C,D ;Not activator, stuff it
TRNE C,600 ;If no control bits, don't touch α<tab> flag
MOVEM C,MACKLU# ;Save char for α<tab>αD kludge
JRST MACLN0
MACLN4: SKIPA T,[MACL4C] ;Routine for backward search arg
MACLN8: MOVEI T,MACL8C ;Forward search
IDPB C,D ;Store αK or αS or αL or αB
PUSHJ P,(T) ;Process arg of search
JRST MACLN0 ;Get next char from macro (still in progress)
JRST MACLN3 ;Macro ended
MACL4C: PUSHJ P,MACL84 ;Store the arg of the backward search
JRST POPJ1 ;Macro ended
SETZM MACKLU ;Not (necessarily) at end of line now
POPJ P,
MACL8C: PUSHJ P,MACL84 ;Store the arg of the forward search
JRST POPJ1 ;Macro ended
XORI C,15≥11 ;αS or αK followed by CR simulates α<tab>
TRO C,200 ;Make it α<something>
ANDI C,377 ;But make sure β is off
MOVEM C,MACKLU ;Remember whether we are at end of line or not
POPJ P, ;This also ensures αKα<tab> doesn't set α<tab> flag
MACL84: PUSHJ P,TYI ;Get char arg of line editor cmd
JFCL ; Always is arg, never activator here
IDPB C,D ;Put in the arg
SKIPE CURMAC ;Just in case αK,αS,αL, or αB was last char in macro
AOSA (P) ;Get more line editor stuff
MOVEI C,ALTMOD ;Macro ended--get an altmode to throw away
POPJ P,
MACKLD: MOVE TT,MACKLU ;Get last character output--αD, αI activate at eol
CAIE TT,211 ;So we figure we're at eol if last char was α<tab>
JRST MACLN1 ;Just line editor command (hope, hope!)
JRST MACLN3 ;Activator, that's enough for line editor (for sure)
MACLN7: CAIE C,415 ;Meta CR?
CAIN C,412 ;Meta LF?
JRST MACLN3 ;Activator
CAIE C,ALTMOD+400 ;Meta Altmode?
JRST MACLN1 ;Meta <non-activator> is a line editor command
JRST MACLN3 ;Activator
MACLN2: CAIE C,777
CAIN C,640 ;αβ<bs> and αβ<space> are both line editor cmds
TRZA C,400 ;But turn off β to avoid possibly repeating
CAIN C,177 ;<bs> is a line editor command.
JRST MACLN1 ;Line editor cmd
LDB TT,[POINT 2,C,28] ;Get control bits.
CAIN TT,2
JRST MACLN7 ;Meta almost anything is line editor command.
CAIE TT,1
JRST MACLN3 ;Not a line editor command, must be activator.
LDB TT,[POINT 7,C,35] ;Char without bits
CAIN TT,14 ;α<FF>?
JRST MACLN1 ;A line editor command.
CAIL TT,"0"
CAILE TT,"9"
CAIN TT,177 ;α<BS>?
JRST MACLN1 ;Control digits and α<BS> are line editor commands
CAIE TT,"K"
CAIN TT,"k"
JRST MACLN8 ;Line editor command with following arg
CAIE TT,"S"
CAIN TT,"s"
JRST MACLN8 ;Line editor command with following arg
CAIE TT,"B"
CAIN TT,"b"
JRST MACLN4 ;Line editor command with following arg
CAIE TT,"L"
CAIN TT,"l"
JRST MACLN4 ;Line editor command with following arg
CAIE TT,"T"
CAIN TT,"t" ;αT is special case 'cause it isn't LE command
JRST MACLN1 ; when not already in LE (bit off in CTAB)
CAIE TT,"D"
CAIN TT,"d" ;Jesus, there are a lot of special cases here!
JRST MACKLD ;αD activates if at end of line
CAIE TT,"I"
CAIN TT,"i" ;And now for the αI kludge
JRST MACKLD ;Activates if at end of line
MOVE TT,CTAB(TT)
TLNE TT,100
JRST MACLN1 ;A line editor command, stuff in buffer and go on.
MACLN3: SKIPN DPY
JRST MACLTT ;Do special stuff for non-display
MACLN5: SKIPN CURMAC ;Still expanding macro?
CAIE C,ALTMOD ;No, is this the extra altmode inserted?
MACLN6: IDPB C,D ;No, put it into buffer for PTL7W9
SKIPE DPY
POPJ P,
IFE DECSW,<
MOVEI C,0
IDPB C,D
SETOM NOSTEP ;Suppress display updating here if stepping macro
PUSHJ P,DISP
JFCL ;Always update display (unless still inside macro).
PUSHJ P,ABCRL0 ;Put out CRLF if necessary.
PTWRS9 TTYPNT
MOVE D,TTYPNT+1
POPJ P,
>;NOT DECSW
IFN DECSW,<
FATAL MACRO ERROR ON NON DISPLAY
>;DECSW
MACLT2: CAIE TT,ALTMOD ;Is this really an activator on TTY?
CAIN TT,12
JRST MACLN5 ;Yes
JRST MACLN1 ;Not an activator on TTY, keep reading
MACLTT: LDB TT,[POINT 7,C,35]
CAIE TT,15
JRST MACLT2
IDPB TT,D ;Put CR into string for PTWRS9
XORI C,15≥12 ; followed by LF with whatever bits there may be
JRST MACLN6
;OMFILE EXETYP SKPDIR SKPDI2 SKPDI3
;Routine to open file specified in extended command.
;Called by JSP E,OMFILE
; <instruction to XCT after reading filename>
; <return here on failure>
; <success return>
OMFILE: JUMPE A,EXETYP ;Type out default filename
TRNE F,ARG!REL
JRST MACABT ;For now this is a no-op
PUSHJ P,XTDLIN ;Prepare to reread extended command line
MOVE D,[MACDFL-2,,MACFIL-2] ;Copy default filename for merge with
BLT D,MACFIL+4 ; filename typed by user
MOVE D,[FRDRUN,,MACFIL] ;Pointer to block for collecting filename
PUSHJ P,FRD0 ;Read filename or keep current default
JFCL ;"Illegal file specification" may end with paren
XCT (E) ;Read page range if executing file
CAIE C,15
JRST RUNILL ;Leftover garbage in command is illegal
MOVE T,[MACFIL-1,,LKUP-1] ;BLT pointer for filename
MOVEI C,DSKM
PUSHJ P,OPNDEV ;Make sure device is open--skip on error
LKPMAC <LOOKUP DSKM,LKUP>
JRST 1(E) ;Single skip return on error
JRST 2(E) ;Double skip return on success
EXETYP: OUTSTR [ASCIZ/ Default file is /]
MOVE D,[FRDRUN,,MACDFL]
PUSHJ P,FILTYP ;Type filename without switches
JRST OUTSPC ;Type a space and skip return
SKPDIR: SETZM MFBLK# ;Initialize number of last record read
PUSHJ P,MFGETR ;Read in first record of file
SETOM MFCNT# ;EOF--no input bytes ready
AOS MFCNT ;We haven't really read the normal single char
TESTBP MFBYTE ;make sure byte ptr hasn't already been backed up
MOVSI T,070000
ADDM T,MFBYTE ;Back up the byte pointer over that byte
MOVE T,MACBUF
MOVE TT,MACBUF+1 ;Look at first 10 chars
CAMN T,CTEXT ;Does it start like E directory?
CAME TT,CTEXT+1
JRST SKPDI3 ;No E dir
SOSG EXEBEG ;Already ignoring page 1?
SOS EXEEND ;No, that makes the range one page shorter
SKPDI2: PUSHJ P,MFGETC ;Skip to next page (formfeed)
POPJ P, ;EOF!
CAIN C,14
SKPDI3: SOSLE EXEBEG ;Have we skipped enough pages?
JRST SKPDI2 ;No
POPJ P, ;Yes
;EXECUT EXECUN EXECUX EINFIN LCMFIN GENMCN GENMCL EXGETC EXEERR EXEER1 EXEFNF
;Routine to read macro def from entire file and then execute it
EXECUT:
IFN DECSW,< ;NO MACRO DEFS ALLOWED ON TTYS YET IN TOPS-10
SKIPN DPY
JRST EXTNF2
>
JSP E,OMFILE ;Open macro file
PUSHJ P,GRANGE ;XCTed--get any page range
JRST EXEFNF ;LOOKUP failed
;; PUSHJ P,OMFIOK ;Store away filename as new default
MOVS C,LKUP+PPN3 ;Get word count
MOVNM C,MFWC# ;And save it
PUSHJ P,SKPDIR ;Skip to beginning page and skip any E directory
MOVE TT,MACFIL ;Name of macro will be primary name of file
LSH TT,-6 ; but with dot in front
TLO TT,'. '
PUSHJ P,GENMCN ;Generate macro name not previously in use, probably
EXECUN: PUSHJ P,MACSET ;Set up expandable FS for macro def
SKIPGE EXEEND
JRST EXECUX ;Null page range
PUSHJ P,GETDEF ;Get macro def
PUSHJ P,EXGETC ;Instruction executed to get next char of def
EXECUX: RELEAS DSKM, ;Flush input file
SETZM JOBJDA+DSKM
EINFIN: JUMPL E,EXEERR ;Don't change any old def if no chars in new def
LCMFIN: PUSHJ P,MACFI0 ;Finish off macro def (here from cmd from lisp)
MOVE D,E ;FS pointer to macro block
MOVSI T,FILMAC
IORM T,MACFLG(D) ;Flag that this macro is really a file macro
AOS NFLMAC# ;Count another file macro defined
MOVEI A,1 ;Repeat arg for calling this new file macro
SKIPN CURMAC
SETZM NSTEP ;Here from typed cmd, flush step count
JRST ZMAC4 ;Now call the macro
GENMCN: MOVEI A,'@'-'.' ;Range of initial chars to try
GENMCL: PUSHJ P,FNDMAC ;Make sure that name doesn't already exist
POPJ P, ;No such macro so far
ADD TT,[010000,,0] ;Increment leading char (initially dot)
SOJG A,GENMCL ;And try again (only so many times)
POPJ P, ;Use final choice, since all possible ones in use
EXGETC: PUSHJ P,MFGETC ;Get char from file
POPJ P, ;EOF--give end of file return
CAIE C,14 ;Is it a formfeed?
JRST POPJ1 ;No, return normal character
SOSL EXEEND ;Yes, have we seen enough pages yet?
JRST EXGETC ;No, get another char
POPJ P, ;Yes, give eof return
EXEERR: AOJE E,EXEER1 ;Jump if error message already typed
SORRY No command text found.
EXEER1: PUSHJ P,ENDFIX ;Close off expandable FS
JRST POPJ1
EXEFNF: RELEAS DSKM,
SETZM JOBJDA+DSKM
JRST EXEFN2 ;Say why LOOKUP lost on execute file
;GETDEF GETDE0 GETDE1 GETDE2 GETDE3 GETDER GETDEC GETDEB GETDEX GETDX2
;Routine to generate macro definition from arbitrary character source.
GETDEF: MOVSI G,NSPEC!LSPC ;Ignore following on input: NUL,BS,CR,LF,FF,ALT,TAB
GETDE0: TDZA B,B ;Assume no control bits
GETDE1: IORI B,-"α"+1(C) ;Turn on CONTROL or META bit
GETDE2: XCT @(P) ;Get next char
JRST POPJ1 ;End of file, end of definition
TDNN G,CTAB(C) ;Ignore special chars
CAIN C,13 ;Also ignore vertical tab
JRST GETDE2 ;Ignore this char
JUMPL B,GETDEX ;Convert character to something else
CAIE C,"α" ;Turn on CONTROL for ALPHA
CAIN C,"β" ;Turn on META for BETA
JRST GETDE1
CAIN C,"⊗"
JRST [ TLO B,-1 ;Flag some conversion to do for next char
JRST GETDE2]
GETDE3: DPB B,[POINT 2,C,28] ;Insert control bits
LEG IDPB C,E ;Store character of macro definition
JRST GETDE0
;Here to ignore everything until we see a right-horseshoe
GETDER: XCT @(P) ;Get next char
JRST POPJ1 ;End of text is end of def
CAIE C,"⊃" ;Nothing terminates this comment but right-horseshoe
JRST GETDER ;Keep skipping text
JRST GETDE0 ;End of comment
;Here to ignore rest of current line (treating it as comment)
GETDEC: XCT @(P) ;Get next char
JRST POPJ1 ;End of text is end of definition
CAIE C,15
CAIN C,12
JRST GETDE0 ;Okay, back to normal interpretation
CAIN C,14
JRST GETDE0
JRST GETDEC ;Continue skipping to end of line
GETDEB: IORI B,-"1"+1(C) ;Alternate way of setting CONTROL or META bit
TLZ B,-1 ;Clear the escape flag
JRST GETDE2 ;Loop for real char
GETDEX: CAIL C,"a"
CAILE C,"z"
JRST .+2
TRZ C,40 ;Convert lower case to upper
CAIE C,"A"
CAIN C,"≠"
HRROI C,ALTMOD ;Not-equal sign becomes altmode
CAIE C,"T"
CAIN C,"="
HRROI C,11 ;Equals sign becomes tab
CAIE C,"L"
CAIN C,"↓"
HRROI C,12 ;Down arrow becomes linefeed
CAIE C,"B"
CAIN C,"↑"
HRROI C,177 ;Up arrow becomes backspace
CAIE C,"V"
CAIN C,"←"
HRROI C,13 ;Left arrow becomes vertical tab
CAIE C,"F"
CAIN C,"→"
HRROI C,14 ;Right arrow becomes formfeed
CAIE C,"C"
CAIN C,"↔"
HRROI C,15 ;Double arrow become carriage return
CAIE C,"α"
CAIN C,"β"
HRROI C,(C)
CAIE C,"X"
CAIN C,"Y"
HRROI C,-"X"+"α"(C) ;X and Y are alternates for alpha and beta
CAIE C,"1"
CAIN C,"2"
JRST GETDEB ;1 and 2 are alternates to generate control bits
CAIN C,";"
JRST GETDEC ;Semicolon means ignore up to CR,LF,or FF
CAIN C,"⊂"
JRST GETDER ;Left-horseshoe means ignore to right-horseshoe
CAIN C,"⊗"
HRROI C,"⊗" ;Circle-x quotes itself
JUMPL C,GETDE3 ;Legal conversion char
SORRX Undefined character conversion:
JRST GETDX2
SETZM TYOPNT
TYPCHR "⊗"⊗7(C)
OUTSTR [ASCIZ/
/]
GETDX2: SETO E, ;Flag error, with error message already typed out
JRST POPJ1
;GRANGE GNUM GNUM0 GNUM2 GNUM3 SKPSPC SKPSP2 MFINI0 MFINIT
;Here to scan for page range (only one permitted).
GRANGE: CAIN C,"("
PUSHJ P,SKPSP2 ;Skip over the left paren and any spaces
PUSHJ P,GNUM ;Get starting page number
JUMPN TT,.+2
HRROI TT,1
HRRZM TT,EXEBEG# ;Beginning page number
CAIN C,":"
PUSHJ P,GNUM0 ;Get ending page number (skipping colon)
JUMPG TT,.+2
MOVEI TT,-1
SUB TT,EXEBEG ;Calculate number of pages in range, minus one
MOVEM TT,EXEEND# ;Number of formfeeds within range
CAIN C,")"
JRST SKPSP2 ;Skip over right paren and any spaces
POPJ P,
GNUM: MOVEI TT,0 ;Scan a decimal number, return it in TT
JRST GNUM3 ;We've already got the first digit in C
GNUM0: MOVEI TT,0 ;Read following decimal number into TT
GNUM2: PUSHJ P,TYI
POPJ P, ;Activator can't be digit
GNUM3: CAIL C,"0"
CAILE C,"9"
JRST SKPSPC ;Skip spaces at end of number
IMULI TT,=10
ADDI TT,-"0"(C) ;Add in new digit
JRST GNUM2
SKPSPC: CAIE C,40 ;Skip over spaces and tabs
CAIN C,11
SKPSP2: PUSHJ P,TYI ;Get next char
POPJ P,
JRST SKPSPC ;Look for more
MFINI0: SETZM MACBUF ;Clear the output buffer
MOVE C,[MACBUF,,MACBUF+1]
BLT C,MACBUF+177
MFINIT: MOVEI C,200*5
MOVEM C,MFCNT ;Init byte count for another record
MOVE C,[POINT 7,MACBUF] ;Initialize byte pointer to new block
MOVEM C,MFBYTE#
POPJ P,
;MFGETC MFGETR MFGET0 MFGET1 MFGET2 MFLUZ MFPSTR MFPST2 MFPUTT MFPUTR
MFGETC: SOSLE MFCNT ;Any bytes ready?
JRST MFGET1 ;Yes, get one
MFGETR: IN DSKM,[IOWD 200,MACBUF↔0] ;No, try to read some more
MFGET0: AOSA MFBLK ;Count another record successfully read
JRST MFLUZ ;IN uuo failed
PUSHJ P,MFINIT ;Initialize byte count and byte pointer
MFGET1: IBP MFBYTE
MOVE C,@MFBYTE ;Get the word
TRNN C,1 ;Is this an SOS line number?
JRST MFGET2 ;No
AOS MFBYTE ;Yes, skip this byte and 5 more (including tab)
MOVNI C,5
ADDM C,MFCNT
JRST MFGETC
MFGET2: LDB C,MFBYTE ;Get char from file
JUMPE C,MFGETC ;Ignore nulls
JRST POPJ1
MFLUZ: GETSTS DSKM,C ;See if we have EOF
TRNN C,20000 ;EOF?
PUSHJ P,TELLZ ;No, some real error!
MOVE C,MFBLK
LSH C,7 ;Convert record count read to word count read
CAML C,MFWC ;Read all of file word count?
POPJ P, ;Yes, that's real EOF
SUB C,MFWC ;No, have just read a partial buffer
IMULI C,5 ;Make a (negative) byte count
MOVNM C,MFCNT ;Save it
JRST MFGET0 ;Now return a character
;Routine to output a string to macro file.
MFPSTR: TLOA B,440700 ;Output an ASCIZ string
MFPST2: PUSHJ P,MFPUTT ;Put out a char
ILDB T,B
JUMPN T,MFPST2
POPJ P,
;Subroutine to output char in T to macro file.
MFPUTT: IDPB T,MFBYTE ;Put out a byte
AOS MFROOM ;Count another char on current line
SOSLE MFCNT ;Any byte left?
POPJ P, ;Yes
PUSHJ P,MFPUTR ;No, output the record
PUSH P,C
PUSHJ P,MFINI0 ;Reset byte count and byte pointer, clear buffer
JRST POPCJ
MFPUTR: OUT DSKM,[IOWD 200,MACBUF↔0] ;Output the macro def buffer
POPJ P,
PUSHJ P,TELLZ ;OUT uuo lost!
;MFCHK PUTDEF PUTDE2 MFLINE MFLIN0
;Routine to check error code from LOOKUP of macro file. Called with JSP TT,MFCHK.
MFCHK: HRRZ T,LKUP+1 ;Get error code
JUMPN T,EXEFNF ;Real error if non-zero code
SETOM MFCNT ;Flag that we're gonna create a new file
JRST (TT) ;Return
;Command routine to write out all macro definitions in a file (extending old file)
PUTDEF: JSP E,ANYMAC ;Doesn't return if no macros
JSP E,OMFILE ;Open macro file
SETZM MFCNT ;XCTed--assume not making a new file
JSP TT,MFCHK ;LOOKUP failed--return only if error was no such file
MOVEI C,DSKM
MOVE T,[MACFIL-1,,LKUP-1]
PUSHJ P,OPNDEV ;Make sure device is open--skip on error
ENTER DSKM,LKUP
JRST EXEFNF ;ENTER failed
;; PUSHJ P,OMFIOK ;Store away filename as new default
UGETF DSKM,T
IFN DECSW,<
USETO DSKM,(T) ;DEC's UGETF doesn't do the USETO
>
SKIPE MFCNT ;Are we creating?
OUT DSKM,[IOWD LCTEXT,CTEXT↔0] ;Yes, put out initial directory
JRST PUTDE2
PUSHJ P,TELLZ ;Oops, OUT lost
PUTDE2: PUSHJ P,ABCRLF
SETZM TYOPNT ;Type out names of all defined macros.
OUTSTR [ASCIZ/Macros written out: /]
MOVEI E,=38 ;Room left on first typeout line
PUSHJ P,MFINI0 ;Initialize byte count and byte pointer, clear buffer
MOVEI T,14
PUSHJ P,MFPUTT ;Put out a formfeed to make defs appear on new page
MOVE D,MACBEG ;Pointer to first macro def
PUSHJ P,MACLS3 ;Loop through all macro definitions, typing out name
PUSHJ P,PUTMAC ;Do this for each macro definition--output to file
SKIPL MFBYTE ;Any bytes in current output buffer?
PUSHJ P,MFPUTR ;Yes, put out last buffer
RELEAS DSKM,
SETZM JOBJDA+DSKM
POPJ P,
MFLINE: TYPCHR "
"
MFLIN0: MOVNI T,=72 ;Max length we will allow output line to be in file
MOVEM T,MFROOM# ;Amount of room left on current line
POPJ P,
;PUTMAC PUTMA0 PUTMAL PUTMA1
;Routine to output to macro file a DEFINE command for regenerating a macro.
PUTMAC: MOVE T,MACFLG(D);Get macro's flags
TLNE T,FILMAC ;Is it a file macro?
JRST POPJ1 ;Yes--don't output it to the file
MOVEI B,[ASCIZ/αXDEFINE /]
PUSHJ P,MFPSTR
MOVEI T,MFPUTT
MOVEM T,TYOADR# ;Make TYPCHR dispatch to MFPUTT for each char
TYPMAC MACNAM(D);Put macro name into define command in file
MOVEI B,[ASCIZ/⊗↔
/]
PUSHJ P,MFPSTR ;Put out symbolic CR and real CRLF
PUSHJ P,PUTMA0 ;Put out macro's definition in 7-bit representation
PUSHJ P,MFLINE ;This instruction executed when output line gets long
MOVEI B,[ASCIZ/αβ⊗↓
/]
PUSHJ P,MFPSTR ;Put out CONTROL-META-LINEFEED to end def in file
SETZM TYOADR ;Restore normal character output mechanism
POPJ P,
;Routine to output 7-bit representation of macro definition.
PUTMA0: PUSHJ P,MFLIN0 ;Init the line length
MOVEI B,MACTXT(D) ;Make byte pointer to macro text
HRLI B,441100
PUTMAL: ILDB A,B ;Get next char from def
JUMPE A,POPJ1 ;A null marks the end of def
SKIPL MFROOM ;Any room left on current file output line?
XCT @(P) ;No, output a CRLF
PUTMA1: TRZE A,200
TYPCHR "α" ;Put out CONTROL bit as an alpha
TRZE A,400
TYPCHR "β" ;Put out META bit as a beta
CAIN A,ALTMOD ;Altmode becomes not-equal sign
IFE DECSW,<
HRROI A,"⊗≠"
>
IFN DECSW,<
HRROI A,"⊗A" ;Use alternate way of saying altmode for TOPS-10
>
CAIN A,11 ;tab becomes equals sign
HRROI A,"⊗="
CAIN A,12 ;linefeed becomes down arrow
HRROI A,"⊗↓"
CAIN A,177 ;backspace becomes up arrow
HRROI A,"⊗↑"
CAIN A,13 ;vertical tab becomes left arrow
HRROI A,"⊗←"
CAIN A,14 ;formfeed becomes right arrow
HRROI A,"⊗→"
CAIN A,15 ;carriage return becomes double arrow
HRROI A,"⊗↔"
CAIE A,"α"
CAIN A,"β"
HRROI A,"⊗"⊗7(A);Alpha and beta need to be quoted
CAIN A,"⊗"
HRROI A,"⊗⊗" ;Circle-x quotes itself
TYPCHR (A) ;Put out char(s)
JRST PUTMAL ;Get next char
;XAttach command ;⊗ MEDIT MEDITX MEDITR MEDIT0 MEDITS MEDITN MEINIT MEDCHR MEDLIN MEDLN0
;Here for XATTACH command to put a macro's editable definition into attach buffer.
MEDIT: PUSHJ P,ENDSET ;Set up expandable FS
PUSHJ P,GETMAC ;Get macro name into TT
CAIN C,"." ;Is this a readonly variable?
JRST MEDITR ;Yes, handle it differently
PUSHJ P,FNDMAC ;Look up macro name
JRST MACUN0 ;No such macro
PUSHJ P,MEINIT ;Init for output
PUSHJ P,PUTMA0 ;Copy macro text to attach buffer
PUSHJ P,MEDLIN ;This is executed when output line gets long
MEDITX: PUSHJ P,MEDLIN ;Finish last line (can't be empty unless def is)
SETZM TYOADR ;Restore normal character output
PUSHJ P,ENDFIX ;Close off expandable FS
SETZM ATTLOC ;These lines didn't come from anywhere in file
SETZM ATTPOS
JRST ATTUPD ;Finish up by setting EXTRA and displaying "A"
;Attach text from readonly variable, all on one line.
MEDITR: MOVEI J,-2 ;do ENDFIX on failure, via RDVUND(J) from MACHA5
MOVE I,[JRST MEDIT0] ;return here after finding variable name
JRST SETX2S ;go look for readonly variable
MEDIT0: MOVE C,E ;save any numeric value returned
PUSHJ P,MEINIT ;init for output
PUSHJ P,MFLIN0 ;init char count
SKIPN D,OKSTRG ;skip if string readonly variable
JRST MEDITN ;number is different
MEDITS: ILDB TT,D ;get char from readonly variable
JUMPE TT,MEDITX ;loop till null
TYPCHR (TT) ;output a char
JRST MEDITS ;loop for more
;Attach readonly variable's value.
MEDITN: TYPDEC C ;value is in C now
JRST MEDITX ;finish up
;Routine to initialize output space for attaching text from macro or variable.
MEINIT: TROE F,ATTMOD ;We are now in attach mode
PUSHJ P,TELLZ ;We shouldn't have come here in attach mode!
MOVSI T,ATTBUF
MOVEM T,ATTBUF ;Set up initial empty attach buffer
SETZM ATTSIZ ;No chars attached yet
MOVEI T,MEDCHR
MOVEM T,TYOADR# ;Make each char output from def go to MEDCHR
JRST MEDLN0 ;Set up byte pointer for storing macro def as text
MEDCHR: AOS MFROOM ;Count a char in the line
LEG IDPB T,MFBYTE
POPJ P,
MEDLIN: PUSH P,MFROOM ;Save to figure out how long this line is
PUSHJ P,MFLINE ;Finish the line with CR and LF, and reset count
MOVE E,MFBYTE
TDZA T,T
LEG IDPB T,E
TLNE E,760000 ;Whole word done?
JRST .-2 ;No, insert a null
ADDI E,2
MOVSI T,TXTCOD
FSFIX E,T ;Close off block of FS for this text line
SUBI E,-1(T) ;Get pointer to beginning of FS blk
MOVNI T,-2-LLDESC(T) ;Number of words of text in this blk
HRLZ T,T ;Make aobjn ptr
HRRI T,LLDESC(E) ;Pointer to first text word
MOVEI TT,1
IORM TT,(T) ;Turn on low order bit of each text word
AOBJN T,.-1
AOS T,TXTNUM ;Get a serial number for this line
HRRZM T,TXTSER(E) ;Store serial number and clear flag halfword
SETZM TXTWIN(E) ;clear window ptr for line in current window
POP P,T ;Get final char count for line, not counting CRLF
SUB T,MFROOM ;Subtract negative initial count
HRLI T,2(T) ;Include CRLF in LH char count
MOVEM T,TXTCNT(E) ;Store in new FS block
MOVEI T,2(T)
ADDM T,ATTSIZ ;Update amount of attached text
AOS ATTNUM ;Update number of lines attached
MOVS T,ATTBUF
HRRM E,(T) ;Make old last line in attach buffer point to us
HRLM E,ATTBUF ;Make attach buffer header point back to us
HRLI T,ATTBUF
MOVSM T,(E) ;Make us point back to old guy, forw to header
MEDLN0: HRRZ E,FSEND
ADD E,[440700,,1+LLDESC]
MOVEM E,MFBYTE ;Now make subsequent text use following FS
POPJ P,
;REDEFI REDERR REDBAK PGCONV REDPG2 REDAT2 REDPAG REDATT PGCON0 PGCHER PGCONX PGCONE PGCONL PGCON2 PGCHAR PGCHLF PGCHA0 PGCHA3 PGCHA5 PGCHA2 PGCHA6 PGCHAB PGCHA4
;Here with ⊗XREDEFINE <macro name> command to take macro def from text on page.
REDEFI: PUSHJ P,GETMA0 ;Get macro name into TT
PUSHJ P,XTDACT ;hit activator -- put it back to be read once more
PUSHJ P,MACCHK ;See if name is ok
JRST MACB00 ;No, illegal name
PUSH P,A ;Preserve numeric arg
PUSHJ P,MACSET ;Set up expandable FS for macro def
POP P,A
PUSHJ P,PGCONV ;convert page/attach text into 9-bit string
JRST REDERR ;error occurred
PUSHJ P,MACFIN ;Finish off macro def
PUSHJ P,REDBAK ;Restore original arrow line
JRST MACTY0 ;Type out new def
REDERR: PUSHJ P,REDBAK ;Restore original arrow line
JRST EXEERR
REDBAK: MOVE A,ARRLIS ;get old line number
TRNE F,NEG ;Did we move up to do this?
PUSHJ P,SETARR ;Yes, move back down
POPJ P,
;Subroutine to convert macro-format text into 9-bit byte string, storing
;text through the byte ptr in E. Amount of text is determined by numeric arg
;to current command. Skips on success. After return (successful or not),
;the caller must call REDBAK (or JUDONX) to restore the arrow to where it
;came from, in case of a negative argument. Should be here with extended
;command line already ready to be read again (XTDLIN already called), in case
;we need to use it because of a zero argument to the cmd.
PGCONV: MOVE TT,ARRL ;Save number of arrow line for getting back there
MOVEM TT,ARRLIS ;nice place to save line number
JUMPE A,PGCON0 ;zero arg means read text from extended cmd line
SETZM TYIPNT ;nonzero arg, so don't read cmd line any more
TRNE F,ATTMOD ;In attach mode, take string from attach buf
JRST REDATT
TRNN F,ARG!REL
JRST REDPAG ;Use whole page to make string
REDPG2: PUSHJ P,ARGCHK ;Check argument against number of lines on page
JUMPE A,CPOPJ ;no text, error
MOVEM A,MFCNT ;Prepare to count down lines used in string
HRRZ C,ARRLIN ;First line to use is current line
REDAT2: PUSHJ P,NEXTL0 ;Set up pointers to first line
POPJ P, ;End of range already -- no text -- error
PUSHJ P,GETDEF ;Generate 9-bit string
PUSHJ P,NEXTCH ;Instruction executed to get next char to interpret
JUMPL E,CPOPJ ;take error return if no chars in string
JRST POPJ1 ;skip on success
REDPAG: PUSHJ P,GOLIN1 ;Get to line 1 of current page
TRO F,NEG ;Make sure we get back
MOVEI A,-1 ;Do lots of lines on this page
JRST REDPG2
REDATT: TRZN F,ARG!REL!NEG ;If no arg,
MOVEI A,-1 ; then use whole attach buffer
JUMPLE A,REDERR ;Can't have non-positive arg
CAMLE A,ATTNUM
MOVE A,ATTNUM ;Don't use more lines than there are attached
MOVEM A,MFCNT ;Number of lines to take text from
HRRZ C,ATTBUF ;First line to use is first attached line
JRST REDAT2
;Here if command had a zero arg. Read text from extended cmd line, and then
;continue reading from tty if cmd line ends with LF (but not αβLF).
PGCON0: TLZ F,TF1!TF2!TF3 ;not multi-line text, no LF needed, no eof, yet
MOVSI TT," R"⊗4
HLLM TT,EMFLG ;set "R" in hdr for REDEFINE or REEVAL
SETOM NEEDHD ;set flag to make HEADS think about hdr line
MOVEI TT,PGCONX ;address for PGCHAR to go to upon aborting
MOVEM TT,PGCHAX# ;store for use when needed
MOVEI TT,[ASCIZ/Continue macro-format text (Alt=abort),/]
MOVEM TT,PGCONA# ;save text to type upon LF at end of cmd line
SETOM LINFLG ;make CMRTR2 do line mode input
SETZM LINFL2 ;And don't let ESC I change mode
PUSHJ P,GETDEF ;generate string
PUSHJ P,PGCHAR ;instruction executed to get next char to interpret
SETZM TYIPNT ;flush extended cmd ptr in case of error
CAMN E,[-1] ;did we see an error (bad conversion)?
TLNN F,TF1 ;yes, did we get into multiline mode?
JRST PGCHER ;no to one of these
PUSHJ P,PGCONE ;yes, make user type αβ<lf> to resynchronize
PGCHER: PUSHJ P,PGCHA4 ;clear "R" from hdr line, restore ALLACT, etc.
JUMPL E,CPOPJ ;take error return if no chars in string, or error
JRST POPJ1 ;skip on success
;Here when PGCHAR aborted from PGCON0
PGCONX: SETO E, ;Flag error, with error message already typed out
SUB P,[2,,2] ;flush returns to GETDEF and GETDEF's caller
JRST PGCHER ;jump back into GETDEF's caller!
;Here when got illegal char after "⊗" in GETDEF from PGCON0; skip to αβLF
PGCONE: PUSHJ P,CSTYIM ;gobble up typeahead, maybe a αβ<lf> already there
JRST PGCONL ;nope, prompt
CAIE C,612 ;EOF?
JRST PGCONE ;nope, keep looking
POPJ P, ;aha
PGCONL: OUTSTR [ASCIZ/ ** End aborted string Now,/]
PUSHJ P,CTMTLF ;with αβ<lf>
PGCON2: PUSHJ P,CTYI1 ;read a char
CAIE C,612 ;eof?
JRST PGCON2 ;no, loop
OUTSTR [ASCIZ/ OK /] ;yes, end of bad string
POPJ P,
;Routine called to get next char from cmd line or beyond (if line ends with LF)
;Skip returns with char, or takes direct return upon EOF, or jumps @PGCHAX
;if aborting cmd. Also, when sees LF ending cmd line, prompts for more by
;typing text pointed to by PGCONA. Preserves B,E,G,DSP (and that's about all);
;calls DISP to update screen when awaiting more typein.
;LINFLG should be set if line mode input is desired (required if reading
;extended cmd).
PGCHAR: TLNE F,TF2!TF3 ;want LF inserted, or now done?
JRST PGCHLF ;yes, do it
MOVE A,E ;save important AC (byte ptr)
PUSH P,G ;save other important AC for GETDEF
PUSHJ P,CMRTR2 ;get char from tty (or extended cmd line)
POP P,G
MOVE E,A ;byte ptr goes back and forth, ends up in E
PUSHJ P,TYIT ;check for activator
JRST PGCHA2 ;activator
JRST POPJ1 ;skip return with char
PGCHLF: TLZN F,TF2 ;need LF now?
JRST PGCHA4 ;nope, must have been TF3, which means eof
MOVEI C,12 ;return LF like normal char found
JRST POPJ1
;Here upon reaching LF that ends cmd line.
PGCHA0: SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]] ;enable αCR, undo ALLACT, etc.
PUSHJ P,LOADMT ;Fix up typeahead
CAIA ;not macro
JRST PGCHA3 ;in macro, don't type prompt
OUTCHR [15] ;put out CR after user's LF
OUTSTR @PGCONA ;tell what to continue typing
PUSHJ P,CTMTLF ;tell what to end with (αβ<lf>)
PGCHA3: TLO F,TF2 ;set flag to insert LF next time
PGCHA5: MOVEI C,15 ;return a CR for end of line, and a LF next time
JRST POPJ1
;Here upon seeing activator.
PGCHA2: CAIN C,612 ;eof is end, even if on cmd line
JRST PGCHA4 ;end of range
ANDI C,177 ;ignore bucky bits
CAIN C,ALTMOD ;abort char (altmode)?
JRST PGCHAB ;yes, abort string and thus the cmd
TLOE F,TF1 ;are we still on cmd line?
JRST PGCHA6 ;no, just return this unbuckified activation char
CAIN C,12 ;yes, is this cmd line continuation char?
JRST PGCHA0 ;yes
CAIE C,15 ;normal cmd line end?
JRST PGCHAB ;no, abort cmd
TLO F,TF2!TF3 ;yes, end of range, need LF later
JRST PGCHA5 ;but go insert CR first
PGCHA6: CAIN C,15 ;CR?
TLO F,TF2 ;yes, make next call get a LF
JRST POPJ1 ;return this char
PGCHAB: PUSHJ P,MACABT ;say aborted
JFCL ;always skips
PUSHJ P,PGCHA4 ;clear R,L,M from hdr line, fix activation modes
JRST @PGCHAX ;take aborted error return
;routine to call upon exit to clean up
PGCHA4: PUSHJ P,SEMODE ;restore normal activation modes
HRRZS EMFLG ;clear E,M,R from hdr line
SETOM NEEDHD ;set flag to make HEADS think about hdr line
POPJ P,
;NXTTAB NEXTCH NEXTLN NEXTL0
NXTTAB: ILDB C,MFBYTE
CAIE C,11
JRST NXTTAB ;Skip spaces between tabs in incore text version
;Here to get next char for macro def from page or attach bufer
;This routine ignores tabs and CRLFs (well, not really CRLFs).
NEXTCH: ILDB C,MFBYTE
CAIN C,11 ;If it's a tab,
JRST NXTTAB ; skip to the ending tab and return it
CAIE C,15
AOSA (P) ;Return normal character
NEXTLN: SOSG MFCNT ;Have we done enough lines?
POPJ P, ;End of range
HRRZ C,@MFBLK ;Get pointer to next line
NEXTL0: MOVEM C,MFBLK
ADD C,[440700,,LLDESC] ;Make byte pointer to text of line
MOVEM C,MFBYTE
SKIPN C,TXTCNT-LLDESC(C);Get char count for this new line
POPJ P, ;Must be pagemark or end of page--end of range
TRNN C,-1 ;Is this a null line?
JRST NEXTLN ;Yes, go right away to next line
MOVEI C,15 ;No, now return the CR
JRST POPJ1 ;Let GETDEF ignore CR -- ⊗; code want to see it
;LBS LBS4 ARGUM2 LBS2
LBS: SETOM NOCRLF ;Prevent CRLF typeout, avoid LSCHK call
SKIPG C,CURMAC ;Any macro in progress?
JRST CMDLUP ;No, ignore number sign
MOVE TT,MREPT(C);Get repeat arg to macro call
HLRE T,TT ;Get negative of remaining arg to macro call
MOVM T,T ;Make it positive
ADDI T,(TT) ;Add in any repeats already done
MOVEI TT,-1(T) ;Leave one repeat still in progress
HRROM TT,MREPT(C) ;But don't let it repeat macro again
HLRZ B,MPOINT(C);Get flag bits from argument to macro call
TRNN B,ARG!REL ;Any arg to macro call?
JRST CMDLUP ;No, then use whatever arg given to ⊗# command
TRNN F,REL ;Was number-sign called with own relative arg?
JRST LBS4 ;No, just use arg from macro call
TRNN F,ARG ;Yes
MOVEI A,1 ;If no repeat argument typed, assume 1.
TRZE F,NEG
MOVN A,A
ADD T,A ;Combine arg to macro call and arg to ⊗# cmd
TROA F,ARG ;We definitely have an arg now
LBS4: TRZ F,NEG!REL!ARG ;Here w/out relative arg to ⊗#.
MOVE A,T ;Put new arg value into arg AC
ANDI B,REL!ARG ;If there was arg to macro call, there is arg now
IOR F,B ; and if arg to macro call was rel, then is rel now
ARGUM2: JUMPGE A,LBS2
TRO F,NEG!REL ;Negative arg is always relative
MOVN A,A
LBS2: TRNN F,ARG ;Any arg now?
SETZ A, ;No
CAILE A,MAXARG ;Maximum allowable repeat arg
MOVEI A,MAXARG
JRST CMDLUP
;EINAME EINRED EINBIG EINCHR
EINAME←←'...EIN' ;Name of macro in which EIN tmpcor file macro is stored
;Here to read EIN tmpcor file (for login area) to do initialization upon E
;startup (after first file open). Will probably skip because EINFIN does.
EINRED: SETZM EINITF ;Don't come back here automatically upon file switching
MOVE T,[1,,['EIN',,0 ;Read tmpcor file EIN for current job
IOWD LMACBF,MACBUF ; into MACBUF
0 ] ] ; from login PPN
TMPCRD T, ;Read tmpcor file
POPJ P, ;No such file
CAILE T,LMACBF ;Is file too big?
JRST EINBIG ;Yes, we didn't read it all
IMULI T,5 ;Turn word count into char count
MOVEM T,MFCNT ;Remember how many chars to read for def
MOVE T,[POINT 7,MACBUF] ;Initialize pointer to ascii string from EIN file
MOVEM T,MFBYTE ;Store for reading chars
MOVE TT,[EINAME] ;Name of macro to create
PUSHJ P,MACSET ;Set up expandable FS for macro def
PUSHJ P,GETDEF ;Generate macro definition
PUSHJ P,EINCHR ;Instruction executed to get next char for def
JRST EINFIN ;Finish up just like execute command, calling this macro
EINBIG: SORRY EIN tmpcor file too big--ignored.
JRST POPJ1
;Subroutine called by GETDEF to get next text char for macro definition.
EINCHR: SOSGE MFCNT ;Any more chars?
POPJ P, ;No more
ILDB C,MFBYTE ;Get one
JRST POPJ1 ;Skip return with char
;HIDE HIDCHK HIDEIT HIDNEW HIDLUZ HIDE0 HIDE1 HIDE2 HIDERR
;Command routine for XHIDE command to hide/unhide dir or just report hidden state.
HIDE:
IFE FTHID,< JRST EXTNF2 >
IFN FTHID,<
SKIPE DIRPAG ;Any dir on disk?
TRNE F,FILLUZ ;And file okay?
JRST HIDERR ;No
TRNN F,DIROK ;And got whole dir in?
JRST HIDERR
JUMPE A,HIDCHK ;Zero arg means just report
IFN FTUNHID,<
movni a,1 ;Force XHIDE cmd to unhide directory
>;IFN FTUNHID
PUSHJ P,HIDE0 ;Get uset value of page two
XCT %OFFS ;Set record offset
OUTSTR HIDLUZ ;Error
HIDCHK: XCT %OFFG ;Get record offset
OUTSTR [ASCIZ/ File's directory is /]
JUMPE A,.+2 ;Did we just set the offset?
OUTSTR [ASCIZ/now /] ;Yes
SOSG HIDDEN ;Normalize offset and check
OUTSTR [ASCIZ/UN/]
OUTSTR [ASCIZ/HIDDEN. /]
JRST POPJ1
;Here from OUTDIR or after formatting a file--set the record offset correctly.
;Enter at HIDNEW after copying or creating a file.
HIDEIT: SKIPN HIDDEN ;Is directory hidden?
POPJ P, ;No
PUSHJ P,HIDE1 ;Yes. Get uset value of page two
HIDNEW: MTAPE DSKO,%%OFFS ;Set record offset
OUTSTR HIDLUZ
POPJ P,
HIDLUZ: ASCIZ/ Error on attempt to set file's offset. /
;Subroutine for XHIDE command to hide/unhide directory.
HIDE0: MOVEI T,1 ;Assume unhiding
JUMPL A,HIDE2 ;Jump if wants to unhide
HIDE1: HRRZ T,@DIR ;Get pointer to page two's dir entry
MOVE T,DIRREC(T) ;Get record number of beginning of page two
TLNE T,-1 ;Better not be any within record offset for page two
PUSHJ P,TELLZ ;Oops!!!
HIDE2: MOVEM T,%%OFFS+2
POPJ P,
HIDERR: SORRY Disk file does not have (valid) E directory.
JRST POPJ1
>;FTHID
;CACHE0 CACCHN CACMIN CACRED CACWRT PCACHE CFSGET CFSGEL CFSGIV CFSGIL
IFN FTBUF,<
IMPURE
CACHE0: BLOCK NBUFS*200 ;The first cache is compiled in, other(s) come from FS.
CACCHN: BLOCK NCACHE ;Channel number of data in each cache
CACMIN: BLOCK NCACHE ;Record number of first record in each cache
CACRED: BLOCK NCACHE ;Bit mask indicating records of actual data in each cache
CACWRT: BLOCK NCACHE ;Bit mask indicating records in each cache needing output
PCACHE: BLOCK NCACHE ;Pointer to actual caches (-1 in LH means not from FS)
;In the masks above, bit 0 means first record has data, bit 1 second record, etc.
PURE
;Routine to set up a second cache from FS while formatting a file (clobbers T,TT).
CFSGET: PUSH P,A
PUSH P,B
PUSH P,C
MOVEI C,NCACHE-1 ;Look for non-existent cache
CFSGEL: JUMPL C,PPCBAJ ;Seems all caches already exist
SKIPE PCACHE(C) ;Does this cache exist?
SOJA C,CFSGEL ;Yes, try next cache
MOVEI B,NBUFS*200 ;No, get this much FS for this cache
PUSHJ P,FSGET
MOVSI B,LOKBIT
HLLM B,-1(A) ;Lock down this FS block
HRRZM A,PCACHE(C) ;Save pointer to the cache's FS
JRST PPCBAJ
;Routine to return the FS of a cache that came from FS (clobbers T,TT).
CFSGIV: PUSH P,A
PUSH P,B
PUSH P,C
MOVEI C,NCACHE-1 ;Look for cache from FS
CFSGIL: JUMPL C,PPCBAJ ;None
SKIPLE A,PCACHE(C) ;Is this one from FS?
SKIPL CACCHN(C) ;Yes. Is it free?
SOJA C,CFSGIL ;No
PUSHJ P,FSGIVE
SETZM PCACHE(C) ;No cache there any more
JRST PPCBAJ
;CACGE0 CACGET CACGEL CACFND CACFNL CACFIT CACSET CACFI2 CACRLC CACRLI CACRLO CACRLT CACRLL
;Routine to find a free cache for channel whose number is in A.
CACGE0: TDZA C,C ;Enter here for input to get only the first cache
CACGET: MOVEI C,NCACHE-1;Here for output to get either cache
CACGEL: JUMPL C,POPJ1 ;Skip return if can't get a cache
SKIPGE CACCHN(C);Is this cache free?
SKIPN PCACHE(C) ;Yes. Does it actually exist?
SOJA C,CACGEL ;No, try next cache
MOVEM A,CACCHN(C) ;Yes, claim it for this channel
SETZM CACRED(C) ;Mark all of cache as empty
POPJ P, ;Success, index of cache returned in C
;Routine to find the cache belonging to channel whose number is in A.
CACFND: MOVEI C,NCACHE-1;Check all caches
CACFNL: CAMN A,CACCHN(C);Right channel using this cache?
AOSA (P) ;Yup
SOJGE C,CACFNL ;No, try next cache
POPJ P, ;No cache for this channel
;Routine to see if record number in A is in range currently in cache.
CACFIT: SKIPE CACRED(C) ;Anything at all in cache?
JRST CACFI2
AOS (P) ;Skip return to say this record fits in cache
CACSET: MOVEM A,CACMIN(C)
MOVNI A,-1(A) ;Figure out record number where disk block starts
IDIVI A,NBUFS ;NBUFS should be (multiple of) number of records/block
ADDM B,CACMIN(C);Make cache start at beginning of disk block
POPJ P,
CACFI2: CAMGE A,CACMIN(C)
POPJ P, ;Doesn't fit in cache
SUBI A,NBUFS
CAMGE A,CACMIN(C) ;Is record less than first record beyond cache?
AOS (P) ;Yes, fits okay
POPJ P,
CACRLC: PUSH P,T
MOVEI T,(C) ;Release cache from channel given in C
PUSHJ P,CACRLT
JRST POPTJ
;Routine to release any cache from a given channel
CACRLI: SKIPA T,[DSKI] ;Releasing from input channel
CACRLO: MOVEI T,DSKO ;Releasing from output channel
CACRLT: PUSH P,C ;Enter here with channel in T
MOVEI C,NCACHE-1
CACRLL: JUMPL C,POPCJ ;Didn't find any cache on that channel
CAME T,CACCHN(C);Is this cache in use by this channel?
SOJA C,CACRLL ;No, check next cache
SKIPE CACWRT(C) ;Better not be anything still to be written out
PUSHJ P,TELLZ ;Oops!
SETOM CACCHN(C) ;Mark cache as no longer in use
JRST POPCJ
;CACCLS CACOUT CACOUL CACOU0
;Make sure disk file is actually written from cache (from ODDONX,MFDD2,WRDON2).
CACCLS: PUSH P,A ;Here to force out anything in the cache
PUSH P,B ; that needs to be written out
PUSH P,C
MOVEI C,NCACHE-1;Check all caches
PUSHJ P,CACOUT ;Force out the cache
SOJGE C,.-1 ;Next cache
JRST PPCBAJ ;Restore C,B,A and return
;Routine to force out a particular cache to make room for other records.
CACOUT: SKIPN A,CACWRT(C) ;Get mask indicating cache records needing writing out
POPJ P, ;That was easy
PUSH P,T
PUSH P,TT
MOVEI T,DSKO
CAME T,CACCHN(C);We better be doing this on the output channel
PUSHJ P,TELLZ ;Oops, someone forgot to write out the cache!
TDZA TT,TT ;Starting at beginning of cache
CACOUL: MOVE TT,B ;Number of records done so far
JFFO A,CACOU0 ;Count records to skip
SETZM CACWRT(C) ;Nothing in cache needs writing out now
POP P,TT
POP P,T
POPJ P,
CACOU0: LSH A,(B) ;Shift first one into sign bit
ADD B,TT ;Count records done plus next group of records to skip
SETCM T,A ;Make zeroes mean records to write out
IFN 1,<
CHNSTS DSKO,TT ;A bugtrap to make sure we have ENTERed the output channel
TRNE TT,20000 ;Have we done an ENTER?
TRNE TT,1000 ;Yes, is the file still open?
PUSHJ P,TELLZ ;No!!!
>;bugtrap
JFFO T,.+2 ;Count records to write out
MOVEI TT,=36 ;Need to write out all records (all bits on in A)
LSH A,(TT) ;Put next zero into sign bit
MOVEI T,(B) ;Number of records to skip at beginning of cache
ADD T,CACMIN(C) ;Number of the first record needing writing out
USETO DSKO,(T) ;Position us to write out at right place in file
MOVEI T,200
IMULI T,(B) ;Number of words at front of cache not being written out
ADD T,PCACHE(C) ;Make pointer to first word to be written out
SUBI T,1 ;Need IOWD pointer
ADD B,TT ;Count total records of cache taken care of after this
IMUL TT,[-200] ;Negative of amount to output
HRL T,TT ;Make the IOWD size
SETZ TT, ;End of dump mode cmd list
OUT DSKO,T ;Write out a piece of the cache
JRST CACOUL ;Now see if need to write out anything else in cache
PUSHJ P,TELLZ ;OUT uuo lost!
;BOUT BINFIN PPCBA1
BOUT: PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,DSKO ;Disk channel we're using for this output
PUSHJ P,CACFND ;Find cache for our channel
PUSHJ P,CACGET ;None currently, try to get a cache
SKIPA A,OBLK ;Got cache. Get record number we want to output.
JRST PPCBAJ ;Can't get cache. Just do single record output.
PUSHJ P,CACFIT ;See if this record fits in the cache
JRST [ PUSHJ P,CACOUT ;Nope, force out everything in the cache
MOVE A,OBLK
PUSHJ P,CACSET ;Set up cache to receive current output block
SETZM CACRED(C) ;Nothing in cache now
JRST .+1]
MOVE A,CACMIN(C);Number of first record in cache
SUB A,OBLK ;Get negative number of records from cache beg to this rec
MOVSI B,400000 ;A bit for the mask
LSH B,(A) ;Into place for this record
IORM B,CACRED(C);Now have some data in cache
IORM B,CACWRT(C);And that record needs outputting
IMUL A,[-200] ;Find positive distance from cache beg
ADD A,PCACHE(C) ;Set up destination of blt pointer
HRLI A,OBUF ;Set up source of blt
BINFIN: MOVE B,A
BLT A,177(B) ;Store in cache
PPCBA1: POP P,C
JRST PPBAJ1 ;Skip return over the single record OUT/IN uuo
;BIN BINOK BINGET PPCBA2 BINGE2 BINFIX BINFI2 BINFI3
BIN: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,ICHN ;Get input channel
PUSHJ P,CACFND ;Find cache for our channel
PUSHJ P,CACGE0 ;None, see if we can get a cache
SKIPA A,IBLK ;Got a cache. Get previous record read in.
JRST PPCBAJ ;Can't get a cache. Just do single record input.
JUMPE C,.+2
PUSHJ P,TELLZ ;Input is only supposed to use cache 0
ADDI A,1 ;Make it current record needed.
CAMLE A,FILLEN ;Is this record before eof?
JRST [ XCT %SETI ;No. Make sure we are positioned to the eof record.
JRST PPCBAJ] ;Now make the single record input uuo get the eof
SKIPE CACRED ;Anything at all in cache?
PUSHJ P,CACFI2 ;Yes, does this record fit in current range in cache?
JRST BINGET ;No, read new data into the cache
BINOK: MOVE A,CACMIN ;See if desired record is marked as present in the cache
SUB A,IBLK
SUBI A,1
MOVSI B,400000 ;A bit for the mask
LSH B,(A) ;Into place for this record
TDNN B,CACRED ;Is this record in the cache?
JRST BINGET ;No, read some data into the cache
IMUL A,[-200] ;Positive distance from front of cache of this record
HRLZ A,A
ADD A,[CACHE0,,IBUF] ;Set up blt pointer from cache to input buffer
JRST BINFIN
BINGET: PUSHJ P,CACOUT ;Force out everything in the cache
MOVE A,IBLK ;Get number of record we last read
ADDI A,1 ;Make it number of record we need
PUSHJ P,CACSET ;Set up cache to hold that record
SETZM CACRED ;Note that cache is now empty
XCT %BSETI ;Position us to read at record that goes at front of cache
XCT %BIN ;Read data into whole cache
JRST BINGE2 ;Read in okay
PUSH P,C
XCT %STAT ;Get I/O status into C
EXCH C,T ;Status into T
EXCH C,(P) ;Save previous T, restore cache index (supposely 0)
TRNN T,20000 ;EOF?
PUSHJ P,TELLZ ;No, some horrible error
MOVE T,CACMIN ;Get first record we tried to read
SUBI T,1 ;Last record guaranteed to not get eof
LSH T,7 ;Convert to words
CAMGE T,FILWC ;Have we read in the whole file?
JRST BINFIX ;No, we just read some data, though not whole cache-ful
POP P,T
PPCBA2: POP P,C
JRST PPBAJ2 ;Double skip return for error (eof)
BINGE2: MOVE A,[<-1>⊗<=36-NBUFS>]
MOVEM A,CACRED ;Flag all records of cache as holding valid data
JRST BINOK ;Now give caller his requested record of data
BINFIX: SUB T,FILWC ;Calculate amount of real data we just read in
MOVN T,T ;Positive amount
MOVE A,T
IDIVI A,200
JUMPE B,BINFI3 ;Did we read a partial record?
SETZM CACHE0(T) ;Yes, clear the rest of that record
CAIN B,177
JRST BINFI2
MOVEI T,(A) ;Number of whole records we read successfully
IMULI T,200 ;Number of words in whole records read
HRL B,T ;Save that value
ADDI T,CACHE0+1(B) ;Address of second word we did NOT read
HRLI T,-1(T) ;LH of blt pointer is to first word not read
HLRZ B,B ;Words in whole records read
BLT T,CACHE0+177(B) ;Clear rest of partial record read
BINFI2: ADDI A,1 ;Count the partial record in the cache
BINFI3: SETO B, ;Make a mask of ones for all records read
MOVN T,A
LSH B,=36(T) ;Put the mask in the high-order bits
MOVEM B,CACRED ;Flag certain records of cache as holding valid data
POP P,T
ADD A,CACMIN ;First record beyond valid data
MOVE B,IBLK
ADDI B,1 ;Number of record we want
CAMGE B,A ;Is it in the cache now?
JRST BINOK ;Yes, move it into the input buffer
JRST PPCBA2 ;No, give eof error return
>;FTBUF
;PROGRP PROCHK PROCH1 PROCH2 PROCH3 PROTEL PROTL2 PROXCT
IFE DECSW,<
AAOPRV←←10000 ;Left half -- access alias as owner
PROPRV←←100000
REAPRV←←40000
WRTPRV←←20000
LUPPRV←←1 ;Left half -- local user privilege
MASPRV←←1 ;Right half -- master account privilege
ALLGRP←←177777 ;Full word -- all group privileges
IMPURE
PROGRP: 'GODMOD'
27
0 ;UFD's protection returned here
0 ;UFD's group access bits returned here
PURE
>
;Routine to set flag WRTPRO iff edit file is write protected from user.
PROCHK:
IFN DECSW,<
POPJ P, ;Someday DEC can check this too
>;DECSW
IFE DECSW,<
SETZM WRTPRO ;Assume not write protected from us
PUSH P,A ;Preserve this AC
SKIPN A,EDFIL+PPN3 ;Get file's PPN
MOVE A,PPN ;Default PPN
XCT %MTAPE ;Get UFD protection and group access bits
JRST POPAJ ;MTAPE failed -- can't happen!!
MOVSI T,1
GETPRV T, ;Get our passive privileges
TLNN T,AAOPRV ;Allowed to access alias as owner?
JRST PROCH0
CAMN A,PPN ;Is this file on the alias area?
TDZA A,A ;Yes, he can access it as the owner
PROCH0: XOR A,RPPN ;Compare with logged in PPN
AND T,[ALLGRP] ;Only group privileges
AND T,PROGRP+3 ;Compare against group access bits
JUMPE T,PROCH1 ;Jump if no special access allowed
CAIE T,MASPRV
TDZA A,A ;User has group access, which means owner access
TLZ A,-1 ;User has owner access if file belongs to same programmer
PROCH1: MOVE T,EDFIL+2 ;Get file's protection
IOR T,PROGRP+2 ;Combine protections of UFD and file
JUMPE A,PROCH2 ;Jump if file is ours
MOVSI A,2
GETPRV A, ;Get effective privileges to check for local user or priv
TLNE A,WRTPRV ;Privileged?
JRST POPAJ ;Yup
TLNN A,LUPPRV ;Local user privilege on?
LSH T,3 ;No, check non-local-user protection
LSH T,3 ;Move write protect bit to owner field
JRST PROCH3
;Here to check own file.
PROCH2: TLNN T,100000 ;Is this file write-protected against us?
JRST POPAJ ;No, restore AC and return
HLLOS WRTPRO ;Flag as at least protected against self
MOVE T,PROGRP+2 ;Get UFD protection again
PROCH3: TLNE T,100000 ;Is file hopelessly write protected from us?
SETOM WRTPRO ;Yes, flag as protected from user without hope of changing
JRST POPAJ ;Restore AC and return
;Routine to warn user if edit file is write protected from him.
PROTEL: TRNN F,REDNLY ;Don't bother him if he's only looking
PROTL2: SKIPN WRTPRO
POPJ P,
PUSHJ P,ABCRLF
PROXCT: OUTSTR [ASCIZ /*** File is write-protected against you!!! ***
/]
SKIPLE WRTPRO
OUTSTR [ASCIZ /(⊗XPROTECTION nnn<cr> can change protection.)
/]
JRST BEEPM2 ;Now beep him!!!
>;NOT DECSW
;QLSYMS QLTBL QLLSEM QLASEM QLLSXP QLASXP QLLPAR QLAPAR QLLIND QLAIND QLCNT QLCHG
COMMENT ⊗
This table as initially set up corresponds to MacLISP syntax.
It is probably general enough to accommodate the syntax of most
LISP systems. The parsing routines use the left half of the table
entries, and the table is kept in impure memory so that it may
be modified. The right half is a duplicate of the left, and may be
used to reinitialize the table.
The syntax of MacLISP can be understood by dividing the characters
into several character classes as shown below. end of comment ⊗
;This table contains the syntax representation chars that the user can
;type in the ⊗XLISPSYNTAX command.
QLSYMS: "(" ;"leftparen" (
")" ;"rightparen" )
"[" ;"leftsuper" [
"]" ;"rightsuper" ]
"/" ;"slash" / %
"'" ;"quote" ' ` ,
"|" ;"vbar" | "
"↔" ;"CR" <carriage return>
";" ;"semi" ;
" " ;"space" NULL TAB LF VT FORM SPACE BS
"A" ;"letter" all other characters
LQLSYM←←.-QLSYMS
COMMENT ⊗
The general syntax of a MacLISP S-expression is that it can be an atom
or a list. An atom is a string of letters. Preceding any character
by a slash makes it a letter. Any string of characters may be
enclosed in vertical bars (vbars), and they plus the vbars constitute
an atom; however, any slash or vbar within the string must be
preceded by a slash. Quotes are MacLISP macro characters, and are
treated specially by the indentation algorithm. Lists consist
of a sequence of S-expressions enclosed in parentheses.
A comment consists of a semi, any string of characters (slashes are
not relevant within comments), and a terminating CR.
MacLISP does not implement superbrackets for various good reasons,
but as a favor to InterLISP hackers, the E LISP commands do handle
them. A right superbracket is like enough right parentheses to
match hanging left parentheses back to and including the most recent
hanging left superbracket (or all hanging left parentheses if no
left superbracket is hanging). Also as a favor to InterLISP,
% initially has the same syntax as /, rather than alphabetic syntax.
The names of characters below are as in standard ASCII, not the SAIL character set.
End of comment ⊗
IMPURE
QLTBL: ;TABLE OF MacLISP CHARACTER SYNTAXES
" ",," " ;NULL
REPEAT 10-0,<"A",,"A"> ;↓ α β ∧ ¬ ε π λ
REPEAT 14-10,<" ",," "> ;TAB LF VT FORM
"↔",,"↔" ;CR
REPEAT 37-15,<"A",,"A"> ;∞ ∂ ⊂ ⊃ ∩ ∪ ∀ ∃ ⊗ ↔ _ → ~ ≠ ≤ ≥ ≡ ∨
" ",," " ;SPACE
"A",,"A" ;!
42*200+42,,42*200+42 ;" " is matched by "
REPEAT 44-42,<"A",,"A"> ;# $
"/",,"/" ;%
"A",,"A" ;&
"'",,"'" ;'
"(",,"(" ;(
")",,")" ;)
REPEAT 53-51,<"A",,"A"> ;* +
"'",,"'" ;,
REPEAT 56-54,<"A",,"A"> ;- .
"/",,"/" ;/
REPEAT 72-57,<"A",,"A"> ;0-9 :
15*200+";",,15*200+";" ;;
REPEAT 132-73,<"A",,"A"> ;< = > ? A-Z
"[",,"[" ;[
"A",,"A" ;\
"[]",,"[]" ;] ] is matched by [
REPEAT 137-135,<"A",,"A"> ;↑ ←
"'",,"'" ;`
REPEAT 173-140,<"A",,"A"> ;a-z {
"||",,"||" ;| | is matched by |
REPEAT 176-174,<"A",,"A"> ;} TILDE
" ",," " ;RUBOUT
QLLSEM: 0 ;RELATIVE LINENUM,,CHARNUM FOR START OF LAST ; OR | CONSTRUCT
QLASEM: 0 ;ADDRESS OF THAT LINE
QLLSXP: 0 ;RELATIVE LINENUM,,CHARNUM FOR START OF LAST SEXP
QLASXP: 0 ;ADDRESS OF THAT LINE
QLLPAR: 0 ;RELATIVE LINENUM,,CHARNUM FOR LAST OPEN LEFT PARENTHESIS
QLAPAR: 0 ;ADDRESS OF THAT LINE
QLLIND: 0 ;Saved relative number of line being parsed through
QLAIND: 0 ;Address of that line
QLCNT: 0 ;Argument given to QLIND command
QLCHG: 0 ;Number of lines changed
PURE
;QLIND QLIN01 QLIN00 QLIND0 QLIN1 QLIN1A QLIN2 QLIN3 QLIN30 QLIN3A QLIN3D QLIN3H QLIN4 QLIN4B QLIN4F QLIN4H QLIN4J QLIN4K QLIN4L QLIN4M QLIN4P QLIN4R QLIN4T QLIN5 QLIN6 QLIN6A QLIN7 QLIN7A QLIN8
;;; COMMAND TO LISP-INDENT <ARG> LINES BEGINNING WITH ARROW LINE.
QLIND: TRNE F,EDITM ;Coming from line editor?
PUSHJ P,FNEDT0 ;Yes, accept edited line (saving arg and bits)
MOVEI DSP,JPTAB ;Indirect table to use unless in attach mode
TRNN F,ATTMOD ;Attach mode?
JRST QLIN01 ;No
JUMPLE A,CPOPJ ;Non-positive arg is no-op in attach mode
MOVEI DSP,JATAB ;Attach mode indirect table
TRO F,ARG ;Don't move, add lines, or exit to line editor
QLIN01: TRNN F,ARG!REL ;Any arg?
CAIE B,CTMT3 ;No, skip if double bucky
JRST QLIN00
PUSHJ P,MOVARR ;For no arg αβ/ cmd, move down a line (A contains 1)
MOVE A,ARRLIN ;Examine new arrow line
SKIPE TXTCNT(A) ;If it is the end of page, then insert a real line
TLNE F,LINSM ;Are we in line insert mode?
PUSHJ P,INSONA ;Yes, insert a new line
MOVEI A,1 ;Now work on one line
QLIN00: JUMPG A,QLIND0
PUSHJ P,ADJARG ;See how many lines before here and move back
JUMPE A,CPOPJ ;Zero arg is a no-op
PUSH P,A ;Save number of lines we actually moved
PUSHJ P,QLIND0 ;Do all the dirty work
POP P,A
JRST MOVARR ;Move back to line we came from
QLIND0: MOVEM A,QLCNT
MOVE A,@JPT1(DSP) ;Get address of first line to be affected
SKIPN TXTCNT(A)
POPJ P, ;Do nothing if it is a page mark
PUSHJ P,ENDSET ;Set up for creation of new lines
TLO F,NOCHK ;Prevent shuffling of free storage
SETZB I,QLLSEM ;I holds a relative line number for comparisons
SETZB Q,QLASEM ;Q has state
SETZB K,QLLSXP ;K is a delayed copy of Q
SETZM QLASXP
SETZM QLCHG
MOVEI J,QLPDL-1 ;J is pointer for "pdl of parens"
TRNE F,ATTMOD
CAIN B,CTMT3 ;Double bucky in attach mode means use page context
SKIPA A,ARRLIN ;Use page context also for non-attach mode
JRST QLIN3 ;No context for single bucky attach mode cmd
TRNN F,ATTMOD ;In attach mode, or if no arg given,
TRNN F,ARG!REL ; we don't want to check the current line
HLRZ A,(A) ; for the beginning of an S-expression, so backup
QLIN1: CAIE A,PAGE ;Move upwards to the beginning of the page
SKIPN TXTCNT(A) ; or a line whose first character has "(" or "["
JRST QLIN1A ; syntax, whichever comes first
LDB C,[350700,,LLDESC(A)]
HLRZ A,(A)
HLRZ C,QLTBL(C) ;Get syntax type from LISP syntax table
ANDI C,177
CAIE C,"("
CAIN C,"["
CAIA
JRST QLIN1
QLIN1A: HRRZ A,(A) ;A now has the line to begin parsing from
QLIN2: CAMN A,ARRLIN ;Until we reach the arrow line,
JRST QLIN3 ; parse forward through the text,
PUSHJ P,QLLINE ; using the QLLINE routine on each line,
HRRZ A,(A) ; stepping through successive lines.
AOJA I,QLIN2
;The main indentation loop begins here: indent one line, then loop back if more.
QLIN3: HRRZ A,@JPT1(DSP) ;Address of first line to affect
QLIN30: MOVEM A,QLAIND ;Save address and relative number
HRLZM I,QLLIND ; of line to be indented
TRNN Q,-1 ;Do nothing if not within parentheses
JRST QLIN5
MOVE G,QLLPAR ;G and A hold "point of interest" in the parse
MOVE A,QLAPAR ;First consider the most recent unmatched "(":
ADDI G,1
MOVE TT,QLLSXP ;If there is a complete S-expression after it
ADDI TT,1 ; and before the line to be indented..
CAMG TT,QLLPAR
JRST QLIN4
HLLZ G,QLLSXP ; then if that S-expression begins on
MOVE A,QLASXP ; a later line than the unmatched "("..
CAMG G,QLLPAR
JRST QLIN3D
MOVEI E,LLDESC(A)
TLO E,440700
QLIN3A: ILDB C,E ; then we want to copy the indentation
CAIN C,40 ; of the line on which that S-expression begins.
AOJA G,QLIN3A
CAIN C,11
JRST QLIN3A
JRST QLIN4
QLIN3D: MOVE G,QLLPAR ;Otherwise this is the first new line within a list.
MOVE A,QLAPAR
ADDI G,1
MOVEI B,(G)
HLRZ I,G
PUSHJ P,QLMRSX ;Move right over one S-expression
MOVEI G,(B)
HRLI G,(I)
CAMG G,QLLSXP
JRST QLIN3H
MOVE G,QLLPAR
ADDI G,1
MOVE A,QLAPAR
JRST QLIN4
QLIN3H: PUSHJ P,QLMTSX ;Move right to beginning of next S-expression
;At this point the right half of G is the desired indentation level.
QLIN4: MOVE E,QLAIND ;Now determine the existing indentation level
HRRZ H,TXTCNT(E) ;Get col count for old version to see if empty line
ADD E,[440700,,LLDESC] ;Make byte pointer to old line's text
JUMPN H,.+2 ;Jump unless empty line
HRLI E,350700 ;Make byte pointer beyond fake space of empty line
TLZ F,TF1 ;TF1 will be on if in "middle" of a tab
SETZB B,D
SETZ H,
QLIN4B: ILDB C,E
CAIE C,40
JRST QLIN4F
TLNN F,TF1
ADDI H,1 ;H will get the number of actual spaces (not those in tabs)
AOJA B,QLIN4B ;B will get the indentation level
QLIN4F: CAIE C,11
JRST QLIN4H
TLC F,TF1
AOJA D,QLIN4B ;D will get TWICE the number of tabs
QLIN4H: CAIN B,(G) ;Compare current and desired indentations
JRST QLIN5 ;Indentation of this line unchanged, keep old line
;Copy the line using the new indentation
MOVE A,QLAIND ;Pointer to old line
AOS QLCHG ;Count the number of lines copied
HRRZ T,FSEND
ADDI T,1 ;T has pointer to new line being built
HRRZ TT,(A) ;Splice the new line in, in place of the old
LEG HRRM TT,(T)
HRLM T,(TT)
HLRZ TT,(A)
LEG HRLM TT,(T)
HRRM T,(TT)
HLLZ TT,TXTFLG(A) ;Copy the text flags from old line to new
LEG HLLM TT,TXTFLG(T)
TLNE TT,ARRBIT
MOVEM T,ARRLIN ;Save pointer to new FS block for arrow line
TLNE TT,WINBIT
MOVEM T,WINLIN ;Save pointer to new FS block for window line
TLNE TT,ARRBIT
TLZ F,NULLIN ;We never create an empty line
AOS TT,TXTNUM ;Give the new line a serial number
LEG HRRM TT,TXTSER(T)
LEG SETZM TXTWIN(T) ;clear window ptr for line in current window
MOVEI C,(G) ;Right half of G is desired indentation level
ANDI C,7 ;C gets number of trailing spaces
MOVEI TT,(G) ; for producing such an indentation
LSH TT,-3 ;TT gets number of tabs
ADDI TT,(C) ;Compute total number of characters for indentation
LSH D,-1 ;D/2+H is the number of characters in old indentation
ADDI D,(H)
SUBI TT,(D) ;Change in disk size of text
ADDM TT,@JCPTR(DSP) ;Adjust count of chars on page or in attach buffer
MOVSI TT,(TT)
ADD TT,TXTCNT(A) ;Add to count of old line to produce count of new
LEG HLLM TT,TXTCNT(T)
ADD A,[440700,,LLDESC] ;A gets byte pointer to old line
MOVEI E,LLDESC(T) ;E gets byte pointer to new line
TLO E,440700
SETZ H, ;H will accumulate display size of new line
MOVEI C,40
MOVEI D,11
MOVEI TT,(G) ;Install a suitable number of tabs
LSH TT,-3 ; in the new line
QLIN4J: SOJL TT,QLIN4K
LEG IDPB D,E
REPEAT 8,<LEG IDPB C,E>
LEG IDPB D,E
ADDI H,8 ;Leading tabs occupy 8 display columns
JRST QLIN4J
QLIN4K: MOVEI TT,(G) ;Install a suitable number of spaces
ANDI TT,7 ; in the new line
QLIN4L: SOJL TT,QLIN4M
LEG IDPB C,E
AOJA H,QLIN4L ;Spaces occupy one display column
QLIN4M: ILDB C,A ;Skip over indentation in old line
CAIE C,40
CAIN C,11
JRST QLIN4M
QLIN4P: CAIE C,15 ;Now copy rest of old line to new
CAIN C,12 ;<cr> and <lf> don't count toward display width
JRST QLIN4R
CAIE C,11
AOJA H,QLIN4R ;Non-tabs count one column
ILDB D,A ;Look for matching tab and flushes spaces between
CAIE D,11 ;End of tab?
JRST .-2 ;No
MOVEI TT,(H) ;Tabs round up to the next multiple of 8
ADDI H,8
TRZ H,7
SUBM H,TT ;TT gets the number of columns occupied by the tab
LEG IDPB C,E ;Deposit the tab into the line
MOVEI D,40
LEG IDPB D,E ;Now as many spaces as the tab occupies columns
SOJG TT,.-1 ;Then drop in and deposit another tab
QLIN4R:
LEG IDPB C,E ;Put character from old line into new line
CAIN C,12
JRST QLIN4T
ILDB C,A
JRST QLIN4P
QLIN4T: TDZA C,C ;Pad new line with nulls
IDPB C,E
TLNE E,760000
JRST .-2
HRRM H,TXTCNT(T) ;Clobber in display width of new line
MOVEI H,LLDESC(T) ;Address of FS text
MOVEI TT,1
IORM TT,(H) ;Make ASCID text
CAIE H,(E) ;End of text yet?
AOJA H,.-2 ;Nope
MOVEI E,2(E) ;Make it be a real live line
MOVSI TT,TXTCOD
FSFIX E,TT
MOVE A,QLAIND
MOVEM T,QLAIND
PUSHJ P,FSGIVE ;Give back the old line to free storage
;Now we are happy with the indentation; figure out whether there is another line to do.
QLIN5: SOSG QLCNT ;We are done if the count has run out.
JRST QLIN6
MOVE A,QLAIND
HLRZ I,QLLIND
HRRZ T,(A)
CAME T,JETST(DSP) ;Skip if we have reached the end of the text
SKIPN TXTCNT(T) ;We are done if we run up against a page mark or BOTSTR.
JRST QLIN6
PUSHJ P,QLLINE ;Otherwise parse through this line and continue.
HRRZ A,(A)
AOJA I,QLIN30
QLIN6: PUSHJ P,ENDFIX ;Close off expanding FS
TLZ F,NOCHK
SKIPN QLCHG ;Did anything get changed?
JRST QLIN6A ;No
XCT JWRT(DSP) ;We have changed the page or attach buffer
PUSHJ P,CORCHK ;maybe core down
QLIN6A: TRNE F,ARG!REL
POPJ P, ;An explicit arg leaves us out of line editor
SETZ TT, ;Otherwise count number of control-spaces
HRRZ A,ARRLIN ; needed to move past the indentation
ADD A,[440700,,LLDESC]
QLIN7: ILDB C,A
CAIN C,40
AOJA TT,QLIN7
CAIE C,11
JRST QLIN8
QLIN7A: ILDB C,A
CAIE C,11
JRST QLIN7A
AOJA TT,QLIN7
QLIN8: PUSH P,TT
PUSH P,[240] ;Control (200) space (40)
JRST EDIT1 ;Go back into line editor
;QLSTEP QLSTP1 QLSTP2 QLST2A QLSTP3 QLSTP4 QLSTP5 QLSTP6 QLSTP7 QLST7A QLST7B
;;; UPDATE STATE OF LISP PARSE BY ONE CHARACTER
;;; A: ADDRESS OF CURRENT LINE
;;; B: NUMBER IN LINE OF CHARACTER IN C
;;; C: CHARACTER
;;; I: RELATIVE LINENUM FOR LINE WHOSE ADDRESS IS IN A
;;; J: "PDL pointer" FOR PARENS INFO
;;; K: PREVIOUS STATE
;;; Q: STATE OF PARSE, TO BE UPDATED
;;; LEFT HALF BITS:
QLSEMI←←1 ;IN MIDDLE OF ;..<CR>
QLVBAR←←2 ;IN MIDDLE OF |..| OR ".."
QLATOM←←4 ;ATOM HAS STARTED OR IS BEING CONTINUED
QLSLSH←←10 ;A / HAS BEEN SEEN
;;; BITS 0-6 CONTAIN CHARACTER FOR MATCHING | OR ", IF ANY
;;; COUNT OF OPEN PARENS IS IN RIGHT HALF
;;; T: CHARACTER TYPE
QLSTEP: TLZE Q,QLSLSH ;If previous character was "/", clear bit and exit
POPJ P,
HLRZ T,QLTBL(C) ;Get character type from table
ANDI T,177
TLZ Q,QLATOM ;Not start of an atom until later notice
TLNN Q,QLSEMI ;Are we in the middle of a ";..<cr>"?
JRST QLSTP1
CAIN T,"↔" ;If so, only a terminating "<cr>" is of interest
TLZ Q,QLSEMI
POPJ P,
QLSTP1: CAIE T,"/" ;Is this character a "/"?
JRST QLSTP2
TLO Q,QLSLSH!QLATOM ;If so, record the fact (also, this begins an atom)
POPJ P,
QLSTP2: CAIE T,"|" ;Is this character a "|"?
JRST QLSTP3
TLCE Q,QLVBAR ;If so, complement "in-vertical-bar-ness"
JRST QLST2A
LDB TT,[310700,,QLTBL(C)]
DPB TT,[350700,,Q] ;If we were not in vertical bars before,
MOVEM B,QLLSEM ; remember what the matching character is,
SOS QLLSEM ; and record where the vertical bar began.
HRLM I,QLLSEM
MOVEM A,QLASEM
TLO Q,QLATOM ;This starts an atom
POPJ P,
QLST2A: LDB TT,[350700,,Q] ;If we were in vertical bars, then this
CAIE TT,(C) ; gets us out if it matches
TLO Q,QLVBAR!QLATOM ;Otherwise note that we're still in it
POPJ P,
QLSTP3: TLZE Q,QLVBAR ;If that wasn't a vertical bar, but we are
JRST QLST2A ; in vertical bars, check only for a match anyway
CAIE T,";" ;Is this character a ";"?
JRST QLSTP4
TLO Q,QLSEMI ;If so, record that we are in ";..<cr>"
MOVEM B,QLLSEM ; and where it began
SOS QLLSEM
HRLM I,QLLSEM
MOVEM A,QLASEM
POPJ P,
QLSTP4: CAIE T,"A" ;If this is a plain old alphabetic character,
JRST QLSTP5 ; just note the fact that it begins
TLO Q,QLATOM ; an atom (or continues it)
POPJ P,
QLSTP5: CAIE T,"(" ;Is this character a "("?
CAIN T,"[" ;Or maybe "["?
CAIA
JRST QLSTP7
ADDI J,2 ;If so, try to remember its position
CAIL J,QLEPDL ; on the "parens pdl"
JRST QLSTP6
MOVEM B,-1(J)
SOS -1(J)
HRLM I,-1(J)
HRRZM A,(J)
DPB C,[310700,,(J)] ;Remember what the character was
QLSTP6: HRRI Q,1(Q) ;Increment the parens count in the state word
POPJ P,
QLSTP7: CAIE T,")" ;Is this character a ")"?
CAIN T,"]" ;Or maybe a "]"?
CAIA
POPJ P, ;If not, must be a space or "'" -- ignore it
QLST7A: TRNE Q,-1 ;Decrement the parens count in the state word,
HRRI Q,-1(Q) ; but do not let it go below zero
SETO TT,
CAIG J,QLPDL-1 ;Try to pop a "(" position from the
POPJ P, ; parens pdl, and remember it as the beginning
MOVE TT,-1(J) ; of the last S-expression
MOVEM TT,QLLSXP
MOVE TT,(J)
HRRZM TT,QLASXP ;Bits 4-10 of TT have the character for "]" to match
SUBI J,2
XOR TT,QLTBL(C)
TLNE TT,77600 ;If the character matches,
CAIE T,"]" ; or if it is not "]" after all (but rather ")"),
POPJ P, ; then we are done
JRST QLST7A ;Otherwise try to pop another entry from the pdl
;QLLINE QLLIN2 QLLIN4 QLLIN6
;;; PARSE THROUGH LINE WHOSE ADDRESS IS IN A
;;; A: ADDRESS OF CURRENT LINE
;;; I: RELATIVE LINENUM FOR LINE WHOSE ADDRESS IS IN A
;;; J: "PDL pointer" FOR PARENS INFO
;;; K: PREVIOUS STATE
;;; Q: STATE OF PARSE, TO BE UPDATED
QLLINE: MOVEI E,LLDESC(A) ;Get byte pointer to text
TLO E,440700
SETZ B, ;B is the relative character position
QLLIN2: TLNN K,QLVBAR!QLATOM!QLSLSH ;If we were not in an atom last time,
TLNN Q,QLVBAR!QLATOM!QLSLSH ; but this time we were,
JRST QLLIN4 ; then we have tripped across
MOVEM B,QLLSXP ; the start of an S-expression
SOS QLLSXP
HRLM I,QLLSXP
MOVEM A,QLASXP
QLLIN4: MOVE K,Q ;Backup our state
ILDB C,E ;Get next character from text
CAIE C,11 ;Don't count tabs,
ADDI B,1 ; but count any other character
PUSHJ P,QLSTEP ;Perform one step of a LISP parse
CAIE C,12 ;Unless that was a line feed,
JRST QLLIN2 ; keep going
CAIGE J,QLPDL ;If there is any dope on the parens pdl,
JRST QLLIN6 ; then dredge it up and remember it
MOVEI T,(J) ; as the position of the most recent
CAIL T,QLEPDL ; unmatched "("
MOVEI T,QLEPDL-1
MOVE TT,-1(T)
MOVEM TT,QLLPAR
MOVE TT,(T)
MOVEM TT,QLAPAR
POPJ P,
QLLIN6: SETZM QLLPAR ;If the parens pdl was empty, there was
SETZM QLAPAR ; no "most recent unmatched '('"
POPJ P,
;QLMTSX QLMT1 QLMT1A QLMT2 QLMT4 QLMT5 QLMT8
;;; MOVE RIGHT TO BEGINNING OF NEXT S-EXPRESSION.
;;; A: ADDRESS OF LINE CONTAINING START OF MOVEMENT
;;; G: RELATIVE LINE NUMBER,,CHARACTER POSITION FOR START OF MOVEMENT
;;; MUST RETURN AN UPDATED A AND G AFTER THE SCAN.
;;; MUST SAVE J, K, Q, QLLSXP, QLASXP, ETC.
QLMTSX: PUSH P,QLLSEM ;Save infinite garbage
PUSH P,QLASEM
PUSH P,QLLSXP
PUSH P,QLASXP
PUSH P,J
PUSH P,K
PUSH P,Q
HLRZ I,G ;I is the relative line number
MOVEI B,(G) ;B is the relative character number (within a line)
SETZB Q,K ;Q and K are parse state variables
MOVEI E,LLDESC(A) ;Get a byte pointer to the text
TLO E,440700
MOVEI TT,(B)
QLMT1: SOJL TT,QLMT2 ;Skip forward to specified character position
QLMT1A: ILDB C,E
CAIN C,11
JRST QLMT1A
JRST QLMT1
QLMT2: TLNN K,QLVBAR!QLATOM!QLSLSH ;If we were previously not in an atom,
TLNN Q,QLVBAR!QLATOM!QLSLSH ; but this time we were,
JRST QLMT4
JRST QLMT8 ; then we have run into an S-expression
QLMT4: MOVE K,Q ;Backup parse state
ILDB C,E ;Get the next character
CAIE C,11 ;Don't count tabs in the
ADDI B,1 ; character count
MOVEI J,QLEPDL ;Prevent QLSTEP from using the PDL
PUSHJ P,QLSTEP ;Do one step of the LISP parse
TLNE Q,QLSEMI ;If we're in a ";..<cr>" comment,
JRST QLMT5 ; ignore everything
CAIE T,"(" ;Otherwise a "(" or "'" certainly
CAIN T,"'" ; begins an S-expression (we cannot be
JRST QLMT8 ; inside vertical bars at this point)
QLMT5: CAIE C,12 ;If we hit a line feed,
JRST QLMT2 ; we must switch to the next line
HRRZ A,(A) ; of text
XCT JARTST(DSP) ;If attach mode, test for reaching arrow line
HRRZ A,ATTBUF ;And if so, continue scanning inside attach buffer
SETZ B, ;Reset byte pointer and character counter, bump the
MOVEI E,LLDESC(A) ; relative line number, and carry on
TLO E,440700
AOJA I,QLMT2
QLMT8: MOVEI G,-1(B) ;Move the relevant information back into G
HRLI G,(I)
POP P,Q ;Restore the garbage
POP P,K
POP P,J
POP P,QLASXP
POP P,QLLSXP
POP P,QLASEM
POP P,QLLSEM
POPJ P,
;QLMRSX QLMR1 QLMR1A QLMR4 QLMR6 QLMR7 QLMR8
;;; MOVE RIGHT OVER NEXT S-EXPRESSION.
;;; A: ADDRESS OF LINE CONTAINING START OF MOVEMENT
;;; G: RELATIVE LINE NUMBER,,CHARACTER POSITION FOR START OF MOVEMENT
;;; MUST RETURN AN UPDATED A AND G AFTER THE SCAN.
;;; MUST SAVE J, K, Q, QLLSXP, QLASXP, ETC.
QLMRSX: PUSH P,QLLSEM ;Save infinite garbage
PUSH P,QLASEM
PUSH P,QLLSXP
PUSH P,QLASXP
PUSH P,J
PUSH P,K
PUSH P,Q
HLRZ I,G ;I is the relative line number
MOVEI B,(G) ;B is the relative character number (within line)
TLZ F,TF1 ;TF1 will be set if we encounter an atom
SETZB Q,K ;Q and K are the parse state variables
MOVEI E,LLDESC(A) ;Get a byte pointer to the text
TLO E,440700
MOVEI TT,(B) ;Desired char position
QLMR1: SOJL TT,QLMR4 ;Move to specified character position
QLMR1A: ILDB C,E
CAIN C,11
JRST QLMR1A
JRST QLMR1
QLMR4: MOVE K,Q ;Backup parse state
ILDB C,E ;Get the next character
CAIE C,11 ;Don't count tabs in
ADDI B,1 ; the character count
MOVEI J,QLEPDL ;Prevent QLSTEP from using the pdl
PUSHJ P,QLSTEP ;Do one step of the LISP parse
TLNN Q,QLSEMI ;If within a ";..<cr>" comment,
TRNE Q,-1 ; or within some set of parentheses,
JRST QLMR6 ; then we cannot have finished an S-expression
TLNE F,TF1 ;If we were within an atom,
TLNE Q,QLATOM ; and are no longer,
CAIA ; then we have passed over
JRST QLMR8 ; an S-expression (and overshot)
TLNE Q,QLATOM ;Note now if we have encountered an atom
TLO F,TF1
TRNE K,-1 ;If the last character was within parentheses,
JRST QLMR7 ; we must have just now emerged
QLMR6: CAIE C,12 ;If we have reached a line feed,
JRST QLMR4 ; we must go to the next line of text
HRRZ A,(A)
XCT JARTST(DSP) ;If attach mode, test for reaching arrow line
HRRZ A,ATTBUF ;And if so, continue scanning inside attach buffer
CAIE A,ATTBUF ;We shouldn't be wrapping around in attach buffer
SKIPN TXTCNT(A) ;This shouldn't be the end of a page
PUSHJ P,TELLZ ;BUG!!
SETZ B,
MOVEI E,LLDESC(A)
TLO E,440700
AOJA I,QLMR4
QLMR7: SKIPA G,B ;Here if we have just finished an S-expression
QLMR8: MOVEI G,-1(B) ;Here if we overshot by a character
HRLI G,(I)
POP P,Q ;Restore garbage
POP P,K
POP P,J
POP P,QLASXP
POP P,QLLSXP
POP P,QLASEM
POP P,QLLSEM
POPJ P,
;LISPSY LISPS2 LISPTL LISPT2 LISPER LISPE2 LISPRS OCTIN OCTINL OCTINX
;Here for the ⊗XLISPSYNTAX command to diddle the syntax table for ⊗/ cmd.
LISPSY: JUMPL A,LISPRS ;Negative arg means reset to initial syntax
PUSHJ P,XTDLMT ;Skip any cmd name delimiter
PUSHJ P,XTDLIN ;Prepare to reread extended command line
PUSHJ P,OCTIN ;Read an octal number of char of interest into B
JRST LISPER ;No octal number seen is illegal
CAIL B,200
JRST LISPER ;Invalid char code
MOVEI E,(B) ;Save char of interest
CAIN C,15
JRST LISPTL ;Report meaning of given char
CAIE C," "
JRST LISPER ;Oops
PUSHJ P,OCTIN ;Maybe read octal of initial super bracket
JRST LISPS2 ;No octal number means no initial super bracket
CAIN C," "
PUSHJ P,TYI ;Get syntax-type char
JRST LISPER ;Gotta be preceded by space; activator is illegal.
LSH B,7 ;Put initial super bracket char in left position
LISPS2: PUSHJ P,TYIT ;Check syntax-type char for activator
JRST LISPER ;Activator is illegal
MOVEI D,(C) ;Save syntax-type char
PUSHJ P,TYI ;Should be followed immediately by CR
CAIE C,15 ;Activator, should be a CR
JRST LISPER ;Bad command
MOVEI TT,LQLSYM-1 ;Length of table of legal syntax types
CAME D,QLSYMS(TT) ;Is this it?
SOJGE TT,.-1
JUMPL TT,LISPE2 ;Char is not in table
IORI D,(B) ;Include initial super bracket if any
HRLM D,QLTBL(E) ;Store new syntax type for given char
SKIPGE BLAB ;Report results except in terse mode
POPJ P,
LISPTL: PUSHJ P,ABCRLF
SETZM TYOPNT
OUTSTR [ASCIZ/Syntax type of character /]
MOVEI C,(E)
PUSHJ P,PRNTCH ;Print char in C
TYPCHR " ("
TYPOCT E
OUTSTR [ASCIZ/) -- /]
LDB C,[POINT 7,QLTBL(E),10] ;Get initial super bracket, if any
JUMPE C,LISPT2
PUSHJ P,PRNTCH ;Print char in C (initial super bracket)
TYPCHR " ("
TYPOCT C
OUTSTR [ASCIZ/) /]
LISPT2: LDB C,[POINT 7,QLTBL(E),17] ;Get syntax type char
PUSHJ P,PRNTCH ;Print it
OUTSTR [ASCIZ/
/]
JRST POPJ1
LISPER: SETZM TYIPNT
SORRF <Format is <octal for char being changed><space><syntax type>>
JRST POPJ1
LISPE2: SETZM TYIPNT
SORRJ Not a valid Lisp syntax type --
PUSHJ P,PRNTCH ;Print char in C
OUTSTR [ASCIZ/
/]
JRST POPJ1
LISPRS: MOVEI TT,200-1 ;Reset all 200 entries in syntax table
HRLS QLTBL(TT) ;Reset entry
SOJGE TT,.-1
SKIPGE BLAB
POPJ P, ;Terse mode -- sshh!
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Lisp syntax table reset to initial default.
/]
JRST POPJ1
;Routine to read a (small) octal number into B. Skip returns if any found.
OCTIN: MOVSI B,400000 ;Collect octal number here, flag none seen yet
OCTINL: PUSHJ P,TYI ;Get next char
JRST OCTINX ;Activator
CAIL C,"0" ;Octal digit?
CAILE C,"7"
JRST OCTINX ;No
LSH B,3 ;Previously collected digits
ADDI B,-"0"(C) ;Plus new digit
JRST OCTINL
OCTINX: JUMPGE B,POPJ1 ;Skip return if octal number read
MOVEI B,0
POPJ P,
;BEEPME BEEPM2 VERBOS TERSE VERSAY SILENT ECHO IECHO IECHO2 ECHO2 ECHO3 SAY SAY2 CVTALS CVTALT CVTAL0 CVTAL2
BEEPME:
BEEPM2: SETO T,
BEEP T, ;Beep him--we still provide this feature.
POPJ P,
;To change the value of BLAB to <0 for terse, 0 for normal, >0 for verbose
VERBOS: JUMPE A,VERSAY
SKIPGE A
SETZ A,
MOVEM A,BLAB#
POPJ P,
TERSE: JUMPE A,VERSAY
SKIPGE A
SETZ A,
MOVNM A,BLAB
POPJ P,
VERSAY: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Reporting state is: /]
SKIPN BLAB
OUTSTR [ASCIZ/Normal. /]
SKIPGE BLAB
OUTSTR [ASCIZ/Terse. /]
SKIPLE BLAB
OUTSTR [ASCIZ/Verbose. /]
SKIPLE SILENC ;Suppressing error msgs?
OUTSTR [ASCIZ/Macro errors: Silent. /] ;Yes
JRST POPJ1
;Command to suppress error messages inside macros only
SILENT: JUMPE A,VERSAY
MOVEM A,SILENC# ;Set or clear silence flag
POPJ P,
;Command to suppress echoing of text edited in line editor.
ECHO: JUMPE A,ECHO2
MOVEM A,NOECHO# ;Set or clear noecho flag -- negative means no echo
POPJ P,
;Command to suppress echoing of all text input to E.
IECHO: JUMPE A,IECHO2 ;zero arg reports status
MOVEM A,NOIECH# ;set or clear no-input-echo flag (like NOECHO)
IFN DECSW,<
MOVE C,[3,,[.TOSST ↔ 0 ↔ 200]] ;turns echoing off
SKIPL NOIECH ;Skip if echoing being suppressed
MOVE C,[3,,[.TOCST ↔ 0 ↔ 200]] ;turns echoing on
TRMOP. C, ;diddle echoing
JFCL
>
IFE DECSW,<
SKIPL NOIECH ;Skip if echoing being suppressed
PTJOBX [0↔4] ;Turn echoing back on.
SKIPGE NOIECH ;Skip if echoing being suppressed
PTJOBX [0↔3] ;Turn echoing off
>
POPJ P,
IECHO2: OUTSTR [ASCIZ/ Input/]
MOVE T,NOIECH ;get old state, in case reporting
JRST ECHO3
ECHO2: OUTSTR [ASCIZ/ Line-editor/]
MOVE T,NOECHO ;get old state, in case reporting
ECHO3: OUTSTR [ASCIZ/ Echoing is O/]
SKIPL T
OUTSTR [ASCIZ/n. /]
SKIPGE T
OUTSTR [ASCIZ/ff. /]
JRST POPJ1
;Command routine (for macro use) to type out arbitrary one line msg and/or number.
SAY: PUSHJ P,XTDLMT ;ignore delimiter of cmd name
MOVSI T,'TTY' ;Type out to self
MOVE TT,EXTPNT ;Get pointer to text following command name
TLZ TT,7777 ;Type up to null
MOVEI D,T
TTYMES D, ;Type message to self
JFCL ;Can't happen, always waits for self
JUMPL A,SAY2
TRNE F,REL
OUTCHR ["+"]
SAY2: SETZM TYOPNT ;Type any output
TRNE F,ARG!REL
TYPDEC A ;Type out repeat arg
CAIN B,CTMT3 ;double bucky?
JRST PPJ1CR ;Type out CRLF
JRST POPJ1
;Set instruction that does or doesn't convert altmodes in files being formatted.
;Here from /nV switch, not allowed to skip return.
CVTALS: JUMPE A,CVTAL0 ;zero arg in switch is same as positive arg
;Here from extended command
CVTALT: JUMPE A,CVTAL2 ;zero arg means report
SKIPL A
CVTAL0: SKIPA T,[MOVEI C,"}"] ;here from INIT, make altmodes converted to braces
MOVSI T,(<JFCL>) ;use this instruction to avoid converting altmodes
MOVEM T,ALTCVT# ;save instruction executed by dispatch tables
POPJ P,
CVTAL2: PUSHJ P,ABCRLF
MOVS T,ALTCVT ;get instruction executed for altmodes
MOVEI TT,[ASCIZ/Altmodes in files are not converted.
/]
CAIE T,(<JFCL>) ;skip if no-op
MOVEI TT,[ASCIZ/Altmodes in files become right braces.
/]
OUTSTR (TT)
JRST POPJ1
;Readonly variables, numeric macro calculations. ;⊗ MACEVL MACEV2 MACEV0 MACEV3 MACEV4 MACEV5 MACEV6 MACEV7 SET SETXL SETXL0 SETX SETX2 SETX2S SETXNM SETSTR SETSTL SET0 SET0S SET2 SET0X SETDIG SUBTRA ADD MINIM2 MAXIM2 MINIMU MAXIMU REMAI2 REMAIN ARGUND ARGBAD RDVUM2 RDVUND RDVSTE ARGUME DIVIDE MULTIP MULTI2 MACHA0 MACHA6 MACHA5 MACHAK MACHA2 TSTTAB TSTTB2 IFLT IFGT IFEQ IFNE IFLEQ IFGEQ TESTER TESTE2 GSLISP GSLIS2 GSLIS3 GSUBJB GSUBJ2 GSUBJ4 GSUBJ3 GSUBJR GSUBSK GSUBTP RDVLIN RDVLNS RDVPAG RDVPA2 RDVCOL RDVCLS CHRNUM CHRCNT RDVCHR RDVSIX RDVEFL RDVWFL RDVRFL RDVIFL RDVNOD RDVSTP RDVROM NFOUND FINDEX RDVFNM RDVFPL RDVSTX RDVDAT RDVTIS RDVDTS RDVDYT RDVDYS RDVDAY RDVDTM RDVTIM RDVDA2 RDVWDL RDVNDA RDVMOL RDVTI2 RDVTYP RDVTY2 RDVTY3 VALTYP LENSKP RDVAR NRDVAR RDVARP
;Routine to scan macro definition for decimal number.
;If no number seen, takes direct return.
;If find a number, takes skip return with value in E,
; with LH(MACREL) set to -1 iff value is Relative (+).
MACEVL: SETZB E,MACREL# ;Collect value in E, clear Relative/Negative flags
MOVEI B,MACTXT(D) ;Make byte pointer to text of macro def
HRRZS (P) ;Flag no number seen yet in macro def
TLOA B,441100
MACEV2: HRROS MACREL ;Flag as relative
MACEV0: ILDB T,B ;Get char from macro
ANDI T,177 ;Flush bucky bits
CAIN T,"-"
JRST [ HLLOS MACREL ;Flag as negative
JRST MACEV0]
CAIN T,"+"
JRST MACEV2 ;Flag relative arg and loop
MACEV3: CAIL T,"0"
CAILE T,"9"
JRST MACEV5 ;Not a digit
IMULI E,=10 ;Shift previous value over one digit
ADDI E,-"0"(T) ;Add in new digit
MACEV4: HRROS (P) ;We saw a number
ILDB T,B ;Next char from macro
ANDI T,177 ;No bits
JRST MACEV3 ;Loop
MACEV5: CAIE T,"∞"
JRST MACEV6 ;End of value
MOVEI E,MAXARG
JRST MACEV4
MACEV6: HRRZ T,MACREL ;Get Negative flag
JUMPE T,MACEV7 ;Jump unless value should be negative
MOVN E,E ;Negative value
MACEV7: POP P,T ;Get value-seen flag and return address
TLNE T,-1 ;Skip if we didn't see a number
JRST 1(T) ;Take skip return with value in E
JRST (T) ;Direct return for no value seen
;Routine to define numeric macro from repeat arg given to cmd.
;Macro definition will contain a possibly signed (+ or -) string of digits.
SET: PUSHJ P,XTDLIN ;Prepare to reread extended command line
SETZ Q, ;Don't save actual input
PUSHJ P,GETWRD ;Collect sixbit word in TT, mask in XMSK
MOVEI Q,-1 ;No word found
MOVEI Q,-1 ;Terminating char of word was activator
PUSHJ P,MACCHK ;Make sure destination macro has valid name
JRST MACBN0 ;Nope, bad name
JUMPN Q,SET0 ;Jump if line ended, no second macro name
SETXL: CAIE C,"="
CAIN C,"←"
JRST SETX ;Okay, copy one macro's numeric value into another
PUSHJ P,TYI
JRST SET0 ;Activator without assignment
TLNE T,LETF!NUMF!LT2F ;Not supposed to have letter/numbers here
JRST SETXL0 ;Oops
MOVE T,JCTAB(C)
TLNN T,MACF ;Not supposed to have special macro-call cmd char
JRST SETXL
SETXL0: SETZM TYIPNT ;Flush remainder of line
JRST MACABT ;Abort this command
;Here to copy one macro into another.
SETX: MOVE E,TT ;Save first (destination) macro name
PUSHJ P,GETMA2 ;Read next (source) macro's name
CAIN C,"." ;Maybe this is a readonly variable
JRST SETX2 ;Yes!
PUSHJ P,FNDMAC ;Get pointer to source macro into D
JRST MACUND ;No such macro
HRRZ B,-1(D) ;Get length of source FS block
MOVEI B,-2(B) ;Don't count the header
PUSHJ P,FSGET ;Get identical size block for destination macro
MOVE TT,E ;Put name back where MACFI1 will expect it
MOVE E,A ;Pointer to new macro's FS
MOVEM TT,MACNAM(E) ;Store name of destination macro
SETZM MACFLG(E) ;No flags for this new macro
MOVSI T,MACCOD
HLLM T,-1(E) ;Mark FS as containing a macro
MOVSI T,MACTXT(D)
HRRI T,MACTXT(E) ;Make blt pointer for copying macro def
ADD A,-1(D) ;Add length of FS block to get pointer beyond end
BLT T,-1-2(A) ;Copy old macro to new
PUSHJ P,MACFI1 ;Link new macro into list
JRST MACTY0 ;Type out definition
SETX2: MOVSI J,SET0S ;Flag normal command, give exit address for MACHAK
MOVE A,E ;Save destination macro's name
MOVE I,[PUSHJ P,SETXNM] ;XCTed by MACHAK when value of macro is in E
SETX2S: MOVE T,[POINT 7,TMPBUF] ;Pointer to constant loc for string
MOVEM T,OKSTRG# ;Permit string readonly variable
JRST MACHA5 ;Get value of readonly variable
SETXNM: MOVE TT,A ;Set up name of macro to be SET into
MOVE A,E ;Get value to be stored in macro
SETO D, ;Don't let us just type out readonly variable value
POPJ P,
SETSTR: SKIPA B,OKSTRG ;Get pointer to loc for string
SETSTL:
LEG IDPB T,E ;Deposit char in macro
ILDB T,B ;Get next char from string
JUMPN T,SETSTL ;Loop till null in string
JRST SET0X ;Close off macro def, finish up
SET0: SETZM OKSTRG ;Indicate that we don't have string var
SET0S: PUSH P,A ;Save new numeric value or byte ptr for string
PUSHJ P,MACSET ;Set E w/bpt into expandable FS for macro name in TT
POP P,A ;Macro's numeric value or byte ptr
SKIPE OKSTRG ;Skip unless this is a string readonly variable
JRST SETSTR ;Go copy readonly variable string into macro
MOVEI T,"+"
JUMPGE A,SET2
MOVM A,A
SKIPA T,["-"] ;(If came from MULTI2 below, REL may be off)
SET2: TRNE F,REL ;If relative arg, insert sign in definition
LEG IDPB T,E
MOVEI T,SETDIG ;Routine to call for each digit
MOVEM T,TYOADR
TYPDEC A ;Convert numeric value into 9-bit macro string
SETZM TYOADR ;Back to normal output
SET0X: PUSHJ P,MACFI0 ;Finish off macro def, don't change LSTMAC
JRST MACTY0 ;Type out name and new def
SETDIG:
LEG IDPB T,E ;Special routine to make ILM legal here
POPJ P,
;Routines to diddle numeric macro by repeat arg given to cmd. Result goes into A.
SUBTRA: SKIPA I,[SUBM E,A] ;Subtract repeat arg from macro value
ADD: MOVE I,[ADDM E,A] ;Add repeat arg to macro value
JRST MULTI2
MINIM2: CAMGE E,A ;A ← min(A,E)
MOVE A,E
POPJ P,
MAXIM2: CAMLE E,A ;A ← max(A,E)
MOVE A,E
POPJ P,
MINIMU: SKIPA I,[PUSHJ P,MINIM2]
MAXIMU: MOVE I,[PUSHJ P,MAXIM2]
JRST MULTI2
REMAI2: PUSH P,E+1
IDIV E,A
MOVE A,E+1 ;A ← remainder(E/A)
POP P,E+1
POPJ P,
REMAIN: MOVE I,[PUSHJ P,REMAI2]
JRST MULTI2
;MACHAK and ARGUM0 jump into following 4 routines (J)
;w/RH(J) containing 0 or -1 or -2.
PUSHJ P,TELLZ ;should never get here
JSP D,CLRTYI ;Flag error for CMDSP
ARGUND: SETZM TYIPNT ;Make sure we stop re-reading extended cmd line
JRST MACUND ;Say macro not defined
PUSHJ P,TELLZ ;should never get here
JSP D,CLRTYI ;Flag error for CMDSP
ARGBAD: SETZM TYIPNT ;Make sure we stop re-reading extended cmd line
SORRJ Macro
SETZM TYOPNT
TYPMAC TT
OUTSTR [ASCIZ/ not numeric. /]
JRST POPJ1
RDVUM2: PUSH P,TT
PUSHJ P,ENDFIX ;Close off expandable FS opened by MEDIT.
POP P,TT
JRST RDVUND
JRST RDVUM2 ;Here from MACHA5 with J holding -2.
JSP D,CLRTYI ;Flag error for CMDSP
RDVUND: SETZM TYIPNT ;Make sure we stop re-reading extended cmd line
SORRF No such readonly value --
SETZM TYOPNT
TYPMAC TT
OUTCHR ["."]
JRST PPJ1CR
PUSHJ P,TELLZ ;should never get here
JSP D,CLRTYI ;Flag error for CMDSP
RDVSTE: SETZM TYIPNT ;Make sure we stop re-reading extended cmd line
SORRF String readonly variable not allowed in this context --
SETZM TYOPNT
TYPMAC TT
OUTCHR ["."]
JRST PPJ1CR
;Routine to set up repeat arg for following command from particular variable.
ARGUME: TRO F,ARG ;Definitely will have an arg when done here
TRNE F,NEG ;Negative arg to ARGUMENT cmd?
MOVN A,A ;Yes, make arg negative
MOVE I,[ADDM E,A] ;Instruction XCTed by MACHAK
HRLOI J,ARGUM2 ;Flag from arg cmd, give exit address for MACHAK
JRST MACHA0 ;Get macro's value and combine with our arg
DIVIDE: SKIPA I,[IDIVM E,A] ;Divide macro value by repeat arg
MULTIP: MOVE I,[IMULM E,A] ;Multiply macro value by repeat arg
MULTI2: MOVSI J,SET0 ;Flag from normal cmd, give exit address
MACHA0: PUSHJ P,GETMAC ;Get macro name into TT
MACHA6: SETZM OKSTRG# ;Don't permit string readonly variables
CAIE C,"." ;Name followed by dot means is RDV
JRST MACHAK ;Normal macro name
MOVEI D,0 ;Flag this as not real macro but readonly var
;Here we evaluate the readonly variable (RDV) whose name is in TT.
;RH(J) contains 0 unless coming from immediate cmd (e.g., ARGUMENT),
; in which case RH(J) contains -1.
MACHA5: MOVSI T,-NRDVAR ;Number of readonly values
CAME TT,RDVAR(T) ;Does name match this readonly variable?
AOBJN T,.-1 ;No, keep looking
JUMPGE T,RDVUND(J) ;No such readonly value
SETZM MACREL ;Flag RDV value as NOT relative
XCT RDVARP(T) ;Get readonly value where MACHAK expects it
JRST MACHA2 ;Numeric readonly var, do something with the value
SKIPE OKSTRG ;Skip if string readonly variable not permitted
TRNE J,1 ;Skip unless immediate cmd (should always skip)
JRST RDVSTE(J) ;String readonly variable not allowed here
XCT I ;Operate on macro value or maybe return
HLRZ J,J ;Get exit address
JRST (J) ;Return to SET0S (or wherever)
MACHAK: PUSHJ P,FNDMAC ;Get pointer to macro into D
JRST ARGUND(J) ;No such macro
PUSHJ P,MACEVL ;Get value of the macro
JRST ARGBAD(J) ;No number in macro
MACHA2: SETZM OKSTRG ;Indicate not string readonly variable
XCT I ;Operate on macro value with repeat arg
TRNN J,-1 ;Skip if here from immediate cmd (ARGUMENT)
JUMPE D,VALTYP ;If using readonly variable, just type result
TRZE F,NEG
TRZ F,REL ;Negative operand doesn't imply relative value
SKIPGE MACREL ;Skip unless macro value was relative
TRO F,REL ;Force result arg to be relative
HLRZ J,J ;Get exit address
JRST (J) ;Join SET (define numeric macro) or LBS (set arg)
;Table of XCTed instructions for tests requested routines at TSTTB2
TSTTAB: CAML A,E ;A holds arg to cmd, E holds macro's value
CAMG A,E
CAME A,E
CAMN A,E
CAMLE A,E
CAMGE A,E
;Command routines for tests of macros. Set up K as index into TSTTAB table.
TSTTB2::
IFLT: JSP K,TESTER ;less than
IFGT: JSP K,TESTER ;greater than
IFEQ: JSP K,TESTER ;equal
IFNE: JSP K,TESTER ;not equal
IFLEQ: JSP K,TESTER ;less or equal ("Q" avoids conditional as'bly!)
IFGEQ: JSP K,TESTER ;greater or equal
TESTER: MOVE I,[JRST TESTE2]
JRST MULTI2 ;Now go evaluate macro
TESTE2: XCT TSTTAB-TSTTB2-1(K) ;Make test
AOSA (P) ;False
POPJ P, ;True
SORRY False test.
POPJ P,
;Here are various routines to evaluate certain readonly variables.
;Result is always returned in E.
;Routines must preserve at least TT,J,C,A,I.
;Get number of first Lisp subjob in the stack (return in E).
GSLISP: SKIPLE E,LISPJB ;skip if no connected Lisp subjob
POPJ P, ;return job number
MOVN E,JOBMAX ;get count of disconnected jobs in subjob stack
JUMPE E,CPOPJ ;return zero if none
MOVSI T,(E) ;make aobjn ptr
GSLIS2: SKIPLE E,OLDJOB(T) ;Lisp subjob here?
JRST GSLIS3 ;yes, return its number, negated, in E
AOBJN T,GSLIS2 ;no, look down the subjob stack
MOVEI E,0 ;end of stack, no lisp subjobs, return zero
POPJ P,
GSLIS3: MOVN E,E ;indicate this job is not currently selected
POPJ P,
;Get number of first PTY subjob in the stack.
;Return "simulated decimal" PTY number, because the SUBJOB command takes
;this number as an argument, but such arguments are read in decimal.
GSUBJB: SKIPGE E,LISPJB ;skip if no connected PTY subjob
JRST GSUBJ4 ;return "decimal" PTY number
MOVN E,JOBMAX ;get count of disconnected jobs in subjob stack
JUMPE E,CPOPJ ;return zero if none
MOVSI T,(E) ;make aobjn ptr
GSUBJ2: SKIPGE E,OLDJOB(T) ;PTY subjob here?
JRST GSUBJ3 ;yes, return its number, negated, in E
AOBJN T,GSUBJ2 ;no, look down the subjob stack
MOVEI E,0 ;end of stack, no PTY subjobs, return zero
POPJ P,
GSUBJ4: MOVN E,E ;indicate this job is currently selected (positive)
;convert "octal" PTY number to "decimal" equivalent (e.g., for decimal typeout)
GSUBJ3: PUSH P,E+1 ;save an AC
PUSHJ P,GSUBJR ;convert to "decimal"
POP P,E+1
POPJ P,
GSUBJR: IDIVI E,=8 ;take PTY nbr apart into octal digits
HRLM E+1,(P)
JUMPE E,.+2
PUSHJ P,GSUBJR ;usual recursive digitizer
HLRE T,(P) ;make it work for negative numbers
IMULI E,=10 ;adjust previous "decimal" digits
ADD E,T ;put back together from decimal digits
POPJ P,
;Get number of jobs in subjob stack (not including any empty slot at top).
GSUBSK: MOVE E,JOBMAX ;get number of jobs in stack, less current job
SKIPE LISPJB ;skip if no current job
ADDI E,1 ;count the current subjob
POPJ P,
;Get number of current subjob (decimalized if PTY).
GSUBTP: SKIPL E,LISPJB ;skip if PTY connected
POPJ P, ;return 0 or positive Lisp job number
JRST GSUBJ3 ;convert PTY number to "decimal"
;Find current line number
RDVLIN: PUSH P,TT
PUSHJ P,GPAGL
POP P,TT
HLRZ E,T
POPJ P,
;Find number of lines on current page
RDVLNS: PUSH P,TT ;RDV routines must preserve TT (readonly var name)
PUSHJ P,GPGLS ;TT ← <line>,,<page>; T ← <lines>
JRST RDVPA2 ;Return value from RH(T)
;Find current page number
RDVPAG: PUSH P,TT
PUSHJ P,GPAGL
RDVPA2: POP P,TT
HRRZ E,T
POPJ P,
;Find current column number
RDVCOL: XCT LENSKP(J) ;Don't skip if in line editor
SKIPA E,EDPOS ;Column of line editor activator, might be zero
MOVEI E,0 ;Zero for not in line editor
POPJ P,
;Find number of columns on current line
RDVCLS: MOVE T,ARRLIN ;Current line
XCT LENSKP(J) ;Don't skip if in line editor
SKIPA E,EDCOLS ;Number of cols in line editor
HRRZ E,TXTCNT(T) ;Number of cols in line
POPJ P,
;Find number of current character within current line
CHRNUM: XCT LENSKP(J) ;Don't skip if in line editor
SKIPA E,EDCNM ;Character number in line
MOVEI E,0 ;Zero for not in line editor
POPJ P,
;Find number of characters on current line, not counting CRLF
CHRCNT: MOVE E,EDSIZ ;Number of chars in line editor
XCT LENSKP(J) ;Don't skip if in line editor
SOJA E,CPOPJ ;Coming from line editor, uncount the CR
MOVE T,ARRLIN ;Current line
HLRZ E,TXTCNT(T) ;Number of chars in line
SUBI E,2 ;Uncount the CRLF
POPJ P,
;Find ascii value of current character
RDVCHR: MOVE E,EDNEXT
CAIN E,400
MOVEI E,15 ;400 represents end of line, so report as a CR
XCT LENSKP(J) ;Don't skip if in line editor
POPJ P, ;In line editor
MOVE T,ARRLIN
ADD T,[350700,,LLDESC] ;Make byte pointer to text of line
LDB E,T ;Get first char of line
TLNE F,NULLIN ;Null line?
MOVEI E,15 ;Yes, report char as CR
TLNE F,PMLIN!OFFEND ;End of page?
MOVEI E,14 ;Yes, report char as FF
POPJ P,
;Find sixbit value of current character
RDVSIX: PUSHJ P,RDVCHR ;Get ascii value
CAIL E,140
SUBI E,40 ;Convert lowercase to upper
SUBI E,40 ;Convert ascii to sixbit, ctrl chars become negative
POPJ P,
RDVEFL: MOVEI E,0 ;Assume not in line editor
XCT LENSKP(J) ;Don't skip if in line editor
MOVEI E,1 ;Line editor
POPJ P,
RDVWFL: MOVEI E,0 ;Assume flag off
TRNE F,WRITE ;Test flag
MOVEI E,1 ;Flag on, return value
POPJ P,
RDVRFL: MOVEI E,0 ;Assume flag off
TRNE F,REDNLY ;Test flag
MOVEI E,1 ;Flag on, return value
POPJ P,
RDVIFL: MOVEI E,0 ;Assume flag off
TLNE F,LINSM ;Test flag
MOVEI E,1 ;Flag on, return value
POPJ P,
RDVNOD: MOVEI E,0 ;Assume not /N mode
HRRZ T,EDFIL+4 ;Get flag for current file
CAIN T,-1
MOVEI E,1 ;/N mode, return value
POPJ P,
RDVSTP: MOVE T,STPADR ;Get address of macro stopping error routine
MOVEI E,0 ;Assume no stopping
TLNE T,-1 ;Is there a low priority error routine?
MOVEI E,1 ;Yes, will stop at least one macro
TRNE T,-1 ;Is there a high priority error routine?
SETO E, ;Yes, will stop all macros
POPJ P,
;Find amount of room left for more incore characters before rippling (X) is needed
RDVROM: MOVE E,ROOM ;Amount of character space on disk for this page
SUB E,CHARS ;Minus amount taken up by chars in core
POPJ P,
;Find out how many instances of search string were found by last search.
NFOUND: SKIPE NSUBST ;Was last search really a substitution?
SKIPA E,SRCN1 ;Yes, return zero for number found
MOVE E,SRCN2 ;Number of instances user ask for in search
SUB E,SRCN1 ;Minus the number we failed to find
POPJ P, ; gives the number actually found.
;Find the index of the current file in the file list.
FINDEX: MOVE T,ZINDEX ;record pointer for current file
MOVEI E,ZENT ;size of each record
IDIVM T,E ;answer in E is index (0 to 7) of this file
AOJA E,CPOPJ ;make answer run from 1 to 8
;Here to generate string readonly variable with filename and switches in it.
;Always skips, to indicate string value returned.
RDVFNM: TDZA T,T ;flag no switches
RDVFPL: MOVEI T,-1 ;want /P and /L switches
SKIPN D,OKSTRG ;get byte ptr
JRST POPJ1 ;skip return quickly if no byte ptr available
MOVEM D,TYOPNT ;set up byte pointer for output
PUSH P,A ;must preserve A and C (and TT,J,I)
PUSH P,C
PUSH P,T ;remember which switches we want
MOVE D,ZINDEX ;get ptr to data block for current file
HRLI D,400000 ;sign bit on suppresses switches /N & /F
ADDI D,ZDATA ;make pointer to filename block for current file
PUSH P,PPN ;save current PPN
SETZM PPN ;force typeout of PPN
PUSHJ P,FILSTR ;convert filename to text string
POP P,PPN ;restore current PPN
POP P,T ;get back switch flag
JUMPE T,RDVSTX ;jump if no switches wanted
TYPCHR "/" ;insert slash in string
PUSHJ P,RDVPAG ;get current page in E
TYPDEC E ;type it into string
TYPCHR "P/" ;put P switch in string, start L
PUSHJ P,RDVLIN ;get current line in E
TYPDEC E ;type it into string
TYPCHR "L" ;put L switch in
RDVSTX: MOVEI T,0
IDPB T,TYOPNT ;end string with null
POP P,C
POP P,A
JRST POPJ1 ;always skip return to indicate STRING value
;Here to generate string readonly variable with current date and/or time.
;We print a space after each field.
;Always skips, to indicate string value returned.
;Flags in T:
;400000,,0 ;print day of week
;1,,0 ;print date
;0,,400000 ;print time in seconds
;0,,1 ;print time in minutes
;0,,2 ;have printed something already
RDVDAT: MOVSI T,1 ;want date only
JRST RDVDA2
RDVTIS: MOVEI T,-1 ;want time in seconds
JRST RDVDA2
RDVDTS: MOVE T,[1,,-1] ;want date and time in seconds
JRST RDVDA2
RDVDYT: HRROI T,1 ;want day, date and time
JRST RDVDA2
RDVDYS: SETO T, ;want day, date and time in seconds
JRST RDVDA2
RDVDAY: MOVSI T,400000 ;sign bit means day of week
JRST RDVDA2
RDVDTM: SKIPA T,[1,,1] ;want date, and time in mins
RDVTIM: MOVEI T,1 ;want time only
RDVDA2: SKIPN D,OKSTRG ;get byte ptr
JRST POPJ1 ;skip return quickly if no byte ptr available
MOVEM D,TYOPNT ;set up byte pointer for output
PUSH P,A ;must preserve A and C (and TT,J,I at least)
PUSH P,C
ACCTIM A, ;get date,,time in secs
TRZ T,2 ;haven't printed anything yet
TLNN T,400000 ;want day of week?
JRST RDVNDA ;no
TRO T,2 ;we've printed something now
HLRZ B,A ;date
DAYCNT B, ;get number of days since day 0
IDIVI B,7 ;day of week to C
MOVE B,WKDAY(C) ;get ptr to ASCII for text of weekday
HRLI B,440700 ;make byte ptr
CAIA
RDVWDL: IDPB C,TYOPNT ;print char of weekday
ILDB C,B ;get char
JUMPN C,RDVWDL ;skip if more
RDVNDA: TLNN T,1 ;skip if want date
JRST RDVTI2 ;just the time please
TROE T,2 ;skip if hadn't printed anything yet
TYPCHR " " ;print space before date
HLRZ B,A ;date
IDIVI B,=31 ;day of month - 1 in C
ADDI C,1
CAIGE C,=10 ;two digits?
TYPCHR "0" ;no, pad with zero
TYPDEC C ;print day of month
IDIVI B,=12 ;month - 1 in C
SKIPA C,MONTH(C) ;5 ascii chars
RDVMOL: IDPB D,TYOPNT ;insert in string
MOVEI D,0 ;place to rotate char into
ROTC C,7 ;next char to D
JUMPN D,RDVMOL ;loop if more chars
ADDI B,=64 ;1964 is year 0
IDIVI B,=100 ;ha! we're ready for the year 2000.
CAIGE C,=10 ;two digits?
TYPCHR "0" ;no, pad with zero
TYPDEC C ;print last two digits of year
RDVTI2: TRNN T,400001 ;want time?
JRST RDVSTX ;no, done
TROE T,2 ;skip if hadn't printed anything yet
TYPCHR " " ;print space before time
MOVEI A,(A) ;just the time
IDIVI A,=60 ;seconds in B, mins in A
MOVE C,B ;save seconds
IDIVI A,=60 ;minutes in B, hrs in A
CAIGE A,=10 ;two digits?
TYPCHR "0" ;no, pad with zero
TYPDEC A ;print two digit hour
TYPCHR ":"
CAIGE B,=10 ;two digits?
TYPCHR "0" ;no, pad with zero
TYPDEC B ;print two digit minute
TRNN T,400000 ;high bit means want time in seconds too
JRST RDVSTX ;no seconds
TYPCHR ":"
CAIGE C,=10 ;two digits?
TYPCHR "0" ;no, pad with zero
TYPDEC C ;print two digit seconds
JRST RDVSTX ;finish up string with null, restore and return
;Here from ZMAC2 when macro name is followed by dot, indicating readonly variable
RDVTYP: JUMPL A,MACABT ;Negative arg to macro call is undefined
JUMPE A,RDVTY2 ;Zero arg types value
SORRF Cannot execute a readonly variable. Use αXARGUMENT or αXSET.
JRST POPJ1
RDVTY2: MOVEI J,0 ;Normal command, in case of error
MOVE I,[JRST RDVTY3] ;XCTed after value gotten into E
JRST SETX2S ;Permit string readonly variable, go read it
RDVTY3: OUTCHR [" "]
SETZM TYOPNT
TYPMAC TT ;Type variable's name
OUTSTR [ASCIZ/. = /]
SKIPN OKSTRG ;Skip if variable has string value
TYPDEC E ;Type numeric value
SKIPE OKSTRG ;Skip unless variable has string value
OUTSTR @OKSTRG ;Type string value
JRST OUTSPC ;Type out space and skip return
;Here when operating on readonly variable. Type out result of operation.
VALTYP: OUTSTR [ASCIZ/ Result = /]
SETZM TYOPNT
TYPDEC A ;Type result of operation
JRST OUTSPC ;Type out space and skip return
;Next three instructions are executed (J) by routine getting readonly variable value.
CAIA ;from Lisp readonly variable evaluator, never LE
SKIPGE DSP ;LE test instruction for cmds like ARGUMENT
LENSKP: TRNE F,EDITM ;Normal instruction to test for line editor
BEGIN RDV ;Readonly variables
GLOBAL E,P ;GRRRRR
;To define a readonly variable, make an entry in RVARS.
;Entry X means X is the name of both the variable and the variable's cell.
;Entry <X,Y> means X is name of variable, Y is name of cell.
;Entry <X,,Z> means X is name of variable, Z is routine to call to get value into E.
; If routine Z skips, then the value returned is a string (byte ptr in OKSTRG).
;Entry <X,,,W> means MOVN E,W will get right value into E.
;Routines must preserve at least TT,J,C,A,I.
DEFINE RVARS <FOR X IN (<LINES,,RDVLNS>,<LINE,,RDVLIN>,PAGES,<PAGE,,RDVPAG>
,<COLS,,RDVCLS>,<COL,,RDVCOL>,<CHARS,,CHRCNT>,<CHAR,,CHRNUM>,<COLINT,COLPOS>
,<CORCHS,CHARS>,<ROOM,,RDVROM>
,<CORBEG,FIRPAG>,<COREND,CURPAG>,<CORLIN,ARRL>,<CORLNS,LINES>
,<WINTOP,TOPWIN>,<SRCHAR,SRCOFF>
,<ASCII,,RDVCHR>,<SIXBIT,,RDVSIX>
,<STEP,STEPIT>
,<SLISP,,GSLISP>,<SUBJOB,,GSUBJB>
,<SUBOUT,PLMODE>,<SUBSTK,,GSUBSK>,<SUBTOP,,GSUBTP>
,<EDLINE,,RDVEFL>,<WFLAG,,RDVWFL>,<RMODE,,RDVRFL>,<IMODE,,RDVIFL>
,<NMODE,,RDVNOD>,<RAPID,SPEEDF>,<TERSE,BLAB>,<SILENT,SILENC>
,<STOPHO,,RDVSTP>,<CHECK,CHKFLG>
,<UNDMAX,DELSMX>,<UNDCHS,DELSIZ>,<UNDLNS,DELNUM>
,<AUTOBU,,,BURPEX>,<BRKCOL,BREAKV>,<ECHO,NOECHO>,<IECHO,NOIECH>
,<MDEPTH,CURMAC>,<EXACT,EXACTS>
,NSUBST,<NFIND,SRCN2>,<NFOUND,,NFOUND>
,<SSLINE,SLNSTP>,<SSPAGE,SPGSTP>
,LMAR,RMAR,BNUM,<CMAR,PMAR>,LMARO,<CMARO,PMARO>
,TLMAR,TRMAR,TBNUM,<TCMAR,TPMAR>,TLMARO,<TCMARO,TPMARO>
,<INDENT,INMAR>,<ALIGN,AMAR>
,<FINDEX,,FINDEX>
,<FILE,,RDVFNM>,<FILEPL,,RDVFPL>
,<DAY,,RDVDAY>,<DAYTIM,,RDVDYT>,<DAYSEC,,RDVDYS>
,<DATE,,RDVDAT>,<DATTIM,,RDVDTM>,<DATSEC,,RDVDTS>
,<TIME,,RDVTIM>,<TIMSEC,,RDVTIS>
,<ATTSIZ,ATTNUM>,ATTMAX,<TOPSIZ,SCRTOP>,<BOTSIZ,PPSIZ>,<WINSIZ,NLINER>)>
DEFINE VARNAM(A,B,C,D)<<SIXBIT /A/>
>
repeat 0,< ;old form
DEFINE VARXCT(A,B,C,D)<
IFDIF <D><><MOVN E,D;>IFIDN <C><><IFIDN <B><><MOVE E,A;>MOVE E,B;>PUSHJ P,C>
>;repeat 0
DEFINE VARXCT(AA,BB,CC,DD)<
IFDIF <DD><><MOVN E,DD
;>IFDIF <CC><><PUSHJ P,CC
;>IFDIF <BB><><MOVE E,BB
;>MOVE E,AA
>
;Sixbit names of readonly variables
↑RDVAR: RVARS
< VARNAM X
>
↑NRDVAR←←.-RDVAR
;Instructions to execute to get values of readonly variables into E
↑RDVARP:RVARS
< VARXCT X
>
BEND RDV
;RAPID RAPID0 MACLED MACLE7 MACLE5 MACLE2 MACLE4 MACLE8 MACLE6 MACLE3 BTAB4 MACLOK MACL2 MACL2A MACL2B MACLTB MACLAC
RAPID: JUMPE A,RAPID0 ;Zero arg reports state of RAPID flag
MOVEM A,SPEEDF# ;Set or clear macro line editor simulation flag
POPJ P,
RAPID0: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Line editor simulator is /]
SKIPGE SPEEDF
OUTSTR [ASCIZ/Disabled. /]
SKIPL SPEEDF ;Default value (0) now means enabled
OUTSTR [ASCIZ/Enabled. /]
JRST CPOPJ1
;Here to try to avoid using actual line editor when just moving around in
;line editor with macros.
;AC usage: A/accumulated LE arg B/byte pointer C/char D/accumulated position
MACLED: SKIPGE SPEEDF# ;Is speeded up macro line editing enabled?
JRST MACLEX ;No, use normal line editor
MOVE B,PTPNT ;Address where 9-bit LE string starts
HRLI B,441100 ;Make byte pointer
MACLE7: MOVEI D,0 ;Starting at left margin
MACLE5: MOVEI A,0 ;No LE arg seen yet
MACLE2: ILDB C,B ;Get char we would send to LE
CAIL C,200+"0" ;Is it a LE repeat arg?
CAILE C,200+"9"
JRST MACLE3 ;No
IMULI A,=10 ;Shift previous number over one digit
ADDI A,-200-"0"(C) ;Add new digit
JRST MACLE2
MACLE4: ADDI D,(A) ;Yes, adjust desired column position
CAMLE D,EDSIZ
MACLE8: MOVE D,EDSIZ ;At end of line
JRST MACLE5
MACLE6: SUBI D,(A) ;Yes, adjust desired column position
JUMPGE D,MACLE5
JRST MACLE7 ;Oops, back to left margin
MACLE3: SKIPN A
MOVEI A,1 ;Repeat arg of zero means really do it once!
CAIE C,200+40 ;α<space>?
CAIN C,600+40 ;or αβ<space>?
JRST MACLE4 ;Yes, move right some
CAMGE D,EDSIZ ;At end of line?
CAIE C,177 ;No, <bs> is like α<bs>
CAIN C,200+177 ;α<bs>?
JRST MACLE6 ;Yes, back up some
CAIN C,600+177 ;αβ<bs>?
JRST MACLE6 ;Yes, back up
CAIN C,200+14 ;α<FF>?
JRST MACLE7 ;Yes, now at left margin
CAIN C,200+11 ;α<tab>?
JRST MACLE8 ;Yes, now at end of line
MOVE T,B
ILDB TT,T ;See if any more typeahead
JUMPE TT,MACLOK ;Jump if we have reached end of simulated typeahead
CAMGE D,EDSIZ ;Can't overtype at end of line editor
TRNE C,600 ;Skip if no bucky bits on this char
JRST MACLEX ;Not overtyping. Must use real line editor.
MOVE TT,CTAB(C) ;Get bits for this char
TLNE TT,NSPEC!LSPC ;Skip unless this char is messy to overtype with
JRST MACLEX ;Use real line editor
;Here we have a simple char overtyping something in line editor
MOVEI T,(D) ;Copy character number
IDIVI T,5 ;Figure out word and byte displacement in BUF
ADD T,BTAB4(TT) ;Make byte pointer to right word in BUF
LDB TT,T ;Get char we would overtype
CAIN TT,11 ;Can't overtype tab 'cause tab might stay around
JRST MACLEX ;Gotta use real line editor
DPB C,T ;Overtype with the new char in simulation
AOJA D,MACLE5 ;Move right one char, get next char from typeahead
BTAB4: 350700,,BUF
260700,,BUF
170700,,BUF
100700,,BUF
10700,,BUF
;Success!! Line editor cmds can be simulated. Now set up everything for EDGL3A.
;Here we are with activation character in C, char position it comes at in D.
MACLOK: CAMLE D,EDSIZ
PUSHJ P,TELLZ ;Simulation screwed up, went past end of line!!
CAIE C,15 ;Plain <cr> and
CAIN C,200+15 ; α<cr> get inserted at the end of the line
MOVE D,EDSIZ ; instead of where cursor is, so move to end first
MOVEM D,EDCNM ;Store number of chars before activator
MOVEM D,EDCNMR
PUSHJ P,EDGSET ;Prepare to count various things
MOVEM C,EDCHR ;Store activation char
MACL2: ILDB C,D ;Get next char
CAMN T,EDCNM ;Does activator come before this char?
JRST MACLAC ;Yes, store various things
MACL2A: CAIN C,11
JRST MACLTB ;Adjust column for tab
CAMN T,EDSIZ ;Are we out of chars in line?
AOJA T,EDGL3A ;Yes, count activator and join normal LE code
MACL2B: AOJ B, ;Count columns
AOJA T,MACL2 ;COUNT CHARACTER
MACLTB: SKIPGE EDTABP
MOVEM B,EDTABP# ;REMEMBER POS OF FIRST TAB FOR REPRST
TRO B,7 ;DIDDLE COL POS
AOJA TT,MACL2B ;& COUNT TABS
MACLAC: MOVEM B,EDPOS ;Remember column position of activator
MOVEM TT,EDTBS ;Remember number of tabs before activator
MOVEM C,EDNEXT ;Remember char after activator
SETOM EDTABP ;Set flag to catch first tab after activator
CAME T,EDSIZ ;Are we done with line?
TRO F,EDBRK ;No, flag that activator came in middle of line
JRST MACL2A
;⊗ SKPSP5 SKPSP3 SKPSP4 GETNUM GETNUI GETNUL GETNU0 GETNUB GETNER GETNU2 GETNUX GETNUR
SKPSP5: CAIE C,"." ;If this is end of RDV name, get next char
JRST SKPSP4 ;Just check for, and skip, spaces
SKPSP3: PUSHJ P,TYI ;Get next char
POPJ P, ;Activator
SKPSP4: CAIE C,40 ;Skip over spaces and tabs
CAIN C,11
JRST SKPSP3
JRST POPJ1 ;Non-activator, non-space
;Routine to continue scanning extended command line for a number.
;First char of possible number should already be in C.
;Leading and trailing blanks are skipped.
;Number can be in the form of a numeric macro or RDV name.
;Takes skip return if number found, with value returned in TT.
;NOTE: This routine will not return if an error is detected (pops up a
; level and skips). So can be called from cmd level and will detect errors.
;Clobbers Q,B,D,E,G,I,J,K,T,TT. Returns char beyond number in C.
GETNUM: TDZA J,J ;Enter here from normal command
GETNUI: MOVEI J,-1 ;Enter here from immediate cmd, like ⊗XCHARACTER
TLZ F,TF1 ;Not negative number yet
POP P,K ;Get return address off stack in case we hit error
MOVEI TT,0 ;Collect number here
PUSHJ P,SKPSP4 ;Skip leading spaces and tabs
JRST (K) ;Saw an activator, return without a number
MOVEI I,=10 ;Assume decimal radix, LH flags no digit seen yet
CAIN C,"-" ;Minus sign?
JRST [ TLO F,TF1 ;Yes, flag it
JRST GETNUB ] ;Flag a number seen
CAIE C,47 ;Single quote means number is octal
JRST GETNU0
HRROI I,10 ;Now in middle of collecting octal number
GETNUL: PUSHJ P,TYI ;Get next char
JRST GETNUX ;Activator
GETNU0: TLNN T,NUMF ;Is this a digit?
JRST GETNU2 ;No
CAIL C,"0"(I) ;Yes, but is it less than radix?
JRST GETNER(J) ;No, illegal number
IMULI TT,(I) ;Yes, multiply be radix
ADDI TT,-"0"(C) ;Add in new digit
GETNUB: HRRO I,I ;Flag a digit seen
JRST GETNUL
JSP D,CLRTYI ;Set up error dispatch to here
GETNER: SETZM TYIPNT
SORRY Illegal digit in octal number.
JRST POPJ1
GETNU2: PUSHJ P,SKPSP4 ;Ignore trailing spaces, skip unless see activator
GETNUX: JUMPGE I,(K) ;Take direct return if no number seen
TLZE F,TF1 ;Did we see a minus sign?
MOVN TT,TT ;Yes, negate the result
JUMPL I,1(K) ;Take skip return now if have already seen a number
TESTBP TYIPNT ;make sure byte ptr hasn't already been backed up
MOVSI TT,70000 ;No, back up input pointer to re-read last char
ADDM TT,TYIPNT ;We haven't used up the input, so this should work
SETZ Q, ;Don't save actual input
PUSHJ P,GETWRD ;Collect sixbit word in TT, mask in XMSK
JRST (K) ;No word found, no number seen, direct return
JFCL ;Terminating char of word was activator
MOVE I,[JRST GETNUR] ;What to do after finding value
JRST MACHA6 ;Go evaluate the macro or RDV -- POPJs on error
GETNUR: PUSHJ P,SKPSP5 ;Skip spaces after macro or RDV name
JFCL ;Activator
MOVE TT,E
JRST 1(K) ;Take skip return with value in TT
;MACDSL MACDS7 MACDS6 MACDS2 MACDS3 MACD3B MACDST MACDS8 MACDS9 MACD5A MACDS5 MACD5B MACDS4 MCURS MCURS2 DCURS DCURS5 DCURS2 DCURS1 DCURS0 ICURS ICURS2 REMCUR
;Here when in DISP from line editor while in middle of expanding macro.
;Output text from our LE buffer (BUF). CRLF supplied by routine that called us.
;This routine also draws LE line when DISP called via CMDEX from EDGL3.
MACDSL: SKIPG CURMAC ;Skip if in macro
SKIPN NOLEDS# ;Suppress LE display if coming from MACLEX
SKIPA T,EXTRA ;See if we have more than one line to draw text
POPJ P,
HLLZS DPYTAB(G) ;Force sim'ed line editor line to be redrawn later
;; SETOM DPYNEW(G) ;note that this line is being output
MOVEM T,EXTRA2#
SETOM LESIM# ;Flag that LE display is being simulated by us
PUSH P,A
PUSH P,B
MOVEI A,1
MOVEM A,MACBUF ;Make buffer into all text display words
MOVE B,[MACBUF,,MACBUF+1]
BLT B,MACBUF+LMACBF-1
HRRZ A,EDPOS ;Get column where cursor should be
MOVEI B,(G) ;Line where simulated LE starts is cursor default
MACDS7: CAMGE A,DPYWID ;Is cursor on this line?
JRST MACDS6 ;Yes
ADDI B,1 ;Put cursor on next line
SUB A,DPYWID ;Wrap around to next line
SOJGE T,MACDS7 ; if there is another line
TDZA A,A ;Don't display cursor
MACDS6: HRLI A,(B) ;Get line number (never zero, because of hdr line)
MOVSM A,CURPOS# ;Remember position so cursor can be drawn later
MOVN TT,DPYWID ;Get terminal's line width
MOVSI TT,(TT) ;Make aobjn counter for counting columns
MOVE A,[POINT 7,MACBUF] ;Place where we will collect text to output
MOVE B,[POINT 7,BUF] ;Place where we find text ready for line editor
MACDS2: ILDB T,B ;Get next char from line
CAIN T,11
JRST MACDST ;Convert tab to right number of spaces
CAIN T,15
JRST MACDS5 ;CR is end of text
IDPB T,A ;Place char for output
MACDS3: AOBJN TT,MACDS2 ;Go back for more text unless done enough columns
;Here the line is long enough to wrap around. See if someone left us some room
;for wrapping around. This code doesn't work for IIIs since it doesn't keep
;track of the dpybuf address of the wrapped around line, but fortunately E
;doesn't make EXTRA room for long LEs on IIIs anyway, so everything is okay.
SOSGE EXTRA2 ;Is there another line for wrapping around?
JRST MACD5B ;Nope, all done
PUSH P,T ;Save char
HLRZ T,TT ;Get overflow count
EXCH T,(P) ;Put count on stack under saved char
PUSH P,T ;Re-stack char
PUSHJ P,MACD3B ;Put out a CRLF and erasing leading col of next line
HRLZ T,DPYWID ;Get width of next line
SUB TT,T ;Reset aobjn counter for new line
SUB TT,[1,,1] ;Undo aobjn already done -- will hit it again
POP P,T ;Get back char
JRST MACDS8 ;Put out char that overflowed
MACD3B: MOVEI T,15
IDPB T,A ;Advance display to next line with CRLF
MOVEI T,12
IDPB T,A
ADDI G,1 ;On next screen line now
HLLZS DPYTAB(G) ;Force redrawing this extra sim'ed line ed line
PUSHJ P,MACDS9 ;Fill out word with nulls
MOVE T,ARRPOS
CAMN T,AR2POS
POPJ P, ;Not DD
MOVEM T,1(A) ;Put in cmd to position us to leading column
ADDI A,1 ;Skip over that word in buffer
MOVEI T,40
IDPB T,A ;Erase leading column of extra line, just in case
POPJ P,
MACDST: MOVEI T,(TT) ;Current column
IORI T,7 ;Adjust to next tab position, minus 1
SUBI T,(TT) ;Number of extra spaces to output
PUSH P,T
HRL T,T
ADD TT,T ;Adjust aobjn ptr forward
MOVEI T,40 ;Get a space -- there is definitely room for one
IDPB T,A ;Put in a space
MACDS8: SOSL (P) ;Need another extra space?
JRST .-2 ;Yes
SUB P,[1,,1] ;Adjust stack
JRST MACDS3 ;No, now go put in final space
MACDS9: TDZA T,T
IDPB T,A ;Fill out last word with nulls
TLNE A,760000 ;Skip if reached end of word
JRST .-2
POPJ P,
MACD5A: PUSHJ P,MACD3B ;Put out a CRLF and erase leading col of next line
MACDS5: SOSL EXTRA2 ;Did we use up all the extra lines?
JRST MACD5A ;No, move down to next line
MACD5B: PUSHJ P,MACDS9 ;Fill out last word with nulls
MOVNI A,-MACBUF+1(A) ;Number of words of text
MOVSI A,(A) ;Make aobjn ptr
MACDS4: PUSH H,MACBUF(A) ;Put word into display buffer
AOBJN A,MACDS4
JRST POPBAJ ;All done
;Here are device-dependent routines to put out the special cursor, to go
;under the current character in the text displayed by MACDSL above.
MCURS: SKIPN CURPOS ;Skip if special cursor position requested
JRST MCURS2
CURSOR CURPOS ;Tell system where to put the cursor on DM
JRST REMCUR ;Remember whether we set up special cursor position
;Routine to restore normal cursor.
MCURS2: SKIPN CUROLD
POPJ P, ;No change needed in cursor position
TRNN F,ATTMOD
CURSOR OLDARR ;Position DM cursor
TRNE F,ATTMOD
CURSOR [-1] ;No special cursor loc in att mode
JRST REMCUR ;Remember whether we set up special cursor position
;The special cursor on the DD has some messiness to usually avoid getting
;erased when the real LE's cursors are erased. The cursor is displayed up
;one scanline from the LE cursors when the LE has definitely been around
;lately (e.g., after ⊗X). Also, when erasing the old special cursor, care
;is taken not to erase it when that might erase the real LE's cursor (which
;itself will erase the special cursor anyway).
DCURS:
IFE DECSW,< ;DEC has no DDs
SKIPN T,CUROLD
JRST DCURS2
SKIPE TT,LEPOS2# ;Get line number where LE is, if any
SKIPE G,CUROL2# ;Get flag indicating which scanline old cursor on
JRST DCURS5 ;Can't be conflict with LE scanline
MOVE A,TT
ADD A,EXTRA ;Line number where LE ends
CAIG TT,(T) ;Don't erase old cursor if on LE's cursor line
CAIGE A,(T) ;(either one of LE's multiple lines)
DCURS5: PUSHJ P,DCURS1 ;Erase old cursor
DCURS2: SETZB G,CUROL2 ;Assume in macro, use LE cursor's scanline
AOSE ODDSCN ;Skip if want to, and can, use odd scanline
SKIPG CURMAC ;Skip if in macro
SOS G,CUROL2 ;Avoid LE cursor's scanline -- move up one
MOVSI B,774000 ;Bits for our cursor -- longer than normal
SKIPE T,CURPOS
PUSHJ P,DCURS0 ;Put out cursor
JRST REMCUR ;Remember where we drew the special cursor
DCURS1: SETZB B,ODDSCN# ;Use blank graphics vector, can't use odd scanline
DCURS0: MOVE A,[CW 3,0,4,0,5,0] ;Column number and line address (high & low parts)
MOVEI TT,(T) ;Line number
IMULI TT,=12 ;Convert to scan line number
ADDI TT,=10(G) ;Put our cursor near bottom of text line
DPB TT,[POINT 4,A,23] ;Put in low order line address
LSH TT,-4
DPB TT,[POINT 5,A,15] ;And high order line address
HLRZ TT,T ;Character column number
IMULI TT,6 ;Times char width in bits gives bit position
LDB T,[POINT 3,TT,35] ;Get bit offset within graphic column
LSH TT,-3 ;Get graphic column number in low-order bits
ADDI TT,1 ;First graphics column under normal text is 1
DPB TT,[POINT 6,A,7] ;Insert column in cmd word
MOVN T,T
LSH B,-1(T) ;Adjust bits into right position within column
TRZ B,17 ;Make sure no stray bits on
IORI B,2 ;Make this a graphics word
SKIPE DDACT
DPYOUT [0↔0] ;Wait for any previous DD program
PUSH H,[CW 1,7,1,7,1,7] ;Graphics mode to diddle cursors
PUSH H,A ;Put position cmd into program
SKIPN DDCOLR ;skip unless DD is black on green
XOR B,[BYTE (32)<-1>(4)0] ;reverse the bits for BOG
PUSH H,B ;Put graphic bits into dpy program
PUSH H,[CW 0,0,3,1,3,1] ;Now an execute to write the bits
POPJ P,
>;IFE DECSW
ICURS:
IFE DECSW,< ;DEC has no IIIs
SKIPN TT,CURPOS
JRST ICURS2 ;No cursor, maybe flush old one
HRRZ G,TT ;Get line number
PUSHJ P,PCOMPI ;Calculate III position cmd to get to line
HLRZ TT,TT ;Get column
IMUL TT,[14⊗=25] ;Calculate distance from left margin
ADD T,TT ;Adjust vector by X position
MOVEM T,IIICU2 ;Put position word into cursor's display program
DPYOUT CRSPOG,[IIICUR ↔ LIIICU] ;Display special cursor
JRST REMCUR ;Remember that we have a special cursor
ICURS2: SKIPE CUROLD
DPYOUT CRSPOG,[0↔0] ;Flush old special cursor
>;IFE DECSW
REMCUR: MOVEI T,0
EXCH T,CURPOS# ;Assume no special cursor next time
MOVEM T,CUROLD# ;Remember where we put cursor this time
POPJ P,
;STEPCK STEPC2 DISP6 DISP6A DISP7 AUTOST AUTOS0 AUTOS2 STEPQ STEP STEPQ2
;Routine to see if we should pause/stop for macro step now; from DISP6 & MACLIN.
;Direct return if not time to step macro (i.e., time to stop or else not stepping).
;Skip return if want to step the macro and pause here.
STEPCK: AOSN NOSTEP# ;Skip unless suppressing display at this step
POPJ P, ;This isn't really a "step"
SOSN NSTEP# ;Is this the step where we're supposed to stop?
JRST STEPC2 ;Yes
SKIPLE STEPIT ;Skip unless we are in macro stepping mode
AOS (P) ;Skip return to indicate time to step macro
POPJ P,
STEPC2: MOVEI T,MACSTS ;Routine to call to stop macro stepping
EXCH T,MACINS
MOVEM T,MACIN2# ;Remember any routine already to be called
POPJ P,
;Here when checking to update display while macro in progress
DISP6: PUSHJ P,STEPCK ;See if it is time to step macro
JRST DISP7 ;Not a "step", not stepping, or not time to step yet
DISP6A: PUSHJ P,DISP0 ;Step macro now -- force display update
JFCL ;Always do display
SKIPLE T,STEPIT ;Make sure still in stepping mode
SLEEP T, ;Sleep given number of seconds
JRST POPJ1
;Here in macro when not stepping.
DISP7: PUSH P,A
PUSH P,B
PUSHJ P,WINCHK ;Make sure window limits are set up correctly
JRST PPBAJ1
;Command routine to enable/disable stepping of macros.
AUTOST: JUMPE A,AUTOS0 ;Just tell what mode we're in
CAILE A,=68
MOVEI A,=68 ;This is max time that you can sleep
MOVEM A,STEPIT# ;Set flag/delay count
POPJ P,
AUTOS0: SKIPG STEPIT
JRST AUTOS2 ;Disabled
SETZM TYOPNT ;Type output
OUTCHR [" "]
TYPDEC STEPIT
OUTSTR [ASCIZ/ seconds per Macro step. /]
JRST POPJ1
AUTOS2: OUTSTR [ASCIZ/ Automatic Macro stepping is disabled. /]
JRST POPJ1
;Ampersand command enters at STEPQ, ⊗XSTEP enters at STEP, both to step a macro.
STEPQ: TDZA DSP,DSP ;Flag single char cmd
STEP: MOVEI DSP,1 ;Flag extended cmd -- takes optional macro name
MOVEM DSP,NSTEP2# ;Remember which kind of stepping requested
JUMPE A,CPOPJ ;Zero steps is a no-op
MOVMM A,NSTEP# ;Number of steps to do before stopping
JUMPE DSP,STEPQ2 ;Don't look for macro name if single-char cmd
PUSHJ P,XTDLIN ;Prepare to rescan extended command line
PUSHJ P,GETMAC ;Get any macro name in the command
MOVEI A,1 ;Repeat arg for ZMAC3
JUMPN TT,ZMAC3A ;Jump if name found, call named macro
STEPQ2: SKIPLE CURMAC
POPJ P, ;We're already inside a macro, just continue
SKIPG C,SAVMAC ;Any macro expansion to continue?
JRST CONTNO ;Nope
JRST RESUM2 ;Yes, go to it
;NDBBOA NDBB0 NDBB2 NDBB22 NDBB3 NDBB33 NDBB4 NDBB66 NDBB6 NDBB5 NDBB44 NDBB55 NDBGET DATPRG DATPR0 DATPR2 DATPR3 DATPR4 NDB2DG NDBPUT
;\BBOARD date format
; ∂16-Nov-78 0848 BH original format from MAIL
; ∂16-Nov-78 BH 16-Nov-78 ME format generated by NDBBOARD command
;Command to update editing date of entry in \BBOARD.
NDBBOA: MOVE T,EDFIL ;Disallow NDBBOARD in the GRIPES file
HLRZ TT,EDFIL+1
CAMN T,['GRIPES']
CAIE TT,'TXT'
JRST NDBB0
MOVE T,EDFIL+PPN3 ;PPN
MOVS TT,EDFIL-1 ;Device
CAMN T,[MSGPPN]
CAIE TT,'DSK'
JRST NDBB0
SORRF Command illegal in this file --
JRST EXTAM3
NDBB0: PUSHJ P,NEWDLS ;Start-up routine
TLZ F,TF1 ;TF1 means we have seen end of line
HRRZ B,(I) ;Point to first old line
ADD B,[440700,,LLDESC] ;Make byte pointer to text
PUSHJ P,NDBGET
CAIE C,"∂" ;Line start with partial sign?
JRST NDBB22 ;No
MOVEI TT,">" ;Yes
DPB TT,B ;Change it to greater-than sign
AOS TT,TXTNUM
HRRM TT,TXTSER-LLDESC(B) ;Give old line a new serial number (it changed)
SETZM TXTWIN-LLDESC(B) ;clear window ptr for line in current window
JRST NDBB22
NDBB2: PUSHJ P,NDBGET ;Get char from old line
NDBB22: CAIN C,15
JRST NDBB5 ;Stop at end of line
PUSHJ P,NDBPUT ;Copy old dir line to new
CAIE C," " ;Space ends date
JRST NDBB2
PUSHJ P,NDBGET
CAIE C," " ;Two spaces means this is original dir line
JRST NDBB66 ;Otherwise, assume it is output of NDBBOARD cmd
NDBB3: PUSHJ P,NDBGET ;Skip over original time
CAIN C,15
JRST NDBB5 ;Strange format, missing tab
CAIE C,11
JRST NDBB3
NDBB33: PUSHJ P,NDBGET ;This should be programmer name
CAIN C,15
TLOA F,TF1 ;End of line
CAIN C,11
JRST NDBB44
PUSHJ P,NDBPUT ;Preserve original programmer name
JRST NDBB33
; ∂16-Nov-78 BH 16-Nov-78 ME format generated by NDBBOARD command
;Here when updating line that apparently already contains NDBBOARD format.
NDBB4: PUSHJ P,NDBPUT ;Char of programmer name
PUSHJ P,NDBGET
NDBB66: CAIN C,15
JRST NDBB5 ;Sudden end of line!
CAIE C,11
JRST NDBB4
NDBB6: PUSHJ P,NDBGET ;Skip over old date and programmer name
CAIN C,15
JRST NDBB5 ;Sudden end
CAIE C,11 ;Tab ends programmer name
JRST NDBB6
JRST NDBB44
NDBB5: TLO F,TF1 ;End of line without seeing space!
NDBB44: PUSHJ P,DATPRG ;Insert date and programmer name
TLNE F,TF1 ;Anything left in line?
SOJA G,NDFIN ;No, all done
MOVEI C,11 ;Yes, copy rest of line (subject) after a tab
PUSHJ P,NDBPUT
NDBB55: PUSHJ P,NDBGET ;Get char from old line
CAIN C,15
SOJA G,NDFIN ;All done, close off FS
PUSHJ P,NDBPUT
JRST NDBB55
NDBGET: ILDB C,B ;Get char from old line
CAIE C,11
POPJ P,
ILDB C,B ;Skip over spaces in middle of tab
CAIE C,11
JRST .-2
POPJ P,
;Put out tab, current date, space, user's programmer name
DATPRG: LDB C,H ;Back up over spaces at end of previous output
CAIE C," "
JRST DATPR0
ADD H,[070000,,0] ;Back up byte pointer
JUMPGE H,.+2
SUB H,[430000,,1] ;Back up to previous word
SOJG G,DATPRG ;We've backed up one column
DATPR0: MOVEI C,11
PUSHJ P,NDBPUT ;Precede date with tab
DATE T, ;Get today's date
IDIVI T,=31 ;Day of month into TT, months into T
PUSH P,T
MOVEI T,1(TT) ;Day of month
PUSHJ P,NDB2DG ;Put out day of month
POP P,T
IDIVI T,=12 ;Year into T, month into TT
ADD TT,[440700,,MONTH]
DATPR2: ILDB C,TT
PUSHJ P,NDBPUT
TLNE TT,760000 ;End of ASCII month word?
JRST DATPR2 ;No
ADDI T,=64
PUSHJ P,NDB2DG ;Put out 2-digit year
MOVEI C," "
PUSHJ P,NDBPUT
HRLZ TT,RPPN ;Get programmer name
DATPR3: MOVEI T,0
LSHC T,6 ;Get one char into T
JUMPE T,DATPR4 ;Omit spaces
MOVEI C,40(T) ;Convert to ascii
PUSHJ P,NDBPUT ;Put into new dir line
DATPR4: JUMPN TT,DATPR3
POPJ P,
NDB2DG: IDIVI T,=10 ;Put out two digit number from T
MOVEI C,"0"(T)
PUSHJ P,NDBPUT
MOVEI C,"0"(TT)
NDBPUT:
LEG IDPB C,H ;Insert char from old line
CAIE C,11
AOJA G,CPOPJ ;Plain char, count one column
HRROI C,-10
IORI C,(G)
SUB G,C ;Count number of additional columns
ADD K,C ;Count negative of spaces generated by tabs
MOVEI T,40
JRST .+11(C)
REPEAT 10,<LEG IDPB T,H>
MOVEI C,11
LEG IDPB C,H
AOJA K,CPOPJ ;Make the negative count be for "extra" spaces only
;OTHERC UPPERC LOWERC LOWER2 UPLOGO UPLOLL UPLOCL MAKOTH UPLOCX UPLOC2 UPLOLX UPLOAT UPLOAN UPLOA2 UPLOWD UPLBWL UPLOWF UPLFWL UPLOXX CASCHK MAKOT2 UPLFWD UPLBWD UPLCHL TOLET TONLET BACKBP FORWBP
;⊗#⊗XPROPCASE makes text contain proper case (capitals only after periods)
;⊗#⊗XSUPPERCASE makes all text following given special char be upper case
;⊗#⊗XSLOWERCASE makes all but first char following given special char be lower case.
;The above are not implemented.
;⊗#⊗XUPPERCASE uppercasifies # lines, or # words if given from line editor
;⊗#⊗XLOWERCASE lowercasifies # lines, or # words if given from line editor
;⊗#⊗XOTHERCASE inverts case of # lines, or # words if given from line editor
;The above commands all work on several contiguous incore pages. This is OK
;because none of these commands change the number of chars on any line and
;therefore they don't change the number of chars or lines on any page.
OTHERC: MOVEI E,2 ;Index for doing OTHER case
JRST LOWER2
UPPERC: TDZA E,E ;Index for doing UPPER case
LOWERC: MOVEI E,1 ;Index for doing LOWER case
LOWER2: TRNE F,EDITM ;If from line editor, then work on words
JRST UPLOWD ;Work within line editor
TLZ F,TF1 ;Nothing changed yet
MOVE T,ARRL ;Remember line number where starting
MOVEM T,ARRLIS ;Save it in case backing up
TRNE F,ATTMOD ;Attach mode?
JRST UPLOAT ;Yes
PUSHJ P,ARGCHK ;Check arg, maybe move up if negative arg
JUMPE A,CPOPJ ;Return quick if zero arg (or no lines)
HRRZ C,ARRLIN ;Get pointer to current line
UPLOGO: MOVEM A,JCNT ;Remember number of lines to do
UPLOG2: TLO F,NOCHK ;Prevent shuffling in FSGIVE
UPLOLL: HRRZ T,TXTCNT(C) ;See if blank line
JUMPE T,UPLOLX ;Don't bother looking at blank line
PUSHJ P,ATTCP4 ;Copy text of line into new FS block, get ptr in A
MOVE B,A ;Copy ptr to new version
ADD B,[440700,,LLDESC] ;Make byte ptr to text of line
MOVEI TT,0 ;Flag nothing changed yet
UPLOCL: ILDB T,B ;Get char from line
CAIN T,15 ;End of line?
JRST UPLOCX ;Yes
HLL T,CTAB(T) ;Get bits for this char
TLNN T,LETF ;Skip if a letter
JRST UPLOCL
TLNN T,LT2F ;Skip if lower case
JRST @(E)[UPLOCL ;UPPER cmd -- already upper case, loop to next char
MAKOTH ;LOWER cmd -- make it lower case
MAKOTH] ;OTHER cmd -- make it lower case
JRST @(E)[MAKOTH ;UPPER cmd -- make it upper case
UPLOCL ;LOWER cmd -- already lower case, loop to next char
MAKOTH] ;OTHER cmd -- make it upper case
MAKOTH: TRC T,40 ;Change case of letter
DPB T,B ;Stuff back into FS block
TLO F,TF1 ;Some text will have changed
AOJA TT,UPLOCL ;Count a changed char, loop to next char
UPLOCX: JUMPE TT,UPLOC2 ;Jump if no change in line
EXCH A,C ;New line into C, old into A
MOVE TT,(C)
HRLM C,(TT) ;Make following line point back to new one
MOVS TT,TT
HRRM C,(TT) ;Make previous line point forward to new one
MOVE TT,TXTFLG(C) ;See if old line (and new one) was special
TLNE TT,WINBIT ;Window line?
MOVEM C,WINLIN ;Yes, new line is window line now
TLNE TT,ARRBIT ;Arrow line?
MOVEM C,ARRLIN ;Yes, new line is arrow line now
UPLOC2: PUSHJ P,FSGIVE ;Release one copy of line (from A)
UPLOLX: HRRZ C,(C) ;Next line
SOSLE JCNT ;Any more lines to do?
JRST UPLOLL ;Yup
TLZ F,NOCHK ;All done diddling FS, can shuffle now
MOVE A,ARRLIS
PUSHJ P,SETARR ;Reposition arrow back where we started
TLZN F,TF1 ;Did anything change?
POPJ P, ;No
TRNE F,ATTMOD ;Attach mode?
JRST ATTWRT ;Yes, note that att buffer has changed
JRST SETWRT ;Set the W flag
UPLOAT: JUMPE A,CPOPJ ;Zero arg is no-op
JUMPL A,UPLOAN ;Negative arg means lines at end of att buf
CAMLE A,ATTNUM ;Max number of lines to do is number attached
MOVE A,ATTNUM
HRRZ C,ATTBUF ;Start at beginning of attach buffer
JRST UPLOGO
UPLOAN: MOVN A,A ;Make it positive count of lines
CAMLE A,ATTNUM ;Max number of lines to do is number attached
MOVE A,ATTNUM
MOVEM A,JCNT ;Save number of lines to do
HLRZ C,ATTBUF ;Get last line in buffer
UPLOA2: SOJLE A,UPLOG2 ;Jump if this is the right line to start at
HLRZ C,(C) ;Back up a line
JRST UPLOA2
;Here when case diddling cmd given from line editor.
;AC A contains number of words to diddle.
UPLOWD: JUMPE A,CPOPJ ;Zero words is easy
MOVE B,EDCNM ;Get char position of activator (cursor)
IDIVI B,5 ;Adjust byte pointer forward that many chars
ADD B,BTAB4(C) ;Make byte pointer to char at cursor
MOVE D,EDCNM ;Get cursor position, for end testing
JUMPGE A,UPLOWF ;Jump if doing words forward from cursor
MOVE J,TONLET ;Instruction to get us to word delimiter
MOVE K,[CAI] ;Instruction to check for and do any case diddling
JSP H,UPLBWD ;Backup, ignoring current word
UPLBWL: MOVE J,TOLET ;Instruction to get us to a letter or digit
MOVE K,[CAI] ;Don't do anything until we see a letter/digit
JSP H,UPLBWD ;Backup till see a letter
MOVE J,TONLET ;Instruction to get us to word delimiter
MOVE K,[PUSHJ P,CASCHK] ;Instruction to check for and do any case diddling
JSP H,UPLBWD ;Backup diddling case until delimiter
AOJL A,UPLBWL ;Loop until have done enough words
POPJ P,
;Here to diddle case of words moving forward.
;First we have to backup to beginning of current word.
UPLOWF: MOVE T,EDSIZ ;Get count of chars, including activator
SUBI T,1 ;Uncount activator
SKIPGE EDCHR ;Uncount LF after CR, if any
SUBI T,1 ;Fudge for LF
PUSH P,[UPLOXX] ;Put address on stack in case hit beginning
MOVE J,TONLET ;Instruction to get us to word delimiter
MOVE K,[CAI] ;Don't diddle while backing up
JSP H,UPLBWD ;Backup to delimiter (may return "up" to UPLOXX)
SUB P,[1,,1] ;Flush special exit address
UPLFWL: MOVE J,TOLET ;Instruction to get us to first letter or digit
MOVE K,[CAI] ;No diddling along the way
JSP H,UPLFWD ;Forward march
MOVE J,TONLET ;Instruction to get us to word delimiter
MOVE K,[PUSHJ P,CASCHK] ;Instruction to check for and do case diddling
JSP H,UPLFWD ;Move forward, diddling case, up to delimiter
SOJG A,UPLFWL ;Loop until done enough words
POPJ P,
;Here if backing up in BACKBP reached left end of line. Jump into forward loop.
UPLOXX: MOVEI D,0 ;Char position is at left end
JRST UPLFWL ;Start forward on current word
CASCHK: TLNN C,LETF ;If not a letter,
POPJ P, ; nothing possible to do
TLNN C,LT2F ;Skip if lower case
JRST @(E)[CPOPJ ;UPPER cmd -- already upper case
MAKOT2 ;LOWER cmd -- make it lower case
MAKOT2] ;OTHER cmd -- make it lower case
JRST @(E)[MAKOT2 ;UPPER cmd -- make it upper case
CPOPJ ;LOWER cmd -- already lower case, loop to next char
MAKOT2] ;OTHER cmd -- make it upper case
MAKOT2: TRC C,40 ;Change case of letter
DPB C,B ;Stuff back in buffer
POPJ P,
;While current char is/isn't digit or letter, move given direction.
;Call with JSP H, with J containing TLNE/TLNN C,NUMF!LETF
;and with K containing instruction to execute for each char until end.
UPLFWD: SKIPA I,[JSP G,FORWBP] ;Instruction for advance byte pointer in B
UPLBWD: MOVE I,[JSP G,BACKBP] ;Instruction to backup byte pointer in B
UPLCHL: LDB C,B ;Get current char
HLL C,CTAB(C) ;Get flags for this char
XCT J ;Test for letter or digit
JRST (H) ;Now we're in previous word
XCT K ;Maybe diddle case
XCT I ;Backup or go forward
JRST UPLCHL ;Loop until see letter or digit
;The following two words are picked up into J for use in above routine.
TOLET: TLNE C,NUMF!LETF ;Instruction to skip until see letter or digit
TONLET: TLNN C,NUMF!LETF ;Instruction to skip until see word delimiter
;Routine to back up byte pointer in B, decrementing D. If D runs out, POPJs,
;else returns to caller. Call with JSP G,BACKBP.
BACKBP: SOJL D,CPOPJ ;Return up level if no more chars to backup over
ADD B,[70000,,0] ;Back up byte ptr
JUMPGE B,(G) ;Return unless need to backup byte ptr a word
SUB B,[430000,,1] ;Backup to last byte in previous word
JRST (G) ;Return to caller
;Routine to advance byte pointer in B, incrementing D. If D hits end of
;line (specified by T), POPJs, else returns to caller. Call with JSP G,FORWBP.
FORWBP: ADDI D,1 ;Next char
CAIL D,(T) ;Reach end of line?
POPJ P, ;Yes, return up level
IBP B ;No, advance byte pointer to next char
JRST (G) ;Return to caller
;⊗ LSPRUN LSPPPN LSPIN2 MLLEN QMMAXC LSPINI LSPMAI LSPMBF LSPSTR LSPST2 LSPLEN PTYNBR PTYBLK INTBTS INTLSP INTPTY LSPJ PLOGIN XON FULTWX SUBJOB SUBJO2 JBTLIN JOBN1 JNA SUJOB1 SUJOBJ OCTARG OCTAR1 OCTAR2 SUJOB3 SUJOB0 SUJOBK SUJOBF SUJOB2 SUJOE1 SUJOE2 SUJOE4 EECHO EECHO2 SUBECH SUECHI SUBLST SUBLC2 SUBLCL SUECH2 XONON XONOFF EXONOF EXONON SULISP SLISP SLISP2 SLISPZ SLISPJ SLISJ2 SLISPY SLISP0 SUJOB4 SLISPX SLISP8 SUBLIN SUBLI0 SUBLI5 SUBLI6 SUBLI7 SUBFIN SUBFI2 SUBFI3 SUBFI4 SCREEN SNDMAI SNDAGN LSPGON SNDFUL SNDLUZ SNDLUI GETMAI GETAGN POPAJ1 GETMAL WAITCT GETNUN GETNUW GETWAI GETLUZ GETLUI SUBWAI SUBWA0 CHKMAI CHKMA2 LSPTCK LSPTC2 LSPWCH LSPWC2 LSPWC3 LSPWC5 LSPWC4 PTOCHK UNQMAI QUEMAI QUEMA2 QMINI QMINI2 QMFLS QUESHF
;default dmp file for SLisp cmd
LSPRUN: 'DSK ' ;device
'MACLSP' ;file name
'DMP ' ;extension
LSPPPN: ' 1 3' ;default PPN for SLISP (SULISP uses alias)
;default init file for Lisp
LSPIN2: 'DSK ' ;device
'ELISP ' ;file name
'INI ' ;extension
0 ;unused
0 ;PPN
IMPURE
MLLEN←←40 ;length of mail messages, in words
QMMAXC←←20 ;max number of Lisp mail msgs we'll try to queue
LSPINI: BLOCK 5 ;for user-specified init filename, same format as LSPIN2
LSPMAI: BLOCK MLLEN ;for sending mail to Lisp
LSPMBF: BLOCK MLLEN ;for receiving mail from Lisp
LSPSTR: BLOCK 1 ;Addr of Lisp string, for passing to Lisp
LSPST2: BLOCK 1 ;Addr of FS of Lisp string
LSPLEN: BLOCK 1 ;Remaining length of lisp string
PTYNBR: BLOCK 2 ;block for controlling subjob through pty
PTYBLK: BLOCK 30 ;block for holding ptrds output from pty
PURE
INTBTS←←INTTTY!INTMAI!INTPTO ;interrupt bits to enable sometimes
INTLSP←←INTTTY!INTMAI ;int bits needed for lisp connection
INTPTY←←INTTTY!INTPTO ;int bits needed for PTY coonection
LSPJ←←7 ;AC where we'll pass our job number to the LISP job (SWAP uuo AC).
;LSPJ better not be A or P or F!
;Init file's name goes in standard system startup ACs:
;0/name(FILWRD)
;1/ext
;3/ppn
;6/device(DEVWRD)
PLOGIN←←5 ;PTJOBX function code for log in job
XON←←2 ;Bit to suppress LF insertion on pty under us
FULTWX←←4 ;Bit to suppress echo on pty under us
;Here for ⊗XSUBJOB cmd to start a user job on a PTY under us.
SUBJOB: JUMPLE A,SUJOB0 ;negative or zero arg is special
SETZM PLMODE ;use default mode upon starting
PUSHJ P,SOMODS ;set hdr to display subjob output mode
TRNE F,ARG ;positive arg means connect to that pty job
JRST SUJOB1 ;reconnect to old pty job
PUSHJ P,SUBJO2 ;get a subjob
JRST POPJ1 ;got it
JRST POPJ1 ;failed, already said why
;Get pty and skip only upon error (w/msg already typed in both cases).
SUBJO2: PTYGET PTYNBR ;get a pty
JRST SUJOE2 ;none to be had
MOVEI TT,PLOGIN ;PTY login function
MOVEM TT,PTYNBR+1
PTJOBX PTYNBR ;log in the pty
JRST SUJOE1 ;no job slots
HRRZ A,PTYNBR ;get line number
MOVN A,A ;negated line number will be put into LISPJB
PUSHJ P,SUBSAV ;set new subjob number, remember old one if any
SETZM LSPWAI# ;don't ever wait for pty to initialize
SETZM LNCRLF ;don't suppress leading crlf
SETZM PTECHO# ;the default is no pty echo
PUSHJ P,SUECHI ;set echo mode from PTECHO
POPJ P,
JBTLIN←←236 ;low core pointer to JBTLIN table
JOBN1←←222 ;low core cell holding JOBN-1
JNA←←40000 ;jbtsts bit meaning job exists
;Here to reconnect to old pty job, line number (typed as decimal) is in A.
SUJOB1: PUSHJ P,OCTARG ;re-interpret arg read as decimal as octal
;Here to reconnect to old pty job, PTY line number in A (arg).
SUJOBJ: PUSHJ P,SUJOB3 ;attach to job
JRST POPJ1 ;made it
JRST POPJ1 ;lost
;User gave a numeric arg which we read as decimal, but it is really an octal
;number, so get the octal value. Arg in A, returned in A; other ACs preserved.
OCTARG: PUSH P,B ;preserve B
PUSHJ P,OCTAR1 ;call recursive routine
POP P,B
POPJ P,
OCTAR1: IDIVI A,=10 ;get low digit, breaking by 10 decimal
HRLM B,(P) ;save remainder (should be less than 8)
JUMPE A,OCTAR2 ;done if high part is zero
PUSHJ P,OCTAR1 ;convert rest of number to octal
LSH A,3 ;multiply higher digits value by 8
OCTAR2: HLRZ B,(P) ;get current octal digit
ADDI A,(B) ;add in to total, return octal in A
POPJ P,
;Connect to PTY job whose PTY line number (positive) is in A. Skip on failure.
SUJOB3: MOVNI B,(A) ;make it negative of pty nbr
TTYJOB B, ;get pty's controlling job number
PJOB T, ;get our job nbr
CAIE T,(B) ;is it our pty?
JRST SUJOE4 ;nope (should never happen, with line nbr in LISPJB)
HRRZM A,PTYNBR ;store pty nbr for connection
MOVN A,A ;negative subjob number (negative line nbr)
PUSHJ P,SUBSAV ;set new subjob number, remember old one if any
SETZM LSPWAI ;don't ever wait for pty to initialize
; PTGETL PTYNBR ;get line characteristics
; MOVE TT,PTYNBR+1 ;put them where we keep them
; HLLM TT,PTYNBR
POPJ P,
SUJOB0: SKIPL LISPJB ;skip if pty job exists
JRST EQUALE ;no pty
JUMPE A,SUJOB2 ;zero arg means report pty job
SUJOBK: PTYREL PTYNBR ;negative arg means release the pty
SUJOBF: SETZM LISPJB ;forget about pty
HRRZS SOMOD ;clear display mode
SETOM NEEDHD ;set flag to make HEADS think about hdr line
SETZM LMBUSY# ;forget about any stuff waiting to be processed
PUSHJ P,LCNCLR ;forget about old stuff half processed
MOVSI TT,INTBTS
INTACM TT, ;no more funny interrupts to worry about
POPJ P,
SUJOB2: HRRZ TT,PTYNBR ;get pty line number
TTYJOB TT, ;get number of job logged in
HRLZ A,TT ;copy job number
JUMPN A,SUJOB4 ;if any job, go get wholine
OUTSTR [ASCIZ/ No job logged in on PTY/]
HRRZ TT,PTYNBR ;pty line number
SETZM TYOPNT ;force output to be typed
TYPOCT TT ;type line nbr
JRST PPJ1CR ;type crlf and skip return
SUJOE1: PTYREL PTYNBR
SUJOE2: SORRF No PTYs or no job slots available.
JRST POPJ1
SUJOE4: SORRF Not a PTY job of ours.
JRST POPJ1
;Command routine to set flag to enable/disable E echoing while in Eval loop.
EECHO: JUMPE A,EECHO2 ;jump if zero arg, report state
MOVEM A,EECHFG# ;set flag, default is zero (E echo on)
POPJ P,
EECHO2: SKIPGE EECHFG ;skip if echoing is on
OUTSTR [ASCIZ/ E echo in Eval is suppressed. /]
SKIPL EECHFG
OUTSTR [ASCIZ/ E echo in Eval is enabled. /]
JRST POPJ1
;Command routine to set flag to enable/disable subjob echoing.
SUBECH: SKIPL LISPJB ;pty job around?
JRST EQUALE ;no, error
JUMPE A,SUECH2 ;jump if zero arg, report state
MOVEM A,PTECHO ;set flag
SUECHI: MOVSI TT,FULTWX ;no-echo bit
SKIPLE PTECHO
JRST SUBLCL ;clear the bit in line characteristics, allow echo
;Here to Set PTY line characteristics bit(s) indicated by LH of TT.
SUBLST: HRR TT,PTYNBR ;insert pty line number
TRO TT,401000 ;explicit tty & op code 1: set LINTAB bits
SUBLC2: MOVSM TT,1(P) ;use stack as temporary storage
HRROI TT,1(P) ;make ptr to single ttyset cmd
SKIPGE LISPJB ;don't set if no pty in use
TTYSET TT, ;execute the cmd
POPJ P,
;Here to Clear PTY line characteristics bit(s) indicated by LH of TT.
SUBLCL: HRR TT,PTYNBR ;insert pty line number
TRO TT,402000 ;explicit tty & op code 2: clear LINTAB bits
JRST SUBLC2
SUECH2: SKIPG PTECHO ;skip if echoing is on
OUTSTR [ASCIZ/ PTY echo is suppressed. /]
SKIPLE PTECHO
OUTSTR [ASCIZ/ PTY echo is enabled. /]
JRST POPJ1
;Set pty's xon.
XONON: MOVSI TT,XON ;set this bit, to suppress LF insertion
JRST SUBLST ;set in line characteristics
;Clear pty's xon.
XONOFF: MOVSI TT,XON ;clear this bit, to give us LF insertion
JRST SUBLCL ;clear in line characteristics
repeat 0,<
EXONOF: SKIPA TT,[-1,,[2000,,XON]] ;clear our own XON
EXONON: HRROI TT,[1000,,XON] ;set our own XON
SKIPL LISPJB ;no diddling unless connected to pty
POPJ P,
SKIPE DPY ;unless we aren't a display!
TTYSET TT, ;setting XON only affects echoing of our inserted LF
POPJ P,
>;repeat 0
;Just like SLISP, but SULISP uses default PPN of user's ALIAS.
SULISP: SKIPA B,PPN ;alias is default
;Command to start up phantom Lisp job.
;Takes file name like RUN command; if no name given, uses default above (MACLSP).
SLISP: MOVE B,LSPPPN ;1,3 is default
SETZM ESCIEN ;no ESC I typed yet
JUMPLE A,SLISP0 ;negative or zero arg?
SETZM PLMODE ;use default mode upon starting/connecting to lisp
PUSHJ P,SOMODS ;set hdr to display subjob output mode
TRNE F,ARG ;positive arg means set job number to that job
JRST SLISPJ ;talk to that job from now on
MOVE T,[LSPRUN,,RUNDEV] ;set up standard name of dmp file
BLT T,RUNFIL+1 ;put it where swap will see it
MOVEM B,RUNFIL+PPN3 ;insert default PPN
PUSHJ P,GETRUN ;Get filename of dmp file
JRST RUNILL ;lost
MOVE B,C ;save input char
MOVE T,[LSPIN2,,LSPINI]
BLT T,LSPINI+4 ;copy default init file to output block
CAIN B,15 ;anything else coming?
JRST SLISP2 ;nope
CAIE B,"(" ;init file coming (surrounded with parens)?
JRST RUNILL ;no, bad spec
MOVE T,PPN
MOVEM T,LSPINI+1+PPN3 ;set up default PPN
MOVE D,[FRDRUN!FRDPAR,,LSPINI+1]
PUSHJ P,FRD0 ;scan init filename
JRST RUNILL ;bad name
CAIN C,")" ;optional right paren
PUSHJ P,TYI ;Get char after paren
JFCL ;ignore skip return
PUSHJ P,XTDEND ;make sure we're read whole cmd line
PUSHJ P,CHKFII ;Make sure the file really exists
JRST RUNFN2 ;nope
SLISP2: PUSHJ P,CHKFIL ;make sure dmp file exists
JRST RUNFN2 ;doesn't exist
PUSH P,LSPJ ;Save this particular AC
PUSH P,F ;save crucial AC
MOVEI T,-1 ;Starting address increment
MOVEM T,RUNFIL+2
MOVEI T,4
HRRM T,RUNFIL+1 ;make swap do non-phantom startup of another job
MOVE T,[LSPINI+1,,FILWRD]
BLT T,FILWRD+PPN3 ;copy init filename to ACs
MOVE DEVWRD,LSPINI
MOVEI LSPJ,RUNDEV
SWAP LSPJ,
MOVE A,LSPJ ;save job number
MOVEI T,1
MOVEM T,RUNFIL+2 ;restore normal starting addr incr
POP P,F ;restore ACs
POP P,LSPJ
JUMPE A,SLISPZ ;don't diddle stuff for old job if no new job
PUSHJ P,SUBSAV ;set new subjob number, remember old one if any
SETOM LSPWAI# ;set flag to wait for lisp to initialize
PUSHJ P,QMINI ;get FS block for queueing Lisp mail
JRST POPJ1
SLISPZ: SORRF Failed to start up a Lisp job -- maybe no job slots.
JRST POPJ1 ;no OK
;Set explicit lisp job number from arg in A (now positive).
;First we make sure job whose number is given isn't on a PTY of ours!
SLISPJ: MOVEI TT,JOBN1 ;see if job number is in range
PEEK TT, ;get max job number
CAILE A,(TT) ;skip if OK
JRST SLISJ2 ;bad job nbr, can't be real job
MOVEI TT,(A) ;job nbr
JBTSTS TT, ;get job status
TLNN TT,JNA ;better be real job
JRST SLISJ2 ;nope
MOVEI TT,JBTLIN ;get ptr to table from low core
PEEK TT, ;get table address
ADDI TT,(A) ;add in job number
PEEK TT, ;get job's jbtlin entry
TRNE TT,400000 ;is this a detached job?
JRST SLISJ2 ;yes, isn't on a PTY of ours then
MOVNI TT,(TT) ;make it negative of pty nbr
TTYJOB TT, ;get pty's controlling job number
PJOB T, ;get our job nbr
CAIN T,(TT) ;is it our pty?
JRST SLISPY ;yes, don't accept as Lisp subjob
SLISJ2: PUSH P,A ;all OK (or JOBCHK will detect the problem)
PUSHJ P,SUBSAV ;set new subjob number, remember old one if any
SETZM LSPWAI ;don't wait for lisp init, maybe already done
PUSHJ P,QMINI ;get FS block for queueing Lisp mail
POP P,A ;new job nbr
PUSHJ P,JOBCHK ;see if this is really our job
OUTSTR [ASCIZ/(Subjob's PPN doesn't match yours;
type ⊗-⊗XSLISP (and then maybe ESC I) to forget that job.)
/]
JRST POPJ1
SLISPY: SORRF Job
MOVE T,A ;get job number
PUSHJ P,RECONT ;type job name and number
OUTSTR [ASCIZ/ is already a PTY subjob; can't be a Lisp subjob too!
/]
JRST POPJ1
SLISP0: SKIPG LISPJB ;Any lisp job?
JRST EQUALL ;no
JUMPL A,SLISPX ;negative arg means tells job to suicide
HRLZ A,LISPJB ;number of our lisp job
SUJOB4: PUSHJ P,ABCRLF
HRRI A,LSPMBF ;place to receive wholine
WHO A,
OUTSTR LSPMBF ;Type wholine
JRST POPJ1
;Here to tell Lisp subjob to go away. Skips on failure.
SLISPX: MOVEI TT,LSPSUI ;type code telling lisp to suicide
MOVEM TT,LSPMAI+LMCMD ;store in mail block
PUSHJ P,SNDMAI ;send mail to lisp
JRST SLISP8 ;failed somehow, don't say OK
SKIPN LSPWAI ;did lisp ever initialize?
JRST SUJOBF ;yes, just forget about job
SKIPA TT,[[ASCIZ/Lisp had never initialized./]]
SLISP8: MOVEI TT,[ASCIZ/Subjob kill failed!/]
PUSHJ P,ABCRLF ;maybe type out CRLF
OUTSTR (TT) ;type error msg
OUTSTR [ASCIZ/ Maybe you should kill it manually (job /]
SETZM TYOPNT ;force typeout
TYPDEC LISPJB ;type job nbr
OUTSTR [ASCIZ/).
/]
MOVNI TT,1
BEEP TT, ;catch his attention with a beep
AOS (P) ;take failure return (no OK)
JRST SUJOBF ;forget about lisp job
;⊗XSUBLINK command connects to a PTY subjob on stack, or creates one, then does
;10XBOTSET (unless botset greater than 3 already done), then goes to Eval loop.
SUBLIN: JUMPLE A,SUBLI0 ;negative or zero arg is just like SUBJOB
PUSH P,B ;save any arg
PUSH P,A ;and bucky bits
PUSHJ P,SUBFIN ;find a PTY subjob and connect to it
JRST SUBLI5 ;got it
JRST PPBAJ1 ;failed
SUBLI0: JUMPE A,SUBJOB ;zero arg, let SUBJOB handle it
TRZ F,ARG!REL ;make BOTSET restore standard size
MOVE A,PPSIZ
CAILE A,PPSIZD ;page printer bigger than default?
PUSHJ P,BOTSET ;yes, set page printer size back to standard
JFCL ;cmd routine may skip
MOVNI A,1 ;make negative arg again
JRST SUBJOB ;let SUBJOB handle PTY release
SUBLI5: POP P,A ;saved arg
TRNE F,ARG!REL ;any arg?
JRST SUBLI6 ;yes, use it for BOTSET
MOVEI A,=10 ;no, use this default PP size
TRO F,ARG ;use our explicit arg in BOTSET
MOVE T,PPSIZ ;current PP size
CAILE T,PPSIZD ;already bigger than default?
JRST SUBLI7 ;yes, don't bother changing
;now move bottom of window up to make room for bigger page printer, if possible.
;but we don't try to move other windows up to do this (we could, with some effort).
SUBLI6: PUSHJ P,GSCBTM ;get max SCRBOT among all other live windows (TT)
SUB TT,SCRLOW ;biggest SCRBOT-SCRLOW is most PPSIZ can increase
SUB TT,PPSIZ ;this makes biggest PPSIZ we can allow right now
MOVN TT,TT ;positive max PPSIZ
CAILE A,(TT) ;can we have PP as big as we want?
MOVE A,TT ;no, use biggest PP size w/o moving other windows
;; OUTSTR [ASCIZ/(Must move bottom(s) of other window(s) up to get big enough PP size.)/]
PUSHJ P,BOTSET ;set bottom
JFCL ;command routine may skip
SUBLI7: POP P,B ;get back bucky bits
JRST EVAL ;now jump into ⊗XEVAL cmd!
;Command routine (and subroutine) to find a PTY subjob of ours and connect to it.
;Skips on failure.
SUBFIN: SKIPGE LISPJB ;already talking to pty?
POPJ P, ;yes, save trouble
SKIPG T,JOBMAX ;any stacked subjobs?
JRST SUBFI3 ;no, make subjob
MOVN T,T
MOVSI T,(T) ;aobjn ptr to subjob stack
SUBFI2: SKIPGE A,OLDJOB(T) ;is this a pty?
JRST SUBFI4 ;yes, connect to it
AOBJN T,SUBFI2 ;no, keep looking
SUBFI3: SETZM PLMODE ;select typeout mode
PUSHJ P,SOMODS ;set hdr to display subjob output mode
PUSHJ P,SUBJO2 ;none in stack, call command routine to get pty
POPJ P, ;OK, we got one
JRST POPJ1 ;already reported lossage, take error return
SUBFI4: MOVM A,A ;make it positive line number
PUSHJ P,SUJOB3 ;connect to specified PTY subjob
POPJ P, ;OK, got it
JRST POPJ1 ;failed and already reported problem
;Command routine to do screen editor. Find PTY subjob, select LPEND mode,
;go to end of page, and enter Eval loop. Bucky bits on ⊗X select line/char mode.
SCREEN: PUSH P,B ;save bucky bits of command
PUSHJ P,SUBFIN ;find a PTY subjob and connect to it
CAIA ;OK
JRST POPUP1 ;lost, flush saved data from stack, return w/o OK
MOVEI A,-1
PUSHJ P,SETARR ;move to end of incore text
PUSHJ P,LPEND ;select LPEND mode
HRRZM P,PTECHO ;enable echoing
PUSHJ P,SUECHI ;set pty line characteristics
POP P,B ;restore char/line flag from bucky bits
JRST EVAL
;Routine to send mail to lisp from LSPMAI block. Skips on success,
;takes direct return on some sort of error (job gone, timed out, ESC I typed).
SNDMAI: MOVE T,LISPJB ;number of Lisp job
MOVEI TT,LSPMAI ;address of letter to be mailed
MOVEI B,0 ;amount of waiting to do
SNDAGN: SKPSEN T ;send mail to Lisp
AOJA B,SNDFUL ;mailbox full, wait and retry a few times
JRST POPJ1 ;letter sent OK
LSPGON: SORRF Lisp job no longer exists!
JRST SUJOBF ;flush interrupts, forget old subjob number
SNDFUL: CAILE B,5 ;how many times to try
JRST SNDLUZ ;timed out
SKIPE ESCIEN ;ESC I typed?
JRST SNDLUI ;yes, quit waiting
SLEEP B, ;wait longer and longer
JRST SNDAGN ;and try again
SNDLUZ: SORRF Lisp job's mailbox is full and not emptying!
POPJ P,
SNDLUI: SORRF ESC I typed while waiting for Lisp job's mailbox to empty.
POPJ P,
;Routine to get required incoming mail from lisp. Skips on success,
;takes direct return on some sort of error (timed out, ESC I typed).
;Clobbers only TT, uses RH of T as expected reply code.
;Doesn't look at mail already queued, since if it did it could loop forever,
;inasmuch as this routine queues mail that isn't what it's looking for.
;Caller must guarantee than required mail can't have been previously received.
;This could cause trouble if a whole sequence of cmds gets queued while we're
;waiting for something (JOBRD done or continuation).
GETMAI: PUSH P,A ;save an AC
MOVEI A,0 ;amount of waiting to do
GETAGN: SRCV LSPMBF ;try to receive continuation mail from lisp
AOJA A,GETNUN ;none there
PUSHJ P,LSPTCK ;check validity and type of message
JRST GETMAL ;failed the test, maybe queue this if interesting
POPAJ1: POP P,A ;restore AC
JRST POPJ1 ;got some mail! success return
;here if got mail other than letter we were expecting
GETMAL: PUSHJ P,LSPTC2 ;see if this is a reasonable msg
JRST GETAGN ;nope, ignore it (maybe some other job sent it)
PUSHJ P,QUEMAI ;queue this message (must preserve T)
OUTSTR [ASCIZ/ (Discarded a message from subjob: no room to queue.)
/]
JRST GETAGN ;and look for the msg we need
WAITCT←←7 ;We wait 1,2,3,..,WAITCT, seconds on subsequent waits for Lisp.
;If user says wait forever, we never wait more than WAITCT+2 seconds, and we
;type a warning msg when waiting WAITCT+1 secs.
GETNUN: CAIG A,WAITCT ;how many times to try quietly
JRST GETNUW ;keep waiting
SKIPGE WAITOK# ;want to wait forever?
JRST GETLUZ ;no, timed out
CAIE A,WAITCT+1 ;is this first time here?
SOJA A,GETNUW ;no, don't wait longer each time now
OUTSTR [ASCIZ/ (Waiting forever for Subjob response. ESC I aborts.)
/]
GETNUW: SKIPE ESCIEN ;ESC I typed?
JRST GETLUI ;yes, quit waiting
GETWAI: SLEEP A, ;wait longer and longer
JRST GETAGN ;and try again
GETLUZ: SORRF Lisp won't send a required message (maybe continued transfer).
JRST POPAJ
GETLUI: SORRF ESC I typed while awaiting required Lisp message (maybe continued transfer).
JRST POPAJ
;command routine to tell E to wait forever when needing a response from Lisp.
SUBWAI: JUMPE A,SUBWA0 ;zero arg means report
MOVEM A,WAITOK ;set flag as requested.
POPJ P,
SUBWA0: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/E will wait for subjob for/]
SKIPGE WAITOK ;skip if forever
OUTSTR [ASCIZ/ about 30 seconds./]
SKIPL WAITOK ;skip if finite wait
OUTSTR [ASCIZ/ever./]
JRST PPJ1CR
;routine to read mail from Lisp and skip if any. First, though, it looks
;for mail from Lisp that E queued earlier.
CHKMAI: PUSHJ P,UNQMAI ;get any queued mail into LSPMBF
JRST CHKMA2 ;none, look for new mail
JRST POPJ1 ;OK, got old queued mail
CHKMA2: SRCV LSPMBF ;read any mail awaiting us
POPJ P, ;no mail
JRST POPJ1 ;got some
;Routine to check the Lisp mail already received for being of a certain type.
;Type is indicated by RH T. Skips on success. (Also validates protocol.)
;Clobbers only TT.
LSPTCK: HRRZ TT,LSPMBF+LMCMD ;get opcode
CAIE TT,(T) ;is it the expected opcode?
POPJ P, ;no
LSPTC2: HLRZ TT,LSPMBF+LMJOB ;get protocol name
CAIE TT,'EPR' ;our protocol?
POPJ P, ;no!
HRRZ TT,LSPMBF+LMJOB ;see if mail is from our correspondent
CAMN TT,LISPJB ;is it?
AOS (P) ;success
POPJ P,
;Here to see if we should wait for Lisp's initial OK before sending Lisp stuff.
;Skips unless user aborts with ESC I. Clobbers T and TT.
LSPWCH: SETOM LSWCNT# ;set flag to tell user once that we are waiting
LSPWC2: SKIPN LSPWAI ;need to wait for Lisp?
JRST POPJ1 ;no (perhaps just talking to pty)
INTMSK [0] ;mask off ints
PUSHJ P,CHKMAI ;last minute mail check
CAIA ;no mail
JRST LSPWC3 ;aha, some mail is here
AOSN LSWCNT ;want to tell user we are waiting?
OUTSTR [ASCIZ/ (Waiting for Lisp to initialize...)
/]
SKIPN ESCIEN ;don't wait if ESC I already typed
IMSTW [-1] ;mask ints on and wait for one
SKIPN ESCIEN ;ESC I typed?
JRST LSPWC2 ;no, start test over (without saying anything)
INTMSK [-1] ;yes, first mask interrupts back on
OUTSTR [ASCIZ/ ESC I typed while waiting for Lisp to initialize; nothing sent to Lisp yet.
/]
POPJ P,
;Here if we got some mail. Maybe it's the initial OK.
LSPWC3: MOVEI T,LSPDUN ;type of mail expected
PUSHJ P,LSPTCK ;right kind?
JRST LSPWC4 ;nope, but maybe it was good stuff from right job
LSPWC5: SETZM LSPWAI ;yes! don't ever have to wait for this lisp again
JRST POPJ1
LSPWC4: HRRZ T,LSPMBF+LMCMD ;get opcode
CAIGE T,LCMAX ;reasonable value?
PUSHJ P,LSPTC2 ;yes, rest of msg reasonable?
JRST LSPWC2 ;nope, ignore mail and wait for more
SETOM LMBUSY ;yes, flag that mail is waiting, process it soon
JRST LSPWC5 ;take success return
;Routine to see if anything waiting from pty. Skips if NO PTY OUTPUT.
PTOCHK: MOVE C,[40,,PTYBLK] ;ptr to input block -- 40 means don't wait
MOVEM C,PTYNBR+1
SETZM PTYBLK
PTRDS PTYNBR ;see if any input waiting from pty
SKIPN PTYBLK ;skip if read anything from pty
AOS (P)
POPJ P,
;Here to see if we can now eat some previously queued mail.
;Skip return iff so, with mail stuffed into LSPMBF and dequeued.
UNQMAI: SKIPG QMCNT# ;any incoming mail queued, ready to read?
POPJ P, ;nope
SOS QMCNT ;decrease count of queued msgs
PUSH P,A ;don't clobber any ACs
MOVE A,QMTAKR ;get taker ptr, for blt
IMULI A,MLLEN ;convert to word offset
ADD A,QMBEG ;add address of buffer
HRLZ A,A ;make it blt source
HRRI A,LSPMBF
BLT A,LSPMBF+MLLEN-1 ;move whole msg to where it is expected
AOS A,QMTAKR ;advance taker
CAIL A,QMMAXC ;reach end of buffer?
SETZM QMTAKR ;yup, reset to beginning
JRST POPAJ1 ;restore A and return
;here to queue the mail msg currently at LSPMBF. Skips unless no room to queue.
QUEMAI: SKIPN QMBEG ;any place to queue?
POPJ P, ;nope, take error return
PUSH P,A ;clobber no ACs
PUSH P,B
AOS A,QMCNT ;count a msg queued
CAILE A,QMMAXC ;buffer already full?
JRST QUEMA2 ;yup, uncount and take error return
MOVE A,QMPUTR ;get putter ptr, for blt
IMULI A,MLLEN ;convert to word offset
ADD A,QMBEG ;add address of buffer
HRLI A,LSPMBF ;fixed mail buffer is source
MOVEI B,MLLEN-1(A) ;blt end address
BLT A,(B) ;put msg into queue
AOS A,QMPUTR ;advance putter
CAIL A,QMMAXC ;reach end of buffer?
SETZM QMPUTR ;yup, reset to beginning
JRST PPBAJ1 ;restore ACs and return
QUEMA2: SOS QMCNT ;buffer full, fix count
JRST POPBAJ ;restore ACs and return
;routine to set up a queue for Lisp mail
QMINI: SKIPE QMBEG ;already have an FS block for queueing mail?
JRST QMINI2 ;yes, just make it look empty
MOVEI B,QMMAXC*MLLEN ;get FS for queued Lisp mail buffer
PUSHJ P,FSGET ;get block
MOVSI T,QUECOD ;type of FS
HLLM T,-1(A) ;mark this FS, for shuffling routines
MOVEM A,QMBEG# ;store address of beginning
QMINI2: SETZM QMPUTR# ;initialize putter
SETZM QMTAKR# ;initialize taker
SETZM QMCNT# ;no messages in queue yet
POPJ P,
;routine to discard the FS that is used as a Lisp mail queue.
;(not yet called from anywhere! we just keep this block forever.)
QMFLS: SKIPN A,QMBEG ;any buffer?
POPJ P, ;nope
PUSHJ P,FSGIVE ;return the FS
SETZM QMBEG ;no buffer now
SETZM QMCNT ;nothing queued either
POPJ P,
;routine called when FS manager is about to shuffle the Lisp queue's FS.
;we carefully manage to keep only one absolute ptr, others ptrs are
;counts from the beginning of the queue.
QUESHF: ADDM C,QMBEG ;buffer being moved by distance in C
POPJ P,
;LSCHK LSCH0 LSCH2 LSCH2A LSCH3 LSCH4 LSPTY LSCH5 LSPT2 LSESCI LSREAD LSMA3 LSMA2 lsgo HLDNOW LCBCNT LCDSP LCMAX LSMAI LSUNDO LSUND2 LCRDV LCMAC LCANS LCDATA RLSTRG RLSTR2 LCNCHK LCNCLR DOJBRD DOJBRX DOJBRE LSEND
;Routine to wait in INTW for either type-in or mail from Lisp.
;Here ONLY from MAIN via CMDIN and CMDRD with no even partially typed command
;in progress and not in line editor (i.e., waiting for top level E cmd),
;AND from EVAL via CMRTR2 (which might be from line editor).
;Take skip return upon reading char from TTY.
;Take direct return upon calling a macro or locking up incoming mail, to make our
;caller reconsider whether something else should be done before calling us again.
;LINFLG is zero if we should look for single char and nonzero if we should
;look for a whole line typed. LINFL2 is nonzero iff we should allow ESC I
;to change between line and char modes.
;* means these instr's would be different for Line mode version of this routine.
LSCHK: AOS (P) ;assume we will skip
LSCH0: MOVE C,[INCHRS C] ;char mode input uuo
SKIPE LINFLG ;want line mode?
MOVE C,[INCHSL C] ;yes, line mode uuo
MOVEM C,LSCHKI# ;save uuo
SKIPGE LMBUSY ;user want us to process mail now?
JRST LSMA3 ;yes, we've already received it, now process it
XCT LSCHKI ;* read char and skip if char/line typed
CAIA
POPJ P, ;return with char read
LSCH2: SKIPGE SUBNOW ;here from special cmd to read subjob w/o waiting?
POPJ P, ;yes, return now
HRROI C,[1000,,SPCACT]
SKIPN LINFLG ;no special activation if line mode wanted
TTYSET C, ;* set special activation mode
;We use special activation mode with SETACT already done of all chars activating
;to get an interrupt when user types any char.
LSCH2A: INTMSK [0] ;mask off ints
XCT LSCHKI ;* one last check for type-in waiting
CAIA ;no type-in
JRST LSUNDO ;aha, something snuck in, undo modes and return char
SKIPGE LISPJB ;skip unless connected to pty
JRST LSCH3
PUSHJ P,CHKMAI ;last minute mail check
JRST LSCH4 ;no mail
JRST LSMAI ;aha, some mail is here
LSCH3: AOSE PTREAD# ;skip if we already read pty output text
PUSHJ P,PTOCHK ;check for pty output
JRST LSPTY ;yup, go process it now
LSCH4: SKIPGE SUBNOW# ;here from special cmd to read subjob w/o waiting?
JRST LSUNDO ;yes, return now, undoing special interrupt stuff
SKIPE LINFL2 ;is ESC I allowed to diddle input mode?
SKIPN ESCIEN ;yes, seen an ESC I?
IMSTW [-1] ;no, mask ints on and wait for one
SKIPE LINFL2 ;is ESC I allowed to diddle input mode?
SKIPN ESCIEN ;yes, seen an ESC I?
CAIA ;no
JRST LSESCI ;yes
PUSHJ P,LSUND2 ;clear special activation if set it
XCT LSCHKI ;* read char and skip if char/line typed
CAIA
POPJ P, ;return with char read
SKIPGE LISPJB ;skip unless connected to pty
JRST LSCH5
SRCV LSPMBF ;read mail and skip if any
JRST LSCH2 ;no typein, no mail, go back and wait for interrupt
JRST LSMA2
LSPTY: PUSHJ P,LSUNDO ;undo interrupt stuff
JRST LSPT2
;Here after interrupt, to see if pty output caused it. We don't set up
;PTYNBR+1 again because it is already set up from last PTRDS, which doesn't
;change it. Also, PTYBLK is still zero from then.
LSCH5: PTRDS PTYNBR ;try reading from pty again
SKIPN PTYBLK ;anything read?
JRST LSCH2 ;nope, loop
LSPT2: SETZM LSPMBF+LMCMD ;no flag bits in lisp mail block either!
MOVEI D,PLTEXP ;process the pty text
JRST LSGO
;Here on ESC I typed while in EVAL loop or in LRECEIVE cmd.
LSESCI: PUSHJ P,LSUNDO ;fix up modes changed for interrupt wait
SKIPE SUBNOW ;is this really LRECEIVE cmd?
POPJ P, ;yes, return now
SETZM ESCIEN ;clear ESC I flag
SETZM LINFLG ;assume want char mode (ESC I)
SKIPGE ESCIE2 ;skip if ESC I typed, not BRK I
SETOM LINFLG ;BRK I typed, give user line mode
JRST LSCH0 ;start over waiting for input/mail/pty
;Routine to look and/or wait for subjob work.
;Before calling, set SUBNOW negative if don't want to wait, or positive
;to wait for that many lines to come from subjob. On return, must zero SUBNOW!
;May or may not skip return; caller should not use skip as information.
LSREAD: AOS (P) ;be like LSCHK, which does SOS (P) at LSGO
SETOM LINFLG ;avoid TTYSET, use "line" mode
MOVSI C,(<JFCL>)
MOVEM C,LSCHKI ;no-op avoids ever reading tty
SKIPL LMBUSY ;skip if already got mail and user wants to see it
JRST LSCH2A
LSMA3: SETZM LMBUSY ;clear mail-buffer-busy flag
SKIPG LISPJB ;skip if connected to lisp
JRST LSPT2 ;pty text waiting, go get it
;here with mail just read
LSMA2: PUSHJ P,LSPTC2 ;check mail for valid protocol (clobbers TT)
JRST LSCH2 ;no, ignore mail
;Here we're making the assumption that we don't need to save any ACs, because
;we only get here from MAIN via CMDIN and CMDRD, or from EVAL via CMRTR2.
;We let our caller save whatever
;ACs it needs preserved, besides F and P. However, we must make
;sure that the cmd flags (REL,ARG,NEG) are restored to their current state,
;which we happen to know (see CMDRD) is all zero. So now we just dispatch
;on the Lisp message type, then clear the cmd flags and loop back to wait again
;for typein or mail (unless display has changed, or macro called, etc., via lisp).
;(Actually, we currently don't call any routines that change the cmd flags,
;so we don't bother clearing them after returning from the dispatch.)
;We also assume that since we not inside any E commands, we can play with FS
;at will; in particular, we'll be creating and calling macros here, and
;sticking text from lisp into the attach buffer or the page.
HRRZ C,LSPMBF+LMCMD ;get lisp's cmd type
CAIL C,LCMAX ;reasonable value?
JRST LSCH2 ;no, ignore this garbage mail
SETZM LSPWAI ;clear wait-for-lisp-initialization flag
SETZM ESCIEN ;no ESC I typed yet to abort lisp xfer
HRRZ D,LCDSP(C) ;get dispatch
HLL D,LSPMBF+LMCMD ;get flags, if any, from cmd word
lsgo: SKIPE NOSUBO# ;manually holding up subjob?
MOVEI D,HLDNOW ;yes, change routine to special one to hold it
PUSHJ P,(D) ;call routine to handle lisp mail
;This next jfcl forces us always to go back and consider updating the display
;which is necessary because we suppress display updates when subjob output
;is awaiting us, even if we are just going to type the output.
;Someday, when I'm sure this is the right thing, I'll flush the skip return
;of the routines called via (D) just above, but for now just pretend they
;all skip.
JFCL ;; JRST LSCH2 ;no macro created nor display changed, wait more
SOS (P) ;don't skip return from LSCHK after all
POPJ P, ;so we can check for display update or new macro
HLDNOW: OUTSTR [ASCIZ/(Subjob output has arrived; type ⊗XLRECEIVE to process it.)
/]
HRRZM P,LMBUSY ;leave mail buffer or ptyblk marked in use
JRST POPJ1 ;get us out of LSCHK since now holding
LCBCNT: POINT 6,LCDSP(TT),17 ;byte ptr to get xfer's count of bytes per word
;Macro to define dispatch table entry. ADR is dispatch address for
;receipt of such a msg, NAME is symbol defined with numeric code of message
;(for sending), and CNT is number of bytes per word for this type xfer.
DEFINE XX(ADR,NAME,CNT),<IFDIF <NAME><><NAME←←.-LCDSP>
ADR+IFDIF <CNT><><CNT⊗=18;>0>
;Dispatch table for various cmd types from lisp mail.
LCDSP: XX(CPOPJ,LSPNOP) ;0 no-op
CPOPJ ;1 "initiating a conversation"
XX(CPOPJ,LSPDUN) ;2 "conversation initiated" or "did the JOBRD"
XX(LCANS,LSPXPR,5) ;3 lisp is returning an SEXPR answer (value)
CPOPJ ;4 "explicit eof"
XX(LCMAC,,5) ;5 lisp is giving E some commands to execute as a macro
XX(CPOPJ,LSPINT) ;6 interrupt (ESC I or something similar)
XX(CPOPJ,LSPSUI) ;7 close connection (given by E)
XX(LCRDV,LSPRDV,1) ;10 from Lisp: sends n words of RDV names
;10 from E: return n words of name,value RDV pairs
LCMAX←←.-LCDSP ;size of table
;Here when mail came in just as we were about to go into INTW.
LSMAI: PUSHJ P,LSUNDO ;undo special modes that were needed for INTW
JRST LSMA2 ;go process the mail we just got
LSUNDO: INTMSK [-1] ;mask ints on so we won't be saving them up
LSUND2: HRROI TT,[2000,,SPCACT] ;(should be able to clobber any AC but C here)
SKIPN LINFLG ;don't clear special activation if didn't set it
TTYSET TT, ;* clear special activation mode
POPJ P,
;Evaluate readonly variables for lisp subjob.
LCRDV: MOVEI J,LCRDV2 ;routine to call to evaluate readonly variables
JRST LCDATA ;get names and then call routine
;Process lisp cmd text by making it into a macro and calling the macro.
LCMAC: SKIPA J,[LCMAC3] ;routine to call to define macro and call it
;Process "answer" from lisp.
LCANS: MOVEI J,PLTEXT ;routine to call to process lisp's answer text
LCDATA: PUSHJ P,RLSTRG ;read lisp string, skip if error
PUSHJ P,(J) ;process lisp text or cmds
CAIA
AOS (P) ;pass skip return up (update display or call macro)
SKIPE A,MFBLK ;FS addr of block
PUSHJ P,FSGIVE ;we didn't keep that block for long
POPJ P, ;that was easy
;Read lisp's string, return ptr to it in D, with JBREND set up pointing to
;an added terminating null following the string and MFBLK pointing to any FS
;block used to hold the string. Clobbers A,B,C,D,T,TT.
;Skips on null string received.
RLSTRG: PUSHJ P,LCNCHK ;are we continuing a previous string?
POPJ P, ;yup, all set
TLNN D,LSPSHT ;short answer (in mail block)?
JRST RLSTR2 ;no, must do JOBRD
SETZM MFBLK ;no FS block needed to hold string
HRRI D,LSPMBF+LMTXT ;pointer to text (flags still in LH)
HRLI D,440700 ;make byte ptr, assuming 7-bit bytes
PUSHJ P,LSEND ;mark end of byte string with a null if ascii
POPJ P,
JRST POPJ1 ;null string, pass error return up
;Here if answer is too long for mail block, must do jobrd to get it.
RLSTR2: PUSHJ P,DOJBRD ;get data via jobrd
AOSA (P) ;error of some sort, take skip return
HRLI D,440700 ;make byte ptr, assuming 7-bit bytes
POPJ P,
;Skip unless continuing an old string.
;Return byte ptr in D if not skipping, if skipping mustn't clobber D.
LCNCHK: SKIPN JBRCON# ;continuing old string?
JRST POPJ1 ;nope
MOVE D,JBRCON ;yes, set byte ptr to restart with
MOVE TT,JBRBEG# ;get back ptr, if any, to beginning of FS blk
MOVEM TT,MFBLK ;make FS get freed if we finish it this time
SETZM JBRCON ;don't continue next time if we finish this time
POPJ P,
;Routine to forget about a to-be-continued string when changing subjobs.
LCNCLR: SKIPN JBRCON ;is there a string to be continued?
POPJ P, ;nope
SETZM JBRCON ;yes, forget about it
SKIPE A,JBRBEG ;is there an FS block to be freed?
PUSHJ P,FSGIVE ;yes, return it
POPJ P,
;Get data from lisp job via JOBRD. Skip on success.
;On return D points to the first word of data from lisp (in FS block).
DOJBRD: HRRZ TT,LSPMBF+LMCMD ;get cmd code
LDB TT,LCBCNT ;get number of bytes per word for cmd's xfer
HLRE B,LSPMBF+LMBMA ;negative byte count
MOVN B,B ;positive byte count
ADDI B,-1(TT) ;round up to next word
IDIVI B,(TT) ;convert to word count
ADDI B,1 ;get an extra FS word for ending null byte
PUSHJ P,FSGET ;get some FS to put text from lisp (ptr in A)
MOVEM A,MFBLK ;save FS block address
MOVSI TT,LOKBIT ;don't let this FS be shuffled because, e.g.,
HLLM TT,-1(A) ; macro FS may be created before our FSGIVE
MOVE D,A ;set my address for jobrd
MOVNI C,-1(B) ;negative word count, discounting extra FS word
HRLZ C,C ;-wc,,0
HRR C,LSPMBF+LMBMA ;-wc,,his address
MOVE B,LISPJB ;job number
MOVEI TT,B ;jobrd block is ACs B,C,D
JOBRD TT,
JRST DOJBRE ;some sort of error
PUSHJ P,LSEND ;mark ascii string end with null, skip if length zero
AOS (P) ;skip for successful job read
DOJBRX: MOVEI TT,LSPDUN ;type-code saying jobrd is done
MOVEM TT,LSPMAI+LMCMD ;store command in mail block
PUSHJ P,SNDMAI ;send mail to lisp
JFCL ;failed or timed out or something
POPJ P,
DOJBRE: CAIE B,1 ;is this a "job not logged in" error?
CAIN B,5 ;of either kind?
JRST LSPGON ;yes, forget lisp job, and don't tell it anything
JRST DOJBRX ;no, just tell lisp we won, even though we didn't
;Mark end of string pointed to by D with a null. Skip return if length is zero.
;Doesn't insert null at end unless string is of 7-bit chars.
LSEND: HLRE B,LSPMBF+LMBMA ;get negative byte count
JUMPE B,POPJ1 ;skip return for length zero
HRRZ TT,LSPMBF+LMCMD ;get cmd type again
LDB TT,LCBCNT ;get count of bytes per word
CAIE TT,5 ;if not 5 bytes/word, then don't insert null!
POPJ P, ;perhaps whole word bytes (RDV)
MOVN B,B ;positive byte count
IDIVI B,5 ;convert to word count and byte remainder
ADDI B,(D) ;point to word containing following byte
HLL B,BTAB4(C) ;set up byte pointer to that following byte
MOVEI C,0
DPB C,B ;make sure that following byte is a zero
MOVEM B,JBREND# ;store byte pointer to the following null byte
POPJ P,
;LATTAC LTYPE LFILE LPEND2 LPEND LMTELL PLXCT PLMMAX PLTELL SOMODT SOMODS PLTEND PLTEN2 PLTEXP PLTEXT LTXTYP LTXTY2 LTXTY3 LRECEI LRECEM LRECE2 LRECEX LRECE0 LRECE3 LRECE4 LCRDV2 LCRDV3 LCRDV4
;Set lisp answer mode to attach answer text.
LATTAC: JUMPE A,LMTELL ;Zero arg means tell current mode
SKIPGE PLMODE ;already in this mode?
POPJ P, ;yes
SETOM PLMODE ;set mode to attach
PUSHJ P,SOMODS ;set hdr to display subjob output mode
SKIPL LISPJB ;skip if connected to pty instead of lisp
SETOM LNCRLF ;set lisp-no-crlf flag upon entering this mode
POPJ P,
;Set lisp answer mode to type answer text.
LTYPE: JUMPE A,LMTELL ;Zero arg means tell current mode
SETZM PLMODE ;set mode to typeout
PUSHJ P,SOMODS ;set hdr to display subjob output mode
SKIPL LISPJB ;skip if connected to pty instead of lisp
SETZM LNCRLF ;set lisp-no-crlf flag upon entering this mode
POPJ P,
;Set lisp answer mode to put answer text into incore text at arrow.
LFILE: JUMPE A,LMTELL ;Zero arg means tell current mode
MOVEI T,1
LPEND2: EXCH T,PLMODE ;set mode to add to file's incore text
PUSHJ P,SOMODS ;set hdr to display subjob output mode
JUMPG T,CPOPJ ;return if already in LFILE or LPEND mode
SKIPL LISPJB ;skip if connected to pty instead of lisp
SETOM LNCRLF ;set lisp-no-crlf flag upon entering this mode
POPJ P,
;Set lisp answer mode to put answer text at end of last page now in core.
;If that page (and file) is not in core upon text arrival from lisp,
;text output will be suspended.
LPEND: JUMPE A,LMTELL ;Zero arg means tell current mode
MOVE T,CURPAG ;remember the page that
MOVEM T,ANSPAG# ; we must be on to insert lisp text at end
MOVE T,ZINDEX ;remember file that we must be in
MOVEM T,ANSFIL# ; to insert text at end of given page
MOVEI T,2
JRST LPEND2
;Tell user what lisp-answer mode is currently.
LMTELL: MOVE TT,PLMODE
CAML TT,[-1] ;range check the mode
CAIL TT,PLMMAX ;in range?
PUSHJ P,TELLZ ;nope!
OUTSTR [ASCIZ/ Subjob-answer mode is to /]
XCT PLTELL(TT)
JRST POPJ1 ;don't say OK
;Dispatch table for PLTEXT.
PUSHJ P,LTXATT ;-1 attach lisp text
PLXCT: PUSHJ P,LTXTYP ;0 type lisp's answer
PUSHJ P,LTXFIL ;1 put lisp text into current page
PUSHJ P,LTXEND ;2 put lisp text at end of special page if in core
PLMMAX←←.-PLXCT
;Table parallel to PLXCT, for reporting mode to user.
OUTSTR [ASCIZ/Attach answer text./]
PLTELL: OUTSTR [ASCIZ/Type answer text./]
OUTSTR [ASCIZ/Insert answer text at arrow./]
PUSHJ P,PLTEND ;insert at end of special page if in core
;Table parallel to PLXCT, for displaying subjob output mode.
ASCII/ a/ ;attach
SOMODT: ASCII/ t/ ;type
ASCII/ f/ ;insert answer text at arrow
ASCII/ e/ ;insert at end of special page if in core
;Make sure hdr displays right subjob output mode.
SOMODS: PUSH P,T
MOVE T,PLMODE ;get subjob output mode
SKIPN LISPJB ;set display char in hdr if any subjob
TDZA T,T ;display nothing if no subjob connected
MOVE T,SOMODT(T) ;get char representing it
HLLM T,SOMOD ;store in hdr
SETOM NEEDHD ;set flag to make HEADS think about hdr line
JRST POPTJ
PLTEND: OUTSTR [ASCIZ/insert answer text at End of page /]
SETZM TYOPNT
TYPDEC ANSPAG
MOVE D,ANSFIL
CAMN D,ZINDEX ;is answer file the current file?
JRST PLTEN2 ;yes
OUTSTR [ASCIZ/ of /]
ADD D,[400000,,ZDATA] ;make pointer to filename block
PUSHJ P,FILTYP ;type filename
PLTEN2: OUTSTR [ASCIZ/.
/]
POPJ P,
;Enter here to process PTY's output text.
PLTEXP: MOVEI D,PTYBLK ;get ptr to pty text, no flag bits
PUSHJ P,LCNCHK ;see if continuing old string
CAIA ;yup
HRLI D,440700 ;make full word byte ptr
SETZM MFBLK ;no FS block in use holding JOBRD text
;Here to process some 7-bit text from Lisp.
;Ptr to text is in D, negative byte count is in LH of LSPMBF+LMBMA.
;;Mail flags used to be in LH of D, now D is full word byte ptr.
PLTEXT: MOVE TT,PLMODE# ;get current mode for handling such text
CAML TT,[-1] ;range check the mode
CAIL TT,PLMMAX ;in range?
PUSHJ P,TELLZ ;nope!
XCT PLXCT(TT) ;yes, call appropriate routine
POPJ P,
JRST POPJ1 ;pass skip return on up
;Type text from lisp, skipping over any leading CRLF.
LTXTYP:
;; HRLI D,440700 ;make a byte ptr
SKIPG LISPJB ;don't skip crlf if text is from pty
JRST LTXTY3
ILDB TT,D
CAIE TT,15
JRST LTXTY2 ;no leading crlf
ILDB TT,D
CAIE TT,12
LTXTY2: ADD D,[70000,,0] ;back up byte ptr
LTXTY3: TLZ D,7777 ;zero count for TTYMES
MOVSI C,'TTY'
MOVEI TT,C
TTYMES TT, ;type to self
JFCL ;can't not skip
POPJ P,
;Cmd routine to let E finally eat any previously arrived text from Lisp.
;The flag LMBUSY is used to note when lisp mail or pty output is already
;read from the system and waiting to be processed in our core image, and
;when such mail or output is being help up for now automatically
;by E. If output is being held up by user command (-XLRECEIVE),
;then NOSUBO will be nonzero.
;LMBUSY = 0 means nothing is waiting.
;LMBUSY < 0 means something is waiting and we should process it very soon.
;LMBUSY > 0 means something is waiting, held up automatically until XLRECEIVE.
;NOSUBO nonzero means user requested holding up output with -XLRECEIVE.
;XLRECEIVE means unhold and receive awaiting stuff now.
;-XLRECEIVE means hold up further stuff.
;0XLRECEIVE means report state of holding already received stuff.
;nXLRECEIVE means receive at least n lines.
;+XLRECEIVE means look for subjob stuff now, but no minimum line count, no waiting
LRECEI: SKIPN LISPJB ;any connected job?
JRST EQUALE ;no, error
JUMPE A,LRECE0 ;jump if zero arg
JUMPL A,LRECE3 ;jump if negative arg
SETZM NOSUBO ;enable subjob output
SKIPE LMBUSY ;anything waiting?
SETOM LMBUSY ;yes, allow us to process mail now, w/o reading it
TRNN F,ARG!REL ;explicit arg?
POPJ P, ;no, enabling subjob is enough
SETOM SUBNOW ;assume no waiting
TRNE F,ARG ;explicit arg?
MOVEM A,SUBNOW ;yes, store number of lines we want
SETZM ESCIEN ;no ESC I typed
SETOM LINFL2 ;enable ESC I to get us out of this wait
LRECEM: SKIPGE SUBNOW ;skip if may wait
JRST LRECE2 ;no waiting, don't update display
PUSHJ P,DISP ;update display,
PUSHJ P,SKPSUB ; if nothing waiting from subjob
LRECE2: PUSHJ P,LSREAD ;read some lines from subjob
JFCL ;ignore skip return
SKIPG SUBNOW ;did we read enough?
JRST LRECEX ;yup
SKIPN ESCIEN ;ESC I typed?
JRST LRECEM ;no, read more
SORRY ESC I typed while waiting for subjob output.
LRECEX: SETZM SUBNOW# ;MUST clear this flag before returning
POPJ P,
LRECE0: SKIPLE LMBUSY
OUTSTR [ASCIZ/ Subjob output is waiting for you. /]
SKIPGE LMBUSY
OUTSTR [ASCIZ/ Subjob output has just been unheld! /]
SKIPE LMBUSY
JRST POPJ1
SKIPN NOSUBO
OUTSTR [ASCIZ/ No subjob output being held up. /]
SKIPE NOSUBO
OUTSTR [ASCIZ/ Subjob output will be held up. /]
JRST POPJ1
;Here to put lisp output on hold until next ⊗X LRECEIVE cmd.
LRECE3: SKIPLE LMBUSY ;make sure not already on hold
JRST LRECE4 ;already holding
SETOM NOSUBO ;no subjob output allowed through now
POPJ P,
LRECE4: OUTSTR [ASCIZ/ Subjob output is already waiting! /] ;not a SORRY error, though
JRST POPJ1
;Here to evaluate set of readonly variables for lisp subjob.
LCRDV2: HRLI D,444400 ;make byte ptr to variable names
MOVEM D,MFBYTE
HLRE D,LSPMBF+LMBMA ;get negative byte count
MOVNM D,MFCNT ;save for countdown
PUSHJ P,ENDSET ;set up expandable FS
MOVE I,FSEND ;address of FS
HRLI I,4400 ;make full word bytes in byte ptr
MOVEI J,-2 ;routines via RDVARP need XCT LENSKP(J) for LE test
LCRDV3: ILDB TT,MFBYTE ;get a name
MOVSI T,-NRDVAR ;Number of readonly values
CAME TT,RDVAR(T) ;Does name match this readonly variable?
AOBJN T,.-1 ;No, keep looking
JUMPGE T,LCRDV4 ;No such readonly value, ignore this name (for now)
XCT RDVARP(T) ;Get readonly value where MACHAK expects it
CAIA ;Numeric readonly variable is OK
JRST LCRDV4 ;String readonly variable is ignored (for now)
LEG IDPB TT,I ;stuff name in reply FS
LEG IDPB E,I ;stuff value in reply FS
LCRDV4: SOSLE MFCNT ;any more names?
JRST LCRDV3 ;yes, evaluate them
MOVE J,FSEND ;get ptr to beginning of FS (at header)
SUBI J,(I) ;subtract final ptr, giving negative word count
MOVNM J,LSPLEN ;set length of data for xfer
MOVE J,FSEND ;get starting ptr again
ADDI J,1 ;point at data
MOVEM J,LSPSTR ;save for sending
MOVEM J,LSPST2 ;save for returning FS
ADDI I,2 ;advance beyond FS trailer, for FSFIX
MOVSI TT,LOKBIT ;lock down this special FS block
FSFIX I,TT
PUSHJ P,ENDFIX ;quit expanding FS
MOVEI TT,LSPRDV ;type code for RDV answers
MOVEM TT,LSPMAI+LMCMD ;store in mail block
MOVEI C,1 ;number of bytes per word being sent
PUSHJ P,SNDLSP ;send data to lisp
JFCL ;lost somehow, timed out or interrupted by ESC I
MOVE A,LSPST2 ;get back FS address
PUSHJ P,FSGIVE ;free up the FS
POPJ P,
;LTXEND LTXER1 LTXER3 LTXER2 LTXFIL LTXEN2 LTXAT3 LTXATT LTXAT2 LTXFI2 LTXEN3 FAKLUP FAKEND LTXLIN LTXLUP LTXNU2 LTXCR1 LTXCR0 LTXCR LTXCR2 LTXLF LTXLF2 DELFAK LTXTAB LTXDSP LTXNUL LTXCO3 LTXLUZ LTXDLY LTXCON LTXCO2 LCMAC3 LCMACX LMCHAR
;Take text from lisp and put it at end of page if right file & page is incore.
LTXEND: MOVE T,ZINDEX
CAME T,ANSFIL ;is this the file where the text should go?
JRST LTXER1 ;no
MOVE T,CURPAG
CAME T,ANSPAG ;is this the page where the text should go?
JRST LTXER2 ;no
TRNE F,ATTMOD!EDITM ;in attach mode or line editor mode?
JRST LTXEN2 ;yes, can't do this now then
MOVE T,ARRL ;yes, this is the right page, want to be at end
CAMLE T,LINES ;if already at end of page
JRST LTXFI2 ; then stay at new end by using normal LFILE mode
MOVEM T,UNPEND ;remember where to return to on page
SETOM OLDFAS ;don't save line position (we're coming right back)
MOVEI A,-1
PUSHJ P,SETARR ;get to end of page
MOVEI I,JPTAB ;normal-mode table of things to diddle
JRST LTXEN3 ;no, that's good, go ahead and receive text
LTXER1: OUTSTR [ASCIZ/(Subjob text arrived for file /]
MOVE D,ANSFIL ;index of proper file
ADD D,[400000,,ZDATA] ;make pointer to filename block
PUSHJ P,FILTYP ;type filename
OUTCHR ["/"]
TYPDEC ANSPAG
OUTCHR ["P"]
LTXER3: OUTSTR [ASCIZ/; use ⊗X LRECEIVE when on that page.)
/]
HRRZM P,LMBUSY# ;flag that we can't receive any more mail!
JRST POPJ1 ;get us out of LSCHK so we won't read mail
LTXER2: SETZM TYOPNT
OUTSTR [ASCIZ/(Subjob text arrived for page /]
TYPDEC ANSPAG
JRST LTXER3
;Take text from lisp and put it on page just above the arrow.
;If we're gonna add text to the page but we're in attach mode,
;then we have to delay the reception from lisp for later.
LTXFIL: TRNN F,ATTMOD!EDITM ;in attach mode or line editor mode?
JRST LTXFI2 ;no, that's good, go ahead and receive text
LTXEN2: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/(Page text arrived from Subjob; can't receive it while in attach or line edit
mode. Use ⊗X LRECEIVE cmd when ready to receive it.) /]
HRRZM P,LMBUSY# ;flag that we can't receive any more mail!
JRST POPJ1 ;get us out of LSCHK so we won't read mail
LTXAT3: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/(Attach buffer text arrived from Subjob; can't receive it while in Eval from
line editor. Use ⊗X LRECEIVE cmd when ready to receive it.) /]
HRRZM P,LMBUSY# ;flag that we can't receive any more mail!
JRST POPJ1 ;get us out of LSCHK so we won't read mail
;Take text from lisp and add at end of attach buffer.
LTXATT: TRNE F,EDITM ;can't go into attach mode while in line editor
JRST LTXAT3 ;so hold up subjob output for now
TROE F,ATTMOD ;already in attach mode?
JRST LTXAT2 ;yes, don't diddle valid attach mode parameters
MOVE TT,[ATTBUF,,ATTBUF] ;no, set up empty buffer ptrs
MOVEM TT,ATTBUF ;make hdr point to itself, both ways
SETZM ATTSIZ ;no chars attached yet
LTXAT2: SKIPA I,[JATAB] ;attach-mode table of things to diddle
LTXFI2: MOVEI I,JPTAB ;normal-mode table of things to diddle
;now take the text from the lisp buffer and put it into normal text line FS blocks.
SETZM UNPEND ;don't want to move back from end of page when done
LTXEN3: SETZM JLCHG ;no lines added yet
SKIPL LISPJB ;skip if connected to pty instead of lisp
SETOM LNCRLF ;ignore leading CRLF
PUSHJ P,ENDSET ;start up expandable FS block
;; HRLI D,440700 ;initialize byte ptr for getting text
MOVSI H,LSPC!NSPEC ;special action for usual bytes
MOVEI DSP,LTXDSP ;dispatch table ptr
XCT JLTPT(I) ;load B with ptr to line to insert after
HRRZ T,(B) ;get ptr to line to insert before
MOVEM T,LTXFOL# ;remember following line for each time at LTXLF
;here we'll see if this new stuff should be appended to old line above,
;which it should be if old line above came to us this way but without a CRLF!
SETZM FAKEC2# ;no old line to delete yet
SKIPN T,FAKECR ;did we have to insert a CRLF?
JRST LTXLIN ;nope, no hack needed
SETZM FAKECR ;forget about this line for next time
CAIE B,PAGE ;page hdr isn't a real line
CAIN B,ATTBUF ;att buffer hdr isn't really a line!
JRST LTXLIN ;so it can't be the old line that got a fake crlf
HRRZ TT,TXTSER(B) ;get above line's serial number
CAME TT,T ;is this the line that came without a crlf?
JRST LTXLIN ;no, back to normal
MOVEM B,FAKEC2 ;save address of old line to delete later
MOVE G,FSEND ;prepare to copy old text to new FS (w/o CRLF)
ADD G,[440700,,LLDESC+1] ;byte ptr to new text
MOVE K,B ;old ptr
ADD K,[440700,,LLDESC] ;byte ptr to old text
MOVE B,TXTCNT(B) ;see if old line is empty
TRNN B,-1 ;skip if nonempty
HRLI K,350700 ;advance byte ptr over fake space
FAKLUP: ILDB C,K ;char from old line
CAIN C,15 ;end of line?
JRST FAKEND ;yes, stop copy
LEG IDPB C,G ;no, copy to new line
JRST FAKLUP
FAKEND: SUB B,[2,,0] ;uncount the CRLF we've now removed
MOVEI K,0 ;no CR seen yet
JRST LTXLUP ;now go add new text to this old text in new line
LTXLIN: SETZB B,K ;B: LH is chars, RH cols, for TXTCNT; K flags CR/LF
MOVE G,FSEND ;FS block hdr address
ADD G,[440700,,LLDESC+1] ;make byte ptr for depositing line's text
LTXLUP: GETCH2 H,D
LEG IDPB C,G ;store char in line
AOBJP B,LTXLUP ;loop unless line gets too long
FATAL Text line from Lisp has more than about 131000 characters.
LTXNU2: MOVEI C,15 ;Here with text end in middle of line--insert CRLF
LEG IDPB C,G
SETO K, ;Flag that we already have a CR for the following LF
MOVE C,TXTNUM ;sneak a look at serial number of this line
ADDI C,1 ; so that we can remember serial number of line in
HRRZM C,FAKECR# ; which we inserted a CRLF that wasn't really there
JRST LTXCR2 ;Now put in the LF
;Here to ignore leading crlf from lisp
LTXCR1: SETOM LNCRLF ;now make us ignore LF
GETCH2 H,D ;look for LF -- only LF will jump
TESTBP D ;make sure byte ptr hasn't already been backed up
ADD D,[70000,,0] ;didn't find LF, backup input ptr over this char
SETZM LNCRLF ;don't ignore crlf any more
JRST LTXLIN ;and go back to input loop, clear K
LTXCR0: TESTBP D ;make sure byte ptr hasn't already been backed up
ADD D,[70000,,0] ;back up over the LF to insert a CR
MOVEI C,15 ;here comes the CR
;Here upon CR from lisp. See if this is a leading CRLF we want to ignore.
LTXCR: HRROI K,40 ;maybe need space for an empty line, flag CR seen
AOSN LNCRLF# ;is this leading CR that we want to ignore?
JUMPE B,LTXCR1 ;yes, unless already seen text in line
JUMPN B,.+2 ;jump if line already non-empty
LEG IDPB K,G ;insert space
LEG IDPB C,G ;end line with CRLF
GETCH2 H,D
LTXCR2: TESTBP D ;make sure byte ptr hasn't already been backed up
ADD D,[70000,,0] ;no, back up over char while we process a LF
MOVEI C,12
;Here upon LF from lisp. See if this is a leading LF we want to ignore.
LTXLF: AOSN LNCRLF# ;is this leading LF that we want to ignore?
JUMPE B,LTXLIN ;yes, jump unless already seen text in line, clear K
JUMPGE K,LTXCR0 ;jump if haven't already seen a CR (insert one)
LEG IDPB C,G
TDZA C,C
IDPB C,G ;fill word with nulls
TLNE G,760000 ;end of word?
JRST .-2 ;no
ADD B,[2,,0] ;include the CR & LF in the char count
MOVNI A,1(G) ;-address beyond end of text
MOVE G,FSEND ;get ptr to start of FS again
ADDI G,1 ;point to FS data, not hdr
ADDI A,LLDESC(G) ;+starting point of text = -wds of text
MOVSI A,(A) ;aobjn count
HRRI A,LLDESC+1(G) ;text wd ptr, +1
MOVEI TT,1 ;bit to turn on in each text word
IORM TT,-1(A) ;Make ASCID text
AOBJN A,.-1 ;loop thru text, ending point beyond FS trailer
MOVSI TT,TXTCOD ;close off this FS as a text line
FSFIX A,TT
AOS TT,TXTNUM
HRRM TT,TXTSER(G) ;give new line a new serial number
SETZM TXTWIN(G) ;clear window ptr for line in current window
HRRZS TXTFLG(G) ;Clear flags for this line (in case attached)
MOVEM B,TXTCNT(G) ;store char and col counts for this line
HLRZ B,B ;char count of new line
ADDM B,@JCPTR(I) ;update count of chars on page or attached
AOS @JLPTR(I) ;count another line on page or attached
HLRZ B,@LTXFOL ;get ptr to line to insert after into B
HRL B,(B) ;get ptr to following line,,prev line
HRRM G,(B) ;make prev point to new
MOVSM B,(G) ;make new point back to prev, on to next
MOVS B,B ;prev,,next
HRLM G,(B) ;make next point back to new
SKIPLE SUBNOW ;are we counting down lines?
SKIPE FAKECR ;yes, but don't if this is a fake CRLF
JRST LTXLF2 ;no counting
SOSN SUBNOW ;count one line down
TRNE F,REL ;here from LRECEIVE -- + means read all text
JRST LTXLF2 ;keep reading text
;here we've collected just enough lines for #XLRECEIVE command, so we'll stop
;reading and leave the rest for processing later.
MOVEM D,JBRCON ;remember byte ptr for next time
MOVE TT,MFBLK ;if we've got an FS block,
MOVEM TT,JBRBEG ; then remember where it starts
SETZM MFBLK ;don't let jobrd FS get returned now (it's locked)!
HRRZM P,LMBUSY# ;flag that we can't receive any more mail!
JRST LTXDLY ;pretend end of text has been seen
LTXLF2: TRNE F,ATTMOD ;attach mode (putting new stuff into attach buffer)?
JRST LTXLIN ;yes, go put next text into another new line
HLRZ TT,B ;previous line, for fake line check
CAMN TT,FAKEC2 ;is previous line going to be flushed?
MOVE B,TT ;yes, then copy flags from prev line, not from next
MOVSI TT,ARRBIT!WINBIT ;want to move these flags from next line to new line
AND TT,TXTFLG(B) ;get old flags of next line (old line)
ANDCAM TT,TXTFLG(B) ;remove flags from old line
HLLM TT,TXTFLG(G) ;copy old flags into new line
TLNE TT,ARRBIT ;need to update arrow line ptr?
MOVEM G,ARRLIN ;yes, new line is now arrow line
TLNE TT,WINBIT ;also check window pointer
MOVEM G,WINLIN ;new line is window line
AOS JLCHG ;count another line inserted
JRST LTXLIN ;now go start up a new line
;Here to delete the old partial line that had the fake CRLF, now that we've
;replaced it with a new line (which may, in fact, have a fake CRLF of its own!).
;Pointer to line is in A
DELFAK: HLRZ B,TXTCNT(A) ;get char count of line
MOVN B,B ;negate for next add
ADDM B,@JCPTR(I) ;update count of chars on page or attached
SOS @JLPTR(I) ;count one less line on page or attached
SOS JLCHG ;count one less line inserted after all
MOVE B,(A) ;get ptr wd from line being deleted
HLLM B,(B) ;make next point back to prev
MOVS B,B ;put backward ptr into RH
HLRM B,(B) ;make prev point to next
PUSHJ P,FSGIVE ;give back the replaced old line
POPJ P,
;Here to put tab into line
LTXTAB: JUMPL K,CPOPJ ;don't do anything if handling CR now
LEG IDPB C,G ;start with a tab
HRROI TT,-10 ;max number of spaces (negative)
IORI TT,(B) ;less number of cols used in this tab slot
SUB B,TT ;count cols of this tab
MOVEI T,40 ;a space char for filling between the 2 tabs
JRST .+11(TT)
REPEAT 10,<LEG IDPB T,G> ;put in right number of spaces
SOJA B,CPOPJ ;uncount one col so AOBJP will do right thing
;Dispatch table used for processing incoming text from subjob.
LTXDSP: JSP C,LTXNUL ;0 null NSPEC (check for end of string)
JUMPGE K,LTXLUP ;1 rubout NSPEC (ignore)
JUMPGE K,LTXCR ;2 CR LSPC (jump unless already processing CR)
JRST LTXLF ;3 LF LSPC
PUSHJ P,LTXTAB ;4 TAB LSPC
JUMPGE K,LTXLUP ;5 FF LSPC (ignore)
XCT ALTCVT ;6 ALT LSPC maybe convert (formerly always converted)
LTXNUL: JUMPL K,(C) ;ignore null while processing CR
SKIPGE LISPJB ;skip if connected to lisp
JRST LTXCO3 ;null is always end for pty output
CAME D,JBREND ;end of string?
JRST LTXLUP ;no, ignore embedded null
;end of string. if continuation bit was on, go get more text,
;else terminate input by inserting CRLF if needed to finish off current line
;and then get out of loop
LTXCO3: MOVE T,LSPMBF+LMCMD ;get cmd flags
TLNE T,LSPCON ;is this a continued cmd?
JRST LTXCON ;yes, go get more stuff
LTXLUZ: JUMPN B,LTXNU2 ;jump if end occurred in middle of line
LTXDLY: PUSHJ P,ENDFIX ;close off expandable FS
SKIPE A,FAKEC2 ;is there an old replaced line to delete?
PUSHJ P,DELFAK ;yes, delete it
PUSHJ P,JEXIT(I) ;fix up various page parameters, marks, etc.
TRO F,DSPSCR ;force screen update
AOS (P) ;make us go back to CMDRD to update the display
SKIPN WINLIN ;if we flushed window line,
SETOM BOTWIN ;then force window fixup
TRNE ATTMOD ;in attach mode, we don't need to fix the arrow
POPJ P, ;attach mode, all done
MOVE A,JLCHG ;amount to move down by to maintain arrow line
SETOM OLDFAS ;don't remember the temporary arrow position
PUSHJ P,MOVARR ;put arrow on text line where it started
SKIPN A,UNPEND# ;do we need to reposition arrow back from page end?
POPJ P,
SETOM OLDFAS ;yes, don't remember end of page
JRST SETARR ;back to where we started all this
;Here to get another block of data of same command from Lisp.
;T already contains the old command type in the RH, for GETMAI.
LTXCON: PUSHJ P,GETMAI ;get another piece of mail from lisp
JRST LTXLUZ ;some sort of error, e.g., timed out
SKIPE A,MFBLK ;get old FS block, if any
PUSHJ P,FSGIVE ;return FS
PUSH P,B ;save some ACs
PUSH P,C
MOVE D,LSPMBF+LMCMD ;get the flags and cmd
PUSHJ P,RLSTRG ;read new string, set up byte ptr in D
SKIPA TT,[LTXCO2] ;got it
MOVEI TT,LTXCO3 ;null string, pretend end already again
POP P,C
POP P,B
JRST (TT)
LTXCO2: JRST -3(C) ;return back into some GETCH2 macro to get next char
;Subroutine called by RLSTRG to define and call a macro with Lisp's cmd text.
LCMAC3:
;; HRLI D,440700 ;make byte ptr
MOVEM D,MFBYTE
HLRE D,LSPMBF+LMBMA ;get negative byte count
MOVNM D,MFCNT ;save for LMCHAR
MOVE TT,['..LISP'] ;Default generated macro name
PUSHJ P,GENMCN ;Generate macro name not previously in use, probably
PUSHJ P,MACSET ;Set up expandable FS for macro def
PUSHJ P,GETDEF ;Generate macro definition
PUSHJ P,LMCHAR ;Instruction executed to get next char for def
JUMPL E,LCMACX ;Don't change any old def if no chars in new def
PUSHJ P,LCMFIN ;Finish off macro def, call the macro
JFCL ;Skips upon calling the macro
AOSA (P) ;skip to indicate must check for new macro call
LCMACX: PUSHJ P,ENDFIX ;close off expandable FS after null macro def
POPJ P,
LMCHAR: SOSGE MFCNT ;any chars left?
POPJ P, ;no, take eof return
ILDB C,MFBYTE ;get next char
JRST POPJ1 ;success return to GETDEF
;LSPSHT LSPCON LSPMAX LSBYSZ LSBYWD LSIBPT LMJOB LMCMD LMBMA LMTXT EQUALS EQUALX EQUAL2 EQUAL3 LLGETX LLGETY EQUALF EQUALE EQUALL LSPLIN LSPLUP LSPTAB LSPFF LSPNXT LSPDSP SNDLSP SNDLS2 SNDLER sndpty sndppc LLGET LLGET1 LLGET2 LLGET3 LLGETE
;command flags in left half of cmd word
LSPSHT←←1 ;flag indicating xfer is very short, fits in mail block
LSPCON←←2 ;flag meaning continuation of text transfer is needed (big xfer)
LSPMAX←←MLLEN-3 ;max number of words of text that will fit in mail block
LSBYSZ←←=9 ;9-bit bytes get sent to lisp
LSBYWD←←=36/LSBYSZ ;number of bytes per word (9-bit bytes)
LSIBPT←←440000+<LSBYSZ⊗6> ;left half of initial byte ptr for packing lisp text
;Words in mail block
LMJOB←←0 ;word for 'EPR',,sender's job number
LMCMD←←1 ;command word
LMBMA←←2 ;word where -byte count,,address goes
LMTXT←←3 ;word where short text starts
;⊗= cmd sends some text off to MACLSP for evaluation.
;Accepts arguments like ⊗XJUST cmds except no arg means one line if no att buffer.
EQUALS: JUMPE A,LLGET ;⊗0 arg means read line of text from user
SKIPN LISPJB ;skip if connected to any subjob
JRST EQUALE ;not talking to a subjob
SETZM ESCIEN ;no ESC I typed yet
PUSHJ P,XONON ;turn on XON if talking to pty, we'll supply LFs
MOVEI TT,LSPXPR
MOVEM TT,LSPMAI+LMCMD ;store mail type
TRNN F,ATTMOD ;In attach mode, arg means same as in justify cmds
TRO F,ARG ;Make no arg mean one line, unlike in justify
MOVEM A,JCNT ;pass arg to JSTART
MOVE I,ARRL ;get arrow line
PUSHJ P,JSTART ;open expandable FS, check arg and set up line count
MOVEM I,ARRLIS ;save original arrow line for restoring later
MOVE E,FSEND ;address of expandable FS
HRRZM E,LSPST2 ;remember for returning buffer to FS
ADD E,[LSIBPT,,LLDESC+1] ;make byte ptr for stuffing text, leave normal hdr
HRRZM E,LSPSTR ;store pointer to string for giving to lisp
MOVE B,JPTR ;pointer to first text line to copy
TRNN F,NEG ;negative arg means use lines before arrow
TRNN F,EDITM ;if from line editor, use line editor text first
CAIA ;not line editor, or negative arg
JRST EQUAL2 ;use line editor text
PUSHJ P,LSPLIN ;copy lines into buffer for LSP
EQUALX: PUSHJ P,LLGETX ;finish up FS and send block to Lisp
SOS (P) ;no skip means sent successfully, say OK
MOVE A,ARRLIS ;get back saved arrow line
PUSHJ P,JUDONX ;restore arrow to original line, if necessary
JRST POPJ1 ;don't say OK if LLGETX skipped (failure)
EQUAL2: MOVE A,[POINT 7,BUF] ;make byte pointer to line editor text
EQUAL3: ILDB C,A ;get a char
LEG IDPB C,E ;store char for lisp
CAIE C,15 ;end of line?
JRST EQUAL3
MOVEI C,12 ;end line with a LF, as usual
PUSHJ P,LSPNXT ;insert LF, process remainder of lines, if any
JRST EQUALX ;finish up
;Finish off an expanding FS block and send it to Lisp with cmd already in
;LSPMAI+LMCMD. Skips on FAILURE of some sort (timeout, etc.).
LLGETX: MOVNI T,1 ;count nulls
MOVEI C,0 ;fill out last word with nulls (at least one!)
IDPB C,E
TLNE E,770000 ;end of word yet? (9-bit bytes)
SOJA T,.-2 ;no, count a null used to fill
ADDI E,2 ;adjust past end of text and past FS trailer
MOVSI TT,LOKBIT ;must lock down this FS until we're done with it
FSFIX E,TT ;close off the FS buffer
MOVEI E,-1(E) ;back up to just past text
SUB E,LSPSTR ;calculate word count
IMULI E,LSBYWD ;make it byte count
ADD E,T ;uncount the nulls
MOVEM E,LSPLEN ;store byte count
PUSHJ P,ENDFIX ;close off expandable FS
PUSHJ P,LSPWCH ;make sure lisp has given initial OK
JRST LLGETY ;no OK yet, and user typed ESC I to abort
MOVEI C,LSBYWD ;number of bytes of text per word, arg for SNDLSP
PUSHJ P,SNDLSP ;send the buffer to lisp
LLGETY: AOS (P) ;timed out or some other error, don't say OK
AOS A,LSPST2 ;ptr to beginning of buffer
PUSHJ P,FSGIVE ;return the buffer to FS
POPJ P,
EQUALF: PUSHJ P,ENDFIX ;close off expandable FS
EQUALE: SORRY Not currently in communication with a subjob.
JRST POPJ1
EQUALL: SORRY Not currently in communication with a Lisp job.
JRST POPJ1
LSPLIN: SKIPN TXTCNT(B) ;non-ex line means this is end of page or page mark
JRST LSPFF ;must be page mark since we checked the line count
MOVE A,B ;copy ptr to current line
ADD A,[440700,,LLDESC] ;Make pointer to text of input line
HRRZ T,TXTCNT(B) ;See if this is an empty line
JUMPN T,.+2
HRLI A,350700 ;avoid seeing the fake space in this empty line
MOVSI H,LSPC!NSPEC ;special action on Null, rubout, CR,LF,ALT,TAB,FF
MOVEI DSP,LSPDSP ;dispatch table ptr
LSPLUP: ILDB C,A ;get char from line
TDNE H,CTAB(C) ;skip unless special
XCT @CTAB(C) ;Caution, return may be .-2, ., .+1
LEG IDPB C,E ;store plain char into buffer
JRST LSPLUP
;here when have seen tab in line being given to lisp.
LSPTAB: ILDB C,A ;get char from line
CAIN C,40
JRST LSPTAB ;ignore embedded spaces
POPJ P, ;spaces are followed by tab, insert it in buffer
;here when have reached pagemark
LSPFF: MOVEI C,14 ;a formfeed for the incore pagemark
;here when reached LF in text line
LSPNXT:
LEG IDPB C,E ;put in final char of line
HRRZ B,(B) ;advance ptr to next line (if any)
SOSLE JCNT ;any more lines to do?
JRST LSPLIN ;yes, do next one
POPJ P, ;no, return from LSPLIN
;Dispatch table used for accumulating text to be sent to subjob.
LSPDSP: PUSHJ P,TELL0 ;0 null NSPEC
PUSHJ P,TELL1 ;1 rubout NSPEC
JFCL ;2 CR LSPC
JRST LSPNXT ;3 LF LSPC
PUSHJ P,LSPTAB ;4 TAB LSPC
PUSHJ P,TELL5 ;5 FF LSPC
JFCL ;6 ALT LSPC now allow Altmodes in file (formerly TELL6)
;Send data to lisp job, skip on success.
;Call with LSPSTR pointing to beginning of data, LSPLEN containing byte length,
;and C containing the number of bytes per word. Clobbers A,B,T,TT.
;(For text being sent, note that the low-order bit
;of each word shipped is random, sometimes on, sometimes off.)
SNDLSP: MOVEI A,0 ;no flag bits for Lisp yet
MOVE T,LSPSTR ;ptr to current place in buffer
SKIPGE LISPJB ;skip unless connected to a pty
JRST SNDPTY ;aha, send text to our pty instead
HRRZM T,LSPMAI+LMBMA ;store starting address of text
SKIPG T,LSPLEN ;get length in bytes
JRST CPOPJ1 ;all done
ADDI T,-1(C) ;make word count round up
IDIVI T,(C) ;convert to word count
CAILE T,LSPMAX ;will it fit in mail block?
JRST SNDLS2 ;nope, Lisp will use jobrd
SETZM LSPMAI+LMTXT+1
MOVE TT,[LSPMAI+LMTXT+1,,LSPMAI+LMTXT+2]
BLT TT,LSPMAI+37 ;clear out mail block's text area
HRLZ TT,LSPSTR ;source of BLT is FS address
HRRI TT,LSPMAI+LMTXT ;dest is mail block
BLT TT,LSPMAI+LMTXT-1(T) ;move text to mail block
TLO A,LSPSHT ;indicate short text (in mail)
SNDLS2: CAILE T,2000 ;this is max amount Lisp can JOBRD at a time
TLOA A,LSPCON ;set continuation-necessary flag
TLZA A,LSPCON ;no continuation
MOVEI T,2000 ;use max allowable
ADDM T,LSPSTR ;make continuation address
MOVN T,T ;negative word count of text
IMULI T,(C) ;convert word count to byte count
ADDM T,LSPLEN ;adjust byte count to remaining amount
SKIPGE LSPLEN ;did count go negative?
SUB T,LSPLEN ;yes, then reduce byte count given to Lisp
HRLM T,LSPMAI+LMBMA ;store text byte length
HLLM A,LSPMAI+LMCMD ;store cmd and any flags
PUSHJ P,SNDMAI ;send mail to lisp
POPJ P, ;failed or timed out or something
;mail successfully sent to Lisp, maybe wait until Lisp has done JOBRD.
TLNE A,LSPSHT ;If short text, then all done (no JOBRD)
JRST SNDLSP ;just for good measure, get out standard way
MOVEI T,LSPDUN ;expected answer
PUSHJ P,GETMAI ;get required Lisp answer (jobrd done)
JRST SNDLER ;lost, abort the transfer (already said sorry)
JRST SNDLSP ;see if there is more to send
SNDLER: OUTSTR [ASCIZ /aborting transfer to Lisp: /]
SETZM TYOPNT ;force typeout
SKIPGE LSPLEN
SETZM LSPLEN ;don't give negative byte count
TYPDEC LSPLEN
OUTSTR [ASCIZ/ bytes not sent.
/]
POPJ P,
SNDPTY: HRRZM T,PTYNBR+1 ;store ptr to string for pty
SNDPPC: PTWRS9 PTYNBR ;stuff text into pty (TSNINT checks this PC)
JRST CPOPJ1 ;can't lose (although the pty job can hang
;if both the input and output buffers are full)
;Here to collect a line of text from user to send to Lisp. Everything up
;through the activator will be sent. Note that we read a line from the
;user before we check to see if a subjob exists, so that the syntax of
;the cmd is always the same, to avoid confusing the user who may have
;typed the lisp/pty line ahead.
LLGET: SKIPE DPY
PUSHJ P,CMDCRL ;Put out CRLF if line long on display
PUSHJ P,LOADM0 ;Make sure ALLACT is ignored in line editor.
OUTSTR [ASCIZ/ Subjob line: /]
PUSHJ P,DISP
XCT LINTST
SETZM ESCIEN ;no ESC I typed yet
PUSHJ P,XONOFF ;turn off XON if talking to pty, for LF insertion
MOVEI I,0 ;let altmode abort
SETOM LINFLG ;read tty in line mode
LLGET1: PUSHJ P,ENDSET ;set up expandable FS
MOVEI T,LSPXPR
MOVEM T,LSPMAI+LMCMD ;store SEXPR mail cmd for lisp
MOVE E,FSEND
MOVEM E,LSPST2 ;remember for freeing FS
ADD E,[LSIBPT,,1] ;make byte ptr for storing cmd text for lisp
HRRZM E,LSPSTR ;save FS address for SNDLSP
LLGET2: PUSHJ P,GTYI ;Loop collecting typein (char mode or line mode)
JRST LLGET3 ;activator ends it
LEG IDPB C,E ;put char into FS block
JRST LLGET2
LLGET3:
LEG IDPB C,E ;stick in activator (maybe CR, but no following LF)
HRRI I,(C) ;special hack to return the activator for EVAL
ANDI C,177 ;flush bucky bits
TLZE I,-1 ;altmode supposed to abort? (skip if so)
JRST LLGETE ;no altmode check, from Eval, check for αβ<lf>
SKIPN LISPJB ;any lisp job or pty?
JRST EQUALF ;nope, nowhere to send this line to!
CAIE C,ALTMOD ;altmode?
JRST LLGETX ;no, finish up FS and send it to lisp (maybe wait)
PUSHJ P,ENDFIX ;yes, close off FS without using any
JRST MACABT ;say aborted
;Here if called from Eval. Different special activator to check for: EOF.
LLGETE: CAIN I,612 ;αβ<lf>?
ADD E,[LSBYSZ⊗=30] ;yes, back up byte ptr to avoid sending the αβ<lf>
JRST LLGETX ;send the line, w/ or w/o activator
;LINTER LINTE3 LINTE2 EVAL EVALUP EVALXT REEVAL
;Here to send interrupt to lisp
LINTER: SKIPGE LISPJB ;skip unless talking to pty
JRST LINPTY ;interrupt pty with ESC I
SKIPG LISPJB ;skip if talking to lisp
JRST EQUALE ;not talking to a lisp job
PUSHJ P,XTDBEG ;set up extended cmd line to read and get first char
JRST LINTE2
LINTE3: MOVEM C,LSPMAI+LMBMA ;pass the char (possibly 9-bit activator) to lisp
SETZM TYIPNT ;ignore rest of cmd line
PUSHJ P,LSPWCH ;make sure lisp has given initial OK
JRST POPJ1 ;not OK yet, and user typed ESC I to abort
MOVEI TT,LSPINT
MOVEM TT,LSPMAI+LMCMD ;set interrupt cmd type in mail block
PUSHJ P,SNDMAI ;send the mail to lisp
AOS (P) ;failed somehow (timed out or esc i typed), no OK
POPJ P,
LINTE2: CAIE C," " ;ignore leading spaces and tabs of cmd line
CAIN C,11
PUSHJ P,TYI ;get next char of cmd line
JRST LINTE3
JRST LINTE2
LINPTY: HRLZ T,PTYNBR ;get ptr number
TLO T,404000 ;make it absolute tty, and ESC cmd
TRO T,"I" ;make is ESC I
HRROI TT,T ;one cmd, in T
TTYSET TT, ;hit pty with ESC I
POPJ P,
;Here to go into special state whereby everything typed is passed to lisp,
;until the user types αβ<lf>.
EVAL: SKIPN LISPJB ;talking to lisp or pty?
JRST EQUALE ;nope, you lose
SETOM LINFLG# ;assume want line mode input in CMRTR2
CAIN B,CTMT3 ;double bucky?
SETZM LINFLG ;yes, use char mode input
SETOM LINFL2 ;let ESC I change input mode
SETZM ESCIEN ;no ESC I typed yet
PUSHJ P,XONOFF ;turn off XON if talking to pty, for LF insertion
;; PUSHJ P,EXONON ;set our XON to suppress inserted LF echoing
TRZ F,ARG!REL!NEG ;clear flags for CMRTR2
MOVSI TT," E"⊗4
HLLM TT,EMFLG ;Flag to user that we're in lisp EVAL mode
SETOM NEEDHD ;set flag to make HEADS think about hdr line
SETACT [[-1↔-1↔-1↔-1,,600000!BSACT!SUPLFE]] ;enable αCR, disable LF echo, undo ALLACT, EMODE, etc.
SKIPGE EECHFG ;skip unless user wants eval echo suppressed
PTJOBX [0↔3] ;disable echo of typein to E
PUSHJ P,LOADMT ;Fix up typeahead
CAIA ;not macro
JRST EVALUP ;in macro, don't type prompt
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Type lines to Subjob /]
MOVE T,LISPJB
PUSHJ P,RECONT ;print subjob name
OUTCHR [","]
PUSHJ P,CTMTLF ;tell what to end with (αβ<lf>)
EVALUP: PUSHJ P,CMRTR2 ;get a char in line mode, check for lisp mail
CAIN C,612 ;αβ<lf>?
JRST EVALXT ;yes, get out of here
HRLI C,(<MOVEI C,>) ;make instruction to regenerate this char
MOVEM C,TYIINS ;so that LLGET1 will see this char first
MOVEI TT,1 ;make nonzero byte ptr that will
MOVEM TT,TYIPNT ; return 0 upon being ILDB'd
MOVSI I,-1 ;don't let altmode abort, suppress final αβ<lf>
PUSHJ P,LLGET1 ;get a line from the user and send it to lisp
JFCL ;skips on error
CAIE I,612 ;time to get out?
JRST EVALUP ;no
EVALXT: HRRZS EMFLG ;Flag to user that we're out of lisp EVAL mode
SETOM NEEDHD ;set flag to make HEADS think about hdr line
PTJOBX [0↔4] ;restore normal echo of typein to E
;; PUSHJ P,EXONOF ;clear our xon bit
JRST SEMODE ;get out of here, restore ALLACT, etc.
;Cmd routine to interpret text from the screen, in E macro format, and
;send it to Lisp as 9-bit command text.
REEVAL: SKIPN LISPJB ;connected to lisp or pty?
JRST EQUALE ;nope, error
SETZM ESCIEN ;no ESC I typed yet to abort Lisp output
PUSHJ P,XONOFF ;turn off XON if talking to pty, for LF insertion
PUSH P,A ;Preserve numeric arg
PUSHJ P,ENDSET ;Set up expandable FS for collecting 9-bit text
POP P,A ;PGCONV will use this arg
MOVE E,FSEND ;Get starting address of our macro FS block
MOVEM E,LSPST2 ;remember for returning FS
ADD E,[441100,,1] ;Make byte pointer for depositing text
HRRZM E,LSPSTR ;remember start address of text to give to lisp
MOVE TT,TOPWIN ;save window position for later restoration
MOVEM TT,TOPWIS ;put is where JUDONX via EQUALX will see it
TRNN F,ATTMOD ;In attach mode, no arg defaults to whole page
TRO F,ARG ;otherwise, make no arg means use only one line
PUSHJ P,XTDLMT ;skip over cmd name delimiter
PUSHJ P,XTDLIN ;set up to reread cmd line
PUSHJ P,PGCONV ;convert page/attach text into 9-bit string
JRST REDERR ;error occurred -- no text or bad escape seq
MOVEI TT,LSPXPR
MOVEM TT,LSPMAI+LMCMD ;store mail type
JRST EQUALX ;finish off by sending the data to lisp, fixing FS
;⊗ JOBNAM PRJPRG NSUBJ OLDJOB JOBMAX JOBDBL SUCONN SUWARN SUBSAV SUBSA2 SUBSA9 SUBSA0 SUBSAD SUBSA4 SUBSA5 SUBSA6 RECONN RECON2 RECONK RECONX RECON7 RECON8 RECON3 RECON4 RECON5 RECO5L RECONT RECOP2 RECONP LSPJCK LSPJCL LSPJC2 LSPWRN LSPWRC LSPWRJ JOBCHK SUBKIL SUBKI0 SUBKI2 SUBKI PTDETC SUBDET SUBDE0 SUBDE2 SUBDE3 REEDET REEDEL REEDEX REEDE0 REEDE1
JOBNAM←←225 ;WAITS lowcore location pointing to job name table
PRJPRG←←211 ;WAITS lowcore location pointing to job table of PPNs
NSUBJ←←4 ;Max number of subjobs we'll remember, not counting current one
IMPURE
;;In OLDJOB and LISPJB, a positive number is a Lisp subjob's job number and
;;a negative number is a PTY subjob's negated PTY line number.
OLDJOB: BLOCK NSUBJ ;stack for remembered old subjobs, oldest last
JOBMAX: 0 ;number of entries currently in OLDJOB
JOBDBL: 2 ;default arg for αβ version of reconnecting command
PURE
;Here to tell about new subjob
SUCONN: SKIPA TT,[[ASCIZ/ Connecting /]]
;Here to see if we're about to disconnect a lisp or pty job when starting
;up another (or reconnecting to an old one).
SUWARN: MOVEI TT,[ASCIZ/ Disconnecting /]
SKIPL BLAB ;suppress msg in Terse mode
SKIPN T,LISPJB ;any old subjob?
POPJ P, ;nope, nothing to worry about
OUTSTR (TT)
PUSHJ P,RECONT ;tell subjob name
OUTSTR [ASCIZ/. /]
POPJ P,
;Routine to update stack of subjobs we've had recently. Clobbers A,T,TT.
;Called with number of new subjob in A (goes into LISPJB), which is
;either a positive Lisp job number or a negative PTY line number.
;This routine makes sure that no two remembered subjobs are the same.
;Routine always skips; but if changing subjob number, it executes the
;instruction following the call, while interrupts are off.
SUBSAV: CAMN A,LISPJB ;is new subjob same as old one?
JRST SUBSA9 ;yes, nothing to do
PUSHJ P,SUWARN ;tell if disconnecting old subjob
PJOB TT,
HRLI TT,'EPR' ;stick in protocol name
MOVEM TT,LSPMAI ;store our job number in mail block, for lisp
MOVSI TT,INTBTS ;clear all funny int bits
INTACM TT, ;off with the bad bits
XCT @(P) ;set or clear INTWAI while ints are off
AOS (P) ;skip return over the XCT'd instr
SETZM LMBUSY# ;forget about any old stuff waiting to be processed
PUSHJ P,LCNCLR ;forget about old stuff half processed
SETZM NOSUBO# ;don't hold up subjob output
MOVSI TT,INTPTY ;assume connecting to pty
SKIPLE A
MOVSI TT,INTLSP ;connecting to lisp, different interrupts
EXCH A,LISPJB# ;set new job number, get old
INTORM TT, ;enable needed interrupts
PUSHJ P,SOMODS ;set hdr to display subjob output mode
AOSE NOCONN ;skip if don't want to tell about new connection
PUSHJ P,SUCONN ;tell about new job
JUMPE A,SUBSA0 ;If no old subjob, just flush new one from stack
MOVSI T,-NSUBJ ;AOBJN ptr to list of places we've been
SKIPA TT,A ;remember subjob being disconnected
SUBSA2: CAME A,TT ;is this the subjob just disconnected?
CAMN A,LISPJB ;is this the subjob we're connecting?
JUMPN A,CPOPJ ;Yes to one, don't remember any subjob twice
EXCH A,OLDJOB(T) ;Remember new place and pick up older place
SKIPE OLDJOB(T) ;Did we just move the end marker in the list?
AOBJN T,SUBSA2 ;No, continue through list unless done
HRRZM T,JOBMAX ;Store number of valid entries in list
POPJ P,
SUBSA9: OUTSTR [ASCIZ / Already connected to /]
MOVE T,LISPJB
PUSHJ P,RECONT ;type subjob name
OUTCHR [" "]
JRST POPJ1
;Here to flush stack entry, if any, for subjob we're going to, in LISPJB.
SUBSA0: SKIPN OLDJOB ;Skip if nothing in stack at all
POPJ P, ;Don't bother with subjob stack
SUBSAD: MOVN T,JOBMAX ;Get size of stack
MOVSI T,(T) ;Make aobjn ptr
SUBSA4: MOVE TT,OLDJOB(T) ;Get index of some subjob on stack
CAMN TT,LISPJB ;Is that the subjob we're going to?
JRST SUBSA6 ;Yes, flush from stack
AOBJN T,SUBSA4 ;Look through stack
POPJ P, ;subjob we're going to wasn't in the stack
SUBSA5: MOVE TT,OLDJOB(T)
MOVEM TT,OLDJOB-1(T) ;Squeeze entry out of middle of stack
SUBSA6: AOBJN T,SUBSA5
SOS T,JOBMAX ;One less entry in stack
SETZM OLDJOB(T) ;Mark end of stack with a zero
POPJ P,
;⊗XRECONNECT command -- same significance of arg as ⊗N and ⊗O and ⊗H cmds
;Connects to selected old subjob from the subjob stack.
RECONN: JUMPE A,RECON4 ;Zero arg means tell current default for αβ command
MOVM C,A ;Get positive index of desired old subjob
TRNE F,REL ;Relative arg?
JRST RECON7 ;Yes, wants to diddle subjob stack
CAIE B,CTMT3 ;αβ command?
JRST RECON2 ;No
TRNE F,ARG ;Yes, any arg?
MOVMM C,JOBDBL ;Arg given with αβ means set default for αβ
MOVM C,JOBDBL ;Get default for αβ command
RECON2: SKIPN OLDJOB ;Any remembered places at all?
JRST RECON3 ;No (check here to allow storing default for αβ)
RECONK: CAMLE C,JOBMAX ;Range check index
MOVE C,JOBMAX ;Out of range -- get index of oldest job
MOVE A,OLDJOB-1(C) ;Get subjob to reconnect to
RECONX: JUMPG A,SLISPJ ;connect to lisp job
MOVM A,A ;positive pty line number
JRST SUJOBJ ;connect to pty job
;Here to rotate subjob stack by a positive or negative amt.
RECON7: SKIPN OLDJOB ;Is there really any place remembered?
JRST RECON3 ;No, forget it
MOVE TT,JOBMAX ;Arg for NOHSTK -- size of stack
CAILE C,(TT) ;Want to diddle stack by more than its size?
JRST NOHSOV ;Yes, that's silly
PUSHJ P,SUWARN ;Tell which job we're disconnecting
SKIPE LISPJB ;is there a current subjob?
JRST RECON8 ;yes, nothing to worry about
MOVE T,OLDJOB ;no, get top subjob in stack
MOVEM T,LISPJB ;make it current subjob temporarily, for NOHSTK to work on
PUSHJ P,SUBSAD ;flush same job from stack
JUMPGE A,RECON8 ;if arg is +n, don't need to adjust it
ADDI A,1 ;arg is -n, make it -(n-1) after we've now popped stack by 1
RECON8: MOVE TT,JOBMAX ;get back stack size (TT clobbered by SUWARN)
HRLI TT,OLDJOB ;Arg for NOHSTK -- stack's starting address
MOVE T,LISPJB ;Another arg -- current place
PUSHJ P,NOHSTK ;Rotate subjob stack by (A)
SETZM LISPJB ;we've already fixed stack, avoid more diddling at SUBSAV
HRRZS SOMOD ;clear display in case this leaves no subjob connected
SETOM NEEDHD ;set flag to make HEADS think about hdr line
JRST RECONX ;select this subjob
RECON3: SORRY No old subjob to return to.
JRST POPJ1
RECON4: CAIE B,CTMT3 ;αβ command?
JRST RECON5 ;No, type out subjob stack
MOVEI A,[ASCIZ /XRECONNECT/] ;Command to type out
MOVE B,JOBDBL ;Current default for αβ command
JRST NOHDEF
RECON5: SETZM TYOPNT
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Subjob stack: (0)/]
SKIPN T,LISPJB
OUTSTR [ASCIZ/(no job) /]
SKIPE T,LISPJB
PUSHJ P,RECONT ;type subjob name
SKIPN OLDJOB ;Any other subjobs?
JRST PPJ1CR ;No
MOVN E,JOBMAX ;Size of subjob stack
MOVSI E,(E) ;Make aobjn ptr
RECO5L: OUTSTR [ASCIZ/ (/]
MOVEI D,1(E) ;Get level of stack position
TYPDEC D ;Type level
OUTCHR [")"]
MOVE T,OLDJOB(E) ;Get subjob from stack
PUSHJ P,RECONT ;Type subjob name
AOBJN E,RECO5L ;Loop through whole subjob stack
JRST PPJ1CR
;Type name of subjob indicated by T.
;And, if PTY, types line number; if Lisp subjob, type job number.
RECONT: SETZM TYOPNT ;force typeout
JUMPL T,RECONP ;jump if PTY line number in T.
TYPDEC T ;type job number
RECOP2: OUTCHR [":"]
MOVEI TT,JOBNAM ;low core ptr to job name table
PEEK TT, ;get ptr to table
ADDI TT,(T)
PEEK TT, ;get job name
TYPSIX TT ;type sixbit name
POPJ P,
RECONP: MOVN T,T ;make it positive pty line number
OUTSTR [ASCIZ/PTY/]
TYPOCT T ;type line number
TTYJOB T, ;get number of job logged in
JUMPN T,RECOP2 ;jump if any job there
OUTSTR [ASCIZ/(not logged in)/]
POPJ P,
;Routine to check for lisp jobs and do PUSHJ P,(B) for each such job,
;with lisp job number in T. Clobbers T and TT, plus whatever (B) does.
;Routine dispatched to, (B), must preserve TT.
LSPJCK: SKIPG TT,JOBMAX ;Look thru subjob stack for lisp jobs
JRST LSPJC2 ;no stack, check current subjob
LSPJCL: SKIPLE T,OLDJOB-1(TT) ;lisp job here?
PUSHJ P,(B) ;output lisp job number
SOJG TT,LSPJCL ;loop back thru stack
LSPJC2: SKIPLE T,LISPJB ;is there a current lisp subjob?
PUSHJ P,(B) ;output lisp job number or whatever
POPJ P,
;warn of any detached subjobs, here from BYE and from before swap at RUN1, etc.
LSPWRN: PUSH P,A
PUSH P,B
SETZB A,TYOPNT ;no jobs seen yet, force typeout
MOVEI B,LSPWRJ ;routine to handle each lisp job
PUSHJ P,LSPJCK ;Call routine in B for each lisp job
SKIPE TT,A ;pass flag up, so that someone can type CRLF
OUTCHR [")"] ;some jobs were typed, end with right paren
JRST POPBAJ
LSPWRC: PUSHJ P,LSPWRN ;type lisp subjobs
SKIPE TT ;skip if none typed
OUTSTR [ASCIZ/
/] ;end the line nicely
POPJ P,
;Routine to be called from LSPJCK for each lisp job
LSPWRJ: TRON A,1 ;flag a job seen
OUTSTR [ASCIZ/
(You still have detached subjob(s):/]
OUTCHR [" "]
PUSH P,TT ;can't clobber TT!
PUSHJ P,RECONT ;type lisp job name and number
POP P,TT
POPJ P,
;Skip return if job whose number is in A exists with same PPN as ours.
JOBCHK: MOVEI TT,JOBN1 ;see if job number is in range
PEEK TT, ;get max job number
CAILE A,(TT) ;skip if OK
POPJ P, ;bad job nbr, can't be real job
MOVE TT,A ;copy job number
JBTSTS TT, ;see if job is logged in
TLNN TT,JNA ;skip if really a job there
POPJ P, ;non ex job
MOVEI TT,PRJPRG ;low core ptr location
PEEK TT, ;get ptr to PPN job table
ADD TT,A ;job nbr plus table ptr = job PPN ptr
PEEK TT, ;logged in PPN of given job
CAMN TT,RPPN ;match ours?
AOS (P) ;yes, success
POPJ P,
;Command routine to kill all subjobs.
SUBKIL: TRNE F,ARG!REL
JRST SUBKI ;any arg disables this command
SUBKI0: SKIPN T,LISPJB ;any connected subjob?
JRST SUBKI2 ;nope, check stack
PUSHJ P,RECONT ;name the job we're killing, from T
OUTCHR [" "]
SKIPGE LISPJB ;skip if not pty
PUSHJ P,SUJOBK ;kill PTY job
SKIPLE LISPJB ;skip if not lisp
PUSHJ P,SLISPX ;kill lisp job (skips on error)
JFCL ;OK
SUBKI2: SKIPN OLDJOB ;any jobs on stack?
POPJ P, ;nope
MOVEI C,1 ;reconnect to first job in stack
SETOM NOCONN ;avoid typing connection notice in SUBSAV
PUSHJ P,RECONK ;reconnect to previous job
JFCL ;usually (maybe always) skips
SETZM NOCONN# ;don't suppress further connection notices
JRST SUBKI0 ;and loop to kill it
SUBKI: SORRY Cannot abbreviate SUBKIL and cannot give any argument.
JRST POPJ1
PTDETC←←10 ;PTJOBX function to detach a PTY.
SUBDET: SKIPL LISPJB ;connected to a PTY job?
JRST EQUALE ;nope, nothing we can do
PUSHJ P,SUBDE0 ;do the detach
JRST SUJOBK ;release and forget about the PTY
;subroutine to actually detach the current pty subjob. pty number in PTYNBR.
SUBDE0: MOVEI T,PTDETC ;command to detach PTY's job
MOVEM T,PTYNBR+1 ;set up function
SUBDE2: MOVEI T,0 ;amount of waiting to do afterwards if won
PTJOBX PTYNBR ;detach subjob from PTY
MOVEI T,1 ;lost, wait a second and retry
SUBDE3: SLEEP T, ;make sure it gets detached OK
JUMPN T,SUBDE2 ;jump back and try again if we lost
HRRZ TT,PTYNBR ;get PTY number
TTYJOB TT, ;see if any job attached to PTY
JUMPG TT,SUBDE3 ;if so, wait more for forced detach to occur
POPJ P,
;Here to detach all PTY subjobs when user gives REENTER cmd to save his text.
REEDET: SETOM REEPFG# ;note no pty subjobs found yet
PUSH P,BLAB ;remember state
SETOM BLAB ;suppress disconnecting/connecting msgs easy way
SKIPGE T,LISPJB ;skip unless pty subjob connected
PUSHJ P,REEDE1 ;type subjob name and detach job
SKIPN OLDJOB ;Any other subjobs?
JRST REEDEX ;No
MOVN E,JOBMAX ;Size of subjob stack
MOVSI E,(E) ;Make aobjn ptr
REEDEL: SKIPGE A,OLDJOB(E) ;Get subjob from stack, skip if not pty
PUSHJ P,REEDE0 ;connect pty, type subjob name and detach job
AOBJN E,REEDEL ;Loop through whole subjob stack
REEDEX: SKIPL REEPFG ;did we detach any pty subjobs?
OUTSTR [ASCIZ/
/]
POP P,BLAB ;restore state
POPJ P,
;subroutine for above code. here we connect to PTY subjobs, list and detach them.
;who knows what this does to the subjob stack, so you should call this only
;when E is abandoning things in a REENTER command.
REEDE0: MOVM A,A ;positive job number
MOVE D,A ;save it
PUSHJ P,SUJOB3 ;connect to this pty job (sets line number in PTYNBR)
SKIPA T,A ;connected, get back job number
POPJ P, ;lost, oh well, we tried
REEDE1: AOSN REEPFG ;this first one?
OUTSTR [ASCIZ/
Detaching your PTY subjob(s): /] ;yes
PUSHJ P,RECONT ;type subjob name (from PTY line number in T)
OUTSTR [ASCIZ / /] ;separate multiple job names
JRST SUBDE0 ;detach the job from PTY
;Would-be Per-open-file data (whole page).
Comment %
For now, all this stuff has been duplicated in the per-window data area, thus
making it illegal to have more than one window per instance of a file.
THIS WHOLE PAGE IS COMMENTED OUT!
;FILDAT←←. ;beginning of per-open-file data area: this copy for current window
;
;ZDIR: 0 ;for zeroing stuff below in BLT through EDIR
;
;;Former variables, now duplicated per open-file
;DIRPAG: 0
;FILWC: 0
;FILLEN: 0
;IBLK: 0
;OBLK: 0
;DIROVH: 0
;DIRSIZ: 0
;ODSIZ: 0
;NODUPD: 0
;WRTPRO: 0 ;Zero unless file is write protected from us
;
;DIR: BLOCK LPDESC
;DIREND: BLOCK LPDESC
;
;EDIR←←.-1 ;end of block zeroed at INIT
;
; 0 ;For /F mode line count.
; 0 ;For device name.
;EDFIL: BLOCK 6
;
;NMARKS←←27 ;Maximum number of marks per file
;MARKS: BLOCK NMARKS
; 0 ;Table stop
; -1 ;Sure stop
;
;;page stack
;;The next three must be contiguous with BAKPLC first (for BEG1A).
;BAKPLC: BLOCK NBACK ;line,,page of recently visited pages (oldest last)
;BAKWIN: BLOCK NBACK ;window setting on recently visited pages
;BAKMAX: 0 ;current number of valid entries in BAKPLC/WIN
;BAKDBL: 2 ;number of pages back we go on αβO command
;
;LFILDT←←.-FILDAT ;length of data block duplicated per open-file (in FS)
THIS WHOLE PAGE IS COMMENTED OUT!
end of comment %
;End of per-open-file data (whole page).
;⊗ WINDAT ZWIN WINSER WINFGS SCRBOT NEEDHD DLINES DARRL DCURPG DPAGES DBLOAT DROOM OLINES OCHRS XPAGES XCHRS XPLST XPLSTE EDLINE EDSER EDCNM2 BKPSW BOOKSW DIRP1 CHARS DIRPT RELPGN ROOM PAGE WINMAX DPLST LSTARR LSTPAG NLINEU NLINER SCRSIZ ARRLIN HEDBLK TRLBLK BOTWIN OFFSET WINLIN SLNSTP SPGSTP TOPWI2 DIRPAG FILWC FILLEN IBLK OBLK DIROVH DIRSIZ EDIRSZ ODSIZ NODUPD XDIRFG WRTPRO DELFIL DELFI2 DELFI3 DIR DIREND EWIN ARRON EDFIL MARKS BAKPLC BAKWIN BAKMAX BAKDBL SCRTOP LPTRTB ARRL TOPWIN LINES LPTRT2 DPTRTB CURPAG FIRPAG PAGES DPTRT2 TOPSTR HED3PG HEDPAG HED5PG HEDNAM ROFLG AFLAG WFLAG UIFLG EMFLG HWFLG SOMOD LTPSTR TOPDSH HEDLIN HED4PG HED2PG HED6PG HED2NM ROFLG2 AFLAG2 WFLAG2 UIFLG2 EMFLG2 HWFLG2 SOMOD2 LTPDSH BOTSTR BOTLX BOTARR BOTARO BOTLN5 BOTPG2 BOTPGO BOTPG3 RFLAG3 WFLAG3 LBTSTR BOTDSH BOTLX2 BOTAR2 BOTLN4 BOTPG4 BOTPG5 RFLAG4 WFLAG4 LBTDSH NEARBY NOLD OLDPLC OLDMAX OLDDBL ZINDEX WINNBR DQINFB WRTTEN WRTJOB WRTPPN WRTFI1 WRTFI2 WRTPPN WRTFI1 WRTFI2 LWINDT
IMPURE
;Per-window data (whole page).
WINDAT←←. ;beginning of per-window data defs: this copy for current window
ZWIN: 0 ;for zeroing below data in BLT through EWIN, at INIT and CREWIN
;the ZWIN word in the FS blocks is used for the list link word
WINSER: 0 ;serial number of window, used as IOPUSH ID
WINFGS: 0 ;flags from F saved here in FS copy, some to be restored later
SCRBOT: 0 ;screen line number of line after last possible line for text
NEEDHD: 0 ;-1 if need to think about recomputing header's text
;Former variables, now duplicated per window.
;;;Lines marked with *'s indicate FS pointers that need back links fixed
;;;when this window is retired (made not the current window).
DLINES: 0 ;in TRAILS, number of lines last reported on trailer line
DARRL: 0 ;in TRAILS, number of arrow line last reported on trailer line
DCURPG: 0 ;in TRAILS, number of current page last reported on trailer line
DPAGES: 0 ;in TRAILS, number of pages last reported on trailer line
DBLOAT: 0 ;in TRAILS, number of excess/short records last reported
DROOM: 0 ;in TRAILS, number of excess/short characters last reported
OLINES: 0 ;old number of lines on page
OCHRS: 0 ;old number of chars
XPAGES: 0 ;number of extra pages in core
XCHRS: 0 ;number of chars plus record-filling nulls on non-final incore pages
XPLST: 0 ;*header of list of extra pages in core, points to PMLINK word
XPLSTE: 0 ;*trailer of list of extra pages
EDLINE: 0 ;incore line number of last line edited, for αβS
EDSER: 0 ;serial number of last line edited
EDCNM2: 0 ;character position within line of last line edited
BKPSW: 0 ;nonzero if we were started by BOOK cmd to use .BKP file
BOOKSW: 0 ;nonzero iff book mode (/B)
DIRP1: 0 ;*pointer to directory entry for first page in core
CHARS: 0 ;number of chars in core, counting padding nulls in non-final pages
DIRPT: 0 ;*pointer to directory entry for last page in core
RELPGN: 0 ;last relative page number assigned to a page currently in core
ROOM: 0 ;amount of unused room on disk for incore text, in characters
PAGE: 0 ;*header of list of incore text lines
WINMAX: 0 ;number of highest numbered incore line that can be first in window
DPLST: 0 ;*header/trailer for list of deleted incore pagemarks
LSTARR: 0 ;last arrow line typed out (non dpy)
LSTPAG: 0 ;page of last arrow line typed out (non dpy)
NLINEU: 0 ;nbr of text lines in window, or 0 for max, as requested by user
NLINER: 0 ;real number of text lines in window
SCRSIZ: 0 ;size of window display in lines from header through trailer line
ARRLIN: 0 ;*ptr to arrow line's FS block
HEDBLK: 0 ;set by SETWIN to point to proper header line's block (not FS)
TRLBLK: 0 ;set by SETWIN to point to proper trailer line's block (not FS)
BOTWIN: 0 ;one greater than number of last text line displayed in window
OFFSET: 0 ;amt to add to ARRL to get OLDARR which is screen line of arrow
WINLIN: 0 ;*pointer to FS block of first text line displayed in window
SLNSTP: 0 ;line number to stop incore searches at
SPGSTP: 0 ;page number to stop extended searches at
TOPWI2: 0 ;line number last displayed in hdr
;Former variables, now duplicated per open-file
DIRPAG: 0
FILWC: 0
FILLEN: 0
IBLK: 0
OBLK: 0
DIROVH: 0
DIRSIZ: 0 ;size of directory in text characters, not counting padding nulls
EDIRSZ: 0 ;size of text in extended part of directory (needing updating)
ODSIZ: 0
NODUPD: 0 ;LH is -1 if suppressing dir updates, RH -1 if dir needs updating
XDIRFG: 0 ;-nbr of records added to file,,last old page nbr-1
WRTPRO: 0 ;Zero unless file is write protected from us
DELFIL: 0 ;nonzero iff file is to be deleted as result of ⊗∂αβD cmd
DELFI2: 0 ;nonzero iff file is to be deleted for ⊗XFileDelete cmd
DELFI3: 0 ;nonzero iff user said ⊗XFileDelete/Q (ignored if DELFI2 not on)
DIR: BLOCK LPDESC
DIREND: BLOCK LPDESC
EWIN←←.-1 ;end of ZWIN block zeroed in WININI (window init)
ARRON: 0 ;ascii form of current arrow character
0 ;For /F mode line count.
0 ;For device name.
EDFIL: BLOCK 6
MARKS: BLOCK NMARKS
0 ;Table stop
-1 ;Sure stop
;page stack
;The next three must be contiguous with BAKPLC first (for BEG1A).
BAKPLC: BLOCK NBACK ;line,,page of recently visited pages (oldest last)
BAKWIN: BLOCK NBACK ;window setting on recently visited pages
BAKMAX: 0 ;current number of valid entries in BAKPLC/WIN
BAKDBL: 2 ;number of pages back we go on αβO command
SCRTOP: SCRTPD ;Line number on screen of header line (top line of screen is 0)
LPTRTB←←.
ARRL: 0
TOPWIN: 0 ;incore line number of first text line displayed in window
1
LINES: 0
LPTRTB-.,,
LPTRT2: HRRZ T,ARRLIN
HRRZ T,WINLIN
HRRZ T,PAGE
HLRZ T,BOTSTR
DPTRTB←←.
CURPAG: 0 ;Number of last in-core page (usually same as FIRPAG)
FIRPAG: 0 ;Number of first in-core page
1
PAGES: 0 ;Number of last page in the file
DPTRTB-.,,
DPTRT2: HRRZ T,DIRPT
HRRZ T,DIRP1
HRRZ T,DIR
HLRZ T,DIREND
LTPSTR+2
TOPSTR: BLOCK LLDESC
ASCID/******* PAGE/
HED3PG: ASCID/ / ;HOLDS " " OR "S "
HEDPAG: BLOCK 1 ;FIRPAG goes here
HED5PG: 1 ;In multipage mode, ":" stored here
1 ;In multipage mode, CURPAG goes here
HEDNAM: BLOCK 7
ROFLG: BLOCK 1 ;this cell must follow HEDNAM -- see SETHED
AFLAG: 1 ;Holds /-A when autoburping is disabled
ASCID/ ******* /
WFLAG: BLOCK 1 ;holds "W" or 1
UIFLG: 1 ;May hold " U" in LH and/or " I" or " A" in RH
EMFLG: 1 ;May hold " M" or " E" or " R" in LH and/or " V" in RH
HWFLG: 1 ;holds " HmWn" for m hidden windows with n W flags on
SOMOD: 1 ;subjob output mode (t: type, a: attach, p:pend, f:file)
ASCID/
/
LTPSTR←←.-TOPSTR
LTPDSH+2
TOPDSH: BLOCK LLDESC
ASCID/....Line /
HEDLIN: BLOCK 1
ASCID/....PAGE/
HED4PG: ASCID/ / ;HOLDS " " OR "S "
HED2PG: BLOCK 1
HED6PG: 1
1
HED2NM: BLOCK 7
ROFLG2: BLOCK 1
AFLAG2: 1 ;Holds /-A when autoburping is disabled
ASCID/..../
WFLAG2: BLOCK 1
UIFLG2: 1 ;U: dir needs updating, I: insert mode, A: attach mode
EMFLG2: 1 ;M: defining a macro, E: in EVAL loop, R: redefine or reeval cmd, V: no display updating
HWFLG2: 1 ;holds " HmWn" for m hidden windows with n W flags on
SOMOD2: 1 ;subjob text output mode (t: type, a: attach, p:pend, f:file)
ASCID/
/
LTPDSH←←.-TOPDSH
LBTSTR+2
BOTSTR: .
BLOCK LLDESC-1
ASCID/***** Arrow at Line /
BOTLX←←=20 ;Number of text chars in above string, for DM incremental prog
BOTARR: BLOCK 1
BOTARO: ASCID/ of /
BOTLN5: BLOCK 1
ASCID/ ***** Page /
BOTPG2: BLOCK 1
BOTPGO: ASCID/ of /
BOTPG3: BLOCK 1
ASCID/ ***** /
RFLAG3: 1 ;To contain Record values
WFLAG3: 1 ;To contain B and X values
ASCID/ *****
/
LBTSTR←←.-BOTSTR
LBTDSH+2
BOTDSH: BLOCK LLDESC
ASCID/.....Arrow at Line /
BOTLX2←←=19 ;Number of text chars in above string, for DM incremental prog
BOTAR2: BLOCK 1
ASCID/ of /
BOTLN4: BLOCK 1
ASCID/.....Page /
BOTPG4: BLOCK 1
ASCID/ of /
BOTPG5: BLOCK 1
ASCID/...../
RFLAG4: 1 ;To contain Record values
WFLAG4: 1 ;To contain B and X values
ASCID/.....
/
LBTDSH←←.-BOTDSH
;line stack
NEARBY←←4 ;Max movement for which we don't remember old line number
NOLD←←=20 ;length of line stack
OLDPLC: BLOCK NOLD ;window,,line number for line stack (oldest last)
OLDMAX: 0 ;number of valid entries in above list
OLDDBL: 2 ;number of lines back we go on αβN command
ZINDEX: 0 ;Index into ZDATA of current file
WINNBR: 0 ;window number used for this window
IFE DECSW,<
DQINFB←←15 ;Location of file writer in Stanford retrieval
WRTTEN: BLOCK DQINFB+2 ;Retrieval gets read in here to find out writer
WRTJOB←WRTTEN+DQINFB ;Jobname of writer of file goes here
WRTPPN←WRTTEN+DQINFB+1 ;PPN of writer of file goes here
WRTFI1←WRTTEN ;Word 1 of LOOKUP contains high-order date
WRTFI2←WRTTEN+1 ;Word 2 of LOOKUP contains date/time written
>;NOT DECSW
IFN DECSW,<
WRTPPN: 0
WRTFI1: 0 ;Save words 1 and 2 from LOOKUP block
WRTFI2: 0
>;DECSW
LWINDT←←.-WINDAT ;length of data block duplicated per window (in FS)
;End of per-window data (whole page).
;PDL EPDL TYIPNT TCPNT SYSCMD ZVARS FNDTBF FNDBUF SRDUMY BITBF1 BITBF2 SBBUF MBBUF VBBITS SBLST BUF BUF2 PBUFE RBUF RSPNT EVARS PATCH PAT LEGTAB ENDPUR CHKSUM ENDLOC
PDL: BLOCK LPDL
EPDL←←.-1 EPDL2←←.-2
TYIPNT: 0
TCPNT: 0
SYSCMD: 0
ZVARS: 0 ;beginning of area zeroed in INIT
VAR ;all the variables (declared with #'s)
FNDTBF: BLOCK SUBBUF+SRSIZ ;To hold both strings for F commands
FNDBUF: BLOCK SUBBUF+SRSIZ ;To hold both strings for X command
SRDUMY: BLOCK SRCBUF
BITBF1: BLOCK 4
BITBF2: BLOCK 4
SBBUF: BLOCK 4
MBBUF: BLOCK 4
VBBITS: BLOCK 6
SBLST: BLOCK 2
BUF: BLOCK 40
BUF2: BLOCK 40
PBUFE←←. ;End of buffer used for loading line editor
RBUF: BLOCK 40
RSPNT←←RBUF
EVARS←←.-1 ;end of area zeroed in INIT
PURE
PATCH:
PAT:: BLOCK 100
LEGTAB: FOR @! X←0,LEGNUM-1<LEG!X
>LEGCNT←←LEGNUM
XLIST ;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE
LIT ;DO THESE LAST FOR OPTIMIZATION
LIST
ENDPUR←←.
CHKSUM: 0 ;To hold initial check sum computed in S 137
IMPURE
IFE PURESW,<PURLST←←PURLNK>
ENDLOC←←.
IFE DECSW,<END BEGS;>END BEG