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