diff --git a/src/e142/atsign.mid b/src/e142/atsign.mid new file mode 100644 index 00000000..19866b6a --- /dev/null +++ b/src/e142/atsign.mid @@ -0,0 +1,12481 @@ +; -*-MIDAS-*- + +.SYMTAB 5001.,2000. + +ITSFLG==:1 ;POSSIBLE VALUES OF "SITE". MUST PRECEDE +CMUFLG==:2 ;"TITLE" SO THAT USER CAN DEFINE "SITE" +SAIFLG==:4 ;EXPLICITLY USING (T) SWITCH. +DECFLG==:10 +TNXFLG==:20 ;THIS DOESN'T WORK YET!! -- MRC + +TITLE ATSIGN + +SUBTTL AC'S, SITE INFO, AND VERSION + +IF1 [ + IFNDEF VERSION,[ + VERSION=.FNAM2 + IFG VERSION,[ ;If the version is numeric (a crude but effective test) + IFL VERSION-SIXBIT/509C/,VERSION=SIXBIT/509C/ ;then up the version if last edit was not at MIT + ];IFG VERSION + IFE VERSION-SIXBIT/MID/,[ + PRINTX /What is @'s version number? / + .TTYMAC VRS + VERSION=SIXBIT/VRS/ + TERMIN +]]]; CLOSES UP TO THE IF1 + +IF2,[; This exists for compiling @ with CCL-type MIDAS + IFE SITE&,[ + PRINTX/... is halfway +/ + ];IFE SITE& +];IF2 + +;;; ***** ACCUMULATORS ***** + +F=:0 ;FLAGS +A=:1 ;TEMPORARY +B=:2 ;TEMPORARY +C=:3 ;TEMPORARY +D=:4 ;TEMPORARY +L=:5 ;NOT SO TEMPORARY +R=:6 ;NOT SO TEMPORARY +H=:7 ;USED FOR JSP'S +N=:10 ;,, +CP=:11 ;CHAR POINTER, E.G. FOR SYLBUF +CH=:12 ;CURRENT CHAR +CC=:13 ;CHARACTER COUNT (PASS 2) +IP=:14 ;INPUT CHAR POINTER +DP=:15 ;DATA POINTER +SP=:16 ;SYMBOL TABLE POINTER/SLBUF POINTER +P=:17 ;PDL POINTER + +;;; CP, CH, CC, IP MUST BE CONSECUTIVE - SEE SORT + +.XCREF F A B C D L R H CH P + +SUBTTL BUREAUCRACY: WHO DID WHAT TO @ WHEN + +;;; ***** PEOPLE WHO HAVE HACKED THE PROGRAM ***** +;;; GLS Guy L. Steele Jr. (GLS@MIT-MC) +;;; RMS Richard M. Stallman (RMS@MIT-AI) +;;; RHG/RG02 Richard H. Gumpertz (Gumpertz@CMU-10A) +;;; MRC Mark Crispin (MRC@SU-AI) +;;; MOON David A. Moon (MOON@MIT-MC) +;;; EAK Earl A. Killian (EAK@MIT-MC) +;;; MT Michael Travers (MT@MIT-XX) + +;;; THE AUTHORITATIVE SOURCE FOR @ IS [MIT-AI]QUUX;@ > + +;; WARNING: RMS, MRC, AND GLS DON'T TAKE THIS BUREAUCRACY VERY SERIOUSLY. + +;;; ***** Modification History ***** +;;; Date Who Description +;;; - - Modifications prior to 28 Mar 76 went unrecorded +;;; 28 Mar 76 RHG Redid line number checking +;;; " " Fixed bug in /-T caused by line number hacking +;;; " " Added PDL overflow handling for DOS +;;; " " Added "extended LOOKUP" code under DOS +;;; " " Added creation date printing to PTLAB for DOS +;;; 29 Mar 76 " Added DROPTHRUTO macro +;;; 30 Mar 76 RMS Clean up problems in ITS version introduced by above. +;;; 01 Apr 76 RMS Added /L[PL/I] +;;; 01 Apr 76 RMS Displays info on progress of listing in the .WHO variables. +;;; " " /nS sets symbol space to symbols. +;;; 03 Apr 76 " PTLAB made more subroutinized, and more uniform across versions. +;;; " " 1st line of continuation pages is never used for text. +;;; " " Date appears on sym tab, CREF, SUBTTL table of contents, ... +;;; " " Infamous excess almost-blank page bug fixed. +;;; 06 Apr 76 RHG Added /K switch support, redid CKLNM (again -- sigh) +;;; " " Suppressed checksumming of line numbers, except under /K switch +;;; 07 Apr 76 " Fixed bug in last changes to checksumming, CKLNM +;;; " " Simplified PTLO hacking for TWOSEG +;;; " " Fixed date setting for DOS copyrights +;;; " " Added SITNAM stuff +;;; " " Fixed /nS printout on title page +;;; " " Fixed bug causing last page to always be printed under DOS +;;; 26 Apr 76 MRC Fixed PPN printout lossage under DOS +;;; 15 Jun 76 Moon Added /L[UCONS] +;;; 05 Sep 76 MRC Fixed assembly error in DOS +;;; 05 Sep 76 RMS OBARRAY assembled without literals +;;; " " LISPSW conditional to save space in DEC version +;;; 07 Sep 76 " SAIL PPN's, font files and XGP commands +;;; " " /X[QUEUE] +;;; 19 Sep 76 MRC Fixed SAIL PPN's, and pretty cases +;;; Installed(and debugged) RMS' written in patches +;;; 02 Oct 76 RMS Made SAIL version work. Understand ETV directories & padding. +;;; /L[TEXT] +;;; 18 Oct 76 RHG Made PGNSPC include space for PPN, in CMU version +;;; RMS Made automatic queueing work in SAIL version +;;; Understand that a narrow font 0 means more room for text +;;; (But doesn't work yet - see comment in FNTCPT) +;;; On DEC system, "FOO" specifies either null extension or default. +;;; Except on ITS, don't use top line of page for text. +;;; 24 Dec 76 RMS /Y means always print real page #, not virtual. +;;; Output file names don't default stickily; defaulted at +;;; open time directly to the /O[...] names. +;;; 26 Dec 76 RHG Added defs of CMUDEC and DECCMU so can assemble on ITS +;;; " " Added prompt for VERSION if .FNAM2 is MID +;;; " " Added printing of .FNAM1 and VERSION in non JCL mode +;;; 24 Jan 77 " Changed PDLCHK etc. to fix LRCEND if it changes +;;; " " Made LRCLEN not be referenced until SYMINI +;;; so that can be changed by a (yet to be added) +;;; switch in the LREC file. Until SYMINI, the LRC +;;; area can grow since it is at the top of core. +;;; " " Changed LRCLEN, SYMLEN, and PDLLEN to be positive +;;; " " Added DFLANG to indicate the default language +;;; 3 Mar 77 " Eliminated quoting NULLs for the CMU XGP +;;; 18 Mar 77 " Moved some SUBTTLs and definitions around +;;; " " Added DEFVG, but no switch to set it +;;; " " Changed 1INSRT to DIE if try to INSERT too many files +;;; If anyone doesn't like this, at least make it +;;; ask the user before continuing, thereby possibly +;;; deleting files from the LRC file +;;; 23 Mar 77 RHG Changed /1G to not only not generate +;;; but also to get rid of gaps and slashified pages +;;; " " Changed /Y to refer to old pages by the printed number, +;;; not the "real" page number. +;;; " " Made .LRC files on DSK go on the same structure +;;; as the existing .LRC file, if extended LOOKUPs work +;;; 24 Mar 77 " Made the protection bits be preserved when entering +;;; a .LRC file, if there previously was a .LRC file. +;;; " " Made /Y not print as "renumbered" those pages +;;; which really haven't changed at all. +;;; 1 Apr 77 RMS Added /L[TECO] +;;; 19 Apr 77 MRC Fix Twenex system names clobbering SUBTLS. +;;; 29 Apr 77 RMS Flushed DEFVG, which was compensating for bugs in +;;; something better which RHG didn't know existed +;;; (sorting definitions by type), which I caused to work. +;;; " " Made /L[TEXT] not use SLURP or OUTLIN, copy input right thru to output. +;;; Also, it understands the format of ITS XGP files and +;;; is not confused by ^L's that are really XGP commands. +;;; 7 Sep 77 RMS Made .INSRT on non-ITS allow a null FN2 to stand for itself +;;; as well as for the default. +;;; " " Added GLPTR spooling and renamed NOQUEUE to QUEUE. +;;; " " Made CREFs start with a key of what the funny symbols mean. +;;; " " Made the language default from the FN2 when possible. +;;; 7 Sep 77 MRC Added TNXFLG value for .SITE. Does not do much at all +;;; right now; any volunteers to JSYSify it? +;;; " " Made it .INSRT CMUDFS or SAIDFS instead of DECDFS for the +;;; CMU and SAIL versions; flushed @'s definition of SAIL and +;;; CMU UUO's. +;;; " " Flushed setting DSKFUL on non-CMU DEC; this should be up +;;; to the user and not randomly done by a program, but CMU +;;; hackers like things doing this (so Rick claims). +;;; 21 Sep 77 RHG Added back the version number hacking for +;;; source edited away from MIT. Changed CMU's +;;; prompt back to "@". +;;; " " Fixed a bug in 2LOOP7. Some loser indexed off +;;; A when it had been clobbered by calls on TITLES. +;;; Also suppressed page map, etc. if ALL pages +;;; are going to be listed. This assumes that if +;;; all pages have NEWPAG set, then all logical +;;; page numbers will match their physical +;;; page numbers. As far as I can tell, CPR does +;;; guarantee this. +;;; 22 Sep 77 " Fixed 1INSRT to default null FN2's properly on ITS +;;; Made files in the LREC file which are not found +;;; call FLOSE to let the user have a chance to recover. +;;; 28 Sep 77 MRC Made  an alias for _ so that underscore and backarrow +;;; will both win at SAIL and ITS. +;;; " " Flushed GETTAB's getting executed at SAIL. +;;; " " Fixed 1.IPPN -- nobody ever wrote SAIL code for it! Foo. +;;; " " Flushed extended LOOKUP code under SAIL -- there's no +;;; such garbage at SAIL and it was extra disk overhead. +;;; " " Other SAIL bug fixes hither and yon. +;;; " " A few more half-hearted Tenex code things. *SIGH* +;;; 6 Oct 77 RHG Fixed a bug I introduced accidentally in ENDUND. +;;; 7 Oct 77 " Made FISORF default on for CODRND and CODTXT +;;; where the order really doesn't matter anyway. +;;; 4 Apr 78 RMS Page numbers in table of contents go at left margin. +;;; " " /Z/L[Random] takes the first nonblank line on each +;;; page to be the subtitle. +;;; " " XGP line-space commands are treated like LF's +;;; by the checksummer. Random 012's inside commands +;;; are not treated as LF's. +;;; " " In DEC version, when the language is learned from the FN2 +;;; the default switches for that language are set. +;;; " " .LIBFIL in an assembler-language file means +;;; ignore the file completely, if it isn't being listed. +;;; 10 Apr 78 RMS Merge in JDS's MUDDLE hackery. +;;; " " Flush STYPE. All types are ASCIZ now. Create SYMOUT. +;;; 9 May 78 MRC Fixed assembly errors when making a SAIL version. +;;; Damnit, when you hack it, make sure it will at least +;;; compile for the other versions! +;;; 17 Jun 78 RHG Commented out the CMU stuff for the extra ^J +;;; in 2PAGE. Also upped CMU default for NFILES. +;;; " " Suppressed the blank page which was printed +;;; if /Z but no Table of Contents to print. +;;; " " Upped LSYLBUF for CMU, since people like +;;; to type a lot, sometimes. +;;; " " Upped NBFRS at CMU to 7, because the CMU-10A +;;; KL-10 is disk bound +;;; 30 Jun 78 EAK Created new language DAPX16 (PDP10 cross assembler +;;; for Honeywell 516/316) +;;; 10 Jul 78 MRC Added support for the @ monitor command at SAIL +;;; Fixed undefined symbol lossage introduced by DAPX16 edit. +;;; 28 Jul 78 RMS Added F.CRDT - file creation dates appear in LREC files. +;;; " " Make @DEFINEd definers with with forms like (MYDEFUN (FUNCTION ... +;;; " " Make /_/O[FOO DLREC] work. +;;; 15 Sep 78 RMS Make /nA print symbol table truncating symbols to n chars. +;;; " " Quote special characters in commands to XQUEUE. +;;; " " FPDLNG has second priority to CODTYP remembered in LREC file. +;;; " " Ignore nonexistent input files if /L[Text]/X. +;;; " " Anything starting with DEF gets @DEFINEd automatically if used. +;;; 19 Sep 78 RHG Fixed DOS version of PTLAB to pass argument to +;;; PTQDAT in R, not A. +;;; " " Changed NOITS version of FPRCHS to use the +;;; extended LOOKUP info, if available. +;;; " " Made processing of NONE: more complete +;;; " " Made 1CKLNM work even with /L[TEXT] by changing +;;; it to a PUSHJ type subroutine. +;;; " " Changed DATOUT to also print a time +;;; " " Changed title pages to include creation date +;;; of comparison file (F.OCRD), if available. +;;; 20 Sep 78 " Got rid of some unreferenced symbols -- not +;;; really necessary but I was feeling perverse. +;;; Similarly, lined up some comments vertically (sigh). +;;; " " Added more in preparation for /L[TEXT]/X at CMU. +;;; 21 Sep 78 " Finished adding /L[TEXT]/X for CMU +;;; " " Generalized the hack RMS installed on 15 Sep 78 +;;; to be controlled by /! switch. +;;; " " Added the macroes XGP, NOXGP, ITSXGP, NOITSXGP, +;;; CMUXGP, and NOCMUXGP to make things easier to read. +;;; " " Changed OKMISS to have three values. 0 means +;;; ignore missing files, +1 means ignore only after +;;; asking a question and getting no substitute file. +;;; This allows deletion via NONE: hack. +;;; -1 (the default) means do nothing special. +;;; Also renamed OKMISS to NXFDSP for Non-eXistent File DiSPosition +;;; " " Fixed FPFILE to understand .EXT under DOS +;;; " " Made DOS version clobber .JBSA since we can't +;;; be restarted anyway. +;;; " " Fixed DLRPS to handle unknown PSW words +;;; 22 Sep 78 " Fixed XSLUR1 label to be in the right place +;;; 24 Sep 78 RMS Packed NXFDSP into word 11 of LR.PSW +;;; 27 Sep 78 RMS Changed sense of NXFDSP. +;;; " " Created SWPRSN - print switch showing sign of argument. +;;; " " Fixed lossage of low bits set in SYLBUF. +;;; 2 Oct 78 RHG Fixed GO2 to not call FPDLNG if ECODTY set +;;; " " Fixed FPRCHS (NOITS/NOSAI version) to +;;; Get the date BEFORE clobbering CH. +;;; " " Fixed DOS version of TITLES to allow +;;; for longer file names (including DEVn:) +;;; 3 Oct 78 MRC Add /XGP switch to XSPOOL command since +;;; .ATC extension loses otherwise. +;;; 12 Oct 78 RHG Made /L[TEXT] and /L[RANDOM] compare the file +;;; creation dates. If equal, assume file unchanged.i. +;;; Also fixed DEVICE defaulting after parsing NONE: in +;;; FPDEF to assume DSK unless explicitly set to NONE: again +;;; " " Fixed 1LOOP/1DONE1 to avoid a page table for skipped files +;;; 19 Oct 78 RHG Renamed 1INSRO to 1INSOP to avoid potential confusion with 1INSR0 +;;; 20 Oct 78 RHG Changed 2OCLSQ to type the number of pages in a file. +;;; 22 Nov 78 MT Added .DEFMAC and .RDEFMAC hacks for assembly langs. +;;; 6 Feb 79 JLK Changes to Gould spooler commands. +;;; 18 Feb 79 RMS Made ITS version get /L from -*-language-*- +;;; Made ITS left margin 128 again. +;;; No tab before subtitles in /# mode. +;;; 13 May 79 MT Let XGP header-page stuff be included for ITSXGP, NOITS sites. +;;; 16 May 79 MT Treat tab as space in FAIL. + +SUBTTL SYSTEM-DEPENDENT DEFINITIONS + +;;; ***** DETERMINE WHERE WE ARE ***** + +IFNDEF SITE,[ + IFDEF .IOT, SITE==:ITSFLG ;IS IT MIT ITS? + IFDEF CMUDEC, SITE==:CMUFLG ;HOW ABOUT CMU? + IFDEF SPWBUT, SITE==:SAIFLG ;HOW ABOUT SU-AI? + IFDEF GTJFN, SITE==:TNXFLG ;HOW ABOUT TENEX OR TWENEX? +];IFNDEF SITE + +IFNDEF SITE,[ + PRINTX /Site = ITS, SAI, CMU, DEC, or TNX? / + .TTYMAC X + SITE==:X!FLG + TERMIN +];IFNDEF SITE +IFNDEF SITE, .FATAL SITE NOT SPECIFIED. + +IFNDEF SITNAM,[ + IFE SITE-ITSFLG,SITNAM==:SIXBIT/ITS/ + IFE SITE-CMUFLG,SITNAM==:SIXBIT/CMU/ + IFE SITE-SAIFLG,SITNAM==:SIXBIT/SAIL/ + IFE SITE-DECFLG,SITNAM==:SIXBIT/DEC/ + IFE SITE-TNXFLG,SITNAM==:SIXBIT/TENEX/ +];IFNDEF SITNAM + +IFNDEF LISPSW,LISPSW==SITE#DECFLG ;>0 => HANDLE LISP AND UCONS CODE. +IFNDEF MUDLSW,MUDLSW==SITE&ITSFLG ;>0 => HANDLE MUDDLE CODE. + +IRPS X,,ITS:CMU:SAI:DEC:TNX:,Y,,NOITS:NOCMU:NOSAI:NODEC:NOTNX: + DEFINE Y +IFN SITE-X!FLG!TERMIN + DEFINE X +IFE SITE-X!FLG!TERMIN +TERMIN + DEFINE DOS ;DEC LIKE OPERATING SYSTEM +IFN &SITE!TERMIN + DEFINE NODOS +IFE &SITE!TERMIN + +DOS,[ IFNDEF OPEN,[ + SAI,.INSRT SYS:SAIDFS + CMU,.INSRT SYS:CMUDFS + DEC,.INSRT SYS:DECDFS + .DECDF + ];IFNDEF OPEN +];DOS +ITS,[ IFNDEF .OPEN,[.INSRT SYS:ITSDFS + .ITSDF + ];IFNDEF .OPEN +];ITS +TNX,[ IFNDEF GTJFN,[.INSRT SYS:TNXDFS + .TNXDF + ];IFNDEF GTJFN +];TNX + +TNX,[ PRINTX/If you think you are going to get a working @ on Tenex by +using TNXFLG are you ever going to lose. +/ + .ERR SITE=TNXFLG doesn't work yet +];TNX + +TNX,YOU'RE WELCOME ;I LOVE PUNS + +IFNDEF XGPFMT,[ ;WHAT SORT OF XGP COMMANDS DO WE WANT TO OUTPUT? + IFE SITE-CMUFLG,XGPFMT==:CMUFLG ;CMU HAS ONE FORMAT. + IFE SITE-SAIFLG,XGPFMT==:ITSFLG ;ITS AND SAIL HAVE ONE. + IFE SITE-ITSFLG,XGPFMT==:ITSFLG + IFNDEF XGPFMT, XGPFMT==:0 ;/X AND /F NOT ALLOWED IF 0. +];IFNDEF XGPFMT + +IRPS X,,ITS:CMU:,Y,,NOITS:NOCMU: + DEFINE Y!XGP +IFN XGPFMT-X!FLG!TERMIN + DEFINE X!XGP +IFE XGPFMT-X!FLG!TERMIN +TERMIN + + DEFINE XGP +IFN XGPFMT!TERMIN + DEFINE NOXGP +IFE XGPFMT!TERMIN + +XGP,[IFNDEF FNTDSN,[ ;WHAT IS DEFAULT DIRECTORY FOR FONT FILES? + IFE SITE-ITSFLG,FNTDSN=:SIXBIT/FONTS/ + IFE SITE-CMUFLG,FNTDSN=:1343,,303360 ;A730KS00 + IFE SITE-SAIFLG,FNTDSN=:SIXBIT/XGPSYS/ + IFE SITE-DECFLG,[ + PRINTX /Default PPN for font files = / + .TTYMAC X + FNTDSN==:X + TERMIN + ];IFE SITE-DECFLG + IFE SITE-TNXFLG,[ + PRINTX /Default directory number for font files = / + .TTYMAC X + FNTDSN==:X + TERMIN + ];IFE SITE-TNXFLG +];IFNDEF FNTDSN +];XGP + +IFNDEF FNTDSN, FNTDSN==:0 + +;;; ***** I/O CHANNELS ***** + +ERRC==:0 ;ERROR MESSAGES +UTIC==:1 ;FILE INPUT +UTOC==:2 ;LISTING OUTPUT +INSC==:3 ;INSERT CHANNEL (FOR VERIFYING EXISTENCE) +DOS, RNMC==:4 ;CHANNEL FOR RENAMING +DOS, DELC==:5 ;CHANNEL FOR DELETING +ITS, TYIC==:4 ;TTY INPUT +ITS, TYOC==:5 ;TTY OUTPUT + +;;; ***** UUO DEFINITIONS ***** + +NODOS, STRT=:1000,, ;ASCIZ STRING TYPEOUT +DOS, STRT=:OUTSTR ;DOS ALREADY HAS A MONITOR UUO TO DO THIS, SO USE IT +6TYP=:2000,, ;SINGLE SIXBIT WORD TYPEOUT +FLOSE=:3000,, ;I/O LOSSAGE MSG, FROM SYSTEM CALL FAILURE-RETURN. +FLOSEI=:4000,, ;I/O LOSSAGE MESSAGE - INTERNALLY DETECTED ERROR. +TYPNUM=:5000,, ;NUMERIC TYPEOUT, AC = RADIX +UUOMAX==:5 + +;;; ***** MIDAS CONTROL SWITCHES ***** + +IFNDEF DECREL, DECREL==:&SITE ;1 => MAKE DEC REL FORMAT FILE. +ITS, TWOSEG==0 ;RIDICULOUS ON A RANDOMLY PAGED SYSTEM +TNX, TWOSEG==0 ;YOU CAN SAY THAT AGAIN +SAI, TWOSEG==0 ;TWOSEG LESS EFFICIENT AT SAIL. +IFNDEF TWOSEG, TWOSEG==:1 + +;;; ***** OP CODES, ETC. ***** + +DEFINE DROPTHRUTO X +IF2, IFN .-X, .ERR THIS DROPTHRUTO SHOULD BE A JRST +TERMIN + +ITS,[ TYO=:.IOT TYOC, + TYI=:.IOT TYIC, + .OUTPT==:.IOT UTOC, +DEFINE SYSCAL NAME,ARGS + .CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))] +TERMIN +];ITS + +TNX,[ +IF1, EXPUNGE .VALUE,.CLOSE,.DISMISS +IF2, .VALUE=:JSYS [LOSE,,LOSE0] +];TNX + +DOS,[ + TYO=:OUTCHR + TYI=:INCHWL +IF1, EXPUNGE .VALUE,.CLOSE,.DISMISS ;IN CASE WE ARE ASSEMBLING ON ITS +IF2, .VALUE==:JSR LOSE ;IF2 BECAUSE LOSE ISN'T DEFINED YET IN PASS 1 + .CLOSE==:RELEASE ;CLOSE ENOUGH APPROXIMATION + .DISMISS==:JRST 2,@0 ;AGAIN, A CLOSE APPROXIMATION (FOR RETURNING FROM PDL OVERFLOWS) + +DEFINE .OUTPT X\OLOOP,ODONE,OCHK,OFLSH ;THIS MIGHT WANT TO BE A SUBROUTINE +IFE N-X, .ERR REGISTER N ILLEGAL AS AN ARG TO .OUTPT + PUSH P,N +OLOOP: HLRE N,X + IMUL N,[-5] + CAMLE N,OUTHED+2 + MOVE N,OUTHED+2 + JUMPLE N,OCHK + SUBM N,OUTHED+2 + MOVNS OUTHED+2 ;SUBM goes the wrong way!!! +IFE N+1-P, .ERR N+1 MUST NOT BE SAME REGISTER AS P (FOR .OUTPT) + PUSH P,N+1 + IDIVI N,5 + CAIN N+1,0 ;We should have an integral number of words!!! + SOSGE N ;And we should have at least 1 + .VALUE + MOVE N+1,(P) ;POP P,N+1 + MOVEM N,(P) ;PUSH P,N + EXCH N,OUTHED+1 + IBP N + HRLI N,010700 ;Faster than 4 more IBP instructions + ADDM N,OUTHED+1 + HRLI N,(X) + BLT N,@OUTHED+1 + POP P,N + HRLI N,(N) + ADD X,N ;This is 1 count short (remember the SOSGE N,) + AOBJP X,ODONE +OFLSH: OUT UTOC, + JRST OLOOP ;Loop if successful + GETSTS UTOC,N + .VALUE + TRZ N,740000 + SETSTS UTOC,(N) +OCHK: JUMPL X,OFLSH ;Note that x will be < 0 if we fall through to here +ODONE: POP P,N +IF2, EXPUNGE OLOOP,ODONE,OCHK,OFLSH +TERMIN +];DOS + +SUBTTL DEFAULT ASSEMBLY PARAMETERS + +SAI,[ +IFNDEF PGLLPT,PGLLPT==54. ;SAIL HAS SHORT LPT PAGES. +IFNDEF PGLDOT,PGLDOT==2194. ;AND DIFFERENT XGP DEFAULTS. +IFNDEF QUEBFL,QUEBFL==100 ;LENGTH OF BUFFER FOR XSPOOL COMMAND. +];SAI + +IFNDEF LNLLPT, LNLLPT==:120. ;DEFAULT NON-XGP LINEL +IFNDEF LNLXGP, LNLXGP==:84. ;DEFAULT XGP LINEL (IF FONTS NOT SPEC'D) +IFNDEF PGLLPT, PGLLPT==:60. ;DEFAULT NON-XGP PAGEL +IFNDEF PGLXGP, PGLXGP==:60. ;DEFAULT XGP PAGEL (IF FONTS NOT SPEC'D) +IFNDEF TOPMAR, TOPMAR==:128. ;XGP OUTPUT TOP MARGIN +IFNDEF BOTMAR, BOTMAR==:124. ;XGP BOTTOM MARGIN. +ITS,IFNDEF LFTMAR, LFTMAR==:128. ;XGP LEFT MARGIN +NOITS,IFNDEF LFTMAR, LFTMAR==:128. ;XGP LEFT MARGIN +IFNDEF RGTMAR, RGTMAR==:128. ;XGP RIGHT MARGIN +IFNDEF PGLDOT, PGLDOT==:192.*11. ;XGP NORMAL PAGE LENGTH IN RASTER UNITS +IFNDEF LNLDOT, LNLDOT==:1700. ;(200.*8.5) XGP PAPER WIDTH IN RASTER UNITS +ITS,IFNDEF PGLGLD,PGLGLD==2080. ;PAGE LENGTH IN DOTS ON GOULD LPT. +ITS,IFNDEF LNLGLD,LNLGLD==1700. ;LINE LENGTH IN DOTS OF GOULD LPT. +ITS,IFNDEF PGLGLP,PGLGLP==62. ;PAGE LENGTH IN LINES OF GOULD, WITH HARDWARE FONT +ITS,IFNDEF LNLGLP,LNLGLP==132. ;LINE LENGTH IN CHARS OF GOULD, WITH HARDWARE FONT +IFNDEF VSPNRM, VSPNRM==:4 ;DEFAULT VSP +CMU,IFNDEF PGNSPC,PGNSPC==:.LENGTH \DEVx:FILNAM.EXT[X999XX99] PAGE MAJ/MIN.CNT\ +TNX,IFNDEF PGNSPC,PGNSPC==:7+40.+40.+12.+.LENGTH\PAGE MAJ/MIN.CNT\ +IFNDEF PGNSPC, PGNSPC==:.LENGTH \DIRNAM;FILNAM FILNM2 PAGE MAJ/MIN.CNT\ +DEC,IFNDEF NFILES,NFILES==:32. ;DON'T WASTE TOO MUCH SPACE ON FILES +CMU,IFNDEF NFILES,NFILES==:128. ;BUT CMU OFTEN WANTS MORE +IFNDEF NFILES, NFILES==:64. ;MAX # FILES ALLOWED +DOS,XGP,IFNDEF LINBFR,LINBFR==:400 ;MUST HAVE ROOM FOR ENOUGH OF FNT FILES. +DOS,IFNDEF LINBFR,LINBFR==:200 ;NO POINT IN TRYING TO READ TOO MUCH AT A TIME +IFNDEF LINBFR, LINBFR==:1000 ;LENGTH OF INPUT BUFFER +IFNDEF LSLBUF, LSLBUF==:1000 ;LENGTH OF OUTPUT BUFFER +CMU,IFNDEF LSYLBUF,LSYLBUF==:400.;CMU sometimes needs long JCL +IFNDEF LSYLBUF,LSYLBUF==:100 ;LENGTH OF SYLLABLE/JCL BUFFER +CMU,NFNTS==2 ;CMU HAS ONLY 2 FONTS (SIGH) +IFNDEF NFNTS, NFNTS==:3 ;# FONTS ALLOWED. +IFNDEF MINPGL, MINPGL==:45. ;SMALLEST ALLOWED PAGEL. +IFNDEF MINLNL, MINLNL==:50. ;SMALLEST ALLOWED LINEL. +IFNDEF MAXVSP, MAXVSP==:20. ;LARGEST VSP THAT CAN BE SPEC'D WITH A POSITIVE ARG TO /V. +DOS,IFNDEF FNAMCW, FNAMCW==29. ;DOS OFTEN PRINTS DEVx: +IFNDEF FNAMCW, FNAMCW==24. ;THIS IS THE COLUMN WIDTH WHEN LISTING FILES IN TITLES + +IFN SITE&,[ ;THESE WILL BE ROUNDED UP TO MULTIPLES OF 1K IN PDLIN1. +IFNDEF PDLDLN,PDLDLN==:2000 ;SIZE OF PDL SPACE +IFNDEF LRCILN,LRCILN==:2000 ;INITIAL SIZE OF LRC AREA (IT CAN GROW, AT FIRST) +IFNDEF LRCDLN,LRCDLN==:40.*2000 ;DEFAULT SIZE OF INPUT LREC INFO SPACE (40K) +IFNDEF SYMDLN,SYMDLN==:40.*2000 ;DEFAULT SIZE OF SYMTAB SPACE (40K) +IFNDEF DATILN,DATILN==:2000 ;INITIAL SIZE OF DATA AREA (IT CAN GROW) +IF2 IFG .JBFF1+PDLDLN+LRCDLN+SYMDLN+DATILN-776000, .ERR DEFAULT SPACE ALLOCATIONS TOO BIG +];ITS OR TNX + +DOS,[ +IFNDEF PDLDLN,PDLDLN==:200 ;SIZE OF PDL +IFNDEF LRCILN,LRCILN==:1 ;INITIAL SIZE OF LRC AREA (IT CAN GROW, AT FIRST) +DEC,IFNDEF LRCDLN,LRCDLN==:2000 ;I guess DEC is tight for CORE --RHG +IFNDEF LRCDLN,LRCDLN==:10000 ;DEFAULT SIZE OF INPUT LREC INFO SPACE. +IFNDEF SYMDLN,SYMDLN==:10000 ;DEFAULT SIZE OF SYMTAB SPACE. +IFNDEF DATILN,DATILN==:1 ;INITIAL SIZE OF DATA AREA (IT CAN GROW) +];DOS + +IF2 [ ;PASS 2, SINCE CODTYP VALUES NOT DEFINED YET IN PASS 1 +ITS,IFNDEF DFLANG,DFLANG==:CODMID +CMU,IFNDEF DFLANG,DFLANG==:CODRND +SAI,IFNDEF DFLANG,DFLANG==:CODFAI +TNX,IFNDEF DFLANG,DFLANG==:CODMID +IFNDEF DFLANG,DFLANG==:CODMID ;DEFAULT LANGUAGE +];IF2 + +SUBTTL FLAG DEFINITIONS + +;;; FLAGS IN LH OF ACCUMULATOR F +FL==:1,,525252 ;BIT TYPEOUT MASK + +FLREFS==:400000 ;REFERENCE STUFF +FLSHRT==:100000 ;SHORT MULTI-FILE NAMES +FLINSRT==:40000 ;LIST ALL INSERTED FILES +FLXGP==:20000 ;XGP HACKERY +FLCREF==:10000 ;CREF FOR ALL FILES WANTED +FLBS==:4000 ;CTRL/H REALLY GOES OUT AS CTRL/H +FLSCR==:2000 ;STRAY CR'S REALLY OVERSTRIKE + ; (ALSO CONTROLS STRAY LINEFEEDS) +FLCTL==:1000 ;CTRL CHARS GO OUT AS THEMSELVES +FLARB==:400 ;ARBITRARILY LONG SYMBOLS +FLFNT2==:200 ;TEXT IS DIFFERENT FONT FROM CRUFT +FLFNT3==:100 ;COMMENTS ARE DIFFERENT FONT FROM TEXT +FL2REF==:40 ;TWO REFS PER LINE (PDP-11 CODE) +FLASCI==:20 ;SYMBOLS ARE IN ASCII (ELSE SIXBIT) + ; (NOBODY USES THIS PRESENTLY) +FLDATE==:10 ;WANT DATE IN HEADINGS +FLNOLN==:4 ;NO STUFF AT ALL ON LEFT +FLQPYM==:2 ;COPYRIGHT MESSAGE +FLSUBT==:1 ;SUBTITLES TABLE OF CONTENTS + +;;; FLAGS IN RH OF F.SWIT OF EACH FILE-BLOCK. +;;; SOME (THOSE IN TEMPF) ARE KEPT IN F FOR FILE BEING PROCESSED. +;;; NOTE THAT DURING SWITCH PROCESSING MOST OF THESE LIVE IN F, +;;; AND MOST OF THE FR FLAGS AREN'T IN USE YET. EXCEPTIONS ARE RANDF, FR1SW. +FS==:525252 ;BIT TYPEOUT MASK + .SEE RANDF ;CAN'T USE 10000 FOR PER-FILE SWITCH + +FSNCHG==:4000 ;SET IF FILE IS DISCOVERED TO BE UNCHANGED SINCE PREVIOUS + ;LISTING WAS MADE. VALUE CALCULATED BY CPRU. + ;UNCHANGED FILE ARE NOT LISTED. +FSLRNM==:2000 ;DON'T CAUSE ANY PAGE TO HAVE A SLASHIFIED PAGE NUMBER, + ;EVEN IF THAT REQUIRES RELISTING LOTS OF PAGES (/1J). +FSLALL==:1000 ;RELIST ALL OF THIS FILE (/-J). +FSGET==:400 ;THIS IS AN LREC FILE, AND .INSRT ALL FILES MENTIONED IN IT. +FSNSMT==:200 ;NO SYMBOL TABLE PRINTOUT FOR THIS FILE +FSNOIN==:100 ;IGNORE FILE EVEN ON PASS 1. USED TO SUPPRESS PASS 1 + ;FOR .INSRT'ED FILES THAT AREN'T REALLY RELEVANT. +FSLREC==: 40 ;THIS FILE IS A LISTING RECORD FILE +FSQUOT==:20 ;THIS FILE WAS SPEC'D WITH A SINGLE-QUOTE. +FSARW==:10 ;THIS FILE'S SPEC HAD A "_". +FSMAIN==:4 ;THIS FILE IS THE ONE WHOSE FN2 SHOULD BE USED FOR THE LREC FILE. +FSSUBT==:2 ;THIS FILE HAS AT LEAST ONE SUBTITLE SPECIFIED, SO RESERVE + ;THE FIRST LINE OF EACH PHYSICAL PAGE FOR A SUBTITLE. + .SEE FR1SW +FSAUX==:1 ;THIS FILE CONTAINS A ".AUXIL", SO IT IS AN AUXILIARY FILE. + ;SYMBOLS THAT APPEAR ONLY AUXILIARY FILES WHICH ARE NOT + ;BEING LISTED ARE NOT MENTIONED IN CREFS. +TEMPF==:FSLREC+FSARW+FSQUOT+FSNOIN+FSNCHG +;THESE FLAGS ARE MOVED FROM F.SWIT INTO AC F FOR EACH FILE DURING PASS1 AND PASS2. + +;;; FLAGS IN RH OF ACCUMULATOR F +FR==:525252 ;BIT TYPEOUT MASK + +FRSYL1==:400000 ;FIRST SYLLABLE OF LINE ALREADY SEEN +FRVSL1==:200000 ;VIRTUAL FIRST SYLLABLE SEEN +FRIF==:100000 ;SOME KIND OF IF SEEN +FRLET==:40000 ;LETTER SEEN (OR . OR $ OR %) +FRSQZ==:20000 ;SQUOZE CHAR SEEN +FRNCHG==:FSNCHG ;THIS FLAG SET IN F FROM F.SWIT OF CURRENT FILE. +FRWPGN==:2000 ;1 => IN OUTLIN, TYPING "PAGE NNN". MEANS THAT + ;CONTINUATION, IF IT TAKES PLACE, SHOULDN'T TRY + ;TO OUTPUT "PAGE NNN" (THAT WOULD CAUSE RECURSION LOOP) +FRNOIN==:FSNOIN ;THESE 4 FLAGS SET IN F FROM F.SWIT OF CURRENT FILE. +FRLREC==:FSLREC ? FRQUOT==:FSQUOT ? FRARW==:FSARW +FR1SW==:2 ;SET BY "/", CLEARED BY "(" - CAUSES RETURN TO FILENAME + ;READER AFTER PROCESSING ONE SWITCH. +FRFNT3==:4 ;BUSY OUTPUTTING IN FONT 3 +FRLCR==:2 ;LAST CHAR WAS CR (FOR SLURP) +FRLTAB==:1 ;LAST CHAR WAS TAB, SPACE, LF, FF +FRPSHRT==:2 ;IN MOBY, INDICATES PAGE IS SHORT, SO SHRINK LETTERS VERTICALLY +FRLSHRT==:1 ;IN MOBY, INDICATES LINES ARE SHORT, SO SHRINK LETTERS HORIZONTALLY. + +;;; FLAGS USED DURING PARSING OF SWITCHES (USED AS SHADOWS) + +RANDF==:10000,, + +SUBTTL FORMAT OF SYMBOL TABLE + +;;; THE SYMBOL TABLE GROWS UPWARD, INITIALLY FROM LOCATION SYMBOT. +;;; THE CURRENT LOW ADDRESS OF THE SYMBOL TABLE IS IN SYMLO. +;;; DURING PASS 1, SP CONTAINS A PDL POINTER TO THE SYMBOL TABLE +;;; WHICH IS USED TO PUSH NEW ENTRIES. AT THE END OF PASS 1, +;;; THE HIGHEST ADDRESS USED +1 IS DEPOSITED IN LOCATION SYMHI. +;;; THE SYMBOL TABLE IS THEN SORTED (SEE SORT), SO THAT PASS 2 +;;; MAY USE A BINARY SEARCH LOOKUP TECHNIQUE. +;;; EACH ENTRY IN THE SYMBOL TABLE IS FOUR WORDS LONG. (THE +;;; ROUTINES SORT, LOOK, AND NLOOK DEPEND ON THIS FACT!) +;;; THE FORMAT OF EACH ENTRY IS AS FOLLOWS: + +S.==:,-1 ;MASK FOR BIT TYPEOUT MODE. +C.==:,-1 + +S.NAME==:0 ;NAME OF SYMBOL. IF SINGLE WORD SYMBOLS ARE + ; BEING USED (THE FLAG FLARB IS OFF), THEN THIS + ; WORD CONTAINS THE SINGLE WORD OF THE NAME. + ; OTHERWISE IT CONTAINS AN AOBJN POINTER TO THE + ; NAME, WHICH IS IN CONSECUTIVE WORDS IN THE + ; DATA AREA. +S.FILE==:1 ;THE LEFT HALF CONTAINS A POINTER TO THE FILE + ; BLOCK (SEE FILES) FOR THE FILE IN WHICH THE + ; DEFINITION WAS FOUND. +S.TYPE==:1 ;THE RIGHT HALF CONTAINS THE ADDRESS OF DATA + ; DESCRIBING THE TYPE OF SYMBOL DEFINITION + .SEE ATYPE ; (E.G. MACRO, ==, .GLOBAL). TYPES ARE DEFINED BY ATYPE. +S.PAGE==:2 ;THE LEFT HALF CONTAINS THE PAGE NUMBER FOR + ; THE DEFINITION. +S.LINE==:2 ;THE RIGHT HALF CONTAINS THE LINE NUMBER -1. +S.BITS==:3 ;THE LEFT HALF CONTAINS VARIOUS BITS PERTAINING + ; TO THE SYMBOL DEFINED. THESE ARE: +%S==1,,525252 + %SDUPL==:400000 ;THIS ENTRY IS PRECEDED BY ONE + ; WITH THE SAME NAME. %SDUPL + ; MUST BE THE SIGN BIT - SEE NLOOK8 + %SXCRF==:200000 ;THIS SYMBOL WAS SEEN IN A + ; .XCREF - DO NOT CREF + %SREFD==:100000 ;THIS SYMBOL WAS REFERENCED ON + ; PASS 2 - USED TO PUT *'S IN + ; THE SYMBOL TABLE (NOT FULLY + ; WINNING IF NOT ALL FILES + ; WERE SEEN ON PASS 2) + %SXSYM==:40000 ;DO NOT PRINT THIS SYMBOL IN THE + ; SYMBOL TABLE - IT IS PRESENT FOR + ; CREF PURPOSES ONLY +S.CREF==:3 ;THE RIGHT HALF IS A POINTER TO A LINKED CHAIN + ; OF CREF DATA FOR THIS SYMBOL. ONLY THE FIRST + ; ENTRY OF SEVERAL WITH THE SAME NAME WILL HAVE + ; CREF DATA. CREF DATA BLOCKS ARE THREE WORDS + ; LONG, AND ARE EXACTLY LIKE THE LAST THREE + ; WORDS OF A SYMBOL TABLE ENTRY. A POINTER TO A + ; CREF ENTRY POINTS TO THE WORD BEFORE THE + ; THREE-WORD BLOCK. THE S.NAME WORD IN A CREF + ; DATA BLOCK IS NOT MEANINGFUL. THE S.CREF WORD + ; IS USED TO CHAIN CREF DATA INTO A LINKED LIST. +LSENT==:4 ;LENGTH OF SYMBOL TABLE ENTRY +C.FILE==:S.FILE +C.TYPE==:S.TYPE +C.PAGE==:S.PAGE +C.LINE==:S.LINE +C.CREF==:S.CREF + +SUBTTL FORMAT OF AN LREC FILE + +;THE FIRST WORD OF AN LREC FILE SHOULD NOW BE SIXBIT/LREC/+1. +;ATTEMPTS TO USE FILES WHICH DO NOT SATISFY THAT CRITERION +;CAUSE ERROR MESSAGES. +;THE REST OF FILE IS COMPOSED OF ENTRIES, ONE AFTER THE OTHER. +;EACH ENTRY DESCRIBES HOW ONE FILE WAS TREATED IN THE LISTING +;THAT THE LREC FILE DESCRIBES. THERE IS AN ENTRY FOR ALL FILES EXCEPT +;LREC FILES AND BACKARROW-SINGLEQUOTE FILES. +;AN ENTRY BEGINS WITH 4 WORDS GIVING THE SNAME, DEV, FN1 AND FN2 OF THE FILE. +;THEN COME 0 OR MORE SUBENTRIES, FOLLOWED BY A -1 SIGNIFYING THE END +;OF THE ENTRY. +;A SUBENTRY CONSISTS OF A WORD HOLDING THE SUBENTRY TYPE, +;A WORD WHOSE LH HAS MINUS THE NUMBER OF DATA WORDS IN THE SUBENTRY, +;FOLLOWED BY DATA WORDS WHOSE SIGNIFICANCE DEPENDS ON THE SUBENTRY TYPE. +;THE SUBENTRY TYPES THAT NOW EXIST ARE: + +LR.==:,-1 ;MASK FOR BIT TYPEOUT MODE. + +LR.PAG==:1 ;THE DATA WORDS ARE THE PAGE TABLE OF THE FILE. +LR.SYM==:2 ;THE DATA WORDS ARE THE SYMBOL TABLE OF THE FILE. + ;THAT IS, THE SYMBOL TABLE OF THE LISTING BUT LIMITED + ;TO SYMBOLS DEFINED IN THIS FILE. CURRENTLY, THIS SUBENTRY + ;IS IGNORED ON INPUT, AND NEVER WRITTEN. +LR.SWT==:3 ;THERE IS 1 DATA WORD, THE F.SWIT VALUE FOR THE FILE. +LR.PSW==:4 ;HOLDS INFO ON SETTINGS ON NON-PER-FILE SWITCHES + ;IF ONE ENTRY IN THE FILE HAS AN LR.PSW + ;SUBENTRY, ALL ENTRIES SHOULD HAVE THEM, AND + ;THEY SHOULD ALL HAVE THE SAME CONTENTS. + ;THE SETTINGS RECORDED IN THIS SUBENTRY ARE USED + ;WHEN /G IS SPEC'D AS THE DEFAULTS FOR ALL THE + ;SWITCHES. THERE ARE 12. WORDS OF DATA: + ;WD 1 THE VALUE OF F + ;WD 2 THE VALUE OF LINEL + ;WD 3 THE VALUE OF PAGEL + ;WD 4 THE VALUE OF UNIVCT + ;WD 5 THE VALUE OF CODTYP + ;WD 6 THE VALUE OF TRUNCP + ;WD 7 THE VALUE OF SINGLE + ;WD 8 THE VALUE OF PRLSN + ;WD 9 THE VALUE OF SYMLEN + ;WD 10 THE VALUE OF QUEUE + ;WD 11 BIT-DECODED: BIT 1.1 = 1 IFF NOTITLE IS NONZERO. + ; BIT 1.2 = 1 IFF REALPG IS NONZERO. + ; BITS 1.3, 1.4 = VALUE OF NXFDSP (TO BE SIGN-EXTENDED) + ;WD 12 THE VALUE OF SYMTRN +LR.FNT==:5 ;HOLDS INFO ON SPEC'D FONTS. PRESENT ONLY IF FONTS HAVE + ;BEEN SPECIFIED. CONTAINS AN IMAGE OF FNTF0 THROUGH FNTFE-1, + ;AS THEY WERE WHEN LREC FILE WAS MADE. THUS, THERE ARE + ;FNTFL WORDS PER FONT, AND NFNTS FONTS. @ WILL NOT COMPLAIN + ;IF HANDED A LONGER LR.FNT BLOCK BUT WILL IGNORE THE EXTRA FONTS. +LR.XGP==:6 ;HOLDS PARAMETERS RELEVANT TO FONTS. RIGHT NOW THERE IS ONLY + ;ONE, THE VSP, FROM FNTVSP. +LR.CRF==:7 ;CONTAINS INFO ON THE OUTPUT FILE FOR CREF TABLES AND + ;UNIVERSAL SYMBOL TABLES. THERE ARE 5 DATA WORDS, WHICH ARE + ;CRFSNM, CRFDEV, CRFFN1, CRFFN2, CRFOFL + ;THE ABSENCE OF THIS SUBENTRY IS EQUIVALENT TO THE PRESENCE + ;OF ONE WITH CRFOFL CONTAINING 0. +LR.CPY==:10 ;THE COPYRIGHT MESSAGE, FROM CPYMSG. +LR.OUT==:11 ;4 WORDS: THE SNAME, DEV, FN1, FN2 DEFAULTS FOR OUTPUT FILES + ;0 => NOT SPECIFIED, SO USE @'S STANDARD DEFAULT EACH TIME. + ;I.E. 0 AS SNAME MEANS USE MSNAME OF USER RUNNING @. +LR.DAT==:12 ;CREATION DATE OF THE SOURCE FILE. + +SUBTTL GENERALLY USEFUL MACROS. + +DEFINE INSIRP A,B +IRPS X,,B +A,X +TERMIN TERMIN + +DEFINE DBP7 X + ADD X,[070000,,] + SKIPGE X + SUB X,[430000,,1] +TERMIN + +DEFINE CONC A,B +A!B!TERMIN + +;;; USEFUL NREVERSE MACRO. QUICKLY REVERSES A LINKED LIST. +;;; FIRST ARG IS AC CONTAINING LIST, NEXT TWO ARE SCRATCH AC'S. +;;; FOURTH IS OFFSET OF CDR POINTER (MUST BE IN RH OF WORD). +;;; FIFTH IS CODE TO EXECUTE ON EACH LOOP, REFERRING TO +;;; AC POINTING AT CURRENT NODE AS X. REVERSED LIST IS LEFT +;;; IN AC WHERE LIST WAS SUPPLIED. + +DEFINE NREVERSE AC1,AC2,AC3,Z,CODE\TAG1,TAG2,TAG3,MAC1 +DEFINE MAC1 X +CODE +TERMIN + JUMPE AC1,TAG3 + SETZ AC2, +TAG1: HRRZ AC3,Z(AC1) + HRRM AC2,Z(AC1) + MAC1 AC1 + JUMPE AC3,TAG3 + HRRZ AC2,Z(AC3) + HRRM AC1,Z(AC3) + MAC1 AC3 + JUMPE AC2,TAG2 + HRRZ AC1,Z(AC2) + HRRM AC3,Z(AC2) + MAC1 AC2 + JUMPN AC1,TAG1 + SKIPA AC1,AC2 +TAG2: MOVEI AC1,(AC3) +TAG3: +EXPUNGE MAC1 +TERMIN + +SUBTTL UUO AND INTERRUPT HANDLERS + +IFN DECREL-TWOSEG, .DECREL +IFN TWOSEG, .DECTWO +IFE DECREL, .SBLK ? LOC 100 +RL0:: ;RELOCATABLE 0 -- MUST BE DEFINED BEFORE ANY ASSEMBLED CODE + +ZZZ==. ? LOC 41 +NOTNX, JSR UUOH +TNX, JSYS [UUOH,,UUOH0] ;JSYS IS SUPERIOR TO JSR FOR THIS SORT OF THING +ITS, JSR .JBCNI +DOS, LOC .JBAPR ? TSINT0 +LOC ZZZ ? EXPUNGE ZZZ + +UUOH: 0 ;UUO HANDLER +ITS,[ SKIPE DEBUG + .SUSET [.RJPC,,UUOJPC] +] +NOTNX, JRST UUOH0 + +ITS,[ +IF1 EXPUNGE .JBCNI,.JBTPC ;IN CASE ASSEMBLING ON DEC SYSTEM (BUT FOR USE ON ITS). + +TSINT: +.JBCNI::0 ;INTERRUPT HANDLER +.JBTPC: 0 + SKIPE DEBUG + .SUSET [.RJPC,,INTJPC] + JRST TSINT0 + +CORLUZ: 0 ;FOR FAILING .CBLK'S + JRST CORLZ0 +];ITS + +NOITS,[ +LOSE: 0 ;.VALUE IS REALLY JSR LOSE +NOTNX, JRST LOSE0 +LOSEDD: 0 ;RH OF .JBDDT PUT HERE TO JRST @. +];NOITS + +UUOASV: 0 ;UUO HANDLER SAVES A HERE +UUOBSV: 0 ;UUO HANDLER SAVES B HERE + +INTASV: 0 ;INTERRUPT HANDLER SAVES A HERE +INTBSV: 0 ;INTERRUPT HANDLER SAVES B HERE +ITS,[ +UUOJPC: 0 ;JPC AT UUOH, AFTER UUOS THAT GO THRU SYSTEM (ONLY IN DEBUG MODE). +INTJPC: 0 ;JPC WHEN INTERRUPT HAPPENED (ONLY IN DEBUG MODE). +IF1 EXPUNGE .JBFF ;IN CASE ASSEMBLING ON DEC SYSTEM (BUT FOR USE ON ITS). +.JBFF: .JBFF1 +];ITS + +SUBTTL VARIABLES PERTAINING TO COMMAND SWITCHES + +CODTYP: DFLANG ;TYPE OF INPUT EXPECTED (WHAT LANGUAGE IT'S IN) +COD==:,-1 ;BIT TYPEOUT MASK +CODMID==:0 ;MIDAS CODE (THE DEFAULT) +CODRND==:1 ;RANDOM TEXT (NO SYMBOLS) +CODFAI==:2 ;FAIL CODE +CODP11==:3 ;PALX-11 CODE +CODLSP==:4 ;LISP CODE +CODM10==:5 ;MACRO-10 CODE +CODUCO==:6 ;UCONS CODE +CODTXT==:7 ;TEXT FOR XGP +CODMDL==:10 ;MUDDLE CODE +CODH16==:11 ;H316 CODE +CODMAX==:12 ;1 + + +FAILP: 0 ;NONZERO IFF CODTYP HOLDS CODFAI (FAIL CODE) OR CODM10 (MACRO-10 CODE). +PALX11: 0 ;NONZERO IFF CODTYP HOLDS CODP11 (PALX-11 CODE). +DAPXP: 0 ;NONZERO IFF CODTYP HOLDS CODDAP (DAPX16 CODE). + +LINEL: 0 ;OUTPUT LINE LENGTH +PAGEL: 0 ;OUTPUT PAGE LENGTH, AS SPECIFIED. +PAGEL1: 0 ;PAGE LENGTH, WITH LINES NEEDED FOR CPYRT MSG SUBTRACTED OUT + ;IF CPYRT MSG IS WANTED. EITHER =PAGEL OR =PAGEL-2. +TLINEL: 0 ;LINEL-, I.E. TEXT LINEL +PLINEL: 0 ;MIN(TLINEL-30., 69.) + +TRUNCP: -1 ;POS => TRUNCATE OUTPUT LINES AT RIGHT MARGIN. + ;NEG => CONTINUE THEM. + ;0 => NEITHER (LET THEM RUN ON). + +SINGLE: 0 ;NON-ZERO => ONLY ONE OUTPUT FILE (/S) +PRLSN: 0 ;NON-ZERO => PRINT DEC LSN'S AS PART OF TEXT (/K) +UNIVCT: 0 ;# OF UNIV SYMBOL TABLES (-1 => AFTER EACH FILE) +QUEUE: 0 ;WHETHER AND HOW TO QUEUE FILES FOR OUTPUT. +QU.NO==-1 ;-1 => DON'T QUEUE, FOR XGP OR FOR LPT. +QU.YES==0 ;0 => QUEUE FOR XGP IF /X, QUEUE (VIA TPL: DEFAULT) FOR LPT OTHERWISE. +QU.GLD==1 ;1 => QUEUE FOR GOULD LPT. /X SAYS DON'T USE HARDWARE FONT. +QU.BAD==2 .SEE FPSXGP ;2 - ILLEGAL VALUE FOR QUEUE TO HAVE. +NOTITL: 0 ;NONZERO => NO TITLE PAGE, NO PAGE MAP AND DELETED&PRINTED PAGES LIST. +REALPG: 0 ;NONZERO => ALWAYS PRINT REAL, NOT VIRTUAL, PAGE #S (/Y). +NXFDSP: 0 ;POSITIVE => FORGET ABOUT NONEXISTENT FILES FROM LREC FILE, AFTER ASKING USER. + ;NEGATIVE => DON'T ASK USER, JUST KEEP THE FILES. + ;ZERO => ASK USER, AND IF HE SAYS "GO AHEAD" KEEP THE FILE. +NOCOMP: 0 ;NONZERO => PRINT FULL LISTINGS INSTEAD OF COMPARISON LISTINGS (/-G). +NORENUM:0 ;NONZERO => DON'T GENERATE ANY /'D PAGE NUMBERS OR PAGE NUMBER GAPS (/1G). +SYMTRN: 0 ;NONZERO => IN SYMBOL TABLE, TRUNCATE SYMBOL NAMES TO THIS MANY CHARACTERS. +OLDFL: 0 ;0 => NORMAL LISTING. + ;-1 => NORMAL, BUT NO LISTING OUTPUT FILES - JUST LREC OUTPUT. + ;1 => LREC FILE EDIT MODE. + ;VALUE SET BY /O SWITCH. +DLRFL: 0 ;-1 => CALL DLREC TO WRITE READABLE DESCRIPTION OF INPUT LREC INFO. + +;THESE WORDS EXIST SO THAT WHEN DEFAULT SWITCH VALUES ARE SEEN +;IN AN INPUT LREC FILE, THOSE SWITCHES SPEC'D BY USER (WHICH +;ARE ALL DECODED ALREADY) ARE NOT OVERRIDDEN BY THE SETTINGS +;IN THE LREC FILE. +ETRUNC: 0 ;NONZERO => TRUNCP WAS EXPLICITLY SPEC'D WITH + ;A /T SWITCH. 0 => TRUNCP WAS DEFAULTED. +ELINEL: 0 ;NONZERO => LINEL WAS EXPLICITLY SPEC'D (/W) +EPAGEL: 0 ;NONZERO => PAGEL WAS EXPLICITLY SPEC'D (/V) +ECODTY: 0 ;NONZERO => CODTYP WAS EXPLICITLY SPEC'D (/? OR /L) + ;AFTER RLREC, NONZERO IF EITHER EXPLICITLY SPEC'D OR SET BY RLREC. +EUNIVC: 0 ;NONZERO => UNIVCT WAS EXPLICITLY SPEC'D (/U) +ESINGL: 0 ;NONZERO => SINGLE WAS EXPLICITLY SPEC'S (/S) +EPRLSN: 0 ;NONZERO => PRLSN WAS EXPLICITLY SPEC'D (/K) +ESYMLE: 0 ;NONZERO => SYMLEN WAS EXPLICITLY SPEC'D (/S) +EFNTVS: 0 ;NONZERO IF FNTVSP WAS EXPLICITLY SPEC'D (/V) +EFNTF: 0 ;NONZERO IF FONT FILES WERE EXPLICITLY SPEC'D (/F[]) +EMSWT: 0 ;NONZERO => /M OR /-M WAS SPEC'D FOR SOME FILE. +ECRFF: 0 ;NONZERO => THE NAME OF THE CREF OUTPUT FILE, + ;OR WHETHER THERE OUGHT TO BE ONE, WAS EXPLICITLY SPEC'D (/C[]). +EOUTFIL:0 ;NONZERO => OUTPUT FILE EXPLICITLY SPEC'D (/O[]). +EQUEUE: 0 ;NONZERO => QUEUE WAS EXPLICITLY SPEC'D (/X[NOQUEUE], ETC.). +EREALPG:0 ;NONZERO => REALPG WAS EXPLICITLY SPEC'D (/Y) +ENOTITL:0 ;NONZERO => NOTITL WAS EXPLICITLY SPEC'D (/&). +ENXFDSP:0 ;NONZERO => NXFDSP WAS EXPLICITLY SPEC'D (/!). +ESYMTRN:0 ;NONZERO => SYMTRN WAS EXPLICITLY SPEC'D (/A) + +EF: 0 ;THOSE BITS IN F SPEC'D EXPLICITLY BY SWITCHES + ;ARE 1 IN EF. + +REALF: 0 ;WHAT F HOLDS AFTER RLREC IS CALLED. THIS IS WHAT GETS + ;WRITTEN IN THE LREC OUTPUT FILE AS THE VALUE OF F. + ;IN FACT, F GETS MODIFIED AFTER THAT POINT TO REFLECT + ;OTHER SWITCHES WHICH ARE REALLY REMEMBERED ELSEWHERE. + +SUBTTL DATA AREA BOUNDARIES, SYMTAB INFO. + +PDLLEN: PDLDLN ;DESIRED LENGTH OF PDL SPACE +LRCLEN: LRCDLN ;DESIRED LENGTH OF LRC INFO SPACE +SYMLEN: SYMDLN ;DESIRED LENGTH OF SYMTAB SPACE + ;THESE VARS ARE USED TO DIVIDE MEMORY UP INTO SPACES. + ;ON ITS, CORE IS ALLOCATED FROM BOTTOM OF SPACE UP. + ;ON DEC SYS, ALL OF SPACE IS ALLOCATED AS REAL CORE INITIALLY. +PDLEND: 0 ;ADDRESS OF LAST WORD OF PDL SPACE. +LRCEND: 0 +SYMEND: 0 + +SYMLO: 0 ;ADDRESS OF FIRST SYMBOL TABLE ENTRY +SYMHI: 0 ;ADDRESS OF LAST ENTRY (NOT LAST +1 !!!) +SYMAOB: 0 ;AOBJN POINTER FOR SYMBOL TABLE +LRCPTR: 0 ;PDL POINTER FOR LREC DATA (EXCH WITH DP FOR USE) +SYM%LN: 0 ;SYMS/LINE FOR SYMBOL TABLE LISTING +SYM%PG: 0 ;SYMS/PAGE +SYMSIZ: 0 ;NUMBER OF CHARS PER SYMBOL +TYPSIZ: 0 ;NUMBER OF CHARS FOR TYPE +SYMCNT: 0 ;COUNTER FOR SYMBOLS + +CHS%WD: 0 ;CHARS/WORD (5 FOR ASCII, 6 FOR SIXBIT) +MAXSSZ: 0 ;MAX SYMBOL SIZE (SEE DEFSYM) +MAXTSZ: 0 ;MAX TYPE SIZE + +COLAOB: 0,,COLTAB ;AOBJN POINTER FOR SYMBOL TABLE COLUMNS +COLTAB: BLOCK 10 ;TABLE OF POINTERS FOR COLUMNS + +DEBUG: SITE&ITSFLG ;NONZERO IF DEBUGGING. SET TO 0 BY PURIFY. + ;WHEN NONZERO, SOME THINGS SAVE INFO, AND + ;SOME INCONVENIENT VALRETS ARE SUPPRESSED. + +OLRECA: 0 ;AOBJN POINTER TO CONCATENATED INPUT LISTING RECORD FILES. + ;SET UP BY RLREC, WHICH READS IN THE FILES. + ;THE DATUM POINTED TO IS IN DATA SPACE. + +SUBTTL PASS 1 VARIABLES + +COMC: "; ;COMMENT CHARACTER + +NSYMSF: 0 ;ON PASS 1, THIS VAR COUNTS SYMS DEFINED IN EACH FILE. + ;AFTER FINISHING A FILE, THIS VAR IS COPIED INTO F.NSYM + ;OF THE FILE, AND THEN ZEROED. THIS IS DONE FOR WLREC'S SAKE. + +COMPAR: 0 ;USED BY SORT + +LISPP: 0 ;PDL POINTER SAVED FROM P AT START OF LISP LOOP. + ;^L FORCES A THROW BACK TO THE TOP LEVEL + ;SO THAT THE HEURISTIC READER NEVER SCREWS + ;FOR MORE THAN A PAGE'S WORTH (ASSUMES NO + ;S-EXP IS BROKEN ACROSS A PAGE BOUNDARY). + +1CKSFL: 0 ;EITHER AN INPUT LREC FILE OR AN OUTPUT LREC FILE WAS SPEC'D. + ;IF SET, IT IS NECESSARY TO CHECKSUM THE INPUT FILES, EITHER TO + ;WRITE THE CHECKSUMS IN THE OUTPUT LREC FILE, OR TO + ;COMPARE WITH THE INPUT LREC FILE. + +;THESE 3 WORDS REMEMBER INFO ON STATUS OF THE CHECKSUMMING PROCESS AT THE +;END OF A BUFFERFUL OF INPUT; USED TO INITIALIZE 1CKS FOR THE NEXT BUFFERFULL. +1CKSUM: 0 ;ON PASS 1, IF 1CKSFL IS SET, THE CHECKSUMS OF THE PAGES OF + ;THE INPUT FILES ARE COMPUTED IN THIS WORD. +1CKSIF: 0 ;-1 => IGNORING 1ST NON-NULL LINE OF A PAGE, FOR /L[TEXT] +1CKSNN: 0 ;-1 => HAVEN'T YET FOUND A NON-NULL LINE WHILE IGNORING +1CKSCF: 0 ;-1 => LAST BUFFERFUL ENDED WITH A CR, SO CHECK FIRST + ;CHARACTER OF NEXT ONE FOR BEING A LF. +1CKSNF: 0 ;-1 => LAST BUFFERFUL ENDED LOOKING FOR A LINE NUMBER + ;SO START UP IN THAT MODE ON NEXT BUFFER CHECKSUMMED. +1CKSLN: 0 ;NUMBER OF LINES SO FAR ON PAGE, IN THE CHECKSUMMER. +1CKXAD: 0 ;RETURN ADDRESS IN 1CKXGP OF CALL TO 1CKXGT THAT RAN INTO END OF BUFFER. +1CKXA: 0 ;VALUE OF A SAVED TILL RETURN FROM THAT CALL. + +1FCNT: 0 ;COUNT OF FILES DURING PASS 1 (USED FOR SETTING MULTI) + +PSAVE: 0 ;P AS OF ENTRY TO SOME CODE ANALYZER (WHICH MIGHT + ; GET RUDELY INTERRUPTED AT EOF) + +1MRDFM: 0 ;-1 IF WE ARE IN A .RDEFMAC (AS OPPOSED TO 0 IF .DEFMAC) + +1UCOLC: -1,,. ;CURRENT LOCALITY IN UCONS CODE + + 0 ;FOR USE BY CKLNM, WHEN IT WRAPS AROUND THE BUFFER + ;MUST IMMEDIATELY PRECEDE INBFR!! +INBFR: BLOCK LINBFR+1 ;INPUT BUFFER +LASTIP: 0 +ITS, INBFRW: 0 ;EXTRA BUFFERED INPUT WORD; WE MUST READ AHEAD OF INBFR + ;SO WE CAN TELL WHETHER THE STUFF AT THE END OF INBFR + ;IS AT THE END OF THE FILE. + +SYLBUF: BLOCK LSYLBUF ;SYLLABLE BUFFER - ALSO USED FOR JCL + +MDLFLG: 0 ; NON-ZERO IF THIS IS A MUDDLE PROGRAM. +MDLCMT: 0 ; -1 IF WE'RE INSIDE A MUDDLE COMMENT. + +SUBTTL PASS 2 VARIABLES + +SLBUF: BLOCK LSLBUF ;OUTPUT ("SLURP") BUFFER +XSLBUF==:SLBUF+LSLBUF-200 ;POINT BEYOND WHICH TO OUTPUT +;STRATEGY FOR OUTPUTTING THE MAIN BODY OF A LISTING IS TO LEAVE NTABS*8 CHARS OF SPACE +;AT THE FRONT OF EVERY LINE; WHEN THE LINE IS DONE, OUTLIN FILLS UP THAT SPACE +;WITH DIGITS OR WITH BLANKS. 2OUTBF/2OUTPJ MUST NOT BE DONE IN THE INTERVAL BETWEEN +;THOSE TWO ACTIONS, OR SPACE MIGHT BE OUTPUT FULL OF GARBAGE. + +RINCR: 0 ;THESE 2 WORDS ARE USED FOR INCREMENTING SP BY 8*NTABS CHARS +LINCR: 0 ;SET UP AT 2START; USED AT OUTL5A. +LASTSP: 0 ;WHEN SPACE HAS BEEN LEFT FOR REFS, LASTSP POINTS AT START OF THAT SPACE. +THISSP: 0 ;POINTS AT END OF SPACE LEFT FOR REFS (START OF LINE'S TEXT) +SUBTSP: 0 ;IF WE HAVE JUST WRITTEN A SUBTITLE OR NON-TEXT 1ST LINE OF A REAL PAGE, + ;SUBTSP POINTS AT THE FRONT OF IT, SO THAT 2SUBFL CAN BACK UP OVER IT. + ;CLEARED BY OUTLIN, SAYING NO LONGER OUGHT TO BE FLUSHED. + +OUTVP: 0 ;ON PASS 2, NUMBER OF OUTPUT LINES IN CURRENT PAGE. + ;OUTVP INCLUDES CONTINUATION LINES, WHILE RH(N) DOES NOT. + ;THE SUBPAGE NUMBER IS OUTVP/PAGEL1. + ;(FOR EXAMPLE, WE'RE ON A CONTINUATION PAGE IF OUTVP > PAGEL1). +OUTPAG: 0 ;NUMBER OF FORM FEEDS IN THE CURRENT OUTPUT FILE +2MCCOL: -1 ;DURING PASS 2, -1 IF NOT PROCESSING COMMENT. + ;WITHIN COMMENT, HOLDS THE HPOS AFTER THE ";" THAT BEGAN COMMENT. + ;USED TO CONTROL LINE-CONTINUATION. +CONTIN: 0 ;-1 WHILE HANDLING A CONTINUATION LINE. + ;SERVES TO SUPPRESS THE LINE NUMBER ON IT + +UNDRLN: 0 ;-1 IF IN MIDDLE OF AN UNDERLINE IN XGP OUTPUT. +FFSUPR: 0 ;-1 => INHIBIT ^L BEFORE NEXT PAGE (SET BEFORE 1ST PAGE IF NO TITLE PAGE) +TXTIGN: 0 ;-1 => 2TEXT READING AN XGP COMMAND, SO ^L'S DON'T COUNT AS PAGE BREAKS. +LFNBEG: 0 ;CONTENTS OF N AT START OF LAST TOP-LEVEL SEXP, FOR LISP AND UCONS. + +LSYL: 0 ;SYMBOL TABLE ENTRY OF LAST REF ON LINE. +LSYL2: 0 ;OTHER LAST REFERENCE (FOR PDP-11 CODE) +LSYL1P: 0 ;DURING OUTLIN, -1 WHILE OUTPUTTING THE FIRST REF + ;WHEN THERE ARE TWO PER LINE. + +2PUTX: 0 ;JFCL FOR TRUNCP 0; CAIGE CC, FOR TRUNCP NOT 0 +2PUTNX: 0 ;CAIA FOR TRUNCP 0; CAIL CC, FOR TRUNCP NOT 0 +2PUTTC: .VALUE ;CAIA IF TRUNCATING; PUSHJ P,2PUTNL IF CONTINUING. +NTABS: 0 ;NUMBER OF TABS IT WOULD TAKE TO EQUAL WIDTH OF REFS AT FRONT OF LINE. +LOOKIT: 0 .SEE LOOK,NLOOK ;ADDRESS OF SYMBOL-LOOKUP ROUTINE. +SLURPX: 0 .SEE SLURP,XSLURP ;USUAL CHAR GOBBLING ROUTINE FOR CURRENT FILE (PASS 2) + ;XSLURP IF NOT LISTING, SLURP IF LISTING. +SLURPY: 0 .SEE SLURP,XSLURP ;INSTANTANEOUS CHAR GOBBLING ROUTINE. + ;NORMALLY SAME AS SLURPX, BUT IN COMPARISON + ;LISTINGS, ON PAGES THAT ARE NOT BEING OUTPUT, + ;SLURPY ALWAYS POINTS TO XSLURP. ALSO, ON A PAGE + ;WHOSE NUMBER IS LESS THAN PAGMIN, SLURPY POINTS + ;TO XSLURP. + +PAGTPT: 0 ;ON PASS 2, POINTS TO PAGE TABLE OF CURRENT FILE. + ;POINTER IS 0 TO LIST EACH PAGE WITH ITS REAL NUMBER. + ;A PAGE TABLE CONSISTS OF TWO-WORD ENTRIES, ONE + ;FOR EACH PAGE OF THE FILE. THE FIRST IS A + ;CHECKSUM FOR THE PAGE. THE SECOND WORD'S LH + ;HOLDS THE LINE-NUMBER OFFSET (THE "NUMBER" + ;FOR LISTING PURPOSES OF THE FIRST LINE ON THE + ;PAGE) AFTER CPRL, OR IN OLD PAGE TABLES; + ;BEFORE CPRL, IT HOLDS THE NUMBER OF LINES ON + ;THE PAGE. THE RH HAS THE FOLLOWING: +NEWPAG==:400000 ;2.9 => THIS PAGE NEEDS RELISTING (CPR + ;SETS THESE BITS) +MAJPAG==:071200 ;B.P. TO MAJOR PAGE # FIELD. +MINPAG==:000700 ;B.P. TO MINOR PAGE # FIELD. + +PAGMIN: 0 ;ON PASS 2, HOLDS CURRENT FILE'S F.MINP = LOWEST # PAGE + ;THAT SHOULD BE PRINTED. USED FOR RESTARTING A PARTIALLY + ;PRINTED LISTING (SEE "P" SWITCH). + +LNDFIL: 0 ;NON-ZERO IF CURRENT INPUT FILE HAS SOS LINE NUMBER +ETVFIL: 0 ;NON-ZERO IF FILE HAS ETV DIRECTORY. + +$DAY: 0 ; FOR PTDATE +$MONTH: 0 +$YEAR: 0 + +FQUOTF: 0 ;NONZERO TO ENABLE QUOTING OF SPECIAL CHARACTERS IN FILOUT. + +SUBTTL DEC VERSION I-O BUFFERS, HEADERS, OPEN AND LOOKUP BLOCKS, ETC. + +NOITS,[ +INHED: BLOCK 3 +OUTHED: BLOCK 3 + +CMU,IFNDEF NBFRS,NBFRS==:7 ;The KL-10 at CMU-10A is disk bound +IFNDEF NBFRS,NBFRS==:2 +BFRLEN==:203 ;magic size for disk buffers +INBFR2: BLOCK BFRLEN*NBFRS +OUTBFR: BLOCK BFRLEN*NBFRS + +INCHN: BLOCK 3-1 + INHED +OUTCHN: BLOCK 3-1 + OUTHED,,0 +INSCHN: BLOCK 3 +RNMCHN: BLOCK 3 +DELCHN: BLOCK 3 + +.RBPPN==:1 ;POSITION OF PPN IN EXTENDED LOOKUP TABLE +.RBNAM==:2 ;POSITION OF NAME 1 IN EXTENDED LOOKUP TABLE +.RBEXT==:3 ;POSITION OF NAME 2 IN EXTENDED LOOKUP TABLE +.RBERR==:3 ;POSITION OF ERROR CODE (IN RIGHT HALF) +.RBPRV==:4 ;PROTECTION, MODE, CREATION TIME AND DATE +.RBSIZ==:5 ;POSITION OF FILE LENGTH IN EXTENDED LOOKUP TABLE +.RBDEV==:16 ;POSITION OF DEVICE IN EXTENDED LOOKUP TABLE + +EXTLEN==:20 +IFG .RBDEV-EXTLEN+1, .ERR EXTLEN IS TOO SMALL + +INFIL: .RBDEV ;ENOUGH TO GET THE DEVICE! + BLOCK EXTLEN-1 +OUFIL: .RBDEV + BLOCK EXTLEN-1 +INSFIL: .RBDEV + BLOCK EXTLEN-1 +RNMFIL: .RBDEV + BLOCK EXTLEN-1 +DELFIL: .RBEXT ;WE ONLY NEED THE FILE NAME SPEC + BLOCK EXTLEN-1 + +IFN OUFIL-INFIL->, .ERR OUFIL PLACED WRONG FOR FLOSE +IFN INSFIL-INFIL->, .ERR INSFIL PLACED WRONG FOR FLOSE + +NOSAI,[ +.DCNAM==:0 ;POSITION OF DEV NAME FOR DSKCHR +.DCSNM==:4 ;POSITION OF STRUCTURE NAME FOR DSKCHR + +STRINF: BLOCK 1+.DCSNM +];NOSAI + +];NOITS + +SAI,[ ;IF /X[QUEUE], WE ACCUMULATE AN XSPOOL COMMAND IN THIS BUFFER +QUEBUF: BLOCK QUEBFL ;AND PTYLOAD IT ALL AT ONCE WHEN WE EXIT. +QUEBFE: BLOCK 10 +QUEBFP: 440700,,QUEBUF ;POINTER TO STUFF QUEBUF. + +QUEARG: 0 ;PTYLOAD ARGUMENT BLOCK. + QUEBUF +];SAI + +SUBTTL FORMAT OF EACH FILE BLOCK + +F.==:,-1 ;MASK FOR BIT TYPEOUT MODE. + +F.ISNM==:0 ;INPUT SNAME +F.IDEV==:1 ;INPUT DEVICE +F.IFN1==:2 ;INPUT FILE NAME 1 +F.IFN2==:3 ;INPUT FILE NAME 2. IF DEC SYSTEM, ONLY LH IS MEANINGFUL, BUT + ;A NULL EXTENSION SETS RH TO 1 TO INHIBIT DEFAULTING. + ;FPDEF SETS THE RH BACK TO 0 AGAIN. +F.OSNM==:4 ;OUTPUT SNAME - ZERO IF FILE NOT TO BE PRINTED +F.ODEV==:5 ;OUTPUT DEVICE +F.OFN1==:6 ;OUTPUT FILE NAME 1 +F.OFN2==:7 ;OUTPUT FILE NAME 2 +F.RSNM==:10 ;.RCHST'D INPUT SNAME ;USE THESE +F.RDEV==:11 ;.RCHST'D INPUT DEVICE ; NAMES WHEN +F.RFN1==:12 ;.RCHST'D INPUT FILE NAME 1 ; PRINTING OUT +F.RFN2==:13 ;.RCHST'D INPUT FILE NAME 2 ; FILE ID'S +F.PAGT==:14 ;AOBJN PTR TO PAGE TABLE (IN LREC DATA AREA) +F.SWIT==:15 ;SWITCH WORD FOR FILE (COPY INTO F WHEN HACK THE FILE) +F.OLRC==:16 ;POINTER TO LISTING RECORD INPUT INFO FOR + ; THIS FILE. 0 IF NO SUCH INPUT (SET BY MLREC) +F.NPGS==:17 ;NUMBER OF PAGES IN THIS FILE (SET ON PASS 1) +F.NSYM==:20 ;# SYMBOLS IN FILE (SET ON PASS 1) +F.MINP==:21 ;# OF 1ST PAGE THAT SHOULD BE PRINTED - USED FOR + ; RESTARTING PARTIALLY PRINTED LISTINGS. SET BY P SWITCH. +F.OPGT==:22 ;AOBJN POINTER TO OLD PAGE TABLE (IN DATA AREA). + ;(PART OF WHAT F.OLRC POINTS TO). + ;SET UP BY CPRFF, USED BY CPRA, ETC. + ;NOTE: CPRFP CLOBBERS 2ND WORDS OF UNREPLACED OLD PAGES + ;TO <0 or NEW PAGE TABLE ENTRY ADDR>,,. THIS SCREWS DLREC. +F.OSMT==:23 ;AOBJN TO OLD SYM TABLE (IN DATA AREA) + ;(AGAIN, A SUBENTRY OF WHAT F.OLRC POINTS TO). +F.CRDT==:24 ;FILE CREATION DATE, IN SYSTEM-DEPENDENT FORMAT. + ;ON ITS, IT USES RQDATE FORMAT. ON BOTS-10, + ;THE LH IS THE DATE, AND THE RH IS THE TIME IN MINUTES PAST MIDNIGHT. +F.OCRD==:25 ;SIMILAR CREATION DATE FOR COMPARISON FILE + +LFBLOK==:26 + +LFILE: 0 ;LENGTH OF CURRENT INPUT FILE, OR 377777,,-1 IF UNKNOWN. + ;SET TO -1 WHEN EOF REACHED. +LFILES: 0 ;TOTAL LENGTH OF ALL FILES +SFILE: 0 ;POINTS TO AFTER LAST SPECIFIED FILE +CFILE: 0 ;POINTS TO CURRENT FILE BLOCK +OFILE: 0 ;ON PASS 2, 0 => NO FILE OPEN, + ;ELSE -> FILEBLOCK HOLDING NAMES OF OPEN OUTPUT FILE. +MULTI: 0 ;-1 => MORE THAN ONE INPUT FILE BEING PROCESSED (NOT NECESSARILY LISTED) + +FILES: BLOCK LFBLOK ;BLOCKS OF FILE SPECS (SHOULD BE ENOUGH) +REPEAT NFILES-1, CONC FIL,\.RPCNT+1,: BLOCK LFBLOK +EFILES: 0 + +FILSRT: BLOCK NFILES ;ADDRESSES OF ALL INPUT FILES SCANNED, ALPHABETICAL BY FILENAMES. +FISORF: 0 ;IF -1, REALLY SORT THEM. IF 0, DON'T SORT - LEAVE IN LREC FILE ORDER. + +DLRECF: BLOCK 2 ;FILE NAMES FOR /_ SWITCH OUTPUT (DLREC). +ITS, SIXBIT /DLREC >/ +NOITS, SIXBIT /DLREC LST/ + +SUBTTL FILE VARIABLES AND OTHERS + +WLRECP: 0 ;NON-ZERO => POINTER TO FILE BLOCK FOR LREC OUTPUT +RLRECP: 0 ;NON-ZERO => POINTER TO AN LREC FILE THAT WAS READ IN + +OTFSNM: 0 +OTFDEV: 0 +OTFFN1: SIXBIT \_@_\ +OTFFN2: SIXBIT \OUTPUT\ + +INSSNM: 0 ;INSERTED FILE'S SNAME +INSDEV: 0 ;DEVICE +INSFN1: 0 ;FILE NAME 1 +INSFN2: 0 ;FILE NAME 2 +INSSWT: 0 ;DESIRED F.SWIT SETTING. + +FNTSPC: 0 ;-1 IF FONTS HAVE BEEN SPEC'D (EXPLICITLY OR THROUGH /G). +FNTVSP: VSPNRM ;THE VERTICAL SPACING FOR THE XGP TO USE (SCRIMP'S VSP PARAMETER). +FNTWID: 0 ;THE WIDTH OF THE WIDEST FONT, IN FNTCPT +FNTWDN: 0 ;WIDTH OF THE FONT BEING USED FOR #S AT THE LEFT MARGIN, IN FNTCPT +FNTHGT: 0 ;THE HEIGHT OF THE HIGHEST FONT, IN FNTCPT +FNTBAS: 0 ;BASELINE OF THE FONT WHOSE BASELINE IS LARGEST. + +FNTF0: OFFSET -. ;TABLE OF FONT FILES. DON'T ADD ANY WORDS - SEE LR.FNT. +FNTSNM::0 ;FILENAMES OF FONT ... +FNTDEV::0 +FNTFN1::0 +FNTFN2::0 +FNTSIZ::0 ;*512.+,, OF FONT. +FNTEXP::0 ;-1 => FONT EXPLICITLY SPEC'D; OVERRIDE /G. +FNTFL:: OFFSET 0 + BLOCK FNTFL* +FNTFE: BLOCK FNTFL ;EXTRA SPACE CLOBBERED BY FPSFND WHEN USER GIVES TOO MANY FONTS. + +CRFFIL:: ;THESE 4 WORDS ARE THE NAMES OF THE FILE FOR CREF AND UNIV SYM +CRFSNM: 0 ;OUTPUT, IF THERE IS ONE. +CRFDEV: 0 ;THE NAMES IN THESE WORDS ARE AS SPEC'D OR READ FROM LREC FILE; +CRFFN1: 0 ;NOT YET DEFAULTED. +CRFFN2: 0 +CRFOFL: 0 ;-1 => CREF & UNIV SYM TABS GO IN A SEPARATE FILE + ;(WHOSE NAMES ARE IN THE ABOVE 4 WORDS). + +CRRFIL:: +CRRSNM: 0 ;THESE 4 WORDS HOLD THE FULLY DEFAULTED CREF OUTPUT FILE NAMES. +CRRDEV: 0 +CRRFN1: 0 +CRRFN2: 0 + +OUTFIL:: ;OUTPUT FILE SPEC FROM JCL OR LREC FILE (/O) +OUTSNM: 0 +OUTDEV: 0 +OUTFN1: 0 +OUTFN2: 0 + +ODEFSW: 0 ;REMEMBERS FSNSMT SETTING AT END OF COMMAND STRING + ;(= DEFAULT SETTING FOR .INSRT'ED FILES) + +MACHINE: SITNAM ;SIXBIT NAME OF SITE +MSNAME: 0 ;ULTIMATE DEFAULT SNAME. + +CHSTAT: BLOCK 6 ;FOR .RCHST + +FPNTBP: 0 ;FILENAME COUNTER IN FILENAME READER (SORT OF) +FPSSBP: 0 ;DURING PROCESING OF A COMMAND SWITCH, THIS HOLDS B.P. TO + ;BEGINNING OF SWITCH, FOR USE IN ERROR MESSAGE PRINTOUTS. +DOS, FPPNBP: 0 ;Similar during parsing of PPNs + +DOS, SYSBUF: BLOCK 10 ;Buffer for printing system name +CMU, PPNBUF=:SYSBUF ;Buffer for converting special CMU PPNs + +SUBTTL SUBTTL AND QOPYRIGHT MESSAGE VARIABLES + +;;; LINKED LIST OF SUBTITLE INFORMATION. +;;; SUBTITLES ARE ACCUMULATED ON PASS 1 AS A LINKED LIST IN REVERSE +;;; ORDER OF APPEARANCE. SBSORT USES THE NREVERSE MACRO TO +;;; PUT THE LIST IN FORWARD ORDER FOR OUTLEP AND SUBOUT ON PASS 2. +;;; EACH SUBTITLE NODE LOOKS LIKE THIS: +;;; ,, ;OPTIONAL +;;; NODE: -<# CHARS>,, +;;; ,, +;;; ... WORDS OF ASCII ... + +SUBTLS: 0 ;LINKED LIST OF SUBTITLES +SUBLEN: 0 ;POSITIVE MAX OVER LENGTHS OF ALL SUBTITLES +SUBPTR: 0 ;POINTER INTO SUBTLS FOR OUTLEP + + +;;; LINKED LIST OF @DEFINE'D SYMBOLS FOR LISP CODE OR .DEFMAC'D SYMBOLS +;;; FOR MIDAS CODE. +;;; FORMAT OF LIST FOR LISP CODE: +;;; NODE: ,, +;;; ,, +;;; WHERE SOMEWHERE IN THE DATA AREA ARE: +;;; SYMBOL: -<# CHARS>,, +;;; AND SIMILARLY FOR TYPE. +;;; +;;; MIDAS HAS SAME FORMAT, BUT IS (SEE BELOWO) AND SYMBOL +;;; HAS USUAL MIDAS FORM. + +ADEFLS: 0 ;LINKED LIST OF @DEFINE CRUD + +;;; FLAGS IN + +%ASRDF==1 ;APPEARED IN .RDEFMAC + +;;; COPYRIGHT MESSAGE - PRINTED AT BOTTOM OF EACH PAGE IF Q SWITCH SPECIFIED. +;;; NULLS (^@ = ASCII 0) IN THE STRING ARE IGNORED. + +CPYMSG: ASCII \ + +(\ + ASCII \c) Co\ + ASCII \pyrig\ + ASCII \ht 19\ +CPYDAT: ASCII \xx\ +ITS, ASCII \ Massachusetts Institute of Technology\ + +SAI, ASCII \ Leland Stanford Jr. University\ + +CMU, ASCII \ Carnegie-Mellon University\ + + ASCII \. All rights reserved.\ +REPEAT CPYMSG+30-., 0 +LCPYMS==:.-CPYMSG +CPYBP==:440700,,CPYDAT ;BYTE POINTER FOR SETTING DATE IN MSG + +PTLO==. ;SOME IMPURE CODE COMES LATER ON IN THE PROGRAM +IFE TWOSEG, .==.+50 ;UNLESS WE HAVE A SEPARATE HI SEGMENT, MAKE SURE WE LEAVE SOME ROOM FOR IT +IF2 IFGE IMPTOP-PURBOT, .ERR NOT ENOUGH ROOM LEFT FOR REST OF IMPURE CODE + +;NOW SWITCH TO THE PURE CODE AREA +ITS, LOC <.+1777>&776000 +IFN TWOSEG, LOC RL0+400000 +PURBOT:: + +SUBTTL VARIOUS DEFAULT 2ND FILENAMES. + +ITS,[ +IPTFN2: SIXBIT/>/ +OPTFN2: SIXBIT/@/ +XGPFN2: SIXBIT/@XGP/ +LRCFN2: SIXBIT/LREC/ +ALRFN2: SIXBIT/>/ +OLRFN2: SIXBIT/OLREC/ +FNDFN2: SIXBIT/KST/ +CRDFN2: SIXBIT/@CREF/ +];ITS +NOITS,[ +IPTFN2: OFFSET -. +CODMID:: SIXBIT /MID/ +CODRND:: 0 +CODFAI:: SIXBIT /FAI/ +CODP11:: NOSAI,SIXBIT /M11/ + SAI,SIXBIT /PAL/ +CODLSP:: SIXBIT /LSP/ +CODM10:: SIXBIT /MAC/ +CODUCO:: 0 +SAI,CODTXT::SIXBIT /XGP/ +CMU,CODTXT::SIXBIT /XGO/ +DEC,CODTXT::0 +TNX,CODTXT::0 +CODMDL:: SIXBIT/MDL/ +CODH16:: SIXBIT/H16/ +CODMAX:: OFFSET 0 + +OPTFN2: SIXBIT/LST/ +LRCFN2: SIXBIT/LRC/ +ALRFN2: 0 +OLRFN2: SIXBIT/OLR/ +CRDFN2: SIXBIT/ATC/ +DEC,[ +XGPFN2: SIXBIT/ATX/ +FNDFN2: SIXBIT/KST/ +];DEC +CMU,[ +XGPFN2: SIXBIT/XGO/ +FNDFN2: SIXBIT/KST/ +];CMU +SAI,[ +XGPFN2: SIXBIT/XGP/ +FNDFN2: SIXBIT/FNT/ +];SAI +];NOITS + +SUBTTL UUO HANDLER + +UUOH0: MOVEM A,UUOASV + MOVEM B,UUOBSV + LDB A,[331100,,40] + CAIG A,UUOMAX + JUMPN A,@UUOTBL-1(A) +BADUUO: .VALUE + JRST BADUUO + +UUOTBL: STRT0 + 6TYP0 + FLOSE0 + FLOSE0 + TYPNM0 +IFN .-UUOTBL-UUOMAX, .ERR WRONG NUMBER OF UUO'S DEFINED + +6TYP0: MOVE B,@40 +6TYP1: SETZ A, + LSHC A,6 + ADDI A,40 + TYO A + JUMPN B,6TYP1 +UUORET: MOVE B,UUOBSV + MOVE A,UUOASV + JRST 2,@UUOH + +STRT0: HRRZ B,40 + HRLI B,440700 +STRT1: ILDB A,B + JUMPE A,UUORET + TYO A + JRST STRT1 + +TYPNM0: EXCH C,40 + MOVE A,(C) ;GET NUMBER TO TYPE + LSH C,-27 ;GET RADIX + ANDI C,17 + PUSHJ P,TYPNM1 + MOVE C,40 + JRST UUORET + +TYPNM1: IDIVI A,(C) + HRLM B,(P) + CAIE A,0 + PUSHJ P,TYPNM1 + HLRZ A,(P) + ADDI A,"0 + TYO A + POPJ P, + +FLOSE0: ;FLOSE AND FLOSEI UUOS. +INSIRP PUSH P,UUOASV UUOBSV CC CH CP L IP +ITS, PUSH P,UUOJPC + PUSH P,UUOH ;MUST END UP AT -1(P) + PUSH P,40 ;MUST END UP AT (P) + HRRZ A,@-1(P) ;GET ERROR RETURN ADDRESS. +ITS, .SUSET [.RAPRC,,B] ;IF WE HAVE BEEN DISOWNED, +ITS, JUMPL B,FLOSE6 ;ACT AS IF USER HAD FORCED NO RETRY. + HRRZ A,40 + TYO [^M] + TYO [^J] + 6TYP 1(A) ;PRINT NAME OF FILE WE WERE TRYING TO OPEN. + TYO [":] +ITS, 6TYP (A) +ITS, TYO [";] + 6TYP 2(A) +ITS, TYO [" ] +NOITS, TYO [".] + 6TYP 3(A) +DOS,[ SKIPN B,(A) + JRST FLOSE7 + TYO ["[] ;] +SAI,[ PUSH P,B ;SAIL PPN'S ARE TWO HALFWORDS OF RIGHT-JUSTIFIED 6BIT. + ANDCMI B,-1 + PUSHJ P,FLOSES + TYO [",] + POP P,B + HRLZS B + PUSHJ P,FLOSES + JRST FLOSRB + +FLOSES: ;PRINT RIGHT-JUSTIFIED SIXBIT, SANS LEADING SPACES. + JUMPE B,CPOPJ + SETZ A, + LSHC A,6 + JUMPE A,.-1 + ADDI A,40 + OUTCHR A + JRST FLOSES +];SAI +NOSAI,[ + JUMPL B,[6TYP (A) ;DEC OR CMU => NEGATIVE => PRINT AS SIXBIT. + JRST FLOSRB] +CMU,[ MOVE A,[B,,PPNBUF] ;CMU => POSITIVE => FUNNY CMU PPN. + DECCMU A, + JRST FLOSOC + OUTSTR PPNBUF + JRST FLOSRB +FLOSOC: +];CMU + HLRZ L,B ;DEC => POSITIVE => PRINT HALFORDS NUMERICALLY. + TYPNUM 8.,L + TYO [",] + HRRZI L,(B) + TYPNUM 8.,L +];NOSAI ;[ +FLOSRB: TYO ["]] +];DOS +FLOSE7: TYO [" ] + DROPTHRUTO FLOS10 + +;DROPS THROUGH +;PRINT MESSAGE DESCRIBING TYPE OF ERROR. +;IF OPCODE IS FLOSEI, AC FIELD IS INTERNAL ERROR CODE. +;OTHERWISE, IT IS CHANNEL NUMBER; +;USE THE ERROR CODE RETURNED BY SYSTEM CALL. +FLOS10: LDB A,[331100,,(P)] ;GET THE OPCODE. + CAIE A,FLOSEI_-33 + JRST FLOSE8 ;IT'S FLOSE. + LDB A,[270400,,(P)] ;IT'S FLOSEI - GET AC FIELD. + JUMPE A,FLOSE3 ;ZERO IS SPECIAL -- JUST PRINT FILENAME + CAIGE A,FLOSSL + SKIPN FLOSST-1(A) ;NON-EXISTENT INTERNAL ERROR CODE? + .VALUE + STRT @FLOSST-1(A) ;TYPE THE ERROR MESSAGE. + JRST FLOSE9 + +FLOSST: OFFSET 1-. +FLSNLR::[ASCIZ /Not an LREC file/] +FLSFNT::[ASCIZ /Font file not in known format (KST or FNT)/] +FLSOIN::[ASCIZ /Input file is an @ output file/] +FLOSSL::OFFSET 0 + + +FLOSE8: +ITS,[ .OPEN ERRC,[SIXBIT \ ERR ! \] + .VALUE +FLOSE1: .IOT ERRC,A + CAIE A,^M + CAIN A,^L + JRST FLOSE2 + TYO A + JRST FLOSE1 +FLOSE2: .CLOSE ERRC, +];ITS +NOITS,[ LGEXTL==:.TZ EXTLEN ;LOG EXTLEN +IFN <1_LGEXTL>-EXTLEN, .ERR LGEXTL NOT = LOG(EXTLEN) +IFG LGEXTL-5, .ERR LGEXTL TOO BIG FOR THE LDB HACK USED HERE + LDB A,[<<4+LGEXTL>_6>+<<27-LGEXTL>_14>,,(P)] ;GET EXTLEN*AC FROM 40 + HRRE A,INFIL-+.RBERR(A) + AOJE A,FLOSE2 + STRT [ASCIZ/Error /] + HRRZI L,-1(A) + TYPNUM 8.,L + TYO [":] + TYO [" ] + CAIL A,0 + CAILE A,MAXERR + SETO A, +FLOSE2: STRT @ERRMSG(A) +];NOITS +;COME HERE AFTER PRINTING ERROR MESSAGE. +FLOSE9: STRT [ASCIZ/ +Use what filename instead? /] + PUSHJ P,TTIL ;READ A LINE OF TYPE-IN. + HRRZ L,(P) + MOVE IP,[440700,,SYLBUF] ;PREPARE TO READ THAT INPUT. + LDB CH,[350700,,SYLBUF] + CAIN CH,^M ;IF THE LINE IS NULL, TRY TO DO WITHOUT THE FILE. + JRST FLOSE5 + PUSHJ P,FPFILE ;OTHERWISE PARSE AS FILESPEC. +REPEAT 2, SOS -1(P) ;AND BACK UP THE PC TO 1 BEFORE THE FLOSE + JRST FLOSE3 + +FLOSE5: HRRZ A,@-1(P) + CAIE A,ERRDIE + JRST FLOSE6 + STRT [ASCIZ/Can't do without this file./] + JRST FLOSE9 + +FLOSE6: HRRM A,-1(P) ;CHANGE THE OLD PC +FLOSE3: POP P,40 + POP P,UUOH +ITS, POP P,UUOJPC +INSIRP POP P,IP L CP CH CC UUOBSV UUOASV + JRST UUORET + +NOITS,[ [ASCIZ/(Unknown error code)/] +ERRMSG: [ASCIZ/OPEN failed -- bad device specified?/] + [ASCIZ/File not found/] + [ASCIZ/No UFD for the specified PPN/] + [ASCIZ/Protection failure or DECtape directory full/] + [ASCIZ/File currently being modified/] + [ASCIZ/File already exists/] + BADERR + [ASCIZ/UFD transmission error/] +REPEAT 13-7+1, BADERR + [ASCIZ/Structure full or quota exceeded/] + [ASCIZ/Write lock error/] + [ASCIZ/Not enough monitor table space/] + [ASCIZ/Partial allocation only/] + [ASCIZ/Block not free on allocated position/] + [ASCIZ/Cannot supersede an existing directory/] + [ASCIZ/Cannot delete a non-empty directory/] + [ASCIZ/Sub-directory not found/] + [ASCIZ/Empty search list/] + BADERR + [ASCIZ/Can't find a DSK to write/] + BADERR +MAXERR==:.-ERRMSG-2 +BADERR: ASCIZ/"Impossible" error (you shouldn't be seeing this message)/ + +LOSE0: OUTSTR [ASCIZ/Unexpected error at location /] + PUSH P,LOSE + SOS LOSE + HRRZS LOSE + TYPNUM 8.,LOSE + POP P,LOSE + OUTSTR [ASCIZ/ +/] +LOSE3: SKIPE .JBDDT + SKIPN DEBUG + JRST LOSE1 + OUTSTR [ASCIZ /Entering DDT! +/] + EXCH A,LOSE + MOVEM A,.JBOPC + HRRZ A,.JBDDT + MOVEM A,LOSEDD + MOVE A,LOSE + JRST @LOSEDD + +LOSE1: EXIT 1, + JRST 2,@LOSE + +G: JRST @.JBOPC ;FOR RESTARTING FROM DDT +];NOITS + +SUBTTL GOBBLE ONE LINE FROM TTY + +TTILA: +ITS, TYO ["@] ;PROMPT AND READ A LINE. +CMU, TYO ["@] +NOCMU,DOS, TYO ["*];USE * SINCE IT IS CONVENTIONAL AND @ IS A SCREW ON TENEX! + +;READ A LINE FROM THE TTY, DOING RUBOUT PROCESSING. +;DO A RETURN BACK TO THE CALLING PUSHJ IF THE WHOLE LINE IS RUBBED OUT. +;THE LINE GOES IN SYLBUF, TERMINATED BY A CR. +TTIL: MOVE CP,[440700,,SYLBUF] ;BP -> START OF BUFFER. + SETZM IP ;0 CHARS READ SO FAR. +TTIL1: TYI CH ;READ NEXT CHAR. + CAIN CH,^U ;CHECK FOR SPECIAL RUBOUT-PROC. CHARS. + JRST TTILX ;^U => CANCEL WHOLE LINE. + CAIN CH,177 + JRST TTILRB ;RUBOUT => CANCEL LAST CHAR. + CAIN CH,^L + JRST TTIL1 + IDPB CH,CP ;ELSE PUT CHAR IN BUFFER. + AOS IP + CAIE CH,^C ;^C AND ^Z TURN INTO CR. + CAIN CH,^Z + JRST [TYO [^M] + TYO [^J] + JRST TTICM2] + CAIE CH,^M ;THEY AND CR TERMINATE THE LINE. + JRST TTIL1 ;OTHER CHARS => KEEP READING. +NOITS, TYI CH ; NOITS, PICK UP THE THAT FOLLOWS A +TTICM2: MOVEI CH,^M ;LINE WAS TERMINATED, PUT ^M AT END OF BUFFER. + IDPB CH,CP + POPJ P, + +TTILRB: SKIPN IP ;RUBOUT IF NO CHARS TO RUB + JRST TTILX ;IS SAME AS ^U (IE SHOULD RE-PROMPT) + SOS IP ;ONE CHAR NOW GONE. + LDB CH,CP + TYO CH ;TYPE THE CANCELED CHARACTER. + DBP7 CP + JRST TTIL1 ;GO ON READING. + +TTILX: TYO [^M] ;COME HERE FOR ^U, OR RUBOUT WITH EMPTY BUFFER. + TYO [^J] + SOS (P) ;RETURN TO THE PUSHJ WHICH CALLED TTIL OR TTILA. + POPJ P, + +SUBTTL PDL OVERFLOW INTERRUPT HANDLER + +TSINT0: MOVEM A,INTASV + MOVEM B,INTBSV + SKIPL A,.JBCNI + TRNN A,200000 ;ONLY INTERESTED IN PDL OVERFLOW + .VALUE + HRRZ A,.JBTPC + LDB A,[270400,,-1(A)] +PDLCHK: HRRZ B,(A) + CAIE A,P + CAIN A,SP + JRST PDLNPG + CAIE A,DP + .VALUE ;WHAT THE HELL? + AOJ B, + CAME B,.JBFF ;TRYING TO EXTEND CORE? + SOJA B,PDLNPG +IFN TWOSEG, CAILE B,377777 +IFE TWOSEG, CAILE B,777777 + SOJA B,PDLFUL +ITS,[ TLO B,11001 + LSH B,-1 + .CBLK B, + JSR CORLUZ + MOVEI B,2000 +];ITS +DOS,[ CORE B, + JRST [ STRT [ASCIZ/Unable to get more core. +Type CONTINUE to try again. +/] + EXIT 1, + JRST PDLCHK ] + HRRZ B,.JBREL ;TAKE ALL THE CORE THAT WE HAVE + SUB B,(A) +];DOS + CAMN DP,LRCEND ;IF WE OVERFLOWED THE LRC AREA + ADDM B,LRCEND ;THEN NOTE THAT FACT + ADDM B,.JBFF + MOVNI B,(B) +TSINTF: HRLM B,(A) +TSINTX: MOVE B,INTBSV + MOVE A,INTASV + .DISMISS .JBTPC + +;COME HERE FOR PDL OVERFLOW NOT AT TOP OF USED CORE. +PDLNPG: CAME B,PDLEND ;ARE WE TRYING TO EXPAND A SPACE PAST ITS TOP? + CAMN B,SYMEND + JRST PDLFUL ;IF SO, ABORT THE LISTING. + CAMN B,LRCEND + JRST PDLFUL +DOS, .VALUE +ITS,[ ADDI B,1 ;ON I.T.S., SPACES DON'T HAVE ALL THEIR CORE + TLO B,11001 ;SO MAYBE A SPACE JUST WANTS ANOTHER PAGE. + LSH B,-1 + .CBLK B, + JSR CORLUZ + MOVEI B,-2000 + JRST TSINTF +];ITS + +PDLFUL: CAMN B,PDLEND + STRT [ASCIZ/PDL /] + CAMN B,LRCEND + JRST [ STRT [ASCIZ/LREC /] + JRST PDLFU2] + CAMN B,SYMEND + STRT [ASCIZ/Symbol /] +PDLFU2: STRT [ASCIZ/data area is full. Try again with different space allocations./] +ITS, .VALUE +NOITS, EXIT 0, ;CAN'T USE .VALUE BECAUSE IT MIGHT BE P THAT OVERFLOWED + +SUBTTL ITS CORLUZ AND PURIFY + +ITS,[ +CORLZ0: .VALUE [ASCIZ \: Can't get core - type $P to retry  +\] +REPEAT 2, SOS CORLUZ + JRST 2,@CORLUZ + + +PURIFY: MOVE A,[-<_-12>,,PURBOT_-12] + .CALL PURCAL + .VALUE + SETZM DEBUG + .VALUE [ASCIZ \:PurifiedPDUMP SYS;TS @\] + +PURCAL: SETZ + SIXBIT \CORBLK\ + 1000,,200000 + 1000,,-1 + SETZ A +];ITS + +SUBTTL INPUT AND OUTPUT MACROS AND SUBROUTINES + +;GET CHARACTER INTO CH, DURING PASS 1. +DEFINE 1GETCH + ILDB CH,IP +TERMIN + +;GET CHARACTER INTO CH, DURING PASS 2. +DEFINE 2GETCH + JSP H,@SLURPY +TERMIN + +;DO 1GETCH ? CAIE CH,^C ? PUSHJ P,1MORE1 ON PASS 1 +;TO CHECK WHETHER THE ^C MEANT END OF BUFFER OR FILE, +;AND MAYBE REFILL BUFFER AND RETURN TO THE 1GETCH. +1MORE1: SOS (P) + +;DO 1GETCH ? XCT TABLE(CH) WHERE THE ^C ENTRY DOES PUSHJ P,1MORE. +1MORE: SOS (P) +1MORE0: MOVEI CH,(IP) + CAME CH,LASTIP ;IS THIS ^C THE ONE PAST THE END OF THE BUFFER? + JRST 1MORE2 ;NO, IT IS DATA. RETURN A ^B TO THE PROGRAM, + ;RETURNING TO AFTER THE 1GETCH. CAN'T RETURN A ^C + ;SINCE THAT WOULD JUST COME BACK HERE! + PUSHJ P,DOINPT ;IT IS THE END OF THE BUFFER. TRY TO REFILL THE BUFFER. + JRST 1DONE ;CAN'T GET ANYTHING => THIS FILE IS DONE. + SKIPE 1CKSFL + PUSHJ P,1CKS ;DO CHECKSUMMING ON CHARS JUST READ. + ILDB CH,IP + POPJ P, + +1MORE2: MOVEI CH,^B ;YES, CTRL/B, NOT CTRL/C!!! + POPJ P, ;THIS WINS PROVIDED ^B AND ^C ARE SYNTACTICALLY EQUIVALENT. + + +;REFILL THE INPUT BUFFER, PASS 1 OR PASS 2. +;SKIPS UNLESS NO MORE INPUT WAS AVAILABLE BECAUSE EOF HAD ALREADY BEEN REACHED. +;SETS LASTIP. PUTS SOME ^C'S IN INPUT BUFFER AT END OF WHAT WAS READ IN. +;RESETS IP TO POINT AT BEGINNING OF BUFFER. +DOINPT: MOVE IP,LASTIP ;DID WE FAIL TO FILL THE BUFFER LAST TIME HERE? + SKIPG LFILE + JRST [ HRLI IP,440700 ;IF SO, SURELY AT END NOW -- MAKE SURE + POPJ P, ] ;WE SEE MORE ^C'S (ELSE ^M LOSES) + PUSHJ P,DOINP0 ;CALL SYSTEM-DEPENDENT INPUT ROUTINE, + ;WHICH SHOULD CLEAR LFILE IF IT REACHES EOF, + ;AND LEAVE IP POINTING AT FIRST WORD OF INBFR NOT FILLED. + HRLI IP,(.BYTE 7 ? ^C ? ^C) + HLLOM IP,(IP) ;STICK 2 ^C'S IN THE WORD AFTER THE END OF TEH DATA READ. + HRRZM IP,LASTIP ;MAKE LASTIP POINT AT THAT WORD. + MOVE IP,[440700,,INBFR] + JRST POPJ1 + +ITS,[ +DOINP0: MOVE IP,[-LINBFR,,INBFR-1] + PUSH IP,INBFRW ;THE FIRST WORD TO "READ" IS THE BUFFERED-BACK WORD. + ADDI IP,1 ;TURN IOWD BACK TO AOBJN POINTER. + .IOT UTIC,IP + SKIPGE IP + SETZM LFILE ;IF WE DON'T FILL THE BUFFER, IT'S EOF. + JUMPL IP,CPOPJ ;IF WE DID FILL IT, SAVE THE LAST WORD FOR NEXT DOINPT, + SUB IP,[1,,1] ;REMOVING IT FROM INBFR, SO THAT WE CAN ASSUME + POP IP,INBFRW ;THAT IF LFILE HASN'T BEEN ZEROED, THERE IS MORE + ADD IP,[1,,1] ;STUFF AFTER WHAT'S IN INBFR (AT LEAST 1 WORD MORE). + POPJ P, +];ITS + +NOITS,[ +DOINP0: PUSH P,A + PUSH P,B + PUSH P,N + MOVEI N,LINBFR + MOVEI IP,INBFR +DOINP1: SOSGE A,INHED+2 + JRST DOINP2 + LDB B,[300600,,INHED+1] + CAIE B,44 + IDIVI A,5 ;# WORDS AVAILABLE IN DEC SYSTEM INPUT BUFFER (MINUS 1) + IBP INHED+1 + HRLZ B,INHED+1 ;ADDR OF 1ST ONE. + HRRI B,(IP) + SUBI N,1(A) ;DEDUCT # WE'RE XFERING FROM # WANTED. + JUMPL N,DOINP3 ;IF WE DON'T WANT THEM ALL, THEN SPECIAL HACKERY. + ADDI IP,1(A) + BLT B,-1(IP) +DOINP2: PUSHJ P,INSOME ;XFERRED ALL OF SYSTEM BUFFER; REFILL IT + JUMPG N,DOINP1 ;GOT SOME STUFF => XFER MORE IF WE WANT MORE. + JUMPE N,DOINP4 + SETZM LFILE ;IF WE HAVE NOT FILLED INBFR, THIS MUST BE EOF. + JRST DOINP4 + +DOINP3: ADD A,N ;NOT XFERRING ALL OF SYSTEM BFR => SET UP + LDB B,[300600,,INHED+1] ;BUFFER COUNTS AND POINTERS FROM WHAT WE ARE TAKING. + CAIE B,44 + IMULI N,5 + MOVNM N,INHED+2 + ADDM A,INHED+1 + ADDI IP,1(A) + BLT B,-1(IP) +DOINP4: POP P,N + POP P,B + POP P,A + POPJ P, + +INSOME: IN UTIC, + POPJ P, + PUSH P,N + GETSTS UTIC,N + TRNN N,740000 + JRST [ TRNN N,20000 ;EOF? + JRST 4,INSOM2 ;NO -- THAT'S VERY FUNNY -- BUT TRY AGAIN + SETZM INHED+2 ;THE MONITOR REALLY SHOULD DO THIS + SETZM LFILE ;LET EVERYONE KNOW WE HIT EOF, IF THEY CARE + POP P,N + JRST POPJ1 ] + .VALUE + TRZ N,740000 + SETSTS UTIC,(N) +INSOM2: POP P,N + SKIPG INHED+2 ;DID WE READ SOME ANYHOW? + JRST INSOME ;NO, READ SOME MORE + POPJ P, ;YES, PROCESS IT FIRST +];NOITS + +;OUTPUT A CHARACTER, TRUNCATING OR CONTINUING IF NECESSARY. +;DOES NOT TAKE CARE OF UPDATING CC. +DEFINE 2PUTCH X +IFSN [X], MOVEI CH,X + XCT 2PUTNX ;SKIP IF NOT PAST RIGHT MARGIN. + XCT 2PUTTC ;MAYBE CONTINUE, OR SKIP IF TRUNCATING. + IDPB CH,SP +TERMIN + +;OUTPUT A CHARACTER. DOES NOT CONSIDER TRUNCATING OR CONTINUING. +DEFINE 2PATCH X +IFSN [X], MOVEI CH,X + IDPB CH,SP +TERMIN + +;OUTPUTS A PAGE-SEPARATOR. +DEFINE 2PAGE + 2PATCH ^M + 2PATCH ^L + AOS OUTPAG +TERMIN + +;IF THE OUTPUT BUFFER IS APPROACHING FULLNESS, +;OUTPUT MOST OF IT, SO THERE WILL BE LOTS OF ROOM. +;IF EVER TOO MANY CHARACTERS GET OUTPUT BETWEEN CALLS TO THIS MACRO, +;@ IS IN DANGER OF LOSING SOME OUTPUT. +DEFINE 2OUTBF \FOO + MOVEI A,(SP) + CAIL A,SLBUF+LSLBUF + .VALUE + CAIGE A,XSLBUF + JRST FOO + MOVE A,(SP) + MOVNI B,(SP) + HRLI B,SLBUF(B) + HRRI B,SLBUF + .OUTPT B + HRRI SP,SLBUF + MOVEM A,(SP) +FOO: +IF2, EXPUNGE FOO +TERMIN + +SUBTTL TABLE OF TYPES USED FOR SYMBOL TABLE PRINTOUT + +;;; THE TYPE OF A SYMBOL LIVES IN THE S.TYPE FIELD OF THE SYMTAB ENTRY. +;;; ORDER OF TYPES IS USED IN SORTING ENTRIES. + +DEFINE ATYPE STR + .LENGTH \STR\,,[ASCIZ \STR\] +TERMIN + +;;; TYPES FOR MIDAS SYMBOLS (ALSO TYPE CHARS FOR CREF) +;;; ORDER THEM BY DECREASING PREFERENCE FOR BEING USED AS THE +;;; REFERENCE ON A LINE (SINCE THE SYMTAB SORTER SORTS ON THEM). +;;; -- THE WORD FOLLOWING THE STRING ADDRESS IS THE CHAR THAT +;;; WILL BE PUT IN A CREF REFERENCE FOR THAT TYPE THING, +;;; UNLESS THE SIGN BIT IS SET WITH THE STRING ADDRESS. +;;; BIT T%NREF IN THE LEFT HALF OF THE FIRST WORD IS EFFECTIVE +;;; JUST AS IN THE SECOND WORD, FOR TYPES WHICH HAVE NO SECOND WORD. + +M%CLN: ATYPE [ ] ? ": ;LABEL. +M%VAR: ATYPE [V] ? "' ;MIDAS VARIABLE. +F%VAR: ATYPE [V] ? "# ;FAIL VARIABLE +M%EQL: ATYPE [=] ? "= ;SYM DEFINED WITH "=" +F%BAKA: ATYPE [_] ? "_ ;SYM DEFINED WITH "_" (IN FAIL). +M%ADEF: ATYPE [D] ? "~ ;DEFINED BY A .DEFMAC'D MACRO +F%OPDF: ATYPE [O] ? "= ;FAIL OPDEF. +M%MAC: ATYPE [M] ? "+ ;MACRO +M%BLOK: ATYPE [B] ? "* ;BLOCK NAME. +F%SYN: ATYPE [S] ? "= ;MACRO-10 "SYN", MIDAS "EQUALS". +P%CSEC: ATYPE [C] ? "* ;CSECT NAME. +P%NARG: ATYPE [?] ? "? ;SYM DEFINED IN .NARG, .NTYPE OR .NCHR. +M%GLO: ATYPE [G] ? "" ;MIDAS GLOBAL. +F%GLO: ATYPE [G] ? "^ ;FAIL GLOBAL SYM. +M%AMAC: ATYPE [D] ? T%NREF,,"~ ;MACRO APPEARING IN .DEFMAC PSEUDO +M%.SEE: ATYPE [ ] ? "! ;.SEE REFERENCE TO A SYMBOL (IN CREFS ONLY) + +;;; TYPES FOR LISP CODE (AND CONNIVER) +;;; BITS IN LH OF SECOND WORD: +;;; T%BIND,, MEANS USE THIS TYPE OF DEFINITION ONLY IF THE DEFINITION IS +;;; BETWEEN THE LAST FUNCTION-BEGINNING SEEN AND THE CURRENT LOCATION. +;;; T%TAG,, MEANS USE THIS TYPE OF DEFINITION ONLY IF ON THIS PAGE. +;;; T%NREF,, MEANS DO NOT USE THIS TYPE OF DEFINITION. + +T%BIND==1 +T%TAG==2 +T%NREF==4 + +L%EXPR: ATYPE [EXPR] ? "f +L%FEXPR: ATYPE [FEXPR] ? "f +L%LEXPR: ATYPE [LEXPR] ? "f +L%MACRO: ATYPE [MACRO] ? "m +L%SETQ: ATYPE [SETQ] ? "= +L%ARRAY: ATYPE [ARRAY] ? "a +L%LABEL: ATYPE [LABEL] ? T%BIND,,"b +L%LVAR: ATYPE [LAMBDA VAR] ? T%BIND,,"b +L%PVAR: ATYPE [PROG VAR] ? T%BIND,,"b +L%DVAR: ATYPE [DO VAR] ? T%BIND,,"b +L%CTAG: ATYPE [CATCH TAG] ? T%BIND,,"c +L%PTAG: ATYPE [PROG TAG] ? T%TAG ,,"t +L%LTAG: ATYPE [LAP TAG] ? T%TAG ,,": +L%ADEF: ATYPE [@DEFINE] ? T%NREF,,"@ +L%PROP: ATYPE [PROPERTY] ? T%NREF,,"p +L%UNKN: ATYPE [????] ? "? ;IF TYPE IS 0, IT IS TREATED AS L%UNKN. + +SUBTTL PDL AND DATA AREA INITIALIZATION + +;THE CONTROL PDL AND LREC DATA AREAS ARE ALLOCATED AS THE FIRST THING DONE (PDLINI). +;WE NEED THE FORMER TO DO ANYTHING AT ALL, AND THE LATTER TO READ THE LREC INPUT FILE. +;THE SYMBOL AND DATA AREAS ARE ALLOCATED LATER, AFTER LREC INPUT PROCESSING, +;SO THAT WE KNOW HOW BIG TO MAKE THE SYMBOL AREA FROM THE /S SWITCH (SYMINI). + +;ALLOCATE THE CONTROL PDL AND THE LREC DATA AREA. +;CALL WITH JSP H, (P ISN'T SET UP YET!). +PDLINI: MOVN C,PDLLEN + JSP L,PDLIN1 + MOVEM B,PDLEND + MOVE P,A + MOVNI C,LRCILN + JSP L,PDLIN1 + MOVEM B,LRCEND + MOVEM A,LRCPTR +ITS, .SUSET [.SMASK,,[200000]] ;PDL OVERFLOW +NOITS, MOVEI A,600000 ? APRENB A, ;PDL OVERFLOW, AUTO REENABLE + JRST (H) + +;Initialize the symbol and data spaces. +;We may also make the LREC data area longer if, +;based on the input LREC file, that seems necessary. +SYMINI: HRRZ C,LRCPTR ;Since we don't yet have a switch to set LRCLEN + SUB C,PDLEND ;Fake it by doubling what we have used so far + ADDI C,1000(C) ;and adding 1000 more + CAMLE C,LRCLEN ;and if that's more than the default + MOVEM C,LRCLEN ;Use it instead + MOVE C,PDLEND ;Get beginning of LRC area + ADD C,LRCLEN ;See where LRCEND should be + SUB C,LRCEND + JUMPLE C,SYMIN1 ;Jump if lrec area already as long as it needs to be. + ADDM C,.JBFF ;else extend core (initializing DP below will take care of the .CORE UUO, if needed) + ADDM C,LRCEND ;and fix LRCEND +NOITS,[ MOVNI C,(C) ;if not ITS, we must fix LH(LRCPTR) + HRLZI C,(C) + ADDM C,LRCPTR +];NOITS +SYMIN1: MOVE B,CODTYP + CAIE B,CODRND ;IF THIS LISTING ISN'T USING SYMBOLS, WE DON'T + CAIN B,CODTXT + TDZA C,C ;NEED TO ALLOCATE ANY SYM SPACE. + MOVN C,SYMLEN + JSP L,PDLIN1 + MOVEM B,SYMEND + MOVE SP,A + MOVNI C,DATILN + JSP L,PDLIN1 + MOVE DP,A + MOVEI A,1(SP) + MOVEM A,SYMLO + POPJ P, + +;JSP L,PDLIN1 TO ALLOCATE A STORAGE SPACE, WITH DESIRED SIZE IN C. +;RETURNS PDL POINTER TO SPACE IN A, AND ADDR OF 1ST WORD FOLLOWING IN B. +PDLIN1: HRRZ B,.JBFF + SUBI B,1 +ITS,[ TRO B,1777 ;MAKE SURE ON PAGE BOUNDARY + TRZ C,1777 ;AND THAT ASKING FOR AN INTEGRAL NUMBER OF PAGES + MOVEI A,1(B) + TLO A,11001 + LSH A,-1 + .CBLK A, ;ALLOCATE THE BOTTOM PAGE. PDLOV HANDLER WILL GET MORE AS NEEDED. + JSR CORLUZ +];ITS +NOITS, TRO B,3 .SEE SORT ;WHICH ASSUMES THAT SYMTAB ENTRIES START + MOVEI A,(B) ;ON 4-WORD BOUNDARIES. +ITS, HRLI A,-2000 +NOITS, HRL A,C + SUB B,C +IFE TWOSEG, CAILE B,777777 ;TOO MUCH CORE?? +IFN TWOSEG, CAILE B,377777 ;TOO MUCH CORE?? + .VALUE + HRRZM B,.JBFF + AOS .JBFF +NOITS,[ MOVE C,B + CORE C, + .VALUE +];NOITS + JRST (L) + +SYSINI: +ITS,[ .OPEN TYIC,[SIXBIT \ TTY@ TTYIN\] + .VALUE + .OPEN TYOC,[SIXBIT \ !TTY@ TTYOUT\] + .VALUE + SYSCAL SSTATU,[ ;READ NAME OF MACHINE ("AI", "MC", "ML", OR "DM") + REPEAT 6,[ ? %CLOUT,,MACHINE ]] + .LOSE %LSSYS +];ITS +CMU,[ MOVE B,[1,,11] ;GET SECOND WORD OF "CMU10X ..." + GETTAB B, + POPJ P, ;OH WELL, LEAVE MACHINE WITH "CMU" + LSH B,1 ;MAKE IT SIXBIT + TLZ B,7777 + TLCN B,400000 ;BUT DON'T STORE IT IF OBVIOUSLY NOT A CAPITAL LETTER (E.G. "A", "B", or "D") + HLRM B,MACHINE +];CMU + POPJ P, + +;READ IN THE DATE AND INITIALIZE THE YEAR IN THE QOPYRIGHT MESSAGE. +DATINI: +ITS,[ .RDATE B, + MOVE C,[CPYBP] +REPEAT 2,[ + SETZ A, + LSHC A,6 + ADDI A,40 + IDPB A,C +] ;END OF REPEAT 2 +];ITS +DOS,[ DATE A, + IDIVI A,31.*12. ;GET YEAR NUMBER MINUS 1964. + MOVE C,[CPYBP] + ADDI A,64.+<10.*"0> + IDIVI A,10. + IDPB A,C + ADDI B,"0 + IDPB B,C +];DOS + POPJ P, + +JCLGET: +ITS,[ .BREAK 12,[5,,SYLBUF] ;GET JCL FROM DDT + SKIPE SYLBUF ;AND IF WE GOT SOME, DON'T ASK FOR MORE + POPJ P, +];ITS +SAI,[ RESCAN B ;LOOK AT MONITOR COMMAND WHICH RAN ME + JUMPE B,POPJ1 + INCHRW B ;READ THE FIRST CHARACTER + CAIN B,"@ ;IF @ + JRST [ MOVSI B,(SIXBIT/@/) + SETNAM B, + SNEAKW B, ;THEN PEEK AT SECOND CHAR. + CAIN B,^M ;IF IT ENDS A LINE, THE COMMAND WAS NULL, SO + JRST GOSCEL ;WE HAVE NO COMMAND STRING. + CAIE B,^J + CAIN B,175 + JRST GOSCEL + JRST TTIL] ;ELSE, WE HAVE ONE, SO READ IT IN +GOSCEL: CAIE B,^J ;THE LINE IS NOT A COMMAND STRING FOR US, + CAIN B,175 ;SO SKIP IT AND THROW IT AWAY. + JRST POPJ1 + INCHRW B + JRST GOSCEL +];SAI + JRST POPJ1 + +SUBTTL TOP LEVEL + +GO: +DOS,[ JFCL + RESET ;AREN'T WE NICE AND PROPER +];DOS + JSP H,PDLINI ;ALLOCATE PDL SPACES, SET UP PDL POINTERS, GET CORE. + PUSHJ P,SYSINI ;INITIALIZE I/O CHANNELS, OTHER SYSTEM-DEPENDENT RANDOMNESS. + PUSHJ P,DATINI ;GET DATE AND INITIALIZE THE QOPYRIGHT MESSAGE. + PUSHJ P,JCLGET ;GET COMMAND LINE FROM SUPERIOR; SKIP IF NONE. + JRST GO2 + 6TYP [.FNAM1] + TYO [".] + 6TYP [VERSION] + TYO [^M] + TYO [^J] + PUSHJ P,TTILA ;READ COMMAND FROM TTY, PROMPTING WITH "@". +GO2: +DOS, HLLZS .JBSA ;CLOBBER .JBSA SINCE WE CAN'T BE RESTARTED ANYWAY + PUSHJ P,FPARSE ;INTERPRET COMMAND STRING. + PUSHJ P,FPDEF ;DEFAULT MOST FILENAMES + PUSHJ P,RLREC ;READ IN LISTING RECORD INPUT FILES. + SKIPN ECODTY ;IF LANGUAGE NOT YET KNOWN, + PUSHJ P,FPDLNG ; FIGURE IT OUT FROM INPUT FILES. +DLRECB: SKIPE DLRFL ;IF /_ SWITCH, DUMP ASCII VERSION OF OUR LREC INFO. + JRST [ PUSHJ P,DLREC ? JRST DEATH] + PUSHJ P,WLRDF ;DEFAULT THE FN2 OF THE LREC OUTPUT FILE, IF ANY. + PUSHJ P,SYMINI ;ALLOCATE SYMBOL SPACE AND DATA SPACE. + MOVEM F,REALF ;SAVE VALUE OF F TO BE PUT IN LREC OUTPUT FILE. + SKIPE FNTSPC ;IF FONTS ARE KNOWN TO @, + PUSHJ P,FNTCPT ;COMPUTE DEFAULT PAGEL, LINEL FROM FONTS. +ITS,[ MOVE B,QUEUE + CAIN B,QU.GLD ;BARF FOR /X[GOULD] (NOT /-X[GOULD]!) + TLNN F,FLXGP ;WITH NO /F[FONTS]. + JRST GO3 + SKIPN FNTSPC + JRST [ STRT [ASCIZ \/X[GOULD] requires specified fonts!\] + JRST ERRDIE ] +GO3: +];ITS + SKIPLE OLDFL ;LREC FILE EDIT MODE? + JRST GO5 ;YES, OMIT CERTAIN PASSES. + MOVE B,CODTYP ;IF THE LANGUAGE IS + CAIE B,CODRND ; [RANDOM] + CAIN B,CODTXT ; or [TEXT] + JRST GO6 ; THEN RUN MLREC EARLY + PUSHJ P,1START ;LOOK AT FILES TO FIND SYMBOL DEFINITIONS. + ;ALSO CREATE PAGE TABLES. + PUSHJ P,1END ;SORT SYMBOL TABLE. + PUSHJ P,DUPL ;LINK TOGETHER DUPLICATE ENTRIES. + PUSHJ P,SBSORT ;REVERSE AND SORT OUT SUBTITLES LIST + PUSHJ P,FISORT ;SORT FILES BY NAME (ACTUALLY MAKE SORTED POINTER-TABLE TO THEM) + PUSHJ P,MLREC ;MATCH INPUT LREC ENTRIES WITH FILES BEING LISTED. +GO4: SKIPE 1CKSFL + PUSHJ P,CPR ;PRODUCE PAGE TABLES OF FILES BEING LISTED. + SKIPN OLDFL ;UNLESS SHOULDN'T ACTUALLY LIST, + PUSHJ P,2START ;LIST THE FILES. + PUSHJ P,WLREC ;WRITE OUTPUT LREC IF THAT IS REQUESTED. +SAI, PUSHJ P,PTYLD ;REQUEST QUEUEING OF OUTPUT FILES (DONE BY 2OCLSQ IN ITS VERSION) + JRST DEATH + +GO6: PUSHJ P,MLREC ;RUN MLREC EARLY FOR /L[TEXT] and /L[RANDOM] + PUSHJ P,1START ;SO 1LOOP CAN COMPARE CREATION DATES + PUSHJ P,SBSORT + SETOM FISORF ;SORT THE FILENAMES ON TITLE SHEET + PUSHJ P,FISORT + JRST GO4 + +;OPERATING IN LREC FILE EDIT MODE (/1O WAS SPECIFIED). +GO5: PUSHJ P,MLREC0 ;ASSOCIATE OLD LREC INFO WITH FILES. + PUSHJ P,XLREC ;ALTER NAMES OF FILES IF NECESSARY. + PUSHJ P,2START + PUSHJ P,WLREC ;WRITE OUT EDITED LREC FILE. + JRST DEATH + +SUBTTL FILE NAME PARSER + +FPARSE: MOVEI L,FILES + MOVE A,[FILES,,FILES+1] + SETZM FILES + BLT A,EFILES + MOVE IP,[440700,,SYLBUF] + MOVSI D,0 ;D = SWITCHES DEFAULTED ON (PERHAPS BY OTHER SWITCHES). + MOVSI R,0 ;R = SWITCHES DEFAULTED OFF. + SETZB F,N ;F = SWITCHES SPECIFICALLY ON; N = SPECIFICALLY OFF. + +;COME HERE AFTER COMMA. START NEW FILE-BLOCK. +FPNEXF: TRZ F,TEMPF+FSMAIN+FSGET ;RE-INIT NO-STICK PER-FILE FLAGS. +FPNLUP: PUSHJ P,FPFILE + CAIE CH," ;WIN WITH EITHER  OR _ ON BOTH SAIL AND ITS + CAIN CH,"_ + JRST FPARO + PUSHJ P,FPENDF + CAIN CH,", + JRST FPCOMA +FPEJCL: MOVEM L,SFILE ;REMEMBER ADDR OF 1ST UNUSED FILEBLOCK + SETZM (L) + IORM F,EF ;IN EF, A BIT SHOULD BE SET + IORM N,EF ;IF THE BIT IN F WAS EITHER + IORM D,EF ;EXPLICITLY SPEC'D OR IMPLIED. + IORM R,EF + TLO D,FLREFS+FLDATE ;THESE 2 DEFAULT ON, BUT DON'T THEREBY COUNT AS EXPLICIT +SAI, TLO D,FLCTL ;ON SAIL, SHOULD USE SAIL CHAR SET. + ANDCM R,F ;COMPUTE FINAL SETTINGS OF SWITCHES, IN F. + ANDCM D,N + ANDCM D,R + IOR F,D +NOXGP, TLZ F,FLXGP\FLFNT2\FLFNT3 + MOVEM F,ODEFSW + MOVE B,QUEUE ;DEFAULT THE PAGEL AND LINEL, ASSUMING THAT + MOVEI A,LNLLPT ;FONTS WERE NOT SPECIFIED. IF THEY WERE SPECIFIED, + TLNE F,FLXGP ;FNTCPT WILL OVERRIDE THIS. + MOVEI A,LNLXGP +ITS, CAIN B,QU.GLD ;FOR GOULD, IF NO FONTS, ASSUME USING /-X[GOULD] (HARDWARE FONT). +ITS, MOVEI A,LNLGLP ;/X[GOULD] DOESN'T WORK WITHOUT FONTS. + SKIPN LINEL + MOVEM A,LINEL + MOVEI A,PGLLPT + TLNE F,FLXGP + MOVEI A,PGLXGP +ITS, CAIN B,QU.GLD +ITS, MOVEI A,PGLGLP + SKIPN PAGEL + MOVEM A,PAGEL + POPJ P, + + +FPENDF: MOVEM F,F.SWIT(L) ;SAVE PER-FILE SWITCHES FOR LAST FILE + TRNN F,FSLREC + JRST FPEND2 + TRNN F,FSARW + TRNN F,FSQUOT + MOVEM L,WLRECP +FPEND2: ADDI L,LFBLOK + POPJ P, + +;COME HERE WHEN COMMA ENCOUNTERED. +FPCOMA: CAIE L,EFILES + JRST FPNEXF + STRT [ASCIZ \Too many files!\] + JRST ERRDIE + +;COME HERE TO HANDLE BACKARROW. +FPARO: IORI F,FSARW + HRLI A,(L) + HRRI A,4(L) + BLT A,7(L) +REPEAT 4, SETZM .RPCNT(L) + JRST FPNLUP + +;READ IN A FILESPEC, WITH FILEBLOCK ADDRESS IN RH(L). +;IF L IS NEGATIVE, ASSUME WE ARE READING A SUBORDINATE FILE'S NAME +;(SUCH AS FOR /F OR /C), AND DON'T RECOGNIZE (, /, _; DO RECOGNIZE CLOSEBRACKET. + +FPFILE: MOVEI CC,FPNTAB ;SET UP FILENAME COUNTER +FPFIL2: MOVEM CC,FPNTBP +FPNAME: MOVE CP,[440600,,CC] + SETZ CC, +FPLOOP: ILDB CH,IP + CAIE CH,", + CAIN CH,40 + JRST FPSPC +DOS,[ CAIN CH,". + JRST FPDOT + CAIN CH,"[ ;] + JRST FPSPC +];DOS + JUMPGE L,FPLOO1 ;[ ;IF READING A FONT FILENAME OR CREF OUTPUT FILENAME, + CAIN CH,"] ;CLOSEBRACKET ENDS THE SPEC, + JRST FPSPC + JRST FPLOO2 ;AND SWITCHES ARE NOT ALLOWED (WE'RE ALREADY INSIDE A SWITCH) + +FPLOO1: CAIE CH,"( + CAIN CH,"_ + JRST FPSPC + CAIE CH," + CAIN CH,"/ + JRST FPSPC + CAIN CH,"' + JRST FPQUOT +FPLOO2: CAIN CH,": + JRST FPCLN +ITS, CAIN CH,"; +ITS, JRST FPSEMI + CAIN CH,^Q + ILDB CH,IP + CAIE CH,^M + CAIN CH,^I + JRST FPSPC + CAIL CH,140 + SUBI CH,40 + SUBI CH,40 + JUMPL CH,FPLOOP + TLNE CP,770000 + IDPB CH,CP + JRST FPLOOP + +FPNTAB: MOVEM CC,2(L) ;STORE FN1 + MOVEM CC,3(L) ;STORE FN2 + MOVEM CC,1(L) ;STORE DEVICE + MOVEM CC,(L) ;STORE SNAME + SKIPA ;IGNORE ALL EXTRA NAMES. + +DOS,[ +FPDOT: AOS 3(L) ;"." IMPLIES FN2 SHOULD NOT BE DEFAULTED, EVEN IF NULL. +];DOS +FPSPC: JUMPE CC,FPSPC5 + XCT @FPNTBP + AOS FPNTBP +FPSPC5: CAIE CH,^M + CAIN CH,", + POPJ P, ;[ + CAIE CH,"] + CAIN CH,"_ + POPJ P, + CAIN CH," + POPJ P, + CAIN CH,"( + JRST FPSWS + CAIN CH,"/ + JRST FP1SW +NODOS, JRST FPNAME +DOS,[ CAIN CH,"[ ;] + JRST FPPPN + CAIE CH,". + JRST FPNAME + MOVEI CC,FPNTAB+1 + JRST FPFIL2 +];DOS + +FPCLN: JUMPE CC,FPNAME + MOVEM CC,1(L) + JRST FPNAME + +FPSEMI: JUMPE CC,FPNAME + MOVEM CC,(L) + JRST FPNAME + +FPQUOT: TROE F,FSQUOT ;1 QUOTE => DON'T OUTPUT THIS FILE. + IORI F,FSNOIN ;2 QUOTES => DON'T INPUT IT EITHER. + JRST FPLOOP + +DOS,[ +FPPPN: MOVEM IP,FPPNBP ;IN CASE THERE IS AN ERROR + SETZB CC,CP + ILDB CH,IP ;[ ;GET A CHARACTER + CAIN CH,"] + JRST [ SAI, SETZ CC, ? DSKPPN CC, ;[] MEANS CURRENT PPN + .ELSE GETPPN CC, + JFCL + JRST FPSEMI ] +SAI,[ + PUSHJ P,FPPPN5 ;READ THE PROJECT NAME. + CAIE CH,", ;IT MUST END WITH A COMMA AND NOT BE NULL. + JRST FPPPN4 + JUMPE CC,FPPPN4 + PUSH P,CC + SETZ CC, ;READ THE PROGRAMMER NAME + PUSHJ P,FPPPN7 + JUMPE CC,FPPPN4 ;IT MUST NOT BE NULL. + CAIN CH,", ;IT MUSTN'T END WITH COMMA. + JRST FPPPN4 + HRL CC,(P) ;MERGE THE TWO. + SUB P,[1,,1] + JRST FPSEMI + +FPPPN5: CAIL CH,140 ;CONVERT LOWER CASE TO UPPER + SUBI CH,40 + LSH CC,6 + ADDI CC,-40(CH) ;AND MERGE INTO SIXBIT. +FPPPN7: ILDB CH,IP + CAIL CH,40 ;[ ;PPN STOPS WITH A CR OR A CLOSEBRACKET. + CAIN CH,"] + POPJ P, + CAIN CH,", + POPJ P, + JRST FPPPN5 +];SAI +NOSAI,;DROPS THROUGH + +;DROPS THROUGH +NOSAI,[ +FPPPN3: CAIL CH,"0 + CAILE CH,"7 + JRST FPPPN2 + LSH CP,3 + TRO CP,-"0(CH) + ILDB CH,IP + CAIE CH,", + JRST FPPPN3 +FPPPN6: ILDB CH,IP + CAIL CH,"0 + CAILE CH,"7 + JRST FPPPN8 + LSH CC,3 + TRO CC,-"0(CH) + JRST FPPPN6 +FPPPN8: HRLI CC,(CP) ;[ + CAIN CH,"] + JRST FPSEMI +FPPPN2: +DEC,[ + JUMPN CP,FPPPN4 ;NOT AN OCTAL PPN. IS IT A SIXBIT PPN? MUST BE <0, + CAIGE CH,100 ;IMPLYING THIS CHAR MUST BE > 100 AND NO DIGITS BEFORE IT. + JRST FPPPN4 +FPPPN5: CAIL CH,140 ;CONVERT LOWER CASE TO UPPER + SUBI CH,40 + LSH CC,6 + ADDI CC,-40(CH) ;AND MERGE INTO SIXBIT. + ILDB CH,IP + CAIL CH,40 ;[ ;PPN STOPS WITH A CR OR A CLOSEBRACKET. + CAIN CH,"] + CAIA + JRST FPPPN5 + JUMPE CC,FPPPN4 +FPPPN7: TLNE CC,770000 ;NOW THAT WE HAVE THE SIXBIT, LEFT-JUSTIFY IT. + JRST FPSEMI + LSH CC,6 + JRST FPPPN7 +];DEC + +CMU,[ JUMPN CC,FPPPN4 ;BAD RIGHT OFF IF ALREADY SAW OCTAL +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE CP,[440700,,PPNBUF] +FPPPN5: CAIE CH,^M ;DON'T LOOK TOO FAR + SKIPE PPNBUF+3 + JRST FPPPN4 + IDPB CH,CP + ILDB CH,IP ;[ + CAIE CH,"] ;LOOP TILL WE FIND A CLOSE BRACKET + JRST FPPPN5 + MOVE CP,[CC,,PPNBUF] + CMUDEC CP, + JRST FPPPN4 + JRST FPSEMI +];CMU +];NOSAI + +FPPPN4: STRT [ASCIZ/Bad PPN: [/] ;] + MOVE A,FPPNBP + JRST FPSBD3 +];DOS + +SUBTTL COMMAND LINE SWITCH PARSER + +FP1SW: TRO F,FR1SW ;JUST ONE SWITCH + JRST FPSW0 + +FPSWS: TRZE F,FR1SW + JRST FPNAME +FPSW0: SETZB A,B +FPSW1: MOVEM IP,FPSSBP + ILDB CH,IP + CAIN CH,^M + POPJ P, + CAIN CH," + MOVEI CH,"_ + CAIL CH,140 + SUBI CH,40 + CAIG CH,40 + JRST FPSWS + JRST @FPSTBL-"!(CH) + +FPSDIG: IMULI A,10. + ADDI A,-"0(CH) + AOJA B,FPSW1 + +FPSNEG: TLO B,400000 + JRST FPSW1 + +;JSP H,FPSNUM IN A SWITCH ROUTINE TO DECODE NUMERIC PREFIX ARGUMENT. +;VALUE RETURNED IN A, SKIPPING IF ARG IS NON-NULL. +FPSNUM: JUMPE B,(H) + JUMPG B,1(H) + MOVNS A + JUMPN A,1(H) + MOVNI A,1 + JRST 1(H) + +FPSBAD: STRT [ASCIZ \Illegal switch: \] +FPSBD1: MOVE A,FPSSBP ;GET BP TO ILDB 1ST CHAR OF SWITCH +FPSBD3: ILDB CH,A ;PRINT OUT AS FAR AS WE READ BEFORE DETECTING ERROR. + TYO CH + CAME A,IP + JRST FPSBD3 +FPSBD2: TYO [^M] + TYO [^J] + JRST ERRDIE + +FPSVAL: STRT [ASCIZ \Bad value for switch: \] + JRST FPSBD1 + +FPSCNF: STRT [ASCIZ \Conflicting switch: \] + JRST FPSBD1 + +SUBTTL MACROS FOR SWITCH DEFINITIONS + +;INSIST OF TURNING THE FLAGS IN "ON" ON AND THOSE IN "OFF" OFF. +;ALSO DEFAULT THOSE IN PLSON AND PLSOFF. +;ALL 4 ARGS SHOULD BE SWAPPED (WHICH MEANS R.H. FLAGS SHOULD BE IN PARENS). +DEFINE SW ON,OFF,PLSON,PLSOFF +IFN OFF, TDNN F,[(OFF)] +IFN ON\OFF, TDNE N,[(ON)] +IFN ON\OFF, JRST FPSCNF +IFN ON, IOR F,[(ON)] +IFN OFF, IOR N,[(OFF)] +IFN PLSON, IOR D,[(PLSON)] +IFN PLSOFF, IOR R,[(PLSOFF)] +IFN ON\PLSON, ANDCM R,[(ON\PLSON)] +IFN OFF\PLSOFF, ANDCM D,[(OFF\PLSOFF)] +TERMIN + +;SET FLAGS ONE WAY IF THERE'S NO MINUS SIGN; ANOTHER WAY IF THERE IS ONE. +;THE TWO ACTIONS WILL GENERALLY BE APPROXIMATELY OPPOSITE. +;NOTE THAT THE LAST 4 ARGS HAVE THEIR INTERPRETATIONS REVERSED +;SO, FOR EXAMPLE, THE 5TH ARG SHOULD GENERALLY RESEMBLE THE 1ST, NOT THE 2ND. +DEFINE SWSW ON,OFF,PLSON,PLSOFF,MOFF,MON,MPLSOFF,MPLSON\FOO,BAR + JUMPL B,FOO + SW [ON][OFF][PLSON][PLSOFF] + JRST BAR +FOO: SW [MON][MOFF][MPLSON][MPLSOFF] +BAR: +IF2, EXPUNGE FOO BAR +TERMIN + +;SET CODTYP TO TYP, CHECKING FOR CONFLICTS. +DEFINE SWCOD TYP + MOVEI A,TYP + PUSHJ P,SWCOD1 +TERMIN + +SWCOD1: SKIPE ECODTY + CAMN A,CODTYP + CAIA + JRST FPSCNF + MOVEM A,CODTYP + SETOM ECODTY + POPJ P, + +FPSNLN: SWSW FLNOLN,,,,FLNOLN + JRST FPSWS + +FPSNST: TRO F,FSNSMT ;/$ MEANS NO SYM TAB - SET FSNSMT OF THIS FILE. + SKIPGE B + TRZ F,FSNSMT ;/-$ MEANS CLEAR FSNSMT - WE DO WANT SYM TAB. + JRST FPSWS + +FPSDAT: SWSW FLDATE,,,,FLDATE ;DATE IN HEADING + JRST FPSWS + +FPSARB: JUMPL B,FPSAR1 + TLNE N,FLARB ;/A AND /A TURN ON FLARB + JRST FPSCNF + TLO F,FLARB + JUMPE B,FPSWS + MOVEM A,SYMTRN ;/A ALSO SETS SYMTRN. + SETOM ESYMTRN + JRST FPSWS + +FPSAR1: TLNE F,FLARB ;/-A TURNS OFF FLARB AND ZEROS SYMTRN. + JRST FPSCNF + TLO N,FLARB + SETOM ESYMTRN + SETZM SYMTRN + JRST FPSWS + +FPSOLD: MOVE CH,IP + ILDB CH,CH + CAIN CH,"[ ;] + JRST FPSOUT ;/O[FOO] SETS OUTPUT FILE NAME + JSP H,FPSNUM + SETO A, ;"/O" SAME AS "/-O". + MOVEM A,OLDFL + JRST FPSWS + +FPSDLR: SETOM DLRFL ;/_ IMPLIES CALL DLREC TO WRITE ASCIFIED VERSION OF INPUT LREC FILE. + TRO F,FSQUOT+FSLREC ;ALSO IMPLIES THIS IS LREC FILE AND SHOULDN'T REWRITE IT. + JRST FPSWS + +FPSCRF: SWSW FLCREF,RANDF,,,FLCREF +FPSCR1: MOVE CH,IP + ILDB CH,CH +FPSCR2: CAIE CH,"[ ;] ;IS THERE A FILENAME SPEC FOLLOWING THE /C OR /U? + JRST FPSWS ;NO. + HRROI A,CRFFIL + PUSHJ P,FPSFIL + SETOM CRFOFL ;SAY THAT A SEPARATE CREF OUTPUT FILE IS WANTED. + SETOM ECRFF ;AND SAY THAT THIS WAS EXPLICITLY SPEC'D. + MOVE A,CRFDEV ;EXCEPT THAT IF USER SPEC'D DEVICE AS "NONE" + CAMN A,[SIXBIT/NONE/] + SETZM CRFOFL ;THEN WHAT HE WAS SAYING WAS THAT THERE SHOULDN'T BE A SEPARATE FILE. + CAMN A,[SIXBIT/NONE/] + SETZM CRFDEV + CAIN CH,^M + POPJ P, + JRST FPSWS + +FPSDBL: SWSW FLSHRT,RANDF,FLREFS,,FLSHRT + JRST FPSWS + +FPSOUT: HRROI A,OUTFIL + PUSHJ P,FPSFIL + SETOM EOUTFIL + CAIN CH,^M + POPJ P, + JRST FPSWS + +FPSFIL: INSIRP PUSH P,CC CP L R D F FPNTBP + IBP IP + MOVE L,A + PUSHJ P,FPFILE + INSIRP POP P,FPNTBP F D R L CC CP + POPJ P, + +;;; SWITCHES HAVING TO DO WITH SPECIFYING THE LANGUAGE. + +FPSQMK: SW RANDF,FLREFS ;RANDOM - /? + SWCOD CODRND + JRST FPSWS + +FPSFAI: SW ,,FLREFS+FLCTL,FLARB ;FAIL + SWCOD CODFAI + JRST FPSWS + +FPSMID: SW ,,FLREFS,FLARB ;MIDAS + SWCOD CODMID + JRST FPSWS + +FPSLSP: +IFE LISPSW,STRT [ASCIZ \/L[LISP] not supported in this version of @\] + SW FLARB+FLASCI,,FLREFS + SWCOD CODLSP + JRST FPSWS + +FPSUCO: +IFE LISPSW,STRT [ASCIZ \/L[UCONS] not supported in this version of @\] + SW FLARB+FLASCI,,FLREFS ;UCONS -- VERY SIMILAR TO LISP + SWCOD CODUCO + JRST FPSWS + +FPSM10: SW ,,FLREFS,FLARB ;MACRO-10 + SWCOD CODM10 + JRST FPSWS + +FPS11: SW ,,FLREFS+FL2REF,FLARB ;PALX11 + SWCOD CODP11 + JRST FPSWS + +FPSTXT: SW FLNOLN,FLREFS,FLCTL+FLBS+FLSCR ;TEXT (TJ6, PUB, SCRIBE, or TEX output, etc). + SWCOD CODTXT + SETZM TRUNCP ;DON'T TRUNCATE OR CONTINUE LINES. + SKIPN ENXFDSP ;AND DEFAULT /-! + SETOM NXFDSP + JRST FPSWS + +FPSMDL: +IFE MUDLSW,STRT [ASCIZ \/L[MUDDLE] not supported in this version of @\] + SW FLARB+FLASCI,,FLREFS ;MUDDLE + SWCOD CODMDL + JRST FPSWS + +FPSDAP: SW ,,FLREFS,FLARB ;DAPX16 + SWCOD CODDAP + JRST FPSWS + +FPSLNG: SETZ B, ;B COUNTS BRACKETS - SWITCH CAN'T END UNLESS THEY'RE BALANCED. + ILDB CH,IP + CAIE CH,"[ ;] ;DO WE HAVE BRACKETED NAMES? + JRST FPSLN5 ;/L WITH NO NAME? + PUSHJ P,FPSPSP ;PASS SPACES. + PUSHJ P,FPS6BT ;READ SIXBIT WORD INTO B + PUSHJ P,FPSCLS ;THROW AWAY ALL UP TO CR OR CLOSEBRACKET. + LDB A,[360600,,B] ;1ST CHAR IN A. + CAIN A,'D + JRST FPSDAP ;"D" => DAPX16 + CAIN A,'L + JRST FPSLSP ;"L" => LISP. + CAIN A,'U + JRST FPSUCO ;"U" => UCONS + CAIN A,'P + JRST FPS11 ;"P" => PALX11 + CAIN A,'F + JRST FPSFAI ;"F" => FAIL + CAIN A,'R + JRST FPSQMK ;"R" => RANDOM (NO SYMBOLS AT ALL). + CAIN A,'T + JRST FPSTXT ;"T" => TEXT (OUTPUT FROM TEXT-JUSTIFIER). + CAIN A,'M + JRST [ LDB A,[300600,,B] ;"M" => MIGHT BE "MIDAS" OR "MACRO-10" OR "MUDDLE". + CAIN A,'I ;SO LOOK AT THE FOLLOWING CHARACTER. + JRST FPSMID + CAIN A,'A + JRST FPSM10 + CAIN A,'U + JRST FPSMDL + JRST FPSLN5] +FPSLN5: STRT [ASCIZ/Bad language name: /] + JRST FPSBD1 + +FPSPSP: ILDB CH,IP ;ILDB FROM IP TILL NEXT NON-SPACE + CAIN CH,40 + JRST FPSPSP + POPJ P, + +FPS6BT: SETZ B, ;READ 6BIT WORD INTO B OFF OF IP, + SKIPA A,[440600,,B] ;ASSUMING 1ST CHAR OF IT ALREADY IN CH. +FPS6B1: ILDB CH,IP + CAILE CH,40 ;[ + CAIN CH,"] + POPJ P, + CAIL CH,140 + SUBI CH,40 + SUBI CH,40 + TLNE A,770000 + IDPB CH,A + JRST FPS6B1 + +FPSCLS: CAIE CH,^M ;[ ;DISCARD UP TO END OF BRACKETED SWITCH. + CAIN CH,"] + POPJ P, + ILDB CH,IP + JRST FPSCLS + +XGP,[ +FPSFNT: MOVE CH,IP ;F SWITCH - LOOK AHEAD AT NEXT CHARACTER + ILDB CH,CH + JSP H,FPSNUM + JRST [ CAIN CH,"[ ;] + JRST FPSFN0 ;FONT NAMES FOLLOW, AND NO #, SO DON'T ASSUME ONE. + MOVEI A,2 ;JUST "F", WITH NO NUMBER AND NO FONT NAMES + JRST .+1] ;IS THE SAME AS "2F". + JUMPLE A,FPSVAL + CAILE A,3 + JRST FPSVAL + TLNE N,FLXGP + JRST FPSCNF + TLZ F,FLFNT2+FLFNT3 + CAIL A,2 + TLO F,FLFNT2 + CAIL A,3 + TLO F,FLFNT3 +FPSFN0: CAIE CH,"[ ;] ;DO FONT NAMES FOLLOW? + JRST FPSXGP + IBP IP ;YES; SKIP THE BRACKET. +FPSFN3: INSIRP PUSH P,CC CP FPNTBP L R D F +FPSFNP==:.-FPSFN3 + HRROI L,FNTF0 +FPSFN1: PUSHJ P,FPSFND ;READ, DEFAULT AND LOOK AT ONE FONT. + CAIN CH,^M ;CR ENDED FONT NAME => + JRST [ SUB P,[FPSFNP,,FPSFNP] + POPJ P,] ;ENTIRE COMMAND STRING IS BEING ENDED. + CAME L,[-1,,FNTFE] ;WHEN TOO MANY FONTS SPEC'D, GARBAGE BLOCK AT FNTFE IS CLOBBERED. + ADDI L,FNTFL ;PROCESS NEXT FONT. ;[ + CAIE CH,"] ;BUT CLOSEBRACKET ENDS THE /F. + JRST FPSFN1 + INSIRP POP P,F D R L FPNTBP CP CC + JRST FPSXGP +] ;END XGP + +XGP,[ +;READ IN ONE FONT FILE NAME, DEFAULT IT, AND GOBBLE SIZE INFO FROM THE FONT FILE. +FPSFND: SETOM FNTSPC ;SAY THAT @ IS SUPPOSED TO HACK FONTS. + PUSHJ P,FPFILE ;READ IN NEXT FONT'S NAME. + SKIPE FNTDEV(L) + JRST FPSFN4 + SKIPN FNTFN1(L) ;WAS IT REALLY SPEC'D, OR NULL? + POPJ P, +FPSFN4: SETOM FNTEXP(L) ;SAY THIS FONT WAS EXPLICITLY SPEC'D. + SETOM EFNTF ;SAY AT LEAST ONE FONT WAS EXPLICITLY SPEC'D. + MOVE CC,FNTDEV(L) + CAMN CC,[SIXBIT/NONE/] ;THE WAY TO UN-SPECIFY A FONT IS TO + JRST [ SETZM FNTSIZ(L) ;SPECIFY IT AS DEVICE NONE: + SETZM FNTDEV(L) + SETZM FNTFN1(L) + POPJ P,] + MOVSI CC,'DSK + SKIPN FNTDEV(L) ;DEFAULT THE OTHER NAMES. + MOVEM CC,FNTDEV(L) + MOVE CC,[FNTDSN] + SKIPN FNTSNM(L) + MOVEM CC,FNTSNM(L) + MOVE CC,FNDFN2 + SKIPN FNTFN2(L) + MOVEM CC,FNTFN2(L) + MOVEI R,6 + MOVEI A,(L) ;OPEN THE FONT FILE, IN IMAGE MODE. + PUSHJ P,2INOPN + FLOSE UTIC,FNTSNM(L) + JFCL CPOPJ + PUSH P,IP ;READ IN A LARGE AMOUNT OF IT. + PUSHJ P,2RDAHD + PUSHJ P,DOINPT + JRST [POP P,IP ? POPJ P,] + POP P,IP + MOVE CC,FNTFN2(L) + CAMN CC,['FNT,,] + JRST FPSFN6 + CAMN CC,['KST,,] ;ERROR IF FONT NOT A KST OR FNT FILE. + JRST FPSFN5 + CAIA + JRST FPSFN4 ;IF USER GIVES A NEW FILENAME, GO TO FPSFN4. + FLOSEI FLSFNT,FNTSNM(L) + JFCL CPOPJ ;IF HE DOESN'T, RETURN. + +FPSFN5: HRRZ CC,INBFR+1 ;KST FILE: GET FONT HEIGHT + HLRZ A,INBFR+1 ;GET BASELINE + ANDI A,777 + HRRZ R,INBFR+4 ;GET WIDTH + JRST FPSFN7 ;STORE THEM IN FNTSIZ(L). + +FPSFN6: +IFL LINBFR-204,.ERR BAD LINBFR FOR PARSING FNT FILES + MOVE CC,INBFR+201 ;FNT FILE: GET HEIGHT, BASELINE AND WIDTH. + MOVE A,INBFR+203 + MOVE R,INBFR+202 +FPSFN7: HRLZM CC,FNTSIZ(L) ;STORE FONT HEIGHT. + DPB A,[331100,,FNTSIZ(L)] ;AND BASELINE + HRRM R,FNTSIZ(L) ;STORE FONT WIDTH. + .CLOSE UTIC, ;THAT IS ALL FOLKS + POPJ P, +] ;END XGP + +FPSBS: SWSW FLBS,,,,FLBS + JRST FPSWS + +FPSINS: SWSW FLINSRT,,,,FLINSRT + JRST FPSWS + +FPSMAI: SWSW (FSMAIN),,,,(FSMAIN) + SETOM EMSWT + JRST FPSWS + +FPSNBG: SETOM NOTITL ;/& SAYS NO TITLE PAGE, ETC. + SKIPGE B ;BUT /-& CANCELS /&. + SETZM NOTITL + SETOM ENOTITL ;EITHER WAY, OVERRIDE THE LREC FILE. + JRST FPSWS + +FPSNRF: SWSW ,FLREFS,,,,FLREFS + JRST FPSWS + +FPSUSF: SKIPGE B ;/G LIKE /@, BUT ALSO USE REMEMBERED SWITCHES & FILE NAMES. + SETOM NOCOMP ;/-G SAYS MAKE FULL LISTINGS, NOT COMPARISON LISTINGS. + SKIPLE B ;/1G MEANS RELIST PAGES RATHER THAN + SETOM NORENUM ;CREATE /'D PAGE #S OR GAPS IN PAGE #S. + IORI F,FSGET ;G SWITCH => .INSRT FILES MENTIONED BY LREC FILE. +FPSLRC: IORI F,FSLREC ;(@) SWITCH => THIS IS LISTING RECORD FILE. + SETOM 1CKSFL ;SAY THERE IS AN LREC FILE SPEC'D. + JRST FPSWS + +FPSCPY: SWSW FLQPYM,,,,FLQPYM + MOVE CH,IP ;CHECK FOR EXPLICIT COPYRIGHT MESSAGE + ILDB CH,CH ; SPECIFIED IN BRACKETS + CAIE CH,"[ ;] + JRST FPSWS + IBP IP + SETZB B,CPYMSG+1 ;B HOLDS BRACKETS COUNT + MOVE C,[CPYMSG+1,,CPYMSG+2] + BLT C,CPYMSG+LCPYMSG-1 + DPB B,[010700,,CPYMSG] ;THIS HAIR ZEROS ALL OF MSG EXCEPT 1ST 4 CHARS (2 CRLFS) + MOVEI C,LCPYMSG*5-4 ;PREPARE TO STICK IN USER'S ARG AFTER THOSE CRLFS. + MOVE A,[100700,,CPYMSG] +FPSCP1: ILDB CH,IP + CAIN CH,"[ ;] + AOJA B,FPSCP2 ;[ + CAIN CH,"] + JRST FPSCP3 + CAIN CH,^Q ;^Q QUOTES, BUT CANNOT QUOTE A ^M + ILDB CH,IP + CAIN CH,^M ;^M TERMINATES, ALWAYS! + JRST FPSWS +FPSCP2: SOSL C + IDPB CH,A + JRST FPSCP1 + +FPSCP3: SOJGE B,FPSCP2 ;MATCHING CLOSE BRACKET TERMINATES + JRST FPSWS + +FPSCR: SWSW FLSCR,,,,FLSCR + JRST FPSWS + +FPSLNM: SETOM EPRLSN ;/K => PRINT DEC LSN'S AS PART OF TEXT. + SETZM PRLSN + TLNN B,400000 + SETOM PRLSN + JRST FPSWS + +FPSSNG: JUMPN A,FPSSYM ;/nS SAYS # SYMBOLS IN SYMTAB SPACE. + SETOM ESINGL ;/S AND /-S SAY WHETHER SINGLE OUTPUT FILE. + SETZM SINGLE + TLNN B,400000 + SETOM SINGLE + JRST FPSWS + +FPSSYM: IMULI A,LSENT + MOVEM A,SYMLEN + SETOM ESYMLEN + JRST FPSWS + +FPSTRN: JSP H,FPSNUM ;-T => CONTINUE. 1T => TRUNCATE. 0T => NEITHER. + MOVEI A,1 ;JUST T SAME AS 1T. + MOVEM A,TRUNCP + SETOM ETRUNC ;INDICATE /T SWITCH WAS SEEN + JRST FPSWS + +FPSUNV: MOVE CH,IP ;/U: FIRST LOOK AHEAD AT NEXT CHARACTER - MAYBE IT IS OPENBRACKET. + ILDB CH,CH + JSP H,FPSNUM + JRST [ SETO A, ;NO NUMBER SPEC'D - IF OPENBRACKET DOESN'T FOLLOW, + CAIN CH,"[ ;] ;ASSUME -1 AS NUMERIC ARG. + JRST FPSCR2 ;IF BRACKET FOLLOWS, DON'T SET UNIVCT IF NO NUMERIC ARG. + JRST .+1] + MOVEM A,UNIVCT + SETOM EUNIVC ;INDICATE UNIVCT WAS EXPLICITLY SPEC'D. + JRST FPSCR2 ;THERE MAY STILL BE A BRACKET FOLLOWING - HANDLE IT IF SO. + +FPSREL: SETOM REALPG + SKIPGE B ;/Y - SET (/-Y CLEAR) REALPG "PRINT REAL PAGE #S, NOT VIRTUAL". + SETZM REALPG + SETOM EREALPG + JRST FPSWS + +FPSOKM: JSP H,FPSNUM ;/-! => KEEP MISSING FILES. /1! => LOSE THEM. /0! => KEEP AFTER ASKING + MOVEI A,1 ;/! = /1! + MOVEM A,NXFDSP + SETOM ENXFDSP + JRST FPSWS + +FPSRLS: TRZ F,FSLALL\FSLRNM + SKIPGE B ;/-J CAUSES A FULL LISTING OF THIS FILE AND SUCCESSIVE FILES. + TRO F,FSLALL ; (PER-FILE /-G). + SKIPLE B ;/1J CAUSES NO /'D PAGE #S OR GAPS IN PAGE #S TO BE CREATED. + IORI F,FSLRNM ; (PER-FILE /1G). + JRST FPSWS + +FPSPGL: JSP H,FPSNUM ;"V" - SET PAGEL OR FNTVSP TO ARGUMENT. + JRST FPSVAL + CAIL A,MAXVSP ;NUMBERS LESS THAN MAXVSP ARE VSP'S. + JRST FPSPG1 + MOVMS A ;NEGATIVE NUMBERS SPECIFY LARGER VSP'S. + MOVEM A,FNTVSP + SETOM EFNTVS + JRST FPSWS + +FPSPG1: CAIGE A,MINPGL ;#S LARGER THAN MAXVSP TRY TO SET PAGEL + JRST FPSVAL ;BUT TOO SMALL WILL SCREW @. + MOVEM A,PAGEL + SETOM EPAGEL ;INDICATE EXPLICIT /V WAS SEEN. + JRST FPSWS + +FPSLNL: JSP H,FPSNUM ;"W" - SET LINEL TO ARGUMENT. + JRST FPSVAL + CAIGE A,MINLNL + JRST FPSVAL + MOVEM A,LINEL + SETOM ELINEL ;INDICATE EXPLICIT /W WAS SEEN. + JRST FPSWS + +FPSMNP: JSP A,FPSNUM ;"P" - SET PAGE TO START LISTING AT. + JRST FPSVAL + MOVEM A,F.MINP(L) + JRST FPSWS + +XGP,[ +FPSXGP: SWSW FLXGP,,,,FLXGP+FLFNT2+FLFNT3 + MOVE A,IP + ILDB CH,A ;IS THERE AN OPENBRACKET? + CAIE CH,"[ ;] + JRST FPSWS + IBP IP ;YES, PASS IT AND ALL SPACES AFTER IT + PUSHJ P,FPSPSP + CAIL CH,140 ;AND GET WHAT OUGHT TO BE A Q OR N (EITHER CASE). + SUBI CH,40 + MOVEI A,QU.BAD + CAIN CH,"Q ;Q => DO QUEUE, SO QUEUE GETS 0 + MOVEI A,QU.YES + CAIN CH,"N ;N => DON'T QUEUE. + MOVE A,[QU.NO] +ITS, CAIN CH,"G ;G => QUEUE FOR GOULD LPT. +ITS, MOVEI A,QU.GLD + CAIN A,QU.BAD + JRST FPSBAD ;COMPLAIN IF /X[MEANINGLESS ARG]. + MOVEM A,QUEUE + SETOM EQUEUE ;INDICATE QUEUE HAS BEEN EXPLICITLY SET BY USER. + PUSHJ P,FPSCLS ;READ AND IGNORE UP TO END OF SWITCH. + JRST FPSWS +];XGP +NOXGP,[ +FPSXGP: FPSFNT: + STRT [ASCIZ \This @ doesn't support the XGP. /X and /F not allowed.\] + JRST FPSBD2 +];NOXGP + +FPSSBT: SWSW FLSUBT,,,,FLSUBT + JRST FPSWS + +FPSCTL: SWSW FLCTL,,,,FLCTL + JRST FPSWS + +;INDEX BY SWITCH CHARACTER IN SIXBIT, TO FIND ADDRESS OF HANDLER FOR CHARACTER. +.SEE SWPRIN ;IF YOU CHANGE THIS TABLE, SEE SWPRIN . + +;SWITCH ROUTINES SHOULDN'T CLOBBER ACS OTHER THAN A,B,C,H AND CH. +;A AND B CONTAIN PREFIX ARGUMENT INFO WHICH IT IS OK TO DESTROY; WHICH FPSNUM USES. +.SEE FPSNUM, SW, SWSW, SWTYP ;ARE USEFUL IN SWITCH ROUTINES. + +;DURING SWITCH PROCESSING, F CONTAINS THOSE FLAGS WHICH MUST! BE ON +;N HAS THOSE WHICH MUST! BE OFF. +;D HAS THOSE DEFAULTED ON, BUT OVERRIDABLE. +;R HAS THOSE DEFAULTED OFF, BUT OVERRIDABLE. + +FPSTBL: + FPSOKM ;! + FPSBAD ;" + FPSNLN ;# SUPPRESS LINE #'S ON LEFT + FPSNST ;$ SUPPRESS SYMBOL TABLE (PER-FILE) + FPSDAT ;% DATE IN HEADING + FPSNBG ;& SUPPRESS BIGPRINT AND PAGE MAP +REPEAT 2, FPSBAD ;' ( + FPNAME ;) END SWITCH LIST +REPEAT 2, FPSBAD ;* + + FPSWS ;, IGNORE + FPSNEG ;- NEG NUMBER +REPEAT 2, FPSBAD ;. / +REPEAT 12, FPSDIG ;0-9 +REPEAT 5, FPSBAD ;: ; < = > + FPSQMK ;? NO SYM REFS AND NO SYM TABLE + FPSLRC ;@ LREC FILE(S) + FPSARB ;A ARBITRARILY LONG SYMBOLS + FPSBAD ;B + FPSCRF ;C MAKE CREF TABLE AT END OF LISTING. + FPSDBL ;D CROSS FILE REFS ABREVIATED FILE NAME + FPSBAD ;E + FPSFNT ;F SPECIFY FONTS + FPSUSF ;G GO THROUGH LREC FILE TO .INSRT FILES MENTIONED. IMPLIES /@. + FPSBS ;H + ^H OUT AS REAL BACKSPACE - OUTPUT AS UPPARROW-H + FPSINS ;I + LIST ALL .INSRT ED FILES + FPSRLS ;J CONTROLS RELISTING OF UNCHANGED PAGES. + FPSLNM ;K (DEC VERSION) PRINT LSN'S AS PART OF TEXT. + FPSLNG ;L FOLLOWED BY NAME OF LANGUAGE FILES ARE IN. + FPSMAI ;M THIS IS MAIN FILE; KEY LREC FILE FN2 TO IT (IF /G USED). + FPSNRF ;N OMIT CROSS REFERENCES + FPSOLD ;O SUPPRESS OUTPUT OF LISTINGS (BUT NOT OF LREC FILE) + ; OR SET OUTPUT FILE NAME DEFAULTS + FPSMNP ;P (PER-FILE) SPEC PAGE TO START LISTING AT. + FPSCPY ;Q QOPYRIGHT MESSAGE + FPSCR ;R STRAY CR S OUTPUT AS UP-ARROW-M IF -, OVERSTRIKE IF + + FPSSNG ;S ONLY ONE OUTPUT FILE + FPSTRN ;T -T => CONTINUE; 1T => TRUNCATE; 0T => NEITHER. + FPSUNV ;U -1 UNVERSIAL SYM TAB AFTER EACH FILE + FPSPGL ;V ARG SETS PAGE LENGTH OR XGP VSP + FPSLNL ;W ARG SETS LINE LENGTH + FPSXGP ;X OUTPUT TO XGP + FPSREL ;Y PRINT REAL PAGE #S, NOT VIRTUAL. + FPSSBT ;Z SUBTITLES TABLE OF CONTENTS +REPEAT 3, FPSBAD ;[ \ ] + FPSCTL ;^ OUTPUT CTL CHARS AS THEMSELVES, NOT USING UPARROWS. + FPSDLR ;_ CALL DLREC TO DESCRIBE LREC FILE. + + +IFN .-FPSTBL-77, .ERR WRONG LENGTH TABLE + +SUBTTL FILE NAME AND SWITCH DEFAULTING + +FPDEF: MOVSI C,'FOO ;DEFAULT FILE NAME 1 + MOVSI B,'DSK ;AND DEVICE. +ITS, .SUSET [.RSNAM,,N] ;DEFAULT INPUT SNAME IS OUR CURRENT SNAME. +DOS, SETZ N, +SAI, DSKPPN N, + MOVEM N,MSNAME + MOVEI A,FILES +FPDEF0: MOVE CH,F.SWIT(A) + TRNE CH,FSLREC ;LISTING RECORD FILES DEFAULT SPECIALLY. + JRST FPDLR + SKIPE F.IFN1(A) ;DEFAULT THE INPUT FN1, DEV AND SNAME. + MOVE C,F.IFN1(A) + SKIPN F.IFN1(A) + MOVEM C,F.IFN1(A) + SKIPN F.IDEV(A) + MOVEM B,F.IDEV(A) + MOVE B,F.IDEV(A) + CAMN B,[SIXBIT /NONE/] ;DEVICE NONE: MEANS LOSE THIS FILE + JRST [ MOVEI B,FSNOIN + IORM B,F.SWIT(A) + MOVSI B,'DSK + JRST FPDEF1 ] + TRNE CH,FSARW + SKIPE L + CAIA + MOVSI L,'DSK + SKIPN F.ISNM(A) + MOVEM N,F.ISNM(A) + MOVE N,F.ISNM(A) + TRC CH,FSARW\FSQUOT ;DON'T OPEN AN OUTPUT-ONLY FILE FOR INPUT. + TRCE CH,FSARW\FSQUOT + TRNE CH,FSNOIN ;IGNORE '' FILES. + JRST FPDEF1 + SKIPLE OLDFL ;IN LREC EDIT MODE, DON'T TRY OPENING FILES. + JRST [ SKIPE F.OSNM(A) ;IN LREC FILE EDIT MODE, PERFORM BIDIRECTIONAL + MOVE N,F.OSNM(A) + SKIPE F.ISNM(A) ;DEFAULTING OF NORMAL FILE SNAMES. + MOVE N,F.ISNM(A) + SKIPN F.OSNM(A) + MOVEM N,F.OSNM(A) + SKIPN F.ISNM(A) + MOVEM N,F.ISNM(A) + JRST FPDEF4 ] +FPDEF2: PUSHJ P,FPDFN2 ;OTHERWISE, DEFAULT THE FN2 IF NECESSARY, AND OPEN THE FILE. + FLOSE UTIC,F.ISNM(A) + JFCL FPDEF4 +FPDEF4: MOVE CH,[UTIC,,CHSTAT] + PUSHJ P,FPRCHS ;DO .RCHST, SET UP F.RDEV, ETC. + .CLOSE UTIC, +ITS,[ + MOVE CH,F.RFN2(A) + CAME CH,XGPFN2 ;IF FOO > TURNS OUT TO BE FOO @XGP, THE LUSER IS LOSING. + JRST FPDEF1 + CAIA ;PRINT AN ERROR MESSAGE AND LET USER RESPECIFY FILENAME. + JRST FPDEF2 ;IF HE RESPECIFIES IT, GO PROCESS WHAT HE GAVE. + FLOSEI FLSOIN,F.ISNM(A) + JFCL ERRDIE ;IF HE REFUSES, COMMIT SUICIDE. +];ITS + + ;OUTPUT FN2 DEFAULTED IN 2LOOP +FPDEF1: ADDI A,LFBLOK + CAMGE A,SFILE + JRST FPDEF0 + POPJ P, + +;OPEN THE FILE SPECIFIED BY F.IDEV(A), ETC., ON UTIC, FOR BLOCK ASCII INPUT. +;IN THE PROCESS, DEFAULT THE FN2. SKIPS IF SUCCESSFUL. +FPDFN2: MOVEI R,2 ;USE ASCII BLOCK INPUT FOR OUR OPENS. + SKIPE F.IFN2(A) + JRST FPDFN3 +DOS,[ + PUSHJ P,2INOPN ;TRY NULL EXTENSION, THEN TRY THE DEFAULT. + CAIA + JRST POPJ1 ;NULL WORKED, SO RETURN -- FILE ALREADY OPEN. +];DOS + MOVE H,CODTYP +NOITS, MOVE H,IPTFN2(H) ;NOITS, DEFAULT FN2 IS APPROPRIATE TO LANGUAGE. +ITS,[ TLNE F,FLXGP + CAIE H,CODTXT + SKIPA H,IPTFN2 ;ON ITS, IT IS USUALLY >, BUT FOR /L[TEXT]/X IT IS XGP. + MOVSI H,'XGP +];ITS + MOVEM H,F.IFN2(A) +FPDFN3: +DOS, HLLZS F.IFN2(A) ;DEFAULTING'S PAST, SO FLUSH THE RH "FOO." USES TO AVOID IT. + JRST 2INOPN ;IF IT SKIPS, WE DO TOO! + +;DEFAULT DIRECTORY OF LREC FILE. +;NOTE OUTPUT FN2 DEFAULTED IN WLREC. INPUT FN2 DEFAULTED IN RLREC. +FPDLR: SKIPE F.OFN1(A) ;PERFORM BIDIRECTIONAL DEFAULTING OF + MOVE C,F.OFN1(A) ;OUTPUT AND INPUT FN1'S. + SKIPE F.IFN1(A) + MOVE C,F.IFN1(A) + SKIPN F.OFN1(A) + MOVEM C,F.OFN1(A) + SKIPN F.IFN1(A) + MOVEM C,F.IFN1(A) + SKIPN H,F.ODEV(A) ;PERFORM BIDIRECTIONAL DEFAULTING OF + SKIPE H,F.IDEV(A) ;OF DEVICE NAME. + CAIA + MOVSI H,'DSK + SKIPN F.ODEV(A) + MOVEM H,F.ODEV(A) + SKIPN F.IDEV(A) + MOVEM H,F.IDEV(A) + SKIPN H,F.OSNM(A) ;PERFORM BIDIRECTIONAL DEFAULTING OF + SKIPE H,F.ISNM(A) ;OF SNAME. + JRST FPDLA2 +ITS, .SUSET [.RSNAM,,H] +SAI, DSKPPN H, +FPDLA2: SKIPN F.OSNM(A) + MOVEM H,F.OSNM(A) + SKIPN F.ISNM(A) + MOVEM H,F.ISNM(A) + JRST FPDEF1 + +;ATTEMPT TO DETERMINE THE LANGUAGE A FILE IS WRITTEN IN FROM ITS FN2. +;ON ITS, THAT ONLY WORKS FOR FN2 = XGP. OFF ITS, IT WORKS FOR MOST LANGUAGES. +FPDLNG: MOVEI A,FILES +FPDLN0: CAML A,SFILE + POPJ P, + MOVE H,F.SWIT(A) + TRNN H,FSNOIN+FSLREC ;LREC FILES AND IGNORED FILES SHOULDN'T BE CONSIDERED. + SKIPN H,F.IFN2(A) ;CAN'T DO ANYTHING IF FN2 NOT SPECIFIED. + JRST FPDLN3 +ITS,[ CAME H,['XGP,,] + JRST FPDLN1 + MOVEI R,CODTXT + JRST FPDLN2 + +FPDLN1: PUSHJ P,FPDLNE + JRST FPDLN3 + MOVEM R,CODTYP ;UNLIKE FN2 OF XGP, -*-TEXT-*- DOES NOT IMPLY /X. + XCT FPDLNT(R) ;THAT IS WHY WE DON'T JUST GO TO FPDLN2 HERE. + POPJ P, +];ITS +DOS,[ MOVEI R,CODMAX-1 ;DOS, FN2 = MID IMPLIES MIDAS (CODMID), ETC. +FPDLN1: CAMN H,IPTFN2(R) + JRST FPDLN2 + SOJGE R,FPDLN1 + JRST FPDLN3 +];DOS +FPDLN2: MOVEM R,CODTYP ;HERE TO STORE THE DETERMINED CODTYP AND SAY IT WAS SPECD. + XCT FPDLNT(R) ;GET SWITCH DEFAULTS FOR THAT CODTYP. + CAIE R,CODTXT ;IF WE HAVE DEFAULTED TO /L[TEXT], + POPJ P, + SKIPN ENXFDSP + SETOM NXFDSP ;THEN WE ALSO WANT /-! +XGP, TLO F,FLXGP ;AND /X + POPJ P, + +FPDLN3: ADDI A,LFBLOK ;CAN'T TELL FROM ONE FILE => LOOK AT THE NEXT ONE. + JRST FPDLN0 + + +;THIS TABLE CONTAINS THE DEFAULT SWITCH SETTINGS FOR EACH LANGUAGE KNOWN TO @. +FPDLNT: OFFSET -. +CODMID:: JFCL +CODRND:: JFCL +CODFAI:: TLO F,FLCTL +CODP11:: TLO F,FL2REF +CODLSP:: TLO F,FLARB +CODM10:: JFCL +CODUCO:: TLO F,FLARB +CODTXT:: JFCL +CODMDL:: TLO F,FLARB\FLASCI +CODDAP:: JFCL +CODMAX:: OFFSET 0 + +ITS,[ + +;TRY TO FIGURE OUT A FILE'S LANGUAGE FROM ITS "PROPERTY LIST" ( -*-FOO-*-). +;A SHOULD POINT AT THE FILE BLOCK. +;SKIP IF SUCCESSFUL, WITH CODTYP VALUE IN R. +FPDLNE: MOVEI R,2 + PUSHJ P,2INOPN + POPJ P, + PUSHJ P,2RDAHD + PUSHJ P,DOINPT + POPJ P, +FPDLN4: 1GETCH ;SKIP INITIAL BLANK LINES. + CAIN CH,40 + JRST FPDLN4 + CAIE CH,^M + CAIN CH,^J + JRST FPDLN4 + JRST FPDLN6 + +FPDLN5: 1GETCH ;SCAN THIS LINE FOR -*-. +FPDLN6: CAIE CH,^M ;GIVE UP AT END OF LINE OR END OF BUFFER. + CAIN CH,^C + POPJ P, + CAIE CH,"- + JRST FPDLN5 + 1GETCH + CAIE CH,"* + JRST FPDLN6 + 1GETCH + CAIE CH,"- + JRST FPDLN6 ;READ THE WORD THAT FOLLOWS THE -*-. + PUSHJ P,FPRDSX + POPJ P, + CAIE CH,": ;TERMINATED BY A COLON => IT OUGHT TO BE "MODE:". + JRST FPDLN7 ;OTHERWISE IT IS ITSELF THE MODE NAME. + CAMN H,[SIXBIT /MODE/] + PUSHJ P,FPRDSX ;"MODE:" => READ THE MODE NAME WHICH FOLLOWS. + POPJ P, +FPDLN7: SETO R, + CAMN H,[SIXBIT /LISP/] + MOVEI R,CODLSP + CAMN H,[SIXBIT /MUDDLE/] + MOVEI R,CODMDL + CAMN H,[SIXBIT /MIDAS/] + MOVEI R,CODMID + CAMN H,[SIXBIT /TEXT/] + MOVEI R,CODTXT + SKIPL R + AOS (P) + POPJ P, + +;READ A SIXBIT WORD INTO H FROM THE FILE VIA 1GETCH. +;SKIPS LEADING BLANKS. DOES NOT RELOAD AT END OF BUFFER. +;FAILS TO SKIP IF END OF BUFFER OR A ^C IN THE FILE IS SEEN. +FPRDSX: 1GETCH + CAIN CH,40 + JRST FPRDSX + SETZ H, + MOVE R,[440600,,H] +FPRDS2: CAIN CH,^C + POPJ P, + CAIE CH,"; + CAIN CH,40 + JRST POPJ1 + CAIE CH,"- + CAIN CH,": + JRST POPJ1 + CAIL CH,140 + SUBI CH,40 + SUBI CH,40 + TLNE R,770000 + IDPB CH,R + 1GETCH + JRST FPRDS2 +];ITS + +;FILL F.RSNM, F.RDEV, F.RFN1 AND F.RFN2 WITH THE "REAL" NAMES OF THE +;FILE OPEN ON THE CHANNEL IN LH(CH), AS OPPOSED TO THE NAMES SPEC'D +;IN THE OPEN. ALSO, ADD FILE'S LENGTH INTO LFILES. +;ALSO PUT THE FILE'S CREATION DATE AND TIME INTO F.CRDT(A). +FPRCHS: PUSH P,B + MOVE B,LFILE + CAMN B,[377777,,777777] ;IF FILE'S LENGTH ISN'T KNOWN, + MOVEI B,4000 ;ASSUME THIS VALUE. + ADDM B,LFILES ;ADD TOGETHER ALL FILES' LENGTHS IN LFILES. + HLRZS CH +ITS,[ SYSCAL RFNAME,[ CH ? %CLOUT,,F.RDEV(A) ? %CLOUT,,F.RFN1(A) + %CLOUT,,F.RFN2(A) ? %CLOUT,,F.RSNM(A)] + .LOSE %LSFIL + SETZM F.CRDT(A) +;; NOW GET THE FILE CREATION DATE. + SYSCAL RFDATE,[ CH ? %CLOUT,,F.CRDT(A)] + JFCL +];ITS +NOITS,[ LSH CH,LGEXTL + SETZM F.CRDT(A) + LDB B,[001400,,INFIL-+.RBPRV(CH)] ;*** CREATION DATE + HRLZM B,F.CRDT(A) + LDB B,[170300,,INFIL-+.RBEXT(CH)] ;DON'T FORGET THE HIGH ORDER BITS + DPB B,[360300,,F.CRDT(A)] + LDB B,[141300,,INFIL-+.RBPRV(CH)] ;RH HAS TIME IN MINUTES. + HRRM B,F.CRDT(A) + MOVE B,INFIL-+.RBNAM(CH) + MOVEM B,F.RFN1(A) + HLLZ B,INFIL-+.RBEXT(CH) + MOVEM B,F.RFN2(A) + SKIPE B,INFIL-+.RBPPN(CH) + JRST FPRCH1 +NOSAI, GETPPN B, ;Too bad DEVPPN does the wrong thing!! +SAI,[ MOVE B,CH + LSH B,-LGEXTL + DSKPPN B, +];SAI + JFCL +FPRCH1: MOVEM B,F.RSNM(A) + MOVE B,INFIL-+.RBDEV(CH) +NOSAI,[ MOVEM B,STRINF+.DCNAM ;Get the DSK STRUCTURE name + MOVE CH,[1+.DCSNM,,STRINF] + DSKCHR CH, + CAIA + MOVE B,STRINF+.DCSNM +];NOSAI + MOVEM B,F.RDEV(A) +];NOITS + SKIPN CH,F.RDEV(A) + MOVE CH,F.IDEV(A) +ITS, CAMN CH,[SIXBIT \DSK\] +ITS, MOVE CH,MACHINE + MOVEM CH,F.RDEV(A) + SKIPN CH,F.RFN1(A) + MOVE CH,F.IFN1(A) + MOVEM CH,F.RFN1(A) + SKIPN CH,F.RFN2(A) + MOVE CH,F.IFN2(A) + MOVEM CH,F.RFN2(A) + SKIPN CH,F.RSNM(A) + MOVE CH,F.ISNM(A) + MOVEM CH,F.RSNM(A) + JRST POPBJ + +;CREATE A TABLE OF POINTERS TO ALL THE INPUT FILES TO BE SCANNED, +;AND SORT THE POINTERS ALPHABETICALLY BY THE FILES' NAMES. + +FISORT: MOVEI A,FILES + MOVEI B,FILSRT-1 ;FIRST, GENERATE POINTER TABLE, NOT SORTED. +FISOR1: MOVE C,F.SWIT(A) + TRC C,FSQUOT+FSARW + TRCE C,FSQUOT+FSARW ;IF NOT AN OUTPUT-ONLY FILE, AN + TRNE C,FSLREC+FSNOIN ;LREC FILE, OR AN IGNORED ('') FILE, + CAIA + PUSH B,A ;MAKE A POINTER IN THE TABLE TO IT. + ADDI A,LFBLOK + CAMGE A,SFILE + JRST FISOR1 + SKIPN FISORF + POPJ P, +;NOW BUBBLE-SORT THE TABLE. +FISOR2: SETZ C, ;MAKE ANOTHER BUBBLE-SORT PASS: + MOVEI B,FILSRT ;B SCANS THRU, C GETS -1 IF WE MADE AN EXCHANGE THIS PASS. +FISOR3: MOVE A,(B) ;LOOP POINT WITHIN ONE PASS. + SKIPN D,1(B) ;REACHED LAST POINTER IN TABLE? + JRST [ JUMPE C,CPOPJ ;YES, NO EXCHANGES THIS PASS => SORT DONE. + JRST FISOR2] ;ELSE MAKE ANOTHER PASS. + MOVE L,F.IFN1(A) ;GET THIS FILE'S FN1 AND NEXT FILE'S. + MOVE CH,F.IFN1(D) + TLC CH,4^5 ;TO COMPARE 2 SIXBIT WORDS ALPHABETICALLY, FLIP SIGNS + TLC L,4^5 ;AND THEN COMPARE AS SIGNED NUMBERS. + CAMG L,CH + AOJA B,FISOR3 ;EXISTING ORDER OK, SO DON'T EXCHANGE. + MOVEM A,1(B) ;ELSE EXCHANGE THE TWO POINTERS IN THE TABLE. + MOVEM D,(B) + SETO C, + AOJA B,FISOR3 + +;COME HERE AFTER READING INPUT LREC FILES, IF FONT HACKERY IS ACTIVE. +;COMPUTE THE DEFAULT PAGE AND LINE SIZE FROM THE CHARACTERISTICS +;OF THE FONTS. +FNTCPT: SKIPE FNTFN1+FNTF0+FNTFL ;IF FONT 2 HAS BEEN SPEC'D, + TLO F,FLFNT2 ;WE OUGHT TO USE IT. + SKIPE FNTFN1+FNTF0+2*FNTFL ;SIMILAR FOR FONT 3 + TLO F,FLFNT3+FLFNT2 ;I DON'T THINK IT WORKS TO USE 3 BUT NOT 2. + ;NOTE THAT THIS UPDATED INFO IN F DOES NOT GO IN THE LREC OUTPUT FILE. + SKIPN FNTFN1+FNTF0 + SKIPE FNTFN1+FNTF0+FNTFL ;RIGHT NOW, ARE ANY OF THE FONT FILES SPEC'D? + JRST FNTCP0 + SKIPE FNTFN1+FNTF0+2*FNTFL + JRST FNTCP0 + SETZM FNTSPC ;NO - SAY THE FONT FEATURE IS NO LONGER IN USE. + POPJ P, ;THIS IS SO IF THE USER UN-SPECIFIES ALL FONTS WITH NONE: + ;@ WILL CEASE BELIEVING THAT FONT FILE NAMES HAVE BEEN SPEC'D. + +FNTCP0: MOVSI A,-NFNTS ;FIRST, COMPUTE MAX WIDTH OF FONTS, AND MAX HEIGHT. +FNTCP1: SKIPN B,FNTSIZ+FNTF0(A) + JRST FNTCP2 ;IGNORE FONTS WHOSE SIZE IS UNKNOWN. + LDB C,[221100,,B] + CAMLE C,FNTHGT ;ACCUMULATE MAXIMUM HEIGHT OF ANY FONT. + MOVEM C,FNTHGT + LDB C,[331100,,B] + CAMLE C,FNTBAS ;SAME FOR BASELINE. + MOVEM C,FNTBAS + HRRZ C,B + CAMLE C,FNTWID ;SAME FOR WIDTH. + MOVEM C,FNTWID +FNTCP2: ADDI A,FNTFL-1 + AOBJN A,FNTCP1 + HRRZ C,FNTSIZ+FNTF0 + SKIPN C ;GET WIDTH OF FONT USED FOR REFS AND LINE #S. + MOVE C,FNTWID ;IT IS WIDTH OF FONT 0 IF KNOWN, ELSE MAX WIDTH. + MOVEM C,FNTWDN +;TREAT THOSE MAXIMA AS EFFECTIVE SIZES OF FONTS. + SKIPE EFNTF ;IF FONTS WERE EXPLICITLY SPEC'D, + SKIPE ELINEL ;AND LINEL WASN'T, COMPUTE LINEL FROM FONT WIDTH. + JRST FNTCPL + MOVEI C,LNLDOT-LFTMAR-RGTMAR +ITS, MOVE D,QUEUE +ITS, CAIN D,QU.GLD +ITS, MOVEI C,LNLGLD-LFTMAR-RGTMAR +;NOTE THAT BECAUSE NTABS ISN'T SET UP YET THIS NEW CODE ACTUALLY ACTS JUST +;LIKE THE OLD (THAT DIDN'T DISTINGUISH FNTWID FROM FNTWDN). +;IT IS VERY HARD TO HAVE NTABS SET UP NOW SINCE IT DEPENDS ON MULTI, +;WHICH IS SET UP BY PASS 1. + MOVE B,NTABS + LSH B,3 + MOVE L,B + IMUL B,FNTWDN ;GET TOTAL LINEL, MINUS AMOUNT OF SPACE WE NEED FOR + SUB C,B ;NUMBERS AT THE LEFT MARGIN + IDIV C,FNTWID ;HOW MANY CHARS OF TEXT CAN WE FIT? + CAIGE D,3 + SUBI C,1 + ADD C,L ;THAT + SIZE OF NUMBERS AT LEFT MARGIN IS # OF CHARS ON A LINE. + MOVEM C,LINEL +FNTCPL: SKIPN EFNTVS ;IF VSP WAS JUST EXPLICITLY SPEC'D + SKIPE EFNTF ;OR FONTS WERE, + SKIPE EPAGEL ;BUT PAGEL WASN'T, + JRST FNTCPP + MOVEI C,PGLDOT-TOPMAR-BOTMAR +ITS, MOVE D,QUEUE +ITS, CAIN D,QU.GLD +ITS, MOVEI C,PGLGLD-TOPMAR-BOTMAR + ADD C,FNTVSP ;COMPUTE PAGEL FROM FONTS AND VSP. + ADD C,FNTBAS + MOVE D,FNTHGT + ADD D,FNTVSP + IDIV C,D + MOVEM C,PAGEL +FNTCPP: POPJ P, + +SUBTTL LREC FILE INPUT + +;READ ALL THE INPUT LISTING RECORD FILES INTO THE LREC AREA, +;CONCATENATING THEIR CONTENTS. AN AOBJN POINTER TO THE RESULTING +;BLOCK GOES IN OLRECA. + +RLREC: EXCH DP,LRCPTR + PUSH P,DP ;REMEMBER WHERE INFO STARTS, TO MAKE AOBJN PTR. + MOVEI A,FILES ;LOOP OVER ALL FILES. +RLREC0: MOVE B,F.SWIT(A) + TRNE B,FSLREC ;IS THIS FILE AN LREC FILE. + PUSHJ P,RLRR ;IF SO, READ IT IN. + ADDI A,LFBLOK + CAMGE A,SFILE + JRST RLREC0 + POP P,B ;RH(B) HAS ORIGIN OF BLOCK, -1. + MOVE C,B ;RH(DP) HAS ADDR OF LAST WORD OF BLOCK. + SUBI C,(DP) ;C HAS - + HRLI C,1(B) ;C HAS SWAPPED AOBJN PTR TO BLOCK. + MOVSM C,OLRECA + EXCH DP,LRCPTR + POPJ P, + +;TRY TO READ IN THE LREC FILE WHICH A POINTS TO. +;OPEN IT, THEN MAYBE GO TO RLRR2 TO READ IT IN. +RLRR: TRC B,FSQUOT+FSARW ;IS THIS JUST AN OUTPUT FILE? + TRCN B,FSQUOT+FSARW + POPJ P, ;YES, DON'T INPUT IT. +RLRR1: MOVEM A,RLRECP ;SAVE FILE BLOCK POINTER OF INPUT LREC FILE. + MOVEI R,6 ;IMAGE BLOCK INPUT + PUSHJ P,[ SKIPN F.IFN2(A) + JRST RLRRD ;OPEN INPUT LREC FILE WITH RLRRD TO DEFAULT FN2 + JRST 2INOPN] ;OR USE KNOWN FN2. + CAIA + JRST RLRR1A +ITS, .STATUS UTIC,B ;ON ITS, ANY ERROR OTHER THAN "FILE NOT FOUND" +ITS, LDB B,[220600,,B] ;MEANS WE WOULD PROBABLY BE UNABLE TO CREATE THE LREC FILE, +ITS, CAIE B,%ENSFL ;SO WE SHOULD DEFINITELY COMPLAIN. +ITS, JRST RLRR1E + MOVE R,SFILE ;CAN'T FIND THE INPUT LREC FILE!! WAS IT THE ONLY FILE SPEC'D? + CAIE R,FIL1 ;IF NOT, ASSUME HE WANTS TO CREATE ONE AND GAVE ALL THE + JRST RLRR1B ;SWITCHES AND FILENAMES, SO BE TOLERANT. +RLRR1E: CAIA ;":@ FOO/G" AND NO FOO - NO HOPE, SO ASK FOR ADVICE. + JRST RLRR1C ;RETURN HERE IF USER GIVES ALTERNATE FILENAMES - TRY AGAIN READING. + FLOSE UTIC,F.ISNM(A) ;REPORT ERROR, ASK WHAT TO DO. + JFCL CPOPJ ;RETURN HERE IF USER SAYS "GO AHEAD ANYWAY" - GIVE UP READING. + +RLRR1B: STRT [ASCIZ /(LREC file new - listing all files in full) +/] + POPJ P, + +RLRR1C: MOVE B,F.SWIT(A) ;IF INPUT LREC FILENAMES FIXED, AND NO ARROW WAS IN THE SPEC, + TRNE B,FSARW ;FIX THE OUTPUT NAMES THE SAME WAY. + JRST RLRR1 + HRLZI CH,F.ISNM(A) + HRRI CH,F.OSNM(A) + BLT CH,F.OFN2(A) + JRST RLRR1 + +;CALL HERE TO OPEN LREC INPUT FILE IF INPUT FN2 NOT SPEC'D. +RLRRD: MOVE CH,LRCFN2 ;FIRST TRY "LREC" OR "LRC" AS FN2. + MOVEM CH,F.IFN2(A) + PUSHJ P,2INOPN + JRST RLRRD1 ;LREC OR LRC NOT FOUND. + JRST POPJ1 + +RLRRD1: MOVE CH,ALRFN2 ;TRY THE ALTERNATE FN2 + MOVEM CH,F.IFN2(A) + PUSHJ P,2INOPN + JRST RLRRD2 +POPJ1: AOSA (P) +RLRRD2: SETZM F.IFN2(A) +CPOPJ: POPJ P, + +;COME HERE TO READ IN AND PROCESS THE ALREADY OPEN INPUT LREC FILE. + +RLRR1A: MOVE C,DP +ITS,[ HRROI D,R + .IOT UTIC,D ;READ 1ST WORD OF FILE. + JUMPL D,CPOPJ +];ITS +NOITS,[ PUSHJ P,INSOME ;GET FIRST BUFFER FULL + SOSGE INHED+2 + POPJ P, ;EMPTY FILE => FORGET IT + ILDB R,INHED+1 +];NOITS + CAMN R,[SIXBIT/LREC/+1] ;THIS IS WHAT IT SHOULD BE. + JRST RLRR2 ;FILE LOOKS LIKE LREC FILE. + CAIA ;IT DOESN'T; THAT'S AN ERROR. + JRST RLRR1C ;FLOSEI EXITS TO PREVIOUS INSN IF NEW FILENAMES SPEC'D. + FLOSEI FLSNLR,F.ISNM(A) ;"FILE IS NOT AN LREC FILE". + JFCL [ PUSH DP,R ;BUT USER INSISTS? OK, ASSUME IT IS ONE + JRST RLRR2] +;BRING THE CONTENTS OF THE LREC FILE INTO CORE. +RLRR2: +ITS,[ + AOBJP DP,RLRRL2 ;TURN DP INTO AOBJN PTR TO SPACE LEFT. +RLRRL: .IOT UTIC,DP ;READ UP TO THAT MUCH. +RLRRL2: JUMPL DP,RLRRL3 ;REACHED EOF? IF SO, JUMP. + SUB DP,[1,,1] ;TURN DP BACK TO PDL POINTER. + PUSHJ DP,.+1 ;CAUSE PDLOV INT THAT ALLOCATES MORE SPACE. + JRST RLRRL ;READ MORE STUFF. (TOO BAD WE CANNOT COMBINE THIS INTO THE PUSHJ) + +RLRRL3: SUB DP,[1,,1] ;TURN DP BACK INTO PDL PTR. +];ITS +NOITS,[ +RLRRL: SOSGE D,INHED+2 + JRST RLRRL3 +RLRRL2: ILDB R,INHED+1 + PUSH DP,R + SOJGE D,RLRRL2 +RLRRL3: PUSHJ P,INSOME + JRST RLRRL +];NOITS + .CLOSE UTIC, + TRNN B,FSGET ;IF FILES MENTIONED IN THIS LREC FILE SHOULD BE .INSRT'ED, + POPJ P, ;NON /G'D LREC FILES POPJ HERE. + PUSH P,DP + SUBM C,DP + HRLI C,(DP) + POP P,DP + ADDI C,1 ;COMPUTE AOBJN PTR TO WHAT WE READ FROM THE FILE, +RLRRE: HRLZI D,(C) ;COME HERE FOR EACH ENTRY IN FILE. C -> ENTRY. + HRRI D,INSSNM + BLT D,INSFN2 ;PREPARE NAMES OF FILE TO .INSRT: SAME AS IN ENTRY + SETZM INSSWT + PUSH P,3(C) ;SAVE SPEC'D FN2 (AS OPPOSED TO FN2 BEING .INSRT'ED) + ADD C,[4,,4] ;SKIP OVER FILENAMES. + PUSHJ P,RLRRS ;NOW SKIP OVER SUBENTRIES, PROCESSING SAVED SWITCHES, ETC. + ;ALSO SETS INSSWT FROM LR.SWT SUBENTRY. +ITS,[ MOVE D,CODTYP + TLNE F,FLXGP + CAIE D,CODTXT + SKIPA D,IPTFN2 +; MOVSI D,'XGP + CAIA ;IF /L[TEXT], FN2 ISN'T A VERSION #, SO LET USER SPECIFY IT + ;AND REMEMBER THE ONE HE GAVE, INSTEAD OF FORCING "XGP". + MOVEM D,INSFN2 +];ITS + PUSH P,C + PUSH P,A ;AFTER SKIPPING OVER THE ENTRY AND SETTING INSSWT, + PUSHJ P,1INSR0 ;INSERT THE FILE. + MOVE D,A + POP P,A + POP P,C + POP P,INSFN2 ;GET BACK 2ND NAME SPEC'D IN LREC FILE. + SKIPG OLDFL ;IN LREC FILE EDIT MODE, + JRST RLRRI1 + JUMPE D,RLRRI1 ;IF THE FILE REALLY WAS PUT IN OUR TABLE OF FILES, + MOVSI R,INSSNM ;SET THE RSNM - RFN2 NAMES OF FILE TO THOSE SPEC'D + HRRI R,F.RSNM(D) ;IN THE LREC FILE ENTRY, SO THEY WILL BE WRITTEN OUT + BLT R,F.RFN2(D) ;UNALTERED IN THE NEW LREC FILE. +RLRRI1: MOVE R,INSSWT ;IF LREC DATA HAD /M SWITCH SET FOR .INSRT'D FILE, + ANDI R,FSMAIN ;MUST NOT LOSE THAT INFO, EVEN IF FILE WAS EXPLICITLY + ; SPEC'D (AND 1INSR0 IGNORED INSSWT) + IORM R,F.SWIT(D) + JUMPL C,RLRRE ;IF MORE ENTRIES REMAIN IN THE LREC FILE, HANDLE THEM. + POPJ P, + +;NOW SKIP THE SUBENTRIES OF THE ENTRY. +;ALSO GET SAVE SWITCH SETTINGS, ETC. OUT OF THE SUBENTRIES +;AND USE THEM AS DEFAULTS FOR SWITCHES NOT EXPLICITLY SPEC'D. +RLRRS: ADD C,[1,,1] ;ADVANCE PAST SUBENTRY TYPE + MOVE R,-1(C) ;GET SUBENTRY TYPE + AOJE R,CPOPJ ;-1 MEANS REACHED END OF ENTRY. + ADD C,[1,,1] ;ADVANCE PAST SUBENTRY SIZE WORD + HLRE D,-1(C) + MOVNS D ;GET LENGTH OF SUBENTRY DATA + HRLS D ;PUT IT IN BOTH HALVES + ADD C,D ;AND ADVANCE C PAST THE SUBENTRY + CAIL R,LR.SWT+1 + CAIL R,DLRECL+1 + JRST RLRRS + JRST @.-LR.SWT(R) + OFFSET -.+LR.SYM+1 +LR.SWT::RLRRSW +LR.PSW::RLRRP +LR.FNT::RLRRF +LR.XGP::RLRRX +LR.CRF::RLRRC +LR.CPY::RLRRQ +LR.OUT::RLRRO +LR.DAT::RLRRS ;IGNORE OLD FILE CREATION DATE. +DLRECL::OFFSET 0 + +;HANDLE LR.SWT SUBENTRY +RLRRSW: MOVE R,-1(C) ;USE THE DATA WORD AS THE PER-FILE SWITCHES OF THE FILE. + ANDCMI R,FSSUBT+FSAUX+FSNCHG+FSLALL+FSLRNM + SKIPE EMSWT + ANDCMI R,FSMAIN + MOVEM R,INSSWT ;USE DATA WORD AS DESIRED F.SWIT FOR .INSRT'ED FILE. + JRST RLRRS + +;HANDLE LR.CRF SUBENTRY. +RLRRC: SKIPE ECRFF + JRST RLRRS + MOVSI R,-5(C) + HRRI R,CRFFIL + BLT R,CRFOFL + JRST RLRRS + +;HANDLE LR.OUT SUBENTRY +RLRRO: SKIPE EOUTFIL + JRST RLRRS + MOVSI R,-4(C) + HRRI R,OUTFIL + BLT R,OUTFIL+3 + JRST RLRRS + +;HANDLE LR.CPY SUBENTRY +RLRRQ: MOVE R,EF + TLNE R,FLQPYM + JRST RLRRS + SETZM CPYMSG ;FIRST CLEAR OUT COPYRIGHT MESSAGE AREA + MOVE R,[CPYMSG,,CPYMSG+1] + BLT R,CPYMSG+LCPYMSG-1 + MOVEI R,CPYMSG-1(D) ;IF MESSAGE TOO LONG, JUST FILL AREA + CAILE R,CPYMSG+LCPYMSG-1 + MOVEI R,CPYMSG+LCPYMSG-1 + SUBM C,D + MOVSI D,(D) + HRRI D,CPYMSG + BLT D,(R) ;COPY LREC COPYRIGHT INTO COPYRIGHT AREA + JRST RLRRS + +;HANDLE LR.PSW SUBENTRY. +RLRRP: HRRZ R,C + SUBM R,D ;D GETS -,,< -> 1ST DATA WORD OF SUBENTRY> + HLLO R,EF + AND F,R ;THROW AWAY ALL SWITCHES IN LH(F) NOT EXPLICITLY SPEC'D. + HLLZ R,(D) ;GET SAVED VALUE OF SWITCHES IN F. + ANDCM R,EF ;MASK TO THOSE NOT SPEC'D THIS TIME. + IOR F,R ;MERGE: EXPLICITLY SPEC'D FROM F, ALL OTHERS FROM SUBENTRY. +IRPS X,,LINEL PAGEL UNIVCT CODTYP TRUNCP SINGLE PRLSN SYMLEN QUEUE + AOBJP D,RLRRS + MOVE R,(D) +IFE X-SYMLEN, MOVMS R ;COMPATABILITY FOR SYMLEN WHICH WAS ONCE NEGATIVE + SKIPN E!X ;SET THOSE NUMERIC SWITCHES USER DIDN'T OVERRIDE. + MOVEM R,X +IFE X-CODTYP, SETOM ECODTYP ;IF CODTYP IS SET HERE, INHIBIT FPDLNG. +TERMIN + AOBJP D,RLRRS + MOVE R,(D) ;NEXT WORD IN LR.PSW IS A WORD OF BITS, WHICH WE MUST DECODE. + SKIPN ENOTIT ;BIT 1.1 IS SET IFF NOTITLE SHOULD BE NONZERO. + DPB R,[.BP 1,NOTITL] + LSH R,-1 + SKIPN EREALPG ;BIT 1.2 IS SET IF REALPG SHOULD BE NONZERO. + DPB R,[.BP 1,REALPG] + LSH R,-1 ;BITS 1.3, 1.4 GO INTO TOP 2 BITS OF NXFDSP, + SKIPN ENXFDSP + SETZM NXFDSP + SKIPN ENXFDSP + DPB R,[.BP (600000),NXFDSP] ;THUS SETTING NXFDSP TO EITHER SIGN OR TO ZERO. + AOBJP D,RLRRS + MOVE R,(D) ;WORD 12 IN THE LR.PSW BLOCK IS THE VALUE OF SYMTRN. + SKIPN ESYMTRN + MOVEM R,SYMTRN + JRST RLRRS + +;HANDLE LR.XGP SUBENTRY +RLRRX: MOVE R,-1(C) ;GET THE DATA WORD + SKIPN EFNTVS ;AND SET VSP, UNLESS USER ALREADY DID. + MOVEM R,FNTVSP + JRST RLRRS + +;HANDLE LR.FNT SUBENTRY +RLRRF: SETOM FNTSPC ;MAKE SURE FONTS GO IN OUTPUT FILES. + SUB C,D ;POINT AT START OF DATA WORDS. + MOVEI R,FNTF0-1 ;SET UP R AS PDL POINTER TO PUSH DATA INTO FONT TABLE. +RLRRF0: CAIN R,FNTFE-1 + JRST RLRRF1 ;FILLED UP THE FONT TABLE; IGNORE REST OF SUBENTRY. + JUMPE D,RLRRF1 ;END OF SUBENTRY => STOP. + SKIPE 1+FNTEXP(R) ;WAS NEXT FONT FILE SPEC'D BY USER? + JRST [ ADDI R,FNTFL ;YES, SKIP THE FILE IN SUBENTRY. + JRST RLRRF2] + REPEAT FNTFL,PUSH R,.RPCNT(C) ;NO COPY FILE FROM SUBENTRY TO FONT TABLE. + SETZM FNTEXP-FNTFL+1(R) ;MAKE SURE FNTEXP ISN'T CHANGED IN PROCESS. +RLRRF2: ADD C,[FNTFL,,FNTFL] ;SKIP TO NEXT FILE IN SUBENTRY. + SUB D,[FNTFL,,FNTFL] + ANDI R,-1 ;MAKE SURE CAIE R, WILL WORK. + JRST RLRRF0 + +RLRRF1: ADD C,D ;SKIP REMAINING UNUSED PART OF SUBENTRY. + JRST RLRRS + +SUBTTL LREC FILE MATCHING ROUTINES + +;LOOK THRU THE INPUT LISTING RECORD INFO, ASSOCIATING THE ENTRIES +;WITH THE FILES THAT THEY CORRESPOND TO. THIS IS DONE AFTER PASS 1, +;WHEN ALL FILES TO BE HANDLED HAVE ALREADY BEEN ENCOUNTERED, AND +;FILE BLOCKS CREATED FOR THEM. + +MLREC: SKIPN NOCOMP ;DON'T BOTHER MATCHING IF WE WANT TO LIST EVERYTHING +MLREC0: SKIPL B,OLRECA ;OR THERE IS NO OLD LREC INFO TO MATCH WITH + POPJ P, +MLREC1: PUSH P,[[0]] ;IF LR.DAT FOUND, ITS ADDRESS GOES HERE + PUSH P,B ;ADDRESS OF BEGINNING OF LREC ENTRY + PUSH P,[0] ;IF LR.PAG SUBENTRY FOUND, ITS ADDRESS GOES HERE. + PUSH P,[0] ;LR.SYM SUBENTRY ADDRESS GOES HERE. + ADD B,[4,,4] ;ADVANCE PAST FILENAMES AT BEGINNING OF ENTRY. +;ADVANCE PAST THE NEXT SUBENTRY. +MLREC2: MOVE C,(B) ;GET NEXT SUBENTRY TYPE + AOJE C,MLREC3 ;-1 MEANS REACHED END OF ENTRY. + HRLZI A,2(B) ;FORM IN A A SWAPPED AOBJN PTR TO DATA WORDS + HLR A,1(B) ;OF THE SUBENTRY. + CAIN C,LR.SYM+1 + MOVSM A,(P) ;AND IF THE SUBENTRY IS LR.PAG OR LR.SYM, + CAIN C,LR.PAG+1 + MOVSM A,-1(P) ;REMEMBER WHERE IT IS. + CAIN C,LR.DAT+1 + HLRZM A,-3(P) + MOVNI A,-2(A) ;GET TOTAL SIZE OF SUBENTRY + HRLI A,(A) ;IN BOTH HALVES + ADD B,A ;SKIP OVER IT + JUMPL B,MLREC2 ;AND LOOP + .VALUE ;UNLESS WE LOST UTTERLY + +;COME HERE ON REACHING THE END OF AN ENTRY. +MLREC3: MOVE C,-2(P) ;GET ADDRESS OF START OF ENTRY + MOVE C,2(C) ;GET THE FN1 FROM THE FILENAMES AT THE FRONT. + MOVEI A,FILES ;NOW LOOK AT ALL FILES KNOWN WITH THAT FN1. +MLREC4: CAME C,F.IFN1(A) + JRST MLREC5 + MOVE H,F.SWIT(A) + MOVE D,-2(P) + MOVE D,3(D) ;GET FN2 FROM THE ENTRY + SKIPE F.OLRC(A) ;IF THIS IS NOT THE FIRST ENTRY TO MATCH + CAMN D,F.IFN2(A) ;AND IT IS NOT AN EXACT MATCH, + TRNE H,FSLREC ;OR IT'S AN LREC FILE, + JRST MLREC5 ;THEN IT SHOULDN'T GET THIS OLREC INFO. + MOVE D,-2(P) + MOVEM D,F.OLRC(A) ;REMEMBER ADDR OF OLREC INFO FOR FILE. + MOVE D,@-3(P) ;ALSO SAVE OLD FILE DATE + MOVEM D,F.OCRD(A) + SKIPE D,(P) ;SET F.OSMT FROM SUBENTRY WE FOUND, MAKING SURE THAT + MOVEM D,F.OSMT(A) ;IF THERE WAS NO SUBENTRY IN THIS ENTRY, BUT WAS ONE + TRNE H,FSLALL ;IF WANT FULL LISTING OF THIS FILE, FORGET THE OLD + JRST MLREC5 ;CHECKSUMS. + SKIPE D,-1(P) ;IN A PREVIOUS ENTRY, WE DON'T FORGET THE OLD ONE. + MOVEM D,F.OPGT(A) ;ALSO SAVE PAGE TABLE SUBENTRY. +MLREC5: ADDI A,LFBLOK + CAMGE A,SFILE + JRST MLREC4 + SUB P,[4,,4] ;NO APPROPRIATE FILE => THROW AWAY SAVED INFO. + AOBJN B,MLREC1 ;LOOP IF ANY MORE ENTRIES + POPJ P, + +;;; IN LREC FILE EDIT MODE, PERFORM ALTERATIONS OF REMEMBERED FILENAMES +;;; AS SPEC'D BY THE COMMAND STRING. + +XLREC: MOVEI A,FILES +XLREC1: MOVE B,F.OPGT(A) + MOVEM B,F.PAGT(A) + MOVE B,F.OLRC(A) ;"REAL FN2" IN OUTPUT LREC FILE IS SAME AS IT WAS IN INPUT. + MOVE B,F.IFN2(B) + MOVEM B,F.RFN2(A) + MOVE B,F.SWIT(A) ;EVERY NON-LREC FILE WHICH HAD A "_" IN ITS SPEC + TRNN B,FSLREC + TRZN B,FSARW + JRST XLREC2 + MOVEM B,F.SWIT(A) ;HAS FSARW CLEARED SO WLREC WON'T CONSIDER THIS A BACKARROW-SIGLEQUOTE FILE EVEN IF SINGLEQUOTE FLAG IS SET, + MOVSI B,F.OSNM(A) ;AND HAS THE SPEC'D OUTPUT NAMES + HRRI B,F.RSNM(A) ;REPLACE THE REMEMBERED NAMES FROM THE OLD LREC FILE + BLT B,F.RFN1(A) + SKIPE B,F.OFN2(A) ;BUT THE FN2 IS HACKED ONLY IF IT WAS SPEC'D. + MOVEM B,F.RFN2(A) +XLREC2: ADDI A,LFBLOK + CAMGE A,SFILE + JRST XLREC1 + POPJ P, + + +;;; DEFAULT THE LREC OUTPUT FN2. CALLED AFTER RLREC, SO IF THERE'S A /M'D FILE +;;; WE ALREADY KNOW ABOUT IT. + +WLRDF: SKIPE A,WLRECP + SKIPE C,F.OFN2(A) + POPJ P, + MOVEI B,FILES ;OUTPUT LREC FN2 NOT SPEC'D: LOOP FOR "MAIN" FILE. +WLREC1: MOVE D,F.SWIT(B) + TRNN D,FSMAIN + JRST WLREC3 + MOVE D,F.RFN1(B) ;FOUND THE MAIN FILE. UNLESS ITS SNAME AND FN1 + MOVE CH,F.RSNM(B) ;ARE THE SAME AS THE LREC FILE'S, + CAMN D,F.OFN1(A) + CAME CH,F.OSNM(A) + SKIPA C,F.RFN2(B) ;USE THE MAIN FILE'S FN2 AS LREC OUTPUT'S FN2. + JRST [ ;OTHERWISE, TRY USING "LR" FOLLOWED BY MAIN FILE'S FN2 + LDB C,[143000,,F.RFN2(B)] + TLO C,'LR_6 + CAMN C,F.RFN2(B) ;BUT CATCH SCREW CASE THAT FN2 IS "LRLRLR"!?!? + SETZ C, + JRST WLREC3] +WLREC3: ADDI B,LFBLOK + CAMGE B,SFILE + JRST WLREC1 + SKIPN C ;LAST RESORT DEFAULT FOR FN2 IS "LREC" OR "LRC" + MOVE C,LRCFN2 + MOVEM C,F.OFN2(A) + POPJ P, + +SUBTTL LREC DUMPING ROUTINES (FOR DEBUGGING) + +;FOR /_, OUTPUT AN ASCII TRANSLATION OF THE INPUT LREC INFO, +;CONTAINING ALL THE INFORMATION THE INPUT LREC FILES HAD. +;MAY BE CALLED FROM DDT VIA PUSHJ P,DLREC$X AFTER BREAKING ANYWHERE +;AFTER DLRECB AND BEFORE CPRFP +DLREC: PUSH P,2PUTX ? MOVSI A,(JFCL) ? MOVEM A,2PUTX + PUSH P,2PUTNX ? MOVSI A,(CAIA) ? MOVEM A,2PUTNX +REPEAT 4,[ + SKIPE B,OUTFIL+.RPCNT ;XFER /O-SPECIFIED DEFAULT DEV AND SNAME INTO FILENAME BLOCK. + MOVEM B,DLRECF+.RPCNT +] + MOVSI B,'DSK ;IF IT DOESN'T SAY, WE HAVE FURETHER DEFAULTS. + SKIPN DLRECF+1 ;NOTE 2LOOPD WILL DEFAULT THE SNAME. FN1 AND FN2 FIXED. + MOVEM B,DLRECF+1 + MOVEI A,DLRECF-F.OSNM + PUSH P,FNTSPC + SETZM FNTSPC + PUSHJ P,2LOOPO + POP P,FNTSPC + SETZB CC,OUTVP + MOVEI B,[ASCIZ /Disassembly of LREC file /] + PUSHJ P,ASCOUT + MOVE L,RLRECP + PUSHJ P,FILOUT + PUSHJ P,CRLOUT + MOVE C,OLRECA + JUMPGE C,DLRCLS +;PROCESS THE NEXT ENTRY IN THE INPUT LREC DATA. +DLREC1: PUSHJ P,CRLOUT + MOVEI B,[ASCIZ/File: /] + PUSHJ P,ASCOUT + MOVEI L,-F.RSNM(C) + PUSHJ P,FILOUT + ADD C,[4,,4] + PUSHJ P,CRLOUT +;HANDLE NEXT SUBENTRY. +DLREC3: SKIPGE (C) + JRST DLRE ;JUMP IF END OF ENTRY. + PUSHJ P,CRLOUT + MOVEI B,[ASCIZ/Subentry: /] + PUSHJ P,ASCOUT + MOVE A,(C) + PUSHJ P,OCTP + HLRE A,1(C) + MOVNS A + 2PATCH ": + PUSHJ P,OCTP + 2PATCH 40 + SKIPLE A,(C) + CAIL A,DLRECL + SKIPA B,['LOSE..] + MOVE B,DLRECT-1(A) + JSP H,SIXOUT + PUSHJ P,CRLOUT + MOVE A,(C) + ADD C,[2,,2] + HLRE D,-1(C) + CAIGE A,DLRECL + JUMPG A,@DLREC4-1(A) +DLREC2: MOVE A,(C) + PUSHJ P,OCTP + PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ + AOBJP C,DLRCLS + AOJL D,DLREC2 + JRST DLREC3 + +DLREC4: OFFSET -.+1 +LR.PAG::DLRP +LR.SYM::DLRSY +LR.SWT::DLRSW +LR.PSW::DLRPS +LR.FNT::DLRF +LR.XGP::DLRX +LR.CRF::DLRC +LR.CPY::DLRCP +LR.OUT::DLRO +LR.DAT::DLRDAT +DLRECL::OFFSET 0 + +DLRECT: OFFSET -.+1 +LR.PAG::'LR.PAG +LR.SYM::'LR.SYM +LR.SWT::'LR.SWT +LR.PSW::'LR.PSW +LR.FNT::'LR.FNT +LR.XGP::'LR.XGP +LR.CRF::'LR.CRF +LR.CPY::'LR.CPY +LR.OUT::'LR.OUT +LR.DAT::'LR.DAT +DLRECL::OFFSET 0 + +;COME HERE ON REACHING THE -1 THAT ENDS AN ENTRY +DLRE: PUSHJ P,CRLOUT ;SAY THIS IS THE END OF AN ENTRY + MOVE B,[SIXBIT/END/] + JSP H,SIXOUT + PUSHJ P,CRLOUT + AOBJN C,DLREC1 ;IF THERE ARE MORE ENTRIES, HANDLE THEM. +DLRCLS: POP P,2PUTNX + POP P,2PUTX + MOVE A,OFILE ;ELSE CLOSE THE FILE. + JRST 2OCLS + +;HANDLE A PAGE-TABLE SUBENTRY. +DLRP: MOVE A,(C) + PUSHJ P,OCTP + MOVEI B,[ASCIZ / Page /] + PUSHJ P,ASCOUT + PUSH P,D + MOVEI D,(C) + PUSHJ P,MJMNR1 + POP P,D + MOVEI CH,"# + HRRZ L,1(C) + TRNE L,NEWPAG + PUSHJ P,CHROUT + HLRZ A,1(C) + JUMPE A,DLRP1 + PUSHJ P,SPCOUT + 2PATCH "( + PUSHJ P,000X + 2PATCH ") +DLRP1: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ + ADD C,[2,,2] + ADDI D,2 + JUMPL D,DLRP + JUMPL C,DLREC3 + JRST DLRCLS + +;HANDLE A SYMBOL TABLE SUBENTRY - PRINT ONE LINE PER SYMBOL. +DLRSY: MOVE R,C + MOVE C,LINEL + PUSHJ P,SYMOUT ;OUTPUT SYMBOL NAME. + MOVEI CH,^I + PUSHJ P,CHROUT + HRRZ A,S.TYPE(C) + HRRZ B,(A) + PUSHJ P,ASCOUT ;OUTPUT SYMBOL TYPE. + PUSHJ P,SPCOUT + HLRZ A,S.PAGE(C) + PUSHJ P,000X + 2PATCH "- + HRRZ A,S.LINE(C) + ADDI A,1 + PUSHJ P,000X + PUSHJ P,SPCOUT ;SAY WHICH FILE DEFINITION IS IN + MOVE B,[SIXBIT/(FILE/] + JSP H,SIXOUT + PUSHJ P,SPCOUT + HLRZ A,S.FILE(C) ;FIND AND PRINT FN1 OF THE FILE. + MOVE B,F.RFN1(A) + JSP H,SIXOUT + 2PATCH ") + HLRZ A,S.BITS(C) + JUMPE A,DLRSY1 ;IF THE S.BITS FIELD IS NON-NULL, PRINT IT TOO. + PUSHJ P,SPCOUT + PUSHJ P,OCTP +DLRSY1: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ + ADD C,[LSENT,,LSENT] + ADDI D,LSENT + JUMPGE C,DLRCLS + JUMPL D,DLRSY + JRST DLREC3 + +;HANDLE A QOPYRIGHT SUBENTRY +DLRCP: MOVSI B,(440700,,(C)) + MOVEI L,5 +DLRCP1: ILDB CH,B + PUSHJ P,CHROUT + SOJG L,DLRCP1 + ADD C,[1,,1] + AOJL D,DLRCP + PUSHJ P,CRLOUT + JUMPL C,DLREC3 + JRST DLRCLS + +;HANDLE LR.PSW SUBENTRY. +DLRPS: HRLZS D +DLRPS2: SKIPL B,DLRPS1(D) ;SKIP UNLESS PAST LAST KNOWN ENTRY NAME + HRRI D,-1(D) ;DON'T ADVANCE BEYOND THE "?" + JSP H,SIXOUT + 2PATCH "= + MOVE A,(C) + PUSHJ P,OCTP + PUSHJ P,CRLOUT ;WE PROBABLY SHOULD ALSO INTERPRET THE BITS (SIGH) + AOBJP C,DLRCLS + AOBJN D,DLRPS2 + JRST DLREC3 + +DLRPS1: SIXBIT/F/ + SIXBIT/LINEL/ + SIXBIT/PAGEL/ + SIXBIT/UNIVCT/ + SIXBIT/CODTYP/ + SIXBIT/TRUNCP/ + SIXBIT/SINGLE/ + SIXBIT/PRLSN/ + SIXBIT/SYMLEN/ + SIXBIT/NOQUEU/ + SIXBIT/BITS/ + SIXBIT/SYMTRN/ + SIXBIT/?/ ;SPECIAL FOR ANY EXTRAS + +;HANDLE LR.SWT SUBENTRY +DLRSW: MOVE B,[SIXBIT/F.SWIT/] + JSP H,SIXOUT + 2PATCH "= + MOVE A,(C) + PUSHJ P,OCTP + PUSHJ P,CRLOUT ;WE PROBABLY SHOULD ALSO INTERPRET THE BITS (SIGH) +DLRDUN: ADD C,[1,,1] + AOJE D,DLREC3 + MOVEI B,[ASCIZ /Extra words follow the meaningful data in this block +/] + PUSHJ P,ASCOUT + HLRZS D + SUB C,D + JRST DLREC3 + +;HANDLE LR.FNT SUBENTRY. +DLRF: SKIPN FNTSIZ(C) + JRST DLRF1 ;NOTHING KNOWN FOR THIS FONT => PRINT NOTHING. + MOVEI L,-F.RSNM(C) + PUSHJ P,FILOUT + MOVEI CH,"( + PUSHJ P,CSPOUT + MOVE A,FNTSIZ(C) + PUSHJ P,OCTP + 2PATCH ") +DLRF1: ADD C,[FNTFL,,FNTFL] + ADDI D,FNTFL + JUMPL D,[MOVEI CH,", ? PUSHJ P,CSPOUT ? JRST DLRF] + PUSHJ P,CRLOUT + JUMPGE C,DLRCLS + JRST DLREC3 + +;HANDLE LR.CRF SUBENTRY. +DLRC: SKIPN 4(C) ;IF ENTRY SAYS "NO FILE IS SPEC'D", + JRST DLRC1 ;IT'S THE SAME AS NO ENTRY AT ALL. +;HANDLE LR.OUT SUBENTRY. +DLRO: MOVEI L,-F.RSNM(C) + PUSHJ P,FILOUT ;ELSE LIST NAMES THAT ARE SPEC'D. +DLRC2: MOVN L,-1(C) + HLRS L + ADD C,L + PUSHJ P,CRLOUT + JUMPGE C,DLRCLS + JRST DLREC3 + +DLRC1: MOVE B,[SIXBIT/NONE:/] + JSP H,SIXOUT + JRST DLRC2 ;MUST PASS OVER THE ENTRY EVEN IF IT SAYS NOTHING. + +;HANDLE LR.XGP SUBENTRY. +DLRX: MOVE B,[SIXBIT/VSP=/] + JSP H,SIXOUT + MOVE A,(C) + PUSHJ P,000X + PUSHJ P,CRLOUT + AOBJN C,DLREC3 + JRST DLREC3 + +;HANDLE AN LR.DAT SUBENTRY. PRINT DATE AS DATE (ACCORDING TO SYSTEM RUNNING ON) AND AS OCTAL. +DLRDAT: PUSH P,D + MOVEI B,[ASCIZ /File date as octal word = /] + PUSHJ P,ASCOUT + HLRZ A,(C) + PUSHJ P,OCTP + MOVEI B,[ASCIZ /,,/] + PUSHJ P,ASCOUT + HRRZ A,(C) + PUSHJ P,OCTP + PUSHJ P,CRLOUT + MOVE R,(C) + PUSH P,C + PUSHJ P,PTQDAT + PUSHJ P,CRLOUT + POP P,C + POP P,D + JRST DLRDUN + +SUBTTL LREC FILE OUTPUT + +;WRITE 1 WORD INTO LREC FILE (USING BUFFER) FROM ACCUMULATOR X. +ITS,[ +DEFINE WLRWWD X,(Y) +IFNB [Y]MOVE X,Y + IDPB X,C + SOSG D + PUSHJ P,WLRWO +TERMIN +];ITS +NOITS,[ +DEFINE WLRWWD X,(Y) +IFNB [Y]MOVE X,Y + SOSGE OUTHED+2 + PUSHJ P,WLRWO + IDPB X,OUTHED+1 +TERMIN +];NOITS + +DEFINE WLRWWI HALF,(VAL) ;IMMEDIATE RIGHT OR LEFT HALF WLRWWD. USES B. + HR!HALF!ZI B,VAL + WLRWWD B +TERMIN + +;;; WRITE AN OUTPUT LREC FILE, IF THAT'S REQUESTED. + +WLREC: SKIPN A,WLRECP + POPJ P, + PUSHJ P,WLRECR ;RENAME OLD LREC FILE AS OLREC. + MOVEI R,7 ;WE WANT IMAGE OUTPUT. +ITS, MOVE H,[SIXBIT/LREC/] ;OPEN _@_ LREC ON ITS. +NOITS, ;H WAS SET UP IN WLRECR + PUSHJ P,2OUTOP + FLOSE UTOC,F.OSNM(A) + JFCL CPOPJ +ITS,[ MOVE C,[004400,,SLBUF-1] ;USE SLBUF TO BUFFER WRITING OF LREC FILE. + MOVEI D,LSLBUF ;C HAS BP TO IDPB, D HAS SPACE LEFT. +] + PUSH P,A ;REMEMBER OUTPUT LREC FILEBLOCK ADDR FOR FINAL RENMWO (ON ITS). + WLRWWD B,[SIXBIT/LREC/+1] ;1ST WORD OF LREC FILE IS SIXBIT/LREC/+1 + MOVEI A,FILES ;LOOK AT ALL FILES, +WLREC2: MOVE B,F.SWIT(A) + TRNN B,FSLREC + PUSHJ P,WLRW ;WRITING AN ENTRY FOR EACH NORMAL FILE + ADDI A,LFBLOK + CAMGE A,SFILE + JRST WLREC2 + PUSHJ P,WLRWO ;PUSH OUT WHAT'S BUFFERED IN SLBUF. + POP P,A + JRST 2OCLS1 ;RENAME AND CLOSE THE OUTPUT FILE. + +;UNLESS THE OUTPUT LREC FN2 IS ">", RENAME ANY EXISTING FILE WE WOULD +;BE SUPERSEDING AS "OLREC". + +WLRECR: +ITS,[ MOVE CH,F.OFN2(A) ;IF OUTPUT FN2 ISN'T ">", + CAMN CH,[SIXBIT/>/] ;ANY OLD FILE WITH SAME NAME WOULD BE OVERWRITTEN, + POPJ P, + MOVEM CH,F.OFN2(A) ;SO RENAME IT "OLREC". + .CALL [ SETZ ? 'DELETE ? F.ODEV(A) ? F.OFN1(A) ? OLRFN2 ? SETZ F.OSNM(A)] + JFCL + .CALL [ SETZ ? 'RENAME ? F.ODEV(A) ? F.OFN1(A) ? F.OFN2(A) ? F.OSNM(A) + F.OFN1(A) ? SETZ OLRFN2] + JFCL +];ITS +NOITS,[ SETZ H, ;For now, use default PROTECTION when we ENTER the new .LRC file + MOVE CH,F.ODEV(A) + MOVEM CH,RNMCHN+1 + DEVCHR CH, + TLNE CH,1000 ;DIRECTORY DEVICE? + OPEN RNMC,RNMCHN ;YES, TRY TO DO RENAMING HACK. + POPJ P, + LSH CH,11. ;MAKE SIGN BIT BE DTA BIT + HLLM CH,(P) + MOVE CH,F.OFN1(A) + MOVEM CH,RNMFIL+.RBNAM + HLLZ CH,F.OFN2(A) + CAMN CH,OLRFN2 + JRST WLREC8 + HLLZM CH,RNMFIL+.RBEXT + MOVE CH,F.OSNM(A) + MOVEM CH,RNMFIL+.RBPPN +NOSAI, LOOKUP RNMC,RNMFIL ;TRY EXTENDED LOOKUP + JRST [ MOVEM CH,RNMFIL+.RBNAM+3;Failed, try non-extended + LOOKUP RNMC,RNMFIL+.RBNAM + JRST WLREC8 ;Still failed -- must not exist +IFN 0,[ ;THE LOGICAL DEVICE NAME WILL DO FOR NOW + MOVEI CH,RNMC +SAI, PNAME CH, +NOSAI, DEVNAM CH, +];IFN 0 + MOVE CH,F.ODEV(A) + MOVEM CH,RNMFIL+.RBDEV + JRST .+1 ] + HLLZ H,RNMFIL+.RBPRV ;Get the old protection for the new .LRC file + TLZ H,777 ;But not the "M" or "TIME" fields + MOVE CH,F.ODEV(A) + CAMN CH,[SIXBIT /DSK/] ;Was the device DSK? + MOVE CH,RNMFIL+.RBDEV ;yes, use the real device + EXCH CH,F.ODEV(A) ;when ENTERing the .LRC file + MOVEM CH,DELCHN+1 ;But use the DSK for deleting + OPEN DELC,DELCHN + .VALUE ;DEVICES SHOULDN'T JUST DISAPPEAR!!! + MOVE CH,F.OFN1(A) + MOVEM CH,DELFIL+.RBNAM + MOVE CH,OLRFN2 + HLLZM CH,DELFIL+.RBEXT + MOVE CH,F.OSNM(A) + MOVEM CH,DELFIL+.RBNAM+3 ;Funny Place because + LOOKUP DELC,DELFIL+.RBNAM ;Non extended lookup + JRST WLREC6 + SETZM DELFIL+.RBNAM + RENAME DELC,DELFIL+.RBNAM + JFCL ;WELL, WE TRIED ANYHOW +WLREC6: RELEASE DELC, + SKIPL (P) ;DECTAPE? + JRST WLREC5 ;NO, NO NEED TO RE LOOKUP + LOOKUP RNMC,RNMFIL+.RBNAM ;DECTAPE FORGETS MORE THAN ONE LOOKUP!!! (SIGH) + JRST WLREC8 ;I WONDER WHAT HAPPENED + CLOSE RNMC, ;DECTAPE ALSO LIKES A CLOSE FIRST, ACCORDING TO THE MANUAL +WLREC5: MOVE CH,OLRFN2 + HLLM CH,RNMFIL+.RBEXT ;CHANGE EXT WITHOUT CLOBBERING DATES + MOVE CH,F.OSNM(A) + MOVEM CH,RNMFIL+.RBNAM+3 ;LOSING NON EXTENDED LOOKUP CLOBBERS THIS WORD + RENAME RNMC,RNMFIL+.RBNAM + JFCL ;WELL, WE TRIED ANYHOW +WLREC8: RELEASE RNMC, +];NOITS + POPJ P, + +;EMPTY THE BUFFERED DATA FROM SLBUF INTO THE FILE, AND RE-INIT C AND D. +WLRWO: +ITS,[ SUBI C,SLBUF-1 ;# WDS OF DATA PUT IN SLBUF. + MOVNS C + HRLZI C,(C) + HRRI C,SLBUF ;AOBJN PTR TO USED PART OF SLBUF. + JUMPGE C,WLRWO2 + .IOT UTOC,C ;WRITE IT OUT. +WLRWO2: MOVE C,[004400,,SLBUF-1] + MOVEI D,LSLBUF ;BUFFER NOW EMPTY; RE-INIT STORING IN IT. + POPJ P, +];ITS +NOITS,[ OUT UTOC, + JRST WLRWO2 + PUSH P,N + GETSTS UTOC,N + .VALUE + TRZ N,740000 + SETSTS UTOC,(N) + POP P,N +WLRWO2: SOSGE OUTHED+2 + .VALUE + POPJ P, +];NOITS + +;WRITE AN LREC ENTRY FOR THE FILE WHOSE BLOCK A POINTS TO. +WLRW: TRC B,FSQUOT+FSARW + TRCN B,FSARW+FSQUOT ;NO LREC ENTRY FOR OUTPUT-ONLY FILES. + POPJ P, + MOVE B,F.IDEV(A) ;WRITE NO INFO ABOUT FILES ON DEVICE NONE:, + CAMN B,[SIXBIT/NONE/] ;SO LREC EDIT MODE CAN GET RID OF FILE BY CHANGING DEV TO NONE:. + POPJ P, + SKIPN B,F.RSNM(A) ;WRITE THE SNAME + MOVE B,F.ISNM(A) + WLRWWD B +CMU, SKIPN B,F.IDEV(A) ;UNDER CMU, USE THE SPECIFIED DEVICE, NOT THE REAL DEVICE + SKIPN B,F.RDEV(A) ;WRITE THE DEV + MOVE B,F.IDEV(A) + WLRWWD B + SKIPN B,F.RFN1(A) ;WRITE THE FN1 + MOVE B,F.IFN1(A) + WLRWWD B + SKIPN B,F.RFN2(A) ;WRITE THE FN2 + MOVE B,F.IFN2(A) + WLRWWD B + WLRWWI R,LR.PSW ;SAVE ALL SWITCH SETTINGS. + WLRWWI L,-12. ;-12. IN L.H. +INSIRP WLRWWD B,REALF LINEL PAGEL UNIVCT CODTYP TRUNCP SINGLE PRLSN SYMLEN QUEUE + SETZ B, ;FROM NOW ON, ALL THOSE 1 BIT PER WORD FLAGS GET ENCODED: + SKIPE NOTITL ;BIT 1.1 OF WORD 11 MEANS NOTITL IS NONZERO. + TRO B,1 + SKIPE REALPG ;BIT 1.2 MEANS REALPG IS NONZERO (/Y). + TRO B,2 + SKIPE NXFDSP ;BIT 1.3 REFLECTS NONZERONESS OF NXFDSP. + TRO B,4 + SKIPGE NXFDSP ;BIT 1.4 IS SIGN BIT OF NXFDSP. + TRO B,10 + WLRWWD B ;OUTPUT THE ENCODED WORD. + WLRWWD B,SYMTRN + WLRWWI R,LR.SWT ;WRITE F.SWIT IN AN LR.SWT SUBENTRY. + WLRWWI L,-1 + WLRWWD B,F.SWIT(A) + SKIPN OUTFIL + SKIPE OUTFIL+1 + JRST WLRWX4 + SKIPN OUTFIL+2 + SKIPE OUTFIL+3 + JRST WLRWX4 + JRST WLRWX5 + +WLRWX4: WLRWWI R,LR.OUT + WLRWWI L,-4 +WLRWX6: WLRWWD CH,OUTFIL(B) + AOBJN B,WLRWX6 +WLRWX5: SKIPN CRFOFL ;IF A SEPARATE CREF OUTPUT FILE IS ENABLED, + JRST WLRWX2 + WLRWWI R,LR.CRF ;REMEMBER INFO ABOUT THAT. + WLRWWI L,-5 +WLRWX3: WLRWWD CH,CRFFIL(B) + AOBJN B,WLRWX3 + JRST WLRWX2 + +WLRWX2: SKIPN FNTSPC ;IF @ KNOWS ABOUT SOME FONTS, + JRST WLRWX ;WRITE THAT INFO INTO LR.XGP AND LR.FNT SUBENTRIES. + WLRWWI R,LR.XGP + WLRWWI L,-1 + WLRWWD B,FNTVSP ;VSP GOES IN LR.XGP + WLRWWI R,LR.FNT ;FONT TABLE GOES IN LR.FNT + WLRWWI L,-NFNTS*FNTFL +WLRWX1: WLRWWD CH,FNTF0(B) + AOBJN B,WLRWX1 +WLRWX: WLRWWI R,LR.CPY ;OUTPUT QOPYRIGHT MESSAGE IN LR.CPY + WLRWWI L,-LCPYMSG +WLRWQ: WLRWWD CH,CPYMSG(B) + AOBJN B,WLRWQ + WLRWWI R,LR.DAT ;OUTPUT CREATION DATE OF SOURCE FILE. + WLRWWI L,-1 + SKIPN CH,F.CRDT(A) + MOVE CH,F.OCRD(A) + WLRWWD CH + MOVE B,F.SWIT(A) + TRNN B,FSNOIN+FSQUOT ;MAYBE WE DON'T WANT SYM TAB OR PAGE TABLE. + SKIPL CH,F.PAGT(A) ;IF FILE IS OUTPUT, USE NEW PAGE TABLE IF ANY. + MOVE CH,F.OPGT(A) ;ELSE DON'T ABANDON ANY OLD ONE. + JUMPGE CH,WLRW2 ;NO PAGE TABLE => NO LR.PAG SUBENTRY. + WLRWWI R,LR.PAG ;WRITE THE PAGE-TABLE SUBENTRY. + WLRWWD B,CH ;AFTER THE SUBENTRY TYPE, THE AOBJN PTR +WLRW1: MOVE CH,(B) ;AND WHAT IT POINTS TO. + WLRWWD CH + AOBJN B,WLRW1 +WLRW2: +IFN 0,[ + SKIPGE F.OSMT(A) ;IF WE HAVE EITHER AN OLD OR A NEW SYMBOL TABLE, + JRST WLRW8 + MOVE B,F.SWIT(A) + TRNN B,FSNOIN+FSQUOT + SKIPN F.NSYM(A) + JRST WLRW5 +WLRW8: MOVEI B,LR.SYM ;WRITE A SYMBOL TABLE SUBENTRY. + WLRWWD B + MOVN B,F.NSYM(A) + JUMPE B,WLRW6 ;NO NEW SYMTAB => WRITE OLD. + LSH B,18.+2 ;HAVE NEW SYMTAB: LH(B) HAS -4*<# SYMBOLS> = - + WLRWWD B + MOVE CH,SYMAOB ;LOOK AT ALL SYMBOLS, +WLRW3: HLRZ B,1(CH) + CAIE B,(A) ;OUTPUTTING THE ENTRIES FOR THOSE IN THIS FILE. + JRST WLRW4 +REPEAT 4,[ + MOVE B,.RPCNT(CH) + WLRWWD B +];REPEAT 4 +WLRW4: ADDI CH,3 + AOBJN CH,WLRW3 +];IFN 0 +WLRW5: SETO B, ;WRITE THE END-OF-ENTRY MARKER. + WLRWWD B + POPJ P, + +IFN 0,[ +WLRW6: HLLZ B,F.OSMT(A) ;WRITE OUT LENGTH AND DATA FROM OLD SYMTAB. + WLRWWD B + MOVE CH,F.OSMT(A) +WLRW7: MOVE B,(CH) + WLRWWD B + AOBJN CH,WLRW7 + JRST WLRW5 +];IFN 0 + +SUBTTL COMPARISON LISTING ROUTINES + +;PERFORM COMPARISONS, DECIDING WHICH PAGES OF EACH FILE NEED TO BE LISTED. + +CPR: MOVEI A,FILES +CPR1: MOVE B,F.SWIT(A) + TRNN B,FSLREC+FSNOIN + PUSHJ P,CPRF ;COMPARE ONE FILE. + ADDI A,LFBLOK + CAMGE A,SFILE + JRST CPR1 + POPJ P, + +;COMPARE THE FILE WHOSE FILE BLOCK <- A. +CPRF: TRC B,FSARW+FSQUOT + TRCE B,FSARW+FSQUOT + SKIPL F.PAGT(A) + POPJ P, + PUSHJ P,CPRFP ;FIND NEW PAGES WHOSE CHECKSUMS MATCH OLD ONES. +ITSXGP,[MOVE B,F.PAGT(A) + MOVE C,CODTYP + CAIN C,CODTXT ;IF /L[TEXT] AND /X, MARK 1ST PAGE AS CHANGED, SINCE + TLNN F,FLXGP ;IT PROBABLY CONTAINS XGP COMMANDS WHOSE LOSS WOULD SCREW. + CAIA + SETZM (B) +];ITSXGP + MOVE D,F.SWIT(A) + PUSHJ P,[ SKIPE REALPG ;IF /Y, ASSIGN EACH PAGE ITS REAL # AS ITS VIRTUAL # + JRST CPRY + PUSHJ P,CPRC ;ELSE RESOLVE ORDERING CONFLICTS AND + JRST CPRA] ;ASSIGN INTERPOLATED PAGE #'S TO PAGES THAT NEED THEM. + PUSHJ P,CPRL ;SET UP LINE # OFFSETS. + PUSHJ P,CPRU ;DECIDE WHETHER FILE HAS CHANGED SINCE PREVIOUS LISTING. + POPJ P, + +;LOOK THRU OLD AND NEW PAGE TABLES, FINDING NEW FILE PAGES WITH SAME CHECKSUM +;AS OLD FILE PAGES. PUT IN LH OF 2ND WORD OF NEW PAGE TABLE ENTRY THE NUMBER +;OF THE CORRESPONDING OLD PAGE. +CPRFP: SKIPL C,F.OPGT(A) ;CAN'T HACK THIS IF NO OLD PAGE TABLE. + POPJ P, +CPRFP5: HRRZS 1(C) ;IN OLD PAGE TABLE, CLEAR LH(2ND WORD) OF ALL WORDS + ADD C,[2,,2] + JUMPL C,CPRFP5 + MOVE C,F.OPGT(A) ;RELOAD OLD PAGE TABLE POINTER + SKIPL B,F.PAGT(A) ;CAN'T HACK THIS IF NO NEW PAGE TABLE. + POPJ P, + MOVE L,F.SWIT(A) + SKIPN NORENUM + TRNE L,FSLRNM ;IF WE WANT TO AVOID NONZERO MINOR PAGE NUMBERS, + JRST CPRFR ;THERE'S A SPECIAL SEARCH ALGORITHM. + HRLZI L,-1 ;MAKE IT EASY TO TEST THE LEFT HALF OF WORDS +CPRFP1: MOVE D,(B) ;GET CHECKSUM OF NEXT NEW PAGE. + MOVE C,F.OPGT(A) ;SCAN OLD PAGE TABLE FOR EQUAL OLD PAGE. +CPRFP4: CAMN D,(C) ;THIS OLD PAGE HAD SAME CKSUM AS NEW PAGE? + TDNE L,1(C) ;(DON'T MATCH SAME PAGE TWICE, IF /Y. IF /-Y, CPRC FIXES THAT) + AOBJN C,[AOBJN C,CPRFP4 ;NO, TRY ANOTHER OLD PAGE. + JRST CPRFP2] ;ALL OLD PAGES TRIED - NO CORRESPONDING OLD PAGE. +CPRFP3: HRRZ D,1(C) ;YES, GET MAJOR AND MINOR PG NOS. OF OLD PAGE, + ANDCMI D,NEWPAG ; AND MAKE NEW PAGE POINT TO THEM + HRRM D,1(B) + SKIPE REALPG + HRLM B,1(C) ;MAKE OLD PAGE POINT AT WHICH NEW PAGE IT IS BECOMING (FOR /Y). +CPRFP2: AOBJP B,CPOPJ + AOBJP B,CPOPJ ;LOOK AT ALL NEW FILE'S PAGES THIS WAY. + MOVE D,(B) ;ATTEMPT TO MAP CONSECUTIVE NEW PAGES + ADD C,[2,,2] + SKIPGE 1(C) + JRST CPRFP1 + CAMN D,(C) ;INTO CONSECUTIVE OLD PAGES. + JUMPL C,CPRFP3 + JRST CPRFP1 ;NEXT NEW NOT EQUAL TO NEXT OLD; TRY OTHER OLD PAGES. + +;SCAN FOR NEW PAGES THAT MATCH THE OLD PAGE WITH THE SAME PHYSICAL PAGE NUMBER. +;CAUSES ENOUGH RELISTING TO MAKE SURE LOGICAL PAGE # ALWAYS EQUALS PHYSICAL. +CPRFR: MOVEI L,.DPB 1,MAJPAG,0 ;Init real page number counter +CPRFR2: HRRZ D,1(C) ;See if Old page number geq real page number + ANDCMI D,NEWPAG + CAIGE D,(L) + JRST [ ADD C,[2,,2] ;If not, loop until it is + JUMPL C,CPRFR2 + POPJ P, ] ;Unless, of course, if we run out + CAIE D,(L) ;Is it now equal? + JRST CPRFR1 ; if not, cant match + MOVE R,(B) ;Otherwise, if checksums match + CAMN R,(C) + HRRM D,1(B) ;Then mark new page table as such +CPRFR1: ADDI L,.DPB 1,MAJPAG,0 ;And loop to the next new page + ADD B,[2,,2] + JUMPL B,CPRFR2 + POPJ P, + +;HERE TO ASSIGN SEQUENTIAL VIRTUAL PAGE #S TO ALL NEW PAGES (IE, VIRT # = REAL #). +;ALSO SETTING THE NEWPAG BITS OF CHANGED PAGES (THOSE WITH NO OLD PAGE NUMBERS FOUND). +CPRY: SKIPL B,F.PAGT(A) + POPJ P, + MOVEI C,.DPB 1,MAJPAG,0 + MOVEI D,NEWPAG +CPRY1: HRRZ L,1(B) ;IF PAGE HAS NO OLD PAGE EQUIVALENT, TURN ON NEWPAG BIT. + SKIPN L + IORM D,1(B) + DPB C,[.BP <<.BM MAJPAG>\.BM MINPAG>,1(B)] + ADD B,[2,,2] + ADDI C,.DPB 1,MAJPAG,0 + JUMPL B,CPRY1 + POPJ P, + +;COME AFTER ASSIGNING MAJOR AND MINOR PAGE #S TO ALL PAGES. +;PUT IN THE LH OF 2ND WORD OF PAGTAB ENTRY FOR EACH PAGE +;THE NUMBER OF THE 1ST LINE ON THAT PAGE, MINUS 1. +;WHEN CPRL CALLED, THAT LH. CONTAINS # LINES ON PAGE. +CPRL: SKIPL B,F.PAGT(A) + POPJ P, + SETZ C, + MOVE CH,CODTYP +;C HAS # OF LAST LINE ON PREVIOUS PAGE. +CPRL1: HLRZ D,1(B) ;# LINES ON THIS PAGE. + HRRZ R,1(B) + CAIE CH,CODRND ;IF /L[RANDOM], ALL PAGES START WITH "LINE 1". + TRNN R,.BM MINPAG ;IF THIS IS MINOR PAGE 0, + SETZ C, ;IT STARTS AT LINE 1. + HRLM C,1(B) ;STORE <1ST LINE ON PAGE>-1 + ADD C,D ;MAKE + AOBJP B,CPOPJ + AOBJN B,CPRL1 + POPJ P, + +;SEE WHETHER FILE HAS CHANGED AT ALL SINCE THE OLREC +;INFO FOR IT WAS WRITTEN. IF NOT, SET FSNCHG FOR FILE. +CPRU: SKIPGE B,F.PAGT(A) + SKIPL C,F.OPGT(A) + POPJ P, +CPRU1: MOVE D,(B) ;LOOK FOR CHANGES BY COMPARING NEW AND OLD PAGE TABLES. + MOVE L,1(B) ;COMPARE BOTH THE PAGE NUMBERS + XOR L,1(C) + TRNN L,<.BM MAJPAG>\.BM MINPAG + CAME D,(C) ;AND THE CHECKSUMS + POPJ P, ;IF THEY DIFFER, FILE HAS CHANGED. + ADD B,[2,,2] + ADD C,[2,,2] + JUMPGE B,CPRU3 + JUMPL C,CPRU1 + POPJ P, ;FILE HAS BEEN EXTENDED AT THE END => IT HAS CHANGED. + +CPRU3: JUMPL C,CPOPJ ;HERE IF FILE HAS BEEN TRUNCATE? + MOVEI D,FSNCHG ;IF THEY DIFFER IN LENGTH, FILE HAS CHANGED. + IORM D,F.SWIT(A) + POPJ P, + +;RESOLVE CONFLICTS IN ASSIGNMENTS MADE BY CPRFP. +;A CONFLICT IS WHERE NEW PAGE CORRESPONDS TO OLD PAGE +;AND NEW PAGE + CORRESPONDS TO OLD PAGE -. +;IN OTHER WORDS, PAGES HAVE BEEN SHUFFLED. +;ONE OR ANOTHER GROUP OF PAGES MUST BE RE-LISTED WITH NEW NUMBERS +;EVEN IF NOT CHANGED. CPRC DECIDES WHICH WAY TO DO THAT SO AS +;TO REDUCE THE AMOUNT OF LOSSAGE THAT RESULTS. IT DOES THAT BY MARKING +;THE PAGES THAT NEED TO BE RELISTED AS HAVING NO CORRESPONDING OLD PAGE. + +CPRC: SKIPL B,F.PAGT(A) + POPJ P, + HRRZ C,1(B) ;FIRST, SCAN THRU NEW PAGE TABLE, LOOKING FOR CONFLICT. + MOVE R,B ;R POINTS TO PAGE WHOSE OLD PAGE # IS IN C. + ADD B,[2,,2] + JUMPGE B,CPOPJ +CPRC1: HRRZ D,1(B) + JUMPE D,CPRC3 + CAMG D,C ;CONFLICT FOUND. + JRST CPRC2 + MOVE C,D + MOVE R,B +CPRC3: AOBJP B,CPOPJ + AOBJN B,CPRC1 + POPJ P, + +;A CONFLICT HAS BEEN FOUND. +CPRC2: MOVE H,B ;H -> PAGE WHOSE NEW PAGE # IS IN D. + SETZB CH,L ;COMPUTE COSTS OF 2 WAYS OF HACKING IN CH,L. +CPRC5: ADD B,[2,,2] + JUMPGE B,CPRC4 + HRRZ D,1(B) ;COMPUTE IN CH COST OF RELISTING UPPER GROUP OF PGS. + JUMPE D,CPRC5 + CAMG D,C + AOJA CH,CPRC5 +CPRC4: MOVE B,R + HRRZ C,1(H) +CPRC6: CAMN B,F.PAGT(A) + JRST CPRC7 + SUB B,[2,,2] ;CPT. IN L COST OF RELISTING LOWER GROUP. + HRRZ D,1(B) + JUMPE D,CPRC6 + CAML D,C + AOJA L,CPRC6 +CPRC7: CAML L,CH ;WHICH GROUP WOULD COST LESS TO RE-LIST? + JRST CPRCU ;THE UPPER GROUP WOULD. +CPRCL: MOVE B,R ;THE LOWER GROUP WOULD. + HRRZ C,1(H) ;GET LOWEST PAGE NUM IN UPPER GROUP +CPRCL1: HRRZ D,1(B) + JUMPE D,CPRCL2 ;IS THIS PAGE TO BE LISTED? + CAMGE D,C ;YES, IS IT STILL IN CONFLICT RANGE? + JRST CPRC ;NO, WE'RE DONE. LOOK FOR ANOTHER CONFLICT. + HLLZS 1(B) ;REQUIRE PAGE TO BE RELISTED. +CPRCL2: CAMN B,F.PAGT(A) + JRST CPRC + SUB B,[2,,2] ;THIS ISN'T THE FIRST PAGE + JRST CPRCL1 ;SO LOOK AT PREVIOUS ONES. + +;IT'S CHEAPER TO RELIST THE UPPER GROUP. +CPRCU: MOVE B,H ;-> 1ST PAGE OF UPPER GROUP. + HRRZ C,1(R) ;PAGE # OF TOP OF LOWER GROUP. +;UPPER GROUP CONSISTS OF ALL PAGES FROM C(B) ON +;UNTIL THE FIRST WHOSE PAGNUM IS > C(C). +CPRCU1: HRRZ D,1(B) + JUMPE D,CPRCU2 + CAMLE D,C ;REACHED END OF UPPER GROUP? + JRST CPRC ;YES, LOOK FOR ANOTHER CONFLICT. + HLLZS 1(B) ;SAY THIS PAGE MUST BE RELISTED. +CPRCU2: ADD B,[2,,2] + JUMPL B,CPRCU1 ;AND KEEP SCANNING UPPER GROUP. + JRST CPRC + +;CPRA ASSIGNS PAGE NUMBERS TO ALL THE PAGES OF THE FILE THAT DON'T HAVE +;CORRESPONDING OLD PAGES, AND SETS THEIR NEWPAG BITS. A PAGE HAS A CORRESPONDING +;OLD PAGE IFF AT THIS POINT IT HAS NONZERO PAGE NUMBERS. +;ALSO, CPRA MAKES SURE THAT FOLLOWING ANY RELISTED PAGE, ALL PAGES WITH THE +;SAME MAJOR PAGE NUMBER ARE ALSO RELISTED. THIS IS BECAUSE THEIR LINE NUMBER OFFSETS +;MAY HAVE CHANGED, AND ANYWAY WE AREN'T SMART ENOUGH TO HANDLE ASSIGNING LINE #S OTHERWISE. + +CPRA9: HLLZS 1(L) ;COME HERE AFTER FINDING AN ALTERED RANGE, WHEN IT + ;IS NECESSARY TO RE-LIST THE UNALTERED PAGE AFTER IT. + +;COME HERE AFTER FINDING AN ALTERED PAGE. +;B HAS MAJOR AND MINOR PAGE #S, AND C -> ENTRY FOR, +;THE LAST UNALTERED PAGE FOUND. +CPRA1: MOVE D,1(L) ;LOOK FOR NEXT UNALTERED PAGE + TRNE D,-1 ;THAT ENDS RUN OF ALTERED ONES. + JRST CPRA2 + ADD L,[2,,2] + JUMPL L,CPRA1 + MOVEI D,.BM MAJPAG ;THERE IS NONE, PRETEND THERE'S A PAGE INFINITY. +;L -> ENTRY FOR 1ST UNALTERED PAGE AFTER RUN OF ALTERED ONES, +;D HAS MAJOR AND MINOR PAGE #S OF IT. +;B,C AS AT CPRA1 +CPRA2: TRNE D,.BM MINPAG ;IF FIRST UNCHANGED PAGE AFTER RUN HAS NONZERO MINOR PAGE #, + JRST CPRA9 ;MUST RE-LIST THAT PAGE TOO; ELSE WE'D GET PAGE N/1 WITH NO PAGE N. + ;OR WORSE: N/M AFTER N/M+C + MOVEI R,(L) ;HOW MANY ALTERED PAGES IN THE RUN? + SUBI R,2(C) + LSH R,-1 ;THAT NUMBER IN R. + LDB N,[MAJPAG,,B] + LDB CH,[MAJPAG,,D] ;DO BOTH ALTERED PAGES AT ENDS OF RUN +;COME HERE FOR RUN OF ALTERED PAGES BETWEEN UNALTERED PAGES. +;KNOW THAT UNALTERED PAGE AT END BEGINS A MAJOR PAGE + SUBI CH,(N) + SOJE CH,CPRA8 ;IF THERE'S NO UNUSED MAJOR PAGE # BETWEEN + ;(THAT IS,.MAJOR PG #S DIFFER BY 1), THEN + ;THE ALTERED PAGES MUST HAVE SAME MAJOR PG # + ;AS THE PRECEDING UNALTERED ONE. + EXCH CH,R + IDIVI CH,(R) ;<# ALTERED PAGES>/<# AVAIL. MAJOR PG #S> + ;CH HAS BASIC # OF PAGES FOR EACH MAJOR PG #. + ;CC HAS # OF MAJOR PG #S THAT NEED 1 EXTRA PG. + IORI B,NEWPAG +CPRA6: IORI B,.BM MINPAG ;INCREMENT TO NEXT MAJOR PAGE #. + MOVEI R,(CH) + SOSL CC + ADDI R,1 ;R HAS # PAGES TO GET THIS MAJOR PG #. +CPRA7: ADDI C,2 + CAIL C,(L) + JRST CPRA4 + ADDI B,1 + HRRM B,1(C) + SOJG R,CPRA7 ;INCREMENT EITHER MINOR PAGE # + JRST CPRA6 ;OR MAJOR PAGE #. + +CPRA8: JUMPE B,CPRA9 ;PAGE INSERTED BEFORE PAGE 1? DON'T CALL IT 0/1; RELIST PG 1. + IORI B,NEWPAG ;MARK ALTERED PAGES AS NEEDING LISTING. +CPRA3: ADDI C,2 ;POINT TO NEXT OF THEM. + CAIL C,(L) + JRST CPRA4 ;ALL OF THEM HANDLED. + ADDI B,1 ;GIVE EACH ALTERED PAGE SOME PAGE #S. + HRRM B,1(C) ;INCREMENTING THE MINOR PG # EACH TIME. + JRST CPRA3 + +CPRA: SETZ B, ;B HAS MAJOR AND MINOR PG #S OF LAST UNCHANGED PAGE. + SKIPL L,F.PAGT(A) + .VALUE + MOVEI C,-2(L) ;C -> ENTRY FOR LAST UNCHANGED PG. + DROPTHRUTO CPRA4 ;WE START IN STATE OF LOOKING FOR NEW PG. + +;AFTER HANDLING ONE RUN OF ALTERED PAGES, OR AT THE BEGINNING, +;SEARCH FOR THE BEGINNING OF THE NEXT. +CPRA4: JUMPGE L,CPOPJ + HRRZ D,1(L) + JUMPE D,CPRA1 + HRRZ B,D + HRRZ C,L + ADD L,[2,,2] + JRST CPRA4 + +SUBTTL PASS 1 MAIN LOOP + +1START: SKIPE 1CKSFL ;IF WE DON'T NEED ANY CHECKSUMMING + JRST 1STAR1 + MOVE A,CODTYP ;AND WE DON'T HAVE ANY SYMBOLS, + TLNN F,FLSUBT ;AND DON'T NEED TO SCAN FOR SUBTITLES IN /L[RANDOM], + CAIE A,CODRND + CAIN A,CODTXT + POPJ P, ;WE CAN SKIP PASS 1. +1STAR1: MOVEI A,FILES + MOVEM A,CFILE + SETOM 1FCNT + SETZM SUBTLS ;INITIALLY NO SUBTITLES IN LIST + SETZM ADEFLS ;INITIALLY NO @DEFINE CRUD + JRST 1LOOP + +1DONE: .CLOSE UTIC, ;DONE WITH A FILE + MOVE P,PSAVE + HRRZ A,CFILE + MOVE B,NSYMSF ;REMEMBER HOW MANY SYMS AND HOW MANY PAGES + MOVEM B,F.NSYM(A) ;THERE WERE IN THIS FILE. + HLRZM N,F.NPGS(A) + EXCH DP,LRCPTR ;PUSHES INTO SPACES MUST BE ON DP, SP, P - SEE PDLEXT. + HRLZ CH,1CKSLN ;IF THERE WAS NO ^L AT THE END OF THE FILE, + MOVE C,1CKSUM + TLNE N,-1 ;MAKE SURE A NULL FILE DOESN'T PRODUCE A ZERO-LENGTH PAGE TABLE. + JUMPE CH,1DONE2 + ;MAKE A PAGETABLE ENTRY FOR THE UNTERMINATED PAGE. + ADDI C,^L ;PRETEND THE PAGE WAS ENDED BY ^L, IN THE CHECKSUM, SO THAT + ROT C,7 ;MAKING A FOLLOWING PAGE WON'T MAKE THIS ONE BE RELISTED. + PUSH DP,C + PUSH DP,CH +1DONE2: HRRZ B,F.PAGT(A) ;GET -LENGTH OF FILE'S PAGE TABLE + SUBI B,1(DP) + HRLM B,F.PAGT(A) ;STORE INTO LENGTH FIELD OF AOBJN PTR IN F.PAGT + EXCH DP,LRCPTR +1DONE1: +ITS, .SUSET [.SWHO1,,[0]] + ADDI A,LFBLOK ;ADVANCE CURRENT FILE POINTER TO NEXT FILE. + MOVEM A,CFILE + DROPTHRUTO 1LOOP + +;DROPS THROUGH. +;SET UP FOR PASS 1 PROCESSING OF FILE IN A. +1LOOP: HRRZ A,CFILE ;GET POINTER TO NEXT FILE BLOCK + CAML A,SFILE + POPJ P, ;JUMP OUT IF NO MORE + MOVEM P,PSAVE + SETZM 1CKSUM + SETZM 1CKSLN + SETZM 1CKSCF + SETZM 1CKSNF + SETZM 1CKSNN + SETZM NSYMSF + SETZM 1CKSIF + MOVE B,CODTYP + CAIN B,CODTXT + SETOM 1CKSIF + ANDCMI F,TEMPF ;FETCH INTO F THE TEMP. FLAGS OF THIS FILE. + MOVE B,F.SWIT(A) + ANDI B,TEMPF + IOR F,B + TRC F,FSARW+FSQUOT + TRCE F,FSARW+FSQUOT ;DON'T DO PASS 1 ON OUTPUT-ONLY FILES. + TRNE F,FSLREC+FSNOIN ;OR OTHER FILES WE SHOULD IGNORE + JRST 1DONE1 + AOSE 1FCNT + SETOM MULTI ;DETECT THE PRESENCE OF MORE THAN 1 INPUT FILE. + MOVE B,CODTYP + CAIE B,CODRND + CAIN B,CODTXT + SKIPL B,F.OLRC(A) + JRST 1LOOP3 + MOVE B,3(B) + TRNN F,FSLALL+FSLRNM + CAME B,F.RFN2(A) + JRST 1LOOP3 + SKIPE B,F.OCRD(A) + CAME B,F.CRDT(A) + JRST 1LOOP3 +1NOCHG: MOVEI B,FSNCHG + IORM B,F.SWIT(A) + JRST 1DONE1 + +1LOOP3: MOVEI R,2 + PUSHJ P,2INOPN ;OPEN THE FILE. + JRST 1NOCHG ;DOESN'T EXIST => DON'T COMPLAIN NOW. WE COMPLAINED BEFORE. + PUSHJ P,2RDAHD ;INIT 1-WORD READ AHEAD FOR SAKE OF FLUSHING PADDING AT EOF. + HRRZ B,LRCPTR + ADDI B,1 + MOVEM B,F.PAGT(A) ;REMEMBER WHERE FILE'S PAGE TABLE STARTS. + PUSHJ P,DOINPT ;FILL UP INPUT BUFFER. + JRST 1DONE +ITS,[ MOVE B,F.RFN1(A) + .SUSET [.SWHO2,,B] + .SUSET [.SWHO3,,[SIXBIT/P1 /+1]] + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +];ITS + PUSHJ P,LNMTST ;SET LNDFIL IF LINE NUMBERS. SET ETVFIL IF ETV DIRECTORY + SKIPE 1CKSFL ;IF CHECKSUMMING IS BEING DONE, + PUSHJ P,1CKS ;HANDLE WHAT THAT 1ST CALL TO INPUT GOT. + MOVSI N,1 ;INITIALIZE ,,-1 + SKIPN ETVFIL ;IF THERE'S A DIRECTORY, DON'T CHECK IT FOR SYMBOL DEFNS + JRST 1LOOP1 +1LOOP2: 1GETCH ;SO READ THROUGH THE 1ST PAGE AS IF FOR /L[RANDOM] + CAIN CH,^C + PUSHJ P,1MORE1 + CAIE CH,^L + JRST 1LOOP2 + MOVSI N,2 +1LOOP1: SKIPL A,CODTYP ;DISPATCH ACCORDING TO LANGUAGE FILE IS WRITTEN IN. + CAIL A,CODMAX + .VALUE + JRST @.+1(A) + OFFSET -. +CODMID::1MIDAS +CODRND::1RANDM +CODFAI::1FAIL +CODP11::1PLX11 +CODLSP::1LISP +CODM10::1FAIL +CODUCO::1UCONS +CODTXT::1RANDM +CODMDL::1MUDDL ;MUDDLE CODE +CODDAP::1DAPX ;DAPX16 CODE +CODMAX::OFFSET 0 + +SUBTTL PASS 1 CHECKSUMMING + +;AFTER A BUFFERFUL (OR PART) HAS BEEN READ IN, DO PAGE-CHECKSUM +;PROCESSING ON IT, ADDING ENTRIES TO PAGE TABLE WHEN NECESSARY. +1CKS: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,IP + AOSN 1CKSNF ;WERE WE IGNORING LINE NUMBERS? + SOJA IP,[IBP IP ;YES, MAKE SURE LH(IP) ISN'T 440700 CROCK + PUSHJ P,1CKLN5 ;AND KEEP CHECKING + SKIPE 1CKSNF ;IF WE SKIPPED RIGHT THROUGH THE WHOLE BUFFER + JRST 1CKS6 ;THEN GET OUT FAST + JRST .+1 ] + EXCH DP,LRCPTR + MOVE A,1CKSLN ;COUNT OF # LINES IN PAGE KEPT IN A. + HRRZ B,LASTIP ;PUT LASTIP WHERE IT CAN BE COMPARED WITH RH(IP) + MOVE C,1CKSUM ;CHECKSUM ACCUMULATES IN C. +XGP,[ SKIPE 1CKXAD ;IF INSIDE 1CKXGP, REENTER IT. + JRST 1CKXRE + MOVE CH,CODTYP + CAIN CH,CODTXT ;FOR XGP TEXT FILES SINCE ^L ISN'T ALWAYS END OF PAGE, + TLNN F,FLXGP ;WE MUST USE A SPECIAL HAIRY PARSE ROUTINE. + CAIA + JRST 1CKXGP ;DO THIS BEFORE CHECKING 1CKSIF, ETC, SINCE WE USE THEM DIFFERENTLY. +];XGP + SKIPE 1CKSIF ;IF IGNORING 1ST LINE OF PAGE, KEEP IGNORING. + JRST 1CKSI1 + AOSN 1CKSCF ;IF PREVIOUS BUFFERFUL ENDED WITH CR + JRST 1CKSC3 ;START THIS AS IF HANDLING A CR. +1CKS1: ILDB CH,IP ;GET NEXT CHAR. +1CKS3: ADDI C,(CH) ;UPDATE CHECKSUM WITH NEW CHAR. + ROT C,7 + CAILE CH,^M ;IF CHAR IS DEFINITELY NOT SPECIAL, + JRST 1CKS1 ;JUST GO ON TO NEXT ONE. + JRST @1CKSTB(CH) ;CR, LF, FF AND ^C NEED EXTRA PROCESSING. + +1CKSTB: 1CKSC ;^@ +REPEAT 2, 1CKS1 ;^A-^B + 1CKSC ;^C +REPEAT 6, 1CKS1 ;^D-^I + 1CKSLF ;^J + 1CKS1 ;^K + 1CKSFF ;^L + 1CKSCR ;^M +IFN .-1CKSTB-^M-1,.ERR WRONG TABLE LENGTH + +1CKSFF: PUSH DP,C ;^L - PUSH CHECKSUM AND LINE COUNT OF PAGE + HRLZI A,(A) ;(THE LATTER ACTUALLY IN LH OF WORD) + PUSH DP,A + SETZB A,C ;THEN RE-INIT BOTH OF THEM. + SKIPE LNDFIL + PUSHJ P,1CKLNM + MOVE CH,CODTYP ;IF A TEXT FILE, + CAIE CH,CODTXT + JRST 1CKS1 + SETZM 1CKSNN ;SAY WE HAVEN'T YET FOUND A NON-NULL LINE. + SETOM 1CKSIF ;IGNORE UP TO THE FIRST NON-NULL LINE OF EVERY PAGE. +1CKSI1: CAIN B,(IP) ;END OF BUFFER => RETURN, BUT 1CKSIF IS SET SO WILL COME BACK. + JRST 1CKS5 + ILDB CH,IP + CAIN CH,^L + JRST 1CKS1A ;DON'T BE CONFUSED BY PAGES CONTAINING NO NON-NULL LINES. + CAIN CH,^J + JRST 1CKSI2 ;END OF LINE => IS IT NON-NULL? + CAIE CH,^M + SETOM 1CKSNN ;ANYTHING BUT ^M OR ^J INDICATES A NON-NULL LINE. + JRST 1CKSI1 + +1CKSI2: SKIPE LNDFIL ;GET HERE ON ^J + PUSHJ P,1CKLNM + SKIPN 1CKSNN ;IF IT WAS NON-NULL, WE'RE FINISHED. + JRST 1CKSI1 + SETZM 1CKSIF ;AND DON'T COME BACK TO IGNORING. + JRST 1CKS1 + +1CKSLF: TLNE F,FLSCR ;LF - IF FLSCR SET, EVERY LF COUNTS AS A LINE. + ADDI A,1 ;OTHERWISE, LINES ARE DETECTED BY THE CR-HANDLER +1CKS1A: SKIPE LNDFIL + PUSHJ P,1CKLNM + JRST 1CKS1 + +1CKSCR: TLNE F,FLSCR ;CR - SEE IF IT'S PART OF A CRLF, + JRST 1CKS1 ;(IF FLSCR SET, THE LINEFEED WILL TAKE CARE OF EVERYTHING) +1CKSC3: ILDB CH,IP + CAIN CH,^J + AOJA A,1CKS3 ;IF IT'S A CRLF, INCREMENT THE LINE COUNT. + CAIN CH,^C + CAIE B,(IP) + JRST 1CKS3 ;IN ANY CASE, DON'T FORGET TO PUT ILDB'D CHAR IN THE CHECKSUM. + SETOM 1CKSCF ;LOOK AHEAD FAILS DUE TO END OF BUFFER - SET FLAG + JRST 1CKS3 ;TO TRY 1CKSCR AGAIN WHEN NEXT BUFFER IS CHECKSUMMED. + +;COME HERE WHEN ^C OR ^@ SEEN WHILE CHECKSUMMING. +1CKSC: CAIN B,(IP) ;FIRST, MAYBE THE ^C MEANS END OF BUFFER. + JRST 1CKS4 + SKIPLE LFILE ;IF EOF HASN'T BEEN REACHED BY INPUT-BUFFER FILLING YET, + JRST 1CKSC4 ;MUST ASSUME ^C IS NOT EOF. + PUSH P,IP +1CKSC1: CAIN B,(IP) ;LOOK AHEAD AT REST OF INPUT BUFFER. + JRST 1CKSC2 ;REACH END WITHOUT SEEING ANYTHING BUT ^C AND ^@ => AT EOF. + ILDB CH,IP + JUMPE CH,1CKSC1 + CAIE CH,^L + CAIN CH,^C + JRST 1CKSC1 + POP P,IP ;CHAR. OTHER THAN ^C OR ^@ FOLLOWS => +1CKSC4: MOVEI CH,^C +ITSXGP,[SKIPE 1CKXAD ;IF THE ^C WAS SEEN INSIDE 1CKXGP, RETURN TO IT. + JRST @1CKXAD +];ITSXGP + JRST 1CKS1 ;THE ^C DOES NOT MEAN EOF. + +;WE REACHED A ^C OR ^@ THAT MEANS EOF; ACT LIKE END-OF-PAGE. +1CKSC2: POP P,IP + LDB CH,IP + +;THE WHOLE INPUT BUFFER HAS BEEN CHECKSUMMED, PLUS ONE ^C OR ^@ WHICH MEANT EOF OR EOB. +1CKS4: ROT C,-7 ;REMOVE SPURIOUS ^C FROM CHECKSUM. + SUBI C,(CH) +1CKS5: MOVEM C,1CKSUM + MOVEM A,1CKSLN + EXCH DP,LRCPTR +1CKS6: POP P,IP ;RESET FOR PASS 1 READING + POP P,C +POPBAJ: POP P,B +POPAJ: POP P,A + POPJ P, + +XGP,[ +;CHECKSUMMING ROUTINE THAT KNOWS HOW TO FIND THE PAGE BREAKS IN XGP TEXT FILES. +1CKXGP: PUSHJ P,1CKXGT + CAIN CH,^L ;^L IS ONLY A PAGE BREAK IF READ HERE (NOT WITHIN AN XGP COMMAND) + JRST 1CKXFF + CAIN CH,177 ;XGP LIKE NON-XGP EXCEPT DETECT THE ESCAPE CHARACTER. + JRST 1CKXCM +1CKXNN: SKIPN 1CKSIF ;SKIP IF STILL IGNORING UP TO 1ST NON-NULL LINE. + JRST 1CKXGP + CAIE CH,^J + CAIN CH,^M + JRST 1CKXIF + SETOM 1CKSNN ;NON-NULL-NESS SEEN WHILE IGNORING: + JRST 1CKXGP ; THIS IS LAST LINE TO IGNORE. + +1CKXIF: SKIPE 1CKSNN ;END OF IGNORED LINE: NON-NULL-NESS SEEN => STOP IGNORING. + SETZM 1CKSIF + JRST 1CKXGP + +1CKXCM: PUSHJ P,1CKXGT ;HERE AFTER AN ESCAPE: READ THE FOLLOWING CHARACTER + CAILE CH,XGPMAX + JRST 1CKXGP + XCT 1CKXTB(CH) ;AND DECODE IT ACCORDING TO THE XGP FORMAT WE KNOW ABOUT. + SETOM 1CKSNN ;NO SKIP MEANS THIS ESCAPE CODE CONSTITUTES NON-NULL DATA. +1CKXIG: SOJL A,1CKXGP ;IGNORE (SKIP OVER NOT PARSING) THE NUMBER OF CHARS IN A. + PUSHJ P,1CKXGT + JRST 1CKXIG + +1CKXIC: PUSHJ P,1CKXGT ;READ CHAR, AND THAT IS NUMBER OF FOLLOWING CHARS TO SKIP. + MOVEI A,(CH) + JRST 1CKXIG + +1CKXFF: SKIPE LNDFIL ;ALTHOUGH LNDFIL SHOULDN'T HAPPEN + PUSHJ P,1CKLNM ;WE SHOULD CHECK ANYWAY + PUSH DP,C ;FF: PUSH CHECKSUM INTO PAGE TABLE, + PUSH DP,[0] ;AND A 0 INSTEAD OF THE LINE COUNT WHICH IS UNUSED IN THIS MODE, + SETZ C, + SETOM 1CKSIF ;SAY MUST NOW IGNORE PAST FIRST NON-NULL LINE. + SETZM 1CKSNN ;AND SAY THAT WE HAVEN'T FOUND ANY NON-NULL-NESS YET. + JRST 1CKXGP + +;HERE TO REENTER 1CKXGT FOR A NEW BUFFERFULL. +1CKXRE: PUSH P,1CKXAD + MOVE A,1CKXA + +;READ-CHARACTER ROUTINE FOR CHECKSUMMING OF /L[TEXT]/X FILES. +;IF REACH END OF BUFFER, RETURNS SAVING CALLER'S ADDRESS IN 1CKXAD +;AND A IN 1CKXA. +1CKXGT: ILDB CH,IP + SKIPE 1CKSIF ;IF IGNORING TEXT NOW, DON'T CHECKSUM THIS CHAR. + JRST 1CKXGX + ADDI C,(CH) ;READ CHARACTER AND ADD INTO CHECKSUM. + ROT C,7 +1CKXGX: CAIE CH,^C + POPJ P, + POP P,1CKXAD ;PROCESS ^C AS USUAL, BUT REMEMBER WHERE TO COME BACK TO. + MOVEM A,1CKXA + JRST 1CKSC +];XGP + +ITSXGP,[ +1CKXTB: JRST 1CKXGP ;RUBOUT-^@ + JRST 1CKXE1 ;^A IS XGP ESCAPE 1 + SKIPA A,[1] ;^B IS XGP ESCAPE 2 + SKIPA A,[2] ;^C IS XGP ESCAPE 3 + SKIPA A,[9.] ;^D IS XGP ESCAPE 4 +XGPMAX==:.-1CKXTB-1 + +;HERE TO READ THE CHARACTER AFTER THE SEQUENCE RUBOUT-^A +1CKXE1: PUSHJ P,1CKXGT + CAIGE CH,40 ;RUBOUT-^A CODES LESS THAN SPACE TAKE NO ARGUMENT. + JRST 1CKXGP + CAIN CH,40 ;RUBOUT-^A-SPACE TAKES 2 CHARS OF ARGUMENT. + JRST 1CKXI2 + CAIN CH,42 ;CODE 42 IS SPECIAL, SINCE IT ENDS A LINE. + JRST 1CKXLS + CAIGE CH,44 ;CODES 41 AND 43 TAKE ONE CHAR OF ARGUMENT. + JRST 1CKXI1 + CAIN CH,45 ;CODE 45 FOLLOWED BY BYTE CONTAINING THE NUMBER + JRST 1CKXIC ;OF FOLLOWING BYTES TO IGNORE. + CAIGE CH,47 + JRST 1CKXGP ;CODES 44 AND 46 TAKE NO ARGUMENTS. + CAIG CH,50 + JRST 1CKXI1 + CAIN CH,51 + JRST 1CKXI2 + CAIE CH,52 + JRST 1CKXGP +1CKXI1: SKIPA A,[1] +1CKXI2: MOVEI A,2 + JRST 1CKXIG + +1CKXLS: PUSHJ P,1CKXGT ;RUBOUT-^A-" TAKES ONE BYTE OF ARGUMENT. SKIP IT. + MOVEI CH,^J ;A LINE-SPACE COMMAND IS LIKE A LINEFEED, + JRST 1CKXNN ;SO WE MUST CHECK WHETHER IT ENDS THE FIRST NON-NULL LINE. +];ITSXGP + +CMUXGP,[ +1CKXTB: JRST 1CKXGP ;0 EOF + SKIPA A,[2] ;1 VS + SKIPA A,[2] ;2 LM + SKIPA A,[2] ;3 TM + SKIPA A,[2] ;4 BM + SKIPA A,[2] ;5 LIN -obsolete + JRST 1CKXGP ;6 CUT + JRST 1CKXGP ;7 NOCUT + SKIPA A,[1] ;10 AK -obsolete + SKIPA A,[1] ;11 BK -obsolete + JRST 1CKXGP ;12 ASUP -internal to LOOK and the XGP + JRST 1CKXGP ;13 BSUP -internal to LOOK and the XGP + JRST 1CKXGP ;14 UA + JRST 1CKXGP ;15 UB + SKIPA A,[2] ;16 JW + SKIPA A,[2] ;17 PAD + SKIPA A,[1] ;20 S + JRST 1CKXIM ;21 IMAGE + JRST 1CKXGP ;22 ICNT -internal to LOOK and the XGP + JRST 1CKXGP ;23 LF -internal to LOOK and the XGP + JRST 1CKXGP ;24 FF -internal to LOOK and the XGP + JRST 1CKXGP ;25 ECL -obsolete or internal to LOOK and the XGP + JRST 1CKXGP ;26 BCL -obsolete + JRST 1CKXGP ;27 CUTIM + SKIPA A,[2] ;30 T + JRST 1CKXGP ;31 RDY -internal to LOOK and the XGP + JRST 1CKXGP ;32 BJON + JRST 1CKXGP ;33 BJOFF + MOVEI A,1 ;34 QUOT + MOVEI A,1 ;35 OVR + JRST 1CKXGP ;36 LEOF -internal to LOOK and the XGP + JRST 1CKXGP ;37 BCNT -internal to LOOK and the XGP + SKIPA A,[2] ;40 SUP + SKIPA A,[2] ;41 SUB + SKIPA A,[2] ;42 DCAP + SKIPA A,[8.] ;43 VEC + SKIPA A,[2] ;44 SL + SKIPA A,[2] ;45 IL + SKIPA A,[2] ;46 PAG + JRST 1CKXGP ;47 HED -internal to LOOK and the XGP + JRST 1CKXGP ;50 HEDC -internal to LOOK and the XGP + JRST 1CKXGP ;51 PNUM -internal to LOOK and the XGP + SKIPA A,[1] ;52 BLK + SKIPA A,[1] ;53 UND + JRST 1CKXIC ;54 SET + JRST 1CKXIC ;55 EXEC + SKIPA A,[2] ;56 BAK + JRST 1CKXIC ;57 IMFL + JRST 1CKXIC ;60 VCFL + SKIPA A,[2] ;61 A= + SKIPA A,[2] ;62 B= + SKIPA A,[1] ;63 FMT + SKIPA A,[8.] ;64 RVEC + JRST 1CKXIC ;65 RVFL + SKIPA A,[1] ;66 HNUM + JRST 1CKXGP ;67 FNCT -internal to LOOK and the XGP + SKIPA A,[1] ;70 BREAK + JRST 1CKXIC ;71 CMFL +XGPMAX==:.-1CKXTB-1 + +1CKXIM: PUSHJ P,1CKXGT ;GET TWO BYTE COUNT + MOVEI A,(CH) + LSH A,7 + PUSHJ P,1CKXGT + ADDB CH,A + SOJL A,1CKXGP ;MULTIPLY COUNT BY 3/2 + LSH A,-1 + ADDI A,1(CH) + JRST 1CKXIG +];CMUXGP + +SUBTTL PASS 1 LINE NUMBER CHECK DURING CHECKSUMMING + + +1CKLN4: SKIPN LNDFIL + SOJA IP,CPOPJ ;NEVER SKIP NULLS ON FILES WITHOUT LINE NUMBERS +1CKLN5: HRLI IP,010700 ;ADVANCE TO END OF WORD +1CKLNM: SKIPN CH,1(IP) + AOJA IP,1CKLN4 ;WORD OF NULLS -- IGNORE IT IF LNDFIL + TRNN CH,1 ;LINE NUMBER? + POPJ P, ;NO, GET OUT OF HERE + CAME CH,[<^C>*201_4,,-1];END OF BUFFER? + JRST CKLNM7 ;NO + SKIPN LNDFIL ;LINE NUMBERS IN THIS FILE? + POPJ P, ;NO, CATCH END OF BUFFER LATER + SETOM 1CKSNF ;REMEMBER WE WERE HERE + HRLI IP,010700 ;MAKE CALLER SPOT THE END-OF-BUFFER TOO + POPJ P, + +;The following code is also used by CKLNM. +;It has a potential problem: it may skip over the END-OF-BUFFER word +;if a LINE-NUMBER or the first half of a PAGE-MARK appears as the last +;word in the buffer. Luckily, LINE-NUMBERS cannot be placed in word +;177 (mod 200) of a file because lines cannot be spread across TOPS-10 +;disk block boundaries. Similarly, PAGE-MARKs cannot be split across +;blocks. Since LINBFR is a multiple of the disk block size, we +;luck out incredibly. This really should be fixed someday soon. -RHG + +CKLNM7: CAMN CH,[201004020101] ;WAS IT A PAGE MARK? + AOJA IP,CKLNM8 ;YES, TREAT SOMEWHAT DIFFERENTLY + HRLI IP,010700 ;MAKE SURE AT END OF LAST WORD + SKIPN PRLSN ;PRINT LINE NUMBERS? + ADD IP,[<350700-010700>,,2] ;NO, SKIP OVER LINE NUMBER AND TAB FOLLOWING IT + POPJ P, + +CKLNM8: MOVEI CH,^L_1 ;turn the CR CR FF NUL NUL into just FF + MOVEM CH,1(IP) + HRLI IP,100700 + AOJA IP,CPOPJ + +SUBTTL PASS 1 PROCESSING FOR RANDOM (SYMBOLLESS) FILES. + +IFE LISPSW,1LISP: 1UCONS: +IFE MUDLSW,1MUDDL: + +1RANDM: TLNE F,FLSUBT ;IF WE WANT A TABLE OF CONTENTS, + JRST 1RSUBT ;TREAT THE FIRST LINE OF EACH PAGE AS A SUBTITLE. +1RAND1: MOVE IP,LASTIP ;JUST READ IN AND IGNORE BUFFERFULLS AT A TIME + HRLI IP,350700 ;(BUT 1MORE1 CALLS 1CKS, WHICH IS ALL THAT MATTERS). + LDB CH,IP + CAIA ;WE GO TO THE CALL TO 1MORE, + CAIA ;WHICH RETURNS TO THIS CAIA, SO WE DON'T CALL IT AGAIN. + PUSHJ P,1MORE1 +ITS,[ ;PUT PAGE # IN WHO-LINE. + MOVE A,CFILE + MOVE N,LRCPTR + ADDI N,1 + SUB N,F.PAGT(A) ;N GETS SIZE OF PAGE TABLE SO FAR, = # PAGES PASSED. + HRLZS N + LSH N,-1 + ADD N,[1,,] ;LH(N) GETS # OF CURRENT PAGE. RH GETS 0. + HLRZ B,N + HRLI B,(SIXBIT/P1/) + .SUSET [.SWHO3,,B] +];ITS + JRST 1RAND1 + +;COME HERE AT THE START OF EACH PAGE, WHEN PROCESSING /L[RANDOM]/Z. +;TAKE THE FIRST NONBLANK LINE ON EACH PAGE TO BE A SUBTITLE. +1RSUBT: SKIPE LNDFIL ;SKIP OVER ANY LINE-NUMBER. + PUSHJ P,CKLNM +1RSUB0: 1GETCH ;NOW SKIP PAST ANY EMPTY LINES AT THE BEGINNING OF THE PAGE. + CAIN CH,^C + PUSHJ P,1MORE1 + CAIN CH,^L ;DON'T BE CONFUSED BY A BLANK PAGE. + JRST 1RPAG + CAIE CH,^J + CAIN CH,^M ;ANYTHING OTHER THAN CR OR LF INDICATES THIS LINE IS NON-BLANK. + JRST 1RSUB0 + DBP7 IP ;SO BACK UP OVER IT + PUSHJ P,1SUBT ;AND READ IN THIS LINE AS THE SUBTITLE. +1RSUB1: 1GETCH ;SKIP TO END OF PAGE. + CAIN CH,^C + PUSHJ P,1MORE1 + CAIE CH,^L + JRST 1RSUB1 +1RPAG: ADD N,[1,,] ;AT END OF PAGE, INCREMENT PAGE NUMBER FOR WHO-LINE. +ITS,[ + HLRZ B,N + HRLI B,(SIXBIT /P1/) + .SUSET [.SWHO3,,B] +];ITS + JRST 1RSUBT + +SUBTTL PASS 1 MIDAS, FAIL, PALX, AND DAPX16 PROCESSING + +1FAIL: SETOM FAILP ;PASS 1 FOR FAIL CODE + ;ALMOST SAME AS FOR MIDAS. + MOVEI A,1FTBL ;USE THE "FAIL" DISPATCH TABLE FOR PARSING. + JRST 1MIDA1 + +1DAPX: MOVEI A,"/ ; SET COMMENT CHARACTER TO SLASH + MOVEM A,COMC ; ... + SETOM DAPXP ; SET FLAG FOR EASY DAPX16 TESTING + JRST 1MIDAS + +1PLX11: SETOM PALX11 + +;;; PASS 1 PROCESSING FOR MIDAS CODE + +1MIDAS: MOVEI A,1MTBL ;USE THE "MIDAS" TABLE FOR PARSING. +1MIDA1: HRRM A,1MXCT + MOVEI A,6 + CAMLE A,MAXSSZ + MOVEM A,MAXSSZ + MOVEM A,CHS%WD + MOVEI A,1 + MOVEM A,MAXTSZ + MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF +1MNLIN: SKIPE LNDFIL + PUSHJ P,CKLNM ;MAIN LOOP FOR PASS 1 MIDAS AND FAIL CODE. + TRZ F,FRSYL1+FRVSL1+FRIF ;NEW LINE + TRZN F,FRLET+FRSQZ + JRST 1MLOOP + JRST 1MNLI1 + +PTHI==. ? .==PTLO ;FOLLOWING CODE IS IMPURE! + +1MNSYL: TRZN F,FRLET+FRSQZ + JRST 1MLOOP + TRO F,FRSYL1 ;AFTER NON-NULL SYLLABLE => NOT 1ST SYLLABLE. +1MNLI1: MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF +1MLOOP: 1GETCH ;GET NEW CHAR +1MXCT: XCT 0(CH) .SEE 1MTBL,1FTBL ;JFCL FOR LOWER CASE, CAIA FOR SQUOZE, ELSE JRST OFF. + SUBI CH,40 ;CONVERT LOWER CASE => UPPER + IDPB CH,CP ;SAVE SQUOZE CHAR IN SYLLABLE + JRST 1MLOOP + +PTLO==. ? .==PTHI ;SWITCH BACK TO PURE SEGMENT. + +1FUPAR: MOVE A,CODTYP ;UPARROW (^) IN FAIL OR MACRO-10. + CAIN A,CODM10 + JRST 1MSQT1 ;IN MACRO-10, IGNORE NEXT CHARACTER (PART OF OPERATOR) + TRNN F,FRLET ;IN FAIL, BEFORE A SYM, IT'S A BLOCK STR. HACK. + JRST 1MLOOP ;BUT AFTERA SYM, IT'S A GLOBAL REF + MOVEI A,F%GLO ;SO DEFINE IT + JRST 1MDFSM + +1MGLO: SKIPE PALX11 ;DOUBLEQUOTE IN MIDAS-10, OR IN PDP11 CODE. + JRST 1MDQT1 ;JUMP IF IT'S PDP11 CODE. + TRNN F,FRSQZ ;DOUBLE QUOTE SEEN IN MIDAS CODE. + JRST 1MGOBL ;NOT PRECEDED BY LETTER + 1GETCH ;IF PRECEDED BY LETTER, + XCT NSQOZP(CH) ; IS IT FOLLOWED BY SQUOZE? + JRST 1MNSYX ;YES, DENOTES BLOCK NAME + MOVEI A,M%GLO + JSP H,DEFSYM +1MNSYX: TRO F,FRSYL1+FRVSL1 ;NEW SYLLABLE, NEXT CHAR + TRZN F,FRLET+FRSQZ ; ALREADY IN CH DUE TO LOOKAHEAD + JRST 1MXCT + MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF + JRST 1MXCT + +1MDQT1: 1GETCH ;DOUBLE QUOTE IN PALX-11: IGNORE 2 CHARS. + XCT NSQOZP(CH) ;TEST FOR SQUOZENESS BUT IGNORE ANSWER. + JFCL ;THE PURPOSE IS TO HANDLE ^C'S. +1MSQT1: 1GETCH ;SINGLE QUOTE IN PALX-11: IGNORE 1 CHAR. + XCT NSQOZP(CH) + JFCL + JRST 1MNSYL + +1MGOBL: 1GETCH ;GOBBLE A CHAR AFTER ", ', OR ^ IN MIDAS CODE. + CAIN CH,^C + PUSHJ P,1MORE0 +1MGOB1: 1GETCH ;EXAMINE NEXT CHAR + XCT NSQOZP(CH) ;SKIP IF NOT SQUOZE + JRST 1MGOB1 ;GOBBLE IF SQUOZE, TRY AGAIN + CAIE CH,"" ;", ', AND ^ CAN CASCADE, + CAIN CH,"' ; E.G. SUCH AS ^P"C^P"D + JRST 1MGOBL + CAIN CH,"^ + JRST 1MGOBL + JRST 1MNSYX ;ALL DONE WITH THIS SYLLABLE + +1MVAR: SKIPE PALX11 ;SINGLE QUOTE IN EITHER MIDAS OR PALX11 + JRST 1MSQT1 ;IT'S PALX11 + TRNN F,FRSQZ ;SINGLE QUOTE FOUND IN MIDAS. + JRST 1MGOBL ;NO SQUOZE FIRST - MEANS SIXBIT + MOVE D,CP + JSP H,1MSFIN ;FINISH THE SYLLABLE + TRNE F,FRLET ;IFNO LETTERS IN IT AT ALL + CAME D,CP ;OR IF THE ' WASN'T AT THE END, ALTHOUGH IT'S STILL A VALID + JRST 1MNSYX ;VARIABLE DEF. IN MIDAS, IGNORE IT TO AVOID "CAN'T", ETC. + MOVEI A,M%VAR ;DEFINE AS A VARIABLE +1MVAR1: JSP H,DEFSYM + JRST 1MNSYX ;THEN REPROCESS THE CHAR WE READ AHEAD INTO CH. + +1FVAR: TRNN F,FRLET ;# SEEN IN FAIL CODE - DEFINE PRECEDING SYM AS VARIABLE. + JRST 1MNSYL ; UNLESS NO PRECEDING SYM PRESENT + 1GETCH ; IN MACRO-10, SYM## IS DIFFERENT -- TREAT IT LIKE SYM" IN MIDAS + XCT NSQOZP(CH) + JFCL + CAIE CH,"# + JRST 1FVAR1 + MOVEI A,M%GLO + JRST 1MDFSM + +1FVAR1: MOVEI A,F%VAR ;HERE FOR SYM# TO DEFINE A VARIABLE IN MIDAS OR FAIL. + JRST 1MVAR1 ;DEFINE SYM, THE REPROCESS CHAR WHICH WE READ AHEAD INTO CH. + +1FQT: TRNE F,FRSQZ ;' OR " IN FAIL CODE - A TEXT CONSTANT. + JRST 1MBRK ;IN MIDDLE OF SYLLABLE? + MOVE A,CH ;SAVE WHICH EVER QUOTE IT IS, AS TERMINATOR. + MOVEI D,10. ;SCAN TILL TERMINATOR, BUT NO MORE THAN 10. CHARS. +1FQT1: 1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 + CAIE CH,^M + CAMN A,CH + JRST 1MBRK ;FOUND TERMINATOR; END OF TEXT CONSTANT. + SOJG D,1FQT1 ;DON'T LOOK MORE THAN 10. CHARS - MAYBE WE ARE CONFUSED + JRST 1MBRK ;AND THERE'S NO TEXT CONSTANT AND NO TERMINATOR. + +1FUNDR: MOVEI CH,". ;SAIL UNDERSCORE EQUIV. TO "." + SOS (P) ;NOTE THAT SAIL UNDERSCORE = ASCII ^X. + POPJ P, + +1MSPAC: SKIPN PALX11 ;IN PALX11, = AND : ARE ALLOWED. + JRST 1MBRK +1FSPAC: MOVE CH,IP ;SPACE OR TAB IN FAIL CODE: IT MAY BE BETWEEN THE + ILDB CH,CH + XCT NSQOZP(CH) ;SYMBOL AND THE COLON OF A LABEL, ETC. + JRST 1MBRK ; - PROCESS THE 1ST + CAIE CH,"= + CAIN CH,": ;, ETC., MEANS IGNORE THE SPACE + JRST 1MLOOP ;SO THAT THE SYMBOL GETS PROCESSED BY THE DEFINER. + CAIN CH,"_ + JRST 1MLOOP + JRST 1MBRK ; => PROCESS THE SYMBOL AS A REFERENCE. + +1MEQL: TRNN F,FRLET ;EQUALS SIGN FOUND + JRST 1MNSYL + MOVE A,SYLBUF ;IGNORE ".=" + CAMN A,[SIXBIT/./] + JRST 1MNSYL + MOVEI A,M%EQL + JRST 1MDFSM ;PUT IN SYMBOL TABLE + +;SEMICOLON OR SLASH FOUND +1MSEMI: CAME CH,COMC ; IS IT THE COMMENT CHARACTER? + JRST 1MBRK ; NO, ITS JUST A BREAK CHARACTER + +1MSEM1: 1GETCH + CAILE CH,^M ; DO IT THIS WAY FOR SPEED + JRST 1MSEM1 + CAIN CH,^C + PUSHJ P,1MORE0 +1MSEMX: CAIN CH,^M ;FAST SCAN UNTIL ^M OR ^L SEEN + JRST 1MBCR + CAIE CH,^L + JRST 1MSEM1 + TRO N,-1 + AOJA N,1MNLIN + +1MCOMA: TRNN F,FRIF + JRST 1MBRK +1MNVS1: TRZ F,FRIF+FRVSL1 + JRST 1MBRK1 + +1MCTL: TRNN F,FRSQZ ;UPARROW SEEN IN MIDAS CODE. + JRST 1MGOBL ;NOT PRECEDED BY SYLLABLE => TEXT CONSTANT. +1MBRK: TRNE F,FRLET ;BREAK CHAR SEEN. IF SYL CONTAINS A LETTER, + TROE F,FRVSL1 ;AND IS VIRTUAL 1ST SYL, + JRST 1MBRK1 + MOVE A,SYLBUF ;ANALYZE FOR VARIOUS HAIRY PSEUDOS. + CAMN A,[SIXBIT \.LIBFI\] + JRST 1MLIBF ;.LIBFIL MEANS IGNORE THIS FILE COMPLETELY. + CAMN A,[SIXBIT \.AUXIL\] + JRST 1MAUXI + SKIPE PALX11 + JRST 1MBRKP + CAMN A,[SIXBIT \DEFINE\] ;DEFINE IS BOTH MIDAS, FAIL, AND DAPX16. + JRST 1MDEF + CAMN A,[SIXBIT \.DEFMA\] ;.DEFMAC AND .RDEFMAC PSEUDOS + JRST 1MADEF + CAMN A,[SIXBIT \.RDEFM\] + JRST 1MASDF + SKIPE DAPXP ; DAPX16 HAS .STITL INSTEAD OF SUBTTL + JRST 1MBRKD + CAMN A,[SIXBIT \SUBTTL\] + JRST 1MSUBT + SKIPE FAILP + JRST 1MBRKF ;FAIL HAS A DIFFERENT SET OF RELEVANT PSEUDOS. + CAMN A,[SIXBIT \.BEGIN\] ;.BEGIN HAS A BLOCKNAME, WHICH MIGHT BE SOME NEWS; + JRST 1M.BEG + CAMN A,[SIXBIT \.INSRT\] ;.INSRT KNOWS A FILE FOR US TO PERUSE. + JRST 1M.INS + CAMN A,[SIXBIT \$INSRT\] ;$INSRT WILL MAKE "UNIFY" RUN, + JRST 1M$INS + CAME A,[SIXBIT \.ALSO\] ;BUT .ELSE AND .ALSO JUST ACT LIKE "IF1". + CAMN A,[SIXBIT \.ELSE\] + JRST 1MNVS1 + CAMN A,[SIXBIT \.GLOBA\] ;.GLOBAL, .SCALAR, .VECTOR DEFINE + JRST 1M.GLO + CAME A,[SIXBIT/.SCALA/] ;ALL OF THE SYMBOLS THAT FOLLOW IN LINE. + CAMN A,[SIXBIT/.VECTO/] + JRST 1M.VEC + CAMN A,[SIXBIT/EQUALS/] ;EQUALS DEFINES THE FIRST SYM THAT WE SEE, + JRST 1FSYN + CAME A,[SIXBIT/.I/] ;.I AND .F DON'T DEFINE ANYTHING. + CAMN A,[SIXBIT/.F/] ;(EVEN THOUGH THEY ARE LIKELY TO CONTAIN "="). + JRST 1MSEMX + JRST 1MBRK2 + +; PSEUDOS FOR DAPX16 +1MBRKD: CAMN A,[SIXBIT \.STITL\] + JRST 1MSUBT + CAMN A,[SIXBIT \EQUALS\] + JRST 1FSYN + JRST 1MBRK2 + +1MBRKF: CAMN A,[SIXBIT/BEGIN/] + JRST 1M.BEG + CAMN A,[SIXBIT/OPDEF/] + JRST 1FOPDEF + CAME A,[SIXBIT/INTEGE/] + CAMN A,[SIXBIT/ARRAY/] + JRST 1M.VEC + CAMN A,[SIXBIT/SYN/] + JRST 1FSYN + CAMN A,[SIXBIT/.INSER/] + JRST 1M.INS + CAME A,[SIXBIT/ENTRY/] + CAMN A,[SIXBIT/GLOBAL/] + JRST 1M.GLO + CAME A,[SIXBIT/EXTERN/] + CAMN A,[SIXBIT/INTERN/] + JRST 1M.GLO + +; TRY LOOKING IN .DEFMAC TABLE + + TLC A,400000 + SKIPA B,ADEFLS +1MALUP: HRRZ B,(B) + JUMPE B,1MBRK4 + MOVS C,1(B) ;GET SYMBOL ADDR + CAME A,(C) + JRST 1MALUP ;NOT IT, LOOP + SETZM 1MRDFM + TLNE C,%ASRDF ;IS IT A .RDEFMAC? + SETOM 1MRDFM + +1MALP2: JSP H,1MSGET ;GOT IT -- GET ARG + MOVEI A,M%ADEF + JSP H,DEFSYM + SKIPE 1MRDFM + JRST 1MALP2 ;NOTE - SHOULD CHECK TYPE OF DEF FOR LOOP + JRST 1MBRK3 + +1MBRK4: TLC A,400000 +1MBRK2: LSH A,-30 + CAIN A,'IF ;SET FLAG IF SOME KIND OF IF IS + TRO F,FRIF ; VIRTUAL FIRST SYL - SEE 1MCOMA +1MBRK1: CAIG CH,^M + CAIG CH,^I + JRST 1MNSYL +1MBRK3: CAIN CH,^M +1MBCR: TLNE F,FLSCR ;CR: IF FLSCR=0 WE ARE COUNTING CRLFS AS LINES. + JRST 1MBNCR + 1GETCH + XCT NSQOZP(CH) + JRST 1MNSYX + CAIE CH,^J + JRST 1MNSYX + AOJA N,1MNLIN + +1MBNCR: CAIE CH,^L + JRST 1MBNFF + IORI N,-1 ;FF: ADVNCE TO NEXT PAGE. + AOJ N, +ITS,[ ;PUT NEW PAGE # IN WHO-LINE. + HLRZ B,N + HRLI B,(SIXBIT/P1/) + .SUSET [.SWHO3,,B] +];ITS + JRST 1MNLIN + +1MBNFF: CAIN CH,^J ;IF FLSCR=1 WE ARE COUNTING ^J'S AS LINES. + TLNN F,FLSCR + JRST 1MNSYL + AOJA N,1MNLIN + + +1MBRKP: CAME A,[SIXBIT \.SBTTL\] + CAMN A,[SIXBIT \.STITL\] + JRST 1MSUBT + CAME A,[SIXBIT \.PSECT\] + CAMN A,[SIXBIT \.CSECT\] + JRST 1MCSEC + CAMN A,[SIXBIT \.NARG\] + JRST 1MNARG + CAME A,[SIXBIT \.NCHR\] + CAMN A,[SIXBIT \.NTYPE\] + JRST 1MNARG + CAMN A,[SIXBIT \.IIF\] + TRO F,FRIF + CAME A,[SIXBIT \.INSER\] + CAMN A,[SIXBIT \.INSRT\] + JRST 1M.INS + CAME A,[SIXBIT \.REQUI\] ;MACN11 HAS LOTS OF SYNONYMS FOR .INSRT + CAMN A,[SIXBIT \.INCLU\] + JRST 1M.INS + CAME A,[SIXBIT \.MACRO\] + CAMN A,[SIXBIT \.MACR\] + JRST 1MDEF + CAMN A,[SIXBIT \.GLOBL\] + JRST 1M.GLO + JRST 1MBRK1 + +1FBAKA: MOVE A,CODTYP + CAIN A,CODM10 + JRST 1MBRK ;"_" IN MACRO-10 JUST AS IN MIDAS. + TRNN F,FRLET ;"_" IN FAIL LIKE = IN MIDAS. + JRST 1MNSYL + MOVEI A,F%BAKA ;SO IF PRECEDED BY NONNULL SYLLABLE, + JRST 1MDFSM ;REGARD AS SYMBOL DEFINITION. + +1MCLN: TRNN F,FRLET ;COLON FOUND + JRST 1MNSYL ;MUST BE PRECEDED BY LETTER(S) + MOVEI A,M%CLN +1MDFSM: JSP H,DEFSYM ;PUT IN SYMBOL TABLE + JRST 1MNSYL + +1MSUBT: PUSHJ P,1SUBT ;SUBTTL - ON PASS 1, GOBBLE SUBTITLE + JRST 1MBRK1 + +1MAUXI: MOVEI A,FSAUX ;.AUXIL - MARK FILE AS AUXILIARY. + MOVE D,CFILE + IORM A,F.SWIT(D) + JRST 1MBRK1 + +1MLIBF: MOVEI A,FSNOIN ;.LIBFIL - MARK THIS FILE AS NOT TO BE PROCESSED, + MOVE D,CFILE + MOVE H,F.SWIT(D) + TRNN F,FSQUOT ;UNLESS IT IS ACTUALLY BEING LISTED. + JRST 1MBRK1 + IORM A,F.SWIT(D) + JRST 1DONE ;AND STOP PROCESSING IT! + +1FSYN: SKIPA A,[F%SYN] ;SYN, EQUALS +1FOPDE: MOVEI A,F%OPDF ;OPDEF + JRST 1MDEF1 + +1MNARG: SKIPA A,[P%NARG] ;.NARG, ETC. +1MCSEC: MOVEI A,P%CSEC ;.CSECT. + JRST 1MDEF1 + +1M.BEG: SKIPA A,[M%BLOK] ;.BEGIN FOUND +1MDEF: MOVEI A,M%MAC ;DEFINE FOUND +1MDEF1: TRNE F,FRSYL1 ;MUST BE FIRST SYLLABLE ON LINE + JRST 1MNSYL + JSP H,1MSGET + JSP H,DEFSYM ;ENTER IN SYMBOL TABLE + JRST 1MSEMX ;IGNORE REST OF LINE + +1M.VEC: JSP H,1MSGET ;.SCALAR, .VECTOR, INTEGER, ARRAY. + MOVEI A,M%VAR + SKIPE FAILP + MOVEI A,F%VAR + JSP H,DEFSYM + JRST 1M.VEC + +1M.GLO: JSP H,1MSGET ;.GLOBAL FOUND + MOVEI A,M%GLO ;DEFINE ARGS AS GLOBAL SYMBOLS + SKIPE FAILP + MOVEI A,F%GLO + JSP H,DEFSYM + JRST 1M.GLO + +; .DEFMAC AND .RDEFMAC HANDLER + +1MASDF: SETOM 1MRDFM ;SAY RDEFMAC + CAIA +1MADEF: SETZM 1MRDFM +1MADLP: JSP H,1MSGET ;GET NEXT SYLLABLE + MOVEI A,M%AMAC + JSP H,DEFSYM ;DEFINE IT + PUSH DP,ADEFLS ;CONS ONTO LIST + HRRZM DP,ADEFLS + MOVSI A,%SXSYM ;SAY DON'T LIST THIS DEF IN SYMTAB + IORM A,S.BITS(B) + HRLZI B,(B) + SKIPE 1MRDFM + HRRI B,%ASRDF ;PUT IN FLAGS IN RH OF B + PUSH DP,B + JRST 1MADLP + +1MSGET: MOVE CP,[440600,,SYLBUF] ;GET NEXT SYLLABLE (ARG TO PSEUDO). + SETZM SYLBUF +1MSGT1: CAMN CH,COMC ;SCAN, IGNORING NON-SQUOZE, EXCEPT FOR A FEW. + JRST 1MSEM1 ; FEW SPECIAL CHARS + CAILE CH,^M + JRST 1MSGT3 + CAIE CH,^K + CAIG CH,^I + JRST 1MSGT3 + JRST 1MBRK3 + +1MSGT3: 1GETCH + XCT NSQOZP(CH) + JRST 1MSGT2 ;WE'VE FOUND A SQUOZE CHAR! + JRST 1MSGT1 ;WE HAVEN'T, SO KEEP LOOKING. + +1MSGT2: XCT 1MTBL(CH) ;NOW GOBBLE UP SQUOZE CHARS, + SUBI CH,40 ; AND DEPOSIT SIXBIT IN BUFFER + IDPB CH,CP +1MSFIN: 1GETCH ;ENTRY TO FINISH A SYLLABLE + XCT NSQOZP(CH) + JRST 1MSGT2 + JRST (H) + +;;; TABLE FOR PASS 1 MIDAS PROCESSING +;;; +;;; XCT 1MTBL(CH) +;;; SUBI CH,40 +;;; IDPB CH,CP +;;; +;;; IF CH IS A SQUOZE CHARACTER, THEN THE IDPB WILL +;;; DEPOSIT THE CORRECT SIXBIT FOR THAT CHARACTER, +;;; CONVERTING LOWER CASE LETTERS TO UPPER CASE. +;;; FURTHERMORE, IT WILL SET THE FRLET AND FRSQZ FLAGS +;;; AS APPROPRIATE. IF CH IS NOT SQUOZE, IT WILL JRST +;;; OFF TO SOME APPROPRIATE ROUTINE. + +1MTBL: JRST 1MLOOP ;^@ +REPEAT 2, JRST 1MBRK ;^A ^B + PUSHJ P,1MORE ;^C +REPEAT 34, JRST 1MBRK ;^D-^_ + JRST 1MSPAC ;SPACE + JRST 1MBRK ;! + JRST 1MGLO ;" + JRST 1MBRK ;# +REPEAT 2, TRO F,FRLET+FRSQZ ;$ % + JRST 1MBRK ;& + JRST 1MVAR ;' +REPEAT 4, JRST 1MBRK ;( ) * + + JRST 1MCOMA ;, + JRST 1MBRK ;- + TRO F,FRLET+FRSQZ ;. + JRST 1MSEMI ;/ +REPEAT 12, TRO F,FRSQZ ;0-9 + JRST 1MCLN ;: + JRST 1MSEMI ;; + JRST 1MBRK ;< + JRST 1MEQL ;= +REPEAT 3, JRST 1MBRK ;> ? @ +REPEAT 26., TRO F,FRLET+FRSQZ ;A-Z +REPEAT 3, JRST 1MBRK ;[ \ ] + JRST 1MCTL ;^ + JRST 1MBRK ;_ + JRST 1MBRK ;` +REPEAT 26., TROA F,FRLET+FRSQZ ;a-z +REPEAT 4, JRST 1MBRK ;{ | } ~ + JRST 1MLOOP ;RUBOUT + +IFN .-1MTBL-200, .ERR WRONG LENGTH TABLE + +;DISPATCH TABLE FOR PASS 1 FAIL AND MACRO-10 PROCESSING. +;USED JUST LIKE (AND IN PLACE OF) 1MTBL. +;MOST ENTRIES ARE THE SAME AS IN 1MTBL, AND ENTRIES FUNCTION +;THE SAME WAY. + +1FTBL: JRST 1MLOOP ;^@ + JRST 1MLOOP ;^A + JRST 1MBRK ;^B + PUSHJ P,1MORE ;^C +REPEAT 5, JRST 1MBRK ;^D - ^H + JRST 1FSPAC ;^I (TAB, TREAT LIKE SPACE) + JRST 1MBRK ;^J + JRST 1FUPAR ;^K +REPEAT 12., JRST 1MBRK ;^L THROUGH ^W + PUSHJ P,1FUNDR ;^X (SAIL UNDERSCORE) SAME AS ".". +REPEAT 7, JRST 1MBRK ;^Y THROUGH ^_ + JRST 1FSPAC ;SPACE + JRST 1MBRK ;! + JRST 1FQT ;" + JRST 1FVAR ;# +REPEAT 2, TRO F,FRLET+FRSQZ ;$ % + JRST 1MBRK ;& + JRST 1FQT ;' +REPEAT 4, JRST 1MBRK ;( ) * + + JRST 1MCOMA ;, + JRST 1MBRK ;- + TRO F,FRLET+FRSQZ ;. + JRST 1MBRK ;/ +REPEAT 10., TRO F,FRSQZ ;0 - 9 + JRST 1MCLN ;: + JRST 1MSEMI ;; + JRST 1MBRK ;< + JRST 1MEQL ;= + JRST 1MBRK ;> + JRST 1MLOOP ;? + JRST 1MBRK ;@ +REPEAT 26., TRO F,FRLET+FRSQZ ;A - Z +REPEAT 3, JRST 1MBRK ;[ \ ] + JRST 1FUPAR ;^ + JRST 1FBAKA ;_ + JRST 1MBRK ;` +REPEAT 26., TROA F,FRLET+FRSQZ ;a - z +REPEAT 3, JRST 1MBRK ;{ | } + JRST 1FUPAR ;~ + JRST 1MBRK ;RUBOUT + +IFN .-200-1FTBL,.ERR WRONG TABLE LENGTH + +;;; TABLE FOR DECIDING WHEHER THE CHARACTER IN CH IS +;;; SQUOZE OR NOT. XCT'ING INTO THE TABLE SKIPS IFF +;;; THE CHARACTER IS NOT A-Z, 0-9, ., $, %. +;;; IF IT IS ^C, 1MORE IS CALLED, POSSIBLY TO READ IN A +;;; NEW BUFFERFULL OF CHARACTERS. + +NSQOZP: +REPEAT 3, CAIA ;^@-^B + PUSHJ P,1MORE ;^C +REPEAT ^X-^D, CAIA ;^D-^W + SKIPE FAILP ;^X IS SQUOZE IN FAIL. +REPEAT "#-^X CAIA ;^Y-# +REPEAT 2, JFCL ;$ % +REPEAT 10, CAIA ;&-- + JFCL ;. + CAIA ;/ +REPEAT 12, JFCL ;0-9 +REPEAT 7, CAIA ;:-@ +REPEAT 26., JFCL ;A-Z +REPEAT 6, CAIA ;[ \ ] ^ _ ` +REPEAT 26., JFCL ;a-z +REPEAT 5, CAIA ;{ | } ~ RUBOUT + +IFN .-NSQOZP-200, .ERR WRONG LENGTH TABLE + +SUBTTL PASS 1 SUBTITLE GOBBLER + +;;; GOBBLE SUBTITLE ON PASS 1. SUBTITLE BEGINS WITH FIRST +;;; NON-BLANK AND ENDS WITH OR WHEN PARENS COUNT IN +;;; R REACHES ZERO (USED FOR LISP COMMENTS). + +1SUBT: MOVSI R,400000 ;HUGE PARENS COUNT FOR MIDAS, ETC. +1SUBTL: PUSH DP,SUBTLS ;ENTER HERE WITH R CONTAINING 1 FOR LISP + HRRZM DP,SUBTLS ;CREATE SUBTITLE NODE, LINK INTO LIST + PUSH DP,CFILE + HLLM N,(DP) + MOVSI B,(010700,,(DP)) + SETZ C, ;C GETS CHARACTER COUNT +1SUBT0: CAIN CH,^M ;WATCH OUT FOR NULL SUBTITLE + JRST 1SUBT9 + 1GETCH ;SKIP OVER SPACES AND TABS + CAIN CH,^C + PUSHJ P,1MORE0 + CAIE CH,40 + CAIN CH,^I + JRST 1SUBT0 +1SUBT1: CAIN CH,^M + JRST 1SUBT9 ; TERMINATES SUBTITLE + CAIN CH,"( + AOJA R,1SUBT2 + CAIN CH,") + SOJE R,1SUBT9 ;MISMATCHED ")" ALSO TERMINATES FOR LISP +1SUBT2: TLNE B,760000 ;MAYBE START NEW WORD OF ASCII + JRST 1SUBT4 + ADD B,[430000,,] + PUSH DP,[0] +1SUBT4: CAIE CH,^I ;DON'T LET ANY TABS OR BS'S INTO SUBTITLE + CAIN CH,^H ;BECAUSE THEY WOULD SCREW UP FORMATTING. + MOVEI CH,40 + IDPB CH,B + 1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 + SOJA C,1SUBT1 + +1SUBT9: HRLM C,@SUBTLS ;CLOBBER IN CHARACTER COUNT. + MOVE D,CODTYP + CAIN D,CODRND ;UNLESS /L[RANDOM], + POPJ P, + MOVEI A,FSSUBT ;SET "THIS FILE HAS SUBTITLES" BIT. + MOVE D,CFILE ;DON'T SET FOR /L[RANDOM] SO SUBTITLES DON'T APPEAR + IORM A,F.SWIT(D) ;ON LISTING PAGES. SUBOUT CHECKS SPECIALLY TO MAKE + POPJ P, ;SURE THAT IT STILL OUTPUTS THE TABLE OF CONTENTS. + +SUBTTL PASS 1 INSERT FILE PROCESSING + +1INSRT: MOVE A,ODEFSW ;/$ SETTING FOR .INSRT'ED FILES IS WHAT THE SETTING WAS + ANDI A,FSNSMT ;AT THE END OF THE COMMAND STRING. + TLNN F,FLINSRT ;UNLESS /I WAS SPEC'D, + IORI A,FSQUOT ;INHIBIT LISTING OF INSRTED FILES. + MOVEM A,INSSWT + TDZA L,L ;CLEAR ENTRY POINT FLAG +1INSR0: SETO L, ;SET FLAG -- WE WANT AN FLOSE IF FILE NOT FOUND + +;ADD A FILE TO @'S TABLE OF FILES TO BE PROCESSED. +;INSSNM ... INSFN2 CONTAIN THE FILENAMES. INSSWT CONTAIN THE PER-FILE SWITCHES. +;IF L IS ZERO THEN WE IGNORE FILES THAT CAN'T BE FOUND. +;THE FILE BLOCK INDEX IS RETURNED IN A (OR 0 IF WE IGNORE THE FILE FOR SOME REASON). + PUSH P,CH +1INSR1: MOVE A,INSDEV + CAME A,[SIXBIT \TTY\] + CAMN A,[SIXBIT \NONE\] + JRST 1INSRL + MOVE A,SFILE + CAIN A,EFILES + JRST [ STRT [ASCIZ \Too many files!\] + JRST ERRDIE + ;JRST 1INSRL + ] + MOVE R,INSFN1 + MOVE B,INSFN2 + MOVEI A,FILES +1INSR2: MOVE CH,F.SWIT(A) ;LOOP TO SEE IF THERE IS ALREADY AN ENTRY FOR THIS FILE + TRNE CH,FSLREC ;LISTING RECORD FILES DON'T COUNT. + JRST 1INSR3 + SKIPLE OLDFL ;IN LREC FILE EDIT MODE, _' DOESN'T HAVE NORMAL MEANING. + JRST 1INSR5 + TRC CH,FSARW+FSQUOT + TRCN CH,FSARW+FSQUOT + JRST 1INSR3 +1INSR5: +DOS,[ CAME B,F.IFN2(A) ;OFF ITS, REQUIRE THAT FN2 MATCH OLD FILE'S IF FN2 SPECIFIED. + JUMPN B,1INSR3 ;BUT UNSPECIFIED => IT WILL DEFAULT, SO DON'T COMPARE. +];DOS + CAMN R,F.IFN1(A) + JRST POPCHJ +1INSR3: ADDI A,LFBLOK + CAME A,SFILE + JRST 1INSR2 + JUMPN B,1INSR6 +DOS,[ PUSHJ P,1INSOP ;OFF ITS, NO FN2 SPECIFIED CAN MEAN A NULL FN2, SO TRY TO OPEN. + CAIA + JRST 1INSR4 ;SUCCEED => USE THE NULL FN2 AS NAME OF FILE TO BE PROCESSED. + MOVE B,CODTYP ;OTHERWISE GET THE DEFAULT FN2 FOR THIS LANGUAGE + MOVE B,IPTFN2(B) ;AND TRY TO OPEN AND USE THAT. +];DOS +ITS, MOVE B,IPTFN2 ;ON ITS, ALWAYS DEFAULT A NULL FN2. + MOVEM B,INSFN2 +1INSR6: PUSHJ P,1INSOP ;OPEN FILE ON INSC JUST TO SEE IF IT'S THERE. + JRST 1INSR7 ;TELL THE USER +1INSR4: MOVEI L,LFBLOK(A) + MOVEM L,SFILE + MOVEI B,(A) + HRLI B,INSSNM + BLT B,F.IFN2(A) + SETZM F.OSNM(A) + SETZM F.ODEV(A) + SETZM F.OFN1(A) + SETZM F.OFN2(A) + MOVE B,INSSWT + MOVEM B,F.SWIT(A) + MOVE CH,[INSC,,CHSTAT] + PUSHJ P,FPRCHS ;SET UP F.RDEV, ETC., USING .RCHST. + .CLOSE INSC, + JRST POPCHJ + +1INSR7: JUMPE L,POPCHJ ;DON'T COMPLAIN TO USER IF CALLED VIA .INSERT OR SUCH + SKIPGE NXFDSP ;IN /-! MODE, DON'T COMPLAIN ABOUT MISSING FILES. + JRST 1INSR4 ;JUST PRETEND THEY EXIST. + CAIA + JRST 1INSR1 ;TRY AGAIN IF FLOSE GETS A NEW NAME + FLOSE INSC,INSSNM + JFCL .+1 ;OTHERWISE CHECK NXFDSP + SKIPG NXFDSP + JRST 1INSR4 ;AND KEEP THE LREC INFO IF /0! +1INSRL: SETZ A, + JRST POPCHJ + +1INSOP: +ITS,[ .CALL INSOPN + POPJ P, + JRST POPJ1 + +INSOPN: SETZ + SIXBIT \OPEN\ ;OPEN FILE + 5000,,2 ;ASCII BLOCK INPUT + 1000,,INSC ;CHANNEL # + INSDEV ;DEVICE + INSFN1 ;FILE NAME 1 + INSFN2 ;FILE NAME 2 + 400000,,INSSNM ;SNAME +];ITS +NOITS,[ SETZM INSCHN ;ASCII MODE + MOVE CH,INSDEV + MOVEM CH,INSCHN+1 + OPEN INSC,INSCHN + POPJ P, + HRLOI CH,377777 + MOVEM CH,INSFIL+.RBSIZ + MOVE CH,INSFN1 + MOVEM CH,INSFIL+.RBNAM + MOVE CH,INSFN2 + HLLZM CH,INSFIL+.RBEXT + MOVE CH,INSSNM + MOVEM CH,INSFIL+.RBPPN +NOSAI, LOOKUP INSC,INSFIL ;TRY EXTENDED LOOKUP + JRST [ MOVEM CH,INSFIL+.RBNAM+3 ;FUNNY PLACE BECAUSE + LOOKUP INSC,INSFIL+.RBNAM ;NON XTENDED LOOKUP + POPJ P, + HRLOI CH,377777 + MOVEM CH,INSFIL+.RBSIZ + MOVEI CH,INSC +SAI, PNAME CH, +NOSAI, DEVNAM CH, + MOVE CH,INSDEV + MOVEM CH,INSFIL+.RBDEV + JRST POPJ1 ] +NOSAI, JRST POPJ1 +];NOITS + +1MFNAM: SETZ A, + MOVE B,[440600,,A] +1MFNM1: 1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 +NOITS, CAIE CH,"[ ;] + CAIN CH,40 + JRST 1MFNM3 +ITS, CAIE CH,"; +NOITS, CAIE CH,". + CAIN CH,": + JRST 1MFNM3 + CAIGE CH,"! + JRST 1MFNM3 + CAIE CH,^Q + JRST 1MFNM2 + 1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 +1MFNM2: CAIGE CH,140 + SUBI CH,40 + TLNE B,770000 + IDPB CH,B + JRST 1MFNM1 + +1MFNM3: JUMPN A,1(H) + CAIE CH,^M + CAIN CH,^J + JRST (H) + CAIN CH,^L + JRST (H) + JRST 1MFNM1 + +;HANDLE $INSRT (A MACRO HACKED BY UNIFY AND SUNDER) +1M$INS: JSP H,1MFNAM + JRST 1MSEMX + MOVEM A,INSFN1 + HRLZ B,CFILE + HRRI B,INSSNM + BLT B,INSDEV + PUSHJ P,1INSRT + JRST 1MSEMX + +1.INSR: +REPEAT 4, SETZM INSSNM+.RPCNT +1.INS1: JSP H,1MFNAM + JRST 1.INS5 + CAIN CH,": + JRST 1.INS6 + CAIN CH,"; ;SEMICOLON AFTER A NON-NULL NAME IS AN SNAME. + JUMPN A,1.INS7 ;IF A'S BLANK, SEMICOLON WILL BE TREATED AS COMMENT. + SKIPN INSFN1 ;TO UNDERSTAND THIS CODE, NOTE THAT 1) NO NAME + EXCH A,INSFN1 ;IS SET UNLESS IT WAS PREVIOUSLY 0, AND 2) + SKIPN INSFN2 ;A BECOMES 0 AFTER SETTING ANY NAME. + EXCH A,INSFN2 ;THUS, THIS CODE PUTS A INTO THE FIRST OF + SKIPN INSDEV ;INSFN1, INSFN2, INSDEV, INSSNM WHICH WASN'T ALREADY SET, + EXCH A,INSDEV ;AND DOESN'T ALTER THE OTHERS. + SKIPN INSSNM + EXCH A,INSSNM +;COME HERE WITH THE FILENAME-DELIMITING CHARACTER IN CH. +1.INS5: +DOS,[ CAIN CH,"[ ;] ;IN DEC VERSION, BRACKET STARTS A PPN. + PUSHJ P,1.IPPN +];DOS + CAIE CH,"; ;DETECT SEMICOLONS NOT PRECEDED BY AN SNAME. + CAIN CH,^M + JRST 1.INS8 + CAIE CH,^J + CAIN CH,^L + JRST 1.INS8 + JRST 1.INS1 + +1.INS6: MOVEM A,INSDEV + JRST 1.INS1 + +1.INS7: MOVEM A,INSSNM + JRST 1.INS1 + +1.INS8: DBP7 IP ;BACK UP OVER ^J OR WHATEVER +1INSDF: MOVE A,CFILE ;USE CURRENT FILE'S NAMES +REPEAT 3,[ ; AS THE .INSRT FILNAMES, BUT LEAVE FN2 BLANK IF UNSPECIFIED. + MOVE B,.RPCNT(A) + SKIPN INSSNM+.RPCNT + MOVEM B,INSSNM+.RPCNT +] ;END OF REPEAT 3 + JRST 1INSRT + +1M.INS: PUSHJ P,1.INSR + JRST 1MSEMX + +DOS,[ +;PPN READER FOR .INSRT'S IN DEC VERSION. + +1.IPPN: SETZB A,B + 1GETCH ;[ + CAIN CH,"] + POPJ P, ;IGNORE [] +NOSAI,[ ; CRETIN OCTAL PPN'S!! +1.IPP3: CAIL CH,"0 + CAILE CH,"7 + JRST 1.IPP2 + LSH B,3 + TRO B,-"0(CH) + 1GETCH + CAIE CH,", + JRST 1.IPP3 +1.IPP6: 1GETCH + CAIL CH,"0 + CAILE CH,"7 + JRST 1.IPP8 + LSH A,3 + TRO A,-"0(CH) + JRST 1.IPP6 +];NOSAI +SAI,[ +1.IPP3: CAILE CH,"_ + SUBI CH,<" > ; LOWERCASEIFY IF NECESSARY + CAIL CH,<" > ;[ + CAIN CH,"] + JRST 1.IPP2 + LSH B,6 + TRO B,-<" >(CH) + 1GETCH + CAIE CH,", + JRST 1.IPP3 +1.IPP6: 1GETCH + CAILE CH,"_ + SUBI CH,<" > + CAIL CH,<" > ;[ + CAIN CH,"] + JRST 1.IPP8 + LSH A,6 + TRO A,-<" >(CH) + JRST 1.IPP6 +];SAI +1.IPP8: HRLI A,(B) ;[ + CAIN CH,"] + JRST 1.IPP4 +CMU,[ +1.IPP2: JUMPN B,1.IPPL ;BAD RIGHT OFF IF ALREADY SAW OCTAL +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE B,[440700,,PPNBUF] +1.IPP5: CAIE CH,^M ;DON'T LOOK TOO FAR + SKIPE PPNBUF+3 + JRST 1.IPPL + IDPB CH,B + 1GETCH ;[ + CAIE CH,"] ;LOOP TILL WE FIND A CLOSE BRACKET + JRST 1.IPP5 + MOVE B,[A,,PPNBUF] + CMUDEC B, + POPJ P, +];CMU +1.IPP4: MOVEM A,INSSNM + POPJ P, + +NOCMU,1.IPP2: +1.IPPL: 1GETCH + CAIE CH,^M ;[ + CAIN CH,"] + POPJ P, + JRST 1.IPPL +];DOS + +SUBTTL PASS 1 SYMBOL DEFINITION ROUTINE + +;;; DEFINE SYMBOL IN SYLBUF WITH CODE IN A, RETURNS PTR TO ENTRY IN B +;;; MUSTN'T CLOBBER CH. + +DEFSYM: AOS NSYMSF ;COUNT # SYMS DEFINED IN EACH FILE + TLNE F,FLARB ;SKIP IF SINGLE WORD SYMS + JRST DEFSY1 + MOVE B,SYLBUF + SKIPE PALX11 ;IN PDP11 CODE, IGNORE "LOCAL" N$ SYMBOLS. + JRST DEFSY6 + SKIPN FAILP + JRST DEFSY3 +DEFSY6: TLC B,200000 ;IN FAIL SYMBOLS CAN'T START WITH DIGITS. + TLNN B,600000 + JRST (H) + MOVE B,SYLBUF +DEFSY3: TLC B,400000 ;MAKE PDP-10 SIGNED COMPARISONS WORKS LIKE UNSIGNED + PUSH SP,B ;PUSH WORD INTO SYM TBL ENTRY + JRST DEFSY5 +DEFSY1: SETZ C, + TDZA B,B ;ELSE FILL OUT SYM WITH +DEFSY2: IDPB B,CP ; SPACES TO WORD BOUNDARY + TLNE CP,760000 + AOJA C,DEFSY2 + MOVNI D,(CP) + HRLI D,SYLBUF-1(D) + HRRI D,1(DP) + MOVEI B,(CP) ;TOO BAD WE CAN'T HAVE NEGATIVE RELOCATION + SUBI B,SYLBUF-1 ; OR WE COULD COMBINE THESE TWO INSTRUCTIONS + IMUL B,CHS%WD + SUBI B,(C) + CAMLE B,MAXSSZ + MOVEM B,MAXSSZ + MOVEI B,SYLBUF +DEFSY4: MOVE C,(B) + TLC C,400000 ;COMPLEMENT SIGN BIT OF EACH WORD OF SYMBOL NAME. + TLNE F,FLASCI + TRZ C,1 ;IF ASCII, MAKE SURE ALL LOW BITS ARE ZERO. + PUSH DP,C ;PUT THE WORD IN THE DATA AREA + CAIE B,(CP) + AOJA B,DEFSY4 + PUSH SP,D ;PUSH OUT INTO SYM TBL ENTRY +DEFSY5: HRL A,CFILE + MOVEI B,(SP) ;RETURN PTR TO ENTRY + PUSH SP,A ;PUSH ,, + PUSH SP,N ;PUSH ,, + PUSH SP,[0] ;PUSH EXTRA WORD FOR FUN LATER + JRST (H) + +SUBTTL PASS 2 SYMBOL REFERENCING ROUTINE + +;;; TRY TO REFERENCE SYMBOL IN A. IF WE WIN, LEAVE POINTER +;;; IN LSYL FOR OUTLIN TO SEE. CALL WITH JSP H,. + +REFSYM: HRRZ B,S.TYPE(A) ;LOOK AT THE TYPE OF THE DEFINITION OF THE SYMBOL. + JUMPE B,(H) ;IGNORE REFS TO SYMS WITH DEFS OF UNKNOWN TYPE. + HLL B,(B) + JUMPG B,REFSY9 + TLNE B,T%NREF ;IT'S A USER TYPE: + JRST (H) ;IGNORE REFS TO SYMS MERELY DEFPROP'D, + JRST REFSY5 ;BUT @DEFINED, ETC SYMBOL TYPES ARE ALWAYS GOOD. + +REFSY9: HLLZ B,1(B) ;IT'S A SYSTEM TYPE. + TLNE B,T%NREF ;IGNORE REFS TO SYMBOLS OF CERTAIN TYPES. + JRST (H) + JUMPE B,REFSY5 + HLRZ C,S.FILE(A) + CAME C,CFILE + JRST REFSLS + TLNN B,T%BIND ;REFER TO A BINDING OF A SYMBOL + JRST REFSY8 + MOVE C,LFNBEG ;ONLY IF WE APPEAR TO BE INSIDE ITS SCOPE. + CAMG C,S.PAGE(A) ;THAT IS, THE BINDING IS BETWEEN THE LAST FUNCTION BEGINNING + CAMG N,S.PAGE(A) ;AND WHERE WE ARE. + JRST REFSLS + JRST REFSY5 + +REFSLS: ADDI A,LSENT ;ONE DEFINITION IS OUT OF ITS SCOPE => + SKIPL S.TYPE(A) .SEE %SDUPL ; TRY SAME SYMBOL'S NEXT DEF, IF THERE IS ONE. + JRST (H) + JRST REFSYM + +REFSY8: HLRZ C,S.PAGE(A) .SEE T%TAG + HLRZ D,N ;REFER TO A PROG OR LAP TAG ONLY FROM SAME PAGE. + CAME D,N + JRST REFSLS +REFSY5: CAME N,S.PAGE(A) ;WHERE WAS THIS SYMBOL DEFINED? + JRST REFSY6 + HLRZ C,S.FILE(A) ; REFERENCING FROM SAME LINE AS DEFN? + CAMN C,CFILE ; (E.G. IFNDEF FOO,FOO==1) => IGNORE THIS REF. + JRST (H) +REFSY6: MOVSI B,%SREFD ;MARK THIS SYMBOL AS REFERENCED AT LEAST ONCE. + IORM B,S.BITS(A) + SKIPN B,LSYL ;IF NO OTHER SYM REFD YET ON THIS LINE, + JRST REFSY1 ; MENTION THIS ONE IN THE MARGIN. + MOVE C,S.BITS(A) + HLR C,S.BITS(B) + TDCE C,[%SXCRF,,%SXCRF] ;IF ONE HAS BEEN .XCREF'D + TDCN C,[%SXCRF,,%SXCRF] ; AND NOT THE OTHER, + JRST REFSY4 ; THEN PREFER THE LATTER + TLNN C,%SXCRF + JRST REFSY1 + JRST REFSY2 + +REFSY4: HRRZ C,S.TYPE(A) + HRRZ D,S.TYPE(B) ;PREFER WHICHEVER SYMBOL HAS A DEFINITION + CAMN D,C ;OF THE HIGHEST PRIORITY TYPE. + JRST REFSY3 + CAML C,D + JRST REFSY2 + JRST REFSY1 + +REFSY3: HLRZ C,S.PAGE(B) ;OTHERWISE, THEY'RE EQUAL SO FAR, SO + HLRZ B,N + CAIE C,(B) ;MAKE A SYMBOL ON PAGE 1 OR CURRENT PAGE + CAIN C,1 ;LOSE TO A SYMBOL ON SOME OTHER PAGE. + JRST REFSY1 + HLRZ C,S.PAGE(A) ;ELSE IF THE NEW ONE IS ON PAGE 1, + CAIE C,(B) + CAIN C,1 + JRST REFSY2 +REFSY1: MOVEM A,LSYL ;CLOBBER IT IN +REFSY2: TLNN F,FLCREF ;NOW THAT WE HAVE REF'D IF DESIRED, + JRST (H) ;CREF TOO IF DESIRED. + SETZ B, + +;;; POSSIBLY ENTER CREF DATA FOR A SYMBOL +;;; (ADDRESS OF SYMBOL TABLE ENTRY IN A, TYPE OF REFERENCE IN B) + +CREFSYM: MOVE C,S.CREF(A) .SEE S.BITS + TLNE C,%SXCRF ;IF .XCREF'D, DO NOT CREF + JRST (H) + HRL B,CFILE + HRRM DP,S.CREF(A) + PUSH DP,B + PUSH DP,N + PUSH DP,C + JRST (H) + +SUBTTL PASS 1 PROCESSING FOR LISP CODE + +IFN LISPSW,[ +1LISP: MOVEI A,5 + MOVEM A,CHS%WD + CAMLE A,MAXSSZ + MOVEM A,MAXSSZ + CAMLE A,MAXTSZ + MOVEM A,MAXTSZ + PUSH P,[1LLOOP] ;PROTECT AGAINST A POP1J. + MOVEM P,LISPP ;SAVE PDL POINTER FOR "THROWS" +1LLOOP: MOVE P,LISPP ;MAY JUMP HERE AT ^L, THUS RESETTING PDL + PUSHJ P,1LTOKN + JRST 1LLP2 ;( + JRST 1LLOOP ;) + JRST 1LLP1 ;' + JRST 1LLOOP ;ATOM + +1LLP1: PUSHJ P,1LSKIP ;' AT TOP LEVEL + JRST 1LLOOP + +1LLP2: PUSHJ P,1LTFRM ;TOP LEVEL NON-ATOMIC FORM + JRST 1LLOOP + +1LTFRM: SKIPA A,[1,,] ;( SEEN AT TOP LEVEL +1LNAF: MOVSI A,2 ;( SEEN IN FUNCTIONAL POSITION + HLLM A,(P) +1LFORM: PUSHJ P,1LTOKN ;( SEEN IN ARGUMENT POSITION + JRST 1LNAF1 ;( - SO GOBBLE UP FUNCTION + JRST POP1J ;) () = NIL + JRST 1LSUBR ;' QUOTED FN - BIG DEAL + JSP H,OBLOOK ;ATOMIC FUNCTION - LOOK IT UP + JRST 1LFRM1 ;NOT FOUND + HLRZ H,OBARRAY+1(C) + JRST (H) ;ELSE JUMP TO HANDLER + +1LFRM1: MOVEI H,(B) + SKIPA L,ADEFLS ;TRY LOOKING UP SYMBOL IN THE @DEFINE LIST +1LFRM2: HRRZ L,(L) + JUMPE L,1LFRM5 ;NOT THERE EITHER - IF IT STARTS WITH "DEF", PUT IT THERE. + HLRZ R,1(L) ;TRY AN ENTRY + MOVE D,A + HRRZ R,(R) +1LFRM3: MOVE C,(R) + CAME C,(D) + JRST 1LFRM2 ;NAME DIFFERS - LOSE + ADDI R,1 + SUBI H,5 + AOBJN D,1LFRM3 + SKIPE (R) ;IF SYMBOL IS INTEGRAL NUMBER OF WORDS, MAKE SURE THAT THE TYPE, + JUMPE H,1LFRM2 ;WHICH IS ASCIZ, HAS A ZERO WORD FOLLOWING. + HRRZ R,1(L) ;WE HAVE WON - GET TYPE POINTER +1LFRM6: PUSHJ P,1LTOKN + JRST 1LFRM4 ;( (MYDEFINE (FOO ARGS) ... IS A POSIBILITY. + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + JSP H,LDEFSYM ;ATOM - DEFINE AS A SYMBOL + HRRM R,S.TYPE(L) ;ITS TYPE IS AS SPECIFIED BY @DEFINE ENTRY + JRST 1LSUBR + +;COME HERE AFTER "(MYDEFINE(", WHERE MYDEFINE HAS BEEN @DEFINED. +1LFRM4: PUSHJ P,1LTOKN + JRST 1L2LUZ ;( ;(MYDEFINE (( + JRST 1LSUBR ;) ;(MYDEFINE () + JRST 1LLLUZ ;' ;(MYDEFINE (' + JSP H,LDEFSYM ;ATOM - (MYDEFINE (FOO => DEFINE FOO. + HRRM R,S.TYPE(L) ;ITS TYPE IS AS SPECIFIED BY @DEFINE ENTRY + JRST 1LLLUZ ;PROCESS REST OF THE MYDEFINE AS CODE. + +1LFRM5: MOVE D,(A) ;HERE FOR UNRECOGNIZED FUNCTION AT TOP LEVEL. + AND D,[.BYTE 7 ? 137 ? 137 ? 137] + CAME D,[ASCII /DEF/] ;COMPARE FIRST THE CHARS WITH "DEF", IGNORING CASE. + JRST 1LSUBR ;NOT "DEF" => THIS FORM ISN'T INTERESTING TO @, SO SKIP IT. + JSP H,LDEFTYP + PUSH DP,ADEFLS ;ADD THIS SYMBOL TO @DEFINE LIST + HRRZM DP,ADEFLS + PUSH DP,R + HRLM R,(DP) + CAML B,MAXTSZ ;UPDATE WIDTH OF WIDEST SYMBOL TABLE TYPE NAME. + MOVEM B,MAXTSZ ;B HAS THE NUMBER OF CHARS OF THE LAST TOKEN READ. + JRST 1LFRM6 ;NOW PROCESS THIS USE OF THE FUNCTION, AS AN @DEFINED FUNCTION. + +1LNAF1: PUSHJ P,1LNAF + JRST 1LSUBR + +;;; GOBBLE UP LISP TOKEN; IF ATOM, LEAVE ASCII IN SYLBUF, +;;; WITH AOBJN POINTER IN A, LENGTH IN CHARS IN B, +;;; AND A COPY OF N AS OF THE START OF THE SYMBOL IN C. +;;; CALLING SEQUENCE: +;;; PUSHJ P,1LTOKN +;;; JRST LPAR ;COME HERE FOR ( +;;; JRST RPAR ;COME HERE FOR ) +;;; JRST QUOTE ;COME HERE FOR ' +;;; HACKATOM ;COME HERE FOR ATOM +;;; DOTS ARE SIMPLY TREATED AS ALPHABETIC (MUMBLE). +;;; SAVES L AND R. + +1LTOKN: TRZ F,FRLET + MOVE CP,[440700,,SYLBUF] +1LTOK1: 1GETCH ;SCAN FOR A MEANINGFUL CHAR + XCT 1LTBL1(CH) + IDPB CH,CP ;BEGINNING OF ATOM, DEPOSIT IN SYLBUF + MOVE C,N +1LTOK2: 1GETCH ;NOW COMPLETE ATOM + XCT 1LTBL2(CH) + IDPB CH,CP + JRST 1LTOK2 + +1LTOKQ: AOS (P) ;' FOUND +1LTOKR: AOS (P) ;) FOUND + POPJ P, + +1LTSL1: 1GETCH ;SLASH FOUND + CAIN CH,^C + PUSHJ P,1MORE0 + TRO F,FRLET ;SLASHIFIED CHAR IS ALPHABETIC BY DEFINITION + CAIN CH,^M ;CR, LF AND FF MUST STILL UPDATE N IN THE USUAL FASHION. + JRST 1LBCR1 + CAIN CH,^J + JRST 1LBLF1 + CAIN CH,^L + JRST 1LBFF1 + CAIL CH,140 + SUBI CH,40 ;CONVERT TO UPPER CASE. + POPJ P, + +1LTOKC: 1GETCH ;COMMENT SEEN (;) + CAILE CH,^M ;SUPER-FAST SCAN UNTIL ^M + JRST 1LTOKC + CAIN CH,^C + PUSHJ P,1MORE0 + CAIN CH,^M + JRST 1LBCR + CAIE CH,^L + JRST 1LTOKC + JRST 1LBFF + +1LBCR: SOS (P) + SOS (P) +1LBCR1: TLNE F,FLSCR + POPJ P, + 1GETCH + XCT NSQOZP(CH) + JFCL + CAIN CH,^J + ADDI N,1 + DBP7 IP + MOVEI CH,^M + POPJ P, + +1LBLF: SOS (P) + SOS (P) +1LBLF1: TLNE F,FLSCR + ADDI N,1 + POPJ P, + +1LBFF: SOS (P) + SOS (P) +1LBFF1: SKIPE LNDFIL + PUSHJ P,CKLNM + TRO N,-1 ;FORM FEED (^L) THROWS BACK + AOJ N, ; TO TOP LEVEL LOOP FOR SAFETY'S SAKE +ITS,[ + HLRZ B,N + HRLI B,(SIXBIT/P1/) + .SUSET [.SWHO3,,B] +];ITS + MOVE B,CODTYP + CAIE B,CODLSP + POPJ P, ;IF NOT REALLY DOING LISP, DON'T THROW.....UGH + JRST 1LLOOP + +1LTOKB: DBP7 IP ;ATOM TERMINATED BY USEFUL CHAR LIKE ( +1LTOKA: SETZ H, ;ATOM FOUND, TERMINATOR USELESS + TDZA B,B +1LTOK4: IDPB B,CP + TLNE CP,760000 + AOJA H,1LTOK4 + MOVNI A,(CP) + HRLI A,SYLBUF-1(A) + HRRI A,SYLBUF + MOVEI B,(CP) ;TOO BAD WE CAN'T HAVE NEGATIVE RELOCATION + SUBI B,SYLBUF-1 + IMUL B,CHS%WD + SUBI B,(H) + POP P,H + JRST 3(H) + +1LVBAR: MOVEI D,LSYLBUF ;VERTICAL BAR SEEN + IMUL D,CHS%WD + MOVE C,N + TRO F,FRLET +1LVB1: 1GETCH + XCT 1LTBL3(CH) + SOSLE D ;PERFECTLY REASONABLE FOR + IDPB CH,CP ; VERTICAL BAR ATOMS TO BE LONG + JRST 1LVB1 ; ENOUGH TO OVERFLOW SYLBUF + +1LALT: TRO F,FRLET + MOVEI CH,"$ ;CONVERT ALTMODE TO $ + POPJ P, + +1LTLC: TRO F,FRLET ;HANDLE A LOWER CASE LETTER: CONVERT CASE + SUBI CH,40 ;AND SAY THAT A LETTER HAS BEEN SEEN. + POPJ P, + +;;; THESE CHARACTER TABLES ARE USED BY 1LTOKN FOR RAPID +;;; PARSING OF LISP TOKENS. 1LTBL1 IS USED TO FIND THE FIRST +;;; CHARACTER OF A TOKEN. 1LTBL2 IS USED WHEN AN ATOMIC +;;; SYMBOL HAS BEEN STARTED AND MORE CHARACTERS ARE BEING +;;; GOBBLED FOR IT. 1LTBL3 IS USED FOR ATOMIC SYMBOLS +;;; WRITTEN USING VERTICAL BARS. LOWER CASE IS CONVERTED TO UPPER, USUALLY. + +1LTBL1: +REPEAT 3, JRST 1LTOK1 ;^@-^B + PUSHJ P,1MORE ;^C +REPEAT 6, JRST 1LTOK1 ;^D-^I + PUSHJ P,1LBLF ;^J + JRST 1LTOK1 ;^K + PUSHJ P,1LBFF ;^L + PUSHJ P,1LBCR ;^M +REPEAT 15, JRST 1LTOK1 ;^N-^Z + PUSHJ P,1LALT ; +REPEAT 4, JRST 1LTOK1 ;^\-^_ + JRST 1LTOK1 ;SPACE +REPEAT 6, TRO F,FRLET ;! " # $ % & + JRST 1LTOKQ ;' + POPJ P, ;( + JRST 1LTOKR ;) + TRO F,FRLET ;* + JFCL ;+ + JRST 1LTOK1 ;, + JFCL ;- + JFCL ;. + PUSHJ P,1LTSL1 ;/ +REPEAT 12, JFCL ;0-9 + JFCL ;: + PUSHJ P,1LTOKC ;; +REPEAT 44, TRO F,FRLET ;< - _ + JRST 1LTOK1 ;` +REPEAT 33, PUSHJ P,1LTLC ;a - { + JRST 1LVBAR ;| +REPEAT 2, PUSHJ P,1LTLC ;} ~ + JRST 1LTOK1 ;RUBOUT + +IFN .-1LTBL1-200, .ERR WRONG LENGTH TABLE + + +1LTBL2: +REPEAT 3, JRST 1LTOK2 ;^@-^B + PUSHJ P,1MORE ;^C +REPEAT 5, JRST 1LTOK2 ;^D-^H + JRST 1LTOKA ;^I + PUSHJ P,1LBLF ;^J + JRST 1LTOK2 ;^K + JRST 1LTOKB ;^L + PUSHJ P,1LBCR ;^M +REPEAT 15, JRST 1LTOK2 ;^N-^Z + PUSHJ P,1LALT ; +REPEAT 4, JRST 1LTOK2 ;^\-^_ + JRST 1LTOKA ;SPACE +REPEAT 6, TRO F,FRLET ;! " # $ % & +REPEAT 3, JRST 1LTOKB ;' ( ) +REPEAT 2, TRO F,FRLET ;* + + JRST 1LTOKA ;, +REPEAT 2, TRO F,FRLET ;- . + PUSHJ P,1LTSL1 ;/ +REPEAT 12, JFCL ;0-9 + JFCL ;: + JRST 1LTOKB ;; +REPEAT 42, TRO F,FRLET ;< = > ? @ A-Z [ \ ] +REPEAT 2, JFCL ;^ _ + JRST 1lTOKB ;` +REPEAT 33, PUSHJ P,1LTLC ;a-z { + JRST 1LTOKB ;| +REPEAT 2, PUSHJ P,1LTLC ;} ~ + JRST 1LTOK2 ;RUBOUT + +IFN .-1LTBL2-200, .ERR WRONG LENGTH TABLE + +1LTBL3: +REPEAT 3, JRST 1LVB1 ;^@-^B + PUSHJ P,1MORE ;^C +REPEAT 6, JRST 1LVB1 ;^D-^I + PUSHJ P,1LBLF ;^J + JRST 1LVB1 ;^K + JRST 1LTOKB ;^L + PUSHJ P,1LBCR ;^M +REPEAT 15, JRST 1LVB1 ;^N-^Z + PUSHJ P,1LALT ; +REPEAT 4, JRST 1LVB1 ;^\-^_ + JFCL ;SPACE +REPEAT 16, JFCL ;! " # $ % & ' ( ) * + , - . + PUSHJ P,1LTSL1 ;/ +REPEAT 60, JFCL ;0-9 : ; < = > ? @ A-Z [ \ ] ^ _ +REPEAT 34, JFCL ;` a-z { DON'T CONVERT CASE INSIDE VBARS. + JRST 1LTOKA ;| +REPEAT 2, JFCL ;} ~ + JRST 1LVB1 ;RUBOUT + +IFN .-1LTBL3-200, .ERR WRONG LENGTH TABLE + +;;; DEFINE LISP SYMBOL. COME HERE WITH A, B, AND C SET UP +;;; AS 1LTOKN LEAVES THEM, I.E.: +;;; A AOBJN POINTER INTO SYLBUF +;;; B CHARACTER COUNT +;;; C N AS OF START OF SYMBOL +;;; DOES NOT SET UP THE S.TYPE FIELD OF THE DEFINITION; +;;; THIS IS FILLED IN LATER. L IS LEFT POINTING TO THE +;;; SYMBOL TABLE ENTRY. + +LDEFSYM: + CAMLE B,MAXSSZ + MOVEM B,MAXSSZ +LDEFS2: AOS NSYMSF ;LDEFS2 DOESN'T UPDATE MAXSSZ. + MOVE B,A ;USE IT FOR SYMBOLS "DEFINED" IN WAYS THAT DON'T + HRRI A,1(DP) ;SHOW IN THE SYMBOL TABLE (%SXSYM WILL BE SET). +LDEFS1: MOVE D,(B) + TLC D,400000 + TRZ D,1 + PUSH DP,D + AOBJN B,LDEFS1 + PUSH SP,A + MOVEI L,(SP) + HRLZ B,CFILE + PUSH SP,B + PUSH SP,C +; PUSH SP,[0] + PUSH SP,[%SREFD,,] ;FOR NOW, PREVENT CRETINOUS *'S + JRST (H) + + +;;; DEFINE LISP TYPE. COME HERE WITH A AND B SET UP AS +;;; 1LTOKN LEAVES THEM: +;;; A AOBJN POINTER INTO SYLBUF +;;; B CHARACTER COUNT +;;; LDEFTYP CREATES THE NECESSARY +;;; "AOBJN" POINTER TO THE CHARACTERS FOR THE TYPE IN THE +;;; DATA AREA. R IS LEFT POINTING TO THE TYPE; IT MAY THEN +;;; BE HRRM'D INTO THE S.TYPE FIELD OF A SYMBOL TABLE ENTRY. +;;; SAVES A, B, AND C, SINCE LDEFSYM MAY SUBSEQUENTLY +;;; BE USED ON THE SAME SYMBOL. + +LDEFTYP: + MOVEI D,2(DP) + HRLI D,400000 ;SET SIGN TO SAY THAT NO CREF LETTER FOLLOWS. + PUSH DP,D + MOVEI R,(DP) ;RETURN THE ADDRESS OF THIS NEW TYPE IN R. + PUSH P,A + PUSH P,B + MOVEI D,1 +LDEFT1: ANDCAM D,(A) + PUSH DP,(A) ;PUSH ALL THE WORDS OF THE SYMBOL. + AOBJN A,LDEFT1 + MOVE A,B + IDIVI A,5 + SKIPN B ;IF SYMBOL IS A MULTIPLE OF 5 CHARACTERS, + PUSH DP,[0] ;PUSH AN EXTRA ZERO WORD TO MAKE THE TYPE ASCIZ. + POP P,B + POP P,A + JRST (H) + +1LMAPC: MOVSI A,(@(H)) + HLLM A,(P) + PUSH P,[1LMAPQ] ;PROTECTION AGAINST POP1J (E.G. AT 1LSKIP) +1LMAP1: PUSHJ P,1LTOKN + JRST 1LMAPL ;( + JRST 1LMAPR ;) + SKIPA H,[1] ;' + MOVEI H,2 ;ATOM + PUSHJ P,@-1(P) +REPEAT 2, JRST 1LMAP1 ;IN CASE 1LFORM IS USED + +1LMAPL: SETZ H, + PUSHJ P,@-1(P) +REPEAT 2, JRST 1LMAP1 ;IN CASE 1LFORM IS USED + +1LMAPR: SUB P,[1,,1] +1LMAPQ: POP P,H + JRST 3(H) + +1LQUO4: PUSHJ P,1LQUOT ;SKIP OUT OF FOUR LEVELS OF ( +1LQUO3: PUSHJ P,1LQUOT ;SKIP OUT OF THREE LEVELS OF ( +1LQUO2: PUSHJ P,1LQUOT ;SKIP OUT OF TWO LEVELS OF ( +1LQUOT: MOVEI L,1 ;SKIP CRUFT UNTIL MATCHING ) SEEN +1LQT1: PUSHJ P,1LTOKN + AOJA L,1LQT1 + JRST 1LQT2 + JRST 1LQT1 + JRST 1LQT1 + +1LQT2: SOJG L,1LQT1 + POPJ P, + +1L2LUZ: PUSHJ P,1LFORM ;FINISH OFF THREE LEVELS OF LIST. + JFCL +1LLLUZ: PUSHJ P,1LFORM ;FINISH OFF TWO LEVELS OF LIST + JFCL +1LSUBR: PUSHJ P,1LMAPC ;FINISH OFF ONE LEVEL OF LIST, + 1LFORM ;( ; AS ARGUMENTS TO A SUBR + 1LSKIP ;' + CPOPJ ;ATOM + POPJ P, + +1LSKIP: PUSHJ P,1LTOKN ;SKIP AND IGNORE S-EXPRESSION + JRST 1LQUOT ;( + JRST POP1J ;) ??? + JRST 1LSKIP ;' + POPJ P, ;ATOM + +1LANY: PUSHJ P,1LTOKN ;ACCEPT ANY S-EXPRESSSION + PUSHJ P,1LARG ;( + JRST POP1J ;) ??? + JRST 1LSKIP ;' + POPJ P, ;ATOM + +1LARG: +REPEAT 2, AOS (P) + JRST 1LFORM + +1LDEFPROP: ;PROCESS DEFPROP + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) + JRST 1LSKIP ;' + JSP H,LDEFS2 ;ATOM + HRLM L,(P) + MOVSI H,%SXSYM ;DEFPROPS GO IN CREF ONLY, NOT IN SYMTAB. + IORM H,S.BITS(L) +1LDEF1: PUSHJ P,1LTOKN + PUSHJ P,1LFN ;( + POPJ P, ;) + JRST 1LDEF1 ;' + PUSHJ P,1LTOKN ;ATOM - WHO CARES + JRST 1LLLUZ ;( + POPJ P, ;) + JRST 1LQUOT ;' + JSP H,LDEFTYP ;ATOM + MOVSI L,T%NREF + IORM L,(R) ;MARK THIS DEFPROP DEFINITION AS NOT WORTH REFERENCING + HLRZ L,(P) + HRRM R,S.TYPE(L) + PUSHJ P,1LPROP + JRST 1LQUOT + +1LPUTPROP: +REPEAT 2, PUSHJ P,1LANY + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) ??? + JRST 1LPUT1 ;' + JRST 1LSUBR ;ATOM + +1LPUT1: PUSHJ P,1LTOKN + JRST 1LLLUZ ;( ??? + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + PUSHJ P,1LPROP ;ATOM + JRST 1LSUBR + +1LCOMMENT: + MOVE A,(P) + TLNN A,1 + JRST 1LQUOT ;COMMENT NOT AT TOP LEVEL IS LIKE QUOTE, + 1GETCH + DBP7 IP + CAIN CH,^M ;"(COMMENT" BY ITSELF ON A LINE IS COMMENTING OUT SOME CODE. + JRST 1LQUOT + MOVEI R,1 ; BUT AT TOP LEVEL IS A SUBTITLE + PUSHJ P,1SUBTL +1LCOM1: SOJL R,CPOPJ ;NOW MUST COUNT OUT PARENS + PUSHJ P,1LQUOT + JRST 1LCOM1 + +1LSETQ: MOVE A,(P) + TLNN A,1 ;IGNORE SETQ'S EXCEPT AT TOP LEVEL + JRST 1LSUBR + PUSHJ P,1LTOKN ;READ THE ATOM BEING SETQ'D + JRST 1LLLUZ ;( ;SCREW CASES - IT'S NOT AN ATOM!?! + POPJ P, ;) + JRST 1LSKIP ;' + MOVEI R,L%SETQ ;DEFINE THE ATOM AS A "SETQ". + JRST 1LDEFR + +1LDEFUN: ;PROCESS DEFUN + PUSHJ P,1LTOKN + JRST 1LDFN7 ;( ;MIGHT BE (DEFUN (FOO BAR)...) + POPJ P, ;) + JRST 1LQUOT ;' + HLRZ D,A + CAIE D,-1 + JRST 1LDFN0 + SETZ R, + MOVE D,(A) + CAMN D,[ASCII \EXPR\] + MOVEI R,L%EXPR + CAMN D,[ASCII \FEXPR\] + MOVEI R,L%FEXPR + CAMN D,[ASCII \MACRO\] + MOVEI R,L%MACRO + JUMPN R,1LDFN4 +1LDFN0: JSP H,LDEFSYM + PUSHJ P,1LTOKN + JRST 1LDFN3 ;( + POPJ P, ;) + JRST 1LQUOT ;' + HLRZ D,A + CAIE D,-1 + JRST 1LDFN1 + SETZ R, + MOVE D,(A) + CAMN D,[ASCII \EXPR\] + MOVEI R,L%EXPR + CAMN D,[ASCII \FEXPR\] + MOVEI R,L%FEXPR + CAMN D,[ASCII \MACRO\] + MOVEI R,L%MACRO + JUMPN R,1LDFN2 + CAME D,[ASCII \NIL\] + JRST 1LDFN1 + MOVEI R,L%EXPR ;NIL MEANS EXPR, NOT LEXPR + HRRM R,S.TYPE(L) + JRST 1LSUBR + +1LDFN1: MOVEI R,L%LEXPR + HRRM R,S.TYPE(L) +1LDFN6: MOVEI R,L%LVAR + PUSHJ P,1LLXV + JRST 1LSUBR + +1LDFN3: MOVEI R,L%EXPR + HRRM R,S.TYPE(L) +1LDFN5: MOVEI R,L%LVAR + PUSHJ P,1LLVL + JRST 1LSUBR + +;COME HERE AFTER SEEING (DEFUN ( IN CASE IT IS (DEFUN (FOO BAR) (ARGS) BODY) +1LDFN7: PUSHJ P,1LTOKN + JRST 1L2LUZ ;( ;(DEFUN (( + JRST 1LSUBR ;) ;(DEFUN () + JRST 1LLLUZ ;' ;(DEFUN (' + JSP H,LDEFSYM ;IT WAS (DEFUN (FOO, SO DEFINE THE FOO AS A SYMBOL. + PUSHJ P,1LTOKN ;NOW, IT SHOULD GO ON AS "(DEFUN (FOO BAR", SO TRY READING BAR. + JRST 1L2LUZ ;( ;(DEFUN (FOO ( + JRST 1LSUBR ;) ;(DEFUN (FOO) + JRST 1LLLUZ ;' ;(DEFUN (FOO ' + PUSH P,L + JSP H,LDEFTYP ;WE READ THE BAR IN "(DEFUN (FOO BAR", SO CREATE A TYPE NAMED BAR + POP P,L + HRRM R,S.TYPE(L) ;AND GIVE THE DEFINITION OF FOO THE TYPE BAR. + PUSHJ P,1LPROP ;NOW DEFINE BAR ITSELF AS A SYMBOL OF TYPE "PROPERTY". +1LDFN9: PUSHJ P,1LTOKN ;NOW SKIP ANY ATOMS FOLLOWING BAR IN THE LIST. + JRST 1L2LUZ ;( ;(DEFUN (FOO BAR BLETCH ( ?? + JRST 1LDFN8 ;) ;AFTER "(DEFUN (FOO BAR BLETCH)" COMES A NORMAL ARGLIST & BODY. + JRST 1LLLUZ ;' ;(DEFUN (FOO BAR ' ?? + JRST 1LDFN9 + +1LDFN8: PUSHJ P,1LTOKN ;START PARSING THE ARGLIST. + JRST 1LDFN5 ;( ;(DEFUN (FOO BAR (, NOW COME LAMBDA VARS. + POPJ P, ;) ;(DEFUN (FOO BAR)) + JRST 1LQUOT + JRST 1LDFN6 ;ATOM => IT IS LEXPR-TYPE FUNCTION, WITH ONE LAMBDA VAR. + +1LMDEF: MOVEI R,L%MACRO ;PROCESS MACRODEF +1LDFN4: PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) + JRST 1LQUOT ;' + JSP H,LDEFSYM +1LDFN2: HRRM R,S.TYPE(L) + PUSHJ P,1LTOKN + JRST 1LDFN5 ;( + POPJ P, ;) + JRST 1LQUOT ;' + CAIN R,L%MACRO ;NEVER LET MACRODEF MARK AS LEXPR + JRST 1LDFN6 + JRST 1LDFN1 + +1LPVRS: SKIPA R,[L%PVAR] ;PARSE PROG VARS +1LLVRS: MOVEI R,L%LVAR ;PARSE LAMBDA VARS + PUSHJ P,1LTOKN + JRST 1LLVL ;( + JRST POP1J ;) + JRST 1LSKIP ;' + MOVE D,(A) + CAMN D,[SIXBIT \NIL\] + POPJ P, ;NIL MEANS EXPR, NOT LEXPR +1LLXV: TLNN F,FLCREF ;LEXPR LAMBDA - ATOM SEEN + POPJ P, + JSP H,LDEFS2 +1LCRFS: MOVSI D,%SXSYM ;SET THE TYPE IN A SYMBOL DEFN, AND MARK TO APPEAR + IORM D,S.BITS(L) ;ONLY IN THE CREF, NOT IN THE SYMTAB. + HRRM R,S.TYPE(L) ;DON'T UPDATE MAXTSZ, SINCE THAT IS ONLY FOR SYMTAB. + POPJ P, + +1LLVL: PUSHJ P,1LMAPC ;LAMBDA VARS LIST + 1LQUOT ;( + 1LSKIP ;' + 1LLXV ;ATOM + POPJ P, + +1LADEF: PUSHJ P,1LTOKN ;PROCESS @DEFINE + JRST 1LLLUZ ;( ??? + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + JSP H,LDEFTYP + JSP H,LDEFSYM + MOVEI A,(R) + MOVEI R,L%ADEF + PUSHJ P,1LTYPE ;DEFINE NEXT ATOM TO BE A "@DEFINE" + MOVEI L,(A) + MOVEI R,(A) + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( ??? + JRST 1LADF1 ;) + JRST 1LQUOT ;' ??? + JSP H,LDEFTYP +1LADF1: PUSH DP,ADEFLS ;ADD ENTRY TO @DEFINE LIST + HRRZM DP,ADEFLS + HRLI R,(L) + PUSH DP,R + CAML B,MAXTSZ ;UPDATE WIDTH OF WIDEST SYMBOL TABLE TYPE NAME. + MOVEM B,MAXTSZ ;B HAS THE NUMBER OF CHARS OF THE LAST TOKEN READ. + JRST 1LSUBR + +1LLAMBDA: + MOVE A,(P) + TLNN A,2 + JRST 1LQUOT + PUSHJ P,1LLVRS + JRST 1LSUBR + +1LLABEL: + MOVE A,(P) + TLNN A,2 + JRST 1LQUOT + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) + JRST 1LQUOT ;' + JSP H,LDEFSYM ;ATOM + MOVEI R,L%LABEL + HRRM R,S.TYPE(L) + PUSHJ P,1LTOKN + PUSHJ P,1LFN ;( + POPJ P, ;) + JRST 1LQUOT ;' + JRST 1LSUBR ;ATOM + +1LARRAY: + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + MOVEI R,L%ARRAY ;ATOM +1LDEFR: JSP H,LDEFSYM ;DEFINE SYMBOL AS TYPE IN R. + HRRM R,S.TYPE(L) + JRST 1LSUBR + +1L$ARRAY: + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( + POPJ P, ;) ??? + JRST 1LARRAY ;' + JRST 1LSUBR ;ATOM + +1LCATCH: + PUSHJ P,1LANY + PUSHJ P,1LTOKN + JRST 1LLLUZ ;( ??? + POPJ P, ;) + JRST 1LLLUZ ;' ??? + JSP H,LDEFSYM ;ATOM + MOVEI R,L%CTAG + PUSHJ P,1LTYPE + JRST 1LQUOT + +1LTYPE: HRRM R,S.TYPE(L) ;SET A TYPE, AND ALSO HACK MAXTSZ + HLRZ B,(R) + CAMLE B,MAXTSZ + MOVEM B,MAXTSZ + POPJ P, + +1LPROP: HLRZ D,A + CAIE D,-1 + JRST 1LPRO1 + MOVE D,(A) ;MAYBE MAKE A PROPERTY BE A SYMBOL + CAME D,[ASCII \EXPR\] + CAMN D,[ASCII \FEXPR\] + POPJ P, + CAMN D,[ASCII \MACRO\] + POPJ P, +1LPRO1: JSP H,LDEFS2 ;DEFINE IT WITH TYPE "PROPERTY", FOR THE CREF ONLY. + MOVEI R,L%PROP + JRST 1LCRFS + +1LMAP: ;MAPPING FUNCTIONS +1LAPPLY: ;APPLY + PUSHJ P,1LFNARG + JRST 1LSUBR + +1LFNARG: ;PROCESS FUNCTIONAL ARG (E.G. FOR MAPCAR) + PUSHJ P,1LTOKN + PUSHJ P,1LFN ;( + JRST POP1J ;) + JRST 1LFNARG ;' + POPJ P, ;ATOM + +1LFN: +REPEAT 2, AOS (P) + JRST 1LNAF + +1LFUNCTION: ;FUNCTION + PUSHJ P,1LFNARG + JRST 1LQUOT + +1LSORT: PUSHJ P,1LANY ;SORT AND SORTCAR + PUSHJ P,1LFNARG + JRST 1LSUBR + +1LCOND: PUSHJ P,1LMAPC ;COND + 1LSUBR ;( + CPOPJ ;' ??? + CPOPJ ;ATOM ??? + POPJ P, + +1LPROG: PUSHJ P,1LPVRS ;PROG +1LPRG1: PUSHJ P,1LMAPC + 1LSUBR ;( + 1LQUOT ;' ??? + 1LPTAG ;ATOM + POPJ P, + +1LPTAG: TLNN F,FLCREF ;PROG TAG FOUND + POPJ P, + JSP H,LDEFS2 + MOVEI R,L%PTAG + JRST 1LCRFS + +1LDO: PUSHJ P,1LTOKN ;DO + JRST 1LDO1 ;( + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + MOVE D,(A) + CAMN D,[ASCII \NIL\] + JRST 1LDO2 + TLNN F,FLCREF ;OLD-STYLE DO FOUND + JRST 1LDO4 + JSP H,LDEFS2 ;ENTER DO VAR IN SYMBOL TABLE + MOVEI R,L%DVAR + PUSHJ P,1LCRFS +1LDO4: +REPEAT 3, PUSHJ P,1LANY ;PROCESS INITIAL VALUE, STEPPER, COND + JRST 1LPRG1 ;TREAT REST AS PROG BODY + +1LDO1: PUSHJ P,1LMAPC ;NEW-STYLE DO VARS LIST FOUND + 1LDO3 ;( + CPOPJ ;' ??? + CPOPJ ;ATOM ??? +1LDO2: PUSHJ P,1LTOKN ;NOW GOBBLE UP COND CLAUSE + JRST 1LDO5 ;( + POPJ P, ;) ??? + JRST 1LPRG1 ;' ??? + JRST 1LPRG1 ;ATOM ;FINISH BY DOING PROG BODY + +1LDO5: PUSHJ P,1LSUBR + JRST 1LPRG1 + +1LDO3: PUSHJ P,1LTOKN ;GOBBLE UP ONE NEW-STYLE VAR SPEC + JRST 1LLLUZ ;( ??? + POPJ P, ;) ??? + JRST 1LDO3 ;' ??? + TLNN F,FLCREF ;ATOM + JRST 1LSUBR + JSP H,LDEFS2 + MOVEI R,L%DVAR + PUSHJ P,1LCRFS + JRST 1LSUBR + +1LINCLUDE: +REPEAT 4, SETZM INSSNM+.RPCNT + PUSHJ P,1LTOKN + JRST 1LINL1 ;( + POPJ P, ;) ??? + JRST 1LQUOT ;' ??? + MOVE D,[440700,,SYLBUF] ;ATOMIC ARG - CHAR COUNT IN B + ADDI B,1 +1LINA1: SETZ C, + MOVE A,[440600,,C] +1LINA2: MOVEI CH,40 + SOSE B ;GET NEXT CHAR, OR SIXBIT SPACE IF NO MORE CHARS + ILDB CH,D + CAIL CH,140 + SUBI CH,40 + SUBI CH,40 + CAIN CH,': + JRST [ MOVEM C,INSDEV ? JRST 1LINA9 ] + CAIN CH,'; + JRST [ MOVEM C,INSSNM ? JRST 1LINA9 ] + JUMPE CH,1LINA8 + TLNE A,760000 + IDPB CH,A + JRST 1LINA2 + +1LINA8: SKIPE INSFN1 + JRST [ SKIPE INSFN2 + JRST [ SKIPE INSDEV + JRST [ SKIPN INSSNM + MOVEM C,INSSNM + JRST 1LINA9 ] + MOVEM C,INSDEV + JRST 1LINA9 ] + MOVEM C,INSFN2 + JRST 1LINA9 ] + MOVEM C,INSFN1 +1LINA9: JUMPG B,1LINA1 + JRST 1LINL9 + +1LINL1: PUSHJ P,1LTOKN + JRST 1LINL2 ;( DEVICE/SNAME LIST + JRST 1LQUOT ;) ??? + JRST 1LQUO2 ;' ??? + PUSHJ P,1LINSX ;ATOM - UREAD-STYLE LIST. CONVERT TO SIXBIT IN A. + CAME A,[SIXBIT \*\] + MOVEM A,INSFN1 +IRP FOO,,[INSFN2,INSDEV,INSSNM] + PUSHJ P,1LTOKN + JRST 1LQUO3 ;( ??? + JRST 1LINL9 ;) END OF UREAD SPEC + JRST 1LQUO2 ;' ??? + PUSHJ P,1LINSX + CAME A,[SIXBIT \*\] + MOVEM A,FOO +TERMIN +1LINL9: PUSHJ P,1INSDF + JRST 1LQUOT + +1LINL2: PUSHJ P,1LTOKN ;NEW-STYLE NAMELIST + JRST 1LQUO4 ;( ??? + JRST 1LQUO2 ;) ??? + JRST 1LQUO3 ;' ??? + PUSHJ P,1LINSX + MOVE L,A + PUSHJ P,1LTOKN + JRST 1LQUO4 ;( ??? + JRST 1LINL3 ;) + JRST 1LQUO3 ;' ??? + CAME L,[SIXBIT \*\] + MOVEM L,INSDEV + PUSHJ P,1LINSX + CAME A,[SIXBIT \*\] + MOVEM A,INSSNM +1LINL6: PUSHJ P,1LTOKN + JRST 1LQUO4 ;( ??? + JRST 1LINL5 ;) END OF DIRECTORY; FILENAMES FOLLOW. + JRST 1LQUO3 ;' ??? + JRST 1LINL6 ;ATOM => IGNORE EXCESS NAMES IN DIRECTORY. + +1LINL3: CAMN L,[SIXBIT \*\] + JRST 1LINL5 +IRP FOO,,[DSK,AI,ML,DM] + CAMN L,[SIXBIT \FOO\] + JRST 1LINL4 +TERMIN + MOVEM L,INSSNM + JRST 1LINL5 + +1LINL4: MOVEM L,INSDEV +1LINL5: +IRP FOO,,[INSFN1,INSFN2] + PUSHJ P,1LTOKN ;GOBBLE FILE NAMES + JRST 1LQUO3 ;( ??? + JRST 1LINL9 ;) END OF NAMELIST + JRST 1LQUO2 ;' ??? + PUSHJ P,1LINSX + CAME A,[SIXBIT \*\] + MOVEM A,FOO +TERMIN + PUSHJ P,1LQUOT ;IGNORE REST OF SPEC + JRST 1LINL9 + +;CONVERT THE ASCII IN SYLBUF TO SIXBIT IN A. +1LINSX: SETZ A, + MOVE D,[440700,,SYLBUF] + MOVE C,[440600,,A] +1LINS1: JUMPE B,CPOPJ + ILDB CH,D + CAIL CH,140 + SUBI CH,40 + SUBI CH,40 + TLNE C,760000 + IDPB CH,C + SOJA B,1LINS1 + +SUBTTL PASS 1 PROCESSING FOR UCONS CODE + +1UCONS: MOVSI N,1 + MOVEI A,5 + MOVEM A,CHS%WD + CAMLE A,MAXSSZ + MOVEM A,MAXSSZ + CAMLE A,MAXTSZ + MOVEM A,MAXTSZ +1UCO00: PUSHJ P,1LTOKN ;FIRST SKIP TWO PARENTHESES + JRST 1UCO10 ;( + JRST 1UCO01 ;) + JRST 1UCO00 ;' + JRST 1UCO00 ;ATOM + +1UCO01: JRST 1UCO00 ;FILE IS OBVIOUSLY IN BAD FORMAT, BUT GRIN AND BEAR IT. + +;FIND THE "(SETQ UCONS '(" AFTER WHICH COMES THE CODE. GO TO 1UCOML THEN. +;SKIP OVER FORMS THAT DON'T LOOK LIKE THAT. +1UCO10: PUSHJ P,1LTOKN + JRST 1UCO11 ;( + JRST 1UCO01 ;) + JRST 1UCO12 ;' + MOVE L,(A) ;ATOM. IS IT SETQ? + CAME L,[ASCII /SETQ/] + JRST 1UCO12 ;NO => THIS FORM IS RANDOM. IGNORE IT. + PUSHJ P,1LTOKN + JRST 1UCO11 ;( + JRST 1UCO01 ;) + JRST 1UCO12 ;' + PUSHJ P,1LTOKN + JRST 1UCO11 ;( + JRST 1UCO01 ;) + CAIA ;' IS GOOD. WE ONLY PROCESS SETQS WHOSE ARGS ARE QUOTED. + JRST 1UCO12 + PUSHJ P,1LTOKN + JRST 1UCOML ;( ENTER THE LIST WHICH IS QUOTED, AND PROCESS IT AS CODE. + JRST 1UCO01 ;) + JRST 1UCO12 ;' OR ATOM AT THIS POINT IS GARBAGE. + JRST 1UCO12 + +1UCO11: PUSHJ P,1LQUOT ;SKIP OUT 2 LEVELS OF PARENS. +1UCO12: PUSHJ P,1LQUOT ;SKIP OUT ONE LEVEL OF PARENS. + JRST 1UCO00 + +;MAIN LOOP. ATOMS SEEN AT THE TOP LEVEL ARE TAGS AND GET PUT IN THE +;SYMBOL TABLE. A FEW PSEUDO-OPS THAT DEFINE SYMBOLS ARE ALSO RECOGNIZED. + +1UCOML: PUSHJ P,1LTOKN + JRST 1UCOL1 ;( + JRST 1UCO12 ;) + JRST 1UCOML ;' + JSP H,LDEFSYM ;ATOM + MOVE R,1UCOLC ;TYPE=LOCALITY + PUSHJ P,1LTYPE + JRST 1UCOML + +;LEVEL 1 LIST + +1UCOL1: PUSHJ P,1LTOKN + JRST 1UCOL2 ;( + JRST 1UCOML ;) + JRST 1UCOL1 ;' + MOVE L,(A) ;ATOM, SEE IF KNOWN PSEUDO-OP + CAMN L,[ASCII/LOCAL/] + JRST 1UCO50 + CAMN L,[ASCII/DEF-D/] + JRST 1UCO61 + CAMN L,[ASCII/ASSIG/] + JRST 1UCO62 + CAMN L,[ASCII/DEF-N/] + JRST 1UCO63 + CAMN L,[ASCII/DEF-B/] + JRST 1UCO64 + CAMN L,[ASCII/MISC-/] + JRST 1UCO81 + CAMN L,[ASCII/MICRO/] + JRST 1UCO82 +1UCOSK: PUSHJ P,1LQUOT ;SKIP TO END OF LEVEL 1 LIST + JRST 1UCOML + +;LEVEL 2 LIST + +1UCOL2: PUSHJ P,1LQUO2 ;SKIP UNTIL MATCHING )) + JRST 1UCOML ;AND RETURN TO MAIN LOOP + +;VARIOUS KEYWORDS + +1UCO50: MOVE C,1(A) ;LOCALITY + CAIN B,8 + CAME C,[ASCII/ITY/] + JRST 1UCOSK + PUSHJ P,1LTOKN + JRST 1UCOL2 ;( + JRST 1UCOML ;) + JRST 1UCOSK ;' + JSP H,LDEFTYP + MOVEM R,1UCOLC + JRST 1UCOSK + +1UCO61: MOVE C,[ASCII/ATA-F/] + MOVE D,[ASCII/IELD/] + JRST 1UCO69 + +1UCO62: MOVE C,1(A) + CAMN C,[ASCII /N/] + JRST 1UCO70 + MOVE C,[ASCII/N-EVA/] + MOVE D,[ASCII /L/] + JRST 1UCO69 + +1UCO63: MOVE C,1(A) + CAMN C,[ASCII /EXT-B/] + MOVE D,[ASCII /IT/] + CAMN C,[ASCII /EXT-F/] + MOVE D,[ASCII /IELD/] + JRST 1UCO69 + +1UCO64: MOVE C,[ASCII/N-REG/] + CAIN B,20. + CAME C,3(A) + JRST 1UCOSK + MOVE C,[ASCII/IT-FI/] + MOVE D,[ASCII/ELD-I/] + JRST 1UCO68 + +1UCO81: MOVE C,[ASCII/INST-/] + MOVE D,[ASCII/ENTRY/] + JRST 1UCO69 + +1UCO82: MOVE C,[ASCII/-CODE/] + MOVE D,[SIXBIT/-ENTR/] + HLRZ L,A + CAIE L,-4 + JRST 1UCOSK + JRST 1UCO68 + +1UCO69: HLRZ L,A + CAIE L,-3 + JRST 1UCOSK +1UCO68: CAMN C,1(A) + CAME D,2(A) + JRST 1UCOSK +1UCO70: JSP H,LDEFTYP ;DEFINING PSEUDO-OP IS TYPE +1UCO71: PUSHJ P,1LTOKN ;NEXT TOKEN IS NAME OF SYMBOL TO DEFINE + JRST 1UCOL2 ;( + JRST 1UCOML ;) + JRST 1UCO71 ;' + JSP H,LDEFSYM + PUSHJ P,1LTYPE + JRST 1UCOSK + +] ;END IFN LISPSW, + +SUBTTL PASS 1 AND PASS 2 PROCESSING FOR MUDDLE CODE + +IFN MUDLSW,.INSRT @MUDDLE + +SUBTTL SYMBOL NAME COMPARISON ROUTINES + +;;; THESE TWO ROUTINES COMPARE A SYMBOL TABLE ENTRY IN +;;; ACCUMULATORS [CP, CH, CC, IP] WITH A SYMBOL TABLE ENTRY +;;; POINTED TO BY ACCUMULATOR A. COMP COMPARES SINGLE-WORD +;;; NAMES, WHILE NCOMP COMPARES NAMES OF ARBITRARY LENGTH. +;;; IF THE NAMES MATCH, THEN THE (FILE, TYPE) PAIRS OF +;;; THE ENTRIES ARE COMPARED; IF THESE MATCH, THE +;;; (PAGE #, LINE # -1) PAIRS, IN AN ATTEMPT TO ORDER THEM. +;;; EACH ROUTINE SKIPS 0 IF [CP, CH, CC, IP] IS LESS THAN +;;; THE ONE POINTED TO BY A; SKIPS 1 IF EQUAL; +;;; SKIPS 2 IF GREATER. USED BY THE SORT ROUTINE (Q.V.) +;;; CORRECT COMPARISON OF CHARACTER DATA OF COURSE REQUIRES +;;; THAT THE WORDS OF DATA HAVE INVERTED SIGN BITS. +;;; PRESERVES A, CP, CH, CC, IP. CLOBBERS B, C, D, H. + +COMP: CAMGE CP,(A) ;COMPARE NAMES + JRST (H) + CAME CP,(A) + JRST 2(H) +COMP7: MOVS B,CH + MOVS C,1(A) + CAMGE B,C ;COMPARE (TYPE, FILE). + JRST (H) + CAME B,C + JRST 2(H) + CAMGE CC,2(A) ;COMPARE (PAGE #, LINE # -1) + JRST (H) ;IN REVERSE ORDER, SO THAT DEFS LATER IN THE FILE + CAME CC,2(A) ;COME FIRST AND ARE MORE LIKELY TO BE USED IN X-REFS. + JRST 2(H) + JRST 1(H) + +NCOMP: MOVE B,(A) ;GET AOBJN POINTERS FOR NAMES + MOVE C,CP +NCOMP1: MOVE D,(C) ;COMPARE ONE WORD + CAMGE D,(B) ; FROM EACH NAME + JRST (H) + CAME D,(B) + JRST 2(H) + AOBJP C,NCOMP2 + AOBJN B,NCOMP1 + JRST 2(H) + +NCOMP2: AOBJN B,(H) + JRST COMP7 + +SUBTTL SORT SYMBOL TABLE + +1END: MOVEI A,-3(SP) ;SET UP SYMHI AND SYMAOB + MOVEM A,SYMHI + SUB A,SYMLO + ASH A,-2 + HRLOI A,(A) + EQV A,SYMLO + MOVEM A,SYMAOB + DROPTHRUTO SORT ;NOW SORT THE SYMBOL TABLE + +;;; HAIRY QUICKSORT (SEE KNUTH VOLUME 3) + +SORTM==:10 + +SORT: MOVEI A,COMP + TLNE F,FLARB + MOVEI A,NCOMP + MOVEM A,COMPAR + PUSH P,[-1] + PUSH P,SYMHI + PUSH P,SYMLO +SORT2: MOVE L,(P) + MOVE R,-1(P) + CAIGE R,SORTM(L) + JRST SORT8 + MOVEI A,(L) + ADDI A,(R) + LSH A,-1 + TRZ A,3 + HRLI B,(A) + HRRI B,CP + BLT B,CP+3 + HRLI B,(L) + HRRI B,(A) + BLT B,3(A) + JRST SORT3A + +SORT3: SUBI R,4 +SORT3A: CAMGE R,(P) + JRST SORT4 + MOVEI A,(R) + JSP H,@COMPAR + JRST SORT3 + JRST SORT3 +SORT4: CAIGE L,(R) + JRST SORT4A + HRLI A,CP + HRRI A,(L) + BLT A,3(L) + JRST SORT7 + +SORT4A: HRLI A,(R) + HRRI A,(L) + BLT A,3(L) +SORT5: ADDI L,4 + CAML L,-1(P) + JRST SORT6 + MOVEI A,(L) + JSP H,@COMPAR + JRST SORT6 + JRST SORT6 + JRST SORT5 + +SORT6: CAIL L,(R) + JRST SORT6A + HRLI A,(L) + HRRI A,(R) + BLT A,3(R) + JRST SORT3 + +SORT6A: HRLI A,CP + HRRI A,(R) + BLT A,3(R) + MOVEI L,(R) +SORT7: CAMN L,(P) + JRST SORT7B + CAMN R,-1(P) + JRST SORT7C + PUSH P,-1(P) ;COPY CURRENT (L, R) PAIR + PUSH P,-1(P) ; ON THE STACK FOR LATER + MOVEI A,(L) + LSH A,1 + SUB A,(P) + MOVEI B,-4(L) + MOVEI C,4(L) + CAMLE A,-1(P) + JRST SORT7A + MOVEM C,-2(P) + MOVEM B,-1(P) + JRST SORT2 + +SORT7A: MOVEM B,-3(P) + MOVEM C,(P) + JRST SORT2 + +SORT7B: MOVEI A,4 + ADDM A,(P) + JRST SORT2 + +SORT7C: MOVNI A,4 + ADDM A,-1(P) + JRST SORT2 + +SORT8: CAIG R,(L) + JRST SORT9 + MOVEI R,4(L) +SORT8A: HRLI A,(R) + HRRI A,CP + BLT A,CP+3 + MOVEI L,-4(R) + JRST SORT8C + +SORT8B: HRLI A,(L) + HRRI A,4(L) + BLT A,7(L) + SUBI L,4 + CAMGE L,(P) + JRST SORT8D +SORT8C: MOVEI A,(L) + JSP H,@COMPAR + JRST SORT8B + JFCL +SORT8D: HRLI A,CP + HRRI A,4(L) + BLT A,7(L) + ADDI R,4 + CAMG R,-1(P) + JRST SORT8A +SORT9: SUB P,[2,,2] + SKIPL (P) + JRST SORT2 +POP1J: SUB P,[1,,1] + POPJ P, + +SUBTTL FIND DUPLICATE DEFINITIONS, AND SORT SUBTITLES + +;;; SCAN OVER THE SYMBOL TABLE, AND FOR EACH ENTRY SET +;;; THE %SDUPL BIT IFF THE ENTRY HAS THE SAME NAME AS +;;; THE ONE PRECEDING IT. THIS IS IMPORTANT TO LOOK/NLOOK +;;; AND TO CRFOUT. + +DUPL: SKIPL B,SYMAOB + POPJ P, + MOVSI R,%SDUPL + TLNE F,FLARB + JRST DUPL4 + JRST DUPL1A + +DUPL1: CAME A,S.NAME(B) +DUPL1A: SKIPA A,S.NAME(B) + IORM R,S.BITS(B) + ADDI B,LSENT-1 + AOBJN B,DUPL1 + POPJ P, + +DUPL2: MOVE C,-LSENT+S.NAME(B) + MOVE D,S.NAME(B) +DUPL3: MOVE A,(C) + CAME A,(D) + JRST DUPL4 + AOBJP C,DUPL6 + AOBJN D,DUPL3 +DUPL4: ADDI B,LSENT-1 + AOBJN B,DUPL2 + POPJ P, + +DUPL6: AOBJN D,DUPL4 + IORM R,S.BITS(B) + JRST DUPL4 + + +;;; GET THE SUBTITLES LIST INTO CORRECT ORDER, AND SET UP SUBLEN. + +SBSORT: SKIPN L,SUBTLS + POPJ P, + SETZ R, ;R WILL GET NEG OF MAX CHARS + NREVERSE L,A,C,0,[ HLRE D,(X) ? CAMGE D,R ? MOVEM D,R ] + MOVEM L,SUBTLS ;SAVE BACK NEW ADDRESS OF START OF LIST. + MOVNM R,SUBLEN ;SUBLEN GETS LENGTH OF LONGEST SUBTITLE. + POPJ P, + +SUBTTL SYMBOL TABLE LOOKUP ROUTINES + +;;; LOOKUP ROUTINES FOR DOING A BINARY SEARCH IN THE +;;; SYMBOL TABLE. STANDARD CALLING SEQUENCE: +;;; JSP H,@LOOKIT ;CONTAINS LOOK OR NLOOK +;;; +;;; +;;; USES A, B, C, D, L, R, CP. IF THE RETURN SKIPS, THE CORRECT +;;; ADDRESS OF THE SYMBOL TABLE ENTRY WILL BE IN A. LOOK AND +;;; NLOOK WILL RETURN THE ADDRESS OF THE FIRST ENTRY OF SEVERAL +;;; WITH THE SAME NAME. + +LOOK: MOVE CP,SYLBUF + TLC CP,400000 + MOVE L,SYMLO + SKIPA R,SYMHI +LOOK1: MOVEI L,4(A) +LOOK2: CAIGE R,(L) + JRST (H) + MOVEI A,(L) + ADDI A,(R) + LSH A,-1 + TRZ A,3 + CAMLE CP,(A) + JRST LOOK1 + CAMN CP,(A) + JRST NLOOK8 + MOVEI R,-4(A) + JRST LOOK2 + +NLOOK: TDZA B,B +NLOOK0: IDPB B,CP + TLNE CP,760000 + JRST NLOOK0 + MOVEI A,SYLBUF-1 + SUBI A,(CP) + HRLI CP,(A) + HRRI CP,SYLBUF + MOVE A,CP + MOVSI B,400000 + XORM B,(A) + AOBJN A,.-1 + MOVE L,SYMLO + SKIPA R,SYMHI +NLOOK1: MOVEI L,4(A) +NLOOK2: CAIGE R,(L) + JRST (H) + MOVEI A,(L) + ADDI A,(R) + LSH A,-1 + TRZ A,3 + MOVE B,CP + MOVE C,(A) +NLOOK3: MOVE D,(B) + CAMLE D,(C) + JRST NLOOK1 + CAMN D,(C) + JRST NLOOK5 +NLOOK4: MOVEI R,-4(A) + JRST NLOOK2 + +NLOOK5: AOBJP B,NLOOK6 + AOBJN C,NLOOK3 + JRST NLOOK1 + +NLOOK6: AOBJN C,NLOOK4 +NLOOK8: SKIPL S.BITS(A) .SEE %SDUPL + JRST 1(H) + SUBI A,LSENT + JRST NLOOK8 + +SUBTTL PASS 2 READ INPUT FILE CHARACTER, WHEN NOT LISTING + +;RETURNS CHAR IN CH. CLOBBERS ONLY A, UNLESS WE RETURN A ^L. +;THE CALLER SHOULD NOT ATTEMPT TO PARSE ANYTHING AS SPANNING A ^L, ANYWAY. +;UPDATES SEVERAL ACS. + +XSLURP: ILDB CH,IP +XSLUR1: CAIN CH,^C + JRST XSLCC + CAIG CH,^M + SKIPE TXTIGN + JRST (H) + CAIN CH,^M ;DO WE HAVE A CR, AND ARE WE COUNTING LINES BY CRLF'S? + TLNE F,FLSCR + JRST XSLCR2 +XSLCR3: MOVE A,IP ;YES; LOOK AHEAD TO SEE IF WE HAVE A CRLF. + ILDB A,A + CAIN A,^J + JRST SLCR3 + CAIE A,^C + JRST (H) + MOVE A,IP + IBP A + ANDI A,-1 + CAME A,LASTIP + JRST (H) + PUSHJ P,DOINPT + JRST (H) + JRST XSLCR3 + +XSLCR2: CAIN CH,^L + JRST FFOUT1 + CAIE CH,^J + JRST (H) + PUSHJ P,CKLNM2 + TRZN F,FRLCR + TLNE F,FLSCR + AOJA N,(H) + JRST (H) + +XSLCC: MOVEI A,(IP) + CAME A,LASTIP + JRST (H) + PUSHJ P,DOINPT + JRST 2DONE + JRST XSLURP + +SUBTTL PASS 2 READ INPUT FILE CHARACTER, LIST IT AND RETURN IT + +;RETURNS CHAR IN CH. CLOBBERS ONLY A, UNLESS WE RETURN A ^L. +;THE CALLER SHOULD NOT ATTEMPT TO PARSE ANYTHING AS SPANNING A ^L, ANYWAY. +;UPDATES SEVERAL ACS. + +SLURP: ILDB CH,IP + XCT SLTBL(CH) +SLURP1: 2PUTCH + AOJA CC,(H) + +SLCC3: +NOCMUXGP,JUMPE CH,SLRUB ;CMU XGP can't handle quoted NULLs +SLCTL: TLNE F,FLCTL + JRST SLURP1 +SLCTL1: MOVEI A,100(CH) + 2PUTCH "^ + MOVEI CH,(A) + AOJ CC, + 2PUTCH + SUBI CH,100 + AOJA CC,(H) + +SLBS: TLNE F,FLBS ;FLBS => ^H OVERPRINTS. OTHERWISE, IT IS LIKE RANDOM CONTROLS. + JUMPG CC,[SOJA CC,[SOJA CC,SLURP1]] +;OUTPUT A FORMATTING CONTROL AS UPARROW-MUMBLE, UNLESS ON XGP WITH FLCTL SET, +;IN WHICH CASE XGP-QUOTE IT. +SLFMTC: TLNE F,FLXGP +SLRUB: TLNN F,FLCTL ;RUBOUT: LIKE MOST CONTROL CHARS + JRST SLCTL1 + TLNN F,FLXGP ;BUT NEEDS QUOTING ON THE XGP. + JRST SLURP1 + MOVEI A,(CH) ;OUTPUT CHAR IN CH, PRECEDED BY A RUBOUT TO XGP-QUOTE IT. + XCT 2PUTNX + XCT 2PUTTC + CAIA + JRST (H) + 2PATCH 177 +CMUXGP, 2PATCH 34 + MOVEI CH,(A) + JRST SLURP1 + +; SLASH +SLSLSH: TRZE F,FRLTAB ; PRECEDED BY TAB OR SPACE? + CAME CH,COMC ; YES, SLASH THE COMMENT CHARACTER? + JRST SLURP1 ; NO, NOT SPECIAL + JRST SLSE1 + +; SEMICOLON +SLSEMI: TRZE F,FRLTAB ; PRECEDED BY TAB OR SPACE? + CAME CH,COMC ; YES, SEMICOLON THE COMMENT CHARACTER? + JRST SLURP1 ; NO, NOT SPECIAL + SKIPE MDLFLG ; MUDDLE? + JRST SLURP1 ; YES, SEMICOLON GETS HANDLED IN MUDDLE HANDLER +;;;WE REALLY OUGHT TO GO TO SLURP1 FOR CODRND, CODLSP TOO, +;;;BUT WE DON'T HAVE 3 FONTS AT CMU, SO I WON'T BOTHER +;;;WITH IT FOR NOW. --RHG +SLSE1: XCT 2PUTNX + XCT 2PUTTC + CAIA + AOJA CC,(H) ;THIS COULD BE A JRST, BUT BE CONSISTENT WITH SLURP1 +2PUTN4: +IFGE NFNTS-3,[ + TLNE F,FLFNT3 ;MAKE SURE WE ARE USING A 3RD FONT + TRNE F,FRFNT3 + JRST 2PUTN5 + 2PATCH 177 + 2PATCH 1 + 2PATCH 2 +2PUTN5: +];IFGE NFNTS-3 + MOVE CH,COMC + JRST SLURP1 + +SLCR: MOVE A,IP ;LOOK AHEAD TO CHAR. AFTER THE CR. + ILDB A,A + CAIN A,^J + JRST SLCR3 ;WE HAVE A CRLF; TELL THE LF TO OUTPUT THE LINE. + CAIE A,^C + JRST SLURP7 ;FOLLOWED BY A NON-^C => CR IS STRAY; DECIDE WHAT TO DO. + MOVE A,IP + IBP A + ANDI A,-1 + CAME A,LASTIP + JRST SLCTL1 ;FOLLOWED BY REAL ^C, OR BY EOF, => CR IS STRAY. + PUSHJ P,DOINPT ;CR AT END OF BUFFER => READ NEW BUFFER AND AGAIN LOOK AHEAD. + JRST SLCTL1 ;NO MORE TO BE READ => CR IS FOLLOWED BY EOF. + JRST SLCR + +SLCR3: IORI F,FRLCR ;SIGNAL THE LF WE KNOW IS COMING THAT IT IS PART + JRST (H) ;OF A CRLF. + +SLURP7: TLNN F,FLSCR ;HERE FOR STRAY CR. FLSCR=1 => OVERPRINT; ELSE OUTPUT + JRST SLFMTC ;AS UPARROW-M, EXCEPT ON XGP IF /^ OUTPUT AS QUOTED ^M. + MOVE CC,NTABS + 2PATCH ^M + MOVEI CH,^I +SLURP3: 2PATCH + SOJG CC,SLURP3 + MOVEI CH,^M + JRST (H) + +SLLF: TRNN F,FRLCR + TLNE F,FLSCR ;LF: IF FLSCR=1, WE COUNT LINES BY LF'S. + JRST LFOUT + JRST SLFMTC ;STRAY LF WHEN FLSCR=0 IS A FORMATTING CHAR WHOSE FORMATTING + ;ACTION ISN'T DESIRED. + +LFOUT: PUSH P,CC ;COME HERE FROM SLURP WHEN ^J SEEN + TRZE F,FRLCR + SETZM (P) ;IF PRECEDED BY CR, STAY AT HPOS=0 AFTER OUTLIN. + INSIRP PUSH P,B C D L R + PUSHJ P,OUTLIN ;DO A CRLF, PRNTING NEW LINE NUMBER + INSIRP POP P,R L D C B + POP P,A + MOVEI CH,40 + JUMPE A,LFOUT1 ;IF LF WASN'T PRECEDED BY CR, +LFOUT2: 2PATCH ;SPACE OUT TO HORIZ. POS. THAT EXISTED BEFORE THE LF. + SOJG A,LFOUT2 +LFOUT1: SKIPE LNDFIL + PUSHJ P,CKLNM ;NOW FLUSH ANY DEC-STYLE LINE # IN INPUT FILE AFTER LF. + TRO F,FRLTAB ;SEMICOLONS AFTER LF'S ARE TREATED AS COMMENT-STARTERS. + SKIPN MDLCMT ;UNLESS WE'RE IN A HELD-OVER COMMENT, OUTLIN LEFT US IN FONT 1. + TRZ F,FRFNT3 + AOS OUTVP ;(BACK HERE FROM MUDDLE FONT HACKERY) + MOVEI CH,^J + AOJA N,(H) + +SLTAB: TRO F,FRLTAB ;HANDLE TAB. + TLNE F,FLXGP ;IN XGP LISTINGS, MUST CONVERT TABS TO SPACES + TLNN F,FLFNT2 ;IF TWO FONTS + JRST SLTAB0 ;SINCE LOSING XGP PRGM INTERPRETS TABS IN FONT 0 ALWAYS. + MOVEI CH,40 +SLTAB1: 2PUTCH + ADDI CC,1 + TRNE CC,7 + JRST SLTAB1 + MOVEI CH,^I + JRST (H) + +SLTAB0: 2PUTCH ;IN LPT AND SINGLE FONT XGP LISTINGS WE CAN JUST OUTPUT A TAB. + ADDI CC,10 + TRZ CC,7 + JRST (H) + +SLALT: TLNE F,FLCTL + JRST SLURP1 + 2PUTCH "$ + MOVEI CH,33 ;ALTMODE NORMALLY PRINTS AS $ BUT RETURNS ALTMODE TO CALLER. + AOJA CC,(H) + +;IN CONTINUATION MODE (TRUNCP < 0) 2PUTTC CALLS HERE (XCT'D BY 2PUTCH). +2PUTNL: +INSIRP PUSH P,A B C D L R H N CH ;DO WE REALLY HAVE TO PUSH ALL THESE? + PUSHJ P,OUTLIN + AOS OUTVP + SETOM CONTIN ;SUPPRESS THE LINE NUMBER ON THE CONTINUATION LINE. + SKIPE LNDFIL ;IF THIS FILE HAS LINE NUMBERS + SKIPN PRLSN ;AND WE ARE PRINTING THEM + JRST 2PUTN9 + 2PATCH ^I ;ADD AN EXTRA TAB + MOVEI CC,10(CC) +2PUTN9: SKIPGE 2MCCOL ;IF WE ARE NOT IN A COMMENT + JRST 2PUTN3 ;GET OUT OF HERE + MOVEI H,2PUTN3 ;FAKE A RETURN ADDRESS + MOVE CH,2MCCOL ;FIRST OF ALL, IF 2MCCOL IS CLOSE TO LINE LENGTH, + LSH CH,-1 ;I.E. >2/3 OF LINE LENGTH + ADD CH,2MCCOL + CAML CH,TLINEL + JRST 2PUTN4 ;THEN DON'T SPACE OUT; CONTINUE COMMENT IN COLUMN 1. +2PUTN6: MOVEI CH,10(CC) + CAML CH,2MCCOL ;NOTE 2MCCOL HAS HPOS !AFTER! THE ";" ON LINE ABOVE. + AOJA CC,2PUTN7 ;CC IS TEMPORARILY 1 TOO BIG IN 2PUTN7 + 2PATCH ^I + ADDI CC,10 + JRST 2PUTN6 + +2PUTN7: MOVEI CH,40 +2PUTN8: CAML CC,2MCCOL + SOJA CC,2PUTN4 ;WE'VE REACHED DESIRED COL. + 2PATCH ;OTHERWISE, 1 MORE SPACE. + AOJA CC,2PUTN8 + +2PUTN3: +INSIRP POP P,CH N H R L D C B A + POPJ P, + +SLNUL: SKIPE ETVFIL ;IGNORE NULLS EVERYWHERE IN AN ETV FILE. + JRST SLURP +SLCC: MOVEI A,(IP) ;HERE FOR ^C, AND (USUALLY) ^@. + CAME A,LASTIP + JRST SLCC1 + PUSHJ P,DOINPT + JRST 2DONE + JRST SLURP + +;COME HERE WHEN ^C OR ^@ SEEN IN FILE +SLCC1: SKIPLE LFILE + JRST SLCC3 + HRRZ A,LASTIP + HRLI A,350700 + HRLM CH,(P) +SLCC2: CAMN A,IP + JRST 2DONE + DBP7 A + LDB CH,A + JUMPE CH,SLCC2 + CAIE CH,^C + CAIN CH,^L + JRST SLCC2 + HLRZ CH,(P) + JRST SLCC3 + +SLTBL: JRST SLNUL ;^@ +REPEAT 2, JRST SLCTL ;^A-^B + JRST SLCC ;^C +REPEAT 4, JRST SLCTL ;^D-^G + JRST SLBS ;^H + JRST SLTAB ;^I + JRST SLLF ;^J + JRST SLCTL ;^K + JRST FFOUT ;^L + JRST SLCR ;^M +REPEAT 15, JRST SLCTL ;^N-^Z + JRST SLALT ;ALTMODE +REPEAT 4, JRST SLCTL ;^\-^_ + TRO F,FRLTAB ;SPACE +REPEAT 7, TRZ F,FRLTAB ;!-. + JRST SLSLSH ;/ +REPEAT 22, TRZ F,FRLTAB ;0-: + JRST SLSEMI ;; +REPEAT 103, TRZ F,FRLTAB ;<-~ + JRST SLRUB ;RUBOUT + +IFN .-SLTBL-200, .ERR WRONG LENGTH TABLE + +SUBTTL CHECK FOR CRETINOUS LINE NUMBERS IN FILES + +CKLNM2: PUSH P,CH + PUSHJ P,CKLNM +POPCHJ: POP P,CH + POPJ P, + +CKLNM4: SKIPN LNDFIL ;DO WE EVEN HAVE LINE NUMBERS? + SOJA IP,CPOPJ ;NO, GET THE HELL OUT OF HERE + HRLI IP,010700 ;SKIP TO END OF WORD +CKLNM: SKIPN CH,1(IP) ;ZERO WORD? + AOJA IP,CKLNM4 ;YES + TRNN CH,1 ;LINE NUMBER? + POPJ P, ;NO + CAME CH,[<^C>*201_4,,-1];AT END OF BUFFER? + JRST CKLNM7 ;NO + SKIPN LNDFIL ;DO WE EVEN HAVE LINE NUMBERS IN THIS FILE? + POPJ P, ;NO, WILL DETECT END OF BUFFER LATER + PUSH P,(IP) ;SAVE CURRENT CHARACTER WORD + PUSH P,IP ;SAVE CURRENT CHARACTER POSITION + PUSHJ P,DOINPT ;READ SOME MORE + JRST CKLNM5 ;EOF -- FAKE IT!! + SKIPE 1CKSFL ;PASS 1 CHECKSUMMING? + PUSHJ P,1CKS ;YES, DO IT +CKLNM6: POP P,IP ;RESTORE CHARACTER POSITION + HRRI IP,INBFR-1 ;BUT FIX THE WORD PART + POP P,(IP) ;RESTORE THE CURRENT CHARACTER WORD + JRST CKLNM ;AND START OVER LIKE NOTHING HAPPENED + +CKLNM5: HLLZM CH,INBFR ;SET THE ^C'S AT THE END, BUT LEAVE LOW BIT OFF!! + MOVEI IP,INBFR + MOVEM IP,LASTIP ;RESET THE INDICATOR + JRST CKLNM6 ;AND ACT AS IF THE DOINPT SUCCEDED + +;ASSUMING THE BEGINNING OF A FILE HAS JUST BEEN READ IN, SEE WHETHER THE FILE +;CONTAINS DEC-STYLE LINE NUMBERS. IF SO, SET LNDFIL. +LNMTST: SETZM LNDFIL ;ASSUME FILE DOES NOT HAVE LINE NUMBERS + SETZM ETVFIL ;ASSUME IT DOESN'T HAVE ETV STYLE DIRECTORY AND PADDING. + MOVE A,INBFR ;IF FILE HAS THEM, FIRST WORD SHOULD BE ONE + TRNE A,1 + JRST LNMTS1 + CAME A,[ASCII /COMME/] ;NO? IF HAS ETV STUFF, SHOULD START WITH "COMMENT ^V ". + POPJ P, + MOVE A,INBFR+1 + CAMN A,[ASCII /NT  /] + SETOM ETVFIL + POPJ P, + +LNMTS1: AND A,[ASCII /ppppp/] ;p = 160; GET TOP 3 BITS OF EACH CHARACTER. + CAME A,[ASCII /00000/] ;THEY MUST BE 011, SINCE ALL 5 CHARS MUST BE DIGITS. + POPJ P, ;NOT SO => 1ST WORD NOT A LINE NUMBER. + LDB A,[350700,,INBFR+1] + CAIE A,^I ;AND IT SHOULD BE FOLLOWED BY A TAB. + POPJ P, + SETOM LNDFIL ;FILE DOES HAVE LINE NUMBERS + SKIPN PRLSN ;SHOULD WE PRINT THEM? + MOVE IP,[350700,,INBFR+1] ;NO, SKIP OVER THEM + POPJ P, + +SUBTTL SET UP FOR PASS 2 (JUMPS INTO PASS 2 MAIN LOOP) + +2START: MOVEI A,LOOK + TLNE F,FLARB + MOVEI A,NLOOK + MOVEM A,LOOKIT + MOVSI A,(JFCL) + SKIPE TRUNCP + MOVSI A,(CAIGE CC,) + HLLM A,2PUTX + MOVSI A,(CAIA) + SKIPE TRUNCP + MOVSI A,(CAIL CC,) + HLLM A,2PUTNX + MOVSI A,(CAIA) + SKIPG TRUNCP ;SET UP 2PUTTC: CAIA IF TRUNCATING, + MOVE A,[PUSHJ P,2PUTNL] ;OUTPUT CRLF IF CONTINUEING. + MOVEM A,2PUTTC + MOVE A,PAGEL + TLNE F,FLQPYM + SUBI A,2 + MOVEM A,PAGEL1 ;FIND EFFECTIVE PAGEL (# TEXT LINES PER PAGE). + MOVEI A,3 + TLNE F,FLSHRT ;THIS COMPLICATED CODE CALCULATES HOW MANY COLUMNS + MOVEI A,2 ;AT THE BEGINNING OF EACH LINE ARE TAKEN + SKIPN MULTI ;UP BY LINE NUMBER AND REFERENCES. + MOVEI A,1 ;THE ANSWER, DIVIDED BY 8, + TLNE F,FL2REF ;GOES IN NTABS. SEE OUTLIN FOR THE + ADDI A,2 ;POSSIBLE FORMATS OF REFERENCES. + TLNN F,FL2REF + SKIPE MULTI + CAIA + ADDI A,1 + TLNN F,FLREFS + MOVEI A,1 + TLNE F,FLNOLN + SETZ A, + MOVEM A,NTABS + MOVEI B,LINCR0(A) + MOVEM B,LINCR + MOVEI B,RINCR0(A) + MOVEM B,RINCR + LSH A,3 + SUB A,LINEL + MOVNS A + MOVEM A,TLINEL ;TLINEL = # POSITIONS ROOM FOR TEXT PER LINE. + HRRM A,2PUTX + HRRM A,2PUTNX + SUBI A,PGNSPC ;SUBTRACT # TO LEAVE FOR "FOO 69 PAGE 69/1.1" + TLNE F,FLDATE +CMU, SUBI A,15. ;ALLOW FOR MM/DD/YYHH:MM +NOCMU, SUBI A,9. ;ALLOW FOR MM/DD/YY + SKIPGE A + SETZ A, + MOVEM A,PLINEL ;HORIZ INDENT FOR "PAGE " AT TOP OF EACH PAGE. + MOVEI A,FILES + MOVEM A,CFILE + SETZM OFILE ;NO OUTPUT FILE OPEN YET. + SETZM 1CKSFL ;TURN OFF CHECK-SUMMING, FOR BENEFIT OF CKLNM + MOVE A,SUBTLS + MOVEM A,SUBPTR + JRST 2LOOP + +SUBTTL PASS 2 MAIN LOOP + +;COME AT END OF FILE ON PASS 2. +2DONE: .CLOSE UTIC, + MOVE P,PSAVE + MOVE A,CODTYP + CAIN A,CODTXT ;FOR /L[TEXT], THERE ARE NO SUBTITLES, LASTSP IS GARBAGE, + JRST 2DONE1 ;AND THERE ARE NO QPYRT MESSAGES. + MOVE A,SLURPY + CAIN A,SLURP ;IF THE LAST PAGE NEEDED PRINTING, MAYBE IT PRINTED + PUSHJ P,2SUBF1 ;A SUPERFLUOUS HEADER FOR A CONTIN PAGE. IF SO, FLUSH IT. + JRST [MOVE SP,LASTSP ;THROW AWAY SPACE LEFT FOR REFS OF NEXT LINE. + JRST 2DONE1] + MOVE SP,LASTSP ;IF WE WANT QOPYRIGHT MESSAGES, AND LAST PAGE WAS PRINTED, + TLNE F,FLQPYM ;AND WASN'T NULL, AND WE DIDN'T FLUSH A SUPERFLUOUS HEADER, + TRNN N,-1 ;THEN WE HAVE A PAGE WITHOUT A QOPYRT MSG AT THE END. + CAIA + PUSHJ P,CPYOUB ;SO PUT ONE THERE. +2DONE1: TRNE F,FSQUOT+FSNCHG + JRST 2DONE2 + HRRZ IP,CFILE + SKIPGE UNIVCT + SETZ IP, + TRNN F,FSNSMT + PUSHJ P,SYMLST +2DONE2: HRRZ A,CFILE + ADDI A,LFBLOK + MOVEM A,CFILE +2LOOP: HRRZ A,CFILE + CAML A,SFILE + JRST 2END + MOVEM P,PSAVE + TRZ F,TEMPF+FSNSMT ;FETCH PER-FILE FLAGS OF THIS FILE. + MOVE B,F.SWIT(A) + ANDI B,TEMPF+FSNSMT + IOR F,B + TRNE F,FSLREC+FSNOIN ;DON'T LIST LREC FILES, OR FILES BEING IGNORED. + JRST 2DONE2 + TRNE F,FSNCHG ;IF FILE UNCHANGED, DON'T NEED PASS 2. + JRST 2LOOP2 + TRNN F,FSQUOT ;IF FILE SHOULDN'T BE LISTED, DON'T NEED PASS2 + JRST 2LOOP6 + TRNE F,FSARW ;EXCEPT '_ FILES ARE JUST FOR OUTPUT. + JRST [ PUSHJ P,2LOOPD + JRST 2DONE2] +2LOOP2: SKIPE CRFOFL ;IF WE DON'T HAVE A DEDICATED OUTPUT FILE FOR CREF AND UNIV SYM TABS + JRST 2LOOP9 + TLNN F,FLCREF + SKIPLE UNIVCT ;THEN IF WE'LL NEED AN OUTPUT FILE + SKIPE OFILE ;AND THERE'S NO OUTPUT FILE OPEN, + JRST 2LOOP9 + MOVE B,A ;AND THIS IS THE LAST CHANCE TO OPEN ONE, SET NEEDFL. +2LOOP8: ADDI B,LFBLOK ;ANY FILE REMAINING, EXCEPT FOR LREC + CAMN B,SFILE ;AND INPUT-ONLY FILES, IS ANOTHER CHANCE. + JRST [ PUSHJ P,2LOOPD ;THIS IS THE LAST CHANCE, SO OPEN FILE. + JRST 2LOOP9] + MOVE C,F.SWIT(B) + TRNE C,FSQUOT+FSLREC+FSNOIN + JRST 2LOOP8 +2LOOP9: TLNN F,FLCREF ;WE DON'T NEED TO LIST THIS FILE; NEED WE SCAN IT? + JRST 2DONE2 ;NO. WE ALREADY OPENED OUTPUT FILE IF NECESSARY. + JRST 2LOOP1 ;YES. + +2LOOP6: SKIPG OLDFL ;HERE FOR A FILE WHICH MUST BE LISTED. IGNORE SINGLE IN LREC EDIT MODE. + SKIPE SINGLE ;DECIDE WHETHER THIS FILE NEEDS A NEW OUTPUT FILE OPENED. + SKIPN OFILE + JRST 2LOOP0 ;YES, IT DOES. + 2PAGE ;NO, BUT MOVE TO TOP OF PAGE + TLNE F,FLXGP + JRST 2LOOP1 + 2PAGE ;IF NOT XGP, LEAVE BLANK PAGE. + JRST 2LOOP1 + +2LOOP0: PUSHJ P,2LOOPD ;OPEN NEW OUTPUT FILE AND PUT IN FONT SPECS IF NECESSRY. +2LOOP1: SKIPLE OLDFL + JRST [ PUSHJ P,TITLES ;IN LREC EDIT MODE, JUST WRITE OUT THE HEADER + PUSHJ P,2DLTPG ;AND LREC INFO; DON'T OPEN THE FILE. + JRST 2DONE2] + MOVE B,F.MINP(A) + MOVEM B,PAGMIN ;GET # OF PAGE TO START LISTING AT. + MOVE B,F.PAGT(A) ;SET UP PAGTPT AS B.P. TO ILDB FILE'S PAGE TABLE. + HRLI B,444400 + SKIPL F.PAGT(A) + SETZ B, ;OR TO 0, IF FILE HAS NO PAGE TABLE. + MOVEM B,PAGTPT + MOVEI B,SLURP + TRNE F,FSQUOT+FSNCHG + MOVEI B,XSLURP + MOVEM B,SLURPX + MOVEM B,SLURPY + SETZM CONTIN + SETZM SUBTSP + MOVEI R,2 + PUSHJ P,2INOPN ;OPEN FOR ASCII INPUT ON UTIC. + FLOSE UTIC,F.ISNM(A) + JFCL 2DONE2 + PUSHJ P,2RDAHD + PUSHJ P,DOINPT + JRST 2DONE +ITS, MOVE B,F.RFN1(A) +ITS, .SUSET [.SWHO2,,B] +ITS, .SUSET [.SWHO3,,[SIXBIT/P2/+1]] +ITS, .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] + PUSH P,A ;SAVE A 'CAUSE LNMTST GRONKS IT... + PUSHJ P,LNMTST ;SET LNDFIL IF THIS FILE HAS DEC LINE NUMBERS. + POP P,A + MOVEM SP,LASTSP ;(IN CASE WE JRST TO 2LOOP5) + TRNE F,FSQUOT+FSNCHG ;IF FILE'S BEING LISTED, + JRST 2LOOP5 + MOVE B,CODTYP + TLNE F,FLXGP ;IF /L[TEXT]/X, + CAIE B,CODTXT + SKIPE NOTITL ;OR IF /&, WE DON'T WANT A TITLE PAGE OR A PAGE MAP. + JRST 2LOOP4 + PUSHJ P,TITLES ; OUTPUT TITLE PAGES: 1 FOR XGP OR GOULD, 2 OTHERWISE + 2PAGE +ITS, MOVE B,QUEUE +ITS, CAIE B,QU.GLD + TLNE F,FLXGP + JRST 2LOOP7 + PUSHJ P,TITLES + 2PAGE +2LOOP7: PUSH P,IP + HRRZ IP,CFILE + SKIPGE C,F.OPGT(IP) ;IF THIS FILE DOESN'T HAVE + MOVE C,F.PAGT(IP) ;BOTH AN OLD PG TBL AND A NEW ONE, + MOVEI B,NEWPAG ;OR ALL PAGES ARE GOING TO BE PRINTED +2LOOPX: JUMPGE C,2LOOPY ;THEN DON'T BOTHER WITH PAGE MAPS, ETC. + ADD C,[2,,2] + TDNE B,1-2(C) ;SKIP IF PAGE WILL NOT BE LISTED + JRST 2LOOPX + PUSHJ P,2DLTPG ;PRINT NUMBERS OF ANY PAGES THAT WENT AWAY. + 2PAGE ;(ALSO PRINTS NUMBERS OF PAGES THAT CHANGED, +2LOOPY: POP P,IP ;AND PRINTS PAGE MAP, IF COMPARISON LISTING) +2LOOP4: TLNN F,FLSUBT + JRST 2LOOP3 + PUSH P,IP ;IF REQUESTED, PRINT TABLE OF CONTENTS + HRRZ IP,CFILE + SKIPGE UNIVCT + SETZ IP, + SETZB CC,OUTVP + SETOM FFSUPR ;INHIBIT FF IF NO TABLE OF CONTENTS + PUSHJ P,SUBOUT + PUSHJ P,2ENDP ;NOW FF AFTER THE TOC IF THERE WAS ONE + POP P,IP +2LOOP3: MOVEM SP,LASTSP ;HERE AFTER PRINTING ALL PREFACE PAGES. + SETZM OUTVP + SETOM FFSUPR ;INHIBIT AN FF BEFORE THE 1ST PRINTED PAGE. + PUSHJ P,OUTNSP +2LOOP5: TRZ F,FRLCR\FRWPGN\FRFNT3 ;HERE IF NOT OUTPUTTING (DOING PASS 2 JUST FOR CREF) + TRO F,FRLTAB + SETZM TXTIGN ;NOT READING ARGS TO AN XGP COMMAND IN /L[TEXT]. + SETOM 2MCCOL ;NOT WITHIN ANY COMMENT. + SETZB N,CC ;SAY THIS IS PAGE 0, + JSP H,FFOUT1 ;ADVANCE TO PAGE 1. + SKIPL CH,CODTYP ;DISPATCH ON FORMAT OF FILE. + CAIL CH,CODMAX + .VALUE + JRST @.+1(CH) + OFFSET -. +CODMID::2MIDAS ;MIDAS +CODRND::2RANDM ;RANDOM +CODFAI::2FAIL ;FAIL +CODP11::2MIDAS ;PALX-11 +CODLSP::2LISP ;LISP +CODM10::2FAIL ;MACRO-10 +CODUCO::2UCONS ;UCONS +CODTXT::2TEXT ;TEXT FOR XGP +CODMDL::2MUDDL ;MUDDLE +CODDAP::2MIDAS ;DAPX16 +CODMAX::OFFSET 0 + +SUBTTL PASS 2 TERMINATION (PRINT CREF, ETC.) + +;COME HERE AT END OF PASS 2, AFTER DEVOURING LAST INPUT FILE. +2END: SETZM FFSUPR +ITS, .SUSET [.SWHO1,,[0]] + TLNN F,FLCREF\FLSUBT ;IF WE WANT A TABLE OF CONTENTS OR FLCREF + SKIPLE UNIVCT ; OR UNIVERSAL SYM TABS + SKIPLE OLDFL + JRST 2END2 +;IF ALL INPUT FILES UNCHANGED SINCE LAST LISTING, THEN UNLESS THE /U OR /C +;WAS EXPLICITLY GIVEN THIS TIME, DON'T BOTHER PRINTING A REPEAT OF AN OLD CREF, ETC. + MOVEI A,FILES +2END0A: MOVE B,F.SWIT(A) + TRC B,FSARW+FSQUOT + TRCE B,FSARW+FSQUOT + TRNE B,FSNOIN+FSLREC + JRST 2END0B + TRNN B,FSNCHG ;A FILE THAT WAS SCANNED, THAT CHANGED, + JRST 2END0C ;MEANS DEFINITELY DO PRINT ALL APPROPRIATE TABLES. +2END0B: ADDI A,LFBLOK + CAMGE A,SFILE + JRST 2END0A +;NO INPUT FILE WAS CHANGED. WAS THERE AN EXPLICIT /U OR /C? + MOVE B,EF + SKIPN EUNIVCT + TLNE B,FLCREF + JRST 2END0C ;YES, PRINT APPROPRIATE TABLES. + JRST 2END2 + +;HERE IF REALLY SHOULD PRINT AT LEAST ONE ITEM OF AUXILIARY OUTPUT. +2END0C: SKIPN CRFOFL ;THEN WANT EITHER A SEPARATE FILE FOR THEM, OR A FF. + JRST 2END3 + MOVSI A,-3 ;DEFAULT THE NAMES OF THE OUTPUT FILE, +2END4: SKIPN B,CRFFIL(A) ;NOTE WE DON'T USE THE /O-SPECIFIED FN2 AS DEFAULT, SINCE + MOVE B,OUTFIL(A) ;DOING SO WOULD BE LIKELY TO PUT THE CREF ON TOP OF + MOVEM B,CRRFIL(A) ;ANOTHER OUTPUT FILE. + AOBJN A,2END4 + SKIPN B,CRFFN2 + MOVE B,CRDFN2 + MOVEM B,CRRFN2 +ITS,[ SKIPN B,CRRDEV ;IF AT THIS POINT SNAME OR FN1 IS SPEC'D BUT NOT DEV, + MOVSI B,'DSK ;ASSUME DEV IS DSK - ELSE IN NON-XGP LISTINGS + SKIPN CRRFN1 + SKIPE CRRSNM ;WE MIGHT GET STUCK WITH TPL. + MOVEM B,CRRDEV +];ITS + MOVEI A,CRRSNM-F.OSNM + PUSHJ P,2LOOPO ;OPEN THE FILE USING THE DEFAULTED NAMES. + SETOM FFSUPR ;PREVENT SUBOUT, SYMLST OR CRFOUT FROM MAKING INITIAL BLANK PAGE. +2END3: PUSH P,UNIVCT + SETZ IP, ;AT END OF LAST FILE: IF EXTRA COPIES OF + SKIPG UNIVCT ; UNIVERSAL SYM TAB LISTING ARE WANTED, + JRST 2END1A ; OR OF SUBTITLE LISTING, OUTPUT THEM NOW +2END1: TLNE F,FLSUBT + PUSHJ P,[PUSHJ P,2ENDP + JRST SUBOUT] + PUSHJ P,SYMLST + SOSLE UNIVCT + JRST 2END1 +2END1A: POP P,UNIVCT + TLNE F,FLCREF ;MAYBE WE WANT A CREF TOO + PUSHJ P,CRFOUT +2END2: SKIPN A,OFILE ;IF OUTPUT FILE OPEN, CLOSE IT. + POPJ P, + JRST 2OCLSQ + +2ENDP: AOSN FFSUPR + POPJ P, + 2PAGE + POPJ P, + +;RENAME AND CLOSE AN OUTPUT FILE IN PASS 2. A -> FILE BLOCK. +2OCLS: SETZM OFILE ;NO OUTPUT FILE OPEN ANY MORE. +ITS, MOVEI CH,^C +ITS, TLNE F,FLXGP + SETZ CH, + PUSHJ P,2OCLSO +2OCLS1: +ITS,[ .CALL [ SETZ + SIXBIT \RENMWO\ ;RENAME WHILE OPEN + 1000,,UTOC ;CHANNEL # + F.OFN1(A) ;FILE NAME 1 + SETZ F.OFN2(A) ] ;FILE NAME 2 + FLOSE UTOC,F.OSNM(A) + JFCL .+1 +];ITS +2OCLS3: .CLOSE UTOC, + POPJ P, + +2OCLSO: +REPEAT 5,2PATCH + MOVNI SP,(SP) + HRLI SP,SLBUF(SP) + HRRI SP,SLBUF + JUMPGE SP,CPOPJ + .OUTPT SP + POPJ P, + +;CLOSE AND QUEUE FOR XGP'ING THE CURRENT OUTPUT FILE. +2OCLSQ: +NOITS,[ ;DON'T DO THIS ON ITS UNLESS YOU SEE HOW TO AVOID IT IF THE JOB IS ^P'D. + FLOSEI 0,F.OSNM(A) ;TYPE THE FILENAME, + JFCL 2OCLS5 ;UNLESS WE ARE DISOWNED. + STRT [ASCIZ\contains \] + AOS OUTPAG + TYPNUM 10.,OUTPAG ;TYPE THE PAGE COUNT FOR THIS FILE + STRT [ASCIZ\ pages\] +NOCMU,[ +NODEC,[ + SKIPL QUEUE + STRT [ASCIZ\ -- queued\] +];NODEC +];NOCMU + STRT [ASCIZ\. +\] +];NOITS +2OCLS5: MOVE L,OFILE ;SAVE OFILE FOR 2QUEUE + PUSHJ P,2OCLS ;CLOSE THE FILE. + SKIPGE C,QUEUE ;IF QUEUEING IS ON, + POPJ P, + DROPTHRUTO 2QUEUE + +SUBTTL QUEUE AN OUTPUT FILE FOR PRINTING + +ITS,[ +2QUEUE: CAIN C,QU.YES ;ON ITS, SIMPLE "YES" AND /-X MEANS WE ALREADY + TLNE F,FLXGP ;QUEUED, SIMPLY BY OUTPUTTING TO TPL:. + CAIA + POPJ P, + .CALL [ SETZ ? SIXBIT /OPEN/ ? [.BAO,,UTOC] + ['DSK,,] ? [SIXBIT /MAIL/] ? [SIXBIT />/] ? SETZ ['.MAIL.]] + POPJ P, + MOVE SP,[010700,,SLBUF-1] + MOVEI B,[ASCIZ /FROM-JOB:@ +HEADER-FORCE:Q +REGISTERED:F +/] + MOVEI B,[ASCIZ /TO:"XGP-SPOOLER +SENT-BY:/] + CAIN C,QU.GLD + MOVEI B,[ASCIZ /TO:"GLP-SPOOLER +SENT-BY:/] + PUSHJ P,ASCOUT + .SUSET [.RUNAME,,B] + PUSH P,B + JSP H,SIXOUT + POP P,CH + .SUSET [.RXUNAME,,B] + CAMN B,CH + JRST 2OCLS2 + MOVEI B,[ASCIZ / +CLAIMED-FROM:/] + PUSHJ P,ASCOUT + .SUSET [.RXUNAME,,B] + JSP H,SIXOUT +2OCLS2: MOVEI B,[ASCIZ / +TEXT;-1 +/] + PUSHJ P,ASCOUT ;THE TEXT OF THE MESSAGE IS JUST THE FILENAME, FOR THE XGP. + MOVEI L,F.OSNM-F.RSNM(L) + SETOM FQUOTF + PUSHJ P,FILOUM ;OUTPUT THE FILE NAME, QUOTING SPECIAL CHARACTERS WTH ^Q. + SETZM FQUOTF + MOVEI B,[ASCIZ */HW/NOHEADING*] + CAIN C,QU.GLD ;OR "NAME/HW/NOHEADING" FOR /-X. + TLNE F,FLXGP + CAIA + PUSHJ P,ASCOUT + MOVEI B,[ASCIZ */DELETE*] + PUSHJ P,ASCOUT + PUSHJ P,CRLOUT + SETZ CH, ;PAD WITH ENOUGH NULLS. + PUSHJ P,2OCLSO ;AND OUTPUT THE JUNK. + JRST 2OCLS3 +];ITS + +CMU, 2QUEUE: POPJ P, +DEC, 2QUEUE: POPJ P, + +SAI,[ +;QUEUE AN OUTPUT FILE FOR PRINTING. DROPS THROUGH FROM 2OCLSQ. +;WHAT WE ACTUALLY DO IS WRITE THE FILENAME INTO QUEBUF. AT END OF RUN, +;THE COMMAND IN QUEBUF GETS PTLOADED ALL AT ONCE. +2QUEUE: PUSH P,SP + MOVE SP,QUEBFP ;MAKE SP POINT AT QUEBUF TO FAKE OUT OUTPUT RTNS. + MOVEI B,[ASCIZ /, /] + CAME SP,[440700,,QUEBUF] + JRST 2OCLS4 + MOVEI B,[ASCIZ *XSPOOL/XGP *] ;BEFORE THE FIRST FILE, SET UP THE COMMAND + TLNN F,FLXGP + MOVEI B,[ASCIZ *SPOOL *] ;ITSELF, AND THE SWITCHES. + SKIPE FNTSPC + MOVEI B,[ASCIZ *XSPOOL/XGP/NOTITLE *] +2OCLS4: PUSHJ P,ASCOUT ;OUTPUT THE COMMAND & SWITCHES, OR A COMMA, + MOVEI L,F.OSNM-F.RSNM(L) + PUSHJ P,FILOUT ;FOLLOWED BY THE FILE NAME. + MOVEM SP,QUEBFP + HRRZS SP ;BARF IF WE GO PAST END OF QUEBUF. + CAIL SP,QUEBFE + .VALUE + POP P,SP + POPJ P, + +PTYLD: SKIPN QUEBUF ;COME HERE AT END OF RUN, TO PTYLOAD THE QUEUE COMMAND + POPJ P, ;IF THERE IS ONE. + MOVEI A,^M + IDPB A,QUEBFP + PTLOAD QUEARG + POPJ P, +];SAI + +SUBTTL PASS 2 OUTPUT FILE OPEN ROUTINES + +;OPEN FOR OUTPUT ON UTOC THE FILE NAMED IN F.OSNM(A), ETC. +;R HAS DESIRED MODE (3 OR 7). SKIP IF SUCCESSFUL. +ITS, ;H HAS DESIRED TEMPORARY FN2; OTFFN1 HAS TEMPORARY FN1. +NOITS, ;H HAS THE DESIRED PROTECTION (OR 0 FOR DEFAULT) IN BITS 0-8, REST ZERO + +2OUTOP: +ITS,[ MOVEM H,OTFFN2 + PUSH P,F.OSNM(A) + POP P,OTFSNM ;PUT SNAM AND DEV IN OTFSNM BLOCK + PUSH P,F.ODEV(A) + POP P,OTFDEV ;SO FLOSE UUOS CAN FIND THEM. + .CALL [ SETZ ? SIXBIT/OPEN/ + 5000,,(R) ? 1000,,UTOC + F.ODEV(A) ? OTFFN1 ? OTFFN2 ? SETZ F.OSNM(A)] + POPJ P, + JRST POPJ1 +];ITS +NOITS,[ SETZM OUTCHN ;ASSUME ASCII + CAIN R,3 + JRST 2OUTO2 ;GOOD ASSUMPTION + CAIE R,7 ;WHOOPS, BETTER BE IMAGE + .VALUE + MOVEI CH,14 + MOVEM CH,OUTCHN +2OUTO2: MOVE CH,F.ODEV(A) + MOVEM CH,OUTCHN+1 + SETOM OUFIL+.RBERR ;IN CASE OF ERROR! + OPEN UTOC,OUTCHN + POPJ P, + MOVE CH,F.OFN1(A) + MOVEM CH,OUFIL+.RBNAM + MOVE CH,F.OFN2(A) + HLLZM CH,OUFIL+.RBEXT + HLLZM H,OUFIL+.RBPRV ;Set up the PROTECTION field + MOVE CH,F.OSNM(A) + MOVEM CH,OUFIL+.RBNAM+3 ;FUNNY LOCATION BECAUSE + ENTER UTOC,OUFIL+.RBNAM ;NOT EXTENDED ENTER + POPJ P, + MOVEI CH,OUTBFR + EXCH CH,.JBFF + OUT UTOC, ;INIT THE BUFFERS + AOSA (P) + .VALUE + EXCH CH,.JBFF + CAILE CH,OUTBFR+NBFRS*BFRLEN + .VALUE + POPJ P, +];NOITS + +;HIGHER-LEVEL OPEN OUTPUT FILE. CLOSE ANY OUTPUT FILE NOW OPEN, +;DEFAULT VARIOUS OUTPUT NAMES, AND INIT OUTPUT BUFFER POINTER. + +2LOOPD: ;OUTPUT OPEN, DEFAULTING NAMES FOR ORDINARY OUTPUT FILE. +REPEAT 4,[ + MOVE B,OUTFIL+.RPCNT ;/O SPECIFIED NAMES ARE THE DEFAULTS. + SKIPN F.OSNM+.RPCNT(A) + MOVEM B,F.OSNM+.RPCNT(A) +];REPEAT 4 +ITS,[ MOVSI B,'DSK ;ON ITS, IF AN OUTPUT FN1 OR SNAME IS SPECIFIED + SKIPN F.OSNM(A) ;(EITHER BEFORE _ OR IN /O), MAKE DEFAULT DEVICE + SKIPE F.OFN1(A) ;DSK INSTEAD OF TPL. + SKIPE F.ODEV(A) ;BUT DON'T OVERRIDE A SPECIFIED DEVICE. + CAIA ;NOTE THIS MUST PRECEDE THE DEFAULTING OF F.OFN1, NEXT. + MOVEM B,F.ODEV(A) +];ITS + MOVE B,F.IFN1(A) ;SECONDARY DEFAULT FOR FN1 IS INPUT FN1. + SKIPN F.OFN1(A) + MOVEM B,F.OFN1(A) +2LOOPO: PUSH P,A + SKIPE A,OFILE ;IF ALREADY AN OUTPUT FILE OPEN, CLOSE IT. + PUSHJ P,2OCLSQ + MOVE A,(P) + MOVEM A,OFILE ;MAKE OFILE -> FILE BLOCK OF OUTPUT FILE WE'RE OPENING. + MOVE B,XGPFN2 +SAI, SKIPE FNTSPC + TLNN F,FLXGP ;OUTPUT FN2 IS DEFAULTED HERE + MOVE B,OPTFN2 + SKIPN F.OFN2(A) + MOVEM B,F.OFN2(A) + MOVE B,MSNAME + SKIPN F.OSNM(A) + MOVEM B,F.OSNM(A) + MOVSI B,'DSK +ITS,[ TLNN F,FLXGP ;ON ITS, NON-XGP LISTINGS GO TO TPL BY DEFAULT + MOVSI B,'TPL + SKIPE QUEUE .SEE QU.YES ;AS LONG AS SIMPLE QUEUEING IS ON. + MOVSI B,'DSK +];ITS + SKIPN F.ODEV(A) + MOVEM B,F.ODEV(A) + MOVEI R,3 ;USE MODE = ASCII OUTPUT. +ITS, MOVE H,[SIXBIT/OUTPUT/] +NOITS, SETZ H, ;USE DEFAULT PROTECTION + PUSHJ P,2OUTOP ;OPEN OUTPUT NAMES IN OTFSNM, ETC. ON UTOC. + FLOSE UTOC,F.OSNM(A) + JFCL 2DONE2 + MOVE SP,[010700,,SLBUF-1] + PUSHJ P,2OUTFNT ;WRITE XGP COMMANDS IF NECESSARY. + SETZM OUTPAG + JRST POPAJ + +SUBTTL XGP COMMANDS OUTPUT + +;WRITE A PAGE OF XGP COMMANDS DESCRIBING THE FONTS AND VSP KNOWN TO @. +2OUTFNT: + TLNN F,FLXGP ;PREFIX THESE COMMANDS ONLY IF /X + POPJ P, + MOVE B,CODTYP ;AND NOT /L[TEXT]. + CAIN B,CODTXT + POPJ P, +SAI,[ + SKIPN FNTSPC + POPJ P, +REPEAT NFNTS,[ ;FOR EACH FONT, + MOVEI L,FNTF0+.RPCNT*FNTFL-F.RSNM + MOVEI B,[ASCIZ \/FONT#\] + SKIPE F.RFN1(L) ;IF IT IS ACTUALLY SPECIFIED, + PUSHJ P,[ + PUSHJ P,ASCOUT ;OUTPUT A COMMAND FOR XSPOOL GIVING + 2PATCH "0+.RPCNT ;ITS NUMBER + 2PATCH "= + PUSHJ P,FILOUT ;AND ITS FILENAMES + JRST CRLOUT] +];REPEAT NFNTS +RADIX 10. + MOVEI B,[.ASCII \/BMAR=1 +/TMAR=!TOPMAR +/RMAR=!LNLDOT-1 +/LMAR=!LFTMAR +/PMAR=!PGLDOT-TOPMAR-1 +/XLINE=\ ? 0] +RADIX 8 + PUSHJ P,ASCOUT + MOVE A,FNTVSP + PUSHJ P,000X + PUSHJ P,CRLOUT + 2PATCH ^L + JRST 2OUTPJ +];SAI + +ITSXGP,[NOSAI,[ + MOVEI B,[ASCIZ /;SKIP 1 +;LFTMAR 128 +/] + PUSHJ P,ASCOUT + SKIPN FNTSPC + JRST 2OUTF2 + MOVEI B,[ASCIZ /;KSET /] + PUSHJ P,ASCOUT + PUSHJ P,2OUTF1 ;PRINT THE FONT FILE NAMES. + PUSHJ P,CRLOUT + MOVEI B,[ASCIZ /;VSP /] + PUSHJ P,ASCOUT + MOVE A,FNTVSP + PUSHJ P,000X ;TELL XGP PROGRAM ABOUT DESIRED VSP: ";VSP " + PUSHJ P,CRLOUT +2OUTF2: MOVEI B,[ASCIZ /@ /] ;SAY WHO MADE THE FILE, JUST FOR LAUGHS + PUSHJ P,ASCOUT + MOVE B,[.FNAM2] + JSP H,SIXOUT + MOVEI B,[ASCIZ /: PAGEL = /] ;LET LOSER KNOW WHAT WE ASSUMED + PUSHJ P,ASCOUT + MOVE A,PAGEL + PUSHJ P,000X + MOVEI B,[ASCIZ /, LINEL = /] + PUSHJ P,ASCOUT + MOVE A,LINEL + PUSHJ P,000X + PUSHJ P,CRLOUT + 2PATCH ^L + JRST 2OUTPJ +]];ITSXGP,NOSAI + +NOITS, POPJ P, ;NOT YET IMPLEMENTED + +2OUTF1: +REPEAT NFNTS,[ +IFN .RPCNT,2PATCH [",] + MOVEI L,FNTF0+.RPCNT*FNTFL-F.RSNM ;F.RSNM COMPENSATES FOR FILOUT + SKIPE F.RFN1(L) ;DON'T PRINT ANYTHING FOR UNSPECIFIED FONTS. + PUSHJ P,FILOUT +];REPEAT NFNTS + POPJ P, + +SUBTTL PASS 2 INPUT FILE OPEN ROUTINES + +;OPEN FILE <- A ON UTIC. SKIP IF SUCCESSFUL. R HAS ITS-STYLE OPEN MODE (2 OR 6). +;IF DOINPT IS GOING TO BE USED TO READ THE FILE, 2RDAHD MUST BE CALLED TO SET UP. +2INOPN: PUSH P,D + PUSH P,CH +ITS,[ .CALL [ SETZ ? SIXBIT/OPEN/ + 5000,,(R) ? 1000,,UTIC ;MODE AND CHANNEL. + 1(A) ? 2(A) ? 3(A) ? SETZ (A)] ;DEV FN1 FN2 SNAME. + JRST POPCHD + .CALL [ SETZ + SIXBIT \FILLEN\ ;GET FILE LENGTH + 1000,,UTIC ;CHANNEL # + 402000,,D ] ;WHERE TO PUT LENGTH + HRLOI D,377777 +];ITS +NOITS,[ SETZM INCHN ;ASSUME ASCII + CAIN R,2 + JRST 2INOP2 ;GOOD ASSUMPTION + CAIE R,6 ;WHOOPS, BETTER BE IMAGE + .VALUE + MOVEI CH,14 + MOVEM CH,INCHN +2INOP2: MOVE CH,F.IDEV(A) + MOVEM CH,INCHN+1 + SETOM INFIL+.RBERR ;IN CASE OF ERROR! + OPEN UTIC,INCHN + JRST POPCHD + MOVEM CH,INFIL+.RBDEV + HRLOI D,377777 + MOVEM D,INFIL+.RBSIZ + MOVE CH,F.IFN1(A) + MOVEM CH,INFIL+.RBNAM + MOVE CH,F.IFN2(A) + HLLZM CH,INFIL+.RBEXT + MOVE CH,F.ISNM(A) + MOVEM CH,INFIL+.RBPPN +NOSAI, LOOKUP UTIC,INFIL + JRST [ MOVEM CH,INFIL+.RBNAM+3 + LOOKUP UTIC,INFIL+.RBNAM + JRST POPCHD + MOVEM D,INFIL+.RBSIZ + MOVEI CH,UTIC +SAI, PNAME CH, +NOSAI, DEVNAM CH, + MOVE CH,F.IDEV(A) + MOVEM CH,INFIL+.RBDEV + JRST 2INOP3 ] +JFCL; - I HAVEN'T CHECKED THIS OUT YET - RHG MOVE D,INFIL+.RBSIZ +2INOP3: MOVEI CH,INBFR2 + EXCH CH,.JBFF + INBUF UTIC,NBFRS + EXCH CH,.JBFF + CAILE CH,INBFR2+NBFRS*BFRLEN + .VALUE +];NOITS + MOVEM D,LFILE + MOVEI D,INBFR+LINBFR + MOVEM D,LASTIP ;MAKE SURE TEST AT DOINPT DOESN'T THINK WE'RE STILL AT EOF. + AOS -2(P) +POPCHD: POP P,CH + POP P,D + POPJ P, + +2RDAHD: +ITS,[ HRROI D,INBFRW + .IOT UTIC,D + SKIPGE D + SETZM LFILE +];ITS + POPJ P, + +SUBTTL PRINT COMPARISON PAGE MAP + +;FIND ALL INSERTED PAGES OR ALL DELETED PAGES. +;PRINTS ALL PAGE #S PRESENT IN THE PAGE TABLE IN C AND NOT IN THE TABLE IN B. +;IF THERE IS AT LEAST ONE PAGE # TO PRINT, THE HEADER IN D IS PRINTED FIRST. +2DLINP: HRRZ R,1(B) ;R IS PAGE # REACHED IN NEW PG TBL, + HRRZ L,1(C) ;L IS # REACHED IN OLD. + ANDCMI R,NEWPAG + ANDCMI L,NEWPAG + SETZ CH, ;CH IS ZERO IF WE HAVEN'T FOUND ANY DELETED PAGES YET. + ;USED TO DECIDE WHETHER TO PRINT HEADER. + MOVE CP,C ;VIRT PAGE #S TO PRINT ARE THOSE IN TABLE IN C. + +;THE ALGORITHM IS TO SCAN THRU BOTH PAGE TBLS AT ONCE, +;ADVANCING IN WHICHEVER TABLE WE ARE AT A SMALLER PAGE # IN. +;WHEN THEY'RE EQUAL, ADVANCE IN THE OLD PAGE TABLE. +;THUS, THE NEW PAGE TABLE PTR ONLY REACHES A HIGHER NUMBER +;THAN THE OLD ONE HAS REACHED WHEN A PAGE IS MISSING FROM +;NEW AND PRESENT IN OLD. + +2DLTP1: CAMN L,R + JRST 2DLTP3 ;EQUAL, ADVANCE IN OLD. + CAML L,R + JRST 2DLTP4 ;NEW SMALLER, ADVANCE IT. +;OLD SMALLER, WE'VE FOUND A DELETION. + JUMPN CH,2DLTP2 + PUSH P,B + MOVE B,D + PUSHJ P,ASCOUT + POP P,B + JRST 2DLTP6 + +2DLTP2: IORI CC,7 + ADDI CC,1 ;SEE WHERE A TAB WOULD BRING US. + MOVEI CH,10.(CC) + CAML CH,LINEL ;NO ROOM ON THIS LINE => GO TO NEXT. + JRST 2DLTP5 + 2PATCH ^I ;ROOM => TAB OUT. + JRST 2DLTP6 + +2DLTP5: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ +2DLTP6: HRRZ A,C + PUSHJ P,2DLTPP ;PRINT PAGE A POINTS AT PAGE TABLE ENTRY OF. +2DLTP3: ADD C,[2,,2] ;ADVANCE IN OLD PAGE TABLE. + JUMPGE C,CPOPJ ;LOOKED AT ALL OLD PAGES => FOUND + ;ALL DELETED ONES. + HRRZ L,1(C) + ANDCMI L,NEWPAG + JRST 2DLTP1 + +2DLTP4: ADD B,[2,,2] ;ADVANCE IN NEW PAGE TABLE. + HRRZ R,1(B) + ANDCMI R,NEWPAG + JUMPL B,2DLTP1 + MOVEI R,.BM MINPAG,+.BM MAJPAG ;REACHED END => DUMMY UP PAGE INFINITY + JRST 2DLTP1 ;SO ALL REMAINING OLD PAGES ARE DELETED. + +;A -> PAGE TABLE ENTRY FOR A PAGE; PRINT PAGE'S REAL NUMBER (IF /Y) OR VIRTUAL NUMBER (/-Y). +;CLOBBERS A,D. +2DLTPP: PUSH P,B + MOVEI D,(A) + PUSHJ P,MJMNR1 + POP P,B + POPJ P, + +;Similar to 2DLINP, but only for deletions under /Y +2DLYP: MOVE D,F.OPGT(IP) + SETZ CH, +2DLYP1: HLRZ L,1(D) ;Page kept? + JUMPN L,2DLYP9 ;Yes, it hasn't been deleted + LDB L,[MINPAG,,1(D)] ;Minor page number? + JUMPN L,2DLYP4 ;if so, it has been deleted since /Y uses only real numbers + LDB L,[MAJPAG,,1(D)] ;Major page being printed? + SUBI L,1 + IMUL L,[2,,2] + ADD L,F.PAGT(IP) + JUMPGE L,2DLYP4 ;No corresponding new page -- was deleted + HRRE L,1(L) .SEE NEWPAG ;Is corresponding new page printed from scratch? + JUMPL L,2DLYP9 ;IF SO, then not really deleted +2DLYP4: JUMPN CH,2DLYP2 ;Got a deleted page -- should we print header? + MOVEI B,[ASCIZ / + +Deleted pages: + +/] + PUSHJ P,ASCOUT + JRST 2DLYP6 + +2DLYP2: IORI CC,7 + ADDI CC,1 ;SEE WHERE A TAB WOULD BRING US. + MOVEI CH,10.(CC) + CAML CH,LINEL ;NO ROOM ON THIS LINE => GO TO NEXT. + JRST 2DLYP5 + 2PATCH ^I ;ROOM => TAB OUT. + JRST 2DLYP6 + +2DLYP5: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ +2DLYP6: PUSHJ P,MJMNR1 +2DLYP9: ADD D,[2,,2] + JUMPL D,2DLYP1 + POPJ P, + +;IN COMPARISON LISTINGS, IT IS POSSIBLE THAT SOME PAGE NUMBERS THAT EXISTED IN +;THE OLD LISTING DO NOT EXIST IN THE LISTING OF THE NEW FILE. SINCE NO +;REPLACEMENTS FOR THOSE PAGES WILL BE PRINTED, THE USER MUST BE TOLD SPECIFICALLY +;TO THROW THEM OUT. +;IF THERE ARE ANY SUCH DELETED PAGES, 2DLTPG PRINTS THEIR NUMBERS, ALONG WITH A +;DESCRIPTIVE HEADER, ON A SEPARATE PAGE AFTER THE TITLE PAGE(S). +;2DLTPG EXPECTS THE OUTPUT FILE TO BE AT THE BOTTOM OF A PAGE, AND LEAVES IT THE +;SAME WAY. + +2DLTPG: MOVE A,IP + SETZM OUTVP + PUSHJ P,PTLAB + SKIPE REALPG ;/Y + JRST [ MOVE L,F.SWIT(IP) + SKIPN NORENUM ;Without /1G + TRNE L,FSLRNM ;or /1J + JRST .+1 + PUSHJ P,2DLYP ;is special + JRST 2PRTPG ] + MOVE B,F.PAGT(IP) + MOVE C,F.OPGT(IP) + MOVEI D,[ASCIZ / + +Deleted Pages: + +/] + PUSHJ P,2DLINP + +;PRINT A LIST OF THE NUMBERS OF ALL INSERTED PAGES - PAGES WHOSE NUMBERS WERE +;NOT THE NUMBERS OF ANY PAGES IN THE PREVIOUS LISTING. +2INSPG: MOVE B,F.OPGT(IP) + MOVE C,F.PAGT(IP) + MOVEI D,[ASCIZ / + +Newly Created Pages: + +/] + PUSHJ P,2DLINP + DROPTHRUTO 2PRTPG + +;PRINT A LIST OF THE PAGE NUMBERS OF ALL PAGES ACTUALLY PRINTED. +;EXITS BY JRST TO 2PGMAP. +2PRTPG: MOVE C,F.PAGT(IP) + MOVE CP,C ;2DLTPP NEEDS PTR TO THE BEGINNING OF THE PAGE TABLE TO PRINT PAGE #. + SETZ CH, +2PRTP1: HRRZ L,1(C) ;GET VIRT. PAGE # OF NEXT PAGE. + TRZN L,NEWPAG + JRST 2PRTP3 ;NOT BEING LISTED => DON'T MENTION IT. +;WE'VE FOUND A PAGE WE SHOULD MENTION. + JUMPN CH,2PRTP2 ;BEFORE THE FIRST ONE, PRINT A HEADER: + MOVEI B,[ASCIZ / + +Printed Pages: + +/] + PUSHJ P,ASCOUT ;THIS IS ALL ANALOGOUS TO 2DLTPG + JRST 2PRTP6 + +2PRTP2: IORI CC,7 + ADDI CC,1 + MOVEI CH,10.(CC) + CAML CH,LINEL + JRST 2PRTP5 + 2PATCH ^I + JRST 2PRTP6 + +2PRTP5: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ +2PRTP6: HRRZ A,C + PUSHJ P,2DLTPP ;PRINT THE NUMBER OF THE PAGE WE FOUND. +2PRTP3: ADD C,[2,,2] + JUMPL C,2PRTP1 + SKIPN REALPG ;IF /Y, PRINT #S OF DISCARDED OLD PAGES TELLING USER HOW TO RENUMBER. + JRST 2PGMAP ;IF NOT /Y, USER SEES THE VIRTUAL PAGE #S, SO PRINT PAGE MAP. + DROPTHRUTO 2RPLPG + +;FOR /Y, PRINT NUMBERS OF ALL OLD PAGES BEING RENUMBERED. +;SUCH PAGES HAVE IN LH(2ND WORD OF PAGE TABLE ENTRY). +2RPLPG: MOVE C,F.OPGT(IP) + SETZ CH, +2RPLP0: HLRZ D,1(C) + JUMPE D,2RPLP1 + MOVE D,1(D) + XOR D,1(C) + TRNN D,<.BM MAJPAG>\.BM MINPAG + JRST 2RPLP1 + JUMPN CH,2RPLP2 + MOVEI B,[ASCIZ / + +Renumbered Pages: ( = ): + +/] + PUSHJ P,ASCOUT + JRST 2RPLP4 + +2RPLP2: MOVEI CH,32.(CC) + CAML CH,LINEL + JRST 2RPLP3 + PUSHJ P,SPCOUT + PUSHJ P,SPCOUT + JRST 2RPLP4 + +2RPLP3: PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ +2RPLP4: HLRZ D,1(C) + PUSHJ P,MJMNR1 ;PRINT = + 2PATCH "= + MOVEI D,(C) + PUSHJ P,MJMNR1 + CAML C,[-6,,-1] ;IS THIS THE START OF A RUN OF AT LEAST 3 CONSECUTIVELY RENUMBERED PGS? + JRST 2RPLP1 + HLRZ D,1(C) + HLRZ L,3(C) + HLRZ R,5(C) + CAIN L,2(D) + CAIE R,4(D) + JRST 2RPLP1 ;NO, NOT RENUMBERED TO CONSECUTIVE PAGES. + MOVEI B,[ASCIZ / THRU /] + PUSHJ P,ASCOUT ;YES, PRINT ONE ENTRY FOR WHOLE RUN: = THRU =. +2RPLP5: CAML C,[-2,,0] + JRST 2RPLP6 + HLRZ L,3(C) + CAIN L,2(D) + AOJA D,[ADD C,[2,,2] + AOJA D,2RPLP5 ] +2RPLP6: PUSHJ P,MJMNR1 ;AND DESCRIBE IT AS = + 2PATCH "= + MOVEI D,(C) + PUSHJ P,MJMNR1 +2RPLP1: ADD C,[2,,2] + JUMPL C,2RPLP0 + JRST SYML9 ;Last but not least, print a Copyright, if needed. + +;CALL HERE TO PRINT A PAGE MAP IF NECESSARY. +;A PAGE MAP GIVES THE CORRESPONDENCE BETWEEN REAL PAGE #S AND +;LISTING PAGE #S. FOR EXAMPLE, IF A PAGE IS INSERTED AFTER PAGE 1, +;IT WILL COME OUT AS PAGE 1/1 IN A COMPARISON LISTING. THEN, REAL PAGE +;3 (THE FORMER PAGE 2) WILL HAVE LISTING PAGE # 2. THE PAGE MAP WOULD +;SAY: 1 1 2 1/1 3 2 +;2PGMAP EXPECTS TO BE CALLED WITH THE OUTPUT FILE AT THE BOTTOM OF A PAGE, +;AND LEAVES THINGS THE SAME WAY. +;THE MAP IS NOT PRINTED IF IT IS THE IDENTITY MAP. + +2PGMAP: MOVE B,F.PAGT(IP) + MOVEI C,1 ;FIRST, WOULD THE PAGE MAP BE TRIVIAL (THE IDENTITY FUNCTION)? +2PGM1A: LDB R,[MAJPAG,,1(B)] + CAME C,R + JRST 2PGM1B ;NO, WE MUST PRINT IT. + AOS C + ADD B,[2,,2] + JUMPL B,2PGM1A + JRST SYML9 ;IT'S TRIVIAL, SO JUST FINISH UP THIS PAGE WITH QPYRT IF NEC. + +2PGM1B: MOVE B,LINEL + ADDI B,8 ;TAKE INTO ACCOUNT FACT THAT SPACE NOT NEEDED AFTER LAST ENTRY ON LINE. + IDIVI B,24. ;COMPUTE # ENTRIES PER LINE. + MOVEM B,SYM%LN + MOVEI C,(B) + CAILE C,10 + MOVEI C,10 + MOVNS C + HRLM C,COLAOB + HRRZ CP,F.PAGT(IP) ;ADDR OF PAGE TABLE OF FILE. + HLRE B,F.PAGT(IP) ;-2*<# PAGES IN FILE> + ASH B,-1 + MOVNM B,SYMCNT ;THROUGHOUT, SYMCNT HAS # PAGES LEFT TO HANDLE. + +;PRINT OUT THE NEXT PAGE OF PAGE MAP. +;N COUNTS THE LINES THAT HAVE BEEN PRINTED. +2PGM2: SKIPG SYMCNT + POPJ P, ;NO MORE ENTRIES NEEDED => RETURN (CPYRT MSG WAS ALREADY OUTPUT) + MOVE B,PAGEL1 + SUB B,OUTVP ;# LINES REMAINING ON PAGE TO BE PRINTED ON. + LSH B,2 ;IF THAT'S < 1/4 * PAGEL1, WE WANT A NEW PAGE + CAML B,PAGEL1 ;EVEN THOUGH ONE HAS BEEN STARTED. + JRST [ ;OTHERWISE, IF 2PRTPG STARTED A PAGE, JUST SKIP 2 LINES. + PUSHJ P,CRLOUT + PUSHJ P,CRLOUT + JRST 2PGM2B] + PUSHJ P,CPYPAG ;MAKE NEW PAGE, AND MAYBE PUT CPYRT MSG AT BOTTOM OF OLD ONE. + HRRZ A,IP + PUSHJ P,PTLAB +2PGM2B: MOVEI B,[ASCIZ /Page Map:/] + PUSHJ P,ASCOUT + PUSHJ P,CRLOUT + PUSHJ P,CRLOUT ;AND A BLANK LINE AFTER THE HEADER LINE. +;NOW PRINT "REAL PAGE" OR "LISTED AS" ABOVE EACH COLUMN OF PAGE NUMBERS. + MOVE L,SYM%LN + CAMLE L,SYMCNT ;IF SYMTAB DOESN'T USE ALL THE COLUMNS, + MOVE L,SYMCNT ;DON'T PRINT "REAL PAGE - LISTED AS" ABOVE UNUSED COLUMNS. +2PGM5A: MOVE B,[SIXBIT/REAL/] + JSP H,SIXOUT + 2PATCH ^I + MOVE B,[SIXBIT/LISTED/] + JSP H,SIXOUT + SOJLE L,2PGM5B + 2PATCH ^I + 2PATCH + JRST 2PGM5A + +2PGM5B: PUSHJ P,CRLOUT + MOVE L,SYM%LN + CAMLE L,SYMCNT ;IF SYMTAB DOESN'T USE ALL THE COLUMNS, + MOVE L,SYMCNT ;DON'T PRINT "REAL PAGE - LISTED AS" ABOVE UNUSED COLUMNS. +2PGM5C: MOVE B,[SIXBIT/PAGE/] + JSP H,SIXOUT + 2PATCH ^I + MOVE B,[SIXBIT/AS/] + JSP H,SIXOUT + SOJLE L,2PGM5D + 2PATCH ^I + 2PATCH + JRST 2PGM5C + +2PGM5D: PUSHJ P,CRLOUT + PUSHJ P,CRLOUT +;PAGE HEADER HAS BEEN PRINTED. PREPARE TO PRINT PAGE'S ENTRIES. + MOVE C,PAGEL1 + SUB C,OUTVP ;# LINES REMAINING ON PAGE. + IMUL C,SYM%LN ;GET # SYMS THAT WILL FIT IN REST OF PAGE. + MOVEM C,SYM%PG + MOVE L,SYMCNT + CAMLE L,SYM%PG + MOVE L,SYM%PG ;L HAS # ENTRIES THAT WILL GO ON THIS PAGE. + IDIV L,SYM%LN ;L HAS # LINES, R HAS # LONG COLUMNS. +;COMPUTE WHERE IN PAGE TABLE EACH COLUMN STARTS. + MOVE D,COLAOB +2PGM2A: MOVEM CP,(D) ;D SPEC'S A COLUMN; RECORD WHERE THE COLUMN STARTS. + ADD CP,L ;THEN COUNT OFF AS MANY ENTRIES AS THERE ARE LINES + ADD CP,L ;EACH ENTRY BEING 2 WORDS + SOSL R ;AND REMEMBER THAT THE FIRST FEW COLUMNS ARE ONE LINE + ADDI CP,2 ;LONGER, IF # ENTRIES ISN'T DIVISIBLE BY # COLUMNS. + AOBJN D,2PGM2A ;COMPUTE THE STARTING POINTS OF ALL THE COLUMNS. + ;CP NOW HAS STARTING POINT OF FOLLOWING PAGE. + +;PRINT THE NEXT LINE. +2PGM3: MOVE L,COLAOB ;AOBJN -> COLUMNS TO BE PRINTED. + +;PRINT NEXT ENTRY ON LINE. +2PGM4: SOSGE SYMCNT + JRST SYML9 ;ALL ENTRIES PRINTED => FINISH PAGE WITH COPYRT MSG. + HRRZ R,(L) ;GET PAGTAB ADDR OF NEXT ENTRY THIS COLUMN. + ADDI R,2 + MOVEM R,(L) ;AND ADVANCE SO NEXT LINE, THIS COLUMN WILL USE NEXT PAGE. + MOVE A,R ;COMPUTE REAL PAGE # FOR THIS ENTRY + HRRZ B,F.PAGT(IP) + SUB A,B ;NOTE IF AT 2PGM4 C( (L) ) EQUALED C(F.PAGT), + LSH A,-1 ;THE RESULT OF THIS INSN IS 1, WHICH IS RIGHT. + PUSHJ P,000X ;PRINT REAL PAGE # IN 4 CHARACTER POSITIONS, + 2PATCH ^I ;AND A TAB. + MOVEI D,-2(R) + PUSHJ P,MJMNR1 ;THEN PRINT THE VIRTUAL PAGE NUMBER OF THE PAGE. + AOBJP L,2PGM8 ;LOOP OVER ALL COLUMNS ON LINE, + 2PATCH ^I ;PUTTING 2 TABS AFTER EACH COLUMN BUT THE LAST. + 2PATCH + JRST 2PGM4 + +;FINISHED PRINTING 1 LINE. +2PGM8: AOS N,OUTVP + CAML N,PAGEL1 ;ROOM FOR ANOTHER LINE ON THIS PAGE? + JRST 2PGM8C + 2PATCH ^M + 2PATCH ^J ;YES, GO PRINT IT. + PUSHJ P,2OUTPJ ;WATCH OUT! SLBUF MAY BE FILLING UP. + JRST 2PGM3 + +2PGM8C: TLNE F,FLQPYM ;END OF PAGE: PRINT COPYRIGHT MSG OF ANY, + PUSHJ P,CPYOUT + PUSHJ P,2OUTPJ + JRST 2PGM2 ;GO PRINT THE NEXT PAGE. + +SUBTTL PASS 2 PROCESSING FOR MIDAS CODE + +2MIDAS: SKIPA CH,[2MTBL] ;FOR MIDAS CODE, ONE DISPATCH TABLE. +2FAIL: MOVEI CH,2FTBL ;FOR FAIL CODE, ANOTHER. + HRRM CH,2MXCT + MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF + SKIPN ETVFIL ;IF THIS IS AN ETV FILE, + JRST 2MNSYL +2MIDAD: 2GETCH ;SKIP OVER THE FIRST PAGE (THE DIRECTORY) + CAIE CH,^L ;NOT FINDING SYMBOL REFS. + JRST 2MIDAD + JRST 2MNSYL + +PTHI==. ? .=PTLO ;SWITCH TO LOW SEGMENT FOR IMPURE CODE. + +2MNSYL: TRZN F,FRLET+FRSQZ ;NEW SYLLABLE - IF ANY SQUOZE + JRST 2MLOOP ; SEEN MUST REINIT POINTERS + MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF +2MLOOP: 2GETCH ;MAIN CHAR GOBBLING LOOP +2MXCT: XCT 0(CH) ;2MTBL\2FTBL ;XCT FROM TABLE - IMPURE!! + SUBI CH,40 ;NO SKIP FOR UPPER CASE, DIGITS + IDPB CH,CP ;SKIP FOR LOWER CASE + JRST 2MLOOP ;STICK IN SIXBIT BUFFER + +PTLO==. ? .=PTHI ;SWITCH BACK TO PURE SEGMENT. + +2MDQT: SKIPE PALX11 ;" SEEN IN MIDAS OR PALX11 + JRST 2MDQT2 ;IT'S PALX11 + TRNE F,FRSQZ ;" SEEN IN MIDAS - DOES IT FOLLOW SQUOZE? + JRST 2MBRK ;YES, MUST MEAN GLOBAL, OR BLOCK NAME. +2MGOBL: 2GETCH ;GOBBLE A CHAR AFTER ", ', OR ^ +2MGOB2: 2GETCH ;EXAMINE NEXT CHAR + SKIPGE 2MTBL(CH) ;SKIP IF NOT SQUOZE + JRST 2MGOB2 ;GOBBLE IF SQUOZE, TRY AGAIN + CAIE CH,"" ;", ', AND ^ CAN CASCADE, + CAIN CH,"' ; E.G. SUCH AS ^P"C^P"D + JRST 2MGOBL + CAIN CH,"^ + JRST 2MGOBL + TRZ F,FRLET+FRSQZ ;NEW SYLLABLE, CHAR ALREADY IN CH + MOVE CP,[440600,,SYLBUF] + SETZM SYLBUF + JRST 2MXCT + + +2FQT: TRNE F,FRSQZ ;' OR " SEEN IN FAIL CODE. + JRST 2MBRK ;IN MIDDLE OF SYLLABLE? + MOVE A,CH ;REMEMBER THE TERMINATOR. + MOVEI D,10. ;IN ANY CASE DON'T LOOK MORE THAN 10. CHARS. +2FQT1: 2GETCH ;THIS LOOP WORKS LIKE 1FQT1. + CAIE CH,^M + CAMN A,CH + JRST 2MBRK + SOJG D,2FQT1 + JRST 2MBRK + +2FSPAC: MOVE CH,IP ;SPACE SEEN IN FAIL CODE. + ILDB CH,CH + SKIPGE 2MTBL(CH) ;IF FOLLOWING CHAR IS SQUOZE, + JRST 2MBRK ;PROCESS THE PRECEDING SYLLABLE. + JRST 2MLOOP ;IF SPACE FOLLOWED BY NON-SQUOZE, IGNORE THE SPACE. + +2FBAKA: MOVE A,CODTYP + CAIN A,CODM10 + JRST 2MBRK + JRST 2MNSYL + +2MSQT: SKIPE PALX11 ;SINGLE QUOTE SEEN + JRST 2MSQT2 + TRNE F,FRSQZ ;' SEEN IN MIDAS CODE. + JRST 2MLOOP ;WITHIN SYLLABLE => IGNORE IT. + JRST 2MGOBL ;OTHERWISE, IT STARTS A TEXT CONSTANT. + +2FUPAR: MOVE A,CODTYP + CAIN A,CODM10 + JRST 2MSQT2 ;^ IN MACRO-10 GOBBLES 1 CHAR. + JRST 2MBRK ;^ IN FAIL IS IGNORED. + +2MDQT2: 2GETCH ;" IN PALX - SKIP 2 CHARS. +2MSQT2: 2GETCH ;' IN PALX - SKIP 1 CHAR. + JRST 2MNSYL + +2MSUBT: PUSHJ P,2MSEM1 ;ON PASS 2, JUST IGNORE SUBTITLES + JRST 2MNSYL + +; SEMICOLON OR SLASH +2MSEMI: CAME CH,COMC ; IS IT THE COMMENT CHARACTER? + JRST 2MBRK ; NO, TREAT AS BREAK + PUSHJ P,2COMME ; IGNORE COMMENT + JRST 2MNSYL + +2COMME: MOVEM CC,2MCCOL ;HERE TO IGNORE A LINE FOR A COMMENT ON PASS 2. +2MSEM1: 2GETCH + CAILE CH,^L ;DO IT THIS WAY FOR SPEED + JRST 2MSEM1 + CAIE CH,^J + CAIN CH,^L + CAIA + JRST 2MSEM1 + SETOM 2MCCOL + POPJ P, + +2MCOMA: TLNN F,FL2REF ;COMMA IN MIDAS OR PALX: + JRST 2MBRK ; JUST A DELIMITER UNLESS FL2REF. + TRNN F,FRLET ;FL2REF: FIRST, DO WHAT OTHER + JRST 2MCOM1 ; DELIMITERS DO - + MOVE A,SYLBUF ;THAT IS, REF THE SYMBOL IF ANY - + JSP H,@LOOKIT + CAIA + JSP H,REFSYM +2MCOM1: MOVE A,LSYL ;THEN SAVE SYMBOL REF AS "THE SYM BEFORE THE COMMA" + MOVEM A,LSYL2 + SETZM LSYL ;AND ALLOW ANOTHER AS THE ONE AFTER THE COMMA. + JRST 2MNSYL + +2MCTL: TRNN F,FRSQZ ;^ SEEN - IF NOT FOLLOWING SQUOZE + JRST 2MGOBL ; IT MUST BE THE ^X CONSTRUCT +2MBRK: TRNN F,FRLET ;BREAK CHAR SEEN + JRST 2MNSYL + MOVE A,SYLBUF ;CHECK FOR VARIOUS PSEUDO'S + SKIPE PALX11 + JRST 2MBRK2 + CAMN A,[SIXBIT \SUBTTL\] + JRST 2MSUBT + CAME A,[SIXBIT \DEFINE\] + CAMN A,[SIXBIT \.BEGIN\] + JRST 2MSUBT +2MBRK1: CAME A,[SIXBIT \XCREF\] + CAMN A,[SIXBIT \.XCREF\] + JRST 2MXCRF + CAMN A,[SIXBIT \.SEE\] + JRST 2M.SEE + JSP H,@LOOKIT ;TRY LOOKING IN SYMBOL TABLE + JRST 2MNSYL + JSP H,REFSYM ;IF FOUND, REF AND CREF + JRST 2MNSYL + +2MBRK2: CAME A,[SIXBIT \.SBTTL\] + CAMN A,[SIXBIT \.STITL\] + JRST 2MSUBT + JRST 2MBRK1 + +2MSGET: MOVE CP,[440600,,SYLBUF] ;GET NEXT SYLLABLE (CALL WITH JSP B,) + SETZM SYLBUF +2MSGT1: CAMN CH,COMC ; EXCEPT MUST NOTICE A + JRST 2MSEMI ; FEW SPECIAL CHARS + CAIE CH,^L + CAIN CH,^J + JRST 2MNSYL + 2GETCH + XCT NSQOZP(CH) + JRST 2MSGT2 + JRST 2MSGT1 + +2MSGT2: XCT 2MTBL(CH) ;NOW GOBBLE UP SQUOZE CHARS, + SUBI CH,40 ; AND DEPOSIT SIXBIT IN BUFFER + IDPB CH,CP + 2GETCH + XCT NSQOZP(CH) + JRST 2MSGT2 + JRST (B) + +2MXCRF: JSP B,2MSGET ;.XCREF FOUND - SET %SXCRF BIT + JSP H,@LOOKIT ; FOR ALL SYMBOLS MENTIONED + JRST 2MXCRF + MOVSI B,%SXCRF + IORM B,S.BITS(A) + JRST 2MXCRF + +2M.SEE: JSP B,2MSGET ;.SEE FOUND - MAKE A SPECIAL .SEE-TYPE REFERENCE + JSP H,@LOOKIT ;TO ALL THE SYMBOLS FOLLOWING IT ON THE LINE. + JRST 2M.SEE + PUSH P,F + SETZM LSYL ;.SEE'D SYMBOLS TAKE PRIORITY OVER ALL OTHERS. + TLZ F,FLCREF ;REFERENCE THE SYM NORMALLY, BUT DON'T CREF IT. + JSP H,REFSYM + POP P,F + MOVEI B,M%.SEE ;THEN CREF IT WITH A SPECIAL CODE + TLNE F,FLCREF + JSP H,CREFSYM ;SO "PAGE!LINE" WILL PRINT INSTEAD OF "PAGE-LINE". + JRST 2M.SEE + +;PASS 2 DISPATCH TABLE FOR MIDAS CODE. + +2MTBL: +REPEAT 40, JRST 2MBRK ;^@-^_ + JRST 2MBRK ;SPACE + JRST 2MBRK ;! + JRST 2MDQT ;" + JRST 2MBRK ;# +REPEAT 2, TRO F,FRLET+FRSQZ ;$ % + JRST 2MBRK ;& + JRST 2MSQT ;' +REPEAT 4, JRST 2MBRK ;( ) * + + JRST 2MCOMA ;, (SPECIAL FOR 2REFS) + JRST 2MBRK ;- + TRO F,FRLET+FRSQZ ;. + JRST 2MSEMI ;/ +REPEAT 12, TRO F,FRSQZ ;0-9 + JRST 2MNSYL ;: + JRST 2MSEMI ;; + JRST 2MBRK ;< + JRST 2MNSYL ;= +REPEAT 3, JRST 2MBRK ;> ? @ +REPEAT 32, TRO F,FRLET+FRSQZ ;A-Z +REPEAT 3, JRST 2MBRK ;[ \ ] + JRST 2MCTL ;^ +REPEAT 2, JRST 2MBRK ;_ ` +REPEAT 32, TROA F,FRLET+FRSQZ ;a-z +REPEAT 4, JRST 2MBRK ;{ | } ~ + JRST 2MBRK ;RUBOUT + +IFN .-2MTBL-200, .ERR WRONG LENGTH TABLE + +;PASS 2 DISPATCH TABLE FOR FAIL AND MACRO-10 CODE. + +2FTBL: JRST 2MLOOP ;^@ +REPEAT ^X-1, JRST 2MBRK ;^A - ^W + PUSHJ P,1FUNDR ;^X +REPEAT 37-^X, JRST 2MBRK ;^Y - ^_ + JRST 2FSPAC ;SPACE + JRST 2MBRK ;! + JRST 2FQT ;" + JRST 2MBRK ;# +REPEAT 2, TRO F,FRLET+FRSQZ ;$ % + JRST 2MBRK ;& + JRST 2FQT ;' +REPEAT 6, JRST 2MBRK ;( ) * + , - + TRO F,FRLET+FRSQZ ;. + JRST 2MBRK ;/ +REPEAT 10., TRO F,FRSQZ ;0 - 9 + JRST 2MNSYL ;: + JRST 2MSEMI ;; + JRST 2MBRK ;< + JRST 2MNSYL ;= +REPEAT 3, JRST 2MBRK ;> ? @ +REPEAT 26., TRO F,FRLET+FRSQZ ;A - Z +REPEAT 3, JRST 2MBRK ;[ \ ] + JRST 2FUPAR ;^ (FOR MACRO-10) + JRST 2FBAKA ;_ (DIFFERS BETWEEN FAIL AND MACRO10) + JRST 2MBRK ;` +REPEAT 26., TROA F,FRLET+FRSQZ ;a - z +REPEAT 3, JRST 2MBRK ;{ | } + JRST 2FUPAR ;~ (FOR MACRO-10) + JRST 2MBRK ;RUBOUT + +IFN .-200-2FTBL,.ERR WRONG TABLE LENGTH + +SUBTTL PASS 2 PROCESSING FOR LISP CODE + +IFN LISPSW,[ + +;WE DON'T ACTUALLY PARSE THE LISP INTO FORMS. ALL WE HAVE TO DO IS +;FIND ALL THE ATOMS AND IGNORE COMMENTS. + +2UCONS: JFCL +2LISP: SETZM LFNBEG + MOVEI CH,^L + +;SKIP TO THE START OF THE NEXT ATOM OR COMMENT. +2LLOOP: MOVE B,CH ;REMEMBER LAST CHAR IN CASE NEXT IS "(". + TRZN F,FRSQZ ;IF THE READ-AHEAD FLAG IS SET, THEN REUSE WHAT'S IN CH. + 2GETCH + XCT 2LTBL(CH) ; PERFORM CHARACTER-DEPENDENT ACTIONS. + JRST 2LLOOP + +;HERE FOR "(" TO DETECT START OF DEFUN ("(" IN COLUMN 0). +2LLPAR: CAIE B,^J + CAIN B,^L + MOVEM N,LFNBEG + JRST 2LLOOP + +;PARSE AN ATOM. +2LSLSH: MOVE CP,[440700,,SYLBUF] ;"/"-QUOTED CHARS ALSO START ATOMS. +2LATM4: 2GETCH + JRST 2LATM5 ; SKIP ATOM-INIT CODE + +2LATOM: MOVE CP,[440700,,SYLBUF] ;BYTE PTR TO ATOM BUFFER +2LATM2: CAIL CH,140 + SUBI CH,40 +2LATM5: IDPB CH,CP ;STORE AWAY THE 1ST CHAR +2LATM1: 2GETCH ;GRAB THE NEXT CHARACTER + XCT 2LTBL2(CH) ;DISPATCH ON NEW CHAR + TRO F,FRSQZ ;SET READ-AHEAD FLAG FOR MAIN LOOP. + JSP H,@LOOKIT ;LOOK UP THE SYMBOL + POPJ P, ;NOT SEEN ON 1ST PASS (IGNORE IT) + JSP H,REFSYM ;SEEN -- PUT IN A CREF ENTRY + POPJ P, + +;PARSE | STRINGS. WE DO NOT REF THEM, SINCE THEY ARE PRESUMABLY +;ONLY THERE TO BE ERROR MESSAGES. +2LSTR: MOVE B,CH ;REMEMBER WHAT WILL END THIS (" OR |). + JRST 2LSTR2 + +2LSTR1: 2GETCH ; FOR READING "/"-QUOTED CHARACTERS + +2LSTR2: 2GETCH ;(ENTRY PT) GET NEXT CHAR IN STRING + CAIN CH,"/ ;QUOTE CHARACTER? + JRST 2LSTR1 ;YES. IGNORE THE NEXT CHAR + CAME CH,B ;END OF THE STRING? + CAIN CH,^L ;DON'T IGNORE LOTS OF STUFF PAST PAGE BNDRY, FOR SAFETY. + POPJ P, + JRST 2LSTR2 ;NO -- KEEP READING + +;DISPATCH TABLE FOR FINDING THE BEGINNING OF AN ATOM OR COMMENT. + +2LTBL: +REPEAT 41, JFCL ;CONTROL CHARACTERS AND SPACE ARE IGNORED. +REPEAT 6, PUSHJ P,2LATOM ;! THROUGH & ARE ATOM CHARACTERS. + JFCL ;' + JRST 2LLPAR ;( + JFCL ;). +REPEAT 2, PUSHJ P,2LATOM ; * AND + + JFCL ;COMMA + PUSHJ P,2LATOM ; - + PUSHJ P,2LATOM ; . + PUSHJ P,2LSLSH ; / +REPEAT 11. PUSHJ P,2LATOM ; DIGITS AND : + PUSHJ P,2COMME ; SEMICOLON +REPEAT 4, PUSHJ P,2LATOM ; < = > ? +REPEAT 40, PUSHJ P,2LATOM ; @ U.C. LETTERS [ \ ] ^ _ + JFCL ; ` IS IGNORED. +REPEAT 26., PUSHJ P,2LATOM ; L.C. LETTERS. + PUSHJ P,2LATOM ; { + PUSHJ P,2LSTR ; | + PUSHJ P,2LATOM ; } + PUSHJ P,2LATOM ; ~ + JFCL ; RUBOUT. +IFN .-2LTBL-200, .ERR 2LTBL IS THE WRONG SIZE. + + +;DISPATCH TABLE FOR FINDING THE END OF AN ATOM. +2LTBL2: +REPEAT 41, JFCL ;END OF ATOM +REPEAT 6, JRST 2LATM2 ;! THROUGH & ARE ATOM CHARACTERS. +REPEAT 3, JFCL ;', ( AND ) ARE IGNORED. +REPEAT 2, JRST 2LATM2 ; * AND + + JFCL ;COMMA + JRST 2LATM2 ; - + JFCL ; . + JRST 2LATM4 ; / +REPEAT 11. JRST 2LATM2 ; DIGITS AND : + JFCL ; SEMICOLON +REPEAT 4, JRST 2LATM2 ; < = > ? +REPEAT 40, JRST 2LATM2 ; @ U.C. LETTERS [ \ ] ^ _ + JFCL ; ` IS IGNORED. +REPEAT 26., JRST 2LATM2 ; L.C. LETTERS. + JRST 2LATM2 ; { + JFCL ; | + JRST 2LATM2 ; } + JRST 2LATM2 ; ~ + JFCL ; RUBOUT. +IFN .-2LTBL2-200, .ERR 2LTBL2 IS THE WRONG SIZE. +];IFN LISPSW + +SUBTTL PASS 2 PROCESSING FOR RANDOM CODE AND TEXT. + +IFE LISPSW,2LISP: 2UCONS: +IFE MUDLSW,2MUDDL: + +2RANDM: 2GETCH + JRST 2RANDM + +;PASS 2 PROCESSING FOR "TEXT" FILES, WHICH CONTAIN NO SYMBOLS. +;WE BYPASS ALL OF THE SLURP AND OUTIN HAIR, AND OUTPUT EXACTLY WHAT WE FIND IN THE FILE. +2TEXT: MOVE SP,LASTSP ;BACK OVER ANY SPACE LEFT FOR NON-EXISTENT LINE NUMBERS. + MOVEI A,2TEXTG + MOVEM A,SLURPX + EXCH A,SLURPY + CAIN A,XSLURP + MOVEM A,SLURPY + SETZM TXTIGN +XGP,[ TLNE F,FLXGP + JRST 2TEXGP +];XGP +2TEXT1: 2GETCH ;EITHER XSLURP (NO SKIP) OR 2TEXTG (SKIPS). + JRST 2TEXT1 + 2PATCH + CAIL CH,40 + JRST 2TEXT1 + 2OUTBF + JRST 2TEXT1 + +;GET A CHAR FOR TEXT MODE. JUST LIKE XSLURP EXCEPT: +; 1) IT SKIPS, SO THAT 2TEXT1 WILL CALL 2PATCH, AND +; 2) ITS ADDRESS IS DIFFERENT, SO THAT FFOUT1 KNOWS IT'S PRINTING OUT. +2TEXTG: AOJA H,XSLURP + +XGP,[ +;HANDLE /L[TEXT]/X MODE. THIS FORMAT CAN CONTAIN ^L'S WHICH ARE ARGUMENTS +;TO XGP COMMANDS; THEY SHOULD NOT BE TAKEN AS SEPARATING PAGES (THE CHECKSUMMER +;ON PASS 1 ALSO KNOWS THIS). TXTIGN, WHEN NONZERO, TELLS FFOUT1 THAT ^L'S ARE +;NOT SPECIAL AT THE MOMENT. +2TEXGP: SETZM TXTIGN +2TEXGL: 2GETCH + JRST 2TEXG1 + 2PATCH + CAIN CH,^J ;SINCE 2OUTBF IS A FEW INSNS, AVOID IT MOST OF THE TIME. + JRST 2TEXG1 + 2OUTBF +2TEXG1: CAIE CH,177 ;XGP LIKE NON-XGP EXCEPT DETECT THE ESCAPE CHARACTER. + JRST 2TEXGL + 2OUTBF + SETOM TXTIGN ;^L'S FOUND IN XGP COMMANDS AREN'T PAGE BREAKS. + 2GETCH + JRST 2TEXG2 + 2PATCH +2TEXG2: CAILE CH,XGPMAX + JRST 2TEXGP + XCT 2TEXGT(CH) ;NOW DECODE THE CHARACTER AFTER THE ESCAPE. +2TEXIG: SOJL B,2TEXGP ;IGNORE (SKIP OVER PARSING) THE NUMBER OF CHARS IN B + 2GETCH + JRST 2TEXIG + 2PATCH + JRST 2TEXIG + +2TEXIC: 2GETCH + JRST 2TEXID + 2PATCH +2TEXID: MOVEI B,(CH) + JRST 2TEXIG +];XGP + +SUBTTL PASS 2 PROCESSING OF XGP CONTROL CODES FOR CODTXT + +ITSXGP,[ + +2TEXGT: JRST 2TEXGP ;RUBOUT-^@ + JRST 2TEXE1 ;^A IS XGP ESCAPE 1 + MOVEI B,1 ;^B IS XGP ESCAPE 2 + MOVEI B,2 ;^C IS XGP ESCAPE 3 + MOVEI B,9. ;^D IS XGP ESCAPE 4 +XGPMAX==:.-2TEXGT-1 + +;HERE TO READ THE CHARACTER AFTER THE SEQUENCE RUBOUT-^A +2TEXE1: 2GETCH + JRST 2TEXF1 + 2PATCH +2TEXF1: CAIGE CH,40 ;RUBOUT-^A CODES LESS THAN SPACE TAKE NO ARGUMENT. + JRST 2TEXGP + CAIN CH,40 ;RUBOUT-^A-SPACE TAKES 2 CHARS OF ARGUMENT. + JRST 2TEXI2 + CAIGE CH,44 ;CODES 41, 42, AND 43 TAKE ONE CHAR OF ARGUMENT. + JRST 2TEXI1 + CAIN CH,45 ;45 TAKES A BYTE WHICH SAYS HOW MANY MORE BYTES TO IGNORE. + JRST 2TEXIC + CAIGE CH,47 + JRST 2TEXGP ;44 AND 46 HAVE NO ARGS + CAIG CH,50 + JRST 2TEXI1 + CAIN CH,51 + JRST 2TEXI2 + CAIE CH,52 + JRST 2TEXGP +2TEXI1: SKIPA B,[1] +2TEXI2: MOVEI B,2 + JRST 2TEXIG +] ;END ITSXGP + +CMUXGP,[ +2TEXGT: JRST 2TEXK0 ;0 EOF + JRST 2TEXK2 ;1 VS + JRST 2TEXK2 ;2 LM + JRST 2TEXK2 ;3 TM + JRST 2TEXK2 ;4 BM + JRST 2TEXK2 ;5 LIN -obsolete + JRST 2TEXK0 ;6 CUT + JRST 2TEXK0 ;7 NOCUT + MOVEI B,1 ;10 AK -obsolete + MOVEI B,1 ;11 BK -obsolete + JRST 2TEXGP ;12 ASUP -internal to LOOK and the XGP + JRST 2TEXGP ;13 BSUP -internal to LOOK and the XGP + JRST 2TEXGP ;14 UA + JRST 2TEXGP ;15 UB + JRST 2TEXK2 ;16 JW + JRST 2TEXK2 ;17 PAD + MOVEI B,1 ;20 S + JRST 2TEXIM ;21 IMAGE + JRST 2TEXGP ;22 ICNT -internal to LOOK and the XGP + JRST 2TEXGP ;23 LF -internal to LOOK and the XGP + JRST 2TEXGP ;24 FF -internal to LOOK and the XGP + JRST 2TEXGP ;25 ECL -obsolete or internal to LOOK and the XGP + JRST 2TEXGP ;26 BCL -obsolete + JRST 2TEXGP ;27 CUTIM + MOVEI B,2 ;30 T + JRST 2TEXGP ;31 RDY -internal to LOOK and the XGP + JRST 2TEXK0 ;32 BJON + JRST 2TEXK0 ;33 BJOFF + MOVEI B,1 ;34 QUOT + MOVEI B,1 ;35 OVR + JRST 2TEXGP ;36 LEOF -internal to LOOK and the XGP + JRST 2TEXGP ;37 BCNT -internal to LOOK and the XGP + MOVEI B,2 ;40 SUP + MOVEI B,2 ;41 SUB + MOVEI B,2 ;42 DCAP + MOVEI B,8. ;43 VEC + MOVEI B,2 ;44 SL + MOVEI B,2 ;45 IL + JRST 2TEXK2 ;46 PAG + JRST 2TEXGP ;47 HED -internal to LOOK and the XGP + JRST 2TEXGP ;50 HEDC -internal to LOOK and the XGP + JRST 2TEXGP ;51 PNUM -internal to LOOK and the XGP + MOVEI B,1 ;52 BLK + MOVEI B,1 ;53 UND + JRST 2TEXKC ;54 SET + JRST 2TEXKC ;55 EXEC + MOVEI B,2 ;56 BAK + JRST 2TEXIC ;57 IMFL + JRST 2TEXIC ;60 VCFL + MOVEI B,2 ;61 A= + MOVEI B,2 ;62 B= + JRST 2TEXK1 ;63 FMT + MOVEI B,8. ;64 RVEC + JRST 2TEXIC ;65 RVFL + MOVEI B,1 ;66 HNUM + JRST 2TEXGP ;67 FNCT -internal to LOOK and the XGP + MOVEI B,1 ;70 BREAK + JRST 2TEXIC ;71 CMFL +XGPMAX==:.-2TEXGT-1 + +2TEXK1: MOVEI B,1 + JRST 2TEXKG + +2TEXK0: TDZA B,B +2TEXK2: MOVEI B,2 +2TEXKG: HRRZ H,SLURPY + CAIE H,XSLURP + JRST 2TXKG2 + PUSH P,CH + 2PATCH 177 + POP P,CH + 2PATCH +2TXKG2: SOJL B,2TEXGP + 2GETCH + JFCL + 2PATCH + JRST 2TXKG2 + +2TEXKC: MOVEI B,(CH) + 2GETCH + CAIA + JRST 2TXKC2 + PUSH P,CH + 2PATCH 177 + 2PATCH (B) + POP P,CH +2TXKC2: 2PATCH + MOVEI B,(CH) + JRST 2TXKG2 + +2TEXIM: 2GETCH ;GET TWO BYTE COUNT + JRST 2TXIM2 + 2PATCH +2TXIM2: MOVEI B,(CH) + LSH B,7 + 2GETCH + JRST 2TXIM3 + 2PATCH +2TXIM3: ADDB CH,B + SOJL B,2TEXGP ;MULTIPLY COUNT BY 3/2 + LSH B,-1 + ADDI B,1(CH) + JRST 2TEXIG +];CMUXGP + +SUBTTL PASS 2 PROCESSING OF FORM FEEDS + +;COME HERE FROM SLURP WHEN ^L SEEN +FFOUT: MOVE A,CODTYP + CAIE A,CODTXT + PUSHJ P,2SUBFL ;IF WE'D JUST MADE A HEADER FOR A CONTIN. PAGE WHICH + JRST FFOUT2 ;NOW ISN'T GOING TO EXIST, FLUSH IT. + TLNE F,FLQPYM ;IT NEEDS A COPYRIGHT MSG + PUSHJ P,OUTLE5 ;(IF 2SUBFL DID ITS JOB, THERE'S ALREADY ONE). +FFOUT2: TRO F,FRLTAB + TRZ F,FRFNT3 +;COME HERE TO START LISTING A NEW PAGE, WHEN FINISHING AN OLD ONE ISN'T NECESSARY. +FFOUT1: SKIPE LNDFIL + PUSHJ P,CKLNM + CAIE H,2PGPR3 ;PUSH OUR H, SO CAN POP AT FFOUT3 AFTER SKIPPING SOME PAGES. + PUSH P,H ;BUT IF CAME FROM THE SKIPPING LOOP, DON'T RE-PUSH. +;DECIDE WHETHER NEXT PAGE NEEDS LISTING. +;IF IT DOESN'T, AND WE'RE NOT CREFFING, SKIP OVER IT +;AND STOP AT THE NEXT PAGE THAT DOES NEED LISTING. + SETZM LSYL ;DOESN'T HURT TO RE-ZERO, AND VITAL TO + SETZM LSYL2 ; COMPARISON WHEN PREV. PAGE NOT LISTED + SKIPN PAGTPT ;NO PAGE TABLE => LIST PAGE IF ITS # IS LARGE ENOUGH. + JRST [ HLRZ CH,N + AOJA CH,2PGPR1] ;CH HAS NEW PAGE'S NUMBER. + IBP PAGTPT + ILDB CH,PAGTPT ;GET PAGE # WORD FOR NEW PAGE. + TLZ CH,-1 + TRNN CH,NEWPAG + JRST 2PGPR2 + LDB CH,[MAJPAG,,CH] ;ELSE LIST IF MAJOR PAGE # LARGE ENOUGH. +2PGPR1: CAML CH,PAGMIN + SKIPA CH,SLURPX ;DO LIST (IF THE FILE IS BEING LISTED) +2PGPR2: MOVEI CH,XSLURP ;DON'T LIST. + MOVEM CH,SLURPY + TLNN F,FLCREF ;IF WE NEED TO LIST THIS PAGE, OR ARE MAKING A CREF, + CAIE CH,XSLURP ;GO TO FFOUT3 TO POP H AND RETURN TO SCAN THE PAGE. + JRST FFOUT3 ;ELSE SKIP QUICKLY OVER THIS PAGE AND THEN GO TO + MOVE CH,CODTYP + CAIN CH,CODTXT + TLNN F,FLXGP ;FOR /L[TEXT]/X FILES, PAGE STRUCTURE IS MORE HAIRY + CAIA ;THAN JUST LOOKING FOR ^L, SO THE FAST-SKIP STUFF WILL LOSE. + JRST FFOUT3 + PUSHJ P,FFOUT4 ;ADVANCE TO NEXT PAGE AND SET WHOLINE. +2PGPR3: ILDB CH,IP + CAIG CH,^M + JRST 2PGPR5 + ILDB CH,IP ;SKIP SUPER-FAST OVER ALL NONSPECIAL CHARACTERS. + CAILE CH,^M + JRST 2PGPR3 +2PGPR5: MOVEI H,2PGPR3 ;HERE, CHAR NEEDS MORE ATTENTION. + JRST XSLUR1 ;SO PAY IT. ^L WILL GO TO FFOUT1; OTHERS, TO 2PGPR3. + +FFOUT3: PUSHJ P,FFOUT4 ;ADVANCE TO NEXT PAGE AND SET WHO-LINE. + SETZM OUTVP + MOVE CH,CODTYP ;/L[TEXT] DOESN'T USE OUTLIN AT ALL. + CAIE CH,CODTXT + PUSHJ P,OUTLEP ;GET READY FOR NEXT LINE AS 1ST OF PAGE; MAYBE SUBTITLE. + MOVEI CH,^L + POPJ P, ;POP P,H (MATCHES FFOUT2) ? JRST (H) + +FFOUT4: TRO N,-1 + ADDI N,1 ;ADVANCE TO LINE 1 OF NEXT PAGE. +ITS,[ + HLRZ CH,N + HRLI CH,(SIXBIT/P2/) + .SUSET [.SWHO3,,CH] +];ITS + POPJ P, + +;COME HERE IF SEE ^L, TO HANDLE THE SITUATION WHERE THE HEADER OF A CONTINUATION PAGE +;(SUBTITLE, "PAGE N") WAS CREATED IN ANTICIPATION, AND THE PAGE TURNS OUT NOT TO EXIST. +;THE LOCATION IN THE OUTPUT BUFFER OF THE BEGINNING OF THE HEADER IS IN SUBTSP. +;SKIPS UNLESS SOMETHING ACTUALLY HAD TO BE FLUSHED. +2SUBFL: MOVE A,OUTVP + CAIG A,1 ;IN FFOUT, DON'T FLUSH HEADER, UNLESS ON CONTINUATION PAGE + JRST 2SUBF2 +2SUBF1: SKIPE SUBTSP ;IF NO HEADER, OR LINES HAVE FOLLOWED IT, DON'T FLUSH IT. + CAME SP,THISSP ;WE HAVE A NON-NULL LINE NOW => DON'T FLUSH HEADER. + JRST 2SUBF2 + MOVE SP,SUBTSP + MOVEM SP,LASTSP + MOVEM SP,THISSP + SOS OUTPAG ;WE HAVE JUST FLUSHED A ^L FROM THE OUTPUT FILE. + JRST OUTNSP + +2SUBF2: CAME SP,THISSP + PUSHJ P,OUTLIN + JRST POPJ1 + + +;;; SUBROUTINE TO PUSH OUT PAGE AND LINE NUMBER OF REFERENCED +;;; SYMBOL (POINTER IN D) IN THE FORM "X999?999X". THE CHARACTER +;;; "?" IS PASSED IN THE LEFT HALF OF D. TWO SPACES ARE OUTPUT +;;; AT THE END (FEWER IF NECESSARY BECAUSE OF 4-DIGIT NUMBERS). + +SPCREF: HRLI D,40 +OUTREF: HLRZ A,S.PAGE(D) + HLRZ B,S.FILE(D) ;FILE SYM IS DEFINED IN + SKIPN REALPG ;IF USER SAYS /Y, OR NO PAGE TABLE, PRINT REAL PAGE #. + SKIPL B,F.PAGT(B) ;ELSE GET PAGE TABLE OF FILE AND PRINT VIRTUAL PAGE #. + JRST [ SETZ B, ? JRST OUTRF2] ;PRINTING REAL PAGE # => SET LINE # OFFSET TO 0. + ADDI B,-1(A) + ADDI B,-1(A) ;POINT TO ENTRY FOR PAGE SYM IS DEF. IN. + MOVE B,1(B) ;GET ITS MAJOR PAGE #, TO PRINT AS PAGE #. + LDB A,[MAJPAG,,B] +OUTRF2: HRRZS (P) + CAIL A,1000. + HRROS (P) ;SIGN OF (P) SET IF SHOULD OMIT THE TRAILING SPACE. + PUSH P,B + PUSHJ P,X999 + POP P,B + HLRZS B ;RH(B) HAS LINE-# OFFSET FOR PAGE. + HLRZ CH,D + 2PATCH + HRRZ A,S.LINE(D) + ADDI A,1(B) + PUSHJ P,999X + SKIPGE (P) + POPJ P, + 2PATCH 40 + POPJ P, + +;;; SUBROUTINE TO PUSH OUT MAJOR/MINOR VIRTUAL PAGE NUMBER. +;;; FIXED FORMAT: X000/000X +;;; IF FILE HAS NO PAGE TABLE, REAL PAGE NUMBER IS OUTPUT. +;;; POINTER TO FILE BLOCK IN IP, REAL PAGE NUMBER IN A. +;;; CLOBBERS A, B, AND D. + +MJMNRF: SKIPL D,F.PAGT(IP) + JRST 000X +REPEAT 2, ADDI D,-1(A) + +;HERE IF D POINTS TO PAGE TABLE ENTRY, TO PRINT VIRTUAL PAGE NUMBER. +MJMNR1: LDB A,[MAJPAG,,1(D)] + PUSHJ P,000X + LDB A,[MINPAG,,1(D)] + JUMPE A,CPOPJ + 2PATCH "/ + JRST 000X + +SUBTTL PASS 2 LISTING OUTPUT PROCESSING + +;;; OUTPUT ONE LINE FOR SLURP. OUTPUTS PAGE AND LINE NUMBERS, +;;; AND SETS UP CROSS REFERENCES FROM POINTERS IN LSYL/LSYL2. +;;; DEPENDING ON THE STATE OF VARIOUS FLAGS, DIFFERENT FORMATS +;;; MAY BE USED. THESE ARE DESCRIBED BELOW: +;;; +;;; I-------I-------I-------I-------I-------I +;;; +;;; -X000---... FLREFS=0 +;;; -X000-X111-111X-... FLREFS=1, MULTI=0 +;;; 000X%%X111-111X-... MULTI=1, FLSHRT=1 +;;; -X000--%%%%%%-X111-111X-... MULTI=1, FLSHRT=0 +;;; X000-X111-111XX222-222X-... FL2REF=1, MULTI=0 +;;; -X000--%%X111-111X--%%X222-222X-... FL2REF=1, FLSHRT=1 +;;; 000X-%%%%%%-X111-111X--%%%%%%-X222-222X-... FL2REF=1, MULTI=1, FLSHRT=0 +;;; +;;; LEGEND: +;;; X EXTRA DIGIT POSITION (NUMBERS NORMALLY 3 DIGITS) +;;; 000 LINE NUMBER +;;; 111 REFERENCE 1 +;;; 222 REFERENCE 2 +;;; %%%% POSITIONS FOR FILE NAME +;;; --- SPACES +;;; ... TEXT (ALWAYS BEGINS AT A TAB STOP) +;;; IF A REFERENCE DOES NOT EXIST, ITS POSITIONS ARE FILLED +;;; WITH SPACES INSTEAD OF THE INDICATED DATA. TABS MUST NOT BE USED - + .SEE OUTNSP ;FOR FURTHER INFO + +OUTLIN: SETZM SUBTSP ;PAGE HEADER ISN'T SUPERFLUOUS IF A LINE FOLLOWS IT + PUSH P,H ;SAVE H + TLNE F,FLFNT2 ;IF USING MULTIPLE FONTS FOR XGP + TLNN F,FLXGP ; MUST OUTPUT MAGIC FONT SHIFT + JRST OUTL0A + 2PATCH 177 ; +ITSXGP,[2PATCH 1 ; + 2PATCH 0 ;FONT 0 +];ITSXGP +CMUXGP, 2PATCH 14 ;SELECT "A" KSET + +OUTL0A: MOVE A,OUTVP ;DIVIDE LINE NUMBER BY PAGEL1 + IDIV A,PAGEL1 + JUMPN B,OUTL0H ;REMAINDER IS 0 => LINE JUST HANDLED WAS THE FIRST + PUSHJ P,OUTLPN ;SO PRINT THE FILENAMES, DATE AND PAGE NUMBERS + PUSHJ P,ENDUND ;(WITH AN UNDERLINE ON THE XGP). +OUTL0H: EXCH SP,LASTSP ;SP POINTS TO PLACE IN BUFFER + MOVE A,OUTVP ; WHERE NEXT LINE BEGINS + IDIV A,PAGEL1 ;THUS LASTSP HAD BEGINNING OF + JUMPN B,OUTL1 ; THIS LINE + AOSN FFSUPR ;IF SUPPRESS FF DESIRED, DON'T OUTPUT FF OR CRLF; + JRST OUTL1A ;OUTNSP SAW THE FLAG AND LEFT LESS SPACE. + 2PAGE ;IF THIS LINE IS FIRST OF NEW PAGE, MUST USE ^L SEQUENCE + JRST OUTL1A + +;AFTER ENDING A LINE THAT'S THE FIRST ON A PHYSICAL OUTPUT PAGE, +;CALL HERE TO OUTPUT THE INPUT FILE NAME, THE DATE AND THE PAGE NUMBER, ALL UNDERLINED. +;CC HAS HORIZ. POSITION IN TEXT AREA. +;A HAS SUBPAGE NUMBER IN LOGICAL OUTPUT PAGE. +;FRWPGN IS SET IFF THIS ROUTINE IS EXECUTING. +;THIS ROUTINE BEGINS AN UNDERLINE AND DOES NOT END IT. +OUTLPN: TROE F,FRWPGN ;IF WE'RE CONTINUEING IN THE MIDDLE OF "PAGE NNN", + POPJ P, ;DON'T TRY RECURSIVELY TO OUTPUT "PAGE NNN". + MOVE H,TLINEL ;TRUNCATION POINT WAS SET LOWER TO MAKE ROOM FOR "PAGE NNN" + HRRM H,2PUTX ;SO SET IT BACK UP, OR ELSE WE'LL CONTINUE. + HRRM H,2PUTNX + MOVEI D,(A) ;SAVE SUBPAGE NUMBER + MOVEI CH,40 +OUTL0B: 2PUTCH ;OUTPUT SPACES UNTIL PLINEL + ADDI CC,1 ; IS REACHED + CAMG CC,PLINEL + JRST OUTL0B + PUSHJ P,BEGUND ;START UNDERLINING IF HAVEN'T ALREADY DONE SO. +ITS,[ MOVE A,CFILE ;PRINT FILE NAMES + MOVE B,F.RFN1(A) + JSP H,OUTSIX + 2PUTCH 40 + ADDI CC,1 + MOVE A,CFILE + MOVE B,F.RFN2(A) + JSP H,OUTSIX +];ITS +NOITS,[ MOVE L,CFILE + PUSHJ P,FILOUT +] + TLNN F,FLDATE + JRST OUTL0W + 2PUTCH 40 + ADDI CC,1 + PUSHJ P,DATOUT ;OUTPUT DATE IN FORM MM/DD/YY +OUTL0W: + MOVEI B,[ASCIZ / Page /] + PUSHJ P,ASCOUT + LDB A,PAGTPT + LDB A,[MAJPAG,,A] ;WHAT MAJOR PAGE # FOR THIS PAGE? + SKIPN PAGTPT + HLRZ A,N + PUSHJ P,ZZZX + SKIPN B,PAGTPT + JRST OUTL0D + IBP B + ILDB B,B + LDB A,PAGTPT + XOR B,A + ANDI A,.BM MINPAG ;WHAT MINOR PAGE #? + TLNN B,.BM MAJPAG ;PRINT MINOR PAGE # IF IT'S NONZERO. PRINT + ; EVEN IF 0 IF NEXT PAGE IS PAGE/1 + JUMPE A,OUTL0D ;NONE + 2PUTCH "/ + PUSHJ P,ZZZX +OUTL0D: SKIPN A,D ;WHAT SUBPAGE #? + JRST OUTL0L ;NONE + 2PUTCH ". + PUSHJ P,ZZZX +OUTL0L: TRZ F,FRWPGN ;WE'VE FINISHED OUTPUTTING THE "PAGE NNN" + POPJ P, + +;CALL HERE AFTER LEAVING SPACE FOR THE REFS ON A LINE, BEFORE SCANNING +;ANY OF THE LINE, IF THAT LINE WILL BE THE FIRST ON A PHYSICAL OUTPUT PAGE. +;IF NO SUBTITLES, INSISTS THAT NEXT LINE BE SHORT TO LEAVE ROOM FOR "PAGE NNN". +;IF SUBTITLES, START NEW PAGE AND WRITE OUT SUBTITLE, LEAVING THINGS SO +;NEXT LINE OF TEXT WILL BE 2ND LINE ON PAGE. IN THIS CASE, MUST FLUSH THE +;SPACE LEFT FOR REFS, AND THEN LEAVE SPACE AGAIN AFTER WRITING THE SUBTITLE. + +;TO PRINT OUT A SUBTITLE, IT MAY BE NECESSARY TO ADVANCE SUBPTR +;TO THE CORRECT SUBTITLE BLOCK FOR THE PAGE ABOUT TO BE PRINTED. + +;IF NEXT PHYS PAGE IS A CONTINUATION PAGE (OUTVP > 0), WE NEED A CPYRT MSG +;TO END THE PREVIOUS PAGE. OTHERWISE, WE ARE COMING FROM FFOUT1 (OUTVP = 0) +;AND CAN ASSUME THAT FFOUT1 PRINTED THE CPYRT MSG IF NECESSARY. +;FFOUT1 DOES THAT BY CALLING OUTLE5. +;ALSO, WE NEVER PUT ANY TEXT ON THE FIRST LINE OF A CONTINUATION PAGE, +;OR THE FIRST LINE OF ANY PAGE WHEN LISTING AN ETV FILE. +OUTLEP: HRRZ A,PLINEL + SUBI A,2 + HRRM A,2PUTX + HRRM A,2PUTNX + MOVE A,CFILE + MOVE A,F.SWIT(A) + MOVE CH,SLURPY ;DON'T OUTPUT SUBTITLE IF FOLLOWING PAGE WON'T BE OUTPUT. +NOITS, JRST OUTLEQ ;IF NOT ITS, DON'T USE 1ST LINE FOR TEXT + SKIPN ETVFIL + SKIPE OUTVP ;ARE WE NOT SUPPOSED TO USE THE 1ST LINE OF THE PAGE? + JRST OUTLEQ + TRNN A,FSSUBT ;ARE THERE SUBTITLES IN THE FILE, + TLNE F,FLQPYM ;OR DO WE WANT COPYRIGHT MESSAGES? +OUTLEQ: CAIN CH,XSLURP ;IS NEXT PAGE REALLY GOING TO BE OUTPUT? + POPJ P, + ;YES; OUTPUT THE CPYRT MSG AND/OR SUBTITLE. + MOVE SP,LASTSP ;SUBTITLE GOES BEFORE THE SPACE WHICH HAS ALREADY BEEN LEFT FOR NEXT LINE'S REFS + PUSH P,H + PUSH P,A + SKIPN OUTVP ;NO CPYRT MSG IF CALLED FROM FFOUT1. + JRST OUTLE4 + TLNE F,FLQPYM ;CPYRT MSG, IF ANY, GOES BEFORE THE FORMFEED. + PUSHJ P,CPYOUB +OUTLE4: AOS B,OUTVP + POP P,A + TRNN A,FSSUBT ;NO SUBTITLE - JUST LEAVE SPACE FOR REFS NOW. + JRST OUTLEA + MOVEM SP,SUBTSP + AOSN FFSUPR + JRST OUTLEC + 2PAGE +OUTLEC: PUSHJ P,BEGUND ;IF WE REALLY HAVE A SUBTITLE, BEGIN AN UNDERLINE NOW. + MOVN CC,NTABS + IMULI CC,8 + ADDI CC,4 ;CC HAS 4 LESS THAN HPOS RELATIVE TO START OF TEXT AREA. + TLNE F,FLNOLN + JRST OUTLED + 2PATCH ^I ;UNLESS /#, HAVE A TAB BEFORE THE SUBTITLE. + ADDI CC,10 +OUTLED: HLRZ C,N + SKIPA A,SUBPTR ;LOOK FOR CORRECT SUBTITLE BLOCK +OUTLE7: HRRZ A,(A) + MOVEM A,SUBPTR +OUTLE0: HRRZ B,1(A) + CAME B,CFILE ;CHECK WHETHER THIS BLOCK IS FOR CURRENT FILE + JRST OUTLE9 + HLRZ B,1(A) + CAMLE B,C ;IF SAME FILE, BUT PAGE NUMBER TOO BIG, WE MUST + JRST OUTLE6 ; BE ON A PAGE BEFORE THE FIRST SUBTITLE IN THE FILE + HRRZ D,(A) ;NOW LOOK AT THE NEXT SUBTITLE BLOCK + JUMPE D,OUTLE8 ;THERE ISN'T ANY, SO USE THIS ONE + HRRZ B,1(D) + CAME B,CFILE + JRST OUTLE8 ;NEXT IS FOR ANOTHER FILE, SO USE THIS ONE + HLRZ B,1(D) + CAMG B,C + JRST OUTLE7 ;WE ARE NOT LESS THAN PAGE NUMBER OF NEXT, SO ADVANCE AND RETRY +OUTLE8: HLRE D,(A) ;A HAS CORRECT BLOCK - GET CHARACTER COUNT + ADD A,[440700,,2] ;GET BYTE POINTER TO ASCII + JUMPN D,OUTLE1 + JRST OUTLE6 ;NULL SUBTITLE?? + +OUTLE9: CAML B,CFILE + .VALUE ;SUBTITLE LIST SCREWED UP + HRRZ A,(A) + MOVEM A,SUBPTR + JUMPE A,OUTLE6 + HRRZ B,1(A) + CAME B,CFILE ;FSSUBT WAS SET, SO THERE MUST BE A SUBTITLE FOR US + JRST OUTLE9 + JRST OUTLE0 + +OUTLE1: ILDB CH,A + 2PATCH ;COPY SUBTITLE TO OUTPUT FILE + ADDI CC,1 + CAMG CC,PLINEL ;STOPPING 4 CHARS BEFORE PLACE "PAGE NNN" SHOULD APPEAR, + AOJL D,OUTLE1 ; OR WHEN WE RUN OUT OF SUBTITLE CHARS +OUTLE6: SUBI CC,4 ;MAKE CC CORRECT HPOS IN TEXT AREA +OUTLEB: MOVE A,OUTVP + IDIV A,PAGEL1 ;AND OUTPUT THE "PAGE NNN" + PUSHJ P,OUTLPN + PUSHJ P,ENDUND ;CLOSE UNDERLINE, IF XGP LISTING. + MOVEM SP,LASTSP + POP P,H + JRST OUTNSP ;LEAVE ONCE AGAIN SPACE FOR REFS OF NEXT LINE. + +OUTLEA: CAIN B,1 ;COME HERE IF NO SUBTITLE. B HAS OUTVP (ALREADY AOS'D) + SKIPE ETVFIL ;ON NON-CONTINUATION PAGE IN NON-ETV FILE, NOTHING TO DO; + CAIA + JRST OUTLE2 ;SO LEAVE SPACE FOR REFS + MOVEM SP,SUBTSP + MOVN CC,NTABS ;ON CONTINUATION PAGE, LEAVE 1ST LINE BLANK EXCEPT FOR "PAGE N" + LSH CC,3 + AOSN FFSUPR + JRST OUTLEB + 2PAGE + JRST OUTLEB + +OUTLE5: MOVE SP,LASTSP + PUSH P,H + PUSHJ P,CPYOUB + AOS OUTVP +OUTLE2: MOVEM SP,LASTSP ;CPYRT MSG BUT NO SUBTITLE COMES HERE. + MOVEI H,OUTLE3 ;OUTVP SHOUDN'T BE CHANGED, BUT TO PREVENT OUTL5A FROM LOOPING + EXCH H,(P) ;BACK TO OUTLEP, WE MUST AOS OUTVP TEMPORARILY, + PUSH P,H ;AND ARRANGE TO SOS IT AGAIN AFTER RETURNING FROM OUTL5A. + JRST OUTL5A + +OUTLE3: SOS OUTVP ;OUTLE2 ARRANGES FOR OUTL5A TO POPJ TO HERE. + POPJ P, + +OUTL1: 2PATCH ^M ;OTHERWISE USE REGULAR ^M ^J + 2PATCH ^J + +;WE HAVE OUTPUT THE CRLF OR FF AND "PAGE N"; NOW FOR LINE # AND REFS. +OUTL1A: LDB A,PAGTPT ;GET LINE NUMBER FOR THIS LINE + HLRZS A + ADDI A,1(N) + TLNE F,FLNOLN + JRST OUTL5 + TLNN F,FLREFS ;NOW DECIDE WHAT FLAVOR OF REFS + JRST OUTL3 + TLNE F,FL2REF + JRST OUT2R + SKIPN MULTI + JRST OUTL2B + TLNN F,FLSHRT + JRST OUTL4 + PUSHJ P,999XS ;*** SINGLE, MULTI-FILE, SHORT +OUT2R3: SKIPE D,LSYL + JRST OUTL2A + MOVEI CH,40 ;NO REF FOR THIS LINE, +REPEAT 2, 2PATCH ; MUST USE SPACES + JRST OUTL2K + +OUTL2A: SETZ A, ;REF FOUND - PRINT FIRST + HLRZ D,1(D) ; TWO CHARS OF FIRST FILE NAME + CAME D,CFILE ; UNLESS SAME AS FILE BEING + LDB A,[360600,,F.RFN1(D)] ; CURRENTLY LISTED + 2PATCH 40(A) + CAME D,CFILE + LDB A,[300600,,F.RFN1(D)] + 2PATCH 40(A) + MOVE D,LSYL + JRST OUTL2D + +OUT2R5: DBP7 SP + JRST OUTL2C + +OUTL2B: 2PATCH 40 ;*** SINGLE, NOT MULTI-FILE +OUT2R1: PUSHJ P,X999S ;*** 2REFS, NOT MULTI *** PUSH OUT LINE NUMBER + 2PATCH 40 +OUTL2C: SKIPE D,LSYL + JRST OUTL2D +OUTL2K: MOVEI CH,40 ;IF NO REF, USE SPACES +REPEAT 10., 2PATCH + JRST OUTL5 + +OUTL2D: PUSHJ P,SPCREF ;PUSH OUT PAGE/LINE NUMBER FOR REFERENCE + JRST OUTL5 + +OUTL3: 2PATCH 40 ;*** NO REFS AT ALL + PUSHJ P,X999S ;JUST PUSH OUT LINE NUMBER + 2PATCH 40 +REPEAT 2, 2PATCH + JRST OUTL5 + +OUT2R: SETOM LSYL1P ;INDICATE TO REF-PRINTING RTNS THAT THE 1ST OF 2 REFS IS BEING HANDLED. + MOVE CH,LSYL ;EXCH LSYL,LSYL2 BECAUSE + EXCH CH,LSYL2 ;THE "FIRST" REF IS IN LSYL2. + MOVEM CH,LSYL + SKIPN MULTI + JRST OUT2R1 + TLNN F,FLSHRT + JRST OUT2R2 + 2PATCH 40 ;*** 2REFS, MULTI-FILE, SHORT. + PUSHJ P,X999S + 2PATCH 40 +OUT2R6: 2PATCH 40 + JRST OUT2R3 + +OUT2R2: PUSHJ P,999XS ;*** 2REFS, MULTI-FILE, LONG. + JRST OUT2R4 + +OUTL4: 2PATCH 40 ;*** SINGLE, MULTI-FILE, LONG + PUSHJ P,X999S ;PUSH OUT LINE NUMBER + 2PATCH 40 +OUT2R4: SKIPN D,LSYL + JRST OUTL4B + 2PATCH 40 + HLRZ A,S.FILE(D) + CAME A,CFILE ; BLANK IF SAME FILE AS ONE + SKIPA B,F.RFN1(A) ; BEING LISTED NOW + SETZ B, +REPEAT 6,[ + SETZ A, + LSHC A,6 + 2PATCH 40(A) +] ;END OF REPEAT 6 + 2PATCH 40 + JRST OUTL2D ;NOW GO DO REST OF REFERENCE + +OUTL4B: MOVEI CH,40 +REPEAT 18., 2PATCH + +;COME HERE AFTER PRINTING 1 REF (OR THE SPACES TO REPLACE IT) +OUTL5: AOSN LSYL1P ;WERE WE PRINTING THE 1ST REF OF TWO? + TLNN F,FL2REF + JRST OUTL5A + MOVE A,LSYL2 ;YES; NOW PRINT THE SECOND. + MOVEM A,LSYL + SKIPN MULTI + JRST OUT2R5 + TLNN F,FLSHRT + JRST OUT2R4 + JRST OUT2R6 + +OUTL5A: SETZM LSYL1P + SETZM LSYL ;CLEAR SYLLABLE INFO + SETZM LSYL2 ; FOR NEXT LINE'S SAKE + HRRZ SP,LASTSP ;RESTORE SP TO END OF THIS LINE + 2OUTBF + HRRM SP,LASTSP ;IF WE DID, MUST UPDATE LASTSP + POP P,H ;UNSAVE H +OUTNSP: HLLZ A,LASTSP ;THIS BUMPS SP BY ENOUGH CHAR + HRR A,RINCR ; POSITIONS EXACTLY TO LEAVE + LDB SP,A ; ROOM FOR REFERENCE DATA + HRR A,LINCR ; (BECAUSE OF THIS METHOD, MAY + LDB B,A ; NOT USE TABS IN REFERENCES!) + ADD SP,LASTSP ;ON THE NEXT TIME THROUGH WE + HLL SP,BINCR(B) ; FILL UP THE GAP + SKIPL FFSUPR ;BUT IF THERE WILL BE A ^L SUPPRESSED BEFORE NEXT LINE, + JRST OUTNS1 + IBP SP ;DON'T LEAVE ROOM FOR IT; BACK UP SP BY 2 + IBP SP ;POSITIONS FOR THE ^M AND ^L + IBP SP + SOS SP +OUTNS1: SETZ CC, + TLNN F,FLFNT2 ;IF USING MULTIPLE XGP FONTS, + JRST OUTL6A ; MORE MAGIC FONT SHIFTS + 2PATCH 177 ; +ITSXGP,[2PATCH 1 ; + MOVEI CH,1 + SKIPE MDLCMT + MOVEI CH,2 + 2PATCH ;FONT 1 (OR 2, IF INSIDE A COMMENT HELD OVER FROM BEFORE). +];ITSXGP +CMUXGP, 2PATCH 15 ;SELECT "B" KSET + +OUTL6A: MOVEM SP,THISSP ;NOW SAVE SP FOR BEGINNING OF TEXT + MOVE A,OUTVP ;IS THE NEXT LINE GOING TO BE 1ST ON A PHYSICAL OUTPUT PG? + IDIV A,PAGEL1 + ADDI B,1 + CAMN B,PAGEL1 + JRST OUTLEP ;MAYBE JUST MAKE SHORTER, MAYBE PRINT SUBTITLE & COME BACK TO OUTL5A + POPJ P, + +;;; MAGIC TABLES USED BY OUTNSP AND OTHERS TO BUMP BYTE +;;; POINTERS IN SP RAPIDLY OVER CERTAIN NUMBERS OF CHARACTER +;;; POSITIONS. STUDY THIS MESS CAREFULLY! + +BINCR: 350700,, + 260700,, + 170700,, + 100700,, + 010700,, + +DEFINE 5BYTES X/ +.BYTE 7 +IRPS Y,,[X] + Y +TERMIN +.BYTE +TERMIN + +RINCR0: 5BYTES 0 0 0 1 1 +RINCR1: 5BYTES 2 2 2 2 2 +RINCR2: 5BYTES 3 3 4 4 4 +RINCR3: 5BYTES 5 5 5 5 6 +RINCR4: 5BYTES 6 7 7 7 7 +RINCR5: 5BYTES 10 10 10 11 11 + +LINCR0: 5BYTES 2 3 4 0 1 +LINCR1: 5BYTES 0 1 2 3 4 +LINCR2: 5BYTES 3 4 0 1 2 +LINCR3: 5BYTES 1 2 3 4 0 +LINCR4: 5BYTES 4 0 1 2 3 +LINCR5: 5BYTES 2 3 4 0 1 + +.BYTE + +BINCR1: 170700,,SLBUF+1 +BINCR2: 350700,,SLBUF+3 +BINCR3: 100700,,SLBUF+4 +BINCR4: 260700,,SLBUF+6 +BINCR5: 010700,,SLBUF+7 + +SUBTTL VARIOUS NUMERICAL PRINT ROUTINES + +;;; ALL NUMERIC OUTPUT ROUTINES TAKE ARGUMENT IN A. + +X999S: AOSN CONTIN ;PRINT NUMBER IN A, OR JUST SPACES IF ON CONTINUATION LINE. + JRST 999X2 + +;PRINT A 4-DIGIT NUMBER, ZERO SUPPRESSING ONLY THE FIRST PLACE. +;THE RIGHT MARGIN OF THE PAGE IS IGNORED - NEVER TRUNCATES OR CONTINUES. +;DOES NOT UPDATE CC. +X999: IDIVI A,100. + IDIVI B,10. + HRLI C,"0(B) + IDIVI A,10. + SKIPN CH,A + SKIPA CH,[40] + ADDI CH,"0 + 2PATCH + 2PATCH "0(B) + HLRZ CH,C + 2PATCH + 2PATCH "0(C) + POPJ P, + +999XS: AOSN CONTIN + JRST 999X2 + +;USUALLY, PRINT 3 DIGITS AND A SPACE, BUT IF ARG IS > 999, +;PRINT 4 DIGITS. IGNORE RIGHT MARGIN. +;DOES NOT UPDATE CC. +999X: IDIVI A,100. + IDIVI B,10. + HRLI C,"0(B) + IDIVI A,10. + JUMPE A,999X1 + 2PATCH "0(A) +999X1: 2PATCH "0(B) + HLRZ CH,C + 2PATCH + 2PATCH "0(C) + JUMPN A,CPOPJ + 2PATCH 40 + POPJ P, + +999X2: 2PATCH 40 +REPEAT 3,2PATCH + POPJ P, + +;PRINT AS MANY DIGITS AS NECESSARY, AND DO TRUNCATE OR CONTINUE IF NEC. +;ALSO, UPDATE THE HORIZONTAL POSITION IN CC. +ZZZX: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,ZZZX + HLRZ A,(P) + 2PUTCH "0(A) + AOJA CC,CPOPJ + +;PRINT AS MANY DIGITS AS NECESSARY, AND IGNORE RIGHT MARGIN, BUT UPDATE CC. +;DOESN'T WORK AT ALL FOR NEGATIVE NUMBERS. +000X: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,000X +OCTP2: HLRZ A,(P) + 2PATCH "0(A) + AOJA CC,CPOPJ + +;OCTAL PRINTOUT OF AS MANY DIGITS AS NECESSARY. +;WORKS FOR NEGATIVE NUMBERS. UPDATES CC BUT IGNORES RIGHT MARGIN. +OCTP: LSHC A,-3 + LSH B,-41 + HRLM B,(P) + JUMPE A,OCTP2 + PUSHJ P,OCTP + JRST OCTP2 + +;;; PRINT ROMAN NUMERALS. +;;; NUMBER TO PRINT IN A. CLOBBERS A, B, C, AND D. + +ROMAN: ANDI A,7777 ;FOR SAFETY'S SAKE +IRP 1,,[M,C,X,I]5,6,[Q,D,L,V]10,,[Z,M,C,X]10.,,[1000.,100.,10.,1.] + MOVEI CH,"1 + MOVEI C,"10 + MOVEI D,"5 +IFSN [6],[ + IDIVI A,10. + PUSHJ P,ROMAN1 +] ;EMD OF IFSN [6], +TERMIN +ROMAN1: EXCH B,A + MOVNI B,(B) + JRST ROMAN0(B) + + JRST [ 2PATCH + 2PATCH (C) + POPJ P, ] ;9 + JFCL ;8 + JFCL ;7 + JFCL ;6 + JRST [ EXCH CH,D + 2PATCH + MOVEI CH,(D) + JRST ROMAN0+5(B) ] ;5 + JRST [ 2PATCH + 2PATCH (D) + POPJ P, ] ;4 + 2PATCH ;3 + 2PATCH ;2 + 2PATCH ;1 +ROMAN0: POPJ P, ;0 + +;PRINT THE CURRENT DATE, AS MM/DD/YY, ADDING HH:MM AT CMU. +;CLOBBERS A,B,CH,H +DATOUT: +ITS,[ .RDATE B, ;RETURNS YYMMDD + ROT B,14 ;GET IN FORM MMDDYY +IRPC X,,[ //] + 2PUTCH "X + ADDI CC,1 +REPEAT 2,[ + SETZ A, + LSHC A,6 + 2PUTCH 40(A) + ADDI CC,1 +] ;END OF REPEAT 2 +TERMIN + POPJ P, +] ;ITS +DOS,[ PUSH P,C ; IS THIS PUSH REALLY NECESSARY? + DATE A, ; GET DATE + IDIVI A,31. ; GET DAYS + PUSH P,B ; SAVE THEM + IDIVI A,12. ; GET MONTHS + JSP H,DEC2TY ; TYPE IT + 2PUTCH "/ + AOJ CC, + POP P,B ; RESTORE B + JSP H,DEC2TY ; TYPE DAYS + 2PUTCH "/ + AOJ CC, + MOVEI B,63.(A) ; GET YEARS + JSP H,DEC2TY ; TYPE IT + 2PUTCH 40 + AOJ CC, +CMU,[ + MSTIME B, + IDIVI B,60.*1000. + IMULI B,60.*1000. + PUSHJ P,PMSTIM + ADDI CC,5 +];CMU + JRST POPCJ + +DEC2TY: AOJ B, ;PRINT (B)+1 AS A 2-CHAR DECIMAL NUMBER. + IDIVI B,10. ; SEPARATE + 2PUTCH "0(B) + 2PUTCH "0(C) + ADDI CC,2 + JRST (H) +] ;DOS + +SUBTTL VARIOUS OUTPUT UTILITY ROUTINES + +;TYPE CRLF. CALL WITH PUSHJ. UPDATES CC AND OUTVP. +CRLOUT: SETZ CC, + 2PATCH ^M + 2PATCH ^J + AOS OUTVP + POPJ P, + +;OUTPUT SIXBIT WORD IN B. UPDATES CC. CALL WITH JSP H,. +;DOES NOT TRUNCATE OR CONTINUE. +SIXOUT: JUMPE B,(H) + SETZ A, + LSHC A,6 + 2PATCH 40(A) + AOJA CC,SIXOUT + +;OUTPUT ASCIZ STRING POINTED TO BY ADDRESS IN B. +;UPDATES CC AND OUTVP. CRLF'S MAY BE INCLUDED. +;TABS AND MULTI-POSITION CHARS ARE NOT UNDERSTOOD. +ASCOUT: HRLI B,440700 +ASCOU1: ILDB CH,B + JUMPE CH,CPOPJ + CAIN CH,^M + JRST [ IBP B ;SKIP THE LF ASSUMED TO FOLLOW EVERY CR + PUSHJ P,CRLOUT ;OUTPUT THE CR AND LF, SETTING VARS APPROPRIATELY. + JRST ASCOU1] + 2PATCH + AOJA CC,ASCOU1 + +;LIKE SIXOUT BUT DOES TRUNCATE OR CONTINUE IF NEC. +OUTSIX: JUMPE B,(H) + SETZ A, + LSHC A,6 + 2PUTCH 40(A) + AOJA CC,OUTSIX + +;OUTPUT THE NAME OF A SYMBOL, WHEN R POINTS AT ITS SYMBOL TABLE ENTRY. +;C SHOULD CONTAIN THE SIZE TO TRUNCATE TO (DECREMENTED). +;UPDATES COLUMN COUNTER IN CC. CLOBBERS A, B, D, H. + +SYMOUT: TLNE F,FLARB+FLASCI + JRST SYMOU0 + MOVE B,(R) ;OUTPUT A 1-WORD SIXBIT SYMBOL NAME. + TLC B,400000 + ADD C,CC + JSP H,SIXOUT + SUB C,CC + POPJ P, + +SYMOU0: MOVE D,(R) ;GET AOBJN POINTER TO MULTI-WORD NAME. +;HERE TO OUTPUT A SYMBOL TYPE, AOBJN PTR IN D. +SYMOU1: MOVE B,(D) ;GET NEXT WORD OF MULTI-WORD SYMBOL + TLC B,400000 +SYMOU2: JUMPE B,SYMOU3 ;ARE WE FINISHED WITH THIS WORD OF THE SYMBOL? + SETZ A, + LSHC A,6 ;NO; GET THE NEXT CHARACTER. + TLNE F,FLASCI + LSHC A,1 ;IF ASCII, SHIFT 7 BITS. + TLNN F,FLASCI + ADDI A,40 ;IF SIXBIT, SHIFT 6 BITS BUT ADD 40. + 2PATCH (A) ;OUTPUT THE CHARACTER, + ADDI CC,1 ;INCREMENT COLUMN COUNTER. + SOJG C,SYMOU2 + POPJ P, + +SYMOU3: AOBJN D,SYMOU1 ;GET ANOTHER WORD, IF ANY + POPJ P, + +;PAD OUT C(C) COLUMNS WITH A SPACE AND DOTS. IF SYMBOLS ARE JUST 6 CHARS, USE ONLY SPACES. +DOTPAD: JUMPE C,CPOPJ + MOVEI CH,40 +DOTPA1: 2PATCH + CAIE C,2 + TLNN F,FLARB + CAIA + MOVEI CH,". + SOJG C,DOTPA1 + POPJ P, + +;L -> FILEBLOCK; PRINT REAL FILE NAMES. +FILOUT: PUSH P,C + SKIPE B,F.RDEV(L) + CAMN B,MACHINE ;IF DEVICE IS UNSPEC'D, OR "DSK", OR EQUIVALENT, + JRST FILOU1 ;DON'T MENTION IT. + CAMN B,[SIXBIT/DSK/] + JRST FILOU1 + JRST FILOU7 + +;LIKE FILOUT, BUT IF DEVICE IS DSK OR EQUIVALENT, PRINT THE MACHINE NAME INSTEAD OF NOTHING. +FILOUM: PUSH P,C + SKIPE B,F.RDEV(L) + CAMN B,[SIXBIT/DSK/] + MOVE B,MACHINE +FILOU7: JSP H,FNMOUT + MOVEI CH,": + PUSHJ P,CHROUT +FILOU1: +ITS,[ SKIPN B,F.RSNM(L) ;IF .RCHST THOUGHT SNAME WAS IMPORTANT, MENTION IT. + JRST FILOU2 + JSP H,FNMOUT + MOVEI CH,"; + PUSHJ P,CHROUT +FILOU2: +];ITS + MOVE B,F.RFN1(L) + JSP H,FNMOUT + SKIPN B,F.RFN2(L) + JRST FILOU3 +ITS, MOVEI CH,40 +NOITS, MOVEI CH,". + PUSHJ P,CHROUT + JSP H,FNMOUT +FILOU3: +DOS,[ SKIPN B,F.RSNM(L) ;Was there a PPN?? + JRST FILOU4 ;NO + MOVEI CH,"[ ;] + PUSHJ P,CHROUT +SAI,[ PUSH P,B ;SAIL PPN'S ARE TWO HALFWORDS OF RIGHT-JUSTIFIED 6BIT. + ANDCMI B,-1 + PUSHJ P,FILOUS + 2PATCH [",] + POP P,B + HRLZS B + PUSHJ P,FILOUS + JRST FILOU5 + +FILOUS: ;PRINT RIGHT-JUSTIFIED SIXBIT, SANS LEADING SPACES. + JUMPE B,CPOPJ + SETZ A, + LSHC A,6 + JUMPE A,.-1 + MOVEI CH,40(A) + PUSHJ P,CHROUT + JRST FILOUS +];SAI +NOSAI,[ + JUMPL B,[ JSP H,SIXOUT ;DEC OR CMU => NEGATIVE PPN IS SIXBIT. + JRST FILOU5 ] +CMU,[ MOVEI B,PPNBUF ;ELSE NUMERIC PPN. ON CMU, CONVERT TO CMU-STYLE. + HRLI B,F.RSNM(L) + DECCMU B, + JRST FILOU6 + PUSHJ P,ASCOUT + JRST FILOU5 +FILOU6: +];CMU + HLRZ A,F.RSNM(L) ;NUMERIC PPN AND NOT CMU => PRINT HALFWORDS IN OCTAL. + PUSHJ P,OCTP + 2PATCH [",] + HRRZ A,F.RSNM(L) + PUSHJ P,OCTP +];NOSAI ;[ +FILOU5: MOVEI CH,"] + PUSHJ P,CHROUT +FILOU4:: +];DOS +POPCJ: POP P,C + POPJ P, + +NOITS,FNMOUT==:SIXOUT +ITS,[ +;PRINT A WORD OF SIXBIT IN B, OPTIONALLY QUOTING WITH ^Q ANY SPECIAL CHARACTERS. +;QUOTING IS ENABLED IF FQUOTF IS NONZERO. OTHERWISE, THIS IS THE SAME AS SIXOUT. +FNMOUT: SKIPN FQUOTF + JRST SIXOUT + JUMPE B,(H) + SETZ A, + LSHC A,6 + CAIE A,0 + CAIN A,', + PUSHJ P,CTQOUT + CAIE A,'_ + CAIN A,/ + PUSHJ P,CTQOUT + 2PATCH 40(A) + AOJA CC,FNMOUT + +CTQOUT: 2PATCH ^Q + ADDI CC,2 + POPJ P, +];END ITS, + +SUBTTL COPYRIGHT MESSAGE OUTPUT ROUTINES + +;LINEFEED DOWN TILL REACH BEGINNING OF LAST LINE OF CURRENT PAGE. +CPYBOT: MOVE C,OUTVP + IDIV C,PAGEL1 ; FOR COPYRIGHT MSG + SUB D,PAGEL1 +CPYBO1: AOJGE D,2OUTPJ + 2PATCH ^M + 2PATCH ^J + AOS OUTVP + JRST CPYBO1 + +CPYOUB: PUSHJ P,CPYBOT ;GO TO PAGE BOTTOM AND OUTPUT CPYRT MSG. +CPYOUT: MOVEI C,5*LCPYMSG ;OUTPUT COPYRIGHT MSG + MOVE D,[440700,,CPYMSG] +CPYOU1: ILDB CH,D + JUMPE CH,CPYOU2 + 2PATCH +CPYOU2: SOJG C,CPYOU1 + JRST 2OUTPJ + +CPYSAY: MOVEI C,5*LCPYMSG-4 ;JUST SAY WHAT COPYRIGHT MSG IS, WITHOUT DOUBLE CRLF + MOVE D,[100700,,CPYMSG] + JRST CPYOU1 + +;OUTPUT A PAGE BOUNDARY, PRECEDED IF NECESSARY BY A CPYRT MSG. +;SETS OUTVP TO 0. +CPYPAG: PUSH P,A + PUSH P,C + PUSH P,D + MOVE A,OUTVP ;IF OUTVP=PAGEL, IT'S BECAUSE OF A SEQUENCE SUCH AS + CAMN A,PAGEL1 ;AOS OUTVP ? IF OUTVP=PAGEL THEN CPYPAG ELSE CRLOUT, + SOS OUTVP ;SO OUTVP REALLY SHOULD BE PAGEL-1 IN THIS CASE. + TLNE F,FLQPYM + PUSHJ P,CPYOUB + 2PAGE + SETZM OUTVP + POP P,D +POPCAJ: POP P,C + JRST POPAJ + +SUBTTL UNDERLINING ROUTINES + +;BEGIN UNDERLINING. HAS NO EFFECT IF NOT AN XGP LISTING OR IF ALREADY UNDERLINING. +BEGUND: SKIPN UNDRLN + TLNN F,FLXGP + POPJ P, + SETOM UNDRLN + 2PATCH 177 +ITSXGP,[2PATCH 1 + 2PATCH 46 +];ITSXGP +CMUXGP,[2PATCH 53 + 2PATCH 30 +];CMUXGP + POPJ P, + +;STOP UNDERLINING. +ENDUND: SKIPE UNDRLN + TLNN F,FLXGP + POPJ P, + SETZM UNDRLN + 2PATCH 177 +ITSXGP,[2PATCH 1 + 2PATCH 47 + 2PATCH 2 +];ITSXGP +CMUXGP,[2PATCH 53 + 2PATCH 0 +];CMUXGP + POPJ P, + +SUBTTL PRINT A TITLE PAGE + +;;; INITIALIZES OUTVP TO 0. +;;; DOES NOT PRINT ANY FORMFEEDS. +;;; ENDS WITH A CPYRT MSG (IF APPROPRIATE). + +TITLCR==:7 ;NUMBER OF CRLF'S EXPLICITLY PRINTED BY TITLES + +TITLES: SETZM OUTVP + PUSHJ P,PTLAB ;PRINT "AI:FOO; BAR DATES,ETC. COMPARED WITH..." + TRZ F,FRPSHRT + MOVE A,OUTVP ;NOW FIGURE OUT HOW MANY LINES THIS PAGE WILL TAKE + ADDI A,TITLCR+SWPRCR+2*MOBYCR(A) + MOVE C,SFILE ;IF WE USE 3 LINES PER CHARACTER SECTION IN BIGPRINTING. + SUBI C,FILES+LFBLOK + IDIVI C,LFBLOK ;THIS IS APPROX # OF FILES WE WILL HAVE TO MENTION. + MOVE R,LINEL + IDIVI R,FNAMCW ;# OF FILENAMES PER LINE. + IDIVI C,(R) ;# LINES NEEDED TO LIST NAMES OF FILES. + SKIPE MULTI + ADD A,C + CAMLE A,PAGEL1 ;WILL WE FIT WITH 3 LINES/SECTION? + TRO F,FRPSHRT ;NO; SHRINK THE CHARS VERTICALLY WHILE BIGPRINTING. + HRRZ B,CFILE + MOVE H,F.RFN1(B) + PUSHJ P,MOBY ;BIGPRINT THE FN1. + PUSHJ P,CRLOUT + PUSHJ P,CRLOUT + SKIPE MULTI + JRST TITLE1 + PUSHJ P,CRLOUT + PUSHJ P,CRLOUT +TITLE1: PUSHJ P,PTLAB ;PRINT THE HEADER LINE AGAIN, + HRRZ B,CFILE + MOVE H,F.RFN2(B) + PUSHJ P,MOBY ;THEN BIGPRINT THE FN2. + PUSHJ P,CRLOUT + MOVE R,LINEL + IDIVI R,FNAMCW + SKIPN MULTI ;IN A MULTI-FILE LISTING, MENTION NAMES OF ALL INPUT FILES. + JRST TITLE2 + MOVEI B,FILSRT + MOVEI D,0 ;D SAYS # OF FILENAMES THERE'S ROOM FOR ON THIS LINE. +TITLE8: MOVE L,(B) ;IGNORING THIS FILE? + MOVE L,F.SWIT(L) + TRNE L,FSNOIN + JRST TITLE5 ;YES, DON'T LIST IT + SOJL D,TITLE3 ;ROOM FOR FILENAMES ON CURRENT LINE? + MOVNS CC ;YES => ALIGN IN COLUMNS. + ADDI CC,FNAMCW-2 ;# SPACES WE NEED. + MOVEI CH,40 +TITLE7: 2PATCH + SOJG CC,TITLE7 + JRST TITLE4 + +TITLE3: PUSHJ P,2OUTPJ ;NO => GO TO NEXT LINE. + MOVEI D,-1(R) + PUSHJ P,CRLOUT +TITLE4: SETZ CC, + MOVE L,(B) + PUSH P,B + PUSHJ P,FILOUT ;PRINT FILENAMES. + POP P,B +TITLE5: SKIPE 1(B) + AOJA B,TITLE8 + PUSHJ P,CRLOUT +TITLE2: PUSHJ P,CRLOUT + PUSHJ P,CRLOUT + PUSHJ P,SWPRIN ;DESCRIBE THE SWITCH SETTINGS WE WERE USING. + PUSHJ P,LRPRIN ;GIVE NAME OF LREC FILE + TLNN F,FLQPYM + JRST 2OUTPJ + JRST CPYOUB + +SUBTTL PRINT OUT SETTINGS OF ALL SWITCHES + +;;; THIS PRINTOUT GOES IN THE TITLE PAGE. CLOBBERS ALL ACS. + +;HANDLE A SWITCH THAT JUST SETS A BIT IN AN AC. +DEFINE SWPR1 SIDE,FLAG,CHAR,+AC=F,SENSE=E,+ + MOVEI CH,"CHAR + T!SIDE!N!SENSE AC,FLAG + PUSHJ P,SWPRSW +TERMIN + +;HANDLE A SWITCH THAT SETS A NUMBER. +DEFINE SWPRN NUMBER,CHAR + SKIPE A,NUMBER + PUSHJ P,SWPRN1 + JFCL "CHAR +TERMIN + +SWPRCR==:3 ;SWPRIN IS UNLIKELY TO USE MORE THAN 3 LINES. + +SWPRIN: MOVEI B,[ASCIZ /Switch Settings: /] + PUSHJ P,ASCOUT +;FIRST, MENTION THE L AND MAYBE C SWITCHES, BECAUSE THEY ARE LIKELY TO BE LONG, +;AND IT IS NICE IF THEY DON'T RISK RUNNING OVER LINEL. + PUSHJ P,SWPRL ;L ;SAY WHAT LANGUAGE. + SKIPE CRFOFL ;IF A CREF-OUTPUT-FILE IS SPEC'D, STATE THAT HERE. + PUSHJ P,SWPRC ;C ;OTHERWISE, C-SWITCH WON'T BE LONG AND CAN GO LATER. + PUSHJ P,SWPRO + MOVE R,CFILE ;R HAS POINTER TO FILE BLOCK OF CURRENT FILE. + MOVE D,F.SWIT(R) ;D HAS THE PER-FILE SWITCHES OF CURRENT FILE. + SWPR1 L,FLNOLN ,# + SWPR1 R,FSNSMT ,$,AC=D + SWPR1 L,FLDATE ,% + SWPR1 R,FSLREC ,@,AC=D + SWPRN SYMTRN ,A + SWPR1 L,FLARB ,A + SKIPE CRFOFL + JRST SWPRI1 + SWPR1 L,FLCREF ,C ;HANDLE C-SWITCH HERE IF IT IS SHORT. + SWPRI1: SWPR1 L,FLSHRT ,D + TLNE F,FLFNT2+FLFNT3 + PUSHJ P,SWPRF ;F ;(JUST FOR PREFIX ARG) + SWPR1 R,FSGET ,G,AC=D + SWPR1 L,FLBS ,H + MOVEI B,[ASCIZ /1J /] + SKIPN NORENUM ;1G + TRNE D,FSLRNM ;1J + PUSHJ P,ASCOUT ;1J AND 1G + MOVEI B,[ASCIZ /-J /] + SKIPN NOCOMP ;-G + TRNE D,FSLALL ;-J + PUSHJ P,ASCOUT ;-J AND -G + SWPR1 L,FLINSRT ,I + MOVEI CH, "K + SKIPE PRLSN + PUSHJ P,SWPRSW + SWPR1 R,FSMAIN ,M,AC=D + SWPR1 L,FLREFS ,N,SENSE=N + SWPRN F.MINP(R) ,P + SWPR1 L,FLSCR ,R + MOVE A,CODTYP + CAIE A,CODRND + CAIN A,CODTXT + JRST NOSYMT + MOVE A,SYMLEN + IDIVI A,LSENT + CAIE A,SYMDLN/LSENT + PUSHJ P,SWPRN1 + JFCL "S +NOSYMT: MOVEI CH, "S + SKIPE SINGLE + PUSHJ P,SWPRSW + SKIPL A,TRUNCP + PUSHJ P,SWPRN1 + JFCL "T + SWPRN UNIVCT ,U + PUSHJ P,SWPRV ;V ;MENTION VSP OR PAGEL + SWPRN LINEL ,W + PUSHJ P,SWPRX ;X ;MAYBE ALSO PRINT [NOQUEUE] + MOVEI CH, "Y + SKIPE REALPG + PUSHJ P,SWPRSW + SWPR1 L,FLSUBT ,Z + SWPR1 L,FLCTL ,^ + SKIPE A,NXFDSP + PUSHJ P,SWPRSN + JFCL "! + SKIPE FNTSPC + PUSHJ P,SWPRFF ;MENTION SPEC'D FONT FILES IF ANY. + TLNE F,FLQPYM + PUSHJ P,SWPRQ ;MENTION COPYRIGHT MSG IF ANY + JRST CRLOUT + +;CR IF TOO CLOSE TO END OF LINE; THEN PRINT CHAR IN CH, AND A SPACE. +SWPRSW: HRLM CH,(P) + MOVEI CH,4(CC) + CAML CH,LINEL + PUSHJ P,CRLOUT + HLRZ CH,(P) +CSPOUT: AOS CC + 2PATCH +SPCOUT: MOVEI CH,40 +CHROUT: 2PATCH + AOJA CC,CPOPJ + +;PRINT OUT AN F-SWITCH DESCRIBING NUMBER OF FONTS. +SWPRF: MOVEI CH,5(CC) + CAML CH,LINEL + PUSHJ P,CRLOUT + MOVEI CH,"2 + TLNE F,FLFNT3 + MOVEI CH,"3 ;HOW MANY FONTS? + PUSHJ P,CHROUT + MOVEI CH,"F + JRST CSPOUT + +;PRINT OUT AN F-SWITCH DESCRIBING THE NAMES OF THE FONTS. +SWPRFF: MOVEI B,[ASCIZ/ +Fonts: F[/] + PUSHJ P,ASCOUT ;MENTION THEIR NAMES, WITHIN BRACKETS. + PUSHJ P,2OUTF1 +SWPRF2: MOVEI CH,"] + JRST CSPOUT + +;PRINT OUT AN L-SWITCH SAYING WHICH LANGUAGE THE LISTING IS OF. +SWPRL: MOVSI B,(SIXBIT \L[\) ;] + JSP H,SIXOUT + MOVE CH,CODTYP + MOVE B,SWPRLT(CH) + JSP H,SIXOUT + JRST SWPRF2 + +SWPRLT: OFFSET -. ;TABLE RELATING INTERNAL LANGUAGE CODES TO LANGUAGE NAMES. +CODMID::SIXBIT/MIDAS/ +CODRND::SIXBIT/RANDOM/ +CODFAI::SIXBIT/FAIL/ +CODP11::SIXBIT/PALX11/ +CODLSP::SIXBIT/LISP/ +CODM10::SIXBIT/MACRO/ +CODUCO::SIXBIT/UCONS/ +CODTXT::SIXBIT/TEXT/ +CODMDL::SIXBIT/MUDDLE/ +CODDAP::SIXBIT/DAPX16/ +CODMAX::OFFSET 0 + +;HANDLE /X, EITHER FOR FLXGP, OR FOR QUEUE. +SWPRX: TLNN F,FLXGP + SKIPE QUEUE + CAIA + POPJ P, + MOVEI CH,12.(CC) + CAML CH,LINEL + PUSHJ P,CRLOUT + MOVEI CH,"- + TLNN F,FLXGP ;IF /-X, AND MENTIONING /X BECAUSE /X[NO] OR /X[GOULD], + PUSHJ P,CHROUT ;PUT IN THE MINUS SIGN. + MOVEI CH,"X + PUSHJ P,CHROUT + MOVE CH,QUEUE + CAIN CH,QU.YES ;IF QUEUE HAS DEFAULT VALUE, DON'T MENTION IT. + JRST SPCOUT + MOVEI B,[ASCIZ /[Noqueue]/] + CAIN CH,QU.GLD + MOVEI B,[ASCIZ /[Gould]/] + PUSHJ P,ASCOUT + JRST SPCOUT + +SWPRO: MOVSI CH,-4 + SKIPN OUTFIL(CH) + AOBJN CH,.-1 + JUMPGE CH,CPOPJ + MOVSI B,(SIXBIT\O[\) ;] + JSP H,SIXOUT + MOVEI L,OUTFIL-F.RSNM + PUSHJ P,FILOUT + JRST SWPRF2 + +; SKIPE A,NUMBER +; PUSHJ P,SWPRN1 ;PRINT THE NUMBER AND THE CHAR +; JFCL "CHAR +SWPRN1: MOVEI CH,8(CC) + CAML CH,LINEL ;MAKE SURE THERE IS ROOM ON THIS LINE FOR WHAT WE WANT TO PRINT. + PUSHJ P,CRLOUT + JUMPGE A,SWPRN2 + 2PATCH "- ;PRINT A "-" FOR NEGATIVE ARGUMENTS + AOS CC + MOVNS A +SWPRN2: PUSHJ P,000X ;FIRST, PRINT THE NUMBER IN A. +SWPRN3: HRRZ CH,@(P) ;THEN GET THE CHARACTER IN THE RH OF WORD AFTER PUSHJ + JRST CSPOUT ;AND PRINT IT (DON'T NEED TO AOS (P) OVER THE JFCL). + +; MOVE A,NUMBER +; PUSHJ P,SWPRSN ;PRINT THE SIGN OF THE NUMBER, AND THE CHAR. +; JFCL "CHAR ;THE SIGN IS PRINTED AS "-", "0" OR "1". +SWPRSN: MOVEI CH,4(CC) + CAML CH,LINEL + PUSHJ P,CRLOUT + MOVEI CH,"0 + SKIPGE A + MOVEI CH,"- + SKIPLE A + MOVEI CH,"1 + 2PATCH + JRST SWPRN3 + +;HANDLE THE V SWITCH, WHICH IS FUNNY BECAUSE THERE ARE TWO VARIABLES IT CAN SET. +;WE MUST PRINT OUT A SPEC TO SET EITHER OR BOTH. +SWPRV: MOVE A,FNTVSP + CAIE A,VSPNRM ;IF VSP ISN'T THE DEFAULT VALUE, MENTION ITS VALUE. + PUSHJ P,SWPRN1 + JFCL "V + MOVE A,PAGEL + PUSHJ P,SWPRN1 ;STATE THE VALUE OF PAGEL ALSO. + JFCL "V + POPJ P, + +;HANDLE THE C-SWITCH, IN CASE IT HAS TO CONTAIN A FILENAME (CRFOFL NONZERO). +SWPRC: MOVEI CH,"- ;IF WE DON'T WANT A CREF (AND WE'RE HERE BECAUSE CRFOFL IS SET) + TLNN F,FLCREF + PUSHJ P,CHROUT ;SAY SO WITH A MINUS. + MOVEI CH,"C + PUSHJ P,CHROUT + MOVEI CH,"[ ;] ;NOW GIVE SPEC'D NAMES OF CREF-OUTPUT-FILE. + PUSHJ P,CHROUT + MOVEI L,CRFSNM-F.RSNM + PUSHJ P,FILOUT + JRST SWPRF2 + +;HANDLE THE Q SWITCH +SWPRQ: PUSHJ P,CRLOUT + MOVSI B,(SIXBIT \Q[\) ;] + JSP H,SIXOUT + PUSHJ P,CPYSAY ;[ + MOVEI CH,"] + JRST CHROUT + +;DESCRIBE LREC FILE +LRPRIN: SKIPN L,WLRECP ;GET POINTER TO LREC OUTPUT FILE, IF ANY, + MOVE L,RLRECP ;ELSE GET POINTER TO LREC INPUT FILE. + JUMPE L,CPOPJ ;IF THERE'S EITHER ONE, WE SHOULD PRINT ITS NAME. + CAME L,WLRECP ;IF IT'S THE OUTPUT FILE, USE THE OUTPUT NAMES, ELSE THE INPUT. + ADDI L,F.IFN1-F.OFN1 + PUSH P,F.OFN2(L) + MOVE B,LRCFN2 + SKIPN F.OFN2(L) + MOVEM B,F.OFN2(L) + MOVEI B,[ASCIZ/LREC File: /] + PUSHJ P,ASCOUT + ADDI L,F.OFN1-F.RFN1 + PUSHJ P,FILOUM + POP P,F.RFN2(L) + JRST CRLOUT + +SUBTTL PRINT HEADER (DATE, PHASE OF MOON, ETC.) + +;;; PTLAB PRINTS 1, 2, OR 3 LINES GIVING DIRECTORY OF CURRENT FILE, +;;; NAME OF USER, DATE OF LISTING, DATE OF FILE, +;;; AND VERSION COMPARED WITH IF ANY. UPDATES N. +;;; PRINTS A CRLF AFTER EACH LINE OF TEXT. + +ITS,[ +PTLAB: HRRZ L,CFILE ;*** FILE NAME + PUSHJ P,FILOUM + MOVEI CH,40 +REPEAT 4, 2PATCH + .SUSET [.RUNAM,,B] ;*** NAME OF LOSER DOING LISTING + JSP H,SIXOUT + MOVEI CH,40 +REPEAT 4, 2PATCH + .CALL [ SETZ ? 'RQDATE ? SETZM R] + JRST PTLAB6 + PUSHJ P,PTQDAT +PTLAB6: PUSHJ P,CRLOUT + DROPTHRUTO PTLAB9 +];ITS + +SUBTTL PRINT HEADER (DATE, PHASE OF MOON, ETC.) + +DOS,[ +PTLAB: +NOSAI,[ ; SAIL DOESN'T HAVE GETTAB'S, SAVE SOME HASSLE + MOVEI B,SYSBUF ;*** SYSTEM NAME +PTLAB5: HLLZ A,B + TRO A,11 ;GETTAB FROM TABLE 11 + GETTAB A, ;GET SYSTEM NAME IN ASCII + JRST [ SKIPE B,MACHINE + JSP H,SIXOUT + JRST PTLAB0 ] + MOVEM A,(B) + SKIPE SYSBUF+6 ; SCREW WITH TWENEX SYSTEM NAME? + JRST PTLAB6 ; YES, IT CAN BE 7 WORDS, AND ALSO MAY + ; NOT HAVE AN ENDING! + TRNE A,376 ;END OF ASCIZ TEXT YET? + AOBJP B,PTLAB5 ;NO, GET SOME MORE +PTLAB6: MOVEI B,SYSBUF + PUSHJ P,ASCOUT +];NOSAI +SAI, MOVE B,MACHINE ; USE MACHINE NAME +SAI, JSP H,SIXOUT + +PTLAB0: 2PATCH 40 + GETPPN B, ; GET USER PPN + JFCL ; (JACCT SKIP) +SAI,[ TRNE B,-1 ; KLUDGE FOR DECUUO + HRLZS B ; GET JUST PROGRAMMER NAME + JSP H,SIXOUT] ; AND OUTPUT IT +NOSAI,[ JUMPL B,[JSP H,SIXOUT ; IN CASE SIXBIT PPN + JRST PTLAB1 ] +CMU,[ MOVE A,[B,,PPNBUF] + DECCMU A, + JRST PTLAB2 + MOVEI B,PPNBUF + PUSHJ P,ASCOUT + JRST PTLAB1 +PTLAB2: +];CMU + PUSH P,B ; SAVE PPN + HLRZ A,B ; GET PROJECT NUMBER + PUSHJ P,OCTP ; PRINT IT + POP P,B ; RESTORE PPN + 2PATCH [",] ; A COMMA + HRRZ A,B ; PROGRAMMER # + PUSHJ P,OCTP ; PRINT IT +];NOSAI +PTLAB1: MOVEI CH,40 ; SPACE OVER +REPEAT 4,2PATCH +NOSAI,[ ;SAIL DOESN'T HAVE GETTAB'S, AND IT SEEMS SILLY TO WRITE CODE TO LOOK + ; AT LAB[F,ACT] AND BOP LAST NAME OVER AND ALL THAT. + HRROI B,31 ; .GTNM1 + GETTAB B, ; GET FIRST HALF OF USER NAME + SETZ B, ; SICK MONITOR + MOVEI C,(B) ; SAVE LAST CHAR + JSP H,SIXOUT + TRNE C,77 ; WAS LAST CHAR A SPACE? + JRST PTLB1A ; NO + 2PATCH 40 ; YES, PRINT A SPACE +PTLB1A: HRROI B,32 ; .GTNM2 + GETTAB B, ; GET SECOND HALF OF USER NAME + SETZ B, ; SICK MONITOR + JSP H,SIXOUT + MOVEI CH,40 ; INDENT OVER SOME +];NOSAI +REPEAT 4,2PATCH + DATE A, ; *** DATE AND TIME + MSTIME B, + PUSHJ P,PTMOON ; PRINT THEM, AND PHASE OF MOON. + PUSHJ P,CRLOUT + HRRZ L,CFILE ; *** FILE NAME + PUSHJ P,FILOUT + DROPTHRUTO PTLAB9 +];DOS + +PTLAB9: MOVE L,CFILE + SKIPN R,F.CRDT(L) + JRST PTLABU ;PRINT DATE ONLY IF WE HAVE ONE!!! + MOVEI B,[ASCIZ/ Created /] + PUSHJ P,ASCOUT + PUSHJ P,PTQDAT +PTLABU: MOVE A,CFILE + SKIPGE F.OPGT(A) ;IF THIS IS A COMPARISON LISTING, + SKIPL C,F.OLRC(A) + JRST PTLAB8 + MOVE B,F.SWIT(A) + TRNE B,FSLALL + JRST PTLAB8 + PUSHJ P,CRLOUT + MOVEI B,[ASCIZ /Compared with /] + PUSHJ P,ASCOUT + MOVEI L,-F.RSNM(C) ;F.RSNM(L) IS ADDR OF NAMES TO PRINT. + PUSHJ P,FILOUT ;PRINT NAME OF FILE COMPARED AGAINST. + MOVE A,CFILE + SKIPN R,F.OCRD(A) + JRST PTLAB3 + MOVEI B,[ASCIZ / created /] + PUSHJ P,ASCOUT + PUSHJ P,PTQDAT +PTLAB3: TRNN F,FSNCHG ;IF FILE IS UNCHANGED SINCE LAST LISTED, SAY SO. + JRST PTLAB8 + MOVEI B,[ASCIZ / -- unchanged/] + PUSHJ P,ASCOUT +PTLAB8: PUSHJ P,CRLOUT + SKIPE MULTI + POPJ P, + JRST CRLOUT + +DAYS: IRPS X,,Sunday Monday Tuesday Wednesday Thursday Friday Saturday + [ASCIZ /X/] +TERMIN +MONTHS: ;TWO WORDS PER MONTH OF ASCIZ STRING +IRPS X,,January February March April May June July August September October November December + ASCII /X/ +IFLE .LENGTH /X/-5, 0 +TERMIN + +;PRINT A DISK-FORMAT DATE IN R, AS "WHENSDAY, MONTH DAY, 1969 00:00:00 PHASEOFMOON" + +ITS,[ +;TURN IT INTO A DEC FORMAT DATE IN A AND TIME (IN MSEC) IN B. +PTQDAT: LDB A,[270400,,R] ;*** MONTH + IMULI A,31. + LDB B,[220500,,R] ;*** DATE + ADD A,B + SUBI A,31.+1 ;ITS USES 1-ORIGIN FOR DAY AND MONTH, WHILE DEC USES 0. + LDB B,[330700,,R] ;*** YEAR + IMULI B,12.*31. + ADDI A,-64.*12.*31.(B) + MOVEI B,(R) ;*** TIME + IMULI B,500. ;TURN INTO MILLISECONDS. +];ITS + +DOS,[ +PTQDAT: HRRZ B,R + IMULI B,60.*1000. ; CONVERT TIME TO MSEC. + HLRZ A,R ;A GETS JUST THE DATE. +];DOS + DROPTHRUTO PTMOON ;PRINT DATE, TIME, AND PHASE OF MOON. + +;A HAS DEC-STYLE DATE, B HAS A DEC-STYLE MSTIME; +; PRINT THEM, AND CORRESPONDING PHASE OF MOON. +PTMOON: PUSH P,B + PUSHJ P,PTDATE + MOVE B,(P) + MOVE C,$YEAR ;*** PHASE OF MOON + MOVEI A,-1(C) + IMULI C,365. + LSH A,-2 + ADDI C,(A) + IDIVI A,25. + SUBI C,(A) + LSH A,-2 + ADDI C,1(A) + MULI C,24.*60.*60. + MOVE L,$YEAR + MOVE B,$DAY + SOSLE $MONTH ;JAN OR FEB?? + TRNE L,3 ;OR NON LEAP YER?? +PTLB3B: SOJA B,PTLB3A ;YES, CORRECT THE DAY + IDIVI L,100. ;MAKE SURE IT IS REALLY A LEAP YEAR + TRNE L,3 ;MULTIPLES OF 400 ARE + JUMPE R,PTLB3B ;BUT OTHER CENTURIES ARE NOT +PTLB3A: AOSE R,$MONTH ;THE SKIP JUST SAVES A MICROSECOND OR TWO + ADD B,MNTHTB(R) ;OTHERWISE ADD IN DAY CORRECTION DUE TO MONTH + IMULI B,24.*60.*60. ; MAKE IT INTO SECONDS SINCE JAN 1 + POP P,L ; GET MILLISECOND TIME + IDIVI L,1000. ; MAKE INTO SECONDS + ADD L,B ; MAKE INTO TOTAL SECONDS SINCE JAN 1 + JFCL 17,.+1 + ADD D,L + ADD D,[690882.] + JFCL 4,[AOJA C,.+1] + ASHC C,2 ;MULTIPLY BY 4, SINCE WE WANT THE QUARTER + DIV C,[<<29.*24.+12.>*60.+44.>*60.+3] ;PERIOD OF MOON IS 29D 12H 44M 2.7S (+/- 9 HRS!!!) + ASH D,-2 ;D IS NOW SECS SINCE START OF QUARTER + ANDI C,3 + MOVE B,QUARTS(C) +;B HAS SIXBIT FOR WHICH QUARTER +;AND D HAS SECONDS SINCE BEGINNING OF THAT QUARTER. + JSP H,SIXOUT + MOVEI C,SMHD + MOVE A,D +PTLAB4: HRRZ B,(C) + IDIVI A,(B) + HRLM B,(P) + SKIPE A + PUSHJ P,[AOJA C,PTLAB4] + HLRZ A,(P) + PUSHJ P,000X + HLRZ CH,(C) + 2PATCH + 2PATCH ". + SOJA C,CPOPJ + +QUARTS: SIXBIT \ NM+\ + SIXBIT \ FQ+\ + SIXBIT \ FM+\ + SIXBIT \ LQ+\ + +SMHD: "S,,60. ;60 SEC PER MIN + "M,,60. ;60 MIN PER HOUR + "H,,24. ;2 HOURS PER DAY + "D,,-1 ;DAY IS BIGGEST UNIT NEEDED IN PHASE OF MOON. + +;PRINT A DEC-STYLE DATE (IN A) AND TIME (IN MSEC, IN B). +;NOTE THAT PTDATE IS USED IN I.T.S. VERSION TOO! +PTDATE: PUSH P,B ; SAVE TIME + IDIVI A,31. ; GET DAYS + MOVEM B,$DAY + IDIVI A,12. ; GET MONTHS + MOVEM B,$MONTH + ADDI A,1964. + MOVEM A,$YEAR + MOVE L,$DAY + ADD L,MNTHTB(B) + TRNN A,3 + CAILE B,1 + AOJ L, + ADDI L,(A) + ASH A,-2 + ADDI L,5(A) ;5 BECAUSE JANUARY 1,1964 WAS A WEDNESDAY + IDIVI L,7 ;DAY OF WEEK IS IN "R" + POP P,B ; GET MILLISECOND TIME + JUMPE B,PTDAT3 + PUSHJ P,PMSTIM + 2PATCH 40 +PTDAT3: MOVE B,DAYS(R) ;*** DAY + PUSHJ P,ASCOUT + 2PATCH [",] + 2PATCH 40 + MOVE B,$MONTH ;*** DATE + ADDI B,MONTHS(B) + PUSHJ P,ASCOUT + 2PATCH 40 + AOS A,$DAY + PUSHJ P,000X + 2PATCH [",] + 2PATCH 40 + MOVE A,$YEAR + JRST 000X + +MNTHTB: +DAYSOFAR==0 +IRP X,,[31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.] + DAYSOFAR +DAYSOFAR==DAYSOFAR+X +TERMIN +IFN DAYSOFAR-365., .ERR MNTHTB DOES NOT ADD UP TO 365. +EXPUNGE DAYSOFAR + +PMSTIM: IDIVI B,1000. ; NOT INTERESTED IN MILLISECONDS + IDIVI B,60. ; GET SECONDS + PUSH P,C ; SAVE 'EM + IDIVI B,60. ; GET HOURS AND MINUTES + PUSH P,C + IDIVI B,10. ;PRINT HOURS + 2PATCH "0(B) + 2PATCH "0(C) + POP P,B ;PRINT MINUTES + 2PATCH [":] + IDIVI B,10. + 2PATCH "0(B) + 2PATCH "0(C) + POP P,B ;PRINT SECONDS + JUMPE B,CPOPJ + 2PATCH [":] + IDIVI B,10. + 2PATCH "0(B) + 2PATCH "0(C) + POPJ P, + +SUBTTL FILE NAME BIGPRINT + +;;; H HAS A SIXBIT WORD; BIGPRINT IT TO THE OUTPUT FILE. +;;; CLOBBERS A,B,C,D,R,L,CH,CC,N, AND BIT FRLSHRT OF F (ALTERS SP). +;;; FRPSHRT MUST BE SET UP AS AN ARGUMENT. + +MOBYCR==:21. ;# OF CRLFS MOBY PRINTS IF FRPSHRT IS 0. + +MOBY: MOVE N,OUTVP + TRZ F,FRLSHRT + MOVEI A,21.*6-6 + CAMLE A,LINEL + TRO F,FRLSHRT ;BIT 1 OF F IS 1 FOR 2 CHARS/GROUP, 0 FOR 3 + MOVEI L,7 +MOBY1: MOVEI R,3 ;LOOP POINT FOR 3-LINE GROUPS + ;ALL 3 LINES IN A LINE GROUP ARE IDENTICAL + ;L (= LINE-GRP #) AFFECTS HOW EACH CHAR PRINTS + TRNE F,FRPSHRT + MOVEI R,2 ;FRPSHRT SAYS USE ONLY 2 LINES INSTEAD 3. +MOBY2: 2PATCH ^M ;LOOP FOR LINE WITHIN A GROUP + 2PATCH ^J + ADDI N,1 + MOVE B,H ;PRINT THE WORD ON EACH LINE + SETO CC, ;CC IS -1 FOR 1ST CHAR OF WORD +MOBY3: SETZ A, ;LOOP FOR CHAR IN WORD + LSHC A,6 ;GET NEXT CHAR IN A + LDB C,MOBY9-1(L) ;5 BIT BYTE SAYING WHAT GOES IN EACH CHAR-GRP + MOVEI D,7 + AOJN CC,MOBY4 ;AVOID SPACES BEFORE 1ST CHAR ON LINE + LSH C,2 + SUBI D,2 +MOBY4: MOVEI CH,40 ;EACH CHAR-GROUP HAS 2 OR 3 + TRNE C,100 ; CHARS, ALL THE SAME + MOVEI CH,40(A) +REPEAT 2, 2PATCH + TRNE F,FRLSHRT + JRST MOBY5 + 2PATCH +MOBY5: LSH C,1 + SOJG D,MOBY4 ;PRINT NEXT CHAR-GRP + JUMPN B,MOBY3 ;PRINT NEXT CHAR + PUSHJ P,2OUTPJ ;FORCE OUT OUTPUT MAYBE + SOJG R,MOBY2 ;PRINT NEXT LINE IN LINE-GRP + SOJG L,MOBY1 ;PRINT NEXT LINE-GRP + MOVEM N,OUTVP + POPJ P, + +MOBY9: 000500,,CHARS(A) ;TABLE OF BYTE POINTERS FOR + 050500,,CHARS(A) ; FETCHING SUCCESSIVE 5-BIT + 120500,,CHARS(A) ; BYTES FROM THE CHARS TABLE + 170500,,CHARS(A) + 240500,,CHARS(A) + 310500,,CHARS(A) + 360500,,CHARS(A) + +;CALL HERE TO FORCE OUT OUTPUT BUFFER. +2OUTPJ: PUSH P,B + 2OUTBF +POPBJ: POP P,B + POPJ P, + +IF1, CHARS: BLOCK 100 + +IF2,[ + +;;; HAIRY SYMBOLS FOR DEFINING CHARACTERS + +RADIX 2. +IRPC V,,[.X]J,,[01] +IRPC W,,[.X]K,,[01] +IRPC X,,[.X]L,,[01] +IRPC Y,,[.X]M,,[01] +IRPC Z,,[.X]N,,[01] +V!!W!!X!!Y!!Z==J!!K!!L!!M!!N +TERMIN +TERMIN +TERMIN +TERMIN +TERMIN +RADIX 8. + +;;; HAIRY MACROS FOR DEFINING 8. CHARACTERS AT A TIME + +DEFINE $$ Q/ +IRPS X,,[Q]Y,,[$0,$1,$2,$3,$4,$5,$6,$7] +Y==X +TERMIN +%%CNT==0 +TERMIN + +DEFINE %% Q/ +IRPS X,,[Q]Y,,[$0,$1,$2,$3,$4,$5,$6,$7] +Y==+X +TERMIN +%%CNT==%%CNT+1 +TERMIN + +DEFINE ...... +IRPS Y,,[$0,$1,$2,$3,$4,$5,$6,$7] + Y +EXPUNGE Y +TERMIN +IFN <.-CHARS>&7, .ERR WRONG LENGTH TABLE +IFN %%CNT-6, .ERR WRONG NUMBER OF %%'S +EXPUNGE %%CNT +TERMIN + +;;; IF2 + +CHARS: + +$$ ..... ..X.. .X.X. .X.X. ..X.. XX..X ..X.. ...X. +%% ..... ..X.. .X.X. .X.X. .XXXX XX..X .X.X. ..X.. +%% ..... ..X.. ..... XXXXX X.X.. ...X. ..X.. .X... +%% ..... ..X.. ..... .X.X. .XXX. ..X.. .X... ..... +%% ..... ..X.. ..... XXXXX ..X.X .X... X.X.X ..... +%% ..... ..... ..... .X.X. XXXX. X..XX X..X. ..... +%% ..... ..X.. ..... .X.X. ..X.. X..XX .XX.X ..... +...... +$$ ...X. .X... ..... ..... ..... ..... ..... ....X +%% ..X.. ..X.. X.X.X ..X.. ..... ..... ..... ....X +%% .X... ...X. .XXX. ..X.. ..... ..... ..... ...X. +%% .X... ...X. XXXXX XXXXX ..... XXXXX ..... ..X.. +%% .X... ...X. .XXX. ..X.. ..... ..... ..... .X... +%% ..X.. ..X.. X.X.X ..X.. ..X.. ..... .XX.. X.... +%% ...X. .X... ..... ..... .X... ..... .XX.. X.... +...... +$$ .XXX. ..X.. .XXX. .XXX. ...X. XXXXX .XXX. XXXXX +%% X...X .XX.. X...X X...X ..XX. X.... X...X ....X +%% X..XX ..X.. ....X ....X .X.X. X.... X.... ...X. +%% X.X.X ..X.. ...X. .XXX. X..X. XXXX. XXXX. .XXXX +%% XX..X ..X.. ..X.. ....X XXXXX ....X X...X ..X.. +%% X...X ..X.. .X... X...X ...X. X...X X...X .X... +%% .XXX. .XXX. XXXXX .XXX. ...X. .XXX. .XXX. X.... +...... +$$ .XXX. .XXX. ..... ..... ...X. ..... .X... .XXX. +%% X...X X...X ..... ..... ..X.. ..... ..X.. X...X +%% X...X X...X .XX.. .XX.. .X... XXXXX ...X. ...X. +%% .XXX. .XXXX .XX.. .XX.. X.... ..... ....X ..X.. +%% X...X ....X ..... ..... .X... XXXXX ...X. ..X.. +%% X...X ...X. .XX.. ..X.. ..X.. ..... ..X.. ..... +%% .XXX. XXX.. .XX.. .X... ...X. ..... .X... ..X.. +...... +$$ .XXX. ..X.. XXXX. .XXX. XXX.. XXXXX XXXXX .XXX. +%% X...X .X.X. X...X X...X X..X. X.... X.... X...X +%% X.XXX X...X X...X X.... X...X X.... X.... X.... +%% X.X.X X...X XXXX. X.... X...X XXXX. XXXX. X.XXX +%% X.XXX XXXXX X...X X.... X...X X.... X.... X...X +%% X.... X...X X...X X...X X..X. X.... X.... X...X +%% .XXXX X...X XXXX. .XXX. XXX.. XXXXX X.... .XXX. +...... +$$ X...X .XXX. ..XXX X...X X.... X...X X...X .XXX. +%% X...X ..X.. ...X. X..X. X.... XX.XX XX..X X...X +%% X...X ..X.. ...X. X.X.. X.... X.X.X X.X.X X...X +%% XXXXX ..X.. ...X. XX... X.... X.X.X X..XX X...X +%% X...X ..X.. ...X. X.X.. X.... X...X X...X X...X +%% X...X ..X.. X..X. X..X. X.... X...X X...X X...X +%% X...X .XXX. .XX.. X...X XXXXX X...X X...X .XXX. +...... +$$ XXXX. .XXX. XXXX. .XXX. XXXXX X...X X...X X...X +%% X...X X...X X...X X...X ..X.. X...X X...X X...X +%% X...X X...X X...X X.... ..X.. X...X X...X X...X +%% XXXX. X...X XXXX. .XXX. ..X.. X...X X...X X.X.X +%% X.... X.X.X X.X.. ....X ..X.. X...X X...X X.X.X +%% X.... X..X. X..X. X...X ..X.. X...X .X.X. XX.XX +%% X.... .XX.X X...X .XXX. ..X.. .XXX. ..X.. X...X +...... +$$ X...X X...X XXXXX .XXX. X.... .XXX. ..X.. ..... +%% X...X X...X ....X .X... X.... ...X. .XXX. ..X.. +%% .X.X. .X.X. ...X. .X... .X... ...X. X.X.X .X... +%% ..X.. ..X.. XXXXX .X... ..X.. ...X. ..X.. XXXXX +%% .X.X. ..X.. .X... .X... ...X. ...X. ..X.. .X... +%% X...X ..X.. X.... .X... ....X ...X. ..X.. ..X.. +%% X...X ..X.. XXXXX .XXX. ....X .XXX. ..X.. ..... +...... + +] ;END OF IF2 + +SUBTTL PRINT SYMBOL TABLE + +;;; THIS CODE PRINTS THE SYMBOL TABLE AT THE END OF EACH LISTED FILE. +;;; THE SYMBOL TABLE IS PRINTED IN A COLUMNAR FORMAT, WITH +;;; EACH COLUMN IN ALPHABETICAL ORDER, AND AS MANY SUCCESSIVE +;;; COLUMNS ON A PAGE AS WILL FIT. ON THE LAST PAGE THE COLUMNS +;;; ARE MADE AS NEARLY EQUAL IN HEIGHT AS POSSIBLE. THE ENTRY +;;; FOR EACH SYMBOL IS OF THE FORM +;;; -NAME- T -FILE- 000*111 +;;; WHERE -NAME- IS THE NAME OF THE SYMBOL, -FILE- THE FILE +;;; IT IS DEFINED IN, T THE TYPE OF DEFINITION, 000 111 THE PAGE +;;; AND LINE NUMBER, AND * IS A * IFF NO REFERENCE TO THE SYMBOL +;;; WAS SEEN ON PASS 2, AND BLANK OTHERWISE. FOR NON MULTI-FILE +;;; SYMBOL TABLES, -FILE- IS NOT PRESENT. +;;; ON ENTRY, IP HAS THE FILE FOR WHICH TO PRINT SYMBOLS, OR +;;; ZERO FOR A MULTI-FILE SYMBOL TABLE. + +;;; STARTS WITH AN FF (UNLESS 1ST THING IN FILE), ENDS WITH QPYRT MSG. + +SYMLST: SKIPL SYMAOB ;IF NO SYMBOLS, GIVE UP NOW! + JRST SYML9A + PUSHJ P,2ENDP ;PRINT A PAGE BOUNDARY UNLESS JUST AFTER ONE. + MOVE L,MAXSSZ ;FIGURE OUT NUMBER OF COLUMNS WANTED BY SYMS AND TYPES, + MOVE R,MAXTSZ + SKIPN SYMTRN + JRST SYML1 + CAML L,SYMTRN ;THEN APPLY USER-SPECIFIED TRUNCATION, IF ANY. + MOVE L,SYMTRN + CAML R,SYMTRN + MOVE R,SYMTRN +SYML1: MOVE B,LINEL ;GET LINEL, AND ADD 2 FOR + ADDI B,2 ; UNUSED GAP AFTER LAST COLUMN + MOVEI D,14(L) ;BASIC COLUMN WIDTH IS + ADDI D,(R) ; MAXSSZ+MAXTSZ+14 + SKIPN MULTI + JRST SYML1A + JUMPN IP,SYML1A + ADDI D,3 ;TO PRINT FILE NAMES NEED EVEN + TLNN F,FLSHRT ; MORE WIDTH + ADDI D,4 +SYML1A: IDIVI B,(D) ;DIVIDE LINEL BY COLUMN WIDTH + JUMPN B,SYML1B ;WIN WIN + CAIL L,10(R) ;GRUMBLE! CAN'T EVEN FIT ONE + SOJA L,SYML1 ; COLUMN! HERE IS A CRUFTY + CAIG R,5 ; HEURISTIC FOR DECREASING ONE + CAIG L,(R) ; OF MAXSSZ AND MAXTSZ SO THAT + SOJA R,SYML1 ; WE CAN FIT. + SOJA L,SYML1 + +SYML1B: MOVEM L,SYMSIZ ;THESE ARE THE MAXSSZ AND MAXTSZ + MOVEM R,TYPSIZ ; WE WILL ACTUALLY USE + MOVEM B,SYM%LN ;NUMBER OF SYMBOLS PER LINE + MOVNI C,(B) + HRLM C,COLAOB ;AOBJN PTR TO COLUMN TABLE + SETZB L,N + MOVE B,SYMAOB ;HERE IS A CROCK: WE NEGATE THE + HLRE D,B ; PAGE/LINE NUMBER WORD OF ALL + MOVSI R,%SXSYM ; ENTRIES TO BE PRINTED +SYML1E: JUMPE IP,SYML1J + HLRZ C,S.FILE(B) ;IF SINGLE-FILE SYMBOL TABLE, + CAIN C,(IP) ; DON'T PRINT SYMBOLS OF OTHER FILES +SYML1J: TDNE R,S.BITS(B) ;ALSO DON'T PRINT SUPPRESSED SYMBOLS + AOJA D,SYML1F ;BUMP D FOR EACH UNPRINTABLE ONE + MOVNS S.PAGE(B) +SYML1F: SKIPL S.BITS(B) .SEE %SDUPL + SKIPA L,S.BITS(B) + IORM L,S.BITS(B) + AND L,[%SREFD,,] + ADDI B,LSENT-1 + AOBJN B,SYML1E + MOVNM D,SYMCNT ;TOTAL # OF SYMBOLS TO PRINT + HRRZ CP,SYMLO ;CP SCANS SYMBOL TABLE +;COME HERE TO DO NEXT PAGE OF SYMBOL TABLE LISTING +SYML2: SETZB CC,OUTVP ;OUTVP COUNTS LINES FOR CPYBOT + SKIPG L,SYMCNT ;JUMP OUT IF ALL DONE + JRST SYML9A + MOVEI B,[ASCIZ \Symbol Table for: \] + PUSHJ P,TABHED + MOVE B,PAGEL1 + SUB B,OUTVP + IMUL B,SYM%LN + MOVEM B,SYM%PG ;NUMBER OF SYMBOLS FOR THIS PAGE + CAMLE L,SYM%PG ;CAN'T DO MORE THAN SYM%PG + MOVE L,SYM%PG ; SYMBOLS ON ONE PAGE + IDIV L,SYM%LN ;DIVIDE BY SYMBOLS PER LINE + MOVE D,COLAOB +;CALCULATE # OF SYMBOLS FOR EACH COLUMN +SYML2A: MOVNI A,(L) ;A GETS # OF SYMS FOR THIS COL + SOSL R ;FOR AN UNEVEN PAGE, THE LEFT- + SUBI A,1 ; MOST COLS GET THE EXCESS + MOVEM CP,(D) ;SAVE POINT IN SYMBOL TABLE + JUMPE A,SYML2D ;THEN SKIP RIGHT NUMBER OF SYMBOLS WE ARE GOING TO PRINT +SYML2C: ADDI CP,LSENT ;TO GET TO FIRST SYMBOL OF NEXT COLUMN. + SKIPL -LSENT+S.PAGE(CP) + JRST SYML2C + AOJL A,SYML2C +SYML2D: AOBJN D,SYML2A ;LOOP TO DO ALL COLUMNS +;COME HERE TO DO NEXT LINE OF SYMBOL TABLE +SYML3: MOVE L,COLAOB +;COME HERE TO DO NEXT SYMBOL ENTRY +SYML4: SOSGE SYMCNT ;COUNT DOWN SYMBOLS + JRST SYML9 + HRRZ R,(L) ;GET POINTER TO NEXT SYMBOL +SYML4A: ADDI R,LSENT + SKIPL -LSENT+S.PAGE(R) ;FIND NEXT SYMBOL TO BE PRINTED. + JRST SYML4A + MOVEM R,(L) ;SET NEXT SYM FOR THIS COLUMN TO THE ONE AFTER IT. + SUBI R,LSENT ;MAKE R POINT TO THE ONE WE ARE ACTUALLY PRINTING. + MOVE C,SYMSIZ + PUSHJ P,SYMOUT ;PRINT THE SYMBOL'S NAME (AT MOST SYMSIZ CHARS OF IT). + PUSHJ P,DOTPAD ;PAD WITH SPACES AND DOTS TO USE TO C(C) COLUMNS. + 2PATCH 40 ;PRINT TYPE OF DEFINITION + HRRZ D,S.TYPE(R) + SKIPN D ;SOMETIMES L[LISP] FORGETS TO SET THE TYPE. + MOVEI D,L%UNKN ; IN THOSE CASES, USE L%UNKN. + MOVE C,TYPSIZ + HRRZ D,(D) + HRLI D,440700 +SYML6C: ILDB CH,D + JUMPE CH,SYML6A + 2PATCH + SOJG C,SYML6C +SYML6A: PUSHJ P,DOTPAD ;PAD TYPE WITH SPACES AND DOTS, IF NECESSARY + JUMPN IP,SYML7G ;PRINT FILE, IF NEEDED + SKIPN MULTI + JRST SYML7G + 2PATCH 40 + HLRZ D,S.FILE(R) ;OUTPUT THE FILE NAME, IF MULTI FILE SYMTAB. + MOVE B,F.RFN1(D) +REPEAT 2,[ + SETZ A, + LSHC A,6 + 2PATCH 40(A) +] ;END OF REPEAT 2 + TLNE F,FLSHRT + JRST SYML7G +REPEAT 4,[ + SETZ A, + LSHC A,6 + 2PATCH 40(A) +] ;END OF REPEAT 4 +SYML7G: MOVMS S.PAGE(R) ;RESTORE NEG PAGE/LINE + MOVEI D,(R) ;D -> SYMBOL DEFINITION ENTRY + HLRZ A,S.BITS(R) ;DECIDE WHETHER OR NOT TO USE A * + HRLI D,40 + TRNN A,%SREFD + HRLI D,"* + PUSHJ P,OUTREF ;PRINT A REFERENCE TO SYMBOL (AND MAYBE A SPACE) + AOBJP L,[ ;BUT MAYBE IT IS TIME TO END A LINE, IN WHICH CASE + CAIE CH,40 ;FLUSH THE SPACE IF THERE WAS ONE. + JRST SYML8 + DBP7 SP + JRST SYML8] + 2PATCH 40 + JRST SYML4 + +;COME HERE AT END OF A LINE +SYML8: AOS A,OUTVP + CAML A,PAGEL1 + JRST SYML8C + 2PATCH ^M + 2PATCH ^J + PUSHJ P,2OUTPJ + JRST SYML3 +SYML8C: TLNE F,FLQPYM + PUSHJ P,CPYOUT + 2PAGE + SETZM OUTVP + PUSHJ P,2OUTPJ + JRST SYML2 +SYML9: TLNN F,FLQPYM +SYML9A: POPJ P, + JRST CPYOUB + +SUBTTL PRINT HEADINGS FOR SYMBOL TABLE, CREF, ETC. + +;;; PRINT A HEADING FOR A TABLE SUCH AS THE SYMBOL TABLE OR CREF. +;;; HEADING HAS RELEVANT FILE NAMES: ALL FILES ON FIRST PAGE, +;;; AS MANY AS WILL FIT IN ONE LINE ON ALL OTHERS. +;;; HEADING ALSO HAS PAGE NUMBER WITHIN TABLE, AND AN ARBITRARY PIECE OF TEXT. +;;; ENTER WITH POINTER TO ASCIZ TEXT IN B, -1 IN N +;;; (THIS ROUTINE WILL AOS N), AND FILE NAME IN IP (ZERO => ALL). +;;; PRESERVES A, B, C, D, L, R, AND IP. + +TABHED: INSIRP PUSH P,A B C D L R + PUSHJ P,ASCOUT + PUSH P,[FILSRT] ;-1(P) POINTS TO FILSRT POINTER TO NEXT FILE TO PRINT. + MOVEI C,3(CC) + PUSH P,C ;FIRST TAB COLUMN + SKIPN L,IP ;L HOLDS CURRENT FILE TO CONSIDER + MOVE L,@-1(P) ; PRINTING NAME OF + JRST TABHD1 + +TABHD3: PUSHJ P,2OUTPJ + PUSHJ P,CRLOUT + JUMPN N,TABHD9 ;ONLY PRINT ONE LINE UNLESS PAGE 1 +TABHD1: MOVEI C,(CC) + ADDI C,24.+2 ;TAB STOPS ARE 24. APART, BUT LEAVE AT + SUB C,(P) ; LEAST 2 SPACES BETWEEN NAMES + IDIVI C,24. + IMULI C,24. + ADD C,(P) + MOVE D,LINEL + SUBI D,24. ;NEED AT LEAST 24. SPACES FOR FILE NAME + CAML D,C + JRST TABHD5 + JUMPN CC,TABHD3 ;MAYBE NEED TO CRLF FIRST + SETZ C, ;BUT GET AT LEAST ONE NAME PER LINE! +TABHD5: PUSHJ P,SPCOUT ;SPACE OVER TO TAB STOP + CAIGE CC,(C) + JRST TABHD5 + SKIPE OUTVP ;IF NOT FIRST LINE, NO PAGE NUMBER + JRST TABHD7 + MOVEI C,(CC) + ADDI C,2*24.+10. ;IS THERE ROOM FOR A FILE NAME AS WELL AS PAGE # AND DATE? + CAMG C,LINEL + JRST TABHD7 + MOVEI CH,40 ;NO, IT'S NOW TIME FOR PAGE NUMBER + JUMPE N,TABHD0 ;IF NOT PAGE 1 AND NOT FAKING, + JUMPL L,TABHD0 ; THEN MAY PRINT NO MORE FILE NAMES, + MOVEI CH,". ; SO USE "..." TO SHOW THERE ARE MORE +TABHD0: +REPEAT 3, 2PATCH + MOVEI B,[ASCIZ / /] + PUSHJ P,ASCOUT + PUSH P,2PUTNX + MOVSI B,(CAIA) + MOVEM B,2PUTNX + PUSHJ P,DATOUT ;PRINT TODAY'S DATE. + POP P,2PUTNX + MOVEI B,[ASCIZ / Page /] + PUSHJ P,ASCOUT + MOVEI A,1(N) ;PRINT PAGE NUMBER + PUSHJ P,ROMAN + JRST TABHD3 + +TABHD7: SKIPL L + PUSHJ P,FILOUT ;OUTPUT FILE NAME + JUMPN IP,TABHD8 ;IF ONLY ONE FILE, OR IF JUST FORCED A PAGE # AFTER + JUMPL L,TABHD8 ; ALL FILES FIT IN THE FIRST LINE, THEN FINISHED. + AOS L,-1(P) + SKIPE L,(L) + JRST TABHD1 ;ELSE KEEP GOING UNTIL ALL INPUT FILES MENTIONED. +TABHD8: SKIPE OUTVP ;SKIP IF FIRST LINE + JRST TABHD2 + TLO L,400000 ;MUST FAKE OUT THE WORLD TO GET + PUSHJ P,SPCOUT ; THE PAGE NUMBER OUT + JRST TABHD1 + +TABHD2: PUSHJ P,CRLOUT +TABHD9: PUSHJ P,CRLOUT + SUB P,[2,,2] + POP P,R + POP P,L + POP P,D + POP P,C + AOJA N,POPBAJ + +SUBTTL OUTPUT SUBTITLE TABLE OF CONTENTS + +;;; PRINT OUT A SUBTITLE TABLE OF CONTENTS. +;;; IP HAS FILE NAME, OR ZERO FOR ALL FILES. MUST PRESERVE IP. +;;; PRINTS NO FF; ASSUMES ONE WAS JUST PRINTED. + +SUBOUT: SKIPN L,SUBTLS + POPJ P, ;NO SUBTITLES, NO CONTENTS! + JUMPE IP,SUBT0 ;IF IT'S A TABLE OF CONTENTS FOR SINGLE FILE, + MOVE A,F.SWIT(IP) ;THEN MAKE THE TABLE IF THE FILE SAYS IT HAS SUBTITLES, + TRNE A,FSSUBT + JRST SUBT2 + MOVE A,CODTYP + CAIN A,CODRND ;OR IF /Z AND /L[RANDOM] (SINCE IN THAT CASE THE SETTING + TLNN F,FLSUBT ;OF FSSUBT IS INHIBITED). + POPJ P, +SUBT2: MOVE A,F.NPGS(IP) ;DON'T MAKE A SINGLE-FILE TABLE OF CONTENTS FOR A 1-PAGE FILE. + CAIG A,1 + POPJ P, +SUBT0: SETZB N,OUTVP + SETZM FFSUPR + MOVEI B,[ASCIZ \Table of Contents for: \] + PUSHJ P,TABHED + MOVE R,LINEL + SUBI R,24 ;GET # CHARS SPACE AVAIL FOR SUBTITLES + CAMLE R,SUBLEN + MOVE R,SUBLEN ;GET MIN OF THAT AND SIZE OF LONGTEST SUBTITLE + ADDI R,10 + PUSH P,[0] ;(P) HAS FILE OF LAST SUBTITLE PRINTED, + ;TO DETECT GOING FROM ONE FILE TO ANOTHER. + HRRZ L,SUBTLS ;GET START OF LIST OF SUBTITLES. +SUBT1: HRRZ A,1(L) + JUMPE IP,SUBT1A + CAIE A,(IP) + JRST SUBT8 ;FORGET THIS ONE -- WRONG FILE +SUBT1A: MOVEI B,[ASCIZ \Table of Contents for: \] + EXCH A,(P) + CAMN A,(P) ;THIS SUBTITLE IN SAME FILE AS PREVIOUS? + JRST [ PUSHJ P,CRFCR ;YES => JUST NEED A CR + JRST SUBT4] ;AND DON'T PRINT FILENAME IF THE SAME. + JUMPE A,SUBT4B ;JUST STARTING A PAGE (LOOKS DIFFERENT ON PAGE 1 AND OTHER PAGES) + MOVE C,OUTVP ;=> NEED ONLY 1 LINE OF SPACE HERE. + CAIGE C,2 + JRST SUBT4B + ADDI C,5 + CAML C,PAGEL1 ;IF DON'T HAVE AT LEAST 5 LINES LEFT ON PAGE + JRST [ PUSHJ P,CRFPAG ;MOVE TO A NEW PAGE. + JRST SUBT4A] + PUSHJ P,CRLOUT ;ELSE JUST LEAVE BLANK LINE. +SUBT4B: PUSHJ P,CRLOUT +SUBT4A: MOVE B,(P) + MOVE B,F.RFN1(B) ;THEN PRINT THE NAME OF THE NEW FILE. + JSP H,SIXOUT +SUBT4: 2PATCH ^I ;SUBTITLES THEMSELVES ALWAYS INDENTED BY 8. + HLRZ A,1(L) + PUSH P,IP + HRRZ IP,1(L) + PUSHJ P,MJMNRF ;FOLLOWED BY THE PAGE NUMBER, + POP P,IP + 2PATCH ^I ;ANOTHER TAB, + MOVEI CC,20 + HLRE D,(L) + HRRI C,2(L) ;AND THE SUBTITLE ITSELF, TRUNCATED AT THE MARGIN. + HRLI C,440700 +SUBT5: AOJG D,SUBT8 + ILDB CH,C + 2PATCH + ADDI CC,1 + CAMGE CC,R + JRST SUBT5 +SUBT8: HRRZ L,(L) + JUMPN L,SUBT1 + SUB P,[1,,1] + JRST SYML9 + +SUBTTL PRINT OUT A CREF + +;;; STARTS WITH AN FF (UNLESS 1ST THING IN FILE); +;;; ENDS WITH A COPYRIGHT MSG (IF NEEDED). + + + +CRFOUT: SKIPL H,SYMAOB ;RETURN IF NO SYMBOLS + POPJ P, + +CRF1: HRRZ B,3(H) ;NREVERSE ALL LINKED LISTS OF CREF DATA + NREVERSE B,A,C,3 + HRRM B,3(H) + ADDI H,3 + AOBJN H,CRF1 + MOVE R,SYMAOB + PUSHJ P,2ENDP ;PRINT A PAGE BOUNDARY UNLESS JUST AFTER ONE. + SETZB CC,OUTVP + SETZB IP,N + MOVEI B,[ASCIZ \Cref of: \] + PUSHJ P,TABHED + SKIPL A,CODTYP ;NOW DISPATCH TO A SPECIFIC + CAIL A,CODMAX ; CREF PRINTING ROUTINE + .VALUE + MOVEI B,[ASCIZ /Key to types of symbol occurrences (Note references come last): + +/] + SKIPN CRFKEY(A) + JRST CRFOU2 + PUSHJ P,ASCOUT + MOVE B,CRFKEY(A) ;FIRST, PRINT AN EXPLANATION IF WE HAVE ONE. + PUSHJ P,ASCOUT + PUSHJ P,CRLOUT + PUSHJ P,CRLOUT +CRFOU2: JRST .+1(A) +OFFSET -. +CODMID:: JRST MCRF ;MIDAS CREF +CODRND:: .VALUE ; +CODFAI:: JRST MCRF +CODP11:: JRST MCRF +CODLSP:: JRST MCRF +CODM10:: JRST MCRF +CODUCO:: JRST MCRF +CODTXT:: .VALUE +CODMDL:: JRST MCRF +CODDAP:: JRST MCRF +CODMAX::OFFSET 0 + +CRFKEY: OFFSET -. +CODMID:: [ASCIZ /Dash - Ordinary reference. ! - .SEE reference. +: - Label. = - Assignment or EQUALS. + - Macro. * - Block. +' - Variable (or .SCALAR, .VECTOR). " - Symbol made global./] +CODRND:: 0 +CODFAI:: [ASCIZ /Dash - Reference. : - Label. _ - Assignment. += - OPDEF or SYN. + - Macro. * - Block. # - Variable. ^ - Global./] +CODP11:: [ASCIZ /Dash - Reference. : - Label. = - Assignment. ++ - Macro. * - .CSECT. ? - .NARG, .NTYPE or .NCHR./] +CODLSP:: [ASCIZ /Dash - Reference. f - Function. b - Bound. = - Top-level Setq. +t - Prog tag. c - Catch tag. p - Property name. m - Macro. +l - Lap tag. a - Array. @ - @define. d - Defprop (or @define'd definer)./] +CODM10:: [ASCIZ /Dash - Reference. : - Label. = - Assignment, OPDEF or SYN. ++ - Macro. # - Variable. " - Symbol made global./] +CODUCO:: 0 +CODTXT:: 0 +CODMDL:: [ASCIZ/ Dash - Reference. l - Local definition (or parameter). +g - Global. t - Newtype. f - Function. m - Macro./] +CODDAP:: [ASCIZ /Dash - Ordinary reference. ! - .SEE reference. +: - Label. = - Assignment or EQUALS. + - Macro./] + +CODMAX::OFFSET 0 + +;WITHIN MCRF, R POINTS INTO SYMBOL TABLE. +MCRF: PUSH P,R ;SEE IF NEXT SYMBOL HAS ANY APPEARANCES +MCRF0A: HLRZ A,S.FILE(R) ;INSIDE NON-INPUT-ONLY OR NON-AUXILIARY FILES. + SETCM A,F.SWIT(A) + TRNE A,FSAUX+FSQUOT + JRST MCRF0 ;FOUND A DEFINITION IN SUCH A FILE. + ADDI R,LSENT-1 + AOBJP R,MCRF0B ;CHECK ALL DEFINITIONS. + SKIPGE S.BITS(R) .SEE %SDUPL + JRST MCRF0A +MCRF0B: MOVE D,(P) ;NO GOOD DEFINITIONS; CHECK REFERENCES. +MCRF0C: HRRZ D,S.CREF(D) + JUMPE D,MCRF0D ;ALL REFS BAD TOO. + HLRZ A,S.FILE(D) + SETCM A,F.SWIT(A) + TRNN A,FSAUX+FSQUOT + JRST MCRF0C ;THIS REF ISN'T IN A GOOD FILE. + +;FOUND REFERENCE OR DEFINITION IN A GOOD FILE; SYMBOL SHOULD BE MENTIONED. +MCRF0: POP P,R + MOVEI B,[ASCIZ \Cref of: \] + PUSHJ P,CRFCR ;START NEW OUTPUT LINE, MAYBE GOING TO NEW PAGE. + MOVE C,LINEL + PUSHJ P,SYMOUT ;PRINT SYMBOL NAME, UPDATING CC. +MCRF2A: 2PATCH ^I ; MOVE TO THE NEXT TAB STOP + ADDI CC,10 + ANDCMI CC,7 + TLNN F,FLARB ;IF SYMBOLS ARE ARBITRARILY LONG, MAKE "TAB STOPS" + JRST MCRF2 ;EVERY 16 COLUMNS, NOT JUST 8. IT LOOKS BETTER. + TRNE CC,10 + JRST MCRF2A +MCRF2: SETZ L, + PUSH P,R ;SAVE ADDR OF SYM'S 1ST DEFN, WHICH POINTS AT CREF DATA. +MCRF3: MOVEI D,(R) ;OUTPUT ALL THE DEFINITIONS OF THIS SYMBOL. + PUSHJ P,MCRFNT ;MCRFNT TAKES ADDR OF STE IN D. + ADDI R,LSENT-1 + AOBJP R,MCRF4 + SKIPGE S.BITS(R) .SEE %SDUPL + JRST MCRF3 +MCRF4: POP P,D + MOVE H,S.BITS(D) ;THANKS TO TIMING ERROR AND INSERTED FILES, + TLNE H,%SXCRF ; MAY HAVE ACCUMULATED CREF DATA EVEN THOUGH + JRST MCRF5 ; .XCREF'D. IN THIS CASE DON'T PRINT DATA. +MCRF4A: HRRZ D,S.CREF(D) + JUMPE D,MCRF5 + PUSHJ P,MCRFNT + JRST MCRF4A + +MCRF0D: SUB P,[1,,1] ;COME HERE FOR SYMBOL APPEARING ONLY IN INPUT-ONLY AUXILIARY FILES; DON'T MENTION IT IN THE CREF. +MCRF5: JUMPL R,MCRF + TLNN F,FLQPYM + POPJ P, + JRST CPYOUB + +;;; OUTPUT A CR FOR CREF, SUBOUT, ETC. B HAS TEXT IN CASE +;;; MUST GO TO NEW PAGE AND CALL TABHED. DOES QOPYRIGHT THING, ETC. +;;; IP HAS FILE, OR ZERO => ALL FILES, AGAIN FOR TABHED'S SAKE. + +CRFCR: PUSHJ P,2OUTPJ + SETZ CC, + AOS CH,OUTVP ;USE CH FOR TEMP HERE + CAML CH,PAGEL1 + JRST CRFPAG + 2PATCH ^M + 2PATCH ^J + POPJ P, + +CRFPAG: PUSHJ P,CPYPAG + JRST TABHED + + +;PRINT A CREF REFERENCE FILE-PAGE-LINE. D POINTS TO THE S.T.E OR CREF DATA BLOCK. +;L POINTS TO THE FILE IN WHICH THE LAST REFERENCE WAS. CC IS THE COLUMN COUNTER. +MCRFNT: MOVEI A,10(CC) + CAMG A,LINEL ;IF THIS LINE IS FULL, START A NEW ONE + JRST MCRFN1 + MOVEI B,[ASCIZ \Cref of: \] + PUSHJ P,CRFCR + 2PATCH ^I ;AND TAB IN ON IT SO WE KNOW IT'S A CONTINUATION. + ADDI CC,10 +MCRFN1: HLRZ A,S.FILE(D) ;GET THE FILE NAME WHERE REFERENCE HAPPENED + SKIPE MULTI + CAIN A,(L) ;NOT SAME FILE AS LAST TIME => PRINT FILE NAME. + JRST MCRFN2 + MOVEI L,(A) + MOVE B,F.RFN1(A) + MOVEI CH,40 +REPEAT 2, 2PATCH +REPEAT 6,[ + SETZ A, + LSHC A,6 + 2PATCH 40(A) +] ;END OF REPEAT 6 + ADDI CC,10 ;TRY AGAIN. THIS TIME, WE'LL BE IN THE "SAME" FILE + JRST MCRFNT ;AND WILL GO TO MCRFN2. + +MCRFN2: HLRZ A,2(D) + HLRZ B,1(D) ;FILE SYM IS DEFINED IN + SKIPN REALPG + SKIPL B,F.PAGT(B) ;PAGE TABLE OF FILE + JRST [ SETZ B, ? JRST MCRFN3] ;FILE HAS NONE. + ADDI B,-1(A) + ADDI B,-1(A) ;POINT TO ENTRY FOR PAGE SYM IS DEF. IN. + MOVE B,1(B) ;GET ITS MAJOR PAGE #, TO PRINT AS PAGE #. + LDB A,[MAJPAG,,B] +MCRFN3: PUSH P,B + PUSHJ P,X999 + POP P,B + HLRZS B ;RH(B) HAS LINE-# OFFSET FOR PAGE. + HRRZ CH,1(D) ; GET THE TYPE-CODE OF THE REFERENCE + JUMPE CH,[ ;AND GET THE FLAG CHARACTER FOR IT, + MOVEI CH,"- ;OR "-" IF TYPE UNKNOWN, + JRST MCRFN6] + SKIPGE (CH) + JRST [ MOVEI CH,"d ;OR "D" FOR A USER-TYPE (PROBABLY A DEFPROP). + JRST MCRFN6] + MOVE CH,1(CH) ;BUT NORMALLY, THE FLAG CHAR IS THE SECOND WORD OF THE TYPE. +MCRFN6: 2PATCH + HRRZ A,2(D) + ADDI A,1(B) + IDIVI A,1000. + JUMPE A,MCRFN4 + 2PATCH "0(A) +MCRFN4: MOVE A,B + IDIVI A,100. + IDIVI B,10. + 2PATCH "0(A) + 2PATCH "0(B) + 2PATCH "0(C) + ADDI CC,10 + POPJ P, + +SUBTTL LISP OBARRAY + +IFN LISPSW,[ + +2LSUBR: 1KSUBR: 2KSUBR: .VALUE + +IFN 0,[ ;THIS IS THE SIMPLE WAY OF CREATING THE OBARRAY. IT MAKES LOTS OF LITERALS. +DEFINE ATOM NAME,1L=1LSUBR,2L=2LSUBR,1K=1KSUBR,2K=2KSUBR + [SIXBIT |NAME| IFLE -6+.LENGTH |NAME|,[? 0]] + 1L,,2L + 1K,,2K +TERMIN +];IFN 0 + +IF1 [ +;ON PASS 1, JUST LEAVE SPACE FOR THE ATOM HEADER SO LOBARRAY CAN BE SET UP. +DEFINE ATOM JUNK/ + BLOCK 3 +TERMIN +];IF1 + +IF2 [ +;ON PASS 2, WE ASSEMBLE THE HEADERS IN-LINE, AND THE PNAMES IN THE BLOCK +;STARTING AT "PNAMES". "ATMPTR" POINTS TO PLACE TO PUT NEXT PNAME. +DEFINE ATOM NAME,1L=1LSUBR,2L=2LSUBR,1K=1KSUBR,2K=2KSUBR + ATMPTR + 1L,,2L + 1K,,2K +ZZ==. +.==ATMPTR + ASCII |NAME| IFLE -5+.LENGTH |NAME|,[? 0] +ATMPTR==. +.==ZZ +TERMIN + +ATMPTR==PNAMES +];IF2 + +.XCREF ATOM + +;;; NAMES MUST BE FEWER THAN 10. CHARACTERS + +OBARRAY: + ATOM @DEFINE,1LADEF + ATOM ADD1 + ATOM ALARMCLOCK + ATOM ALLOC + ATOM ALPHALESSP + ATOM AND + ATOM APPEND + ATOM APPLY,1LAPPLY + ATOM ARG + ATOM ARGS + ATOM ARRAY,1LARRAY + ATOM ARRAYCALL + ATOM ARRAYDIMS + ATOM ASCII + ATOM ASSOC + ATOM ASSQ + ATOM ATAN + ATOM ATOM + ATOM AUTOLOAD + ATOM BAKLIST + ATOM BAKTRACE + ATOM BIGP + ATOM BLTARRAY + ATOM BOOLE + ATOM BOUNDP + ATOM BREAK + ATOM CAAAAR + ATOM CAAADR + ATOM CAAAR + ATOM CAADAR + ATOM CAADDR + ATOM CAADR + ATOM CAAR + ATOM CADAAR + ATOM CADADR + ATOM CADAR + ATOM CADDAR + ATOM CADDDR + ATOM CADDR + ATOM CADR + ATOM CAR + ATOM CATCH,1LCATCH + ATOM CDAAAR + ATOM CDAADR + ATOM CDAAR + ATOM CDADAR + ATOM CDADDR + ATOM CDADR + ATOM CDAR + ATOM CDDAAR + ATOM CDDADR + ATOM CDDAR + ATOM CDDDAR + ATOM CDDDDR + ATOM CDDDR + ATOM CDDR + ATOM CDR + + ATOM COMMENT,1LCOMMENT + ATOM COND,1LCOND + ATOM CONS + ATOM COPYSYMBOL + ATOM COS + ATOM CRUNIT,1LQUOT + ATOM CURSORPOS + ATOM DECLARE + ATOM DEFPROP,1LDEFPROP + ATOM DEFUN,1LDEFUN + ATOM DELETE + ATOM DELQ + ATOM DEPOSIT + ATOM DIFFERENCE + ATOM DISALINE + ATOM DISAPOINT + ATOM DISBLINK + ATOM DISCHANGE + ATOM DISCOPY + ATOM DISCREATE + ATOM DISCRIBE + ATOM DISCUSS + ATOM DISET + ATOM DISFLUSH + ATOM DISFRAME + ATOM DISGOBBLE + ATOM DISGORGE + ATOM DISINI + ATOM DISLINK + ATOM DISLIST + ATOM DISLOCATE + ATOM DISMARK + ATOM DISMOTION + ATOM DISPLAY + ATOM DO,1LDO + ATOM DUMPARRAYS + ATOM EDIT + ATOM EQ + ATOM EQUAL + ATOM ERR + ATOM ERRFRAME + ATOM ERRLIST + ATOM ERROR + ATOM ERRPRINT + ATOM ERRSET + ATOM EVAL + ATOM EVALFRAME + ATOM EXAMINE + ATOM EXP + ATOM EXPLODE + ATOM EXPLODEC + ATOM EXPLODEN + ATOM EXPT + ATOM FASLOAD,1LQUOT + ATOM FILLARRAY + ATOM FIX + ATOM FIXP + ATOM FLATC + ATOM FLATSIZE + ATOM FLOAT + ATOM FLOATP + ATOM FRETURN + ATOM FUNCALL + ATOM FUNCTION,1LFUNCTION + + ATOM GC + ATOM GCD + ATOM GCPROTECT + ATOM GCRELEASE + ATOM GCTWA + ATOM GENSYM + ATOM GET + ATOM GETCHAR + ATOM GETCHARN + ATOM GETDDTSYM + ATOM GETL + ATOM GETMIDASOP + ATOM GETSP + ATOM GO + ATOM GREATERP + ATOM HAIPART + ATOM HAULONG + ATOM IMPLODE + ATOM IMPX + ATOM INCLUDE,1LINCLUDE + ATOM INTERN + ATOM IOC + ATOM IOG + ATOM ISQRT + ATOM LABEL,1LLABEL + ATOM LAMBDA,1LLAMBDA + ATOM LAST + ATOM LENGTH + ATOM LESSP + ATOM LIST + ATOM LISTARRAY + ATOM LISTEN + ATOM LISTIFY + ATOM LOADARRAYS + ATOM LOG + ATOM LSH + ATOM LSUBR + ATOM LSUBRCALL + ATOM MACDMP + ATOM MACRODEF,1LMDEF + ATOM MAKNAM + ATOM MAKNUM + ATOM MAKUNBOUND + ATOM MAP,1LMAP + ATOM MAPC,1LMAP + ATOM MAPCAN,1LMAP + ATOM MAPCAR,1LMAP + ATOM MAPCON,1LMAP + ATOM MAPLIST,1LMAP + ATOM MAX + ATOM MEMBER + ATOM MEMQ + ATOM MIN + ATOM MINUS + ATOM MINUSP + ATOM MPX + ATOM MUNKAM + + ATOM NCONC + ATOM NCONS + ATOM NEXTPLOT + ATOM NORET + ATOM NOT + ATOM NOUUO + ATOM NRECONC + ATOM NREVERSE + ATOM NULL + ATOM NUMBERP + ATOM NVFIX + ATOM NVID + ATOM NVSET + ATOM OBARRAY + ATOM ODDP + ATOM OMPX + ATOM OR + ATOM PAGEBPORG + ATOM PLOT + ATOM PLOTLIST + ATOM PLOTTEXT + ATOM PLUS + ATOM PLUSP + ATOM PRIN1 + ATOM PRINC + ATOM PRINT + ATOM PROG,1LPROG + ATOM PROG2 + ATOM PROGN + ATOM PURCOPY + ATOM PURIFY + ATOM PUTDDTSYM + ATOM PUTPROP,1LPUTPROP + ATOM QUOTE,1LQUOT + ATOM QUOTIENT + ATOM RANDOM + ATOM READ + ATOM READCH + ATOM READLIST + ATOM READTABLE + ATOM RECLAIM + ATOM REMAINDER + ATOM REMOB + ATOM REMPROP + ATOM RETURN + ATOM REVERSE + ATOM ROT + ATOM RPLACA + ATOM RPLACD + ATOM RUNTIME + + ATOM SAMEPNAMEP + ATOM SASSOC + ATOM SASSQ + ATOM SET + ATOM SETARG + ATOM SETQ,1LSETQ + ATOM SETSYNTAX + ATOM SIGNP + ATOM SIN + ATOM SINGLE + ATOM SLEEP + ATOM SORT + ATOM SORTCAR + ATOM SQRT + ATOM SSTATUS + ATOM STATUS + ATOM STORE + ATOM SUB1 + ATOM SUBLIS + ATOM SUBRCALL + ATOM SUBST + ATOM SUSPEND + ATOM SXHASH + ATOM SYSP + ATOM TERPRI + ATOM THROW + ATOM TIME + ATOM TIMES + ATOM TYI + ATOM TYIPEEK + ATOM TYO + ATOM TYPEP + ATOM UAPPEND,1LQUOT + ATOM UCLOSE,1LQUOT + ATOM UFILE,1LQUOT + ATOM UKILL,1LQUOT + ATOM UPROBE,1LQUOT + ATOM UREAD,1LQUOT + ATOM UWRITE,1LQUOT + ATOM VALRET + ATOM XCONS + ATOM ZEROP + ATOM \ + ATOM \\ + ATOM * + ATOM *$ + ATOM *APPEND + ATOM *APPLY + ATOM *ARRAY,1L$ARRAY + ATOM *BREAK + ATOM *DELETE + ATOM *DELQ + ATOM *DIF + ATOM *EVAL + ATOM *FUNCTION,1LFUNCTION + ATOM *GREAT + ATOM *LESS + ATOM *NCONC + ATOM *NOPOINT + ATOM *PLUS + ATOM *QUO + ATOM *REARRAY + ATOM *RSET + ATOM *TIMES + + ATOM + + ATOM +$ + ATOM - + ATOM -$ + ATOM .* + ATOM . + ATOM *$ + ATOM .+ + ATOM .+$ + ATOM .- + ATOM .-$ + ATOM ./ + ATOM ./$ + ATOM / + ATOM /$ + ATOM 1+ + ATOM 1+$ + ATOM 1- + ATOM 1-$ + ATOM < + ATOM = + ATOM > + +LOBARRAY==:<.-OBARRAY>/3 + +RADIX 2. +LOG2LOB==:CONC .LENGTH /,\LOBARRAY-1,/ +RADIX 8. + +REPEAT <1_LOG2LOB>-LOBARRAY,[ + [377777777777] + 1LSUBR,,2LSUBR + 1KSUBR,,2KSUBR +] ;END OF REPEAT <1_LOG2LOB>-LOBARRAY + +PNAMES: BLOCK 2*LOBARRAY + ;LEAVE SPACE FOR PNAMES. ON P2, ATOM ASSEMBLES INTO THIS SPACE. + +OBLOOK: HLRZ R,A + CAIGE R,-2 + JRST (H) + MOVE L,(A) + CAIE R,-1 + SKIPA R,1(A) + SETZ R, + SETZ C, +REPEAT LOG2LOB,[ + HRRZ D,OBARRAY+<3_>(C) + CAME L,(D) + JRST .+4 + CAML R,1(D) + JRST .+3 + JRST .+3 + CAML L,(D) + ADDI C,3_ +] ;END OF REPEAT LOG2LOB + HRRZ D,OBARRAY(C) + CAMN L,(D) + CAME R,1(D) + JRST (H) + JRST 1(H) + +] ;END IFN LISPSW + +SUBTTL VARIOUS SUICIDE ROUTINES + +;JRST HERE TO RETURN TO SUPERIOR AFTER ERROR. +ERRDIE: SKIPE DEBUG +ITS,[ .VALUE + .LOGOUT + .BREAK 16,40000 ;KILL SELF, DO .RESET INPUT. +];ITS +NOITS,[ PUSHJ P,DEATH1 + RESET ;DON'T CLOSE ANYTHING!!!! + EXIT +];NOITS + +;JRST HERE ON SUCCESSFUL COMPLETION OF THE OPERATION. +DEATH: SKIPE DEBUG +ITS,[ .VALUE ;WHEN DEBUGGING, INHIBIT DEATH. + .LOGOUT + .BREAK 16,160000 +];ITS +NOITS,[ PUSHJ P,DEATH1 + EXIT + +DEATH1: OUTSTR [ASCIZ /Done! +/] + POP P,LOSE ;GO TO DDT IF THERE IS ONE; ELSE JUST EXIT 1, + JRST LOSE3 +];NOITS + +LITTER: CONSTA + +PAT: +PATCH: BLOCK 100 +PURTOP:: +.JBFF1:: ;FOR BENEFIT OF ITS, TO INITIALIZE .JBFF + +PTHI==. ? .==PTLO ;SWITCH TO IMPURE AREA +VPATCH: BLOCK 10 +IMPTOP:: + +END GO diff --git a/src/e142/changes.142 b/src/e142/changes.142 new file mode 100644 index 00000000..09620c57 --- /dev/null +++ b/src/e142/changes.142 @@ -0,0 +1,74 @@ +Changes to EMACS in version 142: + +I believe this covers all of the visible changes; if you +find any more PLEASE let me (Rubenstein) know so I can add +it to the list. In addition to the following, the internal +documentation has been cleaned up and simplified considerably, +an attempt which is still going on. If you come across anything +that you think is unclear, please let me know. + +1. File visiting changed somewhat; C-X C-E command removed. + See internal documentation for new behavior. + +2. In autosave mode, C-X C-S does a normal save (i.e. with real + filename). If given an argument, saves under autosave filename + (i.e. sense of argument reversed). + +3. C-X : (^R Set Column) removed. + +4. The Count Lines command has been removed. In its place, C-X L + (which normally counts lines on a page) can be given an argument, + causing it to count lines in the whole buffer. + +5. The command C-] has been changed from Macro Q-register to + Abort Recursive Edit. This can be used as an emergency exit + to commands which call EMACS recursively (e.g. Alter Options). + +6. Comments which start with two comment start characters are + aligned as if they were code. Triple comment character + causes alignment at left margin. This will mostly interest + lisp people. + +7. M-K now kills next sentence, rather than duplicating M-D. + +8. C-M-X runs Instant Extended Command. Like M-X with no + arguments. See the internal doc. + +9. All "Exchange" commands have been renamed "Transpose" + +10. The "Lisp ) Hack" variable is now renamed to "Display matching + Paren" and defaults ON. + +11. Variable Apropos, List One File have been deleted. + +12. Count Lines, Make Variable and Set Variable Comment have + been made into subroutines. + +13. Edit ..D has been renamed to Edit Syntax Table. + +14. Get Date has been renamed to Insert Date. + +15. Several new commands: Undo, Set Variable, Set Key, Delete File, + Copy File, and Rename File. See internal documentation for + description. + +16. The Auto Save on exit now saves in the real filename. + +17. Teleray 1061 and Heath terminals are now supported as + terminal types 17 and 18. Anyone using a terminal + other than a datamedia, please drop me a note... I'd + like to know what other terminal support is required. + +18. Redisplay is much smarter about tabs, when to use I/D char, etc. + +19. Most minor mode commands (Auto Fill, Auto Save, Overwrite, etc) + now toggle the mode if given no argument. They still turn the + mode on with arg > 0 and off with arg <= 0. + +20. Auto save mode now takes only one argument, turning it on or off. + Number of versions and interval are now controlled by setting + the variables Auto Save Max and Auto Save Interval. + +21. Libraries may now contain a macro called & Kill Library + which can do any necessary cleaning up if and when that library + is killed. \ No newline at end of file diff --git a/src/e142/chess._ej b/src/e142/chess._ej new file mode 100644 index 00000000..b7312303 Binary files /dev/null and b/src/e142/chess._ej differ diff --git a/src/e142/conv. b/src/e142/conv. new file mode 100644 index 00000000..d8f7ea18 --- /dev/null +++ b/src/e142/conv. @@ -0,0 +1,969 @@ +-*-Text-*- + +File: CONV Node: Top Up: (DIR) Next: Init + +Programming in TECO for EMACS + +* Menu: + +* Init Files: Init INIT files and what they can do. +* Syntax: Syntax Syntax library source files to be compiled by + the EMACS library compiler. +* Libraries: Lib Other conventions for Libraries and sources. +* Programming: Prog Conventions for TECO programs to be operated + in the EMACS enviromnment. +* Variables: Vars Named variable (QFoo, etc) conventions. +* Major Modes: Major How to define new major modes. +* Submodes:: How to define submodes. +* Prefix:: Prefix characters, such as C-X. +* Hooks:: Variables which EMACS will call at specific times. +* Dump:: Dumping EMACS environments. +* Build:: Building and dumping a new EMACS. +* Wall Charts:: Making wall charts. +* Q-registers: Qregs Conventions for use of Q-registers. +* FS ^R PREV$: FS^RPREV Conventions for setting/examining FS ^R PREV. +* Debugging: Debug Debugging aids in EMACS. + +File: CONV Node: Init, Up: Top, Previous: Top, Next: Syntax + +INIT Files. + + Each user can have his own file of TECO commands for EMACS to +execute each time he starts it up. EMACS looks for the file +; EMACS and then for ;* EMACS, where +stands for the user's home directory. If neither file exists, the +file EMACS;* EMACS (the default init file) is used instead. +On Twenex, the init file is called EMACS.INIT in your login directory, +and the default init file is EMACS.INIT. + + You can cause an EMACS to read another user's init file by giving it +that user's name as its XUNAME; just do ^S in DDT immediately +before starting the EMACS. + + Setting up the default ^R command definitions and named variables +need not be done in an init file, since that is done before the EMACS +environment is dumped out. As a result, your init file need only +define those commands which you wish to change. Use MM Load Lib to +load any additional libraries (or the :EJ command, for libraries which +have no & Setup Library macro). To obtain a function as a +value so you can put it on a character, simply use M.M . The +U command can define a character, as in for example U..^RX which puts +its argument on Meta-X. Use M.V to create and assign a variable, or +better yet M.C to give it some documentation as well. + + When the init file is started, all q-registers not used by EMACS +(and described herein) will probably be zero. One exception is Q1, +which contains the version number of [PURE], as a string. The default +init file types this out as the "EMACS version number". + + If you have no init file, EMACS runs the default init file, which is +the init file on the EMACS directory. This does various things such +as processing a command line from the superior, loading LISPT if +necessary, printing the EMACS version number and offering help, +checking for lower case characters on an upper-case only terminal, ... + + Most people will find that they wish to perform the actions of the +default init file after their own peculiar initializations. +To do this, just end your own init file with + + ER EMACS;* EMACS @Y ET@ > :M(HFX*) + +(On Twenex, do EREMACS;EMACS INIT or EREMACS.INIT instead) +This practice is recommended because some of the things in the default +init file are important for the proper functioning of EMACS. +If you wish to override the default init file's offer of help, or the +JCL processing, then instead of doing the :M with an empty buffer you +should put in the buffer a string to be treated as if it were the JCL. + + FJ + Z"E I' + ZJ .F[VB + ER EMACS;* EMACS ^Y ET@ > + :M( HFX*( F]VB)) + +Putting just Altmode Space in the buffer when there is no JCL will +prevent the default init file from offering help. For this, use +Z"E I ' in the above example. + + If you have enough of your own macros to have a private library of +them, you need not have both the library and an init file to load the +library. You can just call your library EMACS and give it a +~Filename~ of INIT and a & Setup INIT Library macro to perform the +other initialization. The & Setup INIT Library macro should end by +reading in the default init file, just as an ordinary init file +should, but the calling convention is slightly different: + + :I..9 ER EMACS;* EMACS @Y ET@ > :M(HFX*) + + This section does not intend to be intelligible without reference to +TECO ORDER and to the rest of this file. + +File: CONV Node: Syntax, Up: Top, Previous: Init, Next: Lib + +Syntactic Conventions for TECO Macro Files: + + A source file of EMACS macros contains one macro on each page. Each +macro has a name and documentation as well as its definition. These +source files are processed by a compressor which deletes spaces and +comments and performs other syntactic transformations before they are +run. You can also ask to compress and install a single macro, for +testing, by pointing at it and using MM Compile. + + Every macro's definition begins with the macro name, which is +preceded by a ! and followed by :!. You must not ever put a :!, even +with spaces in between, in a macro source file except to end a macro +name. The macro name must be the first thing on a page except for a +CRLF which must follow the previous formfeed on pages after the first. +The name conventions are that subroutine names start with "& " and +names of commands intended to be put on characters start with "^R ". +This is to keep them from limiting the user's ability to abbreviate +the names of commands he wishes to type. Another convention is that +"#" begins the names of commands which form a dispatch table. For +example, in INFO, the command M causes # INFO M to be run. If you +define a command named # INFO +, that will automatically give you an +INFO command called +. + + After the macro name comes a space, an !, and then the macro class. +Then, after another space, the rest of the line is the "brief" +documentation which is used when only a single line is wanted. It +should be a complete sentence. The macro class should be the +character C for a command which users should call by name, S for a +command intended to be used as a subroutine, and ^R for a command +intended to be placed on a character. The macro class does not +restrict how the macro can actually be used; some of the +documentation commands filter commands to be described by class. + + The macro may have only the brief documentation. In this case, the +brief documentation should be followed by an !. Otherwise, the lines +following the brief documentation are the full documentation, which +ends with the first !. The ! must be at the end of its line, and +should not be an excuse to omit punctuation for the last sentence, +since it will not be seen by the user. To put an ! in the text of the +documentation, use control-^. + + After the line ending with !, the next line contains the beginning +of the macro definition proper. Usually, a blank line is put there to +improve readability. You must remember that the definition will not +be used as written, but will be processed syntactically first: all +spaces and tabs, except those following a ^Q, will be deleted. all +_'s not following a ^Q will be turned into spaces. !* is taken to +start a comment and everything from there up to and including the +following ! is deleted (again, a ^Q will prevent this). Double CRLFs +are converted to single ones. Normally, you should use ^]^Q to do +such quoting, since that is safe in all contexts. Inside search +commands and file commands a ^Q by itself is enough. + + Every macro definition should end with a CRLF, after which may come +a ^L and the next macro definition. Macro definitions are separated +only by CRLF ^L CRLF. A ^L in the middle of the line is just part of +a macro. If you want to put CRLF ^L CRLF inside a macro, use CRLF +^]^Q^L CRLF. + + The major mode TECO Mode is useful for editing EMACS source files. +Comments are defined to start with !* and end with !. +Tab is set to the command ^R Indent Nested, which normally moves the +current line to be under the previous line. With an argument, it +takes the argument to be the number of levels "up" to go, where up +means a lesser amount of indentation. Thus, Tab with an argument of 2 +or more is good for the first line after the end of a conditional or +iteration. In addition, unindented lines and lines containing only +comments are ignored. In addition, Meta-' is defined to move forward +over a TECO conditional, and Meta-" to move back. You might wish to +set the variable QFS CTLMTA to -1 in your TECO Mode Hook variable, +thus making control-meta characters insert control characters. If you +do this, you must also make QSwitch Modes Process Options locally +nonzero. + +File: CONV Node: Lib, Up: Top, Previous: Syntax, Next: Prog + +Library File Conventions + + The command Generate Library, in the library EMACS;PURIFY :EJ, is +used to generate :EJ'able libraries from source files following the +syntactic conventions. The operation has two logical subparts: +compression, which removes spaces and comments, and extracts the +documentation into separately named macros; and purification, which +converts the intermediate form into a :EJ'able library. It is +possible to divide the source for a large library into several +subfiles, which will be compressed separately but purified together. +This saves time if only some of the subfiles are modified, since the +compressed versions are saved in separate files and reused if more +recent than the sources. Generate Library handles such multi-file +sources automatically if all the source files' names are given to it. + + One of the source files going into a library should define a +"command" named ~Filename~. The "definition" of this command should +be some kind of identification for the file. It should usually be the +same as the first filename of the library. The documentation for +~Filename~ should describe the purpose of the library as a whole. + + Generate Library automatically creates a ~Directory~ object which +contains a list of all the macros in the file. A library should never +contain two macros with the same name (~Filename~ is an exception: +see below). + + Sometimes it is desirable to merge several library sources into one +:EJ file. If you always like to use, say, TAGS :EJ, and have a +private library, you may save space and increase speed by including +the source of TAGS when generating your private library. This, +however, means that you need to be able to override the ~Filename~ +macro which comes from the source of TAGS. Generate Library solves +this problem by deleting all but the first ~Filename~. Your private +source file must come first, and contain a ~Filename~, to override the +one in the TAGS source. + + Libraries intended to be accessed via the Run Library command should +contain a macro named , which will be the default entry point, +so that the user need not specify the entry point name. In addition, +they MUST have a ~FILENAME~ which is identical to the actual first +name of the file, so that Run Library can tell whether the library is +already loaded. + + If a library contains a macro named & Setup Library, where + is the library's ~Filename~ name, then whenever the library +is loaded with MM Load Library that macro will be called. It can be +used to put some of the library's macros on ^R characters, for +example. If it is used for that purpose, then it should allow the +user to override it by setting up a named variable. For example, the +TAGS library has an & Setup TAGS Library macro, which defines Meta-.. +However, if the variable TAGS Setup Hook is nonzero, & Setup TAGS +Library executes that variable instead of its default actions. Thus, +a user's init file can specify where the TAGS commands should go if +TAGS is ever loaded, by defining TAGS Setup Hook. + + In addition to the names of macros, there are several names that +(usually or always) be found in purified files of EMACS macros. For +every macro FOO, an object named ~DOC~ FOO is available, that contains +FOO's documentation. In addition, ~DIRECTORY~ contains a list (one +per line) of all the macros that the file wishes to advertise that it +contains. Special things such as described in this section, and all +commands with ~ in their names, are not included. + + ~INVERT~ is supposed to be a macro that is the inverse of the loader +macro. That is, , fed to the +~INVERT~ macro should return a string containing the name of the +object. You should not have to be aware of ~INVERT~, because it will +be provided automatically, and called by & Macro Get Full Name when +necessary. + + The BARE library, which contains definitions of the raw TECO ^R-mode +commands, has a different loader macro and so must be generated in a +special way. The command MM BARE Library Generatesource-file-name +will generate and write out the BARE library. The difference in the +loader macro is simply that if a macro's definition is three +characters long or fewer then it is treated as the name of a ^R +command character (as in .^RA for C-A) and that character's initial +raw-TECO definition is returned instead. If the macro's definition as +found in the ordinary way is longer than three characters, it really +is the definition. This way, documentation strings act normally but +the command names themselves can return the raw TECO commands as their +definitions. BARE has a ~INVERT~ macro which knows how to find the +names of raw TECO commands as well as strings in the library. +However, & Macro Get Full Name has to know specially that such +commands, which are positive numbers rather than strings, should be +passed to the BARE library to invert. + +File: CONV Node: Prog, Up: Top, Previous: Lib, Next: Vars + +Programming Conventions + + For good programming practise, every CRLF that is not +part of a string argument should be followed by an indentation +to a position that indicates the current depth in iterations +and conditionals. Use of the Tab command will make this easy. + + Since the FS S ERROR$ flag is normally set in EMACS, searches that +are followed by ";" must always be given the ":" modifier; otherwise, +they will cause errors when they fail, before noticing the ";". This +is because, if FS S ERROR$ is not set, a user who types an iteration +in the minibuffer and omits the ";" is likely to cause himself extreme +lossage. The Tab TECO command is disabled in the EMACS environment, +and is a no-op. Use 9I or I^]^Q to insert a tab. + + Use named subroutines whenever convenient. The subroutine +should usually have documentation beginning with "S " +so that users doing a "List Commands" will not see it, and +a name beginning with "& " so that it will not interfere with the +user's attempt to abbreviate command names. +Call the subroutine with M( M.M&_Subroutine$) (note the +_ is used to get a space). MM&_Subroutine$ would work, but +macros are not supposed to depend on having no-dot q-regs +set up. + + The normal EMACS command level is precisely the TECO ^R command, +with characters redefined to run EMACS macros or user-supplied macros. +All of the information in TECO ORDER on the ^R command, facilities +available for macros which are definitions of ^R characters, and what +values should be returned by such macros, are very important for +anyone who writes macros which are to be placed on characters. + + The mark is kept in TECO's "Ring buffer of point". It's value can +be obtained with :^V with no argument; :^V will push a new value +of the mark. ^V with no colon can be used to pop the mark (read TECO +ORDER for details). One consequence of this scheme is that there is +always a mark somewhere. Note that the ^W EMACS command POPS the +mark, rather than leaving a useless mark at point. + + Commands that take input should do M.I before actually reading it. +That will prompt for the input. The user may redefine .I if he wishes +to eliminate prompting, but even so he should still define all his +macros to use M.I so that other users will receive the behavior they +want. + + Commands that call ^R on data that the user is likely not to regard +as "the thing he is editing" should do 0[..F before the ^R, to turn +off auto-saving, and inhibit window, buffer or file switching (either +of which would cause garbage results if allowed to proceed). See the +& Check Top Level subroutine. They should also bind the default +filenames to GAZONK .DEL, which will prevent the user from screwing +himself with a ^X^W. + + No non-dotted Q-regs should be reserved by the macros, except for +user interfaces like MM. Also, avoid using double-dot Q-regs except +as defined in TECO ORDER. All temporary Q-regs should be pushed and +popped. All macros should return with ^\ if possible. + + When you wish to make a ^R command that checks for the +presence of a ^U as an argument, the conditional to use is +F^XF^Y"N, which succeeds if there was an explicit argument (^U or +otherwise). This makes it convenient to use the macro as a +subroutine, since then one can give it an argument of 1 to mean +"^U", and no argument to mean "no ^U". + + Anything that changes information which is displayed in the mode +line should do 1FS MODE CHANGE so that FS MODE MACRO will eventually +be run to update q-register ..J and thus the mode line. + + If you wish to read input from the user, if it is only a few +characters you can use M.I. But if it can be long or complicated +then rather than writing your own editing facilities for the input +you should use the minibuffer to read it. Simply call & Minibuffer +with the buffer containing any initialization for the input, and on +return take the contents of the buffer as the user's string. See +the documentation of & Minibuffer for more details. Alternatively, +you can read the input with & Read Line, but then the only editing +available will be Rubout. + + I suggest that, if you intend to do any significant programming, you +do MM List Subroutines to find out what is available to you, and read +some of the EMACS source code. + +File: CONV Node: Vars, Up: Top, Previous: Prog, Next: Major + +Named Variable Conventions + + EMACS makes extensive use of named variables, and provides features +for creating, destroying, editing, and listing them. + + The basic way of getting the value of a named variable that already +exists is to do Q. See TECO ORDER for details. If you are +not sure whether a variable exists, you can do FO..Q  +which will return the value if the variable exists, or if +the variable does not exist. :FO can be used to tell whether a +variable exists. Any TECO command that can use a q-register, except +for ^], can also use an existing named variable if it is given the +name of the variable, surrounded by Altmodes, as the q-reg name. +Although TECO allows unambiguous abbreviations of the name to be used, +it is unwise to use abbreviations in a program. + + To create a variable, do M.V. Unlike Q and FO, M.V +does not manage to handle leading, trailing, or multiple spaces; any +variable created with them in its name will be inaccessible (of +course, in a library source file, spaces and tabs are deleted anyway, +and to get a real space you must use "_"). If the variable already +exists, its value will be set, and the old value will be returned. +For a new variable, 0 is returned. A variable can have a comment as +well as a name and a value. To create a variable and give it a +comment, do M.C. Aside from setting the +comment, M.C is just like M.V. + + Sometimes it is more efficient for changing a variable's value to +redefine some command characters, instead of having one definition +which always checks the value of the variable. Do this by providing a +macro to be run whenever the variable's value is changed. This macro +is supplied by making it the variable's comment. Whenever the comment +begins with a "!" it is taken to be a macro to be run in this manner. + + If you want a variable to be presented for editing by MM Alter +Options, you should give the variable a comment which starts with a +"*". If the variable is to have a macro to run when it changes, and +so the comment must start with a "!", then the variable is an option +if the comment starts with "!". NOTE: if you are not careful, the +TECO code to set up such a variable will contain "!*" which will be +taken as the beginning of a comment. Leaving a space (which will be +removed by compression) between the "!" and the "*" will prevent such +lossage. See where the file EINIT sets up such variables if this +isn't clear. + + You can examine the value, and comment if any, of a variable by +doing MM Describe, just as you would ask for the documentation +of a macro. + + Variables can be local to an individual buffer. To make a variable +local to the current buffer, do M.L. From then on, +setting the variable when the current buffer is selected will not +affect its global value, which other buffers will continue to see, +nor will changing that global value affect the local value. Each +buffer in which the variable is made local has its own value for the +variable, while all other buffers share one global value. +Doing M.L has the side-effect of creating the variable globally +with the value of 0 if it did not already exist globally. Local +variables will be created automatically when a file is visited which +contains a local modes specification at the end. They are also the +way in which major modes perform their redefinitions. + + There are two times when local variables are usually created: when +a buffer is created, and when a major mode is specified. EMACS +automatically creates several local variables for each new buffer; +the Buffer Creation Hook variable will be executed and can create some +more. These locals will remain permanently in existence. All local +variables created after that time will be killed whenever the major +mode is changed. This is how one major mode undoes the redefinitions +performed by the previous major mode. A consequence is that any +explicitly created local variables will also be lost when the major +mode is specified (and, therefore, whenever a file is visited which +specifies its mode). + + Not only variables, but q-registers as well (including ^R command +character definitions), can be made local. To make a q-register +local, use the Make Local Q-register command, with the q-register name +as a string argument: M.QA makes QA local, and M.Q.^RF makes the +definition of Control-F local. + + You can override the library definition of an M.M macro by defining +a variable named "MM " followed by the macro name. M.M checks for +such a variable before looking the name up in the loaded libraries. +MM Compile installs the compiled macro in just this way. A few such +MM variables are present in the default environment. This is to make +calling certain key subroutines more efficient; M.M takes less time +finding the variable than searching the libraries. + + To see a list of all existing variables, do MM List Variables. Each +variable's name and value (abbreviated if too long) will be shown. +A list of variables whose names contain can be seen by doing +MM Variable Apropos. + + To destroy a variable, do M(M.M Kill_Variable) to run +MM Kill Variable. This is necessary only in special situations. + +File: CONV Node: Major, Up: Top, Previous: Vars, Next: Submodes + +Defining Major Modes. + + Each major mode is embodied by a command, such as MM TECO Mode or +MM Lisp Mode. A major mode can be created simply by defining an +appropriate command. However, major mode commands must work in a +particular way. + + Major modes make all their redefinitions by creating local +variables. This is how each buffer can have its own major mode. +Buffer switching does not consciously "switch" modes; it just swaps the +local variables, which has that effect. + + The first thing which each major mode command must do is eliminate +the local variables, if any, made by the previous major mode. This is +done by calling M(M.M &_Init_Buffer_Locals). All local variables of +the current buffer, except those made when the buffer was created, are +killed, and the global values reassert themselves. In addition, & +Init Buffer Locals leaves Q.Q bound to the Make Local Q-register +command. + + Then, the major mode macro should create any local variables and +local q-registers that it wants. Supplying a 1, argument to M.L +causes M.L to run much faster, assuming that the specified variable is +not already local. Example: 1,(:I*;) M.L Comment_Start. This is +recommended for major mode commands. Command characters can be +redefined by using M.Q, since character definitions count as +q-registers. Example: M.M ^R_Indent_for_Lisp M.Q ^^I makes the +Tab character local to the current buffer, and redefines it for Lisp. + + Finally, the major mode macro should do + + 1M(M.M &_Set_Mode_Line  ^\ + +& Set Mode Line makes the new mode appear in the mode line, and the 1 +as argument tells it to do everything else appropriate for finishing +up the change of major mode: Setting the variable QMode, running +the value of Mode Hook if it is defined. + + Exiting with ^\ causes the binding of Q.Q, left by & Init Buffer +Locals, to be popped, as well as any other bindings made by the major +mode macro. + +File: CONV Node: Submodes, Up: Top, Previous: Major, Next: Prefix + +Submodes and ..F + + A submode is just a command which rebinds commands or variables and +then calls ^R recursively on the same buffer. A submode's name +usually starts with the word "Edit", as in "Edit Picture". Submodes +are to be distinguished from commands such as Edit ..D which call ^R +recursively on some other text. + + For submodes to indicate that they are active, the variable Submode +is provided. Binding QSubmode to FOO causes [FOO] to appear in the +mode line after the name of the major mode. However, you must call +& Set Mode Line yourself before entering ^R, and you must do an FN +command to cause & Set Mode Line to be called on the way out (even if +you come out via a throw or an MM Top Level). Usually, the Edit FOO +submode will put FOO in the Submode variable. + + Submodes need not bind ..F to zero. Because the buffer is not +bound, it works reasonably well to switch files, buffers or windows +inside a submode. However, you stay inside the submode when you +switch, which you may not like. Someday there may be a different +implementation of Submodes which makes them local to a buffer. + +File: CONV Node: Prefix, Up: Top, Previous: Submodes, Next: Hooks + +Defining Prefix Characters. + + An EMACS environment can contain any number of prefix characters, +although EMACS normally contains only one - C-X. + + To define a prefix character, you must choose a single-dot +q-register to hold the dispatch table for it. Call MM Make Prefix +Character which returns a string which is a definition +of a prefix character which will look in the specified q-register for +the dispatch table. Then put this string into the desired character's +definition. Normally, dispatch tables are made 96 characters long. +If you want Rubout to be available as a subcommand, you must make it +128 characters long, which you can do by providing 128 as an argument +to Make Prefix Character. + + For example, a prefix character C-Y can be defined to dispatch +through q-register .Y by doing + + M(M.M Make Prefix Character).Y U.Y + +After this, you can define individual subcommands by doing things like +M.MFOO U:.Y(A) which puts MM FOO on C-Y A. + + +How Prefix Characters Dispatch. + + All prefix characters made by Make Prefix Character, including the +initially present C-X, do their work by calling the contents of +q-register .P, providing the dispatch table as an argument. .P reads +the input character, extracts the definition of the subcommand, and +returns it. The prefix character itself then calls whatever .value P +returns. You are free to redefine .P to get different behavior, as +long as you respect the interface conventions. Take a look at the +source code for ^^ Prefix Character Driver, which is the default +contents of .P. + + +Making Self-documentation Work for Prefix Characters. + + In order for Where Is and Apropos to list all the ways a command can +be reached as a subcommand of a prefix character, all prefix +characters must be listed in QPrefix Char List. This list has a +very ugly format: there are six characters for each prefix +character. The first two contain the 9-bit code for the prefix +character; the top 2 bits in the first and the bottom 7 bits in the +second. The next four characters are the name of the q-register which +contains the dispatch table used by the prefix character. For +example, the default EMACS value of QPrefix Char List is ".X ". + +File: CONV Node: Hooks, Up: Top, Previous: Prefix, Next: Dump + +Hooks Provided by EMACS + + EMACS offers several hooks in the form of variables whose values +will be executed if nonzero at specific times. + +Buffer Creation Hook + + This variable is executed when a new EMACS buffer is made by Select +Buffer, just after that buffer has been selected. It might use M.L to +add a local variable, in case you want a certain variable to be local +in each buffer. If you do this, you might want to change the global +value of Initial Local Count to the number of initial locals you +expect most buffers to have. It works to have a different number, but +such buffers are given local values of Iitial Local Count, which is +wasteful if not necessary. But if you do change Initial Local Count +globally, make sure you either create the additional locals in the +Main buffer at the same time, or give that buffer a suitable local +definition of Initial Local Count. + + The Buffer Creation Hook is not run when a buffer is created by +Append to Buffer. This is obviously wrong, but since the buffer thus +created is never actually selected, there is no easy way to fix this. + +Buffer Selection Hook + + This variable is executed whenever a buffer has just been selected. +It is most likely to be useful when made local to a particular buffer. + +Buffer Deselection Hook + + This variable is executed whenever a buffer is just about to be +deselected. It is most likely to be useful when made local to a +particular buffer. + +Visit File Hook + + This variable is executed whenever a file has been visited. All the +normal actions of visiting are already complete. + +Set Mode Line Hook + + This variable is executed by & Set Mode Line. If it returns a +string pointer as a value, that string will be stuck into the mode +line just before the closeparen. The purpose of this variable is to +allow libraries which have state variables to display them in the mode +line. So that several libraries can do this without interfering with +each other, each library should append its own hook to the variable +Set Mode Line Hook instead of setting it, and each library's +contribution must be able to accept an argument from a previous +library's contribution and append onto it. For example, a reasonable +string to add " FOO" into the mode line would be: + + +0[1 FQ1"L :I1' :I* 1_FOO (]1) + +This string, at the beginning of Set Mode Line Hook, would return a +string containing just " FOO"; if preceded by another such hook, it +would append the " FOO" onto what that other hook tried to return. + + Setup Hook + + Each library's & Setup Library macro should check for the +existence of a Setup Hook variable, using 0FO..Q. If the +variable exists and is nonzero, the setup macro should execute the +variable INSTEAD of its normal actions. + + Mode Hook + + Each major mode executes a mode hook variable after making its +normal redefinitions, but before updating the mode line. Mode hooks +can create additional local variables or local q-registers (including +local ^R command redefinitions). + +File: CONV Node: Dump, Up: Top, Previous: Hooks, Next: Build + +Dumping an EMACS Environment. + + Dumping an EMACS environment so that it can be loaded and run again +is no simple feat. Since the environment, when dumped (with @EJ), +contains absolute pointers into the main EMACS library, we must make +sure that when the environment is run again the same version of that +library will be at the same place in the address space. This is +accomplished by the Dump Environment command in the PURIFY library. + + The Dump Environment command in the PURIFY library has the ability +to dump out an EMACS environment so that, when loaded, it will reload +the same libraries that were loaded at dumping time - the same +versions, even, if multiple versions of the libraries are maintained. +Before calling Dump Environment, you must decide which of the loaded +libraries are to be reloaded by the dump file. Given such a library, +called (say) "Mumble", you must set up a variable QMumble Library +Filename containing the filename to be used to reload that library. +This filename can contain a version number, if you are interested in +loading the same version as the dumped environment was made with (this +is necessary if any pointers to macros in that library exist in +q-registers or ^R character definitions, etc.). +Only libraries for which such variables are created will be reloaded +by the dumped environment. Not all loaded libraries must be included, +but those which are must be contiguous, and include the first one +loaded. + + In addition, before calling Dump Environment you must specify the +TECO commands to be executed when the dump file is reloaded. This is +done by creating a variable named QMM & Startup Mumble, where Mumble +stands for the contents of QEditor Name. For EMACS, it is +called QMM & Startup EMACS. The contents of q-register ..L are NOT used +when the dump file is started up, but they will reappear in ..L after +start up so that they will be run if the restarted dump file is +stopped and started again. The QMM & Startup Mumble variable is killed +by Dump Environment, since it will be no use afterward. Actually, if +you wish, you can have a command named just & Startup Mumble in one of +the libraries to be reloaded by the dump file, instead. + + The contents of q-register ..L when Dump Environment is called are +NOT used to initialize the dump file when it is reloaded. However, +they do persist in ..L when the reloaded dumped environment is +running, and if that job is stopped and restarted again, the ..L will +be used. + + If your EMACS init file takes a long time to run, you can use Dump +Environment yourself after running the init file. The QEMACS Library +Filename variable remains set up, so you need not worry about getting +the right version of it. Just set up variables for the other +libraries that you want loaded, provide a suitable QMM & Startup +EMACS, and call Dump Environment. + +File: CONV Node: Build, Up: Top, Previous: Dump, Next: Wall Charts + +How to Build and Dump a New EMACS. + + Before building a new dumped EMACS, you must of course Generate +up-to-date versions of the essential libraries. This can be done by + + M-X RunEINIT? Generate + + The visible procedure for building a new EMACS is simply to do + + :NTECO EMACS; + +which runs EMACS;.TECO. (INIT) in NTECO. This leaves you in the TECO +top-level loop, typing TECO command strings, and should display an +EMACS-style mode line. Then, to dump the EMACS, type + + MMRunPURIFYDump + +which will dump the environment you have built. Then kill the job. + + +How Building and Dumping Work + + Building a new EMACS environment has three phases: loading +libraries, creating the "essential environment" necessary for EMACS +macros to work at all, and making the default set of command bindings. +Two other minor operations are the loading of the patch file, and the +purification of variable names. The first phase is straightforward: +it simply loads the latest version of [PURE] :EJ, and also the EINIT +library which contains the code for performing the rest of the +initialization. + + Loading the essential environment is done by the & Load Essential +Environment command in EINIT. This sets up things like q-registers +.M, .L, .V, .A, etc. as well as the option variables which many +commands assume the existence of. Part of loading the essential +environment is loading the patch file EMACS;EPATCH >, which contains +corrected versions of macros changed since [PURE] was generated. The +format of EPATCH is just that of a library source file; EPATCH is +read in and MM Compile One Macro is done on each page of it. + + Loading the default EMACS environment is done by & Load Default +Environment in EINIT. This is what defines C-N to run ^R Down Real. +The reason why it and & Load Essential Environment are not combined is +so that other command environments which use the EMACS execution +environment can be easily built. Building such an environment would +involve calling & Load Essential Environment, and then using something +else instead of & Load Default Environment. + + At the end of building the environment, the variable names are +purified. In order to save a few hundred words of impure core for all +users, the predefined variables' names and their comments are made to +live inside the [PURE] file instead of in impure string space. The +necessary strings are created in [PURE] by the special file VARS, +which is included in the generation of the [PURE] library. It inserts +the strings into the [PURE] file inside of another string, so that +they are conveniently out of the way. Then, the Purify Variables +command in EINIT is used to look at each variable and replace its +impure name with the corresponding pure string, if there is one. + + +How Stand-alone RMAIL and INFO are Built and Dumped. + + Stand-alone INFO differs from an EMACS in that, on start-up, instead +of running the user's or the default init file, a particular procedure +(that of entering ^R-mode and then running MM INFO) is followed. +INFO is built by an EMACS init file which calls Dump Environment, +setting Editor Name to INFO and providing an appropriate MM & Startup +INFO macro to be used to start up the dump file when it is reloaded. +On the practical level, the EMACS init file for INFO actually +dumps the INFO, instead of returning and letting the user dump it. + + Stand-alone RMAIL is dumped by a TECO init file instead of an EMACS +init file, because while stand-alone INFO contains the standard EMACS +^R command definitions, stand-alone RMAIL contains the bare TECO ^R +command definitions. It therefore cannot be built starting from a +whole EMACS. + + New versions of stand-alone RMAIL and INFO must be made for each new +TECO or EMACS version, just like new versions of the EMACS dump file. +The stand-alone RMAIL and INFO always load up the current version of +the RMAIL and INFO libraries, rather than the version which was +current when they were dumped, so new RMAIL and INFO dump files do not +generally need to be made when new versions of those libraries are +installed. + +File: CONV Node: Wall Charts, Up: Top, Previous: Build, Next: Qregs + +Making Wall Charts + + Wall Charts are made by MM RunABSTRWall Chart +with an empty buffer. This produces a wall chart in the buffer, +describing the environment as it exists. is a list of +names of prefix characters, each of which should get a page describing +all of its subcommands. The prefix characters are named as if you +were accessing their definitions as q-registers, such as ".X" for +C-X. The names should be separated by Altmodes. Two Altmodes end the +list of prefix character names. + + +Writing the Documentation Files EMACS CHART and EMACS DOC. + + These two files are produced from the self-documentation strings +within EMACS by the macros in the library ABSTR. Simply doing + + M-X RunEINIT? Document + +will update them according to the current environment. Make sure that +you do this as a user who does not have an init file! Otherwise, the +files will reflect your command definitions rather than the default. + +File: CONV Node: Qregs, Up: Top, Previous: Wall Charts, Next: FS^RPREV + +Usage of Q-registers in EMACS and Macros Intended for EMACS + + EMACS makes no use of non-dot q-regs except as saved and restored +local variables, unless the user explicitly requests such use +with (say) ^XB or ^XX, except for M and R, and even those are not +depended on by the EMACS macros. User macros may use non-dot q-regs +freely, but those intended for general use should not do so except as +local variables (pushed and popped). + + User macros should not use single or double dot q-regs except as +listed here. If it is really essential, you should ask RMS to +allocate another single-dot q-reg for a specific use. Normally, a +named variable is just as good. + + .A MM & Autoload. This macro loads a library temporarily + and returns a pointer to a specified macro in it. + For example, M.A DIREDClean Dir loads the DIRED + library and returns a pointer to the Clean Dir macro + in it. FS :EJPAGE is pushed and left on the stack, + so that the library will be flushed when the macro + which invoked M.A exits and unwinds the stack. + .B The buffer table. This is a q-vector which is + subdivided into a section for each EMACS named buffer. + The details of the format are described in a comment + at the front of the EMACS source file BUFFER. + + .C Set Variable Comment. + Like .V, but creates a comment for the variable. + M.C   creates if necessary, + giving it the comment and the value . + defaults to 0. If the comment starts with + "*", then the variable is an "option" + and MM Alter Options will let the user edit it. + .F The "normal" (top-level) contents of ..F. + When .F and ..F are not the same, EMACS knows that + it is not safe to switch buffers, windows or files. + .F should not be zero; that would lose. See ..F. + .H The horizontal position "goal" for ^N and ^P + commands. If it is a small positive number, it + is a temporary goal, which will be reset by + each ^N or ^P not following another such. The + other possible values in .H are 1000000. plus a + small number, which indicates a semipermanent goal + that was established by ^R Set Goal Column and + which it alone can alter. + .I ^^ Prepare for Input. Do M.I before doing an + FI to read input. The second argument, if any + is the character to prompt with (default is in Q..0). + The first argument is bit-decoded: 1 means that + the control and meta prefix characters should be + noticed, and 2 suppresses prompting and echoing + (acts as if the characater being read is an independent + command). + .L Make Local Variable. Do M.L  to make + into a local variable of the current buffer. + If it already is local, nothing is changed. If + didn't exist at all, 0M.V is implied. + The global value of is not changed; the local + starts off with that same value as well. + If M.L is given a numeric argument, it becomes + the new value of the (local) . + .M ^^ Macro Get. M.M$ returns a pointer to + the macro . Normally, an error will + occur if the name is undefined or ambiguous, + but if 1, is given as argument, instead of an error, + the value 0 or 1 will be returned. Independently, + a pointer to a file can be given as an argument, + and the macro will be looked for in that file. + .N The ring buffer of minibuffer commands. All commands + that use the minibuffer and execute its contents + normally push their commands onto this ring, + so you can run them again easily. Q.N is a q-vector + whose 0th element is the most recent minibuffer. + .P M.P is the driver for "prefix" ^R characters, + which read another character and dispatch on it. + Whatever you put in .P should work like what is + usually put there: ^^ Prefix Character Driver. + See Make Prefix Character. + .V Named Variable maker. (Teco "altmode" Q-regs) + .W Is a flag that determines whether the word commands + refer to LISP atoms. It holds either a null string + (if they do not) or an "@" (if they do). + + ..F normally holds the auto-filing secretary macro. + Auto-saving is turned off by zeroing FS ^R MDLY, + not by changing ..F. Normally, .F contains the + same thing as ..F. Macros which call ^R recursively + should bind ..F to 0, thus inhibiting auto-saving. + Also, the fact that .F and ..F will then be different + will serve as an indication that it is not safe to + switch buffers, files or windows. If you use a + modified version of the secretary macro, you must + store it in both ..F and .F for proper operation. + To turn off the secretary macro globally, you should + not simply set .F and ..F to zero, because then the + functions that bind ..F to zero will not make it + different from .F. You must make a null string and + put it in .F and ..F. + ..K A qvector used to hold strings of deleted text + by the ^R Kill ... and ^R Un-kill commands. + The elements are the strings, in the order they + were killed. The beginning may be filled with zeros, + if there are not enough remembered killed strings + to use the whole qvector. + ..M holds the keyboard macro call stack. + See the file KBDMAC. + +File: CONV Node: FS^RPREV, Up: Top, Previous: Qregs, Next: Debug + +FS ^R LAST / FS ^R PREV Convention + + Some commands set FS ^R LAST to a special value not in +the range of 9-bit characters, to make it possible to test +whether the previous command was in a certain class without +having to know which characters various macros are on. +These are the values used: + +512+27 is set at times in minibuffering, when the + (1033 octal) most recent character was an altmode but a + following altmode should not exit. + +1001 (decimal) is set by deleting commands. + This allows multiple consecutive deletions + to be combined in the ..K ring. + +1002 is set by the vertical-motion commands + so that repeated vertical motion commands + can use the same horizontal position as a goal. + +1003 signals that it is OK for m-Y (^R Un-kill Pop) + to work even though the current region is not + on the kill-ring. This is used by commands like + Fill Region which save the region then do a simple + but possibly dangerous transformation to it. + +File: CONV Node: Debug, Up: Top, Previous: FS^RPREV + +Debugging + + For debugging, make use of the macro MM TCompile, which compresses +the definition of the macro you are pointing at and makes it available +to M.M. This makes it possible to test a new version of a macro +without purifying the whole file containing it. Insert a ^R command +into the definition to make a "breakpoint" which will allow you to +look around. Exiting the ^R will cause execution of the macro to +resume. To test-compile the macro and put it on a character, give the +name of the character as a q-register as an argument to MM Tcompile, +as in MM TCompile.N to set C-N's definition. Any q-register name +is allowed there. + + The default EMACS error handler runs MM Backtrace after every +error, if the first character you type is "?". This feature allows +you to examine the stack, as well as all q-registers and other +variables. MM DescribeBacktrace for details. If QDebug is +nonzero, you can type "?" to get a backtrace after a quit as well as +after an error. + +*note TDEBUG: (TDEBUG)Top, for info on the superb TDEBUG package +which allows you to step through the execution of a macro, +and examine the macro and q-register pdls. + \ No newline at end of file diff --git a/src/e142/datamedia. b/src/e142/datamedia. new file mode 100644 index 00000000..ec082262 --- /dev/null +++ b/src/e142/datamedia. @@ -0,0 +1,1162 @@ +!* -*-TECO-*- ! + +!~FILENAME~:! !Library to rearrange the command set for easy use from +SRI-style Datamedia keyboards. Commands are summarized in the file +DATAMEDIA.CHART .! +DATAMEDIA + +!& Setup DATAMEDIA Library:! !& Setup macro! + + M(M.MDatamedia) + + +!Datamedia:! !C Set up the EMACS/Datamedia environment. +Rearranges the command set for easy use from SRI-style +Datamedia keyboards. Commands are summarized in the file +DATAMEDIA.CHART .! + + Q..$[0 !* An undefined function ! + + 640 FS Q VECTORU.X !* Redefine all ^X fns, room for ^X{, etc. ! + + 2 FS ^R INITu..< + 6 FS ^R INITu..> + + M.M^R_Backward_Wordu..( + M.M^R_Backward_End-of-WordU:.X(() + + M.M^R_Forward_WordU..) + M.M^R_Forward_End-of-WordU:.X()) + + M.M^R_Beginning_of_Real_Lineu..[ + M.M^R_Back_to_IndentationU:.X([) + + M.M^R_Prefix_MetaU.] + M.M^R_End_of_Real_Lineu..] + + !* ^^ already is Prefix-Control ! + M.M^R_Up_Real_Lineu..^ + M.M^R_Up_Comment_LineU:.X(^) + + M.MDM_Indent_New_LineuJ + M.M^R_Down_Real_Lineu..J + M.M^R_Indent_New_Comment_LineU:.X(12.) + + !*c-r! + 15. FS ^R INITUM + 16. FS ^R INITu..M + M.M^R_Down_Comment_LineU:.X(15.) + + M.M^R_Goto_BeginningU..{ + M.M^R_Mark_BeginningU:.X({) + + M.M^R_Goto_EndU..} + M.M^R_Mark_EndU:.X(}) + + M.M^R_Previous_ScreenU..+ + + M.M^R_Prefix_Control-MetaU.\ + M.M^R_Next_ScreenU..\ + + M.M^R_Move_to_Screen_EdgeU..| + + M.M^R_Reposition_WindowU..~ + + M.M^R_New_WindowU..= + M.MDM_Where_Am_IU:.X(=) + + !*delete! + M.M^R_Backward_Kill_Wordu.. + M.M^R_Backward_Kill_to_End-of-WordU:.X() + + !*Tab, edit-tab! + 11. FS ^R INITUI + M.MDM_Indent_NestedU..I + M.M^R_Indent_RigidlyU:.X(9) + + M.M^R_Universal_ArgumentU..* + + M.M^R_Indent_for_CommentU..; + M.M^R_Set_Comment_ColumnU:.X(;) + + M.M^R_Prefix_MetaU + M.M^R_Prefix_Control-MetaU.. + + M.M^R_Define_Kbd_MacroU../ + M.M^R_Call_Last_Kbd_MacroU:.X(/) + + M.M^R_One_WindowU:.X(1) + M.M^R_Two_WindowsU:.X(2) + M.M^R_View_Two_WindowsU:.X(3) + M.M^R_Modified_Two_WindowsU:.X(4) + + Q0U.@ + M.M^R_Mark_SentenceU..@ + M.M^R_Mark_ParagraphU...@ + + Q0U.A + M.M^R_Append_Next_KillU..A + Q0U...A + + Q0U.B + M.M^R_Backward_SentenceU..B + M.M^R_Backward_ParagraphU...B + + Q0U.C + M.M^R_Center_LineU..C + Q0U...C + + Q0U.D + 4 FS ^R INITu..D !*Delete Character! + M.M^R_Kill_Wordu...D + M.M^R_Directory_DisplayU:.X() + M.M^R_Kill_to_End-of-WordU:.X(D) + + Q0U.E + M.M^R_Exchange_CharactersU..E + M.M^R_Exchange_WordsU...E + M.M^R_Edit_FileU:.X() + + Q0U.F + M.M^R_Forward_SentenceU..F + M.M^R_Forward_ParagraphU...F + M.M^R_Find_FileU:.X() + + M.M^R_Goto_Fixed_MarkU..G + Q0U...G + + Q0U + M.M^R_Set_Bounds_RegionU..H + M.M^R_Set_Bounds_FullU.. + + 17. FS ^R INITU..I !*Edit-I = Insert CRLF! + + Q0U..J + + Q0U.K + M.M^R_Kill_Lineu..K + M.M^R_Kill_Regionu...K + M.M^R_Kill_into_Q-regU:.X(K) + + 12. FS ^R INITU.L + M.M^R_Lowercase_Wordu..L + M.M^R_Lowercase_Regionu...L + + M.M^R_Set_Fixed_MarkU..M + + M.M^R_No-opU.N + M.M^R_Un-killU..N + M.M^R_Un-kill_PopU...N + M.M^R_Get_Q-regU:.X(N) + + Q0U.O + Q0U..O + M.M^R_Complement_Overwrite_Modeu...O + M.M^R_Other_WindowU:.X(O) + + Q0U.P + M.MGoto_PageU..P + M.M^R_Mark_PageU...P + M.M^R_Set_Bounds_PageU:.X(P) + + M.M^R_Quoted_InsertU.Q + M.M^R_Fill_Paragraphu..Q + M.M^R_Fill_Regionu...Q + M.M^R_Set_Fill_ColumnU:.X(Q) + M.M^R_Do_Not_Write_FileU:.X() + + Q0U.R + M.MDM_Reverse_Character_SearchU..R + M.MDM_Reverse_Incremental_SearchU...R + M.MDM_Query_ReplaceU:.X(R) + M.M^R_Read_FileU:.X() + + Q0U.S + M.MDM_Character_SearchU..S + M.MDM_Incremental_SearchU...S + M.M^R_TECO_SearchU:.X(S) + M.MDM_Save_FileU:.X() + + Q0U.T + Q0U..T + Q0U...T + + Q0U.U + M.M^R_Uppercase_Wordu..U + M.M^R_Uppercase_Regionu...U + M.M^R_Uppercase_InitialU:.X(U) + + Q0U.V + Q0U..V + Q0U...V + M.M^R_Visit_FileU:.X() + + M.M^R_Backward_Kill_WordU.W + M.M^R_Copy_LineU..W + M.M^R_Copy_RegionU...W + M.M^R_Put_Q-regU:.X(W) + M.MWrite_FileU:.X() + + Q.XU..X + M.M^R_Execute_Completed_MM_CommandU...X + M.M^R_Execute_MinibufferU:.X(X) + + Q0U.Y + M.MSelect_BufferU..Y + M.MList_BuffersU...Y + + 33. FS ^R INITU.Z + M.M^R_Zap_to_CharacterU..Z + M.M^R_Zap_thru_CharacterU...Z + + !*Create Fixed Mark Q-vector! + MM Make_VariableFixed_Mark + 50 FS Q VECTORUFixed_Mark + + !*Buffer creation uses old mode. Auto Fill is local! + (@:I* / QMode + QAuto_Fill_Mode /) M.V Buffer_Deselection_Hook + (@:i* / M(M.M_A_Mode) !* Call old mode ! + QB M.L Auto_Fill_Mode + QB"N 1 M.L Switch_Mode_Process_Options ' + / ) M.V Buffer_Creation_Hook + + M.V CSearch_Default + + 0 M.V Defining_Kbd_Macro + :i* m.v Last_Kbd_Macro + 20.*5fs q vectoru..m + q..m[..o hk ]..o + (@:I* / QDefining_Kbd_Macro"N + I_Defining' / ) M.V Set_Mode_Line_Hook + + 1 M (M.M Set_Variable_Comment) Indentation_Increment !* +! *_Number_of_spaces_per_level_of_indentation + + (M.MDM_Toplevel_^R)FS ^R ENTER + (M.MDM_Secretary_Macro)U..F + Q..F U .F + + :IEditor_NameEMACS/Datamedia + :I..JEMACS/Datamedia_ + M(M.M&_Set_Mode_Line) + + 0 + + +!^R Complement Overwrite Mode:! +!^R If Overwrite Mode is on, turn it off. If it is off, +turn it on. When Overwrite Mode is on, typed non-meta characters +will delete and overwrite characters in the buffer instead +of being inserted. Meta characters still function normally.! + QOverwrite_Mode[1 + Q1"N0U1'"#-1U1' + Q1UOverwrite_Mode + Q1FS^RREPLACE + M(M.M&_Set_Mode_Line) + 0 + +!Goto Page:! !C Move forward or back by pages, or to specific page. +If no arg, go to top of next page. +If arg is zero, go to top of present page. +If arg is negative, go to top of present page, unless already at top, + in which case go to top of preceding page. +If arg is positive (+n), go to top of page n of buffer. +If two args (m,n), go to line m of page whatever.! + + f[sstring[1 + QPage_Delimiter[0 + u1ff"e1u1' !*Default arg to 1! + "#Q1"G J Q1-1U1'' !*If arg>0, go to top and count from there! + q1"g q1< :s0  ; >' !*Search forwards! + "# Q1"LR' !*Skip this pagemark if on it and arg<0! + -:S0 : ' !*Search backwards! + FF-1"G !*Pre-comma arg (if any) is line number! + .U1 + :S0 : .[2 !*Set a limit! + Q1J -1L !*Count lines! + Q2-."L Q2J ' ' !*Don't go beyond end of page! + 0 + +!^R Copy Lines:! !^R Like killing lines and getting them back, +but doesn't mark buffer modified.! + + .: !*Set the mark! + FF"EL' + "#L' !*Advance pointer! + :M(M.M^R_Copy_Region) !*Do it! + +!^R Set Fixed Mark:! !^R Set either THE mark, or special fixed mark. +If no arg, set "ring-of-point" mark. +If arg is zero or positive, set corresponding fixed mark. +There are 10 fixed marks, numbered 0 to 9. They contain character +counts relative to the beginning of the buffer. Fixed marks may +be changed only by this macro, and are unaffected by killing, etc.! + + + FF"E.:' !*No arg: set THE mark! + "#.U:Fixed_Mark()' !*Else set fixed mark.! + 0 + + +!^R Goto Fixed Mark:! !^R If no arg, exchange point and "ring-of-point" mark. +If negative arg, pop the "ring-of-point" mark. +If zero or positive arg, set "ring-of-point" mark and goto fixed mark.! + + FF"E.(W):' !*No arg: Exchange point and mark! + "#"L.:WW1:<>' !*Neg arg: Pop mark! + "#.: !*Push the mark first! + Q:Fixed_Mark()J ' ' !*And go to fixed mark! + 0 + + +!^R Zap to Character:! !^R Kills text up to but not including a +target character. Uses the macro ^R Character Search to obtain +the target character from the keyboard and search for it. The search +skips over the character pointed to.! + + .: !*Push the mark! + [0 FF"E1U0' "#U0' !*Default args if necessary! + Q0"GC' "#R' !*Skip over first character! + Q0M(M.M^R_Character_Search) !*Search! + "LC' "#R' !*Exclude the character found! + :M(M.M^R_Kill_Region) !*Kill! + +!^R Zap thru Character:! !^R Kills text up to and including a +target character. Uses the macro ^R Character Search to obtain +the target character from the keyboard and search for it.! + + .: !*Push the mark! + [0 FF"E1U0' "#U0' !*Default args if necessary! + Q0M(M.M^R_Character_Search) !*Search! + :M(M.M^R_Kill_Region) !*Kill! + +!^R Forward Word:! !^R Move forward over one word.! + + 1:<1A"C1+'1.W:FWL>F"NFG0' + -1:<2.W:FWL>F"NFG'0 + +!^R Forward End-of-Word:! !^R Move forward to the next word end.! + + f"LW-':<"L-'.wfwl>"nfg'0 + + +!^R Backward End-of-Word:! !^R Like Backward Word, but moves to end of +previous word.! + + 1:<0A"C-1'-1.W:FWL>F"NFG0' + -1:<-2.W:FWL>F"NFG'0 + +!^R Kill Word:! !^R Kill next word and trailing delimiters.! + + 1[9.[0 + 1:<1A"C1+'1.W:FWL>F"NFG0' + -1:<2.W:FWL>F"NFG0' + Q0,.:M(M.M&_Kill_Text) + +!^R Kill to End-of-Word:! !^R Kill to next word end.! + + [9.,(.wfwr).F:M(M.M&_Kill_Text) + + +!^R Backward Kill to End-of-Word:! !^R Like Backward Kill Word, +but kills to end of previous word.! + + -1[9.[0 + 1:<0A"C-1'-1.W:FWL>F"NFG0' + -1:<-2.W:FWL>F"NFG0' + .,Q0:M(M.M&_Kill_Text) + +!^R Kill into Q-reg:! !^R Put Q-reg and Kill text! + + 1:M(M.M^R_Put_Q-reg) + + +!^R No-op:! !^R Does nothing.! + + 0 + + +!DM Where Am I:! !^R Print various things about the cursor position. +Print the page and line, +the X position, the Y position, +the octal code for the following character, +cursor position in characters and as a percentage of the total file, +and the virtual boundaries, if any.! + + :i*CFSECHODIS + QPage_DelimiterU3 + [E [B FSBOUNDUEUB + 0,FSZ FSBOUND + .U0J1U10U4<:S3; .-Q0-2; .U4%1> + Q4J1U2 + Q0J QB,QE FSBOUND + @FTPage_Q1@:= + @FT_Line_Q2@:= + @ft_X= fs shpos@:= + @ft_Y= fs ^r vpos@:= + .-z"n @ft_CH= 8[..e 1a@:=]..e' + @ft_.= .@:= @ft( .*100/fsz@:= @ft%) + fsvz+b"n + @ft_H=< h@:= @ft>' + @ft_ 1fsechoact 0 + +!^R TECO Search:! !^R Search, using the basic TECO string search facility. +Special characters: +^B matches any delimiter char. +^N matches any char other than the char following it in the search + string (i.e., "not"). ^N^B matches non-delimiters, and + ^N^X matches nothing. ^N^Q^B matches all but ^B, etc. +^O divides the string into substrings searched for simultaneously. + Any one of these strings, if found, satisfies the search. +^Q quotes the following char, i.e., deprives it of special significance. + Escape and rubout cannot be quoted. +^X matches any char.! + + 1,M(M.M&_Read_Line)Search:[0 + [1 Q1"E1U1' + Q1:S0"EFG' + 0 + + +!DM Query Replace:! +!^R Replace string, asking about each occurrence. +Query Replace:FOOBAR displays the next FOO; you say what to do. +Space => replace it with BAR and show next FOO. +Rubout => don't replace, but show next FOO. +Comma => replace this FOO and show result, waiting for next command. +Period => replace this FOO and exit. Altmode => just exit. +^ => return to site of previous FOO (actually, jump to mark). +^W => kill this FOO and enter recursive ^R. +^R => enter ^R mode recursively. ^L => redisplay screen. +Exclamation mark => replace all remaining FOOs without asking. +Any other character exits and is read again. +If QCase Replace is nonzero, BAR will be capitalized or all caps +if FOO was. +1 MM Query ReplaceFOO... will replace only FOOs that are +bounded on both sides by delimiter characters (according to ..D).! + + FF"N:\'"#:I*'[1 + 1,M(M.M&_Read_Line)Query_Replace:[0 + 1M(M.MQuery_Replace)0 +  + + +!Grind Sexp:! !C Grind the sexp after the pointer. +A modification of the MIT Grind Sexp that recognizes that +in Interlisp, % quotes a character, " starts a long +string, and ; has no significance. +Uses QMiser Column to decide where to start using "Miser" format, +and QFill Column as the page width to aim for. +Saves the old sexp on the kill ring.! + + 1:< + FDL R !* Find the next list.! + F[VB F[VZ FL FSBOUND !* Narrow bounds to that list.! + F=MODELISP"N OConfirm' + z-b-1000"g !Confirm! ^FTDo_you_really_want_to_Grind_this_s-expression?_(Y_or_N): + FI :FC - Y(  FS Echo Display C FS Echo Display)"N '' + Z: + M(M.M &_Save_Region_and_Query) !* No arg so no query, just save region.! + W J + [2 [3 +!*** Now normalize the expression; put it into the form PRIN1 would print.! + [D 128*5,32:ID !* In QD make a dispatch that! + 11.*5:F D -D :M2  !* turns any whitespace into a single space,! + 15.*5:F D RK :M2  !* deletes CRLFs and the indentation after them,! + 12.*5:F D -D :M2  + %*5:F D C !* Handle %'s and "'s right.! + "*5:F D R ^FLL  + (*5:F D :M3  !* Make sure no whitespace follows ('s and ''s! + !"! '*5:F D :M3  + )*5:F D R M3 C  !* or precedes )'s.! + :I2 Z-.< 1A F_ :; D> 32I  + :I3 Z-.< 1A F_ :; D>  + HFD + J .( 0FS VBW 0L .FS VB )J !* Include all of line, up to (, after B,! + !* so that FS HPOS is accurate.! +!*** Now decode the grinding parameters.! + FS WIDTH-10[W !* Figure the width to aim at! + FS WIDTH*2/3[C !* and the comment column.! + 0FO ..Q Fill_Column F"N UW + QWUC' + -1FO ..Q Comment_Column +1F"G -1UC' + QC[M !* Figure the place to switch to Miser fmt.! + -1FO ..Q Miser_Column +1F"G -1UM' + [R :IR /8+1*8 + 0FO ..Q Comment_Rounding F"N UR' + M.M &_Indent [I +!* G gets recursive macro to grind and pass 1 sexp.! +!* It expects numerc arg = depth in parens.! + [G ^:IG` + [2 S' R !* Pass by all leading quotes.! + 1A-("N ^FWL ' !* Atoms, just skip over.! + FL-.-QW++(FS HPOSU2 Q2)"L FLL ' !* Lists that fit in line, skip over.! + C Q2-QM"L !* If not yet far enough for Miser fmt,! + !"! 1A F';()"L ^FWL 1A-32"E C''' !* Skip 1st element, so get 2 on 1st line.! + !* But if 1st element is a list, use miser fmt anyway.! + FS HPOS U2 !* Q2 gets column to put rest of elements at.! + !LP! 1a-32"E D O LP' !* Don't be confused by whitespace.! + 1A-)"E C ' !* Until end of this list,! + FS HPOSU3 + Q3-Q2"N 13I 10I !* and for lists, indent to right place! + Q2/8,9I Q2&7,32I' + +1MG O LP !* and recursively grind.! + ` + 0MG !* DO IT! + J 7F~ (DEFUN_"E !* Now, if list is (DEFUN FOO..., then! + ^FLL 8F= + ______"E + 8D .U3 L !* Get the thing after FOO onto first line,! + Q3,. F~FEXPR + *(Q3,. F~MACRO + )"E !* and if it is a function property name,! + -2D 6D''' !* get it on that line too.! + J HU2U3 + > !* end errset! + J Z: !* Leave region around the ground sexp.! + Q3,Q2 + + +!DM Incremental Search:! !^R Search for character string. +As characters are typed in, the accumulated string is +searched for. Characters may be rubbed out. +^Q quotes special characters. +^S or M-S repeats the search forward; ^R or M-R repeats it backward. +If the accumulated string is empty, ^R, ^S, M-R or M-S either +reverses the direction of search or gobbles the previous +search string and searches for it again. +Altmode or any random control character exits +(anything but altmode is then executed). +If the accumulated string fails to be found, +you will be notified with one bell. You can then exit, +rub the bad characters out (or ^G them all away), +or try searching in the opposite direction. +Quitting a successful search goes back to the starting +point of the search; quitting a failing search rubs out +enough characters to make it successful again. +Altmode when the string is empty makes the search +non-incremental by calling ^R String Search.! + + !* Modified to make M-S same as ^S, M-R same as ^R! + + [D !* QD is direction and # times to search.! + 0[L !* QL > 0 iff failed to find current search string,! + 10.[R !* QR is state register: ! + !* 40. => ^R or ^S repeating search or gobbling default.! + !* 20. => trying to exit (altmode or funny ctl char).! + !* 10. => just starting.! + !* 4 => printing char just read.! + !* 1 => rubout that restored point.! + + [Q @:iQ` !* MQ pushes current info: ., qL, q2, q0, qD.! + q4+1*5-fq3"e !* We are going to push in q3, so make sure space exists.! + q3[..o zj + 200,0i ]..o' + .u:3(%4) !* Push point, search string,! + qLu:3(%4) + q2u:3(%4) + q0u:3(%4) !* this character, and current direction of search.! + qDu:3(%4) + ` + + [T @:iT` + fs rgetty"n 3.&qR"n !* After a rubout, we are redisplaying! +  fs echo disp T fs echo disp !* The whole search string, so prepare by! +  fs echo disp L fs echo disp '' !* erasing the old stuff.! + @ft 8 :i8 !* Update displayed search string.! + ` + + [0 !* Q0 holds type-in character being processed.! + [2 :i2 !* Q2 holds accumulated search string.! + [8 :i8 !* Q8 has accumulated stuff to type in echo area.! + 1fo..qSearch_Exit_Option !* QE nonzero => random control chars exit.! + 200fs q vector [3 !* Q3 holds stack for partial search strings.! + -1[4 !* Q4 is stack pointer.! + [5 !* Q5 is random temp.! + .[P !* QP has old point (to maybe push at end).! + [S :IS M.M&_Isearch_RuboutUS :MS !* QS has & Isearch Rubout (autoloading)! + 1f[noquit + [6 [7 [..j !* Q6 and Q7 are the success and failure ..J strings.! + qD"g :i6I-Search__ :i7Failing_I-Search__' + !* Either Search or Failing Search appears on --more line.! + qD"l :i6Reverse_I-Search__ :i7Failing_Reverse_I-Search__' + 0[I !* QI is nonzero when we are reading input.! + + fs rgetty"n +  fs echo disp T fs echo disp !* The whole search string, so prepare by! +  fs echo disp L fs echo disp !* erasing the old stuff.! + @ft Search:_ -1fstypeo' + "# @ft _S:_ 1fstypeo' !* Set FS TYPEOUT to prevent M.I from doing ^ V.! + + !Restart! + + 1:< 1uI -2f[noquit !* Set up an errset to catch quits.! + < qL"e q6' "# q7'u..j !* Say in --more-- line whether search is winning.! + 0@V 1uI 2,m.iw :fiu0 0uI @fiu5 + q5-"e fq2:@; ! 0fsnoquitw qD:m(m.m ^R_String_Search)' + q5-8"e o Funny' + q5-176."g o Funny' + q5- +"e  +FS REREAD' + + !Normal! + + 4uR !* Handle printing char.! + mQ !* Push ., qL, q2, q0 and qD into q3, for rubbing out.! + :i2 2 0 !* stick this char at end of search string,! + fq8"n mt' !* Update the display.! + @ft 0 "# + + !Try! !* Note if fall through we are inside a failing conditional.! + + mt !* Update the displayed search string.! + 1&qR"n !' !* Don't search after rubout that restored point properly.! + ' + qL"n !' !* No point in searching if know it would fail.! + + .u5 + 40.&qR"e !* For ^S, ^R suppress the moving back so don't no-op.! + qD"g fq2-1r' !* Move back, so that from FO/\O we find the FOO.! + "# fsz-qP f[ vz + fq2-1"g fq2:c"e zj'' + f]vz'' !* After finding FO backwd, move fwd 3 so can find FOO.! + qD:s2"l !' + q5j 1uL fg ! !* But if search fails, undo that motion back.! + + !Funny! + + q5-177."e o Rubout' + !* Only control characters and backspace get past here.! + q5&137.-S"e Q5-600."L o Forward'' !* Check for C-S and M-S (ignore case bit).! + q5&137.-R"e Q5-600."L o Backward'' !* Note: mustn't change q5 since Control rereads it.! + q5&537.-Q"e o Quote' + qE"e o normal' + o Control + + !Quote! !* ^Q quotes the next character.! + + fs osteco"n -1f[helpch' + 2,m.i fiu0 + fs osteco"n f]helpmac' + o normal + + !Forward! !* ^S means search again forward.! + + qD"l :i6I-Search :i7Failing_I-Search' + q4"L qD"g o Default' !* ^S as 1st char going fwd => gobble default string.! + "# 1uD !'' !* ^S as 1st char, going backward, changed to fwd.! + mQ !* Push ., qL, q2, q0 and qD into q3.! + qD"L 0uL' !* If reversing direction, don't assume search will fail.! + 1uD !* String not null: make sure going fwd,! + 40.uR !* Mark us as a ^S so don't change search string,! + o try !* just search for it a second time.! + + !Backward! !* ^R means search again backward.! + + qD"g :i6Reverse_I-Search :i7Failing_Reverse_I-Search' + q4"L qD"l o Default' !* ^R as 1st char going backwd => gobble default string.! + "# -1uD !'' !* ^R as 1st char, going forward, changed to backwd.! + mQ !* Push ., qL, q2, q0 and qD into q3.! + qD"g 0uL' !* If reversing direction, don't assume search will fail.! + -1uD !* String not null: make sure going backwd,! + 40.uR !* Mark us as a ^R so don't change search string,! + o try + + !Default! !* Come here to use default search string.! + + mQ !* Push current state so can rub the default out.! + qSearch_Default_Ring[..o !* Find the default! + .fs word u2 ]..o !* and gobble it.! + fq2"l :i2' + q2u8 + 40.uR !* Inhibit moving back before starting to search.! + o try + + !Rubout! + + q4"l fg !' !* Rubout when string is empty does nothing.! + ms !* Call & Isearch Rubout.! + o try + + !Control! + + q5 fs reread + 0; + + >>u0 @feqit-q0"e @fg !* If we quit, was it successful or not?! + QL"g mt !* If failing, rub out the unfound chars and restart.! + o Restart' + qI"e ms mt o Restart' !* If quit while actually searching, restart.! + QPJ 0fsnoquit + -1fsquit'' !* If succeeding, restore starting point and quit.! + q0f"n fs err' !* Error not a quit => pass it on.! + + fq2"g + qSearch_Default_Ring [..o !* New search char, save prev default.! + fq(.fsword)-1"G 5c .-z"e j'' !* If previous default is worth saving, push it! + q2,.fsword !* Store current (new) default! + ]..o' + + @ft   !* Echo an altmode to show we have exited.! + qP mMM_&_Maybe_Push_Point !* Maybe leave mark at place search started.! + 0 + +!DM Reverse Incremental Search:! !^R Incremental Search Backwards. +Calls Incremental Search with a negative argument.! + + -@:M(m.mDM_Incremental_Search) + + +!DM Character Search:! !^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search.! + + [0 [1[2 0[3 [9 +!RDCH! M.I @:FIU0 !* Q0 gets 12-bit command char! + FIU9 !* Q9 gets actual ascii char! + Q0-(FS^RLAST)"E F[S STRING !* If repeat char called by use default.! + QCSearch_DefaultFSS STRING + OSEARCH ' + Q0:FCU0 !* Uppercase char! + Q0-301."E !* ^A call other macro.! + Q1:M(M.M^R_String_Search)' + Q0-306."E 1u3 oRDCH ' !* ^F set flag to bring to top! + Q0-321."E M.I FIU9 ' !* ^Q read another character, don't check for special.! + Q0-322."E -Q1U1 ORDCH ' !* ^R reverse direction and read another.! + Q0-323."E F[S STRING !* ^S use default.! + QCSearch_DefaultFSS STRING + OSEARCH ' + Q0-324."E ' !* ^T use teco default. -- note else clause next line.! + "# F[S STRING 0S9 ' !* normal character, compile search for it.! + FSS STRINGuCSearch_Default !* Store current (new) default! +!SEARCH! + .U0 Q1:S"E FG ' !* Do the search, ding if error ! + Q0M(M.M&_Maybe_Push_Point) !* Maybe remember where we came from.! + q3"N 2fo..Q Next_Screen_Context_Lines :f ' !* ^F search, adjust window! + 1  + +!DM Reverse Character Search:! !^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search.! + + -@:M(m.mDM_Character_Search) + + +!LISP Mode:! !C Sets things up for editing LISP code +within the Datamedia environment.! + + M(M.M&_Init_Buffer_Locals) + + M.M^R_Indent_For_LISPM.Q..  + M.M^R_Mark_SexpM.Q.@ + M.M^R_Mark_DefunU:.X(@) + M.M^R_Backward_SexpM.Q.B + M.M^R_Backward_ListM.Q..B + M.M^R_Backward_Up_ListM.Q...B + M.M^R_Beginning_of_DefunU:.X(B) + M.M^R_Kill_SexpM.Q.D + M.M^R_Exchange_SexpsM.Q.E + M.M^R_Forward_SexpM.Q.F + M.M^R_Forward_ListM.Q..F + M.M^R_Forward_Up_ListM.Q...F + M.M^R_End_of_DefunU:.X(F) + + 1,(:I*(*_)M.LComment_Start + 1,(:I*))M.LComment_End + 1,(:I*) M.L Paragraph_Delimiter + 0FO..Q LISP_..D F"E !* Select the LISP-mode syntax table! + !* creating it if doesn't exist.! + !"! :I*_A____A____A____A____A____A____A____A____A______________A_________ +____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A_________A____|____A___AA___A/____A____'____(____)____A____A____A____A___AA____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A________ M.V LISP_..D + Q LISP_..D' M.Q ..D + Q.0,1M(M.M&_Set_Mode_Line)LISP + +!SAIL Mode:! !C Sets things up for editing SAIL programs! + + M(M.MLoad)SAIL !* Need to load the file first ! + :M(M.MSAIL_Mode) !* Call the redefined setup macro ! + + +!MIDAS Mode:! !C Set things up for editing MIDAS code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines.! + + M(M.M &_Init_Buffer_Locals) !* See comment at top of file.! + 1,(:I*;) M.L Comment_Start + 1,(:I*) M.L Paragraph_Delimiter +!*** Save time by doing the M.M's only once, the first time MIDAS Mode is called.! + 0fo..q MIDAS_Vector[1 + q1"e 5*5fs qvectoru1 q1m.v MIDAS_Vector + m.m ^R_Go_to_AC_Fieldu:1(0) + m.m ^R_Kill_Terminated_Wordu:1(1) + m.m ^R_Go_to_Address_Fieldu:1(2) + m.m ^R_Go_to_Next_Labelu:1(3) + m.m ^R_Go_to_Previous_Labelu:1(4)' + 1,Q:1(0) M.Q ..B + 1,Q:1(2) M.Q ..F + 1,Q:1(3) M.Q ...F + 1,Q:1(4) M.Q ...B + Q.0,1M(M.M&_Set_Mode_Line) MACRO  + +!MACRO Mode:! !C Set things up for editing MACRO code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines.! + + :M(M.M MIDAS_Mode) + + +!TECO Mode:! !C Set things up for editing TECO code. +Makes Rubout the Tab-hacking Rubout. +Loads the PURIFY library. Makes comments be bounded by "* " and "". +M-F moves forward over a TECO conditional; M-B, back.! + + M(M.M&_Init_Buffer_Locals) + 1,(:I*!*_)M.LComment_Start + 1,(:I*!)M.LComment_End + 1,(:I*)M.LParagraph_Delimiter + 1,Q(1,Q.M.Q)M.Q. + 1,M.M&_FILE_PURIFY_LOADED"E + F[DFILEM(M.MLoad_Library)PURIFY' + m.m^R_Backward_TECO_ConditionalM.Q..B + m.m^R_Forward_TECO_ConditionalM.Q..F + 0FO..Q TECO_..D F"E !* Select the TECO-mode syntax table! + !* creating it if doesn't exist.! + !"! :I*__________________________________________________________________ +_____________________________________________________________________A_____________________________A____A____A____A____A____A____'____(____)____A____A_________A____A____/___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____;____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____|____A____A________ M.V TECO_..D + Q TECO_..D' M.Q ..D + Q.0,1M(M.M&_Set_Mode_Line)TECO + +!Text Mode:! !C Set things up for editing English text. +Makes Auto Fill not indent new lines; says there are no comments.! + + M(M.M &_Init_Buffer_Locals) !* See comment at top of file.! + 1,0M.L Space_Indent_Flag + 0FO..Q Text_..D F"E !* Select the Text-mode syntax table! + !* creating it if doesn't exist.! + !"! :I*__________________________________________________________________ +_____________________________________________________________________A_____________________________A____A____A____A____A____A___A'____(____)____A____A_________A____A____/___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____;____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____|____A____A________ M.V Text_..D + Q Text_..D' M.Q ..D + Q.0,1M(M.M&_Set_Mode_Line) Text  + +!& SAI Mode:! !S Setup for SAIL.! + :M(M.M SAIL_Mode) + +!& LSP Mode:! !& LISP Mode:! !S Setup for LISP.! + :M(M.M LISP_Mode) + +!& PUB Mode:! !S Setup for Text mode.! + :M(M.M Text_Mode) + +!Auto Fill Mode:! !C Turn Auto Fill mode on or off. +No arg or argument of 1 turns the mode on; +any other arg turns it off. +When it is on, lines are broken at the right margin +(position controlled by QFill Column) at spaces, +by doing a LF.! + + !* Altered to set up Switch Mode Process Options, because + Auto Fill Mode is now a local variable ! + -1*(FF)"E1'"#0'UAuto_Fill_Mode + 1 M.L Switch_Mode_Process_Options + M(M.M&_Process_Options) + M(M.M&_Set_Mode_Line) + 0 + +!DM Indent New Line:! !^R Inserts CRLF, then indents the second line. +Any spaces before the inserted CRLF are deleted. +Uses the definitions of CR and Meta-Tab to do the work, +except that if there is a Fill Prefix it is used to indent. +An argument is passed on to the definition of Meta-Tab.! + + @-F_ K !* Leave no spacing behind us at end of line.! + .( @MM !* Run this user's CR definition to insert a CR! + 0fo..q Fill_Prefix[3 !* If a prefix is defined, put it on new line.! + fq3"g g3' + "# 0f FM..I' !* Else run the Tab definition to indent.! + ),. !* f prevents it from typing out.! + + +!DM Indent Nested:! !^R Indent line for specified nesting level. +With no argument (or argument 1) indents the line at the same nesting +level as the last nonblank line (ie, directly under it). +A larger argument means that this line is that many levels +closer to the surface, and should indent under the last line +above it whose level is the same. The previous lines are scanned +under the assumption that any line less indented than its successors +is one level higher than they. +A negative arg N indents to the right of the previous nonblank line; +the amount of additional indentation is N times Q$Indentation Increment. +Unindented lines and comment lines are ignored. +If the cursor is not at the beginning of a line, the whole line +is indented, but the cursor stays fixed with respect to the text.! + + [.4 .[.2 !* Save where to indent from.! + 100000[.3 !* last nonblank line counts as 1st level.! + QComment_Start[.5 + + "G' "#1'< !* Back ARG levels.! + < !* Back 1 level.! + 0@l @-f !* Back to a non-blank line.! + l b-.; + 0@l @f_ r !* Back to after its indentation.! + fq.5f"g f~.5"e !'' !* Lines that start with comments don't count.! + fs shposu.4 !* Get this line's indentation.! + q.4"e !' !* Unindented lines don't count.! + q.4-q.3:; !* Exit if less indented than lower lines already seen.! + > + q.4u.3 > !* Update last level indentation.! + fs hposu.4 !* Column to indent to.! + "L -*QIndentation_Increment+Q.4U.4 ' + !* Negative arg means additional spaces ! + q.2j z-.u.2 @0l !* So go back to point we started at and indent.! + q.4m(m.m&_indent) ( !* contrive that if point is after the indentation,! + z-q.2,.fj) !* it is fixed wrt text, else goes after indentation.! + +!Startup Datamedia:! !C Initialize for editing, process JCL and edit. +Intended to be called from the user init file, instead of reading +EMACS.INIT.! + +!* Code mainly taken from EMACS.INIT ! + +!* Anything in the buffer when you start this will be used +instead of the JCL.! + + ^:I..L` + FSECHOLINES-3"G3FSECHOLINESW' + :M(M.M DM_Toplevel_^R) + ` + Q..9"E Q..LU..9' + + FQ(0FO..QAuto_Save_Filenames)-1"L + FS MSNAME:F6[0 + FS U INDEX+100000 :\ [ 1 + :I*DSK:<0>AUTOSAVE..1 M.VAuto_Save_Filenames ]1 ]0' + + !*Create MM Quit variable! + :FO ..Q MM_Quit "L M.VMM_Quit ' + + FS XJNAME :F6 [J + + FS MSNAME FS D SNAME + QFind_File_Inhibit_Write UInhibit_Write + +!* Process the JCL! + 0[0 0[1 + Z"E FJ' ZJ !* Get JCL, or use whatever previous init file left in buffer.! + ."N !* Process JCL command - extract filenames and commands! + 0,0A- +"E -D' !* REMOVE LF AT END IF ANY *! + J :S"N .,Z^ FX1 -D' !* IF COMMANDS TO EXECUTE, PUT THEM IN Q1! + HFX0' !* IF FILE TO BE READ, PUT NAME IN Q0! + FS LISPT"N FS CCL FNAMU0 + 0FS SUPERIOR !* Dont try to suck in LISPT.! + 0U1 F~JSNDMSG"E M(M.M TEXT_MODE)'' + + HK 0FS MODIFIED + Q0"E Q1"E !* If no commands / file to read, offer help.! + qEMACS_Version:\[1 !* get version no. as string! + FTEMACS/Datamedia_Editor,_version_1_-_type_^__(the_"hold"_key)_for_help. + ]1 + !''! '' + FQ0-1"L Q1"N M1' !* No file specified => execute commands from JCL! + ]1 ]0 ]J :M..9' !* and enter ^R mode.! + + QInhibit_Write,M(M.M Visit_File)0 !* VISIT SPECIFIED FILE, USING ">' AS DEFAULT FN2! + FSLISPT"N F~JSNDMSG"N !* If called by EXEC EDIT command...! + QBuffer_Filenames F[ DFILE + 0 FS DVERS !* Reset version number defaults.! + FS DFILE UBuffer_Filenames + M(M.M&_Set_Mode_Line) + F] D FILE'' + + Q1"N M1' !* If JCL held commands, execute them.! + + ]1 ]0 ]J :M..9 !* Enter ^R Mode ! + +!^R Define Kbd Macro:! !C Begin defining keyboad macro. +After you type this command, until you type it again, +everything you type becomes +part of the accumulating keyboard macro as well as being executed.! + + qDefining_Kbd_Macro"E !* Begin definition ! + 0 fs b consm.v Kbd_Macro_Defining_Body + 0 m.v Kbd_Macro_Defining_Index + m.m &_Define_Kbd_Macro fs tyi sink + 1uDefining_Kbd_Macro + :M(M.M&_Set_Mode_Line)' + "# !* End definition ! + qKbd_Macro_Defining_Body[..o + qKbd_Macro_Defining_Indexj .,zk !* Flush the End Kbd Macro command from the string.! + j < :s; ric > !* Quote all altmodes and ^]'s.! + j i !temp!m(m.m&_immediate_Kbd_Macro) !* Put command to call kbd macro at beginning.! + zj 27i !* Put altmode at end.! + hx* m.v Last_Kbd_Macro !* make mLast_Kbd_Macro call the macro.! + Q..o( ]..o + ) fs bkill !* Flush the data structures used in defining.! + 0 fs tyi sink + 0uDefining_Kbd_Macro + :M(M.M&_Set_Mode_Line)' + + +!DM Save File:! !^R Save Buffer on Disk if Modified. +With zero arg, use Auto Save Filename, +else use Buffer Filename.! + + "E :M(m.m^R_Save_File) ' + 1:M(m.m^R_Save_File) + + +!^R Save File:! !^R Save buffer on disk if modified. +Auto Save mode uses this macro. +If auto-saving is enabled, then we write to filenames read +or to a separate auto-save filename. If auto-saving is off, +or if given an argument, we always write to the filenames read. +"1," as argument indicates that this call was not explicitly +requested, and the user should be asked to confirm if +the file has become a lot smaller. "2," means an auto save, +which should abort if the file is shrunken.! + + 0FO..QDebug_Save_File"N SFORCE_ERROR' + Q..F-Q.F"N 0' + QAuto_Save_Mode[1 + FS MODIFIED"E !* Don't write buffer if not changed since last time, unless! + FF&1"N !* we have an argument (save as real names, not auto save),! + QAuto_Save_Count"N !* we did autosaves since last rewrite of actual file,! + Q1-2"E !* and those auto saves used _^RSV names.! + !* In this case, although file was written, it wasn't! + !* written out as the visited filenames.! + -1FS MODIFIED'''' !* So we must write it now anyway.! + FS MODIFIED"E !* If don't need to write since no changes,! + @FT !* tell the user so.! + (No_changes_need_to_be_written) +  0FS ECHO ACT' + QBuffer_Filenames[0 !* Q0 gets appropriate filenames to save as.! + 1[2 !* Q2 has 1 if saving as buffer filenames, -1 if not.! + Q1-2"E FF&1"E + QAuto_Save_FilenamesU0 -1U2'' + Q0"E "N ' !* Can't save => if implicit, just don't. Explicit => err! + :I*No_filenames_to_save_under FS ERR' + "N 3*FSZ-(2*QAuto_Save_Size)"L !* If file has shrunk, ask for confirmation.! + -2"E @FT +(File_has_shrunk_--_not_auto-saving) 0FSECHO ACT' + 0F[TYI SOURCE + @FT +File_has_shrunk_a_lot.__Save_anyway + @FG 1M(M.M &_Yes_or_No)"E 0FS ERR''' + Q0F[D FILE + Q2"G !* If saving for real, not as auto save filenames,! + FS D DEVICE-(F6DSK)"E !* If disk (ie, can be opened fast)! + 1:< ER FS IF CDATE[4 EC !* See if date of existing file matches when we last! + Q:.B(QBuffer_Index+8)[3 !* read or wrote the file.! + Q4"N Q3"N Q4-Q3"N !* If not, warn user he may be losing.! + FT This_file_has_been_written_on_disk_since_you_last_read_or_wrote_it. + Should_I_write_it_anyway + M(M.M &_Yes_or_No)(FSwindow+b,zf 0u..h)"E 0'''' >'' + Q2,M(M.M Write_File)0 + Q1"N + %Auto_Save_Count + FS D VERSIO"E !* If auto-saving as something >,! + Q1-2"E FF&1"E 1:!> !* If saving as special auto save filenames, delete oldest save.! + '' + "# QAuto_Save_Count-QAuto_Save_Max"G !* If saving as visited names,! + %Auto_Save_DeleteF"G FS D VERSIO + 1:''''' !* If have accumulated enough saves, delete oldest one.! + FF&1"N 0UAuto_Save_Count' !* After ^U^X^S, most recent version is NOT an auto save file.! + 0 + +!DM Toplevel ^R:! !S Enter a loop entering ^R mode within a catch. +Useful as a toplevel macro to be assigned initially to FS ^R ENTER. +The macro MM Top Level will then pop up and into the outermost ^R. +If Q^R Exit Flag is zero, then ^Z will revert to the TECO command loop. +Otherwise if QMM Quit is a string, then it will be macroed. +Otherwise, the file will saved and EMACS will halt. A continue will +re-enter ^R mode.! + + F~Editor_Name..J*+fqEditor_Name+1"N + f=..j(-1"g 0' + [..J :I..J[..J_^R]_0:' + M.M &_Recursive_^R_Set_Mode F[^R ENTER !* Turn off for recursive calls! + F< !TOPLEVEL_^R! +  !* Enter ^R mode ! + !* User types ^Z to quit ! + -1FO ..Q ^R_Exit_Flag @; !* Zero value will really quit ! + 1:< !* Errorset ! + FQMM_Quit "G MMM_Quit' !* Execute special instructions ! + "# + QBuffer_Filenames"N + 1M(M.M^R_Save_File)' !* Save file if appropriate ! + QAuto_Save_Mode "N + QAuto_Save_Filename [ 1 + : !* Delete all versions of autosave file ! + ] 1 ' + FSXJNAME:F6[J + F~JSNDMSG"N !* SNDMSG prints its own message ! + @FTGood-bye. ' + ]J !* Restore temporary Q-reg ! + 100000.FSEXITW ' !* Halt ! + > F"N FG' !* Report any errors ! + > !* Repeat indefinitely ! + @V + FS ^R MODE"N FS ^R EXIT ' !* Exit the ^R mode initially invoking! + fs backdepth"n '  !* This macro might be called directly! + +!DM Secretary Macro:! !S Standard ..F: Auto-save for use in ^R mode editing. +If QAuto Save Mode is non-zero, the buffer is saved +(as by ^R Save File) after every FS ^R MDLY characters.! + + FS MODIFIED"E 0' !* Don't save buffer unless it has changed.! + QAuto_Save_Mode"E 0' !* Is saving enabled for this buffer?! + FSZ"E 0' !* Is there anything in the buffer?! + FS ^R MODE"E 0' !* Are we leaving ^R mode? ! + + @FT _(Auto_Save) + 1:< 2,M(M.M ^R_Save_File) > + FS RGETTY"E F+' + 0 + +!^R Forward TECO Iteration:! !^R Move past the > matching the following <.! + 0[1 .[3 + .( :S + : FSZ-.F[VZ )J !* Don't look past end of this macro.! + < :S<>!*; + 0A-< "E %1' !>! !* Count <'s and >'s.! +! "E Q1-1U1 Q1-1"L 0'' + 0A-* "E S!' > !* Ignore insides of comments.! + Q3J FG 0 + +!^R Backward TECO Iteration:! !^R Move back past the < matching the preceding >.! + 0[1 [2 .[3 + .( -:S + : .F[VB )J !* Don't look past start of this macro.! + < -:S<>! +; + 1A-< "E Q1-1U1 Q1-1"L 0'' !>! !* Count <'s and >'s.! +! "E %1' + 1A-! "E .U2 -S! !* On finding , look for the matching excl! + 2A-*"N Q2J'' !* And if it has a start after it, skip the whole thing! + > + Q3J FG  diff --git a/src/e142/datamedia._ej b/src/e142/datamedia._ej new file mode 100644 index 00000000..f3ca6162 --- /dev/null +++ b/src/e142/datamedia._ej @@ -0,0 +1,1062 @@ +W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + % HmHwMYMeJ)J4I1I=8 8(88(8289HH%88RaGEGR8D8Mkq'^'i  9=9G9 9hr)H)X';'L?Q?YE[EfCwD 28!()i)o0U0\.x.KZKc.^.d:K:V0g0n4t4{LDLM-;,>FsGIOI\m} =p=|JmJwF*F9ktHSkv W_ ?r?z)4IgIr?H6Bv|z}O]}U}do)o3o +o3o?oI|N|Zo oOO/|#|3oWocO8OBf +facarqoq|pWpe\}] +hYhleMe`vJvUzfzty yYIYTQ1Q:`,`6k)k3lhlrk|l0w wS&S3~o~}ZZZfVGVVUKUYNFNPN8N? / 5& Setup DATAMEDIA LibraryM(M.MDatamedia) +Datamediax +Q..$[0 +640FSQVECTORU.X +2FS^RINITu..< +6FS^RINITu..> +M.M^R Backward Wordu..( +M.M^R Backward End-of-WordU:.X(() +M.M^R Forward WordU..) +M.M^R Forward End-of-WordU:.X()) +M.M^R Beginning of Real Lineu..[ +M.M^R Back to IndentationU:.X([) +M.M^R Prefix MetaU.] +M.M^R End of Real Lineu..] +M.M^R Up Real Lineu..^ +M.M^R Up Comment LineU:.X(^) +M.MDM Indent New LineuJ +M.M^R Down Real Lineu..J +M.M^R Indent New Comment LineU:.X(12.) +15.FS^RINITUM +16.FS^RINITu..M +M.M^R Down Comment LineU:.X(15.) +M.M^R Goto BeginningU..{ +M.M^R Mark BeginningU:.X({) +M.M^R Goto EndU..} +M.M^R Mark EndU:.X(}) +M.M^R Previous ScreenU..+ +M.M^R Prefix Control-MetaU.\ +M.M^R Next ScreenU..\ +M.M^R Move to Screen EdgeU..| +M.M^R Reposition WindowU..~ +M.M^R New WindowU..= +M.MDM Where Am IU:.X(=) +M.M^R Backward Kill Wordu.. +M.M^R Backward Kill to End-of-WordU:.X() +11.FS^RINITUI +M.MDM Indent NestedU..I +M.M^R Indent RigidlyU:.X(9) +M.M^R Universal ArgumentU..* +M.M^R Indent for CommentU..; +M.M^R Set Comment ColumnU:.X(;) +M.M^R Prefix MetaU +M.M^R Prefix Control-MetaU.. +M.M^R Define Kbd MacroU../ +M.M^R Call Last Kbd MacroU:.X(/) +M.M^R One WindowU:.X(1) +M.M^R Two WindowsU:.X(2) +M.M^R View Two WindowsU:.X(3) +M.M^R Modified Two WindowsU:.X(4) +Q0U.@ +M.M^R Mark SentenceU..@ +M.M^R Mark ParagraphU...@ +Q0U.A +M.M^R Append Next KillU..A +Q0U...A +Q0U.B +M.M^R Backward SentenceU..B +M.M^R Backward ParagraphU...B +Q0U.C +M.M^R Center LineU..C +Q0U...C +Q0U.D +4FS^RINITu..D +M.M^R Kill Wordu...D +M.M^R Directory DisplayU:.X() +M.M^R Kill to End-of-WordU:.X(D) +Q0U.E +M.M^R Exchange CharactersU..E +M.M^R Exchange WordsU...E +M.M^R Edit FileU:.X() +Q0U.F +M.M^R Forward SentenceU..F +M.M^R Forward ParagraphU...F +M.M^R Find FileU:.X() +M.M^R Goto Fixed MarkU..G +Q0U...G +Q0U +M.M^R Set Bounds RegionU..H +M.M^R Set Bounds FullU.. +17.FS^RINITU..I +Q0U..J +Q0U.K +M.M^R Kill Lineu..K +M.M^R Kill Regionu...K +M.M^R Kill into Q-regU:.X(K) +12.FS^RINITU.L +M.M^R Lowercase Wordu..L +M.M^R Lowercase Regionu...L +M.M^R Set Fixed MarkU..M +M.M^R No-opU.N +M.M^R Un-killU..N +M.M^R Un-kill PopU...N +M.M^R Get Q-regU:.X(N) +Q0U.O +Q0U..O +M.M^R Complement Overwrite Modeu...O +M.M^R Other WindowU:.X(O) +Q0U.P +M.MGoto PageU..P +M.M^R Mark PageU...P +M.M^R Set Bounds PageU:.X(P) +M.M^R Quoted InsertU.Q +M.M^R Fill Paragraphu..Q +M.M^R Fill Regionu...Q +M.M^R Set Fill ColumnU:.X(Q) +M.M^R Do Not Write FileU:.X() +Q0U.R +M.MDM Reverse Character SearchU..R +M.MDM Reverse Incremental SearchU...R +M.MDM Query ReplaceU:.X(R) +M.M^R Read FileU:.X() +Q0U.S +M.MDM Character SearchU..S +M.MDM Incremental SearchU...S +M.M^R TECO SearchU:.X(S) +M.MDM Save FileU:.X() +Q0U.T +Q0U..T +Q0U...T +Q0U.U +M.M^R Uppercase Wordu..U +M.M^R Uppercase Regionu...U +M.M^R Uppercase InitialU:.X(U) +Q0U.V +Q0U..V +Q0U...V +M.M^R Visit FileU:.X() +M.M^R Backward Kill WordU.W +M.M^R Copy LineU..W +M.M^R Copy RegionU...W +M.M^R Put Q-regU:.X(W) +M.MWrite FileU:.X() +Q.XU..X +M.M^R Execute Completed MM CommandU...X +M.M^R Execute MinibufferU:.X(X) +Q0U.Y +M.MSelect BufferU..Y +M.MList BuffersU...Y +33.FS^RINITU.Z +M.M^R Zap to CharacterU..Z +M.M^R Zap thru CharacterU...Z +MMMake VariableFixed Mark +50FSQVECTORUFixed Mark +(@:I*/QMode +QAuto Fill Mode/)M.VBuffer Deselection Hook +(@:i*/M(M.M A Mode) +QBM.LAuto Fill Mode +QB"N1M.LSwitch Mode Process Options' +/)M.VBuffer Creation Hook +M.VCSearch Default +0M.VDefining Kbd Macro +:i*m.vLast Kbd Macro +20.*5fsqvectoru..m +q..m[..ohk]..o +(@:I*/QDefining Kbd Macro"N +I Defining'/)M.VSet Mode Line Hook +1M(M.MSet Variable Comment)Indentation Increment* Number of spaces per level of indentation +(M.MDM Toplevel ^R)FS^RENTER +(M.MDM Secretary Macro)U..F +Q..FU.F +:IEditor NameEMACS/Datamedia +:I..JEMACS/Datamedia  +M(M.M& Set Mode Line) +0 ^R Complement Overwrite ModeiQOverwrite Mode[1 +Q1"N0U1'"#-1U1' +Q1UOverwrite Mode +Q1FS^RREPLACE +M(M.M& Set Mode Line) +0 +Goto Page!f[sstring[1 +QPage Delimiter[0 +u1ff"e1u1' +"#Q1"GJQ1-1U1'' +q1"gq1<:s0;>' +"#Q1"LR' +-:S0:' +FF-1"G +.U1 +:S0:.[2 +Q1J-1L +Q2-."LQ2J'' +0^R Copy Lines0.: +FF"EL' +"#L' +:M(M.M^R Copy Region)^R Set Fixed Mark)FF"E.:' +"#.U:Fixed Mark()' +0^R Goto Fixed MarkFFF"E.(W):' +"#"L.:WW1:<>' +"#.: +Q:Fixed Mark()J'' +0^R Zap to Characterh.: +[0FF"E1U0'"#U0' +Q0"GC'"#R' +Q0M(M.M^R Character Search) +"LC'"#R' +:M(M.M^R Kill Region)^R Zap thru CharacterQ.: +[0FF"E1U0'"#U0' +Q0M(M.M^R Character Search) +:M(M.M^R Kill Region)^R Forward Word71:<1A"C1+'1.W:FWL>F"NFG0' +-1:<2.W:FWL>F"NFG'0^R Forward End-of-Word!f"LW-':<"L-'.wfwl>"nfg'0^R Backward End-of-Word91:<0A"C-1'-1.W:FWL>F"NFG0' +-1:<-2.W:FWL>F"NFG'0^R Kill WordX1[9.[0 +1:<1A"C1+'1.W:FWL>F"NFG0' +-1:<2.W:FWL>F"NFG0' +Q0,.:M(M.M& Kill Text)^R Kill to End-of-Word([9.,(.wfwr).F:M(M.M& Kill Text)#^R Backward Kill to End-of-Word[-1[9.[0 +1:<0A"C-1'-1.W:FWL>F"NFG0' +-1:<-2.W:FWL>F"NFG0' +.,Q0:M(M.M& Kill Text)^R Kill into Q-reg1:M(M.M^R Put Q-reg) ^R No-op0DM Where Am IU:i*CFSECHODIS +QPage DelimiterU3 +[E[BFSBOUNDUEUB +0,FSZFSBOUND +.U0J1U10U4<:S3;.-Q0-2;.U4%1> +Q4J1U2 +Q0JQB,QEFSBOUND +@FTPage Q1@:= +@FT Line Q2@:= +@ft X=fsshpos@:= +@ft Y=fs^rvpos@:= +.-z"n@ft CH=8[..e1a@:=]..e' +@ft .=.@:=@ft(.*100/fsz@:=@ft%) +fsvz+b"n +@ft H=<h@:=@ft>' +@ft 1fsechoact0^R TECO SearchA1,M(M.M& Read Line)Search:[0 +[1Q1"E1U1' +Q1:S0"EFG' +0DM Query Replace]FF"N:\'"#:I*'[1 +1,M(M.M& Read Line)Query Replace:[0 +1M(M.MQuery Replace)0 +Grind SexpW1:< +FDLR +F[VBF[VZFLFSBOUND +F=MODELISP"NOConfirm' +z-b-1000"g!Confirm!^FTDo you really want to Grind this s-expression? (Y or N): +FI:FC-Y(FSEchoDisplayCFSEchoDisplay)"N'' +Z: +M(M.M& Save Region and Query) +WJ +[2[3 +[D128*5,32:ID +11.*5:FD-D:M2 +15.*5:FDRK:M2 +12.*5:FD-D:M2 +%*5:FDC +"*5:FDR^FLL +(*5:FD:M3 +!"!'*5:FD:M3 +)*5:FDRM3C +:I2Z-.<1AF  :;D>32I +:I3Z-.<1AF  :;D> +HFD +J.(0FSVBW0L.FSVB)J +FSWIDTH-10[W +FSWIDTH*2/3[C +0FO..QFill ColumnF"NUW +QWUC' +-1FO..QComment Column+1F"G-1UC' +QC[M +-1FO..QMiser Column+1F"G-1UM' +[R:IR/8+1*8 +0FO..QComment RoundingF"NUR' +M.M& Indent +[G^:IG` +[2S'R +1A-("N^FWL' +FL-.-QW++(FSHPOSU2Q2)"LFLL' +CQ2-QM"L +!"!1AF';()"L^FWL1A-32"EC''' +FSHPOSU2 +!LP!1a-32"EDOLP' +1A-)"EC' +FSHPOSU3 +Q3-Q2"N13I10I +Q2/8,9IQ2&7,32I' ++1MGOLP +` +0MG +J7F~(DEFUN "E +^FLL8F= + "E +8D.U3L +Q3,.F~FEXPR +*(Q3,.F~MACRO +)"E +-2D6D''' +JHU2U3 +> +JZ: +Q3,Q2DM Incremental Search7[D +0[L +10.[R +[Q@:iQ` +q4+1*5-fq3"e +q3[..ozj +200,0i]..o' +.u:3(%4) +qLu:3(%4) +q2u:3(%4) +q0u:3(%4) +qDu:3(%4) +` +[T@:iT` +fsrgetty"n3.&qR"n +fsechodispTfsechodisp +fsechodispLfsechodisp'' +@ft8:i8 +` +[0 +[2:i2 +[8:i8 +1fo..qSearch Exit Option +200fsqvector[3 +-1[4 +[5 +.[P +[S:ISM.M& Isearch RuboutUS:MS +1f[noquit +[6[7[..j +qD"g:i6I-Search :i7Failing I-Search ' +qD"l:i6Reverse I-Search :i7Failing Reverse I-Search ' +0[I +fsrgetty"n +fsechodispTfsechodisp +fsechodispLfsechodisp +@ftSearch: -1fstypeo' +"#@ft S: 1fstypeo' +!Restart! +1:<1uI-2f[noquit +0fsnoquitwqD:m(m.m^R String Search)' +q5-8"eoFunny' +q5-176."goFunny' +q5- +"e +FSREREAD' +!Normal! +4uR +mQ +:i220 +fq8"nmt' +@ft0"# +!Try! +mt +1&qR"n!' +' +qL"n!' +.u5 +40.&qR"e +qD"gfq2-1r' +"#fsz-qPf[vz +fq2-1"gfq2:c"ezj'' +f]vz'' +qD:s2"l!' +q5j1uLfg! +!Funny! +q5-177."eoRubout' +q5&137.-S"eQ5-600."LoForward'' +q5&137.-R"eQ5-600."LoBackward'' +q5&537.-Q"eoQuote' +qE"eonormal' +oControl +!Quote! +fsosteco"n-1f[helpch' +2,m.ifiu0 +fsosteco"nf]helpmac' +onormal +!Forward! +qD"l:i6I-Search:i7Failing I-Search' +q4"LqD"goDefault' +"#1uD!'' +mQ +qD"L0uL' +1uD +40.uR +otry +!Backward! +qD"g:i6Reverse I-Search:i7Failing Reverse I-Search' +q4"LqD"loDefault' +"#-1uD!'' +mQ +qD"g0uL' +-1uD +40.uR +otry +!Default! +mQ +qSearch Default Ring[..o +.fswordu2]..o +fq2"l:i2' +q2u8 +40.uR +otry +!Rubout! +q4"lfg!' +ms +otry +!Control! +q5fsreread +0; +>>u0@feqit-q0"e@fg +QL"gmt +oRestart' +qI"emsmtoRestart' +QPJ0fsnoquit +-1fsquit'' +q0f"nfserr' +fq2"g +qSearch Default Ring[..o +fq(.fsword)-1"G5c.-z"ej'' +q2,.fsword +]..o' +@ft +qPmMM & Maybe Push Point +0!DM Reverse Incremental Search$-@:M(m.mDM Incremental Search)DM Character Search>[0[1[20[3[9 +!RDCH!M.I@:FIU0 +FIU9 +Q0-(FS^RLAST)"EF[SSTRING +QCSearch DefaultFSSSTRING +OSEARCH' +Q0:FCU0 +Q0-301."E +Q1:M(M.M^R String Search)' +Q0-306."E1u3oRDCH' +Q0-321."EM.IFIU9' +Q0-322."E-Q1U1ORDCH' +Q0-323."EF[SSTRING +QCSearch DefaultFSSSTRING +OSEARCH' +Q0-324."E' +"#F[SSTRING0S9' +FSSSTRINGuCSearch Default +!SEARCH! +.U0Q1:S"EFG' +Q0M(M.M& Maybe Push Point) +q3"N2fo..QNext Screen Context Lines:f' +1 +DM Reverse Character Search"-@:M(m.mDM Character Search) +LISP Mode] M(M.M& Init Buffer Locals) +M.M^R Indent For LISPM.Q..  +M.M^R Mark SexpM.Q.@ +M.M^R Mark DefunU:.X(@) +M.M^R Backward SexpM.Q.B +M.M^R Backward ListM.Q..B +M.M^R Backward Up ListM.Q...B +M.M^R Beginning of DefunU:.X(B) +M.M^R Kill SexpM.Q.D +M.M^R Exchange SexpsM.Q.E +M.M^R Forward SexpM.Q.F +M.M^R Forward ListM.Q..F +M.M^R Forward Up ListM.Q...F +M.M^R End of DefunU:.X(F) +1,(:I*(* )M.LComment Start +1,(:I*))M.LComment End +1,(:I*)M.LParagraph Delimiter +0FO..QLISP ..DF"E +!"!:I* A A A A A A A A A A + A A A A A A A A A A A A A A A A A A A | A AA A/ A ' ( ) A A A A AA A AA AA AA AA AA AA AA AA AA AA A A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A M.VLISP ..D +QLISP ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)LISP +SAIL Mode'M(M.MLoad)SAIL +:M(M.MSAIL Mode)MIDAS Mode-M(M.M& Init Buffer Locals) +1,(:I*;)M.LComment Start +1,(:I*)M.LParagraph Delimiter +0fo..qMIDAS Vector[1 +q1"e5*5fsqvectoru1q1m.vMIDAS Vector +m.m^R Go to AC Fieldu:1(0) +m.m^R Kill Terminated Wordu:1(1) +m.m^R Go to Address Fieldu:1(2) +m.m^R Go to Next Labelu:1(3) +m.m^R Go to Previous Labelu:1(4)' +1,Q:1(0)M.Q..B +1,Q:1(2)M.Q..F +1,Q:1(3)M.Q...F +1,Q:1(4)M.Q...B +Q.0,1M(M.M& Set Mode Line)MACROMACRO Mode:M(M.MMIDAS Mode) +TECO Mode +M(M.M& Init Buffer Locals) +1,(:I*!* )M.LComment Start +1,(:I*!)M.LComment End +1,(:I*)M.LParagraph Delimiter +1,Q(1,Q.M.Q)M.Q. +1,M.M& FILE PURIFY LOADED"E +F[DFILEM(M.MLoad Library)PURIFY' +m.m^R Backward TECO ConditionalM.Q..B +m.m^R Forward TECO ConditionalM.Q..F +0FO..QTECO ..DF"E +!"!:I* + A A A A A A A ' ( ) A A A A / AA AA AA AA AA AA AA AA AA AA A ; A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A | A A M.VTECO ..D +QTECO ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)TECO +Text ModeM(M.M& Init Buffer Locals) +1,0M.LSpace Indent Flag +0FO..QText ..DF"E +!"!:I* + A A A A A A A A' ( ) A A A A / AA AA AA AA AA AA AA AA AA AA A ; A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A | A A M.VText ..D +QText ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)Text& SAI Mode:M(M.MSAIL Mode)& LSP Mode& LISP Mode:M(M.MLISP Mode)& PUB Mode:M(M.MText Mode)Auto Fill Mode-1*(FF)"E1'"#0'UAuto Fill Mode +1M.LSwitch Mode Process Options +M(M.M& Process Options) +M(M.M& Set Mode Line) +0DM Indent New LineL@-F  K +.(@MM +0fo..qFill Prefix[3 +fq3"gg3' +"#0fFM..I' +),.DM Indent Nested[.4.[.2 +100000[.3 +QComment Start[.5 +"G'"#1'< +< +0@l@-f +lb-.; +0@l@f  r +fq.5f"gf~.5"e!'' +fsshposu.4 +q.4"e!' +q.4-q.3:; +> +q.4u.3> +fshposu.4 +"L-*QIndentation Increment+Q.4U.4' +q.2jz-.u.2@0l +q.4m(m.m& indent)( +z-q.2,.fj)Startup Datamedia5^:I..L` +FSECHOLINES-3"G3FSECHOLINESW' +:M(M.MDM Toplevel ^R) +` +Q..9"EQ..LU..9' +FQ(0FO..QAuto Save Filenames)-1"L +FSMSNAME:F6[0 +FSUINDEX+100000:\[1 +:I*DSK:<0>AUTOSAVE..1M.VAuto Save Filenames]1]0' +:FO..QMM Quit"LM.VMM Quit' +FSXJNAME:F6[J +FSMSNAMEFSDSNAME +QFind File Inhibit WriteUInhibit Write +0[00[1 +Z"EFJ'ZJ +."N +0,0A- +"E-D' +J:S"N.,Z^FX1-D' +HFX0' +FSLISPT"NFSCCLFNAMU0 +0FSSUPERIOR +0U1F~JSNDMSG"EM(M.MTEXT MODE)'' +HK0FSMODIFIED +Q0"EQ1"E +qEMACS Version:\[1 +FTEMACS/Datamedia Editor, version 1 - type ^_ (the "hold" key) for help. +]1 +!''!'' +FQ0-1"LQ1"NM1' +]1]0]J:M..9' +QInhibit Write,M(M.MVisit File)0 +FSLISPT"NF~JSNDMSG"N +QBuffer FilenamesF[DFILE +0FSDVERS +FSDFILEUBuffer Filenames +M(M.M& Set Mode Line) +F]DFILE'' +Q1"NM1' +]1]0]J:M..9^R Define Kbd Macro*qDefining Kbd Macro"E +0fsbconsm.vKbd Macro Defining Body +0m.vKbd Macro Defining Index +m.m& Define Kbd Macrofstyisink +1uDefining Kbd Macro +:M(M.M& Set Mode Line)' +"# +qKbd Macro Defining Body[..o +qKbd Macro Defining Indexj.,zk +j<:s;ric> +ji!temp!m(m.m& immediate Kbd Macro) +zj27i +hx*m.vLast Kbd Macro +Q..o(]..o +)fsbkill +0fstyisink +0uDefining Kbd Macro +:M(M.M& Set Mode Line)'DM Save File3"E:M(m.m^R Save File)' +1:M(m.m^R Save File)^R Save Filey0FO..QDebug Save File"NSFORCE ERROR' +Q..F-Q.F"N0' +QAuto Save Mode[1 +FSMODIFIED"E +FF&1"N +QAuto Save Count"N +Q1-2"E +-1FSMODIFIED'''' +FSMODIFIED"E +@FT +(No changes need to be written) +0FSECHOACT' +QBuffer Filenames[0 +1[2 +Q1-2"EFF&1"E +QAuto Save FilenamesU0-1U2'' +Q0"E"N' +:I*No filenames to save underFSERR' +"N3*FSZ-(2*QAuto Save Size)"L +-2"E@FT +(File has shrunk -- not auto-saving)0FSECHOACT' +0F[TYISOURCE +@FT +File has shrunk a lot. Save anyway +@FG1M(M.M& Yes or No)"E0FSERR''' +Q0F[DFILE +Q2"G +FSDDEVICE-(F6DSK)"E +1:'' +Q2,M(M.MWrite File)0 +Q1"N +%Auto Save Count +FSDVERSIO"E +Q1-2"EFF&1"E1:!> +'' +"#QAuto Save Count-QAuto Save Max"G +%Auto Save DeleteF"GFSDVERSIO +1:''''' +FF&1"N0UAuto Save Count' +0DM Toplevel ^R7F~Editor Name..J*+fqEditor Name+1"N +f=..j(-1"g0' +[..J:I..J[..J ^R] 0:' +M.M& Recursive ^R Set ModeF[^RENTER +F +]1' +FSXJNAME:F6[J +F~JSNDMSG"N +@FTGood-bye.' +]J +100000.FSEXITW' +>F"NFG' +> +@V +FS^RMODE"NFS^REXIT' +fsbackdepth"n'DM Secretary MacroFSMODIFIED"E0' +QAuto Save Mode"E0' +FSZ"E0' +FS^RMODE"E0' +@FT (Auto Save) +1:<2,M(M.M^R Save File)> +FSRGETTY"EF+' +0^R Forward TECO Iterationu0[1.[3 +.(:S + :FSZ-.F[VZ)J +<:S<>!*; +0A-<"E%1'!>! +!"EQ1-1U1Q1-1"L0'' +0A-*"ES!'> +Q3JFG0^R Backward TECO Iteration0[1[2.[3 +.(-:S + :.F[VB)J +<-:S<>! +; +1A-<"EQ1-1U1Q1-1"L0''!>! +!"E%1' +1A-!"E.U2-S! +2A-*"NQ2J'' +> +Q3JFG& Setup KBDMAC Librarym.m^R Start Kbd Macrou:.x(() +m.m^R End Kbd Macrou:.x()) +m.m^R Call Lastu:.x(E) +:i*m.vLast Kbd Macro +20.*5fsqvectoru..m +q..m[..ohk& Run Kbd Macroq:..m(fq..m/5-1)[0 +q:..m(fq..m/5-2)[1 +q1:g0*200.+(%1:g0)fsreread +%1u:..m(fq..m/5-2) +q1-fq0"l0' +q..m[..ozj-10d +z"e0fstyisource' +0& Call Kbd Macrotq..m[..o +fstyisource"ehk' +f"e1'< +zj10,0i +0,.-10fsword +,.-5fsword> +m.m& Run Kbd Macrofstyisource +0& Immediate Kbd Macro$,:i*:m(m.m& Call Kbd Macro)^R Call Last Kbd MacromLast Kbd Macro^R Start Kbd Macrom0fsbconsm.vKbd Macro Defining Body +0m.vKbd Macro Defining Index +m.m& Define Kbd Macrofstyisink +0& Define Kbd MacrorqKbd Macro Defining Body[..ozj +fstyibeg-(fstyicount-1)"e +zuKbd Macro Defining Index' +/200.i&177.i0^R End Kbd MacroFqKbd Macro Defining Body[..o +qKbd Macro Defining Indexj.,zk +j<:s;ric> +ji!temp!m(m.m& immediate Kbd Macro) +zj27i +hx*m.vLast Kbd Macro +Q..o(]..o +)fsbkill +0fstyisink +0Name Kbd MacroC1,f Command Name[1 +fq1"gqLast Kbd Macrom.vMM 1' +:i..0^R Command to define:  +m(m.m& Read Q-reg)[2 +f=2 +"e0' +f=2"e0' +q2m(m.m& Check Redefinition) +qLast Kbd Macrou2 +0View Kbd Macro:i*[0 +:i..0Kbd Macro Command:  +fq0"em(m.m& Read Q-reg)u0' +q0[1 +m.m^R Call Last Kbd-q1"e +qLast Kbd Macrou1 +:i0Last Kbd Macro' +f[bbindg1 +js)0,.k +zj-d +ft +Definition of keyboard macro 0: + + +m.m& Charprint[2 +jz/2<1a*200.+(2c0a)m2ft > +ft + +0& Check Redefinition'[1 +q1[0 +fq0+1"g +f~(0,6:g0)!Temp!"n +!lose!!"!:I*Can't clobber specified character 1fserr'' +"#Afs^rinit-q0"n +200.@fs^rinit-q0"n +q0"n +olose'''' +~FILENAME~ +DATAMEDIA~DOC~ ~FILENAME~Library to rearrange the command set for easy use from +SRI-style Datamedia keyboards. Commands are summarized in the file +DATAMEDIA.CHART . +#~DOC~ & Setup DATAMEDIA Library& Setup macro +~DOC~ Datamedia<C Set up the EMACS/Datamedia environment. +Rearranges the command set for easy use from SRI-style +Datamedia keyboards. Commands are summarized in the file +DATAMEDIA.CHART . +&~DOC~ ^R Complement Overwrite Mode| +^R If Overwrite Mode is on, turn it off. If it is off, +turn it on. When Overwrite Mode is on, typed non-meta characters +will delete and overwrite characters in the buffer instead +of being inserted. Meta characters still function normally. +~DOC~ Goto PagekC Move forward or back by pages, or to specific page. +If no arg, go to top of next page. +If arg is zero, go to top of present page. +If arg is negative, go to top of present page, unless already at top, + in which case go to top of preceding page. +If arg is positive (+n), go to top of page n of buffer. +If two args (m,n), go to line m of page whatever. +~DOC~ ^R Copy LinesU^R Like killing lines and getting them back, +but doesn't mark buffer modified. +~DOC~ ^R Set Fixed Mark_^R Set either THE mark, or special fixed mark. +If no arg, set "ring-of-point" mark. +If arg is zero or positive, set corresponding fixed mark. +There are 10 fixed marks, numbered 0 to 9. They contain character +counts relative to the beginning of the buffer. Fixed marks may +be changed only by this macro, and are unaffected by killing, etc. +~DOC~ ^R Goto Fixed Mark4^R If no arg, exchange point and "ring-of-point" mark. +If negative arg, pop the "ring-of-point" mark. +If zero or positive arg, set "ring-of-point" mark and goto fixed mark. +~DOC~ ^R Zap to Character[^R Kills text up to but not including a +target character. Uses the macro ^R Character Search to obtain +the target character from the keyboard and search for it. The search +skips over the character pointed to. + +~DOC~ ^R Zap thru Character%^R Kills text up to and including a +target character. Uses the macro ^R Character Search to obtain +the target character from the keyboard and search for it. +~DOC~ ^R Forward Word$^R Move forward over one word. + ~DOC~ ^R Forward End-of-Word+^R Move forward to the next word end. +!~DOC~ ^R Backward End-of-Word@^R Like Backward Word, but moves to end of +previous word. +~DOC~ ^R Kill Word0^R Kill next word and trailing delimiters. + ~DOC~ ^R Kill to End-of-Word +^R Kill to next word end. +)~DOC~ ^R Backward Kill to End-of-WordE^R Like Backward Kill Word, +but kills to end of previous word. +~DOC~ ^R Kill into Q-reg ^R Put Q-reg and Kill text +~DOC~ ^R No-op^R Does nothing. +~DOC~ DM Where Am I ^R Print various things about the cursor position. +Print the page and line, +the X position, the Y position, +the octal code for the following character, +cursor position in characters and as a percentage of the total file, +and the virtual boundaries, if any. +~DOC~ ^R TECO Search/^R Search, using the basic TECO string search facility. +Special characters: +^B matches any delimiter char. +^N matches any char other than the char following it in the search + string (i.e., "not"). ^N^B matches non-delimiters, and + ^N^X matches nothing. ^N^Q^B matches all but ^B, etc. +^O divides the string into substrings searched for simultaneously. + Any one of these strings, if found, satisfies the search. +^Q quotes the following char, i.e., deprives it of special significance. + Escape and rubout cannot be quoted. +^X matches any char. +~DOC~ DM Query ReplaceC +^R Replace string, asking about each occurrence. +Query Replace:FOOBAR displays the next FOO; you say what to do. +Space => replace it with BAR and show next FOO. +Rubout => don't replace, but show next FOO. +Comma => replace this FOO and show result, waiting for next command. +Period => replace this FOO and exit. Altmode => just exit. +^ => return to site of previous FOO (actually, jump to mark). +^W => kill this FOO and enter recursive ^R. +^R => enter ^R mode recursively. ^L => redisplay screen. +Exclamation mark => replace all remaining FOOs without asking. +Any other character exits and is read again. +If QCase Replace is nonzero, BAR will be capitalized or all caps +if FOO was. +1 MM Query ReplaceFOO... will replace only FOOs that are +bounded on both sides by delimiter characters (according to ..D). +~DOC~ Grind SexpZC Grind the sexp after the pointer. +A modification of the MIT Grind Sexp that recognizes that +in Interlisp, % quotes a character, " starts a long +string, and ; has no significance. +Uses QMiser Column to decide where to start using "Miser" format, +and QFill Column as the page width to aim for. +Saves the old sexp on the kill ring. + +~DOC~ DM Incremental Search5^R Search for character string. +As characters are typed in, the accumulated string is +searched for. Characters may be rubbed out. +^Q quotes special characters. +^S or M-S repeats the search forward; ^R or M-R repeats it backward. +If the accumulated string is empty, ^R, ^S, M-R or M-S either +reverses the direction of search or gobbles the previous +search string and searches for it again. +Altmode or any random control character exits +(anything but altmode is then executed). +If the accumulated string fails to be found, +you will be notified with one bell. You can then exit, +rub the bad characters out (or ^G them all away), +or try searching in the opposite direction. +Quitting a successful search goes back to the starting +point of the search; quitting a failing search rubs out +enough characters to make it successful again. +Altmode when the string is empty makes the search +non-incremental by calling ^R String Search. +'~DOC~ DM Reverse Incremental SearchZ^R Incremental Search Backwards. +Calls Incremental Search with a negative argument. +~DOC~ DM Character Search{^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search. +%~DOC~ DM Reverse Character Search{^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search. +~DOC~ LISP ModeOC Sets things up for editing LISP code +within the Datamedia environment. +~DOC~ SAIL Mode0C Sets things up for editing SAIL programs +~DOC~ MIDAS ModeDC Set things up for editing MIDAS code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines. +~DOC~ MACRO ModeDC Set things up for editing MACRO code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines. +~DOC~ TECO ModeRC Set things up for editing TECO code. +Makes Rubout the Tab-hacking Rubout. +Loads the PURIFY library. Makes comments be bounded by "!* " and "!". +M-F moves forward over a TECO conditional; M-B, back. +~DOC~ Text ModesC Set things up for editing English text. +Makes Auto Fill not indent new lines; says there are no comments. +~DOC~ & SAI ModeS Setup for SAIL. +~DOC~ & LSP Mode~DOC~ & LISP ModeS Setup for LISP. +~DOC~ & PUB ModeS Setup for Text mode. +~DOC~ Auto Fill ModehC Turn Auto Fill mode on or off. +No arg or argument of 1 turns the mode on; +any other arg turns it off. +When it is on, lines are broken at the right margin +(position controlled by QFill Column) at spaces, +by doing a LF. +~DOC~ DM Indent New Line^R Inserts CRLF, then indents the second line. +Any spaces before the inserted CRLF are deleted. +Uses the definitions of CR and Meta-Tab to do the work, +except that if there is a Fill Prefix it is used to indent. +An argument is passed on to the definition of Meta-Tab. +~DOC~ DM Indent Nested^R Indent line for specified nesting level. +With no argument (or argument 1) indents the line at the same nesting +level as the last nonblank line (ie, directly under it). +A larger argument means that this line is that many levels +closer to the surface, and should indent under the last line +above it whose level is the same. The previous lines are scanned +under the assumption that any line less indented than its successors +is one level higher than they. +A negative arg N indents to the right of the previous nonblank line; +the amount of additional indentation is N times Q$Indentation Increment. +Unindented lines and comment lines are ignored. +If the cursor is not at the beginning of a line, the whole line +is indented, but the cursor stays fixed with respect to the text. +~DOC~ Startup Datamedia C Initialize for editing, process JCL and edit. +Intended to be called from the user init file, instead of reading +EMACS.INIT. +~DOC~ ^R Define Kbd Macro=C Begin defining keyboad macro. +After you type this command, until you type it again, +everything you type becomes +part of the accumulating keyboard macro as well as being executed. +~DOC~ DM Save Filel^R Save Buffer on Disk if Modified. +With zero arg, use Auto Save Filename, +else use Buffer Filename. +~DOC~ ^R Save Filee^R Save buffer on disk if modified. +Auto Save mode uses this macro. +If auto-saving is enabled, then we write to filenames read +or to a separate auto-save filename. If auto-saving is off, +or if given an argument, we always write to the filenames read. +"1," as argument indicates that this call was not explicitly +requested, and the user should be asked to confirm if +the file has become a lot smaller. "2," means an auto save, +which should abort if the file is shrunken. +~DOC~ DM Toplevel ^R"S Enter a loop entering ^R mode within a catch. +Useful as a toplevel macro to be assigned initially to FS ^R ENTER. +The macro MM Top Level will then pop up and into the outermost ^R. +If Q^R Exit Flag is zero, then ^Z will revert to the TECO command loop. +Otherwise if QMM Quit is a string, then it will be macroed. +Otherwise, the file will saved and EMACS will halt. A continue will +re-enter ^R mode. +~DOC~ DM Secretary Macro.S Standard ..F: Auto-save for use in ^R mode editing. +If QAuto Save Mode is non-zero, the buffer is saved +(as by ^R Save File) after every FS ^R MDLY characters. +#~DOC~ ^R Forward TECO Iteration2^R Move past the > matching the following <. +$~DOC~ ^R Backward TECO Iteration7^R Move back past the < matching the preceding >. + ~DOC~ & Setup KBDMAC Library6S Put commands on keys. Create execution stack. +~DOC~ & Run Kbd Macro?S This is the FS TYI SOURCE for running keyboard macros. +~DOC~ & Call Kbd MacroS Push a kbd macro onto the execution stack of such. +The macro to be called is supplied as a string pointer. +A pre-comma argument is a repeat count. + +~DOC~ & Immediate Kbd MacroS Push a kbd macro supplied as a suffix string arg. +This subroutine is for use in definitions of ^R commands +which directly run keyboard macros. + ~DOC~ ^R Call Last Kbd Macro^^R Run the last defined temporary keyboard macro. +A numeric argument is a repeat count. +~DOC~ ^R Start Kbd Macro#C Begin defining keyboad macro. +After you type this command, everything you type becomes +part of the accumulating keyboard macro as well as being executed. +~DOC~ & Define Kbd Macro3S FS TYI SINK for defining kbd macros. +Takes characters typed and accumulates them in a buffer +which will be formed into a keyboard macro when the definition is finished. +~DOC~ ^R End Kbd MacroZC Terminate definition of a keyboard macro. +All that you have typed since starting the definition, +except this command itself, becomes the definition. +^R Call Last Kbd Macro re-executes the last macro defined. +~DOC~ Name Kbd Macro,C Give a name to the last kbd macro defined. +An MM command is created with the name you specify, +which when invoked runs that keyboard macro. +Then, you are asked to give the command character to +put the macro on. Type Return or Rubout if you don't want +to put it on any character. Otherwise, type a character +which is undefined or is already a keyboard macro. +Prefix characters such as Altmode and ^X may be used. +~DOC~ View Kbd MacroKC Print definition of a keyboard macro. +Supply a suffix string argument containing the command name. +If the string argument is null, you will be asked to type +the character which runs the macro. +~DOC~ & Check RedefinitionS Verify that a certain command can be redefined. +Do not allow a command to be redefined unless it is undefined, +self-inserting, or a string starting with !Temp!. +The command is specified with a q-register name in a string +passed as a string pointer. +~DIRECTORY~%& Setup DATAMEDIA Library +Datamedia +^R Complement Overwrite Mode +Goto Page +^R Copy Lines +^R Set Fixed Mark +^R Goto Fixed Mark +^R Zap to Character +^R Zap thru Character +^R Forward Word +^R Forward End-of-Word +^R Backward End-of-Word +^R Kill Word +^R Kill to End-of-Word +^R Backward Kill to End-of-Word +^R Kill into Q-reg +^R No-op +DM Where Am I +^R TECO Search +DM Query Replace +Grind Sexp +DM Incremental Search +DM Reverse Incremental Search +DM Character Search +DM Reverse Character Search +LISP Mode +SAIL Mode +MIDAS Mode +MACRO Mode +TECO Mode +Text Mode +& SAI Mode +& LSP Mode +& LISP Mode +& PUB Mode +Auto Fill Mode +DM Indent New Line +DM Indent Nested +Startup Datamedia +^R Define Kbd Macro +DM Save File +^R Save File +DM Toplevel ^R +DM Secretary Macro +^R Forward TECO Iteration +^R Backward TECO Iteration +& Setup KBDMAC Library +& Run Kbd Macro +& Call Kbd Macro +& Immediate Kbd Macro +^R Call Last Kbd Macro +^R Start Kbd Macro +& Define Kbd Macro +^R End Kbd Macro +Name Kbd Macro +View Kbd Macro +& Check Redefinition + ~INVERT~[1Q1 diff --git a/src/e142/datamedia.basic b/src/e142/datamedia.basic new file mode 100644 index 00000000..2f486887 --- /dev/null +++ b/src/e142/datamedia.basic @@ -0,0 +1,77 @@ +Here's the barest minimum you need to get started with EMACS/Datamedia: + + In EMACS as soon as you type any character, some action is +performed, and you see the resulting buffer. Generally, graphic, +printing characters insert themselves, while control characters do +the editing. So, to insert some text, just type it. To make +corrections, you use the control characters. + + Control characters are designated by a prefix. "M-" stands for +meta. To type meta characters, hold down the "edit" key as you type +the character. "C-" stands for control. If the command has a "C-M-" +prefix, hold down both the ctrl and edit keys as you type. Here is +a simple description of what various control characters do: + + M-> Move forward one character. + M-< Move backward one character. + M-D Delete next character. + Rubout Delete last character. + M-[ Move to beginning of this line. + M-] Move to end of this line. + M-lf Move to next line. + M-^ Move to previous line. + M-K Kill rest of line. + M-N uN-kill what was just killed, inserting it + into the buffer at the current position. + M-M Mark this place in the buffer. + C-M-K Kill from here to marked place. + (M-N will uN-kill C-M-K-killed text too.) + M-= Clear screen, redisplay buffer. + C-G "Quit". Stops whatever EMACS is doing. + C-C Exit from EMACS. + + C-X or M-X + Prefix character: follow with another character to + make a 2-character C-X or M-X command. C-X and M-X + are equivalent in every way. + + C-X C-V Visit a file. See below. + C-X C-S Save the file you are visiting. + + An easy way to move text around is to kill it, move, then uN-kill. +You can uN-kill any number of times to create copies in different +places. + + If you want to edit text and save it after one session, you must +put it in a "file". To do this, type the C-X C-V command, followed by +the name you would like to use for your file. When you have finished +typing the filename, end it with a carriage-return ("", as we say). +"(New File)" will be printed at the bottom of the screen, and the +file's name will appear in the line which starts with "EMACS (" near +the bottom. Now you are ready to type in the text of the file. + + When you specify the name of a file, you should usually give only +the filename and the extension. The directory will default to your +own (or to that of the file you are already visiting). You need not +specify the directory unless it is different. + + After you have typed for a while, type C-X C-S to "save" what you +have added to the file so far. The text doesn't really go into the +file until you save it. After saving, you can edit some more and +save again, etc. If the system crashes, you can't lose anything which +you have saved already. Each save writes a new version of the file, +with a larger version number, so that old saves do not go away. + + When you want to switch to writing a different file, just use the +C-X C-V command again. The same command allows you to make changes in +an old file. If you do C-X C-V when you have made changes to a file +but not saved them, EMACS will ask you whether to save them. You +should type either "Y" or "N" as the answer. Or type C-G to quit, +look around to decide what to do, save or not, and repeat the C-X C-V. +Don't ever be afraid to quit. + + If you need more help, you can get it by typing the Help +character which you used in order to see this. You typed Help B; +typing other things after Help gets other kinds of help. +Remember that the Help character is the same as the "hold" key on +the Datamedia terminal. diff --git a/src/e142/datamedia.chart b/src/e142/datamedia.chart new file mode 100644 index 00000000..2172655e --- /dev/null +++ b/src/e142/datamedia.chart @@ -0,0 +1,178 @@ + EMACS/DATAMEDIA COMMAND SET + as of November 17, 1978 + (Parentheses indicate not implemented yet) + + Ctrl or *Bare Edit Edit-Ctrl Edit-X + ---- -- ----- ---- --------- ------ +< Backward Character < +> Forward Character > +( Backward Word Backward End-of-Word ( +) Forward Word Forward End-of-Word ) +[ Beginning of Line Back to Indentation [ +] Prefix Meta End of Line (Move to Comment Column) ] +^ Prefix Control Up Real Line Up Comment Line ^ +lf * Indent New Line Down Real Line Indent New Comment Line lf +cr * insert CRLF Next Line Down Comment Line cr +{ Goto Beginning Mark Beginning { +} Goto End Mark End } ++ View Previous Screen + +\ Prefix Control-Meta View Next Screen \ +| Move to Screen Edge | +~ Reposition Window ~ += New Window Where am I = +del * Delete Chars Bkwds Backward Kill Word Bkwd Kill to Word End del +_ [hold] Describe _ +tab * insert tab Nested Indent Indent Rigidly tab +* Multiply Arg by 4 * +; Indent for Comment Set Comment Column ; +esc * Prefix Meta Prefix Control-Meta esc +/ Define Kbd Macro Call Last Kbd Macro / +? Describe ? +1 1 Window 1 +2 2 Windows 2 +@ Mark sentence Mark paragraph @ +A (Again) Append Next Kill A +B Backward sentence Backward paragraph B +C Exit Center line [^C] (Center Region) C +D Delete Character Kill Word Kill to End-of-Word D +E Exchange Characters Exchange Words (Exchange Lines) E +F Forward sentence Forward paragraph F +G Abort Go to Fixed Mark [^G] G +H Set Bounds Region Set Bounds Full H +I [tab] Insert CRLF after point [Edit-tab] I +J [lf] [Edit-lf] J +K Kill Line Kill Region Kill into Q-reg K +L Insert Page Mark Lowercase Word Lowercase Region L +M [cr] Set Fixed Mark [Edit-cr] M +N No-op uNkill uNkill Pop Get Q-register N +O Complement Overwrite Mode Other Window O +P Go to Page Mark Page Set Bounds Page P +Q Quote next char Fill Paragraph Fill Region Set Fill Column Q +R Reverse Char Search Reverse Incr Search Query Replace R +S Character Search Incremental Search TECO Search S +T T +U Uppercase Word Uppercase Region Uppercase Initial U +V V +W Bkwd Kill Word Copy Line Copy Region Put Q-register W +X ^X Prefix ^X Prefix Execute MM Command Execute Minibuffer X +Y Select Buffer List Buffers Y +Z Quit Zap to Character Zap thru Character Z + + COMMANDS REDEFINED IN LISP MODE: + * indicates functions defined only in the INTERLISP-EMACS interface + + Ctrl Edit Edit-Ctrl Edit-X + ---- ---- --------- ------ + +tab Indent for LISP tab +@ Mark sexp (Mark list) (Mark up list) Mark DEFUN @ +A * ARGLIST A +B Backward sexp Backward list Backward list Backward DEFUN B +D Kill sexp D +E Exchange sexps E +F Forward sexp Forward list Forward up list Forward DEFUN F +T * Print to Level * Prettyprint T +Y * Up Eval Y +Z * Exit to LISP Z + +(See the file NEMACS.DOC for a description of the INTERLISP-EMACS interface.) + + + + + COMMANDS REDEFINED IN SAIL MODE: + + Ctrl Edit Edit-Ctrl Edit-X + ---- ---- --------- ------ + +@ (Mark List) (Mark Block) (Mark Statement) (Mark Procedure) F +B Backward List (Backward Statement) Backward Block (Backward Procedure) B +F Forward List Forward Statement Forward Block (Forward Procedure) F +V Make BEGIN END Make Named BEGIN END V + + + COMMANDS REDEFINED IN MACRO MODE: + + Ctrl Edit Edit-Ctrl Edit-X + ---- ---- --------- ------ + +B Go to AC Field Go to Previous Label B +F Go to Address Field Go to Next Label F + + + COMMANDS REDEFINED IN TECO MODE: + + Ctrl Edit Edit-Ctrl Edit-X + ---- ---- --------- ------ + +B Backward conditional Backward iteration B +F Forward conditional Forward iteration F + + +File commands: + ^X ^D Directory Display + ^X ^E Edit File + ^X ^F Find File + ^X ^Q Do Not Write File + ^X ^R Read File + ^X ^S Save File + ^X ^V Visit File + ^X ^W Write File + + New macros written for this package: +^R Forward Word: Move forward over one word. +^R Forward End-of-Word: Move forward to the next word end. +^R Backward End-of-Word: Like Backward Word, but moves to end of + previous word. +^R Kill Word: Kill next word and trailing delimiters. +^R Kill to End-of-Word: Kill to next word end. +^R Backward Kill to End-of-Word: Like Backward Kill Word, + but kills to end of previous word. +^R Complement Overwrite Mode: + If Overwrite Mode is on, turn it off. If it is off, + turn it on. When Overwrite Mode is on, typed non-meta characters + will delete and overwrite characters in the buffer instead + of being inserted. Meta characters still function normally. +Goto Page: If no arg, go to top of next page. + If arg is zero, go to top of page. + If arg is negative, go to top of page, unless already at top, + in which case go to top of preceding page. + If arg is positive (+n), go to top of page n of buffer. + If two args (m,n), go to line m of page whatever. +^R Copy Lines: Like killing lines and getting them back, + but doesn't mark buffer modified. +^R Set Fixed Mark: If no arg, set "ring-of-point" mark. + If arg is zero or positive, set corresponding fixed mark. + There are 10 fixed marks, numbered 0 to 9. They contain character + counts relative to the beginning of the buffer. Fixed marks may + be changed only by this macro, and are unaffected by killing, etc. +^R Goto Fixed Mark: If no arg, exchange point and "ring-of-point" mark. + If negative arg, pop the "ring-of-point" mark. + If zero or positive arg, set "ring-of-point" mark and goto fixed mark. +^R Zap to Character: Kills text up to but not including a + target character. Uses the macro ^R Character Search to obtain + the target character from the keyboard and search for it. + The search skips over the character pointed to. +^R Zap thru Character: Kills text up to and including a + target character. Uses the macro ^R Character Search to obtain + the target character from the keyboard and search for it. +^R No-op: Does nothing. +^R TECO Search: Search, using the basic TECO string search facility. + Special characters: + ^B matches any delimiter char. + ^N matches any char other than the char following it in the search + string (i.e., "not"). ^N^B matches non-delimiters, and + ^N^X matches nothing. ^N^Q^B matches all but ^B, etc. + ^O divides the string into substrings searched for simultaneously. + Any one of these strings, if found, satisfies the search. + ^Q quotes the following char, i.e., deprives it of special + significance. (You must type ^Q twice in the minibuffer). + Escape and rubout cannot be quoted. + ^X matches any char. +Quit: Return to caller. Tries very hard to do the right thing + whether returning to SNDMSG, LISP, the EXEC, or recursive ^R. +^R Define Kbd Macro: Begin defining keyboad macro. + After you type this command, until you type it again, + everything you type becomes part of the accumulating keyboard + macro as well as being executed. + diff --git a/src/e142/datamedia.conversion b/src/e142/datamedia.conversion new file mode 100644 index 00000000..e3a2ba13 --- /dev/null +++ b/src/e142/datamedia.conversion @@ -0,0 +1,195 @@ + EMACS ^R-Command Chart (as of 06/20/78 23:44:32): +DATAMEDIA EQUIVALENTS (as of 6 Aug 78) + + Non-Control Non-Meta Characters: + +M-< Backspace moves back one character (or several). + Tab ^R Indent According to Mode + Linefeed ^R Indent New Line + Return ^R CRLF + Altmode ^R Prefix Meta + Rubout deletes characters backwards. + + + Control Characters: + +  .. ^R Complement SAIL Mode +M-< Backspace moves back one character (or several). + Tab ^R Indent According to Mode + Linefeed ^R Indent New Line + Return ^R CRLF +C-Z Altmode exits from ^R mode. +M-M Space ^R Set/Pop Mark +none % .. ^R Replace String + - .. is part of the next command's argument. + 0 thru 9 is part of the next command's argument. +M-; ; .. ^R Indent for Comment +^X-{ < .. ^R Mark Beginning +none = .. ^R Print Hpos +^X-} > .. ^R Mark End +M-M @ .. ^R Set/Pop Mark +M-[ A .. ^R Beginning of Real Line +M-< B .. moves back one character (or several). +M-esc C .. ^R Prefix Control-Meta +M-D D .. deletes one character (or several) forward. +M-] E .. ^R End of Real Line +M-> F .. moves forward one character (or several). + G .. quits execution of any command. +M-< H .. moves back one character (or several). + I .. ^R Indent According to Mode + J .. ^R Indent New Line +M-K K .. ^R Kill Line +M-= L .. ^R New Window +cr M .. is bare TECO's Control-M +M-lf N .. ^R Down Real Line +M-I O .. inserts one CRLF (or several) after point. +M-^ P .. ^R Up Real Line + Q .. ^R Quoted Insert +none R .. ^R Reverse Search (USE M-MINUS M-S) +C-M-S S .. ^R Incremental Search +M-E T .. ^R Exchange Characters +M-* U .. ^R Universal Argument +M-\ V .. ^R Next Screen +C-M-K W .. ^R Kill Region +M-X X .. is a prefix character. See below. +M-N Y .. ^R Un-kill + Z .. ^R Return to Superior +esc \ .. ^R Prefix Meta + ] .. is bare TECO's Control-] + ^ .. ^R Prefix Control + Rubout deletes backwards, turning tabs into spaces. + Meta Characters: + +lf Linefeed ^R Indent New Comment Line +^X-[ Return ^R Back to Indentation + Altmode ^R Execute Minibuffer + # .. ^R Change Font Word +C-M-R % .. ^R Query Replace +none ( .. ^R Make () +none ) .. ^R Move Over ) + - .. is part of the next command's argument. + . .. ^R Find Tag + / .. ^R Describe + 0 thru 9 is part of the next command's argument. + ; .. ^R Indent for Comment +M-{ < .. ^R Goto Beginning + = .. ^R Count Lines Region +M-} > .. ^R Goto End + ? .. ^R Describe +none @ .. ^R Mark Word +M-B A .. ^R Backward Sentence +M-( B .. ^R Backward Word +^X-U C .. ^R Uppercase Initial +C-M-D D .. ^R Kill Word +M-F E .. ^R Forward Sentence +^X-) F .. ^R Forward Word +C-M-Q G .. ^R Fill Region +C-M-@ H .. ^R Mark Paragraph +tab I .. ^R Tab to Tab Stop +^X-lf J .. ^R Indent New Comment Line +^X-D K .. ^R Kill Word +M-L L .. ^R Lowercase Word +^X-[ M .. ^R Back to Indentation +^X-cr N .. ^R Down Comment Line +^X-^ P .. ^R Up Comment Line +M-Q Q .. ^R Fill Paragraph +M-| R .. ^R Move to Screen Edge +M-C S .. ^R Center Line +C-M-E T .. ^R Exchange Words + U .. ^R Uppercase Word +M-+ V .. ^R Previous Screen +C-M-W W .. ^R Copy Region +C-M-X X .. ^R Execute Completed MM Command +C-M-N Y .. ^R Un-kill Pop +C-M-B [ .. ^R Backward Paragraph +M-D \ .. ^R Delete Horizontal Space +C-M-F ] .. ^R Forward Paragraph +none ^ .. ^R Delete Indentation +none _ .. ^R Underline Word + ~ .. ^R Not Modified + Rubout ^R Backward Kill Word + Control-Meta Characters: + +^X-@ Backspace ^R Mark Defun +none Tab ^R Indent for LISP +^X-lf Linefeed ^R Indent New Comment Line +^X-[ Return ^R Back to Indentation +C-M-B ( .. ^R Backward Up List +C-M-F ) .. ^R Forward Up List + - .. is part of the next command's argument. + 0 thru 9 is part of the next command's argument. +none ; .. ^R Kill Comment +hold ? .. ^R Documentation +C-@ @ .. ^R Mark Sexp +^X-B A .. ^R Beginning of DEFUN +C-B B .. ^R Backward Sexp + C .. exits from ^R mode. +none D .. ^R Down List +C-M-F E .. ^R End of DEFUN +C-F F .. ^R Forward Sexp +none G .. ^R Format Code +C-M-@ H .. ^R Mark Defun +none I .. ^R Indent for LISP +^X-lf J .. ^R Indent New Comment Line +C-D K .. ^R Kill Sexp +^X-[ M .. ^R Back to Indentation +M-F N .. ^R Forward List +none O .. ^R Split Line +M-B P .. ^R Backward List +none Q .. ^R Indent SEXP +M-~ R .. ^R Reposition Window +C-E T .. ^R Exchange Sexps +C-M-B U .. ^R Backward Up List +M-A W .. ^R Append Next Kill + X .. ^R Execute MM Command +C-M-B [ .. ^R Beginning of DEFUN +none \ .. ^R Indent Region +C-M-F ] .. ^R End of DEFUN +none ^ .. ^R Delete Indentation +none Rubout ^R Backward Kill Sexp + Control-X is an escape prefix command with these subcommands: + +C-M-Y ^X ^B List Buffers +C-Z ^X ^C ^R Return to Superior + ^X ^D ^R Directory Display + ^X ^E ^R Edit File + ^X ^F ^R Find File + ^X Tab ^R Indent Rigidly +C-M-L ^X ^L ^R Lowercase Region + ^X ^N ^R Set Goal Column + ^X ^O ^R Delete Blank Lines +C-M-P ^X ^P ^R Mark Page + ^X ^Q ^R Do Not Write File + ^X ^R ^R Read File + ^X ^S ^R Save File + ^X ^T ^R Mini Visited File +C-M-U ^X ^U ^R Uppercase Region + ^X ^V ^R Visit File + ^X ^W Write File +M-G ^X ^X ^R Exchange Point and Mark + ^X Altmode ^R Re-execute Minibuffer + ^X # ^R Change Font Region + ^X . ^R Set Fill Prefix + ^X 1 ^R One Window + ^X 2 ^R Two Windows + ^X 3 ^R View Two Windows + ^X : ^R Set Column + ^X ; ^R Set Comment Column + ^X = ^R Where am I + ^X A ^R Append to Buffer +M-Y ^X B Select Buffer +none ^X D ^R Dired +^X-Q ^X F ^R Set Fill Column +^X-N ^X G ^R Open Get Q-reg + ^X I ^R Info +none ^X K Kill Buffer + ^X L ^R Count Lines Page + ^X M Mail +M-H ^X N ^R Set Bounds Region + ^X O ^R Other Window + ^X P ^R Set Bounds Page + ^X R ^R RMAIL +C-M-H ^X W ^R Set Bounds Full +^X-W ^X X ^R Put Q-reg +none ^X ^ ^R Grow Window + ^X _ ^R Underline Region diff --git a/src/e142/datamedia.doc b/src/e142/datamedia.doc new file mode 100644 index 00000000..9150a6f4 --- /dev/null +++ b/src/e142/datamedia.doc @@ -0,0 +1,63 @@ +DATAMEDIA is a macro library that attempts to make EMACS more +accessible to the SRI user. It does this in three ways: + + 1. The command set has been rearranged and regularized, making +it easier to learn and easier to remember. + 2. The command set is optimized for the Datamedia keyboard. +Maximal use is made of the keypad at the right side. Almost all +editing commands use the edit-key, some use the control-key as well; +there are very few commands that use the control-key alone. + 3. Some new functions have been added, and others have been +modified, to provide additional capability. + +If interest warrants, the EMACS documentation under the INFO subsys +could be rewritten to reflect the new functions. But for the +present, users new to EMACS should follow the following procedure: +List yourself copies of DATAMEDIA.CHART (it's formatted for +wide paper) and DATAMEDIA.CONVERSION. Start up EMACS, type ^_ +(the "hold" key) followed by "I" to get yourself into the INFO +system, then follow directions. Whenever the documentation talks +about a particular command, (for example C-F,) look in your listing +of DATAMEDIA.CONVERSION to find the new equivalent (M-> in this +example). Locate the new command in DATAMEDIA.CHART so you can see +the relationship of this command to other commands. + +Users already somewhat familiar with EMACS should find DATAMEDIA.CHART +self-explanatory. + +To use the new command set, use the command MM Load$DATAMEDIA. (Type +Edit-X, "LOAD", escape, "DATAMEDIA", carriage return.) To have new +new command set automatically load whenever you use EMACS, copy the +file EMACS.INIT or the equivalent to your own directory. + +Note that the commands that move forward and back by words or delete +words always move to the beginnings of words. The same commands with +a ^X prefix move to the ends of words. In the original EMACS it +depended on which direction you approached from. + +Ten "fixed marks" have been provided in addition to THE mark. "The +region" is still defined by the pointer and THE mark; the additional +fixed marks provide the capability of designating some particular +spot in your file that stays put while you copy text elsewhere. With +no arguments, the new command M-M sets THE mark and the command M-G +goes to THE mark (Exchange Point and Mark). With a numeric argument +(0-9) they set or go to the corresponding fixed mark. + +C-X and M-X provide the identical function in the new command set. +They are redundant for convenience in typing commands like C-X C-D +(Directory Display) or M-X M-D (Kill Word) without shifting bits in +mid-command. + +The functions for editing LISP code sometimes double up on +keystrokes. For example, M-F will either be Forward Sentence or +Forward List depending on whether you are in LISP mode or some other +mode. There are ties to the Interlisp/EMACS interface, which allows +you to call EMACS directly from Interlisp to edit LISP functions and +S-expressions. The interface is documented in the file +NEMACS.DOC. + +If you plan to make regular use of EMACS/Datamedia, send me a message +so I can keep you up to date on changes. + + Jerry Agin (AGIN@SRI-KL) + diff --git a/src/e142/datamedia.msg b/src/e142/datamedia.msg new file mode 100644 index 00000000..c5c6e6fa --- /dev/null +++ b/src/e142/datamedia.msg @@ -0,0 +1,279 @@ +30-Aug-78 12:52:43-PDT,180;000000000001 +Date: 30 Aug 1978 1252-PDT +From: Agin +Subject: EMACS Simplified +To: system + +Users and prospective users of the text editor EMACS should read +DATAMEDIA.DOC +------- + 1-Sep-78 10:32:54-PDT,1180;000000000001 +Date: 1 Sep 1978 1032-PDT +From: Agin +Subject: Changes to EMACS/Datamedia +To: EMACS/Datamedia Users: + +Commands have been set up to give the user several options in the +setting of control and meta bits. There are three conventions: + 1. Use the Ctrl and Edit keys on the Datamedia Keyboard. + 2. Use Escape for Meta and either Edit-Escape or + Escape-Escape for Control-Meta. This usage is + similar to TVEDIT. + 3. Use the three unlabeled keys on the left of the keyboard + (between ^L and ^A). The bottom key, ^^, is Prefix + Control. The middle key, ^], is Prefix Meta. The + top key, ^\, is Prefix Control-Meta. +The Execute Minibuffer command has been moved to ^X-X to free M-escape. + +The commands that exchange characters, words, etc. have been moved +from "T" to "E", where they will be more mnemonic. + +Back to Indentation has been assigned to ^X-[ . + +A No-op macro has been implemented and assigned to C-N. Try it after +documentation commands, ^C, etc. + +Replace String is no longer assigned to M-R. It turns out that it +replaces EVERY occurrence of the string. You can get that by typing +"!" to Query Replace. + + Jerry Agin +------- + 7-Sep-78 13:51:17-PDT,499;000000000001 +Date: 7 Sep 1978 1351-PDT +From: Agin +Subject: ^Z Changes +To: EMACS/Datamedia Users: + +^Z had erroneously been assigned to Exit ^R Mode, instead of Return +to Superior. This has now been fixed. The problem of accidentally +hitting ^Z and finding yourself in TECO should not happen any more. + +A new macro called ^R Save and Return to Superior has been +implemented and assigned to ^X ^Z. This is the command to use to +exit from EMACS when called from inside SNDMSG, LISP, etc. +------- +12-Sep-78 17:09:50-PDT,1632;000000000001 +Date: 12 Sep 1978 1709-PDT +From: Agin +Subject: Miscellaneous +To: EMACS/Datamedia Users: + +A new function, "TECO Search" has been defined and assigned to ^X S. +This function uses some powerful features of the underlying TECO +that just ain't available thru the fancied-up "Incremental Search" +function. TECO Search uses the special character ^B to match any +delimiter, and ^X to match any character. ^N is used to negate a +match to the following character. ^O is an "or" function, dividing +the search string into substrings to be searched for simultaneously. + +Both TECO Search (^X S) and Query Replace (C-M-R) use the minibuffer +to obtain their arguments. I'm thinking that it is a mistake to +do it this way--they could just as easily obtain their arguments in +the prompt area the way MM commands do. The price is that carriage +return can't be part of any argument, but the advantage is that +there's one unusual mode of input the user need not learn. Does +anyone have reactions? If I don't hear objections, I'll make the +changes soon. + +Another troublesome matter concerns the various flavors of ^Z. I +discovered that you need the original definition of ^Z (Exit ^R +Mode) to get out of the "Edit Tab Stops" function. One fix is to +redefine Edit Tab Stops so it temporarily re-assigns ^Z to the +do what is necessary. This seems rather unclean, but on the other +hand, a system where you need to remember three different exit +functions that depend on what you're doing isn't very clean either. +Comments anyone? + +The "Where am I" function (^X =) now gives the page and line. + + Jerry +------- +13-Sep-78 16:39:37-PDT,384;000000000001 +Date: 13 Sep 1978 1639-PDT +From: Riseman +Subject: EMACS Documenatation +To: agin + +Gerry, +Is there any documentation file for EMACS which gives +a nice summary of the basic commands. I have listed some +of the nodes in INFO, but they are often long-winded and +provide too much detail to start. I also have listed +the Datamedia chart and conversion tables. +--Ed-- +------- +13-Sep-78 17:23:55-PDT,989;000000000001 +Date: 13 Sep 1978 1723-PDT +From: Agin +Subject: Re: EMACS Documenatation +To: Riseman +cc: AGIN + +In response to your message sent 13 Sep 1978 1639-PDT + +The node "Basic" in the INFO file is a reasonable summary of the basic +commands (modulo conversion to the Datamedia command set). If you +don't like poking thru windy explanations, you might prefer to use +some of the self-documenting features of EMACS. ^_ is the help character; +it is equivalent to the "hold" key. "^_ A FOO" will type the names +of all commands that have FOO in their names. ("A" here stands for +"Apropos".) "^_ D ^R DOWN LINE" types a complete description of the +command "^R DOWN LINE". ("D" for describe.) "^_ C " +tells you what command is assigned to the key, and its description. +The data base for all these features gets automatically updated +whenever commands are changed, so it always corresponds to the version +you have in core at that given moment. + + Jerry +------- +18-Sep-78 10:54:35-PDT,1470;000000000001 +Date: 18 Sep 1978 1054-PDT +From: Agin +Subject: New features +To: EMACS/Datamedia Users: +cc: Boyer + +Commands for editing LISP code have been added to the command set. +See the latest edition of DATAMEDIA.CHART for where they go. I am +indebted to Bob Boyer for supplying some redefinitions and character +tables to make it edit Interlisp. See the file NEMACS.DOC for +the description of a very nice interface that allows you to call EMACS +directly from Interlisp to edit LISP functions and S-expressions. +Note that editing commands get placed on different keys in the Datamedia +environment than Boyer uses in the default environment. In particular, +^Z is the return-to-LISP function. + +^Z is now the universal pop-a-level character within the EMACS/Datamedia +environment. You should use it to return to SNDMSG or LISP, and to +return from recursive ^R. If you use it at any other time, it is +equivalent to ^C. The implementation of ^Z requires that functions +which invoke recursive ^R set up the return function. At present +only Query Replace and Edit Tab Stops know about ^Z. If you use or +know about other functions that call recursive ^R please let me know +so I can set them up to use ^Z also. + +Query Replace and TECO Search now take their arguments from the echo +area rather than the minibuffer. + +The Incremental Search function now recognizes M-S as equivalent to +^S and M-R as equivalent to ^R. + +Enjoy! + Jerry +------- + 6-Oct-78 09:30:35-PDT,497;000000000001 +Date: 6 Oct 1978 0930-PDT +From: Agin +Subject: Changes +To: EMACS/Datamedia Users: + +There's a new SAIL major mode for editing SAIL programs. Commands +are summarized in the newest edition of DATAMEDIA.CHART. Very little +of it is implemented now, but it'll grow. + +The Help function is improved. + +Buffer creation is smarter: It takes its major mode from whatever +was in effect previously. Auto-filling is local to buffers now, and +gets copied when a new buffer is created. +------- +25-Oct-78 09:23:23-PDT,2279;000000000001 +Date: 25 Oct 1978 0923-PDT +From: Agin +Subject: Changes +To: EMACS/Datamedia Users: + +The implementation of the Quit function (^Z) has been changed to +avoid changing all the functions that call ^R recursively. The way +it works now is that ^Z always leaves ^R mode--the smarts about +buffer saving, returning to SNDMSG or LISP, etc, are in what called +^R in the first place. + ^Z when you are at the top level (and not in SNDMSG or LISP) +will save whatever file you are editing and exit to the EXEC. +CONTINUE after ^Z will return you to the edit. + To take advantage of this, you will need to change your +EMACS.INIT file. Replace the cryptic last line of the file with the +following: + MM Startup Datamedia +Alternatively, copy EMACS.INIT to your own directory. + +More goodies in SAIL mode: + Forward Statement and Forward Block now work. They both +recognize comments (either the word COMMENT or a bare exclamation +point) and quotes. M-F is now Forward Statement and C-M-F is Forward +Block--they used to be the other way around. + Backward Block does NOT understand comments or quotes. +Someday I might get around to fixing it. + Make BEGIN-END (M-V) creates a BEGIN END pair. The +indentation level is determined by the position of the cursor at the +time you call it. Make Labelled BEGIN-END (C-M-V) reads a block name +from the echo area and puts it in quotes after the BEGIN and the END. +With either function, a numeric argument will place a semicolon after +the END. + Edit-tab has been modified so that a negative argument will +indent yay-many levels to the right of the preceding line's +indentation. The number of spaces in one level is determined by the +variable Indentation Increment. This variable may be set in your +INIT file--see EMACS.INIT, for example. (Note that setting +Indentation Increment must occur AFTER the call to MM Datamedia.) +You can also change this variable using MM Alter Options. Its +initial value is 1. + + The default search pattern for Character Search is now kept +separately from the default for incremental and string searches. + + Forward and Back DEFUN have been added to LISP Mode. + + TECO Mode has been modified to make M-F and M-B be Forward +and Back TECO Conditional. + + Enjoy! +------- + 9-Nov-78 14:01:52-PST,2083;000000000001 +Date: 9 Nov 1978 1401-PST +From: Agin +Subject: New Goodies! +To: EMACS/Datamedia Users: + +A new EMACS was put up November 6. It's winningest new feature is +Keyboard Macros!!! Your keystrokes can be remembered and played back +just like TVEDIT strings. I've adapted them for Datamedia. + To start a Keyboard macro definition, type M-/. The word +"Defining" will appear in your mode line. Everything you type will +be remembered, until you type another M-/ to end the definition. + M-X / re-executes the last defined keyboard macro. + Keyboard macros can be named and can also be assigned to +keystrokes. Use MM Name Kbd Macro$. You will be prompted for "^R +Command to define:" Type a control character (or M-X character). +If you try to redefine certain characters, EMACS will complain. + If you supply a text arg to MM Name Kbd Macro$ the keyboard +macro will be given a name. If you name your macro FOO, then MM FOO +will run it now. + MM View Kbd Macro will display the contents of any keyboard +macro. It needs either a control-character to which a keyboard macro +has been assigned, or M-X /. + +Autosave Filename is now defaulted to AUTOSAVE..1000nn, where nn is +your job number, on your login directory. In this way, auto saving +needn't fill up your directory with multiple deleted files. ^X ^S +will write to the "permanent" file name rather than the Auto Save +File, unless you give it an arg of 0. ^Z saves your file and cleans +up (deletes) auto save files. + +Goto Page (M-P) doesn't leave the mark behind any more. + +Typing C-M-S in Incremental Search (C-M-S) will start a new search. +Either C-S or M-S will repeat the previous search. + +You'll find Overwrite Mode (C-M-O) is much nicer to use now. + +Other miscellaneous improvements have been reported in past BBOARD +messages from RMS@MIT-AI. Use MSG to peruse MAIL.TXT. + +I'm thinking of putting Reverse Character Search on M-R, Reverse +Incremental Search on C-M-R, and moving Query Replace over to M-X R. +Does anybody have any reactions or preferences? + + Jerry Agin +------- diff --git a/src/e142/datamedia.users b/src/e142/datamedia.users new file mode 100644 index 00000000..70a264d9 --- /dev/null +++ b/src/e142/datamedia.users @@ -0,0 +1,3 @@ +EMACS/Datamedia Users: Agin, Barrow, Feiertag, Heathman, McGhie, +Quam, Riseman, Untulis, McLure +Rindfleisch@SUMEX-AIM, Rubenstein@SUMEX-AIM, Sweer@SUMEX-AIM diff --git a/src/e142/dired._ej b/src/e142/dired._ej new file mode 100644 index 00000000..07586dd1 Binary files /dev/null and b/src/e142/dired._ej differ diff --git a/src/e142/dmacs._ej b/src/e142/dmacs._ej new file mode 100644 index 00000000..ad9a184a --- /dev/null +++ b/src/e142/dmacs._ej @@ -0,0 +1,1167 @@ +@W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + u QwR:I:P:B:PPP +:[:b:0:7zDJDT:l:u(<(HRvSSKSVS,S7 r ~<<;^;iGQ*'*6((*E!E)K6KAIGIPjs@f@mAtA{;5;;*G*N6&6-/Y/`M M$6 6;I;P=='1D1K696?  LNL]T&T0L\gpMYMdSiStn{LLIS'2JUjw6>PIPRagEBEJQ;QI&!U`how u6u@u,u@>JuLuVuu U3UC|Q|]udupULUVll+ n ~ +S +` o |grhx0x=ww&c cnhn{k\ko|l|w+7_X_c||(|6|@vdvmWCWLf;fEq8qBsgsqqgqqELsFsOv~w{K{XrSr]tSt]]|^ ^o_)>KV2VEYY +Q`O\]V]fm~]8]DZu[_&_4^O^_^,^7(4_D_M}-}8Y8YE)`i`u\W\g[][kT^ThTRTY& Setup DMACS LibraryM(M.MDatamedia) +Datamediai Q..$[0 +640FSQVECTORU.X +2FS^RINITu..< +6FS^RINITu..> +M.M^R Backward Wordu..( +M.M^R Backward End-of-WordU:.X(() +M.M^R Forward WordU..) +M.M^R Forward End-of-WordU:.X()) +M.M^R Beginning of Real Lineu..[ +M.M^R Back to IndentationU:.X([) +M.M^R Prefix MetaU.] +M.M^R End of Real Lineu..] +M.M^R Up Real Lineu..^ +Q0U...^ +M.M^R Up Comment LineU:.X(^) +M.MDM Indent New LineuJ +M.M^R Down Real Lineu..J +M.M^R Indent New Comment LineU:.X(12.) +15.FS^RINITUM +16.FS^RINITu..M +M.M^R Down Comment LineU:.X(15.) +M.M^R Goto BeginningU..{ +M.M^R Mark BeginningU:.X({) +M.M^R Goto EndU..} +M.M^R Mark EndU:.X(}) +M.M^R Previous ScreenU..+ +M.M^R Prefix Control-MetaU.\ +M.M^R Next ScreenU..\ +M.M^R Scroll Other WindowU:.X(\) +M.M^R Move to Screen EdgeU..| +M.M^R Reposition WindowU..~ +M.M^R New WindowU..= +M.MDM Where Am IU:.X(=) +M.M^R Backward Kill Wordu.. +M.M^R Backward Kill to End-of-WordU:.X() +377.FS^RINITU.._ +Q..$U..._ +Q..$U:.X(_) +11.FS^RINITUI +M.MDM Indent NestedU..I +M.M^R Indent RigidlyU:.X(9) +M.M^R Universal ArgumentU..* +M.M^R Indent for CommentU..; +M.M^R Set Comment ColumnU:.X(;) +M.M^R Move to HposU..: +M.M^R Set Hpos Target ColumnU:.X(:) +M.M^R Prefix MetaU +M.M^R Prefix Control-MetaU.. +M.M^R Define Kbd MacroU../ +M.M^R One WindowU:.X(1) +M.M^R Two WindowsU:.X(2) +M.M^R View Two WindowsU:.X(3) +M.M^R Modified Two WindowsU:.X(4) +Q0U.@ +Q0U..@ +Q0U...@ +Q0U.A +M.M^R Append Next KillU..A +Q0U...A +Q0U.B +Q0U..B +Q0U...B +Q0U.C +M.M^R Center LineU..C +Q0U...C +M.M^R Center RegionU:.X(C) +Q0U.D +4FS^RINITu..D +M.M^R Kill Wordu...D +M.M^R Directory DisplayU:.X() +M.M^R Kill to End-of-WordU:.X(D) +Q0U.E +M.MDM Exchange CharactersU..E +M.MDM Exchange WordsU...E +M.M^R Exchange LinesU:.X(E) +M.M^R Edit FileU:.X() +Q0U.F +Q0U..F +Q0U...F +M.M^R Find FileU:.X() +M.M^R Goto Fixed MarkU..G +Q0U...G +Q0U +M.M^R Set Bounds RegionU..H +M.M^R Set Bounds FullU.. +17.FS^RINITU..I +Q0U..J +Q0U.K +M.M^R Kill Lineu..K +M.M^R Kill Regionu...K +M.M^R Kill into Q-regU:.X(K) +12.FS^RINITU.L +M.M^R Lowercase Wordu..L +M.M^R Lowercase Regionu...L +M.M^R Set Fixed MarkU..M +M.M^R No-opU.N +M.M^R Un-killU..N +M.M^R Un-kill PopU...N +M.M^R Get Q-regU:.X(N) +Q0U.O +Q0U..O +M.M^R Complement Overwrite Modeu...O +M.M^R Other WindowU:.X(O) +Q0U.P +M.MGoto PageU..P +M.M^R Mark PageU...P +M.M^R Set Bounds PageU:.X(P) +M.M^R Quoted InsertU.Q +M.M^R Fill Paragraphu..Q +M.M^R Fill Regionu...Q +M.M^R Set Fill ColumnU:.X(Q) +M.M^R Do Not Write FileU:.X() +Q0U.R +M.MDM Reverse Character SearchU..R +M.MDM Reverse Incremental SearchU...R +M.MDM Query ReplaceU:.X(R) +M.M^R Read FileU:.X() +Q0U.S +M.MDM Character SearchU..S +M.MDM Incremental SearchU...S +M.M^R TECO SearchU:.X(S) +M.MDM Save FileU:.X() +Q0U.T +M.M^R Find TagU..T +Q0U...T +Q0U.U +M.M^R Uppercase Wordu..U +M.M^R Uppercase Regionu...U +M.M^R Uppercase InitialU:.X(U) +Q0U.V +Q0U..V +Q0U...V +M.M^R Visit FileU:.X() +M.M^R Backward Kill WordU.W +M.M^R Copy LineU..W +M.M^R Copy RegionU...W +M.M^R Put Q-regU:.X(W) +M.MWrite FileU:.X() +Q.XU..X +M.M^R Execute Completed MM CommandU...X +M.M^R Execute MinibufferU:.X(X) +Q0U.Y +M.MSelect BufferU..Y +M.MList BuffersU...Y +33.FS^RINITU.Z +M.M^R Zap to CharacterU..Z +M.M^R Zap thru CharacterU...Z +MMMake VariableFixed Mark +50FSQVECTORUFixed Mark +(@:I*/QMode +QAuto Fill Mode/)M.VBuffer Deselection Hook +(@:i*/M(M.M A Mode) +QBM.LAuto Fill Mode +QB"N1M.LSwitch Mode Process Options' +/)M.VBuffer Creation Hook +69fsadline +69ufill column +M.VCSearch Default +1M(M.MSet Variable Comment)Indentation Increment* Number of spaces per level of indentation +QComment ColumnM.VMoveto Column +(M.MDM Toplevel ^R)FS^RENTER +(M.MDM Secretary Macro)U..F +Q..FU.F +0M.VMM Quit +M(M.MText Mode) +@:I*/M.M^R Find TagU..T +m.m^R Add TagU:.X(T)/M.VTags Setup Hook +(M.M& Maybe Strip)M.VVisit File Hook +:IEditor NameDMACS +:I..JDMACS  +M(M.M& Set Mode Line) +0 ^R Complement Overwrite ModeiQOverwrite Mode[1 +Q1"N0U1'"#-1U1' +Q1UOverwrite Mode +Q1FS^RREPLACE +M(M.M& Set Mode Line) +0 +Goto Page!f[sstring[1 +QPage Delimiter[0 +u1ff"e1u1' +"#Q1"GJQ1-1U1'' +q1"gq1<:s0;>' +"#Q1"LR' +-:S0:' +FF-1"G +.U1 +:S0:.[2 +Q1J-1L +Q2-."LQ2J'' +0^R Copy Lines0.: +FF"EL' +"#L' +:M(M.M^R Copy Region)^R Set Fixed Mark)FF"E.:' +"#.U:Fixed Mark()' +0^R Goto Fixed MarkFFF"E.(W):' +"#"L.:WW1:<>' +"#.: +Q:Fixed Mark()J'' +0^R Zap to Characterh.: +[0FF"E1U0'"#U0' +Q0"GC'"#R' +Q0M(M.MDM Character Search) +"LC'"#R' +:M(M.M^R Kill Region)^R Zap thru CharacterQ.: +[0FF"E1U0'"#U0' +Q0M(M.MDM Character Search) +:M(M.M^R Kill Region)^R Forward Word71:<1A"C1+'1.W:FWL>F"NFG0' +-1:<2.W:FWL>F"NFG'0^R Forward End-of-Word!f"LW-':<"L-'.wfwl>"nfg'0^R Backward End-of-Word91:<0A"C-1'-1.W:FWL>F"NFG0' +-1:<-2.W:FWL>F"NFG'0^R Kill WordX1[9.[0 +1:<1A"C1+'1.W:FWL>F"NFG0' +-1:<2.W:FWL>F"NFG0' +Q0,.:M(M.M& Kill Text)^R Kill to End-of-Word([9.,(.wfwr).F:M(M.M& Kill Text)#^R Backward Kill to End-of-Word[-1[9.[0 +1:<0A"C-1'-1.W:FWL>F"NFG0' +-1:<-2.W:FWL>F"NFG0' +.,Q0:M(M.M& Kill Text)^R Kill into Q-reg1:M(M.M^R Put Q-reg) ^R No-op0DM Where Am IU:i*CFSECHODIS +QPage DelimiterU3 +[E[BFSBOUNDUEUB +0,FSZFSBOUND +.U0J1U10U4<:S3;.-Q0-2;.U4%1> +Q4J1U2 +Q0JQB,QEFSBOUND +@FTPage Q1@:= +@FT Line Q2@:= +@ft X=fsshpos@:= +@ft Y=fs^rvpos@:= +.-z"n@ft CH=8[..e1a@:=]..e' +@ft .=.@:=@ft(.*100/fsz@:=@ft%) +fsvz+b"n +@ft H=<h@:=@ft>' +@ft 1fsechoact0^R TECO SearchA1,M(M.M& Read Line)Search:[0 +[1Q1"E1U1' +Q1:S0"EFG' +0DM Query Replace]FF"N:\'"#:I*'[1 +1,M(M.M& Read Line)Query Replace:[0 +1M(M.MQuery Replace)0 +Grind SexpW1:< +FDLR +F[VBF[VZFLFSBOUND +F=MODELISP"NOConfirm' +z-b-1000"g!Confirm!^FTDo you really want to Grind this s-expression? (Y or N): +FI:FC-Y(FSEchoDisplayCFSEchoDisplay)"N'' +Z: +M(M.M& Save Region and Query) +WJ +[2[3 +[D128*5,32:ID +11.*5:FD-D:M2 +15.*5:FDRK:M2 +12.*5:FD-D:M2 +%*5:FDC +"*5:FDR^FLL +(*5:FD:M3 +!"!'*5:FD:M3 +)*5:FDRM3C +:I2Z-.<1AF  :;D>32I +:I3Z-.<1AF  :;D> +HFD +J.(0FSVBW0L.FSVB)J +FSWIDTH-10[W +FSWIDTH*2/3[C +0FO..QFill ColumnF"NUW +QWUC' +-1FO..QComment Column+1F"G-1UC' +QC[M +-1FO..QMiser Column+1F"G-1UM' +[R:IR/8+1*8 +0FO..QComment RoundingF"NUR' +M.M& Indent +[G^:IG` +[2S'R +1A-("N^FWL' +FL-.-QW++(FSHPOSU2Q2)"LFLL' +CQ2-QM"L +!"!1AF';()"L^FWL1A-32"EC''' +FSHPOSU2 +!LP!1a-32"EDOLP' +1A-)"EC' +FSHPOSU3 +Q3-Q2"N13I10I +Q2/8,9IQ2&7,32I' ++1MGOLP +` +0MG +J7F~(DEFUN "E +^FLL8F= + "E +8D.U3L +Q3,.F~FEXPR +*(Q3,.F~MACRO +)"E +-2D6D''' +JHU2U3 +> +JZ: +Q3,Q2DM Incremental Search7[D +0[L +10.[R +[Q@:iQ` +q4+1*5-fq3"e +q3[..ozj +200,0i]..o' +.u:3(%4) +qLu:3(%4) +q2u:3(%4) +q0u:3(%4) +qDu:3(%4) +` +[T@:iT` +fsrgetty"n3.&qR"n +fsechodispTfsechodisp +fsechodispLfsechodisp'' +@ft8:i8 +` +[0 +[2:i2 +[8:i8 +1fo..qSearch Exit Option +200fsqvector[3 +-1[4 +[5 +.[P +[S:ISM.M& Isearch RuboutUS:MS +1f[noquit +[6[7[..j +qD"g:i6I-Search :i7Failing I-Search ' +qD"l:i6Reverse I-Search :i7Failing Reverse I-Search ' +0[I +fsrgetty"n +fsechodispTfsechodisp +fsechodispLfsechodisp +@ftSearch: -1fstypeo' +"#@ft S: 1fstypeo' +!Restart! +1:<1uI-2f[noquit +0fsnoquitwqD:m(m.m^R String Search)' +q5-8"eoFunny' +q5-176."goFunny' +q5- +"e +FSREREAD' +!Normal! +4uR +mQ +:i220 +fq8"nmt' +@ft0"# +!Try! +mt +1&qR"n!' +' +qL"n!' +.u5 +40.&qR"e +qD"gfq2-1r' +"#fsz-qPf[vz +fq2-1"gfq2:c"ezj'' +f]vz'' +qD:s2"l!' +q5j1uLfg! +!Funny! +q5-177."eoRubout' +q5&137.-S"eQ5-600."LoForward'' +q5&137.-R"eQ5-600."LoBackward'' +q5&537.-Q"eoQuote' +qE"eonormal' +oControl +!Quote! +fsosteco"n-1f[helpch' +2,m.ifiu0 +fsosteco"nf]helpmac' +onormal +!Forward! +qD"l:i6I-Search:i7Failing I-Search' +q4"LqD"goDefault' +"#1uD!'' +mQ +qD"L0uL' +1uD +40.uR +otry +!Backward! +qD"g:i6Reverse I-Search:i7Failing Reverse I-Search' +q4"LqD"loDefault' +"#-1uD!'' +mQ +qD"g0uL' +-1uD +40.uR +otry +!Default! +mQ +qSearch Default Ring[..o +.fswordu2]..o +fq2"l:i2' +q2u8 +40.uR +otry +!Rubout! +q4"lfg!' +ms +otry +!Control! +q5fsreread +0; +>>u0@feqit-q0"e@fg +QL"gmt +oRestart' +qI"emsmtoRestart' +QPJ0fsnoquit +-1fsquit'' +q0f"nfserr' +fq2"g +qSearch Default Ring[..o +fq(.fsword)-1"G5c.-z"ej'' +q2,.fsword +]..o' +@ft +qPmMM & Maybe Push Point +0!DM Reverse Incremental Search$-@:M(m.mDM Incremental Search)DM Character Search>[0[1[20[3[9 +!RDCH!M.I@:FIU0 +FIU9 +Q0-(FS^RLAST)"EF[SSTRING +QCSearch DefaultFSSSTRING +OSEARCH' +Q0:FCU0 +Q0-301."E +Q1:M(M.M^R String Search)' +Q0-306."E1u3oRDCH' +Q0-321."EM.IFIU9' +Q0-322."E-Q1U1ORDCH' +Q0-323."EF[SSTRING +QCSearch DefaultFSSSTRING +OSEARCH' +Q0-324."E' +"#F[SSTRING0S9' +FSSSTRINGuCSearch Default +!SEARCH! +.U0Q1:S"EFG' +Q0M(M.M& Maybe Push Point) +q3"N2fo..QNext Screen Context Lines:f' +1 +DM Reverse Character Search"-@:M(m.mDM Character Search) +LISP Mode +M(M.M& Init Buffer Locals) +M.M^R Indent For LISPM.Q..  +M.M^R Mark SexpM.Q.@ +M.M^R Mark DefunU:.X(@) +M.M^R Backward SexpM.Q.B +M.M^R Backward ListM.Q..B +M.M^R Backward Up ListM.Q...B +M.M^R Beginning of DefunU:.X(B) +M.M^R Kill SexpM.Q.D +M.MDM Exchange SexpsM.Q.E +M.M^R Forward SexpM.Q.F +M.M^R Forward ListM.Q..F +M.M^R Forward Up ListM.Q...F +M.M^R Make ()M.Q..V +M.M^R End of DefunU:.X(F) +1,(:I*(* )M.LComment Start +1,(:I*(* )M.LComment Begin +1,(:I*))M.LComment End +1,(:I*)M.LParagraph Delimiter +0FO..QLISP ..DF"E +S +!"!:I* A A A A A A A A A A + A A A A A A A A A A A A A A A A A A A | A AA A/ A ' ( ) A A A A AA A AA AA AA AA AA AA AA AA AA AA A A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A M.VLISP ..D +QLISP ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)LISPMIDAS ModeIM(M.M& Init Buffer Locals) +1,(:I*;)M.LComment Start +1,(:I*;)M.LComment Begin +1,(:I*)M.LParagraph Delimiter +0fo..qMIDAS Vector[1 +q1"e5*5fsqvectoru1q1m.vMIDAS Vector +m.m^R Go to AC Fieldu:1(0) +m.m^R Kill Terminated Wordu:1(1) +m.m^R Go to Address Fieldu:1(2) +m.m^R Go to Next Labelu:1(3) +m.m^R Go to Previous Labelu:1(4)' +1,Q:1(0)M.Q..B +1,Q:1(2)M.Q..F +1,Q:1(3)M.Q...F +1,Q:1(4)M.Q...B +Q.0,1M(M.M& Set Mode Line)MACRO +TECO Mode 1,M.M& FILE PURIFY LOADED"E +F[DFILEM(M.MLoad Library)PURIFY' +M(M.M& Init Buffer Locals) +1,(:I*!*)M.LComment Start +1,(:I*!* )M.LComment Begin +1,(:I*!)M.LComment End +1,(:I*)M.LParagraph Delimiter +m.m^R Backward TECO ConditionalM.Q..B +m.m^R Forward TECO ConditionalM.Q..F +m.m^R Backward TECO IterationM.Q...B +m.m^R Forward TECO IterationM.Q...F +FSRGETTY"N +65FS^RINITM.Q[' +0FO..QTECO ..DF"E +!"!:I* + A A A A A A A ' ( ) A A A A / AA AA AA AA AA AA AA AA AA AA A ; A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A | A A M.VTECO ..D +QTECO ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)TECO +SAIL Mode'M(M.MLoad)SAIL +:M(M.MSAIL Mode)MACRO ModeF:M(M.MMIDAS Mode) +Text ModebM(M.M& Init Buffer Locals) +1,0M.LSpace Indent Flag +M.M^R Mark SentenceM.Q..@ +M.M^R Mark ParagraphM.Q...@ +M.M^R Backward SentenceM.Q..B +M.M^R Backward ParagraphM.Q...B +M.M^R Forward SentenceM.Q..F +M.M^R Forward ParagraphM.Q...F +0FO..QText ..DF"E +!"!:I* + A A A A A A A A' ( ) A A A A / AA AA AA AA AA AA AA AA AA AA A ; A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A | A A M.VText ..D +QText ..D'M.Q..D +Q.0,1M(M.M& Set Mode Line)Text& SAI Mode:M(M.MSAIL Mode)& LSP Mode& LISP Mode:M(M.MLISP Mode)& PUB Mode:M(M.MText Mode)Auto Fill Mode-1*(FF)"E1'"#0'UAuto Fill Mode +1M.LSwitch Mode Process Options +M(M.M& Process Options) +M(M.M& Set Mode Line) +0 +Fill ModeF:M(M.MAuto Fill Mode) +Save ModeF:M(M.MAuto Save Mode)DM Indent New LineL@-F  K +.(@MM +0fo..qFill Prefix[3 +fq3"gg3' +"#0fFM..I' +),.DM Indent Nested[.4.[.2 +100000[.3 +QComment Start[.5 +"G'"#1'< +< +0@l@-f +lb-.; +0@l@f  r +fq.5f"gf~.5"e!'' +fsshposu.4 +q.4"e!' +q.4-q.3:; +> +q.4u.3> +fshposu.4 +"L-*QIndentation Increment+Q.4U.4' +q.2jz-.u.2@0l +q.4m(m.m& indent)( +z-q.2,.fj)Startup Datamedia}^:I..L` +FSECHOLINES-3"G3FSECHOLINESW' +:M(M.MDM Toplevel ^R) +` +Q..9"EQ..LU..9' +FQ(0FO..QAuto Save Filenames)-1"L +FSMSNAME:F6[0 +FSUINDEX+100000:\[1 +:I*DSK:<0>AUTOSAVE..1M.VAuto Save Filenames]1]0' +FSXJNAME:F6[J +FSMSNAMEFSDSNAME +QFind File Inhibit WriteUInhibit Write +FS%TOFCI"E +M.M^R Autoarg[0460.-1[1 +10Q0U..- +]1]0' +0[00[1 +Z"EFJJ@F + K' +ZJ."N +0,0A- +"E-D' +J:S"N.,Z^FX1-D' +HFX0' +FSLISPT"NFSCCLFNAMU0 +0FSSUPERIOR +0U1F~JSNDMSG"EM(M.MTEXT MODE)'' +HK0FSMODIFIED +Q0"EQ1"E +0FO..QDMACS Version[1 +Q1"EqEMACS Version:\U1' +FTDMACS Editor, version 1 - type ^_ (the "hold" key) for help. +]1 +!''!'' +FQ0-1"LQ1"NM1' +]1]0]J:M..9' +QInhibit Write,M(M.MVisit File)0 +FSLISPT"NF~JSNDMSG"N +QBuffer FilenamesF[DFILE +0FSDVERS +FSDFILEUBuffer Filenames +M(M.M& Set Mode Line) +F]DFILE'' +Q1"NM1' +]1]0]J:M..9Dump DMACSF[DFILE +1,M.M& FILE PURIFY LOADED"E +M(M.MLoad Library)PURIFY' +FSHSNAMEUN +1:DMACS.:EJ>"N +:INEMACS +ER<N>DMACS.:EJ' +FSIFVERSION:\UV +QVM.VDMACS Version +:I*<N>DMACS.:EJ.VM.VDMACS Library Filename +EC +M(M.MDump Environment)<N>DMACS.EXEDump TEACH@:i*| +fsrgetty"eft +How do you expect to learn a display editor on a printing terminal? +140000.FSEXIT' +:i..9 +f[bbindi +M(M.MStartup Datamedia) +f]bbind +etdsk:teach-emacs.tutorial +fshsnamefsdsnamewfsdfileu0 +q0uBuffer Filenames +q0u:.b(qBuffer Index+2) +m(m.m& Set Mode Line) +jsblank lines inserted here +0l:kfsheight-24j +0u..h:m..l +F+ +|m.vMM & Startup DMACS +-1,m(m.mVisit File)DMACS.TEACH +m(m.mText Mode) +F[DFILE +1,M.M& FILE PURIFY LOADED"E +M(M.MLoad Library)PURIFY' +ERDMACS.:EJ +FSIFVERSION:\[0 +:I*DMACS.:EJ.0M.VDMACS Library Filename +EC +M(M.MDump Environment)TEACH-DMACS.EXE& Startup DMACS0FO..QMM & Startup DMACS[0 +Q0"NFQ0"G:M0'' +FSHSNAMEU0 +1:DMACS.INIT>"E +@YECM(HFX*)' +FSMSNAME[1 +ET<1>FOO..0 +:M(M.MStartup Datamedia)DM Save File3"E:M(m.m^R Save File)' +1:M(m.m^R Save File)^R Save Filey0FO..QDebug Save File"NSFORCE ERROR' +Q..F-Q.F"N0' +QAuto Save Mode[1 +FSMODIFIED"E +FF&1"N +QAuto Save Count"N +Q1-2"E +-1FSMODIFIED'''' +FSMODIFIED"E +@FT +(No changes need to be written) +0FSECHOACT' +QBuffer Filenames[0 +1[2 +Q1-2"EFF&1"E +QAuto Save FilenamesU0-1U2'' +Q0"E"N' +:I*No filenames to save underFSERR' +"N3*FSZ-(2*QAuto Save Size)"L +-2"E@FT +(File has shrunk -- not auto-saving)0FSECHOACT' +0F[TYISOURCE +@FT +File has shrunk a lot. Save anyway +@FG1M(M.M& Yes or No)"E0FSERR''' +Q0F[DFILE +Q2"G +FSDDEVICE-(F6DSK)"E +1:'' +Q2,M(M.MWrite File)0 +Q1"N +%Auto Save Count +FSDVERSIO"E +Q1-2"EFF&1"E1:!> +'' +"#QAuto Save Count-QAuto Save Max"G +%Auto Save DeleteF"GFSDVERSIO +1:''''' +FF&1"N0UAuto Save Count' +0DM Toplevel ^RMF~Editor Name..J*+fqEditor Name+1"N +f=..j(-1"g0' +[..J:I..J[..J ^R] 0:' +M.M& Recursive ^R Set ModeF[^RENTER +F +F]DFile]1' +FSXJNAME:F6[J +F~JSNDMSG"N +@FTGood-bye.' +]J +100000.FSEXITW' +>F"NFG' +> +@V +FS^RMODE"NFS^REXIT' +fsbackdepth"n'DM Secretary MacroFSMODIFIED"E0' +QAuto Save Mode"E0' +FSZ"E0' +FS^RMODE"E0' +@FT (Auto Save) +1:<2,M(M.M^R Save File)> +FSRGETTY"EF+' +0^R Forward TECO Iterationu0[1.[3 +.(:S + :FSZ-.F[VZ)J +<:S<>!*; +0A-<"E%1'!>! +!"EQ1-1U1Q1-1"L0'' +0A-*"ES!'> +Q3JFG0^R Backward TECO Iteration0[1[2.[3 +.(-:S + :.F[VB)J +<-:S<>! +; +1A-<"EQ1-1U1Q1-1"L0''!>! +!"E%1' +1A-!"E.U2-S! +2A-*"NQ2J'' +> +Q3JFGPushj-1FO..Qforkcode+1"E +[..+[.., +M(M.MLoad Library)EFORK +]..,]..+ +' +:M(M.M^R Invoke Inferior)^R Define Kbd Macroe-1FO..QLast Kbd Macro+1"E +[(Q:.X(())[(q:.x())) +[(q:.x(E))[(Q:.X(Q)) +M(M.MLoad Library)KBDMAC +]:.X(Q)]:.X(E) +]:.x())]:.x(() +m.m^R Kbd Macro QueryU..? +M.M^R Call Last Kbd MacroU:.X(/) +0M.VDefining Kbd Macro +(@:I*/QDefining Kbd Macro"NI Defining'/)M.VSet Mode Line Hook +@:I..P/QDefining Kbd Macro"N +0UDefining Kbd Macro +M(M.M& Set Mode Line)' +..P/ +' +QDefining Kbd Macro"E +M(M.M^R Start Kbd Macro) +1UDefining Kbd Macro +M(M.M& Set Mode Line) +0' +"# +M(M.M^R End Kbd Macro)[0 +FF"EM(M.MName Kbd Macro)' +0UDefining Kbd Macro +M(M.M& Set Mode Line) +Q0'& Maybe StripSF~ModeTECO"E0' +.FSWORD&1"E +:S"E0'' +:M(M.MStrip SOS Line Numbers)^R Move to HposQFF"E +QMoveto Column[0' +"#[0' +Q0"LFG0' +Q0UMoveto Column +0L +1:<0,Q0FM>"E0' +:LFSHPOS[1 +Q1-Q0"L +.[2 +Q0&770.-(Q1&770.)/8<9I> +Q0-FSHPOS<32I> +Q2,.' + +.,(Q0-FSHPOS<32I>).^R Set Hpos Target Column\ff"n'"#fsshpos'f(uMoveto Column +):\[0 +@ft +Hpos Target Column = 0 0fsechoact& DM Exchange Subrh[5[2[3[4 +"G5R-5FX4 +Z-.U2 +-15L15FX3 +.[0 +G4Z-Q2JG3FKC +Q0,Z-Q2' +"L15R-15FX4 +Z-.U2 +5L-5FX3 +.[0 +G4Z-Q2JG3FKC +Q0,Z-Q2' +.,(w).fu2j +15R-15L.u0 +q2j15R-15fx4z-.u2 +q0j15fx3g4z-q2j.u2g3 +q0q0,.(q2j)DM Exchange CharactersRff"e +@:f"e +0@f"n +-ai3rd2c.-2,.''' +:i*,:m(m.m& DM Exchange Subr)DM Exchange Words):i*.wfw,:m(m.m& DM Exchange Subr)DM Exchange Sexps':i*^fl,:m(m.m& DM Exchange Subr)^R Exchange Linesd.-Z"EFF"E +[2 +-1A-13"E-FX2-L' +"#0:FX20:L' +.,(G2ZJ).'' +:i*@F,:m(m.m& DM Exchange Subr)^R Center RegionE.,(W).F[2 +Z-Q2U2:J +<1M(M.M^R Center Line) +.+Q2-Z;> +:,.~FILENAME~ DMACS~DOC~ ~FILENAME~Library to rearrange the command set for easy use from +SRI-style Datamedia keyboards. Commands are summarized in the file +DMACS.CHART . + +~DOC~ & Setup DMACS Library& Setup macro +~DOC~ Datamedia8C Set up the EMACS/Datamedia environment. +Rearranges the command set for easy use from SRI-style +Datamedia keyboards. Commands are summarized in the file +DMACS.CHART . +&~DOC~ ^R Complement Overwrite Mode| +^R If Overwrite Mode is on, turn it off. If it is off, +turn it on. When Overwrite Mode is on, typed non-meta characters +will delete and overwrite characters in the buffer instead +of being inserted. Meta characters still function normally. +~DOC~ Goto PagekC Move forward or back by pages, or to specific page. +If no arg, go to top of next page. +If arg is zero, go to top of present page. +If arg is negative, go to top of present page, unless already at top, + in which case go to top of preceding page. +If arg is positive (+n), go to top of page n of buffer. +If two args (m,n), go to line m of page whatever. +~DOC~ ^R Copy LinesU^R Like killing lines and getting them back, +but doesn't mark buffer modified. +~DOC~ ^R Set Fixed Mark_^R Set either THE mark, or special fixed mark. +If no arg, set "ring-of-point" mark. +If arg is zero or positive, set corresponding fixed mark. +There are 10 fixed marks, numbered 0 to 9. They contain character +counts relative to the beginning of the buffer. Fixed marks may +be changed only by this macro, and are unaffected by killing, etc. +~DOC~ ^R Goto Fixed Mark4^R If no arg, exchange point and "ring-of-point" mark. +If negative arg, pop the "ring-of-point" mark. +If zero or positive arg, set "ring-of-point" mark and goto fixed mark. +~DOC~ ^R Zap to CharacterX^R Kills text up to but not including a +target character. Uses the Character Search macro to obtain +the target character from the keyboard and search for it. The search +skips over the character pointed to. + +~DOC~ ^R Zap thru Character"^R Kills text up to and including a +target character. Uses the Character Search macro to obtain +the target character from the keyboard and search for it. +~DOC~ ^R Forward Word$^R Move forward over one word. + ~DOC~ ^R Forward End-of-Word+^R Move forward to the next word end. +!~DOC~ ^R Backward End-of-Word@^R Like Backward Word, but moves to end of +previous word. +~DOC~ ^R Kill Word0^R Kill next word and trailing delimiters. + ~DOC~ ^R Kill to End-of-Word +^R Kill to next word end. +)~DOC~ ^R Backward Kill to End-of-WordE^R Like Backward Kill Word, +but kills to end of previous word. +~DOC~ ^R Kill into Q-reg ^R Put Q-reg and Kill text +~DOC~ ^R No-op^R Does nothing. +~DOC~ DM Where Am I ^R Print various things about the cursor position. +Print the page and line, +the X position, the Y position, +the octal code for the following character, +cursor position in characters and as a percentage of the total file, +and the virtual boundaries, if any. +~DOC~ ^R TECO Search/^R Search, using the basic TECO string search facility. +Special characters: +^B matches any delimiter char. +^N matches any char other than the char following it in the search + string (i.e., "not"). ^N^B matches non-delimiters, and + ^N^X matches nothing. ^N^Q^B matches all but ^B, etc. +^O divides the string into substrings searched for simultaneously. + Any one of these strings, if found, satisfies the search. +^Q quotes the following char, i.e., deprives it of special significance. + Escape and rubout cannot be quoted. +^X matches any char. +~DOC~ DM Query ReplaceC +^R Replace string, asking about each occurrence. +Query Replace:FOOBAR displays the next FOO; you say what to do. +Space => replace it with BAR and show next FOO. +Rubout => don't replace, but show next FOO. +Comma => replace this FOO and show result, waiting for next command. +Period => replace this FOO and exit. Altmode => just exit. +^ => return to site of previous FOO (actually, jump to mark). +^W => kill this FOO and enter recursive ^R. +^R => enter ^R mode recursively. ^L => redisplay screen. +Exclamation mark => replace all remaining FOOs without asking. +Any other character exits and is read again. +If QCase Replace is nonzero, BAR will be capitalized or all caps +if FOO was. +1 MM Query ReplaceFOO... will replace only FOOs that are +bounded on both sides by delimiter characters (according to ..D). +~DOC~ Grind SexpZC Grind the sexp after the pointer. +A modification of the MIT Grind Sexp that recognizes that +in Interlisp, % quotes a character, " starts a long +string, and ; has no significance. +Uses QMiser Column to decide where to start using "Miser" format, +and QFill Column as the page width to aim for. +Saves the old sexp on the kill ring. + +~DOC~ DM Incremental Search5^R Search for character string. +As characters are typed in, the accumulated string is +searched for. Characters may be rubbed out. +^Q quotes special characters. +^S or M-S repeats the search forward; ^R or M-R repeats it backward. +If the accumulated string is empty, ^R, ^S, M-R or M-S either +reverses the direction of search or gobbles the previous +search string and searches for it again. +Altmode or any random control character exits +(anything but altmode is then executed). +If the accumulated string fails to be found, +you will be notified with one bell. You can then exit, +rub the bad characters out (or ^G them all away), +or try searching in the opposite direction. +Quitting a successful search goes back to the starting +point of the search; quitting a failing search rubs out +enough characters to make it successful again. +Altmode when the string is empty makes the search +non-incremental by calling ^R String Search. +'~DOC~ DM Reverse Incremental SearchZ^R Incremental Search Backwards. +Calls Incremental Search with a negative argument. +~DOC~ DM Character Search{^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search. +%~DOC~ DM Reverse Character Search{^R Search backward for a single character. +Special Characters: + ^A Call ^R String Search; use MM Describe to see what that does. + ^F Position window so search object is near top + ^Q Quote following character + ^R Reverse search direction and read another char + ^S Search for default + Also done if character macro is called by is typed again, + overides any other function of that character shown here. + ^T Search for Teco default +If ^S is not used, the character typed becomes the default +for future searches. Defaults are kept separate +from the regular TECO "S" command and from Incremental Search. +~DOC~ LISP ModeKC Sets things up for editing LISP code +within the DMACS environment. +~DOC~ MIDAS ModeDC Set things up for editing MIDAS code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines. +~DOC~ TECO ModeRC Set things up for editing TECO code. +Makes Rubout the Tab-hacking Rubout. +Loads the PURIFY library. Makes comments be bounded by "!* " and "!". +M-F moves forward over a TECO conditional; M-B, back. +~DOC~ SAIL Mode0C Sets things up for editing SAIL programs +~DOC~ MACRO ModeDC Set things up for editing MACRO code. +M-F and M-B go to address and AC fields, respectively. +C-M-F and C-M-B go to next and previous label. +Paragraphs are delimited only by blank lines. +~DOC~ Text ModesC Set things up for editing English text. +Makes Auto Fill not indent new lines; says there are no comments. +~DOC~ & SAI ModeS Setup for SAIL. +~DOC~ & LSP Mode~DOC~ & LISP ModeS Setup for LISP. +~DOC~ & PUB ModeS Setup for Text mode. +~DOC~ Auto Fill ModehC Turn Auto Fill mode on or off. +No arg or argument of 1 turns the mode on; +any other arg turns it off. +When it is on, lines are broken at the right margin +(position controlled by QFill Column) at spaces, +by doing a LF. +~DOC~ Fill Mode!C Alias for Auto Fill Mode. +~DOC~ Save Mode!C Alias for Auto Save Mode. +~DOC~ DM Indent New Line^R Inserts CRLF, then indents the second line. +Any spaces before the inserted CRLF are deleted. +Uses the definitions of CR and Meta-Tab to do the work, +except that if there is a Fill Prefix it is used to indent. +An argument is passed on to the definition of Meta-Tab. +~DOC~ DM Indent Nested^R Indent line for specified nesting level. +With no argument (or argument 1) indents the line at the same nesting +level as the last nonblank line (ie, directly under it). +A larger argument means that this line is that many levels +closer to the surface, and should indent under the last line +above it whose level is the same. The previous lines are scanned +under the assumption that any line less indented than its successors +is one level higher than they. +A negative arg N indents to the right of the previous nonblank line; +the amount of additional indentation is N times Q$Indentation Increment. +Unindented lines and comment lines are ignored. +If the cursor is not at the beginning of a line, the whole line +is indented, but the cursor stays fixed with respect to the text. +~DOC~ Startup Datamedia C Initialize for editing, process JCL and edit. +Intended to be called from the user init file, instead of reading +EMACS.INIT. +~DOC~ Dump DMACSC Write out DMACS.EXE +~DOC~ Dump TEACH"C Write out TEACH-DMACS.EXE +~DOC~ & Startup DMACSS Startup after dumping. +~DOC~ DM Save Filel^R Save Buffer on Disk if Modified. +With zero arg, use Auto Save Filename, +else use Buffer Filename. +~DOC~ ^R Save Filee^R Save buffer on disk if modified. +Auto Save mode uses this macro. +If auto-saving is enabled, then we write to filenames read +or to a separate auto-save filename. If auto-saving is off, +or if given an argument, we always write to the filenames read. +"1," as argument indicates that this call was not explicitly +requested, and the user should be asked to confirm if +the file has become a lot smaller. "2," means an auto save, +which should abort if the file is shrunken. +~DOC~ DM Toplevel ^R"S Enter a loop entering ^R mode within a catch. +Useful as a toplevel macro to be assigned initially to FS ^R ENTER. +The macro MM Top Level will then pop up and into the outermost ^R. +If Q^R Exit Flag is zero, then ^Z will revert to the TECO command loop. +Otherwise if QMM Quit is a string, then it will be macroed. +Otherwise, the file will saved and EMACS will halt. A continue will +re-enter ^R mode. +~DOC~ DM Secretary Macro.S Standard ..F: Auto-save for use in ^R mode editing. +If QAuto Save Mode is non-zero, the buffer is saved +(as by ^R Save File) after every FS ^R MDLY characters. +#~DOC~ ^R Forward TECO Iteration2^R Move past the > matching the following <. +$~DOC~ ^R Backward TECO Iteration7^R Move back past the < matching the preceding >. +~DOC~ Push C Invoke an inferior process. +Takes two arguments, both prompted for: First the name of a +variable to hold/get the handle from, and second the name of the +subsys to invoke. The handle defaults to the last handle. +The subsys defaults to "handle".EXE on directory SYSTEM if the +handle is exec, SUBSYS if "handle".EXE exists there, and the +login directory otherwise. If the handle refers to a previously +created +(but not killed) process then that process is continued. +^R Kill Inferior destroys the process. +~DOC~ ^R Define Kbd Macro=C Begin defining keyboad macro. +Everything you type becomes part of the keyboard +macro as well as being executed. +Type this command a second time to end the definition. +A numeric argument n when you finish the definition means +re-execute the macro n-1 additional times immediately. +If you do not specify a numeric argument, you will be +prompted for a character to assign it to (type rubout +or return if you don't want it assigned). +~DOC~ & Maybe Strip<S Strip nulls and SOS line numbers from a file +if (1) Mode is not TECO, and (2) either the first word of the +file has bit 35 on or at least two consecutive nulls exist in the file. +~DOC~ ^R Move to HposF^R Move cursor to a given horizontal position, +adding tabs and spaces if needed. +With argument, move to that column number. +Without argument, move to the column whose number was last given. +#~DOC~ ^R Set Hpos Target Column^R Set target column for ^R Move to Hpos. +If argument is supplied, set target to that column. If no arg, +set target to current horizontal position. +~DOC~ & DM Exchange SubrRS Subroutine used by exchange functions. +arg1 is a string which is "fw" for the appropriate chunk-type. It will +always get an arg. arg2 is the ^R-arg, see the documentation +of ^R Exchange Characters. + ~DOC~ DM Exchange Charactersb^R Interchange the characters before and after the cursor. +With a positive argument it interchanges the character before +the cursor with the n characters after the cursor. +With a negative argument, it interchanges the character after +the cursor with the n characters before the cursor. +With a zero argument, it interchanges the characters at point and mark. +No argument is like an argument of 1, except at the end of a line +the previous two characters are interchanged. +~DOC~ DM Exchange Words-^R Interchange the words before and after the cursor. +With a positive argument it interchanges the word before +the cursor with the n words after the cursor. +With a negative argument, it interchanges the word after +the cursor with the n words before the cursor. +With a zero argument, it interchanges the words at point and mark. +No argument is like an argument of 1. +Leaves the cursor between the chunks interchanged. +~DOC~ DM Exchange Sexps]^R Interchange the S-expressions before and after the cursor. +With a positive argument it interchanges the S-expression before +the cursor with the n S-expressions after the cursor. +With a negative argument, it interchanges the S-expression after +the cursor with the n S-expressions before the cursor. +With a zero argument, it interchanges the S-expressions at point and mark. +No argument is like an argument of 1. +Leaves the cursor between the chunks interchanged. +~DOC~ ^R Exchange LinesD^R Interchange the lines before and after the cursor. +With a positive argument it interchanges the line before +the cursor with the n lines after the cursor. +With a negative argument, it interchanges the line after +the cursor with the n lines before the cursor. +With a zero argument, it interchanges the lines at point and mark. +No argument is like an argument of 1, except at the end of the buffer, +the previous two lines are interchanged. +~DOC~ ^R Center Region9^R Center all lines between the point and the mark. +~DIRECTORY~>& Setup DMACS Library +Datamedia +^R Complement Overwrite Mode +Goto Page +^R Copy Lines +^R Set Fixed Mark +^R Goto Fixed Mark +^R Zap to Character +^R Zap thru Character +^R Forward Word +^R Forward End-of-Word +^R Backward End-of-Word +^R Kill Word +^R Kill to End-of-Word +^R Backward Kill to End-of-Word +^R Kill into Q-reg +^R No-op +DM Where Am I +^R TECO Search +DM Query Replace +Grind Sexp +DM Incremental Search +DM Reverse Incremental Search +DM Character Search +DM Reverse Character Search +LISP Mode +MIDAS Mode +TECO Mode +SAIL Mode +MACRO Mode +Text Mode +& SAI Mode +& LSP Mode +& LISP Mode +& PUB Mode +Auto Fill Mode +Fill Mode +Save Mode +DM Indent New Line +DM Indent Nested +Startup Datamedia +Dump DMACS +Dump TEACH +& Startup DMACS +DM Save File +^R Save File +DM Toplevel ^R +DM Secretary Macro +^R Forward TECO Iteration +^R Backward TECO Iteration +Push +^R Define Kbd Macro +& Maybe Strip +^R Move to Hpos +^R Set Hpos Target Column +& DM Exchange Subr +DM Exchange Characters +DM Exchange Words +DM Exchange Sexps +^R Exchange Lines +^R Center Region + ~INVERT~[1Q1 diff --git a/src/e142/dmacs.teach b/src/e142/dmacs.teach new file mode 100644 index 00000000..3f37d9f0 --- /dev/null +++ b/src/e142/dmacs.teach @@ -0,0 +1,363 @@ +You are looking at the DMACS tutorial. Original authorship was by +Rubenstein@Sumex-AIM and McLure@SRI-KL. This version has been +adapted for the DMACS command set by Agin@SRI-KL. + +DMACS commands are generally prefixed by the CONTROL key or the META +(sometimes labelled EDIT) key. Rather than write out META or CONTROL +each time we want you to prefix a character, we'll use the following +abbreviations: + + C- means hold the CONTROL key down and type a character. + M- means hold the META key down while typing a character. + +Thus, C-F would be hold the control key and type F. You will often +be asked to type characters to see how they work; don't actually do +this, however, until you see >> at the left of the screen. +For instance: +<> +>> Now type M-\ (View next screen) to move to the next screen. + (go ahead, do it by depressing the edit key and \ together). + +Note that there is an overlap when going from screen to screen; this +provides some continuity when moving through the file. + +The first thing that you need to know is how to move around from +place to place in the file. You already know how to move forward a +screen, with M-\. To move backwards a screen, type M-+ (depress the +edit key and type +. + +>> Try typing M-\ and then M-+ to move back and forth a few times. + +SUMMARY +------- + +The following commands are useful for viewing screenfuls: + + M-\ Move forward one screenful + M-+ Move backward one screenful + M-= 'Refresh' the current screen. + +>> Try M-= now. (You'll notice that it centers the screen where + the cursor currently is. If this happens to move this text off the + screen, just do a M-\ to see it again.) Do a M-= for refresh. + +BASIC CURSOR CONTROL +-------------------- + +Getting from screenful to screenful is useful, but how do you +reposition yourself within a given screen to a specific place? +There are several ways you can do this. One way (not the best, but +the most basic) is to use the commands previous, backward, forward +and next. As you can imagine these commands (which are given to +DMACS as M-^, M-<, M->, and M-lf respectively) move the cursor from +where it currently is to a new place in the given direction. Here, +in a more graphical form are the commands: + + Previous line, M-^ + : + : + Backward, M-< .... Current cursor position .... Forward, M-> + : + : + Next line, M-lf + +These are the basic cursor positioning commands and you'll be using +them ALL the time so it would be of great benefit if you learn them +now. + +>> Try doing a few M-lf's to bring the cursor down to this line. + Move into the line with M-<'s and up with M-^'s. Now use + these four commands to play around a little. Try moving off + the top of this screen and see what happens. + +When you go off the top or bottom of the screen, the text beyond +the edge is shifted onto the screen so that your instructions can +be carried out while keeping the cursor on the screen. + +A faster way to move around is to move by words or even entire +sentences. Here is a summary of simple moving operations including +the word and sentence moving commands: + + M-> Move forward a character + M-< Move backward a character + M-) Move forward a word + M-( Move backward a word + + M-lf Move to next line + M-^ Move to previous line + + M-[ Move to beginning of line + M-] Move to end of line + + M-B Move back to beginning of sentence + M-F Move forward to end of sentence + + M-{ Go to beginning of file + M-} Go to end of file + +>> Try all of these commands now a few times for practice. + Since the last two will take you away from this screen, + you can come back here with M-+'s and M-\'s. These are + the most often used commands. + +Like all other commands in DMACS, these commands can be given +arguments which cause them to be executed repeatedly. The way you +give arguments is by prefixing with M- the number of times you want +it repeated. For instance, M-8 M-> moves forward eight characters. + +>> Try giving a suitable argument to M-lf or M-^ to come as close + as you can to this line in one jump. + +The only apparent exception to this is the screen moving commands, +M-\ and M-+. When given an argument, they scroll the screen up or +down by that many lines, rather than screenfuls. This proves to be +much more useful. + +>> Try typing M-8 M-\ now. + +Did it scroll the screen up by 8 lines? If you would like to +scroll it down you can give an argument to M-+. + + +INSERTING AND DELETING +---------------------- + +If you want to type text, just do it. Characters which you can see, +such as A, 7, *, etc. are taken by DMACS as text and inserted +immediately. You can delete the last character you typed by doing +. More generally, will delete the character immediately +before the current cursor position. + +>> Do this now, type a few characters and then delete them + by typing a few times. + +Remember that most DMACS commands can be given a repeat count; Note +that this includes characters which insert themselves. + +>> Try that now -- type M-8 * and see what happens. + +You've now learned the most basic way of typing something in +DMACS and correcting errors. You can delete by words or lines +as well. Here is a summary of the delete operations: + + delete the character just before the cursor + M-D delete the next character after the cursor + C-M-D kill the next word after the cursor + M-K kill from the cursor position to end of line + M- kill the word immediately before the cursor + +Now suppose you kill something, and then you decide that you want to +get it back? Well, whenever you kill something bigger than a +character, DMACS saves it for you. To uNkill it back, use M-N. Note +that you don't have to be in the same place to do M-N; This is a +good way to move text around. Also note that the difference between +"Killing" and "Deleting" something is that "Killed" things can be +uNkilled back, and "Deleted" things cannot. + +For instance, type M-lf a couple times to postion the cursor +at some line on this screen. + + >> Do this now, move the cursor and kill that line with M-K. + +Note that a single M-K will kill the contents of the line, and a +second M-K will delete the line itself, and make all the other lines +move up. If you give M-K a repeat count, it will delete that many +lines AND their contents. + +The text that has just disappeared is saved so that you can +retrieve it. To retrieve the last killed text and put it where +the cursor currently is type M-N. + + >> Try it; type M-N to uNkill the text back. + +Think of M-N as if you were uNkilling something back that someone +took away from you. Notice that if you do several M-K's all at once +the text that is killed is all saved for you so that if you want +it back you can uNkill it back. + + >> Do this now, type M-K several times. + +Now to retrieve that killed text: + + >> Move the cursor down a few lines and type M-N to retrieve the + lines that you killed. This is how you move text from place + to place. You can even make copies of a line by killing it + and uNkilling it back as many times as you want. Remember + that when you have just killed text, it stays with you so + that if you move your cursor elsewhere in the text and + then M-N to uNkill back the killed text, you will have + a method for moving text around in a file. + + +MODE LINE +--------- + +If DMACS sees that you are typing commands slowly it shows them to +you at the bottom of the screen in an area called the echo lines. +This is just the last few lines at the bottom. The line immediately +above these is called the MODE LINE. You may notice that it begins +with DMACS (Text) ...more stuff... This is a very useful +'information' line. To understand DMACS it is best to consider that +it operates in a variety of modes. The default mode is Text which is +what you are in now. There are modes for editing different languages +and text, such as LISP mode, SAIL mode, etc. The mode line serves to +show you various things about your current state. For instance, on +the mode line here you'll notice that it says Main. DMACS operates +with things called buffers. This is a place that it puts your file +while you are editing it. There are names for buffers. The default +buffer upon startup of DMACS is Main. You'll notice that after the +Main and before the --nn%-- comes the filename DSK: +TEACH-DMACS.TUTORIAL. This is the name of your own temporary copy of +the text of the DMACS tutorial; the file you are now visiting. + + +SEARCHING +--------- + +DMACS can do searches for strings (these are groups of +contiguous characters or words) either forward through the +file or backward through it. To search for the string +means that you are trying to locate it somewhere in the +file and have DMACS show you where the occurences of the +string exist. This type of search is somewhat different +from what you may be familiar with. It is a search that +is performed as you type in the thing to search for. The +command to inititate a search is C-M-S for forward search, +and C-M-R for reverse search. BUT WAIT! Don't do them now. +When you type C-M-S you'll notice that the mode line changes +to 'I-Search' and below it you get 'Search:' This tells +you that DMACS is in what is called an incremental search +waiting for you to type the thing that you want to search +for. + +>> Now type C-M-S to start a search. SLOWLY, one letter at a time, + type the word 'cursor', pausing after you type each + character to notice what happens to the cursor. + +Did you see what happened? DMACS, in an incremental search, tries +to go to the occurence of the string that you've typed out so far. +To go to the next occurence of 'cursor' just type M-S. If no +such occurence exists DMACS beeps and tells you that it is a failing +search. To get out of a search tell DMACS that you want to stop +searching with . More generally, DMACS can be told to stop +whatever it is doing with C-G so you could also type C-G. + +If you are in the middle of an incremental search and type , +you'll notice that the last character in the search string is erased +and the search backs up to the previous occurence of that string. For +instance, suppose you currently have typed 'cu' and you see that your +cursor is at the first occurence of 'cu'. If you now type , +the 'u' on the search line is erased and you'll be repositioned in the +text to the occurence of 'c' immediately before the first 'cu'. This +provides a useful means for backing up while you are searching. Also, +if you are in the middle of a search and happen to type a control +character, the cursor will go back to the place where you originally +started the search. + +The C-M-S starts a search that looks for any occurence of the search +string AFTER the current cursor position. But what if you want to +search for something earlier in the text? To do this one should +type C-M-R for Reverse search. Everything that applies to C-M-S applies +to C-M-R except that the direction of the search is reversed. + + +EXTENDING THE COMMAND SET +------------------------- + +There are many, many more DMACS commands than could possibly be put +on all the control and meta characters. DMACS gets around this with +the X (eXtend) command. This comes in two flavors: + + C-X Character eXtend + M-X Character eXtend + +C-X or M-X is always followed by another character that tells what to +do. The second character may or may not require the CONTROL key, +depending on the command. But the META key never has any effect. + +There are many C-X commands. The ones you need immediately are: + + C-X C-V Visit file. This is how you read in a file + to edit it. When you type this, DMACS asks + you for a file name to visit. You would respond + with the name of the file. Then DMACS brings it + in for editing. If the file doesn't exist, then + DMACS assumes that you are creating a new file. + C-X C-S Save file. This is a command that tells DMACS + to save the file you are currently looking at + onto disk. It is recommended you give this + ocassionally to prevent losing any work in the + case of a system crash. + +There is another way to extend the DMACS command set: + + C-M-X Named command eXtend + +Named eXtend commands are commands which are used even less +frequently, or commands which are used only in certain modes. An +example of this type of command is the Replace command. When you +type C-M-X, DMACS will prompt you at the bottom of the screen with MM +(DMACS calls named eXtend commands MM commands) and then you can +type the name of the command you want to execute, in this case, +"Replace String". Just type "REP" and DMACS will complete the +command. Then you type the string that you want to replace, an +, the string you want to replace it with, and a return. + + >> Try this now; type C-M-X reptryyou can do + See how the previous line changed? All the "try"s were + changed to "you can do" + +GETTING MORE HELP +----------------- + +In this tutorial we have tried to supply just enough information to +get you started using DMACS. There is so much available in DMACS that +it would be impossible to explain it all here. However, you may want +to learn more about DMACS since it has numerous desirable features +that you don't know about yet. DMACS has a great deal of internal +documentation. All of these commands can be accessed through the HELP +character, which is the key on Datamedia terminals. To use +the HELP features, type the character, and then a character +saying what kind of help you want. If you are REALLY lost, type + ? and DMACS will tell you what kinds of help it can give. +The options which are most useful are the following: + + C Character describe. You type in the character. + Multi-character commands such as C-X C-Z + and V are also allowed. + D Describe a named command. You type in a command. + A Apropos. Type in a keyword and DMACS will + list all the commands containing that keyword. + More than one keyword can be specified, + seperated by C-O + I Run the INFO program. INFO contains the + complete documentation for DMACS, in + great detail. Here is where you can find out + about, for instance, special commands for editing + LISP code, handling buffers, replacing text, filling + and justifying text, etc. + + >> Go ahead and try some of these. Type C M-K. DMACS will tell + you what that character does. Try typing A WORD to find + out all the commands that have to do with words. When DMACS + prompts you with --MORE--, type a space to see more or a C-N + to get your text back. INFO is a fairly sophisticated + documentation finder and is somewhat complicated. It probably + isn't a good idea to try to use INFO just yet. Use DMACS for + a few days, gain some familiarity and confidence in giving + commands. And then try INFO out. + +Another really valuable help is the file DMACS.CHART. It +lists all the commands available in DMACS. List the file on the line +printer using the exec command LLIST instead of LIST, because it's +formatted for wide paper. Don't try to learn everything on the chart +at once, but when you learn a new command, DO see where it's +mentioned in the chart to help fix the command in your mind. + +CONCLUSION +---------- + +You'll probably find that if you use DMACS for a few days you won't +be able to give it up. Initially it may give you trouble. But remember +that this is the case with any editor, especially one that can do many, +many things. And DMACS can do practically everything. diff --git a/src/e142/einit. b/src/e142/einit. new file mode 100644 index 00000000..5f89722b --- /dev/null +++ b/src/e142/einit. @@ -0,0 +1,519 @@ +!* -*-TECO-*-! + +!~Filename~:! !Macros for installing a new EMACS.! +EINIT + +!? Generate EMACS:! !? Create EMACS :EJ file from sources. +Compresses the source files that need compression, +then concatenates the COMPRS files and purifies, writing +the result out as EMACS;[PURE] >.! + + 1,m.m &_File_PURIFY_Loaded+1"G !* Load PURIFY if not loaded already.! + m(m.m Load_Library)EMACS;PURIFY' + fs osteco"e + m(m.mGenerate_Library) EMACS;DSK:[PURE]_> EMACS1;DOC  USRCOM  !* +! ^R BASE  WRDLST  INDENT  SEARCH  FILES  !* +! SUPPRT  ISEARC  WINDOW  BUFFER  CRL  VARS  + m(m.mGenerate_Library) EMACS;DSK:[PRFY]_> EMACS1;PURIFY  CCL + m(m.m Generate_Library) EMACS;DSK:EINIT EMACS1;EINIT ' + "# + m(m.mGenerate_Library) EMACS;DSK:[PURE]_> DOC  USRCOM  !* +! ^R BASE  WRDLST  INDENT  SEARCH  FILES  !* +! SUPPRT  ISEARC  WINDOW  BUFFER  CRL  VARS  + m(m.mGenerate_Library) EMACS;PURIFY PURIFY  CCL + m(m.m Generate_Library) EMACS;DSK:EINIT EINIT ' +  + +!? Document EMACS:! !? Create EMACS DOC and EMACS CHART.! + m(m.m Load_Lib)EMACS;ABSTR + f[b bind f[d file + m(m.mWall_Chart).X + fs osteco"e + ji;NOXGP + ;SKIP_1 + ' + et EMACS;EMACS_CHART eihpef + hk + fs osteco"e + ji;NOXGP + ;SKIP_1 + ' + m(m.mAbstract_Redefinitions) + m(m.mAbstract_File)_CEMACS + m(m.mAbstract_File)_CTAGS + m(m.mAbstract_File)_CTMACS + m(m.mAbstract_File)_CSLOWLY + m(m.mAbstract_File)_CWORDAB + m(m.mAbstract_File)_CPICTUR + m(m.mAbstract_File)_CABSTR + m(m.mAbstract_File)_CPURIFY + + et EMACS;EMACS_NDOC eihpef + 1:< ed EMACS_ODOC> + 1:< en EMACS_DOC EMACS_ODOC> + en EMACS_NDOC EMACS_DOC +  + +!& Load Default Environment:! !S Create the default environment. +Assuming that the pure files are already loaded +and the "essential" environment is set up, set up the standard +EMACS ^R command definitions, etc.! + + [0 [1 [2 + + @:I*| FSECHO LINES-3"G + 3FSECHO LINES' + | FS TTY MACRO !* Must not be a pure string or use M.M.! + + M.M &_Toplevel_^R U..L !* Put a macro to handle G in ..L! + M.M &_Secretary_Macro U..F !* ..F is nonzero when we aren't in an "inner ^R mode",! + !* but it isn't used unless FS ^R MDLY$ is positive.! + Q..FU.F !* Switching buffers, files or windows OK iff Q.F = Q..F.! + M.M &_Real-time_Interrupt FS CLK MACRO + + M.M &_Recursive_^R_Set_Mode FS ^R ENTER + + M.M ^R_Backwards_Kill_Characters FS RUB MACRO + -1UDisplay_Matching_Paren + + :IR :,.F !* MR returns the region as two numbers.! + + 201.@FS ^R InitU1 255U0 + 400.+A @FS ^R InitU2 + 256< %0W !* Make all unassigned Meta characters into errors.! + Q0#Q2"E Q1U0' + > + Q1U.T + Q2U..I Q2U...L !* A few meta chars should self-insert.! + Q2U..._ + + M.M ^R_Complement_SAIL_Mode U.B !* Control-Alpha ! + + FS ^R INIT UH + M.M ^R_Indent_According_to_Mode UI + M.M ^R_Indent_New_Line UJ + M.M ^R_Indent_New_Comment_Line U..J Q..J U..J + M.M ^R_CRLF UM + + M.M ^R_Set/Pop_Mark U._ Q._ U.@ + M.M ^R_Replace_String U.% + M.M ^R_Query_Replace U..% + M.M ^R_Find_Tag U... + M.M ^R_Indent_For_Comment U.; Q.; U..; + M.M ^R_Kill_Comment U...; + M.M ^R_Mark_Beginning U.< + M.M ^R_Goto_Beginning U..< + M.M ^R_Where_Am_I U.= + M.M ^R_Count_Lines_Region U..= + M.M ^R_Mark_End U.> + M.M ^R_Goto_End U..> + + M.M ^R_Describe U..? Q..?U../ + M.M ^R_Documentation F(U...? )FS HELPMAC + M.M ^R_Kill_Line U.K + M.M ^R_New_Window U.L + M.M ^R_Down_Real_Line U.N + M.M ^R_Down_Comment_Line U..N + M.M ^R_Up_Real_Line U.P + M.M ^R_Up_Comment_Line U..P + M.M ^R_Quoted_Insert U.Q + M.M ^R_Reverse_Search  U.R + M.M ^R_Move_To_Screen_Edge U..R + M.M ^R_Reposition_Window U...R + M.M ^R_Incremental_Search U.S + M.M ^R_Transpose_Characters U.T + M.M ^R_Universal_Argument U.U + M.M ^R_Next_Screen U.V + M.M ^R_Previous_Screen U..V + M.M ^R_Scroll_Other_Window U...V + M.M ^R_Kill_Region U.W + M.M ^R_Copy_Region U..W + M.M ^R_Append_Next_Kill U...W + M.M ^R_Extended_Command U..X + M.M ^R_Instant_Extended_Command U...X + M.M ^R_Un-Kill U.Y + M.M ^R_Un-Kill_Pop U..Y + M.M ^R_Return_To_Superior U.Z + M.M ^R_Prefix_Meta U + 33. FS ^R INIT U. Q. U...C + M.M ^R_Execute_Mini U.. + 433.^ FS ^R INIT U... + M.M ^R_Prefix_Meta U.\ + M.M ^R_Prefix_Control U.^ + M.M ^R_Prefix_Control-Meta U.C + M.M Abort_Recursive_Edit U.] + M.M ^R_Buffer_Not_Modified U..~ + +!* NOT EXACTLY WORD, NOT EXACTLY LIST COMMANDS! + + M.M ^R_Back_to_Indentation U..M Q..M U...M + Q..M F( U..M ) U...M + M.M ^R_Delete_Horizontal_Space U..\ + M.M ^R_Indent_Region U...\ + M.M ^R_Split_Line U...O + +!* LOAD THE WORD COMMANDS! + + M.M ^R_Change_Font_Word U..# + M.M ^R_Upcase_Digit U..' + M.M ^R_Mark_Word U..@ + M.M ^R_Backward_Sentence U..A + M.M ^R_Backward_Word U..B + M.M ^R_Uppercase_Initial U..C + M.M ^R_Kill_Word U..D + M.M ^R_Forward_Sentence U..E + M.M ^R_Forward_Word U..F + M.M ^R_Fill_Region U..G + M.M ^R_Mark_Paragraph U..H + M.M ^R_Tab_to_Tab_Stop U..I + M.M ^R_Kill_Sentence U..K + M.M ^R_Lowercase_Word U..L + M.M ^R_Fill_Paragraph U..Q + M.M ^R_Center_Line U..S + M.M ^R_Transpose_Words U..T + M.M ^R_Uppercase_Word U..U + M.M ^R_Backward_Paragraph U..[ + M.M ^R_Forward_Paragraph U..] + M.M ^R_Delete_Indentation U..^ + M.M ^R_Underline_Word U.._ + M.M ^R_Backward_Kill_Word U.. + +!* LOAD THE LIST COMMANDS! + + M.M ^R_Make_() U..( + M.M ^R_Move_Over_) U..) + M.M ^R_Backward_Up_List U...( Q...( U...U + M.M ^R_Forward_Up_List U...) + M.M ^R_Mark_Sexp U...@ + M.M ^R_Backward_Sexp U...B + M.M ^R_Down_List U...D + M.M ^R_Forward_Sexp U...F + M.M ^R_Format_Code U...G + M.M ^R_Mark_Defun U...H Q...H U...H + M.M ^R_Indent_for_Lisp U...I Q...I U...I + M.M ^R_Kill_Sexp U...K + M.M ^R_Forward_List U...N + M.M ^R_Backward_List U...P + M.M ^R_Indent_Sexp U...Q + M.M ^R_Transpose_Sexps U...T + M.M ^R_Beginning_of_Defun U...[ Q...[ U...A + M.M ^R_End_of_Defun U...] Q...] U...E + M.M ^R_Delete_Indentation U...^ + M.M ^R_Backward_Kill_Sexp U... + + 128M(M.M MAKE_PREFIX).X U.X + :IPrefix_Char_List X.X__ + + M.M List_Buffers U:.X() + M.M ^R_Return_to_Superior U:.X() + M.M ^R_Directory_Display U:.X() + M.M ^R_Command_^X_^E_Flushed U:.X() + M.M Find_File U:.X() + M.M ^R_Indent_Rigidly U:.X(9) !* ^X Tab.! + M.M ^R_Lowercase_Region U:.X( ) + M.M ^R_Set_Goal_Column U:.X() + M.M ^R_Delete_Blank_Lines U:.X() + M.M ^R_Mark_Page U:.X() + M.M ^R_Do_Not_Write_File U:.X() + M.M ^R_Read_File U:.X() + M.M ^R_Save_File U:.X() + M.M ^R_Transpose_Lines U:.X() + M.M ^R_Uppercase_Region U:.X() + M.M ^R_Visit_File U:.X() + M.M Write_File U:.X() + M.M ^R_Exchange_Point_And_Mark U:.X() + M.M ^R_Re-execute_Mini U:.X() + M.M ^R_Change_Font_Region U:.X(#) + M.M ^R_Start_Kbd_Macro U:.X(() + M.M ^R_Set_Fill_Prefix U:.X(.) + M.M ^R_One_Window U:.X(1) + M.M ^R_Two_Windows U:.X(2) + M.M ^R_View_Two_Windows U:.X(3) + M.M ^R_Modified_Two_Windows U:.X(4) + M.M ^R_Set_Comment_Column U:.X(;) + M.M ^R_Where_Am_I U:.X(=) + M.M ^R_Append_to_Buffer U:.X(A) + M.M Select_Buffer U:.X(B) + M.M ^R_DIRED U:.X(D) + M.M ^R_Set_Fill_Column U:.X(F) + M.M ^R_Get_Q-reg U:.X(G) + M.M ^R_Mark_Whole_Buffer U:.X(H) + M.M ^R_Info U:.X(I) + M.M Kill_Buffer U:.X(K) + M.M ^R_Count_Lines_Page U:.X(L) + M.M MAIL U:.X(M) + M.M ^R_Set_Bounds_Region U:.X(N) + M.M ^R_Other_Window U:.X(O) + M.M ^R_Set_Bounds_Page U:.X(P) + M.M Read_Mail U:.X(R) + M.M ^R_Set_Bounds_Full U:.X(W) + M.M ^R_Put_Q-reg U:.X(X) + M.M ^R_Previous_Page U:.X([) + M.M ^R_Next_Page U:.X(]) + M.M ^R_Grow_Window U:.X(^) + M.M ^R_Underline_Region U:.X(_) + M.M ^R_Backward_Kill_Sentence U:.X(127) + +!* Make TWENEX changes! +fs osteco"n +@ft0 + M.M ^R_Prefix_Control-Meta U.Z + 33. FS ^R INIT U...Z + M.M ^R_Return_To_Superior U:.X() + 37. FS HELP CHARW +0"n + M.M ^R_Exit_to_Exec U.C !* Make self-documentation! + 632. @FS ^R INIT U...C + 0U:.X() !* not confuse users! +' + ' +@ft1 + 1FS TTMODEW + 1FS ^R SCANW + 1FS ^R ECHOW + 1FS RUB CRLFW !* ^D AND RUBOUT TREAT CRLF AS ONE CHARACTER.! + 0FS%TOPW !* WINDOWS ARE OK AS LONG AS CURSOR IS ON SCREEN! + 0FS%BOTTOMW + 35FS%ENDW !* WANT 35% BLANK SPACE WHEN DISPLAY NEAR END OF FILE! + 500FS ^R MDLYW + M.M ^R_Auto-fill_Space FS ^R ECSD +@ft2 + :I..J EMACS_ !* Set up ..J so that & Set Mode Line will correct it.! + :I*EMACS M.V Editor_Name !* Name of this editor. For ..J hackery! + +!*** Speed up calls to certain subroutines by putting them in ..Q! + M.M &_Find_Buffer M.V MM_&_Find_Buffer + M.M &_Find_File M.V MM_&_Find_File + M.M &_Get_Library_Pointer M.V MM_&_Get_Library_Pointer + M.M &_Kill_Text M.V MM_&_Kill_Text + M.M &_Matching_Paren M.V MM_&_Matching_Paren + M.M &_Process_File_Options M.V MM_&_Process_File_Options + M.M &_Read_Line M.V MM_&_Read_Line + M.M &_Set_Mode_Line M.V MM_&_Set_Mode_Line + M.M Load_Library M.V MM_Load_Library +@ft3 +!*** Now redo putting various functions in obscure places.! +!*** This duplicates what & Load Essential Environment does.! +!*** The reason is that these functions may be in the patch file,! +!*** in which case the patched versions must be installed.! + + M.M &_Autoload U.A + M.M &_Set_Variable_Comment U.C + M.M &_Prepare_For_Input U.I + M.M Make_Local_Variable U.L + M.M &_Macro_Execute UM + M.M &_Macro_GetU.M + M.M &_Prefix_Character_DriverU.P + M.M &_Make_Variable U.V + + M.M &_Set_Mode_Line FS MODE MAC + FS OSTECO"E !* Only on ITS! + M.M &_Default_FS_Superior FS SUPERIOR' + + M.M &_F^K_Hook U*F _Hook* + M.M &_Subset_Directory_Listing UDirectory_Lister +@ft4 +!*** NOW SET UP EMACS'S ERROR HANDLER. SAVE IT FOR LAST, SINCE IF THERE IS AN ERROR! +!*** AFTER SETTING IT UP, AND NOT ALL THE REST OF EMACS IS THERE, IT IS A SCREW.! + M.M &_Error_Handler U..P +  + +!& Load Essential Environment:! !S Does what's needed for EMACS macros to work at all. +A given environment (such as EMACS, TME, etc.) may set up +other variables, and redefine ^R characters. That is all optional. +But code may fail to work if these variables are missing.! + + 5FS Q VECTOR U..Q + 3U:..Q(0) !* We use 3 words per variable.! + + 1FS S ERROR !* Searches inside iterations can still fail.! + -1FS^I DISABLE !* Tab is a no-op.! + 1FS _ DISABLE !* Don't allow backarrow.! + -1FSFNAM SYNTAX !* FN2s default to ">'! + 1FSBOTHCASE !* Searches ignore case of letters.! + -1FS ECHO FLUSH + 1FS ^L INSERT !* @Y should not discard ^L's.! + 1FS VAR MAC + + 0U.H !* No goal for ^P, ^N known.! + :i.w !* Not in Atom Word Mode.! + + 10*5 FS Q VECTOR U..K !* Set up ..K, the kill vector.! + Q..K[..O J 5D ]..O + -1U0 9< 0U:..K(%0) > + + 5*5 FS Q VECTOR U..U !* Set up ..U, the Undo info vector. See Undo for doc.! + 0U:..U(0) 10000000U:..U(2) !* Set it up so Undo will complain.! + + 6*8 FS Q VECTOR U.N !* Set up .N as qvector 8 words long, with 1 word gap.! + [..O Q.NU..O J 5D ]..O + :I*[1 -1[2 + FQ.N/5< Q1 U:.N(%2)> !* Fill all words with null strings.! + +!* If not in Lisp mode, don't do Lisp syntax hair, but do treat [,] and {,} as parens.! + !"! 1M(M.M &_Alter_..D) [( ]) {( }) |A /A 'A +!* Set up matching openparens for closeparens! + !"! 2M(M.M &_Alter_..D) ][ )( >< }{    '" !'! + + M.M &_Macro_Execute UM + M.M &_Prepare_For_Input U.I + M.M &_Prefix_Character_DriverU.P + + M.M &_Autoload U.A + M.M &_Make_Variable U.V + M.M &_Set_Variable_Comment U.C + + M.M &_Set_Mode_Line FS MODE MAC !* Say what to do about updating ..J! + 1FS MODE CHANGE !* and ask that it be done eventually.! + + M.M &_F^K_Hook M.V *F _Hook* + +!*** These MM variables are essential! + M.M &_Check_Top_Level M.V MM_&_Check_Top_Level + M.M &_Maybe_Push_Point M.V MM_&_Maybe_Push_Point + M.M &_Maybe_Display_Directory M.V MM_&_Maybe_Display_Directory + + 0M.V Abort_Resumption_Message + 0M.C Atom_Word_Mode ! *_1_=>_word_commands_deal_with_LISP_atoms! + :I.W "n :I.W@' 1FS MODE CH + 0M.C Auto_Directory_Display *_1_=>_display_dir_after_writes,_-1_=>_reads_too + 0M.C Auto_Fill_Mode ! *_1_=>_Auto_Fill_(break_long_lines_at_margin)! + 1FS MODE CH + 32FS ^R INIT U_ "E' + M.M^R_Auto-Fill_SpaceU_ + 500M.C Auto_Push_Point_Option *_Searches_moving_this_far_set_mark_at_old_point + :I*_^@ M.C Auto_Push_Point_Notification *_Searches_setting_mark_type_this + 500M.C Auto_Save_Interval ! *_number_of_characters_between_auto-saves! + fs^r mdlyw fs^r mcnt  + 0M.C Auto_Save_Visited_File *_1 =>_auto_save_under_visited_filename + 0M.C Autoarg_Mode ! *_1_=>_digits_before_control_chars_set_arg! + 0 FS ^R INIT[2 + "N M.M ^R_AutoargU2' + Q2-Q0"E ' + Q2U0 Q2U1 Q2U2 Q2U3 Q2U4 + Q2U5 Q2U6 Q2U7 Q2U8 Q2U9  + 1M.C Case_Replace *_1_=>_Replace_commands_preserve_case + 0M.C Comment_Begin *_String_for_beginning_new_comments + 32M.C Comment_Column *_Column_to_start_comments_in + 0M.C Comment_Start *_String_that_indicates_the_start_of_a_comment + :I* M.C Comment_End *_String_that_ends_comments + :I*/8+1*8 M.C Comment_Rounding *_Hairy_-_see_code_for_^R_Indent_for_Comment + 0M.C Display_Matching_Paren ! *_Controls_action_of_)_in_showing_the_matching_(! + "N M.M &_Matching_Paren' "#0' FS ^R PAREN  + 70M.C Fill_Column ! *_Page_width_for_filling_and_grinding! +  FS ADLINE  + :I*.?! M.C Fill_Extra_Space_List *_punctuations_that_need_2_spaces + :I* M.C Fill_Prefix *_String_to_put_before_each_line_when_filling + 0M.C Find_File_Inhibit_Write *_initializes_Inhibit_Write_for_Find_File + 0M.C FS_CTLMTA !! FS CTLMTA  + 0M.C Inhibit_Write ! *_-1_=>_Never_save_automatically_on_switching_files! + 1FS MODE CH  + 0M.C LISP_Indent_Offset *_See_^R_Indent_for_LISP + 0M.C Overwrite_Mode ! *_Overwrite_Mode_status_(see_MM_Overwrite_Mode)! + 1FS MODE CH + FS ^R REPLACE  + :I*  M.C Page_Delimiter *_Search_string_for_finding_page_boundaries + :I*. _ M.C Paragraph_Delimiter *_Lines_starting_with_these_chars_start_paragraphs + -1M.C Permit_Unmatched_Paren *_1_=>_allow_unmatched_),_-1_=>_only_in_Lispish_modes + 0M.C Read_Line_Delay Pausing_this_many_1/30_sec_causes_echoing + 5000 M.C Region_Query_Size *_Some_commands_need_confirmation_if_region_this_big + :I* M.V Set_Mode_Line_Hook + 0M.C Space_Indent_Flag *_If_nonzero,_Auto_Fill_indents_new_lines + :I*MEMO  XGP  @XGP  UNFASL  OUTPUT  OLREC _ !* +! M.C Temp_File_FN2_List *_Reap_File_deletes_these_FN2s + :I*Fundamental M.C Mode Do_MM_FOO_to_enter_FOO_mode + :I* M.C Submode !! 1FS MODE CH  + M.M &_Subset_Directory_Listing M.C Directory_Lister Macro_to_use_to_list_directories + 15FS Q VECTOR[1 Q1 M.V Search_Default_Ring + :I:1(0) :I:1(1) :I:1(2) ]1 + :I..G Q..H"E MDirectory_Lister' + + 0 M.V Backtrace_Temp + :I* M.V Editor_Name + :I* M.V Editor_Type + :I* M.V Prefix_Char_List + + M.M &_Indent_with_Tabs M.V MM_&_Indent + M.M &_Xindent_with_Tabs M.V MM_&_Xindent + :I*________:_______:_______:_______:_______:_______:_______:_______:_______:_______:_______:_______: M.C Tab_Stop_Definitions *_Tab_stops_for_^R_Tab_to_Tab_Stop + +!* Set up buffer table and related variables.! + + 0M.V Next_Bfr_Number + 9*5 FS Q VECTOR U.B + 9U:.B(0) !* Initialize the entry for the initial buffer.! + :I*Main U:.B(1) !* Its name is B.! + 0U:.B(2) !* It contains no file.! + :I*Fundamental U:.B(3) !* It starts in fundamental mode! + Q..Z U:.B(4) !* It is the same one that TECO gave us to start with.! + 0U:.B(5) !* Don't need to init FS DFILE and FS WINDOW slots! + 0U:.B(6) !* Since they are used only when buffer not selected.! + %Next_Bfr_NumberU:.B(7) + 0U:.B(8) + + 0M.V Buffer_Filenames + Q:.B(1) M.V Buffer_Name + 0 M.V Buffer_Index + Q:.B(1) M.V Previous_Buffer + + FS OSTECO"E !* Only on ITS! + M.M &_Default_FS_Superior FS SUPERIOR' + M.M Make_Local_Variable U.L + 0M.V Auto_Save_Mode + M.L Auto_Save_Mode + 0M.C Auto_Save_Default ! *_Default_value_of_Auto_Save_Mode_for_new_files! + 1FS MODE CH  + :I* M.C Auto_Save_Filenames *_Filename_for_Auto_Save_Files + 2M.C Auto_Save_Max *_#_of_saves_to_keep + M.L Auto_Save_Delete + M.L Auto_Save_Size + M.L Auto_Save_Count + M.L Inhibit_Write + 5M.V Initial_Local_Count !* This is the number of M.L's above! +  + +!Purify Variables:! !C Make var names in symtab pure. +For each symbol, sees whether there is a pure string for +its name, and if so makes the sym tab point at that pure string.! + + [1 [2 [3 + m.m &&_Variable_Name_Listu2 !* Q2 has pure string before the first var name.! + < q2+fq2+4u2 -fq2; !* Look at each available pure string.! + :fo..q2u1 !* Look for a variable with that name.! + q1"g f~:..q(q1)2"e !* If it exists and is an exact match,! + q2u:..q(q1) !* stick the pure string in as the variable name.! + q2+fq2+4u3 !* See if the next pure string matches that var's comment.! + q:..q(q1+2)"n + f~:..q(q1+2)3"e !* If so, purify the comment too.! + q3u:..q(q1+2)''' + !* Now, purify anything in .B which matches this string.! + 0u3 + fq.b/5< fq:.b(q3)"g f~:.b(q3)2"e + q2u:.b(q3)'' + %3 > + '> +  + +!& Load Patches:! !S Load patches (made since [pure] file) before dumping. +Essentially, we do a Compile One Macro on each page of +the patch file EMACS;PATnnn >! + + f[b bind qEMACS_Version:\[1 + f[d file et emacs;pat1_> + 1:< er @y>"l ' !* Read in the patch file. Exit if there is none.! + z"e ' !* Exit fast if it's empty.! + @f + k !* Kill extra CRLF and ^L at front of file.! + f[:ej page + m(m.m Load_Library)PURIFY !* Otherwise, temporarily load PURIFY! + < m(m.m TCompile) !* and compile each macro in the patch file.! + :s + +; > + hk  + +!* +** Local Modes: +** Compile Command: M(M.M Generate Library)EMACS;EINITEMACS1;EINIT +** End: +*! diff --git a/src/e142/einit._ej b/src/e142/einit._ej new file mode 100644 index 00000000..c1108618 --- /dev/null +++ b/src/e142/einit._ej @@ -0,0 +1,442 @@ +xW +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + )#2| /f/ozT^.e.o5,531z2 2j2}4V4b1X1e0m0z3x40O0Y0D0K5u5{? Generate EMACS81,m.m& File PURIFY Loaded+1"G +m(m.mLoad Library)EMACS;PURIFY' +fsosteco"e +m(m.mGenerate Library)EMACS;DSK:[PURE] >EMACS1;DOCUSRCOM^RBASEWRDLSTINDENTSEARCHFILESSUPPRTISEARCWINDOWBUFFERCRLVARS +m(m.mGenerate Library)EMACS;DSK:[PRFY] >EMACS1;PURIFYCCL +m(m.mGenerate Library)EMACS;DSK:EINITEMACS1;EINIT' +"# +m(m.mGenerate Library)EMACS;DSK:[PURE] >DOCUSRCOM^RBASEWRDLSTINDENTSEARCHFILESSUPPRTISEARCWINDOWBUFFERCRLVARS +m(m.mGenerate Library)EMACS;PURIFYPURIFYCCL +m(m.mGenerate Library)EMACS;DSK:EINITEINIT' +? Document EMACS>m(m.mLoad Lib)EMACS;ABSTR +f[bbindf[dfile +m(m.mWall Chart).X +fsosteco"e +ji;NOXGP +;SKIP 1 + ' +etEMACS;EMACS CHARTeihpef +hk +fsosteco"e +ji;NOXGP +;SKIP 1 + ' +m(m.mAbstract Redefinitions) +m(m.mAbstract File) CEMACS +m(m.mAbstract File) CTAGS +m(m.mAbstract File) CTMACS +m(m.mAbstract File) CSLOWLY +m(m.mAbstract File) CWORDAB +m(m.mAbstract File) CPICTUR +m(m.mAbstract File) CABSTR +m(m.mAbstract File) CPURIFY +etEMACS;EMACS NDOCeihpef +1: +1: +enEMACS NDOCEMACS DOC +& Load Default Environment/[0[1[2 +@:I*|FSECHOLINES-3"G +3FSECHOLINES' +|FSTTYMACRO +M.M& Toplevel ^RU..L +M.M& Secretary MacroU..F +Q..FU.F +M.M& Real-time InterruptFSCLKMACRO +M.M& Recursive ^R Set ModeFS^RENTER +M.M^R Backwards Kill CharactersFSRUBMACRO +-1UDisplay Matching Paren +:IR:,.F +201.@FS^RInitU1255U0 +400.+A@FS^RInitU2 +256<%0W +Q0#Q2"EQ1U0' +> +Q1U.T +Q2U..IQ2U...L +Q2U..._ +M.M^R Complement SAIL ModeU.B +FS^RINITUH +M.M^R Indent According to ModeUI +M.M^R Indent New LineUJ +M.M^R Indent New Comment LineU..JQ..JU..J +M.M^R CRLFUM +M.M^R Set/Pop MarkU. Q. U.@ +M.M^R Replace StringU.% +M.M^R Query ReplaceU..% +M.M^R Find TagU... +M.M^R Indent For CommentU.;Q.;U..; +M.M^R Kill CommentU...; +M.M^R Mark BeginningU.< +M.M^R Goto BeginningU..< +M.M^R Where Am IU.= +M.M^R Count Lines RegionU..= +M.M^R Mark EndU.> +M.M^R Goto EndU..> +M.M^R DescribeU..?Q..?U../ +M.M^R DocumentationF(U...?)FSHELPMAC +M.M^R Kill LineU.K +M.M^R New WindowU.L +M.M^R Down Real LineU.N +M.M^R Down Comment LineU..N +M.M^R Up Real LineU.P +M.M^R Up Comment LineU..P +M.M^R Quoted InsertU.Q +M.M^R Reverse SearchU.R +M.M^R Move To Screen EdgeU..R +M.M^R Reposition WindowU...R +M.M^R Incremental SearchU.S +M.M^R Transpose CharactersU.T +M.M^R Universal ArgumentU.U +M.M^R Next ScreenU.V +M.M^R Previous ScreenU..V +M.M^R Scroll Other WindowU...V +M.M^R Kill RegionU.W +M.M^R Copy RegionU..W +M.M^R Append Next KillU...W +M.M^R Extended CommandU..X +M.M^R Instant Extended CommandU...X +M.M^R Un-KillU.Y +M.M^R Un-Kill PopU..Y +M.M^R Return To SuperiorU.Z +M.M^R Prefix MetaU +33.FS^RINITU.Q.U...C +M.M^R Execute MiniU.. +433.^FS^RINITU... +M.M^R Prefix MetaU.\ +M.M^R Prefix ControlU.^ +M.M^R Prefix Control-MetaU.C +M.MAbort Recursive EditU.] +M.M^R Buffer Not ModifiedU..~ +M.M^R Back to IndentationU..MQ..MU...M +Q..MF(U..M)U...M +M.M^R Delete Horizontal SpaceU..\ +M.M^R Indent RegionU...\ +M.M^R Split LineU...O +M.M^R Change Font WordU..# +M.M^R Upcase DigitU..' +M.M^R Mark WordU..@ +M.M^R Backward SentenceU..A +M.M^R Backward WordU..B +M.M^R Uppercase InitialU..C +M.M^R Kill WordU..D +M.M^R Forward SentenceU..E +M.M^R Forward WordU..F +M.M^R Fill RegionU..G +M.M^R Mark ParagraphU..H +M.M^R Tab to Tab StopU..I +M.M^R Kill SentenceU..K +M.M^R Lowercase WordU..L +M.M^R Fill ParagraphU..Q +M.M^R Center LineU..S +M.M^R Transpose WordsU..T +M.M^R Uppercase WordU..U +M.M^R Backward ParagraphU..[ +M.M^R Forward ParagraphU..] +M.M^R Delete IndentationU..^ +M.M^R Underline WordU.._ +M.M^R Backward Kill WordU.. +M.M^R Make ()U..( +M.M^R Move Over )U..) +M.M^R Backward Up ListU...(Q...(U...U +M.M^R Forward Up ListU...) +M.M^R Mark SexpU...@ +M.M^R Backward SexpU...B +M.M^R Down ListU...D +M.M^R Forward SexpU...F +M.M^R Format CodeU...G +M.M^R Mark DefunU...HQ...HU...H +M.M^R Indent for LispU...IQ...IU...I +M.M^R Kill SexpU...K +M.M^R Forward ListU...N +M.M^R Backward ListU...P +M.M^R Indent SexpU...Q +M.M^R Transpose SexpsU...T +M.M^R Beginning of DefunU...[Q...[U...A +M.M^R End of DefunU...]Q...]U...E +M.M^R Delete IndentationU...^ +M.M^R Backward Kill SexpU... +128M(M.MMAKE PREFIX).XU.X +:IPrefix Char ListX.X  +M.MList BuffersU:.X() +M.M^R Return to SuperiorU:.X() +M.M^R Directory DisplayU:.X() +M.M^R Command ^X ^E FlushedU:.X() +M.MFind FileU:.X() +M.M^R Indent RigidlyU:.X(9) +M.M^R Lowercase RegionU:.X( ) +M.M^R Set Goal ColumnU:.X() +M.M^R Delete Blank LinesU:.X() +M.M^R Mark PageU:.X() +M.M^R Do Not Write FileU:.X() +M.M^R Read FileU:.X() +M.M^R Save FileU:.X() +M.M^R Transpose LinesU:.X() +M.M^R Uppercase RegionU:.X() +M.M^R Visit FileU:.X() +M.MWrite FileU:.X() +M.M^R Exchange Point And MarkU:.X() +M.M^R Re-execute MiniU:.X() +M.M^R Change Font RegionU:.X(#) +M.M^R Start Kbd MacroU:.X(() +M.M^R Set Fill PrefixU:.X(.) +M.M^R One WindowU:.X(1) +M.M^R Two WindowsU:.X(2) +M.M^R View Two WindowsU:.X(3) +M.M^R Modified Two WindowsU:.X(4) +M.M^R Set Comment ColumnU:.X(;) +M.M^R Where Am IU:.X(=) +M.M^R Append to BufferU:.X(A) +M.MSelect BufferU:.X(B) +M.M^R DIREDU:.X(D) +M.M^R Set Fill ColumnU:.X(F) +M.M^R Get Q-regU:.X(G) +M.M^R Mark Whole BufferU:.X(H) +M.M^R InfoU:.X(I) +M.MKill BufferU:.X(K) +M.M^R Count Lines PageU:.X(L) +M.MMAILU:.X(M) +M.M^R Set Bounds RegionU:.X(N) +M.M^R Other WindowU:.X(O) +M.M^R Set Bounds PageU:.X(P) +M.MRead MailU:.X(R) +M.M^R Set Bounds FullU:.X(W) +M.M^R Put Q-regU:.X(X) +M.M^R Previous PageU:.X([) +M.M^R Next PageU:.X(]) +M.M^R Grow WindowU:.X(^) +M.M^R Underline RegionU:.X(_) +M.M^R Backward Kill SentenceU:.X(127) +fsosteco"n +@ft0 +M.M^R Prefix Control-MetaU.Z +33.FS^RINITU...Z +M.M^R Return To SuperiorU:.X() +37.FSHELPCHARW +0"n +M.M^R Exit to ExecU.C +632.@FS^RINITU...C +0U:.X() +' +' +@ft1 +1FSTTMODEW +1FS^RSCANW +1FS^RECHOW +1FSRUBCRLFW +0FS%TOPW +0FS%BOTTOMW +35FS%ENDW +500FS^RMDLYW +M.M^R Auto-fill SpaceFS^RECSD +@ft2 +:I..JEMACS  +:I*EMACSM.VEditor Name +M.M& Find BufferM.VMM & Find Buffer +M.M& Find FileM.VMM & Find File +M.M& Get Library PointerM.VMM & Get Library Pointer +M.M& Kill TextM.VMM & Kill Text +M.M& Matching ParenM.VMM & Matching Paren +M.M& Process File OptionsM.VMM & Process File Options +M.M& Read LineM.VMM & Read Line +M.M& Set Mode LineM.VMM & Set Mode Line +M.MLoad LibraryM.VMM Load Library +@ft3 +M.M& AutoloadU.A +M.M& Set Variable CommentU.C +M.M& Prepare For InputU.I +M.MMake Local VariableU.L +M.M& Macro ExecuteUM +M.M& Macro GetU.M +M.M& Prefix Character DriverU.P +M.M& Make VariableU.V +M.M& Set Mode LineFSMODEMAC +FSOSTECO"E +M.M& Default FS SuperiorFSSUPERIOR' +M.M& F^K HookU*F Hook* +M.M& Subset Directory ListingUDirectory Lister +@ft4 +M.M& Error HandlerU..P + & Load Essential Environment2#5FSQVECTORU..Q +3U:..Q(0) +1FSSERROR +-1FS^IDISABLE +1FS_DISABLE +-1FSFNAMSYNTAX +1FSBOTHCASE +-1FSECHOFLUSH +1FS^LINSERT +1FSVARMAC +0U.H +:i.w +10*5FSQVECTORU..K +Q..K[..OJ5D]..O +-1U09<0U:..K(%0)> +5*5FSQVECTORU..U +0U:..U(0)10000000U:..U(2) +6*8FSQVECTORU.N +[..OQ.NU..OJ5D]..O +:I*[1-1[2 +FQ.N/5 +!"!1M(M.M& Alter ..D)[(]){(})|A/A'A +!"!2M(M.M& Alter ..D)][)(><}{'"!'! +M.M& Macro ExecuteUM +M.M& Prepare For InputU.I +M.M& Prefix Character DriverU.P +M.M& AutoloadU.A +M.M& Make VariableU.V +M.M& Set Variable CommentU.C +M.M& Set Mode LineFSMODEMAC +1FSMODECHANGE +M.M& F^K HookM.V*F Hook* +M.M& Check Top LevelM.VMM & Check Top Level +M.M& Maybe Push PointM.VMM & Maybe Push Point +M.M& Maybe Display DirectoryM.VMM & Maybe Display Directory +0M.VAbort Resumption Message +0M.CAtom Word Mode!* 1 => word commands deal with LISP atoms! +:I.W"n:I.W@'1FSMODECH +0M.CAuto Directory Display* 1 => display dir after writes, -1 => reads too +0M.CAuto Fill Mode!* 1 => Auto Fill (break long lines at margin)! +1FSMODECH +32FS^RINITU "E' +M.M^R Auto-Fill SpaceU  +500M.CAuto Push Point Option* Searches moving this far set mark at old point +:I* ^@M.CAuto Push Point Notification* Searches setting mark type this +500M.CAuto Save Interval!* number of characters between auto-saves! +fs^rmdlywfs^rmcnt +0M.CAuto Save Visited File* 1=> auto save under visited filename +0M.CAutoarg Mode!* 1 => digits before control chars set arg! +0FS^RINIT[2 +"NM.M^R AutoargU2' +Q2-Q0"E' +Q2U0Q2U1Q2U2Q2U3Q2U4 +Q2U5Q2U6Q2U7Q2U8Q2U9 +1M.CCase Replace* 1 => Replace commands preserve case +0M.CComment Begin* String for beginning new comments +32M.CComment Column* Column to start comments in +0M.CComment Start* String that indicates the start of a comment +:I*M.CComment End* String that ends comments +:I*/8+1*8M.CComment Rounding* Hairy - see code for ^R Indent for Comment +0M.CDisplay Matching Paren!* Controls action of ) in showing the matching (! +"NM.M& Matching Paren'"#0'FS^RPAREN +70M.CFill Column!* Page width for filling and grinding! +FSADLINE +:I*.?!M.CFill Extra Space List* punctuations that need 2 spaces +:I*M.CFill Prefix* String to put before each line when filling +0M.CFind File Inhibit Write* initializes Inhibit Write for Find File +0M.CFS CTLMTA!!FSCTLMTA +0M.CInhibit Write!* -1 => Never save automatically on switching files! +1FSMODECH +0M.CLISP Indent Offset* See ^R Indent for LISP +0M.COverwrite Mode!* Overwrite Mode status (see MM Overwrite Mode)! +1FSMODECH +FS^RREPLACE +:I* M.CPage Delimiter* Search string for finding page boundaries +:I*.  M.CParagraph Delimiter* Lines starting with these chars start paragraphs +-1M.CPermit Unmatched Paren* 1 => allow unmatched ), -1 => only in Lispish modes +0M.CRead Line DelayPausing this many 1/30 sec causes echoing +5000M.CRegion Query Size* Some commands need confirmation if region this big +:I*M.VSet Mode Line Hook +0M.CSpace Indent Flag* If nonzero, Auto Fill indents new lines +:I*MEMOXGP@XGPUNFASLOUTPUTOLREC M.CTemp File FN2 List* Reap File deletes these FN2s +:I*FundamentalM.CModeDo MM FOO to enter FOO mode +:I*M.CSubmode!!1FSMODECH +M.M& Subset Directory ListingM.CDirectory ListerMacro to use to list directories +15FSQVECTOR1M.VSearch Default Ring +:I:1(0):I:1(1):I:1(2)]1 +:I..GQ..H"EMDirectory Lister' +0M.VBacktrace Temp +:I*M.VEditor Name +:I*M.VEditor Type +:I*M.VPrefix Char List +M.M& Indent with TabsM.VMM & Indent +M.M& Xindent with TabsM.VMM & Xindent +:I* : : : : : : : : : : : :M.CTab Stop Definitions* Tab stops for ^R Tab to Tab Stop +0M.VNext Bfr Number +9*5FSQVECTORU.B +9U:.B(0) +:I*MainU:.B(1) +0U:.B(2) +:I*FundamentalU:.B(3) +Q..ZU:.B(4) +0U:.B(5) +0U:.B(6) +%Next Bfr NumberU:.B(7) +0U:.B(8) +0M.VBuffer Filenames +Q:.B(1)M.VBuffer Name +0M.VBuffer Index +Q:.B(1)M.VPrevious Buffer +FSOSTECO"E +M.M& Default FS SuperiorFSSUPERIOR' +M.MMake Local VariableU.L +0M.VAuto Save Mode +M.LAuto Save Mode +0M.CAuto Save Default!* Default value of Auto Save Mode for new files! +1FSMODECH +:I*M.CAuto Save Filenames* Filename for Auto Save Files +2M.CAuto Save Max* # of saves to keep +M.LAuto Save Delete +M.LAuto Save Size +M.LAuto Save Count +M.LInhibit Write +5M.VInitial Local Count +Purify Variablesm[1[2[3 +m.m&& Variable Name Listu2 + +'> +& Load Patches*f[bbindqEMACS Version:\[1 +f[dfileetemacs;pat1 > +1:"l' +z"e' +@f + k +f[:ejpage +m(m.mLoad Library)PURIFY + +hk~Filename~ EINIT~DOC~ ~Filename~(Macros for installing a new EMACS. +~DOC~ ? Generate EMACS<? Create EMACS :EJ file from sources. +Compresses the source files that need compression, +then concatenates the COMPRS files and purifies, writing +the result out as EMACS;[PURE] >. +~DOC~ ? Document EMACS)? Create EMACS DOC and EMACS CHART. +$~DOC~ & Load Default Environment<S Create the default environment. +Assuming that the pure files are already loaded +and the "essential" environment is set up, set up the standard +EMACS ^R command definitions, etc. +&~DOC~ & Load Essential EnvironmentvS Does what's needed for EMACS macros to work at all. +A given environment (such as EMACS, TME, etc.) may set up +other variables, and redefine ^R characters. That is all optional. +But code may fail to work if these variables are missing. +~DOC~ Purify Variables"C Make var names in symtab pure. +For each symbol, sees whether there is a pure string for +its name, and if so makes the sym tab point at that pure string. +~DOC~ & Load PatchesS Load patches (made since [pure] file) before dumping. +Essentially, we do a Compile One Macro on each page of +the patch file EMACS;PATnnn > +~DIRECTORY~? Generate EMACS +? Document EMACS +& Load Default Environment +& Load Essential Environment +Purify Variables +& Load Patches + ~INVERT~[1Q1 diff --git a/src/e142/emacs-133.changes b/src/e142/emacs-133.changes new file mode 100644 index 00000000..02d4faf4 --- /dev/null +++ b/src/e142/emacs-133.changes @@ -0,0 +1,81 @@ +Changes in EMACS version 133: + +*) The self documentation features now know about names for the +built-in TECO ^R command definitions. For example, Apropos of "Line" +will now show ^R Open Line on C-O. You can't actually call those +commands by those names, unless you load the library BARE; this +library is temporarily loaded by the documentation commands that need +it. MM& Load BARE loads BARE and causes BARE to remain loaded until +its caller returns. + +*) C-U C-Y differs from plain C-Y in that it leaves point before +the un-killed text and the mark after. + +*) C-U C-L causes the line point is on to be redisplayed. +Actual numeric arguments (not just C-U) still specify +a line to display point on. + +*) C-; and M-; (^R Indent for Comment) now inserts the comment +terminator as well as the comment starter, leaving point in between +them. M-N and M-P (^R Down Comment Line, and .. Up ..), have been +modified for this behavior. + +*) M-G and M-Q (^R Fill Paragraph and ^R Fill Region) now by default +remove excess spaces such as are produced by filling. + +*) Return now will not gobble a blank line followed by a nonblank +line. + +*) C-K will now treat a blank line as if it were empty, killing +through the CRLF instead of to it. More specifically, if point is +followed by a CRLF with only whitespace in between, C-K will kill +through the CRLF. + +*) M-[ and M-] (^R Backward Paragraph, and ... Forward ...), now treat +"\" at the front of a line just like "." and "-", for the sake of TEX +files. This special treatment is that if those characters are +declared (using QParagraph Delimiter) to start paragraphs, then +whenever a paragraph starts for that reason, that paragraph is only +one line long. + +*) You can now put MM Query Replace on a character. It will read its +arguments in the echo area. + +*) Errors in auto-saving will type out "(Auto Save Error!)". + +*) ^R Indent Nested (the definition of Tab in certain modes) now does +something useful with negative arguments. It indents the line more +than the previous line, (* (ABS ARGUMENT) (MAX 1 QIndent Increment)) +spaces more. QIndent Increment is not initially defined. + +*) There is now an autoloading definition for C-X ( which loads in +KBDMAC and transfers to it. People need no longer load KBDMAC in +their init files. You will now see "Def" in the mode line while +defining a keyboard macro. + +*) Exiting from the top-level ^R invocation now returns to EMACS's +superior. To exit from it back to TECO command level, do +1MM Top Level. This will advise you to re-enter ^R mode by doing +:M..L. Returning to the superior will now clear out the mode line +completely. + +*) Creating a new buffer initializes it in the same mode as the +previous selected buffer. This uses the new @F^G command in TECO. + +*) Making variables like QAuto Fill Mode local now works +straightforwardly; it is no longer necessary to deal with the crock +Switch Modes Process Options, which no longer exists. These variables +have been equipped with macros which are run whenever their values +change. Thus, simply doing 1UAuto Fill Mode is enough to turn on +the mode. MM & Process Options no longer exists. A side effect of +this is that buffer switching is much faster. This uses the new +FS VAR MACRO feature of TECO. QProcess Options Hook no longer +exists; instead, you must make macros to be run when your variables' +values change. This will be documented in CONV later. + +*) Instead of calling MM & Set Mode Line, macros should simply do +1FS Mode Change, which will cause MM & Set Mode Line to be called +when the mode line comes up for redisplay. Thus, multiple reasons for +calling it will not cause it to be called more than once. +QSet Mode Line Hook still exists and works as before. + diff --git a/src/e142/emacs._ej b/src/e142/emacs._ej new file mode 100644 index 00000000..30b97fee Binary files /dev/null and b/src/e142/emacs._ej differ diff --git a/src/e142/emacs._ej.135 b/src/e142/emacs._ej.135 new file mode 100644 index 00000000..cdc0c2ab Binary files /dev/null and b/src/e142/emacs._ej.135 differ diff --git a/src/e142/emacs.ctl b/src/e142/emacs.ctl new file mode 100644 index 00000000..215775a4 --- /dev/null +++ b/src/e142/emacs.ctl @@ -0,0 +1,25 @@ +@midas teco +*2 +*11. +*12. +* +* +* +* +* +* +* +* +*13. +* +*10. +* +* +* +* +* +*17. +@iddt +*;yteco.sav +*;wteco +*purifygmmrunpurifydumpnemacs.savfsexit;h diff --git a/src/e142/emacs.init b/src/e142/emacs.init new file mode 100644 index 00000000..aaca8b9d --- /dev/null +++ b/src/e142/emacs.init @@ -0,0 +1,75 @@ +!* -*-TECO-*- *! +!* This is the default init file for EMACS. + Anything in the buffer when you start this + will be used instead of the JCL. + *! + Q..9"E Q..LU..9' !* ..9 is what to run on the way out.! + !* Maybe same as ..L.! + + FT +NEMACS (emacs version 135) has been renamed to EMACS and the old +version (133) to EMACS. The most recent version (142) +has been brought up as EMACS. A summary of the changes +(there are many) is available in CHANGES.142. In a week +or two, EMACS.SAV;142 will go onto , so try out +the new version before then. Any questions to . + + + FQ(0FO..QAuto Save Filenames)-1"L + FS MSNAME:F6[0 + :I*DSK:0;Autosave > M.VAuto Save Filenames ]0' + + FS XJNAME :F6 [J + + FS MSNAME FS D SNAME !* Make connected dir default name! + QFind File Inhibit Write UInhibit Write + +!* On non-meta keyboards, allow Alt 1 2 to mean an arg of 12.! + FS %TOFCI"E + M.M ^R Autoarg[0 460.-1[1 + 10< Q0,%1^ FS ^R CMAC> Q0U..- + ]1 ]0' + + !* Process the JCL! + 0[0 0[1 + Z"E FJ' ZJ !* Get JCL, or use whatever previous init file left in buffer.! + ."N !* Process JCL command - extract filenames and commands! + 0,0A- +"E -D' !* REMOVE LF AT END IF ANY *! + J :S"N .,Z^ FX1 -D' !* IF COMMANDS TO EXECUTE, PUT THEM IN Q1! + HFX0' !* IF FILE TO BE READ, PUT NAME IN Q0! + ' + FS LISPT"N FS CCL FNAMU0 + 0FS SUPERIOR !* Dont try to suck in LISPT.! + 0U1 F~JSNDMSG"E M(M.M TEXT MODE)'' + + qEMACS Version-132"G M(M.MLoad Library)PATCH' + 1fs Echo Errors + 8FS HELP CHAR + Q0"E Q1"E !* If no commands / file to read, offer help.! + HK FS Date FS FD Convert + 9J \ [4 HK + FS Version :\ [2 + qEMACS Version:\[1 !* get version no. as string! + Q4-12 "L FTGood Morning.' + "# Q4-18 "L FTGood Afternoon.' + "# FTGood Evening.'' + FT +EMACS Editor, version 1.2 - type ^H for help. +'' + FQ0-1"L Q1"N M1' !* No file specified => execute commands from JCL! + 0FS QP Unwind :M..9' !* and enter ^R mode.! + + QInhibit Write,M(M.M Visit File)0 !* VISIT SPECIFIED FILE, USING ">' AS DEFAULT FN2! + FSLISPT"N F~JSNDMSG"N !* If called by EXEC EDIT command...! + QBuffer Filenames F[ DFILE + 0 FS DVERS !* Reset version number defaults.! + FS DFILE UBuffer Filenames + M(M.M& Set Mode Line) + F]D FILE'' + + Q1"N M1' !* If JCL held commands, execute them.! + f~JLISP"E M(M.MLoad Library)Intermacs !* if under a LISP then load Intermacs! + FS Exit' + +0FS QP Unwind :M..9 \ No newline at end of file diff --git a/src/e142/emacs.log b/src/e142/emacs.log new file mode 100644 index 00000000..7a11a450 --- /dev/null +++ b/src/e142/emacs.log @@ -0,0 +1,100 @@ + Tenex Batch System. Version 3.0 + Batch job number 246 Started Monday, November 26, 1979 16:17:23 + Maximum log length (lines): 1000 + Maximum elapsed time (minutes): 360 + Maximum CPU time (seconds): 3600 + Input file : EMACS.CTL;2;ASTAFF,26-Nov-79 14:46:11 + Output file : EMACS.LOG;1;ASTAFF,26-Nov-79 14:42:50 + + SUMEX-AIM Tenex 1.31.33, SUMEX-AIM Exec 1.54.22 + + !!! Hardware problems - save your files often. Running on 1 CPU !!! + +@LOG SCHOEN STAFF + Job 26 on TTY144 26-Nov-79 16:17 + Previous login: 26-Nov-79 16:12 + Tenex will go down Thu 11-29-79 1730 til Thu 11-29-79 2359 + for preventive maintenance +@;end of COMAND.CMD +@ +@connect emacs + EMACS over allocation by 2041 pages. +@usestat + 26-Nov-79 16:17, used 0:00:01 in 0:00:13, sched=10%, 1/23 + 17!+22! Jobs, LA 4.49 6.34 6.70 +@<10/20-sources>midas + ******* [ 16:17:55 (PRIV) USED 0:00:02 IN 0:00:26 ] ******* +NOTPUR MIDAS.417 +*teco +TECO +END OF LOW IMPURE = 3341 +IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): 2 +GTTYP index for DM2500 = 11. +GTTYP index for H1500 = 12. +GTTYP index for VT52 = +GTTYP index for DM1520 = +GTTYP index for IMLAC = +GTTYP index for VT05 = +GTTYP index for TK4025 = +GTTYP index for VT61 = +GTTYP index for TL4041 = +GTTYP index for FOX = +GTTYP index for HP2645 = 13. +GTTYP index for I400 = +GTTYP index for TK4023 = 10. +GTTYP index for ANNARB = +GTTYP index for C100 = +GTTYP index for IQ120 = +GTTYP index for VT100 = +GTTYP index for I100 = +GTTYP index for TL1061 = 17. +GTTYP index for H19 = 18. +CHNTAB+3 35742 21. 316-061 .ICPOV Undefined in BLOCK +CHNTAB+4 35743 21. 316-063 .ICTOD Undefined in BLOCK +CHNTAB+5 35744 21. 316-065 .ICNXP Undefined in BLOCK +TOP OF PURE = 41755 +TECO +GOZ+20 4024 0. 20-044 .TICCC Undefined in literal +SETTTM+1 4223 0. 24-005 .TICCG Undefined +FSNQIT+11 20043 0. 141-085 .TICCG Undefined +FSNQT2+2 20050 0. 141-090 .TICCG Undefined +SETFRK+17 22317 0. 164-031 .TICCG Undefined +RETFRK+4 22341 0. 164-056 .TICCG Undefined +CHNTAB+3 35742 0. 316-061 .ICPOV Undefined in BLOCK +CHNTAB+4 35743 0. 316-063 .ICTOD Undefined in BLOCK +CHNTAB+5 35744 0. 316-065 .ICNXP Undefined in BLOCK +Constants area inclusive +From To +3334 3341 +37700 41554 +Run time = 1:20.14 +5816 Symbols including initial ones (72% used) + ******* [ 16:24:54 EXEC USED 0:01:23 IN 0:07:25 ] ******* +@usestat + 26-Nov-79 16:24, used 0:01:22 in 0:07:21, sched=2%, 2/34 + 15!+21!+1 Jobs, LA 4.61 5.16 5.91 +@iddt + ******* [ 16:24:59 IDDT USED 0:01:24 IN 0:07:29 ] ******* + +;yANK FILE: teco.sav;786 + +;wRITE SYMBOLS ON FILE: teco.SYMBOLS;785 [Confirm] + +purify$$g[_TECO$:PURIFY] +~`u~ + TECO&GETCHR+4/ LDB 15,TECO&BTAB(12) mmrun$pU urify$dU ump$nU emacs.sav$fU sexit$$;hU +^C + ******* [ 16:27:28 EXEC USED 0:01:31 IN 0:09:59 ] ******* +@usestat + 26-Nov-79 16:27, used 0:01:30 in 0:09:55, sched=2%, 3/99 + 18!+21! Jobs, LA 6.06 5.60 5.96 +@^C +@LOGOUT + [New mail from SYSTEM sent 26-Nov-79 16:26] + EMACS over allocation by 2097 pages. + [Confirm] + + Tenex will go down Thu 11-29-79 1730 til Thu 11-29-79 2359 + for preventive maintenance +KILLED JOB 26, USER SCHOEN, ACCT STAFF, TTY 144, AT 11/26/79 1628 + USED 0:1:32 IN 0:10:43 diff --git a/src/e142/emacs.odoc b/src/e142/emacs.odoc new file mode 100644 index 00000000..0b2ef0e8 --- /dev/null +++ b/src/e142/emacs.odoc @@ -0,0 +1,2258 @@ + +^R Commands defined in the EMACS editor (as of 01/06/80): + Commands not listed here are self-inserting, + illegal, or trivial aliases of other commands + (as, Control-x for Control-X, or Control-I for Tab). + +Backspace + moves back one character (or several). + +Tab runs the macro ^R Indent According to Mode + Indents suitably for the language you are using. + In fundamental mode, just inserts a Tab. + +Linefeed + runs the macro ^R Indent New Line + Inserts CRLF, then indents the second line. + Any spaces before the inserted CRLF are deleted. + Uses the definitions of CR and Tab to do the work, + except that if there is a Fill Prefix it is used to indent. + An argument is passed on to the definition of Tab. + +Return runs the macro ^R CRLF + Insert CRLF, or move onto blank line. + A blank line is one containing only spaces and tabs + (which are killed if we move onto it). Single blank lines + (followed by nonblank lines) are not eaten up this way. + In auto-fill mode, we may break the line before the last word. + A pre-comma arg inhibits this. + +Altmode runs the macro ^R Prefix Meta + Sets Meta-bit of following character. + It followed by an A is equivalent to a Meta-A. + If the Metizer character is Altmode, then metizing a ^A + creates a Control-Meta-A. If the metizer is not Altmode, + then metizing a ^A makes a plain Meta-A. + Given a first argument (as in "33,"), returns the + metized character; otherwise, executes its definition. + The value of the arg should be the metizer character itself + so we can tell whether it was an altmode. + +Control- + runs the macro ^R Complement SAIL Mode + Start or stop printing the SAIL character set. + +Control-Altmode + exits from ^R mode. + +Control-Space + runs the macro ^R Set/Pop Mark + Sets or pops the ^R-mode mark. + With no ^U's, pushes . as the mark. + With one ^U, pops the mark into . + With two ^U's, pops the mark and throws it away. + +Control-% + runs the macro ^R Replace String + Replace string with another. Reads args with minibuffer. + Calls the Replace String command. + +Control-; + runs the macro ^R Indent for Comment + Move to or create comment. + Finds start of existing comment, or creates one at end of line. + Indents the comment to QComment Column. + With argument , aligns the existing comments in the + next lines, but does not create comments. + QComment Begin holds the string inserted to start a comment. + QComment Start holds the string recognized as starting an old one. + QComment End holds the string inserted to end a comment. + QComment Rounding holds the macro used when the code goes + past the comment column, to compute a new (larger) comment column + from the width of the code (default is "+1"). + +Control-< + runs the macro ^R Mark Beginning + Set mark at beginning of buffer. + +Control-= + runs the macro ^R Where Am I + Print various things about where cursor is. + Print the X position, the Y position, + the octal code for the following character, + point absolutely and as a percentage of the total file size, + and the virtual boundaries, if any. + +Control-> + runs the macro ^R Mark End + Set mark at end of buffer. + +Control-@ + runs the macro ^R Set/Pop Mark + Sets or pops the ^R-mode mark. + With no ^U's, pushes . as the mark. + With one ^U, pops the mark into . + With two ^U's, pops the mark and throws it away. + +Control-A + goes to the front of the line. + +Control-B + moves back one character (or several). + +Control-C + runs the macro ^R Prefix Control-Meta + Sets Control- and Meta-bits of following character. + It, followed by an A (or a Control-A), + is equivalent to a Control-Meta-A. Given a first argument + (as in "1,"), returns the metized character; otherwise, + executes its definition. + +Control-D + deletes one character (or several) forward. + +Control-E + goes to the end of the line. + +Control-F + moves forward one character (or several). + +Control-G + quits execution of any command. + Throws away any argument. + +Control-K + runs the macro ^R Kill Line + Kill to end of line, or kill an end of line. + At the end of a line (only blanks following) kill through the CRLF. + Otherwise, kill the rest of the line but not the CRLF. + With argument (positive or negative), kill specified number of lines. + Killed text is pushed onto the kill ring for retrieval. + +Control-L + runs the macro ^R New Window + Choose new window putting point at center, top or bottom. + With no argument, chooses a window to put point at the center + (FS %CENTER says where). An argument gives the line to put + point on; negative args count from the bottom. + ^U as argument redisplays the line containing point. + +Control-M + inserts itself. + +Control-N + runs the macro ^R Down Real Line + Move down vertically to next real line. + Continuation lines are skipped. If given after the + last LF in the buffer, makes a new one at the end. + +Control-O + inserts one CRLF (or several) after point. + Thus, point does not move. + +Control-P + runs the macro ^R Up Real Line + Move up vertically to next real line. + Continuation lines are skipped. + +Control-Q + runs the macro ^R Quoted Insert + Reads a character and inserts it. + +Control-R + runs the macro ^R Reverse Search + Incremental Search Backwards. + Calls Incremental Search with a negative argument. + +Control-S + runs the macro ^R Incremental Search + Search for character string. + As characters are typed in, the accumulated string is + searched for. Characters may be rubbed out. + ^Q quotes special characters. + ^S repeats the search, forward, and ^R repeats it backward. + If the accumulated string is empty, ^R or ^S either + reverses the direction of search or gobbles the previous + search string and searches for it again. + Altmode or any random control character exits + (anything but altmode is then executed). + If the accumulated string fails to be found, + you will be notified with one bell. You can then exit, + rub the bad characters out (or ^G them all away), + or try searching in the opposite direction. + Quitting a successful search goes back to the starting + point of the search; quitting a failing search rubs out + enough characters to make it successful again. + Altmode when the string is empty makes the search + non-incremental by calling ^R String Search. + +Control-T + runs the macro ^R Exchange Characters + Interchange the characters before and after the cursor. + With a positive argument it interchanges the characters before and + after the cursor, moves right, and repeats the specified number of + times, dragging the character to the left of the cursor right. With a + negative argument, it interchanges the two characters to the left of + the cursor, moves between them, and repeats the specified number of + times, exactly undoing the positive argument form. With a zero + argument, it interchanges the characters at point and mark. + No argument is like an argument of 1, except at the end of a line + the previous two characters are interchanged. + +Control-U + runs the macro ^R Universal Argument + Sets argument or multiplies it by four. + Followed by digits, uses them to specify the + argument for the command after the digits. + Not followed by digits, multiplies the argument by four. + +Control-V + runs the macro ^R Next Screen + Move down to display next screenful of text. + With argument, moves window down lines. + +Control-W + runs the macro ^R Kill Region + Kill from pointer to mark. + Killed text is pushed onto ..K for retrieval. + +Control-X + is an escape prefix command with these subcommands: + + ^X ^B runs the macro List Buffers + List numbers, names, files and modes of all buffers. + ^X ^C runs the macro ^R Return to Superior + Go back to TECO's controlling job. + With argument, or in auto save mode, saves the buffer first. + ^X ^D runs the macro ^R Directory Display + Display current buffer's file's directory. + Uses whatever directory display macro the user has + selected (put in QDirectory Lister). With non-zero argument, use the + minbuffer to specify the directory with ET. + ^X ^E runs the macro ^R Edit File + Visit file, writing back changes automatically. + If you alter the file, then the next attempt to read in a file + will save this one automatically. Also, auto saving will save + using the file's real name, if possible. + ^X ^F runs the macro ^R Find File + Visit a file in its own buffer. + A nonzero argument inhibits auto saving for this file. + ^X Tab runs the macro ^R Indent Rigidly + Shift text in region sideways as a unit. + All the lines in the region (first character between point and mark) + have their indentation incremented by the numeric argument + of this command (which may be negative). + ^X ^L runs the macro ^R Lowercase Region + Convert point to mark to lower case. + ^X ^N runs the macro ^R Set Goal Column + Set (or flush) a permanent goal for vertical motion. + With no argument, makes the current column the goal for vertical + motion commands. They will always try to go to that column. + With argument, clears out any previously set goal. Only + the ^R Up Real Line and Down Real Line macros are affected. + ^X ^O runs the macro ^R Delete Blank Lines + Kill all blank lines around this line's end. + If done on a non-blank line, kills all spaces and tabs + at the end of it, and all following blank lines + (Lines are blank if they contain only spaces and tabs). + If done on a blank line, deletes all preceding blank lines as well. + ^X ^P runs the macro ^R Mark Page + Put point at top of page, mark at end. + A numeric arg specifies the page: 0 for current, 1 for next, + -1 for previous, larger numbers to move many pages. + qPage Delimiter may contain the string used to + separate pages (or several alternatives, separated by ^O). + ^X ^Q runs the macro ^R Do Not Write File + Don't write back this buffer automatically. + The next time a file is read into this buffer, it will + not be written out to its old file. + With argument, switches to automatic write-back mode. + ^X ^R runs the macro ^R Read File + Read file, no automatic writing. + The filenames are read from the TTY. + Changes made will not be written back unless you + give an explicit command. + ^X ^S runs the macro ^R Save File + Save buffer on disk if modified. + Auto Save mode uses this macro. + If auto-saving is enabled, then we write to filenames read + or to a separate auto-save filename. If auto-saving is off, + or if given an argument, we always write to the filenames read. + "1," as argument indicates that this call was not explicitly + requested, and the user should be asked to confirm if + the file has become a lot smaller. "2," means an auto save, + which should abort if the file is shrunken. + ^X ^T runs the macro ^R Mini Visited File + Minibuffer setting defaults to buffer filenames. + With no argument, runs a minibuffer initialized with + an ET command containing the current buffer's filenames. + Thus, the default filenames get set to the buffer filenames. + With an argument, puts the old defaults in the ET. + This doesn't change the defaults; it just shows them. + ^X ^U runs the macro ^R Uppercase Region + Convert point to mark to upper case. + ^X ^V runs the macro ^R Visit File + Visit file, asking about writing back changes. + If you alter the file, then the next attempt to read in a file + will ask whether you want this one written back out. + ^X ^W runs the macro Write File + Change buffer filenames and write out. + Follow by filename as string argument. "1," says called by ^X^S; + inhibits calling & Set Mode Line and auto-save reinitialization. + Also inhibits setting filenames (in case they are _^RSV). + "-1," as argument inhibits updating the buffer's file cdate as well. + If not at top level (can't switch files now), + doesn't update anything about the current buffer, + but does return the written file's creation date so the caller can store it. + ^X ^X runs the macro ^R Exchange Point and Mark + Exchange pointer and mark. + ^X ^Z runs the macro ^R Return to Superior + Go back to TECO's controlling job. + With argument, or in auto save mode, saves the buffer first. + ^X Altmode runs the macro ^R Re-execute Minibuffer + Re-execute the last minibuffered commands. + With a numeric argument N, re-executes the N'th most recent minibuffer. + ^X # runs the macro ^R Change Font Region + Puts the region in a different font (R). + The font to change to is specified with a numeric argument. + Inserts ^F before and ^F* after. + A negative arg removes font changes in or next to region. + ^X ( runs the macro ^R Start Kbd Macro + Begin defining a keyboard macro. + This version just loads the KBDMAC library and then calls it. + ^X . runs the macro ^R Set Fill Prefix + Defines Fill Prefix from current line. + All of the current line up to point becomes the value + of QFill Prefix. Auto Fill Mode and ^J insert the + prefix on each line; Fill Region assumes that each + non-blank line starts with the prefix (which is ignored + for filling purposes). + To stop using a Fill Prefix, do ^R Set Fill Prefix + at the front of a line. + ^X 1 runs the macro ^R One Window + Display only one window. + Normally, we display what used to be in the top window, + but a numeric argument says to display what was in the bottom one. + ^X 2 runs the macro ^R Two Windows + Show two windows and select window two. + An argument > 1 means give window 2 the same buffer as in Window 1. + A pre-comma argument means keep the cursor in window 1. + ^X 3 runs the macro ^R View Two Windows + Show two windows but stay in first. + ^X 4 runs the macro ^R Modified Two Windows + Find buffer, tag or file in other window. + Follow this command by B or C-B and a buffer name, + F or C-F and a file name, or T or . and a tag name. + We find the buffer, tag or file in the other window, + creating the other window if necessary. + ^X : runs the macro ^R Set Column + Set some column variable to current column. + Reads the name of the column variable to set from the terminal. + ^X ; runs the macro ^R Set Comment Column + Set comment column to current hpos. + An argument > 4 is used as the value instead of current hpos. + With argument <= 4, sets comment column from position of previous comment + and then makes or moves a comment to that position on this line. + ^X = runs the macro ^R Where Am I + Print various things about where cursor is. + Print the X position, the Y position, + the octal code for the following character, + point absolutely and as a percentage of the total file size, + and the virtual boundaries, if any. + ^X A runs the macro ^R Append to Buffer + Append region to specified buffer. + The buffer's name is read from the tty; it is created if nonexistent. + A numeric argument causes us to "prepend" instead. + We always insert the text at that buffer's pointer, but when + "prepending" we leave the pointer before the inserted text. + ^X B runs the macro Select Buffer + Select or create buffer, given its name. + If called from a ^R character, read the buffer name from the terminal + or should be given a buffer number as a numeric arg. + As a subroutine, needs a buffer number (or buffer name pointer) as a + prefix arg, or a buffer name as a string arg. + If there is a buffer with that name, it is selected. + Otherwise, a buffer with that name is created and selected. + When a new buffer is selected the first time, if QBuffer Creation Hook + is nonzero, it is run after the buffer is selected. + ^X D runs the macro ^R Dired + Run MM Dired  for the directory of the current buffer file. + With no argument, edits that directory. + With an argument of 1, shows only the versions of the file in the buffer. + With an argument of 4, asks for input, only versions of that file are shown. + ^X F runs the macro ^R Set Fill Column + Set fill column to current hpos. + ^X G runs the macro ^R Get Q-reg + Get contents of Q-reg (reads name from tty). + Usually leaves the pointer before, and the mark after, the text. + With argument, puts point after and mark before. + When used as a subroutine, if this macro is given + an argument before a comma, that argument becomes + the first character of the q-reg name. + ^X H runs the macro ^R Mark Whole Buffer + Set point at beginning and mark at end of buffer. + Pushes the old point on the mark first, so two pops restore it. + With arg, puts point at end and mark at beginning. + ^X I runs the macro ^R Info + MM Info with null argument. + ^X K runs the macro Kill Buffer + Kill the buffer with specified name. + Takes name as a string (suffix) argument, or reads it from terminal. + Alternatively, the name (as string pointer) or the buffer + number may be given as a prefix argument. + If the buffer has changes in it, we offer to write it out. + ^X L runs the macro ^R Count Lines Page + Type number of lines on this page. + Also add, in parentheses, the number of lines on the page + before point, and the number of lines after point. + ^X M runs the macro Mail + Mail a message, with RMAIL's M option. + Lets you edit a message with ^R, then send it when you + exit the ^R. Use ^G to abort the message, after which + MM Mail with an argument will re-enter. Put the text + of the message after the line which says + --Text follows this line--. Before that line can go only + header items, like the "From:" that is provided for you. + ^X N runs the macro ^R Set Bounds Region + Narrow buffer bounds to point and mark. + ^X O runs the macro ^R Other Window + Switch to the other window. + If both windows are showing, the pointer moves into the + other one. If only window 1 is visible, then the + windows are exchanged: what used to be in window 2 + (invisible) is now in window 1 (visible), and vice versa. + An argument means switch windows but select the same + buffer in the other window. + ^X P runs the macro ^R Set Bounds Page + Narrow buffer bounds to one page. + Numeric arg specifies which page: 0 means this one, + 1 means the next one, -1 means the previous one. + No arg means next page, or current page if bounds are wide open. + Args larger than one move several pages. + qPage Delimiter may contain the string used to + separate pages (or several alternatives, separated by ^O). + ^X R runs the macro ^R RMAIL + Read mail. See topic RMAIL in INFO. + Uses a null command string for RMAIL. + Good for re-entering after exiting RMAIL with ^X. + ^X W runs the macro ^R Set Bounds Full + Widen virtual bounds to whole buffer. + ^X X runs the macro ^R Put Q-reg + Put point to mark into q-reg (reads name from tty). + With an argument, the text is also deleted. + When used as a subroutine, if this macro is given + an argument before a comma, that argument becomes + the first character of the q-reg name. + ^X [ runs the macro ^R Previous Page + Move to previous page delimiter. + See the description of ^R Mark Page. + ^X ] runs the macro ^R Next Page + Move to next page delimiter. + See the description of ^R Mark Page. + ^X ^ runs the macro ^R Grow Window + Make this window (or minibuffer) use more lines. + Argument is number of extra lines (can be negative). + ^X _ runs the macro ^R Underline Region + Puts underlines a la R around the region. + A negative argument removes underlines in or next to region. + QUnderline Begin and QUnderline End may be set to the strings + or characters to be used to begin and end underlines. + ^X Rubout runs the macro ^R Backward Kill Sentence + Kills back to beginning of sentence. + +Control-Y + runs the macro ^R Un-kill + Re-insert the last stuff killed. + Puts point after it and the mark before it. + An argument n says un-kill the n'th most recent + string of killed stuff (1 = most recent). A null + argument (just C-U) means leave point before, mark after. + +Control-Z + runs the macro ^R Prefix Control-Meta + Sets Control- and Meta-bits of following character. + It, followed by an A (or a Control-A), + is equivalent to a Control-Meta-A. Given a first argument + (as in "1,"), returns the metized character; otherwise, + executes its definition. + +Control-\ + runs the macro ^R Prefix Meta + Sets Meta-bit of following character. + It followed by an A is equivalent to a Meta-A. + If the Metizer character is Altmode, then metizing a ^A + creates a Control-Meta-A. If the metizer is not Altmode, + then metizing a ^A makes a plain Meta-A. + Given a first argument (as in "33,"), returns the + metized character; otherwise, executes its definition. + The value of the arg should be the metizer character itself + so we can tell whether it was an altmode. + +Control-] + is the same as in a bare TECO. + +Control-^ + runs the macro ^R Prefix Control + Sets Control-bit of following character. + It followed by an = is equivalent to a Control-=. + Given a first argument (as in "1,"), returns the + controlified character; otherwise, executes its + definition. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta-Backspace + is undefined. + +Meta-Linefeed + runs the macro ^R Indent New Comment Line + Inserts CRLF, then starts new comment. + If done when not in a comment, acts like ^R Indent New Line. + +Meta- is undefined. + +Meta- is undefined. + +Meta-Return + runs the macro ^R Back to Indentation + Move to end of this line's indentation. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta-Altmode + runs the macro ^R Execute Minibuffer + Read and run TECO commands. + Uses the minibuffer to read them. Pushes the command string + onto a ring buffer in Q.N. An explicit argument initializes + the minibuffer with the command from the top of that ring buffer. + Once inside the minibuffer, C-M-Y pops to previous saved + minibuffer commands, going around the ring. + +Meta- is undefined. + +Meta- is undefined. + +Meta- is undefined. + +Meta- + is undefined. + +Meta-Space + is undefined. + +Meta-! is undefined. + +Meta-" is undefined. + +Meta-# runs the macro ^R Change Font Word + Puts the previous word in a different font (R). + The font to change to is specified with a numeric argument. + No arg means move last font change forward past next word. + A negative arg means move last font change back one word. + +Meta-$ is undefined. + +Meta-% runs the macro ^R Query Replace + Query Replace string macro using the minibuffer. + Calls the Query Replace command. + +Meta-& is undefined. + +Meta-' runs the macro ^R Upcase Digit + Convert last digit to shifted character. + Looks on current line back from point, and previous line. + The first time you use this command, it asks you to type + the row of digits from 1 to 9 and then 0, holding down Shift, + to determine how your keyboard is set up. + +Meta-( runs the macro ^R Make () + Insert () putting point between them. + Also make a space before them if appropriate. + With argument, put the ) after the specified number + of already existing s-expressions. Thus, with argument 1, + puts extra parens around the following s-expression. + +Meta-) runs the macro ^R Move Over ) + Move over a ), updating indentation. + Any indentation before the ) is deleted. + LISP-style indentation is inserted after the ). + +Meta-* is undefined. + +Meta-+ is undefined. + +Meta-, is undefined. + +Meta-. runs the macro ^R Find Tag + Jump to the definition of a tag. + This version loads the TAGS package and then calls it. + +Meta-/ runs the macro ^R Describe + Describes a ^R command. + The command character is read from the terminal. + Alternatively, the command char and definition may be fed as + numeric args, in which case the character's name is not printed. + +Meta-: is undefined. + +Meta-; runs the macro ^R Indent for Comment + Move to or create comment. + Finds start of existing comment, or creates one at end of line. + Indents the comment to QComment Column. + With argument , aligns the existing comments in the + next lines, but does not create comments. + QComment Begin holds the string inserted to start a comment. + QComment Start holds the string recognized as starting an old one. + QComment End holds the string inserted to end a comment. + QComment Rounding holds the macro used when the code goes + past the comment column, to compute a new (larger) comment column + from the width of the code (default is "+1"). + +Meta-< runs the macro ^R Goto Beginning + Go to beginning of buffer (leaving mark behind). + With arg from 0 to 10, goes that many tenths of the file + down from the beginning. + +Meta-= runs the macro ^R Count Lines Region + Type number of lines from point to mark. + +Meta-> runs the macro ^R Goto End + Go to end of buffer (leaving mark behind). + With arg from 0 to 10, goes up that many tenths of the file from the end. + +Meta-? runs the macro ^R Describe + Describes a ^R command. + The command character is read from the terminal. + Alternatively, the command char and definition may be fed as + numeric args, in which case the character's name is not printed. + +Meta-@ runs the macro ^R Mark Word + Set mark 1 (or n) words from point. + +Meta-A runs the macro ^R Backward Sentence + Move to beginning of sentence. + A sentence is ended by a ., ? or ! followed by + two spaces or a CRLF (with optional space), with + any number of "closing characters" ", ', ) and ] between. + A sentence also starts after a blank line. + +Meta-B runs the macro ^R Backward Word + Move backward over one word + +Meta-C runs the macro ^R Uppercase Initial + Put next word in lower case, but capitalize initial. + With arg, applies to that many words backward or forward. + If backward, the cursor does not move. + +Meta-D runs the macro ^R Kill Word + Kill next word. + +Meta-E runs the macro ^R Forward Sentence + Move to end of this sentence. + A sentence is ended by a ., ? or ! followed by + two spaces or a CRLF (with optional space), with + any number of "closing characters" ", ', ) and ] between. + A sentence also ends before a blank line. + +Meta-F runs the macro ^R Forward Word + Move forward over one word + +Meta-G runs the macro ^R Fill Region + Fill text from point to mark. + QFill Column specifies the desired text width. + QFill Prefix if nonzero is a string that goes + at the front of each line and is not included in the filling. + See ^R Set Fill Column and ^R Set Fill Prefix. + An explicit positive argument causes adjusting instead of filling. + QFill Extra Space List lists the punctuations which get two spaces. + +Meta-H runs the macro ^R Mark Paragraph + Put point and mark around this paragraph. + In between paragraphs, puts it around the next one. See documentation + on ^R Backward Paragraph for paragraph definition. + +Meta-I runs the macro ^R Tab to Tab Stop + Insert filling till next tab stop. + Filling may be whitespace, or an arbitrary pattern of characters, + controlled by QTab Stop Definitions, which has two lines. + The second line has spaces except at the tab stop columns. + A colon indicates a tab stop to be filled to with indentation; + a period indicates a tab stop to be filled to by copying the + characters from the first line above the horizontal positions + to be filled. + +Meta-J runs the macro ^R Indent New Comment Line + Inserts CRLF, then starts new comment. + If done when not in a comment, acts like ^R Indent New Line. + +Meta-K runs the macro ^R Kill Word + Kill next word. + +Meta-L runs the macro ^R Lowercase Word + Convert one word to lower case, moving past it. + With arg, applies to that many words backward or forward. + If backward, the cursor does not move. + +Meta-M runs the macro ^R Back to Indentation + Move to end of this line's indentation. + +Meta-N runs the macro ^R Down Comment Line + Move to start of next line's comment. + Equivalent to ^R Down Real Line followed by ^R Indent For Comment. + +Meta-O is undefined. + +Meta-P runs the macro ^R Up Comment Line + Move to start of previous line's comment. + Equivalent to ^R Up Real Line followed by ^R Indent For Comment. + +Meta-Q runs the macro ^R Fill Paragraph + Fill (or adjust) this (or next) paragraph. + Point stays the same (but text may move past it due to filling). + A positive numeric argument says adjust rather than fill. + Not allowed in programming language major modes (whenever comments + are defined). + +Meta-R runs the macro ^R Move to Screen Edge + Jump to top or bottom of screen. + Like ^R New Window except that point is changed instead of the window. + With no argument, jumps to the center, according to FS %CENTER. + An argument specifies the number of lines from the top, + (negative args count from the bottom). + +Meta-S runs the macro ^R Center Line + Center this line's text within the line. + With argument, centers that many lines and moves past. + The width is QFill Column, or if that is zero, FS Width-10. + +Meta-T runs the macro ^R Exchange Words + Interchange the words before and after the cursor. + With a positive argument it interchanges the words before and + after the cursor, moves right, and repeats the specified number of + times, dragging the word to the left of the cursor right. With a + negative argument, it interchanges the two words to the left of + the cursor, moves between them, and repeats the specified number of + times, exactly undoing the positive argument form. With a zero + argument, it interchanges the words at point and mark. + +Meta-U runs the macro ^R Uppercase Word + Convert one word to upper case, moving past it. + With arg, applies to that many words backward or forward. + If backward, the cursor does not move. + +Meta-V runs the macro ^R Previous Screen + Move up to display previous screenful of text. + With arg, move window back lines. + +Meta-W runs the macro ^R Copy Region + Stick region into kill-ring without killing it. + Like killing and getting back, but doesn't mark buffer modified. + +Meta-X runs the macro ^R Execute Completed MM Command + Read an MM command from the terminal with completion. + This command prompts at the bottom of the screen with "MM " and reads the + name of an EMACS command. Name completion is done as the command name is + typed (for more information type the HELP key when typing the command name). + Once the command name is read a  is printed and arguments to the command are + read. No completion is done when typing the arguments. + Internals: + Uses & Read Command Name and & Read Line to echo at bottom of screen. + If the variable Read Command Prompt exists it specifies the prompt string; + otherwise "MM " is used. A numeric argument is passed along to the MM + command. The command string is saved on the minibuffer ring + so that ^R Re-execute Mini will redo it, and ^R Execute Mini + with argument will get it back for editing. + +Meta-Y runs the macro ^R Un-kill Pop + Correct after ^R Un-kill to use an earlier kill. + Requires that the region contain the most recent killed stuff, + as it does immediately after using ^R Un-kill. + It is deleted and replaced with the previous killed stuff, + which is rotated to the front of the ring buffer in ..K. + With 0 as argument, just deletes the region with no replacement, + but the region must still match the last killed stuff. + +Meta-Z is undefined. + +Meta-[ runs the macro ^R Backward Paragraph + Move to start of this (or last) paragraph. + A blank line followed by a nonblank one starts a paragraph. + A line whose predecessor is nonblank starts a paragraph + if its first character is matched by the TECO search string + in the variable QParagraph Delimiter or the one in QPage Delimiter. + If a paragraph starts on a line beginning with ".", "\" or "-", then + the following line also starts a paragraph no matter what it is. + +Meta-\ runs the macro ^R Delete Horizontal Space + Delete all spaces and tabs around point. + +Meta-] runs the macro ^R Forward Paragraph + Move to start of next paragraph. + See documentation on ^R Backward Paragraph. + +Meta-^ runs the macro ^R Delete Indentation + Kill CRLF and indentation at front of line. + Leaves one space in place of them. With argument, + moves down one line first (killing CRLF after current line). + +Meta-_ runs the macro ^R Underline Word + Puts underlines around the previous word (R). + If there is an underline begin or end near that word, + it is moved forward one word. + An argument specifies the number of words, and the direction: + positive means forward. + +Meta-` is undefined. + +Meta-{ is undefined. + +Meta-| is undefined. + +Meta-} is undefined. + +Meta-~ runs the macro ^R Not Modified + Pretend that this buffer hasn't been altered. + +Meta-Rubout + runs the macro ^R Backward Kill Word + Kill last word. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta-Backspace + runs the macro ^R Mark Defun + Put point and mark around this DEFUN (or next). + +Control-Meta-Tab + runs the macro ^R Indent for LISP + Indent this line to make ground LISP code. + At column QLISP Wrap Column (default infinite) we wrap around + to column 1 (not 0!). When you go down a level in list structure, + if QLISP Indent Offset is zero, we indent under the first argument; + if it is nonzero, we indent that many columns past the (. + A pre-comma arg means return the appropriate indentation level + but don't actually change the indentation, and don't treat ;;; comments + specially. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta-Return + runs the macro ^R Back to Indentation + Move to end of this line's indentation. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta-Altmode + inserts itself. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + is undefined. + +Control-Meta- + + is undefined. + +Control-Meta-Space + is undefined. + +Control-Meta-! + is undefined. + +Control-Meta-" + is undefined. + +Control-Meta-# + is undefined. + +Control-Meta-$ + is undefined. + +Control-Meta-% + is undefined. + +Control-Meta-& + is undefined. + +Control-Meta-' + is undefined. + +Control-Meta-( + runs the macro ^R Backward Up List + Move up one level of list structure, backward. + +Control-Meta-) + runs the macro ^R Forward Up List + Move up one level of list structure, forward. + +Control-Meta-* + is undefined. + +Control-Meta-+ + is undefined. + +Control-Meta-, + is undefined. + +Control-Meta-. + is undefined. + +Control-Meta-/ + is undefined. + +Control-Meta-: + is undefined. + +Control-Meta-; + runs the macro ^R Kill Comment + Kills the comment (if any) on the current line. + With argument, applies to specified number of lines, and moves past them. + +Control-Meta-< + is undefined. + +Control-Meta-= + is undefined. + +Control-Meta-> + is undefined. + +Control-Meta-? + runs the macro ^R Documentation + General source of helpful information. + +Control-Meta-@ + runs the macro ^R Mark Sexp + Set mark 1 (or n) s-expressions from point. + +Control-Meta-A + runs the macro ^R Beginning of DEFUN + Move to beginning of this or previous DEFUN. + Leaves the mark behind, in case typed by accident. + With a negative argument, moves forward to the beginning of a DEFUN. + The beginning of a DEFUN is any ( in column 0. + +Control-Meta-B + runs the macro ^R Backward Sexp + Move backward past one S-expression (or several). + +Control-Meta-C + exits from ^R mode. + +Control-Meta-D + runs the macro ^R Down List + Move down one level of list structure, forward. + +Control-Meta-E + runs the macro ^R End of DEFUN + Move to end of this or next DEFUN. + Leaves the mark behind, in case typed by accident. + With argument of 2, finds end of following DEFUN. + With argument of -1, finds end of previous DEFUN, etc. + A DEFUN is a list whose ( falls in column 0. + Its end is after the CRLF following its ). + +Control-Meta-F + runs the macro ^R Forward Sexp + Move forward past one S-expression (or several). + +Control-Meta-G + runs the macro ^R Format Code + Calls Grind Sexp or MACSYMA Grind depending on the current MODE. + +Control-Meta-H + runs the macro ^R Mark Defun + Put point and mark around this DEFUN (or next). + +Control-Meta-I + runs the macro ^R Indent for LISP + Indent this line to make ground LISP code. + At column QLISP Wrap Column (default infinite) we wrap around + to column 1 (not 0!). When you go down a level in list structure, + if QLISP Indent Offset is zero, we indent under the first argument; + if it is nonzero, we indent that many columns past the (. + A pre-comma arg means return the appropriate indentation level + but don't actually change the indentation, and don't treat ;;; comments + specially. + +Control-Meta-K + runs the macro ^R Kill Sexp + Kill next s-expression. + +Control-Meta-M + runs the macro ^R Back to Indentation + Move to end of this line's indentation. + +Control-Meta-N + runs the macro ^R Forward List + Move forward past one list (or several). + +Control-Meta-O + runs the macro ^R Split Line + Move rest of this line vertically down. + Inserts a CRLF, and then enough tabs/spaces so that + what had been the rest of the current line is indented as much as + it had been. Point does not move, except to skip over indentation + that originally followed it. + With argument, makes extra blank lines in between. + +Control-Meta-P + runs the macro ^R Backward List + Move backward past one list (or several). + +Control-Meta-Q + runs the macro ^R Indent SEXP + Lisp Indent all lines containing the next s-expr. + Used when full grinding is not desirable. + A numeric argument temporarily sets LISP Indent Offset. + A pre-comma argument means indent this line and all + remaining lines up to Z (used by Tab as subroutine). + +Control-Meta-R + runs the macro ^R Reposition Window + Reposition screen window appropriately. + Tries to get all of current paragraph, defun, etc. on screen. + Never moves the pointer; only wins if FS %TOP and FS %BOTTOM are zero. + +Control-Meta-S + is undefined. + +Control-Meta-T + runs the macro ^R Exchange Sexps + Interchange the S-expressions before and after the cursor. + With a positive argument it interchanges the S-expressions before and + after the cursor, moves right, and repeats the specified number of + times, dragging the S-expression to the left of the cursor right. With a + negative argument, it interchanges the two S-expressions to the left of + the cursor, moves between them, and repeats the specified number of + times, exactly undoing the positive argument form. With a zero + argument, it interchanges the S-expressions at point and mark. + +Control-Meta-U + runs the macro ^R Backward Up List + Move up one level of list structure, backward. + +Control-Meta-V + runs the macro ^R Scroll Other Window + Scroll other window up several lines. + Specify the number as a numeric argument, negative for down. + The default is a whole screenful up. Just Meta-Minus as argument + means scroll a whole screenful down. + +Control-Meta-W + runs the macro ^R Append Next Kill + Make following kill commands append to last batch. + Thus, ^K^K, cursor motion, this command, and ^K^K, + generate one block of killed stuff, containing two lines. + +Control-Meta-X + runs the macro ^R MM Via Minibuffer + Minibuffer with "MM" already there. + Any numeric argument is passed on to the MM command. + +Control-Meta-Y + is undefined. + +Control-Meta-Z + exits from ^R mode. + +Control-Meta-[ + runs the macro ^R Beginning of DEFUN + Move to beginning of this or previous DEFUN. + Leaves the mark behind, in case typed by accident. + With a negative argument, moves forward to the beginning of a DEFUN. + The beginning of a DEFUN is any ( in column 0. + +Control-Meta-\ + runs the macro ^R Indent Region + Indent all lines between point and mark. + With argument, indents each line to exactly that column. + A line is processed if its first character is in the region. + The mark is left after the last line processed. + May be given a subroutine to use on each line instead of + indenting by making the subroutine a prefix arg before a + comma. The subroutine should not move down a line. It can + expect MM & Indent to be in QK. + +Control-Meta-] + runs the macro ^R End of DEFUN + Move to end of this or next DEFUN. + Leaves the mark behind, in case typed by accident. + With argument of 2, finds end of following DEFUN. + With argument of -1, finds end of previous DEFUN, etc. + A DEFUN is a list whose ( falls in column 0. + Its end is after the CRLF following its ). + +Control-Meta-^ + runs the macro ^R Delete Indentation + Kill CRLF and indentation at front of line. + Leaves one space in place of them. With argument, + moves down one line first (killing CRLF after current line). + +Control-Meta-` + is undefined. + +Control-Meta-{ + is undefined. + +Control-Meta-| + is undefined. + +Control-Meta-} + is undefined. + +Control-Meta-~ + is undefined. + +Control-Meta-Rubout + runs the macro ^R Backward Kill Sexp + Kill last s-expression. + + + +Commands in file EMACS: + +List Commands + C List all user commands. + Lists all macros of class "C", intended to be called directly + by the user with MM. Other macros include subroutines (class S) + and ^R command definitions (class "^R"). Use List Subroutines + and List ^R Commands to see their names. + +List Subroutines + C List all subroutines + (Macros intended mainly to be called by other macros). + Subroutines are identified by having class "S ". + Most subroutines have names starting with "& ". + +List ^R Commands + C List macros intended to be ^R-commands + (whether or not they are actually put on any character now). + They are macros of class "^R " (says their documentation). + +Apropos + C MM AproposFOO Lists macros with names containing FOO. + Spaces around the argument are NOT ignored - they must be matched + by spaces in the macro name. + QMM ... variables which match FOO are also listed. + +Where Is + C List the ^R characters that run a given macro. + MM Where Is ^R Forward Word will tell which character + moves forward one word. You can supply the macro as a + numeric arg instead of the name as a string arg. + +Info + C Read documentation files. + Do MM Info and it will take over from there. + When you exit, your place is remembered for when you re-enter. + Non-null string arg is pathname made out of Menu item names + separated by spaces. + +List One File + C List the macros in one file (all classes). + The file name should be a string argument. + Example: MMList One FileEMACS. + +List Loaded Libraries + C List all loaded libraries' names. + +List Variables + C List names and values of all variables. + Variables are referenced as q-registers (as in QFoo) once + they have been created using mm Make Variable. + Given a buffer as an argument, we insert the list into it. + Given a string pointer as an argument, we list only variables + whose names (or values, as printed) include that string. + Any arg inhibits the initial header and the final extra CRLF. + A nonzero precomma arg says consider only vars whose names start + with "MM ". + +Variable Apropos + C List variables with names containing string arg. + Actually, matches are determined by what MM List Variables$ produces, + so if, e.g., an $MM ...$ variable is set to a command whose + name matches, that $MM...$ variable is listed. + +Describe Macro + C mmDescribeFOO describes macro FOO. + Prints the full name and full documentation of the specified macro, + The name of a variable can also be specified. + The macro to be described can also be given as a prefix arg, + as in M.MFOO MMDESCR. + +LISP Mode + C Set things up for editing LISP code. + Puts ^R Indent for LISP on Tab, puts tab-hacking rubout on Rubout. + Paragraphs are delimited only by blank lines. + +MIDAS Mode + C Set things up for editing MIDAS code. + C-M-N and C-M-P go to next and previous label. + C-M-A and C-M-E go to AC and EA fields, respectively. + C-M-D deletes next word and its terminator (eg, "FOO:"). + Paragraphs are delimited only by blank lines. + +TECO Mode + C Set things up for editing TECO code. + Makes Rubout the Tab-hacking Rubout. Tab does ^R Indent Nested. + Loads the PURIFY library. M-' and M-" move forward and back over conditionals. + +Text Mode + C Set things up for editing English text. + Puts ^R Tab to Tab Stop on Tab. + Makes Auto Fill not indent new lines; says there are no comments. + +Edit Tabular Text + C Temporarily set up for editing a table. + Makes Auto Fill indent the next line, + makes Tab be ^R Tab to Tab Stop. + +Edit Indented Text + C Temporarily set up for editing indented text. + Good when body of text is indented, but topics appear at the margin. + Tab is ^R Indent Relative; auto fill indents lines. + Paragraphs start only with blank lines. + +Fundamental Mode + C Return to EMACS's initial mode. + +Macsyma Mode + C Enter a mode for editing Macsyma code. + Modifies the delimiter dispatch, ..D, appropriate for Macsyma syntax, + puts special rubout on rubout, sets parameters for comment hackery, + and defines Tab to be ^R Indent Nested. + +MUDDLE Mode + C Enter a mode for editing MUDDLE code. + Modifies the delimiter dispatch, ..D, appropriate for MUDDLE syntax, + puts special rubout on rubout, sets parameters for comment hackery, + and defines Tab to be ^R Indent for LISP. + +PL1 Mode + C Set up to edit PL/1 code. + +Debug Mode + C Enter Teco macro debugging mode. + Reenter ^R with two windows where buffer appears in window 1, and current macro + level is in window 2. Meta-D gets minibuffer which is stepped through. + No arg splits screen in half; pos arg is line number to split screen at. + +Auto Fill Mode + C Turn Auto Fill mode on or off. + No arg or argument of 1 turns the mode on; + any other arg turns it off. + When it is on, lines are broken at the right margin + (position controlled by QFill Column) at spaces, + by doing a LF. + +Atom Word Mode + C Make word commands deal with LISP atoms. + With argument of 0, makes them not deal with LISP atoms. + The commands affected include ^R Forward Word, ^R Backward Word, + ^R Mark Word, ^R Kill Word, and ^R Backward Kill Word. + +Overwrite Mode + C Enters or leaves overwrite mode. + With argument of 1, or no argument, enters overwrite mode, + in which ordinary characters replace an existing character + instead of shoving the line over to the right. + In this mode, when you wish to insert without replacing, + Meta (non-control) characters insert the corresponding + un-metized characters. To get the normal (command) effect + of a Meta character, use the Metizer. + With an argument of 0 or 4, goes back to the normal (Insert) mode. + With an argument of 16 or -1, enters overwrite mode + but Meta-characters remain commands. + +Indent Tabs Mode + C Enables or disables use of Tabs as indentation. + An argument of 1, or no argument, enables (that is also the default). + An explicit argument other than 1 disables. + +Replace String + C Replace one string with another, globally. + mmReplaceFOOBAR replaces each FOO after point with a BAR. + A numeric argument means replace only FOOs which are + surrounded by delimiter characters. Works by calling Query Replace + and pretending you typed a !. + +Query Replace + C Replace string, asking about each occurrence. + mm Query replaceFOOBAR displays the next FOO; you say what to do. + Space => replace it with BAR and show next FOO. + Rubout => don't replace, but show next FOO. + Comma => replace this FOO and show result, waiting for next command. + Period => replace this FOO and exit. Altmode => just exit. + ^ => return to site of previous FOO (actually, jump to mark). + ^W => kill this FOO and enter recursive ^R. + ^R => enter ^R mode recursively. ^L => redisplay screen. + Exclamation mark => replace all remaining FOOs without asking. + Any other character exits and is read again. + To restart Query Replace after exit, if it was done with a minibuffer, + or M-X, use C-X Altmode or run the minibuffer with an argument. + If QCase Replace is nonzero, BAR will be capitalized or all caps + if the FOO found was (but only if FOO is typed all lower case). + 1 MM Query ReplaceFOO... will replace only FOOs that are + bounded on both sides by delimiter characters (according to ..D). + 1,MM Query ReplaceFOOCommands executes Commands as TECO commands + to perform the replacement. The commands should return a pair of values + which delimit the range of the buffer changed. "H" is safe. + To include Altmodes in the commands, quote them with ^]'s. + The commands can use Q2 and Q4 without saving them. + +Keep Lines + C Delete all lines not containing specified string. + Covers from point to the end of the buffer. + Takes following string argument: mmKeep LinesFOO. + +Flush Lines + C Delete all lines containing specified string. + Covers from point to the end of the buffer. + Takes following string argument: mmFlush LinesFOO. + +Occur + C Displays text lines which contain a given string. + MM OccurFOO shows all following lines which contain FOO. + An arg means type lines before and after each occcurrence. + +How Many + C Counts occurrences of a pattern, after point. + The format is: MM HOW MANY + +Tabify + C Convert spaces after point to tabs. + Groups of more than two spaces which + could be transparently replaced with a tab are. + Numeric arg specifies tab stop spacing; default is 8. + +Untabify + C Converts all tabs after point to spaces. + Takes numeric arg saying how far apart tab stops are, + or assumes 8 columns apart as the default. + +@ TECO + C Make XGP listing of macros file. + Example: 73 MM@ TECOUSRCOM >20FG (notice that + 73 is the page height with the font 20FG). + 20FG and 73 are actually the defaults, so that + MM@ TECOUSRCOM is equivalent. Actually runs + @ TECO from the library EMACS;PURIFY :EJ. + +Tecdoc + C Look up information on Teco commands. + String arg is command, e.g. MM TecdocF^B or MM TecdocFS HPOS. + Represent a control character with a "^" not followed by a space. + The format of .INFO.;TECO ORDER is understood. Type "?" for help. + Actually runs the macro Tecdoc from the library EMACS;PURIFY :EJ. + +Count Lines + C Returns the number of lines in the buffer. + mmCount Lines= types the number. Given arguments, they + specify the range to be counted. + +Load Library + C Load a pure file of macros. + Takes filename as string arg; default FN2 is :EJ. + Tries both the specified (or home) directory and EMACS;. + Runs the library's & Setup macro if there is one, + unless Load Library was given an argument. + If a pre-comma argument is given, the variable FOO Library Filename + is created, for Dump Environment's use. + Returns a pointer to the file, for macros' sake. + +Run Library + C Run a library file macro. + MM Run Library runs the macro + named out of the library , + which is loaded temporarily (unless it is already in core). + If is null, "" is used. + +Kill Libraries + C Delete some loaded libraries from core. + Types the name and description of the library at the top of + the stack, and asks whether to kill it. If you say yes, + kills it, and asks about the next library, and so on. + +List Library + C List contents of (not loaded) file of macros. + Specify the filename as a string argument. The file is + loaded in, listed, and then flushed from core. + +DIRED + C Edit a directory. Runs & DIRED from EMACS;DIRED :EJ. + +Reap File + C Delete old versions of a file. + Takes one or more string arguments, each containing a + filespec. Each filespec is processed individually. + A null argument ends processing, but if the first is + null then the default file is processed. + Only files with a numeric FN2 are deleted. + The number of versions kept is the numeric argument, + or QFile Versions Kept if no argument (usually 2). + If there are more than that many versions, you are told + about the excess and asked whether to delete them. + + In addition, if there is a file with FN2 = XGP, @XGP, + MEMO, or UNFASL, you are asked whether to delete it too. + +Clean Directory + C Clean garbage out of a directory. + Takes the directory name (with semicolon) as a string argument. + For each FN1 in the directory, does MM Reap File (essentially), + which offers to delete any excess old versions. + A numeric argument is passed on to Reap File. + +Compare Directories + C Compare directories on different ITS machines. + Calls ^R on a "merged" listing of the two directories. + Takes string argument that should contain the name of the directory + to compare, the name of the foreign machine (as a device name), + and (optionally) a switch: /W, /S, /D or /L. + /W (the default) means show Whole dir (all files). + /S means show all files that are the Same in the two dirs. + /D means show all files that Differ. + /L means show only Last file for given FN1-machine pair. + Example: MM Compare Directories MC:LISP;/S. + +Kill Variable + C Undefines a variable. + mmKill VariableFOO removes FOO's definition. + +Make Variable + C Creates a variable (accessible via Qname). + After doing mm Make VariableFoo, you can do qFoo. + A numeric arg sets the variable; otherwise, it is set to 0. + +Set Variable Comment + C Puts a comment on a variable. + Format: MM Set Variable CommentFOOThis variable is a test. + The comment string goes in the third word of the three words + in ..Q used by each variable. + A numeric argument, if any, is used to set the variable. + +Alter Options + C ^R-mode editor of permanent options. + Displays a table of the variables which are options, + and their values, and puts you in ^R mode. + A variable is an option if its comment starts with "*" or "!*". + When you hit altmode and leave ^R, the values are updated. + +List Files + C Brief directory listing. + Lists directory N entries to a line, with the following + special characters to the left of the filenames: + : this is a link + ! this file has not been backed up to tape yet + * this file has really been deleted but not yet + closed, or is otherwise locked. + (blank) this is a plain normal file + Also the top line contains in order, the device being + listed from, the directory, Free: followed by the number of + free blocks on the device, Used: followed by the number of + blocks this directory is taking up. + +List All Directory Names + C List names of all disk directories. + +RMAIL + C Read mail. Look under RMAIL with INFO. + Takes RMAIL command string as string argument. + To use the defaults, give a null command string, + as MM RMAIL. To specify an RMAIL file name, + $ is an easier alternative to . + After exiting RMAIL temporarily with ^X, MM RMAIL + (null argument) will re-enter it, and a non-null + argument to MM RMAIL is not allowed. + +Mail + C Mail a message, with RMAIL's M option. + Lets you edit a message with ^R, then send it when you + exit the ^R. Use ^G to abort the message, after which + MM Mail with an argument will re-enter. Put the text + of the message after the line which says + --Text follows this line--. Before that line can go only + header items, like the "From:" that is provided for you. + +EDIT ..D + C Delimiter table editor. + String arg is Q-register to edit. Default is ..D. + Response to "Character:" is ^G to quit, ^Q to quote, + Altmode to leave the macro, or character whose entry to edit. + When editing a character's entry, you are in overwrite mode, + and Altmode exits (you will be asked for another character). + First char in delimiter table is space for delimiter, or A. + Second is space, (, ), /, |, ', or A for lisp syntax. + +Make Dispatch String + C Create a dispatch string for ..D, F^A, etc. + First string arg should be the default entry for chars not + otherwise specified. Each following arg specifies one character; + it should contain the character and up to 5 characters of entry. + A null argument ends the call. Example: + MM Make DispatchAA: ,  makes each entry "AA " + except those for Colon and Comma, which are made " ". + The resulting dispatch string is returned as a value. + +View Q-Register + C Type out contents of any type Q Reg. + String arg is name of the Q-register or variable. + The interpretation as a Q-register name takes priority + if either one would be possible. + +View Buffer + C View the buffer with --More-- processing. + Starting from point, each space you type shows you another screenfull. + Particularly useful on fast pseudo display terminals like Tektronix. + Flushing the --More-- with ^C leaves you centered in the current + window. + +View File + C View a file sequentially on the screen. + Type space to see the next screenful. Anything else exits. + +Get Date + C Insert the current time and date after point. + A date in FS IF CDATE format can be given as a numeric + argument, to use instead of the current date. + The mark is put after the inserted text, and the region + inserted is returned so you can put this on a ^R character. + +Visit Tag Table + C Select a tag table file. + A tag table file is an index to the "tags" (labels, functions, etc.) + in one or more files of code, and allows the use of + ^R Find Tag to go directly to any one of them. + See also the TAGS program which makes tag table files. + A numeric argument sets QTags Find File, which if nonzero + makes TAGS switch files using separate buffers. + +TXJ + C Runs the TECO XGP Justifier program. + Not released yet. Will eventually be documented under INFO. + +Dissociated Press + C Print interesting random text based on text in buffer. + Arg is number of words of continuity at jumps, + or minus number of characters of continuity. + +Compile + C Recompile the file you are visiting. + We first offere to write out each file, unless there is a numeric arg. + A string arg is used to specify extra switches -- it may be null. + Just how depends on the major mode, or can be overridden + by defining the variable Compile Command to be a TECO macro + which should do the work. Files can define that variable locally. + Major modes not built in can also set it. Compile Command + can find the visited file name in Q1 and also as the default filenames. + It MUST end in a ^\, as there will be things on the stack. + +View Mail + C Read your own or other user's mail file. + User name is string argument; null means your own. + +Edit Tab Stops + C Call ^R to edit the buffer defining tab stops. + The second line has spaces except at the tab stop columns. + A colon indicates a tab stop to be filled to with indentation; + a period indicates a tab stop to be filled to by copying the + characters from the first line above the horizontal positions + to be filled. Uses a recursive ^R, in which Overwrite Mode is set. + +Grind Sexp + C Grind the sexp after the pointer. + Uses QMiser Column to decide where to start using + "Miser" format, and QFill Column as the page width + to aim for. + +Grind MACSYMA Code + C Format (indent) MACYSMA code. + When called from ^R mode it grinds from . to , unless it + is given an argument in which case it does the command the cursor is + in. When called from regular TECO it the whole buffer if + given no argument or MACSYMA commands after the . if given + an argument + +Visit File + C Read in a file, filing out previous file. + File name is string argument. Nonzero numeric arg + inhibits auto-saving until next Visit File. + Example: MM Visit File .TECO.;TECORD >. + A pre-comma argument sets QInhibit Write. + We execute Visit File Hook if it is nonzero. + All visiting of files is by means of this command. + +Find File + C Visit a file in its own buffer. + If the file is already in some buffer, select that buffer. + Otherwise, make a buffer named after the file's FN1 and + visit the file there. + If that buffer name is already in use, ask the user + for a name to use instead (it's legal to specify the same one). + A nonzero argument inhibits auto save for a newly loaded file. + We use QFind File Inhibit Write to set up QInhibit Write + for files not previously in core. + +Revert File + C Undo changes to a file. + Reads back the file being edited from disk + (or the most recent save file, if that isn't the same thing). + +Write Region + C Write region to file. + Specify filenames with a suffix string argument. + Two numeric arguments may be used to specify the region, + which othersie is from point to mark. + +Write File + C Change buffer filenames and write out. + Follow by filename as string argument. "1," says called by ^X^S; + inhibits calling & Set Mode Line and auto-save reinitialization. + Also inhibits setting filenames (in case they are _^RSV). + "-1," as argument inhibits updating the buffer's file cdate as well. + If not at top level (can't switch files now), + doesn't update anything about the current buffer, + but does return the written file's creation date so the caller can store it. + +Set Visited Filename + C Change visited filename, without writing file. + What EMACS believes to be the name of the visited file + is set from a string argument. No file's name is actually changed. + +Insert File + C Read file, inserting within existing text. + File name is string argument. Example: MM Insert FileFOO BAR. + The pointer is left at the beginning, and the mark at the end. + +Append to File + C Append region to end of specified file. + The range to write can also be specified with numeric args. + +Prepend to File + C Append region to start of specified file. + The range to write can also be specified with numeric args. + +Auto Save Mode + C Turn auto save on or off immediately on current file. + (The default for newly visited files is QAuto Save Default.) + Zero as argument => auto save mode is turned off. + Otherwise, arg is number of versions to keep around. + No arg => use the default. + A pre-comma arg is the number of characters + between auto saves, default 250. + +Make Prefix Character + C Make definition for a ^R command prefix. + Takes as string arg the name of a q-register, and + returns a consed up macro which, when run, will + use the common prefix-handler in q-reg .P + to dispatch through the q-vector assumed to be + in the specified q-reg. Also puts a suitable q-vector + in that q-reg if it contains 0. In that case, a numeric arg + specifies the length of the q-vector (default is 96). + Example: MMMAKE PREFIX CHARACTER.X U.^RX + makes ^X a prefix character with dispatch table in Q.X. + +Backtrace + C View the frames on the macro-pdl. + Displays one invoked macro, copied into a buffer, + with point at the PC. Then reads a command character: + Linefeed or D goes down the stack (to earlier invocations), + ^ or U goes up to more recent invocations, + ^R calls ^R on what you see, ^L clears the screen, + B calls ^R on the buffer that was being edited, + V displays a q-register's contents, +  runs a minibuffer, X runs MM command, Q exits. + C continues erring function. + +Top Level + C Return to the toplevel ^R loop or to TECO. + With no arg, returns to the toplevel ^R loop. + With an arg, returns to TECO's command level. + +Select Buffer + C Select or create buffer, given its name. + If called from a ^R character, read the buffer name from the terminal + or should be given a buffer number as a numeric arg. + As a subroutine, needs a buffer number (or buffer name pointer) as a + prefix arg, or a buffer name as a string arg. + If there is a buffer with that name, it is selected. + Otherwise, a buffer with that name is created and selected. + When a new buffer is selected the first time, if QBuffer Creation Hook + is nonzero, it is run after the buffer is selected. + +List Buffers + C List numbers, names, files and modes of all buffers. + +List Locals + C List a specific buffer's local variables' names. + Takes name of buffer as a string argument. + Default is current buffer. + +Kill Buffer + C Kill the buffer with specified name. + Takes name as a string (suffix) argument, or reads it from terminal. + Alternatively, the name (as string pointer) or the buffer + number may be given as a prefix argument. + If the buffer has changes in it, we offer to write it out. + +Make Local Variable + C Make a variable local to the current buffer. + Its local value starts off the same as its global value. + Example: M.LFoo Variable (since this macro lives in .L). + "1," as arg means assume that the local doesn't exist yet. + +Make Local Q-register + C Make a q-register local to the current buffer. + String argument should be name of q-register, as in "A" or ".^RA". + "1," as arg means assume that the local doesn't exist yet. + +Kill Local Variable + C Kill one of the current buffer's local variables. + The global value is restored. + +Kill Local Q-register + C Kill one of the current buffer's local q-registers. + The global value is restored. + +Save All Files + C Offers to write back buffers which may need it. + For each buffer which is visiting a file and which + has been written, you are asked whether to save it. + A numeric arg means don't ask; save everything. + +Kill Some Buffers + C Offers to kill each buffer, one by one. + If the buffer contains a modified file and you say to kill it, + you are asked whether to write the file out first. + +Rename Buffer + C Change the name of the current buffer. + New name is suffix string arg; empty defaults to FN1 of visited file. + + + +Commands in file TAGS: + +Find Tag + C Visit a tag (string argument). + Jump to the definition of the tag, switching files if necessary. + A string pointer to the tag name may be given as a + prefix arg. A precomma arg says look for a second occurrence + of the tag (search tag table from previous tag, not beginning) + +? Save Tag Table + C Write out the tag table if it has been changed. + +Next File + C Select the next file in the tags table. + Each of the files described by the selected tags table + is visited one by one if you repeat this macro. + With an argument, we visit the first file in the tag table. + Other macros should call using a comma'd argument ("1,"). + Then we return -1 if successful, or 0 if there were no + more files (instead of err'ing). + +Tags Search + C Search through all files in a Tags file. + Sets up Control-. to continue the search to the next + occurance of the string through all the files in the current + tags table. If no more files left, beeps and returns to + original buffer. Example: MMTags Search$FOO$$ + +Tags Query Replace + C Query Replace through all files in a Tags file. + Takes two string arguments just like MM Query Replace. + Sets up Control-. to continue the Query Replace to the next + occurance of the string through all the files in the current + tags table, in case you exit the Query Replace before it is finished. + "!" means replace all the remaining instances in the current file only. + If no more files left, beeps and returns to the original buffer. + +Tags File List + C Insert in the buffer a list of all files. + The list comes from the currently-visited tags file, and is + sorted alphabetically. + +List Tags + C List all tags in current or specified file. + Specify file with a string arg. All files in the tag table + which contain that argument string will be listed. + +Tags Apropos + C List all known tags whose names contain STRINGARG. + MM Tags Apropos$ knows about the following languages: + TECO, PALX, LISP, MIDAS, FAIL, MUDDLE, MACSYMA, TJ6, R. + +Tags Rescan + C Recompute the tag table and reload it. + +Args + C Print the comments before a tag. + Usually this will describe a subroutine and its arguments and results. + + + +Commands in file TMACS: + +Save Trees + C Compress a listing with form feeds. + Replaces some ^L's in buffer by 4 blank lines, in an attempt + to fill all pages. Page length is an optional numeric + argument. + +Stat + C Print mean and variance for command exec times. + String arg is command to execute. + Num arg is number of times to repeat execution. + Mean is in ms, variance in ms-squared. + +List Buffers + C List numbers, names, files and modes of all buffers. + +Directory Lister + C List directory neater than EY. + Lines things up and doesn't print create time, just date. + +Multeco Mode + C Set up for editing Multics Teco macros. + Calls regular TECO MODE, then sets space-indenters so that no + tabs are used for indenting. + +Type Mailing List + C Prints entry for STRINGARG in .MAIL.;NAMES. + If STRINGARG is of form @, :.MAIL.;NAMES is used. + Only final @ indicates site, so you can do something like: + MM Type Mailing List$BUG-@@AI$ + A numeric ARG limits depth of recursion on EQV-LIST members. + (Default depth is 3.) + @ entries in EQV-LIST are not followed. + Prints "Done." when done, since it sometimes is slow. + +Flush Variables + C Flush any variables with names matching STRINGARG. + The list to be flushed is typed, asking Y, N, or ^R? + N means abort, ^R allows editing of the list. + +Abbrev + C Define or delete MM abbreviations. + MM Abbrev$IF$Insert File$ will define MM IF$ to be MM Insert File$, + evaluating the name now to a pointer. Thus the abbrev IF can be used + as string arguments, e.g. MM Decsribe$IF$. + 1 MM Abbrev$IF$Insert File$ will define MM IF$, but evaluated each time + MM IF$ is used, so that if a new Insert File is created or loaded, + that one will be used. However, IF cannot be used as string arguments. + 0MM Abbrev$IF$ and + -MM Abbrev$IF$ will remove defn for MM IF$. + +SRMail + C Summarize new mail and call RMAIL or other mail-reader. + The RMAIL library is used unless the variable $Mail Reader$ contains a + string naming the library to use. That library must provide the + following functions compatible with RMAIL: + # B take a NUMARG and summarize that many messages. + take a string argument and read that mail. + Also, the old-mail file must be of the form , and + RMAIL's convention about *APPEND* is followed. + If there is NO new mail, and the variable SRMAIL No New Mail Query Exit + is non-0, asks whether to exit or read mail. + Any string arg is passed to the mail-reading command. + Summarizing happens only if there is no string arg, i.e. you're reading + your mail in the normal way. + +Read Mail + C Read mail using RMAIL or some other mail-reader. + If $Mail Reader$ exists, it is a string naming the mail-reader library. + The default is RMAIL. (See topic RMAIL in INFO.) + Passes a string argument to the mail-reader. + (Calls "" in the mail-reader library.) + Good for re-entering after exiting RMAIL or Babyl with ^X. + +Send Mail + C Send mail in ^R mode using RMAIL or some other mail program. + If $Mail Reader$ exists, it is a string naming the mail library. + Default is RMAIL. Calls # R, whose arguments must match + RMAIL's convention. + Control-G aborts, Control-Meta-C finishes and sends the mail. + +Lock File + C "Lock" the file in the current buffer by creating FN1 *LOCKED*. + Will complain if FN1 *LOCKED* already exists, and will tell who has it + locked (since FN1 *LOCKED* contains that person's xuname). + Fails the critical-race test. + This assumes that others will cooperate and use MM Lock File$ and + the matching MM Unlock File$. + +Unlock File + C "Unlock" file in buffer locked by MM Lock File. + +Graph Buffer + C Call ^R Buffer Graph to show schematic of buffer. + +List unused ^R characters + C List unused control, meta, and control-meta characters + +Nowhere Links + C Enters recursive ^R on links to nonexistant files + String argument is directory name (should end with semicolon). + +=Abbrev + C Define or delete MM abbreviations. + MM =Abbrev$IF$Insert File$ will define MM IF = Insert File$ + to be MM Insert File$, evaluated by name each time + MM IF$ is used. Thus if a new Insert File is created or loaded, + that one will be used. + 1MM =Abbrev$... means don't check the MM-name for validity, and don't print + what the defined abbrev is. (For init files.) + 0MM =Abbrev$IF$ and + -MM =Abbrev$IF$ will remove definition for MM IF$. + +Which EMACS History List? + C Print information about mailing lists. + For people who can't keep the EMACS History mailing lists straight. + Types out information concerning the structure of the lists. + +0 + C Does nothing, returns nothing... + ...but is good for something: + If you want to give some Teco commands from the bottom of the screen, + you can call ^R Execute Completed MM Command (or any such "Meta-X"). + + + +Commands in file SLOWLY: + + + +Commands in file WORDAB: + +WORDAB + C MM WORDAB$$ is the same as MM Word Abbrev Mode$$. + I.e. Turn Word Abbrev Mode on or off. + No argument or non-zero argument turns the mode on, + 0 argument turns the mode off. + +Word Abbrev Mode + C Mode for expanding word-abbrevs. + No arg or non-zero arg sets the mode, $Word Abbrev Mode$. + 0 arg clears the mode. + Runs $Word Abbrev Hook$ if any, with arg of new mode setting. If none, + it does: + ^X ^A runs ^R Add Mode Word Abbrev, + ^X + runs ^R Add Global Word Abbrev, + M-' runs ^R Word Abbrev Prefix Mark, + C-M-Space runs ^R Abbrev Expand Only, and + ^XU runs ^R Unexpand Last Word. + Each of the following chars: + ~@#;$%^&*()-_=+[]\|:'`"{},<.>/?, Space, Return, Excl + will run ^R Abbrev Expand And Self-Insert, or ^R Abbrev Expand And Call Old + Char. + Tab runs ^R Abbrev Expand for Tab. + +Define Word Abbrevs + C Define word abbrevs from buffer. + Format of buffer: + ::= null | + ::= : " " + ::= + ::= null | ( ) + ::= null | + For now nothing else, no :s in . + is the name of a major mode (e.g. LISP), if abbrev is to be + effective only in that mode. It is ommitted if the abbrev is to be + effective in all modes. + is a usage-count for the abbrev -- i.e. how many times the + abbrev has been used before. + is any number (including 0) of spaces and tabs. + In addition to the above, if the buffer contains the string: + ^_INACTIVE WORD ABBREV DEFINITIONS: + then every abbrev definition after that is ignored. + +List Word Abbrevs + C List abbrevs and their expansions. + See documentation on Insert Word Abbrevs for details. + +Insert Word Abbrevs + C Insert abbrevs defined and their expansions. + Format is acceptable to MM Define Word Abbrevs$. + Global abbrev "ab" is defined by $X ab * Abbrev$ set to abbrev string. + Mode abbrev "ab" for mode "modenm" is defined by $X ab modenm Abbrev$ + set to abbrev string. + +Make Word Abbrev + C Make first string argument expand to second one. + After doing MM Make Word Abbrev$foo$find outer otter$$, typing "foo" will + automatically expand to "find outer otter". + 3rd string argument, if any, is the mode for the abbrev. + No 3rd string argument means use the current mode. + 3rd string argument = "*" means this make a global abbrev. + This command defines just one abbrev, as compared to Define Word + Abbrevs which defines several abbrevs from a list in the buffer. + Make Word Abbrev is also more restrictive in what the expansion can + be since the expansion cannot contain altmodes or ^]s. + +Kill All Word Abbrevs + C No word abbrevs are defined after this. + For use in conjunction with editing what MM Insert Word Abbrevs$ inserts, + and then after MM Kill All...$, doing MM Define Word Abbrevs$. + +Edit Word Abbrevs + C Go into ^R mode, editing word abbrev definitions. + The buffer is initialized by MM Insert Word Abbrevs$. + ^R mode is entered. When exited normally, (e.g. by ^C^C) the buffer will + be considered as new definitions of word abbrevs. I.e. after ^C^C: + 1. MM Kill All Word Abbrevs$ is done, removing old abbrevs, then + 2. MM Define Word Abbrevs$ is done, defining abbrevs as edited. + ^G will abort MM Edit Word Abbrevs, leaving word abbrevs untouched. + +Write Word Abbrev File + C Write definitions of current word abbrevs. + String argument specifies filename. Default is last used, + initially set to WORDAB DEFNS. + The file written can be used by MM Read Word Abbrev File$ to set up + the current abbrevs in another EMACS. + +Read Word Abbrev File + C Read definitions of word abbrevs and define. + String argument specifies filename. Default is last used, initially set + to WORDAB DEFNS. + A word abbrev definition file can be made by MM Write Word Abbrev File$. + Abbrevs are defined as specified by the file. Note that the definitions + are merged with the old ones. + +Sort Word Abbrevs + C Sort a word abbrev list in the buffer by count. + The most-frequently used abbrevs appear at the top of the list. + + + +Commands in file PICTUR: + +Edit Picture + C Enter a mode for editing a picture in the buffer. + The picture should be between point and mark, to begin with. + Edit Picture inserts spaces to pad out to the margin, then enters + a special mode in which these characters are redefined: + Rubout turns characters into spaces rather than deleting them. + Ordinary characters replace instead of inserting. + Return moves to the beginning of the next line. + Linefeed is like M-M followed by C-N. + C-O makes one or more new lines full of spaces after point. + When you exit the recursive ^R, the excess spaces are removed. + +Strip Picture + C Remove trailing spaces from picture. + Removes trailing spaces from all lines between point and mark. + Alternatively, a range may be specified with two numeric arguments. + +Pad Picture + C Pad lines with trailing spaces to screen width. + Adds enough trailing spaces to each line between point and mark. + + + +Commands in file ABSTR: + +Abstract File + C Make an abstract of some of the macros in a file. + Takes three string arguments: a name prefix, a documentation prefix, + and a library file spec. The name prefix and documentation prefixes + are used to filter the macros in the file: only if its name starts + with the name prefix and its documentation with the doc prefix will + a macro be listed. The filespec may also be the library name of a + currently loaded file, as printed by MM List Loaded Files. + +Abstract Variables + C Insert names, values and comments of all variables. + +Abstract Redefinitions + C List all ^R commands redefined. + +Wall Chart + C Make a wall chart describing ^R commands. + A wall chart is a list of ^R command characters, in alphabetical + order, with the names of the macros they run. To cause prefix + characters to be included in the wall chart, mention each prefix + character in a string argument, as a ^R-command q-reg name + such as .^RX for ^X. A null string argument ends the list. + + + +Commands in file PURIFY: + +& Compress File + C Compress file of macros. + Input file taken as string argument. Output is written + in file with FN2 of COMPRS. If the COMPRS file already + exists and is more recent, the operation is skipped + (however an explicit numerical argument forces compilation anyway). + +TCompile + C Compile macro to be tried out. + Process the buffer (or current page of it) like MM Compress File, + then put the result into the Q-register given as a string arg. + If the macro starts with a macro name, it will in addition + be put in QMM macro name. + +Generate Library + C Make one :EJ file from several source files. + Takes desired name for :EJ file as first string argument, + followed by the names of the input files. A null string argument + (altmode-altmode) ends the argument list. + The input files are all compressed (if they haven't been) + and the COMPRS files are then purified together. + Filename defaulting is sticky; + input FN2's default to >, output FN2's to :EJ. + The defaults are restored after the macro is finished. + +BARE Library Generate + C Generate the BARE library. Source file is string arg. + +Dump Environment + C Dump the current environment. + Takes filenames as suffix string argument. + The dumped environment is given a ..L which will load + the libraries which are loaded now, and then perform other + start-up actions as directed. + + The filenames to use to load the libraies currently loaded are + found in variables named name Library Filename, where + is the name of the library. If that variable is to include a + constant version numbr, it should be set up when the library is loaded. + Libraries which are loaded at dump time but do not possess such + variables will not be loaded by the environment which is dumped. + + The additional start-up actions come from the value of the variable + named "Startup", which is killed before dumping. + + Note that q-registers .1, .2, and .3 are clobbered by this macro. + They will be zero'd on startup by the dumped ..L. + + The file EMACS;.TECO. (INIT) is an example of an init file that + sets up things for use with this macro. + +@ TECO + C Make XGP listing of macros file. + Example: 73 MM@ TECOUSRCOM >20FG (notice that + 73 is the page height with the font 20FG). + 20FG and 73 are actually the defaults, so that + MM@ TECOUSRCOM is equivalent. + +Tecdoc + C Look up information on Teco commands. + String arg is command, e.g. MM TecdocF^B or MM TecdocFS HPOS. + Represent a control character with a "^" not followed by a space. + Spaces elsewhere are ignored. + The format of INFO;TECORD is understood. Type "?" for help. + +List TECO FS Flags + C List names of all TECO FS flags. + + diff --git a/src/e142/emacs.old b/src/e142/emacs.old new file mode 100644 index 00000000..769cfed0 --- /dev/null +++ b/src/e142/emacs.old @@ -0,0 +1,238 @@ +This is the file EMACS.NEWS. It contains news about EMACS, +recent news first. If you have anything you want to add, use the +Post EMACS News command in the ENEWS library. + +Format of this file is ^A^B^C^DMessage^E + +05/23/79 14:55:24RUBENSTEINPAGE library screwing up INFOThe PAGE library shouldn't be screwing up INFO any more. The problem +was a complex one, based on the fact that PAGE's visit file hook +didn't end with a ^\, so id didn't pop the q-register stack, which +was pushed by Visit File, so & Info Select Node's q-registers were +still on the stack when Visit File returned. Anyway, it should +work fine now... + +Stew +04/21/79 23:32:55RUBENSTEINEMACS 133EMACS 133 is now the default version of EMACS. You can still get +EMACS 131 for a little while by running OEMACS + +Stew +04/21/79 23:31:25RUBENSTEINFind File Inhibit WriteThis variable is used to determine whether you like ^X ^F, ^X ^V or +^X ^E as your default file-visiting command. It is used by ^X ^F +to determine which method to use, and it is also used to determine +how to read in a file requested by the exec EDIT command. If you like +^X ^E, do 0U$Find File Inhibit Write$ in your init file. ^X ^V and +^X ^R are 1 and -1, respectively. + +Stew +04/14/79 16:39:42RUBENSTEINEMACS version 133Changes in EMACS version 133: + +*) The self documentation features now know about names for the +built-in TECO ^R command definitions. For example, Apropos of "Line" +will now show ^R Open Line on C-O. You can't actually call those +commands by those names, unless you load the library BARE; this +library is temporarily loaded by the documentation commands that need +it. MM& Load BARE loads BARE and causes BARE to remain loaded until +its caller returns. + +*) C-U C-Y differs from plain C-Y in that it leaves point before +the un-killed text and the mark after. + +*) C-U C-L causes the line point is on to be redisplayed. +Actual numeric arguments (not just C-U) still specify +a line to display point on. + +*) C-; and M-; (^R Indent for Comment) now inserts the comment +terminator as well as the comment starter, leaving point in between +them. M-N and M-P (^R Down Comment Line, and .. Up ..), have been +modified for this behavior. + +*) M-G and M-Q (^R Fill Paragraph and ^R Fill Region) now by default +remove excess spaces such as are produced by filling. + +*) Return now will not gobble a blank line followed by a nonblank +line. + +*) C-K will now treat a blank line as if it were empty, killing +through the CRLF instead of to it. More specifically, if point is +followed by a CRLF with only whitespace in between, C-K will kill +through the CRLF. + +*) M-[ and M-] (^R Backward Paragraph, and ... Forward ...), now treat +"\" at the front of a line just like "." and "-", for the sake of TEX +files. This special treatment is that if those characters are +declared (using QParagraph Delimiter) to start paragraphs, then +whenever a paragraph starts for that reason, that paragraph is only +one line long. + +*) You can now put MM Query Replace on a character. It will read its +arguments in the echo area. + +*) Errors in auto-saving will type out "(Auto Save Error!)". + +*) ^R Indent Nested (the definition of Tab in certain modes) now does +something useful with negative arguments. It indents the line more +than the previous line, (* (ABS ARGUMENT) (MAX 1 QIndent Increment)) +spaces more. QIndent Increment is not initially defined. + +*) There is now an autoloading definition for C-X ( which loads in +KBDMAC and transfers to it. People need no longer load KBDMAC in +their init files. You will now see "Def" in the mode line while +defining a keyboard macro. + +*) Exiting from the top-level ^R invocation now returns to EMACS's +superior. To exit from it back to TECO command level, do +1MM Top Level. This will advise you to re-enter ^R mode by doing +:M..L. Returning to the superior will now clear out the mode line +completely. + +*) Creating a new buffer initializes it in the same mode as the +previous selected buffer. This uses the new @F^G command in TECO. + +*) Making variables like QAuto Fill Mode local now works +straightforwardly; it is no longer necessary to deal with the crock +Switch Modes Process Options, which no longer exists. These variables +have been equipped with macros which are run whenever their values +change. Thus, simply doing 1UAuto Fill Mode is enough to turn on +the mode. MM & Process Options no longer exists. A side effect of +this is that buffer switching is much faster. This uses the new +FS VAR MACRO feature of TECO. QProcess Options Hook no longer +exists; instead, you must make macros to be run when your variables' +values change. This will be documented in CONV later. + +*) Instead of calling MM & Set Mode Line, macros should simply do +1FS Mode Change, which will cause MM & Set Mode Line to be called +when the mode line comes up for redisplay. Thus, multiple reasons for +calling it will not cause it to be called more than once. +QSet Mode Line Hook still exists and works as before. + +04/02/79 15:07:56USECSA request fo a new featureWould it be possible to have a command to fork a new EXEC from emacs? + Michael Toy +03/30/79 11:58:37RUBENSTEINPDL overflows and other EMACS lossagesIf you get any of these, the best thing to do is save your core +image and then give the START command. This will cause EMACS +to re-initialize itself, but your buffers will still remain +intact -- you won't lose any work. Then send me a message +giving as many details as possible... + +Stew +03/30/79 11:54:13RUBENSTEIN^E "bug"C-E is redefined (in ALL modes) to do ^R Exchange Characters. This +used to be on C-T. To get end of line, use C-M->. If you want, a couple +of people have adopted the AI lab editor's convention of M-tab for +end of line and M-^L for beginning (or reversed, I don't remember. I +personally like to have those two commands self inserting, as they are +in vanilla EMACS. + +Stew +03/26/79 12:55:27USECSNews featureI vote to keep the news. It seems to be an effective way for +EMACS users to report bugs and also to find out about bugs that +others have caught. I don't really like the # hack, but it is +just a small irritation. I would rather have to invoke the news +manually instead of having the first character I type echo +incorrectly. + Michael Toy +03/25/79 22:14:06SCHOENanother bug +Beware of pushdown overflow...I got one when trying to get INFO +through the documentation package. + + Eric03/25/79 09:25:53SCHOEN^E bug +Watch out! At least in MIDAS mode, ^E doesn't go to the end of the line, +but splits the carriage return-linefeed sequence separating the current +line from the previous line around the first character of the current line, +like: + +start: reset + move 17,[iowd....] + becomes when ^E is typed on the second line: + +start: reset^Mm^Jove 17,[iowd....] + + + Eric03/20/79 22:54:36VANMELLEI second the motionThe users of this news facility so far are myself, SRISW, and +Rubenstein; of these, SRISW and I hate it -- what's wrong with BBD +anyway? If this feature is desirable, where are the users who like it? +I say flush it if there is no great clamor for it. + +SRISW's point about changing the system too often is also well taken. I +have no objection to people developing and advertising macro libraries +with new features. But changing the default system (in particular all +the nonsense that has been creeping into EMACS.INIT) without definite +user support is a bad idea. Publicize things and let people try them +optionally (e.g. let them put something in their init), but don't do it +in such a way that it is difficult or even impossible to avoid if the +user deems the feature undesirable. Poll the community and see what +they really want!!03/19/79 21:18:26SRISWEMACS changing too oftenIt would seem that SUMEX is having a problem with EMACS that other sites +on the network have experienced. Specifically, the maintainer, in +wanting to bring the most features and usefulness to the local EMACS, +changes it too often thus rendering the entire EMACS user community +angry and confused a great deal of the time. Let me suggest a simple +solution. I maintain EMACS at SRI-KL and SRI-KA, and when I want to make +a change or add a feature, I always send a note to the bulletin board +and wait for the response. If at least 90% of the people approve of the +change, then the new EMACS is generated and put on NEW:. If not, then +the change is simply not put in. I keep these changes to a bare minimum +and never take more than one poll a month. The results have been +graitfying and you might do well to implement your scheme in this manner, +including flushing this silly ENEWS frob. That is what bulletin boards +are for, and your BBD system certainly should carry all these notes. +Not some local software hack.03/19/79 10:59:31SCHOENI vote for consistency +Sorry for sounding like an ass, but I say EMACS should remain the same +for at least two days at a time.... + Eric +03/17/79 16:12:18VANMELLEFlush the news!I agree with srisw. This news system is superfluous. There already +exists a mechanism for communication among emacs users, viz. the +bulletin board (BBD). Interested users can put the EMACS topic on their +interest lists and use BBD or BBREAD to read them when they appear; +they can also POST notices of interest to others. + +Besides, I'd prefer not to add any more to the initial emacs startup +time, and certainly not for this news system. + + Bill03/17/79 12:59:48SRISWIll +I think this news frob is somewhat ill and slightly dumb. If +people want to send mail, they can do it with the mail system, +not some non-standard thing03/17/79 11:07:59RUBENSTEINKEYPAD library no longer loaded by defaultA few users have objected to the idea that Sumex-AIM EMACS be any +different from EMACS anywhere else, so I have decided to make +the default EMACS not load the KEYPAD library by default. It can +still, of course, be loaded with MM Load Library$KEYPAD$ either +from your INIT file or explicitly. + +I would appreciate hearing from users about this and other issues +(on either side)... There will be a message when EMACS starts up +to the effect that the KEYPAD lib is no longer loaded (unless you +happen to have 1M.VKEYPAD Inhibit$ in your init file!) for a few days. +Also, comments on the news facility would be appreciated. In fact, +use M-X Run Library$ENEWS$Post to post your opinions! + +Stew +03/15/79 02:44:40RUBENSTEINWhen is the KEYPAD library NOT loaded?The KEYPAD library is not loaded if + 1) You are not on a datamedia, or + 2) You make Q$KEYPAD Inhibit$ non-zero in your INIT file. + +Someone suggested to me that KEYPAD should NEVER be loaded by default +although those who wished to have it loaded could put it in their +INIT file. + +Comments, anyone? + +Stew + +P.S. In case I never mentioned it, part of my job is to write INIT +files at users request. If there's anything that you want loaded +automatically, or any command that you want redefined, let me know. +03/15/79 01:09:34RUBENSTEINEMACS News ServiceThe EMACS news file can be accessed via two commands in the +ENEWS library: + +Post EMACS News + This command will ask for a subject, then let you type + your news into a buffer. When you exit the recursive + EMACS with C-M-C, your news will be posted. + +Read EMACS News + This command enables you to read recent EMACS news. It types + the date, author, and subject of each news item, most recent + first, and asks you if you want to see the rest. If you + answer Y or , it types it at you and asks for the next. + If you answer N or , it asks about the next without + typing it. If you answer X or Q, it quits asking and returns. + +Try it! + \ No newline at end of file diff --git a/src/e142/emacs.timing b/src/e142/emacs.timing new file mode 100644 index 00000000..b190186d --- /dev/null +++ b/src/e142/emacs.timing @@ -0,0 +1,91 @@ +!* -*-TECO-*- *! +!* This is the default init file for EMACS. + Anything in the buffer when you start this + will be used instead of the JCL. + *! + 0[y 0[X + FTA qy ux FS Runtime uy qy-qx= + Q..9"E Q..LU..9' !* ..9 is what to run on the way out.! + !* Maybe same as ..L.! + + FQ(0FO..QAuto Save Filenames)-1"L + FS MSNAME:F6[0 + :I*DSK:0;Autosave > M.VAuto Save Filenames ]0' + + FS XJNAME :F6 [J + + FS MSNAME FS D SNAME !* Make connected dir default name! + QFind File Inhibit Write UInhibit Write + +!* On non-meta keyboards, allow Alt 1 2 to mean an arg of 12.! + FS %TOFCI"E + M.M ^R Autoarg[0 460.-1[1 + 10< Q0,%1^ FS ^R CMAC> Q0U..- + ]1 ]0' + + FTB qy ux FS Runtime uy qy-qx= +!* Process the JCL! + 0[0 0[1 + Z"E FJ' ZJ !* Get JCL, or use whatever previous init file left in buffer.! + ."N !* Process JCL command - extract filenames and commands! + 0,0A- +"E -D' !* REMOVE LF AT END IF ANY *! + J :S"N .,Z^ FX1 -D' !* IF COMMANDS TO EXECUTE, PUT THEM IN Q1! + HFX0' !* IF FILE TO BE READ, PUT NAME IN Q0! + ' + FS LISPT"N FS CCL FNAMU0 + 0FS SUPERIOR !* Dont try to suck in LISPT.! + 0U1 F~JSNDMSG"E M(M.M TEXT MODE)'' + + FTC qy ux FS Runtime uy qy-qx= + 1fs Echo Errors + 8FS HELP CHAR + HK FS Date FS FD Convert + 9J \ [4 [3 + HK + :I3 + FTD qy ux FS Runtime uy qy-qx= + FS Rgetty-1"E !* If it's a DM! + 0fo..qKEYPAD Inhibit "E !* and he has not inhibited it! + :I3Keypad  + M(M.MLoad Library)KEYPAD'' + FTE qy ux FS Runtime uy qy-qx= +! FS MSNAME[0 F=0RUBENSTEIN "N +! MMRUNRECORD' ]0 + FTF qy ux FS Runtime uy qy-qx= + Q0"E Q1"E !* If no commands / file to read, offer help.! + fs version :\ [2 + qEMACS Version:\[1 !* get version no. as string! + Q4-12 "L FTGood Morning.' + "# Q4-18 "L FTGood Afternoon.' + "# FTGood Evening.'' + FT +Sumex-AIM 3EMACS, version 1.2 - type ^H for help, # for news. + + FTG qy ux FS Runtime uy qy-qx= + EREMACS.NEWS + 12FS IF FDB FS FD Convert EC ET@ > + FTLast news written  HT HK FT + + FTH qy ux FS Runtime uy qy-qx= + :FI-#"E + FIW + M(M.MRun Library)ENEWSRead EMACS News' + ]1 ]2 + '' + FQ0-1"L Q1"N M1' !* No file specified => execute commands from JCL! + 0FS QP Unwind FTI qy ux FS Runtime uy qy-qx= :M..9' !* and enter ^R mode.! + + QInhibit Write,M(M.M Visit File)0 !* VISIT SPECIFIED FILE, USING ">' AS DEFAULT FN2! + FSLISPT"N F~JSNDMSG"N !* If called by EXEC EDIT command...! + QBuffer Filenames F[ DFILE + 0 FS DVERS !* Reset version number defaults.! + FS DFILE UBuffer Filenames + M(M.M& Set Mode Line) + F]D FILE'' + + Q1"N M1' !* If JCL held commands, execute them.! + f~JLISP"E M(M.MLoad Library)Intermacs !* if under a LISP then load Intermacs! + FS Exit' + +0FS QP Unwind :M..9 \ No newline at end of file diff --git a/src/e142/emacs.users b/src/e142/emacs.users new file mode 100644 index 00000000..3e840616 --- /dev/null +++ b/src/e142/emacs.users @@ -0,0 +1,28 @@ +Current EMACS users:Achenbach,Barr,Bennett,Bonnet,Brutlag,Gilmurray,JFinger, +Kennard,Rubenstein,Sacon,Schoen,Scott,Tajnai,Usecs,Vanmelle + +EMACS users list as of 3/16/79 + +Name # times first last + used time time +Achenbach 31 3/1 3/16 +Barr 28 3/12 3/16 +Bennett 24 3/1 3/16 +Bonnet 11 3/12 3/16 +Brutlag 31 3/1 3/16 +Clayton 1 3/16 3/16 +Cower 2 3/14 3/14 +Decsys 1 3/8 3/8 +Gilmurray 11 3/1 3/14 +Hedberg 1 2/28 2/28 +JFinger 43 3/2 3/15 +Kennard 1 3/16 3/16 +Rubenstein ***** ***** ***** +Sacon 7 3/14 3/16 +Schoen 23 3/11 3/16 +Scott 1 3/1 3/1 +Srisw 1 3/3 3/3 +Tajnai 2 3/16 3/16 +Usecs 158 3/2 3/16 +Vanmelle 47 3/2 3/15 +Yeager 3 3/8 3/13 diff --git a/src/e142/enews. b/src/e142/enews. new file mode 100644 index 00000000..bf333387 --- /dev/null +++ b/src/e142/enews. @@ -0,0 +1,54 @@ +!~Filename~:! !Macros relating to the EMACS news file! +ENEWS + +!Post EMACS News:! !C Post news in the EMACS news file +Asks for a subject, then gives you a buffer to type your news into.! + + 1,M(M.M&_ Read_ Line)Subject:_[0 + Q0"E ' + F[B Bind + F+ FTType_your_news.__Exit_with_C-M-C_(M-_C). + [..J :I..J Post_EMACS_News +  + [1 HFX1 + F[ D File + EREMACS.NEWS @Y + S -C + 1I FS Date FS FD Convert + 2I FS HSNAME [0 I0 ]0 + 3I G0 + 4I G1 + 5I + @:EWEMACS.NEWS HP :EF + @FT +Your_News_has_been_posted. + 1fs Echo Active +  + +!Read EMACS news:! !Prints out EMACS news. +Prints out subject, time, author for each news item and asks if the +user wants to see more.! + + F[ B Bind F[ D File [0 + ER EMACS.NEWS @Y + < :S; + FT +News_posted_ .,(S).-1t FT_by_ .,(.+1,(S).FC).-1t FT. +Subject:__ .,(S).-1T FT___Read_it?_ + FI :FC U0 + FT0 + + (Q0 - Q) * (Q0 - X) "E F+ ' + (Q0 - N) * (Q0 - ) "E !' + (Q0 - Y) * (Q0 - _) "E .,(S).-1T !' + (Q0 - ?) "E FT +Q_or_X:_______Quit +N_or_Delete:__Go_on_to_next_message +Y_or_Space:___Type_this_message,_then_ask_about_next_message +?:____________Type_this_message + + -S' + "# FG' + > FT +No_more_messages +  diff --git a/src/e142/enews._ej b/src/e142/enews._ej new file mode 100644 index 00000000..c5d8a419 --- /dev/null +++ b/src/e142/enews._ej @@ -0,0 +1,57 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + Y,6nw! +P]mwbi4:Post EMACS Newsp1,M(M.M& Read Line)Subject: [0 +Q0"E' +F[BBind +F+FTType your news. Exit with C-M-C (M- C). +[..J:I..JPost EMACS News + +[1HFX1 +F[DFile +EREMACS.NEWS@Y +S-C +1IFSDateFSFDConvert +2IFSHSNAME0]0 +3IG0 +4IG1 +5I +@:EWEMACS.NEWSHP:EF +@FT +Your News has been posted. +1fsEchoActive +Read EMACS newsUF[BBindF[DFile[0 +EREMACS.NEWS@Y +<:S; +FT +News posted .,(S).-1tFT by .,(.+1,(S).FC).-1tFT. +Subject: .,(S).-1TFT Read it?  +FI:FCU0 +FT0 + +(Q0-Q)*(Q0-X)"EF+' +(Q0-N)*(Q0-)"E!' +(Q0-Y)*(Q0- )"E.,(S).-1T!' +(Q0-?)"EFT +Q or X: Quit +N or Delete: Go on to next message +Y or Space: Type this message, then ask about next message +?: Type this message + +-S' +"#FG' +>FT +No more messages +~Filename~ ENEWS~DOC~ ~Filename~,Macros relating to the EMACS news file +~DOC~ Post EMACS NewsmC Post news in the EMACS news file +Asks for a subject, then gives you a buffer to type your news into. +~DOC~ Read EMACS newszPrints out EMACS news. +Prints out subject, time, author for each news item and asks if the +user wants to see more. +~DIRECTORY~&Post EMACS News +Read EMACS news + ~INVERT~[1Q1 diff --git a/src/e142/fork._ej b/src/e142/fork._ej new file mode 100644 index 00000000..ec1871a9 --- /dev/null +++ b/src/e142/fork._ej @@ -0,0 +1,62 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + m6BSW +dsW_FP;B39& Setup FORK Library!:i*Fork EXECm.VLastfork +0Fork{1f[noquit +[2[30[4[..o +f Fork name: :FCU2 +fq2"EQLastforku3 +q3"E@FTLast fork was killed +'' +"#:i3Fork 2' +f~3Fork EXEC"N +FF"N0fo..q3f"N,0fz'0M.V3 +5,fq3:g3u2' +0FO..Q3f"NU4 +q4fz'"# +1:2.SAVu4>"N +1:2.SAVu4>"N +1:"N +fshsname[1 +fz<1>2.SAVu4]1''' +q4M.V3' +'"#fz +:i3Fork EXEC' +q3uLastfork' +0 KForkE1f[noquit +[2[3[..o +f Handle name: :FCu2 +q2"E' +fq2"N:i2Fork 2'"# +QLastforku2 +Q2"E@FTLast fork already killed +' +@FTKill 21M(M.M& Yes or No)"E''' +f~2Fork EXEC"E +@FTCannot kill the EXEC fork!' +0FO..Q2u3 +q3"E@FTNo such fork' +q3,0fz +0u2 +qLastfork"N +F=Lastfork2"E0uLastfork'' +0~Filename~FORK~DOC~ ~Filename~(Command to go to an inferior fork. +~DOC~ & Setup FORK Library*S Initialize for handling inferiors. +~DOC~ ForkC Invoke an inferior process. +Takes as string argument the name of the program to invoke. If a +fork by that name already exists, it is resumed. If given an +argument, kills the fork and restarts it. Name defaults to the last +fork run. We look for the program on , , your +connected directory, and your login directory, in that order. Use +KFork command to kill the fork. +~DOC~ KForkrC Kill an inferior process. +Follow command with the name of the fork to kill. +No name kills last fork run. +~DIRECTORY~'& Setup FORK Library +Fork +KFork + ~INVERT~[1Q1 diff --git a/src/e142/fork._ej.2 b/src/e142/fork._ej.2 new file mode 100644 index 00000000..4d029d80 --- /dev/null +++ b/src/e142/fork._ej.2 @@ -0,0 +1,62 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + m6BSW"gv ZbIS>E6<& Setup FORK Library!:i*Fork EXECm.VLastfork +0Fork1f[noquit +[2[30[4[..o +f Fork name: :FCU2 +fq2"EQLastforku3 +q3"E@FTLast fork was killed +'' +"#:i3Fork 2' +@ft +f~3Fork EXEC"N +FF"N0fo..q3f"N,0fz'0M.V3 +5,fq3:g3u2' +0FO..Q3f"NU4 +q4fz'"# +1:2.SAVu4>"N +1:2.SAVu4>"N +1:"N +fshsname[1 +fz<1>2.SAVu4]1''' +q4M.V3' +'"#fz +:i3Fork EXEC' +q3uLastfork' +0 KForkE1f[noquit +[2[3[..o +f Handle name: :FCu2 +q2"E' +fq2"N:i2Fork 2'"# +QLastforku2 +Q2"E@FTLast fork already killed +' +@FTKill 21M(M.M& Yes or No)"E''' +f~2Fork EXEC"E +@FTCannot kill the EXEC fork!' +0FO..Q2u3 +q3"E@FTNo such fork' +q3,0fz +0u2 +qLastfork"N +F=Lastfork2"E0uLastfork'' +0~Filename~FORK~DOC~ ~Filename~(Command to go to an inferior fork. +~DOC~ & Setup FORK Library*S Initialize for handling inferiors. +~DOC~ ForkC Invoke an inferior process. +Takes as string argument the name of the program to invoke. If a +fork by that name already exists, it is resumed. If given an +argument, kills the fork and restarts it. Name defaults to the last +fork run. We look for the program on , , your +connected directory, and your login directory, in that order. Use +KFork command to kill the fork. +~DOC~ KForkrC Kill an inferior process. +Follow command with the name of the fork to kill. +No name kills last fork run. +~DIRECTORY~'& Setup FORK Library +Fork +KFork + ~INVERT~[1Q1 diff --git a/src/e142/fork._ej.3 b/src/e142/fork._ej.3 new file mode 100644 index 00000000..f7906810 --- /dev/null +++ b/src/e142/fork._ej.3 @@ -0,0 +1,62 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + m6BSW#hw [bJT?F6<& Setup FORK Library!:i*Fork EXECm.VLastfork +0Fork1f[noquit +[2[30[4[..o +f Fork name: :FCU2 +fq2"EQLastforku3 +q3"E@FTLast fork was killed +'' +"#:i3Fork 2' +@ft  +f~3Fork EXEC"N +FF"N0fo..q3f"N,0fz'0M.V3 +5,fq3:g3u2' +0FO..Q3f"NU4 +q4fz'"# +1:2.SAVu4>"N +1:2.SAVu4>"N +1:"N +fshsname[1 +fz<1>2.SAVu4]1''' +q4M.V3' +'"#fz +:i3Fork EXEC' +q3uLastfork' +0 KForkE1f[noquit +[2[3[..o +f Handle name: :FCu2 +q2"E' +fq2"N:i2Fork 2'"# +QLastforku2 +Q2"E@FTLast fork already killed +' +@FTKill 21M(M.M& Yes or No)"E''' +f~2Fork EXEC"E +@FTCannot kill the EXEC fork!' +0FO..Q2u3 +q3"E@FTNo such fork' +q3,0fz +0u2 +qLastfork"N +F=Lastfork2"E0uLastfork'' +0~Filename~FORK~DOC~ ~Filename~(Command to go to an inferior fork. +~DOC~ & Setup FORK Library*S Initialize for handling inferiors. +~DOC~ ForkC Invoke an inferior process. +Takes as string argument the name of the program to invoke. If a +fork by that name already exists, it is resumed. If given an +argument, kills the fork and restarts it. Name defaults to the last +fork run. We look for the program on , , your +connected directory, and your login directory, in that order. Use +KFork command to kill the fork. +~DOC~ KForkrC Kill an inferior process. +Follow command with the name of the fork to kill. +No name kills last fork run. +~DIRECTORY~'& Setup FORK Library +Fork +KFork + ~INVERT~[1Q1 diff --git a/src/e142/fork._ej.4 b/src/e142/fork._ej.4 new file mode 100644 index 00000000..77fbb219 --- /dev/null +++ b/src/e142/fork._ej.4 @@ -0,0 +1,62 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + m6BSW#hw [bJT?F6<& Setup FORK Library!:i*Fork EXECm.VLastfork +0Fork1f[noquit +[2[30[4[..o +f Fork name: :FCU2 +fq2"EQLastforku3 +q3"E@FTLast fork was killed +'' +"#:i3Fork 2' +@ft +f~3Fork EXEC"N +FF"N0fo..q3f"N,0fz'0M.V3 +5,fq3:g3u2' +0FO..Q3f"NU4 +q4fz'"# +1:2.SAVu4>"N +1:2.SAVu4>"N +1:"N +fshsname[1 +fz<1>2.SAVu4]1''' +q4M.V3' +'"#fz +:i3Fork EXEC' +q3uLastfork' +0 KForkE1f[noquit +[2[3[..o +f Handle name: :FCu2 +q2"E' +fq2"N:i2Fork 2'"# +QLastforku2 +Q2"E@FTLast fork already killed +' +@FTKill 21M(M.M& Yes or No)"E''' +f~2Fork EXEC"E +@FTCannot kill the EXEC fork!' +0FO..Q2u3 +q3"E@FTNo such fork' +q3,0fz +0u2 +qLastfork"N +F=Lastfork2"E0uLastfork'' +0~Filename~FORK~DOC~ ~Filename~(Command to go to an inferior fork. +~DOC~ & Setup FORK Library*S Initialize for handling inferiors. +~DOC~ ForkC Invoke an inferior process. +Takes as string argument the name of the program to invoke. If a +fork by that name already exists, it is resumed. If given an +argument, kills the fork and restarts it. Name defaults to the last +fork run. We look for the program on , , your +connected directory, and your login directory, in that order. Use +KFork command to kill the fork. +~DOC~ KForkrC Kill an inferior process. +Follow command with the name of the fork to kill. +No name kills last fork run. +~DIRECTORY~'& Setup FORK Library +Fork +KFork + ~INVERT~[1Q1 diff --git a/src/e142/grind._ej b/src/e142/grind._ej new file mode 100644 index 00000000..46df914a Binary files /dev/null and b/src/e142/grind._ej differ diff --git a/src/e142/intermacs. b/src/e142/intermacs. new file mode 100644 index 00000000..94965625 --- /dev/null +++ b/src/e142/intermacs. @@ -0,0 +1,188 @@ + +!~Filename~:! !Commands for Interlisp interface! +INTERMACS + +!Grind Sexp:! !C Grind the sexp after the pointer. +A modification of the MIT Grind Sexp that recognizes that +in Interlisp, % quotes a character, " starts a long +string, and ; has no significance. +Uses QMiser Column to decide where to start using "Miser" format, +and QFill Column as the page width to aim for. +Saves the old sexp on the kill ring.! + + 1:< + FDL R !* Find the next list.! + F[VB F[VZ FL FSBOUND !* Narrow bounds to that list.! + F=MODELISP"N OConfirm' + z-b-1000"g !Confirm! ^FTDo_you_really_want_to_Grind_this_s-expression?_(Y_or_N): + FI :FC - Y(  FS Echo Display C FS Echo Display)"N '' + Z: + M(M.M &_Save_Region_and_Query) !* No arg so no query, just save region.! + W J + [2 [3 +!*** Now normalize the expression; put it into the form PRIN1 would print.! + [D 128*5,32:ID !* In QD make a dispatch that! + 11.*5:F D -D :M2  !* turns any whitespace into a single space,! + 15.*5:F D RK :M2  !* deletes CRLFs and the indentation after them,! + 12.*5:F D -D :M2  + %*5:F D C !* Handle %'s and "'s right.! + "*5:F D R ^FLL  + (*5:F D :M3  !* Make sure no whitespace follows ('s and ''s! + !"! '*5:F D :M3  + )*5:F D R M3 C  !* or precedes )'s.! + :I2 Z-.< 1A F_ :; D> 32I  + :I3 Z-.< 1A F_ :; D>  + HFD + J .( 0FS VBW 0L .FS VB )J !* Include all of line, up to (, after B,! + !* so that FS HPOS is accurate.! +!*** Now decode the grinding parameters.! + FS WIDTH-10[W !* Figure the width to aim at! + FS WIDTH*2/3[C !* and the comment column.! + 0FO ..Q Fill_Column F"N UW + QWUC' + -1FO ..Q Comment_Column +1F"G -1UC' + QC[M !* Figure the place to switch to Miser fmt.! + -1FO ..Q Miser_Column +1F"G -1UM' + [R :IR /8+1*8 + 0FO ..Q Comment_Rounding F"N UR' + M.M &_Indent [I +!* G gets recursive macro to grind and pass 1 sexp.! +!* It expects numerc arg = depth in parens.! + [G ^:IG` + [2 S' R !* Pass by all leading quotes.! + 1A-("N ^FWL ' !* Atoms, just skip over.! + FL-.-QW++(FS HPOSU2 Q2)"L FLL ' !* Lists that fit in line, skip over.! + C Q2-QM"L !* If not yet far enough for Miser fmt,! + !"! 1A F';()"L ^FWL 1A-32"E C''' !* Skip 1st element, so get 2 on 1st line.! + !* But if 1st element is a list, use miser fmt anyway.! + FS HPOS U2 !* Q2 gets column to put rest of elements at.! + !LP! 1a-32"E D O LP' !* Don't be confused by whitespace.! + 1A-)"E C ' !* Until end of this list,! + FS HPOSU3 + Q3-Q2"N 13I 10I !* and for lists, indent to right place! + Q2/8,9I Q2&7,32I' + +1MG O LP !* and recursively grind.! + ` + 0MG !* DO IT! + J 7F~ (DEFUN_"E !* Now, if list is (DEFUN FOO..., then! + ^FLL 8F= + ______"E + 8D .U3 L !* Get the thing after FOO onto first line,! + Q3,. F~FEXPR + *(Q3,. F~MACRO + )"E !* and if it is a function property name,! + -2D 6D''' !* get it on that line too.! + J HU2U3 + > !* end errset! + J Z: !* Leave region around the ground sexp.! + Q3,Q2 + +!& LISP SUPERIOR:! !S Insert as directed by call from LISP.! + [A + [B + [0 + .U0 ZJ Z-3"G + 0A-3"E -4D'' + Q0J !* We delete the four characters at the! + !* end that are used to stop LISP from! + !* reading too far! + "N + FSIFILEUA !* The most recently opened input file! + QLISPFILEUB !* The EMACS.TEMP.FILE! + FS UREAD"N !* If anything is open,! + F~AB"N !* then if it's not EMACS.TEMP.FILE! + E[ !* push the input! + F[ D FILE !* push the default! + FN E] !* pop the input on exit from here! + ERB' !* and open up EMACS.TEMP.FILE! + 0FSIFACCESS' !* start reading at the beginning! + FS UREAD"E !* if nothing is open! + ERB' !* read EMACS.TEMP.FILE! + U0 + "L -Q0U0' !* The absolute value of the arg in 0! + "G MM^R_SET/POP_MARK + ZJ' + Q0FY + "L + .+,.FXA !* If the arg is negative we put! + MA' !* the stuff in A, delete and macro it.! + "G + R + .,ZFSBOUNDARIES' + ' !* We do nothing on a zero arg! + +1"G F+ !* If arg nonnegative, clear screen and refresh.! + :F' + + +!^R UP EVAL:! !^R Return to LISP and evaluate sexp after point.! + + 1000MM^R_Exit_To_LISP +  + +!^R ARGLIST:! !^R Write into lower buffer arglist atom after point. +Writes into lower buffer LISP arglist of function after point (or after +open parenthesis after point.)! + + 1001MM^R_Exit_To_LISP +  + +!^R Pretty Print:! !^R Pretty print buffer (using LISP pretty printer). +Leaves point close to where it was, namely after the rightmost close +parenthesis before point.! + [0 + 0u0 + <-:S(; %0> + 1003MM^R_Exit_To_LISP + .-B"E Q0:S(' +  + +!^R Print to Level:! !^R Print sexp after point with PRINTLEVEL set. +Prints sexpression after point into lower buffer with PRINTLEVEL +set to EMACS.P.PRINT.LEVEL.! + + 1002MM^R_Exit_To_LISP +  + +!^R Exit To LISP:! !^R Simply return to LISP. +Follows the protocol of closing the gap and +leaving at the end of the buffer a string +guaranteed to stop a LISP read.! + [0 + .U0 + ZJ + I_" + 1F? !* Close the gap, so LISP can! + !* read from the buffer! + Q0J + FSEXIT +  + +!& Setup INTERMACS Library:! !S SETUP! + [J + 1M.VLISPFILE + FSJNAMEUJ + F~JLISP"E + FS MSNAME FS D SNAME + EREMACS.TEMP.FILE.0 + FS I FILE ULISPFILE + F~Editor_NameEMACS/Datamedia"E + M.M^R_Pretty_PrintU...T + M.M^R_Pretty_PrintU:.X(T) + M.M^R_Print_To_Level U..T + M.M^R_Exit_To_LISPM.VMM_Quit + M.M^R_ARGLIST U.A + M.M^R_Up_EVAL U.Y' + "#M.M^R_Pretty_PrintU...P + M.M^R_Print_To_Level U..P + M.M^R_Exit_To_LISP U ..Z + M.M^R_Exit_To_LISP U...Z + M.M^R_ARGLIST U...? + M.M^R_Up_EVAL U...Y' + M.M&_LISP_SuperiorFSSUPERIOR' + 1m.vLISP_)_HACK + mmLISP_MODE + MM&_Process_Options + :I..D_A____A____A____A____A____A____A____A____A______________A_________ +____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A____A_________A____|____A___AA___A/____A____'____(____)____A____A____A____A___AA____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A____A____A___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA___AA____A____A____A____A________ +  + diff --git a/src/e142/intermacs._ej b/src/e142/intermacs._ej new file mode 100644 index 00000000..f112b910 --- /dev/null +++ b/src/e142/intermacs._ej @@ -0,0 +1,178 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + Q[dho_h&FPqx +D +Pp +  $gtAN +g +q p z b iTZGrind SexpW1:< +FDLR +F[VBF[VZFLFSBOUND +F=MODELISP"NOConfirm' +z-b-1000"g!Confirm!^FTDo you really want to Grind this s-expression? (Y or N): +FI:FC-Y(FSEchoDisplayCFSEchoDisplay)"N'' +Z: +M(M.M& Save Region and Query) +WJ +[2[3 +[D128*5,32:ID +11.*5:FD-D:M2 +15.*5:FDRK:M2 +12.*5:FD-D:M2 +%*5:FDC +"*5:FDR^FLL +(*5:FD:M3 +!"!'*5:FD:M3 +)*5:FDRM3C +:I2Z-.<1AF  :;D>32I +:I3Z-.<1AF  :;D> +HFD +J.(0FSVBW0L.FSVB)J +FSWIDTH-10[W +FSWIDTH*2/3[C +0FO..QFill ColumnF"NUW +QWUC' +-1FO..QComment Column+1F"G-1UC' +QC[M +-1FO..QMiser Column+1F"G-1UM' +[R:IR/8+1*8 +0FO..QComment RoundingF"NUR' +M.M& Indent +[G^:IG` +[2S'R +1A-("N^FWL' +FL-.-QW++(FSHPOSU2Q2)"LFLL' +CQ2-QM"L +!"!1AF';()"L^FWL1A-32"EC''' +FSHPOSU2 +!LP!1a-32"EDOLP' +1A-)"EC' +FSHPOSU3 +Q3-Q2"N13I10I +Q2/8,9IQ2&7,32I' ++1MGOLP +` +0MG +J7F~(DEFUN "E +^FLL8F= + "E +8D.U3L +Q3,.F~FEXPR +*(Q3,.F~MACRO +)"E +-2D6D''' +JHU2U3 +> +JZ: +Q3,Q2& LISP SUPERIOR[A +[B +[0 +.U0ZJZ-3"G +0A-3"E-4D'' +Q0J +"N +FSIFILEUA +QLISPFILEUB +FSUREAD"N +F~AB"N +E[ +F[DFILE +FNE] +ERB' +0FSIFACCESS' +FSUREAD"E +ERB' +U0 +"L-Q0U0' +"GMM^R SET/POP MARK +ZJ' +Q0FY +"L +.+,.FXA +MA' +"G +R +.,ZFSBOUNDARIES' +' ++1"GF+ +:F' +^R UP EVAL1000MM^R Exit To LISP +^R ARGLIST1001MM^R Exit To LISP +^R Pretty Print@[0 +0u0 +<-:S(;%0> +1003MM^R Exit To LISP +.-B"EQ0:S(' +^R Print to Level1002MM^R Exit To LISP +^R Exit To LISP.[0 +.U0 +ZJ +I " +1F? +Q0J +FSEXIT +& Setup INTERMACS Library) [J +1M.VLISPFILE +FSJNAMEUJ +F~JLISP"E +FSMSNAMEFSDSNAME +EREMACS.TEMP.FILE.0 +FSIFILEULISPFILE +F~Editor NameEMACS/Datamedia"E +M.M^R Pretty PrintU...T +M.M^R Pretty PrintU:.X(T) +M.M^R Print To LevelU..T +M.M^R Exit To LISPM.VMM Quit +M.M^R ARGLISTU.A +M.M^R Up EVALU.Y' +"#M.M^R Pretty PrintU...P +M.M^R Print To LevelU..P +M.M^R Exit To LISPU..Z +M.M^R Exit To LISPU...Z +M.M^R ARGLISTU...? +M.M^R Up EVALU...Y' +M.M& LISP SuperiorFSSUPERIOR' +1m.vLISP ) HACK +mmLISP MODE +MM& Process Options +:I..D A A A A A A A A A A + A A A A A A A A A A A A A A A A A A A | A AA A/ A ' ( ) A A A A AA A AA AA AA AA AA AA AA AA AA AA A A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A A A AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A A A A  +~Filename~ +INTERMACS~DOC~ ~Filename~&Commands for Interlisp interface +~DOC~ Grind SexpZC Grind the sexp after the pointer. +A modification of the MIT Grind Sexp that recognizes that +in Interlisp, % quotes a character, " starts a long +string, and ; has no significance. +Uses QMiser Column to decide where to start using "Miser" format, +and QFill Column as the page width to aim for. +Saves the old sexp on the kill ring. +~DOC~ & LISP SUPERIOR-S Insert as directed by call from LISP. +~DOC~ ^R UP EVAL6^R Return to LISP and evaluate sexp after point. +~DOC~ ^R ARGLIST#^R Write into lower buffer arglist atom after point. +Writes into lower buffer LISP arglist of function after point (or after +open parenthesis after point.) +~DOC~ ^R Pretty Print^R Pretty print buffer (using LISP pretty printer). +Leaves point close to where it was, namely after the rightmost close +parenthesis before point. +~DOC~ ^R Print to Level^R Print sexp after point with PRINTLEVEL set. +Prints sexpression after point into lower buffer with PRINTLEVEL +set to EMACS.P.PRINT.LEVEL. +~DOC~ ^R Exit To LISP^R Simply return to LISP. +Follows the protocol of closing the gap and +leaving at the end of the buffer a string +guaranteed to stop a LISP read. +#~DOC~ & Setup INTERMACS Library +S SETUP +~DIRECTORY~ Grind Sexp +& LISP SUPERIOR +^R UP EVAL +^R ARGLIST +^R Pretty Print +^R Print to Level +^R Exit To LISP +& Setup INTERMACS Library + ~INVERT~[1Q1 diff --git a/src/e142/kbdmac. b/src/e142/kbdmac. new file mode 100644 index 00000000..50e5c9ce --- /dev/null +++ b/src/e142/kbdmac. @@ -0,0 +1,196 @@ +!*-*-TECO-*-! + +!* A keyboard macro's data is represented using two ascii characters + to describe each 9-bit character. The first ascii character holds + the top 2 bits of the 9-bit character, and the second ascii character + holds the low 7 bits. When the macro is run, pairs of characters are + converted back into single 9-bit characters. + Keyboard macros are encapsulated in TECO macros by putting the 36 chars + "tempm(m.m& Immediate Kbd Macro)" in front. + This serves to make the TECO macro recognizable and to make + it push the kbd macro when invoked. + + The keyboard macro call stack is a qvector in q..m. + It has three slots for each call on the stack. + The first slot contains the macro string. + This string includes the call to & Immediate Kbd Macro. + The second slot contains the index at which we are fetching from the string. + The initial value of this slot is 36. + The third slot contains the repeat count.! + +!~Filename~:! !Defining and calling keyboard macros.! +KBDMAC + +!& Setup KBDMAC Library:! !S Put commands on keys. Create execution stack.! + + m.m ^R_Start_Kbd_Macro u:.x(() + m.m ^R_End_Kbd_Macro u:.x()) + m.m ^R_Call_Last u:.x(E) + m.m ^R_Kbd_Macro_Query u:.x(Q) + :i* m.v Last_Kbd_Macro + + 20.*5fs q vectoru..m + q..m[..o hk  + +!& Run Kbd Macro:! !S This is the FS TYI SOURCE for running keyboard macros.! + + fq..m/5-3[2 + q:..m(q2)[0 !* Get innermost running keyboard macro string.! + q:..m(%2)[1 !* Fetch and increment the index at which we are fetching.! + q1:g0*200.+(%1:g0) fs reread !* Form next input character, from next! + !* two elements of string.! + %1u:..m(q2) !* Store back index into string.! + q1-fq0"l 0' !* If string is exhausted,! + q:..m(%2)-1u0 !* decrement repeat count,! + q0f"nf"gu:..m(q2)' !* If not exhausted, decrement count unless it was 0! + 36u:..m(q2-1) 0' !* and anyway jump back to start of macro.! + q..m[..o zj -15d !* Repeat count exhausted => pop it off the pdl,! + z"e 0 fs tyi source' !* and if the pdl is empty we are no longer in a macro.! + 0 !* Return value for ^R, in case ^R is reading the char.! + +!& Immediate Kbd Macro:! !S Push a kbd macro onto the execution stack of such. +Supply the repeat count as pre-comma argument +and a string pointer to the macro as post-comma argument.! + + q..m[..o + fs tyi source"e hk' !* If an error turned off macro execution,! + !* clear out macro call stack.! + zj 15,0i !* Make three more words in the call stack.! + -1fsback str,.-15fs word !* Fill them with string, starting index, and rpt count.! + 36,.-10fs word + ,.-5fs word + + m.m &_Run_Kbd_Macro fs tyi source + 0 + +!^R Call Last Kbd Macro:! !^R Run the last defined temporary keyboard macro. +A numeric argument is a repeat count.! + + :mLast_Kbd_Macro + +!^R Start Kbd Macro:! !C Begin defining keyboad macro. +After you type this command, everything you type becomes +part of the accumulating keyboard macro as well as being executed.! + + 0 fs b consm.v Kbd_Macro_Defining_Body + 0 m.v Kbd_Macro_Defining_Index + m.m &_Define_Kbd_Macro fs tyi sink + 1:<1fs mode ch> + 0 + +!& Define Kbd Macro:! !S FS TYI SINK for defining kbd macros. +Takes characters typed and accumulates them in a buffer +which will be formed into a keyboard macro when the definition is finished.! + + qKbd_Macro_Defining_Body[..o zj !* Select the buffer we use to accumulate.! + fs tyi beg-(fs tyi count-1)"e !* If this is 1st char of ^R command,! + zuKbd_Macro_Defining_Index' !* update index in buffer of last such.! + /200.i &177.i 0 !* Insert the two characters for this command character.! + +!^R End Kbd Macro:! !C Terminate definition of a keyboard macro. +All that you have typed since starting the definition, +except this command itself, becomes the definition. +An argument means re-execute the macro immediately, with the +argument as repeat count, counting defining the macro as once. +^R Call Last Kbd Macro re-executes the last macro defined.! + + qKbd_Macro_Defining_Body[..o + qKbd_Macro_Defining_Indexj .,zk !* Flush the End Kbd Macro command from the string.! + j i !temp!m(m.m&_immediate_Kbd_Macro) !* Put command to call kbd macro at beginning.! + hx* m.v Last_Kbd_Macro !* make mLast_Kbd_Macro call the macro.! + Q..o( ]..o + ) fs bkill !* Flush the data structures used in defining.! + 0 fs tyi sink + 1:<1 fs mode ch> + -1"e 0' !* If arg is 1, we are done.! + f"g-1'mLast_Kbd_Macro' !* Else, repeat appropriate number of extra times.! + 0 + +!Name Kbd Macro:! !C Give a name to the last kbd macro defined. +An MM command is created with the name you specify, +which when invoked runs that keyboard macro. +Then, you are asked to give the command character to +put the macro on. Type Return or Rubout if you don't want +to put it on any character. Otherwise, type a character +which is undefined or is already a keyboard macro. +Prefix characters such as Altmode and ^X may be used.! + + 1,f Command_Name[1 !* Read name of MM command, and define it unless null.! + fq1"g qLast_Kbd_Macro m.v MM_1' + :i..0 ^R_Command_to_define:_ + m(m.m &_Read_Q-reg)[2 !* Ask what character to put it in.! + f=2 +"e 0' + f=2"e 0' !* If he said CR or rubout, don't.! + q2m(m.m &_Check_Redefinition) !* Verify that this char is ok to redefine.! + qLast_Kbd_Macrou2 !* Redefine it.! + 0 + +!View Kbd Macro:! !C Print definition of a keyboard macro. +Supply a suffix string argument containing the command name. +If the string argument is null, you will be asked to type +the character which runs the macro.! + + :i*[0 !* Get the string arg.! + :i..0 Kbd_Macro_Command:_ + fq0"e m(m.m &_Read_Q-reg)u0' !* If null, read character from terminal.! + q0[1 !* Get contents of string.! + m.m ^R_Call_Last_Kbd-q1"e !* If it's the ^X^E command,! + qLast_Kbd_Macrou1 !* get the macro it would run.! + :i0Last_Kbd_Macro' + f[b bind g1 !* Get the thing in a buffer.! + j s) 0,.k !* Flush the call to & immediate kbd macro.! + ft +Definition_of_keyboard_macro_0: + + + m.m&_Charprint[2 + j z/2< 1a*200.+(2c0a) m2 ft_> + ft + + 0 + +!& Check Redefinition:! !S Verify that a certain command can be redefined. +Do not allow a command to be redefined unless it is undefined, +self-inserting, or a string starting with Temp. +The command is specified with a q-register name in a string +passed as a string pointer.! + + [1 + q1[0 !* Q0 gets old definition.! + fq0+1"g !* If old definition is a string not made by this macro,! + f~(0,6:g0)!Temp!"n !* don't let user clobber useful command.! +!lose! !"! :I*Can't_clobber_specified_character_1 fs err'' + "# Afs^r init-q0"n + 200.@ fs^rinit-q0"n !* Don't redefine built-ins except error and self-insert.! + q0"n !* Undefined slots in dispatch prefix are 0.! + o lose'''' +  + +!^R Kbd Macro Query:! !^R Query and continue macro execution. +If called from a macro, reads a character: +Space continues execution. +Rubout terminates this repetition of the macro. +Altmode terminates all repetitions of the macro. +. terminates after the end of this repetition of the macro. +^R enters a recursive edit; when you exit, you are asked again. +^L clears the screen and asks you again. +Anything else exits all macros and is reread as a command.! + + fs tyi source"e 0' !* if not from inside macro, do nothing! + [0[1 [..j :i..j Kbd_Macro_Query + 0f[ tyi source 0f[ tyi sink + !Read! + 2,m.i @:fiu1 fiu0 !* get character, really from tty! + q0- "e f+ Oread' + q0-"e 0 Oread' + -2fsqpun !* pop tyi source and tyi sink! + q0-32"e 0' !* space continues on! + q0-."e 1u:..m(fq..m/5-1) 0' !* . ends after this, set rpt count to 1.! + q0-"e 1u:..m(fq..m/5-1)' !* For Altmode, set rpt count to 1 so flush all repeats.! + q0f:"l !* Both Rubout and Altmode end this repetition! + fq:..m(fq..m/5-3)-2 !* by skipping up to the last char +! u:..m(fq..m/5-2) + fi ' !* and reading it, causing macro to be popped.! + 0fs tyi source !* Other characters quit macro execution! + q1fs reread !* and are unread.! diff --git a/src/e142/kbdmac._ej b/src/e142/kbdmac._ej new file mode 100644 index 00000000..268c986a Binary files /dev/null and b/src/e142/kbdmac._ej differ diff --git a/src/e142/kbdmac._ej0531.7.txt b/src/e142/kbdmac._ej0531.7.txt new file mode 100644 index 00000000..ee9e054c Binary files /dev/null and b/src/e142/kbdmac._ej0531.7.txt differ diff --git a/src/e142/maze. b/src/e142/maze. new file mode 100644 index 00000000..3e6ec607 --- /dev/null +++ b/src/e142/maze. @@ -0,0 +1,32 @@ + :-:-:-:-:-: :-:-:-:-:-:-:-:-:-: + | | | | + : :-:-:-: :-: :-: : : :-:-:-:-: + | | | | | | | | + : : :-: :-: : :-:-: : :-: :-: : + | | | | | | | | | + :-:-: :-:-:-:-: : : :-: :-: : : + | | | | | | | | | + : :-:-: :-: : :-:-:-: : : :-: : + | | | | | | | + : :-:-:-:-:-: : :-: :-: :-: : : + | | | | | | | | + :-:-: : : : :-:-: :-:-:-: :-:-: + | | | | | | | + :-:-:-:-: :-:-: :-:-: : :-: :-: + | | | | | | | | | + : : :-: :-: : : : : : : : :-: : + | | | | | | | | | | | + : :-: :-:-:-: :-:-:-:-: : : : : + | | | | | | | | + :-:-:-: :-: :-: :-: :-: : :-: : + | | | | | | | | | + :-: :-:-: : : : : : : :-:-: : : + | | | | | | | | | | + : :-: :-:-:-:-:-:-:-: : : : : : + | | | | | | | | + :-:-:-:-: : :-: : :-:-: : : : : + | | | | | | | | | + : :-:-: :-: : :-:-:-: : : : :-: + | | | | | | + :-:-: :-:-:-:-:-:-:-:-:-:-:-:-: + \ No newline at end of file diff --git a/src/e142/mazlib._ej b/src/e142/mazlib._ej new file mode 100644 index 00000000..e4999042 Binary files /dev/null and b/src/e142/mazlib._ej differ diff --git a/src/e142/monsym. b/src/e142/monsym. new file mode 100644 index 00000000..b89d2cbe --- /dev/null +++ b/src/e142/monsym. @@ -0,0 +1,848 @@ +;***************************************** +;JSYS SPECIFIC ARGUMENTS +;THE FOLLOWING ARE ORDERED ALPHABETICALLY BY JSYS NAME +;****************************************** + +;ATTACH + +AT%CCJ==:1B0 ;^C JOB WHEN ATTACHED +AT%NAT==:1B1 ;NO ATTACH +AT%TRM==:1B2 ;7 TERMINAL IN 4, NOT CONTROLLING TERM +AT%DIR==:777777B35 ;DIRECTORY NUMBER + +;CFORK + +CR%MAP==:1B0 ;SET MAP FOR NEW FORK TO POINT TO + ; THIS PROCESS +CR%CAP==:1B1 ;MAKE CAPABILITIES IDENTICAL +CR%ACS==:1B3 ;SET ACS FROM BLOCK +CR%ST==:1B4 ;START PROCESS AT PC +CR%PCV==:777777B35 ;VALUE OF PC + +;CHFDB + +CF%NUD==:1B0 ;NO UPDATE DIRECTORY +CF%DSP==:777B17 ;FDB DISPLACEMENT +CF%JFN==:777777B35 ;JFN + +;CLOSF + +CO%NRJ==:1B0 ;NO RELEASE JFN +CO%WCL==:1B1 ;TOPS20AN ;WAIT UNTIL MATCHING CLS IS RECEIVED +CO%JFN==:777777B35 ;JFN + +;CLZFF + +CZ%NIF==:1B0 ;NO INFERIOR FORK FILES +CZ%NSF==:1B1 ;NO SELF FORK FILES +CZ%NRJ==:1B2 ;NO RELEASE JFN +CZ%NCL==:1B3 ;NO CLOSE FILE +CZ%UNR==:1B4 ;UNRESTRICT +CZ%ARJ==:1B5 ;ALWAYS RELEASE JFN +CZ%ABT==:1B6 ;ABORT +CZ%NUD==:1B7 ;NO UPDATE DIRECTORY +CZ%PRH==:777777B35 ;PROCESS HANDLE + +;CNDIR + +CN%CKP==:1B0 ;CHECK PASSWORD ONLY +CN%NOC==:1B1 ;NO CONNECT +CN%JOB==:1B2 ;DOING CONNECT FOR ANOTHER JOB +CN%DIR==:777777B35 ;DIRECTORY NUMBER + +;DELDF + +DD%DTF==:1B0 ;DELETE TEMPORARY FILES +DD%DNF==:1B1 ;DELETE NONEXISTENT FILES +DD%RST==:1B2 ;REBUILD THE SYMBOL TABLE +DD%CHK==:1B3 ;CHECK THE DIR FOR CONSISTENCY ONLY +DD%DIR==777777B35 ;DIRECTORY NUMBER + +;DELF + +DF%NRJ==:1B0 ;DON'T RELEASE JFN +DF%EXP==:1B1 ;EXPUNGE CONTENTS +DF%FGT==:1B2 ;FORGET (EXPUNGE W/O DEASSIGNING ADDRESSES) +DF%DIR==:1B3 ;DELETE, FORGET, AND EXPUNGE A DIRECTORY + ; FILE. (ONLY IF ^E-CREATE KILL FAILED) +DF%JFN==777777B35 ;JFN + +;DUMPI/DUMPO + +DM%NWT==:1B0 ;NO WAIT FOR COMPLETION +DM%FIN==:1B1 ;FINISH PREVIOUS REQUEST + ;***NOT INPLEMENTED YET*** +DM%PTR==:777777B35 ;POINTER TO COMMAND LIST + +;DVCHR AND DVCH1 BIT DEFINITIONS + +DV%OUT==:1B0 ;DEVICE CAN DO OUTPUT +DV%IN==:1B1 ;DEVICE CAN DO INPUT +DV%DIR==:1B2 ;DEVICE HAS A DIRECTORY +DV%AS==:1B3 ;DEVICE IS ASSIGNABLE +DV%MDD==:1B4 ;DEVICE IS A MULTIPLE DIRECTORY DEVICE +DV%AV==:1B5 ;DEVICE IS AVAILABLE TO THIS JOB +DV%ASN==:1B6 ;DEVICE IS ASSIGNED BY ASND +DV%MDV==:1B7 ;DEVICE IS A MOUNTABLE DEVICE +DV%MNT==:1B8 ;DEVICE IS MOUNTED +DV%TYP==:777B17 ;DEVICE TYPE FIELD +DV%MOD==:177777B35 ;DEVICE DATA MODE +DV%M0==:1B35 ;DEVICE CAN BE OPENED IN MODE 0 +DV%M1==:1B34 ;DEVICE CAN BE OPENED IN MODE 1 +DV%M2==:1B33 ;DEVICE CAN BE OPENED IN MODE 2 +DV%M3==:1B32 ;DEVICE CAN BE OPENED IN MODE 3 +DV%M4==:1B31 ;DEVICE CAN BE OPENED IN MODE 4 +DV%M5==:1B30 ;DEVICE CAN BE OPENED IN MODE 5 +DV%M6==:1B29 ;DEVICE CAN BE OPENED IN MODE 6 +DV%M7==:1B28 ;DEVICE CAN BE OPENED IN MODE 7 +DV%M10==:1B27 ;DEVICE CAN BE OPENED IN MODE 10 +DV%M11==:1B26 ;DEVICE CAN BE OPENED IN MODE 11 +DV%M12==:1B25 ;DEVICE CAN BE OPENED IN MODE 12 +DV%M13==:1B24 ;DEVICE CAN BE OPENED IN MODE 13 +DV%M14==:1B23 ;DEVICE CAN BE OPENED IN MODE 14 +DV%M15==:1B22 ;DEVICE CAN BE OPENED IN MODE 15 +DV%M16==:1B21 ;DEVICE CAN BE OPENED IN MODE 16 +DV%M17==:1B20 ;DEVICE CAN BE OPENED IN MODE 17 +D1%SPL==:1B0 ;DEVICE IS SPOOLED +D1%ALC==:1B1 ;DEVICE IS UNDER CONTROL OF ALLOCATOR +D1%VVL==:1B2 ;VOLUME VALID + +;DEVICE TYPE DEFINITIONS + +.DVDSK==:0 ;DISK +.DVMTA==:2 ;MAGTAPE +.DVDTA==:3 ;DECTAPE +.DVPTR==:4 ;PAPER TAPE READER +.DVPTP==:5 ;PAPER TAPE PUNCH +.DVDSP==:6 ;DISPLAY +.DVLPT==:7 ;LINE PRINTER +.DVCDR==:10 ;CARD READER +.DVFE==:11 ;FRONT END DEVICE +.DVTTY==:12 ;TERMINAL +.DVPTY==:13 ;PTY +.DVNUL==:15 ;NULL DEVICE +.DVNET==:16 ;ARPA NETWORK +.DVPLT==:17 ;PLOTTER + +;FLOUT/DFOUT +;FORMAT CONTROL WORD + +FL%SGN==:3B1 ;FIRST FIELD SIGN CONTROL + .FLDIG==:0 ;DIGIT + .FLSPC==:1 ;SPACE + .FLPLS==:2 ;PLUS SIGN + .FLSPA==:3 ;SPACE +FL%JUS==:3B3 ;FIRST FIELD JUSTIFICATION CONTROL + .FLLSP==:0 ;LEADING SPACES + .FLLZR==:1 ;LEADING ZEROS + .FLLAS==:2 ;LEADING ASTERISKS + .FLTSP==:3 ;TRAILING SPACES +FL%ONE==:1B4 ;FIRST FIELD NONBLANK +FL%DOL==:1B5 ;DOLLAR SIGN PREFIX +FL%PNT==:1B6 ;DECIMAL POINT +FL%EXP==:3B8 ;THIRD FIELD EXPONENT CONTROL + .FLEXN==:0 ;NO EXPONENT + .FLEXE==:1 ;E EXPONENT PREFIX + .FLEXD==:2 ;D EXPONENT PREFIX + .FLEXM==:3 ;*10^ EXPONENT PREFIX +FL%ESG==:3B10 ;EXPONENT SIGN CONTROL + .FLDGE==:0 ;DIGIT + .FLPLE==:1 ;PLUS SIGN + .FLSPE==:2 ;SPACE + .FLDGT==:3 ;DIGIT +FL%OVL==:1B11 ;COLUMN OVERFLOW +FL%RND==:37B17 ;DIGIT POSITION FOR ROUNDING +FL%FST==:77B23 ;FIRST FIELD WIDTH +FL%SND==:77B29 ;SECOND FIELD WIDTH +FL%THD==:77B35 ;THIRD FIELD WIDTH + + ;GDSTS + +;SEE MTOPR FOR CARD READER AND LINE PRINTER STATUS BITS +;SEE GENERAL FIELD AND VALUE SECTION FOR MAGTAPE STATUS BITS +;SEE TOPS20AN SECTION FOR NETWORK STATUS BITS + +.GDFSM==:17B3 ;TOPS20AN ;FINITE MACHINE STATE + +;GET + +GT%ADR==1B19 ;USE ADDRESS LIMITS IN AC2 + +;GFRKS + +GF%GFH==:1B0 ;GET RELATIVE FORK HANDLES +GF%GFS==:1B1 ;GET FORK STATUS + +;GTJFN DEFINITIONS + +;FLAGS PROVIDED TO GTJFN ON CALL +GJ%FOU==:1B0 ;FILE IS FOR OUTPUT USE +GJ%NEW==:1B1 ;NEW FILE ONLY +GJ%OLD==:1B2 ;OLD FILE ONLY +GJ%MSG==:1B3 ;PRINT AN APPROPRIATE MESSAGE +GJ%CFM==:1B4 ;CONFIRMATION IS REQUIRED +GJ%TMP==:1B5 ;TEMPORARY +GJ%NS==:1B6 ;DONT SEARCH SEARCH LISTS +GJ%ACC==:1B7 ;NO ACCESS BY OTHER FORKS +GJ%DEL==:1B8 ;IGNORE "DELETED" BIT +GJ%JFN==:3B10 ;JFN USE FIELD +.GJDNU==:0 ;DO NOT USE JFN PROVIDED +.GJERR==:2 ;ERROR IF CANNOT USE JFN PROVIDED +.GJALT==:3 ;USE ALTERNATE IF CANNOT USE GIVEN JFN +GJ%IFG==:1B11 ;ACCEPT INPUT FILE GROUP DESCRIPTORS +GJ%OFG==:1B12 ;ACCEPT OUTPUT FILE GROUP DESCRIPTORS +GJ%FLG==:1B13 ;RETURN FLAGS +GJ%PHY==:1B14 ;PHYSICAL DEVICE ONLY +GJ%XTN==:1B15 ;EXTENDED FORMAT (E+11 EXISTS) +GJ%FNS==:1B16 ;ACCUMULATOR 2 CONTAINS JOB FILE NUMBERS +GJ%SHT==:1B17 ;SHORT CALL FORMAT + + +;FLAGS PROVIDED TO GTJFN (IN SECOND FLAG WORD) + +G1%RND==:1B0 ;RETURN ON NULL(IN ALTERNATE FLAG WORD) +G1%RBF==:1B1 ;^R BUFFER IS DISJOINT +G1%NLN==:1B2 ;NO LONG NAMES +G1%RCM==:1B3 ;RETURN CONFIRM MESSAGE + + +;FLAGS RETURNED BY GTJFN + +GJ%DEV==:1B0 ;ASTERISK WAS GIVEN FOR DEVICE +GJ%UNT==:1B1 ;ASTERISK WAS GIVEN FOR UNIT +GJ%DIR==:1B2 ;ASTERISK WAS GIVEN FOR DIRECTORY +GJ%NAM==:1B3 ;ASTERISK WAS GIVEN FOR NAME +GJ%EXT==:1B4 ;ASTERISK WAS GIVEN FOR EXTENSION +GJ%VER==:1B5 ;ASTERISK WAS GIVEN FOR GENERATION +GJ%UHV==:1B6 ;USE HIGHEST GENERATION +GJ%NHV==:1B7 ;USE NEXT HIGHER GENERATION +GJ%ULV==:1B8 ;USE LOWEST GENERATION +GJ%PRO==:1B9 ;PROTECTION GIVEN +GJ%ACT==:1B10 ;ACCOUNT GIVEN +GJ%TFS==:1B11 ;TEMPORARY FILE SPECIFIED (;T) +GJ%GND==:1B12 ;COMPLEMENT OF GJ%DEL ON CALL + +;GTJFN TABLE OFFSETS + +.GJGEN==:0 ;FLAGS ,, GENERATION +.GJDEF==:0 ;DEFAULT GENERATION +.GJNHG==:-1 ;NEXT HIGHER GENERATION +.GJLEG==:-2 ;LOWEST EXISTING GENERATION +.GJALL==:-3 ;ALL GENERATIONS (I.E., ;*) +.GJSRC==:1 ;SOURCE JFN ,, OUTPUT JFN +.GJDEV==:2 ;DEFAULT DEVICE +.GJDIR==:3 ;DEFAULT DIRECTORY +.GJNAM==:4 ;DEFAULT NAME +.GJEXT==:5 ;DEFAULT EXTENSTION +.GJPRO==:6 ;DEFAULT PROTECTION +.GJACT==:7 ;DEFAULT ACCOUNT +.GJJFN==:10 ;DESIRED JFN +.GJF2==:11 ;SECOND GROUP FLAGS,,COUNT +.GJCPP==:12 ;COPY BUFFER POINTER +.GJCPC==:13 ;COPY BUFFER COUNT +.GJRTY==:14 ;RETYPE (^R) POINTER +.GJBFP==:15 ;TOP OF BUFFER POINTER + +;GNJFN - FLAGS RETURNED + +GN%DIR==:1B14 ;DIRECTORY CHANGED +GN%NAM==:1B15 ;NAME CHANGED +GN%EXT==:1B16 ;EXTENSION CHANGED + +;GTRPW + +PF%USR==:1B0 ;PAGE FAIL WORD - USER MODE REFERENCE +PF%WRT==:1B5 ; " - WRITE REFERENCE +TSW%RD==:1B14 ;TRAP STATUS WORD - READ +TSW%WT==:1B15 ; " - WRITE +TSW%WR==:1B15 ; (ANOTHER NAME FOR ABOVE) +TSW%EX==:1B16 ; " - EXECUTE +TSW%MN==:1B17 ; " - MONITOR MODE REFERENCE + +;GTSTS BITS RETURNED IN 2 + +GS%OPN==:1B0 ;FILE IS OPEN +GS%RDF==:1B1 ;IF OPEN, FILE IS OPEN FOR READ +GS%WRF==:1B2 ;IF OPEN, FILE IS OPEN FOR WRITE +GS%XCF==:1B3 ;IF OPEN, FILE IS OPEN FOR EXECUTE +GS%RND==:1B4 ;OK TO RESET BYTE POINTER + ; (FILE IS NOT APPEND) +GS%APT==:1B5 ;ACCESS PER PAGE TABLE + ; (NOT IMPLEMENTED -- OBSOLETE) +GS%CAL==:1B6 ;OK TO CALL AS A PROCEDURE + ; (NOT IMPLEMENTED -- OBSOLETE) +GS%LNG==:1B7 ;FILE IS LONG +GS%EOF==:1B8 ;AT END OF FILE ON READ +GS%ERR==:1B9 ;FILE MAY BE IN ERROR +GS%NAM==:1B10 ;FILE HAS A NAME (JFN EXISTS) +GS%AST==:1B11 ;ONE OR MORE FIELDS OF NAME + ; IS WILD +GS%ASG==:1B12 ;JFN IS BEING ASSIGNED +GS%HLT==:1B13 ;TERMINATE ON I/O ERROR +GS%FRK==:1B17 ;FILE IS RESTRICTED TO SOME FORK +GS%MOD==:17B35 ;DATA MODE + .GSNRM==:0 ;NORMAL MODE + .GSIMG==:10 ;IMAGE (BINARY) MODE + .GSDMP==:17 ;DUMP MODE + +;IDCNV (ALSO IDTNC AND ODCNV) + +IC%DSA==:1B0 ;DAYLIGHT SAVINGS IF APPROPRIATE +IC%ADS==:1B1 ;APPLY DAYLIGHT SAVINGS +IC%UTZ==:1B2 ;USE TIME ZONE GIVEN +IC%TMZ==:77B17 ;TIME ZONE +IC%TIM==777777B35 ;LOCAL TIME + +;IDTIM & IDTNC + +IT%NDA==:1B0 ;NO DATE +IT%NNM==:1B1 ;NO NUMERIC MONTH +IT%SNM==:1B2 ;SECOND NUMBER IS MONTH +IT%ERR==:1B3 ;ERROR IF NUMBERS ARE NOT IN SPECIFIED + ; ORDER +IT%NTI==:1B6 ;NO TIME +IT%NIS==:1B7 ;NO SECONDS +IT%AIS==:1B8 ;ALWAYS INCLUDE SECONDS +IT%NAC==:1B9 ;NO COLON ALLOWED BETWEEN HH AND MM +IT%AAC==:1B10 ;ALWAYS ALLOW COLON +IT%AMS==:1B11 ;ALWAYS INTERPERET ONE COLON AS HHMM:SS +IT%AHM==:1B12 ;ALWAYS INTERPRET ONE COLON AS HH:MM +IT%N24==:1B14 ;NO 24-HOUR FORMAT +IT%NTM==:1B15 ;NO TIME MODIFIER (AM, PM) +IT%NTZ==:1B16 ;NO TIME ZONE + +;JFNS + +JS%DEV==7B2 ;DEVICE FIELD OUTPUT CONTROL +JS%DIR==:7B5 ;DIRECTORY FIELD OUTPUT CONTROL +JS%NAM==:7B8 ;NAME FIELD OUTPUT CONTROL +JS%TYP==:7B11 ;FILE TYPE FIELD OUTPUT CONTROL +JS%GEN==:7B14 ;GENERATION FIELD OUTPUT CONTROL +JS%PRO==:7B17 ;PROTECTION FIELD OUTPUT CONTROL +JS%ACT==:7B20 ;ACCOUNT FIELD OUTPUT CONTROL + ;VALUES FOR ABOVE 7 FIELDS: + .JSNOF==:0 ;NEVER OUTPUT FIELD + .JSAOF==:1 ;ALWAYS OUTPUT FIELD + .JSSSD==:2 ;SUPPRESS IF SYSTEM DEFAULT +JS%TMP==:1B21 ;RETURN ;T IF TEMP FILE +JS%SIZ==:1B22 ;RETURN SIZE +JS%CDR==:1B23 ;RETURN CREATION DATE +JS%LWR==:1B24 ;RETURN LAST WRITE +JS%LRD==:1B25 ;RETURN LAST READ +JS%PTR==:1B26 ;AC 2 HOLDS STRING POINTER NOT JFN +JS%PSD==:1B32 ;PUCTUATE SIZE AND DATE +JS%TBR==:1B33 ;TAB BEFORE FIELDS RETURNED +JS%TBP==:1B34 ;TAB BEFORE POSSIBLE FIELDS +JS%PAF==:1B35 ;PUNCTUATE ALL FIELDS + +;MTOPR - FUNCTION CODES + +.MOCLE==:0 ;CLEAR ERRORS +.MONOP==:31 ;NOP (WAIT FOR ACTIVITY TO STOP) +.MOREW==:1 ;REWIND +.MOEOF==:3 ;WRITE EOF +.MODTE==:4 ;ASSIGN FE DEVICE TO A DTE +.MOFWR==:6 ;FORWARD SPACE RECORD +.MOBKR==:7 ;BACKSPACE RECORD +.MORUL==:11 ;REWIND AND UNLOAD +.MOERS==:13 ;ERASE TAPE +.MOFWF==:16 ;FORWARD SPACE FILE +.MOBKF==:17 ;BACKSPACE FILE +.MOSPD==:26 ;SET TTY SPEED (FOR KL ONLY) +.MORSP==:27 ;READ LINE SPEED (FOR KL ONLY) +.MOSDR==:2 ;SET READ DIRECTION +.MORDR==:26 ;READ READ DIRECTION +.MOEOT==:10 ;SKIP TO LOGICAL END OF TAPE +.MOSRS==:5 ;SET RECORD SIZE +.MORRS==:15 ;READ RECORD SIZE +.MOSDN==:24 ;SET DENSITY +.MORDN==:12 ;READ DENSITY +.MOSDM==:4 ;SET DATA MODE +.MORDM==:14 ;READ DATA MODE +.MOSPR==:20 ;SET PARITY +.MORPR==:21 ;READ PARITY +.MONRB==:22 ;GET NUMBER OF REMAINING BYTES IN RECORD +.MOFOU==:23 ;FORCE OUT RECORD +.MOINF==:25 ;GET INFORMATION ABOUT TAPE + .MOICT==:0 ;COUNT OF ARGUMENTS TO BE RETURNED + .MOITP==:1 ;MAGTAPE TYPE CODE + .MTT16==:1 ;MAGTAPE TYPE TU16 + .MTT45==:2 ;MAGTAPE TYPE TU45 + .MOIID==:2 ;MAGTAPE REEL ID + .MOISN==:3 ;CHAN,CONTROLLER,UNIT ,, SERIAL # + .MOIRD==:4 ;# OF READS DONE + .MOIWT==:5 ;# OF WRITES DONE + .MOIRC==:6 ;RECORD # FROM BOT + .MOIFC==:7 ;FILE COUNT ON TAPE + .MOISR==:10 ;# OF SOFT READ ERRORS + .MOISW==:11 ;# OF SOFT WRITE ERRORS + .MOIHR==:12 ;# OF HARD READ ERRORS + .MOIHW==:13 ;# OF HARD WRITE ERRORS +.MOPSI==:27 ;SET ERROR PSI FOR LPT AND CDR + MO%MSG==:1B0 ;SUPPRESS STANDARD CTY MESSAGES +.MOSID==:27 ;SET REEL I.D. +.MOIEL==:30 ;INHIBIT ERROR LOGGING +.MOLVF==:32 ;LOAD DEVICE'S VFU +.MORVF==:33 ;READ VFU FILE NAME +.MOLTR==:34 ;LOAD TRANSLATION RAM +.MORTR==:35 ;READ RAM FILE NAME +.MOSTS==:36 ;SET SOFTWARE STATUS +.MORST==:37 ;READ SOFTWARE STATUS + MO%LPC==1 ;PAGE COUNTER OVERFLOW + MO%LCI==2 ;CHARACTER INTERRUPT (HARD ERROR) + MO%LVF==4 ;VFU ERROR. PAPER MUST BE RE-ALIGNED + MO%LVU==20 ;LINE PRINTER HAS OPTICAL VFU + MO%RPE==40 ;RAM PARITY ERROR + + MO%RCK==:1 ;READ CHECK + MO%PCK==:2 ;PICK CHECK + MO%SCK==:4 ;STACK CHECK + MO%HEM==:10 ;HOPPER EMPTY + MO%SFL==:20 ;STACKER FULL + + MO%FNX==:1B17 ;NON-EXISTENT DEVICE + MO%OL==:1B16 ;DEVICE IS OFF-LINE + MO%HE==:1B15 ;HARDWARE ERROR + MO%SER==:1B14 ;SOFTWARE ERROR + MO%IOP==:1B13 ;I/O IN PROGRESS + MO%EOF==:1B12 ;END OF FILE +; 1B11 ;RESERVED + MO%FER==:1B10 ;FATAL ERROR + MO%LCP==:1B0 ;LOWER CASE PRINTER +.MOFLO==:40 ;FLUSH OUTPUT + + ;SEE SETJB FOR VARIOUS ARGUMENT VALUES + +;NET MTOPR NUMBERS + +.MOACP==:20 ;TOPS20AN ;ACCEPT CONNECTION ON SOCKET IN .NSRCR STATE +.MOSND==:21 ;TOPS20AN ;SEND ALL CURENTLY BUFFERED BYTES +.MOSIN==:22 ;TOPS20AN ;SEND INS/INR COMMAND +.MOAIN==:24 ;TOPS20AN ;ASSIGN INS/INR AND FSM PSI CHANNELS + MO%NIN==:77B5 ;TOPS20AN ;INS/INR SOFTWARE INTERRUPT CHANNEL + MO%FSM==:77B17 ;TOPS20AN ;FSM CHANGE OF STATE INTERRUPT CHANNEL + +;NOUT + +NO%MAG==:1B0 ;OUTPUT MAGNITUDE +NO%SGN==:1B1 ;OUTPUT SIGN +NO%LFL==:1B2 ;LEADING FILLER +NO%ZRO==:1B3 ;FILL WITH ZERO'S +NO%OOV==:1B4 ;OUTPUT ON COLUMN OVERFLOW +NO%AST==:1B5 ;OUTPUT ASTERISKS ON OVERFLOW +NO%COL==:177B17 ;NUMBER OF COLUMNS TO USE +NO%RDX==:777777 ;RADIX + +;ODCNV -- SEE IDCNV FOR BITS + +;ODTIM +OT%NDA==:1B0 ;DO NOT OUTPUT DATE +OT%DAY==:1B1 ;OUTPUT DAY OF WEEK +OT%FDY==:1B2 ;OUTPUT NUMERIC MONTH +OT%NMN==:1B3 ;OUTPUT NUMERIC MONTH +OT%FMN==:1B4 ;OUTPUT MONTH IN FULL +OT%4YR==:1B5 ;OUTPUT 4-DIGIT YEAR +OT%DAM==:1B6 ;OUTPUT DAY AFTER MONTH +OT%SPA==:1B7 ;OUTPUT SPACES IN DATE +OT%SLA==:1B8 ;OUTPUT SLASHES IN DATE +OT%NTM==:1B9 ;DO NOT OUTPUT TIME +OT%NSC==:1B10 ;DO NOT OUTPUT SECONDS +OT%12H==:1B11 ;OUTPUT 12-HOUR FORMAT +OT%NCO==:1B12 ;DO NOT OUTPUT COLON +OT%TMZ==:1B13 ;OUTPUT TIME ZONE +OT%SCL==:1B17 ;SUPPRESS COLUMNIZATION + +;ODTNC -- SEE IDCNV FOR BITS + +;OPENF + +OF%BSZ==:77B5 ;BYTE SIZE +OF%MOD==:17B9 ;MODE +OF%HER==:1B18 ;HALT ON IO ERROR +OF%RD==:1B19 ;READ +OF%WR==:1B20 ;WRITE +OF%EX==:1B21 ;EXECUTE +OF%APP==:1B22 ;APPEND +OF%THW==:1B25 ;THAWED +OF%AWT==:1B26 ;ALWAYS WAIT +OF%PDT==:1B27 ;PRESERVE DATES +OF%NWT==:1B28 ;NEVER WAIT +OF%RTD==:1B29 ;RESTRICTED +OF%PLN==:1B30 ;SET TO DISABLE LINE NUMBER CHECKING FOR + ; NON-LINE NUMBER FILES + +;PMAP BIT DEFINITIONS + +PM%RD==:1B2 ;READ +PM%WT==:1B3 ;WRITE +PM%WR==:1B3 ; (ANOTHER NAME FOR ABOVE) +PM%EX==:1B4 ;EXECUTE +PM%RWX==:7B4 ;CONVENIENT ABBREV FOR RD+WT+EX +PM%PLD==:1B5 ;PRELOAD PAGES BEING MAPPED +PM%CPY==:1B9 ;COPY ON WRITE + + +;RFSTS + +RF%FRZ==:1B0 ;PROCESS IS FROZEN +RF%STS==:377777B17 ;PROCESS STATUS CODE + .RFRUN==:0 ;RUNABLE + .RFIO==:1 ;DISMISSED FOR I/O + .RFHLT==:2 ;HALTED + .RFFPT==:3 ;FORCED PROCESS TERMINATION + .RFWAT==:4 ;WAITING FOR INFERIOR PROCESS + .RFSLP==:5 ;SLEEP + .RFTRP==:6 ;7 JSYS trapped +RF%SIC==:777777B35 ;SOFTWARE INTERRUPT CHANNNEL + +;RMAP + +RM%RD==1B2 ;READ ACCESS ALLOWED +RM%WR==:1B3 ;WRITE ACCESS ALLOWED +RM%EX==:1B4 ;EXECUTE ACCESS ALLOWED +RM%PEX==:1B5 ;PAGE EXISTS +RM%CPY==:1B9 ;COPY ON WRITE + +;RPACS/SPACS BIT DEFINITIONS + +PA%RD==:1B2 ;READ ACCESS ALLOWED +PA%WT==:1B3 ;WRITE ACCESS ALLOWED +PA%WR==:1B3 ; (ANOTHER NAME FOR ABOVE) +PA%EX==:1B4 ;EXECUTE ACCESS ALLOWED +PA%PEX==:1B5 ;PAGE EXISTS +PA%IND==:1B6 ;INDIRECT POINTER +PA%TPU==:1B8 ;TRAP TO USER + ; (NOT IMPLEMENTED -- OBSOLETE) +PA%CPY==:1B9 ;COPY ON WRITE +PA%PRV==:1B10 ;PRIVATE +P1%RD==:1B20 ;READ ACCESS ALLOWED IN 1ST POINTER +P1%WR==:1B21 ;WRITE ACCESS ALLOWED IN 1ST POINTER +P1%WT==:1B21 ; (ANOTHER NAME FOR ABOVE) +P1%EX==:1B22 ;EXECUTE ACCESS ALLOWED IN 1ST POINTER +P1%PEX==:1B23 ;PAGE EXISTS IN 1ST POINTER +P1%CPY==:1B27 ;COPY-ON-WRITE IN 1ST POINTER + + +;RTIW + +RT%DIM==:1B0 ;DEFFERED TERMINAL INTERRUPT MASK GIVEN +RT%PRH==:377777B35 ;PROCESS HANDLE + +;SCVEC + +.SVEAD==:0 ;ENTRY ADDRESS +.SVINE==:1 ;INITIAL ENTRY FOR SETUP +.SVGET==:2 ;ENTRY ADDRESS FOR GET SHARE FILE ROUTINE +.SV40==:3 ;ADDRESS TO GET LOCATION 40 +.SVRPC==:4 ;ADDRESS TO GET RETURN PC +.SVMAK==:5 ;ENTRY FOR MAKE SHARE FILE ROUTINE +.SVCST==:6 ;2 WORD BLOCK FOR CONTROL-C/START PROCESSING + +;SSAVE + +SS%NNP==777777B17 ;NEGATIVE NUMBER OF PAGES +SS%CPY==:1B18 ;ALLOW COPY-ON-WRITE +SS%UCA==:1B19 ;USE CURRENT ACCESS +SS%RD==:1B20 ;ALLOW READ ACCESS +SS%WR==:1B21 ;ALLOW WRITE ACCESS +SS%EXE==:1B22 ;ALLOW EXECUTE ACCESS +SS%FPN==:777B37 ;FIRST PAGE NUMBER + +;STDIR + +ST%DIR==:1B0 ;FILES ONLY DIRECTORY +ST%ANA==:1B1 ;ALPHANUMERIC ACCOUNTS +ST%RLM==:1B2 ;REPEAT LOGIN MESSAGE + +;STIW + +ST%PRH==:777777B35 ;PROCESS HANDLE + +;TLINK + +TL%CRO==:1B0 ;CLEAR REMOTE TO OBJECT LINK +TL%COR==:1B1 ;CLEAR OBJECT TO REMOTE LINK +TL%EOR==:1B2 ;ESTABLIST OBJECT TO REMOTE LINK +TL%ERO==:1B3 ;ESTABLISH REMOTE TO OBJECT LINK +TL%SAB==:1B4 ;SET ACCEPT BIT FOR OBJECT +TL%ABS==:1B5 ;ACCEPT BIT STATE +TL%STA==:1B6 ;SET OR CLEAR ADVICE +TL%AAD==1B7 ;ACCEPT ADVICE +TL%OBJ==:777777B35 ;OBJECT DESIGNATOR + + ;*********************************************** +;GENERAL FIELD AND VALUE DEFINITIONS +;USED BY MANY JSYS'S +;*********************************************** + +;GENERAL FORK HANDLES + +.FHSLF==:400000 ;SELF +.FHSUP==:-1 ;SUPERIOR +.FHTOP==:-2 ;TOP IN JOB +.FHSAI==:-3 ;SELF AND INFERIORS +.FHINF==:-4 ;INFERIORS +.FHJOB==:-5 ;ALL IN JOB + +;FIELDS OF JFN MODE WORD + +TT%OSP==:1B0 ;OUTPUT SUPPRESS +TT%MFF==:1B1 ;MECHANICAL FORMFEED PRESENT +TT%TAB==:1B2 ;MECHANICAL TAB PRESENT +TT%LCA==:1B3 ;LOWER CASE CAPABILITIES PRESENT +TT%LEN==:177B10 ;PAGE LENGTH +TT%WID==:177B17 ;PAGE WIDTH +TT%WAK==:77B23 ;WAKEUP FIELD +TT%WK0==:1B18 ;WAKEUP CLASS 0 (UNUSED) +TT%WK1==:1B19 ;WAKEUP CLASS 1 (UNUSED) +TT%WKF==:1B20 ;WAKEUP ON FORMATING CONTROL CHARS +TT%WKN==:1B21 ;WAKEUP ON NON-FORMATTING CONTROLS +TT%WKP==:1B22 ;WAKEUP ON PUNCTUATION +TT%WKA==:1B23 ;WAKEUP ON ALPHANUMERICS +TT%ECO==:1B24 ;ECHOS ON +TT%ECM==:1B25 ;ECHO MODE +TT%ALK==:1B26 ;ALLOW LINKS +TT%AAD==:1B27 ;ALLOW ADVICE (NOT IMPLEMENTED) +TT%DAM==:3B29 ;DATA MODE +.TTBIN==:0 ;BINARY +.TTASC==:1 ;ASCII +.TTATO==:2 ;ASCII AND TRANSLATE OUTPUT ONLY +.TTATE==:3 ;ASCII AND TRANSLATE ECHOS ONLY +TT%UOC==:1B30 ;UPPER CASE OUTPUT CONTROL +TT%LIC==:1B31 ;LOWER CASE INPUT CONTROL +TT%DUM==:3B33 ;DUPLEX MODE +.TTFDX==:0 ;FULL DUPLEX +.TT0DX==:1 ;NOT USED, RESERVED +.TTHDX==:2 ;HALF DUPLEX (CHARACTER) +.TTLDX==:3 ;LINE HALF DUPLEX +TT%PGM==:1B34 ;PAGE MODE +TT%CAR==:1B35 ;CARRIER STATE + +;DIRECTORY PROTECTION DEFINITIONS (3 6-BIT FIELDS: OWNER, GROUP, WORLD) + +DP%RD==:40 ;READING DIRECTORY IS ALLOWED +DP%CN==:10 ;CONNECT TO DIR, OR CHANGE PROT/ACCOUNT +DP%CF==:4 ;CREATING FILES IN DIR IS ALLOWED + +;FILE PROTECTION DEFINITIONS (3 6-BIT FIELDS: OWNER, GROUP, WORLD) + +FP%DIR==:2 ;DIRECTORY LISTING +FP%APP==:4 ;APPEND +FP%EX==:10 ;EXECUTE +FP%WR==:20 ;WRITE +FP%RD==:40 ;READ + + +;INPUT AND OUTPUT IDENTIFIERS + +.PRIIN==:100 ;PRIMARY INPUT +.PRIOU==:101 ;PRIMARY OUTPUT +.NULIO==:377777 ;NULL DESIGNATOR +.CTTRM==:777777 ;JOB'S CONTROLLING TERMINAL +.DVDES==:600000 ;UNIVERSAL DEVICE CODE +.TTDES==:400000 ;UNIVERSAL TERMINAL CODE + +;MAGTAPE DEVICE STATUS BITS + +MT%ILW==:1B18 ;ILLEGAL WRITE +MT%DVE==:1B19 ;DEVICE ERROR +MT%DAE==:1B20 ;DATA ERROR +MT%SER==:1B21 ;SUPPRESS ERROR RECOVERY PROCEDURES +MT%EOF==:1B22 ;EOF (FILE MARK) +MT%IRL==:1B23 ;INCORRECT RECORD LENGTH +MT%BOT==:1B24 ;BEGINNING OF TAPE +MT%EOT==:1B25 ;END OF TAPE +MT%EVP==:1B26 ;EVEN PARITY +MT%DEN==:3B28 ;DENSITY (0 IS 'NORMAL') +.MTLOD==:1 ;LOW DENSITY (200 BPI) +.MTMED==:2 ;MEDIUM DENSITY (556 BPI) +.MTHID==:3 ;HIGH DENSITY (800 BPI) +MT%CCT==:7B31 ;CHARACTER COUNTER + +;DEVICE DATA MODES + +.DMASC==:1 ;ASCII +.DMIMG==:10 ;IMAGE +.DMIMB==:13 ;IMAGE BINARY +.DMBIN==:14 ;BINARY + +;DEFINED PSI CHANNELS + +RADIX 5+5 + +.ICAOV==:6 ;ARITHMETIC OVERFLOW +.ICFOV==:7 ;FLOATING OVERFLOW +.ICPOV==:9 ;PDL OVERFLOW +.ICEOF==:10 ;END OF FILE +.ICDAE==:11 ;DATA ERROR +.ICTOD==:14 ;TIME OF DAY (NOT IMPLEMENTED) +.ICILI==:15 ;ILLEG INSTRUCTION +.ICIRD==:16 ;ILLEGAL READ +.ICIWR==:17 ;ILLEGAL WRITE +.ICIEX==:18 ;ILLEGAL EXECUTE (NOT IMPLEMENTED) +.ICIFT==:19 ;INFERIOR FORK TERMINATION +.ICMSE==:20 ;MACHINE SIZE EXCEEDED +.ICTRU==:21 ;TRAP TO USER (NOT IMPLEMENTED) +.ICNXP==:22 ;NONEXISTENT PAGE REFERENCED + +;TERMINAL TYPE NUMBERS + +.TT33==:0 ;MODEL 33 +.TT35==:1 ;MODEL 35 +.TT37==:2 ;MODEL 37 +.TTEXE==:3 ;EXECUPORT +.ttdm==:11 ; Datamedia +.tthp==:6 ; [SRI] HP2640A +.TTDEF==:8 ;DEFAULT +.TTIDL==:9 ;IDEAL +.TTV05==:10 ;VT05 +.TTL30==:12 ;LA30 +.TTG40==:13 ;GT40 +.TTL36==:14 ;LA36 +.TTV52==:15 ;VT52 + + +;DEFINED TERMINAL CODES + +.TICBK==:0 ;BREAK +.TICCA==:1 ;^A +.TICCB==:2 ;^B +.TICCC==:3 ;^C +.TICCD==:4 ;^D +.TICCE==:5 ;^E +.TICCF==:6 ;^F +.TICCG==:7 ;^G +.TICCH==:8 ;^H +.TICCI==:9 ;^I +.TICCJ==:10 ;^J +.TICCK==:11 ;^K +.TICCL==:12 ;^L +.TICCM==:13 ;^M +.TICCN==:14 ;^N +.TICCO==:15 ;^O +.TICCP==:16 ;^P +.TICCQ==:17 ;^Q +.TICCR==:18 ;^R +.TICCS==:19 ;^S +.TICCT==:20 ;^T +.TICCU==:21 ;^U +.TICCV==:22 ;^V +.TICCW==:23 ;^W +.TICCX==:24 ;^X +.TICCY==:25 ;^Y +.TICCZ==:26 ;^Z +.TICES==:27 ;ESC +.TICRB==:28 ;RUBOUT +.TICSP==:29 ;SPACE +.TICRF==:30 ;CARRIER OFF + +RADIX 8 + +;CAPABILITIES + +SC%CTC==:1B0 ;CONTROL-C +SC%GTB==:1B1 ;GETAB +SC%MMN==:1B2 ;MAP MONITOR +SC%LOG==:1B3 ;LOGGING FUNCTIONS +SC%MPP==:1B4 ;MAP PRIVILEGED PAGES +SC%SDV==:1B5 ;SPECIAL DEVICES + +SC%SUP==:1B9 ;SUPERIOR ACCESS + +SC%FRZ==:1B17 ;FREEZE ON TERMINATING CONDITIONS + +SC%WHL==:1B18 ;WHEEL +SC%OPR==:1B19 ;OPERATOR +SC%CNF==:1B20 ;CONFIDENTIAL INFORMATION ACCESS +SC%MNT==:1B21 ;MAINTENANCE +SC%IPC==:1B22 ;IPCF PRIVILEGES +SC%ENQ==:1B23 ;ENQ/DEQ PRIVILEGES +SC%NWZ==:1B24 ;TOPS20AN ;NET WIZARD PRIVILEGES (ASNSQ, ETC.) +SC%NAS==:1B25 ;TOPS20AN ;NETWORK ABSOLUTE SOCKET PRIVILEGE + +;DDBMOD WORD BIT DEFINITIONS + +MD%FO==:1B0 ;FILES ONLY DIRECTORY +MD%SA==:1B1 ;STRING ACCOUNT ALLOWED +MD%RLM==:1B2 ;REPEAT LOGIN MESSAGE + +;FDB DEFINITIONS + +FB%TMP==:1B0 ;FILE IS TEMPORARY +FB%PRM==:1B1 ;FILE IS PERMANENT +FB%NEX==:1B2 ;FILE DOES NOT HAVE AN EXTENSION YET +FB%DEL==:1B3 ;FILE IS DELETED +FB%NXF==:1B4 ;FILE IS NONEXISTENT +FB%LNG==:1B5 ;FILE IS A LONG FILE +FB%SHT==:1B6 ;FILE HAS COMPRESSED PAGE TABLE + +FB%DIR==:1B7 ;FILE IS A DIRECTORY FILE +FB%NOD==:1B8 ;FILE IS NOT TO BE DUMPED BY BACKUP SYSTEM +FB%BAT==:1B9 ;FILE HAS AT LEAST ONE BAD PAGE + +;6 Begin addition +fb%eph==1b17 +fb%und==1b10 +;6 End + ; IN IT +FB%FCF==:17B17 ;FILE CLASS FIELD + .FBNRM==:0 ;NON-RMS + .FBRMS==:1 ;RMS FILES + +.FBHDR==:0 ;HEADER WORD +.FBCTL==:1 ;FLAGS +.FBEXL==:2 ;LINK TO FDB OF NEXT EXTENSION +.FBADR==:3 ;DISK ADDRESS OF INDEX BLOCK +.FBPRT==:4 ;PROTECTION OF THE FILE +.FBCRE==:5 ;TIME AND DATE OF LAST WRITE +.FBUSE==:6 ;LAST WRITER ,, AUTHOR +.FBGEN==:7 ;GENERATION ,, DIR # + FB%GEN==:777777B17 ;GENERATION NUMBER +.FBDRN==:7 ;GENERATION ,, DIR # + FB%DRN==:777777 ;DIR NUMBER +.FBACT==:10 ;ACCOUNT +.FBBYV==:11 ;RETENTION+BYTE SIZE+MODE ,, # OF PAGES + FB%RET==:77B5 ;RETENTION COUNT + FB%BSZ==:77B11 ;BYTE SIZE + FB%MOD==:17B17 ;LAST OPENF MODE + FB%PGC==:777777 ;PAGE COUNT +.FBSIZ==:12 ;EOF POINTER +.FBCRV==:13 ;TIME AND DATE OF CREATION OF FILE +.FBWRT==:14 ;TIME AND DATE OF LAST USER WRITE +.FBREF==:15 ;TIME AND DATE OF LAST NON-WRITE ACCESS +.FBCNT==:16 ;# OF WRITES ,, # OF REFERENCES +.FBBK0==:17 ;BACKUP WORDS (5) +.FBBK1==:20 +.FBBK2==:21 +.FBBK3==:22 +.FBBK4==:23 +.FBUSW==:24 ;USER SETTABLE WORD + +.FBLEN==:25 ;LENGTH OF THE FDB + + +;*********************************************** +;GENERAL FIELD AND VALUE DEFINITIONS +;USED BY TOPS20AN JSYS'S +;*********************************************** + +;STATES OF A CONNECTION IN ARPANET NCP +; RETURNED IN B0-B3 OF GDSTS ON A NET CONNECTION +; ALSO AVAILABLE IN A GETAB, BUT THAT'S NOT THE PREFERRED WAY +; TO READ THEM, IF YOU HAVE A JFN FOR THE CONNECTION. + +.NSCZD==:01 ;CLOSED +.NSPND==:02 ;PENDING +.NSLSN==:03 ;LISTENING +.NSRCR==:04 ;REQUEST FOR CONNECTION RECEIVED +.NSCW1==:05 ;CLOSE WAIT SUB ONE (NCP CLOSE) +.NSRCS==:06 ;REQUEST FOR CONNECTION SENT +.NSOPN==:07 ;OPENED +.NSCSW==:10 ;CLOSE WAIT (NCP CLOSE) +.NSDTW==:11 ;FINAL DATA WAIT +.NSRF1==:12 ;RFNM WAIT SUB ONE (NORMAL NCP CLOSE) + +.NSCSW==:13 ;CLOSE WAIT (PROGRAM CLOSE) +.NSRF2==:14 ;RFNM WAIT SUB TWO (UNEXPECTED NCP CLOSE) + +.NSFRE==:16 ;FREE diff --git a/src/e142/mqrepl._ej b/src/e142/mqrepl._ej new file mode 100644 index 00000000..9e0cf355 Binary files /dev/null and b/src/e142/mqrepl._ej differ diff --git a/src/e142/nabstr._ej b/src/e142/nabstr._ej new file mode 100644 index 00000000..8d105791 Binary files /dev/null and b/src/e142/nabstr._ej differ diff --git a/src/e142/nemacs. b/src/e142/nemacs. new file mode 100644 index 00000000..4176c868 --- /dev/null +++ b/src/e142/nemacs. @@ -0,0 +1,1071 @@ +(FILECREATED " 3-Feb-79 15:21:16" NEMACS.;11 29497 + + + changes to: START.EMACS + + previous date: "27-Jan-79 17:19:41" NEMACS.;9) + + +(PRETTYCOMPRINT NEMACSCOMS) + +(RPAQQ NEMACSCOMS ((FNS * NEMACSFNS) + (VARS * NEMACSVARS) + (P (PUTD (QUOTE SUBSYS0) + (VIRGINFN (QUOTE SUBSYS)))) + (ADDVARS (ERRORTYPELST + (16 (COND ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.MAP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.MAP.FILE)) + (ERROR "End of EMACS buffer!")) + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.TEMP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.TEMP.FILE)) + (ERROR "End of EMACS temporary file!"))))) + ) + (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + (ADDVARS (NLAMA) + (NLAML))))) + +(RPAQQ NEMACSFNS (,, BINARYMODE CF CP CV DISPLAY.IN.ECHO.AND.DIVE DOWN + DUMP.SCREEN DUMPX DUMPX1 DWN E! E. + EDIT.DRIBBLE.FILE EMACS. EMACS.?= EMACS.GETDEF + EMACS.P EMACS.PP EMACS.RETURN + ENABLE.CONTROL.C.CAPABILITY FLUSH.EMACS + GET.EMACS.BUFFER HK INFO MAKE.QUOTE MAP.BYTES + MAP.PROCESS.TO.FILE PAGE.OF.BYTE PUTSTRING READ.AC + SET.EMACS.VARS SETUP.FANCY.DRIBBLE SFCOC + START.EMACS STIW SUBSYS1 SUBSYS2 TECO WRITE.RSCAN)) +(DEFINEQ + +(,, + [LAMBDA (X Y) + (LOGOR (LLSH X 18) + Y]) + +(BINARYMODE + [LAMBDA NIL + (JSYS 72 65 (LOGAND (LOGXOR (LLSH 1 6) + -1) + (JSYS 71 65 NIL NIL 2))) + + (* We turn off B29 in the JFN Mode Word of the + current output device. If the user is in ASCII mode, + this puts him in Binary mode, which is what is + required by EMACS.) + + + NIL]) + +(CF + [LAMBDA (NAME) + + (* Gets the definition of a function and dives down + to EMACS. Like Teitelman's EDITF, CF uses LASTWORD + if given NIL. The unbroken, unadvised version of the + function is obtained. If the function is compiled, + we check first for an EXPR. Otherwise we try to get + it from the first file that contains it.) + + + (EMACS.GETDEF NAME]) + +(CP + [LAMBDA (X) + + (* Like EDITP, it dives down to EMACS with the + property list of a litatom to edit.) + + + (COND + ((NULL X) + (SETQ X LASTWORD) + (PRINT LASTWORD T))) + (COND + ((AND X (LITATOM X)) + (PRIN3 "(SETPROPLIST " EMACS.TEMP.FILE) + (PRIN4 (KWOTE X) + EMACS.TEMP.FILE) + (SPACES 1 EMACS.TEMP.FILE) + (DUMPX (LIST (QUOTE QUOTE) + (GETPROPLIST X))) + (PRIN3 ") + +" EMACS.TEMP.FILE) + (DOWN)) + (T (ERROR "No editable property list: " X]) + +(CV + [LAMBDA (X) + + (* Like EDITV, it dives down to EMACS with the value + of a variable to edit.) + + + (COND + ((NULL X) + (SETQ X LASTWORD) + (PRINT LASTWORD T))) + (COND + ((NEQ (GETTOPVAL X) + (QUOTE NOBIND)) + (PRIN3 "(RPAQQ " EMACS.TEMP.FILE) + (PRIN4 X EMACS.TEMP.FILE) + (SPACES 1 EMACS.TEMP.FILE) + (DUMPX (GETTOPVAL X)) + (PRIN3 ") + +" EMACS.TEMP.FILE) + (DOWN)) + (T (ERROR X " has no value."]) + +(DISPLAY.IN.ECHO.AND.DIVE + [LAMBDA (LIST) + (PRIN3 "MM^R Two Windows +MMSELECT BUFFERPRINT +HK +I" EMACS.TEMP.FILE) + (PRIN3 (APPLY (FUNCTION CONCAT) + LIST) + EMACS.TEMP.FILE) + (PRIN3 + +" +0J +QWINDOW 2 SIZE-3%"N 3-QWINDOW 2 SIZEMM^R GROW WINDOW' +MM^R OTHER WINDOW +MM& MULTI-WINDOW REFRESH" + EMACS.TEMP.FILE) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN T]) + +(DOWN + [LAMBDA (NEGATE.ARG.FLG) + + (* This is the main function of the EMACS interface + for diving down to EMACS. Once START.EMACS has been + called, DOWN may be called at any time to enter + EMACS. Meta-z will exit from EMACS and return to + down. When DOWN invokes EMACS, it passes to EMACS a + number whose absolute value is the current file + pointer of the file EMACS.TEMP.FILE. + The number is passed to a teco macro in FSSUPERIOR + which is invoked when the EMACS gains control. + If the argument to DOWN is NIL, then the current + file pointer is passed and EMACS simply inserts the + text at the end of the buffer. + If DOWN is given the argument T, then the negative + of the current file pointer is passed. + EMACS takes a negative number to be the instruction + to insert that much text, put it into q-register a, + delete the text and macro A. + Thus, if you simply want to insert some text into + the EMACS buffer, just print that text into + EMACS.TEMP.FILE and call (DOWN). But if you want a + fancier event to occur when EMACS gains control, + then print teco code to EMACS.TEMP.FILE and then + call (DOWN T).) + + + (PROG (TEMP) + (SETQ TEMP (GETFILEPTR EMACS.TEMP.FILE)) + (CLOSER EMACS.ARG.LOC (COND + (NEGATE.ARG.FLG (IMINUS TEMP)) + (T TEMP))) + + (* EMACS.ARG.LOC is a location in a page of lisp + that is identical to the spot that FSSUPERIOR looks + for its argument. See the last few pages of + TECORD.) + + + (SETFILEPTR EMACS.TEMP.FILE 0) + (JSYS 41 65 CLEAR.SCREEN.NUMBER) (* See DUMP.SCREEN.) + (SETQ LASTEMACS (SUBSYS2 LASTEMACS NIL NIL (QUOTE START) + T)) + (GET.EMACS.BUFFER) + LOOP(COND + ((NOT (ZEROP EMACS.EXTRAC)) + (PRIN1 + +" + Illegal exit from EMACS. Exit from EMACS only with meta-Z. + (The gap is not closed.) Returning to EMACS. +" + T) + (DISMISS 3000) + (SETQ LASTEMACS (SUBSYS2 LASTEMACS NIL NIL NIL NIL)) + (GO LOOP))) + (EMACS.RETURN) + (DUMP.SCREEN DUMP.SCREEN.AMOUNT]) + +(DUMP.SCREEN + [LAMBDA (N) + (PROG (TEMP TEMP1) + (COND + ((AND DISPLAYTERMFLG (EQ (DRIBBLEFILE) + FANCY.DRIBBLE.FILE)) + + (* We ship out to the terminal a 30, which will + cause the screen to clear. We don't PRIN1 it because + we do not want it to get into the dribble file. + Then we flash up onto the scrren the last page or so + of text that appeared on the screen during LISP.) + + + (JSYS 41 65 CLEAR.SCREEN.NUMBER) + (SETQ TEMP (GETEOFPTR FANCY.DRIBBLE.FILE)) + (SETQ TEMP1 (IDIFFERENCE TEMP N)) + (COND + ((LESSP TEMP1 0) + (SETQ TEMP1 0))) + (COPYBYTES FANCY.DRIBBLE.FILE T TEMP1 TEMP]) + +(DUMPX + [LAMBDA (X) + (COND + ((AND (LISTP X) + (EQ (CAR X) + (QUOTE DEFINEQ)) + (LISTP (CDR X)) + (NULL (CDDR X)) + (LISTP (CADR X)) + (LISTP (CDADR X)) + (NULL (CDDADR X))) + (PRIN3 "(DEFINEQ (" EMACS.TEMP.FILE) + (PRIN4 (CAADR X) + EMACS.TEMP.FILE) + (PRIN3 " " EMACS.TEMP.FILE) + (DUMPX1 (CAR (CDADR X))) + (PRIN3 ")) + +" EMACS.TEMP.FILE)) + (T (DUMPX1 X]) + +(DUMPX1 + [LAMBDA (X DEF) + + (* We write X into EMACS.TEMP.FILE using the pretty + print algorithm on PPR. + We set the LINELENGTH to 79 because EMACS stupidly + causes wraparound at 80 (instead of 81). The + GETCOMMENT stuff causes lisp comments that are + currently mapped out (because NORMALCOMMENTSFLG is + NIL) to get sent down to EMACS.) + + + (RESETFORM + (LINELENGTH 79) + (RESETFORM (OUTFILE EMACS.TEMP.FILE) + (PROGN (COND + [(GETD (QUOTE PPRIND)) + (PROG ((FORCEIN 1000)) + (PPRIND X 0 0 (QUOTE ( + (* . GETCOMMENT) + (QUOTE . + MAKE.QUOTE] + (T (PROG ((PRETTYPRINTMACROS + (CONS (QUOTE (* . GETCOMMENT)) + PRETTYPRINTMACROS))) + (PRINTDEF X 0 DEF]) + +(DWN + [LAMBDA NIL + (SETFILEPTR EMACS.TEMP.FILE 0) + (PRIN3 " + +" EMACS.TEMP.FILE) + (DOWN]) + +(E! + [LAMBDA (N) + [COND + ((NUMBERP N) + (FOR I FROM 1 TO N DO (E.))) + (T (PROG (OLDLOC) + LOOP(SETQ OLDLOC (GETFILEPTR EMACS.MAP.FILE)) + (WHILE (SYNTAXP (CHCON1 (PEEKC EMACS.MAP.FILE)) + (QUOTE SEPR) + EMACS.READ.TABLE) + DO (READC EMACS.MAP.FILE)) + (COND + ((LESSP (GETFILEPTR EMACS.MAP.FILE) + (DIFFERENCE EMACS.Z 4)) + (SETFILEPTR EMACS.MAP.FILE OLDLOC) + (E.) + (GO LOOP)) + (T (RETURN] + (PACKC (QUOTE (8]) + +(E. + [LAMBDA NIL + + (* This function is for calling after DOWN has + returned. It causes the lisp sexpression after point + in the EMACS buffer to be read and evaluated. + Actually, the form is evaluated with LISPXEVAL so + that it becomes (somewhat) undoable, just as if you + had literally typed it into lisp.) + + + (PROG (TEMP) + (SETQ TEMP (PROG ((NORMALCOMMENTSFLG T)) + (RETURN (READ EMACS.MAP.FILE + EMACS.READ.TABLE)) + + (* We must make lisp read in the comments because + text in the buffer is very likely to get deleted or + edited.) + + + )) + (PROMPTCHAR (QUOTE _) + NIL LISPXHISTORY) + (RESETFORM (PRINTLEVEL (QUOTE (3 . 4))) + (PRINT TEMP T)) + (SETQ TEMP (LISPXEVAL TEMP)) + (RESETFORM (PRINTLEVEL (QUOTE (3 . 4))) + (PRINT TEMP T)) + (RETURN TEMP)) + (PACKC (QUOTE (8]) + +(EDIT.DRIBBLE.FILE + [LAMBDA NIL + (DRIBBLE (IOFILE (DRIBBLE)) + T T) + (PRIN3 "MMSelect BufferDRIBBLE +ER" EMACS.TEMP.FILE) + (PRIN3 FANCY.DRIBBLE.FILE EMACS.TEMP.FILE) + (PRIN3 "HK +^A +ZJ +-1MM^R New Window" EMACS.TEMP.FILE) + (DOWN T]) + +(EMACS. + [LAMBDA NIL + (DUMP.SCREEN DUMP.SCREEN.AMOUNT) + (RETFROM (QUOTE DOWN) + (E.]) + +(EMACS.?= + [LAMBDA NIL + (PROG (NAME) + [COND + ((EQ (SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE)) + (QUOTE %()) + (SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE] + (DISPLAY.IN.ECHO.AND.DIVE + (COND + [(GETD NAME) + (CONS + NAME + (CONS + "[" + (NCONC1 + [COND + ((NLISTP (ARGLIST NAME)) + (LIST (ARGLIST NAME))) + (T (FOR ARGLIST ON (ARGLIST NAME) + JOIN (CONS (CAR ARGLIST) + (COND + ((NULL (CDR ARGLIST)) + NIL) + (T (CONS "," NIL] + "]"] + (T (LIST "Not a function."]) + +(EMACS.GETDEF + [LAMBDA (NAME) (* Gets the definition + of a litatom, as + described in CF.) + (PROG (DEF FILE SPOT MAP WHEREIS) + (COND + ((NULL NAME) + (SETQ NAME LASTWORD) + (PRINT LASTWORD T))) + (SETQ DEF (VIRGINFN NAME)) + [COND + ((LISTP DEF) + (DUMPX (LIST (QUOTE DEFINEQ) + (LIST NAME DEF))) + (RETURN (DOWN] + [COND + ((GETP NAME (QUOTE EXPR)) + [DUMPX (LIST (QUOTE DEFINEQ) + (LIST NAME (GETP NAME (QUOTE EXPR] + (RETURN (DOWN] + (COND + [(SETQ FILE (CAR (WHEREIS NAME))) + [COND + [(SETQ MAP (GETP FILE (QUOTE FILEMAP] + (T (LOADFNS NIL (CDAR (GETP FILE (QUOTE FILEDATES))) + T NIL) + (SETQ MAP (GETP FILE (QUOTE FILEMAP] + (COND + ([SETQ SPOT (ASSOC NAME + (CDDR (CADADR (GETP FILE + (QUOTE FILEMAP] + [SETQ FILE (CDAR (GETP FILE (QUOTE FILEDATES] + (PRINT FILE T) + (PRIN3 "[0E[FNE]ZJ.U0 +I(DEFINEQ " EMACS.TEMP.FILE) + (PRIN3 "ER" EMACS.TEMP.FILE) + (PRIN3 FILE EMACS.TEMP.FILE) + (PRIN3 " +" EMACS.TEMP.FILE) + (PRIN3 (CADR SPOT) + EMACS.TEMP.FILE) + (PRIN3 "FSIFACCESS" EMACS.TEMP.FILE) + (PRIN3 (DIFFERENCE (CDDR SPOT) + (CADR SPOT)) + EMACS.TEMP.FILE) + (PRIN3 + "FY +I) + + +0FSDVERSION +Q0J +.,ZFSBOUNDARIES +F+ +0:F +:F +" + EMACS.TEMP.FILE) + (RETURN (DOWN T))) + (T (ERROR "No Definition Found For" NAME] + (T (ERROR "No Definition Found. " NAME]) + +(EMACS.P + [LAMBDA NIL + (PRIN3 "MM^R Two Windows +MMSELECT BUFFERPRINT +HK +I" EMACS.TEMP.FILE) + (PROG ((PLVLFILEFLG T)) + (RESETFORM (PRINTLEVEL EMACS.P.PRINT.LEVEL) + (PRIN3 (PROG ((NORMALCOMMENTSFLG T)) + (RETURN (READ EMACS.MAP.FILE + EMACS.READ.TABLE))) + EMACS.TEMP.FILE))) + (PRIN3 + +" +0J +QWINDOW 2 SIZE-3%"N 3-QWINDOW 2 SIZEMM^R GROW WINDOW' +MM^R OTHER WINDOW +MM& MULTI-WINDOW REFRESH" + EMACS.TEMP.FILE) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN T]) + +(EMACS.PP + [LAMBDA NIL + (SETFILEPTR EMACS.MAP.FILE EMACS.BEGV) + [PROG (OLDLOC TEMP (NORMALCOMMENTSFLG T)) + LOOP(SETQ OLDLOC (GETFILEPTR EMACS.MAP.FILE)) + (WHILE (SYNTAXP (CHCON1 (PEEKC EMACS.MAP.FILE)) + (QUOTE SEPR) + EMACS.READ.TABLE) + DO (READC EMACS.MAP.FILE)) + (COND + ((LESSP (GETFILEPTR EMACS.MAP.FILE) + (DIFFERENCE EMACS.Z 4)) + (SETFILEPTR EMACS.MAP.FILE OLDLOC) + (SETQ TEMP (NLSETQ (READ EMACS.MAP.FILE EMACS.READ.TABLE)) + ) + (COND + [(NULL TEMP) + (PRIN1 "Unbalanced Sexpression! +" T) + (DISMISS 3000) + (SETFILEPTR EMACS.TEMP.FILE 0) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN] + (T (DUMPX (CAR TEMP)) + (TERPRI EMACS.TEMP.FILE) + (TERPRI EMACS.TEMP.FILE))) + (GO LOOP)) + (T (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN] + (PACKC (QUOTE (8]) + +(EMACS.RETURN + [LAMBDA NIL + (EVAL (CDR (SASSOC EMACS.FSEXIT.ARG EMACS.RETURN.ALIST]) + +(ENABLE.CONTROL.C.CAPABILITY + [LAMBDA NIL + (JSYS 105 OURPROCESS 0 (,, 131072 0]) + +(FLUSH.EMACS + [LAMBDA NIL + + (* This function gets rid of the EMACS fork and + closes the 3 files that EMACS uses.) + + + [COND + ([FIXP (CAR (GETATOMVAL (QUOTE LASTEMACS] + (KFORK (CAR (GETATOMVAL (QUOTE LASTEMACS] + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE EMACS.MAP.FILE))) + (LITATOM EMACS.MAP.FILE) + (OPENP EMACS.MAP.FILE)) + (CLOSEF EMACS.MAP.FILE))) + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE EMACS.TEMP.FILE))) + (LITATOM EMACS.TEMP.FILE) + (OPENP EMACS.TEMP.FILE)) + (CLOSEF EMACS.TEMP.FILE))) + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE FANCY.DRIBBLE.FILE))) + (LITATOM FANCY.DRIBBLE.FILE) + (OPENP FANCY.DRIBBLE.FILE)) + (DRIBBLE NIL))) + (NLSETQ (RELBLK (VAG OUR.BLOCK.START) + EMACS.BLK.SIZE)) + (NLSETQ (RELBLK (VAG EMACS.AC.BLK.START) + 1]) + +(GET.EMACS.BUFFER + [LAMBDA NIL + + (* We assume we have just returned from EMACS and + that the gap has been closed + (with 1F?). We find out where the beginning and end + and point of the current buffer are and we make sure + that every page of the buffer is mapped into + EMACS.MAP.FILE so we can read it with lisp READ.) + + + (SET.EMACS.VARS) + (MAP.BYTES EMACS.BEG EMACS.Z) + (COND + ((GREATERP EMACS.Z EMACS.MAP.FILE.EOF) + (SETFILEPTR EMACS.MAP.FILE EMACS.Z) + (SETQ EMACS.MAP.FILE.EOF EMACS.Z))) + (SETFILEPTR EMACS.MAP.FILE EMACS.PT]) + +(HK + [LAMBDA NIL + (TECO "HK"]) + +(INFO + [LAMBDA NIL + (TECO "MMINFO"]) + +(MAKE.QUOTE + [LAMBDA (X) + (COND + ((AND (LISTP (CDR X)) + (LITATOM (CADR X)) + (NULL (CDDR X))) + (PACK* (QUOTE ') + (CADR X))) + (T (CONS (QUOTE QUOTE) + (CDR X]) + +(MAP.BYTES + [LAMBDA (START END) + (FOR I FROM (PAGE.OF.BYTE START) TO (PAGE.OF.BYTE END) + DO (COND + ((MEMBER I MAPPED.PAGES)) + (T (MAP.PROCESS.TO.FILE (CAR LASTEMACS) + I EMACS.MAP.FILE.JFN) + (SETQ MAPPED.PAGES (CONS I MAPPED.PAGES]) + +(MAP.PROCESS.TO.FILE + [LAMBDA (PROCESS PAGE JFN) + + (* We make a page of PROCESS to a page of + EMACS.TEMP.FILE and then map it back into the + process. Future changes to the process page or file + page affect the other (immediately).) + + + (JSYS 46 (,, PROCESS PAGE) + (,, JFN PAGE) + (,, 61440 0)) + (JSYS 46 (,, JFN PAGE) + (,, PROCESS PAGE) + (,, 61440 0]) + +(PAGE.OF.BYTE + [LAMBDA (BYTE) + (PROG (QUO REM) + (SETQ QUO (IQUOTIENT BYTE 5)) + (SETQ REM (IREMAINDER BYTE 5)) + (RETURN (LLSH (COND + ((ZEROP REM) + (ADD1 QUO)) + (T QUO)) + -9]) + +(PUTSTRING + [LAMBDA (STR ADDR) + + (* We write the bytes in STR starting a ADDR 5 bytes + (of 7 bits each) to a word with a 0 bit at the end. + We make sure that a 0 byte is added at the end. + In fact, the last word ends with 0 bytes.) + + + (UNTIL (GREATERP CHAR (ADD1 (NCHARS STR))) BIND LOC + FIRST (SETQ LOC ADDR) BIND WORD BIND CHAR FIRST (SETQ CHAR 1) + DO (SETQ WORD 0) + (FOR J FROM 1 TO 5 + DO (SETQ WORD (LLSH WORD 7)) + [SETQ WORD (LOGOR WORD + (COND + ((GREATERP CHAR (NCHARS STR)) + 0) + (T (CHCON1 (NTHCHAR STR CHAR] + (SETQ CHAR (ADD1 CHAR))) + (CLOSER LOC (LLSH WORD 1)) + (SETQ LOC (ADD1 LOC))) + ADDR]) + +(READ.AC + [LAMBDA (ACN PROCESS) + (JSYS 113 PROCESS EMACS.AC.BLK.START) + (OPENR (LOGOR EMACS.AC.BLK.START ACN]) + +(SET.EMACS.VARS + [LAMBDA NIL + + (* Sets LISP variables to the contents of the EMACS + buffer block (as documented in TECORD).) + + + (SETQ EMACS.BEG (OPENR EMACS.BEG.LOC)) + (SETQ EMACS.BEGV (OPENR EMACS.BEGV.LOC)) + (SETQ EMACS.PT (OPENR EMACS.PT.LOC)) + (SETQ EMACS.ZV (OPENR EMACS.ZV.LOC)) + (SETQ EMACS.Z (OPENR EMACS.Z.LOC)) + (SETQ EMACS.EXTRAC (OPENR EMACS.EXTRAC.LOC)) + (SETQ EMACS.MODIFF (OPENR EMACS.MODIFF.LOC)) + (SETQ EMACS.FSEXIT.ARG (READ.AC 3 (CAR LASTEMACS]) + +(SETUP.FANCY.DRIBBLE + [LAMBDA NIL + + (* To refresh the screen upon returning to LISP, we + use the dribble file to find out what was recently + typed. We first open the file with IOFILE. + Kindly, DRIBBLE lets us get away with that, because + if you first open a dribble file, you can't open it + for read later.) + + + (COND + ((DRIBBLEFILE) + (SETQ FANCY.DRIBBLE.FILE (CONS NIL NIL))) + (T [SETQ FANCY.DRIBBLE.FILE (OUTPUT (OUTFILE (QUOTE + LISP.DRIBBLE;-1;T] + (CLOSEF FANCY.DRIBBLE.FILE) + (IOFILE FANCY.DRIBBLE.FILE) + (DRIBBLE FANCY.DRIBBLE.FILE T T]) + +(SFCOC + [LAMBDA (TUPLE) + (PROG1 (LIST (JSYS 74 65 NIL NIL 2) + (JSYS 74 65 NIL NIL 3)) + (COND + (TUPLE (JSYS 75 65 (CAR TUPLE) + (CADR TUPLE]) + +(START.EMACS + (LAMBDA NIL (* edited: + " 3-Feb-79 15:20") + (PROG (TEMP NAME RSCAN.BLK) + + (* When we read from the EMACS buffer, we are sure + (provided we exited with meta z) that the buffer + ends with the sequence space, control-c, double + quote mark, control-c. We set up a read table that + causes an error upon encountering a control-c in the + file. The extra control-c and double quote mark + handle the case that we are inside a string read. + All this to prevent reading beyond the end of the + emacs buffer. If we could set the eof mark of + EMACS.MAP.FILE, we would. But there is no way we + know to do that. If the buffer had been large, the + eof mark could conceivably been far beyond where the + buffer we are reading now ends, and consequently, it + is possible that LISP might read a long time before + stopping.) + + + (SETQ EMACS.READ.TABLE (COPYREADTABLE FILERDTBL)) + (SETSYNTAX 3 (QUOTE (MACRO IMMEDIATE (LAMBDA (FL RDTBL) + (ERROR "End of EMACS buffer!")))) + EMACS.READ.TABLE) + (SETSYNTAX (QUOTE ') + (GETSYNTAX (QUOTE ') + (GETREADTABLE T)) + EMACS.READ.TABLE) + + (* Since the user will naturally type in single + quote marks, we want them to get turned into + QUOTE's. Unfortunately, INTERLISP does not do that + when reading from a file (with the default + FILEREADTBL.)) + + + (COND + (LASTEMACS (FLUSH.EMACS))) + + (* Our first step is always to get rid of any EMACS + fork and associated files around.) + + + (SETQ EMACS.TEMP.FILE (OUTPUT (OUTFILE (QUOTE EMACS.TEMP;-1;T) + ))) + + (* EMACS.TEMP.FILE will be the file to which we + print in lisp and from which EMACS reads + (via FSSUPERIOR).) + + + (SETFILEPTR EMACS.TEMP.FILE MAX.EMACS.INPUT) + (SPACES 1 EMACS.TEMP.FILE) + (CLOSEF EMACS.TEMP.FILE) + + (* We IOFILE the temp file so that we can write it + and EMACS can read it.) + + + (SETQ NAME (MKATOM (SIXBIT (JSYS 127)))) + (* We are going to SETNM + and want to restore.) + (SETNM (QUOTE LISP)) + (SETQ RSCAN.BLK (LOC (GETBLK 1))) + + (* We now put into the RSCAN area a string that + EMACS will execute when it is fired up. + The string that EMACS obtains via FJ is the string + put into the RSCAN minus the first word. + EMACS executes the TECO code after the first altmode + in the JCL returned by FJ. This execution is coded + in EMACS.INIT.) + + + (SETQ LASTEMACS (SUBSYS2 (QUOTE EMACS.SAV) + NIL NIL NIL NIL)) + (COND + ((NEQ NAME (QUOTE LISP)) + (SETNM NAME))) (* We dive down to + EMACS.) + (SETQ EMACS.AC.BLK.START (LOC (GETBLK 1))) + (SETQ EMACS.BUFFER.BLOCK (READ.AC 2 (CAR LASTEMACS))) + (* AC2 contains the + beginning of EMACS' + buffer block. + See TECORD.) + (COND + ((EQP (LLSH EMACS.BUFFER.BLOCK -9) + (LLSH (PLUS EMACS.BUFFER.BLOCK 9) + -9)) + (SETQ EMACS.BLK.SIZE 1)) + (T (SETQ EMACS.BLK.SIZE 2))) + + (* We aim to map in the EMACS buffer block into LISP + so that we can see what's gone on down there and so + that we can give an arg to FSSUPERIOR. + We may need one page or two depending upon where the + buffer lies.) + + + (SETQ OUR.BLOCK.START (LOC (GETBLK EMACS.BLK.SIZE))) + + (* We grab a block (or two) from LISP and save + (the boxed) start.) + + + (FOR VAR + IN (QUOTE (EMACS.BEG.LOC EMACS.BEGV.LOC EMACS.PT.LOC + EMACS.GPT.LOC EMACS.ZV.LOC + EMACS.Z.LOC EMACS.EXTRAC.LOC + EMACS.RESTART.LOC EMACS.ARG.LOC + EMACS.MODIFF.LOC)) + AS I FROM 0 DO (SET VAR (PLUS I (LOGOR OUR.BLOCK.START + (LOGAND 511 + EMACS.BUFFER.BLOCK))))) + + (* We set the values of variables to be the location + (in lisp) of the EMACS buffer block contents.) + + (* Now map the EMACS + buffer block page + (s) in.) + (JSYS 46 (,, (CAR LASTEMACS) + (LLSH EMACS.BUFFER.BLOCK -9)) + (,, OURPROCESS (LLSH OUR.BLOCK.START -9)) + (,, 53248 0)) + (COND + ((EQP EMACS.BLK.SIZE 2) + (JSYS 46 (,, (CAR LASTEMACS) + (ADD1 (LLSH EMACS.BUFFER.BLOCK -9))) + (,, OURPROCESS (ADD1 (LLSH OUR.BLOCK.START -9))) + (,, 53248 0)))) (* We may have to map in + two pages.) + + (* Now we put the entry vector for EMACS at the end + of the buffer block. When we start up the fork again + with SUBSYS1 (which calls SUBSYS) we will ask for + the process to be STARTed. This causes the control + to go the FSSUPERIOR, since the entry vector is + sitting at the location one is supposed to commence + to get FSSUPERIOR fired up.) + + + (JSYS 132 (CAR LASTEMACS) + (,, 1 (PLUS EMACS.BUFFER.BLOCK 7))) + (SETQ EMACS.MAP.FILE (OUTPUT (OUTFILE (QUOTE EMACS.MAP;-1;T))) + ) + + (* EMACS.MAP.FILE is the file into which we will + PMAP the buffer pages of EMACS. + We read from that file to get the value of the edits + performed.) + + + (CLOSEF EMACS.MAP.FILE) + (IOFILE EMACS.MAP.FILE) + + (* We have to have the map file open for read and + for write. Only way to do this in LISP is to first + create a file and then close it and then open it + with IOFILE.) + + + (SETQ EMACS.MAP.FILE.EOF 0) + + (* In order to avoid LISP causing an unjustified EOF + error when reading from the buffer, we must before + reading make sure that the EOF is beyond the end of + the buffer. We achieve the effect with + SETFILEPOINTER. To avoid needless calls of GETEOFPTR + and SETFILEPTR we keep track of the maximum we have + set the EOF pointer to.) + + + (SETQ EMACS.MAP.FILE.JFN (OPNJFN EMACS.MAP.FILE)) + (SETQ MAPPED.PAGES NIL) + + (* MAPPED.PAGES is a list of the EMACS process that + we have mapped into EMACS.MAP.FILE.) + + + (ECHOCONTROL CLEAR.SCREEN.NUMBER (QUOTE REAL)) + + (* A real 30 on a datamedia clears the screen and + puts the cursor at the top.) + + + (SETUP.FANCY.DRIBBLE) (* We need the RSCAN + block no more.) + (RELBLK (VAG RSCAN.BLK) + 1) + (TERPRI T) + (WHENCLOSE EMACS.MAP.FILE (QUOTE CLOSEALL) + (QUOTE NO)) + (WHENCLOSE EMACS.TEMP.FILE (QUOTE CLOSEALL) + (QUOTE NO)) + (RETURN NIL)))) + +(STIW + [LAMBDA (W) + (PROG1 (JSYS 123 -5 NIL NIL 2) + (COND + (W (JSYS 124 -5 W]) + +(SUBSYS1 + [LAMBDA (THREE INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE) + + (* Interlisp's SUBSYS does not work when the process + started up fiddles with the terminal interrupt + words, the control character output control, and the + binary/ascii mode word. SUBSYS1 tries to do the job + right by returning a triple containing the lower + process handle, the coc, and the tiw. + Also, an extra arg permits the forcing of entry into + binary mode when the lower process is restarted. + (A call in SUBSYS to SFMOD prevents us from + determining whether the lower process was in binary + mode.) Clearly, someone should do SUBSYS right. + SUBSYS0 is just the unadvised version of SUBSYS.) + + + (PROG (FORK TIW COC) + [COND + ((LITATOM THREE) + (ENABLE.CONTROL.C.CAPABILITY) + (SETQ FORK THREE) + (SETQ TIW (STIW)) + (SETQ COC (SFCOC))) + (T (SETQ FORK (CAR THREE)) + (SETQ TIW (CADR THREE)) + (SETQ COC (CADDR THREE] + (RETURN (RESETFORM (STIW TIW) + (RESETFORM (SFCOC COC) + (PROGN (COND + (BINARYMODE (BINARYMODE + ))) + (LIST (SUBSYS0 FORK + INCOMFILE + OUTCOMFILE + ENTRYPOINTFLG) + (STIW) + (SFCOC]) + +(SUBSYS2 + [LAMBDA (THREE INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE) + (PROG (FORKTHREE) + (SETQ FORKTHREE (SUBSYS1 THREE INCOMFILE OUTCOMFILE + ENTRYPOINTFLG BINARYMODE)) + CONTROL-C-LOOP + (COND + ([NOT (ZEROP (LOGAND 17179869184 (JSYS 93 (CAR FORKTHREE) + NIL NIL 2] + (* True if and only if + EMACS was exited with a + control-c.) + (JSYS 120) + (DISMISS 1000) + + (* We dismiss to permit the operating system to + arrange for the left half of ac1 returned by RFSTS + on the EMACS fork to be 2 instead of 0.0 This is a + horrible hack that is necessitated by a poor + implementation of RFSTS.) + + + (SETQ FORKTHREE (SUBSYS1 FORKTHREE NIL NIL NIL T)) + (GO CONTROL-C-LOOP)) + (T (RETURN FORKTHREE]) + +(TECO + [LAMBDA (MESS) + (PROG (DISPLAYTERMFLG) + (PRIN3 " +F+ +0:F +:F +" EMACS.TEMP.FILE) + (PRIN3 MESS EMACS.TEMP.FILE) + (PRIN3 " +MM^R Exit To LISP" EMACS.TEMP.FILE) + (DOWN T]) + +(WRITE.RSCAN + [LAMBDA (STR) + (PUTSTRING STR RSCAN.BLK) (* RSCAN) + (JSYS 320 (LOGOR (LLSH 147904 18) + RSCAN.BLK]) +) + +(RPAQQ NEMACSVARS ((DUMP.SCREEN.AMOUNT 500) + EMACS.P.PRINT.LEVEL EMACS.RETURN.ALIST OURPROCESS + MAX.EMACS.INPUT (LASTEMACS NIL) + (CLEAR.SCREEN.NUMBER 30) + (BL (CHARACTER CLEAR.SCREEN.NUMBER)))) + +(RPAQ DUMP.SCREEN.AMOUNT 500) + +(RPAQQ EMACS.P.PRINT.LEVEL (2 . 7)) + +(RPAQQ EMACS.RETURN.ALIST ((1000 EMACS.) + (1001 EMACS.?=) + (1002 EMACS.P) + (1003 EMACS.PP))) + +(RPAQQ OURPROCESS 131072) + +(RPAQQ MAX.EMACS.INPUT 896000) + +(RPAQ LASTEMACS NIL) + +(RPAQ CLEAR.SCREEN.NUMBER 30) + +(RPAQ BL (CHARACTER CLEAR.SCREEN.NUMBER)) +(PUTD (QUOTE SUBSYS0) + (VIRGINFN (QUOTE SUBSYS))) + +(ADDTOVAR ERRORTYPELST (16 (COND ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.MAP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.MAP.FILE)) + (ERROR "End of EMACS buffer!")) + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.TEMP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.TEMP.FILE)) + (ERROR "End of EMACS temporary file!") + )))) +(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) +) +(PRETTYCOMPRINT NEMACSCOMS) + +(RPAQQ NEMACSCOMS ((FNS * NEMACSFNS) + (VARS * NEMACSVARS) + (P (PUTD (QUOTE SUBSYS0) + (VIRGINFN (QUOTE SUBSYS)))) + (ADDVARS (ERRORTYPELST + (16 (COND ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.MAP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.MAP.FILE)) + (ERROR "End of EMACS buffer!")) + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.TEMP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.TEMP.FILE)) + (ERROR "End of EMACS temporary file!"))))) + ) + (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + (ADDVARS (NLAMA) + (NLAML) + (LAMA))))) +(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA ) +) +(DECLARE: DONTCOPY + (FILEMAP (NIL (1346 27481 (,, 1358 . 1411) (BINARYMODE 1415 . 1732) (CF +1736 . 2125) (CP 2129 . 2630) (CV 2634 . 3080) (DISPLAY.IN.ECHO.AND.DIVE + 3084 . 3482) (DOWN 3486 . 5641) (DUMP.SCREEN 5645 . 6318) (DUMPX 6322 . + 6730) (DUMPX1 6734 . 7561) (DWN 7565 . 7669) (E! 7673 . 8164) (E. 8168 +. 9100) (EDIT.DRIBBLE.FILE 9104 . 9369) (EMACS. 9373 . 9473) (EMACS.?= +9477 . 10084) (EMACS.GETDEF 10088 . 11624) (EMACS.P 11628 . 12163) ( +EMACS.PP 12167 . 13034) (EMACS.RETURN 13038 . 13128) ( +ENABLE.CONTROL.C.CAPABILITY 13132 . 13218) (FLUSH.EMACS 13222 . 14112) ( +GET.EMACS.BUFFER 14116 . 14701) (HK 14705 . 14741) (INFO 14745 . 14789) +(MAKE.QUOTE 14793 . 14994) (MAP.BYTES 14998 . 15268) ( +MAP.PROCESS.TO.FILE 15272 . 15668) (PAGE.OF.BYTE 15672 . 15901) ( +PUTSTRING 15905 . 16602) (READ.AC 16606 . 16726) (SET.EMACS.VARS 16730 . + 17251) (SETUP.FANCY.DRIBBLE 17255 . 17862) (SFCOC 17866 . 18029) ( +START.EMACS 18033 . 24835) (STIW 24839 . 24933) (SUBSYS1 24937 . 26234) +(SUBSYS2 26238 . 27098) (TECO 27102 . 27327) (WRITE.RSCAN 27331 . 27478) +)))) +STOP diff --git a/src/e142/nemacs.com b/src/e142/nemacs.com new file mode 100644 index 00000000..655c6f1e --- /dev/null +++ b/src/e142/nemacs.com @@ -0,0 +1,785 @@ +(FILECREATED " 3-Feb-79 15:21:46" ("compiled on " NEMACS.;11) (2 . 2 +)) +(FILECREATED " 3-Feb-79 15:21:16" NEMACS.;11 29497 changes to: +START.EMACS previous date: "27-Jan-79 17:19:41" NEMACS.;9) +,, BINARY +-. (B ,>,> GBx,^/,,~(VARIABLE-VALUE-CELL X . 3) +(VARIABLE-VALUE-CELL Y . 7) +(MKN BHC ENTERF)h` +BINARYMODE BINARY +-.^" ,>,>^"(BF,>,>^" @@#+ + + ABx,^/ ,^/@$+ + + Z,~0(KNIL BHC ENTER0) +8 +CF BINARY +-.ZB,~(VARIABLE-VALUE-CELL NAME . 3) +EMACS.GETDEF +(ENTERF) +CP BINARY +  +-.Z2B+ZXBZ,<,<$Z3B+-,+,<ZDZ3B+3B+-,+,<,<,,&,>Z2B+^" $+, ,^/@+ + + Z,<,<,<,<+,<*,XB ,Z1B+#,<-,<$-,<.".Z,<,<,<,<,<*,XB ++ /ZB/Z,~DD)\ (VARIABLE-VALUE-CELL NEGATE.ARG.FLG . 12) +(VARIABLE-VALUE-CELL EMACS.TEMP.FILE . 23) +(VARIABLE-VALUE-CELL EMACS.ARG.LOC . 10) +(VARIABLE-VALUE-CELL CLEAR.SCREEN.NUMBER . 30) +(VARIABLE-VALUE-CELL LASTEMACS . 69) +(VARIABLE-VALUE-CELL EMACS.EXTRAC . 54) +(VARIABLE-VALUE-CELL DUMP.SCREEN.AMOUNT . 72) +(NIL VARIABLE-VALUE-CELL TEMP . 19) +0 +SETFILEPTR +START +SUBSYS2 +GET.EMACS.BUFFER +" + Illegal exit from EMACS. Exit from EMACS only with meta-Z. + (The gap is not closed.) Returning to EMACS. +" +PRIN1 +3000 +DISMISS +EMACS.RETURN +DUMP.SCREEN +(ASZ KT BHC GUNBOX FIXT KNIL MKN FGFPTR ENTERF) H0 `" !xPH +DUMP.SCREEN BINARY +%$-.@ ,~Z3B+ !Z2B+^" ,>,>Z2B+ ^" $+ , ,^/@+ + + ZB"XB ,>,> ,^//,XB,<,<"$#3B+Z"XBZ,<,O-.>,(,>  ,^/3b+ Z`,~ , .",XB ++'@,+'Z,,XB,(,>ZB..Bx,^/."[A" 0B+Zp+ZB.+/Z,,,@B+Z,0,>ZB6.Bx,^/."[A" 0B+Zp+ZB7+/Z,,,$3,<>,,,>ZB, ,^/3b+ Z`,~Z,),>Z,,>Z2B+ ^" $+ , ,^/@8+ + +  ,>,> GBx,^/ ,,~(H@(VARIABLE-VALUE-CELL ACN . 30) +(VARIABLE-VALUE-CELL PROCESS . 3) +(VARIABLE-VALUE-CELL EMACS.AC.BLK.START . 27) +(MKN BHC GUNBOX FIXT KNIL ENTERF)8  Hx +SET.EMACS.VARS BINARY +-. ,XB ,XB ,XB ,XB ,XB ,XB ,XB,<ZDXB,~ +(VARIABLE-VALUE-CELL EMACS.BEG.LOC . 3) +(VARIABLE-VALUE-CELL EMACS.BEG . 6) +(VARIABLE-VALUE-CELL EMACS.BEGV.LOC . 7) +(VARIABLE-VALUE-CELL EMACS.BEGV . 10) +(VARIABLE-VALUE-CELL EMACS.PT.LOC . 11) +(VARIABLE-VALUE-CELL EMACS.PT . 14) +(VARIABLE-VALUE-CELL EMACS.ZV.LOC . 15) +(VARIABLE-VALUE-CELL EMACS.ZV . 18) +(VARIABLE-VALUE-CELL EMACS.Z.LOC . 19) +(VARIABLE-VALUE-CELL EMACS.Z . 22) +(VARIABLE-VALUE-CELL EMACS.EXTRAC.LOC . 23) +(VARIABLE-VALUE-CELL EMACS.EXTRAC . 26) +(VARIABLE-VALUE-CELL EMACS.MODIFF.LOC . 27) +(VARIABLE-VALUE-CELL EMACS.MODIFF . 30) +(VARIABLE-VALUE-CELL LASTEMACS . 32) +(VARIABLE-VALUE-CELL EMACS.FSEXIT.ARG . 34) +3 +READ.AC +(MKN ENTER0)x +8 x8 +SETUP.FANCY.DRIBBLE BINARY + -.  3B+Z,XB,~,< " +B +XBBZBZ,<,<,<&,~P@(VARIABLE-VALUE-CELL FANCY.DRIBBLE.FILE . 17) +DRIBBLEFILE +LISP.DRIBBLE;-1;T +OUTFILE +OUTPUT +CLOSEF +IOFILE +DRIBBLE +(KT CONSNL KNIL ENTER0)0 +0 +SFCOC BINARY +-.^" @@%+ + + ,,<^" @@%+ + + ,,,,>^",>,> &ABx,^/GBx,^/,D/ ,\,[`XB` 5.",XB@+1Z`,~Z",< 9(B{,D22B+I^"+I,,>,>Z,< 6(B{,D22B+O^"+P, ,^/,>,>,>,>,<2,<3$22B+W^"+W, ,^/,^/+ + + Z-,<,<-$/3B+xZD,< E(B{.",D22B+d^"+e,,>,>ZJ,< K(B{.",D22B+k^"+l, ,^/,>,>,>,>,<3,<3$22B+s^"+s, ,^/,^/+ + + Z_2B+z^"+{,,>,>,<(Z`,<,<4$/D22B+^"+, ,^/ B+ + + ,<4"'B'XBB)ZB5Z"XBZB5XBZXBZ,<,<6$6 7Z,,<,<($7,<"8Z +,<,<8,<9&9Z,<,<8,<9&9Z,~_2>p7H'eE(0 ( +B] P  +uTj:D4s@(VARIABLE-VALUE-CELL FILERDTBL . 6) +(VARIABLE-VALUE-CELL EMACS.READ.TABLE . 18) +(VARIABLE-VALUE-CELL LASTEMACS . 240) +(VARIABLE-VALUE-CELL EMACS.TEMP.FILE . 298) +(VARIABLE-VALUE-CELL MAX.EMACS.INPUT . 29) +(VARIABLE-VALUE-CELL EMACS.AC.BLK.START . 67) +(VARIABLE-VALUE-CELL EMACS.BUFFER.BLOCK . 249) +(VARIABLE-VALUE-CELL EMACS.BLK.SIZE . 184) +(VARIABLE-VALUE-CELL OUR.BLOCK.START . 206) +(VARIABLE-VALUE-CELL OURPROCESS . 204) +(VARIABLE-VALUE-CELL EMACS.MAP.FILE . 293) +(VARIABLE-VALUE-CELL EMACS.MAP.FILE.EOF . 275) +(VARIABLE-VALUE-CELL EMACS.MAP.FILE.JFN . 278) +(VARIABLE-VALUE-CELL MAPPED.PAGES . 280) +(VARIABLE-VALUE-CELL CLEAR.SCREEN.NUMBER . 281) +(NIL VARIABLE-VALUE-CELL TEMP . 0) +(NIL VARIABLE-VALUE-CELL NAME . 60) +(NIL VARIABLE-VALUE-CELL RSCAN.BLK . 286) +COPYREADTABLE +3 +((MACRO IMMEDIATE (LAMBDA (FL RDTBL) (ERROR "End of EMACS buffer!"))) . 0) +SETSYNTAX +' +GETREADTABLE +GETSYNTAX +FLUSH.EMACS +EMACS.TEMP;-1;T +OUTFILE +OUTPUT +SETFILEPTR +1 +SPACES +CLOSEF +SIXBIT +MKATOM +LISP +SETNM +GETBLK +EMACS.SAV +SUBSYS2 +2 +READ.AC +9 +PLUS +EQP +((EMACS.BEG.LOC EMACS.BEGV.LOC EMACS.PT.LOC EMACS.GPT.LOC EMACS.ZV.LOC +EMACS.Z.LOC EMACS.EXTRAC.LOC EMACS.RESTART.LOC EMACS.ARG.LOC EMACS.MODIFF.LOC) . + 0) +NIL +(NIL VARIABLE-VALUE-CELL VAR . 105) +(NIL VARIABLE-VALUE-CELL I . 132) +,, +53248 +0 +53248 +7 +EMACS.MAP;-1;T +IOFILE +OPNJFN +REAL +ECHOCONTROL +SETUP.FANCY.DRIBBLE +RELBLK +TERPRI +CLOSEALL +NO +WHENCLOSE +(GUNBOX SET BHC SKNLST ASZ IUNBOX MKN KNIL KT ENTER0)8vXn (Y + =@0 1X,8t +He P )i (MpB`/ & h y j 8_ +`N +XH8( +STIW BINARY +-.^"}@@=+ + + ,,,>Z2B+ ^" $+ +, ,^/@>+ + + ,\,~(H(VARIABLE-VALUE-CELL W . 19) +(BHC GUNBOX FIXT KNIL MKN ENTERF)pXH0 +SUBSYS1 BINARY +UBR-.(B@E,~Z-,+ GZXB GXB HXB+ +ZXB[ZXB[ [ZXBZ +BG,<@H ,~,,>Z2B+ +^" $+ +,@@.+ + + ABx,^/1B+@@@<+ + + ,<"""Z +,<,<,<,<,<*!XB+Z,~ ,$ (VARIABLE-VALUE-CELL THREE . 6) +(VARIABLE-VALUE-CELL INCOMFILE . 8) +(VARIABLE-VALUE-CELL OUTCOMFILE . 10) +(VARIABLE-VALUE-CELL ENTRYPOINTFLG . 12) +(VARIABLE-VALUE-CELL BINARYMODE . 14) +(NIL VARIABLE-VALUE-CELL FORKTHREE . 57) +SUBSYS1 +1000 +DISMISS +(KT BHC GUNBOX FIXT KNIL ENTERF)80`P0  +TECO BINARY + + +-. +@ ,~,< ZD Z, ,> GBx,^/@@ + + + ,,~A`P(VARIABLE-VALUE-CELL STR . 3) +(VARIABLE-VALUE-CELL RSCAN.BLK . 11) +PUTSTRING +(MKN BHC ENTERF)  +(PRETTYCOMPRINT NEMACSCOMS) +(RPAQQ NEMACSCOMS ((FNS * NEMACSFNS) (VARS * NEMACSVARS) (P (PUTD (QUOTE SUBSYS0 +) (VIRGINFN (QUOTE SUBSYS)))) (ADDVARS (ERRORTYPELST (16 (COND ((AND (NEQ (QUOTE + NOBIND) (GETATOMVAL (QUOTE EMACS.MAP.FILE))) (EQ (CADR ERRORMESS) +EMACS.MAP.FILE)) (ERROR "End of EMACS buffer!")) ((AND (NEQ (QUOTE NOBIND) ( +GETATOMVAL (QUOTE EMACS.TEMP.FILE))) (EQ (CADR ERRORMESS) EMACS.TEMP.FILE)) ( +ERROR "End of EMACS temporary file!")))))) (DECLARE: DONTEVAL@LOAD +DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML))))) +(RPAQQ NEMACSFNS (,, BINARYMODE CF CP CV DISPLAY.IN.ECHO.AND.DIVE DOWN +DUMP.SCREEN DUMPX DUMPX1 DWN E! E. EDIT.DRIBBLE.FILE EMACS. EMACS.?= +EMACS.GETDEF EMACS.P EMACS.PP EMACS.RETURN ENABLE.CONTROL.C.CAPABILITY +FLUSH.EMACS GET.EMACS.BUFFER HK INFO MAKE.QUOTE MAP.BYTES MAP.PROCESS.TO.FILE +PAGE.OF.BYTE PUTSTRING READ.AC SET.EMACS.VARS SETUP.FANCY.DRIBBLE SFCOC +START.EMACS STIW SUBSYS1 SUBSYS2 TECO WRITE.RSCAN)) +(RPAQQ NEMACSVARS ((DUMP.SCREEN.AMOUNT 500) EMACS.P.PRINT.LEVEL +EMACS.RETURN.ALIST OURPROCESS MAX.EMACS.INPUT (LASTEMACS NIL) ( +CLEAR.SCREEN.NUMBER 30) (BL (CHARACTER CLEAR.SCREEN.NUMBER)))) +(RPAQ DUMP.SCREEN.AMOUNT 500) +(RPAQQ EMACS.P.PRINT.LEVEL (2 . 7)) +(RPAQQ EMACS.RETURN.ALIST ((1000 EMACS.) (1001 EMACS.?=) (1002 EMACS.P) (1003 +EMACS.PP))) +(RPAQQ OURPROCESS 131072) +(RPAQQ MAX.EMACS.INPUT 896000) +(RPAQ LASTEMACS NIL) +(RPAQ CLEAR.SCREEN.NUMBER 30) +(RPAQ BL (CHARACTER CLEAR.SCREEN.NUMBER)) +(PUTD (QUOTE SUBSYS0) (VIRGINFN (QUOTE SUBSYS))) +(ADDTOVAR ERRORTYPELST (16 (COND ((AND (NEQ (QUOTE NOBIND) (GETATOMVAL (QUOTE +EMACS.MAP.FILE))) (EQ (CADR ERRORMESS) EMACS.MAP.FILE)) (ERROR +"End of EMACS buffer!")) ((AND (NEQ (QUOTE NOBIND) (GETATOMVAL (QUOTE +EMACS.TEMP.FILE))) (EQ (CADR ERRORMESS) EMACS.TEMP.FILE)) (ERROR +"End of EMACS temporary file!"))))) +(PRETTYCOMPRINT NEMACSCOMS) +(RPAQQ NEMACSCOMS ((FNS * NEMACSFNS) (VARS * NEMACSVARS) (P (PUTD (QUOTE SUBSYS0 +) (VIRGINFN (QUOTE SUBSYS)))) (ADDVARS (ERRORTYPELST (16 (COND ((AND (NEQ (QUOTE + NOBIND) (GETATOMVAL (QUOTE EMACS.MAP.FILE))) (EQ (CADR ERRORMESS) +EMACS.MAP.FILE)) (ERROR "End of EMACS buffer!")) ((AND (NEQ (QUOTE NOBIND) ( +GETATOMVAL (QUOTE EMACS.TEMP.FILE))) (EQ (CADR ERRORMESS) EMACS.TEMP.FILE)) ( +ERROR "End of EMACS temporary file!")))))) (DECLARE: DONTEVAL@LOAD +DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA))))) +NIL diff --git a/src/e142/nemacs.doc b/src/e142/nemacs.doc new file mode 100644 index 00000000..bce1f1ca --- /dev/null +++ b/src/e142/nemacs.doc @@ -0,0 +1,334 @@ +Documentation of an interface between EMACS and INTERLISP. + +Robert Boyer, August 1978 +(MMCM provided the solutions to most of the hard problems.) + +0. Advertisement + +Why would anyone want to use EMACS together with Interlisp? + +a. When you are typing to Interlisp, you are already using +a text editor, one of the world's worst: it has only delete, +control-U, control-W, and control-R (which works poorly). +If you use EMACS, you get far more control over your type-in +because you can arbitrarily backup and edit. But far more +importantly, it becomes very difficult to make parenthesis +mistakes: if you type line feed instead of carriage return, +the next line is indented to the correct place; when you +type a close parenthesis, you see displayed automatically +the open parenthesis to which it corresponds. + +b. When you use EDITF, you have to keep doing P commands to +see where you are and what you have done. That is probably +just right for a 100 baud teletype. But it is silly for a +9600 baud display, with its ability to keep constantly +before your eyes what you are working on. Until EMACS came, +however, the only available display oriented editors working +on Datamedia's were for text, not code. Working on LISP +code with, say, TV or TVEDIT commands, is arguably worse +than using EDITF which knows so much about the structure of +LISP sexpressions. But EMACS is approximately as informed +about the structure of LISP as is EDITF. And EMACS, besides +keeping your work right before your eyes, is far better at +the character and single parenthesis level than EDITF. Read +about all the control-meta commands in the EMACS +documentation. The TECO under EMACS really knows the syntax +of LISP (including ', %, and "). + +1. User's Guide To Use The Interface + +To use the interface, start LISP and load the file +NEMACS.COM into LISP and call (START.EMACS). When +that returns (it takes a cpu second or two), you can edit +functions, variables, and property lists with EMACS. To +edit a function, invoke the function CF on the name of the +function (for example CF(FOO)). The function definition is +written into the EMACS buffer surrounded in a (DEFINEQ...). +The virtual buffer boundaries are narrowed to the contents +of the definition. You are placed in EMACS, where you may +edit away. To return to LISP, type meta-z. But first +put point at the beginning of the +"(DEFINEQ", which can usually be gotten to by control-meta-a +or control-<. When you return to LISP nothing has yet +happened to your function. But if you execute the function +E. (that's E followed by a period to remind you of the TECO +point) of no arguments (e.g. "E.]"), then the (modified) +DEFINEQ is executed. When you return to LISP, your display +is refreshed to contain some of the text it held before the +descent into CF. You may resume ordinary LISP interaction +now, or you can call CF on another function and it will also +be inserted in the buffer (and you will be put down into +EMACS again). Again you edit, exit with meta-z, and then +you can execute E. if you want. If you wish to pop up to +LISP in the middle of an edit, then type meta-z and return +to EMACS by invoking (DOWN). + +To edit a variable, use CV. To edit a property list, use +CP. + +The foregoing is all you need to know to edit. It may be +useful to know a little more. To get rid of an EMACS +interface, call (FLUSH.EMACS). To get EMACS to insert into +its buffer anything you want, simply write to the file that +is the value of the variable EMACS.TEMP.FILE. Then call +(DOWN) and the stuff written to the temp file will appear in +the buffer at the end (as with the A command). The virtual +buffer is narrowed to the text that is inserted. (If +nothing has been written to EMACS.TEMP.FILE since the last +return to LISP, (DOWN) simply returns you to the state in +which you last left EMACS. are returned to lisp. If you +execute E.], then the sexp Repeated E.]'s will evaluate +through the buffer. If you want to read from the buffer +yourself, feel free: the file is named EMACS.MAP.FILE. +Upon return to LISP, the file pointer of EMACS.MAP.FILE +is set to the point of the EMACS buffer. + +Warning: never close EMACS.TEMP.FILE or EMACS.MAP.FILE "by +hand." Use FLUSH.EMACS to get rid of them. CLOSEALL() +will not close them, but CLOSEF and CLOSEALL(T) will. A +dribble file is used by the interface to refresh the screen. +If you are using DRIBBLE when you start using NEMACS, or +if you start using DRIBBLE after you start using NEMACS, +then the screen refreshment will not occur. + +If you call (DOWN T), then instead of being inserted, the +text that would have been inserted upon entry to EMACS is +executed (as TECO code, of course). + + +2. Guide to the implementation. + +START.EMACS creates a fork (via SUBSYS) and opens up two +files, the values of the variables EMACS.MAP.FILE and +EMACS.TEMP.FILE. EMACS is passed the instruction MMLOAD +LIBINTERMACSFSEXIT via the FJ (RSCAN) command. +The library INTERMACS contains several EMACS ^R commands. +The library initialization initializes the communication +between the two forks. The EMACS fork handle is the CAR of +LASTEMACS. Whenever control is passed to the EMACS fork, +(by a call to DOWN), a teco macro in FS SUPERIOR is invoked, +given a single numeric argument. The number's absolute +value is the file pointer of EMACS.TEMP.FILE at the time of +descent. If the number is positive, then the FSSUPERIOR +macro inserts the contents of EMACS.TEMP.FILE (up to the +file pointer) at the end of the buffer, narrows the virtual +buffer boundaries to the test inserted, and refreshes the +screen. If the arg is negative, the stuff that would have +been inserted is macroed (in q-register a). Nothing happens +if the arg is 0 except that the screen is refreshed. When +the FSSUPERIOR macro exits, you are in ordinary EMACS +control-r mode. + +Before returning to LISP, the command meta-z closes the gap. +Upon return to LISP, we make sure that every page of the +current EMACS buffer is PMAPed into a page of EMACS.MAP.FILE +(the same page numbers for both). We further set the +variables EMACS.BEG, EMACS.PT, and EMACS.Z to the appropriate +numbers so that they can serve as file pointers into EMACS.MAP.FILE +for the beginning, point, and end of the EMACS buffer. +We set the file pointer of EMACS.MAP.FILE to EMACS.PT. That's +why E. reads from point. But you can read anywhere from EMACS.BEG +to EMACS.Z. You should read with EMACS.READ.TABLE (or a +modification thereof that leaves the handling of control-c +the same) to catch reading past the end of the buffer by +mistake. We place a sequence of four characters (space, +control-c, double quote mark, control-c) at the bottom of the +buffer (and delete them upon return) to catch unbalanced +expression reading. The file pointer of EMACS.TEMP.FILE is +set to 0 upon return to LISP. + +The full details of the hook EMACS has for doing these +things are found in the last few pages of TECORD. + + +3. Miscellaneous Notes on IO + +The variable DUMP.SCREEN.AMOUNT controls how many characters +of the dribble file are written to the screen after +returning to LISP from EMACS. Nothing is written unless +DISPLAYTERMFLG is non-NIL. + +In the file INTERMACS, the delimiter table (what's in ..D) +is fixed to reflect Interlisp (as opposed to the default +Maclisp). In particular, + + all control characters except tab, carriage return, and + line feed are "OTHER" (i.e. just like ordinary alphabetic letters); + + % quotes the next character, + + " delimits strings (it takes the place of | in Maclisp, + which has no strings (on DEC machines), but uses | to + delimit weird atoms); + + /,|, and ; have no significance. + +Square brackets mean nothing to EMACS. If you (SETQ #RPARS +NIL), then the Interlisp pretty printer (PRINTDEF) will not +use square brackets for parentheses, even during MAKEFILE. +You can still type them in to LISP. But you should set +#RPARS (in your init file, perhaps) because often CF gets +the text of a function from your files, where MAKEFILE might +have written square brackets. The function would still +be editable in EMACS, but the parenthesis commands of +EMACS would not respect the square brackets. + +When you are down in EMACS, you can pretty print expressions +in two ways. ^R Format Code (on control-meta-g, which may +be entered by typing hold-g) will pretty print the +expression after point. It works well on small expressions, +less well on large. On large expressions, (particularly the +on the result of editing previously reasonably formatted +expressions), ^R Indent Sexp (control-meta-q) works well. +The reason it works well is that it inserts no carriage +returns at all, but merely fixes the number of leading +spaces on each line. ^R Format Code is a version of the ITS +grinder modified to know about %, ", etc. + +If you set NORMALCOMMENTSFLG to NIL and if you print to +EMACS.TEMP.FILE yourself, be sure to readjust +PRETTYPRINTMACROS by consing (* . GETTCOMMENT) on or you'll +get your comments mapped into the EMACS temp file. + +If you set NORMALCOMMENTSFLG to NIL and if you read from +EMACS.MAP.FILE yourself, then you should bind +NORMALCOMMENTSFLG to NIL during the read. + +When typing into EMACS, your close parentheses will cause +the cursor to bounce back to the balancing open parentheses. +The cursor will stay there 1 second or until you type +another character. To suppress this feature, execute +0m.vLISP ) Hack$ in a minibuffer. To get a longer delay, +use the integral number of seconds you want instead of 0. +To get bouncing to occur only when the corresponding +open parenthesis is on the screen, use the +negative of the number of seconds. + + +4. Specification of the Interlisp commands + +START.EMACS[] creates a new fork containing the EMACS editor +and returns to LISP. + +DOWN[NEGATE.ARG.FLG] passes control to the EMACS fork. If +negate.arg.flg is NIL, then EMACS will insert at the end of +the buffer everything in the file EMACS.TEMP.FILE from 0 to +the current file pointer. If there is something to insert, +then the virtual buffer boundaries are narrowed to what is +inserted. (The buffer boundaries can be widened to the +whole buffer with ^R Set Bound Full (on control-x-w)). The +screen is refreshed. If negate.arg.flg is non-NIL the text +that would have been inserted is put in q-register a and +executed. + All of the following commands that descend to EMACS do so +through calls to DOWN. Upon return to LISP, the file pointer +of EMACS.TEMP.FILE is set to 0. The screen is refreshed +with the last DUMP.SCREEN.AMOUNT characters from the in the +dribble file. All the pages of EMACS containing the current +EMACS buffer are mapped into the file EMACS.MAP.FILE. +EMACS.BEG, EMACS.PT, EMACS.Z, and EMACS.MODIFF are set to +the corresponding values in the buffer block (see +TECORD). EMACS.PT is an appropriate file pointer to +use to read from EMACS.MAP.FILE starting at the point. The +file pointer of EMACS.MAP.FILE is set to EMACS.PT. An error +is caused if EMACS returns to LISP without first closing the +gap. (The proper return is via meta-z, but 1F? FSEXIT is +sufficient if you want to do it yourself.) + +E.[] executes the sexpression starting at the current point +in the EMACS buffer. The execution is recorded as an event +on the history list just as if it had been typed into the +top level read-print-eval loop. The appearance of the execution +on the dribble file is "faked" by printing it to a shallow +depth so that when the screen is refreshed, it looks vaguely +like you typed something in. But the event is really there, +so that ??, REDO, UNDO, etc. all work. + +E![N] executes sexpressions starting at the current point +in the EMACS buffer using E. (above). If N is a number, +then N sexpressions are read and executed. If N is NIL, +then all the sexpressions in the buffer after point are +executed. + +CF[FNNAME] writes the definition of a function into the end +of the EMACS buffer and dives down to EMACS with point at +the beginning of the insertion. The definition is inside a +DEFINEQ and hence suitable for later execution with E.[]. +The definition of the function is fetched much the way that +EDITF does except that no spelling correction is attempted. +In particular, if fnname is NIL, lastword is used. If +fnname has an expr definition, the unadvised, unbroken +version is used. If fn does not have a expr definition but +does have an EXPR property, that is used. Otherwise, the +definition of the function in the first file said to contain +it is used. (Using WHEREIS to find it and using filemaps to +get it quickly into the EMACS buffer without going through +LISP). When CF returns, the function has not been changed at +all; to cause the redefinition, use E., E!, (or C-M-Y from +TECO). + +CV[X] writes a variable name and definition inside an RPAQQ +into the EMACS buffer at the end and descends to EMACS. The +variable has not been affected when you return to LISP; to +cause the resetting, use E., E!, (or C-M-Y from TECO). + +CP[X] writes a litatom and its property list inside a +SETPROPLIST into the EMACS buffer at the end and descends to +EMACS. The property list has not been changed when you +return to EMACS; to set the property list, use E., E!, +(or C-M-Y from TECO). + +TECO[STR] runs the lower level EMACS on the result +of PRIN1ing STR and then exits. For example, TECO(HK) +clear the EMACS buffer and returns to LISP. + +EDIT.DRIBBLE.FILE[] runs EMACS on the Lisp dribble +file in a buffer called DRIBBLE. + +INFO[] runs the INFO program. + +5. The commands available in the EMACS fork. + +Besides the ordinary control-meta commands that are +part of EMACS and the linefeed and LISP ) hack that +come with EMACS lisp mode, there are a few other commands +useful in the Interlisp EMACS interface. + +Meta-z runs the macro ^R Exit to LISP. Simply returns +control to LISP after control has been passed to EMACS +by DOWN (or CF, CV, or CP which call DOWN). Closes the +gap so that LISP can read from the buffer. Places the +sequence space, control-c, ", control-c at the end of +the buffer to stop reading beyond the end of the buffer. +If the new release of TOPS-20 permits the effective +setting of the end of file pointer for a file without +the necessity of closing it, these characters will not be +inserted (eventually). + +Control-p runs the macro ^R Print to Level. Prints into +a second window what EDITF prints for the P command. Useful +if the current sexpression is bigger than a screen full. +To get rid of a second window, you can call ^R One Window, +which is hung on ^X-1. + +Control-meta-? runs the macro ^R ARGLIST. Prints into +a second window the arglist of the function after point +(or after the ( after point if there is one.) On a datamedia, +this command is entered by typing hold (control-_) followed +by ?. To get rid of a second window, you can call ^R One Window, +which is hung on ^X-1. + +Control-meta-y runs the macro ^R UP EVAL. Does an exit +up to lisp and then E.'s the expression after point and +retfrom's DOWN. Approximately identical to meta-z followed +by E. + +Currently, the above 3 commands all work by calling ^R Exit +to LISP with an argument. That argument is deposited in +AC3 when EMACS exits. When DOWN gets control back, it +retrieves the argument and sassoc's down the alist +EMACS.RETURN.ALIST. If a pair is found, then the CDR of the +pair is LISPXEVALED. After evaluation, or if no pair is +found, DOWN refreshes the LISP screen and exits. +Control-meta-y, for example does the E. and then retfrom's +DOWN. \ No newline at end of file diff --git a/src/e142/nemacs.kl b/src/e142/nemacs.kl new file mode 100644 index 00000000..e0ff2329 --- /dev/null +++ b/src/e142/nemacs.kl @@ -0,0 +1,1045 @@ +(FILECREATED "28-Dec-78 17:58:56" NEMACS..144 28948 + + changes to: GETDEF CF EMACS.GETDEF NEMACSFNS + + previous date: "28-Dec-78 17:44:56" NEMACS..143) + + +(PRETTYCOMPRINT NEMACSCOMS) + +(RPAQQ NEMACSCOMS ((FNS * NEMACSFNS) + (VARS * NEMACSVARS) + (P (PUTD (QUOTE SUBSYS0) + (VIRGINFN (QUOTE SUBSYS)))) + (ADDVARS (ERRORTYPELST + (16 (COND ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.MAP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.MAP.FILE)) + (ERROR "End of EMACS buffer!")) + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.TEMP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.TEMP.FILE)) + (ERROR "End of EMACS temporary file!"))))) + ) + (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + (ADDVARS (NLAMA) + (NLAML) + (LAMA))))) + +(RPAQQ NEMACSFNS (,, BINARYMODE CF CP CV DISPLAY.IN.ECHO.AND.DIVE DOWN + DUMP.SCREEN DUMPX DUMPX1 DWN E! E. + EDIT.DRIBBLE.FILE EMACS. EMACS.?= EMACS.GETDEF + EMACS.P EMACS.PP EMACS.RETURN + ENABLE.CONTROL.C.CAPABILITY FLUSH.EMACS + GET.EMACS.BUFFER HK INFO MAKE.QUOTE MAP.BYTES + MAP.PROCESS.TO.FILE PAGE.OF.BYTE PUTSTRING READ.AC + SET.EMACS.VARS SETUP.FANCY.DRIBBLE SFCOC + START.EMACS STIW SUBSYS1 SUBSYS2 TECO WRITE.RSCAN)) +(DEFINEQ + +(,, + (LAMBDA (X Y) + (LOGOR (LLSH X 18) + Y))) + +(BINARYMODE + (LAMBDA NIL + (JSYS 72 65 (LOGAND (LOGXOR (LLSH 1 6) + -1) + (JSYS 71 65 NIL NIL 2))) + + (* We turn off B29 in the JFN Mode Word of the + current output device. If the user is in ASCII mode, + this puts him in Binary mode, which is what is + required by EMACS.) + + + NIL)) + +(CF + (LAMBDA (NAME) + + (* Gets the definition of a function and dives down + to EMACS. Like Teitelman's EDITF, CF uses LASTWORD + if given NIL. The unbroken, unadvised version of the + function is obtained. If the function is compiled, + we check first for an EXPR. Otherwise we try to get + it from the first file that contains it.) + + + (EMACS.GETDEF NAME))) + +(CP + (LAMBDA (X) + + (* Like EDITP, it dives down to EMACS with the + property list of a litatom to edit.) + + + (COND + ((NULL X) + (SETQ X LASTWORD) + (PRINT LASTWORD T))) + (COND + ((AND X (LITATOM X)) + (PRIN3 "(SETPROPLIST " EMACS.TEMP.FILE) + (PRIN4 (KWOTE X) + EMACS.TEMP.FILE) + (SPACES 1 EMACS.TEMP.FILE) + (DUMPX (LIST (QUOTE QUOTE) + (GETPROPLIST X))) + (PRIN3 ") + +" EMACS.TEMP.FILE) + (DOWN)) + (T (ERROR "No editable property list: " X))))) + +(CV + (LAMBDA (X) + + (* Like EDITV, it dives down to EMACS with the value + of a variable to edit.) + + + (COND + ((NULL X) + (SETQ X LASTWORD) + (PRINT LASTWORD T))) + (COND + ((NEQ (GETTOPVAL X) + (QUOTE NOBIND)) + (PRIN3 "(RPAQQ " EMACS.TEMP.FILE) + (PRIN4 X EMACS.TEMP.FILE) + (SPACES 1 EMACS.TEMP.FILE) + (DUMPX (GETTOPVAL X)) + (PRIN3 ") + +" EMACS.TEMP.FILE) + (DOWN)) + (T (ERROR X " has no value."))))) + +(DISPLAY.IN.ECHO.AND.DIVE + (LAMBDA (LIST) + (PRIN3 "MM^R Two Windows +MMSELECT BUFFERPRINT +HK +I" EMACS.TEMP.FILE) + (PRIN3 (APPLY (FUNCTION CONCAT) + LIST) + EMACS.TEMP.FILE) + (PRIN3 + +" +0J +QWINDOW 2 SIZE-3%"N 3-QWINDOW 2 SIZEMM^R GROW WINDOW' +MM^R OTHER WINDOW +MM& MULTI-WINDOW REFRESH" + EMACS.TEMP.FILE) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN T))))) + +(DOWN + (LAMBDA (NEGATE.ARG.FLG) + + (* This is the main function of the EMACS interface + for diving down to EMACS. Once START.EMACS has been + called, DOWN may be called at any time to enter + EMACS. Meta-z will exit from EMACS and return to + down. When DOWN invokes EMACS, it passes to EMACS a + number whose absolute value is the current file + pointer of the file EMACS.TEMP.FILE. + The number is passed to a teco macro in FSSUPERIOR + which is invoked when the EMACS gains control. + If the argument to DOWN is NIL, then the current + file pointer is passed and EMACS simply inserts the + text at the end of the buffer. + If DOWN is given the argument T, then the negative + of the current file pointer is passed. + EMACS takes a negative number to be the instruction + to insert that much text, put it into q-register a, + delete the text and macro A. + Thus, if you simply want to insert some text into + the EMACS buffer, just print that text into + EMACS.TEMP.FILE and call (DOWN). But if you want a + fancier event to occur when EMACS gains control, + then print teco code to EMACS.TEMP.FILE and then + call (DOWN T).) + + + (PROG (TEMP) + (SETQ TEMP (GETFILEPTR EMACS.TEMP.FILE)) + (CLOSER EMACS.ARG.LOC (COND + (NEGATE.ARG.FLG (IMINUS TEMP)) + (T TEMP))) + + (* EMACS.ARG.LOC is a location in a page of lisp + that is identical to the spot that FSSUPERIOR looks + for its argument. See the last few pages of + TECORD.) + + + (SETFILEPTR EMACS.TEMP.FILE 0) + (JSYS 41 65 CLEAR.SCREEN.NUMBER) (* See DUMP.SCREEN.) + (SETQ LASTEMACS (SUBSYS2 LASTEMACS NIL NIL (QUOTE START) + T)) + (GET.EMACS.BUFFER) + LOOP(COND + ((NOT (ZEROP EMACS.EXTRAC)) + (PRIN1 + +" + Illegal exit from EMACS. Exit from EMACS only with meta-Z. + (The gap is not closed.) Returning to EMACS. +" + T) + (DISMISS 3000) + (SETQ LASTEMACS (SUBSYS2 LASTEMACS NIL NIL NIL NIL)) + (GO LOOP))) + (EMACS.RETURN) + (DUMP.SCREEN DUMP.SCREEN.AMOUNT)))) + +(DUMP.SCREEN + (LAMBDA (N) + (PROG (TEMP TEMP1) + (COND + ((AND DISPLAYTERMFLG (EQ (DRIBBLEFILE) + FANCY.DRIBBLE.FILE)) + + (* We ship out to the terminal a 30, which will + cause the screen to clear. We don't PRIN1 it because + we do not want it to get into the dribble file. + Then we flash up onto the scrren the last page or so + of text that appeared on the screen during LISP.) + + + (JSYS 41 65 CLEAR.SCREEN.NUMBER) + (SETQ TEMP (GETEOFPTR FANCY.DRIBBLE.FILE)) + (SETQ TEMP1 (IDIFFERENCE TEMP N)) + (COND + ((LESSP TEMP1 0) + (SETQ TEMP1 0))) + (COPYBYTES FANCY.DRIBBLE.FILE T TEMP1 TEMP)))))) + +(DUMPX + (LAMBDA (X) + (COND + ((AND (LISTP X) + (EQ (CAR X) + (QUOTE DEFINEQ)) + (LISTP (CDR X)) + (NULL (CDDR X)) + (LISTP (CADR X)) + (LISTP (CDADR X)) + (NULL (CDDADR X))) + (PRIN3 "(DEFINEQ (" EMACS.TEMP.FILE) + (PRIN4 (CAADR X) + EMACS.TEMP.FILE) + (PRIN3 " " EMACS.TEMP.FILE) + (DUMPX1 (CAR (CDADR X))) + (PRIN3 ")) + +" EMACS.TEMP.FILE)) + (T (DUMPX1 X))))) + +(DUMPX1 + (LAMBDA (X DEF) + + (* We write X into EMACS.TEMP.FILE using the pretty + print algorithm on PPR. + We set the LINELENGTH to 79 because EMACS stupidly + causes wraparound at 80 (instead of 81). The + GETCOMMENT stuff causes lisp comments that are + currently mapped out (because NORMALCOMMENTSFLG is + NIL) to get sent down to EMACS.) + + + (RESETFORM + (LINELENGTH 79) + (RESETFORM (OUTFILE EMACS.TEMP.FILE) + (PROGN (COND + ((GETD (QUOTE PPRIND)) + (PROG ((FORCEIN 1000)) + (PPRIND X 0 0 (QUOTE ( + (* . GETCOMMENT) + (QUOTE . + MAKE.QUOTE))))) + ) + (T (PROG ((PRETTYPRINTMACROS + (CONS (QUOTE (* . GETCOMMENT)) + PRETTYPRINTMACROS))) + (PRINTDEF X 0 DEF))))))))) + +(DWN + (LAMBDA NIL + (SETFILEPTR EMACS.TEMP.FILE 0) + (PRIN3 " + +" EMACS.TEMP.FILE) + (DOWN))) + +(E! + (LAMBDA (N) + (COND + ((NUMBERP N) + (FOR I FROM 1 TO N DO (E.))) + (T (PROG (OLDLOC) + LOOP(SETQ OLDLOC (GETFILEPTR EMACS.MAP.FILE)) + (WHILE (SYNTAXP (CHCON1 (PEEKC EMACS.MAP.FILE)) + (QUOTE SEPR) + EMACS.READ.TABLE) + DO (READC EMACS.MAP.FILE)) + (COND + ((LESSP (GETFILEPTR EMACS.MAP.FILE) + (DIFFERENCE EMACS.Z 4)) + (SETFILEPTR EMACS.MAP.FILE OLDLOC) + (E.) + (GO LOOP)) + (T (RETURN)))))) + (PACKC (QUOTE (8))))) + +(E. + (LAMBDA NIL + + (* This function is for calling after DOWN has + returned. It causes the lisp sexpression after point + in the EMACS buffer to be read and evaluated. + Actually, the form is evaluated with LISPXEVAL so + that it becomes (somewhat) undoable, just as if you + had literally typed it into lisp.) + + + (PROG (TEMP) + (SETQ TEMP (PROG ((NORMALCOMMENTSFLG T)) + (RETURN (READ EMACS.MAP.FILE + EMACS.READ.TABLE)) + + (* We must make lisp read in the comments because + text in the buffer is very likely to get deleted or + edited.) + + + )) + (PROMPTCHAR (QUOTE _) + NIL LISPXHISTORY) + (RESETFORM (PRINTLEVEL (QUOTE (3 . 4))) + (PRINT TEMP T)) + (SETQ TEMP (LISPXEVAL TEMP)) + (RESETFORM (PRINTLEVEL (QUOTE (3 . 4))) + (PRINT TEMP T)) + (RETURN TEMP)) + (PACKC (QUOTE (8))))) + +(EDIT.DRIBBLE.FILE + (LAMBDA NIL + (DRIBBLE (IOFILE (DRIBBLE)) + T T) + (PRIN3 "MMSelect BufferDRIBBLE +ER" EMACS.TEMP.FILE) + (PRIN3 FANCY.DRIBBLE.FILE EMACS.TEMP.FILE) + (PRIN3 "HK +^A +ZJ +-1MM^R New Window" EMACS.TEMP.FILE) + (DOWN T))) + +(EMACS. + (LAMBDA NIL + (DUMP.SCREEN DUMP.SCREEN.AMOUNT) + (RETFROM (QUOTE DOWN) + (E.)))) + +(EMACS.?= + (LAMBDA NIL + (PROG (NAME) + (COND + ((EQ (SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE)) + (QUOTE %()) + (SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE)))) + (DISPLAY.IN.ECHO.AND.DIVE + (COND + ((GETD NAME) + (CONS + NAME + (CONS + "[" + (NCONC1 + (COND + ((NLISTP (ARGLIST NAME)) + (LIST (ARGLIST NAME))) + (T (FOR ARGLIST ON (ARGLIST NAME) + JOIN (CONS (CAR ARGLIST) + (COND + ((NULL (CDR ARGLIST)) + NIL) + (T (CONS "," NIL))))))) + "]")))) + (T (LIST "Not a function."))))))) + +(EMACS.GETDEF + (LAMBDA (NAME) (* Gets the definition + of a litatom, as + described in CF.) + (PROG (DEF FILE SPOT MAP WHEREIS) + (COND + ((NULL NAME) + (SETQ NAME LASTWORD) + (PRINT LASTWORD T))) + (SETQ DEF (VIRGINFN NAME)) + (COND + ((LISTP DEF) + (DUMPX (LIST (QUOTE DEFINEQ) + (LIST NAME DEF))) + (RETURN (DOWN)))) + (COND + ((GETP NAME (QUOTE EXPR)) + (DUMPX (LIST (QUOTE DEFINEQ) + (LIST NAME (GETP NAME (QUOTE EXPR))))) + (RETURN (DOWN)))) + (COND + ((SETQ FILE (CAR (WHEREIS NAME))) + (COND + ((SETQ MAP (GETP FILE (QUOTE FILEMAP)))) + (T (LOADFNS NIL (CDAR (GETP FILE (QUOTE FILEDATES))) + T NIL) + (SETQ MAP (GETP FILE (QUOTE FILEMAP))))) + (COND + ((SETQ SPOT (ASSOC NAME + (CDDR (CADADR (GETP FILE + (QUOTE FILEMAP))) + ))) + (SETQ FILE (CDAR (GETP FILE (QUOTE FILEDATES)))) + (PRINT FILE T) + (PRIN3 "[0E[FNE]ZJ.U0 +I(DEFINEQ " EMACS.TEMP.FILE) + (PRIN3 "ER" EMACS.TEMP.FILE) + (PRIN3 FILE EMACS.TEMP.FILE) + (PRIN3 " +" EMACS.TEMP.FILE) + (PRIN3 (CADR SPOT) + EMACS.TEMP.FILE) + (PRIN3 "FSIFACCESS" EMACS.TEMP.FILE) + (PRIN3 (DIFFERENCE (CDDR SPOT) + (CADR SPOT)) + EMACS.TEMP.FILE) + (PRIN3 + "FY +I) + + +0FSDVERSION +Q0J +.,ZFSBOUNDARIES +F+ +0:F +:F +" + EMACS.TEMP.FILE) + (RETURN (DOWN T))) + (T (ERROR "No Definition Found For" NAME)))) + (T (ERROR "No Definition Found. " NAME)))))) + +(EMACS.P + (LAMBDA NIL + (PRIN3 "MM^R Two Windows +MMSELECT BUFFERPRINT +HK +I" EMACS.TEMP.FILE) + (PROG ((PLVLFILEFLG T)) + (RESETFORM (PRINTLEVEL EMACS.P.PRINT.LEVEL) + (PRIN3 (PROG ((NORMALCOMMENTSFLG T)) + (RETURN (READ EMACS.MAP.FILE + EMACS.READ.TABLE))) + EMACS.TEMP.FILE))) + (PRIN3 + +" +0J +QWINDOW 2 SIZE-3%"N 3-QWINDOW 2 SIZEMM^R GROW WINDOW' +MM^R OTHER WINDOW +MM& MULTI-WINDOW REFRESH" + EMACS.TEMP.FILE) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN T))))) + +(EMACS.PP + (LAMBDA NIL + (SETFILEPTR EMACS.MAP.FILE EMACS.BEGV) + (PROG (OLDLOC TEMP (NORMALCOMMENTSFLG T)) + LOOP(SETQ OLDLOC (GETFILEPTR EMACS.MAP.FILE)) + (WHILE (SYNTAXP (CHCON1 (PEEKC EMACS.MAP.FILE)) + (QUOTE SEPR) + EMACS.READ.TABLE) + DO (READC EMACS.MAP.FILE)) + (COND + ((LESSP (GETFILEPTR EMACS.MAP.FILE) + (DIFFERENCE EMACS.Z 4)) + (SETFILEPTR EMACS.MAP.FILE OLDLOC) + (SETQ TEMP (NLSETQ (READ EMACS.MAP.FILE EMACS.READ.TABLE)) + ) + (COND + ((NULL TEMP) + (PRIN1 "Unbalanced Sexpression! +" T) + (DISMISS 3000) + (SETFILEPTR EMACS.TEMP.FILE 0) + (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN)))) + (T (DUMPX (CAR TEMP)) + (TERPRI EMACS.TEMP.FILE) + (TERPRI EMACS.TEMP.FILE))) + (GO LOOP)) + (T (RETEVAL (QUOTE DOWN) + (QUOTE (DOWN)))))) + (PACKC (QUOTE (8))))) + +(EMACS.RETURN + (LAMBDA NIL + (EVAL (CDR (SASSOC EMACS.FSEXIT.ARG EMACS.RETURN.ALIST))))) + +(ENABLE.CONTROL.C.CAPABILITY + (LAMBDA NIL + (JSYS 105 OURPROCESS 0 (,, 131072 0)))) + +(FLUSH.EMACS + (LAMBDA NIL + + (* This function gets rid of the EMACS fork and + closes the 3 files that EMACS uses.) + + + (COND + ((FIXP (CAR (GETATOMVAL (QUOTE LASTEMACS)))) + (KFORK (CAR (GETATOMVAL (QUOTE LASTEMACS)))))) + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE EMACS.MAP.FILE))) + (LITATOM EMACS.MAP.FILE) + (OPENP EMACS.MAP.FILE)) + (CLOSEF EMACS.MAP.FILE))) + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE EMACS.TEMP.FILE))) + (LITATOM EMACS.TEMP.FILE) + (OPENP EMACS.TEMP.FILE)) + (CLOSEF EMACS.TEMP.FILE))) + (COND + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE FANCY.DRIBBLE.FILE))) + (LITATOM FANCY.DRIBBLE.FILE) + (OPENP FANCY.DRIBBLE.FILE)) + (DRIBBLE NIL))) + (NLSETQ (RELBLK (VAG OUR.BLOCK.START) + EMACS.BLK.SIZE)) + (NLSETQ (RELBLK (VAG EMACS.AC.BLK.START) + 1)))) + +(GET.EMACS.BUFFER + (LAMBDA NIL + + (* We assume we have just returned from EMACS and + that the gap has been closed + (with 1F?). We find out where the beginning and end + and point of the current buffer are and we make sure + that every page of the buffer is mapped into + EMACS.MAP.FILE so we can read it with lisp READ.) + + + (SET.EMACS.VARS) + (MAP.BYTES EMACS.BEG EMACS.Z) + (COND + ((GREATERP EMACS.Z EMACS.MAP.FILE.EOF) + (SETFILEPTR EMACS.MAP.FILE EMACS.Z) + (SETQ EMACS.MAP.FILE.EOF EMACS.Z))) + (SETFILEPTR EMACS.MAP.FILE EMACS.PT))) + +(HK + (LAMBDA NIL + (TECO "HK"))) + +(INFO + (LAMBDA NIL + (TECO "MMINFO"))) + +(MAKE.QUOTE + (LAMBDA (X) + (COND + ((AND (LISTP (CDR X)) + (LITATOM (CADR X)) + (NULL (CDDR X))) + (PACK* (QUOTE ') + (CADR X))) + (T (CONS (QUOTE QUOTE) + (CDR X)))))) + +(MAP.BYTES + (LAMBDA (START END) + (FOR I FROM (PAGE.OF.BYTE START) TO (PAGE.OF.BYTE END) + DO (COND + ((MEMBER I MAPPED.PAGES)) + (T (MAP.PROCESS.TO.FILE (CAR LASTEMACS) + I EMACS.MAP.FILE.JFN) + (SETQ MAPPED.PAGES (CONS I MAPPED.PAGES))))))) + +(MAP.PROCESS.TO.FILE + (LAMBDA (PROCESS PAGE JFN) + + (* We make a page of PROCESS to a page of + EMACS.TEMP.FILE and then map it back into the + process. Future changes to the process page or file + page affect the other (immediately).) + + + (JSYS 46 (,, PROCESS PAGE) + (,, JFN PAGE) + (,, 61440 0)) + (JSYS 46 (,, JFN PAGE) + (,, PROCESS PAGE) + (,, 61440 0)))) + +(PAGE.OF.BYTE + (LAMBDA (BYTE) + (PROG (QUO REM) + (SETQ QUO (IQUOTIENT BYTE 5)) + (SETQ REM (IREMAINDER BYTE 5)) + (RETURN (LLSH (COND + ((ZEROP REM) + (ADD1 QUO)) + (T QUO)) + -11Q))))) + +(PUTSTRING + (LAMBDA (STR ADDR) + + (* We write the bytes in STR starting a ADDR 5 bytes + (of 7 bits each) to a word with a 0 bit at the end. + We make sure that a 0 byte is added at the end. + In fact, the last word ends with 0 bytes.) + + + (UNTIL (GREATERP CHAR (ADD1 (NCHARS STR))) BIND LOC + FIRST (SETQ LOC ADDR) BIND WORD BIND CHAR FIRST (SETQ CHAR 1) + DO (SETQ WORD 0) + (FOR J FROM 1 TO 5 + DO (SETQ WORD (LLSH WORD 7)) + (SETQ WORD (LOGOR WORD + (COND + ((GREATERP CHAR (NCHARS STR)) + 0) + (T (CHCON1 (NTHCHAR STR CHAR)))))) + (SETQ CHAR (ADD1 CHAR))) + (CLOSER LOC (LLSH WORD 1)) + (SETQ LOC (ADD1 LOC))) + ADDR)) + +(READ.AC + (LAMBDA (ACN PROCESS) + (JSYS 113 PROCESS EMACS.AC.BLK.START) + (OPENR (LOGOR EMACS.AC.BLK.START ACN)))) + +(SET.EMACS.VARS + (LAMBDA NIL + + (* Sets LISP variables to the contents of the EMACS + buffer block (as documented in TECORD).) + + + (SETQ EMACS.BEG (OPENR EMACS.BEG.LOC)) + (SETQ EMACS.BEGV (OPENR EMACS.BEGV.LOC)) + (SETQ EMACS.PT (OPENR EMACS.PT.LOC)) + (SETQ EMACS.ZV (OPENR EMACS.ZV.LOC)) + (SETQ EMACS.Z (OPENR EMACS.Z.LOC)) + (SETQ EMACS.EXTRAC (OPENR EMACS.EXTRAC.LOC)) + (SETQ EMACS.MODIFF (OPENR EMACS.MODIFF.LOC)) + (SETQ EMACS.FSEXIT.ARG (READ.AC 3 (CAR LASTEMACS))))) + +(SETUP.FANCY.DRIBBLE + (LAMBDA NIL + + (* To refresh the screen upon returning to LISP, we + use the dribble file to find out what was recently + typed. We first open the file with IOFILE. + Kindly, DRIBBLE lets us get away with that, because + if you first open a dribble file, you can't open it + for read later.) + + + (COND + ((DRIBBLEFILE) + (SETQ FANCY.DRIBBLE.FILE (CONS NIL NIL))) + (T (SETQ FANCY.DRIBBLE.FILE (OUTPUT (OUTFILE (QUOTE + LISP.DRIBBLE.-1;T)))) + (CLOSEF FANCY.DRIBBLE.FILE) + (IOFILE FANCY.DRIBBLE.FILE) + (DRIBBLE FANCY.DRIBBLE.FILE T T))))) + +(SFCOC + (LAMBDA (TUPLE) + (PROG1 (LIST (JSYS 74 4 NIL NIL 2) + (JSYS 74 4 NIL NIL 3)) + (COND + (TUPLE (JSYS 75 4 (CAR TUPLE) + (CADR TUPLE))))))) + +(START.EMACS + (LAMBDA NIL + (PROG (TEMP NAME RSCAN.BLK) + + (* When we read from the EMACS buffer, we are sure + (provided we exited with meta z) that the buffer + ends with the sequence space, control-c, double + quote mark, control-c. We set up a read table that + causes an error upon encountering a control-c in the + file. The extra control-c and double quote mark + handle the case that we are inside a string read. + All this to prevent reading beyond the end of the + emacs buffer. If we could set the eof mark of + EMACS.MAP.FILE, we would. But there is no way we + know to do that. If the buffer had been large, the + eof mark could conceivably been far beyond where the + buffer we are reading now ends, and consequently, it + is possible that LISP might read a long time before + stopping.) + + + (SETQ EMACS.READ.TABLE (COPYREADTABLE FILERDTBL)) + (SETSYNTAX 3 (QUOTE (MACRO IMMEDIATE + (LAMBDA (FL RDTBL) + (ERROR "End of EMACS buffer!")))) + EMACS.READ.TABLE) + (SETSYNTAX (QUOTE ') + (GETSYNTAX (QUOTE ') + (GETREADTABLE T)) + EMACS.READ.TABLE) + + (* Since the user will naturally type in single + quote marks, we want them to get turned into + QUOTE's. Unfortunately, INTERLISP does not do that + when reading from a file (with the default + FILEREADTBL.)) + + + (COND + (LASTEMACS (FLUSH.EMACS))) + + (* Our first step is always to get rid of any EMACS + fork and associated files around.) + + + (SETQ EMACS.TEMP.FILE (OUTPUT (OUTFILE (QUOTE EMACS.TEMP.-1;T) + ))) + + (* EMACS.TEMP.FILE will be the file to which we + print in lisp and from which EMACS reads + (via FSSUPERIOR).) + + + (SETFILEPTR EMACS.TEMP.FILE MAX.EMACS.INPUT) + (SPACES 1 EMACS.TEMP.FILE) + (CLOSEF EMACS.TEMP.FILE) + (IOFILE EMACS.TEMP.FILE) + + (* We IOFILE the temp file so that we can write it + and EMACS can read it.) + + + (SETQ NAME (MKATOM (SIXBIT (JSYS 127)))) + (* We are going to SETNM + and want to restore.) + (SETNM (QUOTE LISP)) + (SETQ RSCAN.BLK (LOC (GETBLK 1))) + + (* We now put into the RSCAN area a string that + EMACS will execute when it is fired up. + The string that EMACS obtains via FJ is the string + put into the RSCAN minus the first word. + EMACS executes the TECO code after the first altmode + in the JCL returned by FJ. This execution is coded + in EMACS.INIT.) + + + (WRITE.RSCAN "EMACS MMLOAD LIBINTERMACSFSEXIT") + (SETQ LASTEMACS (SUBSYS2 (QUOTE SYS:EMACS.EXE) + NIL NIL NIL NIL)) + (COND + ((NEQ NAME (QUOTE LISP)) + (SETNM NAME))) (* We dive down to + EMACS.) + (SETQ EMACS.AC.BLK.START (LOC (GETBLK 1))) + (SETQ EMACS.BUFFER.BLOCK (READ.AC 2 (CAR LASTEMACS))) + (* AC2 contains the + beginning of EMACS' + buffer block. + See TECORD.) + (COND + ((EQP (LLSH EMACS.BUFFER.BLOCK -9) + (LLSH (PLUS EMACS.BUFFER.BLOCK 9) + -9)) + (SETQ EMACS.BLK.SIZE 1)) + (T (SETQ EMACS.BLK.SIZE 2))) + + (* We aim to map in the EMACS buffer block into LISP + so that we can see what's gone on down there and so + that we can give an arg to FSSUPERIOR. + We may need one page or two depending upon where the + buffer lies.) + + + (SETQ OUR.BLOCK.START (LOC (GETBLK EMACS.BLK.SIZE))) + + (* We grab a block (or two) from LISP and save + (the boxed) start.) + + + (FOR VAR + IN (QUOTE (EMACS.BEG.LOC EMACS.BEGV.LOC EMACS.PT.LOC + EMACS.GPT.LOC EMACS.ZV.LOC + EMACS.Z.LOC EMACS.EXTRAC.LOC + EMACS.RESTART.LOC EMACS.ARG.LOC + EMACS.MODIFF.LOC)) + AS I FROM 0 + DO (SET VAR (PLUS I (LOGOR OUR.BLOCK.START + (LOGAND 511 EMACS.BUFFER.BLOCK)) + ))) + + (* We set the values of variables to be the location + (in lisp) of the EMACS buffer block contents.) + + (* Now map the EMACS + buffer block page + (s) in.) + (JSYS 46 (,, (CAR LASTEMACS) + (LLSH EMACS.BUFFER.BLOCK -9)) + (,, OURPROCESS (LLSH OUR.BLOCK.START -9)) + (,, 53248 0)) + (COND + ((EQP EMACS.BLK.SIZE 2) + (JSYS 46 (,, (CAR LASTEMACS) + (ADD1 (LLSH EMACS.BUFFER.BLOCK -9))) + (,, OURPROCESS (ADD1 (LLSH OUR.BLOCK.START -9))) + (,, 53248 0)))) (* We may have to map in + two pages.) + + (* Now we put the entry vector for EMACS at the end + of the buffer block. When we start up the fork again + with SUBSYS1 (which calls SUBSYS) we will ask for + the process to be STARTed. This causes the control + to go the FSSUPERIOR, since the entry vector is + sitting at the location one is supposed to commence + to get FSSUPERIOR fired up.) + + + (JSYS 132 (CAR LASTEMACS) + (,, 1 (PLUS EMACS.BUFFER.BLOCK 7))) + (SETQ EMACS.MAP.FILE (OUTPUT (OUTFILE (QUOTE EMACS.MAP.-1;T))) + ) + + (* EMACS.MAP.FILE is the file into which we will + PMAP the buffer pages of EMACS. + We read from that file to get the value of the edits + performed.) + + + (CLOSEF EMACS.MAP.FILE) + (IOFILE EMACS.MAP.FILE) + + (* We have to have the map file open for read and + for write. Only way to do this in LISP is to first + create a file and then close it and then open it + with IOFILE.) + + + (SETQ EMACS.MAP.FILE.EOF 0) + + (* In order to avoid LISP causing an unjustified EOF + error when reading from the buffer, we must before + reading make sure that the EOF is beyond the end of + the buffer. We achieve the effect with + SETFILEPOINTER. To avoid needless calls of GETEOFPTR + and SETFILEPTR we keep track of the maximum we have + set the EOF pointer to.) + + + (SETQ EMACS.MAP.FILE.JFN (OPNJFN EMACS.MAP.FILE)) + (SETQ MAPPED.PAGES NIL) + + (* MAPPED.PAGES is a list of the EMACS process that + we have mapped into EMACS.MAP.FILE.) + + + (ECHOCONTROL CLEAR.SCREEN.NUMBER (QUOTE REAL)) + + (* A real 36Q on a datamedia clears the screen and + puts the cursor at the top.) + + + (SETUP.FANCY.DRIBBLE) (* We need the RSCAN + block no more.) + (RELBLK (VAG RSCAN.BLK) + 1) + (TERPRI T) + (WHENCLOSE EMACS.MAP.FILE (QUOTE CLOSEALL) + (QUOTE NO)) + (WHENCLOSE EMACS.TEMP.FILE (QUOTE CLOSEALL) + (QUOTE NO)) + (RETURN NIL)))) + +(STIW + (LAMBDA (W) + (PROG1 (JSYS 123 -5 NIL NIL 2) + (COND + (W (JSYS 124 -5 W)))))) + +(SUBSYS1 + (LAMBDA (THREE INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE) + + (* Interlisp's SUBSYS does not work when the process + started up fiddles with the terminal interrupt + words, the control character output control, and the + binary/ascii mode word. SUBSYS1 tries to do the job + right by returning a triple containing the lower + process handle, the coc, and the tiw. + Also, an extra arg permits the forcing of entry into + binary mode when the lower process is restarted. + (A call in SUBSYS to SFMOD prevents us from + determining whether the lower process was in binary + mode.) Clearly, someone should do SUBSYS right. + SUBSYS0 is just the unadvised version of SUBSYS.) + + + (PROG (FORK TIW COC) + (COND + ((LITATOM THREE) + (ENABLE.CONTROL.C.CAPABILITY) + (SETQ FORK THREE) + (SETQ TIW (STIW)) + (SETQ COC (SFCOC))) + (T (SETQ FORK (CAR THREE)) + (SETQ TIW (CADR THREE)) + (SETQ COC (CADDR THREE)))) + (RETURN (RESETFORM (STIW TIW) + (RESETFORM + (SFCOC COC) + (PROGN (COND + (BINARYMODE (BINARYMODE))) + (LIST (SUBSYS0 FORK INCOMFILE + OUTCOMFILE + ENTRYPOINTFLG) + (STIW) + (SFCOC))))))))) + +(SUBSYS2 + (LAMBDA (THREE INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE) + (PROG (FORKTHREE) + (SETQ FORKTHREE (SUBSYS1 THREE INCOMFILE OUTCOMFILE + ENTRYPOINTFLG BINARYMODE)) + CONTROL-C-LOOP + (COND + ((NOT (ZEROP (LOGAND 17179869184 (JSYS 93 (CAR FORKTHREE) + NIL NIL 2)))) + (* True if and only if + EMACS was exited with a + control-c.) + (JSYS 120) + (DISMISS 1000) + + (* We dismiss to permit the operating system to + arrange for the left half of ac1 returned by RFSTS + on the EMACS fork to be 2 instead of 0.0 This is a + horrible hack that is necessitated by a poor + implementation of RFSTS.) + + + (SETQ FORKTHREE (SUBSYS1 FORKTHREE NIL NIL NIL T)) + (GO CONTROL-C-LOOP)) + (T (RETURN FORKTHREE)))))) + +(TECO + (LAMBDA (MESS) + (PROG (DISPLAYTERMFLG) + (PRIN3 " +F+ +0:F +:F +" EMACS.TEMP.FILE) + (PRIN3 MESS EMACS.TEMP.FILE) + (PRIN3 " +MM^R Exit To LISP" EMACS.TEMP.FILE) + (DOWN T)))) + +(WRITE.RSCAN + (LAMBDA (STR) + (PUTSTRING STR RSCAN.BLK) (* RSCAN) + (JSYS 320 (LOGOR (LLSH 147904 18) + RSCAN.BLK)))) +) + +(RPAQQ NEMACSVARS ((DUMP.SCREEN.AMOUNT 500) + EMACS.P.PRINT.LEVEL EMACS.RETURN.ALIST OURPROCESS + MAX.EMACS.INPUT (LASTEMACS NIL) + (CLEAR.SCREEN.NUMBER 30) + (BL (CHARACTER CLEAR.SCREEN.NUMBER)))) + +(RPAQ DUMP.SCREEN.AMOUNT 500) + +(RPAQQ EMACS.P.PRINT.LEVEL (2 . 7)) + +(RPAQQ EMACS.RETURN.ALIST ((1000 EMACS.) + (1001 EMACS.?=) + (1002 EMACS.P) + (1003 EMACS.PP))) + +(RPAQQ OURPROCESS 131072) + +(RPAQQ MAX.EMACS.INPUT 896000) + +(RPAQ LASTEMACS NIL) + +(RPAQ CLEAR.SCREEN.NUMBER 30) + +(RPAQ BL (CHARACTER CLEAR.SCREEN.NUMBER)) +(PUTD (QUOTE SUBSYS0) + (VIRGINFN (QUOTE SUBSYS))) + +(ADDTOVAR ERRORTYPELST (16 (COND ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.MAP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.MAP.FILE)) + (ERROR "End of EMACS buffer!")) + ((AND (NEQ (QUOTE NOBIND) + (GETATOMVAL (QUOTE + EMACS.TEMP.FILE))) + (EQ (CADR ERRORMESS) + EMACS.TEMP.FILE)) + (ERROR "End of EMACS temporary file!") + )))) +(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA ) +) +(DECLARE: DONTCOPY + (FILEMAP (NIL (1372 27740 (,, 1384 . 1438) (BINARYMODE 1442 . 1759) (CF +1763 . 2153) (CP 2157 . 2661) (CV 2665 . 3114) (DISPLAY.IN.ECHO.AND.DIVE + 3118 . 3519) (DOWN 3523 . 5680) (DUMP.SCREEN 5684 . 6361) (DUMPX 6365 . + 6776) (DUMPX1 6780 . 7628) (DWN 7632 . 7737) (E! 7741 . 8240) (E. 8244 +. 9179) (EDIT.DRIBBLE.FILE 9183 . 9449) (EMACS. 9453 . 9555) (EMACS.?= +9559 . 10183) (EMACS.GETDEF 10187 . 11763) (EMACS.P 11767 . 12305) ( +EMACS.PP 12309 . 13187) (EMACS.RETURN 13191 . 13284) ( +ENABLE.CONTROL.C.CAPABILITY 13288 . 13376) (FLUSH.EMACS 13380 . 14280) ( +GET.EMACS.BUFFER 14284 . 14870) (HK 14874 . 14911) (INFO 14915 . 14960) +(MAKE.QUOTE 14964 . 15169) (MAP.BYTES 15173 . 15448) ( +MAP.PROCESS.TO.FILE 15452 . 15850) (PAGE.OF.BYTE 15854 . 16088) ( +PUTSTRING 16092 . 16794) (READ.AC 16798 . 16920) (SET.EMACS.VARS 16924 . + 17448) (SETUP.FANCY.DRIBBLE 17452 . 18065) (SFCOC 18069 . 18234) ( +START.EMACS 18238 . 25086) (STIW 25090 . 25188) (SUBSYS1 25192 . 26482) +(SUBSYS2 26486 . 27353) (TECO 27357 . 27584) (WRITE.RSCAN 27588 . 27737) +)))) +STOP diff --git a/src/e142/newwin. b/src/e142/newwin. new file mode 100644 index 00000000..bd023ece --- /dev/null +++ b/src/e142/newwin. @@ -0,0 +1,36 @@ +!~Filename~:! !New Windowing command! +NEWWIN + +!& Setup NEWWIN Library:! !S Setup lib! + M.M^R_ New_ Universal_ Argument u.U + M.M^R_ Scroll_ Screen/Lines u.V + 0 + +!^R New Universal Argument:! !^R Sets argument or multiplies it by four. +Followed by digits, uses them to specify the +argument for the command after the digits. +Not followed by digits, multiplies the argument by four.! + [0 :i0 [1 0fs ^r last !* Set flag to say this is arg-setting command.! + < 4,m.i !* loop, reading as many argument characters as follow.! + :fi--"e fq0-1; !* Allow a minus sign as first character only.! + fs ^R argp # 4 fs ^R argp + fi + !' + :fi f 0123456789-:; + fiu1 :i001 > !* Accumulate them as string in Q0.! + !* Get here on 1st non-arg char.! + fq0  (fs ^R argp & 4)"e + fs ^r argp 1 fs ^r argp !* If no digits, act like built-in ^U.! + fs ^r expt +1 fs ^r expt ' + m0 fs ^r arg !* If got some digits, set arg value from them.! + fq0 "N fs ^R argp  3 fs ^r argp' +  + +!^R Scroll Screen/lines:! !^R Scrolls forward one screen +If given an argument of just "-", scrolls backward 1 screen +any other arg scrolls by lines! + + FS ^R ARGP & 6 - 4 "E :@M(M.M^R_ Previous_ Several_ Screens)' + FF "E :@M(M.M^R_ Next_ Several_ Screens)' + @M(M.M^R_ Next_ Screen) +  diff --git a/src/e142/newwin._ej b/src/e142/newwin._ej new file mode 100644 index 00000000..bd56c957 --- /dev/null +++ b/src/e142/newwin._ej @@ -0,0 +1,38 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + m6Chvhu3:Wgocs?I3:bh& Setup NEWWIN LibraryIM.M^R New Universal Argumentu.U +M.M^R Scroll Screen/Linesu.V +0^R New Universal Argumentc[0:i0s^rlast +<4,m.i +:fi--"efq0-1; +fs^Rargp#4fs^Rargp +fi +!' +:fif0123456789-:; +fiu1:i001> +fq0(fs^Rargp&4)"e +fs^rargp1fs^rargp +fs^rexpt+1fs^rexpt' +m0fs^rarg +fq0"Nfs^Rargp3fs^rargp' +^R Scroll Screen/lines}FS^RARGP&6-4"E:@M(M.M^R Previous Several Screens)' +FF"E:@M(M.M^R Next Several Screens)' +@M(M.M^R Next Screen) +~Filename~ +NEWWIN~DOC~ ~Filename~New Windowing command + ~DOC~ & Setup NEWWIN LibraryS Setup lib +#~DOC~ ^R New Universal ArgumentD^R Sets argument or multiplies it by four. +Followed by digits, uses them to specify the +argument for the command after the digits. +Not followed by digits, multiplies the argument by four. + ~DOC~ ^R Scroll Screen/lines^R Scrolls forward one screen +If given an argument of just "-", scrolls backward 1 screen +any other arg scrolls by lines +~DIRECTORY~O& Setup NEWWIN Library +^R New Universal Argument +^R Scroll Screen/lines + ~INVERT~[1Q1 diff --git a/src/e142/page. b/src/e142/page. new file mode 100644 index 00000000..7e83a351 --- /dev/null +++ b/src/e142/page. @@ -0,0 +1,235 @@ +!~Filename~:! !Commands for handling pages intelligently. -*-TECO-*-! +PAGE + +!& Setup PAGE Library:! !S Put macros on appropriate characters.! + + 0FO..Q PAGE_Setup_Hook[0 + fq0"G M0' + "# + M.M^R_Insert_Pagemark u:.X(P) !* Insert Pagemark on ^X P! + M.M^R_Goto_Next_Page u:.X(]) !* Goto Next Page on C-X ]! + M.M^R_Goto_Previous_Page u:.X([) !* Goto Prev Page on C-X [! + M.M^R_Join_Next_Page u:.X(J) !* Join Pages on ^X J ! + M.M^R_Widen_Bounds u:.X(W) !* Widen Bounds on ^X W ! + M.M^R_Incremental_Search [0 + M.M^R_String_Search [1 + (q.S-q0)*(q.S-Q1)"E !* if Search is on C-S ! + q.S M.V Real_Search_Macro + M.M^R_PAGE_Search u.S !* Then PAGE Search on C-S ! + M.M^R_PAGE_Reverse_Search u.R !* Reverse Search on C-R! + '"# (q..S-q0)*(q..S-q1)"E !* else if Search is on M-S! + q..S M.V Real_Search_Macro + M.M^R_PAGE_Search u..S !* then PAGE Search on M-S ! + M.M^R_PAGE_Reverse_Search u..R !* Reverse Search on M-R ! + '"# FTCannot_find_Search!!!__Send_a_note_to_Rubenstein.'' + M.M^R_Go_To_Page U..G !* Go to page on C-X C-P ! + M.M^R_Fill_Region U...G !* Fill Region on C-M-G ! + ' + + 0M.LPAGE_Flush_Crlf + 0M.LCurrent_Page + qSet_Mode_Line_Hook[1 + :i*1 M(M.M&_Set_PAGE_Mode_Line) uSet_Mode_Line_Hook + 0fo..q TECO_ mode_ hook F"E + M.VTECO_ mode_ hook + :i*'u1 + :i*1 + 1uPAGE_ Flush_ Crlf +  +  uTECO_ mode_ hook + + 0fo..q Visit_ File_ Hookf"E + M.VVisit_ File_ Hook + :i*'u1 + :i*1 + M.LCurrent_Page + 0fo..q PAGE_ Flush_ Crlf M.LPAGE_Flush_Crlf +  +  uVisit_File_Hook + + 0 + +!& Set PAGE Mode Line:! !S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string.! + + + qCurrent_Page"E ' !* if Current Page is 0, return argument! + "E :i*' "#' [1 !* if no argument, cons up a blank string! + qCurrent_Page :\ [2 + :I*1_Page_2 (]1 ]2)  + + +!^R Insert Pagemark:! !^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page.! + + 13i 10i 12i !* insert a pagemark! + qCurrent_Page"N + %Current_Page + 0:M(M.M^R_Goto_Next_Page)' + +!^R Goto Next Page:! !^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page.! + + [0 .[1 + M(M.M^R_Set_Bounds_Full) + qCurrent_Page"E !* if no virtual bounds then! + FF "E 0U0' !* if no args then narrow to current page! + 0[3 + 0j <%3 !* increment counter! + qPAGE_Flush_Crlf"E + :s + '"#:s + +'; !* Search for page delim, throw ifn found! + .-3-Q1;> !* if past point then we're there! + q3 uCurrent_Page ]3 + q1j' + qCurrent_Page+q0 [2 + q2:"G !* if page num is not positive then! + 0M(M.M^R_Goto_Next_Page) !* set bounds to this page! + @FENIB Fs Err' !* generate an error! + q0 M(M.M^R_Mark_Page) + q2 uCurrent_Page !* Update page number! + z-."E M(M.M^R_Widen_Bounds) !* If at end (tried to go to far)! + 0M(M.M^R_Goto_Next_Page) !* Set bounds to this page! + @FENIB FS Err' !* Generate a "NOT IN BUFFER" error! + ."'N & qPAGE_flush_Crlf"N2c' !* if not at beginning then skip crlf! + .(W): !* exchange point and mark! + z-."N -3c' !* if not end then back over crlf and ^L! + M(M.M^R_Set_Bounds_Region) !* set bounds to this region! + 1:"N BJ' !* go back to where we were if we can! + ]2 ]1 ]0 + M(M.M&_Set_Mode_Line) + 0 + +!^R Go to Page:! !^R Go to a specific page, arg is page number. +If no arg then go to next page! + + "L -1[0' !* Negative arg -=> Goto previous page! + "# FF"N !* if explicit argument! + -1[0 + M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 1uCurrent_Page + 0j' !* Jump to the beginning! + "# 1[0'' + Q0 M(M.M^R_Goto_Next_Page) !* get to the right page! + 0 + +!^R PAGE Search:! !C Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$.! + + QReal_ Search_ Macro, @:M(M.M&_ Macro_ on_ Whole_ Buffer) + +!& Macro on whole buffer:! !S Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$)! + + F F & 2 "E @FEWNA FS Err' !* if no pre-comma arg, then explode! + qCurrent_ Page"E + F F & 8 "N @:M()' "# :M()'' + M(M.M^R_Set_Bounds_Full) + F F & 8 "N @M()' "# M()' + 0uCurrent_Page + @M(M.M^R_Goto_Next_Page) + 0 + +!^R PAGE Reverse Search:! !C Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details.! + + -1:M(M.M^R_PAGE_Search) + +!& File Directory:! !S Returns a string pointer to the file directory! + + .[1 0[2 0[3 0[4 [5 [6 [7 [c + FS V Z+B "N FS Boundaries u2 u3 !* Remember if we had any bounds! + @M(M.M^R_Set_Bounds_Full)' + 0j + q..o [A !* remember our buffer! + FS B Cons [B !* and make a scratch buffer! + < .,(@f +_ L %4 !* Advance over CRLF's, increment page no.! + 3,Q4 :\ u5 + 1X6 + QPAGE_ Flush_ Crlf "E + :S + ' "# :S + +'uc + qc"E zj').FS Boundaries + M(M.MCount_Lines) u7 + 4,q7 :\ u7 + qB u..o + I5_7__6 !* Print the page number! + qA u..O + 0,fs z FS Boundaries + qc;> + Q1J + q2"N Q3, Q2 FS Boundaries' + qb u..o HFX* (qA u..o qB FS B Kill)  + + +!Print File Directory:! !C Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number.! + + M(M.M&_ File_ Directory) [0 + FTPage__#_Lines___First_Non-blank_Line +0 + ]0 0 + + +!Make File Directory:! !Inserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end! + + M(M.M&_ File_ Directory) [0 + BJ + I0 + + FF"N + .[1 BJ + QComment_ Start [2 + QComment_ End [3 + + ]3 ]2 ]1' + ]0 b,. + +!^R Widen Bounds:! !^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line.! + + @M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 0uCurrent_Page + :M(M.M&_Set_Mode_Line) + + +!^R Goto Previous Page:! !^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page.! + + FF "E -1'"#-' :M(M.M^R_Goto_Next_Page) !* go do it! + +!^R Join Next Page:! !^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one.! + + "L BJ + M(M.M^R_Set_Bounds_Full) + ."E @FENIB FS Err' + "# -3D'' + "# ZJ + M(M.M^R_Set_Bounds_Full) + Z-."E @FENIB FS Err' + "# 3D'' + 0M(M.M^R_Goto_Next_Page) + 0 diff --git a/src/e142/page..75 b/src/e142/page..75 new file mode 100644 index 00000000..3c060175 --- /dev/null +++ b/src/e142/page..75 @@ -0,0 +1,235 @@ +!~Filename~:! !Commands for handling pages intelligently. -*-TECO-*-! +PAGE + +!& Setup PAGE Library:! !S Put macros on appropriate characters.! + + 0FO..Q PAGE_Setup_Hook[0 + fq0"G M0' + "# + M.M^R_Insert_Pagemark u:.X(P) !* Insert Pagemark on ^X P! + M.M^R_Goto_Next_Page u:.X(]) !* Goto Next Page on C-X ]! + M.M^R_Goto_Previous_Page u:.X([) !* Goto Prev Page on C-X [! + M.M^R_Join_Next_Page u:.X(J) !* Join Pages on ^X J ! + M.M^R_Widen_Bounds u:.X(W) !* Widen Bounds on ^X W ! + M.M^R_Incremental_Search [0 + M.M^R_String_Search [1 + (q.S-q0)*(q.S-Q1)"E !* if Search is on C-S ! + q.S M.V Real_Search_Macro + M.M^R_PAGE_Search u.S !* Then PAGE Search on C-S ! + M.M^R_PAGE_Reverse_Search u.R !* Reverse Search on C-R! + '"# (q..S-q0)*(q..S-q1)"E !* else if Search is on M-S! + q..S M.V Real_Search_Macro + M.M^R_PAGE_Search u..S !* then PAGE Search on M-S ! + M.M^R_PAGE_Reverse_Search u..R !* Reverse Search on M-R ! + '"# FTCannot_find_Search!!!__Send_a_note_to_Rubenstein.'' + M.M^R_Go_To_Page U..G !* Go to page on C-X C-P ! + M.M^R_Fill_Region U...G !* Fill Region on C-M-G ! + ' + + 0M.LPAGE_Flush_Crlf + 0M.LCurrent_Page + qSet_Mode_Line_Hook[1 + :i*1 M(M.M&_Set_PAGE_Mode_Line) uSet_Mode_Line_Hook + 0fo..q TECO_ mode_ hook F"E + M.VTECO_ mode_ hook + :i*'u1 + :i*1 + 1uPAGE_ Flush_ Crlf +  +  uTECO_ mode_ hook + + 0fo..q Visit_ File_ Hookf"E + M.VVisit_ File_ Hook + :i*'u1 + :i*1 + M.LCurrent_Page + 0fo..q PAGE_ Flush_ Crlf M.LPAGE_Flush_Crlf +  +  uVisit_File_Hook + + 0 + +!& Set PAGE Mode Line:! !S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string.! + + + qCurrent_Page"E ' !* if Current Page is 0, return argument! + "E :i*' "#' [1 !* if no argument, cons up a blank string! + qCurrent_Page :\ [2 + :I*1_Page_2 (]1 ]2)  + + +!^R Insert Pagemark:! !^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page.! + + 13i 10i 12i !* insert a pagemark! + qCurrent_Page"N + %Current_Page + 0:M(M.M^R_Goto_Next_Page)' + +!^R Goto Next Page:! !^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page.! + + [0 .[1 + M(M.M^R_Set_Bounds_Full) + qCurrent_Page"E !* if no virtual bounds then! + FF "E 0U0' !* if no args then narrow to current page! + 0[3 + 0j <%3 !* increment counter! + qPAGE_Flush_Crlf"E + :s + '"#:s + +'; !* Search for page delim, throw ifn found! + .-3-Q1;> !* if past point then we're there! + q3 uCurrent_Page ]3 + q1j' + qCurrent_Page+q0 [2 + q2:"G !* if page num is not positive then! + 0M(M.M^R_Goto_Next_Page) !* set bounds to this page! + @FENIB Fs Err' !* generate an error! + q0 M(M.M^R_Mark_Page) + q2 uCurrent_Page !* Update page number! + z-."E M(M.M^R_Widen_Bounds) !* If at end (tried to go to far)! + 0M(M.M^R_Goto_Next_Page) !* Set bounds to this page! + @FENIB FS Err' !* Generate a "NOT IN BUFFER" error! + ."'N & qPAGE_flush_Crlf"N2c' !* if not at beginning then skip crlf! + .(W): !* exchange point and mark! + z-."N -3c' !* if not end then back over crlf and ^L! + M(M.M^R_Set_Bounds_Region) !* set bounds to this region! + 1:"N BJ' !* go back to where we were if we can! + ]2 ]1 ]0 + M(M.M&_Set_Mode_Line) + 0 + +!^R Go to Page:! !^R Go to a specific page, arg is page number. +If no arg then go to next page! + + "L -1[0' !* Negative arg -=> Goto previous page! + "# FF"N !* if explicit argument! + -1[0 + M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 1uCurrent_Page + 0j' !* Jump to the beginning! + "# 1[0'' + Q0 M(M.M^R_Goto_Next_Page) !* get to the right page! + 0 + +!^R PAGE Search:! !C Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$.! + + QReal_ Search_ Macro, @:M(M.M&_ Macro_ on_ Whole_ Buffer) + +!& Macro on whole buffer:! !S Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$)! + + F F & 2 "E @FEWNA FS Err' !* if no pre-comma arg, then explode! + qCurrent_ Page"E + F F & 8 "N @:M()' "# :M()'' + M(M.M^R_Set_Bounds_Full) + F F & 8 "N @M()' "# M()' + 0uCurrent_Page + @M(M.M^R_Goto_Next_Page) + 0 + +!^R PAGE Reverse Search:! !C Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details.! + + -1:M(M.M^R_PAGE_Search) + +!& File Directory:! !S Returns a string pointer to the file directory! + + .[1 0[2 0[3 0[4 [5 [6 [7 [c + FS V Z+B "N FS Boundaries u2 u3 !* Remember if we had any bounds! + @M(M.M^R_Set_Bounds_Full)' + 0j + q..o [A !* remember our buffer! + FS B Cons [B !* and make a scratch buffer! + < .,(@f +_ L %4 !* Advance over CRLF's, increment page no.! + 3,Q4 :\ u5 + 1X6 + QPAGE_ Flush_ Crlf "E + :S + ' "# :S + +'uc + qc"E zj').FS Boundaries + M(M.MCount_Lines) u7 + 4,q7 :\ u7 + qB u..o + I5__7__6 !* Print the page number! + qA u..O + 0,fs z FS Boundaries + qc;> + Q1J + q2"N Q3, Q2 FS Boundaries' + qb u..o HFX* (qA u..o qB FS B Kill)  + + +!Print File Directory:! !C Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number.! + + M(M.M&_ File_ Directory) [0 + FTPage__#_Lines___First_Non-blank_Line +0 + ]0 0 + + +!Make File Directory:! !Inserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end! + + M(M.M&_ File_ Directory) [0 + BJ + I0 + + FF"N + .[1 BJ + QComment_ Start [2 + QComment_ End [3 + + ]3 ]2 ]1' + ]0 b,. + +!^R Widen Bounds:! !^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line.! + + @M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 0uCurrent_Page + :M(M.M&_Set_Mode_Line) + + +!^R Goto Previous Page:! !^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page.! + + FF "E -1'"#-' :M(M.M^R_Goto_Next_Page) !* go do it! + +!^R Join Next Page:! !^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one.! + + "L BJ + M(M.M^R_Set_Bounds_Full) + ."E @FENIB FS Err' + "# -3D'' + "# ZJ + M(M.M^R_Set_Bounds_Full) + Z-."E @FENIB FS Err' + "# 3D'' + 0M(M.M^R_Goto_Next_Page) + 0 diff --git a/src/e142/page..76 b/src/e142/page..76 new file mode 100644 index 00000000..56f14277 --- /dev/null +++ b/src/e142/page..76 @@ -0,0 +1,236 @@ +!~Filename~:! !Commands for handling pages intelligently. -*-TECO-*-! +PAGE + +!& Setup PAGE Library:! !S Put macros on appropriate characters.! + + 0FO..Q PAGE_Setup_Hook[0 + fq0"G M0' + "# + M.M^R_Insert_Pagemark u:.X(P) !* Insert Pagemark on ^X P! + M.M^R_Goto_Next_Page u:.X(]) !* Goto Next Page on C-X ]! + M.M^R_Goto_Previous_Page u:.X([) !* Goto Prev Page on C-X [! + M.M^R_Join_Next_Page u:.X(J) !* Join Pages on ^X J ! + M.M^R_Widen_Bounds u:.X(W) !* Widen Bounds on ^X W ! + M.M^R_Incremental_Search [0 + M.M^R_String_Search [1 + (q.S-q0)*(q.S-Q1)"E !* if Search is on C-S ! + q.S M.V Real_Search_Macro + M.M^R_PAGE_Search u.S !* Then PAGE Search on C-S ! + M.M^R_PAGE_Reverse_Search u.R !* Reverse Search on C-R! + '"# (q..S-q0)*(q..S-q1)"E !* else if Search is on M-S! + q..S M.V Real_Search_Macro + M.M^R_PAGE_Search u..S !* then PAGE Search on M-S ! + M.M^R_PAGE_Reverse_Search u..R !* Reverse Search on M-R ! + '"# FTCannot_find_Search!!!__Send_a_note_to_Rubenstein.'' + M.M^R_Go_To_Page U..G !* Go to page on C-X C-P ! + M.M^R_Fill_Region U...G !* Fill Region on C-M-G ! + ' + + 0M.LPAGE_Flush_Crlf + 0M.LCurrent_Page + qSet_Mode_Line_Hook[1 + :i*1 M(M.M&_Set_PAGE_Mode_Line) uSet_Mode_Line_Hook + 0fo..q TECO_ mode_ hook F"E + M.VTECO_ mode_ hook + :i*'u1 + :i*1 + 1uPAGE_ Flush_ Crlf +  +  uTECO_ mode_ hook + + 0fo..q Visit_ File_ Hookf"E + M.VVisit_ File_ Hook + :i*'u1 + :i*1 + M.LCurrent_Page + 0fo..q PAGE_ Flush_ Crlf M.LPAGE_Flush_Crlf +  +  uVisit_File_Hook + + 0 + +!& Set PAGE Mode Line:! !S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string.! + + + qCurrent_Page"E ' !* if Current Page is 0, return argument! + "E :i*' "#' [1 !* if no argument, cons up a blank string! + qCurrent_Page :\ [2 + :I*1_Page_2 (]1 ]2)  + + +!^R Insert Pagemark:! !^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page.! + + 13i 10i 12i !* insert a pagemark! + qCurrent_Page"N + %Current_Page + 0:M(M.M^R_Goto_Next_Page)' + +!^R Goto Next Page:! !^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page.! + + [0 .[1 + M(M.M^R_Set_Bounds_Full) + qCurrent_Page"E !* if no virtual bounds then! + FF "E 0U0' !* if no args then narrow to current page! + 0[3 + 0j <%3 !* increment counter! + qPAGE_Flush_Crlf"E + :s + '"#:s + +'; !* Search for page delim, throw ifn found! + .-3-Q1;> !* if past point then we're there! + q3 uCurrent_Page ]3 + q1j' + qCurrent_Page+q0 [2 + q2:"G !* if page num is not positive then! + 0M(M.M^R_Goto_Next_Page) !* set bounds to this page! + @FENIB Fs Err' !* generate an error! + q0 M(M.M^R_Mark_Page) + q2 uCurrent_Page !* Update page number! + z-."E M(M.M^R_Widen_Bounds) !* If at end (tried to go to far)! + 0M(M.M^R_Goto_Next_Page) !* Set bounds to this page! + @FENIB FS Err' !* Generate a "NOT IN BUFFER" error! + ."'N & qPAGE_flush_Crlf"N2c' !* if not at beginning then skip crlf! + .(W): !* exchange point and mark! + z-."N -3c' !* if not end then back over crlf and ^L! + M(M.M^R_Set_Bounds_Region) !* set bounds to this region! + 1:"N BJ' !* go back to where we were if we can! + ]2 ]1 ]0 + M(M.M&_Set_Mode_Line) + 0 + +!^R Go to Page:! !^R Go to a specific page, arg is page number. +If no arg then go to next page! + + "L -1[0' !* Negative arg -=> Goto previous page! + "# FF"N !* if explicit argument! + -1[0 + M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 1uCurrent_Page + 0j' !* Jump to the beginning! + "# 1[0'' + Q0 M(M.M^R_Goto_Next_Page) !* get to the right page! + 0 + +!^R PAGE Search:! !C Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$.! + + QReal_ Search_ Macro, @:M(M.M&_ Macro_ on_ Whole_ Buffer) + +!& Macro on whole buffer:! !S Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$)! + + F F & 2 "E @FEWNA FS Err' !* if no pre-comma arg, then explode! + qCurrent_ Page"E + F F & 8 "N @:M()' "# :M()'' + M(M.M^R_Set_Bounds_Full) + F F & 8 "N @M()' "# M()' + 0uCurrent_Page + @M(M.M^R_Goto_Next_Page) + 0 + +!^R PAGE Reverse Search:! !C Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details.! + + -1:M(M.M^R_PAGE_Search) + +!& File Directory:! !S Returns a string pointer to the file directory! + + .[1 0[2 0[3 0[4 [5 [6 [7 [c + FS V Z+B "N FS Boundaries u2 u3 !* Remember if we had any bounds! + @M(M.M^R_Set_Bounds_Full)' + 0j + q..o [A !* remember our buffer! + FS B Cons [B !* and make a scratch buffer! + < .,(@f +_ L %4 !* Advance over CRLF's, increment page no.! + 3,Q4 :\ u5 + 1X6 + QPAGE_ Flush_ Crlf "E + :S + ' "# :S + +'uc + qc"E zj').FS Boundaries + M(M.MCount_Lines) u7 + 4,q7 :\ u7 + qB u..o + I5_7__ !* Print the page number! + 0,(fswidth-10)g6 + qA u..O + 0,fs z FS Boundaries + qc;> + Q1J + q2"N Q3, Q2 FS Boundaries' + qb u..o HFX* (qA u..o qB FS B Kill)  + + +!Print File Directory:! !C Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number.! + + M(M.M&_ File_ Directory) [0 + FTPage_Lines__First_Non-blank_Line +0 + ]0 0 + + +!Make File Directory:! !Inserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end! + + M(M.M&_ File_ Directory) [0 + BJ + I0 + + FF"N + .[1 BJ + QComment_ Start [2 + QComment_ End [3 + + ]3 ]2 ]1' + ]0 b,. + +!^R Widen Bounds:! !^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line.! + + @M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 0uCurrent_Page + :M(M.M&_Set_Mode_Line) + + +!^R Goto Previous Page:! !^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page.! + + FF "E -1'"#-' :M(M.M^R_Goto_Next_Page) !* go do it! + +!^R Join Next Page:! !^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one.! + + "L BJ + M(M.M^R_Set_Bounds_Full) + ."E @FENIB FS Err' + "# -3D'' + "# ZJ + M(M.M^R_Set_Bounds_Full) + Z-."E @FENIB FS Err' + "# 3D'' + 0M(M.M^R_Goto_Next_Page) + 0 diff --git a/src/e142/page..77 b/src/e142/page..77 new file mode 100644 index 00000000..90e9aed4 --- /dev/null +++ b/src/e142/page..77 @@ -0,0 +1,238 @@ +!~Filename~:! !Commands for handling pages intelligently. -*-TECO-*-! +PAGE + +!& Setup PAGE Library:! !S Put macros on appropriate characters.! + + 0FO..Q PAGE_Setup_Hook[0 + fq0"G M0' + "# + M.M^R_Insert_Pagemark u:.X(P) !* Insert Pagemark on ^X P! + M.M^R_Goto_Next_Page u:.X(]) !* Goto Next Page on C-X ]! + M.M^R_Goto_Previous_Page u:.X([) !* Goto Prev Page on C-X [! + M.M^R_Join_Next_Page u:.X(J) !* Join Pages on ^X J ! + M.M^R_Widen_Bounds u:.X(W) !* Widen Bounds on ^X W ! + M.M^R_Incremental_Search [0 + M.M^R_String_Search [1 + (q.S-q0)*(q.S-Q1)"E !* if Search is on C-S ! + q.S M.V Real_Search_Macro + M.M^R_PAGE_Search u.S !* Then PAGE Search on C-S ! + M.M^R_PAGE_Reverse_Search u.R !* Reverse Search on C-R! + '"# (q..S-q0)*(q..S-q1)"E !* else if Search is on M-S! + q..S M.V Real_Search_Macro + M.M^R_PAGE_Search u..S !* then PAGE Search on M-S ! + M.M^R_PAGE_Reverse_Search u..R !* Reverse Search on M-R ! + '"# FTCannot_find_Search!!!__Send_a_note_to_Rubenstein.'' + M.M^R_Go_To_Page U..G !* Go to page on C-X C-P ! + M.M^R_Fill_Region U...G !* Fill Region on C-M-G ! + ' + + 0M.LPAGE_Flush_Crlf + 0M.LCurrent_Page + qSet_Mode_Line_Hook[1 + :i*1 M(M.M&_Set_PAGE_Mode_Line) uSet_Mode_Line_Hook + 0fo..q TECO_ mode_ hook F"E + M.VTECO_ mode_ hook + :i*'u1 + :i*1 + 1uPAGE_ Flush_ Crlf +  +  uTECO_ mode_ hook + + 0fo..q Visit_ File_ Hookf"E + M.VVisit_ File_ Hook + :i*'u1 + :i*1 + M.LCurrent_Page + 0fo..q PAGE_ Flush_ Crlf M.LPAGE_Flush_Crlf +  +  uVisit_File_Hook + + 0 + +!& Set PAGE Mode Line:! !S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string.! + + + qCurrent_Page"E ' !* if Current Page is 0, return argument! + "E :i*' "#' [1 !* if no argument, cons up a blank string! + qCurrent_Page :\ [2 + :I*1_Page_2 (]1 ]2)  + + +!^R Insert Pagemark:! !^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page.! + + 13i 10i 12i !* insert a pagemark! + qCurrent_Page"N + %Current_Page + 0:M(M.M^R_Goto_Next_Page)' + +!^R Goto Next Page:! !^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page.! + + [0 .[1 + M(M.M^R_Set_Bounds_Full) + qCurrent_Page"E !* if no virtual bounds then! + FF "E 0U0' !* if no args then narrow to current page! + 0[3 + 0j <%3 !* increment counter! + qPAGE_Flush_Crlf"E + :s + '"#:s + +'; !* Search for page delim, throw ifn found! + .-3-Q1;> !* if past point then we're there! + q3 uCurrent_Page ]3 + q1j' + qCurrent_Page+q0 [2 + q2:"G !* if page num is not positive then! + 0M(M.M^R_Goto_Next_Page) !* set bounds to this page! + @FENIB Fs Err' !* generate an error! + q0 M(M.M^R_Mark_Page) + q2 uCurrent_Page !* Update page number! + z-."E M(M.M^R_Widen_Bounds) !* If at end (tried to go to far)! + 0M(M.M^R_Goto_Next_Page) !* Set bounds to this page! + @FENIB FS Err' !* Generate a "NOT IN BUFFER" error! + ."'N & qPAGE_flush_Crlf"N2c' !* if not at beginning then skip crlf! + .(W): !* exchange point and mark! + z-."N -3c' !* if not end then back over crlf and ^L! + M(M.M^R_Set_Bounds_Region) !* set bounds to this region! + 1:"N BJ' !* go back to where we were if we can! + ]2 ]1 ]0 + M(M.M&_Set_Mode_Line) + 0 + +!^R Go to Page:! !^R Go to a specific page, arg is page number. +If no arg then go to next page! + + "L -1[0' !* Negative arg -=> Goto previous page! + "# FF"N !* if explicit argument! + -1[0 + M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 1uCurrent_Page + 0j' !* Jump to the beginning! + "# 1[0'' + Q0 M(M.M^R_Goto_Next_Page) !* get to the right page! + 0 + +!^R PAGE Search:! !C Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$.! + + QReal_ Search_ Macro, @:M(M.M&_ Macro_ on_ Whole_ Buffer) + +!& Macro on whole buffer:! !S Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$)! + + F F & 2 "E @FEWNA FS Err' !* if no pre-comma arg, then explode! + qCurrent_ Page"E + F F & 8 "N @:M()' "# :M()'' + M(M.M^R_Set_Bounds_Full) + F F & 8 "N @M()' "# M()' + 0uCurrent_Page + @M(M.M^R_Goto_Next_Page) + 0 + +!^R PAGE Reverse Search:! !C Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details.! + + -1:M(M.M^R_PAGE_Search) + +!& File Directory:! !S Returns a string pointer to the file directory! + + .[1 0[2 0[3 0[4 [5 [6 [7 [c + FS V Z+B "N FS Boundaries u2 u3 !* Remember if we had any bounds! + @M(M.M^R_Set_Bounds_Full)' + 0j + q..o [A !* remember our buffer! + FS B Cons [B !* and make a scratch buffer! + < .,(@f +_ L %4 !* Advance over CRLF's, increment page no.! + 3,Q4 :\ u5 + 1X6 + QPAGE_ Flush_ Crlf "E + :S + ' "# :S + +'uc + qc"E zj').FS Boundaries + M(M.MCount_Lines) u7 + 4,q7 :\ u7 + qB u..o + I5_7__ !* Print the page number! + 0,(fswidth-11)g6 + i + + qA u..O + 0,fs z FS Boundaries + qc;> + Q1J + q2"N Q3, Q2 FS Boundaries' + qb u..o HFX* (qA u..o qB FS B Kill)  + + +!Print File Directory:! !C Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number.! + + M(M.M&_ File_ Directory) [0 + FTPage_Lines__First_Non-blank_Line +0 + ]0 0 + + +!Make File Directory:! !Inserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end! + + M(M.M&_ File_ Directory) [0 + BJ + I0 + + FF"N + .[1 BJ + QComment_ Start [2 + QComment_ End [3 + + ]3 ]2 ]1' + ]0 b,. + +!^R Widen Bounds:! !^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line.! + + @M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 0uCurrent_Page + :M(M.M&_Set_Mode_Line) + + +!^R Goto Previous Page:! !^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page.! + + FF "E -1'"#-' :M(M.M^R_Goto_Next_Page) !* go do it! + +!^R Join Next Page:! !^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one.! + + "L BJ + M(M.M^R_Set_Bounds_Full) + ."E @FENIB FS Err' + "# -3D'' + "# ZJ + M(M.M^R_Set_Bounds_Full) + Z-."E @FENIB FS Err' + "# 3D'' + 0M(M.M^R_Goto_Next_Page) + 0 diff --git a/src/e142/page..78 b/src/e142/page..78 new file mode 100644 index 00000000..5d0fade5 --- /dev/null +++ b/src/e142/page..78 @@ -0,0 +1,238 @@ +!~Filename~:! !Commands for handling pages intelligently. -*-TECO-*-! +PAGE + +!& Setup PAGE Library:! !S Put macros on appropriate characters.! + + 0FO..Q PAGE_Setup_Hook[0 + fq0"G M0' + "# + M.M^R_Insert_Pagemark u:.X(P) !* Insert Pagemark on ^X P! + M.M^R_Goto_Next_Page u:.X(]) !* Goto Next Page on C-X ]! + M.M^R_Goto_Previous_Page u:.X([) !* Goto Prev Page on C-X [! + M.M^R_Join_Next_Page u:.X(J) !* Join Pages on ^X J ! + M.M^R_Widen_Bounds u:.X(W) !* Widen Bounds on ^X W ! + M.M^R_Incremental_Search [0 + M.M^R_String_Search [1 + (q.S-q0)*(q.S-Q1)"E !* if Search is on C-S ! + q.S M.V Real_Search_Macro + M.M^R_PAGE_Search u.S !* Then PAGE Search on C-S ! + M.M^R_PAGE_Reverse_Search u.R !* Reverse Search on C-R! + '"# (q..S-q0)*(q..S-q1)"E !* else if Search is on M-S! + q..S M.V Real_Search_Macro + M.M^R_PAGE_Search u..S !* then PAGE Search on M-S ! + M.M^R_PAGE_Reverse_Search u..R !* Reverse Search on M-R ! + '"# FTCannot_find_Search!!!__Send_a_note_to_Rubenstein.'' + M.M^R_Go_To_Page U..G !* Go to page on C-X C-P ! + M.M^R_Fill_Region U...G !* Fill Region on C-M-G ! + ' + + 0M.LPAGE_Flush_Crlf + 0M.LCurrent_Page + qSet_Mode_Line_Hook[1 + :i*1 M(M.M&_Set_PAGE_Mode_Line) uSet_Mode_Line_Hook + 0fo..q TECO_ mode_ hook F"E + M.VTECO_ mode_ hook + :i*'u1 + :i*1 + 1uPAGE_ Flush_ Crlf +  +  uTECO_ mode_ hook + + 0fo..q Visit_ File_ Hookf"E + M.VVisit_ File_ Hook + :i*'u1 + :i*1 + M.LCurrent_Page + 0fo..q PAGE_ Flush_ Crlf M.LPAGE_Flush_Crlf +  +  uVisit_File_Hook + + 0 + +!& Set PAGE Mode Line:! !S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string.! + + + qCurrent_Page"E ' !* if Current Page is 0, return argument! + "E :i*' "#' [1 !* if no argument, cons up a blank string! + qCurrent_Page :\ [2 + :I*1_Page_2 (]1 ]2)  + + +!^R Insert Pagemark:! !^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page.! + + 13i 10i 12i !* insert a pagemark! + qCurrent_Page"N + %Current_Page + 0:M(M.M^R_Goto_Next_Page)' + +!^R Goto Next Page:! !^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page.! + + [0 .[1 + M(M.M^R_Set_Bounds_Full) + qCurrent_Page"E !* if no virtual bounds then! + FF "E 0U0' !* if no args then narrow to current page! + 0[3 + 0j <%3 !* increment counter! + qPAGE_Flush_Crlf"E + :s + '"#:s + +'; !* Search for page delim, throw ifn found! + .-3-Q1;> !* if past point then we're there! + q3 uCurrent_Page ]3 + q1j' + qCurrent_Page+q0 [2 + q2:"G !* if page num is not positive then! + 0M(M.M^R_Goto_Next_Page) !* set bounds to this page! + @FENIB Fs Err' !* generate an error! + q0 M(M.M^R_Mark_Page) + q2 uCurrent_Page !* Update page number! + z-."E M(M.M^R_Widen_Bounds) !* If at end (tried to go to far)! + 0M(M.M^R_Goto_Next_Page) !* Set bounds to this page! + @FENIB FS Err' !* Generate a "NOT IN BUFFER" error! + ."'N & qPAGE_flush_Crlf"N2c' !* if not at beginning then skip crlf! + .(W): !* exchange point and mark! + z-."N -3c' !* if not end then back over crlf and ^L! + M(M.M^R_Set_Bounds_Region) !* set bounds to this region! + 1:"N BJ' !* go back to where we were if we can! + ]2 ]1 ]0 + M(M.M&_Set_Mode_Line) + 0 + +!^R Go to Page:! !^R Go to a specific page, arg is page number. +If no arg then go to next page! + + "L -1[0' !* Negative arg -=> Goto previous page! + "# FF"N !* if explicit argument! + -1[0 + M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 1uCurrent_Page + 0j' !* Jump to the beginning! + "# 1[0'' + Q0 M(M.M^R_Goto_Next_Page) !* get to the right page! + 0 + +!^R PAGE Search:! !C Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$.! + + QReal_ Search_ Macro, @:M(M.M&_ Macro_ on_ Whole_ Buffer) + +!& Macro on whole buffer:! !S Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$)! + + F F & 2 "E @FEWNA FS Err' !* if no pre-comma arg, then explode! + qCurrent_ Page"E + F F & 8 "N @:M()' "# :M()'' + M(M.M^R_Set_Bounds_Full) + F F & 8 "N @M()' "# M()' + 0uCurrent_Page + @M(M.M^R_Goto_Next_Page) + 0 + +!^R PAGE Reverse Search:! !C Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details.! + + -1:M(M.M^R_PAGE_Search) + +!& File Directory:! !S Returns a string pointer to the file directory! + + .[1 0[2 0[3 0[4 [5 [6 [7 [c + FS V Z+B "N FS Boundaries u2 u3 !* Remember if we had any bounds! + @M(M.M^R_Set_Bounds_Full)' + 0j + q..o [A !* remember our buffer! + FS B Cons [B !* and make a scratch buffer! + < .,(@f +_ L %4 !* Advance over CRLF's, increment page no.! + 3,Q4 :\ u5 + .,(:l).X6 + QPAGE_ Flush_ Crlf "E + :S + ' "# :S + +'uc + qc"E zj').FS Boundaries + M(M.MCount_Lines) u7 + 4,q7 :\ u7 + qB u..o + I5__7___ !* Print the page number! + 0,(fswidth-13)g6 + i + + qA u..O + 0,fs z FS Boundaries + qc;> + Q1J + q2"N Q3, Q2 FS Boundaries' + qb u..o HFX* (qA u..o qB FS B Kill)  + + +!Print File Directory:! !C Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number.! + + M(M.M&_ File_ Directory) [0 + FTPage_Lines__First_Non-blank_Line +0 + ]0 0 + + +!Make File Directory:! !Inserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end! + + M(M.M&_ File_ Directory) [0 + BJ + I0 + + FF"N + .[1 BJ + QComment_ Start [2 + QComment_ End [3 + + ]3 ]2 ]1' + ]0 b,. + +!^R Widen Bounds:! !^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line.! + + @M(M.M^R_Set_Bounds_Full) !* widen the bounds! + 0uCurrent_Page + :M(M.M&_Set_Mode_Line) + + +!^R Goto Previous Page:! !^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page.! + + FF "E -1'"#-' :M(M.M^R_Goto_Next_Page) !* go do it! + +!^R Join Next Page:! !^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one.! + + "L BJ + M(M.M^R_Set_Bounds_Full) + ."E @FENIB FS Err' + "# -3D'' + "# ZJ + M(M.M^R_Set_Bounds_Full) + Z-."E @FENIB FS Err' + "# 3D'' + 0M(M.M^R_Goto_Next_Page) + 0 diff --git a/src/e142/page._ej b/src/e142/page._ej new file mode 100644 index 00000000..d8bb9a26 --- /dev/null +++ b/src/e142/page._ej @@ -0,0 +1,216 @@ +PW +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + I h rhv'$0 i t 6 B~ d qR] + + M ZBK 6 @GOTaEV8G"GU| ]h-&4y LX +j +t +_ +f^d& Setup PAGE LibraryU0FO..QPAGE Setup Hook[0 +fq0"GM0' +"# +M.M^R Insert Pagemarku:.X(P) +M.M^R Goto Next Pageu:.X(]) +M.M^R Goto Previous Pageu:.X([) +M.M^R Join Next Pageu:.X(J) +M.M^R Widen Boundsu:.X(W) +M.M^R Incremental Search[0 +M.M^R String Search[1 +(q.S-q0)*(q.S-Q1)"E +q.SM.VReal Search Macro +M.M^R PAGE Searchu.S +M.M^R PAGE Reverse Searchu.R +'"#(q..S-q0)*(q..S-q1)"E +q..SM.VReal Search Macro +M.M^R PAGE Searchu..S +M.M^R PAGE Reverse Searchu..R +'"#FTCannot find Search!!! Send a note to Rubenstein.'' +M.M^R Go To PageU..G +M.M^R Fill RegionU...G +' +0M.LPAGE Flush Crlf +0M.LCurrent Page +qSet Mode Line Hook[1 +:i*1M(M.M& Set PAGE Mode Line)uSet Mode Line Hook +0fo..qTECO mode hookF"E +M.VTECO mode hook +:i*'u1 +:i*1 +1uPAGE Flush Crlf + +uTECO mode hook +0fo..qVisit File Hookf"E +M.VVisit File Hook +:i*'u1 +:i*1 +M.LCurrent Page +0fo..qPAGE Flush CrlfM.LPAGE Flush Crlf + +uVisit File Hook +0& Set PAGE Mode LineVqCurrent Page"E' +"E:i*'"#'[1 +qCurrent Page:\[2 +:I*1 Page 2(]1]2)^R Insert PagemarkN13i10i12i +qCurrent Page"N +%Current Page +0:M(M.M^R Goto Next Page)'^R Goto Next Page_[0.[1 +M(M.M^R Set Bounds Full) +qCurrent Page"E +FF"E0U0' +0[3 +0j<%3 +qPAGE Flush Crlf"E +:s + '"#:s + +'; +.-3-Q1;> +q3uCurrent Page]3 +q1j' +qCurrent Page+q0[2 +q2:"G +0M(M.M^R Goto Next Page) +@FENIBFsErr' +q0M(M.M^R Mark Page) +q2uCurrent Page +z-."EM(M.M^R Widen Bounds) +0M(M.M^R Goto Next Page) +@FENIBFSErr' +."'N&qPAGE flush Crlf"N2c' +.(W): +z-."N-3c' +M(M.M^R Set Bounds Region) +1:"NBJ' +]2]1]0 +M(M.M& Set Mode Line) +0^R Go to Pagex"L-1[0' +"#FF"N +-1[0 +M(M.M^R Set Bounds Full) +1uCurrent Page +0j' +"#1[0'' +Q0M(M.M^R Goto Next Page) +0^R PAGE Search:QReal Search Macro,@:M(M.M& Macro on Whole Buffer)& Macro on whole buffer.FF&2"E@FEWNAFSErr' +qCurrent Page"E +FF&8"N@:M()'"#:M()'' +M(M.M^R Set Bounds Full) +FF&8"N@M()'"#M()' +0uCurrent Page +@M(M.M^R Goto Next Page) +0^R PAGE Reverse Search-1:M(M.M^R PAGE Search)& File Directory .[10[20[30[4[5[6[7[c +FSVZ+B"NFSBoundariesu2u3 +@M(M.M^R Set Bounds Full)' +0j +q..o[A +FSBCons +<.,(@f +  L%4 +3,Q4:\u5 +.,(:l).X6 +QPAGE Flush Crlf"E +:S + '"#:S + +'uc +qc"Ezj').FSBoundaries +M(M.MCount Lines)u7 +4,q7:\u7 +qBu..o +I5 7  +0,(fswidth-13)g6 +i + +qAu..O +0,fszFSBoundaries +qc;> +Q1J +q2"NQ3,Q2FSBoundaries' +qbu..oHFX*(qAu..oqBFSBKill)Print File DirectoryMM(M.M& File Directory)[0 +FTPage Lines First Non-blank Line +0 +]00Make File DirectoryM(M.M& File Directory)[0 +BJ +I0 + +FF"N +.[1BJ +QComment Start[2 +QComment End[3 + +]3]2]1' +]0b,.^R Widen BoundsI@M(M.M^R Set Bounds Full) +0uCurrent Page +:M(M.M& Set Mode Line)^R Goto Previous Page+FF"E-1'"#-':M(M.M^R Goto Next Page)^R Join Next Page"LBJ +M(M.M^R Set Bounds Full) +."E@FENIBFSErr' +"#-3D'' +"#ZJ +M(M.M^R Set Bounds Full) +Z-."E@FENIBFSErr' +"#3D'' +0M(M.M^R Goto Next Page) +0~Filename~PAGE~DOC~ ~Filename~=Commands for handling pages intelligently. -*-TECO-*- +~DOC~ & Setup PAGE Library-S Put macros on appropriate characters. +~DOC~ & Set PAGE Mode Line=S Add Page onto the mode line, maybe. +If given a string argument, appends Page onto the end of the +string, if there are buffer bounds in effect, and returns the +new string. +~DOC~ ^R Insert Pagemark'^R Insert a page mark, leaving new second page current +Inserts a formfeed and a crlf, sets the virtual buffer +boundaries to be the second half of the old page. +~DOC~ ^R Goto Next Page^R Make the next page current. +Set the virtual buffer boundaries to the next page. If given +a negative argument, goes to previous page. +~DOC~ ^R Go to PageS^R Go to a specific page, arg is page number. +If no arg then go to next page +~DOC~ ^R PAGE SearchOC Search that crosses virtual buffer boundaries. +Uses ^R Incremental Search or ^R String Search, whichever you had on C-S +or M-S when you loaded the PAGE library. See the documentation of +whichever search you use for details. You can change the search used by +doing, for instance, M.M^R String Search$ u$Real Search Macro$. +!~DOC~ & Macro on whole bufferlS Macros its precomma arg on the whole buffer. +The post-comma argument and @ flag are passed on to the macro. +If Q$Current Page$ is non-zero, then the bounds are widened, the argument +is macroed, and the bounds are narrowed again to the current page. Thus, +the way to do, say, a search is: + M.M^R Incremental Search$, @M(M.M& Macro on Whole Buffer$) + ~DOC~ ^R PAGE Reverse SearchqC Reverse Search that crosses virtual buffer +boundaries. See documentation of ^R PAGE Search for details. +~DOC~ & File Directory6S Returns a string pointer to the file directory +~DOC~ Print File DirectorywC Prints a directory of the file +Prints out the first non-blank line on each page, preceded by its +page number. +~DOC~ Make File DirectorymInserts a directory of the file at the beginning +Prints out the first non-blank line on each page, preceded by its +page number. If given an argument, puts Q$Comment Start$ at the start +of each line and Q$Comment End$ at the end +~DOC~ ^R Widen Bounds ^R Widen the virtual buffer bounds to include the whole file +Calls ^R Set Bounds Full and clears the page number from the mode line. + +~DOC~ ^R Goto Previous Page^R Make the previous page current. +Set the virtual buffer boundaries to the previous page. If given +a negative argument, goes to the next page. +~DOC~ ^R Join Next Page^R Combine two pages together +Combines this page with next. If given negative arg, +combines previous page with this one. +~DIRECTORY~ +& Setup PAGE Library +& Set PAGE Mode Line +^R Insert Pagemark +^R Goto Next Page +^R Go to Page +^R PAGE Search +& Macro on whole buffer +^R PAGE Reverse Search +& File Directory +Print File Directory +Make File Directory +^R Widen Bounds +^R Goto Previous Page +^R Join Next Page + ~INVERT~[1Q1 diff --git a/src/e142/patch. b/src/e142/patch. new file mode 100644 index 00000000..d9c2375f --- /dev/null +++ b/src/e142/patch. @@ -0,0 +1,64 @@ +!* -*-Teco-*-! +!~Filename~:! !Patches to EMACS macros! +PATCH + +!Select Buffer:! !C Select or create buffer, given its name. +If called from a ^R character, read the buffer name from the terminal +or should be given a buffer number as a numeric arg. +As a subroutine, needs a buffer number (or buffer name pointer) as a +prefix arg, or a buffer name as a string arg. +If there is a buffer with that name, it is selected. +Otherwise, a buffer with that name is created and selected. +When a new buffer is selected the first time, if QBuffer Creation Hook +is nonzero, it is run after the buffer is selected.! + + MMM_&_Check_Top_Levelbuffers + [..h [4 0[3 !* Make sure we can display the bfr we switch to.! + FF&1"N U3' !* Numeric arg => use it as buffer or buffer # to select.! + "# "E :F "G :i3'' !* No postcomma arg or precomma arg => read string arg.! + Q3"E M.M List_BuffersF[HELPMAC !* Else must read from tty.! + "N u4' !* Precomma arg is prompt string to use.! + "# :i4 Select_Buffer' + QPrevious_Buffer[3 !* Get name of default new buffer to put in prompt.! + 1,Q3M(M.M &_Find_Buffer)"L Q:.B(1)U3' + 3,m(m.m &_Read_Line)4_(3):_u3'' !* Read name of buffer to select.! + Q3[5 !* Save name (or buffer #) in Q5.! + FQ3"E QPrevious_BufferU3' !* Null string means previous buffer.! + 1,Q3 M(M.M&_Find_Buffer)[1 !* Get index in buffer table of this name or number.! + Q1u4 !* Q4 remains negative, for a new buffer.! + Q1"L !* No such buffer => make one now.! + FQ3"L :I*No_such_buffer FS ERR' !* Refuse to create buffer if bfr number spec'd.! + FQ5"E 0U1 0U4' !* If ^XB and prev bfr non ex, use 1st buffer instead.! + "# Q3 M(M.M &_Create_Buffer)U1'' !* Else create the specified buffer.! + QBuffer_IndexU3 + Q1-Q3"E 0' + 1F[Noquit !* Prevent quitting half-switched.! + 0FO..Q Buffer_Deselection_Hook[5 + Q5"N M5' + Q.B[..O ZJ 0K ]..O !* Get gap in buffer table out of the way.! + Q3,9F.B !* Swap old buffer's locals back into its entry.! + QBuffer_FilenamesU:.B(Q3+2) !* Stick its filenames back into entry.! + QMode U:.B(Q3+3) !* Stick selected mode into entry.! + +!* Simultaneously swap out old buffer's TECO default filenames + and window address, and swap in the new buffer's.! + Q:.B(Q1+6) FS WINDOW U:.B(Q3+6) + Q:.B(Q1+5)F"E W' FS D FILE U:.B(Q3+5) + +!* We now are "between buffers".! + Q:.B(Q1+2) UBuffer_Filenames !* Get filenames of new buffer.! + Q:.B(Q1+1)UBuffer_Name !* For our records, save its name! + Q:.B(Q1+3)UMode + Q1 UBuffer_Index !* and its index, for when we deselect it.! + Q:.B(Q3+1) UPrevious_Buffer !* remember previously selected buffer's name.! + Q:.B(Q1+3) U3 + Q1,9F.B !* Get new buffer's local variable values.! + 1FSMODE CHANGE !* Recompute mode line eventually.! + Q:.B(Q1+4) U..O !* Now really switch to this buffer.! + 0FO..Q Buffer_Selection_HookF"N [..N' + Q:.B(Q1+5)"N ' !* If buffer has been selected before, that's all.! + Q:.B(Q1+1)U4 + FS OS TECO "E F64'"#Q4' FS DFN1 !* If buffer selected for 1st time, set default fn1 from name.! + 0FO..QBuffer_Creation_HookU4 !* If buffer selecetd for 1st time, maybe run user's hook.! + Q4"N M4' +  diff --git a/src/e142/patch._ej b/src/e142/patch._ej new file mode 100644 index 00000000..c07f8b96 --- /dev/null +++ b/src/e142/patch._ej @@ -0,0 +1,63 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + E"+<D'2 +MSSelect Buffer0MMM & Check Top Levelbuffers +[..h[40[3 +FF&1"NU3' +"#"E:F "G:i3'' +Q3"EM.MList BuffersF[HELPMAC +"Nu4' +"#:i4Select Buffer' +QPrevious Buffer[3 +1,Q3M(M.M& Find Buffer)"LQ:.B(1)U3' +3,m(m.m& Read Line)4 (3): u3'' +Q3[5 +FQ3"EQPrevious BufferU3' +1,Q3M(M.M& Find Buffer)[1 +Q1u4 +Q1"L +FQ3"L:I*No such bufferFSERR' +FQ5"E0U10U4' +"#Q3M(M.M& Create Buffer)U1'' +QBuffer IndexU3 +Q1-Q3"E0' +1F[Noquit +0FO..QBuffer Deselection Hook[5 +Q5"NM5' +Q.B[..OZJ0K]..O +Q3,9F.B +QBuffer FilenamesU:.B(Q3+2) +QModeU:.B(Q3+3) +Q:.B(Q1+6)FSWINDOWU:.B(Q3+6) +Q:.B(Q1+5)F"EW'FSDFILEU:.B(Q3+5) +Q:.B(Q1+2)UBuffer Filenames +Q:.B(Q1+1)UBuffer Name +Q:.B(Q1+3)UMode +Q1UBuffer Index +Q:.B(Q3+1)UPrevious Buffer +Q:.B(Q1+3)U3 +Q1,9F.B +1FSMODECHANGE +Q:.B(Q1+4)U..O +0FO..QBuffer Selection HookF"N[..N' +Q:.B(Q1+5)"N' +Q:.B(Q1+1)U4 +FSOSTECO"EF64'"#Q4'FSDFN1 +0FO..QBuffer Creation HookU4 +Q4"NM4' +~Filename~ PATCH~DOC~ ~Filename~Patches to EMACS macros +~DOC~ Select BufferC Select or create buffer, given its name. +If called from a ^R character, read the buffer name from the terminal +or should be given a buffer number as a numeric arg. +As a subroutine, needs a buffer number (or buffer name pointer) as a +prefix arg, or a buffer name as a string arg. +If there is a buffer with that name, it is selected. +Otherwise, a buffer with that name is created and selected. +When a new buffer is selected the first time, if QBuffer Creation Hook +is nonzero, it is run after the buffer is selected. +~DIRECTORY~Select Buffer + ~INVERT~[1Q1 diff --git a/src/e142/pl1lib._ej b/src/e142/pl1lib._ej new file mode 100644 index 00000000..4023508f Binary files /dev/null and b/src/e142/pl1lib._ej differ diff --git a/src/e142/qp. b/src/e142/qp. new file mode 100644 index 00000000..6233ad5e --- /dev/null +++ b/src/e142/qp. @@ -0,0 +1,22 @@ +!~Filename~:! !QP Printer -*-TECO-*-! +QP + +!:! !C print QP! + M(M.M Qprint) + +!Qprint:! !Print Q-reg PDL! + fs qp ptr [0 -1[1 [2 [3 + q0< %1 :\ u2 + q1 FS QP Home u3 + ft2__3__ + Q1 FS QP Slot u3 + q3 FP u2 + q2 "L Q3 :=' + "# Q2 "E FT' + "# Q2-1 "E FT' + "# Q2-100 "E Q3 M(M.M&_ Macro_ Get_ Full_ Name) U3 + FT[Purstr]__3' + "# FT[String] "3"'''''''' + FT +> + ]3]2]1]0 diff --git a/src/e142/qp._ej b/src/e142/qp._ej new file mode 100644 index 00000000..878d5772 --- /dev/null +++ b/src/e142/qp._ej @@ -0,0 +1,28 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + Y,2:? +`hpxHR>E M(M.MQprint) +Qprint~fsqpptr[0-1[1[2[3 +q0<%1:\u2 +q1FSQPHomeu3 +ft2 3  +Q1FSQPSlotu3 +q3FPu2 +q2"LQ3:=' +"#Q2"EFT' +"#Q2-1"EFT' +"#Q2-100"EQ3M(M.M& Macro Get Full Name)U3 +FT[Purstr] 3' +"#FT[String]"3"'''''''' +FT +> +]3]2]1]0~Filename~QP~DOC~ ~Filename~QP Printer -*-TECO-*- +~DOC~ C print QP +~DOC~ QprintPrint Q-reg PDL +~DIRECTORY~ +Qprint + ~INVERT~[1Q1 diff --git a/src/e142/record. b/src/e142/record. new file mode 100644 index 00000000..90b5b641 --- /dev/null +++ b/src/e142/record. @@ -0,0 +1,24 @@ +!~Filename~:! !appends name to file -*-Teco-*-! +RECORD + +!:! !append the name to Startup.;1! + + F[ B Bind [0 +  "E ERSTARTUP.;1' + "# -1 "E ERPAGE-USERS.;1' + "# -2 "E ERDM-USERS.;1' + "# :I*URF Unknown_ RECORD_ filename FS ERR''' + @Y EC + z[1 ZJ + FS Date FS FD Convert + FS MSname :F6 u1 + i__1 + +  "E @:EWSTARTUP.;1' + "# -1 "E @:EWPAGE-USERS.;1' + "# -2 "E ERDM-USERS.;1' + "# :I*URF Unknown_ RECORD_ filename FS ERR''' + HP + :EF + ET<1>Foo.;0 +  diff --git a/src/e142/record._ej b/src/e142/record._ej new file mode 100644 index 00000000..7342efda --- /dev/null +++ b/src/e142/record._ej @@ -0,0 +1,30 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + E"(07vjq>D F[BBind[0 +"EERSTARTUP.;1' +"#-1"EERPAGE-USERS.;1' +"#-2"EERDM-USERS.;1' +"#:I*URF Unknown RECORD filenameFSERR''' +@YEC +z[1ZJ +FSDateFSFDConvert +FSMSname:F6u1 +i 1 + +"E@:EWSTARTUP.;1' +"#-1"E@:EWPAGE-USERS.;1' +"#-2"EERDM-USERS.;1' +"#:I*URF Unknown RECORD filenameFSERR''' +HP +:EF +ET<1>Foo.;0 +~Filename~ +RECORD~DOC~ ~Filename~%appends name to file -*-Teco-*- +~DOC~ *append the name to Startup.;1 +~DIRECTORY~ + + ~INVERT~[1Q1 diff --git a/src/e142/sa. b/src/e142/sa. new file mode 100644 index 00000000..c1d31a58 --- /dev/null +++ b/src/e142/sa. @@ -0,0 +1,46 @@ +In the past, I have been involved in several different areas of both Chemistry and +Computer Science. Ideally, I would like to find a topic for research (and, +eventually, a career) which encompasses aspects of both of those interests. + +My interest in both chemistry and computer science goes back to high school, where my +chemistry instructor, Dr. George Biehl, sparked not only my initial interest in +chemistry, but also served as my instructor when I enrolled in a lunch-time +minicourse in computer programming. The following year, as my interest increased, I +actually taught the course, with Dr. Biehl serving as my adviser. + +For some time, I was undecided as to whether to specialize in chemistry or computer +science; my first technically oriented job was actually in computers: operator and, +later, systems programmer for the Stanford University Medical Experimental center for +Artificial Intelligence in Medicine (SUMEX-AIM). I was primarily responsible for +improving and maintaining the file backup system and other systems and user-support +programming. This job gave me considerable exposure to current research activities, +such as Lederberg's "Dendral" programs for structure enumeration and elucidation and +Wipke's "Strategic Evaluation off Chemical Synthesis (SECS)" program. + +My second technical position, which I continue to hold, is that of a member of the +technical staff of the medical/analytical instrumentation division of Hewlett/Packard +laboratories. In this diverse group of scientists and engineers, I have been +carrying out research towards the development of new instrumentation. Specifically, +I have worked with another organic chemist and an optical engineer in a study of the +feasibility of using visible ATR spectroscopy and surface bound indicators in a +device for rapid blood pH determination. My contribution to this project consisted +of the synthesis and characterization of several models for surface bound indicators, +such as N-substituted sulfonamides of phenolsulfonphthaleins. More recently, I have +been working with a physical chemist studying the effect of oxygen on room +temperature phosphorescence, with the idea of using that effect to rapidly measure +atmospheric and/or dissolved (blood) oxygen. I have been preparing dyes which show +phosphorescence while adsorbed to a surface such as silica gel or filter paper for +testing of their usefulness in such a device. + +Finally, I am presently engaged in research with Dr. E. E. van Tamelen. Here, I am +continuing work begun by one of his graduate students, developing a total synthesis +of the natural products Triptolide and Stemolide. + +At the present time, I have not formulated a detailed plan of study and research. If +ind synthetic organic chemistry very interesting and challenging, but I hope not to +restrict myself to that relatively narrow field. I believe that computers are going +to become increasingly more useful to the chemist; particularly interesting are +Artificial Intelligence applications, such as Dr. Corey's work in computer aided +synthesis. While computer controlled instrumentation is becoming increasingly +commonplace, very few of these systems are actually "smart" about the chemistry which +is being controlled. \ No newline at end of file diff --git a/src/e142/teach-emacs.ai_s-init b/src/e142/teach-emacs.ai_s-init new file mode 100644 index 00000000..26ac3449 Binary files /dev/null and b/src/e142/teach-emacs.ai_s-init differ diff --git a/src/e142/teach-emacs.txt b/src/e142/teach-emacs.txt new file mode 100644 index 00000000..685aa909 --- /dev/null +++ b/src/e142/teach-emacs.txt @@ -0,0 +1,626 @@ +Things to put in: +Lesson 2: + Mode line, searching, point/mark already in. What else? +Lesson 3: + Need Init files, Two window mode, buffers descriptions. What else? + Autosave mode + +DOCOND declarations for operating-system dependencies: +{Alternatives:ITS,Tops20,Sumex} +{Flag:?Sumex} +{Flag:?ITS} +{Flag:?Tops20} +{Replace:+ITS=>C-Z->C-C} +{Replace:+ITS=>->} +{Replace:+ITS=>->} +{end} +You are looking at the EMACS tutorial. Comments should be sent to +Rubenstein@Sumex-AIM and McLure@SRI-KL. + +EMACS commands are generally prefixed by the CONTROL key or the META +(EDIT on datamedias) key ( if you don't have META or EDIT on your +keyboard). Rather than write out META or CONTROL each time we want +you to prefix a character, we'll use the following abbreviations: + + C- means hold the CONTROL key down and type a character. + M- means hold the META key down while typing a character. + if you don't have a META or EDIT key, then type , + release it, then type the character. + +Thus, C-F would be hold the control key and type F. You will often +be asked to type characters to see how they work; don't actually do +this, however, until you see >> at the left of the screen. For instance: +<> +>> Now type C-V (View next screen) to move to the next screen. + (go ahead, do it by depressing the control key and V together). + From now on, you'll be expected to do this whenever you finish + reading the screen. + +Note that there is an overlap when going from screen to screen; this +provides some continuity when moving through the file. + +The first thing that you need to know is how to move around from place +to place in the file. You already know how to move forward a screen, +with C-V. To move backwards a screen, type M-V (depress the META or +EDIT key and type V, V if you don't have a META or EDIT key}). + +>> Try typing M-V and C-V to move back and forth a few times. + +SUMMARY +------- + +The following commands are useful for viewing screenfuls: + + C-V View next screenful + M-V View previous screenful + C-L 'Refresh' the current screen. + +>> Try C-L now. (You'll notice that it centers the screen where + the cursor currently is. If this happens to move this text off the + screen, just do C-V's or M-V's to see it again.) Do a C-L for refresh. + +BASIC CURSOR CONTROL +-------------------- + +Getting from screenful to screenful is useful, but how do you +reposition yourself within a given screen to a specific place? +There are several ways you can do this. One way (not the best, but +the most basic) is to use the commands previous, backward, forward +and next. As you can imagine these commands (which are given to +EMACS as {+Sumex:M-^, M-<, M->, M-}{-Sumex:C-P, C-B, C-F, and C-N} respectively) move the cursor from +where it currently is to a new place in the given direction. {-Sumex:Here, +in a more graphical form are the commands: + + Previous line, C-P + : + : + Backward, C-B .... Current cursor position .... Forward, C-F + : + : + Next line, C-N + +You'll probably find it easy to think of these by letter. P for +previous, N for next, B for backward and F for forward. These are +the basic cursor positioning commands and you'll be using them ALL +the time so it would be of great benefit if you learn them now. +}{+Sumex:Note +that these commands are placed in the logical place on the Datamedia +keypad.} + +>> Try doing a few {-Sumex:C-N}{+Sumex:M-}'s to bring the cursor down to this line. + Move into the line with {-Sumex:C-F}{+Sumex:M->}'s and up with {-Sumex:C-P}{+Sumex:M-^}'s. Now use + these four commands to play around a little. Try moving off + the top of this screen and see what happens. + +When you go off the top or bottom of the screen, the text beyond +the edge is shifted onto the screen so that your instructions can +be carried out while keeping the cursor on the screen. + +A faster way to move around is to move by words or even entire +sentences. Here is a summary of simple cursor moving operations +including the word and sentence moving commands: + + {-Sumex:C-F}{+Sumex:M->} Move forward a character + {-Sumex:C-B}{+Sumex:M-<} Move backward a character + + M-{-Sumex:F}{+Sumex:)} Move forward a word + M-{-Sumex:B}{+Sumex:(} Move backward a word + + {-Sumex:C-N}{+Sumex:M-} Move to next line + {-Sumex:C-P}{+Sumex:M-^} Move to previous line + + {-Sumex:C-A}{+Sumex:M- M-<} Move to beginning of line + {-Sumex:C-E}{+Sumex:M- M->} Move to end of line + + {-Sumex:M-A}{+Sumex:M- M-(} Move back to beginning of sentence + {-Sumex:M-E}{+Sumex:M- M-)} Move forward to end of sentence + + M-{-Sumex:<}{+Sumex:{*Brace:}} Go to beginning of file + M-{-Sumex:>}{+Sumex:}} Go to end of file +{+Sumex: + +Just as the key means "Add the EDIT key to the next command," +typing M- or means "Add both the EDIT and the CONTROL +keys to the next command." Generally, if C-A does something, M-A will +do it bigger, and C-M-A will do it even bigger. + +} +>> Try all of these commands now a few times for practice. + Since the last two will take you away from this screen, + you can come back here with M-V's and C-V's. These are + the most often used commands. + +Like all other commands in EMACS, these commands can be given +arguments which cause them to be executed repeatedly. The way you +give arguments is by prefixing with M- or C-U. For +instance, C-U 12 C-V scrolls forward twelve lines, and M-8 +M-{+Sumex:)}{-Sumex:F} moves forward eight words. Use whichever of +these methods is more convenient for you. + +>> Try giving a suitable argument to {-Sumex:C-N or C-P}{+Sumex:M-^ or M-Lf} to come as close + as you can to this line in one jump. + +The only apparent exception to this is the screen moving commands, +C-V and M-V. When given an argument, they scroll the screen up or +down by that many lines, rather than screenfuls. This proves to be +much more useful. + +>> Try typing M-8 C-V now. + +Did it scroll the screen up by 8 lines? If you would like to +scroll it down you can give an argument to M-V. + + +INSERTING AND DELETING +---------------------- + +If you want to type text, just do it. Characters which you can see, +such as A, 7, *, etc. are taken by EMACS as text and inserted +immediately. You can delete the last character you typed by doing +. More generally, will delete the character immediately +before the current cursor position. + +>> Do this now, type a few characters and then delete them + by typing a few times. + +Remember that most EMACS commands can be given a repeat count; Note +that this includes characters which insert themselves. + +>> Try that now -- type M-8 * and see what happens. + +You've now learned the most basic way of typing something in +EMACS and correcting errors. You can delete by words or lines +as well. Here is a summary of the delete operations: + + C-D delete the next character after the cursor + delete the character just before the cursor + M-D kill the next word after the cursor + M- kill the word immediately before the cursor + C-K kill from the cursor position to end of line + +Note that C-K kills text ONLY TO THE RIGHT of the cursor; if you put +the cursor in the middle of the line, C-K will delete the right half +of the line. Another C-K will delete the CRLF and join the next line +to the end of the current one. + +Now suppose you kill something, and then you decide that you want to +get it back? Well, whenever you kill something bigger than a +character, EMACS saves it for you. To yank it back, use C-Y. Note +that you don't have to be in the same place to do C-Y; This is a +good way to move text around. Also note that the difference between +"Killing" and "Deleting" something is that "Killed" things can be +yanked back, and "Deleted" things cannot. + +For instance, type {-Sumex:C-N}{+Sumex:M-Linefeed} a couple of times to +postion the cursor at some line on this screen.{*Refill:} + + >> Do this now, move the cursor and kill that line with C-K. + +Note that a single C-K will kill the contents of the line, and a +second C-K will delete the line itself, and make all the other lines +move up. If you give C-K a repeat count, it will delete that many +lines AND their contents. + +The text that has just disappeared is saved so that you can retrieve +it. To retrieve the last killed text and put it where the cursor +currently is type C-Y. + + >> Try it; type C-Y to yank the text back. + +Think of C-Y as if you were yanking something back that someone took +away from you. Notice that if you do several C-K's all at once the +text that is killed is all saved for you so that if you want it back +you can yank it back. + + >> Do this now, type C-K several times. + +Now to retrieve that killed text: + + >> Move the cursor down a few lines and type C-Y to retrieve the + lines that you killed. This is how you move text from place + to place. You can even make copies of a line by killing it + and yanking it back as many times as you want. Remember + that when you have just killed text, it stays with you so + that if you move your cursor elsewhere in the text and + then C-Y to yank back the killed text, you will have + a method for moving text around in a file. + +EXTENDING THE COMMAND SET +------------------------- + +There are many, many more EMACS commands than could possibly be put +on all the control and meta characters. EMACS gets around this with +the X (eXtend) command. This comes in three flavors: + + C-X Character eXtend + M-X Named command eXtend + {-Sumex:M-}{+Sumex:C-M-X} TECO extend + +These are commands that are generally useful but used less than the +commands you have already learned about. As an example, one command +that is used infrequently is the command to tell EMACS that you'd +like to stop editing. The command to do this is C-X C-Z.{-ITS: Think of +it as Z for zapping yourself.} + +There are many C-X commands. The ones you need immediately are: + + C-X C-V Visit file. This is how you read in a file + to edit it. When you type this, EMACS asks + you for a file name to visit. You would respond + with the name of the file. Then EMACS brings it + in for editing. If the file doesn't exist, then + EMACS assumes that you are creating a new file. + C-X C-S Save file. This is a command that tells EMACS + to save the file you are currently looking at + onto disk. It is recommended you give this + ocassionally to prevent losing any work in the + case of a system crash. + C-X C-Z Quit EMACS. This does NOT automatically save your + file. If given any argument, it will save your + file before exiting. Thus, the standard way to + save and exit is C-U C-X C-Z. If you don't like + this, there is a way to have EMACS save your buffer + at frequent intervals and when you exit. This is + called "Auto Save Mode", and is explained below. + +Named eXtend commands are commands which are used even less +frequently, or commands which are used only in certain modes. An +example of this type of command is the Replace command. When you type +M-X, EMACS will prompt you at the bottom of the screen with MM (EMACS +calls named eXtend commands MM commands) and then you can type the +name of the command you want to execute, in this case, "Replace +String". Just type "REP" and EMACS will complete the command. +Then you type the string that you want to replace, an , the +string you want to replace it with, and a return. + + >> Try this now; type M-X reptryyou can do + See how the previous line changed? All the "try"s were + changed to "you can do" + +The last kind of extend command is the TECO extend. If you type +{+Sumex:C-M-X}{-Sumex:M-}, then you can type TECO commands, +terminated with . You probably will never have to use this, +but it's there if you do.{*Refill:} + + +CONCLUSION +---------- + +This is the end of the first lesson in Teach{-ITS:-}Emacs. You now +know all the commands that you really need to edit a file. To learn +some more about Searching, doing things with arbitrary regions of +text, special context oriented commands relating to paragraphs, pages, +LISP S-expressions or lists, you should run Teach{-ITS:-}Emacs +again and go through the intermediate lesson. For now, you ought to +get some practice editing files.{*Refill:} + In this lesson, you will learn about some of the additional things +that EMACS can help you do. If you need to review what was in the +previous lesson, please do so. This lesson is an intermediate level +description of some more advanced and useful features. + +MODE LINE +--------- + +If EMACS sees that you are typing commands slowly it shows them to you +at the bottom of the screen in an area called the echo lines. This is +just the last few lines at the bottom. The line immediately above +these is called the MODE LINE. You may notice that it begins with +EMACS (Fundamental) ...more stuff... This is a very useful +'information' line. To understand EMACS it is best to consider that +it operates in a variety of modes. The default mode is Fundamental +which is what you are in now. There are modes for editing different +languages and text, such as LISP mode, Text mode, etc. The mode line +serves to show you various things about your current state. For +instance, on the mode line here you'll notice that it says Main. +EMACS operates with things called buffers. This is a place that it +puts your file while you are editing it. There are names for buffers. +The default buffer upon startup of EMACS is Main. You'll notice that +after the Main comes the filename +{-ITS:DSK:TEACH-EMACS.TUTORIAL}{+ITS:your-directory; +machine: TEACH TEXT}. This is the name of your own temporary copy of +the text of the EMACS tutorial; the file you are now visiting. +After the name of the file comes --64%--. This indicates that you are +64% of the way through the file. When you are at the top or the +bottom of the file, EMACS will say --TOP-- or --BOT--, respectively.{*Refill:} + + +SEARCHING +--------- + +EMACS can do searches for strings (these are groups of contiguous +characters or words) either forward through the file or backward +through it. To search for the string means that you are trying to +locate it somewhere in the file and have EMACS show you where the +occurences of the string exist. EMACS searches are somewhat different +from what you may be familiar with. The usual search is called +"Incremental Search" -- it is performed as you type in the thing to +search for. The command to inititate an incremental search is C-S for +forward search, and C-R for reverse search. BUT WAIT! Don't do them +now. When you type C-S you'll notice that the mode line changes to +'I-Search' and below it you get 'Search:' This tells you that EMACS is +in incremental search mode, waiting for you to type the thing that you +want to search for.{*Refill:} + +>> Now type C-S to start a search. SLOWLY, one letter at a time, + type the word 'cursor', pausing after you type each + character to notice what happens to the cursor. + +Did you see what happened? EMACS, in an incremental search, tries +to go to the occurence of the string that you've typed out so far. +To go to the next occurence of 'cursor' just type C-S again. If no +such occurence exists EMACS beeps and tells you that it is a failing +search. To get out of Incremental Search Mode, type any EMACS command +except C-Q, C-R or C-S. C-Q can be used to "quote" control characters +so that you can include them in search strings. C-S and C-R repeat +the search in the specified direction.{*Refill:} + +If you are in the middle of an incremental search and type , +you'll notice that the last character in the search string is erased +and the search backs up to the previous occurence of that string. For +instance, suppose you currently have typed 'cu' and you see that your +cursor is at the first occurence of 'cu'. If you now type , +the 'u' on the search line is erased and you'll be repositioned in the +text to the occurence of 'c' immediately before the first 'cu'. This +provides a useful means for backing up while you are searching.{*Refill:} + +The C-S starts a search that looks for any occurence of the search +string AFTER the current cursor position. But what if you want to +search for something earlier in the text? To do this one should type +C-R for Reverse search. Everything that applies to C-S applies to C-R +except that the direction of the search is reversed.{*Refill:} + + +POINT, MARK and REGION +---------------------- + +Another useful facility would be the ability to perform editing +operations on arbitrary regions of text within the buffer. In EMACS, +this facility is available in the form of many commands which operate +on "the region" or "between point and mark." "Point" is simply where +the cursor currently is (cf. the assembly language programmer's "." +meaning the current location). The "mark" is another place in the +file that, for some reason, EMACS is remembering. This "mark" can be +set in many ways. The simplest way is for you to give the command +C-@{+Sumex: (That is, )}, which places the mark at the current +point. Also, you may have noticed that after terminating an +Incremental Search, EMACS typed out ^@ in the echo region. This +indicates that the mark has been set at the point where you started +searching. This mark is not set (and ^@ is not typed out) if you +didn't move very far in your search. + +Suppose you moved the cursor to the beginning of this line and placed +the mark with the above command and then moved the cursor elsewhere in +the file. The area between the mark and the point is called the +"region". This is a very important notion within EMACS. It enables +one to do wonderous manipulations of text within your buffer, often +doing enormous amounts of work within a very small amount of time. We +will discuss this region concept at great length.{*Refill:} + +At any time, if you want to reassure yourself of where the mark is +currently placed, you can use the C-X C-X (exchange point and mark) +command. What happens when you give this command is that the point is +relocated to the location of the mark and vice versa. For instance, +if you had the mark at the beginning of the buffer and the point +somewhere in the middle, you could say C-X C-X and your point would go +to the beginning of the buffer and the mark would be placed in the +middle of the file, where you had just come from.{*Refill:} + + >> Try this; Move the cursor somewhere on the screen, give the Set + Mark command ({-Sumex:C-@}{+Sumex:}), move the cursor somewhere + else on the screen, and then give the command C-X C-X. + +The following commands are useful for delimiting, manipulating and +performing other various and sundry actions on the region: + + Setting the mark and/or region: + {+Sumex:}{-Sumex:C-@} Place the mark where the cursor currently is + C-X C-X Interchange mark and point. + M-@ Set mark after end of next word. + C-< Set mark at beginning of buffer. + C-> Set mark at end of buffer. + M-H Put region around current paragraph. + C-X C-P Put region around current page. + C-X H Put region around entire buffer. + + Doing things to the region: + C-W Kill region (can be retrieved with C-Y) + M-W Copy region (Just puts the region where C-Y + can get it later) + + +TEXT HANDLING COMMANDS +---------------------- + +There are a number of other commands useful for specialized kinds of +files. Some of the most general commands are those used to handle +text. Some of the commands which you have already learned, such as +the sentence handling commands {+Sumex:M- M-(}{-Sumex:M-A} and +{+Sumex:M- M-)}{-Sumex:M-E}, are particularly useful for text. Here +are some others:{*Refill:} + + M-U Uppercase word -- converts words to all upper case + M-L Lowercase word + M-C Capitalize word + C-X C-U Uppercase region + C-X C-L Lowercase region + + M-[ Backwards paragraph + M-] Forwards paragraph + M-H Mark paragraph + M-Q Fill paragraph + + M-G Fill Region. Given a positive argument, the fill + commands will justify too. A negative argument will + cause it to remove extra spaces before filling + (de-justifying). + +INIT FILES +---------- + +Not yet written + +MULTIPLE BUFFERS, TWO WINDOW MODE +--------------------------------- + +Not yet written. + +GETTING MORE HELP +----------------- + +In this tutorial we have tried to supply just enough information to +get you started using EMACS. There is so much available in EMACS that +it would be impossible to explain it all here. However, you may want +to learn more about EMACS since it has numerous desirable features +that you don't know about yet. EMACS has a great deal of internal +documentation. All of these commands can be accessed through the HELP +character. If there is no key labelled "HELP" on your keyboard, you +can type the character as {+ITS:C-_ H (two +keystrokes)}{+Sumex:^H}{+Tops20:^_}. To use the HELP features, type +the character, and then a character saying what kind of help +you want. If you are REALLY lost, type ? and EMACS will tell +you what kinds of help it can give. The options which are most useful +are the following:{*Refill:} + + C Character describe. You type in the character. + Multi-character commands such as C-X C-Z + and (if you have no META or EDIT key) V + are also allowed. + D Describe a named command. You type in a command. + A Apropos. Type in a keyword and EMACS will + list all the commands containing that keyword. + More than one keyword can be specified, + seperated by C-O + I Run the INFO program. INFO contains the + complete documentation for EMACS, in + great detail. Here is where you can find out + about, for instance, special commands for editing + LISP code, handling buffers, replacing text, filling + and justifying text, etc. + + >> Go ahead and try some of these. Type C C-K. EMACS will tell + you what that character does. Try typing A WORD to find + out all the commands that have to do with words. When EMACS + prompts you with --MORE--, type a space to see more or a C-L + to get your text back. INFO is a fairly sophisticated + documentation finder and is somewhat complicated. It probably + isn't a good idea to try to use INFO just yet. Use EMACS for + a few days, gain some familiarity and confidence in giving + commands. And then try INFO out. + TV users guide to EMACS + ----------------------- + +This is meant as a tutorial to introduce the veteran TV user to EMACS, +an editor written at MIT. It has many advantages over TV in terms of +capabilities and flexibility; some of these will be detailed below. It +also has a few drawbacks, but I think you'll find that the advantages to +be gained are worth it. + +In order to get TVUSER EMACS loaded automatically when you start up EMACS +(it's loaded right now, by the way, so this will get you the same EMACS you +are running now), I have copied the file TVUSER.INIT into your +directory as EMACS.INIT. When EMACS starts up, it will read +in and execute the TECO commands in this file, which will load the TVUSER +library. The TVUSER library contains many things suggested by and for TV +users who are trying to switch over to EMACS. Many of the commands are +exactly the same in TVUSER EMACS as in TV. If in doubt (at least when reading +this file), try it. You'll learn later how to check what a character does. + +>> Go ahead and do [W] to move to the next window. + You'll be expected to do [W] when necessary to window forward... + +The notation used in this document will be pretty much a hodge-podge -- +You are certainly familiar with the [X] notation for characters typed +with the EDIT key held down, and with the ^X notation for control +characters. In EMACS, there is a distinction between control characters +(ascii codes 0-37, 177) and characters with the Control modifier bit +(exactly like the EDIT bit). This means, for instance, that the +character Control-> is possible in EMACS, althugh it has no ascii +representation. At MIT, where EMACS was written, and at SU-AI, the +keyboards have two "EDIT" keys, called Control and Meta. These were +BOTH true modifier bits, so you could meaningfully talk about Control->. +For Tenex and Tops-20 sites, the Meta key is exactly the same as the +EDIT key on Datamedias, and every effort is made to insure that ^X will +have the same effect as C-X. In EMACS, you will often see the notation +C-X to mean ^X and M-X to mean [X]. Usually a direct translation will +be sufficient, but if you hold down the control key and type ">", for +instance, you will get a Control-uparrow, because Datamedias can only +generate ASCII codes plus the EDIT bit, and C-> is not an ASCII +character. In any case, M-X may be typed by holding down the edit key +and typing "X", or by typing or and then typing "X". ^X +may be typed by either holding down the control key and typing "X" or +typing ^^ (that's control-uparrow) and then typing "X". There is even +Control-Meta-X, which you type by holding down BOTH the control and edit +keys while typing "X", or typing M-$ (that is, hold down the edit key +and type or ) and then typing "X", or by typing +twice and then typing X. In summary (if you're still with us): + +Character How to type it +--------- -------------- +C-X, ^X Hold down the control key while typing "X" + or Type C-^ (the bottom unlabeled key on DM'S) and then "X" + +M-X, [X] Hold down the "edit" key while typing "X" + or Type or and then type "X" + +C-M-X, [^X] Hold down both the EDIT and CONTROL keys while typing "X" + or Hold down the EDIT key and type X (that is [$X] OR [$]X) + or Type twice and then type "X" (That is, $$X) + + + Advantages of EMACS: a quick rundown. + ------------------------------------- + +EMACS permits handling of numerous files at once. Also permits you to +view two files at once on the same screen for comparison purposes, or to +move text between them. EMACS has commands for justifying and filling +text, and automatically breaking long lines on typein ("autofill" mode). + +EMACS has good self-documentation. You can find out what any given +command does while in EMACS, or ask for a command that does a certain +thing given a keyword. + +It is possible to put any EMACS function on any character. It is this +ability that permits the TV library described below, and you can further +change even these settings to suit your own preferences. If you know +TECO (which, unfortunately, tends to be incomprehensible to all but MIT +hackers), you can extend the command set almost arbitrarily. + +EMACS processes input and screen updating asynchronously, hence often is +much better about not writing more than it needs to; TVEDIT makes you +wait for display to be completed before obeying the next command. E.g. +if you type two window commands in quick succession in TV, it will +completely display the first before moving on to the second. In EMACS, +as soon as it has processed the second command it knows you want to see +a different window, and it will stop writing the first one and go right +on to the second. + +EMACS has commands for string substitution. + + +Disadvantages of EMACS, or things TVEDIT does better: +---------------------------------------------------- + +EMACS does not remember which file you edited last, or where you were +in the file (though you can continue after quitting out of emacs and +your file will still be there; this only applies to starting up EMACS +afresh). + +EMACS does not view pages very specially. Due to some fundamental +limitation, it can't tell you what page it is on, though it can find +pages (i.e. there is a "go to next page" command). It does not maintain +a directory like TVEDIT does, so locating an arbitrary page in the file +may take longer (I have no data on this; emacs seems as fast as TV in +most operations). However, there is a library of commands to treat +pages in a manner similar to SU-AI's E editor, called the PAGE library. + +While EMACS is smart about your typeahead, it often updates the screen +after changes less than perfectly optimally. This is usually not a +problem, but can be annoying at times. + +EMACS so far has no good commands for refreshing portions of the screen +if your display gets trashed by line noise or system messages. + + + Differences that you need to know about between TV and TVUSER EMACS + ------------------------------------------------------------------- + diff --git a/src/e142/teco.files b/src/e142/teco.files new file mode 100644 index 00000000..80b1be4b --- /dev/null +++ b/src/e142/teco.files @@ -0,0 +1,184 @@ + +This is a list of all the files composing EMACS as distributed, +what they do, where they belong on a Twenex system, +and where they are copied from on the MIT-AI machine. + +-- FOR EMACS -- + +Files on SYS: + + TECO.EXE ;Runnable bare ITS TECO + ;(optional; need not be kept around at all). + EMACS.EXE ;The runnable EMACS + XINFO.EXE ;A stand-alone INFO program + TAGS.EXE ;The runnable TAGS program + +Files on + + Those without homes on AI. + + INFO..TECO. ;TECO init file used in building stand-alone INFO + TECPUR.EXE ;The shared portions of TECO + TAGS.FAI ;The source for the Twenex TAGS program + EMACS.CHART ;EMACS "wall chart" command list + EMACS.DOC ;Complete printout of EMACS self-documentation + ;EMACS.CHART and EMACS.DOC are not the same + ;on Twenex as on ITS. They should be generated + ;afresh on Twenex (using ABSTR), not copied. + + Those with homes on AI:.TECO.; + + TECO.FILES ;This file. + TECO.nnn ;TECO source + TECO.ARCHIV ;TECO changes (documentation) + TWENEX.DIFS ;Differences between EMACS on ITS and EMACS on Twenex + TWENEX.INSTALL ;Instructions for installing EMACS on Twenex. + EMACS.CTL ;Batch file for assembling TECO and building EMACS. + + Those with homes on AI:EMACS; + + EMACS.INIT ;Default EMACS init file. Home on AI is TWENEX.INIT. + ABSTR.:EJ ;Macros for generating EMACS.CHART and EMACS.DOC + BASIC.EMACS ;Help B prints this file. + CONV ;INFO documentation on EMACS internals. + DIRED.:EJ ;Directory editor. No home on AI. + ;The home is on on the pumpkin. + DOCOND.:EJ ;Document conditionalizer and macro processor. + EINIT.:EJ ;Library of commands used for building EMACS. + EPATCH ;File of patches to be loaded in when building EMACS. + GRIND.:EJ ;Commands for grinding Lisp and Macsyma code. + INFO.:EJ ;the TECO code for INFO. + INFO.EMACS ;EMACS change announcements in chronological order. + INFO.OEMACS ;More change announcements. + IVORY.:EJ ;An alternate purifier used for WORDAB, PL1LIB, TMACS. + LUNAR.:EJ ;Some macros that might be useful. + MAZLIB.:EJ ;Commands for solving mazes. + MQREPL.:EJ ;Commands to perform several Query Replaces over several files. + PICTUR.:EJ ;Commands for editing pictures made out of characters. + PL1LIB.:EJ ;Commands for editing PL/1 + PURIFY.:EJ ;Commands for building :EJ files from sources. + TAGS.:EJ ;Commands for finding labels fast using tag tables. + TDEBUG.:EJ ;Commands for debugging new EMACS macros. + TEMACS.:EJ ;Miscelaneous commands. + TMACS.:EJ ;Miscelaneous commands. + TWENEX.:EJ ;Commands only for Twenex. + VARG.:EJ ;Makes the arrow keys and numeric keypad work on VT52's. + WORDAB.:EJ ;Implements Word Abbreviation Mode. + [PURE] ;The fundamental EMACS macro library. + + Those with homes on AI:EMACS1; + Unless otherwise noted, these are sources for the + similarly named :EJ files, or, if no :EJ file is + mentioned above, part of the source of EMACS.:EJ. + + ABSTR + BASIC-EMACS.TXT ;DOCOND source from which BASIC.EMACS is made. + ;Home on AI is EMACS1;BASIC EMACS + BUFFER + CCL ;Part of the source for PURIFY.:EJ + CRL + DIRED ;No home on AI. Home is on on pumpkin. + DOC + DOCOND + EINIT + FILES + INDENT + INFO + ISEARC + MQREPL + PICTUR + PURIFY + SEARCH + SUPPRT + TAGS + TWENEX + USRCOM + VARS + WINDOW + WRDLST + ^RBASE + + Other random sources that belong on + + TDEBUG ;Home on MC:EMACS; + GRIND ;Home on MC:EMACS; + LUNAR ;Home on MC:MOON;. Note that the Twiddle + ;macros are exact, superfluous duplicates + ;of the Exchange macros built into EMACS. + WORDAB ;Home on MC:ECC;. Must be purified with IVORY. + PL1LIB ;Home on MC:ECC;. Must be purified with IVORY. + TMACS ;Home on MC:ECC;. Must be purified with IVORY. + VARG ;Home on MC:BAK; + + Even more random: + sample init files, to give you an idea of how it's done. + + MMCM.INIT ;MMCM's EMACS.INIT file, as a sample. + ;Home is AI:MMCM;.EMACS (INIT). + RMS.INIT ;RMS's EMACS.INIT file. + ;Home is AI:RMS;.EMACS (INIT). + HENRY.INIT ;HENRY's EMACS.INIT library. + ;Home is AI:HENRY;.EMACS (INIT). + HENRY. ;Source for HENRY's library. + ;Home is AI:HENRY;.EMACS > + Also, MOON's init file is essentially LUNAR.:EJ. + + +-- The INFO hierarchy -- + Unless otherwise noted, each file documents the + program or :EJ library of the same name. + + ATSIGN ;Info on the ATSIGN program (v.i.) + DIR ;INFO Directory. Do NOT copy this from ITS! + DOCOND + EMACS + INFO + MIDAS + MIDAS.ARCHIV ;Chronological MIDAS change announcements. + PL1LIB + TAGS + TDEBUG + TECORD ;Info on TECO. Not really part of the INFO + ;hierarchy, but on for MM Tecdoc to find. + TMACS + WORDAB + + +-- FOR MIDAS -- + MIDAS is the assembler used to assemble TECO, @, and MIDAS. + + These files can live wherever it is convenient for you. + + MIDAS ;Source of MIDAS. Home on AI:MIDAS;. + TSRTNS ;More of source of MIDAS. Home on AI:MIDAS;. + XJSYS ;Convenient interface to JSYS's (no fixed ACs). + MIDAS.REL ;REL file for MIDAS. + MIDAS.EXE ;Executable MIDAS. + + These have their homes on AI:SYS;. + They should be somewhere on SYS: when + assembling TECO (or MIDAS, etc.) + + ITSDFS.MID ;Definitions of ITS system calls. + ITSBTS.MID ;Definitions of arguments to ITS system calls. + DECDFS.MID ;Similar definitions for Bottoms-10. + DECBTS.MID + TWXDFS.MID ;Similar definitions for Twenex. + TWXBTS.MID ;This is the only one needed for TECO itself + + +-- FOR @ -- + @ is a program used for making multiple-file + cross-reference listings. Use @ when you would + expect to make an assembly listing. + + These files can live wherever is convenient for you. + + ATSIGN.MID ;Source of @. Home is AI:QUUX;@ > + ATSIGN.EXE ;Runnable @ program. + + +-- FOR FUN -- + + EMACS.LETTER ;Letter to sites receiving EMACS. Home is on AI:.TECO.; + JARGON.TXT ;MIT-Stanford glossary of jargon. Home is AI:GLS;JARGON > diff --git a/src/e142/teco.init b/src/e142/teco.init new file mode 100644 index 00000000..5da8d628 --- /dev/null +++ b/src/e142/teco.init @@ -0,0 +1,69 @@ +!* -*-TECO-*- *! + +!* This is the TECO INIT for EMACS. It sets up the EMACS environment + necessary for dumping a new EMACS EJ file. *! +ft entering teco.init  + -1fs^Idisablew !* do this first for comments! + :ejDSK:EMACS;EMACS :EJu0 !* load in the EMACS library! + er ec fs i fileu1 fs if versionu2 !* save filename and version of! +1u4 !* EMACS library! + fs osteco"n !* Twenex! + :ejDSK:TWENEX.:EJw !* load in the TWENEX library! + er ec fs i fileu3 !* save filename of TWENEX library! + ' + :i*& Macro Get,q0m(q0+4)u.m !* call the loader in the EMACS library! + !* to find .M! + f[ :ej page !* save :EJ page for flushing EINIT! + :ejDSK:EMACS;EINIT :EJw !* load EINIT library! +2u4 + m(m.m& Load Essential Environment) +3u4 + q1m.vEMACS Library Filename !* save EMACS library filename! + q2m.vEMACS Versionw !* version no. too! + fs osteco"n !* Twenex! + q3m.vTWENEX Library Filenamew' !* save TWENEX library filename! +4u4 + m(m.m& Load Patches) !* Load fixes written since [PURE] was made! +5u4 + m.vMM ^R Exit to EXEC + m(m.m& Load Default Environment) +6u4 + m(m.mPurify Variables) !* smash variable names to point to pure! + !* space if there is a copy there! + f] :ej page !* flush EINIT! +7u4 +!* Now create a Startup to be called from the ..L! + fsosteco"e @:i*| !* ITS! + etDSK:EMACS !* set device name and FN2! + fs hsname fs dsnamew !* fill in directory! + fs xuname fs dfn1w !* and FN1! + 1:"l + 1:"l + erEMACS;*'' + fs d file[2 et@ > + !** end of system-dependent code! + fs msname fs dsname + qEMACS Version:\u1 !* sigh, still need this! + @y 1a-127"n ]2 :m(.,zfx*)' !* if init doesnt begin with rubout then! + !* execute it as TECO commands! + hk 1,m(m.mLoad Library)2 !* else load it as a library,! + !* saving the filename! + ]2 :m..l + |m.vMM & Startup EMACS' + "# @:i*| !* Twenex! + etDSK:EMACS.INIT fs hsname fs dsname + 1:"l erDSK:' + fs d file[2 et foo.. + !** end of system-dependent code! + fs msname fs dsname + qEMACS Version:\u1 !* sigh, still need this! + @y 1a-127"n ]2 :m(.,zfx*)' !* if init doesnt begin with rubout then! + !* execute it as TECO commands! + hk 1,m(m.mLoad Library)2 !* else load it as a library! + !* saving the filename! + ]2 :m..l + |m.vMM & Startup EMACS' +0u4 + 0u0 0u1 0u2 0u3 !* zero the q-regs we've used! + + hk diff --git a/src/e142/teco.mid b/src/e142/teco.mid new file mode 100644 index 00000000..18203934 --- /dev/null +++ b/src/e142/teco.mid @@ -0,0 +1,21685 @@ +; -*-MIDAS-*- + +;ITS TECO and EMACS should serve as a lesson to all +;of what can be achieved when programmers' creativity is not crushed +;by administrators whose main concern is stifling humor, +;stamping out all possibility of enthusiasm, and forbidding +;everything that isn't compulsory. +;They were produced in a humane anarchy where one man designs, +;implements, and then documents the feature that inspires him. +;They were produced by people who could laugh enough to +;name many years of effort the Incompatible Timesharing System. +;Of course, the whole story is imaginary. Working conditions +;which do not crush the spirit can't be practical. +;You can't run a team that way if you expect to meet the deadline. +;TECO doesn't really exist; you were only dreaming it. + +;ITS TECO was built by RMS on the work of others +;at the MIT Artificial Intelligence Lab +;(not to be confused with the Laboratory for Computer Science). +;It was converted to run on Twenex by MMCM at SRI. + +;TECO is available to those who like the way it is, +;on a basis of communal co-operation: +;you are welcome to make improvements, but only if you consult +;with the other user sites, and send your changes +;to MIT to be merged in and distributed to everyone. +;You owe your improvements to us in return for what you see here. +;If anyone asks you for a copy, make sure he gets in touch with +;the MIT AI Lab so he can get the latest stuff. + +.SYMTAB 8001. ;SHOULD BE PLENTY + +TITLE TECO + +; RESET THE SYSTEM CONDITIONALS NOT SPECIFIED BY /T AT ASSEMBLY TIME. +IFNDEF ITS, ITS==0 +IFNDEF 10X, 10X==0 +IFNDEF 20X, 20X==0 +IFG ITS+10X+20X-1, .FATAL TWO OPERATING SYSTEMS SPECIFIED + +; IF NO SYSTEM SPECIFIED THEN DEFAULT TO THE ONE WE'RE ASSEMBLING ON. +IFE ITS\10X\20X,[ +IFE .OSMIDAS-SIXBIT/ITS/, ITS==1 +IFE .OSMIDAS-SIXBIT/TENEX/, 10X==1 +IFE .OSMIDAS-SIXBIT/TWENEX/,20X==1 +] +IFE ITS\10X\20X, .FATAL NO OPERATING SYSTEM SPECIFIED + +TNX==:10X\20X ; TNX MEANS EITHER TENEX OR TWENEX + +IFN TNX,[ +IFNDEF EMCSDV,EMCSDV==0 ; CAUSES TRANSLATION OF TO EMACS: FOR TNX +IFNDEF INFODV,INFODV==0 +.DECSAV +IFN .OSMIDAS-SIXBIT/TENEX/,[ + IFN .OSMIDAS-SIXBIT/TWENEX/,[ + IF1 [ + .INSRT SYS:TNXDFS + .TNXDF + .INSRT SYS:TWXBTS + ]]] +] + +GLITCH==177 +ALTMOD==33 +IFN ITS,EOFCHR==3 ;PADDING CHARACTER FOR FILES. +IFN TNX,EOFCHR==0 + +IRPS AC,,FF A B C D E J BP T TT TT1 IN OUT CH Q P +AC=.IRPCNT +TERMIN + +A0==TT ;ACS FOR .I PSEUDO. +A1==TT1 + +.XCREF FF,P,A,B,C,IN,OUT,CH,T + +IFN 0,[ ;I HOPE THAT EVERYTHING THAT DEPENDS ON ORDER OF ACS +MUL: MULI: DIV: DIVI: IDIV: IDIVI: ;WILL X-REF TO ONE OF THESE. +ROTC: ASHC: LSHC: CIRC: +BLT: JFFO: +.OPEN: .RDATIM: +] + +IFN ITS,[ +CHTTYI==1 +CHFILI==3 +CHFILO==4 +CHRAND==6 ;FOR READING FILE DIRECTORIES +CHDPYO==7 ;BLOCK MODE DISPLAY OUTPUT FOR ASSEMBLED-IN ^P-CODE STRINGS. +CHERRI==11 +CHECHO==12 ;ECHO-MODE OUTPUT FOR RUBOUT. +CHECDS==13 ;FOR FS ECHO DISPLAY$ ONLY. +CHSIO==14 ;SUPER IMAGE OUTPUT. +CHTTYO==15 ;NORMAL TYPEOUT. + +TYPIN==1_ +TSMSK==%PJATY\%PJWRO\%PJRLT,,%PIPDL+%PIMPV +TSMSK1==TYPIN + +OPNLBP==220600 ;B.P. TO OPEN LOSS CODE IN CHANNEL STATUS. +];IFN ITS + +SUBTTL FLAGS IN FF + +;RIGHT HALF FLAGS + +FR==525252 ;BIT TYPEOUT PREFIX. +FRARG==1 ;THIS COMMAND HAS A POSTCOMMA ARG +FRARG2==2 ;THIS COMMAND HAS A PRECOMMA ARG +FRCLN==4 ;THIS COMMAND WAS GIVEN THE COLON MODIFIER +FRUPRW==10 ;THIS COMMAND WAS GIVEN THE ATSIGN OR UPARROW MODIFIER. +FRALT==20 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FROP==40 ;SET WHEN ARITH OP NEEDS A RIGHT ARG. +FRSYL==200 ;A SYLLABLE IS AVAIL TO USE AS RIGHT OPERAND OF ARITH OP. +FRFIND==2000 ;FA AND FILENAME READER USE THIS. +FRQMRK==4000 ;LAST COMMAND STRING HAD ERROR; "?" IN COMMAND READER PRINTS LAST FEW CHARS. +FRNOT==10000 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FRTRACE==20000 ;TRACE IN PROGRESS: PRINT TECO COMMANDS AS EXECUTED. +FRBACK==40000 ;SEARCH IN REVERSE (ARGUMENT NEGATIVE) +FRQPRN==100000 ;IN ('S SAVED FLAGS, 1 => THIS ( WAS A Q-REG NAME, SO + ;CLOSE SHOULD RETURN TO QREGXR. +FRSPAC==200000 ;IN FA, PREVIOUS CHAR WAS A SPACE. + +;LEFT HALF FLAGS + +FL==1,,525252 ;BIT TYPEOUT PREFIX +FLNEG==1 ;DPT-ING A NEGATIVE NUMBER +FLDIRDPY==2 ;SET => LAST COMMAND WAS FILE COMMAND, SO DISPLAY DIR INSTEAD OF BUFFER +FLIN==200 ;INPUT FILE OPEN. +FLOUT==400 ;OUTPUT FILE OPEN +FLNOIN==400000 ;INSIDE ^R, 1 => THIS IS A ^ V, AND SHOULD READ NO INPUT. + + +SUBTTL OPCODES AND BITS + +TYPR4=37000,, +NUUOS==1 + +CALL=PUSHJ P, +SAVE=PUSH P, +REST=POP P, +RET=POPJ P, +IFN TNX,.VALUE=HALTF + +IF1 EXPUNGE EDIT ;STUPID WORTHLESS EXTENDED INSTRUCTION GETS IN THE WAY. +EXPUNGE DMOVE,DMOVEM ;TWENEX PEOPLE ARE TEMPTED TO USE THESE AND SCREW TENEX. + +.XCREF CALL,REST,SAVE,RET + +BP7==440700 + +;BITS IN 12-BIT AND 9-BIT CHARACTERS +CONTRL==200 +META==400 +SHIFT==1000 +SHIFTL==2000 +TOP==4000 + +SUBTTL DOUBLE-DOT Q-REGS + +IFNDEF NQSETS,NQSETS==3 +NQREG==<"Z-"A+1+"9-"0+1>*NQSETS +.QCRSR==10. ;..A HOLDS CURSOR. +.QBFDS==.QCRSR+1 ;..B HOLDS MACRO EXECUTED AT END OF CMD STRING IF BUFFER DISPLAY WANTED (FLDIRDPY IS OFF) +.QCPRT==.QBFDS+1 ;..C IS UNUSED +.QDLIM==.QCPRT+1 ;..D HOLDS DISPATCH FOR FW, "B, "C, ^B IN SEARCHES. +.QBASE==.QDLIM+1 ;..E HOLDS OUTPUT RADIX FOR = AND \. (INITIALY 10.) +.QCRMC==.QBASE+1 ;..F HOLDS ^R MODE SECRETARY MACRO. +.QFDDS==.QCRMC+1 ;..G HOLDS MACRO EXECUTED AFTER COMMAND STRING TO DISPLAY FILE DIRECTORY. +.QVWFL==.QFDDS+1 ;..H IS NONZERO IF THERE HAS BEEN TYPEOUT BY PRGM (SUPPRESS BUFFER DISPLAY) +.QPT1==.QVWFL+1 ;..I HOLDS WHAT . HAD AT START OF CMD STRING. +.QMODE==.QPT1+1 ;..J HOLDS "MODE" STRING, DISPLAYED ON THE --MORE-- LINE. +.QRRBF==.QMODE+1 ;..K HAS WHAT WAS KILLED IN ^R MODE. +.QRSTR==.QRRBF+1 ;..L HOLDS MACRO EXECUTED WHEN TECO IS $G'D. +.QLOCL==.QRSTR+1 ;..M IS UNUSED +.QUNWN==.QLOCL+1 ;..N HOLDS STRING MACROED BEFORE QREG UNWOUND. +.QBUFR==.QUNWN+1 ;..O HOLDS CURRENT BUFFER. +.QERRH==.QBUFR+1 ;..P HOLDS ERROR-HANDLER MACRO. +.QSYMT==.QERRH+1 ;..Q HOLDS SYMBOL TABLE SCANNED FOR Q CONTRUCT. +.Q..Z==10.+"Z-"A ;..Z HOLDS SAME AS ..O, INITIALLY. + +.QKS==0 ;..0, ..1, ..2 USED BY ^P SORT. +.QKE==1 +.QDL==2 +.Q..0==0 ;OTHER NAMES FOR ..0, ..1, ..2 +.Q..1==.Q..0+1 +.Q..2==.Q..1+1 +.Q..3==.Q..2+1 + +IF2 [ +$QCRSR==QTAB+36.*2+.QCRSR +$QCRMC==QTAB+36.*2+.QCRMC +$QMODE==QTAB+36.*2+.QMODE +$QUNWN==QTAB+36.*2+.QUNWN +$QBUFR==QTAB+36.*2+.QBUFR +$Q..0==QTAB+36.*2+.Q..0 +$QMODE==QTAB+36.*2+.QMODE +$QERRH==QTAB+36.*2+.QERRH +] + +IFNDEF LIOPDL,LIOPDL==8 ;IO PDL SIZE (MUST BE < ITS'S) +IFNDEF FDRBFL,FDRBFL==40 ;SIZE OF FILE DIR READING BUFFER. +IFNDEF LPDL,LPDL==200 ;SIZE OF REGULAR PDL. +IFNDEF MFNUM,MFNUM==25. ;[ ;INITIAL # OF FRAMES FOR MACRO OR ^] CALLS, OR ITERATIONS. +IFNDEF MFMAX,MFMAX==105. ;MAXIMUM NUMBER OF FRAMES. +IFNDEF MFINCR,MFINCR==20. ;NUMBER OF NEW FRAMES TO ALLOCATE AT ONCE. +IFNDEF GCTBL,GCTBL==100 +IFNDEF SLPQWR,SLPQWR==20000 ;# WDS TO EXPAND IMPURE STRING SPACE BY. +IFNDEF SLPWRD,SLPWRD==400 ;# WDS TO EXPAND BUFFER GAP BY. +IFNDEF GCOFTN,GCOFTN==5*2000*10. ;# CHARS OF IMPURE STRINGS WRITTEN TO CAUSE A GC. +IFNDEF LPF,LPF==400 ;QREG PDL # WDS (2 WDS/ENTRY) +IFNDEF STBLSZ,STBLSZ==300 ;SEARCH TABLE SIZE. +IFNDEF CBUFSZ,CBUFSZ==10. ;INITIAL # WDS IN CMD BUFFER. +IFNDEF MACPSZ,MACPSZ==<2*MFMAX+8>/9 ;# WDS IN MACRO PDL (4-BIT BYTES) +IFNDEF FSPSPL,FSPSPL==20 ;LENGTH OF RING BUFFER OF POINT. +IFNDEF UTBSZ,UTBSZ==40 ;LENGTH OF I-O BUFFERS. +IFNDEF LHIMAX,LHIMAX==400 ;NUMBER OF 1ST PAGE NOT AVAIL FOR :EJ +IFNDEF TYIBSZ,TYIBSZ==20. ;RECORD LAST 60 CHARACTERS TYPED. + +SPD==60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALFWORD) + +SUBTTL MACROS + +DEFINE DBP7 A + ADD A,[70000,,] + SKIPGE A + SUB A,[430000,,1] +TERMIN + +DEFINE INSIRP A,B + IRPS ZZZ,,[B] + A,ZZZ +TERMIN TERMIN + +DEFINE CONC CONC1,CONC2 +CONC1!CONC2!TERMIN + +;ERROR MACRO: TYPRE [ERRCODE] +DEFINE TYPRE A + TYPR4 ER$!A +TERMIN + +IF2 ISKER1==TYPRE [ISK] ;"INVALID SORT KEY" ERROR, IF WITHIN A ^P COMMAND. +DEFINE ISKERR + SKIPE PSSAVP + TYPRE [ISK] +TERMIN + +;GIVEN MACPTR OR CTXPTR, SKIP IF THAT STACK IS NOT EMPTY. +DEFINE SKNTOP X + SKIPN A,X +TERMIN + +;SAY HOW ASSEMBLY IS PROGRESSING, AND HOW MUCH CORE IT TAKES SO FAR. +DEFINE INFORM A,B +IF1,[PRINTX \A = B +\]TERMIN + +;SUPPY AN ARITH OP WITHOUT A RIGHT ARG WITH 1 AS AN ARG. +;OPTIONALLY (IF FOO IS Z, O OR N) DEFAULT NO ARG TO AN ARG OF 1, +;PERHAPS SETTING OR CLEARING THE ARGUMENT FLAG (IF FOO IS O OR Z) +DEFINE ARGDFL FOO ;FOO SHOULD BE "O", "Z", "N" OR NULL. +IFNB FOO,TR!FOO!E FF,FRARG + TRZE FF,FROP + CALL ARGDF0 +TERMIN + +SUBTTL SYSTEM-DEPENDENT MACROS TO REDUCE CONDITIONALS ELSEWHERE + +IFN ITS,[ +DEFINE TSOPEN A,B + .OPEN A,B + .LOSE %LSFIL + TERMIN + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN + +DEFINE UTFARG +DEFDEV ? DEFFN1 ? DEFFN2 ? DEFDIR TERMIN + +DEFINE 4WDARG (START) +START ? START+1 ? START+2 ? START+3 TERMIN + +;MAKE NEXT TTY INPUT NOT WAIT FOR AN ACTIVATION CHARACATER. +DEFINE TTYACT + CALL TTYAC1 +TERMIN + +;WAIT FOR OUTPUT TO FINISH; RETURN # CHARS OF AVAILABLE INPUT IN AC "X". +DEFINE LISTEN X + .LISTEN X, +TERMIN + +DEFINE CIS + .SUSET [.SPICL,,[-1]] +TERMIN + +DEFINE CLOSEF X + .CLOSE X, +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT. + MOVE Q,[-<<.LENGTH /STRING/+4>/5>,,[ASCIC /STRING/]] +TERMIN +] + +IFN TNX,[ +DEFINE TTYACT +TERMIN + +DEFINE STRCNC STR1,STR2 +ASCIZ \STR1!STR2\ +TERMIN + +DEFINE LISTEN X +IFN X-1,SAVE 1 +IFN X-2,SAVE 2 + MOVEI 1,.CTTRM + SKIPE DWAIT + DOBE + SIBE + SKIPA X,2 + SETZ X, +IFN X-2,REST 2 +IFN X-1,REST 1 +TERMIN + +DEFINE CLOSEF X + MOVE 1,X + CLOSF + JFCL + SETZM X +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT + HRROI Q,[ASCIZ /STRING/] +TERMIN + +IFNDEF .FNAM3,.FNAM3==.FVERS +] + +SUBTTL DISPLAY VARIABLES + +LOC 41 + JSR UUOH +IFN ITS,JSR TSINT +IFN ITS,LOC 100 +IFN TNX,LOC 140 ;DONT GET SMASHED BY LINK VARIABLES + +RGETTY: 0 ;TCTYP VARIABLE OF TTY. +TTYOPT: 0 ;TTYOPT VARIABLE OF TERMINAL. +TTYSMT: 0 ;TTYSMT VARIABLE OF TERMINAL. +OSPEED: 0 ;OUTPUT LINE SPEED IN BAUD, OR 0 IF UNKNOWN. +NVLNS: 0 ;# VERTICAL LINES ON CONSOLE +NHLNS: 0 ;# HORIZONTAL POSITIONS ON CONSOLE +USZ: 0 ;# VERTICAL LINES USABLE FOR DISPLAY. MUST FOLLOW NHLNS. +IFN USZ-NHLNS-1,.ERR +NELNS: 0 ;# ECHO LINES (NVLNS-USZ). USUALLY 3, SET BY FS ECHO $ +MXNVLS==100. +MXNHLS==160. +TOPLIN: 0 ;# OF 1ST LINE OF SCREEN TO USE FOR BUFFER DISPLAY. +NLINES: 0 ;# LINES OF BUFFER TO DISPLAY, 0 => DEFAULT + ; (2 ON TTYS, AS MANY AS WILL FIT ON DISPLAYS) +VSIZE: 0 ;# OF LINES FOR VBD TO USE (SAME AS NLINES, OR THE DEFAULT # OF LINES). +BOTLIN: 0 ;# OF 1ST LINE BELOW WINDOW. +RRTOPM: 0 ;BOTTOM OF "TOP MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %TOP) +RRBOTM: 0 ;TOP OF "BOTTOM MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %BOTTOM) +DISTRN: 0 ;-1 => TRUNCATE LINES, ELSE CONTINUE THEM. +DISPCR: 0 ;-1 => STRAY CR REALLY DOES A CR. + ;IF NOT OUTPUT AS CR, IT IS OUTPUT AS UPARROW-M. + ;ALSO SIMILARLY CONTROLS WHETHER STRAY LF'S ARE OUTPUT AS LF OR ^-J. +DISPBS: 0 ;-1 => ^H OUTPUT AS BS. OTHERWISE IT IS OUTPUT AS UPARROW-H. +DISSAI: 0 ;ASSUME CTL CHARS ARE 1-POSITION GRAPHICS INSTEAD OF PRINTING AS ^-MUMBLE. +LID: 0 ;NONZERO => TRY TO USE INSERT/DELETE LINE TO MOVE TEXT AROUND. +CID: 0 ;NONZERO => USE CHAR I/D FOR SIMPLE ^R INSERT/DELETE COMMANDS +IFN ITS,[ + .BYTE 8 ;STRINGS TO OUTPUT IN SUPERIMAGE OUTPUT MODE: +EXPUNG DISCPV DISC1V DISCPH MORMCV +DISCMV=,. ;SET CURSOR AND CLEAR LINE. + %TDMV0 ? DISCPV: 0 ? 0 ? %TDEOL +DISCM1=,. ;SET CURSOR, DON'T CLEAR LINE. + %TDNOP ? %TDMV0 ? DISC1V: 0 ? DISCPH: 0 + .BYTE 7 +MORMCL=,. + ^P ? "V ? MORMCV: 0 ? ^M ? ^P ? "L ? ^C ? ^C ? ^C ? ^C + .BYTE +IFN 700000&(DISCPH),[ ;IF MIDAS DEFINED ALL THE TAGS 1 BYTE TO SMALL, FIX THEM UP. +IRPS XX,,DISCPV DISCPH DISC1V MORMCV +.AOP IBP,1,XX +EXPUNGE XX +XX=IFN .AVAL1-1,[.AVAL1] .ELSE [.AVAL2] ; KLUDGE FOR KL'S +TERMIN +]] ;IFN ITS +DISVP: -1 ;VERT POS. OF LAST LINE GIVEN TO DISLIN, REGARDLESS OF + ;WHETHER THE LINE ACTUALLY HAD TO BE IOTTED. + ;(-1 ==> JUST WENT TO TOP OF SCREEN) + ;IF DISLIN SEES IT IS HACKING SAME LINE AS PREVIOUS + ;CALL TO DISLIN, IT DOESN'T CLEAR THE LINE. +DISVP1: 0 ;VERT. POS. OF MAIN PRGM AREA TTY CURSOR. + ;TO MOVE TO LINE , DO AN LF INSTEAD OF + ;THE USUAL ^PV. +DISFLF: 0 ;-1 ==> FORCE DISLIN TO SET CURSOR POS. + +CHCTBP: 0 ;BP. FOR CHCT TO STUFF CHARS. +CHCTVS: 0 ;LAST +1 LINE FOR CHCT TO USE (= BOTLIN EXCEPT DURING TYPEOUT ON PRINTING TTY) +CHCTHP: 0 ;POSITION IN TYPED LINE (FOR CONTINUATION AND TABS) +CHCTCF: 0 ;-1 ==> LAST CHAR GIVEN TO CHCT WAS ^M. +CHCIGN: 0 ;-1 => OUTPUTTING TRUNCATED PORTION OF LINE. +CHCTAD: 0 ;CHCT PUSHJ'S @. WITH EACH LINE. +CHCTVP: 0 ;VERT. POS. OF THAT LINE. +CHCTHC: 0 ;HASH CODE OF THAT LINE. +CHCTBL: 0 ;WHEN @CHCTAD CALLED, THIS HOLDS CHAR ADDR 1ST CHAR + ;IN THE LINE BEING DISPLAYED. (ASSUMING THAT + ;DISAD WAS CALLED WITH IN HOLDING ADDR + ;OF THE CHAR AFTER THE ONE BEING OUTPUT.) +CHCTNL: 0 ;WHEN @CHCTAD CALLED, THIS WD >0 => CHAR ADDR + ;1ST CHAR TO APPEAR ON NEXT SCREEN LINE (IF ANY) + ;-1 => NEXT CALL TO @CHCTAD WILL BE ON SAME SCREEN LINE. +CHCRHP: 0 ;WHEN @CHCTAD CALLED, THIS IS HPOS AT WHICH TTY CURSOR WILL BE LEFT (FOR SCPOS) +CHCOVP: 0 ;WHEN @CHCTAD CALLED, INDICATES A STRAY ^M OR ^H WAS JUST IOTTED. +ORESET: 0 ;OUTPUT STOPPED BY QUIT NOW IN PROGRESS +MORFLF: 0 ;USER HAS FLUSHED TYPEOUT (1 => WITH RUBOUT, -1 => WITH OTHER CHAR) +OLDFLF: 0 ;GETS VALUE OF MORFLF WHEN TYPEOUT IS UN-FLUSHED AGAIN (RETURN TO ^R, ETC). +MORESW: 0 ;0 => NO --MORE-- OR ANYTHING. 1 => --BOT--. 2 => --TOP--. 3 => --MIDDLE--. +MS%UP==1 ;VALUES 0, 1, 2 AND 3 ARE MADE OF THESE 2 BITS. +MS%DWN==2 ;MS%UP MEAN'S THERE'S TEXT ABOVE THE SCREEN; MS%DWN, THAT THERE'S TEXT BELOW. + ;IF IT'S 3 THEN THE LH IS THE PERCENTAGE OF THE FILE ABOVE SCREEN. +MS%MOR==4 ;4 MEANS THAT --MORE-- IS BEING DISPLAYED. +MS%FLS==5 ;5 MEANS THAT --MORE--FLUSHED IS BEING DISPLAYED. +DISOMD: -1 ;WHAT $QMODE HAD WHEN LAST DISPLAYED. + ;IF $QMODE NE DISOMD, MUST REDISPLAY THE MODE. +MODCHG: 0 ;POSITIVE => ..J NEEDS TO BE RECOMPUTED, SO RUN MODMAC. + ;NEGATIVE => IT IS -2* A FS QP PTR$. IF POP PAST THERE, MUST RUN MODMAC. +MODMAC: 0 ;NON-0 => IT IS MACRO TO RECOMPUTE ..J WHEN IT IS ABOUT TO BE DISPLAYED. +TYOFLG: -1 ;>= 0 ==> TYPEOUT INITTED. +ECHACT: 0 ;-1 => SOMETHING WAS PRINTED IN THE ECHO AREA, SO ^R SHOULD CLEAR IT. FS ECHO ACTIVE$ +ECHFLS: 0 ;NONZERO TO ENABLE THE ECHACT FEATURE. FS ECHO FLUSH$. +ECHCHR: 0 ;-1 => LAST COMMAND HAS TYPED OUT, SO ^R SHOULDN'T ECHO IT. + ;OTHERWISE, IT IS CHARACTER OR STRING TO ECHO. + ;(PRINTING TERMINALS ONLY). +RUBENC: 0 ;NONZERO => IS CHAR OR STRING TO TYPE BEFORE TYPING ANYTHING ELSE + ;(EG, \, AFTER A RUBOUT IN ^R IN SCANNING MODE). FS XPROMPT$. +BSNOLF: 0 ;-1 => BACKWARD MOTION AND RUBBING OUT SHOULDN'T DO LF'S (PRINTING TTY ONLY). +DISADP: 0 ;WHEN DISAD IS CALLED, THIS SHOULD HOLD C(PT)+1. + ;USED BY DISAD TO DECIDE WHEN TO OUTPUT CURSOR. + +IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER. + +IFN TNX,[ +EOLFLG: 0 ;KLUGE FLAG FOR TERMINALS WITH NO CLEOL +SGTTYP: 0 ;PLACE TO SAVE GTTYP TERMINAL INDEX +VT1BUF:: ;USED ALSO BY VT100 FOR SCROLLING COMMANDS +HPBUF: BLOCK 4 ;BUFFER FOR HP CURSOR MOTION COMMANDS +DISBF1: BLOCK 6 ;HOLDS STUFF TO SET CURSOR POS FOR THE LINE IN DISBUF. +] +IFN ITS,[ ;DISBF1 AND DISBUF IOTTED AT ONCE. +DISBF1: BLOCK 2 ;IF NO CURSOR MOTION NEEDED, THIS HOLDS %TDNOP (0 ON TENEX). +] +DISBUF: BLOCK DISBFL ;BUFFER FOR TEXT TO BE IOTTED TO TTY. +DISBFC: 0 ;# CHARS SPACE LEFT IN DISBUF. + +DISPRR: 0 ;NON0 => PDL LEVEL AT RRDISP. + ;CAUSES CRSR POS AT PT TO BY REMEMBERED, ETC. +GEA: 0 ;-1, OR OLD ADDR (REL TO BEG) OF 1ST CHAR OF BUFFER DISPLAYED. +%TOP: 10. ;PERCENT OF SCREEN CURSOR SHOULDN'T ENTER AT TOP. +%BOTTO: 10. ;SIMILAR, FOR BOTTOM. +%CENTE: 40. ;PERCENT FROM TOP CURSOR SHOULD GO WHEN WINDOW CHANGES. +%END: 30. ;WHEN WINDOW MOVED, CURSOR MUST BE >= THIS MUCH FROM BOTTOM. +CLRMOD: -1 ;-1 => CLEAR SCREEN IN DISTOP IF TTY + ;HAD BEEN TAKEN AWAY AND RETURNED BY TECO'S SUPERIOR. + ;0 => DON'T DO THAT. + ;1 => DISABLE ALL SCREEN-CLEARING, EWVEN BY ^L AND F+ +PJATY: -1 ;-1 => WE JUST GOT A %PJATY INT, SO SHOULD REDISPLAY WHOLE SCREEN SOON. +REFRSH: 0 ;NONZERO => MACRO IT WHEN WANT TO CLEAR SCREEN DUE TO PJATY + ;(INSTEAD OF MACROING FS ^R DISPLAY$). +VREMEM: 0 ;NON0 WHEN DISPLAYING STUFF THAT'S IN BUFFER. +RRINHI: 0 ;NON-0 INHIBITS ALL DISPLAY UPDATING (FS ^R INHIBIT$) +TTMODE: 0 ;NON-0 => DISPLAY BUFFER AFTER CMD STRINGS EVEN IF PRINTING TTY. +HCDS: BLOCK MXNVLS ;HASH CODES OF LINES ON SCREEN +HCDSE: 0 + +LINBEG: BLOCK MXNVLS ;1 WD / LINE ON SCREEN, SET BY VBD AS FOLLOWS: + ;BITS 3.9 - 1.1 -- CHAR ADDR OF 1ST CHAR ON THE LINE + ;BITS 4.9 - 4.1 -- HPOS THAT CHARACTER STARTED IN. +DWAIT: 0 ;WAIT FOR OUTPUT TO FINISH BETWEEN LINES, TO AVOID BUFFERING UP LOTS OF STUFF. +DFORCE: 0 ;FORCE DISPLAY TO FINISH DESPITE PENDING INPUT. DON'T UPDATE MODELINE. +SHOMOD: 0 ;ON PRINTING TTY, FR TYPES OUT ..J IF THIS IS NONZERO. + +SUBTTL ITS FILE AND INTERRUPT VARIABLES + +IFN ITS,[ +TIME: 0 ;TIME IN SIXBIT +DATE: 0 ;DATE IN SIXBIT +PDTIME: 0 ;# SECONDS SINCE BEGINNING OF YEAR +LPDTIM: 0 ;LOCALIZED " +YEAR: 0 ;YEAR AND FLAGS +CDATE: SIXBIT/ 00,19/ +CTIME: SIXBIT / : : / +0 + +INTJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU WERE INTERRUPTED FROM +UUOJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU UUO'D FROM, IF IT WAS ILLEGAL MUUO. + +TSINT: 0 + 0 + .SUSET [.RJPC,,INTJPC] + JRST TSINTP + +INTACS: BLOCK 20 + +TTYST1: 322020,,202020 ;ACTIVATE ON ^C (AND OTHER RANDOM CTL CHARS) + ;OUTPUT CTL CHARS IN IMAGE MODE. +TTYST2: 332033,,300220 ;ACT. ON ^G (^S), RUB, ALT; INT. ON ^G (^S) ,ALTMODE; OUTPUT CR IN IMAGE. +TTYSTS: 0 ;3RD ARG FOR TTYSET. +DEFDEV: 0 ;DEFAULT FILENAMES. DEFAULT DEVICE INITTED TO MACHINE NAME. +DEFFN1: SIXBIT /@/ +DEFFN2: SIXBIT />/ +DEFFN3==DEFFN2 ;GENERATION NUMBER IS THE SAME AS SECOND FILENAME +DEFDIR: 0 ;CURRENT SNAME. +ERDEV: 0 ;LIKE EIDEV BUT FOR DEV BEING READ. +RUTF1: 0 ;REAL FILE NAMES +RUTF2: 0 ;ON READ +ERSNM: 0 ;AND SNAME BEING READ. +ROUDEV: 0 ;REAL FILE NAMES OF LAST OUTPUT FILE EXPLICITLY CLOSED. DEVICE NAME. +ROUFN1: 0 ;FN1 OF IT. +ROUFN2: 0 ;FN2 OF IT. +ROUSNM: 0 ;SNAME OF IT. + +MACHIN: 0 ;SIXBIT NAME OF MACHINE. + +FDRBUF: BLOCK FDRBFL ;BUFFER FOR READING FROM CHRAND. +FDRBFE: _29. +FDRP: 0 ;BYTE POINTER TO FDRBUF + +CHPOPX: TRNE\TRNN T,1 ;SEE IF THIS PUSHED IOCHNL IS THE RIGHT DIRECTION +GCHN2: CAIN E,. ;DON'T USE CHNL AS TEMP + ;IF ITS THE ONE WE WANT TO POP INTO. + +IOP: -LIOPDL,,IOPDL-1 ;POINTER TO LOCAL IO PDL +IOPDL: BLOCK LIOPDL ;LOCAL IO PDL +];IFN ITS + +SUBTTL TWENEX FILE AND INTERRUPT VARIABLES + +IFN TNX,[ + NFKS==10 ;NUMBER OF SUBFORKS THERE CAN BE AT ONE TIME (NOT COUNTING EXECFK). +EXECFK: -1 ;FORK HANDLE FOR EXEC (FZ$ := PUSH) +RUNFRK: 0 ;FORK HANDLE OF CURRENTLY RUNNING PROCESS (WITHIN FZ). +FRKTAB: BLOCK NFKS ;TABLE OF FORK HANDLES, INDEXED BY FZ ARGUMENT NUMBER +INTACS: BLOCK 20 ;SAVE ACS ON INTERRUPTS +INTPC: 0 ;INTERRUPT SAVED PCS FOR THE THREE LEVELS. +INTPC1: 0 +INTPC2: 0 +BOOTP: 0 ;P SAVED HERE TO BE DUMPED IN EJ FILES (SINCE SSAVE DOESN'T SAVE ACS). +DISCPH: 0 ;STARTING HPOS FOR THIS LINE +FCITYI: 0 ;HIGH ORDER BITS ARENT PARITY (CROCK NEEDED FOR DM1520) +IFN 20X,[ +PAGMOD: 0 ;NON-ZERO => LEAVE TERMINAL IN PAGE MODE (FOR ^S/^Q) +] +ITTYMD: BLOCK 3 ;PLACE TO SAVE INITIAL TTY MODES TO RESTORE BEFORE CALLING SUBFORK. +ECHOP: -1 ;ARE WE IN ECHO AREA? +ECHOF2: 0 ;MUST TECO EXPLICITLY ECHO INPUT? +ECHOL0: 0 ;VPOS OF FIRST LINE OF ECHO AREA +ECHOPS: 0 ;CURRENT POSITION IN ECHO AREA +ECODPF: 0 ;FS ECHO DISPLAY: WAS ^P LAST CHARACTER SEEN? +ECODPS: 0 ;SAVED POSITION FOR ^PS IN ECHO AREA +SAVMOD: 0 ;SFMOD TO BE RESTORED ON ^G INTERRUPT (FOR :ET), ELSE 0 +TTLPOS: 0 ;REAL SCREEN POSITION (INTERNAL RFPOS/SFPOS EQUIVALENT) +OPNJFN: 0 ;JFN BEFORE OPENF +CHFILI: 0 ;INPUT FILE JFN +CHFILO: 0 ;OUTPUT FILE JFN +DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE + 0 +DEFDIR: BLOCK 20 ;DIRECTORY NUMBER +DEFFN1: ASCII /FILE/ ;DEFAULT TO SOMETHING RANDOM + BLOCK 17 ;NAME +DEFFN2: BLOCK 20 ;EXTENSION +DEFFN3: 0 ;GENERATION NUMBER +ERDEV: BLOCK 63 ;SAME FORMAT - LAST READ FILE'S NAME +ROUDEV: BLOCK 63 ;DITTO - REAL OUTPUT FILENAMES +ETMODE: 37 ;BITMASK OF FIELDS TO DEFAULT FOR :ET COMMAND +CCLJFN: 0 ;JFN IN 1 IF STARTED AT NORMAL ENTRY+2 +INIOP: -LIOPDL,,INIPDL-1 ;INPUT I/O PDL POINTER +INIPDL: BLOCK LIOPDL ;INPUT I/O PDL +OUTIOP: -LIOPDL,,OUIPDL-1 ;OUTPUT I/O PDL POINTER +OUIPDL: BLOCK LIOPDL ;OUTPUT I/O PDL +MORMCL: BLOCK 4 ;CLEAR MORE LINE +SAV123: 0 ;JSR HERE TO SAVE AC'S 1 2 AND 3 ON THE STACK + SAVE A + SAVE B + SAVE C + JRST @SAV123 + +%TOERS==40000 ;CAN SELECTIVELY ERASE +%TOHDX==20000 ;HALF DUPLEX (BOUND TO LOSE SOMEWHERE) +%TOMVB==10000 ;CAN BS +%TOSAI==4000 ;SAIL CHAR SET +%TOSA1==2000 ;USE SAIL CHAR SET +%TOOVR==1000 ;CAN OVERWRITE +%TOMVU==400 ;CAN MOVE THE CURSOR UP +%TOMOR==200 ;MORE PROCESSING +%TOROL==100 ;ROLL +%TOLWR==20 ;HAS LOWERCASE KEYBOARD +%TOFCI==10 ;HAS 12 BIT INPUT CAPABILITY +%TOLID==2 ;HAS LINE I/D +%TOCID==1 ;HAS CHAR I/D +] +;[ + +SUBTTL RCH, CHARACTER SYNTAX TABLES, ^] + +UUOQ: 0 +UUOH: 0 + MOVEM Q,UUOQ + LDB Q,[331100,,40] + CAIN Q,TYPR4_-33 + JRST ETYP2A +IFN ITS,.SUSET [.RJPC,,UUOJPC] + MOVE Q,UUOQ + .VALUE + TYPRE [DSI] + +SKRCH: SKIPG COMCNT + TYPRE [UEC] +RCH: SOSGE COMCNT + JRST RCH2 ;NOTE RCH2 LOOKS AT OUR RETURN ADDRESS. + ILDB CH,CPTR + XCT RCHDTB(CH) ;DO SPECIAL STUFF OR JFCL.. +TRACS: POPJ P,TYOS ;OR JRST TYOS IN TRACE MODE. + SKIPN MACPTR ;RCHDTB ENTRY SKIPS IF SHOULD CHANGE CHAR'S CASE. + XORI CH,40 ;BUT NEVER CHANGE CASE OF CHARS IN MACROS. + JRST TRACS + +;[[[[ +RCHDTB: REPEAT 33,JFCL +RCHALT: JFCL ENDARG ;OR JRST IF SHOULD END A ^]^X + REPEAT ^]-34,JFCL +RCHBRC: JRST CTLBRC ;^] + REPEAT "?-^],JFCL + SKIPL RCHSFF ;@ + REPEAT 26.,SKIPL CASE ;UPPER CASE LETTERS + REPEAT 5,SKIPL RCHSFF ;[\]^_ + JFCL ;` + REPEAT 26.,SKIPG CASE ;LOWER CASE LETTERS. + REPEAT 5,JFCL ;{|}~ +IFN .-200-RCHDTB, .ERR RCHDTB WRONG SIZE. + +SQUOTP: 0 ;;SIGN => READING SUPER-QUOTED MACRO. + ;4.8 => READING DELIMITER-PROTECTED MACRO. +DLMF2: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT 4.8 OF SQUOTP SHOULD BE SET +SQUOF2: 0 ; " " " " " " SIGN OF SQUOTP " " " +BRC1CF: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT ONLY ONE CHARACTER SHOULD BE GOBBLED +BRCUAV: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THE Q-REGISTER + ;SHOULD BE USED AS A NUMERIC VALUE (IE. ASCII VALUE) + +BRC1: 0 ;[ ZERO => HANDLE ^] NORMALLY + ;[[[[[; -1 => DO-NOT EXPAND MACROS, BUT HANDLE ^]^],^]$,^]^V,AND ^]^Q NORMALLY +BRCFLG: 0 ;[ ;SET TO -1 BY ^]'S THAT INSERT UNPREDICTABLE STUFF. + ;[ ;SET IT TO 0 AND TEST IT LATER TO SEE IF ANY ^]'S HAVE HAPPENED. + ;[ ;ALSO, ^]^V LEAVES THE CHARACTER HERE ON RETURN, AS IT WAS + ;BEFORE BEING TRUNCATED TO 7 BITS. + +CASE: 0 ;DESIRED INPUT CASE. + ;0 => LEAVE CASE OF CHARS ALONE, + ;<0 => WANT CHARS IN LOWER CASE, + ;>0 => WANT CHARS IN UPPER CASE. + ;NEGATED BY CASE-SHIFT AND CASE-LOCK CHARS. +CASNRM: 0 ;NORMAL CASE - REINIT. CASE AT START OF CMD STRING. + ;THIS IS WHAT FSCASE SETS. +CASDIS: 0 ;NONZERO => PUT CASESHIFTS IN OUTPUT. +CASSFT: -1 ;CASE-SHIFT CHAR, OR -1 IF NONE. +CASLOK: -1 ;CASE-LOCK CHAR, OR -1 IF NONE. +RCHSFD: 0 ;SAVED NORMAL CONTENTS OF RCHDTB ENTRY FOR + ;CASE-:SHIFT CHAR (RCHDTB ENTRY NOW IS ) +RCHLOD: 0 ;SAVED NORMAL RCHDTB ENTRY FOR CASE-LOCK CHAR. +RCHSFF: 0 ;-1 => LAST CHAR WAS A CASE-SHIFT. + ;USED TO CAUSE A CASE SHIFT TO QUOTE ITSELF. + +SUBTTL ADDRESS SPACE ORGANIZATION + +;;; THE 1ST 2 PAGES ARE THE "LOW IMPURE", CONTAINING SPECIAL-PURPOSE VARIABLES. +;;; THEN COMES THE PURE CODE, FROM "INIT" TO "HUSED". +;;; THEN COMES THE HIGH IMPURE, STARTING WITH A FEW SPECIAL-PURPOSE VARIABLES, +;;; FOLLOWED BY THE ^R COMMAND DISPATCH TABLE. + +;;; THEN COME THE DYNAMICALY ALLOCATED AREAS: +; THE COMMAND BUFFER IS USED FOR OLD-FASHIONED (NON-^R) TECO TOP-LEVEL COMMAND READIN. +CBUFLO: 10740,,CBUF ;SET TO BP -> BOTTOM OF COMMAND BUFFER. +CBUFH: CBUF+CBUFSZ-1 ;-> LAST WD OF COMMAND BUFFER + +; IMPURE STRING SPACE CONTAINS STRINGS AND BUFFERS' POINTER-STRINGS. +; BOTH START WITH A FLAG CHARACTER (QRSTR OR QRBFR, RESPECTIVELY), FOLLOWED +; BY 3 CHARACTERS HOLDING A NUMBER. IN A STRING, THAT NUMBER IS THE LENGTH, +; INCLUDING THE FOUR HEADER CHARACTERS, AND THE DATA FOLLOWS THE NUMBER. +; IN A BUFFER POINTER-STRING, THE NUMBER IS THE ADDRESS OF THE BUFFER'S FRAME. +; EITHER KIND OF OBJECT IS REPRESENTED IN QREGS, AS VALUES, ETC. BY A NUMBER +; WHICH IS THE CHARACTER ADDRESS RELATIVE TO THE START OF THE SPACE, PLUS SETZ. +QRBUF: INIQRB ;CHAR ADDR START OF IMPURE STRING SPACE +QRWRT: INIQRW ;CHAR ADDR 1ST CHAR ABOVE IMPURE STRING SPACE. +QRSTR==177 ;PREFIX CHAR FOR STRING (FOLLOWED BY 3 CHARS HOLDING + ;21-BIT SIZE OF STRING INCLUDING 4 HEADER BYTES, FOLLOWED BY TEXT). +QRBFR==176 ;PREFIX CHAR FOR BUFFER POINTER (FOLLOWED BY 3 CHARS + ;HOLDING ADDR OF POINTER-BLOCK (IN MACRO-FRAME SPACE)). + +; THEN COMES A GAP, CONTAINING NON-EXISTENT MEMORY, FOLLOWED BY BUFFER SPACE. +; EVERY BUFFER'S DATA AREA IS A SUBSET OF BUFFER SPACE, AND BUFFER SPACE +; IS USED FOR NO OTHER PURPOSE. +; BUFFER SPACE STARTS AND ENDS ON WORD BOUNDARIES, BUT BUFFERS NEED NOT START ON THEM. +; EACH BUFFER ENDS ON A WORD BOUNDARY, AND IS FOLLOWED BY ONE UNUSED WORD, +; WHICH IS INCLUDED IN BUFFER SPACE. ASIDE FORM THOSE UNUSED WORDS, EVERY WORD +; IN BUFFER SPACE CONTAINS PART OF AT LEAST ONE BUFFER. +; BUFFER DATA IS POINTED TO BY BUFFER FRAMES (SEE MFBFR), +.SEE BEG ; OR, FOR THE CURRENT BUFFER, BY BEG, ETC. +BFRBOT: INIBUF ;CHAR ADDR BOTTOM OF BUFFER SPACE (= BEG OF LOWERMOST BUFFER) +BFRTOP: INITOP ;CHAR ADDR TOP OF BUFFER SPACE (> Z OF UPPERMOST BUFFER) + +; THE MEMORY ABOVE BUFFER SPACE CAN CONTAIN ^P-SORT TABLES. IT CAN +; ALSO CONTAIN RANDOM DATA USED ENTIRELY WITHIN A SINGLE COMMAND. +MEMT: <1777+INITOP/5>_-10. ;NUMBER OF 1ST PAGE OF NXM ABOVE BUFFER SPACE. + +; ABOVE THE RANDM DATA THERE IS A GAP, RUNNING TO THE TOP OF MEMORY OR TO THE +; BEGINNING OF PURE STRING SPACE, WHICH STRETCHES DOWN FROM THE TOP OF MEMORY. +; OBJECTS IN PURE STRING SPACE LOOK LIKE OBJECTS IN IMPURE STRING SPACE, AND +; ARE POINTED TO BY NUMBERS WHICH ARE SETZ PLUS THE ABSOLUTE CHARACTER ADDRESS. +LHIPAG: LHIMAX ;LOWEST PAGE IN USE BY PURE STRING SPACE. + +INSINP: 0 ;WHILE INSERTING, PDL LEVEL AT INSLUP, ELSE 0. +INSLEN: 0 ;LENGTH OF THE LAST STRING INSERTED OR SEARCHED FOR. +TOTALC: 0 ;# CHARS AT END OF GAP NOT YET USED BY INSERT. +INSRCH: 0 ;INSN FOR INSERT TO XCT TO GET A CHAR. +INSDLM: 0 ;THE DELIMITER FOR THIS INSERT +INSBP: -1 ;NORMALLY -1 => NO ACTION. + ;INSERT AND FCECMD SET IT TO 0, SIGNALLING RCH + ;THAT BP SHOULD BE SAVED IN INSBP IF THERE IS A CHANCE + ;THAT A GC WILL OCCUR (EG IF PUSMAC IS CALLED). + ;BFRRLC WILL THEN RELOCATE INSBP AS A BYTE POINTER + ;EVENTUALLY RCH WILL COPY INSBP BACK TO BP AND ZERO INSBP. + +;VARIABLES DESCRIBING THE CURRENTLY SELECTED BUFFER. +BFRSTR: SETZ INI..O-INIQRB ;INTERNAL VERSION OF $QBUFR; + ;-> POINTER-STRING OF CURRENT BUFFER. +BFRPTR: MFBUF1 ;-> BUFFER FRAME FOR CURRENT BUFFER (IN MACRO-FRAME SPACE). +BEG: INIBEG ;CHARACTER ADDRESS OF BEGINNING OF BUFFER +BEGV: INIBEG ;CHAR ADDR BEGINNING OF AREA BEING EDITED. +PT: INIBEG ;CHARACTER ADDRESS OF "POINTER" +GPT: INIBEG ;CHARACTER ADDRESS OF THE BEGINNING OF THE GAP +ZV: INIBEG ;CHAR ADDR 1ST CHAR AFTER AREA BEING EDITED. +Z: INIBEG ;CHARACTER ADDRESS OF FIRST CHARACTER AFTER BUFFER +EXTRAC: 0 ;SIZE OF GAP (# CHARS) + JRST SUPCMD ;START TECO HERE TO REQUEST SPACE IN BUFFER, ETC. +SUPARG: 0 ;HOW MUCH SPACE IS WANTED. RETURNS WITH .BREAK 16,100000 +MODIFF: 0 ;NONZERO IFF THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. + ;SET BY WRITING; CAN BE SET OR CLEARED BY USER. +READON: 0 ;NON-0 DISALLOWS MODIFYING THIS BUFFER; CAN BE SET OR CLEARED BY USER + +;VARS ASSOCIATED WITH COMPUTATION OF NUMERIC ARGUMENTS. +LEV: 0 ;DEPTH IN PARENTHESES. +NUM: 0 +SARG: 0 ;ARG BEFORE COMMA FOUND HERE IF FRARG2 FLAG SET. +DLIM: ADD C,SYL ;THIS INSN SET BY ARITH OPS. +SYL: 0 +OSYL: 0 +IBASE: 10. ;INPUT RADIX FOR NUMBERS NOT FOLLOWED BY "." +I.BASE: 8 ;INPUT RADIX FOR NUMBERS FOLLOWED BY ".". + +;VARS USED BY TYPE-IN, AND LIS. +TYIBUF: BLOCK TYIBSZ ;BUFFER WHICH HOLDS LAST TYIBSZ*3 INPUT CHARACTERS. +TYIBFP: 441400,,TYIBUF +TYISNK: 0 ;MACRO TO BE CALLED WITH EACH TYPED-IN CHARACTER (BUT NOT REREAD ONES) + ;IN ADDITION TO PROCESSING THE CHARACTER NORMALLY. FOR DEFINING MACROS. +TYISRC: 0 ;NONZERO => MACRO TO SUPPLY "TYPE-IN" CHARACTERS. FOR EXECUTING MACROS. + +ECHOFL: 0 ;NONZERO => SYSTEM ECHOING IS TURNED ON. +LTYICH: 0 ;LAST CHAR READ FROM TTY, FOR DETECTING $$. +UNRCHC: -1 ;-1, OR CHARACTER TO BE RE-READ. +INCHCT: 0 ;NUMBER OF CHARACTERS READ FROM TTY SO FAR. +INCHRR: 0 ;VALUE OF INCHCT AT LAST TIME THROUGH RRLP1. + ;INCHCT-INCHRR IS LENGTH OF THIS ^R COMMAND IN INPUT CHARS. +HELPMA: 0 ;FS HELP MAC$: NONZERO => MACRO TO RUN WHEN "HELP" KEY IS TYPED. +HELPCH: TOP+"H ;FS HELP CHAR$: CHARACTER TO INVOKE HELP MACRO +PROMCH: "& ;THE PROMPT-CHARACTER; FS PROMPT $. 0 => NO PROMPTING. +CMFLFL: 0 ;-1 READ COMMAND OR INIT FILE +;[[ +CTLBRF: 0 ;-1 IF READING CHARACTER AFTER A ^] OR ^]^Q (IN TECO CMD STRING). +CBMAX: 0 ;LENGTH OF WHAT IS NOW IN CBUF. +SAVCMX: 1 ;CBMAX OF LAST CBUF STRING THAT WAS LONGER THAN 3 WORDS. +SAVCW1: 0 ;AND 1ST 3 WDS OF THAT CMD STRING. +SAVCW2: 0 ;THESE VARS COPIED BACK INTO CBMAX, CMD BUFFER, +SAVCW3: 0 ;AND CPTR BY LISCY (^Y AS FIRST CHAR TYPED) +SAVCPT: 0 ;(SAVED CPTR) SO IT CAN RESTORE LAST LONG COMMAND. + +FSPSPB: BLOCK FSPSPL ;RING BUFFER OF PT. +FSPSPP: 4400,,FSPSPB-1 ;RING BUFFER POINTER, -> LAST USED ENTRY. + +LISTF5: CALL . ;XCT THIS TO OUTPUT A CHARACTER. +DPT5: MOVEI CH,40 ;RH HAS CHARTO PAD A PRINTED NUMBER WITH. + +SUBTTL MACRO CALL FRAMES + +;MACRO AND ITERATION HANDLING LIST STRUCTURE: +;EACH CELL HAS MFBLEN WORDS. +;LISTS ARE LINKED THRU THE LAST WORD. +;THE FIRST 2 WORDS ARE RELOCATED BY GC. +;POINTERS TO NON-FREE BLOCKS ACTUALLY POINT TO THE +;LAST WORD OF THE BLOCK. + +MFBLEN==7 ;# WORDS PER CELL. + +;[ ;MACRO OR ^] INVOKATION LIST... +;(POINTED TO BY MACPTR) +MFCCNT==0 ;COMCNT +MFCPTR==1 ;CPTR +MFCSTR==2 ;CSTR +MFARG1==3 ;MARG1 +MFARG2==4 ;MARG2 +MFPF==5 ;MACSPF +MFLINK==6 ;MACPTR + ;LH HAS SAVED LH(MACBTS). + +;[[[ ;^]^X READ CELL. ^]^X IS A SPECIAL KLUDGE TO ALLOW STRING ARGUMENTS + ;TO BE READ FROM THE PREVIOUS COMMAND STRING LEVEL. IT TRIES TO BE + ;CLEVER ABOUT WHAT IT DOES WHEN OTHER ^] STRINGS ARE ENCOUNTERED WHILE + ;SCANNING FOR THE END OF THE ARGUMENT, DEFINED BY THE FIRST + ;ENCOUNTERED THAT ISN'T PROTECTED AGAINST TRIPPING THE CATCH (IE., BY QUOTING IT)> +;THESE CELLS FORM A LIST POINTED TO BY CTXPTR. + ;COMCNT + ;CPTR + ;CSTR + ;MARG1 + ;MARG2 + ;UNUSED. +;[ ;CTXPTR + +;ITERATION OR ERRSET (:< -- >)CELL +;THESE FORM A LIST POINTED TO BY ITRPTR. + ;COMCNT + ;CPTR + ;CSTR +MFICNT==3 ;ITERCT +MFMACP==4 ;MACPDP +MFPF==5 ;LH OF THIS WORD HAS RH OF P, RH HAS RH OF PF. + ;AS THEY WERE WHEN THE < WAS EXECUTED. + ;ITRPTR + +;BUFFER FRAME - DISTINGUISHED BY NEGATIVE 1ST WORD OF BLOCK. +MFBBTS==760000 ;THESE ARE ALL THE BITS IN MFBEG WORDS. +MFBFR==400000 ;1 => THIS IS A BUFFER FRAME. +MFMARK==200000 ;GC MARK BIT FOR BUFFER FRAME. +MFQVEC==100000 ;BIT INDICATING MARK THRU THE WORDS OF THIS BUFFER +MFMODIF==040000 ;1 => THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. +MFREADO==020000 ;1 => DONT ALLOW MODIFICATION OF THIS BUFFER + +MFBEG==0 ;HOLDS WHAT WOULD BE IN BEG IF THIS BUFFER WERE SELECTED. + ;AS WELL AS MFBFR AND MFMARK IN THE LH. +MFBEGV==1 ;SIMILAR, BUT FOR BEGV, AND NO MFBFR OR MFMARK. +MFPT==2 ;SIMILAR, FOR PT. +MFGPT==3 ;SIMILAR, FOR GPT. +MFZV==4 ;SIMILAR, FOR ZV. +MFZ==5 ;SIMILAR, FOR Z. +MFEXTR==6 ;SIMILAR, FOR EXTRAC. + +;THE FREE STORAGE LIST OF CELLS IS POINTED TO BY MFFREE, +;AND LINKED THROUGH THE LAST (MFLINK) WORD OF THE CELL, +;AND TERMINATED WITH A 0. +;THE MFCPTR OF A FREE CELL CONTAINS 0. +;POINTERS TO FREE CELLS ACTUALLY POINT TO THE WORD +;BEFORE THE FIRST WORD OF THE CELL. +;IF THE 1ST WORD OF A CELL IS NEGATIVE (MFBFR IS SET) THE CELL IS A BUFFER FRAME. + +MFFREE: MFSTRT-1 ;MACRO FRAME FREE LIST POINTER. +MFEND: MFEND1 ;END OF SPACE ALLOCATED TO MACRO FRAMES. + +COMCNT: 0 ;NUMBER OF CHARACTERS LEFT IN CURRENT LEVEL OF COMMAND STRING +CPTR: 0 ;BYTE POINTER TO COMMAND STRING (CURRENT LEVEL) +CSTR: 0 ;THE TECO STRING OBJECT WE ARE NOW EXECUTING PART OF. + ;IF EXECUTING SOMETHING NOT IN A TECO STRING, THIS IS BP TO ILDB 1ST CHAR. +MARG1: 0 ;FIRST NUMERIC MACRO ARGUMENT (GOTTEN BY ^X INSIDE MACRO) +MARG2: 0 ;SECOND NUMERIC MACRO ARGUMENT (FETCHED BY ^Y) +MACSPF: 0 ;PF COPIED INTO THIS WORD WHEN MACRO IS CALLED. + +MACPTR: 0 ;POINTER TO THE LAST CELL IN THE MACRO INVOKATION AND +;[ ;^] INVOKATION LIST +MACDEP: 0 ;NUMBER OF FRAMES IN MACPTR STACK (INCLUDING THOSE VIA MACXP). + +CTXPTR: 0 ;[ ;POINTER TO LAST CELL IN THE ^]^X INVOKATION LIST + +MACBTS: 0 ;BITS IN LH SAYING HOW MANY ARGS GIVEN TO CURRENT MACRO. +MFBA1==400000 ;1 => 2 ARGS WERE GIVEN. +MFBA2==200000 ;1 => AN ARG WAS GIVEN. +MFBATSN==100000 ;1 => @ WAS SPECIFIED IN THE CALL TO THIS MACRO. + + +ITRPTR: 0 ;RH PTR TO INNERMOST ITERATION OR ERRSET CELL + ;LH PTR TO INNERMOST ERRSET CELL (OR 0) +ITERCT: 0 ;# PASSES LEFT IN INNERMOST ITERATION. + +;[[[[[ ;THE MACRO PDL CONSISTS OF 4-BIT BYTES, ONE PER MACRO CALL +;OR ^]-CALL (INCLUDING ^]^X). +;MACRO PDL OVERFLOW IS IMPOSSIBLE BECAUSE THE RATIO OF MACRO-PDL +;TO MACRO CELL SPACE INSURES THAT THE LATTER WILL RUN OUT FIRST. +;ONE ENTRY PUSHED FOR EACH ^] CALL (INCLUDING ^]^X) OR M COMMAND. +;0 => MACRO CALL THAT DIDN'T SUPERQUOTE OR DELIMITER-PROTECT. +;1 - 7 => MACRO CALL. 4 BIT => HAD BEEN LOOKING FOR $ AT RCHALT. +; 1 AND 2 BITS: SUBTRACT 1, THEN GET OLD 4.8, 4.9 OF SQUOTP. +;10 => NULL ENTRY, IGNORE WHEN POPPING. +;11 THRU 17 => ^]^X CALL, LOW 3 BUTS SAME AS FOR 1 - 7. + +MACPDP: 400,,MACPDL-1 ;MACRO PDL PTR, -> HIGHEST USED BYTE. +MACPDL: BLOCK MACPSZ +MACXP: 0 ;P IN LAST CALL TO MACXCT OR MACXQ. + +SUBTTL SORT AND SEARCH VARIABLES + +;^P SORT VARIABLES: +PSMEM: 0 ;WD ADDR 1ST WD OF ^P SORT TABLE + ;(WHICH LIVES ABOVE THE BUFFER) +PSMEMT: 0 ;WD ADDR 1ST WD OF LAST ENTRY OF TABLE + ;ENTRIES ARE ADDED AT THE END, AND ARE 4 WDS LONG. +PSSAVP: 0 ;P SAVED INSIDE ^P, OR 0. USED TO TELL WHETHER A SORT IS IN PROGRESS. + ;ALSO USED TO DETECT UNWINDING OUT OF A SORT. +PSZF: 0 ;SET TO -1 TO INDICATE LAST RECORD HAS BEEN FOUND. +PSCASE: 0 ;NONZERO => ^P-SEARCH IGNORES CASE. (FS ^PCASE) + +LPSDBK==4 ;SORT TABLE ENTRIES ARE 4 WDS LONG: + ;0TH WD CHAR ADDR START OF KEY, RELATIVE TO BEG. + ;LATER REPLACED BY BP TO ILDB KEY. + ;1ST WD -<# CHARS IN RECORD>,,-<# CHARS IN KEY> + ;2ND WD CHAR ADDR START OF RECORD, RELATIVE TO BEG. + ;3RD WD POINTER (RELATIVE TO PSMEM) TO NEXT ENTRY, + ;OR -1 FOR LAST ENTRY. TABLE IS SORTED + ;BY CHANGING THESE POINTERS. + +;SEARCH VARIABLES: +PNCHFG: 0 ;0 => S OR FB OR REVERSE SEARCH, 1 => _, -1 => N +SEARG: 0 ;# TIMES TO SEARCH. 1 FOR FB; + ;= ABS VAL. OF NUMERIC ARG FOR S, _, N. +SRCBEG: 0 ;CHARACTER NUMBER (REL TO BEG) OF START OF SEARCH RANGE. +SRCEND: 0 ;CHARACTER NUMBER (REL TO BEG) OF END OF SEARCH RANGE. +SRCERR: 0 ;-1 => FAILING SEARCHES SHOULD BE ERRORS EVEN INSIDE ITERATIONS. +BBP: 0 ;BP. TO 1ST CHAR IN RANGE TO BE SEARCHED. +ZBP: 0 ;BP TO CHAR AFTER LAST CHAR IN RANGE TO BE SEARCHED. +BBP1: 0 ;NOT USED IN FORWARD SEARCH. + ;FOR BACKWARD SEARCH, IT IS THE SAME AS BBP + ;UNLESS THE GAP IS BETWEEN BBP AND WHERE WE ARE SEARCHING, + ;IN WHICH CASE BBP1 POINTS TO THE FIRST CHARACTER AFTER THE GAP. +ZBP1: 0 ;IF GAP IS WITHIN RANGE OF SEARCH, + ;BP TO 1ST CHAR POS WITHIN THE GAP; OTHERWISE, SAME AS ZBP. + ;WHEN FWD SEARCH CROSSES THE GAP, ZBP1 SET FROM ZBP +SLP4N: 0 ;WHEN E MOVES TEMPORARILY FORWARD OVER THE GAP, WHILE TESTING ONE ALTERNATIVE, +SLP4N1: 0 ;SLP4 AND SLP4-1 ARE SAVED IN THESE TWO WORDS. + ;WHEN E IS RESET FROM C, THEY ARE RESTORED FROM THESE WORDS. +SLP1P: JRA B,. ;SLP1D\SLP1I INSTRUCTION EXECUTED WHEN TIME TO READ ANOTHER CHARACTER +TEM1: 0 ;0, OR BP TO START OF LAST INSTANCE FOUND. +TEM2: 0 ;0, OR BP TO END OF LAST INSTANCE FOUND. + +SFINDF: 0 ;VALUE OF THE LAST SEARCH (WHETHER :-SEARCH OR NOT) + +SBFRS: SETZ INISRS-INIQRB ;STRING-POINTER THAT PRESERVES SEARCH-BUFFER. +SBFRP: MFSBUF ;-> SEARCH BUFFER HEADER. +STBLP: INISRB/5 ;ADDRESS OF SEARCH BUFFER BODY. +STBLPX: INISRB/5,,SLP1P ;ALWAYS THE SAME FUNCTION OF STBLP. + +SFXOR: 0 ;ASCII /QQQQQ/, IF 1ST CHAR OF SEARCH STRING IS Q, INSIDE SFAST. +SFASAD: SFAFN0,SFAFC0 ;ADDRESS TO ENTER APPROPRIATE MAIN LOOP OF SFAST. + ;DEPENDS ON WHETHER CASE BEING IGNORED FOR 1ST CHAR OF STRING. + +SUBTTL MORE VARIABLES + +GCPTR: 0 +GCNRLC: 0 ;-1 => GC SHOULDN'T RELOCATE STRINGS, JUST FLUSH UNNEEDED BUFFERS. +QRGCMX: INIQRB+GCOFTN ;GC IMPURE STRINGS WHEN QRWRT GETS THIS LARGE. +STOPF: 0 ;FS QUIT$. NEGATIVE == QUIT DESIRED (FS QUIT) + ;^G AT INT LVL SETS STOPF; SETTING STOPF CAUSES + ;QUITTING ACTION UNDER CONTROL OF NOQUIT. +NOQUIT: 0 ;(FS NOQUIT) 0 => ^G QUITS TO TECO'S TOP LEVEL. + ;POSITIVE => ^G JUST SETS STOPF FOR PROGRAM TO TEST. + ;NEGATIVE => ^G CAUSES "QIT" ERROR (ERRSETABLE). +CLKFLG: 0 ;-1 => IT IS TIME TO RUN THE REAL-TIME CLOCK ROUTINE. +IFN TNX,CLKINT: 0 ;LENGTH OF INTERVAL AT WHICH TO RUN CLOCK ROUTINE +CLKMAC: 0 ;POINTER TO REAL-TIME CLOCK ROUTINE. +RUNFLG: 0 ;-1 ==> TECO HAS BEEN RUN. Q..Q, ETC. HAVE BEEN INITTED. +VARMAC: 0 ;NONZERO => ENABLE FEATURE OF CALLING MACRO WHEN A NAMED VARIABLE IS SET. +LASTER: 0 ;MOST RECENT ERROR MESSAGE (A STRING POINTER). +ERRFLG: 0 ;-1 WHILE PROCESSING AN ERROR. +ERRFL1: 0 ;FS ERRFLG$ - NEGATIVE (-) =. PROTECT 1ST LINES OF SCREEN + ;FROM REDISPLAY (ASSUMING THEY CONTAIN ERROR MESSAGE). SET BY FG. +VERBOS: 0 ;IF NON-ZERO, DISPLAY WHOLE ERROR MESSAGE STRING IMMEDITAELY +ERR1: 0 +ERR2: 0 +ERRECH: 0 ;-1 => TYPE ERR MSGS IN ECHO AREA. + +PTLFCD: 0 ;PTLAB FILE CREATION DATE + +STABP: ;THIS IS THE CACHE FOR JUMPS ("O" COMMAND) +SYMS: BLOCK 20 ;THESE HOLD THE CPTRS AT SOME JUMPS; +VALS: BLOCK 20 ;THESE, THE CPTRS OF TAGS JUMPED TO; +CNTS: BLOCK 20 ;THESE, THE COMCNTS AT THOSE TAGS. +SYMEND: ;ENTRIES ARE IN PAIRS. EACH JUMP CPTR SELECTS A PAIR + ;THE ENTRIES IN A PAIR ARE USED FIFO BY NEW JUMPS. + +PF: -LPF-1,,PFL-1 ;Q REGISTER PDL POINTER +PFL: BLOCK LPF +;QREG PDL ENTRIES ARE 2 WORDS EACH. +;THE FIRST WORD CONTAINS THE DATA PUSHED. +;THE SECOND CONTAINS INFO ON WHERE PUSHED FROM: +; EITHER THE CORE LOCATION PUSHED FROM, +; THE QREG NAME (FOR Q$FOO$ Q-REGS), +; OR THE INDEX IN FLAGD OF THE FS FALG THAT WAS PUSHED. +; THESE ARE DISTINGUISHED BY WHETHER THE NUMBER IS < FLAGSL. + +PDL: BLOCK LPDL +BAKTAB: ;"\" COMMAND WITH ARG "PRINTS" INTO THESE WORDS. +LTABS==100. +STAB: ;WITHIN "O" COMMAND SEARCH, HOLDS THE TAG NAME. +LBF: ;OUTPUT BUFFER FOR "@" AND "^O" COMMANDS. +GCTAB: BLOCK GCTBL +IFG LTABS-GCTBL,BLOCK LTABS-GCTBL + ;USES OF GCTAB: + ;JCL READ INTO IT. USED AS BUFFER BY E_. USED BY ALINK + ;TO HOLD SOME TEMPS. + +QRB: QTAB ;POINTER TO BLOCK OF QREGS WITH NO "."'S IN NAME. +QRB.: QTAB+36. ;POINTER TO BLOCK OF ONE-"." QREGS. +QRB..: QTAB+36.*2 ;POINTER TO BLOCK OF ".." QREGS. +QTAB: BLOCK NQREG + +CTLCF: 0 ;SET BY ^C, SAYS EXIT AFTER COMMAND DONE. + +UTIBUF: BLOCK UTBSZ ;BUFFER FOR READING FROM CHFILI +UTIBE: 0 ;WORD TO HOLD A ^C STUCK ON TO DETECT EOB +UTRLDT: 350700,, ;B.P. TO THE ^C TERMINATING FILLED PART OF UTIBUF +UTYIP: 010700,,0 ;B.P. FOR UNLOADING UTIBUF + +UTOBUF: BLOCK UTBSZ ;BUFFER FOR WRITING TO CHFILO +UTOBE: +UTYOP: 010700,,0 ;B.P. FOR STUFFING UTOBUF +UTYOCT: 0 + +IMQUIT: 0 ;-1 SAYS ^G SHOULD QUIT IMMEDIATELY. + ;SET EG. DURING SEARCHES, WHICH DON'T NEED TO CLEAN UP. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + ;SET TO 1 ONLY AT TECO STARTUP AND WITHIN LIS. + +GOXFLS: 0 ;ZEROED BY GO. -1 => GO SHOULD POP ALL THE WAY TO THE TOP LEVEL. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + +TSINAL: 0 ;-1 => LAST INT. CHAR. WAS ALTMODE. (FOR FINDING $$ AT INT LVL) +TSALTC: 0 ;# OF $$'S ITYIC'D BUT NOT IOT'D. + +PAGENU: 0 ;PAGE # IN INPUT FILE. +LASTPA: -1 ;0 IF HAVE YANKED LAST PAGE OF INPUT FILE. + +IFN ITS,MSNAME: 0 ;WORKING DIRECTORY. +HSNAME: 0 ;HOME DIRECTORY (SIXBIT IN ITS, DIR # IN TWENEX). +OUTFLG: 0 ;-1 => OUTPUT TO EW'D FILE DISABLED. +FILEPA: EOFCHR ;CHAR TO PAD LAST WORD OF OUTPUT FILES WITH. +RDMNMS: 3.14 ;USED BY RANDOM # GENERATOR. VALUE OF FS RANDOM +DOWNF: 0 ;-1 => DOING AN FLD +SEXPFL: 0 ;-1 => FL IS LOOKING FOR S-EXP, NOT LIST. + ;S-EXP MEANS EITHER WORD OR LIST, WHICHEVER STARTS FIRST. +FFRRCT: 0 ;IN FILENAME READER = <# OF FILENAMES> -1 +FNAMSY: 0 ;0 => IF ONLY 1 FILENAME IN STRING, IT IS FN2. + ;NOT 0 => IT IS FN1 (LIKE ALL OTHER PROGRAMS). (FS FNAMSYNTAX) +ADLINE: 60. ;SIXTY CHARACTERS PER LINE OF ADJUSTED TEXT (FA) +NOOPAL: -1 ;IGNORE ALTMODES IF NEGATIVE. + ;STRAY ALTMODES ARE ERRORS IF THIS IS 0. THEY ARE LIKE ^_ IF >0. +NLAROW: 0 ;0 => "_" LEGAL. 1 => ILLEGAL. -1 => "_" TREATED AS "-". +YDISAB: 0 ;0 => Y IS LEGAL. 1 => ILLEGAL. -1 => Y TREATED AS ^ Y. +TABMOD: 0 ;0 => TAB INSERTS, 1 => TAB ILLEGAL, -1 => TAB IGNORED. +FFMODE: 0 ;NON0 => ^L'S READ FROM FILE GO IN BFR. + ;0 => ^L AT END OF PAGE Y'D OR FILE ^Y'D + ;IS THROWN AWAY, AND PW GENERATES A ^L. +UNWINF: 0 ;0 => UNWIND QREG PDL AFTER EACH COMMAND STRING. +BOTHCA: 0 ;NONZERO => SEARCH DOESN'T DISTINGUISH UPPER AND LOWER CASE. +SKNBPT: 0 ;B.P. TO LDB 1ST CHAR OF THE STRING IN .QDLIM. + ;HAS A IN INDEX FIELD. +KILMOD: -1 ;0 => FS BKILL SHOULDN'T REALLY KILL. +SLPNCR: 0 ;-1 => SLPN00 SHOULDN'T CLEAR LOW BITS. +YANKMT: 0 ;0 EXCEPT INSIDE YANK, HAS WHAT MEMT HAD AT START OF YANK. + ;USED TO ELIMINATE EXCESS LOW-BIT CLEARING. +TRCOUT: 0 ;NONZERO WHILE OUTPUTTING TRACE OUTPUT. + ;USED TO PREVENT TRACE OUTPUT FROM CLOBBERING TOP LINE OF SCREEN. +PUREFL: 0 ;-1 => TECO HAS BEEN PURIFIED. +INITF1: 0 ;SET TO -1 BY STARTUP CODE SO THAT ..L WILL BE MACROED + ;NEXT TIME THROUGH THE LOOP AT GO. +INITFL: 0 ;TECO WAS STARTED AT INIT+2, SAYING IT IS UNDER A LISP. +STEPFL: 0 ;-1 => TECO MACRO LINE-STEPPING FEATURE ENABLED: + ;CR AS A COMMAND DOES ^VW AND THEN QUITS IF CHAR IS ^G, + ;ENTERS ^R IF CHAR IS ^R, SETS STEPFL TO 0 IF CHAR IS ^P. + ;ELSE, CAN BE A MACRO TO CALL TO DO THE STEPPING. +STEPDE: -1 ;MAXIMUM MACRO PDL DEPTH (FS BACKDEPTH) AT WHICH TO ALLOW STEPPING, OR -1. +SETPP: 0 ;OLD CONTENTS OF P BEFORE MOST RECENT CALL TO SETPP. DEBUGGING ONLY. +SUPHND: 0 ;FS SUPERIOR$ - MACRO TO HANDLE REQUESTS FROM SUPERIOR. + +SUBTTL BOOTSTRAP FOR EJ FILES + +IF2 PURP1==INIT/2000 ;# OF 1ST PURE CODE PAGE +IF2 PURPL==/2000 ;# OF 1ST PAGE ABOVE PURE CODE. + +BOOT: JRST BOOT1 ;THIS IS THE START ADDRESS WRITTEN INTO EJ FILES. + .VALUE + SETOM INITFL ;START AT START + 2 => SET FS LISPT. +IFN TNX,MOVEM 1,CCLJFN ;TWENEX - SAVE THE JFN WE WERE GIVEN FOR FS CCL FNA$ +BOOT1: SKIPE LIMPUR ;WERE WE JUST LOADED, OR WERE WE RESTARTED? + JRST INIT ;RESTARTED => PURE CODE ALREADY PRESENT, SO DO NORMAL RESTART. +IFN ITS,[ + SYSCAL OPEN,[[.UII,,CHFILI] ? ['DSK,,] ? ['TECPUR] ? [.FNAM2] ? ['.TECO.]] + .LOSE %LSFIL ;TECO PURE FILE NOT FOUND. + .IOT CHFILI,A + SKIPE A + .LOSE ;NOT A PDUMP FILE?? + .ACCESS CHFILI,[INIT+2000] ;GOBBLE TECO'S PURE PAGES OUT OF THE PDUMP FILE. + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBNDR ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHFILI] + .LOSE %LSFIL + .CLOSE CHFILI, +] +IFN TNX,[ + MOVE P,BOOTP + MOVSI 1,(GJ%OLD\GJ%SHT) +RADIX 10. +IFN 20X,[ IFN EMCSDV, HRROI 2,[STRCNC [EMACS:TECPUR.EXE.]\.FNAM3 ] + .ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +] +IFN 10X, HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +RADIX 8 + GTJFN + .VALUE +IFN 20X,[IOR 1,[.FHSLF,,GT%ADR] + MOVE 2,[PURP1*2,,PURPL*2] +] +IFN 10X,HRLI 1,.FHSLF + GET +] + SETOM PJATY ;SCREEN NEEDS COMPLETE REDISPLAY SINCE WE HAVEN'T INITTED IT. + MOVEI TT,LHIMAX ;WE HAVE NO LIBRARIES LOADED IN YET. + MOVEM TT,LHIPAG + JRST INIT + +CONSTA ;WITHOUT THIS, OUR LITERALS WOULD BE IN THE PURE CODE. + +RRVARX:: IF2 IFNDEF RRVARB, RRVARB:: BLOCK RRVARL + +IF2 VPAT: VPATCH: + +INFORM [END OF LOW IMPURE]\.-1 +LOC .\1777 ;MOVE TO LAST WORD OF PAGE +LIMPUR:: -1 ;0 => THIS IS AN EJ FILE JUST LOADED; IT MUST GET TECO'S PURE PAGES. + +SUBTTL ^R MODE VARIABLES + +;^R REAL TIME EDIT MODE VARIABLES. ON PASS 2 WE PUT THEM IN LOW IMPURE IF THEY FIT, +;OTHERWISE IN HIGH IMPURE. + +RRVARL==51. ;NUMBER OF WORDS OF ^R VARIABLES. + +IF2 [ ;BY THE TIME WE GET HERE ON PASS 2, RRVARB WILL + ;HAVE THE DESIRED LOCATION OF THE ^R VARIABLES BLOCK. +RRTMPV==. ? LOC RRVARB + +RRHPOS: 0 ;CURRENT CURSOR HPOS & VPOS: REFLECT +RRVPOS: 0 ;CURRENT VALUE OF PT, EVEN IF SCREEN HASN'T CAUGHT UP. +RROHPO: -1 ;WHAT RRHPOS HELD LAST TIME CURSOR ACTUALLY WAS MOVED. +RROVPO: -1 ;IF THESE DIFFER FROM CURRENT POS, MUST MOVE CURSOR. +RRCMMT: -1 ;0 IF IN COMMENT MODE. +RRCCOL: 0 ;COLUMN IN WHICH THE COMMENTS SHOULD START. +RRMNVP: 0 ;THE VPOS OF UPPERMOST LINE THAT NEEDS REDISPLAY, + ;OR 377777,,-1 MEANING NO LINES NEED REDISPLAY, + ;OR -1 MEANING DON'T TRUST LINBEG AT ALL; DO FULL REDISPLAY. + ;IF RRMNVP IS POSITIVE AND FINITE, ALL LINBEGS FROM TOPLIN + ;DOWN THRU THE RRMNVP'TH LINE (INCLUSIVE) MUST BE ACCURATE OR YOU WILL LOSE! +RRMNHP: 0 ;LEFTMOST COLUMN ON THAT LINE THAT NEEDS REDISPLAY. +RRMAXP: 0 ;NON0 => LARGEST VALUE OF PT AT WHICH BUFFER WAS CHANGED. +RRMSNG: 0 ;NON0 => SOME TEXT AFTER RRMAXP IS MISSING FROM THE SCREEN. +RRRPCT: 0 ;NUMERIC ARG SPEC'D WITH ^V OR CTL-DIGITS. +RRARGP: 0 ;NONZERO => RRRPCT HAS BEEN SET (ELSE IT DEFAULTS TO 1). +RR4TCT: 0 ;# OF OCCURRENCES OF ^U. THE NUMERIC ARG TO A COMMAND IS RRRPCT*(4 ^ RR4TCT) +RUBCRL: 0 ;-1 => ^D AND RUBOUT DELETE A WHOLE CRLF AT ONE BLOW. +RRLAST: 0 ;MOST RECENT ^R-MODE CHAR THAT WASN'T AN ARGUMENT-SETTING COMMAND +RRPRVC: 0 ;WHAT WAS IN RRLAST BEFORE ITS CURRENT CONTENTS. +RRRPLC: 0 ;-1 => NORMAL CHARS REPLACE (X = DIX$) + ;1 => THAT, AND META-CHARS INSERT (LIKE ETV) +RRMCCT: 0 ;FS CRMDLY -- # CHARS TO HANDLE BETWEEN + ;INVOCATIONS OF SECRETARY MACRO. +RRMCC1: 0 ;THIS IS USED TO COUNT THAT MANY CHARS. +RRNCCR: 0 ;SET TO -1 DURING REDISPLAY IF THE PTR + ;COMES AFTER A CR. THAT MEANS RRHPOS IS WRONG + ;AND SHOULD BE COMPUTED BY CALLING RRBTCR. +RRCCHP: 0 ;TEMP. IN CHCT; SAVES HPOS AT START OF EACH CHAR. +RRERFL: 0 ;TEMP. THAT SAVES ERRFL1 OVER CALL TO VBD. +RROLDZ: 0 ;VALUE OF Z, AT TIME OF LAST REDISPLAY THAT WASN'T INTERRUPTED BY TYPEIN. +RROLZV: 0 ;VALUE OF ZV, AT THAT TIME. +RRIDVP: 0 .SEE RRLID ;VPOS AT WHICH WE SHOULD INSERT/DELETE LINES. +RRIDLB: 0 ;OLD LINBEG OF THAT LINE. +RRIDBK: 0 ;# OF NEWLY MADE BLANK LINES BEFORE THAT LINE. +RRCIDP: 0 ;NEG => USE CHAR I/D FOR THIS COMMAND, POS => ONLY REASON FOR + ;UPDATING IS NOT AT END OF LINE, CAN PERHAPS LUCK OUT WITH TABS +RRUNQT: 0 ;-1 => TEMPORARILY REENABLE BUILTIN COMMANDS. +RRALQT: -1 ;NONNEG => DISABLE BUILTIN COMMANDS, BUT + ;THIS WD'S CONTENTS ARE CHAR THAT REENABLES THEM TEMPORARILY. +RRCMQT: 0 ;-1 => ALL CONTROL-META-LETTERS,ETC. ARE SELF-INSERTING (FOR EDITING MACROS). +RREZ: INIBEG ;WHEN ^R MODE IS EXITED, Z, BEG AND PT +RREBEG: INIBEG ;ARE SAVED IN THESE 3 VARS. IF ^R IS REENTERED +RREPT: INIBEG ;WITH ARGS, THEY ARE COMPARED WITH THESE VALUES. + ;RREBEG IS 0 WHILE ^R IS ACTUALLY IN CONTROL. + ;NOT 0 DURING NORMAL COMMAND EXECUTION, INCLUDING MACROS CALLED FROM ^R. + ;0 PREVENTS ^G FROM QUITTING AT INT LVL. +RREVPS: 0 ;REMEMBER RRVPOS AND RRHPOS AT EXIT, IN CASE WE REENTER +RREHPS: 0 ;WITH ONE ARGUMENT. +RREBUF: 0 ;REMEMBER BUFFER THAT ^R WAS PREVIOUSLY DISPLAYING (AS STRING PTR). +RRMKPT: -1 ;THE MARK USED BY ^T, ^X, ^W. +RRSCAN: 0 ;NONZERO => VARIOUS COMMANDS PRINT WHAT THEY STEP OVER/INSERT/DELETE. +RRTTMX: 50. ;FS ^RMAX$. MAX # CHARS OF INSERT TO BE WILLING TO SCAN ON PRINTING TTY. +RRECHO: 0 ;-1 => ECHO THE ^R COMMANDS EXECUTED. 0 => ECHO ONLY ON PRINTING TTY +RRMORF: 0 ;POSITIVE => USE --MORE-- INSTEAD OF --TOP--, ETC., EVEN THOUGH IN ^R. + ;NEGATIVE => DON'T USE EITHER --MORE-- OR --TOP--, ETC. WHEN IN ^R. +RRXINV: 0 ;THIS IS THE REAL DEFINITION OF "SELF-INSERTING CHARS", 0 => SELF-INSERT +RRENTM: 0 ;FS ^R ENTER$, NONZERO => MACRO IT WHEN ENTER ^R. +RRLEVM: 0 ;FS ^R LEAVE$, NONZERO => MACRO IT WHEN LEAVE ^R. +RRDISM: 0 ;FS ^R DISPLAY$, NONZERO => MACRO WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. + +;DEBUGGING VARIABLES: +RRDHPS: 0 ;REMEMBERS RRHPOS BEFORE LAST REDISPLAY. +RRDVPS: 0 ;SAME FOR RRVPOS +RRDMHP: 0 ;SAME FOR RRMNHP +RRDMVP: 0 ;SAME FOR RRMNVP +RRDPT: 0 ;REMEMBER 1ST CHAR DISPLAYED IN LAST REDISPLAY. +IFN .-RRVARB-RRVARL, .ERR RRVARL ISN'T SET RIGHT. + +LOC RRTMPV + +] ;END IF2 + +SUBTTL INITIALIZATION + +INIT: SKIPE RUNFLG ;RESTARTING => DON'T CLOBBER BUFFER, Q-REGS. + JRST GOZ + SETZ FF, + MOVE P,[-LPDL,,PDL-1] +GOZ: SETZM SQUOTP ;NONZERO SQUOTP CAN INTERFERE WITH INSASC. + SETOM PJATY ;SCREEN CONTENTS HAVE BEEN RANDOMLY CLOBBERED. + MOVE CH,LIMPUR ;CH GETS 0 IF THIS IS EITHER TECO JUST LOADED + ; OR AN EJ FILE JUST LOADED + AND CH,RUNFLG +IFN ITS,[ + MOVE E,[-8,,[.SMASK,,[TSMSK] ? .SMSK2,,[TSMSK1] ;SET MASKS, + .SPICL,,[-1] ? .SWHO1,,[0] + .RSNAME,,Q ? .RHSNAME,,HSNAME + .RIOS+CHFILI,,A ? .RIOS+CHFILO,,C]] + .SUSET E + JUMPN CH,GOZ4B ;IF TS TECO OR SOME EJ FILE HAS JUST BEEN LOADED, + MOVEM Q,MSNAME ;THEN OUR .SNAME IS THE MSNAME. + MOVEM Q,DEFDIR ;AND ALSO SHOULD BE OUR DEFAULT SNAME. +GOZ4B: SKIPN A ;ALSO SEE IF DISK CHNLS REALLY STILL OPEN, IN CASE THIS IS A RESTART. + CALL UICLS ;IF THEY AREN'T, TECO SHOULDN'T THINK THEY ARE. + SKIPN C + TLZ FF,FLOUT + SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,MACHIN ]] + .LOSE %LSSYS + .I DEFDEV=MACHIN +];IFN ITS +IFN TNX,[ + CIS ;FORGET ANY INTERRUPTS IN PROGRESS + MOVEI A,.FHSLF + MOVE B,[LEVTAB,,CHNTAB] + SIR + EIR +IFN 20X,MOVE 2,[740400,,020000] ; CHANNELS 0-3, 9 AND 22 +IFN 10X,MOVE 2,[700410,,020000] ; CHANNELS 0-2, 9, 14 AND 22 + AIC + RPCAP + TRZ 2,-1 ;ONLY ENABLE LH CAPS + IOR 3,2 + EPCAP + JUMPGE 3,GOZ4A ; NO ^C CAPABILITY? + MOVE A,[.TICCC,,2] + ATI ; ^C ON CHANNEL 2 +GOZ4A: +IFN TNX,[MOVEI A,.PRIOU + RFCOC + MOVEM B,ITTYMD+1 + MOVEM C,ITTYMD+2 + RFMOD + MOVEM B,ITTYMD ;SAVE TTY MODES +IFN 20X,[ + LDB A,[.BP TT%PGM,B] + MOVEM A,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING +];20X +];TNX + JUMPN CH,GOZ4B + GJINF +IFN 20X,[ + TLNE 1,-1 + TLO 1,040000 ; MAKE SURE THIS LOOKS LIKE A DIRECTORY + MOVEM 1,HSNAME ; HSNAME IS DIRECTORY CORRESPONDING TO USER + MOVSI 1,(GJ%OFG\GJ%SHT) ; PARSE ONLY + HRROI 2,DEFFN1 + GTJFN + JRST GOZ4B + CALL FFSET3 ; SET DEFAULTS FROM IT + RLJFN + JFCL +] +IFN 10X,[ + MOVEM A,HSNAME ; HSNAME IS JUST USER + HRROI A,DEFDIR ; CANNOT JUST DO GTJFN, CAUSE LOSING TENEX FILESYSTEM WILL FAIL + DIRST ; ON SECOND ATTEMPT + JFCL +] +GOZ4B: SKIPN 1,CHFILI + JRST GOZ4 + GTSTS + TLNN 1,(GS%OPN) ; FILE STILL OPEN? + CALL UICLS ; NO +GOZ4: SKIPN 1,CHFILO + JRST GOZ5 + GTSTS + TLNN 1,(GS%OPN) + TLZ FF,FLOUT +];IFN TNX + +GOZ5: SETOM LIMPUR ;MAKE SURE A SECOND $G WON'T MAKE BOOT REBOOT. + CALL INITTY ;INITIALIZE TTY AND FLAGS ABOUT WHAT KIND AND HOW TO TREAT IT. + MOVEI A,[ASCIZ *-!-*] ;USE -!- FOR CURSOR ON PRINTING TTYS. + SKIPE C,RGETTY + MOVEI A,[ASCIZ */\*] ;USE /\ ON DISPLAYS. +IFN ITS,[ + CAIN C,3 + MOVEI A,[ASCIZ //] ;BUT USE "I-BEAM" ON IMLACS. +] +IFN TNX,[ + CAIN C,1 + MOVEI A,[ASCIZ /_/] ;WHAT PEOPLE ARE USED TO ON DATAMEDIAS +] + HRLI A,BP7 + MOVE CH,QRB.. + ADDI CH,.QCRSR + CALL INSASC ;INSERT ASCII STRING IN Q-REG ..A. + SETOM INITF1 ;CAUSE ..L TO BE RUN. +GOZ3: SETZM CPTR ;CPTR MIGHT POINT INTO PURE STRING SPACE WHICH IS NOW NXM. + SKIPE RUNFLG + JRST CTLW + +;STUFF TO DO WHEN STARTED UP THE 1ST TIME ONLY. + MOVE CH,QRB.. + MOVEI A,10. + MOVEM A,.QBASE(CH) ;INIT. OUTPUT RADIX. + MOVE A,[SETZ 1+INIDLM*5-INIQRB] + MOVEM A,.QDLIM(CH) + HRRI A,INI..O-INIQRB + MOVEM A,.QBUFR(CH) + MOVEM A,.Q..Z(CH) + MOVE IN,BEG ;MAKE SURE THE BOTTOM PAGE OF BUFFER EXISTS + CALL GETCHR ;TO PREVENT CONFUSING THE CODE AT FLSCOR + SETOM RUNFLG ;SAY TECO HAS BEEN RUN. + MOVEI A,[ASCIZ/ 5FSQVECTOU..Q 2U:..Q(0)/] + CALL MACXCW ;PUT AN EMPTY SYMBOL TABLE IN ..Q. + MOVEI A,TYOA + HRRM A,LISTF5 ;CAUSE OUTPUT ROUTINES TO TYPE ON TTY. + MOVEI A,[ASCIZ/IMPURE /] + SKIPN PUREFL + CALL ASCIND + MOVE A,[.FNAM1] + MOVEI C,". + CALL SIXINT + MOVEI C,.FVERS + CALL DPT +IFN ITS,[ + .SUSET [.RXUNAME,,C] + .CALL GOZO1 ; OPEN ; TECO + CAIA + JRST GOZ7 + MOVSI C,(SIXBIT/*/) + .CALL GOZO1 ; OPEN ;* TECO + CAIA + JRST GOZ7 + .CALL GOZO2 ; LAST RESORT IS .TECO.;* TECO + CAIA +GOZ7: SETOM CMFLFL ;BUT IF INIT FILE EXISTS, USE IT, +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. + +GOZO1: SETZ ? SIXBIT/OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? C ? [SIXBIT /TECO/] ? SETZ HSNAME + +GOZO2: SETZ ? SIXBIT /OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? [SIXBIT/*/] ? [SIXBIT/TECO/] ? SETZ [SIXBIT/.TECO./] +] +IFN TNX,[ + MOVSI 1,(GJ%OLD\GJ%SHT) + HRROI 2,[ASCIZ /TECO.INIT/] + GTJFN + JRST GOZ6 + MOVE 2,[36._30.+OF%RD] + OPENF + JRST GOZ6 + MOVEM 1,CHFILI + SETOM CMFLFL +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. +] + +;OPEN THE TTY CHANNELS AND SET VARIOUS VARS ACCORDING TO TYPE OF TTY. +FSTTYI: +INITTY: +IFN ITS,[ + TSOPEN CHTTYI,[[%TIFUL+40,,'TTY]] ;INITIALIZE TTY. + TSOPEN CHDPYO,[[%TJCTN+%TJDIS+.BAO,,'TTY]] ;BLOCK OUTPUT FOR DISIOT. + TSOPEN CHECHO,[[%TJECH+%TJPP2+.UAO,,'TTY]] ;ECHO MODE OUTPUT. + TSOPEN CHECDS,[[%TJECH+%TJPP2+%TJCTN+%TJDIS+.UAO,,'TTY]] ;FOR FS ECHO DISPLAY$. + TSOPEN CHSIO,[[%TJSIO+%TJCTN+.UAO,,'TTY]] ;SUPER-IMAGE OUTPUT. + TSOPEN CHTTYO,[[%TJCTN+.UAO,,'TTY]] ;NORMAL TYPE OUT. +] + SETZM DISSAI ;DEFAULT IS DON'T PRINT SAIL CHARACTERS. + PUSHJ P,SETTTM ;SET UP RGETTY, STTYS. + MOVEM CH,RGETTY + MOVEM CH,VERBOS ;LONG ERR MSGS DEFAULT ON IFF DISPLAY TTY. +IFN ITS,[ + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['OSPEED] ? %CLOUT,,OSPEED] + SETZM OSPEED + MOVE A,OSPEED + CAIGE A,10 ;AVOID LOSING ON OLD ITS ON WHICH OSPEED IS A SPEED CODE. + SETZM OSPEED + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['SMARTS] ? %CLOUT,,TTYSMT] + SETZM TTYSMT + .CALL RSSB ;SET NVLNS, NHLNS, TTYOPT. + .VALUE + MOVE A,NHLNS +] +IFN TNX,[ +IFN 20X,[MOVEI A,.CTTRM + MOVEI B,.MORSP ;READ TTY'S SPEED + MTOPR + MOVEI C,(C) ;GET OUTPUT SPEED + CAILE C,9600. ;DONT GET CONFUSED BY NVT'S OR PTY'S + SETZ C, +] +IFN 10X,MOVEI C,2400. ;DEFAULT LINE SPEED FOR 10X + MOVEM C,OSPEED ;SAVE IT + MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL + HLRZ A,0(C) ;ENTRY 0 IS PAGE SIZE + MOVEM A,NVLNS ;NUMBER OF VERTICAL LINES + MOVE A,1(C) ;ENTRY 1 IS TTY OPTION BITS + MOVEM A,TTYOPT + HRRZ A,0(C) ;NUMBER OF HORIZONTAL LINES +] + CAILE A,MXNHLS ;MUST BE IN RANGE + MOVEI A,MXNHLS + MOVEM A,NHLNS + SETCM A,TTYOPT ;GET OPTION BITS FOR THIS TERMINAL + TLNE A,%TOOVR ;TTY CAN'T OVERPRINT => + SETZM DISPCR ;DON'T LET STRAY CR'S TRY TO DO SO. + TLNE A,%TOOVR+%TOMVB ;DON'T LET BS OVERPRINT IF TTY CAN'T BS. + SETZM DISPBS + TLNN A,%TOSA1 ;:TCTYP SAIL => WE SHOULD USE SAIL CHAR SET. + SETOM DISSAI + SETCA A, ;CAN'T ERASE SELECTIVELY => CAN'T USE DISPLAY FEATURES. + TLC A,%TOERS+%TOMVU + TLCE A,%TOERS+%TOMVU + CALL [MOVSI C,377777 ;WE SHOULD NEVER DO --MORE--, + MOVEM C,NVLNS +IFN ITS,[ MOVSI C,%TSMOR ;SYSTEM SHOULD DO **MORE** PROCESSING. + ANDCAM C,TTYSTS + ] + SETZB C,RGETTY ;ALSO PRETEND TO BE PRINTING TTY. + TLNN A,%TOOVR + SETOM BSNOLF ;ON GLASS TTY, PULL VARIOUS OVERPRINT-ERASE HACKS. + RET] + SETZM CHCTVP + SETZM CHCTCF + SETOM DWAIT + MOVE C,OSPEED ;SET DWAIT IF TTY'S SPEED IS KNOWN TO BE 600 BAUD OR LESS. + CAIG C,600. + SKIPN C + SETZM DWAIT + LDB C,[.BP (%TOLID),A] + MOVEM C,LID ;IF TTY CAN INSERT/DELETE LINES, DEFAULT IS TO USE THEM. + LDB C,[.BP (%TOCID),A] + MOVEM C,CID ;LIKEWISE CHAR I/D +IFN TNX,[ + CAIE CH,17 .SEE C100 + CAIN CH,21 .SEE VT100 ;UNTIL THE RIGHT %TO BIT DEFINED + MOVNS LID ;HACK SCROLL REGION FOR MOVING TEXT RIGHT + LDB C,[.BP (%TOFCI),A] ;CAN IT GENERATE BONA FIDE HIGH ORDER BITS? + MOVEM C,FCITYI ;YES, DONT MISTAKE THEM FOR PARITY THEN +] + MOVE C,NVLNS + IDIVI C,6 ;COMPUTE # ECHO LINES. + CAIGE C,3 + MOVEI C,3 + SKIPN RGETTY ;NO ECHO LINES ON PRINTING TTERMINALS. + SETZ C, + CALL FSECL1 ;AND SET THAT MANY. + SKIPE RGETTY + JRST ECHOCR + RET + +SUBTTL ECHOING CONTROL + +IFN ITS,[ +;REINITIALIZE TTYSTS, TTYST1, TTYST2; +;TURN ON ECHOING, AND SET ECHOFL TO INDICATE THAT WAS DONE. +SETTTM: .CALL RTTYS1 + .VALUE + MOVE TT,TTYST1 + MOVE TT1,TTYST2 + ANDCM TT,[202020,,202020] ;HAVE ECHOING ON IFF + ANDCM TT1,[202020,,202020] ;FS ECHOLINES $ IS >=0. + SKIPL NELNS + IOR TT,[202020,,202020] + SKIPL NELNS + IOR TT1,[202020,,200020] + TLO Q,%TSCLE+%TSACT+%TSMOR + SKIPN RGETTY + TLZ Q,%TSMOR + .CALL STTYS1 + .VALUE + SETOM ECHOFL + TLZ Q,%TSINT+%TSSAI + MOVEM Q,TTYSTS + RET + +TTYAC2: HRROS (P) + CAIA +TTYAC1: HRRZS (P) +TTYAC4: SAVE Q + SAVE TT + SAVE TT1 + SAVE CH + .CALL RTTYS1 + .LOSE %LSFIL + TLZ Q,#%TSSAI + IOR Q,TTYSTS + SKIPGE CH,-4(P) + TLO Q,%TSINT + .CALL STTYS1 + .LOSE %LSFIL + REST CH + REST TT1 + REST TT + JRST POPQJ + +RSSB: SETZ + SIXBIT /CNSGET/ + %CLIMM,,CHDPYO + %CLOUT,,NVLNS + %CLOUT,,NHLNS + %CLOUT,,TT ;TCTYP + %CLOUT,,TT ;TTYCOM + 400000+%CLOUT,,TTYOPT + +RTTYS1: SETZ + SIXBIT \TTYGET\ + %CLIMM,,CHTTYI + %CLOUT,,TT + %CLOUT,,TT1 + %CLOUT,,Q + %CLOUT,,CH + 400000+%CLOUT,,CH ;TCTYP VARIABLE + +STTYS1: SETZ + SIXBIT \TTYSET\ + %CLIMM,,CHTTYI + TT + TT1 + SETZ Q +] + +IFN TNX,[ + ; DO INITIAL SETUP +SETTTM: SAVE C + MOVSI A,.TICCG ; ^G ON CHANNEL 0 + SKIPG NOQUIT ; UNLESS QUIT NOT ALLOWED + ATI + CALL DOSTIW ; SETUP TERMINAL INT MASK + MOVEI 1,.PRIIN + GTTYP ; GET TERMINAL TYPE + MOVEM B,SGTTYP ; SAVE TYPE FOR DPYRST + CAMN 2,[SIXBIT /4023/] ; BBN'S WAY OF DOING TTY TYPES + MOVEI 2,TK4023 + CAME 2,[SIXBIT /4024/] ; SAME THING AS 4025 + CAMN 2,[SIXBIT /4025/] + MOVEI 2,TK4025 + CAMN 2,[SIXBIT /HP/] + MOVEI 2,HP2645 + MOVE CH,TTYTYP(2) ; GET TERMINAL TYPE DISPATCH + RFMOD ; GET TTY MODE WORD + SKIPE CH ; PRINTING? + TRZA 2,TT%DAM ; NO, BINARY MODE THEN + TRO 2,1_6\TT%ECO ; YES, MAKE SURE DATA MODE NORMAL + SFMOD +IFN 20X,[ + SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON? + JRST .+4 ; YES, DONT MESS WITH IT + JUMPE CH,SETTM1 + TRZE 2,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY + STPAR +] +SETTM1: SETOM ECHOF2 ; ASSUME ECHO + SKIPE RGETTY ; PRINTING TTY'S ECHO FOR THEMSELVES + SKIPGE NELNS ; FS ECHOLINES >= 0 ? + SETZM ECHOF2 ; NO, ECHO OFF + SETOM ECHOFL ; SAY WE DID SOMETHING + JUMPN CH,POPCJ ; DONE UNLESS PRINTING + MOVE B,[.BYTE 2 ? 1 ? 1 ? 1 ? 0 ? 1 ? 1 ? 1 ? 2 ? 2 ? 3 ? 2 ? 1 ? 1 ? 2 ? 1 ? 1 ? 1 ? 1] +IFN 10X,MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 3] +.ELSE MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 1] + SFCOC + JRST POPCJ ; AND RETURN +] ;TNX + + +;TURN OFF ECHOING. +NOECHO: SETZM ECHOFL +IFN ITS,[ + SYSCAL TTYSET,[%CLIMM,,CHTTYI + [020202,,020202] ;NOTHING ECHOES, EVERYTHING ACTIVATES, + [030202,,120202] ] ;^G INTERRUPTS, CR OUTPUT IN IMAGE MODE. + .LOSE %LSFIL +] +IFN TNX,[ + SETZM ECHOF2 ;SAY DONT ECHO THINGS FOR DISPLAY TERMINAL + SKIPE RGETTY + RET + MOVEI A,.PRIOU + RFMOD + TRZ B,TT%ECO ;TURN OFF ECHOS ON PRINTING TERMINAL + SFMOD +] + RET + +SUBTTL TERMINAL INPUT + +;READ A CHARACTER FROM THE TTY. +TYI: CALL TYINH +TYIH: CAIN CH,TOP+"H ;IS THIS THE "HELP" KEY? +TYIURH: SKIPN HELPMAC ;YES, IS THERE A HELP MACRO? + RET ;JUST RETURN THE CHARACTER + CALL [ CALL SAVACS ;PRESERVE ACS AND CURRENT TECO VALUES. + MOVE A,HELPMAC + CALL MACXCP + JRST RSTACS] + SKIPN RREBEG ;IF FS HELPMAC$ RUN INSIDE ^R, RETURN FROM TYI SO THAT + RET ;RRLP1 CAN GO TO RRLP AND MAKE SPACE REDISPLAY THE SCREEN. + JRST TYI ;AFTER RUNNING FS HELP$, TRY AGAIN TO READ A CHARACTER. + +TYIW0: CALL TYIWN0 ;DONT CHECK STOPF, BUT DO UNREAD AND HELP CHAR + JRST TYIH + +;READ CHARACTER, CHECK FOR AND STANDARDIZE HELP CHARACTER, BUT DONT RUN HELP MACRO +TYINH: SKIPGE STOPF + CALL QUIT1 +TYIWN0: MOVE CH,UNRCHC ;GOBBLE ANY UNREAD CHARACTER. + SETOM UNRCHC + JUMPGE CH,CPOPJ + SKIPE TYISRC ;IF THERE IS A "TYI SOURCE", CALL IT. + JRST [ PUSH P,[TYIWN0] + CALL SAVACS + MOVE A,TYISRC ;SINCE IT CAN'T RETURN A VALUE UNCLOBBERED, + CALL MACXCP ;IT SHOULD SET FS REREAD$ TO THE CHARACTER. + JRST RSTACS] ;AND WE RETURN TO TYIWN0 TO GOBBLE IT. + SKIPGE CLKFLG + CALL RLTCLK +IFN ITS,TYIIOT: .IOT CHTTYI,CH +IFN TNX,[ + EXCH A,CH + PBIN +TYIIOT: SKIPN RGETTY ;ON PRINTING TERMINAL +IFN 10X, CAIE A,37 ;ON 10X CONVERT 37 TO CR +IFN 20X, CAIE A,^M ;ON 20X, AFTER A CR, + JRST TYI5 +IFN 20X,PBIN ;FLUSH THE LF + MOVEI A,^M +TYI5: EXCH A,CH + SKIPN FCITYI ;ARE HIGH ORDER BITS PARITY BITS? + ANDI CH,177 ;YES, MASK THEM OFF (SOME TERMINALS GENERATE PARITY) + TRZE CH,200 ;CONVERT EDIT TO META AT LOWEST LEVEL + TRO CH,META + SKIPE ECHOF2 + CALL ECHOCH ;ECHO IT IF REQUESTED, AND SYSTEM DIDN'T ECHO IT. +] + AOS INCHCT ;BUMP COUNT OF INPUT CHARACTERS READ SO FAR. + ANDI CH,777+TOP + CAME CH,HELPCH ;TURN OUR HELP CHARACTER INTO TOP-H. + JRST TYI6 + CALL TYI4 + MOVEI CH,TOP+"H + RET + +TYI6: SKIPE DISPRR ;WHEN OUTSIDE OF ^R, + JRST TYI7 + CAIN CH,33 ;DETECT ALTMODE-ALTMODE. + CAME CH,LTYICH + JRST TYI2 + SOSGE TSALTC ;FOUND ONE! DECREMENT COUNT OF PAIRS REMAINING TO BE READ. + AOS TSALTC +TYI7: HRLI CH,-1 ;MAKE SURE 2ND ALTMODE OF PAIR CAN'T COUNT AS FIRST OF ANOTHER. +TYI2: MOVEM CH,LTYICH + ANDI CH,#META#CONTRL ;TURN ASCII CTL CHARS INTO 9-BIT ONES, + CAIE CH,^M + CAIG CH,^J ;EXCEPT FOR ^H, ^I, ^J, ^M AND ALTMODE. + CAIGE CH,^H + CAIN CH,33 + JRST TYI3 + TRNN CH,TOP+140 ;ALSO, DON'T ALTER THINGS WHICH HAVE THE "TOP" BIT. + IORI CH,CONTRL+100 +TYI3: IOR CH,LTYICH ;NOW RESTORE THE CONTROL AND META BITS, AND FLUSH TOP. + ANDI CH,CONTRL+META+177 +TYI4: IDPB CH,TYIBFP ;RECORD THE INPUT CHARACTER IN THE RING BUFFER FOR SUCH. + CALL TYI1 + SKIPN TYISNK ;INVOKE FS TYIMACRO$ IF THERE IS ONE + RET + CALL SAVACS + MOVE C,CH ;WITH THE CHARACTER AS ARGUMENT. + MOVE A,TYISNK + CALL MACXCP + JRST RSTACS + + +FSTBNXT:ILDB A,TYIBFP ;FS .TYINXT$: GET NEXT OLD TYI CHARACTER. + AOS (P) +TYI1: EXCH CH,TYIBFP + CAMN CH,[001400,,TYIBUF+TYIBSZ-1] + SUBI CH,TYIBSZ + EXCH CH,TYIBFP + RET + +;CONVERT CHAR. IN CH FROM TV CHAR SET TO ASCII. +TYINRM: TRZ CH,META ;CONTROL-^-MUMBLE JUST BECOMES ^-MUMBLE. + TRZN CH,CONTRL + RET + CAIN CH,177 + RET ;CONTROL-RUBOUT SHOULD BE RUBOUT, NOT "?". + CAIE CH,40 ;CONTROL-SPACE IS ^@. + TRZE CH,100 ;NOTE TV CHAR SET HAS CONTROL-LOWERCASE LETTERS! + ANDCMI CH,40 ;THEY SHOULD CONVERT JUST LIKE CONTROL-UPPERCASE LETTERS. + RET + +SUBTTL PURIFY + +IFN ITS,[ +;DUMPIT$G TO DO $Y THEN PURIFY, WITH THE BONUS THAT IT REFUSES +;TO WORK ON A TECO THAT HAS BEEN RUN. +DUMPIT: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /Y +P/] + +;PURIFY$G TO MAKE PURE THE PAGES THAT ARE SUPPOSED TO BE PURE. +PURIFY: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /B P/] + MOVEI P,PDL + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A] + .LOSE %LSFIL + SETOM PUREFL + MOVE A,[.FNAM2] + .VALUE [ASCIZ \ +A/ ..UFILE+2/ 1Q +..UFILE+3/ 1'.TECO. +..UFILE+1/ 1'TECPUR +:Purified + +:PDUMP\] + JRST INIT +] + +IFN TNX,[ +PURIFY: SKIPE RUNFLG + .VALUE + SETOM PUREFL + HLRE 2,116 ;BLT OUT THE SYMBOL TABLE + AOS 1,116 ;FIRST ADDRESS OF SYMBOLS+1 + HRLI 1,-1(1) + SETZM -1(1) ;ZERO IT OUT + SUBI 2,(1) ;GET LAST WORD OF THEM + MOVM 2,2 + BLT 1,(2) ;AND ZERO THE REST OF THEM + SETZM 116 ;ZERO POINTER TOO FOR DDT + + MOVEI 1,.FHSLF + MOVE 2,[3,,BOOT] + SEVEC ;SET UP OUR ENTRY VECTOR + + MOVSI 1,(GJ%SHT) +RADIX 10. +IFN 10X,HRROI 2,[STRCNC [TECO.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECO.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%CPY+SS%RD+SS%EXE+<-600,,0>] + SETZ 3, + SSAVE + ERJMP PFYERR +RADIX 10. + MOVSI 1,(GJ%SHT) +IFN 10X,HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%RD+SS%EXE+] + SSAVE + ERJMP PFYERR + JRST INIT + +PFYERR: MOVEI 1,.PRIOU ;ERROR WHILE PURIFYING, GIVE THE PERSON A HINT WHAT HAPPENED + HRLOI 2,.FHSLF ;LAST ERROR THIS PROCESS + SETZ 3, + ERSTR + JFCL + JFCL + .VALUE +] ;IFN TNX + +SUBTTL SUBROUTINES FOR COMMAND STREAM CHARACTER READER RCH + +;COME HERE ON TRYING TO READ PAST THE END OF A COMMAND STRING LEVEL. +RCH2: SAVE A ;POP OFF MACRO FRAME + SETZM COMCNT ;DON'T LET COMCNT BE -1 -- WOULD SCREW IF ERROR HANDLER DOES BACKTRACE. + SKIPN A,MACPTR ;0 MEANS TRIED TO POP OUT OF TOP-LEVEL + JRST INSCHK +RCH2A: CALL ERSTST ;REFUSE TO POP OUT OF MACRO CONTAINING UNTERMINATED "<" OR ":<". + LDB CH,MACPDP ;TRY TO POP MACPDL ENTRY FOR THE MACRO-CALL. + TRNE CH,10 + JRST RCH2B ;TOP OF MACPDL ISN'T A MACRO-CALL ENTRY! + HRRE A,(A) + JUMPGE A,RCH2D ;ARE WE POPPING OUT OF A MACXQ (MIDAS TO TECO CALL)? + HRRZ A,-1(P) ;YES, ONLY ALLOWED FROM COMMAND LOOP. + CAIE A,CDRCH + JRST INSCHK ;INSIDE A COMMAND => ERROR. +RCH2D: MOVE A,MACPTR + CALL DECDCH ;IT IS ONE, RESTORE RCHALT AND SQUOTP AS IT SAYS. + CALL POPMAC ;POP THE MACRO-STRING-FRAME. + CALL POPMP ;ACTUALLY DEECREMENT MACPDP. +RCH2C: REST A + SKIPL MACPTR ;ARE WE POPPING OUT OF A MACXQ? + JRST RCH ;NO, TRY AGAIN, READ FROM WHAT WE POPPED INTO. + MOVE CH,MACXP ;YES, RESTORE PDL LEVEL TO THAT AT + POP CH,MACXP ;CALL TO MACXQ, AND PREPARE TO RETURN. + POP CH,MACPTR + JRST SETP1 ;SET P FROM CH AND ADJUST LEV. + +RCH2B: CAIN CH,10 ;A NULL ENTRY? FLUSH IT AND TRY AGAIN. + JRST [CALL POPMP ? JRST RCH2A] + MOVEI CH,4 ;[ ;CAN'T POP SINCE ^]^X'D INTO, + MOVEM CH,COMCNT ;[ ;INSTEAD ^]^X UP ANOTHER LEVEL. + MOVE CH,[BP7,,[ASCIZ//]] + MOVEM CH,CPTR + MOVEM CH,CSTR + SKIPGE MACPTR ;I THINK TECO LOSES IF IT USES UP + .VALUE ;[ ;ALL OF A MACXQ'D STRING WITH A ^]^X. + JRST RCH2C + +;THE RCHDTB ENTRY FOR THE CASE SHIFT CHAR IS +RCHSFT: SKIPN MACPTR ;IN MACRO, CASE SHIFT ISN'T SPECIAL. +RCHSF1: SKIPE RCHSFF ;IF PREV. CHAR WAS SHIFT, THIS ONE IS QUOTED. + POPJ P, ;PRETEND NOT TO BE A CASE-SHIFT. + MOVNS CASE ;ELSE ASK TO READ NEXT CHAR IN THE OTHER CASE, + MOVE CH,-1(P) ;GET RET. ADDR OF READ RTN, + SETOM RCHSFF ;QUOTE NEXT CHAR IF CASE-SHIFT OR LOCK. + XCT -1(CH) ;RE-CALL THE READ RTN. (TRACES IF NEC) + MOVNS CASE ;RESTORE CASE TO WHAT IT HAD BEEN. + SETZM RCHSFF +POP1J: SUB P,[1,,1] ;RETURN FROM THE CALL TO RCH + POPJ P, ;SINCE CHAR WAS ALREADY TRACED. + +RCHLOK: SKIPN MACPTR ;RCHDTB ENTRY FOR CASE-LOCK CALLS HERE.. + SKIPE RCHSFF ;IF IN MACRO OR QUOTED BY A CASESHIFT, + POPJ P, ;DO NOTHING SPECIAL. + MOVNS CASE ;ELSE SWITCH THE CASE WE WANT CHARS IN, +RCHTRY: SUB P,[1,,1] + REST CH + JRST -1(CH) ;AND GO READ THE NEXT CHAR. + +;OUTPUT CHARACTER IN CH WHOSE EXECUTION IS TRACED. +.SEE TRACS ;TRACS CONTAINS JRST TYOS WHEN TRACING IS ON. +;CLOBBERS NO ACS. +TYOS: SKIPE BRC1 + RET + SAVE Q + SAVE CH + SETOM TRCOUT + PUSHJ P,TYO + MOVE CH,(P) + CAIE CH,^M ;DON'T MAKE CR COME OUT AS ^M. + PUSHJ P,DISFLS + SETZM TRCOUT + REST CH +POPQJ: REST Q + RET + +;COME HERE IF POP OUT OF MACXQ'D OR TOP-LEVEL STRING IN THE MIDDLE OF A COMMAND. +INSCHK: SKIPN INSINP ;IF WITHIN AN INSERT, WE COULD JUST ERR OUT + TYPRE [CNM] + MOVE P,INSINP ;BUT THAT WOULD LOSE THE STUFF INSERTED SO FAR. + SETZM INSINP ;SO TELL INSDUN TO DO THE CNM ERROR + JRST INSDUN ;AND CAUSE INSERT TO FINISH UP. + +SUBTTL MACRO FRAME ALLOCATION + +;FREE UP A CELL OF MACRO CALL SPACE. +;A -> 1ST WD OF CELL, MINUS 1. +FLSFRM: ANDI A,-1 ;MAKE SURE NO GARBAGE BLOCK IS PUT ON THE FRAME FREELIST. + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + SETZM MFCPTR+1(A) + SETZM MFBEG+1(A) + EXCH CH,MFFREE + MOVEM CH,MFLINK+1(A) + MOVE CH,MFFREE + HRRZM A,MFFREE + POPJ P, + +;OBTAIN A FREE CELL OF MACRO CALL CELL SPACE. +;RETURN POINTER TO WD BEFORE 1ST WD OF CELL, IN A. +GETFRM: SKIPG A,MFFREE + JRST GETFR1 + ANDI A,-1 + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + MOVE A,MFLINK+1(A) + EXCH A,MFFREE + POPJ P, + +GETFR1: CALL GCNRL ;GC, PERHAPS FREEING FRAMES USED BY BUFFERS. + SKIPE MFFREE + JRST GETFRM ;ONE WAS FREED. + CALL GETFR2 + JRST GETFRM + +GETFR2: CALL SAVACS ;MAKE MFINCR MORE MACRO FRAMES, + SAVE TOTALC + MOVE A,MFEND ;UNLESS WE ALREADY HAVE THE MOST WE ARE ALLOWED TO HAVE. + CAILE A,MFSTRT+*MFBLEN + TYPRE [TMN] + MOVEI C,MFINCR*MFBLEN*5 ;NUMBER OF CHARS WORTH OF SPACE WE WILL ALLOCATE. + CALL SLPQGT ;MAKE SURE IMPURE STRING SPACE HAS ROOM TO MOVE UP THAT FAR. + HRRZ BP,CBUFLO + IMULI BP,5 + MOVE TT,QRWRT ;GET START AND END OF RANGE OF CORE TO MOVE UP, IN CHARS. + HRRZ CH,INSBP ;NOTE THAT IF A STRING IS NOW BEING WRITTEN JUST PAST QRWRT, + ADDI CH,1 ;IT MUST BE INCLUDED IN RANGE TO MOVE. + IMULI CH,5 + CAML CH,BFRBOT + JRST GETFR7 + CAMGE TT,CH + MOVE TT,CH +GETFR7: MOVEI C,MFINCR*MFBLEN ;GET NUMBER OF WORDS TO MOVE UP BY. + CALL SLPN0Q + SAVE E + MOVE A,MACPTR + CALL GETFR5 ;RELOCATE ALL BYTE POINTERS IN MACRO, CTX AND ITERATION FRAMES. + MOVE A,CTXPTR + CALL GETFR5 + MOVE A,ITRPTR + CALL GETFR5 + CAML D,CSTR ;IF CPTR IS A B.P. TO A STRING, RELOCATE IT. + ADDM C,CPTR + REST E + ADDM E,QRBUF ;ADD # CHARS MOVED BY (SET BY SLPN0Q) TO + ADDM E,QRWRT ;BOUNDS OF IMPURE STRING SPACE. + MOVE D,BFRBOT + IDIVI D,5 + HRRZ E,INSBP + CAIL E,@CBUFLO ;IF INSBP IS IN THE COMMAND BUFFER OR IMPURE STRING SPACE, + CAMLE E,D ;RELOCATE IT. + JRST GETFR4 ;(THESE TESTS EXCLUDE THE SPECIAL VALUES, 0 AND -1). + ADDM C,INSBP +GETFR4: ADDM C,CBUFLO + ADDM C,CBUFH ;UPDATE BOUNDS OF COMMAND BUFFER. + MOVE A,MFEND + ADDB C,MFEND ;MARK ADDITIONAL SPACE AS IN USE BY MACRO FRAMES. + SOS A +GETFR3: CALL FLSFRM ;NOW "FREE" ALL THE NEWLY ALLOCATED FRAMES SO THEY CAN BE USED. + ADDI A,MFBLEN ;NOTE THAT THE ARG TO FLSFRM MUST BE THE FRAME ADDR MINUS 1. + CAIE A,-1(C) + JRST GETFR3 + REST TOTALC + JRST RSTACS + +;IF A POINTS TO THE START OF A LIST OF MACRO FRAMES, +;RELOCATE THOSE MFCPTR'S OF FRAMES IN THE LIST WHICH POINT AT STRINGS. +;C IS THE AMOUNT TO RELOCATE BY. +GETFR5: MOVE D,QRWRT + TLO D,400000 ;D GETS THE LARGEST NUMBER WHICH IS A STRING POINTER. + MOVE E,MACXP ;IF THIS LIST IS MACPTR, IT MAY HAVE POINTERS THRU THE STACK. +GETFR6: JUMPE A,CPOPJ ;EXIT ON REACHING END OF LIST. + CAML D,MFCSTR-MFLINK(A) ;RELOCATE THE CPTR IF THE CSTR INDICATES THAT THE CPTR + ADDM C,MFCPTR-MFLINK(A) ;POINTS INTO AN IMPURE STRING. + HRRE A,MFLINK-MFLINK(A) ;NOTE THAT A POINTS AT THE MFLINK WORD, NOT THE START OF THE FRAME. + JUMPGE A,GETFR6 ;NOW ADVANCE TO THE NEXT FRAME IN THE LIST. + MOVE A,-1(E) ;BUT MAYBE ADVANCE DOWN A LINK MADE BY A MACXQ CALL. + MOVE E,(E) + JRST GETFR6 + +;[ +SUBTTL ^] + +;[ ;THE RCHDTB ENTRY FOR ^] IS +;NOTE THIS CAN RETURN TO THE CALLING PUSHJ, TO RETRY IT. +CTLBRC: JUMPL CH,TRACS + SKIPGE SQUOTP + JRST TRACS + CALL TRACS + SETZM BRC1CF + SETZM BRCUAV + SETOM DLMF2 + SETZM SQUOF2 +BRCREC: SKIPG COMCNT + TYPRE [UEC] + SOS COMCNT + ILDB CH,CPTR + CALL TRACS +BRCRC2: INSIRP PUSH P,A B TT TT1 BP ;BP MUST BE LAST - SEE EXPMAC. + SETZ A, + PUSHJ P,QNMGE2 + JRST QLET + SKIPE BRC1 + JRST BRCRT5 + CALL QLGET + JRST BRCNVL + JRST EXPMAC + +QLET: SKIPE A + TYPRE [IQN] +INSIRP POP P,BP TT1 TT B A ;[ + CAIE CH,^] + CAIN CH,ALTMOD + JRST BRCPRT + CAIN CH,"$ + JRST RET33 + CAIN CH,^Q + JRST BRCCTQ + CAIN CH,^T + JRST BRCCTT + CAIN CH,^S + JRST BRCCTS + CAIN CH,^A + JRST BRC1CH + CAIN CH,^V + JRST BRCCTV + SKIPE BRC1 + JRST BRCRC3 + CAIN CH,"@ + JRST BRCIND + CAIN CH,^X + JRST BRCCTX + CAIN CH,^Y + JRST BRCCTY + TYPRE [ICB] + +BRCRC3: CAIN CH,"@ + JRST BRCREC + CAIE CH,^X + CAIN CH,^Y + JRST BRCRT + TYPRE [ICB] + +BRCCTS: SETOM SQUOF2 + SETOM DLMF2 + JRST BRCREC + +BRCCTT: SETZM DLMF2 + JRST BRCREC + +BRC1CH: SETOM BRC1CF + JRST BRCREC + +BRCIND: SAVE [BRCREC+1] + JRST BRCREC ;CALL BRCREC, THEN GO TO BRCRC2. + +BRCCTV: SETOM BRCUAV + JRST BRCREC + +BRCNVL: SKIPN BRCUAV + TYPRE [QNS] + SETOM BRCFLG + INSIRP POP P,BP TT1 TT B + MOVE CH,A + HRROM A,BRCUAV ;LEAVE UNTRUNCATED VALUE FOR QNMGET. + ANDI CH,177 + CALL TRACS + SKIPE SQUOF2 + HRLI CH,-1 + JRST POPAJ + +BRCCTQ: CALL SKRCH +BRCPRT: HRLI CH,-1 ;RETURN THE CHARACTER SUPERQUOTED. + POPJ P, + +;SET SQUOTP ACC TO SQUOF2, DLMF2 AND TURN OFF RCHALT. +;ALSO SAVE OLD STATE OF THOSE VARS AS BITS IN CH FOR PUSHING ON MACPDP +FLGENC: SETZ CH, + SKIPE DLMF2 ;SET SQUOTP ACC. TO SQUOF2, DLMF2 + TLO CH,2^5 + SKIPE SQUOF2 + TLO CH,4^5 ;AND SET CH ACC TO PREVIOUS SQUOTP AND RCHALT + EXCH CH,SQUOTP + IORM CH,SQUOTP + ROT CH,2 .SEE MACPDP ;SET UP CH AS A MACPDL ENTRY + ADDI CH,1 + HLRZ A,RCHALT + CAIN A,(CALL) + ADDI CH,4 + MOVEI A,(JFCL) ;ALSO TURN OFF RCHALT. + HRLM A,RCHALT + POPJ P, + +DECDCH: TRNN CH,3 + POPJ P, ;THIS ENTRY DIDN'T PUSH SQUOTP, RCHALT. + SUBI CH,1 + DPB CH,[420200,,SQUOTP] + TRNN CH,4 + SKIPA CH,[(JFCL)] + MOVEI CH,(CALL) + HRLM CH,RCHALT + POPJ P, + +;A HAS STRING OBJECT, B HAS LENGTH, BP HAS POINTER TO IT. +;PUSH A CALL TO THAT OBJECT ONTO THE RCH INPUT STREAM. +;NOTE TOP OF PDL HAS VALUE THAT WAS IN BP WHEN RCH WAS CALLED. +EXPMAC: SETOM BRCFLG + MOVE BP,(P) ;SAVE BP, AND GET OUR CALLER'S BP. + CALL PUSMA0 ;PUSH MACRO PDL, RELOCATING BP IF BUFFERS MOVE. + MOVEM BP,(P) ;GIVE CALLER'S BP BACK TO HIM, RELOCATED IF NEC. + CALL QLGET0 ;REDECODE ADDR OF STRING (MAYBE PUSMA0 MADE FRAMES AND CHANGED IT). + SKIPE BRC1CF + MOVEI TT,1 + MOVEM A,CSTR + MOVEM BP,CPTR + SKIPE BRC1CF ;IF WANT WHOLE STRING, + CAMLE TT,B ;OR IF WANT MORE CHARS THAN STRING HAS, + MOVE TT,B ;USE STRING LENGTH RATHER THAN DESIRED # CHARS. + MOVEM TT,COMCNT + MOVE B,PF + MOVEM B,MACSPF + SETZM MACBTS ;[ ;THERE ARE NO ARGS IN A ^] CALL. + SETZ CH, ;IF NOT SETTING ANY FLAGS, PUSH 0 ON MACPDL. + SKIPN SQUOF2 + SKIPE DLMF2 + CALL FLGENC ;ELSE COMPUTE WHAT TO PUSH. + IDPB CH,MACPDP +BRCRT5: INSIRP POP P,BP TT1 TT B +BRCRT4: REST A +BRCRT: REST CH + JRST -1(CH) ;RETRY THE RCH. + +RET33: MOVEI CH,ALTMOD + POPJ P, + +;[ ;PERFORM A PUSH INTO A ^]^X. +BRCCTX: SKIPE BRC1CF + JRST BRCCTY + SETOM BRCFLG + PUSH P,A + HRRZ A,-2(P) + CAIE A,BCYRCH+1 ;[[ ;IF THE ^]^X WAS IN THE CHARACTER THAT A ^]^Y WAS TRYING TO READ, + JRST BRCCX2 + PUSH P,RCHALT + HRLZI A,(JFCL) ;[ ;PERFORM A RECURSIVE ^]^Y, + HLLM A,RCHALT + PUSHJ P,BRCCTY + POP P,RCHALT ;[ ; WE HAVE ADVANCED PAST THE ^]^X IN THIS MACRO LEVEL. + CAIN CH,ALTMOD ;IF WHAT WE JUST GOT IS AN ALTMODE, THAT'S OK; RETURN IT. + JRST BRCRT4 + MOVE A,CPTR ;[ ;BUT OTHERWISE, THIS ^]^X HAS LONGER TO RUN, + PUSH P,CH ;[ ;SO WE MUST BACK UP OVER IT. +BRCCX1: DBP7 A + AOS COMCNT + LDB CH,A ;[ + CAIE CH,^] ;[ ;SO BACK UP UNTIL WE GET TO THE ^]. + JRST BRCCX1 + DBP7 A ;AND BACK UP ONE CHAR FURTHER. + AOS COMCNT + MOVEM A,CPTR + POP P,CH ;[ ;THEN RETURN THE THING WE GOT FROM THE RECURSIVE ^]^Y. + JRST POPAJ + +BRCCX2: CALL BRCCX0 + JRST BRCRT4 + +;[ ;PUSH INTO A ^]^X, AS A SUBROUTINE, NOT CALLED BY RCH. RETURNS WITH A NORMAL POPJ. +BRCCX0: PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC ;SET SQUOTP, GET OLD STATE IN CH. + ADDI CH,10 ;[ ;INDICATE PUSHED BY ^]^X, NOT MACRO CALL. + IDPB CH,MACPDP + MOVEI A,(CALL) + HRLM A,RCHALT ;[ ;START LOOKING FOR AN $ TO END ^]^X. + SKIPGE MACPTR ;[ ;TRYING TO ^]^X OUT OF A MACXQ => PHONY UP NULL ARG. + CALL ENDAR2 + RET + +ENDARG: MOVEM A,(P) + CALL ENDAR2 + JRST BRCRT4 + +ENDAR2: CALL ERSTST + LDB CH,MACPDP + TRNN CH,10 + JRST ENDAR1 ;[ ;POPPING ^]^X BUT MACPDP SAYS MACRO CALL. + CAIN CH,10 ;NULL ENTRY ON MACPDP? FLUSH IT. + JRST [CALL POPMP ? JRST ENDAR2] +ENDAR5: CALL DECDCH ;[ ;A ^]^X ENTRY, UNBIND SQUOTP AND RCHALT. + CALL POPMP ;AND REMOVE THE ENTRY FROM THE STACK. + JRST ENDAR4 + +ENDAR1: SAVE MACPDP +ENDAR3: CALL POPMP + CALL ERSTST + LDB CH,MACPDP ;[ ;LOOK DOWN MACPDP FOR A ^]^X ENTRY. + CAIG CH,10 + JRST ENDAR3 ;THE ENTRIES ABOVE MUST BE 0 OR 10 . + CALL DECDCH ;FOUND THE ENTRY, RESTORE SQUOTP. + MOVEI CH,10 ;REPLACE THE ENTRY WITH A NULL. + DPB CH,MACPDP + REST MACPDP +ENDAR4: CALL PUSMA0 + JRST POPCTX + +BRCCTY: SETOM BRCFLG + PUSH P,A ;HANDLE ^Y OR ^F^X. + PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC + ADDI CH,10 + IDPB CH,MACPDP + SKIPGE MACPTR ;IF OUR CALLER WAS MACHINE-LANGUAGE TECO, + SKIPA CH,[ALTMOD] ;DON'T TRY TO POP INTO IT; PHONY UP AN ALTMODE. +BCYRCH: PUSHJ P,RCH + SKIPGE SQUOTP + HRLI CH,-1 + SAVE CH + CALL ENDAR2 + REST CH + REST A + RET + +;F^K COMMAND FOR READING STRING ARGUMENTS: + +;DO F^K$. IF YOU WERE CALLED BY A MACRO, IT WILL ACT LIKE ;[ +; :I*^]^X$, GOBBLING A STRING ARG FROM THAT MACRO. +;OTHERWISE, IT ACTS LIKE M$*F^K HOOK*$$, +; WHICH SHOULD READ AN ARGUMENT FROM THE TERMINAL, PROMPTING. +; IF THE USER RUBS OUT PAST THE START OF THE ARGUMENT, +; M$*F^K HOOK*$ SHOULD EXIT FROM THE F^K'ING MACRO WITH -2FS BACK RETURN$. + +;:F^K RETURNS A NEGATIVE VALUE IF THE CURRENT MACRO'S CALLER WAS TECO INTERNAL CODE. +;IT RETURNS A NONNEGATIVE NUMBER IF THE CALLER WAS ANOTHER MACRO. + +;CALLING A MACRO WITH @M MAKES F^K WITHIN THAT MACRO BELIEVE THAT THE +;MACRO WAS CALLED FROM TECO INTERNAL CODE. + +FCTLK: SKIPN A,MACPTR + TYPRE [CNM] ;BARF IF NO CALLER AT ALL + HRRE A,(A) + MOVE T,MACBTS ;@M IS TREATED LIKE A CALL FROM INSIDE TECO. + TLNE T,MFBATSN + SETO A, + TRZE FF,FRCLN ;FOR :F^K, RETURN NEGATIVE IF CALLER IS TECO CODE. + JRST POPJ1 + JUMPL A,FCTLK1 ;NO COLON. JUMP IF CALLER IS ^R OR OTHER TECO CODE. + CALL FNOOP ;CALLER IS A MACRO. FLUSH . + MOVE A,CPTR ;BACK UP OVER THE ALTMODE, SO THAT IT WILL TERMINATE THE + DBP7 A ;ARG WHICH THE :I* WILL READ. + MOVEM A,CPTR + AOS COMCNT + SETZM SQUOF2 + SETOM DLMF2 + CALL BRCCX0 ;[ ;SIMULATE GOBBLING A ^]^X. DELIMITER PROTECT, BUT NO SUPERQUOTING. +FCTLK0: TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + MOVEI CH,A + MOVE OUT,[CALL RCH] + MOVEM OUT,INSRCH + AOS (P) + JRST PSI ;THEN SIMULATE A :I* AND RETURN ITS VALUE. + +FCTLK1: MOVEI A,[ASCIZ /FM*F HOOK*/] + HRLI A,440700 + MOVE BP,A + MOVEI B,14. ;THIS IS THE NUMBER OF CHARACTERS IN THAT ASCIZ STRING!! + REST T ;DISCARD RETURN ADDRESS, SINCE MAC2 WILL JUMP TO MAIN LOOP. + CAIN T,CDRET + .VALUE + JRST MAC2 ;[ ;WE CAN'T USE MACXQ, SINCE WE NEED TO HAVE ^]^X WORK THROUGH THIS. + +PUSMA0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSMAC + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSMAC + EXCH BP,INSBP + RET + +PUSMAC: SAVE A + PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,MACPTR] + PUSH A,... +TERMIN MOVEM A,MACPTR + AOS MACDEP + HLL A,MACBTS + HLLM A,(A) + JRST POPAJ + +POPMAC: SKNTOP MACPTR + TYPRE [CNM] +POPMA1:IRP ...,,[MACPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,MACPTR + HRLS MACPTR + HLLZM A,MACBTS + SOS MACDEP + RET + +PUSCX0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSCTX + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSCTX + EXCH BP,INSBP + RET + +PUSCTX: PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,CTXPTR] + PUSH A,... +TERMIN MOVEM A,CTXPTR + HLL A,MACBTS + HLLM A,(A) + POPJ P, + +POPCTX: SKNTOP CTXPTR + JRST [.VALUE ? JRST GO] +IRP ...,,[CTXPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,CTXPTR + HRLS CTXPTR + HLLZM A,MACBTS + RET + +;DECREMENT MACPDP. +POPMP: MOVE CH,MACPDP + ADD CH,[40000,,] + JUMPGE CH,POPMP1 + CAML CH,[440000,,] + SUB CH,[440000,,1] +POPMP1: MOVEM CH,MACPDP + POPJ P, + +;IF ABOUT TO POP MACPDP, MAKE SURE NOT POPPING +;OUT OF A LEVEL CONTAINING AN UNTERMINATED ERRSET OR ITERATION. +ERSTST: HRRZ CH,ITRPTR ;ADDR OF BLOCK FOR INNERMOST ERRSET OR ITERATION. + JUMPE CH,CPOPJ ;THERE IS NONE IN PROGRESS. + MOVE CH,MFMACP-MFBLEN+1(CH) ;GET THE MACPDP VALUE AT TIME IT WAS ENTERED. + CAME CH,MACPDP ;ARE WE POPPING THAT LEVEL? + RET + TSC CH,ITRPTR ;YES. WHICH IS IT - AN ERRSET OR AN ITERATION? + TRNN CH,-1 + TYPRE [ERP] ;AN ERRSET. + TYPRE [UTI] ;AN ITERATION. + +SUBTTL ERRORS + +;FE -- INSERT A "TECO ERROR" FILE IN THE BUFFER BEFORE PT. +;:FE -- INSERT A LIST OF NAMES OF FS FLAGS. +;FE -- INSERT IN BUFFER THE 3-LETTER CODE + ;AND MESSAGE ASSOCIATED WITH ERROR CODE +;^ FE$ -- RETURNS THE ERROR CODE ASSOCIATED WITH THE 3-CHAR + ;MESSAGE . +FECMD: TRZE FF,FRUPRW + JRST FECMU + MOVSI T,-LERTAB + MOVEI A,TYOM ;TYPEOUT INTO BUFFER AT PT. + HRRM A,LISTF5 + CALL GAPSLP + TRNE FF,FRCLN ;:FE - INSERT LIST OF FS FLAGS. + JRST FECMD3 + TRZN FF,FRARG + JRST FECMD2 ;NO ARG, INSERT A LINE FOR EACH ERROR. + MOVE A,C ;AN ARG (ERROR CODE) IS JUST A STRING, SO GET IT. +FECMD6: CALL QGET3 + JRST CRR1 + +FECMD2: SAVE PT ;SAVE CURRENT PT SO CAN SET UP INSLEN. +FECMD5: MOVE A,ERRTAB(T) + HRLI A,400000 ;MAKE STRING PTR TO NEXT ERROR MESSAGE. + SAVE T + CALL FECMD6 ;INSERT EACH ERROR MESSAGE IN THE BUFFER. + REST T + AOBJN T,FECMD5 + REST C ;C GETS OLD PT. + SUB C,PT + MOVNM C,INSLEN ;FKD WILL DELETE THE WHOLE TABLE. + RET + +FECMD3: MOVSI T,-FLAGSL +FECMD4: MOVE E,FLAGS(T) ;GET THE NEXT FLAG'S NAME + CALL TYPR ;AND TYPE IT OUT INTO BUFFER. + CALL CRR1 ;EACH NAME GOES ON A LINE. + AOBJP T,CPOPJ ;WHEN THRU, UNBIND LISTF5 AND DONE. + AOJA T,FECMD4 ;HANDLE NEXT FLAG NAME. + +;HANDLE ^ FE. +FECMU: CALL FSIXR ;READ ARG, MAKE SIXBIT WORD IN A. + JFCL + HLRZ C,A + MOVSI A,-LERTAB ;NOW SEARCH ERROR TABLE FOR THIS ERROR. +FECMU2: HLRZ TT,ERRTAB(A) + CAIE TT,(C) + AOBJN A,FECMU2 ;STOP WHEN FIND IT, OR AT END OF ERRTAB. + CAIN A,LERTAB ;IS IT THE END? + JRST NRET0 ;YES, NO SUCH ERROR MESSAGE, RETURN 0. + HRRZ A,ERRTAB(A) + HRLI A,400000 ;ELSE RETURN POINTER TO THE ERROR STRING. + JRST POPJ1 + +;ROUTINE FOR FS ERR$. +FSERR: MOVE A,LASTER + TRNN FF,FRARG + JRST POPJ1 ;READING ONLY - RETURN LAST ERROR'S CODE. + MOVEM C,LASTER + JRST DISTOE + +;FG -- MAKE A STANDARD ERROR REPORT (USEFUL IN ERROR HANDLER MACROS). +;IF ARG, PRINT STANDARD ERROR MESSAGE FOR THAT ERROR CODE. + ;AND IF ":", DO IT AT TOP OF SCREEN. + ;Q..H IS NOT CHANGED BY FG EVEN IF IT DOES TYPEOUT. +;IF "^", THROW AWAY TYPE AHEAD. +;IN ANY CASE, TYPE A BELL. +FGCMD: MOVE A,QRB.. + SAVE .QVWFL(A) + TRZE FF,FRARG + CALL FGCMDP + MOVE A,QRB.. + REST .QVWFL(A) + SKIPE ERRECH ;IF WE TYPED THE ERR MSG IN THE ECHO AREA, + SETZM ECHACT + TRZN FF,FRUPRW + JRST TYPBEL +IFN ITS,.RESET CHTTYI, +IFN TNX,[MOVEI A,.PRIIN ;CLEAR INPUT + CFIBF] + SETZM TSINAL + SETZM TSALTC + SETOM UNRCHC +TYPBEL: SKIPE TYISNK + HRRZM P,MODCHG ;IF CLEARING TYISNK, REMOVE "DEF" FROM EMACS MODE LINE. + SETZM TYISNK + SETZM TYISRC +IFN ITS,.IOT CHECHO,[^G] +IFN TNX,[SAVE A + MOVEI A,^G + PBOUT + REST A] + JRST FSECO6 + +FGCMDP: JUMPE C,CPOPJ ;THERE WS NO ERROR => DON'T PRINT ERROR MESSAGE. + TRZE FF,FRCLN + CALL [ SKIPN ERRECH + JRST DISTOT + SKIPGE PJATY ;IF SCREEN MUST BE REDISPLAYED, CLEAR IT NOW RATHER THAN + CALL DISIN0 ;AFTER THE ERROR MESSAGE IS PRINTED. + MOVEI CH,^M + JRST FSECO1] + MOVE D,VERBOS +FGCMD3: HRRZM P,ERRFL1 ;DON'T LET FS ERRFLG$ STOP THIS FROM PRINTING. + MOVEI A,TYOA + SKIPE ERRECH ;IF SPECIFIED, TYPE IN ECHO AREA. + MOVEI A,FSECO1 + HRRM A,LISTF5 + CALL FGCMD1 + MOVEI CH,"? + CALL @LISTF5 + SKIPE ERRECH + RET + CALL DISFLS + MOVE E,TOPLIN + SUB E,CHCTVP ;HOW MANY LINES WERE USED? + SOS E + MOVEM E,ERRFL1 ;MAKE SURE THOSE LINES AREN'T ERASED BY REDISPLAY. + RET + +FGCMD1: MOVE A,C ;PRINT CONTENTS OF STRING IN C. + CALL QLGET0 + RET +FGCMD2: JUMPE B,CPOPJ + ILDB CH,BP + CAIN CH,^I ;IF D IS ZERO, STOP AT FIRST TAB. + JUMPE D,CPOPJ + CALL @LISTF5 + SOJA B,FGCMD2 + +;HANDLE TOP-LEVEL ^X COMMAND: PRINT THE FULL EROR MESSAGE FOR THE LAST ERROR. +FECMD8: MOVE C,LASTER + SETO D, + JRST FGCMD3 + +;COME HERE TO REPORT SYSTEM CALL ERROR, ASSUMING THE FILE NAMES ARE IN DEFDEV, ETC. +IFN ITS,[ +OPNER1: .SUSET [.RBCHN,,CH] ;GET # OF CHANNEL IN ERROR, + LSH CH,27 + IOR CH,[.STATUS CH] + XCT CH ;READ THE ERROR CODE, + LDB CH,[220600,,CH] +OPNER4: SAVE CH ;ENTER HERE WITH ERRCODE IN RH(CH), TO PRETEND I.T.S GAVE AN ERROR. + HRLZS (P) + MOVEI C,70. ;WRITE A STRING CONTAINING FILENAMES AND I.T.S. ERROR MESSAGE. + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVSI E,'OPN + CALL SIXNTY ;FIRST IN THE STRING GOES "OPN" FOLLOWED BY 3-DIGIT ERROR CODE. + LDB CH,[.BP (700),(P)] + CALL DGPT + LDB CH,[.BP (70),(P)] + CALL DGPT + LDB CH,[.BP (7),(P)] + CALL DGPT + MOVEI CH,40 + REPEAT 2,XCT LISTF5 ;THEN 2 SPACES. + CALL LFILE ;THEN THE FILENAMES. + MOVEI CH,40 + REPEAT 3,XCT LISTF5 ;3 SPACES. + REST E + SYSCAL OPEN,[%CLIMM,,CHERRI ? ['ERR,,] ? %CLIMM,,3 ? E] + JRST .-1 +OPNER2: .IOT CHERRI,CH ;COPY INTO STRING, STOPPING AT CRLF OR FF. + CAIE CH,^M + CAIN CH,^L + JRST [.CLOSE CHERRI, + JRST OPNER3] + XCT LISTF5 + JRST OPNER2 +] + +IFN TNX,[ +OPNER0: MOVE A,OPNJFN + RLJFN + JFCL +OPNER1: MOVEI A,.FHSLF ;GET THIS FORKS LAST JSYS ERROR MESSAGE +IFN 10X,[MOVE C,[4,,BAKTAB+4] + BLT C,BAKTAB+10 ;GETER ON TENEX SMASHES 4-10 +] + GETER +IFN 10X,[MOVS C,[4,,BAKTAB+4] + BLT C,10 +] +OPNER4: PUSH P,2 ;ENTER HERE TO FAKE ERROR FROM 2 + MOVEI C,70. ;MAKE ENOUGH STRING SPACE + CALL QOPEN + MOVSI E,'OPN ;INSERT OPN + CALL SIXNTY + POP P,2 + LDB CH,[070100,,2] + CALL DGPT + LDB CH,[060300,,2] + CALL DGPT + LDB CH,[030300,,2] + CALL DGPT + LDB CH,[000300,,2] + CALL DGPT + MOVEI CH,40 ;AND TWO SPACES + REPEAT 2,XCT LISTF5 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT DEFAULTS + MOVEI CH,40 + REPEAT 3,XCT LISTF5 + MOVE A,[440700,,BAKTAB] + SETZ C, + ERSTR + JFCL + JFCL +IFN 10X,IDPB C,A ;STUPID 10X JSYS DOESNT MAKE ASCIZ + MOVEI A,BAKTAB + CALL ASCIND ;AND INSERT IT TOO +] +OPNER3: CALL QCLOSV ;NOW FINISH THE STRING'S HEADER, AND RETURN POINTER IN A. + MOVEM A,LASTER ;REMEMBER IT AS THE MOST RECENT ERROR'S CODE. + JRST DISTOE ;NOW GET CAUGHT BY ERRSET INVOKE ERROR HANDLER. + +;TYPR4 UUO (TYPRE MACRO) COMES HERE. +ETYP2A: HRRZ CH,@40 ;ERROR, AND IT CAN BE HANDLED NORMALLY; GET THE ERROR CODE. + HRLI CH,400000 + MOVEM CH,LASTER ;REMEMBER AS CODE OF MOST RECENT ERROR. + JRST DISTOE ;GET CAUGHT BY ERRSET OR POP. + +IMMQIT: SETOM IMQUIT ;ALLOW QUITS TO HAPPEN AT ANY TIME, + SKIPL STOPF ;AND QUIT IF ALREADY PENDING. + RET +QUIT0: ;CALL HERE IF STOPF IS SET, WHEN IT IS ACCEPTABLE TO QUIT. +QUIT1: SETZM ORESET ;RE-ALLOW TYPEOUT NOW THAT WE GOT THRU WITH THE COMMAND + SKIPLE NOQUIT + SKIPLE IMQUIT + CAIA ;NOQUIT POSITIVE => NO QUITTING AT ALL (UNLESS IMQUIT OVERRIDES) + RET + SETZM STOPF ;ELSE QUIT, AND CLEAR FLAG SAYING WE NEED TO QUIT. +IFN 20X,[MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] + CALL DISRST ;THROW AWAY ANYTHING IN DISBUF. + SKIPG IMQUIT ;IMQUIT POSITIVE ONLY AT STARTUP AND IN COMMAND READER + SKIPN NOQUIT ;IF QUITTING SHOULD GO TO TOP LEVEL, DO SO. + CAIA + TYPRE [QIT] ;NOQUIT NEGATIVE WANTS TO SIGNAL AN ERROR. + CIS ;CLEAR ANY INTERRUPTS IN PROGRESS. + SETOM RROVPO + CALL TYPBEL + SETZM ECHACT +IFN ITS,[.IOT CHECHO,["^] + .IOT CHECHO,["G] +] +IFN TNX,[MOVEI CH,"^ + CALL ECHOC1 + MOVEI CH,"G + CALL ECHOC1 +] + JRST GOX1 + +DELQIT: SETZM IMQUIT ;STOP ALLOWING QUITS INSIDE COMMANDS, AND EXIT. + RET + +;CALL HERE TO SIGNAL AN ERROR, AFTER SETTING LASTER. +;DISTOE RETURNS TO AN ERRSET IF THERE IS ONE; OTHERWISE, IT GOES TO +;GOX1 TO ENTER A BREAK LOOP, INVOKE THE ERROR HANDLER, OR POP TO ^R OR TOP LVL. +DISTOE: MOVE Q,PT ;ERROR CHECK: IS PT OUT OF BUFFER BOUNDS? + CAMG Q,ZV + CAMGE Q,BEGV + .VALUE + TRNN P,-1 + .VALUE + CIS + SKIPL ERRFLG ;WERE WE ALREADY INVOLVED IN STARTING TO HANDLE AN ERROR? + JRST DISTOW + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P ;YES; GIVE UP TRYING TO RECOVER AND POP ALL THE WAY UP, + PUSHJ CH,SETP ;SINCE TRYING TO HANDLE THIS ERROR NORMALLY WILL PROBABLY + ;CAUSE ANOTHER ERROR. + SETZM ERRFL1 ;PREVENT TYPEOUT OF THE MESSAGE FROM BEING SUPPRESSED. + CALL DISTOT + MOVEI CH,TYOA + HRRM CH,LISTF5 ;NOT CAUGHT BY ERRSET, PREPARE FOR TYPEOUT. + MOVEI A,[ASCIZ/ERROR WHILE ENTERING ERROR HANDLER! POPPING TO TOP LEVEL. +/] + CALL ASCIND + CALL ERESET + JRST CTLW + +DISTOW: SETOM ERRFLG + CALL ERESET + HLRZ Q,ITRPTR + JUMPE Q,GOX1 ;IF WITHIN AN ERRSET + HLRZ CH,MFPF-MFBLEN+1(Q) + HRRZ A,DISPRR ;WHICH HAS NO ^R INSIDE IT + SKIPE A + CAIG A,(CH) + JRST ERRP3 ;THEN THROW TO THE ERRSET. + JRST GOX1 ;ELSE GIVE TO THE ^R OR TO ERROR HANDLER. + +;COME WHEN ERROR IS CAUGHT BY ERRSET. +ERRP3: CALL UNWIND ;POP SOME STUFF OF MACRO PDL, ETC. + JRST ERRP4 ;DOESN'T SKIP IF HAVE FINISHED UNWINDING; CH = RH(ITRPTR) + JRST ERRP3 ;SKIPS 1 AFTER POPPING MACRO CALLED BY "M" CMD. + MOVE CH,MACXP + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SKIPS 2 AFTER POPPING A MACXQ OR MACXCW. + JRST ERRP3 + +ERRP4: HRROI Q,MFCSTR-MFBLEN+1(CH) + POP Q,CSTR ;POSITION AT THE FRONT OF THE ERRSET + POP Q,CPTR + POP Q,COMCNT + JRST INCMA0 ;THEN SEARCH FOR THE >. + +;CLEAN UP WHEN ERROR OR QUIT HAPPENS, IN CASE VARIABLES WERE SCREWED. +;THIS STUFF DONE REGARDLESS OF WHETHER ERROR WAS CAUGHT BY ERRSET. +ERESET: SETOM INSBP + SETZM DISFLF + SETZM IMQUIT + SETZM INSINP + SETZM INSBP + SETZM TRCOUT + SETZM BRC1 + SETZM SLPNCR + SETZM YANKMT +IFN ITS,.CLOSE CHRAND, ;IN CASE WE QUIT OUT OF READING FILE DIR. + MOVE A,QRB.. ;MAKE SURE BFRPTR AND BFRSTR AGREE WITH ..O. + MOVE C,.QBUFR(A) ;A PDL OVERFLOW IN CERTAIN PLACES CAN CONFUSE THEM. + JRST BFRSET + +;TRY TO UNWIND MACRO PDL AND ITERATIONS UNTIL REACH INNERMOST ERRSET. +;DON'T SKIP IF REACH THERE. SKIP 1 IF POP AN ORDINARY MACR (IN WHICH CASE +;UNWINDING ISN'T FINISHED). SKIP 2 AFTER POPPING A MACRO CALLED +;BY A MACXQ. +UNWIND: HRRO A,ITRPTR ;FIND INNERMOST ERRSET OR ITERATION, + SKIPN ITRPTR ;[ ;IF NO ITERATION, POP ANY MACRO OR ^]^X. + SKIPA CH,[400,,MACPDL-1] + MOVE CH,MFMACP-MFBLEN+1(A) + CAMN CH,MACPDP ;[ ;ANY MACRO OR ^]^X CALLS INSIDE IT => POP THEM. + JRST UNWINI ;ELSE HANDLE THE ERRSET OR ITERATION. +UNWINM: LDB CH,MACPDP ;[ ;IS IT A MACRO? OR A ^]^X? + CAIN CH,10 + JRST UNWIN2 ;IT'S A NULL, THROW IT AWAY. + TRNE CH,10 + JRST UNWIN1 ;[ ;IT'S A ^]^X. + SKIPN MACPTR + .VALUE ;MACPDP AND MACPTR OUT OF PHASE?? + CALL DECDCH ;IT'S A MACRO CALL, RESTORE SQUOTP, ETC. + CALL POPMAC ;POP STRING PTR, ETC. + AOS (P) ;SKIP 1 OR 2 DEPENDING. + SKIPGE MACPTR + AOS (P) + JRST POPMP + +UNWIN1: CALL DECDCH ;[ ;POP A ^]^X. + CALL POPCTX + CALL PUSMAC +UNWIN2: CALL POPMP + JRST UNWIND + +UNWINI: SKIPN ITRPTR ;TRYING TO UNWIND WHEN NO ITERATION OR MACRO => + .VALUE ;UNWIND'S CALLER'S END TEST FAILED. + HLRZ CH,ITRPTR ;IS THIS AN ERRSET OR AN ITERATION? + CAIN CH,(A) + RET ;REACHED AN ERRSET. + CALL ITRPOP ;AN ITERATION - POP IT + JRST UNWIND ;AND LOOK AT THE NEXT ONE OUT. + +;FS ^R EXIT - WITHIN A MACRO CALLED FROM ^R, RETURN FROM THE ^R. +;FS ^R THROW - WITHIN A MACRO CALLED FROM ^R, RETURN TO ^R. +FSCREX: SKIPA Q,[FSCRE1,,MEXIT1] +FSCRTH: MOVE Q,[FSCRT1,,MEXIT1] + SKIPN DISPRR ;NOT INSIDE ^R => ERROR. + TYPRE [N%R] + JRST MEXIT1 + +;FS BACK RETURN$: RETURN TO A SPECIFIED FRAME (SPECIFIED A LA FS BACK ARGS$). +FSBKRT: CALL BACKTR ;A GETS A POINTER TO THE FRAME TO RETURN TO. + MOVE Q,[FSBKR2,,FSBKR1] + SOS A ;REMEMBER ADDR OF FRAME (MINUS 1, + MOVEM A,GCTAB ; AS IT WILL BE WHEN ON THE FREELIST). + JRST MEXIT1 + +FSBKR1: SKIPA B,[CD5A] ;AFTER POPPING A MACRO FRAME, B GETS HOW TO RETURN +FSBKR2: MOVEI B,CPOPJ ;TO THAT FRAME, DEPENDING ON WHETHER IT WAS A MACXQ. + MOVE A,GCTAB + CAME A,MFFREE ;IF THE FRAME JUST POPPED INTO AND FREED WAS THE RIGHT ONE, + JRST MEXIT1 ;RETURN TO IT. ELSE, KEEP POPPING. + JRST (B) + +;^\ - IN A MACRO, RETURN FROM IT, POPPING QREGS AND ITERATIONS. +;:^\ DOESN'T POP QREGS. +MEXIT: SKIPN MACPTR + TYPRE [NIM] ;"EXIT MACRO" IF NOT INSIDE ONE? + MOVE Q,[CPOPJ,,CD5A] +;RH(Q) HAS WHERE TO GO AFTER POPPING A MACRO CALLED BY "M". +;LH(Q) HAS WHERE TO GO AFTER POPPING A MACXQ. +MEXIT1: MOVE C,MACSPF ;PLACE TO POP TO. + TRZN FF,FRCLN ;POP THE QREG PDL UNLESS :^\. + JRST [ SAVE Q + CALL FSQPU0 + REST Q + JRST .+1] +MEXIT2: CALL UNWIND ;POP A MACRO OR ITERATION. + JRST [ CALL ITRPOP ;HERE IF ENCOUNTER AN ERRSET. + JRST MEXIT2] + JRST (Q) ;POPPED AN ORDINARY MACRO. + MOVE CH,MACXP ;POPPED A MACRO CALLED BY A MACXQ. + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SET P FROM CH, UNWIND STUFF, THEN POPJ P, + HLRZ CH,Q + JRST (CH) + +FSCRE1: SKIPA C,[RREXI0] +FSCRT1: MOVEI C,RRTHRW + SKIPE A,MACXP ;WE HAVE JUST POPPED THE MACRO CALLED FROM ^R, IF + CAMG A,DISPRR ;THE NEXT POSSIBLE CANDIDATE MACRO FRAME + JRST (C) ;IS TOO FAR OUT ON THE CONTROL STACK. + JRST MEXIT1 ;NO, POP THE INNERMOST MACRO AGAIN. + +SUBTTL QUIT/ERROR REINITIALIZATION + +;COME HERE ON INITIALIZATION, QUIT, AND ^W COMMAND. +CTLW: SETOM GOXFLS ;POP TO TOP LEVEL; DON'T INVOKE ERROR HANDLER OR MAKE BREAK LOOP + +;COME HERE ON ERROR. +;IMQUIT IS POSITIVE IF WE QUIT OUT OF LIS (TECO COMMAND READER). IT MEANS DON'T + ;WE SHOULD STAY IN THE COMMAND LEVEL THAT WAS CALLING LIS. +;OTHERWISE, IF $QERRH (Q..P) IS NONZERO, IT IS THE ERROR HANDLER MACRO TO CALL. +;OTHERWISE, IF UNWINF (FS*RSET$) IS NONZERO, CREATE A BREAK LOOP. +GOX1: SKIPN CH,LEV ;COMPUTE THE PDL LEVEL AT THE INNERMOST + MOVE CH,[-LPDL,,PDL-1] + SKIPN Q,MACXP ;INVOCATION OF THE COMMAND LOOP OR ^R. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q ;NAMELY, MUST BE INSIDE ALL OPEN-PARENS, + MOVE CH,Q ;INSIDE ALL MACXQ'S, ABOVE BOTTOM OF STACK, + SKIPN Q,DISPRR ;AND ABOVE DISPRR. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q + MOVE CH,Q + SKIPGE GOXFLS ;MAYBE WE HAVE BEEN RQ'D TO POP ALL THE WAY TO TOP. + MOVE CH,[-LPDL,,PDL-1] + CAME P,CH ;MUSTN'T PUSHJ CH, IF CH=P, SINCE RET. ADDR WOULD BE UNPROTECTED + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING SOME STUFF; THEN POPJ P, + SKIPL TYOFLG ;IF TYPEOUT IN PROGRESS, FORCE IT OUT. + CALL DISFLS + SETZM CTLCF + SKIPE CPTR + CALL ERRP2 ;MARK THE CURRENT PC FOR "?" TO DISPLAY. + MOVE C,IMQUIT + SETZM IMQUIT + MOVE TT,BEG + SKIPN E,RREBEG ;MUSTN'T RUN OUTSIDE ^R WITH RREBEG ZERO. + MOVEM TT,RREBEG + SKIPL ERRFLG + SETZM LASTER ;IF NO ERROR, MAKE SURE FS ERROR IS 0. + HRRZM P,ERRFL1 ;AS YET, NO ERROR MESSAGE PRINTED (THOUGH MAY CHANGE) + SKIPN GOXFLS ;IF WE'RE POPPING TO TOP, DON'T PUSH NOW. + SKIPLE C ;IF THIS IS TECO STARTUP, OR QUIT OUT OF COMMAND READER, + JRST GOX4 ;THERE'S REALLY NOTHING TO PUSH NOW. + SKIPN UNWINF ;ENTER BREAK LOOP? + SKIPE $QERRH ;OR HAVE AN ERROR HANDLER? + CAIA + JRST GOX4 ;NEITHER; NO NEED TO PUSH. + JUMPN E,GOX5 ;IF ERROR OCCURRED ACTUALLY INSIDE ^R (NOT WITHIN A MACRO) + SAVE [[ MOVE P,DISPRR + REST A + JRST RRLP]] ;THEN SIMULATE A MACXQ CALL WHICH, WHEN RETURNED FROM, WILL + SAVE MACPTR ;RETURN TO ^R. + SAVE MACXP + SETOM MACPTR + MOVEM P,MACXP +GOX5: JSP T,OPEN1 ;NOW PUSH VALUES + CALL PUSMAC ;AND THE CURRENT MACRO (THAT ERRED). + CALL FLGENC ;ENCODE AND SAVE SQUOTP AND RCHALT + IDPB CH,MACPDP + SETZM SQUOTP + CALL GOCPY ;IF CBUF IS ON MACRO PDL, COPY IT TO A STRING + ;SINCE CBUF IS LIKELY TO BE OVERWRITTEN NOW. + SKIPE A,$QERRH ;IF THE USER HAS AN ERROR HANDLER, GO TO IT. + JRST [ TRO FF,FRCLN ;WE ALREADY PUSHED THE ERRING MACRO; NO NEED TO PUSH AGAIN. + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + JRST MAC5] ;NOW RUN THE ERROR HANDLER. +GOX4: TRO FF,FRARG\FRCLN\FRUPRW + SKIPGE GOXFLS ;GOXFLS AND ERRFLG IMPLY THIS IS "ERROR ENTERING ERROR HANDLER" + TRZ FF,FRCLN ;SO DON'T OVERWRITE THAT LINE WITH THE ERROR MSG. + SKIPE C,LASTER ;NO USER ERROR-HANDLER, SO IF RESPONDING TO AN ERROR, + CALL FGCMD ;PRINT STANDARD ERROR MESSAGE, FLUSH TYPEAHEAD, AND TYPE A BELL. + SETOM UNRCHC ;IF WE ARE ^G-QUITTING BACK TO TECO CMD LOOP, FLUSH THE ^G. + SETZM TYISRC + SETZM TYISNK + SETOM TYOFLG ;FORCE TYPEOUT TO RE-INIT. + SKIPN RGETTY + CALL CRR + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + SKIPN UNWINF ;NOW NORMALLY ENTER A COMMAND LOOP, BUT + SKIPN A,DISPRR + JRST GO + SKIPE MACXP + CAML A,MACXP ;IF DON'T WANT A BREAK LOOP AND INSIDE A ^R, RETURN TO THAT ^R. + JRST [SETZM RREBEG + JRST RRTHRW] ;HOW TO DO IT DEPENDS ON WHETHER WE CALLED ANY MACROS FROM IT. + JRST FSCRTH + +;ALTMODE AS COMMAND. +ALTCMD: SKIPGE NOOPAL ;FS NOOPALT NEGATIVE => IGNORE ALTMODE. + JRST CD5 + SKIPN NOOPAL ;POSITIVE => ALTMODE IS LIKE ^_. + TYPRE [DCD] ;ERROR IN MACROS, IGNORE AT TOP LEVEL. +LGOGO: + ;COME HERE WHEN EXECUTE ^_, PERHAPS ALTMODE. + CALL FLSOUT ;EMPTY OUTPUT BUFFER INTO OUTPUT FILE. +IFN ITS,[ + .SUSET [.RJNAM,,A] + CAME A,['HACTRN] + .LOGOUT +] + AOSN CTLCF ;IF READ ^C, + CALL FSEXI1 ;RETURN TO DDT. + HRRZM P,ERRFL1 +GO: MOVE A,GOXFLS ;IF WE'RE REQUESTED TO POP ALL THE WAY + SETZM GOXFLS + SKIPE UNWINF ;OR NOT IN *RSET MODE, + JUMPGE A,GO2 + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING OUT OF ^R OR SORT OR PARENS. + SETZM MACXP + SETZM NOQUIT + SETZM MACPTR + SETZM MACDEP + SETZM CTXPTR + SETZM ITRPTR + MOVE A,[400,,MACPDL-1] + MOVEM A,MACPDP + MOVEI A,MFSTRT-1 ;NOW PUT ALL CELLS ON THE FREE LIST. + SETZM MFFREE + MOVE B,MFEND +GO1: SKIPL MFBEG+1(A) .SEE MFBFR ;FREE ALL MACRO FRAMES, EXCEPT THOSE OF BUFFERS. + CALL FLSFRM ;FREE IT. + ADDI A,MFBLEN + CAIGE A,-1(B) + JRST GO1 + MOVE C,PFINI ;UNWIND QREG PDL. + CALL FSQPU0 +GO2: MOVEI A,(JFCL) + HRLM A,RCHALT + SETZM SQUOTP + SETZM MACBTS ;THERE ARE NO MACRO ARGS IN TOP-LEVEL CMD STRING. + CALL FLSCM1 ;FLUSH SOME CORE, AND FORCE OUT OUTPUT BUFFER. + SKIPL TYOFLG ;FORCE ALL TYPEOUT TO BE PRINTED. + CALL DISFLS + SETZM IMQUIT + SKIPN ECHOFL + CALL SETTTM ;TURN ECHOING BACK ON IF NECESSARY. + SKIPE MORFLF ;IF PREVIOUS COMMAND FLUSHED, + SETOM TYOFLG ;NEXT TYPEOUT WILL REINIT AND UN-FLUSH. + SETZM MORFLF + MOVE C,QRB.. + MOVE C,.QPT1(C) ;GET WHAT . WAS WHEN LAST CMD STRING STARTED. + CALL FSPSPT ;PUSH ON . RING BUFFER. + MOVE CH,QRB.. ;MACRO ..L IF THAT'S APPROPRIATE. + MOVE A,.QRSTR(CH) + AOSN INITF1 + JUMPN A,GOXX + CALL VIEW2 ;NOW GO TRY TO DISPLAY DIR. OR BUFFER. + JRST LIS + +GOXX: TRO FF,FRCLN ;DO A :M TO ..L, MAKING IT THE TOP LEVEL MACRO FRAME + JRST MAC5 ;LEAVING MACPDL EMPTY. + +;FIND THE MACRO FRAME THAT IS EXECUTING OUT OF CBUF, COPY THE CONTENTS +;OF CBUF INTO A STRING, AND MAKE THE MACRO FRAME POINT TO THAT STRING INSTEAD. +;THE GOAL IS TO FREE UP CBUF FOR RE-USE WHEN COMMAND READER IS ENTERED +;IN A BREAK LOOP. +;DOESN'T PROMISE TO RPESERVE ANY ACS. +GOCPY: MOVEI A,MFSTRT +GOCPY1: SKIPGE MFBEG(A) .SEE MFBFR ;DONT CONSIDER BUFFER FRAMES. + JRST GOCPY2 + HRRZ C,MFCPTR(A) ;WHERE DOES B.P. OF MACRO FRAME POINT? + JUMPE C,GOCPY2 ;IGNORE FREE CELLS; THERE MAY BE SOME -> CBUF. + CAIL C,@CBUFLO + CAIL C,@CBUFH + JRST GOCPY2 + JRST GOCPY3 ;CPTR OF THIS FRAME POINTS WITHIN CBUF! + +GOCPY2: ADDI A,MFBLEN + CAMGE A,MFEND ;SCAN ALL FRAMES. + JRST GOCPY1 + RET ;NO FRAME POINTS IN CBUF - NO COPYING NEED BE DONE. + +GOCPY3: HRRZ E,CBMAX ;HOW LONG IS USED PART OF CBUF? + MOVEI C,4(E) ;GET THAT MUCH SPACE, PLUS SOME FOR STRING HEADER + CALL SLPQGT + MOVEI B,QRSTR + MOVEI C,4(E) + CALL QHDRW1 ;WRITE HEADER OF STRING; B.P. RETURNED IN BP TO IDPB TEXT. + MOVE C,E + MOVE IN,CBUFLO ;AND GET B.P. TO ILDB TEXT TO COPY. +GOCPY4: ILDB CH,IN + IDPB CH,BP + SOJG C,GOCPY4 + MOVE BP,QRWRT + SUB BP,QRBUF + TLO BP,400000 + MOVEM BP,MFCSTR(A) ;STORE STRING POINTER TO NEWLY CONSTRUCTED STRING IN MACRO FRAME. + MOVEI BP,4(E) + ADDB BP,QRWRT ;CLOSE THE FINISHED STRING; ET CHAR ADDR 1 + LAST CHAR. + SUB BP,MFCCNT(A) ;GET NEW CHAR ADDR OF CHAR CPTR SHOULD ILDB NEXT + CALL GETIBP ;AND SET UP CPTR -> SAME CHARACTER IN ITS NEW HOME. + MOVEM BP,MFCPTR(A) + RET + +SUBTTL F? COMMAND + +;F? COMMAND - MBOX CONTROL. +;ARGUMENT IS BIT-DECODED. NO ARG, OR ARG=0, IMPLIES ARG=30 . +;BIT 1.1 - CLOSE GAP. MAY BE NEEDED FOR COMMUNICATION WITH OTHER PROGRAMS +; THAT DON'T UNDERSTAND THE GAP. +;BIT 1.2 - GC STRING SPACE. USEFUL BEFORE DUMPING OUT OR IF IT IS SUSPECTED +; MANY STRINGS HAVE RECENTLY BEEN DISCARDED. +;BIT 1.3 - SWEEP THE JUMP CACHE. NECESSARY IF A STRING'S CONTENTS HAVE BEEN +; ALTERED BY THE F^E COMMAND, AND IT IS A MACRO THAT MIGHT +; HAVE CONTAINED "O" COMMANDS. +;BIT 1.4 - FLUSH UNOCCUPIED CORE. GOOD TO DO EVERY SO OFTEN, OR IF IT IS +; LIKELY THE BUFFER HAS JUST SHRUNK. +;BIT 1.5 - CLOSE THE GAP, IF IT IS > 5000 CHARACTERS. GOOD TO DO EVERY SO +; OFTEN, IN CASE USER DELETES LARGE AMOUNTS OF TEXT; SAY, +; WHENEVER EXCESS CORE IS FLUSHED. +FLSCMD: ARGDFL + SKIPE C + TRNN FF,FRARG ;NO ARG SAME AS ARG OF 30. +FLSCM1: MOVEI C,30 + HRLM C,(P) + CALL FLSOUT ;FIRST, FORCE OUT OUTPOUT BUFFER. + HLRZ C,(P) + MOVE A,EXTRAC + TRNE C,20 + CAIG A,5000 ;"20" BIT MEANS CLOSE GAP IF VERY LARGE. + TRNE C,1 ;"1" BIT MEANS CLOSE GAP IN ANY CASE. + CALL SLPSHT + TRNE C,2 ;IF "2" BIT IS SET IN ARG, DO A GC, + JRST GCC ;THAT INCLUDES FLUSHING CORE AND SWEEPING CACHE. + TRNN C,4 ;"4" BIT MEANS SWEEP JUMP CACHE. + JRST FLSCM2 + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 +FLSCM2: TRNN C,10 ;"10" BIT MEANS FLUSH UNUSED CORE. + RET +FLSCOR: SAVE A + SAVE C + SAVE B + MOVE A,BFRTOP ;OTHERWISE JUST FLUSH CORE. + CAMN A,BFRBOT ;DON'T FLUSH ALL PAGES, ELSE THE + ADDI A,1 ;GAP BETWEEN IMPURE STRINGS AND BUFFER WOULD FILL UP. + ADDI A,2000*5-1 + IDIVI A,5*2000 ;A_ # PAGES WE'RE REALLY USING. + MOVE C,MEMT ;C_ # OF LAST PAGE WE HAVE. + SUBM A,C ;C HAS -<# PAGES TO FLUSH> + JUMPE C,POPBCA + MOVE J,A +IFN ITS,[ + HRLM C,A ;A HAS AOBJN -> PAGES TO BE FLUSHED. + SKIPGE A ;WE'RE TRYING TO CORE UP??? + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A] + .VALUE +] +IFN TNX,[ + MOVEI B,(A) ;FIRST BLOCK TO DO + ASH B,1 ;MAKE A PAGE NUMBER + HRLI B,.FHSLF + SETO A, ;SAY UNMAP + ASH C,1 +IFN 20X,[MOVM C,C ;NUMBER OF PAGES + HRLI C,(PM%CNT) + PMAP ;UNMAP THEM +] +IFN 10X,[PMAP ;TENEX -- NO MULTIPLE PMAPS + AOJGE C,.+2 + AOJA B,.-2 +]] + MOVEM J,MEMT ;UPDATE # OF FIRST K OF NXM. + JRST POPBCA + +SUBTTL TECO COMMAND STRING READER + +LISCRF: CALL ECHOCR +LIS: HRRZM P,IMQUIT ;^G DURING TYPEIN QUITS IMMEDIATELY. + SETZM NOQUIT + SKIPGE STOPF ;PERFORM ANY PENDING QUIT. + CALL QUIT0 + SKIPN ECHOFL + CALL SETTTM ;MAKE SURE ECHOING IS ON. + SETZM RCHSFF + .I CASE=CASNRM ;REINIT THE INPUT CASE. + TTYACT ;TO SET "ACTIVATE ON NEXT CHAR REGARDLESS" AGAIN + CALL VBDACU + JFCL + SETZM CTLBRF + MOVE C,QRB.. + SETZM .QVWFL(C) + MOVE B,CBUFLO ;BP TO BEFORE CMD BUFF. + MOVE TT,CBMAX ;WAS THE PREVIOUS CMD STRING A LONG ONE? + CAIGE TT,10. + JRST LISSRT ;NO, IT WAS SHORT. + MOVEM TT,SAVCMX ;YES, THIS IS CMD STRING FOR ^Y TO INSERT. + MOVEI TT,SAVCW1-1 ;SO SAVE INFO ON IT SO SHORT CMDS + PUSH TT,1(B) ;WON'T CLOBBER THE BEGINNING OF IT. + PUSH TT,2(B) + PUSH TT,3(B) + .I SAVCPT=CPTR +LISSRT: SETZM CBMAX ;CBMAX COUNTS CHARS IN CMD STRING BEING READ IN + SETZM COMCNT + MOVEM B,CPTR ;INIT CPTR FOR EXECUTION OF THE CMD STRING + MOVEM B,CSTR + MOVE C,CBUFH + ;HANDLE ":TECO FOO BAR" FROM DDT + SKIPGE CMFLFL ;READING FROM INIT FILE => GO YANK AND XCT IT. + JRST LISINI +LI1: SKIPE RGETTY ;IF NO DISPLAY, + JRST LILUP + SKIPE CH,PROMCH ;PROMPT UNLESS PROMPTING DISABLED. + CALL TYANOW +;FALLS THROUGH TO READ THE FIRST CHARACTER. + +;FALLS THROUGH. +;LOOP AFTER HANDLING A CHAR OTHER THAN ALTMODE. +LILUP: TRZ FF,FRALT ;SAY THE PRECEDING CHAR WASN'T ALTMODE. +LI2: MOVE C,CBUFH + CAILE C,(B) ;LOOP BACK HERE AFTER ALTMODE, WITH FRALT SET. + JRST LI3 + ADDI C,100 ;IF WE'VE FILLED THE COMMAND BUFFER, MAKE IT BIGGER. + SAVE C + MOVEI C,500 ;MAKE SURE WHEN IMPURE STRING SPACE IS MOVED UP + CALL SLPQGT ;IT WON'T REACH BUFFER SPACE. + REST C + MOVE E,QRWRT ;LAST WD TO MOVE UP IS LAST IN IMPURE STRING SPACE. + IDIVI E,5 + MOVE J,QRBUF + IDIVI J,5 + SUBM E,J + MOVE CH,(E) + MOVEM CH,100(E) + SOS E + SOJGE J,.-3 + MOVEI T,500 + ADDM T,QRBUF + ADDM T,QRWRT +LI3: MOVEM C,CBUFH + SETZM CTLCF + CALL TYI ;READ CHARACTER FROM TERMINAL. + CALL TYINRM + MOVEI TT,^J ;PRETEND THAT EVERY CR IS FOLLOWED BY A LF. + CAIN CH,^M + MOVEM TT,UNRCHC + SKIPL CTLBRF ;[ ;LET ^]^Q QUOTE A ^C +IFN ITS, CAIE CH,^C +IFN TNX, CAIE CH,^Z ;^C IMPLIES GO + JRST LI3Z + SETOM CTLCF ;BACK TO DDT IF FINISH COMMAND STRING WITHOUT ERROR. + JRST LISEOF ;IT ALSO TERMINATES THE COMMAND STRING. + +LI3Z: CAME B,CBUFLO ;IF THIS IS 1ST CHAR, SOME CHARS ARE SPECIAL. + JRST LI3D1 ;NO, NORMAL. + JRST LISFST + +;COME HERE AFTER READING A CHAR, WHEN THE CMD BUFFER IS EMPTY. +LISFST: CAIN CH,^R + JRST RRIMMD + CAIN CH,^T + JRST EDIT + CAIN CH,^U ;^U => DISPLAY FILE DIR USING USER'S MACRO. + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) + TLO FF,FLDIRDPY + SETZM IMQUIT + JRST GO] + CAIN CH,^V + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + CALL POPPT ;POP . RING BUFFER. + JFCL + MOVE CH,QRB.. + MOVEM A,.QPT1(CH) ;PREVENT AUTOMATIC RE-PUSH. + JRST GO] + CAIN CH,^X + SKIPN LASTER + CAIA + JRST [CALL FECMD8 ? JRST GO] + CAIN CH,^Y + JRST LISCY + TRNN FF,FRQMRK + JRST LI3D1 + CAIN CH,"? + JRST ERRTYP +LI3D1: PUSHJ P,CKCH + JRST LISCRF ;RUBOUT ON AN EMPTY BUFFER. + JRST [SETZM CTLBRF ? JRST LILUP] ;A CHAR WAS RUBBED. +LISTOR: AOS CBMAX + IDPB CH,B + AOSE CTLBRF ;[[ ;WAS THIS CHAR PRECEDED BY ^] OR ^]^Q? + JRST LISBR1 ;NO. + CAIN CH,^Q ;YES, ^Q=> NEXT CHAR ALSO QUOTED. +LISBRC: SETOM CTLBRF + JRST LILUP ;[ ;QUOTED ^] AND ALTMODE AREN'T SPECIAL. + + ;[[ BRACKETS MUST BALANCE FOR CONDITIONALS. +LISBR1: CAIN CH,^] ;NOT QUOTED, ^] QUOTES NEXT CHAR. + JRST LISBRC + CAIE CH,ALTMOD ;ALTMODE => CHECK FOR ALT-ALT, MAYBE END STRING. + JRST LILUP + TRON FF,FRALT ;SAY JUST SAW AN ALTMODE, + JRST LI2 + JRST LISDUN ;PREV. CHAR ALSO ALTMODE => END STRING. + +CKCH: CAIE CH,177 + JRST POPJ2 ;OK CHAR - RETURN, SKIPPING TWO + CAMN B,CBUFLO + POPJ P, ;RUBBED TO BEGINNING - NO SKIP + LDB CH,B + PUSHJ P,FSECOR + DBP7 B + SOS CBMAX + JRST POPJ1 ;RUBBED ONE CHAR - RETURN, SKIPPING ONE + +;COME HERE ON ^C ON TTY. +LISEOF: MOVEI CH,ALTMOD ;DUMMY UP TWO ALTMODES. + IDPB CH,B + AOS CBMAX + IDPB CH,B + AOS CBMAX + +;COME HERE AFTER HANDLING AND STORING ALTMODE-ALTMODE +LISDUN: MOVEI CH,^_ ;^_ TO STOP EXECUTION OF CMD STRING. + IDPB CH,B + AOS TT,CBMAX + MOVEM TT,COMCNT + +;INITIALIZE RANDOM STUFF FOR ANOTHER CMD STRING. + SETZM IMQUIT + SETZM ERRFLG ;DON'T IGNORE 1ST LINE OF NEXT V-COMMAND. +IFN TNX,SETZM ECHOP ;NOT IN ECHO AREA ANY MORE + SKIPN RGETTY + PUSHJ P,CRR + TRZ FF,#FRTRACE + MOVE A,PT ;Q..I _ . . + SUB A,BEG + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + MOVEM A,.QPT1(CH) ;PUT . INTO Q..I. + JRST CD + +POPJ2: AOS (P) +CPOPJ1: POPJ1: + AOS (P) + POPJ P, + +LISINI: CALL RRED1 ;INIT FILE OPEN ON CHFILI; PREPARE TO YANK IT. + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS. + MOVEI A,[ASCIZ /^ Y :M(HFX*)/] + SETZM CMFLFL ;COMMAND FILE HAS BEEN HANDLED (ALMOST) + SETZM IMQUIT + CALL MACXCW ;XCT THAT STRING, TO YANK AND XCT THE INIT FILE. + JRST GO + +;CONTROL-Y WAS 1ST CHAR TYPED -- +; INSERT LAST COMMAND STRING INTO BUFFER, THEN REDISPLAY. +LISCY: MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^Y. + SETOM SQUOTP ;[ ;DON'T LET ^] EXPAND WHEN WE REREAD CMD STRING. + SETOM BRC1 + .I COMCNT=SAVCMX + HRROI TT,SAVCW3 ;RESTORE THE LAST LONG (>7 CHARS) CMD STRING + POP TT,3(B) ;.I <3RD WD OF CMD BUFFER>=SAVCW3 + POP TT,2(B) + POP TT,1(B) + MOVE B,SAVCPT + SETO OUT, + +LISCY1: CALL SKRCH ;READ CHAR FROM CMD STRING, DON'T TRACE. + MOVE C,COMCNT ;IF WE'VE REACHED THE $$^_ AT THE END, + CAIGE C,3 ;DON'T PUT THE $ IN THE BUFFER. + JRST [JUMPL OUT,GO ;IF CMD STRING WASN'T ALL READ, + MOVEM OUT,PT ;PUT PT AFTER LAST CHAR THAT WAS. + JRST GO] + CALL TYOMGS ;INSERT NEXT CHAR OF CMD STRING INTO BUFFER. + CAMN B,CPTR ;THE PTR SHOULD END UP AT THE POINT + MOVE OUT,PT ;COMMAND STRING READING STOPPED. + JRST LISCY1 + +;? WAS 1ST CHAR TYPED AFTER ERR MSG, RETYPE LAST FEW CHARS. +ERRTYP: HRRZM P,ERRFL1 ;DON'T LET ERRFL1 PREVENT OUR TYPEOUT FROM APPEARING. + MOVE B,ERR2 + MOVEI C,8*5 + SUBI B,8 + ILDB CH,B + CAMG C,ERR1 + PUSHJ P,TYO + CAME B,ERR2 + SOJA C,.-4 + JRST GO + +;MARK THE CURRENT MACRO PC FOR ERRTYP TO TYPE OUT. +ERRP2: MOVEI A,COMCNT + CALL MFBEGP ;C GETS CURRENT PC IN CHARS IN CURRENT MACRO. + TRO FF,FRQMRK + MOVEM C,ERR1 ;SAVE THAT, AND B.P. TO LAST CHAR READ. + MOVE A,CPTR + MOVEM A,ERR2 + RET + +SUBTTL ^R MODE + +;GET LENGTH CODE OF CHAR IN CH INTO A. +;SKIP IF NOT A CTL CHAR. NOTE THAT CALLING DISAD6 MAY BE +;EQUIVALENT TO DOING CALL .+1 . +DEFINE RRCHRG + SKIPE CASDIS ;IN -1F$ MODE, HANDLE SLASHIFICATION. + CALL DISAD6 + MOVEI A,(CH) + IDIVI A,6 + LDB A,RRCHBP(B) + CAIN CH,177 ;RUBOUT PRINTS AS ^? OR AS INTEGRAL SIGN, SO TREAT IT AS A CTL CHAR. + SKIPA A,[1] + CAIGE CH,40 +TERMIN + +;ENTRY FOR ^R 1ST CHAR TYPED IN CMD STRING. +RRIMMD: SAVE [GO] + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^R. + SETZM IMQUIT + +;^R EXECUTED AS A COMMAND. +RRENTR: .I CASE=CASNRM + TLZA FF,FLNOIN ;SAY INPUT IS ACCEPTIBLE. +;"^ V" COMMAND WITHIN A MACRO CALLED FROM ^R MODE COMES HERE. +RRNOIN: TLO FF,FLNOIN ;ENTRY TO DISPLAY ONCE AND RETURN, PROCESSING NO INPUT. + CALL RREARG ;PROCESS ARGS IF ANY, DECIDE WHAT REDISPLAY NEEDED. + ;ALSO MAKE SURE RRHPOS AND RRVPOS ARE REASONABLE. + SAVE FF ;REMEMBER WHETHER THIS IS ^R OR ^ V, FOR RREAR0. + SAVE PF ;SAVE QPDL PTR SO EXITING ^R CAN POP WHAT FS ^R ENTER PUSHES. + SAVE DISPRR + CALL [MOVEM P,DISPRR ;SET UP PDL RESTORATION POINT + RET] ;FOR ERRORS CAUGHT BY ^R. + JUMPL FF,RRNOI2 + SKIPE A,RRENTM + CALL RRMACR +RRNOI2::SETOM ECHCHR ;ENTERING ^R SHOULDN'T ECHO A COMMAND. ^ V SHOUDLN'T ECHO ONE. +;DROPS THROUGH. + +SUBTTL ^R MODE REDISPLAY + +;DROPS THROUGH. + +;MAIN LOOP OF ^R EDIT: ROUTINES DISPATCHED TO WILL POPJ TO HERE. +RRLP: CAIA + CALL RRTTY1 ;BUILT-IN COMMANDS SKIP TO "RETURN ONE VALUE", SO SCAN CURSOR MOTION. + CALL RRTTYE ;PRINTING TTY IN SCAN MODE, IF COMMAND DOESN'T TYPE OUT, ECHO IT. + SETZM STOPF + SETZM ORESET + TLNN FF,FLNOIN + CALL RRARGF + JUMPL FF,RRLP6 ;THIS IS ^R AS OPPOSED TO ^V + MOVE CH,INCHCT ;THEN IF THE LAST COMMAND WAS NOT AN ARG-SETTER, + SKIPE RRLAST ;THEN A COMMAND HAS JUST ENDED, SO SAVE FS TYI COUNT IN FS TYI BEG. + MOVEM CH,INCHRR + SKIPLE RRMCCT ;AND IF FS ^RMDLY ISN'T 0, + SOSLE RRMCC1 ;THEN IF IT IS ALREADY TIME TO INVOKE SECY, DO SO. + JRST RRLP6 + MOVE CH,QRB.. ;IF THERE IS ONE. IF THERE IS NONE, RRMCC1 IS NEGATIVE SO AS + SKIPN A,.QCRMC(CH) ;SOON AS THERE IS ONE AGAIN IT WILL BE RUN. + JRST RRLP6 + CALL RRMACR ;DO SO. + MOVE A,RRMCCT ;AND REINIT # CHARS TO EXECUTE BEFORE + MOVEM A,RRMCC1 ;NEXT INVOKATION. +RRLP6: SETO OUT, ;WE HAVEN'T RUN THE FS ^R DISPLAY MACRO YET. +RRLP6A: SKIPN RGETTY + JRST [ SKIPGE GEA ;ON PRINTING TTY, REDISPLAY ONLY AFTER A ^L. + JRST RRLP4 + JRST RRLP1] ;OTHERWISE JUST READ ANOTHER COMMAND. + SKIPE ECHFLS + SKIPL ECHACT ;IF ECHO AREA SHOULD BE CLEARED, DO SO. + JRST RRLP6B + SKIPL PJATY ;IF WHOLE SCREEN IS ABOUT TO BE CLEARED ANYWAY, DON'T BOTHER. + TLNE FF,FLNOIN ;CLEAR ECHO AREA ONLY AT TIMES WHEN INPUT COULD BE READ. + JRST RRLP6B + MOVEI C,^P + CALL FSECDS + MOVEI C,"C + CALL FSECDS ;FSECDS SETS RROVPO SO WE WILL REPOSITION THE CURSOR WHEN WE CAN. + SETZM ECHACT ;INDICATE ECHO AREA CLEAR NOW. +RRLP6B: SKIPE RRINHI ;IF DISPLAYING IS INHIBITED, READ ANOTHER COMMAND WITHOUT DISPLAYING + JRST [ MOVE T,MORESW ;BUT DO UPDATE THE MODE-LINE. + CALL DISMD + JRST RRLP1] + SKIPE DFORCE + JRST RRLP6C + LISTEN TT + JUMPN TT,RRLP1 ;ANY BUFFERED INPUT TO PROCESS? + SKIPGE UNRCHC + SKIPE TYISRC + JRST RRLP1 +RRLP6C: SETOM TYOFLG ;DOING ^R DISPLAY FORCES TYPEOUT TO RE-INIT. + SKIPGE GEA ;^L OR F+ HAS CLEARED THE SCREEN => REDISPLAY + JRST RRLP4 + SKIPL PJATY ;SCREEN GOT CLOBBERED, OR LOTS OF CHANGES HAPPENED, => + SKIPGE RRMNVP ;MUST CHECK THE WINDOW BEFORE DISPLAYING ANYTHING. + JRST RRLP4 + CALL RRWBLS ;IS OLD WINDOW STILL GOOD? + CALL [ TRO FF,FRUPRW ;NO => CHOOSE A NEW ONE FROM SCRATCH, AND + JRST RRALT6] ;TRY SCROLLING THE TEXT WITH INSERT/DELETE LINE. + MOVE A,RRMAXP ;RRMAXP=1 IS SET TO INHIBIT UPDATING IN RRDLB AND RRINSC. + CAIN A,1 ;IT DOESN'T INDICATE ANY CHANGES HAVE ACTUALLY OCCURRED. + SETZM RRMAXP + SKIPN RRMAXP ;ANY REDISPLAY REQUIRED? + SKIPE RRMSNG + CAIA + JRST RRLP3 ;NO, JUST MOVE CURSOR IF NEC. + MOVE A,RRMNVP + CAML A,BOTLIN ;IF ALL REQUIRED REDISPLAY IS REALLY OFF BOTTOM OF SCREEN, + JRST [ CALL RRDIS2 ;SAY IT'S BEEN DONE, AND MOVE THE CURSOR IF NEC. + JRST RRLP3] + JUMPE OUT,RRLP2F ;RUN FS ^R DISPLAY, UNLESS WE JUST FINISHED RUNNING IT. + SKIPN A,RRDISM ;ABOUT TO DISPLAY; FIRST CALL USER'S MACRO. + JRST RRLP2F + CALL RRMACR + SETZ OUT, ;MARK FS ^R DISPLAY AS RUN, THIS TIME, TO AVOID INFINITE LOOP. + TRNN FF,FRARG2 ;IF 0 OR 2 VALUES, RECONSIDER WHAT DISPLAY TO DO + TRNN FF,FRARG + SETO OUT, + JRST RRLP6A + +;HERE IF PART OF THE SCREEN NEEDS REDISPLAY BUT NOT WHOLE SCREEN. +RRLP2F: SETOM RRIDLB ;IF NO INSERT/DELETE LINE, CAUSE ASSOCIATED CODE TO DO NOTHING. + SKIPE LID ;IF THE TERMINAL HAS INSERT/DELETE LINE, SEE HOW MANY LINES OF + CALL RRLID ;BOTTOM OF WINDOW WILL STILL BE GOOD IF SHIFTED A FEW LINES. + CALL CHCTI0 ;INIT. FOR CALLING DISAD. + SETZM CHCTBP + AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET) + HLLOS DISBFC + MOVEI TT,CPOPJ + MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS. + .I RRDHPS=RRHPOS ;SAVE INFO FOR DEBUGGING. + .I RRDVPS=RRVPOS + .I RRDMHP=RRMNHP + .I RRDMVP=RRMNVP + SAVE PT + SAVE RRHPOS + SAVE RRVPOS +RRLP2G: MOVE A,RRMNVP ;FIND THE 1ST CHAR IN THE 1ST LINE + MOVEM A,RRVPOS + LDB TT,[3300,,LINBEG(A)] ;WHICH WAS ALTERED, + MOVEM TT,PT + MOVE TT,LINBEG(A) + ASH TT,-33 + MOVEM TT,RRHPOS ;AND WHAT COLUMN IT WAS TYPED IN. + MOVEM TT,CHCTHP ;IN CASE LINE DOESN'T START AT LEFT MARGIN + ;(DUE PERHAPS TO LF WITHOUT CR) + CALL CHCTL4 ;INIT CHCTHC WITH SPACES. + SETZ T, ;T GETS THE LARGEST HPOS THAT ACTUALLY EXISTS ON THE LINE. + ;IF THE LINE ENDS SHORT OF RRMNHP, WE RESET RRMNHP TO THAT AND RETRY. +RRLP2B: MOVE TT,RRHPOS ;MOVE FORWARD TILL WE FIND 1ST CHAR + CAML TT,RRMNHP ;THAT FALLS IN THE 1ST ALTERED COLUMN. + JRST RRLP2C + MOVE TT,PT + CAML TT,ZV + JRST RRLP2C + CALL RRFORW + CAMGE T,RRHPOS + MOVE T,RRHPOS + MOVE TT,RRVPOS + CAME TT,RRMNVP ;BUT DON'T LET US MOVE PAST THE END OF + JRST RRLP2D ;THE LINE WE'RE SUPPOSED TO START ON. + CALL DISAD2 ;PUT THE CHARACTERS WE SKIP OVER INTO THE LINE'S HASH CODE. + JRST RRLP2B + +RRLP2D: MOVEM T,RRMNHP ;HERE IF THE LINE DOESN'T EXTEND AS FAR RIGHT AS RRMNHP SAYS. + CALL CHCTI0 ;SET RRMNHP BACK TO THE LARGEST HPOS ON THE LINE, AND TRY AGAIN. + JRST RRLP2G ;SO WE DISPLAY FROM THE VERY END OF THE LINE. + +RRLP2C: MOVE IN,PT ;CHAR ADDR 1ST CHAR TO BE OUTPUT. + CAML IN,BEGV + CAMLE IN,ZV + .VALUE + MOVEM IN,RRDPT ;REMEMBER WHERE OUTPUT STARTD, FOR DEBUGGING. + .I DISVP1=CHCTVP=DISVP=RRVPOS=RRMNVP + CALL DISLI6 + CAME TT,BOTLIN ;UNLESS IT'S THE --MORE-- LINE, + SKIPN CHCTHP ;IF WE'RE DISPLAYING A WHOLE LINE, DON'T CLEAR UNLESS CHECKSUM + JRST [ SETOM DISVP ;SAYS IT HAS ACTUALLY CHANGED. + SETOM DISVP1 + JRST RRLP2E] + CALL RRMVC ;DISPLAYING ONLY PART OF A LINE: CHECKSUM MECHANISM WOULD LOSE, + CALL CLREOL ;SO CLEAR THE PART WE WANT TO CLEAR, + SETOM HCDS(TT) ;AND DISABLE THE CHECKSUM MECHANISM TO FORCE OUTPUTTING. +RRLP2E: REST RRVPOS + REST RRHPOS + REST PT + MOVEI TT,DISLIN + MOVEM TT,CHCTAD + .I CHCTVS=BOTLIN + SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + CALL VBDOK3 ;DO THE DISPLAYING, + CALL RRDIS2 ;INDICATE NOW REDISPLAY NOT NEEDED. + JRST RRLP5 + +;TEST THE WINDOW FOR VALIDITY, ASSUMING RRVPOS IS CORRECT. +;MUCH FASTER THAN AN ACTUAL VBDBLS. +;CLOBBERS A, IN, TT, TT1. +RRWBLS: MOVE A,RRVPOS + SKIPN GEA + JRST RRWBL1 + CAMGE A,RRTOPM ;CURSOR TOO NEAR TOP => NEW WINDOW. + RET +RRWBL1: MOVE TT,MORESW + TRNN TT,MS%DWN ;IF THERE'S STUFF PAST THE SCREEN BOTTOM, + JRST RRWBL2 ;WE DON'T WANT CURSOR TOO NEAR BOTTOM. + CAML A,RRBOTM + RET +RRWBL2: CAMGE A,BOTLIN ;IF CURSOR'S BELOW BOTTOM, WE MUST SHIFT THE WINDOW. + JRST POPJ1 ;ELSE, OLD WINDOW IS STILL GOOD. + MOVE IN,PT ;EXCEPTION: CURSOR AT FRONT OF --MORE-- LINE + CAMG A,BOTLIN ;AT END OF BUFFER AFTER A CRLF, + CAME IN,ZV ;IS CONSIDERED AT THE END, RATHER THAN BELOW IT. + RET + SUBI IN,2 + CALL RREOLT ;SO CHECK FOR THE CRLF. + JRST POPJ1 + RET + +;COME HERE HAVING DETERMINED THAT A FULL SCREEN REDISPLAY IS NEEDED. +RRLP4: MOVE A,RRDISM ;DO FULL REDISPLAY, TESTING PREVIOUS WINDOW. + JUMPE A,RRLP5A + CALL RRMACR + SKIPL GEA ;ON RETURN, IS REDISPLAY STILL NEEDED OR WAS IT ALREADY DONE? + SKIPGE RRMAXP + JRST RRLP5A + SKIPGE PJATY ;IF SEEMS TO HAVE BEEN DONE, MAYBE WE SHOULDN'T DO IT. + SKIPE RRMSNG + CAIA + JRST RRLP6 +RRLP5A: SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + .I RRERFL=ERRFL1 + SETOM RRIDLB ;IN FULL REDISPLAY, NONE OF THE TEXT ALREADY ON THE SCREEN CAN BE REUSED. + CALL RRDISP ;NORMAL (VBD) DISPLAY, MAYBE CHANGING WINDOW. + CALL RRDIS2 ;REDISPLAY NOW NOT NEEDED, + SKIPL RRERFL ;UNLESS THIS REDISPLAY DIDN'T DISPLAY THE TOP LINE + JRST RRLP5 + .I RRMNVP=TOPLIN ;(PRESERVING AN ERR MSG) IN WHICH CASE REDISPLAY AFTER NEXT CMD. + SETZM RRMNHP + .I RRMAXP=GEA+BEGV +RRLP5: .I RROLDZ=Z + .I RROLZV=ZV + AOSN RRNCCR ;IF CHAR BEFORE PT WAS A CR, RRHPOS WASN'T SET + ;(DUE TO THE FACT THAT A CR ISN'T OUTPUT UNTIL THE + ;NEXT CHAR IS SEEN) + CALL [ SOS PT ;HPOS AND VPOS ARE CORRECT FOR BEFORE + JRST RRFORW] ;THE CR, SO SPACE OVER IT. + MOVE A,RRHPOS ;DON'T LET THE CURSOR BE OVER THE "!" + CALL RRFOR3 ;OF A CONTINUATION. +RRLP3: MOVE T,MORESW + CALL DISMD ;REDISPLAY Q..J IF IT HAS CHANGED, NOT CHANGING --MORE-- STATUS. + SKIPE RGETTY + CALL RRMVC ;PUT THE HARDWARE CURSOR AT THE POINTER. + JRST RRLP1 + +RRDISX: MOVEI T,RRLP1 ;COME HERE TO QUIT DISPLAYING BECAUSE INPUT WAITING. + MOVE CH,DISPRR + MOVEM T,(CH) ;PREVENT RRARGF FROM BEING CALLED. +;COME HERE IF STOP DISPLAYING SINCE KNOW NO MORE DISPLAY NEEDED. +RRDISF: MOVE P,DISPRR + .I RROLZV=ZV + MOVE T,Z + SUB T,RROLDZ + ADDM T,RROLDZ +RRDISG: MOVE A,T ;NOW UPDATE THE LINBEG WORDS OF THE REMAINING SCREEN LINES. + AOS TT,BP + CAMLE TT,BOTLIN + .VALUE + JRST RRFXR1 + +RRDISP: SKIPN RGETTY + JRST RRDIS3 + .I RRMNVP=TOPLIN ;IF DISPLAYING IS INTERRUPTED, MAKE + SETZM RRMNHP ;WE RESTART THE RIGHT WAY. + SETOM RRMSNG ;SAY WE CAN'T STOP DISPLAYING AT RRMAXP. + JRST VBDRR + +RRDIS1: MOVE CH,CHCTHP ;CALL HERE WHEN CURSOR IS OUTPUT, + MOVEM CH,RRHPOS ;OR AT END OF BUFFER IF PT IS THERE. + MOVE CH,CHCTCF ;IF THE LAST CHAR WAS CR, + MOVEM CH,RRNCCR ;SAY WE DON'T KNOW CORRECT HPOS. + MOVE CH,CHCTVP + MOVEM CH,RRVPOS ;REMEMBER SCREEN POS. OF CURSOR. + POPJ P, + +RRDIS2: SETZM RRMAXP ;HERE TO DECLARE THAT NO REDISPLAY IS NEEDED. + SETZM RRMSNG + HRLOI TT,377777 + MOVEM TT,RRMNVP + MOVEM TT,RRMNHP + POPJ P, + +;MOVE THE CURSOR TO THE PLACE SPECIFIED BY RRVPOS AND RRHPOS. +;ASSUMES THAT RROHPO, RROVPO HOLD CURRENT ACTUAL LOCATION OF CURSOR, +;OR -1 IF THE OLD POSITION IS NOT KNOWN. CLOBBERS Q. + +RRMVC: MOVE Q,RRHPOS + SKIPN RGETTY + MOVEM Q,CHCTHP + SKIPE RGETTY + CAME Q,RROHPO ;IF NEITHER COORD NEEDS TO BE CHANGED, + JRST RRMVC1 + MOVE Q,RRVPOS + CAMN Q,RROVPO + RET ;DON'T BOTHER TO DO ANYTHING. +RRMVC1: SAVE BP + HRRZ BP,RRHPOS + HRL BP,RRVPOS + HRRZM BP,RROHPOS + HLRZM BP,RROVPOS + CALL SETCU1 + JRST POPBPJ + +;HERE TO SEE IF ANY OF THE TEXT ON THE SCREEN, PAST ALL CHANGES WE MUST DISPLAY, +;CAN STILL BE USED IF WE CAN MOVE IT TO THE RIGHT LINE ON THE SCREEN +;(USING INSERT/DELETE LINE). SOMETIMES WE ACTUALLY MOVE THE TEXT AND BLT THE TABLES. +;USUALLY WE JUST SET RRIDVP TO THAT LINE'S VPOS AND RRIDLB TO ITS LINBEG WORD +;(RELOCATED TO CONTAIN A CURRENT ADDRESS RATHER THAN A HISTORICAL ONE). +;RRIDBK IS SET TO THE NUMBER OF BLANK LINES WHICH NOW PRECEDE THAT STILL-USEFUL LINE. +;IT IS USED IN RECOGNIZING WHERE THAT LINE IS GOING TO BE WANTED ON THE SCREEN +;AS SOON AS THE FIRST BLANK LINE IS REACHED IN TYPEOUT. THIS REDUCES WASTEFUL DISPLAY. +RRLID: CALL RRLID2 ;FIND THE TEXT TO BE PRESERVED, SET RRIDLB AND RRDVP. + RET ;NO SKIP MEANS NO TEXT ON SCREEN MAY BE PRESERVED. + MOVE BP,RRMNVP + MOVE TT1,RRIDLB + CAME TT1,LINBEG(BP) ;IF THAT TEXT OUGHT TO BE MOVED UP TO WHERE WE WILL START + RET ;DISPLAYING (IE, WE ARE DISPLAYING THAT SOME LINES WERE KILLED) + SETZM RRMAXP ;ALL CHANGES ARE BEING HANDLED BY THE LINE-DELETE, SO THERE AREN'T ANY MORE. +;DELETE LINES OF TEXT FROM C(BP) TO C(RRIDVP). +RRLID5: SOS BP + MOVE CH,RRMSNG + IOR CH,RRMAXP + CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT". + JUMPN CH,[ ;RRMSNG SAYS THAT THE STUFF BELOW DELETION POINT MAY NEED REDISPLAY + ;EVEN THOUGH IT'S AFTER RRMAXP, SO WE MUSNT'T TRY TO SKIP OVER IT. + MOVE TT,RRIDLB ;BUT GIVE THAT PLACE AN ACCURATE LINBEG TO RESTART + MOVEM TT,LINBEG+1(BP) ;REDISPLAY WITH. + RET] + MOVE BP,BOTLIN ;NOW ALL THAT NEEDS DISPLAYING ARE THE NEW BLANK LINES AT THE BOTTOM. + SUB BP,Q ;SO GET THE VPOS OF THE FIRST OF THEM, + CAMLE BP,TOPLIN ;AND START DISPLAYING AT THE LINE BEFORE IT, + SOS BP ;SINCE THAT'S THE LAST ONE WITH A VALID LINBEG. + EXCH BP,RRMNVP + SETZM RRMNHP ;NOTE THAT DSLID SETS RRMSNG. + MOVE CH,Z + SUB CH,RROLDZ ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP, +RRLID4: CAMLE BP,RRMNVP ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE + JRST RRLID6 ;CORRECT WITHOUT NEEDING RELOCATION. + ADDM CH,LINBEG(BP) + AOJA BP,RRLID4 + +RRLID6: MOVE CH,ZV ;DON'T LEAVE RRMNVP POINTING PAST THE END OF THE BUFFER. +RRLID7: MOVE BP,RRMNVP ;IF THE LINE IT POINTS AT IS AT OR AFTER THE END OF BUFFER, + CAMLE BP,TOPLIN ;MOVE IT BACK TO THE LINE THAT ACTUALLY FOLLOWS THE END. + CAME CH,LINBEG(BP) ;CHANGED FROM LINBEG-1(BP) SO DOESN'T LOSE ON A BUFFER + RET ;WHICH DOES NOT END WITH A CRLF. + SOS RRMNVP + JRST RRLID7 + +;DETERMINE WHETHER ANY OF THE LINES AT THE BOTTOM OF THE SCREEN CAN BE PRESERVED +;(PERHAPS MOVING THEM UP OR DOWN WITH INSERT/DELETE LINE). +;SKIP IF THERE ARE ANY, SETTING RRIDVP TO THE VPOS OF THE FIRST, AND RRIDLB +;TO THAT LINE'S LINBEG (UPDATED TO BE CORRECT WITH CURRENT Z, RATHER THAN RROLDZ). +RRLID2: SETOM RRIDLB + SETZM RRIDBK + MOVE OUT,RROLDZ + SUB OUT,Z ;COMPUTE ADDRESS BEYOND WHICH NO BUFFER CHANGES HAVE OCCURRED, + ADD OUT,RRMAXP ;RELOCATED TO MATCH OLD LINBEG WORDS. + MOVE BP,TOPLIN +RRLID1: CAMN BP,BOTLIN + RET ;REACH END OF WINDOW => NO EXISTING TEXT STILL GOOD. DON'T SET RRIDLB. + LDB TT1,[3300,,LINBEG(BP)] + CAMLE OUT,TT1 ;SEE WHICH LINE IS THE FIRST TO START AFTER THAT POINT. + AOJA BP,RRLID1 + ADD TT1,Z + SUB TT1,RROLDZ + CAMN TT1,BEGV ;A LINE IS ACCEPTABLE ONLY IF ITS TEXT IS STILL AT THE FRONT OF A LINE. + JRST RRLID3 ;SO REQUIRE THAT IT BE AT FRONT OF BUFFER OR AFTER A CRLF. + MOVE IN,TT1 + SUBI IN,2 + CALL GETINC + CAIE CH,^M + AOJA BP,RRLID1 ;IF THIS LINE NOT GOOD FOR THIS REASON, NEXT LINE PROBABLY STILL GOOD. + CALL GETCHR + CAIE CH,^J + AOJA BP,RRLID1 +RRLID3: MOVEM BP,RRIDVP ;RRIDVP POINTS AT 1ST LINE NOT INVALIDATED, OR AT BOTLIN IF ALL INVALID + MOVE TT1,LINBEG(BP) + ADD TT1,Z ;GET ADDR OF BEGINNING OF TEXT THAT CAN BE SAVED IF MOVED UP OR DOWN, + SUB TT1,RROLDZ ;RELOCATED TO BE THE CURRENT ADDRESS, NOT THE ADDR IT HAD + MOVE TT,TT1 + TLZ TT,777000 ;DON'T TRY TO MOVE FOLLOWING TEXT IF IT IS NULL (IT STARTS AT Z). + CAMN TT,ZV + RET + MOVEM TT1,RRIDLB ;WHEN LAST DISPLAYED. + MOVE IN,TT + SETOM RRIDBK ;NOW HOW MANY BLANK LINES ARE THERE BEFORE THAT POINT? +RRLID8: SOS IN ;SCAN BACKWARDS COUNTING THEM AND PUT NUMBER IN RRIDBK. + CAMGE IN,BEGV ;IF REACH BEG OF BFR JUST BEFORE A CRLF, THEN EACH CRLF WE PASSED + JRST [ AOS RRIDBK ;COUNTS FOR ONE BLANK LINE. + JRST POPJ1] + CALL GETCHR + CAIE CH,^J ;OTHERWISE, THE LAST CRLF WE FIND IS REALLY THE END OF A NONBLANK LINE + JRST POPJ1 ;AND SHOULDN'T COUNT. TO ARRANGE THAT, WE START COUNTING AT -1. + CAMG IN,BEGV + JRST POPJ1 + SOS IN + CALL GETCHR + CAIE CH,^M + JRST POPJ1 + AOS RRIDBK + JRST RRLID8 + +SUBTTL PRINTING TERMINAL ^R DISPLAY + +;DISPLAY CURRENT LINE AND PUT TTY CURSOR IN RIGHT PLACE, FOR PRINTING TTY SCAN MODE. +RRDIS3: SKIPN RRSCAN + RET + CALL RRBTCR + SETZM RRVPOS ;TYPE LINE UP TO POINT (0T) + SETZM RUBENC + CALL DISTOT + SETZ C, + CALL GETAG7 ;FIND RANGE (0F^@). + JFCL + .I GEA=E-BEGV + CALL TYPE2 ;TYPE IT. + TRO FF,FRCLN + MOVEI C,1 + CALL GETAG7 ;NOW TYPE TO END OF LINE. + JFCL + CAMN C,E + RET + CALL TYPE2 ;AND BS OVER IT, SAYING MUST DO A LF IF WE ARE AT THE END OF THE LINE. + JRST RRTTY2 + +;HERE TO HANDLE CURSOR MOTION, ON PRINTING TERMINAL IN SCAN MODE. +RRTTY: SKIPN RRSCAN + JRST RRBTCR + TRNN FF,FRARG ;IF WE KNOW NOTHING ABOUT THIS OPERATION, DON'T DISPLAY. + JRST RRBTCR ;WE COULDN'T DO ANYTHING BUT ^L; LET USER DECIDE ON THAT. + TRNE FF,FRARG2 + JRST RRTTID ;JUMP IF IT'S AN INSERT/DELETE OPERATION. + CALL RRMAC3 + SKIPGE RRMNVP + RET + MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,CPOPJ +RRTTY1: SKIPN RGETTY ;HERE TO SCAN MOTION CAUSED BY BUILT-IN ^F, ETC. + SKIPN RRSCAN + RET + MOVE A,RRVPOS ;SHOW THE USER THE CURSOR MOTION IN SOME NICE WAY. + SUB A,RREVPS ;UNLESS WE'RE ON THE SAME LINE, OR THE NEXT ONE, + JUMPL A,CPOPJ + CAIL A,2 ;DON'T JUST GO OFF AND PRINT LOTS OF GARBAGE; + RET ;LET USER DECIDE WHETHER TO REDISPLAY THE BUFFER. + MOVE C,PT + MOVE E,RREPT ;FORWARD HORIZONTAL MOTION => TYPE CHARS MOVED OVER. +RRTTY4: CAMGE E,C + JRST RRTTYF + CAMG E,C ;NO MOTION, EVEN, => STILL PREVENT ECHOING. + JRST RRTTY3 +RRTTY2: SKIPE A,RUBENC ;NO NEED TO LF BETWEEN TWO BACKWARD MOTION CMDS. + CAIN A,^J ;ASIDE FROM THAT, IF LAST THING DONE WANTED STUFF TYPED, + CAIA ;TYPE IT. + CALL RUBEND + CALL RRMVC ;BUT IF BACKWARD MOTION, JUST MOVE BACK TO HPOS, BUT + MOVEI A,^J + SKIPN BSNOLF + MOVEM A,RUBENC ;MAKE SURE WE TYPE A LF BEFORE TYPING ANYTHING ON THIS LINE. +RRTTY3: SETOM ECHCHR ;MAKE THIS COMMAND NOT BE ECHOED. + RET + +RRTTYF: SAVE DISPCR ;HERE TO SCAN FORWARD MOTION: TYPE CHARS MOVED OVER, + SETOM DISPCR ;WITH FS ^M PRINT$ SET TO -1 SO THAT STRAY CR AND LF + CALL TYPE2 ;COME OUT AS THEMSELVES. + REST DISPCR + RET + +;COME HERE AFTER A COMMAND. IF IN SCAN MODE ON PRINTING TTY, AND COMMAND DIDN'T +;TYPE ANYTHING, ECHO IT (BY TYPING THE CHAR OR STRING IN FS ECHO CHAR$). +RRTTYE: MOVE CH,ECHCHR + CAME CH,[-1] + SKIPE RGETTY + RET + SKIPGE GEA ;DON'T ECHO A ^L OR SIMILAR CHAR. + RET + SKIPE RRSCAN + SKIPN RRLAST ;DON'T ECHO ARG-SETTING COMMANDS. + RET + CAIL CH, + CALL TYINRM ;IF IT'S A CHAR (NOT A STRING) CONVERT TO 7-BIT. + JRST FSECO1 + +RUBEND: SAVE CH ;AND IF THERE'S ANYTHING TO TYPE (SUCH AS LF AFTER + SKIPE CH,RUBENC ;BACKWARD MOTION IN ^R MODE), TYPE IT. + CALL FSECOR + SETZM RUBENC + JRST POPCHJ + +;COME HERE TO HANDLE A COMMAND THAT RETURNED 2 VALUES, ON A PRINTING TTY IN SCAN MODE. +RRTTID: MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,RRBTCR + MOVE C,NUM + MOVE E,SARG + CAML E,C + EXCH C,E + CALL GETANU ;E, C GET THE CHAR ADDRS OF START AND END OF CHANGED RANGE. + CAME C,PT ;WE DON'T KNOW HOW TO HANDLE IT UNLESS POINT WAS PUT AT END. + JRST RRBTCR + .I C-E + CAML TT,RRTTMX ;IS SIZE OF RANGE CHANGED BELOW THRESHHOLD? + JRST RRBTCR ;TOO MANY CHANGES => DON'T PRINT THEM. + CAMN E,RREPT ;DID CHANGES START AT THE OLD POINT? + JRST RRTTI1 + SAVE C ;IF NOT, MOVE BACK TO WHERE CHANGES STARTED. + SAVE E + SAVE PT + MOVEM C,PT ;MOVE RRVPOS, RRHPOS TO THE POSITION OF THAT PLACE. + CALL RRMAC3 + REST PT ;BUT DON'T REALLY SET PT THERE. + MOVE C,(P) + MOVE E,RREPT ;NOW "MOVE BACK" THERE "FROM" WHERE PT USED TO BE. + CALL RRTTY4 + REST E + REST C +RRTTI1: CALL RRBTCR + CAME E,C ;NOW TYPE ALL THE NEW TEXT, LEAVING CURSOR AT POINT + JRST RRTTYF ;SINCE POINT IS WHERE THE NEW TEXT ENDS. + RET + +SUBTTL ^R COMMAND DISPATCH + +;COME HERE TO HANDLE INPUT (NO DISPLAY NEEDED OR INPUT KNOWN TO BE WAITING). +RRLP1: TLNE FF,FLNOIN ;IF WE'RE DOING AN "^ V", RETURN + CALL RREXIT ;(DOESN'T COME BACK) AFTER DISPLAYING ONCE. + CALL TYIW0 ;READ A CHARACTER + CAIN CH,TOP+"H ;IGNORE "HELP" (FS HELPMAC$ ALREADY RUN, IF APPROPRIATE), + JRST RRLP ;BUT DO GO TO RRLP SO SPACE WILL FLUSH HELPMAC'S TYPEOUT. + ANDI CH,777 + MOVEM CH,$Q..0 ;PUT CHAR WHERE USER MACRO DEFINITION CAN FIND IT. + MOVEM CH,RRLAST ;ALSO PUT IT IN FS ^R LAST$. + MOVEM CH,ECHCHR ;FOR PRINTING TTY, REMEMBER WHICH CHAR TO ECHO. + SKIPN RGETTY + SKIPE RRECHO ;DECIDE WHETHER TO ECHO ^R INPUT. + SKIPGE RRECHO + CALL [CALL TYINRM ;MUST NORMALIZE CHARACTER BEFORE OUTPUTTING, + JRST FSECO1] + MOVE CH,$Q..0 ;(IN CASE WE CALLED TYINRM). + SAVE [RRLP] + CALL RRARGD ;PUT VALUE OF COMMAND'S ARG IN C. +RRLP7: CALL RRLEA2 ;NOW SET UP "RRE" VARS IN CASE RRTTY CALLED AFTER CMD. + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;COMMAND WILL SET ..H TO SAY ^R SHOULD WAIT BEFORE DISPLAYING. + CAMN CH,CASSFT ;F$ CASE CTL CHRS DON'T HAVE FIXED VALUES. + JRST RRSFT + CAMN CH,CASLOK ;SO THE DISPATCH TABLE CAN'T CHECK FOR THEM. + JRST RRLOK + CALL RRCASC ;IF IN F$ MODE, DO CASE CONVERSION. + TRNN CH,META + JRST RRLP7I + TRNE CH,CONTRL ;META NON-CONTROL CHARACTERS ALL SELF-INSERT + JRST RRLP7J + SKIPLE RRRPLC ;IF IN FS ^R REPLACE$ > 0 MODE. + JRST RRXINS +RRLP7J: TRNE CH,CONTRL ;CONTROL-META LETTERS SELF INSERT IF FS CTLMTA$ NEGATIVE. + TRNN CH,100 + JRST RRLP7I + SKIPGE RRCMQT + JRST RRXINS +RRLP7I: +;"INDIRECT" (RRINDR) DEFINITIONS LOOP BACK HERE. +RRIND1: MOVE E,RRMACT(CH) ;GET CURRENT DEFINITION OF CHARACTER. + SKIPL RRALQT ;UNLESS DEFINITIONS ARE SUPPRESSED, + SKIPGE RRUNQT + JRST RRLP7D ;USE THE DEFINITION + CAME CH,RRALQT ;ELSE IF THIS IS NOT THE UNQUOTING CHAR, + JRST RRLP7B ;MAKE IT SELF-INSERTING. + SETOM RRUNQT ;IF IT IS, REENABLE DEFINITIONS FOR 1 COMMAND. + SETZM RRLAST ;DON'T FLUSH NEXT COMMAND'S ARGUMENT. + RET + +;HANDLE A CHARACTER IN SUPPRESS MODE. +RRLP7B: JUMPL E,RRLP7E ;IF ITS DEF. IS A MACRO, SEE WHETHER IT STARTS WITH "W". + MOVEI A,(E) + CAIE A,RRINDR + CAIN CH,177 + JRST RRLP7D ;RUBOUT WORKS EVEN IN SUPPRESS MODE. +RRLP7F: CAIN CH,CONTRL+"M ;OTHER CHARS BECOME SELF-INSERTING. + SKIPA E,[RRCRLF,,RRREPT] +RRXINS: SKIP E,RRXINV + SKIPN E + MOVE E,[RRDINS,,RRREPI] +RRLP7D: SKIPGE A,E ;COME HERE TO USE WHATEVER DEFINITION IS IN E. + JRST RRMAC0 ;EITHER A MACRO OR A BUILT-IN FUNCTION. +RRLP7H: TRZ FF,FRCLN\FRUPRW + LDB A,[331100,,(E)] ;BUILT-INS MUST START WITH A "SKIP" (THAT DOESN'T SKIP EVER). +IFN ITS,CAIE A,.BREAK_-33 ;DON'T BE CONFUSED BY BREAKPOINTS. +IFN TNX,CAIE A,JSYS_-33 ;BPT MAYBE? + CAIN A,SKIP_-33 + JRST (E) + TYPRE [M%R] + +RRLP7E: MOVE A,E ;MACRO-CHAR. TYPED IN SUPPRESS MODE. + CALL QLGET1 + JRST RRLP7F + ILDB TT,BP ;WHAT IS ITS 1ST CHARACTER? + CAIE TT,"W+40 + CAIN TT,"W ;IF IT DOESN'T START WITH A "W" THEN THE DEFINITION IS SUPPRESSED. + JUMPG B,RRLP7D ;IF IT STARTS WITH "W", THEN EXECUTE DEFINITION EVEN IN SUPPRESS MODE. + JRST RRLP7F + +SUBTTL ^R CHARACTER FORWARD/BACKWARD + +;^B - MOVE BACKWARDS ONE CHARACTER. +;UPDATES RRHPOS AND RRVPOS. LEAVES THE CHAR MOVED OVER IN CH. +;LEAVES PT IN IN. CLOBBERS OUT, TT, TT1, A, C. +RRBACK: MOVE IN,BEGV ;ERROR IF AT BEGINNING OF BUFFER. + CAML IN,PT + JRST RRERR +RRBAC4: SOS IN,PT ;GET THE CHAR BEFORE THE PTR + CALL GETCHR +RRBAC0: RRCHRG ;GET CHAR'S DISPATCH TYPE CODE IN A. + XCT RRBACT(A) +RRBAC1: SOS A,RRHPOS + JUMPGE A,CPOPJ +RRBAC3: ADD A,NHLNS ;MOVED OVER LINE-CONTINUATION. + MOVEM A,RRHPOS ;GO BACK TO PREV. LINE'S END. +RRBACV: SOS RRVPOS + POPJ P, + +RRBACT: SOSA A,RRHPOS ;ORD. CHAR., BACK 1 POS. + JRST RRBACC ;NON-FORMATTING CONTROL CHARS. + JRST RRBACH ;^H, CHECK ^HPRINT FLAG. + JRST RRBACR ;^M, SPECIAL. + JRST RRBACL ;^J, UP 1 LINE. + SAVE [RRBTCR] ;TAB, COMPUTE RRHPOS BY MOVING FWD + ;FROM PREVIOUS CR. + JRST RRBAC2 ;2-POS CTL CHARS NO AFFECTED BY FS SAIL (^P AND ^C). + +RRBACR: ADDI IN,1 ;CR: IS IT FOLLOWED BY LF? + CALL GETCHR + MOVEI A,(CH) + MOVEI CH,^M + CAMGE IN,ZV + CAIE A,^J ;IF THIS CR REALLY CAME OUT AS CR, + SKIPGE DISPCR + JRST RRBTCR ;COMPUTE HPOS THE HARD WAY. + SUBI IN,1 +RRBAC2: SOS RRHPOS ;IF IT CAME OUT AS UPARROW-M, + JRST RRBAC1 ;TREAT AS 2-POS CTL CHAR. + +RRBACL: SUBI IN,1 ;LF: SEE IF PREV. CHAR IS CR. + CALL GETINC + MOVEI A,(CH) + MOVEI CH,^J + CAML IN,BEGV + CAIE A,^M ;BASED ON THAT AND ON DISPCR, DECIDE HOW LF WAS PRINTED OUT. + SKIPGE DISPCR + JRST RRBACV + JRST RRBAC2 + +RRBACH: SKIPL DISPBS ;MOVE BACK OVER ^H - IF IT CAME OUT AS + JRST RRBACC ;UPARROW-H, TREAT AS ORDINARY CTL CHAR. + MOVE A,RRHPOS ;ELSE, IF WE KNOW IT CAME OUT AS A BACKSPACE, IT'S SIMPLE. + CAIG A,2 + JRST RRBTCR ;NEAR MARGIN, WE CAN'T BE SURE, SO MUST SCAN FORWARD. + AOS RRHPOS + RET + +;NON-FORMATTING CONTROL CHARS, CHECK SAIL FLAG. +RRBACC: SKIPN DISSAI + JRST RRBAC2 ;NORMALLY, MOVE BACK 2 POS. + JRST RRBAC1 ;IN SAIL MODE, MOVE 1 POS. + +;^F -- MOVE FWD 1 CHAR. SEE THE COMMENTS BEFORE RRBACK. +RRFORW: MOVE IN,PT ;ERROR IF AT END OF BUFFER. + CAML IN,ZV + JRST RRERR + CALL GETINC +RRFOR0: AOS PT + RRCHRG + XCT RRFORT(A) ;DISPATCH ON TYPE OF CHAR. +RRFOR1: AOS A,RRHPOS +RRFOR3: CAMGE A,NHLNS ;HAVE WE MOVED PAST RIGHT MARGIN? + POPJ P, + CAMN A,NHLNS ;CHECK FOR JUST REACHING THE RIGHT MARGIN. + JRST [ SAVE CH ;IF REACH RIGHT MARGIN, MUST + MOVE IN,PT ;CONTINUE PROVIDED WE'RE NOT AT + CALL RREOLT ;THE END OF THE LINE. + JRST POPCHJ ;AT END OF LINE, NOTHING TO DO. + REST CH ;NOT AT EOL, CONTINUE. + MOVE A,RRHPOS + JRST .+1] + SUB A,NHLNS + MOVEM A,RRHPOS +RRFORV: AOS RRVPOS + POPJ P, + +RRFORT: AOSA A,RRHPOS ;ORDINARY CHAR, MOVE FWD 1 POS. + JRST RRFORC ;NON-FORMATTING CONTROLS. + JRST RRFORH ;MOVE FWD OVER ^H - CHECK ^HPRINT FLAG. + JRST RRFWCR ;^M, SPECIAL. + JRST RRFORL ;^J, DOWN 1 LINE. + JRST RRFOTB ;^I + JRST RRFOR2 ;2-POS CTL CHRS NOT AFFECTED BY FS SAIL (^P AND ^C). + +RRFOTB: MOVE TT,RRHPOS + MOVEI A,10(TT) + ANDCMI A,7 ;A HAS NEXT TAB STOP'S POSITION. + CAMLE A,NHLNS ;BUT IF THAT'S OFF THE SCREEN, TAB STOP IS RIGHT MARGIN, + CAMN TT,NHLNS ;UNLESS WE'RE ALREADY AT THE MARGIN, IN WHICH CASE + CAIA ;WE CAN TAB 8 SPACES INTO NEXT LINE VIA CONTINUATION. + MOVE A,NHLNS + MOVEM A,RRHPOS + JRST RRFOR3 + +RRFWCR: SKIPGE DISPCR + JRST RRFWC1 + CALL GETCHR ;CR - SEE IF NEXT CHAR IS LF. + MOVEI A,(CH) + MOVEI CH,^M ;MAKE SURE WE RETURN CHAR BEING PASSED IN CH. + CAMGE IN,ZV + CAIE A,^J + JRST RRFOR2 ;NO, CR CAME OUT AS UPARROW-M +RRFWC1: SETOM RRHPOS ;(RRHPOS WILL BE AOS'D TO 0) + JRST RRFOR1 + +RRFORL: SKIPGE DISPCR ;LF: BASED ON WHETHER A CR PRECEDES IT AND ON DISPCR, + JRST RRFORV + SUBI IN,2 + CALL GETCHR ;DECIDE HOW THE LF CAME OUT AND THEREFORE + MOVEI A,(CH) + MOVEI CH,^J + MOVE TT,IN + ADDI IN,2 + CAML TT,BEGV + CAIE A,^M ;HOW TO MOVE OVER IT. + JRST RRFOR2 + JRST RRFORV + +RRFORH: SKIPGE DISPBS ;MOVING FWD OVER ^H -IF CAME OUT AS + SKIPN RRHPOS + JRST RRFORC + JRST RRBAC1 ;REAL ^H, MOVE BACK 1 POS + +;NON-FORMATTING CONTROLS, CHECK FS SAIL FLAG. +RRFORC: SKIPE DISSAI ;IN SAIL MODE, THEY'RE 1-POS GRAPHICS. + JRST RRFOR1 +RRFOR2: AOS RRHPOS ;ELSE TREAT AS 2-POS CTL CHAR. + JRST RRFOR1 + +;MAKE SURE RRHPOS IS CORRECT BY MOVING BACK TO THE LAST CR THAT +;REALLY CAME OUT AS A CR, AND MOVING FORWARD AGAIN. PT IS UNCHANGED. +;THE LARGEST HPOS THAT OCCURS ON THE LINE UP TO PT IS RETURNED IN OUT. +;PT IS RETURNED IN IN. CLOBBERS TT, TT1. +;A CONTAINS ADDR OF THE CR WE WENT BACK TO (+1), AND B HAS VPOS DIFFERENCE FROM THERE. +RRBTCR: SAVE CH + SAVE RRVPOS ;VPOS WILL BE ALTERED WHILE WE MOVE FWD + ;BUT WE REALLY DON'T WANT IT CHANGED. +RRBTC5: SAVE PT ;REMEMBER WHERE TO STOP WHEN MOVE FWD AGAIN. + MOVE A,GEA ;1ST, FIGURE OUT WHERE TO STOP MOVING BACKWARD + ADD A,BEGV ;IF WE DON'T FIND A CR. 1ST CHAR ON SCREEN + ;IS ONE PLACE. BEGINNING OF BFR IS ANOTHER. + SKIPL GEA + CAMLE A,PT ;(AT BOTH PLACES, HPOS MUST BE 0) + MOVE A,BEGV ;USE WHICHEVER WE'LL REACH SOONER. + MOVE B,PT ;STOP IN ANY CASE AFTER MOVING BACK 10000 CHARS. + SUBI B,10000. ;AT THAT POINT, BETTER TO CHOOSE A NEW WINDOW AND START OVER! + CAMG B,A ;NOW B GETS WHICHEVER OF THOSE TWO STOPPING POINTS IS REACHED FIRST. + MOVE B,A + SETZ OUT, ;ON 1ST PASS OUT=-1 => AN LF HAS BEEN PASSED GOING BACKWARDS. +RRBTC0: MOVE IN,PT + CAMG IN,B ;REACHED A STOPPING POINT => WHICH KIND? + JRST [ CAMN B,A ;A LEGITIMATE ONE (BEG OR TOP OF SCREEN) => + JRST RRBTC1 ;WE CAN JUST SCAN FORWARD FROM THERE. + REST PT + CALL [ CALL SAVACS + CALL VBDBLS ;ELSE, COMPUTE A NEW TOP OF SCREEN + JRST RSTACS] + JRST RRBTC5] ;AND TRY AGAIN. + SOS IN,PT + CALL GETINC ;ELSE, KEEP GOING BACK. + CAIN CH,^J + SETO OUT, ;REACHED LF => SAY NOT ON LINE WE STARTED ON. + CAIE CH,^M ;REACHED CR => SEE WHETHER IT CAME OUT AS ONE. + JRST RRBTC0 + JUMPE OUT,RRBTC0 ;BUT DON'T STOP AT ANY CR IF WE HAVEN'T GONE UP AT LEAST ONE LINE. + SKIPGE DISPCR + JRST RRBTC4 + CALL GETCHR + CAIE CH,^J + JRST RRBTC0 + AOS PT ;START AFTER THE CR AND THE LF. +RRBTC4: AOS PT ;START AFTER THE CR. +RRBTC1: SETZB OUT,RRHPOS ;AT THE CR, KNOW HPOS IS 0. + SAVE PT ;REMEMBER WHERE WE WENT BACK TO, TO RETURN IT IN A. + SAVE RRVPOS +RRBTC2: MOVE IN,PT ;REACHED WHERE WE STARTED? + CAMN IN,-2(P) + JRST RRBTC3 ;YES, FLUSH STACK & EXIT. + CALL RRFORW ;MOVE FWD TILL GET THERE. + MOVE A,RRVPOS ;IF WE'VE MOVED TO ANOTHER LINE, + CAME A,(P) + JRST [ MOVEM A,(P) ;THEN THE CHARS SEEN SO FAR ARE NOT ON THE SAME + SETZ OUT, ;LINE RRBTCR STARTED ON, SO THEY DON'T COUNT + JRST RRBTC2] ;IN OUT'S VALUE. + CAML OUT,RRHPOS ;IF CURRENT HPOS IS > LARGEST SO FAR, + JRST RRBTC2 + MOVE OUT,RRHPOS ;UPDATE MAXIMUM-HPOS-ON-CURRENT-LINE. + JRST RRBTC2 + +RRBTC3: REST B ;RETURN IN B THE VPOS DIFFERENCE WE MOVED OVER. + REST A ;RETURN IN A THE ADDR OF WHERE WE WENT BACK TO. + SUB P,[1,,1] + REST RRVPOS + SUB B,RRVPOS + JRST POPCHJ + +SUBTTL ^R MODE ARGUMENT PROCESSING + +;^U - MULTIPLY REPEAT COUNT OR WHATEVER BY 4. +RR4TIM: SKIP + AOS RR4TCT + MOVEI TT,1 + JRST RRNXI2 ;SET RRARGP TO SAY NON-NULL ARG. + +;^V - READ IN A NUMERIC ARGUMENT. +;THE CHARS OF THE ARG ARE ECHOED IN THE ECHO AREA. +;^G CANCELS THE ARG. ANY OTHER NON-DIGIT IS TREATED AS A COMMAND +;WHICH USES THE ARG (THIS INCLUDES RUBOUT). THE ARG IS LEFT IN RRRPCT. +RRARG: SKIP C,[0] ;WE'LL COMPUTE ARG'S VALUE IN C. + CALL RRECSP ;TYPE A SPACE AT BOTTOM OF SCREEN. +RRARG0: CALL TYIW0 ;READ CHAR: EITHER PART OF ARG, OR NEXT COMMAND. + MOVEM CH,$Q..0 ;IF THE LATTER, IT WILL EXPECT TO BE IN Q..0. + CAIN CH,"- + JUMPE C,[SAVE [RRARGN] ;1ST CHAR IS "-" => NEGATE ARG. + JRST RRARG1] + CAIL CH,"0 + CAILE CH,"9 + JRST RRARGX ;NON-DIGIT: TERMINATE ARG. + IMUL C,IBASE ;DIGIT: PUT IT IN ARG. + ADDI C,-"0(CH) +RRARG1: CALL FSECO1 ;AND PRINT IT IN THE ECHO AREA. + JRST RRARG0 + +RRARGX: MOVEM C,RRRPCT ;SAVE AWAY THE ARG WE READ. + MOVEM CH,UNRCHC ;REPROCESS THE ARG-TERMINATING CHAR AS A COMMAND WITH THAT ARG + JRST RRNXIT ;SAY THERE'S AN ARG IN RRRPCT. + +RRARGN: MOVNS RRRPCT + RET + +RRCMNS: SKIP ;CONTROL-MINUS: SET BIT SAYING NEGATE THE ARGUMENT. + MOVEI TT,5 + JRST RRNXI2 + +RRCDGT: SKIP TT,RRRPCT ;CONTROL-DIGITS: ACCUMULATE AN ARGUMENT. + IMUL TT,IBASE + ANDI CH,77 ;WIN FOR META DIGITS AND C-M-DIGITS. + ADDI TT,-60(CH) + MOVEM TT,RRRPCT +RRNXIT: MOVEI TT,3 +RRNXI2: IORM TT,RRARGP + SETZM RRLAST ;SAY THIS IS AN ARG-SETTING COMMAND; + RET ;DON'T FLUSH ARG OR CLOBBER FS ^R PREV$. + +;COMMANDS THAT WANT TO BE REPEATED A NUMBER OF TIMES EQUAL +;TO THE NUMERIC ARG DISPATCH THRU HERE. +;(THAT IS, THE DISPATCH WD HOLDS ,,RRREPT ) +RRREPT: SKIP ;TELL RRLP7H ERROR-CHECK WE'RE GOOD GUYS. + HLRZS E ;PUT IN RH. +RRREP1: JUMPLE C,POPJ1 ;C HAS -<# TIMES ALREADY DONE> + CAIN C,1 ;IF CALLING FOR THE LAST TIME, THEN IF COMMAND SKIPS WE SHOULD. + JRST (E) ;(THUS RETURNING 1 VAL IF CALLED WITH M COMMAND, OR TRIGGERING RRTTY). + SAVE E + HRLM CH,(P) ;SAVE CMD RTN ADDR AND THE CHAR. + SAVE C ;AND # TIMES REMAINING. + CALL (E) ;DO IT ONCE + JFCL + REST C + REST E + HLRZ CH,E + SOJA C,RRREP1 + +;LIKE RRREPT, BUT IF REPEAT COUNT IS > 8 THEN SAY IN ADVANCE THAT +;REDISPLAY IS NEEDED (TO INHIBIT UPDATING). +;USED TO REPEAT INSERT COMMANDS, SO THAT ^U^UA DOESN'T +;RUN SLOWLY BY TYPING OUT AN A AT A TIME. +RRREPI: SKIP + HLRZS E +RRREP2: CAIG C,8 + JRST RRREP1 + SKIPN RRMAXP ;RRMAXP=1 INHIBITS UPDATING BUT DOESN'T MARK ANY ACTUAL PART + AOS RRMAXP ;OF THE BUFFER AS NEEDING REDISPLAY. THE INSERT RTN WILL CHANGE + JRST RRREP1 ;RRMAXP TO INCLUDE WHAT IT INSERTS. + +;COMPUTE THE ARGUMENT FROM THE EXPLICIT ARGUMENT AND +;THE POWER-OF-4. RETURN IN C. +RRARGD: MOVE TT,RRARGP ;GET THE EXPLICIT ARG, OR 1 IF NONE SPEC'D. + TRNE TT,2 + SKIPA C,RRRPCT + MOVEI C,1 + TRNE TT,4 ;IF ^- SET THE 4 BIT, NEGATE THE ARG. + MOVNS C + MOVE TT,RR4TCT ;THEN MULTIPLY BY 4 FOR EACH ^U. + SOJGE TT,[LSH C,2 ? JRST .] + RET + +;AFTER A COMMAND, IF IT DIDN'T IDENTIFY ITSELF AS AN ARGUMENT-SETTING COMMAND +;(BY CLEARING RRLAST), FLUSH THE ARGUMENT THAT THE COMMAND USED. +RRARGF: SKIPN TT,RRLAST ;IF THE LAST COMMAND DIDN'T PRESERVE OR MAKE AN ARG, + RET + MOVEM TT,RRPRVC ;REMEMBER IT AS "PREVIOUS COMMAND" FOR NEXT COMMAND, + SETZM RRARGP ;SAY TO GIVE NEXT COMMAND THE DEFAULT ARG (1) + SETZM RR4TCT ;AND CLEAR ARG ACCUMULATION VARIABLES. + SETZM RRRPCT + SETZM RRUNQT + RET + +;COME HERE FOR ^G. +RRQUIT: SKIP TT,CASNRM ;NOTE: THIS RTN IS CALLABLE BY RRLP7H, SO NEED "SKIP" + MOVEM TT,CASE ;IN F$ MODE, UNDO ANY CASE-LOCKAGE. + SETOM RRMKPT ;ELIMINATE THE MARK. + SKIPE NELNS + CALL ECHOCR ;GO TO NEW LINE IN ECHO REGION + SETOM RROVPO ;FORCE CURSOR REPOSITIONING + +;ERROR DETECTED BY RR EDIT: +RRERR: SKIP + SKIPE RREBEG ;IF NOT INSIDE ^R, GIVE A TECO ERROR. + TYPRE [BEL] + MOVE P,DISPRR + JRST TYPBEL ;TYPE A BELL AND REENTER MAIN LOOP. + +;"UNDEFINED" ^R COMMAND CHARACTERS HAVE THIS DEFINITION, WHICH TYPES A BELL +;AND RETURNS 1 VALUE. THIS AVOIDS GETTING A "BEL" ERROR, IF UNDEFINED CHAR +;IS RUN WITH M^R. +RRUNDF: SKIP + AOS (P) + JRST TYPBEL + +;EXPECT CHAR ADDR IN "IN", SKIP UNLESS IT POINTS TO THE END +;OF THE BUFFER OR THE END OF A LINE. CLOBBERS TT, TT1 +RREOLT: CAMN IN,ZV + POPJ P, ;AT EOF. + SAVE CH + CALL GETINC + CAIN CH,^M + CAMN IN,ZV + SOJA IN,POPCH1 ;BEFORE A CR THAT'S THE LAST CHAR. + CALL GETCHR + SUBI IN,1 + CAIE CH,^J +POPCH1: AOS -1(P) ;BEFORE A STRAY CR => NOT AT EOL. + JRST POPCHJ ;BEFORE A CRLF => EOL. + +;CHECK IF THE CURRENT LINE HAS TABS IN IT AFTER PT, WHICH MIGHT MAKE +;AVOIDING REDISPLAY TOO HARD, SKIP IF NONE FOUND AND BUFFER LINE DOES NOT +;WRAP AROUND TO SEVERAL SCREEN LINES +RRNTBP: SAVE BP + MOVE IN,PT + CALL GETIBI ;GET POINTER TO CURRENT POSITION +RRNTB1: CAMN IN,ZV + JRST RRNTB3 ;AT THE VERY END, OK NO TABS THEN + CAMN IN,GPT + CALL FEQGAP ;MOVE OVER GAP + ILDB CH,BP +RRNTB2: CAIN CH,^I ;IS IT A TAB? + JRST POPBPJ ;YES, FAILURE THEN + CAIE CH,^M ;GOT TO CR? + AOJA IN,RRNTB1 ;NO, KEEP LOOKING + AOJ IN, + CAMN IN,ZV + JRST RRNTB3 + CAMN IN,GPT + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;REALLY AT CRLF? + AOJA IN,RRNTB2 ;NO, STRAY CR + SUBI IN,1 ;CHECK HPOS JUST BEFORE THE CR. +RRNTB3: SKIPGE DISTRN ;IF WE ARE JUST TO TRUNCATE LONG LINES + JRST POPBP1 ;THAT'S ENOUGH CHECKING, SKIP RETURN +INSIRP PUSH P,RRHPOS RRVPOS PT E + MOVE E,IN + CALL RRMOV ;FIND POSITION OF END OF LINE (AS OF LAST REDISPLAY) + MOVE TT,RRHPOS ;GET NEW VALUES + MOVE TT1,RRVPOS +INSIRP POP P,E PT RRVPOS RRHPOS + CAME TT1,RRVPOS ;ON THE SAME LINE? + JRST POPBPJ ;NO, MUST REDISPLAY THEN + CAMGE TT,NHLNS ;ALSO IF THIS WOULD BE DISPLAYED PAST END OF LINE +POPBP1: AOS -1(P) ;SUCCESS RETURN + JRST POPBPJ + +;IF A CHARACTER 'S DEFINITION IS ,,RRINDR, IT IS AN INDIRECT PTR +;TO THE DEFINITION OF THE CHARACTER -. USED TO HANDLE +;THE LOWER CASE CONTROL CHARACTERS SUCH AS 341 = CTL-LOWERCASE-A. +;ALSO USED TO MAKE CONTROL-H EQUIVALENT TO BACKSPACE; SIMILAR FOR TAB & LF. +RRINDR: SKIP + HLRZS E ;GET + SUB CH,E + JRST RRIND1 ;GO USE DEF'N OF -. + +SUBTTL ^R MODE SINGLE CHARACTER DELETION AND INSERTION + +RRDLNB: MOVNS C ;HERE FOR DELETE BACKWARD WITH NEGATIVE ARG. + JRST RRCTD1 + +;^D -- DELETE FORWARD. (D) +RRCTLD: SKIP + JUMPGE C,RRCTD1 + MOVNM C,RRRPCT ;IF NEGATIVE ARG, SET ITS NEGATION UP AS ARG + .I RRARGP=3 + SETZM RR4TCT + MOVEI CH,177 ;AND TURN INTO RUBOUT. + JRST RRIND1 + +RRCTD1: JSP E,RRREP1 + MOVE IN,PT + CAML IN,ZV + JRST RRERR + JSP E,RRTYPP ;ON PRINTING TTY, MAYBE TYPE SCAN INFO + CALL [ SETCM E,TTYOPT + CALL GETCHR ;GET CHARACTER ABOUT TO DELETE + MOVEI A,(CH) + MOVEI CH,"/ + TLNE E,%TOOVR\%TOMVB ;IF CAN BACKSPACE AND OVERPRINT, OVERPINT A SLASH. + CAIN A,^M ;ABOUT TO DELETE A CRLF, TYPE A SLASH. + CALL FSECOR + MOVEI CH,^H ;BS OVER IT IF OVERPRINTING + TLNN E,%TOOVR\%TOMVB + CALL FSECOR + MOVEI CH,(A) ;GET CHARACTER AGAIN + CALL FSECOR + SKIPN BSNOLF + RET + JRST RRMVC] ;THEN ECHO THE CHAR BEING DELETED. + SKIPN RUBCRL ;IF FS RUBCRLF$ NONZERO, + JRST RRDLF + CALL RREOLT ;IF BEFORE A CRLF, DELETE BOTH CHARS. + JRST [ CALL GAPSLP + CALL DEL1F ;DELETE THEM AT ONCE, AND DON'T TRY TO DO UPDATING. + CALL DEL1F + MOVE BP,RRVPOS + MOVE T,RRHPOS + MOVNI A,2 + JRST RRFXM1] + +;INTERNAL ROUTINE TO DELETE FORWARD. +RRDLF: CALL RRFORW ;MOVE OVER THE CHAR, THEN DELETE IT BACKWARD. + +;INTERNAL ROUTINE TO DELETE BACKWARD (-D). DELETED CHAR LEFT IN CH. +;CLOBBERS A,B,IN,OUT,TT,TT1,Q, T, BP +RRDLB: SETOM RRMKPT + MOVE IN,PT ;ERROR AT BEGINNING OF BUFFER. + CAMG IN,BEGV + JRST RRERR + SAVE RRVPOS ;REMEMBER VPOS TO RIGHT OF CHARACTER. + CALL RRBACK ;ACCOUNT FOR CURSOR POS CHANGE DUE TO DELETION. + CALL GAPSLP + CALL RRCRDI + CALL DEL1F ;DELETE FORWARD FROM BUFFER, NO CURSOR HACKERY. + CAIE CH,^H ;DELETING CHARS THAT MOVE LEFT IS HARD. + CAIN CH,^M + JRST RRDLB4 + CALL RRICHK ;SEE WHETHER IT'S EASY TO UPDATE SCREEN. + REST A + CAMN A,BP ;IF EFFECTS OF CHANGE REACH PREV. LINE, + SKIPE RRMAXP ;OR IF REDISPLAY WILL BE DONE ANYWAY. + JRST RRDLB1 ;DON'T BOTHER TO DO IT HERE. + SKIPN RRCIDP ;IF NEED TO DO SOMETHING WITH I/D OR TABS, + JRST RRDLB3 + CAIE CH,^I + SKIPN DISSAI + CAIL CH,40 ;BETTER NOT BE DIFFICULT CHARACTER + CAIN CH,177 + JRST RRDLB1 ;IF IT IS, JUST REDISPLAY +RRDLB3: CALL RRMVC ;UPDATE THE SCREEN NOW: + MOVNI T,1 ;UPDATE LINBEG WORDS OF ALL LINES + CALL RRINS3 ;BELOW THIS ONE. + MOVE BP,RRVPOS + SKIPGE T,RRCIDP + JRST [ SETOM HCDS(BP) ;IF MOVING CHARS TO NEW HPOSES, WE CAN'T FIX THE HASHCODE. + JRST DELCHR] + CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE + SKIPN DISSAI ;USING RRHPOS AS THE HPOS FOR COMPUTING IT. + CAIL CH,40 + CAIN CH,177 + SETOM HCDS(BP) ;BUT THAT DOESN'T WIN FOR 2-PLACE CHARACTERS. + JUMPG T,ERSCHR ;NOW GO CLEAR OUT THE APPROPRIATE PARTS OF THE SCREEN. + JRST CLREOL + +RRDLB4: SUB P,[1,,1] ;FLUSH SAVED VPOS. FROM STACK. + SKIPGE DISPCR + SETZ T, ;DELETING A REAL STRAY CR => MUST REDISPLAY WHOLE LINE + ;TO GET RID OF OVERSTRUCK CHAR IN POSITION 0. +RRDLB1: MOVNI A,1 ;1 CHAR DELETED AT VPOS, HPOS IN BP,T. + JRST RRFXM1 + +FSRRRU: ARGDFL Z ;FS ^R RUBOUT$ + SAVE [RRLEA1] ;AFTERWARDS SET RREPT, RREHPS, RREVPS. + JSP E,RRREP2 + JRST RRDLB ;RUB OUT SPEC'D # OF CHARS WITH NO TAB OR CRLF HACKS. + +;BUILT-IN DEFINITION OF RUBOUT: DECODE ARGUMENT. +RRRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + JSP E,RRREP2 ;REPEAT ARG TIMES WHAT FOLLOWS (BUT FIRST OTHER STUFF) +RRRUBD: CALL RRDLB ;DELETE ONE CHAR BACKWARD + SKIPE RUBCRL ;AND THEN IF FS RUBCRLF$ NONZERO, AFTER RUBBING OUT A ^J + CAIE CH,^J + JRST RRRUBP + MOVE IN,PT ;FLUSH A CR BEFORE IT, TOO. + SOS IN + CAMGE IN,BEGV + JRST RRRUBP + CALL GETCHR + CAIN CH,^M + CALL RRDLB +RRRUBP: JSP E,RRTYPP ;ON PRINTING TTY, IF SCANNING, TYPE THE RUBBED CHARACTER. + CAIA ;NOTICE THAT IF RUBBING A CRLF WE COME HERE FOR THE CR + RET ;WHICH WILL ECHO AS CRLF. + MOVE E,TTYOPT + TLNE E,%TOMVB ;ON TTY THAT CAN'T BS, SURROUND RUBBED STUFF WITH \'S. + JRST RRRUBB + MOVEI IN,"\ + SAVE CH + MOVEI CH,"\ + CAME IN,RUBENC ;IF NOT YET INSIDE A \ PAIR, START ONE. + CALL FSECO1 + SETZM RUBENC ;IF INSIDE ONE ALREADY, DON'T END IT YET. + REST CH + CALL FSECOR ;TYPE THE RUBBED CHARACTER. + MOVEM IN,RUBENC ;FOLLOW WITH A \ WHEN WE STOP RUBBING OUT. + RET + +RRRUBB: CALL RRTTY2 ;MOVE CURSOR TO RIGHT PLACE. THIS KING OF RUBOUT CAN INTERMIX + MOVEI CH,"/ ;WITH BACKWARD MOTION. + CALL FSECOR ;OVERSTRIKE A / (MAY ERASE OR NOT, WHO CARES?) + JRST RRMVC + +;CTL-RUBOUT: LIKE RUBOUT, BUT CONVERTS TABS INTO SPACES FIRST. +RRCRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + JSP E,RRREP2 ;REPEAT THE FOLLOWING ARG TIMES: + SAVE RRHPOS + CALL RRBACK ;WE NEED HPOS BOTH BEFORE AND AFTER CHAR TO BE FLUSHED, + REST E ;IF IT'S A TAB. + CAIE CH,^I + JRST [ CALL RRFORW ;NOT TAB => UNDO THE RRBACK + JRST RRRUBD] ;AND DO A NORMAL RUBOUT. + CALL GAPSLP + SAVE PT + AOS (P) + CALL DEL1F ;ELSE FLUSH THE TAB AND PUT IN APPRO. # OF SPACES + SUB E,RRHPOS +RRCRU1: MOVEI CH,40 + CALL TYOM + SOS PT + CALL RRFORW ;MOVING FORWARD OVER THEM + SOJG E,RRCRU1 ;LEAVING US IN INITIAL STATE EXCEPT TAB REPLACED BY SPACES. + REST T + SUB T,PT + MOVNS T ;T HAS CHANGE IN PT DUE TO OUR INSERTION. + MOVE BP,RRVPOS + CAMGE BP,TOPLIN ;IF THE CHANGE IS ABOVE THE SCREEN, RELOCATE ALL LINBEGS IN THE WINDOW. + MOVE BP,TOPLIN + CAMGE BP,BOTLIN ;IF THIS CHANGE IS OFF THE END OF THE SCREEN, WE ARE DONE. + CALL RRINS3 ;RELOCATE LINBEG TABLE FOR WHAT WE HAVE DONE. + JRST RRRUBD ;THEN DELETE THE LAST SPACE. + +;COME HERE WHEN CASE-SHIFT IS READ. +RRSFT: MOVNS CASE ;READ NEXT CHAR IN ABNORMAL CASE. + AOSE RCHSFF + SETOM RCHSFF ;RESTORE TO NORMAL AFTER NEXT CHAR. + SKIPN RCHSFF ;ALLOW THE CASE-SHIFT TO QUOTE ITSELF. + JRST RRLP7J + +;TYPE THE CHAR IN Q..0 AS A PROMPT, IF THERE IS NO INPUT AVAILABLE. +RRECO1: SKIPE RGETTY + SKIPGE RRECHO ;ON DISPLAY TTY, IF NOT ECHOING THE COMMAND, + RET + MOVEI A,[ASCIZ /0^V^:FT..00 /] + JRST RRMACR + +;COME HERE FOR CASE-LOCK AS A COMMAND. +RRLOK: MOVNS CASE + POPJ P, + +;^O - INSERT CRLF, THEN BACK UP OVER IT. +RRCTLO: CALL RRCRL1 ;INSERT CRLF + JFCL + AOS (P) + CALL RRBACK ;THEN BACK OVER IT. + JRST RRBACK + +;^M - INSERT ^M AND ^J. +RRCRLF: CALL RRCMRU ;REMOVE TAB-SEMI'S FROM LINE WE'RE ON. +RRCRL1: MOVEI CH,^M + CALL RRINS ;INSERT THE ^M. + MOVEI CH,^J + JRST RRINSQ ;INSERT THE ^J. + +;^Q -- READ NEXT CHAR AND INSERT IT. +RRQUOT: SKIP + SAVE C + CALL RRECO1 ;FINISH DISPLAYING, MAYBE PROMPT WITH A "^Q". + CALL TYI ;READ THE CHAR TO BE QUOTED. + CALL TYINRM + REST C + JSP E,RRREP1 ;NOTE ^Q MUST DO ITS OWN REPETITION. + JRST RRINSQ ;OTHERWISE ^V5^Q WOULD READ AND INSERT 5 CHARS. + ;INSTEAD OF READING 1 CHAR AND INSERTING + ;IT 5 TIMES. + +;THIS IS THE DEFAULT DEFINITION OF "SELF-INSERTING" CHARACTERS: +;NORMALLY, JUST INSERT. META-CHARS INSERT. IF FS ^R REPLACE$ NONZERO, +;NON-META CHARS REPLACE INSTEAD (BUT AT END OF LINE, THEY INSERT). +RRDINS: MOVE CH,$Q..0 + TRNN CH,META + SKIPN RRRPLC + JRST RRINSC + MOVE IN,PT + CAML IN,ZV ;AT END OF BUFFER, JUST INSERT. + JRST RRINSC + CALL GETCHR ;HERE IF SUPPOSED TO TRY TO REPLACE. + CAIE CH,^M ;AT END OF LINE? + CAIN CH,^J + JRST RRINSC ;YES => INSERT, DON'T REPLACE. + CAIE CH,^H + CAIN CH,^L + JRST RRINSC + CAIN CH,^I + JRST RRDINT +RRDIN0: AOS (P) + CALL RRICH9 ;CHECK FOR VARIOUS CONDITIONS PROHIBITING UPDATING. + CALL RRFORW + SAVE RRHPOS ;WHAT IS HPOS AFTER THE CHAR WE ARE REPLACING?? + CALL RRBACK ;DELETE THAT CHARACTER. + SAVE CH + SAVE RRHPOS + CALL GAPSLP + CALL DEL1F + MOVE CH,$Q..0 + CALL TYOM ;INSERT THE NEW CHARACTER. + SOS PT + MOVE BP,RRVPOS + CALL RRFORW ;WHAT IS THE HPOS AFTER THE NEW CHARACTER? + REST T ;T GETS HPOS BEFORE THIS CHARACTER. + REST B ;B HAS CHAR WE ARE REPLACING. + REST A ;A GETS HPOS AFTER CHAR WE REPLACED. + CAMN A,RRHPOS ;HPOS AFTER THIS CHAR SAME AS AFTER OLD => WE CAN REWRITE ON SCREEN, + CAME BP,RRVPOS ;AS LONG AS IT DOESN'T CONTINUE THE LINE. + JRST RRDIN3 + CAIE CH,ALTMOD ;EITHER CHAR IS ALTMODE => CAN'T UPDATE. + CAIN B,ALTMOD + JRST RRDIN3 + SKIPE RRMAXP + JRST RRDIN3 + EXCH T,RRHPOS ;T GETS HPOS AFTER (LIKE A), RRHPOS GETS HPOS BEFORE CHAR. + EXCH CH,B + CAIN CH,11 + MOVEI CH,40 + CALL CHCTHR ;UPDATE HASH CODE OF LINE FOR CHAR BEING REPLACED. + MOVE CH,B + CALL CHCTHI ;UPDATE THE HASH CODE OF THE LINE FOR CHAR BEING INSERTED. + CALL RRMVC ;MOVE TO HPOS OF START OF CHARACTER. + SUB A,RRHPOS ;A GETS NUMBER OF POSITIONS THE CHARACTER TAKES. + CAIE A,1 + SETOM HCDS(BP) ;MORE THAN 1 => WE CAN'T FIX THE HASH CODE, SO CALL FOR REDISPLAY. + MOVE TT,TTYOPT + TLNN TT,%TOOVR ;IF TERMINAL CAN OVERPRINT, WE MUST CLEAR THE SPOTS. + JRST RRDIN2 +RRDIN1: CALL ERSCHR ;CLEAR OUT THAT MANY POSITIONS. + MOVEI CH,40 + CALL TYOINV + SOJG A,RRDIN1 + SETOM RROHPO + CALL RRMVC ;THEN RESTORE CURSOR POSITION. +RRDIN2: MOVEM T,RRHPOS ;SET HPOS TO ITS VALUE AFTER THE NEW CHARACTER. + MOVEM T,RROHPO + MOVE CH,$Q..0 ;NOW PRINT THE NEW CHARACTER AT THE DESIRED PLACE. + SKIPE CASDIS + CALL DISAD6 + JRST TYOINV + +RRDIN3: SETZ A, ;HERE TO UPDATE RRMNVP, RRMNHP, RRMAXP IF CAN'T UPDATE SCREEN. + JRST RRFXM1 ;T HAS HPOS OF CHAR, BP HAS VPOS. + +RRDINT: .I RRHPOS+1 ;BEFORE A TAB => INSERT UNLESS TAB NOW TAKING ONLY 1 SPACE. + TRNN TT,7 + JRST RRDIN0 +RRINSC: MOVE CH,$Q..0 +RRINSQ: AOS (P) + TRZ FF,FRARG2 + JRST RRINS + +FSRRINS:MOVE CH,C ;USER-INTERFACE TO RRINS: FS ^R INSERT$ + +;INSERT CHAR IN CH. +;CLOBBERS A, B, IN, OUT, TT, TT1, CH, Q, T, BP +RRINS: CALL TYINRM ;CONVERT CHARACTER TO ASCII. + SETOM RRMKPT + SKIPN RRMAXP + CAIN CH,^I ;INSERTING ANY CTL CHAR BUT TAB IS HARD. + JRST RRINS2 + CAIL CH,40 + CAIN CH,177 + AOSA RRMAXP +RRINS2: CALL RRICHK ;SEE IF OBVIOUSLY CAN'T UPDATE SCREEN NOW. + CALL RRCRDI + CALL [ CALL TYOMGS ;INSERT CHAR AFTER PT. + SOS PT + POPJ P,] + MOVE Q,RRHPOS + CALL RRFORW ;THEN MOVE FORWARD OVER IT. + MOVEI A,1 ;(FOR RRFXM1) 1 CHAR INSERTED. + CAMN BP,RRVPOS ;CHAR MOVED TO NEXT LINE => MUST REDISPLAY + SKIPE RRMAXP ;IF NOT PLANNING TO REDISPLAY, + JRST RRFXM1 + SKIPE RRCIDP ;IF GOING TO DO SOMETHING WITH CHAR I/D + CAIE CH,^I ;MUST BE AN EASY CHAR + CAIA + JRST RRFXM1 ;FOR TABS REDISPLAY REQUIRED + MOVE T,Q + EXCH T,RRHPOS ;POSITION CURSOR AT HPOS BEFORE THE CHARACTER. + CALL RRMVC + CALL CHCTHI ;USE THAT HPOS TO UPDATE LINE'S HASH CODE. + CAIN CH,^I ;AFTER A TAB, THE HASH CODE WAS NOT UPDATED PROPERLY. + SETOM HCDS(BP) + MOVEM T,RRHPOS + MOVEM T,RROHPO + MOVEI T,1 ;UPDATE LINBEG WDS OF ALL LINES + CALL RRINS3 ;BELOW THIS LINE. + SKIPGE RRCIDP ;IF USING CHAR I/D FOR THIS + CALL INSCHR ;INSERT THE SPACE FOR IT FIRST + MOVE BP,RRVPOS + SKIPN CASDIS ;IF CASE FLAGGING MIGHT BE HAPPENING, + SKIPGE RRCIDP ;OR IF WE ARE MOVING OTHER CHARACTERS AROUND, + SETOM HCDS(BP) ;THEN UPDATING THE HASH CODE LOST, SO CALL FOR REDISPLAY OF LINE. + SKIPE CASDIS ;OUTPUT CHARACTER, WITH CASE-SHIFT IF ANY. + CALL DISAD6 + JRST TYOINV + +RRINS3: ADDM T,RROLDZ + ADDM T,RROLZV + JRST RRDISG + +;CHECK FOR SOME OF THE THINGS THAT WOULD RULE OUT UPDATING THE +;SCREEN IMMEDIATELY FOR AN INSERT OR DELETE. IF ANY IS +;FOUND, LEAVE RRMAXP NONZERO (THIS WON'T CONFUSE RRLP BECAUSE +;WE'LL SET RRMAXP ANYWAY IN ORDER TO CAUSE REDISPLAY) +;REDISPLAY WILL ALWAYS WORK, BUT UPDATING IS FASTER. +;CLOBBERS A, B, IN, OUT, TT, TT1 +RRICHK: HRROS (P) ;SET SIGN FOR CHECKING INSERTION AND DELETION. + CAIA +RRICH9: HRRZS (P) ;CLEAR SIGN FOR CHECKING FOR REPLACEMENT. + SETZM RRCIDP ;SO FAR NO TAB OR CHAR I/D STUFF APPEARS TO BE NECESSARY. + SKIPN RRINHI + SKIPE RRMSNG + JRST RRICH2 + SKIPE RRMAXP ;REDISPLAY NECESSARY ANYWAY => + RET ;IT WILL FIX SCREEN; WE NEEDN'T. + SAVE CH + SKIPN RGETTY + JRST RRICH1 ;CAN'T UPDATE IF THERE'S A CURSOR STRING. + MOVE CH,RRVPOS ;IF CURSOR IS OFF SCREEN, + CAML CH,TOPLIN + CAML CH,BOTLIN ;DON'T UPDATE, REDISPLAY IS NEEDED. + JRST RRICH1 + SKIPL -1(P) + JRST RRICH4 + MOVE IN,PT + CALL RREOLT ;UPDATING FOR INSERT/DELETE POSSIBLE ONLY AT END OF LINE. + CAIA + JRST RRICH3 ;UNLESS BEFORE TAB OR CHAR I/D CAN BE USED +RRICH4: LISTEN A ;MANY UPDATES DON'T BEAT 1 REDISPLAY. + SKIPN TYISRC + CAIL A,5 + JRST RRICH1 + SKIPL DISPCR ;IF THERE ARE NO REAL BS'S OR STRAY CR'S + SKIPGE DISPBS + CAIA + JRST POPCHJ ;NO NEED FOR THE NEXT TEST. + CALL RRBTCR ;PERHAPS, DUE TO BACKSPACES, SOMETHING + CAMG OUT,RRHPOS ;EARLIER IN THE LINE APPEARS FARTHER + JRST POPCHJ ;RIGHT ON THE SCREEN (EG ABC/\) +RRICH1: REST CH +RRICH2: AOS RRMAXP ;CAUSE CALLER NOT TO TRY UPDATING. + RET + +;CHECK FOR CONDITIONS THAT MIGHT ALLOW US TO AVOID REDISPLAY EVEN IF +;NOT AT THE END OF THE LINE, IF RETURNS SUCCESSFUL, RRCIDP WILL BE +;POSITIVE IF WE ARE BEFORE A TAB THAT TAKES MORE THAN 1 SPACE AND SO +;CAN INSERT BY OVERWRITING, OR NEGATIVE IF WE ARE TO USE CHAR I/D +RRICH3: SKIPE CASDIS ;DONT GET SCREWED BY FLAGGING + JRST RRICH1 ;JUST REDISPLAY IN THAT CASE + CALL GETINC ;GET NEXT CHAR + CAIE CH,^I ;IS IT A TAB? + JRST RRICH5 ;NO, TRY CHAR I/D MAYBE + .I RRHPOS+1 ;GET NUMBER OF CHARS IT USES + TRNN TT,7 ;IF MORE THAN ONE + JRST RRICH1 + AOS RRCIDP ;SAY HACKING A TAB, + JRST RRICH4 ;AND GO CONTINUE CHECKS +RRICH5: SKIPE CID ;TRY TO USE CHAR I/D? + CALL RRNTBP ;CHECK THAT THE LINE HAS NO TABS AFTER THIS IN IT + JRST RRICH1 ;NO, FORGET IT, MUST REDISPLAY + SETOM RRCIDP ;SAY USE CHAR I/D FOR THIS ONE + JRST RRICH4 ;AND CONTINUE CHECKING + +;CONVERT LOWER CASE TO UPPER OR VICE VERSA, ACC. TO FS CASE $ +;FOR SHIFT OR LOCK CHARS, RCHSFT AND RCHLOK MIGHT GET CALLED! +RRCASC: TRNE CH,CONTRL+META + RET + CAIL CH,100 ;[ ;XCTING WOULD LOSE ON ALTMODE, ^]. + XCT RCHDTB(CH) ;SKIPS FOR CHARS WHOSE CASE IS WRONG. + CAIA + XORI CH,40 ;CHANGE TO THE OTHER CASE. + MOVEM CH,$Q..0 + AOSN RCHSFF + MOVNS CASE ;IF PREV. CHAR WAS CASE SHIFT, UN-COMPLIMENT CASE. + POPJ P, + +;TAKE CARE OF THE POSSIBILITY THAT CHANGING THE BUFFER AFTER PT MAY +;CHANGE WHAT APPEARS ON THE SCREEN BEFORE PT. (FOR EXAMPLE, +;INSERTING OR DELETING A LF AFTER A CR.) +;FOLLOW A CALL TO RRCRDI WITH AN INSN THAT CHANGES THE BUFFER +;AFTER PT, BUT DOESN'T CHANGE PT, AND DOESN'T CLOBBER BP OR T. +;ON RETURN, PT IS UNCHANGED, RRHPOS AND RRVPOS +;ARE CORRECT, AND BP,T CONTAIN THE V AND HPOS OF A PLACE ON THE SCREEN +;BEFORE WHICH NOTHING NEEDS TO CHANGE. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRCRDI: SAVE CH + SAVE PT + CALL RRCRDB ;MOVE BACK TO BEFORE ALL BEFORE-EFFECTS. + MOVE IN,PT + CAMN IN,(P) ;IF WE DIDN'T MOVE BACK AT ALL, NO PROBLEM. + JRST RRCRDX + SUB IN,BEG ;ELSE REMEMBER HOW FAR BACK WE MOVED, + EXCH IN,(P) ;RELATIVE TO BEG IN CASE BUFFER MOVES. + MOVEM IN,PT ;GIVE PT THE RIGHT VALUE FOR USER'S RTN, + MOVE CH,-1(P) ;AND CH. + MOVE T,RRHPOS ;GET HPOS AND VPOS OF PLACE WE MOVED BACK TO, + MOVE BP,RRVPOS ;TO RETURN TO OUR CALLER. + XCT @-2(P) ;DO WHAT CALLER WANTED DONE. + MOVE IN,(P) ;SET PT TO WHERE WE MOVED BACK TO + ADD IN,BEG + EXCH IN,PT ;BUT REMEMBER ITS REAL VALUE. + MOVEM IN,(P) +RRCRD1: CALL RRFORW ;THEN MOVE FWD OVER WHAT WE MOVED + CAME IN,(P) ;BACK OVER. + JRST RRCRD1 + SUB P,[1,,1] + JRST POPCH1 + +RRCRDX: MOVE T,RRHPOS ;NO PROBLEM OF BEFORE-EFFECTS, JUST + MOVE BP,RRVPOS ;RETURN THE HPOS AND VPOS, AND EXIT + SUB P,[1,,1] ;TO THE USER'S BUFFER-MUNGING INSN. + JRST POPCHJ + +RRCRDB: MOVE IN,PT + SUBI IN,1 ;ARE WE AFTER A CR? IF SO, IT MAY CHANGE FORM. + CAMGE IN,BEGV + POPJ P, ;AT BEGINNING OF BUFFER, NO PROBLEM. + CALL GETCHR ;ARE WE AFTER A CR? + CAIN CH,^M ;IF SO, IT MIGHT CHANGE FORM. + CALL [ SKIPL DISPCR ;IF IT CAN COME OUT AS "^M" + JRST RRBACK ;THEN IT CAN PROPAGATE BEFORE-EFFECTS. + JRST POP1J] ;ELSE, IT GUARANTEES NO BEFORE-EFFECTS. + MOVE IN,PT + SUBI IN,2 ;IF IN HORIZ. POS. 0, AND + SKIPG RRHPOS + CAMGE IN,BEGV ;NOT NEAR THE BEGINNING OF BUFFER, + POPJ P, + CALL GETINC ;AND NOT SHORTLY AFTER A CR (NOTE THIS + CAIN CH,^M ;CATCHES A PRECEDING CRLF) + RET + CALL GETCHR + SKIPGE DISPBS ;AND NOT RIGHT AFTER A ^H THAT REALLY BACKSPACES (THEN MOVING BACK + CAIE CH,^H ;OVER IT WOULD UNDERESTIMATE!) + CALL RRBACK ;THEN MAYBE "!" MUST BE WRITTEN OR ERASED AT END OF PREVIOUS LINE. + POPJ P, + +SUBTTL LEAVE ^R, UPWARD OR DOWNWARD + +;ALTMODE - LEAVE ^R MODE. +RREXIT: SKIP A,RREBEG + JUMPN A,FSCREX ;IF COMING FROM M.^R$, DO A FS^REXIT$. +RREXI0: MOVE CH,QRB.. ;DON'T INHIBIT REDISPLAY AT NEXT OPPORTUNITY (UNLESS RRLEVM TYPES) + SETZM .QVWFL(CH) + TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPGE -3(A) + JRST RREXI2 ;^ V - LEAVE FLNOIN ON. + SKIPE A,RRLEVM ;IF EXITING ^R, RUN FS ^R LEAVE$. + CALL RRMACR + TLZ FF,FLNOIN +RREXI2: MOVE P,DISPRR + SUB P,[1,,1] ;POP OFF RET ADDR AT RRLP + REST DISPRR + CALL RRLEAV ;SET UP "RRE" VARIABLES. + SETOM ECHCHR ;A ^R COMMAND WHICH CALLS ^R SHOULDN'T HAVE ECHOING WHEN IT RETURNS. + ANDCMI FF,FRARG+FRARG2 + SKIPE DISPRR ;IF EXITING THE OUTERMOST LEVEL OF ^R, + JRST RREXI1 + CALL SETTTM ;TURN ON SYSTEM ECHOING AGAIN. + MOVE CH,QRB.. + SKIPE A,.QCRMC(CH) ;EXECUTE THE SECRETARY MACRO IF ANY. + CALL MACXQ +RREXI1: REST C ;POP QREG PDL PTR SAVED AT ENTRY TO ^R + CALL FSQPU0 ;UNWIND PDL DOWN TO THAT LEVEL. + JRST POP1J + +RRTHRW: MOVE CH,DISPRR ;RETURN TO ^R MAIN LOOP. + PUSHJ CH,SETP1 + MOVEI TT,RRLP ;RETURN TO IT AT NORMAL RETURN, NO MATTER WHERE WE LEFT IT FROM. + MOVEM TT,(P) + .I RRLAST=RRPRVC ;MAKE SURE ARGS GET FLUSHED. + JRST RREAR0 ;WE'RE COMING FROM OUTSIDE ^R, SO MUST OFFICIALLY RE-ENTER. + +RRLEAV: .I RREZ=Z + .I RREBEG=BEG +RRLEA1: +RRLEA2: .I RREPT=PT + .I RREHPS=RRHPOS + .I RREVPS=RRVPOS + .I RREBUF=BFRSTR + RET + + +;[ ;HANDLE THE ^] COMMAND IN ^R MODE. +;CLOBBERS ALL ACS. SKIPS. +RRBRC: SKIP + MOVEI A,[ASCIZ /[0[1MU0:I1 +<^V^:FT0 FIU0 :I110 Q0-."N0;'> +F^:M(:I* F^:M1(]1]0) ) /] + +RRMAC0: SKIP ;SUPPLY ^R-STYLE NUMERIC ARG AS ARG TO MACRO. + MOVEM C,NUM ;SUPPLY THE COMMAND'S ARG, OR 1 (THE DEFAULT), TO THE MACRO, + TRZ FF,FRARG + SKIPE RRARGP +RRMAC6: IORI FF,FRARG ;AND TELL IT IT HAS AN ARG IF THE ARG IS NON-DEFAULTED. + JRST RRMAC5 + +;CALL THE MACRO IN A WITH NO ARG., AND LOOK AT ITS RETURNED VALUES TO DECIDE +;HOW TO UPDATE THE ^R-MODE VARIABLES. +RRMACR: ANDCMI FF,FRARG + SETZM NUM +RRMAC5: ANDCMI FF,FRARG2\FRCLN\FRSYL\FROP ;IN ANY CASE THE MACRO DOESN7T HAVE 2 ARGS. + SETZM SARG + CALL RRLEAV ;SET UP THE "RRE" VARIABLES. + CALL MACXQW ;EXECUTE THE MACRO. + JRST RREAR0 + +SUBTTL PROCESS ARGUMENTS/VALUES GIVEN TO ^R + +RREAR0: TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPL -3(A) + TLZ FF,FLNOIN ;TO SAY WHETHER THIS IS ^R OR ^ V. +RREARG: SKIPE ECHOFL + CALL NOECHO +RREAR1: CALL VBDACU ;MAKE SURE FS ALTCOUNT IS IN PHASE WITH REALITY + JFCL + MOVE C,NLINES + CALL WINSET ;COMPUTE SIZE AND POS OF WINDOW, SET RRTOPM. RRBOTM, BOTLIN, VSIZE. + MOVMS DISTRN ;TRUNCATION SCREWS ^R-MODE. + MOVE T,BFRSTR + CAME T,RREBUF ;IF BUFFER HAS BEEN SWITCHED ON US, RECOMPUTE THE DISPLAY! + SETOM RRMNVP + .I RRHPOS=RREHPS + .I RRVPOS=RREVPS + MOVE A,BEG ;RELOCATE ALL ^R-MODE POINTERS INTO BUFFER. + SUB A,RREBEG + SETZM RREBEG ;DECLARE ^R IN CONTROL; PREVENT ^G INT LVL QUIT. + ADDM A,RREPT + ADDM A,RREZ + SKIPN RGETTY + JRST RRTTY + CALL RRFXRL ;RELOCATE LINBEG TABLE BY A. + MOVE BP,TOPLIN + MOVE T,GEA ;IF CURRENT FS WINDOW$ IS NOT CONSISTENT WITH LINBEGS, + ADD T,BEGV ;WE SHOULDN'T HAVE BEEN FED ANY ARGS, + LDB B,[3300,,LINBEG(BP)] + CAMN B,T + CAMLE B,ZV ;SO FLUSH THEM. SAME GOES IF FS WINDOW$ IS IMPOSSIBLE. + TRZ FF,FRARG + MOVE C,QRB.. + SKIPE TT,MORFLF ;IF OUR MACRO RAN INTO A --MORE--FLUSHED, + SETOM TYOFLG ;DON'T LET IT STAY AROUND TO PLAGUE NEXT COMMAND, +; SKIPE MORFLF +; SETZM .QVWFL(C) ;AND WE CAN ALSO REDISPLAY RIGHT NOW. +;REMOVED SO THAT FLUSHING WITH A RUBOUT WILL CAUSE REDISPLAY AFTER THE NEXT INPUT CHAR. +;IS NOT EXPECTED TO AFFECT WHAT HAPPENS WHEN YOU FLUSH WITH NON-RUBOUT. + SETZM MORFLF + MOVEM TT,OLDFLF + MOVE TT,MORESW + SKIPN .QVWFL(C) ;DOES STUFF ON SCREEN WANT TO BE PRESERVED? + JRST [ CAIE TT,MS%FLS ;NO: BUT IF MODE LINE SAYS --MORE--FLUSHED, + JRST RREAR2 ;WE MUST ACT TO PREVENT LOSS AT RRLP3. + JRST RREAR4] + SETZM .QVWFL(C) + CALL TYINH ;YES: WAIT TILL USER TYPES A CHARACTER SAYING + CAIE CH,40 + MOVEM CH,UNRCHC ;HE HAS READ THE STUFF (DON'T FLUSH THE CHARACTER UNLESS IT'S A SPACE) +RREAR4: CALL RRLRDS ;NOW MAKE SURE THAT THE BUFFER IS REDISPLAYED AFTER THIS CHARACTER + SETOM RRMSNG ;NOTE LINES MAY NEED REDISPLAY EVEN IF AFTER RRMAXP. + SETZM ERRFL1 ;NO NEED TO PROTECT AN ERROR MESSAGE PAST NEXT INPUT CHARACTER. +RREAR2: MOVE C,NUM ;GETARG WANTS 2ND VALUE IN C. + MOVE E,SARG ;AND 1ST VALUE IN E. + SKIPL RRMNVP ;*IF THIS IS A SCREW, AT LEAST DO THIS IN RREAR3* + TRNN FF,FRARG ;MACRO RETURNED NO ARG => + JRST RRMAC1 ;DON'T ASSUME ANYTHING. + SKIPGE GEA ;PREVENT CONFUSION IF ALREADY KNOW GOING TO DO FULL REDISPLAY. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => ONLY PT HAS CHANGED. + JRST RRMAC3 + CAML E,C + EXCH C,E ;DO F^@ - PREVENT 2<1 ERROR BY ORDERING THE ARGS PROPERLY. + CALL GETANU ;TURN MACRO'S VALUES INTO CHAR ADDRS. + CALL RRLMOV ;FIND VPOS IN BP OF LOWEST UNCHANGED LINE. + JRST RRMAC3 ; CHANGES ARE BELOW SCREEN, NOTHING TO DO. + CAMGE BP,TOPLIN + JRST RREAR3 ;IF CHANGES REACH PAST TOP, SCROLL DOWN. + MOVE TT,Z + SUBM TT,RREZ ;RREZ _ CHANGE IN # CHARS IN BUFFER. + SAVE PT + CALL RRHMOV + CALL RRCRDB ;MOVE BACK TO ELIMINATE BEFORE-EFFECTS. + REST E ;WE ARE JUST BEFORE 1ST PLACE ON SCREEN + MOVE BP,RRVPOS ;THAT WAS CHANGED. MARK THIS AS PLACE + MOVE T,RRHPOS ;THAT REDISPLAY MUST START BEFORE. + CALL RRDLB2 ;UPDATE RRMNVP AND RRMNHP. + CALL RRQMOV ;GET BACK CORRECT PT, MOVE FWD TO THERE, GETTING CORRECT HPOS AND VPOS. + MOVE E,C + MOVE A,RREZ + JRST RRFXMX ;UPDATE RRMAXP. + +;HERE FOR CHANGES THAT REACH PAST TOP OF SCREEN. +;FIGURE OUT WHERE CHANGES STOP, AND CHOOSE A NEW WINDOW TO PUT THAT POINT +;ON THE SAME LINE WHERE IT IS NOW, THUS AVOIDING REDISPLAYING THE UNCHANGED TEXT. +RREAR3: MOVE A,Z + SUB A,RREZ + MOVE E,C ;FIRST, ADJUST RRMAXP FOR THE CHANGES MADE. + CALL RRFXMX + CALL RRLID2 ;THEN, FIND 1ST UNALTERED LINE'S POS IN BUFFER AND SCREEN + JRST RRMAC1 ;THERE IS NONE => DO FULL REDISPLAY. + MOVE A,RRIDVP ;A GETS THAT LINE'S VPOS. + SUB A,TOPLIN + LDB E,[014300,,A] + ADD A,E ;IF IT IS IN THE BOTTOM 1/3 OF THE SCREEN, + ADD A,TOPLIN + CAML A,BOTLIN ;MIGHT AS WELL RE-CENTER THE WHOLE THING. + JRST RRMAC1 + SAVE PT + LDB A,[3300,,RRIDLB] + MOVEM A,PT ;OTHERWISE, PICK A WINDOW THAT DOESN'T REQUIRE IT TO MOVE. + MOVE A,RRIDVP ;CALCULATE WINDOW PUTTING PT AT VPOS IN A. + CALL VBDBL1 + MOVEM B,RRVPOS + MOVE A,RRIDLB ;OK, POINT OF LAST CHANGE HASN'T MOVED ON SCREEN, + ASH A,-33 ;BUT CURSOR MIGHT NOT BE AT THE END OF CHANGED REGION. + MOVEM A,RRHPOS ;SO FIGURE OUT WHERE THE CURSOR IS. + REST E + CALL RRMOV +;HERE TO SAY REDISPLAY MUST START AT THE TOP OF THE SCREEN, BUT NOT REQUIRE TESTING THE WINDOW. +;SAYS NOTHING ABOUT WHERE REDISPLAY NEEDS TO END. +RRLRDS: MOVE TT,TOPLIN ;NOW THAT WINDOW HAS BEENCHANGED, EVERY LINE NEEDS REDISPLAY. + CAMGE TT,RRMNVP ;IF RRMNVP IS -1, DON'T FORGET THAT FACT! + MOVEM TT,RRMNVP + SETZM RRMNHP + MOVE A,GEA ;AND WE MUST SET UP FIRT LINE'S LINBEG SO DISPLAY STARTS OFF RIGHT. + ADD A,BEGV ;WE COULD JUST SETOM RRMNVP, BUT THEN THE WINDOW, WHICH WE KNOW IS + MOVEM A,LINBEG(TT) ;VALID, WOULD BE WASTEFULLY REBLESSED. + RET + +;FIGURE OUT CURRENT CURSOR POSITION OF CHAR ADDR IN E. +;USES THE OLD LINBEGS AND RRMNVP, AS A SHORTCUT. +RRQMOV: CALL RRLMOV + JFCL + CAMGE BP,TOPLIN + MOVE BP,TOPLIN +;ASSUMES BP WAS SET UP BY CALLING RRLMOV. +RRHMOV: MOVEM BP,RRVPOS ;SET PT, RRVPOS AND RRHPOS TO VALUES + LDB TT,[3300,,LINBEG(BP)] + MOVEM TT,PT ;AT START OF LINE ON WHICH 1ST CHANGE LIES. + MOVE TT,LINBEG(BP) ;THOSE ARE STILL VALID, SINCE NOTHING CHANGED ABOVE THEM. + ASH TT,-33 + MOVEM TT,RRHPOS + JRST RRMOV ;THEN SCAN FROM THERE TO THE DESIRED POINT. + +;FIND IN BP THE VERTICAL POSITION OF THE LOWEST LINE +;WHICH, AS OF LAST DISPLAY (NOT, NOT, NOW) BEGAN BEFORE THE CHAR ADDR IN E. +RRLMOV: MOVE BP,RRMNVP + CAMN BP,[377777,,777777] + JRST RRLMO1 + LDB TT,[3300,,LINBEG(BP)] + CAMGE TT,E + JRST POPJ1 +RRLMO1: MOVE BP,TOPLIN + SOS BP +RRMAC2: MOVEI TT,1(BP) + CAME BP,RRMNVP ;WE CAN'T USE A VPOS WHOSE LINBEG DOESN'T EXIST OR ISN'T VALID. + CAMN TT,BOTLIN + JRST POPJ1 + LDB TT,[3300,,LINBEG+1(BP)] + CAML TT,RROLZV ;IF CHANGES WERE INSERTION AT END OF BFR, WE WANT TO FIND THE LINE + JRST [ CAMGE BP,TOPLIN ;WHICH CONTAINS THE LAST OF THE OLD TEXT CHARACTERS. + MOVE BP,TOPLIN ;INSERTION INTO EMPTY BUFFER IS A CHANGE STARTING WITH LINE 0. + JRST POPJ1] + ;IF CHANGES START AT 1ST CHAR OF NEXT LINE, WE NEED NOT SCAN THIS LINE, + CAMN TT,E ;UNLESS NEXT LINE STARTS IN MID-CHARACTER, + SKIPL LINBEG+1(BP) ;IN WHICH CASE THE CHAR REALLY BEGINS ON THIS LINE. + CAMLE TT,E ;IF CHANGES START BEFORE NEXT LINE, MUST SCAN THIS LINE. + JRST POPJ1 + ;THIS CHANGED FROM CAML SO THAT ^K'ING TOP LINE OF SCREEN + ;WOULD NOT END UP SAYING CHANGES REACH PAST TOP OF SCREEN, ETC. + AOJA BP,RRMAC2 ;IF CHANGES START AFTER END OF LINE, NEED NOT SEARCH IT. + +;UPDATE THE "MINIMUM SCREEN POSITION THAT CHANGED" +;USING DICTIONARY ORDER ON RRVPOS, RRHPOS. +RRDLB2: CAML BP,BOTLIN ;DON'T EVER LET RRMNVP BECOME AS LARGE AS BOTLIN. + JRST [ MOVE BP,BOTLIN + SOJA BP,.+1] + CAMLE BP,RRMNVP + POPJ P, + CAMGE BP,TOPLIN ;DON'T ALLOW RRMNVP TO BECOME LESS THAN TOPLIN. + SETO BP, ;MAKE IT -1 (WHICH IS SPECIAL) IF CHANGES GO OFF TOP. + EXCH BP,RRMNVP + CAMG BP,RRMNVP + CAMG T,RRMNHP + MOVEM T,RRMNHP + POPJ P, + +RRFXM1: MOVE E,PT + CALL RRDLB2 +;UPDATE RRMAXP. SIGNED # CHARS INSERTED OR DELETED IN A, +;PLACE INSERTED OR DELETED IN E. +RRFXMX: MOVE T,RRMAXP ;NOTE RRMAXP MAY HAVE THE SPECIAL VALUE INFINITY (LARGEST POS NUMBER) + AOS T + CAILE T,1 ;IN WHICH CASE IT SHOULDN'T BE RELOCATED. + ADDM A,RRMAXP ;RELOCATE OLD VALUE IN CASE IT'S ABOVE WHERE CHANGE HAPPENED. + CAML E,RRMAXP + MOVEM E,RRMAXP ;MAKE SURE RRMAXP IS ABOVE PLACE CHANGE HAPPENED. + POPJ P, + +;SET PT TO VALUE IN E, UPDATING CURSOR POS. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRMOV: CAMN E,PT ;PT SAME AS MARK => DO NOTHING. + POPJ P, + MOVE A,E + SUB A,PT ;MOVING A LONG DISTANCE => DON'T BOTHER TO KEEP TRACK OF + MOVMS A ;CHANGES IN VPOS AND HPOS. JUST GO THERE AND RECOMPUTE HPOS. + CAIL A,10000. + SKIPN RGETTY + CAIA + JRST RRMOVL + CAML E,PT + JRST RRMOVF ;PT BEFORE DESIRED PT => GO FWD. +RRMOVB: CALL RRBACK + CAMN E,IN ;REACHED THE DESIRED PT YET? + RET + SKIPL A,RRVPOS ;GONE ABOVE TOP OF SCREEN? + JRST RRMOVB + MOVNS A ;ON TERMINAL WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + ADD A,TOPLIN + CAMGE A,VSIZE ;TILL WE GET A SCREEN HEIGHT ABOVE THE TOP OF THE SCREEN. + SKIPN LID ;UNTIL THAT POINT, THERE MAY BE SOME ADVANTAGE IN SCROLLING + CAIA ;THE SCREEN DOWN, AND FOR THAT WE NEED TO KEEP THE VPOS. + JRST RRMOVB +RRMOVL: MOVEM E,PT ;IT'S PROBABLY FASTER TO REQUEST COMPLETE RECOMPUTATION. + JRST RRMAC1 + +RRMOVF: MOVE TT,RRVPOS + ADDI TT,3 + SAVE TT +RRMOVG: CALL RRFORW + CAMN E,IN + JRST POP1J + MOVE TT,RRVPOS + MOVE TT1,(P) ;IF GO AT LEAST 3 LINES (FOR RRTTY'S SAKE, TO AVOID HAVING LONG JUMPS + CAML TT,TT1 ;LOOK LIKE MOTION TO NEXT LINE) AND + CAMG TT,BOTLIN ;GONE BELOW BOTTOM OF SCREEN, THEN DON'T BOTHER SCANNING IT OUT. + JRST RRMOVG + SUB TT,BOTLIN ;ON TTY WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + CAMGE TT,VSIZE ;TILL A SCREEN HEIGHT BELOW THE BOTTOM, IN CASE WE CAN + SKIPN LID ;SAVE DISPLAY BY SCROLLING THE TEXT UPWARD. + CAIA + JRST RRMOVG + SUB P,[1,,1] + JRST RRMOVL + +;,F^R - REPORT CHANGES BETWEEN , TO ^R WITHOUT DISPLAYING ANYTHING. +;F^R TELLS ^R NOT TO REMEMBER ANYTHING FROM ITS PREVIOUS DISPLAYING. + +;:F^R FORCES A VALID FS WINDOW$ TO BE CALCULATED NOW. +;SET FS WINDOW TO -1 FIRST, TO FORCE A NEW WINDOW TO BE COMPUTED FROM SCRATCH. +;DO A F^R FIRST TO AVOID ASSUMING THAT FS ^R VPOS$ IS VALID. +;:F^R CHOOSES A WINDOW THAT PUTS POINT ON LINE +FS TOPLIN$ +;A NEGATIVE COUNTS FROM THE BOTTOM OF THE USABLE WINDOW. +;IF THE WINDOW IS CHANGED, THAT FACT IS REPORTED TO ^R IMMEDIATELY, +;SO YOU CAN RETURN ONE VALUE TO ^R IF YOU ARE SURE YOU DON'T INVALIDATE IT. + +;^:F^R IS LIKE :F^R EXCEPT THAT, IF INSERT/DELETE LINE ARE AVAILABLE, +;IT IMMEDIATELY SHIFTS STUFF ON THE SCREEN TO REDUCE EVENTUAL REDISPLAY. + +;,^ F^R SAYS LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) NEED REDISPLAY. +RRALTR: TRNE FF,FRCLN + JRST RRALT1 + TRNE FF,FRUPRW ;^F^R IS FOR EXITING THE MINIBUFFER. + JRST RRMNX + TRNN FF,FRARG ;NO ARG => SAY ALL HAS CHANGED. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => SAY NOTHING HAS. ^R WILL KNOW ANYWAY + RET ;IF POINT HAS BEEN CHANGED. + MOVE A,BEG ;2 ARGS => REPORT MODIFICATIONS TO PART OF BUFFER. + SUBM A,RREBEG + EXCH A,RREBEG + CALL RRFXRL + CALL RREAR2 + .I RREZ=Z + JRST RRLEA2 + +RRALT1: SKIPGE C ; :F^R COMES HERE. + ADD C,VSIZE ;A NEGATIVE ARG COUNTS FROM WINDOW BOTTOM. + ADD C,TOPLIN ;ALL ARGS ARE RELATIVE TO WINDOW, NOT ABSOLUTE ON SCREEN. + MOVE A,C + TRNE FF,FRARG ;NO ARG => TEST OLD WINDOW, BASED ON RRVPOS. + JRST RRALT2 + SKIPL GEA ;OLD WINDOW NOT KNOWN OR RRVPOS REPORTED SUSPECT => + SKIPGE RRMNVP + JRST RRALT7 ;SKIP THE FAST CHECK, AND DO ORDINARY BLESSING. + MOVE B,PT ;THE FAST CHECK IS ONLY APPLICABLE WHEN POINT IS + CAME B,RREPT ;AT THE PLACE WE HAVE REMEMBERED THE VPOS OF. + JRST RRALT7 + CALL RRWBLS + CAIA ;FAST CHECK APPLICABLE AND LOSES => NEW WINDOW CERTAINLY NEEDED, + RET +RRALT6: SETOB A,GEA ; SO TELL VBDBLS NOT TO BOTHER WITH THE OLD ONE. +RRALT2: CAML A,TOPLIN + CAML A,BOTLIN +RRALT7: SETO A, + SAVE GEA + SAVE RRVPOS + CALL VBDBLS + REST E ;E HAS PREVIOUS VPOS OF POINT. + REST A ;A HAS PREVIOUS ADDRESS OF TOP LINE. + MOVEM B,RREVPS ;B HAS NEW VPOS OF POINT. + MOVEM B,RRVPOS + .I RREHPS=CHCTHP + .I RREPT=PT ;WHEN WE RETURN TO ^R IT SHOULD KNOW WHICH POINT RREVPS REFERS TO. + CAMN A,GEA ;IF THE WINDOW IS ACTUALY CHANGED, + RET + SKIPE LID ;AND WE CAN'T OR SHOULDN'T MOVE THE TEXT, + TRNN FF,FRUPRW + JRST RRALT5 + SKIPL RRMNVP + JRST RRALT3 +RRALT5: SETOM RRMSNG ;JUST TELL ^R THAT EVERY LINE NEEDS REDISPLAY + JRST RRLRDS ;BUT WINDOW IS CERTAINLY GOOD. + +;HERE TO TRY TO MOVE TEXT ON THE SCREEN WITH INSERT/DELETE LINE +RRALT3: MOVN C,B ;HOW FAR ARE WE MOVING TEXT, AND WHICH WAY? + ADD C,E + MOVM E,C ;GET MAGNITUDE OF DISTANCE MOVED. + CAML E,VSIZE ;MOVING MORE THAN SCREEN HEIGHT => ALL OF OLD WINDOW GOING OFF SCREEN + JRST RRALT5 ;SO DON'T BOTHER WITH THIS. + MOVE BP,TOPLIN ;THE LINE THAT WILL MOVE TO POSITION TOPLIN + MOVE E,C ;IS NOW ON THE SCREEN AT POSITION TOPLIN+C(C). + ADD E,BP ;TELL DSLID WHAT THAT POSITION IS. + MOVEM E,RRIDVP ;FOR DOWNWARD MOTION, THAT LINE IS FICTITIOUS, BUT DSLID KNOWS THAT. + JUMPL C,RRALT4 + ;MOVING UP => PRETEND DELETED THE FIRST FEW LINES ON THE SCREEN. + CAML E,RRMNVP ;CAN'T WIN IF CHANGES TO TEXT EXTEND ABOVE WHAT WILL BECOME + JRST RRALT5 ;THE FIRST LINE ON THE SCREEN, SINCE IN THAT CASE ITS LINBEG IS WRONG. + MOVE TT,LINBEG(E) + MOVEM TT,RRIDLB ;RRIDLB GETS LINBEG OF WHAT WILL BECOME THE TOP LINE ON SCREEN. + MOVE TT,RRMNVP + MOVNS C ;RRMNVP MOVES UP WITH THE TEXT, IF IT ISN'T INFINITY. + CAME TT,[SETZ-1] + ADDM C,RRMNVP ;NOTE IT CAN'T GO PAST TOPLIN, DUE TO CAML E,RRMNVP ABOVE. + JRST RRLID5 ;GO DELETE THE LINES BELOW TOPLIN. + +RRALT4: AOS RRIDVP ;COMPENSATE FOR DIFFERENT MEANING OF THIS AND BP IF MOVING TEXT DOWN. + CALL DSLID ;MOVE IT. + JRST RRALT5 ;THEN SAY EVERY LINE MIGHT NEED REDISPLAY. + +;HERE FOR ,^ F^R SAYING LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) +;NEED REDISPLAY. +RRMNX: CAML C,RRMNVP ;HANDLE END OF RANGE OF VPOS'S BY SETTING RRMAXP TO CORRESPOND TO IT, + JRST RRMNX1 ;OR, IF LINBEGS AROUND THERE ARE UNKNOWN, BY SETTING RRMSNG. + LDB T,[3300,,LINBEG(C)] + MOVEM T,RRMAXP + JRST RRMNX2 + +RRMNX1: SETOM RRMSNG +RRMNX2: MOVE BP,E ;HANDLE BEGINNING OF RANGE OF VPOS'S BY SETTING RRMNVP THERE. + SETZ T, + JRST RRDLB2 + +;,FM - MOVE DOWN TO HPOS , LINES DOWN. +;,^ FM - MOVE UP TO HPOS , - LINES UP. +;NORMALLY, EXACT VALUE OF HPOS IS NEEDED TO STOP SCAN. +;BUT COLON MODIFYER => ANY LARGER HPOS IS ALSO OK. +;IF SCAN DOESN'T FIND AN ACCEPTABLE HPOS ON THE DESIRED LINE +;THEN EITHER A NIB ERROR OR A NHP ERROR WILL RESULT. +;FM TRIES TO AVOID STOPPING BETWEEN A CR AND ITS LF. +FMCMD: TRNE FF,FRARG2 + TRNN FF,FRARG + TYPRE [WNA] + CALL RRBTCR ;MAKE SURE RRHPOS IS CORRECT FOR CURRENT BUFFER AND PT. + ADD E,RRVPOS ;E IS DESTINATION VPOS. + MOVE IN,PT + TRNE FF,FRUPRW + JRST FMBACK ;NOW FORWARD AND BACKWARD MOTION DIVERGE. +FMFWD: CAMGE E,RRVPOS ;IF WENT PAST TARGET LINE, WITHOUT STOPPING ON IT, BARF. + JRST [ CALL RRBCRL ;MOVE BACK TO END OF DESIRED LINE. + TYPRE [NHP]] + CAME E,RRVPOS ;IF HAVE REACHED TARGET VPOS, + JRST FMFWD1 + TRNE FF,FRCLN + CAML C,RRHPOS ;AND HAVE REACHED TARGET HPOS, + CAMN C,RRHPOS + RET +FMFWD1: CAML IN,ZV + TYPRE [NIB] ;AT END OF BUFFER WITHOUT REACHING TARGET => BARF. + CALL RRFORW + JRST FMFWD + +FMBACK: CAMLE E,RRVPOS ;WENT PAST TARGET VPOS WITHOUT FINDING TARGET HPOS => BARF. + JRST [ CALL RRFCRL ;RETURN TO DESIRED LINE BEFORE COMPLAINING. + TYPRE [NHP]] + CAME E,RRVPOS ;REACHED TARGET VPOS + JRST FMBAC1 + TRNE FF,FRCLN + CAML C,RRHPOS + CAMN C,RRHPOS + RET +FMBAC1: CAMG IN,BEGV + TYPRE [NIB] + CALL RRBCRL + JRST FMBACK + +;MOVE FORWARD OVER EITHER A SINGLE CHAR OR A CRLF. +RRFCRL: CALL RRFORW + CAIE CH,^M + RET + CALL GETCHR + CAIE CH,^J + RET + JRST RRFORW + +;MOVE BACKWARD OVER EITHER A SINGLE CHAR OR A CR-LF PAIR. +RRBCRL: CALL RRBACK ;MOVE BACK 1 CHAR, + CAIE CH,^J ;AND IF THAT LEAVES US BETWEEN A CR AND ITS LF, + RET ;MOVE BACK 1 MORE. + SOS IN + CALL GETINC + CAIE CH,^M + RET + JRST RRBACK + +SUBTTL ^R COMMAND DISPATCH TABLE MANAGEMENT + +;FS ^R INIT$ RETURNS THE INITIAL SETTING OF FS ^R CMAC$. +;THE UPARROW FLAG HAS THE SAME MEANING AS FOR FS ^R CMAC$. +FSCRIN: TRZN FF,FRARG + TYPRE [WNA] + CALL TYIABN ;IF DON'T HAVE UPARROW FLAG, CONVERT ASCII ARG TO 9-BIT. + MOVEI CH,(C) + TRZN CH,META + TRNN C,CONTRL + SKIPA A,[RRXINS] ;META OR NON-CONTROL CHARS ARE SELF-INSERTING (EXCEPT RUBOUT) + MOVEI A,RRUNDF ;MOST CONTROLS ARE ERRORS. + LDB Q,[.BP 177,CH] + CAIL Q,40+"A + CAILE Q,40+"Z + CAIA ;IF THE ASCII PART IS LOWER CASE, + MOVE A,[40,,RRINDR] ;IT IS A "RRINDR" CHAR (INDIRECT). + CAIN CH,CONTRL+33 ;CONTROL-ALTMODE GOES INDIRECT THROUGH ALTMODE. + MOVE A,[200,,RRINDR] ;AND SIMILAR FOR CONTROL-META-ALTMODE. + CAIL CH,CONTRL+^H ;SIMILAR FOR CONTROL-BS, CONTROL-TAB, CONTROL-LF, + CAILE CH,CONTRL+^J ;CONTROL-CR, AND META EQUIVALENTS. + CAIN CH,CONTRL+^M + MOVE A,[200,,RRINDR] + CAIL CH,CONTRL+"H + CAILE CH,CONTRL+"J + JRST FSCRI1 + MOVE A,[300,,RRINDR] + JRST POPJ1 + +FSCRI1: CAIN C,33 ;ALTMODE ON TV IS NOT SAME AS CTL-[ ;] + MOVEI A,RREXIT + CAIN C,^M ;SIMILARLY, HANDLE CR (WHICH IS NOT CTL-M) + MOVE A,[RRCRLF,,RRREPT] + CAIL C,^H + CAILE C,^J + CAIA + MOVE A,[RRINSC,,RRREPI] + CAIL Q,"0 ;CONTROL, META AND C-M-DIGITS ALL ADD TO ARGUMENT TO NEXT CMD. + CAILE Q,"9 + JRST FSCRI2 + TRNE C,CONTRL+META + MOVEI A,RRCDGT +FSCRI2: CAIE Q,"- ;C-MINUS, M-MINUS AND C-M-MINUS ALL SET "NEGATE ARG" FLAG + JRST FSCRI3 + TRNE C,CONTRL+META + MOVEI A,RRCMNS +FSCRI3: CAIN C,177 ;RUBOUT IS A RUBOUT. + MOVEI A,RRRUB + CAIN C,CONTRL+177 ;CTL-RUBOUT IS TAB-HACKING RUBOUT. + MOVEI A,RRCRUB + CAIL C,CONTRL+"@ + CAILE C,CONTRL+"_ + JRST POPJ1 + SUBI C,CONTRL+"@ ;AS A LAST RESORT, LOOK CHAR UP IN RRITAB. + ROT C,-1 + HRRZ A,RRITAB(C) ;INDEX TO HALFWORD OF INITIAL VALUE TABLE. + SKIPL C + HLRZ A,RRITAB(C) + TRZN A,400000 ;400000 BIT => DEFINITION GOES THROUGH RRREPT. + JRST POPJ1 + HRLZS A + HRRI A,RRREPT + JRST POPJ1 + + +;TABLE OF INITIAL ^R-MODE DEFINITIONS OF CONTROL CHARACTERS. +.SEE RRMACT ;CHANGE RRMACT WHEN YOU CHANGE THIS. +.BYTE 22 +RRITAB: RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + RRINDR ;CONTROL-H (THIS ENTRY NOT ACTUALLY USED) + RRINDR ;CONTROL-I " + RRINDR ;CONTROL-J " + RRKILL ;^K + RRCTLL ;^L + 400000+RRINSC ;CONTROL M + RRNEXT ;^N + 400000+RRCTLO ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;CONTROL-[ ;] + RRUNDF ;^\ + RRBRC ;[ ;^] + RRUNDF ;^^ + RRUNDF ;^_ +.BYTE + +;GET OR SET THE MACRO ASSOCIATED WITH A CHARACTER +;(IF A CHAR HAS AN ASSOCIATED MACRO, WHEN THAT CHAR IS READ IN +;^R-MODE, THE MACRO IS CALLED INSTEAD OF THE USUAL ACTION FOR +;THAT CHARACTER.) +;^^FS^RCMAC$ GETS, Q,^^FS^RCMAC$ SETS. +;CHARACTER IS ASSUMED TO BE ASCII. IF UPARROW FLAG IS ON, +;THE CHARACTER IS TREATED AS 9-BIT INSTEAD. +;DEPOSITS IN -1(P)! ASSUMES THE CALLER WAS THE FS COMMAND DISPATCH! +FSCRMA: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => SETTING, ELSE GETTING. + CALL TYIABN ;IF FRUPRW OFF, CONVERT ASCII ARG TO 9-BIT. + MOVE E,C + MOVE C,SARG + CAIGE E,RRMACL ;LAST ARG OUT OF RANGE => ERROR. + SKIPGE E + TYPRE [AOR] + ADDI E,RRMACT ;E -> WORD TO BE SET OR GOTTEN. + HRLM E,-1(P) .SEE FSCALL + JRST FSNOR1 + +TYIABN: TRZN FF,FRUPRW ;IF FRUPRW IS OFF, CONVERT ASCII CHAR IN C TO 9-BIT. + CAIL C,40 + RET + CAIE C,33 + CAIN C,^M + RET + CAIL C,^H + CAILE C,^J + ADDI C,300 + RET + +; FS ^R IND RETURNS THE CHAR CODE THAT INDIRECTS TO (MAY BE ITSELF). +FSINDT: TRZ FF,FRARG ;FLUSH ARG OR WE WILL ADD TO IT. + CAIGE C,512. + CAIGE C,0 + TYPRE [AOR] + HRRZ A,C ;INITIALLY ASSUME CHAR NOT INDIRECT. +FSIND1: HRRZ T,RRMACT(A) + CAIE T,RRINDR + JRST POPJ1 ;NOT INDIRECT => RETURN IT. + HLRE T,RRMACT(A) ;ELSE COMPUTE THE CHAR IT INDIRECTS TO. + SUB A,T + JRST FSIND1 + +;, F^S SEARCHES BUFFER IN STARTING AT WORD +;FOR A WORD CONTAINING . RETURNS IDX OF FIRST SUCH, OR -1 IF NONE. +;, :F^S SEARCHES ^R DEFINITION TABLE. +TABSRC: TRNN FF,FRARG + TYPRE [WNA] + MOVE J,[-RRMACL,,RRMACT] + TRNE FF,FRCLN ;COLON => SEARCH ^R DEFINITION TABLE. + JRST TABSR1 + CALL QREGX ;ELSE READ QREG NAME + MOVE BP,A + CALL QBGET1 ;AND DECODE CONTENTS AS BUFFER. + MOVE T,MFBEGV(B) ;B HAS FRAME ADDR; MAKE AOBJN TO CONTENTS. + IDIVI T,5 + HRRZ J,T + MOVE T,MFZV(B) + IDIVI T,5 + SUBM J,T + HRL J,T +TABSR1: HRLS E + ADD E,J ;1ST ARG IS # OF ENTRIES AT FRONT OF TABLE NOT TO TEST. + CAME C,(E) + AOBJN E,.-1 + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + JUMPGE E,NRETM1 ;RETURN -1 IF DON'T FIND THE OBJECT. + SUB E,J + HRRZ A,E + JRST POPJ1 ;ELSE RETURN INDEX FIRST FIND IT AT. + +SUBTTL MISCELANEOUS ^R MODE COMMANDS + +RRCTLL: SKIP ;^L COMMAND. + SKIPN RGETTY ;^L WITH ARG PRINTS SPEC'D # OF LINES (FOR PRINTING TTY'S). + JRST RRDISL + CALL CTLL +RRMAC1: SETOM RRMNVP ;CAUSE WINDOW TO BE TESTED, + SETOM RRMSNG ;AND THE WHOLE BUFFER TO BE REDISPLAYED. + JRST RRBTCR ;IN CASE THAT DOESN'T HAPPEN FOR A WHILE + ;MAKE SURE WE HAVE A REASONABLE RRHPOS. + +RRDISL: SETZM RUBENC ;HERE FOR ^L; DISPLAY LINES OF BUFFER. + CALL CRR + CALL CRR + CALL WINSET ;SET WINDOW SIZE TO LINES. + CALL VBDRR ;DO THE DISPLAY. + CALL RRDIS3 ;THEN DO A 0T SO USER SEES WHERE CURSOR IS. + MOVE C,NLINES ;RESTORE NORMAL WINDOW SIZE. + JRST WINSET + +RRMAC3: ADDB A,RREPT ;RELOCATE OLD PT FOR BUFFER MOTION. + CAML A,BEGV ;OLD CURSOR-LOCATION NO LONGER INSIDE BUFFER => + CAMLE A,ZV ;CAN'T MOVE FROM THERE, MUST REDISPLAY SLOW WAY. + JRST RRMAC1 + MOVE E,PT + SKIPN RGETTY ;ELSE, USE EITHER RRMOV OR RRQMOV TO DETERMINE NEW VPOS/HPOS, + JRST RRMOV1 ;GUESSING WHICH ONE WILL BE FASTER; BUT ON TTY'S USE ONLY RRMOV. + MOVE TT,A + SUB TT,PT + MOVMS TT + CAIL TT,30. + JRST RRQMOV +RRMOV1: MOVEM A,PT ;THAT IS WHERE RRHPOS AND RRVPOS ARE RIGHT FOR. + JRST RRMOV + +RRERST: SAVE Q +RRERS1: CAML CH,DISPRR ;POPPING OUT OF A MACXQ: POPPING OUT OF A ^R-INVOCATION? + JRST POPQJ + SOS Q,DISPRR ;IF SO, RESTORE DISPRR'S VALUE OUTSIDE THAT INVOCATION. + POP Q,DISPRR + SKIPE DISPRR ;IF THIS ^R WAS THE OUTERMOST, + JRST RRERS1 + SAVE TT + SAVE TT1 + SAVE CH + CALL SETTTM ;RESTORE NORMAL TTYSET. + REST CH + REST TT1 + REST TT + JRST POPQJ + +;RTNS TO HANDLE THE MARK. + +;SET THE MARK AT PT. +RRMARK: SKIP + SKIPE RR4TCT ;^U^T EXCHANGES MARK WITH PT. + JRST RREXCH +RRMRK1: .I RRMKPT=PT-BEG + POPJ P, + +;EXCHANGE THE MARK AND PT. +RREXCH: SKIP + SKIPGE E,RRMKPT + JRST RRERR ;NO MARK => CAN'T EXCHANGE. + ADD E,BEG ;TURN INTO CHAR ADDR. + SAVE PT ;REMEMBER NEW VALUE OF MARK. + CALL RRMOV ;MOVE PT TO OLD MARK. + REST TT ;SET MARK TO OLD PT. + SUB TT,BEG + MOVEM TT,RRMKPT + JRST RRTTY ;ON PRINTING TERMINAL, GO SHOW CURSOR MOTION. + +;DO FX..K ON EVERYTHING FROM PT TO THE MARK. +RRFX: SKIP + SKIPGE A,RRMKPT + JRST RRERR + ADD A,BEG + CAMN A,PT ;DELETING NO CHARS => + JRST RRFXXT ;DON'T CLOBBER QREG ..K. + CAMG A,PT + CALL RREXCH ;MAKE SURE PT IS BEFORE MARK. + MOVE E,PT + MOVE A,RRMKPT + ADD A,BEG + MOVE C,A + SUBM E,A + CALL RRFXMX ;SET RRMAXP + CALL RRCRDI ;WORRY ABOUT BEFORE-EFFECTS. + CALL [ CALL RRDLB2 ;SET RRMNVP, RRMNHP FROM T,BP. + MOVE CH,QRB.. + ADDI CH,.QRRBF + CALL FXCMD2 ;DO THE FX. D _ AMOUNT BEG CHANGED. + MOVE A,D + JRST RRFXRL] ;RELOCATE VARIOUS PTRS THAT MUCH +RRFXXT: SETOM RRMKPT ;ELIMINATE THE MARK. + POPJ P, + +;RELOCATE RR MODE'S VARIOUS PTR THAT ARE KEPT AS CHAR ADDRS, +;BY THE AMOUNT IN A. (IN CASE THE BUFFER WAS MOVED) +;CLOBBERS TT +RRFXRL: MOVE TT,RRMAXP ;NOTE THAT IF RRMAXP IS INFINITY IT SHOULDN'T BE CHANGED. + AOS TT + CAILE TT,1 ;ALSO IF IT IS ZERO. + ADDM A,RRMAXP + ADDM A,RROLDZ + MOVE TT,TOPLIN +RRFXR1: CAMN TT,BOTLIN + RET + ADDM A,LINBEG(TT) + AOJA TT,RRFXR1 + +;KILL LINES STARTING AT PT, AND PUT IN QREG ..K. +RRKILL: SKIP + CALL RRMRK1 + CALL RRNEX1 + JRST RRFX + +;^S -- READ CHAR, AND SEARCH FOR THAT CHAR. +RRSRCH: SKIP + SAVE C + CALL RRECO1 ;MAYBE PROMPT WITH A ^S. + REST NUM + MOVEI A,[ASCIZ/FIU..0 :S..0 /] + JRST RRMAC6 + +RRCTLB: SKIP ;^B MOVES BACKWARD - IT IS -^F. + MOVNS C +RRCTLF: SKIP ;^F MOVES FORWARD, BUT ON PRINTING TTY IT ECHOES. + AOS (P) + JUMPL C,RRCB1 ;WORK FOR NEGATIVE ARGS. + JSP E,RRREP1 + JRST RRFORW + +RRCB1: MOVNS C + JSP E,RRREP1 + JRST RRBACK + +;JSP E,RRTYPP SKIPS UNLESS WE ARE SCANNING (SHOULD PRINT SCANNED CHARACTERS). +RRTYPP: SKIPN RGETTY + SKIPN RRSCAN + JRST 1(E) + JRST (E) + +;^P -- WITH ARGUMENT , DOES -@L. +RRPREV: SKIP ;CALCULATE , + MOVNS C + JRST RRNEX2 ; IS -. + +;^A -- MOVE TO BEGINNING OF LINE. +;WITH ARGUMENT , DOES -1@L. +RRBEG: SKIP + SOJA C,RREND2 + +;^E -- MOVE TO END OF LINE (:@L). WITH ARGUMENT , DO :@L. +RREND: SKIP +RREND1: TRO FF,FRCLN +RREND2: AOS (P) + JRST RRNEX1 + +;^N -- MOVE TO BEGINNING OF NEXT LINE. (@L) +;WITH ARGUMENT , DOES @L. +RRNEXT: SKIP +RRNEX2: AOS (P) + SAVE [RRCMIN] ;DO COMMENT-MODE STUFF AT START AND FINISH OF MOTION. + CALL RRCMRU +RRNEX1: MOVE IN,PT + TRO FF,FRUPRW + CALL GETAG4 ;COMPUTE WHERE WE'RE GOING TO. + JFCL + ADD E,C ;THE WAY THE L COMMAND DOES. + SUB E,PT + JRST RRMOV ;THEN GO THERE. + +;CALL HERE WHEN LEAVING A LINE. +;IN COMMENT MODE, TAB-SEMI'S ARE REMOVED BY THIS RTN. +RRCMRU: SKIPGE RRCMMT + POPJ P, ;DO NOTHING IF NOT COMMENT MODE. +RRCMR1: SAVE C + MOVEI C,1 + CALL RREND1 + JFCL + REST C + MOVE IN,PT + CAMG IN,BEGV + POPJ P, ;DO NOTHING AT BEGINNING OF BUFFER. + SOS IN + CALL GETCHR ;IF CHAR BEFORE PT IS A SEMI, + CAIE CH,"; + POPJ P, +RRCMR0: CALL RRDLB ;DELETE IT, AND ANY TABS BEFORE IT. + MOVE IN,PT + CAMG IN,BEGV + POPJ P, + SOS IN + CALL GETCHR + CAIE CH,^I + CAIN CH,40 + JRST RRCMR0 + POPJ P, + +RRCMS1: SETZ C, + CALL RRNEX1 + +;CALL HERE WHEN ENTER A LINE. +;IN COMMENT MODE, TAB-SEMI WILL BE INSERTED. +RRCMIN: SKIPGE RRCMMT + RET ;NOT COMMENT MODE. +RRCMI0: MOVE IN,PT ;MOVE UP TO EXISTING COMMENT + CALL RREOLT ;OR END OF LINE. + JRST RRCMI1 ;REACHED END, INSERT TAB-SEMI. + CALL GETCHR + CAIN CH,"; + JRST RRFORW ;REACHED SEMI, STOP AFTER IT. + CALL RRFORW + JRST RRCMI0 ;ELSE KEEP LOOKING. + +RRCMI1: MOVEI CH,^I ;INSERT TABS TILL REACH COMMENT COLUMN + CALL RRINS + MOVE A,RRHPOS + CAMGE A,RRCCOL ;REACHED THE COMMENT COLUMN? + JRST RRCMI1 ;NO, MORE TABS TO INSERT. + MOVEI CH,"; ;YES, INSERT THE SEMI. + JRST RRINS + +;^C -- COMPLEMENT COMMENT MODE. +RRCMSW: SKIP ;IF NUMERIC ARG, IT IS SETTING OF COMMENT COLUMN. + CAIE C,1 + MOVEM C,RRCCOL + AOSE A,RRCMMT ;IF WAS -1, MAKE IT 0. + SETOB A,RRCMMT ;WAS >=0, MAKE IT -1. + CALL RRECSP ;THEN INDICATE WHICH MODE WE'RE IN. + MOVE CH,(A)1+[ "T ? "C ] + CALL FSECO1 + XCT (A)1+[CALL RRCMR1 ;LEAVING COMMENT MODE, REMOVE SEMI. + CALL RRCMS1] ;WHEN ENTER COMMENT MD, INSERT SEMI. +;TYPE A SPACE IN THE ECHO REGION, MAKING SURE CURSOR WILL +;BE REPOSITIONED IN THE DISPLAY REGION. PRESERVE ALL ACS. +RRECSP: SAVE CH + MOVEI CH,40 + CALL FSECO1 + JRST POPCHJ + +;^R -- SET COMMENT COLUMN FROM CURRENT HPOS. +RRCMCS: SKIP A,RRHPOS + SKIPGE RRCMMT ;NO EFFECT UNLESS IN COMMENT MODE. + POPJ P, + MOVEM A,RRCCOL + POPJ P, + +;TABLES USED BY RRCHRG. THE ENTRY FOR EACH +;CHARACTER IS AN INDEX INTO RRFORT OR RRBACT. + +RRCHBP: REPEAT 6,<360600-<6*.RPCNT>_12.>,,RRCHTB(A) + +;CODES IN RRCHTB ARE: + ;0 - 1-POSITION CHARACTER. + ;1 - ORDINARY CTL CHAR - USUALLY 2-POSITION, BUT 1-POSITION IN SAIL MODE. + ;2 - BACKSPACE. + ;3 - CR + ;4 - LF + ;5 - TAB. + ;6 - SPECIAL CTL CHARACTER - 2-POSITION EVEN IN SAIL MODE. + +RRCHTB: .BYTE 6 + 1 ;^@ + 1 ;^A + 1 ;^B + 1 ;^C + 1 ;^D + 1 ;^E + 1 ;^F + 1 ;^G + 2 ;^H + 5 ;^I + 4 ;^J + 1 ;^K + 1 ;^L + 3 ;^M + 1 ;^N + 1 ;^O + 1 ;^P + 1 ;^Q + 1 ;^R + 1 ;^S + 1 ;^T + 1 ;^U + 1 ;^V + 1 ;^W + 1 ;^X + 1 ;^Y + 1 ;^Z + 0 ;ALTMODE, 1 POSITION. + 1 ;[ ;^] + 1 ;^\ + 1 ;^^ + 1 ;^_ + .BYTE + +SUBTTL OBSOLETE ^T COMMAND + +EDIT: CALL GAPSLP + SKIPE ECHOFL + CALL NOECHO + TRZ FF,FRARG+FRARG2+FRUPRW ;FRARG ON = INSERT MODE, OFF = OVERWRITE MODE + ;FRARG2 ON = IN IS POINTING TO CR + ;FRUPRW ON = BACKWARDS RUB MODE + SETZM COMCNT + MOVE B,CBUFLO + SKIPA IN,PT +ED0.0: POP P,A ;PURGE EXTRA PUSHJ P, +ED0: PUSHJ P,CRR + TRZ FF,FRUPRW ;TURN OFF "\" FLAG +ED1: PUSHJ P,DISFLS + PUSHJ P,TYI + CALL TYINRM + MOVE A,CH + MOVEI CH,"\ + CAIL A,40 + JRST EDLIS + SKIPL C,EDDPTB(A) ;IS IT A RUBBACK COMMAND + JRST ED11 ;NO + TRON FF,FRUPRW ;TURN ON "\" FLAG +ED12: PUSHJ P,TYOA ;AND IF WAS OFF, TYPE "\" +ED13: MOVE CH,A + PUSHJ P,@C + PUSHJ P,TYO + JRST ED1 + +ED11: TRZE FF,FRUPRW ;TURN OFF "\" FLAG + JRST ED12 ;IF IT WAS ON, PRINT "\" + JRST ED13 + +BELL: CALL TYPBEL + JRST CPOPJ1 + +EDLIS: CAIE A,177 + JRST EDLIS1 + TRON FF,FRUPRW + PUSHJ P,TYOA + JRST .+3 +EDLIS1: TRZE FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + PUSHJ P,CKCH + JRST ED0 + JRST ED1 + PUSHJ P,EDOV + JUMPL CH,ED1 + PUSHJ P,TYO + JRST ED1 + +ED%: MOVEI CH,"# + PUSHJ P,TYO + PUSH P,IN + PUSH P,FF +ED%1: PUSHJ P,CGETIN + JUMPL CH,ED%2 ;END OF LINE OR BUFFER + PUSHJ P,TYO + JRST ED%1 +ED%2: POP P,FF + POP P,IN + PUSHJ P,CRR + MOVE A,COMCNT + JUMPLE A,CPOPJ1 + MOVE B,CBUFLO + ILDB CH,B + PUSHJ P,TYO + SOJG A,.-2 + JRST CPOPJ1 +EDOV: MOVE A,CH + TRNN FF,FRARG ;IN INSERT MODE + PUSHJ P,CGETIN ;NO + SKIPA CH,A +EDCPY: PUSHJ P,CGETIN + JUMPL CH,CPOPJ +EDCPY1: IDPB CH,B + AOS COMCNT + POPJ P, + +CGETIN: MOVNI CH,1 + TRNE FF,FRARG2 + POPJ P, + CAML IN,ZV ;AT END OF BUFFER + JRST CGETI1 + PUSHJ P,GETCHR + CAIN CH,15 +CGETI1: TROA FF,FRARG2 + AOJA IN,CPOPJ + MOVNI CH,1 + POPJ P, + +EDCR: PUSHJ P,CRR +EDCR2: TRNE FF,FRARG2 + JRST EDCR1 + PUSHJ P,CGETIN + JRST EDCR2 +EDCR1: MOVE C,IN ;GET ADDR AFTER END OF OLD LINE, + MOVE E,PT ;GET ADDR OF START OF IT, + CALL DELET1 ;TURN THAT INTO GAP. + MOVE C,COMCNT ;NOW INSERT SPACE FOR NEW LINE, + CALL SLPGET ;BP GETS BP TO IDPB INTO SPACE. + MOVE A,COMCNT + JUMPE A,EDCR3 + MOVE B,CBUFLO + ILDB CH,B + IDPB CH,BP + SOJG A,.-2 +EDCR3: TRZ FF,FRARG+FRUPRW+FRARG2 + SETZM COMCNT + SETOM UNRCHC + PUSHJ P,SETTTM + JRST GO + +RTYI: PUSHJ P,TYI + CALL TYINRM + CAIE CH,177 + POPJ P, + MOVEI CH,"\ + TRON FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + SUB P,[1,,1] + POPJ P, + +EDD: PUSHJ P,CGETIN ;DELETE NEXT CHAR + JUMPL CH,BELL ;BELL IF NONE + MOVEI CH,"% + POPJ P, + +EDP: MOVEI CH,"< ;COMPLEMENT STATE OF INSERT/OVERWRITE MODE + TRCE FF,FRARG + MOVEI CH,"> + POPJ P, + +EDS: PUSHJ P,RTYI ;COPY THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDS1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDS1 ;KEEP LOOKING + POP P,FF + POP P,IN + JRST EDN1 +EDN: PUSHJ P,EDCPY ;COPY THRU 1ST SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAIN CH," + JRST EDN + MOVEI A," +EDN1: PUSHJ P,EDCPY + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAME CH,A + JRST EDN1 + JRST CPOPJ1 + +EDS2: POP P,FF + POP P,IN + JRST BELL + +EDQ: PUSHJ P,RTYI ;QUOTE NEXT CHAR + JRST EDOV + +EDT: PUSHJ P,RTYI ;DELETE THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDT1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDT1 + POP P,FF + POP P,IN + JRST EDO1 + +EDO: PUSHJ P,CGETIN ;DELETE THRU NEXT SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + MOVE A,CH + MOVEI CH,"% + PUSHJ P,TYO + CAIN A," + JRST EDO + MOVEI A," +EDO1: PUSHJ P,CGETIN + JUMPL CH,CPOPJ1 + CAMN CH,A + SETOM A + MOVEI CH,"% + PUSHJ P,TYO + JUMPL A,CPOPJ1 + JRST EDO1 + +EDR: TROA FF,FRARG+FRUPRW ;FRARG ON = ECHO +EDL: TRZ FF,FRARG+FRUPRW ;FRUPRW ON = DONT END EDIT +EDL1: TRNE FF,FRARG2 + JRST EDL2 + PUSHJ P,EDCPY + JUMPL CH,EDL2 + TRNE FF,FRARG + PUSHJ P,TYO + JRST EDL1 +EDL2: TRZ FF,FRARG + TRZE FF,FRUPRW + JRST CPOPJ1 ;DON'T END EDIT + PUSHJ P,CRR ;CR-LF THEN END EDIT + JRST EDCR1 + +EDW: LDB CH,B ;RUBBACK TO 1ST NON-SPACE, THEN BACK TO 1ST SPACE + CAIE CH," + JRST EDW1 + MOVEI CH,177 + PUSHJ P,CKCH + JRST ED0.0 + JRST EDW +EDW1: LDB CH,B + CAIN CH," + JRST CPOPJ1 ;FOUND SPACE, QUIT + MOVEI CH,177 ;TO TELL CKCH TO RUBBACK + PUSHJ P,CKCH + JRST ED0.0 ;NOTHING TO RUB + JRST EDW1 + .VALUE ;SHOULD NEVER GET HERE + +EDALT: TRO FF,FRARG ;COPY REST W/ ECHO AND END EDIT + TRZ FF,FRUPRW + JRST EDL1 + +SUBTTL TECO COMMAND DISPATCH / ARGUMENT ARITHMETIC + +CD: SETZM NUM ;FLUSH ANY ARGUMENT, OR : OR ^. + SETZM SARG + TRZA FF,FRARG+FRARG2+FROP+FRUPRW+FRCLN+FRSYL +CD2B: TROA FF,FROP+FRARG ;COME HERE FROM ARITH OPS, NEED 2ND ARG. +CD2A: MOVSI A,(ADD C,);SET UP DLIM FOR THE DEFAULT + ;CONDITION OF ADDING THE OLD VALUE + ;WITH ANY NEW NUMBER ENTERED + HLLM A,DLIM ;PUT THE APPROPRIATE OPERATOR AWAY + CLEARM SYL ;CLEAR THE NEW NUMBER ENTERED + CLEARM OSYL ;ALSO CLEAR ITS OCTAL INTERPRETATION +CD5: MOVE A,QRWRT ;IF IMPURE STRING SPACE HAS INCREASED BY + CAML A,QRGCMX ;GCOFTN CHARS SINCE PREVIOUS GC, + PUSHJ P,GC ;GC THE IMPURE STRINGS. +CD5A: SKIPGE STOPF ;IF THE USER HAS ^G'ED, TRY TO QUIT, + CALL QUIT0 ;TRY TO QUIT (CHECK NOQUIT). + CALL RCH ;GET THE NEXT COMMAND CHARACTER +CDRCH: TRNE CH,100 ;CONVERT LOWER CASE TO UPPER. + ANDCMI CH,40 + SETZB B,SQUOTP + TRZ FF,FRNOT ;RESET MORE FLAGS + XCT DTB(CH) ;EXECUTE THE ENTRY FROM THE DISPATCH TABLE +CD5B: TLZ FF,FLDIRDPY ;RESET THE "DISPLAY THE FILE DIRECTORY BIT", THIS INSURES + ;THAT AN E COMMAND WILL ONLY DISPLAY THEBUFFER IF IT IS THE LAST COMMAND + MOVE C,NUM ;GET THE OLD VALUE + TRZN FF,FRSYL + JRST CD5C + XCT DLIM ;THEN PERFORM THE SAVED OPERATION + MOVEM C,NUM ;AND MAKE IT THE NEW OLD VALUE +CD5C: MOVE E,SARG ;GET THE SECOND ARGUMENT TO THE COMMAND (IF ANY) + JUMPGE B,(B) ;IF B POSITIVE, THEN JUMP TO IT. + PUSHJ P,(B) ;IF B NEGATIVE, PUSHJ +CDRET: JRST CD ;NON-SKIP RETURNING COMMANDS DON'T RETURN VALUE +VALREC: TROE FF,FRARG ;IF HAVE ARG FROM BEFORE, NOT GOBBLED, + JRST VALRET ;DO ARITH. WITH IT & THIS CMD'S VALUE. + MOVEM A,NUM ;IF NO ARG OR THIS CMD USED IT, ITS + TRZ FF,FROP ;VALUE IS ALL THE ARG WE HAVE. + JRST CD2A + +CDNUM: JFCL 10,.+1 ;CLEAR OVERFLOW FLAG. + MOVE A,OSYL ;ASSEMBLE THIS DIGIT INTO A NUMBER + IMUL A,I.BASE ;(USUALLY OCTAL) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) + MOVEM A,OSYL + JFCL 10,.+1 + MOVE A,SYL + IMUL A,IBASE ;AND IN DECIMAL (USUALLY) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) +VALRET: MOVEM A,SYL ;SAVE IT AS A VALUE + TRZ FF,FROP ;DON'T HAVE ARITH OP WAITING FOR 2ND ARG +CD7: TRO FF,FRARG+FRSYL ;DECLARE THAT THERE IS AN ARGUMENT AND A CURRENT VALUE + JRST CD5 ;AND RETURN + + +;ARGDFL MACRO CALLS HERE IF FROP WAS SET, AFTER CLEARING IT. +;ARGDFL IS USED TO DEFAULT "-" TO "-1", ETC. +ARGDF0: SETZM SYL ;PRETEND A "1" HAD PRECEDED THIS CMD, + AOS SYL ;AFTER THE OPERATOR THAT NEEDS 2ND ARG, + XCT DLIM ;DO THE ARITHMETIC, + POPJ P, + +PNT: MOVE A,OSYL + TRNE FF,FRSYL + JRST VALRET + MOVE A,PT + SUB A,BEG + JRST VALRET + +CNTRAT: ARGDFL Z, ;^@ - TAKES 1 ARG, RETURNS .,.+ARG OR .+ARG,. . + TRZE FF,FRARG2 + JRST [ TRZE FF,FRCLN ;M,N:^@ RETURNS N,M. + JRST [ MOVE B,C + MOVE A,E + JRST 2VALS] + MOVE A,C ;M,N^@ RETURNS N-M. + SUB A,E + JRST POPJ1] + MOVE B,PT + ADD C,PT + MOVE A,C + CAMG A,B ;MAKE SURE ARGS ARE IN RIGHT ORDER. + EXCH A,B + JRST HOLE0 + +HOLE: MOVE B,BEGV + MOVE A,ZV +HOLE0: SUB B,BEG ;RETURN 2 CHAR ADDRS AS VALUES. + SUB A,BEG ;CHANGE THEM TO CHARACTER NUMBERS (REL TO BEG, THAT IS) +2VALS: MOVEM B,SARG ;RETURN 2 VALUES IN B, A. + TRO FF,FRARG2 + JRST POPJ1 + +END1: SKIPA A,ZV +BCMD: MOVE A,BEGV +FSROC1: SUB A,BEG + JRST POPJ1 + +;F^X COMMAND - WITHIN MACRO, RETURN THE MACRO ARGS +;(AS MANY AS IT WAS CALLED WITH). +FCTLX: MOVE A,MARG2 ;GET THE VALUES THE MACRO'S ARGS HAVE IF THEY EXIST. + MOVE B,MARG1 + MOVE C,MACBTS ;GET THE BITS THAT SAY WHETHER THEY DO. +;ENTER HERE DO F^X ON SOME OLD MACRO FRAME, WITH ITS DATA IN A, B, C. +FCTLX2: TRZ FF,FRARG+FRARG2+FROP+FRSYL + SETZM NUM ;FLUSH ALL TRACES OF ARGUMENTS. + SUB P,[1,,1] ;THROW AWAY RET ADDR (VALREC-1); WE WILL JUMP INTO COMMAND LOOP. + TLNN C,MFBA1 ;IF THERE'S A 1ST ARG, + JRST FCTLX1 + MOVEM B,SARG ;PUT IT AWAY + TRO FF,FRARG2 ;AND SAY THERE IS ONE. +FCTLX1: TLNE C,MFBA2 + JRST VALREC ;IF THERE'S A 2ND ARG, SET IT UP AS CURRENT VALUE. + JRST CD2A ;IF THERE ISN'T, SET UP NO CURRENT VALUE BUT DON'T CLEAR FRARG2. + +;F^Y COMMAND - TAKES 0,1 OR 2 ARGS, AND RETURNS 0 IF NO ARGS, 1 IF ONLY A 2ND ARG, +;2 IF ONLY A 1ST ARG (EG 1,F), 3 IF TWO ARGS (EG 1,2F). +;IN ADDITION, 4 IS ADDED TO THE RESULT IF THE COLON FLAG IS SET, +;AND 8 IS ADDED TO THE RESULT IF THE ATSIGN FLAG IS SET. +FCTLY: LDB A,[.BP FRARG+FRARG2+FRCLN+FRUPRW,FF] + TRZ FF,FRARG+FRARG2+FRUPRW+FRCLN + JRST POPJ1 + +;^M - FLUSH CURRENT VALUE +CTLM: MOVE A,CPTR ;^M. IF NEXT CHAR IS ^J, READ IT NOW. + ILDB CH,A + CAIN CH,^J + SKIPN COMCNT ;THIS IS SO THAT, IF FS STEP CALLS A MACRO, + CAIA ;THE POINTER IN AN FS BACKTRACE$ IS AT A NICE-LOOKING PLACE. + CALL RCH +CTLM2: SKIPN A,STEPFL + RET + MOVE B,STEPDE ;DON'T STEP IF DEEPER IN MACRO CALLS THAN USER-SUPPLIED LIMIT. + CAMGE B,MACDEP + JUMPGE B,CPOPJ + SETZ C, ;(DON'T GIVE THE STEP MACRO A NONZERO ARG) + CALL QLGET0 + CAIA ;IF FS STEP IS A NONZERO NUMBER, DO OUR BUILT-IN STEPPING. + JRST MACXCP ;IF IT'S A STRING, MACRO IT AND RETURN ITS VALUE. + MOVE A,QRB.. + SKIPE .QVWFL(A) + JRST CTLM1 + TRZ FF,FRARG+FRARG2+FRCLN + TRO FF,FRUPRW ;IN LINE-STEPPING MODE (SEE FS STEP$), + CALL VIEW1B ;DO ^VW, AND DECODE VALUE OF CHARACTER READ +CTLM1: MOVE A,QRB.. + SETZM .QVWFL(A) ;AND ALLOW BUFFER DISPLAY AFTER COMMAND. + TRZ FF,FRUPRW+FRCLN + CALL FTYI + JFCL + CAIN A,^F + JRST [ SETZM NOQUIT ;^F QUITS EVEN WHEN QUITTING NOT ALLOWED. + SETOM STOPF + RET] + CAIN A,^R + JRST [ CALL RRENTR ; ENTER ^R MODE + JRST CTLM1] ;THEN DECODE ANOTHER CHARACTER. + CAIN A,^P + SETZM STEPFL ;OR TURN OFF STEPPING + RET + +CAND: MOVSI A,(AND C,) + JRST CD2B +COR: MOVSI A,(IOR C,) + JRST CD2B +BAKARR: HRROI B,SERCHA ;_ IS EITHER SEARCH-AND-YANK OR SAME AS -. + SKIPLE NLAROW ;FS _DISABLE POSITIVE => "_" IS ERROR. + TYPRE [DCD] ;"DISABLED COMMAND" + SKIPN NLAROW ;FS _DISABLE IS NEGATIVE => "_" IS TREATED AS "-". + JRST CD5B ;FS _DISABLE IS 0 => "_" IS SEARCH-AND-YANK. +MINUS: MOVSI A,(SUB C,) + JRST CD2B +TIMES: MOVSI A,(IMUL C,) + JRST CD2B +SLASH: MOVSI A,(IDIV C,) + JRST CD2B +CXOR: MOVSI A,(XOR C,) + JRST CD2B +PLUS: MOVSI A,(ADD C,) + JRST CD2B + +SPACE: TRNE FF,FROP ;SPACE BETWEEN NUMBERS IS LIKE PLUS, + JRST CD5A ;BUT SPACE NEXT TO AN ARITHMETIC OPERATOR IS IGNORED. + JRST CD2A + +COMMA: TRZN FF,FRARG + JRST COMMA1 + MOVEM C,SARG + TROE FF,FRARG2 + TYPRE [WNA] +COMMA1: SETZM NUM ;NO ACCUMULATED 1ST ARG ANYMORE, + JRST CD2A ;INIT. FOR NEW ARG, DON'T CLEAR FRCLN. + +ASLSL: TROA FF,FRUPRW ;TURN ON THE UPARROW FLAG +ACOLON: TRO FF,FRCLN ;TURN ON THE COLON FLAG + JRST CD5A ;AND GO BACK FOR MORE + +;HANDLE (, ), F(, F) + +FOPEN: SUB P,[1,,1] ;F( - PUSH VALUES BUT DON'T FLUSH THEM. + SKIPA T,[CD5A] +OPEN: MOVEI T,CD ;( - PUSH AND FLUSH VALUES. +OPEN1: TRZ FF,FRQPRN ;SAY THIS ( ISN'T A QREG NAME. +OPEN2: SAVE NUM + HLLZ CH,DLIM + HRR CH,FF ;REMEMBER CURRENT FRCLN, FRUPRW, FRARG2. + TRNE FF,FRARG2 + SAVE SARG ;SAVE 2ND ARG IF THEE IS ONE. + SAVE CH + SAVE LEV + MOVEM P,LEV + JRST (T) + +FCLOSE: SUB P,[1,,1] ;F) - POP AND THROW AWAY VALUES. CALLED WITH PUSHJ. + SKIPA T,[CD5A] +CLOSE: HRROI T,CD5A ;) - POP AND RETURN VALUES. RH(T) IS RET. ADDR., SIGN=0 => THROW AWAY. +CLOSE2: CAME P,LEV + TYPRE [UMC] ;NOT ALLOWED IF TOP OF STACK DOESN'T HAVE SOME PUSHED VALS. + SKIPN Q,ITRPTR + JRST CLOSE1 + HLRZ Q,-1(Q) + CAIN Q,(P) + TYPRE [UMC] ;DON'T ALLOW SEQUENCE "(<)" - WOULD SCREW UP ">". +CLOSE1: REST LEV + REST CH + ANDCMI CH,#FRARG2#FRCLN#FRUPRW#FROP#FRARG#FRQPRN + TRNE CH,FRARG2 + REST B + REST A + TRNN CH,FRQPRN + JUMPGE T,(T) ;FOR F), DO NOTHING WITH THE POPPED STUFF. + EXCH A,NUM ;ELSE RESTORE SAVED ARG VALUES AND OPERATOR. + HLLM CH,DLIM + TRNE CH,FRARG2 + MOVEM B,SARG + TRZE CH,FRQPRN ;FOR Q( - ), WE HANDLE THE FLAGS A SPECIAL WAY. + JRST QREGXR + TRNE FF,FRARG ;NORMALLY, WE SET UP THE VALUE WITHIN THE PARENS AS A SYLLABLE + TRZ CH,FROP ;TO DO ARITHMETIC ON. SO THE PREVIOUS OPERATOR GETS A RIGHT OPERAND. + TRNE FF,FRARG + IORI FF,FRSYL + MOVEM A,SYL + IORI FF,(CH) + JRST (T) + +;SET P FROM CH, AND FORGET ABOUT ALL ('S +;THAT WERE IN THE PART OF THE STACK THAT HAS BEEN FLUSHED. +;ALSO PERFORM APPROPRIATE ACTIONS IN CASE POPPING PAST A ^R OR A SORT. +;THEN EXIT WITH POPJ P, (NOTE P HAS CHANGED, SO CALL WITH PUSHJ CH, +;BUT DON'T DARE DO THAT IF P=CH, SINCETHAT WOULD LEAVE THE RETURN +;POINTER ON STACK ABOVE P, CAUSING TIMING ERROR WITH INT. LEVEL). +SETP: MOVEM P,SETPP + CAMLE CH,P + .VALUE ;MOVING PDL POINTER UPWARDS?? + SKIPE DISPRR ;IF POPPING OUT OF A ^R, + CALL RRERST ;UNBIND SOME STUFF. + CAMGE CH,PSSAVP + SETZM PSSAVP ;DETECT ERRING OUT THROUGH A ^P, AND RELEASE SORT TABLES. +;HERE IF KNOWN NOT TO BE EXITING A ^R OR ^P. +SETP1: SKIPE LEV ;IF THERE IS AN (, + CAML CH,LEV ;AND IT'S NO LONGER BENEATH P, + JRST [ MOVE P,CH ? RET] + HRRZ P,LEV + CAIL P,PDL + CAIL P,PDL+LPDL + .VALUE + MOVE P,LEV ;FLUSH THE INNERMOST "(" + REST LEV + JRST SETP1 ;AND EXAMINE THE NEXT ONE. + +SUBTTL VIRTUAL CHARACTER ADDRESS SUBROUTINES + +CHKC: CAML E,BEGV ;BARF IF E NOT IN BUFFER. + CAMLE E,ZV + TYPRE [NIB] + RET + +CHK: CAMG C,ZV + CAMGE C,BEGV + TYPRE [NIB] + RET + +CHK1: CAMG E,BEGV + MOVE E,BEGV + CAML C,ZV + MOVE C,ZV + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +CHK1A: CAMG E,BEG + MOVE E,BEG + CAML C,Z + MOVE C,Z + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +GETIBI: SKIPA BP,IN +GETIB.: MOVE BP,PT +GETIBV: CAML BP,GPT + ADD BP,EXTRAC +GETIBP: SOSA TT,BP +GETBP: MOVE TT,BP + IDIVI TT,5 + MOVE BP,BTAB(TT1) + HRRI BP,(TT) + TLZ BP,17 + POPJ P, + +;CONVERT THE BYTE POINTER IN BP TO A CHARACTER ADDRESS +GETCA: LDB TT,[360600,,BP] ;GET POSITION FIELD IN TT + MOVEI BP,1(BP) ;CLEAR OUT LH OF BYTE POINTER + IMULI BP,5 + IDIVI TT,7 + SUBI BP,1(TT) + POPJ P, + +GETINC: MOVE TT,IN + AOSA IN +GETCHR: MOVE TT,IN + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + LDB CH,BTAB(TT1) + POPJ P, + +PUTINC: MOVE TT,OUT + AOSA OUT +PUT: MOVE TT,OUT + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + DPB CH,BTAB(TT1) + POPJ P, + + 440700+TT,, ;FOR SORT +BTAB: 350700+TT,, + 260700+TT,, + 170700+TT,, + 100700+TT,, + 10700+TT,, + +;CALL GETARG TO DECODE 0,1 OR 2 ARGS AS "T", "K", "X", ETC. DO. +;RETURNS IN E,C THE CHAR ADDRS OF BEGINNING AND END OF RANGE. +;SKIPS IF THERE WERE 0 OR 1 ARG; DOESN'T SKIP IF WERE 2. +;THE CALL TO GETARG SHOULD BE FOLLOWED BY A CALL TO CHK1 +;OR CHK1A, TO MAKE SURE THE ARGS ARE IN RANGE, IF THERE ARE 2 ARGS. + +;HERE TO AVOID LOOKING AT THE UPARROW FLAG. ALSO, CHECK RANGE USING VIRTUAL BOUNDS. +GETANU: SAVE FF + ANDCMI FF,FRUPRW + CALL GETARG + CALL CHK1 + REST FF + ANDCMI FF,FRCLN + RET + +;WITH THE UPARROW MODIFIER, WE STOP ONLY AT CRLFS, NOT STRAY LF'S. +GETARG: TRNE FF,FRARG2 + JRST GETAG6 + ARGDFL O +GETAG7: MOVE IN,PT +GETAG4: SAVE CH + SAVE B + JUMPLE C,GETAG2 + MOVE BP,IN + CAML BP,GPT + ADD BP,EXTRAC + CALL GETIBP +GETAR1: CAMN IN,ZV + JRST GETAG5 + CAMN IN,GPT ;REACHING THE GAP => MOVE OVER IT. + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;SCN UNTIL THE NEXT LF. + AOJA IN,GETAR1 + TRNN FF,FRUPRW ;IF WE HAVE THE UPARROW FLAG, + AOJA IN,GETAR2 + MOVE CH,BP ;CHECK THAT BEFORE THIS LF THERE IS A CR. + DBP7 CH + LDB CH,CH + TRNE FF,FRCLN ;IF WE HAVE COLON FLAG, WE WILL STOP BEFORE THE CR, + CAME IN,PT ;SO INSIST THAT THE CR ITSELF BE AFTER OUR STARTING POINT. + CAIE CH,^M + AOJA IN,GETAR1 + AOJ IN, +GETAR2: SOJG C,GETAR1 ;FOUND LF OR CRLF AS APPROPRIATE. IN POINTS AFTER THE LF. +GETAG1: TRZE FF,FRCLN + CALL GETAG8 + CAMG IN,BEGV + MOVE IN,BEGV +GETAG5: REST B + REST CH + MOVE E,PT + MOVE C,IN + TRZ FF,FRCLN\FRUPRW ;TURN IT OFF IF NOT ALREADY DONE + TLZE FF,FLNEG + EXCH C,E + AOS (P) + RET + +GETAG8: SUBI IN,2 + PUSHJ P,GETCHR + CAIE CH,15 + AOJA IN,GETAG9 + POPJ P, + +GETAG9: PUSHJ P,GETCHR + CAIE CH,12 + AOJ IN, + POPJ P, + +GETAG6: ADD C,BEG + ADD E,BEG + TRZ FF,FRCLN\FRUPRW + POPJ P, + +GETAG2: SOS IN +GETAG0: CAMGE IN,BEGV + AOJA IN,GETAG3 + PUSHJ P,GETCHR + CAIE CH,12 + SOJA IN,GETAG0 + TRNN FF,FRUPRW + JRST GETAR3 + CAMN IN,BEGV + JRST GETAG3 + SUBI IN,1 + CALL GETINC + CAIE CH,^M + SOJA IN,GETAG0 +GETAR3: AOJLE C,GETAG2 + AOJ IN, +GETAG3: TLO FF,FLNEG + JRST GETAG1 + +SUBTTL FUNDAMENTAL TECO COMMANDS + +REVERS: TRNE FF,FRARG2 ;R MOVES BACK N CHARACTERS. + JRST LINE ;MAKE FLR MOVE RIGHT OVER A LIST. + ARGDFL Z + MOVNS C + JRST REVER1 + +CHARAC: ARGDFL Z +REVER1: ADD C,PT +JMP1: CAML C,BEGV ;IS THE SPEC'D POS. WITHIN BFR'S LIMITS? + CAMLE C,ZV + JRST [TRZE FF,FRCLN ;NO, FOR :C, ETC. + JRST NRET0 ;RETURN FAILURE. + TYPRE [NIB]] ;NO :, THIS IS ERROR. + MOVEM C,PT + TRZE FF,FRCLN + JRST NRETM1 ;FOR :C, ETC. SAY SUCCESSFUL. + POPJ P, + +JMP: TRZN FF,FRARG + SKIPA C,BEGV + ADD C,BEG + JRST JMP1 + +LINE: CALL GETARG ;GET PT AND DESIRED PT IN C,E. DO GOBBLE UPARROW FLAG. + CALL CHK1 ;MAKE SURE ARGS ARE WITHIN VIRT. BUFFER. + ADD C,E + SUB C,PT ;IF EITHER ARG EQUALED PT, PT IS NOW THE OTHER ONE. + JRST JMP1 + +KILL: PUSHJ P,GETARG + PUSHJ P,CHK1 + JRST DELET1 + +DELETE: ARGDFL Z +DELET0: JUMPE C,CPOPJ ;DELETING 0 CHARS. + MOVE E,PT + ADD C,PT ;C,E HAVE 2 ENDS OF RANGE TO DELETE. + CALL CHK ;MAKE SURE C IS IN THE BUFFER. + +;MAIN DELETE RTN. C,E VIRTUAL CHAR ADDRS -> ENDS OF STUFF TO DELETE +;SETS PT TO PLACE DELETED FROM, LEAVES GAP THERE TOO. +.SEE FXCMD ;MUSTN'T CLOBBER A OR D. +DELET1: CAMG C,E ;GET UPPER END IN C, LOWER IN E. + EXCH C,E + MOVEM E,PT ;TELL GAPSLP WHERE TO PUT GAP (IF CALL IT) + SKIPE READON ;IF NOT ALLOWED TO MODIFY BUFFER + TYPRE [RDO] ;BARF OUT HERE + CAML C,GPT ;IF THE GAP IS IN OR NEXT TO + CAMLE E,GPT ;THE AREA BEING DELETED, OK. + CALL GAPSLP ;ELSE MOVE IT TO BE SO. + MOVEM E,GPT ;NOW TURN THE AREA INTO GAP. + SUB C,E +DELETB: SETOM MODIFF ;WE ARE CHANGING THE BUFFER CONTENTS. + ADDM C,EXTRAC + MOVNS C + ADDM C,ZV + ADDM C,Z + POPJ P, + +DEL1B: SOS PT ;DELETE 1 CHARACTER BACKWARDS FROM PT. + SOS GPT +DEL1F: SOS ZV ;DELETE 1 FORWARDS FROM PT. + SOS Z + AOS EXTRAC + RET + +SUBTTL F^E REPLACE CHARACTERS COMMAND + +;F^E$ - REPLACE STRING INTO BUFFER STARTING AT POSITION . +;:F^E$ - REPLACE IN QREG (EITHER STRING OR BUFFER WORKS). +;REPLACING IS LIKE INSERTING AND THEN DELETING AS MANY CHARS AS WERE INSERTED. +FCECMD: ARGDFL + TRZN FF,FRCLN + JRST FCE1 ;INSERT IN BUFFER? + TRZN FF,FRARG + TYPRE [WNA] + CALL QREGX ;NO, QREG. WHICH ONE? + CALL QLGET0 ;LENGTHH IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + SKIPL C + CAMLE C,B ;MAKE SURE ARG IS IN RANGE + TYPRE [AOR] + CALL GETCA + ADD BP,C ;ADJUST B.P. TO PLACE TO START REPLACING AT. + CALL GETBP + SETZ A, ;THERE'S NO GAP TO WORRY ABOUT. + JRST FCE2 + +FCE1: SKIPE READON ;ALLOWED TO MUNGE THIS BUFFER? + TYPRE [RDO] ;NO + SETOM MODIFF ;HERE WE ARE CHANGING THE CURRENT BUFFER'S CONTENTS. + TRZE FF,FRARG ;NO ARG, AND REPLACING IN BUFFER => USE ".". + JRST FCE5 + MOVE C,PT + SUB C,BEG +FCE5: MOVE BP,GPT ;REPLACE IN BUFFER. + CALL GETIBP ;MAKE B.P. TO START OF GAP SO WE CAN TELL WHEN WE REACH GAP. + MOVE A,BP + MOVE BP,BEG + ADD BP,C ;GET VIRT. CHAR ADDR OF WHERE TO START REPLACING + CAML BP,BEGV + CAMLE BP,ZV + TYPRE [AOR] + CALL GETIBV ;TURN INTO REAL CHAR ADDR, THEN BP. + ADD C,BEG ;TURN STOP ADRD IN C INTO ADDR REL. TO VIRTUAL BEG, + SUB C,BEGV ;SINCE MUST BE COMPARED WITH VIRTUAL SIZE. + MOVE B,ZV + SUB B,BEGV ;GET LENGTH OF BUFFER. +FCE2: SUB B,C ;C HAS CHARS FROM PLACE WE START TO END OF BUFFER OR QREG. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;FIND OUT WHAT STRING ARG DELIMITER WE'RE USING. + CALL RCH + MOVEM CH,INSDLM +FCE3: CALL RCH ;THIS IS THE INNER LOOP OF FCE + SKIPE SQUOTP + JRST FCE4 + CAMN CH,INSDLM ;CHECK CHAR FOR DELIMITERNESS UNLESS SUPERQUOTED, ETC. + JRST FCEEND +FCE4: SOJL B,[TYPRE [STL]] ;CHECK FOR END OF BUFFER OR QREG. + CAMN A,BP + CALL FEQGAP ;CHECK FOR GAP - MOVE B.P. IN BP OVER IT. + IDPB CH,BP + JRST FCE3 + +FCEEND: SETOM INSBP + RET + +SUBTTL INSERTION COMMANDS + +;INSERT ASCIZ STRING <- BP IN A, INTO Q-REG IN CH. +INSASC: TRO FF,FRCLN ;SAY INSERT IN Q-REG. + SAVE CH + SAVE [0] + SETZM INSDLM ;DELIMITER IS THE ^@ ENDING THE ASCIZ. + MOVE CH,[ILDB CH,A] + MOVEM CH,INSRCH ;GET CHARS BY ILDB-ING BP. + JRST INSAS1 + +FNCMD: MOVE CH,[CALL RCH] ;FN = [..N:I..N BUT PREVENTS QUIT IN BETWEEN. ;] + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QUNWN + CALL OPENB2 + JRST PSI + +CNTRLF: MOVN C,INSLEN ;^F -- SAME AS "FKDI". + CALL DELET0 + TRZ FF,FRARG ;MAKE SURE ^F DOESN'T INSERT ASCII(N). + JRST INSERT + +TAB: HRROI B,TAB0 ;HERE FOR TAB. DECIDE WHETHER IT'S + SKIPLE TABMOD + TYPRE [DCD] ;DISABLED, + SKIPE TABMOD + MOVEI B,SPACE ;IGNORED (LIKE SPACE, ACTUALLY), + JRST CD5B ;OR ENABLED (IN WHICH CASE COME BACK TO TAB0). + +TAB0: PUSHJ P,TYOMGS ;USED FOR ENTRY FROM SELF-INSERTING CHARACTERS + ANDCMI FF,FRCLN\FRUPRW\FRARG\FRARG2 +INSERT: TRNE FF,FRARG ;IF GIVEN AN ARG, + JRST INS1C ;THEN JUST INSERT THAT CHARACTER + MOVE OUT,[CALL RCH] ;SAY TO USE RCH TO GET CHARACTERS TO INSERT + MOVEM OUT,INSRCH + TRNN FF,FRCLN ;IF NOT GOING TO A Q REG + JRST INS1 ;THEN SKIP THIS STUFF + PUSHJ P,QREGVS ;OTHERWISE GET THE Q-REG NAME + JUMPE B,INS0 ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS PSI, THEN RETURNS TO INSERT'S CALLER. + JRST INS0 + +;PSI IS USED BY THINGS THAT WANT TO INSERT A STRING ARG INTO A SPECIFIC QREG. +;THE QREG ADDRESS SHOULD BE IN CH. +PSI: SETZ B, + TRO FF,FRCLN +INS0: SAVE CH ;REMEMBER WHICH QREG TO STORE IN. + SAVE B + CAIA +INS1: PUSHJ P,GAPSLP ;GET THE GAP AROUND THE HOME COUNTRY + MOVEI CH,ALTMOD ;GET THE TEMPORARY APROX- + ;IMATION TO THE DELIMITER + TRZE FF,FRUPRW ;IF IT ISN'T RIGHT (THE UPARROW + ;INDICATOR IS TURNED ON) + PUSHJ P,RCH ;THEN GET THE RIGHT ONE + MOVEM CH,INSDLM ;AND SAVE IT AS THE ONE TO USE + TRNN FF,FRCLN ;IF NOT INTO A Q-REG, THEN JUMP + JRST INS2 ;FORWARD +INSAS1: MOVE C,BFRBOT ;GET # CHARS UNUSED AFTER IMPURE STRING SPACE, + SUB C,QRWRT + SUBI C,4 ;WE'LL CERTAINLY NEED 4 FOR HEADER OF NEW STRING. + ;INS5 WILL PUT THAT IN TOTALC, # CHARS FREE TO USE. + MOVE BP,QRWRT ;START STRING AT START OF FREE SPACE, + ADDI BP,4 ;BEGIN THE TEXT AFTER WHERE HEADER'LL GO. + JRST INS5 + +INS2: MOVE BP,PT ;NEXT, GET THE POINTER ADDRESS + MOVE C,EXTRAC ;# CHARS FREE TO STORE IN IS GAP SIZE. +INS5: MOVEM C,TOTALC + CALL GETIBP ;GET BP FOR IDPB INTO GAP. + MOVEM P,INSINP .SEE INSCHK ;GO TO INSDUN ON CNM ERROR, TO CLEAN UP. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES INSIDE GETFRM INSIDE RCH. + +;HERE IS THE LOOP THAT GETS CHARACTERS AND PUTS THEM IN THE BUFFER +INSLUP: XCT INSRCH ;GET A CHARACTER (RCH AUTOMATICALLY + ;[ ;TAKES CARE OF ALL ^] CALLS AND MACRO + ;RETURNS) +INSDCK: SKIPE SQUOTP ;UNLESS WITHIN QUOTED MACRO, + JRST INSDIR + CAMN CH,INSDLM ;THEN SEE IF IT IS THE DELIMITER + JRST INSDUN ;IF SO, YOU'RE ALMOST DONE +INSDIR: SOSGE TOTALC + CALL INSSL1 + IDPB CH,BP + JRST INSLUP + +INSSL1: SETOM INSBP .SEE BFRRL3 ;FAKE OUT THE ERROR CHECK AT BFRRL3+EPSILON + CALL INSSLP + SETZM INSBP + RET + +INSSLP: MOVN C,TOTALC ;HOW MANY CHARS ALREADY KNOWN NEEDED.? + TRNE FF,FRCLN + JRST SLPQRG ;:I, MOVE UP BUFFER AT LEAST THAT MUCH. + ADD C,EXTRAC + JRST SLPSAV ;ELSE MAKE GAP > THAT MUCH BIGGER. + +INSDUN: SETOM INSBP + CALL GETCA + AOS OUT,BP ;CHAR ADDR 1ST PLACE NOT STORED IN. + TRNN FF,FRCLN ;IF YOU'RE NOT USING A Q-REG + JRST INS4 ;THEN EVERYTHING IS MUCH SIMPLER + SKIPGE TOTALC ;IF INSERTING 0 CHARS, MAKE SURE SPACE FOR HEADER. + CALL INSSL1 +INSDU1: MOVE C,BP ;GET END OF STRING, + MOVE BP,QRWRT ;AND PLACE START OF HEADER SHOULD BE. + SUB C,BP ;# CHARS WE USED (TEXT SIZE +4) + MOVEI B,QRSTR ;THIS IS THE CHAR TO START THE HEADER + CALL QHDRW0 ;WRITE A STRING HEADER AT <- CHAR ADDR IN BP. +INS3: REST B ;GET BACK INFO ON QREG. + REST CH ;GET BACK ADDR OF QREG TO STORE IN. + CALL QCLOSE ;STORE IN IT; OUT HAS CHAR ADDR END OF STRING. + ;QRWRT HAS CHAR ADDR OF BEINNING. UPDATES ALL PTRS. + JRST INSRT1 + +INS4: MOVEM BP,PT + MOVEM BP,GPT + MOVE CH,TOTALC ;# CHARS OF GAP WE DIDN'T USE. + EXCH CH,EXTRAC ;IS WHAT'S LEFT OF THE GAP. + SUB CH,EXTRAC ;AMOUNT WE DID USE + MOVEM CH,INSLEN ;IS # CHARS INSERTED. + ADDM CH,Z ;THAT MANY MORE CHARS NOW. + ADDM CH,ZV +INSRT1: SKIPN INSINP ;0 => WAS CLEARED BY INSCHK, WAS CNM ERROR. + TYPRE [CNM] + SETZM INSINP ;NO LONGER IN MIDDLE OF INSERT. + TRZ FF,FRCLN+FRUPRW ;IF THIS IS :I*, WE ARE RETURNING VALUE SO MUST CLEAR THESE + RET ;BY HAND. + +INS1C: ARGDFL + TRNN FF,FRARG2 ;,I - INSERT TIMES. + MOVEI E,1 + SKIPGE E +TYPAOR: TYPRE [AOR] + TRZE FF,FRCLN + JRST INS1CQ ;INTO QREG? + MOVE CH,NUM ;INTO BUFFER. + ANDCMI FF,FRCLN + PUSHJ P,GAPSLP + SKIPN C,E + RET + CALL SLPGET ;GET C(C) CHARS SPACE, AND B.P. IN BP. + IDPB CH,BP + SOJG C,.-1 + RET + +TYOMGS: CALL GAPSLP +TYOM: SAVE C + PUSH P,TT + PUSH P,TT1 + SAVE BP + MOVEI C,1 + CALL SLPGE1 + IDPB CH,BP + REST BP + POP P,TT1 + POP P,TT +POPCJ: REST C + RET + +;:I -- INSERT 1 CHAR IN QREG. +;,:I -- INSERT COPIES OF CHARACTER. +;:I* -- RETURNS A STRING CONTAINING THE CHARACTER . +INS1CQ: CALL QREGVS ;GET ADDR OF QREG IN CH. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + ;FLUSH ARG IN CASE :I* - OTHERWISE WOULD ADD ARG TO VALUE. + JUMPE B,INS1CR ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS INS1CR, THEN RETURNS TO INSERT'S CALLER. +INS1CR: SAVE B + MOVEI C,4(E) ;NEED 4 CHARS FOR HEADER, + CONTENTS. + CALL SLPQGT ;MOVE BUFFER UP IF NEC. + MOVEI B,QRSTR ;1ST CHARACTER, FOR HEADER. + MOVEI C,4(E) ;LENGTH, FOR HEADER. + CALL QHDRW1 ;WRITE THE STRING HEADER, LEAVE BP IN BP. + MOVE C,E + MOVE A,NUM + IDPB A,BP + SOJG C,.-1 + MOVEI OUT,4(E) ;GET ADDR 1ST CHAR THIS NEW STRING DOESN'T USE. + ADD OUT,QRWRT + REST B + JRST QCLOSE ;UPDATE QRWRT; STORE STRING IN QREG <- CH. + +SUBTTL GAP CONTROL + +IFNDEF SLPAMT,SLPAMT==SLPWRD*5 ;MAKE GAP IN UNITS OF THIS MANY CHARS. +IFNDEF SLPQAM,SLPQAM==SLPQWR*5 ;MOVE BUFFER UP IN UNITS OF THIS MANY. + +;MAKE SOME SPACE BY MOVING A SEGMENT OF MEMORY UPWARD. +;REAL CHARACTER ADDR. OF BOTTOM CHAR. OF SEGMENT TO MOVE IN BP +;REAL CHAR ADDR OF SEGMENT IN TT. +;MINIMUM AMOUNT OF SPACE (# OF CHRS) IN C. +;SPACE IS MADE ONLY IN MULTIPLES OF A WORD. +SLPN00: MOVE D,BFRTOP + SUB D,BEG ;GET NUMBER OF CHARS WE WILL HAVE TO MOVE. + CAIL D,2000*5*5 ;IF MORE THAN 5K WORDS, IT PAYS TO MAKE LOTS OF SPACE. + SKIPA D,[2000] ;SO MAKE IT A K AT A TIME, AND USE PAGE-MAPPING. + MOVEI D,100 ;ELSE JUST MAKE 100 WORDS AT A TIME. + MOVE E,@BFRPTR + TLNE E,MFQVEC ;IN A QVECTOR, MAKE ONLY 100 WORDS OF SPACE + MOVEI D,100 ;SINCE THEY NEVER GET VERY BIG. + MOVE E,D + IMULI D,5 + ADDI C,-1(D) ;ROUND C, THE NUMBER OF CHARS OF SPACE WE NEED, + IDIV C,D ;UP TO A MULTIPLE OF WHAT'S IN D, + IMUL C,E ;BUT CONVERT IT TO WORDS INSTEAD OF CHARACTERS. +;HERE TO MAKE SPACE FOR IMPURE STRING SPACE. +SLPN0Q: IDIVI BP,5 + ADDI TT,4 + IDIVI TT,5 + MOVE E,TT + ADD E,C ;ADDR OF LAST WD TO MOVE INTO, + 1. + SKIPE PSSAVP ;IF SORTING, + CAMGE E,PSMEM ;IF WE'D BE CLOBBERING SORT TABLES, MOVE THEM TOO. + JRST SLPN01 + MOVE TT,PSMEMT ;LAST WD TO MOVE UP IS LAST WD OF SORT TABLES, + ADDI TT,3 + ADDM C,PSMEM ;RELOCATE POINTERS TO SORT TABLES. + ADDM C,PSMEMT + MOVE E,TT + ADD E,C +SLPN01: ADDI E,2000 + LSH E,-10. + CAML E,LHIPAG ;DON'T IMPINGE ON PURE STRING SPACE! LEAVE 1K EMPTY IN BETWEEN. + TYPRE [URK] +IFN ITS,[ + TRNN C,1777 ;IF MAKING SPACE IN UNITS OF A K, DO IT BY PAGE MAPPING + JRST SLPN0P ;TO AVOID HAVING TO SWAP EVERYTHING IN. +SLPN0W: ] + SUBM TT,BP ;BP _ # WDS TO MOVE. + HRLI TT,-1 ;TT HAS -1,,LAST WD + 1. + SUB TT,[1,,1] ;MAKE -> LAST WD (1ST POP WILL MOVE IT) + MOVEI D,(C) + HRLI D,(POP TT,(TT)) + MOVE E,[SOJGE BP,D] + MOVE J,[JRST SLPN02] + JRST E +SLPN02: MOVE E,C ;GET BACK # WDS ADDED, + IMULI E,5 + ADDM E,TOTALC + POPJ P, + +IFN ITS,[ +SLPN0P: CAILE TT,2000(BP) ;MAKE SURE WE HAVE AT LEAST A K LEFT TO DO! + SKIPE PSSAVP ;USE PAGE-MAPPING ONLY IF NO SORT TABLE! WE'D CLOBBER IT! + JRST SLPN0W +SLPN03: MOVEI D,-1(TT) + LSH D,-10. ;COMPUTE # OF TOP PAGE TO MOVE, + MOVEI E,1777(TT) + ADD E,C ;AND # OF PAGE TO MOVE IT INTO, + 1. + LSH E,-10. + CAMLE E,MEMT ;SINCE WE ARE MOVING UP THE BOUNDARY OF BUFFER SPACE MEMORY, + MOVEM E,MEMT ;WE MUST REMEMBER THAT. + SUBI E,1 ;NOW CONVERT TO EXACT PAGE TO MOVE INTO. + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSELF ? D] + .LOSE %LSSYS + SUBI TT,1 + ANDI TT,-2000 ;SET TT TO TOP OF WHAT STILL NEEDS TO BE MOVED. + CAILE TT,2000(BP) ;KEEP MOVING PAGES UNTIL LESS THAN A PAGE REMAINS. + JRST SLPN03 +SLPN0R: CAMG E,D ;NOW, MAKE FRESH PAGES WHERE THE NEWLY CREATED GAP IS. + JRST SLPN0W + SOS E ;ENOUGH TO MAKE SURE WE DON'T HAVE ANYTHING IN THE MAP TWICE + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSNEW] + .LOSE %LSSYS ;IS EXACTLY THE RIGHT NUMBER. + JRST SLPN0R +] ;IFN ITS + +;MAKE SURE GAP AT LEAST SOME MINIMUM SIZE +;(# CHARS IN C) +SLPSAV: CAMG C,EXTRAC + RET + CALL SAVACS + SUB C,EXTRAC ;HOW MANY MORE CHARS NEEDED? + MOVE BP,GPT ;GET ACTUAL ADDR OF END OF GAP. + ADD BP,EXTRAC + MOVE TT,BFRTOP ;GET ACTUAL ADDR OF END OF BUFFER. + SAVE Z + SAVE MEMT + PUSHJ P,SLPN00 + MOVEI D,@D ;GET ADDR LAST WD OF NEWLY MADE GAP. + REST BP ;DON'T NEED TO CLEAR NEWLY OBTAINED CORE. + SKIPE YANKMT + MOVE BP,YANKMT + LSH BP,10. + CAML D,BP + SOS D,BP + MOVEI BP,1 ;PREPARE TO CLEAR LOW BITS OF WDS THAT NEED IT. + REST A ;ANY WD PREVIOUSLY PART OF THIS BUFFER DOESN'T NEED IT. + IDIVI A,5 +SLPSA2: CAMGE D,A + JRST SLPSA1 + ANDCAM BP,(D) + SOJA D,SLPSA2 + +SLPSA1: ADDM E,EXTRAC + MOVE T,E + MOVE TT,Z + CALL BFRRLC + JRST RSTACS + +;LIKE SLPGET, BUT FOR COMMANDS THAT EITHER INSERT IN THE BUFFER +;OR CONS UP AND RETURN A STRING. SUCH COMMANDS SHOULD ALSO EXIT THRU SLPXIT. +SLP: TRNE FF,FRCLN + JRST QOPEN + +;INSERT C(C) CHARS AT PT, MAKING SPACE IF NEC. +;PUTS PT AFTER THEM. BRINGS THE GAP TO PT. +;DON'T ACTUALLY PUT ANYTHING IN THOSE CHARS, +;RATHER RETURN IN BP A BP. TO IDPB INTO THEM. +;CLOBBERS TT, TT1. PRESERVES C! +SLPGET: CALL GAPSLP +SLPGE1: CAMLE C,EXTRAC ;HAVE ENOUGH ROOM FOR THE CHARS? + CALL SLPSAV ;NO, STRETCH GAP. + MOVE BP,PT + ADDM C,PT ;UPDATE VARS FOR INSERTION OF THOSE CHARS. + ADDM C,GPT + MOVNS C ;DELETE - CHARS TO UPDATE Z, ZV, EXTRAC. + CALL DELETB ;DELETB NEGATES C. + SOJA BP,GETBP ;MAKE REMEMBERED PT (IN BP) INTO BP. + +;MAKE SURE UNUSED SPACE AFTER IMPURE STRING SPACE AT LEAST C(C) CHARS. +;MAY MOVE BUFFER, IN WHICH CASE ALL BUFFER POINTERS WILL +;BE UPDATED AS NECESSARY. +SLPQGT: ADD C,QRWRT ;CHAR ADDR LAST CHAR WE'LL NEED. + SUB C,BFRBOT ;THAT CHAR IN BUFFER? + JUMPL C,CPOPJ ;NO, HVE ENOUGH ROOM. + +;GET AT LEAST C(C) MORE UNUSED SPACE FOR IMPURE STRINGS. +;WILL MOVE BUFFER AND UPDATE ALL BUFFER POINTERS. +SLPQRG: CALL SAVACS + MOVE BP,BFRBOT ;MOVE ENTIRE BUFFER. + MOVE TT,BFRTOP ;GET REAL ADDR. END OF BUFFER. + ADDI C,SLPQAM-1 + IDIVI C,SLPQAM ;# OF UNIT INCREMENTS WE NEED. + IMULI C,SLPQWR ;# OF WDS TO MOVE THE BUFFER. + CALL SLPN0Q ;MOVE IT. + MOVE BP,BFRBOT + IDIVI BP,5 +SLPQR1: SETZM (BP) ;CLEAR ALL WORDS OF SPACE JUST MADE. + AOJ BP, ;NOTE THAT BFRBOT HAS NOT BEEN RELOCATED YET, SO IT POINTS AT + SOJG C,SLPQR1 ;THE BOTTOM OF THE SPACE JUST MADE. + MOVE T,E + CALL BFRMOV ;RELOCATE ALL PTRS TO BUFFER. + JRST RSTACS + +;WRITE A STRING HEADER. B HAS INITIAL CHARACTER (QRSTR OR QRBFR), +;C HAS CONTENTS (LENGTH OR BUFFER FRAME ADDRESS). +;BP IS LEFT WITH A B.P. TO LAST CHAR. OF HEADER. +;CLOBBERS C,T,TT. +QHDRW1: MOVE BP,QRWRT ;WRITE HEADER IN FIRST FREE SPOT. +QHDRW0: CALL GETBP ;ASSUME BP HAS CHAR ADDR OF PLACE TO WRITE. + DPB B,BP + IDPB C,BP + LSH C,-7 + IDPB C,BP + LSH C,-7 + IDPB C,BP + RET + +QCLOSV: CALL GETCA ;WHERE DID WE STOP IDPB'ING? + AOS BP + MOVE C,BP + MOVE BP,QRWRT ;BP GETS PLACE TO WRITE HEADER. + MOVE OUT,C ;OUT GETS NEW VALUE FOR QRWRT. + SUB C,BP ;C GETS LENGTH OF WHAT WE JUST WROTE (INCL HEADER) + MOVEI B,QRSTR + CALL QHDRW0 ;WRITE THE HEADER + MOVEI CH,A ;TELL QCLOSE TO STORE INTO A, + SETZ B, ;WHICH IS NOT A NAMED VARIABLE. + JRST QCLOSE + +;MAKE SURE THERE IS SPACE IN IMPURE STRING SPACE FOR C(C) CHARS, +;THEN SET UP LISTF5 TO IDPB THRU BP INTO IMPURE STRING SPACE. +QOPEN: SAVE C + ADDI C,4 ;HEADER OF STRING NEDS SPACE TOO. + CALL SLPQGT ;MAKE SURE EXISTS ENOUGH SPACE. + REST C + MOVE BP,QRWRT ;START WRITING INTO UNUSED IMPURE STRING SPACE + ADDI BP,4 ;SKIPPING ROOM FOR THE NEW STRING'S HEADER-TO-BE. + CALL GETIBP + MOVEI A,[IDPB CH,BP ? RET] + HRRM A,LISTF5 + POPJ P, + +;ASSUME A STRING HAS BEEN STORED IN THE AREA ABOVE QRWRT, +;UPDATE QRWRT AND STORE STRING PTR IN QREG. +QCLOSQ: TDZA B,B ;QREG ADDR IN CH, AND CERTAINLY NOT A NAMED VARIABLE. +QCLOSP: REST CH ;QREG ADDR IS ON STACK. B IS AS RETURNED BY QREGX. +QCLOSE: EXCH OUT,QRWRT ;QREG ADDR IN CH. B IS AS RETURNED BY QREGX. + SUB OUT,QRBUF + TLO OUT,400000 + MOVE C,OUT + JRST USE2 ;STORE VALUE IN QREG, WITH ERROR CHECKING ETC. + +;CLOSE UP THE GAP, AND SAY IT IS AT PT. +SLPSHT: SKIPN EXTRAC ;NOTHING TO DO IF NO GAP. + JRST GAPSLN + SAVE Q +SLPSH1: MOVE Q,Z + CAMN Q,GPT + JRST SLPSH2 + EXCH Q,PT + SAVE Q + CALL GAPSLP ;THEN MOVE THE GAP TO PT. + REST PT +SLPSH2: REST Q + CALL GAPKIL ;NOW GAP IS AT END, JUST FORGET ABOUT IT. +GAPSLN: SAVE PT ;GAP LENGTH IS 0, MAKES NO DIFFERENCE WHERE + REST GPT ;WE SAY THE GAP IS LOCATED. + RET + +;ASSUMING THAT THE GAP IS AT THE END OF THE CURRENT BUFFER, +;CLOSE IT UP. CLOBBERS NO ACS. RELOCATES ALL NECESSARY POINTERS +;IN BUFFER FRAMES (AND BFRTOP). +GAPKIL: SAVE A + SAVE C + SAVE B + MOVE A,Z + ADD A,EXTRAC + IDIVI A,5 ;WHAT WORD DOES THE THING AFTER THE BUFFER + MOVE C,A ;ACTUALLY START IN? + IMULI A,5 + ADDI A,5 + CAML A,BFRTOP ;IF THERE'S NOTHING AFTER THE BUFFER, JUST CHANGE A FEW POINTERS + JRST [ MOVE A,Z ;IN PARTICULAR BFRTOP POINTED AFTER GAP, + IDIVI A,5 + IMULI A,5 ;MAKE IT -> CHAR ADDR OF WORD BNDRY + ADDI A,5 ;AFTER THE END OF THE BUFFER. + MOVEM A,BFRTOP + JRST GAPKI1] + SAVE C ;THERE'S ANOTHER BUFFER AFTER THIS ONE. + MOVE A,Z + IDIVI A,5 ;WHAT WORD SHOULD IT START IN (ACTUALLY 1 LESS THAN) + HRL A,(P) ;AND -1+ + HRRZ C,A + SUB C,(P) ;C HAS - + ADD A,[1,,1] ;,, + MOVEM A,(P) + SAVE C + MOVE A,BFRTOP + IDIVI A,5 ;WORD FOR BLT TO STOP MOVING OUT OF (PLUS 1) + REST C + ADDI A,-1(C) + EXCH C,(P) + BLT C,(A) + EXCH T,(P) ;GET # WORDS THINGS MOVED BY. + IMULI T,5 + SAVE TT + MOVE TT,Z + ADD TT,EXTRAC + CALL BFRRLC ;RELOCATE PTRS TO BUFFERS WE MOVED. + REST TT + REST T +GAPKI1: SETZM EXTRAC +POPBCA: REST B +POPCAJ: REST C + REST A + RET + +;MOVE THE GAP TO PT. +GAPSLP: SKIPE READON ;ALLOWED TO MODIFY? + TYPRE [RDO] + SETOM MODIFF ;IF WE CARE WHERE GAP IS, WE MUST BE ABOUT TO MUNG THE BUFFER. +GAPSL0: SKIPN EXTRAC ;NO GAP REALLY => + JRST GAPSLN ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER. + SAVE Q + MOVE Q,PT + CAMN Q,GPT ;GAP ALREADY AT PT => NOTHING TO DO. + JRST POPQJ + CAMG Q,GPT ;MOVING GAP DOWN => DIFFERENT. + JRST GAPDN + REST Q + CALL SAVACS +GAPUP3: MOVE BP,GPT ;MOVE 1ST FEW CHARS 1 AT A TIME. + CAMN BP,PT ;(WHEN GET HERE 2ND TIME, + JRST RSTACS ;MIGHT BE NOTHING TO MOVE) + ADD BP,EXTRAC ;GET FETCHING PTR -> ABOVE GAP. + CALL GETIBP + MOVE TT,GPT + IDIVI TT,5 ;GET STORING PTR -> BELOW GAP. + MOVE A,PT + SUB A,GPT ;GET TOTAL # CHARS TO BE MOVED. + JUMPE TT1,[SOJA TT,GAPUP2] +GAPUP0: SUBI TT1,5 ;(WILL INCREM. TO 0 WHEN REACH WD BNDRY) +GAPUP1: ILDB IN,BP ;GET A CHAR FROM ABOVE GAP, + DPB IN,BTAB+5(TT1) ;PUT IT BELOW GAP, + AOS GPT ;SAY GAP HAS MOVED UP 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + AOJN TT1,GAPUP1 ;EFFECTIVELY IBP THE STORING PTR. +GAPUP2: CAIGE A,5 ;BOTTOM OF GAP NOW ON WD BNDRY, + AOJA TT,GAPUP0 ;< 1 WDS LEFT => KEEP GOING CHAR BY CHAR. + MOVEI C,1(TT) ;GET ADDR 1ST WD TO MOVE DOWN INTO. + MOVE 10,PT + ADD 10,EXTRAC ;REAL ADDR 1ST CHAR NOT TO MOVE DOWN. + SUBI 10,5 ;DON'T MOVE THE LAST 5 CHARS WITH FAST LOOP (CAN GARBAGE). + IDIVI 10,5 ;10 -> HIGHEST WD TO MOVE DOWN FROM. NOTE 10 = T. + MOVN 12,EXTRAC + IDIVI 12,5 ;12 GETS <# WDS OF GAP, ROUNDED UP>. 13 <- # CHARS ROUNDED BY. + JUMPE 13,[ ;HERE IF CAN USE BLT (ALL ON WORD BNDRYS). + ADD 10,12 ;10 GETS ADDR OF LAST WD TO MOVE DOWN TO. + SUBM C,12 ;12 GETS 1ST ADDR TO MOVE FROM. + MOVEI 11,1(10) + SUB 11,C ;11 GETS # OF WORDS TO MOVE. + IMULI 11,5 + ADDM 11,GPT ;UPDATE GPT FOR WHAT WE'RE DOING HERE. + HRLI C,(12) + BLT C,(10) + JRST GAPUP3] + ADDI 12,-1(10) ;12 -> HIGHEST WD TO MOVE DOWN INTO. + MOVNM 13,11 + IMULI 11,7 + MOVNI 14,-43(11) + SUBI C,1(12) ;C HAS MINUS # WDS TO MOVE + JUMPE C,[AOS TT,12 ;WOULD MOVE 0 WORDS (CAN HAPPEN) => DO REST BY CHARS. + SETZ TT1, + JRST GAPUP0] + MOVN 15,C ;UPDATE GPT FOR THE WDS WE'RE MOVING. + IMULI 15,5 + ADDM 15,GPT + MOVE 13,12 + HRLI 10,(MOVE B,(C)) + HRLI 11,(LSHC A,) + MOVE 12,[LSH A,1] + HRLI 13,(MOVEM A,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPUP3] + MOVE A,@10 + ROT A,-1 + MOVE 15,.+1 + AOJLE C,10 + +;MOVE THE GAP DOWN (IE MOVE CHARS FROM PT TO GPT UP) +GAPDN: MOVE Q,PT + ADD Q,PT + ADD Q,PT + ADD Q,Z ;COMPUTE WEIGHTED AVERAGE OF PT AND Z, THEN COMPARE WITH GPT + LSH Q,-2 + CAMG Q,GPT ;IS GPT CLOSER TO PT, OR TO Z? + CALL [ SAVE PT ;GPT IS MUCH CLOSER TO Z THAN TO POINT. SO FASTEST THING + MOVE Q,Z ;IS TO MOVE GAP TO Z, ADJUST WITH GAPADJ, AND + MOVEM Q,PT ;MOVE IT DOWN AGAIN USING A POP-LOOP. + CALL GAPSLP + REST PT + RET] + REST Q ;GPT CLOSER TO PT; FASTER TO MOVE GAP DIRECTLY TO POINT. + CALL SAVACS + MOVE BP,GPT + CAMN BP,Z ;IF GAP IS AT END OF BUFFER, WE CAN ADJUST ITS SIZE A LITTLE + CALL GAPADJ ;AND THEREBY ENABLE WHAT FOLLOWS TO USE A BLT. +GAPDN3: MOVE BP,GPT ;MOVE THE 1ST FEW CHARS UP, + CAMN BP,PT ;(FOR GETTING HERE 2ND TIME WITH + JRST RSTACS ;TO BE MOVED) + CALL GETBP ;GET PTR FOR FETCHING CHARS BELOW GAP, + MOVE TT,GPT + ADD TT,EXTRAC ;GET PTR FOR STORING ABOVE GAP. + IDIVI TT,5 + MOVE A,GPT ;GET TOTAL # CHARS MUST MOVE UP. + SUB A,PT + SOJL TT1,GAPDN2 ;ALREADY MOVING TO WD BNDRY. +GAPDN1: DBP7 BP ;GET PTR -> LAST CHAR BELOW GAP. + LDB CH,BP + DPB CH,BTAB(TT1) ;MOVE IT BELOW TOP OF GAP. + SOS GPT ;GAP HAS MOVED DOWN 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + SOJGE TT1,GAPDN1 ;EFFECTIVELY DBP7 THE OUTPUT BP. +GAPDN2: CAIGE A,5 ;TOP OF GAP NOW ON WD BNDRY +GAPDN5: SOJA TT,[ADDI TT1,5 ;< 1 WD LEFT, KEEP + JRST GAPDN1] ;CHAR AT A TIME. + MOVE 13,EXTRAC ;MOVE AS MUCH AS CAN, WD AT A TIME. + IDIVI 13,5 + IMULI 14,7 + MOVN 11,14 + MOVEI 14,-43(14) + MOVE B,PT + ADDI B,4 + IDIVI B,5 + MOVE 15,GPT + IDIVI 15,5 + MOVEI C,(15) + SUB C,B + JUMPE C,[MOVE TT,GPT ;IF CAN'T MOVE ANYTHING WORD-WISE AFTER ALL, + ADD TT,EXTRAC ;REENTER CHAR-AT-A-TIME LOOP + IDIVI TT,5 + SOJA TT1,GAPDN5] + MOVE 7,B + MOVN 15,C ;MAKE GPT REFLECT THE MOTION OF GAP + IMULI 15,5 ;THAT IS NOW ABOUT TO BE DONE. + ADDM 15,GPT + JUMPE 11,GAPDN4 ;(TRANSLATING BY INTEGRAL # OF WDS.) + ADDI 13,1(7) + HRLI 7,(MOVE A,(C)) + HRLOI 10,(LSH A,) + HRLI 11,(LSHC A,) + MOVE 12,[ANDCMI B,1] + HRLI 13,(MOVEM B,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPDN3] + MOVE B,@7 + MOVE 15,.+1 + SOJGE C,7 + +GAPDN4: HRLI 13,(POP 7,(7)) ;EXTRAC = 0 MOD 5, NEED NOT ROTATE + ADDI 7,-1(C) ;-> HIGHEST WD TO MOVE FROM + HRLI 7,-1 ;PREVENT PDL OV. + MOVE 15,[JRST GAPDN3] ;INSN THAT EXITS LOOP. + MOVE 14,.+1 + SOJGE C,13 ;C HAS # WDS TO MOVE. + +;WHEN THE GAP IS AT Z, WE CAN ADJUST ITS SIZE WITHIN A RANGE OF 5 WITHOUT MOVING ANYTHING. +;IF WE WANT TO MOVE THE GAP DOWN, ADJUSTING ITS SIZE TO A MULTIPLE OF 5 +;WILL ENABLE US TO USE A POP-LOOP INSTEAD OF A SLOWER LOOP. + +GAPADJ: MOVE A,Z + IDIVI A,5 ;IF EXTRAC IS A MULTPLE OF 5, REAL Z (Z+EXTRAC) MOD 5 IS THIS REMAINDER + MOVE IN,Z + ADD IN,EXTRAC ;SO GET REAL Z + IDIVI IN,5 + IMULI IN,5 ;AND ADJUST IT TO EQUAL THAT, MOD 5, + ADD IN,B ;WITHOUT CHANGING WHICH WORD IT POINTS AT. + SUB IN,Z ;BUT Z CAN'T CHANGE, SO THE CHANGE IN REAL Z + MOVEM IN,EXTRAC ;MUST ALL BE DUE TO CHANGE IN EXTRAC. + RET + +SUBTTL STRING SPACE GARBAGE COLLECTION + +GCNRL: SETOM GCNRLC ;GC TO RECLAIM MACRO FRAMES. DON'T MOVE IMPURE STRINGS. + CAIA ;(THEREFORE, CAN BE CALLED IN MID-COMMAND) +GC: +GCC: SETZM GCNRLC + CALL SAVACS +IFN ITS,[ + MOVE A,[-2,,[.SWHO1,,[.BYTE 2,3,3 ? 1 ? 6 ? 6] + .SWHO2,,[SIXBIT/QR GC/]]] + .SUSET A +] + CALL MEMTOP ;A -> 1ST UNUSED WORD ABOVE BFR & SORT TABLES. + HRLI A,4400 + MOVEM A,GCPTR ;GCPTR HAS B.P. TO IDPB INTO HIGH CORE. + PUSH P,A ;REMEMBER WHAT ITS STARTING VALUE WAS. + MOVE C,BFRPTR ;COPY BEG, ETC. INTO CURRENT BUFFER'S + CALL NEWBFR ;FRAME, SO THE LATTER IS UP TO DATE. + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 ;CLEAR THE JUMP CACHE, SINCE IT WILL NOW BECOME INVALID. + MOVEI T,CSTR ;MARK CSTR + PUSHJ P,GCMA +GCC1: MOVEI T,MFSTRT+MFCSTR ;MARK ALL MACRO FRAMES' STRINGS. +GCC2: SKIPGE MFBEG-MFCSTR(T) ;DON'T MARK BUFFER FRAMES THIS WAY. + JRST GCC4 + ADDI T,MFARG1-MFCSTR + CALL GCM ;MARK MACRO ARG 1 (MAY BE A STRING POINTER) + ADDI T,MFARG2-MFARG1 + CALL GCM ;MARK MACRO ARG 2 + SUBI T,MFARG2-MFCSTR ;POINT TO CSTR AGAIN + SKIPE (T) + PUSHJ P,GCMA +GCC4: ADDI T,MFBLEN + CAMGE T,MFEND + JRST GCC2 +GCC3: HRRZ T,PF ;MARK THE QREG PDL. + CAIL T,PFL ;MARK BOTH VALUES AND ADDRS, SINCE "ADDR" MIGHT BE A NAME-STRING. +GCC5: CALL GCM + CAILE T,PFL + SOJA T,GCC5 + HRRZ T,LEV ;NOW MARK ALL SAVED VALUES +GCC7: SKIPN A,T ;OF ALL PAREN'S. + JRST GCC8 ;WE'VE REACHED THE OUTERMOST; WE'RE DONE. + SUBI T,2 ;GET ADDR OF LAST SAVED VALUE. + CALL GCM + SUBI T,1 ;GET ADDR OF 1ST (IF THERE ARE 2) + MOVE TT,2(T) ;GET THE WORD WHICH SAYS HOW MANY. + TRNE TT,FRARG2 ;IF THERE ARE 2, MARK THE 1ST. + CALL GCM + MOVE T,(A) ;NOW HANDLE NEXT PAREN OUT. + JRST GCC7 + +GCC8: MOVE T,[-NQREG,,QTAB] + CALL GCM + AOBJN T,.-1 + MOVE T,[-RRMACL,,RRMACT] + CALL GCM + AOBJN T,.-1 +IRPS XX,,DISOMD SBFRS BFRSTR MARG1 MARG2 SARG NUM SYL RRXINV RRENTM RRLEVM RRDISM REFRSH LASTER STEPFL HELPMAC ECHCHR CLKMAC TYISNK TYISRC RREBUF MODMAC + MOVEI T,XX + CALL GCM +TERMIN + POP P,A + MOVE T,A ;STARTING GCPTR MINUS CURRENT + SUB T,GCPTR ;GIVES -<# WDS IDPB'D> + HRLM T,A ;AOBJN -> TABLE OF POINTERS. + ADDI A,1 + MOVEM A,GCPTR + JUMPGE A,GCE ;NO ENTRIES => NO IMPURE STRINGS TO GC. + SKIPE GCNRLC ;IF SHOULDN'T MOVE IMPURE STRINGS, SKIP THAT PART. + JRST GCE5 + CALL GCSORT ;ELSE SORT GCTAB INTO ORDER STRINGS APPEAR IN MEMORY. + CALL GCSWP ;COMPRESS STRING SPACE, USING GCPTR TABLE TO RELOCATE POINTERS. + MOVE IN,OUT + IMULI IN,5 ;COMPUTE WHERE IMPURE STRING SPACE NOW ENDS. + JRST GCE1 ;GO FLUSH EXCESS PAGES, MAYBE MOVING BUFFER SPACE DOWNWARD. + +;MARK THE TECO OBJECT POINTER IN THE WORD WHICH RH(T) POINTS AT. +;IF THE OBJECT IS A POINTER, WE PUSH AN ENTRY ONTO GCPTR. +GCM: MOVE IN,(T) + TLZE IN,400000 ;RETURN IF NOT A STRING POINTER OR IF POINTS AT THE ERROR MESSAGES. + CAIGE IN,EREND*5-INIQRB + RET ;NO NEED TO MARK BUILT-IN ERROR MESSAGES SINCE NOT SWEPT. + ADD IN,QRBUF +GCM3: CAML IN,QRBUF + CAML IN,QRWRT ;FINISH CHECKING THAT IT REALLY POINTS INTO IMPURE STRING SPACE. + RET + CALL GETCHR ;DOES IT POINT AT A 177 OR 176? + CAIN CH,QRBFR + JRST GCMB ;176 => THIS IS A BUFFER. + CAIE CH,QRSTR ;177 => THIS IS A STRING. + RET ;ANYTHING ELSE => THIS IS NEITHER. DON'T MARK IT. + +;PUSH A GCPTR ENTRY FOR POINTER LOCATION RH(T) AND STRING ADDRESS C(IN). +GCM2: IDPB IN,GCPTR + IDPB T,GCPTR + POPJ P, + +;FOUND A POINTER TO A BUFFER. +GCMB: MOVE BP,IN + CALL GCM2 ;MARK THE 4-CHAR STRING THAT WE GO INDIRECT THROUGH, + CALL GETBP ;GO INDIRECT THROUGH IT TO GET FRAME ADDRESS + CALL QLGET4 ;RETURNS -4 + JUMPL B,CPOPJ ;DEAD BUFFER HAS NO BUFFER FRAME. + MOVSI IN,MFMARK ;AND MARK THE BUFFER FRAME AS LIVING. + IOR IN,4(B) + EXCH IN,4(B) + TLNN IN,MFMARK ;IF THE FRAME WASN'T ALREADY MARKED, + TLNN IN,MFQVEC ;AND MUST BE MARKED THROUGH, DO SO. + RET + SAVE T + MOVE T,MFBEG+4(B) + TLZ T,MFBBTS + IDIVI T,5 ;FIRST, MARK BELOW THE GAP. + MOVE TT,MFGPT+4(B) + CALL GCMBR + MOVE T,MFGPT+4(B) + ADD T,MFEXTR+4(B) + IDIVI T,5 ;THEN MARK ABOVE GAP (GPT+EXTRAC TO Z+EXTRAC) + MOVE TT,MFZ+4(B) + ADD TT,MFEXTR+4(B) + CALL GCMBR +POPTJ: REST T + RET + +;MARK INDIRECT THROUGH A RANGE OF WORDS (IN A QVECTOR). +GCMBR: SAVE B ;T HAS WORD ADDR, TT CHAR ADDR. + IDIVI TT,5 ;MARK ALL TEH WORDS FROM T TO TT. + SUBM T,TT + HRL T,TT + SKIPGE T + CALL GCM + AOBJN T,.-1 + REST B + RET + +;HERE TO MARK A BYTE POINTER, SUCH AS CPTR. T POINTS AT THE CSTR WORD OF A +;COMCNT, CPTR, CSTR TRIPLE. IF THE POINTER POINTS INTO IMPURE STRING SPACE, +;WE PUSH A GCPTR ENTRY POINTING AT THE CPTR WORD BUT GIVING THE CHAR ADDR EQUIVALENT +;AS ITS STRING ADDRESS. +GCMA: SAVE GCPTR + CALL GCM ;MARK THE CSTR WORD, AS AN ORDINARY TECO OBJECT. + REST TT + CAMN TT,GCPTR ;IF IT DOESN'T NEED RELOCATION, NEITHER DOES CPTR. + RET + MOVE IN,1(TT) ;IF CSTR NEEDS IT, SO DOES CPTR; PUSH A MARKER FOR CPTR + IDPB IN,GCPTR ;GIVING THE SAME "CHAR ADDR TO RELOCATE ACCORDING TO" + MOVEI IN,CPTR-CSTR(T) + IDPB IN,GCPTR ;WHICH THE CSTR USED, BUT POINTING AT THE CPTR INSTEAD OF THE CSTR. + RET + +;SORT THE POINTER TABLE TO FACILITATE SWEEPING. +;THE POINTERS GO IN THE SAME ORDER AS THE STRINGS THEY POINT AT. +GCSORT: HRRZ A,GCPTR + HLRE B,GCPTR + SUBM A,B + MOVSI C,10 + +;RECURSIVE RADIX-EXCHANGE SORT. +;A POINTS TO FIRST ENTRY IN THIS SUB-SORT. +;B POINTS TO LAST ENTRY + 1 +;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON FOR THIS SUB-SORT. +GCSWPS==2 ;2 WORDS PER TABLE ENTRY. + +GCSRT: HRLM B,(P) ;SAVE UPPER BOUND + CAIL A,-GCSWPS(B) + JRST GCSRT7 ;ONE OR ZERO ENTRIES + PUSH P,A ;SAVE LOWER BOUND +GCSRT3: TDNN C,(A) ;BIT SET IN LOWER ENTRY? + JRST GCSRT4 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN + SUBI B,GCSWPS ;YES, NOW BACK UP UPPER POINT + TDNE C,(B) ;BIT CLEAR IN UPPER ENTRY? + JRST GCSRT5 ;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN +REPEAT GCSWPS,[ ;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES + MOVE D,.RPCNT(A) + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A) +] +GCSRT4: ADDI A,GCSWPS ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY +GCSRT5: CAME A,B ;ANY MORE ENTRIES LEFT? + JRST GCSRT3 ;YES, GO PROCESS THEM + ;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET + ROT C,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT + POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT + JUMPL C,GCSRT6 ;JUMP IF NO MORE KEY TO SORT ON + PUSHJ P,GCSRT ;SORT BOTTOM PART OF TABLE + HLRZ B,(P) ;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE) + PUSHJ P,GCSRT ;SORT TOP PART OF TABLE +GCSRT6: ROT C,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C" +GCSRT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED + RET + +;SWEEP THE IMPURE STRING SPACE, DISCARDING GARBAGE BY MOVING THE GOOD STUFF DOWN. +GCSWP: MOVE IN,QRBUF + ADDI IN,EREND*5-INIQRB + IDIVI IN,5 ;IN GETS PLACE WE EXPECT NEXT OLD STRING (GARBAGE OR NOT) TO START. + MOVE OUT,IN ;OUT GETS PLACE TO PUT NEXT NON-GARBAGE STRING. + MOVE Q,GCPTR ;Q IS USED TO STEP THROUGH THE POINTER TABLE. + SETZ BP, ;THERE IS NO PENDING BLT, YET. +;WHEN BP IS NONZERO, IT IS THE AC FOR A PENDING BLT. WHEN WE SEE A NON-GARBAGE STRING, +;WE KNOW IT NEEDS TO BE BLT'ED (USUALLY), BUT WE DON'T DO THE BLT UNTIL WE COME +;TO SOME ACTUAL GARBAGE. THAT WAY WE BLT CONTIGUOUS NON-GARBAGE STRINGS TOGETHER. +;INSTEAD OF BLT'ING, WE SET UP BP AS THE BLT AC (OLD START,,NEW START) AS A REMINDER. + +;COME HERE TO EXAMINE THE NEXT POINTER AND SEE WHETHER WE HAVE FOUND A GAP OF GARBAGE. +GCSWPL: JUMPGE Q,GCBLT ;NO MORE POINTERS => FINISHED SWEEPING. DO ANY PENDING BLT. + MOVE A,(Q) ;WHERE DOES THE NEXT NON-GARBAGE STRING START? + IDIVI A,5 + JUMPE BP,GCSWP2 + CAMG A,IN ;STARTS IN THE EXPECTED PLACE => IT IS CONTIGUOUS WITH + JRST GCSWP1 ;PREVIOUS NON-GARBAGE, SO DON'T BLT NOW. + CALL GCBLT ;NOT CONTIGUOUS => BETTER BLT THE OLD STUFF. +;HERE FOR THE BEGINNING OF A CONTIGUOUS RUN OF NON-GARBAGE; SET BP NONZERO +GCSWP2: MOVE IN,A + HRRZ BP,OUT ;AND MAKE BP DESCRIBE HOW THIS STUFF WILL HAVE TO BE BLT'ED. + HRL BP,A +GCSWP1: SAVE BP ;NOW FIND OUT WHERE THIS STRING ENDS. + SETZ B, ;B GETS (EVENTUALLY) LENGTH OF STRING-OBJECT + MOVE BP,(Q) + CALL GETBP ;WHICH IS IT? A BUFFER OR A STRING? + LDB CH,BP + CAIN CH,QRBFR ;IF IT'S A BUFFER, THERE'S REALLY JUST A 4-CHAR HEADER HERE. + JRST GCSWP3 + CAIE CH,QRSTR ;IF IT'S A STRING, THERE'S THE HEADER PLUS DATA. + .VALUE + CALL QLGET4 ;HOW MUCH DATA? +GCSWP3: ADDI B,3 ;B GETS LENGTH OF HEADER + (DATA IF ANY) - 1. + MOVE BP,(Q) + ADDB BP,B ;BOTH B AND BP HAVE CHAR ADDR OF LAST CHAR. + CALL GETBP ;BP GETS BP TO LDB LAST CHAR. + MOVEI A,1(BP) ;A GETS ADDR OF WORD AFTER THE END OF THIS STRING. + REST BP + SUB A,IN ;NOW INCREASE IN TO EQUAL THAT, AND INCREASE OUT THE SAME AMOUNT. + ADD IN,A ;NEW VALUE OF IN IS WHERE THE NEXT STRING SHOULD START IF IT IS CONTIG. + ADD OUT,A ;ACTUALLY, IT CAN START IN THE PREVIOUS WORD IF IT IS REALLY CONTIG. + ;THE CAMG ABOVE WILL NOT SKIP IN EITHER CASE. +;NOW RELOCATE ALL THE POINTERS INTO THIS STRING. +;B IS CHAR ADDR REL QRBUF OF LAST CHAR OF STRING. +;ALL POINTERS LESS THAN OR EQUAL TO THAT POINT INTO THIS STRING. + MOVE C,OUT + SUB C,IN ;C GETS # OF WORDS (NEGATIVE ALWAYS) THIS STRING IS MOVING BY. + MOVE D,C + IMULI D,5 ;D GETS # OF CHARACTERS. +GCSWPR: CAMGE B,(Q) ;AFTER THE LAST POINTER INTO THIS STRING, + JRST GCSWPL ;GO EXAMINE THE NEXT AND MAYBE BLT THIS ONE, ETC. + MOVE A,1(Q) + SKIPL (A) ;ELSE RELOCATE. RELOCATE POSITIVE QTYS (B.P.S) BY WORDS, + ADDM C,(A) + SKIPGE (A) ;RELOCATE NEGATIVE ONES (TECO OBJECTS) BY CHARS. + ADDM D,(A) + AOBJN Q,.+1 + AOBJN Q,GCSWPR ;LOOK AT ALL PTRS. IF RUN OUT, DO ANY PENDING BLT AND WE'RE DONE. + +;DO THE PENDING BLT DESCRIBED BY BP. OUT, THE PLACE TO START THE NEXT GOOD STRING, +;TELLS US WHERE THE BLT SHOULD STOP. +GCBLT: JUMPE BP,CPOPJ + CAIN OUT,(BP) + .VALUE + MOVS C,BP + CAME C,BP ;DON'T DO THE BLT IF IT IS SHIFTING BY 0 WORDS. + BLT BP,-1(OUT) + SETZ BP, + RET + +GCE5: SKIPA IN,QRWRT +GCE: MOVE IN,QRBUF +GCE1: MOVE CH,IN ;GC AGAIN AFTER GCOFTN CHARS + ADDI CH,GCOFTN ;OF IMPURE STRING ARE CREATED. + SKIPL GCNRLC + MOVEM CH,QRGCMX + MOVE A,QRWRT ;REMEMBER OLD TOP OF IMPURE STRING SPACE FOR SAKE OF LOW BIT CLEARING. + CAMGE A,IN ;GC PRODUCED NEGATIVE FREE SPACE? + .VALUE + MOVEM IN,QRWRT ;CHAR ADDR ABOVE END OF STRING SPACE. + ADDI IN,SLPQAM*2 ;LEAVE 2*SLPQAM CHARS SPACE TO WRITE MORE STRINGS INTO, + MOVE CH,IN + ADDI CH,SLPQAM + CAML CH,BFRBOT ;AND IF BUFFER SPACE STARTS AT LEAST SLPQAM ABOVE THAT POINT, + MOVE IN,BFRBOT ;MOVE IT DOWN TO THAT POINT. ELSE DON'T MOVE IT. + IDIVI IN,5 +IFN ITS,[ + MOVE CH,QRWRT + ADDI CH,2000*5-1 ;COMPUTE 1ST PAGE IMPURE STRINGS DON'T NEED. + IDIVI CH,2000*5 + LDB Q,[121000,,IN] ;AND 1ST PAGE BUFFER NEEDS. + SUBM CH,Q ;-<# PAGES WE CAN FLUSH> + JUMPE Q,GCE2 + SKIPL Q + .VALUE + SAVE CH + HRLI CH,(Q) ;AOBJN -> PAGES TO FLUSH. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? CH] + .LOSE %LSSYS + REST CH + IMULI CH,2000*5 + CAML A,CH ;BETTER NOT CLEAR LOW BITS IN THE PAGES WE JUST FLUSHED. + MOVE A,CH +GCE2: +] + SAVE A + MOVEI A,MFSTRT ;LOOK AT ALL BUFFER FRAMES, +GCE3: MOVE T,MFBEG(A) ;AND RELEASE ALL THE DEAD ONES. + TLNN T,MFBFR + JRST GCE4 ;THIS IS A MACRO CALL, NOT A BUFFER. + TLZN T,MFMARK + JRST [ CALL KILBFR ;THIS ONE IS DEAD. + JRST GCE4] + MOVEM T,MFBEG(A) ;CLEAR THE MARK-BIT. +GCE4: ADDI A,MFBLEN + CAMGE A,MFEND + JRST GCE3 + REST A + IDIVI A,5 + CAML A,IN ;DON'T CLEAR LOW BITS IN CORE THAT BUFFERS WILL OCCUPY. + MOVE A,IN + MOVE T,QRWRT ;NOW, CLEAR LOW BITS BY CLEARING ALL OF THE EXISTING + ADDI T,4 ;CORE FROM THE TOP OF THE OCCUPIED PORTION OF + IDIVI T,5 ;IMPURE STRING SPACE UP TO BUFFER SPACE. + CAMG A,T + JRST GCE7 + MOVE C,[SIXBIT /LBCLR/] + MOVEM C,(T) ;STORE THIS RECOGNIZABLE CONSTANT TO CLEAR THE LOW BIT + HRLI T,T ;(FOR SAKE OF DEBUGGING). + ADDI T,1 + CAIL A,1(T) + BLT T,-1(A) +GCE7: MOVE T,BFRBOT ;C(IN) IS THE PLACE BUFFER SPACE + IDIVI T,5 ;SHOULD START; MOVE IT DOWN IF NEC. + CAMG T,IN + JRST GCE6 + SUBM IN,T + HRLS IN + SUB IN,T + MOVSS IN + MOVE C,BFRTOP + IDIVI C,5 + ADDI C,(T) + BLT IN,(C) + CALL BFRMVW +GCE6: CALL FLSCOR +IFN ITS,.SUSET [.SWHO1,,[0]] + JRST RSTACS + +;PUSHJ HERE, AND IT RETURNS WITH ACS 0-16 SAVED. +IFN P-17,.ERR PDL POINTER NOT AC17 +.SEE CIRC ;THIS DEPENDS ON THE ORDER OF THE AC'S +SAVACS: ADD P,[16,,16] ;MAKE ROOM ON STACK FOR 1 THRU 16. + MOVEM 1,-15(P) ;SAVE 1 + MOVEI 1,-14(P) + HRLI 1,2 + BLT 1,(P) ;USE 1 TO SAVE THE REST + MOVE 1,-15(P) ;RESTORE 1. + SKIPL P + TYPRE [PDL] + SAVE -16(P) ;PUT RETURN PC ON TOP OF STACK, + MOVEM 0,-17(P) ;SAVE AC 0 IN ITS PLACE, + RET + +;JRST RSTACS TO UNDO A SAVACS, THEN POPJ OUT OF THE ROUTINE THAT CALLED THE SAVACS. +RSTACS: MOVSI 16,-16(P) ;GET START OF WHERE THEY ARE + HRRI 16,0 + BLT 16,16 ;RESTORE THE REST + SUB P,[17,,17] + RET + +RST321: REST C ;JSP A,RST321 TO POP ACS 3 2 AND 1 OFF THE STACK + REST B + EXCH A,(P) + RET + +SUBTTL BUFFER SELECTION, CREATION AND KILLING + +;A -> BUFFER FRAME; FREE THE FRAME AND THE SPACE IT POINTS TO. +;CLOBBERS C,E,T,TT. +KILBFR: MOVSI C,MFREADO + ANDCAM C,(A) ;MAKE READ-ONLY BUFFER WRITEABLE SO WE DON'T GET ERROR EMPTYING IT. + MOVEI C,(A) + SAVE BFRPTR + CALL NEWBFR ;SELECT THAT BUFFER FRAME AS CURRENT. + MOVE C,Z + MOVE E,BEG + CALL DELET1 ;DELETE ALL THE TEXT IN IT. + MOVEI C,5 ;FAKE GAPKIL INTO CLOSING UP THE 1-WORD INTER-BUFFER + ADDM C,EXTRAC ;GAP, AS WELL AS THE ACTUAL SPACE OCCUPIED BY THIS BFR. + MOVNI C,5 + ADDM C,Z + CALL GAPKIL ;FLUSH ALL SPACE IN BUFFER AREA USED BY THIS BUFFER. + SETZM MFBEG(A) ;FREE THE BUFFER FRAME BY CLEARING MFBFR BIT + SAVE A + SOJ A, + CALL FLSFRM ;AND PUTTING ON FREELIST (WHOSE POINTERS -> FRAME-1) + REST A + REST C ;NOW RESELECT THE BUFFER THAT WAS CURRENT AT CALL. + ;WITH OUT DESELECTING THE NOW-DEAD BUFFER + JRST NEWBF1 ;(THE IDEA IS TO AVOID SETTING ITS MFBFR BIT). + +;C -> BUFFER FRAME; SELECT IT AS CURRENT. SETS UP BEG, ETC. +;CLOBBERS C,T,TT. +NEWBFR: MOVE T,BFRPTR ;COPY BEG, ETC. BACK INTO THE FRAME + MOVE TT,T ;THEY CAME FROM. + HRLI T,BEG ;(THAT IS, THE ONE CEASING TO BE CURRENT) + HLL C,MFBEG(TT) ;DON'T CLOBBER THE MFBFR AND MFMARK BITS. + BLT T,MFEXTR(TT) + HLLZ T,C ;WE SAVE THE BITS IN LH(C) TO AVOID USING ANY STACK. + ANDI C,-1 ;A PDL OV IN HERE WOULD BE HORRIBLE. + AND T,[MFBBTS-MFMODIF-MFREADO,,] + SKIPE MODIFF + TLO T,MFMODIF ;STORE MODIFF OF DESELECTED BUFFER AS A BIT. + SKIPE READON + TLO T,MFREADO ;AND FS READ ONLY$ + IORM T,MFBEG(TT) +NEWBF1: MOVEM C,BFRPTR ;REMEMBER WHICH FRAME NOW CURRENT. + SKIPL T,(C) ;SELECTING A FRAME WHICH ISN'T A BUFFER? + .VALUE + LDB TT,[.BP (MFREADO),T] + MOVEM TT,READON ;RESTORE READONLY FLAG + AND T,[MFMODIF,,] + MOVEM T,MODIFF ;RESTORE THE MODIFF OF THE BUFFER BEING SELECTED. + MOVSS C + HRRI C,BEG + BLT C,EXTRAC ;SET UP VARS FOR IT. + MOVSI T,MFBBTS ;BUFFER FLAG BITS SHOULD BE IN MFBEG BUT NOT BEG. + ANDCAM T,BEG + RET + +;FSWORD$ RETURNS WORD OF BUFFER CONTAINING CHARACTER AFTER +;,FSWORD$ ALSO SETS THAT WORD TO . NOTE THAT NO WORD EVER +;CONTAINS PART OF 2 DIFFERENT BUFFERS, BECAUSE OF FSBCREATE$'S ALLOCATION POLICY. +FSWORD: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => WRITING; ELSE READING. + ADD C,BEG ;GET VIRT CHAR ADDRESS OF A CHAR IN DESIRED WORD. + CALL CHK ;"NIB" IF OUTSIDE BUFFER BOUNDS. + TRNN FF,FRARG ;WRITING IN FS WORD$ MODIFIES BUFFER CONTENTS. + JRST FSWRD1 + SKIPE READON ;ALLOWED TO MODIFY THIS BUFFER? + TYPRE [RDO] + SETOM MODIFF +FSWRD1: CAMLE C,GPT ;CONVERT VIRTUAL ADDRESS TO REAL ADDRESS. + ADD C,EXTRAC + IDIVI C,5 ;GET ADDRESS OF WORD CONTAINING CHAR AFTER SPEC'D CHAR ADDR. + MOVE E,C ;PUT ADDRESS OF FLAG-WORD IN E FOR FSNORM + MOVE C,SARG ;AND VALUE TO STORE (IF ANY) IN C, THE ARGUMENT TO FSNORM. + JRST FSNOR1 ;NOW READ AND MAYBE WRITE THE BUFFER WORD. + +BFRMVW: IMULI T,5 +BFRMOV: MOVE TT,BFRBOT + ADDM T,BFRBOT + ADDM T,BEG + ADDM T,BEGV + ADDM T,PT + ADDM T,GPT + ADDM T,ZV + ADDM T,Z + JRST BFRRLC + +;RELOCATE POINTERS INTO BUFFER SPACE WHEN PART OF IT MOVES. +;ALL POINTERS IN ALL BUFFER FRAMES ARE CHANGED IF THEY ARE +;LARGER THAN C(TT) WHICH IS PRESUMABLY THE CHAR ADDR AT WHICH +;SOMETHING GREW OR SHRANK. C(T) IS THE AMOUNT TO ADD TO EACH +;POINTER. DOES NOT RELOCATE BEG, BEGV, PT, GPT, ZV OR Z. +;BYTE POINTERS IN MACRO FRAMES, AND CPTR AND INSBP, ARE ALSO RELOCATED. +;CLOBBERS A,C. RELOCATES BFRTOP PROPERLY. +BFRRLC: SKIPL @BFRPTR ;CURRENT BUFFER HEADER ISN'T A BUFFER HEADER? + .VALUE + SAVE BP + MOVE A,BFRTOP ;TO SAVE TIME, IF WE CAN FIGURE OUT THAT THE CHANGE + SUBI A,5 ;TOOK PLACE IN THE UPPERMOST BUFFER, THEN WE KNOW NO + CAMLE TT,A ;BUFFER HAS TO BE RELOCATED. + JRST BFRRL3 ;SO WE DON'T HAVE TO TEST THEM ALL. + MOVEI A,MFSTRT ;SCAN ALL BUFFER FRAMES. +BFRRL1: SKIPL C,MFBEG(A) .SEE MFBFR + JRST BFRRL4 ;THIS FRAME ISN'T A BUFFER FRAME. + TLZ C,MFBBTS ;IT IS A BUFFER FRAME. + CAME A,BFRPTR + CAMGE C,TT ;IS IT HIGH ENOUGH IN MEMORY TO BE RELOCATED? + JRST BFRRL2 +INSIRP ADDM T(A),MFBEG MFBEGV MFPT MFGPT MFZV MFZ + ADD C,T + CAMGE C,BFRBOT ;BUFFER RELOCATED TO BELOW BUFFER SPACE? + .VALUE +BFRRL2: ADDI A,MFBLEN + CAMGE A,MFEND + JRST BFRRL1 +BFRRL3: MOVE BP,CPTR ;RELOCATE CPTR - MAYBE WE'RE EXECUTING OUT OF A BUFFER NOW. + CALL BFRRL5 + MOVEM BP,CPTR + SKIPE INSINP + SKIPE INSBP + CAIA + .VALUE ;IN INSERT, AND INSBP ISN'T SAVING IT?? + MOVE BP,INSBP + CALL BFRRL5 + MOVEM BP,INSBP + ADDM T,BFRTOP + SKIPL @BFRPTR + .VALUE +POPBPJ: REST BP + RET + +BFRRL4: MOVE BP,MFCPTR(A) ;MACRO FRAME FOUND: IF THE CPTR POINTS AT A BUFFER, + CALL BFRRL5 ;RELOCATE IT IF THAT BUFFER IS MOVING. + MOVEM BP,MFCPTR(A) + JRST BFRRL2 + +BFRRL5: SAVE TT ;BP HAS A B.P. EITHER RELOCATE IT, OR SKIP IF IT'S UNCHANGED. + CALL GETCA + REST TT + CAMGE BP,BFRTOP + CAMGE BP,TT + JRST POPJ1 ;IF WE SKIP, BP IS CLOBBERED, BUT CALLER SHOULD ASSUME UNCHANGED. + ADD BP,T ;RELOCATE THE POINTER IF NEC. + SAVE TT + CALL GETBP + REST TT + RET + +BFRSE2: MOVEM B,PF ;SPECIAL ENTRY FROM FSQPUN + ;STORE BACK QREG PDL PTR; OTHERWISE ERROR QNB WOULD + ;CAUSE A LOOP DUE TO AUTOMATIC UNWIND. +;SELECT THE BUFFER IN THE Q-REG CH POINTS AT (PRESUMABLY ..O), PROVIDED IT IS LEGITIMATE. +;OTHERWISE, CLOBBER THE QREG BACK TO THE CURRENTLY SELECTED BUFFER. +BFRSE1: SAVE C + MOVE C,BFRSTR + EXCH C,(CH) + CALL BFRSET ;WHILE WE SELECT IT, KEEP THE OLD, GOOD BUFFER IN ..O. + MOVEM C,(CH) ;THEN PUT NEW ONE BACK IN ..O WHEN ERROR CAN'T HAPPEN. + JRST POPCJ + +;ASSUME C HAS A STRING PTR TO A BUFFER'S POINTER STRING; +;MAKE THAT BUFFER CURRENT. CLOBBERS BP,T,TT. +BFRSET: SAVE C + SAVE CH + SAVE B + SAVE C + CALL QBGET + SKIPN C,B + TYPRE [QNB] ;SELECTING A KILLED BUFFER? + REST BFRSTR + REST B + CALL NEWBFR + REST CH + JRST POPCJ + +;C HAS STRING PTR TO PTR STRING OF BUFFER. +;RETURN IN B THE ADDR OF THE FRAME. +;RETURN IN CH A BP TO 1ST CHAR OF POINTER STRING. +;CLOBBERS BP,T,TT. +QBGET: MOVE BP,C +QBGET2: ADD BP,QRBUF + TLZE BP,400000 + CAML BP,QRWRT + TYPRE [QNB] + CALL GETBP + LDB CH,BP + CAIE CH,QRBFR + TYPRE [QNB] + MOVE CH,BP + CALL QLGET4 ;FORM NEXT 3 CHARS INTO NUMBER IN B + ADDI B,4 ;QLGET4 SUBTRACTS 4; WE MUST COMPENSATE. + RET + +;HERE TO DECODE A BUFFER POINTER IN BP, AND ALSO MAKE SURE, IN CASE IT IS THE +;SELECTED BUFFER, THAT THE WORDS IN THE BUFFER BLOCK ARE UP TO DATE. +QBGET1: CAME BP,BFRSTR + JRST QBGET2 + SAVE C + MOVE C,BFRPTR + CALL NEWBFR + REST C + JRST QBGET2 + +;FS BCREATE$ -- CREATE A NEW BUFFER, AND MAKE IT CURRENT. +FSCRBF: CALL FSCRB1 + MOVEI CH,$QBUFR ;ADDR OF QREG TO STORE IN. + CALL QCLOSQ + MOVEM OUT,BFRSTR ;SET INTERNAL Q..O AS WELL. + MOVE C,A + JRST NEWBFR ;SET PREDIGESTED Q..O (BFRPTR) AS WELL. + +;FS BCONS$ -- RETURNS A NEWLY CREATED BUFFER. +FSBCON: CALL FSCRB1 +FSBCO1: MOVEI CH,A + CALL QCLOSQ + JRST POPJ1 + +;FS QVECTOR$ -- RETURNS A QREG VECTOR BUFFER. +FSQVEC: CALL FSCRB1 + MOVSI T,MFQVEC + IORM T,(A) ;NOTE A -> BUFFER FRAME. + JRST FSBCO1 + +FSCRB1: TRZN FF,FRARG + SETZ C, ;C HAS # OF CHARS OF SPACE TO MAKE IN THE BUFFER. + SAVE C ;(SPACE IS NOT INITIALIZED). + MOVEI C,4 + CALL SLPQGT ;GET SPACE FOR POINTER-STRING. + ;NOW THE BUFFERS WON'T MOVE, SO WE CAN SET + ;UP THE POINTERS IN THE FRAME. + CALL GETFRM ;OBTAIN FRAME FOR BUFFER; ADDR IN A. + MOVEI A,1(A) ;GETFRM ACTUALLY GIVES ADDR OF FRAME MINUS 1. + SETZM MFEXTR(A) + MOVE C,BFRTOP ;PUT THIS NEW BUFFER AT TOP OF MEM. +INSIRP MOVEM C(A),MFBEGV MFPT MFGPT MFZV MFZ + TLO C,MFBFR ;MARK THIS FRAME AS A BUFFER FRAME + MOVEM C,MFBEG(A) + TLZ C,MFBFR + IDIVI C,5 ;FIND WHICH WORD WE START IN + HRLZ TT,C ;MAKE A BLT POINTER TO ZERO STARTING FROM THERE. + HRRI TT,1(C) + REST C ;HOW MUCH SPACE DO WE WANT? + ADDM C,MFZV(A) ;INCLUDE IT IN THE BUFFER BY SETTING Z AND ZV. + ADDB C,MFZ(A) + IDIVI C,5 ;WHICH WORD DO WE END IN? + SETZM -1(TT) ;ZERO ALL THE SPACE, INCLUDING THAT WORD. + CAIE C,-1(TT) + BLT TT,(C) + IMULI C,5 ;FIND THE NEXT WORD BOUNDARY, FOR NEW TOP OF BUFFER SPACE. + ADDI C,5 + MOVEM C,BFRTOP ;EACH BUFFER GETS A WORD OF SPACE SO THEY'RE SEPARATED. + MOVEI B,QRBFR ;NOW CREATE THE POINTER STRING IN SPACE ALREADY RESERVED. + MOVE C,A ;IT SHOULD CONTAIN THE ADDR OF THE BUFFER FRAME. + CALL QHDRW1 + MOVEI OUT,4 + ADD OUT,QRWRT + RET + +;FS BKILL$ -- TAKES ARG = STRING POINTER TO PTR STRING OF BUFFER, +;AND KILLS THAT BUFFER. THAT IS, THE BUFFER FRAME AND TEXT ARE FREED, +;AND THE PTR STRING IS CHANGED TO BE A DEAD BUFFER. IF NO ARG, +;[ ;DO " Q..O(]..O[A)UA QA-Q..O"NFSBKILL$' ]A ". +FSKILB: TRZE FF,FRARG ;IF THERE'S AN ARG, USE IT. + JRST FSKIL1 + SAVE $QBUFR ;OTHERWISE, POP QREG PDL INTO Q..O, + MOVEI CH,$QBUFR + CALL CLOSB2 + REST C ;AND IF POPPED VALUE DIFFERS FROM PREV. CONTENTS, + CAMN C,$QBUFR ;KILL THE PREVIOUS CONTENTS. + RET +FSKIL1: SKIPN KILMOD + RET ;ALLOW THIS TO BE DISABLED FOR DEBUGGING. + CALL QBGET ;GET ADDR OF FRAME IN B. + CAMN B,BFRPTR + TYPRE [KCB] ;KILL A BUFFER WHILE IT'S SELECTED? + SKIPN A,B + RET ;KILLING A DEAD BUFFER. + SETZ Q, + IDPB Q,CH ;STORE 0'S IN BUFFER-FRAME-ADDR IN PTR STRING. + IDPB Q,CH + IDPB Q,CH + JRST KILBFR ;FREE FRAME AND TEXT. + +;F[B BIND$ -- PUSH THE CURRENT BUFFER. F]B BIND$ -- POP IT. +FSBBIN: TRNN FF,FRARG + JRST FSBBI3 ;NO ARG => MUST BE PUSHING. + JUMPGE C,FSBBI3 ;ARG IS POSITIVE => MUST BE SIZE OF BUFFER TO MAKE, SO WE'RE PUSHING. + SAVE BFRSTR ;ARG => POPPING. REMEMBER THE INNER BINDING BEING FLUSHED. + MOVEM C,$QBUFR + CALL BFRSET ;SELECT THE OLD BINDING (IN C) + REST C ;KILL THE INNER BINDING AFTER THAT SUCCEEDS. + JRST FSKIL1 + +FSBBI3: TRO FF,FRARG + CALL FSBCONS ;PUSHING THE SEARCH TABLE: MAKE A NEW ONE, + JFCL + SAVE BFRSTR ;SAVE THE OLD ONE TO RETURN, AND SELECT NEW ONE. + MOVE C,A + CALL BFRSET + MOVEM A,$QBUFR +POPAJ1: REST A ;THEN RETURN THE OLD ONE (TO GO ON QREG PDL). + JRST POPJ1 + +;EMACS BUFFER SWITCH LOCAL VARIABLE SWAPPING + +;,F^G - DO A LOCAL VARIABLE SWAP FOR THE EMACS BUFFER TABLE. +; IS THE BUFFER WHICH IS THE EMACS BUFFER TABLE. +; IS THE WORD OFFSET (VIRTUAL) OF AN ENTRY IN IT. +; IS THE POSITION WITHIN THAT ENTRY OF THE FIRST LOCAL VARIABLE. +;LOCAL VARIABLES FILL ALL THE REST OF THE ENTRY FROM THERE +; (THE TOTAL LENGTH OF THE ENTRY IS ITS FIRST WORD). +;EACH LOCAL VARIABLE TAKES TWO WORDS: +; THE FIRST IS THE NAME AS A STRING POINTER, OR THE :FSQPHOME$ OF A ^R COMMAND SLOT OR Q-REG, +; AND THE SECOND IS THE SWAPPED-OUT VALUE. + +;@F^G ONLY STORES THE CURRENT VALUES INTO THE BUFFER TABLE. +;:F^G ONLY GETS NEW VALUES OUT OF THE BUFFER TABLE. + +;NOTE: WE ASSUME THAT THE GAP IN THE BUFFER TABLE IS NOT IN THE MIDDLE OF THIS ENTRY! +;IT IS OK IF IT IS DIRECTLY IN FRONT OR BEHIND THE ENTRY. + +FCTLG: EXCH C,E ;HAHA I THOUGHT , PUT IN C AND IN E, SO MAKE IT THAT WAY. + CALL QREGX ;READ QREG CONTAINING THE BUFFER TABLE. + MOVE BP,A + CALL QBGET1 ;B GETS PTR TO BUFFER TABLE'S BUFFER FRAME. + IMULI C,5 ;C HAS CHARACTER POINTER TO START OF EMACS BUFFER'S ENTRY. + ADD C,MFBEGV(B) + CAML C,MFGPT(B) + ADD C,MFEXTR(B) + IDIVI C,5 ;C NOW HAS WORD ADDRESS OF START OF ENTRY. + MOVE D,(C) ;D HAS LENGTH OF ENTRY. + ADD C,E ;C NOW GETS POINTER TO FIRST LOCAL VARIABLE ENTRY. + SUB D,E ;D HAS # OF WORDS LEFT (TWICE NUMBER OF LOCAL VARS). + JUMPLE D,CPOPJ + +;HACK THE NEXT LOCAL VAR. C POINTS TO THE WORD IN THE BUFFER TABLE HOLDING ITS NAME. +;D HAS THE NUMBER OF WORDS OF LOCAL VARS LEFT TO HACK IN THIS BUFFER. +FCTLG1: MOVE A,(C) + CALL FCTLG2 ;LOAD NAME OF NEXT LOCAL VAR INTO GCTAB. + JRST FCTLG4 ;IT ISN'T A STRING => IT IS ADDRESS IN RRMACT. + MOVE IN,QRB.. ;GET STRING POINTER TO SYMBOL TABLE. + MOVE A,.QSYMT(IN) + SAVE C + SAVE D + SAVE FF + TRZ FF,FRCLN\FRUPRW\FRARG\FRARG2 + TRO FF,FRUPRW ;INSIST ON EXACT MATCH IN LOCAL VARIABLE NAME. + CALL FOCMD3 ;LOOK UP THAT VARIABLE IN THE SYMBOL TABLE. IN GETS S.T.E. ADDRESS. + TYPRE [UVN] + REST FF + MOVEI CH,1(IN) ;CH GETS ADDR OF VALUE WORD IN S.T.E. + MOVE IN,-1(P) ;IN GETS ADDR OF LOCAL VARIABLE ENTRY./ + MOVE D,(CH) ;BEGIN THE EXCHANGE, + MOVE C,1(IN) + TRNN FF,FRCLN ;COLON MEANS DON'T STORE IN THE BUFFER TABLE. + MOVEM D,1(IN) + TRNN FF,FRUPRW ;ATSIGN MEANS DON'T SET THE VARIABLE. + CALL [ SKIPE VARMAC ;IF SETTING THE VAR CAN CALL A MACRO, + JRST USE3 ;USE USE3 TO DO IT SO THAT THE MACRO GETS CALLED. + MOVEM C,(CH) ;OTHERWISE JUST STORE. + RET] + REST D + REST C + JRST FCTLG6 + +FCTLG5: MOVE CH,1(IN) ;FETCH BOTH VALUES, TO EXCHANGE THEM. + MOVE Q,1(C) + TRNN FF,FRCLN ;IF NO COLON, STORE IN THE BUFFER TABLE. + MOVEM CH,1(C) + TRNN FF,FRUPRW ;IF NO ATSIGN, SET THE Q-REG. + MOVEM Q,1(IN) +FCTLG6: ADDI C,2 ;MOVE PAST THIS LOCAL VAR AND DECREMENT COUNT OF REMAINING ONES. + SUBI D,2 + JUMPG D,FCTLG1 + RET ;AFTER HACKING ALL LOCAL VARS, WE ARE DONE. + +;GIVEN A STRING POINTER IN A, LOAD THE STRING INTO STAB WITH J POINTING AT THE END. +;SKIPS UNLESS THE OBJECT IN A REALLY IS A STRING. +;CLOBBERS B,BP,CH,TT,TT1. +FCTLG2: CALL QLGET0 ;GET BP TO VAR NAME STRING IN BP AND LENGTH IN B. + RET + MOVEI J,STAB-1 + JUMPE B,POPJ1 +FCTLG3: ILDB CH,BP ;FETCH NEXT CHAR OF VARIABLE NAME STRING + CAIL CH,"A+40 ;CONVERT LETTERS TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;AND STORE IN STAB FOR OUR LOOKUP. + SOJG B,FCTLG3 + JRST POPJ1 + +FCTLG4: MOVE IN,A ;HERE IF A LOCAL'S "NAME" ISN'T A STRING. + CAIGE IN,RRMACT+1000 ;IT SHOULD POINT INTO RRMACT OR AT A Q-REG. + CAIGE IN,RRMACT + CAIGE IN,QTAB+NQREG + CAIGE IN,QTAB + CAIA ;SKIP IF NOT THE ADDRESS OF A LEGITIMATE LOCAL Q-REGISTER. + SOJA IN,FCTLG5 ;GO SWAP THE CONTENTS OF THAT WORD. + CAIL C,FLAGSL*2 ;IF IT ISN'T A LOCAL Q-REG, MAYBE IT'S AN FS FLAG. + TYPRE [ILN] ;THEY ARE REPRESENTED BY INDICES INTO THE TABLE FLAGS. + SAVE C + SAVE D + MOVE B,IN ;GET VALUE TO SWAP IN AS ARG TO FLAG ROUTINE. + MOVE C,FLAGD(C) ;GET ADDRESS OF FLAG ROUTINE. + SAVE FF + TRZ FF,FRCLN+FRARG+FRARG2 + TRZN FF,FRUPRW ;IF NO ATSIGN, SET THE FLAG. + TRO FF,FRARG + CALL FSFND ;IN ANY CASE, CALL FLAG ROUTINE SO WE GET THE OLD VALUE + REST FF + REST D + REST C + TRNN FF,FRCLN ;WHICH, IF NO COLON, WE STORE IN THE BUFFER TABLE. + MOVEM A,1(C) + JRST FCTLG6 + +SUBTTL SEARCH COMMANDS + +;GET ARGUMENTS TO SEARCH +GSARG: TRZ FF,FRBACK ;CLEAR SOME FLAGS + ARGDFL Z, ;GET ARGUMENT OR OPERATOR CONVERTED TO VALUE + MOVMM C,SEARG ;STORE # OCCURRENCES TO LOOK FOR. + JUMPL C,GSARGN ;J IF SEARCHING BACKWARDS. + MOVE E,PT ;ELSE RANGE TO SEARCH IS PT TO ZV. + MOVE C,ZV +GSARG2: MOVEI B,SLP1I ;GET-CHAR RTN FOR MOVING FWD. +GSARG1: HRRM B,SLP1P ;STORE GET CHAR RTN ADDR. +GSAPCH: MOVE BP,E ;CHAR ADDR BOTTOM OF RANGE. + CAML E,GPT ;IF CHAR ADDRESSED IS ABOVY RANGE, PT TO IT. + ADD BP,EXTRAC + CALL GETBP + MOVEM BP,BBP ;SAVE BP'S TO BOTTOM OF RANGE. + MOVEM BP,BBP1 + MOVE BP,C ;MAKE PTR TO TOP OF RANGE: + CAMG C,GPT ;IF IT IS BEYOND GAP, + CAML E,GPT ;OR BOTTOM IS AT GAP, + ADD BP,EXTRAC ;RELOCATE TO PT ABOVE GAP, + CALL GETBP + MOVEM BP,ZBP + MOVEM BP,ZBP1 + CAMGE E,GPT ;IS THE GAP WITHIN RANGE OF SEARCH? + CAMG C,GPT + JRST GSARG7 + TRNN FF,FRBACK + JRST GSARG4 + MOVE BP,GPT ;IN BACKWARD SEARCH, MUST STOP AT GAP + ADD BP,EXTRAC ;TO MOVE OVER IT. + CALL GETBP + MOVEM BP,BBP1 +GSARG4: MOVE BP,GPT ;FOR MOVING FWD OVER GAP, + CALL GETBP + MOVEM BP,ZBP1 ;NEED BP TO START OF GAP. +GSARG7: SUB E,BEG + SUB C,BEG + MOVEM E,SRCBEG ;REMEMBER RANGE SEARCHED, FOR ^B COMMAND. + MOVEM C,SRCEND + POPJ P, + +GSARGN: MOVE E,BEGV ;BACKWARDS, RANGE IS BEGV TO PT. + MOVE C,PT +GSARG6: TRO FF,FRBACK + MOVEI B,SLP1D ;RTN TO GET CHARS BACKWARDS. + SETZM PNCHFG ;NEVER READ FROM FILE IF BACKWARD SEARCH FAILS. + JRST GSARG1 + +GSARGB: TRZ FF,FRBACK ;BOUNDED SEARCH. + MOVEI J,1 ;GO ONLY ONCE. + MOVEM J,SEARG + TRNE FF,FRARG2 + CAMG E,C ;IF FB HAS 2 ARGS, IN REVERSE ORDER, + JRST GSARG5 + EXCH C,E ;THEN DO BACKWARDS BOUNDED SEARCH. + CALL GETARG + CALL CHK1 + JRST GSARG6 + +GSARG5: CALL GETARG ;GET RANGE IN C,E. + CALL CHK1 + JRST GSARG2 + + ;SEARCH COMMANDS + +SERCHA: HRRZM P,PNCHFG ;_ COMMAND. PNCHFG POSITIVE. + CAIA +SERCHP: SETOM PNCHFG ;N COMMAND. PNCHFG NEGATIVE. + CAIA +SERCH: SETZM PNCHFG ;S COMMAND. PNCHFG ZERO. + CALL GSARG ;HANDLE ARG, SET UP DISPATCHES. + JRST SERCH1 + +;FB -- BOUNDED SEARCH. ARGS LIKE K,T. (:FB IS LIKE :S, NOT :K). +FBCMD: SAVE FF ;SAVE FRCLN. + ANDCMI FF,FRCLN\FRUPRW + CALL GSARGB ;GET RANGE OF BUFFER, SET UP DISPATCHES. + SETZM PNCHFG + REST A + ANDI A,FRCLN\FRUPRW ;RESTORE: FLAG SO IT WILL SAY WHETHER TO RETURN A VALUE. + IORI FF,(A) +SERCH1: MOVEI CH,ALTMOD ;NOW TO CHOOSE A TEXT TERMINATOR, DEFAULT IS ALTMODE + TRNE FF,FRUPRW ;UPARROW TYPED? + CALL RCH ;YES, GET NEXT CHARACTER INSTEAD + HRRM CH,INSDLM ;STORE AS DELIMITER + MOVE E,SBFRP ;ADDRESS OF SEARCH BUFFER HEADER BLOCK. + MOVE TT,MFZ(E) + MOVE E,MFBEGV(E) ;CHAR ADDRS OF BEGINNING AND END OF SEARCH BUFFER. + IDIVI E,5 + AOS E + MOVEM E,STBLP ;WORD ADDRESS OF SEARCH BUFFER BODY, + 1 (START OF DATA) + HRLM E,STBLPX + IDIVI TT,5 + SUBM E,TT ;- + HRLI E,-1(TT) ;AOBJN -> SEARCH BUFFER + SETO D, ;SAY THERE ISN'T A CHAR TO BE REREAD. + TRZE FF,FRUPRW + JRST SERCH2 + CALL RCH ;IF NOT AN ^-TYPE ARG, CHECK FOR NULL ARG + SKIPE SQUOTP + JRST SERCH3 ;DON'T BE CONFUSED BY SUPERQUOTED ALTMODES. + CAIN CH,ALTMOD ;WHICH MEANS REPEAT PREVIOUS SEARCH. + JRST SRLC +SERCH3: MOVE D,CH ;ELSE CAUSE THE CHAR TO BE REREAD. + TLZ D,4^5 ;DON'T LET IT BE NEGATIVE. + JRST SERCH2 + +;REPEAT THE PREVIOUS SEARCH. THE SEARCH BUFFER CONTAINS POINTERS INTO ITSELF. +;ALL THOSE POINTERS MUST BE RELOCATED IF THE SEAECH BUFFER HAS MOVED SINCE THE LAST +;TIME IT WAS USED. E -> BUFFER BODY BOTTOM. CLOBBERS E,D,TT. +SRLC: SKIPN -1(E) ;DOES BUFFER SAY IT IS VALID? + TYPRE [SNR] + HRRZ TT,(E) ;RH OF 1ST WORD OF TABLE SHOULD POINT TO 2ND. + SUBI TT,1(E) ;SUBTRACT REAL ADDR OF 2ND, GIVES AMOUNT BUFFER HAS MOVED. + MOVNS TT + HRLZ TT1,TT ;WE MAY WANT TO RELOCATE LH'S AS WELL AS RH'S. + JUMPE TT,SRN3 ;DON'T BOTHER RELOCATING IF RLOC. AMOUNT IS 0. +SRLC1: ADDM TT1,(E) ;LH OF EACH SUBSTRING HEADER IS A POINTER. + HRRZ D,(E) + CAIN D,SLP1P ;REACHED END OF TABLE? + JRST SRN3 + ADDM TT,(E) ;NO; RH IS ALSO A POINTER. + HLRZ E,(E) ;FIND NEXT SUBSTRING. + JRST SRLC1 + +;NOW COMPILE SEARCH TABLE +SERCH2: SETZM -1(E) ;WHILE WE SET UP STBL IT IS INVALID. +SCPL: HRRZ C,E ;SAVE LOCATION OF BEGINNING OF BLOCK (LOOP POINT FOR CONTROL O) + MOVEI CH,1(E) ;GET RIGHT HALF OF UPCOMING HEADER + PUSHJ P,SDEP ;DEPOSIT IN TABLE +SCPL1: TDZA A,A ;CLEAR INDEX AND FALL INTO LOOP +SCNOT: TRC A,1 ;CONTROL N, COMPLEMENT 1 BIT INDEX + SKIPGE CH,D ;IF THERE'S A CHAR TO REREAD, USE IT. + CALL RCH ;ELSE GET NEXT CHARACTER. + SETO D, ;FLUSH THE SAVED CHAR IF ANY. + SKIPGE SQUOTP + JRST SCNSP ;SUPERQUOTED CHAR. + SKIPE SQUOTP + JRST SCNDL ;DELIM-PROTECTED CHAR. + CAMN CH,INSDLM ;IF TEXT TERMINATOR (RH MODIFIED), + JRST SCPX ;THEN DONE COMPILING, GO DO IT +SCNDL: CAILE CH,^X + JRST SCNSP + CAIN CH,^X ;IF CONTROL X (FOR "ANY CHARACTER"), + ADDI A,XSER ;THEN SET INDEX + CAIN CH,^B ;IF CONTROL B (FOR BREAK CHARACTER) + ADDI A,BSER ;THEN SET INDEX + CAIN CH,^N ;IF CONTROL N (FOR "NOT") + JRST SCNOT ;THEN CLOBBER INDEX AND GET NEXT CHARACTER + CAIN CH,^O ;IF CONTROL O ("OR"), + JRST SCPOR ;THEN GENERATE NEW HEADER + CAIN CH,^Q ;IF CONTROL Q (QUOTES THE NEXT CHARACTER), + CALL RCH ;THEN REALLY USE NEXT CHARACTER, SKIPPING ABOVE TESTS +SCNSP: SKIPE BOTHCA ;BOTHCASE=0 => CASES ARE DISTINCT. + TRNN CH,100 ;BOTHCASE=1 => CASE IGNORED FOR LETTERS ONLY. + JRST SCNSP1 ;BOTHCASE=-1 => CASE IGNORED FOR ALL CHARS > 100 . + ANDI CH,-1 ;SUPERQUOTED CHARS STIL GET CONVERTED. + CAIL CH,"A+40 ;IF IGNORING CASE FOR A CHARACTER, CONVERT IT TO + CAILE CH,"Z+40 ;UPPER CASE HERE, ND ALSO WHIE SEARCHING THE BUFFER. + SKIPG BOTHCA + ANDCMI CH,40 +SCNSP1: TRNE A,-2 ;IF INDEX CLOBBERED, + SKIPA CH,(A) ;THEN GET TABLE ENTRY + HLL CH,CHSER(A) ;INDEX NOT CLOBBERED OUT OF EXISTENCE, TURN INTO CAIE OR CAIN + PUSHJ P,SDEP ;DEPOSIT TABLE ENTRY + JRST SCPL1 ;LOOP + +SDEP: MOVEM CH,(E) ;ADD AN ENTRY TO THE SEARCH TABLE + AOBJN E,CPOPJ ;RETURN IF TABLE NOT FULL + TYPRE [STL] + +SCPX: TDZA B,B ;TEXT TERMINATOR ENCOUNTERED +SCPOR: MOVEI B,SCPL ;CONTROL O + MOVE CH,[JRST WIN] ;SET FINAL TABLE ENTRY (EXECUTED => THIS STRING FOUND) + CAIN C,-1(E) + HRRI CH,WINNL1 ;BUT FOR NULL STRINGS, USE WINNL1 INSTEAD WIN. + PUSHJ P,SDEP ;DEPOSIT + HRLM E,(C) ;STORE POINTER TO THIS HEADER IN LH(LAST HEADER) + JUMPN B,(B) ;JUMP IF NOT TEXT TERMINATOR + MOVS A,STBLPX ;GET LIST CIRCULIZER/POINTER TO ROUTINE TO READ NEXT CHAR. + MOVSM A,(E) ;STORE IN TABLE (THIS LAST ENTRY, DON'T INCREMENT E OR CHECK FOR OVERFLOW) + SETOM -1(A) ;SEARCH TABLE NOW COMPILED. + MOVEI E,1(E) + IMULI E,5 + MOVE A,SBFRP + MOVEM E,MFZV(A) ;ZV OF SEARCH BUFER POINTS TO END OF REGION BEING USED. + JRST SRN3 + + ;TABLES FOR COMPILING SEARCH TABLE + +XSER: JFCL ;CONTROL X + CAIA ;NOT CONTROL X + +BSER: PUSHJ P,SKNBRK ;CONTROL B + PUSHJ P,SKBRK ;NOT CONTROL B + +CHSER: CAIN A, ;NORMAL CHARACTERS (HLL'ED WITH CHAR. IN RIGHT HALF) + CAIE A, ;NOT CHAR. + +;SEARCH TABLE FORMAT + +;FOLLOWING IS COMPILATION OF "SFOO SP)" + ;EVERY WORD ASSEMBLED WITH ",," IS A SUBSTRING HEADER. + +;STBLP POINTS HERE: +;TEM: .+5,,.+1 ;HEADER, LH POINTS TO NEXT COMPARISON STRING + ;RH POINTS TO TABLE THIS COMPARISON STRING +; CAIN A,"F ;IF THE TEST IS TO SUCCEED THEN THE INSTRUCTION SHOULD NOT SKIP +; CAIE A,"O ;THE CHARACTERS ARE IN A +; CAIN A,"O +; JRST WIN ;DOES JRST WIN IF ENTIRE STRING HAS BEEN FOUND +; .+10,,.+1 ;THIS LAST COMPARISON STRING BUT LH STILL POINTS SOMEWHERE +; CAIN A,40 +; CAIE A,"S +; CAIN A,"P +; PUSHJ P,SKBRK ;SKBRK => , SKNBRK =>  +; JFCL +; CAIN A,") +; JRST WIN +; .+2,,.+1 +; JRST WINNL1 +; TEM,,SLP1P ;FINAL HEADER, LH POINTS TO FIRST HEADER MAKING LIST CIRCULAR + ;RH POINTS TO A JRA B, + +;MAIN SEARCH LOOP + +SLP2LC: OFFSET 17-9-. +SLP2==. + LDB A,C ;GET CHARACTER + XCT (B) ;COMPARE WITH FIRST CHARACTER THIS COMPARISON STRING + ;SKIP => THIS CHARACTER LOSES, TRY NEXT COMPARISON STRING + ;NO SKIP => THIS CHARACTER WINS, TRY NEXT ONE + ;WIN ON STRING => JRST WIN + ;THIS CHARACTER TOTALLY LOSES ON ALL COMPARISON STRINGS => EXECUTE SLP1P + ;^ => B := FIRST HEADER IN SEARCH TABLE + SKIPA E,C ;WIN THIS CHARACTER, GET POINTER FOR CHECKING FUTURE CHARACTERS + JRA B,.-2 ;LOSE THIS COMPARISON STRING, TRY NEXT +SLP3==. + ILDB A,E ;GET NEXT CHARACTER + XCT 1(B) ;EXECUTE NEXT TABLE ENTRY + CAMN E,ZBP ;IT CLAIMS TO HAVE WON; WAS IT AT END OF BUFFER? +SLP4:: JRA B,SLP2 ;LOSE, TRY NEXT COMPARISON STRING + AOJA B,SLP3 ;WIN THIS CHARACTER, TRY NEXT + +IFN .-17,.ERR SLP2 WRONG TABLE LENGTH + + OFFSET 0 + +;FALLS THROUGH. +;ASSUMING THE SEARCH TABLE IS SET UP, DO THE SEARCHING. +SRN3: TRZ FF,FRARG+FRARG2 + SETOB A,SFINDF ;A NULL SEARCH OR SEARCHING 0 TIMES SHOULD STATE THAT IT WON. + SKIPE SEARG ;IF ARGUMENT ZERO, (ENTRY FOR "AGAIN" COMMAND) + JRST SRN2 + TRNE FF,FRCLN ;THEN WIN, DON'T BOTHER ACTUALLY SEARCHING. + JRST POPJ1 ;RETURN -1 AS VALUE IF ONE IS WANTED. + RET + +SRN2: CALL SKNBCP ;SET UP SKNBPT FROM Q..D, FOR SKNBRK'S SAKE. + SETZM TEM2 ;NO WINNING SEARCHES FOR SRCV TO DOCUMENT + MOVE C,BBP ;GET PLACE TO START; NORMALLY LOW END + TRNE FF,FRBACK + MOVE C,ZBP ;BUT HIGH END IF REVERSE. +;FOR SEARCH WITH REPEAT COUNT, REPETITIONS COME BACK HERE. +SRN2RP: MOVE E,C ;INIT. BP TO END OF STRING IN CASE FIND NULL STRING. + MOVS 16,[SLP2,,SLP2LC] ;GET POINTER FOR BLTING IN MAIN LOOP + BLT 16,16 ;BLT IN MAIN LOOP + SKIPGE BOTHCA ;IN BOTH-CASES MODE, + MOVE SLP2,[JRST SLPLO1] + SKIPGE BOTHCA ;IGNORE THE CASE OF THE CHARS SEARCHING. + MOVE SLP3,[JRST SLPLOW] + SKIPLE BOTHCA ;BOTHCA POSITIVE => IGNORE CASE OF LETTERS ONLY. + MOVE SLP2,[JRST SLPLO3] + SKIPLE BOTHCA + MOVE SLP3,[JRST SLPLO2] + CALL IMMQIT ;IT'S OK TO QUIT OUT OF MIDDLE OF SEARCH. + MOVE B,ZBP + TRNN FF,FRBACK ;IF GAP IS IN THE RANGE + CAMN B,ZBP1 ;AND WE'RE STARTING BEFORE IT, + JRST SRN1 + MOVE SLP4,[JRST SLP1Z] ;TEMP. PTR ADVANCE + HRRI SLP4-1,ZBP1 ;WILL ENCOUNTER GAP BEFORE END. + MOVEM SLP4,SLP4N + MOVEM SLP4-1,SLP4N1 +SRN1: MOVE B,@STBLP ;INITIALIZE LIST POINTER + HLRZ A,B + TRNE FF,FRBACK ;IF BACKWARDS, ENTER NORMAL LOOP. + JRST WINNUL + HRRZ A,(A) ;IF THERE IS ONLY ONE ALTERNATIVE IN THE SEARCH STRING + CAIE A,SLP1P + JRST SRN5 + HLRZ A,(B) ;AND THE 1ST CHAR OF SEARCH STRING + CAIE A,(CAIN A,) ;IS NOT A SPECIAL SEARCH CHARACTER, + JRST SRN5 + MOVEI A,SFAST ;THEN WE CAN GO FAST + HRRM A,SLP1P ;USE THE GET-NEXT-CHAR ROUTINE THAT CAN SKIP FAST + HRRZ A,(B) ;OVER UNINTERESTING REGIONS. + MOVEI D,SFAFN0 ;WHICH MAIN LOOP SHOULD WE USE? + SKIPE BOTHCA ;SFAFC0 IGNORES THE 40 BIT; SFAFN0 DOESN'T. + CAIGE A,100 ;IS THE 1ST CHAR ONE WHOSE CASE WE WANT TO IGNORE? + JRST SRN4 ;NO. + CAIL A,"A + CAILE A,"Z + SKIPG BOTHCA + MOVEI D,SFAFC0 ;YES. +SRN4: MOVEM D,SFASAD ;TELL SFAST WHERE TO GO. +REPEAT 4,[ROT A,7 ;GENERATE AN ASCII CONSTANT WITH 1ST CHAR OF SEARCH + TRO A,@(B) ;REPEATED 5 TIMES. +] + LSH A,1 + MOVEM A,SFXOR +SRN5: CAMN C,ZBP + JRST WINNUL + JRST SLP1K + +;ROUTINE TO GET NEXT CHARACTER GOING FORWARD UNDER SPECIAL CIRCUMSTANCES. +;MAY SKIP FAST OVER MANY CHARACTERS BEFORE FINALLY STOPPING WITH A CHARACTER IT CAN'T +;QUICKLY RULE OUT. +SFAST: TLNE C,760000 + JRST SLP1I ;GO SLOW IF NOT STARTING NEW WORD. + HRRZ A,ZBP1 + CAIN A,(C) ;OR IF NEAR GAP OR END OF RANGE + JRST SLP1I + SUBM C,A + HRL C,A ;AOBJN -> RANGE OF WORDS WE CAN SCAN FAST. + JRST @SFASAD ;TO SFAFN0 OR SFAFC0. + +;THIS IS THE SFAST MAIN LOOP THAT DOESN'T IGNORE THE 40 BIT OF THE CHARACTER. +SFAFNL: MOVE A,(C) + XOR A,SFXOR ;XOR NEXT WORD WITH ASCII/QQQQQ/ WHERE Q IS CHAR WE'RE LOOKING FOR. + TLNN A,(177_35) ;IS 1ST CHAR OF WORD THE ONE WE WANT? + JRST SFAF1 + TLNN A,(177_26) ;OR THE 2ND? + JRST SFAF2 + TDNN A,[177_17] + JRST SFAF3 + TRNN A,177_10 + JRST SFAF4 + TRNN A,177_1 + JRST SFAF5 +SFAFN0: AOBJN C,SFAFNL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +;MAIN LOOP THAT IGNORES THE 40 BIT. +SFAFCL: MOVE A,(C) + XOR A,SFXOR + TLNN A,(137_35) ;ONLY DIFFERENCE IS THAT EACH MASK OMITS THE 40 BIT. + JRST SFAF1 + TLNN A,(137_26) + JRST SFAF2 + TDNN A,[137_17] + JRST SFAF3 + TRNN A,137_10 + JRST SFAF4 + TRNN A,137_1 + JRST SFAF5 +SFAFC0: AOBJN C,SFAFCL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +SFAF1: HRLI C,350700 ;MUST EXAMINE 1ST CHAR THIS WORD - SO DROP INTO + JRST SLP2+2 ;MAIN SEARCH LOOP. + +SFAF2: HRLI C,260700 + JRST SLP2+2 + +SFAF3: HRLI C,170700 + JRST SLP2+2 + +SFAF4: HRLI C,100700 + JRST SLP2+2 + +SFAF5: HRLI C,010700 + JRST SLP2+2 + +;GET NEXT CHARACTER SEARCHING BACKWARDS + +SLP1E: MOVEM C,ZBP ;INITIALIZATION, SET CEILING FOR SEARCH +SLP1D: CAMN C,BBP1 ;AT BEGINNING OF BUFFER OR END OF GAP? + JRST SLP1F ;YES, FIGURE OUT WHICH. + ADD C,[70000,,] ;NO, DECREMENT C, + JUMPGE C,SLP2 ;AND GO BACK INTO LOOP + SUB C,[430000,,1] + JRST SLP2 + +SLP1F: CAMN C,BBP + JRST LOSE ;REALLY AT START OF RANGE, SEARCH FAILED. + JRST SLP1G ;MOVED BACK TO GAP, GO OVER IT. + +;GET NEXT CHARACTER SEARCHING FORWARDS + +SLP1I: IBP C ;INCREMENT TO NEXT CHARACTER +SLP1K: CAME C,ZBP1 ;AT START OF GAP OR END OF RANGE? + JRST SLP2 ;NO, KEEP GOING + CAMN C,ZBP ;WHICH ONE IS IT? + JRST LOSE ;IT'S END OF RANGE. +;MOVE OVER GAP TO GET NEXT CHARACTER +SLP1G: INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT ;COMPUTE A B.P. TO OTHER SIDE OF GAP. + TRNE FF,FRBACK + AOSA BP ;BACKWARD => 1ST CHAR OF GAP, + ADD BP,EXTRAC ;FWD => LAST CHAR OF GAP. + CALL GETIBP + MOVE C,BP + MOVE BP,BBP ;ALREADY PASSED GAP SOLOOK FOR BNDRYS + MOVEM BP,BBP1 ;OF RANGE INSTEAD. + MOVE BP,ZBP + TRNN FF,FRBACK + MOVEM BP,ZBP1 + XORI SLP4-1,ZBP#ZBP1 + MOVEM SLP4-1,SLP4N1 + XOR SLP4,[#] + MOVEM SLP4,SLP4N +INSIRP POP P,TT1 TT BP + HRRZ A,SLP1P ;NOW WE'RE ACROSS GAP SO RETRY FETCHING NEXT CHAR. + JRST (A) + +SLP1Z: XCT SLP4-1 + CAIA + JRA B,SLP2 + MOVE SLP4-1,[CAMN E,ZBP] + MOVE SLP4,[JRA B,SLP1Z1] + INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT + ADD BP,EXTRAC + CALL GETIBP + MOVE E,BP +INSIRP POP P,TT1 TT BP + JRST SLP3 + +SLP1Z1: MOVE SLP4-1,SLP4N1 + MOVE SLP4,SLP4N + JRST SLP2 + +SLPLOW: ILDB A,E ;COME HERE FROM SLP3 IN BOTHCASES MODE. + CAIL A,140 + SUBI A,40 + JRST SLP3+1 + +SLPLO1: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,140 + SUBI A,40 + JRST SLP2+1 + +SLPLO2: ILDB A,E ;COME HERE FROM SLP3 WHEN IGNORING CASE FOR LETTERS ONLY. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP3+1 + SUBI A,40 + JRST SLP3+1 + +SLPLO3: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP2+1 + SUBI A,40 + JRST SLP2+1 + +;HERE IF SEARCH FAILS TO FIND THE STRING. EITHER READ NEXT PAGE, OR COMMAND HAS FAILED. +LOSE: SKIPE PNCHFG ;IS IT AN N OR _ COMMAND? + SKIPL LASTPA ;IF SO, AND NOT AT EOF, TRY READING MORE FROM FILE. + JRST LOSE2 ;OTHERWISE, SEARCH HAS REALLY FAILED. + MOVEI C,1 ;MAYBE PUNCH ONCE + SETZM IMQUIT ;DON'T QUIT OUT OF I-O - MIGHT GARBLE FILE. + TRZ FF,FRARG + CALL [ SKIPGE PNCHFG ;PUNCH? + JRST PUNCHA ;YES + JRST YANK] ;NO + MOVE E,BEGV ;GET RANGE TO SEARCH = WHOLE BUFFER, + MOVE C,ZV + CALL GSAPCH ;SET BBP, ZBP. + JRST SRN2 ;SEARCH NEW BUFFER + +LOSE2: SETZM SFINDF ;SEARCH LOST, CLEAR FLAG FOR SEMICOLON + PUSHJ P,SRCV ;SET PT (IF THIS WAS REPEATED SEARCH, MAYBE WE FOUND IT ONCE). + TRZE FF,FRCLN ;IF COLON TYPED FOR SEARCH, + JRST NRET0 ;THEN RETURN 0 AS VALUE + MOVE TT,ITRPTR ;ARE WE WITHIN AN ITERATION? + TSC TT,ITRPTR ;(BUT ERRSETS DON'T COUNT). + TRNN TT,-1 + SKIPE PSSAVP ;OR ARE WE WITHIN A ^P-SORT? + SKIPE SRCERR ;YES. IF SRCERR IS 0, INHIBIT THE ERROR. + TYPRE [SFL] + RET + +WINNL1: MOVE E,C ;NULL SEARCH STRING FOUND. +;THIS SEARCH WINS, MAYBE DO SOME MORE +WIN: MOVEM C,TEM1 ;SAVE C, (BYTE POINTER TO FIRST CHARACTER IN FOUND STRING) + MOVEM E,TEM2 ;AND E, ( " TO LAST CHARACTER IN FOUND STRING) + SOSLE SEARG ;THIS LAST SEARCH? + JRST WIN3 ;NO, KEEP GOING +WIN1: PUSHJ P,SRCV ;PICK UP THE PIECES (ENTRY FOR FOUND NULL STRING AT END OF BUFFER) + TRZ B,-1 ;YES, CHASE DOWN LIST LOOKING FOR THIS LIST POINTER + MOVE C,@STBLP ;GET INITIAL POINTER + MOVNI A,1 ;INITIALIZE COUNT +WIN2: TRZ C,-1 ;CLEAR OUT RIGHT HALF OF THIS LIST ENTRY + CAME C,B ;IS THIS THE ONE? + JRA C,[SOJA A,WIN2] ;NO, TRY NEXT + MOVEM A,SFINDF ;STORE FS SVALUE$ + TRZE FF,FRCLN ;RETURN SFINDF AS VALUE IFF IT'S A ":S". + AOS (P) + RET + +;HERE TO SEARCH OVER AGAIN. CLEAN UP FOR RE-ENTERING SEARCH LOOP. +WIN3: TRNE FF,FRBACK + JRST WIN3R + MOVE BP,E + CALL GETCA ;BP GETS REAL CHAR ADDR CORRESPONDING TO END OF INSTANCE FOUND. + MOVE C,ZBP ;IF FORWARD, THEN START FROM END OF THE INSTANCE WE JUST FOUND (IN E), + CAMLE BP,GPT ;AND IF THAT MEANS SKIPPING OVER THE GAP, FIX UP ZBP1 TO MATCH ZBP. + MOVEM C,ZBP1 + MOVE C,E + JRST SRN2RP + +WIN3R: MOVE E,ZBP ;IF BACKWARD, START FROM BEGINNING OF WHAT WE FOUND, + MOVEM C,ZBP ;BUT PREVENT OVERLAP BY SETTING END OF RANGE TO THERE. + MOVE BP,C + CALL GETCA + CAME E,ZBP1 ;IF THE GAP WASN'T OR IS NO LONGER IN THE RANGE, + CAMGE BP,GPT + MOVEM C,ZBP1 ;THEN ZBP1 SHOULD EQUAL ZBP. + JRST SRN2RP + +;SEARCHING STARTING AT END OF BUFFER, DON'T WIN FOR FORWARD NON-NULL SEARCH + +WINNUL: MOVE A,[JRST WINNL1] ;SET UP A AS CONSTANT FOR COMPARISON AGAINST MEMORY +WINNL2: CAMN A,(B) ;IF AGREEMENT, + JRST WINNL1 ;THEN NULL COMPARISON STRING, WIN, KIND OF + CAME B,STBLPX ;IF THIS ISN'T LAST ENTRY IN TABLE, + JRA B,WINNL2 ;THEN TRY NEXT ONE + TRNN FF,FRBACK ;NO NON-NULL COMPARISON STRINGS, IF SEARCHING FORWARD, + JRST LOSE ;THEN LOSE + JRA B,SLP1E ;SEARCHING BACKWARDS => RE-INITIALIZE LIST POINTER, FALL IN + +;PICK UP PIECES FROM SEARCH; COMPUTE NEW VALUE OF PT. + +SRCV: SETZM IMQUIT + SKIPN BP,TEM2 ;GET POINTER TO LAST CHARACTER IN FOUND STRING + JRST SRCVX ;NO WINNERS THIS BUFFER + MOVE C,TEM1 ;GET POINTER TO FIRST CHARACTER IN FOUND STRING + TRNE FF,FRBACK ;IF SEARCH WAS BACKWARDS, + EXCH C,BP ;THEN REALLY WANT THEM INTERCHANGED + ;BP NOW HAS TECO'S . IN BYTE POINTER FORM + ;C HAS BYTE POINTER TO OTHER END OF STRING FOUND + PUSHJ P,GETCA ;CONVERT BP TO CHARACTER ADDRESS + EXCH BP,C ;GET OTHER BYTE POINTER IN BP + PUSHJ P,GETCA ;CONVERT TO CHARACTER ADDRESS + CAMLE C,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL, + SUB C,EXTRAC + CAMLE BP,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL. + SUB BP,EXTRAC + SUB BP,C ;DIFFERENCE = LENGTH OF LAST SEARCH STRING FOUND. + MOVEM C,PT ;GO THERE. +SRCVX: MOVNM BP,INSLEN ;STORE SIGNED LENGTH OF LAST SEARCH STRING FOUND + ;SIGN OF LLSSF IS OPPOSITE THAT OF ARG TO SEARCH FROM WHICH IT WAS SET + POPJ P, + +FKCMD: MOVN A,INSLEN ;"FK" - + JRST POPJ1 + +;FS S STRING$ - READ OR SET THE DEFAULT SEARCH STRING. +FSSSTR: CALL FSSSTV ;FIRST, CONS UP A STRING CONTAINING THE OLD VALUE. + TRZE FF,FRARG ;THEN, IF WE HAVE AN ARG, SET THE DEFAULT FROM IT: + CAMN C,[-1] ;ARG OF -1 MEANS "INVALID SEARCH STRING"; JUST DON'T SET. + JRST POPJ1 + JSP T,GCPUSA ;MUST SET. PUSH VALUE TO RETURN WHERE GC WILL RELOCATE IT. + MOVEI A,[ASCIZ /[0 U0 0S0 ]0/] + SAVE SFINDF + CALL MACXCP ;SET SEARCH STRING DEFAULT BY PASSING ARG TO AN S COMMAND. + REST SFINDF +;POP A GCPUSA'D VALUE AND RETURN IT AS COMMAND'S VALUE. +GCPOPV: REST LEV + SUB P,[1,,1] + JRST POPAJ1 + +GCPUSA: SAVE A ;PUSH THE VALUE IN A AND ARRANGE FOR GC TO RELOCATE IT + SAVE [0] ;WHILE IT IS ON THE STACK. THIS IS DONE BY MAKING + SAVE LEV ;IT LOOK LIKE A "(" BLOCK. + MOVEM P,LEV + JRST (T) + +;RETURN IN A A STRING CONTAINING THE CURRENT DEFAULT SEARCH STRING. PRESERVE C. +FSSSTV: MOVE E,SBFRP + MOVE CH,MFZV(E) + MOVE E,MFBEGV(E) + IDIVI E,5 ;GET WORD ADDR'S OF START AND END OF SEARCH TABLE. + IDIVI CH,5 + AOS E ;SKIP OVER THE VALID-WORD AT THE START. + SETO A, + SKIPN -1(E) ;BUT IF THE TABLE'S CONTENTS AREN'T VALID, RETURN -1. + POPJ P, + SAVE C ;ELSE WE'LL RETURN A STRING. WHAT'S A BOUND ON LENGTH WE NEED? + SAVE [POPCJ] + MOVE C,CH + SUB C,E ;TWICE LENGTH OF SEARCH TABLE IS ENOUGH. + LSH C,1 + CALL QOPEN ;ALLOCATE THAT SPACE, SET UP LISTF5 TO STORE INTO STRING. + AOS E ;SKIP THE FIRST POINTER-PAIR IN THE SEARCH TABLE. +FSSSTL: SETZ C, + HLRZ TT,(E) ;GET LH AND RH OF NEXT SEARCH TABLE WORD. + HRRZ TT1,(E) + CAIN TT1,SLP1P ;SLP1P IN RH IDENTIFIES END OF SEARCH TABLE + JRST QCLOSV ;SO FINISH UP THE STRING'S HEADER AND RETURN IT. + CAIL TT1,HUSED ;AN RH THAT'S AN ADDRESS IN BUFFER SPACE + JRST [ MOVEI CH,^O ;INDICATES A DIVISION BETWEEN ALTERNATIVE STRINGS, + JRST FSSST2] ;SO WE NEED A ^O FOR IT. + CAIN TT,(JRST) ;JRST INSN MUST BE JRST WIN OR WINNUL, WHICH IS AT THE END OF + AOJA E,FSSSTL ;EVERY ALTERNATIVE. IT CORRESPONDS TO NO CHAR IN USER'S ARG. + CAIN TT,(JFCL) + MOVSI C,(ASCII //) ;JFCL IS GENERATED BY A ^X. + CAIN TT,(CAIA) + MOVSI C,(ASCII //) ;CAIA COMES FROM A ^N^X. + CAIN TT1,SKNBRK + MOVSI C,(ASCII //) ;CALL SKNBRK COMES FROM ^B. + CAIN TT1,SKBRK + MOVSI C,(ASCII //) ;CALL SKBRK COMES FROM ^N^B. + JUMPE C,FSSST1 ;ANYTHING ELSE MUST BE ORDINARY, OR A ^N. + MOVEI A,C + CALL ASCIND ;IF ^X OR ^B, OR ^N OF ONE, STORE IN STRING THE STUFF IN C. + AOJA E,FSSSTL + +FSSST1: MOVEI CH,^N + CAIN TT,(CAIE A,) ;DECIDE BETWEEN ORDINARY CHAR AND ^N'D CHARACTER. + XCT LISTF5 + MOVEI CH,^Q ;IF CHAR IS ONE THAT WOULD BE SPECIAL, MUST QUOTE IT. + CAIE TT1,^B + CAIN TT1,^X + XCT LISTF5 + CAIE TT1,^Q + CAIN TT1,^O + XCT LISTF5 + CAIN TT1,^N + XCT LISTF5 + MOVE CH,TT1 ;[ + CAIN CH,^] + XCT LISTF5 ;[ ;^] HAS ITS OWN WAY TO BE QUOTED. +FSSST2: XCT LISTF5 + AOJA E,FSSSTL + +SUBTTL ..D DELIMITER DISPATCH USAGE + +;SKNBRK SKIPS UNLESS THE CHARACTER IN A IS A DELIMITER CHARACTER. +;THE SET OF DELIMITERS IS DEFINED BY THE CONTENTS OF QREG ..D, +;WHICH SHOULD BE A STRING CONTAINING 5*128. CHARACTERS, FORMING A +;DISPATCH TABLE. EACH ASCII CHAR HAS A 5-CHAR DISPATCH ENTRY WHOSE +;FIRST TWO CHARACTERS ONLY ARE SIGNIFICANT. +;THE FIRST CHARACTER IS THE MOST GENERAL: IF IT IS NOT A SPACE, THEN +;THE CHARACTER WHOSE ENTRY IT IS IS NOT A DELIMITER. +;INITIALLY ALL NON-SQUOZE CHARACTERS ARE DELIMITERS. +;THE SECOND CHARACTER SAYS HOW LISP HANDLES THE CHAR BEING HANDLED. +;THE POSSIBLE DISPATCH CHARS ARE "(", ")", "/", "|", "A" AND " ". +;SKNBRK ASSUMES THAT SKNBPT HAS BEEN SET UP BY SKNBCP ALREADY. +;CLOBBERS D. +SKNBRK: LDB D,SKNBPT + CAIN D,"A + AOS (P) + RET + +DQT3: CALL SKNBCP ;SKIP IF CHAR IN C IS DELIMITER; RECOMPUTES SKNBPT. + MOVE A,C +SKBRK: LDB D,SKNBPT ;SKIP IF CHAR IN A IS DELIM. SKNBCP SHOULD HAVE BEEN CALLED. + CAIE D,"A + AOS (P) + RET + +;LOOK AT QREG ..D, AND SET UP SKNBPT FOR USE BY SKNBRK. +SKNBCP: MOVE CH,QRB.. + ADDI CH,.QDLIM + CALL QLGET ;BP _ BP TO TEXT. + TYPRE [QNS] + CAIGE B,5*200 ;NOT LONG ENOUGH => ERROR. + TYPRE [STS] + IBP BP ;BP HAS BP TO LDB 1ST CHAR. + TLO BP,A ;LDB BP TO GET DISPATCH OF CHAR IN A. + MOVEM BP,SKNBPT + RET + +;; ^B COMMAND: GO TO BEGINNING OF BUFFER IF LAST SEARCH WAS BACKWARD AND FAILED, +;; OR TO END IF LAST SEARCH WAS FORWARD AND FAILED. SET FS INSLEN$ TO 0 EITHER WAY. +;; IF LAST SEARCH SUCCEEDED, DON'T MOVE, AND DON'T CHANGE FS INSLEN$. +;; WITH COLON FLAG, IF SEARCH WAS SUCCESSFUL DO FKC. +CTLB: TRZ FF,FRARG\FRARG2 + MOVN C,INSLEN + SKIPE SFINDF + JRST [ TRZE FF,FRCLN + JRST REVER1 + RET] + SETZM INSLEN + HRRZ A,SLP1P + CAIE A,SLP1D ;WAS LAST SEARCH FORWARD? + SKIPA A,SRCEND ;IF SO, GO TO END + MOVE A,SRCBEG ;ELSE GO TO BEGINNING. + ADD A,BEG + MOVEM A,PT + RET + +SUBTTL F AND FS COMMAND DISPATCH + +;F-COMMAND SUBDISPATCH. +FCMD: PUSHJ P,LRCH + XCT FDTB(CH) + POPJ P, + JRST POPJ1 + +;FS COMMAND. +FSET: MOVE B,[440600,,D] + MOVE E,[440600,,J] + SETO BP, + SETZB D,J +;D GETS THE SPEC'D NAME; J GETS MASK TO THOSE CHARS IN THE WORD WHICH WERE SPEC'D. +FSLUP: CALL RCH + ANDI CH,-1 + TRNE CH,100 + ANDCMI CH,40 ;CONVERT TO LOWER CASE. + CAILE CH,40 + JRST FSCHAR ;NON-CONTROLS ARE FOR REAL. + CAIN CH,ALTMOD + SKIPGE SQUOTP ;ALTMODE ENDS NAME UNLESS SUPERQUOTED. + CAIA ;OTHERWISE, ^X IS TREATED AS IF IT WERE AN UPARROW AND AN X. + JRST FSLKUP + MOVEI TT,'^ + CAIE CH,40 ;SPACE, UNLIKE CTL CHARS, IS JUST IGNORED. + TLNN B,770000 ;CTL CHARS ALSO IGNORED IF ALREADY HAVE 6 CHARS. + JRST FSLUP + IDPB TT,B + IDPB BP,E + +FSCHAR: HRREI CH,-40(CH) ;GET SIXBIT, IGNORING LH SINCE MIGHT BE -1 + TLNE B,770000 ;[ ;IF THE CHAR WAS QUOTED WITH ^]^Q + IDPB CH,B + TLNE E,770000 + IDPB BP,E + JRST FSLUP + +FSLKUP: MOVE B,[-FLAGSL*2,,FLAGS] + +;BINARY SEARCH IN VECTOR OF FLAGS <- AOBJN IN B +;FOR VALUE IN D. CLOBBERS B,E,TT. +FSLUKB: HLRE E,B + HRLI B,E ;B IS INDEX OF E. + MOVNS TT,E +;B -> INSIDE AREA, IDX OF E. +;E = SIZE OF LAST STEP. +;TT = # WDS LEFT IN PART OF AREA AFTER B. +;LEAVES B POINTING TO LAST FLAG WHOSE NAME IS < DESIRED NAME +;(NOTE: IF ALL FLAGS ARE >= DESIRED NAME, B -> 1ST FLAG). +;THEN GOES TO FSLUK1. +FSLUK0: CAILE E,(TT) ;E_MAX(LAST STEP,SPACE LEFT) + MOVEI E,(TT) + CAIN E,2 ;ONLY 1 ENTRY TO SEARCH THRU => DONE. + JRST FSLUK1 + LSH E,-1 ;STEP = .5* SIZE OF STUFF TO SEARCH. + TRZE E,1 ;ROUND UP TO EVEN NUMBER. + ADDI E,2 + CAMG D,@B ;E.A. IS RH(B)+STEP. + JRST FSLUK0 ;THAT'S TOO FAR, DON'T MOVE B. + HRRI B,@B ;NOT TOO FAR, SET PTR THERE. + SUBI TT,(E) ;WE'RE CLOSER TO END NOW. + JRST FSLUK0 + +FSLUK1: CAMLE D,(B) ;(THIS PREVENTS LOSSAGE IF SUPPOSED TO FIND 1ST FLAG IN TABLE) + ADDI B,2 + MOVEI B,-FLAGS(B) ;POINT TO 1ST FLAG GREATER THAN OR EQUAL TO DESIRED. + MOVE E,FLAGS(B) + AND E,J ;IF THIS FLAG DOESN'T MATCH SPEC'D NAME, NONE DOES. + CAME D,E + TYPRE [IFN] + CAMN D,FLAGS(B) ;EXACT MATCH IS NEVER CONSIDERED AMBIGUOUS. + JRST FSFND + MOVE E,FLAGS+2(B) ;ELSE, DOES THE NEXT FLAG AFTER THE ONE FOUND + AND E,J ;ALSO MATCH THE SPECIFIED NAME? + CAMN D,E + TYPRE [AFN] ;YES - SPEC'D NAME IS AMBIGUOUS. +FSFND: MOVS E,FLAGD(B) + HRLM B,(P) +FSCALL: CALL (E) ;SOME ROUTINES WILL DEPOSIT IN -1(P)! THEY ALL CREF FSCALL. + RET ;(THEIR GOAL IS TO FAKE OUT FPUSH VIA THE INSN AT .+1) + HLRZ E,(P) ;FOR FLAGS THAT RETURN VALUE, MAKE SURE INDEX OF FLAG IS + JRST POPJ1 ;IN E, FOR FPUSH TO WORK. + +SUBTTL FS FLAG ROUTINES + +;[ ;F]$ POPS QREG PDL INTO THAT FLAG. +;[ ;F]^RCMAC$ WORKS, ETC. +FPOP: MOVEI CH,E ;CH HAS ADDR TO POP INTO. + CALL CLOSB2 + TRON FF,FRARG + SKIPA C,E ;MAKE POPPED VALUE COME BEFORE ANY SPEC'D ARG. + TRO FF,FRARG2 + CALL FSET ;SET THE FLAG, RETURNING THE OLD VALUE OF THE FLAG. + JFCL + RET ;RETURN NO VALUE. + +;F[$ PUSHES THAT FLAG ONTO THE QREG PDL. +;F[^RCMAC$, ETC., WORK. ;]] +FPUSH: MOVE B,PF ;IF WE ARE ABOUT TO OVERFLOW QREG PDL, DETECT THAT + CAMN B,PFTOP ;BEFORE SETTING THE FLAG. + JRST OPENB1 + CALL FSET ;DO FS$, WHICH LEAVES INDEX IN FLAGD IN E. + TYPRE [WNA] ;FLAG HAS NO VALUE, AND YOU WANT TO PUSH IT?? + TRNE FF,FRARG2 ;BARF IF TRY TO PUSH FS BOUNDARIES$, SINCE IT DOESN'T WIN. + TYPRE [WNA] + MOVEI CH,A + CALL OPENB2 ;PUSH THE VALUE FROM A, WHERE FSET LEFT IT, + MOVEM E,(B) ;THEN SET "WHERE PUSHED FROM" FIELD TO THE INDEX OF THIS + ;FLAG IN THE FLAGS TABLE, + ;THUS TELLING AUTO-UNWIND TO POP THE FLAG BY DOING FPOP. + RET + +;HERE ARE THE COMMONLY USED FS FLAG ROUTINES. + +IFN ITS,FSSTRR:: FSDSNM:: FSNQIT:: FSDIRH:: +IFN TNX,FSFVER:: +FSNORM: HLRZS E ;HERE TO READ/SET NORMAL FLAG; E -> WORD HOLDING VALUE. +FSNOR1: MOVE A,(E) +FSNOR2: ARGDFL + TRZN FF,FRARG + JRST POPJ1 + MOVEM C,(E) + CAIE E,CASNRM ;IF SET CASNRM, ALSO SET CASDIS. + JRST POPJ1 + ANDI C,1 + MOVEM C,CASDIS + JRST POPJ1 + +FSVAL: HLRZ A,E ;HERE TO RETURN CONSTANT VALUE (AS FOR FS VERSIO$) + JRST POPJ1 + +IFN ITS,[ +FSRSYS: HRRI E,A ;HERE TO READ A PARTICULAR .SUSET VAR (AS FOR FS OPTION$) + .SUSET E + JRST POPJ1 + +FSOPTL: .SUSET [.ROPTIO,,B] ;READ BIT IN LH OF .OPTION. C SAYS WHICH BIT. + JRST FSBIT1 +] + +FSRNLY: MOVE A,E ;READ-ONLY FLAG'S ADDR IN LH(E) + JRA A,POPJ1 + +FSROCA: MOVE A,E ;READ ONLY CHAR. ADDR, RETURN RELATIVE TO BEG. + JRA A,FSROC1 + +FSWBIT: ARGDFL + HRRI E,FF ;HERE IF WE WANT TO BE ABLE TO WRITE A BIT AS WELL AS READ IT. + MOVE B,FF ;LH(E) HAS B.P. L.H., AND WE ASSUME THE BIT IS IN FF. + SKIPE C ;WE MUST SAVE THE OLD FF SO WE CAN RETURN THE OLD SETTING OF THE BIT. + SETO C, ;ANY NONZERO ARG MEANS TURN THE BIT TO 1. + TRNE FF,FRARG + DPB C,E + CAMN E,[.BP FRTRACE] + CALL QUEST1 ;IF THE BIT JUST CHANGED IS FRTRACE, SET TRACS TOO. + JRST FSBIT1 + +FSBIT: SKIPA B,FF ;LH(E) HAS B.P. L.H., TO FETCH BIT IN FF. +FSTTOL: HLLZ B,TTYOPT ;TEST BIT IN LH(TTYOPT). +FSBIT1: HRRI E,B + LDB E,E ;FETCH THE DESIRED BIT. + SKIPN E +NRET0: TDZA A,A ;VALUE IS 0 IF BIT CLEAR, +NRETM1: SETO A, ;-1 IF SET. + JRST POPJ1 + +;ALTCOUNT FLAG, # COMMAND STRINGS TYPED AHEAD BY USER. +FSALTC: CALL VBDACU ;DO LISTEN TO UPDATE TSALTC, + JFCL + JRST FSNORM ;THEN DO NORMAL FS ON TSALTC. + +;READ OR SET # OF COMMAND LINES. +FSECLS: MOVE A,NELNS ;GET CURRENT # OF CMD LINES, + ARGDFL + TRZE FF,FRARG + CALL FSECL1 ;AND SET IT IF NEC. + JRST POPJ1 + +;DESIRED # ECHO LINES IN C. (OR - => NO ECHO, BUT -1 ECHO LINES) +FSECL1: SKIPGE E,C ;GET ARG IF POSITIVE, + SETCA E, ;OR -1-ARG IF NEGATIVE. + CAML E,NVLNS ;VALUE TOO LARGE => WOULD CRASH TECO. + TYPRE [AOR] + SKIPN RGETTY + JRST FSECL3 + MOVE T,NVLNS + SUB T,NELNS ;IN CASE WE ARE REDUCING NELNS, ZERO OUT HASH CODES OF ALL LINES +FSECL2: SETOM HCDS-1(T) ;THAT WERE PREVIOUSLY IN THE ECHO AREA (AND THE OLD MORE LINE). + CAME T,NVLNS + AOJA T,FSECL2 +FSECL3: MOVEM C,NELNS + MOVE C,NVLNS ;TOTAL # LINES - # ECHO LINES + SUB C,E +IFN TNX,[ + MOVEM C,ECHOL0 ;SAVE FIRST LINE OF ECHO AREA + HRLZM C,ECHOPS ;AND SET UP AS NEW ECHO POSITION +] + SUBI C,1 ;DEDUCT 1 LINE FOR THE --MORE-- + MOVEM C,USZ ;= # LINES FOR BUFFER DISPLAY. +IFN ITS,[ + ADDI C,10 + DPB C,[MORMCV] +] +IFN TNX,CALL MCLSET ;SET UP STRING THAT WILL CLEAR LINE IN C IN MORMCL + SETOM DISOMD ;INDICATE DISPLAYED "MODE" (Q..J) IS OUT OF DATE. +IFN ITS,[ + SYSCAL SCML,[%CLIMM,,CHTTYI ? E] + .LOSE %LSFIL +] + SKIPE ECHOFL ;IF ECHOING NOMINALLY "ON" (THAT IS, NOT OFF DUE TO ^R OR ^T) + CALL SETTTM ;THEN MAYBE CHANGING THIS FLAG TURNS IT OFF OR ON. + SETOM TYOFLG ;USZ HAS CHANGED, SO MAKE SURE TYPEOUT KNOWS ABOUT IT. + RET + +FSWIDTH:TRNE FF,FRARG + CAIG C,MXNHLS + JRST FSNORM + TYPRE [AOR] + +IFN 20X,[ +FSTTPG: MOVE A,PAGMOD ;GET CURRENT PAGE MODE STATE + TRNE FF,FRARG ;IF ANY ARG + MOVEM C,PAGMOD ;SETUP NEW ONE + JUMPGE C,CPOPJ1 ;AND IF NOT -1, DONT NEED TO CHANGE YET + SAVE A + MOVEI A,.PRIOU + RFMOD + TRON B,TT%PGM ;TURN ON PAGE MODE WHILE IN TECO + STPAR + REST A + JRST CPOPJ1 +] + +FSRUNT: +IFN ITS,[ + .SUSET [.RRUNT,,A] + MULI A,4069. ;CONVERT TO NANOSEC., + DIV A,[1.^6] ;THEN TO MILLISEC. +] +IFN TNX,[ + MOVEI A,.FHSLF ;THIS FORK + RUNTM ;RUNTIME IN MS. +] + JRST POPJ1 + +FSUPTI: +IFN ITS,.RDTIME A, ;RETURN THE SYSTEM UP TIME - FS UPTIME $ +IFN TNX,TIME ;SYSTEM UPTIME IN MS. + JRST POPJ1 + +FSSWIT: +IFN ITS,.RDSW A, +IFN TNX,SWTCH ;FOR WHAT ITS WORTH + JRST POPJ1 ;RETURN PDP10 CONSOLE SWITCHES. + +FSDDFS: MOVE A,DEFDEV ;RETURN -1 IF DEFAULT DEVICE IS "FAST". +IFN ITS,CAME A,MACHINE +IFN TNX,CAME A,[ASCII/DSK/] + JRST NRET0 + JRST NRETM1 + +IFN ITS,[ +..RHSNAM==16 ? ..RMAIL==17 + +;,FS U HSNAME$ RETURNS IN SIXBIT THE HSNAME OF ON MACHINE . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED FOR THE CURRENT MACHINE. +FSUHSN: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RHSNAM,,A] + MOVE A,B + TRZ FF,FRARG\FRARG2 + JRST POPJ1 + +;,FS UMAIL$ SETS DEFAULT FILENAMES TO MAIL FILE OF ON . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED MEANING USE THAT USER'S HOME MACHINE. +FSUML: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RMAIL,,A] + MOVEM A,DEFDEV + MOVEM B,DEFFN1 + MOVEM C,DEFDIR + MOVE A,[SIXBIT /MAIL/] + MOVEM A,DEFFN2 + RET +];IFN ITS + +FSEJPG: MOVE A,LHIPAG ;READ OR WRITE FS :EJ PAGE$. + ARGDFL + TRZN FF,FRARG + JRST POPJ1 + CAML C,LHIPAG ;ILLEGAL TO SET IT TO A SMALLER VALUE SINCE PAGES DON'T EXIST. + CAILE C,LHIMAX ;ILLEGAL TO SET ABOVE TOP OF ADDRESS SPACE. + TYPRE [AOR] + EXCH C,LHIPAG +;NOW FLUSH THE PAGES WE HAVE REMOVED FROM PURE STRING SPACE. +IFN ITS,[ + MOVE B,C + SUB B,LHIPAG ;B GETS MINUS NUMBER OF PAGES FS :EJPAGE$ HAS ADVANCED OVER. + JUMPE B,POPJ1 + HRL C,B ;C GETS AOBJN TO PAGES TO BE FLUSHED. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? C] + .LOSE %LSSYS +];IFN ITS +IFN TNX,[ + MOVE B,C + SUB C,LHIPAG ;NEGATIVE NUMBER OF K + JUMPE C,POPJ1 + MOVM C,C + LSHC B,1 ;TRANSLATE FROM K TO PAGES. + HRLI B,.FHSLF ;THIS FORK + SAVE A ;PRESERVE WHAT FS EJPAGE IS GOING TO RETURN. + SETO A, +IFN 20X,[ + HRLI C,(PM%CNT) ;COUNT GIVEN + PMAP +];IFN 20X +IFN 10X,[ +FSEJP1: PMAP + SOJLE C,FSEJP2 + AOJA B,FSEJP1 +FSEJP2: +];IFN 10X + REST A +];IFN TNX + JRST POPJ1 + +;RETURN CURRENT DATE/TIME IN DISK FILE DATE FORMAT. +FSDATE: +IFN ITS,[ + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS +] +IFN TNX,GTAD ;GET TIME IN SYSTEM INTERNAL FORMAT (ASSUME WILL + JRST POPJ1 ;BE PASSED ALONG TO FS F DCONV$ UNMUNGED) + +FSFDAT: +IFN ITS,[ + HLRZS E ;CREATION DATE OF FILE ON CHNL IN LH(E) + ARGDFL + SYSCAL RFDATE,[E ? %CLOUT,,A] + JRST OPNER1 + TRZN FF,FRARG + JRST POPJ1 + SYSCAL SFDATE,[E ? C] + JRST OPNER1 + JRST POPJ1 +] +IFN TNX,[ + HLRZS E + MOVE A,(E) ;GET THE JFN + ARGDFL + SAVE C ;SAVE ANY ARG + MOVE B,[1,,.FBWRT] + MOVEI C,A + GTFDB ;GET THE OLD WRITE DATE + REST C + TRZN FF,FRARG ;WRITING ON THIS FLAG? + JRST POPJ1 ;NO, JUST RETURN +FSFDT2: SAVE A + MOVE A,(E) + SETO B, + HRLI A,.FBWRT + CHFDB ;YES, CHANGE IT + REST A ;AND RETURN OLD VALUE + JRST POPJ1 +] + +;"FS FDCONV $" IS LIKE "\" BUT HANDLES FILE DATES INSTEAD NUMBERS. +FSDCNV: TRNE FF,FRARG + JRST FSDCN2 ;ARG => GO TURN IT INTO STRING IN BUFFER + JRST FSDCNI ;ELSE PARSE A DATE OUT OF THE BUFFER. + +IFN ITS,[ +FSDCNI: SAVE [0] ;PUSH WORD TO ACCUM. THE DATE IN. +FSDCN0: MOVE OUT,[-6,, [40,, ;MONTH + 1,, ;DAY + 1000,, ;YEAR + 3600.*2 ;HOUR (IN TERMS OF 1/2 SEC) + 60.*2 ;MINUTE + 2]] ;SECOND + JRST FSDCN4 + +FSDCN3: MOVE IN,PT + CAMN IN,ZV ;AT END OF BUFFER => RETURN WHAT WE HAVE + JRST FSDCN1 + CALL GETINC + CAIN CH,^M ;STOP BEFORE A CR. + JRST FSDCN1 + AOS PT ;ELSE MOVE OVER DELIMITER +FSDCN4: MOVE Q,PT + SAVE OUT + CALL BAKSL ;READ THE NEXT NUMBER + JFCL + REST OUT + CAMN Q,PT + JRST FSDCN1 ;NO NUMBER => FINISHED. + IMUL A,(OUT) ;ELSE PUT THIS # IN RIGHT PLACE + ADDM A,(P) ;IN THE DATE BEING ACCUMULATED. + AOBJN OUT,FSDCN3 ;HAVEN'T READ ALL 6 YET => KEEP GOING. +FSDCN1: REST A ;A HAS DATE TO RETURN. + CAMN OUT,@FSDCN0 ;IF DATE IN BUFFER WAS NULL, + SETO A, ;RETURN -1 + JRST POPJ1 + +FSDCN2: MOVEM C,PTLFCD + MOVEI TT,TYOM + HRRM TT,LISTF5 ;PRINT THE DATE INTO MEMORY. + CALL [ TRNN FF,FRCLN + JRST GAPSLP + MOVEI C,18. + JRST QOPEN] + SKIPL PTLFCD ;DATE IS -1 => LEAVE EMPTY. + CALL PTLAB9 + JRST SLPXIT +] ;IFN ITS + +IFN TNX,[ +FSDCNI: CALL GAPSL0 ;MOVE GAP TO PT, BUT ARENT MUNGING BUFFER + CALL GETIB. ;GET BYTE POINTER TO . + MOVE A,BP + SETZ B, + IDTIM ;READ IN TIME + SETO B, +IFN 20X,DBP7 A ;MAKE RESULTING BYTE POSITIONS CONSISTANT + MOVE BP,A ;GET UPDATED BYTE POINTER + CALL GETCA ;GET CHARACTER ADDR + SUB BP,EXTRAC ;MOVE OVER GAP + MOVEM BP,PT ;UPDATE . + MOVE A,B ;VALUE TO RETURN + JRST POPJ1 + +FSDCN2: MOVEI A,TYOM ;INTO BUFFER + HRRM A,LISTF5 + HRROI A,BAKTAB ;STRING SPACE + MOVE B,C + TRNE FF,FRARG2 + SKIPA C,SARG ;USE ANY SECOND ARG AS THE FORMAT + MOVSI C,(OT%NMN\OT%DAM\OT%SLA) ;ELSE DEFAULT TO DD/MM/YY HH:MM:SS + ODTIM + LDB C,[350700,,BAKTAB] ;IF ITS FORMAT, MUST MAKE UP FOR ODTIM LOSSAGE + TRNN FF,FRARG2 + CAIE C,40 + JRST FSDCN3 + MOVEI C,"0 ;BY CONVERTING LEADING SPACE TO 0 + DPB C,[350700,,BAKTAB] +FSDCN3: MOVEI C,20. ;MAKE ENOUGH ROOM + CALL [ TRNN FF,FRCLN + JRST GAPSLP + JRST QOPEN] + MOVEI A,BAKTAB + CALL ASCIND ;INSERT IT + JRST SLPXIT + +FSJOBN: GJINF ;GET JOB NUMBER + MOVEI A,(C) + JRST CPOPJ1 + +FSGTNM: GETNM ;GET SIXBIT JOB NAME + MOVE C,A ;SET UP AS AN ARG + JRST FSIXST ;AND GO MAKE A STRING OF IT + +FSMACH: MOVE A,[SIXBIT/LHOSTN/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; GET LOCAL HOST NO. + JUMPE B,FSMAC1 ; TRY ALTERNATIVE METHOD IF NO LHOSTN + JUMPL A,FSMAC1 ; OR IF LHOSTN IS NEGATIVE (TOPS-20 RELEASE 3 + ; HAS A LHOSTN ENTRY ON ALL SYSTEMS) + MOVE B,A + HRROI A,BAKTAB + CVHST ; CONVERT HOST NO. TO NAME + JRST FSMAC1 ; NO STRING FOR THAT HOST + MOVEI B,0 ; MAKE SURE STRING IS ASCIZ + IDPB B,A ; ... + JRST FSSTR3 +FSMAC1: SETZM BAKTAB ; FOR THE MOMENT RETURN 0 + JRST FSSTR3 + +FSCCLF: SKIPN A,CCLJFN ;FS CCL FNA$ - IF STARTED AT +2, ... + JRST CPOPJ1 ;NOT, RETURN 0 + MOVEI B,(A) + HRROI A,BAKTAB ;RETURN STRING OF JFN GIVEN + MOVE C,[111110,,000001] ;AS DSK:NAM.EXT.GEN + JFNS + MOVEI A,(B) + RLJFN + JFCL + SETZM CCLJFN ;DONT HAVE STRAY JFNS AROUND LATER + JRST FSSTR3 ;MOVE STRING FROM BAKTAB AND RETURN STRING POINTER + +FSNQIT: MOVE A,NOQUIT ;GET PREVIOUS SETTING + ARGDFL + TRZN FF,FRARG ;IF NO ARG, + JRST POPJ1 ;RETURN IT + MOVEM C,NOQUIT ;SETUP NEW ONE + JUMPG A,FSNQT2 ;CHANGING FROM POSITIVE + JUMPLE C,POPJ1 ;IF NOT CHANGING TO POSITIVE, NOTHING TO DO + SAVE A + MOVEI A,.TICCG + DTI ;ELSE TURN OFF ^G INTERRUPT + JRST POPAJ1 +FSNQT2: JUMPG C,POPJ1 ;NOTHING IF CHANGING TO POSITIVE + SAVE A + MOVSI A,.TICCG ;ELSE RE-ASSIGN ^G INTERRUPT + ATI + JRST POPAJ1 + +FSLOAD: MOVE A,[SIXBIT/SYSTAT/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; FIND TABLE NO. OF SYSTAT TABLE + JUMPE B,FSLOA1 ; IF NOT FOUND THEN RETURN ZERO + MOVEI A,(B) ; GETAB ARG: TABLE NO. IN RH + HRLI A,14 ; AND OFFSET IN LH + GETAB ; GET ENTRY 14 OF SYSTAT TABLE: 1 MINUTE LOAD + ; AVERAGE + TDZA B,B ; IF ERROR RETURN ZERO + MOVE B,A +FSLOA1: HRROI A,BAKTAB + MOVE C,[FL%ONE\FL%PNT\020200] + JSYS 233 ;FLOUT MAYBE SHOULD BE RENAMED + SETZM BAKTAB + JRST FSSTR3 +];IFN TNX + +IFN TNX,[ + +FSDIRH: MOVE B,HSNAME ;HOME DIRECTORY + JRST FSDIR3 +FSDIR2: GJINF + SKIPA B,A ;LOGIN DIR +FSDIRS: GJINF ;CONNECTED DIR +FSDIR3: HRROI A,BAKTAB + DIRST ;INTO STRING SPACE + SETZM BAKTAB +FSSTR3: MOVEI E,BAKTAB +FSSTR0: MOVEI C,10 ;GET ENOUGH STRING + CALL QOPEN + MOVEI A,(E) + CALL ASCIND ;INSERT IT +FSSTR2: CALL QCLOSV ;AND RETURN STRING POINTER + JRST POPJ1 + +FSDSNM: TRO FF,FRNOT ;FLAG TO FLUSH DIRST PUNCTUATION +FSSTRR: HLRZS E ;GET DESIRED ADDRESS + TRZN FF,FRARG ;ANY ARG? + JRST FSSTR0 ;NO, RETURN THE STRING THEN + HRLI E,440700 ;MAKE BYTE POINTER + SKIPL A,C ;GET ARG - SHOULD BE A STRING + CAIA + CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING + TYPRE [ARG] ;NOT A STRING? +FSSTR1: ILDB CH,BP + TRNE CH,100 ;MAKE SURE IS UPPERCASE + TRZ CH,40 + CAIN CH,": ;LOOK LIKE STRUCTURE PUNCTUATION FROM DIRST + TRNN FF,FRNOT ;AND ON THE LOOKOUT FOR THAT? + CAIA + JRST FSDSN2 ;YES, GO HANDLE THAT + CAIE CH,"< + CAIN CH,"> ;IF PART OF DIRECTORY PUNCTUATION + TRNN FF,FRNOT ;AND LOOKING FOR IT - SKIP MOVING CHAR + IDPB CH,E + SOJG B,FSSTR1 ;MOVE STRING INTO DESIRED PLACE + MOVEI CH,^@ ;AND END WITH A NULL + IDPB CH,E + RET +FSDSN2: MOVEI CH,^@ + IDPB CH,E + MOVE CH,DEFDIR ;IF : SEEN IN DIRECTORY, MOVE STRUCTURE + MOVEM CH,DEFDEV ;OVER TO DEVICE + MOVE CH,DEFDIR+1 + MOVEM CH,DEFDEV+1 + MOVE E,[440700,,DEFDIR] ;AND RESET POINTER TO DIRECTORY + SOJA B,FSSTR1 +] ;IFN TNX + +;RETURN THE HORIZ POS. OF THE CURRENT POINTER SETTING, +;ASSUMING THAT BACKSPACES AND STRAY CR'S COME OUT AS SUCH. +; ^HPRINT AND ^MPRINT FLAGS ARE NOT LOOKED AT. +FSHPOS: MOVE BP,BEGV + SOS C,BP + SETZ A, + MOVE BP,PT + CAMN BP,BEGV + JRST POPJ1 + MOVE IN,BP + SOS BP +FSHPOL: SOS IN + CALL GETCHR + CAIE CH,^M + CAMN C,IN + JRST FSHPOT + JRST FSHPOL + +FSHPOD: AOS IN + CALL GETCHR + CAIE CH,^J + CAIN CH,GLITCH + JRST FSHPOT + CAIN CH,^I + JRST [ ADDI A,10 + TRZ A,7 + JRST FSHPOT] + CAIN CH,ALTMOD + AOJA A,FSHPOT + CAIN CH,^H + SOJA A,FSHPOT + CAIGE CH," + AOJ A, + AOJ A, +FSHPOT: CAME IN,BP + JRST FSHPOD + JRST POPJ1 + +;RETURN HPOS COUNTING CTL CHARS AS THEY APPEAR, BUT NOT COUNTING CONTINUATION. +FSSHPS: SAVE NHLNS + .I NHLNS=1000000. + CALL RRBTCR + MOVE A,RRHPOS + REST NHLNS + SAVE A + CALL RRBTCR + REST A + JRST POPJ1 + +;READ OR SET THE VIRTUAL BUFFER BOUNDARIES - THE RANGE OF +;BUFFER THAT ALL OTHER COMMANDS ARE ALLOWED TO TOUCH. +FSBOUN: TRNN FF,FRARG + JRST HOLE ;NO ARG => RETURN BOUNDS, LIKE H COMMAND + MOVE E,SARG + CALL GETARG ;ELSE CALCULATE NEW BOUNDS, + CALL CHK1A + CALL HOLE ;SET UP THE VALUES TO BE RETURNED, + JFCL +FSBOU1: CALL CHK1A ;MAKE SURE BEG CONVERT STRING ARG TO "SIXBIT", SAME AS :I*. + MOVE A,C + TRZE FF,FRUPRW+FRCLN + JRST POPJ1 ;:F6 CONVERTS "SIXBIT" TO STRING: RETURN THE ARG. + JRST QGET4 ;F6 INSERTS "SIXBIT" ARG IN BUFFER: ENTER "G" COMMAND. +] + +IFN ITS,[ +;F6 COMMAND. +FSIXB: TRZN FF,FRARG + JRST FSIXR ;NO ARG => READ IN STRING AND CONVERT TO SIXBIT. + TRZE FF,FRUPRW+FRCLN ; :F6 RETURNS STRING CONTAINING THE CHARS OF THE SIXBIT. + JRST FSIXST + MOVE E,C ;TREAT ARG AS WD OF SIXBIT AND INSERT IN BUFFER. + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + JRST SIXNTY ;GO INSERT THE SIXBIT. +] + +;READ IN A STRING , AND RETURN CONVERTED TO SIXBIT IN A. IGNORE CONTROL CHARS. SKIPS. +FSIXR: MOVE OUT,[440600,,A] + SETZ A, +FSIXRL: CALL LRCH + CAIN CH,ALTMOD + JRST POPJ1 + CAIL CH,40 + TLNN OUT,770000 + JRST FSIXRL + SUBI CH,40 + IDPB CH,OUT + JRST FSIXRL + +FSIXST: AOS (P) ;HERE TO CONVERT SIXBIT TO STRING. + SAVE C + MOVEI C,12. ;WE WILL NEED AT MOST 12 CHARS - MAKE SURE SPACE IS THERE. + CALL QOPEN + REST E ;NOW OUTPUT THE SIXBIT INTO STRING SPACE (LISTF5 AND BP + CALL SIXNTY ;SET UP BY QOPEN). + JRST QCLOSV ;WRITE THE HEADER AND RETURN THE STRING POINTER. + +FSIXFL: AOS (P) ;CONVERT SIXBIT TO STRING, PUTTING "FS" IN FRONT AND ALTMODE BEHIND. + SAVE C + MOVEI C,15. ;WORKS ALMOST LIKE FSIXST. + CALL QOPEN + MOVEI CH,"F ;BUT PUT IN THE "FS" NOW. + IDPB CH,BP + MOVEI CH,"S + IDPB CH,BP + REST E + CALL SIXNTY + MOVEI CH,ALTMOD ;PUT IN THE ALTMODE AT THE END. + IDPB CH,BP + JRST QCLOSV + +IFN ITS,[ +;FS D VERSI$ - RETURN OR SET DEFAULT VERSION NUMBERS +FSDVER: SAVE C + CALL FSFVER ;GET VALUE IN A CORRESPONDING TO OLD VALUE OF DEFAULT FN2. + JFCL + REST T + TRZN FF,FRARG ;ANY ARG GIVEN? + JRST POPJ1 ;NO, GO RETURN DEFAULT + JUMPE T,FSDVR3 ;0 = > + CAMN T,[-2] ;-2 = < + JRST FSDVR4 + JUMPL T,POPJ1 ;ARG IS -1 => DON'T CHANGE ANYTHING. + CAMLE T,[999999.] + TYPRE [ARG] ;ELSE MUST BE REASONABLE VERSION NUMBER. + SETZ C, ;ACCUMULATE IT HERE +FSDVR1: IDIVI T,10. + IORI C,'0(TT) + ROT C,-6 + JUMPN T,FSDVR1 ;KEEP GOING IF MORE NUMBER TO DO +FSDVR2: MOVEM C,DEFFN3 + JRST POPJ1 ;OK, WE SET THE DEFAULT, NOW RETURN PREVIOUS VALUE STILL IN A. + +FSDVR3: SKIPA C,[SIXBIT />/] ;0 = > +FSDVR4: MOVE C,[SIXBIT /" (FS D VERSION$ ONLY) +FSFVER: HLRZS E + SKIPN C,(E) ;GET SECOND FILENAME + JRST FSFVR2 ;BLANK ISNT A NUMBER + SETZ A, ;ACCUMULATE NUMBER HERE + CAMN C,[SIXBIT />/] ;CHECK FOR SPECIAL "NUMBERS" + JRST POPJ1 ;> = 0 + CAMN C,[SIXBIT / IF NEXT CHAR IS SPACE OR CR, IT SHOULD BREAK. +;FRNOT => NO NON-SPACE HAS BEEN SEEN YET ON THIS LINE + ;(SO SPACES SHOULD BE LIKE ORDINARY CHARS) +;FRFIND => PREVIOUS CHAR WAS ^H SO SPACE IS ORDINARY. +;FRSPAC => PREV. CHAR WAS SPACE, SO SPACE SHOULD BE ORDINARY AFTER IT +ADJUST: PUSHJ P,GETANU + EXCH C,E ;THROUGHOUT THE CMD, E -> 1ST CHAR AFTER RANGE TO JUSTIFY. + MOVEM C,PT + CALL GAPSLP + SAVE [0] ;THIS WD HAS STARTING HPOS OF LINE. + +;COME HERE TO PRODUCE 1 MORE LINE OF JUSTIFIED TEXT. +ADJLP0: ANDCMI FF,FRALT + MOVE IN,PT + MOVE D,IN ;D -> 1ST CHAR THAT MIGHT NOT FIT (DON'T KNOW YET) + ANDCMI FF,FRFIND+FRSPAC ;PREV. CHAR WASN'T ^H. OR SPACE. + TRO FF,FRNOT ;NO NON-SPACE HAS BEEN SEEN SO FAR. + MOVE J,(P) ;J HAS HPOS IN OUTPUT LINE, + SETZ OUT, ;OUT IS # WDS FOUND SO FAR. + SETZ Q, ;Q IS 0 IF WE HAVEN'T PASSED A CRLF, OR CHAR ADDR AFTER LAST CRLF. + SETZ C, ;C HAS # WDS AS OF LAST CRLF WE PASSED. + SAVE J ;(P) HAS WHAT J HAD WHEN IN HAD WHAT D HAS. + MOVE BP,IN + ADD BP,EXTRAC + CALL GETIBP ;WE WILL FETCH CHARS VIA BP. +ADJLP1: CAML IN,E + JRST ADJBRK ;PRETEND THERE'S A SPACE AFTER RANGE TO WORK ON. + ILDB CH,BP + AOJ IN, + CAIG CH,40 + JRST ADJCTL +ADJNRM: ANDCMI FF,FRALT\FRNOT\FRFIND\FRSPAC ;NORMAL CHAR ON PASS 1 OF FA. + AOJA J,ADJLP1 + +ADJCTL: CAIN CH,40 + JRST ADJSPC ;SPACE ENDS A WORD. + CAIN CH,^M + JRST ADJCR ;CR ENDS A WORD. + CAIN CH,^I + JRST ADJTAB + CAIN CH,^L ;^L MAKES A BREAK BEFORE AND AFTER THE LINE CONTAINING IT. + JRST ADJFF + CAIE CH,^H + JRST ADJNRM + TRZ FF,FRALT\FRNOT\FRSPAC + IORI FF,FRFIND + SOJGE J,ADJLP1 + AOJA J,ADJLP1 + +ADJFF: JUMPN Q,ADJFF1 ;^L: IF IT'S NOT ON THE LINE WE STARTED HACKING ON THIS CYCLE, + ;FILL UP TO THE CRLF BEFORE THE ^L, THEN CONSIDER IT AGAIN. + JRST ADJSK1 ;JUST SKIP OVER THE ^L, AND WHAT PRECEDES IT ON THE LINE. + +ADJTAB: TRNE FF,FRALT ;COME HERE FOR TAB + SOJA IN,ADJBRK ;TAB AT START OF LINE BREAKS. + IORI J,7 ;ELSE ADVANCE HPOS TO TAB STOP + ADDI J,1 + MOVEM J,-1(P) ;SAY NEXT OUTPUT LINE STARTS AT THAT STOP + JUMPE Q,ADJSK1 ;IF WE HAVEN'T PASSED A CRLF THIS TIME, SKIP PAST ALL BEFORE TAB. +ADJFF1: MOVE IN,Q ;ELSE BACK UP TO THE CRLF AND FILL UP TO IT. + MOVE OUT,C ;THEN NEXT TIME WE'LL SKIP ALL FROM CRLF TO THE TAB. + JRST ADJBRK + +;COME HERE ON SPACE +ADJSPC: TRNE FF,FRALT ;IF 1ST CHAR ON LINE, IT IS A BREAK. + JRST ADJSP1 + TRNN FF,FRFIND\FRSPAC\FRNOT ;ELSE IF SPACE FOLLOWS A WORD, + SKIPA B,BP ;THEN UNLESS + JRST ADJNSP + ILDB B,B ;IT IS FOLLOWED BY A BACKSPACE, WE END A WORD. + CAIE B,^H + JRST ADJSP1 +ADJNSP: TRZ FF,FRFIND\FRALT + AOJA J,ADJLP1 + +ADJCR: TRZE FF,FRFIND ;COME HERE ON CR. + AOJA IN,ADJBRK ;CR PRECEDED BY ^H CAUSES BREAK AFTER FOLLOWING LF. + TRNE FF,FRALT ;THIS CR ENDS NULL LINE => BREAK + SOJA IN,ADJBRK ;BEFORE IT. + ;THE PARAGRAPH WILL BE ENDED, AND WE'LL + ;COME BACK HERE WITH FRALT CLEAR, + ;AND DO THE JUMPE J, BELOW. + TRNE FF,FRNOT ;LINE OF ONLY SPACES IS A BREAK. + AOJA IN,ADJSKP + IBP BP ;SKIP THE LF ASSUMED TO FOLLOW THE CR. + AOS IN + MOVE Q,IN ;REMEMBER CHAR ADDR AND # WDS AS OF MOST RECENT CRLF. + MOVE C,OUT + JUMPE J,ADJSKP ;NULL LINE AT BEGINNING => PASS OVER IT. +ADJSP1: TRNE FF,FRALT ;SPACE AFTER CRLF; BREAK BEFORE THE SPACE + SOJA IN,ADJBRK ;SO SPACE WILL BE REPROCESSED FOR NEXT LINE. + JUMPE OUT,ADJSP2 ;PREVENT LOSSAGE FROM SUPERLONG WORD. + CAMLE J,ADLINE + JRST ADJGO ;WORD JUST ENDED WON'T FIT =>JUSTIFY THE OTHERS & NEW LINE. +ADJSP2: CAIN CH,^M + TRO FF,FRALT ;AFTER ^M, ANOTHER SPACE BREAKS. + TROE FF,FRSPAC ;AFTER A SPACE, DON'T COUNT A NEW WORD, BUT DO ADVANCE HPOS. + AOJA J,ADJLP1 + MOVEM J,(P) ;REMEMBER HOW FAR WE GOT IN BUFFER AND LINE. + MOVE D,IN + AOS J ;IF NEXT WD FITS, WILL NEED 1 POS FOR SPACE. + AOJA OUT,ADJLP1 + +ADJSKP: SETZM -1(P) +ADJSK1: MOVEM IN,PT ;PASS OVER SOME TEXT, NOT FILLING. + SUB P,[1,,1] + CALL GAPSLP + JRST ADJBR3 + +ADJBRK: SETZM (P) ;FILL THE LINE BEFORE A BREAK BUT NOJUST. + MOVE D,IN + TRO FF,FRALT ;INDICATE WE STOPPED AT A BREAK. + JRST ADJBR1 + +;COME HERE AFTER DELIMITING WHAT WILL BECOME ONE LINE, TO JUSTIFY IT. +ADJGO: MOVN J,(P) + ADD J,ADLINE + TRNE FF,FRUPRW ;JUST FILLING => INSERT NO SPACES. + SETZ J, + MOVEM J,(P) ;# SPACES MUST SCATTER THRU LINE. + +;(P) HAS # OF SPACES WE MUST INSERT TO JUSTIFY + ;(0 IF STOPPED AT A BREAK, IN WHICH CASE FRALT SET) +;OUT HAS # OF WORD-BREAKS IN THE LINE. +;-1(P) STILL HAS HPOS TO START NEXT LINE AT. +;E STILL HAS 1ST CHAR NOT TO BE PROCESSED BY THE FA COMMAND. +;D HAS CHAR ADDR OF 1ST CHAR NOT TO BE INCLUDED. +;IF FRALT IS SET (BREAK FOLLOWS), D IS EXACT. +;THE CRLF BEFORE D MAY HAVE PRECEDING SPACES, WHICH ARE DELETED. +;OTHERWISE, D POINTS AFTER THE SPACE OR CRLF AFTER THE LAST WORD TO INCLUDE. +;IN THIS CASE, THERE MAY BE MORE SPACES FOLLOWING, WHICH OUGHT TO BE DELETED. +;A CRLF AFTER THE SPACES SHOULD ALSO BE DELETED. +ADJBR1: SETZ J, + SOSG OUT + MOVEI OUT,1 + ANDCMI FF,FRFIND+FRSPAC + TRO FF,FRNOT ;NO NON-SPACE CHAR SEEN YET. + MOVE IN,PT ;IN IS CHAR ADDR FOR TAKING FROM ABOVE GAP, + MOVE BP,PT + CALL GETIBP ;BP IS BP FOR IDPBNG INTO BOTTOM OF GAP. +ADJGL: CAML IN,E + JRST POP2J ;AT END OF RANGE IN MID-LINE => DON'T PUT IN A CRLF. + CALL GETINC + CAIN CH,^M + JRST ADJGCR + CAIN CH,40 + JRST ADJGS +ADJGS4: CAMLE IN,D ;AT END OF THIS OUTPUT LINE & PAST ALL TRAILING SPACES + JRST ADJDUN ;=> INSERT THE CRLF AND HACK NEXT LINE. + ANDCMI FF,FRNOT+FRSPAC ;NON-SPACE SEEN. + CAIN CH,^H + TROA FF,FRFIND +ADJGS1: ANDCMI FF,FRFIND + IDPB CH,BP ;ORD. CHR., JUST COPY TO BELOW THE GAP. + AOS GPT + AOS PT + JRST ADJGL + +ADJGS: CAME E,IN ;SPACE AT END OF RANGE => DON'T CHECK FOLLOWING CHAR. + TRNE FF,FRNOT+FRFIND + JRST ADJGS1 ;SPACE AFTER BS OR BEFORE 1ST WD IS NORMAL CHAR. + CALL GETINC ;ELSE SEE IF FOLLOWED BY BS. + CAIE CH,^H + SOJA IN,[ ;NO, IT IS A WORD DELIMITER. + TRNN FF,FRALT ;IF LINE DOESN'T END WITH A BREAK, + JRST ADJCR1 ;MAKE SURE EXTRA SPACES PAST END ARE DELETED. + JRST ADJCR2] + MOVEI CH,40 + SOJA IN,ADJGS4 ;YES, IT IS ORDINARY. + +ADJGCR: ANDCMI FF,FRFIND ;CR: DELETE FOLLOWING LF IF ANY. + CALL GETCHR + CAIN CH,^J + CALL ADJDLC +ADJCR2: CAMGE IN,D ;CRLF (OR SPACE, IF THERE'S A BREAK HERE) PAST THE END OF THE LINE + JRST ADJCR1 ;MEANS WE HAVE FINISHED SKIPPING THE EXCESS MULTIPLE SPACES + CALL ADJDLC ;AND WE SHOULD JUST FLUSH THIS ONE AND PREVIOUS ONES + JRST ADJDUN ;AND PUT IN THE CRLF. + +ADJCR1: MOVEI CH,40 ;ALSO REPLACE THE CR WITH A SPACE. + TROE FF,FRSPAC ;A SPACE OR CR WHICH FOLLOWS A SPACE + JRST ADJGS1 ;SHOULD NOT HAVE SPACES INSERTED AFTER IT FOR JUSTIFICATION. + CAMGE IN,D + ADD J,(P) +ADJGS2: CAMGE J,OUT + JRST ADJGS1 + IBP BP ;TIME TO GENERATE A SPACE. + SUB J,OUT + AOS E + AOS D ;RELOC OUR PTRS TO BUFFER SINCE INSERTING CHAR. + AOS IN + CALL TYOM + JRST ADJGS2 ;SEE IF SHOULD INSERT ANOTHER SPACE. + +;COME HERE WHEN WE HAVE DONE PASS 2 ON A WHOLE LINE +ADJDUN: SUBI IN,2 ;WE HAVE JUST PASSED AT LEAST ONE SPACE INTO THE OUTPUT LINE. + JRST ADJEND ;MAKE IN POINT AT IT. IN SHOULD BE GPT-1 NOW. + +ADJDUD: CALL ADJDLB +ADJEND: CALL GETCHR ;DELETE ANY SPACES WHICH WOULD OTHERWISE BE LEFT AT + CAIN CH,40 ;THE END OF THE LINE, BEFORE THE CRLF WE ARE ABOUT TO MAKE. + JRST ADJDUD +ADJDU1: REST J + MOVEI CH,^M ;PRODUCED A LINE, PUT CRLF AFTER IT, REPLACING THE SPACE THERE. + CALL TYOM + MOVEI CH,^J + CALL TYOM + ADDI E,2 ;RELOCATE PTR TO BUFFER ABOVE PLACE INSERTED IN. + SETZM (P) ;NEXT LINE STARTS IN COLUMN 0. +ADJBR3: CAMLE E,PT ;MORE CHARS TO HANDLE => + JRST ADJLP0 ;DO ANOTHER LINE. + JRST POP1J + +ADJDLB: SOS PT + SOS GPT + SOS IN +ADJDLC: AOS EXTRAC ;DELETE THE CHAR AT PT. + SOS Z + SOS E + SOS ZV + SOJA D,CPOPJ + +SUBTTL F^A DISPATCH-TABLE COMMAND + +;"F^A" SCAN THROUGH THE BUFFER, DISPATCHING THROUGH A +;USER-SUPPLIED TABLE ON EACH CHARACTER. +;"^ F^A" SCANS BACKWARDS. +FCACMD: CALL QREGX ;GET DISPATCH TABLE IN A. + LDB OUT,[.BP FRCLN,FF] + TRZ FF,FRCLN + CALL GETANU ;E,C HAVE RANGE TO SCAN. + DPB OUT,[.BP FRCLN,FF] + TRNE FF,FRUPRW + EXCH C,E ;E HAS PLACE TO START; C HAS PLACE TO STOP. + MOVEM E,PT + MOVEI TT,FCA1 ;LOOP POINT IF FCA1 FOR FORWARD SCAN. + TRZE FF,FRUPRW + MOVEI TT,FCA3 ;FCA3 FOR BACKWARD SCAN. + SAVE FF + SAVE TT + MOVE OUT,QRB.. ;SAVE DISPATCH TABLE STRING IN .Q..3 + MOVEM A,.Q..3(OUT) +FCA0: CALL QLGET1 ;GET LENGTH IN B, BP IN BP. + TYPRE [QNS] + CAIGE B,128.*5 + TYPRE [STS] ;STRING TOO SHORT. + JRST @(P) ;FCA1 OR FCA3 + +;LOOP POINT FOR FORWARD SCAN. +;BP HAS BP TO ILDB TABLE; +;C HAS CHAR ADDR OF LAST CHAR TO SCAN + 1. +FCA1: MOVE IN,PT + CAML IN,C + JRST POP2J ;FINISHED SCAN => RETURN. + CALL GETINC + MOVEM IN,PT +FCA4: TRNE FF,FRTRACE + CALL FCATRC ;PRINT PRETTY INFO IF TRACING. + MOVEM CH,.Q..0(OUT) ;SAVE CHAR IN CASE MACRO WANTS IT. + ADD CH,BP ;FIND THE 5 CHARS OF TABLE FOR THIS CHR. + ILDB A,CH ;IS THE FIRST A SPACE? + CAIE A,40 + JRST FCA2 ;NO, MACRO THE 5 CHARS. + ILDB A,CH ;YES, THE NEXT CHAR HOLDS THE WIDTH + SUBI A,100 + ADDM A,.Q..1(OUT) ;OF THIS CHAR, PLUS 100 . + ILDB A,CH ;GET THE 3RD CHAR OF THE FIVE. + CAIN A,40 ;"(" AND ")" ARE SPECIAL, " " IS NORMAL. + JRST @(P) ;FCA1 OR FCA3 + HRRZ CH,(P) ;IT'S SPECIAL. WHICH DIRECTION ARE WE SCANNING? + CAIE A,") ;IF CODE IS ")", + JRST FCAOPN + SKIPGE .Q..1(OUT) ;STOP IF COUNT < 0 AND GOING FORWARD. + CAIE CH,FCA1 + JRST (CH) + JRST POP2J + +FCAOPN: SKIPLE .Q..1(OUT) ;CODE IS "("; STOP IF COUNT > 0 AND GOING BACKWARD. + CAIE CH,FCA3 + JRST (CH) + JRST POP2J + +FCA3: MOVE IN,PT ;LOOP POINT FOR SCANNING BACKWARDS + CAMG IN,C + JRST POP2J + SOS IN,PT + CALL GETCHR + JRST FCA4 + +;IN TRACE MODE, CALL HERE TO PRINT !! FOR EACH CHAR WE PASS. +FCATRC: SAVE CH + MOVEI CH,"! + CALL TYOS + MOVE CH,(P) + CALL TYOS + MOVEI CH,"! + CALL TYOS + JRST POPCHJ + +;HERE FOR A CHAR WHICH REQUIRES THAT WE ACTUALLY MACRO SOME STUFF. +FCA2: MOVN TT,(P) + ADDI TT,FCA1 ;TT IS POS. IFF SCANNING FORWARD. +IFL FCA3-FCA1,.ERR + ASH TT,-43 ;-1 IFF BACKWARD, 0 IFF FORWARD. + IORI TT,1 ;-1 IFF BACKWARD, 1 IFF FORWARD. + MOVEM TT,INSLEN ;MAKE "^F" REPLACE THE CHAR SCANNED. + JUMPG TT,[ SUB C,ZV ;IF FORWARD, STORE END OF RANGE AS DISTANCE FROM Z. + MOVNM C,.Q..2(OUT) + JRST FCA5] + SUB C,BEGV ;GOING BACKWARD, STORE DISTANCE FROM C. + MOVEM C,.Q..2(OUT) +FCA5: MOVE B,.Q..0(OUT) + ADD BP,B + MOVE E,-1(P) + TRNE E,FRCLN ;:F^A TREATS DISPATCH TABLE AS A QVECTOR. + JRST [ IBP BP ;IT EXTRACTS A WORD, AND TREATS IT AS A STRING POINTER TO A MACRO. + MOVE A,(BP) + CALL MACXQ + JRST FCA7] + MOVE A,.Q..3(OUT) + MOVEI B,5 ;MACRO A STRING THAT IS AN INITIAL + ;SEGMENT OF THE DISPATCH TABLE, ENDING AFTER THE + ;FIFTH OF THE CHARS FOR THE CHAR JUST SCANNED. + ;WANT TO SET COMCNT TO 5. + CALL MACXC2 ;EXECUTE THEM. +FCA7: MOVE OUT,QRB.. + MOVE TT,(P) + CAIN TT,FCA1 + JRST [ MOVN C,.Q..2(OUT) + ADD C,ZV ;SEE HOW THE MACRO HAS CHANGED END OF RANGE. + JRST FCA6] ;MUST USE DIFFERENT CODE DEPENDING ON HOW IT WAS STORED. + MOVE C,.Q..2(OUT) + ADD C,BEGV +FCA6: CAMGE C,BEGV ;DON'T LET END OF RANGE GET OUTSIDE VIRTUAL BOUNDARIES. + MOVE C,BEGV + CAMLE C,ZV + MOVE C,ZV + MOVE A,.Q..3(OUT) + JRST FCA0 + +POP2J: SUB P,[2,,2] + POPJ P, + +SUBTTL F^B COMMAND + +;F^B$ - RETURNS -1 IF DOES NOT OCCUR IN ; +; OTHERWISE RETURNS THE POSITION OF THE FIRST OCCURRENCE +; (0 IF IS THE FIRST CHARACTER OF ). +;AT CALL, IS IN C. THIS COULD BE SMARTER: +; IF IS FOUND IN THE MIDDLE OF A SUBSTITUTED QREG WITHIN , +; WE COULD JUST POP OUT OF IT RATHER THAN READING THROUGH IT. +;,F^B$ SKIPS CHARS OF BEFORE LOOKING FOR . +FMEMQ: TRNE FF,FRUPRW + JRST FFIND + TRZN FF,FRARG + TYPRE [WNA] + TRZN FF,FRARG2 + SETZ E, ;E IS PLACE TO START SEARCHING (0, FOR 1ST CHAR, IF NO ARG). + MOVE B,MACPDP + SETZ A, ;A COUNTS THE CHARS WHICH AREN'T . +FMEMQ1: CALL RCH + SKIPN SQUOTP ;NO; REACHED END OF STRING? + CAIE CH,ALTMOD + CAIA ;NO, SEE IF REACHED DESIRED CHARACTER (OUR NUMERIC ARG) + JRST NRETM1 ;YES, RETURN -1 + CAIE C,(CH) + AOJA A,FMEMQ1 ;DIDN'T REACH CHAR BEING SEARCHED FOR. + CAMGE A,E + AOJA A,FMEMQ1 ;REACHED IT, BUT BEFORE WHERE WE ARE SUPPOSED TO BE LOOKING. + CALL FNOOP ;FOUND . NOW IGNORE REST OF STRING + JRST POPJ1 ;AND RETURN THE VALUE, ALREADY IN A. + +;HERE FOR ^ F^B$ - FIND NEXT OCCURRENCE IN THE BUFFER +;OF A CHARACTER NOT IN , AND RETURN .,. +;^:F^B$ RETURNS .,. +;AN ARGUMENT OF -1 CAUSES SCANNING TO GO BACKWARDS INSTEAD. +;THUS, ^ F^B $K KILLS ALL SPACES AFTER POINT, AND ^-F^B $K KILLS ALL THOSE BEFORE. +;WITH 2 ARGS ,, WE JUMP TO AND THEN SCAN TOWARD . +FFIND: JSP BP,FLCMD1 ;FLCMD1 CALLS US TO MOVE POINT TO OTHER END OF RANGE, + ;THEN CALCULATES AND RETURNS THE RANGE AS TWO VALUES. + CALL OARG ;READ IN THE STRING. ST+1 HAS 1ST CHAR. + TRNN FF,FRARG2 + JRST FFINDA + ADD C,BEG ;2 ARGS GIVE RANGE TO SCAN. CONVERT TO INTERNAL CHAR ADDRS. + ADD E,BEG + CALL CHKC ;BARF IF E NOT IN BUFFER. + CALL CHK ;BARF IF C NOT IN BUFFER. + MOVEM E,PT ;1ST ARG SAYS WHERE TO START THE SCAN. + MOVE OUT,C ;2ND ARG SAYS WHERE TO STOP. + SUB C,E ;SIGN OF C GETS DIRECTION OF SEARCH (AS IF JUST 1 ARG). + JRST FFINDZ + +FFINDA: SKIPL C ;HERE FOR JUST 1 ARG. OUT GETS PLACE TO STOP SCAN. + SKIPA OUT,ZV + MOVE OUT,BEGV +FFINDZ: MOVE IN,PT ;J POINTS AT WORD AFTER THE LAST CHAR IN STAB. + CALL GETIBI ;GOING FWD => GET B.P. TO ILDB CHAR AFTER POINT. + JUMPL C,FFINDB ;GOING BACKWARD => ALTER THAT. +FFINDC: CAMN IN,OUT ;IN AND PT ARE THE SAME. BP HAS B.P. TO ILDB CHAR AT PT. + RET + CAMN IN,GPT ;HANDLE MOVING ACROSS THE GAP. + CALL FEQGAP + ILDB CH,BP +FFINDS: MOVEI A,STAB+1 ;HERE FOR EITHER FWD OR BACKWD SCAN, TO SEE IF CHAR IS IN +FFIND1: CAMN A,J ;THE STRING. + JRST [ TRNN FF,FRCLN ;NO => FOR NON-COLON, WE HAVE FOUND END OF RANGE. + RET + JRST FFIND2] + CAME CH,(A) + AOJA A,FFIND1 + TRNE FF,FRCLN ;YES => FOR ^:F^B WE HAVE FOUND THE END OF THE RANGE. + RET +FFIND2: JUMPL C,FFINDD ;NOT AT END => MOVE TO NEXT CHARACTER. + AOS IN,PT + JRST FFINDC + +FFINDB: IBP BP ;MOVE BACKWARRD, THE FIRST TIME. + CAIA +FFINDD: SOS IN,PT ;MOVE BACKWARD AGAIN. + CAMN IN,OUT + RET + CAMN IN,GPT + CALL DWNGAP + DBP7 BP + LDB CH,BP + JRST FFINDS + +SUBTTL WORD AND LIST PARSING COMMANDS + +FWCMD: MOVEI BP,WORDSP + JRST .+2 +FLCMD: MOVEI BP,LISTSP +FLCMD1: ARGDFL Z + CALL IMMQIT ;ALLOW IMMEDIATE QUITTING IN CASE WE HAVE FAR TO SEARCH. + SAVE PT + SETZM SEXPFL + CALL (BP) + MOVE E,PT + REST C + MOVEM C,PT + CAMGE C,E + EXCH C,E + SUB C,BEG + SUB E,BEG + MOVEM E,SARG + MOVE A,C + TRZ FF,FRUPRW+FRCLN + TRO FF,FRARG2 + SETZM IMQUIT ;STOP ALLOWING IMMEDIATE QUITTING. + JRST POPJ1 + +FUCMD: JSP BP,FLCMD1 + SETZM DOWNF + MOVM D,C + MOVNS D +FUCMD1: JUMPE D,CPOPJ + HLRES C + JRST LISTSQ + +FDCMD: JSP BP,FLCMD1 + SETOM DOWNF + MOVM D,C + JRST FUCMD1 + +;THIS ROUTINE TAKES ARG IN C, AND DOES FWL. +;FS INSLEN IS SET TO LENGTH OF LAST WORD OR INTER-WORD-SPACE SEEN +;(NOTE IF YOU START WITHIN A WORD, FS INSLEN$ MIGHT NOT BE WHAT YOU WANT). +;IF SEXPFL IS SET, ASSUMES WAS REACHED FROM ^ FL, AND GOES BACK THERE +;AFTER FINDING ONE WORD. +;THE UPARROW FLAG CAUSES SCANNING TO BE FOR LISP ATOMS INSTEAD OF WORDS. +WORDSP: CALL SKNBCP ;INITIALIZE SO WE CAN CALL SKNBRK. + TRNE FF,FRUPRW + IBP SKNBPT ;FOR LISP, USE 2ND CHAR OF DISPATCH ENTRY RATHER THAN 1ST. + JUMPL C,WBACK + JUMPE C,CPOPJ + CALL LFINIT ;SET UP E, IN, BP. +WFVBA1: SKIPE SEXPFL ;HERE TO START WORD-GAP, TREATING LAST CHAR SEEN AS PART OF PREV. WORD. + JRST LFLOOP + MOVE B,E ;SAVE E IN B EVERY SO OFTEN. E-B WILL BE VALUE OF INSLEN. + SOSA B +WFSBEG: MOVE B,E ;LIKE WFVBA1, BUT COUNT LAST TERMINATOR AS PART OF THIS GAP. + SKIPE SEXPFL + JRST LFDSP +WFSLUP: SOJLE E,WFSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT + CAIE A,"; + CAIN A,"A + JRST WFSEND + CAIE A,"/ + CAIN A,"| + JRST WFSEND + JRST WFSLUP + +WFSEND: TRNE FF,FRCLN +WFVBA2: SOJLE C,WFDONC + MOVE B,E + CAIN A,"| + JRST WFVBAR ;WIN IN CASES LIKE |FOO||BAR| + JRST WFWDSP ;NOW PROCESS CHAR THAT STARTS THE WORD AS IF FOUND IT INSIDE WORD + +;HERE WHEN A :FW FINDS START OF WORD AND THINK'S IT IS FINISHED. +WFDONC: TRNN FF,FRUPRW ;IF IT WAS AN ^:FW, AND LAST CHAR WAS A ', BACK UP OVER IT. + JRST WFDONE + CAMN E,IN + CALL DWNGAP + AOS E ;AND KEEP BACKING UP PAST ALL '-TYPE CHARS. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST WFDONC + SOJA E,WFDONE + +WFWLUP: SOJLE E,WFWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT +WFWDSP: CAIE A,"; + CAIN A,"A + JRST WFWLUP + CAIN A,"' ;' CHARS CAN CONTINUE A WORD, BUT NOT START ONE. + JRST WFWLUP + CAIN A,"/ + JRST WFSLSH + CAIN A,"| ;| INSIDE WORD IS CASE OF FOO|BAR|, WHICH IS 2 WORDS, + JRST [ TRNE FF,FRCLN ;SO END THIS WORD AND IMMEDIATELY START ANOTHER. + MOVE B,E + JRST WFVBA2] +WFWEND: TRNE FF,FRCLN + JRST WFSBEG + SOJG C,WFSBEG +WFDONE: SUB B,E + SUB E,ZV + MOVNS E + JRST WORD12 + +WFSEOB: TRC FF,FRCLN ;WENT FWD PAST Z, BETWEEN WORDS. +WFWEOB: SOJG C,TYPNIB ;WENT FWD PAST Z, IN MIDDLE OF WORD. + TRNE FF,FRCLN + JRST TYPNIB + JRST WFDONE + +WFSLSH: CALL LFSLSH ;HANDLE A SLASH-CHARACTER GOING FORWARD. + JRST WFWLUP + +WFVBAR: CALL LFVBAR ;VERTICAL BAR: SKIP TO MATCHING ONE. + TRNN FF,FRCLN ;IF TIME TO STOP MOVING, MAKE SURE CLOSING VBAR + SOJLE C,[SOJA E,WFDONE] ;COUNTS AS PART OF WORD, NOT PART OF GAP. + ;IF MUST KEEP GOING, DO SO, BUT DON'T COUNT + JRST WFVBA1 ;THE VBAR AS PART OF THE GAP THAT'S STARTING. + +;MOVE BACKWARDS OVER WORDS. + +WBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +WBVBA1: SKIPE SEXPFL + JRST LBLOOP + MOVE B,E + SOSA B +WBSBEG: MOVE B,E + SKIPE SEXPFL + JRST LBDSP +WBSLUP: SOJL E,WBSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIE A,"A + CAIN A,"| + JRST WBSEND + CAIN A,"; + JRST WBSEND + CAIE A,"/ + JRST WBSLUP +WBSLSH: SAVE E ;FOUND A SLASH GOING BACKWARD. + SAVE BP ;IF IT'S SLASHED, IT ENDS A WORD; ELSE FOLLOWING CHAR + CALL REALP ;IS SLASHED AND ENDS THE WORD. + JFCL ;BIT 1.1 OF CH IS 1 IF SLASH IS SLASHED. + REST BP + REST E + TRNE CH,1 + JRST WBSEND + IBP BP + AOJ E, +WBSEND: TRNE FF,FRCLN +WBVBA2: SOJLE C,WBDONE + MOVE B,E + CAIN A,"| + JRST WBVBAR + JRST WBWDSP + +WBWLUP: SOJL E,WBWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT +WBWDSP: CAIE A,"; + CAIN A,"A + JRST WBWLUP + CAIN A,"| + JRST [ TRNE FF,FRCLN + MOVE B,E + JRST WBVBA2] + CAIE A,"' + CAIN A,"/ + JRST WBWLUP + SAVE BP + SAVE E + CALL REALP + JFCL + REST E + REST BP + TRNE CH,1 + JRST WBWLUP +WBWEND: TRNE FF,FRCLN + JRST WBSBEG + SOJG C,WBSBEG +WBDONE: SUBM E,B + AOJ E, + ADD E,BEGV +WORD12: MOVEM E,PT + MOVEM B,INSLEN + TRZ FF,FRCLN+FRUPRW + RET + +WBSEOB: TRC FF,FRCLN +WBWEOB: SOJG C,TYPNIB + TRNE FF,FRCLN + JRST TYPNIB + JRST WBDONE + +WBVBAR: CALL LBVBAR ;MOVE BACK OVER A VERTICAL BAR GROUPING. +WBVBA4: JUMPE E,WBVBA3 ;THEN BACK OVER ALL ' CHARACTERS BEFORE IT. + SAVE E + SAVE BP + SOJ E, + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST [ SUB P,[2,,2] + JRST WBVBA4] + REST BP + REST E +WBVBA3: TRNN FF,FRCLN ;IF IT'S TIME TO STOP MOVING, SAY WE STOPPED AFTER PASSING THE + SOJLE C,[SOJA E,WBDONE] ;VBAR, INSTEAD OF BEFORE, AS WE WOULD STOP AT A SPACE. + JRST WBVBA1 ;IF KEEP MOVING, DON'T INCLUDE THE VBAR IN THE NEW GAP. + +LISTSP: TRNE FF,FRUPRW + SETOM SEXPFL + SETZB D,DOWNF + JUMPE C,CPOPJ +LISTSQ: CALL SKNBCP ;SET UP SKNBPT FROM ..D + IBP SKNBPT + JUMPL C,LBACK + CALL LFINIT ;SET UP BP, E, IN. +LFLOOP: SOJLE E,LFEOB ;AFTER THIS INSN E HAS # CHARS LEFT TO SCAN. + CAMN E,IN ;IF WE'RE ABOUT TO ILDB INTO THE GAP, CROSS IT: + CALL FEQGAP ;(BP <- BP TO ILDB 1ST CHAR AFTER GAP). + ILDB A,BP + LDB A,SKNBPT ;GET DISPATCH ENTRY OF THIS CHARACTER. +LFDSP: CAIN A,"/ + JRST [ TRNE FF,FRUPRW ;FOR ^ FL, REMEMBER SLASH STARTS AN ATOM. + JUMPE D,WFSEND + CALL LFSLSH + JRST LFLOOP] + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WFSEND + CALL LFVBAR + JRST LFLOOP] + CAIE A,"; + CAIN A,"A ;SEMICOLON AND LETTERS START ATOMS. + TRNN FF,FRUPRW + JRST LFFOO1 + JUMPE D,WFSEND +LFFOO1: CAIN A,"( + JRST LFLPAR + CAIE A,") + JRST LFLOOP + SKIPE DOWNF + AOJA D,LFLOOP + AOJL D,LFLOOP + SETZ D, ;MAKE SURE 2FLL SAME AS FLL FLL. + SOJG C,LFLOOP +LFDONE: SUB E,ZV + TRC FF,FRCLN + JRST LISTX + +LFEOB: JUMPL D,[TYPRE [UBP]] ;UNBALANCED PARENTHESES +TYPNIB: TYPRE [NIB] + +LFSLSH: SOJLE E,TYPUEB ;HANDLE "/" GOING FORWARD. + CAMN E,IN ;IF WE'VE REACHED THE GAP, MAKE BP CROSS IT. + CALL FEQGAP + IBP BP + RET + +TYPUEB: TYPRE [UEB] + +LFLPAR: TRNE FF,FRCLN ;:FL => STOP BEFORE ( INSTEAD OF AFTER IT AS FOR FD. + JUMPE D,[SOJE C,LFCDON ;ALSO, :FL BACKS OVER ''S WHILE FD DOESN'T. + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LFLOOP + SOJG D,LFLOOP + JRST LFDONE + +LFCDON: MOVNS E + ADD E,ZV ;TURN INTO CHAR ADDR OF THE (. + TRZ FF,FRCLN ;DON'T LET LISTX MUNG IT. + TRNE FF,FRUPRW ;FOR ^:FL, +LFCDO1: CAMG E,BEGV ;SCAN BACKWARD PAST ANY QUOTES BEFORE THE (. + JRST LISTX + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + SOJA E,LFCDO1 + JRST LISTX + +LFVBAR: SOJLE E,TYPUEB ;HANDLE "|" GOING FORWARD. + CAMN E,IN + CALL FEQGAP ;WHEN REACH GAP, MOVE OVER IT. + ILDB A,BP + LDB A,SKNBPT ;DECODE NEXT CHARACTER. + CAIN A,"/ + JRST [ CALL LFSLSH ;SLASH => DON'T CHECK NEXT CHAR FOR BEING A "|". + JRST LFVBAR] + CAIE A,"| + JRST LFVBAR ;FIRST UNSLASHIFIED "|" ENDS THE STRING. + RET + +;MOVE BACKWARD OVER LISTS. + +LBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +LBLOOP: SOJL E,LFEOB + CAMN E,IN ;IF ABOUT TO DLDB INTO LAST CHAR OF GAP, + CALL DWNGAP ;MAKE BP -> LOWEST CHAR. OF GAP. + DBP7 BP +LBDSP: LDB A,BP + LDB A,SKNBPT + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WBSEND + CALL LBVBAR + JRST LBLOOP] + TRNN FF,FRUPRW ;IF ^ FL, NOTE THAT LETTERS AND SLASH START ATOMS + JRST LBFOO1 + CAIN A,"A + JUMPE D,WBSEND + CAIN A,"/ ;FOR SLASH, THE CHAR AFTER IT (ALREADY SCANNED) + JUMPE D,WBSLSH ;IS ALSO PART OF THE ATOM. +LBFOO1: CAIN A,") + JRST LBRPAR + CAIE A,"( + JRST LBLOOP + CALL REALP + JRST LBQOTD + SKIPE DOWNF + AOJA D,LBLOOP + AOJL D,LBLOOP + SETZ D, + SOJG C,LBLOOP + TRNN FF,FRUPRW ;FOUND MATCHING OPENPAREN. NOW, IF PASSING SEXPS, + JRST LBDONE +LBQOT1: MOVE B,E ;SKIP OVER ANY NO-SLASHIFIED '-LIKE CHARACTERS + SOJL E,LBQOT2 ;THAT PRECEDE THE OPENPAREN. + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + CALL REALP +LBQOT2: SKIPA E,B + JRST LBQOT1 +LBDONE: ADD E,BEGV +LISTX: MOVMM E,PT + TRZE FF,FRCLN + AOS PT + POPJ P, + +LBVBAR: CALL REALP ;HANDLE "|" GOING BACKWARDS. + RET +LBVBLP: SOJL E,TYPUEB + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"| + CALL REALP + JRST LBVBLP + RET + +LBRPAR: CALL REALP ;HANDLE ")", MOVING BACKWARD. + JRST LBQOTD + TRNE FF,FRCLN + JUMPE D,[SOJE C,LBDONE + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LBLOOP + SOJG D,LBLOOP + JRST LBDONE + +LBQOTD: MOVEI A,"A ;SLASHIFIED PAREN HAS "ALPHABETIC" SYNTAX + TRNE FF,FRUPRW ;AND CAN START (END?) AN ATOM. + JUMPE D,WBSEND + JRST LBLOOP + +;INITIALIZATION AND AUXILIARY ROUTINES FOR FW AND FL. + +;SET UP BP, E, IN FOR GOING FORWARD. +LFINIT: MOVE BP,PT + CAML BP,GPT + ADD BP,EXTRAC ;GET REAL CHAR ADDR OF CHAR AFTER PT. + CALL GETIBP + MOVE IN,ZV + SUB IN,GPT ;THIS IS WHAT E WILL HAVE WHEN GAP IS REACHED. + MOVE E,ZV + SUB E,PT + AOJA E,CPOPJ + +;BP GETS A B.P. TO THE 1ST CHARACTER OF THE GAP, TO DLDB INTO THE REGION +;BELOW THE GAP. +DWNGAP: MOVE BP,GPT + JRST GETBP + +;SET UP BP, E, IN FOR GOING BACKWARD. +LBINIT: MOVE BP,PT + CAMLE BP,GPT ;BP GETS REAL CHAR ADDR +1 OF CHAR BEFORE PT. + ADD BP,EXTRAC + CALL GETBP ;BP SET UP FOR DLDB. + MOVE E,PT + SUB E,BEGV + MOVE IN,GPT ;IN USED FOR DETECTING THAT GAP IS REACHED. + SUB IN,BEGV ;CHECK: IF PT = GPT NOW, E WILL = IN THE FIRST TIME THRU. + SOJA IN,CPOPJ + +;DURING BACKWARD SCAN, CHECK WHETHER THE CHAR JUST REACHED WAS SLASHIFIED. +;MOVES BP AND E BACK OVER THE SLASHES, LEAVES THEM AS IF 1ST OF THE SLASHES +;WAS JUST GOBBLED. IF # SLASHES IS EVEN (CHAR IS NOT SLASHIFIED), +;BIT 1.1 OF CH WILL BE 0, AND REALP WILL SKIP. +REALP: SETZI CH, +REALP3: SOJL E,REALP1 + CAMN IN,E + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"/ + AOJA CH,REALP3 + IBP BP +REALP1: AOJ E, + TRNN CH,1 + AOS (P) + POPJ P, + +;F^F IS TH HAIRY FORWARD-ONLY LIST PARSER. +;IT TAKES A "STATE" WHICH INCLUDES THE PAREN DEPTH AS AN ARGUMENT, +;PARSES FROM POINT TO A SPECIFIED PLACE, AND RETURNS THE UPDATED STATE. +;DO ,F^F AND IT RETURNS THE NEW STATE. +;THE STATE'S RH IS TH PAREN DEPTH. THE LH IS BITS, AS FOLLOWS: +; 100,, => INSIDE A COMMENT. +; 4,, => INSIDE VERTICAL BARS. +; 2,, => INSIDE OR RIGHT AFTER AN ATOM. +; 1,, => SLASHIFIED. +;WE ARE INSIDE (AS OPPOSED TO ADJACENT TO) AN ATOM IF 4,, OR 1,, IS SET, +;OR IF 2,, IS SET AND THH NEXT CHARACTER HAS A OR / SYNTAX. +;WHEN WE RETURN, Q..0 GETS THE ADDRESS AFTER THE LAST OPEN-| OR ; SEEN; +;Q..1 GETS THE ADDRESS OF THE LAST UNMATCHED (, OR -1; +;Q..2 GETS THE ADDRESS OF THE START OF THH LAST SEXP, OR -1. + +;SCANNING STOPS WHEN IT REACHES THE SPECIFIED ADDRESS, +; OR WHEN THE PAREN DEPTH REACHES 0. +;FOR :F^F, SCAN ALSO STOPS WHEN AFTER ANY ATOM-START CHARACTER. + + +FCTLF: TRZE FF,FRARG + TRZN FF,FRARG2 + TYPRE [WNA] ;WE MUST HAVE 2 ARGS. AND DISCARD THEM. + SETZ OUT, + TRZE FF,FRCLN ;OUT GETS BITS OF STATE WHICH ARE TERMINATING CONDITIONS. + MOVSI OUT,7 + ADD C,BEG + CALL CHK ;CALCULATE AND VALIDATE ADDRESS TO STOP SCANNING AT. + CALL SKNBCP + IBP SKNBPT ;SKNBPT IS B.P. TO LDB LISP SYNTAX OF CHAR IN CH. + MOVEI TT,CH ;PUT "CH" IN INDEX FIELD TO MAKE THAT TRUE. + DPB TT,[220600,,SKNBPT] + SKIPGE A,E ;KEEP THE STATE IN A. NEGATIVE NUMBER AS ARG + ANDI A,-1 ;MEANS A NEGATIVE PAREN DEPTH, WITH STATE BITS 0. + MOVE CH,QRB.. + SETOM .Q..0(CH) ;SO FAR WE HAVE NOT SEEN ANY ( OR |. + MOVE IN,PT + CALL GETIBI ;IN GETS SCAN POINT AS VIRT ADDR, BP GETS BP TO ILDB. + CAMLE IN,C + TYPRE [2%1] + MOVE Q,P + SETZB D,B ;D HAS ADDR+1 OF START OF SEXP THHT ENDED LAST, OR 0. + ;B HAS STATE BEFORE LAST CHARACTER SCANNED. +FCTLFL: TLNN B,7 ;IF LAST CHAR WASN'T IN OR AFTER AN ATOM, + TLNN A,7 ;AND THIS ONE WAS, + CAIA ;THEN WE HAVE JUST STARTED AN ATOM, + MOVE D,IN ;SO REMEMBER . AS ADDR+1 OF LAST SEXP'S START. + MOVE B,A + TDNN A,OUT ;STOP CONDITION MET OR REACHED END OF RANGE => + CAMN IN,C ;RETURN, SETTING APPRO. Q-REGS. + JRST FCTLFX + CAMN IN,GPT + CALL FEQGAP ;WHEN WE COME TO TH GAP, MOVE TH B.P. OVER IT. + AOS IN,PT + ILDB CH,BP + TLZE A,1 ;PREVIOUS CHARACTER WAS SLASH => DON'T CHECK THIS ONE. + JRST FCTLFL + TLZ A,2 + LDB CH,SKNBPT + TLNE A,100 ;INSIDE A COMMENT, ONLY CR IS INTERESTING. + JRST [ CAIN CH,^M + TLZ A,100 + JRST FCTLFL] + CAIN CH,"/ + JRST [ TLO A,3 + JRST FCTLFL] + CAIN CH,"| + JRST [ MOVE CH,IN ;| => COMPLEMENT IN-|-NESS, + SUB CH,BEG ;AND IF THIS IS ENTERING A PAIR, + TLCE A,4 ; REMEMBER THE ADDRESS IN Q..0. + MOVEM CH,@QRB.. + JRST FCTLFL] + TLNE A,4 + JRST FCTLFL ;WITHIN VERTICAL BARS => ONLY | AND / ARE SPECIAL. + CAIN CH,"; + JRST [ MOVE CH,IN ;ELSE ; STARTS A COMMENT, AND REMEMBER ITS ADDRESS. + SUB CH,BEG + MOVEM CH,@QRB.. + TLO A,100 + JRST FCTLFL] + CAIN CH,"A + TLO A,2 + CAIN CH,"( + JRST [ HRRI A,1(A) ;( => PUSH ITS ADDRESS+1 SO WE CAN + PUSH P,IN ;FIND THE LAST UNMATCHED ONE. + JRST FCTLF1] ;ALSO INCREMENT THE DEPTH COUNTER. + CAIE CH,") + JRST FCTLFL + CAME Q,P ;) => POP ADDR+1 OF THE MATCHING (, IF ANY. + POP P,D ;IT BECOMES THE ADDR+1 OF THE LAST SEXP TO START. + HRRI A,-1(A) ;DECREMENT THE DEPTH. +FCTLF1: TRNE A,-1 ;IF THE DEPTH EVER BECOMES 0 AFTER A PAREN, EXIT. + JRST FCTLFL +FCTLFX: CAME Q,P ;EXIT: GET ADDRESS OF LAST UNMATCHED (, + SOSA IN,(P) ;OR -1 IF THERE IS NONE. + SKIPA IN,[-1] + SUB IN,BEG + MOVE CH,QRB.. + MOVEM IN,.Q..1(CH) ;STORE THAT IN Q..1 + SOSLE D + SUB D,BEG ;TURN D INTO REL CHAR ADDR OF + MOVEM D,.Q..2(CH) ;THE START OF THE LAST SEXP. PUT IN Q..2 + MOVE P,Q ;FLUSH SAVED ( ADDRESSES FROM THE STACK. + JRST POPJ1 ;RETURN THE NEW STATE, WHICH IS IN A. + +SUBTTL MISCELANEOUS F- COMMANDS + +;FX - PUT TEXT INTO AND DELETE IT. FX* RETURNS THE TEXT. +;AC D HAS # CHARS BUFFER WAS MOVED (BY CREATION OF THE STRING) +FXCMD: CALL QREGVS ;THIS CAN MAKE US SKIP! + CALL GETANU ;TAKES ARGS LIKE X, K, ETC. + SKIPA +FXCMD2: SETZ B, ;HERE WITH CH POINTING AT QREG, ASSUMED NOT IN A QVECTOR. + SAVE C + SAVE E ;REMEMBER BOTH ON PDL. + SAVE BEG ;X10 MAY MOVE BUFFER, MUST KNOW HOW MUCH. + CALL X12 ;GO PUT IN QREG (WHICH MIGHT BE AC A - SEE QREGVS) + REST D + SUB D,BEG ;-<# CHARS BUFFER MOVED UP> + REST E + REST C ;GET THE ENDS BACK, + MOVNS D + ADD E,D ;RELOCATE REMEMBERED PTRS. + ADD C,D + MOVEM C,PT + JRST DELET1 + +FTYI: CALL DISMDI ;UPDATE MODE DISPLAY (Q..J) IF NEC. + TTYACT + CALL TYI + TRZE FF,FRCLN ;:FI READS CHAR AND DOESN'T GOBBLE. + MOVEM CH,UNRCHC + TRZN FF,FRUPRW ;^ FI RETURNS UNNORMALIZED CHARACTER. + CALL TYINRM ;NORMAL FI RETURNS NORMAILZED CHARACTER. + MOVE A,CH + JRST POPJ1 + +CNTRUP: CALL RCH ;^^ - RETURN ASCII FOR NEXT CHAR IN CMD STRING. [ + MOVEI A,(CH) ;DISCARD LH, WHICH IS NONZERO FOR ^]^Q'D CHAR. + JRST POPJ1 + +;? COMMAND, COMPLEMENT TRACE MODE. :? TURNS OFF TRACE MODE. +QUESTN: TRNE FF,FRCLN + TRZA FF,FRTRACE + TRC FF,FRTRACE +QUEST1: MOVSI A,(JRST) + TRNN FF,FRTRACE + MOVSI A,(RET) + HRRI A,TYOS + MOVEM A,TRACS + POPJ P, + +FCTLAT: CALL GETARG ;F^@ - TAKES RANGE OF BUFFER, + JFCL + CAMG C,E ;RETURNS 2 ARGS DELIMITING THAT RANGE + EXCH C,E ;IN NUMERIC ORDER. 2,1F^@ GIVES 1,2. + MOVE B,E + MOVE A,C + ANDCMI FF,FRARG+FRARG2 + JRST HOLE0 + +;F*$ -- NO-OP. +;[ ;MAINLY USEFUL FOR F*^]^X$ +FNOOP: JSP B,RDALTC + POPJ P, + JRST FNOOP + +;READ 1 CHAR OF STRING ARG, TURNING UNQUOTED DOLLARSIGNS TO ALTMODES. +;AT END OF ARG, FAIL TO SKIP. +RDALTC: PUSHJ P,RCH + SKIPE SQUOTP + JRST 1(B) + CAIN CH,ALTMOD + JRST (B) + CAIN CH,"$ + MOVEI CH,ALTMOD + JRST 1(B) + +;^V WITH ARG -- PUSH ARGUMENT ON RING BUFFER OF PT. RETURNS NO VALUE. +;NORMALLY, DOESN'T PUSH IF ARG SAME AS CURRENT TOP. :^V PUSHES IN ANY CASE. +FSPSPT: MOVE E,FSPSPP ;GET RING BUFFER POINTER. + LDB CH,E ;GET LAST VALUE PUSHED. + TRZE FF,FRCLN ;UNLESS THIS IS :^V, + JRST FSPSP1 + CAMN C,CH + RET ;DON'T PUSH THE SAME THING TWICE IN A ROW. +FSPSP1: CAMN E,[4400,,FSPSPB+FSPSPL-1] + SUBI E,FSPSPL ;AT END, RING AROUND TO BEGINNING. + IDPB C,E + MOVEM E,FSPSPP + RET + +;^V COMMAND -- WITHOUT ARG, POP TOP OF RING BUFFER OF PT INTO PT; +;THEN RETURN WHAT REMAINS ON TOP OF RING BUFFER (IF THAT VALUE IS +;PUT IN Q..I, THE TOP-LEVEL WILL AVOID PUSHING WHEN IT IS NEXT ENTERED). +;:^V RETURNS VALUE ON TOP OF RING BUFFER. +;^V WITH ARG PUSHES - SEE ABOVE. +CTLV: TRNE FF,FRARG + JRST FSPSPT +POPPT: MOVE E,FSPSPP + MOVE A,(E) ;GET LAST THING PUSHED. + TRZE FF,FRCLN + JRST POPJ1 ;:^V JUST RETURNS VALUE ON TOP OF RING BUFFER. + ADD A,BEG ;PREPARE TO SET PT FROM IT. + SUBI E,1 ;DECREMENT THE RING BUFFER POINTER. + CAMN E,[4400,,FSPSPB-1] + ADDI E,FSPSPL + MOVEM E,FSPSPP + MOVE C,A ;TAKE THE VALUE JUST POPPED. + CALL CHK ;ERR OUT IF IT ISN'T INSIDE THE BUFFER. + MOVEM A,PT ;JUMP THERE IF IT IS. + MOVE A,(E) ;RETURN WHAT IS NOW AT THE TOP. + JRST POPJ1 + +;^Z -- INSERT RANDOM LETTERS BEFORE PT. +;^Z WITHOUT ARG -- RETURN A RANDOM NUMBER. +RANDOM: ARGDFL + JUMPE C,RNDNUM + JUMPLE C,CPOPJ + CALL SLPGET ;INSERT C(C) CHARS, RET. BP. IN BP. +RNDLUP: MOVSI A,123467 + FMPB A,RDMNMS + IDIVI A,26. + MOVEI CH,"A(B) + IDPB CH,BP + SOJG C,RNDLUP + POPJ P, + +RNDNUM: MOVSI A,132476 + FMPB A,RDMNMS + TLZ A,400000 + JRST POPJ1 + +SUBTTL COMMUNICATION WITH SUPERIOR JOB + +FSEXI1: TLZ FF,FLDIRDPY ;COME HERE TO HANDLE ^C TYPED AT TECO COMMAND READER. + MOVEI C,100000 +FSEXIT: MOVEI B,BEG .SEE CIRC +IFN ITS,.BREAK 16,(C) ;FS EXIT +IFN TNX,JRST .EXIT + RET + +SUPCMD: MOVE C,SUPARG ;JUMP HERE IF SUPERIOR STARTS TECO AT BFR BLOCK + 7. + MOVEM C,NUM ;FETCH THE ARG IN BFR BLOCK + 8, AND MAKE IT CURRENT ARGUMENT. + TRO FF,FRARG + SKIPE A,SUPHND ;IF TECO MACRO HANDLER SUPPLIED, RUN IT GIVING IT + JRST MAC5 ;THE ARG OUR SUPERIOR GAVE. + CALL GAPSLP + SKIPLE C ;OTHERWISE, IF ARG IS POSITIVE INSURE AT LEAST THAT MUCH GAP. + CALL SLPGET + MOVEI C,500000 ;DO AN $X RETURN IN CASE $X'ING FROM DDT. + JRST FSEXIT + +;^K$ -- VALRET . +DECDMP: CALL DECDMX ;FORMULATE STRING + MOVEI B,BEG .SEE CIRC + SKIPGE PJATY ;MAKE SURE WE DON'T CLEAR PJATY IF IT WAS ALREADY ON. + TRZ FF,FRUPRW +IFN ITS,.VALUE (A) ;SUPERIOR EXPECTS 2 TO POINT TO BEG +IFN TNX,[ + HRLI A,440700 +IFN 20X,[ + RSCAN ;BEST WAY WE HAVE TO RETURN A STRING TO THE EXEC + TDN + SETZ A, + RSCAN + TDN +] +IFN 10X,[ + MOVE CH,A ;BYTE POINTER TO CHARS TO DO + MOVEI A,.CTTRM +DECDM2: ILDB B,CH + JUMPE B,DECDM3 + STI ;STUFF INTO TERMINAL'S INPUT BUFFER + JRST DECDM2 +DECDM3: +] + CALL .EXIT +] + TRZE FF,FRUPRW + SETZM PJATY ;^ FLAG => SUPPRESS AUTOMATIC REDISPLAY. + POPJ P, + +DECDMX: CALL MEMTOP ;GET ADDR OF 1ST WD ABOVE BFR IN A. + AOS OUT,A + IMULI OUT,5 ;GET CHAR ADDR 1ST CHAR IN THAT WD. + SUB OUT,EXTRAC ;SINCE PUTINC WILL ADD EXTRAC. + JSP B,RDALTC + JRST DECDM1 + CALL PUTINC ;STUFF CHARS THERE, ABOVE BUFFER. + JRST RDALTC + +DECDM1: SETZ CH, ;AFTER STRING, PUT ^@ + CALL PUTINC ;TO TELL DDT IT'S THE END. + SETZM 1(TT) ;ZERO NEXT WD SO DDT WILL STOP FETCHING. + RET + +;FZ - MANIPULATE INFERIOR PROCESS +; FZ$ CREATE FORK, RETURNS FORK INDEX +; 0FZ$ CREATE EXEC FORK (FILESPEC FROM STRING) +; FZ$ "PUSH" +; NFZ$ RESUME FORK N +; -NFZ$ KILL FORK N + +IFN TNX,[ +FZCMD: CALL DECDMX ;BUFFER STRING + HRRO B,A + TRZE FF,FRARG ;ARG GIVEN? + JRST FZCMD3 ;YES - MORE CHECKING + MOVE A,0(B) ;NO - SEE IF NULL STRING ARG + TLNN A,774000 + JRST .PUSH ;YES - DO PUSH + CALL NEWFRK ;ELSE - CREATE NEW FORK + MOVEM B,RUNFRK ;SAVE FORK INDEX +FZCMD1: CALL SETFRK ;SET FORK TTY STATE +FZCMD2: CALL GOFRK ;START UP FORK + MOVE A,RUNFRK ;NO - RETURN FORK INDEX + JRST POPJ1 ;RETURN OK + +FZCMD3: SKIPN A,NUM ;EXPLICIT 0? + JRST .PUSH0 ;YES - MAYBE "PUSH" + JUMPL A,KILFRK ;IF NEGATIVE, THEN KILL FORK + MOVEM A,RUNFRK ;SAVE FORK INDEX + CAILE A,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(A) + TYPRE [ARG] + CALL SETFRK ;SET FORK STATES + TRNE FF,FRARG2 ;HAVE PRE-COMMA ARG? + JRST FZCMD2 ;YES - START FORK AND WAIT FOR TERMINATION + SAVE C ; SAVE AC + SAVE A ; SAVE FORK HANDLE + RFSTS ; GET FORK STATUS AND PC + HLRZ C,A ; COPY FORK STATUS + REST A ; RESTORE FORK HANDLE + TRZE C,(RF%FRZ) ; FORK FROZEN? + RFORK ; YES, WARM IT UP + CAIE C,.RFHLT ; HALTED? + CAIN C,.RFFPT + SFORK ; YES, START IT AT PC RETURNED BY RFSTS + REST C ; RESTORE AC + JRST WAITA ;WAIT FOR TERMINATION + +;RUN AN EXEC PROCESS + +.PUSH0: MOVE A,0(B) ;CHECK NULL STRING + SKIPLE EXECFK ;CHECK EXISTING EXEC FORK + TLNN A,774000 + JRST .PUSH ;NULL STRING OR NO EXISTING FORK + MOVE A,EXECFK ;KILL OFF OLD FORK + KFORK +IFN 20X, ERJMP .+1 + SETOM EXECFK ;SAY NO EXEC +.PUSH: SETZM RUNFRK ;0 - EXEC FORK INDEX + SKIPLE A,EXECFK ;HAVE EXEC? + JRST FZCMD1 ;YES - USE IT + MOVE A,0(B) ;SEE IF NULL STRING + TLNN A,774000 +IFN 20X, HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/] +IFN 10X, HRROI B,[ASCIZ /EXEC.SAV/] + SETZM EXECFK ;FLAG TO SAVE FORK HANDLE + CALL NEWFRK ;CREATE AN EXEC FORK + JRST FZCMD1 ;RUN EXEC AND RETURN + +;KILL FORK (INDEX IN A) + +KILFRK: MOVN B,A ;GET POSITIVE INDEX + CAILE B,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(B) + TYPRE [ARG] + KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + SETZM FRKTAB-1(B) + RET ;RETURN NO VALUE. + +;SET UP TTY MODES FOR RUNNING INFERIOR + +SETFRK: SKIPGE PJATY ;DON'T CLEAR THIS IF ALREADY ON + TRZ FF,FRUPRW + SAVE A ;SAVE FORK HANDLE + CALL DPYRST ;RESET TERMINAL (IF DPY) + MOVEI A,.CTTRM ;CONTROLLING TERMINAL + MOVE B,ITTYMD ;RESTORE TTY MODES + SFMOD + STPAR + MOVE B,ITTYMD+1 ;COULD BE DMOVE EXCEPT FOR KA10 TYPES + MOVE C,ITTYMD+2 + SFCOC + MOVEI A,.FHJOB ;SETUP TERMINAL INTERUPT WORD + SETO B, + SETZ C, + STIW + MOVEI A,.TICCG ;CTRL-G + MOVE B,0(P) ;FORK HANDLE + CAMN B, EXECFK ;THIS THE EXEC? + DTI ;YES - TURN OFF C-G + JRST POPAJ ;RESTORE FORK HANDLE AND EXIT + +;START INFERIOR (HANDLE IN A) + +GOFRK: TRNN FF,FRARG2 + TDZA B,B ;NO ARG - SPECIFY 0 + MOVE B,SARG ;GET ARG IF SPECIFIED + SFRKV ;START INFERIOR + +WAITA: WFORK ;WAIT FOR FORK TO TERMINATE +WAITX: ;SPECIAL LABEL FOR TSINT +RETFRK: SAVE A ;SAVE FORK HANDLE + CALL PAGON ;RESTORE DPY + TRZE FF,FRUPRW ;RES + SETZM PJATY ;^ FLAG => SUPPRESS AUTO REDISPLAY + MOVSI A,.TICCG ;MAKE SURE ^G ASSIGNED ON CHANNEL 0 + ATI + JRST POPAJ ;RESTORE HANDLE AND EXIT + +;CREATE A NEW FORK FOR PROGRAM NAMED BY POINTER IN B +;IF EXECFK IS 0, WE WANT TO CREATE AN EXEC FORK. +;OTHERWISE, WE ALLOCATE AN INDEX AND RETURN IT IN B. + +NEWFRK: MOVSI A,(GJ%SHT\GJ%OLD) + GTJFN + JRST OPNER1 + SAVE A ;SAVE JFN + MOVSI A,(CR%CAP) ;PASS ON CAPABILITIES + CFORK + JRST FRKC3 + EXCH A,0(P) ;SAVE FORK HANDLE GET JFN + HRL A,0(P) ;FORK,,JFN + GET ;GET FILE +IFN 20X, ERJMP FRKC4 + REST A ;RESTORE FORK HANDLE + SKIPN EXECFK ;WANT THIS HANDLE? + JRST [ MOVEM A,EXECFK + RET] + MOVSI B,-NFKS + SKIPE FRKTAB(B) ;IN USE? + AOBJN B,.-1 ;YES - TRY NEXT + JUMPG B,FRKC5 ;TABLE FULL? + MOVEM A,FRKTAB(B) ;SAVE NEW HANDLE + MOVEI B,1(B) ;RETURN NEW INDEX IN B + RET + +FRKC3: REST A ;JFN ON STACK + RLJFN ;RELEASE JFN IN A + JFCL + JRST OPNER1 + +FRKC4: TLZ A,-1 ;JFN + RLJFN + JFCL + REST A ;FORK HANDLE ON STACK + KFORK ;FLUSH FORK +IFN 20X, ERJMP .+1 + JRST OPNER1 + +FRKC5: KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + MOVEI B,CFRKX3 + JRST OPNER4 +];TNX (FZ COMMAND) + +;FJ -- INSERT THE CMD STRING FROM DDT IN THE BUFFER. +;IF NO STRING, INSERTS NOTHING. STRING WILL USUALLY END WITH CRLF. +FJCL: PUSHJ P,FJCLRD ;READ IN THE COMMAND STRING, + SKIPN GCTAB + POPJ P, ;NOTHING TO DO IF STRING NULL. + MOVE A,[BP7,,GCTAB] + MOVEI C, ;COUNT THE CHARS IN E. +FJCL1: ILDB CH,A + JUMPE CH,FJCL2 + CAIE CH,^M ;^M AND ^@ END THE STRING. + AOJA C,FJCL1 + ADDI C,2 ;^M COUNTS AS 2 CHARS, ^@ AS NONE. +FJCL2: CALL SLPGET ;INSERT C(C) CHARS, BP IN BP FOR IDPB. + MOVE A,[BP7,,GCTAB] +FJCL3: ILDB CH,A ;COPY THE CHARS INTO THE SPACE. + JUMPE CH,CPOPJ ;STOP BEFORE A ^@. + IDPB CH,BP + CAIE CH,^M ;AFTER ^M, STORE ^J ANDF DONE. + JRST FJCL3 + MOVEI CH,^J + IDPB CH,BP + POPJ P, + +;READ THE CMD STRING FROM DDT INTO GCTAB. +FJCLRD: SETZM GCTAB + MOVE A,[GCTAB,,GCTAB+1] + BLT A,GCTAB+GCTBL-2 + MOVEM A,GCTAB+GCTBL-1 ;LAST WD NOT 0 TO STOP STORING. +;FIRST, RETURN WITH GCTAB ZEROED IF THERE IS NO JCL. +IFN ITS,[ + .SUSET [.ROPTIO,,A] + TLNN A,OPTCMD ;HAS SUPERIOR SAID IT HAS CMD STRING? + POPJ P, ;NO, RETURN AS IF READ 0 FROM IT. +] +IFN 20X,[ + SETZB A,B + RSCAN ;GET RSCAN BUFFER + TDN + SETZ B, + MOVN C,A ;GET NUMBER OF CHARACTERS IN IT +FJCLR2: JUMPGE C,CPOPJ ;RETURN IF NOTHING TO READ + PBIN ;FLUSH THE FIRST WORD OF THE RSCAN LINE + LSH B,7 + ADD B,A + CAILE A,40 + AOJA C,FJCLR2 + AOJGE C,CPOPJ + CAMN B,[_-1] + RET +] +;THERE IS JCL, SO READ IT INTO GCTAB. +IFN ITS,.BREAK 12,[5,,GCTAB] +IFN 20X,[ + MOVEI A,-1 ;READ FROM CONTROLLING TERMINAL + HRROI B,GCTAB + SIN ;THE REST OF THE RSCAN STRING +] + RET + +SUBTTL F=, F~ STRING COMPARISON + +;F=$ OR F=$ +;COMPARES THE STRINGS AND RETURNS A NUMBER WHOSE SIGN IS NEGATIVE +;IF QREG OR BUFFER RANGE IS LESS; POSITIVE, IF GREATER; 0, IF THE +;TWO STRINGS ARE EQUAL. +;IF THE VALUE IS NONZERO, ITS ABS VALUE IS 1 + THE POSITION OF THE FIRST +;DIFFERENCE; I.E., 1 IF THE FIRST CHARACTERS DIFFER. +;A STRING IS GREATER THAN ANY INITIAL SEGMENT OF IT. +;F~ (OR F^) COMPARES SIMILARLY BUT IGNORES CASE DIFFERENCES. +FAPPRX: TRO FF,FRNOT +FEQ: TRNE FF,FRARG\FRCLN + JRST FEQ0 ;NUMERIC ARG => USE BUFFER RANGE. + SAVE FF ;PRESERVE FRNOT OVER QREGX. + CALL QREGX ;ELSE READ NAME OF QREG. + REST FF + CALL QLGET0 ;GET LENGTH IN B, BP TO ILDB IN BP. + TYPRE [QNS] + SETZB D,IN ;THERE'S NO GAP TO SKIP OVER. + AOJA IN,FEQ1 + +FEQ0: CALL GETANU ;DECODE 1 OR 2 ARGS AS FOR K, T, X ETC. + MOVE D,GPT ;D GETS CHAR ADDR OF START OF GAP. + MOVE B,C ;B GETS # CHARS, + SUB B,E + MOVE BP,E + CAML E,GPT + ADD BP,EXTRAC ;IN CASE RANGE STARTS AFTER GAP. + MOVE IN,BP + CALL GETIBP ;BP GETS BP TO ILDB 1ST CHAR. +FEQ1: SETZ A, ;ORDER OF STRINGS NOT KNOWN YET. + ;WHEN ORDER IS DETERMINED, A WILL GET 1 OR -1. + MOVE E,B ;REMEMBER INITIAL VALUE OF B. + SETZM INSBP ;MAKE SURE RCH RELOCATES BP. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;UPARROW SAYS USE DELIMITER OTHER THAN ALTMD. + CALL RCH + MOVEM CH,INSDLM ;REMEMBER THE DELIMITER. + TRZ FF,FRARG+FRCLN+FRARG2 +;GET THE NEXT CHAR FROM THE STRING ARG. +FEQLUP: CALL RCH ;READ IT. + SKIPE SQUOTP ;IF NOT QUOTED OR DELIM-PROTECTED, + JRST FEQLU1 + CAMN CH,INSDLM ;SEE IF IT IS THE DELIMITER. + JRST FEQEND +FEQLU1: JUMPN A,FEQLUP ;INEQUALITY SEEN => JUST SKIPPING TO END OF STRING ARG NOW. + SOJL B,FEQEN1 ;END OF QREG BUT NOT END OF STRING ARG => QREG IS LESS. + CAMN D,IN ;ELSE GET NEXT CHAR OF QREG OR BUFFER. + CALL FEQGAP ;SKIP OVER GAP IF HAVE REACHED IT. + AOS IN + ILDB C,BP + CAIN C,(CH) ;CHARS EQUAL => NO DECISION YET, + JRST FEQLUP ;KEEP LOOKING. + TRNN FF,FRNOT ;NO MATCH => IF F^, TRY IGNORING CASE. + JRST FEQNE + CAIL C,"A+40 + CAILE C,"Z+40 + CAIA + SUBI C,40 + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN C,CH + JRST FEQLUP +FEQNE: CAIL C,(CH) ;QREG OR BUFFER GREATER => + AOJA A,FEQLUP ;RETURN POSITIVE; ELSE NEGATIVE. +FEQEN1: SOJA A,FEQLUP ;EITHER WAY, SKIP OVER REST OF STRING ARG. + +FEQEND: SETOM INSBP + JUMPN A,FEQEN2 ;END OF STRING ARG: RETURN ANSWER IF KNOWN. + SOJL B,POPJ1 ;ELSE QREG ENDING NOW TOO => EQUAL. + AOJ A, ;STRING ARG FINISHED, OTHER NOT => STRING ARG IS SMALLER. +FEQEN2: SUB E,B ;INITIAL VALUE OF B - CURRENT + IMUL A,E ;GIVES 1+POSITION OF 1ST DIFFERENCE. + JRST POPJ1 + +FEQGAP: MOVE BP,GPT ; BP GETS BP TO ILDB 1ST CHAR AFTER GAP. + ADD BP,EXTRAC + JRST GETIBP + +SUBTTL CASE CONVERSION + +;FC - TAKES ARGS LIKE K, CONVERTS AREA OF BUFFER TO LOWER CASE +;PT GOES BEFORE THE SAME CHARACTER BEFORE AND AFTER. +;^ FC CONVERTS TO UPPER CASE. +;:FC RETURNS , CONVERTED TO UPPER CASE. +LOWCON: TRZE FF,FRCLN + JRST LOWCO3 ;:FC GOES OFF. + PUSHJ P,GETANU + MOVE IN,E + SUB C,IN + SKIPE READON + TYPRE [RDO] + SETOM MODIFF ;WE ARE ABOUT TO CHANGE THE BUFFER CONTENTS. + CALL GETIBI ;GET IN BP B.P. TO ILDB CHARS STARTING WHERE IN POINTS. +LOWCO1: SOJL C,CPOPJ + CAMN IN,GPT ;WHEN REACH GAP, MOVE B.P. OVER IT. + CALL FEQGAP + ILDB CH,BP + TRNE FF,FRUPRW + JRST LOWCO5 + CAIG CH,"Z + CAIGE CH,"A + JRST LOWCO2 +LOWCO6: XORI CH,40 +LOWCO2: DPB CH,BP ;PUT CHAR INTO FRONT OF GAP, + AOJA IN,LOWCO1 + +LOWCO5: CAIG CH,40+"Z ;CONVERTING TO UPPER CASE: + CAIGE CH,40+"A + JRST LOWCO2 + JRST LOWCO6 ;LOWER CASE CHARS GET SHIFTED, + +LOWCO3: TRZN FF,FRARG + TYPRE [WNA] + MOVE A,C ;HANDLE :FC. TO GET VALUE, START WITH ARG, + TRZ FF,FRUPRW ;DON'T LEAVE ^ FLAG ON; DON'T LET ARG INTERFERE WITH VALUE. + CALL QLGET0 ;ARG IS STRING => CONVERT ALL CHARS OF THE STRING. + CAIA + JRST LOWCO4 + ANDI C,177 + CAIG C,40+"Z + CAIGE C,40+"A + CAIA + XORI A,40 + JRST POPJ1 + +LOWCO4: AOS (P) + MOVE C,B ;ARG IS STRING; MAKE NEW STRING = OLD ONE CONVERTED TO U.C. + MOVE E,BP ;SAVE PTR TO OLD STRING; QOPEN RETURNS PTR TO NEW ONE IN BP. + CALL QOPEN ;MEANWHILE C HAS SIZE NEEDED FOR NEW ONE, = SIZE OF OLD. + JUMPE B,QCLOSV +LOWCO7: ILDB TT,E ;COPY OLD STRING + CAIL TT,"A+40 + CAILE TT,"Z+40 + CAIA + SUBI TT,40 ;CONVERT EACH CHARACTER IF NECESSARY. + IDPB TT,BP ;STORE INTO THE NEW STRING. + SOJG B,LOWCO7 + JRST QCLOSV ;THEN FINISH THE NEW STRING'S HEADER AND RETURN IT. + +NEWAS: ARGDFL ;DOLLARSIGN COMMAND. + CALL FSCASF ;UNLESS IN -1$, NO CASE SHIFT OR LOCK. + SKIPGE C + MOVEI IN,"/ ;-1$, USE / AS THE CASE-SHIFT, NO CASE-LOCK. + JRST FSCAS1 + +FSCASV: MOVE A,CASNRM ;COMPUTE VALUE FOR FS CASE TO RETURN. + SKIPL CH,CASSFT ;IF THERE'S A CASE-SHIFT, PUT IT IN BUFFER.. + CALL TYOMGS + SKIPL CH,CASLOK ;SAME FOR CASE-LOCK. + CALL TYOM + JRST POPJ1 + +FSCASE: TRNN FF,FRARG ;FS CASE -- NO ARG => RETURN STATUS INFO. + JRST FSCASV + ARGDFL + CALL FSCASF ;READ THE STRING ARG WITH NO CASE SHIFT OR CASE LOCK. + CALL RCH ;READ WHAT MIGHT BE THE CASE-SHIFT. + CAIN CH,ALTMOD ;NULL STRING ARG => NEITHER. + JRST FSCAS1 ;(NOTE IN, OUT HOLD -1) + MOVEI IN,(CH) ;ELSE 1ST CHAR OF ARG IS CASE-:SHIFT. + CALL RCH ;AND THERE MAY BE A CASE-LOCK. + CAIN CH,ALTMOD + JRST FSCAS1 ;NO MORE CHARS IN ARG => NO CASE-LOCK. + MOVEI OUT,(CH) +FSCAS0: JSP B,RDALTC ;IGNORE REST OF STRING ARG. + CAIA + JRST FSCAS0 +FSCAS1: CAMN IN,OUT ;TRYING TO MAKE SAME CHAR SHIFT & LOCK? + SETO IN, ;JUST USE IT AS LOCK. + MOVEM C,CASNRM ;SIGN OF ARG IS NORMAL INPUT CASE. + MOVEM C,CASE ;SET CURRENT CASE TO NEW NORMAL. + ANDI C,1 + MOVEM C,CASDIS ;ARG ODD => FLAG ON OUTPUT. + MOVEM IN,CASSFT ;THEN STORE AWAY NEW SHIFT AND LOCK CHARS, + MOVEM OUT,CASLOK + MOVE TT,[CALL RCHSFT] ;ACTUALLY MAKE THE NEW CASE-SHIFT + SKIPL IN ;(IF ANY) + EXCH TT,RCHDTB(IN) ;ACT LIKE ONE. + MOVEM TT,RCHSFD ;MAKE SURE CAN UNDO THAT EXCH. + MOVE TT,[CALL RCHLOK] + SKIPL OUT ;SIMILAR FOR THE NEW CASE-LOCK. + EXCH TT,RCHDTB(OUT) + MOVEM TT,RCHLOD + POPJ P, + +;CAUSE THE CASE-SHIFT AND CASE-LOCK, IF ANY, TO BECOME NORMAL. +;CHARACTERS AGAIN, WITH NO CASE-SHIFT OR -LOCK IN EXISTENCE. +;SETOM'S IN, OUT. CLOBBERS TT, TT1. +FSCASF: MOVE TT,RCHLOD ;FIRST TURN THE OLD SHIFT AND LOCK CHARS + SKIPL TT1,CASLOK ;INTO NORMAL CHARS. + MOVEM TT,RCHDTB(TT1) + MOVE TT,RCHSFD + SKIPL TT1,CASSFT + MOVEM TT,RCHDTB(TT1) + SETOB IN,CASSFT ;THEN SAY THERE ARE NONE. + SETOB OUT,CASLOK + POPJ P, + +SUBTTL Q-REGISTER NAME READERS + +;ROUTINES TO READ IN SUFFIX QREG ARGS: + +;THERE ARE SEVERAL TYPES OF SUFFIX QREGS, AND VARIOUS ROUTINES ALLOW CERTAIN SUBSETS. +;A LETTER (OR DOTS AND A LETTER, OR A ^R OR ^^ NAME) NAMES A FIXED LOCATION IN TECO. +;AN EXPRESSION IN PARENTHESES IS A READ-ONLY QREG "CONTAINING" THE VALUE OF THE EXP. +;A * IS A WRITE-ONLY QREG AND WHAT IS WRITTEN IN IT IS THE COMMAND'S VALUE. +;:() WHERE IS A QREG CONTAINING A Q-VECTOR, IS A SUBSCRIPTING EXPRESSION. +; IN THIS CASE, THE QREG IS ONE WORD IN THE QVECTOR. +; IS A LONG-NAME QREG. THE NAME IS LOOKED UP IN THE SYMBOL TABLE +; (A QVECTOR IN ..Q) WITH FO TO FIND THE WORD IN THAT QVECTOR HOLDING THE VALUE. + +;THE REASON THERE ARE SEVERAL ROUTINES IS THAT ONLY READING-ONLY COMMANDS +;ALLOW (-) QREGS, AND ONLY WRITING-ONLY COMMANDS ALLOW *. +;QREGS IS THE BASIC ROUTINE (NEITHER * NOR PARENS), QREGX ALLOWS PARENS, +;AND QREGVS ALLOWS *. + +;THE ROUTINES HAVE SIMILAR VALUE CONVENTIONS: +;A CONTAINS THE CONTENTS OF THE QREG, +;CH CONTAINS ITS ADDRESS (BAKTAB, FOR PAREN-QREGS WHICH CAN'T BE WRITTEN) +;B CONTAINS AN INDICATION OF WHICH TYPE OF NAME WAS READ. + ;NORMALLY, IT IS ZERO. FOR :(), IT IS POSITIVE; FOR NAME, IT IS NEGATIVE. + ;IN EITHER OF THOSE TWO CASES, THE RH POINTS AT THE BUFFER BLOCK OF THE QVECTOR + ;CONTAINING THE SLOT. THAT IS SO THAT COMMANDS LIKE :I CAN TELL IF THAT QVECTOR + ;IS RELOCATED AND CORRECT ACCORDINGLY (SEE QREGVA). +;IN, FOR A NAME QREG (B IS NEGATIVE), CONTAINS A TECO STRING POINTER TO THE +;INTERNED NAME OF THE QREG AS FOUND IN THE SYMBOL TABLE. + +;READ EITHER A QREG NAME OR AN EXPRESSION IN PARENS, WHOSE VALUE +;IS USED AS THE "CONTENTS" OF THE QREG. CONTENTS RETURNED IN A. CLOBBERS ALL ACS +;EXCEPT C,E. ALSO ALLOWS SUBSCRIPTED QVECTORS, LIKE QREGS. +QREGX: CALL SKRCH + CAIE CH,"( + JRST QREGS0 + TRO FF,FRQPRN ;MARK THIS ( AS BEING FROM QREGX. + MOVEI T,CD + JRST OPEN2 ;SAVE ARGS, ETC; WILL COME BACK WHEN ")" IS SEEN + +QREGXR: MOVE C,NUM ;TO HERE. A HAS VALUE WITHIN THE PARENS. + MOVE E,SARG ;RESTORE THE SAVED ARGS. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + IORI FF,(CH) + SETZ B, ;RETURN B AS 0 TO SHOW THIS WASN'T A SUBSCTRIPTED QREG. + MOVEI CH,BAKTAB ;MAKE SURE, IF CALLER TRIES TO WRITE OUR QREG, NO HARM DONE. + RET + +;HERE TAKE CARE OF "SIMPLE" (..A OR ...^RX) TYPE QREG NAMES. +QREGXX: SETZB A,B + CALL QNMGE2 ;HERE FROM QREGX OR QREGS IF IT'S AN ORDINARY QREG NAME AFTER ALL. + TYPRE [IQN] + MOVE A,(CH) + POPJ P, + +;HERE TO READ EITHER QREG NAME OR "*" MEANING RETURN AS VALUE INSTEAD OF SETTING QREG. +;ASSUMES -1(P) IS CALLER'S RETURN ADDRESS, AND AOS'S IT SO CALLER RETURNS THE VALUE. +QREGVS: CALL SKRCH ;HERE TO ALLOW EITHER * OR SUBSCRIPTING. + CAIE CH,"* + JRST QREGS0 + MOVEI CH,A ;SUPPLY AC A AS ADDR OF "QREG". + SETZB A,B ;SAY ITS VALUE IS 0 (FOR THINGS LIKE ^ X). + AOS -1(P) ;MAKE OUR CALLER SKIP-RETURN + RET + +;READ IN A QREG NAME, ALLOWING SUBSCRIPTING (AS IN Q:.Q(10) = 10TH ELT OF Q-VECTOR IN .Q) +;ON RETURN FROM THIS OR ANY OTHER QREG-READING ROUTINE, IF B IS NONZERO +;THEN THE QREG WAS SUBSCRIPTED, AND B POINTS AT THE BUFFER BLOCK OF THE Q-VECTOR. +;WE ALSO HANDLE "LONG QREG NAMES" AS IN QFOO, SINCE THAT IS IMPLEMENTED +;BY MEANS OF INDEXING (INTO THE SYMBOL TABLE QVECTOR). +QREGS: CALL SKRCH +QREGS0: CAIN CH,ALTMOD + JRST QREGN ;CHECK FOR Q$FOO$ CONSTRUCT. + CAIE CH,": + JRST QREGXX + CALL QREGX ;FIRST, READ THE QREG WHICH IS THE Q-VECTOR TO SUBSCRIPT. + SAVE A ;SAVE IT AS IF IN A (. + SAVE [0] + SAVE LEV + MOVEM P,LEV + CALL QREGX ;THEN READ THE VALUE OF THE INDEX. + MOVE IN,A + MOVEI T,.+2 + JRST CLOSE2 ;POP STUFF OFF, LEAVING Q-VECTOR IN A. + MOVE BP,A + CALL QBGET1 ;GET BUFFER-BLOCK ADDR IN B. + SKIPN B + TYPRE [QNB] + IMULI IN,5 ;GET VIRTUAL CHAR ADDR INSIDE Q-VECTOR OF DESIRED WORD. + ADD IN,MFBEG(B) + TLZ IN,MFBBTS + CAML IN,MFBEGV(B) ;COMPLAIN IF NOT INSIDE VIRTUAL BOUNDS. + CAML IN,MFZV(B) + TYPRE [NIB] + CAML IN,MFGPT(B) + ADD IN,MFEXTR(B) ;TURN INTO REAL ADDRESS. + IDIVI IN,5 + MOVE A,(IN) ;FETCH CONTENTS OF WORD, + MOVE CH,IN ;AND ALSO RETURN ITS ADDRESS, FOR "U", ETC. + RET + +;COMMANDS THAT DO CONSING, AFTER CALLING QREGVS, SHOULD, IF B IS NONZERO, +;DO A JSP TT,QREGVA TO WORRY ABOUT CHANCE THAT CONSING WILL MOVE THE Q-VECTOR. +;QREGVA SAVES STUFF, CALLS BACK TO DO THE WORK, THEN FIXES UP AND RETURNS TO COMMAND'S CALLER. +;IF B IS NEGATIVE, THE QREG IS A NAMED VARIABLE, AND WE MAY NEED TO CALL A MACRO +;WHEN ITS VALUE CHANGES. WE PRESERVE B FOR USE2 TO ACCOMPLISH THAT. +QREGVA: SAVE B ;REMEMBER ADDR OF BUFFER BLOCK OF QVECTOR + SAVE CH ;REMEMBER ADDRESS OF WORD IN QVECTOR. + MOVE CH,MFBEGV(B) + IDIVI CH,5 ;BUT CONVERT IT INTO AN INDEX RELATIVE TO QVECTOR'S B. + MOVNS CH + ADDM CH,(P) + MOVEI CH,A ;NOW CALL THE COMMAND BACK, GETTING RESULT IN A. + SETZ B, + CALL (TT) + MOVE B,-1(P) ;NOW CONVERT REL. IDX. INTO QVECTOR BACK INTO ADDRESS. + MOVE CH,MFBEGV(B) + IDIVI CH,5 + ADD CH,(P) + SUB P,[2,,2] + MOVE C,A ;NOW GO STORE VALUE IN QREG. + JRST USE2 + +;HERE AFTER SEEING A QREG NAME STARTS WITH AN ALTMODE, AS IN QFOO. [ +QREGN: SETZM SQUOTP ;Q^]A WHERE A HOLDS $FOO$ SHOULD WIN. + SAVE C + SAVE E ;FO CLOBBERS ALL ACS + SAVE FF + MOVE A,QRB.. + MOVE A,.QSYMT(A) ;GET THE PTR TO THE QVECTOR USED AS SYMBOL TABLE. + MOVE BP,A + CALL QBGET1 + SAVE B + TRZ FF,FRCLN\FRARG\FRARG2\FRUPRW + CALL FOCMD0 ;DO FO TO READ IN THE "FOO" AND SEARCH SYMBOL TABLE. + JFCL ;PUTS VAL IN A AND ADDR OF S.T.E. IN IN. + MOVEI CH,1(IN) ;CH GETS ADDR OF SLOT IN QVECTOR HOLDING THE VALUE. + MOVE IN,(IN) ;IN GETS THE STRING WHICH IS THE FULL NAME. + REST B ;RETURN IN B THE BUFFER BLOCK OF THE QVECTOR + TLO B,400000 + REST FF ;(FOR RELOCATION HACKERY IN QREGVA FOR :I AND X). + REST E + JRST POPCJ + +;SKIP IF CHAR IN CH IS A LETTER OR A DIGIT. ALSO, CONVERT LOWER +;CASE LETETRS TO UPPER CASE. +QRVTST: CAIL CH,"0 + CAILE CH,"9 + CAIA + JRST POPJ1 + CAIL CH,"A + CAILE CH,"Z + CAIA + JRST POPJ1 + CAIL CH,"A+40 + CAILE CH,"Z+40 + POPJ P, + SUBI CH,40 + JRST POPJ1 + +;READ IN A QREG NAME, AND RETURN IN CH THE ADDRESS OF THE QREG. +;CLOBBERS A AND CH. +QNMGET: SETZI A, + CALL SKRCH +QNMGE2: CAIN CH,". + AOJA A,QNMGET+1 + CAIE CH,^R + CAIN CH,^^ + JRST QNMGE3 + CALL QRVTST + RET + CAILE A,NQSETS-1 + RET + AOS (P) +QNMGE1: MOVEI CH,-"0(CH) + CAILE CH,9 + SUBI CH,"A-"9-1 + ADD CH,QRB(A) + RET + +QNMGE3: LSH A,7 ;HANDLE QREG NAME CONTAINING "^R" OR "^^": + CAIN CH,^^ + XORI A,100 +QNMGE5: SETZM BRCUAV ;[ ;IF A ^]^V IS DONE, BRCUAV WILL BECOME NEGATIVE. + CALL SKRCH ;READ IN NAME OF ^R-MODE CHARACTER + SKIPGE BRCUAV ;[ ;THE POINT OF THIS IS THAT ^]^V TRUNCATES TO 7 BITS, + HRRZ CH,BRCUAV ;BUT WE HAVE TO GET BACK THE 9-BIT VALUE. + XOR CH,A ;GET THE SPECIFIED CHAR. IN TV CHAR SET. + ANDI CH,777 + ADDI CH,RRMACT ;THE "QREG" IS THE RRMACT ENTRY FOR THE CHARACTER. + JRST POPJ1 + +;F^^ -- CONVERT A ^R-COMMAND NAME INTO A NUMBER (F^^.^R. RETURNS 174. = 256) +;:F^^ -- IF IS A VALID Q-REG NAME, RETURN THE +;:FSQPHOME$ OF THE Q-REG. OTHERWISE, RETURN 0. +FCTLUP: TRZE FF,FRCLN + JRST FCUP1 + CALL QNMGET + TYPRE [ARG] + MOVEI A,-RRMACT(CH) + CAIL A,1000 + TYPRE [ARG] + JRST POPJ1 + +FCUP1: TRZ FF,FRARG + MOVE A,C ;:F^^. + CALL QLGET0 ;DECODE THE STRING, B.P. IN BP AND LENGTH IN B. + JRST NRET0 + SETZ A, ;COUNT NUMBER OF DOTS IN A. +FCUP2: SOJL B,NRET0 ;STRING EXHAUSTED => NOT VALID. + ILDB CH,BP + CAIN CH,". ;NEXT CHAR IS A DOT => JUST COUNT IT. + AOJA A,FCUP2 + CAIE CH,^R ;NON-DOT => WE'RE NEAR THE END NOW. + CAIN CH,^^ + JRST FCUP3 ;^R CHARACTER DEFN NAMES ARE OK TOO. + CALL QNMGE2 ;ELSE FIGURE OUT THE QREG NAME, + SETZ CH, ;NO SKIP MEANS IT ISN'T A VALID ONE, SO RETURN 0. + MOVE A,CH ;ELSE QNMGE2 LEFT THE DESIRED VALUE IN CH. + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +FCUP3: LSH A,7 ;^R CHARACTER DEFN NAME => PUT DOTS IN CTL AND META BITS, + CAIN CH,^^ + XORI A,100 ;FOR ^^ CONTROLIFY WHAT FOLLOWS. + SOJL B,NRET0 ;STRING EXHAUSTED RIGHT AFTER THE ^R OR ^^ => LOSE. + ILDB CH,BP + XOR A,CH ;ELSE MERGE CHAR WITH DOTS AND RETURN. + ANDI A,777 + ADDI A,RRMACT + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +;FO COMMAND - BINARY SEARCH A TABLE FOR A GIVEN STRING. +;FOLLOW BY QREG WHICH POINTS TO A STRING OR BUFFER CONTAINING THE TABLE +;(MUST BE ON A WORD BOUNDARY, SO USELESS WITH IMPURE STRINGS). +;AFTER THE QREG NAME COMES THE STRING TO SEARCH FOR. +;THE FIRST WORD OF THE TABLE MUST CONTAIN THE SIZE (IN WORDS) OF +;ALL THE ENTRIES; AFTER IT COME THE ENTRIES. THE FIRST WORD OF EACH ENTRY +;IS ASSUMED TO BE THE POINTER TO THE NAME-STRING TO SEARCH FOR. +;IF THE TABLE IS A PURE STRING, THAT PONTER IS RELATIVE TO THE TABLE ITSELF. +;PLAIN FO GETS AN ERROR (UVN OR AVN) IF THE TARGET NAME IS MISSING OR AMBIGUOUS; +;OTHERWISE, IT RETURNS THE VALUE IN THE SECOND WORD OF THE ENTRY. +;:FO RETURNS THE OFFSET OF THE ENTRY FOUND; IF THE TARGET IS NOT FOUND +;OR AMBIGUOUS, MINUS THE OFFSET OF THE ENTRY TO INSERT BEFORE IS RETURNED. +;FO RETURNS THE VALUE OF THE VARIABLE IF IT IS DEFINED, OTHERWISE. +;"^" MODIFIER => DON'T ALLOW ABBREVIATIONS, JUST EXACT MATCHES. +FOCMD: CALL QREGX ;READ THE QREG NAME. +FOCMD0: MOVEI J,STAB-1 ;THEN ACCUMULATE STRING TO SEARCH FOR IN STAB. + MOVEI B,40 ;B HOLDS PREVIOUS CHARACTER, FOR COMPRESSING SPACES. + TRZ FF,FRNOT +FOCMD1: CALL ORCH ;READ CHAR, CONVERT LETTERS TO U.C. + CAIN CH,ALTMOD + SKIPE SQUOTP + CAIA + JRST FOCMD2 + SKIPGE SQUOTP ;ALLOW FOR SUPERQUOTED SPACES + HRLI CH,-1 + CAIN CH,^I + MOVEI CH,40 ;CONVERT ALL TABS TO SPACES. + CAIN CH,40 ;CHECK FOR MULTIPLE OR LEADING WHITESPACE. + CAIE B,40 ;IF THIS CHAR AND PREVIOUS BOTH SPACING, IGNORE THIS ONE. + CAIA + JRST FOCMD1 + MOVE B,CH ;REMEMBER THIS CHAR AS PREVIOUS FOR NEXT. + HRRZS CH + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;REMEMBER CHAR IN STAB. + JRST FOCMD1 + +FOCMD2: CAIN B,40 ;FLUSH TRAILING SPACES. + SOS J +;ENTER HERE FROM F^G COMMAND. +FOCMD3: CALL QLGET0 ;GET TABLE LENGTH IN CHARS IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + IBP BP + HLRZ A,BP + CAIE A,350700 ;TABLE MUST START ON WORD BOUNDARY. + TYPRE [ARG] + MOVE C,(BP) ;C GETS ENTRY SIZE IN WORDS, FROM 1ST WORD OF TABLE. + MOVE OUT,B + IDIVI OUT,5 ;SIZE MUST BE INTEGRAL # OF WORDS. + SKIPE OUT+1 .SEE CH + TYPRE [ARG] + SOS CH,OUT ;OUT GETS TABLE SIZE, NOT COUNTING 1ST WORD (SIZE PER ENTRY). + IDIV CH,C + SKIPE CH+1 .SEE Q + TYPRE [ARG] ;TABLE MUST BE INTEGRAL NUMBER OF ENTRIES. + MOVEI IN,1(BP) ;IN -> 1ST WORD (NOT COUNTING ENTRY-SIZE WORD AT FRONT). + ADD OUT,IN ;OUT -> LAST WORD + 1 + HRRZ E,BP + IMULI E,5 ;E GETS CHAR ADDR OF START OF TABLE (INCLUDING DOPE WORD). + CAML E,BFRTOP ;IF TABLE IS A PURE STRING, SET FRNOT, INDICATING + TRO FF,FRNOT ;NAME POINTERS ARE RELATIVE TO BOTTOM OF STRING (NEED E ADDED). + SUBI E,4 + TLO E,400000 + MOVE T,OUT ;SAVE BOUNDS OF WHOLE TABLE AS [E,T) ;] + HRRZS J ;J POINTS AT END OF STUFF IN STAB. + CAIGE J,STAB + JRST FOCMDU ;ARG NULL AFTER HACKING IT => NO GOOD. + JRST FOCMDN + +;NOW TRY TO NARROW THE RANGE [IN,OUT) WHICH THE OBJECT MIGHT BE IN. ;] +;E HAS CHAR ADDR START OF TABLE MINUS 4 (WITH SIGN SET), +;T -> WORD AFTER END, C HAS ENTRY SIZE IN WORDS, +;J POINTS TO LAST USED WORD IN STAB. +FOCMDN: MOVE CH,OUT + SUB CH,IN + CAMG CH,C + JRST FOCMDF ;NARROWED TO ONE ENTRY => IT'S THAT OR NOTHING. + IDIV CH,C ;HOW MANY ENTRIES THEN? + MOVE D,CH + LSH D,-1 ;BINARY SEARCH STEP IS HALF THAT MANY. + IMUL D,C + ADD D,IN ;GET PTR TO MIDDLE OF RANGE; COMPARE THAT POINT WITH TARGET. + CALL FOCMP + JRST [ MOVE OUT,D ;TARGET IS LESS => NARROW TO BOTTOM HALF-RANGE. + JRST FOCMDN] + JRST [ MOVE IN,D ;TARGET IS MORE => NARROW TO TOP HALF-RANGE. + JRST FOCMDN] + MOVE IN,D + JRST FOCMDW ;TARGET IS EQUAL => WE CERTAINLY WIN. + +;NARROWED TO JUST ONE ENTRY; IS IT GOOD? +FOCMDF: CAML IN,T + JRST FOCMDU + MOVE D,IN ;FIRST OF ALL, THIS ENTRY IS THAT LAST ONE L.E. TARGET. + CALL FOCMP ;SO ADVANCE TO THE FIRST ONE G.E. THE TARGET + CAIA + ADD IN,C ;SINCE THE TARGET MIGHT BE ABBREVIATION FOR THAT ONE. + CAML IN,T ;DETECT CASE THAT TARGET IS GREATER THAN ALL SYMBOLS + JRST FOCMDU + MOVE OUT,IN + ADD OUT,C + MOVE A,(IN) + CALL FOCMDA ;DOES TARGET ABBREVIATE ENTRY'S NAME? + JRST FOCMDU ;NO => TARGET NOT FOUND, RETURN 0. + JUMPE B,FOCMDW ;YES, MAY BE GOOD. IF EXACT MATCH, CERTAINLY GOOD. + TRNE FF,FRUPRW ;"^" AND NOT EXACT MATCH => IT'S "UNDEFINED". + JRST FOCMDU + CAMN OUT,T + JRST FOCMDW ;NO FOLLOWING ENTRY => NAME CAN'T BE AMGIBUOUS. + MOVE A,(OUT) ;DOES FOLLOWING ENTRY ALSO WIN? + CALL FOCMDA + JRST FOCMDW ;NO => THIS ENTRY WINS! + TRNE FF,FRARG ;AMBIGUOUS NAME. IF HAVE DEFAULT (ARG), RETURN IT. + JRST FOCMDU + TRZN FF,FRCLN ;OR ELSE MAYBE GIVE ERROR, + TYPRE [AVN] +FOCMDL: MOVEI A,-1(IN) ;MAYBE RETURN MINUS THE PLACE TO PUT THE NAME. + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + IDIVI E,5 ;E GETS WORD BEFORE THE WORD TABLE STARTS IN. + SUBM E,A + JRST POPJ1 + +FOCMDU: TRZE FF,FRARG ;HERE IF NAME IS UNDEFINED; IN -> PLACE TO INSERT IT. + JRST [ TRZ FF,FRCLN\FRUPRW + MOVE A,NUM + JRST POPJ1] + TRZN FF,FRCLN + TYPRE [UVN] + JRST FOCMDL + +FOCMDW: MOVE A,1(IN) ;FOUND THE TARGET. RETURN EITHER 2ND WORD OF ENTRY + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + TRZN FF,FRCLN + JRST POPJ1 + MOVEI A,-1(IN) + IDIVI E,5 + SUB A,E + JRST POPJ1 ;OR THE INDEX OF THE ENTRY. + +;SKIP IF THE STRING IN STAB IS AN ABBREVIATION FOR THE STRING A POINTS TO +;(A HOLDS TECO STRING POINTER). +FOCMDA: TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;SKIP IF TARGET ABBREVIATES THE STRING A POINTS TO. + TYPRE [QNS] + MOVEI Q,STAB +FOCMDG: CAMLE Q,J + JRST POPJ1 ;JUMP IF TARGET ABBREVIATES ENTRY'S NAME. + JUMPE B,CPOPJ ;TARGET DOESN'T ABBREVIATE ENTRY'S NAME => TARGET NOT FOUND. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAME CH,(Q) + RET + SOS B + AOJA Q,FOCMDG + +;COMPARE STRING IN STAB (TARGET) WITH STRING THAT @(D) POINTS TO. SKIP ONCE +;IF TARGET BIGGER, SKIP TWICE IF EQUAL. +FOCMP: MOVE A,(D) ;GET THIS ENTRY'S NAME. + TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;DECODE AS STRING. + TYPRE [QNS] + MOVEI Q,STAB ;Q SCANS TARGET, BP SCANS THIS ENTRY'S NAME. +FOCMPL: JUMPE B,[CAMLE Q,J + JRST POPJ2 ;IF BOTH STRINGS EXHAUSTED, THEUY ARE EQUAL. + JRST POPJ1] ;TARGET HAS MORE => IT IS BIGGER. + CAMLE Q,J + RET ;TARGET EMPTY, BUT THIS ENTRY NAME HAS MORE => TARGET LESS. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMGE CH,(Q) + JRST POPJ1 ;TARGET IS BIGGER. + CAMLE CH,(Q) + RET ;TARGET SMALLER. + SOS B + AOJA Q,FOCMPL ;EQUAL SO FAR, KEEP LOOKING. + +SUBTTL DECODE A STRING POINTER + +;CH HAS QREG IDX; DON'T SKIP IF QREG NOT STRING. +;ELSE SKIP WITH B HOLDING # CHARS OF TEXT IN STRING (NOT INCLUDING HEADER), +;BP HOLDING A B.P. TO ILDB THE TEXT. CLOBBERS TT, TT1. +QLGET: MOVE A,(CH) +QLGET0: CAML A,[SETZ+LHIMAX*5*2000] + RET ;CAN'T BE EITHER PURE OR IMPURE SPACE. +QLGET1: MOVE BP,A + TLZ BP,400000 ;FLUSH THE SIGN BIT (SET IN ALL POINTERS) + CAMGE BP,BFRTOP ;IF IT'S IMPURE SPACE, + ADD BP,QRBUF ;POINTER IS RELATIVE TO START OF IMPURE SPACE. +QLGET2: PUSHJ P,GETBP +QLGET3: LDB B,BP + CAIN B,QRBFR + JRST QLGET5 + CAIE B,QRSTR + RET + AOS (P) +QLGET4: ILDB B,BP + ILDB TT,BP + ROT TT,7 + IOR B,TT + ILDB TT,BP + LSH TT,14. + IOR B,TT + SUBI B,4 + RET + +;HANDLE THE CASE IN WHICH QLGET IS CALLED ON QREG HOLDING A BUFFER. +QLGET5: CALL QLGET4 ;GET ADDR OF HEADER, MINUS 4, IN B. + ADDI B,4 + JUMPE B,CPOPJ ;GIVE 0 AS LENGTH OF DEAD BUFFER + SAVE T + SAVE C + MOVEI C,(B) ;IF THIS BUFFER IS CURRENT, THE VALUES IN ITS HEADER + CAMN C,BFRPTR ;MAY BE OUT OF DATE. UPDATE THEM BY RESELECTING. + CALL NEWBFR + MOVE BP,MFGPT(B) + CAMG BP,MFBEGV(B) + JRST QLGET6 + CAML BP,MFZV(B) ;IF THE GAP IS WHERE IT WILL DO HARM, THEN MOVE IT TO WHERE IT WON'T. + JRST QLGET6 + SAVE BFRPTR ;PUSH CURRENT BUFFER, + MOVEI C,(B) ;SELECT THE ONE BEING QLGET'ED + CALL NEWBFR + SAVE PT + MOVE BP,ZV + MOVEM BP,PT ;PUT PT WHERE WE WANT THE GAP TO BE + CALL GAPSL0 ;AND MOVE THE GAP THERE. (WITHOUT SETTING MODIFF, NOT REALLY MODIFYING) + REST PT + REST C ;POP THE SELECTED BUFFER. + CALL NEWBFR +QLGET6: REST C + MOVE BP,MFBEGV(B) ;GET VIRT ADDR OF BEGINNING OF BUFFER + MOVE T,MFZV(B) + SUB T,BP ;GET LENGTH OF BUFFER. + CAML BP,MFGPT(B) + ADD BP,MFEXTR(B) ;CONVERT VIRT ADDR TO REAL ADDR. + MOVE B,T + REST T + AOS (P) + JRST GETIBP ;RETURN IN BP, B.P. TO ILDB BUFFER. + +SUBTTL Q-REGISTER COMMANDS + +;FQ - RETURN LENGTH OF TEXT IN , OR -1 IF NOT TEXT. +QLEN: PUSHJ P,QREGX + PUSHJ P,QLGET0 +RETM1A: SKIPA A,[-1] + MOVE A,B + JRST POPJ1 + +;Q - RETURN CONTENTS OF QREG AS A NUMBER. +QREG: AOS (P) + JRST QREGX + +;% - INCREMENT , RETURN NEW VALUE. +PCNT: CALL QREGS ;READ QREG NAME, GET IDX IN CH. + AOS C,A ;INCREMENT. PUT IN C FOR USE2 AND IN A TO RETURN. + AOS (P) ;WE ALWAYS RETURN A VALUE. + JRST USE2 ;GO STORE BACK IN QREG. + +;U - PUT NUMERIC ARG IN . 2 ARGS => USE 2ND, RETURN 1ST. +USE: TRZN FF,FRARG + TYPRE [WNA] + ARGDFL + CALL QREGS +USE1: CAIN CH,A ;MAKE SURE U* IS A NO-OP. + JRST POPJ1 + TRZN FF,FRARG2 ;M,NUQ SHOULD RETURN M. + JRST USE2 + MOVE A,E + AOS (P) +;STORE THE CONTENTS OF C INTO THE QREG IN CH. +;B IS ASSUMED TO CONTAIN WHAT QREGX LEAVES THERE. +USE2: CAIN CH,$QBUFR ;SELECT A NEW BUFFER BEFORE! SETTING ..O, IN CASE IT GETS ERROR. + CALL BFRSET + SKIPE VARMAC + JUMPL B,USE3 ;IF SETTING A NAMED VARIABLE, SEE IF THERE'S A MACRO TO RUN. + MOVEM C,(CH) + RET + +USE3: SAVE A + SAVE B +IFN ITS,[ + MOVE A,MACHIN + CAMN A,[SIXBIT/AI/] +] + SKIPN A,1(CH) ;LOOK AT THE THIRD WORD OF THE NAMED VARIABLE'S DATA BLOCK. + JRST USE4 ;(IF VARMAC IS SET, WE ASSUME THAT WORD EXISTS). + CALL QLGET0 ;IS IT A STRING? + JRST USE4 + ILDB B,BP ;DOES IT START WITH "!"? + CAIN B,"! + CALL [ CALL SAVACS ;BOTH YES => CALL IT WITH NEW VALUE OF VARIABLE AS ARG. + CALL MACXCP + JRST RSTACS] +USE4: MOVEM C,(CH) ;THEN, OR IN ANY CASE, SET THE VARIABLE. +POPBAJ: REST B + REST A + RET + +;FP RETURNS AN INDICATION OF 'S DATA TYPE: +;-4 => NUMBER (NOT IN RANGE FOR PURE OR IMPURE STRING SPACE) +;-3 => PURE OBJECT WITH MEANINGLESS HEADER +;-2 => IMPURE OBJECT WITH MEANINGLESS HEADER +;-1 => DEAD BUFFER +;0 => LIVING BUFFER +;1 => Q-VECTOR. +;100 => PURE STRING +;101 => IMPURE STRING +FDATTY: MOVNI A,4 + TRZN FF,FRARG + TYPRE [WNA] + TLZN C,400000 ;MUST BE CLOSE TO 400000,, TO BE ANYTHING BUT A NUMBER. + JRST POPJ1 + MOVE BP,C + CAML C,BFRBOT ;IS IT IN RANGE FOR IMURE SPACE? + JRST [ MOVE D,LHIPAG + IMULI D,5*2000 + CAMGE C,[LHIMAX*5*2000] ;NO, WHAT ABOUT PURE SPACE? + CAMGE C,D + JRST POPJ1 ;NO, ORDINARY NUMBER + AOJA A,FDATT2] ;YES, SEE WHAT KIND OBJECT (A _ -3) + ADD BP,QRBUF ;ADDR'S IN IMPURE SPACE ARE REL. TO QRBUF. + MOVNI A,2 +;A HAS -2 FOR IMPURE SPACE, -3 FOR PURE SPACE. +;SEE IF OBJECT IS STRING, BUFFER OR NOTHING. +FDATT2: CALL GETIBP + ILDB B,BP + CAIN B,QRSTR ;STRING => RETURN 100. OR 101. + JRST [ ADDI A,103. + JRST POPJ1] + CAIE B,QRBFR + JRST POPJ1 ;NOTHING => RETURN -3 OR -2. + CALL QLGET4 ;BUFFER: IS IT STILL ALIVE? + ADDI B,4 ;B GETS BUFFER BLOCK ADDR, OR 0 IF DEAD BUFFER. + JUMPE B,RETM1A ;RETURN -1 IF DEAD. + MOVEI A,0 + MOVE C,(B) + TLNE C,MFQVEC + AOS A ;IF Q-VECTOR, RETURN 1, ELSE 0. + JRST POPJ1 + +QGET3: TRZ FF,FRARG\FRARG2 + JRST QGET4 + +;G COMMAND -- INSERT QREG IN BUFFER BEFORE PT. +;,G -- GET RANGE OF CHARS , FROM QREG. +;FS INSLEN$ IS SET TO # CHARS INSERTED. +;:G -- RETURN THE 'TH CHARACTER OF . +QGET: CALL QREGX +QGET4: CALL QLGET0 + JRST [ MOVE C,A ? JRST BAKSL1] + TRNN FF,FRARG + SETZ C, + CAMLE C,B ;MAKE SURE UNCOMMA'D ARG, IF ANY, IS WITHIN RANGE + MOVE C,B ;[0 , ] + SKIPGE C + SETZ C, + TRNE FF,FRARG ;DETECT THE 1-ARG CASE (ONLY LEGAL WITH COLON). + TRNE FF,FRARG2 + CAIA + JRST QGET7 + TRNN FF,FRARG2 ;(IF NO ARGS, C AND E MAY BE RANDOM. PREVENT 2<1 ERROR). + SETZB C,E + SKIPGE E + SETZ E, + CAMLE E,C ;MAKE SURE ARGS ARE IN INCREASING ORDER. + TYPRE [2%1] + TRNN FF,FRARG2 + SKIPA C,B ;IF NO ARGS, # CHARS TO INSERT IS LENGTH OF QREG. + SUB C,E ;IF ARGS, IT IS DIFFERENCE BETWEEN ARGS. + MOVEM C,INSLEN +QGETI: SAVE A + CALL SLP ;INSERT BUFFER SPACE OR PREPARE TO WRITE AT QRWRT. LEAVE BP. IN BP. + MOVE IN,BP + REST A + JUMPE C,SLPXIT + CALL QLGET0 ;IN CASE QREG IS BUFFER AND WAS MOVED BY SLPGET, + .VALUE ;RECOMPUTE THE BYTE PTR TO IT. + JUMPE E,QGET1 ;IF NOT STARTING AT BEGINNING OF STRING, + CALL GETCA ;MAKE B.P. -> ARG1'TH CHAR OF QREG. + ADD BP,E + CALL GETBP +QGET1: HLRZ CH,BP + HLRZ D,IN + CAIN CH,010700 + CAIE D,010700 ;IF WE'RE AT A WORD BOUNDARY IN BOTH QREG AND BUFFER, + JRST QGET2 + CAIGE C,5 ;AND TRANSFERING AT LEAST 1 WORD, + JRST QGET2 + IDIVI C,5 ;DO A BLT TO AVOID LOSING LOW BITS. + MOVEI CH,1(IN) + HRLI CH,1(BP) + ADD BP,C ;AND UPDATE BOTH B.P.'S TO POINT AFTER WHAT WE'RE BLT'ING. + ADD IN,C + BLT CH,(IN) + SKIPN C,D ;# CHARS NOT TRANSFERED BY THE BLT. + JRST QGET6 +QGET2: ILDB CH,BP + IDPB CH,IN + SOJG C,QGET2 +QGET6: MOVE BP,IN ;IF WRITING A STRING, SLPXIT REQUIRES B.P. TO LAST CHAR IN BP. +SLPXIT: TRZN FF,FRCLN ;WRITING IN BUFFER => FINISHED. + RET + TRZ FF,FRUPRW+FRARG+FRARG2 ;WRITING A STRING => FINISH CONSING AND RETURN IT. + AOS (P) + JRST QCLOSV + +QGET7: TRZN FF,FRCLN ;1 ARG TO G IS BAD NUMBER UNLESS WE HAVE A COLON. + TYPRE [WNA] + CAML C,B + TYPRE [ARG] + TRZ FF,FRUPRW+FRARG + CALL GETCA ;INCREMENT THE B.P. IN BP BY THE # CHARS WHICH IS THE ARG. + ADD BP,C + CALL GETBP + ILDB A,BP ;AND FETCH THAT CHARACTER AND RETURN IT AS VALUE OF :G. + JRST POPJ1 + +X: CALL QREGVS + CALL GETANU ;X COMMAND, GET ENDS OF AREA IN C,E. +X12: TRZ FF,FRARG\FRARG2 ;FLUSH ARG; AVOIDS LOSSAGE FOR X* WHICH RETURNS VALUE. + JUMPE B,X10 ;IS THE QREG SUBSCRIPTED? (X:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS X10, THEN RETURNS TO INSERT'S CALLER. + +X10: SAVE CH + SAVE B + TRZE FF,FRUPRW + PUSHJ P,QLGET0 ;APPENDING TO QREG-GET PREVIOUS LENGTH/LOCATION + SETZB B,BP + SAVE B + SAVE BP + CALL CHK1 + SUB C,E ;C HAS # CHARS TO X AWAY + ADDI C,4 ;THEN INCLUDE 4 CHARS FOR HEADER. + ADD C,-1(P) ;HOW MUCH SPACE, INCLUDING OLD STRING WE ARE APPENDING TO? + SAVE C + MOVN J,BEG + CALL SLPQGT ;MAKE SURE HAVE ENOUGH SPACE IN IMPURE STRING SPACE. + ADD J,BEG ;CHANGE IN BEG = AMOUNT BUFFER MOVED. + ADD E,J ;RELOCATE ADDR OF START OF AREA OF BUFFER TO X FROM. + MOVE C,(P) ;GET LENGTH INCL. HEADER. + MOVEI B,QRSTR ;AND 1ST CHAR FOR HEADER. + CALL QHDRW1 ;WRITE THE HEADER IN BOTTOM OF FREE AREA. + REST C + SUBI C,4 ;C HAS LENGTH NOT INCL. HEADER. + SKIPN J,-1(P) ;ANY CHARS TO APPEND TO? + JRST X8 + SUB C,J ;YES, COUNT OFF THAT MANY AS INSERTED, + MOVE OUT,(P) ;GET BP TO ILDB OLD TEXT TO APPEND TO, +X7: ILDB CH,OUT ;AND COPY INTO NEW STRING. + IDPB CH,BP + SOJG J,X7 +X8: MOVE IN,E +X1: SOJL C,X2 ;MAYBE INSERTED ALL THE CHARS. + CALL GETINC ;IF NOT, INSERT THE NEXT. + IDPB CH,BP + JRST X1 + +X2: CALL GETCA + AOS OUT,BP ;GET CHAR ADDR OF LAST+1. + TRZ FF,FRCLN\FRUPRW + SUB P,[2,,2] ;FLUSH INFO ON OLD STRING TO APPEND TO. + REST B + JRST QCLOSP ;POP QREG ADDR AND STORE STRING IN IT. + +SUBTTL Q-REGISTER PDL + +;[ - PUSH ONTO QREG PDL. ;] +OPENB: ARGDFL ;MAKE -[0 THE SAME AS -1[0 + CALL QREGX ;READ THE QREG VALUE IN A AND ADDR IN CH. + SAVE CH + SKIPLE B ;IF THIS QREG IS REALLY AN ELT OF A QVECTOR, + TYPRE [IQN] ;AUTO-UNWIND WOULD LOSE, SO COMPLAIN. + SKIPGE B + MOVE CH,IN ;FOR NAME QREGS, PUSH INTERNED NAME-STRING AS QREG ADDR. + SAVE B ;PRESERVE FLAG FOR USE1. + MOVE B,PF + CAMN B,PFTOP ;CHECK FOR OVERFLOW BEFORE WRITING ANYTHING. + TYPRE [QRP] + PUSH B,A ;THEN PUSH OLD CONTENTS + CALL OPENB3 ;GO PUSH ADDR OF QREG (FOR UNWINDING) AND RETURN. + REST B + REST CH ;GET BACK ACTUAL LOCATION OF QREG + TRZN FF,FRARG ;AND IF WE HAVE ARG, STORE ARG INTO IT. + RET + JRST USE1 ;DO IT VIA USE SO THAT STORING INTO ..O WORKS. + +OPENB2: MOVE B,PF + CAMN B,PFTOP ;DETECT OVERPUSH BEFORE A PDLOV INT HAPPENS. +OPENB1: TYPRE [QRP] + PUSH B,(CH) +OPENB3: PUSH B,CH +FSQPU2: MOVEM B,PF + POPJ P, + +;[[ ;] - POP FROM QREG PDL INTO . ]* POPS AND RETURNS AS VALUE. +CLOSEB: CALL QREGVS ;CAN MAKE US SKIP! + CAIA +;POP INTO ADDRESS SUPPLIED IN CH. ASSUME IT'S NOT A NAMED VARIABLE. +CLOSB2: SETZ B, ;B SUPPLIES INFORMATION TO USE2. + MOVE A,PF + CAMN A,PFINI ;DETECT UNDERFLOW FIRST THING. + TYPRE [QRP] + POP A,C + POP A,C ;C GETS VALUE POPPED FROM SLOT. + MOVEM A,PF ;MARK SLOT GONE BEFORE WE STORE, SINCE USE2 CAN ERR. + JRST USE2 + +;FS QPPTR $ -- GET OR SET QREG PDL POINTER. +;TAKES AND RETURNS # ENTRIES ON STACK. +FSQPPT: HRRZ A,PF + SUBI A,PFL-1 ;GET 2*<# ENTRIES NOW ON STACK> + LSH A,-1 ;A HAS VALUE TO RETURN. + TRZN FF,FRARG + JRST POPJ1 ;NO ARG => JUST RETURN THE VALUE. + CALL FSQPRG ;CONVERT ARG TO NEW PDL PTR. + MOVEM C,PF ;STORE NEW CONTENTS. + JRST POPJ1 + +;HANDLE ARGUMENT DECODING FOR FS QP SLOT, FS QP PTR, AND FS QP UNWIND. +FSQPRG: ARGDFL + JUMPL C,FSQPR1 + LSH C,1 ;ARG -> PTR TRANSFORMATION IS INVERSE OF + HRLI C,(C) ;PTR -> VALUE TRANSFORMATION DONE ABOVE. + ADD C,PFINI + CAMLE C,PF + JRST TYPAOR ;DON'T ALLOW REF. TO CELLS ABOVE CURRENT POINTER POS. + RET + +FSQPR1: LSH C,1 ;NEGATIVE ARG IS RELATIVE TO CURRENT POINTER. + HRLI C,-1(C) + ADD C,PF + CAMGE C,PFINI ;DON'T ALLOW REF BELOW BOTTOM OF QREG PDL. + JRST TYPAOR + RET + +PFINI: -LPF-1,,PFL-1 +PFTOP: -1,,PFL+LPF-1 + +;FS QP HOME$ RETURNS A STRING WHICH IS THE NAME OF THE Q-REG THAT WAS +;PUSHED INTO PDL SLOT . :FSQP HOME$ RETURNS A NUMBER THAT ENCODES +;THAT NAME - SUCH NUMBERS ARE USEFUL IN THAT, IN A GIVEN TECO, EACH QREG +;HAS A UNIQUE NUMBER. WITH NO COLON, IF THE SLOT WAS PUSHED WITH +;F[FOO$, WE RETURN "FSFOO$". ;] +;^ FS QPHOME$ CONVERTS AN NUMBER WHICH IS A :FSQPHOME VALUE INTO A +;DESCRIPTIVE FSQPHOME$-STYLE STRING. SO :FSQPHOME$ ^ FSQPHOME$ = FSQPHOME$. +FSQPHO: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRUPRW + JRST FSQPH2 + CALL FSQPRG ;FIND SLOT . + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + MOVE C,2(C) ;GET WHERE PUSHED FROM. + MOVE A,C +FSQPH2: TRZE FF,FRCLN ;NUMERIC FORM MAY BE WHAT WE WANT. + JRST POPJ1 ;OTHERWISE, MUST DECODE AND TURN INTO STRING: + ;ALREADY A STRING => IT IS VARIABLE NAME; PUT ALTMODES AROUND IT. + JUMPL C,[ MOVEM C,NUM + MOVEI A,[ASCIZ /[0 :I*Q0/] ;] + JRST MACXQV] ;THAT'S DONE MOST EASILY BY TECO COMMANDS. + MOVEI A,[ASCIZ /:I**/] + CAIN C,BAKTAB ;IF A [(...) PUSHED THIS SLOT, RETURN "*". ;] + JRST MACXQV + CAIGE C,FLAGSL*2 ;IF AN F[ PUSHED THIS, ;] + JRST [ MOVE C,FLAGS(C) ;RETURN NAME OF FLAG IN ASCII. + JRST FSIXFL] + MOVE E,C + MOVEI C,6 ;OTHERWISE IT WAS A NORMAL QREG OR A ^R COMMAND DEFINITION. + CALL QOPEN ;SO START CONSING UP A STRING WITH THE NAME. + MOVEI CH,"Q + IDPB CH,BP + CAIGE E,RRMACT + JRST FSQPH1 + SUBI E,RRMACT ;IT WAS A ^R COMMAND. WHAT WAS 9-BIT CHARACTER? + IDIVI E,200 + CALL FSQPH. ;PUT OUT 1 DOT FOR CTL, 2 FOR META, 3 FOR BOTH. + MOVEI CH,^R + IDPB CH,BP +FSQPH3: IDPB J,BP ;THEN THE ASCII PART OF THE CHARACTER. + AOS (P) + JRST QCLOSV ;INISH CONSING THE STRING AND RETURN IT. + +FSQPH1: SUBI E,QTAB ;ORDINARY OLD-FASHIONED QREG. + IDIVI E,36. ;HOW MANY DOTS? + CALL FSQPH. + ADDI J,"0 ;CONVERT WHAT'S LEFT TO A LETTER OR DIGIT. + CAILE J,"9 ;(STARTS OUT AS IDX IN QRB, QRB. OR QRB..). + ADDI J,"A-"0-10. + JRST FSQPH3 + +FSQPH.: MOVEI CH,". ;OUTPUT DOTS THRU BP IN BP. J SAYS HOW MANY. + JUMPE E,CPOPJ + IDPB CH,BP + SOJA E,FSQPH. + +MACXQV: CALL MACXQW ;EXECUTE A MACRO IN A AND RETURN THE VALUE IT RETURNS. + MOVE A,NUM + TRZ FF,FRARG\FRARG2\FRUPRW\FRCLN + JRST POPJ1 + +; FS QPSLOT $ -- RETURNS CONTENTS OF SLOT . +;,FS QPSLOT $ ALSO SETS THE SLOT TO . +FSQPSL: MOVE E,SARG + TRZN FF,FRARG ;MUST HAVE ARG TO KNOW WHICH SLOT. + TYPRE [WNA] + TRZE FF,FRARG2 ;IF 1 ARG, IT'S SLOT #, IN C. + TRO FF,FRARG ;IF 2, SLOT #'S IN C, NEW VALUE IN E. + CALL FSQPRG ;FIND ADDRESS OF DESIRED SLOT IN C. + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + EXCH C,E + AOJA E,FSNOR1 ;WORD TO GET OR SET IS 2ND WORD OF SLOT. + +; FS QPUNWIND $ -- UNWINDS QREG PDL TO LEVEL . +;THAT IS, POPS EACH ENTRY BACK INTO THE QREG IT WAS PUSHED FROM. +FSQPUN: TRZN FF,FRARG ;NO ARG => ASSUME 0. + SETZ C, + PUSHJ P,FSQPRG ;COMPUTE LEVEL TO UNWIND TO FROM ARG. +FSQPU0: MOVE B,PF +FSQPU1: CAMG B,C ;DOWN TO DESIRED LEVEL? + JRST FSQPU2 ;JUST SET PF & EXIT + POP B,CH ;POP 1 ENTRY + JUMPL CH,FSQPU5 ;JUMP IF "QREG ADDR" IS A STRING - MEANS IT IS QREG NAME, A LA QFOO. +IF2 IFG FLAGSL*2-QTAB,.ERR QRP CAN'T TELL [ FROM F[ + ;]] + CAIGE CH,FLAGSL*2 ;IF ENTRY WAS MADE BY AN F[, POP INTO FLAG. ;] + JRST FSQPU4 + CAIN CH,$QUNWN ;IF UNWINDING Q..N, + JRST [ MOVE A,(CH) + POP B,(CH) ;POP IT, STORING OR SAVING ALL TEMPS, + JRST FSQPU3];AND GO MACRO IT. + POP B,(CH) + CAIN CH,$QBUFR ;IF UNWINDING Q..O, WE'RE SELECTING A NEW BUFFER. + CALL BFRSE2 + JRST FSQPU1 + +FSQPU4: SAVE C ;HANDLE UNWINDING AN FS FLAG. + POP B,C ;GET OLD FLAG VALUE, AS ARG. + MOVS E,FLAGD(CH) + SAVE FF + IORI FF,FRARG ;SAY THERE'S AN ARG. + MOVEM B,PF + CALL (E) ;SET THE FLAG. + JFCL + REST FF ;DON'T LET THE ROUTINE CLOBBER THE VALUES. + REST C + JRST FSQPU0 + +FSQPU3: JUMPE A,FSQPU1 + JSP T,OPEN1 ;HANDLE UNWINDING Q..N; MUST PRESERVE TEMPS. +FSQPU6: SAVE C + MOVEM B,PF + CALL MACXQW ;EXECUTE THE INNER BINDING OF ..N (WHICH IS IN A). + REST C + HRROI T,FSQPU0 + TRZ FF,FRARG+FRARG2+FRSYL+FROP + JRST CLOSE2 ;POP WHAT OPEN PUSHED, AND GO TO FSQPU0 + +FSQPU5: MOVE A,CH ;POP INTO LONG-NAMED QREG WHOSE NAME IS IN CH. + JSP T,OPEN1 + MOVEM A,SARG + TRO FF,FRARG\FRARG2 + TRZ FF,FRCLN\FRUPRW\FRSYL\FROP + POP B,NUM + MOVEI A,[ASCIZ /[0 U0/] ;] + JRST FSQPU6 + +SUBTTL M SUBROUTINE CALL COMMAND + +;M SAVES CURRENT EXECUTION POINTERS AND THEN EXECUTES CONTENTS OF . + ; MAY CONTAIN TEXT OR THE ADDRESS OF A BUILT-IN FUNCTION. +;:M JUMPS INTO THE STRING IN AND DOESN'T RETURN - BUILT-IN FUNCTIONS NOT ALLOWED. +MAC: CALL QREGX ;GET A NAME AND PUT ITS ENTRY IN A + CAIL CH,RRMACT ;FOR M^R ETC, PUT THE CHARACTER WHOSE DEFINITION IS BEING RUN + CAIL CH,RRMACT+1000 + JRST MAC6 + SUBI CH,RRMACT ;IN Q..0. + MOVEM CH,$Q..0 +MAC6: MOVE CH,$Q..0 +MAC5: CALL QLGET0 ;REALLY TEXT? IF SO, LENGTH IN B, BP TO ILDB TEXT IN BP. + JSP T,MACN ;NOT REALLY TEXT; USE AS BUILT-IN FUNCTION ADDRESS. + TRNE FF,FRCLN ;IF YOU ARE DOING A :M, DON'T PUSH THE CALLING STRING + JRST MAC3 +MAC2: MOVEM BP,INSBP ;ELSE PUSH THE STRING CONTAINING THE "M" BEFORE JUMPING. + CALL PUSMAC ;WE SAVE THE B.P. TO THE MACRO BEING CALLED IN INSBP + MOVE BP,INSBP ;SO IT WILL BE RELOCATED BY GETFR2. + MOVEI CH,0 + IDPB CH,MACPDP ;PUSH A 0 (MACRO CALL) ENTRY. + .I MACSPF=PF ;REMEMBER QREG PDL LEVEL FOR THIS FRAME TO POP TO. + SETZM MACBTS +MAC3: MOVEM A,CSTR ;STORE TECO OBJECT POINTER TO WHAT WE'RE CALLING. + SETZ TT, ;PUT IN MACBTS INDICATIONS OF HOW MANY ARGS THERE ARE. + TRNE FF,FRARG ;MFBA1 AND MFBA2 ARE SIMPLY SET. + TLO TT,MFBA2 + TRNE FF,FRARG2 + TLO TT,MFBA1 + TRNE FF,FRUPRW ;MFBATSN IS SET TO WHETHER THERE WAS AN @, EXCEPT + TLO TT,MFBATSN + MOVSI C,MFBATSN ;THAT :M WITH NO @ DOES NOT CLEAR MFBATSN IF IT WAS SET. + ANDM C,MACBTS + IORM TT,MACBTS + MOVEI C,1 + TRZE FF,FRUPRW ;GET THE FIRST MACRO ARGUMENT (OR, IF NONE, + TRNE FF,FRARG ;EITHER 0 OR (IF FRUPRW) 1). + MOVE C,NUM + ARGDFL + MOVEM C,MARG2 ;SAVE IT AS THE THING ^Y GETS + MOVE C,SARG ;TRY FOR A SECOND ARGUMENT + TRNN FF,FRARG2 + MOVEI C,0 ;IF NONE, THEN 0 + MOVEM C,MARG1 ;SIGH + MOVEM B,COMCNT ;STORE LENGTH OF TEXT AS LENGTH OF MACRO. + MOVEM BP,CPTR ;GIVE RCH THE BP TO THE TEXT. + ILDB CH,BP ;NOW, START EXECUTING THE MACRO, BUT FIRST + CAIE CH,"W+40 ;UNLESS THE FIRST CHARACTER IS "W", MAYBE INVOKE FS STEPMAC$ + CAIN CH,"W + JUMPN B,CD + CALL CTLM2 + JRST CD + +;A IS ADDR 1ST WD ASCIZ STRING, EXECUTE STRING AS MACRO. +MACXCW: HRLI A,BP7 +MACXCT: SETO B, ;A IS BP -> STRING. + MOVE BP,A ;MUST COUNT # CHARS IN STRING. +MACXC1: ILDB CH,A + AOJ B, + JUMPN CH,MACXC1 + MOVE A,BP ;GIVE THE BYTE POINTER AS THE FS BACK STR$ SINCE THERE'S NO + JRST MACXC2 ;ACTUAL TECO OBJECT POINTER WE CAN USE. + +MACXQW: JUMPGE A,MACXCW ;EXECUTE EITHER A QREG OR AN ASSEMBLED-IN ASCII STRING. + ;DISTINGUISH THEM SINCE STRING QREGS ARE NEGATIVE. + +;A HAS CONTENTS OF A QREG; PUSHJ HERE TO EXECUTE IT, POPJ'ING AFTER IT FINISHES. +MACXQ: CALL QLGET0 ;GET LENGTH AND STARTING BP OF STRING. + JSP T,MACN1 ;(QREG CONTAINS A NUMBER; PUSHJ TO THAT LOCATION). +MACXC2: TRZ FF,FRUPRW + SAVE MACPTR + SAVE MACXP + MOVEM P,MACXP .SEE RCH2 + SETOM MACPTR ;-1 SAYS CALLED FROM MACXP. + JRST MAC2 + +MACN: TRZE FF,FRCLN ;HERE WHEN AN "M" COMMAND CALLS A BUILT-IN FUNCTION. + SETZM COMCNT ;:M TO BUILTIN => JUST DISCARD REST OF STRING AT THIS LEVEL. + SAVE [CDRET] ;POPJ TO EITHER (JRST TO) CD, OR VALREC IF SKIP. + MOVEI T,2+[ SUB P,[1,,1] ? JRST MAC5] +;T HAS 2+ ADDR TO GO TO IF THIS NUMBER "TURNS OUT" TO BE A STRING AFTER ALL. +;2+ IS SO CAN JSP AFTER A FAILING CALL TO QLGET0. +MACN1: ARGDFL ;MACROING A QREG CONTAINING A NUMBER. + TRNN FF,FRARG + MOVEI C,1 + MOVE E,A + ANDI A,-1 + CAIE A,RRINDR ;TRACE THRU INDIRECTD DEFINITIONS HERE, SO THAT + JRST RRLP7H + HLRE A,E ;IF THE ULTIMATE TARGET IS A STRING, WE CAN MACRO IT + SUB CH,A ;WITH OUT GOING THROUGH RRMACR. + MOVE A,RRMACT(CH) + JRST -2(T) + +;FSBACKTRACE$ - INSERT IN THE BUFFER THE TEXT OF THE MACRO IN FRAME . +;LEAVE POINT AT THE PC OF THAT FRAME. +FSBAKT: CALL BACKTR ;FIND THE FRAME THE USER SPECIFIED. +FSBAK1: CALL MFBEGP ;GET STARTING B.P. IN B AND CURRENT PC IN C. + SAVE B + ADD C,MFCCNT(A) ;C GETS TOTAL SIZE OF MACRO. + MOVEM C,INSLEN ;INSERT SPACE IN BUFFER TO HOLD THE STRING. + CALL SLPGET + MOVN A,MFCCNT(A) + ADDM A,PT + MOVE IN,BP + REST BP + JRST QGET1 + +;FS BACK PC$ - RETURN RELATIVE PC (OFFSET FROM 1ST CHAR) OF MACRO IN FRAME . +;,FS BACK PC$ - SET RELATIVE PC OF THAT FRAME TO . +; SETTIN THE PC TO A VERY LARGE NUMBER PUTS IT AT THE END OF THE STRING. +FSBAKP: CALL BACKTR + CALL MFBEGP ;C GETS CURRENT RELATIVE PC. + SAVE C + TRZN FF,FRARG2 ;DO WE WANT TO CHANGE IT? + JRST POPAJ1 + ADD C,MFCCNT(A) + CAMLE E,C ;IF ARG IS GREATER THAN # OF CHARS IN STRING, MAKE POINT AT END. + MOVE E,C + SKIPGE E ;NEGATIVE PC'S ARE MEANINGLESS. + TYPRE [AOR] + ADD BP,E ;IF SO, ADD DESIRED PC TO CHAR ADDR OF START + CALL GETBP ;CONVERT TO B.P. AND STORE AS THE FETCH POINTER. + MOVEM BP,MFCPTR(A) + SUB E,(P) ;GET THE DIFFERENCE BETWEEN NEW PC AND OLD + MOVNS E + ADDM E,MFCCNT(A) ;AND UPDATE NUMBER-OF-CHARS-TO-GO BY THAT MUCH. + JRST POPAJ1 + +;FS BACK QP PTR$ - RETURN FS QP PTR$ OF BOTTOM OF QP FRAME +;BELONGING TO MACRO FRAME . THIS IS THE QP PTR WHICH +;^\'ING THAT FRAME WOULD UNWIND TO. +FSBAKQ: CALL BACKTR + HRRZ A,MFPF(A) ;GET SAVED QREG PDL POINTER, + SUBI A,PFL-1 ;CONVERT IT TO A PDL DEPTH INDEX. + LSH A,-1 + JRST POPJ1 + +;FS BACK ARGS$ - RETURN ARGS OF MACRO FRAME . +FSBAKA: CALL BACKTR ;GET POINTER TO FRAME IN A. + MOVE C,MFLINK(A) ;GET FRAME'S SAVED MACBTS, MARG1, MARG2 + MOVE B,MFARG1(A) + MOVE A,MFARG2(A) + JRST FCTLX2 ;AND RETURN APPROPRIATE VALUES, A LA F^X. + +;FS BACK STRING$ - RETURN STRING POINTER TO MACRO BEING EXECUTED IN FRAME . +;IF THAT MACRO ISN'T A STRING, WE RETURN A BYTE POINTER (A NUMBER). +;THERE IS NO WAY TO DECODE SUCH BYTE POINTERS, BUT THEY CAN BE COMPARED RELIABLY. +FSBAKS: CALL BACKTR ;GET FRAME POINTER IN A. + MOVE A,MFCSTR(A) + JRST POPJ1 + +;SUBROUTINES FOR FS BACK WHATEVER. + +;A POINTS AT A MACRO FRAME (OR AT COMCNT); RETURN IN B A B.P. TO THE MACRO'S START, +;AND IN C THE DISTANCE IN CHARACTERS OF THE CURRENT PC FROM THE START. +MFBEGP: MOVE BP,MFCPTR(A) + CALL GETCA + MOVE C,BP + SAVE A + MOVE A,MFCSTR(A) + CALL QLGET0 + MOVE BP,A + MOVE B,BP ;B GETS B.P. TO START OF MACRO. + CALL GETCA ;BP GETS CHAR ADDR OF IT. + SUB C,BP + JRST POPAJ + +;RETURN IN A A POINTER TO THE MACRO FRAME SPECIFIED BY THE DEPTH IN C. +;IF C IS POSITIVE, IT IS COUNTING FROM THE BOTTOM OF THE STACK +;(0 = OUTERMOST FRAME). IF IT IS NEGATIVE, IT COUNTS DOWN FROM THE +;CURRENT FRAME (-1 = THIS FRAME'S CALLER). +BACKTR: ARGDFL Z + MOVNS C + SKIPG C + ADD C,MACDEP ;C NOW HAS NUMBER OF FRAMES TO GO OUT FROM CURRENT ONE. + SOJL C,TYPAOR ;ILLEGAL TO REFER TO CURRENT FRAME, SINCE IT ISN'T STORED THE SAME WAY. + MOVE B,MACXP + HRRE A,MACPTR ;START WITH TOP OF MACPTR STACK (CURRENT MACRO'S CALLER). +BACKT0: JUMPGE A,BACKT2 + HRRE A,-1(B) ;WHENEVER A MACXQ CALL IS FOUND, GO BACK THROUGH IT. + MOVE B,(B) + JRST BACKT0 + +BACKT2: JUMPE A,TYPAOR + JUMPE C,[ ;HAVE WE GONE OUT ENOUGH FRAMES? + SUBI A,MFLINK + RET] + HRRE A,(A) ;NO, GO OUT ONE FRAME MORE. + SOJA C,BACKT0 + +GMARG2: SKIPA A,MARG2 +GMARG1: MOVE A,MARG1 + JRST POPJ1 + +SUBTTL CONVERT NUMBERS TO STRINGS + +BAKSL: TRZ FF,FRUPRW + TRZE FF,FRARG + JRST BAKS1A + SETZ A, + MOVE IN,PT + PUSHJ P,GETINC + TRZE FF,FRCLN + CAIE CH,"- + JRST BAKSL7 + TRO FF,FRARG +BAKSLA: PUSHJ P,GETINC +BAKSL7: CAMLE IN,ZV + JRST BAKSL3 +BAKSL6: CAIG CH,"9 + CAIGE CH,"0 + SOJA IN,BAKSL2 + JFCL 10,.+1 + IMUL A,IBASE + JFCL 10,[TLC A,400000 ? JRST .+1] ;MAKE OVERFLOW ACT AS IF UNSIGNED MULTIPLY. + ADDI A,-60(CH) + JRST BAKSLA + +BAKSL3: MOVE IN,ZV +BAKSL2: TRZE FF,FRARG + MOVNS A + MOVEM IN,PT + JRST POPJ1 + +;\ WRITE IN BASE IN ..E, INTO BUFFER. :\ CONS INTO STRING AND RETURN IT. +;,\ USE COLUMNS, MAKING LEADING SPACES IF NEEDED. +BAKS1A: MOVEI TT,40 + HRRM TT,DPT5 + SOS TT,E + TRZE FF,FRARG2 + SKIPA BP,[DPT1] +BAKSL1: MOVEI BP,DPT + MOVE T,[(700)BAKTAB-1] + MOVEI E,0 + MOVEI CH,[IDPB CH,T ? AOJA E,CPOPJ] + HRRM CH,LISTF5 + PUSHJ P,(BP) + MOVE C,E + MOVEM C,INSLEN + CALL SLP ;INSERT THEM, OR PREPARE TO WRITE STRING. GET BP IN BP. + MOVE T,[440700,,BAKTAB] +BAKSLL: ILDB CH,T ;COPY THE PRINTED STUFF INTO INSERTED SPACE. + IDPB CH,BP + SOJG C,BAKSLL + JRST SLPXIT ;IN CASE OF :\, FINISH CONSING THE STRING. + +SUBTTL CONTROL CONSTRUCTS + +FDQUOT: SUB P,[1,,1] ;F" LIKE " BUT ARGUMENT REMAINS AS WELL AS BEING TESTED. + SKIPA A,[CD2A] +DQUOTE: MOVEI A,CD + CALL LRCH ;READ THE CONDITION NAME (B, C, G, L, E, N, #) + CAIN CH,"# ;IS THIS AN "ELSE"? + JRST [ CALL NOGO ;YES, FAIL: SKIP TO THE ', + JRST CD2A] ;RETURN WITHOUT FLUSHING VALUE. + CAIN CH,"' + JRST VCOND + SAVE A ;REMEMBER RETURN ADDRESS (CD OR CD2A). + CALL CONDIT ;DECODE THE CONDITION, + XCT A ;TEST IT, + TRC FF,FRCLN ;TAKE THE EQV OF ITS SUCCESS AND THE COLON FLAG. + TRZN FF,FRCLN + JRST CTLM2 ;NON-: CONDITION WON OR :-CONDITION LOST, INVOKE STEPPER AND RETURN. +NOGO: MOVEI A,0 ;CONDITION FAILED. SKIP TO THE ' AND CHECK FOR AN ELSE. + MOVE C,COMCNT ;REMEMBER WHERE STARTING FROM, SO IF HAVE UTC ERROR + MOVE E,CPTR ;CAN SIGNAL IT AT THE ". +NOGO1: SOSGE COMCNT + JRST [ MOVEM C,COMCNT + MOVEM E,CPTR + TYPRE [UTC]] + ILDB CH,CPTR + CAIN CH,"" + AOJA A,NOGO1 + CAIE CH,"' + JRST NOGO1 + SOJGE A,NOGO1 + CALL TRACS ;FOUND THE TERMINATING '. MENTION IT IF TRACING. + MOVE A,COMCNT + MOVE BP,CPTR +NOGO2: SOJL A,CPOPJ ;AFTER THE MATCHING ', CHECK FOR AN ELSE ("#) + ILDB CH,BP ;IS THE NEXT CHAR A DOUBLEQUOTE? + CAIE CH,^M + CAIN CH,^J ;ALLOW CRLFS TO INTERVENE BEFORE THE DOUBLEQUOTE. + JRST NOGO2 ;JUST PASS THEM BY. + SKIPGE TABMOD + CAIE CH,^I + CAIN CH,40 + JRST NOGO2 ;ALSO ALLOW SPACES BETWEEN. + CAIN CH,"! ;ALSO ALLOW TAGS BETWEEN. + JRST NOGO3 + CAIE CH,"" + RET ;NO - THERE IS NO "ELSE" + SOJL A,CPOPJ ;MAKE SURE A "#" FOLLOWS THE """". + ILDB B,BP + CAIE B,"# + RET + CALL TRACS ;THERE IS AN ELSE - TRACE THE " AND #. + MOVEI CH,"# + CALL TRACS + MOVEM BP,CPTR ;RESUME EXECUTION INSIDE THE ELSE CLAUSE. + MOVEM A,COMCNT + JRST CTLM2 ;WE HAVE JUST ENETERED AN ELSE CLAUSE, SO INVOKE STEPPER. + +NOGO3: SOJL A,CPOPJ + ILDB CH,BP ;SKIP UNTIL THE NEXT "!", THEN CONTINUE LOOKING FOR '"#'. + CAIE CH,"! + JRST NOGO3 + JRST NOGO2 + +;READ THE NAME OF A CONDITION, AND RETURN IN A +;AN INSTRUCTION TO SKIP IF THE CONDITION IS TRUE. +CONDIT: TRNN FF,FRARG + TYPRE [WNA] ;THIS IS A NUMERIC CONDITIONAL: SNARF THE ARG. + MOVEI A,C +IRPC Z,,[GLNE] + CAIN CH,"Z + HRLI A,(SKIP!Z) +TERMIN + CAIN CH,"A + MOVE A,[CALL DQTLET] + CAIN CH,"D + MOVE A,[CALL DQTDGT] + CAIN CH,"U + MOVE A,[CALL DQTUC] + CAIN CH,"C + MOVE A,[CALL DQT1] + CAIN CH,"B + MOVE A,[CALL DQT3] ;B => GET INSN TO SKIP IF GIVEN A BREAK CHARACTER. + TLNN A,-1 ;IF WE DIDN'T RECOGNIZE THE CONDITION, SIGNAL AN ERROR. + TYPRE [BD%] + RET + +DQT1: PUSHJ P,DQT3 ;SKIP IF CHAR IN C IS NOT A BREAK CHARACTER. + AOS (P) + RET + +DQTLET: CAIG C,"Z+40 ;SKIP IF CHARACTER IN C IS A LETTER. + CAIGE C,"A+40 +DQTUC: CAIG C,"Z ;SKIP IF THE CHARACTER IN C IS AN UPPER-CASE LETTER. + CAIGE C,"A + RET + JRST POPJ1 + +DQTDGT: CAIG C,"9 ;SKIP IF THE CHARACTER IN C IS A DIGIT. + CAIGE C,"0 + RET + JRST POPJ1 + +VCOND: CALL LRCH ;"' COMMAND: TEST A CONDITION, + CALL CONDIT ;BUT RETURN -1 IF IT SUCCEEDS, OR ELSE 0. + XCT A ;THUS, 0"'N RETURNS 0 BUT 1"'N RETURNS -1. + TRC FF,FRCLN + TRZ FF,FRARG + SAVE [CDRET] + TRZN FF,FRCLN + JRST NRETM1 + JRST NRET0 + +EXCLAM: SETOM BRC1 ;HANDLE "!" AS A COMMAND. + CALL SKRCH ;[ ;SKIP UNTIL THE NEXT "!". BRC1 INHIBITS MOST ^] FORMS. + CAIE CH,"! + JRST .-2 + SETZM BRC1 + CALL TRACS ;IN TRACE MODE, TRACE A SECOND "!" TO MINIMIZE USER CONFUSION. + JRST CD5A + +LRCH: PUSHJ P,RCH + TRNE CH,100 + ANDCMI CH,40 + POPJ P, + +;HANDLE THE "O" COMMAND: O$ JUMPS TO !!. ":O" DOES NOT ERR IF TAG UNFOUND. +OG: MOVE A,CPTR ;FIRST, LOOK IN THE JUMP CACHE FOR ADDR OF "O" CMD. + MOVE C,A + ANDI C,16 ;GET INDEX IN CACHE OF ENTRY PAIR THAT'S APPRO. + CAMN A,SYMS(C) ;IS FIRST ENTRY FOR THIS "O"? + JRST OGFND + CAMN A,SYMS+1(C) ;IS THE SECOND? + AOJA C,OGFND ;IF FOUND, GET PLACE TO JUMP TO FROM CACHE ENTRY. +;THIS JUMP NOT IN CACHE; MUST ACTUALLY SEARCH. + SAVE CPTR ;PUSH INFO ON WHERE TO STORE INTO CACHE WHEN FIND TAG. + SAVE C ;THESE 2 WORDS ARE NOT USED FOR ANY OTHER PURPOSE. + CALL OARG ;READ IN THE STRING ARG. + MOVEI A,COMCNT + CALL MFBEGP ;FIND START OF CURRENT MACRO. + EXCH BP,B ;NOW BP HAS BP TO START, B HAS STRING POINTER TO MACRO, + ADD C,COMCNT ;C HAS TOTAL SIZE OF MACRO. + CAMGE B,BFRTOP + CAMGE B,QRWRT ;ARE WE IN A STRING? OR IN A BUFFER OR CBUF? + CAMGE B,QRBUF + SETOM BRCFLG ;JUMPS IN BUFFERS AND CBUF AREN'T CACHED, + ;SINCE THE DATA AT A GIVEN LOCATION IS LIKELY TO CHANGE. + +;NOW SEARCH FOR THE DESIRED LABEL. + TRNE FF,FRUPRW + SOS J +OG4: MOVEI D,STAB +OG5: CAIN D,1(J) + JRST OG3 + SOJL C,OGUGT ;COMPARE MACRO CHAR BY CHAR AGAINST TAG. + ILDB CH,BP + CAIL CH,"A+40 ;CONVERT TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN CH,(D) + AOJA D,OG5 + TLNE BP,760000 ;AT WORD BOUNDARY => TRY TO SKIP WORDS FAST. + JRST OG4 +OG6: SUBI C,5 + JUMPL C,OG7 ;NOT A WHOLE WORD LEFT TO SCAN => CAN'T GO FAST. + MOVE D,1(BP) ;ELSE GET THE NEXT WORD + XOR D,[ASCII /!!!!!/] ;AND SEE IF THERE ARE ANY !'S IN IT. + TLNE D,(177_35) + TLNN D,(177_26) + JRST OG7 + TRNE D,177_1 + TRNN D,177_10 + JRST OG7 + TDNN D,[177_17] + JRST OG7 + AOJA BP,OG6 ;THERE ARE NONE, SO WKIP THIS WORD. + +OG7: ADDI C,5 ;FOUND AN !, SO SCAN SLOWLY TO LOCALIZE IT. + JRST OG4 + +;COME HERE WHEN WE HAVE FOUND THE TAG BY SEARCHING. +OG3: MOVEM C,COMCNT ;SET COMMAND-READING POINT TO WHERE WE FOUND THE TAG. + MOVEM BP,CPTR + REST A ;REMEMBER IDX OF CACHE ENTRY TO STORE IN. + REST B ;REMEMBER CPTR OF "O" TO PUT IN CACHE + SKIPE BRCFLG + JRST OGXIT ;BUT MAYBE CACHE IS INHIBITED FOR THIS JUMP. + EXCH B,SYMS(A) ;STORE THIS JUMP IN 1ST ENTRY OF PAIR, AND MOVE + MOVEM B,SYMS+1(A) ;OLD CONTENTS OF 1ST ENTRY INTO 2ND. + MOVE B,COMCNT + EXCH B,CNTS(A) ;CACHE ENTRY CONTAINS CPTR OF "O", + MOVEM B,CNTS+1(A) ;CPTR OF TAG, AND COMCNT OF TAG. + MOVE BP,CPTR + EXCH BP,VALS(A) + MOVEM BP,VALS+1(A) + JRST OGXIT + +OGFND: TRNE FF,FRTRACE + CALL OARG ;IF TRACING, READ IN ARGUMENT SO IT WILL SHOW IN TRACE. + MOVE A,VALS(C) ;COME HERE WHEN THE JUMP IS FOUND IN THE CACHE. + MOVEM A,CPTR + MOVE A,CNTS(C) + MOVEM A,COMCNT +OGXIT: TRZ FF,FRCLN + TRZN FF,FRUPRW + JRST CD + MOVEI CH,"! + CALL TRACS + JRST EXCLAM ;@ O => WE'RE INSIDE A LABEL, SO WE MUST SKIP TO THE END. + +OGUGT: TRZN FF,FRCLN ;COME HERE IF TAG IS NOT FOUND. + TYPRE [UGT] + SUB P,[2,,2] + JRST CD + +;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD +;IN STAB, WITH AN ! BEFORE AND AFTER. LEAVE J -> LAST +;WORD USED IN STAB. USED BY "O" AND "F;". ;[ +;BRCFLG LEFT NONZERO IFF SOME UNPREDICTABLE ^] CALLS TOOK PLACE. +;CLOBBERS A, CH. +OARG: MOVEI J,STAB+1 + MOVEI A,41 + MOVEM A,-1(J) + SETZM BRCFLG ;[ ;ANY ^] CALLS WE WORRY ABOUT WILL SET BRCFLG. +OGNF1: CAIN J,STAB+LTABS + TYPRE [STL] + CALL ORCH + HRRZM CH,(J) + SKIPN SQUOTP + CAIE CH,ALTMOD + AOJA J,OGNF1 + MOVEM A,(J) + RET + +ORCH: CALL RCH ;READ CHAR AND CONVERT L.C. LETTERS (ONLY) TO U.C. + CAIL CH,"A+40 + CAILE CH,"Z+40 + RET + SUBI CH,40 + RET + +;SEMICOLON AND ITERATIONS. + +SEMICL: SKIPN ITRPTR + TYPRE [SNI] + TRNN FF,FRARG + MOVE C,SFINDF + TRNN FF,FRUPRW ;UNLESS THE ^ FLAG IS SET, CONVERT SIGN TO NONZERO-NESS. + ASH C,-35. + MOVE A,[JUMPN C,CD] ;THEN WIN (KEEP ITERATING) IF NONZERO, + TRNE FF,FRCLN ;OR, IF COLON, WIN IF ZERO. + HRLI A,(JUMPE C,) + XCT A +INCMA0: MOVEI CH,"> ;"TRACE" A ">" TO HELP USER UNDERSTAND. + CALL TRACS + MOVEI A,0 + MOVE BP,CPTR + MOVE C,COMCNT ;SEARCH FOR THE ">" THAT ENDS THIS ITERATION. +INCMA1: SOJL C,[HRRO A,ITRPTR + CALL ITRPOP + TYPRE [UTI]] + ILDB CH,BP + CAIN CH,"< + AOJA A,INCMA1 + CAIE CH,"> + JRST INCMA1 + SOJGE A,INCMA1 + MOVEM BP,CPTR + MOVEM C,COMCNT + +;HERE THE CODE FOR ">", ";", "F;", AND ERRORS INSIDE ERRSETS, +;MERGES INTO ONE. +INCMA2: HRRO A,ITRPTR ;PTR TO INNERMOST ITER OR ERRSET. + HLRZ TT,ITRPTR ;TO INNERMOST ERRSET. + MOVEI E,(A) + CALL FSEMIP ;SKIP IF THIS ITERATION WAS A CATCH. + CAIN TT,(A) ;SKIP UNLESS IT WAS AN ERRSET. + SKIPA TT,[-1] ;TT HAS -1 IF CATCH OR ERRSET, + SETZ TT, ;0 FOR ORDINARY ITERATION. + CALL ITRPOP ;POP THE ITERATION FRAME. + JUMPE TT,CD ;FOR ORDINARY ITER'S, THAT'S ALL. +;EXITING A CATCH OR ERRSET: 1ST, WE MAY HAVE JUST UNWOUND +;AND NEED TO RESET PDLS. 2ND, WE MUST RETURN A VALUE SAYING +;WHETHER WE EXITED NORMALLY. + TRZ FF,FRARG+FRARG2+FROP+FRSYL+FRCLN+FRUPRW + AOS A,ERRFLG ;EXITING ERRSET, WAS THERE ERROR? + JUMPN A,[SETZ A, ? JRST VALREC] ;RETURN 0 IF NO ERROR. + HLRZ CH,C + HRLI CH,1-PDL-LPDL(CH) + CAME P,CH ;IF CH=P, SETP IS NOT NEEDED, AND RET. ADDR WOULD BE ABOVE P! + PUSHJ CH,SETP ;MOVE P,CH , CHECK FOR UNWINDING PARENS, SORT OR ^R, THEN POPJ P, + HRLI C,1-PFL-LPF(C) + CALL FSQPU0 ;ON ERROR IN ERRSET, UNWIND QREG PDL + MOVE A,LASTER + JRST VALREC + +;A CONTAINS ITRPTR'S RH; POP OFF AN ITERATION. +ITRPOP: POP A,ITRPTR + POP A,C + POP A,(A) + POP A,ITERCT + MOVEI A,-MFICNT(A) + JRST FLSFRM + +GRTH: SKNTOP ITRPTR + TYPRE [UMC] + TRZE FF,FRUPRW + JRST GRTH1 + SOSN ITERCT + JRST INCMA2 +GRTH1: HRRO A,ITRPTR + SUBI A,MFBLEN-MFCPTR-1 + POP A,CPTR + POP A,COMCNT + MOVEI CH,^M + CALL TRACS + MOVEI CH,^J + CALL TRACS + MOVEI CH,"< + CALL TRACS + JRST CD + +FLSSTH: SUB P,[1,,1] +LSSTH: PUSHJ P,GETFRM + MOVE TT,PF + HRLI TT,(P) +INSIRP PUSH A,COMCNT CPTR CSTR ITERCT MACPDP TT ITRPTR + HRRM A,ITRPTR ;STORE PTR TO INNERMOST ITER OR ERRSET. + TRZE FF,FRCLN ;IF THIS IS ERRSET, SET PTR TO + HRLM A,ITRPTR ;INNERMOST ERRSET. + TRZE FF,FRARG + JRST LSSTH2 + SETOM ITERCT + JRST CD + +LSSTH2: JUMPLE C,INCMA0 + MOVEM C,ITERCT + JRST CD + +CNTRLN: SETOM GEA + TRNE FF,FRARG + MOVEM C,NLINES + TRZN FF,FRCLN + RET + AOSE TTMODE + SETOM TTMODE + POPJ P, + +;F;$ - THROW TO , RETURNING 1 (OR F;'S ARG, IF ANY) FROM THE F<...>. +FSEMIC: TRZN FF,FRARG + MOVEI C,1 + SAVE C + CALL OARG ;READ INTO STAB, WITH "!"'S. +;NOW LOOK AT ALL ITERATIONS, INNERMOST FIRST, FOR ONE WHICH +;IS A CATCH WITH THE APPROPRIATE TAG. + HRRZ E,ITRPTR +FSEMI1: JUMPE E,[TYPRE [UCT]] ;UNSEEN CATCH TAG. + CALL FSEMIP ;IS THIS ITERATION A CATCH? + JRST FSEMI2 ;NO, LOOK AT NEXT ONE OUT. + IBP BP + MOVEI D,STAB ;YES, COMPARE ITS TAB WITH . + MOVE A,MFCCNT-MFBLEN+1(E) +FSEMI3: SOJL A,FSEMI2 ;F< TAG ENDED TOO SOON - MISMATCH. + ILDB TT,BP + CAIL TT,"A+40 ;CONVERT L.C. LETTERS TO U.C. + CAILE TT,"Z+40 + CAIA + SUBI TT,40 + CAME TT,(D) + JRST FSEMI2 ;THE CHARS DIFFER. + ADDI D,1 ;ADVANCE TO NEXT CHAR IN + CAME D,J + JRST FSEMI3 +;WE'VE FOUND A CATCH WITH OUR TAG! + REST LASTER ;VALUE TO BE RETURNED FROM F<...>, WHERE ERRP3 WANTS IT. + SETOM ERRFLG ;FAKE INCMA2 INTO RETURNING NEGATIVE. +FSEMI4: HRRO A,ITRPTR ;POP OFF ALL ITERATIONS INSIDE THE + CAIN E,(A) ;CATCH WE'RE POPPING TO. + JRST [ HRLM E,ITRPTR ;THEN PRETEND THIS CATCH WAS AN ERRSET + JRST ERRP3] ;AND ERR OUT OF IT. + CALL ITRPOP + JRST FSEMI4 + +;COME HERE IF ITERATION ISN'T A CATCH, OR HAS WRONG TAG. +FSEMI2: HRRZ E,MFLINK-MFBLEN+1(E) + JRST FSEMI1 + +;E -> AN ITERATION FRAME. SKIP IF THAT ITERATION IS REALLUY A +;CATCH. IN THAT CASE, RETURN IN BP B.P. TO ILDB THE "<". +FSEMIP: MOVE BP,MFCPTR-MFBLEN+1(E) + SUBI BP,1 ;BACK UP BP BY 2 CHARS. +REPEAT 3,IBP BP + ILDB C,BP ;FETCH THE CHAR BEFORE THE "<" + CAIE C,"F+40 + CAIN C,"F ;IF IT'S "F", THIS ITERATION'S A CATCH. + AOS (P) + RET + +SUBTTL ^P SORT COMMAND + +;THE SORT TABLE IS A TABLE OF POINTERS TO SORT RECORDS. +;PSMEM POINTS AT THE FIRST ENTRY. PSMEMT POINTS PAST THE LAST ONE. +;EACH ENTRY IS 4 (LPSDBK) WORDS LONG. +;THE 1ST WORD OF AN ENTRY IS EITHER A B.P. TO THE START OF THE RECORD'S KEY + ;OR THE KEY ITSELF IF IT IS A NUMBER. +;THE SECOND WORD'S RH IS THE LENGTH OF THE KEY IF THE KEY IS A STRING, + ;OR -1 IF THE KEY IS A NUMBER. +;THE SECOND WORD'S LH IS MINUS THE LENGTH OF THE RECORD IN CHARACTERS. +;THE THIRD WORD IS THE CHAR ADDR OF THE START OF THE RECORD. +;THE FOURTH WORD POINTS TO THE NEXT ENTRY (IN ORIGINAL ORDER BEFORE SORT, + ;IN SORTED ORDER AFTER. THIS IS THE LINK FOR A LIST SORT). + +PSORT: ISKERR ;CAN'T SORT WITHIN SORT. + SAVE FF ;REMEMBER FRCLN (PSI SETS IT) + MOVE CH,[JRST [ + CALL RCH ;READ CHAR, + SKIPGE SQUOTP ;SUPERQUOTED => + JRST INSDIR ;JUST INSERT. + CAIE CH,"$ ;ELSE REPLACE $ BY ALTMODE + JRST INSDCK + MOVEI CH,ALTMOD + JRST INSDIR]] ;AND CHECK FOR DELIMITER UNLESS DELIM PROTECTED. + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QKS ;GET ARGS + CALL PSI ;IN PSEUDO Q-REGS + MOVE CH,QRB.. + ADDI CH,.QKE + CALL PSI + MOVE CH,QRB.. + ADDI CH,.QDL + CALL PSI + CALL MEMTOP + MOVEM P,PSSAVP ;INDICATE A SORT IS IN PROGRESS. + MOVEM A,PSMEM + MOVEM A,PSMEMT + MOVE T,A + SETZM PSZF + MOVE TT,ZV + SUB TT,BEGV ;# CHARS IN RANGE BEING EDITED. + JUMPE TT,PSXIT ;SORTING NO CHARS IS NOOP. + MOVE C,BEGV ;START FROM BEGINNING + MOVEM C,PT +;DROPS THROUGH. + +;DROPS THROUGH. +;LOOP HERE TO DELIMIT THE NEXT RECORD AND ITS KEY. +PS4: SUB C,BEG ;KEEP ALL ADDRS RELATIVE TO BEG IN CASE IMPURE STRINGS MOVE BUFFER. + MOVEM C,2(T) ;3RD WORD OF POINTER: CHAR ADDR OF RECORD. + PUSH P,C + MOVE A,QRB.. + MOVE A,.QKS(A) ;FIND BEGINNING OF KEY + CALL MACXQ + MOVE T,PSMEMT + MOVE C,PT + SUB C,BEG ;FOR NOW, KEEP CHAR ADDR REL BUFFER, WILL CHANGE TO BP LATER. + PUSH P,C + MOVEM C,(T) ;IS 1ST POINTER WORD + MOVE A,QRB.. + MOVE A,.QKE(A) ;FIND END OF KEY + PUSHJ P,PS2 + SKIPGE C ;BARF IF THE KEY IS NEGATIVE IN LENGTH (WOULD THINK IT WAS NUMERIC). + TYPRE [ISK] + TRNN FF,FRARG ;IF "END OF KEY" MACRO RETURNS A VALUE, THAT VALUE IS THE KEY. + JRST PS8 + MOVE A,NUM ;STORE IT INSTEAD OF THE CHAR ADDR OF THE KEY. + MOVEM A,(T) ;STORE -1 AS "KEY LENGTH" TO IDENTIFY THIS KEY AS NUMBER + MOVNI C,1 ;INSTEAD OF A STRING. +PS8: MOVEM C,1(T) ;#CHARS IN KEY FOR RH(2ND WORD OF TABLE ENTRY) + MOVE A,QRB.. + MOVE A,.QDL(A) ;FIND NEXT RECORD + PUSHJ P,PS1 +PS7: MOVNS C + SKIPL C + TYPRE [ESR] ;SORT-RECORD WITH NO CHARACTERS (OR NEGATIVE NUMBER???) + HRLM C,1(T) ;-LENGTH OF RECORD FOR AOBJN + ADDI T,LPSDBK ;NEXT POINTER + MOVEM T,PSMEMT + MOVE C,PT + SKIPL PSZF ;DID WE RUN OUT + JRST PS4 ;NO + MOVE A,ZV + MOVEM A,PT + CALL GAPSLP + MOVEI C,20. ;MAKE SURE THERE'S A GAP AFTER RANGE BEING + CALL SLPSAV ;SORTED, SO BLT OF SORTED STUFF WON'T CLOBBER A FEW CHARS. + MOVE A,PSMEM ;LOWER BOUND + MOVE B,PSMEMT ;UPPER BOUND. +PS7A: CAMN A,B ;NOW CONVERT ADDRS REL. TO BEG TO WHAT WE REALLY WANT. + JRST PS7B ;ALL RECORDS HANDLED. + HRRE E,1(A) + JUMPL E,PS7C ;IF THE KEY IS A STRING, NOT A NUMBER, + MOVE E,(A) ;GET ADDR START OF KEY, + ADD E,BEG + IDIVI E,5 ;CONVERT TO BP. TO 1ST BIT. + ADD E,BTAB-1(J) + TLZ E,17 + MOVEM E,(A) +PS7C: ADDI A,LPSDBK + MOVE E,A + SUB E,PSMEM + MOVEM E,-1(A) ;MAKE ENTRY'S 3RD WD POINT TO NEXT ENTRY. + JRST PS7A ;DO NEXT RECORD. + +PS1: SKIPGE PSZF ;ALREADY AT END => NOOP INSTEAD OF USER'S MACRO. + JRST PS2A +PS2: SETOM SFINDF + CALL MACXQ +PS2A: MOVE T,PSMEMT + POP P,J ;RETURN POINT + POP P,E ;OLD PT-BEG + ADD E,BEG + MOVE C,PT + SKIPL SFINDF ;IF THE LAST SEARCH FAILED + SKIPA C,ZV + CAML C,ZV ;OR WE'RE AT THE END OF THE BUFFER + SETOM PSZF ;THEN THIS RECORD IS THE LAST ONE. + SUB C,E ;# CHARS IN C + JRST (J) + +;RETURN IN A A PTR TO THE 1ST UNUSED WORD OF HIGH MEM. +MEMTOP: MOVE A,BFRTOP + IDIVI A,5 + SUBI A,3 + SKIPE PSSAVP + MOVE A,PSMEMT + ADDI A,4 + POPJ P, + +PS7B: SETOM -1(A) ;LAST ENTRY'S LINK WORD IS NIL. + MOVE A,(P) ;RESTORE FRCLN AS IT WAS AT CALL TO PSORT. + TRNE A,FRCLN + IORI FF,FRCLN + HRRZ J,PSMEMT ;DYNAMICALLY ALLOCATED PDL + PUSHJ J,PS3 ;SORT POINTERS + MOVE T,BEGV ;SET UP FOR LATER BLT + IDIVI T,5 + HRRM T,J ;DESTINATION = WORD CONTAINING BEGV + MOVE CH,(T) ;MUST HAVE CHARS BEFORE BEGV IN WD + HLL C,BTAB-1(TT) ;GET BPT TO NEW BUFFER AREA + TLZ C,77 + HRR C,PSMEMT ;WHICH OVERWRITES SORT PDL + HRLM C,J ;SOURCE FOR BLT + MOVEM CH,(C) ;SAVE CHARS +PS6: ADD A,PSMEM ;CHANGE REL PTR TO ABS, -> NEXT TAB ENTRY. + HLRE E,1(A) ;- # CHARS IN RECORD. + JUMPE E,PS5 + MOVE BP,2(A) ;CHAR ADDR START OF RECORD. + ADD BP,BEG + CALL GETIBP +PS6A: ILDB CH,BP ;MOVE THE RECORD. + IDPB CH,C + AOJL E,PS6A +PS5: MOVE A,3(A) ;GET PTR TO NEXT RECORD'S ENTRY. + JUMPGE A,PS6 ;IF THERE IS ANOTHER, LOOP BACK. + MOVE A,ZV + IDIVI A,5 + BLT J,1(A) ;DONE, MOVE IT DOWN + CALL FLSCOR +PSXIT: SETZM PSSAVP ;TURN OFF SORT FLAG. + MOVE A,BEGV + MOVEM A,PT + JRST POP1J + +;ACTUALLY SORT THE LIST OF SORT TABLE ENTRIES, +;BY REARRANGING THE LINK WORDS SO THAT THEY ARE LINKED +;IN SORTED ORDER. +PS3: SETZ E, ;POINT TO THE HEAD OF THE LIST O SORT. + MOVE C,PSMEMT ;C _ LENGTH(E) + SUB C,PSMEM + LSH C,-2 + +;(DEFUN NSORT (N) (COND ((= N 1) (CHOP1)) +; (T (MERGE (NSORT (/ N 2)) (NSORT (- N (/ N 2))))))) +;E HOLDS L, C HOLDS N, J USED AS PDL PTR, VALUE RETURNED IN A. +PS3NSORT: CAIN C,1 + JRST PS3NS1 + PUSH J,C + LSH C,-1 ;THIS IS N/2 + PUSHJ J,PS3NSORT ;(NSORT (/ N 2)) + POP J,C + PUSH J,A + AOJ C, + LSH C,-1 ;(- N (/ N 2)) + PUSHJ J,PS3NSORT ;(NSORT (- N (/ N 2))) + POP J,C ;A, C HAVE ARGS TO MERGE. + MOVEI B,D ;B -> TAIL OF ACCUMULATED MERGED LIST, + ;D WILL EVENTUALLY POINT TO ITS HEAD. +PS3MRG: JUMPL C,PS3TK1 ;1ST ARG EMPTY => TAKE FROM 2ND. + JUMPL A,PS3TKB ;2ND EXHAUSTED => TAKE FROM FIRST. + MOVE TT,PSMEM ;ELSE GET PTRS TO AND SIZES OF THE KEYS + MOVE TT1,PSMEM + ADD TT,A ;BELONGING TO THE HEADS OF 1ST AND 2ND ARG. + ADD TT1,C + TRNE FF,FRCLN ;^ ^P - SORT IN REVERSE ORDER. + EXCH TT,TT1 + MOVE CH,(TT) ;CH IS BP TO ILDB KEY OF 2ND, + MOVE Q,(TT1) ;Q, FOR 1ST. + HRRE TT,1(TT) ;# CHARS IN KEY OF 2ND, + HRRE TT1,1(TT1) ;SAME FOR 1ST. + JUMPGE TT1,PS3CM3 + JUMPGE TT,PS3TKB ;1ST KEY A NUMBER, 2ND A STRING => 1ST IS LESS. + CAML Q,CH + JRST PS3TKA ;BOTH NUMBERS => 1ST KEY NUMBER GREATER => TAKE 2ND. + JRST PS3TKB + +PS3CM3: JUMPL TT,PS3TKA ;2ND KEY A NUMBER, 1ST A STRING => 2ND IS LESS. + +;COMPARE TWO KEYS WHICH ARE STRINGS, GO TO PS3TKA IF 2ND KEY IS LESS, ELSE PS3TKB. +PS3CMP: SOJL TT1,PS3TKB ;FIRST KEY ENDED, IT IS .LE., SO USE IT. + SOJL TT,PS3TKA ;2ND KEY ENDED, IT IS .L., TAKE 2ND. + ILDB T,CH ;ELSE LOOK AT NEXT CHAR OF EACH. + ILDB BP,Q + SKIPN PSCASE ;IF WE SHOULD IGNORE CASE, + JRST PS3CM1 + CAIGE T,"A+40 + JRST PS3CM2 + CAIG T,"Z+40 + SUBI T,40 +PS3CM2: CAIGE BP,"A+40 + JRST PS3CM1 + CAIG BP,"Z+40 + SUBI BP,40 +PS3CM1: CAIN T,(BP) + JRST PS3CMP ;CHARS EQUAL => KEEP LOOKING. + CAIG T,(BP) + JRST PS3TKA ;CHAR FROM 2ND IS LESS, TAKE 2ND. +PS3TKB: MOVEM C,(B) ;"TAKE 1ST"; ENTRY AT HEAD OF 1ST ARG + ADD C,PSMEM ;IS LESS THAN THAT AT HEAD OF 2ND, SO + MOVEI B,3(C) ;TRANSFER IT TO TAIL OF MERGED LIST + MOVE C,(B) ;AND ADVANCE DOWN THE 1ST ARG. + JRST PS3MRG + +PS3TKA: MOVEM A,(B) ;"TAKE 2ND"; LIKE "TAKE 1ST" BUT FOR 2ND ARG. + ADD A,PSMEM + MOVEI B,3(A) + MOVE A,(B) + JRST PS3MRG + +PS3TK1: JUMPGE A,PS3TKA ;1ST EXHAUSTED; 2ND ISN'T => TAKE 2ND. + SETOM (B) ;BOTH ARGS EXHAUSTED => MERGE FINISHED, TERMINATE LIST. + MOVE A,D ;RETURN VALUE IN A. + POPJ J, + +PS3NS1: MOVEI A,(E) ;(NSORT 1) COMES HERE. + ADD E,PSMEM ;RETURN THE HEAD OF LIST TO BE SORTED, + MOVE T,E + MOVE E,3(T) ;REPLACING THAT LIST WITH ITS CDR, + SETOM 3(T) ;AND MAKING THE HEAD'S CDR NIL. + POPJ J, + +SUBTTL INPUT FROM FILES + +APPEND: ARGDFL + TRZE FF,FRCLN + JRST APPNDL + TRZN FF,FRARG + JRST YANK2 + ADD C,PT + SOS IN,C + CAMGE IN,ZV + CAMGE IN,BEGV + JRST APPND2 ;J IF OUT OF RANGE OF BUFFER. + ANDCMI FF,FRARG2 + PUSHJ P,GETCHR + MOVE A,CH + JRST POPJ1 + +APPND2: TRZN FF,FRARG2 ;IF ONLY ARG, OUT OF RANGE IS ERROR. + TYPRE [NIB] + MOVE A,E ;2 ARGS => RETURN 1ST ARG. + JRST POPJ1 + +APPNDL: TRNN FF,FRARG ;:A - APPEND LINES, OR TO ^L, + MOVEI C,1 ;WHICHEVER COMES FIRST. + TLNN FF,FLIN + RET + SAVE PT + MOVE OUT,ZV ;TEMPORARILY PUT PT AT END SO + MOVEM OUT,PT ;TYOM WILL INSERT AT END. + CALL GAPSLP +APPNL2: PUSHJ P,UTYI + SKIPN FFMODE + CAIE CH,^L + SKIPL LASTPA ;AT EOF => UTYI WAS RETURNING DUMMY CHARS; IGNORE THEM. + JRST APPNL1 + PUSHJ P,TYOM + CAIN CH,^L + JRST APPNL1 + CAIE CH,^J ;END OF LINE + JRST APPNL2 + SOJG C,APPNL2 +APPNL1: REST PT + CAIE CH,^L + RET + AOS PAGENU +;CLOSE THE INPUT FILE IF IT IS EMPTY EXCEPT FOR PADDING. +APPNL4: CALL UTYI ;READ AHEAD 1 CHAR TO SEE IF ANYTHING + SKIPL LASTPA ;IS LEFT IN THE FILE. + RET ;NO => LEAVE FILE MARKED "EOF". + MOVE A,UTYIP ;ELSE ARRANGE TO RE-READ THAT CHAR. + DBP7 A + MOVEM A,UTYIP + POPJ P, + +;Y => READ ONE PAGE FROM THE OPEN INPUT FILE, +;DESTROYING PREVIOUS CONTENTS OF BUFFER. +;IF NO FILE OPEN, JUST EMPTY THE BUFFER. +;THE FS YDISABLE$ FLAG MAY TURN Y INTO AN ERROR. +;^ Y READS IN ALL THE REST OF THE FILE. +YANK: SKIPGE YDISAB + IORI FF,FRUPRW ;YDISAB NEGATIVE => Y IS ^Y. + SKIPLE YDISAB + TYPRE [DCD] ;FS YDISABLE POSITIVE => "Y" IS ILLEGAL. +YANKEE: MOVE E,BEGV + MOVE C,ZV ;FIRST, KILL CURRENT CONTENTS. + CALL DELET1 +YANK2: TLNN FF,FLIN + JRST UTLSTP ;NO FILE OPEN => INSERT NOTHING. + TRNE FF,FRUPRW + JRST YANKAL ;"^ Y" IS HANDELD SEPARATELY. + .I YANKMT=MEMT ;PREVENT EXCESS CLEARING OF LOW BITS IN SLPSAV + MOVE BP,ZV ;GET PLACE TO INSERT AT. + EXCH BP,PT ;GET GAP THERE. + CALL GAPSLP + MOVEM BP,PT + MOVE BP,BEG + CAME BP,Z ;IF BUFFER IS EMPTY NOW, + JRST YANK3 + MOVE BP,BEG ;ADJUST VALUE OF BEG SO THAT + IDIVI BP,5 ;THE BUFFER STARTS IN THE SAME PART OF A WORD + ;AS THE EMPTY PART OF UTOBUF FOR ORDINARY Y. + HLL BP,UTYOP ;(MAKES IT MORE LIKELY THAT PW CAN GO FAST) + TLNN BP,760000 ;MAKE SURE WE DON'T MOVE BEG TO + SUBI BP,1 ;A DIFFERENT WORD. + CALL GETCA ;TURN INTO CHAR ADDR OF LAST CHAR BEFORE BUFFER + SUB BP,BEG + AOS TT,BP ;TURN INTO DISPLACEMENT OF NEW BEG FROM OLD + ADDB TT,BEG ;UPDATE BEG. + CAMGE TT,BFRBOT ;NEW BEG ISN'T SUPPOSED TO BE OUTSIDE BUFFER SPACE. + .VALUE + ADDM BP,BEGV ;SHIFT ALL THE OTHER BUFFER POINTERS JUST LIKE BEG + ADDM BP,PT + ADDM BP,GPT + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC +YANK3: MOVE BP,ZV + AOS PAGENU + SAVE D + PUSHJ P,GETIBP + MOVE OUT,BP + MOVE IN,[YPG,,A] + BLT IN,BP + MOVE IN,UTYIP + SKIPN Q,EXTRAC + JRST YPGNRM + JRST A + +YPG: ILDB CH,IN ;A + CAIE CH,EOFCHR ;B + CAIN CH,14 ;C + JRST YPG1 ;D + IDPB CH,OUT ;E + SOJG Q,A ;J + JRST YPGNRM ;BP + +YPG1: MOVEM IN,UTYIP ;WE JUST ILDB'D ^C OR ^L. + HRRZ TT,IN + CAIN TT,UTIBE + JRST YPG2 ;JUST END OF UTIBUF - RELOAD IT. + CAIE CH,EOFCHR + JRST YPG3 ;IT WAS A ^L - GO INSERT IT AND RETURN. + CAME IN,UTRLDT + JRST E ;^C INSIDE THE FILE - INSERT IT AND KEEP GOING. + CALL UTLSTP ;EOF - MARK FILE AS AT EOF. +YPG1A: MOVE BP,OUT + CALL GETCA + AOS BP + MOVE E,ZV ;GET PLACE WHERE INSERTED FILE STARTS, FOR YANKX'S USE. + CALL YPG1B ;UPDATE BUFFER BLOCK FOR CHARS WE HAVE READ IN. + REST D + JRST YANKX ;NOW MAYBE DELETE PADDING OR A TRAILING ^L. + +YPG1B: SETZM YANKMT + MOVEM BP,GPT + SUB BP,ZV ;# CHARS YANKED. + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC + POPJ P, + +YPG3: IDPB CH,OUT ;ENCOUNTERED A ^L - INSERT IT, + CALL APPNL4 ;MARK THE FILE CLOSED IF THERE'S NOTHING LEFT IN IT + JRST YPG1A ;THEN FINISH UP AS IF REACHED EOF. + +YPG2: CALL UTRLD2 ;EOB AND CAN'T GO FAST, RELOAD UTIBUF. + MOVE IN,UTYIP + JRST A ;TRY AGAIN TO READ A CHARACTER. + +YPGNRM: SAVE C ;COME HERE WHEN RUN OUT OF GAP TO YANK INTO. + MOVE C,EXTRAC + ADDI C,5* ;C <- AMOUNT OF GAP WE WANT. + MOVN Q,EXTRAC + CALL SLPSAV + REST C + ADD Q,EXTRAC + JRST A + +;HANDLE "^ Y" AND "^ A" - READ IN ALL OF INPUTR FILE, THEN +;REMOVE PADDING FROM END, AND MAYBE REMOVE A TRAILING ^L. +YANKAL: MOVE C,ZV + SAVE C ;MOVE POINT TO ZV, SAVING ZV AND OLD POINT. + EXCH C,PT + SAVE C + CALL FYCMDA ;THEN INSERT THE WHOLE FILE THERE. + CALL GAPSLP ;AND MOVE THE GAP TO THE END OF WHAT WAS INSERTED. + REST PT ;POINT IS NOW SAME AS AT ENTRY, BUT GPT = ZV. + REST E ;THIS IS OLD VALUE OF ZV - WHERE THE FILE STARTS. + CALL UICLS + CALL YANKX ;DELETE PADDING CHARS AT END. + JRST FLSCM1 ;FLUSH EXCESS CORE. + +;DELETE BACKWARDS FROM GPT ALL CONSECUTIVE ^C'S AND ^@'S; +;THEN, IF FS ^LINSERT$ IS 0, DELETE A FORMFEED IF ANY. +;REFUSES TO DELETE BACK PAST WHERE E POINTS. +YANKX: MOVE IN,GPT +YANKX1: MOVEI C,1 + CAMN E,IN + RET + SOS IN + CALL GETCHR + CAIE CH,^C + JUMPN CH,YANKX2 + SOS GPT + CALL DELETB ;DELETE 1 CHAR AFTER GPT (SINCE C HAS 1). + JRST YANKX1 + +YANKX2: CAIN CH,^L ;GOT ALL ^C'S AND ^@'S - NOW MAYBE TAKE A ^L. + SKIPE FFMODE + RET + SOS GPT + JRST DELETB + +;INSERT ALL OF THE OPEN INPUT FILE BEFORE POINT. +;FY WITH NO ARGUMENT USES THIS, AS DOES "^ Y". +FYCMDA: CALL FSIFLEN ;HOW MUCH SPACE DO WE NEED? + JFCL + .I YANKMT=MEMT ;IN CASE MUST MAKE SEVERAL TRIES, PREVENT EXCESS LOW-BIT CLEARING. + JUMPL A,FYCMD7 +IFN ITS,[ + SYSCAL RFPNTR,[%CLIMM,,CHFILI ? %CLOUT,,C] + SETZ C, + IMULI C,5 ;IF WE ARE NOT POINTING AT THE FRONT OF THE FILE, WE DON'T + SUB A,C ;HAVE AS MUCH TO READ, SO WE DON'T NEED AS MUCH SPACE. + SKIPGE C,A ;IF KNOW HOW MUCH SPACE, READ WHOLE FILE AT ONCE. +] +IFN TNX,[ + MOVE C,A ;SAVE SIZE OF FILE + MOVE A,CHFILI + RFPTR + TDZA B,B ;FAILED, ASSUME 0 BUT DONT PMAP + JUMPE B,FYPMAP ;IF AT START OF FILE STILL, CAN READ IT IN FAST + IMULI B,5 + SUB C,B + SKIPGE C +] +FYCMD7: MOVEI C,2000*5 ;ELSE GET 1K AT A TIME. + CALL FYCMD6 ;READ THAT MUCH. + SKIPE LASTPA ;IS THERE ANY MORE IN THE FILE? + JRST FYCMD7 ;YES, SO GET MORE. + SETZM YANKMT + RET + +IFN TNX,[ +;MAP IN INPUT FILE USING PMAP'S +FYPMAP: CALL GAPSLP ;MOVE GAP TO PT + SAVE C ;SAVE SIZE OF INPUT FILE + MOVE A,GPT + IDIVI A,1000*5 ;GET PAGE TO START MAPPING INTO + JUMPE B,.+2 .SEE CIRC + AOJ A, + SAVE A ;SAVE PAGE NUMBER + IMULI A,1000*5 ;GET CHARACTER ADDRESS + IDIVI C,1000*5 ;GET NUMBER OF PAGES IN INPUT FILE + JUMPE D,FYPMA1 .SEE CIRC + AOJ C, + SUBI D,1000*5 ;D IS - +FYPMA1: SAVE C ;SAVE IT + IMULI C,1000*5 ;BACK INTO CHARACTERS + SUB C,GPT ;GET SIZE OF GAP WE WILL NEED FOR ALL THIS + ADDB C,A ;END OF LAST PAGE TO BE MAPPED + CALL SLPSAV ;MAKE SURE THERE IS THAT MUCH ROOM FOR IT + SUB A,EXTRAC ;COMPUTE SIZE OF GAP AFTER END OF NEW PAGES + ADD D,A ;D IS - + HRLZ A,CHFILI ;GET INPUT FILE AGAIN + MOVE B,-1(P) ;FIRST PROCESS PAGE + HRLI B,.FHSLF +IFN 20X,[ + REST C ;NUMBER OF PAGES AGAIN + HRLI C,(PM%CNT\PM%RD\PM%CPY\PM%PLD) ;READ, COPY, PRELOAD + PMAP ;READ IN THE WHOLE FILE. +] +IFN 10X,[ + REST T ;COUNT OF PAGES TO MAP + MOVSI C,(PM%RD\PM%EX\PM%CPY) ;THIS IS THE SECOND BIGGEST CROCK +FYPMA2: PMAP + SOJLE T,FYPMA3 + AOJ A, + AOJA B,FYPMA2 +FYPMA3: +] + REST A ;GET FIRST PAGE AGAIN + IMULI A,1000*5 ;GET CHARACTER ADDRESS OF START OF MAPPED IN FILE + SUB A,GPT ;COMPUTE NEW SIZE OF GAP ON THIS END + MOVEM A,EXTRAC + REST A ;SIZE OF INPUT FILE AGAIN + ADDM A,PT ;PT TO END OF STUFF JUST INSERTED + ADDM A,ZV + SUB A,D ;FOR NOW SET END HIGH SO GETS BLTED ALONG WITH REST OF + ADDM A,Z + CALL SLPSHT ;CLOSE UP THE LOWER GAP + ADDM D,Z ;FIX UP END OF BUFFER + MOVNM D,EXTRAC ;SIZE OF UPPER GAP + JRST UTLSTP ;TELL EVERYONE AT EOF NOW +] + +;FY - READ CHARACTERS FROM THE INPUT FILE, OR UNTIL EOF, +;AND INSERT THEM IN THE BUFFER BEFORE POINT. NO PADDING CHARACTERS ARE +;FLUSHED, SO ALL IS UNDER PROGRAMMER CONTROL. IF THE TRANSFER GOES TO A WORD +;BOUNDARY, AND STARTS AT A WORD BOUNDARY IN THE FILE, THEN IT IS +;SUITABLE FOR READING IN BINARY DATA. TO MAKE THAT HAPPEN, WE SOMETIMES +;INSERT SOME SPACES IN THE BUFFER TO PRODUCE CORRECT ALIGNMENT, +;AND THEN DELETE THEM WHEN FINISHED READING. +FYCMD: TLNN FF,FLIN + TYPRE [NFI] + TRNN FF,FRARG + JRST FYCMDA ;NO ARG => READ THE WHOLE FILE. + JUMPL C,TYPAOR ;NEGATIVE ARG NOT ALLOWED. +FYCMD6: SAVE C + MOVE BP,UTYIP ;FOR SPEED, LEAVE ENOUGH SPACE BEFORE INSERTING THE FILE + CALL GETCA ;TO ENABLE TRANSFER TO GO WORDWISE. + MOVEI BP,1(BP) + SUB BP,PT + IDIVI BP,5 + SKIPE BP,T + ADDI BP,5 + SAVE BP + ADD C,BP ;THAT MUCH, PLUS # CHARS BEING READ, IS AMT OF SPACE WE NEED. + CALL GAPSLP ;GET GAP TO POINT. + CALL SLPSAV ;MAKE SURE THERE'S ENOUGH SPACE. + MOVE C,-1(P) + MOVE BP,PT + ADD BP,(P) ;LEAVE THE FEW CHARS OF SPACE TO REACH PROPER ALIGNMENT. + CALL GETIBP ;CREATE B.P. FOR IDPB'ING INTO THE GAP. +FYCMD0: JUMPE C,FYCMDE + MOVE A,UTYIP ;AND LOOK AT B.P. WE'LL ILDB FROM. + HRRZ B,UTRLDT + ADD B,[(010700)-1] +FYCMDW: TLNN A,760000 + JRST FYCMD1 ;JUMP IF CAN START GOING WORD-WISE. +FYCMDS: CAMN A,B + JRST FYCMDR ;IF UTIBUF EXHAUSTED, MUST RELOAD IT. + ILDB CH,A ;OTHERWISE, TRANSFER ONE MORE CHARACTER + IDPB CH,BP + SOJG C,FYCMDW + MOVEM A,UTYIP +FYCMDE: CALL UTEOF ;IF THERE'S NOTHING LEFT IN THE INPUT FILE, MARK IT "AT EOF". + MOVE E,-1(P) + SUB E,C ;# CHARS ACTUALLY READ IN + ADD E,(P) ;PLUS # CHARS OF SPACE LEFT AT FRONT. + ADDM E,GPT ;"INSERT" THE DATA AND THE SPACE AT FRONT. + ADDM E,ZV ;BUT DON'T CHANGE POINT, YET. + ADDM E,Z + SUBM E,EXTRAC + MOVNS EXTRAC + REST C ;C HAS # CHARS OF SPACE THAT'S NOW IN THE BUFFER + SUB P,[1,,1] + JUMPE C,FYCMD8 + SUB E,C ;E HAS # CHARS OF REAL DATA NOW INSERTED. + CALL GAPSLP ;GET GAP TO POINT, WHICH STILL POINTS VBEFORE THE SPACE + CALL DELETB ;AND DELETE THE SPACE. +FYCMD8: ADDM E,PT ;NOW MAKE POINT GO AFTER THE INSERTED DATA. + RET + +FYCMDR: CAME A,[010700,,UTIBE-1] + JRST FYCMDE ;IF LAST INPUT BUFFER WASN'T FULL, THIS IS EOF. + CALL UTRLD2 ;ELSE, READ ANOTHER INPUT BUFFER AND CONTINUE TRANSFERING. + JRST FYCMD0 + +;HERE TO ATTEMPT A WORD-WISE TRANSFER. +FYCMD1: MOVEM A,UTYIP + CAIGE C,5 ;DON'T BOTHER TRYING TO GO FAST IF < 1 WHOLE WORD LEFT. + JRST FYCMDS + IDIVI C,5 .SEE D + IBP BP + SUB B,A ;IF THEER'S ANYTHING LEFT IN UTIBUF, MUST USE IT FIRST. + JUMPE B,FYCMDI ;LH'S CANCEL SINCE BOTH ARE 010700. + IBP A + HRL BP,A + CAMLE B,C ;# WORDS TO TRANSFER RIGHT NOW = + MOVE B,C ;MIN (, ). + ADDM B,UTYIP ;REMOVE THAT MANY WORDS FROM THE BUFFER. + SUB C,B ;# WORDS THAT WILL BE LEFT EMPTY AFTER USING UP UTIBUF? + ADD B,BP + BLT BP,-1(B) ;TRANSFER WHAT'S LEFT OF UTIBUF. + IMULI C,5 + HRRZ BP,B + JRST FYCMD2 + +;GOING WORD AT A TIME, AND UTIBUF IS EMPTY, SO GET DIRECTLY FROM FILE. +FYCMDI: +IFN ITS,[ + CAIGE C,100000 ;DON'T TRY TO IOT MORE THAN 32K AT A TIME. + JRST FYCMD4 + IMULI C,5 + ADD D,C ;SO PUT TOTAL # CHARS TO GET, MINUS 32K OF CHARS, IN D, + SUBI D,5*100000 + MOVEI C,100000 ;AND GET ONLY 32K RIGHT NOW. +FYCMD4: MOVNS C + HRL BP,C ;AOBJN -> BUFFER WORDS TO TRANSFER INTO. + .IOT CHFILI,BP + HLRE C,BP +] +IFN TNX,[ + SAVE B + MOVE A,CHFILI ;INPUT FILE + MOVEI B,(BP) ;FIRST WORD TO READ INTO + HRLI B,444400 + MOVNS C + SIN + MOVEI BP,1(B) ;UPDATE FIRST WORD NOT READ INTO + HRL BP,C ;UPDATE COUNT LEFT TO DO + REST B +] + IMUL C,[-5] +FYCMD2: ADD C,D ;# CHARS WE WERE SUPPOSED TO TRANSFER BUT HAVEN'T YET. + JUMPL BP,FYCMD3 ;EOF => WE WILL NEVER GET THEM, SO INSERT WHAT WE HAVE GOT. + ADD BP,[(010700)-1] ;GET BACK B.P. TO IDPB THE REST OF THE DATA + JRST FYCMD0 ;RELOAD BUFFER TO XFER LAST FEW CHARS 1 AT A TIME. + +FYCMD3: CALL UTLSTP + JRST FYCMDE + +;READ NEXT CHARACTER FROM OPEN INPUT FILE, AND RETURN IT IN CH. +;UP TO A WORD OF ^C'S OR ^@'S BEFORE THE END OF THE FILE WILL BE IGNORED. +;IF TRY TO READ PAST EOF, FS LASTPAGE$ WILL BE SET TO 0, AND ^L WILL BE RETURNED. +UTYI: ILDB CH,UTYIP + CAILE CH,EOFCHR + RET + CAIE CH,EOFCHR + JUMPN CH,CPOPJ + HRRZ CH,UTYIP + CAIN CH,UTIBE + JRST UTYIR ;EXHAUSTED BUFFER => REALOD IT AND TRY AGAIN. +UTYI4: MOVE CH,UTYIP + CAMN CH,UTRLDT + JRST UTYIE ;READ PAST EOF => CLOSE FILE AND RETURN A ^L. +;^C OR ^@ INSIDE THE FILE - IS IT PADDING BEFORE EOF? + HRLI CH,010700 + IBP CH + CAME CH,UTRLDT ;MORE THAN 1 WORD FROM THE END => IT ISN'T PADDING. + JRST UTYI5 + ANDI CH,-1 + CAIE CH,UTIBE ;THIS LAST WORD OF INPUT BUFFER => WE DON'T KNOW WHETHER + JRST UTYI1 ;THERE ARE MORE WORDS IN THE FILE, + MOVE CH,UTIBE-1 ;SO FIND OUT BY PUTTING THIS WORD AT BEGINNING OF BUFFER + MOVEM CH,UTIBUF ;AND FILLING UP THE REST IF POSSIBLE. + MOVE CH,UTIBE + MOVEM CH,UTIBUF+1 + MOVNI CH,UTIBE-UTIBUF-1 + ADDM CH,UTYIP + ADDM CH,UTRLDT + CALL UTRLD3 ;NOW TRY FILLING REST OF INPUT BUFFER. + JRST UTYI4 ;WE NOW HAVE ENOUGH INFO TO ANSWER OUR QUESTION. + +;COME HERE WHEN A ^C OR ^@ IS FOUND IN THE LAST WORD OF THE FILE, TO LOOK +;AHEAD AND SEE IF REST OF THE CHARS IN LAST WORD ARE ALL ^C OR ^@. +UTYI1: SAVE UTYIP +UTYI3: ILDB CH,UTYIP + CAIE CH,^C + JUMPN CH,UTYI2 + MOVE CH,UTYIP + CAME CH,UTRLDT + JRST UTYI3 + SUB P,[1,,1] ;ALL ARE ^C OR ^@ => RETURN CLOSING FILE. +UTYIE: CALL UTLSTP + MOVEI CH,^L + RET + +UTYI2: REST UTYIP ;NOT ALL PADDING => THIS ^C OR ^@ IS REALLY DATA, AND SO ARE THE REST. +UTYI5: LDB CH,UTYIP + RET + +UTYIR: CALL UTRLD2 + JRST UTYI ;GO BACK AND TRY AGAIN + +;"EC" COMMAND -- CLOSE THE INPUT FILE AND MARK IT CLOSED. +UICLS: CALL UTLSTP ;FIRST, SET "AT EOF" SO ATTEMPTS TO READ WILL GET ^C'S. + CLOSEF CHFILI + TLZ FF,FLIN + RET + +;REFILL THE INPUT BUFFER. +UTRLD2: MOVE CH,[10700,,UTIBUF-1] + MOVEM CH,UTYIP +IFN ITS,[ + SKIPA CH,[UTIBUF-UTIBE,,UTIBUF] +UTRLD3: MOVE CH,[UTIBUF+1-UTIBE,,UTIBUF+1] + .IOT CHFILI,CH + HRRM CH,UTRLDT ;FIRST ADR. NOT LOADED BY SYS + JUMPGE CH,CPOPJ + MOVEI CH,EOFCHR + DPB CH,UTRLDT ;STORE EOF THERE + POPJ P, +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVE B,[444400,,UTIBUF] ;POINTER TO BUFFER + MOVNI C,UTIBE-UTIBUF ;COUNT TO READ +UTRLD4: MOVE A,CHFILI ;INPUT FILE + SIN + AOJ B, ;WILL BE OF THE FORM 004400,,ADDR-1 + HRRM B,UTRLDT ;FIRST ADDR NOT LOADED + JUMPE C,POP321 ;HAVE WE REACHED EOF? + MOVEI CH,EOFCHR ;YES + DPB CH,UTRLDT + JRST POP321 +UTRLD3: JSR SAV123 + MOVE B,[444400,,UTIBUF+1] ;TRY TO FILL THE REST OF THE BUFFER + MOVNI C,UTIBE-UTIBUF-1 + JRST UTRLD4 +] + +;SEE IF THE INPUT FILE IS AT EOF. IF SO, SET FS LASTPA, ETC. +;TO TELL THE USER THAT IT IS. +UTEOF: SKIPL LASTPA + RET ;ALREADY AT EOF => NO CHANGE. + MOVE CH,UTYIP + IBP CH + CAME CH,UTRLDT ;MORE LEFT IN INPUT BUFFER => NOT EOF + RET + ANDI CH,-1 + CAIE CH,UTIBE ;NONE LEFT IN INPUT BUFFER, AND BUFFER WASN'T A FULL ONE, + JRST UTLSTP ;=> CLEARLY AT EOF. + CALL UTRLD2 ;AT END OF BUFFER => TRY READING SOME MORE TO SEE + JRST UTEOF ;IF AT EOF. + +;INDICATE THAT THE INPUT FILE IS AT EOF. ALL ATTEMPTS TO READ MORE +;WILL JUST ENCOUNTER ANOTHER EOF. +UTLSTP: SETZM LASTPA ;SAY "EOF" TO ANYONE WHO ASKS. + MOVE CH,[010700,,[ASCIC//]-1] + MOVEM CH,UTYIP ;SET UP BUFFER TO APPEAR TO BE JUST BEFORE AN EOF + IBP CH ;SO THAT ANY ATTEMPT TO READ A CHARACTER WILL SEE EOF + MOVEM CH,UTRLDT ;AND COME RIGHT BACK HERE. + RET + +;FS IF LENGTH$ - READ LENGTH OF OPEN INPUT FILE. +FSIFLEN:TLNN FF,FLIN + TYPRE [NFI] + MOVEI A,CHFILI +IFN ITS,[ +FSIFL1: SYSCAL FILLEN,[A ? %CLOUT,,A] + SKIPA A,[-1] +] +IFN TNX,[ +FSIFL1: MOVE A,(A) ;INPUT FILE + MOVE B,[2,,.FBBYV] + MOVEI C,A + GTFDB + EXCH A,B + LDB C,[.BP FB%BSZ,B] ;GET BYTE SIZE + CAIN C,7 ;IF 7, ALREADY HAVE WHAT WE WANT + JRST POPJ1 + CAIN C,36. ;IF 36, KNOW HOW MANY WORDS ALREADY + JRST .+4 + MOVEI B,36. + IDIVI B,(C) ;GET NUNBER OF BYTES IN A WORD + IDIVI A,(B) ;GET NUMBER OF WORDS +] + IMULI A,5 ;INTO CHARACTERS + JRST POPJ1 + +FSOFLEN:TLNN FF,FLOUT + TYPRE [NDO] + MOVEI A,CHFILO + JRST FSIFL1 + +;SET INPUT FILE ACCESS POINTER TO CHAR # IN C. +FSIFAC: TLNN FF,FLIN + TYPRE [NFI] +IFN ITS,[ + MOVEI A,CHFILI + .CALL RFACCB + TYPRE [NRA] ;NOT RANDOM ACCESS FILE. + IDIVI C,5 ;CHANGE ARG TO WORD #. + .ACCES CHFILI,C ;FIND THAT WORD. +] +IFN TNX,[ + IDIVI C,5 ;CONVERT TO WORD # + MOVE A,CHFILI + MOVE B,C ;GET ARG + SFPTR + TYPRE [NRA] +] + SETOM LASTPA ;EVEN IF FILE WAS AT EOF, IT WON'T BE ANY MORE. + CALL UTRLD2 ;FILL UP THE INPUT BUFFER + HRRZ CH,UTRLDT + CAIN CH,UTIBUF ;DID WE GET ANYTHING? + JRST UTLSTP ;NO, .ACCESS WENT TO EOF. + JUMPE D,CPOPJ ;YES, ADVANCE IN WORD TO SPEC'D CHARACTER IF IT ISN'T THE 1ST. + IBP UTYIP + SOJG D,.-1 + RET + +SUBTTL OUTPUT TO FILES + +;P COMMAND WITH 2 ARGS. +PUNCHB: CALL GETARG + CALL CHK1A +PUNCHF: ;PUNCH OUT RANGE SPEC'D BY C,E. + CAMGE E,GPT + CAMG C,GPT ;IF GAP IS INSIDE RANGE TO BE PUNCHED, WE MUST BE CAREFUL. + JRST PUNCHG + PUSH P,C + MOVE C,GPT + CALL PUNCHG ;FIRST, PUNCH EVERYTHING UP TO THE GAP. + MOVE E,GPT + MOVE TT,EXTRAC + IDIVI TT,5 + JUMPE TT1,[ ;IF GAP DOESN'T DESTROY ALIGNMENT, JUST PUNCH EVERYTHING AFTER THE GAP. + POP P,C + JRST PUNCHG] +PUNCHJ: MOVE E,GPT ;GAP DESTROYS ALIGNMENT; IT IS FASTEST TO ADJUST ALIGNMENT OURSELVES + MOVE C,E ;BY MOVING THE GAP UP PAST THE TEXT TO BE OUTPUT. + ADDI C,4*5*2000 ;MOVE THE GAP PAST AT MOST 4K AT A TIME + SUB C,UTYOCT ;(PLUS ENOUGH TO FILL OUTPUT BUFFER, TO INSURE IT'S EMPTY AT NEXT STOP) + MOVE T,(P) ;AND THEN OUTPUT THAT 4K. + CAMG T,C ;WHEN LESS THAN 4K REMAIN TO BE DONE, + JRST [ POP P,C ;WE DO WHAT IS LEFT AND EXIT. + JRST PUNCHH] + CALL PUNCHH + JRST PUNCHJ + +PUNCHH: SAVE PT ;MOVE THE GAP UP PAST END OF RANGE TO BE TRANSFERRED NOW, + MOVEM C,PT + CALL GAPSL0 ;WITHOUT MARKING THE BUFFER AS MODIFIED, HOWEVER. + REST PT +PUNCHG: MOVE IN,E + MOVE BP,IN + SUBM C,IN ;IN GETS COUNT OF CHARS REMAINING. + JUMPLE IN,CPOPJ + PUSHJ P,GETIBV ;BP GETS BP TO FETCH FROM BUFFER. +PCHF1: MOVE TT,UTYOP + HLRZ OUT,BP + CAMN TT,[010700,,UTOBUF-1] ;UTOBUF EMPTY AND + CAIE OUT,010700 ;NEXT CHR IN BUFFER IS 1ST IN A WD => + JRST PCHF2 +PCHF3: CAIGE IN,5 ;TRY .IOTING OUT OF BUFFER. + JRST PCHF2 + ADDI BP,1 + MOVE CH,IN ;GET # WDS FULL IN BUFFER AFTER WHERE WE ARE. + IDIVI CH,5 +IFN ITS,[ + CAIL CH,4000 + MOVEI CH,4000 ;DON'T OUTPUT MORE THAN 2K AT ONCE. + MOVNS CH + HRLI BP,(CH) ;BP HAS AOBJN -> WDS IN BUFFER. + .IOT CHFILO,BP +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVNS C,CH ;NUMBER OF CHARS + MOVEI B,(BP) ;FIRST WORD + HRLI B,444400 + MOVE A,CHFILO ;OUTPUT FILE + SOUT + HRRI BP,1(B) ;FIRST ADDR NOT WRITTEN + JSP A,RST321 ;RESTORE ACS +] + IMULI CH,5 ;# CHARS JUST OUTPUT. + ADD IN,CH ;THAT MANY FEWER LEFT. + SUBI BP,1 ;CHANGE BP BACK TO BP TO NEXT CHAR. + HRLI BP,010700 + JRST PCHF3 ;HANDLE REMAINING CHARS. + +PCHF2: MOVN OUT,UTYOCT + CAMLE OUT,IN + MOVE OUT,IN ;OUT GETS # OF CHARS TO XFER INTO OUTPUT BUFFER. + PUSH P,OUT + JUMPE OUT,PPG1 + MOVE E,[PPG,,A] + BLT E,D + JRST A + +PPG: ILDB CH,BP ;A + IDPB CH,TT ;B + SOJG OUT,A ;C + JRST PPG1 ;D + +PPG1: POP P,OUT + MOVEM TT,UTYOP + ADDM OUT,UTYOCT ;UPDATE MINUS NUMBER OF FREE CHARS REMAINING IN BUFFER. + SKIPL UTYOCT + CALL UTYOA + SUB IN,OUT + JUMPG IN,PCHF1 + RET + +POPDJ: POP P,D + POPJ P, + +;THIS IS THE HIGHER LEVELS OF THE P COMMAND. +PUNCH: SKIPGE OUTFLG ;CHECK FOR OUTPUT DISABLED OR NO FILE OPEN. + RET + TLNN FF,FLOUT + TYPRE [NDO] + TRNE FF,FRARG2 + JRST PUNCHB ;2-ARG P COMMAND. + MOVE T,CPTR + ILDB T,T ;ELSE PEEK AT NEXT CHAR TO SEE IF IT IS W. + ANDCMI T,40 + SKIPE COMCNT + CAIE T,"W +PUNCHA: SETZ T, ;ENTER HERE FOR N AND EE COMMANDS. + SKIPGE OUTFLG ;IF T IS NONZERO, DON'T READ, JUST OUTPUT. + RET + TLNN FF,FLOUT + TYPRE [NDO] + MOVE D,C ;D HAS NUMBER OF PAGES TO OUTPUT. + JUMPL D,CPOPJ +PUN1: SAVE D + SAVE T + PUSHJ P,PUNCHR + TRZ FF,FRARG + REST T + SKIPN T + CALL YANKEE + REST D + MOVE E,ZV + CAMN E,BEGV ;KEEP FEEDING PAGES THROUGH UNTIL COUNT RUNS OUT + SKIPE LASTPA ;OR WE ARE AT EOF WITH AN EMPTY BUFFER. + SOJG D,PUN1 +CPOPJ: POPJ P,VIEW1 + +PUNCHR: SKIPGE STOPF ;IN BETWEEN PAGES, + CALL QUIT0 ;TRY TO QUIT IF DESIRED (CHECKS NOQUIT). + MOVE E,BEGV + MOVE C,ZV + SKIPE FFMODE ;IN FFMODE, ANY ^L DESIRED IS ALREADY IN BFR. + JRST PUNCHF + CALL PUNCHF ;IF ^L'S READ GET THROWN AWAY, + MOVEI CH,^L ;MUST REGENERATE THEM ON OUTPUT. + JRST PPA + +;FORCE OUT CONTENTS OF OUTPUT BUFFER. CLOBBERS A, B, C. +FLSOUT: TLNN FF,FLOUT + RET ;NO OUTPUT FILE. + MOVE B,UTYOP + IBP B ;-> WD NEXT OUTPUT CHAR WILL GO IN. + MOVEI A,@B + MOVNI C,-UTOBUF(A) ;# WDS FILLED UP IN FRONT END OF BFR. + JUMPE C,CPOPJ +IFN ITS,[ + HRLZI A,(C) + HRRI A,UTOBUF ;AOBJN -> FILLED PART. + .IOT CHFILO,A +] +IFN TNX,[ + SAVE C + SAVE B + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + SOUT + REST B + REST C +] + MOVE A,(B) ;GET THE PARTIALLY FILLED WORD. + MOVEM A,UTOBUF ;PUT IT IN 1ST WD OF BUFFER, + ADDM C,UTYOP ;BACK THE BP UP THE RIGHT # WDS. + IMULI C,5 + ADDM C,UTYOCT ;MORE SPACE IN OUTPUT BUFFER NOW. + POPJ P, + +;OUTPUT CHAR IN CH TO OUTPUT FILE, IF ANY. +PPA: +PPA2: SKIPGE OUTFLG + RET + TLNE FF,FLOUT + JRST UTYO + RET + +UTYO: IDPB CH,UTYOP + AOSGE UTYOCT + POPJ P, +UTYOA: MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT +IFN ITS,[ + MOVE CH,[UTOBUF-UTOBE,,UTOBUF] + .IOT CHFILO,CH + MOVE CH,[10700,,UTOBUF-1] + EXCH CH,UTYOP + POPJ P, +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + MOVNI C,UTOBE-UTOBUF ;COUNT + SOUT + MOVE CH,[10700,,UTOBUF-1] ;UPDATE BUFFER POINTER + EXCH CH,UTYOP + JRST POP321 ;RESTORE ACS AND RETURN +] ;IFN TNX + +;SET ACCESS POINTER OF OUTPUT FILE TO CHAR # IN C, +;WHICH MUST BE A MULTIPLE OF 5. ERROR IF ANY CHARS IN OUTPUT +;BUFFER ARE LOST (WHICH WILL BE THE CASE UNLESS OUTPUT STOPPED +;ON A WORD BOUNDARY). +FSOFAC: TLNN FF,FLOUT + TYPRE [NDO] +IFN ITS,[ + MOVEI A,CHFILO + .CALL RFACCB + TYPRE [NRA] +] + SAVE C + CALL FLSOUT ;FORCE OUT THE OUTPUT BUFFER. + REST C + MOVN A,UTYOCT ;ANYTHING NOT FORCED OUT?? + CAIE A,UTBSZ*5 + TYPRE [WLO] + IDIVI C,5 ;GET WORD # IN FILE OF DESIRED POSITION. + SKIPE D + TYPRE [ARG] ;ARG NOT MULTIPLE OF 5?? +IFN ITS,.ACCES CHFILO,C +IFN TNX,[ + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,C + SFPTR ;SET POINTER + TYPRE [NRA] +] + RET + +SUBTTL I/O COMMANDS + +ECMD: TLO FF,FLDIRDPY ;DISPATCH FOR E-COMMANDS. + PUSHJ P,LRCH + ANDI CH,-1 + CAIN CH,^U + JRST EUHACK + CAIGE CH,"? ;IF CHARACTER BEYOND "?, DISPATCH ON IT. + TYPRE [IEC] + XCT ETAB-"?(CH) + +RLTCLK: CALL SAVACS ;RUN THE REAL TIME CLOCK HANDLER. DON'T CLOBBER ANYTHING. + SETZM CLKFLG + SKIPE A,CLKMAC + CALL MACXCP + SETZM CLKFLG + JRST RSTACS + +IFN ITS,[.SEE %%TNX% ;WHERE THIS MOBY CONDITIONAL ENDS + +ASLEEP: CALL IMMQIT + TRZE FF,FRCLN + JRST ASLEE1 + TRZE FF,FRARG + .SLEEP C, + JRST DELQIT + +ASLEE1: AOS (P) ;:^S 1) RETURNS RESULT OF FS LISTEN$ +ASLEE4: TRZ FF,FRARG ; 2) SLEEPS ONLY AS LONG AS THERE IS NO INPUT AVAIL. + SKIPN TYISRC + SKIPL UNRCHC + SKIPA A,[1] + .LISTEN A, + JUMPN A,DELQIT + JUMPE C,DELQIT + CALL TTYAC2 +ASLEE2: .SLEEP C, + JRST ASLEE4 + +EQMRK: CALL FFRRDD ;E?$ 0 IF FILE EXISTS, ELSE (NUMERIC) ERROR CODE. + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;TRY TO OPEN; A GETS 0 OR I.T.S. ERROR CODE + JFCL + SETZM IMQUIT + .CLOSE CHRAND, + JRST POPJ1 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS, +FSCLKI: SKIPE C ;OR TURN OFF REAL TIME CLOCK, WITH ARG OF 0. + SKIPA A,[%RLSET,,C] + MOVSI A,%RLFLS + .REALT A, + RET + +SUBTTL EG COMMAND + +EGET: PUSH P,LISTF5 + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY ;EGET TO INSERT IN THE BUFFER + PUSHJ P,GDATIM + JFCL + PUSHJ P,GLPDTM + SKIPG E,DATE ;THE DATE + SETZ E, ;IF SYSTEM DOESN'T KNOW DATE, USE 6 SPACES. + CALL TYPR + CALL CRR1 + SKIPG E,TIME + SETZ E, + CALL TYPR ;INSERT TIME FROM SIXBIT WORD, + CALL CRR1 + MOVE A,DEFDIR ;THE CURRENT SYSTEM NAME + PUSHJ P,SIXINS + CALL LFILE ;INSERT CURRENT DEFAULT FILE NAMES. + CALL CRR1 + TLNN FF,FLIN ;THE NAMES OF THE FILE OPEN FOR READING (IF ANY) + JRST EGET2 ;(NONE, LEAVE BLANK LINE - EVENTUALLY REPLACE THIS CRUFT WITH .RCHST) + MOVE A,ERSNM + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,ERDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,RUTF1 + MOVEI C,40 + PUSHJ P,SIXINT + SKIPA A,RUTF2 +EGET2: SETZI A, + PUSHJ P,SIXINS + SKIPL TIME + PUSHJ P,SYMDAT ;THE DATE IN STANDARD SYMBOLIC FORM + PUSHJ P,CRR1 + LDB CH,[320300,,YEAR] ;A THREE DIGIT NUMBER + PUSHJ P,DGPT ;FIRST DIGIT DAY OF WEEK (0 => SUNDAY) + LDB CH,[270300,,YEAR] ;SECOND DIGIT DAY OF WEEK OF BEGINNING OF YEAR + PUSHJ P,DGPT + LDB CH,[410300,,YEAR] ;THIRD DIGIT 3 BITS + ;4 BIT 1 => NORMAL YEAR AFTER 2/28 + ;2 BIT 1 => LEAP YEAR + ;1 BIT 1 => DAYLIGHT SAVINGS TIME IN EFFECT + PUSHJ P,DGPT + PUSHJ P,CRR1 + PUSHJ P,POM ;THE PHASE OF THE MOON + PUSHJ P,CRR1 + POP P,LISTF5 + POPJ P, + + ;VARIOUS TIME GETTING ROUTINES + +GDATIM: .RDATIM A, ;GET TIME IN A, DATE IN B + MOVEM A,TIME ;STORE SIXBIT TIME + MOVEM B,DATE ;STORE SIXBIT DATE + JUMPGE A,POPJ1 ;IF TIME AVAILABLE THEN SKIP-RETURN + POPJ P, ;NOT AVAILABLE, DON'T SKIP (BUT LEAVE TIME AND DATE NEGATIVE) + +GLPDTM: .RLPDT A, ;GET VARIOUS TIMES IN BINARY + MOVEM B,YEAR ;SAVE YEAR AND FLAGS + MOVEM A,LPDTIM ;SAVE LOCALIZED # SECONDS SINCE BEGINNING OF YEAR + TLNE B,400000 ;IF NORMAL YEAR AFTER FEB 28, + SUBI A,SPD ;THEN BACK UP A DAY + TLNE B,100000 ;IF DAYLIGHT SAVINGS TIME IN EFFECT, + SUBI A,3600. ;THEN BACK UP AN HOUR + MOVEM A,PDTIME ;SAVE # SECONDS SINCE BEGINNING OF YEAR + POPJ P, + + ;TYPE OUT (THROUGH LISTF5) THE DATE IN ENGLISH + +SYMDAT: PUSHJ P,DOW ;TYPE DAY OF WEEK + REPEAT 2,PUSHJ P,SPSP ;TYPE TWO SPACES + MOVE E,DATE ;GET DATE + DPB E,[221400,,CDATE] ;DEPOSIT SIXBIT FOR DAY OF MONTH + LDB CH,[220100,,DATE] ;GET FIRST DIGIT OF MONTH + LDB E,[140400,,DATE] ;GET SECOND DIGIT OF MONTH + IMULI CH,10. ;MULTIPLY THE FIRST DIGIT TO ITS PROPER WEIGHTING + ADD E,CH ;ADD TOGETHER TO GET MONTH + MOVE E,MONTHS-1(E) ;GET MONTH IN SIXBIT + PUSHJ P,SIXNTY ;TYPE OUT MONTH + MOVE E,CDATE ;GET FIRST PART OF DATE + PUSHJ P,TYPR ;TYPE OUT + MOVE E,DATE ;GET DATE + MOVEI IN,2 ;LIMIT TYPEOUT TO TWO CHARACTERS + JRST TYPR3 ;TYPE OUT LAST TWO DIGITS OF YEAR AND RETURN + +MONTHS: IRPS S,,[JAN FEB MARCH APRIL +MAY JUNE JULY AUG SEPT OCT NOV DEC] + SIXBIT /S/ +TERMIN + + ;TYPE OUT DAY OF WEEK + +DOW: LDB A,[320300,,YEAR] ;GET DAY OF WEEK (0 => SUNDAY) + MOVE A,DOWTBL(A) ;GET SIXBIT FOR DAY (EXCEPT FOR THE "DAY") + PUSHJ P,SIXIN1 ;TYPE OUT + MOVSI A,(SIXBIT /DAY/) ;NOW FOR THE "DAY" + JRST SIXIN1 ;TYPE IT OUT AND RETURN + +DOWTBL: IRPS DAY,,[SUN MON TUES WEDNES THURS FRI SATUR] + SIXBIT /DAY/ + TERMIN + + ;TYPE OUT THE PHASE OF THE MOON + +POM: PUSHJ P,GNDS0 ;GET NUMBER OF DAYS SINCE 1/1/0000 + MULI A,SPD ;CONVERT TO SECONDS IN A AND B + JFCL 17,.+1 ;CLEAR FLAGS FOR FOLLOWING + ADD B,PDTIME ;# SECONDS SINCE BEGINNING OF YEAR + ADD B,SYNOFS ;THE MOON DOESN'T QUITE BELIEVE IN THE GREGORIAN CALENDAR SYSTEM + JFCL 4,[AOJA A,.+1] ;CRY1 + ASHC A,2 ;CONVERT TO QUARTER SECONDS + DIV A,SYNP ;DIVIDE BY NUMBER OF SECONDS IN A PERIOD TO GET NUMBER OF QUARTERS SINCE THEN + ASH B,-2 ;CONVERT REMAINDER TO SECONDS (# SECONDS INTO THIS QUARTER) + PUSH P,B ;SAVE REMAINDER + IDIVI A,4 ;GET QUARTER IN B + MOVE A,[SIXBIT /NM+ FQ+ FM+ LQ+/](B) ;GET SIXBIT CRUFT IN A (I REFUSE TO CHANGE THE 1Q!!!) + PUSHJ P,SIXIN1 ;TYPE IT OUT + POP P,B ;RESTORE # SECONDS INTO THIS PERIOD +TDHMS: MOVEI E,TDHMST ;SET POINTER TO TABLE +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + PUSHJ P,[AOJA E,TDHMS1] ;INCREMENT INDEX WHILE RECURSING + HLRZ C,(P) +TDHMS2: PUSHJ P,DPT ;TYPE OUT IN DECIMAL + HLLZ A,(E) ;GET SIXBIT CRUFT + SOJA E,SIXIN1 ;BACK UP INDEX, TYPE OUT, AND RETURN + +TDHMST: SIXBIT /S./+60. ;SECONDS + SIXBIT /M./+60. ;MINUTES + SIXBIT /H./+24. ;HOURS + SIXBIT /D./+<,-1> ;DAYS + +SYNP: 2551443. +SYNOFS: 690882. + + ;GET NUMBER OF DAYS SINCE 1/1/0000 (AS OF 1/1/CURRENT YEAR) IN A + +GNDS0: MOVEI C,@YEAR ;GET YEAR + MOVEI A,-1(C) ;ALSO GET YEAR-1 IN A + IMULI C,365. ;FIRST APPROXIMATION + IDIVI A,4 + ADD C,A ;ADD NUMBER OF YEARS DIVISIBLE BY 4 + IDIVI A,25. + SUB C,A ;SUBTRACT NUMBER OF YEARS DIVISIBLE BY 100 + IDIVI A,4 + ADD A,C ;ADD CRUD ALREADY CALCULATED TO NUMBER OF YEARS DIVISIBLE BY 400 + AOJA A,CPOPJ + +SUBTTL FILENAME READER FOR ITS + +;FILENAME PARSING ROUTINES. FFRDEV READS DEV AND SNAME ONLY. +;FFRRDD (ET CMD) READS ENTIRE NAME. +;FRD LEAVES THE NAMES IN A, B NOT SETTING DEFFN1 AND DEFFN2. +FFRDEV: TROA FF,FRNOT +FRD: TRZ FF,FRNOT + TROA FF,FRALT +ETCMD: +FFRRDD: TRZ FF,FRALT+FRNOT + MOVE A,DEFFN1 + MOVE B,DEFFN2 + SETOM FFRRCT + TRO FF,FRFIND +FF1: MOVEI E,0 + MOVE C,[440600,,E] +FF2: PUSHJ P,LRCH + SKIPGE SQUOTP + JRST FF3 + SKIPN SQUOTP + CAIE CH,ALTMOD + CAIN CH,40 + JRST FFTRM + CAIN CH,^I + JRST FFTRM + CAIE CH,^X + CAIN CH,^A ;^A OR ^X REFERS TO DEFAULT FIRST FILENAME. + JRST FFCTLX + CAIE CH,^Y + CAIN CH,^B ;^B OR ^Y REFERS TO SECOND DEFAULT FILE NAME + JRST FFCTLY + CAIN CH,"; + JRST FFSYSN + CAIN CH,": + JRST FFDEVN + CAIN CH,^Q + PUSHJ P,LRCH ;^Q QUOTES NEXT CHAR. +FF3: HRREI CH,-40(CH) + JUMPL CH,FF2 ;IGNORE CONTROL CHARACTERS. + TLNE C,770000 + IDPB CH,C + JRST FF2 + +;STORE NAME IN E AS SNAME, AND RESET DEVICE TO DSK IF APPROPRIATE. +FFSYSN: SKIPE E + MOVEM E,DEFDIR + .SUSET [.SSNAM,,E] + TRNN FF,FRFIND + JRST FF1 ;DEVICE HAS BEEN SPECIFIED + LDB C,[301400,,DEFDEV] + CAIE C,' ML + CAIN C,' AI + JRST FF1 + CAIE C,' MC + CAIN C,' ML + JRST FF1 + CALL FFDEV2 + JRST FF1 + +FFDEVN: PUSH P,[FFEND] +FFDEV1: JUMPE E,CPOPJ ;STORE THE CONTENTS OF E AS A DEVICE NAME, IF NOT NULL. + TRZ FF,FRFIND + CAMN E,['DSK,,] +FFDEV2: MOVE E,MACHIN + MOVEM E,DEFDEV + RET + +FFCTLX: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^X, + MOVE E,DEFFN1 ;GET THE DEFAULT FN1, + JRST FFTRM ;AND STORE IT AS A NAME. + +FFCTLY: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^Y, + MOVE E,DEFFN2 ;GET THE DEFAULT FN2, + JRST FFTRM ;AND STORE IT TOO. + +;STORE AWAY A "NORMAL FILENAME", IN E. IGNORE IT IF NULL. +FFSTOR: JUMPE E,CPOPJ + TRNE FF,FRNOT + JRST FFDEV1 + AOSE FFRRCT + MOVE A,B + MOVE B,E + RET + +;HERE AFTER A NAME IS TERMINATED WITH SOMETHING OTHER THAN : OR ; (IT'S A NORMAL NAME). +FFTRM: CALL FFSTOR +FFEND: CAIE CH,ALTMOD + JRST FF1 + SKIPL FNAMSY + SKIPA E,DEFFN2 + MOVSI E,'>_14 + SKIPE FNAMSY ;NONZERO FNAMSY SAYS + SKIPE FFRRCT ;IF ONLY ONE FILENAME + CAIA + JRST FFTRM ;USE ">" OR PREVIOUS DEFAULT AS SECOND. + TRZE FF,FRALT + RET + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + RET + +FSIFILE:SKIPA E,[ERDEV] ;FS I FILE$ - DESCRIBE OPEN INPUT FILE. +FSOFIL: MOVEI E,ROUDEV ;FS O FILE$ - DESCRIBE LAST CLOSED OUTPUT FILE. + AOSA (P) +FSDFRD: MOVEI E,DEFDEV + SAVE C + MOVEI C,14.*4 ;14 CHARS PER FILENAME >> ENOUGH + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVE A,3(E) ;WRITE THE DATA THROUGH THAT BYTE POINTER. + MOVEI C,"; + CALL SIXINT ;FIRST SNAME AND ";" AND A TAB + MOVEI CH,40 + IDPB CH,BP + MOVE A,(E) + MOVEI C,": ;THEN DEVICE NAME, ":", AND A TAB + CALL SIXINT + MOVEI CH,40 + IDPB CH,BP + MOVE A,1(E) ;THEN FN1 AND A TAB + MOVEI C,40 + CALL SIXINT + MOVE A,2(E) ;AND THE FN2. + CALL SIXIN1 + CALL QCLOSV + JRST POPCJ + +;FILE COPY +FCOPY: PUSHJ P,FFRRDD + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;OPEN FOR INPUT, NAMES IN DEFDEV ETC. + JRST OPNER1 + TRNN FF,FRUPRW ;^ E_ => XFER REAL FILENAMES OF SOURCE TO DEFAULTS. + JRST FCOPY3 + SYSCAL RFNAME,[ %CLIMM,,CHRAND ? 4WDARG( <%CLOUT,,DEFDEV>)] + .LOSE %LSFIL +FCOPY3: PUSHJ P,FFRRDD + SYSCAL OPEN,[[.BAO,,CHERRI] ? DEFDEV ? [SIXBIT/_TECO_/] ? [SIXBIT/_COPY_/] ? DEFDIR] + JRST OPNER1 + TRNN FF,FRCLN ;:E_ => TRANSFER INPUT FILE DATE TO OUTPUT FILE. + JRST FCOPY2 + SYSCAL RFDATE,[%CLIMM,,CHRAND ? %CLOUT,,Q] + SETOM Q + SYSCAL SFDATE,[%CLIMM,,CHERRI ? Q] + JFCL +FCOPY2: MOVE T,[-GCTBL,,GCTAB] + .IOT CHRAND,T + JUMPL T,FCOPY4 + MOVE T,[-GCTBL,,GCTAB] + .IOT CHERRI,T + JRST FCOPY2 + +FCOPY4: .CLOSE CHRAND, + MOVSI T,-GCTAB-1(T) + EQVI T,-1#GCTAB + .IOT CHERRI,T + SYSCAL RENMWO,[%CLIMM,,CHERRI ? DEFFN1 ? DEFFN2] + .VALUE + .CLOSE CHERRI, + JRST DELQIT + +BPNTRD: PUSHJ P,.OPNRD + TRZ FF,FRARG + JRST .FNPNT + +.OPNRD: PUSHJ P,FFRRDD +RRED: TLZ FF,FLIN ;IN CASE OPEN FAILS, INDICATE NOTHING IS OPEN. + CALL UTLSTP + MOVE A,[2,,CHFILI] + TRNE FF,FRARG ;IF HAVE ARG, IOR IT INTO OPEN-MODE. + TLO A,(C) + CALL IMMQIT + TLZ A,1 ;MAKE SURE MODE USED FOR INPUT OPEN IS EVEN! + .CALL RREDB ;OPEN NAMES IN DEFDEV ETC, MODE,,CHNL IN A. + JRST OPNER1 ;FAILURE. + SETZM IMQUIT + SETZM PAGENU ;HAVE READ 0 PAGES SO FAR. + SETOM LASTPA ;NOT ON LAST PAGE AS FAR AS TECO KNOWS. + CALL RREDGN ;DO .RCHST, SET UP ERDEV, ERSNM, RUTF1, RUTF2. +;COME HERE TO START "OFFICIALLY" READING A FILE ALREADY OPEN. +RRED1: TLO FF,FLIN + MOVEI CH,^C + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOS CH + HRRM CH,UTRLDT + POPJ P, + +RREDB: SETZ ? SIXBIT/OPEN/ ? A ? UTFARG ? 403000,,A + +RREDGN: MOVE A,DEFDIR + SYSCAL RFNAME,[%CLIMM,,CHFILI ? 4WDARG( <%CLOUT,,ERDEV>)] + .VALUE + SKIPN ERSNM ;IF DEVICE DOESN'T USE SNAME, GIVE CURRENT SNAME. + MOVEM A,ERSNM + RET + +;IO PUSH-DOWN COMMANDS + +;E[ => PUSH INPUT CHANNEL +PSHIC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + MOVEI CH,CHFILI ;SET ARG TO FOLLOWING + TLNN FF,FLIN ;IF FILE NOT OPEN, + JRST PSHIC2 + PUSHJ P,PSHCK ;E := WORD ADR OR DIE BECAUSE NOT RANDOM ACCESS + MOVE A,UTYIP ;GET BYTE POINTER + IBP A ;MAKE SURE IT POINTS *TO* THE WORD TO GET THE NEXT BYTE FROM + MOVEI T,(A) + SUB T,UTRLDT + HRREI T,(T) ;GET -<# WORDS TO GO TO END OF BUFFER> + JUMPE T,PSHIC2 ;JUMP IF AT END OF BUFFER, DON'T NEED TO DO .ACCESS + ADD E,T ;CALCULATE DESIRED WORD ADDRESS + .ACCESS CHFILI,E ;CLOBBER TO DESIRED +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA. + LSH E,1 + SUB E,LASTPA ;LASTPA HOLDS 0 OR -1. + LSH E,2 + TLNE FF,FLIN ;SAVE STATE OF FLIN TOO. + ADDI E,2 + HRRI A,1(E) ;LOW BIT SET SAYS INPUT CHNL. + PUSHJ P,CHPSH ;DO THE PUSH + JRST UICLS ;CLOBBER POINTERS AND RETURN + + ;E] => POP INTO INPUT CHANNEL + +POPIC: TLZ FF,FLDIRDPY ;DON'T DISPLAY DIRECTORY. + PUSHJ P,UICLS ;CLOBBER POINTERS FIRST + MOVE CH,[TRNN T,CHFILI] ;TRNN SKIPS IF THIS RIGHT KIND OF PDL ENTRY, CHFILI CHANNEL TO POP INTO + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + LDB CH,[020100,,A] + MOVNM CH,LASTPA + LDB CH,[031700,,A] + MOVEM CH,PAGENU + .STATUS CHFILI,CH ;GET CHANNEL STATUS + TRNE CH,77 ;IF NO DEVICE OPEN NOW + TRNN A,2 ;OR NONE WAS OPEN THEN, + JRST UTLSTP ;SAY WE'RE AT END OF FILE (MUST ALWAYS SAY THAT IF FLIN OFF) + TLO FF,FLIN ;OTHERWISE, SAY A FILE IS OPEN + CALL UTRLD2 ;RE-FILL INPUT BUFFER. + HRRI A,UTIBUF ;CONVERT BACK TO BYTE POINTER + DBP7 A ;DECREMENT TO GET RELOCATED ORIGINAL POINTER. + MOVEM A,UTYIP ;STORE AS POINTER + JRST RREDGN ;DO RFNAME; SET UP ERDEV, ERSNM, RUTF1, RUTF2. + + ;CHECK THE VALIDITY OF THE INPUT FILE OPEN ON CHANNEL SPECIFIED BY CH + +PSHCK: HRRZ A,CH ;GET CHANNEL + .CALL RFACCB + TYPRE [NRA] + RET + +RFACCB: SETZ ? 'RFPNTR ? A ? MOVEM E ((SETZ)) + + ;E\ => PUSH OUTPUT CHANNEL + +PSHOC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + CALL FLSOUT ;FORCE OUT BUFFER, EXCEPT 1 WD (LEFT IN 1ST WD OF BUFFER) + MOVE B,UTYOP ;GET B.P. TO SHIFT POS. FIELD INTO A. + IBP B ;GET BP TO PLACE NEXT CHAR GOES (RH = UTOBUF). + LDB A,[73500,,UTOBUF] ;GET 1ST 4 CHRS FROM THAT WD + ;(5TH CAN'T BE USED, SINCE FLSOUT WOULD HAVE OUTPUT THE WD) + LSHC A,7 ;LEFT-JUSTIFY CHARACTERS AND SHIFT MEAT OF BYTE POINTER IN, LEAVE BIT 1.1 BLANK (=> OUTPUT) + MOVEI CH,CHFILO ;PUT CHANNEL SPECIFICATION IN CH + PUSHJ P,CHPSH ;PUSH THE CHANNEL (ALSO PUSH A ONTO LOCAL PDL) + TLZ FF,FLOUT + RET ;CLOBBER BUFFER POINTERS AND RETURN + + ;E^ => POP INTO OUTPUT CHANNEL + +POPOC: TLZ FF,FLDIRDPY\FLOUT ;DON'T TRY TO CONTROL U + MOVE CH,[TRNE T,CHFILO] ;GET CHANNEL AND TEST INSTRUCTION IN T (INSTRUCTION SKIPS IF THIS RIGHT PDL ENTRY) + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + .STATUS CHFILO,C + TRNN C,77 + POPJ P, ;POPPED AN UNOPENED CHANNEL. + MOVEM A,UTOBUF ;STORE BACK PARTIALLY FILLED WORD + MOVE C,[700,,UTOBUF] ;GET BYTE POINTER LESS POSITION FIELD IN C + DPB A,[350700,,C] ;DEPOSIT POS FIELD + EXTRA LOW BIT + DBP7 C + MOVEM C,UTYOP ;STORE BACK NEW POINTER + ANDI A,177 ;MASK A TO POSITION FIELD_1 + IDIVI A,7_1 ;GET # CHARACTERS STILL TO BE PROCESSED THIS WORD - 1 IN A + ADDI A,*5-4 ;CONVERT TO NUMBER OF CHARACTERS YET TO OUTPUT + MOVNM A,UTYOCT ;STORE AS COUNT REMAINING + TLO FF,FLOUT ;FILE OPEN + RET + + ;PUSH THE IO CHANNEL SPECIFIED BY CH + +CHPSH: MOVE C,IOP ;GET IO PDL POINTER + PUSHJ P,CHPSH1 ;DO THE PUSH + MOVEM C,IOP ;STORE BACK UPDATED POINTER + POPJ P, + +CHPSH1: PUSH C,A + MOVE Q,[.IOPUS] + DPB CH,[270400,,Q] + XCT Q + POPJ P, + +CHPOP2: MOVE Q,[.IOPOP] + DPB E,[270400,,Q] + XCT Q + RET + + ;IO POP INTO THE CHANNEL SPECIFIED BY CH + +CHPOP: HLLM CH,CHPOPX ;STORE VALIDITY CHECKING INSTRUCTION + HRRM CH,GCHN2 ;STORE CHANNEL IN CHANNEL SEARCH ROUTINE (MAKE IT SKIP OVER IT) + MOVEI E,17 ;SET FIRST CHANEL FOR GCHN TO TRY + MOVE C,IOP ;GET IO PDL POINTER + HRRZ A,C ;GET RH IN A + MOVE B,[TYPRE [NOP] +] ;NOT ON PDL: EXECUTED IF SPECIFIED TYPE OF CHANNEL HASN'T BEEN PUSHED + PUSHJ P,CHPOP1 ;DO THE POP + XCT B ;LOST, DO THE APPROPRIATE THING + MOVEM C,IOP ;STORE BACK UPDATED POINTER + MOVE A,B ;PUT RETURN LOCAL PDL WORD IN A FOR ROUTINE THAT CALLED THIS ONE + MOVE CH,E ;RESTORE CH FOR CALLING ROUTINE + POPJ P, + + ;ENTRY ON TOP OF PDL WRONG TYPE, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + +CHPOP3: PUSH P,T ;SAVE LOCAL DESCRIPTOR WORD ON MAIN PDL + PUSHJ P,GCHN ;GET A FREE CHANNEL TO POP INTO + JRST POPAJ ;NO CHANNELS AVAILABLE + PUSHJ P,CHPOP2 ;POP INTO CHANNEL + HRLM E,-1(P) ;SAVE CHANNEL NUMBER POPPED INTO + PUSHJ P,[SOJA A,CHPOP1] ;TRY AGAIN ON ORIGINAL TASK + SOS -1(P) ;LOSE, CAUSE RETURN NOT TO SKIP + HLRZ CH,-1(P) ;RESTORE CHANNEL NUMBER, THIS TIME IN CH FOR PUSH BACK + POP P,A ;RESTORE LOCAL PDL ENTRY, BUT IN A + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPSH1 ;PUSH BACK CHANNEL AND RETURN + + +CHPOP1: CAIGE A,IOPDL ;IF A DOESN'T POINT INTO PDL, + POPJ P, ;THEN NOT ON PDL , UNSCREW PDL AND DO TYPRE [NOP] + POP C,T ;POP LOCAL PDL ENTRY INTO T + XCT CHPOPX ;SKIP IF THIS THE RIGHT KIND OF PDL ENTRY + JRST CHPOP3 ;WRONG KIND OF ENTRY, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + MOVE E,CH ;RIGHT KIND OF ENTRY, SAVE ORIGINAL CHANNEL SPECIFICATION IN E + MOVE B,T ;WIN, SAVE LOCAL PDL ENTRY FOR TOP LEVEL + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPOP2 + + ;FIND A FREE CHANNEL TO POP INTO + +GCHN: ;GCHN NAME OF ENTRY TRANSFERED TO, GCHN2 NAME OF INSTRUCTION TO ADDRESS MODIFY + XCT GCHN2 ;RH MODIFIED, CHANNEL REALLY TRYING TO POP INTO SO LEAVE IT ALONE + JRST GCHN3 ;DON'T POP INTO THIS CHANNEL + MOVE T,[.STATUS T] + DPB E,[270400,,T] + XCT T ;GET STATUS OF CHNL CONSIDERING POPPING INTO. + TRNN T,77 ;DEVICE OPEN ON CHANNEL? + JRST POPJ1 ;NO, RETURN WINNING +GCHN3: SOJGE E,GCHN ;LOSE, TRY NEXT CHANNEL + MOVE B,[TYPRE [NFC] +] ;NO FREE CHANNELS TO POP INTO + POPJ P, ;NON-SKIP RETURN + +EXITE: HRLOI C,377777 ;INFINITY + TRO FF,FRARG + MOVE E,BEGV ;PUNCH OUT IF BUFFER NONEMPTY + CAMN E,ZV + SKIPE LASTPA ;OR AN INPUT FILE IS OPEN + PUSHJ P,PUNCHA + CALL UICLS + JRST EFCMD + +;EF COMMAND - CLOSE OUTPUT FILE. +EFCMD: PUSHJ P,FRD ;READ FILENAMES TO CLOSE UNDER. +EFCMD1: MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + TLNN FF,FLOUT + TYPRE [NDO] + CAIA +EFCMDA: CALL UTYO ;PAD WITH THE CHARACTER IN FS FILEPAD TO WORD BNDRY. + MOVE CH,UTYOP + HRR CH,FILEPAD + TLNE CH,760000 + JRST EFCMDA + CALL FLSOUT ;FORCE OUT THE BUFFER (INCL. PADDING). + TRZE FF,FRCLN + JRST EFCMD2 + SYSCAL RENMWO,[%CLIMM,,CHFILO ? DEFFN1 ? DEFFN2] ;GIVE FILE ITS ULTIMATE SPEC'D NAME. + JRST OPNER1 +EFCMD2: SYSCAL RFNAME,[%CLIMM,,CHFILO ? 4WDARG( <%CLOUT,,ROUDEV>)] + .LOSE %LSFIL ;SET FS OFILE$ SO USER CAN FIND WHICH VERSION # IT WAS. + .CLOSE CHFILO, + TLZ FF,FLOUT + POPJ P, + +;EJ - OPEN FILE FOR READING AND LOAD IMPURE AREAS AS DUMPED IN FILE. +;TAKES A FILENAME ARGUMENT. DOES NOT ALTER THE DEFAULT SNAME. +;AFTER LOADING, TECO IS RESTARTED, WHICH MEANS M..L WILL BE DONE. +;^ EJ - WRITE ALL IMPURE AREAS INTO A FILE OPEN FOR WRITING, AND +;FILE IT AWAY AS SPEC'D NAMES. + +;FORMAT OF FILE: +;1ST WORD: SIXBIT/TECO/+1 (FOR ERROR CHECKING) +;2ND WORD: .FVERS OF TECO DOING THE DUMPING. + ;PREVENTS TECOS FROM LOADING DUMP FILES OF OTHER VERSIONS. +;3RD WORD: JRST 1, AS REQUIRED TO MARK THE BEGINNING OF SBLK DATA IN A BIN FILE +;THEN COME SBLK DATA BLOCKS SPECIFYING RANGES OF CORE TO LOAD, +;AND THEN TWO COPIES OF THE START ADDRESS (BOOT). + +;: EJ - OPEN FILE FOR READING AND MAP IT INTO CORE JUST UNDER LHIPAG. +;LHIPAG IS SET TO POINT AT THE BEGINNING OF THE FILE, AND A PURE +;STRING POINTER TO THE START OF THE FILE IS RETURNED. THIS COMMAND +;DOES NOT USE THE FILE FORMAT USED BY PLAIN EJ AND ^ EJ; IN FACT, +;THE FILE IS JUST A CORE IMAGE. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR + TLNN FF,FLOUT ;^ EJ. + TYPRE [NDO] + MOVE A,[-3,,[SIXBIT /TECO/+1 + .FVERS + JRST 1]] + .IOT CHFILO,A ;SAY THIS IS A TECO DUMP FILE, AND WHAT + ;TECO VERSION DUMPED IT. + HRROI A,P + JSP T,EJWBLK + MOVE A,[20-HCDS,,20] + JSP T,EJWBLK ;DUMP LOW IMPURE. + MOVE A,[HCDSE-LIMPUR,,HCDSE] + JSP T,EJWBLK ;EXCEPT FOR THE SCREEN-LINE HASH CODES. + MOVE A,QRWRT + ADDI A,4 + IDIVI A,5 ;ADDR LAST WORD OF IMPURE STRING SPACE. + SUBI A,HIMPUR ;LENGTH OF HIGH IMPURE. + MOVNS A + HRLZS A + HRRI A,HIMPUR + JSP T,EJWBLK ;DUMP OUT HIGH IMPURE. + MOVE A,BFRBOT + IDIVI A,5 + MOVE C,BFRTOP + IDIVI C,5 + SUBM A,C ;- + HRL A,C ;AOBJN TO BUFFER SPACE. + JSP T,EJWBLK ;DUMP OUT BUFFER SPACE. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;OUTPUT THE STARTING ADDRESS + MOVE TT,[-4,,2] ;OUTPUT AN INDIRECT SYMBOL TABLE POINTER BLOCK, + MOVE A,[-4,,[SIXBIT /DSK/ ? SIXBIT /TECPUR/ ? .FNAM2 ? SIXBIT /.TECO./]] + JSP T,EJWBL1 ;WHICH NEEDS A CHECKSUM LIKE ALL OTHERS. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;AND THEN ANOTHER COPY, THUS MARKING OFF A NULL SYMBOL TABLE. + JRST EFCMD ;RENAME AND CLOSE FILE. + +;A HAS AOBJN POINTER TO RANGE OF DATA; WRITE AN SBLK DESCRIBING IT. +EJWBLK: MOVE TT,A +;HERE IF TT CONTAINS BLOCK HEADER, DISTINCT FROM THE POINTER TO THE DATA. +EJWBL1: HRROI C,TT ;FIRST WE NEED TO WRITE THE AOBJN ITSELF. + .IOT CHFILO,C + .IOT CHFILO,A ;THEN WRITE THE DATA IN THAT RANGE. + MOVE TT1,TT ;THEN COMPUTE THE CHECKSUM IN TT, INCLUDING THE AOBJN WORD + ROT TT,1 + ADD TT,(TT1) ;AND THEN THE DATA WORDS. + AOBJN TT1,.-2 + HRROI C,TT + .IOT CHFILO,C ;OUTPUT THE CHECKSUM. + JRST (T) + +;EJ AND :EJ COMMANDS (THE INPUT VERSIONS OF EJ). +EJCMDR: TRZ FF,FRARG ;DON'T PASS ANY ARG TO .OPNRD; USE BLOCK ASCII MODE ALWAYS. + CALL .OPNRD ;READ FILE SPEC & OPEN FILE + TRZN FF,FRCLN ;:EJ? + JRST EJCMD2 + SYSCAL FILLEN,[%CLIMM,,CHFILI ? %CLOUT,,A] + JRST OPNER1 + ADDI A,1777 ;HOW MANY PAGES LONG IS THE FILE? + LSH A,-10. + MOVNS C,A + ADD C,LHIPAG ;IF IT WILL END JUST BELOW LHIPAG, WHERE SHOULD IT START? + CAMG C,MEMT ;LEAVE AT LEAST ONE EMPTY PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;NO ROOM - CAN WE FLUSH SOME WASTAGE FROM BUFFER SPACE? + CAMG C,MEMT + TYPRE [URK] ;NO, THERE'S REALLY NO ROOM. + RET] + HRL C,A + SYSCAL CORBLK,[%CLIMM,,200000 ? %CLIMM,,%JSELF ? C ? %CLIMM,,CHFILI] + JRST OPNER1 + CALL UICLS ;ALL PAGES MAPPED; DON'T NEED THE FILE NOW. + ADDB A,LHIPAG ;ADJUST LHIPAG FOR PAGES WE HAVE GOBBLED. + IMULI A,5*2000 + TLO A,400000 ;RETURN A STRING POINTER TO BOTTOM OF FILE. + JRST POPJ1 + +EJCMD2: MOVE A,[-3,,C] ;ORDINARY "EJ". CHECK FIRST 3 WORDS OF FILE. + .IOT CHFILI,A .SEE IDIVI ;CONSECUTIVE AC'S USED HERE. + CAMN C,[SIXBIT/TECO/+1] + CAME D,[.FVERS] ;DUMPED BY DIFFERENT TECO VERSION, + TYPRE [AOR] ;OR NOT A TECO DUMP FILE. + CAME E,[JRST 1] + TYPRE [AOR] + .SUSET [.SMSK2,,[0]] ;INTERRUPT MIGHT DO TTYSET FROM NEWLY CLOBBERED VARS. + MOVE E,LHIPAG ;SINCE WE AREN'T OVERWRITING PURE STRING SPACE + ;MUSTN'T FORGET WHERE IT STARTS. + MOVE D,MSNAME ;ALSO DON'T CLOBBER MSNAME. + MOVE T,MEMT ;.IOT'S CAN MAKE MEMORY BUT CAN'T FLUSH ANY. + MOVE J,INITFL +EJCMD1: HRROI A,C + .IOT CHFILI,A ;READ NEXT BLOCK HEADER + JUMPGE C,EJCMD3 ;POSITIVE => END OF BLOCK DATA; RESTART TECO, RUNNING Q..L. + .IOT CHFILI,C ;LOAD DATA OF BLOCK, + HRROI A,C + .IOT CHFILI,A ;SKIP THE CHECKSUM. + JRST EJCMD1 ;READ NEXT BLOCK. + +EJCMD3: MOVEM E,LHIPAG + INSIRP MOVEM D,MSNAME DEFDIR + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL ;FS LISPT$ SHOULD NOT BE CHANGED BY AN EJ. + .I SAVCMX=CBMAX=1 + .CLOSE CHFILI, + JRST INIT + +RENAM: PUSHJ P,FFRRDD + PUSHJ P,FRD + CALL IMMQIT + SYSCAL RENAME,[UTFARG ? A ? B] + JRST OPNER1 + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + JRST DELQIT + +ALINK: PUSHJ P,FFRRDD ;GET LINK NAME + CAME A,[SIXBIT/>/] + CAMN B,[SIXBIT/>/] + JRST ALINK1 ;MAKING LINK FROM FOO > WON'T DELETE ANYTHING. + MOVEI A,CHRAND + CALL IMMQIT + .CALL RREDB ;ELSE SEE IF ANY FILE WITH THAT NAME. + JRST ALINK1 + MOVEI CH,%EEXFL ;GET ERROR CODE FOR "FILE ALREADY EXISTS", + JRST OPNER4 ;SIGNAL AN ERROR WITH MESSAGE READ FROM SYSTEM. + +ALINK1: SETZM IMQUIT + MOVE A,[DEFDEV,,GCTAB] + BLT A,GCTAB+3 ;SAVE THE LINK NAMES, + CALL FFRRDD ;READ NAMES LINKED TO. + CALL ALINK2 ;GET CORRECT SNAME TO LINK TO IN C. + MOVE T,[GCTAB,,DEFDEV] + BLT T,DEFDIR ;BRING BACK LINK NAMES, + CALL IMMQIT + SYSCAL MLINK,[UTFARG ? A ? B ? C] + JRST OPNER1 + JRST DELQIT + +ALINK2: MOVE C,DEFDIR + MOVS T,DEFDEV ;CONVERT COM: TO COMMON;, ETC. + CAIN T,'COM + MOVE C,['COMMON] + CAIN T,'SYS + MOVSI C,'SYS + CAIN T,'TPL + MOVE C,['.LPTR.] + RET + +UNREAP==2 + +;READ OR WRITE DON'T-REAP BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSREAP: HLRZS E + SYSCAL FILBLK,[E ? %CLOUT,,A ? %CLOUT,,A ? %CLOUT,,A] + JRST OPNER1 + LDB A,[.BP (UNREAP),A] + MOVE B,['SREAPB] + JRST FSREA1 + +;READ OR WRITE DUMPED BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSDUMP: HLRZS E + SYSCAL RDMPBT,[E ? %CLOUT,,A] + JRST OPNER1 + MOVE B,['SDMPBT] +FSREA1: TRZN FF,FRARG + JRST POPJ1 + SYSCAL CALL,[B ? E ? C] + JRST OPNER1 + JRST POPJ1 + +WWINIT: TRNN FF,FRCLN + CALL FFRDEV ;SET DEFAULT DEV AND SNAME + TRNE FF,FRCLN + CALL FFRRDD ;OR SET DEFAULT DEV, SNAME AND FILENAMES. +EICMD: +WINIT: MOVE A,DEFFN1 + MOVE B,DEFFN2 + TRZE FF,FRCLN ;:EW, :EI USE SPEC'D NAMES TO OPEN AS, + JRST WINIT1 + MOVE A,[SIXBIT/_TECO_/] ;WITHOUT COLON, OPEN AS _TECO_ OUTPUT. + MOVE B,['OUTPUT] +WINIT1: TLZ FF,FLOUT + CALL IMMQIT + MOVEI T,100000 ;^ EW OPENS IN WRITE-OVER MODE. + TRZN FF,FRUPRW +WINIT2: MOVEI T,0 ;OTHERWISE, USE NORMAL WRITE. + SYSCAL OPEN,[[3,,CHFILO] ? DEFDEV ? A ? B ? DEFDIR ? 4000,,T] + JRST WINIT3 + SETZM IMQUIT + JSP T,FHAK ;INIT. BUFFER POINTERS. + TLO FF,FLOUT + POPJ P, + +WINIT3: .STATUS CHFILO,D ;IF WRITE-OVER OPEN FAILS FOR "FILE NOT FOUND" + LDB D,[220600,,D] + CAIN D,%ENSFL + JUMPN T,WINIT2 + JRST OPNER1 + +FHAK: TLO FF,FLOUT + MOVE CH,[10700,,UTOBUF-1] + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT + JRST 1(T) + +;DO .MTAPE ON CHANNEL IN E, WITH ARGS IN C AND SARG. +FSMTAP: HRLZS E + HRRI E,C ;E GETS CHANNEL,,ADDRESS + HRL C,SARG ;LH(C) GETS COUNT (DEFAULT IS 1). + TRNN FF,FRARG2 + HRLI C,1 + .MTAPE E, + JFCL + MOVE A,C + JRST POPJ1 + +DELE: TRZE FF,FRCLN + JRST DELE1 ; :ED IS DELETE INPUT FILE. + PUSHJ P,FFRRDD + SYSCAL DELETE,[UTFARG] + JRST OPNER1 + POPJ P, + +DELE1: TLNN FF,FLIN + TYPRE [NFI] + SYSCAL DELEWO,[%CLIMM,,CHFILI] + .LOSE %LSFIL + POPJ P, + +LISTF: CALL FFRDEV ;EY COMMAND - READ DEV NAME. +CNTRU1: CALL VBDACU ;IF THERE'S A CMD STRING PENDING, + RET ;DON'T BOTHER OPENING THE DIR. + SETZ CH, + CALL DISINI + SKIPA OUT,[CHCT] +LISTFM: MOVEI OUT,TYOM ;EZ AND EM COMMANDS. + TRNE CH,20 + CALL FFRDEV + TLZ FF,FLDIRDPY + HRRM OUT,LISTF5 + CALL AOFDIR +LISTF2: HRRZ OUT,LISTF5 + CALL GFDBLK + CAIN OUT,TYOM ;IF DUMPING CRUD INTO BUFFER, + JRST LSTF3 ;THEN DO IT FAST +LISTF6: ILDB CH,FDRP + CAIE CH,EOFCHR + CAIN CH,14 + JRST LISTF% + CALL @LISTF5 + JRST LISTF6 + +LSTF3: ANDI CH,-1 + CAIE CH,FDRBUF ;DONT ALLOW TO BACK UP BEFORE BEGINNING + SUBI CH,1 ;BACK UP TO LAST WORD .IOT'ED INTO + CAIE CH,FDRBUF ;IF NOT POINTING TO BEGINNING OF BUFFER, + SUBI CH,1 ;THEN BACK UP A WORD FOR "FORM FEED AT END OF LAST WORD" SCREW + MOVEI E,-FDRBUF(CH) ;GET INDEX INTO BUFFER IN E + IMULI E,5 ;CONVERT E TO NUMBER OF CHARACTERS UP TO THIS WORD + HRLI CH,440700 ;CONVERT TO BYTE POINTER TO WORD +LSTF4: ILDB A,CH ;GET CHARACTER FROM LAST WORD (DOES THIS LOOK BACKWARDS TO YOU?) + CAIE A,14 ;IF FORM FEED, + CAIN A,EOFCHR ;OR IF EOF CHARACTER, + JRST .+2 ;THEN FOUND END + AOJA E,LSTF4 ;HAVEN'T FOUND END YET, LOOP BACK + JUMPE E,CPOPJ ;IF NO CHARACTERS THEN THAT'S ALL FOR THIS ROUTINE + MOVEI C,(E) + CALL SLPGET ;INSERT THAT MANY CHARS, GET IDPB BP IN BP. + ILDB CH,FDRP ;NOW GET CHARACTER TO COPY + IDPB CH,BP ;COPY IT + SOJG E,.-2 ;DO IT THE APPROPRIATE NUMBER OF TIMES + IBP FDRP ;INCREMENT FDRP TO MAKE IT APPEAR THAT THE ACTUAL EOF CHARACTER WAS ENCOUNTERED + + ;PROCESS THE NEXT BLOCK OF THE FILE DIRECTORY BEING LISTED + +LISTF%: SKIPN MORFLF + JRST LSTF%2 + HRRZ A,LISTF5 ;USER HAS "FLUSHED", SEE IF TYPING OUT + CAIN A,CHCT + JRST LSTF%3 ;TYPING OUT, STOP NOW +LSTF%2: HRRZ CH,FDRP + CAIN CH,FDRBFE + JRST LISTF2 ;MORE TO COME +LSTF%3: .CLOSE CHRAND, + HRRZ A,LISTF5 + CAIN A,CHCT + JRST DISCLG + POPJ P, + +IFN 0,%%TNX%: +] ;END IFN ITS CONDTIONAL + +SUBTTL TWENEX FILE COMMANDS + +IFN TNX,[.SEE %%TNX. ;END OF THIS CONDITIONAL + +ASLEEP: TRZN FF,FRARG + SETZ C, + LSH C,5 ;CONVERT 30THS OF A SECONDS TO MS (MORE OR LESS) + TRZE FF,FRCLN ;:^S? + JRST ASLEE1 ;YES + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND + MOVE A,C + DISMS + JRST DELQIT + +ASLEE1: JUMPE C,FSLISN ;0:^S IS JUST LIKE FSLISTEN$, SO SAVE TIME THAT ATI, DTI WOULD TAKE. + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND +ASLEE5: MOVEI A,.PRIIN ;ALSO IF WE ALREADY KNOW THE ANSWER + SIBE + JRST ASLEE4 ;DONT EVEN GO TO SLEEP + SKIPGE UNRCHC + SKIPE TYISRC + JRST ASLEE4 +IFN 10X,[ + CAIGE C,50. ;TENEX DOESNT HAVE TYPEIN INTERRUPT, SO TAKE 50. MS NAPS + SKIPA A,C ;LESS THAN INCREMENT, SLEEP FOR REMAINDER + MOVEI A,50. ;ELSE JUST FOR 50. + DISMS + SUBI C,50. + JUMPG C,ASLEE5 ;STILL TIME TO GO + SETZ B, ;TIME RAN OUT, RETURN 0 +] +IFN 20X,[ + MOVE A,[.TICTI,,1] + ATI ;ASSIGN ANY TYPEIN TO CHANNEL 1 + MOVE A,C + DISMS ;SLEEP OR GET AWAKENED + SETZ B, ;RETURN 0 + JRST ASLEE3 + +ASLEE2: CIS ;FLUSH INTERRUPTS + MOVEI A,.PRIIN + SIBE ;RETURN FS LISTEN + CAIA + SETZ B, ;NOTHING WAITING +ASLEE3: MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] +ASLEE4: SETZM IMQUIT + MOVE A,B + JRST CPOPJ1 + +EQMRK: MOVSI A,(GJ%OLD) + CALL FRD ;E? RETURN 0 IF FILE EXISTS + JRST CPOPJ1 ;IT DOESNT, JUST RETURN ERROR CODE THEN + RLJFN ;GET RID OF THE JFN + JFCL + SETZ A, ;RETURN 0 FOR SUCCESS + JRST CPOPJ1 + +;SOMEONE SHOULD DEFINE THESE IN TWXBTS +.TIMAL==5 +.TIMEL==1 + +IFN 10X,[ ;STUPID TENICES CANT STANDARDIZE THIS +IF1 [ +PRINTX \IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): \ +.TTYMAC FOO +.IIT==FOO +TERMIN +IFE .IIT-1,IIT=JSYS 247 ;NOT EVEN THE SAME JSYS NUMBER +IFE .IIT-2,IIT=JSYS 630 +]] +.ELSE .IIT==0 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS OF SECONDS +FSCLKI: LSH C,4 ;CONVERT TO MS (MORE OR LESS) + MOVEM C,CLKINT ;SAVE LENGTH OF INTERVAL +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMAL] ;DELETE ALL TIMERS FOR THIS FORK + TIMER +] +IFE .IIT-1,[ + MOVE A,[100000,,.FHSLF] ;DELETE ALL BEFORE THIS TIME + HRLOI B,377777 ;INFINITY + IIT +] + JFCL ;IGNORE ERRORS +FSCLK2: SKIPN B,CLKINT ;GET LENGTH OF REAL-TIME INTERVAL + RET ;NO MORE TO DO IF 0 +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMEL] ;SET ELAPSED TIME + MOVEI C,3 ;ON CHANNEL 3 + TIMER +] +IFE .IIT-1,[ + MOVE A,[400000,,.FHSLF] + IIT +] +IFE .IIT-2,[ + MOVE C,B ;NUMBER OF MS UNTIL TIME + MOVEI A,.FHSLF + MOVSI B,10 ;ON CHAN 14. + IIT +] + JFCL ;IGNORE ERROR HERE AS WELL + RET + +TSINTC: SETOM CLKFLG ;REAL-TIME INTERRUPT, SAY IT IS TIME TO RUN HANDLER +INSIRP PUSH P,A B C + HRRZ A,INTPC2 ;GET WHERE INTERRUPT CAME FROM + CAIN A,TYIIOT ;WAITING FOR INPUT? + CALL [ SUBI A,1 ;YES, RUN THE HANDLER NOW, BUT IN CASE AN ERRSET GOES OFF + MOVEM A,INTPC2 ;DURING THE MACRO EXECUTION, ENSURE WE RESTART THE PBIN + JRST RLTCLK] ;AND DONT EVER FALL THROUGH WITH GARBAGE USER DIDNT TYPE + CALL FSCLK2 ;SETUP NEW TIMER FOR NEXT TIME +INSIRP POP P,C B A + DEBRK + ERJMP [JRST @INTPC2] ;NEEDLESS TO SAY THE INDIRECTION WONT WORK IN THE ERJMP ITSELF + +EGET: SAVE LISTF5 ;EG - INSERT STUFF INTO BUFFER + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY + HRROI A,BAKTAB + SETO B, ;CURRENT TIME + MOVSI C,(OT%NMN\OT%DAM) + ODTIM + MOVE A,[350700,,BAKTAB+1] + MOVEI C,1 + CALL EGETYP + MOVE A,[440700,,BAKTAB] + MOVEI C,2 + CALL EGETYP + CALL CRR1 + MOVE A,[100700,,BAKTAB+1] + MOVEI C,3 + CALL EGETYP + CALL CRR1 + GJINF ;CONNECTED DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT CURRENT FILENAME DEFAULTS + CALL CRR1 + TLNN FF,FLIN ;HAVE AN OPEN INPUT FILE? + JRST EGET2 + MOVEI E,ERDEV ;YES, INSERT IT'S REAL NAME + CALL FSDFR1 +EGET2: CALL CRR1 + HRROI A,BAKTAB ;CURRENT DATE IN ENGLISH FORMAT + SETO B, + MOVSI C,(OT%DAY\OT%FDY\OT%4YR\OT%DAM\OT%SPA\OT%NTM\OT%SCL) + ODTIM ;"MONDAY, NOV 28 1977" + MOVE A,[440700,,BAKTAB] + MOVEI C,3 ;REPLACE THIRD SPACE WITH COMMA + ILDB B,A + CAIE B,40 + JRST .-2 + SOJG C,.-3 + MOVEI B,", + DPB B,A + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + CALL CRR1 + CALL POM ;THE PHASE OF THE MOON (CLOSE) + CALL CRR1 + REST LISTF5 ;RESTORE THINGS + RET + +EGETYP: ILDB CH,A ;INSERT 2 CHARS AND THEN FLUSH THE NEXT ONE C TIMES + CAIN CH,40 + MOVEI CH,"0 + XCT LISTF5 + ILDB CH,A + XCT LISTF5 + SOJLE C,CPOPJ + IBP A + JRST EGETYP + +;TYPE OUT PHASE OF THE MOON +POM: GTAD + SUB A,SYNOFS ;OFFSET TO NEAREST NEW MOON TO DAY 0 + IDIV A,SYNP ;DIVIDE INTO QUARTER PERIODS + ANDI A,3 ;GET PERIOD + MOVEI A,PHSNMS(A) + CALL ASCIND ;TYPE ITS NAME + MULI B,24.*60.*60. ;CONVERT TO SECONDS + LSH C,1 ;FLUSH DUPLICATE SIGN BIT + LSHC B,17. ;GET ONE WORD PRODUCT + MOVEI E,TDHMST +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + CALL [AOJA E,TDHMS1] ;INCREMENT AND RECURSE + HLRZ C,(P) +TDHMS2: CALL DPT ;TYPE IN IN DECIMAL + HLLZ A,(E) + SOJA E,SIXIN1 ;BACK UP, TYPE AND RETURN +; USE SOME OTHER OUTPUT ROUTINE, SUCH AS SIXNTY OR ASCIND. + +PHSNMS: ASCII /NM+/ + ASCII /FQ+/ + ASCII /FM+/ + ASCII /LQ+/ + +TDHMST: SIXBIT /S./+60. + SIXBIT /M./+60. + SIXBIT /H./+24. + SIXBIT /D./+<,-1> + +SYNP: <29.53059&<777,,-1>>_-6 ;LENGTH OF QUARTER IN GTAD UNITS +SYNOFS: 22,,253553 ;18 DAYS AND A BIT + +FRDOLD: MOVSI A,(GJ%OLD) ;INSIST ON OLD FILE + CALL FRD + JRST OPNER1 ;DOESNT EXIST, ERROR +IFN 10X,[ ;THIS IS EXTREMELY DISTASTEFUL + SKIPN DEFFN2 ;IS THERE SUPPOSED TO BE AN EXTENSION? + RET ;NO, OK THEN + MOVE B,A ;YES, WE MUST CHECK FOR A GROSS MISFEATURE IN THE TENEX FILESYSTEM, + HRROI A,BAKTAB ;WHEREBY IF FILE WITH DEFAULT FN2 DOES NOT EXIST BUT A FILE WITH A NULL + MOVSI C,000200 ;FN2 DOES, IT WILL STILL BE FOUND + JFNS ;SEE WHAT THE EXTENSION OF THE FILE WE GOT IS + MOVE A,B + LDB B,[350700,,BAKTAB] + JUMPN B,CPOPJ ;NON-NULL, OK + RLJFN ;FOO! WE HAVE BEEN SCREWED, GET RID OF LOSING JFN + JFCL + MOVEI 2,GJFX19 + JRST OPNER4 ;AND FAKE NO SUCH EXTENSION ERROR +] +.ELSE RET + +FRD0: TDZA A,A +FRDFOU: MOVSI A,(GJ%FOU) +; GET A JFN FROM A FOLLOWING STRING, USING THE CURRENT DEFAULTS +; TAKES GTJFN FLAGS IN 1 RETURNS +1 A/ ERROR CODE OR +2 A/ JFN +FRD: CALL FFRRDD ;CONVERT STRING TO FILESPEC FORMAT +FF5: SETZ B, +FF5A: MOVE C,[.NULIO,,.NULIO] + SETO D, ;USE ALL DEFAULT FIELDS +FF4: MOVEM C,BAKTAB+.GJSRC + TRNN D,1 ;DEFAULT GENERATION NUMBER? + TRZA A,-1 ;NO, USE 0 THEN + HRR A,DEFFN3 ;GET DEFAULT GENERATION NUMBER + MOVEM A,BAKTAB+.GJGEN +.GJFN1==.GJNAM +.GJFN2==.GJEXT +IRPS STR,,[FN2 FN1 DIR DEV] + ROT D,-1 + TRNE D,1 ;DEFAULT THIS FIELD? + SKIPN DEF!STR ;AND HAVE A DEFAULT? + TDZA A,A ;NO OR NO + HRROI A,DEF!STR ;YES, GET IT + MOVEM A,BAKTAB+.GJ!STR +TERMIN +IFN EMCSDV\INFODV,[ ;TRANSLATE FOR SYSTEMS WITHOUT REAL + JUMPGE D,FF4B ;SKIP THIS IF NOT DEFAULTING DIRECTORY + MOVE A,DEFDIR +IFN INFODV,[ + CAMN A,[ASCIZ /INFO/] ;WANT ? + JRST FF4A ;YES +] +IFN EMCSDV,[ + CAMN A,[ASCIZ /EMACS/] ;WANT ? + SKIPE DEFDIR+1 +] + JRST FF4B +FF4A: HRROI A,DEFDIR + MOVEM A,BAKTAB+.GJDEV ;MAKE IT EMACS: OR INFO: + SETZM BAKTAB+.GJDIR ;AND FORGET DIRECTORY +FF4B: +] + SETZM BAKTAB+.GJPRO + SETZM BAKTAB+.GJACT + MOVEI A,BAKTAB + GTJFN + RET ;SINGLE RETURN + JRST CPOPJ1 ;SKIP RETURN WITH THE JFN + +;READ A FILESPEC, SETTING DEFAULTS FROM IT +FFRDEV: +FFRRDD: SAVE A + CALL MEMTOP ;GET A POINTER TO START OF FREE BUFFER SPACE + HRLI A,440700 ;MAKE IT A BYTE POINTER + SAVE A ;SAVE IT FOR LATER + SETZ B, ;RESET FLAGS +FFST0: SETZB TT,(A) ;ZERO LAST CHARACTER INSERTED + MOVSI C,(A) + HRRI C,1(A) + BLT C,17(A) ;AND AREA WE WILL BE INSERTING INTO +FFST1: CALL RCH ;GET A CHARACTER + SKIPGE SQUOTP ;SUPERQUOTED? + JRST FFSTQ2 ;YES, INSERT IT QUOTED THEN + TRNE CH,100 ;UPPERCASE UNQUOTED LETTERS + ANDCMI CH,40 + SKIPN SQUOTP ;NOT A TERMINATOR? + CAIE CH,33 ;ELSE ALTMODE TERMINATES + CAIA + JRST FFST4 + TLNE B,040000 ;PARSING DIRECTORY NAME? + JRST FFSTDR ;YES, INSERT IT THEN + CAIE CH,^A + CAIN CH,^X ;WANTS FIRST NAME DEFAULT? + JRST FFSCTX + CAIE CH,^B + CAIN CH,^Y ;WANTS SECOND NAME DEFAULT? + JRST FFSCTY + CAIE CH,^V ;^V OR ... + CAIN CH,^Q ;^Q QUOTES ANOTHER CHARACTER + JRST FFSTQT + CAIN CH,40 ;TRANSLATE SPACE TO DOT + JRST FFSTSP + CAIN CH,": ;END OF DEVICE NAME + JRST FFSTCL + CAIN CH,"< ;MAYBE PART OF DIRECTORY + JRST FFSTLT + CAIN CH,"> ;DITTO + JRST FFSTGT + CAIN CH,". ;NOTICE WHEN WE GET THE DOT + JRST FFSTDT + CAIN CH,"; ;MAYBE PART OF DIRECTORY FOR ITS + JRST FFSTSM +IFN 20X,[CAIE CH,"[ ;THESE NEED TO BE QUOTED + CAIN CH,"] +] +IFN 10X,CAIN CH,"_ ;THIS NEEDS TO BE QUOTED ON TENEX + JRST FFSTQ2 + CAIE CH,"( + CAIN CH,") + JRST FFSTQ2 + CAIE CH,"@ + CAIN CH,"^ + JRST FFSTQ2 +FFST2: MOVEI TT,(CH) ;SAVE LAST CHAR INSERTED +FFST3: IDPB CH,A ;STICK IT IN + JRST FFST1 ;AND GET ANOTHER CHAR + +FFSTQT: CALL RCH ;^Q QUOTES NEXT CHAR +FFSTQ2: MOVEI C,^V + CAIE TT,^V ;UNLESS ^V WAS LAST TO GO IN + IDPB C,A ;INSERT ONE + HRROI TT,(CH) ;SAY CHAR WAS QUOTED + JRST FFST3 ;AND INSERT IT + +FFSTDR: CAIE CH,"> ;WAITING FOR DIRECTORY + JRST FFST2 + TLZ B,040000 +FFSTB4: SKIPA A,[DEFDIR] +FFSTB0: MOVEI A,DEFFN1 +FFSTB1: HRL A,(P) ;GET START OF WHERE IT IS +FFSTB2: MOVEI C,17(A) ;GET END + BLT A,(C) ;MOVE THE DEFAULT IN +FFSTB3: MOVE A,(P) ;GET FRESH STRING POINTER + JRST FFST0 ;AND CONTINUE + +FFSCTX: SKIPA A,[DEFFN1,,0] ;INSERT DEFAULT FN1 +FFSCTY: MOVSI A,DEFFN2 ;INSERT FN2 + TLO B,400000 ;THESE ARE ITS CONSTRUCTS + JUMPE TT,FFSCT2 ;UNLESS NOTHING SEEN YET, + MOVEI C,DEFFN1 ;SET UP WHAT WE HAVE AS FN1 + HRL C,(P) + MOVEI CH,17(C) + BLT C,(CH) +FFSCT2: HRRI A,DEFFN1 ;ASSUME SETTING FN1 + TLOE B,200000 ;UNLESS DOT SEEN ALREADY + HRRI A,DEFFN2 ;IN WHICH CASE, FN2 + JRST FFSTB2 ;GO SET THEM AND CONTINUE + +FFSTSP: JUMPE TT,FFST1 ;SPACE - IF NOTHING YET, FLUSH IT IN ALL CASES + TLO B,400000 ;ELSE IT IS ITS STYLE + TLOE B,200000 ;IF ALREADY HAVE A DOT, + JRST FFST1 ;JUST FLUSH IT + JRST FFSTB0 ;ELSE GO SET FN1 FROM WHAT WE HAVE + +FFSTCL: HRRZ A,(P) ;: - GET FIRST WORD FOR DEVICE + MOVE C,(A) + MOVEM C,DEFDEV + MOVE C,1(A) + MOVEM C,DEFDEV+1 + JRST FFSTB3 ;AND GO GET MORE + +FFSTLT: JUMPGE B,FFSTL2 ;< - IF NOT ITS, MUST BE DIRECTORY + SKIPA C,[.GJLEG] ;ELSE WANT OLDEST VERSION +FFSTGT: MOVEI C,.GJDEF ;> - WANT NEWEST VERSION + MOVEM C,DEFFN3 ;SET UP DEFAULT GEN NUMBER + SETZM DEFFN2 ;AND DEFAULT FN2 TO NULL + TLOA B,320000 ;BOTH NAMES SEEN +FFSTL2: TLO B,040000 ;LOOK FOR DIRECTORY NAME + JRST FFST1 + +FFSTDT: JUMPL B,FFSTQ2 ;QUOTE IT IF ITS STYLE + TLOE B,200000 ;ALREADY HAVE A DOT? + JRST FFSTD2 ;YES, MUST BE END OF FN2 OR GENERATION NUMBER + JUMPN TT,FFSTB0 ;NON NULL STRING, MUST TERMINATE FN1 + TLO B,400000 ;ELSE ITS STYLE, + JRST FFSTQ2 ;SO INSERT IT QUOTED +FFSTD2: TLOE B,100000 ;ALREADY HAVE BOTH DOTS? + JRST FFSTD3 ;YES, MUST BE END OF GENERATION NUMBER THEN + MOVEI A,DEFFN2 ;ELSE, SET DEFAULT FN2 + JRST FFSTB1 ;AND RETURN +FFSTD3: TLOE B,020000 ;EVERYTHING SEEN + JRST FFST1 ;ALREADY ALL SEEN, FLUSH IT THEN + CALL FFSGEN ;GET GENERATION NUMBER FROM STRING + JRST FFSTB3 ;AND RETURN + +FFSTSM: TLNE B,200000 ;IF DOT SEEN ALREADY, + JRST FFSTD2 ;TREAT IT AS A DOT NOW + TLO B,400000 ;ELSE, ITS'S ITS STYLE + JRST FFSTB4 ;AND THE DIRECTORY + +FFST4: POP P,A ;GET BACK STRING POINTER + TLNE B,020000 ;IF EVERYTHING SEEN ALREADY, + JRST CPOP1J ;DONE + TLNE B,300000 ;IF EITHER FN1 OR FN2 SEEN, + SETZM DEFFN3 ;RESET THE GENERATION NUMBER + JUMPE TT,CPOP1J ;IF NOTHING YET, DONE + TLNE B,040000 ;IF WAITING FOR DIR, + JRST FFST4D ;FINISH IT UP + TLNE B,100000 ;IF PARSING GENERATION NUMBER + JRST FFST4G ;GO DO THAT + TLNE B,200000 ;IF PARSING FN2, + JRST FFST4B + SKIPLE C,FNAMSY ;FS FNAM SYNTAX$ > 0 => DEFAULT FN1 + JRST FFST4A ;GO SET FN1 + JUMPE C,FFST4B ;0 => GO SET FN2 + SETZM DEFFN2 ;DEFAULT TO FOO..0 +FFST4A: SKIPA C,[DEFFN1] ;SETTING DEFFN1 +FFST4B: MOVEI C,DEFFN2 ;SETTING DEFFN2 +FFST4C: HRLI C,(A) ;SOURCE + MOVEI A,17(C) + BLT C,(A) ;SET IT UP + JRST CPOP1J ;AND RETURN +FFST4D: MOVEI C,DEFDIR ;SETTING DIRECTORY + JRST FFST4C +FFST4G: CALL FFSGN0 ;SET GENERATION NUMBER + JRST CPOP1J ;AND RETURN + +FFSGEN: MOVE A,-1(P) ;GET STARTING POINTER +FFSGN0: SETZB TT,C ;INIT NUMBER + ILDB CH,A ;PEEK FIRST CHAR + CAIE CH,"- ;NEGATIVE? + JRST FFSGN2 ;NO + SETO C, ;SAY NEGATIVE NUMBER +FFSGN1: ILDB CH,A ;GET CHARACTER +FFSGN2: CAIL CH,"0 + CAILE CH,"9 + JRST FFSGN3 + IMULI TT,10. + ADDI TT,-"0(CH) + JRST FFSGN1 +FFSGN3: SKIPGE C ;NEGATIVE? + MOVNS TT ;YES + MOVEM TT,DEFFN3 ;SET UP DEFAULT GEN NUMBER + RET + +;SET UP DEFAULTS FROM STRING FOLLOWING +ETCMD: TRZN FF,FRCLN ;:ET? + JRST FFRRDD ;NO + +FFRRTT: CALL ECOPOS ;POSITION TO CURRENT PLACE IN ECHO AREA + CALL DPYRST ;RESET DISPLAY MODE + MOVEI A,.PRIOU + RFMOD + MOVEM B,SAVMOD ;SAVE TTY MODE (ALSO FOR ^G TO USE) + TRO B,1_6\TT%ECO ;MAKE SURE ECHO ON AND DATA MODE OK + SFMOD + SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN + TRZN FF,FRARG ;:ET - GET FROM TTY IN ECHO AREA + TLZA A,-1 + HRLZ A,C ;ANY ARGUMENT IS THE GTJFN FLAGS + TLO A,(GJ%FLG) ;RETURN FLAGS AS WELL + SETZ B, ;NO STRING + MOVE C,[.PRIIN,,.PRIOU] ;FROM TTY: + MOVE D,ETMODE ;WITH FS :ET MODE MASK OF DEFAULTS TO USE + CALL FF4 + JRST [CALL FFRRT1 ;RESTORE TTY MODE FIRST + JRST OPNER1] ;THEN REPORT ERROR + PUSH P,A ;SAVE JFN + CALL FFSET ;SET UP DEFAULTS FROM IT + ANDI A,-1 + RLJFN ;FLUSH REAL JFN + JFCL + POP P,A ;GET BACK JFN FLAGS + TLNE A,(GJ%UHV\GJ%NHV) ;IF THE VERSION CAME FROM GTJFN NOT THE USER, + SETZM DEFFN3 ;SETUP VERSION NUMBER DEFAULT RIGHT + TLNN A,(GJ%VER) ;IF VERSION NUMBER HAD WILDCARDS + JRST FFRRT1 + HRROI B,-3 + MOVEM B,DEFFN3 ;SET IT TO DEFAULT RIGHT +FFRRT1: SETZM IMQUIT ;NO MORE ^G AFTER THIS + MOVE B,SAVMOD ;RESTORE TTY MODE AFTER GTJFN +FFRRT2: MOVEI A,.PRIOU + SFMOD + SETZM SAVMOD ;AND NO MODE TO RESTORE + MOVEI A,21 .SEE VT100 + CAME A,RGETTY + RET + HRROI A,[ASCIZ "<[?2l"] ;BACK INTO VT52 MODE FOR VT100 + PSOUT + RET + +;SET UP FILENAME DEFAULTS FROM A JFN IN 1 +ROUNMS: MOVEI E,ROUDEV ;GIVE FILENAMES FOR LAST REAL OUTPUT FILE + JRST FFSET1 + +RREDGN: SKIPA E,[ERDEV] ;FOR LAST READ FILE +FFSET: MOVEI E,DEFDEV ;FOR CURRENT DEFAULTS +FFSET1: SETZM (E) + MOVSI C,(E) + HRRI C,1(E) + BLT C,ERDEV-1-DEFDEV(E) ;ZERO OUT BLOCK FIRST + SAVE A ;SAVE JFN TO SET THEM FROM + ANDI A,-1 + MOVE B,[1,,.FBGEN] + MOVEI C,C + GTFDB + ERJMP FFSET2 ;FAILED, LEAVE AT 0 + HLRZM C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER +FFSET2: MOVE B,(P) +JS%FN1==JS%NAM +JS%FN2==JS%TYP +IRPS STR,,[DEV DIR FN1 FN2] + HRROI A,DEF!STR-DEFDEV(E) + MOVSI C,(JS%!STR)&101100 + JFNS +TERMIN + JRST CPOP1J +FFSET3: MOVEI E,DEFDEV ;SETUP DEFAULTS + SAVE A + JRST FFSET2 + +FSIFIL: SKIPA E,[ERDEV] ;DESCRIBE INPUT FILE +FSOFIL: MOVEI E,ROUDEV ;DESCRIBE LAST OUTPUT FILE + AOSA (P) +FSDFRD: MOVEI E,DEFDEV ;DESCRIBE DEFAULTS + SAVE C + MOVEI C,140. ;BE SURE LONG ENOUGH + CALL QOPEN + CALL FSDFR1 +FSDFRT: CALL QCLOSV ;CLOSE UP Q REG SPACE AND GIVE STRING + JRST POPCJ + +;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E +FSDFR1: MOVEI A,DEFDEV-DEFDEV(E) + CALL ASCIND ;DEVICE + MOVEI CH,": + CALL @LISTF5 + MOVEI CH,"< + CALL @LISTF5 + MOVEI A,DEFDIR-DEFDEV(E) ;DIRECTORY + CALL ASCIND + MOVEI CH,"> + CALL @LISTF5 + MOVEI A,DEFFN1-DEFDEV(E) ;NAME + CALL ASCIND + MOVEI CH,". + CALL @LISTF5 + MOVEI A,DEFFN2-DEFDEV(E) ;EXTENSION + CALL ASCIND +IFN 10X,MOVEI CH,"; +.ELSE MOVEI CH,". + CALL @LISTF5 + HRRE C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER + JRST DPT + +;FILE COPY +FCOPY: CALL FRDOLD ;GET FIRST FILENAME + MOVE B,[7_30.+OF%RD] ;OPEN FOR 7 BIT READ + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SAVE A +FCOPY3: CALL FRD0 ;GET SECOND ONE + JRST OPNER1 + MOVE B,[7_30.+OF%WR] + MOVEM A,OPNJFN + OPENF + JRST [ POP P,A + RLJFN + JFCL + JRST OPNER0 + ] + TRNN FF,FRCLN ;: E_ XFER INPUT FILE DATES TOO + JRST FCOPY2 + EXCH A,(P) ;INPUT FILE +IFN 20X,[ + MOVEI B,T + MOVEI C,1 + RFTAD + EXCH A,(P) + SFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,C + GTFDB + EXCH A,(P) + HRLI A,.FBWRT + SETO B, + CHFDB + ANDI A,-1 +] +FCOPY2: EXCH A,(P) ;GET INPUT FILE + MOVE B,[440700,,GCTAB] + MOVNI C,GCTBL*5 + SIN + ADDI C,GCTBL*5 ;GET NUMBER OF WORDS REALLY TRANSFERED + JUMPE C,FCOPY4 ;NONE, EOF + MOVN C,C + MOVE B,[440700,,GCTAB] + EXCH A,(P) ;OUTPUT FILE + SOUT + JRST FCOPY2 +FCOPY4: CLOSF ;CLOSE INPUT FILE + JFCL + REST A ;FILE JUST WRITTEN + CLOSF + JFCL + JRST DELQIT + +;OPEN INPUT FILE AND BIGPRINT NAME ON OUTPUT DEVICE +BPNTRD: CALL .OPNRD + TRZ FF,FRARG + JRST .FNPNT + +;OPEN FILE FOR READ +.OPNRD: CALL FRDOLD + TLZN FF,FLIN ;JUST IN CASE + JRST RRED2 + EXCH A,CHFILI + CLOSF + JFCL + SKIPA A,CHFILI +RRED2: MOVEM A,CHFILI +IFN 20X,MOVE B,[36._30.+OF%RD] +IFN 10X,MOVE B,[36._30.+OF%RD+OF%EX] ;THIS IS THE BIGGEST CROCK + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + SETZM PAGENU + SETOM LASTPA + CALL RREDGN ;SET UP REAL FILENAMES OF INPUT FILE + +;HERE TO ACTUALLY START READING FROM IT +RRED1: TLO FF,FLIN + MOVEI CH,EOFCHR + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOJ CH, + HRRM CH,UTRLDT + RET + +; I/O PDL COMMANDS +;E[ - PUSH INPUT JFN AND STATE +PSHIC: TLZ FF,FLDIRDPY + TLNN FF,FLIN ;ANYTHING OPEN NOW? + JRST PSHIC2 + MOVE A,CHFILI ;GET CURRENT POSITION + RFPTR + TYPRE [NRA] + MOVE C,UTYIP ;GET CURRENT POINTER + IBP C ;FIGURE HOW MANY WORDS WE HAVENT USED + MOVEI T,(C) + SUB T,UTRLDT + HRREI T,(T) + JUMPE T,PSHIC2 + ADD B,T ;RESET BYTE POSITION BEFORE THEM + SFPTR + TYPRE [NRA] +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA + LSH E,1 + SUB E,LASTPA + LSH E,2 + TLNE FF,FLIN ;AND STATE OF FLIN + ADDI E,2 + HRRI C,1(E) + MOVE A,INIOP ;GET INPUT PDL POINTER + PUSH A,CHFILI ;PUSH JFN + PUSH A,C ;PUSH STATE THEREOF + MOVEM A,INIOP ;UPDATE PDL POINTER + TLZ FF,FLIN + JRST UTLSTP ;SET TO SEE EOF + +;E] - POP INPUT JFN +POPIC: TLZ FF,FLDIRDPY + CALL UICLS ;CLOSE ANYTHING WE HAVE NOW + MOVE C,INIOP ;GET INPUT PDL POINTER + POP C,CH ;GET STATE FLAGS + LDB A,[020100,,CH] + MOVNM A,LASTPA ;STATE OF LASTPA + LDB A,[031700,,CH] + MOVEM A,PAGENU ;STATE OF PAGENU + POP C,A ;GET JFN + MOVEM C,INIOP ;UPDATE PDL POINTER + GTSTS + TLNE B,(GS%OPN) ;IS IT OPEN? + TRNN CH,2 ;AND WE THOUGHT ONE WAS TOO? + RET ;NO OR NO, FORGET IT + TLO FF,FLIN ;YES, SAY ONE IS NOW + MOVEM A,CHFILI ;STORE AWAY JFN + CALL UTRLD2 ;GET A BUFFER FULL + HRRI CH,UTIBUF + DBP7 CH + MOVEM CH,UTYIP ;UPDATE BUFFER POINTER + JRST RREDGN ;AND SET REAL FILENAMES + +;E\ - PUSH OUTPUT JFN +PSHOC: TLZ FF,FLDIRDPY + CALL FLSOUT ;FLUSH ANY CURRENT OUTPUT THRU + MOVE B,UTYOP ;GET POINTER TO OUTPUT BUFFER + IBP B + LDB A,[073500,,UTOBUF] + LSHC A,7 + MOVE C,OUTIOP ;GET OUTPUT PDL + PUSH C,CHFILO ;SAVE JFN + PUSH C,A ;SAVE STATE OF JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + TLZ FF,FLOUT ;SAY NO FILE TO WRITE ON NOW + RET + +;E^ - POP OUTPUT CHANNEL +POPOC: TLZ FF,FLDIRDPY\FLOUT ;PERHAPS NO FILE TO WRITE + MOVE C,OUTIOP ;GET OUTPUT PDL POINTER + POP C,CH ;GET STATE + POP C,A ;GET JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + GTSTS + TLNN B,(GS%OPN) ;FILE NOW OPEN? + RET ;NO, DONE THEN + MOVEM A,CHFILO ;YES, UPDATE BUFFER POINTERS + MOVEM CH,UTOBUF + MOVE C,[000700,,UTOBUF] + DPB CH,[350700,,C] + DBP7 C + MOVEM C,UTYOP + ANDI CH,177 + IDIVI CH,7_1 + ADDI CH,*5-4 + MOVNM CH,UTYOCT ;AND COUNT OF REMAINING BYTES + TLO FF,FLOUT ;SAY WE HAVE AN OUTPUT FILE NOW + RET + +EXITE: HRLOI C,377777 ;EE - WRITE OUT FILE AND CLOSE IT + TRO FF,FRARG + MOVE E,BEGV ;ANYTHING IN THE BUFFER? + CAMN E,ZV + SKIPE LASTPA ;OR THE INPUT FILE? + CALL PUNCHA ;YES, WRITE IT OUT THEN + CALL UICLS ;CLOSE ANY INPUT FILE + JRST EFCMD ;AND GO CLOSE AND RENAME OUTPUT FILE + +EXITX: TLNN FF,FLOUT ;IF NO OUTPUT FILE + CALL FFRRDD ;STILL READ AND SET DEFAULTS + TLNE FF,FLOUT ;IF HAVE AN OUTPUT FILE, + CALL EXITE ;FINISH IT UP +IFN 20X,[ + MOVE A,[.PRAST,,.FHSLF] ;SET THIS FORK + MOVEI B,[1 ;MAGIC FOR THE EXEC + 400740,,2 + 0] + MOVEI C,3 ;LENGTH + PRARG ;SET PROCESS ARG BLOCK +] +IFN 10X,[ ;THIS IS THE ONLY WAY TO GET BACK CCL FOR 10X +RUN==47000,,35 ;1050 UUO + MOVE A,[1,,[SIXBIT /SYS/ + SIXBIT /CCL/ + 0 ? 0 ? 0 ? 0]] + RUN A, ;SWAP IN CCL AND DO LAST COMMAND AGAIN + JFCL +] + JRST .EXIT ;AND QUIT BACK TO EXEC + +EFCMD: CALL FFRRDD ;GET FILE DEFAULTS FOR REAL OUTPUT +EFCMD1: TLNN FF,FLOUT ;MUST HAVE AN OUTPUT FILE + TYPRE [NDO] + TDZA A,A ;RESET COUNT OF FILLER BYTES +EFCMDA: CALL UTYO + MOVE CH,UTYOP + HRR CH,FILEPA ;PAD TO EVEN WORD WITH FILEPAD + TLNE CH,760000 + AOJA A,EFCMDA + PUSH P,A ;SAVE COUNT OF FILLER BYTES + CALL FLSOUT ;FLUSH OUT LAST OF BUFFER + MOVE A,CHFILO + RFPTR ;GET WHERE WE ARE + SETZ B, + IMULI B,5 ;INTO CHARS + SUBM B,(P) ;LESS FILLERS + TLO A,(CO%NRJ) ;CLOSE, BUT SAVE JFN + CLOSF + JFCL + HRLI A,.FBSIZ ;SET FILE SIZE + SETO B, + POP P,C ;TO NOT INCLUDE FILLERS + CHFDB + ERJMP EFCMD5 ;MAYBE ONLY WRITE ACCESS, NO FDB + HRLI A,.FBBYV ;AND SET BYTE SIZE + MOVSI B,(FB%BSZ) + MOVSI C,000700 ;TO BE 7-BIT + CHFDB +EFCMD5: MOVSI C,DEFDEV-ERDEV ;SEE IF FILENAME DEFAULTS HAVE CHANGED +EFCMD4: MOVE B,DEFDEV(C) + CAME B,ROUDEV(C) + JRST EFCMD3 ;DIFFERENT, MUST DO RENAME + AOBJN C,EFCMD4 + ANDI A,-1 ;GET JUST JFN +EFCMD2: CALL ROUNMS ;SET UP REAL NAMES OF OUTPUT FILE + RLJFN ;THRU WITH THE JFN + JFCL + TLZ FF,FLOUT ;NO MORE OUTPUT FILE + SETZM CHFILO + RET +EFCMD3: MOVSI A,(GJ%FOU) + CALL FF5 ;GET JFN FOR NEW NAME + JRST OPNER1 + MOVEI B,(A) + MOVE A,CHFILO ;RENAME OUTPUT FILE TO IT + RNAMF + JRST OPNER1 + MOVEI A,(B) + JRST EFCMD2 + +;EJ - LOAD IMPURE PORTIONS FROM FILE +;:EJ LOAD LIBRARY FILE INTO PURE STRING SPACE. +;^ EJ - WRITE OUT IMPURE PORTIONS IN A BOOTABLE FORMAT +;DUMP FILES CAN BE IDENTIFIED BECAUSE THEY HAVE 'TEC,,VERSION-NUMBER +;IN THE .FBUSW WORD IN THE FDB. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR ;READ IN + TLZN FF,FLOUT ;^ EJ + TYPRE [NDO] ;MUST HAVE AN OUTPUT FILE ALREADY + MOVEM P,BOOTP ;SSAVE DOESNT SAVE AC'S + MOVE A,CHFILO + TLO A,(CO%NRJ) + CLOSF + JFCL ;CLOSE FAKE OUTPUT FILE + HRLI A,(DF%EXP) + DELF ;AND GET RID OF IT + JFCL + SETZM CHFILO ;DONT HAVE THIS SET IN THE DUMPED OUT FILE + CALL FRDFOU ;GET REAL OUTPUT FILE + JRST OPNER1 + CALL ROUNMS ;SET UP REAL OUTPUT NAMES + HRLI A,.FBUSW + SETO B, + MOVE C,[SIXBIT /TEC/+.FVERS] ;TO IDENTIFY A DUMP FILE + CHFDB + MOVE TT,[-<_-9>,,SS%CPY\SS%RD\SS%EXE+0] + MOVEM TT,BAKTAB ;LOW IMPURE + MOVE TT,QRWRT + ADDI TT,4 + IDIVI TT,5000 + SUBI TT,HIMPUR_-9 + MOVNI TT,1(TT) ;NEGATIVE OF NUMBER OF PAGES + HRLI TT,SS%CPY\SS%RD\SS%EXE+HIMPUR_-9 + MOVSM TT,BAKTAB+1 ;START OF HIGH IMPURE + MOVE B,BFRBOT + IDIVI B,5000 ;STARTING PAGE OF BUFFER SPACE + MOVE C,BFRTOP + IDIVI C,5000 + SUBM B,C ;-LENGTH + HRLI B,-1(C) ;- + TRO B,SS%CPY\SS%RD\SS%EXE + MOVEM B,BAKTAB+2 + HRLI A,.FHSLF + MOVEI B,BAKTAB + SETZB C,BAKTAB+3 + SETZM LIMPUR ;MAKE SURE THE EJ FILE LOADS TECPUR IF RUN + SSAVE ;SAVE THOSE IMPURE PAGES + SETOM LIMPUR + RET + +;INPUT VERSIONS +EJCMDR: CALL FRDOLD ;GET FILE + TRZN FF,FRCLN + JRST EJCMD2 ;EJ - MAP IN IMPURE AREAS + MOVE B,[36._30.+OF%RD] + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SIZEF + TYPRE [URK] ;SOME SORT OF ERROR HERE + ASH C,-1 ;CONVERT PAGES TO BLOCKS + MOVNI B,(C) + ADD B,LHIPAG ;WITHIN RANGE? + CAMG B,MEMT ;LEAVE AT LEAST ONE BLANK PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;BUT SEE IF THERE IS ANYTHING WASTED WE CAN FLUSH + CAMG B,MEMT ;BEFORE DECIDING IT'S FATAL. + TYPRE [URK] + RET] + MOVEM B,LHIPAG ;UPDATE BOTTOM PAGE + ASHC B,1 ;CONVERT BACK TO BLOCKS + HRLI B,.FHSLF + HRLZS A ;JFN + HRLI C,(PM%CNT\PM%RD) +IFN 10X,[ + MOVEI D,(C) + PMAP ;10X - NO MULTIPLE PMAP'S + SOJLE D,.+3 + AOJ A, + AOJA B,.-3 +] +.ELSE PMAP ;MAP IN THOSE PAGES + HLRZ A,A + CLOSF + JFCL + HRRZ A,LHIPAG ;RETURN POINTER + IMULI A,12000 + TLO A,400000 + JRST POPJ1 + +EJCMD2: MOVE B,[1,,.FBUSW] ;CHECK USER SETTABLE WORD + MOVEI C,C + GTFDB + CAME C,[SIXBIT /TEC/+.FVERS] ;A COMPATIBLE DUMP FILE? + TYPRE [AOR] ;NOPE + MOVE E,LHIPAG + MOVE T,MEMT + MOVE J,INITFL ;SAVE THESE GUYS + HRLI A,.FHSLF + GET ;THIS SHOULD ONLY HAVE IMPURE PAGES + MOVEM E,LHIPAG + MOVE B,D + HRROI A,DEFDIR + DIRST + JFCL + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL + .I SAVCMX=CBMAX=1 ;RESTORE THEM + SETOM PJATY ;WE JUST LOADED INVALID HCDS, SO NEED ALL LINES REDISPLAYED. + JRST INIT ;RESTART OURSELVES + +;RENAME FILE 1 TO FILE 2 +RENAM: CALL FRDOLD ;GET FIRST FILE + SAVE A + CALL FRDFOU ;GET SECOND FILE + JRST OPNER1 + CALL IMMQIT + MOVEI B,(A) + REST A + RNAMF ;DO THE RENAME + JRST OPNER1 + MOVEI A,(B) + RLJFN + JFCL + JRST DELQIT + +;DELETE A FILE +DELE: CALL FRDOLD ;GET OLD FILE JFN + DELF ;DELETE IT + JRST OPNER1 + RET + +WWINIT: CALL FFRRDD ;EW - GET FILENAME DEFAULTS +EICMD: TRNE FF,FRUPRW ;^EW MEANS CAN OVERWRITE + TDZA A,A ;NO GTJFN FLAGS THEN + MOVSI A,(GJ%FOU) ;OTHERWISE USER OUTPUT DEFAULTS + CALL FF5 ;GET JFN FROM DEFAULTS + JRST OPNER1 + EXCH A,CHFILO + SKIPLE A + CLOSF ;GET RID OF ANY OLD FILE + JFCL + MOVE A,CHFILO + MOVE B,[36._30.+OF%WR] ;OPEN FOR WRITE + TRNE FF,FRUPRW ;AND IF IN OVERWRITE MODE, + TRO B,OF%RD ;READ TOO, SO FILE NOT CLOBBERED + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + TLO FF,FLOUT ;SAY WE HAVE ONE + MOVE CH,[DEFDEV,,ROUDEV] ;SAVE CURRENT FILENAME DEFAULTS + BLT CH,ROUDEV+ERDEV-DEFDEV-1 + MOVE CH,[010700,,UTOBUF-1] ;REINIT BUFFER POINTER + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT ;AND BUFFER COUNT + RET + +; DO MTOPR ON JFN FROM LH E, WITH ARGS IN C AND SARG +FSMTAP: HLRZS E + MOVE A,(E) + MOVE C,SARG + MTOPR + MOVE A,C ;ANY ARG RETURNED IN 3 + JRST POPJ1 + +; READ OR MODIFY FDB FOR INPUT FILE +FSIFDB: TRZN FF,FRARG + TYPRE [WNA] + HLRZS E + MOVE A,(E) + MOVEI B,(C) ;FIRST WORD TO DO + HRLI B,1 ;ONE WORD + MOVEI C,D ;WHERE TO PUT IT + GTFDB + TRZN FF,FRARG2 ;WAS THERE A SECOND ARGUMENT? + JRST FSFDB2 ;NO, JUST RETURN OLD VALUE + HRLI A,(B) ;WORD TO CHANGE + MOVE C,SARG ;NEW VALUE + MOVE B,C + XOR B,D ;GENERATE MASK FOR NEW VALUES + CHFDB + ERJMP OPNER1 +FSFDB2: MOVE A,D + JRST CPOPJ1 + +;DIRECTORY DISPLAY COMMANDS +LISTF: CALL LSTFRD ;GET FILESPEC FROM FOLLOWING STRING +CNTRU1: CALL LSTFR2 ;USE DEFAULT (DEV:*.*.*) + CALL VBDACU ;SEE IF THERE IS ANY COMMAND WAITING + RET ;RETURN RIGHT AWAY + SETZ CH, + CALL DISINI ;INIT DISPLAY + MOVEI OUT,CHCT ;TYPE OUT + JRST LISTF1 + +LISTFM: MOVEI OUT,TYOM ;TYPE INTO MEMORY + TRNE CH,20 ;EZ? + CALL LSTFRD ;YES, READ FROM USER + CALL LSTFR2 ;NO, USE DEFAULTS +LISTF1: SAVE A ;SAVE THE JFN + TLZ FF,FLDIRDPY ;DONT NEED IT AGAIN + HRRM OUT,LISTF5 + +LISTF2: HRROI A,BAKTAB ;INTO FREE SPACE + HRRZ B,(P) + TRNE FF,FRARG ;USE USERS FORMAT IF AN ARGUMENT OF IT + SKIPA C,NUM + MOVE C,[1_27.+1_24.+1_21.+JS%SIZ+JS%LWR+JS%LRD+JS%PSD+JS%PAF] + JFNS ;ALONG WITH SIZE AND READ AND WRITE DATES + MOVEI CH,^M ;AND A CRLF + IDPB CH,A + MOVEI CH,^J + IDPB CH,A + MOVEI CH,^@ + IDPB CH,A ;END WITH NULL + + HRRZ OUT,LISTF5 ;GET WHERE IT GOES + CAIN OUT,TYOM ;INTO MEMORY? + JRST LISTF8 ;YES, DO IT FAST THEN + MOVEI A,BAKTAB ;START OF WHERE STRING IS + CALL ASCIND ;TYPE THIS LINE OUT + SKIPL MORFLF ;--MORE-- FLUSHED? + JRST LISTF3 ;NO + POP P,A ;GET BACK JFN + RLJFN ;GET RID OF IT + JFCL + JRST LISTF7 ;DONE + + +LISTF8: MOVEI C,-BAKTAB(A) ;NUMBER OF WORDS + IMULI C,5 + LSH A,-30. + HRREI A,-36.+7(A) ;NULL DOESNT COUNT + IDIVI A,7 + SUB C,A ;GET TOTAL NUMBER OF CHARS USED + CALL SLPGET ;MAKE THAT MUCH ROOM + MOVE A,[440700,,BAKTAB] +LISTF6: ILDB CH,A ;INSERT GIVEN NUMBER OF CHARACTERS + IDPB CH,BP + SOJG C,LISTF6 + +LISTF3: MOVE A,(P) ;GET BACK MULTI JFN + GNJFN ;GET NEXT FILE + CAIA ;NONE LEFT + JRST LISTF2 ;TAKE CARE OF IT TOO + POP P,A ;FLUSH JFN +LISTF7: HRRZ A,LISTF5 ;IF GOING TO DISPLAY AREA, + CAIN A,CHCT + JRST DISCLG ;FINISH UP DISPLAY + RET + +LSTFRD: AOSA (P) ;GET A FILENAME FROM THE USER +LSTFR2: TLZA FF,FRNOT ;GET JUST DEFAULTS + TLO FF,FRNOT + SAVE DEFFN1 ;TEMPROARILY USE *.* + SAVE DEFFN2 + SAVE DEFFN3 + MOVSI A,() + MOVEM A,DEFFN1 ;SET THEM UP + MOVEM A,DEFFN2 + MOVEI A,-3 ;AND .* + HRRM A,DEFFN3 + MOVSI A,(GJ%IFG\GJ%OLD) ;ALLOW MULTIPLE INPUT FILESPECS + TLNE FF,FRNOT ;READING FROM STRING? + JRST LSTFR4 ;YES, GET IT +IFN 10X,HRROI B,[ASCIZ /*.*;*/] +.ELSE HRROI B,[ASCIZ /*.*.*/] ;DEFAULT STRING IF NOT FOM USER +LSTFR5: CALL FF5A + JRST OPNER1 +LSTFR3: REST DEFFN3 + REST DEFFN2 + REST DEFFN1 + RET +LSTFR4: CALL FFRRDD ;READ FILESPEC STRING + JRST LSTFR5 + +IFN 0,%%TNX.: +] ;END IFN TNX CONDITIONAL + +;FS DFILE$ -- THE DEFAULT FILE NAMES, AS A STRING. CAN BE READ OR SET. +FSDFILE:CALL FSDFRD ;FIRST GET VALUE TO RETURN FROM OLD FILENAMES. + TRZN FF,FRARG ;IF HAVE ARG, SET FILENAMES TO IT BY INSERTING IT + JRST POPJ1 ;INTO AN ET COMMAND. + JSP T,GCPUSA ;MEANWHILE, KEEP VALUE WHERE IT WILL BE RELOCATED. + MOVEI A,[ASCIZ /[0 U0 ET0 ]0/] + CALL MACXCP + JRST GCPOPV + +;HERE TO MACRO QREG OR ASCIZ IN A, WITH ARG IN C, SAVING CURRENT VALUE STATUS. +MACXCP: JSP T,OPEN1 + MOVEM C,NUM + CALL [ SKIPE RREBEG ;IF ^R IS DOING THIS, MUST CALL MACRO USING RRMAC. + JRST MACXQW ;SO THAT TECO KNOWS WE ARE LEAVING ^R. + JRST RRMAC5] + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW\FROP\FRSYL + HRROI T,CPOPJ + JRST CLOSE2 + +SUBTTL OUTPUT ROUTINES THAT USE LISTF5 + +;COME HERE FOR DPT OF NEGATIVE NUMBER. +DPT2: CAMN C,[SETZ] ;CAN'T NEGATE THIS! MUST WORK SPECIALLY + JRST DPTMNF + MOVNS C ;OTHERWISE PRINT THE MAGNITUDE, PRECEDED BY A "-". + TLO FF,FLNEG +RDPT: SOJA TT,DPT6 + +DPT: TDZA TT,TT ;DECIMAL PRINT, NO LEADING ZEROS. +SLDPT: MOVEI TT,2 ;DECIMAL PRINT, WITH AT LEAST 3 POSITIONS USED. +DPT1: JUMPL C,DPT2 +DPT6: MOVE D,QRB.. + MOVM CH,.QBASE(D) + SOJLE CH,[ + MOVEI C,10. ;IF ..E HOLDS 0, 1 OR -1, REPLACE BY 10. + MOVEM C,.QBASE(D) + TYPRE [..E]] + IDIV C,.QBASE(D) +DPT8: HRLM D,(P) + JUMPGE D,DPT7 ;HANDLE NEGATIVE REMAINDER (IMPLIES NEG. RADIX). + MOVE D,QRB.. + HRLZ D,.QBASE(D) + MOVNS D + ADDM D,(P) + AOS C +DPT7: SKIPE C + CALL RDPT + TLZE FF,FLNEG + SAVE ["--"0,,DPT3] +DPT3: JUMPLE TT,DPT4 + XCT DPT5 + PUSHJ P,@LISTF5 + SOJG TT,.-1 +DPT4: HLRE CH,(P) +DGPT: ADDI CH,"0 + CAILE CH,"9 ;FOR "DIGITS" ABOVE 9, USE LETTERS. + ADDI CH,"A-"9-1 + JRST @LISTF5 + +DPTMNF: MOVE D,QRB.. ;HANDLE PRINTING OF 400000,, + MOVE D,.QBASE(D) + CAIE D,8 ;PRINT IT WITH A "-" SIGN, EXCEPT IN OCTAL. + TLO FF,FLNEG + SAVE D + LSHC C,-35. ;NOTE LOW BIT OF E IS 0, SINCE QRB.. ISN'T TOO BIG. + DIV C,(P) + SUB P,[1,,1] + JRST DPT8 + +;= PRINTS . +;,= PRINTS ,. +;,= PRINTS ,. +;^ => PRINT IN ECHO AREA. : => OMIT THE . +PRNT: ARGDFL ;-= MEANS -1=. + TRNN FF,FRARG+FRARG2 + TYPRE [WNA] + TRNN FF,FRARG2 + JRST PRNT2 + EXCH C,E ;= WITH 2 ARGS: + CALL PRNT3 ;PRINT THE 1ST ARG, + MOVEI CH,", + CALL @LISTF5 ;A COMMA, + EXCH C,E ;AND THE SECOND ARG. + TRNE FF,FRARG +PRNT2: PUSHJ P,PRNT3 + TRNN FF,FRUPRW + SAVE [DISFLS] ;IF ORDINARY TYPEOUT, MUST FORCE IT OUT WHEN DONE. + TRNE FF,FRCLN + RET + JRST CRR1 + +PRNT3: MOVEI A,TYO + TRNE FF,FRUPRW + MOVEI A,FSECO2 + HRRM A,LISTF5 + JRST DPT + +CRR: MOVEI CH,TYO + HRRM CH,LISTF5 + PUSHJ P,CRR1 + JRST DISFLS + +CRR1: MOVEI CH,15 + PUSHJ P,@LISTF5 + MOVEI CH,12 + JRST @LISTF5 + +CTLQM: SKIPA CH,[^Q] +SPSP: MOVEI CH,40 + JRST @LISTF5 + +FORMF: MOVEI CH,^M + CALL @LISTF5 + MOVEI CH,^L + JRST @LISTF5 + +IFN ITS,[ +LFILE: MOVE A,DEFDIR + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,DEFDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,DEFFN1 + MOVEI C,40 + PUSHJ P,SIXINT + MOVE A,DEFFN2 +] ;IFN ITS + +;OUTPUT A WORD OF SIXBIT, WITH ^Q'S AS NEC. SO TECO CAN READ BACK IN AS FILENAME. +SIXIN1: JUMPE A,CPOPJ + MOVEI B,0 + ROTC A,6 +IFN ITS,[ + JUMPE B,SIXIN2 + CAIE B,': + CAIN B,'; +SIXIN2: PUSHJ P,CTLQM +] + MOVEI CH,40(B) + PUSHJ P,@LISTF5 + JRST SIXIN1 + +SIXINT: PUSHJ P,SIXIN1 ;INSERT IN THE BUFFER THE SIXBIT WORD IN A + MOVE CH,C ;AND THE ASCII CHAR IN C + JRST @LISTF5 + +SIXINS: PUSHJ P,SIXIN1 + JRST CRR1 ;END WITH CRLF + +;OUTPUT ASCIZ STRING <- A, THRU LISTF5. +ASCIND: HRLI A,BP7 ;GET BP TO STRING. +ASCIN1: ILDB CH,A + JUMPE CH,CPOPJ + XCT LISTF5 + JRST ASCIN1 + +SIXNTY: PUSH P,OUT + MOVE OUT,E +SIXNT1: SETZ CH, + ROTC OUT,6 + ADDI CH,40 + CALL @LISTF5 + JUMPN OUT,SIXNT1 + REST OUT + POPJ P, + +TYPR: MOVEI IN,6 +TYPR3: MOVE OUT,[(600)E-1] + ILDB CH,OUT + ADDI CH,40 + XCT LISTF5 + SOJG IN,.-3 +TYPR2A: POPJ P,LISTF4 + +SLTAB: LISTF4: + MOVEI CH,^I + JRST @LISTF5 + +SUBTTL TERMINAL I/O FS FLAGS + +;FS LISTEN$ - RETURN NONZERO IFF INPUT IS AVAILABLE. +;IF NONZERO ARG, THEN IF NO INPUT AVAILABLE PRINT IT AS ASCII CHAR IN ECHO AREA. +FSLISN: SKIPN TYISRC + SKIPL A,UNRCHC ;RETURN -1 IF INPUT IS AVAILABLE FROM ANY SOURCE. + JRST POPJ1 + LISTEN A + JUMPG A,NRETM1 + TRZE FF,FRARG ;OTHERWISE, IF THERE'S AN ARG, + SKIPN RGETTY + JRST POPJ1 + AOS (P) + JRST FSECOT ;TYPE IT IN ECHO MODE (ON DISPLAYS ONLY) + +IFN ITS,[ +;FS MP DISPLAY$ - OUTPUT CHARACTER OR STRING TO M.P. AREA IN DISPLAY MODE. +FSMPDS: SKIPGE CH,C + JSP CH,FSMPD1 + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJDIS] + .LOSE %LSFIL + RET +] + +FSMPD1: HRRM CH,LISTF5 + SETO D, + JRST FGCMD1 + +;FS ECHO DISPLAY$ - OUTPUT CHAR OR STRING IN DISPLAY MODE (^P IS SPECIAL) TO THE ECHO AREA. +;ARG IN C; CLOBBERS CH. +FSECDS: SKIPGE CH,NELNS + SETCM CH,NELNS + JUMPE CH,CPOPJ ;DO NOTHING IF THERE'S NO ECHO AREA. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPGE CH,C + JSP CH,FSMPD1 +IFN ITS,.IOT CHECDS,CH +IFN TNX,CALL ECHODP ;OUTPUT ^P CODE IN ECHO AREA + JRST FSECO5 + +IFN TNX,FSMPDS: ;CLOSEST WE CAN COME - NOTHING SHOULD DO IT ANYWAY +FSIMAG: SKIPGE CH,C ;FS IMAGE OUT$ - OUTPUT CHARACTER OR STRING IN SUPER-IMAGE MODE. + JSP CH,FSMPD1 +IFN ITS,.IOT CHSIO,CH +IFN TNX,CALL [MOVEI A,(CH) ? PBOUT ? RET] + JRST FSECO6 + +;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS STRAY CR. +FSECO2: CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPN RGETTY ;ON PRINTING TTY, MUST TYPE USING NORMAL MECHANISM; OTHERWISE + JRST TYO ;CHCTHP WOULD NOT BE UPDATED AND SPURIOUS CONTINUATIONS WOULD HAPPEN + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +IFN ITS,[ + SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +IFN TNX,CALL ECHOC0 ;OUTPUT CHARACTER IN ECHO AREA + JRST FSECO5 + +;FS ECHO OUT - OUTPUT ARG IN ECHO MODE (WRITE-ONLY) +FSECOT: MOVE CH,C ;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS CRLF. +FSECO1: SKIPN RGETTY ;ON PRINTING TTY, WE WILL USE NORMAL TYPEOUT, WHICH MEANS + SAVE [DISFLS] ;THAT AFTERWARD WE MUST FORCE IT OUT. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + JUMPL CH,[ ;IF ARG IS A STRING, + CALL SAVACS + MOVE C,CH + MOVEI CH,FSECO2 ;TYPE OUT EACH CHAR OF IT USING FSECO2. + HRRM CH,LISTF5 + SETO D, + CALL FGCMD1 + JRST RSTACS] + SKIPN RGETTY + JRST [ CAIN CH,^M + JRST CRR + JRST TYO] + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +FSECOR: +IFN ITS,.IOT CHECHO,CH ;ARG IS CHAR IN CH; OUTPUT IN ECHO MODE. +IFN TNX,CALL ECHOCH +FSECO5: SKIPG ECHACT + SETOM ECHACT ;MAKE SURE ECHO AREA IS CLEARED. +FSECO6: SETOM RROVPO ;IN CASE IN ^R MODE, + SETOM RROHPO ;MAKE SURE CURSOR GETS REPOSITIONED. + SETOM ECHCHR + RET + +FSECO7: AOSE PJATY ;CLEAR SCREEN IF IT SAYS IT NEEDS TO BE CLEARED SOON. + RET + CALL CTLL1 + SETOM RRMSNG ;MAKE SURE ^R REDISPLAYS EVERYTHING NEXT TIME. + JRST RRLRDS + +SUBTTL TERMINAL OUTPUT COMMANDS + +;FV$ -- DISPLAY +FVIEW: TROE FF,FRCLN ;:FV DOESN'T START AT TOP OF SCREEN. + JRST FVIEW1 ;AND IT DOES TYPEOUT INSTEAD OF DISPLAY. + CALL DISINI + JRST FVIEW1 + +;FT$ -- TYPE +FTYPE: TRNE FF,FRUPRW ;^ FT TYPES STRING IN ECHO AREA. + JRST [ CALL IMMQIT + TRNN FF,FRCLN ;^:FT DOES DOES SO ONLY IF NO INPUT AVAILABLE. + JRST FTYECH + SKIPGE UNRCHC + SKIPE TYISRC + JRST FNOOP + LISTEN A + JUMPE A,FTYECH + JRST FNOOP] ;THERE'S INPUT; IGNORE STRING INSTEAD TYPING IT. + TRZE FF,FRCLN ;:FT STARTS AT TOP OF SCREEN. + SETOM TYOFLG + CALL DISINT +FVIEW1: MOVEI BP,CHCT + CALL IMMQIT +FTYLUP: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + CAIA + JRST FTEND +FTYCHR: ANDI CH,177 + CALL (BP) + JRST FTYLUP + +FTEND: CALL DELQIT + TRNE FF,FRCLN + JRST DISCLG + SKIPGE TYOFLG + RET + JRST DISFLS + +FTYEC1: ANDI CH,-1 ;REMEMBER SUPRQUTED CHARS HAVE L.H. SET! + CALL [ CAIE CH,^M + CAIN CH,^J + JRST FSECO2 + JRST FSECO1] +FTYECH: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + JRST FTYEC1 + CALL DELQIT + SKIPN RGETTY + JRST DISFLS + RET + +;V COMMAND, AND ALL VARIATIONS THEREOF. EXIT WITH JRST RET. +VIEW: TRZE FF,FRUPRW + JRST [ CALL VIEW1B ;"^ V" - DO APPRO. KIND OF DISPLAY + JRST VIEW1A] ;THEN CHECK FOR FOLLOWING W. + SKIPN RGETTY + JRST VIEW1A + PUSHJ P,DISINI + SETOM VREMEM ;TRY TO DISPLAY BFR AT SAME PLACE + PUSHJ P,GETARG + CALL CHK1A + MOVE A,E + SUB A,BEGV + SKIPGE A + SETO A, + MOVEM A,GEA + .I DISADP=PT+1 ;TELL DISAD WHERE TO PUT CURSOR. + MOVEI J,DISAD + PUSHJ P,TYPE1 +VIEW1: PUSHJ P,DISCLG +VIEW1A: MOVE T,CPTR + ILDB C,T + CAIE C,"W + CAIN C,"W+40 + SKIPN COMCNT + POPJ P, + CALL RCH ;FLUSH THE "W" OF "VW". + TRZ FF,FRARG2+FRARG+FRCLN + JRST FTYI ;READ IN CHAR, RETURN AS NUMBER. + +VIEW1B: SKIPE DISPRR ;"^ V": IN ^R MODE, DO A ^R-STYLE DISPLAY + JRST RRNOIN + JRST VIEW3A ;ELSE DO STANDARD DISPLAY. + +EUHACK: CALL FFRDEV ;E^U -- READ FILENAME, THEN DO + JRST CNTRLU ;WHATEVER DIR DISPLAY THE USER WANTS. + +;COME HERE FROM GO, AFTER THE END OF A COMMAND STRING +;(WHETHER IT ENDED SUCCESSFULLY OR NOT) +;DECIDE WHETHER AND HOW TO DISPLAY. +VIEW2: ANDCMI FF,FRCLN + TLZE FF,FLDIRDPY ;FRCLN _ FLDIRDPY +;^U COMMAND - DO USER'S SELECTED TYPE OF DIRECTORY DISPLAY. +CNTRLU: IORI FF,FRCLN + MOVE CH,QRB.. + TRNN FF,FRCLN + SKIPA A,.QBFDS(CH) ;FLDIRDPY WAS OFF, WE WANT BUFFER DISPLAY. + MOVE A,.QFDDS(CH) ;IT WAS ON, WE WANT DIR DISPLAY. + JUMPE A,VIEW3B ;USER HASN'T SUPPLIED MACRO: DO ^V OR :^V. + JRST MACXQ ;DO THE MACRO. + +TYPE: PUSHJ P,GETANU ;T COMMAND: DECODE ARGS. + MOVEI J,FSECO2 ;^ T TYPES IN ECHO AREA. + TRZN FF,FRUPRW +TYPE2: MOVEI J,TYO ;TYPE RANE IN E,C. +TYPE1: MOVE IN,E +TYPE3: SKIPN MORFLF + SKIPE STOPF + RET + CAML IN,C + JRST TYPE5 + PUSHJ P,GETINC + PUSHJ P,(J) + JRST TYPE3 + +TYPE5: CAIE J,TYO + SKIPN RGETTY + SKIPGE TYOFLG + POPJ P, + JRST DISFLS ;FORCE THE TYPEOUT OUT, IF THE M.P. AREA TYPEOUT MECHANISM WAS USED. + +SUBTTL BUFFER DISPLAY + +;COME HERE AFTER EACH CMD STRING, +;IF USER HAS NOT SUPPLIED A MACRO TO BE INVOKED. +VIEW3B: TRZ FF,FRARG + MOVE TT,QRB.. + SKIPE .QVWFL(TT) + POPJ P, ;DON'T DISPLAY IF CMDS IN STRING INHIBITED IT. + SKIPE RGETTY ;SHOULD WE EVER DISPLAY ON THIS TERMINAL + JRST VIEW3A + TRNN FF,FRCLN ;ELSE, ON PRINTING TTY, NO DISPLAY OF DIRS, + SKIPN TTMODE ;BUFFER DISPLAYED ONLY IN :^N MODE. + RET +VIEW3A: TRZE FF,FRCLN + JRST CNTRU1 + CALL VBDACU ;UPDATE TSALTC, SKIP IF OK TO DISPLAY. + POPJ P, +VBD: SETO A, + CALL VBDBLS ;MAKE SURE WE HAVE A VALID WINDOW (BLESS IT) + JRST VBDDIS ;THEN DISPLAY FROM THERE. + +VBDRR: SETO A, + CALL VBDBL1 ;HERE TO DISPLAY FOR ^R, WITH OUTPUT AND WINDOW SET UP. ON DISPLAYS ONLY! + MOVEM B,RRVPOS + JRST VBDDIS + +;A/ -1 => MAKE SURE THAT WE HAVE A VALID WINDOW. +;A/ VPOS => CHOOSE WINDOW TO PUT PT AT THAT VPOS. +VBDBLS: SETOM TYOFLG ;SINCE WE ARE SCREWING UP VPOS AND HPOS, TYPEOUT SHOULD REINIT. + MOVE C,NLINES + CALL WINSET +VBDBL1: SAVE %END + SAVE CHCTVS ;ON PRINTING TTY'S WE MUSTN'T CHANGE THE WINDOW SIZE FOR GOOD. + .I CHCTVS=BOTLIN ;BUT DURING BUFFER DISPLAY, RESTRICT TO # LINES. + CALL VBDRR2 ;CALCULATE NEW ABSOLUTE WINDOW ADDRESS IN A. + .I GEA=A-BEGV + REST CHCTVS + REST %END + RET + +VBDRR2: JUMPGE A,[ SETOM %END ;IF VPOS FOR PT SPEC'D EXPLICITLY, USE IT. + JRST VBDN5] ;ALSO TURN OFF MARGIN CHECKING FOR ZV. + SKIPE RGETTY ;NOT DATAPOINT => NO DESIRE TO DISPLAY FROM SAME PLACE. + SKIPGE IN,GEA ;OR NO OLD PLACE TO START FROM => + JRST VBDNEW ;START FROM SCRATCH. + ADD IN,BEGV ;TRY THE OLD START. + CAMLE IN,PT ;NO GOOD TO START AFTER POINTER. + JRST VBDNEW + JRST VBDTRY ;ELSE SEE IF OLD WINDOW STILL GOOD. + +;SET THE VARIABLES THAT DESCRIBE THE SIZE AND POSITION OF THE WINDOW +;AND THE MARGINS (REGIONS WHERE WE DON'T WANT THE POINTER TO BE); NAMELY, +;RRTOPM, RRBOTM, BOTLIN, AND VSIZE. +;C SHOULD CONTAIN NLINES (OR SOMETHING TO USE INSTEAD). +WINSET: SAVE D + SKIPGE C + SETZ C, ;NEGATIVE # LINES NOT ALLOWED. + SAVE J + SKIPL J,TOPLIN + CAML J,USZ + SETZM TOPLIN ;IF FS TOP LINE$ IS INVALID, SET IT TO 0 INSTEAD. + REST J + SKIPE C + ADD C,TOPLIN ;C HAS DESIRED LAST LINE (+1) TO USE, OR 0 FOR WHOLE SCREEN. + CAML C,USZ + SETZ C, ;CAN'T USE MORE LINES THAN WE HAVE. + SKIPN C + MOVE C,USZ ;NO SPECIFICATION, OR BAD SPEC, => USE TILL SCREEN BOTTOM. + CAIL C,MXNVLS ;IF THAT'S INFINITELY MANY LINES, USE 2 LINES. + MOVEI C,2 + MOVEM C,BOTLIN ;STORE DESIRED LAST LINE (+1) IN BOTLIN. + SUB C,TOPLIN + MOVEM C,VSIZE + IMUL C,%TOP ;COMPUTE MARGINS THAT CURSOR MUSN'T GO OUTSIDE. + IDIVI C,100. + ADD C,TOPLIN + MOVEM C,RRTOPM + MOVE C,VSIZE + IMUL C,%BOTTO + IDIVI C,100. + SUB C,BOTLIN + MOVNM C,RRBOTM + JRST POPDJ + +;TRY TO MAKE SURE TSALTC IS UP TO DATE. TSALTC CAN GET WRONG IF TTY IS +;RETURNED TO DDT AND IT THROWS AWAY ALL THE INPUT. +VBDACU: SKIPN TSALTC ;UPDATE TSALTC (IN CASE DDT HAS FLUSHED + SKIPE TSINAL ;THE $$'S THAT INT'D US) (SKIP IF ENDS UP 0) + CAIA + JRST POPJ1 + LISTEN CH, + JUMPN CH,CPOPJ + SETZM TSALTC ;NO INPUT CHARS WAITING => NO $$'S. + SETZM TSINAL ;AND NO STRAY $. + HRROS LTYICH + JRST POPJ1 + +;COME HERE TO SEE IF THE PREVIOUS WINDOW (ADDR IN IN) CAN BE REUSED (GEA > -1). +;IN THIS CASE, CAN GO TO VBDNEW IF THE WINDOW IS BAD, OR CAN RETURN WINDOW IN A. +;COME HERE FROM VBDNEW WITH A TENTATIVE WINDOW ADDRESS IN IN (WHICH MAY BE TOO +;CLOSE TO BEG) TO FIND A MORE PRECISE WINDOW (GEA = -1). +;IN THIS CASE, C HOLDS -, AND WE ALWAYS RETURN. +;WE ALWAYS RETURN THE NEW VPOS OF POINT IN B. +;WE SHOULD NEVER BE CALLED WITH A WINDOW THAT IS AFTER POINT. +VBDTRY: CALL CHCTI0 ;INIT VARIOUS TEMPS FOR TYPEOUT. + SETZ T, ;INITIAL HPOS IS 0 (VBDL UPDATES) + SETZM MORFLF ;THIS MIGHT HAVE STOPPED LAST VBDTRY. + CALL MEMTOP ;OUT GETS ADDR OF FREE STORAGE, + MOVE OUT,A ;FOR TABLE OF LINE-BEGINNING ADDRESSES. + MOVE A,IN ;A _ THE START WE'RE TRYING NOW. + CAMLE A,PT + .VALUE + CALL GETIBI ;BP IN BP TO FETCH CHARS TO TYPE, STARTING AT IN. + MOVEI TT,VBDL ;CALL VBDL TO "OUTPUT" A LINE. + MOVEM TT,CHCTAD + SETZB TT,CHCTBP ;TELL CHCT TO THROW AWAY CHARS. + HLLOM TT,DISBFC ;IT WILL NEVER FILL UP ITS INFINITE SINK. + MOVE TT,TOPLIN ;START "PRINTING" WHERE WE WILL LATER REALLY START PRINTING. + MOVEM TT,CHCTVP + ADD TT,OUT ;STORE BEGINNING OF 1ST LINE DISPLAYED AS 1ST CHAR DISPLAYED. + MOVEM IN,(OUT) +VBD0: CAMN IN,PT ;REACHED PT => + JRST VBDPT ;CHECK WHETHER THIS WINDOW IS OK. +VBDPT2: CAMN IN,ZV ;(COMES BACK IF CAN'T TELL YET, + ;NEAR END OF SCREEN BUT OK IF END OF BUFFER FITS) + JRST VBD3 ;AT END, SEE IF MADE IT ON TO SCREEN. + CAMN IN,GPT ;IF AT GAP, MOVE BP OVER IT. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 ;OUTPUT NEXT CHAR. + SKIPN MORFLF + JRST VBD0 + JRST VBDNEW ;OFF END OF SCREEN AND PT TOO LOW. + +VBD3: MOVE TT,CHCTVP ;REACHED ZV BEFORE FLUSHING, + CAMN TT,BOTLIN ;WINDOW OK IF ZV IS ON SCREEN ABOVE --MORE-- LINE + CAMN T,CHCTHP ;OR IF ZV IS ON IT BUT NO CHARS TYPED ON IT + CAIA + JRST VBDNEW + +;REACHED PT DURING VBD0 LOOP. +VBDPT: SKIPGE GEA ;CAME TO VBDTRY FROM VBDNEW => + JRST VBDDWN ;ZERO IN ON BEST WINDOW. + CAMN A,BEGV ;TRYING TO RE-USE WINDOW => + JRST VBDPT1 ;UNLESS WE STARTED AT START OF BUFFER, + MOVE TT,RRTOPM + CAMLE TT,CHCTVP ;SHOULDN'T HAVE PT < %TOP PERCENT OF SCREEN FROM TOP. + JRST VBDNEW +VBDPT1: MOVE B,CHCTVP ;MIGHT BE OK, REMRMBER # OF LINE WITH PT. + CAMN B,BOTLIN ;IF WE'RE ON THE --MORE-- LINE + CAMN T,CHCTHP ;WE'RE REALLY OFF BOTTOM, BAD WINDOW. + CAIA + JRST VBDNEW + CAML B,RRBOTM ;NOT IN LAST %BOTTOM PERCENT OF SCREEN OR + CAMN IN,ZV ;ALREADY AT BUFFER END => + RET ;CAN'T BE TO NEAR BOTTOM. IT'S GOOD; RETURN IT. + CALL DISBAR + JRST VBDPT2 ;ELSE SEE IF END OF BUFFER FITS ON SCREEN. + +;CHCT CALLS HERE WITH EACH LINE DURING VBDTRY. +;SETS UP THE LINE-BEGINNING ADDRESS ENTRY FOR THE LINE. +;LEAVES HORIZ POS. START OF NEXT LINE IN T. +VBDL: MOVE Q,CHCTVP + MOVE TT1,Q + ADD TT1,OUT + MOVE T,CHCTNL ;STORE ADDRESS OF 1ST CHAR ON LINE. + MOVEM T,1(TT1) + MOVE T,CHCTHP ;RETURN H.P. AFTER LINE. + MOVE TT1,GEA ;IF GOING TO GO TO VDBDWN, + AOJE TT1,CPOPJ ;MAKE SURE ALL THE LINE'S STARTS ARE STORED. + CAMN Q,BOTLIN ;AT BOTTOM OF SCREEN => + SETOM MORFLF ;STOP THE LOOP AT VBDTRY. + POPJ P, + +;START FROM SCRATCH, FIGURING OUT A NEW WINDOW. +;RETURN THE NEW WINDOW ADDRESS IN A, AND THE NEW VPOS OF POINT IN B. +VBDNEW: SKIPGE DISTRN + JRST VIEW2A ;IN TRUNCATE MODE, EVERYTHING EASIER. + MOVE A,VSIZE ;PRETEND WE'RE STARTING AT MIDDLE OF SCREEN. + IMUL A,%CENTER + IDIVI A,100. + SKIPGE A + SETZ A, + MOVE T,VSIZE + CAMG T,A + MOVEI A,-1(T) + ADD A,TOPLIN +;HERE FROM RREAR3; A HAS DESIRED VPOS OF PT. +VBDN5: SETOM GEA ;SO NEXT TIME REACH VBDPT WON'T COME HERE AGAIN. + CALL CHCTI0 + SETZM CHCTBP ;MAKE SURE WE DON'T TRY USING UP INFINITE AMOUNTS OF DISBUF. + MOVEM A,CHCTVP + SETZB T,MORFLF + MOVE BP,PT + CAMN BP,BEGV ;IF PT = BEGV, WINDOW MUST START AT BEGV. + JRST [ MOVE A,BP + MOVE B,TOPLIN + RET] + MOVEI C,CPOPJ ;TELL DISAD NOT TO DO ANYTHING WITH THE LINES IT CONSTRUCTS. + MOVEM C,CHCTAD + SAVE CHCTVP ;SAVE TOPLINE+#CENTER. + MOVE TT,VSIZE + IMUL TT,%END + JUMPL TT,VBDN6 + IDIVI TT,100. + SAVE TT ;REMEMBER #END (TOTAL*%END/100) + IMUL TT,NHLNS ;ARE WE WITHIN #END*WIDTH*2 CHARS OF END OF BUFFER? + LSH TT,1 + CAIL TT,1000. ;IF NOT FOR THIS, SMALL %END'S WOULD BE IGNORED UNLESS PT VERY NEAR Z. + MOVEI TT,1000. ;RATHER, THEY MEAN "PUT Z VERY NEAR SCREEN END, IF IT'S ON SCREEN AT ALL" + ADD TT,BP + CAMGE TT,ZV ;IF SO, DON'T LEAVE MORE THAN #END BLANK LINES AT BOTTOM. + JRST VBDN4 ;IF NOT, ASSUME WE WON'T LEAVE THEM & DON'T WASTE TIME. + CAMN BP,ZV ;WE'RE AT END OF BUFFER => + JRST [SOS IN,BP ;NEED FULL SCREEN ABOVE PT. + CALL GETCHR ;IF LAST CHAR ISN'T LF, + CAIE CH,^J ;MAKE SURE THE LAST UNTERMINATED LINE + AOS CHCTVP ;DOESN'T END UP OFF SCREEN BOTTOM. + JRST VBDN2] + CAMLE BP,GPT + ADD BP,EXTRAC + CALL GETIBP ;SEE HOW MANY LINESOF TEXT THERE ARE BETWEEN PT AND BUFFER END. + MOVE IN,PT + SKIPE RGETTY + SKIPE RREBEG + CALL DISBAR ;STARTING AT THE PTR SO MAKE CURSOR (EXCEPT IN ^R ON DISPLAY TTY). + MOVE E,BOTLIN ;IF WE GET DOWN TO VPOS = TOTAL-#END, WE CAN PUT CURSOR + SUB E,(P) ;AT THE USUAL PLACE (#CENTER), SO STOP COUNTING LINES. +VBDN1: CAMN IN,ZV + JRST VBDN2 ;ALL USED UP, SEE HOW MANY LINES THAT MADE. + CAMG E,CHCTVP + JRST VBDN4 + CAMN IN,GPT ;WHEN AT GAP, MOVE BP OVER GAP. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 + JRST VBDN1 + +VBDN2: MOVE C,CHCTVP ;REACHED END OF BFR WITHOUT REACHING VPOS = TOTAL-#END. + CAME T,CHCTHP ;MAYBE WE STARTED ANOTHER LINE NOT COUNTED IN VPOS. COUNT IT TOO + JRST [ CAME C,BOTLIN ;UNLESS IT'S REALLY OFF + AOS C ;BOTTOM OF SCREEN. + JRST .+1] + SUB C,A ;# LINES WE PRINTED IN VBDN1 LOOP. + ADD C,(P) ;PLUS MAX # BLANK LINES TO LEAVE BELOW THEM, + MOVNS C ;GIVES MAX # LINES WE CAN ALLOW BELOW PT. + ADD C,BOTLIN ;SUBTRACT FROM WINDOW BOTTOM TO GIVE MIN VPOS FOR PT. + MOVEM C,-1(P) ;(SMALLER THAN AND INSTEAD OF TOPLIN+#CENTER WHICH WE SAVED). +VBDN4: SUB P,[1,,1] ;NO LONGER NEED #END. +VBDN6: MOVNS C,(P) ;GET BACK #CENTER OR CORRECTED # OF LINES WE WANT ABOVE PT. + ADD C,TOPLIN ;-<# LINES NEEDED ABOVE PT> + CALL VBDN7 ;IN GETS PLACE WHERE THOSE LINES START. + REST C ;- . + JRST VBDTRY + +;RETURN IN IN THE CHAR ADDR OF A SPOT C(C) LINES UP FROM POINT. +;MORE PRECISELY, IT MUST BE AT LEAST C(C) SCREEN LINES UP, BUT MAY BE MORE, +;BUT SHOULDN'T BE TOO MUCH MORE FOR THE SAKE OF EFFICIENCY. +;LIKE DOING -@L BUT WITH CUTOFF IN CASE THERE ARE NO CRLFS IN THE BUFFER. +VBDN7: MOVE E,C ;FIND PLACE BACK FROM POINT FAR ENOUGH + SUBI E,2 ;TO FILL UP THAT MANY SCREEN LINES (PLUS 2) + IMUL E,NHLNS ;WITH JUST CONTINUATION LINES. + ADD E,PT + CAMGE E,BEGV ;THERE, OR BEGINNING OF BUFFER, IS WHERE WE CUT OFF. + MOVE E,BEGV + MOVE IN,PT ;NOW, LOOK BACK THAT MANY LINES FROM POINT, BUT NOT PAST THERE. +VBDN7L: SOS IN ;LOOP HERE OVER LINES. +VBDN7C: CAMGE IN,E ;LOOP HERE OVER CHARACTERS. + AOJA IN,CPOPJ + CALL GETCHR ;EXAMINE NEXT CHAR BACK FOR BEING A LF. + CAIE CH,^J + SOJA IN,VBDN7C + CAMN IN,E + RET + SUBI IN,1 ;IF SO, SEE IF WHAT PRECEDES IT IS A CR. + CALL GETINC + CAIE CH,^M + SOJA IN,VBDN7C + AOJLE C,VBDN7L ;IF SO, THAT'S ONE LINE DOWN. + AOJA IN,CPOPJ ;WHEN WE'VE GONE ENOUGH LINES, LEAVE IN -> CHAR AFTER THE LF. + +;COME HERE IN VBDTRY TO SEE WHETHER OUR GUESS FOR GEA WAS GOOD. +;IT'S NO GOOD IF POINT WOULD APPEAR FARTHER DOWN THE SCREEN THAN EXPECTED/ +;SINCE WE REMEMBERED WHERE IN THE BUFFER EACH SCREEN LINE STARTED, +;WE CAN IMMEDIATELY FIND THE CHARACTER THE RIGHT NUMBER OF LINES UP FROM POINT. +;C HAS THE NUMBER OF SCREEN LINES DESIRED ABOVE POINT. +VBDDWN: SAVE A + SAVE RRHPOS + SAVE RRVPOS ;FIRST WORRY ABOUT THINGS LIKE: + .I RRHPOS=CHCTHP + .I RRVPOS=CHCTVP + AOSN RRNCCR ;WHAT IF POINT IS RIGHT AFTER A CR? IN THAT CASE + CALL [ SOS PT ;THE CR HASN'T REALLY BEEN OUTPUT YET. + JRST RRFORW] ;SO ADJUST OUR SCREEN POSITION TO BE AFTER THE CR. + MOVE A,RRHPOS + CALL RRFOR3 ;ALSO, MAYBE THE NEXT CHARACTER WOULD CAUSE A CONTINUATION. + MOVE A,RRHPOS + MOVEM A,CHCTHP + MOVE A,RRVPOS ;ADJUST SCREEN POSITION FOR THAT, IF NECESSARY. + EXCH A,CHCTVP + ADD A,OUT ;IN CASE WE DO START A CONTINUATION LINE, + PUSH A,PT ;ENTER IN THE TABLE WHERE THAT CONTINUATION STARTS. + REST RRVPOS + REST RRHPOS + REST A + MOVN B,C + CAMLE B,CHCTVP + MOVE B,CHCTVP + ADD C,CHCTVP ;(C STILL HAD - # LINES WANTED ABOVE PTR) + JUMPLE C,CPOPJ ;NOT MORE THAN MAX, OK. + ADD C,TOPLIN + ADD C,OUT + MOVE A,(C) ;ELSE FIND 1ST CHAR ON THE LINE WE SHOULD START WITH. + RET + +;DISPLAY THE BUFFER STARTING AT THE WINDOW IN GEA. +VBDDIS: SAVE CHCTVS + SAVE [[ REST CHCTVS + RET]] + SAVE BOTLIN + CALL DISINI ;SET UP FOR DISPLAY. + REST BOTLIN ;DISINI RESETS BOTLIN IGNORING FS LINES, WHICH IS WRONG. + .I CHCTVS=BOTLIN + MOVE TT,QRB.. ;DISPLAY SHOULDN'T INHIBIT ANOTHER DISPLAY OF SAME STUFF. + SETZM .QVWFL(TT) + SETOM VREMEM + MOVE TT,TOPLIN + MOVEM TT,CHCTVP + MOVE IN,GEA + ADD IN,BEGV + MOVEM IN,LINBEG(TT) +VBDOK3: MOVEM IN,CHCTBL ;REMEMBER CHAR ADDR START OF 1ST LINE + ;(DISAD WILL SET CHCTBL FOR LATER LINES) + CALL GETIBI +VBDOK1: SKIPN MORFLF + SKIPGE ORESET ;STOP IF FLUSHED OR QUITTING. + JRST DISCLG + CAMN IN,ZV ;STOP IF NO MORE CHARS. + JRST DISCLG + CAMN IN,PT ;OUTPUT THE CURSOR IF BEFORE PT. + CALL DISBAR + CAMN IN,GPT ;IF AT GAP, MOVE B.P. IN BP OVER IT. + CALL FEQGAP + MOVE TT,CHCTHP + CAME TT,NHLNS ;IF ABOUT TO CONTINUE A LINE + SKIPN DISBFC ;OR IF THE BUFFER IS FULL, + JRST VBDSLO ;OUTPUT 1 CHARACTER SLOWLY TO CONTINUE OR EMPTY THE BUFFER. + SKIPGE DISTRN + JRST VBDSLO + SKIPE CASDIS ;IF WE NEED CASE-FLAGGING, OR + JRST VBDSLO + SKIPL CHCTCF ;IF WE HAVE AN UNPROCESSED CR, + JRST VBDFAS ;MUST GO THRU DISAD SINCE ONLY DISAD KNOWS HOW TO HACK ONE. +VBDSLO: ILDB CH,BP + AOS IN +VBDSL1: .I RRCCHP=CHCTHP + CALL DISAD2 ;OUTPUT THE CHAR. + JRST VBDOK1 + +;IF WE GET HERE, WE KNOW WE CAN GO AT LEAST 1 CHAR BEFORE REACHING PT, GPT, ZV, +;THE RIGHT MARGIN, OR THE END OF DISBUF. +;A HAS THE HPOS TIMES 7, E HAS THE HASH CODE, BP HAS THE BP AND IN HAS THE CHAR ADDRESS. +;TT HAS THE HPOS TO STOP AT, TIMES 7. OUT HAS THE BP TO STOP AT. CH HOLDS THE CHAR. +VBDFAS: MOVE OUT,BP + MOVE BP,ZV ;CONSIDER PT, GPT AND ZV; BP GETS WHICHEVER IS SMALLEST + CAMGE IN,GPT + CAMG BP,GPT + CAIA + MOVE BP,GPT ;YET BEYOND WHERE IN IS NOW. + CAMGE IN,PT + CAMG BP,PT + CAIA + MOVE BP,PT + SOS BP ;CONVERT CHAR ADDR IN BP TO THE B.P. TO LDB THE PREVIOUS CHAR. + CALL GETIBV + IBP BP ;(GETIBV FOLLOWED BY IBP = GETBV). + EXCH OUT,BP + MOVE A,CHCTHP ;A GETS 7 TIMES THE HPOS. WE USE IT FOR SHIFTING FOR THE HASH CODE. + IMULI A,7 ;ALSO, TT GETS 7 TIMES THE LINE WIDTH AND THAT IS AN END TEST. + MOVE TT,NHLNS + IMULI TT,7 + MOVE E,CHCTHC ;E IS WHERE WE ACCUMULATE THE CHECKSUM. +VBDFLP: ILDB CH,BP + XCT VBDTBL(CH) ;FOR FUNNY CHARS, GO SOMEPLACE ELSE. +VBDNRM: IDPB CH,CHCTBP ;STORE CHAR INTO OUTPUT. + ROT CH,(A) + ADD E,CH ;UPDATE THE HASH CODE OF THE LINE. +VBDTRT: ADDI A,7 + CAME BP,OUT ;STOP IF REACH PT, GPT OR ZV. + CAMN A,TT ;STOP IF REACH RIGHT MARGIN. + CAIA ;IN EITHER CASE, INCREMENT HPOS FOR CHAR WE JUST DID. + JRST VBDFLP +;HERE EITHER IN = PT,GPT OR ZV, OR ELSE WE ARE ABOUT TO CONTINUE A LINE. +;SO VBDOK1 IS GUARANTEED TO DO 1 CHAR THE SLOW WAY BEFORE VBDFAS IS REACHED. +VBDOUT: CALL VBDSTO ;STORE BACK CHCTHC, CHCTHP, AND IN + JRST VBDOK1 + +VBDTBL: JRST VBDCTL ;^@ +REPEAT 6,JRST VBDCTL ;^A THRU ^F + JRST VBDCTL ;^G + JRST VBDBS ;^H + JRST VBDTAB ;^I + JRST VBDLF ;^J +REPEAT 2,JRST VBDCTL ;^K, ^L + JRST VBDCR ;^M +REPEAT 13.,JRST VBDCTL ;^N THRU ^Z + JRST VBDALT ;ALTMODE +REPEAT 4,JRST VBDCTL ;^\ THRU ^_ +REPEAT 137,JFCL ;NORMAL GRAPHICS CHARACTERS + JRST VBDCTL ;RUBOUT IS LIKE A CTL CHAR. +IFN .-VBDTBL-200,.ERR WRONG TABLE LENGTH + +VBDSTO: IDIVI A,7 ;CONVERT A BACK TO HPOS TIMES 1. + EXCH A,CHCTHP ;A IS UPDATED CHCTHP + SUB A,CHCTHP ;OLD CHCTHP MINUS NEW CHCTHP (A NEGATIVE NUMBER) + ADDM A,DISBFC ;IS ALSO - <# OF CHARS IDPB'D>. + MOVEM E,CHCTHC + SAVE BP + CALL GETCA + AOS IN,BP + CAMLE IN,GPT + SUB IN,EXTRAC + REST BP + RET + +VBDCR: SETOM CHCTCF ;CR => SET FLAG FOR NEXT CHAR AND HANDLE IT WITH DISAD. + JRST VBDOUT + +VBDCTL: SKIPE DISSAI ;MOST CONTROL CHARS ARE NORMAL IN SAIL MODE, LOSING OTHERWISE. + JRST VBDNRM +VBDBS:: VBDLF:: +VBDLOS: CALL VBDSTO ;HERE FOR A CHAR THAT MUST BE HANDLED WITH DISAD. + JRST VBDSL1 ;WE KNOW THAT IN DOESN'T = PT, GPT, OR ZV, OR WE WOULN'T HAVE + ;GOT EVEN THIS FAR, SO IT'S SAFE TO GO STRAIGHT TO VBDSLO. + +VBDALT: MOVE TT1,TTYOPT + TLNN TT1,%TOSAI + MOVEI CH,"$ + JRST VBDNRM + +VBDTAB: MOVEI CH,40 ;OUTPUT SPACES + IDPB CH,CHCTBP + ROT CH,(A) ;UPDATING HASH CODE OF LINE + ADD E,CH + ADDI A,7 ;AND INCREMENTING THE HPOS + TRNE A,7 ;TILL WE REACH A TAB STOP. NOTE 7*HPOS IS A MULTIPLE OF 8 IFF HPOS IS. + CAMN A,TT ;THE END OF THE LINE COUNTS AS A TAB STOP. + CAIA + JRST VBDTAB + SUBI A,7 + JRST VBDTRT ;RE-ENTER NORMAL LOOP, EXIT IF REACHED OBSTACLE. + +VIEW2A: MOVE C,VSIZE + ADDI C,1 ;(IF C ODD, WANT LINE WITH PT CENTERED) + LSH C,-1 + SAVE FF + TRZ FF,FRCLN\FRUPRW + PUSHJ P,GETAG7 ;GET 1 + LAST CHAR ADR TO PRINT IN E + JFCL + MOVN C,VSIZE + CAMN IN,BEGV ;IF BUFFER NOT EMPTY, + JRST VIEW2B + SOS IN + CALL GETINC ;LOOK AT LAST CHAR, NOT CHANGING IN. + CAIE CH,^J ;IF NOT LF, IT COUNTS AS A LINE. + AOS C +VIEW2B: PUSHJ P,GETAG4 ;THEN MOVE 2*N BACKWARD FROM THERE, GET 1ST TO DISPLAY. + JFCL + MOVE A,E ;DISPLAY AS MUCH AS WILL FIT. + REST FF + RET + +SUBTTL SINGLE CHARACTER TERMINAL OUTPUT, BUFFERED + +;OUTPUT ROUTINES. OUTPUT CHAR IN CH AS DESCRIBED, CLOBBERING ONLY Q. + +;"DISPLAY" - OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD: MOVE Q,CHCTHP + MOVEM Q,RRCCHP + CAMN IN,DISADP ;IF THIS CHAR COMES AFTER POINTER, + CALL DISBAR ;OUTPUT CURSOR. + +;DON'T OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD2: SKIPN CASDIS ;IF IN -1F$ MODE + JRST CHCT + SAVE .-1 ;DO CASE-FLAGGING: ROUTINE FOR 1 CHAR IS CHCT. + +;CALL DISAD6 ? OUTPUT 1 CHAR ? POPJ P, ;TO OUTPUT A CASESHIFT IF NEC. +DISAD6: SKIPGE CASSFT ;DON'T TRY OUTPUTTING CASESHIFT + POPJ P, ;IF THERE ISN'T ANY. + CAME CH,CASSFT ;PUT CASE-SHIFTS BEFORE + CAMN CH,CASLOK ;CASE-SHIFTS AND CASE-:LOCKS. + JRST DISAD3 + CAILE CH,"Z+40 ;LOWER CASE SPECIAL CHARACTERS ALWAYS NEED CASESHIFTS. + CAIN CH,177 + CAIN CH,"@+40 + JRST DISAD3 + CAIL CH,"A+40 ;LOWER CASE LETTERS NEED THEM IS NORMAL CASE IS UPPER. + CAILE CH,"Z+40 + JRST DISAD4 + SKIPG CASNRM + RET + JRST DISAD3 ;PUT SLASHES BEFORE LOWER. + +DISAD4: SKIPL CASNRM ;IF NORMAL CASE IS LOWER, + RET + CAIL CH,"A ;PUT CASE-SHIFTS BEFORE UPPER CASE. + CAILE CH,"Z + RET +DISAD3: SAVE [DISAD5] ;CASESHIFT NEEDED; ARRANGE TO OUTPUT IT, + SAVE -1(P) ;THEN POPJ TO OUTPUT ORIGINAL CHAR. + HRLM CH,-2(P) + MOVE CH,CASSFT + POPJ P, ;PDL HAS 1-CHAR-RTN ? DISAD5 ? CHAR,,1-CHAR-RTN. + +;OUTPUT A CURSOR. +DISBAR: PUSH P,CH + SKIPE RREBEG + JRST DISBA1 + CALL RRDIS1 + SKIPE RGETTY + JRST POPCHJ +DISBA1: +INSIRP PUSH P,TT TT1 BP A B + MOVE CH,QRB.. ;GET ADDR OF CURSOR QREG + ADDI CH,.QCRSR + CALL QLGET + JRST DISBA2 ;NOT TEXT, NO CURSOR. + AOSN CHCTCF ;FORCE OUT ANY BUFFERED CR BEFORE THE CURSOR. + CALL CHCT5 + MOVE A,BP +DISBA3: SOJL B,DISBA2 ;LENGTH OF TEXT WAS IN B, + ILDB CH,A ;GET AND OUTPUT CHARS OF CURSOR. + CALL [ CAIN CH,^H + JRST DISBBS ;OUTPUT BS AS REAL BACKSPACE. + CAIL CH,40 ;OUTPUT CTL CHARS OTHER THAN ^H IN IMAGE MODE. + JRST CHCT + JRST CHCT4] + JRST DISBA3 + +DISBA2: INSIRP POP P,B A BP TT1 TT +POPCHJ: POP P,CH + POPJ P, + +;TTY AND DISPLAY ROUTINES. +;"TYPEOUT" - DON'T TYPE CURSOR, DO NOTICE CASDIS. +TYO: PUSHJ P,DISINT ;INIT. TYPEOUT. + JRST DISAD2 + +TYANOW: PUSHJ P,TYOA ;TYPEOUT, NO CURSOR, NO SLASH. + JRST DISFLS ;FORCE IT OUT IMMEDIATELY. + +TYOA: PUSHJ P,DISINT ;"TYPEOUT" + +;NO CURSOR, DON'T DO CASE FLAGGING. +CHCT: SKIPN ORESET + SKIPE MORFLF ;DON'T OUTPUT AFTER -FLUSHED. + POPJ P, + CAIN CH,^J + JRST CHCTLF ;LF => OUTPUT LINE. + AOSN CHCTCF ;ELSE FORCE OUT SAVED UP CR. + CALL CHCT5 + CAIN CH,177 + JRST CHCT0A ;RUBOUT COMES OUT AS ^? . + CAIL CH,40 ;NON-CTL CHARS. ONE POSITION. + JRST CHCT1A + CAIN CH,^I ;TAB => OUTPUT SEVERAL SPACES. + JRST CHCTTB + CAIN CH,^H + JRST CHCTBS + CAIN CH,^M ;REMEMBER A CR, NEXT CHAR WILL DECIDE. + JRST [SETOM CHCTCF ? POPJ P,] + CAIN CH,33 ;ALTMODE => OUTPUT. + JRST [ MOVE Q,TTYOPT + TLNN Q,%TOSAI ;ON TERMINALS WHICH CAN HANDLE ONE, SEND REAL ALTMODE. + MOVEI CH,"$ ;OTHERWISE SEND DOLLARSIGN. + CALL CHCT1A + JRST RET33] ;IN EITHER CASE DON'T CLOBBER CH. +CHCT0A: SKIPE DISSAI ;IN SAIL MODE, CTL CHARS OUTPUT AS THEMSELVES + JRST CHCT1A ;AND ASSUMED TO TAKE 1 POS. ON SCREEN. +CHCT0B: HRLM CH,(P) + MOVEI CH,"^ ;OTHER CTL CHARS => OUTPUT "^" + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + PUSHJ P,CHCT1A + HLRZ CH,(P) + XORI CH,100 ;AND UN-CTLED CHAR. + CALL CHCT1A +DISAD5: HLRZ CH,(P) + POPJ P, + +;OUTPUT AN ORDINARY PRINTING CHARACTER. +;WHEN A FULL LINE HAS BEEN ACCUMULATED, CALL @CHCTAD +;WITH HASH CODE IN CHCTHC, VERT. POS. IN CHCTVP, +;HORIZ. POS. AFTER LINE IN CHCTHP. +CHCT1A: MOVE Q,CHCTHP + CAMGE Q,NHLNS ;IF FILLED LINE, CONTINUE IT. + JRST CHCT2 + PUSH P,CH + SKIPGE DISTRN ;TRUNCATING MEANS IGNORING CHARS TILL NEXT CR. + JRST [ MOVEI CH,"! ;IF WE'VE JUST BEGUN TO TRUNCATE, + SKIPL CHCIGN ;PUT IN AN EXCL. + CALL CHCT4 + SETOM CHCIGN ;START IGNORING MOST CHARS. + JRST CHCT1B] + MOVEI CH,"! + CALL CHCT4 ;PUT A ! AT END OF LINE. + MOVEM IN,CHCTNL + SOS CHCTNL ;ADDR OF 1ST CHAR OF LINE AFTER THIS ONE. + SETZM CHCTCF + CALL CHCTL0 ;NOW DO A CRLF. +CHCT1B: POP P,CH +CHCT2: SKIPL CHCTHP + CALL CHCT4 ;OUTPUT THE CHAR IF NECESSARY, + AOS CHCTHP + RET + +;PUT THE CHAR IN CH INTO THE BUFFER AND THE HASH-CODE. +;IF THE BUFFER (<- CHCTBP) IS FULL, OUTPUT IT FIRST. +CHCT4: SKIPL CHCIGN + SKIPN CHCTBP + POPJ P, + SOSG DISBFC ;IF BUFFER FULL,FLUSH IT + JRST [ PUSH P,CH + SETOM CHCTNL + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + PUSHJ P,@CHCTAD + POP P,CH + JRST .+1] + IDPB CH,CHCTBP ;STORE CHAR IN CALLER'S BUFFER. + +;MERGE CHARACTER IN CH INTO THE HASH CODE FOR THIS LINE. +;THE HASHING DEPENDS ON THE HPOS. WE GET IT FROM CHCTHP. +CHCTH: HRLM CH,(P) + MOVE Q,CHCTHP + IMULI Q,7 + ROT CH,(Q) + ADDM CH,CHCTHC + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR INSERTION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHI: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR DELETION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHR: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + MOVNS CH + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +CHCTTB: MOVEI CH,40 ;TAB: OUTPUT A SPACE. + PUSHJ P,CHCT1A + MOVE CH,CHCTHP ;NOT AT TAB STOP => + SKIPN MORFLF ;GO OUTPUT ANOTHER UNLESS FLUSHED + TRNN CH,7 + JRST CHCTT1 + CAME CH,NHLNS + JRST CHCTTB +CHCTT1: MOVEI CH,11 + RET + +;INIT. FOR CHCT. +CHCTI0: SETZM CHCTCF ;NO PENDING ^M. + SETZM CHCOVP + SETZM CHCTHP + SETZM CHCIGN ;NOT BEYOND RIGHT MARGIN. +CHCTI1: AOS CHCTVP + SETZM CHCTHC ;INIT. ACCUMULATION OF HASH CODE. + POPJ P, + +CHCT5: PUSH P,CH ;FORCE OUT CR FOLLOWED BY OTHER THAN LF. + SKIPL DISPCR ;-1 => DO REAL CR. + JRST CHCT5A + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + SETZM CHCTHP ;REAL CR: ZERO HORIZ POSITION, + SETZM CHCIGN ;NO LONGER PAST RIGHT MARGIN. + MOVEI CH,^M ;NOW FORCE OUT THE BUFFER, AND, + CALL CHCTIM ;ON PRINTING TTY, OUTPUT A REAL CR. + JRST POPCHJ + +CHCT5A: MOVEI CH,"^ ;SHOULDN'T OVERPRINT, PRINT AS ^M. + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + CALL CHCT1A + MOVEI CH,"M + CALL CHCT1A + MOVE CH,CHCTHP ;IF WE CONTINUE THE LINE RIGHT AFTER THE ^M, WE SHOULD REALIZE + MOVEM CH,RRCCHP ;THAT THE NEXT CHAR STARTS IN COLUMN 0 OF NEXT LINE, NOT COLUMN -2! + JRST POPCHJ + +CHCTBS: SKIPL DISPBS ;DISPBS < 0 => PRINT AS BS. + JRST CHCT0A +DISBBS: SKIPN CHCTHP ;CAN'T DO ANYTHING AT LEFT MARGIN. + JRST CHCT0A ;^H AT COLUMN 0 => TYPE ^H. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SOS CHCTHP + MOVEI CH,^H ;IF WE'RE REALLY PRINTING, OUTPUT REAL ^H. +CHCTIM: SAVE CH + SETOM CHCTNL + SETOM DISFLF + CALL @CHCTAD ;SEND WHAT WE HAVE SO FAR. + SETZM DISFLF + REST CH +CHCTI9: SAVE CH + MOVE CH,CHCTAD + CAIE CH,DISLIN ;DON'T SEND THE ^H OR ^M IF WE'RE NOT REALLY TYPING. + JRST POPCHJ + MOVE CH,CHCTVP ;NO NEED TO SEND CR NOW IF WILL MOVE DOWN ANYWAY, + CAME CH,DISVP ;SINCE IN THAT CASE THE CURSOR MOTION WILL BE DONE BEFORE NEXT LINE. + JRST POPCHJ + REST CH + SETOM CHCOVP ;INDICATE DOING OVERPRINTING: NEXT DISLIN MUSTN'T %TDMV1 (IMLAX LOSE). + JRST TYOINV + +;COME HERE TO OUTPUT A LF. CALLED BY THE ROUTINE TO OUTPUT STRAY CR. +;CLOBBERS ONLY Q. LEAVES A ^J IN CH. +CHCTLF: MOVEM IN,CHCTNL + AOSE CHCTCF ;IF HAVE UNPROCESSED CR, OUTPUT IT. + JRST [ SKIPL DISPCR ;NO CR; WHAT DO WE DO FOR STRAY LF? + JRST CHCT0B ;MAYBE OUTPUT AS ^ AND J. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + JRST CHCTL1] + SETZM RRCCHP +CHCTL0: SETZM CHCIGN ;STOP IGNORING CHARS IF HAD TRUNCATED LINE. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SETZM CHCTHP ;REFLECT IT IN HORIZ. POS. +CHCTL1: PUSHJ P,@CHCTAD ;LF ENDS LINE, TELL CALLER ABOUT IT. + MOVEI CH,^M ;ON NON-DISPLAY, MUST ACTUALLY DO THE CR IF WANTED. + SKIPN CHCTCF + SKIPE RGETTY + CAIA + CALL CHCTI9 + PUSHJ P,CHCTI1 ;INIT NEW LINE. + SKIPL CH,CHCTNL + MOVEM CH,CHCTBL +CHCTL4: SKIPG CH,CHCTHP + JRST CHCTL3 + MOVE Q,CHCTHC ;PUT SPACES IN HASH CODE. +CHCTL2: ROT Q,7 ;FOR THE INDENT IN LINE WE'RE STARTING WITH. + ADDI Q,40 + SOJG CH,CHCTL2 + MOVEM Q,CHCTHC +CHCTL3: MOVEI CH,^J + POPJ P, + +SUBTTL SEND THE TERMINAL OUTPUT BUFFER + +;CALL HERE TO FORCE OUT BUFFERED OUTPUT. +;CALL AFTER EACH TECO COMMAND THAT DOES OUTPUT. +DISFLS: AOSN CHCTCF ;FORCE OUT ANY UNPROCESSED CR. + CALL CHCT5 ;THIS CAN BE A SCREW IF BETWEEN THAT CR AND A LF! + SETOM CHCTNL + SETOM DISFLF ;FORCE DISLIN TO MOVE CURSOR + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + PUSHJ P,DISLIN ;.IOT IT. + SETZM DISFLF + POPJ P, + +;OUTPUT THE BUFFER. +DISLIN: SKIPE TSALTC ;IF A CMD STRING IS WAITING TO BE READ, + SETOM MORFLF ;GIVE UP TYPEING OUT. + SKIPN ORESET + SKIPE MORFLF + JRST DISRST + SAVE T + SAVE BP +DISLI7: SKIPN BP,CHCTVP ;IF ABOUT TO WRITE ON TOP LINE + JRST [ SKIPN TRCOUT ;BECAUSE OF TRACE MODE, + JRST .+1 + DISSTR / +/ + CALL DISIOT ;CLEAR 1ST LINE AND USE SECOND INSTEAD. + AOS BP,CHCTVP + SETZM HCDS + JRST .+1] + MOVE CH,CHCTHC +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;INITIALLY ASSUME NO POSITIONING NEEDED + MOVEM Q,DISBF1+1 +] +IFN TNX,[ + SETZM DISBF1 ;CLEAR OUT CURSOR POSITIONING + MOVE Q,[DISBF1,,DISBF1+1] + BLT Q,DISBF1+5 +] + SKIPN RGETTY + JRST DISLI0 ;ON PRINTING TTY, NO OLD LINE REMAINS ON SCREEN. + CAML BP,CHCTVS ;IF WE'RE WITHIN THE SCREEN AREA, + JRST DISLN5 + SKIPN RREBEG + SKIPGE CHCTNL ;IN ^R, IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLI8 ;COMPUTE THE LINBEG WORD FOR THE LINE THAT WILL FOLLOW THIS ONE: + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SKIPG Q,RRIDLB ;IF CAN INSERT/DELETE, SEE IF THAT TEXT IS PRESENT ON THE SCREEN + JRST DISLI8 + CAMN Q,T + JRST DISLI9 ;AND IF SO, MOVE IT TO THE LINE AFTER THIS ONE. + CAML T,Q ;IF WE HAVE ALREADY HACKED RRIDLB AND PASSED IT, DO NOTHING NOW. + JRST DISLI8 + SUB Q,RRIDBK ;ELSE MAYBE WE HAVE REACHED THE BLANK LINES PRECEDING RRIDLB. + SUB Q,RRIDBK + CAMG T,Q + JRST DISLI8 + SUB T,Q ;IF SO, FIGURE OUT FROM RRIDBK HOW MANY BLANK LINES REMAIN + ASH T,-1 ;TO BE PRINTED, AND FROM THAT, WHAT VPOS TO COPY RRIDLB TO. + SUB T,RRIDBK ;BUT THERE IS A FUNNY WAY TO TELL DSLID THAT. + ADDM T,RRIDVP +DISLI9: CALL DSLID + SETOM RRIDLB + MOVE BP,CHCTVP +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;DSLID CLOBBERS DISBF1! + MOVEM Q,DISBF1+1 +] +DISLI8: AOSG CHCOVP + JRST DISLI1 + AOSG ERRFL1 ;IF ERRFL1 (FS ERRFLG$) IS <0, IT IS - # LINE OF ERROR MSGS ON SCREEN, + JRST DISLI3 ;SO COUNT OFF THAT MANY LINES BEFORE OUTPUTTING. + CAMN CH,HCDS(BP) ;OUTPUT ONLY IF HASH CODE DIFFERS, + SKIPE DISFLF ;OR IF INSIST ON OUTPUTTING + JRST DISLI4 + JRST DISLI3 + +DISLN5: MOVEM BP,DISVP ;WE'RE AT BOTTOM OF SCREEN; MUST OUTPUT, SO THAT + MOVEM BP,DISVP1 ;WE WILL CALL DISMOR IF NECESSARY, BUT ARRANGE NOT TO CLEAR +DISLI4: +IFN ITS,[ + DPB BP,[DISCPV] ;PREPARE TO SET VERT. POS. + DPB BP,[DISC1V] + MOVE Q,DISCM1 ;IF SAME LINE AS BEFORE, JUST MOVE CURSOR; DON'T CLEAR. + MOVEM Q,DISBF1+1 + CAMN BP,DISVP + JRST DISLN3 + MOVE Q,DISCMV + LDB T,[DISCPH] + JUMPN T,[ ;IF NOT STARTING IN COL 0, MUST GO TO COL 0, CLEAR, THEN SET CURSOR. + MOVEM Q,DISBF1 + JRST DISLN3] + MOVEM Q,DISBF1+1 ;IF STARTING IN COL 0, JUST GO TO COL 0 AND CLEAR. + JUMPE BP,DISLN3 + MOVEI T,-1(BP) ;IF MOVING DOWN 1 LINE, AND GOING TO COL 0, DO IT WITH A %TDCRL. + MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDCRL] + CAMN T,DISVP1 + MOVEM Q,DISBF1+1 +DISLN3: +] +IFN TNX,[ + MOVEI Q,DISMOV ;ASSUME CLEAR TOO + CAMN BP,DISVP + MOVEI Q,DISMV1 ;DONT NEED TO + CALL (Q) ;SET UP DISBF1 RIGHT +] + MOVEM BP,DISVP1 ;REMEMBER WHAT LINE THE CURSOR IS ON. + JRST DISLI1 ;GO OUTPUT POSITIONING & LINE. + +DISLI0: SKIPL DISVP ;ON PRINTING TTY, + CAMN BP,DISVP ;IF NOT SAME LINE AS BEFORE, LINEFEED. + JRST DISLI1 +IFN ITS,[HRROI Q,[ASCIC/ +/] + CALL DISIOT +] +IFN TNX,CALL ECHLF2 +DISLI1: SKIPGE Q,CHCTBP ;GET THE STUFFING B.P. AND MAKE NORMALIZE IT + SUB Q,[400000,,1] ;BY CONVERTING 441000,,FOO TO 041000,,FOO-1 + CAMG BP,CHCTVS ;IF BELOW END OF SCREEN, OR + CAME Q,[041000,,DISBUF-1] ;IF NON-NULL LINE AT END OF SCREEN, + CAMGE BP,CHCTVS + JRST DISLN4 + JRST DISMOR ;GO PRINT --MORE--, COME BACK. + +DISLN4: CAMGE BP,CHCTVS ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE. STORE NEW HASHCODE. + SKIPN RGETTY + CAIA + MOVEM CH,HCDS(BP) + SETZ T, ;COUNT THE NUMBER OF UNUSED BYTES IN THE LAST WORD +DISLI2: TLNE Q,700000 ;OF THE OUTPUT BUFFER. + AOJA T,[IBP Q ? JRST DISLI2] + MOVEI Q,1-DISBF1(Q) + LSH Q,2 + SUBM Q,T ;# OF CHARS TO BE OUTPUT. + CALL DISSIOT ;OUTPUT THAT MANY CHARS STARTING AT DISBF1 +DISLI3: MOVEM BP,DISVP ;INDICATE WHERE WE HAVE PUT THE CURSOR. + MOVEI T,1(BP) + SKIPE RGETTY ;ON A DISPLAY, CONSIDER STOPPING OUTPUT BECAUSE OF INPUT AVAIL. + CAML T,CHCTVS ;AVOID BOUNDARY LOSSAGE: DON'T STOP ON --MORE-- LINE + JRST DISLN1 ;OR THE LINE BEFORE IT (WOULD SET --MORE-- LINE'S LINBEG). + SKIPN RREBEG + SKIPGE CHCTNL ;IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLN1 +;SET UP LINBEG WORD FOR LINE AFTER THIS ONE, IN CASE WE DECIDE TO STOP DISPLAYING NOW. +;IF WE DO, THE LINBEG WORD FOR THE NEXT LINE IS NECESSARY FOR STARTING UP AGAIN. + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SETZM DISFLF ;IN CASE WE EXIT, MAKE SURE DISFLF DOESN'T STAY SET. + MOVE Q,CHCTNL + CAMLE Q,RRMAXP ;IF NEXT LINE STARTS PAST THE END OF ALL CHANGES, + SKIPE RRMSNG ;AND ALL UNCHANGED LINES ARE PROPERLY ON THE SCREEN, + JRST DISLN2 + MOVE Q,LINBEG+1(BP) + ADD Q,Z ;AND WE ARE ABOUT TO DISPLAY THE SAME CHARACTERS THAT ARE ON THE LINE + SUB Q,RROLDZ ;ALREADY (TAKING INTO ACCOUNT INSERTIONS AND DELETIONS SINCE + CAMN T,Q ;OLD LINBEG WAS STORED), THEN WE NEED NOT REALLY REDISPLAY. + JRST RRDISF ;SO STOP DISPLAYING AND RETURN TO ^R. +DISLN2: AOS BP + MOVEM T,LINBEG(BP) + MOVEM BP,RRMNVP ;IF THERE IS INPUT, STOP DISPLAYING; LATER START FROM NEXT LINE. + SETZM RRMNHP ;THUS MAKE SURE REDISPLAY STARTS THIS FAR UP AT LEAST. + SKIPE DFORCE + JRST DISLN6 ;FS DFORCE$ MEANS FINISH DISPLAY EVEN IF INPUT IS WAITING. +IFN ITS,[ + SKIPE DWAIT ;FOR VERY SLOW TTYS, WAIT BETWEEN LINES SO WE STOP DISPLAYING FAST + .LISTEN T, ;WHEN THERE IS TYPE-IN. + .STATUS CHTTYI,T ;ARE CHARS AVAILABLE FOR ^R TO PROCESS? + ANDI T,2000 ;IF SO, STOP DISPLAYING AND PROCESS THEM. +] +IFN TNX,[ + SAVE A + SAVE B + MOVEI A,.CTTRM + SKIPE DWAIT ;DO DOBE ONLY IF SLOW TERMINAL + DOBE ;(DONT USE LISTEN MACRO) + SIBE ;ANY CHARACTERS FOR ^R TO PROCESS? + TDZA T,T ;YES + SETO T, ;NO + REST B + REST A +] +DISLN6: JUMPE T,[SKIPE LID ;IF DOING INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP + JRST [ SETOM RRMSNG ;SINCE THE LATTER WOULD SCREW IF THIS NEW INPUT WANTS + JRST RRDISX] ;TO INSERT OR DELETE LINES. + MOVE T,CHCTNL ;MAKE SURE NEXT REDISPLAY DOESN'T + CAMLE T,RRMAXP ;STOP BEFORE REACHING THIS FAR DOWN. + MOVEM T,RRMAXP ;WITHOUT THIS, + JRST RRDISX] ;LOSES IF TYPED QUICKLY. +DISLN1: REST BP + REST T +DISLI6: MOVE Q,CHCTHP ;REMEMBER STARTING HORIZ POS. OF NEXT LINE. +IFN ITS,DPB Q,[DISCPH] +IFN TNX,MOVEM Q,DISCPH +DISRST: MOVE Q,[441000,,DISBUF] + MOVEM Q,CHCTBP ;RE-INIT BUFFERING. + MOVEI Q,4*DISBFC-6 + MOVEM Q,DISBFC + POPJ P, + +;HERE IN REDISPLAY ON TERMINALS WITH INSERT/DELETE LINE +;WHEN WHAT'S LEFT ON THE SCREEN BELOW CURSOR IS VALUABLE, IF MOVED TO THE RIGHT PLACE. +;WE MOVE IT THERE AND THEN RESUME DISPLAYING. +;BP HAS VPOS OF LINE ABOUT TO BE OUTPUT, WHEN CALLED FROM DISLIN. +;THIS MEANS THAT FOR UPWARD MOTION WE MOVE THINGS UP TO LINES STARTING FROM 1(BP), +;WHEREAS FOR DOWNWARD MOTION WE MOVE DOWN FROM LINES STARTING FROM (BP). +;THE DISTANCE THAT LINES MOVE ACROSS IS (RRIDVP)-(BP)-1 IN EITHER CASE. +;OTHER CALLERS MUST ARRANGE BP AND RRIDVP ACCORDINGLY. +;WE CLOBBER ONLY Q. +DSLID: MOVE Q,RRIDVP ;GET OLD POSITION OF TEXT WE WANT TO MOVE UP OR DOWN. + SUBI Q,1(BP) ;Q GETS # LINES TO MOVE IT UP (OR - # TO MOVE IT DOWN). +;Q=0 IS A SPECIAL CASE- NO MOTION OF THE STUFF ON THE SCREEN IS NECESSARY! + JUMPE Q,CPOPJ ;THE NON-INSERT-DELETE MECHANISMS FOR RROLDZ WILL WIN IN THIS CASE. +IFN ITS,[SAVE 0 ;PUSH THE CURRENT CURSOR POS SO WE CAN AVOID CHANGING IT. + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,(P)] + .LOSE %LSFIL +] +.ELSE SAVE TTLPOS + SAVE Q + SAVE BP + JUMPL Q,DSLIDD +;WE WANT TO MOVE STUFF UP. + AOS BP + ADD BP,-1(P) ;CHECK FOR SCREW CASE THAT THERE REALLY AREN'T ANY USEFUL LINES + CAML BP,BOTLIN ;LEFT TO MOVE UP. IF WE DIDN'T CHECK, DSLID5 WOULD CLOBBER LOW CORE. + JRST DSLID4 + SUB BP,-1(P) + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE OF SCREEN? + JRST [CALL SCRLUP ;YES, SCROLL Q LINES UP THEN + JRST DSLID8] + CALL DELLIN ;DELETE THAT MANY LINES BELOW WHERE CURSOR IS NOW. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,-1(P) ;NOW GO THAT MANY LINES ABOVE MODE LINE (TO WHERE TEXT OF MODE LINE IS) + CALL INSLIN ;AND INSERT EMPTY LINES TO PUSH MODE LINE BACK TO RIGHT PLACE. +DSLID8: MOVE Q,(P) + AOS BP,Q ;Q GETS NEW VPOS OF UPPERMOST LINE MOVED UP. + ADD BP,-1(P) ;BP GETS THE VPOS IT CAME FROM. + SAVE A +DSLID5: MOVE A,LINBEG(BP) ;COPY UP THE LINBEGS FOR THE LINES MOVED UP. + MOVEM A,LINBEG(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + AOS BP + AOS Q + CAMGE BP,BOTLIN ;STOP WHEN BP POINTS AT THE WINDOW END, WHICH WASN'T MOVED UP. + JRST DSLID5 + REST A +DSLID6: SETZM HCDS(Q) ;ZERO THE HASH CODES FOR THE INSERTED BLANK LINES. + AOS Q + CAMGE Q,BOTLIN + JRST DSLID6 + SETOM RRMSNG ;NOW, WE MUST THINK ABOUT DISPLAYING ALL THE WAY TO END OF WINDOW, + ;SO THAT WE WILL FILL THOSE BLANK LINES WITH WHAT BELONGS THERE. +DSLID3: MOVE BP,-2(P) ;NOW RESTORE CURSOR TO POSITION IT HAD ON ENTRY TO DSLID. + CALL SETCUR +DSLID4: REST BP ;SO THAT WE FILL IN THOSE BLANK LINES. + REST Q + JRST POP1J + +;HERE TO MOVE TEXT DOWNWARD. +DSLIDD: MOVMS -1(P) ;GET POSITIVE # OF LINES TO MOVE DOWN. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,BP + SOS Q + CAMG Q,(P) ;DETECT FUNNY CASE WHERE THE NUMBER OF LINES LEFT IS LESS THAN + JRST DSLID4 ;THE DISTANCE DOWN WE MUST MOVE THEM. GIVE UP IN THAT CASE. + MOVE Q,-1(P) + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE? + JRST [MOVE BP,(P) ;YES, GET TOP LINE AGAIN + CALL SCRLDN ;SCROLL Q LINES DOWN + JRST DSLID9] + CALL DELLIN ;FIRST, DELETE SOME LINES JUST ABOVE THE MODE LINE. + MOVE BP,(P) + MOVE Q,-1(P) + CALL INSLIN ;THEN, INSERT THE SAME NUMBER JUST BELOW THIS LINE. +DSLID9: MOVE Q,BOTLIN + SOS Q + MOVE BP,Q + SUB BP,-1(P) + SAVE A + SAVE LINBEG+1(BP) ;REMEMBER LINBEG OF FIRST LINE THAT MOVES OFF SCREEN BOTTOM. +DSLID1: MOVE A,LINBEG(BP) ;COPY DOWN THE LINBEGS FOR THE LINES MOVED DOWN. + MOVEM A,LINBEG(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + SOS BP + SOS Q + CAML BP,-2(P) ;STOP AFTER MOVING THE HIGHEST LINE TO BE MOVED. + JRST DSLID1 +DSLID7: MOVE A,LINBEG+1(BP) ;FILL THE LINBEGS OF THE NEWLY CREATED BLANK LINES WITH + MOVEM A,LINBEG(Q) ;SOMETHING MEANINGFUL: THE LINBEG OF THE FIRST FOLLOWING LINE. + SETZM HCDS(Q) ;CLEAR THE HASHCODES OF THE NEWLY MADE BLANK LINES. + CAIE Q,1(BP) + SOJA Q,DSLID7 + REST A ;GET BACK LINBEG OF LINE MOVED OFF BOTTOM OF SCREEN. + SKIPN DFORCE ;DFORCE => MODE LINE SHOULD NOT BE UPDATED BY THIS REDISPLAY. + SKIPE RRMSNG ;IF RRMSNG IS SET THEN THE LINBEGS AREN'T EVEN VALID FOR + JRST DSLID2 ;WHAT FOLLOWS, BUT SOMEONE ELSE WILL HANDLE IT. + SKIPN RRMORF + CAMN A,RROLZV ;IF THERE WAS DISPLAYED TEXT ON THAT LINE, + JRST DSLID2 + MOVE A,MORESW ;THEN THE MODE LINE SHOULD SAY --MIDDLE-- OR --TOP-- NOW. + TRON A,MS%DWN ;IF IT ISN'T ALREADY RIGHT, + SETZM DISOMD ;MAKE SURE THAT IT WILL BE REDISPLAYED + MOVEM A,MORESW ;SAYING THE RIGHT THING. + TRNN A,MS%UP ;THIS INCLUDES FIGURING OUT THE % ABOVE SCREEN + JRST DSLID2 + CALL DISMO6 ;IF STUFF WAS OFF THE TOP ALREADY AND NOW ALSO OFF THE BOTTOM. + HRLM A,MORESW +DSLID2: REST A + JRST DSLID3 + +SUBTTL HANDLE BOTTOM-OF-SCREEN CONDITION + +;PRINT --MORE--, GO BACK TO DISLI3 IF FLUSHED, ELSE TO DISLI7. +;IN ^R MODE, EXIT RESTORING P FROM DISPRR. +DISMOR: SKIPGE ERRFLG + JRST DISLN1 + SKIPN RREBEG + JRST [ MOVE P,DISPRR ;IN ^R MODE: WE WANT TO POP BACK TO ^R PDL LEVEL. + SKIPN RGETTY ;^R MODE ON PRINTING TTY: WE'RE ALREADY IN POSITION. + RET + MOVEI T,MS%DWN ;^R ON DISPLAY: CHOOSE AMONG --TOP--, --MIDDLE-- + SKIPE GEA + TRO T,MS%UP + SKIPE RRMORF ;AND --MORE-- IF FS ^R MORE IS > 0. + MOVEI T,MS%MOR + SKIPGE RRMORF ;USE NONE AT ALL IF FS ^R MORE IS < 0. + SETZ T, + SETZ A, + TRNE T,MS%UP ;IF NOT SAYING --MORE-- AND HAVE TEXT ABOVE AND BELOW SCREEN, + CALL DISMO6 ;COMPUTE FRACTION OF TEXT ABOVE + HRLM A,T ;AND INCLUDE THAT IN THE MODE LINE. + JRST DISMD] ;UPDATE --MORE-- LINE AND RETURN TO ^R. + SKIPN RGETTY + JRST DISMO3 ;ON PRINTING TTY, JUST ASSUME FLUSHED. + MOVEI T,8 ;ON DISPLAY, MUST DO THE POSITIONING THAT DISLIN DIDN'T DO. + CAMG BP,USZ + CALL DISSIOT + SKIPN ORESET + SKIPE MORFLF + JRST DISLI3 ;ALREADY FLUSHED. + SETZM MORESW + MOVEI T,MS%MOR ;REDISPLAY --MORE-- LINE AND PUT --MORE-- ON IT. + CALL DISMD + SKIPGE CTLCF ;^C IMPLIES FLUSH IT. + JRST DISMO2 + TTYACT +IFN TNX,[SAVE ECHOF2 + SETZM ECHOF2] ;DONT ECHO IT NOW + PUSHJ P,TYINH +IFN TNX,REST ECHOF2 + CAIN CH,40 ;READ A SPACE => + JRST [ PUSHJ P,DISTOP ;TOP OF SCREEN, THEN TRY AGAIN. + SKIPL VREMEM ;IF DISPLAYING STUFF THAT'S IN BUFFER, + JRST DISLI7 + MOVE Q,CHCTBL ;REMEMBER WHERE THIS SCREENFULL STARTED, + SUB Q,BEGV ;NEXT BUFFER DISPLAY WILL TRY TO START AT SAME PLACE. + MOVEM Q,GEA + JRST DISLI7] + CAIE CH,177 ;ELSE RE-READ UNLESS RUBOUT. + MOVEM CH,UNRCHC + HRRZM P,MORFLF + CAIE CH,177 ;SET MORFLF (FS FLUSHED$) TO NONZERO, POSITIVE IFF RUBOUT. +DISMO2: SETOM MORFLF + DISSTR /-FLUSHED/ + PUSHJ P,DISIOT ;PUT FLUSHED ON THE --MORE-- LINE + MOVEI T,MS%FLS + MOVEM T,MORESW ;AND REMEMBER THAT THAT IS WHAT'S THERE. +IFN TNX,[SKIPE ECHOF2 + CALL ECHOCH] ;ECHO IT NOW + JRST DISLI3 + +DISMO3: SETOM MORFLF + JRST DISLI3 + +;A GETS PERCENT OF BUFFER ABOVE START OF WINDOW. +DISMO6: SAVE B + MOVE A,GEA + ADD A,BEGV + SUB A,BEG ;GET WINDOW START REL. TO BEG. + MOVE B,Z + SUB B,BEG ;GET Z REL. TO BEG. + IMULI A,100. + IDIV A,B ;A GETS WINDOW AS PERCENT OF Z. +POPBJ: REST B + RET + +SUBTTL INITIALIZE DISPLAY OUTPUT + +;INIT FOR DISPLAY OUTPUT. +DISINI: SETOM TYOFLG ;"TYPEOUT" NO LONGER INITTED. + SETOM ECHCHR ;IF ^R COMMAND DOES DISPLAYING IT SHOULDN'T BE ECHOED ON PRINTING TTY. + MOVE Q,QRB.. + SETOM .QVWFL(Q) +DISIN0: SETZM VREMEM +DISTO1: PUSHJ P,CHCTI0 ;INIT FOR CHCT. + MOVEI Q,DISLIN ;TELL IT TO CALL DISLIN EACH LINE. + MOVEM Q,CHCTAD + PUSHJ P,DISLI6 ;INIT. BUFFERING. + +;MOVE TO TOP OF SCREEN. +DISTOP: AOSN PJATY + JRST [ CALL CTLL1 + JRST DISTO1 ] ;REINIT IN CASE FS REDISPLAY$ DID SOME TYPEOUT. + SETZM MORFLF ;UNDO A FLUSHED. + SETZM OLDFLF + SETOM DISVP + SETZM DISVP1 + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPN RGETTY + JRST [ SETZM TOPLIN + SKIPE RUBENC ;ON PRINTING TTY, NORMALLY ADVANCE TO CLEAN LINE, + JRST RUBEND ;BUT DO SOMETHING SPECIAL IF WAS PREARRANGED. + JRST CRIF] + SAVE C + MOVE C,NLINES ;SET UP WINDOW SIZE FROM USER-SETTABLE FLAGS (LINES AND TOPLINE). + CALL WINSET + REST C + MOVE Q,TOPLIN + MOVEM Q,CHCTVP + MOVE Q,BOTLIN + SKIPN RGETTY + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPGE ERRFL1 + RET + JRST HOMCUR ;BRING CURSOR TO TOP LEFT. + +;START "TYPEOUT" AT TOP OF SCREEN. +DISTOT: SETOM TYOFLG ;FORCE RE-INIT. + +;INIT FOR TYPEOUT, PREVENT BUFFER DISPLAY. +;ALL TYPEOUT ROUTINES MUST COME HERE. +DISINT: MOVE Q,QRB.. + SETOM .QVWFL(Q) + SETOM ECHCHR ;IF ^R COMMAND DOES TYPEOUT IT SHOULDN'T BE ECHOED ON PRINTING TTY. + AOSN TYOFLG ;IF NO PREVIOUS TYPEOUT, + JRST DISIN0 + SKIPE RUBENC + CALL RUBEND + RET + +CTLL: SKIPLE CLRMOD ;SCREEN-CLEARING MAY BE DISABLED. + RET + MOVE Q,QRB.. + SETZM .QVWFL(Q) ;ALLOW BUFFER DISPLAY. + SETOM TYOFLG ;NEXT TYPEOUT WILL START AT TOP OF SCREEN. + SETOM GEA ;ALLOW NEW TEXT WINDOW TO BE CHOSEN. + SETZM MORFLF ;FLUSHING A --MORE-- DOESN'T LAST PAST CLEARING THE SCREEN. + SETZM OLDFLF + SKIPGE PJATY + JRST CTLL1 + SKIPE RGETTY + SKIPN NLINES ;IF NOT USING WHOLE SCREEN FOR WINDOW NOW, + SKIPE TOPLIN ;CLEAR JUST WHAT'S IN THE WINDOW. + JRST CTLL2 + +;HERE TO DO A REAL CLEAR-SCREEN. +CTLL1: SETZM PJATY ;HERE TO CLEAR WHOLE SCREEN. + SETZM MORESW ;BE AWARE THAT --MORE-- IS BEING ERASED. + SETZM ECHACT ;ECHO AREA IS NOW CLEAR. + CALL CLRSCN + SETOM RROVPO ;SHOW RRTTY THAT IT NEEDN'T ECHO THE COMMAND. + SETOM DISOMD ;REDISPLAY THE "MODE" ON THE --MORE-- LINE. + SETZM HCDS ;SET HASH CODES TO 0 + MOVE Q,[HCDS,,HCDS+1] + BLT Q,HCDSE-1 ;SINCE 0 IS CODE FOR A NULL LINE + SKIPN REFRSH ;IF USER HAS A REFRESH ROUTINE, RUN IT. + RET + CALL SAVACS ;SAVING ALL ACS, AND DOING A (-) AROUND IT. + MOVE A,REFRSH + CALL MACXCP + JRST RSTACS + +CTLL2: SKIPE RGETTY ;ON DISPLAYS, EFFECTIVELY CLEAR ECHO AREA WITH A CR. + CALL ECHOCR + CALL DISINI ;CLEAR WINDOW AREA BY DOING A "BUFFER DISPLAY" OF NO CHARACTERS. + CALL DISCLR ;NOW "REST OF SCREEN", MEANING ALL OF WINDOW. + MOVE Q,QRB.. + SETZM .QVWFLA(Q) + RET + +;"CLOSE" A BUNCH OF DISPLAY OUTPUT - CLEAR LINES FROM CURSOR TO END OF WINDOW. +DISCLG: CAME IN,PT + JRST DISCL3 + SKIPN RREBEG + CALL RRDIS1 +DISCL3: SETZM VREMEM + SETOM TYOFLG ;FORCE NEXT TYPEOUT TO CALL DISINT + CALL DISFLS ;FORCE OUT ANY INCOMPLETE LINE. + SKIPN ORESET + SKIPE MORFLF ;IF WE WERE FLUSHED AT A --MORE--, JUST UN-FLUSH. + RET + SKIPN RGETTY ;ELSE, ON DISPLAY TTY, CLEAR REST OF SCREEN + RET + AOS CHCTVP + CALL DISCLR ;CLEAR OUT REST OF LINES IN DISPLAY AREA. +;MAKE SURE THE --MORE-- LINE DOESN'T SAY "--MORE--", AND HAS THE +;CORRECT MODE DISPLAYED ON IT. +DISCLJ: MOVEI T,MS%UP + SKIPE GEA ;FIGURE OUT WHETHER WE WANT AN EMPTY --MORE-- FIELD, OR A --BOT--. + SKIPE RREBEG + SETZ T, + SKIPE RRMORF + SETZ T, + JRST DISMD ;AND UPDATE THE --MORE-- LINE IF IT ISN'T WHAT WE WANT. + +;CLEAR LINES FROM CHCTVP DOWN TO END OF DISPLAY AREA. +DISCLR: MOVE BP,CHCTVP + CAML BP,CHCTVS ;STOP CLEARING AT END OF WINDOW, OR END OF SCREEN. + RET + MOVEM IN,LINBEG(BP) ;ABOUT TO CLEAR A LINE: SET ITS LINBEG TO END OF BUFFER. + SKIPN HCDS(BP) ;LINE ALREADY CLEAR => DON'T CLEAR IT. + JRST DISCL1 + SETZM HCDS(BP) ;CLEAR A LINE BY CLEARING THE HASH CODE, + HRLZS BP ;MOVING TO THE LINE + CALL SETCU1 + CALL CLREOL ;AND CLEARING VIA THE SYSTEM. +DISCL1: AOS CHCTVP + JRST DISCLR + +;,FS TYO HASH$ SETS HASH CODE OF LINE. +FSHCD: TRZN FF,FRARG + TYPRE [AOR] + MOVE E,SARG + SKIPL C ;REQUIRE VPOS TO BE IN RANGE. + CAML C,USZ + TYPRE [AOR] + MOVE A,HCDS(C) + TRZE FF,FRARG2 + MOVEM E,HCDS(C) + JRST POPJ1 + +SUBTTL MODE LINE DISPLAY + +FRCMD: TRZE FF,FRCLN + JRST CLRMOR ;:FR => CLEAR THE MORE LINE ENTIRELY. + SKIPN RGETTY ;FR => ON PRINTING TTY, MAYBE TYPE OUT THE MODE. + JRST DISMDP ;FOR IMPLICIT FR'S SUCH AS FI AND ^R, WE NEVER DO THAT. +;REDISPLAY THE MODE LINE AND RETURN CURSOR TO WHERE IT IS, +;PROVIDED THERE IS NO INPUT AVAILABLE. +DISMDI: MOVE Q,$QMODE ;UPDATE MODE DISPLAY IF IT IS NECESSARY + SKIPN RGETTY ;ON PRINTING TTY, WE DISPLAY IT DIFFERENTLY. + RET + MOVE T,PFINI + SUB T,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES T + CAMG T,MODCHG ;IF FS MODE CHANGE$ LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF FS MODE CHANGE$ IS POS, WE MUST RUN FS MODE MAC$ + JRST .+3 + CAMN Q,DISOMD + RET + SKIPN TYISRC + SKIPL UNRCHC + RET + LISTEN Q, + JUMPN Q,CPOPJ ;DON'T UPDATE MODE LINE IF INPUT AVAILABLE. + MOVE T,MORESW ;DON'T CHANGE THE --MORE-- OR WHATEVER, + CAIN T,MS%FLS ;EXCEPT GET RID OF A "FLUSHED". + MOVEI T,MS%MOR +IFN ITS,[ + HRROI Q,[ASCIC/S/] ;AVOID CLOBBERING CURSOR POSITION. + CALL DISIOT + CALL DISMD ;NO INPUT: DISPLAY THE NEW "MODE" + HRROI Q,[ASCIC/R/] + JRST DISIOT +] +IFN TNX,[ + SAVE B + MOVE B,TTLPOS ;MOVE CURSOR BACK WHERE IT WAS BEFORE + CALL DISMD + JRST SETCU3 +] + +DISMDP: SKIPN SHOMOD ;ONLY DISPLAY MODE ON PRINTING TTY IF FS SHOWMODE$ IS SET. + RET + MOVEM Q,DISOMD ;AND THEN ALWAYS SHOW IT EVEN IF HAVE INPUT. + CALL CRIF ;GET FRESH LINE + CALL DISMD2 ;TYPE OUT MODE + JRST CRIF ;AND ANOTHER NEW LINE + +;UPDATE, IF NECESSARY, THE "MODE" DISPLAYED ON THE --MORE-- LINE. +;THE "MODE" IS A TEXT STRING STORED IN Q..J. THE CONTENTS OF THAT QREG ARE +;ALWAYS VISIBLE ON THE --MORE-- LINE. THE IDEA IS FOR THE USER TO BE +;ABLE TO TELL IMMEDIATELY WHAT MODE HE IS IN (WHERE THE MODES ARE DEFINED +;BY HIS MACROS PACKAGE). +;T SHOULD HAVE THE DESIRED MORESW VALUE SAYING WHETHER WE WANT --MORE-- OR --TOP-- OR WHAT. +DISMD: MOVE Q,PFINI + SUB Q,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES Q + CAMG Q,MODCHG ;IF FS MODE CHANGE$ IS LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF IT IS POSITIVE, WE MUST RUN IT TOO. + CALL [ + CALL SAVACS + SETZM MODCHG ;CLEAR THE FLAG. + SETZB C,E ;PASS 0 AS ARG TO USER'S MACRO. + SKIPE A,MODMAC + CALL MACXCP ;CALL USER'S MACRO TO RECOMPUTE IT + JRST RSTACS] + CAME T,MORESW ;IF THE DESIRED STATE OF --MORE-- OR NOT IS CHANGED, + JRST DISMD9 + MOVE Q,$QMODE ;OR THE DESIRED MODE STRING IS CHANGED, WE MUST REDISPLAY THE LINE. + CAMN Q,DISOMD + RET +DISMD9: SKIPN RGETTY ;NO MODE IS SHOWN ON PRINTING TTY'S. + RET + SKIPE DFORCE ;DON'T UPDATE MODE IF FS D FORCE$ IS SET. + RET +DISMD2: MOVE Q,$QMODE + MOVEM Q,DISOMD +INSIRP PUSH P,A B TT TT1 BP CH + MOVE A,Q + CALL CLRMOR ;CLEAR THE WHOLE --MORE-- LINE. + SETOM RROHPO ;REMEMBER THAT I.T.S. CURSOR POS. IS BEING CLOBBERED. + SETOM RROVPO + CALL QLGET0 + JRST DISMD1 ;MODE STRING IS NULL? + MOVE TT,NHLNS ;NO => TRUNCATE IT IF TOO BIG TO A SIZE THAT WILL FIT + SKIPE T + SUBI TT,7 ;TOGETHER WITH THE --TOP-- OR WHATEVER. + TRNE T,MS%MOR ;OR, IF IT MIGHT BE --MORE---FLUSHED, + SUBI TT,9 ;LEAVE ROOM FOR THAT. + CAML B,TT + MOVE B,TT +DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, OR AS MANY CHARS OF IT AS B SAYS. + ILDB CH,BP +IFN ITS,[ ;OUTPUT WITH %TJECH SET SO CTL CHARS DON'T COME OUT IN IMAGE MODE. + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +.ELSE CALL TYOINV + JRST DISMD3 + +DISMD1: +INSIRP POP P,CH BP TT1 TT B A + MOVEM T,MORESW + JUMPE T,CPOPJ ;IF WE ARE SUPPOSED TO HAVE --MORE-- OR SOMETHING, WRITE IT. + SKIPN RGETTY + RET + TLNN T,-1 ;IF % ABOVE SCREEN IN LH IS NONZERO, PRINT THAT. + CAIN T,3 ;IF IN MIDDLE OF BUFFER BUT PERCENT IS 0, PRINT 1%. + JRST DISMD5 + CAIL T,5 ;WE SHOULDN'T GET HERE WANTING TO DISPLAY --MORE--FLUSHED! + .VALUE + MOVE Q,DISMD4-1(T) +IFN ITS,HRLI Q,-2 +IFN TNX,HRLI Q,-1 + JRST DISIOT + +DISMD4: +IFN ITS,[ + [ASCIC *--BOT--*] + [ASCIC *--TOP--*] + 0 + [ASCIC /--MORE--/] +] +IFN TNX,[ + [ASCIZ *--BOT--*] + [ASCIZ *--TOP--*] + 0 + [ASCIZ /--MORE--/] +] + +;OUTPUT --NN%-- WHERE N IS IN LH(T). +DISMD5: DISSTR /--/ + CALL DISIOT + SAVE CH + HLRZ CH,T + SKIPN CH ;PRINT 01% INSTEAD OF 00%, SINCE 00% WHEN NOT AT TOP + MOVEI CH,1 ;MIGHT BE PARADOXICAL. + IDIVI CH,10. + ADDI CH,"0 + CALL TYOINV + MOVEI CH,"0(Q) + CALL TYOINV + REST CH + DISSTR /%--/ + JRST DISIOT + +SUBTTL CURSOR CONTROL SUBROUTINES + +IFN ITS,[ +;SCROLL Q LINES UP AND DOWN AT VPOS IN BP +SCRLUP: +SCRLDN: .VALUE ;ITS DOESNT SUPPORT THIS YET. + +;DELETE # OF LINES IN Q AT VPOS IN BP. +DELLIN: SAVE [%TDDLP] + JRST DELLI1 + +;INSERT # LINES IN Q AT VPOS IN BP. +INSLIN: SAVE [%TDILP] +DELLI1: SAVE [440800,,DISBF1] ;ACCUMULATE STRING IN DISBF1. + SAVE A + MOVEI A,%TDMV0 ;FIRST A COMAND TO SET DESIRED VPOS, AND HPOS 0. + IDPB A,-1(P) + IDPB BP,-1(P) + SETZ A, + IDPB A,-1(P) + MOVEI A,3 ;IF INSERTING/DELETING 0 LINES, JUST MOVE THE CURSOR. + JUMPE Q,DELLI2 ;DON'T PUT IN A %TDILP OR %TDDLP. + MOVE A,-2(P) ;THEN A COMMAND TO INSERT OR DELETE + IDPB A,-1(P) + IDPB Q,-1(P) ;THE SPECIFIED NUMBER OF LINES. + MOVEI A,5 +DELLI2: MOVE Q,[441000,,DISBF1] ;THEN OUTPUT THE STRING. + SYSCAL SIOT,[%CLIMM,,CHSIO ? Q ? A] + .LOSE %LSFIL + REST A + SUB P,[2,,2] + RET + +;OUTPUT C(T) CHARS STARTING AT DISBF1, WITH SUPER-IMAGE SIOT. +DISSIOT:MOVE Q,[441000,,DISBF1] +DISLI5: ILDB CH,Q ;SKIP ALL %TDNOP'S AT THE BEGINNING. + CAIN CH,%TDNOP + SOJG T,DISLI5 + JUMPE T,CPOPJ ;NO CHARS REALLY NEED TO BE SENT => RETURN. + ADD Q,[100000,,] + MOVEI CH,CHSIO + SKIPN RGETTY ;ON PRINTING TTYS, DON'T USE SUPER-IMAGE MODE. + MOVEI CH,CHTTYO +DISSI1: SYSCAL SIOT,[CH ? Q ? T] + .LOSE %LSFIL + SKIPN RGETTY + RET + MOVE Q,NHLNS + CAML Q,CHCRHP + MOVE Q,CHCRHP + SYSCAL SCPOS,[CH ? BP ? Q] + .LOSE %LSFIL + RET + +;MOVE CURSOR AND TELL ITS WHERE IT IS. ON A PRINTING TTY, DON'T ACTUALLY CHANGE +;THE VERTICAL POSITION, IN CASE THE TTY IS A STORAGE TUBE. CLOBBERS BP AND Q. +SETCU1: SKIPE RGETTY + JRST SETCU2 + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,Q] + .LOSE %LSFIL + HLL BP,Q +SETCU2: CALL SETCUR + HLRZ Q,BP + ANDI BP,-1 + SYSCAL SCPOS,[%CLIMM,,CHTTYO ? Q ? BP] + .LOSE %LSFIL + RET + +;MOVE CURSOR USING SUPERIMAGE MODE TO POSITION SPECD AS VPOS,,HPOS IN BP. +;CLOBBERS Q. +SETCUR: SAVE BP + SAVE [441000,,DISBF1] + SAVE A + MOVEI A,%TDMV0 + IDPB A,-1(P) + HLRZ Q,BP + IDPB Q,-1(P) + IDPB BP,-1(P) + MOVEI A,3 + JRST DELLI2 + +ECHOCR: .IOT CHECHO,[^M] + RET + +CLRSCN: HRROI Q,[ASCIC/C/] + JRST DISIOT + +HOMCUR: HRROI Q,[ASCIC/T/] + JRST DISIOT + +ERSCHR: HRROI Q,[ASCIC/K/] + JRST DISIOT + +INSCHR: HRROI Q,[ASCIC/^/] + JRST DISIOT +DELCHR: HRROI Q,[ASCIC/_/] + JRST DISIOT + +CRIF: HRROI Q,[ASCIC /A/] + JRST DISIOT + +CLRMOR: SKIPA Q,[-2,,MORMCL] ; MAYBE THIS SHOULD BE -3? +CLREOL: HRROI Q,[ASCIC/L/] +DISIOT: .IOT CHDPYO,Q + RET + +;IMMEDIATE TYPEOUT, NO HASH-CODING. +TYOINV: .IOT CHTTYO,CH + POPJ P, +] ;IFN ITS + +IFN TNX,[ +;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS. + +;THE TTYTYP TABLE TRANSLATES TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES. +;THEY ARE: 0 => PRINTING TERMINAL, 1 => DM2500, 2 => H1500, 3 => VT52, +; 4 => DM1520, 5 => IMLAC, 6 => VT05, 7 => TK4025, 10 => VT61, +; 11 => TL4041, 12 => FOX, 13 => HP2645, 14 => I400, 15 => TK4023, +; 16 => ANNARB, 17 => C100, 20 = IQ120, 21 => VT100, 22 => I100, +; 23 => TL1061. +;VARIOUS TABLES ARE INDEXED BY THE INTERNAL TECO TYPE CODE, WHICH LIVES IN RGETTY. +NTTYPE==30. ;1+ LARGEST TWENEX TERMINAL TYPE. SIZE OF TTYTYP TABLE. + +DEFINE DEFTYP TYPE,TABLE +IF1 [ IFNDEF TYPE,[ +PRINTX \GTTYP index for TYPE = \ +.TTYMAC FOO +IFB FOO,TYPE==0 +.ELSE TYPE==FOO +IFG TYPE-NTTYPE+1,.ERR TTYTYP TABLE ISNT LARGE ENOUGH FOR THAT +TERMIN +]] +IF2 [ +IFNDEF %%TYPE,%%TYPE==0 +%%TYPE==%%TYPE+1 +IFN TYPE,[ +%%TMP==. +LOC TTYTYP+TYPE +%%TYPE +LOC %%TMP +]] +IFN TYPE,TABLE +.ELSE 0 +TERMIN + +TTYTBS: PRINTB ;DEVICE DEPENDANT ROUTINE DISPATCH TABLE, INDEXED BY RGETTY +DEFTYP DM2500,DM25TB +DEFTYP H1500,HZ15TB +DEFTYP VT52,VT52TB +DEFTYP DM1520,DM15TB +DEFTYP IMLAC,IMLCTB +DEFTYP VT05,VT05TB +DEFTYP TK4025,TK40TB +DEFTYP VT61,VT61TB +DEFTYP TL4041,TL40TB +DEFTYP FOX,FOXTB +DEFTYP HP2645,HPTB +DEFTYP I400,I400TB +DEFTYP TK4023,TK43TB +DEFTYP ANNARB,AATB +DEFTYP C100,C100TB +DEFTYP IQ120,IQ12TB +DEFTYP VT100,VT10TB +DEFTYP I100,I100TB +DEFTYP TL1061,TL40TB + +VT52I==3 ;INDEX FOR VT52 AS OPPOSED TO VT61, VT100, TELERAYS, ETC. +TL106I==23 ;INDEX FOR TL1061 AS OPPOSED TO TL4041. + +TTYTYP: BLOCK NTTYPE ;INTERNAL TYPE (RGETTY), INDEXED BY GTTYP TYPE + +PRINTB: 377777,,79. ;PRINTING TERMINAL DISPATCH VECTOR + (%TOOVR+%TOMVB+%TOLWR) +REPEAT 4,JFCL + SETZM MORMCL +REPEAT 7,JFCL + +;SET CURSOR POSITION TO VPOS,,HPOS IN 2 +CURPOS: SETOM ECHOP +CURPS0: SAVE B ;SAVE DESIRED POSITION + CALL CURPS1 ;DO WORK FIRST + REST TTLPOS + RET +CURPS1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CURSOR POSITIONING + T,,2 ;ENTRY 2 IN DEVICE TABLE + +;DISPATCH BY RGETTY INTO TABLE INDEXED BY POINTER AFTER CALLER +DDPYTB: SAVE T + MOVE T,RGETTY ;GET INTERNAL TERMINAL TYPE + MOVE T,TTYTBS(T) ;GET DISPATCH VECTOR + XCT @(A) ;CALL APPROPRIATE ROUTINE + REST T + JRST CPOP1J + +;CLEAR TO END OF LINE +CLREOL: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOL + T,,3 ;ENTRY 3 IN TABLE + +;CLEAR TO END OF SCREEN +CLREOS: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOS + T,,4 ;ENTRY 4 IN TABLE + +;CLEAR SCREEN +CLRSCN: SAVE A + SETZM TTLPOS ;SAY WE ARE AT HOME + SETOM ECHOP + MOVE A,ECHOL0 ;FIRST LINE OF ECHO AREA + HRLZM A,ECHOPS ;RESET ECHO POSITION + JSP A,DDPYTB + T,,5 ;CLEAR SCREEN ENTRY 5 IN TABLE + +;INSERT LINES +INSLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT LINE + T,,11 ;ENTRY 11 IN TABLE + +;DELETE LINES +DELLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE LINE + T,,12 ;ENTRY 12 IN TABLE + +;INSERT CHARACTERS +INSCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT CHAR + T,,13 ;ENTRY 13 IN TABLE + +;DELETE CHARACTERS +DELCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE CHAR + T,,14 ;ENTRY 14 IN TABLE + +;SET UP MORMCL TO CLEAR LINE AT VPOS IN C +MCLSET: SAVE A + JSP A,DDPYTB ;DISPATCH FOR MORE LINE SETUP + T,,6 ;ENTRY 6 IN TABLE + +;SET UP DISBF1 TO CLEAR LINE FIRST +DISMOV: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMOV + T,,7 ;ENTRY 7 IN TABLE + +;DONT CLEAR IT, JUST GO THERE +DISMV1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMV1 + T,,10 ;ENTRY 10 IN TABLE + +;TAKE TERMINAL OUT OF DISPLAY MODE +DPYRST: SAVE A + JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET + T,,15 ;ENTRY 15 IN TABLE + +;SCROLL Q LINES UP +SCRLUP: SAVE A + JSP A,DDPYTB + T,,16 + +;SCROLL Q LINES DOWN +SCRLDN: SAVE A + JSP A,DDPYTB + T,,17 + +;LOW LEVEL INTERFACES TO DEVICE DEPENDANT ROUTINES + +DISSIO: JSR SAV123 ;SAVE ACS + MOVE B,[441000,,DISBF1] +DISSI2: ILDB CH,B + JUMPN CH,DISSI3 ;FLUSH INITIAL NULLS + SOJG T,DISSI2 + JRST DISSI4 ;NOTHING TO DO +DISSI3: MOVEI A,.PRIOU + ADD B,[100000,,0] ;MAKE BYTE POINTER + MOVNI C,(T) ;NUMBER OF CHARACTERS TO OUTPUT + SOUT + SETOM ECHOP ;NO LONGER IN ECHO AREA IF WE WERE + SKIPN RGETTY ;DONE IF PRINTING + JRST DISSI4 + MOVE B,NHLNS + CAML B,CHCRHP + MOVE B,CHCRHP ;UPDATE HORIZONTAL POSITION + HRLI B,(BP) + MOVEM B,TTLPOS ;UPDATE CURSOR POSITION +IFN TK4025\ANNARB,[ + MOVE A,RGETTY ;HAVE TO KLUDGE CLEOL +IFN TK4025,[ + CAIN A,7 .SEE TTYTYP ; FOR 4025S + JRST DISSTK +] +IFN ANNARB,[ + CAIN A,16 .SEE TTYTYP + JRST DISSTK +] +] ;TK4025\ANNARB + +POP321: +DISSI4: REST C +POP21J: REST B + REST A + RET + +IFN TK4025\ANNARB,[ +DISSTK: SKIPN EOLFLG ;POSTPONED CLEARING NEEDED? + CALL CLREOL ;YES, FAKE IT + JRST POP321 +] ;TK4025\ANNARB + +;SET CURSOR POS TO VPOS,,HPOS IN BP. CLOBBERS AT MOST Q. +SETCU1:: +SETCUR: SKIPN RGETTY ;ON PRINTING TERMINAL + JRST SETCU2 ;USE BS OR SPACE TO DO WHAT WE CAN + SAVE B ;SAVE ACS + MOVE B,BP ;GET DESIRED POSITION +SETCU3: CALL CURPOS ;GO THERE +CPOP2J: REST B + RET + +SETCU2: SAVE A ;HANDLE "CURSOR MOTION" ON PRINTING TTY + TRNN BP,-1 ;MOVE TO START OF LINE? + JRST [MOVEI A,^M ;YES, DO IT FAST + PBOUT + JRST CPOP1J] + SAVE B + MOVEI A,.PRIOU + RFPOS ;GET CURRENT POSITION + ANDI B,-1 ;SHOULD ONLY BE ASKED TO HANDLE HORIZ MOTION + SUBI B,(BP) ;GET DIFFERENCE + JUMPE B,POP21J ;ALREADY THERE, NOTHING TO DO + MOVEI A,^H ;USE BS IF MOVING LEFT + JUMPL B,[MOVMS B ;BUT IF MOVING RIGHT + MOVEI A,40 ;USE SPACE + JRST .+1] + PBOUT + SOJG B,.-1 + JRST POP21J + +;RETURN CURSOR TO UPPER LEFT CORNER OF SCREEN. +HOMCUR: SAVE B + SETZ B, + CALL CURPOS + JRST CPOP2J + + +;CLEAR THE MORE LINE, SMASH ONLY Q +CLRMOR: MOVE Q,RGETTY ;GET TTY TYPE +IFN VT05,[ + CAIN Q,6 ;HAS NULLS IN IT? + JRST CLRMO6 ;YES, MUST USE SOUT THEN +] +IFN TK4025,[ + CAIN Q,7 ;NEEDS SPECIAL HACKING? + JRST CLRMO7 +] +IFN ANNARB,[ + CAIN Q,16 + JRST CLRM16 +] +IFN C100,[ + CAIN Q,17 + JRST CLRM17 +] + HRROI Q,MORMCL ;OTHERWISE JUST FALL THRU WITH WHAT WAS SETUP + +;OUTPUT ASCIZ STRING Q POINTS AT. +DISIOT: EXCH A,Q + PSOUT + EXCH A,Q + RET + +;ITS-STYLE ASCII MODE OUTPUT. +TYOINV: SKIPN RGETTY ;SIMPLE ON PRINTING TERMINAL + JRST [EXCH A,CH + PBOUT + EXCH A,CH + RET] + SAVE A + SAVE B + MOVEI A,.PRIOU + MOVE B,TTLPOS + CAIN CH,^I + JRST [ADDI B,10 ;TAB - MOVE TO NEXT TAB STOP + TRZ B,7 + CALL CURPS0 + JRST POP21J] + CAIN CH,^J + ADD B,[1,,0] ;LF - MOVE TO NEXT LINE + CAIN CH,^M + TRZ B,-1 ;CR - MOVE TO START OF LINE + EXCH B,CH + BOUT + EXCH B,CH + CAIL CH,40 + AOJ B, ;PRINT CHAR, COUNT ONE POSITION + MOVEM B,TTLPOS + JRST POP21J + +;GET FRESH LINE +CRIF: SAVE A + SAVE B + MOVEI A,.PRIOU + RFPOS + HRROI A,[ASCIZ/ +/] + TRNE B,-1 + PSOUT + JRST POP21J + +SUBTTL SIMULATE ITS ECHO AND ^P FOR TWENEX + +;ECHO CHARACTER IN CH, IN THE ECHO AREA. +ECHOC0: HRROS (P) ;FLAG THAT CR SHOULD COME OUT AS STRAY ONE + CAIA +ECHOCH: HRRZS (P) + SAVE CH + TRZE CH,CONTRL + TRZ CH,100 + ANDI CH,177 ;CLEAR OTHER RANDOM BITS + CAIN CH,177 ;RUBOUTS DONT ECHO + JRST POPCHJ + CAIN CH,^J ;LF? + JRST ECHOLF + CAIN CH,^M ;CR? + JRST ECOCR0 + CAIN CH,33 ;ESC COMES OUT AS $ + MOVEI CH,"$ + CAIN CH,^I ;TAB? + JRST ECHOTB + CAIE CH,^H ;BS COMES OUT AS ITSELF + CAIL CH,40 ;CONTROL-MUMBLE? + JRST ECHOC3 + MOVEI CH,"^ ;YES, PRINT ^-MUMBLE + CALL ECHOC1 + MOVE CH,(P) + TRO CH,100 +ECHOC3: CALL ECHOC1 ;PRINT SINGLE CHARACTER + JRST POPCHJ + +ECHOLF: SKIPN RGETTY + JRST ECHLF3 +ECHLF1: CALL ECHOC2 ;ADVANCE TO NEXT LINE + JRST POPCHJ +ECHLF3: CALL ECHLF2 + JRST POPCHJ + +ECHLF2: SAVE A + SAVE B + MOVEI A,.PRIOU ;MONITOR WONT LET US TYPE A BARE LF, SO... +IFN 20X,[ + RFPOS + SAVE B + TRZ B,-1 ;FIRST PRETEND WE ARE AT THE LEFT MARGIN ALREADY + SFPOS +] + MOVEI B,^J ;THEN TYPE IT + BOUT +IFN 20X,[ + RFPOS ;GET LINE IT THINKS THAT PUTS US ON + HLLM B,(P) + REST B ;AND SET UP TO REALLY BE IN MIDDLE OF IT + SFPOS +] + JRST POP21J + +ECHOCR: HRRZS (P) ;ALWAYS CRLF + SAVE CH + MOVEI CH,^M +ECOCR0: SKIPN RGETTY + JRST [CALL ECHOC1 ;ON PRINTING TTY, JUST TYPE IT + JRST POPCHJ] ;AND RETURN + HLLZS ECHOPS ;GO TO START OF THIS LINE + SKIPGE -1(P) ;OUTPUT STRAY CR? + JRST ECOTB2 ;YES, JUST GO TO START OF LINE THEN + JRST ECHLF1 ;ELSE ADVANCE A LINE AND CLEAR IT + +ECHOC1: SKIPE RGETTY + CALL ECOPOS + EXCH CH,A + PBOUT + EXCH CH,A + SKIPN RGETTY + RET + AOS CH,ECHOPS + ANDI CH,-1 ;GET HPOS + CAMGE CH,NHLNS + JRST ECHOC4 ;STILL WITHIN RANGE + HLLZS ECHOPS ;START OF NEW LINE +ECHOC2: HLRZ CH,ECHOPS + AOJ CH, + CAML CH,NVLNS + HRRZ CH,ECHOL0 + HRLM CH,ECHOPS + CALL ECOPS0 + JRST CLREOL + +ECHOC4: MOVE CH,ECHOPS ;MAKE SURE KNOW OUR POSITION RIGHT + MOVEM CH,TTLPOS + RET + +ECHOTB: SKIPN RGETTY + JRST ECHOC3 + HRRZ CH,ECHOPS + ADDI CH,8 + TRZ CH,7 + CAML CH,NHLNS + SETZ CH, + HRRM CH,ECHOPS + JUMPE CH,ECHLF1 ;ADVANCE TO NEXT LINE IF WRAP AROUND +ECOTB2: CALL ECOPS0 + JRST POPCHJ + +ECOPS0: SETOM ECHOP ;HERE TO BE SURE WE GO THERE FIRST +ECOPOS: AOSE ECHOP + RET + SAVE A + SAVE B + MOVE B,ECHOPS + CALL CURPS0 + JRST POP21J + +;SIMULATE DISPLAY TYPEOUT IN ECHO AREA (IE INTERPRET ^P CODES) +ECHODP: AOSG C,ECODPF ;HAD A ^P LAST TIME? + JRST ECODP0 ;YES, OF SOME SORT + CAIE CH,^P ;^P NOW? + JRST ECHOC1 ;THAT WAS EASY ENUF + SETOM ECODPF ;YES, SAY SO FOR NEXT TIME + RET +ECODP0: AOJL C,ECODP1 ;^PH OR ^PV? + SETZM ECODPF + SKIPGE C,ECODTB-"A(CH) + CALL ECOPOS ;SEE IF WE SHOULD MOVE TO RIGHT SPOT FIRST + JRST (C) ;DISPATCH FOR THIS ONE + +ECODP1: AOJL C,ECODP2 ;^PV SEEN? + MOVEI C,-10(CH) ;GET DESIRED HPOS + CAMLE C,NHLNS + MOVE C,NHLNS + HRRM C,ECHOPS +ECODP3: SETZM ECODPF + JRST ECOPS0 ;MOVE THE CURSOR THERE + +ECODP2: MOVEI C,-10(CH) ;GET DESIRED VPOS + SETZM ECODPF + CAMGE C,ECHOL0 + MOVE C,ECHOL0 + CAMLE C,NVLNS + MOVE C,NVLNS ;GET IT IN RANGE + JRST ECODP3 + +ECODTB: ECODPA ;A - ADVANCE TO FRESH LINE + ECODPB ;B - MOVE BACKWARD + ECODPC ;C - CLEAR ECHO AREA + ECHOC2 ;D - MOVEM DOWN + -1,,CLREOS ;E - CLEAR TO END OF SCREEN + ECODF0 ;F - MOVE FORWARD + CPOPJ ;G + ECODPH ;H - SET HORIZONTAL POSITION + CPOPJ ;I + CPOPJ ;J + -1,,ECODPK ;K - ERASE CURRENT CHARACTER POSITION + -1,,CLREOL ;L - CLEAR TO END OF LINE + CPOPJ ;M - MORE - SHOULNDT BE DOING THAT, RIGHT? + CPOPJ ;N - DITTO + CPOPJ ;O + ECODPP ;P - OUTPUT ^P + ECODPQ ;Q - OUTPUT ^C + [MOVE C,ECODPS ? MOVEM C,ECHOPS ? JRST ECOPS0] ;R - SAVE POSITION + [MOVE C,ECHOPS ? MOVEM C,ECODPS ? RET] ;S - RESTORE POSITION + ECODPT ;T - GO TO TOP OF ECHO AREA + ECODPU ;U - MOVE UP + ECODPV ;V - SET VERTICAL POSITION + CPOPJ ;W + ECODPX ;X - BACKSPACE AND ERASE CHARACTER + CPOPJ ;Y + ECODPZ ;Z - HOME DOWN + -1,,INSLIN ;[ INSERT LINE + -1,,DELLIN ;\ DELETE LINE + -1,,CLREOL ;] SAME AS ^PL + -1,,INSCHR ;^ INSERT CHARACTER + -1,,DELCHR ;_ DELETE CHARACTER + +ECODPA: MOVE C,ECHOPS ;^PA - MOVE TO FRESH LINE + TRNN C,-1 ;AT START OF A LINE NOW? + RET ;YES + JRST ECHOCR ;NO, TYPE CRLF + +ECODPB: HRRZ C,ECHOPS ;^PB - MOVE BACKWARD + SOJL C,ECODB2 +ECODB1: HRRM C,ECHOPS ;STILL WITHIN RANGE, GO THERE + JRST ECOPS0 +ECODB2: MOVE C,NHLNS ;MOVE TO LAST LINE - 2 + SUBI C,2 + HRRM C,ECHOPS + JRST ECODPU ;AND UP A LINE + +ECODPC: SKIPN RGETTY ;^PC - CLEAR ECHO AREA + JRST ECHOCR ;TYPE CRLF ON PRINTING TERMINAL + CALL ECODPT ;MOVE TO TOP OF ECHO AREA + JRST CLREOS ;AND CLEAR TO END OF SCREEN + +ECODF0: HRRZ C,ECHOPS ;^PF - MOVE FORWARD + AOJ C, + CAMLE C,NHLNS + SETZ C, ;WRAP AROUND ON THE SAME LINE + JRST ECODB1 ;GO THERE + +ECODPH: SKIPA C,[-2] ;^PH - SET HORIZONTAL POSITION +ECODPV: MOVNI C,3 ;^PV - SET VERTICAL POSITION + MOVEM C,ECODPF + RET + +ERSCHR: +ECODPK: +IFN IMLAC,[ + MOVE A,RGETTY + CAIN A,5 ;BS OVERWRITES ON IMLAX + SKIPA A,[-1,,[.BYTE 7 ? 177 ? 204-176 ? 0]] +] + HRROI A,[.BYTE 7 ? 40 ? 10 ? 0] ;^PK - ERASE CURRENT CHAR + PSOUT + RET + +ECODPP: SKIPA CH,[^P] ;^PP - TYPE ^P +ECODPQ: MOVEI CH,^C ;^PQ - TYPE ^C + JRST ECHOC1 ;JUST TYPE IT OUT + +ECODPZ: MOVE C,NVLNS ;^PZ - HOME DOWN + SOSA C ;NUMBER OF LINES -1 +ECODPT: MOVE C,ECHOL0 ;^PT MOVE TO TOP + HRLZM C,ECHOPS + JRST ECOPS0 ;GO THERE + +ECODU2: SKIPA C,NVLNS ;GO TO BOTTOM LINE +ECODPU: HLRZ C,ECHOPS ;^PU - MOVE UP + SOJL C,ECODU2 ;STILL IN RANGE? + HRLM C,ECHOPS + JRST ECOPS0 ;YES, GO THERE + +ECODPX: MOVE C,ECHOPS ;^PX ERASE LAST CHARACTER + TRNN C,-1 ;AT START OF LINE? + JRST ECODX2 + CALL ECOPOS + SOJ C, + MOVEM C,ECHOPS + MOVEI A,^H + PBOUT + JRST ECODPK +ECODX2: HRR C,NHLNS + SUB C,[1,,2] + MOVEM C,ECHOPS + CALL ECOPS0 ;MOVE TO LAST COL -2 OF LAST LINE + JRST CLREOL ;AND CLEAR TO END + +IFN DM2500,[ +SUBTTL DM2500 + +DM25TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) + CALL DMCPS + CALL DMCEOL + CALL DMCEOL ;CLOSEST WE CAN COME + CALL DMCLRS + CALL DMMCLS + CALL DMDSMV + CALL DMDMV1 + CALL DMINSL + CALL DMDELL + CALL DMINSC + CALL DMDELC + CALL DMRST + +DMCPS: JUMPE B,[MOVEI A,^B ;HOME IS EASY + PBOUT + RET] + MOVEI A,^L ;ELSE ^L + PBOUT + HRRZ A,B + XORI A,"` + PBOUT + HLRZ A,B + XORI A,"` +DMCP2: PBOUT + RET + +DMCEOL: MOVEI A,^W + JRST DMCP2 + +DMCLRS: MOVEI A,^^ + PBOUT ;[ +DMRST: MOVEI A,^] ;RESTORE ROLL MODE + JRST DMCP2 + +DMINSL: SAVE C + SAVE B + CALL DMINS1 ;POSITION RIGHT AND ENTER I/D MODE + MOVEI A,30. ;COMPUTE AMOUNT OF FILL NEEDED + SUBI A,(BP) ;((30.-(BP))*OSPEED-2400.)/14400. + SKIPN B,OSPEED ;SPEED OF OUTPUT + MOVEI B,9600. ;ASSUME MAX IF UNKNOWN + IMULI B,(A) + SUBI B,2400. + IDIVI B,14400. ;MAGIC NUMBER IN B +DMINS2: MOVEI A,^J ;INSERT A LINE + PBOUT + MOVEI A,177 ;FILL CHARACTER + SKIPE C,B ;GET NUMBER OF FILL CHARS NEEDED + PBOUT + SOJG C,.-1 ;OUTPUT THAT MANY + SOJG Q,DMINS2 ;REPEAT FOR NUMBER OF LINES REQUESTED + REST B +DMINS3: REST C + MOVEI A,^X + JRST DMCP2 + +DMDELL: SAVE C + CALL DMINS1 +DMDEL2: MOVEI A,^Z ;DELETE A LINE + PBOUT + MOVEI A,177 ;ONE FILL CHAR + SKIPE C,OSPEED + CAIL C,9600. + PBOUT ;ONLY FOR 9600 BAUD OR MORE THOUGH + SOJG Q,DMDEL2 + JRST DMINS3 + +DMINS1: HRROI A,[.BYTE 7 ? ^L ? "` ? 0] + PSOUT + MOVEI A,140(BP) + PBOUT + MOVEI A,^P + PBOUT + RET + +DMMCLS: LSH C,14.+1 + XOR C,[.BYTE 7 ? ^L ? "` ? "` ? ^W ? 0] + MOVEM C,MORMCL + RET + +DMDSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 + XOR B,[.BYTE 8 ? ^L ? "` ? "` ? ^W] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST DMDSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL DMDSM1 + LSH A,4 +DMDSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +DMDSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + XOR B,[.BYTE 8 ? 0 ? ^L ? "` ? "`] + RET + +DMDMV1: SAVE B + SETZB A,B + CALL DMDSM1 + JRST DMDSM2 + +DMINSC: SAVE C + HRROI A,[.BYTE 7 ? ^P ? ^\ ? ^X ? 0] + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + HRROI A,[.BYTE 7 ? ^P ? 40 ? 177 ? ^X ? ^H ? 40 ? ^H] ;USE HAIRY ONE + PSOUT + REST C + RET + +DMDELC: HRROI A,[.BYTE 7 ? ^P ? ^H ? 0] + PSOUT + SAVE C + MOVEI A,177 + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + PBOUT ;NEED ONE FILL CHAR + JRST DMINS3 +] ;DM2500 + +IFN H1500,[ +SUBTTL H1500 + +HZ15TB: 24.,,79. ;DISPATCH VECTOR FOR HZ1500 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL HZCPS + CALL HZCEOL + CALL HZCEOS + CALL HZCLRS + CALL HZMCLS + CALL HZDSMV + CALL HZDMV1 + CALL HZINSL + CALL HZDELL +REPEAT 3,JFCL + +HZCPS: SAVE C + MOVE C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRRZ A,B + ADDI A,140 + CAIL A,177 + SUBI A,140 + DPB A,[170700,,C] + HLRZ A,B + LSH A,7+1 + IOR C,A + HRROI A,C + PSOUT + REST C + RET + +HZCEOL: HRROI A,[.BYTE 7 ? 176 ? ^O ? 177 ?0] + PSOUT + RET + +HZCEOS: HRROI A,[.BYTE 7 ? 176? ^X ?177?177?177?177?177?0] + PSOUT + RET + +HZCLRS: HRROI A,[.BYTE 7 ? 176? ^\ ?177?177?177?177?0] + PSOUT + RET + +HZINSL: SAVE C + CALL HZIDPS +HZINS1: HRROI A,[.BYTE 7 ? 176 ? ^Z ? 0] + PSOUT + MOVEI C,8. + CALL HZFILL + SOJG Q,HZINS1 + REST C + RET + +HZFILL: HRROI A,[.BYTE 7 ? 177?177?177?177 ? 0] + PSOUT + SOJG C,.-2 + RET + +HZDELL: SAVE C + CALL HZIDPS +HZDEL1: HRROI A,[.BYTE 7 ? 176 ? ^S ? 0] + PSOUT + MOVEI C,1. + CALL HZFILL + SOJG Q,HZDEL1 + REST C + RET + +HZIDPS: MOVEI C,140(BP) + LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRROI A,C + PSOUT + RET + +;MOVE TO LINE START, CEOL, MOVE TO HPOS ON SAME LINE +HZDSMV: SAVE B + MOVEI A,(BP) ;DESIRED VPOS + LSH A,4 + IOR A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] ;MOVE TO LINE START + MOVE B,[.BYTE 8 ? 176 ? ^O ? 177 ? 177] ;CEOL + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + SETZM DISBF1+5 ;ASSUME NO HORIZ POSITIONING NECSY + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST CPOP2J ;YES, DONT NEED SECOND CURSOR ADDRESS THEN +HZDSM2: MOVE A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] + CALL HZDSM1 + MOVEM A,DISBF1+5 + JRST CPOP2J + +HZDSM1: SAVE A + DPB BP,[041000+P,,] ;VPOS + MOVE B,DISCPH + DPB B,[141000+P,,] ;HPOS + REST A + RET + +HZDMV1: SAVE B + SETZM DISBF1+3 ? SETZM DISBF1+4 + JRST HZDSM2 + +HZMCLS: LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 176] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? ^O ? 177 ? 177 ? 0] + MOVEM C,MORMCL+1 + RET +] ;H1500 + +IFN VT52\VT61\VT100\TL4041\TL1061,[ +SUBTTL VT52S OF VARIOUS SORTS + +IFN VT52,[ +VT52TB: 24.,,79. ;DISPATCH VECTOR FOR VIRGIN VT52 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 +REPEAT 5,JFCL +] ;VT52 +IFN VT61,[ +VT61TB: 24.,,79. ;DISPATCH VECTOR FOR VT61 +IFE VT61-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL VTINSL + CALL VTDELL + CALL VTINSC + CALL VTDELC + JFCL + +;THE VT61 FLAVOUR OF I/D LINE/CHAR FOR A VT52 +VTINSL: SKIPA A,["F] ;$PF - INSERT LINE +VTDELL: MOVEI A,"D ;$PD - DELETE LINE + SAVE A + MOVEI A,"Y + CALL VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT +VTINS1: MOVEI A,"P + CALL VTESC + MOVE A,(P) ;GET DESIRED FUNCTION AGAIN + PBOUT + SOJG Q,VTINS1 + JRST CPOP1J + +VTDELC: HRROI A,[.BYTE 7 ? 33 ? "P ? "S ? 0] + PSOUT + RET +VTINSC: HRROI A,[.BYTE 7 ? 33 ? "P ? "I ? 40 ? 33 ? "P ? "I+40 ? 10 ? 0] + PSOUT + RET +] ;VT61 + +IFN TL4041\TL1061,[ +TL40TB: 24.,,79. ;DISPATCH VECTOR FOR TELERAY 4041 +IFE TL1061-VT52,IFE TL4041-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL TLINSL + CALL TLDELL + CALL TLINSC + CALL TLDELC + JFCL + +;THE TELERAY 4041 VERSION OF I/D LINE/CHAR +TLINSL: SKIPA A,["L] ;$L - INSERT LINE +TLDELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"Y + CALL VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT + REST A ;GET DESIRED FUNCTION AGAIN +TLDEL1: CALL VTESC + SAVE A + MOVE A,RGETTY + CAIE A,TL106I + JRST TLDEL2 + MOVEI A,40. + DISMS +TLDEL2: REST A + SOJG Q,TLDEL1 + RET + +TLDELC: MOVEI A,"Q + JRST VTESC +TLINSC: MOVEI A,"P + JRST VTESC +] ;TL4041,TL1061 + +IFN VT100,[ +VT10TB: 24.,,79. ;DISPATCH VECTOR FOR VT100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) ;HAS BETTER THAN LID + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VT1CLR + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 +REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED + CALL VT1RST + CALL VT1SUP + CALL VT1SDN + + +VT1CLR: HRROI A,[ASCIZ "<[?2lHJ"] ;] + PSOUT + RET + +VT1RST: HRROI A,[ASCIZ /<78/] ;] RESET SCROLL REGION + PSOUT + RET + +;SCROLL Q LINES STARTING WITH LINE IN BP UP +VT1SUP: PUSH P,["D] ;INDEX NEEDED TO CAUSE SCROLLING (DOESNT TAKE ARGUMENT) + JSP A,VT1SCR ;SETUP SCROLL REGION AND BYTE POINTER IN A + MOVE B,BOTLIN ;POSITION TO BOTTOM OF SCROLL REGION, OFFSET +VT1UP2: CALL VT1ARG + MOVEI B,"H + IDPB B,A + MOVEI B,0 + IDPB B,A ;MAKE ASCIZ OF POSITIONING STUFF + HRROI A,VT1BUF + PSOUT ;TYPE IT ALL OUT +VT1UP3: MOVE A,-2(P) ;GET CURSOR COMMAND + CALL VTESC ;SCROLL RIGHT DIRECTION + MOVEI A,0 + MOVEI B,10. ;NEED PADDING FOR THIS + PBOUT + SOJG B,.-1 + SOJG Q,VT1UP3 + HRROI A,[ASCIZ /[?2l/] ;] BACK INTO VT52 MODE (MAYBE ALWAYS ANSI?) + PSOUT + JRST POP321 ;ALSO FLUSH SCROLLING COMMAND + +VT1SDN: PUSH P,["M] ;REVERSE INDEX TO SCROLL + JSP A,VT1SCR ;SETUP SCROLL REGION + MOVEI B,1(BP) ;MOVE TO TOP LINE, OFFSET + JRST VT1UP2 + +VT1SCR: PUSH P,B + PUSH P,C + PUSH P,A ;SAVE RETURN ADDRESS AS WELL + MOVE A,[440700,,VT1BUF] ;MAKE STRING POINTER + MOVEI B,33 + IDPB B,A + MOVEI B,"< ;ENTER ANSI MODE + IDPB B,A + MOVEI B,1(BP) ;STARTING LINE, OFFSET + CALL VT1ARG + MOVEI B,"; + IDPB B,A + MOVE B,BOTLIN ;BOTTOM LINE, OFFSET + CALL VT1AR1 + MOVEI B,"r ;SET SCROLL REGION + IDPB B,A + RET + +VT1ARG: MOVEI C,33 + IDPB C,A + MOVEI C,"[ ;] + IDPB C,A +VT1AR1: IDIVI B,10. + JUMPE B,VT1AR2 ;NO TENS DIGIT + ADDI B,"0 + IDPB B,A ;ELSE PUT IT IN +VT1AR2: ADDI C,"0 + IDPB C,A ;AND DIGITS + RET +];VT100 + +VTCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST VTESC] + MOVEI A,"Y ;ELSE SEND $Y + CALL VTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + JRST VTES1 + +VTCEOL: MOVEI A,"K ;CLEAR EOL +VTESC: SAVE A + MOVEI A,33 + PBOUT + REST A +VTES1: PBOUT + RET + +VTCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL VTESC +VTCEOS: MOVEI A,"J ;CLEAR EOS + CALL VTESC + MOVE A,RGETTY + CAIE A,VT52I ;REAL VT52 NEEDS PADDING AFTER CLEAR SCREEN + RET + SAVE C + MOVE A,OSPEED ;ABOVE 4800 BAUD, TO AVOID ^S^Q LOSSAGE. + SETZ C, + CAIN A,9600. + MOVEI C,26. ;26 RUBOUTS AT 9600 BAUD, 5 AT 4800 + CAIE A,4800. ;(EMPIRICALLY DETERMINED. DON'T ASK ME WHY). + MOVEI C,5 + JUMPE C,POPCJ + MOVEI A,177 + PBOUT + SOJG C,.-1 + JRST POPCJ + +VTMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "Y ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "K ? 0) + MOVEM C,MORMCL+1 + RET + +VTDSMV: SAVE B + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST VTDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $Y ? $K + MOVEM B,DISBF1+5 + JRST CPOP2J +VTDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... + MOVEM B,DISBF1+4 + CALL VTDMV1 + JRST CPOP2J + +VTDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] + MOVEM A,DISBF1+5 ;$Y + RET +] ;VT52 + +IFN FOX,[ +SUBTTL FOX + +FOXTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER FOX + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL FXCPS + CALL FXCEOL + CALL FXCEOS + CALL FXCLRS + CALL FXMCLS + CALL FXDSMV + CALL FXDMV1 +REPEAT 5,JFCL + +FXCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST FXESC] + MOVEI A,"X ;ELSE SEND $X + CALL FXESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,"Y ;$Y + CALL FXESC + MOVEI A,40(B) ;+40 + JRST FXES1 + +FXCEOL: MOVEI A,"I ;CLEAR EOL +FXESC: SAVE A + MOVEI A,33 + PBOUT + REST A +FXES1: PBOUT + RET + +FXCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL FXESC +FXCEOS: MOVEI A,"J ;CLEAR EOS + JRST FXESC + +FXMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "X ? 40 ? 33 ? "Y] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 40 ? 33 ? "I] + MOVEM C,MORMCL+1 + RET + +FXDSMV: SAVE B + MOVEI B,(BP) ;DESIRED VPOS + SKIPE A,DISCPH ;DESIRED HPOS = 0? + JRST FXDSM2 ;NO, MUST GO THERE AFTERWARDS + LSH B,8+4 + ADD B,[.BYTE 8 ? 33 ? "X ? 40 ? 33] ;$X$ + MOVE A,[.BYTE 8 ? "Y ? 40 ? 33 ? "I] ;Y$I +FXDSM1: MOVEM B,DISBF1+4 + MOVEM A,DISBF1+5 + JRST CPOP2J +FXDSM2: LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? 33 ? "X ? 40] ;$X + MOVEM B,DISBF1+3 + MOVE B,[.BYTE 8 ? 33 ? "Y ? 40 ? 33] ;$Y<0>$ + ADD A,[.BYTE 8 ? "I ? 33 ? "Y ? 40] ;I$Y + JRST FXDSM1 + +FXDMV1: MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "X] + MOVEM A,DISBF1+4 ;$X + MOVEI A,(BP) ;DESIRED VPOS + LSH A,24. + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 40 ? 33 ? "Y ? 40] + MOVEM A,DISBF1+5 ;$Y + RET +] ;FOX + +IFN DM1520,[ +SUBTTL DM1520 + +DM15TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 1520 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL D1CPS + CALL D1CEOL + CALL D1CEOS + CALL D1CLRS + CALL D1MCLS + CALL D1DSMV + CALL D1DMV1 +REPEAT 5,JFCL + +D1CPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY + PBOUT + RET] + MOVEI A,^^ ;ELSE ^^ + PBOUT + MOVEI A,40(B) + PBOUT + HLRZ A,B + ADDI A,40 +D1CP2: PBOUT + RET + +D1CEOS: MOVEI A,^K ;ERASE EOS + JRST D1CP2 ;[ +D1CEOL: MOVEI A,^] ;ERASE EOL + JRST D1CP2 +D1CLRS: MOVEI A,^L ;ERASE SCREEN + JRST D1CP2 + +D1MCLS: LSH C,14.+1 ;[ + ADD C,[.BYTE 7 ? ^^ ? 40 ? 40 ? ^] ? 0] + MOVEM C,MORMCL + RET + +D1DSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 ;[ + ADD B,[.BYTE 8 ? ^^ ? 40 ? 40 ? ^] ] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST D1DSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL D1DSM1 + LSH A,4 +D1DSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +D1DSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? ^^ ? 40 ? 40] + RET + +D1DMV1: SAVE B + SETZB A,B + CALL D1DSM1 + JRST D1DSM2 +] ;DM1520 + +IFN IMLAC,[ +SUBTTL IMLAX + +IMLCTB: 44.,,88. ;DISPATCH TABLE FOR IMLAX + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOOVR) + CALL IMCPS + CALL IMCEOL + CALL IMCEOS + CALL IMCLRS + CALL IMMCLS + CALL IMDSMV + CALL IMDMV1 + CALL IMINSL + CALL IMDELL + CALL IMINSC + CALL IMDELC + JFCL + +IMCPS: MOVEI A,217 ;%TDMV0 + CALL IMCEO2 + HLRZ A,B ;VPOS + AOJ A, ;AVOID SENDING NULL + PBOUT + MOVEI A,1(B) ;HPOS +IMCPS2: PBOUT + RET + +IMCEOS: MOVEI A,202 ;%TDEOF +IMCEO2: SAVE A + MOVEI A,177 ;SEND > 200 BY ESCAPING FIRST + PBOUT + REST A + SUBI A,176 ;SEND REST + JRST IMCPS2 +IMCEOL: MOVEI A,203 ;%TDEOL + JRST IMCEO2 +IMCLRS: MOVEI A,220 ;%TDCLR + JRST IMCEO2 + +IMINSL: SKIPA A,[223] ;%TDILP +IMDELL: MOVEI A,224 ;%TDDLP + SAVE A ;SAVE DESIRED FUNCTION + MOVEI A,217 ;%TDMV0 TO BEGINNING OF DESIRED LINE + CALL IMCEO2 + MOVEI A,1(BP) ;VPOS + PBOUT + MOVEI A,1 + PBOUT + REST A ;GET BACK DESIRED FUNCTION + CALL IMCEO2 + MOVEI A,(Q) ;GET REPEAT COUNT + JRST IMCPS2 + +IMINSC: SKIPA A,[225] ;%TDICP +IMDELC: MOVEI A,226 ;%TDDCP + CALL IMCEO2 + MOVEI A,1 + JRST IMCPS2 + +IMMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 177 ? 217-176 ? 1 ? 1 ? 177] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? 203-176 ? 0) + MOVEM C,MORMCL+1 + RET + +IMDSMV: SAVE B + MOVEI B,1(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 1 ? 177 ? 203-176] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 177 ? 217-176] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IMDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST %TDMV0 ? %TDEOL + MOVEM B,DISBF1+5 + JRST CPOP2J +IMDSM2: MOVEM A,DISBF1+3 ;HPOS TOO, %TDMV0 ? %TDEOL ? ... + MOVEM B,DISBF1+4 + +IMDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 177 ? 217-176 ? 1 ? 1] + MOVEM A,DISBF1+5 ;%TDMV0 + RET +] + +IFN VT05,[ ;[ +SUBTTL VT05 + +VT05TB: 20.,,71. ;DISPATCH VECTOR FOR VT05 + (%TOERS+%TOMVB+%TOMVU) ;CANT EVEN DISPLAY LOWERCASE + CALL V0CPS + CALL V0CEOL + CALL V0CEOS + CALL V0CLRS + CALL V0MCLS + CALL V0DSMV + CALL V0DMV1 +REPEAT 5,JFCL + +V0CPS: JUMPE B,[MOVEI A,^] ;HOME IS EASY + JRST V0EOS2] ;WELL, AS EASY AS ANYTHING ELSE + MOVEI A,^N + PBOUT + HLRZ A,B + ADDI A,40 + CALL V0EOS2 ;TYPE YPOS+40 AND FILL (MUST FILL IN THE MIDDLE OF IT!) + MOVEI A,40(B) ;THEN XPOS+40 + PBOUT + RET + ;[ +V0CLRS: MOVEI A,^] ;HOME + CALL V0EOS2 ;WITH FILL +V0CEOS: MOVEI A,^_ ;CLEAR EOS +V0EOS2: PBOUT +V0FILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE +REPEAT 4,PBOUT ;OF THE CURSOR ADDRESSING) + RET +V0CEOL: MOVEI A,^^ + JRST V0EOS2 + +V0MCLS: LSH C,21.+1 + ADD C,[.BYTE 7 ? ^N ? 40 ? 0] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 0 ? 40 ? ^^] + MOVEM C,MORMCL+1 + RET + +V0DSMV: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + MOVE B,[.BYTE 8 ? 0 ? 0 ? 40 ? ^^] + SKIPE DISCPH ;ANY HPOS? + JRST V0DSM2 ;YES + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + JRST CPOP2J +V0DSM2: MOVEM A,DISBF1+1 + MOVEM B,DISBF1+2 +V0DSM3: MOVEM A,DISBF1+4 + MOVE B,DISCPH ;GET HPOS + ADDI B,40 + LSH B,8+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +V0DMV1: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + JRST V0DSM3 + +CLRMO6: JSR SAV123 + MOVEI A,.PRIOU + HRROI B,MORMCL + MOVNI C,8 + SOUT + CALL V0FILL + JRST POP321 +] + +IFN TK4025,[ +SUBTTL TEKTRONIX 4025S + +TK40TB: 34.,,78. ;DISPATCH TABLE FOR TEKTRONIX 4025 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL TKCPS + CALL TKCEOL + CALL TKCEOS + CALL TKCLRS + CALL TKMCLS + CALL TKDSMV + CALL TKDMV1 + CALL TKINSL + CALL TKDELL + CALL TKINSC + CALL TKDELC + JFCL + + +; TKCPS - OUTPUT TEK4025 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +TKCPS: JUMPE B,[HRROI A,[ASCIZ / +`UP34;/] + JRST TKCLR2] ;IF HOME, BE SURE TO RESYNCH + SAVE B ;SAVE DESIRED POSITION + SAVE TTLPOS ;WHERE WE ARE NOW. + HLRZ B,TTLPOS ;JUST ROW + CAIL B,28. ;CAN'T TRUST IT IF AT MODE LINE OR BELOW + JRST TKCPS8 ;SO USE FUDGED ABSOLUTE + HLRZ A,-1(P) ;GET NEW + SUBI B,(A) ;GET OLD-NEW + JUMPE B,TKCPS1 ;NO DIFF THERE + HRROI A,[ASCIZ /`DOW/] ;ASSUME NEGATIVE => DOWN + SKIPL B + HRROI A,[ASCIZ /`UP/] ;POSITIVE => UP + PSOUT + CALL TKCPS7 +TKCPS1: REST B ;GET BACK OLD + ANDI B,-1 ;JUST COL + HRRZ A,(P) ;GET NEW + SUBI B,(A) + JUMPE B,CPOP2J + JUMPE A,[MOVEI A,^M ;FASTER IF GOING TO BEGINNING OF LINE + PBOUT + JRST CPOP2J] + HRROI A,[ASCIZ /`RIG/] ;ASSUME NEGATIVE => RIGHT + SKIPL B + HRROI A,[ASCIZ /`LEF/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + +TKCPS7: MOVM A,B + SOJE A,TKCPS3 +TKCPS2: CALL TKCPS4 +TKCPS3: MOVEI A,"; + PBOUT + RET + +TKCPS4: SAVE [PBOUT] +TKCPS5: SAVE B + AOJ A, ;OFFSET TO 1,1 AS ORIGIN + IDIVI A,10. + JUMPE A,TKCPS6 + MOVEI A,"0(A) + XCT -1(P) +TKCPS6: MOVEI A,"0(B) + XCT -1(P) + JRST POP21J + +TKCPS8: + HRROI A,[ASCIZ / +`UP34;/] + PSOUT + REST B ;POP OFF OLD STUFF + HLRZ B,(P) ;GET LINE + JUMPE B,TKCPS9 + HRROI A,[ASCIZ /`DOW/] + PSOUT + CALL TKCPS7 +TKCPS9: HRRZ B,(P) + JUMPE B,CPOP2J + HRROI A,[ASCIZ /`RIG/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + + +TKCEOS: ; CLOSE ENOUGH FOR MOST THINGS +TKCEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + PUSH P,C ; SAVE FOR LATER + SUBI C,79. ; MAKE HPOS-79 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVEI A,^M + PBOUT ; BACK TO LEFT + POP P,B ; GET BACK OLD POS + JUMPE B,TKCEO1 + HRROI A,[ASCIZ /`RIG/] + PSOUT + PUSHJ P,TKCPS7 +TKCEO1: POP P,C + POP P,B + POP P,A + POPJ P, + +TKCEO2: HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRROI A,[ASCIZ / /] ; SOME SPACES FOR FILL + PSOUT + MOVEI A,^M + PBOUT + RET + +TKCLRS: HRROI A,[ASCIZ /`ERA;/] +TKCLR2: PSOUT + RET + +TKINSC: HRROI A,[ASCIZ /`ICH; `LEF1;/] + JRST TKCLR2 +TKDELC: HRROI A,[ASCIZ /`DCH;/] + JRST TKCLR2 + +; TKDELL - OUTPUT TEK4025 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +TKDELL: MOVS B,BP + CALL TKCPS + MOVEM B,TTLPOS + HRROI A,[ASCIZ /`DLI/] + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 ;ACCOUNT FOR INCREMENTING THAT WILL BE DONE + + +; TKINSL - OUTPUT TEK4025 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +TKINSL: MOVSI B,-1(BP) + JUMPGE B,.+2 + MOVEI B,0 ; THIS WILL LOSE BUT ITS BETTER THAN NOTHING + CALL TKCPS + MOVEM B,TTLPOS + HRROI A,[ASCIZ /`ILI/] + PSOUT + MOVEI A,(Q) + SOS A + CALL TKCPS2 + HRROI A,[ASCIZ /`UP/] ;REPOSITION CURSOR + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 + +TKMCLS: MOVEM C,MORMCL + RET + +CLRMO7: SAVE A + SAVE B + HRROI A,[ASCIZ /`UP34;`DOW/] + PSOUT + MOVE B,MORMCL + CALL TKCPS7 + HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRLZ B,MORMCL + MOVEM B,TTLPOS + JRST POP21J + + +TKDMV1: HRROS (P) + SAVE [141000,,DISBF1+1] + JRST TKDSM2 +TKDSMV: SKIPE DISCPH ;ANY HPOS? + SAVE [441000,,DISBF1] ;YES, WILL NEED WHOLE BUFFER + SAVE [141000,,DISBF1+1] + HRRZS -1(P) +TKDSM2: SAVE B + MOVE B,TTLPOS + MOVEI A,^M + TRNE B,-1 ;IF NOT THERE ALREADY... + IDPB A,-1(P) ;START AT BEGINNING OF CURRENT LINE + HLRZS B ;GET CURRENT ROW + SUBI B,(BP) ;GET OLD-NEW + JUMPE B,TKDSM5 ;ALREADY ON RIGHT LINE + MOVEI A,[ASCIZ /`DOW /] ;ASSUME NEGATIVE => DOWN + SKIPL B + MOVEI A,[ASCIZ /`UP /] + CALL TKDSMS + MOVM A,B + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) +TKDSM5: SETZM EOLFLG ; NO CLEARING + SKIPE HCDS(BP) ;NEED CLEARING? + SKIPGE -2(P) ;AND WANT CLEARING? + SKIPA A,[-1] ;NO OR NO + SETZ A, ;YES AND YES, IT'S NEEDED + MOVEM A,EOLFLG ;SAVE IT + SKIPN DISCPH ;GET HPOS IF ANY + JRST POP21J + MOVEI A,[ASCIZ /`RIG /] + CALL TKDSMS + MOVE A,DISCPH + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) + JRST POP21J + +TKDSMS: SAVE B + HRLI A,440700 +TKDSS2: ILDB B,A + JUMPE B,CPOP2J + IDPB B,-3(P) + JRST TKDSS2 + +TKDSMN: SOJE A,CPOPJ + SAVE [IDPB A,-4(P)] + JRST TKCPS5 +] + +IFN HP2645,[ +SUBTTL HP2645 + +HPTB: 24.,,79. ;DISPATCH VECTOR FOR HP2645 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL HPCPS + CALL HPCEOL + CALL HPCEOS + CALL HPCLRS + CALL HPMCLS + CALL HPDSMV + CALL HPDMV1 + CALL HPINSL + CALL HPDELL + CALL HPINSC + CALL HPDELC + JFCL + + +; HPCPS - OUTPUT HP2645 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +HPCPS: SAVE A ; SAVE AC + MOVE A,[440700,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + CALL HPMOVE ; GET COMMANDS TO DO CURSOR MOVEMENT + MOVE A,[440700,,HPBUF] ; SEND COMMANDS + PSOUT ; ... + REST A ; RESTORE AC + RET + + +; HPMOVE - CALCULATE HP2645 CURSOR POSITIONING COMMANDS. +; ARGUMENTS: +; A B.P. TO OUTPUT BUFFER (UPDATED ON RETURN) +; B LINE,,COLUMN + +HPMOVE: SAVE B ; SAVE ACS + SAVE C ; ... + JUMPE B,[ ; SIMPLE HOME + MOVEI C,33 ; $H WILL DO + IDPB C,A + MOVEI C,"H + IDPB C,A + JRST HPMOV1 + ] +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + HLRZ B,-1(P) ; GET LINE NO. + CALL HPNO ; OUTPUT AS DECIMAL NO. + HRRZ B,-1(P) ; GET COLUMN NO. + JUMPE B,[ ; IF COLUMN NO. IS ZERO THEN USE DIRECT + MOVEI C,"R ; CURSOR POSITION FOR LINE NO. ONLY + IDPB C,A + MOVEI C,^M ; THEN FOLLOW WITH A CR + IDPB C,A ; ... + JRST HPMOV1 + ] + MOVEI C,"r ; TERMINATE LINE NO. + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI C,"C ; TERMINATE COLUMN NO. + IDPB C,A ; ... +HPMOV1: MOVEI C,0 ; TERMINATE WITH A NULL + IDPB C,A ; ... + REST C ; RESTORE ACS + REST B ; ... + RET + +; INTERNAL SUBROUTINE - OUTPUT B AS DECIMAL NO. +HPNO: IDIVI B,10. ; CONVERT TO TENS AND ONES DIGITS + JUMPE B,HPN1 ; SKIP TENS DIGIT IF ZERO + ADDI B,"0 ; CONVERT TENS DIGIT TO ASCII + IDPB B,A ; OUTPUT TENS DIGIT +HPN1: ADDI C,"0 ; CONVERT ONES DIGIT TO ASCII + IDPB C,A ; OUTPUT ONES DIGIT + RET + + +; HPCEOL - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF LINE. + +HPCEOL: HRROI A,[ASCIZ "K"] + PSOUT + RET + + +; HPCEOS - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF SCREEN. + +HPCEOS: HRROI A,[ASCIZ "J"] + PSOUT + RET + + +; HPCLRS - OUTPUT HP2645 COMMANDS TO CLEAR THE SCREEN. + +HPCLRS: HRROI A,[ASCIZ "HJ"] + PSOUT + RET + + +; HPINSL - OUTPUT HP2645 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +HPINSL: MOVEI A,"L ; $L - INSERT LINE + JRST HPDEL1 + + +; HPDELL - OUTPUT HP2645 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +HPDELL: MOVEI A,"M ; $M - DELETE LINE +HPDEL1: SAVE B ; SAVE AC + MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. + CALL HPCPS ; MOVE TO DESIRED LINE NO. + MOVEI B,33 ; ESC +HPID1: EXCH A,B + PBOUT ; OUTPUT ESC + EXCH A,B + PBOUT ; OUTPUT "L" OR "M" + SOJG Q,HPID1 + REST B ; RESTORE AC + RET + +HPDELC: HRROI A,[ASCIZ "P"] + PSOUT + RET +HPINSC: HRROI A,[ASCIZ "Q R"] + PSOUT + RET + +; HPMCLS - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED LINE AND CLEAR +; IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER TIME. +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +HPMCLS: SAVE A ; ... + SAVE B ; ... + MOVE A,[440700,,MORMCL] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,C ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; PUT IN COMMANDS TO MOVE TO DESIRED LINE + MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH + DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE + MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE + IDPB B,A ; ... + MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... + REST B ; RESTORE ACS + REST A ; ... + RET + + +; HPDSMV - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +HPDSMV: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE + MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH + DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE + MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE + IDPB B,A ; ... + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM1 ; YES, ALREADY THERE +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A +HPDSM1: MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... +HPDSM2: SUBI A,HPBUF ; CALCULATE NO. OF BYTES WE'VE GENERATED + MULI A,4 ; (SEE HAKMEM NOTE 165) + SUBI B,1-4(A) ; ... + MOVNI A,(B) ; CALCULATE BYTE ADDRESS TO START AT, + ADD A,[DISBUF*4] ; I.E. DISBUF*4-NBYTES + IDIVI A,4 ; CONVERT TO B.P. + HRL A,(B)[441000 ? 341000 ? 241000 ? 141000] ; ... + MOVE B,[441000,,HPBUF] ; B.P. TO BUFFER +HPDSM3: ILDB C,B ; GET BYTE FROM HPBUF + JUMPE C,HPDSM4 ; ZERO BYTE TERMINATES + IDPB C,A ; PUT INTO DISBF1 + JRST HPDSM3 +HPDSM4: REST C ; RESTORE ACS + REST B ; ... + REST A ; ... + RET + + +; HPDMV1 IS JUST LIKE HPDSMV, EXCEPT THAT IT DOES NOT CLEAR. + +HPDMV1: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM2 ; YES, ALREADY THERE + MOVEI C,33 ; SEND THE START OF THE CURSOR POSITIONING + DPB C,A ; SEQUENCE + MOVEI C,"& ; ... + IDPB C,A ; ... + MOVEI C,"a ; ... + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A ; ... + JRST HPDSM1 + +];IFN HP2645 + +IFN I400,[ +SUBTTL INFOTON 400 + +I400TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) + CALL I4CPS + CALL I4CEOL + CALL I4CEOS + CALL I4CLRS + CALL I4MCLS + CALL I4DSMV + CALL I4DMV1 + CALL I4INSL + CALL I4DELL + CALL I4INSC + CALL I4DELC + CALL I4RST + +I4CPS: HRROI A,[ASCIZ /[/] ;] + PSOUT + JUMPE B,I4CPS8 ; SKIP ALL THIS FOR HOMING + HLRZ A,B ; VERTICAL POS + AOS A ; USES 1 BASED ADDRESSING + CALL I4PAR + HRRZ A,B + JUMPE A,I4CPS8 + PUSH P,A + MOVEI A,"; + PBOUT + POP P,A + AOS A + CALL I4PAR +I4CPS8: MOVEI A,"H + PBOUT + RET + +I4ESC: SAVE A + HRROI A,[ASCIZ /[/] ;] + PSOUT + REST A + PBOUT + RET + +I4PAR: SAVE B + IDIVI A,10. + JUMPE A,I4PAR1 + ADDI A,"0 + PBOUT +I4PAR1: MOVEI A,"0(B) + PBOUT + JRST CPOP2J + +I4CEOL: MOVEI A,"N + JRST I4ESC + +I4CEOS: MOVEI A,"J + JRST I4ESC + +I4CLRS: HRROI A,[ASCIZ //] ;] + PSOUT + RET + +I4MCLS: HRROI A,[ASCIZ //] ;] SET UP RIGHT MODE + PSOUT + MOVEI A,1(C) + IDIVI A,10. + LSH A,14.+1 + LSH B,7+1 + ADDI A,(B) + ADD A,[.BYTE 7 ? 33 ? "[ ? "0 ? "0 ? "H] ;] + MOVEM A,MORMCL + MOVE A,[.BYTE 7 ? 33 ? "[ ? "N] ;] + MOVEM A,MORMCL+1 + RET + +I4DSMV: MOVEI C,5 ; INDEX INTO DISBF1 + MOVE A,[.BYTE 8 ? 33 ? "[ ? "2 ? "N ] ;] + MOVEM A,DISBF1(C) + SOS C + JRST I4DMV3 ; ENTER REST OF CODE + +I4DMV1: MOVEI C,5 ; INDEX INTO DISBF1 +I4DMV3: MOVE A,DISCPH + AOS A + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,8+4 + ADD A,[.BYTE 8 ? "; ? "0 ? "0 ? "H ] + MOVEM A,DISBF1(C) + SOS C +I4DSM2: MOVEI A,1(BP) + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "[ ? "0 ? "0 ] ;] + MOVEM A,DISBF1(C) + RET + +I4INSL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSTION CURSOR TO IT +I4INS1: HRROI A,[ASCIZ //] ;]]] + PSOUT + PUSHJ P,I4PAD ;PAD THE INSERT + SOJG Q,I4INS1 ;AND LOOP IF MORE TO DO + RET + +I4DELL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSITION CURSOR TO IT +I4DEL1: HRROI A,[ASCIZ //] ;]]] HAVE TO SWITCH MODES AND BACK + PSOUT + PUSHJ P,I4PAD ;PAD FOR THE DELETION + SOJG Q,I4DEL1 ;AND LOOP IF MORE TO DO + RET + +I4PAD: MOVE A,OSPEED ;GET SPEED IN BPS (IN A TO PRESERVE C FR IDIVI) + IDIVI A,600. ;FIND NUMBER OF PADDING CHAR'S + MOVEI B,(A) + MOVEI A,177 ;PAD WITH RUBOUTS + PBOUT + SOJG B,.-1 + RET + +I4INSC: HRROI A,[ASCIZ / /] ;]] ECHH! + PSOUT + RET + +I4DELC: MOVEI A,"P + JRST I4ESC + +I4RST: HRROI A,[ASCIZ //] ;] RESET ROLL + PSOUT + RET + +] ;IFN I400 + +IFN I100,[ +SUBTTL INFOTON 100 + +I100TB: 24.,,79. ;DISPATCH VECTOR FOR I100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL I1CPS + CALL I1CEOL + CALL I1CEOS + CALL I1CLRS + CALL I1MCLS + CALL I1DSMV + CALL I1DMV1 + CALL I1INSL + CALL I1DELL + JFCL + JFCL + JFCL + +I1INSL: SKIPA A,["L] ;$L - INSERT LINE +I1DELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"f + CALL I1ESC + MOVEI A,40 + PBOUT + MOVEI A,40(BP) + PBOUT +I1INS1: MOVE A,(P) ; GET DESIRED FUNCTION AGAIN + CALL I1ESC + SOJG Q,I1INS1 + JRST CPOP1J + + +I1CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST I1ESC] + MOVEI A,"f ;ELSE SEND $f + CALL I1ESC + MOVEI A,40(B) ;+40 + PBOUT + HLRZ A,B + ADDI A,40 ;+40 + JRST I1ES1 + +I1CEOL: MOVEI A,"K ;CLEAR EOL +I1ESC: SAVE A + MOVEI A,33 + PBOUT + REST A +I1ES1: PBOUT + RET + +I1CLRS: MOVEI A,"H ;CLEAR SCREEN + CALL I1ESC +I1CEOS: MOVEI A,"J ;CLEAR EOS + JRST I1ESC + +I1MCLS: LSH C,7.+1 + ADD C,[.BYTE 7 ? 33 ? "f ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "K ? 0) + MOVEM C,MORMCL+1 + RET + +I1DSMV: SAVE B + MOVEI B,40(BP) + LSH B,16.+4 + IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "f] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST I1DSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $f ? $K + MOVEM B,DISBF1+5 + JRST CPOP2J +I1DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $f ? $K ? ... + MOVEM B,DISBF1+4 + CALL I1DMV1 + JRST CPOP2J + +I1DMV1: MOVE A,DISCPH ; GET WANTED HPOS + LSH A,8 + IORI A,(BP) ;DESIRED VPOS + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "f ? 40 ? 40] + MOVEM A,DISBF1+5 ;$f + RET +] ;I100 + +IFN TK4023,[ +SUBTTL TEKTRONIX 402 (UGH) 3 + +; Note - this currently runs with the screen (except the mode line) in +; inverse video, for greater readability. If you don't like this see +; T3CLRS for how to fix it. + +TK43TB: 24.,,77. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL T3CPS + CALL T3CEOL + CALL T3CEOS + CALL T3CLRS + CALL T3MCLS + CALL T3DSMV + CALL T3DMV1 +REPEAT 5,JFCL + +T3CPS: MOVEI A,28. + PBOUT + MOVEI A,41(B) ; X POS + PBOUT + HLRZ A,B ; Y POS + ADDI A,40 + PBOUT + RET + +T3CLRS: SAVE A + SAVE B + SAVE C + MOVEI A,33 ; ESCAPE + PBOUT + MOVEI A,^L ; FORMFEED + PBOUT + + MOVSI C,-24. ; AOBJN PTR +T3CLR1: HRLOI B,(C) ; GO TO X = -1 + CALL T3CPS + MOVEI A,31. ; SET A PROTECTED ATTRIBUTE + PBOUT + MOVEI A,"J ; NOTE - MAKE THIS "B FOR NON-INVERT SCREEN + PBOUT + AOBJN C,T3CLR1 + SETZ B, ; GO BACK HOME + CALL T3CPS + JRST POP321 + +T3MCLS: MOVE A,[[.BYTE 7 ? 28. ? 41 ? 40 ? 31. ? "@ + 33 ? "O ? 1 ? 1 ? 1 + 1 ? 28. ? 40 ? 40 ? 31. + "B],,MORMCL] + BLT A,MORMCL+3 + LSH C,1+7 + ADDM C,MORMCL+2 + LSH C,7 + ADDM C,MORMCL + RET + +T3DSMV: SAVE B + MOVE B,[[.BYTE 8 ? 28. ? 41 ? 40 ? 31. + "@ ? 33 ? "O ? 0 + 0 ? 0 ? 0 ? 28. + 41 ? 40 ? 40 ? ^H],,DISBF1+2] + BLT B,DISBF1+5 + MOVE B,DISCPH + LSH B,8 + ADDI B,(BP) + LSH B,8+4 + ADDM B,DISBF1+2 + LSH B,8 + ADDM B,DISBF1+5 + JRST CPOP2J + +T3DMV1: SAVE B + MOVE B,DISCPH ; X POS + LSH B,8. + ADDI B,40(BP) ; Y POS + LSH B,4 + ADD B,[.BYTE 8 ? 0 ? 28. ? 41 ? 0] + MOVEM B,DISBF1+5 + JRST CPOP2J + +T3CEOS: +T3CEOL: SAVE A + SAVE B + SAVE C + HRROI A,[.BYTE 7 ? 31. ? "H ? 33 ? "O] + PSOUT + SKIPN C,OSPEED ; GOTTA PAD? + JRST T3CEO1 ; ASSUME THE WORST + SETZ A, + CAIL C,4800. + HRROI A,[.BYTE 7 ? 1 ? 1] + CAIL C,9600. +T3CEO1: HRROI A,[.BYTE 7 ? 1 ? 1 ? 1 ? 1] + SKIPE A + PSOUT + MOVE B,TTLPOS ; MUST REPOSITION CURSOR + CALL T3CPS + HRROI A,[.BYTE 7 ? 40 ? ^H] + PSOUT + JRST POP321 + +] ;IFN TK4023 + +IFN ANNARB,[ +SUBTTL ANN ARBOR + +AATB: 40.,,78. ;DISPATCH TABLE FOR ANN ARBOR + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL AACPS ;NOTE: WIDTH MUST BE 78 DUE TO CRETINOUS + CALL AACEOL ;AUTO CRLF AND SCROLL AFTER WRITING IN COLUMN 79. + CALL AACEOS ;SO THE "!" MUST GO IN COLUMN 78. + CALL AACLRS + CALL AAMCLS + CALL AADSMV + CALL AADMV1 + JFCL + JFCL + JFCL + JFCL + JFCL + + +; AACPS - OUTPUT ANN ARBOR CURSOR POSITIONING COMMANDS TO TERMINAL. + +; ARGUMENT: +; B LINE,,COLUMN + +AACPS: JUMPE B,[MOVEI A,^K ; SIMPLE HOME? + PBOUT ; YES, USE HOME COMMAND INSTEAD OF ABSOLUTE + RET] ; POSITIONING + MOVEI A,^O ; SEND START OF ABSOLUTE CURSOR POSITION + PBOUT ; SEQUENCE + SAVE B ; SAVE LINE,,COLUMN + MOVEI A,(B) ; GET COLUMN NO. + IDIVI A,10. ; CONVERT TO FUNNY BCD REPRESENTATION + LSH A,4 ; ... + IOR A,B ; ... + PBOUT ; OUTPUT + HLRZ A,(P) ; GET LINE NO. + CAIL A,20. ; THIS IS WEIRD + ADDI A,12. ; ... + ADDI A,100 + PBOUT + REST B ; RESTORE CURSOR POSITION + RET + + +AACEOS: ; CLOSE ENOUGH FOR MOST THINGS +AACEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUBI C,80. ; MAKE HPOS-80 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVE B,TTLPOS + CALL AACPS + POP P,C + POP P,B + POP P,A + RET + + +AACLRS: MOVEI A,^L + PBOUT + RET + + +; AAMCLS - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED LINE AND +; CLEAR IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER +; TIME. ACTUALLY WE SIMPLY PUT THE LINE NO. IN MORMCL AND CLRMOR HAS A +; SPECIAL TEST WHICH JUMPS TO CLRM16 (SIGH). + +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +AAMCLS: MOVSM C,MORMCL + RET + +CLRM16: SAVE A + SAVE B + MOVE B,MORMCL + CALL AACPS + MOVEM B,TTLPOS + CALL AACEOL + JRST POP21J + + +; AADSMV - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +AADSMV: SETZM EOLFLG ; NO CLEARING + SKIPN HCDS(BP) ; NEED CLEARING? + SETOM EOLFLG ; YES, SET FLAG TO DO IT LATER +; FALL THROUGH TO AADMV1 + + +; AADMV1 IS JUST LIKE AADSMV, EXCEPT THAT IT DOES NOT CLEAR. + +AADMV1: SAVE B ; SAVE AC + MOVE A,DISCPH ; GET COLUMN NO. + IDIVI A,10. + LSH A,4 + IORI A,^O_8.(B) + LSH A,8. + ADDI A,100(BP) + CAIL BP,20. + ADDI A,12. + LSH A,4 ; SHIFT INTO HIGH 32 BITS OF THE WORD + MOVEM A,DISBF1+5 ; ^O COLUMN LINE + REST B ; RESTORE AC + RET + +] ; IFN ANNARB + +IFN C100,[ +SUBTTL HDS C100 +; SUPPORT FOR THE HUMAN DESIGNED SYSTEMS' CONCEPT-100 AND CONCEPT-APL +; TERMINALS. +; +; NOTES: THESE TERMINALS MUST BE IN `PROGRAMMER MODE' FOR THINGS LIKE +; CURSOR ADDRESSING TO WORK; WE ALWAYS PUT THE TERMINAL IN THIS MODE, +; WHICH IS THE CORRECT ONE FOR FULL-DUPLEX SYSTEMS, AT EACH SCREEN CLEAR, +; UNDER THE ASSUMPTION THAT THE FIRST USEFUL THING DONE BY EMACS IS TO CLEAR +; THE SCREEN. LEAVING THE TERMINAL IN THIS MODE CAN'T HURT. +; +; THE CONCEPT SERIES NEEDS A FAIR AMOUNT OF FILL CHARACTERS FOR MOST +; OF THE MORE COMPLICATED FUNCTIONS; AT WORST, 50 MS. OF FILL WOULD BE +; NEEDED (EG, FOR AN INSERT-CHARACTER FUNCTION AT THE START OF A FULL +; SCREEN). IN THIS CODE, WE'VE TRIED TO PARAMETRIZE THE FILL FACTOR +; FOR EACH FUNCTION, AND COMPUTE THE ACTUAL AMOUNT OF FILL (NULS ARE +; USED), DEPENDING ON THE SPEED. NOTE THAT WE CAN ONLY USE 79. COLUMNS +; ON THE CONCEPT, AS PROBLEMS OCCUR WITH LINE FEEDS IF AUTO-CRLF HAS +; HAPPENED ON THE LAST LINE OF THE WINDOW (IT'S TOO UGLY TO DESCRIBE +; HERE). + +C100TB: 24.,,78. ; CONCEPT DESCRIPTOR TABLE: SIZE, + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ; CAPABILITIES, + CALL CPCPS ; ROUTINES: CURSOR POSITIONING + CALL CPCEOL ; CLEAR TO END OF LINE + CALL CPCEOS ; CLEAR TO END OF SCREEN + CALL CPCLRS ; CLEAR SCREEN + CALL CPMCLS ; BUILD --MORE-- CLEARER + CALL CPDSMV ; SET UP DISBF1 FOR MOVING TO, CLEARING LINE + CALL CPDMV1 ; DITTO, BUT DON'T DO ANY CLEARING + CALL CPINSL ; INSERT SOME LINES + CALL CPDELL ; DELETE 'EM, TOO + CALL CPINSC ; INSERT A CHAR + CALL CPDELC ; AND MAYBE DELETE ONE + CALL CPTRST ; RESET THE TERMINAL (RESET WINDOW) + CALL CPWUP ; MOVE LINES VIA WINDOWING UP + CALL CPWDN ; DOWN + +; FUNCTION CODES (FOR DELAY CALCULATIONS); IF YOU EVER CHANGE THESE, CHANGE +; THE DELAY TABLE IN CPFILC, TOO. + +%FCCES==0 ; CLEAR TO END OF SCREEN, +%FCCEL==1 ; CLEAR TO END OF LINE, +%FCCLS==2 ; CLEAR SCREEN, +%FCINL==3 ; INSERT LINE, +%FCDLL==4 ; DELETE LINE + +; POSITION CURSOR TO (VERTICAL POSTION,,HORIZONTAL POSTION) IN B + +CPCPS: JUMPE B,[HRROI A, [.BYTE 7 ? 33 ? "? ? 0] ; GOING HOME IS EASY + PSOUT ; OUTPUT `$?' + RET ] ; AND GET OUT + SAVE C ; SAVE WORK REG + MOVE C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 0] ; BUILD POSITIONER IN C + HLRZ A, B ; GET VERTICAL POSITION + LSH A, 7 ; MOVE IT INTO POSITION + IORI A, (B) ; FOLLOWED BY THE HORIZONTAL + LSH A, 7+1 ; POSITION + ADD C, A ; DROP IT IN + HRROI A, C ; FINALLY, OUTPUT IT ALL + PSOUT ; ... + REST C ; GET BACK WORK REG + RET ; ALL DONE + +; CLEAR TO END OF SCREEN + +CPCEOS: + HRROI A, [.BYTE 7 ? 33 ? ^E ? 0] ; OUTPUT CLEAR-ALL TO + PSOUT ; END OF WINDOW + PUSH P, [1] ; WORST CASE ASSUMED + MOVEI A, %FCCES ; AND FILL APPROPRIATELY + CALL CPFILL ; FOR THIS FUNCTION AND SPEED + RET ; EVERYONE'S HAPPY + +; CLEAR TO END OF LINE + +CPCEOL: HRROI A, [.BYTE 7 ? 33 ? ^U ? 0] ; OUTPUT CLEAR-ALL TO + PSOUT ; END OF LINE + MOVEI A, %FCCEL ; FILL FOR THIS FUNCTION + PUSH P, [1] ; NO MULTIPLIER NEEDED + CALL CPFILL + RET ; ALL OK + +; CLEAR SCREEN ENTIRELY (SEE NOTE ABOVE) + +CPCLRS: HRROI A, [.BYTE 7 ? 33 ? "U ? ^L ? 0] ; MAGIC MUMBLE TO GO INTO + PSOUT ; `PROGRAMMER MODE' AND CLEAR SCREEN + MOVEI A, %FCCLS ; DELAY APPROPRIATELY + PUSH P, [1] ; NO MULTIPLIER + CALL CPFILL + RET + +; SET UP MORMCL TO CLEAR (--MORE--) LINE AT VERTICAL POSITION IN C + +CPMCLS: LSH C, 7+7+1 ; SHIFT POSITION TO FINAL RESTING PLACE + ADD C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 33] ; ADD IN POSITIONER + MOVEM C, MORMCL ; PUT WHERE IT'LL BE USEFUL + MOVSI C, (.BYTE 7 ? ^U) ; FINALLY, DROP IN A CLEAR TO END + MOVEM C, MORMCL+1 ; OF LINE + RET ; ALL DONE + +; *HACK* ROUTINE CALLED BY CLRMOR ROUTINE ABOVE, TO OUTPUT MORMCL, +; FOLLOWED BY APPROPRIATE DELAY. + +CLRM17: JSR SAV123 ; NEED THESE FOR WORK + MOVEI A, 101 ; STANDARD OUT PORT + HRROI B, MORMCL ; OUTPUT MORMCL + MOVNI C, 9. ; POSITION, CLEAR, AND DELAY + SOUT ; ZAP + JRST POP321 ; ALL DONE + +; SET UP DISBF1 TO MOVE TO LINE (VERTICAL POSITION) IN BP, CLEAR +; LINE, AND GO TO HORIZONTAL POSITION IN DISCPH ON THAT LINE. +; NOTE: WE'RE ASSUMING YOU DON'T NEED MORE THAN 5 OR 6 DELAYING NULS +; AT FULL SPEED FOR CLEARING-ALL TO END OF LINE. + +CPDSMV: SAVE B ; STASH WORK REG AWAY + MOVEI A, 40(BP) ; GET VERTICAL COORDINATE + LSH A, 8.+4. ; MOVE IT INTO POSITION + ADD A, [.BYTE 8. ? 33 ? "a ? 0 ? 40] ; MAKE POSITIONER + MOVSI B, (.BYTE 8. ? 33 ? ^U) ; AND CLEAR-ALL-ER TO E-O-L + SETZM DISBF1+5 ; ASSUME NO HORIZONTAL MOTION + SETZM DISBF1+4 ; ... + SKIPN DISCPH ; DO WE NEED HORIZONTAL MOTION AFTER? + JRST [ MOVEM A, DISBF1+2 ; NO, JUST DUMP IT ALL + MOVEM B, DISBF1+3 + JRST CPOP2J ] ; OUT AND RETURN + MOVEM A, DISBF1+1 ; YES, PUT DOWN POSITIONER AND CLEARER + MOVEM B, DISBF1+2 + SETZM DISBF1+3 ; MAKE SURE THE PADDING NULLS ARE THERE + MOVEI B, (BP) ; GET VERTICAL COORDINATE + LSH B, 8. ; POSITION IT + ADD B, DISCPH ; GET HORIZONTAL POSITION + LSH B, 4 ; GET INTO THE RIGHT SLOT + ADD B, [.BYTE 8. ? 33 "a ? 40 ? 40] ; FINALLY FINISH IT UP + MOVEM B, DISBF1+5 ; AND DROP IT INTO THE DISPLAY BUFFER + JRST CPOP2J ; ALL DONE + + +; SET UP DISBF1 TO MOVE TO POSITION AS CODED BY (BP, DISCPH); DON'T +; CLEAR ANYTHING. + +CPDMV1: SETZM DISBF1+3 ; CLEAR OUT UNUSED PART OF DISPLAY + SETZM DISBF1+4 ; BUFFER + MOVEI A, (BP) ; GET VERTICAL POSITION + LSH A, 8 ; MAKE ROOM FOR HORIZONTAL + IOR A, DISCPH ; POSITION + LSH A, 4 ; ACCOUNT FOR POSITION OF 4 8.-BIT BYTES + ADD A, [.BYTE 8 ? 33 ? "a ? 40 ? 40] ; BUILD POSITIONER + MOVEM A, DISBF1+5 ; AND DROP INTO ITS FINAL RESTING PLACE + RET ; ALL DONE + + +; INSERT AND DELETE C(Q) LINES (AT THE VERTICAL POSITION IN BP); ON +; CONCEPT'S, THE CURSOR DOESN'T MOVE. + + ; ENTER HERE WITH SCREEN SIZE IN A +CPINSW: SAVE B ; (USED BY CPWIN ROUTINE ONLY) + PUSH P, A ; AND PUT IT WHERE USED LATER + JRST CPINS5 ; GO JOIN COMMON CODE + +CPINSL: SAVE B ; SAVE A WORK REG + PUSH P, [24.] ; AT THIS POINT, ASSUME FULL SCREEN +CPINS5: MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + POP P, B ; GET WINDOW SIZE INTO B + SUBI B, (BP) ; AND COMPUTE NUMBER OF LINES BEING MOVED +CPINS1: HRROI A, [.BYTE 7 ? 33 ? ^R ? 0] ; FOR EACH LINE TO BE + PSOUT ; INSERTED, `$^R' DOES IT + PUSH P, B ; PASS # LINES FOR FILL ACTION + MOVEI A, %FCINL ; AND DELAY APPROPRIATELY + CALL CPFILL + HRROI A, [.BYTE 7 ? 33 ? "< ? 0] ; NOW, GO ONTO NEXT LINE + PSOUT + SOJ B, ; BUMP DOWN NUMBER OF LINES BEING SHOVED DOWN + SOJG Q, CPINS1 ; DO FOR NUMBER OF LINES REQUESTED + REST B ; GET BACK WORK REG + RET ; ALL DONE + +CPDELL: SAVE B ; SAVE A WORK REG + MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + MOVEI B, 24. ; COMPUTE NUMBER OF LINES + SUBI B, (BP) ; BEING AFFECTED +CPDEL1: HRROI A, [.BYTE 7 ? 33 ? ^B ? 0] ; DELETE A LINE + PSOUT ; ... + PUSH P, B ; PASS # LINES FOR FILL ACTION, AND + MOVEI A, %FCDLL ; WAIT FOR THIS SLOW + CALL CPFILL ; TERMINAL + SOJG Q, CPDEL1 ; DO IT NUMBER OF TIMES REQUESTED + REST B ; GET BACK WORK REG + RET + +; INSERT AND DELETE CHARACTER; THE INSERT-CHARACTER WORKS BY ACTUALLY +; ENTERING INSERT MODE, DROPPING IN A SPACE TO MAKE ROOM, AND LEAVING +; INSERT MODE; THEN, MOVE BACK OVER THE SPACE. + +CPINSC: SAVE B ; STASH WORK REGS + SAVE C ; ... + MOVEI A, .PRIOU ; PRIMARY OUT PORT + HRROI B, [.BYTE 7 ? 33 ? ^P ? 40 ? 33 ? 0 ? ^H] ; OUTPUT IT ALL + MOVNI C, 6 ; BYTE COUNT + SOUT ; OUT SHE GOES + REST C ; RESTORE WORK REGS + REST B ; ... + RET + +CPDELC: HRROI A, [.BYTE 7 ? 33 ? ^Q ? 0] ; DELETE CHARACTER IN LINE + PSOUT + RET + +; ROUTINE TO FILL (WITH NULS) APPROPRIATELY FOR ANY GIVEN FUNCTION +; (AS CODED BY %FCXXX, ABOVE). THE FUNCTION CODE IS IN A. +; CLOBBERS A. THE FILL FACTOR (E.G., NUMBER OF LINES AFFECTED) IS +; AT -1(P), AND IS PEELED OFF THE STACK. + +CPFILL: EXCH B, (P) ; GET RETURN ADDRESS, SAVE WORK REG + EXCH B, -1(P) ; GET FILL FACTOR, SAVE RETURN ADDRESS + CALL CPFILC ; COMPUTE HOW MANY NULS ARE NEEDED (TO A) + SAVE C ; GET JSYS WORK REG + MOVNI C, (A) ; GET DELAY COUNT + MOVEI A, .PRIOU ; PRIMARY OUTPUT + HRROI B, [.BYTE 7 ; LOTS OF NULLS + REPEAT 100., 0 + ] + SOUT ; OUTPUT AS MANY NULLS AS NEEDED + REST C ; RESTORE WORK REG + REST B ; DONE WITH B + RET ; DONE WITH US + + +; ROUTINE TO COMPUTE HOW MANY NULS ARE NEEDED TO FILL AFTER A GIVEN +; FUNCTION; %FCXXX CODE IS IN A, FILL FACTOR IN B. +; RETURNS RESULT IN A. + +CPFILC: MOVE A, (A) [ ; GET DELAY BASED ON CODE (>1200,,<=1200) + 48.,,1. ; CLEAR TO END OF SCREEN (%FCCES) + 6.,,1. ; CLEAR TO END OF LINE (%FCCEL) + 48.,,3. ; CLEAR SCREEN (%FCCLS) + 4.,,1. ; INSERT LINE (%FCINL) + 4.,,1. ; DELETE LINE (%FCDLL) + ] + SAVE C ; STASH WORK REGISTER + SKIPE C, OSPEED ; GET SPEED WE'RE RUNNING AT + CAILE C, 1200. ; AND IF IT'S GREATER THAN 1200 BAUD, + MOVS A, A ; USE LEFT HALF + TLZ A, -1 ; USE WHATEVER IS IN RIGHT HALF NOW + IMULI A, (B) ; MULTIPLY BY FILL FACTOR + REST C ; RESTORE WORK REG + RET ; ALL DONE, RESULT IS IN A + +; MOVE LINES AROUND ON SCREEN USING HARDWARE WINDOWING TO WIN ON SPEED. +; (SIGH; THIS CODE WILL PROBABLY BE USELESS WHEN THEY SPEED UP INSERT/ +; DELETE LINE). SEE MOVWIN ROUTINE FOR INPUTS. + +CPWDN: SAVE B ; SAVE WORK REG + MOVEI B, (BP) ; GET DESTINATION LINE (TOP LINE OF WINDOW) + MOVE A, BOTLIN ; GET # OF LINES IN + SUBI A, (B) ; HARDWARE WINDOW + CALL CPSETW ; SET UP THE WINDOW + SETZ BP, ; WANNA INSERT C(Q) LINES AT TOP OF SCREEN + CALL CPINSW ; GO INSERT THEM + CALL CPWRST ; RESET THE HARDWARE WINDOW TO WHOLE SCREEN + JRST CPOP2J ; RESTORE B AND GET OUT + +; HERE TO MOVE A GROUP OF LINES UP + +CPWUP: SAVE B ; SAVE A WORKING REGISTER + SAVE A ; SAVE JSYS WORK REGS + SAVE C + MOVE B, BP ; GET DESTINATION LINE (TOP OF NEW WINDOW) + MOVE A, BOTLIN ; GET # OF LINES + SUBI A, (B) ; IN WINDOW + CALL CPSETW ; SET THE WINDOW + MOVEI B, (A) ; GET # OF LAST LINE IN WINDOW + SUBI B, 1 ; ... + HRLZ B, B ; MAKE INTO (VPOS,,HPOS) OF LAST LINE + CALL CPCPS ; GO THERE + MOVEI A, .PRIOU ; TTY OUT PORT + HRROI B, [.BYTE 7 ; MAKE LOTS OF S WITH PADDING + REPEAT 24., ^J ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + ] + MOVNI C, (Q) ; GET NEGATIVE # OF LINES TO MOVE UP + IMULI C, 7 ; TIME # CHARS PER LINE SHIFT + SOUT ; SCROLL IT UP WITH S + CALL CPWRST ; RESET WINDOW + REST C ; GET BACK WORK REGS + REST A + JRST CPOP2J ; RESTORE B AND GET OUT + +; WINDOW-SETTING UTILITY ROUTINES +; SET UP A WINDOW; A/ # OF LINES WANTED ON SCREEN, B/ LINE # OF HOME + +CPSETW: JSR SAV123 ; SAVE WORK REGS + SAVE D + SAVE E + MOVE D, [.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 40] + MOVE E,[.BYTE 7 ? 80.+40 ? 0 ? 0 ? 0 ? 0] ; GET SKELETON + LSH B, 7+7+1 ; GET STARTING LINE AND + LSH A, 1 ; LENGTH INTO POSITION + ADD D, B ; AND DROP THEM IN + ADD D, A + MOVEI A, .PRIOU + HRROI B, D ; NOW SET THE WINDOW + MOVNI C, 10. + SOUT + REST E + REST D + JRST POP321 ; RESTORE WORK REGS + +; RESET THE HARDWARE WINDOW TO ITS FULL (?) GLORY + +CPWRST: JSR SAV123 ; SAVE WORK REGS + MOVEI A, .PRIOU + HRROI B, [.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 24.+40 ? 80.+40 ? 0 ? 0 ? 0] + MOVNI C, 10. + SOUT ; OUTPUT WINDOW-RESET SEQUENCE + JRST POP321 ; ALL DONE + + +; RESET THE WHOLE TERMINAL, UPON EXIT. + +CPTRST: SAVE B ; SAVE WORK REG + CALL CPWRST ; RESET THE WINDOW + MOVE B,TTLPOS + CALL CPCPS ; GO THERE + JRST CPOP2J ; RESTORE B AND GET OUT + +] ;C100 + +IFN IQ120,[ +SUBTTL SOROC IQ 120 + +IQ12TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL IQCPS + CALL IQCEOL + CALL IQCEOS + CALL IQCLRS + CALL IQMCLS + CALL IQDSMV + CALL IQDMV1 +REPEAT 5,JFCL + +IQCPS: JUMPE B,[ + MOVEI A,^^ ;SAVE A LITTLE FOR HOME + PBOUT + RET ] + HRROI A,[ASCIZ /=/] + PSOUT + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + PBOUT + RET + +IQCEOL: HRROI A,[ASCIZ /T/] ;CLEAR EOL + PSOUT + RET + +IQCEOS: HRROI A,[ASCIZ /Y/] ;CLEAR EOS + PSOUT + RET + +IQCLRS: HRROI A,[ASCIZ /+/] ;CLEAR SCREEN + PSOUT + RET + +IQMCLS: LSH C,14.+1 ;SETUP MORMCL TO CLEAR LINE IN C + ADD C,[.BYTE 7 ? 33 ? "= ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "T ? 0) + MOVEM C,MORMCL+1 + RET + +IQDSMV: SAVE B ;SETUP DISBF1 TO GO TO POSITION FROM BP AND DISCPH + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "T] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "=] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IQDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $= ? $T + MOVEM B,DISBF1+5 + JRST CPOP2J +IQDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $= ? $T ? ... + MOVEM B,DISBF1+4 + CALL IQDMV1 + JRST CPOP2J + +IQDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] + MOVEM A,DISBF1+5 ;$= + RET +] ;IQ120 + +IFN TK4025\ANNARB,[ +SPACES: ASCII / / +] ; IFN TK4025\ANNARB +];IFN TNX + +SUBTTL INTERRUPT HANDLERS + +IFN ITS,[ + +TSINTP: MOVEM 16,INTACS+16 ;SAVE ALL ACS. + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVE C,TSINT +TSIL: HRRZ A,TSINT+1 ;GET THE PC IN CASE THE INTERRUPT ROUTINE WANTS TO CHECK IT FOR TYIIOT + JUMPL C,TSIN2 ;INT IN SECOND WORD + TLZE C,%PJATY + JRST TSINTA + TLZE C,%PJRLT + JRST TSINTC + TLZE C,%PJWRO + TYPRE [PUR] + TRZE C,%PIMPV ;MPV => CREATE THE NONEXISTENT CORE AND RETRY. + JRST TSINT4 + TRZE C,%PIPDL + TYPRE [PDL] +TSIN2A: MOVSI 16,INTACS + BLT 16,16 + .SUSET [.SJPC,,INTJPC] + .DISMI TSINT+1 + +TSINTA: SKIPE RGETTY ;TTY GIVEN BACK TO TECO INTERRUPT. + SKIPL CLRMOD ;THIS FEATURE CAN BE DISABLED FOR DEBUGGING. + JRST TSIL + SETOM PJATY ;SAY THAT WE SHOULD CLEAR THE SCREEN AND REDISPLAY COMPLETELY. + SETOM DISOMD + JRST TSIL + +TSINTC: SETOM CLKFLG ;REAL-TIME CLOCK INTERRUPT. SAY IT'S TIME TO RUN THE HANDLER. + CAIE A,TYIIOT ;IF WE ARE NOW WAITING FOR INPUT, RUN IT RIGHT AWAY, + JRST TSIL + MOVEI A,TSINTD + MOVEM A,TSINT+1 ;BUT FIRST EXIT FROM INTERRUPT LEVEL AND RESTORE ACS. + JRST TSIL + +TSINTD: CALL RLTCLK + JRST TYIIOT + +TSINT4: SOS TSINT+1 + CAIL A,HUSED ;MPV INT: CATCH JUMPS TO RANDOMNESS. + .VALUE + .SUSET [.RMPVA,,A] ;GET ADR START OF MISSING PAGE. + LSH A,-12 + MOVE B,A + IMULI B,2000*5 + CAMGE B,QRWRT ;ALL OF IMPURE STRING SPACE MARKED AS EXISTING SHOULD + .VALUE ;REALLY EXIST, OR THERE'S A BUG. + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + SYSCAL CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,%JSELF ? %CLIMM,,-1(A) ? %CLIMM,,%JSNEW] + .LOSE %LSSYS + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +TSINT6: SKIPE DISPRR ;HANDLE INTERRUPT FROM ALTMODE + JRST TSIL ;DO NOTHING IF INSIDE ^R. + SETCMM TSINAL ;REMEMBER PARITY OF ALTMODES, + SKIPN TSINAL ;IF SECOND, STOP DISPLAYING BUFFER. + JRST [ AOS TSALTC ;COUNT NUMBER OF $$ PAIRS SEEN. + JRST TSIL] + CALL TTYAC2 ;IF FIRST ALTMODE, SAY THAT NEXT CHARACTER MUST INTERRUPT + JRST TSIL ;SO WE CAN TELL AT INT. LEVEL. WHETHER THIS IS A $$ PAIR. + +TSIN2: TRZN C,TYPIN ;SECOND WORD INTERRUPT. IS IT TYPE-IN? + JRST TSIN2A ;THAT'S ALL THERE IS. +TSINT1: MOVEI A,CHTTYI + .ITYIC A, + JRST TSIL + HRRZ CH,TSINT+1 + CAIN CH,ASLEE2 ;IF M.P. IS INSIDE A :^S, WAKE IT UP + AOS TSINT+1 ;(IT HAS ARRANGED FOR ALL CHARS TO INTERRUPT) + TRZ A,SHIFT+SHIFTL + HRRZ CH,A + ANDI CH,177 + CAIN CH,33 ;ALTMODE => MUST SEE IF FOLLOWING CHAR IS AN ALTMODE. + JRST TSINT6 + SETZM TSINAL ;ELSE TELL NEXT CHAR (IF ALTMODE) THAT PREV. CHAR. WASN'T ONE. + CAIE A,^G + CAIN A,CONTRL+"G + JRST TSINT3 ;NOW CHECK FOR ALL FORMS OF ^G. + CAIE A,CONTRL+"G+40 + JRST TSIL +TSINT3: TLNN FF,FLNOIN ;UNLESS IT IS JUST DISPLAYING, ... + SKIPE RREBEG ;DONT SET IF IN A ^R + SETOM STOPF + SKIPLE CH,NOQUIT + JRST TSIL + HRRZ A,TSINT+1 + AOJL CH,TSINT5 ;-2FSNOQUIT$ => DON'T FLUSH INPUT & OUTPUT. + SKIPE RGETTY + JRST TSINT7 ;ON DISPLAYS, CAN'T .RESET MAIN OUTPUT SINCE COULD LOSE TRACK OF SCREEN + HLRZ CH,(A) + ANDI CH,777740 + CAIN A,DISSI1 + AOSA A,TSINT+1 + CAIN CH,(.IOT CHDPYO,) ;ON PRINTING TTY DON'T RETURN TO HUNG OUTPUT .IOT + AOS A,TSINT+1 + .RESET CHDPYO, + .RESET CHTTYO, +TSINT7: .RESET CHTTYI, + SETOM UNRCHC + SETZM TYISRC ;FLUSH ANY EXECUTING KBD MACRO. + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK ;FLUSH DEFINING A KBD MACRO. + MOVE CH,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(CH) + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,TSINT+1 + MOVEI CH,CONTRL+"G ;IF NOW INSIDE ^R, STICK A ^G IN AS INPUT + SKIPN RREBEG ;INSTEAD OF SETTING STOPF (WHICH WE AVOIDED DOING). + MOVEM CH,UNRCHC + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + SKIPE RREBEG + SETOM ORESET ;SIGNAL TYPEOUT ROUTINES TO STOP TYPING +TSINT5: SKIPN RREBEG + JRST TSIL + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT, ERR, OR DO NOTHING ACCORDING TO NOQUIT. + JRST TSIL +] + +IFN TNX,[ +;^G INTERRUPT COMES HERE +TSINT: MOVEM 16,INTACS+16 ;SAVE ACS + MOVEI 16,INTACS + BLT 16,INTACS+15 +TSINT3: SKIPE B,SAVMOD ;RESTORE TTY MODE REQUESTED? + CALL FFRRT2 ;YES, DO IT THEN + TLNN FF,FLNOIN + SKIPE RREBEG ;FROM ^R? + SETOM STOPF + SKIPLE B,NOQUIT ;QUIT NOT ALLOWED? + JRST TSIL ;YES, RETURN RIGHT AWAY + MOVEI CH,CONTRL+"G + AOJL B,TSINT5 ;WANTS CLEAR INPUT? + MOVEI A,.PRIIN ;YES + CFIBF + SETOM UNRCHC ;NOTHING WAITING + SETZM TYISRC + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK + MOVE A,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(A) + SKIPE RREBEG + SETOM ORESET + SKIPN RREBEG ;IF FROM ^R, ... +TSINT5: MOVEM CH,UNRCHC ;PRETEND TO READ IT RATHER THAN SETTING STOPF + HRRZ A,INTPC1 + CAIE A,WAITX ;NOT INPUT IF RUNNING INFERIOR + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,INTPC1 ;DONT GET HUNG UP ON READING FROM TTY + SKIPN RREBEG ;RETURN IF FROM ^R + JRST TSIL + CAIN A,WAITX ;RUNNING AN INFERIOR? + JRST [ SETZM STOPF ;DON'T QUIT OUT OF FZ + MOVEM A,INTPC1 ;SAVE RETURN PC + MOVEI A,^G ;RING CHIMES + PBOUT + MOVE A,INTACS+A ;GET FORK HANDLE + FFORK ;FREEZE IT + JRST TSIL] ;DEBRK TO PROCESS TERMINATION CODE + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT IF REQUESTED +TSIL: MOVSI 16,INTACS ;RETURN + BLT 16,16 + DEBRK + +NXPINT: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI 1,.FHSLF + GTRPW + MOVEI B,(A) ;GET WORD THAT GOT PAGE FAULT + ANDI A,-1 + LSH A,-12 + IMULI B,5 + CAMGE B,QRWRT + .VALUE + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +CNTRLC: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI CH,^C + CALL ECHOCH + CALL .EXIT + JRST TSIL + +.EXIT: SKIPN SAVMOD ;UNLESS FROM INSIDE GTJFN + CALL DPYRST ;TAKE TERMINAL OUT OF DISPLAY MODE + MOVEI A,.PRIOU ;TENEX EXEC DOESNT KNOW ALWAYS KNOW + RFMOD +IFN 20X,[SKIPE PAGMOD ;WAS PAGE MODE IN EFFECT? + TROE B,TT%PGM ;YES, IS IT NOW? + CAIA + STPAR + MOVE B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE + SFPOS +] +IFN 10X,[CALL ECHOCR ;CANNOT TELL MONITOR POSITION, SO GO TO BOL + TRON B,100 ;ABOUT RESTORING ASCII DATA MODE + SFMOD + MOVEI A,.FHJOB + SETO B, ;AND JOB TERMINAL INTERRUPT MASK + STIW +] + MOVEI B,BEG .SEE CIRC + HALTF ;STOP HERE + +PAGON: SETOM PJATY ;MUST ASSUME WE MESSED UP THE SCREEN +IFN 20X,[ + SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE + JRST DOSTIW +];20X + MOVEI A,.PRIOU + RFMOD +IFN 20X,[ + LDB C,[.BP TT%PGM,B] + MOVEM C,PAGMOD ;SAVE CURRENT PAGE MODE SETTING FIRST +];20X + TRZE B,TT%PGM\TT%DAM ;MAKE SURE PAGE MODE TURNED OFF + SKIPN RGETTY ;ON DISPLAYS + JRST DOSTIW + SFMOD + STPAR + +DOSTIW: MOVEI A,.FHSLF + RPCAP + JUMPGE C,CPOPJ ;NO ^C CAPABILITY + MOVEI A,.FHJOB ;RESTORE INTERRUPT MASKS +IFN 10X,TLO A,400000 + MOVE B,[042000,,000020] ;^C & ^G + MOVE C,RRMACT+CONTRL+"T ;IF ^T NOT ASSIGNED AS COMMAND + CAIN C,RRUNDF + TRO B,100000 ;ALLOW IT AS INTERRUPT TO SYSTEM + MOVSI C,040000 ;^C DEFERRED + STIW + RET + +LEVTAB: INTPC + INTPC1 + INTPC2 +CHNTAB: 2,,TSINT ;^G +IFN 20X,3,,ASLEE2 ;ANYTHING TO WAKE FROM :^S +.ELSE 0 + 1,,CNTRLC ;CONTROL-C INTERRUPT +IFN 20X,3,,TSINTC ;CLOCK INTERRUPT + BLOCK .ICPOV-<.-CHNTAB> + 1,,[CIS ? TYPRE [PDL] ] ;PUSHDOWN OVERFLOW + BLOCK .ICTOD-<.-CHNTAB> +IFN 10X,3,,TSINTC ;10X IIT INTERRUPT + BLOCK .ICNXP-<.-CHNTAB> + 2,,NXPINT ;NEW PAGE CREATED + BLOCK 36.-<.-CHNTAB> +];END IFN TNX + +SUBTTL BIGPRINTING + +.FNPNT: +IFN ITS,[SYSCAL RFDATE,[%CLIMM,,CHFILI ? %CLOUT,,PTLFCD] + SETOM PTLFCD +] + MOVEI A,PPA + HRRM A,LISTF5 + PUSHJ P,.+1 ;PRINT THE BIGPRINT TWICE. + MOVEI A,ERDEV+DEFFN1-DEFDEV ;FN1 + CALL .FNPT2 + MOVEI A,ERDEV+DEFFN2-DEFDEV ;FN2 + CALL .FNPT2 + JRST FORMF + +;BIGPRINT THE FILENAME WHOSE ADDRESS IS IN A +.FNPT2: +IFN TNX,MOVE C,A +IFN TNX,CALL .ST26B +IFN ITS,MOVE A,(A) + PUSH P,A + TRNN FF,FRARG + PUSHJ P,PTLAB +.FN3: MOVE A,(P) + MOVEI C,4 + PUSHJ P,CRR1 + SOJN C,.-1 + MOVEI TT1,7 +.FN239: MOVEI J,3 +.FN249: SETZM B + ROTC A,6 + MOVEI T,3 +.FN259: XCT LDBT1-1(T) + IMULI B,10101 + SETZM E + TRNE TT,2 + HRLM B,E + CAIG T,1 + JRST .FN269 + TRNE TT,1 + HRRM B,E +.FN269: PUSHJ P,[JUMPN A,TYPR + CAIE T,1 ;DON'T PRINT TRAILING SPACES. + JRST TYPR + JRST SIXNTY] + IDIVI B,10101 + SOJN T,.FN259 + JUMPE A,.FN279 + MOVEI CH,40 + REPEAT 3,PUSHJ P,PPA + JRST .FN249 +.FN279: MOVE A,(P) + PUSHJ P,CRR1 + SOJN J,.FN249 + SOJN TT1,.FN239 +CPOP1J: +POPAJ: POP P,A + POPJ P, + +IFN ITS,[ +PTLAB: PUSHJ P,CRR1 + MOVE E,DEFDEV + CALL SIXNTY ;OUTPUT DEVICE NAME + MOVEI CH,": + XCT LISTF5 + MOVE E,DEFDIR + CALL SIXNTY ;AND THE SNAME + MOVEI CH,"; + XCT LISTF5 + CALL LISTF4 + .SUSET [.RUNAM,,E] + PUSHJ P,TYPR + PUSHJ P,LISTF4 + PUSHJ P,GDATIM ;GET DATE AND TIME + POPJ P, ;SYSTEM DOESN'T HAVE THEM, QUIT HERE + PUSHJ P,GLPDTM ;WIN, ALSO GET CRUD FOR PHASE OF MOON + MOVE E,TIME ;GET TIME FOR PRINTING OUT + DPB E,[301400,,CTIME+1] + LSH E,-14 + DPB E,[61400,,CTIME] + LSH E,-14 + DPB E,[301400,,CTIME] + MOVE E,CTIME + PUSHJ P,TYPR + MOVE E,CTIME+1 + PUSHJ P,SIXNTY + PUSHJ P,LISTF4 + PUSHJ P,SYMDAT ;TYPE OUT DATE + PUSHJ P,LISTF4 ;TYPE ANOTHER TAB + PUSHJ P,POM ;PUSH OUT PHASE OF MOON + SKIPG PTLFCD + POPJ P, + PUSHJ P,LISTF4 + MOVEI A,[ASCIZ \CREATED \] + PUSHJ P,ASCIND +PTLAB9: MOVEI A,"0 + HRRM A,DPT5 + TLZ FF,FLNEG +IRPS Q,R,[270400/220500/330700] + LDB C,[Q,,PTLFCD] + MOVEI TT,1 + PUSHJ P,DPT1 +IFSE R,/,[ MOVEI CH,"/ + PUSHJ P,@LISTF5 +] +TERMIN + CALL SPSP + HRRZ A,PTLFCD + LSH A,-1 +IRPS Q,R,[6:6:0] + IDIVI A,12 + PUSH P,B +IFN Q,[ IDIVI A,Q + PUSH P,B + PUSH P,["R-"0] +] +.ELSE PUSH P,A +TERMIN + MOVEI IN,10 +PTLAB3: POP P,CH + ADDI CH,"0 + PUSHJ P,@LISTF5 + SOJG IN,PTLAB3 + POPJ P, +] + +IFN TNX,[ +PTLAB: PUSHJ P,CRR1 + MOVEI A,ERDEV + CALL ASCIND + MOVEI CH,": ;DEVICE: + XCT LISTF5 + MOVEI CH,"< + XCT LISTF5 + MOVEI A,ERDEV+DEFDIR-DEFDEV + CALL ASCIND ;DIRECTORY + MOVEI CH,"> + XCT LISTF5 + CALL LISTF4 ;TYPE TAB + GJINF + MOVEI B,(A) ;LOGIN DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + HRROI A,BAKTAB + SETOB B,C + ODTIM + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + CALL POM ;INSERT PHASE OF MOON + SKIPG PTLFCD + RET + CALL LISTF4 + MOVEI A,[ASCIZ /Last written /] + CALL ASCIND + MOVE A,CHFILI +IFN 20X,[ + MOVEI B,B + MOVEI C,1 + RFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,B + GTFDB +] + HRROI A,BAKTAB + SETZ C, + ODTIM + MOVEI A,BAKTAB + JRST ASCIND + +.ST26B: SETZ A, + MOVE OUT,[440600,,A] + MOVEI IN,6 + HRLI C,440700 +.ST26C: ILDB CH,C + JUMPE CH,CPOPJ + SUBI CH,40 + IDPB CH,OUT + SOJG IN,.ST26C + RET +] + +IFN ITS,[ +AOFDIR: SYSCAL OPEN,[[.BAI,,CHRAND] ? DEFDEV ? ['.FILE.] ? [SIXBIT/(DIR)/] ? DEFDIR] + JRST OPNER1 + POPJ P, + +GFDBLK: MOVE CH,[440700,,FDRBUF] + MOVEM CH,FDRP + HRLI CH,-FDRBFL + SKIPN NOQUIT + SKIPL STOPF ;CHECK FOR QUIT; IF SO, PLAY LIKE EOF + .IOT CHRAND,CH + HRLI CH,EOFCHR_<18.-7> + HLLZM CH,(CH) + POPJ P, +] + +IFN ITS,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + PUSHJ P,FRD + PUSH P,B + SETZM PTLFCD + PUSHJ P,.FNPT2 + POP P,A + PUSHJ P,.FNPT2 + JRST FORMF +] +IFN TNX,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + SETZM PTLFCD + CALL FRD0 ;GET FILESPEC + JRST OPNER1 + PUSH P,A + MOVSI C,001000 + CALL SYMLS2 ;PRINT FILENAME + MOVSI C,000100 + CALL SYMLS2 ;AND EXTENSION + POP P,A + RLJFN ;GET RID OF IT + JFCL + JRST FORMF + +SYMLS2: HRROI A,BAKTAB + MOVE B,-1(P) + JFNS + MOVEI A,BAKTAB + JRST .FNPT2 ;AND BIGPRINT IT +] + +LDBT1: REPEAT 3,LDB TT,LDBT2-1+.RPCNT*7(TT1) + +LDBT2: REPEAT 21.,[%T1==.RPCNT/7 + %T2==.RPCNT-%T1*7 + CH5.7T(B+200+<2*%T1+5*%T2>_12.) + ] + +CH5.7T: 0 ;SP +DEFINE .. A,B,C,D,E,F,G,H + IFSN H,,[PRINTC /CH5.7T LOSE! +/] + A_31.+B_26.+C_21.+D_16.+E_11.+F_6+G_1 +TERMIN + + .. 4,4,4,4,4,0,4,, ;! + .. 12,12,12,0,0,0,0,, ;" + .. 12,12,37,12,37,12,12,, ;# + .. 4,17,24,16,5,36,4,, ;$ + .. 36,31,2,4,10,23,3,, ;% + .. 4,12,4,10,25,22,15,, ;& + .. 4,4,4,0,0,0,0,, ;' + .. 2,4,10,10,10,4,2,, ;( + .. 10,4,2,2,2,4,10,, ;) + .. 0,25,16,33,16,25,0,, ;* + .. 0,0,4,33,4,0,0,, ;+ + .. 0,0,0,0,14,4,10,, ;, + .. 0,0,0,16,0,0,0,, ;- + .. 0,0,0,0,0,14,14,, ;. + .. 0,1,2,4,10,20,0,, ;/ + .. 16,21,23,25,31,21,16,, ;0 + .. 4,14,4,4,4,4,16,, ;1 + .. 16,21,1,2,4,10,37,, ;2 + .. 16,21,1,6,1,21,16,, ;3 + .. 2,6,12,37,2,2,2,, ;4 . . . OK, BEELER? + .. 37,20,36,1,1,21,16,, ;5 + .. 16,21,20,36,21,21,16,, ;6 + .. 37,1,2,4,10,20,20,, ;7 + .. 16,21,16,21,21,21,16,, ;8 + .. 16,21,21,17,1,21,16,, ;9 + .. 0,14,14,0,14,14,0,, ;: + .. 0,14,14,0,14,4,10,, ; ; + .. 0,2,4,10,4,2,0,, ;< + .. 0,0,37,0,37,0,0,, ;= + .. 0,10,4,2,4,10,0,, ;> + .. 16,21,2,4,4,0,4,, ;? + .. 16,21,27,25,27,20,17,, ;@ + .. 16,21,21,37,21,21,21,, ;A + .. 36,21,21,36,21,21,36,, ;B + .. 16,21,20,20,20,21,16,, ;C + .. 36,21,21,21,21,21,36,, ;D + .. 37,20,20,36,20,20,37,, ;E + .. 37,20,20,36,20,20,20,, ;F + .. 16,21,20,20,23,21,16,, ;G + .. 21,21,21,37,21,21,21,, ;H + .. 16,4,4,4,4,4,16,, ;I + .. 7,1,1,1,1,21,16,, ;J + .. 21,22,24,34,22,21,21,, ;K + .. 20,20,20,20,20,20,37,, ;L + .. 21,33,25,21,21,21,21,, ;M + .. 21,21,31,25,23,21,21,, ;N + .. 16,21,21,21,21,21,16,, ;O + .. 36,21,21,36,20,20,20,, ;P + .. 16,21,21,21,25,22,15,, ;Q + .. 36,21,21,36,21,21,21,, ;R + .. 16,21,20,16,1,21,16,, ;S + .. 37,4,4,4,4,4,4,, ;T + .. 21,21,21,21,21,21,16,, ;U + .. 21,21,21,21,21,12,4,, ;V + .. 21,21,21,21,21,25,12,, ;W + .. 21,21,12,4,12,21,21,, ;X + .. 21,21,12,4,4,4,4,, ;Y + .. 37,2,4,16,4,10,37,, ;Z + .. 6,4,4,4,4,4,6,, ;[ + .. 0,20,10,4,2,1,0,, ;\ + .. 14,4,4,4,4,4,14,, ;] + .. 4,16,25,4,4,4,4,, ;^ + .. 0,4,10,37,10,4,0,, ;_ + + IFN .-CH5.7T-64.,.. ,,,,,,,69 + + +SUBTTL DISPATCH TABLES + +;^T DISPATCH TABLE +EDDPTB: +REPEAT 3., BELL ;^@ - ^B + EDCPY ;^C COPY NEXT CHAR + EDD ;^D DELETE NEXT CHAR + BELL ;^E + ED% ;^F HELP TYPE REST OF THIS LINE, CR-LF, WHAT'S BEEN DONE SO FAR + BELL ;^G QUIT (NEVER GETS HERE) + BELL ;^H + EDOV ;^I TAB, TAKE AS CHAR + EDOV ;^J LINEFEED TAKE AS CHAR + BELL ;^K + EDL ;^L COPY REST OF LINE W/O ECHO AND END EDIT + EDCR ;^M CR - END EDIT + EDN ;^N COPY THRU NEXT SPACE OR EOL + EDO ;^O DELETE THRU NEXT SPACE + EDP ;^P ENTER/LEAVE PUT(INSERT) MODE + EDQ ;^Q TAKE "T" AS CHAR ("T" IS CHAR FOLLOWING ^P IN TYPIN STRING) + EDR ;^R COPY REST OF LINE + EDS ;^S COPY TO CHAR "T" + EDT ;^T DELETE TO CHAR "T" +REPEAT 2,BELL ;^U - ^V + 400000,,EDW ;^W DELETE TO LAST SPACE +REPEAT 3, BELL ;^X - ^Z + EDALT ;^[ (ALTMODE) COPY REST WITH ECHO AND END EDIT ;] +REPEAT 4, BELL ; ^[, ^\, ^], ^^ AND ^_ + +;THE ERROR TABLE: EACH WORD HAS THE 3-CHAR MESSAGE IN LH, +;POINTER TO ASCIZ STRING IN RH. +;THE TABLE IS SORTED WITH THE 3-CHAR MESSAGE AS THE KEY. +;THE FIRST ARG TO ERRDEF IS THE 3-CHAR MESSAGE. IT MUST +;CONSIST OF 3 SIXBIT CHARACTERS. +;THE SECOND ARG TO ERRDEF IS WHAT SHOULD BE GIVEN AS THE ARG +;TO THE TYPRE MACRO. IT MUST CONSIST OF 3 SQUOZE CHARS. +;IN TECO LISTINGS, CROSS-REFS GO UNDER THE NAME WHICH +;IS THE ARG TO ERRDEF. IN CREFS, THEY ARE UNDER THE LABEL ACTUALLY +;USED, WHICH HAS AN "ER$" CONCATENATED ON TO THE FRONT. +;OF TYPRE TO CHECK FOR THEM. + +IF1 [ +ERTOTL==0 ;ON PASS 1, ERTOTL ACCUMULATES AMOUNT OF STRING SPACE NEEDED FOR MESSAGES. + ;ALSO DEFINE THE LABELS FOR THE WORDS IN THIS TABLE. +DEFINE ERRDEF A,B,C/ +ER$!B ERTOTL==ERTOTL+<5+4+.LENGTH |C|+4>/5 + BLOCK 1 +TERMIN +] + +IF2 [ +ERNEXT==ERSTRT ;ON PASS 2, PUT THE STRINGS WHERE THEY BELONG, AND THE 3-CHAR NAMES HERE. + +DEFINE ERRDEF A,B,C/ +ER$!B SIXBIT /A/ ERNEXT*5-INIQRB+1 +ERTMP==. +.=ERNEXT + .BYTE 7 + 0 + QRSTR + ERLEN==<4+4+.LENGTH |C|> + ERLEN&177 + &177 + 0 + .BYTE + ASCII |A C| +ERNEXT==. +.=ERTMP +TERMIN +] + +ERRTAB: ERRDEF [..E]..E:,Bad value in q-reg ..E (output radix) + ERRDEF [2<1]2%1:,The second argument was less than the first + ERRDEF [AFN]AFN:,Ambiguous FS flag name + ERRDEF [AOR]AOR:,Argument out of range + ERRDEF [ARG]ARG:,Bad argument + ERRDEF [AVN]AVN:,Ambiguous variable or macro name. + ERRDEF [BD"]BD%:,Bad condition after " -- should be G,L,N,E,B,C,D,A or U + ERRDEF [BEL]BEL:,A built-in ^R command called from macro signaled an error + ERRDEF [CMD]CMD:,A char that isn't a TECO command was executed + ERRDEF [CNM]CNM:,Caller wasn't a macro (it was TECO internal code) + ERRDEF [DCD]DCD:,A disabled command was executed + ERRDEF [DSI]DSI:,Damned screw infinitely + ERRDEF [ERP]ERP:,Attempted :< ... ^\ with no closing > first + ERRDEF [ESR]ESR:,Empty sort record +;[ + ERRDEF [ICB]ICB:,Illegal ^] command + ERRDEF [IEC]IEC:,Illegal "E" command + ERRDEF [IFC]IFC:,Illegal "F" command + ERRDEF [IFN]IFN:,Illegal FS flag name + ERRDEF [IQN]IQN:,Invalid q-register name + ERRDEF [ILN]ILN:,Invalid local q-register number + ERRDEF [ISK]ISK:,Invalid sort key - "^P" command + ERRDEF [KCB]KCB:,Kill currently selected buffer + ERRDEF [M^R]M%R:,Attempted to macro a meaningless number + ERRDEF [NDO]NDO:,No device open for output - try "EW" + ERRDEF [NFC]NFC:,No free channels to pop into + ERRDEF [NFI]NFI:,No file open for input - try doing "ER" + ERRDEF [NHP]NHP:,Nonexistent horizontal position + ERRDEF [NIB]NIB:,You have addressed a character not in the buffer + ERRDEF [NIM]NIM:,Not inside a macro + ERRDEF [NOP]NOP:,Specified type of IO channel hasn't been pushed + ERRDEF [NRA]NRA:,File not random access + ERRDEF [N^R]N%R:,Not in ^R - command meaningful only inside ^R + ERRDEF [PDL]PDL:,Pushdown stack full + ERRDEF [PUR]PUR:,Attempted write in pure page + ERRDEF [RDO]RDO:,Attempt to modify a read-only buffer + ERRDEF [QIT]QIT:,^G typed on TTY and FS NOQUIT$ was negative + ERRDEF [QNB]QNB:,Q-register not buffer - attempt to select a string or number + ERRDEF [QNN]QNN:,Q-register not numeric + ERRDEF [QNS]QNS:,Q-register not string or buffer + ERRDEF [QRF]QRF:,Q-regs failed, probably TECO bug + ERRDEF [QRP]QRP:,Q-register PDL overflow or underflow + ERRDEF [SFL]SFL:,Search failed + ERRDEF [SNI]SNI:,Semicolon not in iteration + ERRDEF [SNR]SNR:,There is no valid search string to repeat + ERRDEF [STL]STL:,String argument too long + ERRDEF [STS]STS:,Dispatch string too short +;[[[ + ERRDEF [TMN]TMN:,Too many macro, ^]q-register, ^]^X, or ^]^Y nestings + ERRDEF [UBP]UBP:,Unbalanced parentheses found with an FL-type command + ERRDEF [UCT]UCT:,Unseen catch tag + ERRDEF [UEB]UEB:,FL-type command encountered end of buffer. + ERRDEF [UEC]UEC:,Unexpected end of command + ERRDEF [UGT]UGT:,Unseen go-tag + ERRDEF [UMC]UMC:,Unmatched ")" or ">" as a command + ERRDEF [URK]URK:,Buffer space or library space exhausted + ERRDEF [UTC]UTC:,Unterminated conditional + ERRDEF [UTI]UTI:,Unterminated iteration or errset (missing ">"?) + ERRDEF [UVN]UVN:,Undefined variable or macro name + ERRDEF [WLO]WLO:,FS OFACCP$ when old access pointer wasn't multiple of 5 + ERRDEF [WNA]WNA:,Wrong number of arguments + +LERTAB==.-ERRTAB + +IF2 IFN ERNEXT-EREND,.ERR LOSSAGE IN ERRTAB. + +; E COMMANDS DISPATCH TABLES + +ETAB: JRST EQMRK ;? + TYPRE [IEC] ;@ + TYPRE [IEC] ;A + TYPRE [IEC] ;B + JRST UICLS ;C + JRST DELE ;D + JRST EXITE ;E + JRST EFCMD ;F + JRST EGET ;G + TYPRE [IEC] ;H + JRST EICMD ;I + JRST EJCMD ;J + TYPRE [IEC] ;K + JRST CNTRU1 ;L + JRST LISTFM ;M + JRST RENAM ;N + TYPRE [IEC] ;O + JRST BPNTRD ;P +IFN ITS,JRST ALINK ;Q +IFN TNX,TYPRE [IEC] ;Q + JRST .OPNRD ;R + TYPRE [IEC] ;S + JRST ETCMD ;T + TYPRE [IEC] ;U + TYPRE [IEC] ;V + JRST WWINIT ;W +IFN TNX,JRST EXITX ;X +.ELSE TYPRE [IEC] + JRST LISTF ;Y + JRST LISTFM ;Z + JRST PSHIC ;[ + JRST PSHOC ;\ + JRST POPIC ;] + JRST POPOC ;^ + JRST FCOPY ;_ + +LETAB==.-ETAB + +;MUST BE SORTED BY FLAG NAME + +DEFINE FLG A,B,C + .1STWD SIXBIT/A/ +IFB C,[FSNORM,,]IFNB C,[C,,]B+IFB B,A +TERMIN + +FLAGS: FLG ADLINE, ;SIZE OF LINE ADJUST FILLS (FA) + FLG ALTCOU,TSALTC,FSALTC ;# CMD STRINGS WAITING TO BE READ. + FLG BACKAR,0,FSBAKA ;RETURN ARGS OF OLD MACRO FRAME + FLG BACKDE,MACDEP,FSRNLY ;DEPTH OF MACRO PDL. + FLG BACKPC,0,FSBAKP ;RETURN RELATIVE PC OF OLD MACRO FRAME + FLG BACKQP,0,FSBAKQ ;RETURN QPDL UNWIND POINTER OF OLD MACRO FRAME + FLG BACKRE,0,FSBKRT ;RETURN CONTROL TO SPECIFIED FRAME. + FLG BACKST,0,FSBAKS ;RETURN STRING POINTER TO MACRO ON MACRO PDL. + FLG BACKTR,0,FSBAKT ;TRACES BACK THE MACRO PDL. + FLG BBIND,0,FSBBIND ;PUSH OR POP CURRENT BUFFER CONVENIENTLY. + FLG BCONS,0,FSBCON ;RETURN A NEW BUFFER. + FLG BCREAT,0,FSCRBF ;CREATE NEW BUFFER (AND SELECT IT). + FLG BKILL,0,FSKILB ;ARG = POINTER TO BUFFER TO BE KILLED. + FLG BOTHCA, ;NONZERO => SEARCHES IGNORE CASE DISTINCTIONS. + FLG BOUNDA,0,FSBOUN ;BOUNDARIES OF PART OF BUFFER BEING EDITED. + FLG BSNOLF ;NOT 0 => BACKWARD MOTION SHOULDN'T BE FOLLOWED BY A LF. + FLG CASE,CASNRM ;SET CASE-SHIFTING MODE. + FLG CASENO,CASE ;SET CURRENT CASE-LOCK STATE. +IFN TNX,FLG CCLFNA,0,FSCCLF ;RETURN STRING FOR JFN IN 1 AT NORMAL ENTRY+2 + FLG CLKINT,0,FSCLKI ;SET CLOCK INTERVAL. + FLG CLKMAC,CLKMAC ;CLOCK HANDLER ROUTINE. + FLG CTLMTA,RRCMQT ;NEGATIVE => CONTROL-META-LETTER SSELF INSERTING. + FLG DATASW,0,FSSWIT ;PDP10 CONSOLE SWITCHES. + FLG DATE,0,FSDATE ;RETURN CURRENT DATE IN DISK FORMAT. + FLG DDEVICE,DEFDEV,FSSTRR ;DEFAULT DEVICE AND FILENAMES. + FLG DDFAST,0,FSDDFS ;-1 IF DEFAULT DEVICE IS "FAST". + FLG DFILE,0,FSDFILE ;DEFAULT FILE'S NAMES, AS STRING. + FLG DFN1,DEFFN1,FSSTRR + FLG DFN2,DEFFN2,FSSTRR + FLG DFORCE, ;NOT 0 => FINISH DISPLAY DESPITE PENDING INPUT, DON'T UPDATE MODE LINE. + FLG DSNAME,DEFDIR,FSDSNM + FLG DVERSI,DEFFN3,FSDVER ;DEFAULT FN2 AS NUMBER < AND > SPECIAL + FLG DWAIT ;NONZERO => DON'T ALLOW MUCH STUFF IN TTY OUTPUT BUFFER. + FLG ECHOAC,ECHACT ;-1 => ECHO AREA IS ACTIVE (CRUFT SHOULD BE CLEARED BY ^R). + FLG ECHOCH,ECHCHR ;NONZERO => INHIBIT SCAN-ECHOING THIS ^R COMMAND. + FLG ECHODI,0,FSECDS ;(WRITE-ONLY) ECHO-MODE DISPLAY-MODE OUTPUT OF ARG. + FLG ECHOER,ERRECH ;NONZERO => TYPE ERR MSGS IN ECHO AREA. + FLG ECHOFL,ECHFLS ;NONZERO => CLEAR ECHO AREA AFTER EACH COMPLETE ^R COMMAND. + FLG ECHOLI,0,FSECLS ;# OF COMMAND LINES. + FLG ECHOOU,0,FSECOT ;(WRITE-ONLY) ECHO-MODE OUTPUT OF ARGUMENT. + FLG ERR,LASTER,FSERR ;SIGNAL AN ARBITRARY ERROR. + FLG ERRFLG,ERRFL1 ;WHEN ..B OR ..G MACROED, THIS + ;HAS 0 OR ERROR CODE OF CMD STRING JUST ENDED. + FLG ERROR,LASTER, ;ERROR CODE OF MOST RECENT ERROR. + FLG EXIT,0,FSEXIT ;DO .BREAK 16, TO INTERUPT SUPERIOR. + FLG FDCONV,0,FSDCNV ;CONVERT NUMERIC TO ASCII FILE DATES. + FLG FILEPA, ;CHAR TO PAD LAST WD OF OUTPUT FILE WITH. + FLG FLUSHED,MORFLF ;0 => NOT AFTER --FLUSHED, 1 => RUBOUT, -1 => OTHER FLUSHAGE. + FLG FNAMSY, ;0 => IF ONLY ONE FILENAME, IT IS FN2. + ;> 0 => ONLY ONE FILENAME IS FN1. + ;< 0 => ONLY ONE FNAME IS FN1, AND FN2 IS ">". + FLG GAPLEN,EXTRAC,FSRNLY ;SIZE OF GAP. + FLG GAPLOC,GPT,FSROCA ;CHAR ADDR OF GAP. + FLG HEIGHT,NVLNS,FSRNLY ;NUMBER OF LINES TO DISPLAY + FLG HELPCH, ;CHARACTER TO INVOKE "HELP" MACRO + FLG HELPMAC, ;MACRO TO CALL IF USER TYPES "HELP" KEY. + FLG HPOSIT,0,FSHPOS ;PHYSICAL POSITION OF A 2741 TYPEBALL IF IT TYPED FROM THE PREVOUS CARRET + FLG HSNAME,,FSDIRH ;HOME DIRECTORY NAME. + FLG I&DCHR,CID ;NONZERO => TRY TO USE CHAR I/D. + FLG I&DLIN,LID ;NONZERO => TRY TO INSERT AND DELETE LINES. + FLG I.BASE, ;INPUT RADIX FOR #S FOLLOWED BY ".". + FLG IBASE, ;ORDINARY INPUT RADIX. + FLG IFACCE,0,FSIFAC ;(WRITE-ONLY) SET INPUT FILE ACCESS PTR + FLG IFCDAT,CHFILI,FSFDAT ;NUMERIC CREATION DATE OF INPUT FILE. + FLG IFDEVI,ERDEV,FSSTRR ;DEVICE NOW READING FROM. +IFN ITS,FLG IFDUMP,CHFILI,FSDUMP ;FILE HAS BEEN DUMPED BIT. +IFN TNX,FLG IFFDB,CHFILI,FSIFDB ;READ OR MODIFY FILE DESCRIPTOR BLOCK + FLG IFFN1,,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING. + FLG IFFN2,,FSSTRR ;FN2 OF FILE NOW OPEN FOR READING. + FLG IFILE,0,FSIFILE ;FILENAMES OF FILE NOW READING , AS STRING. + FLG IFLENG,0,FSIFLEN ;(R-O) LENGTH OF INPUT FILE. + FLG IFMTAP,CHFILI,FSMTAP ;DO .MTAPE ON INPUT FILE. +IFN ITS,FLG IFREAP,CHFILI,FSREAP ;DON'T REAP BIT. + FLG IFSNAM,,FSSTRR ;SNAME OF FILE NOW READING FROM. + FLG IFVERS,,FSFVER ;VERSION OF FILE OPEN FOR READING. + FLG IMAGEO,0,FSIMAG ;(WRITE-ONLY) IMAGE MODE OUTPUT OF ARG + FLG INCOUN,INCHCT ;NUMBER OF INPUT CHARACTERS SO FAR. + FLG INSLEN,INSLEN ;LENGTH OF THE LAST INSERT STRING +IFN ITS,FLG JNAME,.RJNAM,FSRSYS ;GET TECO'S JNAME. +IFN TNX,FLG JNAME,0,FSGTNM + FLG LASTPA,,FSRNLY ;SET BY TECO TO 0 AFTER READING LAST PAGE OF IPUT FILE. + FLG LINES,NLINES ;NUMBER OF LINES TO DISPLAY + FLG LISPT,INITFL ;NONZERO => TECO WAS STARTED AT ALTERNATE ENTRY + ;POINT SIGNIFYING THAT SUPERIOR IS A LISP. + FLG LISTEN,0,FSLISN ;DO .LISTEN, MAYBE PROMPT VIA FS ECHOT. +IFN TNX,FLG LOADAV,0,FSLOAD ;1 MINUTE LOAD AVERAGE +IFN ITS,FLG MACHIN,,FSRNLY ;READ MACHINE NAME +IFN TNX,FLG MACHIN,0,FSMACH + FLG MODECH,MODCHG ;NONZERO SAYS MODMAC MUST BE CALLED. + FLG MODEMA,MODMAC ;NONZERO => IS MACRO TO RECOMPUTE ..J WHEN NECESSARY. + FLG MODIFI,MODIFF ;SET NONZERO WHEN BUFFER WRITTEN IN. +IFN ITS,FLG MPDISP,0,FSMPDS ;DISPLAY OUTPUT TO M.P. AREA. +IFN ITS,FLG MSNAME ;READ WORKING DIRECTORY NAME +IFN TNX,FLG MSNAME,0,FSDIRS ;READ CURRENT CONNECTED DIRECTORY + FLG NLAROW, ;<>0=> DON'T ALLOW _ COMMAND + FLG NOOPAL, ;SAY WHAT TO TO WITH ALTMODES AS COMMANDS. + ;0 => ERROR, -1 => IGNORE, 1 => LIKE ^_. + FLG NOQUIT,,FSNQIT ;0 => ^G QUITS NORMALLY. + ;POS => ^G JUST SETS STOPF; NO QUITTING. + ;NEG => ^G CAUSES ERRSETABLE "QIT" ERROR. + FLG OFACCE,0,FSOFAC ;(WRITE-ONLY) SET OUTPUT FILE ACCESS POINTER + FLG OFCDAT,CHFILO,FSFDAT ;DATE OF OUTPUT FILE (NUMERIC) + FLG OFILE,0,FSOFILE ;REAL NAMES OF LAST OUTPUT FILE CLOSED. + FLG OFLENG,0,FSOFLEN ;LENGTH OF OUTPUT FILE. + FLG OFMTAP,CHFILO,FSMTAP ;DO .MTAPE ON OUTPUT FILE. + FLG OFVERS,,FSFVER ;VERSION LAST OUTPUT FILE + FLG OLDFLU,OLDFLF ;OLD VALUE OF FS FLUSHED, IN NEXT ^R COMMAND AFTER THE FLUSHED ONE. + FLG OLDMOD,DISOMD ;LAST ..J VALUE DISPLAYED. + FLG OSPEED ;OUTPUT SPEED IN BAUD, OR 0 IF UNKNOWN. + FLG OSTECO,TNX+10X,FSVAL ;OPERATING SYSTEM, 0 => ITS, + ;1 => TWENEX, 2 => TENEX + FLG OUTPUT,OUTFLG ;-1 => OUTPUT TO FILE DISABLED. + FLG PAGENU, ;PAGE # IN CURRENT INPUT FILE. + FLG PJATY ;NONZERO => SCREEN NEEDS REFRESHING. + FLG PROMPT,PROMCH ;0, OR ASCII VALUE OF PROMPT CHAR. + FLG PUSHPT,0,FSPSPT ;DO ^V + FLG QPHOME,0,FSQPHO ;QREG PDL SLOT - WHERE IT WAS PUSHED FROM. + FLG QPPTR,0,FSQPPT ;QREG PDL PTR + FLG QPSLOT,0,FSQPSL ;QREG PDL SLOT (ARG SAYS WHICH ONE) + FLG QPUNWI,0,FSQPUN ;UNWIND QREG PDL. + FLG QUIT,STOPF ;NEGATIVE => A ^G-QUIT HAS BEEN REQUESTED. + FLG QVECTO,0,FSQVEC ;RETURN A NEW QREG VECTOR BUFFER. + FLG RANDOM,RDMNMS ;RANDOM # GENERATOR'S SEED. + FLG READON ;NON-0 => DONT ALLOW MODIFICATION OF THIS BUFFER + FLG REALAD,BEG,FSRNLY ;PHYS CHAR ADDR OF BEGINNING OF BUFFER. + FLG REFRES,REFRSH ;MACRO TO REDISPLAY WHOLE SCREEN. + FLG REREAD,UNRCHC ;-1, OR TTY CHARACTER TO RE-READ. + FLG RGETTY, ;NON-0=> DISPLAY TERMINAL + FLG RUBCRL ;NON-0 => RUBOUT AND ^D DELETE A WHOLE CRLF AT ONCE. + FLG RUNTIM,0,FSRUNT ;NUMBER OF MICROSECONDS OF CPU TIME USED + FLG SAIL,DISSAI ;NON0 => TTY ASSUMED TO PRINT SAIL CHAR SET. + FLG SEARCH,SFINDF ;VALUE RETURNED BY THE LAST SEARCH + FLG SERROR,SRCERR ;NONZERO => FAILING SERACHES ARE ERRORS EVEN IN ITERATIONS. + FLG SHOWMO,SHOMOD ;NOT 0 => FR SHOULD PRINT ..J ON PRINTING TTY. + FLG SHPOS,0,FSSHPS ;LIKE FS HPOS BUT CTL CHARS APPEAR AS ON SCREEN. + FLG SSTRING,0,FSSSTR ;CURRENT SEARCH STRING, AS A STRING. + FLG STEPDE,STEPDE ;MAXIMUM MACRO PDL DEPTH FOR STEPPING TO GO ON. + FLG STEPMA,STEPFL ;NONZERO => SINGLE STEP MACROS, LINE AT A TIME. + FLG SUPERI,SUPHND ;MACRO TO HANDLE REQUESTS FROM SUPERIOR. + FLG SVALUE,SFINDF ;VALUE RETURNED BY LAST SEARCH. + FLG TOPLIN ;1ST LINE TO USE FOR BUFFER DISPLAY. + FLG TRACE,<(.BP FRTRACE)>,FSWBIT ; -1 IFF IN TRACE MODE. + FLG TRUNCA,DISTRN ;CONTROLS TRUNCATION VS. CONTINUATION OF TYPED LINES. + ;NEGATIVE => TRUNCATE, ELSE CONTINUE. + FLG TTMODE,TTMODE +IFN 20X,FLG TTPAGM,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY. + FLG TTYOPT,,FSRNLY ;TTY'S TTYOPT VARIABLE. +IFN 20X,FLG TTYPAG,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYSMT,,FSRNLY ;TTY'S TTYSMT VARIABLE. + FLG TYIBEG,INCHRR + FLG TYICOU,INCHCT + FLG TYISIN,TYISNK ;MACRO CALLED WITH EACH INPUT CHARACTER, FOR DEFINING KBD MACRO + FLG TYISOU,TYISRC ;MACRO CALLED TO GET INPUT CHARS FROM KBD MACRO. + FLG TYOHAS,0,FSHCD ;HASH CODE OF SCREEN LINE. + FLG TYOHPO,CHCTHP,FSRNLY ;HPOS OF TYPEOUT, AT THE MOMENT. + FLG TYPEOU,TYOFLG ;-1 => NEXT TYPEOUT GOES AT SCREEN TOP. + ;ELSE TYPEOUT HAS BEEN DONE AND MORE TYPEOUT FOLLOWS IT. +IFN ITS,FLG UHSNAM,0,FSUHSN ;GET HSNAME OF A USER FROM DDT. +IFN ITS,FLG UINDEX,.RUIND,FSRSYS ;GET TECO'S JOB NUMBER. +IFN TNX,FLG UINDEX,0,FSJOBN +IFN ITS,FLG UMAILF,0,FSUML ;GET FILENAME OF A USER'S MAIL FILE FROM DDT. +IFN ITS,FLG UNAME,.RUNAME,FSRSYS ;GET TECO'S UNAME. +IFN TNX,FLG UNAME,0,FSDIR2 + FLG UPTIME,0,FSUPTI ;SYSTEM UP TIME IN 60'TH'S. + FLG UREAD,<(.BP (FLIN))>,FSBIT ;-1 IF INPUT FILE, ELSE 0. + FLG UWRITE,<(.BP (FLOUT))>,FSBIT ;-1 IFF OUTPUT FILE OPEN, ELSE 0. + FLG VARMAC, ;NONZERO => ENABLE FEATURE TO RUN MACRO WHEN VARIABLE CHANGES. + FLG VB,0,FSVB ;BEGV, BUT CAN BE PUSHED/POPPED. + FLG VERBOS,VERBOS ;<>0=> DISPLAY MOBY ERROR MESSAGES + FLG VERSIO,.FVERS,FSVAL ;VERSION NUMBER OF THIS TECO + FLG VZ,0,FSVZ ;Z-ZV, BUT CAN BE PUSHED/POPPED. + FLG WIDTH,NHLNS,FSWIDTH ;SIZE OF THE TYPED\DISPLAYED LINE + FLG WINDOW,GEA ;CHAR ADDR (REL BEGV) OF 1ST CHAR IN WINDOW + FLG WORD,0,FSWORD ;GET OR SET SOME WORD IN THE CURRNET BUFFER. +IFN ITS,FLG XJNAME,.RXJNA,FSRSYS ;INSERT .XJNAME IN BUFFER +IFN TNX,FLG XJNAME,0,FSGTNM + FLG XPROMP,RUBENC ;0, OR CHAR TO TYPE NEXT TIME DISINI DONE. +IFN ITS,FLG XUNAME,.RXUNA,FSRSYS ;INSERT .XUNAME IN BUFFER +IFN TNX,FLG XUNAME,0,FSDIR2 + FLG YDISAB, ;DISABLES Y COMMAND IN VARIOUS WAYS + FLG Z,Z,FSROCA ;# CHARS IN BUFFER (Z COMMAND IS 1 + # OF LAST CHAR IN RANGE BEING EDITED.) + FLG ^HPRIN,DISPBS ;PRINT BS AS BS? NEGATIVE => YES. + FLG ^IDISA,TABMOD ;0 => TABS INSERT 1 => ERROR -1 => IGNORE. + FLG ^LINSE,FFMODE ;NON0 => ^L'S READ FROM FILE GO IN BUFFER. + FLG ^MPRIN,DISPCR ;STRAY CR CAN COME OUT AS CR? NEGATIVE => YES. + FLG ^PCASE,PSCASE ;NONZERO => ^P SORT IGNORES CASE. + FLG ^RARG,RRRPCT ;BASIC ^R-MODE ARGUMENT (SET BY ^V) + FLG ^RARGP,RRARGP ;0 => USE 1 INSTEAD OF FS ^RARG$. + FLG ^RCCOL,RRCCOL ;COMMENT COLUMN FOR ^R MODE. + FLG ^RCMAC,0,FSCRMA ;MACROS ASSOCIATED WITH CHARS. + FLG ^RDISP,RRDISM ;MACRO TO RUN WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. + FLG ^RECHO,RRECHO ;CONTROLS ECHOING OF CHARACTERS READ IN BY ^R. + FLG ^RENTER,RRENTM ;MACROED WHEN ^R IS ENTERED. + FLG ^REXIT,0,FSCREX ;EXIT FROM ^R WHEN EXECUTED. + FLG ^REXPT,RR4TCT ;EXPONENT-OF-4, INCREMENTED BY ^U. + FLG ^RHPOS,RRHPOS ;HPOS OF CURSOR IN ^R MODE. + FLG ^RINCO,INCHRR ;TOTAL # OF INPUT CHARS, AT START OF LAST ^R COMMAND. + FLG ^RINDI,0,FSINDT ;TRACE ^R INDIRECT COMMAND DEFINITIONS. + FLG ^RINHI,RRINHI ;NONZERO INHIBITS ALL DISPLAY UPDATING. + FLG ^RINIT,0,FSCRIN ;INITIAL VALUE OF FS ^R CMACRO$ + FLG ^RINSE,0,FSRRINS ;INTERNAL ^R 1-CHAR INSERT ROUTINE. + FLG ^RLAST,RRLAST ;MOST RECENT ^R-MODE CHAR (EXCEPT ARG-SETTING CHARS) + FLG ^RLEAVE,RRLEVM ;MACROED WHEN ^R EXITS (BUT NOT IF ERR'D OR THROWN THRU) + FLG ^RMARK,RRMKPT ;THE ^R-MODE MARK, SET BY ^T. -1 => NO MARK NOW. + FLG ^RMAX,RRTTMX ;MAX # CHARS OF INSERT OR DELETE TO TYPE OUT. + FLG ^RMCNT,RRMCC1 ;THE COUNTER USED TO TELL WHEN TO CALL SEC'Y MACRO. + ;INITTED FROM FS ^RMDLY, COUNTED DOWN TO 0. + FLG ^RMDLY,RRMCCT ;# OF ^R CMDS TO DO BETWEEN INVOCATIONS OF SEC'Y MACRO. + FLG ^RMODE,DISPRR,FSRNLY ;NONZERO IN ^R MODE. + FLG ^RMORE,RRMORF ;> 0 SAYS USE --MORE-- INSTEAD OF --TOP-- IN ^R MODE. + ;< 0 SAYS USE NEITHER --MORE-- NOR --TOP--. + FLG ^RNORM,RRXINV ;THIS IS THE REAL DEFINITION OF ANY ^R-MD CHAR + ;DEFINED TO BE "SELF-INSERTING". INITIALLY + ;IS AN INTERNAL ENTRY TO FS ^RINS$. + FLG ^RPREV,RRPRVC ;THE ^R-MODE COMMAND CHAR BEFORE THE ONE IN ^R LAST. + FLG ^RREPL,RRRPLC ;CONTROLS INSERTION VS REPLACEMENT BY NORMAL CHARS. + FLG ^RRUBO,0,FSRRRUB ;INTERNAL ^R RUBOUT ROUTINE. + FLG ^RSCAN,RRSCAN ;NONZERO => ^R ON PRINTING TTY PRINTS CHARS MOVED OVER. + FLG ^RSUPP,RRALQT ;NONZERO SUPPRESSES BUILTIN COMMANDS + FLG ^RTHRO,0,FSCRTH ;THROW TO INNERMOST ^R INVOCATION. + FLG ^RUNSU,RRUNQT + FLG ^RVPOS,RRVPOS ;VPOS OF CURSOR IN ^R MODE. + FLG _DISAB,NLAROW + FLG %BOTTO, ;PERCENT AT BOTTOM BARRED TO CURSOR. + FLG %CENTE, ;PERCENT FROM TOP TO PREFERRED LOCATION FOR CURSOR (WHEN WINDOW CHOSEN) + FLG %END, ;PERCENT AT BOTTOM BARRED TO CURSOR WHEN WINDOW CHOSEN. +IFN ITS,FLG %OPLSP,<(.BP (%OPLSP))>,FSOPTL ;VALUE OF JOB'S %OPLSP BIT (SUPERIOR IS LISP). + FLG %TOCID,<(.BP (%TOCID))>,FSTTOL ;VALUE OF TTY'S %TOCID BIT. + FLG %TOFCI,<(.BP (%TOFCI))>,FSTTOL ;VALUE OF TTY'S %TOFCI BIT. + FLG %TOHDX,<(.BP (%TOHDX))>,FSTTOL ;VALUE OF TTY'S %TOHDX BIT. + FLG %TOLID,<(.BP (%TOLID))>,FSTTOL ;VALUE OF TTY'S %TOLID BIT. + FLG %TOLWR,<(.BP (%TOLWR))>,FSTTOL ;VALUE OF TTY'S %TOLWR BIT. + FLG %TOMOR,<(.BP (%TOMOR))>,FSTTOL ;VALUE OF TTY'S %TOMOR BIT. + FLG %TOOVR,<(.BP (%TOOVR))>,FSTTOL ;VALUE OF TTY'S %TOOVR BIT. + FLG %TOP, ;PERCENT OF SCREEN AT TOP BARRED TO CURSOR. + FLG %TOROL,<(.BP (%TOROL))>,FSTTOL ;VALUE OF TTY'S %TOROL BIT. + FLG %TOSAI,<(.BP (%TOSAI))>,FSTTOL ;VALUE OF TTY'S %TOSAI BIT. + FLG *RSET,UNWINF ;NONZERO PREVENTS AUTOMATIC QRP UNWINDING. + FLG .CLRMO,CLRMOD ;NONZERO => CLEAR SCREEN WHEN TTY GIVEN BACK BY SUPERIOR. + FLG .KILMO,KILMOD ;(NORMALLY NON-0) 0 MAKES FSBKILL$ A NOOP. + FLG .TYINX,0,FSTBNXT ;ILDB THAT POINTER AND RING IT AROUND TO GET NEXT OLD TYI CHAR. + FLG .TYIPT,TYIBFP,FSRNLY ;POINTER TO NEXT TYI CHARACTER IN RING BUFFER. + FLG :EJPAG,LHIPAG,FSEJPG ;# OF LOWEST PAGE IN USE BY PURE STRING SPACE +IFN TNX,FLG :ETMOD,ETMODE ;BITMASK OF FIELDS TO DEFAULT IN :ET COMMAND +FLAGSL==<.-FLAGS>/2 + +FLAGD==FLAGS+1 + + <-1>_-1 ;THIS TERMINATES THE AMBIGUITY TEST AT FSFND. + BLOCK 4 ;FOR PATCHING (HARD BUT POSSIBLE) + +IFCERR==TYPRE [IFC] + +FDTB: JRST FCTLAT ;^@ + JRST FCACMD ;^A + JRST FMEMQ ;^B +TYPIFC: IFCERR ;^C + IFCERR ;^D + JRST FCECMD ;^E + JRST FCTLF ;^F + JRST FCTLG ;^G + IFCERR ;^H + IFCERR ;^I + IFCERR ;^J + JRST FCTLK ;^K + REPEAT ^R-^K-1,IFCERR + JRST RRALTR ;^R + JRST TABSRC ;^S + REPEAT ^X-^S-1,IFCERR + JRST FCTLX ;^X + JRST FCTLY ;^Y ;[ + REPEAT 4,IFCERR ;^Z - ^] + JRST FCTLUP ;^^ + IFCERR ;^_ + IFCERR ;SPACE + IFCERR ;! + JRST FDQUOT ;" + IFCERR ;# + JRST FSCASE ;$ + REPEAT 3,IFCERR ;%-' + JRST FOPEN ;( + JRST FCLOSE ;) + JRST FNOOP ;* + JRST CTLL ;+ + REPEAT "6-"+-1,IFCERR + JRST FSIXB ;6 + REPEAT ";-"6-1,IFCERR + JRST FSEMIC ;; + JRST FLSSTH ;< + JRST FEQ ;= + IFCERR ;> + JRST FLSCMD ;? + IFCERR ;@ + JRST ADJUST ;A + JRST FBCMD ;B + JRST LOWCON ;C + JRST FDCMD ;D + JRST FECMD ;E + IFCERR ;F + JRST FGCMD ;G + IFCERR ;H + JRST FTYI ;I + JRST FJCL ;J + JRST FKCMD ;K + JRST FLCMD ;L + JRST FMCMD ;M + JRST FNCMD ;N + JRST FOCMD ;O + JRST FDATTY ;P + JRST QLEN ;Q + JRST FRCMD ;R + JRST FSET ;S + JRST FTYPE ;T + JRST FUCMD ;U + JRST FVIEW ;V + JRST FWCMD ;W + JRST FXCMD ;X + JRST FYCMD ;Y +IFE TNX,IFCERR ;Z +IFN TNX,JRST FZCMD ;Z + JRST FPUSH ;[ + IFCERR ;\ + JRST FPOP ;] + JRST FAPPRX ;^ + JRST SERCHA ;_, LIKE NORMAL _ CMD. +IFN .-FDTB-140,[PRINTX \FDTB LOSS +\] + + +DTB: HRROI B,CNTRAT ;^@ + MOVEI B,COR ;^A + HRROI B,CTLB ;^B + TYPRE [CMD] ;^C + TYPRE [CMD] ;^D + TYPRE [CMD] ;^E + HRROI B,CNTRLF ;^F + TYPRE [CMD] ;^G - TS QUIT + TYPRE [CMD] ;^H - BACKSPACE + JRST TAB ;^I - TAB + MOVEI B,CD ;^J - LINE FEED + HRROI B,DECDMP ;^K - VALRET SOMETHING + HRROI B,CTLL ;^L - FORM FEED + HRROI B,CTLM ;^M - CARR RET + HRROI B,CNTRLN ;^N + HRROI B,SYMLST ;^O + HRROI B,PSORT ;^P + TYPRE [CMD] ;^Q + HRROI B,RRENTR ;^R + HRROI B,ASLEEP ;^S + HRROI B,EDIT ;^T - EDIT + HRROI B,CNTRLU ;^U + HRROI B,CTLV ;^V + JRST CTLW ;^W + HRROI B,GMARG1 ;^X + HRROI B,GMARG2 ;^Y + HRROI B,RANDOM ;^Z + JRST ALTCMD ;ALTMODE + MOVEI B,MEXIT ;^\ + TYPRE [CMD] ;[ ;^] + HRROI B,CNTRUP ;^^ + JRST LGOGO ;^_ + + MOVEI B,SPACE ; + MOVEI B,EXCLAM ;! + MOVEI B,DQUOTE ;" + MOVEI B,CXOR ;# + HRROI B,NEWAS ;$ + HRROI B,PCNT ;% + MOVEI B,CAND ;& + JRST CD5A ;' + MOVEI B,OPEN ;( + MOVEI B,CLOSE ;) + MOVEI B,TIMES ;* + MOVEI B,PLUS ;+ + MOVEI B,COMMA ;, + MOVEI B,MINUS ;- + JRST PNT ;. + MOVEI B,SLASH ;/ +REPEAT 12,JRST CDNUM ;DIGITS 0 - 9. + JRST ACOLON ;: + MOVEI B,SEMICL ; ; + MOVEI B,LSSTH ;< + HRROI B,PRNT ;= + JRST GRTH ;> + HRROI B,QUESTN ;? + JRST ASLSL ;@ + HRROI B,APPEND ;A + HRROI B,BCMD ;B + HRROI B,CHARAC ;C + HRROI B,DELETE ;D + HRROI B,ECMD ;E + HRROI B,FCMD ;F + HRROI B,QGET ;G + HRROI B,HOLE ;H + HRROI B,INSERT ;I + HRROI B,JMP ;J + HRROI B,KILL ;K + HRROI B,LINE ;L + MOVEI B,MAC ;M + HRROI B,SERCHP ;N + MOVEI B,OG ;O + HRROI B,PUNCH ;P + HRROI B,QREG ;Q + HRROI B,REVERS ;R + HRROI B,SERCH ;S + HRROI B,TYPE ;T + HRROI B,USE ;U + HRROI B,VIEW ;V + MOVEI B,CD ;W + HRROI B,X ;X + HRROI B,YANK ;Y + HRROI B,END1 ;Z + HRROI B,OPENB ;[ + HRROI B,BAKSL ;\ + HRROI B,CLOSEB ;] + JRST ASLSL ;^ + JRST BAKARR ;_ +IFN .-DTB-140,.ERR DTB WRONG # ENTRIES. + +CONSTANTS + +PAT: +PATCH": BLOCK 200 +PATCHE": 0 + +HUSED: INFORM [TOP OF PURE]\.-1 + +LOC <.+1777>&776000 +VARIABLES +IFN .&1777, .ERR VARIABLES! + +HIMPUR:: + +;IF ^R VARIABLES DON'T FIT IN LOW IMPURE, PUT THEM HERE. +IFG +RRVARL-1777, RRVARB:: BLOCK RRVARL + +;^R-MODE COMMAND DISPATCH TABLE. POSITIVE => BUILTIN COMMAND; +;RH IS DISP. ADDR, LH IS EXTRA INFO (SECONDARY DISP. ADDR). +;NEGATIVE => IT IS STRING POINTER TO MACRO. +RRMACT: +;NON-CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRXINS ;^@ - ^G +REPEAT 3,RRINSC,,RRREPI ;^H, ^I, ^J NEVER REPLACE, REGARDLESS OF FS ^R REPLACE$ + RRXINS ;^K + RRXINS ;^L + RRCRLF,,RRREPT ;^M +REPEAT 33-^M-1,RRXINS ;^N - ^Z + RREXIT ;ALTMODE +REPEAT "A+40-ALTMOD-1,RRXINS ;^\ - ` +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS. +REPEAT 4,RRXINS ;LOWERCASE SPECIAL CHARACTERS. + RRRUB + +.SEE RRITAB ;MUST BE CHANGED WHEN THE ENTRIES BELOW ARE CHANGED. +;CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRUNDF ;CONTROL-^@ TO CONTROL-^G +REPEAT 3,200,,RRINDR ;CONTROL-BS TO CONTROL-LF. +REPEAT 2,RRUNDF ;CONTROL-^K AND CONTROL-^L. + 200,,RRINDR ;CONTROL-CR +REPEAT 33-^M-1,RRUNDF ;CONTROL-^N THROUGH CONTROL-^Z. + 200,,RRINDR ;CONTROL-ALTMODE. +REPEAT "--33-1,RRUNDF ;CONTROL-^\ TO CONTROL-, + RRCMNS ;CONTROL-MINUS +REPEAT "0-"--1,RRUNDF ;CONTROL-. TO CONTROL-/ +REPEAT 10.,RRCDGT ;CONTROL-0 THRU CONTROL-9 +REPEAT 100-"9-1,RRUNDF ;CONTROL-: TO CONTROL-? + RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + 300,,RRINDR ;^H + 300,,RRINDR ;^I + 300,,RRINDR ;^J + RRKILL ;^K + RRCTLL ;^L + RRINSC,,RRREPI ;^M + RRNEXT ;^N + RRCTLO,,RRREPT ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;^[ + RRUNDF ;^\ + RRBRC ;^] + RRUNDF ;^^ + RRUNDF ;^_ + RRUNDF ;^` +REPEAT 32,40,,RRINDR ;^ +REPEAT 4,RRUNDF ;^{ ^| ^} ^~ + RRCRUB ;CONTROL-RUBOUT. +IFN .-RRMACT-400,,.ERR + +;META CHARS: +REPEAT "-,RRXINS + RRCMNS +REPEAT "0-"--1,RRXINS +REPEAT 10.,RRCDGT +REPEAT "A+40-"9-1,RRXINS +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS INDIRECT THRU UPPERCASE. +REPEAT 5,RRXINS + +;CONTROL-META CHARS: MOSTLY SELF-INSERTING, BUT SOME ARE INDIRECT THROUGH OTHERS. +REPEAT ^H,RRXINS ;^@ THRU ^G +REPEAT 3,200,,RRINDR ;^H THRU ^J +REPEAT 2,RRXINS ;^K, ^L + 200,,RRINDR ;^M +REPEAT 33-^M-1,RRXINS ;^N TO ^Z + 200,,RRINDR ;ALTMODE +REPEAT "--33-1,RRXINS ;^\ TO COMMA + RRCMNS ;MINUS SIGN +REPEAT "0-"--1,RRXINS ;. TO / +REPEAT 10.,RRCDGT ;0 TO 9 +REPEAT "H-"9-1,RRXINS ;: TO G +REPEAT 3,300,,RRINDR ;H, I, J +REPEAT "`-"J,RRXINS ;K TO ` +REPEAT 32,40,,RRINDR ;a to z +REPEAT 200-172-1,RRXINS ;{ TO RUBOUT. + +IFN .-RRMACT-1000,.ERR + +RRMACL==1000 ;LENGTH OF RRMACT + +SUBTTL INITIAL CONTENTS OF STRING AND BUFFER SPACE + +;; BUFFER AND MACRO CALL FRAMES. MORE CAN BE CREATED, PUSHING COMMAND BUFFER UP. + +MFSTRT: REPEAT MFNUM-3, REPEAT MFBLEN-1,[ 0 ?] . + REPEAT MFBLEN, 0 +MFBUF1: MFBFR,,INIBEG ;BUFFER FRAME FOR INITIALLY SELECTED BUFFER. + REPEAT MFBLEN-2,INIBEG + 0 +MFSBUF: MFBFR,,INISRB ;THIS BUFFER HOLDS THE COMPILED SEARCH STRING. + REPEAT 4,INISRB + INISRE + 0 +MFEND1:: + +CBUF: BLOCK CBUFSZ ;COMMAND BUFFER FOR NON-^R MAIN LOOP. + +;INITIAL CONTENTS OF STRING SPACE: + +INIQRB==5*. +ERSTRT: BLOCK ERTOTL ;STRINGS FOR ERROR MESSAGES GO HERE. +EREND:: +INIDLM:: + <.BYTE 7 ? 177 ? QRSTR ? 4 ? 5 ? 0> + REPEAT ^M, ASCII / / + ASCII / + / ;CR. ENDS COMMENTS IN LISP. + REPEAT 33-^M-1, ASCII / / + ASCII / A / ;ALTMODE + REPEAT 40-33, ASCII / / ;34 THRU SPACE + ASCII / A / ;! + ASCII / A / ;" + ASCII / A / ;# + REPEAT "%-"$+1, ASCII /AA / ;$, %. + ASCII / A / ;& + ASCII / ' / ;' + ASCII / ( / ;( + ASCII / ) / ;) + ASCII / A / ;* + ASCII / A / ;+ + ASCII / / ;, + ASCII / A / ;- + ASCII /AA / ;. + ASCII . / . ;/ + REPEAT "0-"/-1, ASCII / A / + REPEAT "9-"0+1, ASCII /AA / + REPEAT ";-"9-1, ASCII / A / + ASCII / ; / + REPEAT "A-";-1, ASCII / A / + REPEAT "Z-"A+1, ASCII /AA / + REPEAT "a-"Z-1, ASCII / A / + REPEAT "z-"a+1, ASCII /AA / + REPEAT "|-"z-1, ASCII / A / + ASCII / | / + REPEAT 176-"|, ASCII / A / + ASCII / / +IFN .-INIDLM-201,.ERR WRONG TABLE LENGTH +INI..O==5*. + <.BYTE 7 ? QRBFR ? MFBUF1&177 ? MFBUF1_<-7>&177 + MFBUF1_<-14.>&177> +INISRS==5*. + <.BYTE 7 ? QRBFR ? MFSBUF&177 ? MFSBUF_<-7>&177 ? MFSBUF_<-16>&177> +INIQRW==5*. + +;INITIAL CONTENTS OF BUFFER SPACE. + +INIBUF==5*<&<-2000>> +INISRB==INIBUF +INISRE==INISRB+5*<1+STBLSZ> +INIBEG==INISRE+5 +INITOP==INIBEG+5 + +END BOOT diff --git a/src/e142/teco.mid.783 b/src/e142/teco.mid.783 new file mode 100644 index 00000000..bef5ee1f --- /dev/null +++ b/src/e142/teco.mid.783 @@ -0,0 +1,21705 @@ +; -*-MIDAS-*- + +;ITS TECO and EMACS should serve as a lesson to all +;of what can be achieved when programmers' creativity is not crushed +;by administrators whose main concern is stifling humor, +;stamping out all possibility of enthusiasm, and forbidding +;everything that isn't compulsory. +;They were produced in a humane anarchy where one man designs, +;implements, and then documents the feature that inspires him. +;They were produced by people who could laugh enough to +;name many years of effort the Incompatible Timesharing System. +;Of course, the whole story is imaginary. Working conditions +;which do not crush the spirit can't be practical. +;You can't run a team that way if you expect to meet the deadline. +;TECO doesn't really exist; you were only dreaming it. + +;ITS TECO was built by RMS on the work of others +;at the MIT Artificial Intelligence Lab +;(not to be confused with the Laboratory for Computer Science). +;It was converted to run on Twenex by MMCM at SRI. + +;TECO is available to those who like the way it is, +;on a basis of communal co-operation: +;you are welcome to make improvements, but only if you consult +;with the other user sites, and send your changes +;to MIT to be merged in and distributed to everyone. +;You owe your improvements to us in return for what you see here. +;If anyone asks you for a copy, make sure he gets in touch with +;the MIT AI Lab so he can get the latest stuff. + +.SYMTAB 8001. ;SHOULD BE PLENTY + +TITLE TECO + +; RESET THE SYSTEM CONDITIONALS NOT SPECIFIED BY /T AT ASSEMBLY TIME. +IFNDEF ITS, ITS==0 +IFNDEF 10X, 10X==0 +IFNDEF 20X, 20X==0 +IFG ITS+10X+20X-1, .FATAL TWO OPERATING SYSTEMS SPECIFIED + +; IF NO SYSTEM SPECIFIED THEN DEFAULT TO THE ONE WE'RE ASSEMBLING ON. +IFE ITS\10X\20X,[ +IFE .OSMIDAS-SIXBIT/ITS/, ITS==1 +IFE .OSMIDAS-SIXBIT/TENEX/, 10X==1 +IFE .OSMIDAS-SIXBIT/TWENEX/,20X==1 +] +IFE ITS\10X\20X, .FATAL NO OPERATING SYSTEM SPECIFIED + +TNX==:10X\20X ; TNX MEANS EITHER TENEX OR TWENEX + +IFN TNX,[ +IFNDEF EMCSDV,EMCSDV==0 ; CAUSES TRANSLATION OF TO EMACS: FOR TNX +IFNDEF INFODV,INFODV==0 +.DECSAV +IFN .OSMIDAS-SIXBIT/TENEX/,[ + IFN .OSMIDAS-SIXBIT/TWENEX/,[ + IF1 [ + .INSRT SYS:TNXDFS + .TNXDF + .INSRT SYS:TWXBTS + ]]] +] + +GLITCH==177 +ALTMOD==33 +IFN ITS,EOFCHR==3 ;PADDING CHARACTER FOR FILES. +IFN TNX,EOFCHR==0 + +IRPS AC,,FF A B C D E J BP T TT TT1 IN OUT CH Q P +AC=.IRPCNT +TERMIN + +A0==TT ;ACS FOR .I PSEUDO. +A1==TT1 + +.XCREF FF,P,A,B,C,IN,OUT,CH,T + +IFN 0,[ ;I HOPE THAT EVERYTHING THAT DEPENDS ON ORDER OF ACS +MUL: MULI: DIV: DIVI: IDIV: IDIVI: ;WILL X-REF TO ONE OF THESE. +ROTC: ASHC: LSHC: CIRC: +BLT: JFFO: +.OPEN: .RDATIM: +] + +IFN ITS,[ +CHTTYI==1 +CHFILI==3 +CHFILO==4 +CHRAND==6 ;FOR READING FILE DIRECTORIES +CHDPYO==7 ;BLOCK MODE DISPLAY OUTPUT FOR ASSEMBLED-IN ^P-CODE STRINGS. +CHERRI==11 +CHECHO==12 ;ECHO-MODE OUTPUT FOR RUBOUT. +CHECDS==13 ;FOR FS ECHO DISPLAY$ ONLY. +CHSIO==14 ;SUPER IMAGE OUTPUT. +CHTTYO==15 ;NORMAL TYPEOUT. + +TYPIN==1_ +TSMSK==%PJATY\%PJWRO\%PJRLT,,%PIPDL+%PIMPV +TSMSK1==TYPIN + +OPNLBP==220600 ;B.P. TO OPEN LOSS CODE IN CHANNEL STATUS. +];IFN ITS + +SUBTTL FLAGS IN FF + +;RIGHT HALF FLAGS + +FR==525252 ;BIT TYPEOUT PREFIX. +FRARG==1 ;THIS COMMAND HAS A POSTCOMMA ARG +FRARG2==2 ;THIS COMMAND HAS A PRECOMMA ARG +FRCLN==4 ;THIS COMMAND WAS GIVEN THE COLON MODIFIER +FRUPRW==10 ;THIS COMMAND WAS GIVEN THE ATSIGN OR UPARROW MODIFIER. +FRALT==20 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FROP==40 ;SET WHEN ARITH OP NEEDS A RIGHT ARG. +FRSYL==200 ;A SYLLABLE IS AVAIL TO USE AS RIGHT OPERAND OF ARITH OP. +FRFIND==2000 ;FA AND FILENAME READER USE THIS. +FRQMRK==4000 ;LAST COMMAND STRING HAD ERROR; "?" IN COMMAND READER PRINTS LAST FEW CHARS. +FRNOT==10000 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FRTRACE==20000 ;TRACE IN PROGRESS: PRINT TECO COMMANDS AS EXECUTED. +FRBACK==40000 ;SEARCH IN REVERSE (ARGUMENT NEGATIVE) +FRQPRN==100000 ;IN ('S SAVED FLAGS, 1 => THIS ( WAS A Q-REG NAME, SO + ;CLOSE SHOULD RETURN TO QREGXR. +FRSPAC==200000 ;IN FA, PREVIOUS CHAR WAS A SPACE. + +;LEFT HALF FLAGS + +FL==1,,525252 ;BIT TYPEOUT PREFIX +FLNEG==1 ;DPT-ING A NEGATIVE NUMBER +FLDIRDPY==2 ;SET => LAST COMMAND WAS FILE COMMAND, SO DISPLAY DIR INSTEAD OF BUFFER +FLIN==200 ;INPUT FILE OPEN. +FLOUT==400 ;OUTPUT FILE OPEN +FLNOIN==400000 ;INSIDE ^R, 1 => THIS IS A ^ V, AND SHOULD READ NO INPUT. + + +SUBTTL OPCODES AND BITS + +TYPR4=37000,, +NUUOS==1 + +CALL=PUSHJ P, +SAVE=PUSH P, +REST=POP P, +RET=POPJ P, +IFN TNX,.VALUE=HALTF + +IF1 EXPUNGE EDIT ;STUPID WORTHLESS EXTENDED INSTRUCTION GETS IN THE WAY. +EXPUNGE DMOVE,DMOVEM ;TWENEX PEOPLE ARE TEMPTED TO USE THESE AND SCREW TENEX. + +.XCREF CALL,REST,SAVE,RET + +BP7==440700 + +;BITS IN 12-BIT AND 9-BIT CHARACTERS +CONTRL==200 +META==400 +SHIFT==1000 +SHIFTL==2000 +TOP==4000 + +SUBTTL DOUBLE-DOT Q-REGS + +IFNDEF NQSETS,NQSETS==3 +NQREG==<"Z-"A+1+"9-"0+1>*NQSETS +.QCRSR==10. ;..A HOLDS CURSOR. +.QBFDS==.QCRSR+1 ;..B HOLDS MACRO EXECUTED AT END OF CMD STRING IF BUFFER DISPLAY WANTED (FLDIRDPY IS OFF) +.QCPRT==.QBFDS+1 ;..C IS UNUSED +.QDLIM==.QCPRT+1 ;..D HOLDS DISPATCH FOR FW, "B, "C, ^B IN SEARCHES. +.QBASE==.QDLIM+1 ;..E HOLDS OUTPUT RADIX FOR = AND \. (INITIALY 10.) +.QCRMC==.QBASE+1 ;..F HOLDS ^R MODE SECRETARY MACRO. +.QFDDS==.QCRMC+1 ;..G HOLDS MACRO EXECUTED AFTER COMMAND STRING TO DISPLAY FILE DIRECTORY. +.QVWFL==.QFDDS+1 ;..H IS NONZERO IF THERE HAS BEEN TYPEOUT BY PRGM (SUPPRESS BUFFER DISPLAY) +.QPT1==.QVWFL+1 ;..I HOLDS WHAT . HAD AT START OF CMD STRING. +.QMODE==.QPT1+1 ;..J HOLDS "MODE" STRING, DISPLAYED ON THE --MORE-- LINE. +.QRRBF==.QMODE+1 ;..K HAS WHAT WAS KILLED IN ^R MODE. +.QRSTR==.QRRBF+1 ;..L HOLDS MACRO EXECUTED WHEN TECO IS $G'D. +.QLOCL==.QRSTR+1 ;..M IS UNUSED +.QUNWN==.QLOCL+1 ;..N HOLDS STRING MACROED BEFORE QREG UNWOUND. +.QBUFR==.QUNWN+1 ;..O HOLDS CURRENT BUFFER. +.QERRH==.QBUFR+1 ;..P HOLDS ERROR-HANDLER MACRO. +.QSYMT==.QERRH+1 ;..Q HOLDS SYMBOL TABLE SCANNED FOR Q CONTRUCT. +.Q..Z==10.+"Z-"A ;..Z HOLDS SAME AS ..O, INITIALLY. + +.QKS==0 ;..0, ..1, ..2 USED BY ^P SORT. +.QKE==1 +.QDL==2 +.Q..0==0 ;OTHER NAMES FOR ..0, ..1, ..2 +.Q..1==.Q..0+1 +.Q..2==.Q..1+1 +.Q..3==.Q..2+1 + +IF2 [ +$QCRSR==QTAB+36.*2+.QCRSR +$QCRMC==QTAB+36.*2+.QCRMC +$QMODE==QTAB+36.*2+.QMODE +$QUNWN==QTAB+36.*2+.QUNWN +$QBUFR==QTAB+36.*2+.QBUFR +$Q..0==QTAB+36.*2+.Q..0 +$QMODE==QTAB+36.*2+.QMODE +$QERRH==QTAB+36.*2+.QERRH +] + +IFNDEF LIOPDL,LIOPDL==8 ;IO PDL SIZE (MUST BE < ITS'S) +IFNDEF FDRBFL,FDRBFL==40 ;SIZE OF FILE DIR READING BUFFER. +IFNDEF LPDL,LPDL==200 ;SIZE OF REGULAR PDL. +IFNDEF MFNUM,MFNUM==25. ;[ ;INITIAL # OF FRAMES FOR MACRO OR ^] CALLS, OR ITERATIONS. +IFNDEF MFMAX,MFMAX==105. ;MAXIMUM NUMBER OF FRAMES. +IFNDEF MFINCR,MFINCR==20. ;NUMBER OF NEW FRAMES TO ALLOCATE AT ONCE. +IFNDEF GCTBL,GCTBL==100 +IFNDEF SLPQWR,SLPQWR==20000 ;# WDS TO EXPAND IMPURE STRING SPACE BY. +IFNDEF SLPWRD,SLPWRD==400 ;# WDS TO EXPAND BUFFER GAP BY. +IFNDEF GCOFTN,GCOFTN==5*2000*10. ;# CHARS OF IMPURE STRINGS WRITTEN TO CAUSE A GC. +IFNDEF LPF,LPF==400 ;QREG PDL # WDS (2 WDS/ENTRY) +IFNDEF STBLSZ,STBLSZ==300 ;SEARCH TABLE SIZE. +IFNDEF CBUFSZ,CBUFSZ==10. ;INITIAL # WDS IN CMD BUFFER. +IFNDEF MACPSZ,MACPSZ==<2*MFMAX+8>/9 ;# WDS IN MACRO PDL (4-BIT BYTES) +IFNDEF FSPSPL,FSPSPL==20 ;LENGTH OF RING BUFFER OF POINT. +IFNDEF UTBSZ,UTBSZ==40 ;LENGTH OF I-O BUFFERS. +IFNDEF LHIMAX,LHIMAX==400 ;NUMBER OF 1ST PAGE NOT AVAIL FOR :EJ +IFNDEF TYIBSZ,TYIBSZ==20. ;RECORD LAST 60 CHARACTERS TYPED. + +SPD==60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALFWORD) + +SUBTTL MACROS + +DEFINE DBP7 A + ADD A,[70000,,] + SKIPGE A + SUB A,[430000,,1] +TERMIN + +DEFINE INSIRP A,B + IRPS ZZZ,,[B] + A,ZZZ +TERMIN TERMIN + +DEFINE CONC CONC1,CONC2 +CONC1!CONC2!TERMIN + +;ERROR MACRO: TYPRE [ERRCODE] +DEFINE TYPRE A + TYPR4 ER$!A +TERMIN + +IF2 ISKER1==TYPRE [ISK] ;"INVALID SORT KEY" ERROR, IF WITHIN A ^P COMMAND. +DEFINE ISKERR + SKIPE PSSAVP + TYPRE [ISK] +TERMIN + +;GIVEN MACPTR OR CTXPTR, SKIP IF THAT STACK IS NOT EMPTY. +DEFINE SKNTOP X + SKIPN A,X +TERMIN + +;SAY HOW ASSEMBLY IS PROGRESSING, AND HOW MUCH CORE IT TAKES SO FAR. +DEFINE INFORM A,B +IF1,[PRINTX \A = B +\]TERMIN + +;SUPPY AN ARITH OP WITHOUT A RIGHT ARG WITH 1 AS AN ARG. +;OPTIONALLY (IF FOO IS Z, O OR N) DEFAULT NO ARG TO AN ARG OF 1, +;PERHAPS SETTING OR CLEARING THE ARGUMENT FLAG (IF FOO IS O OR Z) +DEFINE ARGDFL FOO ;FOO SHOULD BE "O", "Z", "N" OR NULL. +IFNB FOO,TR!FOO!E FF,FRARG + TRZE FF,FROP + CALL ARGDF0 +TERMIN + +SUBTTL SYSTEM-DEPENDENT MACROS TO REDUCE CONDITIONALS ELSEWHERE + +IFN ITS,[ +DEFINE TSOPEN A,B + .OPEN A,B + .LOSE %LSFIL + TERMIN + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN + +DEFINE UTFARG +DEFDEV ? DEFFN1 ? DEFFN2 ? DEFDIR TERMIN + +DEFINE 4WDARG (START) +START ? START+1 ? START+2 ? START+3 TERMIN + +;MAKE NEXT TTY INPUT NOT WAIT FOR AN ACTIVATION CHARACATER. +DEFINE TTYACT + CALL TTYAC1 +TERMIN + +;WAIT FOR OUTPUT TO FINISH; RETURN # CHARS OF AVAILABLE INPUT IN AC "X". +DEFINE LISTEN X + .LISTEN X, +TERMIN + +DEFINE CIS + .SUSET [.SPICL,,[-1]] +TERMIN + +DEFINE CLOSEF X + .CLOSE X, +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT. + MOVE Q,[-<<.LENGTH /STRING/+4>/5>,,[ASCIC /STRING/]] +TERMIN +] + +IFN TNX,[ +DEFINE TTYACT +TERMIN + +DEFINE STRCNC STR1,STR2 +ASCIZ \STR1!STR2\ +TERMIN + +DEFINE LISTEN X +IFN X-1,SAVE 1 +IFN X-2,SAVE 2 + MOVEI 1,.CTTRM + SKIPE DWAIT + DOBE + SIBE + SKIPA X,2 + SETZ X, +IFN X-2,REST 2 +IFN X-1,REST 1 +TERMIN + +DEFINE CLOSEF X + MOVE 1,X + CLOSF + JFCL + SETZM X +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT + HRROI Q,[ASCIZ /STRING/] +TERMIN + +IFNDEF .FNAM3,.FNAM3==.FVERS +] + +SUBTTL DISPLAY VARIABLES + +LOC 41 + JSR UUOH +IFN ITS,JSR TSINT +IFN ITS,LOC 100 +IFN TNX,LOC 140 ;DONT GET SMASHED BY LINK VARIABLES + +RGETTY: 0 ;TCTYP VARIABLE OF TTY. +TTYOPT: 0 ;TTYOPT VARIABLE OF TERMINAL. +TTYSMT: 0 ;TTYSMT VARIABLE OF TERMINAL. +OSPEED: 0 ;OUTPUT LINE SPEED IN BAUD, OR 0 IF UNKNOWN. +NVLNS: 0 ;# VERTICAL LINES ON CONSOLE +NHLNS: 0 ;# HORIZONTAL POSITIONS ON CONSOLE +USZ: 0 ;# VERTICAL LINES USABLE FOR DISPLAY. MUST FOLLOW NHLNS. +IFN USZ-NHLNS-1,.ERR +NELNS: 0 ;# ECHO LINES (NVLNS-USZ). USUALLY 3, SET BY FS ECHO $ +MXNVLS==100. +MXNHLS==160. +TOPLIN: 0 ;# OF 1ST LINE OF SCREEN TO USE FOR BUFFER DISPLAY. +NLINES: 0 ;# LINES OF BUFFER TO DISPLAY, 0 => DEFAULT + ; (2 ON TTYS, AS MANY AS WILL FIT ON DISPLAYS) +VSIZE: 0 ;# OF LINES FOR VBD TO USE (SAME AS NLINES, OR THE DEFAULT # OF LINES). +BOTLIN: 0 ;# OF 1ST LINE BELOW WINDOW. +RRTOPM: 0 ;BOTTOM OF "TOP MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %TOP) +RRBOTM: 0 ;TOP OF "BOTTOM MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %BOTTOM) +DISTRN: 0 ;-1 => TRUNCATE LINES, ELSE CONTINUE THEM. +DISPCR: 0 ;-1 => STRAY CR REALLY DOES A CR. + ;IF NOT OUTPUT AS CR, IT IS OUTPUT AS UPARROW-M. + ;ALSO SIMILARLY CONTROLS WHETHER STRAY LF'S ARE OUTPUT AS LF OR ^-J. +DISPBS: 0 ;-1 => ^H OUTPUT AS BS. OTHERWISE IT IS OUTPUT AS UPARROW-H. +DISSAI: 0 ;ASSUME CTL CHARS ARE 1-POSITION GRAPHICS INSTEAD OF PRINTING AS ^-MUMBLE. +LID: 0 ;NONZERO => TRY TO USE INSERT/DELETE LINE TO MOVE TEXT AROUND. +CID: 0 ;NONZERO => USE CHAR I/D FOR SIMPLE ^R INSERT/DELETE COMMANDS +IFN ITS,[ + .BYTE 8 ;STRINGS TO OUTPUT IN SUPERIMAGE OUTPUT MODE: +EXPUNG DISCPV DISC1V DISCPH MORMCV +DISCMV=,. ;SET CURSOR AND CLEAR LINE. + %TDMV0 ? DISCPV: 0 ? 0 ? %TDEOL +DISCM1=,. ;SET CURSOR, DON'T CLEAR LINE. + %TDNOP ? %TDMV0 ? DISC1V: 0 ? DISCPH: 0 + .BYTE 7 +MORMCL=,. + ^P ? "V ? MORMCV: 0 ? ^M ? ^P ? "L ? ^C ? ^C ? ^C ? ^C + .BYTE +IFN 700000&(DISCPH),[ ;IF MIDAS DEFINED ALL THE TAGS 1 BYTE TO SMALL, FIX THEM UP. +IRPS XX,,DISCPV DISCPH DISC1V MORMCV +.AOP IBP,1,XX +EXPUNGE XX +XX=IFN .AVAL1-1,[.AVAL1] .ELSE [.AVAL2] ; KLUDGE FOR KL'S +TERMIN +]] ;IFN ITS +DISVP: -1 ;VERT POS. OF LAST LINE GIVEN TO DISLIN, REGARDLESS OF + ;WHETHER THE LINE ACTUALLY HAD TO BE IOTTED. + ;(-1 ==> JUST WENT TO TOP OF SCREEN) + ;IF DISLIN SEES IT IS HACKING SAME LINE AS PREVIOUS + ;CALL TO DISLIN, IT DOESN'T CLEAR THE LINE. +DISVP1: 0 ;VERT. POS. OF MAIN PRGM AREA TTY CURSOR. + ;TO MOVE TO LINE , DO AN LF INSTEAD OF + ;THE USUAL ^PV. +DISFLF: 0 ;-1 ==> FORCE DISLIN TO SET CURSOR POS. + +CHCTBP: 0 ;BP. FOR CHCT TO STUFF CHARS. +CHCTVS: 0 ;LAST +1 LINE FOR CHCT TO USE (= BOTLIN EXCEPT DURING TYPEOUT ON PRINTING TTY) +CHCTHP: 0 ;POSITION IN TYPED LINE (FOR CONTINUATION AND TABS) +CHCTCF: 0 ;-1 ==> LAST CHAR GIVEN TO CHCT WAS ^M. +CHCIGN: 0 ;-1 => OUTPUTTING TRUNCATED PORTION OF LINE. +CHCTAD: 0 ;CHCT PUSHJ'S @. WITH EACH LINE. +CHCTVP: 0 ;VERT. POS. OF THAT LINE. +CHCTHC: 0 ;HASH CODE OF THAT LINE. +CHCTBL: 0 ;WHEN @CHCTAD CALLED, THIS HOLDS CHAR ADDR 1ST CHAR + ;IN THE LINE BEING DISPLAYED. (ASSUMING THAT + ;DISAD WAS CALLED WITH IN HOLDING ADDR + ;OF THE CHAR AFTER THE ONE BEING OUTPUT.) +CHCTNL: 0 ;WHEN @CHCTAD CALLED, THIS WD >0 => CHAR ADDR + ;1ST CHAR TO APPEAR ON NEXT SCREEN LINE (IF ANY) + ;-1 => NEXT CALL TO @CHCTAD WILL BE ON SAME SCREEN LINE. +CHCRHP: 0 ;WHEN @CHCTAD CALLED, THIS IS HPOS AT WHICH TTY CURSOR WILL BE LEFT (FOR SCPOS) +CHCOVP: 0 ;WHEN @CHCTAD CALLED, INDICATES A STRAY ^M OR ^H WAS JUST IOTTED. +ORESET: 0 ;OUTPUT STOPPED BY QUIT NOW IN PROGRESS +MORFLF: 0 ;USER HAS FLUSHED TYPEOUT (1 => WITH RUBOUT, -1 => WITH OTHER CHAR) +OLDFLF: 0 ;GETS VALUE OF MORFLF WHEN TYPEOUT IS UN-FLUSHED AGAIN (RETURN TO ^R, ETC). +MORESW: 0 ;0 => NO --MORE-- OR ANYTHING. 1 => --BOT--. 2 => --TOP--. 3 => --MIDDLE--. +MS%UP==1 ;VALUES 0, 1, 2 AND 3 ARE MADE OF THESE 2 BITS. +MS%DWN==2 ;MS%UP MEAN'S THERE'S TEXT ABOVE THE SCREEN; MS%DWN, THAT THERE'S TEXT BELOW. + ;IF IT'S 3 THEN THE LH IS THE PERCENTAGE OF THE FILE ABOVE SCREEN. +MS%MOR==4 ;4 MEANS THAT --MORE-- IS BEING DISPLAYED. +MS%FLS==5 ;5 MEANS THAT --MORE--FLUSHED IS BEING DISPLAYED. +DISOMD: -1 ;WHAT $QMODE HAD WHEN LAST DISPLAYED. + ;IF $QMODE NE DISOMD, MUST REDISPLAY THE MODE. +MODCHG: 0 ;POSITIVE => ..J NEEDS TO BE RECOMPUTED, SO RUN MODMAC. + ;NEGATIVE => IT IS -2* A FS QP PTR$. IF POP PAST THERE, MUST RUN MODMAC. +MODMAC: 0 ;NON-0 => IT IS MACRO TO RECOMPUTE ..J WHEN IT IS ABOUT TO BE DISPLAYED. +TYOFLG: -1 ;>= 0 ==> TYPEOUT INITTED. +ECHACT: 0 ;-1 => SOMETHING WAS PRINTED IN THE ECHO AREA, SO ^R SHOULD CLEAR IT. FS ECHO ACTIVE$ +ECHFLS: 0 ;NONZERO TO ENABLE THE ECHACT FEATURE. FS ECHO FLUSH$. +ECHCHR: 0 ;-1 => LAST COMMAND HAS TYPED OUT, SO ^R SHOULDN'T ECHO IT. + ;OTHERWISE, IT IS CHARACTER OR STRING TO ECHO. + ;(PRINTING TERMINALS ONLY). +RUBENC: 0 ;NONZERO => IS CHAR OR STRING TO TYPE BEFORE TYPING ANYTHING ELSE + ;(EG, \, AFTER A RUBOUT IN ^R IN SCANNING MODE). FS XPROMPT$. +BSNOLF: 0 ;-1 => BACKWARD MOTION AND RUBBING OUT SHOULDN'T DO LF'S (PRINTING TTY ONLY). +DISADP: 0 ;WHEN DISAD IS CALLED, THIS SHOULD HOLD C(PT)+1. + ;USED BY DISAD TO DECIDE WHEN TO OUTPUT CURSOR. + +IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER. + +IFN TNX,[ +EOLFLG: 0 ;KLUGE FLAG FOR TERMINALS WITH NO CLEOL +SGTTYP: 0 ;PLACE TO SAVE GTTYP TERMINAL INDEX +VT1BUF:: ;USED ALSO BY VT100 FOR SCROLLING COMMANDS +HPBUF: BLOCK 4 ;BUFFER FOR HP CURSOR MOTION COMMANDS +DISBF1: BLOCK 6 ;HOLDS STUFF TO SET CURSOR POS FOR THE LINE IN DISBUF. +] +IFN ITS,[ ;DISBF1 AND DISBUF IOTTED AT ONCE. +DISBF1: BLOCK 2 ;IF NO CURSOR MOTION NEEDED, THIS HOLDS %TDNOP (0 ON TENEX). +] +DISBUF: BLOCK DISBFL ;BUFFER FOR TEXT TO BE IOTTED TO TTY. +DISBFC: 0 ;# CHARS SPACE LEFT IN DISBUF. + +DISPRR: 0 ;NON0 => PDL LEVEL AT RRDISP. + ;CAUSES CRSR POS AT PT TO BY REMEMBERED, ETC. +GEA: 0 ;-1, OR OLD ADDR (REL TO BEG) OF 1ST CHAR OF BUFFER DISPLAYED. +%TOP: 10. ;PERCENT OF SCREEN CURSOR SHOULDN'T ENTER AT TOP. +%BOTTO: 10. ;SIMILAR, FOR BOTTOM. +%CENTE: 40. ;PERCENT FROM TOP CURSOR SHOULD GO WHEN WINDOW CHANGES. +%END: 30. ;WHEN WINDOW MOVED, CURSOR MUST BE >= THIS MUCH FROM BOTTOM. +CLRMOD: -1 ;-1 => CLEAR SCREEN IN DISTOP IF TTY + ;HAD BEEN TAKEN AWAY AND RETURNED BY TECO'S SUPERIOR. + ;0 => DON'T DO THAT. + ;1 => DISABLE ALL SCREEN-CLEARING, EWVEN BY ^L AND F+ +PJATY: -1 ;-1 => WE JUST GOT A %PJATY INT, SO SHOULD REDISPLAY WHOLE SCREEN SOON. +REFRSH: 0 ;NONZERO => MACRO IT WHEN WANT TO CLEAR SCREEN DUE TO PJATY + ;(INSTEAD OF MACROING FS ^R DISPLAY$). +VREMEM: 0 ;NON0 WHEN DISPLAYING STUFF THAT'S IN BUFFER. +RRINHI: 0 ;NON-0 INHIBITS ALL DISPLAY UPDATING (FS ^R INHIBIT$) +TTMODE: 0 ;NON-0 => DISPLAY BUFFER AFTER CMD STRINGS EVEN IF PRINTING TTY. +HCDS: BLOCK MXNVLS ;HASH CODES OF LINES ON SCREEN +HCDSE: 0 + +LINBEG: BLOCK MXNVLS ;1 WD / LINE ON SCREEN, SET BY VBD AS FOLLOWS: + ;BITS 3.9 - 1.1 -- CHAR ADDR OF 1ST CHAR ON THE LINE + ;BITS 4.9 - 4.1 -- HPOS THAT CHARACTER STARTED IN. +DWAIT: 0 ;WAIT FOR OUTPUT TO FINISH BETWEEN LINES, TO AVOID BUFFERING UP LOTS OF STUFF. +DFORCE: 0 ;FORCE DISPLAY TO FINISH DESPITE PENDING INPUT. DON'T UPDATE MODELINE. +SHOMOD: 0 ;ON PRINTING TTY, FR TYPES OUT ..J IF THIS IS NONZERO. + +SUBTTL ITS FILE AND INTERRUPT VARIABLES + +IFN ITS,[ +TIME: 0 ;TIME IN SIXBIT +DATE: 0 ;DATE IN SIXBIT +PDTIME: 0 ;# SECONDS SINCE BEGINNING OF YEAR +LPDTIM: 0 ;LOCALIZED " +YEAR: 0 ;YEAR AND FLAGS +CDATE: SIXBIT/ 00,19/ +CTIME: SIXBIT / : : / +0 + +INTJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU WERE INTERRUPTED FROM +UUOJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU UUO'D FROM, IF IT WAS ILLEGAL MUUO. + +TSINT: 0 + 0 + .SUSET [.RJPC,,INTJPC] + JRST TSINTP + +INTACS: BLOCK 20 + +TTYST1: 322020,,202020 ;ACTIVATE ON ^C (AND OTHER RANDOM CTL CHARS) + ;OUTPUT CTL CHARS IN IMAGE MODE. +TTYST2: 332033,,300220 ;ACT. ON ^G (^S), RUB, ALT; INT. ON ^G (^S) ,ALTMODE; OUTPUT CR IN IMAGE. +TTYSTS: 0 ;3RD ARG FOR TTYSET. +DEFDEV: 0 ;DEFAULT FILENAMES. DEFAULT DEVICE INITTED TO MACHINE NAME. +DEFFN1: SIXBIT /@/ +DEFFN2: SIXBIT />/ +DEFFN3==DEFFN2 ;GENERATION NUMBER IS THE SAME AS SECOND FILENAME +DEFDIR: 0 ;CURRENT SNAME. +ERDEV: 0 ;LIKE EIDEV BUT FOR DEV BEING READ. +RUTF1: 0 ;REAL FILE NAMES +RUTF2: 0 ;ON READ +ERSNM: 0 ;AND SNAME BEING READ. +ROUDEV: 0 ;REAL FILE NAMES OF LAST OUTPUT FILE EXPLICITLY CLOSED. DEVICE NAME. +ROUFN1: 0 ;FN1 OF IT. +ROUFN2: 0 ;FN2 OF IT. +ROUSNM: 0 ;SNAME OF IT. + +MACHIN: 0 ;SIXBIT NAME OF MACHINE. + +FDRBUF: BLOCK FDRBFL ;BUFFER FOR READING FROM CHRAND. +FDRBFE: _29. +FDRP: 0 ;BYTE POINTER TO FDRBUF + +CHPOPX: TRNE\TRNN T,1 ;SEE IF THIS PUSHED IOCHNL IS THE RIGHT DIRECTION +GCHN2: CAIN E,. ;DON'T USE CHNL AS TEMP + ;IF ITS THE ONE WE WANT TO POP INTO. + +IOP: -LIOPDL,,IOPDL-1 ;POINTER TO LOCAL IO PDL +IOPDL: BLOCK LIOPDL ;LOCAL IO PDL +];IFN ITS + +SUBTTL TWENEX FILE AND INTERRUPT VARIABLES + +IFN TNX,[ +JNAME: 0 ;JOB NAME -- SET BY FS TTYINIT$ + NFKS==10 ;NUMBER OF SUBFORKS THERE CAN BE AT ONE TIME (NOT COUNTING EXECFK). +EXECFK: -1 ;FORK HANDLE FOR EXEC (FZ$ := PUSH) +RUNFRK: 0 ;FORK HANDLE OF CURRENTLY RUNNING PROCESS (WITHIN FZ). +FRKTAB: BLOCK NFKS ;TABLE OF FORK HANDLES, INDEXED BY FZ ARGUMENT NUMBER +NAMTAB: BLOCK NFKS ;TABLE OF NAMES OF FORKS, PARALLEL TO FRKTAB +INTACS: BLOCK 20 ;SAVE ACS ON INTERRUPTS +INTPC: 0 ;INTERRUPT SAVED PCS FOR THE THREE LEVELS. +INTPC1: 0 +INTPC2: 0 +BOOTP: 0 ;P SAVED HERE TO BE DUMPED IN EJ FILES (SINCE SSAVE DOESN'T SAVE ACS). +DISCPH: 0 ;STARTING HPOS FOR THIS LINE +FCITYI: 0 ;HIGH ORDER BITS ARENT PARITY (CROCK NEEDED FOR DM1520) +IFN 20X,[ +PAGMOD: 0 ;NON-ZERO => LEAVE TERMINAL IN PAGE MODE (FOR ^S/^Q) +] +ITTYMD: BLOCK 3 ;PLACE TO SAVE INITIAL TTY MODES TO RESTORE BEFORE CALLING SUBFORK. +ECHOP: -1 ;ARE WE IN ECHO AREA? +ECHOF2: 0 ;MUST TECO EXPLICITLY ECHO INPUT? +ECHOL0: 0 ;VPOS OF FIRST LINE OF ECHO AREA +ECHOPS: 0 ;CURRENT POSITION IN ECHO AREA +ECODPF: 0 ;FS ECHO DISPLAY: WAS ^P LAST CHARACTER SEEN? +ECODPS: 0 ;SAVED POSITION FOR ^PS IN ECHO AREA +SAVMOD: 0 ;SFMOD TO BE RESTORED ON ^G INTERRUPT (FOR :ET), ELSE 0 +TTLPOS: 0 ;REAL SCREEN POSITION (INTERNAL RFPOS/SFPOS EQUIVALENT) +OPNJFN: 0 ;JFN BEFORE OPENF +CHFILI: 0 ;INPUT FILE JFN +CHFILO: 0 ;OUTPUT FILE JFN +DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE + 0 +DEFDIR: BLOCK 20 ;DIRECTORY NUMBER +DEFFN1: ASCII /FILE/ ;DEFAULT TO SOMETHING RANDOM + BLOCK 17 ;NAME +DEFFN2: BLOCK 20 ;EXTENSION +DEFFN3: 0 ;GENERATION NUMBER +ERDEV: BLOCK 63 ;SAME FORMAT - LAST READ FILE'S NAME +ROUDEV: BLOCK 63 ;DITTO - REAL OUTPUT FILENAMES +ETMODE: 37 ;BITMASK OF FIELDS TO DEFAULT FOR :ET COMMAND +CCLJFN: 0 ;JFN IN 1 IF STARTED AT NORMAL ENTRY+2 +INIOP: -LIOPDL,,INIPDL-1 ;INPUT I/O PDL POINTER +INIPDL: BLOCK LIOPDL ;INPUT I/O PDL +OUTIOP: -LIOPDL,,OUIPDL-1 ;OUTPUT I/O PDL POINTER +OUIPDL: BLOCK LIOPDL ;OUTPUT I/O PDL +MORMCL: BLOCK 4 ;CLEAR MORE LINE +SAV123: 0 ;JSR HERE TO SAVE AC'S 1 2 AND 3 ON THE STACK + SAVE A + SAVE B + SAVE C + JRST @SAV123 + +%TOERS==40000 ;CAN SELECTIVELY ERASE +%TOHDX==20000 ;HALF DUPLEX (BOUND TO LOSE SOMEWHERE) +%TOMVB==10000 ;CAN BS +%TOSAI==4000 ;SAIL CHAR SET +%TOSA1==2000 ;USE SAIL CHAR SET +%TOOVR==1000 ;CAN OVERWRITE +%TOMVU==400 ;CAN MOVE THE CURSOR UP +%TOMOR==200 ;MORE PROCESSING +%TOROL==100 ;ROLL +%TOLWR==20 ;HAS LOWERCASE KEYBOARD +%TOFCI==10 ;HAS 12 BIT INPUT CAPABILITY +%TOLID==2 ;HAS LINE I/D +%TOCID==1 ;HAS CHAR I/D +] +;[ + +SUBTTL RCH, CHARACTER SYNTAX TABLES, ^] + +UUOQ: 0 +UUOH: 0 + MOVEM Q,UUOQ + LDB Q,[331100,,40] + CAIN Q,TYPR4_-33 + JRST ETYP2A +IFN ITS,.SUSET [.RJPC,,UUOJPC] + MOVE Q,UUOQ + .VALUE + TYPRE [DSI] + +SKRCH: SKIPG COMCNT + TYPRE [UEC] +RCH: SOSGE COMCNT + JRST RCH2 ;NOTE RCH2 LOOKS AT OUR RETURN ADDRESS. + ILDB CH,CPTR + XCT RCHDTB(CH) ;DO SPECIAL STUFF OR JFCL.. +TRACS: POPJ P,TYOS ;OR JRST TYOS IN TRACE MODE. + SKIPN MACPTR ;RCHDTB ENTRY SKIPS IF SHOULD CHANGE CHAR'S CASE. + XORI CH,40 ;BUT NEVER CHANGE CASE OF CHARS IN MACROS. + JRST TRACS + +;[[[[ +RCHDTB: REPEAT 33,JFCL +RCHALT: JFCL ENDARG ;OR JRST IF SHOULD END A ^]^X + REPEAT ^]-34,JFCL +RCHBRC: JRST CTLBRC ;^] + REPEAT "?-^],JFCL + SKIPL RCHSFF ;@ + REPEAT 26.,SKIPL CASE ;UPPER CASE LETTERS + REPEAT 5,SKIPL RCHSFF ;[\]^_ + JFCL ;` + REPEAT 26.,SKIPG CASE ;LOWER CASE LETTERS. + REPEAT 5,JFCL ;{|}~ +IFN .-200-RCHDTB, .ERR RCHDTB WRONG SIZE. + +SQUOTP: 0 ;;SIGN => READING SUPER-QUOTED MACRO. + ;4.8 => READING DELIMITER-PROTECTED MACRO. +DLMF2: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT 4.8 OF SQUOTP SHOULD BE SET +SQUOF2: 0 ; " " " " " " SIGN OF SQUOTP " " " +BRC1CF: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT ONLY ONE CHARACTER SHOULD BE GOBBLED +BRCUAV: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THE Q-REGISTER + ;SHOULD BE USED AS A NUMERIC VALUE (IE. ASCII VALUE) + +BRC1: 0 ;[ ZERO => HANDLE ^] NORMALLY + ;[[[[[; -1 => DO-NOT EXPAND MACROS, BUT HANDLE ^]^],^]$,^]^V,AND ^]^Q NORMALLY +BRCFLG: 0 ;[ ;SET TO -1 BY ^]'S THAT INSERT UNPREDICTABLE STUFF. + ;[ ;SET IT TO 0 AND TEST IT LATER TO SEE IF ANY ^]'S HAVE HAPPENED. + ;[ ;ALSO, ^]^V LEAVES THE CHARACTER HERE ON RETURN, AS IT WAS + ;BEFORE BEING TRUNCATED TO 7 BITS. + +CASE: 0 ;DESIRED INPUT CASE. + ;0 => LEAVE CASE OF CHARS ALONE, + ;<0 => WANT CHARS IN LOWER CASE, + ;>0 => WANT CHARS IN UPPER CASE. + ;NEGATED BY CASE-SHIFT AND CASE-LOCK CHARS. +CASNRM: 0 ;NORMAL CASE - REINIT. CASE AT START OF CMD STRING. + ;THIS IS WHAT FSCASE SETS. +CASDIS: 0 ;NONZERO => PUT CASESHIFTS IN OUTPUT. +CASSFT: -1 ;CASE-SHIFT CHAR, OR -1 IF NONE. +CASLOK: -1 ;CASE-LOCK CHAR, OR -1 IF NONE. +RCHSFD: 0 ;SAVED NORMAL CONTENTS OF RCHDTB ENTRY FOR + ;CASE-:SHIFT CHAR (RCHDTB ENTRY NOW IS ) +RCHLOD: 0 ;SAVED NORMAL RCHDTB ENTRY FOR CASE-LOCK CHAR. +RCHSFF: 0 ;-1 => LAST CHAR WAS A CASE-SHIFT. + ;USED TO CAUSE A CASE SHIFT TO QUOTE ITSELF. + +SUBTTL ADDRESS SPACE ORGANIZATION + +;;; THE 1ST 2 PAGES ARE THE "LOW IMPURE", CONTAINING SPECIAL-PURPOSE VARIABLES. +;;; THEN COMES THE PURE CODE, FROM "INIT" TO "HUSED". +;;; THEN COMES THE HIGH IMPURE, STARTING WITH A FEW SPECIAL-PURPOSE VARIABLES, +;;; FOLLOWED BY THE ^R COMMAND DISPATCH TABLE. + +;;; THEN COME THE DYNAMICALY ALLOCATED AREAS: +; THE COMMAND BUFFER IS USED FOR OLD-FASHIONED (NON-^R) TECO TOP-LEVEL COMMAND READIN. +CBUFLO: 10740,,CBUF ;SET TO BP -> BOTTOM OF COMMAND BUFFER. +CBUFH: CBUF+CBUFSZ-1 ;-> LAST WD OF COMMAND BUFFER + +; IMPURE STRING SPACE CONTAINS STRINGS AND BUFFERS' POINTER-STRINGS. +; BOTH START WITH A FLAG CHARACTER (QRSTR OR QRBFR, RESPECTIVELY), FOLLOWED +; BY 3 CHARACTERS HOLDING A NUMBER. IN A STRING, THAT NUMBER IS THE LENGTH, +; INCLUDING THE FOUR HEADER CHARACTERS, AND THE DATA FOLLOWS THE NUMBER. +; IN A BUFFER POINTER-STRING, THE NUMBER IS THE ADDRESS OF THE BUFFER'S FRAME. +; EITHER KIND OF OBJECT IS REPRESENTED IN QREGS, AS VALUES, ETC. BY A NUMBER +; WHICH IS THE CHARACTER ADDRESS RELATIVE TO THE START OF THE SPACE, PLUS SETZ. +QRBUF: INIQRB ;CHAR ADDR START OF IMPURE STRING SPACE +QRWRT: INIQRW ;CHAR ADDR 1ST CHAR ABOVE IMPURE STRING SPACE. +QRSTR==177 ;PREFIX CHAR FOR STRING (FOLLOWED BY 3 CHARS HOLDING + ;21-BIT SIZE OF STRING INCLUDING 4 HEADER BYTES, FOLLOWED BY TEXT). +QRBFR==176 ;PREFIX CHAR FOR BUFFER POINTER (FOLLOWED BY 3 CHARS + ;HOLDING ADDR OF POINTER-BLOCK (IN MACRO-FRAME SPACE)). + +; THEN COMES A GAP, CONTAINING NON-EXISTENT MEMORY, FOLLOWED BY BUFFER SPACE. +; EVERY BUFFER'S DATA AREA IS A SUBSET OF BUFFER SPACE, AND BUFFER SPACE +; IS USED FOR NO OTHER PURPOSE. +; BUFFER SPACE STARTS AND ENDS ON WORD BOUNDARIES, BUT BUFFERS NEED NOT START ON THEM. +; EACH BUFFER ENDS ON A WORD BOUNDARY, AND IS FOLLOWED BY ONE UNUSED WORD, +; WHICH IS INCLUDED IN BUFFER SPACE. ASIDE FORM THOSE UNUSED WORDS, EVERY WORD +; IN BUFFER SPACE CONTAINS PART OF AT LEAST ONE BUFFER. +; BUFFER DATA IS POINTED TO BY BUFFER FRAMES (SEE MFBFR), +.SEE BEG ; OR, FOR THE CURRENT BUFFER, BY BEG, ETC. +BFRBOT: INIBUF ;CHAR ADDR BOTTOM OF BUFFER SPACE (= BEG OF LOWERMOST BUFFER) +BFRTOP: INITOP ;CHAR ADDR TOP OF BUFFER SPACE (> Z OF UPPERMOST BUFFER) + +; THE MEMORY ABOVE BUFFER SPACE CAN CONTAIN ^P-SORT TABLES. IT CAN +; ALSO CONTAIN RANDOM DATA USED ENTIRELY WITHIN A SINGLE COMMAND. +MEMT: <1777+INITOP/5>_-10. ;NUMBER OF 1ST PAGE OF NXM ABOVE BUFFER SPACE. + +; ABOVE THE RANDM DATA THERE IS A GAP, RUNNING TO THE TOP OF MEMORY OR TO THE +; BEGINNING OF PURE STRING SPACE, WHICH STRETCHES DOWN FROM THE TOP OF MEMORY. +; OBJECTS IN PURE STRING SPACE LOOK LIKE OBJECTS IN IMPURE STRING SPACE, AND +; ARE POINTED TO BY NUMBERS WHICH ARE SETZ PLUS THE ABSOLUTE CHARACTER ADDRESS. +LHIPAG: LHIMAX ;LOWEST PAGE IN USE BY PURE STRING SPACE. + +INSINP: 0 ;WHILE INSERTING, PDL LEVEL AT INSLUP, ELSE 0. +INSLEN: 0 ;LENGTH OF THE LAST STRING INSERTED OR SEARCHED FOR. +TOTALC: 0 ;# CHARS AT END OF GAP NOT YET USED BY INSERT. +INSRCH: 0 ;INSN FOR INSERT TO XCT TO GET A CHAR. +INSDLM: 0 ;THE DELIMITER FOR THIS INSERT +INSBP: -1 ;NORMALLY -1 => NO ACTION. + ;INSERT AND FCECMD SET IT TO 0, SIGNALLING RCH + ;THAT BP SHOULD BE SAVED IN INSBP IF THERE IS A CHANCE + ;THAT A GC WILL OCCUR (EG IF PUSMAC IS CALLED). + ;BFRRLC WILL THEN RELOCATE INSBP AS A BYTE POINTER + ;EVENTUALLY RCH WILL COPY INSBP BACK TO BP AND ZERO INSBP. + +;VARIABLES DESCRIBING THE CURRENTLY SELECTED BUFFER. +BFRSTR: SETZ INI..O-INIQRB ;INTERNAL VERSION OF $QBUFR; + ;-> POINTER-STRING OF CURRENT BUFFER. +BFRPTR: MFBUF1 ;-> BUFFER FRAME FOR CURRENT BUFFER (IN MACRO-FRAME SPACE). +BEG: INIBEG ;CHARACTER ADDRESS OF BEGINNING OF BUFFER +BEGV: INIBEG ;CHAR ADDR BEGINNING OF AREA BEING EDITED. +PT: INIBEG ;CHARACTER ADDRESS OF "POINTER" +GPT: INIBEG ;CHARACTER ADDRESS OF THE BEGINNING OF THE GAP +ZV: INIBEG ;CHAR ADDR 1ST CHAR AFTER AREA BEING EDITED. +Z: INIBEG ;CHARACTER ADDRESS OF FIRST CHARACTER AFTER BUFFER +EXTRAC: 0 ;SIZE OF GAP (# CHARS) + JRST SUPCMD ;START TECO HERE TO REQUEST SPACE IN BUFFER, ETC. +SUPARG: 0 ;HOW MUCH SPACE IS WANTED. RETURNS WITH .BREAK 16,100000 +MODIFF: 0 ;NONZERO IFF THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. + ;SET BY WRITING; CAN BE SET OR CLEARED BY USER. +READON: 0 ;NON-0 DISALLOWS MODIFYING THIS BUFFER; CAN BE SET OR CLEARED BY USER + +;VARS ASSOCIATED WITH COMPUTATION OF NUMERIC ARGUMENTS. +LEV: 0 ;DEPTH IN PARENTHESES. +NUM: 0 +SARG: 0 ;ARG BEFORE COMMA FOUND HERE IF FRARG2 FLAG SET. +DLIM: ADD C,SYL ;THIS INSN SET BY ARITH OPS. +SYL: 0 +OSYL: 0 +IBASE: 10. ;INPUT RADIX FOR NUMBERS NOT FOLLOWED BY "." +I.BASE: 8 ;INPUT RADIX FOR NUMBERS FOLLOWED BY ".". + +;VARS USED BY TYPE-IN, AND LIS. +TYIBUF: BLOCK TYIBSZ ;BUFFER WHICH HOLDS LAST TYIBSZ*3 INPUT CHARACTERS. +TYIBFP: 441400,,TYIBUF +TYISNK: 0 ;MACRO TO BE CALLED WITH EACH TYPED-IN CHARACTER (BUT NOT REREAD ONES) + ;IN ADDITION TO PROCESSING THE CHARACTER NORMALLY. FOR DEFINING MACROS. +TYISRC: 0 ;NONZERO => MACRO TO SUPPLY "TYPE-IN" CHARACTERS. FOR EXECUTING MACROS. + +ECHOFL: 0 ;NONZERO => SYSTEM ECHOING IS TURNED ON. +LTYICH: 0 ;LAST CHAR READ FROM TTY, FOR DETECTING $$. +UNRCHC: -1 ;-1, OR CHARACTER TO BE RE-READ. +INCHCT: 0 ;NUMBER OF CHARACTERS READ FROM TTY SO FAR. +INCHRR: 0 ;VALUE OF INCHCT AT LAST TIME THROUGH RRLP1. + ;INCHCT-INCHRR IS LENGTH OF THIS ^R COMMAND IN INPUT CHARS. +HELPMA: 0 ;FS HELP MAC$: NONZERO => MACRO TO RUN WHEN "HELP" KEY IS TYPED. +HELPCH: TOP+"H ;FS HELP CHAR$: CHARACTER TO INVOKE HELP MACRO +PROMCH: "& ;THE PROMPT-CHARACTER; FS PROMPT $. 0 => NO PROMPTING. +CMFLFL: 0 ;-1 READ COMMAND OR INIT FILE +;[[ +CTLBRF: 0 ;-1 IF READING CHARACTER AFTER A ^] OR ^]^Q (IN TECO CMD STRING). +CBMAX: 0 ;LENGTH OF WHAT IS NOW IN CBUF. +SAVCMX: 1 ;CBMAX OF LAST CBUF STRING THAT WAS LONGER THAN 3 WORDS. +SAVCW1: 0 ;AND 1ST 3 WDS OF THAT CMD STRING. +SAVCW2: 0 ;THESE VARS COPIED BACK INTO CBMAX, CMD BUFFER, +SAVCW3: 0 ;AND CPTR BY LISCY (^Y AS FIRST CHAR TYPED) +SAVCPT: 0 ;(SAVED CPTR) SO IT CAN RESTORE LAST LONG COMMAND. + +FSPSPB: BLOCK FSPSPL ;RING BUFFER OF PT. +FSPSPP: 4400,,FSPSPB-1 ;RING BUFFER POINTER, -> LAST USED ENTRY. + +LISTF5: CALL . ;XCT THIS TO OUTPUT A CHARACTER. +DPT5: MOVEI CH,40 ;RH HAS CHARTO PAD A PRINTED NUMBER WITH. + +SUBTTL MACRO CALL FRAMES + +;MACRO AND ITERATION HANDLING LIST STRUCTURE: +;EACH CELL HAS MFBLEN WORDS. +;LISTS ARE LINKED THRU THE LAST WORD. +;THE FIRST 2 WORDS ARE RELOCATED BY GC. +;POINTERS TO NON-FREE BLOCKS ACTUALLY POINT TO THE +;LAST WORD OF THE BLOCK. + +MFBLEN==7 ;# WORDS PER CELL. + +;[ ;MACRO OR ^] INVOKATION LIST... +;(POINTED TO BY MACPTR) +MFCCNT==0 ;COMCNT +MFCPTR==1 ;CPTR +MFCSTR==2 ;CSTR +MFARG1==3 ;MARG1 +MFARG2==4 ;MARG2 +MFPF==5 ;MACSPF +MFLINK==6 ;MACPTR + ;LH HAS SAVED LH(MACBTS). + +;[[[ ;^]^X READ CELL. ^]^X IS A SPECIAL KLUDGE TO ALLOW STRING ARGUMENTS + ;TO BE READ FROM THE PREVIOUS COMMAND STRING LEVEL. IT TRIES TO BE + ;CLEVER ABOUT WHAT IT DOES WHEN OTHER ^] STRINGS ARE ENCOUNTERED WHILE + ;SCANNING FOR THE END OF THE ARGUMENT, DEFINED BY THE FIRST + ;ENCOUNTERED THAT ISN'T PROTECTED AGAINST TRIPPING THE CATCH (IE., BY QUOTING IT)> +;THESE CELLS FORM A LIST POINTED TO BY CTXPTR. + ;COMCNT + ;CPTR + ;CSTR + ;MARG1 + ;MARG2 + ;UNUSED. +;[ ;CTXPTR + +;ITERATION OR ERRSET (:< -- >)CELL +;THESE FORM A LIST POINTED TO BY ITRPTR. + ;COMCNT + ;CPTR + ;CSTR +MFICNT==3 ;ITERCT +MFMACP==4 ;MACPDP +MFPF==5 ;LH OF THIS WORD HAS RH OF P, RH HAS RH OF PF. + ;AS THEY WERE WHEN THE < WAS EXECUTED. + ;ITRPTR + +;BUFFER FRAME - DISTINGUISHED BY NEGATIVE 1ST WORD OF BLOCK. +MFBBTS==760000 ;THESE ARE ALL THE BITS IN MFBEG WORDS. +MFBFR==400000 ;1 => THIS IS A BUFFER FRAME. +MFMARK==200000 ;GC MARK BIT FOR BUFFER FRAME. +MFQVEC==100000 ;BIT INDICATING MARK THRU THE WORDS OF THIS BUFFER +MFMODIF==040000 ;1 => THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. +MFREADO==020000 ;1 => DONT ALLOW MODIFICATION OF THIS BUFFER + +MFBEG==0 ;HOLDS WHAT WOULD BE IN BEG IF THIS BUFFER WERE SELECTED. + ;AS WELL AS MFBFR AND MFMARK IN THE LH. +MFBEGV==1 ;SIMILAR, BUT FOR BEGV, AND NO MFBFR OR MFMARK. +MFPT==2 ;SIMILAR, FOR PT. +MFGPT==3 ;SIMILAR, FOR GPT. +MFZV==4 ;SIMILAR, FOR ZV. +MFZ==5 ;SIMILAR, FOR Z. +MFEXTR==6 ;SIMILAR, FOR EXTRAC. + +;THE FREE STORAGE LIST OF CELLS IS POINTED TO BY MFFREE, +;AND LINKED THROUGH THE LAST (MFLINK) WORD OF THE CELL, +;AND TERMINATED WITH A 0. +;THE MFCPTR OF A FREE CELL CONTAINS 0. +;POINTERS TO FREE CELLS ACTUALLY POINT TO THE WORD +;BEFORE THE FIRST WORD OF THE CELL. +;IF THE 1ST WORD OF A CELL IS NEGATIVE (MFBFR IS SET) THE CELL IS A BUFFER FRAME. + +MFFREE: MFSTRT-1 ;MACRO FRAME FREE LIST POINTER. +MFEND: MFEND1 ;END OF SPACE ALLOCATED TO MACRO FRAMES. + +COMCNT: 0 ;NUMBER OF CHARACTERS LEFT IN CURRENT LEVEL OF COMMAND STRING +CPTR: 0 ;BYTE POINTER TO COMMAND STRING (CURRENT LEVEL) +CSTR: 0 ;THE TECO STRING OBJECT WE ARE NOW EXECUTING PART OF. + ;IF EXECUTING SOMETHING NOT IN A TECO STRING, THIS IS BP TO ILDB 1ST CHAR. +MARG1: 0 ;FIRST NUMERIC MACRO ARGUMENT (GOTTEN BY ^X INSIDE MACRO) +MARG2: 0 ;SECOND NUMERIC MACRO ARGUMENT (FETCHED BY ^Y) +MACSPF: 0 ;PF COPIED INTO THIS WORD WHEN MACRO IS CALLED. + +MACPTR: 0 ;POINTER TO THE LAST CELL IN THE MACRO INVOKATION AND +;[ ;^] INVOKATION LIST +MACDEP: 0 ;NUMBER OF FRAMES IN MACPTR STACK (INCLUDING THOSE VIA MACXP). + +CTXPTR: 0 ;[ ;POINTER TO LAST CELL IN THE ^]^X INVOKATION LIST + +MACBTS: 0 ;BITS IN LH SAYING HOW MANY ARGS GIVEN TO CURRENT MACRO. +MFBA1==400000 ;1 => 2 ARGS WERE GIVEN. +MFBA2==200000 ;1 => AN ARG WAS GIVEN. +MFBATSN==100000 ;1 => @ WAS SPECIFIED IN THE CALL TO THIS MACRO. + + +ITRPTR: 0 ;RH PTR TO INNERMOST ITERATION OR ERRSET CELL + ;LH PTR TO INNERMOST ERRSET CELL (OR 0) +ITERCT: 0 ;# PASSES LEFT IN INNERMOST ITERATION. + +;[[[[[ ;THE MACRO PDL CONSISTS OF 4-BIT BYTES, ONE PER MACRO CALL +;OR ^]-CALL (INCLUDING ^]^X). +;MACRO PDL OVERFLOW IS IMPOSSIBLE BECAUSE THE RATIO OF MACRO-PDL +;TO MACRO CELL SPACE INSURES THAT THE LATTER WILL RUN OUT FIRST. +;ONE ENTRY PUSHED FOR EACH ^] CALL (INCLUDING ^]^X) OR M COMMAND. +;0 => MACRO CALL THAT DIDN'T SUPERQUOTE OR DELIMITER-PROTECT. +;1 - 7 => MACRO CALL. 4 BIT => HAD BEEN LOOKING FOR $ AT RCHALT. +; 1 AND 2 BITS: SUBTRACT 1, THEN GET OLD 4.8, 4.9 OF SQUOTP. +;10 => NULL ENTRY, IGNORE WHEN POPPING. +;11 THRU 17 => ^]^X CALL, LOW 3 BUTS SAME AS FOR 1 - 7. + +MACPDP: 400,,MACPDL-1 ;MACRO PDL PTR, -> HIGHEST USED BYTE. +MACPDL: BLOCK MACPSZ +MACXP: 0 ;P IN LAST CALL TO MACXCT OR MACXQ. + +SUBTTL SORT AND SEARCH VARIABLES + +;^P SORT VARIABLES: +PSMEM: 0 ;WD ADDR 1ST WD OF ^P SORT TABLE + ;(WHICH LIVES ABOVE THE BUFFER) +PSMEMT: 0 ;WD ADDR 1ST WD OF LAST ENTRY OF TABLE + ;ENTRIES ARE ADDED AT THE END, AND ARE 4 WDS LONG. +PSSAVP: 0 ;P SAVED INSIDE ^P, OR 0. USED TO TELL WHETHER A SORT IS IN PROGRESS. + ;ALSO USED TO DETECT UNWINDING OUT OF A SORT. +PSZF: 0 ;SET TO -1 TO INDICATE LAST RECORD HAS BEEN FOUND. +PSCASE: 0 ;NONZERO => ^P-SEARCH IGNORES CASE. (FS ^PCASE) + +LPSDBK==4 ;SORT TABLE ENTRIES ARE 4 WDS LONG: + ;0TH WD CHAR ADDR START OF KEY, RELATIVE TO BEG. + ;LATER REPLACED BY BP TO ILDB KEY. + ;1ST WD -<# CHARS IN RECORD>,,-<# CHARS IN KEY> + ;2ND WD CHAR ADDR START OF RECORD, RELATIVE TO BEG. + ;3RD WD POINTER (RELATIVE TO PSMEM) TO NEXT ENTRY, + ;OR -1 FOR LAST ENTRY. TABLE IS SORTED + ;BY CHANGING THESE POINTERS. + +;SEARCH VARIABLES: +PNCHFG: 0 ;0 => S OR FB OR REVERSE SEARCH, 1 => _, -1 => N +SEARG: 0 ;# TIMES TO SEARCH. 1 FOR FB; + ;= ABS VAL. OF NUMERIC ARG FOR S, _, N. +SRCBEG: 0 ;CHARACTER NUMBER (REL TO BEG) OF START OF SEARCH RANGE. +SRCEND: 0 ;CHARACTER NUMBER (REL TO BEG) OF END OF SEARCH RANGE. +SRCERR: 0 ;-1 => FAILING SEARCHES SHOULD BE ERRORS EVEN INSIDE ITERATIONS. +BBP: 0 ;BP. TO 1ST CHAR IN RANGE TO BE SEARCHED. +ZBP: 0 ;BP TO CHAR AFTER LAST CHAR IN RANGE TO BE SEARCHED. +BBP1: 0 ;NOT USED IN FORWARD SEARCH. + ;FOR BACKWARD SEARCH, IT IS THE SAME AS BBP + ;UNLESS THE GAP IS BETWEEN BBP AND WHERE WE ARE SEARCHING, + ;IN WHICH CASE BBP1 POINTS TO THE FIRST CHARACTER AFTER THE GAP. +ZBP1: 0 ;IF GAP IS WITHIN RANGE OF SEARCH, + ;BP TO 1ST CHAR POS WITHIN THE GAP; OTHERWISE, SAME AS ZBP. + ;WHEN FWD SEARCH CROSSES THE GAP, ZBP1 SET FROM ZBP +SLP4N: 0 ;WHEN E MOVES TEMPORARILY FORWARD OVER THE GAP, WHILE TESTING ONE ALTERNATIVE, +SLP4N1: 0 ;SLP4 AND SLP4-1 ARE SAVED IN THESE TWO WORDS. + ;WHEN E IS RESET FROM C, THEY ARE RESTORED FROM THESE WORDS. +SLP1P: JRA B,. ;SLP1D\SLP1I INSTRUCTION EXECUTED WHEN TIME TO READ ANOTHER CHARACTER +TEM1: 0 ;0, OR BP TO START OF LAST INSTANCE FOUND. +TEM2: 0 ;0, OR BP TO END OF LAST INSTANCE FOUND. + +SFINDF: 0 ;VALUE OF THE LAST SEARCH (WHETHER :-SEARCH OR NOT) + +SBFRS: SETZ INISRS-INIQRB ;STRING-POINTER THAT PRESERVES SEARCH-BUFFER. +SBFRP: MFSBUF ;-> SEARCH BUFFER HEADER. +STBLP: INISRB/5 ;ADDRESS OF SEARCH BUFFER BODY. +STBLPX: INISRB/5,,SLP1P ;ALWAYS THE SAME FUNCTION OF STBLP. + +SFXOR: 0 ;ASCII /QQQQQ/, IF 1ST CHAR OF SEARCH STRING IS Q, INSIDE SFAST. +SFASAD: SFAFN0,SFAFC0 ;ADDRESS TO ENTER APPROPRIATE MAIN LOOP OF SFAST. + ;DEPENDS ON WHETHER CASE BEING IGNORED FOR 1ST CHAR OF STRING. + +SUBTTL MORE VARIABLES + +GCPTR: 0 +GCNRLC: 0 ;-1 => GC SHOULDN'T RELOCATE STRINGS, JUST FLUSH UNNEEDED BUFFERS. +QRGCMX: INIQRB+GCOFTN ;GC IMPURE STRINGS WHEN QRWRT GETS THIS LARGE. +STOPF: 0 ;FS QUIT$. NEGATIVE == QUIT DESIRED (FS QUIT) + ;^G AT INT LVL SETS STOPF; SETTING STOPF CAUSES + ;QUITTING ACTION UNDER CONTROL OF NOQUIT. +NOQUIT: 0 ;(FS NOQUIT) 0 => ^G QUITS TO TECO'S TOP LEVEL. + ;POSITIVE => ^G JUST SETS STOPF FOR PROGRAM TO TEST. + ;NEGATIVE => ^G CAUSES "QIT" ERROR (ERRSETABLE). +CLKFLG: 0 ;-1 => IT IS TIME TO RUN THE REAL-TIME CLOCK ROUTINE. +IFN TNX,CLKINT: 0 ;LENGTH OF INTERVAL AT WHICH TO RUN CLOCK ROUTINE +CLKMAC: 0 ;POINTER TO REAL-TIME CLOCK ROUTINE. +RUNFLG: 0 ;-1 ==> TECO HAS BEEN RUN. Q..Q, ETC. HAVE BEEN INITTED. +VARMAC: 0 ;NONZERO => ENABLE FEATURE OF CALLING MACRO WHEN A NAMED VARIABLE IS SET. +LASTER: 0 ;MOST RECENT ERROR MESSAGE (A STRING POINTER). +ERRFLG: 0 ;-1 WHILE PROCESSING AN ERROR. +ERRFL1: 0 ;FS ERRFLG$ - NEGATIVE (-) =. PROTECT 1ST LINES OF SCREEN + ;FROM REDISPLAY (ASSUMING THEY CONTAIN ERROR MESSAGE). SET BY FG. +VERBOS: 0 ;IF NON-ZERO, DISPLAY WHOLE ERROR MESSAGE STRING IMMEDITAELY +ERR1: 0 +ERR2: 0 +ERRECH: 0 ;-1 => TYPE ERR MSGS IN ECHO AREA. + +PTLFCD: 0 ;PTLAB FILE CREATION DATE + +STABP: ;THIS IS THE CACHE FOR JUMPS ("O" COMMAND) +SYMS: BLOCK 20 ;THESE HOLD THE CPTRS AT SOME JUMPS; +VALS: BLOCK 20 ;THESE, THE CPTRS OF TAGS JUMPED TO; +CNTS: BLOCK 20 ;THESE, THE COMCNTS AT THOSE TAGS. +SYMEND: ;ENTRIES ARE IN PAIRS. EACH JUMP CPTR SELECTS A PAIR + ;THE ENTRIES IN A PAIR ARE USED FIFO BY NEW JUMPS. + +PF: -LPF-1,,PFL-1 ;Q REGISTER PDL POINTER +PFL: BLOCK LPF +;QREG PDL ENTRIES ARE 2 WORDS EACH. +;THE FIRST WORD CONTAINS THE DATA PUSHED. +;THE SECOND CONTAINS INFO ON WHERE PUSHED FROM: +; EITHER THE CORE LOCATION PUSHED FROM, +; THE QREG NAME (FOR Q$FOO$ Q-REGS), +; OR THE INDEX IN FLAGD OF THE FS FALG THAT WAS PUSHED. +; THESE ARE DISTINGUISHED BY WHETHER THE NUMBER IS < FLAGSL. + +PDL: BLOCK LPDL +BAKTAB: ;"\" COMMAND WITH ARG "PRINTS" INTO THESE WORDS. +LTABS==100. +STAB: ;WITHIN "O" COMMAND SEARCH, HOLDS THE TAG NAME. +LBF: ;OUTPUT BUFFER FOR "@" AND "^O" COMMANDS. +GCTAB: BLOCK GCTBL +IFG LTABS-GCTBL,BLOCK LTABS-GCTBL + ;USES OF GCTAB: + ;JCL READ INTO IT. USED AS BUFFER BY E_. USED BY ALINK + ;TO HOLD SOME TEMPS. + +QRB: QTAB ;POINTER TO BLOCK OF QREGS WITH NO "."'S IN NAME. +QRB.: QTAB+36. ;POINTER TO BLOCK OF ONE-"." QREGS. +QRB..: QTAB+36.*2 ;POINTER TO BLOCK OF ".." QREGS. +QTAB: BLOCK NQREG + +CTLCF: 0 ;SET BY ^C, SAYS EXIT AFTER COMMAND DONE. + +UTIBUF: BLOCK UTBSZ ;BUFFER FOR READING FROM CHFILI +UTIBE: 0 ;WORD TO HOLD A ^C STUCK ON TO DETECT EOB +UTRLDT: 350700,, ;B.P. TO THE ^C TERMINATING FILLED PART OF UTIBUF +UTYIP: 010700,,0 ;B.P. FOR UNLOADING UTIBUF + +UTOBUF: BLOCK UTBSZ ;BUFFER FOR WRITING TO CHFILO +UTOBE: +UTYOP: 010700,,0 ;B.P. FOR STUFFING UTOBUF +UTYOCT: 0 + +IMQUIT: 0 ;-1 SAYS ^G SHOULD QUIT IMMEDIATELY. + ;SET EG. DURING SEARCHES, WHICH DON'T NEED TO CLEAN UP. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + ;SET TO 1 ONLY AT TECO STARTUP AND WITHIN LIS. + +GOXFLS: 0 ;ZEROED BY GO. -1 => GO SHOULD POP ALL THE WAY TO THE TOP LEVEL. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + +TSINAL: 0 ;-1 => LAST INT. CHAR. WAS ALTMODE. (FOR FINDING $$ AT INT LVL) +TSALTC: 0 ;# OF $$'S ITYIC'D BUT NOT IOT'D. + +PAGENU: 0 ;PAGE # IN INPUT FILE. +LASTPA: -1 ;0 IF HAVE YANKED LAST PAGE OF INPUT FILE. + +IFN ITS,MSNAME: 0 ;WORKING DIRECTORY. +HSNAME: 0 ;HOME DIRECTORY (SIXBIT IN ITS, DIR # IN TWENEX). +OUTFLG: 0 ;-1 => OUTPUT TO EW'D FILE DISABLED. +FILEPA: EOFCHR ;CHAR TO PAD LAST WORD OF OUTPUT FILES WITH. +RDMNMS: 3.14 ;USED BY RANDOM # GENERATOR. VALUE OF FS RANDOM +DOWNF: 0 ;-1 => DOING AN FLD +SEXPFL: 0 ;-1 => FL IS LOOKING FOR S-EXP, NOT LIST. + ;S-EXP MEANS EITHER WORD OR LIST, WHICHEVER STARTS FIRST. +FFRRCT: 0 ;IN FILENAME READER = <# OF FILENAMES> -1 +FNAMSY: 0 ;0 => IF ONLY 1 FILENAME IN STRING, IT IS FN2. + ;NOT 0 => IT IS FN1 (LIKE ALL OTHER PROGRAMS). (FS FNAMSYNTAX) +ADLINE: 60. ;SIXTY CHARACTERS PER LINE OF ADJUSTED TEXT (FA) +NOOPAL: -1 ;IGNORE ALTMODES IF NEGATIVE. + ;STRAY ALTMODES ARE ERRORS IF THIS IS 0. THEY ARE LIKE ^_ IF >0. +NLAROW: 0 ;0 => "_" LEGAL. 1 => ILLEGAL. -1 => "_" TREATED AS "-". +YDISAB: 0 ;0 => Y IS LEGAL. 1 => ILLEGAL. -1 => Y TREATED AS ^ Y. +TABMOD: 0 ;0 => TAB INSERTS, 1 => TAB ILLEGAL, -1 => TAB IGNORED. +FFMODE: 0 ;NON0 => ^L'S READ FROM FILE GO IN BFR. + ;0 => ^L AT END OF PAGE Y'D OR FILE ^Y'D + ;IS THROWN AWAY, AND PW GENERATES A ^L. +UNWINF: 0 ;0 => UNWIND QREG PDL AFTER EACH COMMAND STRING. +BOTHCA: 0 ;NONZERO => SEARCH DOESN'T DISTINGUISH UPPER AND LOWER CASE. +SKNBPT: 0 ;B.P. TO LDB 1ST CHAR OF THE STRING IN .QDLIM. + ;HAS A IN INDEX FIELD. +KILMOD: -1 ;0 => FS BKILL SHOULDN'T REALLY KILL. +SLPNCR: 0 ;-1 => SLPN00 SHOULDN'T CLEAR LOW BITS. +YANKMT: 0 ;0 EXCEPT INSIDE YANK, HAS WHAT MEMT HAD AT START OF YANK. + ;USED TO ELIMINATE EXCESS LOW-BIT CLEARING. +TRCOUT: 0 ;NONZERO WHILE OUTPUTTING TRACE OUTPUT. + ;USED TO PREVENT TRACE OUTPUT FROM CLOBBERING TOP LINE OF SCREEN. +PUREFL: 0 ;-1 => TECO HAS BEEN PURIFIED. +INITF1: 0 ;SET TO -1 BY STARTUP CODE SO THAT ..L WILL BE MACROED + ;NEXT TIME THROUGH THE LOOP AT GO. +INITFL: 0 ;TECO WAS STARTED AT INIT+2, SAYING IT IS UNDER A LISP. +STEPFL: 0 ;-1 => TECO MACRO LINE-STEPPING FEATURE ENABLED: + ;CR AS A COMMAND DOES ^VW AND THEN QUITS IF CHAR IS ^G, + ;ENTERS ^R IF CHAR IS ^R, SETS STEPFL TO 0 IF CHAR IS ^P. + ;ELSE, CAN BE A MACRO TO CALL TO DO THE STEPPING. +STEPDE: -1 ;MAXIMUM MACRO PDL DEPTH (FS BACKDEPTH) AT WHICH TO ALLOW STEPPING, OR -1. +SETPP: 0 ;OLD CONTENTS OF P BEFORE MOST RECENT CALL TO SETPP. DEBUGGING ONLY. +SUPHND: 0 ;FS SUPERIOR$ - MACRO TO HANDLE REQUESTS FROM SUPERIOR. + +SUBTTL BOOTSTRAP FOR EJ FILES + +IF2 PURP1==INIT/2000 ;# OF 1ST PURE CODE PAGE +IF2 PURPL==/2000 ;# OF 1ST PAGE ABOVE PURE CODE. + +BOOT: JRST BOOT1 ;THIS IS THE START ADDRESS WRITTEN INTO EJ FILES. + .VALUE + SETOM INITFL ;START AT START + 2 => SET FS LISPT. +IFN TNX,MOVEM 1,CCLJFN ;TWENEX - SAVE THE JFN WE WERE GIVEN FOR FS CCL FNA$ +BOOT1: SKIPE LIMPUR ;WERE WE JUST LOADED, OR WERE WE RESTARTED? + JRST INIT ;RESTARTED => PURE CODE ALREADY PRESENT, SO DO NORMAL RESTART. +IFN ITS,[ + SYSCAL OPEN,[[.UII,,CHFILI] ? ['DSK,,] ? ['TECPUR] ? [.FNAM2] ? ['.TECO.]] + .LOSE %LSFIL ;TECO PURE FILE NOT FOUND. + .IOT CHFILI,A + SKIPE A + .LOSE ;NOT A PDUMP FILE?? + .ACCESS CHFILI,[INIT+2000] ;GOBBLE TECO'S PURE PAGES OUT OF THE PDUMP FILE. + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBNDR ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHFILI] + .LOSE %LSFIL + .CLOSE CHFILI, +] +IFN TNX,[ + MOVE P,BOOTP + MOVSI 1,(GJ%OLD\GJ%SHT) +RADIX 10. +IFN 20X,[ IFN EMCSDV, HRROI 2,[STRCNC [EMACS:TECPUR.EXE.]\.FNAM3 ] + .ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +] +IFN 10X, HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +RADIX 8 + GTJFN + .VALUE +IFN 20X,[IOR 1,[.FHSLF,,GT%ADR] + MOVE 2,[PURP1*2,,PURPL*2] +] +IFN 10X,HRLI 1,.FHSLF + GET +] + SETOM PJATY ;SCREEN NEEDS COMPLETE REDISPLAY SINCE WE HAVEN'T INITTED IT. + MOVEI TT,LHIMAX ;WE HAVE NO LIBRARIES LOADED IN YET. + MOVEM TT,LHIPAG + JRST INIT + +CONSTA ;WITHOUT THIS, OUR LITERALS WOULD BE IN THE PURE CODE. + +RRVARX:: IF2 IFNDEF RRVARB, RRVARB:: BLOCK RRVARL + +IF2 VPAT: VPATCH: + +INFORM [END OF LOW IMPURE]\.-1 +LOC .\1777 ;MOVE TO LAST WORD OF PAGE +LIMPUR:: -1 ;0 => THIS IS AN EJ FILE JUST LOADED; IT MUST GET TECO'S PURE PAGES. + +SUBTTL ^R MODE VARIABLES + +;^R REAL TIME EDIT MODE VARIABLES. ON PASS 2 WE PUT THEM IN LOW IMPURE IF THEY FIT, +;OTHERWISE IN HIGH IMPURE. + +RRVARL==51. ;NUMBER OF WORDS OF ^R VARIABLES. + +IF2 [ ;BY THE TIME WE GET HERE ON PASS 2, RRVARB WILL + ;HAVE THE DESIRED LOCATION OF THE ^R VARIABLES BLOCK. +RRTMPV==. ? LOC RRVARB + +RRHPOS: 0 ;CURRENT CURSOR HPOS & VPOS: REFLECT +RRVPOS: 0 ;CURRENT VALUE OF PT, EVEN IF SCREEN HASN'T CAUGHT UP. +RROHPO: -1 ;WHAT RRHPOS HELD LAST TIME CURSOR ACTUALLY WAS MOVED. +RROVPO: -1 ;IF THESE DIFFER FROM CURRENT POS, MUST MOVE CURSOR. +RRCMMT: -1 ;0 IF IN COMMENT MODE. +RRCCOL: 0 ;COLUMN IN WHICH THE COMMENTS SHOULD START. +RRMNVP: 0 ;THE VPOS OF UPPERMOST LINE THAT NEEDS REDISPLAY, + ;OR 377777,,-1 MEANING NO LINES NEED REDISPLAY, + ;OR -1 MEANING DON'T TRUST LINBEG AT ALL; DO FULL REDISPLAY. + ;IF RRMNVP IS POSITIVE AND FINITE, ALL LINBEGS FROM TOPLIN + ;DOWN THRU THE RRMNVP'TH LINE (INCLUSIVE) MUST BE ACCURATE OR YOU WILL LOSE! +RRMNHP: 0 ;LEFTMOST COLUMN ON THAT LINE THAT NEEDS REDISPLAY. +RRMAXP: 0 ;NON0 => LARGEST VALUE OF PT AT WHICH BUFFER WAS CHANGED. +RRMSNG: 0 ;NON0 => SOME TEXT AFTER RRMAXP IS MISSING FROM THE SCREEN. +RRRPCT: 0 ;NUMERIC ARG SPEC'D WITH ^V OR CTL-DIGITS. +RRARGP: 0 ;NONZERO => RRRPCT HAS BEEN SET (ELSE IT DEFAULTS TO 1). +RR4TCT: 0 ;# OF OCCURRENCES OF ^U. THE NUMERIC ARG TO A COMMAND IS RRRPCT*(4 ^ RR4TCT) +RUBCRL: 0 ;-1 => ^D AND RUBOUT DELETE A WHOLE CRLF AT ONE BLOW. +RRLAST: 0 ;MOST RECENT ^R-MODE CHAR THAT WASN'T AN ARGUMENT-SETTING COMMAND +RRPRVC: 0 ;WHAT WAS IN RRLAST BEFORE ITS CURRENT CONTENTS. +RRRPLC: 0 ;-1 => NORMAL CHARS REPLACE (X = DIX$) + ;1 => THAT, AND META-CHARS INSERT (LIKE ETV) +RRMCCT: 0 ;FS CRMDLY -- # CHARS TO HANDLE BETWEEN + ;INVOCATIONS OF SECRETARY MACRO. +RRMCC1: 0 ;THIS IS USED TO COUNT THAT MANY CHARS. +RRNCCR: 0 ;SET TO -1 DURING REDISPLAY IF THE PTR + ;COMES AFTER A CR. THAT MEANS RRHPOS IS WRONG + ;AND SHOULD BE COMPUTED BY CALLING RRBTCR. +RRCCHP: 0 ;TEMP. IN CHCT; SAVES HPOS AT START OF EACH CHAR. +RRERFL: 0 ;TEMP. THAT SAVES ERRFL1 OVER CALL TO VBD. +RROLDZ: 0 ;VALUE OF Z, AT TIME OF LAST REDISPLAY THAT WASN'T INTERRUPTED BY TYPEIN. +RROLZV: 0 ;VALUE OF ZV, AT THAT TIME. +RRIDVP: 0 .SEE RRLID ;VPOS AT WHICH WE SHOULD INSERT/DELETE LINES. +RRIDLB: 0 ;OLD LINBEG OF THAT LINE. +RRIDBK: 0 ;# OF NEWLY MADE BLANK LINES BEFORE THAT LINE. +RRCIDP: 0 ;NEG => USE CHAR I/D FOR THIS COMMAND, POS => ONLY REASON FOR + ;UPDATING IS NOT AT END OF LINE, CAN PERHAPS LUCK OUT WITH TABS +RRUNQT: 0 ;-1 => TEMPORARILY REENABLE BUILTIN COMMANDS. +RRALQT: -1 ;NONNEG => DISABLE BUILTIN COMMANDS, BUT + ;THIS WD'S CONTENTS ARE CHAR THAT REENABLES THEM TEMPORARILY. +RRCMQT: 0 ;-1 => ALL CONTROL-META-LETTERS,ETC. ARE SELF-INSERTING (FOR EDITING MACROS). +RREZ: INIBEG ;WHEN ^R MODE IS EXITED, Z, BEG AND PT +RREBEG: INIBEG ;ARE SAVED IN THESE 3 VARS. IF ^R IS REENTERED +RREPT: INIBEG ;WITH ARGS, THEY ARE COMPARED WITH THESE VALUES. + ;RREBEG IS 0 WHILE ^R IS ACTUALLY IN CONTROL. + ;NOT 0 DURING NORMAL COMMAND EXECUTION, INCLUDING MACROS CALLED FROM ^R. + ;0 PREVENTS ^G FROM QUITTING AT INT LVL. +RREVPS: 0 ;REMEMBER RRVPOS AND RRHPOS AT EXIT, IN CASE WE REENTER +RREHPS: 0 ;WITH ONE ARGUMENT. +RREBUF: 0 ;REMEMBER BUFFER THAT ^R WAS PREVIOUSLY DISPLAYING (AS STRING PTR). +RRMKPT: -1 ;THE MARK USED BY ^T, ^X, ^W. +RRSCAN: 0 ;NONZERO => VARIOUS COMMANDS PRINT WHAT THEY STEP OVER/INSERT/DELETE. +RRTTMX: 50. ;FS ^RMAX$. MAX # CHARS OF INSERT TO BE WILLING TO SCAN ON PRINTING TTY. +RRECHO: 0 ;-1 => ECHO THE ^R COMMANDS EXECUTED. 0 => ECHO ONLY ON PRINTING TTY +RRMORF: 0 ;POSITIVE => USE --MORE-- INSTEAD OF --TOP--, ETC., EVEN THOUGH IN ^R. + ;NEGATIVE => DON'T USE EITHER --MORE-- OR --TOP--, ETC. WHEN IN ^R. +RRXINV: 0 ;THIS IS THE REAL DEFINITION OF "SELF-INSERTING CHARS", 0 => SELF-INSERT +RRENTM: 0 ;FS ^R ENTER$, NONZERO => MACRO IT WHEN ENTER ^R. +RRLEVM: 0 ;FS ^R LEAVE$, NONZERO => MACRO IT WHEN LEAVE ^R. +RRDISM: 0 ;FS ^R DISPLAY$, NONZERO => MACRO WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. + +;DEBUGGING VARIABLES: +RRDHPS: 0 ;REMEMBERS RRHPOS BEFORE LAST REDISPLAY. +RRDVPS: 0 ;SAME FOR RRVPOS +RRDMHP: 0 ;SAME FOR RRMNHP +RRDMVP: 0 ;SAME FOR RRMNVP +RRDPT: 0 ;REMEMBER 1ST CHAR DISPLAYED IN LAST REDISPLAY. +IFN .-RRVARB-RRVARL, .ERR RRVARL ISN'T SET RIGHT. + +LOC RRTMPV + +] ;END IF2 + +SUBTTL INITIALIZATION + +INIT: SKIPE RUNFLG ;RESTARTING => DON'T CLOBBER BUFFER, Q-REGS. + JRST GOZ + SETZ FF, + MOVE P,[-LPDL,,PDL-1] +GOZ: SETZM SQUOTP ;NONZERO SQUOTP CAN INTERFERE WITH INSASC. + SETOM PJATY ;SCREEN CONTENTS HAVE BEEN RANDOMLY CLOBBERED. + MOVE CH,LIMPUR ;CH GETS 0 IF THIS IS EITHER TECO JUST LOADED + ; OR AN EJ FILE JUST LOADED + AND CH,RUNFLG +IFN ITS,[ + MOVE E,[-8,,[.SMASK,,[TSMSK] ? .SMSK2,,[TSMSK1] ;SET MASKS, + .SPICL,,[-1] ? .SWHO1,,[0] + .RSNAME,,Q ? .RHSNAME,,HSNAME + .RIOS+CHFILI,,A ? .RIOS+CHFILO,,C]] + .SUSET E + JUMPN CH,GOZ4B ;IF TS TECO OR SOME EJ FILE HAS JUST BEEN LOADED, + MOVEM Q,MSNAME ;THEN OUR .SNAME IS THE MSNAME. + MOVEM Q,DEFDIR ;AND ALSO SHOULD BE OUR DEFAULT SNAME. +GOZ4B: SKIPN A ;ALSO SEE IF DISK CHNLS REALLY STILL OPEN, IN CASE THIS IS A RESTART. + CALL UICLS ;IF THEY AREN'T, TECO SHOULDN'T THINK THEY ARE. + SKIPN C + TLZ FF,FLOUT + SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,MACHIN ]] + .LOSE %LSSYS + .I DEFDEV=MACHIN +];IFN ITS +IFN TNX,[ + CIS ;FORGET ANY INTERRUPTS IN PROGRESS + MOVEI A,.FHSLF + MOVE B,[LEVTAB,,CHNTAB] + SIR + EIR +IFN 20X,MOVE 2,[740400,,020000] ; CHANNELS 0-3, 9 AND 22 +IFN 10X,MOVE 2,[700410,,020000] ; CHANNELS 0-2, 9, 14 AND 22 + AIC + RPCAP + TRZ 2,-1 ;ONLY ENABLE LH CAPS + IOR 3,2 + EPCAP + JUMPGE 3,GOZ4A ; NO ^C CAPABILITY? + MOVE A,[.TICCC,,2] + ATI ; ^C ON CHANNEL 2 +GOZ4A: +IFN TNX,[MOVEI A,.PRIOU + RFCOC + MOVEM B,ITTYMD+1 + MOVEM C,ITTYMD+2 + RFMOD + MOVEM B,ITTYMD ;SAVE TTY MODES +IFN 20X,[ + LDB A,[.BP TT%PGM,B] + MOVEM A,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING +];20X +];TNX + JUMPN CH,GOZ4B + GJINF +IFN 20X,[ + TLNE 1,-1 + TLO 1,040000 ; MAKE SURE THIS LOOKS LIKE A DIRECTORY + MOVEM 1,HSNAME ; HSNAME IS DIRECTORY CORRESPONDING TO USER + MOVSI 1,(GJ%OFG\GJ%SHT) ; PARSE ONLY + HRROI 2,DEFFN1 + GTJFN + JRST GOZ4B + CALL FFSET3 ; SET DEFAULTS FROM IT + RLJFN + JFCL +] +IFN 10X,[ + MOVEM A,HSNAME ; HSNAME IS JUST USER + HRROI A,DEFDIR ; CANNOT JUST DO GTJFN, CAUSE LOSING TENEX FILESYSTEM WILL FAIL + DIRST ; ON SECOND ATTEMPT + JFCL +] +GOZ4B: SKIPN 1,CHFILI + JRST GOZ4 + GTSTS + TLNN 1,(GS%OPN) ; FILE STILL OPEN? + CALL UICLS ; NO +GOZ4: SKIPN 1,CHFILO + JRST GOZ5 + GTSTS + TLNN 1,(GS%OPN) + TLZ FF,FLOUT +];IFN TNX + +GOZ5: SETOM LIMPUR ;MAKE SURE A SECOND $G WON'T MAKE BOOT REBOOT. + CALL INITTY ;INITIALIZE TTY AND FLAGS ABOUT WHAT KIND AND HOW TO TREAT IT. + MOVEI A,[ASCIZ *-!-*] ;USE -!- FOR CURSOR ON PRINTING TTYS. + SKIPE C,RGETTY + MOVEI A,[ASCIZ */\*] ;USE /\ ON DISPLAYS. +IFN ITS,[ + CAIN C,3 + MOVEI A,[ASCIZ //] ;BUT USE "I-BEAM" ON IMLACS. +] +IFN TNX,[ + CAIN C,1 + MOVEI A,[ASCIZ /_/] ;WHAT PEOPLE ARE USED TO ON DATAMEDIAS +] + HRLI A,BP7 + MOVE CH,QRB.. + ADDI CH,.QCRSR + CALL INSASC ;INSERT ASCII STRING IN Q-REG ..A. + SETOM INITF1 ;CAUSE ..L TO BE RUN. +GOZ3: SETZM CPTR ;CPTR MIGHT POINT INTO PURE STRING SPACE WHICH IS NOW NXM. + SKIPE RUNFLG + JRST CTLW + +;STUFF TO DO WHEN STARTED UP THE 1ST TIME ONLY. + MOVE CH,QRB.. + MOVEI A,10. + MOVEM A,.QBASE(CH) ;INIT. OUTPUT RADIX. + MOVE A,[SETZ 1+INIDLM*5-INIQRB] + MOVEM A,.QDLIM(CH) + HRRI A,INI..O-INIQRB + MOVEM A,.QBUFR(CH) + MOVEM A,.Q..Z(CH) + MOVE IN,BEG ;MAKE SURE THE BOTTOM PAGE OF BUFFER EXISTS + CALL GETCHR ;TO PREVENT CONFUSING THE CODE AT FLSCOR + SETOM RUNFLG ;SAY TECO HAS BEEN RUN. + MOVEI A,[ASCIZ/ 5FSQVECTOU..Q 2U:..Q(0)/] + CALL MACXCW ;PUT AN EMPTY SYMBOL TABLE IN ..Q. + MOVEI A,TYOA + HRRM A,LISTF5 ;CAUSE OUTPUT ROUTINES TO TYPE ON TTY. + MOVEI A,[ASCIZ/IMPURE /] + SKIPN PUREFL + CALL ASCIND + MOVE A,[.FNAM1] + MOVEI C,". + CALL SIXINT + MOVEI C,.FVERS + CALL DPT +IFN ITS,[ + .SUSET [.RXUNAME,,C] + .CALL GOZO1 ; OPEN ; TECO + CAIA + JRST GOZ7 + MOVSI C,(SIXBIT/*/) + .CALL GOZO1 ; OPEN ;* TECO + CAIA + JRST GOZ7 + .CALL GOZO2 ; LAST RESORT IS .TECO.;* TECO + CAIA +GOZ7: SETOM CMFLFL ;BUT IF INIT FILE EXISTS, USE IT, +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. + +GOZO1: SETZ ? SIXBIT/OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? C ? [SIXBIT /TECO/] ? SETZ HSNAME + +GOZO2: SETZ ? SIXBIT /OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? [SIXBIT/*/] ? [SIXBIT/TECO/] ? SETZ [SIXBIT/.TECO./] +] +IFN TNX,[ + MOVSI 1,(GJ%OLD\GJ%SHT) + HRROI 2,[ASCIZ /TECO.INIT/] + GTJFN + JRST GOZ6 + MOVE 2,[36._30.+OF%RD] + OPENF + JRST GOZ6 + MOVEM 1,CHFILI + SETOM CMFLFL +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. +] + +;OPEN THE TTY CHANNELS AND SET VARIOUS VARS ACCORDING TO TYPE OF TTY. +FSTTYI: +INITTY: +IFN ITS,[ + TSOPEN CHTTYI,[[%TIFUL+40,,'TTY]] ;INITIALIZE TTY. + TSOPEN CHDPYO,[[%TJCTN+%TJDIS+.BAO,,'TTY]] ;BLOCK OUTPUT FOR DISIOT. + TSOPEN CHECHO,[[%TJECH+%TJPP2+.UAO,,'TTY]] ;ECHO MODE OUTPUT. + TSOPEN CHECDS,[[%TJECH+%TJPP2+%TJCTN+%TJDIS+.UAO,,'TTY]] ;FOR FS ECHO DISPLAY$. + TSOPEN CHSIO,[[%TJSIO+%TJCTN+.UAO,,'TTY]] ;SUPER-IMAGE OUTPUT. + TSOPEN CHTTYO,[[%TJCTN+.UAO,,'TTY]] ;NORMAL TYPE OUT. +] + SETZM DISSAI ;DEFAULT IS DON'T PRINT SAIL CHARACTERS. + PUSHJ P,SETTTM ;SET UP RGETTY, STTYS. + MOVEM CH,RGETTY + MOVEM CH,VERBOS ;LONG ERR MSGS DEFAULT ON IFF DISPLAY TTY. +IFN ITS,[ + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['OSPEED] ? %CLOUT,,OSPEED] + SETZM OSPEED + MOVE A,OSPEED + CAIGE A,10 ;AVOID LOSING ON OLD ITS ON WHICH OSPEED IS A SPEED CODE. + SETZM OSPEED + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['SMARTS] ? %CLOUT,,TTYSMT] + SETZM TTYSMT + .CALL RSSB ;SET NVLNS, NHLNS, TTYOPT. + .VALUE + MOVE A,NHLNS +] +IFN TNX,[ +IFN 20X,[MOVEI A,.CTTRM + MOVEI B,.MORSP ;READ TTY'S SPEED + MTOPR + MOVEI C,(C) ;GET OUTPUT SPEED + CAILE C,9600. ;DONT GET CONFUSED BY NVT'S OR PTY'S + SETZ C, +] +IFN 10X,MOVEI C,2400. ;DEFAULT LINE SPEED FOR 10X + MOVEM C,OSPEED ;SAVE IT + MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL + HLRZ A,0(C) ;ENTRY 0 IS PAGE SIZE + MOVEM A,NVLNS ;NUMBER OF VERTICAL LINES + MOVE A,1(C) ;ENTRY 1 IS TTY OPTION BITS + MOVEM A,TTYOPT + GETNM + MOVEM A,JNAME + HRRZ A,0(C) ;NUMBER OF HORIZONTAL LINES +] + CAILE A,MXNHLS ;MUST BE IN RANGE + MOVEI A,MXNHLS + MOVEM A,NHLNS + SETCM A,TTYOPT ;GET OPTION BITS FOR THIS TERMINAL + TLNE A,%TOOVR ;TTY CAN'T OVERPRINT => + SETZM DISPCR ;DON'T LET STRAY CR'S TRY TO DO SO. + TLNE A,%TOOVR+%TOMVB ;DON'T LET BS OVERPRINT IF TTY CAN'T BS. + SETZM DISPBS + TLNN A,%TOSA1 ;:TCTYP SAIL => WE SHOULD USE SAIL CHAR SET. + SETOM DISSAI + SETCA A, ;CAN'T ERASE SELECTIVELY => CAN'T USE DISPLAY FEATURES. + TLC A,%TOERS+%TOMVU + TLCE A,%TOERS+%TOMVU + CALL [MOVSI C,377777 ;WE SHOULD NEVER DO --MORE--, + MOVEM C,NVLNS +IFN ITS,[ MOVSI C,%TSMOR ;SYSTEM SHOULD DO **MORE** PROCESSING. + ANDCAM C,TTYSTS + ] + SETZB C,RGETTY ;ALSO PRETEND TO BE PRINTING TTY. + TLNN A,%TOOVR + SETOM BSNOLF ;ON GLASS TTY, PULL VARIOUS OVERPRINT-ERASE HACKS. + RET] + SETZM CHCTVP + SETZM CHCTCF + SETOM DWAIT + MOVE C,OSPEED ;SET DWAIT IF TTY'S SPEED IS KNOWN TO BE 600 BAUD OR LESS. + CAIG C,600. + SKIPN C + SETZM DWAIT + LDB C,[.BP (%TOLID),A] + MOVEM C,LID ;IF TTY CAN INSERT/DELETE LINES, DEFAULT IS TO USE THEM. + LDB C,[.BP (%TOCID),A] + MOVEM C,CID ;LIKEWISE CHAR I/D +IFN TNX,[ + CAIE CH,17 .SEE C100 + CAIN CH,21 .SEE VT100 ;UNTIL THE RIGHT %TO BIT DEFINED + MOVNS LID ;HACK SCROLL REGION FOR MOVING TEXT RIGHT + LDB C,[.BP (%TOFCI),A] ;CAN IT GENERATE BONA FIDE HIGH ORDER BITS? + MOVEM C,FCITYI ;YES, DONT MISTAKE THEM FOR PARITY THEN +] + MOVE C,NVLNS + IDIVI C,6 ;COMPUTE # ECHO LINES. + CAIGE C,3 + MOVEI C,3 + SKIPN RGETTY ;NO ECHO LINES ON PRINTING TTERMINALS. + SETZ C, + CALL FSECL1 ;AND SET THAT MANY. + SKIPE RGETTY + JRST ECHOCR + RET + +SUBTTL ECHOING CONTROL + +IFN ITS,[ +;REINITIALIZE TTYSTS, TTYST1, TTYST2; +;TURN ON ECHOING, AND SET ECHOFL TO INDICATE THAT WAS DONE. +SETTTM: .CALL RTTYS1 + .VALUE + MOVE TT,TTYST1 + MOVE TT1,TTYST2 + ANDCM TT,[202020,,202020] ;HAVE ECHOING ON IFF + ANDCM TT1,[202020,,202020] ;FS ECHOLINES $ IS >=0. + SKIPL NELNS + IOR TT,[202020,,202020] + SKIPL NELNS + IOR TT1,[202020,,200020] + TLO Q,%TSCLE+%TSACT+%TSMOR + SKIPN RGETTY + TLZ Q,%TSMOR + .CALL STTYS1 + .VALUE + SETOM ECHOFL + TLZ Q,%TSINT+%TSSAI + MOVEM Q,TTYSTS + RET + +TTYAC2: HRROS (P) + CAIA +TTYAC1: HRRZS (P) +TTYAC4: SAVE Q + SAVE TT + SAVE TT1 + SAVE CH + .CALL RTTYS1 + .LOSE %LSFIL + TLZ Q,#%TSSAI + IOR Q,TTYSTS + SKIPGE CH,-4(P) + TLO Q,%TSINT + .CALL STTYS1 + .LOSE %LSFIL + REST CH + REST TT1 + REST TT + JRST POPQJ + +RSSB: SETZ + SIXBIT /CNSGET/ + %CLIMM,,CHDPYO + %CLOUT,,NVLNS + %CLOUT,,NHLNS + %CLOUT,,TT ;TCTYP + %CLOUT,,TT ;TTYCOM + 400000+%CLOUT,,TTYOPT + +RTTYS1: SETZ + SIXBIT \TTYGET\ + %CLIMM,,CHTTYI + %CLOUT,,TT + %CLOUT,,TT1 + %CLOUT,,Q + %CLOUT,,CH + 400000+%CLOUT,,CH ;TCTYP VARIABLE + +STTYS1: SETZ + SIXBIT \TTYSET\ + %CLIMM,,CHTTYI + TT + TT1 + SETZ Q +] + +IFN TNX,[ + ; DO INITIAL SETUP +SETTTM: SAVE C + MOVSI A,.TICCG ; ^G ON CHANNEL 0 + SKIPG NOQUIT ; UNLESS QUIT NOT ALLOWED + ATI + CALL DOSTIW ; SETUP TERMINAL INT MASK + MOVEI 1,.PRIIN + GTTYP ; GET TERMINAL TYPE + MOVEM B,SGTTYP ; SAVE TYPE FOR DPYRST + CAMN 2,[SIXBIT /4023/] ; BBN'S WAY OF DOING TTY TYPES + MOVEI 2,TK4023 + CAME 2,[SIXBIT /4024/] ; SAME THING AS 4025 + CAMN 2,[SIXBIT /4025/] + MOVEI 2,TK4025 + CAMN 2,[SIXBIT /HP/] + MOVEI 2,HP2645 + MOVE CH,TTYTYP(2) ; GET TERMINAL TYPE DISPATCH + RFMOD ; GET TTY MODE WORD + SKIPE CH ; PRINTING? + TRZA 2,TT%DAM ; NO, BINARY MODE THEN + TRO 2,1_6\TT%ECO ; YES, MAKE SURE DATA MODE NORMAL + SFMOD +IFN 20X,[ + SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON? + JRST .+4 ; YES, DONT MESS WITH IT + JUMPE CH,SETTM1 + TRZE 2,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY + STPAR +] +SETTM1: SETOM ECHOF2 ; ASSUME ECHO + SKIPE RGETTY ; PRINTING TTY'S ECHO FOR THEMSELVES + SKIPGE NELNS ; FS ECHOLINES >= 0 ? + SETZM ECHOF2 ; NO, ECHO OFF + SETOM ECHOFL ; SAY WE DID SOMETHING + JUMPN CH,POPCJ ; DONE UNLESS PRINTING + MOVE B,[.BYTE 2 ? 1 ? 1 ? 1 ? 0 ? 1 ? 1 ? 1 ? 2 ? 2 ? 3 ? 2 ? 1 ? 1 ? 2 ? 1 ? 1 ? 1 ? 1] +IFN 10X,MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 3] +.ELSE MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 1] + SFCOC + JRST POPCJ ; AND RETURN +] ;TNX + + +;TURN OFF ECHOING. +NOECHO: SETZM ECHOFL +IFN ITS,[ + SYSCAL TTYSET,[%CLIMM,,CHTTYI + [020202,,020202] ;NOTHING ECHOES, EVERYTHING ACTIVATES, + [030202,,120202] ] ;^G INTERRUPTS, CR OUTPUT IN IMAGE MODE. + .LOSE %LSFIL +] +IFN TNX,[ + SETZM ECHOF2 ;SAY DONT ECHO THINGS FOR DISPLAY TERMINAL + SKIPE RGETTY + RET + MOVEI A,.PRIOU + RFMOD + TRZ B,TT%ECO ;TURN OFF ECHOS ON PRINTING TERMINAL + SFMOD +] + RET + +SUBTTL TERMINAL INPUT + +;READ A CHARACTER FROM THE TTY. +TYI: CALL TYINH +TYIH: CAIN CH,TOP+"H ;IS THIS THE "HELP" KEY? +TYIURH: SKIPN HELPMAC ;YES, IS THERE A HELP MACRO? + RET ;JUST RETURN THE CHARACTER + CALL [ CALL SAVACS ;PRESERVE ACS AND CURRENT TECO VALUES. + MOVE A,HELPMAC + CALL MACXCP + JRST RSTACS] + SKIPN RREBEG ;IF FS HELPMAC$ RUN INSIDE ^R, RETURN FROM TYI SO THAT + RET ;RRLP1 CAN GO TO RRLP AND MAKE SPACE REDISPLAY THE SCREEN. + JRST TYI ;AFTER RUNNING FS HELP$, TRY AGAIN TO READ A CHARACTER. + +TYIW0: CALL TYIWN0 ;DONT CHECK STOPF, BUT DO UNREAD AND HELP CHAR + JRST TYIH + +;READ CHARACTER, CHECK FOR AND STANDARDIZE HELP CHARACTER, BUT DONT RUN HELP MACRO +TYINH: SKIPGE STOPF + CALL QUIT1 +TYIWN0: MOVE CH,UNRCHC ;GOBBLE ANY UNREAD CHARACTER. + SETOM UNRCHC + JUMPGE CH,CPOPJ + SKIPE TYISRC ;IF THERE IS A "TYI SOURCE", CALL IT. + JRST [ PUSH P,[TYIWN0] + CALL SAVACS + MOVE A,TYISRC ;SINCE IT CAN'T RETURN A VALUE UNCLOBBERED, + CALL MACXCP ;IT SHOULD SET FS REREAD$ TO THE CHARACTER. + JRST RSTACS] ;AND WE RETURN TO TYIWN0 TO GOBBLE IT. + SKIPGE CLKFLG + CALL RLTCLK +IFN ITS,TYIIOT: .IOT CHTTYI,CH +IFN TNX,[ + EXCH A,CH + PBIN +TYIIOT: SKIPN RGETTY ;ON PRINTING TERMINAL +IFN 10X, CAIE A,37 ;ON 10X CONVERT 37 TO CR +IFN 20X, CAIE A,^M ;ON 20X, AFTER A CR, + JRST TYI5 +IFN 20X,PBIN ;FLUSH THE LF + MOVEI A,^M +TYI5: EXCH A,CH + SKIPN FCITYI ;ARE HIGH ORDER BITS PARITY BITS? + ANDI CH,177 ;YES, MASK THEM OFF (SOME TERMINALS GENERATE PARITY) + TRZE CH,200 ;CONVERT EDIT TO META AT LOWEST LEVEL + TRO CH,META + SKIPE ECHOF2 + CALL ECHOCH ;ECHO IT IF REQUESTED, AND SYSTEM DIDN'T ECHO IT. +] + AOS INCHCT ;BUMP COUNT OF INPUT CHARACTERS READ SO FAR. + ANDI CH,777+TOP + CAME CH,HELPCH ;TURN OUR HELP CHARACTER INTO TOP-H. + JRST TYI6 + CALL TYI4 + MOVEI CH,TOP+"H + RET + +TYI6: SKIPE DISPRR ;WHEN OUTSIDE OF ^R, + JRST TYI7 + CAIN CH,33 ;DETECT ALTMODE-ALTMODE. + CAME CH,LTYICH + JRST TYI2 + SOSGE TSALTC ;FOUND ONE! DECREMENT COUNT OF PAIRS REMAINING TO BE READ. + AOS TSALTC +TYI7: HRLI CH,-1 ;MAKE SURE 2ND ALTMODE OF PAIR CAN'T COUNT AS FIRST OF ANOTHER. +TYI2: MOVEM CH,LTYICH + ANDI CH,#META#CONTRL ;TURN ASCII CTL CHARS INTO 9-BIT ONES, + CAIE CH,^M + CAIG CH,^J ;EXCEPT FOR ^H, ^I, ^J, ^M AND ALTMODE. + CAIGE CH,^H + CAIN CH,33 + JRST TYI3 + TRNN CH,TOP+140 ;ALSO, DON'T ALTER THINGS WHICH HAVE THE "TOP" BIT. + IORI CH,CONTRL+100 +TYI3: IOR CH,LTYICH ;NOW RESTORE THE CONTROL AND META BITS, AND FLUSH TOP. + ANDI CH,CONTRL+META+177 +TYI4: IDPB CH,TYIBFP ;RECORD THE INPUT CHARACTER IN THE RING BUFFER FOR SUCH. + CALL TYI1 + SKIPN TYISNK ;INVOKE FS TYIMACRO$ IF THERE IS ONE + RET + CALL SAVACS + MOVE C,CH ;WITH THE CHARACTER AS ARGUMENT. + MOVE A,TYISNK + CALL MACXCP + JRST RSTACS + + +FSTBNXT:ILDB A,TYIBFP ;FS .TYINXT$: GET NEXT OLD TYI CHARACTER. + AOS (P) +TYI1: EXCH CH,TYIBFP + CAMN CH,[001400,,TYIBUF+TYIBSZ-1] + SUBI CH,TYIBSZ + EXCH CH,TYIBFP + RET + +;CONVERT CHAR. IN CH FROM TV CHAR SET TO ASCII. +TYINRM: TRZ CH,META ;CONTROL-^-MUMBLE JUST BECOMES ^-MUMBLE. + TRZN CH,CONTRL + RET + CAIN CH,177 + RET ;CONTROL-RUBOUT SHOULD BE RUBOUT, NOT "?". + CAIE CH,40 ;CONTROL-SPACE IS ^@. + TRZE CH,100 ;NOTE TV CHAR SET HAS CONTROL-LOWERCASE LETTERS! + ANDCMI CH,40 ;THEY SHOULD CONVERT JUST LIKE CONTROL-UPPERCASE LETTERS. + RET + +SUBTTL PURIFY + +IFN ITS,[ +;DUMPIT$G TO DO $Y THEN PURIFY, WITH THE BONUS THAT IT REFUSES +;TO WORK ON A TECO THAT HAS BEEN RUN. +DUMPIT: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /Y +P/] + +;PURIFY$G TO MAKE PURE THE PAGES THAT ARE SUPPOSED TO BE PURE. +PURIFY: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /B P/] + MOVEI P,PDL + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A] + .LOSE %LSFIL + SETOM PUREFL + MOVE A,[.FNAM2] + .VALUE [ASCIZ \ +A/ ..UFILE+2/ 1Q +..UFILE+3/ 1'.TECO. +..UFILE+1/ 1'TECPUR +:Purified + +:PDUMP\] + JRST INIT +] + +IFN TNX,[ +PURIFY: SKIPE RUNFLG + .VALUE + SETOM PUREFL + HLRE 2,116 ;BLT OUT THE SYMBOL TABLE + AOS 1,116 ;FIRST ADDRESS OF SYMBOLS+1 + HRLI 1,-1(1) + SETZM -1(1) ;ZERO IT OUT + SUBI 2,(1) ;GET LAST WORD OF THEM + MOVM 2,2 + BLT 1,(2) ;AND ZERO THE REST OF THEM + SETZM 116 ;ZERO POINTER TOO FOR DDT + + MOVEI 1,.FHSLF + MOVE 2,[3,,BOOT] + SEVEC ;SET UP OUR ENTRY VECTOR + + MOVSI 1,(GJ%SHT) +RADIX 10. +IFN 10X,HRROI 2,[STRCNC [TECO.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECO.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%CPY+SS%RD+SS%EXE+<-600,,0>] + SETZ 3, + SSAVE + ERJMP PFYERR +RADIX 10. + MOVSI 1,(GJ%SHT) +IFN 10X,HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%RD+SS%EXE+] + SSAVE + ERJMP PFYERR + JRST INIT + +PFYERR: MOVEI 1,.PRIOU ;ERROR WHILE PURIFYING, GIVE THE PERSON A HINT WHAT HAPPENED + HRLOI 2,.FHSLF ;LAST ERROR THIS PROCESS + SETZ 3, + ERSTR + JFCL + JFCL + .VALUE +] ;IFN TNX + +SUBTTL SUBROUTINES FOR COMMAND STREAM CHARACTER READER RCH + +;COME HERE ON TRYING TO READ PAST THE END OF A COMMAND STRING LEVEL. +RCH2: SAVE A ;POP OFF MACRO FRAME + SETZM COMCNT ;DON'T LET COMCNT BE -1 -- WOULD SCREW IF ERROR HANDLER DOES BACKTRACE. + SKIPN A,MACPTR ;0 MEANS TRIED TO POP OUT OF TOP-LEVEL + JRST INSCHK +RCH2A: CALL ERSTST ;REFUSE TO POP OUT OF MACRO CONTAINING UNTERMINATED "<" OR ":<". + LDB CH,MACPDP ;TRY TO POP MACPDL ENTRY FOR THE MACRO-CALL. + TRNE CH,10 + JRST RCH2B ;TOP OF MACPDL ISN'T A MACRO-CALL ENTRY! + HRRE A,(A) + JUMPGE A,RCH2D ;ARE WE POPPING OUT OF A MACXQ (MIDAS TO TECO CALL)? + HRRZ A,-1(P) ;YES, ONLY ALLOWED FROM COMMAND LOOP. + CAIE A,CDRCH + JRST INSCHK ;INSIDE A COMMAND => ERROR. +RCH2D: MOVE A,MACPTR + CALL DECDCH ;IT IS ONE, RESTORE RCHALT AND SQUOTP AS IT SAYS. + CALL POPMAC ;POP THE MACRO-STRING-FRAME. + CALL POPMP ;ACTUALLY DEECREMENT MACPDP. +RCH2C: REST A + SKIPL MACPTR ;ARE WE POPPING OUT OF A MACXQ? + JRST RCH ;NO, TRY AGAIN, READ FROM WHAT WE POPPED INTO. + MOVE CH,MACXP ;YES, RESTORE PDL LEVEL TO THAT AT + POP CH,MACXP ;CALL TO MACXQ, AND PREPARE TO RETURN. + POP CH,MACPTR + JRST SETP1 ;SET P FROM CH AND ADJUST LEV. + +RCH2B: CAIN CH,10 ;A NULL ENTRY? FLUSH IT AND TRY AGAIN. + JRST [CALL POPMP ? JRST RCH2A] + MOVEI CH,4 ;[ ;CAN'T POP SINCE ^]^X'D INTO, + MOVEM CH,COMCNT ;[ ;INSTEAD ^]^X UP ANOTHER LEVEL. + MOVE CH,[BP7,,[ASCIZ//]] + MOVEM CH,CPTR + MOVEM CH,CSTR + SKIPGE MACPTR ;I THINK TECO LOSES IF IT USES UP + .VALUE ;[ ;ALL OF A MACXQ'D STRING WITH A ^]^X. + JRST RCH2C + +;THE RCHDTB ENTRY FOR THE CASE SHIFT CHAR IS +RCHSFT: SKIPN MACPTR ;IN MACRO, CASE SHIFT ISN'T SPECIAL. +RCHSF1: SKIPE RCHSFF ;IF PREV. CHAR WAS SHIFT, THIS ONE IS QUOTED. + POPJ P, ;PRETEND NOT TO BE A CASE-SHIFT. + MOVNS CASE ;ELSE ASK TO READ NEXT CHAR IN THE OTHER CASE, + MOVE CH,-1(P) ;GET RET. ADDR OF READ RTN, + SETOM RCHSFF ;QUOTE NEXT CHAR IF CASE-SHIFT OR LOCK. + XCT -1(CH) ;RE-CALL THE READ RTN. (TRACES IF NEC) + MOVNS CASE ;RESTORE CASE TO WHAT IT HAD BEEN. + SETZM RCHSFF +POP1J: SUB P,[1,,1] ;RETURN FROM THE CALL TO RCH + POPJ P, ;SINCE CHAR WAS ALREADY TRACED. + +RCHLOK: SKIPN MACPTR ;RCHDTB ENTRY FOR CASE-LOCK CALLS HERE.. + SKIPE RCHSFF ;IF IN MACRO OR QUOTED BY A CASESHIFT, + POPJ P, ;DO NOTHING SPECIAL. + MOVNS CASE ;ELSE SWITCH THE CASE WE WANT CHARS IN, +RCHTRY: SUB P,[1,,1] + REST CH + JRST -1(CH) ;AND GO READ THE NEXT CHAR. + +;OUTPUT CHARACTER IN CH WHOSE EXECUTION IS TRACED. +.SEE TRACS ;TRACS CONTAINS JRST TYOS WHEN TRACING IS ON. +;CLOBBERS NO ACS. +TYOS: SKIPE BRC1 + RET + SAVE Q + SAVE CH + SETOM TRCOUT + PUSHJ P,TYO + MOVE CH,(P) + CAIE CH,^M ;DON'T MAKE CR COME OUT AS ^M. + PUSHJ P,DISFLS + SETZM TRCOUT + REST CH +POPQJ: REST Q + RET + +;COME HERE IF POP OUT OF MACXQ'D OR TOP-LEVEL STRING IN THE MIDDLE OF A COMMAND. +INSCHK: SKIPN INSINP ;IF WITHIN AN INSERT, WE COULD JUST ERR OUT + TYPRE [CNM] + MOVE P,INSINP ;BUT THAT WOULD LOSE THE STUFF INSERTED SO FAR. + SETZM INSINP ;SO TELL INSDUN TO DO THE CNM ERROR + JRST INSDUN ;AND CAUSE INSERT TO FINISH UP. + +SUBTTL MACRO FRAME ALLOCATION + +;FREE UP A CELL OF MACRO CALL SPACE. +;A -> 1ST WD OF CELL, MINUS 1. +FLSFRM: ANDI A,-1 ;MAKE SURE NO GARBAGE BLOCK IS PUT ON THE FRAME FREELIST. + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + SETZM MFCPTR+1(A) + SETZM MFBEG+1(A) + EXCH CH,MFFREE + MOVEM CH,MFLINK+1(A) + MOVE CH,MFFREE + HRRZM A,MFFREE + POPJ P, + +;OBTAIN A FREE CELL OF MACRO CALL CELL SPACE. +;RETURN POINTER TO WD BEFORE 1ST WD OF CELL, IN A. +GETFRM: SKIPG A,MFFREE + JRST GETFR1 + ANDI A,-1 + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + MOVE A,MFLINK+1(A) + EXCH A,MFFREE + POPJ P, + +GETFR1: CALL GCNRL ;GC, PERHAPS FREEING FRAMES USED BY BUFFERS. + SKIPE MFFREE + JRST GETFRM ;ONE WAS FREED. + CALL GETFR2 + JRST GETFRM + +GETFR2: CALL SAVACS ;MAKE MFINCR MORE MACRO FRAMES, + SAVE TOTALC + MOVE A,MFEND ;UNLESS WE ALREADY HAVE THE MOST WE ARE ALLOWED TO HAVE. + CAILE A,MFSTRT+*MFBLEN + TYPRE [TMN] + MOVEI C,MFINCR*MFBLEN*5 ;NUMBER OF CHARS WORTH OF SPACE WE WILL ALLOCATE. + CALL SLPQGT ;MAKE SURE IMPURE STRING SPACE HAS ROOM TO MOVE UP THAT FAR. + HRRZ BP,CBUFLO + IMULI BP,5 + MOVE TT,QRWRT ;GET START AND END OF RANGE OF CORE TO MOVE UP, IN CHARS. + HRRZ CH,INSBP ;NOTE THAT IF A STRING IS NOW BEING WRITTEN JUST PAST QRWRT, + ADDI CH,1 ;IT MUST BE INCLUDED IN RANGE TO MOVE. + IMULI CH,5 + CAML CH,BFRBOT + JRST GETFR7 + CAMGE TT,CH + MOVE TT,CH +GETFR7: MOVEI C,MFINCR*MFBLEN ;GET NUMBER OF WORDS TO MOVE UP BY. + CALL SLPN0Q + SAVE E + MOVE A,MACPTR + CALL GETFR5 ;RELOCATE ALL BYTE POINTERS IN MACRO, CTX AND ITERATION FRAMES. + MOVE A,CTXPTR + CALL GETFR5 + MOVE A,ITRPTR + CALL GETFR5 + CAML D,CSTR ;IF CPTR IS A B.P. TO A STRING, RELOCATE IT. + ADDM C,CPTR + REST E + ADDM E,QRBUF ;ADD # CHARS MOVED BY (SET BY SLPN0Q) TO + ADDM E,QRWRT ;BOUNDS OF IMPURE STRING SPACE. + MOVE D,BFRBOT + IDIVI D,5 + HRRZ E,INSBP + CAIL E,@CBUFLO ;IF INSBP IS IN THE COMMAND BUFFER OR IMPURE STRING SPACE, + CAMLE E,D ;RELOCATE IT. + JRST GETFR4 ;(THESE TESTS EXCLUDE THE SPECIAL VALUES, 0 AND -1). + ADDM C,INSBP +GETFR4: ADDM C,CBUFLO + ADDM C,CBUFH ;UPDATE BOUNDS OF COMMAND BUFFER. + MOVE A,MFEND + ADDB C,MFEND ;MARK ADDITIONAL SPACE AS IN USE BY MACRO FRAMES. + SOS A +GETFR3: CALL FLSFRM ;NOW "FREE" ALL THE NEWLY ALLOCATED FRAMES SO THEY CAN BE USED. + ADDI A,MFBLEN ;NOTE THAT THE ARG TO FLSFRM MUST BE THE FRAME ADDR MINUS 1. + CAIE A,-1(C) + JRST GETFR3 + REST TOTALC + JRST RSTACS + +;IF A POINTS TO THE START OF A LIST OF MACRO FRAMES, +;RELOCATE THOSE MFCPTR'S OF FRAMES IN THE LIST WHICH POINT AT STRINGS. +;C IS THE AMOUNT TO RELOCATE BY. +GETFR5: MOVE D,QRWRT + TLO D,400000 ;D GETS THE LARGEST NUMBER WHICH IS A STRING POINTER. + MOVE E,MACXP ;IF THIS LIST IS MACPTR, IT MAY HAVE POINTERS THRU THE STACK. +GETFR6: JUMPE A,CPOPJ ;EXIT ON REACHING END OF LIST. + CAML D,MFCSTR-MFLINK(A) ;RELOCATE THE CPTR IF THE CSTR INDICATES THAT THE CPTR + ADDM C,MFCPTR-MFLINK(A) ;POINTS INTO AN IMPURE STRING. + HRRE A,MFLINK-MFLINK(A) ;NOTE THAT A POINTS AT THE MFLINK WORD, NOT THE START OF THE FRAME. + JUMPGE A,GETFR6 ;NOW ADVANCE TO THE NEXT FRAME IN THE LIST. + MOVE A,-1(E) ;BUT MAYBE ADVANCE DOWN A LINK MADE BY A MACXQ CALL. + MOVE E,(E) + JRST GETFR6 + +;[ +SUBTTL ^] + +;[ ;THE RCHDTB ENTRY FOR ^] IS +;NOTE THIS CAN RETURN TO THE CALLING PUSHJ, TO RETRY IT. +CTLBRC: JUMPL CH,TRACS + SKIPGE SQUOTP + JRST TRACS + CALL TRACS + SETZM BRC1CF + SETZM BRCUAV + SETOM DLMF2 + SETZM SQUOF2 +BRCREC: SKIPG COMCNT + TYPRE [UEC] + SOS COMCNT + ILDB CH,CPTR + CALL TRACS +BRCRC2: INSIRP PUSH P,A B TT TT1 BP ;BP MUST BE LAST - SEE EXPMAC. + SETZ A, + PUSHJ P,QNMGE2 + JRST QLET + SKIPE BRC1 + JRST BRCRT5 + CALL QLGET + JRST BRCNVL + JRST EXPMAC + +QLET: SKIPE A + TYPRE [IQN] +INSIRP POP P,BP TT1 TT B A ;[ + CAIE CH,^] + CAIN CH,ALTMOD + JRST BRCPRT + CAIN CH,"$ + JRST RET33 + CAIN CH,^Q + JRST BRCCTQ + CAIN CH,^T + JRST BRCCTT + CAIN CH,^S + JRST BRCCTS + CAIN CH,^A + JRST BRC1CH + CAIN CH,^V + JRST BRCCTV + SKIPE BRC1 + JRST BRCRC3 + CAIN CH,"@ + JRST BRCIND + CAIN CH,^X + JRST BRCCTX + CAIN CH,^Y + JRST BRCCTY + TYPRE [ICB] + +BRCRC3: CAIN CH,"@ + JRST BRCREC + CAIE CH,^X + CAIN CH,^Y + JRST BRCRT + TYPRE [ICB] + +BRCCTS: SETOM SQUOF2 + SETOM DLMF2 + JRST BRCREC + +BRCCTT: SETZM DLMF2 + JRST BRCREC + +BRC1CH: SETOM BRC1CF + JRST BRCREC + +BRCIND: SAVE [BRCREC+1] + JRST BRCREC ;CALL BRCREC, THEN GO TO BRCRC2. + +BRCCTV: SETOM BRCUAV + JRST BRCREC + +BRCNVL: SKIPN BRCUAV + TYPRE [QNS] + SETOM BRCFLG + INSIRP POP P,BP TT1 TT B + MOVE CH,A + HRROM A,BRCUAV ;LEAVE UNTRUNCATED VALUE FOR QNMGET. + ANDI CH,177 + CALL TRACS + SKIPE SQUOF2 + HRLI CH,-1 + JRST POPAJ + +BRCCTQ: CALL SKRCH +BRCPRT: HRLI CH,-1 ;RETURN THE CHARACTER SUPERQUOTED. + POPJ P, + +;SET SQUOTP ACC TO SQUOF2, DLMF2 AND TURN OFF RCHALT. +;ALSO SAVE OLD STATE OF THOSE VARS AS BITS IN CH FOR PUSHING ON MACPDP +FLGENC: SETZ CH, + SKIPE DLMF2 ;SET SQUOTP ACC. TO SQUOF2, DLMF2 + TLO CH,2^5 + SKIPE SQUOF2 + TLO CH,4^5 ;AND SET CH ACC TO PREVIOUS SQUOTP AND RCHALT + EXCH CH,SQUOTP + IORM CH,SQUOTP + ROT CH,2 .SEE MACPDP ;SET UP CH AS A MACPDL ENTRY + ADDI CH,1 + HLRZ A,RCHALT + CAIN A,(CALL) + ADDI CH,4 + MOVEI A,(JFCL) ;ALSO TURN OFF RCHALT. + HRLM A,RCHALT + POPJ P, + +DECDCH: TRNN CH,3 + POPJ P, ;THIS ENTRY DIDN'T PUSH SQUOTP, RCHALT. + SUBI CH,1 + DPB CH,[420200,,SQUOTP] + TRNN CH,4 + SKIPA CH,[(JFCL)] + MOVEI CH,(CALL) + HRLM CH,RCHALT + POPJ P, + +;A HAS STRING OBJECT, B HAS LENGTH, BP HAS POINTER TO IT. +;PUSH A CALL TO THAT OBJECT ONTO THE RCH INPUT STREAM. +;NOTE TOP OF PDL HAS VALUE THAT WAS IN BP WHEN RCH WAS CALLED. +EXPMAC: SETOM BRCFLG + MOVE BP,(P) ;SAVE BP, AND GET OUR CALLER'S BP. + CALL PUSMA0 ;PUSH MACRO PDL, RELOCATING BP IF BUFFERS MOVE. + MOVEM BP,(P) ;GIVE CALLER'S BP BACK TO HIM, RELOCATED IF NEC. + CALL QLGET0 ;REDECODE ADDR OF STRING (MAYBE PUSMA0 MADE FRAMES AND CHANGED IT). + SKIPE BRC1CF + MOVEI TT,1 + MOVEM A,CSTR + MOVEM BP,CPTR + SKIPE BRC1CF ;IF WANT WHOLE STRING, + CAMLE TT,B ;OR IF WANT MORE CHARS THAN STRING HAS, + MOVE TT,B ;USE STRING LENGTH RATHER THAN DESIRED # CHARS. + MOVEM TT,COMCNT + MOVE B,PF + MOVEM B,MACSPF + SETZM MACBTS ;[ ;THERE ARE NO ARGS IN A ^] CALL. + SETZ CH, ;IF NOT SETTING ANY FLAGS, PUSH 0 ON MACPDL. + SKIPN SQUOF2 + SKIPE DLMF2 + CALL FLGENC ;ELSE COMPUTE WHAT TO PUSH. + IDPB CH,MACPDP +BRCRT5: INSIRP POP P,BP TT1 TT B +BRCRT4: REST A +BRCRT: REST CH + JRST -1(CH) ;RETRY THE RCH. + +RET33: MOVEI CH,ALTMOD + POPJ P, + +;[ ;PERFORM A PUSH INTO A ^]^X. +BRCCTX: SKIPE BRC1CF + JRST BRCCTY + SETOM BRCFLG + PUSH P,A + HRRZ A,-2(P) + CAIE A,BCYRCH+1 ;[[ ;IF THE ^]^X WAS IN THE CHARACTER THAT A ^]^Y WAS TRYING TO READ, + JRST BRCCX2 + PUSH P,RCHALT + HRLZI A,(JFCL) ;[ ;PERFORM A RECURSIVE ^]^Y, + HLLM A,RCHALT + PUSHJ P,BRCCTY + POP P,RCHALT ;[ ; WE HAVE ADVANCED PAST THE ^]^X IN THIS MACRO LEVEL. + CAIN CH,ALTMOD ;IF WHAT WE JUST GOT IS AN ALTMODE, THAT'S OK; RETURN IT. + JRST BRCRT4 + MOVE A,CPTR ;[ ;BUT OTHERWISE, THIS ^]^X HAS LONGER TO RUN, + PUSH P,CH ;[ ;SO WE MUST BACK UP OVER IT. +BRCCX1: DBP7 A + AOS COMCNT + LDB CH,A ;[ + CAIE CH,^] ;[ ;SO BACK UP UNTIL WE GET TO THE ^]. + JRST BRCCX1 + DBP7 A ;AND BACK UP ONE CHAR FURTHER. + AOS COMCNT + MOVEM A,CPTR + POP P,CH ;[ ;THEN RETURN THE THING WE GOT FROM THE RECURSIVE ^]^Y. + JRST POPAJ + +BRCCX2: CALL BRCCX0 + JRST BRCRT4 + +;[ ;PUSH INTO A ^]^X, AS A SUBROUTINE, NOT CALLED BY RCH. RETURNS WITH A NORMAL POPJ. +BRCCX0: PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC ;SET SQUOTP, GET OLD STATE IN CH. + ADDI CH,10 ;[ ;INDICATE PUSHED BY ^]^X, NOT MACRO CALL. + IDPB CH,MACPDP + MOVEI A,(CALL) + HRLM A,RCHALT ;[ ;START LOOKING FOR AN $ TO END ^]^X. + SKIPGE MACPTR ;[ ;TRYING TO ^]^X OUT OF A MACXQ => PHONY UP NULL ARG. + CALL ENDAR2 + RET + +ENDARG: MOVEM A,(P) + CALL ENDAR2 + JRST BRCRT4 + +ENDAR2: CALL ERSTST + LDB CH,MACPDP + TRNN CH,10 + JRST ENDAR1 ;[ ;POPPING ^]^X BUT MACPDP SAYS MACRO CALL. + CAIN CH,10 ;NULL ENTRY ON MACPDP? FLUSH IT. + JRST [CALL POPMP ? JRST ENDAR2] +ENDAR5: CALL DECDCH ;[ ;A ^]^X ENTRY, UNBIND SQUOTP AND RCHALT. + CALL POPMP ;AND REMOVE THE ENTRY FROM THE STACK. + JRST ENDAR4 + +ENDAR1: SAVE MACPDP +ENDAR3: CALL POPMP + CALL ERSTST + LDB CH,MACPDP ;[ ;LOOK DOWN MACPDP FOR A ^]^X ENTRY. + CAIG CH,10 + JRST ENDAR3 ;THE ENTRIES ABOVE MUST BE 0 OR 10 . + CALL DECDCH ;FOUND THE ENTRY, RESTORE SQUOTP. + MOVEI CH,10 ;REPLACE THE ENTRY WITH A NULL. + DPB CH,MACPDP + REST MACPDP +ENDAR4: CALL PUSMA0 + JRST POPCTX + +BRCCTY: SETOM BRCFLG + PUSH P,A ;HANDLE ^Y OR ^F^X. + PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC + ADDI CH,10 + IDPB CH,MACPDP + SKIPGE MACPTR ;IF OUR CALLER WAS MACHINE-LANGUAGE TECO, + SKIPA CH,[ALTMOD] ;DON'T TRY TO POP INTO IT; PHONY UP AN ALTMODE. +BCYRCH: PUSHJ P,RCH + SKIPGE SQUOTP + HRLI CH,-1 + SAVE CH + CALL ENDAR2 + REST CH + REST A + RET + +;F^K COMMAND FOR READING STRING ARGUMENTS: + +;DO F^K$. IF YOU WERE CALLED BY A MACRO, IT WILL ACT LIKE ;[ +; :I*^]^X$, GOBBLING A STRING ARG FROM THAT MACRO. +;OTHERWISE, IT ACTS LIKE M$*F^K HOOK*$$, +; WHICH SHOULD READ AN ARGUMENT FROM THE TERMINAL, PROMPTING. +; IF THE USER RUBS OUT PAST THE START OF THE ARGUMENT, +; M$*F^K HOOK*$ SHOULD EXIT FROM THE F^K'ING MACRO WITH -2FS BACK RETURN$. + +;:F^K RETURNS A NEGATIVE VALUE IF THE CURRENT MACRO'S CALLER WAS TECO INTERNAL CODE. +;IT RETURNS A NONNEGATIVE NUMBER IF THE CALLER WAS ANOTHER MACRO. + +;CALLING A MACRO WITH @M MAKES F^K WITHIN THAT MACRO BELIEVE THAT THE +;MACRO WAS CALLED FROM TECO INTERNAL CODE. + +FCTLK: SKIPN A,MACPTR + TYPRE [CNM] ;BARF IF NO CALLER AT ALL + HRRE A,(A) + MOVE T,MACBTS ;@M IS TREATED LIKE A CALL FROM INSIDE TECO. + TLNE T,MFBATSN + SETO A, + TRZE FF,FRCLN ;FOR :F^K, RETURN NEGATIVE IF CALLER IS TECO CODE. + JRST POPJ1 + JUMPL A,FCTLK1 ;NO COLON. JUMP IF CALLER IS ^R OR OTHER TECO CODE. + CALL FNOOP ;CALLER IS A MACRO. FLUSH . + MOVE A,CPTR ;BACK UP OVER THE ALTMODE, SO THAT IT WILL TERMINATE THE + DBP7 A ;ARG WHICH THE :I* WILL READ. + MOVEM A,CPTR + AOS COMCNT + SETZM SQUOF2 + SETOM DLMF2 + CALL BRCCX0 ;[ ;SIMULATE GOBBLING A ^]^X. DELIMITER PROTECT, BUT NO SUPERQUOTING. +FCTLK0: TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + MOVEI CH,A + MOVE OUT,[CALL RCH] + MOVEM OUT,INSRCH + AOS (P) + JRST PSI ;THEN SIMULATE A :I* AND RETURN ITS VALUE. + +FCTLK1: MOVEI A,[ASCIZ /FM*F HOOK*/] + HRLI A,440700 + MOVE BP,A + MOVEI B,14. ;THIS IS THE NUMBER OF CHARACTERS IN THAT ASCIZ STRING!! + REST T ;DISCARD RETURN ADDRESS, SINCE MAC2 WILL JUMP TO MAIN LOOP. + CAIN T,CDRET + .VALUE + JRST MAC2 ;[ ;WE CAN'T USE MACXQ, SINCE WE NEED TO HAVE ^]^X WORK THROUGH THIS. + +PUSMA0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSMAC + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSMAC + EXCH BP,INSBP + RET + +PUSMAC: SAVE A + PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,MACPTR] + PUSH A,... +TERMIN MOVEM A,MACPTR + AOS MACDEP + HLL A,MACBTS + HLLM A,(A) + JRST POPAJ + +POPMAC: SKNTOP MACPTR + TYPRE [CNM] +POPMA1:IRP ...,,[MACPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,MACPTR + HRLS MACPTR + HLLZM A,MACBTS + SOS MACDEP + RET + +PUSCX0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSCTX + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSCTX + EXCH BP,INSBP + RET + +PUSCTX: PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,CTXPTR] + PUSH A,... +TERMIN MOVEM A,CTXPTR + HLL A,MACBTS + HLLM A,(A) + POPJ P, + +POPCTX: SKNTOP CTXPTR + JRST [.VALUE ? JRST GO] +IRP ...,,[CTXPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,CTXPTR + HRLS CTXPTR + HLLZM A,MACBTS + RET + +;DECREMENT MACPDP. +POPMP: MOVE CH,MACPDP + ADD CH,[40000,,] + JUMPGE CH,POPMP1 + CAML CH,[440000,,] + SUB CH,[440000,,1] +POPMP1: MOVEM CH,MACPDP + POPJ P, + +;IF ABOUT TO POP MACPDP, MAKE SURE NOT POPPING +;OUT OF A LEVEL CONTAINING AN UNTERMINATED ERRSET OR ITERATION. +ERSTST: HRRZ CH,ITRPTR ;ADDR OF BLOCK FOR INNERMOST ERRSET OR ITERATION. + JUMPE CH,CPOPJ ;THERE IS NONE IN PROGRESS. + MOVE CH,MFMACP-MFBLEN+1(CH) ;GET THE MACPDP VALUE AT TIME IT WAS ENTERED. + CAME CH,MACPDP ;ARE WE POPPING THAT LEVEL? + RET + TSC CH,ITRPTR ;YES. WHICH IS IT - AN ERRSET OR AN ITERATION? + TRNN CH,-1 + TYPRE [ERP] ;AN ERRSET. + TYPRE [UTI] ;AN ITERATION. + +SUBTTL ERRORS + +;FE -- INSERT A "TECO ERROR" FILE IN THE BUFFER BEFORE PT. +;:FE -- INSERT A LIST OF NAMES OF FS FLAGS. +;FE -- INSERT IN BUFFER THE 3-LETTER CODE + ;AND MESSAGE ASSOCIATED WITH ERROR CODE +;^ FE$ -- RETURNS THE ERROR CODE ASSOCIATED WITH THE 3-CHAR + ;MESSAGE . +FECMD: TRZE FF,FRUPRW + JRST FECMU + MOVSI T,-LERTAB + MOVEI A,TYOM ;TYPEOUT INTO BUFFER AT PT. + HRRM A,LISTF5 + CALL GAPSLP + TRNE FF,FRCLN ;:FE - INSERT LIST OF FS FLAGS. + JRST FECMD3 + TRZN FF,FRARG + JRST FECMD2 ;NO ARG, INSERT A LINE FOR EACH ERROR. + MOVE A,C ;AN ARG (ERROR CODE) IS JUST A STRING, SO GET IT. +FECMD6: CALL QGET3 + JRST CRR1 + +FECMD2: SAVE PT ;SAVE CURRENT PT SO CAN SET UP INSLEN. +FECMD5: MOVE A,ERRTAB(T) + HRLI A,400000 ;MAKE STRING PTR TO NEXT ERROR MESSAGE. + SAVE T + CALL FECMD6 ;INSERT EACH ERROR MESSAGE IN THE BUFFER. + REST T + AOBJN T,FECMD5 + REST C ;C GETS OLD PT. + SUB C,PT + MOVNM C,INSLEN ;FKD WILL DELETE THE WHOLE TABLE. + RET + +FECMD3: MOVSI T,-FLAGSL +FECMD4: MOVE E,FLAGS(T) ;GET THE NEXT FLAG'S NAME + CALL TYPR ;AND TYPE IT OUT INTO BUFFER. + CALL CRR1 ;EACH NAME GOES ON A LINE. + AOBJP T,CPOPJ ;WHEN THRU, UNBIND LISTF5 AND DONE. + AOJA T,FECMD4 ;HANDLE NEXT FLAG NAME. + +;HANDLE ^ FE. +FECMU: CALL FSIXR ;READ ARG, MAKE SIXBIT WORD IN A. + JFCL + HLRZ C,A + MOVSI A,-LERTAB ;NOW SEARCH ERROR TABLE FOR THIS ERROR. +FECMU2: HLRZ TT,ERRTAB(A) + CAIE TT,(C) + AOBJN A,FECMU2 ;STOP WHEN FIND IT, OR AT END OF ERRTAB. + CAIN A,LERTAB ;IS IT THE END? + JRST NRET0 ;YES, NO SUCH ERROR MESSAGE, RETURN 0. + HRRZ A,ERRTAB(A) + HRLI A,400000 ;ELSE RETURN POINTER TO THE ERROR STRING. + JRST POPJ1 + +;ROUTINE FOR FS ERR$. +FSERR: MOVE A,LASTER + TRNN FF,FRARG + JRST POPJ1 ;READING ONLY - RETURN LAST ERROR'S CODE. + MOVEM C,LASTER + JRST DISTOE + +;FG -- MAKE A STANDARD ERROR REPORT (USEFUL IN ERROR HANDLER MACROS). +;IF ARG, PRINT STANDARD ERROR MESSAGE FOR THAT ERROR CODE. + ;AND IF ":", DO IT AT TOP OF SCREEN. + ;Q..H IS NOT CHANGED BY FG EVEN IF IT DOES TYPEOUT. +;IF "^", THROW AWAY TYPE AHEAD. +;IN ANY CASE, TYPE A BELL. +FGCMD: MOVE A,QRB.. + SAVE .QVWFL(A) + TRZE FF,FRARG + CALL FGCMDP + MOVE A,QRB.. + REST .QVWFL(A) + SKIPE ERRECH ;IF WE TYPED THE ERR MSG IN THE ECHO AREA, + SETZM ECHACT + TRZN FF,FRUPRW + JRST TYPBEL +IFN ITS,.RESET CHTTYI, +IFN TNX,[MOVEI A,.PRIIN ;CLEAR INPUT + CFIBF] + SETZM TSINAL + SETZM TSALTC + SETOM UNRCHC +TYPBEL: SKIPE TYISNK + HRRZM P,MODCHG ;IF CLEARING TYISNK, REMOVE "DEF" FROM EMACS MODE LINE. + SETZM TYISNK + SETZM TYISRC +IFN ITS,.IOT CHECHO,[^G] +IFN TNX,[SAVE A + MOVEI A,^G + PBOUT + REST A] + JRST FSECO6 + +FGCMDP: JUMPE C,CPOPJ ;THERE WS NO ERROR => DON'T PRINT ERROR MESSAGE. + TRZE FF,FRCLN + CALL [ SKIPN ERRECH + JRST DISTOT + SKIPGE PJATY ;IF SCREEN MUST BE REDISPLAYED, CLEAR IT NOW RATHER THAN + CALL DISIN0 ;AFTER THE ERROR MESSAGE IS PRINTED. + MOVEI CH,^M + JRST FSECO1] + MOVE D,VERBOS +FGCMD3: HRRZM P,ERRFL1 ;DON'T LET FS ERRFLG$ STOP THIS FROM PRINTING. + MOVEI A,TYOA + SKIPE ERRECH ;IF SPECIFIED, TYPE IN ECHO AREA. + MOVEI A,FSECO1 + HRRM A,LISTF5 + CALL FGCMD1 + MOVEI CH,"? + CALL @LISTF5 + SKIPE ERRECH + RET + CALL DISFLS + MOVE E,TOPLIN + SUB E,CHCTVP ;HOW MANY LINES WERE USED? + SOS E + MOVEM E,ERRFL1 ;MAKE SURE THOSE LINES AREN'T ERASED BY REDISPLAY. + RET + +FGCMD1: MOVE A,C ;PRINT CONTENTS OF STRING IN C. + CALL QLGET0 + RET +FGCMD2: JUMPE B,CPOPJ + ILDB CH,BP + CAIN CH,^I ;IF D IS ZERO, STOP AT FIRST TAB. + JUMPE D,CPOPJ + CALL @LISTF5 + SOJA B,FGCMD2 + +;HANDLE TOP-LEVEL ^X COMMAND: PRINT THE FULL EROR MESSAGE FOR THE LAST ERROR. +FECMD8: MOVE C,LASTER + SETO D, + JRST FGCMD3 + +;COME HERE TO REPORT SYSTEM CALL ERROR, ASSUMING THE FILE NAMES ARE IN DEFDEV, ETC. +IFN ITS,[ +OPNER1: .SUSET [.RBCHN,,CH] ;GET # OF CHANNEL IN ERROR, + LSH CH,27 + IOR CH,[.STATUS CH] + XCT CH ;READ THE ERROR CODE, + LDB CH,[220600,,CH] +OPNER4: SAVE CH ;ENTER HERE WITH ERRCODE IN RH(CH), TO PRETEND I.T.S GAVE AN ERROR. + HRLZS (P) + MOVEI C,70. ;WRITE A STRING CONTAINING FILENAMES AND I.T.S. ERROR MESSAGE. + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVSI E,'OPN + CALL SIXNTY ;FIRST IN THE STRING GOES "OPN" FOLLOWED BY 3-DIGIT ERROR CODE. + LDB CH,[.BP (700),(P)] + CALL DGPT + LDB CH,[.BP (70),(P)] + CALL DGPT + LDB CH,[.BP (7),(P)] + CALL DGPT + MOVEI CH,40 + REPEAT 2,XCT LISTF5 ;THEN 2 SPACES. + CALL LFILE ;THEN THE FILENAMES. + MOVEI CH,40 + REPEAT 3,XCT LISTF5 ;3 SPACES. + REST E + SYSCAL OPEN,[%CLIMM,,CHERRI ? ['ERR,,] ? %CLIMM,,3 ? E] + JRST .-1 +OPNER2: .IOT CHERRI,CH ;COPY INTO STRING, STOPPING AT CRLF OR FF. + CAIE CH,^M + CAIN CH,^L + JRST [.CLOSE CHERRI, + JRST OPNER3] + XCT LISTF5 + JRST OPNER2 +] + +IFN TNX,[ +OPNER0: MOVE A,OPNJFN + RLJFN + JFCL +OPNER1: MOVEI A,.FHSLF ;GET THIS FORKS LAST JSYS ERROR MESSAGE +IFN 10X,[MOVE C,[4,,BAKTAB+4] + BLT C,BAKTAB+10 ;GETER ON TENEX SMASHES 4-10 +] + GETER +IFN 10X,[MOVS C,[4,,BAKTAB+4] + BLT C,10 +] +OPNER4: PUSH P,2 ;ENTER HERE TO FAKE ERROR FROM 2 + MOVEI C,70. ;MAKE ENOUGH STRING SPACE + CALL QOPEN + MOVSI E,'OPN ;INSERT OPN + CALL SIXNTY + POP P,2 + LDB CH,[070100,,2] + CALL DGPT + LDB CH,[060300,,2] + CALL DGPT + LDB CH,[030300,,2] + CALL DGPT + LDB CH,[000300,,2] + CALL DGPT + MOVEI CH,40 ;AND TWO SPACES + REPEAT 2,XCT LISTF5 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT DEFAULTS + MOVEI CH,40 + REPEAT 3,XCT LISTF5 + MOVE A,[440700,,BAKTAB] + SETZ C, + ERSTR + JFCL + JFCL +IFN 10X,IDPB C,A ;STUPID 10X JSYS DOESNT MAKE ASCIZ + MOVEI A,BAKTAB + CALL ASCIND ;AND INSERT IT TOO +] +OPNER3: CALL QCLOSV ;NOW FINISH THE STRING'S HEADER, AND RETURN POINTER IN A. + MOVEM A,LASTER ;REMEMBER IT AS THE MOST RECENT ERROR'S CODE. + JRST DISTOE ;NOW GET CAUGHT BY ERRSET INVOKE ERROR HANDLER. + +;TYPR4 UUO (TYPRE MACRO) COMES HERE. +ETYP2A: HRRZ CH,@40 ;ERROR, AND IT CAN BE HANDLED NORMALLY; GET THE ERROR CODE. + HRLI CH,400000 + MOVEM CH,LASTER ;REMEMBER AS CODE OF MOST RECENT ERROR. + JRST DISTOE ;GET CAUGHT BY ERRSET OR POP. + +IMMQIT: SETOM IMQUIT ;ALLOW QUITS TO HAPPEN AT ANY TIME, + SKIPL STOPF ;AND QUIT IF ALREADY PENDING. + RET +QUIT0: ;CALL HERE IF STOPF IS SET, WHEN IT IS ACCEPTABLE TO QUIT. +QUIT1: SETZM ORESET ;RE-ALLOW TYPEOUT NOW THAT WE GOT THRU WITH THE COMMAND + SKIPLE NOQUIT + SKIPLE IMQUIT + CAIA ;NOQUIT POSITIVE => NO QUITTING AT ALL (UNLESS IMQUIT OVERRIDES) + RET + SETZM STOPF ;ELSE QUIT, AND CLEAR FLAG SAYING WE NEED TO QUIT. +IFN 20X,[MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] + CALL DISRST ;THROW AWAY ANYTHING IN DISBUF. + SKIPG IMQUIT ;IMQUIT POSITIVE ONLY AT STARTUP AND IN COMMAND READER + SKIPN NOQUIT ;IF QUITTING SHOULD GO TO TOP LEVEL, DO SO. + CAIA + TYPRE [QIT] ;NOQUIT NEGATIVE WANTS TO SIGNAL AN ERROR. + CIS ;CLEAR ANY INTERRUPTS IN PROGRESS. + SETOM RROVPO + CALL TYPBEL + SETZM ECHACT +IFN ITS,[.IOT CHECHO,["^] + .IOT CHECHO,["G] +] +IFN TNX,[MOVEI CH,"^ + CALL ECHOC1 + MOVEI CH,"G + CALL ECHOC1 +] + JRST GOX1 + +DELQIT: SETZM IMQUIT ;STOP ALLOWING QUITS INSIDE COMMANDS, AND EXIT. + RET + +;CALL HERE TO SIGNAL AN ERROR, AFTER SETTING LASTER. +;DISTOE RETURNS TO AN ERRSET IF THERE IS ONE; OTHERWISE, IT GOES TO +;GOX1 TO ENTER A BREAK LOOP, INVOKE THE ERROR HANDLER, OR POP TO ^R OR TOP LVL. +DISTOE: MOVE Q,PT ;ERROR CHECK: IS PT OUT OF BUFFER BOUNDS? + CAMG Q,ZV + CAMGE Q,BEGV + .VALUE + TRNN P,-1 + .VALUE + CIS + SKIPL ERRFLG ;WERE WE ALREADY INVOLVED IN STARTING TO HANDLE AN ERROR? + JRST DISTOW + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P ;YES; GIVE UP TRYING TO RECOVER AND POP ALL THE WAY UP, + PUSHJ CH,SETP ;SINCE TRYING TO HANDLE THIS ERROR NORMALLY WILL PROBABLY + ;CAUSE ANOTHER ERROR. + SETZM ERRFL1 ;PREVENT TYPEOUT OF THE MESSAGE FROM BEING SUPPRESSED. + CALL DISTOT + MOVEI CH,TYOA + HRRM CH,LISTF5 ;NOT CAUGHT BY ERRSET, PREPARE FOR TYPEOUT. + MOVEI A,[ASCIZ/ERROR WHILE ENTERING ERROR HANDLER! POPPING TO TOP LEVEL. +/] + CALL ASCIND + CALL ERESET + JRST CTLW + +DISTOW: SETOM ERRFLG + CALL ERESET + HLRZ Q,ITRPTR + JUMPE Q,GOX1 ;IF WITHIN AN ERRSET + HLRZ CH,MFPF-MFBLEN+1(Q) + HRRZ A,DISPRR ;WHICH HAS NO ^R INSIDE IT + SKIPE A + CAIG A,(CH) + JRST ERRP3 ;THEN THROW TO THE ERRSET. + JRST GOX1 ;ELSE GIVE TO THE ^R OR TO ERROR HANDLER. + +;COME WHEN ERROR IS CAUGHT BY ERRSET. +ERRP3: CALL UNWIND ;POP SOME STUFF OF MACRO PDL, ETC. + JRST ERRP4 ;DOESN'T SKIP IF HAVE FINISHED UNWINDING; CH = RH(ITRPTR) + JRST ERRP3 ;SKIPS 1 AFTER POPPING MACRO CALLED BY "M" CMD. + MOVE CH,MACXP + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SKIPS 2 AFTER POPPING A MACXQ OR MACXCW. + JRST ERRP3 + +ERRP4: HRROI Q,MFCSTR-MFBLEN+1(CH) + POP Q,CSTR ;POSITION AT THE FRONT OF THE ERRSET + POP Q,CPTR + POP Q,COMCNT + JRST INCMA0 ;THEN SEARCH FOR THE >. + +;CLEAN UP WHEN ERROR OR QUIT HAPPENS, IN CASE VARIABLES WERE SCREWED. +;THIS STUFF DONE REGARDLESS OF WHETHER ERROR WAS CAUGHT BY ERRSET. +ERESET: SETOM INSBP + SETZM DISFLF + SETZM IMQUIT + SETZM INSINP + SETZM INSBP + SETZM TRCOUT + SETZM BRC1 + SETZM SLPNCR + SETZM YANKMT +IFN ITS,.CLOSE CHRAND, ;IN CASE WE QUIT OUT OF READING FILE DIR. + MOVE A,QRB.. ;MAKE SURE BFRPTR AND BFRSTR AGREE WITH ..O. + MOVE C,.QBUFR(A) ;A PDL OVERFLOW IN CERTAIN PLACES CAN CONFUSE THEM. + JRST BFRSET + +;TRY TO UNWIND MACRO PDL AND ITERATIONS UNTIL REACH INNERMOST ERRSET. +;DON'T SKIP IF REACH THERE. SKIP 1 IF POP AN ORDINARY MACR (IN WHICH CASE +;UNWINDING ISN'T FINISHED). SKIP 2 AFTER POPPING A MACRO CALLED +;BY A MACXQ. +UNWIND: HRRO A,ITRPTR ;FIND INNERMOST ERRSET OR ITERATION, + SKIPN ITRPTR ;[ ;IF NO ITERATION, POP ANY MACRO OR ^]^X. + SKIPA CH,[400,,MACPDL-1] + MOVE CH,MFMACP-MFBLEN+1(A) + CAMN CH,MACPDP ;[ ;ANY MACRO OR ^]^X CALLS INSIDE IT => POP THEM. + JRST UNWINI ;ELSE HANDLE THE ERRSET OR ITERATION. +UNWINM: LDB CH,MACPDP ;[ ;IS IT A MACRO? OR A ^]^X? + CAIN CH,10 + JRST UNWIN2 ;IT'S A NULL, THROW IT AWAY. + TRNE CH,10 + JRST UNWIN1 ;[ ;IT'S A ^]^X. + SKIPN MACPTR + .VALUE ;MACPDP AND MACPTR OUT OF PHASE?? + CALL DECDCH ;IT'S A MACRO CALL, RESTORE SQUOTP, ETC. + CALL POPMAC ;POP STRING PTR, ETC. + AOS (P) ;SKIP 1 OR 2 DEPENDING. + SKIPGE MACPTR + AOS (P) + JRST POPMP + +UNWIN1: CALL DECDCH ;[ ;POP A ^]^X. + CALL POPCTX + CALL PUSMAC +UNWIN2: CALL POPMP + JRST UNWIND + +UNWINI: SKIPN ITRPTR ;TRYING TO UNWIND WHEN NO ITERATION OR MACRO => + .VALUE ;UNWIND'S CALLER'S END TEST FAILED. + HLRZ CH,ITRPTR ;IS THIS AN ERRSET OR AN ITERATION? + CAIN CH,(A) + RET ;REACHED AN ERRSET. + CALL ITRPOP ;AN ITERATION - POP IT + JRST UNWIND ;AND LOOK AT THE NEXT ONE OUT. + +;FS ^R EXIT - WITHIN A MACRO CALLED FROM ^R, RETURN FROM THE ^R. +;FS ^R THROW - WITHIN A MACRO CALLED FROM ^R, RETURN TO ^R. +FSCREX: SKIPA Q,[FSCRE1,,MEXIT1] +FSCRTH: MOVE Q,[FSCRT1,,MEXIT1] + SKIPN DISPRR ;NOT INSIDE ^R => ERROR. + TYPRE [N%R] + JRST MEXIT1 + +;FS BACK RETURN$: RETURN TO A SPECIFIED FRAME (SPECIFIED A LA FS BACK ARGS$). +FSBKRT: CALL BACKTR ;A GETS A POINTER TO THE FRAME TO RETURN TO. + MOVE Q,[FSBKR2,,FSBKR1] + SOS A ;REMEMBER ADDR OF FRAME (MINUS 1, + MOVEM A,GCTAB ; AS IT WILL BE WHEN ON THE FREELIST). + JRST MEXIT1 + +FSBKR1: SKIPA B,[CD5A] ;AFTER POPPING A MACRO FRAME, B GETS HOW TO RETURN +FSBKR2: MOVEI B,CPOPJ ;TO THAT FRAME, DEPENDING ON WHETHER IT WAS A MACXQ. + MOVE A,GCTAB + CAME A,MFFREE ;IF THE FRAME JUST POPPED INTO AND FREED WAS THE RIGHT ONE, + JRST MEXIT1 ;RETURN TO IT. ELSE, KEEP POPPING. + JRST (B) + +;^\ - IN A MACRO, RETURN FROM IT, POPPING QREGS AND ITERATIONS. +;:^\ DOESN'T POP QREGS. +MEXIT: SKIPN MACPTR + TYPRE [NIM] ;"EXIT MACRO" IF NOT INSIDE ONE? + MOVE Q,[CPOPJ,,CD5A] +;RH(Q) HAS WHERE TO GO AFTER POPPING A MACRO CALLED BY "M". +;LH(Q) HAS WHERE TO GO AFTER POPPING A MACXQ. +MEXIT1: MOVE C,MACSPF ;PLACE TO POP TO. + TRZN FF,FRCLN ;POP THE QREG PDL UNLESS :^\. + JRST [ SAVE Q + CALL FSQPU0 + REST Q + JRST .+1] +MEXIT2: CALL UNWIND ;POP A MACRO OR ITERATION. + JRST [ CALL ITRPOP ;HERE IF ENCOUNTER AN ERRSET. + JRST MEXIT2] + JRST (Q) ;POPPED AN ORDINARY MACRO. + MOVE CH,MACXP ;POPPED A MACRO CALLED BY A MACXQ. + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SET P FROM CH, UNWIND STUFF, THEN POPJ P, + HLRZ CH,Q + JRST (CH) + +FSCRE1: SKIPA C,[RREXI0] +FSCRT1: MOVEI C,RRTHRW + SKIPE A,MACXP ;WE HAVE JUST POPPED THE MACRO CALLED FROM ^R, IF + CAMG A,DISPRR ;THE NEXT POSSIBLE CANDIDATE MACRO FRAME + JRST (C) ;IS TOO FAR OUT ON THE CONTROL STACK. + JRST MEXIT1 ;NO, POP THE INNERMOST MACRO AGAIN. + +SUBTTL QUIT/ERROR REINITIALIZATION + +;COME HERE ON INITIALIZATION, QUIT, AND ^W COMMAND. +CTLW: SETOM GOXFLS ;POP TO TOP LEVEL; DON'T INVOKE ERROR HANDLER OR MAKE BREAK LOOP + +;COME HERE ON ERROR. +;IMQUIT IS POSITIVE IF WE QUIT OUT OF LIS (TECO COMMAND READER). IT MEANS DON'T + ;WE SHOULD STAY IN THE COMMAND LEVEL THAT WAS CALLING LIS. +;OTHERWISE, IF $QERRH (Q..P) IS NONZERO, IT IS THE ERROR HANDLER MACRO TO CALL. +;OTHERWISE, IF UNWINF (FS*RSET$) IS NONZERO, CREATE A BREAK LOOP. +GOX1: SKIPN CH,LEV ;COMPUTE THE PDL LEVEL AT THE INNERMOST + MOVE CH,[-LPDL,,PDL-1] + SKIPN Q,MACXP ;INVOCATION OF THE COMMAND LOOP OR ^R. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q ;NAMELY, MUST BE INSIDE ALL OPEN-PARENS, + MOVE CH,Q ;INSIDE ALL MACXQ'S, ABOVE BOTTOM OF STACK, + SKIPN Q,DISPRR ;AND ABOVE DISPRR. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q + MOVE CH,Q + SKIPGE GOXFLS ;MAYBE WE HAVE BEEN RQ'D TO POP ALL THE WAY TO TOP. + MOVE CH,[-LPDL,,PDL-1] + CAME P,CH ;MUSTN'T PUSHJ CH, IF CH=P, SINCE RET. ADDR WOULD BE UNPROTECTED + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING SOME STUFF; THEN POPJ P, + SKIPL TYOFLG ;IF TYPEOUT IN PROGRESS, FORCE IT OUT. + CALL DISFLS + SETZM CTLCF + SKIPE CPTR + CALL ERRP2 ;MARK THE CURRENT PC FOR "?" TO DISPLAY. + MOVE C,IMQUIT + SETZM IMQUIT + MOVE TT,BEG + SKIPN E,RREBEG ;MUSTN'T RUN OUTSIDE ^R WITH RREBEG ZERO. + MOVEM TT,RREBEG + SKIPL ERRFLG + SETZM LASTER ;IF NO ERROR, MAKE SURE FS ERROR IS 0. + HRRZM P,ERRFL1 ;AS YET, NO ERROR MESSAGE PRINTED (THOUGH MAY CHANGE) + SKIPN GOXFLS ;IF WE'RE POPPING TO TOP, DON'T PUSH NOW. + SKIPLE C ;IF THIS IS TECO STARTUP, OR QUIT OUT OF COMMAND READER, + JRST GOX4 ;THERE'S REALLY NOTHING TO PUSH NOW. + SKIPN UNWINF ;ENTER BREAK LOOP? + SKIPE $QERRH ;OR HAVE AN ERROR HANDLER? + CAIA + JRST GOX4 ;NEITHER; NO NEED TO PUSH. + JUMPN E,GOX5 ;IF ERROR OCCURRED ACTUALLY INSIDE ^R (NOT WITHIN A MACRO) + SAVE [[ MOVE P,DISPRR + REST A + JRST RRLP]] ;THEN SIMULATE A MACXQ CALL WHICH, WHEN RETURNED FROM, WILL + SAVE MACPTR ;RETURN TO ^R. + SAVE MACXP + SETOM MACPTR + MOVEM P,MACXP +GOX5: JSP T,OPEN1 ;NOW PUSH VALUES + CALL PUSMAC ;AND THE CURRENT MACRO (THAT ERRED). + CALL FLGENC ;ENCODE AND SAVE SQUOTP AND RCHALT + IDPB CH,MACPDP + SETZM SQUOTP + CALL GOCPY ;IF CBUF IS ON MACRO PDL, COPY IT TO A STRING + ;SINCE CBUF IS LIKELY TO BE OVERWRITTEN NOW. + SKIPE A,$QERRH ;IF THE USER HAS AN ERROR HANDLER, GO TO IT. + JRST [ TRO FF,FRCLN ;WE ALREADY PUSHED THE ERRING MACRO; NO NEED TO PUSH AGAIN. + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + JRST MAC5] ;NOW RUN THE ERROR HANDLER. +GOX4: TRO FF,FRARG\FRCLN\FRUPRW + SKIPGE GOXFLS ;GOXFLS AND ERRFLG IMPLY THIS IS "ERROR ENTERING ERROR HANDLER" + TRZ FF,FRCLN ;SO DON'T OVERWRITE THAT LINE WITH THE ERROR MSG. + SKIPE C,LASTER ;NO USER ERROR-HANDLER, SO IF RESPONDING TO AN ERROR, + CALL FGCMD ;PRINT STANDARD ERROR MESSAGE, FLUSH TYPEAHEAD, AND TYPE A BELL. + SETOM UNRCHC ;IF WE ARE ^G-QUITTING BACK TO TECO CMD LOOP, FLUSH THE ^G. + SETZM TYISRC + SETZM TYISNK + SETOM TYOFLG ;FORCE TYPEOUT TO RE-INIT. + SKIPN RGETTY + CALL CRR + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + SKIPN UNWINF ;NOW NORMALLY ENTER A COMMAND LOOP, BUT + SKIPN A,DISPRR + JRST GO + SKIPE MACXP + CAML A,MACXP ;IF DON'T WANT A BREAK LOOP AND INSIDE A ^R, RETURN TO THAT ^R. + JRST [SETZM RREBEG + JRST RRTHRW] ;HOW TO DO IT DEPENDS ON WHETHER WE CALLED ANY MACROS FROM IT. + JRST FSCRTH + +;ALTMODE AS COMMAND. +ALTCMD: SKIPGE NOOPAL ;FS NOOPALT NEGATIVE => IGNORE ALTMODE. + JRST CD5 + SKIPN NOOPAL ;POSITIVE => ALTMODE IS LIKE ^_. + TYPRE [DCD] ;ERROR IN MACROS, IGNORE AT TOP LEVEL. +LGOGO: + ;COME HERE WHEN EXECUTE ^_, PERHAPS ALTMODE. + CALL FLSOUT ;EMPTY OUTPUT BUFFER INTO OUTPUT FILE. +IFN ITS,[ + .SUSET [.RJNAM,,A] + CAME A,['HACTRN] + .LOGOUT +] + AOSN CTLCF ;IF READ ^C, + CALL FSEXI1 ;RETURN TO DDT. + HRRZM P,ERRFL1 +GO: MOVE A,GOXFLS ;IF WE'RE REQUESTED TO POP ALL THE WAY + SETZM GOXFLS + SKIPE UNWINF ;OR NOT IN *RSET MODE, + JUMPGE A,GO2 + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING OUT OF ^R OR SORT OR PARENS. + SETZM MACXP + SETZM NOQUIT + SETZM MACPTR + SETZM MACDEP + SETZM CTXPTR + SETZM ITRPTR + MOVE A,[400,,MACPDL-1] + MOVEM A,MACPDP + MOVEI A,MFSTRT-1 ;NOW PUT ALL CELLS ON THE FREE LIST. + SETZM MFFREE + MOVE B,MFEND +GO1: SKIPL MFBEG+1(A) .SEE MFBFR ;FREE ALL MACRO FRAMES, EXCEPT THOSE OF BUFFERS. + CALL FLSFRM ;FREE IT. + ADDI A,MFBLEN + CAIGE A,-1(B) + JRST GO1 + MOVE C,PFINI ;UNWIND QREG PDL. + CALL FSQPU0 +GO2: MOVEI A,(JFCL) + HRLM A,RCHALT + SETZM SQUOTP + SETZM MACBTS ;THERE ARE NO MACRO ARGS IN TOP-LEVEL CMD STRING. + CALL FLSCM1 ;FLUSH SOME CORE, AND FORCE OUT OUTPUT BUFFER. + SKIPL TYOFLG ;FORCE ALL TYPEOUT TO BE PRINTED. + CALL DISFLS + SETZM IMQUIT + SKIPN ECHOFL + CALL SETTTM ;TURN ECHOING BACK ON IF NECESSARY. + SKIPE MORFLF ;IF PREVIOUS COMMAND FLUSHED, + SETOM TYOFLG ;NEXT TYPEOUT WILL REINIT AND UN-FLUSH. + SETZM MORFLF + MOVE C,QRB.. + MOVE C,.QPT1(C) ;GET WHAT . WAS WHEN LAST CMD STRING STARTED. + CALL FSPSPT ;PUSH ON . RING BUFFER. + MOVE CH,QRB.. ;MACRO ..L IF THAT'S APPROPRIATE. + MOVE A,.QRSTR(CH) + AOSN INITF1 + JUMPN A,GOXX + CALL VIEW2 ;NOW GO TRY TO DISPLAY DIR. OR BUFFER. + JRST LIS + +GOXX: TRO FF,FRCLN ;DO A :M TO ..L, MAKING IT THE TOP LEVEL MACRO FRAME + JRST MAC5 ;LEAVING MACPDL EMPTY. + +;FIND THE MACRO FRAME THAT IS EXECUTING OUT OF CBUF, COPY THE CONTENTS +;OF CBUF INTO A STRING, AND MAKE THE MACRO FRAME POINT TO THAT STRING INSTEAD. +;THE GOAL IS TO FREE UP CBUF FOR RE-USE WHEN COMMAND READER IS ENTERED +;IN A BREAK LOOP. +;DOESN'T PROMISE TO RPESERVE ANY ACS. +GOCPY: MOVEI A,MFSTRT +GOCPY1: SKIPGE MFBEG(A) .SEE MFBFR ;DONT CONSIDER BUFFER FRAMES. + JRST GOCPY2 + HRRZ C,MFCPTR(A) ;WHERE DOES B.P. OF MACRO FRAME POINT? + JUMPE C,GOCPY2 ;IGNORE FREE CELLS; THERE MAY BE SOME -> CBUF. + CAIL C,@CBUFLO + CAIL C,@CBUFH + JRST GOCPY2 + JRST GOCPY3 ;CPTR OF THIS FRAME POINTS WITHIN CBUF! + +GOCPY2: ADDI A,MFBLEN + CAMGE A,MFEND ;SCAN ALL FRAMES. + JRST GOCPY1 + RET ;NO FRAME POINTS IN CBUF - NO COPYING NEED BE DONE. + +GOCPY3: HRRZ E,CBMAX ;HOW LONG IS USED PART OF CBUF? + MOVEI C,4(E) ;GET THAT MUCH SPACE, PLUS SOME FOR STRING HEADER + CALL SLPQGT + MOVEI B,QRSTR + MOVEI C,4(E) + CALL QHDRW1 ;WRITE HEADER OF STRING; B.P. RETURNED IN BP TO IDPB TEXT. + MOVE C,E + MOVE IN,CBUFLO ;AND GET B.P. TO ILDB TEXT TO COPY. +GOCPY4: ILDB CH,IN + IDPB CH,BP + SOJG C,GOCPY4 + MOVE BP,QRWRT + SUB BP,QRBUF + TLO BP,400000 + MOVEM BP,MFCSTR(A) ;STORE STRING POINTER TO NEWLY CONSTRUCTED STRING IN MACRO FRAME. + MOVEI BP,4(E) + ADDB BP,QRWRT ;CLOSE THE FINISHED STRING; ET CHAR ADDR 1 + LAST CHAR. + SUB BP,MFCCNT(A) ;GET NEW CHAR ADDR OF CHAR CPTR SHOULD ILDB NEXT + CALL GETIBP ;AND SET UP CPTR -> SAME CHARACTER IN ITS NEW HOME. + MOVEM BP,MFCPTR(A) + RET + +SUBTTL F? COMMAND + +;F? COMMAND - MBOX CONTROL. +;ARGUMENT IS BIT-DECODED. NO ARG, OR ARG=0, IMPLIES ARG=30 . +;BIT 1.1 - CLOSE GAP. MAY BE NEEDED FOR COMMUNICATION WITH OTHER PROGRAMS +; THAT DON'T UNDERSTAND THE GAP. +;BIT 1.2 - GC STRING SPACE. USEFUL BEFORE DUMPING OUT OR IF IT IS SUSPECTED +; MANY STRINGS HAVE RECENTLY BEEN DISCARDED. +;BIT 1.3 - SWEEP THE JUMP CACHE. NECESSARY IF A STRING'S CONTENTS HAVE BEEN +; ALTERED BY THE F^E COMMAND, AND IT IS A MACRO THAT MIGHT +; HAVE CONTAINED "O" COMMANDS. +;BIT 1.4 - FLUSH UNOCCUPIED CORE. GOOD TO DO EVERY SO OFTEN, OR IF IT IS +; LIKELY THE BUFFER HAS JUST SHRUNK. +;BIT 1.5 - CLOSE THE GAP, IF IT IS > 5000 CHARACTERS. GOOD TO DO EVERY SO +; OFTEN, IN CASE USER DELETES LARGE AMOUNTS OF TEXT; SAY, +; WHENEVER EXCESS CORE IS FLUSHED. +FLSCMD: ARGDFL + SKIPE C + TRNN FF,FRARG ;NO ARG SAME AS ARG OF 30. +FLSCM1: MOVEI C,30 + HRLM C,(P) + CALL FLSOUT ;FIRST, FORCE OUT OUTPOUT BUFFER. + HLRZ C,(P) + MOVE A,EXTRAC + TRNE C,20 + CAIG A,5000 ;"20" BIT MEANS CLOSE GAP IF VERY LARGE. + TRNE C,1 ;"1" BIT MEANS CLOSE GAP IN ANY CASE. + CALL SLPSHT + TRNE C,2 ;IF "2" BIT IS SET IN ARG, DO A GC, + JRST GCC ;THAT INCLUDES FLUSHING CORE AND SWEEPING CACHE. + TRNN C,4 ;"4" BIT MEANS SWEEP JUMP CACHE. + JRST FLSCM2 + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 +FLSCM2: TRNN C,10 ;"10" BIT MEANS FLUSH UNUSED CORE. + RET +FLSCOR: SAVE A + SAVE C + SAVE B + MOVE A,BFRTOP ;OTHERWISE JUST FLUSH CORE. + CAMN A,BFRBOT ;DON'T FLUSH ALL PAGES, ELSE THE + ADDI A,1 ;GAP BETWEEN IMPURE STRINGS AND BUFFER WOULD FILL UP. + ADDI A,2000*5-1 + IDIVI A,5*2000 ;A_ # PAGES WE'RE REALLY USING. + MOVE C,MEMT ;C_ # OF LAST PAGE WE HAVE. + SUBM A,C ;C HAS -<# PAGES TO FLUSH> + JUMPE C,POPBCA + MOVE J,A +IFN ITS,[ + HRLM C,A ;A HAS AOBJN -> PAGES TO BE FLUSHED. + SKIPGE A ;WE'RE TRYING TO CORE UP??? + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A] + .VALUE +] +IFN TNX,[ + MOVEI B,(A) ;FIRST BLOCK TO DO + ASH B,1 ;MAKE A PAGE NUMBER + HRLI B,.FHSLF + SETO A, ;SAY UNMAP + ASH C,1 +IFN 20X,[MOVM C,C ;NUMBER OF PAGES + HRLI C,(PM%CNT) + PMAP ;UNMAP THEM +] +IFN 10X,[PMAP ;TENEX -- NO MULTIPLE PMAPS + AOJGE C,.+2 + AOJA B,.-2 +]] + MOVEM J,MEMT ;UPDATE # OF FIRST K OF NXM. + JRST POPBCA + +SUBTTL TECO COMMAND STRING READER + +LISCRF: CALL ECHOCR +LIS: HRRZM P,IMQUIT ;^G DURING TYPEIN QUITS IMMEDIATELY. + SETZM NOQUIT + SKIPGE STOPF ;PERFORM ANY PENDING QUIT. + CALL QUIT0 + SKIPN ECHOFL + CALL SETTTM ;MAKE SURE ECHOING IS ON. + SETZM RCHSFF + .I CASE=CASNRM ;REINIT THE INPUT CASE. + TTYACT ;TO SET "ACTIVATE ON NEXT CHAR REGARDLESS" AGAIN + CALL VBDACU + JFCL + SETZM CTLBRF + MOVE C,QRB.. + SETZM .QVWFL(C) + MOVE B,CBUFLO ;BP TO BEFORE CMD BUFF. + MOVE TT,CBMAX ;WAS THE PREVIOUS CMD STRING A LONG ONE? + CAIGE TT,10. + JRST LISSRT ;NO, IT WAS SHORT. + MOVEM TT,SAVCMX ;YES, THIS IS CMD STRING FOR ^Y TO INSERT. + MOVEI TT,SAVCW1-1 ;SO SAVE INFO ON IT SO SHORT CMDS + PUSH TT,1(B) ;WON'T CLOBBER THE BEGINNING OF IT. + PUSH TT,2(B) + PUSH TT,3(B) + .I SAVCPT=CPTR +LISSRT: SETZM CBMAX ;CBMAX COUNTS CHARS IN CMD STRING BEING READ IN + SETZM COMCNT + MOVEM B,CPTR ;INIT CPTR FOR EXECUTION OF THE CMD STRING + MOVEM B,CSTR + MOVE C,CBUFH + ;HANDLE ":TECO FOO BAR" FROM DDT + SKIPGE CMFLFL ;READING FROM INIT FILE => GO YANK AND XCT IT. + JRST LISINI +LI1: SKIPE RGETTY ;IF NO DISPLAY, + JRST LILUP + SKIPE CH,PROMCH ;PROMPT UNLESS PROMPTING DISABLED. + CALL TYANOW +;FALLS THROUGH TO READ THE FIRST CHARACTER. + +;FALLS THROUGH. +;LOOP AFTER HANDLING A CHAR OTHER THAN ALTMODE. +LILUP: TRZ FF,FRALT ;SAY THE PRECEDING CHAR WASN'T ALTMODE. +LI2: MOVE C,CBUFH + CAILE C,(B) ;LOOP BACK HERE AFTER ALTMODE, WITH FRALT SET. + JRST LI3 + ADDI C,100 ;IF WE'VE FILLED THE COMMAND BUFFER, MAKE IT BIGGER. + SAVE C + MOVEI C,500 ;MAKE SURE WHEN IMPURE STRING SPACE IS MOVED UP + CALL SLPQGT ;IT WON'T REACH BUFFER SPACE. + REST C + MOVE E,QRWRT ;LAST WD TO MOVE UP IS LAST IN IMPURE STRING SPACE. + IDIVI E,5 + MOVE J,QRBUF + IDIVI J,5 + SUBM E,J + MOVE CH,(E) + MOVEM CH,100(E) + SOS E + SOJGE J,.-3 + MOVEI T,500 + ADDM T,QRBUF + ADDM T,QRWRT +LI3: MOVEM C,CBUFH + SETZM CTLCF + CALL TYI ;READ CHARACTER FROM TERMINAL. + CALL TYINRM + MOVEI TT,^J ;PRETEND THAT EVERY CR IS FOLLOWED BY A LF. + CAIN CH,^M + MOVEM TT,UNRCHC + SKIPL CTLBRF ;[ ;LET ^]^Q QUOTE A ^C +IFN ITS, CAIE CH,^C +IFN TNX, CAIE CH,^Z ;^C IMPLIES GO + JRST LI3Z + SETOM CTLCF ;BACK TO DDT IF FINISH COMMAND STRING WITHOUT ERROR. + JRST LISEOF ;IT ALSO TERMINATES THE COMMAND STRING. + +LI3Z: CAME B,CBUFLO ;IF THIS IS 1ST CHAR, SOME CHARS ARE SPECIAL. + JRST LI3D1 ;NO, NORMAL. + JRST LISFST + +;COME HERE AFTER READING A CHAR, WHEN THE CMD BUFFER IS EMPTY. +LISFST: CAIN CH,^R + JRST RRIMMD + CAIN CH,^T + JRST EDIT + CAIN CH,^U ;^U => DISPLAY FILE DIR USING USER'S MACRO. + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) + TLO FF,FLDIRDPY + SETZM IMQUIT + JRST GO] + CAIN CH,^V + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + CALL POPPT ;POP . RING BUFFER. + JFCL + MOVE CH,QRB.. + MOVEM A,.QPT1(CH) ;PREVENT AUTOMATIC RE-PUSH. + JRST GO] + CAIN CH,^X + SKIPN LASTER + CAIA + JRST [CALL FECMD8 ? JRST GO] + CAIN CH,^Y + JRST LISCY + TRNN FF,FRQMRK + JRST LI3D1 + CAIN CH,"? + JRST ERRTYP +LI3D1: PUSHJ P,CKCH + JRST LISCRF ;RUBOUT ON AN EMPTY BUFFER. + JRST [SETZM CTLBRF ? JRST LILUP] ;A CHAR WAS RUBBED. +LISTOR: AOS CBMAX + IDPB CH,B + AOSE CTLBRF ;[[ ;WAS THIS CHAR PRECEDED BY ^] OR ^]^Q? + JRST LISBR1 ;NO. + CAIN CH,^Q ;YES, ^Q=> NEXT CHAR ALSO QUOTED. +LISBRC: SETOM CTLBRF + JRST LILUP ;[ ;QUOTED ^] AND ALTMODE AREN'T SPECIAL. + + ;[[ BRACKETS MUST BALANCE FOR CONDITIONALS. +LISBR1: CAIN CH,^] ;NOT QUOTED, ^] QUOTES NEXT CHAR. + JRST LISBRC + CAIE CH,ALTMOD ;ALTMODE => CHECK FOR ALT-ALT, MAYBE END STRING. + JRST LILUP + TRON FF,FRALT ;SAY JUST SAW AN ALTMODE, + JRST LI2 + JRST LISDUN ;PREV. CHAR ALSO ALTMODE => END STRING. + +CKCH: CAIE CH,177 + JRST POPJ2 ;OK CHAR - RETURN, SKIPPING TWO + CAMN B,CBUFLO + POPJ P, ;RUBBED TO BEGINNING - NO SKIP + LDB CH,B + PUSHJ P,FSECOR + DBP7 B + SOS CBMAX + JRST POPJ1 ;RUBBED ONE CHAR - RETURN, SKIPPING ONE + +;COME HERE ON ^C ON TTY. +LISEOF: MOVEI CH,ALTMOD ;DUMMY UP TWO ALTMODES. + IDPB CH,B + AOS CBMAX + IDPB CH,B + AOS CBMAX + +;COME HERE AFTER HANDLING AND STORING ALTMODE-ALTMODE +LISDUN: MOVEI CH,^_ ;^_ TO STOP EXECUTION OF CMD STRING. + IDPB CH,B + AOS TT,CBMAX + MOVEM TT,COMCNT + +;INITIALIZE RANDOM STUFF FOR ANOTHER CMD STRING. + SETZM IMQUIT + SETZM ERRFLG ;DON'T IGNORE 1ST LINE OF NEXT V-COMMAND. +IFN TNX,SETZM ECHOP ;NOT IN ECHO AREA ANY MORE + SKIPN RGETTY + PUSHJ P,CRR + TRZ FF,#FRTRACE + MOVE A,PT ;Q..I _ . . + SUB A,BEG + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + MOVEM A,.QPT1(CH) ;PUT . INTO Q..I. + JRST CD + +POPJ2: AOS (P) +CPOPJ1: POPJ1: + AOS (P) + POPJ P, + +LISINI: CALL RRED1 ;INIT FILE OPEN ON CHFILI; PREPARE TO YANK IT. + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS. + MOVEI A,[ASCIZ /^ Y :M(HFX*)/] + SETZM CMFLFL ;COMMAND FILE HAS BEEN HANDLED (ALMOST) + SETZM IMQUIT + CALL MACXCW ;XCT THAT STRING, TO YANK AND XCT THE INIT FILE. + JRST GO + +;CONTROL-Y WAS 1ST CHAR TYPED -- +; INSERT LAST COMMAND STRING INTO BUFFER, THEN REDISPLAY. +LISCY: MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^Y. + SETOM SQUOTP ;[ ;DON'T LET ^] EXPAND WHEN WE REREAD CMD STRING. + SETOM BRC1 + .I COMCNT=SAVCMX + HRROI TT,SAVCW3 ;RESTORE THE LAST LONG (>7 CHARS) CMD STRING + POP TT,3(B) ;.I <3RD WD OF CMD BUFFER>=SAVCW3 + POP TT,2(B) + POP TT,1(B) + MOVE B,SAVCPT + SETO OUT, + +LISCY1: CALL SKRCH ;READ CHAR FROM CMD STRING, DON'T TRACE. + MOVE C,COMCNT ;IF WE'VE REACHED THE $$^_ AT THE END, + CAIGE C,3 ;DON'T PUT THE $ IN THE BUFFER. + JRST [JUMPL OUT,GO ;IF CMD STRING WASN'T ALL READ, + MOVEM OUT,PT ;PUT PT AFTER LAST CHAR THAT WAS. + JRST GO] + CALL TYOMGS ;INSERT NEXT CHAR OF CMD STRING INTO BUFFER. + CAMN B,CPTR ;THE PTR SHOULD END UP AT THE POINT + MOVE OUT,PT ;COMMAND STRING READING STOPPED. + JRST LISCY1 + +;? WAS 1ST CHAR TYPED AFTER ERR MSG, RETYPE LAST FEW CHARS. +ERRTYP: HRRZM P,ERRFL1 ;DON'T LET ERRFL1 PREVENT OUR TYPEOUT FROM APPEARING. + MOVE B,ERR2 + MOVEI C,8*5 + SUBI B,8 + ILDB CH,B + CAMG C,ERR1 + PUSHJ P,TYO + CAME B,ERR2 + SOJA C,.-4 + JRST GO + +;MARK THE CURRENT MACRO PC FOR ERRTYP TO TYPE OUT. +ERRP2: MOVEI A,COMCNT + CALL MFBEGP ;C GETS CURRENT PC IN CHARS IN CURRENT MACRO. + TRO FF,FRQMRK + MOVEM C,ERR1 ;SAVE THAT, AND B.P. TO LAST CHAR READ. + MOVE A,CPTR + MOVEM A,ERR2 + RET + +SUBTTL ^R MODE + +;GET LENGTH CODE OF CHAR IN CH INTO A. +;SKIP IF NOT A CTL CHAR. NOTE THAT CALLING DISAD6 MAY BE +;EQUIVALENT TO DOING CALL .+1 . +DEFINE RRCHRG + SKIPE CASDIS ;IN -1F$ MODE, HANDLE SLASHIFICATION. + CALL DISAD6 + MOVEI A,(CH) + IDIVI A,6 + LDB A,RRCHBP(B) + CAIN CH,177 ;RUBOUT PRINTS AS ^? OR AS INTEGRAL SIGN, SO TREAT IT AS A CTL CHAR. + SKIPA A,[1] + CAIGE CH,40 +TERMIN + +;ENTRY FOR ^R 1ST CHAR TYPED IN CMD STRING. +RRIMMD: SAVE [GO] + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^R. + SETZM IMQUIT + +;^R EXECUTED AS A COMMAND. +RRENTR: .I CASE=CASNRM + TLZA FF,FLNOIN ;SAY INPUT IS ACCEPTIBLE. +;"^ V" COMMAND WITHIN A MACRO CALLED FROM ^R MODE COMES HERE. +RRNOIN: TLO FF,FLNOIN ;ENTRY TO DISPLAY ONCE AND RETURN, PROCESSING NO INPUT. + CALL RREARG ;PROCESS ARGS IF ANY, DECIDE WHAT REDISPLAY NEEDED. + ;ALSO MAKE SURE RRHPOS AND RRVPOS ARE REASONABLE. + SAVE FF ;REMEMBER WHETHER THIS IS ^R OR ^ V, FOR RREAR0. + SAVE PF ;SAVE QPDL PTR SO EXITING ^R CAN POP WHAT FS ^R ENTER PUSHES. + SAVE DISPRR + CALL [MOVEM P,DISPRR ;SET UP PDL RESTORATION POINT + RET] ;FOR ERRORS CAUGHT BY ^R. + JUMPL FF,RRNOI2 + SKIPE A,RRENTM + CALL RRMACR +RRNOI2::SETOM ECHCHR ;ENTERING ^R SHOULDN'T ECHO A COMMAND. ^ V SHOUDLN'T ECHO ONE. +;DROPS THROUGH. + +SUBTTL ^R MODE REDISPLAY + +;DROPS THROUGH. + +;MAIN LOOP OF ^R EDIT: ROUTINES DISPATCHED TO WILL POPJ TO HERE. +RRLP: CAIA + CALL RRTTY1 ;BUILT-IN COMMANDS SKIP TO "RETURN ONE VALUE", SO SCAN CURSOR MOTION. + CALL RRTTYE ;PRINTING TTY IN SCAN MODE, IF COMMAND DOESN'T TYPE OUT, ECHO IT. + SETZM STOPF + SETZM ORESET + TLNN FF,FLNOIN + CALL RRARGF + JUMPL FF,RRLP6 ;THIS IS ^R AS OPPOSED TO ^V + MOVE CH,INCHCT ;THEN IF THE LAST COMMAND WAS NOT AN ARG-SETTER, + SKIPE RRLAST ;THEN A COMMAND HAS JUST ENDED, SO SAVE FS TYI COUNT IN FS TYI BEG. + MOVEM CH,INCHRR + SKIPLE RRMCCT ;AND IF FS ^RMDLY ISN'T 0, + SOSLE RRMCC1 ;THEN IF IT IS ALREADY TIME TO INVOKE SECY, DO SO. + JRST RRLP6 + MOVE CH,QRB.. ;IF THERE IS ONE. IF THERE IS NONE, RRMCC1 IS NEGATIVE SO AS + SKIPN A,.QCRMC(CH) ;SOON AS THERE IS ONE AGAIN IT WILL BE RUN. + JRST RRLP6 + CALL RRMACR ;DO SO. + MOVE A,RRMCCT ;AND REINIT # CHARS TO EXECUTE BEFORE + MOVEM A,RRMCC1 ;NEXT INVOKATION. +RRLP6: SETO OUT, ;WE HAVEN'T RUN THE FS ^R DISPLAY MACRO YET. +RRLP6A: SKIPN RGETTY + JRST [ SKIPGE GEA ;ON PRINTING TTY, REDISPLAY ONLY AFTER A ^L. + JRST RRLP4 + JRST RRLP1] ;OTHERWISE JUST READ ANOTHER COMMAND. + SKIPE ECHFLS + SKIPL ECHACT ;IF ECHO AREA SHOULD BE CLEARED, DO SO. + JRST RRLP6B + SKIPL PJATY ;IF WHOLE SCREEN IS ABOUT TO BE CLEARED ANYWAY, DON'T BOTHER. + TLNE FF,FLNOIN ;CLEAR ECHO AREA ONLY AT TIMES WHEN INPUT COULD BE READ. + JRST RRLP6B + MOVEI C,^P + CALL FSECDS + MOVEI C,"C + CALL FSECDS ;FSECDS SETS RROVPO SO WE WILL REPOSITION THE CURSOR WHEN WE CAN. + SETZM ECHACT ;INDICATE ECHO AREA CLEAR NOW. +RRLP6B: SKIPE RRINHI ;IF DISPLAYING IS INHIBITED, READ ANOTHER COMMAND WITHOUT DISPLAYING + JRST [ MOVE T,MORESW ;BUT DO UPDATE THE MODE-LINE. + CALL DISMD + JRST RRLP1] + SKIPE DFORCE + JRST RRLP6C + LISTEN TT + JUMPN TT,RRLP1 ;ANY BUFFERED INPUT TO PROCESS? + SKIPGE UNRCHC + SKIPE TYISRC + JRST RRLP1 +RRLP6C: SETOM TYOFLG ;DOING ^R DISPLAY FORCES TYPEOUT TO RE-INIT. + SKIPGE GEA ;^L OR F+ HAS CLEARED THE SCREEN => REDISPLAY + JRST RRLP4 + SKIPL PJATY ;SCREEN GOT CLOBBERED, OR LOTS OF CHANGES HAPPENED, => + SKIPGE RRMNVP ;MUST CHECK THE WINDOW BEFORE DISPLAYING ANYTHING. + JRST RRLP4 + CALL RRWBLS ;IS OLD WINDOW STILL GOOD? + CALL [ TRO FF,FRUPRW ;NO => CHOOSE A NEW ONE FROM SCRATCH, AND + JRST RRALT6] ;TRY SCROLLING THE TEXT WITH INSERT/DELETE LINE. + MOVE A,RRMAXP ;RRMAXP=1 IS SET TO INHIBIT UPDATING IN RRDLB AND RRINSC. + CAIN A,1 ;IT DOESN'T INDICATE ANY CHANGES HAVE ACTUALLY OCCURRED. + SETZM RRMAXP + SKIPN RRMAXP ;ANY REDISPLAY REQUIRED? + SKIPE RRMSNG + CAIA + JRST RRLP3 ;NO, JUST MOVE CURSOR IF NEC. + MOVE A,RRMNVP + CAML A,BOTLIN ;IF ALL REQUIRED REDISPLAY IS REALLY OFF BOTTOM OF SCREEN, + JRST [ CALL RRDIS2 ;SAY IT'S BEEN DONE, AND MOVE THE CURSOR IF NEC. + JRST RRLP3] + JUMPE OUT,RRLP2F ;RUN FS ^R DISPLAY, UNLESS WE JUST FINISHED RUNNING IT. + SKIPN A,RRDISM ;ABOUT TO DISPLAY; FIRST CALL USER'S MACRO. + JRST RRLP2F + CALL RRMACR + SETZ OUT, ;MARK FS ^R DISPLAY AS RUN, THIS TIME, TO AVOID INFINITE LOOP. + TRNN FF,FRARG2 ;IF 0 OR 2 VALUES, RECONSIDER WHAT DISPLAY TO DO + TRNN FF,FRARG + SETO OUT, + JRST RRLP6A + +;HERE IF PART OF THE SCREEN NEEDS REDISPLAY BUT NOT WHOLE SCREEN. +RRLP2F: SETOM RRIDLB ;IF NO INSERT/DELETE LINE, CAUSE ASSOCIATED CODE TO DO NOTHING. + SKIPE LID ;IF THE TERMINAL HAS INSERT/DELETE LINE, SEE HOW MANY LINES OF + CALL RRLID ;BOTTOM OF WINDOW WILL STILL BE GOOD IF SHIFTED A FEW LINES. + CALL CHCTI0 ;INIT. FOR CALLING DISAD. + SETZM CHCTBP + AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET) + HLLOS DISBFC + MOVEI TT,CPOPJ + MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS. + .I RRDHPS=RRHPOS ;SAVE INFO FOR DEBUGGING. + .I RRDVPS=RRVPOS + .I RRDMHP=RRMNHP + .I RRDMVP=RRMNVP + SAVE PT + SAVE RRHPOS + SAVE RRVPOS +RRLP2G: MOVE A,RRMNVP ;FIND THE 1ST CHAR IN THE 1ST LINE + MOVEM A,RRVPOS + LDB TT,[3300,,LINBEG(A)] ;WHICH WAS ALTERED, + MOVEM TT,PT + MOVE TT,LINBEG(A) + ASH TT,-33 + MOVEM TT,RRHPOS ;AND WHAT COLUMN IT WAS TYPED IN. + MOVEM TT,CHCTHP ;IN CASE LINE DOESN'T START AT LEFT MARGIN + ;(DUE PERHAPS TO LF WITHOUT CR) + CALL CHCTL4 ;INIT CHCTHC WITH SPACES. + SETZ T, ;T GETS THE LARGEST HPOS THAT ACTUALLY EXISTS ON THE LINE. + ;IF THE LINE ENDS SHORT OF RRMNHP, WE RESET RRMNHP TO THAT AND RETRY. +RRLP2B: MOVE TT,RRHPOS ;MOVE FORWARD TILL WE FIND 1ST CHAR + CAML TT,RRMNHP ;THAT FALLS IN THE 1ST ALTERED COLUMN. + JRST RRLP2C + MOVE TT,PT + CAML TT,ZV + JRST RRLP2C + CALL RRFORW + CAMGE T,RRHPOS + MOVE T,RRHPOS + MOVE TT,RRVPOS + CAME TT,RRMNVP ;BUT DON'T LET US MOVE PAST THE END OF + JRST RRLP2D ;THE LINE WE'RE SUPPOSED TO START ON. + CALL DISAD2 ;PUT THE CHARACTERS WE SKIP OVER INTO THE LINE'S HASH CODE. + JRST RRLP2B + +RRLP2D: MOVEM T,RRMNHP ;HERE IF THE LINE DOESN'T EXTEND AS FAR RIGHT AS RRMNHP SAYS. + CALL CHCTI0 ;SET RRMNHP BACK TO THE LARGEST HPOS ON THE LINE, AND TRY AGAIN. + JRST RRLP2G ;SO WE DISPLAY FROM THE VERY END OF THE LINE. + +RRLP2C: MOVE IN,PT ;CHAR ADDR 1ST CHAR TO BE OUTPUT. + CAML IN,BEGV + CAMLE IN,ZV + .VALUE + MOVEM IN,RRDPT ;REMEMBER WHERE OUTPUT STARTD, FOR DEBUGGING. + .I DISVP1=CHCTVP=DISVP=RRVPOS=RRMNVP + CALL DISLI6 + CAME TT,BOTLIN ;UNLESS IT'S THE --MORE-- LINE, + SKIPN CHCTHP ;IF WE'RE DISPLAYING A WHOLE LINE, DON'T CLEAR UNLESS CHECKSUM + JRST [ SETOM DISVP ;SAYS IT HAS ACTUALLY CHANGED. + SETOM DISVP1 + JRST RRLP2E] + CALL RRMVC ;DISPLAYING ONLY PART OF A LINE: CHECKSUM MECHANISM WOULD LOSE, + CALL CLREOL ;SO CLEAR THE PART WE WANT TO CLEAR, + SETOM HCDS(TT) ;AND DISABLE THE CHECKSUM MECHANISM TO FORCE OUTPUTTING. +RRLP2E: REST RRVPOS + REST RRHPOS + REST PT + MOVEI TT,DISLIN + MOVEM TT,CHCTAD + .I CHCTVS=BOTLIN + SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + CALL VBDOK3 ;DO THE DISPLAYING, + CALL RRDIS2 ;INDICATE NOW REDISPLAY NOT NEEDED. + JRST RRLP5 + +;TEST THE WINDOW FOR VALIDITY, ASSUMING RRVPOS IS CORRECT. +;MUCH FASTER THAN AN ACTUAL VBDBLS. +;CLOBBERS A, IN, TT, TT1. +RRWBLS: MOVE A,RRVPOS + SKIPN GEA + JRST RRWBL1 + CAMGE A,RRTOPM ;CURSOR TOO NEAR TOP => NEW WINDOW. + RET +RRWBL1: MOVE TT,MORESW + TRNN TT,MS%DWN ;IF THERE'S STUFF PAST THE SCREEN BOTTOM, + JRST RRWBL2 ;WE DON'T WANT CURSOR TOO NEAR BOTTOM. + CAML A,RRBOTM + RET +RRWBL2: CAMGE A,BOTLIN ;IF CURSOR'S BELOW BOTTOM, WE MUST SHIFT THE WINDOW. + JRST POPJ1 ;ELSE, OLD WINDOW IS STILL GOOD. + MOVE IN,PT ;EXCEPTION: CURSOR AT FRONT OF --MORE-- LINE + CAMG A,BOTLIN ;AT END OF BUFFER AFTER A CRLF, + CAME IN,ZV ;IS CONSIDERED AT THE END, RATHER THAN BELOW IT. + RET + SUBI IN,2 + CALL RREOLT ;SO CHECK FOR THE CRLF. + JRST POPJ1 + RET + +;COME HERE HAVING DETERMINED THAT A FULL SCREEN REDISPLAY IS NEEDED. +RRLP4: MOVE A,RRDISM ;DO FULL REDISPLAY, TESTING PREVIOUS WINDOW. + JUMPE A,RRLP5A + CALL RRMACR + SKIPL GEA ;ON RETURN, IS REDISPLAY STILL NEEDED OR WAS IT ALREADY DONE? + SKIPGE RRMAXP + JRST RRLP5A + SKIPGE PJATY ;IF SEEMS TO HAVE BEEN DONE, MAYBE WE SHOULDN'T DO IT. + SKIPE RRMSNG + CAIA + JRST RRLP6 +RRLP5A: SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + .I RRERFL=ERRFL1 + SETOM RRIDLB ;IN FULL REDISPLAY, NONE OF THE TEXT ALREADY ON THE SCREEN CAN BE REUSED. + CALL RRDISP ;NORMAL (VBD) DISPLAY, MAYBE CHANGING WINDOW. + CALL RRDIS2 ;REDISPLAY NOW NOT NEEDED, + SKIPL RRERFL ;UNLESS THIS REDISPLAY DIDN'T DISPLAY THE TOP LINE + JRST RRLP5 + .I RRMNVP=TOPLIN ;(PRESERVING AN ERR MSG) IN WHICH CASE REDISPLAY AFTER NEXT CMD. + SETZM RRMNHP + .I RRMAXP=GEA+BEGV +RRLP5: .I RROLDZ=Z + .I RROLZV=ZV + AOSN RRNCCR ;IF CHAR BEFORE PT WAS A CR, RRHPOS WASN'T SET + ;(DUE TO THE FACT THAT A CR ISN'T OUTPUT UNTIL THE + ;NEXT CHAR IS SEEN) + CALL [ SOS PT ;HPOS AND VPOS ARE CORRECT FOR BEFORE + JRST RRFORW] ;THE CR, SO SPACE OVER IT. + MOVE A,RRHPOS ;DON'T LET THE CURSOR BE OVER THE "!" + CALL RRFOR3 ;OF A CONTINUATION. +RRLP3: MOVE T,MORESW + CALL DISMD ;REDISPLAY Q..J IF IT HAS CHANGED, NOT CHANGING --MORE-- STATUS. + SKIPE RGETTY + CALL RRMVC ;PUT THE HARDWARE CURSOR AT THE POINTER. + JRST RRLP1 + +RRDISX: MOVEI T,RRLP1 ;COME HERE TO QUIT DISPLAYING BECAUSE INPUT WAITING. + MOVE CH,DISPRR + MOVEM T,(CH) ;PREVENT RRARGF FROM BEING CALLED. +;COME HERE IF STOP DISPLAYING SINCE KNOW NO MORE DISPLAY NEEDED. +RRDISF: MOVE P,DISPRR + .I RROLZV=ZV + MOVE T,Z + SUB T,RROLDZ + ADDM T,RROLDZ +RRDISG: MOVE A,T ;NOW UPDATE THE LINBEG WORDS OF THE REMAINING SCREEN LINES. + AOS TT,BP + CAMLE TT,BOTLIN + .VALUE + JRST RRFXR1 + +RRDISP: SKIPN RGETTY + JRST RRDIS3 + .I RRMNVP=TOPLIN ;IF DISPLAYING IS INTERRUPTED, MAKE + SETZM RRMNHP ;WE RESTART THE RIGHT WAY. + SETOM RRMSNG ;SAY WE CAN'T STOP DISPLAYING AT RRMAXP. + JRST VBDRR + +RRDIS1: MOVE CH,CHCTHP ;CALL HERE WHEN CURSOR IS OUTPUT, + MOVEM CH,RRHPOS ;OR AT END OF BUFFER IF PT IS THERE. + MOVE CH,CHCTCF ;IF THE LAST CHAR WAS CR, + MOVEM CH,RRNCCR ;SAY WE DON'T KNOW CORRECT HPOS. + MOVE CH,CHCTVP + MOVEM CH,RRVPOS ;REMEMBER SCREEN POS. OF CURSOR. + POPJ P, + +RRDIS2: SETZM RRMAXP ;HERE TO DECLARE THAT NO REDISPLAY IS NEEDED. + SETZM RRMSNG + HRLOI TT,377777 + MOVEM TT,RRMNVP + MOVEM TT,RRMNHP + POPJ P, + +;MOVE THE CURSOR TO THE PLACE SPECIFIED BY RRVPOS AND RRHPOS. +;ASSUMES THAT RROHPO, RROVPO HOLD CURRENT ACTUAL LOCATION OF CURSOR, +;OR -1 IF THE OLD POSITION IS NOT KNOWN. CLOBBERS Q. + +RRMVC: MOVE Q,RRHPOS + SKIPN RGETTY + MOVEM Q,CHCTHP + SKIPE RGETTY + CAME Q,RROHPO ;IF NEITHER COORD NEEDS TO BE CHANGED, + JRST RRMVC1 + MOVE Q,RRVPOS + CAMN Q,RROVPO + RET ;DON'T BOTHER TO DO ANYTHING. +RRMVC1: SAVE BP + HRRZ BP,RRHPOS + HRL BP,RRVPOS + HRRZM BP,RROHPOS + HLRZM BP,RROVPOS + CALL SETCU1 + JRST POPBPJ + +;HERE TO SEE IF ANY OF THE TEXT ON THE SCREEN, PAST ALL CHANGES WE MUST DISPLAY, +;CAN STILL BE USED IF WE CAN MOVE IT TO THE RIGHT LINE ON THE SCREEN +;(USING INSERT/DELETE LINE). SOMETIMES WE ACTUALLY MOVE THE TEXT AND BLT THE TABLES. +;USUALLY WE JUST SET RRIDVP TO THAT LINE'S VPOS AND RRIDLB TO ITS LINBEG WORD +;(RELOCATED TO CONTAIN A CURRENT ADDRESS RATHER THAN A HISTORICAL ONE). +;RRIDBK IS SET TO THE NUMBER OF BLANK LINES WHICH NOW PRECEDE THAT STILL-USEFUL LINE. +;IT IS USED IN RECOGNIZING WHERE THAT LINE IS GOING TO BE WANTED ON THE SCREEN +;AS SOON AS THE FIRST BLANK LINE IS REACHED IN TYPEOUT. THIS REDUCES WASTEFUL DISPLAY. +RRLID: CALL RRLID2 ;FIND THE TEXT TO BE PRESERVED, SET RRIDLB AND RRDVP. + RET ;NO SKIP MEANS NO TEXT ON SCREEN MAY BE PRESERVED. + MOVE BP,RRMNVP + MOVE TT1,RRIDLB + CAME TT1,LINBEG(BP) ;IF THAT TEXT OUGHT TO BE MOVED UP TO WHERE WE WILL START + RET ;DISPLAYING (IE, WE ARE DISPLAYING THAT SOME LINES WERE KILLED) + SETZM RRMAXP ;ALL CHANGES ARE BEING HANDLED BY THE LINE-DELETE, SO THERE AREN'T ANY MORE. +;DELETE LINES OF TEXT FROM C(BP) TO C(RRIDVP). +RRLID5: SOS BP + MOVE CH,RRMSNG + IOR CH,RRMAXP + CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT". + JUMPN CH,[ ;RRMSNG SAYS THAT THE STUFF BELOW DELETION POINT MAY NEED REDISPLAY + ;EVEN THOUGH IT'S AFTER RRMAXP, SO WE MUSNT'T TRY TO SKIP OVER IT. + MOVE TT,RRIDLB ;BUT GIVE THAT PLACE AN ACCURATE LINBEG TO RESTART + MOVEM TT,LINBEG+1(BP) ;REDISPLAY WITH. + RET] + MOVE BP,BOTLIN ;NOW ALL THAT NEEDS DISPLAYING ARE THE NEW BLANK LINES AT THE BOTTOM. + SUB BP,Q ;SO GET THE VPOS OF THE FIRST OF THEM, + CAMLE BP,TOPLIN ;AND START DISPLAYING AT THE LINE BEFORE IT, + SOS BP ;SINCE THAT'S THE LAST ONE WITH A VALID LINBEG. + EXCH BP,RRMNVP + SETZM RRMNHP ;NOTE THAT DSLID SETS RRMSNG. + MOVE CH,Z + SUB CH,RROLDZ ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP, +RRLID4: CAMLE BP,RRMNVP ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE + JRST RRLID6 ;CORRECT WITHOUT NEEDING RELOCATION. + ADDM CH,LINBEG(BP) + AOJA BP,RRLID4 + +RRLID6: MOVE CH,ZV ;DON'T LEAVE RRMNVP POINTING PAST THE END OF THE BUFFER. +RRLID7: MOVE BP,RRMNVP ;IF THE LINE IT POINTS AT IS AT OR AFTER THE END OF BUFFER, + CAMLE BP,TOPLIN ;MOVE IT BACK TO THE LINE THAT ACTUALLY FOLLOWS THE END. + CAME CH,LINBEG(BP) ;CHANGED FROM LINBEG-1(BP) SO DOESN'T LOSE ON A BUFFER + RET ;WHICH DOES NOT END WITH A CRLF. + SOS RRMNVP + JRST RRLID7 + +;DETERMINE WHETHER ANY OF THE LINES AT THE BOTTOM OF THE SCREEN CAN BE PRESERVED +;(PERHAPS MOVING THEM UP OR DOWN WITH INSERT/DELETE LINE). +;SKIP IF THERE ARE ANY, SETTING RRIDVP TO THE VPOS OF THE FIRST, AND RRIDLB +;TO THAT LINE'S LINBEG (UPDATED TO BE CORRECT WITH CURRENT Z, RATHER THAN RROLDZ). +RRLID2: SETOM RRIDLB + SETZM RRIDBK + MOVE OUT,RROLDZ + SUB OUT,Z ;COMPUTE ADDRESS BEYOND WHICH NO BUFFER CHANGES HAVE OCCURRED, + ADD OUT,RRMAXP ;RELOCATED TO MATCH OLD LINBEG WORDS. + MOVE BP,TOPLIN +RRLID1: CAMN BP,BOTLIN + RET ;REACH END OF WINDOW => NO EXISTING TEXT STILL GOOD. DON'T SET RRIDLB. + LDB TT1,[3300,,LINBEG(BP)] + CAMLE OUT,TT1 ;SEE WHICH LINE IS THE FIRST TO START AFTER THAT POINT. + AOJA BP,RRLID1 + ADD TT1,Z + SUB TT1,RROLDZ + CAMN TT1,BEGV ;A LINE IS ACCEPTABLE ONLY IF ITS TEXT IS STILL AT THE FRONT OF A LINE. + JRST RRLID3 ;SO REQUIRE THAT IT BE AT FRONT OF BUFFER OR AFTER A CRLF. + MOVE IN,TT1 + SUBI IN,2 + CALL GETINC + CAIE CH,^M + AOJA BP,RRLID1 ;IF THIS LINE NOT GOOD FOR THIS REASON, NEXT LINE PROBABLY STILL GOOD. + CALL GETCHR + CAIE CH,^J + AOJA BP,RRLID1 +RRLID3: MOVEM BP,RRIDVP ;RRIDVP POINTS AT 1ST LINE NOT INVALIDATED, OR AT BOTLIN IF ALL INVALID + MOVE TT1,LINBEG(BP) + ADD TT1,Z ;GET ADDR OF BEGINNING OF TEXT THAT CAN BE SAVED IF MOVED UP OR DOWN, + SUB TT1,RROLDZ ;RELOCATED TO BE THE CURRENT ADDRESS, NOT THE ADDR IT HAD + MOVE TT,TT1 + TLZ TT,777000 ;DON'T TRY TO MOVE FOLLOWING TEXT IF IT IS NULL (IT STARTS AT Z). + CAMN TT,ZV + RET + MOVEM TT1,RRIDLB ;WHEN LAST DISPLAYED. + MOVE IN,TT + SETOM RRIDBK ;NOW HOW MANY BLANK LINES ARE THERE BEFORE THAT POINT? +RRLID8: SOS IN ;SCAN BACKWARDS COUNTING THEM AND PUT NUMBER IN RRIDBK. + CAMGE IN,BEGV ;IF REACH BEG OF BFR JUST BEFORE A CRLF, THEN EACH CRLF WE PASSED + JRST [ AOS RRIDBK ;COUNTS FOR ONE BLANK LINE. + JRST POPJ1] + CALL GETCHR + CAIE CH,^J ;OTHERWISE, THE LAST CRLF WE FIND IS REALLY THE END OF A NONBLANK LINE + JRST POPJ1 ;AND SHOULDN'T COUNT. TO ARRANGE THAT, WE START COUNTING AT -1. + CAMG IN,BEGV + JRST POPJ1 + SOS IN + CALL GETCHR + CAIE CH,^M + JRST POPJ1 + AOS RRIDBK + JRST RRLID8 + +SUBTTL PRINTING TERMINAL ^R DISPLAY + +;DISPLAY CURRENT LINE AND PUT TTY CURSOR IN RIGHT PLACE, FOR PRINTING TTY SCAN MODE. +RRDIS3: SKIPN RRSCAN + RET + CALL RRBTCR + SETZM RRVPOS ;TYPE LINE UP TO POINT (0T) + SETZM RUBENC + CALL DISTOT + SETZ C, + CALL GETAG7 ;FIND RANGE (0F^@). + JFCL + .I GEA=E-BEGV + CALL TYPE2 ;TYPE IT. + TRO FF,FRCLN + MOVEI C,1 + CALL GETAG7 ;NOW TYPE TO END OF LINE. + JFCL + CAMN C,E + RET + CALL TYPE2 ;AND BS OVER IT, SAYING MUST DO A LF IF WE ARE AT THE END OF THE LINE. + JRST RRTTY2 + +;HERE TO HANDLE CURSOR MOTION, ON PRINTING TERMINAL IN SCAN MODE. +RRTTY: SKIPN RRSCAN + JRST RRBTCR + TRNN FF,FRARG ;IF WE KNOW NOTHING ABOUT THIS OPERATION, DON'T DISPLAY. + JRST RRBTCR ;WE COULDN'T DO ANYTHING BUT ^L; LET USER DECIDE ON THAT. + TRNE FF,FRARG2 + JRST RRTTID ;JUMP IF IT'S AN INSERT/DELETE OPERATION. + CALL RRMAC3 + SKIPGE RRMNVP + RET + MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,CPOPJ +RRTTY1: SKIPN RGETTY ;HERE TO SCAN MOTION CAUSED BY BUILT-IN ^F, ETC. + SKIPN RRSCAN + RET + MOVE A,RRVPOS ;SHOW THE USER THE CURSOR MOTION IN SOME NICE WAY. + SUB A,RREVPS ;UNLESS WE'RE ON THE SAME LINE, OR THE NEXT ONE, + JUMPL A,CPOPJ + CAIL A,2 ;DON'T JUST GO OFF AND PRINT LOTS OF GARBAGE; + RET ;LET USER DECIDE WHETHER TO REDISPLAY THE BUFFER. + MOVE C,PT + MOVE E,RREPT ;FORWARD HORIZONTAL MOTION => TYPE CHARS MOVED OVER. +RRTTY4: CAMGE E,C + JRST RRTTYF + CAMG E,C ;NO MOTION, EVEN, => STILL PREVENT ECHOING. + JRST RRTTY3 +RRTTY2: SKIPE A,RUBENC ;NO NEED TO LF BETWEEN TWO BACKWARD MOTION CMDS. + CAIN A,^J ;ASIDE FROM THAT, IF LAST THING DONE WANTED STUFF TYPED, + CAIA ;TYPE IT. + CALL RUBEND + CALL RRMVC ;BUT IF BACKWARD MOTION, JUST MOVE BACK TO HPOS, BUT + MOVEI A,^J + SKIPN BSNOLF + MOVEM A,RUBENC ;MAKE SURE WE TYPE A LF BEFORE TYPING ANYTHING ON THIS LINE. +RRTTY3: SETOM ECHCHR ;MAKE THIS COMMAND NOT BE ECHOED. + RET + +RRTTYF: SAVE DISPCR ;HERE TO SCAN FORWARD MOTION: TYPE CHARS MOVED OVER, + SETOM DISPCR ;WITH FS ^M PRINT$ SET TO -1 SO THAT STRAY CR AND LF + CALL TYPE2 ;COME OUT AS THEMSELVES. + REST DISPCR + RET + +;COME HERE AFTER A COMMAND. IF IN SCAN MODE ON PRINTING TTY, AND COMMAND DIDN'T +;TYPE ANYTHING, ECHO IT (BY TYPING THE CHAR OR STRING IN FS ECHO CHAR$). +RRTTYE: MOVE CH,ECHCHR + CAME CH,[-1] + SKIPE RGETTY + RET + SKIPGE GEA ;DON'T ECHO A ^L OR SIMILAR CHAR. + RET + SKIPE RRSCAN + SKIPN RRLAST ;DON'T ECHO ARG-SETTING COMMANDS. + RET + CAIL CH, + CALL TYINRM ;IF IT'S A CHAR (NOT A STRING) CONVERT TO 7-BIT. + JRST FSECO1 + +RUBEND: SAVE CH ;AND IF THERE'S ANYTHING TO TYPE (SUCH AS LF AFTER + SKIPE CH,RUBENC ;BACKWARD MOTION IN ^R MODE), TYPE IT. + CALL FSECOR + SETZM RUBENC + JRST POPCHJ + +;COME HERE TO HANDLE A COMMAND THAT RETURNED 2 VALUES, ON A PRINTING TTY IN SCAN MODE. +RRTTID: MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,RRBTCR + MOVE C,NUM + MOVE E,SARG + CAML E,C + EXCH C,E + CALL GETANU ;E, C GET THE CHAR ADDRS OF START AND END OF CHANGED RANGE. + CAME C,PT ;WE DON'T KNOW HOW TO HANDLE IT UNLESS POINT WAS PUT AT END. + JRST RRBTCR + .I C-E + CAML TT,RRTTMX ;IS SIZE OF RANGE CHANGED BELOW THRESHHOLD? + JRST RRBTCR ;TOO MANY CHANGES => DON'T PRINT THEM. + CAMN E,RREPT ;DID CHANGES START AT THE OLD POINT? + JRST RRTTI1 + SAVE C ;IF NOT, MOVE BACK TO WHERE CHANGES STARTED. + SAVE E + SAVE PT + MOVEM C,PT ;MOVE RRVPOS, RRHPOS TO THE POSITION OF THAT PLACE. + CALL RRMAC3 + REST PT ;BUT DON'T REALLY SET PT THERE. + MOVE C,(P) + MOVE E,RREPT ;NOW "MOVE BACK" THERE "FROM" WHERE PT USED TO BE. + CALL RRTTY4 + REST E + REST C +RRTTI1: CALL RRBTCR + CAME E,C ;NOW TYPE ALL THE NEW TEXT, LEAVING CURSOR AT POINT + JRST RRTTYF ;SINCE POINT IS WHERE THE NEW TEXT ENDS. + RET + +SUBTTL ^R COMMAND DISPATCH + +;COME HERE TO HANDLE INPUT (NO DISPLAY NEEDED OR INPUT KNOWN TO BE WAITING). +RRLP1: TLNE FF,FLNOIN ;IF WE'RE DOING AN "^ V", RETURN + CALL RREXIT ;(DOESN'T COME BACK) AFTER DISPLAYING ONCE. + CALL TYIW0 ;READ A CHARACTER + CAIN CH,TOP+"H ;IGNORE "HELP" (FS HELPMAC$ ALREADY RUN, IF APPROPRIATE), + JRST RRLP ;BUT DO GO TO RRLP SO SPACE WILL FLUSH HELPMAC'S TYPEOUT. + ANDI CH,777 + MOVEM CH,$Q..0 ;PUT CHAR WHERE USER MACRO DEFINITION CAN FIND IT. + MOVEM CH,RRLAST ;ALSO PUT IT IN FS ^R LAST$. + MOVEM CH,ECHCHR ;FOR PRINTING TTY, REMEMBER WHICH CHAR TO ECHO. + SKIPN RGETTY + SKIPE RRECHO ;DECIDE WHETHER TO ECHO ^R INPUT. + SKIPGE RRECHO + CALL [CALL TYINRM ;MUST NORMALIZE CHARACTER BEFORE OUTPUTTING, + JRST FSECO1] + MOVE CH,$Q..0 ;(IN CASE WE CALLED TYINRM). + SAVE [RRLP] + CALL RRARGD ;PUT VALUE OF COMMAND'S ARG IN C. +RRLP7: CALL RRLEA2 ;NOW SET UP "RRE" VARS IN CASE RRTTY CALLED AFTER CMD. + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;COMMAND WILL SET ..H TO SAY ^R SHOULD WAIT BEFORE DISPLAYING. + CAMN CH,CASSFT ;F$ CASE CTL CHRS DON'T HAVE FIXED VALUES. + JRST RRSFT + CAMN CH,CASLOK ;SO THE DISPATCH TABLE CAN'T CHECK FOR THEM. + JRST RRLOK + CALL RRCASC ;IF IN F$ MODE, DO CASE CONVERSION. + TRNN CH,META + JRST RRLP7I + TRNE CH,CONTRL ;META NON-CONTROL CHARACTERS ALL SELF-INSERT + JRST RRLP7J + SKIPLE RRRPLC ;IF IN FS ^R REPLACE$ > 0 MODE. + JRST RRXINS +RRLP7J: TRNE CH,CONTRL ;CONTROL-META LETTERS SELF INSERT IF FS CTLMTA$ NEGATIVE. + TRNN CH,100 + JRST RRLP7I + SKIPGE RRCMQT + JRST RRXINS +RRLP7I: +;"INDIRECT" (RRINDR) DEFINITIONS LOOP BACK HERE. +RRIND1: MOVE E,RRMACT(CH) ;GET CURRENT DEFINITION OF CHARACTER. + SKIPL RRALQT ;UNLESS DEFINITIONS ARE SUPPRESSED, + SKIPGE RRUNQT + JRST RRLP7D ;USE THE DEFINITION + CAME CH,RRALQT ;ELSE IF THIS IS NOT THE UNQUOTING CHAR, + JRST RRLP7B ;MAKE IT SELF-INSERTING. + SETOM RRUNQT ;IF IT IS, REENABLE DEFINITIONS FOR 1 COMMAND. + SETZM RRLAST ;DON'T FLUSH NEXT COMMAND'S ARGUMENT. + RET + +;HANDLE A CHARACTER IN SUPPRESS MODE. +RRLP7B: JUMPL E,RRLP7E ;IF ITS DEF. IS A MACRO, SEE WHETHER IT STARTS WITH "W". + MOVEI A,(E) + CAIE A,RRINDR + CAIN CH,177 + JRST RRLP7D ;RUBOUT WORKS EVEN IN SUPPRESS MODE. +RRLP7F: CAIN CH,CONTRL+"M ;OTHER CHARS BECOME SELF-INSERTING. + SKIPA E,[RRCRLF,,RRREPT] +RRXINS: SKIP E,RRXINV + SKIPN E + MOVE E,[RRDINS,,RRREPI] +RRLP7D: SKIPGE A,E ;COME HERE TO USE WHATEVER DEFINITION IS IN E. + JRST RRMAC0 ;EITHER A MACRO OR A BUILT-IN FUNCTION. +RRLP7H: TRZ FF,FRCLN\FRUPRW + LDB A,[331100,,(E)] ;BUILT-INS MUST START WITH A "SKIP" (THAT DOESN'T SKIP EVER). +IFN ITS,CAIE A,.BREAK_-33 ;DON'T BE CONFUSED BY BREAKPOINTS. +IFN TNX,CAIE A,JSYS_-33 ;BPT MAYBE? + CAIN A,SKIP_-33 + JRST (E) + TYPRE [M%R] + +RRLP7E: MOVE A,E ;MACRO-CHAR. TYPED IN SUPPRESS MODE. + CALL QLGET1 + JRST RRLP7F + ILDB TT,BP ;WHAT IS ITS 1ST CHARACTER? + CAIE TT,"W+40 + CAIN TT,"W ;IF IT DOESN'T START WITH A "W" THEN THE DEFINITION IS SUPPRESSED. + JUMPG B,RRLP7D ;IF IT STARTS WITH "W", THEN EXECUTE DEFINITION EVEN IN SUPPRESS MODE. + JRST RRLP7F + +SUBTTL ^R CHARACTER FORWARD/BACKWARD + +;^B - MOVE BACKWARDS ONE CHARACTER. +;UPDATES RRHPOS AND RRVPOS. LEAVES THE CHAR MOVED OVER IN CH. +;LEAVES PT IN IN. CLOBBERS OUT, TT, TT1, A, C. +RRBACK: MOVE IN,BEGV ;ERROR IF AT BEGINNING OF BUFFER. + CAML IN,PT + JRST RRERR +RRBAC4: SOS IN,PT ;GET THE CHAR BEFORE THE PTR + CALL GETCHR +RRBAC0: RRCHRG ;GET CHAR'S DISPATCH TYPE CODE IN A. + XCT RRBACT(A) +RRBAC1: SOS A,RRHPOS + JUMPGE A,CPOPJ +RRBAC3: ADD A,NHLNS ;MOVED OVER LINE-CONTINUATION. + MOVEM A,RRHPOS ;GO BACK TO PREV. LINE'S END. +RRBACV: SOS RRVPOS + POPJ P, + +RRBACT: SOSA A,RRHPOS ;ORD. CHAR., BACK 1 POS. + JRST RRBACC ;NON-FORMATTING CONTROL CHARS. + JRST RRBACH ;^H, CHECK ^HPRINT FLAG. + JRST RRBACR ;^M, SPECIAL. + JRST RRBACL ;^J, UP 1 LINE. + SAVE [RRBTCR] ;TAB, COMPUTE RRHPOS BY MOVING FWD + ;FROM PREVIOUS CR. + JRST RRBAC2 ;2-POS CTL CHARS NO AFFECTED BY FS SAIL (^P AND ^C). + +RRBACR: ADDI IN,1 ;CR: IS IT FOLLOWED BY LF? + CALL GETCHR + MOVEI A,(CH) + MOVEI CH,^M + CAMGE IN,ZV + CAIE A,^J ;IF THIS CR REALLY CAME OUT AS CR, + SKIPGE DISPCR + JRST RRBTCR ;COMPUTE HPOS THE HARD WAY. + SUBI IN,1 +RRBAC2: SOS RRHPOS ;IF IT CAME OUT AS UPARROW-M, + JRST RRBAC1 ;TREAT AS 2-POS CTL CHAR. + +RRBACL: SUBI IN,1 ;LF: SEE IF PREV. CHAR IS CR. + CALL GETINC + MOVEI A,(CH) + MOVEI CH,^J + CAML IN,BEGV + CAIE A,^M ;BASED ON THAT AND ON DISPCR, DECIDE HOW LF WAS PRINTED OUT. + SKIPGE DISPCR + JRST RRBACV + JRST RRBAC2 + +RRBACH: SKIPL DISPBS ;MOVE BACK OVER ^H - IF IT CAME OUT AS + JRST RRBACC ;UPARROW-H, TREAT AS ORDINARY CTL CHAR. + MOVE A,RRHPOS ;ELSE, IF WE KNOW IT CAME OUT AS A BACKSPACE, IT'S SIMPLE. + CAIG A,2 + JRST RRBTCR ;NEAR MARGIN, WE CAN'T BE SURE, SO MUST SCAN FORWARD. + AOS RRHPOS + RET + +;NON-FORMATTING CONTROL CHARS, CHECK SAIL FLAG. +RRBACC: SKIPN DISSAI + JRST RRBAC2 ;NORMALLY, MOVE BACK 2 POS. + JRST RRBAC1 ;IN SAIL MODE, MOVE 1 POS. + +;^F -- MOVE FWD 1 CHAR. SEE THE COMMENTS BEFORE RRBACK. +RRFORW: MOVE IN,PT ;ERROR IF AT END OF BUFFER. + CAML IN,ZV + JRST RRERR + CALL GETINC +RRFOR0: AOS PT + RRCHRG + XCT RRFORT(A) ;DISPATCH ON TYPE OF CHAR. +RRFOR1: AOS A,RRHPOS +RRFOR3: CAMGE A,NHLNS ;HAVE WE MOVED PAST RIGHT MARGIN? + POPJ P, + CAMN A,NHLNS ;CHECK FOR JUST REACHING THE RIGHT MARGIN. + JRST [ SAVE CH ;IF REACH RIGHT MARGIN, MUST + MOVE IN,PT ;CONTINUE PROVIDED WE'RE NOT AT + CALL RREOLT ;THE END OF THE LINE. + JRST POPCHJ ;AT END OF LINE, NOTHING TO DO. + REST CH ;NOT AT EOL, CONTINUE. + MOVE A,RRHPOS + JRST .+1] + SUB A,NHLNS + MOVEM A,RRHPOS +RRFORV: AOS RRVPOS + POPJ P, + +RRFORT: AOSA A,RRHPOS ;ORDINARY CHAR, MOVE FWD 1 POS. + JRST RRFORC ;NON-FORMATTING CONTROLS. + JRST RRFORH ;MOVE FWD OVER ^H - CHECK ^HPRINT FLAG. + JRST RRFWCR ;^M, SPECIAL. + JRST RRFORL ;^J, DOWN 1 LINE. + JRST RRFOTB ;^I + JRST RRFOR2 ;2-POS CTL CHRS NOT AFFECTED BY FS SAIL (^P AND ^C). + +RRFOTB: MOVE TT,RRHPOS + MOVEI A,10(TT) + ANDCMI A,7 ;A HAS NEXT TAB STOP'S POSITION. + CAMLE A,NHLNS ;BUT IF THAT'S OFF THE SCREEN, TAB STOP IS RIGHT MARGIN, + CAMN TT,NHLNS ;UNLESS WE'RE ALREADY AT THE MARGIN, IN WHICH CASE + CAIA ;WE CAN TAB 8 SPACES INTO NEXT LINE VIA CONTINUATION. + MOVE A,NHLNS + MOVEM A,RRHPOS + JRST RRFOR3 + +RRFWCR: SKIPGE DISPCR + JRST RRFWC1 + CALL GETCHR ;CR - SEE IF NEXT CHAR IS LF. + MOVEI A,(CH) + MOVEI CH,^M ;MAKE SURE WE RETURN CHAR BEING PASSED IN CH. + CAMGE IN,ZV + CAIE A,^J + JRST RRFOR2 ;NO, CR CAME OUT AS UPARROW-M +RRFWC1: SETOM RRHPOS ;(RRHPOS WILL BE AOS'D TO 0) + JRST RRFOR1 + +RRFORL: SKIPGE DISPCR ;LF: BASED ON WHETHER A CR PRECEDES IT AND ON DISPCR, + JRST RRFORV + SUBI IN,2 + CALL GETCHR ;DECIDE HOW THE LF CAME OUT AND THEREFORE + MOVEI A,(CH) + MOVEI CH,^J + MOVE TT,IN + ADDI IN,2 + CAML TT,BEGV + CAIE A,^M ;HOW TO MOVE OVER IT. + JRST RRFOR2 + JRST RRFORV + +RRFORH: SKIPGE DISPBS ;MOVING FWD OVER ^H -IF CAME OUT AS + SKIPN RRHPOS + JRST RRFORC + JRST RRBAC1 ;REAL ^H, MOVE BACK 1 POS + +;NON-FORMATTING CONTROLS, CHECK FS SAIL FLAG. +RRFORC: SKIPE DISSAI ;IN SAIL MODE, THEY'RE 1-POS GRAPHICS. + JRST RRFOR1 +RRFOR2: AOS RRHPOS ;ELSE TREAT AS 2-POS CTL CHAR. + JRST RRFOR1 + +;MAKE SURE RRHPOS IS CORRECT BY MOVING BACK TO THE LAST CR THAT +;REALLY CAME OUT AS A CR, AND MOVING FORWARD AGAIN. PT IS UNCHANGED. +;THE LARGEST HPOS THAT OCCURS ON THE LINE UP TO PT IS RETURNED IN OUT. +;PT IS RETURNED IN IN. CLOBBERS TT, TT1. +;A CONTAINS ADDR OF THE CR WE WENT BACK TO (+1), AND B HAS VPOS DIFFERENCE FROM THERE. +RRBTCR: SAVE CH + SAVE RRVPOS ;VPOS WILL BE ALTERED WHILE WE MOVE FWD + ;BUT WE REALLY DON'T WANT IT CHANGED. +RRBTC5: SAVE PT ;REMEMBER WHERE TO STOP WHEN MOVE FWD AGAIN. + MOVE A,GEA ;1ST, FIGURE OUT WHERE TO STOP MOVING BACKWARD + ADD A,BEGV ;IF WE DON'T FIND A CR. 1ST CHAR ON SCREEN + ;IS ONE PLACE. BEGINNING OF BFR IS ANOTHER. + SKIPL GEA + CAMLE A,PT ;(AT BOTH PLACES, HPOS MUST BE 0) + MOVE A,BEGV ;USE WHICHEVER WE'LL REACH SOONER. + MOVE B,PT ;STOP IN ANY CASE AFTER MOVING BACK 10000 CHARS. + SUBI B,10000. ;AT THAT POINT, BETTER TO CHOOSE A NEW WINDOW AND START OVER! + CAMG B,A ;NOW B GETS WHICHEVER OF THOSE TWO STOPPING POINTS IS REACHED FIRST. + MOVE B,A + SETZ OUT, ;ON 1ST PASS OUT=-1 => AN LF HAS BEEN PASSED GOING BACKWARDS. +RRBTC0: MOVE IN,PT + CAMG IN,B ;REACHED A STOPPING POINT => WHICH KIND? + JRST [ CAMN B,A ;A LEGITIMATE ONE (BEG OR TOP OF SCREEN) => + JRST RRBTC1 ;WE CAN JUST SCAN FORWARD FROM THERE. + REST PT + CALL [ CALL SAVACS + CALL VBDBLS ;ELSE, COMPUTE A NEW TOP OF SCREEN + JRST RSTACS] + JRST RRBTC5] ;AND TRY AGAIN. + SOS IN,PT + CALL GETINC ;ELSE, KEEP GOING BACK. + CAIN CH,^J + SETO OUT, ;REACHED LF => SAY NOT ON LINE WE STARTED ON. + CAIE CH,^M ;REACHED CR => SEE WHETHER IT CAME OUT AS ONE. + JRST RRBTC0 + JUMPE OUT,RRBTC0 ;BUT DON'T STOP AT ANY CR IF WE HAVEN'T GONE UP AT LEAST ONE LINE. + SKIPGE DISPCR + JRST RRBTC4 + CALL GETCHR + CAIE CH,^J + JRST RRBTC0 + AOS PT ;START AFTER THE CR AND THE LF. +RRBTC4: AOS PT ;START AFTER THE CR. +RRBTC1: SETZB OUT,RRHPOS ;AT THE CR, KNOW HPOS IS 0. + SAVE PT ;REMEMBER WHERE WE WENT BACK TO, TO RETURN IT IN A. + SAVE RRVPOS +RRBTC2: MOVE IN,PT ;REACHED WHERE WE STARTED? + CAMN IN,-2(P) + JRST RRBTC3 ;YES, FLUSH STACK & EXIT. + CALL RRFORW ;MOVE FWD TILL GET THERE. + MOVE A,RRVPOS ;IF WE'VE MOVED TO ANOTHER LINE, + CAME A,(P) + JRST [ MOVEM A,(P) ;THEN THE CHARS SEEN SO FAR ARE NOT ON THE SAME + SETZ OUT, ;LINE RRBTCR STARTED ON, SO THEY DON'T COUNT + JRST RRBTC2] ;IN OUT'S VALUE. + CAML OUT,RRHPOS ;IF CURRENT HPOS IS > LARGEST SO FAR, + JRST RRBTC2 + MOVE OUT,RRHPOS ;UPDATE MAXIMUM-HPOS-ON-CURRENT-LINE. + JRST RRBTC2 + +RRBTC3: REST B ;RETURN IN B THE VPOS DIFFERENCE WE MOVED OVER. + REST A ;RETURN IN A THE ADDR OF WHERE WE WENT BACK TO. + SUB P,[1,,1] + REST RRVPOS + SUB B,RRVPOS + JRST POPCHJ + +SUBTTL ^R MODE ARGUMENT PROCESSING + +;^U - MULTIPLY REPEAT COUNT OR WHATEVER BY 4. +RR4TIM: SKIP + AOS RR4TCT + MOVEI TT,1 + JRST RRNXI2 ;SET RRARGP TO SAY NON-NULL ARG. + +;^V - READ IN A NUMERIC ARGUMENT. +;THE CHARS OF THE ARG ARE ECHOED IN THE ECHO AREA. +;^G CANCELS THE ARG. ANY OTHER NON-DIGIT IS TREATED AS A COMMAND +;WHICH USES THE ARG (THIS INCLUDES RUBOUT). THE ARG IS LEFT IN RRRPCT. +RRARG: SKIP C,[0] ;WE'LL COMPUTE ARG'S VALUE IN C. + CALL RRECSP ;TYPE A SPACE AT BOTTOM OF SCREEN. +RRARG0: CALL TYIW0 ;READ CHAR: EITHER PART OF ARG, OR NEXT COMMAND. + MOVEM CH,$Q..0 ;IF THE LATTER, IT WILL EXPECT TO BE IN Q..0. + CAIN CH,"- + JUMPE C,[SAVE [RRARGN] ;1ST CHAR IS "-" => NEGATE ARG. + JRST RRARG1] + CAIL CH,"0 + CAILE CH,"9 + JRST RRARGX ;NON-DIGIT: TERMINATE ARG. + IMUL C,IBASE ;DIGIT: PUT IT IN ARG. + ADDI C,-"0(CH) +RRARG1: CALL FSECO1 ;AND PRINT IT IN THE ECHO AREA. + JRST RRARG0 + +RRARGX: MOVEM C,RRRPCT ;SAVE AWAY THE ARG WE READ. + MOVEM CH,UNRCHC ;REPROCESS THE ARG-TERMINATING CHAR AS A COMMAND WITH THAT ARG + JRST RRNXIT ;SAY THERE'S AN ARG IN RRRPCT. + +RRARGN: MOVNS RRRPCT + RET + +RRCMNS: SKIP ;CONTROL-MINUS: SET BIT SAYING NEGATE THE ARGUMENT. + MOVEI TT,5 + JRST RRNXI2 + +RRCDGT: SKIP TT,RRRPCT ;CONTROL-DIGITS: ACCUMULATE AN ARGUMENT. + IMUL TT,IBASE + ANDI CH,77 ;WIN FOR META DIGITS AND C-M-DIGITS. + ADDI TT,-60(CH) + MOVEM TT,RRRPCT +RRNXIT: MOVEI TT,3 +RRNXI2: IORM TT,RRARGP + SETZM RRLAST ;SAY THIS IS AN ARG-SETTING COMMAND; + RET ;DON'T FLUSH ARG OR CLOBBER FS ^R PREV$. + +;COMMANDS THAT WANT TO BE REPEATED A NUMBER OF TIMES EQUAL +;TO THE NUMERIC ARG DISPATCH THRU HERE. +;(THAT IS, THE DISPATCH WD HOLDS ,,RRREPT ) +RRREPT: SKIP ;TELL RRLP7H ERROR-CHECK WE'RE GOOD GUYS. + HLRZS E ;PUT IN RH. +RRREP1: JUMPLE C,POPJ1 ;C HAS -<# TIMES ALREADY DONE> + CAIN C,1 ;IF CALLING FOR THE LAST TIME, THEN IF COMMAND SKIPS WE SHOULD. + JRST (E) ;(THUS RETURNING 1 VAL IF CALLED WITH M COMMAND, OR TRIGGERING RRTTY). + SAVE E + HRLM CH,(P) ;SAVE CMD RTN ADDR AND THE CHAR. + SAVE C ;AND # TIMES REMAINING. + CALL (E) ;DO IT ONCE + JFCL + REST C + REST E + HLRZ CH,E + SOJA C,RRREP1 + +;LIKE RRREPT, BUT IF REPEAT COUNT IS > 8 THEN SAY IN ADVANCE THAT +;REDISPLAY IS NEEDED (TO INHIBIT UPDATING). +;USED TO REPEAT INSERT COMMANDS, SO THAT ^U^UA DOESN'T +;RUN SLOWLY BY TYPING OUT AN A AT A TIME. +RRREPI: SKIP + HLRZS E +RRREP2: CAIG C,8 + JRST RRREP1 + SKIPN RRMAXP ;RRMAXP=1 INHIBITS UPDATING BUT DOESN'T MARK ANY ACTUAL PART + AOS RRMAXP ;OF THE BUFFER AS NEEDING REDISPLAY. THE INSERT RTN WILL CHANGE + JRST RRREP1 ;RRMAXP TO INCLUDE WHAT IT INSERTS. + +;COMPUTE THE ARGUMENT FROM THE EXPLICIT ARGUMENT AND +;THE POWER-OF-4. RETURN IN C. +RRARGD: MOVE TT,RRARGP ;GET THE EXPLICIT ARG, OR 1 IF NONE SPEC'D. + TRNE TT,2 + SKIPA C,RRRPCT + MOVEI C,1 + TRNE TT,4 ;IF ^- SET THE 4 BIT, NEGATE THE ARG. + MOVNS C + MOVE TT,RR4TCT ;THEN MULTIPLY BY 4 FOR EACH ^U. + SOJGE TT,[LSH C,2 ? JRST .] + RET + +;AFTER A COMMAND, IF IT DIDN'T IDENTIFY ITSELF AS AN ARGUMENT-SETTING COMMAND +;(BY CLEARING RRLAST), FLUSH THE ARGUMENT THAT THE COMMAND USED. +RRARGF: SKIPN TT,RRLAST ;IF THE LAST COMMAND DIDN'T PRESERVE OR MAKE AN ARG, + RET + MOVEM TT,RRPRVC ;REMEMBER IT AS "PREVIOUS COMMAND" FOR NEXT COMMAND, + SETZM RRARGP ;SAY TO GIVE NEXT COMMAND THE DEFAULT ARG (1) + SETZM RR4TCT ;AND CLEAR ARG ACCUMULATION VARIABLES. + SETZM RRRPCT + SETZM RRUNQT + RET + +;COME HERE FOR ^G. +RRQUIT: SKIP TT,CASNRM ;NOTE: THIS RTN IS CALLABLE BY RRLP7H, SO NEED "SKIP" + MOVEM TT,CASE ;IN F$ MODE, UNDO ANY CASE-LOCKAGE. + SETOM RRMKPT ;ELIMINATE THE MARK. + SKIPE NELNS + CALL ECHOCR ;GO TO NEW LINE IN ECHO REGION + SETOM RROVPO ;FORCE CURSOR REPOSITIONING + +;ERROR DETECTED BY RR EDIT: +RRERR: SKIP + SKIPE RREBEG ;IF NOT INSIDE ^R, GIVE A TECO ERROR. + TYPRE [BEL] + MOVE P,DISPRR + JRST TYPBEL ;TYPE A BELL AND REENTER MAIN LOOP. + +;"UNDEFINED" ^R COMMAND CHARACTERS HAVE THIS DEFINITION, WHICH TYPES A BELL +;AND RETURNS 1 VALUE. THIS AVOIDS GETTING A "BEL" ERROR, IF UNDEFINED CHAR +;IS RUN WITH M^R. +RRUNDF: SKIP + AOS (P) + JRST TYPBEL + +;EXPECT CHAR ADDR IN "IN", SKIP UNLESS IT POINTS TO THE END +;OF THE BUFFER OR THE END OF A LINE. CLOBBERS TT, TT1 +RREOLT: CAMN IN,ZV + POPJ P, ;AT EOF. + SAVE CH + CALL GETINC + CAIN CH,^M + CAMN IN,ZV + SOJA IN,POPCH1 ;BEFORE A CR THAT'S THE LAST CHAR. + CALL GETCHR + SUBI IN,1 + CAIE CH,^J +POPCH1: AOS -1(P) ;BEFORE A STRAY CR => NOT AT EOL. + JRST POPCHJ ;BEFORE A CRLF => EOL. + +;CHECK IF THE CURRENT LINE HAS TABS IN IT AFTER PT, WHICH MIGHT MAKE +;AVOIDING REDISPLAY TOO HARD, SKIP IF NONE FOUND AND BUFFER LINE DOES NOT +;WRAP AROUND TO SEVERAL SCREEN LINES +RRNTBP: SAVE BP + MOVE IN,PT + CALL GETIBI ;GET POINTER TO CURRENT POSITION +RRNTB1: CAMN IN,ZV + JRST RRNTB3 ;AT THE VERY END, OK NO TABS THEN + CAMN IN,GPT + CALL FEQGAP ;MOVE OVER GAP + ILDB CH,BP +RRNTB2: CAIN CH,^I ;IS IT A TAB? + JRST POPBPJ ;YES, FAILURE THEN + CAIE CH,^M ;GOT TO CR? + AOJA IN,RRNTB1 ;NO, KEEP LOOKING + AOJ IN, + CAMN IN,ZV + JRST RRNTB3 + CAMN IN,GPT + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;REALLY AT CRLF? + AOJA IN,RRNTB2 ;NO, STRAY CR + SUBI IN,1 ;CHECK HPOS JUST BEFORE THE CR. +RRNTB3: SKIPGE DISTRN ;IF WE ARE JUST TO TRUNCATE LONG LINES + JRST POPBP1 ;THAT'S ENOUGH CHECKING, SKIP RETURN +INSIRP PUSH P,RRHPOS RRVPOS PT E + MOVE E,IN + CALL RRMOV ;FIND POSITION OF END OF LINE (AS OF LAST REDISPLAY) + MOVE TT,RRHPOS ;GET NEW VALUES + MOVE TT1,RRVPOS +INSIRP POP P,E PT RRVPOS RRHPOS + CAME TT1,RRVPOS ;ON THE SAME LINE? + JRST POPBPJ ;NO, MUST REDISPLAY THEN + CAMGE TT,NHLNS ;ALSO IF THIS WOULD BE DISPLAYED PAST END OF LINE +POPBP1: AOS -1(P) ;SUCCESS RETURN + JRST POPBPJ + +;IF A CHARACTER 'S DEFINITION IS ,,RRINDR, IT IS AN INDIRECT PTR +;TO THE DEFINITION OF THE CHARACTER -. USED TO HANDLE +;THE LOWER CASE CONTROL CHARACTERS SUCH AS 341 = CTL-LOWERCASE-A. +;ALSO USED TO MAKE CONTROL-H EQUIVALENT TO BACKSPACE; SIMILAR FOR TAB & LF. +RRINDR: SKIP + HLRZS E ;GET + SUB CH,E + JRST RRIND1 ;GO USE DEF'N OF -. + +SUBTTL ^R MODE SINGLE CHARACTER DELETION AND INSERTION + +RRDLNB: MOVNS C ;HERE FOR DELETE BACKWARD WITH NEGATIVE ARG. + JRST RRCTD1 + +;^D -- DELETE FORWARD. (D) +RRCTLD: SKIP + JUMPGE C,RRCTD1 + MOVNM C,RRRPCT ;IF NEGATIVE ARG, SET ITS NEGATION UP AS ARG + .I RRARGP=3 + SETZM RR4TCT + MOVEI CH,177 ;AND TURN INTO RUBOUT. + JRST RRIND1 + +RRCTD1: JSP E,RRREP1 + MOVE IN,PT + CAML IN,ZV + JRST RRERR + JSP E,RRTYPP ;ON PRINTING TTY, MAYBE TYPE SCAN INFO + CALL [ SETCM E,TTYOPT + CALL GETCHR ;GET CHARACTER ABOUT TO DELETE + MOVEI A,(CH) + MOVEI CH,"/ + TLNE E,%TOOVR\%TOMVB ;IF CAN BACKSPACE AND OVERPRINT, OVERPINT A SLASH. + CAIN A,^M ;ABOUT TO DELETE A CRLF, TYPE A SLASH. + CALL FSECOR + MOVEI CH,^H ;BS OVER IT IF OVERPRINTING + TLNN E,%TOOVR\%TOMVB + CALL FSECOR + MOVEI CH,(A) ;GET CHARACTER AGAIN + CALL FSECOR + SKIPN BSNOLF + RET + JRST RRMVC] ;THEN ECHO THE CHAR BEING DELETED. + SKIPN RUBCRL ;IF FS RUBCRLF$ NONZERO, + JRST RRDLF + CALL RREOLT ;IF BEFORE A CRLF, DELETE BOTH CHARS. + JRST [ CALL GAPSLP + CALL DEL1F ;DELETE THEM AT ONCE, AND DON'T TRY TO DO UPDATING. + CALL DEL1F + MOVE BP,RRVPOS + MOVE T,RRHPOS + MOVNI A,2 + JRST RRFXM1] + +;INTERNAL ROUTINE TO DELETE FORWARD. +RRDLF: CALL RRFORW ;MOVE OVER THE CHAR, THEN DELETE IT BACKWARD. + +;INTERNAL ROUTINE TO DELETE BACKWARD (-D). DELETED CHAR LEFT IN CH. +;CLOBBERS A,B,IN,OUT,TT,TT1,Q, T, BP +RRDLB: SETOM RRMKPT + MOVE IN,PT ;ERROR AT BEGINNING OF BUFFER. + CAMG IN,BEGV + JRST RRERR + SAVE RRVPOS ;REMEMBER VPOS TO RIGHT OF CHARACTER. + CALL RRBACK ;ACCOUNT FOR CURSOR POS CHANGE DUE TO DELETION. + CALL GAPSLP + CALL RRCRDI + CALL DEL1F ;DELETE FORWARD FROM BUFFER, NO CURSOR HACKERY. + CAIE CH,^H ;DELETING CHARS THAT MOVE LEFT IS HARD. + CAIN CH,^M + JRST RRDLB4 + CALL RRICHK ;SEE WHETHER IT'S EASY TO UPDATE SCREEN. + REST A + CAMN A,BP ;IF EFFECTS OF CHANGE REACH PREV. LINE, + SKIPE RRMAXP ;OR IF REDISPLAY WILL BE DONE ANYWAY. + JRST RRDLB1 ;DON'T BOTHER TO DO IT HERE. + SKIPN RRCIDP ;IF NEED TO DO SOMETHING WITH I/D OR TABS, + JRST RRDLB3 + CAIE CH,^I + SKIPN DISSAI + CAIL CH,40 ;BETTER NOT BE DIFFICULT CHARACTER + CAIN CH,177 + JRST RRDLB1 ;IF IT IS, JUST REDISPLAY +RRDLB3: CALL RRMVC ;UPDATE THE SCREEN NOW: + MOVNI T,1 ;UPDATE LINBEG WORDS OF ALL LINES + CALL RRINS3 ;BELOW THIS ONE. + MOVE BP,RRVPOS + SKIPGE T,RRCIDP + JRST [ SETOM HCDS(BP) ;IF MOVING CHARS TO NEW HPOSES, WE CAN'T FIX THE HASHCODE. + JRST DELCHR] + CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE + SKIPN DISSAI ;USING RRHPOS AS THE HPOS FOR COMPUTING IT. + CAIL CH,40 + CAIN CH,177 + SETOM HCDS(BP) ;BUT THAT DOESN'T WIN FOR 2-PLACE CHARACTERS. + JUMPG T,ERSCHR ;NOW GO CLEAR OUT THE APPROPRIATE PARTS OF THE SCREEN. + JRST CLREOL + +RRDLB4: SUB P,[1,,1] ;FLUSH SAVED VPOS. FROM STACK. + SKIPGE DISPCR + SETZ T, ;DELETING A REAL STRAY CR => MUST REDISPLAY WHOLE LINE + ;TO GET RID OF OVERSTRUCK CHAR IN POSITION 0. +RRDLB1: MOVNI A,1 ;1 CHAR DELETED AT VPOS, HPOS IN BP,T. + JRST RRFXM1 + +FSRRRU: ARGDFL Z ;FS ^R RUBOUT$ + SAVE [RRLEA1] ;AFTERWARDS SET RREPT, RREHPS, RREVPS. + JSP E,RRREP2 + JRST RRDLB ;RUB OUT SPEC'D # OF CHARS WITH NO TAB OR CRLF HACKS. + +;BUILT-IN DEFINITION OF RUBOUT: DECODE ARGUMENT. +RRRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + JSP E,RRREP2 ;REPEAT ARG TIMES WHAT FOLLOWS (BUT FIRST OTHER STUFF) +RRRUBD: CALL RRDLB ;DELETE ONE CHAR BACKWARD + SKIPE RUBCRL ;AND THEN IF FS RUBCRLF$ NONZERO, AFTER RUBBING OUT A ^J + CAIE CH,^J + JRST RRRUBP + MOVE IN,PT ;FLUSH A CR BEFORE IT, TOO. + SOS IN + CAMGE IN,BEGV + JRST RRRUBP + CALL GETCHR + CAIN CH,^M + CALL RRDLB +RRRUBP: JSP E,RRTYPP ;ON PRINTING TTY, IF SCANNING, TYPE THE RUBBED CHARACTER. + CAIA ;NOTICE THAT IF RUBBING A CRLF WE COME HERE FOR THE CR + RET ;WHICH WILL ECHO AS CRLF. + MOVE E,TTYOPT + TLNE E,%TOMVB ;ON TTY THAT CAN'T BS, SURROUND RUBBED STUFF WITH \'S. + JRST RRRUBB + MOVEI IN,"\ + SAVE CH + MOVEI CH,"\ + CAME IN,RUBENC ;IF NOT YET INSIDE A \ PAIR, START ONE. + CALL FSECO1 + SETZM RUBENC ;IF INSIDE ONE ALREADY, DON'T END IT YET. + REST CH + CALL FSECOR ;TYPE THE RUBBED CHARACTER. + MOVEM IN,RUBENC ;FOLLOW WITH A \ WHEN WE STOP RUBBING OUT. + RET + +RRRUBB: CALL RRTTY2 ;MOVE CURSOR TO RIGHT PLACE. THIS KING OF RUBOUT CAN INTERMIX + MOVEI CH,"/ ;WITH BACKWARD MOTION. + CALL FSECOR ;OVERSTRIKE A / (MAY ERASE OR NOT, WHO CARES?) + JRST RRMVC + +;CTL-RUBOUT: LIKE RUBOUT, BUT CONVERTS TABS INTO SPACES FIRST. +RRCRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + JSP E,RRREP2 ;REPEAT THE FOLLOWING ARG TIMES: + SAVE RRHPOS + CALL RRBACK ;WE NEED HPOS BOTH BEFORE AND AFTER CHAR TO BE FLUSHED, + REST E ;IF IT'S A TAB. + CAIE CH,^I + JRST [ CALL RRFORW ;NOT TAB => UNDO THE RRBACK + JRST RRRUBD] ;AND DO A NORMAL RUBOUT. + CALL GAPSLP + SAVE PT + AOS (P) + CALL DEL1F ;ELSE FLUSH THE TAB AND PUT IN APPRO. # OF SPACES + SUB E,RRHPOS +RRCRU1: MOVEI CH,40 + CALL TYOM + SOS PT + CALL RRFORW ;MOVING FORWARD OVER THEM + SOJG E,RRCRU1 ;LEAVING US IN INITIAL STATE EXCEPT TAB REPLACED BY SPACES. + REST T + SUB T,PT + MOVNS T ;T HAS CHANGE IN PT DUE TO OUR INSERTION. + MOVE BP,RRVPOS + CAMGE BP,TOPLIN ;IF THE CHANGE IS ABOVE THE SCREEN, RELOCATE ALL LINBEGS IN THE WINDOW. + MOVE BP,TOPLIN + CAMGE BP,BOTLIN ;IF THIS CHANGE IS OFF THE END OF THE SCREEN, WE ARE DONE. + CALL RRINS3 ;RELOCATE LINBEG TABLE FOR WHAT WE HAVE DONE. + JRST RRRUBD ;THEN DELETE THE LAST SPACE. + +;COME HERE WHEN CASE-SHIFT IS READ. +RRSFT: MOVNS CASE ;READ NEXT CHAR IN ABNORMAL CASE. + AOSE RCHSFF + SETOM RCHSFF ;RESTORE TO NORMAL AFTER NEXT CHAR. + SKIPN RCHSFF ;ALLOW THE CASE-SHIFT TO QUOTE ITSELF. + JRST RRLP7J + +;TYPE THE CHAR IN Q..0 AS A PROMPT, IF THERE IS NO INPUT AVAILABLE. +RRECO1: SKIPE RGETTY + SKIPGE RRECHO ;ON DISPLAY TTY, IF NOT ECHOING THE COMMAND, + RET + MOVEI A,[ASCIZ /0^V^:FT..00 /] + JRST RRMACR + +;COME HERE FOR CASE-LOCK AS A COMMAND. +RRLOK: MOVNS CASE + POPJ P, + +;^O - INSERT CRLF, THEN BACK UP OVER IT. +RRCTLO: CALL RRCRL1 ;INSERT CRLF + JFCL + AOS (P) + CALL RRBACK ;THEN BACK OVER IT. + JRST RRBACK + +;^M - INSERT ^M AND ^J. +RRCRLF: CALL RRCMRU ;REMOVE TAB-SEMI'S FROM LINE WE'RE ON. +RRCRL1: MOVEI CH,^M + CALL RRINS ;INSERT THE ^M. + MOVEI CH,^J + JRST RRINSQ ;INSERT THE ^J. + +;^Q -- READ NEXT CHAR AND INSERT IT. +RRQUOT: SKIP + SAVE C + CALL RRECO1 ;FINISH DISPLAYING, MAYBE PROMPT WITH A "^Q". + CALL TYI ;READ THE CHAR TO BE QUOTED. + CALL TYINRM + REST C + JSP E,RRREP1 ;NOTE ^Q MUST DO ITS OWN REPETITION. + JRST RRINSQ ;OTHERWISE ^V5^Q WOULD READ AND INSERT 5 CHARS. + ;INSTEAD OF READING 1 CHAR AND INSERTING + ;IT 5 TIMES. + +;THIS IS THE DEFAULT DEFINITION OF "SELF-INSERTING" CHARACTERS: +;NORMALLY, JUST INSERT. META-CHARS INSERT. IF FS ^R REPLACE$ NONZERO, +;NON-META CHARS REPLACE INSTEAD (BUT AT END OF LINE, THEY INSERT). +RRDINS: MOVE CH,$Q..0 + TRNN CH,META + SKIPN RRRPLC + JRST RRINSC + MOVE IN,PT + CAML IN,ZV ;AT END OF BUFFER, JUST INSERT. + JRST RRINSC + CALL GETCHR ;HERE IF SUPPOSED TO TRY TO REPLACE. + CAIE CH,^M ;AT END OF LINE? + CAIN CH,^J + JRST RRINSC ;YES => INSERT, DON'T REPLACE. + CAIE CH,^H + CAIN CH,^L + JRST RRINSC + CAIN CH,^I + JRST RRDINT +RRDIN0: AOS (P) + CALL RRICH9 ;CHECK FOR VARIOUS CONDITIONS PROHIBITING UPDATING. + CALL RRFORW + SAVE RRHPOS ;WHAT IS HPOS AFTER THE CHAR WE ARE REPLACING?? + CALL RRBACK ;DELETE THAT CHARACTER. + SAVE CH + SAVE RRHPOS + CALL GAPSLP + CALL DEL1F + MOVE CH,$Q..0 + CALL TYOM ;INSERT THE NEW CHARACTER. + SOS PT + MOVE BP,RRVPOS + CALL RRFORW ;WHAT IS THE HPOS AFTER THE NEW CHARACTER? + REST T ;T GETS HPOS BEFORE THIS CHARACTER. + REST B ;B HAS CHAR WE ARE REPLACING. + REST A ;A GETS HPOS AFTER CHAR WE REPLACED. + CAMN A,RRHPOS ;HPOS AFTER THIS CHAR SAME AS AFTER OLD => WE CAN REWRITE ON SCREEN, + CAME BP,RRVPOS ;AS LONG AS IT DOESN'T CONTINUE THE LINE. + JRST RRDIN3 + CAIE CH,ALTMOD ;EITHER CHAR IS ALTMODE => CAN'T UPDATE. + CAIN B,ALTMOD + JRST RRDIN3 + SKIPE RRMAXP + JRST RRDIN3 + EXCH T,RRHPOS ;T GETS HPOS AFTER (LIKE A), RRHPOS GETS HPOS BEFORE CHAR. + EXCH CH,B + CAIN CH,11 + MOVEI CH,40 + CALL CHCTHR ;UPDATE HASH CODE OF LINE FOR CHAR BEING REPLACED. + MOVE CH,B + CALL CHCTHI ;UPDATE THE HASH CODE OF THE LINE FOR CHAR BEING INSERTED. + CALL RRMVC ;MOVE TO HPOS OF START OF CHARACTER. + SUB A,RRHPOS ;A GETS NUMBER OF POSITIONS THE CHARACTER TAKES. + CAIE A,1 + SETOM HCDS(BP) ;MORE THAN 1 => WE CAN'T FIX THE HASH CODE, SO CALL FOR REDISPLAY. + MOVE TT,TTYOPT + TLNN TT,%TOOVR ;IF TERMINAL CAN OVERPRINT, WE MUST CLEAR THE SPOTS. + JRST RRDIN2 +RRDIN1: CALL ERSCHR ;CLEAR OUT THAT MANY POSITIONS. + MOVEI CH,40 + CALL TYOINV + SOJG A,RRDIN1 + SETOM RROHPO + CALL RRMVC ;THEN RESTORE CURSOR POSITION. +RRDIN2: MOVEM T,RRHPOS ;SET HPOS TO ITS VALUE AFTER THE NEW CHARACTER. + MOVEM T,RROHPO + MOVE CH,$Q..0 ;NOW PRINT THE NEW CHARACTER AT THE DESIRED PLACE. + SKIPE CASDIS + CALL DISAD6 + JRST TYOINV + +RRDIN3: SETZ A, ;HERE TO UPDATE RRMNVP, RRMNHP, RRMAXP IF CAN'T UPDATE SCREEN. + JRST RRFXM1 ;T HAS HPOS OF CHAR, BP HAS VPOS. + +RRDINT: .I RRHPOS+1 ;BEFORE A TAB => INSERT UNLESS TAB NOW TAKING ONLY 1 SPACE. + TRNN TT,7 + JRST RRDIN0 +RRINSC: MOVE CH,$Q..0 +RRINSQ: AOS (P) + TRZ FF,FRARG2 + JRST RRINS + +FSRRINS:MOVE CH,C ;USER-INTERFACE TO RRINS: FS ^R INSERT$ + +;INSERT CHAR IN CH. +;CLOBBERS A, B, IN, OUT, TT, TT1, CH, Q, T, BP +RRINS: CALL TYINRM ;CONVERT CHARACTER TO ASCII. + SETOM RRMKPT + SKIPN RRMAXP + CAIN CH,^I ;INSERTING ANY CTL CHAR BUT TAB IS HARD. + JRST RRINS2 + CAIL CH,40 + CAIN CH,177 + AOSA RRMAXP +RRINS2: CALL RRICHK ;SEE IF OBVIOUSLY CAN'T UPDATE SCREEN NOW. + CALL RRCRDI + CALL [ CALL TYOMGS ;INSERT CHAR AFTER PT. + SOS PT + POPJ P,] + MOVE Q,RRHPOS + CALL RRFORW ;THEN MOVE FORWARD OVER IT. + MOVEI A,1 ;(FOR RRFXM1) 1 CHAR INSERTED. + CAMN BP,RRVPOS ;CHAR MOVED TO NEXT LINE => MUST REDISPLAY + SKIPE RRMAXP ;IF NOT PLANNING TO REDISPLAY, + JRST RRFXM1 + SKIPE RRCIDP ;IF GOING TO DO SOMETHING WITH CHAR I/D + CAIE CH,^I ;MUST BE AN EASY CHAR + CAIA + JRST RRFXM1 ;FOR TABS REDISPLAY REQUIRED + MOVE T,Q + EXCH T,RRHPOS ;POSITION CURSOR AT HPOS BEFORE THE CHARACTER. + CALL RRMVC + CALL CHCTHI ;USE THAT HPOS TO UPDATE LINE'S HASH CODE. + CAIN CH,^I ;AFTER A TAB, THE HASH CODE WAS NOT UPDATED PROPERLY. + SETOM HCDS(BP) + MOVEM T,RRHPOS + MOVEM T,RROHPO + MOVEI T,1 ;UPDATE LINBEG WDS OF ALL LINES + CALL RRINS3 ;BELOW THIS LINE. + SKIPGE RRCIDP ;IF USING CHAR I/D FOR THIS + CALL INSCHR ;INSERT THE SPACE FOR IT FIRST + MOVE BP,RRVPOS + SKIPN CASDIS ;IF CASE FLAGGING MIGHT BE HAPPENING, + SKIPGE RRCIDP ;OR IF WE ARE MOVING OTHER CHARACTERS AROUND, + SETOM HCDS(BP) ;THEN UPDATING THE HASH CODE LOST, SO CALL FOR REDISPLAY OF LINE. + SKIPE CASDIS ;OUTPUT CHARACTER, WITH CASE-SHIFT IF ANY. + CALL DISAD6 + JRST TYOINV + +RRINS3: ADDM T,RROLDZ + ADDM T,RROLZV + JRST RRDISG + +;CHECK FOR SOME OF THE THINGS THAT WOULD RULE OUT UPDATING THE +;SCREEN IMMEDIATELY FOR AN INSERT OR DELETE. IF ANY IS +;FOUND, LEAVE RRMAXP NONZERO (THIS WON'T CONFUSE RRLP BECAUSE +;WE'LL SET RRMAXP ANYWAY IN ORDER TO CAUSE REDISPLAY) +;REDISPLAY WILL ALWAYS WORK, BUT UPDATING IS FASTER. +;CLOBBERS A, B, IN, OUT, TT, TT1 +RRICHK: HRROS (P) ;SET SIGN FOR CHECKING INSERTION AND DELETION. + CAIA +RRICH9: HRRZS (P) ;CLEAR SIGN FOR CHECKING FOR REPLACEMENT. + SETZM RRCIDP ;SO FAR NO TAB OR CHAR I/D STUFF APPEARS TO BE NECESSARY. + SKIPN RRINHI + SKIPE RRMSNG + JRST RRICH2 + SKIPE RRMAXP ;REDISPLAY NECESSARY ANYWAY => + RET ;IT WILL FIX SCREEN; WE NEEDN'T. + SAVE CH + SKIPN RGETTY + JRST RRICH1 ;CAN'T UPDATE IF THERE'S A CURSOR STRING. + MOVE CH,RRVPOS ;IF CURSOR IS OFF SCREEN, + CAML CH,TOPLIN + CAML CH,BOTLIN ;DON'T UPDATE, REDISPLAY IS NEEDED. + JRST RRICH1 + SKIPL -1(P) + JRST RRICH4 + MOVE IN,PT + CALL RREOLT ;UPDATING FOR INSERT/DELETE POSSIBLE ONLY AT END OF LINE. + CAIA + JRST RRICH3 ;UNLESS BEFORE TAB OR CHAR I/D CAN BE USED +RRICH4: LISTEN A ;MANY UPDATES DON'T BEAT 1 REDISPLAY. + SKIPN TYISRC + CAIL A,5 + JRST RRICH1 + SKIPL DISPCR ;IF THERE ARE NO REAL BS'S OR STRAY CR'S + SKIPGE DISPBS + CAIA + JRST POPCHJ ;NO NEED FOR THE NEXT TEST. + CALL RRBTCR ;PERHAPS, DUE TO BACKSPACES, SOMETHING + CAMG OUT,RRHPOS ;EARLIER IN THE LINE APPEARS FARTHER + JRST POPCHJ ;RIGHT ON THE SCREEN (EG ABC/\) +RRICH1: REST CH +RRICH2: AOS RRMAXP ;CAUSE CALLER NOT TO TRY UPDATING. + RET + +;CHECK FOR CONDITIONS THAT MIGHT ALLOW US TO AVOID REDISPLAY EVEN IF +;NOT AT THE END OF THE LINE, IF RETURNS SUCCESSFUL, RRCIDP WILL BE +;POSITIVE IF WE ARE BEFORE A TAB THAT TAKES MORE THAN 1 SPACE AND SO +;CAN INSERT BY OVERWRITING, OR NEGATIVE IF WE ARE TO USE CHAR I/D +RRICH3: SKIPE CASDIS ;DONT GET SCREWED BY FLAGGING + JRST RRICH1 ;JUST REDISPLAY IN THAT CASE + CALL GETINC ;GET NEXT CHAR + CAIE CH,^I ;IS IT A TAB? + JRST RRICH5 ;NO, TRY CHAR I/D MAYBE + .I RRHPOS+1 ;GET NUMBER OF CHARS IT USES + TRNN TT,7 ;IF MORE THAN ONE + JRST RRICH1 + AOS RRCIDP ;SAY HACKING A TAB, + JRST RRICH4 ;AND GO CONTINUE CHECKS +RRICH5: SKIPE CID ;TRY TO USE CHAR I/D? + CALL RRNTBP ;CHECK THAT THE LINE HAS NO TABS AFTER THIS IN IT + JRST RRICH1 ;NO, FORGET IT, MUST REDISPLAY + SETOM RRCIDP ;SAY USE CHAR I/D FOR THIS ONE + JRST RRICH4 ;AND CONTINUE CHECKING + +;CONVERT LOWER CASE TO UPPER OR VICE VERSA, ACC. TO FS CASE $ +;FOR SHIFT OR LOCK CHARS, RCHSFT AND RCHLOK MIGHT GET CALLED! +RRCASC: TRNE CH,CONTRL+META + RET + CAIL CH,100 ;[ ;XCTING WOULD LOSE ON ALTMODE, ^]. + XCT RCHDTB(CH) ;SKIPS FOR CHARS WHOSE CASE IS WRONG. + CAIA + XORI CH,40 ;CHANGE TO THE OTHER CASE. + MOVEM CH,$Q..0 + AOSN RCHSFF + MOVNS CASE ;IF PREV. CHAR WAS CASE SHIFT, UN-COMPLIMENT CASE. + POPJ P, + +;TAKE CARE OF THE POSSIBILITY THAT CHANGING THE BUFFER AFTER PT MAY +;CHANGE WHAT APPEARS ON THE SCREEN BEFORE PT. (FOR EXAMPLE, +;INSERTING OR DELETING A LF AFTER A CR.) +;FOLLOW A CALL TO RRCRDI WITH AN INSN THAT CHANGES THE BUFFER +;AFTER PT, BUT DOESN'T CHANGE PT, AND DOESN'T CLOBBER BP OR T. +;ON RETURN, PT IS UNCHANGED, RRHPOS AND RRVPOS +;ARE CORRECT, AND BP,T CONTAIN THE V AND HPOS OF A PLACE ON THE SCREEN +;BEFORE WHICH NOTHING NEEDS TO CHANGE. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRCRDI: SAVE CH + SAVE PT + CALL RRCRDB ;MOVE BACK TO BEFORE ALL BEFORE-EFFECTS. + MOVE IN,PT + CAMN IN,(P) ;IF WE DIDN'T MOVE BACK AT ALL, NO PROBLEM. + JRST RRCRDX + SUB IN,BEG ;ELSE REMEMBER HOW FAR BACK WE MOVED, + EXCH IN,(P) ;RELATIVE TO BEG IN CASE BUFFER MOVES. + MOVEM IN,PT ;GIVE PT THE RIGHT VALUE FOR USER'S RTN, + MOVE CH,-1(P) ;AND CH. + MOVE T,RRHPOS ;GET HPOS AND VPOS OF PLACE WE MOVED BACK TO, + MOVE BP,RRVPOS ;TO RETURN TO OUR CALLER. + XCT @-2(P) ;DO WHAT CALLER WANTED DONE. + MOVE IN,(P) ;SET PT TO WHERE WE MOVED BACK TO + ADD IN,BEG + EXCH IN,PT ;BUT REMEMBER ITS REAL VALUE. + MOVEM IN,(P) +RRCRD1: CALL RRFORW ;THEN MOVE FWD OVER WHAT WE MOVED + CAME IN,(P) ;BACK OVER. + JRST RRCRD1 + SUB P,[1,,1] + JRST POPCH1 + +RRCRDX: MOVE T,RRHPOS ;NO PROBLEM OF BEFORE-EFFECTS, JUST + MOVE BP,RRVPOS ;RETURN THE HPOS AND VPOS, AND EXIT + SUB P,[1,,1] ;TO THE USER'S BUFFER-MUNGING INSN. + JRST POPCHJ + +RRCRDB: MOVE IN,PT + SUBI IN,1 ;ARE WE AFTER A CR? IF SO, IT MAY CHANGE FORM. + CAMGE IN,BEGV + POPJ P, ;AT BEGINNING OF BUFFER, NO PROBLEM. + CALL GETCHR ;ARE WE AFTER A CR? + CAIN CH,^M ;IF SO, IT MIGHT CHANGE FORM. + CALL [ SKIPL DISPCR ;IF IT CAN COME OUT AS "^M" + JRST RRBACK ;THEN IT CAN PROPAGATE BEFORE-EFFECTS. + JRST POP1J] ;ELSE, IT GUARANTEES NO BEFORE-EFFECTS. + MOVE IN,PT + SUBI IN,2 ;IF IN HORIZ. POS. 0, AND + SKIPG RRHPOS + CAMGE IN,BEGV ;NOT NEAR THE BEGINNING OF BUFFER, + POPJ P, + CALL GETINC ;AND NOT SHORTLY AFTER A CR (NOTE THIS + CAIN CH,^M ;CATCHES A PRECEDING CRLF) + RET + CALL GETCHR + SKIPGE DISPBS ;AND NOT RIGHT AFTER A ^H THAT REALLY BACKSPACES (THEN MOVING BACK + CAIE CH,^H ;OVER IT WOULD UNDERESTIMATE!) + CALL RRBACK ;THEN MAYBE "!" MUST BE WRITTEN OR ERASED AT END OF PREVIOUS LINE. + POPJ P, + +SUBTTL LEAVE ^R, UPWARD OR DOWNWARD + +;ALTMODE - LEAVE ^R MODE. +RREXIT: SKIP A,RREBEG + JUMPN A,FSCREX ;IF COMING FROM M.^R$, DO A FS^REXIT$. +RREXI0: MOVE CH,QRB.. ;DON'T INHIBIT REDISPLAY AT NEXT OPPORTUNITY (UNLESS RRLEVM TYPES) + SETZM .QVWFL(CH) + TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPGE -3(A) + JRST RREXI2 ;^ V - LEAVE FLNOIN ON. + SKIPE A,RRLEVM ;IF EXITING ^R, RUN FS ^R LEAVE$. + CALL RRMACR + TLZ FF,FLNOIN +RREXI2: MOVE P,DISPRR + SUB P,[1,,1] ;POP OFF RET ADDR AT RRLP + REST DISPRR + CALL RRLEAV ;SET UP "RRE" VARIABLES. + SETOM ECHCHR ;A ^R COMMAND WHICH CALLS ^R SHOULDN'T HAVE ECHOING WHEN IT RETURNS. + ANDCMI FF,FRARG+FRARG2 + SKIPE DISPRR ;IF EXITING THE OUTERMOST LEVEL OF ^R, + JRST RREXI1 + CALL SETTTM ;TURN ON SYSTEM ECHOING AGAIN. + MOVE CH,QRB.. + SKIPE A,.QCRMC(CH) ;EXECUTE THE SECRETARY MACRO IF ANY. + CALL MACXQ +RREXI1: REST C ;POP QREG PDL PTR SAVED AT ENTRY TO ^R + CALL FSQPU0 ;UNWIND PDL DOWN TO THAT LEVEL. + JRST POP1J + +RRTHRW: MOVE CH,DISPRR ;RETURN TO ^R MAIN LOOP. + PUSHJ CH,SETP1 + MOVEI TT,RRLP ;RETURN TO IT AT NORMAL RETURN, NO MATTER WHERE WE LEFT IT FROM. + MOVEM TT,(P) + .I RRLAST=RRPRVC ;MAKE SURE ARGS GET FLUSHED. + JRST RREAR0 ;WE'RE COMING FROM OUTSIDE ^R, SO MUST OFFICIALLY RE-ENTER. + +RRLEAV: .I RREZ=Z + .I RREBEG=BEG +RRLEA1: +RRLEA2: .I RREPT=PT + .I RREHPS=RRHPOS + .I RREVPS=RRVPOS + .I RREBUF=BFRSTR + RET + + +;[ ;HANDLE THE ^] COMMAND IN ^R MODE. +;CLOBBERS ALL ACS. SKIPS. +RRBRC: SKIP + MOVEI A,[ASCIZ /[0[1MU0:I1 +<^V^:FT0 FIU0 :I110 Q0-."N0;'> +F^:M(:I* F^:M1(]1]0) ) /] + +RRMAC0: SKIP ;SUPPLY ^R-STYLE NUMERIC ARG AS ARG TO MACRO. + MOVEM C,NUM ;SUPPLY THE COMMAND'S ARG, OR 1 (THE DEFAULT), TO THE MACRO, + TRZ FF,FRARG + SKIPE RRARGP +RRMAC6: IORI FF,FRARG ;AND TELL IT IT HAS AN ARG IF THE ARG IS NON-DEFAULTED. + JRST RRMAC5 + +;CALL THE MACRO IN A WITH NO ARG., AND LOOK AT ITS RETURNED VALUES TO DECIDE +;HOW TO UPDATE THE ^R-MODE VARIABLES. +RRMACR: ANDCMI FF,FRARG + SETZM NUM +RRMAC5: ANDCMI FF,FRARG2\FRCLN\FRSYL\FROP ;IN ANY CASE THE MACRO DOESN7T HAVE 2 ARGS. + SETZM SARG + CALL RRLEAV ;SET UP THE "RRE" VARIABLES. + CALL MACXQW ;EXECUTE THE MACRO. + JRST RREAR0 + +SUBTTL PROCESS ARGUMENTS/VALUES GIVEN TO ^R + +RREAR0: TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPL -3(A) + TLZ FF,FLNOIN ;TO SAY WHETHER THIS IS ^R OR ^ V. +RREARG: SKIPE ECHOFL + CALL NOECHO +RREAR1: CALL VBDACU ;MAKE SURE FS ALTCOUNT IS IN PHASE WITH REALITY + JFCL + MOVE C,NLINES + CALL WINSET ;COMPUTE SIZE AND POS OF WINDOW, SET RRTOPM. RRBOTM, BOTLIN, VSIZE. + MOVMS DISTRN ;TRUNCATION SCREWS ^R-MODE. + MOVE T,BFRSTR + CAME T,RREBUF ;IF BUFFER HAS BEEN SWITCHED ON US, RECOMPUTE THE DISPLAY! + SETOM RRMNVP + .I RRHPOS=RREHPS + .I RRVPOS=RREVPS + MOVE A,BEG ;RELOCATE ALL ^R-MODE POINTERS INTO BUFFER. + SUB A,RREBEG + SETZM RREBEG ;DECLARE ^R IN CONTROL; PREVENT ^G INT LVL QUIT. + ADDM A,RREPT + ADDM A,RREZ + SKIPN RGETTY + JRST RRTTY + CALL RRFXRL ;RELOCATE LINBEG TABLE BY A. + MOVE BP,TOPLIN + MOVE T,GEA ;IF CURRENT FS WINDOW$ IS NOT CONSISTENT WITH LINBEGS, + ADD T,BEGV ;WE SHOULDN'T HAVE BEEN FED ANY ARGS, + LDB B,[3300,,LINBEG(BP)] + CAMN B,T + CAMLE B,ZV ;SO FLUSH THEM. SAME GOES IF FS WINDOW$ IS IMPOSSIBLE. + TRZ FF,FRARG + MOVE C,QRB.. + SKIPE TT,MORFLF ;IF OUR MACRO RAN INTO A --MORE--FLUSHED, + SETOM TYOFLG ;DON'T LET IT STAY AROUND TO PLAGUE NEXT COMMAND, +; SKIPE MORFLF +; SETZM .QVWFL(C) ;AND WE CAN ALSO REDISPLAY RIGHT NOW. +;REMOVED SO THAT FLUSHING WITH A RUBOUT WILL CAUSE REDISPLAY AFTER THE NEXT INPUT CHAR. +;IS NOT EXPECTED TO AFFECT WHAT HAPPENS WHEN YOU FLUSH WITH NON-RUBOUT. + SETZM MORFLF + MOVEM TT,OLDFLF + MOVE TT,MORESW + SKIPN .QVWFL(C) ;DOES STUFF ON SCREEN WANT TO BE PRESERVED? + JRST [ CAIE TT,MS%FLS ;NO: BUT IF MODE LINE SAYS --MORE--FLUSHED, + JRST RREAR2 ;WE MUST ACT TO PREVENT LOSS AT RRLP3. + JRST RREAR4] + SETZM .QVWFL(C) + CALL TYINH ;YES: WAIT TILL USER TYPES A CHARACTER SAYING + CAIE CH,40 + MOVEM CH,UNRCHC ;HE HAS READ THE STUFF (DON'T FLUSH THE CHARACTER UNLESS IT'S A SPACE) +RREAR4: CALL RRLRDS ;NOW MAKE SURE THAT THE BUFFER IS REDISPLAYED AFTER THIS CHARACTER + SETOM RRMSNG ;NOTE LINES MAY NEED REDISPLAY EVEN IF AFTER RRMAXP. + SETZM ERRFL1 ;NO NEED TO PROTECT AN ERROR MESSAGE PAST NEXT INPUT CHARACTER. +RREAR2: MOVE C,NUM ;GETARG WANTS 2ND VALUE IN C. + MOVE E,SARG ;AND 1ST VALUE IN E. + SKIPL RRMNVP ;*IF THIS IS A SCREW, AT LEAST DO THIS IN RREAR3* + TRNN FF,FRARG ;MACRO RETURNED NO ARG => + JRST RRMAC1 ;DON'T ASSUME ANYTHING. + SKIPGE GEA ;PREVENT CONFUSION IF ALREADY KNOW GOING TO DO FULL REDISPLAY. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => ONLY PT HAS CHANGED. + JRST RRMAC3 + CAML E,C + EXCH C,E ;DO F^@ - PREVENT 2<1 ERROR BY ORDERING THE ARGS PROPERLY. + CALL GETANU ;TURN MACRO'S VALUES INTO CHAR ADDRS. + CALL RRLMOV ;FIND VPOS IN BP OF LOWEST UNCHANGED LINE. + JRST RRMAC3 ; CHANGES ARE BELOW SCREEN, NOTHING TO DO. + CAMGE BP,TOPLIN + JRST RREAR3 ;IF CHANGES REACH PAST TOP, SCROLL DOWN. + MOVE TT,Z + SUBM TT,RREZ ;RREZ _ CHANGE IN # CHARS IN BUFFER. + SAVE PT + CALL RRHMOV + CALL RRCRDB ;MOVE BACK TO ELIMINATE BEFORE-EFFECTS. + REST E ;WE ARE JUST BEFORE 1ST PLACE ON SCREEN + MOVE BP,RRVPOS ;THAT WAS CHANGED. MARK THIS AS PLACE + MOVE T,RRHPOS ;THAT REDISPLAY MUST START BEFORE. + CALL RRDLB2 ;UPDATE RRMNVP AND RRMNHP. + CALL RRQMOV ;GET BACK CORRECT PT, MOVE FWD TO THERE, GETTING CORRECT HPOS AND VPOS. + MOVE E,C + MOVE A,RREZ + JRST RRFXMX ;UPDATE RRMAXP. + +;HERE FOR CHANGES THAT REACH PAST TOP OF SCREEN. +;FIGURE OUT WHERE CHANGES STOP, AND CHOOSE A NEW WINDOW TO PUT THAT POINT +;ON THE SAME LINE WHERE IT IS NOW, THUS AVOIDING REDISPLAYING THE UNCHANGED TEXT. +RREAR3: MOVE A,Z + SUB A,RREZ + MOVE E,C ;FIRST, ADJUST RRMAXP FOR THE CHANGES MADE. + CALL RRFXMX + CALL RRLID2 ;THEN, FIND 1ST UNALTERED LINE'S POS IN BUFFER AND SCREEN + JRST RRMAC1 ;THERE IS NONE => DO FULL REDISPLAY. + MOVE A,RRIDVP ;A GETS THAT LINE'S VPOS. + SUB A,TOPLIN + LDB E,[014300,,A] + ADD A,E ;IF IT IS IN THE BOTTOM 1/3 OF THE SCREEN, + ADD A,TOPLIN + CAML A,BOTLIN ;MIGHT AS WELL RE-CENTER THE WHOLE THING. + JRST RRMAC1 + SAVE PT + LDB A,[3300,,RRIDLB] + MOVEM A,PT ;OTHERWISE, PICK A WINDOW THAT DOESN'T REQUIRE IT TO MOVE. + MOVE A,RRIDVP ;CALCULATE WINDOW PUTTING PT AT VPOS IN A. + CALL VBDBL1 + MOVEM B,RRVPOS + MOVE A,RRIDLB ;OK, POINT OF LAST CHANGE HASN'T MOVED ON SCREEN, + ASH A,-33 ;BUT CURSOR MIGHT NOT BE AT THE END OF CHANGED REGION. + MOVEM A,RRHPOS ;SO FIGURE OUT WHERE THE CURSOR IS. + REST E + CALL RRMOV +;HERE TO SAY REDISPLAY MUST START AT THE TOP OF THE SCREEN, BUT NOT REQUIRE TESTING THE WINDOW. +;SAYS NOTHING ABOUT WHERE REDISPLAY NEEDS TO END. +RRLRDS: MOVE TT,TOPLIN ;NOW THAT WINDOW HAS BEENCHANGED, EVERY LINE NEEDS REDISPLAY. + CAMGE TT,RRMNVP ;IF RRMNVP IS -1, DON'T FORGET THAT FACT! + MOVEM TT,RRMNVP + SETZM RRMNHP + MOVE A,GEA ;AND WE MUST SET UP FIRT LINE'S LINBEG SO DISPLAY STARTS OFF RIGHT. + ADD A,BEGV ;WE COULD JUST SETOM RRMNVP, BUT THEN THE WINDOW, WHICH WE KNOW IS + MOVEM A,LINBEG(TT) ;VALID, WOULD BE WASTEFULLY REBLESSED. + RET + +;FIGURE OUT CURRENT CURSOR POSITION OF CHAR ADDR IN E. +;USES THE OLD LINBEGS AND RRMNVP, AS A SHORTCUT. +RRQMOV: CALL RRLMOV + JFCL + CAMGE BP,TOPLIN + MOVE BP,TOPLIN +;ASSUMES BP WAS SET UP BY CALLING RRLMOV. +RRHMOV: MOVEM BP,RRVPOS ;SET PT, RRVPOS AND RRHPOS TO VALUES + LDB TT,[3300,,LINBEG(BP)] + MOVEM TT,PT ;AT START OF LINE ON WHICH 1ST CHANGE LIES. + MOVE TT,LINBEG(BP) ;THOSE ARE STILL VALID, SINCE NOTHING CHANGED ABOVE THEM. + ASH TT,-33 + MOVEM TT,RRHPOS + JRST RRMOV ;THEN SCAN FROM THERE TO THE DESIRED POINT. + +;FIND IN BP THE VERTICAL POSITION OF THE LOWEST LINE +;WHICH, AS OF LAST DISPLAY (NOT, NOT, NOW) BEGAN BEFORE THE CHAR ADDR IN E. +RRLMOV: MOVE BP,RRMNVP + CAMN BP,[377777,,777777] + JRST RRLMO1 + LDB TT,[3300,,LINBEG(BP)] + CAMGE TT,E + JRST POPJ1 +RRLMO1: MOVE BP,TOPLIN + SOS BP +RRMAC2: MOVEI TT,1(BP) + CAME BP,RRMNVP ;WE CAN'T USE A VPOS WHOSE LINBEG DOESN'T EXIST OR ISN'T VALID. + CAMN TT,BOTLIN + JRST POPJ1 + LDB TT,[3300,,LINBEG+1(BP)] + CAML TT,RROLZV ;IF CHANGES WERE INSERTION AT END OF BFR, WE WANT TO FIND THE LINE + JRST [ CAMGE BP,TOPLIN ;WHICH CONTAINS THE LAST OF THE OLD TEXT CHARACTERS. + MOVE BP,TOPLIN ;INSERTION INTO EMPTY BUFFER IS A CHANGE STARTING WITH LINE 0. + JRST POPJ1] + ;IF CHANGES START AT 1ST CHAR OF NEXT LINE, WE NEED NOT SCAN THIS LINE, + CAMN TT,E ;UNLESS NEXT LINE STARTS IN MID-CHARACTER, + SKIPL LINBEG+1(BP) ;IN WHICH CASE THE CHAR REALLY BEGINS ON THIS LINE. + CAMLE TT,E ;IF CHANGES START BEFORE NEXT LINE, MUST SCAN THIS LINE. + JRST POPJ1 + ;THIS CHANGED FROM CAML SO THAT ^K'ING TOP LINE OF SCREEN + ;WOULD NOT END UP SAYING CHANGES REACH PAST TOP OF SCREEN, ETC. + AOJA BP,RRMAC2 ;IF CHANGES START AFTER END OF LINE, NEED NOT SEARCH IT. + +;UPDATE THE "MINIMUM SCREEN POSITION THAT CHANGED" +;USING DICTIONARY ORDER ON RRVPOS, RRHPOS. +RRDLB2: CAML BP,BOTLIN ;DON'T EVER LET RRMNVP BECOME AS LARGE AS BOTLIN. + JRST [ MOVE BP,BOTLIN + SOJA BP,.+1] + CAMLE BP,RRMNVP + POPJ P, + CAMGE BP,TOPLIN ;DON'T ALLOW RRMNVP TO BECOME LESS THAN TOPLIN. + SETO BP, ;MAKE IT -1 (WHICH IS SPECIAL) IF CHANGES GO OFF TOP. + EXCH BP,RRMNVP + CAMG BP,RRMNVP + CAMG T,RRMNHP + MOVEM T,RRMNHP + POPJ P, + +RRFXM1: MOVE E,PT + CALL RRDLB2 +;UPDATE RRMAXP. SIGNED # CHARS INSERTED OR DELETED IN A, +;PLACE INSERTED OR DELETED IN E. +RRFXMX: MOVE T,RRMAXP ;NOTE RRMAXP MAY HAVE THE SPECIAL VALUE INFINITY (LARGEST POS NUMBER) + AOS T + CAILE T,1 ;IN WHICH CASE IT SHOULDN'T BE RELOCATED. + ADDM A,RRMAXP ;RELOCATE OLD VALUE IN CASE IT'S ABOVE WHERE CHANGE HAPPENED. + CAML E,RRMAXP + MOVEM E,RRMAXP ;MAKE SURE RRMAXP IS ABOVE PLACE CHANGE HAPPENED. + POPJ P, + +;SET PT TO VALUE IN E, UPDATING CURSOR POS. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRMOV: CAMN E,PT ;PT SAME AS MARK => DO NOTHING. + POPJ P, + MOVE A,E + SUB A,PT ;MOVING A LONG DISTANCE => DON'T BOTHER TO KEEP TRACK OF + MOVMS A ;CHANGES IN VPOS AND HPOS. JUST GO THERE AND RECOMPUTE HPOS. + CAIL A,10000. + SKIPN RGETTY + CAIA + JRST RRMOVL + CAML E,PT + JRST RRMOVF ;PT BEFORE DESIRED PT => GO FWD. +RRMOVB: CALL RRBACK + CAMN E,IN ;REACHED THE DESIRED PT YET? + RET + SKIPL A,RRVPOS ;GONE ABOVE TOP OF SCREEN? + JRST RRMOVB + MOVNS A ;ON TERMINAL WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + ADD A,TOPLIN + CAMGE A,VSIZE ;TILL WE GET A SCREEN HEIGHT ABOVE THE TOP OF THE SCREEN. + SKIPN LID ;UNTIL THAT POINT, THERE MAY BE SOME ADVANTAGE IN SCROLLING + CAIA ;THE SCREEN DOWN, AND FOR THAT WE NEED TO KEEP THE VPOS. + JRST RRMOVB +RRMOVL: MOVEM E,PT ;IT'S PROBABLY FASTER TO REQUEST COMPLETE RECOMPUTATION. + JRST RRMAC1 + +RRMOVF: MOVE TT,RRVPOS + ADDI TT,3 + SAVE TT +RRMOVG: CALL RRFORW + CAMN E,IN + JRST POP1J + MOVE TT,RRVPOS + MOVE TT1,(P) ;IF GO AT LEAST 3 LINES (FOR RRTTY'S SAKE, TO AVOID HAVING LONG JUMPS + CAML TT,TT1 ;LOOK LIKE MOTION TO NEXT LINE) AND + CAMG TT,BOTLIN ;GONE BELOW BOTTOM OF SCREEN, THEN DON'T BOTHER SCANNING IT OUT. + JRST RRMOVG + SUB TT,BOTLIN ;ON TTY WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + CAMGE TT,VSIZE ;TILL A SCREEN HEIGHT BELOW THE BOTTOM, IN CASE WE CAN + SKIPN LID ;SAVE DISPLAY BY SCROLLING THE TEXT UPWARD. + CAIA + JRST RRMOVG + SUB P,[1,,1] + JRST RRMOVL + +;,F^R - REPORT CHANGES BETWEEN , TO ^R WITHOUT DISPLAYING ANYTHING. +;F^R TELLS ^R NOT TO REMEMBER ANYTHING FROM ITS PREVIOUS DISPLAYING. + +;:F^R FORCES A VALID FS WINDOW$ TO BE CALCULATED NOW. +;SET FS WINDOW TO -1 FIRST, TO FORCE A NEW WINDOW TO BE COMPUTED FROM SCRATCH. +;DO A F^R FIRST TO AVOID ASSUMING THAT FS ^R VPOS$ IS VALID. +;:F^R CHOOSES A WINDOW THAT PUTS POINT ON LINE +FS TOPLIN$ +;A NEGATIVE COUNTS FROM THE BOTTOM OF THE USABLE WINDOW. +;IF THE WINDOW IS CHANGED, THAT FACT IS REPORTED TO ^R IMMEDIATELY, +;SO YOU CAN RETURN ONE VALUE TO ^R IF YOU ARE SURE YOU DON'T INVALIDATE IT. + +;^:F^R IS LIKE :F^R EXCEPT THAT, IF INSERT/DELETE LINE ARE AVAILABLE, +;IT IMMEDIATELY SHIFTS STUFF ON THE SCREEN TO REDUCE EVENTUAL REDISPLAY. + +;,^ F^R SAYS LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) NEED REDISPLAY. +RRALTR: TRNE FF,FRCLN + JRST RRALT1 + TRNE FF,FRUPRW ;^F^R IS FOR EXITING THE MINIBUFFER. + JRST RRMNX + TRNN FF,FRARG ;NO ARG => SAY ALL HAS CHANGED. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => SAY NOTHING HAS. ^R WILL KNOW ANYWAY + RET ;IF POINT HAS BEEN CHANGED. + MOVE A,BEG ;2 ARGS => REPORT MODIFICATIONS TO PART OF BUFFER. + SUBM A,RREBEG + EXCH A,RREBEG + CALL RRFXRL + CALL RREAR2 + .I RREZ=Z + JRST RRLEA2 + +RRALT1: SKIPGE C ; :F^R COMES HERE. + ADD C,VSIZE ;A NEGATIVE ARG COUNTS FROM WINDOW BOTTOM. + ADD C,TOPLIN ;ALL ARGS ARE RELATIVE TO WINDOW, NOT ABSOLUTE ON SCREEN. + MOVE A,C + TRNE FF,FRARG ;NO ARG => TEST OLD WINDOW, BASED ON RRVPOS. + JRST RRALT2 + SKIPL GEA ;OLD WINDOW NOT KNOWN OR RRVPOS REPORTED SUSPECT => + SKIPGE RRMNVP + JRST RRALT7 ;SKIP THE FAST CHECK, AND DO ORDINARY BLESSING. + MOVE B,PT ;THE FAST CHECK IS ONLY APPLICABLE WHEN POINT IS + CAME B,RREPT ;AT THE PLACE WE HAVE REMEMBERED THE VPOS OF. + JRST RRALT7 + CALL RRWBLS + CAIA ;FAST CHECK APPLICABLE AND LOSES => NEW WINDOW CERTAINLY NEEDED, + RET +RRALT6: SETOB A,GEA ; SO TELL VBDBLS NOT TO BOTHER WITH THE OLD ONE. +RRALT2: CAML A,TOPLIN + CAML A,BOTLIN +RRALT7: SETO A, + SAVE GEA + SAVE RRVPOS + CALL VBDBLS + REST E ;E HAS PREVIOUS VPOS OF POINT. + REST A ;A HAS PREVIOUS ADDRESS OF TOP LINE. + MOVEM B,RREVPS ;B HAS NEW VPOS OF POINT. + MOVEM B,RRVPOS + .I RREHPS=CHCTHP + .I RREPT=PT ;WHEN WE RETURN TO ^R IT SHOULD KNOW WHICH POINT RREVPS REFERS TO. + CAMN A,GEA ;IF THE WINDOW IS ACTUALY CHANGED, + RET + SKIPE LID ;AND WE CAN'T OR SHOULDN'T MOVE THE TEXT, + TRNN FF,FRUPRW + JRST RRALT5 + SKIPL RRMNVP + JRST RRALT3 +RRALT5: SETOM RRMSNG ;JUST TELL ^R THAT EVERY LINE NEEDS REDISPLAY + JRST RRLRDS ;BUT WINDOW IS CERTAINLY GOOD. + +;HERE TO TRY TO MOVE TEXT ON THE SCREEN WITH INSERT/DELETE LINE +RRALT3: MOVN C,B ;HOW FAR ARE WE MOVING TEXT, AND WHICH WAY? + ADD C,E + MOVM E,C ;GET MAGNITUDE OF DISTANCE MOVED. + CAML E,VSIZE ;MOVING MORE THAN SCREEN HEIGHT => ALL OF OLD WINDOW GOING OFF SCREEN + JRST RRALT5 ;SO DON'T BOTHER WITH THIS. + MOVE BP,TOPLIN ;THE LINE THAT WILL MOVE TO POSITION TOPLIN + MOVE E,C ;IS NOW ON THE SCREEN AT POSITION TOPLIN+C(C). + ADD E,BP ;TELL DSLID WHAT THAT POSITION IS. + MOVEM E,RRIDVP ;FOR DOWNWARD MOTION, THAT LINE IS FICTITIOUS, BUT DSLID KNOWS THAT. + JUMPL C,RRALT4 + ;MOVING UP => PRETEND DELETED THE FIRST FEW LINES ON THE SCREEN. + CAML E,RRMNVP ;CAN'T WIN IF CHANGES TO TEXT EXTEND ABOVE WHAT WILL BECOME + JRST RRALT5 ;THE FIRST LINE ON THE SCREEN, SINCE IN THAT CASE ITS LINBEG IS WRONG. + MOVE TT,LINBEG(E) + MOVEM TT,RRIDLB ;RRIDLB GETS LINBEG OF WHAT WILL BECOME THE TOP LINE ON SCREEN. + MOVE TT,RRMNVP + MOVNS C ;RRMNVP MOVES UP WITH THE TEXT, IF IT ISN'T INFINITY. + CAME TT,[SETZ-1] + ADDM C,RRMNVP ;NOTE IT CAN'T GO PAST TOPLIN, DUE TO CAML E,RRMNVP ABOVE. + JRST RRLID5 ;GO DELETE THE LINES BELOW TOPLIN. + +RRALT4: AOS RRIDVP ;COMPENSATE FOR DIFFERENT MEANING OF THIS AND BP IF MOVING TEXT DOWN. + CALL DSLID ;MOVE IT. + JRST RRALT5 ;THEN SAY EVERY LINE MIGHT NEED REDISPLAY. + +;HERE FOR ,^ F^R SAYING LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) +;NEED REDISPLAY. +RRMNX: CAML C,RRMNVP ;HANDLE END OF RANGE OF VPOS'S BY SETTING RRMAXP TO CORRESPOND TO IT, + JRST RRMNX1 ;OR, IF LINBEGS AROUND THERE ARE UNKNOWN, BY SETTING RRMSNG. + LDB T,[3300,,LINBEG(C)] + MOVEM T,RRMAXP + JRST RRMNX2 + +RRMNX1: SETOM RRMSNG +RRMNX2: MOVE BP,E ;HANDLE BEGINNING OF RANGE OF VPOS'S BY SETTING RRMNVP THERE. + SETZ T, + JRST RRDLB2 + +;,FM - MOVE DOWN TO HPOS , LINES DOWN. +;,^ FM - MOVE UP TO HPOS , - LINES UP. +;NORMALLY, EXACT VALUE OF HPOS IS NEEDED TO STOP SCAN. +;BUT COLON MODIFYER => ANY LARGER HPOS IS ALSO OK. +;IF SCAN DOESN'T FIND AN ACCEPTABLE HPOS ON THE DESIRED LINE +;THEN EITHER A NIB ERROR OR A NHP ERROR WILL RESULT. +;FM TRIES TO AVOID STOPPING BETWEEN A CR AND ITS LF. +FMCMD: TRNE FF,FRARG2 + TRNN FF,FRARG + TYPRE [WNA] + CALL RRBTCR ;MAKE SURE RRHPOS IS CORRECT FOR CURRENT BUFFER AND PT. + ADD E,RRVPOS ;E IS DESTINATION VPOS. + MOVE IN,PT + TRNE FF,FRUPRW + JRST FMBACK ;NOW FORWARD AND BACKWARD MOTION DIVERGE. +FMFWD: CAMGE E,RRVPOS ;IF WENT PAST TARGET LINE, WITHOUT STOPPING ON IT, BARF. + JRST [ CALL RRBCRL ;MOVE BACK TO END OF DESIRED LINE. + TYPRE [NHP]] + CAME E,RRVPOS ;IF HAVE REACHED TARGET VPOS, + JRST FMFWD1 + TRNE FF,FRCLN + CAML C,RRHPOS ;AND HAVE REACHED TARGET HPOS, + CAMN C,RRHPOS + RET +FMFWD1: CAML IN,ZV + TYPRE [NIB] ;AT END OF BUFFER WITHOUT REACHING TARGET => BARF. + CALL RRFORW + JRST FMFWD + +FMBACK: CAMLE E,RRVPOS ;WENT PAST TARGET VPOS WITHOUT FINDING TARGET HPOS => BARF. + JRST [ CALL RRFCRL ;RETURN TO DESIRED LINE BEFORE COMPLAINING. + TYPRE [NHP]] + CAME E,RRVPOS ;REACHED TARGET VPOS + JRST FMBAC1 + TRNE FF,FRCLN + CAML C,RRHPOS + CAMN C,RRHPOS + RET +FMBAC1: CAMG IN,BEGV + TYPRE [NIB] + CALL RRBCRL + JRST FMBACK + +;MOVE FORWARD OVER EITHER A SINGLE CHAR OR A CRLF. +RRFCRL: CALL RRFORW + CAIE CH,^M + RET + CALL GETCHR + CAIE CH,^J + RET + JRST RRFORW + +;MOVE BACKWARD OVER EITHER A SINGLE CHAR OR A CR-LF PAIR. +RRBCRL: CALL RRBACK ;MOVE BACK 1 CHAR, + CAIE CH,^J ;AND IF THAT LEAVES US BETWEEN A CR AND ITS LF, + RET ;MOVE BACK 1 MORE. + SOS IN + CALL GETINC + CAIE CH,^M + RET + JRST RRBACK + +SUBTTL ^R COMMAND DISPATCH TABLE MANAGEMENT + +;FS ^R INIT$ RETURNS THE INITIAL SETTING OF FS ^R CMAC$. +;THE UPARROW FLAG HAS THE SAME MEANING AS FOR FS ^R CMAC$. +FSCRIN: TRZN FF,FRARG + TYPRE [WNA] + CALL TYIABN ;IF DON'T HAVE UPARROW FLAG, CONVERT ASCII ARG TO 9-BIT. + MOVEI CH,(C) + TRZN CH,META + TRNN C,CONTRL + SKIPA A,[RRXINS] ;META OR NON-CONTROL CHARS ARE SELF-INSERTING (EXCEPT RUBOUT) + MOVEI A,RRUNDF ;MOST CONTROLS ARE ERRORS. + LDB Q,[.BP 177,CH] + CAIL Q,40+"A + CAILE Q,40+"Z + CAIA ;IF THE ASCII PART IS LOWER CASE, + MOVE A,[40,,RRINDR] ;IT IS A "RRINDR" CHAR (INDIRECT). + CAIN CH,CONTRL+33 ;CONTROL-ALTMODE GOES INDIRECT THROUGH ALTMODE. + MOVE A,[200,,RRINDR] ;AND SIMILAR FOR CONTROL-META-ALTMODE. + CAIL CH,CONTRL+^H ;SIMILAR FOR CONTROL-BS, CONTROL-TAB, CONTROL-LF, + CAILE CH,CONTRL+^J ;CONTROL-CR, AND META EQUIVALENTS. + CAIN CH,CONTRL+^M + MOVE A,[200,,RRINDR] + CAIL CH,CONTRL+"H + CAILE CH,CONTRL+"J + JRST FSCRI1 + MOVE A,[300,,RRINDR] + JRST POPJ1 + +FSCRI1: CAIN C,33 ;ALTMODE ON TV IS NOT SAME AS CTL-[ ;] + MOVEI A,RREXIT + CAIN C,^M ;SIMILARLY, HANDLE CR (WHICH IS NOT CTL-M) + MOVE A,[RRCRLF,,RRREPT] + CAIL C,^H + CAILE C,^J + CAIA + MOVE A,[RRINSC,,RRREPI] + CAIL Q,"0 ;CONTROL, META AND C-M-DIGITS ALL ADD TO ARGUMENT TO NEXT CMD. + CAILE Q,"9 + JRST FSCRI2 + TRNE C,CONTRL+META + MOVEI A,RRCDGT +FSCRI2: CAIE Q,"- ;C-MINUS, M-MINUS AND C-M-MINUS ALL SET "NEGATE ARG" FLAG + JRST FSCRI3 + TRNE C,CONTRL+META + MOVEI A,RRCMNS +FSCRI3: CAIN C,177 ;RUBOUT IS A RUBOUT. + MOVEI A,RRRUB + CAIN C,CONTRL+177 ;CTL-RUBOUT IS TAB-HACKING RUBOUT. + MOVEI A,RRCRUB + CAIL C,CONTRL+"@ + CAILE C,CONTRL+"_ + JRST POPJ1 + SUBI C,CONTRL+"@ ;AS A LAST RESORT, LOOK CHAR UP IN RRITAB. + ROT C,-1 + HRRZ A,RRITAB(C) ;INDEX TO HALFWORD OF INITIAL VALUE TABLE. + SKIPL C + HLRZ A,RRITAB(C) + TRZN A,400000 ;400000 BIT => DEFINITION GOES THROUGH RRREPT. + JRST POPJ1 + HRLZS A + HRRI A,RRREPT + JRST POPJ1 + + +;TABLE OF INITIAL ^R-MODE DEFINITIONS OF CONTROL CHARACTERS. +.SEE RRMACT ;CHANGE RRMACT WHEN YOU CHANGE THIS. +.BYTE 22 +RRITAB: RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + RRINDR ;CONTROL-H (THIS ENTRY NOT ACTUALLY USED) + RRINDR ;CONTROL-I " + RRINDR ;CONTROL-J " + RRKILL ;^K + RRCTLL ;^L + 400000+RRINSC ;CONTROL M + RRNEXT ;^N + 400000+RRCTLO ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;CONTROL-[ ;] + RRUNDF ;^\ + RRBRC ;[ ;^] + RRUNDF ;^^ + RRUNDF ;^_ +.BYTE + +;GET OR SET THE MACRO ASSOCIATED WITH A CHARACTER +;(IF A CHAR HAS AN ASSOCIATED MACRO, WHEN THAT CHAR IS READ IN +;^R-MODE, THE MACRO IS CALLED INSTEAD OF THE USUAL ACTION FOR +;THAT CHARACTER.) +;^^FS^RCMAC$ GETS, Q,^^FS^RCMAC$ SETS. +;CHARACTER IS ASSUMED TO BE ASCII. IF UPARROW FLAG IS ON, +;THE CHARACTER IS TREATED AS 9-BIT INSTEAD. +;DEPOSITS IN -1(P)! ASSUMES THE CALLER WAS THE FS COMMAND DISPATCH! +FSCRMA: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => SETTING, ELSE GETTING. + CALL TYIABN ;IF FRUPRW OFF, CONVERT ASCII ARG TO 9-BIT. + MOVE E,C + MOVE C,SARG + CAIGE E,RRMACL ;LAST ARG OUT OF RANGE => ERROR. + SKIPGE E + TYPRE [AOR] + ADDI E,RRMACT ;E -> WORD TO BE SET OR GOTTEN. + HRLM E,-1(P) .SEE FSCALL + JRST FSNOR1 + +TYIABN: TRZN FF,FRUPRW ;IF FRUPRW IS OFF, CONVERT ASCII CHAR IN C TO 9-BIT. + CAIL C,40 + RET + CAIE C,33 + CAIN C,^M + RET + CAIL C,^H + CAILE C,^J + ADDI C,300 + RET + +; FS ^R IND RETURNS THE CHAR CODE THAT INDIRECTS TO (MAY BE ITSELF). +FSINDT: TRZ FF,FRARG ;FLUSH ARG OR WE WILL ADD TO IT. + CAIGE C,512. + CAIGE C,0 + TYPRE [AOR] + HRRZ A,C ;INITIALLY ASSUME CHAR NOT INDIRECT. +FSIND1: HRRZ T,RRMACT(A) + CAIE T,RRINDR + JRST POPJ1 ;NOT INDIRECT => RETURN IT. + HLRE T,RRMACT(A) ;ELSE COMPUTE THE CHAR IT INDIRECTS TO. + SUB A,T + JRST FSIND1 + +;, F^S SEARCHES BUFFER IN STARTING AT WORD +;FOR A WORD CONTAINING . RETURNS IDX OF FIRST SUCH, OR -1 IF NONE. +;, :F^S SEARCHES ^R DEFINITION TABLE. +TABSRC: TRNN FF,FRARG + TYPRE [WNA] + MOVE J,[-RRMACL,,RRMACT] + TRNE FF,FRCLN ;COLON => SEARCH ^R DEFINITION TABLE. + JRST TABSR1 + CALL QREGX ;ELSE READ QREG NAME + MOVE BP,A + CALL QBGET1 ;AND DECODE CONTENTS AS BUFFER. + MOVE T,MFBEGV(B) ;B HAS FRAME ADDR; MAKE AOBJN TO CONTENTS. + IDIVI T,5 + HRRZ J,T + MOVE T,MFZV(B) + IDIVI T,5 + SUBM J,T + HRL J,T +TABSR1: HRLS E + ADD E,J ;1ST ARG IS # OF ENTRIES AT FRONT OF TABLE NOT TO TEST. + CAME C,(E) + AOBJN E,.-1 + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + JUMPGE E,NRETM1 ;RETURN -1 IF DON'T FIND THE OBJECT. + SUB E,J + HRRZ A,E + JRST POPJ1 ;ELSE RETURN INDEX FIRST FIND IT AT. + +SUBTTL MISCELANEOUS ^R MODE COMMANDS + +RRCTLL: SKIP ;^L COMMAND. + SKIPN RGETTY ;^L WITH ARG PRINTS SPEC'D # OF LINES (FOR PRINTING TTY'S). + JRST RRDISL + CALL CTLL +RRMAC1: SETOM RRMNVP ;CAUSE WINDOW TO BE TESTED, + SETOM RRMSNG ;AND THE WHOLE BUFFER TO BE REDISPLAYED. + JRST RRBTCR ;IN CASE THAT DOESN'T HAPPEN FOR A WHILE + ;MAKE SURE WE HAVE A REASONABLE RRHPOS. + +RRDISL: SETZM RUBENC ;HERE FOR ^L; DISPLAY LINES OF BUFFER. + CALL CRR + CALL CRR + CALL WINSET ;SET WINDOW SIZE TO LINES. + CALL VBDRR ;DO THE DISPLAY. + CALL RRDIS3 ;THEN DO A 0T SO USER SEES WHERE CURSOR IS. + MOVE C,NLINES ;RESTORE NORMAL WINDOW SIZE. + JRST WINSET + +RRMAC3: ADDB A,RREPT ;RELOCATE OLD PT FOR BUFFER MOTION. + CAML A,BEGV ;OLD CURSOR-LOCATION NO LONGER INSIDE BUFFER => + CAMLE A,ZV ;CAN'T MOVE FROM THERE, MUST REDISPLAY SLOW WAY. + JRST RRMAC1 + MOVE E,PT + SKIPN RGETTY ;ELSE, USE EITHER RRMOV OR RRQMOV TO DETERMINE NEW VPOS/HPOS, + JRST RRMOV1 ;GUESSING WHICH ONE WILL BE FASTER; BUT ON TTY'S USE ONLY RRMOV. + MOVE TT,A + SUB TT,PT + MOVMS TT + CAIL TT,30. + JRST RRQMOV +RRMOV1: MOVEM A,PT ;THAT IS WHERE RRHPOS AND RRVPOS ARE RIGHT FOR. + JRST RRMOV + +RRERST: SAVE Q +RRERS1: CAML CH,DISPRR ;POPPING OUT OF A MACXQ: POPPING OUT OF A ^R-INVOCATION? + JRST POPQJ + SOS Q,DISPRR ;IF SO, RESTORE DISPRR'S VALUE OUTSIDE THAT INVOCATION. + POP Q,DISPRR + SKIPE DISPRR ;IF THIS ^R WAS THE OUTERMOST, + JRST RRERS1 + SAVE TT + SAVE TT1 + SAVE CH + CALL SETTTM ;RESTORE NORMAL TTYSET. + REST CH + REST TT1 + REST TT + JRST POPQJ + +;RTNS TO HANDLE THE MARK. + +;SET THE MARK AT PT. +RRMARK: SKIP + SKIPE RR4TCT ;^U^T EXCHANGES MARK WITH PT. + JRST RREXCH +RRMRK1: .I RRMKPT=PT-BEG + POPJ P, + +;EXCHANGE THE MARK AND PT. +RREXCH: SKIP + SKIPGE E,RRMKPT + JRST RRERR ;NO MARK => CAN'T EXCHANGE. + ADD E,BEG ;TURN INTO CHAR ADDR. + SAVE PT ;REMEMBER NEW VALUE OF MARK. + CALL RRMOV ;MOVE PT TO OLD MARK. + REST TT ;SET MARK TO OLD PT. + SUB TT,BEG + MOVEM TT,RRMKPT + JRST RRTTY ;ON PRINTING TERMINAL, GO SHOW CURSOR MOTION. + +;DO FX..K ON EVERYTHING FROM PT TO THE MARK. +RRFX: SKIP + SKIPGE A,RRMKPT + JRST RRERR + ADD A,BEG + CAMN A,PT ;DELETING NO CHARS => + JRST RRFXXT ;DON'T CLOBBER QREG ..K. + CAMG A,PT + CALL RREXCH ;MAKE SURE PT IS BEFORE MARK. + MOVE E,PT + MOVE A,RRMKPT + ADD A,BEG + MOVE C,A + SUBM E,A + CALL RRFXMX ;SET RRMAXP + CALL RRCRDI ;WORRY ABOUT BEFORE-EFFECTS. + CALL [ CALL RRDLB2 ;SET RRMNVP, RRMNHP FROM T,BP. + MOVE CH,QRB.. + ADDI CH,.QRRBF + CALL FXCMD2 ;DO THE FX. D _ AMOUNT BEG CHANGED. + MOVE A,D + JRST RRFXRL] ;RELOCATE VARIOUS PTRS THAT MUCH +RRFXXT: SETOM RRMKPT ;ELIMINATE THE MARK. + POPJ P, + +;RELOCATE RR MODE'S VARIOUS PTR THAT ARE KEPT AS CHAR ADDRS, +;BY THE AMOUNT IN A. (IN CASE THE BUFFER WAS MOVED) +;CLOBBERS TT +RRFXRL: MOVE TT,RRMAXP ;NOTE THAT IF RRMAXP IS INFINITY IT SHOULDN'T BE CHANGED. + AOS TT + CAILE TT,1 ;ALSO IF IT IS ZERO. + ADDM A,RRMAXP + ADDM A,RROLDZ + MOVE TT,TOPLIN +RRFXR1: CAMN TT,BOTLIN + RET + ADDM A,LINBEG(TT) + AOJA TT,RRFXR1 + +;KILL LINES STARTING AT PT, AND PUT IN QREG ..K. +RRKILL: SKIP + CALL RRMRK1 + CALL RRNEX1 + JRST RRFX + +;^S -- READ CHAR, AND SEARCH FOR THAT CHAR. +RRSRCH: SKIP + SAVE C + CALL RRECO1 ;MAYBE PROMPT WITH A ^S. + REST NUM + MOVEI A,[ASCIZ/FIU..0 :S..0 /] + JRST RRMAC6 + +RRCTLB: SKIP ;^B MOVES BACKWARD - IT IS -^F. + MOVNS C +RRCTLF: SKIP ;^F MOVES FORWARD, BUT ON PRINTING TTY IT ECHOES. + AOS (P) + JUMPL C,RRCB1 ;WORK FOR NEGATIVE ARGS. + JSP E,RRREP1 + JRST RRFORW + +RRCB1: MOVNS C + JSP E,RRREP1 + JRST RRBACK + +;JSP E,RRTYPP SKIPS UNLESS WE ARE SCANNING (SHOULD PRINT SCANNED CHARACTERS). +RRTYPP: SKIPN RGETTY + SKIPN RRSCAN + JRST 1(E) + JRST (E) + +;^P -- WITH ARGUMENT , DOES -@L. +RRPREV: SKIP ;CALCULATE , + MOVNS C + JRST RRNEX2 ; IS -. + +;^A -- MOVE TO BEGINNING OF LINE. +;WITH ARGUMENT , DOES -1@L. +RRBEG: SKIP + SOJA C,RREND2 + +;^E -- MOVE TO END OF LINE (:@L). WITH ARGUMENT , DO :@L. +RREND: SKIP +RREND1: TRO FF,FRCLN +RREND2: AOS (P) + JRST RRNEX1 + +;^N -- MOVE TO BEGINNING OF NEXT LINE. (@L) +;WITH ARGUMENT , DOES @L. +RRNEXT: SKIP +RRNEX2: AOS (P) + SAVE [RRCMIN] ;DO COMMENT-MODE STUFF AT START AND FINISH OF MOTION. + CALL RRCMRU +RRNEX1: MOVE IN,PT + TRO FF,FRUPRW + CALL GETAG4 ;COMPUTE WHERE WE'RE GOING TO. + JFCL + ADD E,C ;THE WAY THE L COMMAND DOES. + SUB E,PT + JRST RRMOV ;THEN GO THERE. + +;CALL HERE WHEN LEAVING A LINE. +;IN COMMENT MODE, TAB-SEMI'S ARE REMOVED BY THIS RTN. +RRCMRU: SKIPGE RRCMMT + POPJ P, ;DO NOTHING IF NOT COMMENT MODE. +RRCMR1: SAVE C + MOVEI C,1 + CALL RREND1 + JFCL + REST C + MOVE IN,PT + CAMG IN,BEGV + POPJ P, ;DO NOTHING AT BEGINNING OF BUFFER. + SOS IN + CALL GETCHR ;IF CHAR BEFORE PT IS A SEMI, + CAIE CH,"; + POPJ P, +RRCMR0: CALL RRDLB ;DELETE IT, AND ANY TABS BEFORE IT. + MOVE IN,PT + CAMG IN,BEGV + POPJ P, + SOS IN + CALL GETCHR + CAIE CH,^I + CAIN CH,40 + JRST RRCMR0 + POPJ P, + +RRCMS1: SETZ C, + CALL RRNEX1 + +;CALL HERE WHEN ENTER A LINE. +;IN COMMENT MODE, TAB-SEMI WILL BE INSERTED. +RRCMIN: SKIPGE RRCMMT + RET ;NOT COMMENT MODE. +RRCMI0: MOVE IN,PT ;MOVE UP TO EXISTING COMMENT + CALL RREOLT ;OR END OF LINE. + JRST RRCMI1 ;REACHED END, INSERT TAB-SEMI. + CALL GETCHR + CAIN CH,"; + JRST RRFORW ;REACHED SEMI, STOP AFTER IT. + CALL RRFORW + JRST RRCMI0 ;ELSE KEEP LOOKING. + +RRCMI1: MOVEI CH,^I ;INSERT TABS TILL REACH COMMENT COLUMN + CALL RRINS + MOVE A,RRHPOS + CAMGE A,RRCCOL ;REACHED THE COMMENT COLUMN? + JRST RRCMI1 ;NO, MORE TABS TO INSERT. + MOVEI CH,"; ;YES, INSERT THE SEMI. + JRST RRINS + +;^C -- COMPLEMENT COMMENT MODE. +RRCMSW: SKIP ;IF NUMERIC ARG, IT IS SETTING OF COMMENT COLUMN. + CAIE C,1 + MOVEM C,RRCCOL + AOSE A,RRCMMT ;IF WAS -1, MAKE IT 0. + SETOB A,RRCMMT ;WAS >=0, MAKE IT -1. + CALL RRECSP ;THEN INDICATE WHICH MODE WE'RE IN. + MOVE CH,(A)1+[ "T ? "C ] + CALL FSECO1 + XCT (A)1+[CALL RRCMR1 ;LEAVING COMMENT MODE, REMOVE SEMI. + CALL RRCMS1] ;WHEN ENTER COMMENT MD, INSERT SEMI. +;TYPE A SPACE IN THE ECHO REGION, MAKING SURE CURSOR WILL +;BE REPOSITIONED IN THE DISPLAY REGION. PRESERVE ALL ACS. +RRECSP: SAVE CH + MOVEI CH,40 + CALL FSECO1 + JRST POPCHJ + +;^R -- SET COMMENT COLUMN FROM CURRENT HPOS. +RRCMCS: SKIP A,RRHPOS + SKIPGE RRCMMT ;NO EFFECT UNLESS IN COMMENT MODE. + POPJ P, + MOVEM A,RRCCOL + POPJ P, + +;TABLES USED BY RRCHRG. THE ENTRY FOR EACH +;CHARACTER IS AN INDEX INTO RRFORT OR RRBACT. + +RRCHBP: REPEAT 6,<360600-<6*.RPCNT>_12.>,,RRCHTB(A) + +;CODES IN RRCHTB ARE: + ;0 - 1-POSITION CHARACTER. + ;1 - ORDINARY CTL CHAR - USUALLY 2-POSITION, BUT 1-POSITION IN SAIL MODE. + ;2 - BACKSPACE. + ;3 - CR + ;4 - LF + ;5 - TAB. + ;6 - SPECIAL CTL CHARACTER - 2-POSITION EVEN IN SAIL MODE. + +RRCHTB: .BYTE 6 + 1 ;^@ + 1 ;^A + 1 ;^B + 1 ;^C + 1 ;^D + 1 ;^E + 1 ;^F + 1 ;^G + 2 ;^H + 5 ;^I + 4 ;^J + 1 ;^K + 1 ;^L + 3 ;^M + 1 ;^N + 1 ;^O + 1 ;^P + 1 ;^Q + 1 ;^R + 1 ;^S + 1 ;^T + 1 ;^U + 1 ;^V + 1 ;^W + 1 ;^X + 1 ;^Y + 1 ;^Z + 0 ;ALTMODE, 1 POSITION. + 1 ;[ ;^] + 1 ;^\ + 1 ;^^ + 1 ;^_ + .BYTE + +SUBTTL OBSOLETE ^T COMMAND + +EDIT: CALL GAPSLP + SKIPE ECHOFL + CALL NOECHO + TRZ FF,FRARG+FRARG2+FRUPRW ;FRARG ON = INSERT MODE, OFF = OVERWRITE MODE + ;FRARG2 ON = IN IS POINTING TO CR + ;FRUPRW ON = BACKWARDS RUB MODE + SETZM COMCNT + MOVE B,CBUFLO + SKIPA IN,PT +ED0.0: POP P,A ;PURGE EXTRA PUSHJ P, +ED0: PUSHJ P,CRR + TRZ FF,FRUPRW ;TURN OFF "\" FLAG +ED1: PUSHJ P,DISFLS + PUSHJ P,TYI + CALL TYINRM + MOVE A,CH + MOVEI CH,"\ + CAIL A,40 + JRST EDLIS + SKIPL C,EDDPTB(A) ;IS IT A RUBBACK COMMAND + JRST ED11 ;NO + TRON FF,FRUPRW ;TURN ON "\" FLAG +ED12: PUSHJ P,TYOA ;AND IF WAS OFF, TYPE "\" +ED13: MOVE CH,A + PUSHJ P,@C + PUSHJ P,TYO + JRST ED1 + +ED11: TRZE FF,FRUPRW ;TURN OFF "\" FLAG + JRST ED12 ;IF IT WAS ON, PRINT "\" + JRST ED13 + +BELL: CALL TYPBEL + JRST CPOPJ1 + +EDLIS: CAIE A,177 + JRST EDLIS1 + TRON FF,FRUPRW + PUSHJ P,TYOA + JRST .+3 +EDLIS1: TRZE FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + PUSHJ P,CKCH + JRST ED0 + JRST ED1 + PUSHJ P,EDOV + JUMPL CH,ED1 + PUSHJ P,TYO + JRST ED1 + +ED%: MOVEI CH,"# + PUSHJ P,TYO + PUSH P,IN + PUSH P,FF +ED%1: PUSHJ P,CGETIN + JUMPL CH,ED%2 ;END OF LINE OR BUFFER + PUSHJ P,TYO + JRST ED%1 +ED%2: POP P,FF + POP P,IN + PUSHJ P,CRR + MOVE A,COMCNT + JUMPLE A,CPOPJ1 + MOVE B,CBUFLO + ILDB CH,B + PUSHJ P,TYO + SOJG A,.-2 + JRST CPOPJ1 +EDOV: MOVE A,CH + TRNN FF,FRARG ;IN INSERT MODE + PUSHJ P,CGETIN ;NO + SKIPA CH,A +EDCPY: PUSHJ P,CGETIN + JUMPL CH,CPOPJ +EDCPY1: IDPB CH,B + AOS COMCNT + POPJ P, + +CGETIN: MOVNI CH,1 + TRNE FF,FRARG2 + POPJ P, + CAML IN,ZV ;AT END OF BUFFER + JRST CGETI1 + PUSHJ P,GETCHR + CAIN CH,15 +CGETI1: TROA FF,FRARG2 + AOJA IN,CPOPJ + MOVNI CH,1 + POPJ P, + +EDCR: PUSHJ P,CRR +EDCR2: TRNE FF,FRARG2 + JRST EDCR1 + PUSHJ P,CGETIN + JRST EDCR2 +EDCR1: MOVE C,IN ;GET ADDR AFTER END OF OLD LINE, + MOVE E,PT ;GET ADDR OF START OF IT, + CALL DELET1 ;TURN THAT INTO GAP. + MOVE C,COMCNT ;NOW INSERT SPACE FOR NEW LINE, + CALL SLPGET ;BP GETS BP TO IDPB INTO SPACE. + MOVE A,COMCNT + JUMPE A,EDCR3 + MOVE B,CBUFLO + ILDB CH,B + IDPB CH,BP + SOJG A,.-2 +EDCR3: TRZ FF,FRARG+FRUPRW+FRARG2 + SETZM COMCNT + SETOM UNRCHC + PUSHJ P,SETTTM + JRST GO + +RTYI: PUSHJ P,TYI + CALL TYINRM + CAIE CH,177 + POPJ P, + MOVEI CH,"\ + TRON FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + SUB P,[1,,1] + POPJ P, + +EDD: PUSHJ P,CGETIN ;DELETE NEXT CHAR + JUMPL CH,BELL ;BELL IF NONE + MOVEI CH,"% + POPJ P, + +EDP: MOVEI CH,"< ;COMPLEMENT STATE OF INSERT/OVERWRITE MODE + TRCE FF,FRARG + MOVEI CH,"> + POPJ P, + +EDS: PUSHJ P,RTYI ;COPY THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDS1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDS1 ;KEEP LOOKING + POP P,FF + POP P,IN + JRST EDN1 +EDN: PUSHJ P,EDCPY ;COPY THRU 1ST SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAIN CH," + JRST EDN + MOVEI A," +EDN1: PUSHJ P,EDCPY + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAME CH,A + JRST EDN1 + JRST CPOPJ1 + +EDS2: POP P,FF + POP P,IN + JRST BELL + +EDQ: PUSHJ P,RTYI ;QUOTE NEXT CHAR + JRST EDOV + +EDT: PUSHJ P,RTYI ;DELETE THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDT1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDT1 + POP P,FF + POP P,IN + JRST EDO1 + +EDO: PUSHJ P,CGETIN ;DELETE THRU NEXT SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + MOVE A,CH + MOVEI CH,"% + PUSHJ P,TYO + CAIN A," + JRST EDO + MOVEI A," +EDO1: PUSHJ P,CGETIN + JUMPL CH,CPOPJ1 + CAMN CH,A + SETOM A + MOVEI CH,"% + PUSHJ P,TYO + JUMPL A,CPOPJ1 + JRST EDO1 + +EDR: TROA FF,FRARG+FRUPRW ;FRARG ON = ECHO +EDL: TRZ FF,FRARG+FRUPRW ;FRUPRW ON = DONT END EDIT +EDL1: TRNE FF,FRARG2 + JRST EDL2 + PUSHJ P,EDCPY + JUMPL CH,EDL2 + TRNE FF,FRARG + PUSHJ P,TYO + JRST EDL1 +EDL2: TRZ FF,FRARG + TRZE FF,FRUPRW + JRST CPOPJ1 ;DON'T END EDIT + PUSHJ P,CRR ;CR-LF THEN END EDIT + JRST EDCR1 + +EDW: LDB CH,B ;RUBBACK TO 1ST NON-SPACE, THEN BACK TO 1ST SPACE + CAIE CH," + JRST EDW1 + MOVEI CH,177 + PUSHJ P,CKCH + JRST ED0.0 + JRST EDW +EDW1: LDB CH,B + CAIN CH," + JRST CPOPJ1 ;FOUND SPACE, QUIT + MOVEI CH,177 ;TO TELL CKCH TO RUBBACK + PUSHJ P,CKCH + JRST ED0.0 ;NOTHING TO RUB + JRST EDW1 + .VALUE ;SHOULD NEVER GET HERE + +EDALT: TRO FF,FRARG ;COPY REST W/ ECHO AND END EDIT + TRZ FF,FRUPRW + JRST EDL1 + +SUBTTL TECO COMMAND DISPATCH / ARGUMENT ARITHMETIC + +CD: SETZM NUM ;FLUSH ANY ARGUMENT, OR : OR ^. + SETZM SARG + TRZA FF,FRARG+FRARG2+FROP+FRUPRW+FRCLN+FRSYL +CD2B: TROA FF,FROP+FRARG ;COME HERE FROM ARITH OPS, NEED 2ND ARG. +CD2A: MOVSI A,(ADD C,);SET UP DLIM FOR THE DEFAULT + ;CONDITION OF ADDING THE OLD VALUE + ;WITH ANY NEW NUMBER ENTERED + HLLM A,DLIM ;PUT THE APPROPRIATE OPERATOR AWAY + CLEARM SYL ;CLEAR THE NEW NUMBER ENTERED + CLEARM OSYL ;ALSO CLEAR ITS OCTAL INTERPRETATION +CD5: MOVE A,QRWRT ;IF IMPURE STRING SPACE HAS INCREASED BY + CAML A,QRGCMX ;GCOFTN CHARS SINCE PREVIOUS GC, + PUSHJ P,GC ;GC THE IMPURE STRINGS. +CD5A: SKIPGE STOPF ;IF THE USER HAS ^G'ED, TRY TO QUIT, + CALL QUIT0 ;TRY TO QUIT (CHECK NOQUIT). + CALL RCH ;GET THE NEXT COMMAND CHARACTER +CDRCH: TRNE CH,100 ;CONVERT LOWER CASE TO UPPER. + ANDCMI CH,40 + SETZB B,SQUOTP + TRZ FF,FRNOT ;RESET MORE FLAGS + XCT DTB(CH) ;EXECUTE THE ENTRY FROM THE DISPATCH TABLE +CD5B: TLZ FF,FLDIRDPY ;RESET THE "DISPLAY THE FILE DIRECTORY BIT", THIS INSURES + ;THAT AN E COMMAND WILL ONLY DISPLAY THEBUFFER IF IT IS THE LAST COMMAND + MOVE C,NUM ;GET THE OLD VALUE + TRZN FF,FRSYL + JRST CD5C + XCT DLIM ;THEN PERFORM THE SAVED OPERATION + MOVEM C,NUM ;AND MAKE IT THE NEW OLD VALUE +CD5C: MOVE E,SARG ;GET THE SECOND ARGUMENT TO THE COMMAND (IF ANY) + JUMPGE B,(B) ;IF B POSITIVE, THEN JUMP TO IT. + PUSHJ P,(B) ;IF B NEGATIVE, PUSHJ +CDRET: JRST CD ;NON-SKIP RETURNING COMMANDS DON'T RETURN VALUE +VALREC: TROE FF,FRARG ;IF HAVE ARG FROM BEFORE, NOT GOBBLED, + JRST VALRET ;DO ARITH. WITH IT & THIS CMD'S VALUE. + MOVEM A,NUM ;IF NO ARG OR THIS CMD USED IT, ITS + TRZ FF,FROP ;VALUE IS ALL THE ARG WE HAVE. + JRST CD2A + +CDNUM: JFCL 10,.+1 ;CLEAR OVERFLOW FLAG. + MOVE A,OSYL ;ASSEMBLE THIS DIGIT INTO A NUMBER + IMUL A,I.BASE ;(USUALLY OCTAL) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) + MOVEM A,OSYL + JFCL 10,.+1 + MOVE A,SYL + IMUL A,IBASE ;AND IN DECIMAL (USUALLY) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) +VALRET: MOVEM A,SYL ;SAVE IT AS A VALUE + TRZ FF,FROP ;DON'T HAVE ARITH OP WAITING FOR 2ND ARG +CD7: TRO FF,FRARG+FRSYL ;DECLARE THAT THERE IS AN ARGUMENT AND A CURRENT VALUE + JRST CD5 ;AND RETURN + + +;ARGDFL MACRO CALLS HERE IF FROP WAS SET, AFTER CLEARING IT. +;ARGDFL IS USED TO DEFAULT "-" TO "-1", ETC. +ARGDF0: SETZM SYL ;PRETEND A "1" HAD PRECEDED THIS CMD, + AOS SYL ;AFTER THE OPERATOR THAT NEEDS 2ND ARG, + XCT DLIM ;DO THE ARITHMETIC, + POPJ P, + +PNT: MOVE A,OSYL + TRNE FF,FRSYL + JRST VALRET + MOVE A,PT + SUB A,BEG + JRST VALRET + +CNTRAT: ARGDFL Z, ;^@ - TAKES 1 ARG, RETURNS .,.+ARG OR .+ARG,. . + TRZE FF,FRARG2 + JRST [ TRZE FF,FRCLN ;M,N:^@ RETURNS N,M. + JRST [ MOVE B,C + MOVE A,E + JRST 2VALS] + MOVE A,C ;M,N^@ RETURNS N-M. + SUB A,E + JRST POPJ1] + MOVE B,PT + ADD C,PT + MOVE A,C + CAMG A,B ;MAKE SURE ARGS ARE IN RIGHT ORDER. + EXCH A,B + JRST HOLE0 + +HOLE: MOVE B,BEGV + MOVE A,ZV +HOLE0: SUB B,BEG ;RETURN 2 CHAR ADDRS AS VALUES. + SUB A,BEG ;CHANGE THEM TO CHARACTER NUMBERS (REL TO BEG, THAT IS) +2VALS: MOVEM B,SARG ;RETURN 2 VALUES IN B, A. + TRO FF,FRARG2 + JRST POPJ1 + +END1: SKIPA A,ZV +BCMD: MOVE A,BEGV +FSROC1: SUB A,BEG + JRST POPJ1 + +;F^X COMMAND - WITHIN MACRO, RETURN THE MACRO ARGS +;(AS MANY AS IT WAS CALLED WITH). +FCTLX: MOVE A,MARG2 ;GET THE VALUES THE MACRO'S ARGS HAVE IF THEY EXIST. + MOVE B,MARG1 + MOVE C,MACBTS ;GET THE BITS THAT SAY WHETHER THEY DO. +;ENTER HERE DO F^X ON SOME OLD MACRO FRAME, WITH ITS DATA IN A, B, C. +FCTLX2: TRZ FF,FRARG+FRARG2+FROP+FRSYL + SETZM NUM ;FLUSH ALL TRACES OF ARGUMENTS. + SUB P,[1,,1] ;THROW AWAY RET ADDR (VALREC-1); WE WILL JUMP INTO COMMAND LOOP. + TLNN C,MFBA1 ;IF THERE'S A 1ST ARG, + JRST FCTLX1 + MOVEM B,SARG ;PUT IT AWAY + TRO FF,FRARG2 ;AND SAY THERE IS ONE. +FCTLX1: TLNE C,MFBA2 + JRST VALREC ;IF THERE'S A 2ND ARG, SET IT UP AS CURRENT VALUE. + JRST CD2A ;IF THERE ISN'T, SET UP NO CURRENT VALUE BUT DON'T CLEAR FRARG2. + +;F^Y COMMAND - TAKES 0,1 OR 2 ARGS, AND RETURNS 0 IF NO ARGS, 1 IF ONLY A 2ND ARG, +;2 IF ONLY A 1ST ARG (EG 1,F), 3 IF TWO ARGS (EG 1,2F). +;IN ADDITION, 4 IS ADDED TO THE RESULT IF THE COLON FLAG IS SET, +;AND 8 IS ADDED TO THE RESULT IF THE ATSIGN FLAG IS SET. +FCTLY: LDB A,[.BP FRARG+FRARG2+FRCLN+FRUPRW,FF] + TRZ FF,FRARG+FRARG2+FRUPRW+FRCLN + JRST POPJ1 + +;^M - FLUSH CURRENT VALUE +CTLM: MOVE A,CPTR ;^M. IF NEXT CHAR IS ^J, READ IT NOW. + ILDB CH,A + CAIN CH,^J + SKIPN COMCNT ;THIS IS SO THAT, IF FS STEP CALLS A MACRO, + CAIA ;THE POINTER IN AN FS BACKTRACE$ IS AT A NICE-LOOKING PLACE. + CALL RCH +CTLM2: SKIPN A,STEPFL + RET + MOVE B,STEPDE ;DON'T STEP IF DEEPER IN MACRO CALLS THAN USER-SUPPLIED LIMIT. + CAMGE B,MACDEP + JUMPGE B,CPOPJ + SETZ C, ;(DON'T GIVE THE STEP MACRO A NONZERO ARG) + CALL QLGET0 + CAIA ;IF FS STEP IS A NONZERO NUMBER, DO OUR BUILT-IN STEPPING. + JRST MACXCP ;IF IT'S A STRING, MACRO IT AND RETURN ITS VALUE. + MOVE A,QRB.. + SKIPE .QVWFL(A) + JRST CTLM1 + TRZ FF,FRARG+FRARG2+FRCLN + TRO FF,FRUPRW ;IN LINE-STEPPING MODE (SEE FS STEP$), + CALL VIEW1B ;DO ^VW, AND DECODE VALUE OF CHARACTER READ +CTLM1: MOVE A,QRB.. + SETZM .QVWFL(A) ;AND ALLOW BUFFER DISPLAY AFTER COMMAND. + TRZ FF,FRUPRW+FRCLN + CALL FTYI + JFCL + CAIN A,^F + JRST [ SETZM NOQUIT ;^F QUITS EVEN WHEN QUITTING NOT ALLOWED. + SETOM STOPF + RET] + CAIN A,^R + JRST [ CALL RRENTR ; ENTER ^R MODE + JRST CTLM1] ;THEN DECODE ANOTHER CHARACTER. + CAIN A,^P + SETZM STEPFL ;OR TURN OFF STEPPING + RET + +CAND: MOVSI A,(AND C,) + JRST CD2B +COR: MOVSI A,(IOR C,) + JRST CD2B +BAKARR: HRROI B,SERCHA ;_ IS EITHER SEARCH-AND-YANK OR SAME AS -. + SKIPLE NLAROW ;FS _DISABLE POSITIVE => "_" IS ERROR. + TYPRE [DCD] ;"DISABLED COMMAND" + SKIPN NLAROW ;FS _DISABLE IS NEGATIVE => "_" IS TREATED AS "-". + JRST CD5B ;FS _DISABLE IS 0 => "_" IS SEARCH-AND-YANK. +MINUS: MOVSI A,(SUB C,) + JRST CD2B +TIMES: MOVSI A,(IMUL C,) + JRST CD2B +SLASH: MOVSI A,(IDIV C,) + JRST CD2B +CXOR: MOVSI A,(XOR C,) + JRST CD2B +PLUS: MOVSI A,(ADD C,) + JRST CD2B + +SPACE: TRNE FF,FROP ;SPACE BETWEEN NUMBERS IS LIKE PLUS, + JRST CD5A ;BUT SPACE NEXT TO AN ARITHMETIC OPERATOR IS IGNORED. + JRST CD2A + +COMMA: TRZN FF,FRARG + JRST COMMA1 + MOVEM C,SARG + TROE FF,FRARG2 + TYPRE [WNA] +COMMA1: SETZM NUM ;NO ACCUMULATED 1ST ARG ANYMORE, + JRST CD2A ;INIT. FOR NEW ARG, DON'T CLEAR FRCLN. + +ASLSL: TROA FF,FRUPRW ;TURN ON THE UPARROW FLAG +ACOLON: TRO FF,FRCLN ;TURN ON THE COLON FLAG + JRST CD5A ;AND GO BACK FOR MORE + +;HANDLE (, ), F(, F) + +FOPEN: SUB P,[1,,1] ;F( - PUSH VALUES BUT DON'T FLUSH THEM. + SKIPA T,[CD5A] +OPEN: MOVEI T,CD ;( - PUSH AND FLUSH VALUES. +OPEN1: TRZ FF,FRQPRN ;SAY THIS ( ISN'T A QREG NAME. +OPEN2: SAVE NUM + HLLZ CH,DLIM + HRR CH,FF ;REMEMBER CURRENT FRCLN, FRUPRW, FRARG2. + TRNE FF,FRARG2 + SAVE SARG ;SAVE 2ND ARG IF THEE IS ONE. + SAVE CH + SAVE LEV + MOVEM P,LEV + JRST (T) + +FCLOSE: SUB P,[1,,1] ;F) - POP AND THROW AWAY VALUES. CALLED WITH PUSHJ. + SKIPA T,[CD5A] +CLOSE: HRROI T,CD5A ;) - POP AND RETURN VALUES. RH(T) IS RET. ADDR., SIGN=0 => THROW AWAY. +CLOSE2: CAME P,LEV + TYPRE [UMC] ;NOT ALLOWED IF TOP OF STACK DOESN'T HAVE SOME PUSHED VALS. + SKIPN Q,ITRPTR + JRST CLOSE1 + HLRZ Q,-1(Q) + CAIN Q,(P) + TYPRE [UMC] ;DON'T ALLOW SEQUENCE "(<)" - WOULD SCREW UP ">". +CLOSE1: REST LEV + REST CH + ANDCMI CH,#FRARG2#FRCLN#FRUPRW#FROP#FRARG#FRQPRN + TRNE CH,FRARG2 + REST B + REST A + TRNN CH,FRQPRN + JUMPGE T,(T) ;FOR F), DO NOTHING WITH THE POPPED STUFF. + EXCH A,NUM ;ELSE RESTORE SAVED ARG VALUES AND OPERATOR. + HLLM CH,DLIM + TRNE CH,FRARG2 + MOVEM B,SARG + TRZE CH,FRQPRN ;FOR Q( - ), WE HANDLE THE FLAGS A SPECIAL WAY. + JRST QREGXR + TRNE FF,FRARG ;NORMALLY, WE SET UP THE VALUE WITHIN THE PARENS AS A SYLLABLE + TRZ CH,FROP ;TO DO ARITHMETIC ON. SO THE PREVIOUS OPERATOR GETS A RIGHT OPERAND. + TRNE FF,FRARG + IORI FF,FRSYL + MOVEM A,SYL + IORI FF,(CH) + JRST (T) + +;SET P FROM CH, AND FORGET ABOUT ALL ('S +;THAT WERE IN THE PART OF THE STACK THAT HAS BEEN FLUSHED. +;ALSO PERFORM APPROPRIATE ACTIONS IN CASE POPPING PAST A ^R OR A SORT. +;THEN EXIT WITH POPJ P, (NOTE P HAS CHANGED, SO CALL WITH PUSHJ CH, +;BUT DON'T DARE DO THAT IF P=CH, SINCETHAT WOULD LEAVE THE RETURN +;POINTER ON STACK ABOVE P, CAUSING TIMING ERROR WITH INT. LEVEL). +SETP: MOVEM P,SETPP + CAMLE CH,P + .VALUE ;MOVING PDL POINTER UPWARDS?? + SKIPE DISPRR ;IF POPPING OUT OF A ^R, + CALL RRERST ;UNBIND SOME STUFF. + CAMGE CH,PSSAVP + SETZM PSSAVP ;DETECT ERRING OUT THROUGH A ^P, AND RELEASE SORT TABLES. +;HERE IF KNOWN NOT TO BE EXITING A ^R OR ^P. +SETP1: SKIPE LEV ;IF THERE IS AN (, + CAML CH,LEV ;AND IT'S NO LONGER BENEATH P, + JRST [ MOVE P,CH ? RET] + HRRZ P,LEV + CAIL P,PDL + CAIL P,PDL+LPDL + .VALUE + MOVE P,LEV ;FLUSH THE INNERMOST "(" + REST LEV + JRST SETP1 ;AND EXAMINE THE NEXT ONE. + +SUBTTL VIRTUAL CHARACTER ADDRESS SUBROUTINES + +CHKC: CAML E,BEGV ;BARF IF E NOT IN BUFFER. + CAMLE E,ZV + TYPRE [NIB] + RET + +CHK: CAMG C,ZV + CAMGE C,BEGV + TYPRE [NIB] + RET + +CHK1: CAMG E,BEGV + MOVE E,BEGV + CAML C,ZV + MOVE C,ZV + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +CHK1A: CAMG E,BEG + MOVE E,BEG + CAML C,Z + MOVE C,Z + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +GETIBI: SKIPA BP,IN +GETIB.: MOVE BP,PT +GETIBV: CAML BP,GPT + ADD BP,EXTRAC +GETIBP: SOSA TT,BP +GETBP: MOVE TT,BP + IDIVI TT,5 + MOVE BP,BTAB(TT1) + HRRI BP,(TT) + TLZ BP,17 + POPJ P, + +;CONVERT THE BYTE POINTER IN BP TO A CHARACTER ADDRESS +GETCA: LDB TT,[360600,,BP] ;GET POSITION FIELD IN TT + MOVEI BP,1(BP) ;CLEAR OUT LH OF BYTE POINTER + IMULI BP,5 + IDIVI TT,7 + SUBI BP,1(TT) + POPJ P, + +GETINC: MOVE TT,IN + AOSA IN +GETCHR: MOVE TT,IN + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + LDB CH,BTAB(TT1) + POPJ P, + +PUTINC: MOVE TT,OUT + AOSA OUT +PUT: MOVE TT,OUT + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + DPB CH,BTAB(TT1) + POPJ P, + + 440700+TT,, ;FOR SORT +BTAB: 350700+TT,, + 260700+TT,, + 170700+TT,, + 100700+TT,, + 10700+TT,, + +;CALL GETARG TO DECODE 0,1 OR 2 ARGS AS "T", "K", "X", ETC. DO. +;RETURNS IN E,C THE CHAR ADDRS OF BEGINNING AND END OF RANGE. +;SKIPS IF THERE WERE 0 OR 1 ARG; DOESN'T SKIP IF WERE 2. +;THE CALL TO GETARG SHOULD BE FOLLOWED BY A CALL TO CHK1 +;OR CHK1A, TO MAKE SURE THE ARGS ARE IN RANGE, IF THERE ARE 2 ARGS. + +;HERE TO AVOID LOOKING AT THE UPARROW FLAG. ALSO, CHECK RANGE USING VIRTUAL BOUNDS. +GETANU: SAVE FF + ANDCMI FF,FRUPRW + CALL GETARG + CALL CHK1 + REST FF + ANDCMI FF,FRCLN + RET + +;WITH THE UPARROW MODIFIER, WE STOP ONLY AT CRLFS, NOT STRAY LF'S. +GETARG: TRNE FF,FRARG2 + JRST GETAG6 + ARGDFL O +GETAG7: MOVE IN,PT +GETAG4: SAVE CH + SAVE B + JUMPLE C,GETAG2 + MOVE BP,IN + CAML BP,GPT + ADD BP,EXTRAC + CALL GETIBP +GETAR1: CAMN IN,ZV + JRST GETAG5 + CAMN IN,GPT ;REACHING THE GAP => MOVE OVER IT. + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;SCN UNTIL THE NEXT LF. + AOJA IN,GETAR1 + TRNN FF,FRUPRW ;IF WE HAVE THE UPARROW FLAG, + AOJA IN,GETAR2 + MOVE CH,BP ;CHECK THAT BEFORE THIS LF THERE IS A CR. + DBP7 CH + LDB CH,CH + TRNE FF,FRCLN ;IF WE HAVE COLON FLAG, WE WILL STOP BEFORE THE CR, + CAME IN,PT ;SO INSIST THAT THE CR ITSELF BE AFTER OUR STARTING POINT. + CAIE CH,^M + AOJA IN,GETAR1 + AOJ IN, +GETAR2: SOJG C,GETAR1 ;FOUND LF OR CRLF AS APPROPRIATE. IN POINTS AFTER THE LF. +GETAG1: TRZE FF,FRCLN + CALL GETAG8 + CAMG IN,BEGV + MOVE IN,BEGV +GETAG5: REST B + REST CH + MOVE E,PT + MOVE C,IN + TRZ FF,FRCLN\FRUPRW ;TURN IT OFF IF NOT ALREADY DONE + TLZE FF,FLNEG + EXCH C,E + AOS (P) + RET + +GETAG8: SUBI IN,2 + PUSHJ P,GETCHR + CAIE CH,15 + AOJA IN,GETAG9 + POPJ P, + +GETAG9: PUSHJ P,GETCHR + CAIE CH,12 + AOJ IN, + POPJ P, + +GETAG6: ADD C,BEG + ADD E,BEG + TRZ FF,FRCLN\FRUPRW + POPJ P, + +GETAG2: SOS IN +GETAG0: CAMGE IN,BEGV + AOJA IN,GETAG3 + PUSHJ P,GETCHR + CAIE CH,12 + SOJA IN,GETAG0 + TRNN FF,FRUPRW + JRST GETAR3 + CAMN IN,BEGV + JRST GETAG3 + SUBI IN,1 + CALL GETINC + CAIE CH,^M + SOJA IN,GETAG0 +GETAR3: AOJLE C,GETAG2 + AOJ IN, +GETAG3: TLO FF,FLNEG + JRST GETAG1 + +SUBTTL FUNDAMENTAL TECO COMMANDS + +REVERS: TRNE FF,FRARG2 ;R MOVES BACK N CHARACTERS. + JRST LINE ;MAKE FLR MOVE RIGHT OVER A LIST. + ARGDFL Z + MOVNS C + JRST REVER1 + +CHARAC: ARGDFL Z +REVER1: ADD C,PT +JMP1: CAML C,BEGV ;IS THE SPEC'D POS. WITHIN BFR'S LIMITS? + CAMLE C,ZV + JRST [TRZE FF,FRCLN ;NO, FOR :C, ETC. + JRST NRET0 ;RETURN FAILURE. + TYPRE [NIB]] ;NO :, THIS IS ERROR. + MOVEM C,PT + TRZE FF,FRCLN + JRST NRETM1 ;FOR :C, ETC. SAY SUCCESSFUL. + POPJ P, + +JMP: TRZN FF,FRARG + SKIPA C,BEGV + ADD C,BEG + JRST JMP1 + +LINE: CALL GETARG ;GET PT AND DESIRED PT IN C,E. DO GOBBLE UPARROW FLAG. + CALL CHK1 ;MAKE SURE ARGS ARE WITHIN VIRT. BUFFER. + ADD C,E + SUB C,PT ;IF EITHER ARG EQUALED PT, PT IS NOW THE OTHER ONE. + JRST JMP1 + +KILL: PUSHJ P,GETARG + PUSHJ P,CHK1 + JRST DELET1 + +DELETE: ARGDFL Z +DELET0: JUMPE C,CPOPJ ;DELETING 0 CHARS. + MOVE E,PT + ADD C,PT ;C,E HAVE 2 ENDS OF RANGE TO DELETE. + CALL CHK ;MAKE SURE C IS IN THE BUFFER. + +;MAIN DELETE RTN. C,E VIRTUAL CHAR ADDRS -> ENDS OF STUFF TO DELETE +;SETS PT TO PLACE DELETED FROM, LEAVES GAP THERE TOO. +.SEE FXCMD ;MUSTN'T CLOBBER A OR D. +DELET1: CAMG C,E ;GET UPPER END IN C, LOWER IN E. + EXCH C,E + MOVEM E,PT ;TELL GAPSLP WHERE TO PUT GAP (IF CALL IT) + SKIPE READON ;IF NOT ALLOWED TO MODIFY BUFFER + TYPRE [RDO] ;BARF OUT HERE + CAML C,GPT ;IF THE GAP IS IN OR NEXT TO + CAMLE E,GPT ;THE AREA BEING DELETED, OK. + CALL GAPSLP ;ELSE MOVE IT TO BE SO. + MOVEM E,GPT ;NOW TURN THE AREA INTO GAP. + SUB C,E +DELETB: SETOM MODIFF ;WE ARE CHANGING THE BUFFER CONTENTS. + ADDM C,EXTRAC + MOVNS C + ADDM C,ZV + ADDM C,Z + POPJ P, + +DEL1B: SOS PT ;DELETE 1 CHARACTER BACKWARDS FROM PT. + SOS GPT +DEL1F: SOS ZV ;DELETE 1 FORWARDS FROM PT. + SOS Z + AOS EXTRAC + RET + +SUBTTL F^E REPLACE CHARACTERS COMMAND + +;F^E$ - REPLACE STRING INTO BUFFER STARTING AT POSITION . +;:F^E$ - REPLACE IN QREG (EITHER STRING OR BUFFER WORKS). +;REPLACING IS LIKE INSERTING AND THEN DELETING AS MANY CHARS AS WERE INSERTED. +FCECMD: ARGDFL + TRZN FF,FRCLN + JRST FCE1 ;INSERT IN BUFFER? + TRZN FF,FRARG + TYPRE [WNA] + CALL QREGX ;NO, QREG. WHICH ONE? + CALL QLGET0 ;LENGTHH IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + SKIPL C + CAMLE C,B ;MAKE SURE ARG IS IN RANGE + TYPRE [AOR] + CALL GETCA + ADD BP,C ;ADJUST B.P. TO PLACE TO START REPLACING AT. + CALL GETBP + SETZ A, ;THERE'S NO GAP TO WORRY ABOUT. + JRST FCE2 + +FCE1: SKIPE READON ;ALLOWED TO MUNGE THIS BUFFER? + TYPRE [RDO] ;NO + SETOM MODIFF ;HERE WE ARE CHANGING THE CURRENT BUFFER'S CONTENTS. + TRZE FF,FRARG ;NO ARG, AND REPLACING IN BUFFER => USE ".". + JRST FCE5 + MOVE C,PT + SUB C,BEG +FCE5: MOVE BP,GPT ;REPLACE IN BUFFER. + CALL GETIBP ;MAKE B.P. TO START OF GAP SO WE CAN TELL WHEN WE REACH GAP. + MOVE A,BP + MOVE BP,BEG + ADD BP,C ;GET VIRT. CHAR ADDR OF WHERE TO START REPLACING + CAML BP,BEGV + CAMLE BP,ZV + TYPRE [AOR] + CALL GETIBV ;TURN INTO REAL CHAR ADDR, THEN BP. + ADD C,BEG ;TURN STOP ADRD IN C INTO ADDR REL. TO VIRTUAL BEG, + SUB C,BEGV ;SINCE MUST BE COMPARED WITH VIRTUAL SIZE. + MOVE B,ZV + SUB B,BEGV ;GET LENGTH OF BUFFER. +FCE2: SUB B,C ;C HAS CHARS FROM PLACE WE START TO END OF BUFFER OR QREG. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;FIND OUT WHAT STRING ARG DELIMITER WE'RE USING. + CALL RCH + MOVEM CH,INSDLM +FCE3: CALL RCH ;THIS IS THE INNER LOOP OF FCE + SKIPE SQUOTP + JRST FCE4 + CAMN CH,INSDLM ;CHECK CHAR FOR DELIMITERNESS UNLESS SUPERQUOTED, ETC. + JRST FCEEND +FCE4: SOJL B,[TYPRE [STL]] ;CHECK FOR END OF BUFFER OR QREG. + CAMN A,BP + CALL FEQGAP ;CHECK FOR GAP - MOVE B.P. IN BP OVER IT. + IDPB CH,BP + JRST FCE3 + +FCEEND: SETOM INSBP + RET + +SUBTTL INSERTION COMMANDS + +;INSERT ASCIZ STRING <- BP IN A, INTO Q-REG IN CH. +INSASC: TRO FF,FRCLN ;SAY INSERT IN Q-REG. + SAVE CH + SAVE [0] + SETZM INSDLM ;DELIMITER IS THE ^@ ENDING THE ASCIZ. + MOVE CH,[ILDB CH,A] + MOVEM CH,INSRCH ;GET CHARS BY ILDB-ING BP. + JRST INSAS1 + +FNCMD: MOVE CH,[CALL RCH] ;FN = [..N:I..N BUT PREVENTS QUIT IN BETWEEN. ;] + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QUNWN + CALL OPENB2 + JRST PSI + +CNTRLF: MOVN C,INSLEN ;^F -- SAME AS "FKDI". + CALL DELET0 + TRZ FF,FRARG ;MAKE SURE ^F DOESN'T INSERT ASCII(N). + JRST INSERT + +TAB: HRROI B,TAB0 ;HERE FOR TAB. DECIDE WHETHER IT'S + SKIPLE TABMOD + TYPRE [DCD] ;DISABLED, + SKIPE TABMOD + MOVEI B,SPACE ;IGNORED (LIKE SPACE, ACTUALLY), + JRST CD5B ;OR ENABLED (IN WHICH CASE COME BACK TO TAB0). + +TAB0: PUSHJ P,TYOMGS ;USED FOR ENTRY FROM SELF-INSERTING CHARACTERS + ANDCMI FF,FRCLN\FRUPRW\FRARG\FRARG2 +INSERT: TRNE FF,FRARG ;IF GIVEN AN ARG, + JRST INS1C ;THEN JUST INSERT THAT CHARACTER + MOVE OUT,[CALL RCH] ;SAY TO USE RCH TO GET CHARACTERS TO INSERT + MOVEM OUT,INSRCH + TRNN FF,FRCLN ;IF NOT GOING TO A Q REG + JRST INS1 ;THEN SKIP THIS STUFF + PUSHJ P,QREGVS ;OTHERWISE GET THE Q-REG NAME + JUMPE B,INS0 ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS PSI, THEN RETURNS TO INSERT'S CALLER. + JRST INS0 + +;PSI IS USED BY THINGS THAT WANT TO INSERT A STRING ARG INTO A SPECIFIC QREG. +;THE QREG ADDRESS SHOULD BE IN CH. +PSI: SETZ B, + TRO FF,FRCLN +INS0: SAVE CH ;REMEMBER WHICH QREG TO STORE IN. + SAVE B + CAIA +INS1: PUSHJ P,GAPSLP ;GET THE GAP AROUND THE HOME COUNTRY + MOVEI CH,ALTMOD ;GET THE TEMPORARY APROX- + ;IMATION TO THE DELIMITER + TRZE FF,FRUPRW ;IF IT ISN'T RIGHT (THE UPARROW + ;INDICATOR IS TURNED ON) + PUSHJ P,RCH ;THEN GET THE RIGHT ONE + MOVEM CH,INSDLM ;AND SAVE IT AS THE ONE TO USE + TRNN FF,FRCLN ;IF NOT INTO A Q-REG, THEN JUMP + JRST INS2 ;FORWARD +INSAS1: MOVE C,BFRBOT ;GET # CHARS UNUSED AFTER IMPURE STRING SPACE, + SUB C,QRWRT + SUBI C,4 ;WE'LL CERTAINLY NEED 4 FOR HEADER OF NEW STRING. + ;INS5 WILL PUT THAT IN TOTALC, # CHARS FREE TO USE. + MOVE BP,QRWRT ;START STRING AT START OF FREE SPACE, + ADDI BP,4 ;BEGIN THE TEXT AFTER WHERE HEADER'LL GO. + JRST INS5 + +INS2: MOVE BP,PT ;NEXT, GET THE POINTER ADDRESS + MOVE C,EXTRAC ;# CHARS FREE TO STORE IN IS GAP SIZE. +INS5: MOVEM C,TOTALC + CALL GETIBP ;GET BP FOR IDPB INTO GAP. + MOVEM P,INSINP .SEE INSCHK ;GO TO INSDUN ON CNM ERROR, TO CLEAN UP. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES INSIDE GETFRM INSIDE RCH. + +;HERE IS THE LOOP THAT GETS CHARACTERS AND PUTS THEM IN THE BUFFER +INSLUP: XCT INSRCH ;GET A CHARACTER (RCH AUTOMATICALLY + ;[ ;TAKES CARE OF ALL ^] CALLS AND MACRO + ;RETURNS) +INSDCK: SKIPE SQUOTP ;UNLESS WITHIN QUOTED MACRO, + JRST INSDIR + CAMN CH,INSDLM ;THEN SEE IF IT IS THE DELIMITER + JRST INSDUN ;IF SO, YOU'RE ALMOST DONE +INSDIR: SOSGE TOTALC + CALL INSSL1 + IDPB CH,BP + JRST INSLUP + +INSSL1: SETOM INSBP .SEE BFRRL3 ;FAKE OUT THE ERROR CHECK AT BFRRL3+EPSILON + CALL INSSLP + SETZM INSBP + RET + +INSSLP: MOVN C,TOTALC ;HOW MANY CHARS ALREADY KNOWN NEEDED.? + TRNE FF,FRCLN + JRST SLPQRG ;:I, MOVE UP BUFFER AT LEAST THAT MUCH. + ADD C,EXTRAC + JRST SLPSAV ;ELSE MAKE GAP > THAT MUCH BIGGER. + +INSDUN: SETOM INSBP + CALL GETCA + AOS OUT,BP ;CHAR ADDR 1ST PLACE NOT STORED IN. + TRNN FF,FRCLN ;IF YOU'RE NOT USING A Q-REG + JRST INS4 ;THEN EVERYTHING IS MUCH SIMPLER + SKIPGE TOTALC ;IF INSERTING 0 CHARS, MAKE SURE SPACE FOR HEADER. + CALL INSSL1 +INSDU1: MOVE C,BP ;GET END OF STRING, + MOVE BP,QRWRT ;AND PLACE START OF HEADER SHOULD BE. + SUB C,BP ;# CHARS WE USED (TEXT SIZE +4) + MOVEI B,QRSTR ;THIS IS THE CHAR TO START THE HEADER + CALL QHDRW0 ;WRITE A STRING HEADER AT <- CHAR ADDR IN BP. +INS3: REST B ;GET BACK INFO ON QREG. + REST CH ;GET BACK ADDR OF QREG TO STORE IN. + CALL QCLOSE ;STORE IN IT; OUT HAS CHAR ADDR END OF STRING. + ;QRWRT HAS CHAR ADDR OF BEINNING. UPDATES ALL PTRS. + JRST INSRT1 + +INS4: MOVEM BP,PT + MOVEM BP,GPT + MOVE CH,TOTALC ;# CHARS OF GAP WE DIDN'T USE. + EXCH CH,EXTRAC ;IS WHAT'S LEFT OF THE GAP. + SUB CH,EXTRAC ;AMOUNT WE DID USE + MOVEM CH,INSLEN ;IS # CHARS INSERTED. + ADDM CH,Z ;THAT MANY MORE CHARS NOW. + ADDM CH,ZV +INSRT1: SKIPN INSINP ;0 => WAS CLEARED BY INSCHK, WAS CNM ERROR. + TYPRE [CNM] + SETZM INSINP ;NO LONGER IN MIDDLE OF INSERT. + TRZ FF,FRCLN+FRUPRW ;IF THIS IS :I*, WE ARE RETURNING VALUE SO MUST CLEAR THESE + RET ;BY HAND. + +INS1C: ARGDFL + TRNN FF,FRARG2 ;,I - INSERT TIMES. + MOVEI E,1 + SKIPGE E +TYPAOR: TYPRE [AOR] + TRZE FF,FRCLN + JRST INS1CQ ;INTO QREG? + MOVE CH,NUM ;INTO BUFFER. + ANDCMI FF,FRCLN + PUSHJ P,GAPSLP + SKIPN C,E + RET + CALL SLPGET ;GET C(C) CHARS SPACE, AND B.P. IN BP. + IDPB CH,BP + SOJG C,.-1 + RET + +TYOMGS: CALL GAPSLP +TYOM: SAVE C + PUSH P,TT + PUSH P,TT1 + SAVE BP + MOVEI C,1 + CALL SLPGE1 + IDPB CH,BP + REST BP + POP P,TT1 + POP P,TT +POPCJ: REST C + RET + +;:I -- INSERT 1 CHAR IN QREG. +;,:I -- INSERT COPIES OF CHARACTER. +;:I* -- RETURNS A STRING CONTAINING THE CHARACTER . +INS1CQ: CALL QREGVS ;GET ADDR OF QREG IN CH. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + ;FLUSH ARG IN CASE :I* - OTHERWISE WOULD ADD ARG TO VALUE. + JUMPE B,INS1CR ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS INS1CR, THEN RETURNS TO INSERT'S CALLER. +INS1CR: SAVE B + MOVEI C,4(E) ;NEED 4 CHARS FOR HEADER, + CONTENTS. + CALL SLPQGT ;MOVE BUFFER UP IF NEC. + MOVEI B,QRSTR ;1ST CHARACTER, FOR HEADER. + MOVEI C,4(E) ;LENGTH, FOR HEADER. + CALL QHDRW1 ;WRITE THE STRING HEADER, LEAVE BP IN BP. + MOVE C,E + MOVE A,NUM + IDPB A,BP + SOJG C,.-1 + MOVEI OUT,4(E) ;GET ADDR 1ST CHAR THIS NEW STRING DOESN'T USE. + ADD OUT,QRWRT + REST B + JRST QCLOSE ;UPDATE QRWRT; STORE STRING IN QREG <- CH. + +SUBTTL GAP CONTROL + +IFNDEF SLPAMT,SLPAMT==SLPWRD*5 ;MAKE GAP IN UNITS OF THIS MANY CHARS. +IFNDEF SLPQAM,SLPQAM==SLPQWR*5 ;MOVE BUFFER UP IN UNITS OF THIS MANY. + +;MAKE SOME SPACE BY MOVING A SEGMENT OF MEMORY UPWARD. +;REAL CHARACTER ADDR. OF BOTTOM CHAR. OF SEGMENT TO MOVE IN BP +;REAL CHAR ADDR OF SEGMENT IN TT. +;MINIMUM AMOUNT OF SPACE (# OF CHRS) IN C. +;SPACE IS MADE ONLY IN MULTIPLES OF A WORD. +SLPN00: MOVE D,BFRTOP + SUB D,BEG ;GET NUMBER OF CHARS WE WILL HAVE TO MOVE. + CAIL D,2000*5*5 ;IF MORE THAN 5K WORDS, IT PAYS TO MAKE LOTS OF SPACE. + SKIPA D,[2000] ;SO MAKE IT A K AT A TIME, AND USE PAGE-MAPPING. + MOVEI D,100 ;ELSE JUST MAKE 100 WORDS AT A TIME. + MOVE E,@BFRPTR + TLNE E,MFQVEC ;IN A QVECTOR, MAKE ONLY 100 WORDS OF SPACE + MOVEI D,100 ;SINCE THEY NEVER GET VERY BIG. + MOVE E,D + IMULI D,5 + ADDI C,-1(D) ;ROUND C, THE NUMBER OF CHARS OF SPACE WE NEED, + IDIV C,D ;UP TO A MULTIPLE OF WHAT'S IN D, + IMUL C,E ;BUT CONVERT IT TO WORDS INSTEAD OF CHARACTERS. +;HERE TO MAKE SPACE FOR IMPURE STRING SPACE. +SLPN0Q: IDIVI BP,5 + ADDI TT,4 + IDIVI TT,5 + MOVE E,TT + ADD E,C ;ADDR OF LAST WD TO MOVE INTO, + 1. + SKIPE PSSAVP ;IF SORTING, + CAMGE E,PSMEM ;IF WE'D BE CLOBBERING SORT TABLES, MOVE THEM TOO. + JRST SLPN01 + MOVE TT,PSMEMT ;LAST WD TO MOVE UP IS LAST WD OF SORT TABLES, + ADDI TT,3 + ADDM C,PSMEM ;RELOCATE POINTERS TO SORT TABLES. + ADDM C,PSMEMT + MOVE E,TT + ADD E,C +SLPN01: ADDI E,2000 + LSH E,-10. + CAML E,LHIPAG ;DON'T IMPINGE ON PURE STRING SPACE! LEAVE 1K EMPTY IN BETWEEN. + TYPRE [URK] +IFN ITS,[ + TRNN C,1777 ;IF MAKING SPACE IN UNITS OF A K, DO IT BY PAGE MAPPING + JRST SLPN0P ;TO AVOID HAVING TO SWAP EVERYTHING IN. +SLPN0W: ] + SUBM TT,BP ;BP _ # WDS TO MOVE. + HRLI TT,-1 ;TT HAS -1,,LAST WD + 1. + SUB TT,[1,,1] ;MAKE -> LAST WD (1ST POP WILL MOVE IT) + MOVEI D,(C) + HRLI D,(POP TT,(TT)) + MOVE E,[SOJGE BP,D] + MOVE J,[JRST SLPN02] + JRST E +SLPN02: MOVE E,C ;GET BACK # WDS ADDED, + IMULI E,5 + ADDM E,TOTALC + POPJ P, + +IFN ITS,[ +SLPN0P: CAILE TT,2000(BP) ;MAKE SURE WE HAVE AT LEAST A K LEFT TO DO! + SKIPE PSSAVP ;USE PAGE-MAPPING ONLY IF NO SORT TABLE! WE'D CLOBBER IT! + JRST SLPN0W +SLPN03: MOVEI D,-1(TT) + LSH D,-10. ;COMPUTE # OF TOP PAGE TO MOVE, + MOVEI E,1777(TT) + ADD E,C ;AND # OF PAGE TO MOVE IT INTO, + 1. + LSH E,-10. + CAMLE E,MEMT ;SINCE WE ARE MOVING UP THE BOUNDARY OF BUFFER SPACE MEMORY, + MOVEM E,MEMT ;WE MUST REMEMBER THAT. + SUBI E,1 ;NOW CONVERT TO EXACT PAGE TO MOVE INTO. + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSELF ? D] + .LOSE %LSSYS + SUBI TT,1 + ANDI TT,-2000 ;SET TT TO TOP OF WHAT STILL NEEDS TO BE MOVED. + CAILE TT,2000(BP) ;KEEP MOVING PAGES UNTIL LESS THAN A PAGE REMAINS. + JRST SLPN03 +SLPN0R: CAMG E,D ;NOW, MAKE FRESH PAGES WHERE THE NEWLY CREATED GAP IS. + JRST SLPN0W + SOS E ;ENOUGH TO MAKE SURE WE DON'T HAVE ANYTHING IN THE MAP TWICE + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSNEW] + .LOSE %LSSYS ;IS EXACTLY THE RIGHT NUMBER. + JRST SLPN0R +] ;IFN ITS + +;MAKE SURE GAP AT LEAST SOME MINIMUM SIZE +;(# CHARS IN C) +SLPSAV: CAMG C,EXTRAC + RET + CALL SAVACS + SUB C,EXTRAC ;HOW MANY MORE CHARS NEEDED? + MOVE BP,GPT ;GET ACTUAL ADDR OF END OF GAP. + ADD BP,EXTRAC + MOVE TT,BFRTOP ;GET ACTUAL ADDR OF END OF BUFFER. + SAVE Z + SAVE MEMT + PUSHJ P,SLPN00 + MOVEI D,@D ;GET ADDR LAST WD OF NEWLY MADE GAP. + REST BP ;DON'T NEED TO CLEAR NEWLY OBTAINED CORE. + SKIPE YANKMT + MOVE BP,YANKMT + LSH BP,10. + CAML D,BP + SOS D,BP + MOVEI BP,1 ;PREPARE TO CLEAR LOW BITS OF WDS THAT NEED IT. + REST A ;ANY WD PREVIOUSLY PART OF THIS BUFFER DOESN'T NEED IT. + IDIVI A,5 +SLPSA2: CAMGE D,A + JRST SLPSA1 + ANDCAM BP,(D) + SOJA D,SLPSA2 + +SLPSA1: ADDM E,EXTRAC + MOVE T,E + MOVE TT,Z + CALL BFRRLC + JRST RSTACS + +;LIKE SLPGET, BUT FOR COMMANDS THAT EITHER INSERT IN THE BUFFER +;OR CONS UP AND RETURN A STRING. SUCH COMMANDS SHOULD ALSO EXIT THRU SLPXIT. +SLP: TRNE FF,FRCLN + JRST QOPEN + +;INSERT C(C) CHARS AT PT, MAKING SPACE IF NEC. +;PUTS PT AFTER THEM. BRINGS THE GAP TO PT. +;DON'T ACTUALLY PUT ANYTHING IN THOSE CHARS, +;RATHER RETURN IN BP A BP. TO IDPB INTO THEM. +;CLOBBERS TT, TT1. PRESERVES C! +SLPGET: CALL GAPSLP +SLPGE1: CAMLE C,EXTRAC ;HAVE ENOUGH ROOM FOR THE CHARS? + CALL SLPSAV ;NO, STRETCH GAP. + MOVE BP,PT + ADDM C,PT ;UPDATE VARS FOR INSERTION OF THOSE CHARS. + ADDM C,GPT + MOVNS C ;DELETE - CHARS TO UPDATE Z, ZV, EXTRAC. + CALL DELETB ;DELETB NEGATES C. + SOJA BP,GETBP ;MAKE REMEMBERED PT (IN BP) INTO BP. + +;MAKE SURE UNUSED SPACE AFTER IMPURE STRING SPACE AT LEAST C(C) CHARS. +;MAY MOVE BUFFER, IN WHICH CASE ALL BUFFER POINTERS WILL +;BE UPDATED AS NECESSARY. +SLPQGT: ADD C,QRWRT ;CHAR ADDR LAST CHAR WE'LL NEED. + SUB C,BFRBOT ;THAT CHAR IN BUFFER? + JUMPL C,CPOPJ ;NO, HVE ENOUGH ROOM. + +;GET AT LEAST C(C) MORE UNUSED SPACE FOR IMPURE STRINGS. +;WILL MOVE BUFFER AND UPDATE ALL BUFFER POINTERS. +SLPQRG: CALL SAVACS + MOVE BP,BFRBOT ;MOVE ENTIRE BUFFER. + MOVE TT,BFRTOP ;GET REAL ADDR. END OF BUFFER. + ADDI C,SLPQAM-1 + IDIVI C,SLPQAM ;# OF UNIT INCREMENTS WE NEED. + IMULI C,SLPQWR ;# OF WDS TO MOVE THE BUFFER. + CALL SLPN0Q ;MOVE IT. + MOVE BP,BFRBOT + IDIVI BP,5 +SLPQR1: SETZM (BP) ;CLEAR ALL WORDS OF SPACE JUST MADE. + AOJ BP, ;NOTE THAT BFRBOT HAS NOT BEEN RELOCATED YET, SO IT POINTS AT + SOJG C,SLPQR1 ;THE BOTTOM OF THE SPACE JUST MADE. + MOVE T,E + CALL BFRMOV ;RELOCATE ALL PTRS TO BUFFER. + JRST RSTACS + +;WRITE A STRING HEADER. B HAS INITIAL CHARACTER (QRSTR OR QRBFR), +;C HAS CONTENTS (LENGTH OR BUFFER FRAME ADDRESS). +;BP IS LEFT WITH A B.P. TO LAST CHAR. OF HEADER. +;CLOBBERS C,T,TT. +QHDRW1: MOVE BP,QRWRT ;WRITE HEADER IN FIRST FREE SPOT. +QHDRW0: CALL GETBP ;ASSUME BP HAS CHAR ADDR OF PLACE TO WRITE. + DPB B,BP + IDPB C,BP + LSH C,-7 + IDPB C,BP + LSH C,-7 + IDPB C,BP + RET + +QCLOSV: CALL GETCA ;WHERE DID WE STOP IDPB'ING? + AOS BP + MOVE C,BP + MOVE BP,QRWRT ;BP GETS PLACE TO WRITE HEADER. + MOVE OUT,C ;OUT GETS NEW VALUE FOR QRWRT. + SUB C,BP ;C GETS LENGTH OF WHAT WE JUST WROTE (INCL HEADER) + MOVEI B,QRSTR + CALL QHDRW0 ;WRITE THE HEADER + MOVEI CH,A ;TELL QCLOSE TO STORE INTO A, + SETZ B, ;WHICH IS NOT A NAMED VARIABLE. + JRST QCLOSE + +;MAKE SURE THERE IS SPACE IN IMPURE STRING SPACE FOR C(C) CHARS, +;THEN SET UP LISTF5 TO IDPB THRU BP INTO IMPURE STRING SPACE. +QOPEN: SAVE C + ADDI C,4 ;HEADER OF STRING NEDS SPACE TOO. + CALL SLPQGT ;MAKE SURE EXISTS ENOUGH SPACE. + REST C + MOVE BP,QRWRT ;START WRITING INTO UNUSED IMPURE STRING SPACE + ADDI BP,4 ;SKIPPING ROOM FOR THE NEW STRING'S HEADER-TO-BE. + CALL GETIBP + MOVEI A,[IDPB CH,BP ? RET] + HRRM A,LISTF5 + POPJ P, + +;ASSUME A STRING HAS BEEN STORED IN THE AREA ABOVE QRWRT, +;UPDATE QRWRT AND STORE STRING PTR IN QREG. +QCLOSQ: TDZA B,B ;QREG ADDR IN CH, AND CERTAINLY NOT A NAMED VARIABLE. +QCLOSP: REST CH ;QREG ADDR IS ON STACK. B IS AS RETURNED BY QREGX. +QCLOSE: EXCH OUT,QRWRT ;QREG ADDR IN CH. B IS AS RETURNED BY QREGX. + SUB OUT,QRBUF + TLO OUT,400000 + MOVE C,OUT + JRST USE2 ;STORE VALUE IN QREG, WITH ERROR CHECKING ETC. + +;CLOSE UP THE GAP, AND SAY IT IS AT PT. +SLPSHT: SKIPN EXTRAC ;NOTHING TO DO IF NO GAP. + JRST GAPSLN + SAVE Q +SLPSH1: MOVE Q,Z + CAMN Q,GPT + JRST SLPSH2 + EXCH Q,PT + SAVE Q + CALL GAPSLP ;THEN MOVE THE GAP TO PT. + REST PT +SLPSH2: REST Q + CALL GAPKIL ;NOW GAP IS AT END, JUST FORGET ABOUT IT. +GAPSLN: SAVE PT ;GAP LENGTH IS 0, MAKES NO DIFFERENCE WHERE + REST GPT ;WE SAY THE GAP IS LOCATED. + RET + +;ASSUMING THAT THE GAP IS AT THE END OF THE CURRENT BUFFER, +;CLOSE IT UP. CLOBBERS NO ACS. RELOCATES ALL NECESSARY POINTERS +;IN BUFFER FRAMES (AND BFRTOP). +GAPKIL: SAVE A + SAVE C + SAVE B + MOVE A,Z + ADD A,EXTRAC + IDIVI A,5 ;WHAT WORD DOES THE THING AFTER THE BUFFER + MOVE C,A ;ACTUALLY START IN? + IMULI A,5 + ADDI A,5 + CAML A,BFRTOP ;IF THERE'S NOTHING AFTER THE BUFFER, JUST CHANGE A FEW POINTERS + JRST [ MOVE A,Z ;IN PARTICULAR BFRTOP POINTED AFTER GAP, + IDIVI A,5 + IMULI A,5 ;MAKE IT -> CHAR ADDR OF WORD BNDRY + ADDI A,5 ;AFTER THE END OF THE BUFFER. + MOVEM A,BFRTOP + JRST GAPKI1] + SAVE C ;THERE'S ANOTHER BUFFER AFTER THIS ONE. + MOVE A,Z + IDIVI A,5 ;WHAT WORD SHOULD IT START IN (ACTUALLY 1 LESS THAN) + HRL A,(P) ;AND -1+ + HRRZ C,A + SUB C,(P) ;C HAS - + ADD A,[1,,1] ;,, + MOVEM A,(P) + SAVE C + MOVE A,BFRTOP + IDIVI A,5 ;WORD FOR BLT TO STOP MOVING OUT OF (PLUS 1) + REST C + ADDI A,-1(C) + EXCH C,(P) + BLT C,(A) + EXCH T,(P) ;GET # WORDS THINGS MOVED BY. + IMULI T,5 + SAVE TT + MOVE TT,Z + ADD TT,EXTRAC + CALL BFRRLC ;RELOCATE PTRS TO BUFFERS WE MOVED. + REST TT + REST T +GAPKI1: SETZM EXTRAC +POPBCA: REST B +POPCAJ: REST C + REST A + RET + +;MOVE THE GAP TO PT. +GAPSLP: SKIPE READON ;ALLOWED TO MODIFY? + TYPRE [RDO] + SETOM MODIFF ;IF WE CARE WHERE GAP IS, WE MUST BE ABOUT TO MUNG THE BUFFER. +GAPSL0: SKIPN EXTRAC ;NO GAP REALLY => + JRST GAPSLN ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER. + SAVE Q + MOVE Q,PT + CAMN Q,GPT ;GAP ALREADY AT PT => NOTHING TO DO. + JRST POPQJ + CAMG Q,GPT ;MOVING GAP DOWN => DIFFERENT. + JRST GAPDN + REST Q + CALL SAVACS +GAPUP3: MOVE BP,GPT ;MOVE 1ST FEW CHARS 1 AT A TIME. + CAMN BP,PT ;(WHEN GET HERE 2ND TIME, + JRST RSTACS ;MIGHT BE NOTHING TO MOVE) + ADD BP,EXTRAC ;GET FETCHING PTR -> ABOVE GAP. + CALL GETIBP + MOVE TT,GPT + IDIVI TT,5 ;GET STORING PTR -> BELOW GAP. + MOVE A,PT + SUB A,GPT ;GET TOTAL # CHARS TO BE MOVED. + JUMPE TT1,[SOJA TT,GAPUP2] +GAPUP0: SUBI TT1,5 ;(WILL INCREM. TO 0 WHEN REACH WD BNDRY) +GAPUP1: ILDB IN,BP ;GET A CHAR FROM ABOVE GAP, + DPB IN,BTAB+5(TT1) ;PUT IT BELOW GAP, + AOS GPT ;SAY GAP HAS MOVED UP 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + AOJN TT1,GAPUP1 ;EFFECTIVELY IBP THE STORING PTR. +GAPUP2: CAIGE A,5 ;BOTTOM OF GAP NOW ON WD BNDRY, + AOJA TT,GAPUP0 ;< 1 WDS LEFT => KEEP GOING CHAR BY CHAR. + MOVEI C,1(TT) ;GET ADDR 1ST WD TO MOVE DOWN INTO. + MOVE 10,PT + ADD 10,EXTRAC ;REAL ADDR 1ST CHAR NOT TO MOVE DOWN. + SUBI 10,5 ;DON'T MOVE THE LAST 5 CHARS WITH FAST LOOP (CAN GARBAGE). + IDIVI 10,5 ;10 -> HIGHEST WD TO MOVE DOWN FROM. NOTE 10 = T. + MOVN 12,EXTRAC + IDIVI 12,5 ;12 GETS <# WDS OF GAP, ROUNDED UP>. 13 <- # CHARS ROUNDED BY. + JUMPE 13,[ ;HERE IF CAN USE BLT (ALL ON WORD BNDRYS). + ADD 10,12 ;10 GETS ADDR OF LAST WD TO MOVE DOWN TO. + SUBM C,12 ;12 GETS 1ST ADDR TO MOVE FROM. + MOVEI 11,1(10) + SUB 11,C ;11 GETS # OF WORDS TO MOVE. + IMULI 11,5 + ADDM 11,GPT ;UPDATE GPT FOR WHAT WE'RE DOING HERE. + HRLI C,(12) + BLT C,(10) + JRST GAPUP3] + ADDI 12,-1(10) ;12 -> HIGHEST WD TO MOVE DOWN INTO. + MOVNM 13,11 + IMULI 11,7 + MOVNI 14,-43(11) + SUBI C,1(12) ;C HAS MINUS # WDS TO MOVE + JUMPE C,[AOS TT,12 ;WOULD MOVE 0 WORDS (CAN HAPPEN) => DO REST BY CHARS. + SETZ TT1, + JRST GAPUP0] + MOVN 15,C ;UPDATE GPT FOR THE WDS WE'RE MOVING. + IMULI 15,5 + ADDM 15,GPT + MOVE 13,12 + HRLI 10,(MOVE B,(C)) + HRLI 11,(LSHC A,) + MOVE 12,[LSH A,1] + HRLI 13,(MOVEM A,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPUP3] + MOVE A,@10 + ROT A,-1 + MOVE 15,.+1 + AOJLE C,10 + +;MOVE THE GAP DOWN (IE MOVE CHARS FROM PT TO GPT UP) +GAPDN: MOVE Q,PT + ADD Q,PT + ADD Q,PT + ADD Q,Z ;COMPUTE WEIGHTED AVERAGE OF PT AND Z, THEN COMPARE WITH GPT + LSH Q,-2 + CAMG Q,GPT ;IS GPT CLOSER TO PT, OR TO Z? + CALL [ SAVE PT ;GPT IS MUCH CLOSER TO Z THAN TO POINT. SO FASTEST THING + MOVE Q,Z ;IS TO MOVE GAP TO Z, ADJUST WITH GAPADJ, AND + MOVEM Q,PT ;MOVE IT DOWN AGAIN USING A POP-LOOP. + CALL GAPSLP + REST PT + RET] + REST Q ;GPT CLOSER TO PT; FASTER TO MOVE GAP DIRECTLY TO POINT. + CALL SAVACS + MOVE BP,GPT + CAMN BP,Z ;IF GAP IS AT END OF BUFFER, WE CAN ADJUST ITS SIZE A LITTLE + CALL GAPADJ ;AND THEREBY ENABLE WHAT FOLLOWS TO USE A BLT. +GAPDN3: MOVE BP,GPT ;MOVE THE 1ST FEW CHARS UP, + CAMN BP,PT ;(FOR GETTING HERE 2ND TIME WITH + JRST RSTACS ;TO BE MOVED) + CALL GETBP ;GET PTR FOR FETCHING CHARS BELOW GAP, + MOVE TT,GPT + ADD TT,EXTRAC ;GET PTR FOR STORING ABOVE GAP. + IDIVI TT,5 + MOVE A,GPT ;GET TOTAL # CHARS MUST MOVE UP. + SUB A,PT + SOJL TT1,GAPDN2 ;ALREADY MOVING TO WD BNDRY. +GAPDN1: DBP7 BP ;GET PTR -> LAST CHAR BELOW GAP. + LDB CH,BP + DPB CH,BTAB(TT1) ;MOVE IT BELOW TOP OF GAP. + SOS GPT ;GAP HAS MOVED DOWN 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + SOJGE TT1,GAPDN1 ;EFFECTIVELY DBP7 THE OUTPUT BP. +GAPDN2: CAIGE A,5 ;TOP OF GAP NOW ON WD BNDRY +GAPDN5: SOJA TT,[ADDI TT1,5 ;< 1 WD LEFT, KEEP + JRST GAPDN1] ;CHAR AT A TIME. + MOVE 13,EXTRAC ;MOVE AS MUCH AS CAN, WD AT A TIME. + IDIVI 13,5 + IMULI 14,7 + MOVN 11,14 + MOVEI 14,-43(14) + MOVE B,PT + ADDI B,4 + IDIVI B,5 + MOVE 15,GPT + IDIVI 15,5 + MOVEI C,(15) + SUB C,B + JUMPE C,[MOVE TT,GPT ;IF CAN'T MOVE ANYTHING WORD-WISE AFTER ALL, + ADD TT,EXTRAC ;REENTER CHAR-AT-A-TIME LOOP + IDIVI TT,5 + SOJA TT1,GAPDN5] + MOVE 7,B + MOVN 15,C ;MAKE GPT REFLECT THE MOTION OF GAP + IMULI 15,5 ;THAT IS NOW ABOUT TO BE DONE. + ADDM 15,GPT + JUMPE 11,GAPDN4 ;(TRANSLATING BY INTEGRAL # OF WDS.) + ADDI 13,1(7) + HRLI 7,(MOVE A,(C)) + HRLOI 10,(LSH A,) + HRLI 11,(LSHC A,) + MOVE 12,[ANDCMI B,1] + HRLI 13,(MOVEM B,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPDN3] + MOVE B,@7 + MOVE 15,.+1 + SOJGE C,7 + +GAPDN4: HRLI 13,(POP 7,(7)) ;EXTRAC = 0 MOD 5, NEED NOT ROTATE + ADDI 7,-1(C) ;-> HIGHEST WD TO MOVE FROM + HRLI 7,-1 ;PREVENT PDL OV. + MOVE 15,[JRST GAPDN3] ;INSN THAT EXITS LOOP. + MOVE 14,.+1 + SOJGE C,13 ;C HAS # WDS TO MOVE. + +;WHEN THE GAP IS AT Z, WE CAN ADJUST ITS SIZE WITHIN A RANGE OF 5 WITHOUT MOVING ANYTHING. +;IF WE WANT TO MOVE THE GAP DOWN, ADJUSTING ITS SIZE TO A MULTIPLE OF 5 +;WILL ENABLE US TO USE A POP-LOOP INSTEAD OF A SLOWER LOOP. + +GAPADJ: MOVE A,Z + IDIVI A,5 ;IF EXTRAC IS A MULTPLE OF 5, REAL Z (Z+EXTRAC) MOD 5 IS THIS REMAINDER + MOVE IN,Z + ADD IN,EXTRAC ;SO GET REAL Z + IDIVI IN,5 + IMULI IN,5 ;AND ADJUST IT TO EQUAL THAT, MOD 5, + ADD IN,B ;WITHOUT CHANGING WHICH WORD IT POINTS AT. + SUB IN,Z ;BUT Z CAN'T CHANGE, SO THE CHANGE IN REAL Z + MOVEM IN,EXTRAC ;MUST ALL BE DUE TO CHANGE IN EXTRAC. + RET + +SUBTTL STRING SPACE GARBAGE COLLECTION + +GCNRL: SETOM GCNRLC ;GC TO RECLAIM MACRO FRAMES. DON'T MOVE IMPURE STRINGS. + CAIA ;(THEREFORE, CAN BE CALLED IN MID-COMMAND) +GC: +GCC: SETZM GCNRLC + CALL SAVACS +IFN ITS,[ + MOVE A,[-2,,[.SWHO1,,[.BYTE 2,3,3 ? 1 ? 6 ? 6] + .SWHO2,,[SIXBIT/QR GC/]]] + .SUSET A +] + CALL MEMTOP ;A -> 1ST UNUSED WORD ABOVE BFR & SORT TABLES. + HRLI A,4400 + MOVEM A,GCPTR ;GCPTR HAS B.P. TO IDPB INTO HIGH CORE. + PUSH P,A ;REMEMBER WHAT ITS STARTING VALUE WAS. + MOVE C,BFRPTR ;COPY BEG, ETC. INTO CURRENT BUFFER'S + CALL NEWBFR ;FRAME, SO THE LATTER IS UP TO DATE. + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 ;CLEAR THE JUMP CACHE, SINCE IT WILL NOW BECOME INVALID. + MOVEI T,CSTR ;MARK CSTR + PUSHJ P,GCMA +GCC1: MOVEI T,MFSTRT+MFCSTR ;MARK ALL MACRO FRAMES' STRINGS. +GCC2: SKIPGE MFBEG-MFCSTR(T) ;DON'T MARK BUFFER FRAMES THIS WAY. + JRST GCC4 + ADDI T,MFARG1-MFCSTR + CALL GCM ;MARK MACRO ARG 1 (MAY BE A STRING POINTER) + ADDI T,MFARG2-MFARG1 + CALL GCM ;MARK MACRO ARG 2 + SUBI T,MFARG2-MFCSTR ;POINT TO CSTR AGAIN + SKIPE (T) + PUSHJ P,GCMA +GCC4: ADDI T,MFBLEN + CAMGE T,MFEND + JRST GCC2 +GCC3: HRRZ T,PF ;MARK THE QREG PDL. + CAIL T,PFL ;MARK BOTH VALUES AND ADDRS, SINCE "ADDR" MIGHT BE A NAME-STRING. +GCC5: CALL GCM + CAILE T,PFL + SOJA T,GCC5 + HRRZ T,LEV ;NOW MARK ALL SAVED VALUES +GCC7: SKIPN A,T ;OF ALL PAREN'S. + JRST GCC8 ;WE'VE REACHED THE OUTERMOST; WE'RE DONE. + SUBI T,2 ;GET ADDR OF LAST SAVED VALUE. + CALL GCM + SUBI T,1 ;GET ADDR OF 1ST (IF THERE ARE 2) + MOVE TT,2(T) ;GET THE WORD WHICH SAYS HOW MANY. + TRNE TT,FRARG2 ;IF THERE ARE 2, MARK THE 1ST. + CALL GCM + MOVE T,(A) ;NOW HANDLE NEXT PAREN OUT. + JRST GCC7 + +GCC8: MOVE T,[-NQREG,,QTAB] + CALL GCM + AOBJN T,.-1 + MOVE T,[-RRMACL,,RRMACT] + CALL GCM + AOBJN T,.-1 +IRPS XX,,DISOMD SBFRS BFRSTR MARG1 MARG2 SARG NUM SYL RRXINV RRENTM RRLEVM RRDISM REFRSH LASTER STEPFL HELPMAC ECHCHR CLKMAC TYISNK TYISRC RREBUF MODMAC + MOVEI T,XX + CALL GCM +TERMIN + POP P,A + MOVE T,A ;STARTING GCPTR MINUS CURRENT + SUB T,GCPTR ;GIVES -<# WDS IDPB'D> + HRLM T,A ;AOBJN -> TABLE OF POINTERS. + ADDI A,1 + MOVEM A,GCPTR + JUMPGE A,GCE ;NO ENTRIES => NO IMPURE STRINGS TO GC. + SKIPE GCNRLC ;IF SHOULDN'T MOVE IMPURE STRINGS, SKIP THAT PART. + JRST GCE5 + CALL GCSORT ;ELSE SORT GCTAB INTO ORDER STRINGS APPEAR IN MEMORY. + CALL GCSWP ;COMPRESS STRING SPACE, USING GCPTR TABLE TO RELOCATE POINTERS. + MOVE IN,OUT + IMULI IN,5 ;COMPUTE WHERE IMPURE STRING SPACE NOW ENDS. + JRST GCE1 ;GO FLUSH EXCESS PAGES, MAYBE MOVING BUFFER SPACE DOWNWARD. + +;MARK THE TECO OBJECT POINTER IN THE WORD WHICH RH(T) POINTS AT. +;IF THE OBJECT IS A POINTER, WE PUSH AN ENTRY ONTO GCPTR. +GCM: MOVE IN,(T) + TLZE IN,400000 ;RETURN IF NOT A STRING POINTER OR IF POINTS AT THE ERROR MESSAGES. + CAIGE IN,EREND*5-INIQRB + RET ;NO NEED TO MARK BUILT-IN ERROR MESSAGES SINCE NOT SWEPT. + ADD IN,QRBUF +GCM3: CAML IN,QRBUF + CAML IN,QRWRT ;FINISH CHECKING THAT IT REALLY POINTS INTO IMPURE STRING SPACE. + RET + CALL GETCHR ;DOES IT POINT AT A 177 OR 176? + CAIN CH,QRBFR + JRST GCMB ;176 => THIS IS A BUFFER. + CAIE CH,QRSTR ;177 => THIS IS A STRING. + RET ;ANYTHING ELSE => THIS IS NEITHER. DON'T MARK IT. + +;PUSH A GCPTR ENTRY FOR POINTER LOCATION RH(T) AND STRING ADDRESS C(IN). +GCM2: IDPB IN,GCPTR + IDPB T,GCPTR + POPJ P, + +;FOUND A POINTER TO A BUFFER. +GCMB: MOVE BP,IN + CALL GCM2 ;MARK THE 4-CHAR STRING THAT WE GO INDIRECT THROUGH, + CALL GETBP ;GO INDIRECT THROUGH IT TO GET FRAME ADDRESS + CALL QLGET4 ;RETURNS -4 + JUMPL B,CPOPJ ;DEAD BUFFER HAS NO BUFFER FRAME. + MOVSI IN,MFMARK ;AND MARK THE BUFFER FRAME AS LIVING. + IOR IN,4(B) + EXCH IN,4(B) + TLNN IN,MFMARK ;IF THE FRAME WASN'T ALREADY MARKED, + TLNN IN,MFQVEC ;AND MUST BE MARKED THROUGH, DO SO. + RET + SAVE T + MOVE T,MFBEG+4(B) + TLZ T,MFBBTS + IDIVI T,5 ;FIRST, MARK BELOW THE GAP. + MOVE TT,MFGPT+4(B) + CALL GCMBR + MOVE T,MFGPT+4(B) + ADD T,MFEXTR+4(B) + IDIVI T,5 ;THEN MARK ABOVE GAP (GPT+EXTRAC TO Z+EXTRAC) + MOVE TT,MFZ+4(B) + ADD TT,MFEXTR+4(B) + CALL GCMBR +POPTJ: REST T + RET + +;MARK INDIRECT THROUGH A RANGE OF WORDS (IN A QVECTOR). +GCMBR: SAVE B ;T HAS WORD ADDR, TT CHAR ADDR. + IDIVI TT,5 ;MARK ALL TEH WORDS FROM T TO TT. + SUBM T,TT + HRL T,TT + SKIPGE T + CALL GCM + AOBJN T,.-1 + REST B + RET + +;HERE TO MARK A BYTE POINTER, SUCH AS CPTR. T POINTS AT THE CSTR WORD OF A +;COMCNT, CPTR, CSTR TRIPLE. IF THE POINTER POINTS INTO IMPURE STRING SPACE, +;WE PUSH A GCPTR ENTRY POINTING AT THE CPTR WORD BUT GIVING THE CHAR ADDR EQUIVALENT +;AS ITS STRING ADDRESS. +GCMA: SAVE GCPTR + CALL GCM ;MARK THE CSTR WORD, AS AN ORDINARY TECO OBJECT. + REST TT + CAMN TT,GCPTR ;IF IT DOESN'T NEED RELOCATION, NEITHER DOES CPTR. + RET + MOVE IN,1(TT) ;IF CSTR NEEDS IT, SO DOES CPTR; PUSH A MARKER FOR CPTR + IDPB IN,GCPTR ;GIVING THE SAME "CHAR ADDR TO RELOCATE ACCORDING TO" + MOVEI IN,CPTR-CSTR(T) + IDPB IN,GCPTR ;WHICH THE CSTR USED, BUT POINTING AT THE CPTR INSTEAD OF THE CSTR. + RET + +;SORT THE POINTER TABLE TO FACILITATE SWEEPING. +;THE POINTERS GO IN THE SAME ORDER AS THE STRINGS THEY POINT AT. +GCSORT: HRRZ A,GCPTR + HLRE B,GCPTR + SUBM A,B + MOVSI C,10 + +;RECURSIVE RADIX-EXCHANGE SORT. +;A POINTS TO FIRST ENTRY IN THIS SUB-SORT. +;B POINTS TO LAST ENTRY + 1 +;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON FOR THIS SUB-SORT. +GCSWPS==2 ;2 WORDS PER TABLE ENTRY. + +GCSRT: HRLM B,(P) ;SAVE UPPER BOUND + CAIL A,-GCSWPS(B) + JRST GCSRT7 ;ONE OR ZERO ENTRIES + PUSH P,A ;SAVE LOWER BOUND +GCSRT3: TDNN C,(A) ;BIT SET IN LOWER ENTRY? + JRST GCSRT4 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN + SUBI B,GCSWPS ;YES, NOW BACK UP UPPER POINT + TDNE C,(B) ;BIT CLEAR IN UPPER ENTRY? + JRST GCSRT5 ;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN +REPEAT GCSWPS,[ ;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES + MOVE D,.RPCNT(A) + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A) +] +GCSRT4: ADDI A,GCSWPS ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY +GCSRT5: CAME A,B ;ANY MORE ENTRIES LEFT? + JRST GCSRT3 ;YES, GO PROCESS THEM + ;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET + ROT C,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT + POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT + JUMPL C,GCSRT6 ;JUMP IF NO MORE KEY TO SORT ON + PUSHJ P,GCSRT ;SORT BOTTOM PART OF TABLE + HLRZ B,(P) ;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE) + PUSHJ P,GCSRT ;SORT TOP PART OF TABLE +GCSRT6: ROT C,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C" +GCSRT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED + RET + +;SWEEP THE IMPURE STRING SPACE, DISCARDING GARBAGE BY MOVING THE GOOD STUFF DOWN. +GCSWP: MOVE IN,QRBUF + ADDI IN,EREND*5-INIQRB + IDIVI IN,5 ;IN GETS PLACE WE EXPECT NEXT OLD STRING (GARBAGE OR NOT) TO START. + MOVE OUT,IN ;OUT GETS PLACE TO PUT NEXT NON-GARBAGE STRING. + MOVE Q,GCPTR ;Q IS USED TO STEP THROUGH THE POINTER TABLE. + SETZ BP, ;THERE IS NO PENDING BLT, YET. +;WHEN BP IS NONZERO, IT IS THE AC FOR A PENDING BLT. WHEN WE SEE A NON-GARBAGE STRING, +;WE KNOW IT NEEDS TO BE BLT'ED (USUALLY), BUT WE DON'T DO THE BLT UNTIL WE COME +;TO SOME ACTUAL GARBAGE. THAT WAY WE BLT CONTIGUOUS NON-GARBAGE STRINGS TOGETHER. +;INSTEAD OF BLT'ING, WE SET UP BP AS THE BLT AC (OLD START,,NEW START) AS A REMINDER. + +;COME HERE TO EXAMINE THE NEXT POINTER AND SEE WHETHER WE HAVE FOUND A GAP OF GARBAGE. +GCSWPL: JUMPGE Q,GCBLT ;NO MORE POINTERS => FINISHED SWEEPING. DO ANY PENDING BLT. + MOVE A,(Q) ;WHERE DOES THE NEXT NON-GARBAGE STRING START? + IDIVI A,5 + JUMPE BP,GCSWP2 + CAMG A,IN ;STARTS IN THE EXPECTED PLACE => IT IS CONTIGUOUS WITH + JRST GCSWP1 ;PREVIOUS NON-GARBAGE, SO DON'T BLT NOW. + CALL GCBLT ;NOT CONTIGUOUS => BETTER BLT THE OLD STUFF. +;HERE FOR THE BEGINNING OF A CONTIGUOUS RUN OF NON-GARBAGE; SET BP NONZERO +GCSWP2: MOVE IN,A + HRRZ BP,OUT ;AND MAKE BP DESCRIBE HOW THIS STUFF WILL HAVE TO BE BLT'ED. + HRL BP,A +GCSWP1: SAVE BP ;NOW FIND OUT WHERE THIS STRING ENDS. + SETZ B, ;B GETS (EVENTUALLY) LENGTH OF STRING-OBJECT + MOVE BP,(Q) + CALL GETBP ;WHICH IS IT? A BUFFER OR A STRING? + LDB CH,BP + CAIN CH,QRBFR ;IF IT'S A BUFFER, THERE'S REALLY JUST A 4-CHAR HEADER HERE. + JRST GCSWP3 + CAIE CH,QRSTR ;IF IT'S A STRING, THERE'S THE HEADER PLUS DATA. + .VALUE + CALL QLGET4 ;HOW MUCH DATA? +GCSWP3: ADDI B,3 ;B GETS LENGTH OF HEADER + (DATA IF ANY) - 1. + MOVE BP,(Q) + ADDB BP,B ;BOTH B AND BP HAVE CHAR ADDR OF LAST CHAR. + CALL GETBP ;BP GETS BP TO LDB LAST CHAR. + MOVEI A,1(BP) ;A GETS ADDR OF WORD AFTER THE END OF THIS STRING. + REST BP + SUB A,IN ;NOW INCREASE IN TO EQUAL THAT, AND INCREASE OUT THE SAME AMOUNT. + ADD IN,A ;NEW VALUE OF IN IS WHERE THE NEXT STRING SHOULD START IF IT IS CONTIG. + ADD OUT,A ;ACTUALLY, IT CAN START IN THE PREVIOUS WORD IF IT IS REALLY CONTIG. + ;THE CAMG ABOVE WILL NOT SKIP IN EITHER CASE. +;NOW RELOCATE ALL THE POINTERS INTO THIS STRING. +;B IS CHAR ADDR REL QRBUF OF LAST CHAR OF STRING. +;ALL POINTERS LESS THAN OR EQUAL TO THAT POINT INTO THIS STRING. + MOVE C,OUT + SUB C,IN ;C GETS # OF WORDS (NEGATIVE ALWAYS) THIS STRING IS MOVING BY. + MOVE D,C + IMULI D,5 ;D GETS # OF CHARACTERS. +GCSWPR: CAMGE B,(Q) ;AFTER THE LAST POINTER INTO THIS STRING, + JRST GCSWPL ;GO EXAMINE THE NEXT AND MAYBE BLT THIS ONE, ETC. + MOVE A,1(Q) + SKIPL (A) ;ELSE RELOCATE. RELOCATE POSITIVE QTYS (B.P.S) BY WORDS, + ADDM C,(A) + SKIPGE (A) ;RELOCATE NEGATIVE ONES (TECO OBJECTS) BY CHARS. + ADDM D,(A) + AOBJN Q,.+1 + AOBJN Q,GCSWPR ;LOOK AT ALL PTRS. IF RUN OUT, DO ANY PENDING BLT AND WE'RE DONE. + +;DO THE PENDING BLT DESCRIBED BY BP. OUT, THE PLACE TO START THE NEXT GOOD STRING, +;TELLS US WHERE THE BLT SHOULD STOP. +GCBLT: JUMPE BP,CPOPJ + CAIN OUT,(BP) + .VALUE + MOVS C,BP + CAME C,BP ;DON'T DO THE BLT IF IT IS SHIFTING BY 0 WORDS. + BLT BP,-1(OUT) + SETZ BP, + RET + +GCE5: SKIPA IN,QRWRT +GCE: MOVE IN,QRBUF +GCE1: MOVE CH,IN ;GC AGAIN AFTER GCOFTN CHARS + ADDI CH,GCOFTN ;OF IMPURE STRING ARE CREATED. + SKIPL GCNRLC + MOVEM CH,QRGCMX + MOVE A,QRWRT ;REMEMBER OLD TOP OF IMPURE STRING SPACE FOR SAKE OF LOW BIT CLEARING. + CAMGE A,IN ;GC PRODUCED NEGATIVE FREE SPACE? + .VALUE + MOVEM IN,QRWRT ;CHAR ADDR ABOVE END OF STRING SPACE. + ADDI IN,SLPQAM*2 ;LEAVE 2*SLPQAM CHARS SPACE TO WRITE MORE STRINGS INTO, + MOVE CH,IN + ADDI CH,SLPQAM + CAML CH,BFRBOT ;AND IF BUFFER SPACE STARTS AT LEAST SLPQAM ABOVE THAT POINT, + MOVE IN,BFRBOT ;MOVE IT DOWN TO THAT POINT. ELSE DON'T MOVE IT. + IDIVI IN,5 +IFN ITS,[ + MOVE CH,QRWRT + ADDI CH,2000*5-1 ;COMPUTE 1ST PAGE IMPURE STRINGS DON'T NEED. + IDIVI CH,2000*5 + LDB Q,[121000,,IN] ;AND 1ST PAGE BUFFER NEEDS. + SUBM CH,Q ;-<# PAGES WE CAN FLUSH> + JUMPE Q,GCE2 + SKIPL Q + .VALUE + SAVE CH + HRLI CH,(Q) ;AOBJN -> PAGES TO FLUSH. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? CH] + .LOSE %LSSYS + REST CH + IMULI CH,2000*5 + CAML A,CH ;BETTER NOT CLEAR LOW BITS IN THE PAGES WE JUST FLUSHED. + MOVE A,CH +GCE2: +] + SAVE A + MOVEI A,MFSTRT ;LOOK AT ALL BUFFER FRAMES, +GCE3: MOVE T,MFBEG(A) ;AND RELEASE ALL THE DEAD ONES. + TLNN T,MFBFR + JRST GCE4 ;THIS IS A MACRO CALL, NOT A BUFFER. + TLZN T,MFMARK + JRST [ CALL KILBFR ;THIS ONE IS DEAD. + JRST GCE4] + MOVEM T,MFBEG(A) ;CLEAR THE MARK-BIT. +GCE4: ADDI A,MFBLEN + CAMGE A,MFEND + JRST GCE3 + REST A + IDIVI A,5 + CAML A,IN ;DON'T CLEAR LOW BITS IN CORE THAT BUFFERS WILL OCCUPY. + MOVE A,IN + MOVE T,QRWRT ;NOW, CLEAR LOW BITS BY CLEARING ALL OF THE EXISTING + ADDI T,4 ;CORE FROM THE TOP OF THE OCCUPIED PORTION OF + IDIVI T,5 ;IMPURE STRING SPACE UP TO BUFFER SPACE. + CAMG A,T + JRST GCE7 + MOVE C,[SIXBIT /LBCLR/] + MOVEM C,(T) ;STORE THIS RECOGNIZABLE CONSTANT TO CLEAR THE LOW BIT + HRLI T,T ;(FOR SAKE OF DEBUGGING). + ADDI T,1 + CAIL A,1(T) + BLT T,-1(A) +GCE7: MOVE T,BFRBOT ;C(IN) IS THE PLACE BUFFER SPACE + IDIVI T,5 ;SHOULD START; MOVE IT DOWN IF NEC. + CAMG T,IN + JRST GCE6 + SUBM IN,T + HRLS IN + SUB IN,T + MOVSS IN + MOVE C,BFRTOP + IDIVI C,5 + ADDI C,(T) + BLT IN,(C) + CALL BFRMVW +GCE6: CALL FLSCOR +IFN ITS,.SUSET [.SWHO1,,[0]] + JRST RSTACS + +;PUSHJ HERE, AND IT RETURNS WITH ACS 0-16 SAVED. +IFN P-17,.ERR PDL POINTER NOT AC17 +.SEE CIRC ;THIS DEPENDS ON THE ORDER OF THE AC'S +SAVACS: ADD P,[16,,16] ;MAKE ROOM ON STACK FOR 1 THRU 16. + MOVEM 1,-15(P) ;SAVE 1 + MOVEI 1,-14(P) + HRLI 1,2 + BLT 1,(P) ;USE 1 TO SAVE THE REST + MOVE 1,-15(P) ;RESTORE 1. + SKIPL P + TYPRE [PDL] + SAVE -16(P) ;PUT RETURN PC ON TOP OF STACK, + MOVEM 0,-17(P) ;SAVE AC 0 IN ITS PLACE, + RET + +;JRST RSTACS TO UNDO A SAVACS, THEN POPJ OUT OF THE ROUTINE THAT CALLED THE SAVACS. +RSTACS: MOVSI 16,-16(P) ;GET START OF WHERE THEY ARE + HRRI 16,0 + BLT 16,16 ;RESTORE THE REST + SUB P,[17,,17] + RET + +RST321: REST C ;JSP A,RST321 TO POP ACS 3 2 AND 1 OFF THE STACK + REST B + EXCH A,(P) + RET + +SUBTTL BUFFER SELECTION, CREATION AND KILLING + +;A -> BUFFER FRAME; FREE THE FRAME AND THE SPACE IT POINTS TO. +;CLOBBERS C,E,T,TT. +KILBFR: MOVSI C,MFREADO + ANDCAM C,(A) ;MAKE READ-ONLY BUFFER WRITEABLE SO WE DON'T GET ERROR EMPTYING IT. + MOVEI C,(A) + SAVE BFRPTR + CALL NEWBFR ;SELECT THAT BUFFER FRAME AS CURRENT. + MOVE C,Z + MOVE E,BEG + CALL DELET1 ;DELETE ALL THE TEXT IN IT. + MOVEI C,5 ;FAKE GAPKIL INTO CLOSING UP THE 1-WORD INTER-BUFFER + ADDM C,EXTRAC ;GAP, AS WELL AS THE ACTUAL SPACE OCCUPIED BY THIS BFR. + MOVNI C,5 + ADDM C,Z + CALL GAPKIL ;FLUSH ALL SPACE IN BUFFER AREA USED BY THIS BUFFER. + SETZM MFBEG(A) ;FREE THE BUFFER FRAME BY CLEARING MFBFR BIT + SAVE A + SOJ A, + CALL FLSFRM ;AND PUTTING ON FREELIST (WHOSE POINTERS -> FRAME-1) + REST A + REST C ;NOW RESELECT THE BUFFER THAT WAS CURRENT AT CALL. + ;WITH OUT DESELECTING THE NOW-DEAD BUFFER + JRST NEWBF1 ;(THE IDEA IS TO AVOID SETTING ITS MFBFR BIT). + +;C -> BUFFER FRAME; SELECT IT AS CURRENT. SETS UP BEG, ETC. +;CLOBBERS C,T,TT. +NEWBFR: MOVE T,BFRPTR ;COPY BEG, ETC. BACK INTO THE FRAME + MOVE TT,T ;THEY CAME FROM. + HRLI T,BEG ;(THAT IS, THE ONE CEASING TO BE CURRENT) + HLL C,MFBEG(TT) ;DON'T CLOBBER THE MFBFR AND MFMARK BITS. + BLT T,MFEXTR(TT) + HLLZ T,C ;WE SAVE THE BITS IN LH(C) TO AVOID USING ANY STACK. + ANDI C,-1 ;A PDL OV IN HERE WOULD BE HORRIBLE. + AND T,[MFBBTS-MFMODIF-MFREADO,,] + SKIPE MODIFF + TLO T,MFMODIF ;STORE MODIFF OF DESELECTED BUFFER AS A BIT. + SKIPE READON + TLO T,MFREADO ;AND FS READ ONLY$ + IORM T,MFBEG(TT) +NEWBF1: MOVEM C,BFRPTR ;REMEMBER WHICH FRAME NOW CURRENT. + SKIPL T,(C) ;SELECTING A FRAME WHICH ISN'T A BUFFER? + .VALUE + LDB TT,[.BP (MFREADO),T] + MOVEM TT,READON ;RESTORE READONLY FLAG + AND T,[MFMODIF,,] + MOVEM T,MODIFF ;RESTORE THE MODIFF OF THE BUFFER BEING SELECTED. + MOVSS C + HRRI C,BEG + BLT C,EXTRAC ;SET UP VARS FOR IT. + MOVSI T,MFBBTS ;BUFFER FLAG BITS SHOULD BE IN MFBEG BUT NOT BEG. + ANDCAM T,BEG + RET + +;FSWORD$ RETURNS WORD OF BUFFER CONTAINING CHARACTER AFTER +;,FSWORD$ ALSO SETS THAT WORD TO . NOTE THAT NO WORD EVER +;CONTAINS PART OF 2 DIFFERENT BUFFERS, BECAUSE OF FSBCREATE$'S ALLOCATION POLICY. +FSWORD: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => WRITING; ELSE READING. + ADD C,BEG ;GET VIRT CHAR ADDRESS OF A CHAR IN DESIRED WORD. + CALL CHK ;"NIB" IF OUTSIDE BUFFER BOUNDS. + TRNN FF,FRARG ;WRITING IN FS WORD$ MODIFIES BUFFER CONTENTS. + JRST FSWRD1 + SKIPE READON ;ALLOWED TO MODIFY THIS BUFFER? + TYPRE [RDO] + SETOM MODIFF +FSWRD1: CAMLE C,GPT ;CONVERT VIRTUAL ADDRESS TO REAL ADDRESS. + ADD C,EXTRAC + IDIVI C,5 ;GET ADDRESS OF WORD CONTAINING CHAR AFTER SPEC'D CHAR ADDR. + MOVE E,C ;PUT ADDRESS OF FLAG-WORD IN E FOR FSNORM + MOVE C,SARG ;AND VALUE TO STORE (IF ANY) IN C, THE ARGUMENT TO FSNORM. + JRST FSNOR1 ;NOW READ AND MAYBE WRITE THE BUFFER WORD. + +BFRMVW: IMULI T,5 +BFRMOV: MOVE TT,BFRBOT + ADDM T,BFRBOT + ADDM T,BEG + ADDM T,BEGV + ADDM T,PT + ADDM T,GPT + ADDM T,ZV + ADDM T,Z + JRST BFRRLC + +;RELOCATE POINTERS INTO BUFFER SPACE WHEN PART OF IT MOVES. +;ALL POINTERS IN ALL BUFFER FRAMES ARE CHANGED IF THEY ARE +;LARGER THAN C(TT) WHICH IS PRESUMABLY THE CHAR ADDR AT WHICH +;SOMETHING GREW OR SHRANK. C(T) IS THE AMOUNT TO ADD TO EACH +;POINTER. DOES NOT RELOCATE BEG, BEGV, PT, GPT, ZV OR Z. +;BYTE POINTERS IN MACRO FRAMES, AND CPTR AND INSBP, ARE ALSO RELOCATED. +;CLOBBERS A,C. RELOCATES BFRTOP PROPERLY. +BFRRLC: SKIPL @BFRPTR ;CURRENT BUFFER HEADER ISN'T A BUFFER HEADER? + .VALUE + SAVE BP + MOVE A,BFRTOP ;TO SAVE TIME, IF WE CAN FIGURE OUT THAT THE CHANGE + SUBI A,5 ;TOOK PLACE IN THE UPPERMOST BUFFER, THEN WE KNOW NO + CAMLE TT,A ;BUFFER HAS TO BE RELOCATED. + JRST BFRRL3 ;SO WE DON'T HAVE TO TEST THEM ALL. + MOVEI A,MFSTRT ;SCAN ALL BUFFER FRAMES. +BFRRL1: SKIPL C,MFBEG(A) .SEE MFBFR + JRST BFRRL4 ;THIS FRAME ISN'T A BUFFER FRAME. + TLZ C,MFBBTS ;IT IS A BUFFER FRAME. + CAME A,BFRPTR + CAMGE C,TT ;IS IT HIGH ENOUGH IN MEMORY TO BE RELOCATED? + JRST BFRRL2 +INSIRP ADDM T(A),MFBEG MFBEGV MFPT MFGPT MFZV MFZ + ADD C,T + CAMGE C,BFRBOT ;BUFFER RELOCATED TO BELOW BUFFER SPACE? + .VALUE +BFRRL2: ADDI A,MFBLEN + CAMGE A,MFEND + JRST BFRRL1 +BFRRL3: MOVE BP,CPTR ;RELOCATE CPTR - MAYBE WE'RE EXECUTING OUT OF A BUFFER NOW. + CALL BFRRL5 + MOVEM BP,CPTR + SKIPE INSINP + SKIPE INSBP + CAIA + .VALUE ;IN INSERT, AND INSBP ISN'T SAVING IT?? + MOVE BP,INSBP + CALL BFRRL5 + MOVEM BP,INSBP + ADDM T,BFRTOP + SKIPL @BFRPTR + .VALUE +POPBPJ: REST BP + RET + +BFRRL4: MOVE BP,MFCPTR(A) ;MACRO FRAME FOUND: IF THE CPTR POINTS AT A BUFFER, + CALL BFRRL5 ;RELOCATE IT IF THAT BUFFER IS MOVING. + MOVEM BP,MFCPTR(A) + JRST BFRRL2 + +BFRRL5: SAVE TT ;BP HAS A B.P. EITHER RELOCATE IT, OR SKIP IF IT'S UNCHANGED. + CALL GETCA + REST TT + CAMGE BP,BFRTOP + CAMGE BP,TT + JRST POPJ1 ;IF WE SKIP, BP IS CLOBBERED, BUT CALLER SHOULD ASSUME UNCHANGED. + ADD BP,T ;RELOCATE THE POINTER IF NEC. + SAVE TT + CALL GETBP + REST TT + RET + +BFRSE2: MOVEM B,PF ;SPECIAL ENTRY FROM FSQPUN + ;STORE BACK QREG PDL PTR; OTHERWISE ERROR QNB WOULD + ;CAUSE A LOOP DUE TO AUTOMATIC UNWIND. +;SELECT THE BUFFER IN THE Q-REG CH POINTS AT (PRESUMABLY ..O), PROVIDED IT IS LEGITIMATE. +;OTHERWISE, CLOBBER THE QREG BACK TO THE CURRENTLY SELECTED BUFFER. +BFRSE1: SAVE C + MOVE C,BFRSTR + EXCH C,(CH) + CALL BFRSET ;WHILE WE SELECT IT, KEEP THE OLD, GOOD BUFFER IN ..O. + MOVEM C,(CH) ;THEN PUT NEW ONE BACK IN ..O WHEN ERROR CAN'T HAPPEN. + JRST POPCJ + +;ASSUME C HAS A STRING PTR TO A BUFFER'S POINTER STRING; +;MAKE THAT BUFFER CURRENT. CLOBBERS BP,T,TT. +BFRSET: SAVE C + SAVE CH + SAVE B + SAVE C + CALL QBGET + SKIPN C,B + TYPRE [QNB] ;SELECTING A KILLED BUFFER? + REST BFRSTR + REST B + CALL NEWBFR + REST CH + JRST POPCJ + +;C HAS STRING PTR TO PTR STRING OF BUFFER. +;RETURN IN B THE ADDR OF THE FRAME. +;RETURN IN CH A BP TO 1ST CHAR OF POINTER STRING. +;CLOBBERS BP,T,TT. +QBGET: MOVE BP,C +QBGET2: ADD BP,QRBUF + TLZE BP,400000 + CAML BP,QRWRT + TYPRE [QNB] + CALL GETBP + LDB CH,BP + CAIE CH,QRBFR + TYPRE [QNB] + MOVE CH,BP + CALL QLGET4 ;FORM NEXT 3 CHARS INTO NUMBER IN B + ADDI B,4 ;QLGET4 SUBTRACTS 4; WE MUST COMPENSATE. + RET + +;HERE TO DECODE A BUFFER POINTER IN BP, AND ALSO MAKE SURE, IN CASE IT IS THE +;SELECTED BUFFER, THAT THE WORDS IN THE BUFFER BLOCK ARE UP TO DATE. +QBGET1: CAME BP,BFRSTR + JRST QBGET2 + SAVE C + MOVE C,BFRPTR + CALL NEWBFR + REST C + JRST QBGET2 + +;FS BCREATE$ -- CREATE A NEW BUFFER, AND MAKE IT CURRENT. +FSCRBF: CALL FSCRB1 + MOVEI CH,$QBUFR ;ADDR OF QREG TO STORE IN. + CALL QCLOSQ + MOVEM OUT,BFRSTR ;SET INTERNAL Q..O AS WELL. + MOVE C,A + JRST NEWBFR ;SET PREDIGESTED Q..O (BFRPTR) AS WELL. + +;FS BCONS$ -- RETURNS A NEWLY CREATED BUFFER. +FSBCON: CALL FSCRB1 +FSBCO1: MOVEI CH,A + CALL QCLOSQ + JRST POPJ1 + +;FS QVECTOR$ -- RETURNS A QREG VECTOR BUFFER. +FSQVEC: CALL FSCRB1 + MOVSI T,MFQVEC + IORM T,(A) ;NOTE A -> BUFFER FRAME. + JRST FSBCO1 + +FSCRB1: TRZN FF,FRARG + SETZ C, ;C HAS # OF CHARS OF SPACE TO MAKE IN THE BUFFER. + SAVE C ;(SPACE IS NOT INITIALIZED). + MOVEI C,4 + CALL SLPQGT ;GET SPACE FOR POINTER-STRING. + ;NOW THE BUFFERS WON'T MOVE, SO WE CAN SET + ;UP THE POINTERS IN THE FRAME. + CALL GETFRM ;OBTAIN FRAME FOR BUFFER; ADDR IN A. + MOVEI A,1(A) ;GETFRM ACTUALLY GIVES ADDR OF FRAME MINUS 1. + SETZM MFEXTR(A) + MOVE C,BFRTOP ;PUT THIS NEW BUFFER AT TOP OF MEM. +INSIRP MOVEM C(A),MFBEGV MFPT MFGPT MFZV MFZ + TLO C,MFBFR ;MARK THIS FRAME AS A BUFFER FRAME + MOVEM C,MFBEG(A) + TLZ C,MFBFR + IDIVI C,5 ;FIND WHICH WORD WE START IN + HRLZ TT,C ;MAKE A BLT POINTER TO ZERO STARTING FROM THERE. + HRRI TT,1(C) + REST C ;HOW MUCH SPACE DO WE WANT? + ADDM C,MFZV(A) ;INCLUDE IT IN THE BUFFER BY SETTING Z AND ZV. + ADDB C,MFZ(A) + IDIVI C,5 ;WHICH WORD DO WE END IN? + SETZM -1(TT) ;ZERO ALL THE SPACE, INCLUDING THAT WORD. + CAIE C,-1(TT) + BLT TT,(C) + IMULI C,5 ;FIND THE NEXT WORD BOUNDARY, FOR NEW TOP OF BUFFER SPACE. + ADDI C,5 + MOVEM C,BFRTOP ;EACH BUFFER GETS A WORD OF SPACE SO THEY'RE SEPARATED. + MOVEI B,QRBFR ;NOW CREATE THE POINTER STRING IN SPACE ALREADY RESERVED. + MOVE C,A ;IT SHOULD CONTAIN THE ADDR OF THE BUFFER FRAME. + CALL QHDRW1 + MOVEI OUT,4 + ADD OUT,QRWRT + RET + +;FS BKILL$ -- TAKES ARG = STRING POINTER TO PTR STRING OF BUFFER, +;AND KILLS THAT BUFFER. THAT IS, THE BUFFER FRAME AND TEXT ARE FREED, +;AND THE PTR STRING IS CHANGED TO BE A DEAD BUFFER. IF NO ARG, +;[ ;DO " Q..O(]..O[A)UA QA-Q..O"NFSBKILL$' ]A ". +FSKILB: TRZE FF,FRARG ;IF THERE'S AN ARG, USE IT. + JRST FSKIL1 + SAVE $QBUFR ;OTHERWISE, POP QREG PDL INTO Q..O, + MOVEI CH,$QBUFR + CALL CLOSB2 + REST C ;AND IF POPPED VALUE DIFFERS FROM PREV. CONTENTS, + CAMN C,$QBUFR ;KILL THE PREVIOUS CONTENTS. + RET +FSKIL1: SKIPN KILMOD + RET ;ALLOW THIS TO BE DISABLED FOR DEBUGGING. + CALL QBGET ;GET ADDR OF FRAME IN B. + CAMN B,BFRPTR + TYPRE [KCB] ;KILL A BUFFER WHILE IT'S SELECTED? + SKIPN A,B + RET ;KILLING A DEAD BUFFER. + SETZ Q, + IDPB Q,CH ;STORE 0'S IN BUFFER-FRAME-ADDR IN PTR STRING. + IDPB Q,CH + IDPB Q,CH + JRST KILBFR ;FREE FRAME AND TEXT. + +;F[B BIND$ -- PUSH THE CURRENT BUFFER. F]B BIND$ -- POP IT. +FSBBIN: TRNN FF,FRARG + JRST FSBBI3 ;NO ARG => MUST BE PUSHING. + JUMPGE C,FSBBI3 ;ARG IS POSITIVE => MUST BE SIZE OF BUFFER TO MAKE, SO WE'RE PUSHING. + SAVE BFRSTR ;ARG => POPPING. REMEMBER THE INNER BINDING BEING FLUSHED. + MOVEM C,$QBUFR + CALL BFRSET ;SELECT THE OLD BINDING (IN C) + REST C ;KILL THE INNER BINDING AFTER THAT SUCCEEDS. + JRST FSKIL1 + +FSBBI3: TRO FF,FRARG + CALL FSBCONS ;PUSHING THE SEARCH TABLE: MAKE A NEW ONE, + JFCL + SAVE BFRSTR ;SAVE THE OLD ONE TO RETURN, AND SELECT NEW ONE. + MOVE C,A + CALL BFRSET + MOVEM A,$QBUFR +POPAJ1: REST A ;THEN RETURN THE OLD ONE (TO GO ON QREG PDL). + JRST POPJ1 + +;EMACS BUFFER SWITCH LOCAL VARIABLE SWAPPING + +;,F^G - DO A LOCAL VARIABLE SWAP FOR THE EMACS BUFFER TABLE. +; IS THE BUFFER WHICH IS THE EMACS BUFFER TABLE. +; IS THE WORD OFFSET (VIRTUAL) OF AN ENTRY IN IT. +; IS THE POSITION WITHIN THAT ENTRY OF THE FIRST LOCAL VARIABLE. +;LOCAL VARIABLES FILL ALL THE REST OF THE ENTRY FROM THERE +; (THE TOTAL LENGTH OF THE ENTRY IS ITS FIRST WORD). +;EACH LOCAL VARIABLE TAKES TWO WORDS: +; THE FIRST IS THE NAME AS A STRING POINTER, OR THE :FSQPHOME$ OF A ^R COMMAND SLOT OR Q-REG, +; AND THE SECOND IS THE SWAPPED-OUT VALUE. + +;@F^G ONLY STORES THE CURRENT VALUES INTO THE BUFFER TABLE. +;:F^G ONLY GETS NEW VALUES OUT OF THE BUFFER TABLE. + +;NOTE: WE ASSUME THAT THE GAP IN THE BUFFER TABLE IS NOT IN THE MIDDLE OF THIS ENTRY! +;IT IS OK IF IT IS DIRECTLY IN FRONT OR BEHIND THE ENTRY. + +FCTLG: EXCH C,E ;HAHA I THOUGHT , PUT IN C AND IN E, SO MAKE IT THAT WAY. + CALL QREGX ;READ QREG CONTAINING THE BUFFER TABLE. + MOVE BP,A + CALL QBGET1 ;B GETS PTR TO BUFFER TABLE'S BUFFER FRAME. + IMULI C,5 ;C HAS CHARACTER POINTER TO START OF EMACS BUFFER'S ENTRY. + ADD C,MFBEGV(B) + CAML C,MFGPT(B) + ADD C,MFEXTR(B) + IDIVI C,5 ;C NOW HAS WORD ADDRESS OF START OF ENTRY. + MOVE D,(C) ;D HAS LENGTH OF ENTRY. + ADD C,E ;C NOW GETS POINTER TO FIRST LOCAL VARIABLE ENTRY. + SUB D,E ;D HAS # OF WORDS LEFT (TWICE NUMBER OF LOCAL VARS). + JUMPLE D,CPOPJ + +;HACK THE NEXT LOCAL VAR. C POINTS TO THE WORD IN THE BUFFER TABLE HOLDING ITS NAME. +;D HAS THE NUMBER OF WORDS OF LOCAL VARS LEFT TO HACK IN THIS BUFFER. +FCTLG1: MOVE A,(C) + CALL FCTLG2 ;LOAD NAME OF NEXT LOCAL VAR INTO GCTAB. + JRST FCTLG4 ;IT ISN'T A STRING => IT IS ADDRESS IN RRMACT. + MOVE IN,QRB.. ;GET STRING POINTER TO SYMBOL TABLE. + MOVE A,.QSYMT(IN) + SAVE C + SAVE D + SAVE FF + TRZ FF,FRCLN\FRUPRW\FRARG\FRARG2 + TRO FF,FRUPRW ;INSIST ON EXACT MATCH IN LOCAL VARIABLE NAME. + CALL FOCMD3 ;LOOK UP THAT VARIABLE IN THE SYMBOL TABLE. IN GETS S.T.E. ADDRESS. + TYPRE [UVN] + REST FF + MOVEI CH,1(IN) ;CH GETS ADDR OF VALUE WORD IN S.T.E. + MOVE IN,-1(P) ;IN GETS ADDR OF LOCAL VARIABLE ENTRY./ + MOVE D,(CH) ;BEGIN THE EXCHANGE, + MOVE C,1(IN) + TRNN FF,FRCLN ;COLON MEANS DON'T STORE IN THE BUFFER TABLE. + MOVEM D,1(IN) + TRNN FF,FRUPRW ;ATSIGN MEANS DON'T SET THE VARIABLE. + CALL [ SKIPE VARMAC ;IF SETTING THE VAR CAN CALL A MACRO, + JRST USE3 ;USE USE3 TO DO IT SO THAT THE MACRO GETS CALLED. + MOVEM C,(CH) ;OTHERWISE JUST STORE. + RET] + REST D + REST C + JRST FCTLG6 + +FCTLG5: MOVE CH,1(IN) ;FETCH BOTH VALUES, TO EXCHANGE THEM. + MOVE Q,1(C) + TRNN FF,FRCLN ;IF NO COLON, STORE IN THE BUFFER TABLE. + MOVEM CH,1(C) + TRNN FF,FRUPRW ;IF NO ATSIGN, SET THE Q-REG. + MOVEM Q,1(IN) +FCTLG6: ADDI C,2 ;MOVE PAST THIS LOCAL VAR AND DECREMENT COUNT OF REMAINING ONES. + SUBI D,2 + JUMPG D,FCTLG1 + RET ;AFTER HACKING ALL LOCAL VARS, WE ARE DONE. + +;GIVEN A STRING POINTER IN A, LOAD THE STRING INTO STAB WITH J POINTING AT THE END. +;SKIPS UNLESS THE OBJECT IN A REALLY IS A STRING. +;CLOBBERS B,BP,CH,TT,TT1. +FCTLG2: CALL QLGET0 ;GET BP TO VAR NAME STRING IN BP AND LENGTH IN B. + RET + MOVEI J,STAB-1 + JUMPE B,POPJ1 +FCTLG3: ILDB CH,BP ;FETCH NEXT CHAR OF VARIABLE NAME STRING + CAIL CH,"A+40 ;CONVERT LETTERS TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;AND STORE IN STAB FOR OUR LOOKUP. + SOJG B,FCTLG3 + JRST POPJ1 + +FCTLG4: MOVE IN,A ;HERE IF A LOCAL'S "NAME" ISN'T A STRING. + CAIGE IN,RRMACT+1000 ;IT SHOULD POINT INTO RRMACT OR AT A Q-REG. + CAIGE IN,RRMACT + CAIGE IN,QTAB+NQREG + CAIGE IN,QTAB + CAIA ;SKIP IF NOT THE ADDRESS OF A LEGITIMATE LOCAL Q-REGISTER. + SOJA IN,FCTLG5 ;GO SWAP THE CONTENTS OF THAT WORD. + CAIL C,FLAGSL*2 ;IF IT ISN'T A LOCAL Q-REG, MAYBE IT'S AN FS FLAG. + TYPRE [ILN] ;THEY ARE REPRESENTED BY INDICES INTO THE TABLE FLAGS. + SAVE C + SAVE D + MOVE B,IN ;GET VALUE TO SWAP IN AS ARG TO FLAG ROUTINE. + MOVE C,FLAGD(C) ;GET ADDRESS OF FLAG ROUTINE. + SAVE FF + TRZ FF,FRCLN+FRARG+FRARG2 + TRZN FF,FRUPRW ;IF NO ATSIGN, SET THE FLAG. + TRO FF,FRARG + CALL FSFND ;IN ANY CASE, CALL FLAG ROUTINE SO WE GET THE OLD VALUE + REST FF + REST D + REST C + TRNN FF,FRCLN ;WHICH, IF NO COLON, WE STORE IN THE BUFFER TABLE. + MOVEM A,1(C) + JRST FCTLG6 + +SUBTTL SEARCH COMMANDS + +;GET ARGUMENTS TO SEARCH +GSARG: TRZ FF,FRBACK ;CLEAR SOME FLAGS + ARGDFL Z, ;GET ARGUMENT OR OPERATOR CONVERTED TO VALUE + MOVMM C,SEARG ;STORE # OCCURRENCES TO LOOK FOR. + JUMPL C,GSARGN ;J IF SEARCHING BACKWARDS. + MOVE E,PT ;ELSE RANGE TO SEARCH IS PT TO ZV. + MOVE C,ZV +GSARG2: MOVEI B,SLP1I ;GET-CHAR RTN FOR MOVING FWD. +GSARG1: HRRM B,SLP1P ;STORE GET CHAR RTN ADDR. +GSAPCH: MOVE BP,E ;CHAR ADDR BOTTOM OF RANGE. + CAML E,GPT ;IF CHAR ADDRESSED IS ABOVY RANGE, PT TO IT. + ADD BP,EXTRAC + CALL GETBP + MOVEM BP,BBP ;SAVE BP'S TO BOTTOM OF RANGE. + MOVEM BP,BBP1 + MOVE BP,C ;MAKE PTR TO TOP OF RANGE: + CAMG C,GPT ;IF IT IS BEYOND GAP, + CAML E,GPT ;OR BOTTOM IS AT GAP, + ADD BP,EXTRAC ;RELOCATE TO PT ABOVE GAP, + CALL GETBP + MOVEM BP,ZBP + MOVEM BP,ZBP1 + CAMGE E,GPT ;IS THE GAP WITHIN RANGE OF SEARCH? + CAMG C,GPT + JRST GSARG7 + TRNN FF,FRBACK + JRST GSARG4 + MOVE BP,GPT ;IN BACKWARD SEARCH, MUST STOP AT GAP + ADD BP,EXTRAC ;TO MOVE OVER IT. + CALL GETBP + MOVEM BP,BBP1 +GSARG4: MOVE BP,GPT ;FOR MOVING FWD OVER GAP, + CALL GETBP + MOVEM BP,ZBP1 ;NEED BP TO START OF GAP. +GSARG7: SUB E,BEG + SUB C,BEG + MOVEM E,SRCBEG ;REMEMBER RANGE SEARCHED, FOR ^B COMMAND. + MOVEM C,SRCEND + POPJ P, + +GSARGN: MOVE E,BEGV ;BACKWARDS, RANGE IS BEGV TO PT. + MOVE C,PT +GSARG6: TRO FF,FRBACK + MOVEI B,SLP1D ;RTN TO GET CHARS BACKWARDS. + SETZM PNCHFG ;NEVER READ FROM FILE IF BACKWARD SEARCH FAILS. + JRST GSARG1 + +GSARGB: TRZ FF,FRBACK ;BOUNDED SEARCH. + MOVEI J,1 ;GO ONLY ONCE. + MOVEM J,SEARG + TRNE FF,FRARG2 + CAMG E,C ;IF FB HAS 2 ARGS, IN REVERSE ORDER, + JRST GSARG5 + EXCH C,E ;THEN DO BACKWARDS BOUNDED SEARCH. + CALL GETARG + CALL CHK1 + JRST GSARG6 + +GSARG5: CALL GETARG ;GET RANGE IN C,E. + CALL CHK1 + JRST GSARG2 + + ;SEARCH COMMANDS + +SERCHA: HRRZM P,PNCHFG ;_ COMMAND. PNCHFG POSITIVE. + CAIA +SERCHP: SETOM PNCHFG ;N COMMAND. PNCHFG NEGATIVE. + CAIA +SERCH: SETZM PNCHFG ;S COMMAND. PNCHFG ZERO. + CALL GSARG ;HANDLE ARG, SET UP DISPATCHES. + JRST SERCH1 + +;FB -- BOUNDED SEARCH. ARGS LIKE K,T. (:FB IS LIKE :S, NOT :K). +FBCMD: SAVE FF ;SAVE FRCLN. + ANDCMI FF,FRCLN\FRUPRW + CALL GSARGB ;GET RANGE OF BUFFER, SET UP DISPATCHES. + SETZM PNCHFG + REST A + ANDI A,FRCLN\FRUPRW ;RESTORE: FLAG SO IT WILL SAY WHETHER TO RETURN A VALUE. + IORI FF,(A) +SERCH1: MOVEI CH,ALTMOD ;NOW TO CHOOSE A TEXT TERMINATOR, DEFAULT IS ALTMODE + TRNE FF,FRUPRW ;UPARROW TYPED? + CALL RCH ;YES, GET NEXT CHARACTER INSTEAD + HRRM CH,INSDLM ;STORE AS DELIMITER + MOVE E,SBFRP ;ADDRESS OF SEARCH BUFFER HEADER BLOCK. + MOVE TT,MFZ(E) + MOVE E,MFBEGV(E) ;CHAR ADDRS OF BEGINNING AND END OF SEARCH BUFFER. + IDIVI E,5 + AOS E + MOVEM E,STBLP ;WORD ADDRESS OF SEARCH BUFFER BODY, + 1 (START OF DATA) + HRLM E,STBLPX + IDIVI TT,5 + SUBM E,TT ;- + HRLI E,-1(TT) ;AOBJN -> SEARCH BUFFER + SETO D, ;SAY THERE ISN'T A CHAR TO BE REREAD. + TRZE FF,FRUPRW + JRST SERCH2 + CALL RCH ;IF NOT AN ^-TYPE ARG, CHECK FOR NULL ARG + SKIPE SQUOTP + JRST SERCH3 ;DON'T BE CONFUSED BY SUPERQUOTED ALTMODES. + CAIN CH,ALTMOD ;WHICH MEANS REPEAT PREVIOUS SEARCH. + JRST SRLC +SERCH3: MOVE D,CH ;ELSE CAUSE THE CHAR TO BE REREAD. + TLZ D,4^5 ;DON'T LET IT BE NEGATIVE. + JRST SERCH2 + +;REPEAT THE PREVIOUS SEARCH. THE SEARCH BUFFER CONTAINS POINTERS INTO ITSELF. +;ALL THOSE POINTERS MUST BE RELOCATED IF THE SEAECH BUFFER HAS MOVED SINCE THE LAST +;TIME IT WAS USED. E -> BUFFER BODY BOTTOM. CLOBBERS E,D,TT. +SRLC: SKIPN -1(E) ;DOES BUFFER SAY IT IS VALID? + TYPRE [SNR] + HRRZ TT,(E) ;RH OF 1ST WORD OF TABLE SHOULD POINT TO 2ND. + SUBI TT,1(E) ;SUBTRACT REAL ADDR OF 2ND, GIVES AMOUNT BUFFER HAS MOVED. + MOVNS TT + HRLZ TT1,TT ;WE MAY WANT TO RELOCATE LH'S AS WELL AS RH'S. + JUMPE TT,SRN3 ;DON'T BOTHER RELOCATING IF RLOC. AMOUNT IS 0. +SRLC1: ADDM TT1,(E) ;LH OF EACH SUBSTRING HEADER IS A POINTER. + HRRZ D,(E) + CAIN D,SLP1P ;REACHED END OF TABLE? + JRST SRN3 + ADDM TT,(E) ;NO; RH IS ALSO A POINTER. + HLRZ E,(E) ;FIND NEXT SUBSTRING. + JRST SRLC1 + +;NOW COMPILE SEARCH TABLE +SERCH2: SETZM -1(E) ;WHILE WE SET UP STBL IT IS INVALID. +SCPL: HRRZ C,E ;SAVE LOCATION OF BEGINNING OF BLOCK (LOOP POINT FOR CONTROL O) + MOVEI CH,1(E) ;GET RIGHT HALF OF UPCOMING HEADER + PUSHJ P,SDEP ;DEPOSIT IN TABLE +SCPL1: TDZA A,A ;CLEAR INDEX AND FALL INTO LOOP +SCNOT: TRC A,1 ;CONTROL N, COMPLEMENT 1 BIT INDEX + SKIPGE CH,D ;IF THERE'S A CHAR TO REREAD, USE IT. + CALL RCH ;ELSE GET NEXT CHARACTER. + SETO D, ;FLUSH THE SAVED CHAR IF ANY. + SKIPGE SQUOTP + JRST SCNSP ;SUPERQUOTED CHAR. + SKIPE SQUOTP + JRST SCNDL ;DELIM-PROTECTED CHAR. + CAMN CH,INSDLM ;IF TEXT TERMINATOR (RH MODIFIED), + JRST SCPX ;THEN DONE COMPILING, GO DO IT +SCNDL: CAILE CH,^X + JRST SCNSP + CAIN CH,^X ;IF CONTROL X (FOR "ANY CHARACTER"), + ADDI A,XSER ;THEN SET INDEX + CAIN CH,^B ;IF CONTROL B (FOR BREAK CHARACTER) + ADDI A,BSER ;THEN SET INDEX + CAIN CH,^N ;IF CONTROL N (FOR "NOT") + JRST SCNOT ;THEN CLOBBER INDEX AND GET NEXT CHARACTER + CAIN CH,^O ;IF CONTROL O ("OR"), + JRST SCPOR ;THEN GENERATE NEW HEADER + CAIN CH,^Q ;IF CONTROL Q (QUOTES THE NEXT CHARACTER), + CALL RCH ;THEN REALLY USE NEXT CHARACTER, SKIPPING ABOVE TESTS +SCNSP: SKIPE BOTHCA ;BOTHCASE=0 => CASES ARE DISTINCT. + TRNN CH,100 ;BOTHCASE=1 => CASE IGNORED FOR LETTERS ONLY. + JRST SCNSP1 ;BOTHCASE=-1 => CASE IGNORED FOR ALL CHARS > 100 . + ANDI CH,-1 ;SUPERQUOTED CHARS STIL GET CONVERTED. + CAIL CH,"A+40 ;IF IGNORING CASE FOR A CHARACTER, CONVERT IT TO + CAILE CH,"Z+40 ;UPPER CASE HERE, ND ALSO WHIE SEARCHING THE BUFFER. + SKIPG BOTHCA + ANDCMI CH,40 +SCNSP1: TRNE A,-2 ;IF INDEX CLOBBERED, + SKIPA CH,(A) ;THEN GET TABLE ENTRY + HLL CH,CHSER(A) ;INDEX NOT CLOBBERED OUT OF EXISTENCE, TURN INTO CAIE OR CAIN + PUSHJ P,SDEP ;DEPOSIT TABLE ENTRY + JRST SCPL1 ;LOOP + +SDEP: MOVEM CH,(E) ;ADD AN ENTRY TO THE SEARCH TABLE + AOBJN E,CPOPJ ;RETURN IF TABLE NOT FULL + TYPRE [STL] + +SCPX: TDZA B,B ;TEXT TERMINATOR ENCOUNTERED +SCPOR: MOVEI B,SCPL ;CONTROL O + MOVE CH,[JRST WIN] ;SET FINAL TABLE ENTRY (EXECUTED => THIS STRING FOUND) + CAIN C,-1(E) + HRRI CH,WINNL1 ;BUT FOR NULL STRINGS, USE WINNL1 INSTEAD WIN. + PUSHJ P,SDEP ;DEPOSIT + HRLM E,(C) ;STORE POINTER TO THIS HEADER IN LH(LAST HEADER) + JUMPN B,(B) ;JUMP IF NOT TEXT TERMINATOR + MOVS A,STBLPX ;GET LIST CIRCULIZER/POINTER TO ROUTINE TO READ NEXT CHAR. + MOVSM A,(E) ;STORE IN TABLE (THIS LAST ENTRY, DON'T INCREMENT E OR CHECK FOR OVERFLOW) + SETOM -1(A) ;SEARCH TABLE NOW COMPILED. + MOVEI E,1(E) + IMULI E,5 + MOVE A,SBFRP + MOVEM E,MFZV(A) ;ZV OF SEARCH BUFER POINTS TO END OF REGION BEING USED. + JRST SRN3 + + ;TABLES FOR COMPILING SEARCH TABLE + +XSER: JFCL ;CONTROL X + CAIA ;NOT CONTROL X + +BSER: PUSHJ P,SKNBRK ;CONTROL B + PUSHJ P,SKBRK ;NOT CONTROL B + +CHSER: CAIN A, ;NORMAL CHARACTERS (HLL'ED WITH CHAR. IN RIGHT HALF) + CAIE A, ;NOT CHAR. + +;SEARCH TABLE FORMAT + +;FOLLOWING IS COMPILATION OF "SFOO SP)" + ;EVERY WORD ASSEMBLED WITH ",," IS A SUBSTRING HEADER. + +;STBLP POINTS HERE: +;TEM: .+5,,.+1 ;HEADER, LH POINTS TO NEXT COMPARISON STRING + ;RH POINTS TO TABLE THIS COMPARISON STRING +; CAIN A,"F ;IF THE TEST IS TO SUCCEED THEN THE INSTRUCTION SHOULD NOT SKIP +; CAIE A,"O ;THE CHARACTERS ARE IN A +; CAIN A,"O +; JRST WIN ;DOES JRST WIN IF ENTIRE STRING HAS BEEN FOUND +; .+10,,.+1 ;THIS LAST COMPARISON STRING BUT LH STILL POINTS SOMEWHERE +; CAIN A,40 +; CAIE A,"S +; CAIN A,"P +; PUSHJ P,SKBRK ;SKBRK => , SKNBRK =>  +; JFCL +; CAIN A,") +; JRST WIN +; .+2,,.+1 +; JRST WINNL1 +; TEM,,SLP1P ;FINAL HEADER, LH POINTS TO FIRST HEADER MAKING LIST CIRCULAR + ;RH POINTS TO A JRA B, + +;MAIN SEARCH LOOP + +SLP2LC: OFFSET 17-9-. +SLP2==. + LDB A,C ;GET CHARACTER + XCT (B) ;COMPARE WITH FIRST CHARACTER THIS COMPARISON STRING + ;SKIP => THIS CHARACTER LOSES, TRY NEXT COMPARISON STRING + ;NO SKIP => THIS CHARACTER WINS, TRY NEXT ONE + ;WIN ON STRING => JRST WIN + ;THIS CHARACTER TOTALLY LOSES ON ALL COMPARISON STRINGS => EXECUTE SLP1P + ;^ => B := FIRST HEADER IN SEARCH TABLE + SKIPA E,C ;WIN THIS CHARACTER, GET POINTER FOR CHECKING FUTURE CHARACTERS + JRA B,.-2 ;LOSE THIS COMPARISON STRING, TRY NEXT +SLP3==. + ILDB A,E ;GET NEXT CHARACTER + XCT 1(B) ;EXECUTE NEXT TABLE ENTRY + CAMN E,ZBP ;IT CLAIMS TO HAVE WON; WAS IT AT END OF BUFFER? +SLP4:: JRA B,SLP2 ;LOSE, TRY NEXT COMPARISON STRING + AOJA B,SLP3 ;WIN THIS CHARACTER, TRY NEXT + +IFN .-17,.ERR SLP2 WRONG TABLE LENGTH + + OFFSET 0 + +;FALLS THROUGH. +;ASSUMING THE SEARCH TABLE IS SET UP, DO THE SEARCHING. +SRN3: TRZ FF,FRARG+FRARG2 + SETOB A,SFINDF ;A NULL SEARCH OR SEARCHING 0 TIMES SHOULD STATE THAT IT WON. + SKIPE SEARG ;IF ARGUMENT ZERO, (ENTRY FOR "AGAIN" COMMAND) + JRST SRN2 + TRNE FF,FRCLN ;THEN WIN, DON'T BOTHER ACTUALLY SEARCHING. + JRST POPJ1 ;RETURN -1 AS VALUE IF ONE IS WANTED. + RET + +SRN2: CALL SKNBCP ;SET UP SKNBPT FROM Q..D, FOR SKNBRK'S SAKE. + SETZM TEM2 ;NO WINNING SEARCHES FOR SRCV TO DOCUMENT + MOVE C,BBP ;GET PLACE TO START; NORMALLY LOW END + TRNE FF,FRBACK + MOVE C,ZBP ;BUT HIGH END IF REVERSE. +;FOR SEARCH WITH REPEAT COUNT, REPETITIONS COME BACK HERE. +SRN2RP: MOVE E,C ;INIT. BP TO END OF STRING IN CASE FIND NULL STRING. + MOVS 16,[SLP2,,SLP2LC] ;GET POINTER FOR BLTING IN MAIN LOOP + BLT 16,16 ;BLT IN MAIN LOOP + SKIPGE BOTHCA ;IN BOTH-CASES MODE, + MOVE SLP2,[JRST SLPLO1] + SKIPGE BOTHCA ;IGNORE THE CASE OF THE CHARS SEARCHING. + MOVE SLP3,[JRST SLPLOW] + SKIPLE BOTHCA ;BOTHCA POSITIVE => IGNORE CASE OF LETTERS ONLY. + MOVE SLP2,[JRST SLPLO3] + SKIPLE BOTHCA + MOVE SLP3,[JRST SLPLO2] + CALL IMMQIT ;IT'S OK TO QUIT OUT OF MIDDLE OF SEARCH. + MOVE B,ZBP + TRNN FF,FRBACK ;IF GAP IS IN THE RANGE + CAMN B,ZBP1 ;AND WE'RE STARTING BEFORE IT, + JRST SRN1 + MOVE SLP4,[JRST SLP1Z] ;TEMP. PTR ADVANCE + HRRI SLP4-1,ZBP1 ;WILL ENCOUNTER GAP BEFORE END. + MOVEM SLP4,SLP4N + MOVEM SLP4-1,SLP4N1 +SRN1: MOVE B,@STBLP ;INITIALIZE LIST POINTER + HLRZ A,B + TRNE FF,FRBACK ;IF BACKWARDS, ENTER NORMAL LOOP. + JRST WINNUL + HRRZ A,(A) ;IF THERE IS ONLY ONE ALTERNATIVE IN THE SEARCH STRING + CAIE A,SLP1P + JRST SRN5 + HLRZ A,(B) ;AND THE 1ST CHAR OF SEARCH STRING + CAIE A,(CAIN A,) ;IS NOT A SPECIAL SEARCH CHARACTER, + JRST SRN5 + MOVEI A,SFAST ;THEN WE CAN GO FAST + HRRM A,SLP1P ;USE THE GET-NEXT-CHAR ROUTINE THAT CAN SKIP FAST + HRRZ A,(B) ;OVER UNINTERESTING REGIONS. + MOVEI D,SFAFN0 ;WHICH MAIN LOOP SHOULD WE USE? + SKIPE BOTHCA ;SFAFC0 IGNORES THE 40 BIT; SFAFN0 DOESN'T. + CAIGE A,100 ;IS THE 1ST CHAR ONE WHOSE CASE WE WANT TO IGNORE? + JRST SRN4 ;NO. + CAIL A,"A + CAILE A,"Z + SKIPG BOTHCA + MOVEI D,SFAFC0 ;YES. +SRN4: MOVEM D,SFASAD ;TELL SFAST WHERE TO GO. +REPEAT 4,[ROT A,7 ;GENERATE AN ASCII CONSTANT WITH 1ST CHAR OF SEARCH + TRO A,@(B) ;REPEATED 5 TIMES. +] + LSH A,1 + MOVEM A,SFXOR +SRN5: CAMN C,ZBP + JRST WINNUL + JRST SLP1K + +;ROUTINE TO GET NEXT CHARACTER GOING FORWARD UNDER SPECIAL CIRCUMSTANCES. +;MAY SKIP FAST OVER MANY CHARACTERS BEFORE FINALLY STOPPING WITH A CHARACTER IT CAN'T +;QUICKLY RULE OUT. +SFAST: TLNE C,760000 + JRST SLP1I ;GO SLOW IF NOT STARTING NEW WORD. + HRRZ A,ZBP1 + CAIN A,(C) ;OR IF NEAR GAP OR END OF RANGE + JRST SLP1I + SUBM C,A + HRL C,A ;AOBJN -> RANGE OF WORDS WE CAN SCAN FAST. + JRST @SFASAD ;TO SFAFN0 OR SFAFC0. + +;THIS IS THE SFAST MAIN LOOP THAT DOESN'T IGNORE THE 40 BIT OF THE CHARACTER. +SFAFNL: MOVE A,(C) + XOR A,SFXOR ;XOR NEXT WORD WITH ASCII/QQQQQ/ WHERE Q IS CHAR WE'RE LOOKING FOR. + TLNN A,(177_35) ;IS 1ST CHAR OF WORD THE ONE WE WANT? + JRST SFAF1 + TLNN A,(177_26) ;OR THE 2ND? + JRST SFAF2 + TDNN A,[177_17] + JRST SFAF3 + TRNN A,177_10 + JRST SFAF4 + TRNN A,177_1 + JRST SFAF5 +SFAFN0: AOBJN C,SFAFNL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +;MAIN LOOP THAT IGNORES THE 40 BIT. +SFAFCL: MOVE A,(C) + XOR A,SFXOR + TLNN A,(137_35) ;ONLY DIFFERENCE IS THAT EACH MASK OMITS THE 40 BIT. + JRST SFAF1 + TLNN A,(137_26) + JRST SFAF2 + TDNN A,[137_17] + JRST SFAF3 + TRNN A,137_10 + JRST SFAF4 + TRNN A,137_1 + JRST SFAF5 +SFAFC0: AOBJN C,SFAFCL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +SFAF1: HRLI C,350700 ;MUST EXAMINE 1ST CHAR THIS WORD - SO DROP INTO + JRST SLP2+2 ;MAIN SEARCH LOOP. + +SFAF2: HRLI C,260700 + JRST SLP2+2 + +SFAF3: HRLI C,170700 + JRST SLP2+2 + +SFAF4: HRLI C,100700 + JRST SLP2+2 + +SFAF5: HRLI C,010700 + JRST SLP2+2 + +;GET NEXT CHARACTER SEARCHING BACKWARDS + +SLP1E: MOVEM C,ZBP ;INITIALIZATION, SET CEILING FOR SEARCH +SLP1D: CAMN C,BBP1 ;AT BEGINNING OF BUFFER OR END OF GAP? + JRST SLP1F ;YES, FIGURE OUT WHICH. + ADD C,[70000,,] ;NO, DECREMENT C, + JUMPGE C,SLP2 ;AND GO BACK INTO LOOP + SUB C,[430000,,1] + JRST SLP2 + +SLP1F: CAMN C,BBP + JRST LOSE ;REALLY AT START OF RANGE, SEARCH FAILED. + JRST SLP1G ;MOVED BACK TO GAP, GO OVER IT. + +;GET NEXT CHARACTER SEARCHING FORWARDS + +SLP1I: IBP C ;INCREMENT TO NEXT CHARACTER +SLP1K: CAME C,ZBP1 ;AT START OF GAP OR END OF RANGE? + JRST SLP2 ;NO, KEEP GOING + CAMN C,ZBP ;WHICH ONE IS IT? + JRST LOSE ;IT'S END OF RANGE. +;MOVE OVER GAP TO GET NEXT CHARACTER +SLP1G: INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT ;COMPUTE A B.P. TO OTHER SIDE OF GAP. + TRNE FF,FRBACK + AOSA BP ;BACKWARD => 1ST CHAR OF GAP, + ADD BP,EXTRAC ;FWD => LAST CHAR OF GAP. + CALL GETIBP + MOVE C,BP + MOVE BP,BBP ;ALREADY PASSED GAP SOLOOK FOR BNDRYS + MOVEM BP,BBP1 ;OF RANGE INSTEAD. + MOVE BP,ZBP + TRNN FF,FRBACK + MOVEM BP,ZBP1 + XORI SLP4-1,ZBP#ZBP1 + MOVEM SLP4-1,SLP4N1 + XOR SLP4,[#] + MOVEM SLP4,SLP4N +INSIRP POP P,TT1 TT BP + HRRZ A,SLP1P ;NOW WE'RE ACROSS GAP SO RETRY FETCHING NEXT CHAR. + JRST (A) + +SLP1Z: XCT SLP4-1 + CAIA + JRA B,SLP2 + MOVE SLP4-1,[CAMN E,ZBP] + MOVE SLP4,[JRA B,SLP1Z1] + INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT + ADD BP,EXTRAC + CALL GETIBP + MOVE E,BP +INSIRP POP P,TT1 TT BP + JRST SLP3 + +SLP1Z1: MOVE SLP4-1,SLP4N1 + MOVE SLP4,SLP4N + JRST SLP2 + +SLPLOW: ILDB A,E ;COME HERE FROM SLP3 IN BOTHCASES MODE. + CAIL A,140 + SUBI A,40 + JRST SLP3+1 + +SLPLO1: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,140 + SUBI A,40 + JRST SLP2+1 + +SLPLO2: ILDB A,E ;COME HERE FROM SLP3 WHEN IGNORING CASE FOR LETTERS ONLY. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP3+1 + SUBI A,40 + JRST SLP3+1 + +SLPLO3: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP2+1 + SUBI A,40 + JRST SLP2+1 + +;HERE IF SEARCH FAILS TO FIND THE STRING. EITHER READ NEXT PAGE, OR COMMAND HAS FAILED. +LOSE: SKIPE PNCHFG ;IS IT AN N OR _ COMMAND? + SKIPL LASTPA ;IF SO, AND NOT AT EOF, TRY READING MORE FROM FILE. + JRST LOSE2 ;OTHERWISE, SEARCH HAS REALLY FAILED. + MOVEI C,1 ;MAYBE PUNCH ONCE + SETZM IMQUIT ;DON'T QUIT OUT OF I-O - MIGHT GARBLE FILE. + TRZ FF,FRARG + CALL [ SKIPGE PNCHFG ;PUNCH? + JRST PUNCHA ;YES + JRST YANK] ;NO + MOVE E,BEGV ;GET RANGE TO SEARCH = WHOLE BUFFER, + MOVE C,ZV + CALL GSAPCH ;SET BBP, ZBP. + JRST SRN2 ;SEARCH NEW BUFFER + +LOSE2: SETZM SFINDF ;SEARCH LOST, CLEAR FLAG FOR SEMICOLON + PUSHJ P,SRCV ;SET PT (IF THIS WAS REPEATED SEARCH, MAYBE WE FOUND IT ONCE). + TRZE FF,FRCLN ;IF COLON TYPED FOR SEARCH, + JRST NRET0 ;THEN RETURN 0 AS VALUE + MOVE TT,ITRPTR ;ARE WE WITHIN AN ITERATION? + TSC TT,ITRPTR ;(BUT ERRSETS DON'T COUNT). + TRNN TT,-1 + SKIPE PSSAVP ;OR ARE WE WITHIN A ^P-SORT? + SKIPE SRCERR ;YES. IF SRCERR IS 0, INHIBIT THE ERROR. + TYPRE [SFL] + RET + +WINNL1: MOVE E,C ;NULL SEARCH STRING FOUND. +;THIS SEARCH WINS, MAYBE DO SOME MORE +WIN: MOVEM C,TEM1 ;SAVE C, (BYTE POINTER TO FIRST CHARACTER IN FOUND STRING) + MOVEM E,TEM2 ;AND E, ( " TO LAST CHARACTER IN FOUND STRING) + SOSLE SEARG ;THIS LAST SEARCH? + JRST WIN3 ;NO, KEEP GOING +WIN1: PUSHJ P,SRCV ;PICK UP THE PIECES (ENTRY FOR FOUND NULL STRING AT END OF BUFFER) + TRZ B,-1 ;YES, CHASE DOWN LIST LOOKING FOR THIS LIST POINTER + MOVE C,@STBLP ;GET INITIAL POINTER + MOVNI A,1 ;INITIALIZE COUNT +WIN2: TRZ C,-1 ;CLEAR OUT RIGHT HALF OF THIS LIST ENTRY + CAME C,B ;IS THIS THE ONE? + JRA C,[SOJA A,WIN2] ;NO, TRY NEXT + MOVEM A,SFINDF ;STORE FS SVALUE$ + TRZE FF,FRCLN ;RETURN SFINDF AS VALUE IFF IT'S A ":S". + AOS (P) + RET + +;HERE TO SEARCH OVER AGAIN. CLEAN UP FOR RE-ENTERING SEARCH LOOP. +WIN3: TRNE FF,FRBACK + JRST WIN3R + MOVE BP,E + CALL GETCA ;BP GETS REAL CHAR ADDR CORRESPONDING TO END OF INSTANCE FOUND. + MOVE C,ZBP ;IF FORWARD, THEN START FROM END OF THE INSTANCE WE JUST FOUND (IN E), + CAMLE BP,GPT ;AND IF THAT MEANS SKIPPING OVER THE GAP, FIX UP ZBP1 TO MATCH ZBP. + MOVEM C,ZBP1 + MOVE C,E + JRST SRN2RP + +WIN3R: MOVE E,ZBP ;IF BACKWARD, START FROM BEGINNING OF WHAT WE FOUND, + MOVEM C,ZBP ;BUT PREVENT OVERLAP BY SETTING END OF RANGE TO THERE. + MOVE BP,C + CALL GETCA + CAME E,ZBP1 ;IF THE GAP WASN'T OR IS NO LONGER IN THE RANGE, + CAMGE BP,GPT + MOVEM C,ZBP1 ;THEN ZBP1 SHOULD EQUAL ZBP. + JRST SRN2RP + +;SEARCHING STARTING AT END OF BUFFER, DON'T WIN FOR FORWARD NON-NULL SEARCH + +WINNUL: MOVE A,[JRST WINNL1] ;SET UP A AS CONSTANT FOR COMPARISON AGAINST MEMORY +WINNL2: CAMN A,(B) ;IF AGREEMENT, + JRST WINNL1 ;THEN NULL COMPARISON STRING, WIN, KIND OF + CAME B,STBLPX ;IF THIS ISN'T LAST ENTRY IN TABLE, + JRA B,WINNL2 ;THEN TRY NEXT ONE + TRNN FF,FRBACK ;NO NON-NULL COMPARISON STRINGS, IF SEARCHING FORWARD, + JRST LOSE ;THEN LOSE + JRA B,SLP1E ;SEARCHING BACKWARDS => RE-INITIALIZE LIST POINTER, FALL IN + +;PICK UP PIECES FROM SEARCH; COMPUTE NEW VALUE OF PT. + +SRCV: SETZM IMQUIT + SKIPN BP,TEM2 ;GET POINTER TO LAST CHARACTER IN FOUND STRING + JRST SRCVX ;NO WINNERS THIS BUFFER + MOVE C,TEM1 ;GET POINTER TO FIRST CHARACTER IN FOUND STRING + TRNE FF,FRBACK ;IF SEARCH WAS BACKWARDS, + EXCH C,BP ;THEN REALLY WANT THEM INTERCHANGED + ;BP NOW HAS TECO'S . IN BYTE POINTER FORM + ;C HAS BYTE POINTER TO OTHER END OF STRING FOUND + PUSHJ P,GETCA ;CONVERT BP TO CHARACTER ADDRESS + EXCH BP,C ;GET OTHER BYTE POINTER IN BP + PUSHJ P,GETCA ;CONVERT TO CHARACTER ADDRESS + CAMLE C,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL, + SUB C,EXTRAC + CAMLE BP,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL. + SUB BP,EXTRAC + SUB BP,C ;DIFFERENCE = LENGTH OF LAST SEARCH STRING FOUND. + MOVEM C,PT ;GO THERE. +SRCVX: MOVNM BP,INSLEN ;STORE SIGNED LENGTH OF LAST SEARCH STRING FOUND + ;SIGN OF LLSSF IS OPPOSITE THAT OF ARG TO SEARCH FROM WHICH IT WAS SET + POPJ P, + +FKCMD: MOVN A,INSLEN ;"FK" - + JRST POPJ1 + +;FS S STRING$ - READ OR SET THE DEFAULT SEARCH STRING. +FSSSTR: CALL FSSSTV ;FIRST, CONS UP A STRING CONTAINING THE OLD VALUE. + TRZE FF,FRARG ;THEN, IF WE HAVE AN ARG, SET THE DEFAULT FROM IT: + CAMN C,[-1] ;ARG OF -1 MEANS "INVALID SEARCH STRING"; JUST DON'T SET. + JRST POPJ1 + JSP T,GCPUSA ;MUST SET. PUSH VALUE TO RETURN WHERE GC WILL RELOCATE IT. + MOVEI A,[ASCIZ /[0 U0 0S0 ]0/] + SAVE SFINDF + CALL MACXCP ;SET SEARCH STRING DEFAULT BY PASSING ARG TO AN S COMMAND. + REST SFINDF +;POP A GCPUSA'D VALUE AND RETURN IT AS COMMAND'S VALUE. +GCPOPV: REST LEV + SUB P,[1,,1] + JRST POPAJ1 + +GCPUSA: SAVE A ;PUSH THE VALUE IN A AND ARRANGE FOR GC TO RELOCATE IT + SAVE [0] ;WHILE IT IS ON THE STACK. THIS IS DONE BY MAKING + SAVE LEV ;IT LOOK LIKE A "(" BLOCK. + MOVEM P,LEV + JRST (T) + +;RETURN IN A A STRING CONTAINING THE CURRENT DEFAULT SEARCH STRING. PRESERVE C. +FSSSTV: MOVE E,SBFRP + MOVE CH,MFZV(E) + MOVE E,MFBEGV(E) + IDIVI E,5 ;GET WORD ADDR'S OF START AND END OF SEARCH TABLE. + IDIVI CH,5 + AOS E ;SKIP OVER THE VALID-WORD AT THE START. + SETO A, + SKIPN -1(E) ;BUT IF THE TABLE'S CONTENTS AREN'T VALID, RETURN -1. + POPJ P, + SAVE C ;ELSE WE'LL RETURN A STRING. WHAT'S A BOUND ON LENGTH WE NEED? + SAVE [POPCJ] + MOVE C,CH + SUB C,E ;TWICE LENGTH OF SEARCH TABLE IS ENOUGH. + LSH C,1 + CALL QOPEN ;ALLOCATE THAT SPACE, SET UP LISTF5 TO STORE INTO STRING. + AOS E ;SKIP THE FIRST POINTER-PAIR IN THE SEARCH TABLE. +FSSSTL: SETZ C, + HLRZ TT,(E) ;GET LH AND RH OF NEXT SEARCH TABLE WORD. + HRRZ TT1,(E) + CAIN TT1,SLP1P ;SLP1P IN RH IDENTIFIES END OF SEARCH TABLE + JRST QCLOSV ;SO FINISH UP THE STRING'S HEADER AND RETURN IT. + CAIL TT1,HUSED ;AN RH THAT'S AN ADDRESS IN BUFFER SPACE + JRST [ MOVEI CH,^O ;INDICATES A DIVISION BETWEEN ALTERNATIVE STRINGS, + JRST FSSST2] ;SO WE NEED A ^O FOR IT. + CAIN TT,(JRST) ;JRST INSN MUST BE JRST WIN OR WINNUL, WHICH IS AT THE END OF + AOJA E,FSSSTL ;EVERY ALTERNATIVE. IT CORRESPONDS TO NO CHAR IN USER'S ARG. + CAIN TT,(JFCL) + MOVSI C,(ASCII //) ;JFCL IS GENERATED BY A ^X. + CAIN TT,(CAIA) + MOVSI C,(ASCII //) ;CAIA COMES FROM A ^N^X. + CAIN TT1,SKNBRK + MOVSI C,(ASCII //) ;CALL SKNBRK COMES FROM ^B. + CAIN TT1,SKBRK + MOVSI C,(ASCII //) ;CALL SKBRK COMES FROM ^N^B. + JUMPE C,FSSST1 ;ANYTHING ELSE MUST BE ORDINARY, OR A ^N. + MOVEI A,C + CALL ASCIND ;IF ^X OR ^B, OR ^N OF ONE, STORE IN STRING THE STUFF IN C. + AOJA E,FSSSTL + +FSSST1: MOVEI CH,^N + CAIN TT,(CAIE A,) ;DECIDE BETWEEN ORDINARY CHAR AND ^N'D CHARACTER. + XCT LISTF5 + MOVEI CH,^Q ;IF CHAR IS ONE THAT WOULD BE SPECIAL, MUST QUOTE IT. + CAIE TT1,^B + CAIN TT1,^X + XCT LISTF5 + CAIE TT1,^Q + CAIN TT1,^O + XCT LISTF5 + CAIN TT1,^N + XCT LISTF5 + MOVE CH,TT1 ;[ + CAIN CH,^] + XCT LISTF5 ;[ ;^] HAS ITS OWN WAY TO BE QUOTED. +FSSST2: XCT LISTF5 + AOJA E,FSSSTL + +SUBTTL ..D DELIMITER DISPATCH USAGE + +;SKNBRK SKIPS UNLESS THE CHARACTER IN A IS A DELIMITER CHARACTER. +;THE SET OF DELIMITERS IS DEFINED BY THE CONTENTS OF QREG ..D, +;WHICH SHOULD BE A STRING CONTAINING 5*128. CHARACTERS, FORMING A +;DISPATCH TABLE. EACH ASCII CHAR HAS A 5-CHAR DISPATCH ENTRY WHOSE +;FIRST TWO CHARACTERS ONLY ARE SIGNIFICANT. +;THE FIRST CHARACTER IS THE MOST GENERAL: IF IT IS NOT A SPACE, THEN +;THE CHARACTER WHOSE ENTRY IT IS IS NOT A DELIMITER. +;INITIALLY ALL NON-SQUOZE CHARACTERS ARE DELIMITERS. +;THE SECOND CHARACTER SAYS HOW LISP HANDLES THE CHAR BEING HANDLED. +;THE POSSIBLE DISPATCH CHARS ARE "(", ")", "/", "|", "A" AND " ". +;SKNBRK ASSUMES THAT SKNBPT HAS BEEN SET UP BY SKNBCP ALREADY. +;CLOBBERS D. +SKNBRK: LDB D,SKNBPT + CAIN D,"A + AOS (P) + RET + +DQT3: CALL SKNBCP ;SKIP IF CHAR IN C IS DELIMITER; RECOMPUTES SKNBPT. + MOVE A,C +SKBRK: LDB D,SKNBPT ;SKIP IF CHAR IN A IS DELIM. SKNBCP SHOULD HAVE BEEN CALLED. + CAIE D,"A + AOS (P) + RET + +;LOOK AT QREG ..D, AND SET UP SKNBPT FOR USE BY SKNBRK. +SKNBCP: MOVE CH,QRB.. + ADDI CH,.QDLIM + CALL QLGET ;BP _ BP TO TEXT. + TYPRE [QNS] + CAIGE B,5*200 ;NOT LONG ENOUGH => ERROR. + TYPRE [STS] + IBP BP ;BP HAS BP TO LDB 1ST CHAR. + TLO BP,A ;LDB BP TO GET DISPATCH OF CHAR IN A. + MOVEM BP,SKNBPT + RET + +;; ^B COMMAND: GO TO BEGINNING OF BUFFER IF LAST SEARCH WAS BACKWARD AND FAILED, +;; OR TO END IF LAST SEARCH WAS FORWARD AND FAILED. SET FS INSLEN$ TO 0 EITHER WAY. +;; IF LAST SEARCH SUCCEEDED, DON'T MOVE, AND DON'T CHANGE FS INSLEN$. +;; WITH COLON FLAG, IF SEARCH WAS SUCCESSFUL DO FKC. +CTLB: TRZ FF,FRARG\FRARG2 + MOVN C,INSLEN + SKIPE SFINDF + JRST [ TRZE FF,FRCLN + JRST REVER1 + RET] + SETZM INSLEN + HRRZ A,SLP1P + CAIE A,SLP1D ;WAS LAST SEARCH FORWARD? + SKIPA A,SRCEND ;IF SO, GO TO END + MOVE A,SRCBEG ;ELSE GO TO BEGINNING. + ADD A,BEG + MOVEM A,PT + RET + +SUBTTL F AND FS COMMAND DISPATCH + +;F-COMMAND SUBDISPATCH. +FCMD: PUSHJ P,LRCH + XCT FDTB(CH) + POPJ P, + JRST POPJ1 + +;FS COMMAND. +FSET: MOVE B,[440600,,D] + MOVE E,[440600,,J] + SETO BP, + SETZB D,J +;D GETS THE SPEC'D NAME; J GETS MASK TO THOSE CHARS IN THE WORD WHICH WERE SPEC'D. +FSLUP: CALL RCH + ANDI CH,-1 + TRNE CH,100 + ANDCMI CH,40 ;CONVERT TO LOWER CASE. + CAILE CH,40 + JRST FSCHAR ;NON-CONTROLS ARE FOR REAL. + CAIN CH,ALTMOD + SKIPGE SQUOTP ;ALTMODE ENDS NAME UNLESS SUPERQUOTED. + CAIA ;OTHERWISE, ^X IS TREATED AS IF IT WERE AN UPARROW AND AN X. + JRST FSLKUP + MOVEI TT,'^ + CAIE CH,40 ;SPACE, UNLIKE CTL CHARS, IS JUST IGNORED. + TLNN B,770000 ;CTL CHARS ALSO IGNORED IF ALREADY HAVE 6 CHARS. + JRST FSLUP + IDPB TT,B + IDPB BP,E + +FSCHAR: HRREI CH,-40(CH) ;GET SIXBIT, IGNORING LH SINCE MIGHT BE -1 + TLNE B,770000 ;[ ;IF THE CHAR WAS QUOTED WITH ^]^Q + IDPB CH,B + TLNE E,770000 + IDPB BP,E + JRST FSLUP + +FSLKUP: MOVE B,[-FLAGSL*2,,FLAGS] + +;BINARY SEARCH IN VECTOR OF FLAGS <- AOBJN IN B +;FOR VALUE IN D. CLOBBERS B,E,TT. +FSLUKB: HLRE E,B + HRLI B,E ;B IS INDEX OF E. + MOVNS TT,E +;B -> INSIDE AREA, IDX OF E. +;E = SIZE OF LAST STEP. +;TT = # WDS LEFT IN PART OF AREA AFTER B. +;LEAVES B POINTING TO LAST FLAG WHOSE NAME IS < DESIRED NAME +;(NOTE: IF ALL FLAGS ARE >= DESIRED NAME, B -> 1ST FLAG). +;THEN GOES TO FSLUK1. +FSLUK0: CAILE E,(TT) ;E_MAX(LAST STEP,SPACE LEFT) + MOVEI E,(TT) + CAIN E,2 ;ONLY 1 ENTRY TO SEARCH THRU => DONE. + JRST FSLUK1 + LSH E,-1 ;STEP = .5* SIZE OF STUFF TO SEARCH. + TRZE E,1 ;ROUND UP TO EVEN NUMBER. + ADDI E,2 + CAMG D,@B ;E.A. IS RH(B)+STEP. + JRST FSLUK0 ;THAT'S TOO FAR, DON'T MOVE B. + HRRI B,@B ;NOT TOO FAR, SET PTR THERE. + SUBI TT,(E) ;WE'RE CLOSER TO END NOW. + JRST FSLUK0 + +FSLUK1: CAMLE D,(B) ;(THIS PREVENTS LOSSAGE IF SUPPOSED TO FIND 1ST FLAG IN TABLE) + ADDI B,2 + MOVEI B,-FLAGS(B) ;POINT TO 1ST FLAG GREATER THAN OR EQUAL TO DESIRED. + MOVE E,FLAGS(B) + AND E,J ;IF THIS FLAG DOESN'T MATCH SPEC'D NAME, NONE DOES. + CAME D,E + TYPRE [IFN] + CAMN D,FLAGS(B) ;EXACT MATCH IS NEVER CONSIDERED AMBIGUOUS. + JRST FSFND + MOVE E,FLAGS+2(B) ;ELSE, DOES THE NEXT FLAG AFTER THE ONE FOUND + AND E,J ;ALSO MATCH THE SPECIFIED NAME? + CAMN D,E + TYPRE [AFN] ;YES - SPEC'D NAME IS AMBIGUOUS. +FSFND: MOVS E,FLAGD(B) + HRLM B,(P) +FSCALL: CALL (E) ;SOME ROUTINES WILL DEPOSIT IN -1(P)! THEY ALL CREF FSCALL. + RET ;(THEIR GOAL IS TO FAKE OUT FPUSH VIA THE INSN AT .+1) + HLRZ E,(P) ;FOR FLAGS THAT RETURN VALUE, MAKE SURE INDEX OF FLAG IS + JRST POPJ1 ;IN E, FOR FPUSH TO WORK. + +SUBTTL FS FLAG ROUTINES + +;[ ;F]$ POPS QREG PDL INTO THAT FLAG. +;[ ;F]^RCMAC$ WORKS, ETC. +FPOP: MOVEI CH,E ;CH HAS ADDR TO POP INTO. + CALL CLOSB2 + TRON FF,FRARG + SKIPA C,E ;MAKE POPPED VALUE COME BEFORE ANY SPEC'D ARG. + TRO FF,FRARG2 + CALL FSET ;SET THE FLAG, RETURNING THE OLD VALUE OF THE FLAG. + JFCL + RET ;RETURN NO VALUE. + +;F[$ PUSHES THAT FLAG ONTO THE QREG PDL. +;F[^RCMAC$, ETC., WORK. ;]] +FPUSH: MOVE B,PF ;IF WE ARE ABOUT TO OVERFLOW QREG PDL, DETECT THAT + CAMN B,PFTOP ;BEFORE SETTING THE FLAG. + JRST OPENB1 + CALL FSET ;DO FS$, WHICH LEAVES INDEX IN FLAGD IN E. + TYPRE [WNA] ;FLAG HAS NO VALUE, AND YOU WANT TO PUSH IT?? + TRNE FF,FRARG2 ;BARF IF TRY TO PUSH FS BOUNDARIES$, SINCE IT DOESN'T WIN. + TYPRE [WNA] + MOVEI CH,A + CALL OPENB2 ;PUSH THE VALUE FROM A, WHERE FSET LEFT IT, + MOVEM E,(B) ;THEN SET "WHERE PUSHED FROM" FIELD TO THE INDEX OF THIS + ;FLAG IN THE FLAGS TABLE, + ;THUS TELLING AUTO-UNWIND TO POP THE FLAG BY DOING FPOP. + RET + +;HERE ARE THE COMMONLY USED FS FLAG ROUTINES. + +IFN ITS,FSSTRR:: FSDSNM:: FSNQIT:: FSDIRH:: +IFN TNX,FSFVER:: +FSNORM: HLRZS E ;HERE TO READ/SET NORMAL FLAG; E -> WORD HOLDING VALUE. +FSNOR1: MOVE A,(E) +FSNOR2: ARGDFL + TRZN FF,FRARG + JRST POPJ1 + MOVEM C,(E) + CAIE E,CASNRM ;IF SET CASNRM, ALSO SET CASDIS. + JRST POPJ1 + ANDI C,1 + MOVEM C,CASDIS + JRST POPJ1 + +FSVAL: HLRZ A,E ;HERE TO RETURN CONSTANT VALUE (AS FOR FS VERSIO$) + JRST POPJ1 + +IFN ITS,[ +FSRSYS: HRRI E,A ;HERE TO READ A PARTICULAR .SUSET VAR (AS FOR FS OPTION$) + .SUSET E + JRST POPJ1 + +FSOPTL: .SUSET [.ROPTIO,,B] ;READ BIT IN LH OF .OPTION. C SAYS WHICH BIT. + JRST FSBIT1 +] + +FSRNLY: MOVE A,E ;READ-ONLY FLAG'S ADDR IN LH(E) + JRA A,POPJ1 + +FSROCA: MOVE A,E ;READ ONLY CHAR. ADDR, RETURN RELATIVE TO BEG. + JRA A,FSROC1 + +FSWBIT: ARGDFL + HRRI E,FF ;HERE IF WE WANT TO BE ABLE TO WRITE A BIT AS WELL AS READ IT. + MOVE B,FF ;LH(E) HAS B.P. L.H., AND WE ASSUME THE BIT IS IN FF. + SKIPE C ;WE MUST SAVE THE OLD FF SO WE CAN RETURN THE OLD SETTING OF THE BIT. + SETO C, ;ANY NONZERO ARG MEANS TURN THE BIT TO 1. + TRNE FF,FRARG + DPB C,E + CAMN E,[.BP FRTRACE] + CALL QUEST1 ;IF THE BIT JUST CHANGED IS FRTRACE, SET TRACS TOO. + JRST FSBIT1 + +FSBIT: SKIPA B,FF ;LH(E) HAS B.P. L.H., TO FETCH BIT IN FF. +FSTTOL: HLLZ B,TTYOPT ;TEST BIT IN LH(TTYOPT). +FSBIT1: HRRI E,B + LDB E,E ;FETCH THE DESIRED BIT. + SKIPN E +NRET0: TDZA A,A ;VALUE IS 0 IF BIT CLEAR, +NRETM1: SETO A, ;-1 IF SET. + JRST POPJ1 + +;ALTCOUNT FLAG, # COMMAND STRINGS TYPED AHEAD BY USER. +FSALTC: CALL VBDACU ;DO LISTEN TO UPDATE TSALTC, + JFCL + JRST FSNORM ;THEN DO NORMAL FS ON TSALTC. + +;READ OR SET # OF COMMAND LINES. +FSECLS: MOVE A,NELNS ;GET CURRENT # OF CMD LINES, + ARGDFL + TRZE FF,FRARG + CALL FSECL1 ;AND SET IT IF NEC. + JRST POPJ1 + +;DESIRED # ECHO LINES IN C. (OR - => NO ECHO, BUT -1 ECHO LINES) +FSECL1: SKIPGE E,C ;GET ARG IF POSITIVE, + SETCA E, ;OR -1-ARG IF NEGATIVE. + CAML E,NVLNS ;VALUE TOO LARGE => WOULD CRASH TECO. + TYPRE [AOR] + SKIPN RGETTY + JRST FSECL3 + MOVE T,NVLNS + SUB T,NELNS ;IN CASE WE ARE REDUCING NELNS, ZERO OUT HASH CODES OF ALL LINES +FSECL2: SETOM HCDS-1(T) ;THAT WERE PREVIOUSLY IN THE ECHO AREA (AND THE OLD MORE LINE). + CAME T,NVLNS + AOJA T,FSECL2 +FSECL3: MOVEM C,NELNS + MOVE C,NVLNS ;TOTAL # LINES - # ECHO LINES + SUB C,E +IFN TNX,[ + MOVEM C,ECHOL0 ;SAVE FIRST LINE OF ECHO AREA + HRLZM C,ECHOPS ;AND SET UP AS NEW ECHO POSITION +] + SUBI C,1 ;DEDUCT 1 LINE FOR THE --MORE-- + MOVEM C,USZ ;= # LINES FOR BUFFER DISPLAY. +IFN ITS,[ + ADDI C,10 + DPB C,[MORMCV] +] +IFN TNX,CALL MCLSET ;SET UP STRING THAT WILL CLEAR LINE IN C IN MORMCL + SETOM DISOMD ;INDICATE DISPLAYED "MODE" (Q..J) IS OUT OF DATE. +IFN ITS,[ + SYSCAL SCML,[%CLIMM,,CHTTYI ? E] + .LOSE %LSFIL +] + SKIPE ECHOFL ;IF ECHOING NOMINALLY "ON" (THAT IS, NOT OFF DUE TO ^R OR ^T) + CALL SETTTM ;THEN MAYBE CHANGING THIS FLAG TURNS IT OFF OR ON. + SETOM TYOFLG ;USZ HAS CHANGED, SO MAKE SURE TYPEOUT KNOWS ABOUT IT. + RET + +FSWIDTH:TRNE FF,FRARG + CAIG C,MXNHLS + JRST FSNORM + TYPRE [AOR] + +IFN 20X,[ +FSTTPG: MOVE A,PAGMOD ;GET CURRENT PAGE MODE STATE + TRNE FF,FRARG ;IF ANY ARG + MOVEM C,PAGMOD ;SETUP NEW ONE + JUMPGE C,CPOPJ1 ;AND IF NOT -1, DONT NEED TO CHANGE YET + SAVE A + MOVEI A,.PRIOU + RFMOD + TRON B,TT%PGM ;TURN ON PAGE MODE WHILE IN TECO + STPAR + REST A + JRST CPOPJ1 +] + +FSRUNT: +IFN ITS,[ + .SUSET [.RRUNT,,A] + MULI A,4069. ;CONVERT TO NANOSEC., + DIV A,[1.^6] ;THEN TO MILLISEC. +] +IFN TNX,[ + MOVEI A,.FHSLF ;THIS FORK + RUNTM ;RUNTIME IN MS. +] + JRST POPJ1 + +FSUPTI: +IFN ITS,.RDTIME A, ;RETURN THE SYSTEM UP TIME - FS UPTIME $ +IFN TNX,TIME ;SYSTEM UPTIME IN MS. + JRST POPJ1 + +FSSWIT: +IFN ITS,.RDSW A, +IFN TNX,SWTCH ;FOR WHAT ITS WORTH + JRST POPJ1 ;RETURN PDP10 CONSOLE SWITCHES. + +FSDDFS: MOVE A,DEFDEV ;RETURN -1 IF DEFAULT DEVICE IS "FAST". +IFN ITS,CAME A,MACHINE +IFN TNX,CAME A,[ASCII/DSK/] + JRST NRET0 + JRST NRETM1 + +IFN ITS,[ +..RHSNAM==16 ? ..RMAIL==17 + +;,FS U HSNAME$ RETURNS IN SIXBIT THE HSNAME OF ON MACHINE . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED FOR THE CURRENT MACHINE. +FSUHSN: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RHSNAM,,A] + MOVE A,B + TRZ FF,FRARG\FRARG2 + JRST POPJ1 + +;,FS UMAIL$ SETS DEFAULT FILENAMES TO MAIL FILE OF ON . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED MEANING USE THAT USER'S HOME MACHINE. +FSUML: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RMAIL,,A] + MOVEM A,DEFDEV + MOVEM B,DEFFN1 + MOVEM C,DEFDIR + MOVE A,[SIXBIT /MAIL/] + MOVEM A,DEFFN2 + RET +];IFN ITS + +FSEJPG: MOVE A,LHIPAG ;READ OR WRITE FS :EJ PAGE$. + ARGDFL + TRZN FF,FRARG + JRST POPJ1 + CAML C,LHIPAG ;ILLEGAL TO SET IT TO A SMALLER VALUE SINCE PAGES DON'T EXIST. + CAILE C,LHIMAX ;ILLEGAL TO SET ABOVE TOP OF ADDRESS SPACE. + TYPRE [AOR] + EXCH C,LHIPAG +;NOW FLUSH THE PAGES WE HAVE REMOVED FROM PURE STRING SPACE. +IFN ITS,[ + MOVE B,C + SUB B,LHIPAG ;B GETS MINUS NUMBER OF PAGES FS :EJPAGE$ HAS ADVANCED OVER. + JUMPE B,POPJ1 + HRL C,B ;C GETS AOBJN TO PAGES TO BE FLUSHED. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? C] + .LOSE %LSSYS +];IFN ITS +IFN TNX,[ + MOVE B,C + SUB C,LHIPAG ;NEGATIVE NUMBER OF K + JUMPE C,POPJ1 + MOVM C,C + LSHC B,1 ;TRANSLATE FROM K TO PAGES. + HRLI B,.FHSLF ;THIS FORK + SAVE A ;PRESERVE WHAT FS EJPAGE IS GOING TO RETURN. + SETO A, +IFN 20X,[ + HRLI C,(PM%CNT) ;COUNT GIVEN + PMAP +];IFN 20X +IFN 10X,[ +FSEJP1: PMAP + SOJLE C,FSEJP2 + AOJA B,FSEJP1 +FSEJP2: +];IFN 10X + REST A +];IFN TNX + JRST POPJ1 + +;RETURN CURRENT DATE/TIME IN DISK FILE DATE FORMAT. +FSDATE: +IFN ITS,[ + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS +] +IFN TNX,GTAD ;GET TIME IN SYSTEM INTERNAL FORMAT (ASSUME WILL + JRST POPJ1 ;BE PASSED ALONG TO FS F DCONV$ UNMUNGED) + +FSFDAT: +IFN ITS,[ + HLRZS E ;CREATION DATE OF FILE ON CHNL IN LH(E) + ARGDFL + SYSCAL RFDATE,[E ? %CLOUT,,A] + JRST OPNER1 + TRZN FF,FRARG + JRST POPJ1 + SYSCAL SFDATE,[E ? C] + JRST OPNER1 + JRST POPJ1 +] +IFN TNX,[ + HLRZS E + MOVE A,(E) ;GET THE JFN + ARGDFL + SAVE C ;SAVE ANY ARG + MOVE B,[1,,.FBWRT] + MOVEI C,A + GTFDB ;GET THE OLD WRITE DATE + REST C + TRZN FF,FRARG ;WRITING ON THIS FLAG? + JRST POPJ1 ;NO, JUST RETURN +FSFDT2: SAVE A + MOVE A,(E) + SETO B, + HRLI A,.FBWRT + CHFDB ;YES, CHANGE IT + REST A ;AND RETURN OLD VALUE + JRST POPJ1 +] + +;"FS FDCONV $" IS LIKE "\" BUT HANDLES FILE DATES INSTEAD NUMBERS. +FSDCNV: TRNE FF,FRARG + JRST FSDCN2 ;ARG => GO TURN IT INTO STRING IN BUFFER + JRST FSDCNI ;ELSE PARSE A DATE OUT OF THE BUFFER. + +IFN ITS,[ +FSDCNI: SAVE [0] ;PUSH WORD TO ACCUM. THE DATE IN. +FSDCN0: MOVE OUT,[-6,, [40,, ;MONTH + 1,, ;DAY + 1000,, ;YEAR + 3600.*2 ;HOUR (IN TERMS OF 1/2 SEC) + 60.*2 ;MINUTE + 2]] ;SECOND + JRST FSDCN4 + +FSDCN3: MOVE IN,PT + CAMN IN,ZV ;AT END OF BUFFER => RETURN WHAT WE HAVE + JRST FSDCN1 + CALL GETINC + CAIN CH,^M ;STOP BEFORE A CR. + JRST FSDCN1 + AOS PT ;ELSE MOVE OVER DELIMITER +FSDCN4: MOVE Q,PT + SAVE OUT + CALL BAKSL ;READ THE NEXT NUMBER + JFCL + REST OUT + CAMN Q,PT + JRST FSDCN1 ;NO NUMBER => FINISHED. + IMUL A,(OUT) ;ELSE PUT THIS # IN RIGHT PLACE + ADDM A,(P) ;IN THE DATE BEING ACCUMULATED. + AOBJN OUT,FSDCN3 ;HAVEN'T READ ALL 6 YET => KEEP GOING. +FSDCN1: REST A ;A HAS DATE TO RETURN. + CAMN OUT,@FSDCN0 ;IF DATE IN BUFFER WAS NULL, + SETO A, ;RETURN -1 + JRST POPJ1 + +FSDCN2: MOVEM C,PTLFCD + MOVEI TT,TYOM + HRRM TT,LISTF5 ;PRINT THE DATE INTO MEMORY. + CALL [ TRNN FF,FRCLN + JRST GAPSLP + MOVEI C,18. + JRST QOPEN] + SKIPL PTLFCD ;DATE IS -1 => LEAVE EMPTY. + CALL PTLAB9 + JRST SLPXIT +] ;IFN ITS + +IFN TNX,[ +FSDCNI: CALL GAPSL0 ;MOVE GAP TO PT, BUT ARENT MUNGING BUFFER + CALL GETIB. ;GET BYTE POINTER TO . + MOVE A,BP + SETZ B, + IDTIM ;READ IN TIME + SETO B, +IFN 20X,DBP7 A ;MAKE RESULTING BYTE POSITIONS CONSISTANT + MOVE BP,A ;GET UPDATED BYTE POINTER + CALL GETCA ;GET CHARACTER ADDR + SUB BP,EXTRAC ;MOVE OVER GAP + MOVEM BP,PT ;UPDATE . + MOVE A,B ;VALUE TO RETURN + JRST POPJ1 + +FSDCN2: MOVEI A,TYOM ;INTO BUFFER + HRRM A,LISTF5 + HRROI A,BAKTAB ;STRING SPACE + MOVE B,C + TRNE FF,FRARG2 + SKIPA C,SARG ;USE ANY SECOND ARG AS THE FORMAT + MOVSI C,(OT%NMN\OT%DAM\OT%SLA) ;ELSE DEFAULT TO DD/MM/YY HH:MM:SS + ODTIM + LDB C,[350700,,BAKTAB] ;IF ITS FORMAT, MUST MAKE UP FOR ODTIM LOSSAGE + TRNN FF,FRARG2 + CAIE C,40 + JRST FSDCN3 + MOVEI C,"0 ;BY CONVERTING LEADING SPACE TO 0 + DPB C,[350700,,BAKTAB] +FSDCN3: MOVEI C,20. ;MAKE ENOUGH ROOM + CALL [ TRNN FF,FRCLN + JRST GAPSLP + JRST QOPEN] + MOVEI A,BAKTAB + CALL ASCIND ;INSERT IT + JRST SLPXIT + +FSJOBN: GJINF ;GET JOB NUMBER + MOVEI A,(C) + JRST CPOPJ1 + +FSGTNM: MOVE C,JNAME ;GET OUR STARTUP JNAME + JRST FSIXST ;AND GO MAKE A STRING OF IT + +FSGTN0: GETNM ;GET SIXBIT JOB NAME + MOVE C,A ;SET UP AS AN ARG + JRST FSIXST + +FSMACH: MOVE A,[SIXBIT/LHOSTN/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; GET LOCAL HOST NO. + JUMPE B,FSMAC1 ; TRY ALTERNATIVE METHOD IF NO LHOSTN + JUMPL A,FSMAC1 ; OR IF LHOSTN IS NEGATIVE (TOPS-20 RELEASE 3 + ; HAS A LHOSTN ENTRY ON ALL SYSTEMS) + MOVE B,A + HRROI A,BAKTAB + CVHST ; CONVERT HOST NO. TO NAME + JRST FSMAC1 ; NO STRING FOR THAT HOST + MOVEI B,0 ; MAKE SURE STRING IS ASCIZ + IDPB B,A ; ... + JRST FSSTR3 +FSMAC1: SETZM BAKTAB ; FOR THE MOMENT RETURN 0 + JRST FSSTR3 + +FSCCLF: SKIPN A,CCLJFN ;FS CCL FNA$ - IF STARTED AT +2, ... + JRST CPOPJ1 ;NOT, RETURN 0 + MOVEI B,(A) + HRROI A,BAKTAB ;RETURN STRING OF JFN GIVEN + MOVE C,[111110,,000001] ;AS DSK:NAM.EXT.GEN + JFNS + MOVEI A,(B) + RLJFN + JFCL + SETZM CCLJFN ;DONT HAVE STRAY JFNS AROUND LATER + JRST FSSTR3 ;MOVE STRING FROM BAKTAB AND RETURN STRING POINTER + +FSNQIT: MOVE A,NOQUIT ;GET PREVIOUS SETTING + ARGDFL + TRZN FF,FRARG ;IF NO ARG, + JRST POPJ1 ;RETURN IT + MOVEM C,NOQUIT ;SETUP NEW ONE + JUMPG A,FSNQT2 ;CHANGING FROM POSITIVE + JUMPLE C,POPJ1 ;IF NOT CHANGING TO POSITIVE, NOTHING TO DO + SAVE A + MOVEI A,.TICCG + DTI ;ELSE TURN OFF ^G INTERRUPT + JRST POPAJ1 +FSNQT2: JUMPG C,POPJ1 ;NOTHING IF CHANGING TO POSITIVE + SAVE A + MOVSI A,.TICCG ;ELSE RE-ASSIGN ^G INTERRUPT + ATI + JRST POPAJ1 + +FSLOAD: MOVE A,[SIXBIT/SYSTAT/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; FIND TABLE NO. OF SYSTAT TABLE + JUMPE B,FSLOA1 ; IF NOT FOUND THEN RETURN ZERO + MOVEI A,(B) ; GETAB ARG: TABLE NO. IN RH + HRLI A,14 ; AND OFFSET IN LH + GETAB ; GET ENTRY 14 OF SYSTAT TABLE: 1 MINUTE LOAD + ; AVERAGE + TDZA B,B ; IF ERROR RETURN ZERO + MOVE B,A +FSLOA1: HRROI A,BAKTAB + MOVE C,[FL%ONE\FL%PNT\020200] + JSYS 233 ;FLOUT MAYBE SHOULD BE RENAMED + SETZM BAKTAB + JRST FSSTR3 +];IFN TNX + +IFN TNX,[ + +FSDIRH: MOVE B,HSNAME ;HOME DIRECTORY + JRST FSDIR3 +FSDIR2: GJINF + SKIPA B,A ;LOGIN DIR +FSDIRS: GJINF ;CONNECTED DIR +FSDIR3: HRROI A,BAKTAB + DIRST ;INTO STRING SPACE + SETZM BAKTAB +FSSTR3: MOVEI E,BAKTAB +FSSTR0: MOVEI C,10 ;GET ENOUGH STRING + CALL QOPEN + MOVEI A,(E) + CALL ASCIND ;INSERT IT +FSSTR2: CALL QCLOSV ;AND RETURN STRING POINTER + JRST POPJ1 + +FSDSNM: TRO FF,FRNOT ;FLAG TO FLUSH DIRST PUNCTUATION +FSSTRR: HLRZS E ;GET DESIRED ADDRESS + TRZN FF,FRARG ;ANY ARG? + JRST FSSTR0 ;NO, RETURN THE STRING THEN + HRLI E,440700 ;MAKE BYTE POINTER + SKIPL A,C ;GET ARG - SHOULD BE A STRING + CAIA + CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING + TYPRE [ARG] ;NOT A STRING? +FSSTR1: ILDB CH,BP + TRNE CH,100 ;MAKE SURE IS UPPERCASE + TRZ CH,40 + CAIN CH,": ;LOOK LIKE STRUCTURE PUNCTUATION FROM DIRST + TRNN FF,FRNOT ;AND ON THE LOOKOUT FOR THAT? + CAIA + JRST FSDSN2 ;YES, GO HANDLE THAT + CAIE CH,"< + CAIN CH,"> ;IF PART OF DIRECTORY PUNCTUATION + TRNN FF,FRNOT ;AND LOOKING FOR IT - SKIP MOVING CHAR + IDPB CH,E + SOJG B,FSSTR1 ;MOVE STRING INTO DESIRED PLACE + MOVEI CH,^@ ;AND END WITH A NULL + IDPB CH,E + RET +FSDSN2: MOVEI CH,^@ + IDPB CH,E + MOVE CH,DEFDIR ;IF : SEEN IN DIRECTORY, MOVE STRUCTURE + MOVEM CH,DEFDEV ;OVER TO DEVICE + MOVE CH,DEFDIR+1 + MOVEM CH,DEFDEV+1 + MOVE E,[440700,,DEFDIR] ;AND RESET POINTER TO DIRECTORY + SOJA B,FSSTR1 +] ;IFN TNX + +;RETURN THE HORIZ POS. OF THE CURRENT POINTER SETTING, +;ASSUMING THAT BACKSPACES AND STRAY CR'S COME OUT AS SUCH. +; ^HPRINT AND ^MPRINT FLAGS ARE NOT LOOKED AT. +FSHPOS: MOVE BP,BEGV + SOS C,BP + SETZ A, + MOVE BP,PT + CAMN BP,BEGV + JRST POPJ1 + MOVE IN,BP + SOS BP +FSHPOL: SOS IN + CALL GETCHR + CAIE CH,^M + CAMN C,IN + JRST FSHPOT + JRST FSHPOL + +FSHPOD: AOS IN + CALL GETCHR + CAIE CH,^J + CAIN CH,GLITCH + JRST FSHPOT + CAIN CH,^I + JRST [ ADDI A,10 + TRZ A,7 + JRST FSHPOT] + CAIN CH,ALTMOD + AOJA A,FSHPOT + CAIN CH,^H + SOJA A,FSHPOT + CAIGE CH," + AOJ A, + AOJ A, +FSHPOT: CAME IN,BP + JRST FSHPOD + JRST POPJ1 + +;RETURN HPOS COUNTING CTL CHARS AS THEY APPEAR, BUT NOT COUNTING CONTINUATION. +FSSHPS: SAVE NHLNS + .I NHLNS=1000000. + CALL RRBTCR + MOVE A,RRHPOS + REST NHLNS + SAVE A + CALL RRBTCR + REST A + JRST POPJ1 + +;READ OR SET THE VIRTUAL BUFFER BOUNDARIES - THE RANGE OF +;BUFFER THAT ALL OTHER COMMANDS ARE ALLOWED TO TOUCH. +FSBOUN: TRNN FF,FRARG + JRST HOLE ;NO ARG => RETURN BOUNDS, LIKE H COMMAND + MOVE E,SARG + CALL GETARG ;ELSE CALCULATE NEW BOUNDS, + CALL CHK1A + CALL HOLE ;SET UP THE VALUES TO BE RETURNED, + JFCL +FSBOU1: CALL CHK1A ;MAKE SURE BEG CONVERT STRING ARG TO "SIXBIT", SAME AS :I*. + MOVE A,C + TRZE FF,FRUPRW+FRCLN + JRST POPJ1 ;:F6 CONVERTS "SIXBIT" TO STRING: RETURN THE ARG. + JRST QGET4 ;F6 INSERTS "SIXBIT" ARG IN BUFFER: ENTER "G" COMMAND. +] + +IFN ITS,[ +;F6 COMMAND. +FSIXB: TRZN FF,FRARG + JRST FSIXR ;NO ARG => READ IN STRING AND CONVERT TO SIXBIT. + TRZE FF,FRUPRW+FRCLN ; :F6 RETURNS STRING CONTAINING THE CHARS OF THE SIXBIT. + JRST FSIXST + MOVE E,C ;TREAT ARG AS WD OF SIXBIT AND INSERT IN BUFFER. + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + JRST SIXNTY ;GO INSERT THE SIXBIT. +] + +;READ IN A STRING , AND RETURN CONVERTED TO SIXBIT IN A. IGNORE CONTROL CHARS. SKIPS. +FSIXR: MOVE OUT,[440600,,A] + SETZ A, +FSIXRL: CALL LRCH + CAIN CH,ALTMOD + JRST POPJ1 + CAIL CH,40 + TLNN OUT,770000 + JRST FSIXRL + SUBI CH,40 + IDPB CH,OUT + JRST FSIXRL + +FSIXST: AOS (P) ;HERE TO CONVERT SIXBIT TO STRING. + SAVE C + MOVEI C,12. ;WE WILL NEED AT MOST 12 CHARS - MAKE SURE SPACE IS THERE. + CALL QOPEN + REST E ;NOW OUTPUT THE SIXBIT INTO STRING SPACE (LISTF5 AND BP + CALL SIXNTY ;SET UP BY QOPEN). + JRST QCLOSV ;WRITE THE HEADER AND RETURN THE STRING POINTER. + +FSIXFL: AOS (P) ;CONVERT SIXBIT TO STRING, PUTTING "FS" IN FRONT AND ALTMODE BEHIND. + SAVE C + MOVEI C,15. ;WORKS ALMOST LIKE FSIXST. + CALL QOPEN + MOVEI CH,"F ;BUT PUT IN THE "FS" NOW. + IDPB CH,BP + MOVEI CH,"S + IDPB CH,BP + REST E + CALL SIXNTY + MOVEI CH,ALTMOD ;PUT IN THE ALTMODE AT THE END. + IDPB CH,BP + JRST QCLOSV + +IFN ITS,[ +;FS D VERSI$ - RETURN OR SET DEFAULT VERSION NUMBERS +FSDVER: SAVE C + CALL FSFVER ;GET VALUE IN A CORRESPONDING TO OLD VALUE OF DEFAULT FN2. + JFCL + REST T + TRZN FF,FRARG ;ANY ARG GIVEN? + JRST POPJ1 ;NO, GO RETURN DEFAULT + JUMPE T,FSDVR3 ;0 = > + CAMN T,[-2] ;-2 = < + JRST FSDVR4 + JUMPL T,POPJ1 ;ARG IS -1 => DON'T CHANGE ANYTHING. + CAMLE T,[999999.] + TYPRE [ARG] ;ELSE MUST BE REASONABLE VERSION NUMBER. + SETZ C, ;ACCUMULATE IT HERE +FSDVR1: IDIVI T,10. + IORI C,'0(TT) + ROT C,-6 + JUMPN T,FSDVR1 ;KEEP GOING IF MORE NUMBER TO DO +FSDVR2: MOVEM C,DEFFN3 + JRST POPJ1 ;OK, WE SET THE DEFAULT, NOW RETURN PREVIOUS VALUE STILL IN A. + +FSDVR3: SKIPA C,[SIXBIT />/] ;0 = > +FSDVR4: MOVE C,[SIXBIT /" (FS D VERSION$ ONLY) +FSFVER: HLRZS E + SKIPN C,(E) ;GET SECOND FILENAME + JRST FSFVR2 ;BLANK ISNT A NUMBER + SETZ A, ;ACCUMULATE NUMBER HERE + CAMN C,[SIXBIT />/] ;CHECK FOR SPECIAL "NUMBERS" + JRST POPJ1 ;> = 0 + CAMN C,[SIXBIT / IF NEXT CHAR IS SPACE OR CR, IT SHOULD BREAK. +;FRNOT => NO NON-SPACE HAS BEEN SEEN YET ON THIS LINE + ;(SO SPACES SHOULD BE LIKE ORDINARY CHARS) +;FRFIND => PREVIOUS CHAR WAS ^H SO SPACE IS ORDINARY. +;FRSPAC => PREV. CHAR WAS SPACE, SO SPACE SHOULD BE ORDINARY AFTER IT +ADJUST: PUSHJ P,GETANU + EXCH C,E ;THROUGHOUT THE CMD, E -> 1ST CHAR AFTER RANGE TO JUSTIFY. + MOVEM C,PT + CALL GAPSLP + SAVE [0] ;THIS WD HAS STARTING HPOS OF LINE. + +;COME HERE TO PRODUCE 1 MORE LINE OF JUSTIFIED TEXT. +ADJLP0: ANDCMI FF,FRALT + MOVE IN,PT + MOVE D,IN ;D -> 1ST CHAR THAT MIGHT NOT FIT (DON'T KNOW YET) + ANDCMI FF,FRFIND+FRSPAC ;PREV. CHAR WASN'T ^H. OR SPACE. + TRO FF,FRNOT ;NO NON-SPACE HAS BEEN SEEN SO FAR. + MOVE J,(P) ;J HAS HPOS IN OUTPUT LINE, + SETZ OUT, ;OUT IS # WDS FOUND SO FAR. + SETZ Q, ;Q IS 0 IF WE HAVEN'T PASSED A CRLF, OR CHAR ADDR AFTER LAST CRLF. + SETZ C, ;C HAS # WDS AS OF LAST CRLF WE PASSED. + SAVE J ;(P) HAS WHAT J HAD WHEN IN HAD WHAT D HAS. + MOVE BP,IN + ADD BP,EXTRAC + CALL GETIBP ;WE WILL FETCH CHARS VIA BP. +ADJLP1: CAML IN,E + JRST ADJBRK ;PRETEND THERE'S A SPACE AFTER RANGE TO WORK ON. + ILDB CH,BP + AOJ IN, + CAIG CH,40 + JRST ADJCTL +ADJNRM: ANDCMI FF,FRALT\FRNOT\FRFIND\FRSPAC ;NORMAL CHAR ON PASS 1 OF FA. + AOJA J,ADJLP1 + +ADJCTL: CAIN CH,40 + JRST ADJSPC ;SPACE ENDS A WORD. + CAIN CH,^M + JRST ADJCR ;CR ENDS A WORD. + CAIN CH,^I + JRST ADJTAB + CAIN CH,^L ;^L MAKES A BREAK BEFORE AND AFTER THE LINE CONTAINING IT. + JRST ADJFF + CAIE CH,^H + JRST ADJNRM + TRZ FF,FRALT\FRNOT\FRSPAC + IORI FF,FRFIND + SOJGE J,ADJLP1 + AOJA J,ADJLP1 + +ADJFF: JUMPN Q,ADJFF1 ;^L: IF IT'S NOT ON THE LINE WE STARTED HACKING ON THIS CYCLE, + ;FILL UP TO THE CRLF BEFORE THE ^L, THEN CONSIDER IT AGAIN. + JRST ADJSK1 ;JUST SKIP OVER THE ^L, AND WHAT PRECEDES IT ON THE LINE. + +ADJTAB: TRNE FF,FRALT ;COME HERE FOR TAB + SOJA IN,ADJBRK ;TAB AT START OF LINE BREAKS. + IORI J,7 ;ELSE ADVANCE HPOS TO TAB STOP + ADDI J,1 + MOVEM J,-1(P) ;SAY NEXT OUTPUT LINE STARTS AT THAT STOP + JUMPE Q,ADJSK1 ;IF WE HAVEN'T PASSED A CRLF THIS TIME, SKIP PAST ALL BEFORE TAB. +ADJFF1: MOVE IN,Q ;ELSE BACK UP TO THE CRLF AND FILL UP TO IT. + MOVE OUT,C ;THEN NEXT TIME WE'LL SKIP ALL FROM CRLF TO THE TAB. + JRST ADJBRK + +;COME HERE ON SPACE +ADJSPC: TRNE FF,FRALT ;IF 1ST CHAR ON LINE, IT IS A BREAK. + JRST ADJSP1 + TRNN FF,FRFIND\FRSPAC\FRNOT ;ELSE IF SPACE FOLLOWS A WORD, + SKIPA B,BP ;THEN UNLESS + JRST ADJNSP + ILDB B,B ;IT IS FOLLOWED BY A BACKSPACE, WE END A WORD. + CAIE B,^H + JRST ADJSP1 +ADJNSP: TRZ FF,FRFIND\FRALT + AOJA J,ADJLP1 + +ADJCR: TRZE FF,FRFIND ;COME HERE ON CR. + AOJA IN,ADJBRK ;CR PRECEDED BY ^H CAUSES BREAK AFTER FOLLOWING LF. + TRNE FF,FRALT ;THIS CR ENDS NULL LINE => BREAK + SOJA IN,ADJBRK ;BEFORE IT. + ;THE PARAGRAPH WILL BE ENDED, AND WE'LL + ;COME BACK HERE WITH FRALT CLEAR, + ;AND DO THE JUMPE J, BELOW. + TRNE FF,FRNOT ;LINE OF ONLY SPACES IS A BREAK. + AOJA IN,ADJSKP + IBP BP ;SKIP THE LF ASSUMED TO FOLLOW THE CR. + AOS IN + MOVE Q,IN ;REMEMBER CHAR ADDR AND # WDS AS OF MOST RECENT CRLF. + MOVE C,OUT + JUMPE J,ADJSKP ;NULL LINE AT BEGINNING => PASS OVER IT. +ADJSP1: TRNE FF,FRALT ;SPACE AFTER CRLF; BREAK BEFORE THE SPACE + SOJA IN,ADJBRK ;SO SPACE WILL BE REPROCESSED FOR NEXT LINE. + JUMPE OUT,ADJSP2 ;PREVENT LOSSAGE FROM SUPERLONG WORD. + CAMLE J,ADLINE + JRST ADJGO ;WORD JUST ENDED WON'T FIT =>JUSTIFY THE OTHERS & NEW LINE. +ADJSP2: CAIN CH,^M + TRO FF,FRALT ;AFTER ^M, ANOTHER SPACE BREAKS. + TROE FF,FRSPAC ;AFTER A SPACE, DON'T COUNT A NEW WORD, BUT DO ADVANCE HPOS. + AOJA J,ADJLP1 + MOVEM J,(P) ;REMEMBER HOW FAR WE GOT IN BUFFER AND LINE. + MOVE D,IN + AOS J ;IF NEXT WD FITS, WILL NEED 1 POS FOR SPACE. + AOJA OUT,ADJLP1 + +ADJSKP: SETZM -1(P) +ADJSK1: MOVEM IN,PT ;PASS OVER SOME TEXT, NOT FILLING. + SUB P,[1,,1] + CALL GAPSLP + JRST ADJBR3 + +ADJBRK: SETZM (P) ;FILL THE LINE BEFORE A BREAK BUT NOJUST. + MOVE D,IN + TRO FF,FRALT ;INDICATE WE STOPPED AT A BREAK. + JRST ADJBR1 + +;COME HERE AFTER DELIMITING WHAT WILL BECOME ONE LINE, TO JUSTIFY IT. +ADJGO: MOVN J,(P) + ADD J,ADLINE + TRNE FF,FRUPRW ;JUST FILLING => INSERT NO SPACES. + SETZ J, + MOVEM J,(P) ;# SPACES MUST SCATTER THRU LINE. + +;(P) HAS # OF SPACES WE MUST INSERT TO JUSTIFY + ;(0 IF STOPPED AT A BREAK, IN WHICH CASE FRALT SET) +;OUT HAS # OF WORD-BREAKS IN THE LINE. +;-1(P) STILL HAS HPOS TO START NEXT LINE AT. +;E STILL HAS 1ST CHAR NOT TO BE PROCESSED BY THE FA COMMAND. +;D HAS CHAR ADDR OF 1ST CHAR NOT TO BE INCLUDED. +;IF FRALT IS SET (BREAK FOLLOWS), D IS EXACT. +;THE CRLF BEFORE D MAY HAVE PRECEDING SPACES, WHICH ARE DELETED. +;OTHERWISE, D POINTS AFTER THE SPACE OR CRLF AFTER THE LAST WORD TO INCLUDE. +;IN THIS CASE, THERE MAY BE MORE SPACES FOLLOWING, WHICH OUGHT TO BE DELETED. +;A CRLF AFTER THE SPACES SHOULD ALSO BE DELETED. +ADJBR1: SETZ J, + SOSG OUT + MOVEI OUT,1 + ANDCMI FF,FRFIND+FRSPAC + TRO FF,FRNOT ;NO NON-SPACE CHAR SEEN YET. + MOVE IN,PT ;IN IS CHAR ADDR FOR TAKING FROM ABOVE GAP, + MOVE BP,PT + CALL GETIBP ;BP IS BP FOR IDPBNG INTO BOTTOM OF GAP. +ADJGL: CAML IN,E + JRST POP2J ;AT END OF RANGE IN MID-LINE => DON'T PUT IN A CRLF. + CALL GETINC + CAIN CH,^M + JRST ADJGCR + CAIN CH,40 + JRST ADJGS +ADJGS4: CAMLE IN,D ;AT END OF THIS OUTPUT LINE & PAST ALL TRAILING SPACES + JRST ADJDUN ;=> INSERT THE CRLF AND HACK NEXT LINE. + ANDCMI FF,FRNOT+FRSPAC ;NON-SPACE SEEN. + CAIN CH,^H + TROA FF,FRFIND +ADJGS1: ANDCMI FF,FRFIND + IDPB CH,BP ;ORD. CHR., JUST COPY TO BELOW THE GAP. + AOS GPT + AOS PT + JRST ADJGL + +ADJGS: CAME E,IN ;SPACE AT END OF RANGE => DON'T CHECK FOLLOWING CHAR. + TRNE FF,FRNOT+FRFIND + JRST ADJGS1 ;SPACE AFTER BS OR BEFORE 1ST WD IS NORMAL CHAR. + CALL GETINC ;ELSE SEE IF FOLLOWED BY BS. + CAIE CH,^H + SOJA IN,[ ;NO, IT IS A WORD DELIMITER. + TRNN FF,FRALT ;IF LINE DOESN'T END WITH A BREAK, + JRST ADJCR1 ;MAKE SURE EXTRA SPACES PAST END ARE DELETED. + JRST ADJCR2] + MOVEI CH,40 + SOJA IN,ADJGS4 ;YES, IT IS ORDINARY. + +ADJGCR: ANDCMI FF,FRFIND ;CR: DELETE FOLLOWING LF IF ANY. + CALL GETCHR + CAIN CH,^J + CALL ADJDLC +ADJCR2: CAMGE IN,D ;CRLF (OR SPACE, IF THERE'S A BREAK HERE) PAST THE END OF THE LINE + JRST ADJCR1 ;MEANS WE HAVE FINISHED SKIPPING THE EXCESS MULTIPLE SPACES + CALL ADJDLC ;AND WE SHOULD JUST FLUSH THIS ONE AND PREVIOUS ONES + JRST ADJDUN ;AND PUT IN THE CRLF. + +ADJCR1: MOVEI CH,40 ;ALSO REPLACE THE CR WITH A SPACE. + TROE FF,FRSPAC ;A SPACE OR CR WHICH FOLLOWS A SPACE + JRST ADJGS1 ;SHOULD NOT HAVE SPACES INSERTED AFTER IT FOR JUSTIFICATION. + CAMGE IN,D + ADD J,(P) +ADJGS2: CAMGE J,OUT + JRST ADJGS1 + IBP BP ;TIME TO GENERATE A SPACE. + SUB J,OUT + AOS E + AOS D ;RELOC OUR PTRS TO BUFFER SINCE INSERTING CHAR. + AOS IN + CALL TYOM + JRST ADJGS2 ;SEE IF SHOULD INSERT ANOTHER SPACE. + +;COME HERE WHEN WE HAVE DONE PASS 2 ON A WHOLE LINE +ADJDUN: SUBI IN,2 ;WE HAVE JUST PASSED AT LEAST ONE SPACE INTO THE OUTPUT LINE. + JRST ADJEND ;MAKE IN POINT AT IT. IN SHOULD BE GPT-1 NOW. + +ADJDUD: CALL ADJDLB +ADJEND: CALL GETCHR ;DELETE ANY SPACES WHICH WOULD OTHERWISE BE LEFT AT + CAIN CH,40 ;THE END OF THE LINE, BEFORE THE CRLF WE ARE ABOUT TO MAKE. + JRST ADJDUD +ADJDU1: REST J + MOVEI CH,^M ;PRODUCED A LINE, PUT CRLF AFTER IT, REPLACING THE SPACE THERE. + CALL TYOM + MOVEI CH,^J + CALL TYOM + ADDI E,2 ;RELOCATE PTR TO BUFFER ABOVE PLACE INSERTED IN. + SETZM (P) ;NEXT LINE STARTS IN COLUMN 0. +ADJBR3: CAMLE E,PT ;MORE CHARS TO HANDLE => + JRST ADJLP0 ;DO ANOTHER LINE. + JRST POP1J + +ADJDLB: SOS PT + SOS GPT + SOS IN +ADJDLC: AOS EXTRAC ;DELETE THE CHAR AT PT. + SOS Z + SOS E + SOS ZV + SOJA D,CPOPJ + +SUBTTL F^A DISPATCH-TABLE COMMAND + +;"F^A" SCAN THROUGH THE BUFFER, DISPATCHING THROUGH A +;USER-SUPPLIED TABLE ON EACH CHARACTER. +;"^ F^A" SCANS BACKWARDS. +FCACMD: CALL QREGX ;GET DISPATCH TABLE IN A. + LDB OUT,[.BP FRCLN,FF] + TRZ FF,FRCLN + CALL GETANU ;E,C HAVE RANGE TO SCAN. + DPB OUT,[.BP FRCLN,FF] + TRNE FF,FRUPRW + EXCH C,E ;E HAS PLACE TO START; C HAS PLACE TO STOP. + MOVEM E,PT + MOVEI TT,FCA1 ;LOOP POINT IF FCA1 FOR FORWARD SCAN. + TRZE FF,FRUPRW + MOVEI TT,FCA3 ;FCA3 FOR BACKWARD SCAN. + SAVE FF + SAVE TT + MOVE OUT,QRB.. ;SAVE DISPATCH TABLE STRING IN .Q..3 + MOVEM A,.Q..3(OUT) +FCA0: CALL QLGET1 ;GET LENGTH IN B, BP IN BP. + TYPRE [QNS] + CAIGE B,128.*5 + TYPRE [STS] ;STRING TOO SHORT. + JRST @(P) ;FCA1 OR FCA3 + +;LOOP POINT FOR FORWARD SCAN. +;BP HAS BP TO ILDB TABLE; +;C HAS CHAR ADDR OF LAST CHAR TO SCAN + 1. +FCA1: MOVE IN,PT + CAML IN,C + JRST POP2J ;FINISHED SCAN => RETURN. + CALL GETINC + MOVEM IN,PT +FCA4: TRNE FF,FRTRACE + CALL FCATRC ;PRINT PRETTY INFO IF TRACING. + MOVEM CH,.Q..0(OUT) ;SAVE CHAR IN CASE MACRO WANTS IT. + ADD CH,BP ;FIND THE 5 CHARS OF TABLE FOR THIS CHR. + ILDB A,CH ;IS THE FIRST A SPACE? + CAIE A,40 + JRST FCA2 ;NO, MACRO THE 5 CHARS. + ILDB A,CH ;YES, THE NEXT CHAR HOLDS THE WIDTH + SUBI A,100 + ADDM A,.Q..1(OUT) ;OF THIS CHAR, PLUS 100 . + ILDB A,CH ;GET THE 3RD CHAR OF THE FIVE. + CAIN A,40 ;"(" AND ")" ARE SPECIAL, " " IS NORMAL. + JRST @(P) ;FCA1 OR FCA3 + HRRZ CH,(P) ;IT'S SPECIAL. WHICH DIRECTION ARE WE SCANNING? + CAIE A,") ;IF CODE IS ")", + JRST FCAOPN + SKIPGE .Q..1(OUT) ;STOP IF COUNT < 0 AND GOING FORWARD. + CAIE CH,FCA1 + JRST (CH) + JRST POP2J + +FCAOPN: SKIPLE .Q..1(OUT) ;CODE IS "("; STOP IF COUNT > 0 AND GOING BACKWARD. + CAIE CH,FCA3 + JRST (CH) + JRST POP2J + +FCA3: MOVE IN,PT ;LOOP POINT FOR SCANNING BACKWARDS + CAMG IN,C + JRST POP2J + SOS IN,PT + CALL GETCHR + JRST FCA4 + +;IN TRACE MODE, CALL HERE TO PRINT !! FOR EACH CHAR WE PASS. +FCATRC: SAVE CH + MOVEI CH,"! + CALL TYOS + MOVE CH,(P) + CALL TYOS + MOVEI CH,"! + CALL TYOS + JRST POPCHJ + +;HERE FOR A CHAR WHICH REQUIRES THAT WE ACTUALLY MACRO SOME STUFF. +FCA2: MOVN TT,(P) + ADDI TT,FCA1 ;TT IS POS. IFF SCANNING FORWARD. +IFL FCA3-FCA1,.ERR + ASH TT,-43 ;-1 IFF BACKWARD, 0 IFF FORWARD. + IORI TT,1 ;-1 IFF BACKWARD, 1 IFF FORWARD. + MOVEM TT,INSLEN ;MAKE "^F" REPLACE THE CHAR SCANNED. + JUMPG TT,[ SUB C,ZV ;IF FORWARD, STORE END OF RANGE AS DISTANCE FROM Z. + MOVNM C,.Q..2(OUT) + JRST FCA5] + SUB C,BEGV ;GOING BACKWARD, STORE DISTANCE FROM C. + MOVEM C,.Q..2(OUT) +FCA5: MOVE B,.Q..0(OUT) + ADD BP,B + MOVE E,-1(P) + TRNE E,FRCLN ;:F^A TREATS DISPATCH TABLE AS A QVECTOR. + JRST [ IBP BP ;IT EXTRACTS A WORD, AND TREATS IT AS A STRING POINTER TO A MACRO. + MOVE A,(BP) + CALL MACXQ + JRST FCA7] + MOVE A,.Q..3(OUT) + MOVEI B,5 ;MACRO A STRING THAT IS AN INITIAL + ;SEGMENT OF THE DISPATCH TABLE, ENDING AFTER THE + ;FIFTH OF THE CHARS FOR THE CHAR JUST SCANNED. + ;WANT TO SET COMCNT TO 5. + CALL MACXC2 ;EXECUTE THEM. +FCA7: MOVE OUT,QRB.. + MOVE TT,(P) + CAIN TT,FCA1 + JRST [ MOVN C,.Q..2(OUT) + ADD C,ZV ;SEE HOW THE MACRO HAS CHANGED END OF RANGE. + JRST FCA6] ;MUST USE DIFFERENT CODE DEPENDING ON HOW IT WAS STORED. + MOVE C,.Q..2(OUT) + ADD C,BEGV +FCA6: CAMGE C,BEGV ;DON'T LET END OF RANGE GET OUTSIDE VIRTUAL BOUNDARIES. + MOVE C,BEGV + CAMLE C,ZV + MOVE C,ZV + MOVE A,.Q..3(OUT) + JRST FCA0 + +POP2J: SUB P,[2,,2] + POPJ P, + +SUBTTL F^B COMMAND + +;F^B$ - RETURNS -1 IF DOES NOT OCCUR IN ; +; OTHERWISE RETURNS THE POSITION OF THE FIRST OCCURRENCE +; (0 IF IS THE FIRST CHARACTER OF ). +;AT CALL, IS IN C. THIS COULD BE SMARTER: +; IF IS FOUND IN THE MIDDLE OF A SUBSTITUTED QREG WITHIN , +; WE COULD JUST POP OUT OF IT RATHER THAN READING THROUGH IT. +;,F^B$ SKIPS CHARS OF BEFORE LOOKING FOR . +FMEMQ: TRNE FF,FRUPRW + JRST FFIND + TRZN FF,FRARG + TYPRE [WNA] + TRZN FF,FRARG2 + SETZ E, ;E IS PLACE TO START SEARCHING (0, FOR 1ST CHAR, IF NO ARG). + MOVE B,MACPDP + SETZ A, ;A COUNTS THE CHARS WHICH AREN'T . +FMEMQ1: CALL RCH + SKIPN SQUOTP ;NO; REACHED END OF STRING? + CAIE CH,ALTMOD + CAIA ;NO, SEE IF REACHED DESIRED CHARACTER (OUR NUMERIC ARG) + JRST NRETM1 ;YES, RETURN -1 + CAIE C,(CH) + AOJA A,FMEMQ1 ;DIDN'T REACH CHAR BEING SEARCHED FOR. + CAMGE A,E + AOJA A,FMEMQ1 ;REACHED IT, BUT BEFORE WHERE WE ARE SUPPOSED TO BE LOOKING. + CALL FNOOP ;FOUND . NOW IGNORE REST OF STRING + JRST POPJ1 ;AND RETURN THE VALUE, ALREADY IN A. + +;HERE FOR ^ F^B$ - FIND NEXT OCCURRENCE IN THE BUFFER +;OF A CHARACTER NOT IN , AND RETURN .,. +;^:F^B$ RETURNS .,. +;AN ARGUMENT OF -1 CAUSES SCANNING TO GO BACKWARDS INSTEAD. +;THUS, ^ F^B $K KILLS ALL SPACES AFTER POINT, AND ^-F^B $K KILLS ALL THOSE BEFORE. +;WITH 2 ARGS ,, WE JUMP TO AND THEN SCAN TOWARD . +FFIND: JSP BP,FLCMD1 ;FLCMD1 CALLS US TO MOVE POINT TO OTHER END OF RANGE, + ;THEN CALCULATES AND RETURNS THE RANGE AS TWO VALUES. + CALL OARG ;READ IN THE STRING. ST+1 HAS 1ST CHAR. + TRNN FF,FRARG2 + JRST FFINDA + ADD C,BEG ;2 ARGS GIVE RANGE TO SCAN. CONVERT TO INTERNAL CHAR ADDRS. + ADD E,BEG + CALL CHKC ;BARF IF E NOT IN BUFFER. + CALL CHK ;BARF IF C NOT IN BUFFER. + MOVEM E,PT ;1ST ARG SAYS WHERE TO START THE SCAN. + MOVE OUT,C ;2ND ARG SAYS WHERE TO STOP. + SUB C,E ;SIGN OF C GETS DIRECTION OF SEARCH (AS IF JUST 1 ARG). + JRST FFINDZ + +FFINDA: SKIPL C ;HERE FOR JUST 1 ARG. OUT GETS PLACE TO STOP SCAN. + SKIPA OUT,ZV + MOVE OUT,BEGV +FFINDZ: MOVE IN,PT ;J POINTS AT WORD AFTER THE LAST CHAR IN STAB. + CALL GETIBI ;GOING FWD => GET B.P. TO ILDB CHAR AFTER POINT. + JUMPL C,FFINDB ;GOING BACKWARD => ALTER THAT. +FFINDC: CAMN IN,OUT ;IN AND PT ARE THE SAME. BP HAS B.P. TO ILDB CHAR AT PT. + RET + CAMN IN,GPT ;HANDLE MOVING ACROSS THE GAP. + CALL FEQGAP + ILDB CH,BP +FFINDS: MOVEI A,STAB+1 ;HERE FOR EITHER FWD OR BACKWD SCAN, TO SEE IF CHAR IS IN +FFIND1: CAMN A,J ;THE STRING. + JRST [ TRNN FF,FRCLN ;NO => FOR NON-COLON, WE HAVE FOUND END OF RANGE. + RET + JRST FFIND2] + CAME CH,(A) + AOJA A,FFIND1 + TRNE FF,FRCLN ;YES => FOR ^:F^B WE HAVE FOUND THE END OF THE RANGE. + RET +FFIND2: JUMPL C,FFINDD ;NOT AT END => MOVE TO NEXT CHARACTER. + AOS IN,PT + JRST FFINDC + +FFINDB: IBP BP ;MOVE BACKWARRD, THE FIRST TIME. + CAIA +FFINDD: SOS IN,PT ;MOVE BACKWARD AGAIN. + CAMN IN,OUT + RET + CAMN IN,GPT + CALL DWNGAP + DBP7 BP + LDB CH,BP + JRST FFINDS + +SUBTTL WORD AND LIST PARSING COMMANDS + +FWCMD: MOVEI BP,WORDSP + JRST .+2 +FLCMD: MOVEI BP,LISTSP +FLCMD1: ARGDFL Z + CALL IMMQIT ;ALLOW IMMEDIATE QUITTING IN CASE WE HAVE FAR TO SEARCH. + SAVE PT + SETZM SEXPFL + CALL (BP) + MOVE E,PT + REST C + MOVEM C,PT + CAMGE C,E + EXCH C,E + SUB C,BEG + SUB E,BEG + MOVEM E,SARG + MOVE A,C + TRZ FF,FRUPRW+FRCLN + TRO FF,FRARG2 + SETZM IMQUIT ;STOP ALLOWING IMMEDIATE QUITTING. + JRST POPJ1 + +FUCMD: JSP BP,FLCMD1 + SETZM DOWNF + MOVM D,C + MOVNS D +FUCMD1: JUMPE D,CPOPJ + HLRES C + JRST LISTSQ + +FDCMD: JSP BP,FLCMD1 + SETOM DOWNF + MOVM D,C + JRST FUCMD1 + +;THIS ROUTINE TAKES ARG IN C, AND DOES FWL. +;FS INSLEN IS SET TO LENGTH OF LAST WORD OR INTER-WORD-SPACE SEEN +;(NOTE IF YOU START WITHIN A WORD, FS INSLEN$ MIGHT NOT BE WHAT YOU WANT). +;IF SEXPFL IS SET, ASSUMES WAS REACHED FROM ^ FL, AND GOES BACK THERE +;AFTER FINDING ONE WORD. +;THE UPARROW FLAG CAUSES SCANNING TO BE FOR LISP ATOMS INSTEAD OF WORDS. +WORDSP: CALL SKNBCP ;INITIALIZE SO WE CAN CALL SKNBRK. + TRNE FF,FRUPRW + IBP SKNBPT ;FOR LISP, USE 2ND CHAR OF DISPATCH ENTRY RATHER THAN 1ST. + JUMPL C,WBACK + JUMPE C,CPOPJ + CALL LFINIT ;SET UP E, IN, BP. +WFVBA1: SKIPE SEXPFL ;HERE TO START WORD-GAP, TREATING LAST CHAR SEEN AS PART OF PREV. WORD. + JRST LFLOOP + MOVE B,E ;SAVE E IN B EVERY SO OFTEN. E-B WILL BE VALUE OF INSLEN. + SOSA B +WFSBEG: MOVE B,E ;LIKE WFVBA1, BUT COUNT LAST TERMINATOR AS PART OF THIS GAP. + SKIPE SEXPFL + JRST LFDSP +WFSLUP: SOJLE E,WFSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT + CAIE A,"; + CAIN A,"A + JRST WFSEND + CAIE A,"/ + CAIN A,"| + JRST WFSEND + JRST WFSLUP + +WFSEND: TRNE FF,FRCLN +WFVBA2: SOJLE C,WFDONC + MOVE B,E + CAIN A,"| + JRST WFVBAR ;WIN IN CASES LIKE |FOO||BAR| + JRST WFWDSP ;NOW PROCESS CHAR THAT STARTS THE WORD AS IF FOUND IT INSIDE WORD + +;HERE WHEN A :FW FINDS START OF WORD AND THINK'S IT IS FINISHED. +WFDONC: TRNN FF,FRUPRW ;IF IT WAS AN ^:FW, AND LAST CHAR WAS A ', BACK UP OVER IT. + JRST WFDONE + CAMN E,IN + CALL DWNGAP + AOS E ;AND KEEP BACKING UP PAST ALL '-TYPE CHARS. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST WFDONC + SOJA E,WFDONE + +WFWLUP: SOJLE E,WFWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT +WFWDSP: CAIE A,"; + CAIN A,"A + JRST WFWLUP + CAIN A,"' ;' CHARS CAN CONTINUE A WORD, BUT NOT START ONE. + JRST WFWLUP + CAIN A,"/ + JRST WFSLSH + CAIN A,"| ;| INSIDE WORD IS CASE OF FOO|BAR|, WHICH IS 2 WORDS, + JRST [ TRNE FF,FRCLN ;SO END THIS WORD AND IMMEDIATELY START ANOTHER. + MOVE B,E + JRST WFVBA2] +WFWEND: TRNE FF,FRCLN + JRST WFSBEG + SOJG C,WFSBEG +WFDONE: SUB B,E + SUB E,ZV + MOVNS E + JRST WORD12 + +WFSEOB: TRC FF,FRCLN ;WENT FWD PAST Z, BETWEEN WORDS. +WFWEOB: SOJG C,TYPNIB ;WENT FWD PAST Z, IN MIDDLE OF WORD. + TRNE FF,FRCLN + JRST TYPNIB + JRST WFDONE + +WFSLSH: CALL LFSLSH ;HANDLE A SLASH-CHARACTER GOING FORWARD. + JRST WFWLUP + +WFVBAR: CALL LFVBAR ;VERTICAL BAR: SKIP TO MATCHING ONE. + TRNN FF,FRCLN ;IF TIME TO STOP MOVING, MAKE SURE CLOSING VBAR + SOJLE C,[SOJA E,WFDONE] ;COUNTS AS PART OF WORD, NOT PART OF GAP. + ;IF MUST KEEP GOING, DO SO, BUT DON'T COUNT + JRST WFVBA1 ;THE VBAR AS PART OF THE GAP THAT'S STARTING. + +;MOVE BACKWARDS OVER WORDS. + +WBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +WBVBA1: SKIPE SEXPFL + JRST LBLOOP + MOVE B,E + SOSA B +WBSBEG: MOVE B,E + SKIPE SEXPFL + JRST LBDSP +WBSLUP: SOJL E,WBSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIE A,"A + CAIN A,"| + JRST WBSEND + CAIN A,"; + JRST WBSEND + CAIE A,"/ + JRST WBSLUP +WBSLSH: SAVE E ;FOUND A SLASH GOING BACKWARD. + SAVE BP ;IF IT'S SLASHED, IT ENDS A WORD; ELSE FOLLOWING CHAR + CALL REALP ;IS SLASHED AND ENDS THE WORD. + JFCL ;BIT 1.1 OF CH IS 1 IF SLASH IS SLASHED. + REST BP + REST E + TRNE CH,1 + JRST WBSEND + IBP BP + AOJ E, +WBSEND: TRNE FF,FRCLN +WBVBA2: SOJLE C,WBDONE + MOVE B,E + CAIN A,"| + JRST WBVBAR + JRST WBWDSP + +WBWLUP: SOJL E,WBWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT +WBWDSP: CAIE A,"; + CAIN A,"A + JRST WBWLUP + CAIN A,"| + JRST [ TRNE FF,FRCLN + MOVE B,E + JRST WBVBA2] + CAIE A,"' + CAIN A,"/ + JRST WBWLUP + SAVE BP + SAVE E + CALL REALP + JFCL + REST E + REST BP + TRNE CH,1 + JRST WBWLUP +WBWEND: TRNE FF,FRCLN + JRST WBSBEG + SOJG C,WBSBEG +WBDONE: SUBM E,B + AOJ E, + ADD E,BEGV +WORD12: MOVEM E,PT + MOVEM B,INSLEN + TRZ FF,FRCLN+FRUPRW + RET + +WBSEOB: TRC FF,FRCLN +WBWEOB: SOJG C,TYPNIB + TRNE FF,FRCLN + JRST TYPNIB + JRST WBDONE + +WBVBAR: CALL LBVBAR ;MOVE BACK OVER A VERTICAL BAR GROUPING. +WBVBA4: JUMPE E,WBVBA3 ;THEN BACK OVER ALL ' CHARACTERS BEFORE IT. + SAVE E + SAVE BP + SOJ E, + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST [ SUB P,[2,,2] + JRST WBVBA4] + REST BP + REST E +WBVBA3: TRNN FF,FRCLN ;IF IT'S TIME TO STOP MOVING, SAY WE STOPPED AFTER PASSING THE + SOJLE C,[SOJA E,WBDONE] ;VBAR, INSTEAD OF BEFORE, AS WE WOULD STOP AT A SPACE. + JRST WBVBA1 ;IF KEEP MOVING, DON'T INCLUDE THE VBAR IN THE NEW GAP. + +LISTSP: TRNE FF,FRUPRW + SETOM SEXPFL + SETZB D,DOWNF + JUMPE C,CPOPJ +LISTSQ: CALL SKNBCP ;SET UP SKNBPT FROM ..D + IBP SKNBPT + JUMPL C,LBACK + CALL LFINIT ;SET UP BP, E, IN. +LFLOOP: SOJLE E,LFEOB ;AFTER THIS INSN E HAS # CHARS LEFT TO SCAN. + CAMN E,IN ;IF WE'RE ABOUT TO ILDB INTO THE GAP, CROSS IT: + CALL FEQGAP ;(BP <- BP TO ILDB 1ST CHAR AFTER GAP). + ILDB A,BP + LDB A,SKNBPT ;GET DISPATCH ENTRY OF THIS CHARACTER. +LFDSP: CAIN A,"/ + JRST [ TRNE FF,FRUPRW ;FOR ^ FL, REMEMBER SLASH STARTS AN ATOM. + JUMPE D,WFSEND + CALL LFSLSH + JRST LFLOOP] + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WFSEND + CALL LFVBAR + JRST LFLOOP] + CAIE A,"; + CAIN A,"A ;SEMICOLON AND LETTERS START ATOMS. + TRNN FF,FRUPRW + JRST LFFOO1 + JUMPE D,WFSEND +LFFOO1: CAIN A,"( + JRST LFLPAR + CAIE A,") + JRST LFLOOP + SKIPE DOWNF + AOJA D,LFLOOP + AOJL D,LFLOOP + SETZ D, ;MAKE SURE 2FLL SAME AS FLL FLL. + SOJG C,LFLOOP +LFDONE: SUB E,ZV + TRC FF,FRCLN + JRST LISTX + +LFEOB: JUMPL D,[TYPRE [UBP]] ;UNBALANCED PARENTHESES +TYPNIB: TYPRE [NIB] + +LFSLSH: SOJLE E,TYPUEB ;HANDLE "/" GOING FORWARD. + CAMN E,IN ;IF WE'VE REACHED THE GAP, MAKE BP CROSS IT. + CALL FEQGAP + IBP BP + RET + +TYPUEB: TYPRE [UEB] + +LFLPAR: TRNE FF,FRCLN ;:FL => STOP BEFORE ( INSTEAD OF AFTER IT AS FOR FD. + JUMPE D,[SOJE C,LFCDON ;ALSO, :FL BACKS OVER ''S WHILE FD DOESN'T. + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LFLOOP + SOJG D,LFLOOP + JRST LFDONE + +LFCDON: MOVNS E + ADD E,ZV ;TURN INTO CHAR ADDR OF THE (. + TRZ FF,FRCLN ;DON'T LET LISTX MUNG IT. + TRNE FF,FRUPRW ;FOR ^:FL, +LFCDO1: CAMG E,BEGV ;SCAN BACKWARD PAST ANY QUOTES BEFORE THE (. + JRST LISTX + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + SOJA E,LFCDO1 + JRST LISTX + +LFVBAR: SOJLE E,TYPUEB ;HANDLE "|" GOING FORWARD. + CAMN E,IN + CALL FEQGAP ;WHEN REACH GAP, MOVE OVER IT. + ILDB A,BP + LDB A,SKNBPT ;DECODE NEXT CHARACTER. + CAIN A,"/ + JRST [ CALL LFSLSH ;SLASH => DON'T CHECK NEXT CHAR FOR BEING A "|". + JRST LFVBAR] + CAIE A,"| + JRST LFVBAR ;FIRST UNSLASHIFIED "|" ENDS THE STRING. + RET + +;MOVE BACKWARD OVER LISTS. + +LBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +LBLOOP: SOJL E,LFEOB + CAMN E,IN ;IF ABOUT TO DLDB INTO LAST CHAR OF GAP, + CALL DWNGAP ;MAKE BP -> LOWEST CHAR. OF GAP. + DBP7 BP +LBDSP: LDB A,BP + LDB A,SKNBPT + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WBSEND + CALL LBVBAR + JRST LBLOOP] + TRNN FF,FRUPRW ;IF ^ FL, NOTE THAT LETTERS AND SLASH START ATOMS + JRST LBFOO1 + CAIN A,"A + JUMPE D,WBSEND + CAIN A,"/ ;FOR SLASH, THE CHAR AFTER IT (ALREADY SCANNED) + JUMPE D,WBSLSH ;IS ALSO PART OF THE ATOM. +LBFOO1: CAIN A,") + JRST LBRPAR + CAIE A,"( + JRST LBLOOP + CALL REALP + JRST LBQOTD + SKIPE DOWNF + AOJA D,LBLOOP + AOJL D,LBLOOP + SETZ D, + SOJG C,LBLOOP + TRNN FF,FRUPRW ;FOUND MATCHING OPENPAREN. NOW, IF PASSING SEXPS, + JRST LBDONE +LBQOT1: MOVE B,E ;SKIP OVER ANY NO-SLASHIFIED '-LIKE CHARACTERS + SOJL E,LBQOT2 ;THAT PRECEDE THE OPENPAREN. + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + CALL REALP +LBQOT2: SKIPA E,B + JRST LBQOT1 +LBDONE: ADD E,BEGV +LISTX: MOVMM E,PT + TRZE FF,FRCLN + AOS PT + POPJ P, + +LBVBAR: CALL REALP ;HANDLE "|" GOING BACKWARDS. + RET +LBVBLP: SOJL E,TYPUEB + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"| + CALL REALP + JRST LBVBLP + RET + +LBRPAR: CALL REALP ;HANDLE ")", MOVING BACKWARD. + JRST LBQOTD + TRNE FF,FRCLN + JUMPE D,[SOJE C,LBDONE + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LBLOOP + SOJG D,LBLOOP + JRST LBDONE + +LBQOTD: MOVEI A,"A ;SLASHIFIED PAREN HAS "ALPHABETIC" SYNTAX + TRNE FF,FRUPRW ;AND CAN START (END?) AN ATOM. + JUMPE D,WBSEND + JRST LBLOOP + +;INITIALIZATION AND AUXILIARY ROUTINES FOR FW AND FL. + +;SET UP BP, E, IN FOR GOING FORWARD. +LFINIT: MOVE BP,PT + CAML BP,GPT + ADD BP,EXTRAC ;GET REAL CHAR ADDR OF CHAR AFTER PT. + CALL GETIBP + MOVE IN,ZV + SUB IN,GPT ;THIS IS WHAT E WILL HAVE WHEN GAP IS REACHED. + MOVE E,ZV + SUB E,PT + AOJA E,CPOPJ + +;BP GETS A B.P. TO THE 1ST CHARACTER OF THE GAP, TO DLDB INTO THE REGION +;BELOW THE GAP. +DWNGAP: MOVE BP,GPT + JRST GETBP + +;SET UP BP, E, IN FOR GOING BACKWARD. +LBINIT: MOVE BP,PT + CAMLE BP,GPT ;BP GETS REAL CHAR ADDR +1 OF CHAR BEFORE PT. + ADD BP,EXTRAC + CALL GETBP ;BP SET UP FOR DLDB. + MOVE E,PT + SUB E,BEGV + MOVE IN,GPT ;IN USED FOR DETECTING THAT GAP IS REACHED. + SUB IN,BEGV ;CHECK: IF PT = GPT NOW, E WILL = IN THE FIRST TIME THRU. + SOJA IN,CPOPJ + +;DURING BACKWARD SCAN, CHECK WHETHER THE CHAR JUST REACHED WAS SLASHIFIED. +;MOVES BP AND E BACK OVER THE SLASHES, LEAVES THEM AS IF 1ST OF THE SLASHES +;WAS JUST GOBBLED. IF # SLASHES IS EVEN (CHAR IS NOT SLASHIFIED), +;BIT 1.1 OF CH WILL BE 0, AND REALP WILL SKIP. +REALP: SETZI CH, +REALP3: SOJL E,REALP1 + CAMN IN,E + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"/ + AOJA CH,REALP3 + IBP BP +REALP1: AOJ E, + TRNN CH,1 + AOS (P) + POPJ P, + +;F^F IS TH HAIRY FORWARD-ONLY LIST PARSER. +;IT TAKES A "STATE" WHICH INCLUDES THE PAREN DEPTH AS AN ARGUMENT, +;PARSES FROM POINT TO A SPECIFIED PLACE, AND RETURNS THE UPDATED STATE. +;DO ,F^F AND IT RETURNS THE NEW STATE. +;THE STATE'S RH IS TH PAREN DEPTH. THE LH IS BITS, AS FOLLOWS: +; 100,, => INSIDE A COMMENT. +; 4,, => INSIDE VERTICAL BARS. +; 2,, => INSIDE OR RIGHT AFTER AN ATOM. +; 1,, => SLASHIFIED. +;WE ARE INSIDE (AS OPPOSED TO ADJACENT TO) AN ATOM IF 4,, OR 1,, IS SET, +;OR IF 2,, IS SET AND THH NEXT CHARACTER HAS A OR / SYNTAX. +;WHEN WE RETURN, Q..0 GETS THE ADDRESS AFTER THE LAST OPEN-| OR ; SEEN; +;Q..1 GETS THE ADDRESS OF THE LAST UNMATCHED (, OR -1; +;Q..2 GETS THE ADDRESS OF THE START OF THH LAST SEXP, OR -1. + +;SCANNING STOPS WHEN IT REACHES THE SPECIFIED ADDRESS, +; OR WHEN THE PAREN DEPTH REACHES 0. +;FOR :F^F, SCAN ALSO STOPS WHEN AFTER ANY ATOM-START CHARACTER. + + +FCTLF: TRZE FF,FRARG + TRZN FF,FRARG2 + TYPRE [WNA] ;WE MUST HAVE 2 ARGS. AND DISCARD THEM. + SETZ OUT, + TRZE FF,FRCLN ;OUT GETS BITS OF STATE WHICH ARE TERMINATING CONDITIONS. + MOVSI OUT,7 + ADD C,BEG + CALL CHK ;CALCULATE AND VALIDATE ADDRESS TO STOP SCANNING AT. + CALL SKNBCP + IBP SKNBPT ;SKNBPT IS B.P. TO LDB LISP SYNTAX OF CHAR IN CH. + MOVEI TT,CH ;PUT "CH" IN INDEX FIELD TO MAKE THAT TRUE. + DPB TT,[220600,,SKNBPT] + SKIPGE A,E ;KEEP THE STATE IN A. NEGATIVE NUMBER AS ARG + ANDI A,-1 ;MEANS A NEGATIVE PAREN DEPTH, WITH STATE BITS 0. + MOVE CH,QRB.. + SETOM .Q..0(CH) ;SO FAR WE HAVE NOT SEEN ANY ( OR |. + MOVE IN,PT + CALL GETIBI ;IN GETS SCAN POINT AS VIRT ADDR, BP GETS BP TO ILDB. + CAMLE IN,C + TYPRE [2%1] + MOVE Q,P + SETZB D,B ;D HAS ADDR+1 OF START OF SEXP THHT ENDED LAST, OR 0. + ;B HAS STATE BEFORE LAST CHARACTER SCANNED. +FCTLFL: TLNN B,7 ;IF LAST CHAR WASN'T IN OR AFTER AN ATOM, + TLNN A,7 ;AND THIS ONE WAS, + CAIA ;THEN WE HAVE JUST STARTED AN ATOM, + MOVE D,IN ;SO REMEMBER . AS ADDR+1 OF LAST SEXP'S START. + MOVE B,A + TDNN A,OUT ;STOP CONDITION MET OR REACHED END OF RANGE => + CAMN IN,C ;RETURN, SETTING APPRO. Q-REGS. + JRST FCTLFX + CAMN IN,GPT + CALL FEQGAP ;WHEN WE COME TO TH GAP, MOVE TH B.P. OVER IT. + AOS IN,PT + ILDB CH,BP + TLZE A,1 ;PREVIOUS CHARACTER WAS SLASH => DON'T CHECK THIS ONE. + JRST FCTLFL + TLZ A,2 + LDB CH,SKNBPT + TLNE A,100 ;INSIDE A COMMENT, ONLY CR IS INTERESTING. + JRST [ CAIN CH,^M + TLZ A,100 + JRST FCTLFL] + CAIN CH,"/ + JRST [ TLO A,3 + JRST FCTLFL] + CAIN CH,"| + JRST [ MOVE CH,IN ;| => COMPLEMENT IN-|-NESS, + SUB CH,BEG ;AND IF THIS IS ENTERING A PAIR, + TLCE A,4 ; REMEMBER THE ADDRESS IN Q..0. + MOVEM CH,@QRB.. + JRST FCTLFL] + TLNE A,4 + JRST FCTLFL ;WITHIN VERTICAL BARS => ONLY | AND / ARE SPECIAL. + CAIN CH,"; + JRST [ MOVE CH,IN ;ELSE ; STARTS A COMMENT, AND REMEMBER ITS ADDRESS. + SUB CH,BEG + MOVEM CH,@QRB.. + TLO A,100 + JRST FCTLFL] + CAIN CH,"A + TLO A,2 + CAIN CH,"( + JRST [ HRRI A,1(A) ;( => PUSH ITS ADDRESS+1 SO WE CAN + PUSH P,IN ;FIND THE LAST UNMATCHED ONE. + JRST FCTLF1] ;ALSO INCREMENT THE DEPTH COUNTER. + CAIE CH,") + JRST FCTLFL + CAME Q,P ;) => POP ADDR+1 OF THE MATCHING (, IF ANY. + POP P,D ;IT BECOMES THE ADDR+1 OF THE LAST SEXP TO START. + HRRI A,-1(A) ;DECREMENT THE DEPTH. +FCTLF1: TRNE A,-1 ;IF THE DEPTH EVER BECOMES 0 AFTER A PAREN, EXIT. + JRST FCTLFL +FCTLFX: CAME Q,P ;EXIT: GET ADDRESS OF LAST UNMATCHED (, + SOSA IN,(P) ;OR -1 IF THERE IS NONE. + SKIPA IN,[-1] + SUB IN,BEG + MOVE CH,QRB.. + MOVEM IN,.Q..1(CH) ;STORE THAT IN Q..1 + SOSLE D + SUB D,BEG ;TURN D INTO REL CHAR ADDR OF + MOVEM D,.Q..2(CH) ;THE START OF THE LAST SEXP. PUT IN Q..2 + MOVE P,Q ;FLUSH SAVED ( ADDRESSES FROM THE STACK. + JRST POPJ1 ;RETURN THE NEW STATE, WHICH IS IN A. + +SUBTTL MISCELANEOUS F- COMMANDS + +;FX - PUT TEXT INTO AND DELETE IT. FX* RETURNS THE TEXT. +;AC D HAS # CHARS BUFFER WAS MOVED (BY CREATION OF THE STRING) +FXCMD: CALL QREGVS ;THIS CAN MAKE US SKIP! + CALL GETANU ;TAKES ARGS LIKE X, K, ETC. + SKIPA +FXCMD2: SETZ B, ;HERE WITH CH POINTING AT QREG, ASSUMED NOT IN A QVECTOR. + SAVE C + SAVE E ;REMEMBER BOTH ON PDL. + SAVE BEG ;X10 MAY MOVE BUFFER, MUST KNOW HOW MUCH. + CALL X12 ;GO PUT IN QREG (WHICH MIGHT BE AC A - SEE QREGVS) + REST D + SUB D,BEG ;-<# CHARS BUFFER MOVED UP> + REST E + REST C ;GET THE ENDS BACK, + MOVNS D + ADD E,D ;RELOCATE REMEMBERED PTRS. + ADD C,D + MOVEM C,PT + JRST DELET1 + +FTYI: CALL DISMDI ;UPDATE MODE DISPLAY (Q..J) IF NEC. + TTYACT + CALL TYI + TRZE FF,FRCLN ;:FI READS CHAR AND DOESN'T GOBBLE. + MOVEM CH,UNRCHC + TRZN FF,FRUPRW ;^ FI RETURNS UNNORMALIZED CHARACTER. + CALL TYINRM ;NORMAL FI RETURNS NORMAILZED CHARACTER. + MOVE A,CH + JRST POPJ1 + +CNTRUP: CALL RCH ;^^ - RETURN ASCII FOR NEXT CHAR IN CMD STRING. [ + MOVEI A,(CH) ;DISCARD LH, WHICH IS NONZERO FOR ^]^Q'D CHAR. + JRST POPJ1 + +;? COMMAND, COMPLEMENT TRACE MODE. :? TURNS OFF TRACE MODE. +QUESTN: TRNE FF,FRCLN + TRZA FF,FRTRACE + TRC FF,FRTRACE +QUEST1: MOVSI A,(JRST) + TRNN FF,FRTRACE + MOVSI A,(RET) + HRRI A,TYOS + MOVEM A,TRACS + POPJ P, + +FCTLAT: CALL GETARG ;F^@ - TAKES RANGE OF BUFFER, + JFCL + CAMG C,E ;RETURNS 2 ARGS DELIMITING THAT RANGE + EXCH C,E ;IN NUMERIC ORDER. 2,1F^@ GIVES 1,2. + MOVE B,E + MOVE A,C + ANDCMI FF,FRARG+FRARG2 + JRST HOLE0 + +;F*$ -- NO-OP. +;[ ;MAINLY USEFUL FOR F*^]^X$ +FNOOP: JSP B,RDALTC + POPJ P, + JRST FNOOP + +;READ 1 CHAR OF STRING ARG, TURNING UNQUOTED DOLLARSIGNS TO ALTMODES. +;AT END OF ARG, FAIL TO SKIP. +RDALTC: PUSHJ P,RCH + SKIPE SQUOTP + JRST 1(B) + CAIN CH,ALTMOD + JRST (B) + CAIN CH,"$ + MOVEI CH,ALTMOD + JRST 1(B) + +;^V WITH ARG -- PUSH ARGUMENT ON RING BUFFER OF PT. RETURNS NO VALUE. +;NORMALLY, DOESN'T PUSH IF ARG SAME AS CURRENT TOP. :^V PUSHES IN ANY CASE. +FSPSPT: MOVE E,FSPSPP ;GET RING BUFFER POINTER. + LDB CH,E ;GET LAST VALUE PUSHED. + TRZE FF,FRCLN ;UNLESS THIS IS :^V, + JRST FSPSP1 + CAMN C,CH + RET ;DON'T PUSH THE SAME THING TWICE IN A ROW. +FSPSP1: CAMN E,[4400,,FSPSPB+FSPSPL-1] + SUBI E,FSPSPL ;AT END, RING AROUND TO BEGINNING. + IDPB C,E + MOVEM E,FSPSPP + RET + +;^V COMMAND -- WITHOUT ARG, POP TOP OF RING BUFFER OF PT INTO PT; +;THEN RETURN WHAT REMAINS ON TOP OF RING BUFFER (IF THAT VALUE IS +;PUT IN Q..I, THE TOP-LEVEL WILL AVOID PUSHING WHEN IT IS NEXT ENTERED). +;:^V RETURNS VALUE ON TOP OF RING BUFFER. +;^V WITH ARG PUSHES - SEE ABOVE. +CTLV: TRNE FF,FRARG + JRST FSPSPT +POPPT: MOVE E,FSPSPP + MOVE A,(E) ;GET LAST THING PUSHED. + TRZE FF,FRCLN + JRST POPJ1 ;:^V JUST RETURNS VALUE ON TOP OF RING BUFFER. + ADD A,BEG ;PREPARE TO SET PT FROM IT. + SUBI E,1 ;DECREMENT THE RING BUFFER POINTER. + CAMN E,[4400,,FSPSPB-1] + ADDI E,FSPSPL + MOVEM E,FSPSPP + MOVE C,A ;TAKE THE VALUE JUST POPPED. + CALL CHK ;ERR OUT IF IT ISN'T INSIDE THE BUFFER. + MOVEM A,PT ;JUMP THERE IF IT IS. + MOVE A,(E) ;RETURN WHAT IS NOW AT THE TOP. + JRST POPJ1 + +;^Z -- INSERT RANDOM LETTERS BEFORE PT. +;^Z WITHOUT ARG -- RETURN A RANDOM NUMBER. +RANDOM: ARGDFL + JUMPE C,RNDNUM + JUMPLE C,CPOPJ + CALL SLPGET ;INSERT C(C) CHARS, RET. BP. IN BP. +RNDLUP: MOVSI A,123467 + FMPB A,RDMNMS + IDIVI A,26. + MOVEI CH,"A(B) + IDPB CH,BP + SOJG C,RNDLUP + POPJ P, + +RNDNUM: MOVSI A,132476 + FMPB A,RDMNMS + TLZ A,400000 + JRST POPJ1 + +SUBTTL COMMUNICATION WITH SUPERIOR JOB + +FSEXI1: TLZ FF,FLDIRDPY ;COME HERE TO HANDLE ^C TYPED AT TECO COMMAND READER. + MOVEI C,100000 +FSEXIT: MOVEI B,BEG .SEE CIRC +IFN ITS,.BREAK 16,(C) ;FS EXIT +IFN TNX,JRST .EXIT + RET + +SUPCMD: MOVE C,SUPARG ;JUMP HERE IF SUPERIOR STARTS TECO AT BFR BLOCK + 7. + MOVEM C,NUM ;FETCH THE ARG IN BFR BLOCK + 8, AND MAKE IT CURRENT ARGUMENT. + TRO FF,FRARG + SKIPE A,SUPHND ;IF TECO MACRO HANDLER SUPPLIED, RUN IT GIVING IT + JRST MAC5 ;THE ARG OUR SUPERIOR GAVE. + CALL GAPSLP + SKIPLE C ;OTHERWISE, IF ARG IS POSITIVE INSURE AT LEAST THAT MUCH GAP. + CALL SLPGET + MOVEI C,500000 ;DO AN $X RETURN IN CASE $X'ING FROM DDT. + JRST FSEXIT + +;^K$ -- VALRET . +DECDMP: CALL DECDMX ;FORMULATE STRING + MOVEI B,BEG .SEE CIRC + SKIPGE PJATY ;MAKE SURE WE DON'T CLEAR PJATY IF IT WAS ALREADY ON. + TRZ FF,FRUPRW +IFN ITS,.VALUE (A) ;SUPERIOR EXPECTS 2 TO POINT TO BEG +IFN TNX,[ + HRLI A,440700 +IFN 20X,[ + RSCAN ;BEST WAY WE HAVE TO RETURN A STRING TO THE EXEC + TDN + SETZ A, + RSCAN + TDN +] +IFN 10X,[ + MOVE CH,A ;BYTE POINTER TO CHARS TO DO + MOVEI A,.CTTRM +DECDM2: ILDB B,CH + JUMPE B,DECDM3 + STI ;STUFF INTO TERMINAL'S INPUT BUFFER + JRST DECDM2 +DECDM3: +] + CALL .EXIT +] + TRZE FF,FRUPRW + SETZM PJATY ;^ FLAG => SUPPRESS AUTOMATIC REDISPLAY. + POPJ P, + +DECDMX: CALL MEMTOP ;GET ADDR OF 1ST WD ABOVE BFR IN A. + AOS OUT,A + IMULI OUT,5 ;GET CHAR ADDR 1ST CHAR IN THAT WD. + SUB OUT,EXTRAC ;SINCE PUTINC WILL ADD EXTRAC. + JSP B,RDALTC + JRST DECDM1 + CALL PUTINC ;STUFF CHARS THERE, ABOVE BUFFER. + JRST RDALTC + +DECDM1: SETZ CH, ;AFTER STRING, PUT ^@ + CALL PUTINC ;TO TELL DDT IT'S THE END. + SETZM 1(TT) ;ZERO NEXT WD SO DDT WILL STOP FETCHING. + RET + +;FZ - MANIPULATE INFERIOR PROCESS +; FZ$ CREATE FORK, RETURNS FORK INDEX +; 0FZ$ CREATE EXEC FORK (FILESPEC FROM STRING) +; FZ$ "PUSH" +; NFZ$ RESUME FORK N +; -NFZ$ KILL FORK N + +IFN TNX,[ +FZCMD: CALL DECDMX ;BUFFER STRING + HRRO B,A + TRZE FF,FRARG ;ARG GIVEN? + JRST FZCMD3 ;YES - MORE CHECKING + MOVE A,0(B) ;NO - SEE IF NULL STRING ARG + TLNN A,774000 + JRST .PUSH ;YES - DO PUSH + CALL NEWFRK ;ELSE - CREATE NEW FORK + MOVEM B,RUNFRK ;SAVE FORK INDEX +FZCMD1: CALL SETFRK ;SET FORK TTY STATE +FZCMD2: CALL GOFRK ;START UP FORK + MOVE A,RUNFRK ;NO - RETURN FORK INDEX + JRST POPJ1 ;RETURN OK + +FZCMD3: SKIPN A,NUM ;EXPLICIT 0? + JRST .PUSH0 ;YES - MAYBE "PUSH" + JUMPL A,KILFRK ;IF NEGATIVE, THEN KILL FORK + MOVEM A,RUNFRK ;SAVE FORK INDEX + CAILE A,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(A) + TYPRE [ARG] + CALL SETFRK ;SET FORK STATES + TRNE FF,FRARG2 ;HAVE PRE-COMMA ARG? + JRST FZCMD2 ;YES - START FORK AND WAIT FOR TERMINATION + SAVE C ; SAVE AC + SAVE A ; SAVE FORK HANDLE + RFSTS ; GET FORK STATUS AND PC + HLRZ C,A ; COPY FORK STATUS + REST A ; RESTORE FORK HANDLE + TRZE C,(RF%FRZ) ; FORK FROZEN? + RFORK ; YES, WARM IT UP + CAIE C,.RFHLT ; HALTED? + CAIN C,.RFFPT + SFORK ; YES, START IT AT PC RETURNED BY RFSTS + REST C ; RESTORE AC + JRST WAITA ;WAIT FOR TERMINATION + +;RUN AN EXEC PROCESS + +.PUSH0: MOVE A,0(B) ;CHECK NULL STRING + SKIPLE EXECFK ;CHECK EXISTING EXEC FORK + TLNN A,774000 + JRST .PUSH ;NULL STRING OR NO EXISTING FORK + MOVE A,EXECFK ;KILL OFF OLD FORK + KFORK +IFN 20X, ERJMP .+1 + SETOM EXECFK ;SAY NO EXEC +.PUSH: SETZM RUNFRK ;0 - EXEC FORK INDEX + SKIPLE A,EXECFK ;HAVE EXEC? + JRST FZCMD1 ;YES - USE IT + MOVE A,0(B) ;SEE IF NULL STRING + TLNN A,774000 +IFN 20X, HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/] +IFN 10X, HRROI B,[ASCIZ /EXEC.SAV/] + SETZM EXECFK ;FLAG TO SAVE FORK HANDLE + CALL NEWFRK ;CREATE AN EXEC FORK + JRST FZCMD1 ;RUN EXEC AND RETURN + +;KILL FORK (INDEX IN A) + +KILFRK: MOVN B,A ;GET POSITIVE INDEX + CAILE B,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(B) + TYPRE [ARG] + KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + SETZM FRKTAB-1(B) + RET ;RETURN NO VALUE. + +;SET UP TTY MODES FOR RUNNING INFERIOR + +SETFRK: SKIPGE PJATY ;DON'T CLEAR THIS IF ALREADY ON + TRZ FF,FRUPRW + SAVE A ;SAVE FORK HANDLE + CALL DPYRST ;RESET TERMINAL (IF DPY) + MOVEI A,.CTTRM ;CONTROLLING TERMINAL + MOVE B,ITTYMD ;RESTORE TTY MODES + SFMOD + STPAR + MOVE B,ITTYMD+1 ;COULD BE DMOVE EXCEPT FOR KA10 TYPES + MOVE C,ITTYMD+2 + SFCOC + MOVEI A,.FHJOB ;SETUP TERMINAL INTERUPT WORD + SETO B, + SETZ C, + STIW + MOVEI A,.TICCG ;CTRL-G + MOVE B,0(P) ;FORK HANDLE + CAMN B, EXECFK ;THIS THE EXEC? + DTI ;YES - TURN OFF C-G + MOVE C,RUNFRK + JUMPE C,[MOVE A,['EXEC'] + SETNM + JRST POPAJ] + MOVE A,NAMTAB(C) + SETNM + JRST POPAJ ;RESTORE FORK HANDLE AND EXIT + +;START INFERIOR (HANDLE IN A) + +GOFRK: TRNN FF,FRARG2 + TDZA B,B ;NO ARG - SPECIFY 0 + MOVE B,SARG ;GET ARG IF SPECIFIED + SFRKV ;START INFERIOR + +WAITA: WFORK ;WAIT FOR FORK TO TERMINATE +WAITX: ;SPECIAL LABEL FOR TSINT +RETFRK: SAVE A ;SAVE FORK HANDLE + CALL PAGON ;RESTORE DPY + TRZE FF,FRUPRW ;RES + SETZM PJATY ;^ FLAG => SUPPRESS AUTO REDISPLAY + MOVSI A,.TICCG ;MAKE SURE ^G ASSIGNED ON CHANNEL 0 + ATI + MOVE A,JNAME + SETNM + JRST POPAJ ;RESTORE HANDLE AND EXIT + +;CREATE A NEW FORK FOR PROGRAM NAMED BY POINTER IN B +;IF EXECFK IS 0, WE WANT TO CREATE AN EXEC FORK. +;OTHERWISE, WE ALLOCATE AN INDEX AND RETURN IT IN B. + +NEWFRK: MOVSI A,(GJ%SHT\GJ%OLD) + GTJFN + JRST OPNER1 + SAVE A ;SAVE JFN + SETNM ;SET THE SUBSYS NAME + GETNM + SAVE A + MOVSI A,(CR%CAP) ;PASS ON CAPABILITIES + CFORK + JRST FRKC3 + EXCH A,-1(P) ;SAVE FORK HANDLE GET JFN + HRL A,-1(P) ;FORK,,JFN + GET ;GET FILE +IFN 20X, ERJMP FRKC4 + REST A ;RESTORE FORK HANDLE + SKIPN EXECFK ;WANT THIS HANDLE? + JRST [ MOVEM A,EXECFK + RET] + MOVSI B,-NFKS + SKIPE FRKTAB(B) ;IN USE? + AOBJN B,.-1 ;YES - TRY NEXT + JUMPG B,FRKC5 ;TABLE FULL? + MOVEM A,FRKTAB(B) ;SAVE NEW HANDLE + REST A + MOVEM A,NAMTAB(B) ;SAVE THE FORK'S NAME + MOVEI B,1(B) ;RETURN NEW INDEX IN B + RET + +FRKC3: REST A ;JFN ON STACK + RLJFN ;RELEASE JFN IN A + JFCL + JRST OPNER1 + +FRKC4: TLZ A,-1 ;JFN + RLJFN + JFCL + REST A ;FORK HANDLE ON STACK + KFORK ;FLUSH FORK +IFN 20X, ERJMP .+1 + JRST OPNER1 + +FRKC5: KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + MOVEI B,CFRKX3 + JRST OPNER4 +];TNX (FZ COMMAND) + +;FJ -- INSERT THE CMD STRING FROM DDT IN THE BUFFER. +;IF NO STRING, INSERTS NOTHING. STRING WILL USUALLY END WITH CRLF. +FJCL: PUSHJ P,FJCLRD ;READ IN THE COMMAND STRING, + SKIPN GCTAB + POPJ P, ;NOTHING TO DO IF STRING NULL. + MOVE A,[BP7,,GCTAB] + MOVEI C, ;COUNT THE CHARS IN E. +FJCL1: ILDB CH,A + JUMPE CH,FJCL2 + CAIE CH,^M ;^M AND ^@ END THE STRING. + AOJA C,FJCL1 + ADDI C,2 ;^M COUNTS AS 2 CHARS, ^@ AS NONE. +FJCL2: CALL SLPGET ;INSERT C(C) CHARS, BP IN BP FOR IDPB. + MOVE A,[BP7,,GCTAB] +FJCL3: ILDB CH,A ;COPY THE CHARS INTO THE SPACE. + JUMPE CH,CPOPJ ;STOP BEFORE A ^@. + IDPB CH,BP + CAIE CH,^M ;AFTER ^M, STORE ^J ANDF DONE. + JRST FJCL3 + MOVEI CH,^J + IDPB CH,BP + POPJ P, + +;READ THE CMD STRING FROM DDT INTO GCTAB. +FJCLRD: SETZM GCTAB + MOVE A,[GCTAB,,GCTAB+1] + BLT A,GCTAB+GCTBL-2 + MOVEM A,GCTAB+GCTBL-1 ;LAST WD NOT 0 TO STOP STORING. +;FIRST, RETURN WITH GCTAB ZEROED IF THERE IS NO JCL. +IFN ITS,[ + .SUSET [.ROPTIO,,A] + TLNN A,OPTCMD ;HAS SUPERIOR SAID IT HAS CMD STRING? + POPJ P, ;NO, RETURN AS IF READ 0 FROM IT. +] +IFN 20X,[ + SETZB A,B + RSCAN ;GET RSCAN BUFFER + TDN + SETZ B, + MOVN C,A ;GET NUMBER OF CHARACTERS IN IT +FJCLR2: JUMPGE C,CPOPJ ;RETURN IF NOTHING TO READ + PBIN ;FLUSH THE FIRST WORD OF THE RSCAN LINE + LSH B,7 + ADD B,A + CAILE A,40 + AOJA C,FJCLR2 + AOJGE C,CPOPJ + CAMN B,[_-1] + RET +] +;THERE IS JCL, SO READ IT INTO GCTAB. +IFN ITS,.BREAK 12,[5,,GCTAB] +IFN 20X,[ + MOVEI A,-1 ;READ FROM CONTROLLING TERMINAL + HRROI B,GCTAB + SIN ;THE REST OF THE RSCAN STRING +] + RET + +SUBTTL F=, F~ STRING COMPARISON + +;F=$ OR F=$ +;COMPARES THE STRINGS AND RETURNS A NUMBER WHOSE SIGN IS NEGATIVE +;IF QREG OR BUFFER RANGE IS LESS; POSITIVE, IF GREATER; 0, IF THE +;TWO STRINGS ARE EQUAL. +;IF THE VALUE IS NONZERO, ITS ABS VALUE IS 1 + THE POSITION OF THE FIRST +;DIFFERENCE; I.E., 1 IF THE FIRST CHARACTERS DIFFER. +;A STRING IS GREATER THAN ANY INITIAL SEGMENT OF IT. +;F~ (OR F^) COMPARES SIMILARLY BUT IGNORES CASE DIFFERENCES. +FAPPRX: TRO FF,FRNOT +FEQ: TRNE FF,FRARG\FRCLN + JRST FEQ0 ;NUMERIC ARG => USE BUFFER RANGE. + SAVE FF ;PRESERVE FRNOT OVER QREGX. + CALL QREGX ;ELSE READ NAME OF QREG. + REST FF + CALL QLGET0 ;GET LENGTH IN B, BP TO ILDB IN BP. + TYPRE [QNS] + SETZB D,IN ;THERE'S NO GAP TO SKIP OVER. + AOJA IN,FEQ1 + +FEQ0: CALL GETANU ;DECODE 1 OR 2 ARGS AS FOR K, T, X ETC. + MOVE D,GPT ;D GETS CHAR ADDR OF START OF GAP. + MOVE B,C ;B GETS # CHARS, + SUB B,E + MOVE BP,E + CAML E,GPT + ADD BP,EXTRAC ;IN CASE RANGE STARTS AFTER GAP. + MOVE IN,BP + CALL GETIBP ;BP GETS BP TO ILDB 1ST CHAR. +FEQ1: SETZ A, ;ORDER OF STRINGS NOT KNOWN YET. + ;WHEN ORDER IS DETERMINED, A WILL GET 1 OR -1. + MOVE E,B ;REMEMBER INITIAL VALUE OF B. + SETZM INSBP ;MAKE SURE RCH RELOCATES BP. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;UPARROW SAYS USE DELIMITER OTHER THAN ALTMD. + CALL RCH + MOVEM CH,INSDLM ;REMEMBER THE DELIMITER. + TRZ FF,FRARG+FRCLN+FRARG2 +;GET THE NEXT CHAR FROM THE STRING ARG. +FEQLUP: CALL RCH ;READ IT. + SKIPE SQUOTP ;IF NOT QUOTED OR DELIM-PROTECTED, + JRST FEQLU1 + CAMN CH,INSDLM ;SEE IF IT IS THE DELIMITER. + JRST FEQEND +FEQLU1: JUMPN A,FEQLUP ;INEQUALITY SEEN => JUST SKIPPING TO END OF STRING ARG NOW. + SOJL B,FEQEN1 ;END OF QREG BUT NOT END OF STRING ARG => QREG IS LESS. + CAMN D,IN ;ELSE GET NEXT CHAR OF QREG OR BUFFER. + CALL FEQGAP ;SKIP OVER GAP IF HAVE REACHED IT. + AOS IN + ILDB C,BP + CAIN C,(CH) ;CHARS EQUAL => NO DECISION YET, + JRST FEQLUP ;KEEP LOOKING. + TRNN FF,FRNOT ;NO MATCH => IF F^, TRY IGNORING CASE. + JRST FEQNE + CAIL C,"A+40 + CAILE C,"Z+40 + CAIA + SUBI C,40 + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN C,CH + JRST FEQLUP +FEQNE: CAIL C,(CH) ;QREG OR BUFFER GREATER => + AOJA A,FEQLUP ;RETURN POSITIVE; ELSE NEGATIVE. +FEQEN1: SOJA A,FEQLUP ;EITHER WAY, SKIP OVER REST OF STRING ARG. + +FEQEND: SETOM INSBP + JUMPN A,FEQEN2 ;END OF STRING ARG: RETURN ANSWER IF KNOWN. + SOJL B,POPJ1 ;ELSE QREG ENDING NOW TOO => EQUAL. + AOJ A, ;STRING ARG FINISHED, OTHER NOT => STRING ARG IS SMALLER. +FEQEN2: SUB E,B ;INITIAL VALUE OF B - CURRENT + IMUL A,E ;GIVES 1+POSITION OF 1ST DIFFERENCE. + JRST POPJ1 + +FEQGAP: MOVE BP,GPT ; BP GETS BP TO ILDB 1ST CHAR AFTER GAP. + ADD BP,EXTRAC + JRST GETIBP + +SUBTTL CASE CONVERSION + +;FC - TAKES ARGS LIKE K, CONVERTS AREA OF BUFFER TO LOWER CASE +;PT GOES BEFORE THE SAME CHARACTER BEFORE AND AFTER. +;^ FC CONVERTS TO UPPER CASE. +;:FC RETURNS , CONVERTED TO UPPER CASE. +LOWCON: TRZE FF,FRCLN + JRST LOWCO3 ;:FC GOES OFF. + PUSHJ P,GETANU + MOVE IN,E + SUB C,IN + SKIPE READON + TYPRE [RDO] + SETOM MODIFF ;WE ARE ABOUT TO CHANGE THE BUFFER CONTENTS. + CALL GETIBI ;GET IN BP B.P. TO ILDB CHARS STARTING WHERE IN POINTS. +LOWCO1: SOJL C,CPOPJ + CAMN IN,GPT ;WHEN REACH GAP, MOVE B.P. OVER IT. + CALL FEQGAP + ILDB CH,BP + TRNE FF,FRUPRW + JRST LOWCO5 + CAIG CH,"Z + CAIGE CH,"A + JRST LOWCO2 +LOWCO6: XORI CH,40 +LOWCO2: DPB CH,BP ;PUT CHAR INTO FRONT OF GAP, + AOJA IN,LOWCO1 + +LOWCO5: CAIG CH,40+"Z ;CONVERTING TO UPPER CASE: + CAIGE CH,40+"A + JRST LOWCO2 + JRST LOWCO6 ;LOWER CASE CHARS GET SHIFTED, + +LOWCO3: TRZN FF,FRARG + TYPRE [WNA] + MOVE A,C ;HANDLE :FC. TO GET VALUE, START WITH ARG, + TRZ FF,FRUPRW ;DON'T LEAVE ^ FLAG ON; DON'T LET ARG INTERFERE WITH VALUE. + CALL QLGET0 ;ARG IS STRING => CONVERT ALL CHARS OF THE STRING. + CAIA + JRST LOWCO4 + ANDI C,177 + CAIG C,40+"Z + CAIGE C,40+"A + CAIA + XORI A,40 + JRST POPJ1 + +LOWCO4: AOS (P) + MOVE C,B ;ARG IS STRING; MAKE NEW STRING = OLD ONE CONVERTED TO U.C. + MOVE E,BP ;SAVE PTR TO OLD STRING; QOPEN RETURNS PTR TO NEW ONE IN BP. + CALL QOPEN ;MEANWHILE C HAS SIZE NEEDED FOR NEW ONE, = SIZE OF OLD. + JUMPE B,QCLOSV +LOWCO7: ILDB TT,E ;COPY OLD STRING + CAIL TT,"A+40 + CAILE TT,"Z+40 + CAIA + SUBI TT,40 ;CONVERT EACH CHARACTER IF NECESSARY. + IDPB TT,BP ;STORE INTO THE NEW STRING. + SOJG B,LOWCO7 + JRST QCLOSV ;THEN FINISH THE NEW STRING'S HEADER AND RETURN IT. + +NEWAS: ARGDFL ;DOLLARSIGN COMMAND. + CALL FSCASF ;UNLESS IN -1$, NO CASE SHIFT OR LOCK. + SKIPGE C + MOVEI IN,"/ ;-1$, USE / AS THE CASE-SHIFT, NO CASE-LOCK. + JRST FSCAS1 + +FSCASV: MOVE A,CASNRM ;COMPUTE VALUE FOR FS CASE TO RETURN. + SKIPL CH,CASSFT ;IF THERE'S A CASE-SHIFT, PUT IT IN BUFFER.. + CALL TYOMGS + SKIPL CH,CASLOK ;SAME FOR CASE-LOCK. + CALL TYOM + JRST POPJ1 + +FSCASE: TRNN FF,FRARG ;FS CASE -- NO ARG => RETURN STATUS INFO. + JRST FSCASV + ARGDFL + CALL FSCASF ;READ THE STRING ARG WITH NO CASE SHIFT OR CASE LOCK. + CALL RCH ;READ WHAT MIGHT BE THE CASE-SHIFT. + CAIN CH,ALTMOD ;NULL STRING ARG => NEITHER. + JRST FSCAS1 ;(NOTE IN, OUT HOLD -1) + MOVEI IN,(CH) ;ELSE 1ST CHAR OF ARG IS CASE-:SHIFT. + CALL RCH ;AND THERE MAY BE A CASE-LOCK. + CAIN CH,ALTMOD + JRST FSCAS1 ;NO MORE CHARS IN ARG => NO CASE-LOCK. + MOVEI OUT,(CH) +FSCAS0: JSP B,RDALTC ;IGNORE REST OF STRING ARG. + CAIA + JRST FSCAS0 +FSCAS1: CAMN IN,OUT ;TRYING TO MAKE SAME CHAR SHIFT & LOCK? + SETO IN, ;JUST USE IT AS LOCK. + MOVEM C,CASNRM ;SIGN OF ARG IS NORMAL INPUT CASE. + MOVEM C,CASE ;SET CURRENT CASE TO NEW NORMAL. + ANDI C,1 + MOVEM C,CASDIS ;ARG ODD => FLAG ON OUTPUT. + MOVEM IN,CASSFT ;THEN STORE AWAY NEW SHIFT AND LOCK CHARS, + MOVEM OUT,CASLOK + MOVE TT,[CALL RCHSFT] ;ACTUALLY MAKE THE NEW CASE-SHIFT + SKIPL IN ;(IF ANY) + EXCH TT,RCHDTB(IN) ;ACT LIKE ONE. + MOVEM TT,RCHSFD ;MAKE SURE CAN UNDO THAT EXCH. + MOVE TT,[CALL RCHLOK] + SKIPL OUT ;SIMILAR FOR THE NEW CASE-LOCK. + EXCH TT,RCHDTB(OUT) + MOVEM TT,RCHLOD + POPJ P, + +;CAUSE THE CASE-SHIFT AND CASE-LOCK, IF ANY, TO BECOME NORMAL. +;CHARACTERS AGAIN, WITH NO CASE-SHIFT OR -LOCK IN EXISTENCE. +;SETOM'S IN, OUT. CLOBBERS TT, TT1. +FSCASF: MOVE TT,RCHLOD ;FIRST TURN THE OLD SHIFT AND LOCK CHARS + SKIPL TT1,CASLOK ;INTO NORMAL CHARS. + MOVEM TT,RCHDTB(TT1) + MOVE TT,RCHSFD + SKIPL TT1,CASSFT + MOVEM TT,RCHDTB(TT1) + SETOB IN,CASSFT ;THEN SAY THERE ARE NONE. + SETOB OUT,CASLOK + POPJ P, + +SUBTTL Q-REGISTER NAME READERS + +;ROUTINES TO READ IN SUFFIX QREG ARGS: + +;THERE ARE SEVERAL TYPES OF SUFFIX QREGS, AND VARIOUS ROUTINES ALLOW CERTAIN SUBSETS. +;A LETTER (OR DOTS AND A LETTER, OR A ^R OR ^^ NAME) NAMES A FIXED LOCATION IN TECO. +;AN EXPRESSION IN PARENTHESES IS A READ-ONLY QREG "CONTAINING" THE VALUE OF THE EXP. +;A * IS A WRITE-ONLY QREG AND WHAT IS WRITTEN IN IT IS THE COMMAND'S VALUE. +;:() WHERE IS A QREG CONTAINING A Q-VECTOR, IS A SUBSCRIPTING EXPRESSION. +; IN THIS CASE, THE QREG IS ONE WORD IN THE QVECTOR. +; IS A LONG-NAME QREG. THE NAME IS LOOKED UP IN THE SYMBOL TABLE +; (A QVECTOR IN ..Q) WITH FO TO FIND THE WORD IN THAT QVECTOR HOLDING THE VALUE. + +;THE REASON THERE ARE SEVERAL ROUTINES IS THAT ONLY READING-ONLY COMMANDS +;ALLOW (-) QREGS, AND ONLY WRITING-ONLY COMMANDS ALLOW *. +;QREGS IS THE BASIC ROUTINE (NEITHER * NOR PARENS), QREGX ALLOWS PARENS, +;AND QREGVS ALLOWS *. + +;THE ROUTINES HAVE SIMILAR VALUE CONVENTIONS: +;A CONTAINS THE CONTENTS OF THE QREG, +;CH CONTAINS ITS ADDRESS (BAKTAB, FOR PAREN-QREGS WHICH CAN'T BE WRITTEN) +;B CONTAINS AN INDICATION OF WHICH TYPE OF NAME WAS READ. + ;NORMALLY, IT IS ZERO. FOR :(), IT IS POSITIVE; FOR NAME, IT IS NEGATIVE. + ;IN EITHER OF THOSE TWO CASES, THE RH POINTS AT THE BUFFER BLOCK OF THE QVECTOR + ;CONTAINING THE SLOT. THAT IS SO THAT COMMANDS LIKE :I CAN TELL IF THAT QVECTOR + ;IS RELOCATED AND CORRECT ACCORDINGLY (SEE QREGVA). +;IN, FOR A NAME QREG (B IS NEGATIVE), CONTAINS A TECO STRING POINTER TO THE +;INTERNED NAME OF THE QREG AS FOUND IN THE SYMBOL TABLE. + +;READ EITHER A QREG NAME OR AN EXPRESSION IN PARENS, WHOSE VALUE +;IS USED AS THE "CONTENTS" OF THE QREG. CONTENTS RETURNED IN A. CLOBBERS ALL ACS +;EXCEPT C,E. ALSO ALLOWS SUBSCRIPTED QVECTORS, LIKE QREGS. +QREGX: CALL SKRCH + CAIE CH,"( + JRST QREGS0 + TRO FF,FRQPRN ;MARK THIS ( AS BEING FROM QREGX. + MOVEI T,CD + JRST OPEN2 ;SAVE ARGS, ETC; WILL COME BACK WHEN ")" IS SEEN + +QREGXR: MOVE C,NUM ;TO HERE. A HAS VALUE WITHIN THE PARENS. + MOVE E,SARG ;RESTORE THE SAVED ARGS. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + IORI FF,(CH) + SETZ B, ;RETURN B AS 0 TO SHOW THIS WASN'T A SUBSCTRIPTED QREG. + MOVEI CH,BAKTAB ;MAKE SURE, IF CALLER TRIES TO WRITE OUR QREG, NO HARM DONE. + RET + +;HERE TAKE CARE OF "SIMPLE" (..A OR ...^RX) TYPE QREG NAMES. +QREGXX: SETZB A,B + CALL QNMGE2 ;HERE FROM QREGX OR QREGS IF IT'S AN ORDINARY QREG NAME AFTER ALL. + TYPRE [IQN] + MOVE A,(CH) + POPJ P, + +;HERE TO READ EITHER QREG NAME OR "*" MEANING RETURN AS VALUE INSTEAD OF SETTING QREG. +;ASSUMES -1(P) IS CALLER'S RETURN ADDRESS, AND AOS'S IT SO CALLER RETURNS THE VALUE. +QREGVS: CALL SKRCH ;HERE TO ALLOW EITHER * OR SUBSCRIPTING. + CAIE CH,"* + JRST QREGS0 + MOVEI CH,A ;SUPPLY AC A AS ADDR OF "QREG". + SETZB A,B ;SAY ITS VALUE IS 0 (FOR THINGS LIKE ^ X). + AOS -1(P) ;MAKE OUR CALLER SKIP-RETURN + RET + +;READ IN A QREG NAME, ALLOWING SUBSCRIPTING (AS IN Q:.Q(10) = 10TH ELT OF Q-VECTOR IN .Q) +;ON RETURN FROM THIS OR ANY OTHER QREG-READING ROUTINE, IF B IS NONZERO +;THEN THE QREG WAS SUBSCRIPTED, AND B POINTS AT THE BUFFER BLOCK OF THE Q-VECTOR. +;WE ALSO HANDLE "LONG QREG NAMES" AS IN QFOO, SINCE THAT IS IMPLEMENTED +;BY MEANS OF INDEXING (INTO THE SYMBOL TABLE QVECTOR). +QREGS: CALL SKRCH +QREGS0: CAIN CH,ALTMOD + JRST QREGN ;CHECK FOR Q$FOO$ CONSTRUCT. + CAIE CH,": + JRST QREGXX + CALL QREGX ;FIRST, READ THE QREG WHICH IS THE Q-VECTOR TO SUBSCRIPT. + SAVE A ;SAVE IT AS IF IN A (. + SAVE [0] + SAVE LEV + MOVEM P,LEV + CALL QREGX ;THEN READ THE VALUE OF THE INDEX. + MOVE IN,A + MOVEI T,.+2 + JRST CLOSE2 ;POP STUFF OFF, LEAVING Q-VECTOR IN A. + MOVE BP,A + CALL QBGET1 ;GET BUFFER-BLOCK ADDR IN B. + SKIPN B + TYPRE [QNB] + IMULI IN,5 ;GET VIRTUAL CHAR ADDR INSIDE Q-VECTOR OF DESIRED WORD. + ADD IN,MFBEG(B) + TLZ IN,MFBBTS + CAML IN,MFBEGV(B) ;COMPLAIN IF NOT INSIDE VIRTUAL BOUNDS. + CAML IN,MFZV(B) + TYPRE [NIB] + CAML IN,MFGPT(B) + ADD IN,MFEXTR(B) ;TURN INTO REAL ADDRESS. + IDIVI IN,5 + MOVE A,(IN) ;FETCH CONTENTS OF WORD, + MOVE CH,IN ;AND ALSO RETURN ITS ADDRESS, FOR "U", ETC. + RET + +;COMMANDS THAT DO CONSING, AFTER CALLING QREGVS, SHOULD, IF B IS NONZERO, +;DO A JSP TT,QREGVA TO WORRY ABOUT CHANCE THAT CONSING WILL MOVE THE Q-VECTOR. +;QREGVA SAVES STUFF, CALLS BACK TO DO THE WORK, THEN FIXES UP AND RETURNS TO COMMAND'S CALLER. +;IF B IS NEGATIVE, THE QREG IS A NAMED VARIABLE, AND WE MAY NEED TO CALL A MACRO +;WHEN ITS VALUE CHANGES. WE PRESERVE B FOR USE2 TO ACCOMPLISH THAT. +QREGVA: SAVE B ;REMEMBER ADDR OF BUFFER BLOCK OF QVECTOR + SAVE CH ;REMEMBER ADDRESS OF WORD IN QVECTOR. + MOVE CH,MFBEGV(B) + IDIVI CH,5 ;BUT CONVERT IT INTO AN INDEX RELATIVE TO QVECTOR'S B. + MOVNS CH + ADDM CH,(P) + MOVEI CH,A ;NOW CALL THE COMMAND BACK, GETTING RESULT IN A. + SETZ B, + CALL (TT) + MOVE B,-1(P) ;NOW CONVERT REL. IDX. INTO QVECTOR BACK INTO ADDRESS. + MOVE CH,MFBEGV(B) + IDIVI CH,5 + ADD CH,(P) + SUB P,[2,,2] + MOVE C,A ;NOW GO STORE VALUE IN QREG. + JRST USE2 + +;HERE AFTER SEEING A QREG NAME STARTS WITH AN ALTMODE, AS IN QFOO. [ +QREGN: SETZM SQUOTP ;Q^]A WHERE A HOLDS $FOO$ SHOULD WIN. + SAVE C + SAVE E ;FO CLOBBERS ALL ACS + SAVE FF + MOVE A,QRB.. + MOVE A,.QSYMT(A) ;GET THE PTR TO THE QVECTOR USED AS SYMBOL TABLE. + MOVE BP,A + CALL QBGET1 + SAVE B + TRZ FF,FRCLN\FRARG\FRARG2\FRUPRW + CALL FOCMD0 ;DO FO TO READ IN THE "FOO" AND SEARCH SYMBOL TABLE. + JFCL ;PUTS VAL IN A AND ADDR OF S.T.E. IN IN. + MOVEI CH,1(IN) ;CH GETS ADDR OF SLOT IN QVECTOR HOLDING THE VALUE. + MOVE IN,(IN) ;IN GETS THE STRING WHICH IS THE FULL NAME. + REST B ;RETURN IN B THE BUFFER BLOCK OF THE QVECTOR + TLO B,400000 + REST FF ;(FOR RELOCATION HACKERY IN QREGVA FOR :I AND X). + REST E + JRST POPCJ + +;SKIP IF CHAR IN CH IS A LETTER OR A DIGIT. ALSO, CONVERT LOWER +;CASE LETETRS TO UPPER CASE. +QRVTST: CAIL CH,"0 + CAILE CH,"9 + CAIA + JRST POPJ1 + CAIL CH,"A + CAILE CH,"Z + CAIA + JRST POPJ1 + CAIL CH,"A+40 + CAILE CH,"Z+40 + POPJ P, + SUBI CH,40 + JRST POPJ1 + +;READ IN A QREG NAME, AND RETURN IN CH THE ADDRESS OF THE QREG. +;CLOBBERS A AND CH. +QNMGET: SETZI A, + CALL SKRCH +QNMGE2: CAIN CH,". + AOJA A,QNMGET+1 + CAIE CH,^R + CAIN CH,^^ + JRST QNMGE3 + CALL QRVTST + RET + CAILE A,NQSETS-1 + RET + AOS (P) +QNMGE1: MOVEI CH,-"0(CH) + CAILE CH,9 + SUBI CH,"A-"9-1 + ADD CH,QRB(A) + RET + +QNMGE3: LSH A,7 ;HANDLE QREG NAME CONTAINING "^R" OR "^^": + CAIN CH,^^ + XORI A,100 +QNMGE5: SETZM BRCUAV ;[ ;IF A ^]^V IS DONE, BRCUAV WILL BECOME NEGATIVE. + CALL SKRCH ;READ IN NAME OF ^R-MODE CHARACTER + SKIPGE BRCUAV ;[ ;THE POINT OF THIS IS THAT ^]^V TRUNCATES TO 7 BITS, + HRRZ CH,BRCUAV ;BUT WE HAVE TO GET BACK THE 9-BIT VALUE. + XOR CH,A ;GET THE SPECIFIED CHAR. IN TV CHAR SET. + ANDI CH,777 + ADDI CH,RRMACT ;THE "QREG" IS THE RRMACT ENTRY FOR THE CHARACTER. + JRST POPJ1 + +;F^^ -- CONVERT A ^R-COMMAND NAME INTO A NUMBER (F^^.^R. RETURNS 174. = 256) +;:F^^ -- IF IS A VALID Q-REG NAME, RETURN THE +;:FSQPHOME$ OF THE Q-REG. OTHERWISE, RETURN 0. +FCTLUP: TRZE FF,FRCLN + JRST FCUP1 + CALL QNMGET + TYPRE [ARG] + MOVEI A,-RRMACT(CH) + CAIL A,1000 + TYPRE [ARG] + JRST POPJ1 + +FCUP1: TRZ FF,FRARG + MOVE A,C ;:F^^. + CALL QLGET0 ;DECODE THE STRING, B.P. IN BP AND LENGTH IN B. + JRST NRET0 + SETZ A, ;COUNT NUMBER OF DOTS IN A. +FCUP2: SOJL B,NRET0 ;STRING EXHAUSTED => NOT VALID. + ILDB CH,BP + CAIN CH,". ;NEXT CHAR IS A DOT => JUST COUNT IT. + AOJA A,FCUP2 + CAIE CH,^R ;NON-DOT => WE'RE NEAR THE END NOW. + CAIN CH,^^ + JRST FCUP3 ;^R CHARACTER DEFN NAMES ARE OK TOO. + CALL QNMGE2 ;ELSE FIGURE OUT THE QREG NAME, + SETZ CH, ;NO SKIP MEANS IT ISN'T A VALID ONE, SO RETURN 0. + MOVE A,CH ;ELSE QNMGE2 LEFT THE DESIRED VALUE IN CH. + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +FCUP3: LSH A,7 ;^R CHARACTER DEFN NAME => PUT DOTS IN CTL AND META BITS, + CAIN CH,^^ + XORI A,100 ;FOR ^^ CONTROLIFY WHAT FOLLOWS. + SOJL B,NRET0 ;STRING EXHAUSTED RIGHT AFTER THE ^R OR ^^ => LOSE. + ILDB CH,BP + XOR A,CH ;ELSE MERGE CHAR WITH DOTS AND RETURN. + ANDI A,777 + ADDI A,RRMACT + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +;FO COMMAND - BINARY SEARCH A TABLE FOR A GIVEN STRING. +;FOLLOW BY QREG WHICH POINTS TO A STRING OR BUFFER CONTAINING THE TABLE +;(MUST BE ON A WORD BOUNDARY, SO USELESS WITH IMPURE STRINGS). +;AFTER THE QREG NAME COMES THE STRING TO SEARCH FOR. +;THE FIRST WORD OF THE TABLE MUST CONTAIN THE SIZE (IN WORDS) OF +;ALL THE ENTRIES; AFTER IT COME THE ENTRIES. THE FIRST WORD OF EACH ENTRY +;IS ASSUMED TO BE THE POINTER TO THE NAME-STRING TO SEARCH FOR. +;IF THE TABLE IS A PURE STRING, THAT PONTER IS RELATIVE TO THE TABLE ITSELF. +;PLAIN FO GETS AN ERROR (UVN OR AVN) IF THE TARGET NAME IS MISSING OR AMBIGUOUS; +;OTHERWISE, IT RETURNS THE VALUE IN THE SECOND WORD OF THE ENTRY. +;:FO RETURNS THE OFFSET OF THE ENTRY FOUND; IF THE TARGET IS NOT FOUND +;OR AMBIGUOUS, MINUS THE OFFSET OF THE ENTRY TO INSERT BEFORE IS RETURNED. +;FO RETURNS THE VALUE OF THE VARIABLE IF IT IS DEFINED, OTHERWISE. +;"^" MODIFIER => DON'T ALLOW ABBREVIATIONS, JUST EXACT MATCHES. +FOCMD: CALL QREGX ;READ THE QREG NAME. +FOCMD0: MOVEI J,STAB-1 ;THEN ACCUMULATE STRING TO SEARCH FOR IN STAB. + MOVEI B,40 ;B HOLDS PREVIOUS CHARACTER, FOR COMPRESSING SPACES. + TRZ FF,FRNOT +FOCMD1: CALL ORCH ;READ CHAR, CONVERT LETTERS TO U.C. + CAIN CH,ALTMOD + SKIPE SQUOTP + CAIA + JRST FOCMD2 + SKIPGE SQUOTP ;ALLOW FOR SUPERQUOTED SPACES + HRLI CH,-1 + CAIN CH,^I + MOVEI CH,40 ;CONVERT ALL TABS TO SPACES. + CAIN CH,40 ;CHECK FOR MULTIPLE OR LEADING WHITESPACE. + CAIE B,40 ;IF THIS CHAR AND PREVIOUS BOTH SPACING, IGNORE THIS ONE. + CAIA + JRST FOCMD1 + MOVE B,CH ;REMEMBER THIS CHAR AS PREVIOUS FOR NEXT. + HRRZS CH + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;REMEMBER CHAR IN STAB. + JRST FOCMD1 + +FOCMD2: CAIN B,40 ;FLUSH TRAILING SPACES. + SOS J +;ENTER HERE FROM F^G COMMAND. +FOCMD3: CALL QLGET0 ;GET TABLE LENGTH IN CHARS IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + IBP BP + HLRZ A,BP + CAIE A,350700 ;TABLE MUST START ON WORD BOUNDARY. + TYPRE [ARG] + MOVE C,(BP) ;C GETS ENTRY SIZE IN WORDS, FROM 1ST WORD OF TABLE. + MOVE OUT,B + IDIVI OUT,5 ;SIZE MUST BE INTEGRAL # OF WORDS. + SKIPE OUT+1 .SEE CH + TYPRE [ARG] + SOS CH,OUT ;OUT GETS TABLE SIZE, NOT COUNTING 1ST WORD (SIZE PER ENTRY). + IDIV CH,C + SKIPE CH+1 .SEE Q + TYPRE [ARG] ;TABLE MUST BE INTEGRAL NUMBER OF ENTRIES. + MOVEI IN,1(BP) ;IN -> 1ST WORD (NOT COUNTING ENTRY-SIZE WORD AT FRONT). + ADD OUT,IN ;OUT -> LAST WORD + 1 + HRRZ E,BP + IMULI E,5 ;E GETS CHAR ADDR OF START OF TABLE (INCLUDING DOPE WORD). + CAML E,BFRTOP ;IF TABLE IS A PURE STRING, SET FRNOT, INDICATING + TRO FF,FRNOT ;NAME POINTERS ARE RELATIVE TO BOTTOM OF STRING (NEED E ADDED). + SUBI E,4 + TLO E,400000 + MOVE T,OUT ;SAVE BOUNDS OF WHOLE TABLE AS [E,T) ;] + HRRZS J ;J POINTS AT END OF STUFF IN STAB. + CAIGE J,STAB + JRST FOCMDU ;ARG NULL AFTER HACKING IT => NO GOOD. + JRST FOCMDN + +;NOW TRY TO NARROW THE RANGE [IN,OUT) WHICH THE OBJECT MIGHT BE IN. ;] +;E HAS CHAR ADDR START OF TABLE MINUS 4 (WITH SIGN SET), +;T -> WORD AFTER END, C HAS ENTRY SIZE IN WORDS, +;J POINTS TO LAST USED WORD IN STAB. +FOCMDN: MOVE CH,OUT + SUB CH,IN + CAMG CH,C + JRST FOCMDF ;NARROWED TO ONE ENTRY => IT'S THAT OR NOTHING. + IDIV CH,C ;HOW MANY ENTRIES THEN? + MOVE D,CH + LSH D,-1 ;BINARY SEARCH STEP IS HALF THAT MANY. + IMUL D,C + ADD D,IN ;GET PTR TO MIDDLE OF RANGE; COMPARE THAT POINT WITH TARGET. + CALL FOCMP + JRST [ MOVE OUT,D ;TARGET IS LESS => NARROW TO BOTTOM HALF-RANGE. + JRST FOCMDN] + JRST [ MOVE IN,D ;TARGET IS MORE => NARROW TO TOP HALF-RANGE. + JRST FOCMDN] + MOVE IN,D + JRST FOCMDW ;TARGET IS EQUAL => WE CERTAINLY WIN. + +;NARROWED TO JUST ONE ENTRY; IS IT GOOD? +FOCMDF: CAML IN,T + JRST FOCMDU + MOVE D,IN ;FIRST OF ALL, THIS ENTRY IS THAT LAST ONE L.E. TARGET. + CALL FOCMP ;SO ADVANCE TO THE FIRST ONE G.E. THE TARGET + CAIA + ADD IN,C ;SINCE THE TARGET MIGHT BE ABBREVIATION FOR THAT ONE. + CAML IN,T ;DETECT CASE THAT TARGET IS GREATER THAN ALL SYMBOLS + JRST FOCMDU + MOVE OUT,IN + ADD OUT,C + MOVE A,(IN) + CALL FOCMDA ;DOES TARGET ABBREVIATE ENTRY'S NAME? + JRST FOCMDU ;NO => TARGET NOT FOUND, RETURN 0. + JUMPE B,FOCMDW ;YES, MAY BE GOOD. IF EXACT MATCH, CERTAINLY GOOD. + TRNE FF,FRUPRW ;"^" AND NOT EXACT MATCH => IT'S "UNDEFINED". + JRST FOCMDU + CAMN OUT,T + JRST FOCMDW ;NO FOLLOWING ENTRY => NAME CAN'T BE AMGIBUOUS. + MOVE A,(OUT) ;DOES FOLLOWING ENTRY ALSO WIN? + CALL FOCMDA + JRST FOCMDW ;NO => THIS ENTRY WINS! + TRNE FF,FRARG ;AMBIGUOUS NAME. IF HAVE DEFAULT (ARG), RETURN IT. + JRST FOCMDU + TRZN FF,FRCLN ;OR ELSE MAYBE GIVE ERROR, + TYPRE [AVN] +FOCMDL: MOVEI A,-1(IN) ;MAYBE RETURN MINUS THE PLACE TO PUT THE NAME. + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + IDIVI E,5 ;E GETS WORD BEFORE THE WORD TABLE STARTS IN. + SUBM E,A + JRST POPJ1 + +FOCMDU: TRZE FF,FRARG ;HERE IF NAME IS UNDEFINED; IN -> PLACE TO INSERT IT. + JRST [ TRZ FF,FRCLN\FRUPRW + MOVE A,NUM + JRST POPJ1] + TRZN FF,FRCLN + TYPRE [UVN] + JRST FOCMDL + +FOCMDW: MOVE A,1(IN) ;FOUND THE TARGET. RETURN EITHER 2ND WORD OF ENTRY + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + TRZN FF,FRCLN + JRST POPJ1 + MOVEI A,-1(IN) + IDIVI E,5 + SUB A,E + JRST POPJ1 ;OR THE INDEX OF THE ENTRY. + +;SKIP IF THE STRING IN STAB IS AN ABBREVIATION FOR THE STRING A POINTS TO +;(A HOLDS TECO STRING POINTER). +FOCMDA: TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;SKIP IF TARGET ABBREVIATES THE STRING A POINTS TO. + TYPRE [QNS] + MOVEI Q,STAB +FOCMDG: CAMLE Q,J + JRST POPJ1 ;JUMP IF TARGET ABBREVIATES ENTRY'S NAME. + JUMPE B,CPOPJ ;TARGET DOESN'T ABBREVIATE ENTRY'S NAME => TARGET NOT FOUND. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAME CH,(Q) + RET + SOS B + AOJA Q,FOCMDG + +;COMPARE STRING IN STAB (TARGET) WITH STRING THAT @(D) POINTS TO. SKIP ONCE +;IF TARGET BIGGER, SKIP TWICE IF EQUAL. +FOCMP: MOVE A,(D) ;GET THIS ENTRY'S NAME. + TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;DECODE AS STRING. + TYPRE [QNS] + MOVEI Q,STAB ;Q SCANS TARGET, BP SCANS THIS ENTRY'S NAME. +FOCMPL: JUMPE B,[CAMLE Q,J + JRST POPJ2 ;IF BOTH STRINGS EXHAUSTED, THEUY ARE EQUAL. + JRST POPJ1] ;TARGET HAS MORE => IT IS BIGGER. + CAMLE Q,J + RET ;TARGET EMPTY, BUT THIS ENTRY NAME HAS MORE => TARGET LESS. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMGE CH,(Q) + JRST POPJ1 ;TARGET IS BIGGER. + CAMLE CH,(Q) + RET ;TARGET SMALLER. + SOS B + AOJA Q,FOCMPL ;EQUAL SO FAR, KEEP LOOKING. + +SUBTTL DECODE A STRING POINTER + +;CH HAS QREG IDX; DON'T SKIP IF QREG NOT STRING. +;ELSE SKIP WITH B HOLDING # CHARS OF TEXT IN STRING (NOT INCLUDING HEADER), +;BP HOLDING A B.P. TO ILDB THE TEXT. CLOBBERS TT, TT1. +QLGET: MOVE A,(CH) +QLGET0: CAML A,[SETZ+LHIMAX*5*2000] + RET ;CAN'T BE EITHER PURE OR IMPURE SPACE. +QLGET1: MOVE BP,A + TLZ BP,400000 ;FLUSH THE SIGN BIT (SET IN ALL POINTERS) + CAMGE BP,BFRTOP ;IF IT'S IMPURE SPACE, + ADD BP,QRBUF ;POINTER IS RELATIVE TO START OF IMPURE SPACE. +QLGET2: PUSHJ P,GETBP +QLGET3: LDB B,BP + CAIN B,QRBFR + JRST QLGET5 + CAIE B,QRSTR + RET + AOS (P) +QLGET4: ILDB B,BP + ILDB TT,BP + ROT TT,7 + IOR B,TT + ILDB TT,BP + LSH TT,14. + IOR B,TT + SUBI B,4 + RET + +;HANDLE THE CASE IN WHICH QLGET IS CALLED ON QREG HOLDING A BUFFER. +QLGET5: CALL QLGET4 ;GET ADDR OF HEADER, MINUS 4, IN B. + ADDI B,4 + JUMPE B,CPOPJ ;GIVE 0 AS LENGTH OF DEAD BUFFER + SAVE T + SAVE C + MOVEI C,(B) ;IF THIS BUFFER IS CURRENT, THE VALUES IN ITS HEADER + CAMN C,BFRPTR ;MAY BE OUT OF DATE. UPDATE THEM BY RESELECTING. + CALL NEWBFR + MOVE BP,MFGPT(B) + CAMG BP,MFBEGV(B) + JRST QLGET6 + CAML BP,MFZV(B) ;IF THE GAP IS WHERE IT WILL DO HARM, THEN MOVE IT TO WHERE IT WON'T. + JRST QLGET6 + SAVE BFRPTR ;PUSH CURRENT BUFFER, + MOVEI C,(B) ;SELECT THE ONE BEING QLGET'ED + CALL NEWBFR + SAVE PT + MOVE BP,ZV + MOVEM BP,PT ;PUT PT WHERE WE WANT THE GAP TO BE + CALL GAPSL0 ;AND MOVE THE GAP THERE. (WITHOUT SETTING MODIFF, NOT REALLY MODIFYING) + REST PT + REST C ;POP THE SELECTED BUFFER. + CALL NEWBFR +QLGET6: REST C + MOVE BP,MFBEGV(B) ;GET VIRT ADDR OF BEGINNING OF BUFFER + MOVE T,MFZV(B) + SUB T,BP ;GET LENGTH OF BUFFER. + CAML BP,MFGPT(B) + ADD BP,MFEXTR(B) ;CONVERT VIRT ADDR TO REAL ADDR. + MOVE B,T + REST T + AOS (P) + JRST GETIBP ;RETURN IN BP, B.P. TO ILDB BUFFER. + +SUBTTL Q-REGISTER COMMANDS + +;FQ - RETURN LENGTH OF TEXT IN , OR -1 IF NOT TEXT. +QLEN: PUSHJ P,QREGX + PUSHJ P,QLGET0 +RETM1A: SKIPA A,[-1] + MOVE A,B + JRST POPJ1 + +;Q - RETURN CONTENTS OF QREG AS A NUMBER. +QREG: AOS (P) + JRST QREGX + +;% - INCREMENT , RETURN NEW VALUE. +PCNT: CALL QREGS ;READ QREG NAME, GET IDX IN CH. + AOS C,A ;INCREMENT. PUT IN C FOR USE2 AND IN A TO RETURN. + AOS (P) ;WE ALWAYS RETURN A VALUE. + JRST USE2 ;GO STORE BACK IN QREG. + +;U - PUT NUMERIC ARG IN . 2 ARGS => USE 2ND, RETURN 1ST. +USE: TRZN FF,FRARG + TYPRE [WNA] + ARGDFL + CALL QREGS +USE1: CAIN CH,A ;MAKE SURE U* IS A NO-OP. + JRST POPJ1 + TRZN FF,FRARG2 ;M,NUQ SHOULD RETURN M. + JRST USE2 + MOVE A,E + AOS (P) +;STORE THE CONTENTS OF C INTO THE QREG IN CH. +;B IS ASSUMED TO CONTAIN WHAT QREGX LEAVES THERE. +USE2: CAIN CH,$QBUFR ;SELECT A NEW BUFFER BEFORE! SETTING ..O, IN CASE IT GETS ERROR. + CALL BFRSET + SKIPE VARMAC + JUMPL B,USE3 ;IF SETTING A NAMED VARIABLE, SEE IF THERE'S A MACRO TO RUN. + MOVEM C,(CH) + RET + +USE3: SAVE A + SAVE B +IFN ITS,[ + MOVE A,MACHIN + CAMN A,[SIXBIT/AI/] +] + SKIPN A,1(CH) ;LOOK AT THE THIRD WORD OF THE NAMED VARIABLE'S DATA BLOCK. + JRST USE4 ;(IF VARMAC IS SET, WE ASSUME THAT WORD EXISTS). + CALL QLGET0 ;IS IT A STRING? + JRST USE4 + ILDB B,BP ;DOES IT START WITH "!"? + CAIN B,"! + CALL [ CALL SAVACS ;BOTH YES => CALL IT WITH NEW VALUE OF VARIABLE AS ARG. + CALL MACXCP + JRST RSTACS] +USE4: MOVEM C,(CH) ;THEN, OR IN ANY CASE, SET THE VARIABLE. +POPBAJ: REST B + REST A + RET + +;FP RETURNS AN INDICATION OF 'S DATA TYPE: +;-4 => NUMBER (NOT IN RANGE FOR PURE OR IMPURE STRING SPACE) +;-3 => PURE OBJECT WITH MEANINGLESS HEADER +;-2 => IMPURE OBJECT WITH MEANINGLESS HEADER +;-1 => DEAD BUFFER +;0 => LIVING BUFFER +;1 => Q-VECTOR. +;100 => PURE STRING +;101 => IMPURE STRING +FDATTY: MOVNI A,4 + TRZN FF,FRARG + TYPRE [WNA] + TLZN C,400000 ;MUST BE CLOSE TO 400000,, TO BE ANYTHING BUT A NUMBER. + JRST POPJ1 + MOVE BP,C + CAML C,BFRBOT ;IS IT IN RANGE FOR IMURE SPACE? + JRST [ MOVE D,LHIPAG + IMULI D,5*2000 + CAMGE C,[LHIMAX*5*2000] ;NO, WHAT ABOUT PURE SPACE? + CAMGE C,D + JRST POPJ1 ;NO, ORDINARY NUMBER + AOJA A,FDATT2] ;YES, SEE WHAT KIND OBJECT (A _ -3) + ADD BP,QRBUF ;ADDR'S IN IMPURE SPACE ARE REL. TO QRBUF. + MOVNI A,2 +;A HAS -2 FOR IMPURE SPACE, -3 FOR PURE SPACE. +;SEE IF OBJECT IS STRING, BUFFER OR NOTHING. +FDATT2: CALL GETIBP + ILDB B,BP + CAIN B,QRSTR ;STRING => RETURN 100. OR 101. + JRST [ ADDI A,103. + JRST POPJ1] + CAIE B,QRBFR + JRST POPJ1 ;NOTHING => RETURN -3 OR -2. + CALL QLGET4 ;BUFFER: IS IT STILL ALIVE? + ADDI B,4 ;B GETS BUFFER BLOCK ADDR, OR 0 IF DEAD BUFFER. + JUMPE B,RETM1A ;RETURN -1 IF DEAD. + MOVEI A,0 + MOVE C,(B) + TLNE C,MFQVEC + AOS A ;IF Q-VECTOR, RETURN 1, ELSE 0. + JRST POPJ1 + +QGET3: TRZ FF,FRARG\FRARG2 + JRST QGET4 + +;G COMMAND -- INSERT QREG IN BUFFER BEFORE PT. +;,G -- GET RANGE OF CHARS , FROM QREG. +;FS INSLEN$ IS SET TO # CHARS INSERTED. +;:G -- RETURN THE 'TH CHARACTER OF . +QGET: CALL QREGX +QGET4: CALL QLGET0 + JRST [ MOVE C,A ? JRST BAKSL1] + TRNN FF,FRARG + SETZ C, + CAMLE C,B ;MAKE SURE UNCOMMA'D ARG, IF ANY, IS WITHIN RANGE + MOVE C,B ;[0 , ] + SKIPGE C + SETZ C, + TRNE FF,FRARG ;DETECT THE 1-ARG CASE (ONLY LEGAL WITH COLON). + TRNE FF,FRARG2 + CAIA + JRST QGET7 + TRNN FF,FRARG2 ;(IF NO ARGS, C AND E MAY BE RANDOM. PREVENT 2<1 ERROR). + SETZB C,E + SKIPGE E + SETZ E, + CAMLE E,C ;MAKE SURE ARGS ARE IN INCREASING ORDER. + TYPRE [2%1] + TRNN FF,FRARG2 + SKIPA C,B ;IF NO ARGS, # CHARS TO INSERT IS LENGTH OF QREG. + SUB C,E ;IF ARGS, IT IS DIFFERENCE BETWEEN ARGS. + MOVEM C,INSLEN +QGETI: SAVE A + CALL SLP ;INSERT BUFFER SPACE OR PREPARE TO WRITE AT QRWRT. LEAVE BP. IN BP. + MOVE IN,BP + REST A + JUMPE C,SLPXIT + CALL QLGET0 ;IN CASE QREG IS BUFFER AND WAS MOVED BY SLPGET, + .VALUE ;RECOMPUTE THE BYTE PTR TO IT. + JUMPE E,QGET1 ;IF NOT STARTING AT BEGINNING OF STRING, + CALL GETCA ;MAKE B.P. -> ARG1'TH CHAR OF QREG. + ADD BP,E + CALL GETBP +QGET1: HLRZ CH,BP + HLRZ D,IN + CAIN CH,010700 + CAIE D,010700 ;IF WE'RE AT A WORD BOUNDARY IN BOTH QREG AND BUFFER, + JRST QGET2 + CAIGE C,5 ;AND TRANSFERING AT LEAST 1 WORD, + JRST QGET2 + IDIVI C,5 ;DO A BLT TO AVOID LOSING LOW BITS. + MOVEI CH,1(IN) + HRLI CH,1(BP) + ADD BP,C ;AND UPDATE BOTH B.P.'S TO POINT AFTER WHAT WE'RE BLT'ING. + ADD IN,C + BLT CH,(IN) + SKIPN C,D ;# CHARS NOT TRANSFERED BY THE BLT. + JRST QGET6 +QGET2: ILDB CH,BP + IDPB CH,IN + SOJG C,QGET2 +QGET6: MOVE BP,IN ;IF WRITING A STRING, SLPXIT REQUIRES B.P. TO LAST CHAR IN BP. +SLPXIT: TRZN FF,FRCLN ;WRITING IN BUFFER => FINISHED. + RET + TRZ FF,FRUPRW+FRARG+FRARG2 ;WRITING A STRING => FINISH CONSING AND RETURN IT. + AOS (P) + JRST QCLOSV + +QGET7: TRZN FF,FRCLN ;1 ARG TO G IS BAD NUMBER UNLESS WE HAVE A COLON. + TYPRE [WNA] + CAML C,B + TYPRE [ARG] + TRZ FF,FRUPRW+FRARG + CALL GETCA ;INCREMENT THE B.P. IN BP BY THE # CHARS WHICH IS THE ARG. + ADD BP,C + CALL GETBP + ILDB A,BP ;AND FETCH THAT CHARACTER AND RETURN IT AS VALUE OF :G. + JRST POPJ1 + +X: CALL QREGVS + CALL GETANU ;X COMMAND, GET ENDS OF AREA IN C,E. +X12: TRZ FF,FRARG\FRARG2 ;FLUSH ARG; AVOIDS LOSSAGE FOR X* WHICH RETURNS VALUE. + JUMPE B,X10 ;IS THE QREG SUBSCRIPTED? (X:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS X10, THEN RETURNS TO INSERT'S CALLER. + +X10: SAVE CH + SAVE B + TRZE FF,FRUPRW + PUSHJ P,QLGET0 ;APPENDING TO QREG-GET PREVIOUS LENGTH/LOCATION + SETZB B,BP + SAVE B + SAVE BP + CALL CHK1 + SUB C,E ;C HAS # CHARS TO X AWAY + ADDI C,4 ;THEN INCLUDE 4 CHARS FOR HEADER. + ADD C,-1(P) ;HOW MUCH SPACE, INCLUDING OLD STRING WE ARE APPENDING TO? + SAVE C + MOVN J,BEG + CALL SLPQGT ;MAKE SURE HAVE ENOUGH SPACE IN IMPURE STRING SPACE. + ADD J,BEG ;CHANGE IN BEG = AMOUNT BUFFER MOVED. + ADD E,J ;RELOCATE ADDR OF START OF AREA OF BUFFER TO X FROM. + MOVE C,(P) ;GET LENGTH INCL. HEADER. + MOVEI B,QRSTR ;AND 1ST CHAR FOR HEADER. + CALL QHDRW1 ;WRITE THE HEADER IN BOTTOM OF FREE AREA. + REST C + SUBI C,4 ;C HAS LENGTH NOT INCL. HEADER. + SKIPN J,-1(P) ;ANY CHARS TO APPEND TO? + JRST X8 + SUB C,J ;YES, COUNT OFF THAT MANY AS INSERTED, + MOVE OUT,(P) ;GET BP TO ILDB OLD TEXT TO APPEND TO, +X7: ILDB CH,OUT ;AND COPY INTO NEW STRING. + IDPB CH,BP + SOJG J,X7 +X8: MOVE IN,E +X1: SOJL C,X2 ;MAYBE INSERTED ALL THE CHARS. + CALL GETINC ;IF NOT, INSERT THE NEXT. + IDPB CH,BP + JRST X1 + +X2: CALL GETCA + AOS OUT,BP ;GET CHAR ADDR OF LAST+1. + TRZ FF,FRCLN\FRUPRW + SUB P,[2,,2] ;FLUSH INFO ON OLD STRING TO APPEND TO. + REST B + JRST QCLOSP ;POP QREG ADDR AND STORE STRING IN IT. + +SUBTTL Q-REGISTER PDL + +;[ - PUSH ONTO QREG PDL. ;] +OPENB: ARGDFL ;MAKE -[0 THE SAME AS -1[0 + CALL QREGX ;READ THE QREG VALUE IN A AND ADDR IN CH. + SAVE CH + SKIPLE B ;IF THIS QREG IS REALLY AN ELT OF A QVECTOR, + TYPRE [IQN] ;AUTO-UNWIND WOULD LOSE, SO COMPLAIN. + SKIPGE B + MOVE CH,IN ;FOR NAME QREGS, PUSH INTERNED NAME-STRING AS QREG ADDR. + SAVE B ;PRESERVE FLAG FOR USE1. + MOVE B,PF + CAMN B,PFTOP ;CHECK FOR OVERFLOW BEFORE WRITING ANYTHING. + TYPRE [QRP] + PUSH B,A ;THEN PUSH OLD CONTENTS + CALL OPENB3 ;GO PUSH ADDR OF QREG (FOR UNWINDING) AND RETURN. + REST B + REST CH ;GET BACK ACTUAL LOCATION OF QREG + TRZN FF,FRARG ;AND IF WE HAVE ARG, STORE ARG INTO IT. + RET + JRST USE1 ;DO IT VIA USE SO THAT STORING INTO ..O WORKS. + +OPENB2: MOVE B,PF + CAMN B,PFTOP ;DETECT OVERPUSH BEFORE A PDLOV INT HAPPENS. +OPENB1: TYPRE [QRP] + PUSH B,(CH) +OPENB3: PUSH B,CH +FSQPU2: MOVEM B,PF + POPJ P, + +;[[ ;] - POP FROM QREG PDL INTO . ]* POPS AND RETURNS AS VALUE. +CLOSEB: CALL QREGVS ;CAN MAKE US SKIP! + CAIA +;POP INTO ADDRESS SUPPLIED IN CH. ASSUME IT'S NOT A NAMED VARIABLE. +CLOSB2: SETZ B, ;B SUPPLIES INFORMATION TO USE2. + MOVE A,PF + CAMN A,PFINI ;DETECT UNDERFLOW FIRST THING. + TYPRE [QRP] + POP A,C + POP A,C ;C GETS VALUE POPPED FROM SLOT. + MOVEM A,PF ;MARK SLOT GONE BEFORE WE STORE, SINCE USE2 CAN ERR. + JRST USE2 + +;FS QPPTR $ -- GET OR SET QREG PDL POINTER. +;TAKES AND RETURNS # ENTRIES ON STACK. +FSQPPT: HRRZ A,PF + SUBI A,PFL-1 ;GET 2*<# ENTRIES NOW ON STACK> + LSH A,-1 ;A HAS VALUE TO RETURN. + TRZN FF,FRARG + JRST POPJ1 ;NO ARG => JUST RETURN THE VALUE. + CALL FSQPRG ;CONVERT ARG TO NEW PDL PTR. + MOVEM C,PF ;STORE NEW CONTENTS. + JRST POPJ1 + +;HANDLE ARGUMENT DECODING FOR FS QP SLOT, FS QP PTR, AND FS QP UNWIND. +FSQPRG: ARGDFL + JUMPL C,FSQPR1 + LSH C,1 ;ARG -> PTR TRANSFORMATION IS INVERSE OF + HRLI C,(C) ;PTR -> VALUE TRANSFORMATION DONE ABOVE. + ADD C,PFINI + CAMLE C,PF + JRST TYPAOR ;DON'T ALLOW REF. TO CELLS ABOVE CURRENT POINTER POS. + RET + +FSQPR1: LSH C,1 ;NEGATIVE ARG IS RELATIVE TO CURRENT POINTER. + HRLI C,-1(C) + ADD C,PF + CAMGE C,PFINI ;DON'T ALLOW REF BELOW BOTTOM OF QREG PDL. + JRST TYPAOR + RET + +PFINI: -LPF-1,,PFL-1 +PFTOP: -1,,PFL+LPF-1 + +;FS QP HOME$ RETURNS A STRING WHICH IS THE NAME OF THE Q-REG THAT WAS +;PUSHED INTO PDL SLOT . :FSQP HOME$ RETURNS A NUMBER THAT ENCODES +;THAT NAME - SUCH NUMBERS ARE USEFUL IN THAT, IN A GIVEN TECO, EACH QREG +;HAS A UNIQUE NUMBER. WITH NO COLON, IF THE SLOT WAS PUSHED WITH +;F[FOO$, WE RETURN "FSFOO$". ;] +;^ FS QPHOME$ CONVERTS AN NUMBER WHICH IS A :FSQPHOME VALUE INTO A +;DESCRIPTIVE FSQPHOME$-STYLE STRING. SO :FSQPHOME$ ^ FSQPHOME$ = FSQPHOME$. +FSQPHO: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRUPRW + JRST FSQPH2 + CALL FSQPRG ;FIND SLOT . + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + MOVE C,2(C) ;GET WHERE PUSHED FROM. + MOVE A,C +FSQPH2: TRZE FF,FRCLN ;NUMERIC FORM MAY BE WHAT WE WANT. + JRST POPJ1 ;OTHERWISE, MUST DECODE AND TURN INTO STRING: + ;ALREADY A STRING => IT IS VARIABLE NAME; PUT ALTMODES AROUND IT. + JUMPL C,[ MOVEM C,NUM + MOVEI A,[ASCIZ /[0 :I*Q0/] ;] + JRST MACXQV] ;THAT'S DONE MOST EASILY BY TECO COMMANDS. + MOVEI A,[ASCIZ /:I**/] + CAIN C,BAKTAB ;IF A [(...) PUSHED THIS SLOT, RETURN "*". ;] + JRST MACXQV + CAIGE C,FLAGSL*2 ;IF AN F[ PUSHED THIS, ;] + JRST [ MOVE C,FLAGS(C) ;RETURN NAME OF FLAG IN ASCII. + JRST FSIXFL] + MOVE E,C + MOVEI C,6 ;OTHERWISE IT WAS A NORMAL QREG OR A ^R COMMAND DEFINITION. + CALL QOPEN ;SO START CONSING UP A STRING WITH THE NAME. + MOVEI CH,"Q + IDPB CH,BP + CAIGE E,RRMACT + JRST FSQPH1 + SUBI E,RRMACT ;IT WAS A ^R COMMAND. WHAT WAS 9-BIT CHARACTER? + IDIVI E,200 + CALL FSQPH. ;PUT OUT 1 DOT FOR CTL, 2 FOR META, 3 FOR BOTH. + MOVEI CH,^R + IDPB CH,BP +FSQPH3: IDPB J,BP ;THEN THE ASCII PART OF THE CHARACTER. + AOS (P) + JRST QCLOSV ;INISH CONSING THE STRING AND RETURN IT. + +FSQPH1: SUBI E,QTAB ;ORDINARY OLD-FASHIONED QREG. + IDIVI E,36. ;HOW MANY DOTS? + CALL FSQPH. + ADDI J,"0 ;CONVERT WHAT'S LEFT TO A LETTER OR DIGIT. + CAILE J,"9 ;(STARTS OUT AS IDX IN QRB, QRB. OR QRB..). + ADDI J,"A-"0-10. + JRST FSQPH3 + +FSQPH.: MOVEI CH,". ;OUTPUT DOTS THRU BP IN BP. J SAYS HOW MANY. + JUMPE E,CPOPJ + IDPB CH,BP + SOJA E,FSQPH. + +MACXQV: CALL MACXQW ;EXECUTE A MACRO IN A AND RETURN THE VALUE IT RETURNS. + MOVE A,NUM + TRZ FF,FRARG\FRARG2\FRUPRW\FRCLN + JRST POPJ1 + +; FS QPSLOT $ -- RETURNS CONTENTS OF SLOT . +;,FS QPSLOT $ ALSO SETS THE SLOT TO . +FSQPSL: MOVE E,SARG + TRZN FF,FRARG ;MUST HAVE ARG TO KNOW WHICH SLOT. + TYPRE [WNA] + TRZE FF,FRARG2 ;IF 1 ARG, IT'S SLOT #, IN C. + TRO FF,FRARG ;IF 2, SLOT #'S IN C, NEW VALUE IN E. + CALL FSQPRG ;FIND ADDRESS OF DESIRED SLOT IN C. + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + EXCH C,E + AOJA E,FSNOR1 ;WORD TO GET OR SET IS 2ND WORD OF SLOT. + +; FS QPUNWIND $ -- UNWINDS QREG PDL TO LEVEL . +;THAT IS, POPS EACH ENTRY BACK INTO THE QREG IT WAS PUSHED FROM. +FSQPUN: TRZN FF,FRARG ;NO ARG => ASSUME 0. + SETZ C, + PUSHJ P,FSQPRG ;COMPUTE LEVEL TO UNWIND TO FROM ARG. +FSQPU0: MOVE B,PF +FSQPU1: CAMG B,C ;DOWN TO DESIRED LEVEL? + JRST FSQPU2 ;JUST SET PF & EXIT + POP B,CH ;POP 1 ENTRY + JUMPL CH,FSQPU5 ;JUMP IF "QREG ADDR" IS A STRING - MEANS IT IS QREG NAME, A LA QFOO. +IF2 IFG FLAGSL*2-QTAB,.ERR QRP CAN'T TELL [ FROM F[ + ;]] + CAIGE CH,FLAGSL*2 ;IF ENTRY WAS MADE BY AN F[, POP INTO FLAG. ;] + JRST FSQPU4 + CAIN CH,$QUNWN ;IF UNWINDING Q..N, + JRST [ MOVE A,(CH) + POP B,(CH) ;POP IT, STORING OR SAVING ALL TEMPS, + JRST FSQPU3];AND GO MACRO IT. + POP B,(CH) + CAIN CH,$QBUFR ;IF UNWINDING Q..O, WE'RE SELECTING A NEW BUFFER. + CALL BFRSE2 + JRST FSQPU1 + +FSQPU4: SAVE C ;HANDLE UNWINDING AN FS FLAG. + POP B,C ;GET OLD FLAG VALUE, AS ARG. + MOVS E,FLAGD(CH) + SAVE FF + IORI FF,FRARG ;SAY THERE'S AN ARG. + MOVEM B,PF + CALL (E) ;SET THE FLAG. + JFCL + REST FF ;DON'T LET THE ROUTINE CLOBBER THE VALUES. + REST C + JRST FSQPU0 + +FSQPU3: JUMPE A,FSQPU1 + JSP T,OPEN1 ;HANDLE UNWINDING Q..N; MUST PRESERVE TEMPS. +FSQPU6: SAVE C + MOVEM B,PF + CALL MACXQW ;EXECUTE THE INNER BINDING OF ..N (WHICH IS IN A). + REST C + HRROI T,FSQPU0 + TRZ FF,FRARG+FRARG2+FRSYL+FROP + JRST CLOSE2 ;POP WHAT OPEN PUSHED, AND GO TO FSQPU0 + +FSQPU5: MOVE A,CH ;POP INTO LONG-NAMED QREG WHOSE NAME IS IN CH. + JSP T,OPEN1 + MOVEM A,SARG + TRO FF,FRARG\FRARG2 + TRZ FF,FRCLN\FRUPRW\FRSYL\FROP + POP B,NUM + MOVEI A,[ASCIZ /[0 U0/] ;] + JRST FSQPU6 + +SUBTTL M SUBROUTINE CALL COMMAND + +;M SAVES CURRENT EXECUTION POINTERS AND THEN EXECUTES CONTENTS OF . + ; MAY CONTAIN TEXT OR THE ADDRESS OF A BUILT-IN FUNCTION. +;:M JUMPS INTO THE STRING IN AND DOESN'T RETURN - BUILT-IN FUNCTIONS NOT ALLOWED. +MAC: CALL QREGX ;GET A NAME AND PUT ITS ENTRY IN A + CAIL CH,RRMACT ;FOR M^R ETC, PUT THE CHARACTER WHOSE DEFINITION IS BEING RUN + CAIL CH,RRMACT+1000 + JRST MAC6 + SUBI CH,RRMACT ;IN Q..0. + MOVEM CH,$Q..0 +MAC6: MOVE CH,$Q..0 +MAC5: CALL QLGET0 ;REALLY TEXT? IF SO, LENGTH IN B, BP TO ILDB TEXT IN BP. + JSP T,MACN ;NOT REALLY TEXT; USE AS BUILT-IN FUNCTION ADDRESS. + TRNE FF,FRCLN ;IF YOU ARE DOING A :M, DON'T PUSH THE CALLING STRING + JRST MAC3 +MAC2: MOVEM BP,INSBP ;ELSE PUSH THE STRING CONTAINING THE "M" BEFORE JUMPING. + CALL PUSMAC ;WE SAVE THE B.P. TO THE MACRO BEING CALLED IN INSBP + MOVE BP,INSBP ;SO IT WILL BE RELOCATED BY GETFR2. + MOVEI CH,0 + IDPB CH,MACPDP ;PUSH A 0 (MACRO CALL) ENTRY. + .I MACSPF=PF ;REMEMBER QREG PDL LEVEL FOR THIS FRAME TO POP TO. + SETZM MACBTS +MAC3: MOVEM A,CSTR ;STORE TECO OBJECT POINTER TO WHAT WE'RE CALLING. + SETZ TT, ;PUT IN MACBTS INDICATIONS OF HOW MANY ARGS THERE ARE. + TRNE FF,FRARG ;MFBA1 AND MFBA2 ARE SIMPLY SET. + TLO TT,MFBA2 + TRNE FF,FRARG2 + TLO TT,MFBA1 + TRNE FF,FRUPRW ;MFBATSN IS SET TO WHETHER THERE WAS AN @, EXCEPT + TLO TT,MFBATSN + MOVSI C,MFBATSN ;THAT :M WITH NO @ DOES NOT CLEAR MFBATSN IF IT WAS SET. + ANDM C,MACBTS + IORM TT,MACBTS + MOVEI C,1 + TRZE FF,FRUPRW ;GET THE FIRST MACRO ARGUMENT (OR, IF NONE, + TRNE FF,FRARG ;EITHER 0 OR (IF FRUPRW) 1). + MOVE C,NUM + ARGDFL + MOVEM C,MARG2 ;SAVE IT AS THE THING ^Y GETS + MOVE C,SARG ;TRY FOR A SECOND ARGUMENT + TRNN FF,FRARG2 + MOVEI C,0 ;IF NONE, THEN 0 + MOVEM C,MARG1 ;SIGH + MOVEM B,COMCNT ;STORE LENGTH OF TEXT AS LENGTH OF MACRO. + MOVEM BP,CPTR ;GIVE RCH THE BP TO THE TEXT. + ILDB CH,BP ;NOW, START EXECUTING THE MACRO, BUT FIRST + CAIE CH,"W+40 ;UNLESS THE FIRST CHARACTER IS "W", MAYBE INVOKE FS STEPMAC$ + CAIN CH,"W + JUMPN B,CD + CALL CTLM2 + JRST CD + +;A IS ADDR 1ST WD ASCIZ STRING, EXECUTE STRING AS MACRO. +MACXCW: HRLI A,BP7 +MACXCT: SETO B, ;A IS BP -> STRING. + MOVE BP,A ;MUST COUNT # CHARS IN STRING. +MACXC1: ILDB CH,A + AOJ B, + JUMPN CH,MACXC1 + MOVE A,BP ;GIVE THE BYTE POINTER AS THE FS BACK STR$ SINCE THERE'S NO + JRST MACXC2 ;ACTUAL TECO OBJECT POINTER WE CAN USE. + +MACXQW: JUMPGE A,MACXCW ;EXECUTE EITHER A QREG OR AN ASSEMBLED-IN ASCII STRING. + ;DISTINGUISH THEM SINCE STRING QREGS ARE NEGATIVE. + +;A HAS CONTENTS OF A QREG; PUSHJ HERE TO EXECUTE IT, POPJ'ING AFTER IT FINISHES. +MACXQ: CALL QLGET0 ;GET LENGTH AND STARTING BP OF STRING. + JSP T,MACN1 ;(QREG CONTAINS A NUMBER; PUSHJ TO THAT LOCATION). +MACXC2: TRZ FF,FRUPRW + SAVE MACPTR + SAVE MACXP + MOVEM P,MACXP .SEE RCH2 + SETOM MACPTR ;-1 SAYS CALLED FROM MACXP. + JRST MAC2 + +MACN: TRZE FF,FRCLN ;HERE WHEN AN "M" COMMAND CALLS A BUILT-IN FUNCTION. + SETZM COMCNT ;:M TO BUILTIN => JUST DISCARD REST OF STRING AT THIS LEVEL. + SAVE [CDRET] ;POPJ TO EITHER (JRST TO) CD, OR VALREC IF SKIP. + MOVEI T,2+[ SUB P,[1,,1] ? JRST MAC5] +;T HAS 2+ ADDR TO GO TO IF THIS NUMBER "TURNS OUT" TO BE A STRING AFTER ALL. +;2+ IS SO CAN JSP AFTER A FAILING CALL TO QLGET0. +MACN1: ARGDFL ;MACROING A QREG CONTAINING A NUMBER. + TRNN FF,FRARG + MOVEI C,1 + MOVE E,A + ANDI A,-1 + CAIE A,RRINDR ;TRACE THRU INDIRECTD DEFINITIONS HERE, SO THAT + JRST RRLP7H + HLRE A,E ;IF THE ULTIMATE TARGET IS A STRING, WE CAN MACRO IT + SUB CH,A ;WITH OUT GOING THROUGH RRMACR. + MOVE A,RRMACT(CH) + JRST -2(T) + +;FSBACKTRACE$ - INSERT IN THE BUFFER THE TEXT OF THE MACRO IN FRAME . +;LEAVE POINT AT THE PC OF THAT FRAME. +FSBAKT: CALL BACKTR ;FIND THE FRAME THE USER SPECIFIED. +FSBAK1: CALL MFBEGP ;GET STARTING B.P. IN B AND CURRENT PC IN C. + SAVE B + ADD C,MFCCNT(A) ;C GETS TOTAL SIZE OF MACRO. + MOVEM C,INSLEN ;INSERT SPACE IN BUFFER TO HOLD THE STRING. + CALL SLPGET + MOVN A,MFCCNT(A) + ADDM A,PT + MOVE IN,BP + REST BP + JRST QGET1 + +;FS BACK PC$ - RETURN RELATIVE PC (OFFSET FROM 1ST CHAR) OF MACRO IN FRAME . +;,FS BACK PC$ - SET RELATIVE PC OF THAT FRAME TO . +; SETTIN THE PC TO A VERY LARGE NUMBER PUTS IT AT THE END OF THE STRING. +FSBAKP: CALL BACKTR + CALL MFBEGP ;C GETS CURRENT RELATIVE PC. + SAVE C + TRZN FF,FRARG2 ;DO WE WANT TO CHANGE IT? + JRST POPAJ1 + ADD C,MFCCNT(A) + CAMLE E,C ;IF ARG IS GREATER THAN # OF CHARS IN STRING, MAKE POINT AT END. + MOVE E,C + SKIPGE E ;NEGATIVE PC'S ARE MEANINGLESS. + TYPRE [AOR] + ADD BP,E ;IF SO, ADD DESIRED PC TO CHAR ADDR OF START + CALL GETBP ;CONVERT TO B.P. AND STORE AS THE FETCH POINTER. + MOVEM BP,MFCPTR(A) + SUB E,(P) ;GET THE DIFFERENCE BETWEEN NEW PC AND OLD + MOVNS E + ADDM E,MFCCNT(A) ;AND UPDATE NUMBER-OF-CHARS-TO-GO BY THAT MUCH. + JRST POPAJ1 + +;FS BACK QP PTR$ - RETURN FS QP PTR$ OF BOTTOM OF QP FRAME +;BELONGING TO MACRO FRAME . THIS IS THE QP PTR WHICH +;^\'ING THAT FRAME WOULD UNWIND TO. +FSBAKQ: CALL BACKTR + HRRZ A,MFPF(A) ;GET SAVED QREG PDL POINTER, + SUBI A,PFL-1 ;CONVERT IT TO A PDL DEPTH INDEX. + LSH A,-1 + JRST POPJ1 + +;FS BACK ARGS$ - RETURN ARGS OF MACRO FRAME . +FSBAKA: CALL BACKTR ;GET POINTER TO FRAME IN A. + MOVE C,MFLINK(A) ;GET FRAME'S SAVED MACBTS, MARG1, MARG2 + MOVE B,MFARG1(A) + MOVE A,MFARG2(A) + JRST FCTLX2 ;AND RETURN APPROPRIATE VALUES, A LA F^X. + +;FS BACK STRING$ - RETURN STRING POINTER TO MACRO BEING EXECUTED IN FRAME . +;IF THAT MACRO ISN'T A STRING, WE RETURN A BYTE POINTER (A NUMBER). +;THERE IS NO WAY TO DECODE SUCH BYTE POINTERS, BUT THEY CAN BE COMPARED RELIABLY. +FSBAKS: CALL BACKTR ;GET FRAME POINTER IN A. + MOVE A,MFCSTR(A) + JRST POPJ1 + +;SUBROUTINES FOR FS BACK WHATEVER. + +;A POINTS AT A MACRO FRAME (OR AT COMCNT); RETURN IN B A B.P. TO THE MACRO'S START, +;AND IN C THE DISTANCE IN CHARACTERS OF THE CURRENT PC FROM THE START. +MFBEGP: MOVE BP,MFCPTR(A) + CALL GETCA + MOVE C,BP + SAVE A + MOVE A,MFCSTR(A) + CALL QLGET0 + MOVE BP,A + MOVE B,BP ;B GETS B.P. TO START OF MACRO. + CALL GETCA ;BP GETS CHAR ADDR OF IT. + SUB C,BP + JRST POPAJ + +;RETURN IN A A POINTER TO THE MACRO FRAME SPECIFIED BY THE DEPTH IN C. +;IF C IS POSITIVE, IT IS COUNTING FROM THE BOTTOM OF THE STACK +;(0 = OUTERMOST FRAME). IF IT IS NEGATIVE, IT COUNTS DOWN FROM THE +;CURRENT FRAME (-1 = THIS FRAME'S CALLER). +BACKTR: ARGDFL Z + MOVNS C + SKIPG C + ADD C,MACDEP ;C NOW HAS NUMBER OF FRAMES TO GO OUT FROM CURRENT ONE. + SOJL C,TYPAOR ;ILLEGAL TO REFER TO CURRENT FRAME, SINCE IT ISN'T STORED THE SAME WAY. + MOVE B,MACXP + HRRE A,MACPTR ;START WITH TOP OF MACPTR STACK (CURRENT MACRO'S CALLER). +BACKT0: JUMPGE A,BACKT2 + HRRE A,-1(B) ;WHENEVER A MACXQ CALL IS FOUND, GO BACK THROUGH IT. + MOVE B,(B) + JRST BACKT0 + +BACKT2: JUMPE A,TYPAOR + JUMPE C,[ ;HAVE WE GONE OUT ENOUGH FRAMES? + SUBI A,MFLINK + RET] + HRRE A,(A) ;NO, GO OUT ONE FRAME MORE. + SOJA C,BACKT0 + +GMARG2: SKIPA A,MARG2 +GMARG1: MOVE A,MARG1 + JRST POPJ1 + +SUBTTL CONVERT NUMBERS TO STRINGS + +BAKSL: TRZ FF,FRUPRW + TRZE FF,FRARG + JRST BAKS1A + SETZ A, + MOVE IN,PT + PUSHJ P,GETINC + TRZE FF,FRCLN + CAIE CH,"- + JRST BAKSL7 + TRO FF,FRARG +BAKSLA: PUSHJ P,GETINC +BAKSL7: CAMLE IN,ZV + JRST BAKSL3 +BAKSL6: CAIG CH,"9 + CAIGE CH,"0 + SOJA IN,BAKSL2 + JFCL 10,.+1 + IMUL A,IBASE + JFCL 10,[TLC A,400000 ? JRST .+1] ;MAKE OVERFLOW ACT AS IF UNSIGNED MULTIPLY. + ADDI A,-60(CH) + JRST BAKSLA + +BAKSL3: MOVE IN,ZV +BAKSL2: TRZE FF,FRARG + MOVNS A + MOVEM IN,PT + JRST POPJ1 + +;\ WRITE IN BASE IN ..E, INTO BUFFER. :\ CONS INTO STRING AND RETURN IT. +;,\ USE COLUMNS, MAKING LEADING SPACES IF NEEDED. +BAKS1A: MOVEI TT,40 + HRRM TT,DPT5 + SOS TT,E + TRZE FF,FRARG2 + SKIPA BP,[DPT1] +BAKSL1: MOVEI BP,DPT + MOVE T,[(700)BAKTAB-1] + MOVEI E,0 + MOVEI CH,[IDPB CH,T ? AOJA E,CPOPJ] + HRRM CH,LISTF5 + PUSHJ P,(BP) + MOVE C,E + MOVEM C,INSLEN + CALL SLP ;INSERT THEM, OR PREPARE TO WRITE STRING. GET BP IN BP. + MOVE T,[440700,,BAKTAB] +BAKSLL: ILDB CH,T ;COPY THE PRINTED STUFF INTO INSERTED SPACE. + IDPB CH,BP + SOJG C,BAKSLL + JRST SLPXIT ;IN CASE OF :\, FINISH CONSING THE STRING. + +SUBTTL CONTROL CONSTRUCTS + +FDQUOT: SUB P,[1,,1] ;F" LIKE " BUT ARGUMENT REMAINS AS WELL AS BEING TESTED. + SKIPA A,[CD2A] +DQUOTE: MOVEI A,CD + CALL LRCH ;READ THE CONDITION NAME (B, C, G, L, E, N, #) + CAIN CH,"# ;IS THIS AN "ELSE"? + JRST [ CALL NOGO ;YES, FAIL: SKIP TO THE ', + JRST CD2A] ;RETURN WITHOUT FLUSHING VALUE. + CAIN CH,"' + JRST VCOND + SAVE A ;REMEMBER RETURN ADDRESS (CD OR CD2A). + CALL CONDIT ;DECODE THE CONDITION, + XCT A ;TEST IT, + TRC FF,FRCLN ;TAKE THE EQV OF ITS SUCCESS AND THE COLON FLAG. + TRZN FF,FRCLN + JRST CTLM2 ;NON-: CONDITION WON OR :-CONDITION LOST, INVOKE STEPPER AND RETURN. +NOGO: MOVEI A,0 ;CONDITION FAILED. SKIP TO THE ' AND CHECK FOR AN ELSE. + MOVE C,COMCNT ;REMEMBER WHERE STARTING FROM, SO IF HAVE UTC ERROR + MOVE E,CPTR ;CAN SIGNAL IT AT THE ". +NOGO1: SOSGE COMCNT + JRST [ MOVEM C,COMCNT + MOVEM E,CPTR + TYPRE [UTC]] + ILDB CH,CPTR + CAIN CH,"" + AOJA A,NOGO1 + CAIE CH,"' + JRST NOGO1 + SOJGE A,NOGO1 + CALL TRACS ;FOUND THE TERMINATING '. MENTION IT IF TRACING. + MOVE A,COMCNT + MOVE BP,CPTR +NOGO2: SOJL A,CPOPJ ;AFTER THE MATCHING ', CHECK FOR AN ELSE ("#) + ILDB CH,BP ;IS THE NEXT CHAR A DOUBLEQUOTE? + CAIE CH,^M + CAIN CH,^J ;ALLOW CRLFS TO INTERVENE BEFORE THE DOUBLEQUOTE. + JRST NOGO2 ;JUST PASS THEM BY. + SKIPGE TABMOD + CAIE CH,^I + CAIN CH,40 + JRST NOGO2 ;ALSO ALLOW SPACES BETWEEN. + CAIN CH,"! ;ALSO ALLOW TAGS BETWEEN. + JRST NOGO3 + CAIE CH,"" + RET ;NO - THERE IS NO "ELSE" + SOJL A,CPOPJ ;MAKE SURE A "#" FOLLOWS THE """". + ILDB B,BP + CAIE B,"# + RET + CALL TRACS ;THERE IS AN ELSE - TRACE THE " AND #. + MOVEI CH,"# + CALL TRACS + MOVEM BP,CPTR ;RESUME EXECUTION INSIDE THE ELSE CLAUSE. + MOVEM A,COMCNT + JRST CTLM2 ;WE HAVE JUST ENETERED AN ELSE CLAUSE, SO INVOKE STEPPER. + +NOGO3: SOJL A,CPOPJ + ILDB CH,BP ;SKIP UNTIL THE NEXT "!", THEN CONTINUE LOOKING FOR '"#'. + CAIE CH,"! + JRST NOGO3 + JRST NOGO2 + +;READ THE NAME OF A CONDITION, AND RETURN IN A +;AN INSTRUCTION TO SKIP IF THE CONDITION IS TRUE. +CONDIT: TRNN FF,FRARG + TYPRE [WNA] ;THIS IS A NUMERIC CONDITIONAL: SNARF THE ARG. + MOVEI A,C +IRPC Z,,[GLNE] + CAIN CH,"Z + HRLI A,(SKIP!Z) +TERMIN + CAIN CH,"A + MOVE A,[CALL DQTLET] + CAIN CH,"D + MOVE A,[CALL DQTDGT] + CAIN CH,"U + MOVE A,[CALL DQTUC] + CAIN CH,"C + MOVE A,[CALL DQT1] + CAIN CH,"B + MOVE A,[CALL DQT3] ;B => GET INSN TO SKIP IF GIVEN A BREAK CHARACTER. + TLNN A,-1 ;IF WE DIDN'T RECOGNIZE THE CONDITION, SIGNAL AN ERROR. + TYPRE [BD%] + RET + +DQT1: PUSHJ P,DQT3 ;SKIP IF CHAR IN C IS NOT A BREAK CHARACTER. + AOS (P) + RET + +DQTLET: CAIG C,"Z+40 ;SKIP IF CHARACTER IN C IS A LETTER. + CAIGE C,"A+40 +DQTUC: CAIG C,"Z ;SKIP IF THE CHARACTER IN C IS AN UPPER-CASE LETTER. + CAIGE C,"A + RET + JRST POPJ1 + +DQTDGT: CAIG C,"9 ;SKIP IF THE CHARACTER IN C IS A DIGIT. + CAIGE C,"0 + RET + JRST POPJ1 + +VCOND: CALL LRCH ;"' COMMAND: TEST A CONDITION, + CALL CONDIT ;BUT RETURN -1 IF IT SUCCEEDS, OR ELSE 0. + XCT A ;THUS, 0"'N RETURNS 0 BUT 1"'N RETURNS -1. + TRC FF,FRCLN + TRZ FF,FRARG + SAVE [CDRET] + TRZN FF,FRCLN + JRST NRETM1 + JRST NRET0 + +EXCLAM: SETOM BRC1 ;HANDLE "!" AS A COMMAND. + CALL SKRCH ;[ ;SKIP UNTIL THE NEXT "!". BRC1 INHIBITS MOST ^] FORMS. + CAIE CH,"! + JRST .-2 + SETZM BRC1 + CALL TRACS ;IN TRACE MODE, TRACE A SECOND "!" TO MINIMIZE USER CONFUSION. + JRST CD5A + +LRCH: PUSHJ P,RCH + TRNE CH,100 + ANDCMI CH,40 + POPJ P, + +;HANDLE THE "O" COMMAND: O$ JUMPS TO !!. ":O" DOES NOT ERR IF TAG UNFOUND. +OG: MOVE A,CPTR ;FIRST, LOOK IN THE JUMP CACHE FOR ADDR OF "O" CMD. + MOVE C,A + ANDI C,16 ;GET INDEX IN CACHE OF ENTRY PAIR THAT'S APPRO. + CAMN A,SYMS(C) ;IS FIRST ENTRY FOR THIS "O"? + JRST OGFND + CAMN A,SYMS+1(C) ;IS THE SECOND? + AOJA C,OGFND ;IF FOUND, GET PLACE TO JUMP TO FROM CACHE ENTRY. +;THIS JUMP NOT IN CACHE; MUST ACTUALLY SEARCH. + SAVE CPTR ;PUSH INFO ON WHERE TO STORE INTO CACHE WHEN FIND TAG. + SAVE C ;THESE 2 WORDS ARE NOT USED FOR ANY OTHER PURPOSE. + CALL OARG ;READ IN THE STRING ARG. + MOVEI A,COMCNT + CALL MFBEGP ;FIND START OF CURRENT MACRO. + EXCH BP,B ;NOW BP HAS BP TO START, B HAS STRING POINTER TO MACRO, + ADD C,COMCNT ;C HAS TOTAL SIZE OF MACRO. + CAMGE B,BFRTOP + CAMGE B,QRWRT ;ARE WE IN A STRING? OR IN A BUFFER OR CBUF? + CAMGE B,QRBUF + SETOM BRCFLG ;JUMPS IN BUFFERS AND CBUF AREN'T CACHED, + ;SINCE THE DATA AT A GIVEN LOCATION IS LIKELY TO CHANGE. + +;NOW SEARCH FOR THE DESIRED LABEL. + TRNE FF,FRUPRW + SOS J +OG4: MOVEI D,STAB +OG5: CAIN D,1(J) + JRST OG3 + SOJL C,OGUGT ;COMPARE MACRO CHAR BY CHAR AGAINST TAG. + ILDB CH,BP + CAIL CH,"A+40 ;CONVERT TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN CH,(D) + AOJA D,OG5 + TLNE BP,760000 ;AT WORD BOUNDARY => TRY TO SKIP WORDS FAST. + JRST OG4 +OG6: SUBI C,5 + JUMPL C,OG7 ;NOT A WHOLE WORD LEFT TO SCAN => CAN'T GO FAST. + MOVE D,1(BP) ;ELSE GET THE NEXT WORD + XOR D,[ASCII /!!!!!/] ;AND SEE IF THERE ARE ANY !'S IN IT. + TLNE D,(177_35) + TLNN D,(177_26) + JRST OG7 + TRNE D,177_1 + TRNN D,177_10 + JRST OG7 + TDNN D,[177_17] + JRST OG7 + AOJA BP,OG6 ;THERE ARE NONE, SO WKIP THIS WORD. + +OG7: ADDI C,5 ;FOUND AN !, SO SCAN SLOWLY TO LOCALIZE IT. + JRST OG4 + +;COME HERE WHEN WE HAVE FOUND THE TAG BY SEARCHING. +OG3: MOVEM C,COMCNT ;SET COMMAND-READING POINT TO WHERE WE FOUND THE TAG. + MOVEM BP,CPTR + REST A ;REMEMBER IDX OF CACHE ENTRY TO STORE IN. + REST B ;REMEMBER CPTR OF "O" TO PUT IN CACHE + SKIPE BRCFLG + JRST OGXIT ;BUT MAYBE CACHE IS INHIBITED FOR THIS JUMP. + EXCH B,SYMS(A) ;STORE THIS JUMP IN 1ST ENTRY OF PAIR, AND MOVE + MOVEM B,SYMS+1(A) ;OLD CONTENTS OF 1ST ENTRY INTO 2ND. + MOVE B,COMCNT + EXCH B,CNTS(A) ;CACHE ENTRY CONTAINS CPTR OF "O", + MOVEM B,CNTS+1(A) ;CPTR OF TAG, AND COMCNT OF TAG. + MOVE BP,CPTR + EXCH BP,VALS(A) + MOVEM BP,VALS+1(A) + JRST OGXIT + +OGFND: TRNE FF,FRTRACE + CALL OARG ;IF TRACING, READ IN ARGUMENT SO IT WILL SHOW IN TRACE. + MOVE A,VALS(C) ;COME HERE WHEN THE JUMP IS FOUND IN THE CACHE. + MOVEM A,CPTR + MOVE A,CNTS(C) + MOVEM A,COMCNT +OGXIT: TRZ FF,FRCLN + TRZN FF,FRUPRW + JRST CD + MOVEI CH,"! + CALL TRACS + JRST EXCLAM ;@ O => WE'RE INSIDE A LABEL, SO WE MUST SKIP TO THE END. + +OGUGT: TRZN FF,FRCLN ;COME HERE IF TAG IS NOT FOUND. + TYPRE [UGT] + SUB P,[2,,2] + JRST CD + +;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD +;IN STAB, WITH AN ! BEFORE AND AFTER. LEAVE J -> LAST +;WORD USED IN STAB. USED BY "O" AND "F;". ;[ +;BRCFLG LEFT NONZERO IFF SOME UNPREDICTABLE ^] CALLS TOOK PLACE. +;CLOBBERS A, CH. +OARG: MOVEI J,STAB+1 + MOVEI A,41 + MOVEM A,-1(J) + SETZM BRCFLG ;[ ;ANY ^] CALLS WE WORRY ABOUT WILL SET BRCFLG. +OGNF1: CAIN J,STAB+LTABS + TYPRE [STL] + CALL ORCH + HRRZM CH,(J) + SKIPN SQUOTP + CAIE CH,ALTMOD + AOJA J,OGNF1 + MOVEM A,(J) + RET + +ORCH: CALL RCH ;READ CHAR AND CONVERT L.C. LETTERS (ONLY) TO U.C. + CAIL CH,"A+40 + CAILE CH,"Z+40 + RET + SUBI CH,40 + RET + +;SEMICOLON AND ITERATIONS. + +SEMICL: SKIPN ITRPTR + TYPRE [SNI] + TRNN FF,FRARG + MOVE C,SFINDF + TRNN FF,FRUPRW ;UNLESS THE ^ FLAG IS SET, CONVERT SIGN TO NONZERO-NESS. + ASH C,-35. + MOVE A,[JUMPN C,CD] ;THEN WIN (KEEP ITERATING) IF NONZERO, + TRNE FF,FRCLN ;OR, IF COLON, WIN IF ZERO. + HRLI A,(JUMPE C,) + XCT A +INCMA0: MOVEI CH,"> ;"TRACE" A ">" TO HELP USER UNDERSTAND. + CALL TRACS + MOVEI A,0 + MOVE BP,CPTR + MOVE C,COMCNT ;SEARCH FOR THE ">" THAT ENDS THIS ITERATION. +INCMA1: SOJL C,[HRRO A,ITRPTR + CALL ITRPOP + TYPRE [UTI]] + ILDB CH,BP + CAIN CH,"< + AOJA A,INCMA1 + CAIE CH,"> + JRST INCMA1 + SOJGE A,INCMA1 + MOVEM BP,CPTR + MOVEM C,COMCNT + +;HERE THE CODE FOR ">", ";", "F;", AND ERRORS INSIDE ERRSETS, +;MERGES INTO ONE. +INCMA2: HRRO A,ITRPTR ;PTR TO INNERMOST ITER OR ERRSET. + HLRZ TT,ITRPTR ;TO INNERMOST ERRSET. + MOVEI E,(A) + CALL FSEMIP ;SKIP IF THIS ITERATION WAS A CATCH. + CAIN TT,(A) ;SKIP UNLESS IT WAS AN ERRSET. + SKIPA TT,[-1] ;TT HAS -1 IF CATCH OR ERRSET, + SETZ TT, ;0 FOR ORDINARY ITERATION. + CALL ITRPOP ;POP THE ITERATION FRAME. + JUMPE TT,CD ;FOR ORDINARY ITER'S, THAT'S ALL. +;EXITING A CATCH OR ERRSET: 1ST, WE MAY HAVE JUST UNWOUND +;AND NEED TO RESET PDLS. 2ND, WE MUST RETURN A VALUE SAYING +;WHETHER WE EXITED NORMALLY. + TRZ FF,FRARG+FRARG2+FROP+FRSYL+FRCLN+FRUPRW + AOS A,ERRFLG ;EXITING ERRSET, WAS THERE ERROR? + JUMPN A,[SETZ A, ? JRST VALREC] ;RETURN 0 IF NO ERROR. + HLRZ CH,C + HRLI CH,1-PDL-LPDL(CH) + CAME P,CH ;IF CH=P, SETP IS NOT NEEDED, AND RET. ADDR WOULD BE ABOVE P! + PUSHJ CH,SETP ;MOVE P,CH , CHECK FOR UNWINDING PARENS, SORT OR ^R, THEN POPJ P, + HRLI C,1-PFL-LPF(C) + CALL FSQPU0 ;ON ERROR IN ERRSET, UNWIND QREG PDL + MOVE A,LASTER + JRST VALREC + +;A CONTAINS ITRPTR'S RH; POP OFF AN ITERATION. +ITRPOP: POP A,ITRPTR + POP A,C + POP A,(A) + POP A,ITERCT + MOVEI A,-MFICNT(A) + JRST FLSFRM + +GRTH: SKNTOP ITRPTR + TYPRE [UMC] + TRZE FF,FRUPRW + JRST GRTH1 + SOSN ITERCT + JRST INCMA2 +GRTH1: HRRO A,ITRPTR + SUBI A,MFBLEN-MFCPTR-1 + POP A,CPTR + POP A,COMCNT + MOVEI CH,^M + CALL TRACS + MOVEI CH,^J + CALL TRACS + MOVEI CH,"< + CALL TRACS + JRST CD + +FLSSTH: SUB P,[1,,1] +LSSTH: PUSHJ P,GETFRM + MOVE TT,PF + HRLI TT,(P) +INSIRP PUSH A,COMCNT CPTR CSTR ITERCT MACPDP TT ITRPTR + HRRM A,ITRPTR ;STORE PTR TO INNERMOST ITER OR ERRSET. + TRZE FF,FRCLN ;IF THIS IS ERRSET, SET PTR TO + HRLM A,ITRPTR ;INNERMOST ERRSET. + TRZE FF,FRARG + JRST LSSTH2 + SETOM ITERCT + JRST CD + +LSSTH2: JUMPLE C,INCMA0 + MOVEM C,ITERCT + JRST CD + +CNTRLN: SETOM GEA + TRNE FF,FRARG + MOVEM C,NLINES + TRZN FF,FRCLN + RET + AOSE TTMODE + SETOM TTMODE + POPJ P, + +;F;$ - THROW TO , RETURNING 1 (OR F;'S ARG, IF ANY) FROM THE F<...>. +FSEMIC: TRZN FF,FRARG + MOVEI C,1 + SAVE C + CALL OARG ;READ INTO STAB, WITH "!"'S. +;NOW LOOK AT ALL ITERATIONS, INNERMOST FIRST, FOR ONE WHICH +;IS A CATCH WITH THE APPROPRIATE TAG. + HRRZ E,ITRPTR +FSEMI1: JUMPE E,[TYPRE [UCT]] ;UNSEEN CATCH TAG. + CALL FSEMIP ;IS THIS ITERATION A CATCH? + JRST FSEMI2 ;NO, LOOK AT NEXT ONE OUT. + IBP BP + MOVEI D,STAB ;YES, COMPARE ITS TAB WITH . + MOVE A,MFCCNT-MFBLEN+1(E) +FSEMI3: SOJL A,FSEMI2 ;F< TAG ENDED TOO SOON - MISMATCH. + ILDB TT,BP + CAIL TT,"A+40 ;CONVERT L.C. LETTERS TO U.C. + CAILE TT,"Z+40 + CAIA + SUBI TT,40 + CAME TT,(D) + JRST FSEMI2 ;THE CHARS DIFFER. + ADDI D,1 ;ADVANCE TO NEXT CHAR IN + CAME D,J + JRST FSEMI3 +;WE'VE FOUND A CATCH WITH OUR TAG! + REST LASTER ;VALUE TO BE RETURNED FROM F<...>, WHERE ERRP3 WANTS IT. + SETOM ERRFLG ;FAKE INCMA2 INTO RETURNING NEGATIVE. +FSEMI4: HRRO A,ITRPTR ;POP OFF ALL ITERATIONS INSIDE THE + CAIN E,(A) ;CATCH WE'RE POPPING TO. + JRST [ HRLM E,ITRPTR ;THEN PRETEND THIS CATCH WAS AN ERRSET + JRST ERRP3] ;AND ERR OUT OF IT. + CALL ITRPOP + JRST FSEMI4 + +;COME HERE IF ITERATION ISN'T A CATCH, OR HAS WRONG TAG. +FSEMI2: HRRZ E,MFLINK-MFBLEN+1(E) + JRST FSEMI1 + +;E -> AN ITERATION FRAME. SKIP IF THAT ITERATION IS REALLUY A +;CATCH. IN THAT CASE, RETURN IN BP B.P. TO ILDB THE "<". +FSEMIP: MOVE BP,MFCPTR-MFBLEN+1(E) + SUBI BP,1 ;BACK UP BP BY 2 CHARS. +REPEAT 3,IBP BP + ILDB C,BP ;FETCH THE CHAR BEFORE THE "<" + CAIE C,"F+40 + CAIN C,"F ;IF IT'S "F", THIS ITERATION'S A CATCH. + AOS (P) + RET + +SUBTTL ^P SORT COMMAND + +;THE SORT TABLE IS A TABLE OF POINTERS TO SORT RECORDS. +;PSMEM POINTS AT THE FIRST ENTRY. PSMEMT POINTS PAST THE LAST ONE. +;EACH ENTRY IS 4 (LPSDBK) WORDS LONG. +;THE 1ST WORD OF AN ENTRY IS EITHER A B.P. TO THE START OF THE RECORD'S KEY + ;OR THE KEY ITSELF IF IT IS A NUMBER. +;THE SECOND WORD'S RH IS THE LENGTH OF THE KEY IF THE KEY IS A STRING, + ;OR -1 IF THE KEY IS A NUMBER. +;THE SECOND WORD'S LH IS MINUS THE LENGTH OF THE RECORD IN CHARACTERS. +;THE THIRD WORD IS THE CHAR ADDR OF THE START OF THE RECORD. +;THE FOURTH WORD POINTS TO THE NEXT ENTRY (IN ORIGINAL ORDER BEFORE SORT, + ;IN SORTED ORDER AFTER. THIS IS THE LINK FOR A LIST SORT). + +PSORT: ISKERR ;CAN'T SORT WITHIN SORT. + SAVE FF ;REMEMBER FRCLN (PSI SETS IT) + MOVE CH,[JRST [ + CALL RCH ;READ CHAR, + SKIPGE SQUOTP ;SUPERQUOTED => + JRST INSDIR ;JUST INSERT. + CAIE CH,"$ ;ELSE REPLACE $ BY ALTMODE + JRST INSDCK + MOVEI CH,ALTMOD + JRST INSDIR]] ;AND CHECK FOR DELIMITER UNLESS DELIM PROTECTED. + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QKS ;GET ARGS + CALL PSI ;IN PSEUDO Q-REGS + MOVE CH,QRB.. + ADDI CH,.QKE + CALL PSI + MOVE CH,QRB.. + ADDI CH,.QDL + CALL PSI + CALL MEMTOP + MOVEM P,PSSAVP ;INDICATE A SORT IS IN PROGRESS. + MOVEM A,PSMEM + MOVEM A,PSMEMT + MOVE T,A + SETZM PSZF + MOVE TT,ZV + SUB TT,BEGV ;# CHARS IN RANGE BEING EDITED. + JUMPE TT,PSXIT ;SORTING NO CHARS IS NOOP. + MOVE C,BEGV ;START FROM BEGINNING + MOVEM C,PT +;DROPS THROUGH. + +;DROPS THROUGH. +;LOOP HERE TO DELIMIT THE NEXT RECORD AND ITS KEY. +PS4: SUB C,BEG ;KEEP ALL ADDRS RELATIVE TO BEG IN CASE IMPURE STRINGS MOVE BUFFER. + MOVEM C,2(T) ;3RD WORD OF POINTER: CHAR ADDR OF RECORD. + PUSH P,C + MOVE A,QRB.. + MOVE A,.QKS(A) ;FIND BEGINNING OF KEY + CALL MACXQ + MOVE T,PSMEMT + MOVE C,PT + SUB C,BEG ;FOR NOW, KEEP CHAR ADDR REL BUFFER, WILL CHANGE TO BP LATER. + PUSH P,C + MOVEM C,(T) ;IS 1ST POINTER WORD + MOVE A,QRB.. + MOVE A,.QKE(A) ;FIND END OF KEY + PUSHJ P,PS2 + SKIPGE C ;BARF IF THE KEY IS NEGATIVE IN LENGTH (WOULD THINK IT WAS NUMERIC). + TYPRE [ISK] + TRNN FF,FRARG ;IF "END OF KEY" MACRO RETURNS A VALUE, THAT VALUE IS THE KEY. + JRST PS8 + MOVE A,NUM ;STORE IT INSTEAD OF THE CHAR ADDR OF THE KEY. + MOVEM A,(T) ;STORE -1 AS "KEY LENGTH" TO IDENTIFY THIS KEY AS NUMBER + MOVNI C,1 ;INSTEAD OF A STRING. +PS8: MOVEM C,1(T) ;#CHARS IN KEY FOR RH(2ND WORD OF TABLE ENTRY) + MOVE A,QRB.. + MOVE A,.QDL(A) ;FIND NEXT RECORD + PUSHJ P,PS1 +PS7: MOVNS C + SKIPL C + TYPRE [ESR] ;SORT-RECORD WITH NO CHARACTERS (OR NEGATIVE NUMBER???) + HRLM C,1(T) ;-LENGTH OF RECORD FOR AOBJN + ADDI T,LPSDBK ;NEXT POINTER + MOVEM T,PSMEMT + MOVE C,PT + SKIPL PSZF ;DID WE RUN OUT + JRST PS4 ;NO + MOVE A,ZV + MOVEM A,PT + CALL GAPSLP + MOVEI C,20. ;MAKE SURE THERE'S A GAP AFTER RANGE BEING + CALL SLPSAV ;SORTED, SO BLT OF SORTED STUFF WON'T CLOBBER A FEW CHARS. + MOVE A,PSMEM ;LOWER BOUND + MOVE B,PSMEMT ;UPPER BOUND. +PS7A: CAMN A,B ;NOW CONVERT ADDRS REL. TO BEG TO WHAT WE REALLY WANT. + JRST PS7B ;ALL RECORDS HANDLED. + HRRE E,1(A) + JUMPL E,PS7C ;IF THE KEY IS A STRING, NOT A NUMBER, + MOVE E,(A) ;GET ADDR START OF KEY, + ADD E,BEG + IDIVI E,5 ;CONVERT TO BP. TO 1ST BIT. + ADD E,BTAB-1(J) + TLZ E,17 + MOVEM E,(A) +PS7C: ADDI A,LPSDBK + MOVE E,A + SUB E,PSMEM + MOVEM E,-1(A) ;MAKE ENTRY'S 3RD WD POINT TO NEXT ENTRY. + JRST PS7A ;DO NEXT RECORD. + +PS1: SKIPGE PSZF ;ALREADY AT END => NOOP INSTEAD OF USER'S MACRO. + JRST PS2A +PS2: SETOM SFINDF + CALL MACXQ +PS2A: MOVE T,PSMEMT + POP P,J ;RETURN POINT + POP P,E ;OLD PT-BEG + ADD E,BEG + MOVE C,PT + SKIPL SFINDF ;IF THE LAST SEARCH FAILED + SKIPA C,ZV + CAML C,ZV ;OR WE'RE AT THE END OF THE BUFFER + SETOM PSZF ;THEN THIS RECORD IS THE LAST ONE. + SUB C,E ;# CHARS IN C + JRST (J) + +;RETURN IN A A PTR TO THE 1ST UNUSED WORD OF HIGH MEM. +MEMTOP: MOVE A,BFRTOP + IDIVI A,5 + SUBI A,3 + SKIPE PSSAVP + MOVE A,PSMEMT + ADDI A,4 + POPJ P, + +PS7B: SETOM -1(A) ;LAST ENTRY'S LINK WORD IS NIL. + MOVE A,(P) ;RESTORE FRCLN AS IT WAS AT CALL TO PSORT. + TRNE A,FRCLN + IORI FF,FRCLN + HRRZ J,PSMEMT ;DYNAMICALLY ALLOCATED PDL + PUSHJ J,PS3 ;SORT POINTERS + MOVE T,BEGV ;SET UP FOR LATER BLT + IDIVI T,5 + HRRM T,J ;DESTINATION = WORD CONTAINING BEGV + MOVE CH,(T) ;MUST HAVE CHARS BEFORE BEGV IN WD + HLL C,BTAB-1(TT) ;GET BPT TO NEW BUFFER AREA + TLZ C,77 + HRR C,PSMEMT ;WHICH OVERWRITES SORT PDL + HRLM C,J ;SOURCE FOR BLT + MOVEM CH,(C) ;SAVE CHARS +PS6: ADD A,PSMEM ;CHANGE REL PTR TO ABS, -> NEXT TAB ENTRY. + HLRE E,1(A) ;- # CHARS IN RECORD. + JUMPE E,PS5 + MOVE BP,2(A) ;CHAR ADDR START OF RECORD. + ADD BP,BEG + CALL GETIBP +PS6A: ILDB CH,BP ;MOVE THE RECORD. + IDPB CH,C + AOJL E,PS6A +PS5: MOVE A,3(A) ;GET PTR TO NEXT RECORD'S ENTRY. + JUMPGE A,PS6 ;IF THERE IS ANOTHER, LOOP BACK. + MOVE A,ZV + IDIVI A,5 + BLT J,1(A) ;DONE, MOVE IT DOWN + CALL FLSCOR +PSXIT: SETZM PSSAVP ;TURN OFF SORT FLAG. + MOVE A,BEGV + MOVEM A,PT + JRST POP1J + +;ACTUALLY SORT THE LIST OF SORT TABLE ENTRIES, +;BY REARRANGING THE LINK WORDS SO THAT THEY ARE LINKED +;IN SORTED ORDER. +PS3: SETZ E, ;POINT TO THE HEAD OF THE LIST O SORT. + MOVE C,PSMEMT ;C _ LENGTH(E) + SUB C,PSMEM + LSH C,-2 + +;(DEFUN NSORT (N) (COND ((= N 1) (CHOP1)) +; (T (MERGE (NSORT (/ N 2)) (NSORT (- N (/ N 2))))))) +;E HOLDS L, C HOLDS N, J USED AS PDL PTR, VALUE RETURNED IN A. +PS3NSORT: CAIN C,1 + JRST PS3NS1 + PUSH J,C + LSH C,-1 ;THIS IS N/2 + PUSHJ J,PS3NSORT ;(NSORT (/ N 2)) + POP J,C + PUSH J,A + AOJ C, + LSH C,-1 ;(- N (/ N 2)) + PUSHJ J,PS3NSORT ;(NSORT (- N (/ N 2))) + POP J,C ;A, C HAVE ARGS TO MERGE. + MOVEI B,D ;B -> TAIL OF ACCUMULATED MERGED LIST, + ;D WILL EVENTUALLY POINT TO ITS HEAD. +PS3MRG: JUMPL C,PS3TK1 ;1ST ARG EMPTY => TAKE FROM 2ND. + JUMPL A,PS3TKB ;2ND EXHAUSTED => TAKE FROM FIRST. + MOVE TT,PSMEM ;ELSE GET PTRS TO AND SIZES OF THE KEYS + MOVE TT1,PSMEM + ADD TT,A ;BELONGING TO THE HEADS OF 1ST AND 2ND ARG. + ADD TT1,C + TRNE FF,FRCLN ;^ ^P - SORT IN REVERSE ORDER. + EXCH TT,TT1 + MOVE CH,(TT) ;CH IS BP TO ILDB KEY OF 2ND, + MOVE Q,(TT1) ;Q, FOR 1ST. + HRRE TT,1(TT) ;# CHARS IN KEY OF 2ND, + HRRE TT1,1(TT1) ;SAME FOR 1ST. + JUMPGE TT1,PS3CM3 + JUMPGE TT,PS3TKB ;1ST KEY A NUMBER, 2ND A STRING => 1ST IS LESS. + CAML Q,CH + JRST PS3TKA ;BOTH NUMBERS => 1ST KEY NUMBER GREATER => TAKE 2ND. + JRST PS3TKB + +PS3CM3: JUMPL TT,PS3TKA ;2ND KEY A NUMBER, 1ST A STRING => 2ND IS LESS. + +;COMPARE TWO KEYS WHICH ARE STRINGS, GO TO PS3TKA IF 2ND KEY IS LESS, ELSE PS3TKB. +PS3CMP: SOJL TT1,PS3TKB ;FIRST KEY ENDED, IT IS .LE., SO USE IT. + SOJL TT,PS3TKA ;2ND KEY ENDED, IT IS .L., TAKE 2ND. + ILDB T,CH ;ELSE LOOK AT NEXT CHAR OF EACH. + ILDB BP,Q + SKIPN PSCASE ;IF WE SHOULD IGNORE CASE, + JRST PS3CM1 + CAIGE T,"A+40 + JRST PS3CM2 + CAIG T,"Z+40 + SUBI T,40 +PS3CM2: CAIGE BP,"A+40 + JRST PS3CM1 + CAIG BP,"Z+40 + SUBI BP,40 +PS3CM1: CAIN T,(BP) + JRST PS3CMP ;CHARS EQUAL => KEEP LOOKING. + CAIG T,(BP) + JRST PS3TKA ;CHAR FROM 2ND IS LESS, TAKE 2ND. +PS3TKB: MOVEM C,(B) ;"TAKE 1ST"; ENTRY AT HEAD OF 1ST ARG + ADD C,PSMEM ;IS LESS THAN THAT AT HEAD OF 2ND, SO + MOVEI B,3(C) ;TRANSFER IT TO TAIL OF MERGED LIST + MOVE C,(B) ;AND ADVANCE DOWN THE 1ST ARG. + JRST PS3MRG + +PS3TKA: MOVEM A,(B) ;"TAKE 2ND"; LIKE "TAKE 1ST" BUT FOR 2ND ARG. + ADD A,PSMEM + MOVEI B,3(A) + MOVE A,(B) + JRST PS3MRG + +PS3TK1: JUMPGE A,PS3TKA ;1ST EXHAUSTED; 2ND ISN'T => TAKE 2ND. + SETOM (B) ;BOTH ARGS EXHAUSTED => MERGE FINISHED, TERMINATE LIST. + MOVE A,D ;RETURN VALUE IN A. + POPJ J, + +PS3NS1: MOVEI A,(E) ;(NSORT 1) COMES HERE. + ADD E,PSMEM ;RETURN THE HEAD OF LIST TO BE SORTED, + MOVE T,E + MOVE E,3(T) ;REPLACING THAT LIST WITH ITS CDR, + SETOM 3(T) ;AND MAKING THE HEAD'S CDR NIL. + POPJ J, + +SUBTTL INPUT FROM FILES + +APPEND: ARGDFL + TRZE FF,FRCLN + JRST APPNDL + TRZN FF,FRARG + JRST YANK2 + ADD C,PT + SOS IN,C + CAMGE IN,ZV + CAMGE IN,BEGV + JRST APPND2 ;J IF OUT OF RANGE OF BUFFER. + ANDCMI FF,FRARG2 + PUSHJ P,GETCHR + MOVE A,CH + JRST POPJ1 + +APPND2: TRZN FF,FRARG2 ;IF ONLY ARG, OUT OF RANGE IS ERROR. + TYPRE [NIB] + MOVE A,E ;2 ARGS => RETURN 1ST ARG. + JRST POPJ1 + +APPNDL: TRNN FF,FRARG ;:A - APPEND LINES, OR TO ^L, + MOVEI C,1 ;WHICHEVER COMES FIRST. + TLNN FF,FLIN + RET + SAVE PT + MOVE OUT,ZV ;TEMPORARILY PUT PT AT END SO + MOVEM OUT,PT ;TYOM WILL INSERT AT END. + CALL GAPSLP +APPNL2: PUSHJ P,UTYI + SKIPN FFMODE + CAIE CH,^L + SKIPL LASTPA ;AT EOF => UTYI WAS RETURNING DUMMY CHARS; IGNORE THEM. + JRST APPNL1 + PUSHJ P,TYOM + CAIN CH,^L + JRST APPNL1 + CAIE CH,^J ;END OF LINE + JRST APPNL2 + SOJG C,APPNL2 +APPNL1: REST PT + CAIE CH,^L + RET + AOS PAGENU +;CLOSE THE INPUT FILE IF IT IS EMPTY EXCEPT FOR PADDING. +APPNL4: CALL UTYI ;READ AHEAD 1 CHAR TO SEE IF ANYTHING + SKIPL LASTPA ;IS LEFT IN THE FILE. + RET ;NO => LEAVE FILE MARKED "EOF". + MOVE A,UTYIP ;ELSE ARRANGE TO RE-READ THAT CHAR. + DBP7 A + MOVEM A,UTYIP + POPJ P, + +;Y => READ ONE PAGE FROM THE OPEN INPUT FILE, +;DESTROYING PREVIOUS CONTENTS OF BUFFER. +;IF NO FILE OPEN, JUST EMPTY THE BUFFER. +;THE FS YDISABLE$ FLAG MAY TURN Y INTO AN ERROR. +;^ Y READS IN ALL THE REST OF THE FILE. +YANK: SKIPGE YDISAB + IORI FF,FRUPRW ;YDISAB NEGATIVE => Y IS ^Y. + SKIPLE YDISAB + TYPRE [DCD] ;FS YDISABLE POSITIVE => "Y" IS ILLEGAL. +YANKEE: MOVE E,BEGV + MOVE C,ZV ;FIRST, KILL CURRENT CONTENTS. + CALL DELET1 +YANK2: TLNN FF,FLIN + JRST UTLSTP ;NO FILE OPEN => INSERT NOTHING. + TRNE FF,FRUPRW + JRST YANKAL ;"^ Y" IS HANDELD SEPARATELY. + .I YANKMT=MEMT ;PREVENT EXCESS CLEARING OF LOW BITS IN SLPSAV + MOVE BP,ZV ;GET PLACE TO INSERT AT. + EXCH BP,PT ;GET GAP THERE. + CALL GAPSLP + MOVEM BP,PT + MOVE BP,BEG + CAME BP,Z ;IF BUFFER IS EMPTY NOW, + JRST YANK3 + MOVE BP,BEG ;ADJUST VALUE OF BEG SO THAT + IDIVI BP,5 ;THE BUFFER STARTS IN THE SAME PART OF A WORD + ;AS THE EMPTY PART OF UTOBUF FOR ORDINARY Y. + HLL BP,UTYOP ;(MAKES IT MORE LIKELY THAT PW CAN GO FAST) + TLNN BP,760000 ;MAKE SURE WE DON'T MOVE BEG TO + SUBI BP,1 ;A DIFFERENT WORD. + CALL GETCA ;TURN INTO CHAR ADDR OF LAST CHAR BEFORE BUFFER + SUB BP,BEG + AOS TT,BP ;TURN INTO DISPLACEMENT OF NEW BEG FROM OLD + ADDB TT,BEG ;UPDATE BEG. + CAMGE TT,BFRBOT ;NEW BEG ISN'T SUPPOSED TO BE OUTSIDE BUFFER SPACE. + .VALUE + ADDM BP,BEGV ;SHIFT ALL THE OTHER BUFFER POINTERS JUST LIKE BEG + ADDM BP,PT + ADDM BP,GPT + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC +YANK3: MOVE BP,ZV + AOS PAGENU + SAVE D + PUSHJ P,GETIBP + MOVE OUT,BP + MOVE IN,[YPG,,A] + BLT IN,BP + MOVE IN,UTYIP + SKIPN Q,EXTRAC + JRST YPGNRM + JRST A + +YPG: ILDB CH,IN ;A + CAIE CH,EOFCHR ;B + CAIN CH,14 ;C + JRST YPG1 ;D + IDPB CH,OUT ;E + SOJG Q,A ;J + JRST YPGNRM ;BP + +YPG1: MOVEM IN,UTYIP ;WE JUST ILDB'D ^C OR ^L. + HRRZ TT,IN + CAIN TT,UTIBE + JRST YPG2 ;JUST END OF UTIBUF - RELOAD IT. + CAIE CH,EOFCHR + JRST YPG3 ;IT WAS A ^L - GO INSERT IT AND RETURN. + CAME IN,UTRLDT + JRST E ;^C INSIDE THE FILE - INSERT IT AND KEEP GOING. + CALL UTLSTP ;EOF - MARK FILE AS AT EOF. +YPG1A: MOVE BP,OUT + CALL GETCA + AOS BP + MOVE E,ZV ;GET PLACE WHERE INSERTED FILE STARTS, FOR YANKX'S USE. + CALL YPG1B ;UPDATE BUFFER BLOCK FOR CHARS WE HAVE READ IN. + REST D + JRST YANKX ;NOW MAYBE DELETE PADDING OR A TRAILING ^L. + +YPG1B: SETZM YANKMT + MOVEM BP,GPT + SUB BP,ZV ;# CHARS YANKED. + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC + POPJ P, + +YPG3: IDPB CH,OUT ;ENCOUNTERED A ^L - INSERT IT, + CALL APPNL4 ;MARK THE FILE CLOSED IF THERE'S NOTHING LEFT IN IT + JRST YPG1A ;THEN FINISH UP AS IF REACHED EOF. + +YPG2: CALL UTRLD2 ;EOB AND CAN'T GO FAST, RELOAD UTIBUF. + MOVE IN,UTYIP + JRST A ;TRY AGAIN TO READ A CHARACTER. + +YPGNRM: SAVE C ;COME HERE WHEN RUN OUT OF GAP TO YANK INTO. + MOVE C,EXTRAC + ADDI C,5* ;C <- AMOUNT OF GAP WE WANT. + MOVN Q,EXTRAC + CALL SLPSAV + REST C + ADD Q,EXTRAC + JRST A + +;HANDLE "^ Y" AND "^ A" - READ IN ALL OF INPUTR FILE, THEN +;REMOVE PADDING FROM END, AND MAYBE REMOVE A TRAILING ^L. +YANKAL: MOVE C,ZV + SAVE C ;MOVE POINT TO ZV, SAVING ZV AND OLD POINT. + EXCH C,PT + SAVE C + CALL FYCMDA ;THEN INSERT THE WHOLE FILE THERE. + CALL GAPSLP ;AND MOVE THE GAP TO THE END OF WHAT WAS INSERTED. + REST PT ;POINT IS NOW SAME AS AT ENTRY, BUT GPT = ZV. + REST E ;THIS IS OLD VALUE OF ZV - WHERE THE FILE STARTS. + CALL UICLS + CALL YANKX ;DELETE PADDING CHARS AT END. + JRST FLSCM1 ;FLUSH EXCESS CORE. + +;DELETE BACKWARDS FROM GPT ALL CONSECUTIVE ^C'S AND ^@'S; +;THEN, IF FS ^LINSERT$ IS 0, DELETE A FORMFEED IF ANY. +;REFUSES TO DELETE BACK PAST WHERE E POINTS. +YANKX: MOVE IN,GPT +YANKX1: MOVEI C,1 + CAMN E,IN + RET + SOS IN + CALL GETCHR + CAIE CH,^C + JUMPN CH,YANKX2 + SOS GPT + CALL DELETB ;DELETE 1 CHAR AFTER GPT (SINCE C HAS 1). + JRST YANKX1 + +YANKX2: CAIN CH,^L ;GOT ALL ^C'S AND ^@'S - NOW MAYBE TAKE A ^L. + SKIPE FFMODE + RET + SOS GPT + JRST DELETB + +;INSERT ALL OF THE OPEN INPUT FILE BEFORE POINT. +;FY WITH NO ARGUMENT USES THIS, AS DOES "^ Y". +FYCMDA: CALL FSIFLEN ;HOW MUCH SPACE DO WE NEED? + JFCL + .I YANKMT=MEMT ;IN CASE MUST MAKE SEVERAL TRIES, PREVENT EXCESS LOW-BIT CLEARING. + JUMPL A,FYCMD7 +IFN ITS,[ + SYSCAL RFPNTR,[%CLIMM,,CHFILI ? %CLOUT,,C] + SETZ C, + IMULI C,5 ;IF WE ARE NOT POINTING AT THE FRONT OF THE FILE, WE DON'T + SUB A,C ;HAVE AS MUCH TO READ, SO WE DON'T NEED AS MUCH SPACE. + SKIPGE C,A ;IF KNOW HOW MUCH SPACE, READ WHOLE FILE AT ONCE. +] +IFN TNX,[ + MOVE C,A ;SAVE SIZE OF FILE + MOVE A,CHFILI + RFPTR + TDZA B,B ;FAILED, ASSUME 0 BUT DONT PMAP + JUMPE B,FYPMAP ;IF AT START OF FILE STILL, CAN READ IT IN FAST + IMULI B,5 + SUB C,B + SKIPGE C +] +FYCMD7: MOVEI C,2000*5 ;ELSE GET 1K AT A TIME. + CALL FYCMD6 ;READ THAT MUCH. + SKIPE LASTPA ;IS THERE ANY MORE IN THE FILE? + JRST FYCMD7 ;YES, SO GET MORE. + SETZM YANKMT + RET + +IFN TNX,[ +;MAP IN INPUT FILE USING PMAP'S +FYPMAP: CALL GAPSLP ;MOVE GAP TO PT + SAVE C ;SAVE SIZE OF INPUT FILE + MOVE A,GPT + IDIVI A,1000*5 ;GET PAGE TO START MAPPING INTO + JUMPE B,.+2 .SEE CIRC + AOJ A, + SAVE A ;SAVE PAGE NUMBER + IMULI A,1000*5 ;GET CHARACTER ADDRESS + IDIVI C,1000*5 ;GET NUMBER OF PAGES IN INPUT FILE + JUMPE D,FYPMA1 .SEE CIRC + AOJ C, + SUBI D,1000*5 ;D IS - +FYPMA1: SAVE C ;SAVE IT + IMULI C,1000*5 ;BACK INTO CHARACTERS + SUB C,GPT ;GET SIZE OF GAP WE WILL NEED FOR ALL THIS + ADDB C,A ;END OF LAST PAGE TO BE MAPPED + CALL SLPSAV ;MAKE SURE THERE IS THAT MUCH ROOM FOR IT + SUB A,EXTRAC ;COMPUTE SIZE OF GAP AFTER END OF NEW PAGES + ADD D,A ;D IS - + HRLZ A,CHFILI ;GET INPUT FILE AGAIN + MOVE B,-1(P) ;FIRST PROCESS PAGE + HRLI B,.FHSLF +IFN 20X,[ + REST C ;NUMBER OF PAGES AGAIN + HRLI C,(PM%CNT\PM%RD\PM%CPY\PM%PLD) ;READ, COPY, PRELOAD + PMAP ;READ IN THE WHOLE FILE. +] +IFN 10X,[ + REST T ;COUNT OF PAGES TO MAP + MOVSI C,(PM%RD\PM%EX\PM%CPY) ;THIS IS THE SECOND BIGGEST CROCK +FYPMA2: PMAP + SOJLE T,FYPMA3 + AOJ A, + AOJA B,FYPMA2 +FYPMA3: +] + REST A ;GET FIRST PAGE AGAIN + IMULI A,1000*5 ;GET CHARACTER ADDRESS OF START OF MAPPED IN FILE + SUB A,GPT ;COMPUTE NEW SIZE OF GAP ON THIS END + MOVEM A,EXTRAC + REST A ;SIZE OF INPUT FILE AGAIN + ADDM A,PT ;PT TO END OF STUFF JUST INSERTED + ADDM A,ZV + SUB A,D ;FOR NOW SET END HIGH SO GETS BLTED ALONG WITH REST OF + ADDM A,Z + CALL SLPSHT ;CLOSE UP THE LOWER GAP + ADDM D,Z ;FIX UP END OF BUFFER + MOVNM D,EXTRAC ;SIZE OF UPPER GAP + JRST UTLSTP ;TELL EVERYONE AT EOF NOW +] + +;FY - READ CHARACTERS FROM THE INPUT FILE, OR UNTIL EOF, +;AND INSERT THEM IN THE BUFFER BEFORE POINT. NO PADDING CHARACTERS ARE +;FLUSHED, SO ALL IS UNDER PROGRAMMER CONTROL. IF THE TRANSFER GOES TO A WORD +;BOUNDARY, AND STARTS AT A WORD BOUNDARY IN THE FILE, THEN IT IS +;SUITABLE FOR READING IN BINARY DATA. TO MAKE THAT HAPPEN, WE SOMETIMES +;INSERT SOME SPACES IN THE BUFFER TO PRODUCE CORRECT ALIGNMENT, +;AND THEN DELETE THEM WHEN FINISHED READING. +FYCMD: TLNN FF,FLIN + TYPRE [NFI] + TRNN FF,FRARG + JRST FYCMDA ;NO ARG => READ THE WHOLE FILE. + JUMPL C,TYPAOR ;NEGATIVE ARG NOT ALLOWED. +FYCMD6: SAVE C + MOVE BP,UTYIP ;FOR SPEED, LEAVE ENOUGH SPACE BEFORE INSERTING THE FILE + CALL GETCA ;TO ENABLE TRANSFER TO GO WORDWISE. + MOVEI BP,1(BP) + SUB BP,PT + IDIVI BP,5 + SKIPE BP,T + ADDI BP,5 + SAVE BP + ADD C,BP ;THAT MUCH, PLUS # CHARS BEING READ, IS AMT OF SPACE WE NEED. + CALL GAPSLP ;GET GAP TO POINT. + CALL SLPSAV ;MAKE SURE THERE'S ENOUGH SPACE. + MOVE C,-1(P) + MOVE BP,PT + ADD BP,(P) ;LEAVE THE FEW CHARS OF SPACE TO REACH PROPER ALIGNMENT. + CALL GETIBP ;CREATE B.P. FOR IDPB'ING INTO THE GAP. +FYCMD0: JUMPE C,FYCMDE + MOVE A,UTYIP ;AND LOOK AT B.P. WE'LL ILDB FROM. + HRRZ B,UTRLDT + ADD B,[(010700)-1] +FYCMDW: TLNN A,760000 + JRST FYCMD1 ;JUMP IF CAN START GOING WORD-WISE. +FYCMDS: CAMN A,B + JRST FYCMDR ;IF UTIBUF EXHAUSTED, MUST RELOAD IT. + ILDB CH,A ;OTHERWISE, TRANSFER ONE MORE CHARACTER + IDPB CH,BP + SOJG C,FYCMDW + MOVEM A,UTYIP +FYCMDE: CALL UTEOF ;IF THERE'S NOTHING LEFT IN THE INPUT FILE, MARK IT "AT EOF". + MOVE E,-1(P) + SUB E,C ;# CHARS ACTUALLY READ IN + ADD E,(P) ;PLUS # CHARS OF SPACE LEFT AT FRONT. + ADDM E,GPT ;"INSERT" THE DATA AND THE SPACE AT FRONT. + ADDM E,ZV ;BUT DON'T CHANGE POINT, YET. + ADDM E,Z + SUBM E,EXTRAC + MOVNS EXTRAC + REST C ;C HAS # CHARS OF SPACE THAT'S NOW IN THE BUFFER + SUB P,[1,,1] + JUMPE C,FYCMD8 + SUB E,C ;E HAS # CHARS OF REAL DATA NOW INSERTED. + CALL GAPSLP ;GET GAP TO POINT, WHICH STILL POINTS VBEFORE THE SPACE + CALL DELETB ;AND DELETE THE SPACE. +FYCMD8: ADDM E,PT ;NOW MAKE POINT GO AFTER THE INSERTED DATA. + RET + +FYCMDR: CAME A,[010700,,UTIBE-1] + JRST FYCMDE ;IF LAST INPUT BUFFER WASN'T FULL, THIS IS EOF. + CALL UTRLD2 ;ELSE, READ ANOTHER INPUT BUFFER AND CONTINUE TRANSFERING. + JRST FYCMD0 + +;HERE TO ATTEMPT A WORD-WISE TRANSFER. +FYCMD1: MOVEM A,UTYIP + CAIGE C,5 ;DON'T BOTHER TRYING TO GO FAST IF < 1 WHOLE WORD LEFT. + JRST FYCMDS + IDIVI C,5 .SEE D + IBP BP + SUB B,A ;IF THEER'S ANYTHING LEFT IN UTIBUF, MUST USE IT FIRST. + JUMPE B,FYCMDI ;LH'S CANCEL SINCE BOTH ARE 010700. + IBP A + HRL BP,A + CAMLE B,C ;# WORDS TO TRANSFER RIGHT NOW = + MOVE B,C ;MIN (, ). + ADDM B,UTYIP ;REMOVE THAT MANY WORDS FROM THE BUFFER. + SUB C,B ;# WORDS THAT WILL BE LEFT EMPTY AFTER USING UP UTIBUF? + ADD B,BP + BLT BP,-1(B) ;TRANSFER WHAT'S LEFT OF UTIBUF. + IMULI C,5 + HRRZ BP,B + JRST FYCMD2 + +;GOING WORD AT A TIME, AND UTIBUF IS EMPTY, SO GET DIRECTLY FROM FILE. +FYCMDI: +IFN ITS,[ + CAIGE C,100000 ;DON'T TRY TO IOT MORE THAN 32K AT A TIME. + JRST FYCMD4 + IMULI C,5 + ADD D,C ;SO PUT TOTAL # CHARS TO GET, MINUS 32K OF CHARS, IN D, + SUBI D,5*100000 + MOVEI C,100000 ;AND GET ONLY 32K RIGHT NOW. +FYCMD4: MOVNS C + HRL BP,C ;AOBJN -> BUFFER WORDS TO TRANSFER INTO. + .IOT CHFILI,BP + HLRE C,BP +] +IFN TNX,[ + SAVE B + MOVE A,CHFILI ;INPUT FILE + MOVEI B,(BP) ;FIRST WORD TO READ INTO + HRLI B,444400 + MOVNS C + SIN + MOVEI BP,1(B) ;UPDATE FIRST WORD NOT READ INTO + HRL BP,C ;UPDATE COUNT LEFT TO DO + REST B +] + IMUL C,[-5] +FYCMD2: ADD C,D ;# CHARS WE WERE SUPPOSED TO TRANSFER BUT HAVEN'T YET. + JUMPL BP,FYCMD3 ;EOF => WE WILL NEVER GET THEM, SO INSERT WHAT WE HAVE GOT. + ADD BP,[(010700)-1] ;GET BACK B.P. TO IDPB THE REST OF THE DATA + JRST FYCMD0 ;RELOAD BUFFER TO XFER LAST FEW CHARS 1 AT A TIME. + +FYCMD3: CALL UTLSTP + JRST FYCMDE + +;READ NEXT CHARACTER FROM OPEN INPUT FILE, AND RETURN IT IN CH. +;UP TO A WORD OF ^C'S OR ^@'S BEFORE THE END OF THE FILE WILL BE IGNORED. +;IF TRY TO READ PAST EOF, FS LASTPAGE$ WILL BE SET TO 0, AND ^L WILL BE RETURNED. +UTYI: ILDB CH,UTYIP + CAILE CH,EOFCHR + RET + CAIE CH,EOFCHR + JUMPN CH,CPOPJ + HRRZ CH,UTYIP + CAIN CH,UTIBE + JRST UTYIR ;EXHAUSTED BUFFER => REALOD IT AND TRY AGAIN. +UTYI4: MOVE CH,UTYIP + CAMN CH,UTRLDT + JRST UTYIE ;READ PAST EOF => CLOSE FILE AND RETURN A ^L. +;^C OR ^@ INSIDE THE FILE - IS IT PADDING BEFORE EOF? + HRLI CH,010700 + IBP CH + CAME CH,UTRLDT ;MORE THAN 1 WORD FROM THE END => IT ISN'T PADDING. + JRST UTYI5 + ANDI CH,-1 + CAIE CH,UTIBE ;THIS LAST WORD OF INPUT BUFFER => WE DON'T KNOW WHETHER + JRST UTYI1 ;THERE ARE MORE WORDS IN THE FILE, + MOVE CH,UTIBE-1 ;SO FIND OUT BY PUTTING THIS WORD AT BEGINNING OF BUFFER + MOVEM CH,UTIBUF ;AND FILLING UP THE REST IF POSSIBLE. + MOVE CH,UTIBE + MOVEM CH,UTIBUF+1 + MOVNI CH,UTIBE-UTIBUF-1 + ADDM CH,UTYIP + ADDM CH,UTRLDT + CALL UTRLD3 ;NOW TRY FILLING REST OF INPUT BUFFER. + JRST UTYI4 ;WE NOW HAVE ENOUGH INFO TO ANSWER OUR QUESTION. + +;COME HERE WHEN A ^C OR ^@ IS FOUND IN THE LAST WORD OF THE FILE, TO LOOK +;AHEAD AND SEE IF REST OF THE CHARS IN LAST WORD ARE ALL ^C OR ^@. +UTYI1: SAVE UTYIP +UTYI3: ILDB CH,UTYIP + CAIE CH,^C + JUMPN CH,UTYI2 + MOVE CH,UTYIP + CAME CH,UTRLDT + JRST UTYI3 + SUB P,[1,,1] ;ALL ARE ^C OR ^@ => RETURN CLOSING FILE. +UTYIE: CALL UTLSTP + MOVEI CH,^L + RET + +UTYI2: REST UTYIP ;NOT ALL PADDING => THIS ^C OR ^@ IS REALLY DATA, AND SO ARE THE REST. +UTYI5: LDB CH,UTYIP + RET + +UTYIR: CALL UTRLD2 + JRST UTYI ;GO BACK AND TRY AGAIN + +;"EC" COMMAND -- CLOSE THE INPUT FILE AND MARK IT CLOSED. +UICLS: CALL UTLSTP ;FIRST, SET "AT EOF" SO ATTEMPTS TO READ WILL GET ^C'S. + CLOSEF CHFILI + TLZ FF,FLIN + RET + +;REFILL THE INPUT BUFFER. +UTRLD2: MOVE CH,[10700,,UTIBUF-1] + MOVEM CH,UTYIP +IFN ITS,[ + SKIPA CH,[UTIBUF-UTIBE,,UTIBUF] +UTRLD3: MOVE CH,[UTIBUF+1-UTIBE,,UTIBUF+1] + .IOT CHFILI,CH + HRRM CH,UTRLDT ;FIRST ADR. NOT LOADED BY SYS + JUMPGE CH,CPOPJ + MOVEI CH,EOFCHR + DPB CH,UTRLDT ;STORE EOF THERE + POPJ P, +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVE B,[444400,,UTIBUF] ;POINTER TO BUFFER + MOVNI C,UTIBE-UTIBUF ;COUNT TO READ +UTRLD4: MOVE A,CHFILI ;INPUT FILE + SIN + AOJ B, ;WILL BE OF THE FORM 004400,,ADDR-1 + HRRM B,UTRLDT ;FIRST ADDR NOT LOADED + JUMPE C,POP321 ;HAVE WE REACHED EOF? + MOVEI CH,EOFCHR ;YES + DPB CH,UTRLDT + JRST POP321 +UTRLD3: JSR SAV123 + MOVE B,[444400,,UTIBUF+1] ;TRY TO FILL THE REST OF THE BUFFER + MOVNI C,UTIBE-UTIBUF-1 + JRST UTRLD4 +] + +;SEE IF THE INPUT FILE IS AT EOF. IF SO, SET FS LASTPA, ETC. +;TO TELL THE USER THAT IT IS. +UTEOF: SKIPL LASTPA + RET ;ALREADY AT EOF => NO CHANGE. + MOVE CH,UTYIP + IBP CH + CAME CH,UTRLDT ;MORE LEFT IN INPUT BUFFER => NOT EOF + RET + ANDI CH,-1 + CAIE CH,UTIBE ;NONE LEFT IN INPUT BUFFER, AND BUFFER WASN'T A FULL ONE, + JRST UTLSTP ;=> CLEARLY AT EOF. + CALL UTRLD2 ;AT END OF BUFFER => TRY READING SOME MORE TO SEE + JRST UTEOF ;IF AT EOF. + +;INDICATE THAT THE INPUT FILE IS AT EOF. ALL ATTEMPTS TO READ MORE +;WILL JUST ENCOUNTER ANOTHER EOF. +UTLSTP: SETZM LASTPA ;SAY "EOF" TO ANYONE WHO ASKS. + MOVE CH,[010700,,[ASCIC//]-1] + MOVEM CH,UTYIP ;SET UP BUFFER TO APPEAR TO BE JUST BEFORE AN EOF + IBP CH ;SO THAT ANY ATTEMPT TO READ A CHARACTER WILL SEE EOF + MOVEM CH,UTRLDT ;AND COME RIGHT BACK HERE. + RET + +;FS IF LENGTH$ - READ LENGTH OF OPEN INPUT FILE. +FSIFLEN:TLNN FF,FLIN + TYPRE [NFI] + MOVEI A,CHFILI +IFN ITS,[ +FSIFL1: SYSCAL FILLEN,[A ? %CLOUT,,A] + SKIPA A,[-1] +] +IFN TNX,[ +FSIFL1: MOVE A,(A) ;INPUT FILE + MOVE B,[2,,.FBBYV] + MOVEI C,A + GTFDB + EXCH A,B + LDB C,[.BP FB%BSZ,B] ;GET BYTE SIZE + CAIN C,7 ;IF 7, ALREADY HAVE WHAT WE WANT + JRST POPJ1 + CAIN C,36. ;IF 36, KNOW HOW MANY WORDS ALREADY + JRST .+4 + MOVEI B,36. + IDIVI B,(C) ;GET NUNBER OF BYTES IN A WORD + IDIVI A,(B) ;GET NUMBER OF WORDS +] + IMULI A,5 ;INTO CHARACTERS + JRST POPJ1 + +FSOFLEN:TLNN FF,FLOUT + TYPRE [NDO] + MOVEI A,CHFILO + JRST FSIFL1 + +;SET INPUT FILE ACCESS POINTER TO CHAR # IN C. +FSIFAC: TLNN FF,FLIN + TYPRE [NFI] +IFN ITS,[ + MOVEI A,CHFILI + .CALL RFACCB + TYPRE [NRA] ;NOT RANDOM ACCESS FILE. + IDIVI C,5 ;CHANGE ARG TO WORD #. + .ACCES CHFILI,C ;FIND THAT WORD. +] +IFN TNX,[ + IDIVI C,5 ;CONVERT TO WORD # + MOVE A,CHFILI + MOVE B,C ;GET ARG + SFPTR + TYPRE [NRA] +] + SETOM LASTPA ;EVEN IF FILE WAS AT EOF, IT WON'T BE ANY MORE. + CALL UTRLD2 ;FILL UP THE INPUT BUFFER + HRRZ CH,UTRLDT + CAIN CH,UTIBUF ;DID WE GET ANYTHING? + JRST UTLSTP ;NO, .ACCESS WENT TO EOF. + JUMPE D,CPOPJ ;YES, ADVANCE IN WORD TO SPEC'D CHARACTER IF IT ISN'T THE 1ST. + IBP UTYIP + SOJG D,.-1 + RET + +SUBTTL OUTPUT TO FILES + +;P COMMAND WITH 2 ARGS. +PUNCHB: CALL GETARG + CALL CHK1A +PUNCHF: ;PUNCH OUT RANGE SPEC'D BY C,E. + CAMGE E,GPT + CAMG C,GPT ;IF GAP IS INSIDE RANGE TO BE PUNCHED, WE MUST BE CAREFUL. + JRST PUNCHG + PUSH P,C + MOVE C,GPT + CALL PUNCHG ;FIRST, PUNCH EVERYTHING UP TO THE GAP. + MOVE E,GPT + MOVE TT,EXTRAC + IDIVI TT,5 + JUMPE TT1,[ ;IF GAP DOESN'T DESTROY ALIGNMENT, JUST PUNCH EVERYTHING AFTER THE GAP. + POP P,C + JRST PUNCHG] +PUNCHJ: MOVE E,GPT ;GAP DESTROYS ALIGNMENT; IT IS FASTEST TO ADJUST ALIGNMENT OURSELVES + MOVE C,E ;BY MOVING THE GAP UP PAST THE TEXT TO BE OUTPUT. + ADDI C,4*5*2000 ;MOVE THE GAP PAST AT MOST 4K AT A TIME + SUB C,UTYOCT ;(PLUS ENOUGH TO FILL OUTPUT BUFFER, TO INSURE IT'S EMPTY AT NEXT STOP) + MOVE T,(P) ;AND THEN OUTPUT THAT 4K. + CAMG T,C ;WHEN LESS THAN 4K REMAIN TO BE DONE, + JRST [ POP P,C ;WE DO WHAT IS LEFT AND EXIT. + JRST PUNCHH] + CALL PUNCHH + JRST PUNCHJ + +PUNCHH: SAVE PT ;MOVE THE GAP UP PAST END OF RANGE TO BE TRANSFERRED NOW, + MOVEM C,PT + CALL GAPSL0 ;WITHOUT MARKING THE BUFFER AS MODIFIED, HOWEVER. + REST PT +PUNCHG: MOVE IN,E + MOVE BP,IN + SUBM C,IN ;IN GETS COUNT OF CHARS REMAINING. + JUMPLE IN,CPOPJ + PUSHJ P,GETIBV ;BP GETS BP TO FETCH FROM BUFFER. +PCHF1: MOVE TT,UTYOP + HLRZ OUT,BP + CAMN TT,[010700,,UTOBUF-1] ;UTOBUF EMPTY AND + CAIE OUT,010700 ;NEXT CHR IN BUFFER IS 1ST IN A WD => + JRST PCHF2 +PCHF3: CAIGE IN,5 ;TRY .IOTING OUT OF BUFFER. + JRST PCHF2 + ADDI BP,1 + MOVE CH,IN ;GET # WDS FULL IN BUFFER AFTER WHERE WE ARE. + IDIVI CH,5 +IFN ITS,[ + CAIL CH,4000 + MOVEI CH,4000 ;DON'T OUTPUT MORE THAN 2K AT ONCE. + MOVNS CH + HRLI BP,(CH) ;BP HAS AOBJN -> WDS IN BUFFER. + .IOT CHFILO,BP +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVNS C,CH ;NUMBER OF CHARS + MOVEI B,(BP) ;FIRST WORD + HRLI B,444400 + MOVE A,CHFILO ;OUTPUT FILE + SOUT + HRRI BP,1(B) ;FIRST ADDR NOT WRITTEN + JSP A,RST321 ;RESTORE ACS +] + IMULI CH,5 ;# CHARS JUST OUTPUT. + ADD IN,CH ;THAT MANY FEWER LEFT. + SUBI BP,1 ;CHANGE BP BACK TO BP TO NEXT CHAR. + HRLI BP,010700 + JRST PCHF3 ;HANDLE REMAINING CHARS. + +PCHF2: MOVN OUT,UTYOCT + CAMLE OUT,IN + MOVE OUT,IN ;OUT GETS # OF CHARS TO XFER INTO OUTPUT BUFFER. + PUSH P,OUT + JUMPE OUT,PPG1 + MOVE E,[PPG,,A] + BLT E,D + JRST A + +PPG: ILDB CH,BP ;A + IDPB CH,TT ;B + SOJG OUT,A ;C + JRST PPG1 ;D + +PPG1: POP P,OUT + MOVEM TT,UTYOP + ADDM OUT,UTYOCT ;UPDATE MINUS NUMBER OF FREE CHARS REMAINING IN BUFFER. + SKIPL UTYOCT + CALL UTYOA + SUB IN,OUT + JUMPG IN,PCHF1 + RET + +POPDJ: POP P,D + POPJ P, + +;THIS IS THE HIGHER LEVELS OF THE P COMMAND. +PUNCH: SKIPGE OUTFLG ;CHECK FOR OUTPUT DISABLED OR NO FILE OPEN. + RET + TLNN FF,FLOUT + TYPRE [NDO] + TRNE FF,FRARG2 + JRST PUNCHB ;2-ARG P COMMAND. + MOVE T,CPTR + ILDB T,T ;ELSE PEEK AT NEXT CHAR TO SEE IF IT IS W. + ANDCMI T,40 + SKIPE COMCNT + CAIE T,"W +PUNCHA: SETZ T, ;ENTER HERE FOR N AND EE COMMANDS. + SKIPGE OUTFLG ;IF T IS NONZERO, DON'T READ, JUST OUTPUT. + RET + TLNN FF,FLOUT + TYPRE [NDO] + MOVE D,C ;D HAS NUMBER OF PAGES TO OUTPUT. + JUMPL D,CPOPJ +PUN1: SAVE D + SAVE T + PUSHJ P,PUNCHR + TRZ FF,FRARG + REST T + SKIPN T + CALL YANKEE + REST D + MOVE E,ZV + CAMN E,BEGV ;KEEP FEEDING PAGES THROUGH UNTIL COUNT RUNS OUT + SKIPE LASTPA ;OR WE ARE AT EOF WITH AN EMPTY BUFFER. + SOJG D,PUN1 +CPOPJ: POPJ P,VIEW1 + +PUNCHR: SKIPGE STOPF ;IN BETWEEN PAGES, + CALL QUIT0 ;TRY TO QUIT IF DESIRED (CHECKS NOQUIT). + MOVE E,BEGV + MOVE C,ZV + SKIPE FFMODE ;IN FFMODE, ANY ^L DESIRED IS ALREADY IN BFR. + JRST PUNCHF + CALL PUNCHF ;IF ^L'S READ GET THROWN AWAY, + MOVEI CH,^L ;MUST REGENERATE THEM ON OUTPUT. + JRST PPA + +;FORCE OUT CONTENTS OF OUTPUT BUFFER. CLOBBERS A, B, C. +FLSOUT: TLNN FF,FLOUT + RET ;NO OUTPUT FILE. + MOVE B,UTYOP + IBP B ;-> WD NEXT OUTPUT CHAR WILL GO IN. + MOVEI A,@B + MOVNI C,-UTOBUF(A) ;# WDS FILLED UP IN FRONT END OF BFR. + JUMPE C,CPOPJ +IFN ITS,[ + HRLZI A,(C) + HRRI A,UTOBUF ;AOBJN -> FILLED PART. + .IOT CHFILO,A +] +IFN TNX,[ + SAVE C + SAVE B + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + SOUT + REST B + REST C +] + MOVE A,(B) ;GET THE PARTIALLY FILLED WORD. + MOVEM A,UTOBUF ;PUT IT IN 1ST WD OF BUFFER, + ADDM C,UTYOP ;BACK THE BP UP THE RIGHT # WDS. + IMULI C,5 + ADDM C,UTYOCT ;MORE SPACE IN OUTPUT BUFFER NOW. + POPJ P, + +;OUTPUT CHAR IN CH TO OUTPUT FILE, IF ANY. +PPA: +PPA2: SKIPGE OUTFLG + RET + TLNE FF,FLOUT + JRST UTYO + RET + +UTYO: IDPB CH,UTYOP + AOSGE UTYOCT + POPJ P, +UTYOA: MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT +IFN ITS,[ + MOVE CH,[UTOBUF-UTOBE,,UTOBUF] + .IOT CHFILO,CH + MOVE CH,[10700,,UTOBUF-1] + EXCH CH,UTYOP + POPJ P, +] +IFN TNX,[ + JSR SAV123 ;SAVE ACS + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + MOVNI C,UTOBE-UTOBUF ;COUNT + SOUT + MOVE CH,[10700,,UTOBUF-1] ;UPDATE BUFFER POINTER + EXCH CH,UTYOP + JRST POP321 ;RESTORE ACS AND RETURN +] ;IFN TNX + +;SET ACCESS POINTER OF OUTPUT FILE TO CHAR # IN C, +;WHICH MUST BE A MULTIPLE OF 5. ERROR IF ANY CHARS IN OUTPUT +;BUFFER ARE LOST (WHICH WILL BE THE CASE UNLESS OUTPUT STOPPED +;ON A WORD BOUNDARY). +FSOFAC: TLNN FF,FLOUT + TYPRE [NDO] +IFN ITS,[ + MOVEI A,CHFILO + .CALL RFACCB + TYPRE [NRA] +] + SAVE C + CALL FLSOUT ;FORCE OUT THE OUTPUT BUFFER. + REST C + MOVN A,UTYOCT ;ANYTHING NOT FORCED OUT?? + CAIE A,UTBSZ*5 + TYPRE [WLO] + IDIVI C,5 ;GET WORD # IN FILE OF DESIRED POSITION. + SKIPE D + TYPRE [ARG] ;ARG NOT MULTIPLE OF 5?? +IFN ITS,.ACCES CHFILO,C +IFN TNX,[ + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,C + SFPTR ;SET POINTER + TYPRE [NRA] +] + RET + +SUBTTL I/O COMMANDS + +ECMD: TLO FF,FLDIRDPY ;DISPATCH FOR E-COMMANDS. + PUSHJ P,LRCH + ANDI CH,-1 + CAIN CH,^U + JRST EUHACK + CAIGE CH,"? ;IF CHARACTER BEYOND "?, DISPATCH ON IT. + TYPRE [IEC] + XCT ETAB-"?(CH) + +RLTCLK: CALL SAVACS ;RUN THE REAL TIME CLOCK HANDLER. DON'T CLOBBER ANYTHING. + SETZM CLKFLG + SKIPE A,CLKMAC + CALL MACXCP + SETZM CLKFLG + JRST RSTACS + +IFN ITS,[.SEE %%TNX% ;WHERE THIS MOBY CONDITIONAL ENDS + +ASLEEP: CALL IMMQIT + TRZE FF,FRCLN + JRST ASLEE1 + TRZE FF,FRARG + .SLEEP C, + JRST DELQIT + +ASLEE1: AOS (P) ;:^S 1) RETURNS RESULT OF FS LISTEN$ +ASLEE4: TRZ FF,FRARG ; 2) SLEEPS ONLY AS LONG AS THERE IS NO INPUT AVAIL. + SKIPN TYISRC + SKIPL UNRCHC + SKIPA A,[1] + .LISTEN A, + JUMPN A,DELQIT + JUMPE C,DELQIT + CALL TTYAC2 +ASLEE2: .SLEEP C, + JRST ASLEE4 + +EQMRK: CALL FFRRDD ;E?$ 0 IF FILE EXISTS, ELSE (NUMERIC) ERROR CODE. + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;TRY TO OPEN; A GETS 0 OR I.T.S. ERROR CODE + JFCL + SETZM IMQUIT + .CLOSE CHRAND, + JRST POPJ1 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS, +FSCLKI: SKIPE C ;OR TURN OFF REAL TIME CLOCK, WITH ARG OF 0. + SKIPA A,[%RLSET,,C] + MOVSI A,%RLFLS + .REALT A, + RET + +SUBTTL EG COMMAND + +EGET: PUSH P,LISTF5 + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY ;EGET TO INSERT IN THE BUFFER + PUSHJ P,GDATIM + JFCL + PUSHJ P,GLPDTM + SKIPG E,DATE ;THE DATE + SETZ E, ;IF SYSTEM DOESN'T KNOW DATE, USE 6 SPACES. + CALL TYPR + CALL CRR1 + SKIPG E,TIME + SETZ E, + CALL TYPR ;INSERT TIME FROM SIXBIT WORD, + CALL CRR1 + MOVE A,DEFDIR ;THE CURRENT SYSTEM NAME + PUSHJ P,SIXINS + CALL LFILE ;INSERT CURRENT DEFAULT FILE NAMES. + CALL CRR1 + TLNN FF,FLIN ;THE NAMES OF THE FILE OPEN FOR READING (IF ANY) + JRST EGET2 ;(NONE, LEAVE BLANK LINE - EVENTUALLY REPLACE THIS CRUFT WITH .RCHST) + MOVE A,ERSNM + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,ERDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,RUTF1 + MOVEI C,40 + PUSHJ P,SIXINT + SKIPA A,RUTF2 +EGET2: SETZI A, + PUSHJ P,SIXINS + SKIPL TIME + PUSHJ P,SYMDAT ;THE DATE IN STANDARD SYMBOLIC FORM + PUSHJ P,CRR1 + LDB CH,[320300,,YEAR] ;A THREE DIGIT NUMBER + PUSHJ P,DGPT ;FIRST DIGIT DAY OF WEEK (0 => SUNDAY) + LDB CH,[270300,,YEAR] ;SECOND DIGIT DAY OF WEEK OF BEGINNING OF YEAR + PUSHJ P,DGPT + LDB CH,[410300,,YEAR] ;THIRD DIGIT 3 BITS + ;4 BIT 1 => NORMAL YEAR AFTER 2/28 + ;2 BIT 1 => LEAP YEAR + ;1 BIT 1 => DAYLIGHT SAVINGS TIME IN EFFECT + PUSHJ P,DGPT + PUSHJ P,CRR1 + PUSHJ P,POM ;THE PHASE OF THE MOON + PUSHJ P,CRR1 + POP P,LISTF5 + POPJ P, + + ;VARIOUS TIME GETTING ROUTINES + +GDATIM: .RDATIM A, ;GET TIME IN A, DATE IN B + MOVEM A,TIME ;STORE SIXBIT TIME + MOVEM B,DATE ;STORE SIXBIT DATE + JUMPGE A,POPJ1 ;IF TIME AVAILABLE THEN SKIP-RETURN + POPJ P, ;NOT AVAILABLE, DON'T SKIP (BUT LEAVE TIME AND DATE NEGATIVE) + +GLPDTM: .RLPDT A, ;GET VARIOUS TIMES IN BINARY + MOVEM B,YEAR ;SAVE YEAR AND FLAGS + MOVEM A,LPDTIM ;SAVE LOCALIZED # SECONDS SINCE BEGINNING OF YEAR + TLNE B,400000 ;IF NORMAL YEAR AFTER FEB 28, + SUBI A,SPD ;THEN BACK UP A DAY + TLNE B,100000 ;IF DAYLIGHT SAVINGS TIME IN EFFECT, + SUBI A,3600. ;THEN BACK UP AN HOUR + MOVEM A,PDTIME ;SAVE # SECONDS SINCE BEGINNING OF YEAR + POPJ P, + + ;TYPE OUT (THROUGH LISTF5) THE DATE IN ENGLISH + +SYMDAT: PUSHJ P,DOW ;TYPE DAY OF WEEK + REPEAT 2,PUSHJ P,SPSP ;TYPE TWO SPACES + MOVE E,DATE ;GET DATE + DPB E,[221400,,CDATE] ;DEPOSIT SIXBIT FOR DAY OF MONTH + LDB CH,[220100,,DATE] ;GET FIRST DIGIT OF MONTH + LDB E,[140400,,DATE] ;GET SECOND DIGIT OF MONTH + IMULI CH,10. ;MULTIPLY THE FIRST DIGIT TO ITS PROPER WEIGHTING + ADD E,CH ;ADD TOGETHER TO GET MONTH + MOVE E,MONTHS-1(E) ;GET MONTH IN SIXBIT + PUSHJ P,SIXNTY ;TYPE OUT MONTH + MOVE E,CDATE ;GET FIRST PART OF DATE + PUSHJ P,TYPR ;TYPE OUT + MOVE E,DATE ;GET DATE + MOVEI IN,2 ;LIMIT TYPEOUT TO TWO CHARACTERS + JRST TYPR3 ;TYPE OUT LAST TWO DIGITS OF YEAR AND RETURN + +MONTHS: IRPS S,,[JAN FEB MARCH APRIL +MAY JUNE JULY AUG SEPT OCT NOV DEC] + SIXBIT /S/ +TERMIN + + ;TYPE OUT DAY OF WEEK + +DOW: LDB A,[320300,,YEAR] ;GET DAY OF WEEK (0 => SUNDAY) + MOVE A,DOWTBL(A) ;GET SIXBIT FOR DAY (EXCEPT FOR THE "DAY") + PUSHJ P,SIXIN1 ;TYPE OUT + MOVSI A,(SIXBIT /DAY/) ;NOW FOR THE "DAY" + JRST SIXIN1 ;TYPE IT OUT AND RETURN + +DOWTBL: IRPS DAY,,[SUN MON TUES WEDNES THURS FRI SATUR] + SIXBIT /DAY/ + TERMIN + + ;TYPE OUT THE PHASE OF THE MOON + +POM: PUSHJ P,GNDS0 ;GET NUMBER OF DAYS SINCE 1/1/0000 + MULI A,SPD ;CONVERT TO SECONDS IN A AND B + JFCL 17,.+1 ;CLEAR FLAGS FOR FOLLOWING + ADD B,PDTIME ;# SECONDS SINCE BEGINNING OF YEAR + ADD B,SYNOFS ;THE MOON DOESN'T QUITE BELIEVE IN THE GREGORIAN CALENDAR SYSTEM + JFCL 4,[AOJA A,.+1] ;CRY1 + ASHC A,2 ;CONVERT TO QUARTER SECONDS + DIV A,SYNP ;DIVIDE BY NUMBER OF SECONDS IN A PERIOD TO GET NUMBER OF QUARTERS SINCE THEN + ASH B,-2 ;CONVERT REMAINDER TO SECONDS (# SECONDS INTO THIS QUARTER) + PUSH P,B ;SAVE REMAINDER + IDIVI A,4 ;GET QUARTER IN B + MOVE A,[SIXBIT /NM+ FQ+ FM+ LQ+/](B) ;GET SIXBIT CRUFT IN A (I REFUSE TO CHANGE THE 1Q!!!) + PUSHJ P,SIXIN1 ;TYPE IT OUT + POP P,B ;RESTORE # SECONDS INTO THIS PERIOD +TDHMS: MOVEI E,TDHMST ;SET POINTER TO TABLE +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + PUSHJ P,[AOJA E,TDHMS1] ;INCREMENT INDEX WHILE RECURSING + HLRZ C,(P) +TDHMS2: PUSHJ P,DPT ;TYPE OUT IN DECIMAL + HLLZ A,(E) ;GET SIXBIT CRUFT + SOJA E,SIXIN1 ;BACK UP INDEX, TYPE OUT, AND RETURN + +TDHMST: SIXBIT /S./+60. ;SECONDS + SIXBIT /M./+60. ;MINUTES + SIXBIT /H./+24. ;HOURS + SIXBIT /D./+<,-1> ;DAYS + +SYNP: 2551443. +SYNOFS: 690882. + + ;GET NUMBER OF DAYS SINCE 1/1/0000 (AS OF 1/1/CURRENT YEAR) IN A + +GNDS0: MOVEI C,@YEAR ;GET YEAR + MOVEI A,-1(C) ;ALSO GET YEAR-1 IN A + IMULI C,365. ;FIRST APPROXIMATION + IDIVI A,4 + ADD C,A ;ADD NUMBER OF YEARS DIVISIBLE BY 4 + IDIVI A,25. + SUB C,A ;SUBTRACT NUMBER OF YEARS DIVISIBLE BY 100 + IDIVI A,4 + ADD A,C ;ADD CRUD ALREADY CALCULATED TO NUMBER OF YEARS DIVISIBLE BY 400 + AOJA A,CPOPJ + +SUBTTL FILENAME READER FOR ITS + +;FILENAME PARSING ROUTINES. FFRDEV READS DEV AND SNAME ONLY. +;FFRRDD (ET CMD) READS ENTIRE NAME. +;FRD LEAVES THE NAMES IN A, B NOT SETTING DEFFN1 AND DEFFN2. +FFRDEV: TROA FF,FRNOT +FRD: TRZ FF,FRNOT + TROA FF,FRALT +ETCMD: +FFRRDD: TRZ FF,FRALT+FRNOT + MOVE A,DEFFN1 + MOVE B,DEFFN2 + SETOM FFRRCT + TRO FF,FRFIND +FF1: MOVEI E,0 + MOVE C,[440600,,E] +FF2: PUSHJ P,LRCH + SKIPGE SQUOTP + JRST FF3 + SKIPN SQUOTP + CAIE CH,ALTMOD + CAIN CH,40 + JRST FFTRM + CAIN CH,^I + JRST FFTRM + CAIE CH,^X + CAIN CH,^A ;^A OR ^X REFERS TO DEFAULT FIRST FILENAME. + JRST FFCTLX + CAIE CH,^Y + CAIN CH,^B ;^B OR ^Y REFERS TO SECOND DEFAULT FILE NAME + JRST FFCTLY + CAIN CH,"; + JRST FFSYSN + CAIN CH,": + JRST FFDEVN + CAIN CH,^Q + PUSHJ P,LRCH ;^Q QUOTES NEXT CHAR. +FF3: HRREI CH,-40(CH) + JUMPL CH,FF2 ;IGNORE CONTROL CHARACTERS. + TLNE C,770000 + IDPB CH,C + JRST FF2 + +;STORE NAME IN E AS SNAME, AND RESET DEVICE TO DSK IF APPROPRIATE. +FFSYSN: SKIPE E + MOVEM E,DEFDIR + .SUSET [.SSNAM,,E] + TRNN FF,FRFIND + JRST FF1 ;DEVICE HAS BEEN SPECIFIED + LDB C,[301400,,DEFDEV] + CAIE C,' ML + CAIN C,' AI + JRST FF1 + CAIE C,' MC + CAIN C,' ML + JRST FF1 + CALL FFDEV2 + JRST FF1 + +FFDEVN: PUSH P,[FFEND] +FFDEV1: JUMPE E,CPOPJ ;STORE THE CONTENTS OF E AS A DEVICE NAME, IF NOT NULL. + TRZ FF,FRFIND + CAMN E,['DSK,,] +FFDEV2: MOVE E,MACHIN + MOVEM E,DEFDEV + RET + +FFCTLX: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^X, + MOVE E,DEFFN1 ;GET THE DEFAULT FN1, + JRST FFTRM ;AND STORE IT AS A NAME. + +FFCTLY: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^Y, + MOVE E,DEFFN2 ;GET THE DEFAULT FN2, + JRST FFTRM ;AND STORE IT TOO. + +;STORE AWAY A "NORMAL FILENAME", IN E. IGNORE IT IF NULL. +FFSTOR: JUMPE E,CPOPJ + TRNE FF,FRNOT + JRST FFDEV1 + AOSE FFRRCT + MOVE A,B + MOVE B,E + RET + +;HERE AFTER A NAME IS TERMINATED WITH SOMETHING OTHER THAN : OR ; (IT'S A NORMAL NAME). +FFTRM: CALL FFSTOR +FFEND: CAIE CH,ALTMOD + JRST FF1 + SKIPL FNAMSY + SKIPA E,DEFFN2 + MOVSI E,'>_14 + SKIPE FNAMSY ;NONZERO FNAMSY SAYS + SKIPE FFRRCT ;IF ONLY ONE FILENAME + CAIA + JRST FFTRM ;USE ">" OR PREVIOUS DEFAULT AS SECOND. + TRZE FF,FRALT + RET + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + RET + +FSIFILE:SKIPA E,[ERDEV] ;FS I FILE$ - DESCRIBE OPEN INPUT FILE. +FSOFIL: MOVEI E,ROUDEV ;FS O FILE$ - DESCRIBE LAST CLOSED OUTPUT FILE. + AOSA (P) +FSDFRD: MOVEI E,DEFDEV + SAVE C + MOVEI C,14.*4 ;14 CHARS PER FILENAME >> ENOUGH + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVE A,3(E) ;WRITE THE DATA THROUGH THAT BYTE POINTER. + MOVEI C,"; + CALL SIXINT ;FIRST SNAME AND ";" AND A TAB + MOVEI CH,40 + IDPB CH,BP + MOVE A,(E) + MOVEI C,": ;THEN DEVICE NAME, ":", AND A TAB + CALL SIXINT + MOVEI CH,40 + IDPB CH,BP + MOVE A,1(E) ;THEN FN1 AND A TAB + MOVEI C,40 + CALL SIXINT + MOVE A,2(E) ;AND THE FN2. + CALL SIXIN1 + CALL QCLOSV + JRST POPCJ + +;FILE COPY +FCOPY: PUSHJ P,FFRRDD + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;OPEN FOR INPUT, NAMES IN DEFDEV ETC. + JRST OPNER1 + TRNN FF,FRUPRW ;^ E_ => XFER REAL FILENAMES OF SOURCE TO DEFAULTS. + JRST FCOPY3 + SYSCAL RFNAME,[ %CLIMM,,CHRAND ? 4WDARG( <%CLOUT,,DEFDEV>)] + .LOSE %LSFIL +FCOPY3: PUSHJ P,FFRRDD + SYSCAL OPEN,[[.BAO,,CHERRI] ? DEFDEV ? [SIXBIT/_TECO_/] ? [SIXBIT/_COPY_/] ? DEFDIR] + JRST OPNER1 + TRNN FF,FRCLN ;:E_ => TRANSFER INPUT FILE DATE TO OUTPUT FILE. + JRST FCOPY2 + SYSCAL RFDATE,[%CLIMM,,CHRAND ? %CLOUT,,Q] + SETOM Q + SYSCAL SFDATE,[%CLIMM,,CHERRI ? Q] + JFCL +FCOPY2: MOVE T,[-GCTBL,,GCTAB] + .IOT CHRAND,T + JUMPL T,FCOPY4 + MOVE T,[-GCTBL,,GCTAB] + .IOT CHERRI,T + JRST FCOPY2 + +FCOPY4: .CLOSE CHRAND, + MOVSI T,-GCTAB-1(T) + EQVI T,-1#GCTAB + .IOT CHERRI,T + SYSCAL RENMWO,[%CLIMM,,CHERRI ? DEFFN1 ? DEFFN2] + .VALUE + .CLOSE CHERRI, + JRST DELQIT + +BPNTRD: PUSHJ P,.OPNRD + TRZ FF,FRARG + JRST .FNPNT + +.OPNRD: PUSHJ P,FFRRDD +RRED: TLZ FF,FLIN ;IN CASE OPEN FAILS, INDICATE NOTHING IS OPEN. + CALL UTLSTP + MOVE A,[2,,CHFILI] + TRNE FF,FRARG ;IF HAVE ARG, IOR IT INTO OPEN-MODE. + TLO A,(C) + CALL IMMQIT + TLZ A,1 ;MAKE SURE MODE USED FOR INPUT OPEN IS EVEN! + .CALL RREDB ;OPEN NAMES IN DEFDEV ETC, MODE,,CHNL IN A. + JRST OPNER1 ;FAILURE. + SETZM IMQUIT + SETZM PAGENU ;HAVE READ 0 PAGES SO FAR. + SETOM LASTPA ;NOT ON LAST PAGE AS FAR AS TECO KNOWS. + CALL RREDGN ;DO .RCHST, SET UP ERDEV, ERSNM, RUTF1, RUTF2. +;COME HERE TO START "OFFICIALLY" READING A FILE ALREADY OPEN. +RRED1: TLO FF,FLIN + MOVEI CH,^C + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOS CH + HRRM CH,UTRLDT + POPJ P, + +RREDB: SETZ ? SIXBIT/OPEN/ ? A ? UTFARG ? 403000,,A + +RREDGN: MOVE A,DEFDIR + SYSCAL RFNAME,[%CLIMM,,CHFILI ? 4WDARG( <%CLOUT,,ERDEV>)] + .VALUE + SKIPN ERSNM ;IF DEVICE DOESN'T USE SNAME, GIVE CURRENT SNAME. + MOVEM A,ERSNM + RET + +;IO PUSH-DOWN COMMANDS + +;E[ => PUSH INPUT CHANNEL +PSHIC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + MOVEI CH,CHFILI ;SET ARG TO FOLLOWING + TLNN FF,FLIN ;IF FILE NOT OPEN, + JRST PSHIC2 + PUSHJ P,PSHCK ;E := WORD ADR OR DIE BECAUSE NOT RANDOM ACCESS + MOVE A,UTYIP ;GET BYTE POINTER + IBP A ;MAKE SURE IT POINTS *TO* THE WORD TO GET THE NEXT BYTE FROM + MOVEI T,(A) + SUB T,UTRLDT + HRREI T,(T) ;GET -<# WORDS TO GO TO END OF BUFFER> + JUMPE T,PSHIC2 ;JUMP IF AT END OF BUFFER, DON'T NEED TO DO .ACCESS + ADD E,T ;CALCULATE DESIRED WORD ADDRESS + .ACCESS CHFILI,E ;CLOBBER TO DESIRED +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA. + LSH E,1 + SUB E,LASTPA ;LASTPA HOLDS 0 OR -1. + LSH E,2 + TLNE FF,FLIN ;SAVE STATE OF FLIN TOO. + ADDI E,2 + HRRI A,1(E) ;LOW BIT SET SAYS INPUT CHNL. + PUSHJ P,CHPSH ;DO THE PUSH + JRST UICLS ;CLOBBER POINTERS AND RETURN + + ;E] => POP INTO INPUT CHANNEL + +POPIC: TLZ FF,FLDIRDPY ;DON'T DISPLAY DIRECTORY. + PUSHJ P,UICLS ;CLOBBER POINTERS FIRST + MOVE CH,[TRNN T,CHFILI] ;TRNN SKIPS IF THIS RIGHT KIND OF PDL ENTRY, CHFILI CHANNEL TO POP INTO + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + LDB CH,[020100,,A] + MOVNM CH,LASTPA + LDB CH,[031700,,A] + MOVEM CH,PAGENU + .STATUS CHFILI,CH ;GET CHANNEL STATUS + TRNE CH,77 ;IF NO DEVICE OPEN NOW + TRNN A,2 ;OR NONE WAS OPEN THEN, + JRST UTLSTP ;SAY WE'RE AT END OF FILE (MUST ALWAYS SAY THAT IF FLIN OFF) + TLO FF,FLIN ;OTHERWISE, SAY A FILE IS OPEN + CALL UTRLD2 ;RE-FILL INPUT BUFFER. + HRRI A,UTIBUF ;CONVERT BACK TO BYTE POINTER + DBP7 A ;DECREMENT TO GET RELOCATED ORIGINAL POINTER. + MOVEM A,UTYIP ;STORE AS POINTER + JRST RREDGN ;DO RFNAME; SET UP ERDEV, ERSNM, RUTF1, RUTF2. + + ;CHECK THE VALIDITY OF THE INPUT FILE OPEN ON CHANNEL SPECIFIED BY CH + +PSHCK: HRRZ A,CH ;GET CHANNEL + .CALL RFACCB + TYPRE [NRA] + RET + +RFACCB: SETZ ? 'RFPNTR ? A ? MOVEM E ((SETZ)) + + ;E\ => PUSH OUTPUT CHANNEL + +PSHOC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + CALL FLSOUT ;FORCE OUT BUFFER, EXCEPT 1 WD (LEFT IN 1ST WD OF BUFFER) + MOVE B,UTYOP ;GET B.P. TO SHIFT POS. FIELD INTO A. + IBP B ;GET BP TO PLACE NEXT CHAR GOES (RH = UTOBUF). + LDB A,[73500,,UTOBUF] ;GET 1ST 4 CHRS FROM THAT WD + ;(5TH CAN'T BE USED, SINCE FLSOUT WOULD HAVE OUTPUT THE WD) + LSHC A,7 ;LEFT-JUSTIFY CHARACTERS AND SHIFT MEAT OF BYTE POINTER IN, LEAVE BIT 1.1 BLANK (=> OUTPUT) + MOVEI CH,CHFILO ;PUT CHANNEL SPECIFICATION IN CH + PUSHJ P,CHPSH ;PUSH THE CHANNEL (ALSO PUSH A ONTO LOCAL PDL) + TLZ FF,FLOUT + RET ;CLOBBER BUFFER POINTERS AND RETURN + + ;E^ => POP INTO OUTPUT CHANNEL + +POPOC: TLZ FF,FLDIRDPY\FLOUT ;DON'T TRY TO CONTROL U + MOVE CH,[TRNE T,CHFILO] ;GET CHANNEL AND TEST INSTRUCTION IN T (INSTRUCTION SKIPS IF THIS RIGHT PDL ENTRY) + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + .STATUS CHFILO,C + TRNN C,77 + POPJ P, ;POPPED AN UNOPENED CHANNEL. + MOVEM A,UTOBUF ;STORE BACK PARTIALLY FILLED WORD + MOVE C,[700,,UTOBUF] ;GET BYTE POINTER LESS POSITION FIELD IN C + DPB A,[350700,,C] ;DEPOSIT POS FIELD + EXTRA LOW BIT + DBP7 C + MOVEM C,UTYOP ;STORE BACK NEW POINTER + ANDI A,177 ;MASK A TO POSITION FIELD_1 + IDIVI A,7_1 ;GET # CHARACTERS STILL TO BE PROCESSED THIS WORD - 1 IN A + ADDI A,*5-4 ;CONVERT TO NUMBER OF CHARACTERS YET TO OUTPUT + MOVNM A,UTYOCT ;STORE AS COUNT REMAINING + TLO FF,FLOUT ;FILE OPEN + RET + + ;PUSH THE IO CHANNEL SPECIFIED BY CH + +CHPSH: MOVE C,IOP ;GET IO PDL POINTER + PUSHJ P,CHPSH1 ;DO THE PUSH + MOVEM C,IOP ;STORE BACK UPDATED POINTER + POPJ P, + +CHPSH1: PUSH C,A + MOVE Q,[.IOPUS] + DPB CH,[270400,,Q] + XCT Q + POPJ P, + +CHPOP2: MOVE Q,[.IOPOP] + DPB E,[270400,,Q] + XCT Q + RET + + ;IO POP INTO THE CHANNEL SPECIFIED BY CH + +CHPOP: HLLM CH,CHPOPX ;STORE VALIDITY CHECKING INSTRUCTION + HRRM CH,GCHN2 ;STORE CHANNEL IN CHANNEL SEARCH ROUTINE (MAKE IT SKIP OVER IT) + MOVEI E,17 ;SET FIRST CHANEL FOR GCHN TO TRY + MOVE C,IOP ;GET IO PDL POINTER + HRRZ A,C ;GET RH IN A + MOVE B,[TYPRE [NOP] +] ;NOT ON PDL: EXECUTED IF SPECIFIED TYPE OF CHANNEL HASN'T BEEN PUSHED + PUSHJ P,CHPOP1 ;DO THE POP + XCT B ;LOST, DO THE APPROPRIATE THING + MOVEM C,IOP ;STORE BACK UPDATED POINTER + MOVE A,B ;PUT RETURN LOCAL PDL WORD IN A FOR ROUTINE THAT CALLED THIS ONE + MOVE CH,E ;RESTORE CH FOR CALLING ROUTINE + POPJ P, + + ;ENTRY ON TOP OF PDL WRONG TYPE, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + +CHPOP3: PUSH P,T ;SAVE LOCAL DESCRIPTOR WORD ON MAIN PDL + PUSHJ P,GCHN ;GET A FREE CHANNEL TO POP INTO + JRST POPAJ ;NO CHANNELS AVAILABLE + PUSHJ P,CHPOP2 ;POP INTO CHANNEL + HRLM E,-1(P) ;SAVE CHANNEL NUMBER POPPED INTO + PUSHJ P,[SOJA A,CHPOP1] ;TRY AGAIN ON ORIGINAL TASK + SOS -1(P) ;LOSE, CAUSE RETURN NOT TO SKIP + HLRZ CH,-1(P) ;RESTORE CHANNEL NUMBER, THIS TIME IN CH FOR PUSH BACK + POP P,A ;RESTORE LOCAL PDL ENTRY, BUT IN A + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPSH1 ;PUSH BACK CHANNEL AND RETURN + + +CHPOP1: CAIGE A,IOPDL ;IF A DOESN'T POINT INTO PDL, + POPJ P, ;THEN NOT ON PDL , UNSCREW PDL AND DO TYPRE [NOP] + POP C,T ;POP LOCAL PDL ENTRY INTO T + XCT CHPOPX ;SKIP IF THIS THE RIGHT KIND OF PDL ENTRY + JRST CHPOP3 ;WRONG KIND OF ENTRY, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + MOVE E,CH ;RIGHT KIND OF ENTRY, SAVE ORIGINAL CHANNEL SPECIFICATION IN E + MOVE B,T ;WIN, SAVE LOCAL PDL ENTRY FOR TOP LEVEL + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPOP2 + + ;FIND A FREE CHANNEL TO POP INTO + +GCHN: ;GCHN NAME OF ENTRY TRANSFERED TO, GCHN2 NAME OF INSTRUCTION TO ADDRESS MODIFY + XCT GCHN2 ;RH MODIFIED, CHANNEL REALLY TRYING TO POP INTO SO LEAVE IT ALONE + JRST GCHN3 ;DON'T POP INTO THIS CHANNEL + MOVE T,[.STATUS T] + DPB E,[270400,,T] + XCT T ;GET STATUS OF CHNL CONSIDERING POPPING INTO. + TRNN T,77 ;DEVICE OPEN ON CHANNEL? + JRST POPJ1 ;NO, RETURN WINNING +GCHN3: SOJGE E,GCHN ;LOSE, TRY NEXT CHANNEL + MOVE B,[TYPRE [NFC] +] ;NO FREE CHANNELS TO POP INTO + POPJ P, ;NON-SKIP RETURN + +EXITE: HRLOI C,377777 ;INFINITY + TRO FF,FRARG + MOVE E,BEGV ;PUNCH OUT IF BUFFER NONEMPTY + CAMN E,ZV + SKIPE LASTPA ;OR AN INPUT FILE IS OPEN + PUSHJ P,PUNCHA + CALL UICLS + JRST EFCMD + +;EF COMMAND - CLOSE OUTPUT FILE. +EFCMD: PUSHJ P,FRD ;READ FILENAMES TO CLOSE UNDER. +EFCMD1: MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + TLNN FF,FLOUT + TYPRE [NDO] + CAIA +EFCMDA: CALL UTYO ;PAD WITH THE CHARACTER IN FS FILEPAD TO WORD BNDRY. + MOVE CH,UTYOP + HRR CH,FILEPAD + TLNE CH,760000 + JRST EFCMDA + CALL FLSOUT ;FORCE OUT THE BUFFER (INCL. PADDING). + TRZE FF,FRCLN + JRST EFCMD2 + SYSCAL RENMWO,[%CLIMM,,CHFILO ? DEFFN1 ? DEFFN2] ;GIVE FILE ITS ULTIMATE SPEC'D NAME. + JRST OPNER1 +EFCMD2: SYSCAL RFNAME,[%CLIMM,,CHFILO ? 4WDARG( <%CLOUT,,ROUDEV>)] + .LOSE %LSFIL ;SET FS OFILE$ SO USER CAN FIND WHICH VERSION # IT WAS. + .CLOSE CHFILO, + TLZ FF,FLOUT + POPJ P, + +;EJ - OPEN FILE FOR READING AND LOAD IMPURE AREAS AS DUMPED IN FILE. +;TAKES A FILENAME ARGUMENT. DOES NOT ALTER THE DEFAULT SNAME. +;AFTER LOADING, TECO IS RESTARTED, WHICH MEANS M..L WILL BE DONE. +;^ EJ - WRITE ALL IMPURE AREAS INTO A FILE OPEN FOR WRITING, AND +;FILE IT AWAY AS SPEC'D NAMES. + +;FORMAT OF FILE: +;1ST WORD: SIXBIT/TECO/+1 (FOR ERROR CHECKING) +;2ND WORD: .FVERS OF TECO DOING THE DUMPING. + ;PREVENTS TECOS FROM LOADING DUMP FILES OF OTHER VERSIONS. +;3RD WORD: JRST 1, AS REQUIRED TO MARK THE BEGINNING OF SBLK DATA IN A BIN FILE +;THEN COME SBLK DATA BLOCKS SPECIFYING RANGES OF CORE TO LOAD, +;AND THEN TWO COPIES OF THE START ADDRESS (BOOT). + +;: EJ - OPEN FILE FOR READING AND MAP IT INTO CORE JUST UNDER LHIPAG. +;LHIPAG IS SET TO POINT AT THE BEGINNING OF THE FILE, AND A PURE +;STRING POINTER TO THE START OF THE FILE IS RETURNED. THIS COMMAND +;DOES NOT USE THE FILE FORMAT USED BY PLAIN EJ AND ^ EJ; IN FACT, +;THE FILE IS JUST A CORE IMAGE. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR + TLNN FF,FLOUT ;^ EJ. + TYPRE [NDO] + MOVE A,[-3,,[SIXBIT /TECO/+1 + .FVERS + JRST 1]] + .IOT CHFILO,A ;SAY THIS IS A TECO DUMP FILE, AND WHAT + ;TECO VERSION DUMPED IT. + HRROI A,P + JSP T,EJWBLK + MOVE A,[20-HCDS,,20] + JSP T,EJWBLK ;DUMP LOW IMPURE. + MOVE A,[HCDSE-LIMPUR,,HCDSE] + JSP T,EJWBLK ;EXCEPT FOR THE SCREEN-LINE HASH CODES. + MOVE A,QRWRT + ADDI A,4 + IDIVI A,5 ;ADDR LAST WORD OF IMPURE STRING SPACE. + SUBI A,HIMPUR ;LENGTH OF HIGH IMPURE. + MOVNS A + HRLZS A + HRRI A,HIMPUR + JSP T,EJWBLK ;DUMP OUT HIGH IMPURE. + MOVE A,BFRBOT + IDIVI A,5 + MOVE C,BFRTOP + IDIVI C,5 + SUBM A,C ;- + HRL A,C ;AOBJN TO BUFFER SPACE. + JSP T,EJWBLK ;DUMP OUT BUFFER SPACE. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;OUTPUT THE STARTING ADDRESS + MOVE TT,[-4,,2] ;OUTPUT AN INDIRECT SYMBOL TABLE POINTER BLOCK, + MOVE A,[-4,,[SIXBIT /DSK/ ? SIXBIT /TECPUR/ ? .FNAM2 ? SIXBIT /.TECO./]] + JSP T,EJWBL1 ;WHICH NEEDS A CHECKSUM LIKE ALL OTHERS. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;AND THEN ANOTHER COPY, THUS MARKING OFF A NULL SYMBOL TABLE. + JRST EFCMD ;RENAME AND CLOSE FILE. + +;A HAS AOBJN POINTER TO RANGE OF DATA; WRITE AN SBLK DESCRIBING IT. +EJWBLK: MOVE TT,A +;HERE IF TT CONTAINS BLOCK HEADER, DISTINCT FROM THE POINTER TO THE DATA. +EJWBL1: HRROI C,TT ;FIRST WE NEED TO WRITE THE AOBJN ITSELF. + .IOT CHFILO,C + .IOT CHFILO,A ;THEN WRITE THE DATA IN THAT RANGE. + MOVE TT1,TT ;THEN COMPUTE THE CHECKSUM IN TT, INCLUDING THE AOBJN WORD + ROT TT,1 + ADD TT,(TT1) ;AND THEN THE DATA WORDS. + AOBJN TT1,.-2 + HRROI C,TT + .IOT CHFILO,C ;OUTPUT THE CHECKSUM. + JRST (T) + +;EJ AND :EJ COMMANDS (THE INPUT VERSIONS OF EJ). +EJCMDR: TRZ FF,FRARG ;DON'T PASS ANY ARG TO .OPNRD; USE BLOCK ASCII MODE ALWAYS. + CALL .OPNRD ;READ FILE SPEC & OPEN FILE + TRZN FF,FRCLN ;:EJ? + JRST EJCMD2 + SYSCAL FILLEN,[%CLIMM,,CHFILI ? %CLOUT,,A] + JRST OPNER1 + ADDI A,1777 ;HOW MANY PAGES LONG IS THE FILE? + LSH A,-10. + MOVNS C,A + ADD C,LHIPAG ;IF IT WILL END JUST BELOW LHIPAG, WHERE SHOULD IT START? + CAMG C,MEMT ;LEAVE AT LEAST ONE EMPTY PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;NO ROOM - CAN WE FLUSH SOME WASTAGE FROM BUFFER SPACE? + CAMG C,MEMT + TYPRE [URK] ;NO, THERE'S REALLY NO ROOM. + RET] + HRL C,A + SYSCAL CORBLK,[%CLIMM,,200000 ? %CLIMM,,%JSELF ? C ? %CLIMM,,CHFILI] + JRST OPNER1 + CALL UICLS ;ALL PAGES MAPPED; DON'T NEED THE FILE NOW. + ADDB A,LHIPAG ;ADJUST LHIPAG FOR PAGES WE HAVE GOBBLED. + IMULI A,5*2000 + TLO A,400000 ;RETURN A STRING POINTER TO BOTTOM OF FILE. + JRST POPJ1 + +EJCMD2: MOVE A,[-3,,C] ;ORDINARY "EJ". CHECK FIRST 3 WORDS OF FILE. + .IOT CHFILI,A .SEE IDIVI ;CONSECUTIVE AC'S USED HERE. + CAMN C,[SIXBIT/TECO/+1] + CAME D,[.FVERS] ;DUMPED BY DIFFERENT TECO VERSION, + TYPRE [AOR] ;OR NOT A TECO DUMP FILE. + CAME E,[JRST 1] + TYPRE [AOR] + .SUSET [.SMSK2,,[0]] ;INTERRUPT MIGHT DO TTYSET FROM NEWLY CLOBBERED VARS. + MOVE E,LHIPAG ;SINCE WE AREN'T OVERWRITING PURE STRING SPACE + ;MUSTN'T FORGET WHERE IT STARTS. + MOVE D,MSNAME ;ALSO DON'T CLOBBER MSNAME. + MOVE T,MEMT ;.IOT'S CAN MAKE MEMORY BUT CAN'T FLUSH ANY. + MOVE J,INITFL +EJCMD1: HRROI A,C + .IOT CHFILI,A ;READ NEXT BLOCK HEADER + JUMPGE C,EJCMD3 ;POSITIVE => END OF BLOCK DATA; RESTART TECO, RUNNING Q..L. + .IOT CHFILI,C ;LOAD DATA OF BLOCK, + HRROI A,C + .IOT CHFILI,A ;SKIP THE CHECKSUM. + JRST EJCMD1 ;READ NEXT BLOCK. + +EJCMD3: MOVEM E,LHIPAG + INSIRP MOVEM D,MSNAME DEFDIR + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL ;FS LISPT$ SHOULD NOT BE CHANGED BY AN EJ. + .I SAVCMX=CBMAX=1 + .CLOSE CHFILI, + JRST INIT + +RENAM: PUSHJ P,FFRRDD + PUSHJ P,FRD + CALL IMMQIT + SYSCAL RENAME,[UTFARG ? A ? B] + JRST OPNER1 + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + JRST DELQIT + +ALINK: PUSHJ P,FFRRDD ;GET LINK NAME + CAME A,[SIXBIT/>/] + CAMN B,[SIXBIT/>/] + JRST ALINK1 ;MAKING LINK FROM FOO > WON'T DELETE ANYTHING. + MOVEI A,CHRAND + CALL IMMQIT + .CALL RREDB ;ELSE SEE IF ANY FILE WITH THAT NAME. + JRST ALINK1 + MOVEI CH,%EEXFL ;GET ERROR CODE FOR "FILE ALREADY EXISTS", + JRST OPNER4 ;SIGNAL AN ERROR WITH MESSAGE READ FROM SYSTEM. + +ALINK1: SETZM IMQUIT + MOVE A,[DEFDEV,,GCTAB] + BLT A,GCTAB+3 ;SAVE THE LINK NAMES, + CALL FFRRDD ;READ NAMES LINKED TO. + CALL ALINK2 ;GET CORRECT SNAME TO LINK TO IN C. + MOVE T,[GCTAB,,DEFDEV] + BLT T,DEFDIR ;BRING BACK LINK NAMES, + CALL IMMQIT + SYSCAL MLINK,[UTFARG ? A ? B ? C] + JRST OPNER1 + JRST DELQIT + +ALINK2: MOVE C,DEFDIR + MOVS T,DEFDEV ;CONVERT COM: TO COMMON;, ETC. + CAIN T,'COM + MOVE C,['COMMON] + CAIN T,'SYS + MOVSI C,'SYS + CAIN T,'TPL + MOVE C,['.LPTR.] + RET + +UNREAP==2 + +;READ OR WRITE DON'T-REAP BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSREAP: HLRZS E + SYSCAL FILBLK,[E ? %CLOUT,,A ? %CLOUT,,A ? %CLOUT,,A] + JRST OPNER1 + LDB A,[.BP (UNREAP),A] + MOVE B,['SREAPB] + JRST FSREA1 + +;READ OR WRITE DUMPED BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSDUMP: HLRZS E + SYSCAL RDMPBT,[E ? %CLOUT,,A] + JRST OPNER1 + MOVE B,['SDMPBT] +FSREA1: TRZN FF,FRARG + JRST POPJ1 + SYSCAL CALL,[B ? E ? C] + JRST OPNER1 + JRST POPJ1 + +WWINIT: TRNN FF,FRCLN + CALL FFRDEV ;SET DEFAULT DEV AND SNAME + TRNE FF,FRCLN + CALL FFRRDD ;OR SET DEFAULT DEV, SNAME AND FILENAMES. +EICMD: +WINIT: MOVE A,DEFFN1 + MOVE B,DEFFN2 + TRZE FF,FRCLN ;:EW, :EI USE SPEC'D NAMES TO OPEN AS, + JRST WINIT1 + MOVE A,[SIXBIT/_TECO_/] ;WITHOUT COLON, OPEN AS _TECO_ OUTPUT. + MOVE B,['OUTPUT] +WINIT1: TLZ FF,FLOUT + CALL IMMQIT + MOVEI T,100000 ;^ EW OPENS IN WRITE-OVER MODE. + TRZN FF,FRUPRW +WINIT2: MOVEI T,0 ;OTHERWISE, USE NORMAL WRITE. + SYSCAL OPEN,[[3,,CHFILO] ? DEFDEV ? A ? B ? DEFDIR ? 4000,,T] + JRST WINIT3 + SETZM IMQUIT + JSP T,FHAK ;INIT. BUFFER POINTERS. + TLO FF,FLOUT + POPJ P, + +WINIT3: .STATUS CHFILO,D ;IF WRITE-OVER OPEN FAILS FOR "FILE NOT FOUND" + LDB D,[220600,,D] + CAIN D,%ENSFL + JUMPN T,WINIT2 + JRST OPNER1 + +FHAK: TLO FF,FLOUT + MOVE CH,[10700,,UTOBUF-1] + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT + JRST 1(T) + +;DO .MTAPE ON CHANNEL IN E, WITH ARGS IN C AND SARG. +FSMTAP: HRLZS E + HRRI E,C ;E GETS CHANNEL,,ADDRESS + HRL C,SARG ;LH(C) GETS COUNT (DEFAULT IS 1). + TRNN FF,FRARG2 + HRLI C,1 + .MTAPE E, + JFCL + MOVE A,C + JRST POPJ1 + +DELE: TRZE FF,FRCLN + JRST DELE1 ; :ED IS DELETE INPUT FILE. + PUSHJ P,FFRRDD + SYSCAL DELETE,[UTFARG] + JRST OPNER1 + POPJ P, + +DELE1: TLNN FF,FLIN + TYPRE [NFI] + SYSCAL DELEWO,[%CLIMM,,CHFILI] + .LOSE %LSFIL + POPJ P, + +LISTF: CALL FFRDEV ;EY COMMAND - READ DEV NAME. +CNTRU1: CALL VBDACU ;IF THERE'S A CMD STRING PENDING, + RET ;DON'T BOTHER OPENING THE DIR. + SETZ CH, + CALL DISINI + SKIPA OUT,[CHCT] +LISTFM: MOVEI OUT,TYOM ;EZ AND EM COMMANDS. + TRNE CH,20 + CALL FFRDEV + TLZ FF,FLDIRDPY + HRRM OUT,LISTF5 + CALL AOFDIR +LISTF2: HRRZ OUT,LISTF5 + CALL GFDBLK + CAIN OUT,TYOM ;IF DUMPING CRUD INTO BUFFER, + JRST LSTF3 ;THEN DO IT FAST +LISTF6: ILDB CH,FDRP + CAIE CH,EOFCHR + CAIN CH,14 + JRST LISTF% + CALL @LISTF5 + JRST LISTF6 + +LSTF3: ANDI CH,-1 + CAIE CH,FDRBUF ;DONT ALLOW TO BACK UP BEFORE BEGINNING + SUBI CH,1 ;BACK UP TO LAST WORD .IOT'ED INTO + CAIE CH,FDRBUF ;IF NOT POINTING TO BEGINNING OF BUFFER, + SUBI CH,1 ;THEN BACK UP A WORD FOR "FORM FEED AT END OF LAST WORD" SCREW + MOVEI E,-FDRBUF(CH) ;GET INDEX INTO BUFFER IN E + IMULI E,5 ;CONVERT E TO NUMBER OF CHARACTERS UP TO THIS WORD + HRLI CH,440700 ;CONVERT TO BYTE POINTER TO WORD +LSTF4: ILDB A,CH ;GET CHARACTER FROM LAST WORD (DOES THIS LOOK BACKWARDS TO YOU?) + CAIE A,14 ;IF FORM FEED, + CAIN A,EOFCHR ;OR IF EOF CHARACTER, + JRST .+2 ;THEN FOUND END + AOJA E,LSTF4 ;HAVEN'T FOUND END YET, LOOP BACK + JUMPE E,CPOPJ ;IF NO CHARACTERS THEN THAT'S ALL FOR THIS ROUTINE + MOVEI C,(E) + CALL SLPGET ;INSERT THAT MANY CHARS, GET IDPB BP IN BP. + ILDB CH,FDRP ;NOW GET CHARACTER TO COPY + IDPB CH,BP ;COPY IT + SOJG E,.-2 ;DO IT THE APPROPRIATE NUMBER OF TIMES + IBP FDRP ;INCREMENT FDRP TO MAKE IT APPEAR THAT THE ACTUAL EOF CHARACTER WAS ENCOUNTERED + + ;PROCESS THE NEXT BLOCK OF THE FILE DIRECTORY BEING LISTED + +LISTF%: SKIPN MORFLF + JRST LSTF%2 + HRRZ A,LISTF5 ;USER HAS "FLUSHED", SEE IF TYPING OUT + CAIN A,CHCT + JRST LSTF%3 ;TYPING OUT, STOP NOW +LSTF%2: HRRZ CH,FDRP + CAIN CH,FDRBFE + JRST LISTF2 ;MORE TO COME +LSTF%3: .CLOSE CHRAND, + HRRZ A,LISTF5 + CAIN A,CHCT + JRST DISCLG + POPJ P, + +IFN 0,%%TNX%: +] ;END IFN ITS CONDTIONAL + +SUBTTL TWENEX FILE COMMANDS + +IFN TNX,[.SEE %%TNX. ;END OF THIS CONDITIONAL + +ASLEEP: TRZN FF,FRARG + SETZ C, + LSH C,5 ;CONVERT 30THS OF A SECONDS TO MS (MORE OR LESS) + TRZE FF,FRCLN ;:^S? + JRST ASLEE1 ;YES + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND + MOVE A,C + DISMS + JRST DELQIT + +ASLEE1: JUMPE C,FSLISN ;0:^S IS JUST LIKE FSLISTEN$, SO SAVE TIME THAT ATI, DTI WOULD TAKE. + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND +ASLEE5: MOVEI A,.PRIIN ;ALSO IF WE ALREADY KNOW THE ANSWER + SIBE + JRST ASLEE4 ;DONT EVEN GO TO SLEEP + SKIPGE UNRCHC + SKIPE TYISRC + JRST ASLEE4 +IFN 10X,[ + CAIGE C,50. ;TENEX DOESNT HAVE TYPEIN INTERRUPT, SO TAKE 50. MS NAPS + SKIPA A,C ;LESS THAN INCREMENT, SLEEP FOR REMAINDER + MOVEI A,50. ;ELSE JUST FOR 50. + DISMS + SUBI C,50. + JUMPG C,ASLEE5 ;STILL TIME TO GO + SETZ B, ;TIME RAN OUT, RETURN 0 +] +IFN 20X,[ + MOVE A,[.TICTI,,1] + ATI ;ASSIGN ANY TYPEIN TO CHANNEL 1 + MOVE A,C + DISMS ;SLEEP OR GET AWAKENED + SETZ B, ;RETURN 0 + JRST ASLEE3 + +ASLEE2: CIS ;FLUSH INTERRUPTS + MOVEI A,.PRIIN + SIBE ;RETURN FS LISTEN + CAIA + SETZ B, ;NOTHING WAITING +ASLEE3: MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] +ASLEE4: SETZM IMQUIT + MOVE A,B + JRST CPOPJ1 + +EQMRK: MOVSI A,(GJ%OLD) + CALL FRD ;E? RETURN 0 IF FILE EXISTS + JRST CPOPJ1 ;IT DOESNT, JUST RETURN ERROR CODE THEN + RLJFN ;GET RID OF THE JFN + JFCL + SETZ A, ;RETURN 0 FOR SUCCESS + JRST CPOPJ1 + +;SOMEONE SHOULD DEFINE THESE IN TWXBTS +.TIMAL==5 +.TIMEL==1 + +IFN 10X,[ ;STUPID TENICES CANT STANDARDIZE THIS +IF1 [ +PRINTX \IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): \ +.TTYMAC FOO +.IIT==FOO +TERMIN +IFE .IIT-1,IIT=JSYS 247 ;NOT EVEN THE SAME JSYS NUMBER +IFE .IIT-2,IIT=JSYS 630 +]] +.ELSE .IIT==0 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS OF SECONDS +FSCLKI: LSH C,4 ;CONVERT TO MS (MORE OR LESS) + MOVEM C,CLKINT ;SAVE LENGTH OF INTERVAL +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMAL] ;DELETE ALL TIMERS FOR THIS FORK + TIMER +] +IFE .IIT-1,[ + MOVE A,[100000,,.FHSLF] ;DELETE ALL BEFORE THIS TIME + HRLOI B,377777 ;INFINITY + IIT +] + JFCL ;IGNORE ERRORS +FSCLK2: SKIPN B,CLKINT ;GET LENGTH OF REAL-TIME INTERVAL + RET ;NO MORE TO DO IF 0 +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMEL] ;SET ELAPSED TIME + MOVEI C,3 ;ON CHANNEL 3 + TIMER +] +IFE .IIT-1,[ + MOVE A,[400000,,.FHSLF] + IIT +] +IFE .IIT-2,[ + MOVE C,B ;NUMBER OF MS UNTIL TIME + MOVEI A,.FHSLF + MOVSI B,10 ;ON CHAN 14. + IIT +] + JFCL ;IGNORE ERROR HERE AS WELL + RET + +TSINTC: SETOM CLKFLG ;REAL-TIME INTERRUPT, SAY IT IS TIME TO RUN HANDLER +INSIRP PUSH P,A B C + HRRZ A,INTPC2 ;GET WHERE INTERRUPT CAME FROM + CAIN A,TYIIOT ;WAITING FOR INPUT? + CALL [ SUBI A,1 ;YES, RUN THE HANDLER NOW, BUT IN CASE AN ERRSET GOES OFF + MOVEM A,INTPC2 ;DURING THE MACRO EXECUTION, ENSURE WE RESTART THE PBIN + JRST RLTCLK] ;AND DONT EVER FALL THROUGH WITH GARBAGE USER DIDNT TYPE + CALL FSCLK2 ;SETUP NEW TIMER FOR NEXT TIME +INSIRP POP P,C B A + DEBRK + ERJMP [JRST @INTPC2] ;NEEDLESS TO SAY THE INDIRECTION WONT WORK IN THE ERJMP ITSELF + +EGET: SAVE LISTF5 ;EG - INSERT STUFF INTO BUFFER + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY + HRROI A,BAKTAB + SETO B, ;CURRENT TIME + MOVSI C,(OT%NMN\OT%DAM) + ODTIM + MOVE A,[350700,,BAKTAB+1] + MOVEI C,1 + CALL EGETYP + MOVE A,[440700,,BAKTAB] + MOVEI C,2 + CALL EGETYP + CALL CRR1 + MOVE A,[100700,,BAKTAB+1] + MOVEI C,3 + CALL EGETYP + CALL CRR1 + GJINF ;CONNECTED DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT CURRENT FILENAME DEFAULTS + CALL CRR1 + TLNN FF,FLIN ;HAVE AN OPEN INPUT FILE? + JRST EGET2 + MOVEI E,ERDEV ;YES, INSERT IT'S REAL NAME + CALL FSDFR1 +EGET2: CALL CRR1 + HRROI A,BAKTAB ;CURRENT DATE IN ENGLISH FORMAT + SETO B, + MOVSI C,(OT%DAY\OT%FDY\OT%4YR\OT%DAM\OT%SPA\OT%NTM\OT%SCL) + ODTIM ;"MONDAY, NOV 28 1977" + MOVE A,[440700,,BAKTAB] + MOVEI C,3 ;REPLACE THIRD SPACE WITH COMMA + ILDB B,A + CAIE B,40 + JRST .-2 + SOJG C,.-3 + MOVEI B,", + DPB B,A + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + CALL CRR1 + CALL POM ;THE PHASE OF THE MOON (CLOSE) + CALL CRR1 + REST LISTF5 ;RESTORE THINGS + RET + +EGETYP: ILDB CH,A ;INSERT 2 CHARS AND THEN FLUSH THE NEXT ONE C TIMES + CAIN CH,40 + MOVEI CH,"0 + XCT LISTF5 + ILDB CH,A + XCT LISTF5 + SOJLE C,CPOPJ + IBP A + JRST EGETYP + +;TYPE OUT PHASE OF THE MOON +POM: GTAD + SUB A,SYNOFS ;OFFSET TO NEAREST NEW MOON TO DAY 0 + IDIV A,SYNP ;DIVIDE INTO QUARTER PERIODS + ANDI A,3 ;GET PERIOD + MOVEI A,PHSNMS(A) + CALL ASCIND ;TYPE ITS NAME + MULI B,24.*60.*60. ;CONVERT TO SECONDS + LSH C,1 ;FLUSH DUPLICATE SIGN BIT + LSHC B,17. ;GET ONE WORD PRODUCT + MOVEI E,TDHMST +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + CALL [AOJA E,TDHMS1] ;INCREMENT AND RECURSE + HLRZ C,(P) +TDHMS2: CALL DPT ;TYPE IN IN DECIMAL + HLLZ A,(E) + SOJA E,SIXIN1 ;BACK UP, TYPE AND RETURN +; USE SOME OTHER OUTPUT ROUTINE, SUCH AS SIXNTY OR ASCIND. + +PHSNMS: ASCII /NM+/ + ASCII /FQ+/ + ASCII /FM+/ + ASCII /LQ+/ + +TDHMST: SIXBIT /S./+60. + SIXBIT /M./+60. + SIXBIT /H./+24. + SIXBIT /D./+<,-1> + +SYNP: <29.53059&<777,,-1>>_-6 ;LENGTH OF QUARTER IN GTAD UNITS +SYNOFS: 22,,253553 ;18 DAYS AND A BIT + +FRDOLD: MOVSI A,(GJ%OLD) ;INSIST ON OLD FILE + CALL FRD + JRST OPNER1 ;DOESNT EXIST, ERROR +IFN 10X,[ ;THIS IS EXTREMELY DISTASTEFUL + SKIPN DEFFN2 ;IS THERE SUPPOSED TO BE AN EXTENSION? + RET ;NO, OK THEN + MOVE B,A ;YES, WE MUST CHECK FOR A GROSS MISFEATURE IN THE TENEX FILESYSTEM, + HRROI A,BAKTAB ;WHEREBY IF FILE WITH DEFAULT FN2 DOES NOT EXIST BUT A FILE WITH A NULL + MOVSI C,000200 ;FN2 DOES, IT WILL STILL BE FOUND + JFNS ;SEE WHAT THE EXTENSION OF THE FILE WE GOT IS + MOVE A,B + LDB B,[350700,,BAKTAB] + JUMPN B,CPOPJ ;NON-NULL, OK + RLJFN ;FOO! WE HAVE BEEN SCREWED, GET RID OF LOSING JFN + JFCL + MOVEI 2,GJFX19 + JRST OPNER4 ;AND FAKE NO SUCH EXTENSION ERROR +] +.ELSE RET + +FRD0: TDZA A,A +FRDFOU: MOVSI A,(GJ%FOU) +; GET A JFN FROM A FOLLOWING STRING, USING THE CURRENT DEFAULTS +; TAKES GTJFN FLAGS IN 1 RETURNS +1 A/ ERROR CODE OR +2 A/ JFN +FRD: CALL FFRRDD ;CONVERT STRING TO FILESPEC FORMAT +FF5: SETZ B, +FF5A: MOVE C,[.NULIO,,.NULIO] + SETO D, ;USE ALL DEFAULT FIELDS +FF4: MOVEM C,BAKTAB+.GJSRC + TRNN D,1 ;DEFAULT GENERATION NUMBER? + TRZA A,-1 ;NO, USE 0 THEN + HRR A,DEFFN3 ;GET DEFAULT GENERATION NUMBER + MOVEM A,BAKTAB+.GJGEN +.GJFN1==.GJNAM +.GJFN2==.GJEXT +IRPS STR,,[FN2 FN1 DIR DEV] + ROT D,-1 + TRNE D,1 ;DEFAULT THIS FIELD? + SKIPN DEF!STR ;AND HAVE A DEFAULT? + TDZA A,A ;NO OR NO + HRROI A,DEF!STR ;YES, GET IT + MOVEM A,BAKTAB+.GJ!STR +TERMIN +IFN EMCSDV\INFODV,[ ;TRANSLATE FOR SYSTEMS WITHOUT REAL + JUMPGE D,FF4B ;SKIP THIS IF NOT DEFAULTING DIRECTORY + MOVE A,DEFDIR +IFN INFODV,[ + CAMN A,[ASCIZ /INFO/] ;WANT ? + JRST FF4A ;YES +] +IFN EMCSDV,[ + CAMN A,[ASCIZ /EMACS/] ;WANT ? + SKIPE DEFDIR+1 +] + JRST FF4B +FF4A: HRROI A,DEFDIR + MOVEM A,BAKTAB+.GJDEV ;MAKE IT EMACS: OR INFO: + SETZM BAKTAB+.GJDIR ;AND FORGET DIRECTORY +FF4B: +] + SETZM BAKTAB+.GJPRO + SETZM BAKTAB+.GJACT + MOVEI A,BAKTAB + GTJFN + RET ;SINGLE RETURN + JRST CPOPJ1 ;SKIP RETURN WITH THE JFN + +;READ A FILESPEC, SETTING DEFAULTS FROM IT +FFRDEV: +FFRRDD: SAVE A + CALL MEMTOP ;GET A POINTER TO START OF FREE BUFFER SPACE + HRLI A,440700 ;MAKE IT A BYTE POINTER + SAVE A ;SAVE IT FOR LATER + SETZ B, ;RESET FLAGS +FFST0: SETZB TT,(A) ;ZERO LAST CHARACTER INSERTED + MOVSI C,(A) + HRRI C,1(A) + BLT C,17(A) ;AND AREA WE WILL BE INSERTING INTO +FFST1: CALL RCH ;GET A CHARACTER + SKIPGE SQUOTP ;SUPERQUOTED? + JRST FFSTQ2 ;YES, INSERT IT QUOTED THEN + TRNE CH,100 ;UPPERCASE UNQUOTED LETTERS + ANDCMI CH,40 + SKIPN SQUOTP ;NOT A TERMINATOR? + CAIE CH,33 ;ELSE ALTMODE TERMINATES + CAIA + JRST FFST4 + TLNE B,040000 ;PARSING DIRECTORY NAME? + JRST FFSTDR ;YES, INSERT IT THEN + CAIE CH,^A + CAIN CH,^X ;WANTS FIRST NAME DEFAULT? + JRST FFSCTX + CAIE CH,^B + CAIN CH,^Y ;WANTS SECOND NAME DEFAULT? + JRST FFSCTY + CAIE CH,^V ;^V OR ... + CAIN CH,^Q ;^Q QUOTES ANOTHER CHARACTER + JRST FFSTQT + CAIN CH,40 ;TRANSLATE SPACE TO DOT + JRST FFSTSP + CAIN CH,": ;END OF DEVICE NAME + JRST FFSTCL + CAIN CH,"< ;MAYBE PART OF DIRECTORY + JRST FFSTLT + CAIN CH,"> ;DITTO + JRST FFSTGT + CAIN CH,". ;NOTICE WHEN WE GET THE DOT + JRST FFSTDT + CAIN CH,"; ;MAYBE PART OF DIRECTORY FOR ITS + JRST FFSTSM +IFN 20X,[CAIE CH,"[ ;THESE NEED TO BE QUOTED + CAIN CH,"] +] +IFN 10X,CAIN CH,"_ ;THIS NEEDS TO BE QUOTED ON TENEX + JRST FFSTQ2 + CAIE CH,"( + CAIN CH,") + JRST FFSTQ2 + CAIE CH,"@ + CAIN CH,"^ + JRST FFSTQ2 +FFST2: MOVEI TT,(CH) ;SAVE LAST CHAR INSERTED +FFST3: IDPB CH,A ;STICK IT IN + JRST FFST1 ;AND GET ANOTHER CHAR + +FFSTQT: CALL RCH ;^Q QUOTES NEXT CHAR +FFSTQ2: MOVEI C,^V + CAIE TT,^V ;UNLESS ^V WAS LAST TO GO IN + IDPB C,A ;INSERT ONE + HRROI TT,(CH) ;SAY CHAR WAS QUOTED + JRST FFST3 ;AND INSERT IT + +FFSTDR: CAIE CH,"> ;WAITING FOR DIRECTORY + JRST FFST2 + TLZ B,040000 +FFSTB4: SKIPA A,[DEFDIR] +FFSTB0: MOVEI A,DEFFN1 +FFSTB1: HRL A,(P) ;GET START OF WHERE IT IS +FFSTB2: MOVEI C,17(A) ;GET END + BLT A,(C) ;MOVE THE DEFAULT IN +FFSTB3: MOVE A,(P) ;GET FRESH STRING POINTER + JRST FFST0 ;AND CONTINUE + +FFSCTX: SKIPA A,[DEFFN1,,0] ;INSERT DEFAULT FN1 +FFSCTY: MOVSI A,DEFFN2 ;INSERT FN2 + TLO B,400000 ;THESE ARE ITS CONSTRUCTS + JUMPE TT,FFSCT2 ;UNLESS NOTHING SEEN YET, + MOVEI C,DEFFN1 ;SET UP WHAT WE HAVE AS FN1 + HRL C,(P) + MOVEI CH,17(C) + BLT C,(CH) +FFSCT2: HRRI A,DEFFN1 ;ASSUME SETTING FN1 + TLOE B,200000 ;UNLESS DOT SEEN ALREADY + HRRI A,DEFFN2 ;IN WHICH CASE, FN2 + JRST FFSTB2 ;GO SET THEM AND CONTINUE + +FFSTSP: JUMPE TT,FFST1 ;SPACE - IF NOTHING YET, FLUSH IT IN ALL CASES + TLO B,400000 ;ELSE IT IS ITS STYLE + TLOE B,200000 ;IF ALREADY HAVE A DOT, + JRST FFST1 ;JUST FLUSH IT + JRST FFSTB0 ;ELSE GO SET FN1 FROM WHAT WE HAVE + +FFSTCL: HRRZ A,(P) ;: - GET FIRST WORD FOR DEVICE + MOVE C,(A) + MOVEM C,DEFDEV + MOVE C,1(A) + MOVEM C,DEFDEV+1 + JRST FFSTB3 ;AND GO GET MORE + +FFSTLT: JUMPGE B,FFSTL2 ;< - IF NOT ITS, MUST BE DIRECTORY + SKIPA C,[.GJLEG] ;ELSE WANT OLDEST VERSION +FFSTGT: MOVEI C,.GJDEF ;> - WANT NEWEST VERSION + MOVEM C,DEFFN3 ;SET UP DEFAULT GEN NUMBER + SETZM DEFFN2 ;AND DEFAULT FN2 TO NULL + TLOA B,320000 ;BOTH NAMES SEEN +FFSTL2: TLO B,040000 ;LOOK FOR DIRECTORY NAME + JRST FFST1 + +FFSTDT: JUMPL B,FFSTQ2 ;QUOTE IT IF ITS STYLE + TLOE B,200000 ;ALREADY HAVE A DOT? + JRST FFSTD2 ;YES, MUST BE END OF FN2 OR GENERATION NUMBER + JUMPN TT,FFSTB0 ;NON NULL STRING, MUST TERMINATE FN1 + TLO B,400000 ;ELSE ITS STYLE, + JRST FFSTQ2 ;SO INSERT IT QUOTED +FFSTD2: TLOE B,100000 ;ALREADY HAVE BOTH DOTS? + JRST FFSTD3 ;YES, MUST BE END OF GENERATION NUMBER THEN + MOVEI A,DEFFN2 ;ELSE, SET DEFAULT FN2 + JRST FFSTB1 ;AND RETURN +FFSTD3: TLOE B,020000 ;EVERYTHING SEEN + JRST FFST1 ;ALREADY ALL SEEN, FLUSH IT THEN + CALL FFSGEN ;GET GENERATION NUMBER FROM STRING + JRST FFSTB3 ;AND RETURN + +FFSTSM: TLNE B,200000 ;IF DOT SEEN ALREADY, + JRST FFSTD2 ;TREAT IT AS A DOT NOW + TLO B,400000 ;ELSE, ITS'S ITS STYLE + JRST FFSTB4 ;AND THE DIRECTORY + +FFST4: POP P,A ;GET BACK STRING POINTER + TLNE B,020000 ;IF EVERYTHING SEEN ALREADY, + JRST CPOP1J ;DONE + TLNE B,300000 ;IF EITHER FN1 OR FN2 SEEN, + SETZM DEFFN3 ;RESET THE GENERATION NUMBER + JUMPE TT,CPOP1J ;IF NOTHING YET, DONE + TLNE B,040000 ;IF WAITING FOR DIR, + JRST FFST4D ;FINISH IT UP + TLNE B,100000 ;IF PARSING GENERATION NUMBER + JRST FFST4G ;GO DO THAT + TLNE B,200000 ;IF PARSING FN2, + JRST FFST4B + SKIPLE C,FNAMSY ;FS FNAM SYNTAX$ > 0 => DEFAULT FN1 + JRST FFST4A ;GO SET FN1 + JUMPE C,FFST4B ;0 => GO SET FN2 + SETZM DEFFN2 ;DEFAULT TO FOO..0 +FFST4A: SKIPA C,[DEFFN1] ;SETTING DEFFN1 +FFST4B: MOVEI C,DEFFN2 ;SETTING DEFFN2 +FFST4C: HRLI C,(A) ;SOURCE + MOVEI A,17(C) + BLT C,(A) ;SET IT UP + JRST CPOP1J ;AND RETURN +FFST4D: MOVEI C,DEFDIR ;SETTING DIRECTORY + JRST FFST4C +FFST4G: CALL FFSGN0 ;SET GENERATION NUMBER + JRST CPOP1J ;AND RETURN + +FFSGEN: MOVE A,-1(P) ;GET STARTING POINTER +FFSGN0: SETZB TT,C ;INIT NUMBER + ILDB CH,A ;PEEK FIRST CHAR + CAIE CH,"- ;NEGATIVE? + JRST FFSGN2 ;NO + SETO C, ;SAY NEGATIVE NUMBER +FFSGN1: ILDB CH,A ;GET CHARACTER +FFSGN2: CAIL CH,"0 + CAILE CH,"9 + JRST FFSGN3 + IMULI TT,10. + ADDI TT,-"0(CH) + JRST FFSGN1 +FFSGN3: SKIPGE C ;NEGATIVE? + MOVNS TT ;YES + MOVEM TT,DEFFN3 ;SET UP DEFAULT GEN NUMBER + RET + +;SET UP DEFAULTS FROM STRING FOLLOWING +ETCMD: TRZN FF,FRCLN ;:ET? + JRST FFRRDD ;NO + +FFRRTT: CALL ECOPOS ;POSITION TO CURRENT PLACE IN ECHO AREA + CALL DPYRST ;RESET DISPLAY MODE + MOVEI A,.PRIOU + RFMOD + MOVEM B,SAVMOD ;SAVE TTY MODE (ALSO FOR ^G TO USE) + TRO B,1_6\TT%ECO ;MAKE SURE ECHO ON AND DATA MODE OK + SFMOD + SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN + TRZN FF,FRARG ;:ET - GET FROM TTY IN ECHO AREA + TLZA A,-1 + HRLZ A,C ;ANY ARGUMENT IS THE GTJFN FLAGS + TLO A,(GJ%FLG) ;RETURN FLAGS AS WELL + SETZ B, ;NO STRING + MOVE C,[.PRIIN,,.PRIOU] ;FROM TTY: + MOVE D,ETMODE ;WITH FS :ET MODE MASK OF DEFAULTS TO USE + CALL FF4 + JRST [CALL FFRRT1 ;RESTORE TTY MODE FIRST + JRST OPNER1] ;THEN REPORT ERROR + PUSH P,A ;SAVE JFN + CALL FFSET ;SET UP DEFAULTS FROM IT + ANDI A,-1 + RLJFN ;FLUSH REAL JFN + JFCL + POP P,A ;GET BACK JFN FLAGS + TLNE A,(GJ%UHV\GJ%NHV) ;IF THE VERSION CAME FROM GTJFN NOT THE USER, + SETZM DEFFN3 ;SETUP VERSION NUMBER DEFAULT RIGHT + TLNN A,(GJ%VER) ;IF VERSION NUMBER HAD WILDCARDS + JRST FFRRT1 + HRROI B,-3 + MOVEM B,DEFFN3 ;SET IT TO DEFAULT RIGHT +FFRRT1: SETZM IMQUIT ;NO MORE ^G AFTER THIS + MOVE B,SAVMOD ;RESTORE TTY MODE AFTER GTJFN +FFRRT2: MOVEI A,.PRIOU + SFMOD + SETZM SAVMOD ;AND NO MODE TO RESTORE + MOVEI A,21 .SEE VT100 + CAME A,RGETTY + RET + HRROI A,[ASCIZ "<[?2l"] ;BACK INTO VT52 MODE FOR VT100 + PSOUT + RET + +;SET UP FILENAME DEFAULTS FROM A JFN IN 1 +ROUNMS: MOVEI E,ROUDEV ;GIVE FILENAMES FOR LAST REAL OUTPUT FILE + JRST FFSET1 + +RREDGN: SKIPA E,[ERDEV] ;FOR LAST READ FILE +FFSET: MOVEI E,DEFDEV ;FOR CURRENT DEFAULTS +FFSET1: SETZM (E) + MOVSI C,(E) + HRRI C,1(E) + BLT C,ERDEV-1-DEFDEV(E) ;ZERO OUT BLOCK FIRST + SAVE A ;SAVE JFN TO SET THEM FROM + ANDI A,-1 + MOVE B,[1,,.FBGEN] + MOVEI C,C + GTFDB + ERJMP FFSET2 ;FAILED, LEAVE AT 0 + HLRZM C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER +FFSET2: MOVE B,(P) +JS%FN1==JS%NAM +JS%FN2==JS%TYP +IRPS STR,,[DEV DIR FN1 FN2] + HRROI A,DEF!STR-DEFDEV(E) + MOVSI C,(JS%!STR)&101100 + JFNS +TERMIN + JRST CPOP1J +FFSET3: MOVEI E,DEFDEV ;SETUP DEFAULTS + SAVE A + JRST FFSET2 + +FSIFIL: SKIPA E,[ERDEV] ;DESCRIBE INPUT FILE +FSOFIL: MOVEI E,ROUDEV ;DESCRIBE LAST OUTPUT FILE + AOSA (P) +FSDFRD: MOVEI E,DEFDEV ;DESCRIBE DEFAULTS + SAVE C + MOVEI C,140. ;BE SURE LONG ENOUGH + CALL QOPEN + CALL FSDFR1 +FSDFRT: CALL QCLOSV ;CLOSE UP Q REG SPACE AND GIVE STRING + JRST POPCJ + +;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E +FSDFR1: MOVEI A,DEFDEV-DEFDEV(E) + CALL ASCIND ;DEVICE + MOVEI CH,": + CALL @LISTF5 + MOVEI CH,"< + CALL @LISTF5 + MOVEI A,DEFDIR-DEFDEV(E) ;DIRECTORY + CALL ASCIND + MOVEI CH,"> + CALL @LISTF5 + MOVEI A,DEFFN1-DEFDEV(E) ;NAME + CALL ASCIND + MOVEI CH,". + CALL @LISTF5 + MOVEI A,DEFFN2-DEFDEV(E) ;EXTENSION + CALL ASCIND +IFN 10X,MOVEI CH,"; +.ELSE MOVEI CH,". + CALL @LISTF5 + HRRE C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER + JRST DPT + +;FILE COPY +FCOPY: CALL FRDOLD ;GET FIRST FILENAME + MOVE B,[7_30.+OF%RD] ;OPEN FOR 7 BIT READ + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SAVE A +FCOPY3: CALL FRD0 ;GET SECOND ONE + JRST OPNER1 + MOVE B,[7_30.+OF%WR] + MOVEM A,OPNJFN + OPENF + JRST [ POP P,A + RLJFN + JFCL + JRST OPNER0 + ] + TRNN FF,FRCLN ;: E_ XFER INPUT FILE DATES TOO + JRST FCOPY2 + EXCH A,(P) ;INPUT FILE +IFN 20X,[ + MOVEI B,T + MOVEI C,1 + RFTAD + EXCH A,(P) + SFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,C + GTFDB + EXCH A,(P) + HRLI A,.FBWRT + SETO B, + CHFDB + ANDI A,-1 +] +FCOPY2: EXCH A,(P) ;GET INPUT FILE + MOVE B,[440700,,GCTAB] + MOVNI C,GCTBL*5 + SIN + ADDI C,GCTBL*5 ;GET NUMBER OF WORDS REALLY TRANSFERED + JUMPE C,FCOPY4 ;NONE, EOF + MOVN C,C + MOVE B,[440700,,GCTAB] + EXCH A,(P) ;OUTPUT FILE + SOUT + JRST FCOPY2 +FCOPY4: CLOSF ;CLOSE INPUT FILE + JFCL + REST A ;FILE JUST WRITTEN + CLOSF + JFCL + JRST DELQIT + +;OPEN INPUT FILE AND BIGPRINT NAME ON OUTPUT DEVICE +BPNTRD: CALL .OPNRD + TRZ FF,FRARG + JRST .FNPNT + +;OPEN FILE FOR READ +.OPNRD: CALL FRDOLD + TLZN FF,FLIN ;JUST IN CASE + JRST RRED2 + EXCH A,CHFILI + CLOSF + JFCL + SKIPA A,CHFILI +RRED2: MOVEM A,CHFILI +IFN 20X,MOVE B,[36._30.+OF%RD] +IFN 10X,MOVE B,[36._30.+OF%RD+OF%EX] ;THIS IS THE BIGGEST CROCK + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + SETZM PAGENU + SETOM LASTPA + CALL RREDGN ;SET UP REAL FILENAMES OF INPUT FILE + +;HERE TO ACTUALLY START READING FROM IT +RRED1: TLO FF,FLIN + MOVEI CH,EOFCHR + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOJ CH, + HRRM CH,UTRLDT + RET + +; I/O PDL COMMANDS +;E[ - PUSH INPUT JFN AND STATE +PSHIC: TLZ FF,FLDIRDPY + TLNN FF,FLIN ;ANYTHING OPEN NOW? + JRST PSHIC2 + MOVE A,CHFILI ;GET CURRENT POSITION + RFPTR + TYPRE [NRA] + MOVE C,UTYIP ;GET CURRENT POINTER + IBP C ;FIGURE HOW MANY WORDS WE HAVENT USED + MOVEI T,(C) + SUB T,UTRLDT + HRREI T,(T) + JUMPE T,PSHIC2 + ADD B,T ;RESET BYTE POSITION BEFORE THEM + SFPTR + TYPRE [NRA] +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA + LSH E,1 + SUB E,LASTPA + LSH E,2 + TLNE FF,FLIN ;AND STATE OF FLIN + ADDI E,2 + HRRI C,1(E) + MOVE A,INIOP ;GET INPUT PDL POINTER + PUSH A,CHFILI ;PUSH JFN + PUSH A,C ;PUSH STATE THEREOF + MOVEM A,INIOP ;UPDATE PDL POINTER + TLZ FF,FLIN + JRST UTLSTP ;SET TO SEE EOF + +;E] - POP INPUT JFN +POPIC: TLZ FF,FLDIRDPY + CALL UICLS ;CLOSE ANYTHING WE HAVE NOW + MOVE C,INIOP ;GET INPUT PDL POINTER + POP C,CH ;GET STATE FLAGS + LDB A,[020100,,CH] + MOVNM A,LASTPA ;STATE OF LASTPA + LDB A,[031700,,CH] + MOVEM A,PAGENU ;STATE OF PAGENU + POP C,A ;GET JFN + MOVEM C,INIOP ;UPDATE PDL POINTER + GTSTS + TLNE B,(GS%OPN) ;IS IT OPEN? + TRNN CH,2 ;AND WE THOUGHT ONE WAS TOO? + RET ;NO OR NO, FORGET IT + TLO FF,FLIN ;YES, SAY ONE IS NOW + MOVEM A,CHFILI ;STORE AWAY JFN + CALL UTRLD2 ;GET A BUFFER FULL + HRRI CH,UTIBUF + DBP7 CH + MOVEM CH,UTYIP ;UPDATE BUFFER POINTER + JRST RREDGN ;AND SET REAL FILENAMES + +;E\ - PUSH OUTPUT JFN +PSHOC: TLZ FF,FLDIRDPY + CALL FLSOUT ;FLUSH ANY CURRENT OUTPUT THRU + MOVE B,UTYOP ;GET POINTER TO OUTPUT BUFFER + IBP B + LDB A,[073500,,UTOBUF] + LSHC A,7 + MOVE C,OUTIOP ;GET OUTPUT PDL + PUSH C,CHFILO ;SAVE JFN + PUSH C,A ;SAVE STATE OF JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + TLZ FF,FLOUT ;SAY NO FILE TO WRITE ON NOW + RET + +;E^ - POP OUTPUT CHANNEL +POPOC: TLZ FF,FLDIRDPY\FLOUT ;PERHAPS NO FILE TO WRITE + MOVE C,OUTIOP ;GET OUTPUT PDL POINTER + POP C,CH ;GET STATE + POP C,A ;GET JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + GTSTS + TLNN B,(GS%OPN) ;FILE NOW OPEN? + RET ;NO, DONE THEN + MOVEM A,CHFILO ;YES, UPDATE BUFFER POINTERS + MOVEM CH,UTOBUF + MOVE C,[000700,,UTOBUF] + DPB CH,[350700,,C] + DBP7 C + MOVEM C,UTYOP + ANDI CH,177 + IDIVI CH,7_1 + ADDI CH,*5-4 + MOVNM CH,UTYOCT ;AND COUNT OF REMAINING BYTES + TLO FF,FLOUT ;SAY WE HAVE AN OUTPUT FILE NOW + RET + +EXITE: HRLOI C,377777 ;EE - WRITE OUT FILE AND CLOSE IT + TRO FF,FRARG + MOVE E,BEGV ;ANYTHING IN THE BUFFER? + CAMN E,ZV + SKIPE LASTPA ;OR THE INPUT FILE? + CALL PUNCHA ;YES, WRITE IT OUT THEN + CALL UICLS ;CLOSE ANY INPUT FILE + JRST EFCMD ;AND GO CLOSE AND RENAME OUTPUT FILE + +EXITX: TLNN FF,FLOUT ;IF NO OUTPUT FILE + CALL FFRRDD ;STILL READ AND SET DEFAULTS + TLNE FF,FLOUT ;IF HAVE AN OUTPUT FILE, + CALL EXITE ;FINISH IT UP +IFN 20X,[ + MOVE A,[.PRAST,,.FHSLF] ;SET THIS FORK + MOVEI B,[1 ;MAGIC FOR THE EXEC + 400740,,2 + 0] + MOVEI C,3 ;LENGTH + PRARG ;SET PROCESS ARG BLOCK +] +IFN 10X,[ ;THIS IS THE ONLY WAY TO GET BACK CCL FOR 10X +RUN==47000,,35 ;1050 UUO + MOVE A,[1,,[SIXBIT /SYS/ + SIXBIT /CCL/ + 0 ? 0 ? 0 ? 0]] + RUN A, ;SWAP IN CCL AND DO LAST COMMAND AGAIN + JFCL +] + JRST .EXIT ;AND QUIT BACK TO EXEC + +EFCMD: CALL FFRRDD ;GET FILE DEFAULTS FOR REAL OUTPUT +EFCMD1: TLNN FF,FLOUT ;MUST HAVE AN OUTPUT FILE + TYPRE [NDO] + TDZA A,A ;RESET COUNT OF FILLER BYTES +EFCMDA: CALL UTYO + MOVE CH,UTYOP + HRR CH,FILEPA ;PAD TO EVEN WORD WITH FILEPAD + TLNE CH,760000 + AOJA A,EFCMDA + PUSH P,A ;SAVE COUNT OF FILLER BYTES + CALL FLSOUT ;FLUSH OUT LAST OF BUFFER + MOVE A,CHFILO + RFPTR ;GET WHERE WE ARE + SETZ B, + IMULI B,5 ;INTO CHARS + SUBM B,(P) ;LESS FILLERS + TLO A,(CO%NRJ) ;CLOSE, BUT SAVE JFN + CLOSF + JFCL + HRLI A,.FBSIZ ;SET FILE SIZE + SETO B, + POP P,C ;TO NOT INCLUDE FILLERS + CHFDB + ERJMP EFCMD5 ;MAYBE ONLY WRITE ACCESS, NO FDB + HRLI A,.FBBYV ;AND SET BYTE SIZE + MOVSI B,(FB%BSZ) + MOVSI C,000700 ;TO BE 7-BIT + CHFDB +EFCMD5: MOVSI C,DEFDEV-ERDEV ;SEE IF FILENAME DEFAULTS HAVE CHANGED +EFCMD4: MOVE B,DEFDEV(C) + CAME B,ROUDEV(C) + JRST EFCMD3 ;DIFFERENT, MUST DO RENAME + AOBJN C,EFCMD4 + ANDI A,-1 ;GET JUST JFN +EFCMD2: CALL ROUNMS ;SET UP REAL NAMES OF OUTPUT FILE + RLJFN ;THRU WITH THE JFN + JFCL + TLZ FF,FLOUT ;NO MORE OUTPUT FILE + SETZM CHFILO + RET +EFCMD3: MOVSI A,(GJ%FOU) + CALL FF5 ;GET JFN FOR NEW NAME + JRST OPNER1 + MOVEI B,(A) + MOVE A,CHFILO ;RENAME OUTPUT FILE TO IT + RNAMF + JRST OPNER1 + MOVEI A,(B) + JRST EFCMD2 + +;EJ - LOAD IMPURE PORTIONS FROM FILE +;:EJ LOAD LIBRARY FILE INTO PURE STRING SPACE. +;^ EJ - WRITE OUT IMPURE PORTIONS IN A BOOTABLE FORMAT +;DUMP FILES CAN BE IDENTIFIED BECAUSE THEY HAVE 'TEC,,VERSION-NUMBER +;IN THE .FBUSW WORD IN THE FDB. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR ;READ IN + TLZN FF,FLOUT ;^ EJ + TYPRE [NDO] ;MUST HAVE AN OUTPUT FILE ALREADY + MOVEM P,BOOTP ;SSAVE DOESNT SAVE AC'S + MOVE A,CHFILO + TLO A,(CO%NRJ) + CLOSF + JFCL ;CLOSE FAKE OUTPUT FILE + HRLI A,(DF%EXP) + DELF ;AND GET RID OF IT + JFCL + SETZM CHFILO ;DONT HAVE THIS SET IN THE DUMPED OUT FILE + CALL FRDFOU ;GET REAL OUTPUT FILE + JRST OPNER1 + CALL ROUNMS ;SET UP REAL OUTPUT NAMES + HRLI A,.FBUSW + SETO B, + MOVE C,[SIXBIT /TEC/+.FVERS] ;TO IDENTIFY A DUMP FILE + CHFDB + MOVE TT,[-<_-9>,,SS%CPY\SS%RD\SS%EXE+0] + MOVEM TT,BAKTAB ;LOW IMPURE + MOVE TT,QRWRT + ADDI TT,4 + IDIVI TT,5000 + SUBI TT,HIMPUR_-9 + MOVNI TT,1(TT) ;NEGATIVE OF NUMBER OF PAGES + HRLI TT,SS%CPY\SS%RD\SS%EXE+HIMPUR_-9 + MOVSM TT,BAKTAB+1 ;START OF HIGH IMPURE + MOVE B,BFRBOT + IDIVI B,5000 ;STARTING PAGE OF BUFFER SPACE + MOVE C,BFRTOP + IDIVI C,5000 + SUBM B,C ;-LENGTH + HRLI B,-1(C) ;- + TRO B,SS%CPY\SS%RD\SS%EXE + MOVEM B,BAKTAB+2 + HRLI A,.FHSLF + MOVEI B,BAKTAB + SETZB C,BAKTAB+3 + SETZM LIMPUR ;MAKE SURE THE EJ FILE LOADS TECPUR IF RUN + SSAVE ;SAVE THOSE IMPURE PAGES + SETOM LIMPUR + RET + +;INPUT VERSIONS +EJCMDR: CALL FRDOLD ;GET FILE + TRZN FF,FRCLN + JRST EJCMD2 ;EJ - MAP IN IMPURE AREAS + MOVE B,[36._30.+OF%RD] + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SIZEF + TYPRE [URK] ;SOME SORT OF ERROR HERE + ASH C,-1 ;CONVERT PAGES TO BLOCKS + MOVNI B,(C) + ADD B,LHIPAG ;WITHIN RANGE? + CAMG B,MEMT ;LEAVE AT LEAST ONE BLANK PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;BUT SEE IF THERE IS ANYTHING WASTED WE CAN FLUSH + CAMG B,MEMT ;BEFORE DECIDING IT'S FATAL. + TYPRE [URK] + RET] + MOVEM B,LHIPAG ;UPDATE BOTTOM PAGE + ASHC B,1 ;CONVERT BACK TO BLOCKS + HRLI B,.FHSLF + HRLZS A ;JFN + HRLI C,(PM%CNT\PM%RD) +IFN 10X,[ + MOVEI D,(C) + PMAP ;10X - NO MULTIPLE PMAP'S + SOJLE D,.+3 + AOJ A, + AOJA B,.-3 +] +.ELSE PMAP ;MAP IN THOSE PAGES + HLRZ A,A + CLOSF + JFCL + HRRZ A,LHIPAG ;RETURN POINTER + IMULI A,12000 + TLO A,400000 + JRST POPJ1 + +EJCMD2: MOVE B,[1,,.FBUSW] ;CHECK USER SETTABLE WORD + MOVEI C,C + GTFDB + CAME C,[SIXBIT /TEC/+.FVERS] ;A COMPATIBLE DUMP FILE? + TYPRE [AOR] ;NOPE + MOVE E,LHIPAG + MOVE T,MEMT + MOVE J,INITFL ;SAVE THESE GUYS + HRLI A,.FHSLF + GET ;THIS SHOULD ONLY HAVE IMPURE PAGES + MOVEM E,LHIPAG + MOVE B,D + HRROI A,DEFDIR + DIRST + JFCL + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL + .I SAVCMX=CBMAX=1 ;RESTORE THEM + SETOM PJATY ;WE JUST LOADED INVALID HCDS, SO NEED ALL LINES REDISPLAYED. + JRST INIT ;RESTART OURSELVES + +;RENAME FILE 1 TO FILE 2 +RENAM: CALL FRDOLD ;GET FIRST FILE + SAVE A + CALL FRDFOU ;GET SECOND FILE + JRST OPNER1 + CALL IMMQIT + MOVEI B,(A) + REST A + RNAMF ;DO THE RENAME + JRST OPNER1 + MOVEI A,(B) + RLJFN + JFCL + JRST DELQIT + +;DELETE A FILE +DELE: CALL FRDOLD ;GET OLD FILE JFN + DELF ;DELETE IT + JRST OPNER1 + RET + +WWINIT: CALL FFRRDD ;EW - GET FILENAME DEFAULTS +EICMD: TRNE FF,FRUPRW ;^EW MEANS CAN OVERWRITE + TDZA A,A ;NO GTJFN FLAGS THEN + MOVSI A,(GJ%FOU) ;OTHERWISE USER OUTPUT DEFAULTS + CALL FF5 ;GET JFN FROM DEFAULTS + JRST OPNER1 + EXCH A,CHFILO + SKIPLE A + CLOSF ;GET RID OF ANY OLD FILE + JFCL + MOVE A,CHFILO + MOVE B,[36._30.+OF%WR] ;OPEN FOR WRITE + TRNE FF,FRUPRW ;AND IF IN OVERWRITE MODE, + TRO B,OF%RD ;READ TOO, SO FILE NOT CLOBBERED + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + TLO FF,FLOUT ;SAY WE HAVE ONE + MOVE CH,[DEFDEV,,ROUDEV] ;SAVE CURRENT FILENAME DEFAULTS + BLT CH,ROUDEV+ERDEV-DEFDEV-1 + MOVE CH,[010700,,UTOBUF-1] ;REINIT BUFFER POINTER + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT ;AND BUFFER COUNT + RET + +; DO MTOPR ON JFN FROM LH E, WITH ARGS IN C AND SARG +FSMTAP: HLRZS E + MOVE A,(E) + MOVE C,SARG + MTOPR + MOVE A,C ;ANY ARG RETURNED IN 3 + JRST POPJ1 + +; READ OR MODIFY FDB FOR INPUT FILE +FSIFDB: TRZN FF,FRARG + TYPRE [WNA] + HLRZS E + MOVE A,(E) + MOVEI B,(C) ;FIRST WORD TO DO + HRLI B,1 ;ONE WORD + MOVEI C,D ;WHERE TO PUT IT + GTFDB + TRZN FF,FRARG2 ;WAS THERE A SECOND ARGUMENT? + JRST FSFDB2 ;NO, JUST RETURN OLD VALUE + HRLI A,(B) ;WORD TO CHANGE + MOVE C,SARG ;NEW VALUE + MOVE B,C + XOR B,D ;GENERATE MASK FOR NEW VALUES + CHFDB + ERJMP OPNER1 +FSFDB2: MOVE A,D + JRST CPOPJ1 + +;DIRECTORY DISPLAY COMMANDS +LISTF: CALL LSTFRD ;GET FILESPEC FROM FOLLOWING STRING +CNTRU1: CALL LSTFR2 ;USE DEFAULT (DEV:*.*.*) + CALL VBDACU ;SEE IF THERE IS ANY COMMAND WAITING + RET ;RETURN RIGHT AWAY + SETZ CH, + CALL DISINI ;INIT DISPLAY + MOVEI OUT,CHCT ;TYPE OUT + JRST LISTF1 + +LISTFM: MOVEI OUT,TYOM ;TYPE INTO MEMORY + TRNE CH,20 ;EZ? + CALL LSTFRD ;YES, READ FROM USER + CALL LSTFR2 ;NO, USE DEFAULTS +LISTF1: SAVE A ;SAVE THE JFN + TLZ FF,FLDIRDPY ;DONT NEED IT AGAIN + HRRM OUT,LISTF5 + +LISTF2: HRROI A,BAKTAB ;INTO FREE SPACE + HRRZ B,(P) + TRNE FF,FRARG ;USE USERS FORMAT IF AN ARGUMENT OF IT + SKIPA C,NUM + MOVE C,[1_27.+1_24.+1_21.+JS%SIZ+JS%LWR+JS%LRD+JS%PSD+JS%PAF] + JFNS ;ALONG WITH SIZE AND READ AND WRITE DATES + MOVEI CH,^M ;AND A CRLF + IDPB CH,A + MOVEI CH,^J + IDPB CH,A + MOVEI CH,^@ + IDPB CH,A ;END WITH NULL + + HRRZ OUT,LISTF5 ;GET WHERE IT GOES + CAIN OUT,TYOM ;INTO MEMORY? + JRST LISTF8 ;YES, DO IT FAST THEN + MOVEI A,BAKTAB ;START OF WHERE STRING IS + CALL ASCIND ;TYPE THIS LINE OUT + SKIPL MORFLF ;--MORE-- FLUSHED? + JRST LISTF3 ;NO + POP P,A ;GET BACK JFN + RLJFN ;GET RID OF IT + JFCL + JRST LISTF7 ;DONE + + +LISTF8: MOVEI C,-BAKTAB(A) ;NUMBER OF WORDS + IMULI C,5 + LSH A,-30. + HRREI A,-36.+7(A) ;NULL DOESNT COUNT + IDIVI A,7 + SUB C,A ;GET TOTAL NUMBER OF CHARS USED + CALL SLPGET ;MAKE THAT MUCH ROOM + MOVE A,[440700,,BAKTAB] +LISTF6: ILDB CH,A ;INSERT GIVEN NUMBER OF CHARACTERS + IDPB CH,BP + SOJG C,LISTF6 + +LISTF3: MOVE A,(P) ;GET BACK MULTI JFN + GNJFN ;GET NEXT FILE + CAIA ;NONE LEFT + JRST LISTF2 ;TAKE CARE OF IT TOO + POP P,A ;FLUSH JFN +LISTF7: HRRZ A,LISTF5 ;IF GOING TO DISPLAY AREA, + CAIN A,CHCT + JRST DISCLG ;FINISH UP DISPLAY + RET + +LSTFRD: AOSA (P) ;GET A FILENAME FROM THE USER +LSTFR2: TLZA FF,FRNOT ;GET JUST DEFAULTS + TLO FF,FRNOT + SAVE DEFFN1 ;TEMPROARILY USE *.* + SAVE DEFFN2 + SAVE DEFFN3 + MOVSI A,() + MOVEM A,DEFFN1 ;SET THEM UP + MOVEM A,DEFFN2 + MOVEI A,-3 ;AND .* + HRRM A,DEFFN3 + MOVSI A,(GJ%IFG\GJ%OLD) ;ALLOW MULTIPLE INPUT FILESPECS + TLNE FF,FRNOT ;READING FROM STRING? + JRST LSTFR4 ;YES, GET IT +IFN 10X,HRROI B,[ASCIZ /*.*;*/] +.ELSE HRROI B,[ASCIZ /*.*.*/] ;DEFAULT STRING IF NOT FOM USER +LSTFR5: CALL FF5A + JRST OPNER1 +LSTFR3: REST DEFFN3 + REST DEFFN2 + REST DEFFN1 + RET +LSTFR4: CALL FFRRDD ;READ FILESPEC STRING + JRST LSTFR5 + +IFN 0,%%TNX.: +] ;END IFN TNX CONDITIONAL + +;FS DFILE$ -- THE DEFAULT FILE NAMES, AS A STRING. CAN BE READ OR SET. +FSDFILE:CALL FSDFRD ;FIRST GET VALUE TO RETURN FROM OLD FILENAMES. + TRZN FF,FRARG ;IF HAVE ARG, SET FILENAMES TO IT BY INSERTING IT + JRST POPJ1 ;INTO AN ET COMMAND. + JSP T,GCPUSA ;MEANWHILE, KEEP VALUE WHERE IT WILL BE RELOCATED. + MOVEI A,[ASCIZ /[0 U0 ET0 ]0/] + CALL MACXCP + JRST GCPOPV + +;HERE TO MACRO QREG OR ASCIZ IN A, WITH ARG IN C, SAVING CURRENT VALUE STATUS. +MACXCP: JSP T,OPEN1 + MOVEM C,NUM + CALL [ SKIPE RREBEG ;IF ^R IS DOING THIS, MUST CALL MACRO USING RRMAC. + JRST MACXQW ;SO THAT TECO KNOWS WE ARE LEAVING ^R. + JRST RRMAC5] + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW\FROP\FRSYL + HRROI T,CPOPJ + JRST CLOSE2 + +SUBTTL OUTPUT ROUTINES THAT USE LISTF5 + +;COME HERE FOR DPT OF NEGATIVE NUMBER. +DPT2: CAMN C,[SETZ] ;CAN'T NEGATE THIS! MUST WORK SPECIALLY + JRST DPTMNF + MOVNS C ;OTHERWISE PRINT THE MAGNITUDE, PRECEDED BY A "-". + TLO FF,FLNEG +RDPT: SOJA TT,DPT6 + +DPT: TDZA TT,TT ;DECIMAL PRINT, NO LEADING ZEROS. +SLDPT: MOVEI TT,2 ;DECIMAL PRINT, WITH AT LEAST 3 POSITIONS USED. +DPT1: JUMPL C,DPT2 +DPT6: MOVE D,QRB.. + MOVM CH,.QBASE(D) + SOJLE CH,[ + MOVEI C,10. ;IF ..E HOLDS 0, 1 OR -1, REPLACE BY 10. + MOVEM C,.QBASE(D) + TYPRE [..E]] + IDIV C,.QBASE(D) +DPT8: HRLM D,(P) + JUMPGE D,DPT7 ;HANDLE NEGATIVE REMAINDER (IMPLIES NEG. RADIX). + MOVE D,QRB.. + HRLZ D,.QBASE(D) + MOVNS D + ADDM D,(P) + AOS C +DPT7: SKIPE C + CALL RDPT + TLZE FF,FLNEG + SAVE ["--"0,,DPT3] +DPT3: JUMPLE TT,DPT4 + XCT DPT5 + PUSHJ P,@LISTF5 + SOJG TT,.-1 +DPT4: HLRE CH,(P) +DGPT: ADDI CH,"0 + CAILE CH,"9 ;FOR "DIGITS" ABOVE 9, USE LETTERS. + ADDI CH,"A-"9-1 + JRST @LISTF5 + +DPTMNF: MOVE D,QRB.. ;HANDLE PRINTING OF 400000,, + MOVE D,.QBASE(D) + CAIE D,8 ;PRINT IT WITH A "-" SIGN, EXCEPT IN OCTAL. + TLO FF,FLNEG + SAVE D + LSHC C,-35. ;NOTE LOW BIT OF E IS 0, SINCE QRB.. ISN'T TOO BIG. + DIV C,(P) + SUB P,[1,,1] + JRST DPT8 + +;= PRINTS . +;,= PRINTS ,. +;,= PRINTS ,. +;^ => PRINT IN ECHO AREA. : => OMIT THE . +PRNT: ARGDFL ;-= MEANS -1=. + TRNN FF,FRARG+FRARG2 + TYPRE [WNA] + TRNN FF,FRARG2 + JRST PRNT2 + EXCH C,E ;= WITH 2 ARGS: + CALL PRNT3 ;PRINT THE 1ST ARG, + MOVEI CH,", + CALL @LISTF5 ;A COMMA, + EXCH C,E ;AND THE SECOND ARG. + TRNE FF,FRARG +PRNT2: PUSHJ P,PRNT3 + TRNN FF,FRUPRW + SAVE [DISFLS] ;IF ORDINARY TYPEOUT, MUST FORCE IT OUT WHEN DONE. + TRNE FF,FRCLN + RET + JRST CRR1 + +PRNT3: MOVEI A,TYO + TRNE FF,FRUPRW + MOVEI A,FSECO2 + HRRM A,LISTF5 + JRST DPT + +CRR: MOVEI CH,TYO + HRRM CH,LISTF5 + PUSHJ P,CRR1 + JRST DISFLS + +CRR1: MOVEI CH,15 + PUSHJ P,@LISTF5 + MOVEI CH,12 + JRST @LISTF5 + +CTLQM: SKIPA CH,[^Q] +SPSP: MOVEI CH,40 + JRST @LISTF5 + +FORMF: MOVEI CH,^M + CALL @LISTF5 + MOVEI CH,^L + JRST @LISTF5 + +IFN ITS,[ +LFILE: MOVE A,DEFDIR + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,DEFDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,DEFFN1 + MOVEI C,40 + PUSHJ P,SIXINT + MOVE A,DEFFN2 +] ;IFN ITS + +;OUTPUT A WORD OF SIXBIT, WITH ^Q'S AS NEC. SO TECO CAN READ BACK IN AS FILENAME. +SIXIN1: JUMPE A,CPOPJ + MOVEI B,0 + ROTC A,6 +IFN ITS,[ + JUMPE B,SIXIN2 + CAIE B,': + CAIN B,'; +SIXIN2: PUSHJ P,CTLQM +] + MOVEI CH,40(B) + PUSHJ P,@LISTF5 + JRST SIXIN1 + +SIXINT: PUSHJ P,SIXIN1 ;INSERT IN THE BUFFER THE SIXBIT WORD IN A + MOVE CH,C ;AND THE ASCII CHAR IN C + JRST @LISTF5 + +SIXINS: PUSHJ P,SIXIN1 + JRST CRR1 ;END WITH CRLF + +;OUTPUT ASCIZ STRING <- A, THRU LISTF5. +ASCIND: HRLI A,BP7 ;GET BP TO STRING. +ASCIN1: ILDB CH,A + JUMPE CH,CPOPJ + XCT LISTF5 + JRST ASCIN1 + +SIXNTY: PUSH P,OUT + MOVE OUT,E +SIXNT1: SETZ CH, + ROTC OUT,6 + ADDI CH,40 + CALL @LISTF5 + JUMPN OUT,SIXNT1 + REST OUT + POPJ P, + +TYPR: MOVEI IN,6 +TYPR3: MOVE OUT,[(600)E-1] + ILDB CH,OUT + ADDI CH,40 + XCT LISTF5 + SOJG IN,.-3 +TYPR2A: POPJ P,LISTF4 + +SLTAB: LISTF4: + MOVEI CH,^I + JRST @LISTF5 + +SUBTTL TERMINAL I/O FS FLAGS + +;FS LISTEN$ - RETURN NONZERO IFF INPUT IS AVAILABLE. +;IF NONZERO ARG, THEN IF NO INPUT AVAILABLE PRINT IT AS ASCII CHAR IN ECHO AREA. +FSLISN: SKIPN TYISRC + SKIPL A,UNRCHC ;RETURN -1 IF INPUT IS AVAILABLE FROM ANY SOURCE. + JRST POPJ1 + LISTEN A + JUMPG A,NRETM1 + TRZE FF,FRARG ;OTHERWISE, IF THERE'S AN ARG, + SKIPN RGETTY + JRST POPJ1 + AOS (P) + JRST FSECOT ;TYPE IT IN ECHO MODE (ON DISPLAYS ONLY) + +IFN ITS,[ +;FS MP DISPLAY$ - OUTPUT CHARACTER OR STRING TO M.P. AREA IN DISPLAY MODE. +FSMPDS: SKIPGE CH,C + JSP CH,FSMPD1 + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJDIS] + .LOSE %LSFIL + RET +] + +FSMPD1: HRRM CH,LISTF5 + SETO D, + JRST FGCMD1 + +;FS ECHO DISPLAY$ - OUTPUT CHAR OR STRING IN DISPLAY MODE (^P IS SPECIAL) TO THE ECHO AREA. +;ARG IN C; CLOBBERS CH. +FSECDS: SKIPGE CH,NELNS + SETCM CH,NELNS + JUMPE CH,CPOPJ ;DO NOTHING IF THERE'S NO ECHO AREA. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPGE CH,C + JSP CH,FSMPD1 +IFN ITS,.IOT CHECDS,CH +IFN TNX,CALL ECHODP ;OUTPUT ^P CODE IN ECHO AREA + JRST FSECO5 + +IFN TNX,FSMPDS: ;CLOSEST WE CAN COME - NOTHING SHOULD DO IT ANYWAY +FSIMAG: SKIPGE CH,C ;FS IMAGE OUT$ - OUTPUT CHARACTER OR STRING IN SUPER-IMAGE MODE. + JSP CH,FSMPD1 +IFN ITS,.IOT CHSIO,CH +IFN TNX,CALL [MOVEI A,(CH) ? PBOUT ? RET] + JRST FSECO6 + +;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS STRAY CR. +FSECO2: CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPN RGETTY ;ON PRINTING TTY, MUST TYPE USING NORMAL MECHANISM; OTHERWISE + JRST TYO ;CHCTHP WOULD NOT BE UPDATED AND SPURIOUS CONTINUATIONS WOULD HAPPEN + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +IFN ITS,[ + SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +IFN TNX,CALL ECHOC0 ;OUTPUT CHARACTER IN ECHO AREA + JRST FSECO5 + +;FS ECHO OUT - OUTPUT ARG IN ECHO MODE (WRITE-ONLY) +FSECOT: MOVE CH,C ;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS CRLF. +FSECO1: SKIPN RGETTY ;ON PRINTING TTY, WE WILL USE NORMAL TYPEOUT, WHICH MEANS + SAVE [DISFLS] ;THAT AFTERWARD WE MUST FORCE IT OUT. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + JUMPL CH,[ ;IF ARG IS A STRING, + CALL SAVACS + MOVE C,CH + MOVEI CH,FSECO2 ;TYPE OUT EACH CHAR OF IT USING FSECO2. + HRRM CH,LISTF5 + SETO D, + CALL FGCMD1 + JRST RSTACS] + SKIPN RGETTY + JRST [ CAIN CH,^M + JRST CRR + JRST TYO] + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +FSECOR: +IFN ITS,.IOT CHECHO,CH ;ARG IS CHAR IN CH; OUTPUT IN ECHO MODE. +IFN TNX,CALL ECHOCH +FSECO5: SKIPG ECHACT + SETOM ECHACT ;MAKE SURE ECHO AREA IS CLEARED. +FSECO6: SETOM RROVPO ;IN CASE IN ^R MODE, + SETOM RROHPO ;MAKE SURE CURSOR GETS REPOSITIONED. + SETOM ECHCHR + RET + +FSECO7: AOSE PJATY ;CLEAR SCREEN IF IT SAYS IT NEEDS TO BE CLEARED SOON. + RET + CALL CTLL1 + SETOM RRMSNG ;MAKE SURE ^R REDISPLAYS EVERYTHING NEXT TIME. + JRST RRLRDS + +SUBTTL TERMINAL OUTPUT COMMANDS + +;FV$ -- DISPLAY +FVIEW: TROE FF,FRCLN ;:FV DOESN'T START AT TOP OF SCREEN. + JRST FVIEW1 ;AND IT DOES TYPEOUT INSTEAD OF DISPLAY. + CALL DISINI + JRST FVIEW1 + +;FT$ -- TYPE +FTYPE: TRNE FF,FRUPRW ;^ FT TYPES STRING IN ECHO AREA. + JRST [ CALL IMMQIT + TRNN FF,FRCLN ;^:FT DOES DOES SO ONLY IF NO INPUT AVAILABLE. + JRST FTYECH + SKIPGE UNRCHC + SKIPE TYISRC + JRST FNOOP + LISTEN A + JUMPE A,FTYECH + JRST FNOOP] ;THERE'S INPUT; IGNORE STRING INSTEAD TYPING IT. + TRZE FF,FRCLN ;:FT STARTS AT TOP OF SCREEN. + SETOM TYOFLG + CALL DISINT +FVIEW1: MOVEI BP,CHCT + CALL IMMQIT +FTYLUP: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + CAIA + JRST FTEND +FTYCHR: ANDI CH,177 + CALL (BP) + JRST FTYLUP + +FTEND: CALL DELQIT + TRNE FF,FRCLN + JRST DISCLG + SKIPGE TYOFLG + RET + JRST DISFLS + +FTYEC1: ANDI CH,-1 ;REMEMBER SUPRQUTED CHARS HAVE L.H. SET! + CALL [ CAIE CH,^M + CAIN CH,^J + JRST FSECO2 + JRST FSECO1] +FTYECH: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + JRST FTYEC1 + CALL DELQIT + SKIPN RGETTY + JRST DISFLS + RET + +;V COMMAND, AND ALL VARIATIONS THEREOF. EXIT WITH JRST RET. +VIEW: TRZE FF,FRUPRW + JRST [ CALL VIEW1B ;"^ V" - DO APPRO. KIND OF DISPLAY + JRST VIEW1A] ;THEN CHECK FOR FOLLOWING W. + SKIPN RGETTY + JRST VIEW1A + PUSHJ P,DISINI + SETOM VREMEM ;TRY TO DISPLAY BFR AT SAME PLACE + PUSHJ P,GETARG + CALL CHK1A + MOVE A,E + SUB A,BEGV + SKIPGE A + SETO A, + MOVEM A,GEA + .I DISADP=PT+1 ;TELL DISAD WHERE TO PUT CURSOR. + MOVEI J,DISAD + PUSHJ P,TYPE1 +VIEW1: PUSHJ P,DISCLG +VIEW1A: MOVE T,CPTR + ILDB C,T + CAIE C,"W + CAIN C,"W+40 + SKIPN COMCNT + POPJ P, + CALL RCH ;FLUSH THE "W" OF "VW". + TRZ FF,FRARG2+FRARG+FRCLN + JRST FTYI ;READ IN CHAR, RETURN AS NUMBER. + +VIEW1B: SKIPE DISPRR ;"^ V": IN ^R MODE, DO A ^R-STYLE DISPLAY + JRST RRNOIN + JRST VIEW3A ;ELSE DO STANDARD DISPLAY. + +EUHACK: CALL FFRDEV ;E^U -- READ FILENAME, THEN DO + JRST CNTRLU ;WHATEVER DIR DISPLAY THE USER WANTS. + +;COME HERE FROM GO, AFTER THE END OF A COMMAND STRING +;(WHETHER IT ENDED SUCCESSFULLY OR NOT) +;DECIDE WHETHER AND HOW TO DISPLAY. +VIEW2: ANDCMI FF,FRCLN + TLZE FF,FLDIRDPY ;FRCLN _ FLDIRDPY +;^U COMMAND - DO USER'S SELECTED TYPE OF DIRECTORY DISPLAY. +CNTRLU: IORI FF,FRCLN + MOVE CH,QRB.. + TRNN FF,FRCLN + SKIPA A,.QBFDS(CH) ;FLDIRDPY WAS OFF, WE WANT BUFFER DISPLAY. + MOVE A,.QFDDS(CH) ;IT WAS ON, WE WANT DIR DISPLAY. + JUMPE A,VIEW3B ;USER HASN'T SUPPLIED MACRO: DO ^V OR :^V. + JRST MACXQ ;DO THE MACRO. + +TYPE: PUSHJ P,GETANU ;T COMMAND: DECODE ARGS. + MOVEI J,FSECO2 ;^ T TYPES IN ECHO AREA. + TRZN FF,FRUPRW +TYPE2: MOVEI J,TYO ;TYPE RANE IN E,C. +TYPE1: MOVE IN,E +TYPE3: SKIPN MORFLF + SKIPE STOPF + RET + CAML IN,C + JRST TYPE5 + PUSHJ P,GETINC + PUSHJ P,(J) + JRST TYPE3 + +TYPE5: CAIE J,TYO + SKIPN RGETTY + SKIPGE TYOFLG + POPJ P, + JRST DISFLS ;FORCE THE TYPEOUT OUT, IF THE M.P. AREA TYPEOUT MECHANISM WAS USED. + +SUBTTL BUFFER DISPLAY + +;COME HERE AFTER EACH CMD STRING, +;IF USER HAS NOT SUPPLIED A MACRO TO BE INVOKED. +VIEW3B: TRZ FF,FRARG + MOVE TT,QRB.. + SKIPE .QVWFL(TT) + POPJ P, ;DON'T DISPLAY IF CMDS IN STRING INHIBITED IT. + SKIPE RGETTY ;SHOULD WE EVER DISPLAY ON THIS TERMINAL + JRST VIEW3A + TRNN FF,FRCLN ;ELSE, ON PRINTING TTY, NO DISPLAY OF DIRS, + SKIPN TTMODE ;BUFFER DISPLAYED ONLY IN :^N MODE. + RET +VIEW3A: TRZE FF,FRCLN + JRST CNTRU1 + CALL VBDACU ;UPDATE TSALTC, SKIP IF OK TO DISPLAY. + POPJ P, +VBD: SETO A, + CALL VBDBLS ;MAKE SURE WE HAVE A VALID WINDOW (BLESS IT) + JRST VBDDIS ;THEN DISPLAY FROM THERE. + +VBDRR: SETO A, + CALL VBDBL1 ;HERE TO DISPLAY FOR ^R, WITH OUTPUT AND WINDOW SET UP. ON DISPLAYS ONLY! + MOVEM B,RRVPOS + JRST VBDDIS + +;A/ -1 => MAKE SURE THAT WE HAVE A VALID WINDOW. +;A/ VPOS => CHOOSE WINDOW TO PUT PT AT THAT VPOS. +VBDBLS: SETOM TYOFLG ;SINCE WE ARE SCREWING UP VPOS AND HPOS, TYPEOUT SHOULD REINIT. + MOVE C,NLINES + CALL WINSET +VBDBL1: SAVE %END + SAVE CHCTVS ;ON PRINTING TTY'S WE MUSTN'T CHANGE THE WINDOW SIZE FOR GOOD. + .I CHCTVS=BOTLIN ;BUT DURING BUFFER DISPLAY, RESTRICT TO # LINES. + CALL VBDRR2 ;CALCULATE NEW ABSOLUTE WINDOW ADDRESS IN A. + .I GEA=A-BEGV + REST CHCTVS + REST %END + RET + +VBDRR2: JUMPGE A,[ SETOM %END ;IF VPOS FOR PT SPEC'D EXPLICITLY, USE IT. + JRST VBDN5] ;ALSO TURN OFF MARGIN CHECKING FOR ZV. + SKIPE RGETTY ;NOT DATAPOINT => NO DESIRE TO DISPLAY FROM SAME PLACE. + SKIPGE IN,GEA ;OR NO OLD PLACE TO START FROM => + JRST VBDNEW ;START FROM SCRATCH. + ADD IN,BEGV ;TRY THE OLD START. + CAMLE IN,PT ;NO GOOD TO START AFTER POINTER. + JRST VBDNEW + JRST VBDTRY ;ELSE SEE IF OLD WINDOW STILL GOOD. + +;SET THE VARIABLES THAT DESCRIBE THE SIZE AND POSITION OF THE WINDOW +;AND THE MARGINS (REGIONS WHERE WE DON'T WANT THE POINTER TO BE); NAMELY, +;RRTOPM, RRBOTM, BOTLIN, AND VSIZE. +;C SHOULD CONTAIN NLINES (OR SOMETHING TO USE INSTEAD). +WINSET: SAVE D + SKIPGE C + SETZ C, ;NEGATIVE # LINES NOT ALLOWED. + SAVE J + SKIPL J,TOPLIN + CAML J,USZ + SETZM TOPLIN ;IF FS TOP LINE$ IS INVALID, SET IT TO 0 INSTEAD. + REST J + SKIPE C + ADD C,TOPLIN ;C HAS DESIRED LAST LINE (+1) TO USE, OR 0 FOR WHOLE SCREEN. + CAML C,USZ + SETZ C, ;CAN'T USE MORE LINES THAN WE HAVE. + SKIPN C + MOVE C,USZ ;NO SPECIFICATION, OR BAD SPEC, => USE TILL SCREEN BOTTOM. + CAIL C,MXNVLS ;IF THAT'S INFINITELY MANY LINES, USE 2 LINES. + MOVEI C,2 + MOVEM C,BOTLIN ;STORE DESIRED LAST LINE (+1) IN BOTLIN. + SUB C,TOPLIN + MOVEM C,VSIZE + IMUL C,%TOP ;COMPUTE MARGINS THAT CURSOR MUSN'T GO OUTSIDE. + IDIVI C,100. + ADD C,TOPLIN + MOVEM C,RRTOPM + MOVE C,VSIZE + IMUL C,%BOTTO + IDIVI C,100. + SUB C,BOTLIN + MOVNM C,RRBOTM + JRST POPDJ + +;TRY TO MAKE SURE TSALTC IS UP TO DATE. TSALTC CAN GET WRONG IF TTY IS +;RETURNED TO DDT AND IT THROWS AWAY ALL THE INPUT. +VBDACU: SKIPN TSALTC ;UPDATE TSALTC (IN CASE DDT HAS FLUSHED + SKIPE TSINAL ;THE $$'S THAT INT'D US) (SKIP IF ENDS UP 0) + CAIA + JRST POPJ1 + LISTEN CH, + JUMPN CH,CPOPJ + SETZM TSALTC ;NO INPUT CHARS WAITING => NO $$'S. + SETZM TSINAL ;AND NO STRAY $. + HRROS LTYICH + JRST POPJ1 + +;COME HERE TO SEE IF THE PREVIOUS WINDOW (ADDR IN IN) CAN BE REUSED (GEA > -1). +;IN THIS CASE, CAN GO TO VBDNEW IF THE WINDOW IS BAD, OR CAN RETURN WINDOW IN A. +;COME HERE FROM VBDNEW WITH A TENTATIVE WINDOW ADDRESS IN IN (WHICH MAY BE TOO +;CLOSE TO BEG) TO FIND A MORE PRECISE WINDOW (GEA = -1). +;IN THIS CASE, C HOLDS -, AND WE ALWAYS RETURN. +;WE ALWAYS RETURN THE NEW VPOS OF POINT IN B. +;WE SHOULD NEVER BE CALLED WITH A WINDOW THAT IS AFTER POINT. +VBDTRY: CALL CHCTI0 ;INIT VARIOUS TEMPS FOR TYPEOUT. + SETZ T, ;INITIAL HPOS IS 0 (VBDL UPDATES) + SETZM MORFLF ;THIS MIGHT HAVE STOPPED LAST VBDTRY. + CALL MEMTOP ;OUT GETS ADDR OF FREE STORAGE, + MOVE OUT,A ;FOR TABLE OF LINE-BEGINNING ADDRESSES. + MOVE A,IN ;A _ THE START WE'RE TRYING NOW. + CAMLE A,PT + .VALUE + CALL GETIBI ;BP IN BP TO FETCH CHARS TO TYPE, STARTING AT IN. + MOVEI TT,VBDL ;CALL VBDL TO "OUTPUT" A LINE. + MOVEM TT,CHCTAD + SETZB TT,CHCTBP ;TELL CHCT TO THROW AWAY CHARS. + HLLOM TT,DISBFC ;IT WILL NEVER FILL UP ITS INFINITE SINK. + MOVE TT,TOPLIN ;START "PRINTING" WHERE WE WILL LATER REALLY START PRINTING. + MOVEM TT,CHCTVP + ADD TT,OUT ;STORE BEGINNING OF 1ST LINE DISPLAYED AS 1ST CHAR DISPLAYED. + MOVEM IN,(OUT) +VBD0: CAMN IN,PT ;REACHED PT => + JRST VBDPT ;CHECK WHETHER THIS WINDOW IS OK. +VBDPT2: CAMN IN,ZV ;(COMES BACK IF CAN'T TELL YET, + ;NEAR END OF SCREEN BUT OK IF END OF BUFFER FITS) + JRST VBD3 ;AT END, SEE IF MADE IT ON TO SCREEN. + CAMN IN,GPT ;IF AT GAP, MOVE BP OVER IT. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 ;OUTPUT NEXT CHAR. + SKIPN MORFLF + JRST VBD0 + JRST VBDNEW ;OFF END OF SCREEN AND PT TOO LOW. + +VBD3: MOVE TT,CHCTVP ;REACHED ZV BEFORE FLUSHING, + CAMN TT,BOTLIN ;WINDOW OK IF ZV IS ON SCREEN ABOVE --MORE-- LINE + CAMN T,CHCTHP ;OR IF ZV IS ON IT BUT NO CHARS TYPED ON IT + CAIA + JRST VBDNEW + +;REACHED PT DURING VBD0 LOOP. +VBDPT: SKIPGE GEA ;CAME TO VBDTRY FROM VBDNEW => + JRST VBDDWN ;ZERO IN ON BEST WINDOW. + CAMN A,BEGV ;TRYING TO RE-USE WINDOW => + JRST VBDPT1 ;UNLESS WE STARTED AT START OF BUFFER, + MOVE TT,RRTOPM + CAMLE TT,CHCTVP ;SHOULDN'T HAVE PT < %TOP PERCENT OF SCREEN FROM TOP. + JRST VBDNEW +VBDPT1: MOVE B,CHCTVP ;MIGHT BE OK, REMRMBER # OF LINE WITH PT. + CAMN B,BOTLIN ;IF WE'RE ON THE --MORE-- LINE + CAMN T,CHCTHP ;WE'RE REALLY OFF BOTTOM, BAD WINDOW. + CAIA + JRST VBDNEW + CAML B,RRBOTM ;NOT IN LAST %BOTTOM PERCENT OF SCREEN OR + CAMN IN,ZV ;ALREADY AT BUFFER END => + RET ;CAN'T BE TO NEAR BOTTOM. IT'S GOOD; RETURN IT. + CALL DISBAR + JRST VBDPT2 ;ELSE SEE IF END OF BUFFER FITS ON SCREEN. + +;CHCT CALLS HERE WITH EACH LINE DURING VBDTRY. +;SETS UP THE LINE-BEGINNING ADDRESS ENTRY FOR THE LINE. +;LEAVES HORIZ POS. START OF NEXT LINE IN T. +VBDL: MOVE Q,CHCTVP + MOVE TT1,Q + ADD TT1,OUT + MOVE T,CHCTNL ;STORE ADDRESS OF 1ST CHAR ON LINE. + MOVEM T,1(TT1) + MOVE T,CHCTHP ;RETURN H.P. AFTER LINE. + MOVE TT1,GEA ;IF GOING TO GO TO VDBDWN, + AOJE TT1,CPOPJ ;MAKE SURE ALL THE LINE'S STARTS ARE STORED. + CAMN Q,BOTLIN ;AT BOTTOM OF SCREEN => + SETOM MORFLF ;STOP THE LOOP AT VBDTRY. + POPJ P, + +;START FROM SCRATCH, FIGURING OUT A NEW WINDOW. +;RETURN THE NEW WINDOW ADDRESS IN A, AND THE NEW VPOS OF POINT IN B. +VBDNEW: SKIPGE DISTRN + JRST VIEW2A ;IN TRUNCATE MODE, EVERYTHING EASIER. + MOVE A,VSIZE ;PRETEND WE'RE STARTING AT MIDDLE OF SCREEN. + IMUL A,%CENTER + IDIVI A,100. + SKIPGE A + SETZ A, + MOVE T,VSIZE + CAMG T,A + MOVEI A,-1(T) + ADD A,TOPLIN +;HERE FROM RREAR3; A HAS DESIRED VPOS OF PT. +VBDN5: SETOM GEA ;SO NEXT TIME REACH VBDPT WON'T COME HERE AGAIN. + CALL CHCTI0 + SETZM CHCTBP ;MAKE SURE WE DON'T TRY USING UP INFINITE AMOUNTS OF DISBUF. + MOVEM A,CHCTVP + SETZB T,MORFLF + MOVE BP,PT + CAMN BP,BEGV ;IF PT = BEGV, WINDOW MUST START AT BEGV. + JRST [ MOVE A,BP + MOVE B,TOPLIN + RET] + MOVEI C,CPOPJ ;TELL DISAD NOT TO DO ANYTHING WITH THE LINES IT CONSTRUCTS. + MOVEM C,CHCTAD + SAVE CHCTVP ;SAVE TOPLINE+#CENTER. + MOVE TT,VSIZE + IMUL TT,%END + JUMPL TT,VBDN6 + IDIVI TT,100. + SAVE TT ;REMEMBER #END (TOTAL*%END/100) + IMUL TT,NHLNS ;ARE WE WITHIN #END*WIDTH*2 CHARS OF END OF BUFFER? + LSH TT,1 + CAIL TT,1000. ;IF NOT FOR THIS, SMALL %END'S WOULD BE IGNORED UNLESS PT VERY NEAR Z. + MOVEI TT,1000. ;RATHER, THEY MEAN "PUT Z VERY NEAR SCREEN END, IF IT'S ON SCREEN AT ALL" + ADD TT,BP + CAMGE TT,ZV ;IF SO, DON'T LEAVE MORE THAN #END BLANK LINES AT BOTTOM. + JRST VBDN4 ;IF NOT, ASSUME WE WON'T LEAVE THEM & DON'T WASTE TIME. + CAMN BP,ZV ;WE'RE AT END OF BUFFER => + JRST [SOS IN,BP ;NEED FULL SCREEN ABOVE PT. + CALL GETCHR ;IF LAST CHAR ISN'T LF, + CAIE CH,^J ;MAKE SURE THE LAST UNTERMINATED LINE + AOS CHCTVP ;DOESN'T END UP OFF SCREEN BOTTOM. + JRST VBDN2] + CAMLE BP,GPT + ADD BP,EXTRAC + CALL GETIBP ;SEE HOW MANY LINESOF TEXT THERE ARE BETWEEN PT AND BUFFER END. + MOVE IN,PT + SKIPE RGETTY + SKIPE RREBEG + CALL DISBAR ;STARTING AT THE PTR SO MAKE CURSOR (EXCEPT IN ^R ON DISPLAY TTY). + MOVE E,BOTLIN ;IF WE GET DOWN TO VPOS = TOTAL-#END, WE CAN PUT CURSOR + SUB E,(P) ;AT THE USUAL PLACE (#CENTER), SO STOP COUNTING LINES. +VBDN1: CAMN IN,ZV + JRST VBDN2 ;ALL USED UP, SEE HOW MANY LINES THAT MADE. + CAMG E,CHCTVP + JRST VBDN4 + CAMN IN,GPT ;WHEN AT GAP, MOVE BP OVER GAP. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 + JRST VBDN1 + +VBDN2: MOVE C,CHCTVP ;REACHED END OF BFR WITHOUT REACHING VPOS = TOTAL-#END. + CAME T,CHCTHP ;MAYBE WE STARTED ANOTHER LINE NOT COUNTED IN VPOS. COUNT IT TOO + JRST [ CAME C,BOTLIN ;UNLESS IT'S REALLY OFF + AOS C ;BOTTOM OF SCREEN. + JRST .+1] + SUB C,A ;# LINES WE PRINTED IN VBDN1 LOOP. + ADD C,(P) ;PLUS MAX # BLANK LINES TO LEAVE BELOW THEM, + MOVNS C ;GIVES MAX # LINES WE CAN ALLOW BELOW PT. + ADD C,BOTLIN ;SUBTRACT FROM WINDOW BOTTOM TO GIVE MIN VPOS FOR PT. + MOVEM C,-1(P) ;(SMALLER THAN AND INSTEAD OF TOPLIN+#CENTER WHICH WE SAVED). +VBDN4: SUB P,[1,,1] ;NO LONGER NEED #END. +VBDN6: MOVNS C,(P) ;GET BACK #CENTER OR CORRECTED # OF LINES WE WANT ABOVE PT. + ADD C,TOPLIN ;-<# LINES NEEDED ABOVE PT> + CALL VBDN7 ;IN GETS PLACE WHERE THOSE LINES START. + REST C ;- . + JRST VBDTRY + +;RETURN IN IN THE CHAR ADDR OF A SPOT C(C) LINES UP FROM POINT. +;MORE PRECISELY, IT MUST BE AT LEAST C(C) SCREEN LINES UP, BUT MAY BE MORE, +;BUT SHOULDN'T BE TOO MUCH MORE FOR THE SAKE OF EFFICIENCY. +;LIKE DOING -@L BUT WITH CUTOFF IN CASE THERE ARE NO CRLFS IN THE BUFFER. +VBDN7: MOVE E,C ;FIND PLACE BACK FROM POINT FAR ENOUGH + SUBI E,2 ;TO FILL UP THAT MANY SCREEN LINES (PLUS 2) + IMUL E,NHLNS ;WITH JUST CONTINUATION LINES. + ADD E,PT + CAMGE E,BEGV ;THERE, OR BEGINNING OF BUFFER, IS WHERE WE CUT OFF. + MOVE E,BEGV + MOVE IN,PT ;NOW, LOOK BACK THAT MANY LINES FROM POINT, BUT NOT PAST THERE. +VBDN7L: SOS IN ;LOOP HERE OVER LINES. +VBDN7C: CAMGE IN,E ;LOOP HERE OVER CHARACTERS. + AOJA IN,CPOPJ + CALL GETCHR ;EXAMINE NEXT CHAR BACK FOR BEING A LF. + CAIE CH,^J + SOJA IN,VBDN7C + CAMN IN,E + RET + SUBI IN,1 ;IF SO, SEE IF WHAT PRECEDES IT IS A CR. + CALL GETINC + CAIE CH,^M + SOJA IN,VBDN7C + AOJLE C,VBDN7L ;IF SO, THAT'S ONE LINE DOWN. + AOJA IN,CPOPJ ;WHEN WE'VE GONE ENOUGH LINES, LEAVE IN -> CHAR AFTER THE LF. + +;COME HERE IN VBDTRY TO SEE WHETHER OUR GUESS FOR GEA WAS GOOD. +;IT'S NO GOOD IF POINT WOULD APPEAR FARTHER DOWN THE SCREEN THAN EXPECTED/ +;SINCE WE REMEMBERED WHERE IN THE BUFFER EACH SCREEN LINE STARTED, +;WE CAN IMMEDIATELY FIND THE CHARACTER THE RIGHT NUMBER OF LINES UP FROM POINT. +;C HAS THE NUMBER OF SCREEN LINES DESIRED ABOVE POINT. +VBDDWN: SAVE A + SAVE RRHPOS + SAVE RRVPOS ;FIRST WORRY ABOUT THINGS LIKE: + .I RRHPOS=CHCTHP + .I RRVPOS=CHCTVP + AOSN RRNCCR ;WHAT IF POINT IS RIGHT AFTER A CR? IN THAT CASE + CALL [ SOS PT ;THE CR HASN'T REALLY BEEN OUTPUT YET. + JRST RRFORW] ;SO ADJUST OUR SCREEN POSITION TO BE AFTER THE CR. + MOVE A,RRHPOS + CALL RRFOR3 ;ALSO, MAYBE THE NEXT CHARACTER WOULD CAUSE A CONTINUATION. + MOVE A,RRHPOS + MOVEM A,CHCTHP + MOVE A,RRVPOS ;ADJUST SCREEN POSITION FOR THAT, IF NECESSARY. + EXCH A,CHCTVP + ADD A,OUT ;IN CASE WE DO START A CONTINUATION LINE, + PUSH A,PT ;ENTER IN THE TABLE WHERE THAT CONTINUATION STARTS. + REST RRVPOS + REST RRHPOS + REST A + MOVN B,C + CAMLE B,CHCTVP + MOVE B,CHCTVP + ADD C,CHCTVP ;(C STILL HAD - # LINES WANTED ABOVE PTR) + JUMPLE C,CPOPJ ;NOT MORE THAN MAX, OK. + ADD C,TOPLIN + ADD C,OUT + MOVE A,(C) ;ELSE FIND 1ST CHAR ON THE LINE WE SHOULD START WITH. + RET + +;DISPLAY THE BUFFER STARTING AT THE WINDOW IN GEA. +VBDDIS: SAVE CHCTVS + SAVE [[ REST CHCTVS + RET]] + SAVE BOTLIN + CALL DISINI ;SET UP FOR DISPLAY. + REST BOTLIN ;DISINI RESETS BOTLIN IGNORING FS LINES, WHICH IS WRONG. + .I CHCTVS=BOTLIN + MOVE TT,QRB.. ;DISPLAY SHOULDN'T INHIBIT ANOTHER DISPLAY OF SAME STUFF. + SETZM .QVWFL(TT) + SETOM VREMEM + MOVE TT,TOPLIN + MOVEM TT,CHCTVP + MOVE IN,GEA + ADD IN,BEGV + MOVEM IN,LINBEG(TT) +VBDOK3: MOVEM IN,CHCTBL ;REMEMBER CHAR ADDR START OF 1ST LINE + ;(DISAD WILL SET CHCTBL FOR LATER LINES) + CALL GETIBI +VBDOK1: SKIPN MORFLF + SKIPGE ORESET ;STOP IF FLUSHED OR QUITTING. + JRST DISCLG + CAMN IN,ZV ;STOP IF NO MORE CHARS. + JRST DISCLG + CAMN IN,PT ;OUTPUT THE CURSOR IF BEFORE PT. + CALL DISBAR + CAMN IN,GPT ;IF AT GAP, MOVE B.P. IN BP OVER IT. + CALL FEQGAP + MOVE TT,CHCTHP + CAME TT,NHLNS ;IF ABOUT TO CONTINUE A LINE + SKIPN DISBFC ;OR IF THE BUFFER IS FULL, + JRST VBDSLO ;OUTPUT 1 CHARACTER SLOWLY TO CONTINUE OR EMPTY THE BUFFER. + SKIPGE DISTRN + JRST VBDSLO + SKIPE CASDIS ;IF WE NEED CASE-FLAGGING, OR + JRST VBDSLO + SKIPL CHCTCF ;IF WE HAVE AN UNPROCESSED CR, + JRST VBDFAS ;MUST GO THRU DISAD SINCE ONLY DISAD KNOWS HOW TO HACK ONE. +VBDSLO: ILDB CH,BP + AOS IN +VBDSL1: .I RRCCHP=CHCTHP + CALL DISAD2 ;OUTPUT THE CHAR. + JRST VBDOK1 + +;IF WE GET HERE, WE KNOW WE CAN GO AT LEAST 1 CHAR BEFORE REACHING PT, GPT, ZV, +;THE RIGHT MARGIN, OR THE END OF DISBUF. +;A HAS THE HPOS TIMES 7, E HAS THE HASH CODE, BP HAS THE BP AND IN HAS THE CHAR ADDRESS. +;TT HAS THE HPOS TO STOP AT, TIMES 7. OUT HAS THE BP TO STOP AT. CH HOLDS THE CHAR. +VBDFAS: MOVE OUT,BP + MOVE BP,ZV ;CONSIDER PT, GPT AND ZV; BP GETS WHICHEVER IS SMALLEST + CAMGE IN,GPT + CAMG BP,GPT + CAIA + MOVE BP,GPT ;YET BEYOND WHERE IN IS NOW. + CAMGE IN,PT + CAMG BP,PT + CAIA + MOVE BP,PT + SOS BP ;CONVERT CHAR ADDR IN BP TO THE B.P. TO LDB THE PREVIOUS CHAR. + CALL GETIBV + IBP BP ;(GETIBV FOLLOWED BY IBP = GETBV). + EXCH OUT,BP + MOVE A,CHCTHP ;A GETS 7 TIMES THE HPOS. WE USE IT FOR SHIFTING FOR THE HASH CODE. + IMULI A,7 ;ALSO, TT GETS 7 TIMES THE LINE WIDTH AND THAT IS AN END TEST. + MOVE TT,NHLNS + IMULI TT,7 + MOVE E,CHCTHC ;E IS WHERE WE ACCUMULATE THE CHECKSUM. +VBDFLP: ILDB CH,BP + XCT VBDTBL(CH) ;FOR FUNNY CHARS, GO SOMEPLACE ELSE. +VBDNRM: IDPB CH,CHCTBP ;STORE CHAR INTO OUTPUT. + ROT CH,(A) + ADD E,CH ;UPDATE THE HASH CODE OF THE LINE. +VBDTRT: ADDI A,7 + CAME BP,OUT ;STOP IF REACH PT, GPT OR ZV. + CAMN A,TT ;STOP IF REACH RIGHT MARGIN. + CAIA ;IN EITHER CASE, INCREMENT HPOS FOR CHAR WE JUST DID. + JRST VBDFLP +;HERE EITHER IN = PT,GPT OR ZV, OR ELSE WE ARE ABOUT TO CONTINUE A LINE. +;SO VBDOK1 IS GUARANTEED TO DO 1 CHAR THE SLOW WAY BEFORE VBDFAS IS REACHED. +VBDOUT: CALL VBDSTO ;STORE BACK CHCTHC, CHCTHP, AND IN + JRST VBDOK1 + +VBDTBL: JRST VBDCTL ;^@ +REPEAT 6,JRST VBDCTL ;^A THRU ^F + JRST VBDCTL ;^G + JRST VBDBS ;^H + JRST VBDTAB ;^I + JRST VBDLF ;^J +REPEAT 2,JRST VBDCTL ;^K, ^L + JRST VBDCR ;^M +REPEAT 13.,JRST VBDCTL ;^N THRU ^Z + JRST VBDALT ;ALTMODE +REPEAT 4,JRST VBDCTL ;^\ THRU ^_ +REPEAT 137,JFCL ;NORMAL GRAPHICS CHARACTERS + JRST VBDCTL ;RUBOUT IS LIKE A CTL CHAR. +IFN .-VBDTBL-200,.ERR WRONG TABLE LENGTH + +VBDSTO: IDIVI A,7 ;CONVERT A BACK TO HPOS TIMES 1. + EXCH A,CHCTHP ;A IS UPDATED CHCTHP + SUB A,CHCTHP ;OLD CHCTHP MINUS NEW CHCTHP (A NEGATIVE NUMBER) + ADDM A,DISBFC ;IS ALSO - <# OF CHARS IDPB'D>. + MOVEM E,CHCTHC + SAVE BP + CALL GETCA + AOS IN,BP + CAMLE IN,GPT + SUB IN,EXTRAC + REST BP + RET + +VBDCR: SETOM CHCTCF ;CR => SET FLAG FOR NEXT CHAR AND HANDLE IT WITH DISAD. + JRST VBDOUT + +VBDCTL: SKIPE DISSAI ;MOST CONTROL CHARS ARE NORMAL IN SAIL MODE, LOSING OTHERWISE. + JRST VBDNRM +VBDBS:: VBDLF:: +VBDLOS: CALL VBDSTO ;HERE FOR A CHAR THAT MUST BE HANDLED WITH DISAD. + JRST VBDSL1 ;WE KNOW THAT IN DOESN'T = PT, GPT, OR ZV, OR WE WOULN'T HAVE + ;GOT EVEN THIS FAR, SO IT'S SAFE TO GO STRAIGHT TO VBDSLO. + +VBDALT: MOVE TT1,TTYOPT + TLNN TT1,%TOSAI + MOVEI CH,"$ + JRST VBDNRM + +VBDTAB: MOVEI CH,40 ;OUTPUT SPACES + IDPB CH,CHCTBP + ROT CH,(A) ;UPDATING HASH CODE OF LINE + ADD E,CH + ADDI A,7 ;AND INCREMENTING THE HPOS + TRNE A,7 ;TILL WE REACH A TAB STOP. NOTE 7*HPOS IS A MULTIPLE OF 8 IFF HPOS IS. + CAMN A,TT ;THE END OF THE LINE COUNTS AS A TAB STOP. + CAIA + JRST VBDTAB + SUBI A,7 + JRST VBDTRT ;RE-ENTER NORMAL LOOP, EXIT IF REACHED OBSTACLE. + +VIEW2A: MOVE C,VSIZE + ADDI C,1 ;(IF C ODD, WANT LINE WITH PT CENTERED) + LSH C,-1 + SAVE FF + TRZ FF,FRCLN\FRUPRW + PUSHJ P,GETAG7 ;GET 1 + LAST CHAR ADR TO PRINT IN E + JFCL + MOVN C,VSIZE + CAMN IN,BEGV ;IF BUFFER NOT EMPTY, + JRST VIEW2B + SOS IN + CALL GETINC ;LOOK AT LAST CHAR, NOT CHANGING IN. + CAIE CH,^J ;IF NOT LF, IT COUNTS AS A LINE. + AOS C +VIEW2B: PUSHJ P,GETAG4 ;THEN MOVE 2*N BACKWARD FROM THERE, GET 1ST TO DISPLAY. + JFCL + MOVE A,E ;DISPLAY AS MUCH AS WILL FIT. + REST FF + RET + +SUBTTL SINGLE CHARACTER TERMINAL OUTPUT, BUFFERED + +;OUTPUT ROUTINES. OUTPUT CHAR IN CH AS DESCRIBED, CLOBBERING ONLY Q. + +;"DISPLAY" - OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD: MOVE Q,CHCTHP + MOVEM Q,RRCCHP + CAMN IN,DISADP ;IF THIS CHAR COMES AFTER POINTER, + CALL DISBAR ;OUTPUT CURSOR. + +;DON'T OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD2: SKIPN CASDIS ;IF IN -1F$ MODE + JRST CHCT + SAVE .-1 ;DO CASE-FLAGGING: ROUTINE FOR 1 CHAR IS CHCT. + +;CALL DISAD6 ? OUTPUT 1 CHAR ? POPJ P, ;TO OUTPUT A CASESHIFT IF NEC. +DISAD6: SKIPGE CASSFT ;DON'T TRY OUTPUTTING CASESHIFT + POPJ P, ;IF THERE ISN'T ANY. + CAME CH,CASSFT ;PUT CASE-SHIFTS BEFORE + CAMN CH,CASLOK ;CASE-SHIFTS AND CASE-:LOCKS. + JRST DISAD3 + CAILE CH,"Z+40 ;LOWER CASE SPECIAL CHARACTERS ALWAYS NEED CASESHIFTS. + CAIN CH,177 + CAIN CH,"@+40 + JRST DISAD3 + CAIL CH,"A+40 ;LOWER CASE LETTERS NEED THEM IS NORMAL CASE IS UPPER. + CAILE CH,"Z+40 + JRST DISAD4 + SKIPG CASNRM + RET + JRST DISAD3 ;PUT SLASHES BEFORE LOWER. + +DISAD4: SKIPL CASNRM ;IF NORMAL CASE IS LOWER, + RET + CAIL CH,"A ;PUT CASE-SHIFTS BEFORE UPPER CASE. + CAILE CH,"Z + RET +DISAD3: SAVE [DISAD5] ;CASESHIFT NEEDED; ARRANGE TO OUTPUT IT, + SAVE -1(P) ;THEN POPJ TO OUTPUT ORIGINAL CHAR. + HRLM CH,-2(P) + MOVE CH,CASSFT + POPJ P, ;PDL HAS 1-CHAR-RTN ? DISAD5 ? CHAR,,1-CHAR-RTN. + +;OUTPUT A CURSOR. +DISBAR: PUSH P,CH + SKIPE RREBEG + JRST DISBA1 + CALL RRDIS1 + SKIPE RGETTY + JRST POPCHJ +DISBA1: +INSIRP PUSH P,TT TT1 BP A B + MOVE CH,QRB.. ;GET ADDR OF CURSOR QREG + ADDI CH,.QCRSR + CALL QLGET + JRST DISBA2 ;NOT TEXT, NO CURSOR. + AOSN CHCTCF ;FORCE OUT ANY BUFFERED CR BEFORE THE CURSOR. + CALL CHCT5 + MOVE A,BP +DISBA3: SOJL B,DISBA2 ;LENGTH OF TEXT WAS IN B, + ILDB CH,A ;GET AND OUTPUT CHARS OF CURSOR. + CALL [ CAIN CH,^H + JRST DISBBS ;OUTPUT BS AS REAL BACKSPACE. + CAIL CH,40 ;OUTPUT CTL CHARS OTHER THAN ^H IN IMAGE MODE. + JRST CHCT + JRST CHCT4] + JRST DISBA3 + +DISBA2: INSIRP POP P,B A BP TT1 TT +POPCHJ: POP P,CH + POPJ P, + +;TTY AND DISPLAY ROUTINES. +;"TYPEOUT" - DON'T TYPE CURSOR, DO NOTICE CASDIS. +TYO: PUSHJ P,DISINT ;INIT. TYPEOUT. + JRST DISAD2 + +TYANOW: PUSHJ P,TYOA ;TYPEOUT, NO CURSOR, NO SLASH. + JRST DISFLS ;FORCE IT OUT IMMEDIATELY. + +TYOA: PUSHJ P,DISINT ;"TYPEOUT" + +;NO CURSOR, DON'T DO CASE FLAGGING. +CHCT: SKIPN ORESET + SKIPE MORFLF ;DON'T OUTPUT AFTER -FLUSHED. + POPJ P, + CAIN CH,^J + JRST CHCTLF ;LF => OUTPUT LINE. + AOSN CHCTCF ;ELSE FORCE OUT SAVED UP CR. + CALL CHCT5 + CAIN CH,177 + JRST CHCT0A ;RUBOUT COMES OUT AS ^? . + CAIL CH,40 ;NON-CTL CHARS. ONE POSITION. + JRST CHCT1A + CAIN CH,^I ;TAB => OUTPUT SEVERAL SPACES. + JRST CHCTTB + CAIN CH,^H + JRST CHCTBS + CAIN CH,^M ;REMEMBER A CR, NEXT CHAR WILL DECIDE. + JRST [SETOM CHCTCF ? POPJ P,] + CAIN CH,33 ;ALTMODE => OUTPUT. + JRST [ MOVE Q,TTYOPT + TLNN Q,%TOSAI ;ON TERMINALS WHICH CAN HANDLE ONE, SEND REAL ALTMODE. + MOVEI CH,"$ ;OTHERWISE SEND DOLLARSIGN. + CALL CHCT1A + JRST RET33] ;IN EITHER CASE DON'T CLOBBER CH. +CHCT0A: SKIPE DISSAI ;IN SAIL MODE, CTL CHARS OUTPUT AS THEMSELVES + JRST CHCT1A ;AND ASSUMED TO TAKE 1 POS. ON SCREEN. +CHCT0B: HRLM CH,(P) + MOVEI CH,"^ ;OTHER CTL CHARS => OUTPUT "^" + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + PUSHJ P,CHCT1A + HLRZ CH,(P) + XORI CH,100 ;AND UN-CTLED CHAR. + CALL CHCT1A +DISAD5: HLRZ CH,(P) + POPJ P, + +;OUTPUT AN ORDINARY PRINTING CHARACTER. +;WHEN A FULL LINE HAS BEEN ACCUMULATED, CALL @CHCTAD +;WITH HASH CODE IN CHCTHC, VERT. POS. IN CHCTVP, +;HORIZ. POS. AFTER LINE IN CHCTHP. +CHCT1A: MOVE Q,CHCTHP + CAMGE Q,NHLNS ;IF FILLED LINE, CONTINUE IT. + JRST CHCT2 + PUSH P,CH + SKIPGE DISTRN ;TRUNCATING MEANS IGNORING CHARS TILL NEXT CR. + JRST [ MOVEI CH,"! ;IF WE'VE JUST BEGUN TO TRUNCATE, + SKIPL CHCIGN ;PUT IN AN EXCL. + CALL CHCT4 + SETOM CHCIGN ;START IGNORING MOST CHARS. + JRST CHCT1B] + MOVEI CH,"! + CALL CHCT4 ;PUT A ! AT END OF LINE. + MOVEM IN,CHCTNL + SOS CHCTNL ;ADDR OF 1ST CHAR OF LINE AFTER THIS ONE. + SETZM CHCTCF + CALL CHCTL0 ;NOW DO A CRLF. +CHCT1B: POP P,CH +CHCT2: SKIPL CHCTHP + CALL CHCT4 ;OUTPUT THE CHAR IF NECESSARY, + AOS CHCTHP + RET + +;PUT THE CHAR IN CH INTO THE BUFFER AND THE HASH-CODE. +;IF THE BUFFER (<- CHCTBP) IS FULL, OUTPUT IT FIRST. +CHCT4: SKIPL CHCIGN + SKIPN CHCTBP + POPJ P, + SOSG DISBFC ;IF BUFFER FULL,FLUSH IT + JRST [ PUSH P,CH + SETOM CHCTNL + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + PUSHJ P,@CHCTAD + POP P,CH + JRST .+1] + IDPB CH,CHCTBP ;STORE CHAR IN CALLER'S BUFFER. + +;MERGE CHARACTER IN CH INTO THE HASH CODE FOR THIS LINE. +;THE HASHING DEPENDS ON THE HPOS. WE GET IT FROM CHCTHP. +CHCTH: HRLM CH,(P) + MOVE Q,CHCTHP + IMULI Q,7 + ROT CH,(Q) + ADDM CH,CHCTHC + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR INSERTION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHI: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR DELETION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHR: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + MOVNS CH + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +CHCTTB: MOVEI CH,40 ;TAB: OUTPUT A SPACE. + PUSHJ P,CHCT1A + MOVE CH,CHCTHP ;NOT AT TAB STOP => + SKIPN MORFLF ;GO OUTPUT ANOTHER UNLESS FLUSHED + TRNN CH,7 + JRST CHCTT1 + CAME CH,NHLNS + JRST CHCTTB +CHCTT1: MOVEI CH,11 + RET + +;INIT. FOR CHCT. +CHCTI0: SETZM CHCTCF ;NO PENDING ^M. + SETZM CHCOVP + SETZM CHCTHP + SETZM CHCIGN ;NOT BEYOND RIGHT MARGIN. +CHCTI1: AOS CHCTVP + SETZM CHCTHC ;INIT. ACCUMULATION OF HASH CODE. + POPJ P, + +CHCT5: PUSH P,CH ;FORCE OUT CR FOLLOWED BY OTHER THAN LF. + SKIPL DISPCR ;-1 => DO REAL CR. + JRST CHCT5A + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + SETZM CHCTHP ;REAL CR: ZERO HORIZ POSITION, + SETZM CHCIGN ;NO LONGER PAST RIGHT MARGIN. + MOVEI CH,^M ;NOW FORCE OUT THE BUFFER, AND, + CALL CHCTIM ;ON PRINTING TTY, OUTPUT A REAL CR. + JRST POPCHJ + +CHCT5A: MOVEI CH,"^ ;SHOULDN'T OVERPRINT, PRINT AS ^M. + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + CALL CHCT1A + MOVEI CH,"M + CALL CHCT1A + MOVE CH,CHCTHP ;IF WE CONTINUE THE LINE RIGHT AFTER THE ^M, WE SHOULD REALIZE + MOVEM CH,RRCCHP ;THAT THE NEXT CHAR STARTS IN COLUMN 0 OF NEXT LINE, NOT COLUMN -2! + JRST POPCHJ + +CHCTBS: SKIPL DISPBS ;DISPBS < 0 => PRINT AS BS. + JRST CHCT0A +DISBBS: SKIPN CHCTHP ;CAN'T DO ANYTHING AT LEFT MARGIN. + JRST CHCT0A ;^H AT COLUMN 0 => TYPE ^H. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SOS CHCTHP + MOVEI CH,^H ;IF WE'RE REALLY PRINTING, OUTPUT REAL ^H. +CHCTIM: SAVE CH + SETOM CHCTNL + SETOM DISFLF + CALL @CHCTAD ;SEND WHAT WE HAVE SO FAR. + SETZM DISFLF + REST CH +CHCTI9: SAVE CH + MOVE CH,CHCTAD + CAIE CH,DISLIN ;DON'T SEND THE ^H OR ^M IF WE'RE NOT REALLY TYPING. + JRST POPCHJ + MOVE CH,CHCTVP ;NO NEED TO SEND CR NOW IF WILL MOVE DOWN ANYWAY, + CAME CH,DISVP ;SINCE IN THAT CASE THE CURSOR MOTION WILL BE DONE BEFORE NEXT LINE. + JRST POPCHJ + REST CH + SETOM CHCOVP ;INDICATE DOING OVERPRINTING: NEXT DISLIN MUSTN'T %TDMV1 (IMLAX LOSE). + JRST TYOINV + +;COME HERE TO OUTPUT A LF. CALLED BY THE ROUTINE TO OUTPUT STRAY CR. +;CLOBBERS ONLY Q. LEAVES A ^J IN CH. +CHCTLF: MOVEM IN,CHCTNL + AOSE CHCTCF ;IF HAVE UNPROCESSED CR, OUTPUT IT. + JRST [ SKIPL DISPCR ;NO CR; WHAT DO WE DO FOR STRAY LF? + JRST CHCT0B ;MAYBE OUTPUT AS ^ AND J. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + JRST CHCTL1] + SETZM RRCCHP +CHCTL0: SETZM CHCIGN ;STOP IGNORING CHARS IF HAD TRUNCATED LINE. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SETZM CHCTHP ;REFLECT IT IN HORIZ. POS. +CHCTL1: PUSHJ P,@CHCTAD ;LF ENDS LINE, TELL CALLER ABOUT IT. + MOVEI CH,^M ;ON NON-DISPLAY, MUST ACTUALLY DO THE CR IF WANTED. + SKIPN CHCTCF + SKIPE RGETTY + CAIA + CALL CHCTI9 + PUSHJ P,CHCTI1 ;INIT NEW LINE. + SKIPL CH,CHCTNL + MOVEM CH,CHCTBL +CHCTL4: SKIPG CH,CHCTHP + JRST CHCTL3 + MOVE Q,CHCTHC ;PUT SPACES IN HASH CODE. +CHCTL2: ROT Q,7 ;FOR THE INDENT IN LINE WE'RE STARTING WITH. + ADDI Q,40 + SOJG CH,CHCTL2 + MOVEM Q,CHCTHC +CHCTL3: MOVEI CH,^J + POPJ P, + +SUBTTL SEND THE TERMINAL OUTPUT BUFFER + +;CALL HERE TO FORCE OUT BUFFERED OUTPUT. +;CALL AFTER EACH TECO COMMAND THAT DOES OUTPUT. +DISFLS: AOSN CHCTCF ;FORCE OUT ANY UNPROCESSED CR. + CALL CHCT5 ;THIS CAN BE A SCREW IF BETWEEN THAT CR AND A LF! + SETOM CHCTNL + SETOM DISFLF ;FORCE DISLIN TO MOVE CURSOR + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + PUSHJ P,DISLIN ;.IOT IT. + SETZM DISFLF + POPJ P, + +;OUTPUT THE BUFFER. +DISLIN: SKIPE TSALTC ;IF A CMD STRING IS WAITING TO BE READ, + SETOM MORFLF ;GIVE UP TYPEING OUT. + SKIPN ORESET + SKIPE MORFLF + JRST DISRST + SAVE T + SAVE BP +DISLI7: SKIPN BP,CHCTVP ;IF ABOUT TO WRITE ON TOP LINE + JRST [ SKIPN TRCOUT ;BECAUSE OF TRACE MODE, + JRST .+1 + DISSTR / +/ + CALL DISIOT ;CLEAR 1ST LINE AND USE SECOND INSTEAD. + AOS BP,CHCTVP + SETZM HCDS + JRST .+1] + MOVE CH,CHCTHC +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;INITIALLY ASSUME NO POSITIONING NEEDED + MOVEM Q,DISBF1+1 +] +IFN TNX,[ + SETZM DISBF1 ;CLEAR OUT CURSOR POSITIONING + MOVE Q,[DISBF1,,DISBF1+1] + BLT Q,DISBF1+5 +] + SKIPN RGETTY + JRST DISLI0 ;ON PRINTING TTY, NO OLD LINE REMAINS ON SCREEN. + CAML BP,CHCTVS ;IF WE'RE WITHIN THE SCREEN AREA, + JRST DISLN5 + SKIPN RREBEG + SKIPGE CHCTNL ;IN ^R, IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLI8 ;COMPUTE THE LINBEG WORD FOR THE LINE THAT WILL FOLLOW THIS ONE: + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SKIPG Q,RRIDLB ;IF CAN INSERT/DELETE, SEE IF THAT TEXT IS PRESENT ON THE SCREEN + JRST DISLI8 + CAMN Q,T + JRST DISLI9 ;AND IF SO, MOVE IT TO THE LINE AFTER THIS ONE. + CAML T,Q ;IF WE HAVE ALREADY HACKED RRIDLB AND PASSED IT, DO NOTHING NOW. + JRST DISLI8 + SUB Q,RRIDBK ;ELSE MAYBE WE HAVE REACHED THE BLANK LINES PRECEDING RRIDLB. + SUB Q,RRIDBK + CAMG T,Q + JRST DISLI8 + SUB T,Q ;IF SO, FIGURE OUT FROM RRIDBK HOW MANY BLANK LINES REMAIN + ASH T,-1 ;TO BE PRINTED, AND FROM THAT, WHAT VPOS TO COPY RRIDLB TO. + SUB T,RRIDBK ;BUT THERE IS A FUNNY WAY TO TELL DSLID THAT. + ADDM T,RRIDVP +DISLI9: CALL DSLID + SETOM RRIDLB + MOVE BP,CHCTVP +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;DSLID CLOBBERS DISBF1! + MOVEM Q,DISBF1+1 +] +DISLI8: AOSG CHCOVP + JRST DISLI1 + AOSG ERRFL1 ;IF ERRFL1 (FS ERRFLG$) IS <0, IT IS - # LINE OF ERROR MSGS ON SCREEN, + JRST DISLI3 ;SO COUNT OFF THAT MANY LINES BEFORE OUTPUTTING. + CAMN CH,HCDS(BP) ;OUTPUT ONLY IF HASH CODE DIFFERS, + SKIPE DISFLF ;OR IF INSIST ON OUTPUTTING + JRST DISLI4 + JRST DISLI3 + +DISLN5: MOVEM BP,DISVP ;WE'RE AT BOTTOM OF SCREEN; MUST OUTPUT, SO THAT + MOVEM BP,DISVP1 ;WE WILL CALL DISMOR IF NECESSARY, BUT ARRANGE NOT TO CLEAR +DISLI4: +IFN ITS,[ + DPB BP,[DISCPV] ;PREPARE TO SET VERT. POS. + DPB BP,[DISC1V] + MOVE Q,DISCM1 ;IF SAME LINE AS BEFORE, JUST MOVE CURSOR; DON'T CLEAR. + MOVEM Q,DISBF1+1 + CAMN BP,DISVP + JRST DISLN3 + MOVE Q,DISCMV + LDB T,[DISCPH] + JUMPN T,[ ;IF NOT STARTING IN COL 0, MUST GO TO COL 0, CLEAR, THEN SET CURSOR. + MOVEM Q,DISBF1 + JRST DISLN3] + MOVEM Q,DISBF1+1 ;IF STARTING IN COL 0, JUST GO TO COL 0 AND CLEAR. + JUMPE BP,DISLN3 + MOVEI T,-1(BP) ;IF MOVING DOWN 1 LINE, AND GOING TO COL 0, DO IT WITH A %TDCRL. + MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDCRL] + CAMN T,DISVP1 + MOVEM Q,DISBF1+1 +DISLN3: +] +IFN TNX,[ + MOVEI Q,DISMOV ;ASSUME CLEAR TOO + CAMN BP,DISVP + MOVEI Q,DISMV1 ;DONT NEED TO + CALL (Q) ;SET UP DISBF1 RIGHT +] + MOVEM BP,DISVP1 ;REMEMBER WHAT LINE THE CURSOR IS ON. + JRST DISLI1 ;GO OUTPUT POSITIONING & LINE. + +DISLI0: SKIPL DISVP ;ON PRINTING TTY, + CAMN BP,DISVP ;IF NOT SAME LINE AS BEFORE, LINEFEED. + JRST DISLI1 +IFN ITS,[HRROI Q,[ASCIC/ +/] + CALL DISIOT +] +IFN TNX,CALL ECHLF2 +DISLI1: SKIPGE Q,CHCTBP ;GET THE STUFFING B.P. AND MAKE NORMALIZE IT + SUB Q,[400000,,1] ;BY CONVERTING 441000,,FOO TO 041000,,FOO-1 + CAMG BP,CHCTVS ;IF BELOW END OF SCREEN, OR + CAME Q,[041000,,DISBUF-1] ;IF NON-NULL LINE AT END OF SCREEN, + CAMGE BP,CHCTVS + JRST DISLN4 + JRST DISMOR ;GO PRINT --MORE--, COME BACK. + +DISLN4: CAMGE BP,CHCTVS ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE. STORE NEW HASHCODE. + SKIPN RGETTY + CAIA + MOVEM CH,HCDS(BP) + SETZ T, ;COUNT THE NUMBER OF UNUSED BYTES IN THE LAST WORD +DISLI2: TLNE Q,700000 ;OF THE OUTPUT BUFFER. + AOJA T,[IBP Q ? JRST DISLI2] + MOVEI Q,1-DISBF1(Q) + LSH Q,2 + SUBM Q,T ;# OF CHARS TO BE OUTPUT. + CALL DISSIOT ;OUTPUT THAT MANY CHARS STARTING AT DISBF1 +DISLI3: MOVEM BP,DISVP ;INDICATE WHERE WE HAVE PUT THE CURSOR. + MOVEI T,1(BP) + SKIPE RGETTY ;ON A DISPLAY, CONSIDER STOPPING OUTPUT BECAUSE OF INPUT AVAIL. + CAML T,CHCTVS ;AVOID BOUNDARY LOSSAGE: DON'T STOP ON --MORE-- LINE + JRST DISLN1 ;OR THE LINE BEFORE IT (WOULD SET --MORE-- LINE'S LINBEG). + SKIPN RREBEG + SKIPGE CHCTNL ;IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLN1 +;SET UP LINBEG WORD FOR LINE AFTER THIS ONE, IN CASE WE DECIDE TO STOP DISPLAYING NOW. +;IF WE DO, THE LINBEG WORD FOR THE NEXT LINE IS NECESSARY FOR STARTING UP AGAIN. + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SETZM DISFLF ;IN CASE WE EXIT, MAKE SURE DISFLF DOESN'T STAY SET. + MOVE Q,CHCTNL + CAMLE Q,RRMAXP ;IF NEXT LINE STARTS PAST THE END OF ALL CHANGES, + SKIPE RRMSNG ;AND ALL UNCHANGED LINES ARE PROPERLY ON THE SCREEN, + JRST DISLN2 + MOVE Q,LINBEG+1(BP) + ADD Q,Z ;AND WE ARE ABOUT TO DISPLAY THE SAME CHARACTERS THAT ARE ON THE LINE + SUB Q,RROLDZ ;ALREADY (TAKING INTO ACCOUNT INSERTIONS AND DELETIONS SINCE + CAMN T,Q ;OLD LINBEG WAS STORED), THEN WE NEED NOT REALLY REDISPLAY. + JRST RRDISF ;SO STOP DISPLAYING AND RETURN TO ^R. +DISLN2: AOS BP + MOVEM T,LINBEG(BP) + MOVEM BP,RRMNVP ;IF THERE IS INPUT, STOP DISPLAYING; LATER START FROM NEXT LINE. + SETZM RRMNHP ;THUS MAKE SURE REDISPLAY STARTS THIS FAR UP AT LEAST. + SKIPE DFORCE + JRST DISLN6 ;FS DFORCE$ MEANS FINISH DISPLAY EVEN IF INPUT IS WAITING. +IFN ITS,[ + SKIPE DWAIT ;FOR VERY SLOW TTYS, WAIT BETWEEN LINES SO WE STOP DISPLAYING FAST + .LISTEN T, ;WHEN THERE IS TYPE-IN. + .STATUS CHTTYI,T ;ARE CHARS AVAILABLE FOR ^R TO PROCESS? + ANDI T,2000 ;IF SO, STOP DISPLAYING AND PROCESS THEM. +] +IFN TNX,[ + SAVE A + SAVE B + MOVEI A,.CTTRM + SKIPE DWAIT ;DO DOBE ONLY IF SLOW TERMINAL + DOBE ;(DONT USE LISTEN MACRO) + SIBE ;ANY CHARACTERS FOR ^R TO PROCESS? + TDZA T,T ;YES + SETO T, ;NO + REST B + REST A +] +DISLN6: JUMPE T,[SKIPE LID ;IF DOING INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP + JRST [ SETOM RRMSNG ;SINCE THE LATTER WOULD SCREW IF THIS NEW INPUT WANTS + JRST RRDISX] ;TO INSERT OR DELETE LINES. + MOVE T,CHCTNL ;MAKE SURE NEXT REDISPLAY DOESN'T + CAMLE T,RRMAXP ;STOP BEFORE REACHING THIS FAR DOWN. + MOVEM T,RRMAXP ;WITHOUT THIS, + JRST RRDISX] ;LOSES IF TYPED QUICKLY. +DISLN1: REST BP + REST T +DISLI6: MOVE Q,CHCTHP ;REMEMBER STARTING HORIZ POS. OF NEXT LINE. +IFN ITS,DPB Q,[DISCPH] +IFN TNX,MOVEM Q,DISCPH +DISRST: MOVE Q,[441000,,DISBUF] + MOVEM Q,CHCTBP ;RE-INIT BUFFERING. + MOVEI Q,4*DISBFC-6 + MOVEM Q,DISBFC + POPJ P, + +;HERE IN REDISPLAY ON TERMINALS WITH INSERT/DELETE LINE +;WHEN WHAT'S LEFT ON THE SCREEN BELOW CURSOR IS VALUABLE, IF MOVED TO THE RIGHT PLACE. +;WE MOVE IT THERE AND THEN RESUME DISPLAYING. +;BP HAS VPOS OF LINE ABOUT TO BE OUTPUT, WHEN CALLED FROM DISLIN. +;THIS MEANS THAT FOR UPWARD MOTION WE MOVE THINGS UP TO LINES STARTING FROM 1(BP), +;WHEREAS FOR DOWNWARD MOTION WE MOVE DOWN FROM LINES STARTING FROM (BP). +;THE DISTANCE THAT LINES MOVE ACROSS IS (RRIDVP)-(BP)-1 IN EITHER CASE. +;OTHER CALLERS MUST ARRANGE BP AND RRIDVP ACCORDINGLY. +;WE CLOBBER ONLY Q. +DSLID: MOVE Q,RRIDVP ;GET OLD POSITION OF TEXT WE WANT TO MOVE UP OR DOWN. + SUBI Q,1(BP) ;Q GETS # LINES TO MOVE IT UP (OR - # TO MOVE IT DOWN). +;Q=0 IS A SPECIAL CASE- NO MOTION OF THE STUFF ON THE SCREEN IS NECESSARY! + JUMPE Q,CPOPJ ;THE NON-INSERT-DELETE MECHANISMS FOR RROLDZ WILL WIN IN THIS CASE. +IFN ITS,[SAVE 0 ;PUSH THE CURRENT CURSOR POS SO WE CAN AVOID CHANGING IT. + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,(P)] + .LOSE %LSFIL +] +.ELSE SAVE TTLPOS + SAVE Q + SAVE BP + JUMPL Q,DSLIDD +;WE WANT TO MOVE STUFF UP. + AOS BP + ADD BP,-1(P) ;CHECK FOR SCREW CASE THAT THERE REALLY AREN'T ANY USEFUL LINES + CAML BP,BOTLIN ;LEFT TO MOVE UP. IF WE DIDN'T CHECK, DSLID5 WOULD CLOBBER LOW CORE. + JRST DSLID4 + SUB BP,-1(P) + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE OF SCREEN? + JRST [CALL SCRLUP ;YES, SCROLL Q LINES UP THEN + JRST DSLID8] + CALL DELLIN ;DELETE THAT MANY LINES BELOW WHERE CURSOR IS NOW. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,-1(P) ;NOW GO THAT MANY LINES ABOVE MODE LINE (TO WHERE TEXT OF MODE LINE IS) + CALL INSLIN ;AND INSERT EMPTY LINES TO PUSH MODE LINE BACK TO RIGHT PLACE. +DSLID8: MOVE Q,(P) + AOS BP,Q ;Q GETS NEW VPOS OF UPPERMOST LINE MOVED UP. + ADD BP,-1(P) ;BP GETS THE VPOS IT CAME FROM. + SAVE A +DSLID5: MOVE A,LINBEG(BP) ;COPY UP THE LINBEGS FOR THE LINES MOVED UP. + MOVEM A,LINBEG(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + AOS BP + AOS Q + CAMGE BP,BOTLIN ;STOP WHEN BP POINTS AT THE WINDOW END, WHICH WASN'T MOVED UP. + JRST DSLID5 + REST A +DSLID6: SETZM HCDS(Q) ;ZERO THE HASH CODES FOR THE INSERTED BLANK LINES. + AOS Q + CAMGE Q,BOTLIN + JRST DSLID6 + SETOM RRMSNG ;NOW, WE MUST THINK ABOUT DISPLAYING ALL THE WAY TO END OF WINDOW, + ;SO THAT WE WILL FILL THOSE BLANK LINES WITH WHAT BELONGS THERE. +DSLID3: MOVE BP,-2(P) ;NOW RESTORE CURSOR TO POSITION IT HAD ON ENTRY TO DSLID. + CALL SETCUR +DSLID4: REST BP ;SO THAT WE FILL IN THOSE BLANK LINES. + REST Q + JRST POP1J + +;HERE TO MOVE TEXT DOWNWARD. +DSLIDD: MOVMS -1(P) ;GET POSITIVE # OF LINES TO MOVE DOWN. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,BP + SOS Q + CAMG Q,(P) ;DETECT FUNNY CASE WHERE THE NUMBER OF LINES LEFT IS LESS THAN + JRST DSLID4 ;THE DISTANCE DOWN WE MUST MOVE THEM. GIVE UP IN THAT CASE. + MOVE Q,-1(P) + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE? + JRST [MOVE BP,(P) ;YES, GET TOP LINE AGAIN + CALL SCRLDN ;SCROLL Q LINES DOWN + JRST DSLID9] + CALL DELLIN ;FIRST, DELETE SOME LINES JUST ABOVE THE MODE LINE. + MOVE BP,(P) + MOVE Q,-1(P) + CALL INSLIN ;THEN, INSERT THE SAME NUMBER JUST BELOW THIS LINE. +DSLID9: MOVE Q,BOTLIN + SOS Q + MOVE BP,Q + SUB BP,-1(P) + SAVE A + SAVE LINBEG+1(BP) ;REMEMBER LINBEG OF FIRST LINE THAT MOVES OFF SCREEN BOTTOM. +DSLID1: MOVE A,LINBEG(BP) ;COPY DOWN THE LINBEGS FOR THE LINES MOVED DOWN. + MOVEM A,LINBEG(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + SOS BP + SOS Q + CAML BP,-2(P) ;STOP AFTER MOVING THE HIGHEST LINE TO BE MOVED. + JRST DSLID1 +DSLID7: MOVE A,LINBEG+1(BP) ;FILL THE LINBEGS OF THE NEWLY CREATED BLANK LINES WITH + MOVEM A,LINBEG(Q) ;SOMETHING MEANINGFUL: THE LINBEG OF THE FIRST FOLLOWING LINE. + SETZM HCDS(Q) ;CLEAR THE HASHCODES OF THE NEWLY MADE BLANK LINES. + CAIE Q,1(BP) + SOJA Q,DSLID7 + REST A ;GET BACK LINBEG OF LINE MOVED OFF BOTTOM OF SCREEN. + SKIPN DFORCE ;DFORCE => MODE LINE SHOULD NOT BE UPDATED BY THIS REDISPLAY. + SKIPE RRMSNG ;IF RRMSNG IS SET THEN THE LINBEGS AREN'T EVEN VALID FOR + JRST DSLID2 ;WHAT FOLLOWS, BUT SOMEONE ELSE WILL HANDLE IT. + SKIPN RRMORF + CAMN A,RROLZV ;IF THERE WAS DISPLAYED TEXT ON THAT LINE, + JRST DSLID2 + MOVE A,MORESW ;THEN THE MODE LINE SHOULD SAY --MIDDLE-- OR --TOP-- NOW. + TRON A,MS%DWN ;IF IT ISN'T ALREADY RIGHT, + SETZM DISOMD ;MAKE SURE THAT IT WILL BE REDISPLAYED + MOVEM A,MORESW ;SAYING THE RIGHT THING. + TRNN A,MS%UP ;THIS INCLUDES FIGURING OUT THE % ABOVE SCREEN + JRST DSLID2 + CALL DISMO6 ;IF STUFF WAS OFF THE TOP ALREADY AND NOW ALSO OFF THE BOTTOM. + HRLM A,MORESW +DSLID2: REST A + JRST DSLID3 + +SUBTTL HANDLE BOTTOM-OF-SCREEN CONDITION + +;PRINT --MORE--, GO BACK TO DISLI3 IF FLUSHED, ELSE TO DISLI7. +;IN ^R MODE, EXIT RESTORING P FROM DISPRR. +DISMOR: SKIPGE ERRFLG + JRST DISLN1 + SKIPN RREBEG + JRST [ MOVE P,DISPRR ;IN ^R MODE: WE WANT TO POP BACK TO ^R PDL LEVEL. + SKIPN RGETTY ;^R MODE ON PRINTING TTY: WE'RE ALREADY IN POSITION. + RET + MOVEI T,MS%DWN ;^R ON DISPLAY: CHOOSE AMONG --TOP--, --MIDDLE-- + SKIPE GEA + TRO T,MS%UP + SKIPE RRMORF ;AND --MORE-- IF FS ^R MORE IS > 0. + MOVEI T,MS%MOR + SKIPGE RRMORF ;USE NONE AT ALL IF FS ^R MORE IS < 0. + SETZ T, + SETZ A, + TRNE T,MS%UP ;IF NOT SAYING --MORE-- AND HAVE TEXT ABOVE AND BELOW SCREEN, + CALL DISMO6 ;COMPUTE FRACTION OF TEXT ABOVE + HRLM A,T ;AND INCLUDE THAT IN THE MODE LINE. + JRST DISMD] ;UPDATE --MORE-- LINE AND RETURN TO ^R. + SKIPN RGETTY + JRST DISMO3 ;ON PRINTING TTY, JUST ASSUME FLUSHED. + MOVEI T,8 ;ON DISPLAY, MUST DO THE POSITIONING THAT DISLIN DIDN'T DO. + CAMG BP,USZ + CALL DISSIOT + SKIPN ORESET + SKIPE MORFLF + JRST DISLI3 ;ALREADY FLUSHED. + SETZM MORESW + MOVEI T,MS%MOR ;REDISPLAY --MORE-- LINE AND PUT --MORE-- ON IT. + CALL DISMD + SKIPGE CTLCF ;^C IMPLIES FLUSH IT. + JRST DISMO2 + TTYACT +IFN TNX,[SAVE ECHOF2 + SETZM ECHOF2] ;DONT ECHO IT NOW + PUSHJ P,TYINH +IFN TNX,REST ECHOF2 + CAIN CH,40 ;READ A SPACE => + JRST [ PUSHJ P,DISTOP ;TOP OF SCREEN, THEN TRY AGAIN. + SKIPL VREMEM ;IF DISPLAYING STUFF THAT'S IN BUFFER, + JRST DISLI7 + MOVE Q,CHCTBL ;REMEMBER WHERE THIS SCREENFULL STARTED, + SUB Q,BEGV ;NEXT BUFFER DISPLAY WILL TRY TO START AT SAME PLACE. + MOVEM Q,GEA + JRST DISLI7] + CAIE CH,177 ;ELSE RE-READ UNLESS RUBOUT. + MOVEM CH,UNRCHC + HRRZM P,MORFLF + CAIE CH,177 ;SET MORFLF (FS FLUSHED$) TO NONZERO, POSITIVE IFF RUBOUT. +DISMO2: SETOM MORFLF + DISSTR /-FLUSHED/ + PUSHJ P,DISIOT ;PUT FLUSHED ON THE --MORE-- LINE + MOVEI T,MS%FLS + MOVEM T,MORESW ;AND REMEMBER THAT THAT IS WHAT'S THERE. +IFN TNX,[SKIPE ECHOF2 + CALL ECHOCH] ;ECHO IT NOW + JRST DISLI3 + +DISMO3: SETOM MORFLF + JRST DISLI3 + +;A GETS PERCENT OF BUFFER ABOVE START OF WINDOW. +DISMO6: SAVE B + MOVE A,GEA + ADD A,BEGV + SUB A,BEG ;GET WINDOW START REL. TO BEG. + MOVE B,Z + SUB B,BEG ;GET Z REL. TO BEG. + IMULI A,100. + IDIV A,B ;A GETS WINDOW AS PERCENT OF Z. +POPBJ: REST B + RET + +SUBTTL INITIALIZE DISPLAY OUTPUT + +;INIT FOR DISPLAY OUTPUT. +DISINI: SETOM TYOFLG ;"TYPEOUT" NO LONGER INITTED. + SETOM ECHCHR ;IF ^R COMMAND DOES DISPLAYING IT SHOULDN'T BE ECHOED ON PRINTING TTY. + MOVE Q,QRB.. + SETOM .QVWFL(Q) +DISIN0: SETZM VREMEM +DISTO1: PUSHJ P,CHCTI0 ;INIT FOR CHCT. + MOVEI Q,DISLIN ;TELL IT TO CALL DISLIN EACH LINE. + MOVEM Q,CHCTAD + PUSHJ P,DISLI6 ;INIT. BUFFERING. + +;MOVE TO TOP OF SCREEN. +DISTOP: AOSN PJATY + JRST [ CALL CTLL1 + JRST DISTO1 ] ;REINIT IN CASE FS REDISPLAY$ DID SOME TYPEOUT. + SETZM MORFLF ;UNDO A FLUSHED. + SETZM OLDFLF + SETOM DISVP + SETZM DISVP1 + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPN RGETTY + JRST [ SETZM TOPLIN + SKIPE RUBENC ;ON PRINTING TTY, NORMALLY ADVANCE TO CLEAN LINE, + JRST RUBEND ;BUT DO SOMETHING SPECIAL IF WAS PREARRANGED. + JRST CRIF] + SAVE C + MOVE C,NLINES ;SET UP WINDOW SIZE FROM USER-SETTABLE FLAGS (LINES AND TOPLINE). + CALL WINSET + REST C + MOVE Q,TOPLIN + MOVEM Q,CHCTVP + MOVE Q,BOTLIN + SKIPN RGETTY + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPGE ERRFL1 + RET + JRST HOMCUR ;BRING CURSOR TO TOP LEFT. + +;START "TYPEOUT" AT TOP OF SCREEN. +DISTOT: SETOM TYOFLG ;FORCE RE-INIT. + +;INIT FOR TYPEOUT, PREVENT BUFFER DISPLAY. +;ALL TYPEOUT ROUTINES MUST COME HERE. +DISINT: MOVE Q,QRB.. + SETOM .QVWFL(Q) + SETOM ECHCHR ;IF ^R COMMAND DOES TYPEOUT IT SHOULDN'T BE ECHOED ON PRINTING TTY. + AOSN TYOFLG ;IF NO PREVIOUS TYPEOUT, + JRST DISIN0 + SKIPE RUBENC + CALL RUBEND + RET + +CTLL: SKIPLE CLRMOD ;SCREEN-CLEARING MAY BE DISABLED. + RET + MOVE Q,QRB.. + SETZM .QVWFL(Q) ;ALLOW BUFFER DISPLAY. + SETOM TYOFLG ;NEXT TYPEOUT WILL START AT TOP OF SCREEN. + SETOM GEA ;ALLOW NEW TEXT WINDOW TO BE CHOSEN. + SETZM MORFLF ;FLUSHING A --MORE-- DOESN'T LAST PAST CLEARING THE SCREEN. + SETZM OLDFLF + SKIPGE PJATY + JRST CTLL1 + SKIPE RGETTY + SKIPN NLINES ;IF NOT USING WHOLE SCREEN FOR WINDOW NOW, + SKIPE TOPLIN ;CLEAR JUST WHAT'S IN THE WINDOW. + JRST CTLL2 + +;HERE TO DO A REAL CLEAR-SCREEN. +CTLL1: SETZM PJATY ;HERE TO CLEAR WHOLE SCREEN. + SETZM MORESW ;BE AWARE THAT --MORE-- IS BEING ERASED. + SETZM ECHACT ;ECHO AREA IS NOW CLEAR. + CALL CLRSCN + SETOM RROVPO ;SHOW RRTTY THAT IT NEEDN'T ECHO THE COMMAND. + SETOM DISOMD ;REDISPLAY THE "MODE" ON THE --MORE-- LINE. + SETZM HCDS ;SET HASH CODES TO 0 + MOVE Q,[HCDS,,HCDS+1] + BLT Q,HCDSE-1 ;SINCE 0 IS CODE FOR A NULL LINE + SKIPN REFRSH ;IF USER HAS A REFRESH ROUTINE, RUN IT. + RET + CALL SAVACS ;SAVING ALL ACS, AND DOING A (-) AROUND IT. + MOVE A,REFRSH + CALL MACXCP + JRST RSTACS + +CTLL2: SKIPE RGETTY ;ON DISPLAYS, EFFECTIVELY CLEAR ECHO AREA WITH A CR. + CALL ECHOCR + CALL DISINI ;CLEAR WINDOW AREA BY DOING A "BUFFER DISPLAY" OF NO CHARACTERS. + CALL DISCLR ;NOW "REST OF SCREEN", MEANING ALL OF WINDOW. + MOVE Q,QRB.. + SETZM .QVWFLA(Q) + RET + +;"CLOSE" A BUNCH OF DISPLAY OUTPUT - CLEAR LINES FROM CURSOR TO END OF WINDOW. +DISCLG: CAME IN,PT + JRST DISCL3 + SKIPN RREBEG + CALL RRDIS1 +DISCL3: SETZM VREMEM + SETOM TYOFLG ;FORCE NEXT TYPEOUT TO CALL DISINT + CALL DISFLS ;FORCE OUT ANY INCOMPLETE LINE. + SKIPN ORESET + SKIPE MORFLF ;IF WE WERE FLUSHED AT A --MORE--, JUST UN-FLUSH. + RET + SKIPN RGETTY ;ELSE, ON DISPLAY TTY, CLEAR REST OF SCREEN + RET + AOS CHCTVP + CALL DISCLR ;CLEAR OUT REST OF LINES IN DISPLAY AREA. +;MAKE SURE THE --MORE-- LINE DOESN'T SAY "--MORE--", AND HAS THE +;CORRECT MODE DISPLAYED ON IT. +DISCLJ: MOVEI T,MS%UP + SKIPE GEA ;FIGURE OUT WHETHER WE WANT AN EMPTY --MORE-- FIELD, OR A --BOT--. + SKIPE RREBEG + SETZ T, + SKIPE RRMORF + SETZ T, + JRST DISMD ;AND UPDATE THE --MORE-- LINE IF IT ISN'T WHAT WE WANT. + +;CLEAR LINES FROM CHCTVP DOWN TO END OF DISPLAY AREA. +DISCLR: MOVE BP,CHCTVP + CAML BP,CHCTVS ;STOP CLEARING AT END OF WINDOW, OR END OF SCREEN. + RET + MOVEM IN,LINBEG(BP) ;ABOUT TO CLEAR A LINE: SET ITS LINBEG TO END OF BUFFER. + SKIPN HCDS(BP) ;LINE ALREADY CLEAR => DON'T CLEAR IT. + JRST DISCL1 + SETZM HCDS(BP) ;CLEAR A LINE BY CLEARING THE HASH CODE, + HRLZS BP ;MOVING TO THE LINE + CALL SETCU1 + CALL CLREOL ;AND CLEARING VIA THE SYSTEM. +DISCL1: AOS CHCTVP + JRST DISCLR + +;,FS TYO HASH$ SETS HASH CODE OF LINE. +FSHCD: TRZN FF,FRARG + TYPRE [AOR] + MOVE E,SARG + SKIPL C ;REQUIRE VPOS TO BE IN RANGE. + CAML C,USZ + TYPRE [AOR] + MOVE A,HCDS(C) + TRZE FF,FRARG2 + MOVEM E,HCDS(C) + JRST POPJ1 + +SUBTTL MODE LINE DISPLAY + +FRCMD: TRZE FF,FRCLN + JRST CLRMOR ;:FR => CLEAR THE MORE LINE ENTIRELY. + SKIPN RGETTY ;FR => ON PRINTING TTY, MAYBE TYPE OUT THE MODE. + JRST DISMDP ;FOR IMPLICIT FR'S SUCH AS FI AND ^R, WE NEVER DO THAT. +;REDISPLAY THE MODE LINE AND RETURN CURSOR TO WHERE IT IS, +;PROVIDED THERE IS NO INPUT AVAILABLE. +DISMDI: MOVE Q,$QMODE ;UPDATE MODE DISPLAY IF IT IS NECESSARY + SKIPN RGETTY ;ON PRINTING TTY, WE DISPLAY IT DIFFERENTLY. + RET + MOVE T,PFINI + SUB T,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES T + CAMG T,MODCHG ;IF FS MODE CHANGE$ LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF FS MODE CHANGE$ IS POS, WE MUST RUN FS MODE MAC$ + JRST .+3 + CAMN Q,DISOMD + RET + SKIPN TYISRC + SKIPL UNRCHC + RET + LISTEN Q, + JUMPN Q,CPOPJ ;DON'T UPDATE MODE LINE IF INPUT AVAILABLE. + MOVE T,MORESW ;DON'T CHANGE THE --MORE-- OR WHATEVER, + CAIN T,MS%FLS ;EXCEPT GET RID OF A "FLUSHED". + MOVEI T,MS%MOR +IFN ITS,[ + HRROI Q,[ASCIC/S/] ;AVOID CLOBBERING CURSOR POSITION. + CALL DISIOT + CALL DISMD ;NO INPUT: DISPLAY THE NEW "MODE" + HRROI Q,[ASCIC/R/] + JRST DISIOT +] +IFN TNX,[ + SAVE B + MOVE B,TTLPOS ;MOVE CURSOR BACK WHERE IT WAS BEFORE + CALL DISMD + JRST SETCU3 +] + +DISMDP: SKIPN SHOMOD ;ONLY DISPLAY MODE ON PRINTING TTY IF FS SHOWMODE$ IS SET. + RET + MOVEM Q,DISOMD ;AND THEN ALWAYS SHOW IT EVEN IF HAVE INPUT. + CALL CRIF ;GET FRESH LINE + CALL DISMD2 ;TYPE OUT MODE + JRST CRIF ;AND ANOTHER NEW LINE + +;UPDATE, IF NECESSARY, THE "MODE" DISPLAYED ON THE --MORE-- LINE. +;THE "MODE" IS A TEXT STRING STORED IN Q..J. THE CONTENTS OF THAT QREG ARE +;ALWAYS VISIBLE ON THE --MORE-- LINE. THE IDEA IS FOR THE USER TO BE +;ABLE TO TELL IMMEDIATELY WHAT MODE HE IS IN (WHERE THE MODES ARE DEFINED +;BY HIS MACROS PACKAGE). +;T SHOULD HAVE THE DESIRED MORESW VALUE SAYING WHETHER WE WANT --MORE-- OR --TOP-- OR WHAT. +DISMD: MOVE Q,PFINI + SUB Q,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES Q + CAMG Q,MODCHG ;IF FS MODE CHANGE$ IS LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF IT IS POSITIVE, WE MUST RUN IT TOO. + CALL [ + CALL SAVACS + SETZM MODCHG ;CLEAR THE FLAG. + SETZB C,E ;PASS 0 AS ARG TO USER'S MACRO. + SKIPE A,MODMAC + CALL MACXCP ;CALL USER'S MACRO TO RECOMPUTE IT + JRST RSTACS] + CAME T,MORESW ;IF THE DESIRED STATE OF --MORE-- OR NOT IS CHANGED, + JRST DISMD9 + MOVE Q,$QMODE ;OR THE DESIRED MODE STRING IS CHANGED, WE MUST REDISPLAY THE LINE. + CAMN Q,DISOMD + RET +DISMD9: SKIPN RGETTY ;NO MODE IS SHOWN ON PRINTING TTY'S. + RET + SKIPE DFORCE ;DON'T UPDATE MODE IF FS D FORCE$ IS SET. + RET +DISMD2: MOVE Q,$QMODE + MOVEM Q,DISOMD +INSIRP PUSH P,A B TT TT1 BP CH + MOVE A,Q + CALL CLRMOR ;CLEAR THE WHOLE --MORE-- LINE. + SETOM RROHPO ;REMEMBER THAT I.T.S. CURSOR POS. IS BEING CLOBBERED. + SETOM RROVPO + CALL QLGET0 + JRST DISMD1 ;MODE STRING IS NULL? + MOVE TT,NHLNS ;NO => TRUNCATE IT IF TOO BIG TO A SIZE THAT WILL FIT + SKIPE T + SUBI TT,7 ;TOGETHER WITH THE --TOP-- OR WHATEVER. + TRNE T,MS%MOR ;OR, IF IT MIGHT BE --MORE---FLUSHED, + SUBI TT,9 ;LEAVE ROOM FOR THAT. + CAML B,TT + MOVE B,TT +DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, OR AS MANY CHARS OF IT AS B SAYS. + ILDB CH,BP +IFN ITS,[ ;OUTPUT WITH %TJECH SET SO CTL CHARS DON'T COME OUT IN IMAGE MODE. + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +.ELSE CALL TYOINV + JRST DISMD3 + +DISMD1: +INSIRP POP P,CH BP TT1 TT B A + MOVEM T,MORESW + JUMPE T,CPOPJ ;IF WE ARE SUPPOSED TO HAVE --MORE-- OR SOMETHING, WRITE IT. + SKIPN RGETTY + RET + TLNN T,-1 ;IF % ABOVE SCREEN IN LH IS NONZERO, PRINT THAT. + CAIN T,3 ;IF IN MIDDLE OF BUFFER BUT PERCENT IS 0, PRINT 1%. + JRST DISMD5 + CAIL T,5 ;WE SHOULDN'T GET HERE WANTING TO DISPLAY --MORE--FLUSHED! + .VALUE + MOVE Q,DISMD4-1(T) +IFN ITS,HRLI Q,-2 +IFN TNX,HRLI Q,-1 + JRST DISIOT + +DISMD4: +IFN ITS,[ + [ASCIC *--BOT--*] + [ASCIC *--TOP--*] + 0 + [ASCIC /--MORE--/] +] +IFN TNX,[ + [ASCIZ *--BOT--*] + [ASCIZ *--TOP--*] + 0 + [ASCIZ /--MORE--/] +] + +;OUTPUT --NN%-- WHERE N IS IN LH(T). +DISMD5: DISSTR /--/ + CALL DISIOT + SAVE CH + HLRZ CH,T + SKIPN CH ;PRINT 01% INSTEAD OF 00%, SINCE 00% WHEN NOT AT TOP + MOVEI CH,1 ;MIGHT BE PARADOXICAL. + IDIVI CH,10. + ADDI CH,"0 + CALL TYOINV + MOVEI CH,"0(Q) + CALL TYOINV + REST CH + DISSTR /%--/ + JRST DISIOT + +SUBTTL CURSOR CONTROL SUBROUTINES + +IFN ITS,[ +;SCROLL Q LINES UP AND DOWN AT VPOS IN BP +SCRLUP: +SCRLDN: .VALUE ;ITS DOESNT SUPPORT THIS YET. + +;DELETE # OF LINES IN Q AT VPOS IN BP. +DELLIN: SAVE [%TDDLP] + JRST DELLI1 + +;INSERT # LINES IN Q AT VPOS IN BP. +INSLIN: SAVE [%TDILP] +DELLI1: SAVE [440800,,DISBF1] ;ACCUMULATE STRING IN DISBF1. + SAVE A + MOVEI A,%TDMV0 ;FIRST A COMAND TO SET DESIRED VPOS, AND HPOS 0. + IDPB A,-1(P) + IDPB BP,-1(P) + SETZ A, + IDPB A,-1(P) + MOVEI A,3 ;IF INSERTING/DELETING 0 LINES, JUST MOVE THE CURSOR. + JUMPE Q,DELLI2 ;DON'T PUT IN A %TDILP OR %TDDLP. + MOVE A,-2(P) ;THEN A COMMAND TO INSERT OR DELETE + IDPB A,-1(P) + IDPB Q,-1(P) ;THE SPECIFIED NUMBER OF LINES. + MOVEI A,5 +DELLI2: MOVE Q,[441000,,DISBF1] ;THEN OUTPUT THE STRING. + SYSCAL SIOT,[%CLIMM,,CHSIO ? Q ? A] + .LOSE %LSFIL + REST A + SUB P,[2,,2] + RET + +;OUTPUT C(T) CHARS STARTING AT DISBF1, WITH SUPER-IMAGE SIOT. +DISSIOT:MOVE Q,[441000,,DISBF1] +DISLI5: ILDB CH,Q ;SKIP ALL %TDNOP'S AT THE BEGINNING. + CAIN CH,%TDNOP + SOJG T,DISLI5 + JUMPE T,CPOPJ ;NO CHARS REALLY NEED TO BE SENT => RETURN. + ADD Q,[100000,,] + MOVEI CH,CHSIO + SKIPN RGETTY ;ON PRINTING TTYS, DON'T USE SUPER-IMAGE MODE. + MOVEI CH,CHTTYO +DISSI1: SYSCAL SIOT,[CH ? Q ? T] + .LOSE %LSFIL + SKIPN RGETTY + RET + MOVE Q,NHLNS + CAML Q,CHCRHP + MOVE Q,CHCRHP + SYSCAL SCPOS,[CH ? BP ? Q] + .LOSE %LSFIL + RET + +;MOVE CURSOR AND TELL ITS WHERE IT IS. ON A PRINTING TTY, DON'T ACTUALLY CHANGE +;THE VERTICAL POSITION, IN CASE THE TTY IS A STORAGE TUBE. CLOBBERS BP AND Q. +SETCU1: SKIPE RGETTY + JRST SETCU2 + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,Q] + .LOSE %LSFIL + HLL BP,Q +SETCU2: CALL SETCUR + HLRZ Q,BP + ANDI BP,-1 + SYSCAL SCPOS,[%CLIMM,,CHTTYO ? Q ? BP] + .LOSE %LSFIL + RET + +;MOVE CURSOR USING SUPERIMAGE MODE TO POSITION SPECD AS VPOS,,HPOS IN BP. +;CLOBBERS Q. +SETCUR: SAVE BP + SAVE [441000,,DISBF1] + SAVE A + MOVEI A,%TDMV0 + IDPB A,-1(P) + HLRZ Q,BP + IDPB Q,-1(P) + IDPB BP,-1(P) + MOVEI A,3 + JRST DELLI2 + +ECHOCR: .IOT CHECHO,[^M] + RET + +CLRSCN: HRROI Q,[ASCIC/C/] + JRST DISIOT + +HOMCUR: HRROI Q,[ASCIC/T/] + JRST DISIOT + +ERSCHR: HRROI Q,[ASCIC/K/] + JRST DISIOT + +INSCHR: HRROI Q,[ASCIC/^/] + JRST DISIOT +DELCHR: HRROI Q,[ASCIC/_/] + JRST DISIOT + +CRIF: HRROI Q,[ASCIC /A/] + JRST DISIOT + +CLRMOR: SKIPA Q,[-2,,MORMCL] ; MAYBE THIS SHOULD BE -3? +CLREOL: HRROI Q,[ASCIC/L/] +DISIOT: .IOT CHDPYO,Q + RET + +;IMMEDIATE TYPEOUT, NO HASH-CODING. +TYOINV: .IOT CHTTYO,CH + POPJ P, +] ;IFN ITS + +IFN TNX,[ +;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS. + +;THE TTYTYP TABLE TRANSLATES TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES. +;THEY ARE: 0 => PRINTING TERMINAL, 1 => DM2500, 2 => H1500, 3 => VT52, +; 4 => DM1520, 5 => IMLAC, 6 => VT05, 7 => TK4025, 10 => VT61, +; 11 => TL4041, 12 => FOX, 13 => HP2645, 14 => I400, 15 => TK4023, +; 16 => ANNARB, 17 => C100, 20 = IQ120, 21 => VT100, 22 => I100, +; 23 => TL1061. +;VARIOUS TABLES ARE INDEXED BY THE INTERNAL TECO TYPE CODE, WHICH LIVES IN RGETTY. +NTTYPE==30. ;1+ LARGEST TWENEX TERMINAL TYPE. SIZE OF TTYTYP TABLE. + +DEFINE DEFTYP TYPE,TABLE +IF1 [ IFNDEF TYPE,[ +PRINTX \GTTYP index for TYPE = \ +.TTYMAC FOO +IFB FOO,TYPE==0 +.ELSE TYPE==FOO +IFG TYPE-NTTYPE+1,.ERR TTYTYP TABLE ISNT LARGE ENOUGH FOR THAT +TERMIN +]] +IF2 [ +IFNDEF %%TYPE,%%TYPE==0 +%%TYPE==%%TYPE+1 +IFN TYPE,[ +%%TMP==. +LOC TTYTYP+TYPE +%%TYPE +LOC %%TMP +]] +IFN TYPE,TABLE +.ELSE 0 +TERMIN + +TTYTBS: PRINTB ;DEVICE DEPENDANT ROUTINE DISPATCH TABLE, INDEXED BY RGETTY +DEFTYP DM2500,DM25TB +DEFTYP H1500,HZ15TB +DEFTYP VT52,VT52TB +DEFTYP DM1520,DM15TB +DEFTYP IMLAC,IMLCTB +DEFTYP VT05,VT05TB +DEFTYP TK4025,TK40TB +DEFTYP VT61,VT61TB +DEFTYP TL4041,TL40TB +DEFTYP FOX,FOXTB +DEFTYP HP2645,HPTB +DEFTYP I400,I400TB +DEFTYP TK4023,TK43TB +DEFTYP ANNARB,AATB +DEFTYP C100,C100TB +DEFTYP IQ120,IQ12TB +DEFTYP VT100,VT10TB +DEFTYP I100,I100TB +DEFTYP TL1061,TL40TB + +VT52I==3 ;INDEX FOR VT52 AS OPPOSED TO VT61, VT100, TELERAYS, ETC. +TL106I==23 ;INDEX FOR TL1061 AS OPPOSED TO TL4041. + +TTYTYP: BLOCK NTTYPE ;INTERNAL TYPE (RGETTY), INDEXED BY GTTYP TYPE + +PRINTB: 377777,,79. ;PRINTING TERMINAL DISPATCH VECTOR + (%TOOVR+%TOMVB+%TOLWR) +REPEAT 4,JFCL + SETZM MORMCL +REPEAT 7,JFCL + +;SET CURSOR POSITION TO VPOS,,HPOS IN 2 +CURPOS: SETOM ECHOP +CURPS0: SAVE B ;SAVE DESIRED POSITION + CALL CURPS1 ;DO WORK FIRST + REST TTLPOS + RET +CURPS1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CURSOR POSITIONING + T,,2 ;ENTRY 2 IN DEVICE TABLE + +;DISPATCH BY RGETTY INTO TABLE INDEXED BY POINTER AFTER CALLER +DDPYTB: SAVE T + MOVE T,RGETTY ;GET INTERNAL TERMINAL TYPE + MOVE T,TTYTBS(T) ;GET DISPATCH VECTOR + XCT @(A) ;CALL APPROPRIATE ROUTINE + REST T + JRST CPOP1J + +;CLEAR TO END OF LINE +CLREOL: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOL + T,,3 ;ENTRY 3 IN TABLE + +;CLEAR TO END OF SCREEN +CLREOS: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOS + T,,4 ;ENTRY 4 IN TABLE + +;CLEAR SCREEN +CLRSCN: SAVE A + SETZM TTLPOS ;SAY WE ARE AT HOME + SETOM ECHOP + MOVE A,ECHOL0 ;FIRST LINE OF ECHO AREA + HRLZM A,ECHOPS ;RESET ECHO POSITION + JSP A,DDPYTB + T,,5 ;CLEAR SCREEN ENTRY 5 IN TABLE + +;INSERT LINES +INSLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT LINE + T,,11 ;ENTRY 11 IN TABLE + +;DELETE LINES +DELLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE LINE + T,,12 ;ENTRY 12 IN TABLE + +;INSERT CHARACTERS +INSCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT CHAR + T,,13 ;ENTRY 13 IN TABLE + +;DELETE CHARACTERS +DELCHR: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE CHAR + T,,14 ;ENTRY 14 IN TABLE + +;SET UP MORMCL TO CLEAR LINE AT VPOS IN C +MCLSET: SAVE A + JSP A,DDPYTB ;DISPATCH FOR MORE LINE SETUP + T,,6 ;ENTRY 6 IN TABLE + +;SET UP DISBF1 TO CLEAR LINE FIRST +DISMOV: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMOV + T,,7 ;ENTRY 7 IN TABLE + +;DONT CLEAR IT, JUST GO THERE +DISMV1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMV1 + T,,10 ;ENTRY 10 IN TABLE + +;TAKE TERMINAL OUT OF DISPLAY MODE +DPYRST: SAVE A + JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET + T,,15 ;ENTRY 15 IN TABLE + +;SCROLL Q LINES UP +SCRLUP: SAVE A + JSP A,DDPYTB + T,,16 + +;SCROLL Q LINES DOWN +SCRLDN: SAVE A + JSP A,DDPYTB + T,,17 + +;LOW LEVEL INTERFACES TO DEVICE DEPENDANT ROUTINES + +DISSIO: JSR SAV123 ;SAVE ACS + MOVE B,[441000,,DISBF1] +DISSI2: ILDB CH,B + JUMPN CH,DISSI3 ;FLUSH INITIAL NULLS + SOJG T,DISSI2 + JRST DISSI4 ;NOTHING TO DO +DISSI3: MOVEI A,.PRIOU + ADD B,[100000,,0] ;MAKE BYTE POINTER + MOVNI C,(T) ;NUMBER OF CHARACTERS TO OUTPUT + SOUT + SETOM ECHOP ;NO LONGER IN ECHO AREA IF WE WERE + SKIPN RGETTY ;DONE IF PRINTING + JRST DISSI4 + MOVE B,NHLNS + CAML B,CHCRHP + MOVE B,CHCRHP ;UPDATE HORIZONTAL POSITION + HRLI B,(BP) + MOVEM B,TTLPOS ;UPDATE CURSOR POSITION +IFN TK4025\ANNARB,[ + MOVE A,RGETTY ;HAVE TO KLUDGE CLEOL +IFN TK4025,[ + CAIN A,7 .SEE TTYTYP ; FOR 4025S + JRST DISSTK +] +IFN ANNARB,[ + CAIN A,16 .SEE TTYTYP + JRST DISSTK +] +] ;TK4025\ANNARB + +POP321: +DISSI4: REST C +POP21J: REST B + REST A + RET + +IFN TK4025\ANNARB,[ +DISSTK: SKIPN EOLFLG ;POSTPONED CLEARING NEEDED? + CALL CLREOL ;YES, FAKE IT + JRST POP321 +] ;TK4025\ANNARB + +;SET CURSOR POS TO VPOS,,HPOS IN BP. CLOBBERS AT MOST Q. +SETCU1:: +SETCUR: SKIPN RGETTY ;ON PRINTING TERMINAL + JRST SETCU2 ;USE BS OR SPACE TO DO WHAT WE CAN + SAVE B ;SAVE ACS + MOVE B,BP ;GET DESIRED POSITION +SETCU3: CALL CURPOS ;GO THERE +CPOP2J: REST B + RET + +SETCU2: SAVE A ;HANDLE "CURSOR MOTION" ON PRINTING TTY + TRNN BP,-1 ;MOVE TO START OF LINE? + JRST [MOVEI A,^M ;YES, DO IT FAST + PBOUT + JRST CPOP1J] + SAVE B + MOVEI A,.PRIOU + RFPOS ;GET CURRENT POSITION + ANDI B,-1 ;SHOULD ONLY BE ASKED TO HANDLE HORIZ MOTION + SUBI B,(BP) ;GET DIFFERENCE + JUMPE B,POP21J ;ALREADY THERE, NOTHING TO DO + MOVEI A,^H ;USE BS IF MOVING LEFT + JUMPL B,[MOVMS B ;BUT IF MOVING RIGHT + MOVEI A,40 ;USE SPACE + JRST .+1] + PBOUT + SOJG B,.-1 + JRST POP21J + +;RETURN CURSOR TO UPPER LEFT CORNER OF SCREEN. +HOMCUR: SAVE B + SETZ B, + CALL CURPOS + JRST CPOP2J + + +;CLEAR THE MORE LINE, SMASH ONLY Q +CLRMOR: MOVE Q,RGETTY ;GET TTY TYPE +IFN VT05,[ + CAIN Q,6 ;HAS NULLS IN IT? + JRST CLRMO6 ;YES, MUST USE SOUT THEN +] +IFN TK4025,[ + CAIN Q,7 ;NEEDS SPECIAL HACKING? + JRST CLRMO7 +] +IFN ANNARB,[ + CAIN Q,16 + JRST CLRM16 +] +IFN C100,[ + CAIN Q,17 + JRST CLRM17 +] + HRROI Q,MORMCL ;OTHERWISE JUST FALL THRU WITH WHAT WAS SETUP + +;OUTPUT ASCIZ STRING Q POINTS AT. +DISIOT: EXCH A,Q + PSOUT + EXCH A,Q + RET + +;ITS-STYLE ASCII MODE OUTPUT. +TYOINV: SKIPN RGETTY ;SIMPLE ON PRINTING TERMINAL + JRST [EXCH A,CH + PBOUT + EXCH A,CH + RET] + SAVE A + SAVE B + MOVEI A,.PRIOU + MOVE B,TTLPOS + CAIN CH,^I + JRST [ADDI B,10 ;TAB - MOVE TO NEXT TAB STOP + TRZ B,7 + CALL CURPS0 + JRST POP21J] + CAIN CH,^J + ADD B,[1,,0] ;LF - MOVE TO NEXT LINE + CAIN CH,^M + TRZ B,-1 ;CR - MOVE TO START OF LINE + EXCH B,CH + BOUT + EXCH B,CH + CAIL CH,40 + AOJ B, ;PRINT CHAR, COUNT ONE POSITION + MOVEM B,TTLPOS + JRST POP21J + +;GET FRESH LINE +CRIF: SAVE A + SAVE B + MOVEI A,.PRIOU + RFPOS + HRROI A,[ASCIZ/ +/] + TRNE B,-1 + PSOUT + JRST POP21J + +SUBTTL SIMULATE ITS ECHO AND ^P FOR TWENEX + +;ECHO CHARACTER IN CH, IN THE ECHO AREA. +ECHOC0: HRROS (P) ;FLAG THAT CR SHOULD COME OUT AS STRAY ONE + CAIA +ECHOCH: HRRZS (P) + SAVE CH + TRZE CH,CONTRL + TRZ CH,100 + ANDI CH,177 ;CLEAR OTHER RANDOM BITS + CAIN CH,177 ;RUBOUTS DONT ECHO + JRST POPCHJ + CAIN CH,^J ;LF? + JRST ECHOLF + CAIN CH,^M ;CR? + JRST ECOCR0 + CAIN CH,33 ;ESC COMES OUT AS $ + MOVEI CH,"$ + CAIN CH,^I ;TAB? + JRST ECHOTB + CAIE CH,^H ;BS COMES OUT AS ITSELF + CAIL CH,40 ;CONTROL-MUMBLE? + JRST ECHOC3 + MOVEI CH,"^ ;YES, PRINT ^-MUMBLE + CALL ECHOC1 + MOVE CH,(P) + TRO CH,100 +ECHOC3: CALL ECHOC1 ;PRINT SINGLE CHARACTER + JRST POPCHJ + +ECHOLF: SKIPN RGETTY + JRST ECHLF3 +ECHLF1: CALL ECHOC2 ;ADVANCE TO NEXT LINE + JRST POPCHJ +ECHLF3: CALL ECHLF2 + JRST POPCHJ + +ECHLF2: SAVE A + SAVE B + MOVEI A,.PRIOU ;MONITOR WONT LET US TYPE A BARE LF, SO... +IFN 20X,[ + RFPOS + SAVE B + TRZ B,-1 ;FIRST PRETEND WE ARE AT THE LEFT MARGIN ALREADY + SFPOS +] + MOVEI B,^J ;THEN TYPE IT + BOUT +IFN 20X,[ + RFPOS ;GET LINE IT THINKS THAT PUTS US ON + HLLM B,(P) + REST B ;AND SET UP TO REALLY BE IN MIDDLE OF IT + SFPOS +] + JRST POP21J + +ECHOCR: HRRZS (P) ;ALWAYS CRLF + SAVE CH + MOVEI CH,^M +ECOCR0: SKIPN RGETTY + JRST [CALL ECHOC1 ;ON PRINTING TTY, JUST TYPE IT + JRST POPCHJ] ;AND RETURN + HLLZS ECHOPS ;GO TO START OF THIS LINE + SKIPGE -1(P) ;OUTPUT STRAY CR? + JRST ECOTB2 ;YES, JUST GO TO START OF LINE THEN + JRST ECHLF1 ;ELSE ADVANCE A LINE AND CLEAR IT + +ECHOC1: SKIPE RGETTY + CALL ECOPOS + EXCH CH,A + PBOUT + EXCH CH,A + SKIPN RGETTY + RET + AOS CH,ECHOPS + ANDI CH,-1 ;GET HPOS + CAMGE CH,NHLNS + JRST ECHOC4 ;STILL WITHIN RANGE + HLLZS ECHOPS ;START OF NEW LINE +ECHOC2: HLRZ CH,ECHOPS + AOJ CH, + CAML CH,NVLNS + HRRZ CH,ECHOL0 + HRLM CH,ECHOPS + CALL ECOPS0 + JRST CLREOL + +ECHOC4: MOVE CH,ECHOPS ;MAKE SURE KNOW OUR POSITION RIGHT + MOVEM CH,TTLPOS + RET + +ECHOTB: SKIPN RGETTY + JRST ECHOC3 + HRRZ CH,ECHOPS + ADDI CH,8 + TRZ CH,7 + CAML CH,NHLNS + SETZ CH, + HRRM CH,ECHOPS + JUMPE CH,ECHLF1 ;ADVANCE TO NEXT LINE IF WRAP AROUND +ECOTB2: CALL ECOPS0 + JRST POPCHJ + +ECOPS0: SETOM ECHOP ;HERE TO BE SURE WE GO THERE FIRST +ECOPOS: AOSE ECHOP + RET + SAVE A + SAVE B + MOVE B,ECHOPS + CALL CURPS0 + JRST POP21J + +;SIMULATE DISPLAY TYPEOUT IN ECHO AREA (IE INTERPRET ^P CODES) +ECHODP: AOSG C,ECODPF ;HAD A ^P LAST TIME? + JRST ECODP0 ;YES, OF SOME SORT + CAIE CH,^P ;^P NOW? + JRST ECHOC1 ;THAT WAS EASY ENUF + SETOM ECODPF ;YES, SAY SO FOR NEXT TIME + RET +ECODP0: AOJL C,ECODP1 ;^PH OR ^PV? + SETZM ECODPF + SKIPGE C,ECODTB-"A(CH) + CALL ECOPOS ;SEE IF WE SHOULD MOVE TO RIGHT SPOT FIRST + JRST (C) ;DISPATCH FOR THIS ONE + +ECODP1: AOJL C,ECODP2 ;^PV SEEN? + MOVEI C,-10(CH) ;GET DESIRED HPOS + CAMLE C,NHLNS + MOVE C,NHLNS + HRRM C,ECHOPS +ECODP3: SETZM ECODPF + JRST ECOPS0 ;MOVE THE CURSOR THERE + +ECODP2: MOVEI C,-10(CH) ;GET DESIRED VPOS + SETZM ECODPF + CAMGE C,ECHOL0 + MOVE C,ECHOL0 + CAMLE C,NVLNS + MOVE C,NVLNS ;GET IT IN RANGE + JRST ECODP3 + +ECODTB: ECODPA ;A - ADVANCE TO FRESH LINE + ECODPB ;B - MOVE BACKWARD + ECODPC ;C - CLEAR ECHO AREA + ECHOC2 ;D - MOVEM DOWN + -1,,CLREOS ;E - CLEAR TO END OF SCREEN + ECODF0 ;F - MOVE FORWARD + CPOPJ ;G + ECODPH ;H - SET HORIZONTAL POSITION + CPOPJ ;I + CPOPJ ;J + -1,,ECODPK ;K - ERASE CURRENT CHARACTER POSITION + -1,,CLREOL ;L - CLEAR TO END OF LINE + CPOPJ ;M - MORE - SHOULNDT BE DOING THAT, RIGHT? + CPOPJ ;N - DITTO + CPOPJ ;O + ECODPP ;P - OUTPUT ^P + ECODPQ ;Q - OUTPUT ^C + [MOVE C,ECODPS ? MOVEM C,ECHOPS ? JRST ECOPS0] ;R - SAVE POSITION + [MOVE C,ECHOPS ? MOVEM C,ECODPS ? RET] ;S - RESTORE POSITION + ECODPT ;T - GO TO TOP OF ECHO AREA + ECODPU ;U - MOVE UP + ECODPV ;V - SET VERTICAL POSITION + CPOPJ ;W + ECODPX ;X - BACKSPACE AND ERASE CHARACTER + CPOPJ ;Y + ECODPZ ;Z - HOME DOWN + -1,,INSLIN ;[ INSERT LINE + -1,,DELLIN ;\ DELETE LINE + -1,,CLREOL ;] SAME AS ^PL + -1,,INSCHR ;^ INSERT CHARACTER + -1,,DELCHR ;_ DELETE CHARACTER + +ECODPA: MOVE C,ECHOPS ;^PA - MOVE TO FRESH LINE + TRNN C,-1 ;AT START OF A LINE NOW? + RET ;YES + JRST ECHOCR ;NO, TYPE CRLF + +ECODPB: HRRZ C,ECHOPS ;^PB - MOVE BACKWARD + SOJL C,ECODB2 +ECODB1: HRRM C,ECHOPS ;STILL WITHIN RANGE, GO THERE + JRST ECOPS0 +ECODB2: MOVE C,NHLNS ;MOVE TO LAST LINE - 2 + SUBI C,2 + HRRM C,ECHOPS + JRST ECODPU ;AND UP A LINE + +ECODPC: SKIPN RGETTY ;^PC - CLEAR ECHO AREA + JRST ECHOCR ;TYPE CRLF ON PRINTING TERMINAL + CALL ECODPT ;MOVE TO TOP OF ECHO AREA + JRST CLREOS ;AND CLEAR TO END OF SCREEN + +ECODF0: HRRZ C,ECHOPS ;^PF - MOVE FORWARD + AOJ C, + CAMLE C,NHLNS + SETZ C, ;WRAP AROUND ON THE SAME LINE + JRST ECODB1 ;GO THERE + +ECODPH: SKIPA C,[-2] ;^PH - SET HORIZONTAL POSITION +ECODPV: MOVNI C,3 ;^PV - SET VERTICAL POSITION + MOVEM C,ECODPF + RET + +ERSCHR: +ECODPK: +IFN IMLAC,[ + MOVE A,RGETTY + CAIN A,5 ;BS OVERWRITES ON IMLAX + SKIPA A,[-1,,[.BYTE 7 ? 177 ? 204-176 ? 0]] +] + HRROI A,[.BYTE 7 ? 40 ? 10 ? 0] ;^PK - ERASE CURRENT CHAR + PSOUT + RET + +ECODPP: SKIPA CH,[^P] ;^PP - TYPE ^P +ECODPQ: MOVEI CH,^C ;^PQ - TYPE ^C + JRST ECHOC1 ;JUST TYPE IT OUT + +ECODPZ: MOVE C,NVLNS ;^PZ - HOME DOWN + SOSA C ;NUMBER OF LINES -1 +ECODPT: MOVE C,ECHOL0 ;^PT MOVE TO TOP + HRLZM C,ECHOPS + JRST ECOPS0 ;GO THERE + +ECODU2: SKIPA C,NVLNS ;GO TO BOTTOM LINE +ECODPU: HLRZ C,ECHOPS ;^PU - MOVE UP + SOJL C,ECODU2 ;STILL IN RANGE? + HRLM C,ECHOPS + JRST ECOPS0 ;YES, GO THERE + +ECODPX: MOVE C,ECHOPS ;^PX ERASE LAST CHARACTER + TRNN C,-1 ;AT START OF LINE? + JRST ECODX2 + CALL ECOPOS + SOJ C, + MOVEM C,ECHOPS + MOVEI A,^H + PBOUT + JRST ECODPK +ECODX2: HRR C,NHLNS + SUB C,[1,,2] + MOVEM C,ECHOPS + CALL ECOPS0 ;MOVE TO LAST COL -2 OF LAST LINE + JRST CLREOL ;AND CLEAR TO END + +IFN DM2500,[ +SUBTTL DM2500 + +DM25TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) + CALL DMCPS + CALL DMCEOL + CALL DMCEOL ;CLOSEST WE CAN COME + CALL DMCLRS + CALL DMMCLS + CALL DMDSMV + CALL DMDMV1 + CALL DMINSL + CALL DMDELL + CALL DMINSC + CALL DMDELC + CALL DMRST + +DMCPS: JUMPE B,[MOVEI A,^B ;HOME IS EASY + PBOUT + RET] + MOVEI A,^L ;ELSE ^L + PBOUT + HRRZ A,B + XORI A,"` + PBOUT + HLRZ A,B + XORI A,"` +DMCP2: PBOUT + RET + +DMCEOL: MOVEI A,^W + JRST DMCP2 + +DMCLRS: MOVEI A,^^ + PBOUT ;[ +DMRST: MOVEI A,^] ;RESTORE ROLL MODE + JRST DMCP2 + +DMINSL: SAVE C + SAVE B + CALL DMINS1 ;POSITION RIGHT AND ENTER I/D MODE + MOVEI A,30. ;COMPUTE AMOUNT OF FILL NEEDED + SUBI A,(BP) ;((30.-(BP))*OSPEED-2400.)/14400. + SKIPN B,OSPEED ;SPEED OF OUTPUT + MOVEI B,9600. ;ASSUME MAX IF UNKNOWN + IMULI B,(A) + SUBI B,2400. + IDIVI B,14400. ;MAGIC NUMBER IN B +DMINS2: MOVEI A,^J ;INSERT A LINE + PBOUT + MOVEI A,177 ;FILL CHARACTER + SKIPE C,B ;GET NUMBER OF FILL CHARS NEEDED + PBOUT + SOJG C,.-1 ;OUTPUT THAT MANY + SOJG Q,DMINS2 ;REPEAT FOR NUMBER OF LINES REQUESTED + REST B +DMINS3: REST C + MOVEI A,^X + JRST DMCP2 + +DMDELL: SAVE C + CALL DMINS1 +DMDEL2: MOVEI A,^Z ;DELETE A LINE + PBOUT + MOVEI A,177 ;ONE FILL CHAR + SKIPE C,OSPEED + CAIL C,9600. + PBOUT ;ONLY FOR 9600 BAUD OR MORE THOUGH + SOJG Q,DMDEL2 + JRST DMINS3 + +DMINS1: HRROI A,[.BYTE 7 ? ^L ? "` ? 0] + PSOUT + MOVEI A,140(BP) + PBOUT + MOVEI A,^P + PBOUT + RET + +DMMCLS: LSH C,14.+1 + XOR C,[.BYTE 7 ? ^L ? "` ? "` ? ^W ? 0] + MOVEM C,MORMCL + RET + +DMDSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 + XOR B,[.BYTE 8 ? ^L ? "` ? "` ? ^W] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST DMDSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL DMDSM1 + LSH A,4 +DMDSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +DMDSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + XOR B,[.BYTE 8 ? 0 ? ^L ? "` ? "`] + RET + +DMDMV1: SAVE B + SETZB A,B + CALL DMDSM1 + JRST DMDSM2 + +DMINSC: SAVE C + HRROI A,[.BYTE 7 ? ^P ? ^\ ? ^X ? 0] + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + HRROI A,[.BYTE 7 ? ^P ? 40 ? 177 ? ^X ? ^H ? 40 ? ^H] ;USE HAIRY ONE + PSOUT + REST C + RET + +DMDELC: HRROI A,[.BYTE 7 ? ^P ? ^H ? 0] + PSOUT + SAVE C + MOVEI A,177 + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + PBOUT ;NEED ONE FILL CHAR + JRST DMINS3 +] ;DM2500 + +IFN H1500,[ +SUBTTL H1500 + +HZ15TB: 24.,,79. ;DISPATCH VECTOR FOR HZ1500 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL HZCPS + CALL HZCEOL + CALL HZCEOS + CALL HZCLRS + CALL HZMCLS + CALL HZDSMV + CALL HZDMV1 + CALL HZINSL + CALL HZDELL +REPEAT 3,JFCL + +HZCPS: SAVE C + MOVE C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRRZ A,B + ADDI A,140 + CAIL A,177 + SUBI A,140 + DPB A,[170700,,C] + HLRZ A,B + LSH A,7+1 + IOR C,A + HRROI A,C + PSOUT + REST C + RET + +HZCEOL: HRROI A,[.BYTE 7 ? 176 ? ^O ? 177 ?0] + PSOUT + RET + +HZCEOS: HRROI A,[.BYTE 7 ? 176? ^X ?177?177?177?177?177?0] + PSOUT + RET + +HZCLRS: HRROI A,[.BYTE 7 ? 176? ^\ ?177?177?177?177?0] + PSOUT + RET + +HZINSL: SAVE C + CALL HZIDPS +HZINS1: HRROI A,[.BYTE 7 ? 176 ? ^Z ? 0] + PSOUT + MOVEI C,8. + CALL HZFILL + SOJG Q,HZINS1 + REST C + RET + +HZFILL: HRROI A,[.BYTE 7 ? 177?177?177?177 ? 0] + PSOUT + SOJG C,.-2 + RET + +HZDELL: SAVE C + CALL HZIDPS +HZDEL1: HRROI A,[.BYTE 7 ? 176 ? ^S ? 0] + PSOUT + MOVEI C,1. + CALL HZFILL + SOJG Q,HZDEL1 + REST C + RET + +HZIDPS: MOVEI C,140(BP) + LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRROI A,C + PSOUT + RET + +;MOVE TO LINE START, CEOL, MOVE TO HPOS ON SAME LINE +HZDSMV: SAVE B + MOVEI A,(BP) ;DESIRED VPOS + LSH A,4 + IOR A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] ;MOVE TO LINE START + MOVE B,[.BYTE 8 ? 176 ? ^O ? 177 ? 177] ;CEOL + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + SETZM DISBF1+5 ;ASSUME NO HORIZ POSITIONING NECSY + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST CPOP2J ;YES, DONT NEED SECOND CURSOR ADDRESS THEN +HZDSM2: MOVE A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] + CALL HZDSM1 + MOVEM A,DISBF1+5 + JRST CPOP2J + +HZDSM1: SAVE A + DPB BP,[041000+P,,] ;VPOS + MOVE B,DISCPH + DPB B,[141000+P,,] ;HPOS + REST A + RET + +HZDMV1: SAVE B + SETZM DISBF1+3 ? SETZM DISBF1+4 + JRST HZDSM2 + +HZMCLS: LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 176] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? ^O ? 177 ? 177 ? 0] + MOVEM C,MORMCL+1 + RET +] ;H1500 + +IFN VT52\VT61\VT100\TL4041\TL1061,[ +SUBTTL VT52S OF VARIOUS SORTS + +IFN VT52,[ +VT52TB: 24.,,79. ;DISPATCH VECTOR FOR VIRGIN VT52 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 +REPEAT 5,JFCL +] ;VT52 +IFN VT61,[ +VT61TB: 24.,,79. ;DISPATCH VECTOR FOR VT61 +IFE VT61-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL VTINSL + CALL VTDELL + CALL VTINSC + CALL VTDELC + JFCL + +;THE VT61 FLAVOUR OF I/D LINE/CHAR FOR A VT52 +VTINSL: SKIPA A,["F] ;$PF - INSERT LINE +VTDELL: MOVEI A,"D ;$PD - DELETE LINE + SAVE A + MOVEI A,"Y + CALL VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT +VTINS1: MOVEI A,"P + CALL VTESC + MOVE A,(P) ;GET DESIRED FUNCTION AGAIN + PBOUT + SOJG Q,VTINS1 + JRST CPOP1J + +VTDELC: HRROI A,[.BYTE 7 ? 33 ? "P ? "S ? 0] + PSOUT + RET +VTINSC: HRROI A,[.BYTE 7 ? 33 ? "P ? "I ? 40 ? 33 ? "P ? "I+40 ? 10 ? 0] + PSOUT + RET +] ;VT61 + +IFN TL4041\TL1061,[ +TL40TB: 24.,,79. ;DISPATCH VECTOR FOR TELERAY 4041 +IFE TL1061-VT52,IFE TL4041-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 + CALL TLINSL + CALL TLDELL + CALL TLINSC + CALL TLDELC + JFCL + +;THE TELERAY 4041 VERSION OF I/D LINE/CHAR +TLINSL: SKIPA A,["L] ;$L - INSERT LINE +TLDELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"Y + CALL VTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT + REST A ;GET DESIRED FUNCTION AGAIN +TLDEL1: CALL VTESC + SAVE A + MOVE A,RGETTY + CAIE A,TL106I + JRST TLDEL2 + MOVEI A,40. + DISMS +TLDEL2: REST A + SOJG Q,TLDEL1 + RET + +TLDELC: MOVEI A,"Q + JRST VTESC +TLINSC: MOVEI A,"P + JRST VTESC +] ;TL4041,TL1061 + +IFN VT100,[ +VT10TB: 24.,,79. ;DISPATCH VECTOR FOR VT100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) ;HAS BETTER THAN LID + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VT1CLR + CALL VTMCLS + CALL VTDSMV + CALL VTDMV1 +REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED + CALL VT1RST + CALL VT1SUP + CALL VT1SDN + + +VT1CLR: HRROI A,[ASCIZ "<[?2lHJ"] ;] + PSOUT + RET + +VT1RST: HRROI A,[ASCIZ /<78/] ;] RESET SCROLL REGION + PSOUT + RET + +;SCROLL Q LINES STARTING WITH LINE IN BP UP +VT1SUP: PUSH P,["D] ;INDEX NEEDED TO CAUSE SCROLLING (DOESNT TAKE ARGUMENT) + JSP A,VT1SCR ;SETUP SCROLL REGION AND BYTE POINTER IN A + MOVE B,BOTLIN ;POSITION TO BOTTOM OF SCROLL REGION, OFFSET +VT1UP2: CALL VT1ARG + MOVEI B,"H + IDPB B,A + MOVEI B,0 + IDPB B,A ;MAKE ASCIZ OF POSITIONING STUFF + HRROI A,VT1BUF + PSOUT ;TYPE IT ALL OUT +VT1UP3: MOVE A,-2(P) ;GET CURSOR COMMAND + CALL VTESC ;SCROLL RIGHT DIRECTION + MOVEI A,0 + MOVEI B,10. ;NEED PADDING FOR THIS + PBOUT + SOJG B,.-1 + SOJG Q,VT1UP3 + HRROI A,[ASCIZ /[?2l/] ;] BACK INTO VT52 MODE (MAYBE ALWAYS ANSI?) + PSOUT + JRST POP321 ;ALSO FLUSH SCROLLING COMMAND + +VT1SDN: PUSH P,["M] ;REVERSE INDEX TO SCROLL + JSP A,VT1SCR ;SETUP SCROLL REGION + MOVEI B,1(BP) ;MOVE TO TOP LINE, OFFSET + JRST VT1UP2 + +VT1SCR: PUSH P,B + PUSH P,C + PUSH P,A ;SAVE RETURN ADDRESS AS WELL + MOVE A,[440700,,VT1BUF] ;MAKE STRING POINTER + MOVEI B,33 + IDPB B,A + MOVEI B,"< ;ENTER ANSI MODE + IDPB B,A + MOVEI B,1(BP) ;STARTING LINE, OFFSET + CALL VT1ARG + MOVEI B,"; + IDPB B,A + MOVE B,BOTLIN ;BOTTOM LINE, OFFSET + CALL VT1AR1 + MOVEI B,"r ;SET SCROLL REGION + IDPB B,A + RET + +VT1ARG: MOVEI C,33 + IDPB C,A + MOVEI C,"[ ;] + IDPB C,A +VT1AR1: IDIVI B,10. + JUMPE B,VT1AR2 ;NO TENS DIGIT + ADDI B,"0 + IDPB B,A ;ELSE PUT IT IN +VT1AR2: ADDI C,"0 + IDPB C,A ;AND DIGITS + RET +];VT100 + +VTCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST VTESC] + MOVEI A,"Y ;ELSE SEND $Y + CALL VTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + JRST VTES1 + +VTCEOL: MOVEI A,"K ;CLEAR EOL +VTESC: SAVE A + MOVEI A,33 + PBOUT + REST A +VTES1: PBOUT + RET + +VTCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL VTESC +VTCEOS: MOVEI A,"J ;CLEAR EOS + CALL VTESC + MOVE A,RGETTY + CAIE A,VT52I ;REAL VT52 NEEDS PADDING AFTER CLEAR SCREEN + RET + SAVE C + MOVE A,OSPEED ;ABOVE 4800 BAUD, TO AVOID ^S^Q LOSSAGE. + SETZ C, + CAIN A,9600. + MOVEI C,26. ;26 RUBOUTS AT 9600 BAUD, 5 AT 4800 + CAIE A,4800. ;(EMPIRICALLY DETERMINED. DON'T ASK ME WHY). + MOVEI C,5 + JUMPE C,POPCJ + MOVEI A,177 + PBOUT + SOJG C,.-1 + JRST POPCJ + +VTMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "Y ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "K ? 0) + MOVEM C,MORMCL+1 + RET + +VTDSMV: SAVE B + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST VTDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $Y ? $K + MOVEM B,DISBF1+5 + JRST CPOP2J +VTDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... + MOVEM B,DISBF1+4 + CALL VTDMV1 + JRST CPOP2J + +VTDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] + MOVEM A,DISBF1+5 ;$Y + RET +] ;VT52 + +IFN FOX,[ +SUBTTL FOX + +FOXTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER FOX + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL FXCPS + CALL FXCEOL + CALL FXCEOS + CALL FXCLRS + CALL FXMCLS + CALL FXDSMV + CALL FXDMV1 +REPEAT 5,JFCL + +FXCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST FXESC] + MOVEI A,"X ;ELSE SEND $X + CALL FXESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,"Y ;$Y + CALL FXESC + MOVEI A,40(B) ;+40 + JRST FXES1 + +FXCEOL: MOVEI A,"I ;CLEAR EOL +FXESC: SAVE A + MOVEI A,33 + PBOUT + REST A +FXES1: PBOUT + RET + +FXCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL FXESC +FXCEOS: MOVEI A,"J ;CLEAR EOS + JRST FXESC + +FXMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 33 ? "X ? 40 ? 33 ? "Y] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 40 ? 33 ? "I] + MOVEM C,MORMCL+1 + RET + +FXDSMV: SAVE B + MOVEI B,(BP) ;DESIRED VPOS + SKIPE A,DISCPH ;DESIRED HPOS = 0? + JRST FXDSM2 ;NO, MUST GO THERE AFTERWARDS + LSH B,8+4 + ADD B,[.BYTE 8 ? 33 ? "X ? 40 ? 33] ;$X$ + MOVE A,[.BYTE 8 ? "Y ? 40 ? 33 ? "I] ;Y$I +FXDSM1: MOVEM B,DISBF1+4 + MOVEM A,DISBF1+5 + JRST CPOP2J +FXDSM2: LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? 33 ? "X ? 40] ;$X + MOVEM B,DISBF1+3 + MOVE B,[.BYTE 8 ? 33 ? "Y ? 40 ? 33] ;$Y<0>$ + ADD A,[.BYTE 8 ? "I ? 33 ? "Y ? 40] ;I$Y + JRST FXDSM1 + +FXDMV1: MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "X] + MOVEM A,DISBF1+4 ;$X + MOVEI A,(BP) ;DESIRED VPOS + LSH A,24. + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 40 ? 33 ? "Y ? 40] + MOVEM A,DISBF1+5 ;$Y + RET +] ;FOX + +IFN DM1520,[ +SUBTTL DM1520 + +DM15TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 1520 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL D1CPS + CALL D1CEOL + CALL D1CEOS + CALL D1CLRS + CALL D1MCLS + CALL D1DSMV + CALL D1DMV1 +REPEAT 5,JFCL + +D1CPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY + PBOUT + RET] + MOVEI A,^^ ;ELSE ^^ + PBOUT + MOVEI A,40(B) + PBOUT + HLRZ A,B + ADDI A,40 +D1CP2: PBOUT + RET + +D1CEOS: MOVEI A,^K ;ERASE EOS + JRST D1CP2 ;[ +D1CEOL: MOVEI A,^] ;ERASE EOL + JRST D1CP2 +D1CLRS: MOVEI A,^L ;ERASE SCREEN + JRST D1CP2 + +D1MCLS: LSH C,14.+1 ;[ + ADD C,[.BYTE 7 ? ^^ ? 40 ? 40 ? ^] ? 0] + MOVEM C,MORMCL + RET + +D1DSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 ;[ + ADD B,[.BYTE 8 ? ^^ ? 40 ? 40 ? ^] ] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST D1DSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL D1DSM1 + LSH A,4 +D1DSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +D1DSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? ^^ ? 40 ? 40] + RET + +D1DMV1: SAVE B + SETZB A,B + CALL D1DSM1 + JRST D1DSM2 +] ;DM1520 + +IFN IMLAC,[ +SUBTTL IMLAX + +IMLCTB: 44.,,88. ;DISPATCH TABLE FOR IMLAX + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOOVR) + CALL IMCPS + CALL IMCEOL + CALL IMCEOS + CALL IMCLRS + CALL IMMCLS + CALL IMDSMV + CALL IMDMV1 + CALL IMINSL + CALL IMDELL + CALL IMINSC + CALL IMDELC + JFCL + +IMCPS: MOVEI A,217 ;%TDMV0 + CALL IMCEO2 + HLRZ A,B ;VPOS + AOJ A, ;AVOID SENDING NULL + PBOUT + MOVEI A,1(B) ;HPOS +IMCPS2: PBOUT + RET + +IMCEOS: MOVEI A,202 ;%TDEOF +IMCEO2: SAVE A + MOVEI A,177 ;SEND > 200 BY ESCAPING FIRST + PBOUT + REST A + SUBI A,176 ;SEND REST + JRST IMCPS2 +IMCEOL: MOVEI A,203 ;%TDEOL + JRST IMCEO2 +IMCLRS: MOVEI A,220 ;%TDCLR + JRST IMCEO2 + +IMINSL: SKIPA A,[223] ;%TDILP +IMDELL: MOVEI A,224 ;%TDDLP + SAVE A ;SAVE DESIRED FUNCTION + MOVEI A,217 ;%TDMV0 TO BEGINNING OF DESIRED LINE + CALL IMCEO2 + MOVEI A,1(BP) ;VPOS + PBOUT + MOVEI A,1 + PBOUT + REST A ;GET BACK DESIRED FUNCTION + CALL IMCEO2 + MOVEI A,(Q) ;GET REPEAT COUNT + JRST IMCPS2 + +IMINSC: SKIPA A,[225] ;%TDICP +IMDELC: MOVEI A,226 ;%TDDCP + CALL IMCEO2 + MOVEI A,1 + JRST IMCPS2 + +IMMCLS: LSH C,14.+1 + ADD C,[.BYTE 7 ? 177 ? 217-176 ? 1 ? 1 ? 177] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? 203-176 ? 0) + MOVEM C,MORMCL+1 + RET + +IMDSMV: SAVE B + MOVEI B,1(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 1 ? 177 ? 203-176] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 177 ? 217-176] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IMDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST %TDMV0 ? %TDEOL + MOVEM B,DISBF1+5 + JRST CPOP2J +IMDSM2: MOVEM A,DISBF1+3 ;HPOS TOO, %TDMV0 ? %TDEOL ? ... + MOVEM B,DISBF1+4 + +IMDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 177 ? 217-176 ? 1 ? 1] + MOVEM A,DISBF1+5 ;%TDMV0 + RET +] + +IFN VT05,[ ;[ +SUBTTL VT05 + +VT05TB: 20.,,71. ;DISPATCH VECTOR FOR VT05 + (%TOERS+%TOMVB+%TOMVU) ;CANT EVEN DISPLAY LOWERCASE + CALL V0CPS + CALL V0CEOL + CALL V0CEOS + CALL V0CLRS + CALL V0MCLS + CALL V0DSMV + CALL V0DMV1 +REPEAT 5,JFCL + +V0CPS: JUMPE B,[MOVEI A,^] ;HOME IS EASY + JRST V0EOS2] ;WELL, AS EASY AS ANYTHING ELSE + MOVEI A,^N + PBOUT + HLRZ A,B + ADDI A,40 + CALL V0EOS2 ;TYPE YPOS+40 AND FILL (MUST FILL IN THE MIDDLE OF IT!) + MOVEI A,40(B) ;THEN XPOS+40 + PBOUT + RET + ;[ +V0CLRS: MOVEI A,^] ;HOME + CALL V0EOS2 ;WITH FILL +V0CEOS: MOVEI A,^_ ;CLEAR EOS +V0EOS2: PBOUT +V0FILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE +REPEAT 4,PBOUT ;OF THE CURSOR ADDRESSING) + RET +V0CEOL: MOVEI A,^^ + JRST V0EOS2 + +V0MCLS: LSH C,21.+1 + ADD C,[.BYTE 7 ? ^N ? 40 ? 0] + MOVEM C,MORMCL + MOVE C,[.BYTE 7 ? 0 ? 40 ? ^^] + MOVEM C,MORMCL+1 + RET + +V0DSMV: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + MOVE B,[.BYTE 8 ? 0 ? 0 ? 40 ? ^^] + SKIPE DISCPH ;ANY HPOS? + JRST V0DSM2 ;YES + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + JRST CPOP2J +V0DSM2: MOVEM A,DISBF1+1 + MOVEM B,DISBF1+2 +V0DSM3: MOVEM A,DISBF1+4 + MOVE B,DISCPH ;GET HPOS + ADDI B,40 + LSH B,8+4 + MOVEM B,DISBF1+5 + JRST CPOP2J + +V0DMV1: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + JRST V0DSM3 + +CLRMO6: JSR SAV123 + MOVEI A,.PRIOU + HRROI B,MORMCL + MOVNI C,8 + SOUT + CALL V0FILL + JRST POP321 +] + +IFN TK4025,[ +SUBTTL TEKTRONIX 4025S + +TK40TB: 34.,,78. ;DISPATCH TABLE FOR TEKTRONIX 4025 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL TKCPS + CALL TKCEOL + CALL TKCEOS + CALL TKCLRS + CALL TKMCLS + CALL TKDSMV + CALL TKDMV1 + CALL TKINSL + CALL TKDELL + CALL TKINSC + CALL TKDELC + JFCL + + +; TKCPS - OUTPUT TEK4025 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +TKCPS: JUMPE B,[HRROI A,[ASCIZ / +`UP34;/] + JRST TKCLR2] ;IF HOME, BE SURE TO RESYNCH + SAVE B ;SAVE DESIRED POSITION + SAVE TTLPOS ;WHERE WE ARE NOW. + HLRZ B,TTLPOS ;JUST ROW + CAIL B,28. ;CAN'T TRUST IT IF AT MODE LINE OR BELOW + JRST TKCPS8 ;SO USE FUDGED ABSOLUTE + HLRZ A,-1(P) ;GET NEW + SUBI B,(A) ;GET OLD-NEW + JUMPE B,TKCPS1 ;NO DIFF THERE + HRROI A,[ASCIZ /`DOW/] ;ASSUME NEGATIVE => DOWN + SKIPL B + HRROI A,[ASCIZ /`UP/] ;POSITIVE => UP + PSOUT + CALL TKCPS7 +TKCPS1: REST B ;GET BACK OLD + ANDI B,-1 ;JUST COL + HRRZ A,(P) ;GET NEW + SUBI B,(A) + JUMPE B,CPOP2J + JUMPE A,[MOVEI A,^M ;FASTER IF GOING TO BEGINNING OF LINE + PBOUT + JRST CPOP2J] + HRROI A,[ASCIZ /`RIG/] ;ASSUME NEGATIVE => RIGHT + SKIPL B + HRROI A,[ASCIZ /`LEF/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + +TKCPS7: MOVM A,B + SOJE A,TKCPS3 +TKCPS2: CALL TKCPS4 +TKCPS3: MOVEI A,"; + PBOUT + RET + +TKCPS4: SAVE [PBOUT] +TKCPS5: SAVE B + AOJ A, ;OFFSET TO 1,1 AS ORIGIN + IDIVI A,10. + JUMPE A,TKCPS6 + MOVEI A,"0(A) + XCT -1(P) +TKCPS6: MOVEI A,"0(B) + XCT -1(P) + JRST POP21J + +TKCPS8: + HRROI A,[ASCIZ / +`UP34;/] + PSOUT + REST B ;POP OFF OLD STUFF + HLRZ B,(P) ;GET LINE + JUMPE B,TKCPS9 + HRROI A,[ASCIZ /`DOW/] + PSOUT + CALL TKCPS7 +TKCPS9: HRRZ B,(P) + JUMPE B,CPOP2J + HRROI A,[ASCIZ /`RIG/] + PSOUT + CALL TKCPS7 + JRST CPOP2J + + +TKCEOS: ; CLOSE ENOUGH FOR MOST THINGS +TKCEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + PUSH P,C ; SAVE FOR LATER + SUBI C,79. ; MAKE HPOS-79 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVEI A,^M + PBOUT ; BACK TO LEFT + POP P,B ; GET BACK OLD POS + JUMPE B,TKCEO1 + HRROI A,[ASCIZ /`RIG/] + PSOUT + PUSHJ P,TKCPS7 +TKCEO1: POP P,C + POP P,B + POP P,A + POPJ P, + +TKCEO2: HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRROI A,[ASCIZ / /] ; SOME SPACES FOR FILL + PSOUT + MOVEI A,^M + PBOUT + RET + +TKCLRS: HRROI A,[ASCIZ /`ERA;/] +TKCLR2: PSOUT + RET + +TKINSC: HRROI A,[ASCIZ /`ICH; `LEF1;/] + JRST TKCLR2 +TKDELC: HRROI A,[ASCIZ /`DCH;/] + JRST TKCLR2 + +; TKDELL - OUTPUT TEK4025 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +TKDELL: MOVS B,BP + CALL TKCPS + MOVEM B,TTLPOS + HRROI A,[ASCIZ /`DLI/] + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 ;ACCOUNT FOR INCREMENTING THAT WILL BE DONE + + +; TKINSL - OUTPUT TEK4025 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +TKINSL: MOVSI B,-1(BP) + JUMPGE B,.+2 + MOVEI B,0 ; THIS WILL LOSE BUT ITS BETTER THAN NOTHING + CALL TKCPS + MOVEM B,TTLPOS + HRROI A,[ASCIZ /`ILI/] + PSOUT + MOVEI A,(Q) + SOS A + CALL TKCPS2 + HRROI A,[ASCIZ /`UP/] ;REPOSITION CURSOR + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 + +TKMCLS: MOVEM C,MORMCL + RET + +CLRMO7: SAVE A + SAVE B + HRROI A,[ASCIZ /`UP34;`DOW/] + PSOUT + MOVE B,MORMCL + CALL TKCPS7 + HRROI A,[ASCIZ /`DLI;`UP;`ILI;/] + PSOUT + HRLZ B,MORMCL + MOVEM B,TTLPOS + JRST POP21J + + +TKDMV1: HRROS (P) + SAVE [141000,,DISBF1+1] + JRST TKDSM2 +TKDSMV: SKIPE DISCPH ;ANY HPOS? + SAVE [441000,,DISBF1] ;YES, WILL NEED WHOLE BUFFER + SAVE [141000,,DISBF1+1] + HRRZS -1(P) +TKDSM2: SAVE B + MOVE B,TTLPOS + MOVEI A,^M + TRNE B,-1 ;IF NOT THERE ALREADY... + IDPB A,-1(P) ;START AT BEGINNING OF CURRENT LINE + HLRZS B ;GET CURRENT ROW + SUBI B,(BP) ;GET OLD-NEW + JUMPE B,TKDSM5 ;ALREADY ON RIGHT LINE + MOVEI A,[ASCIZ /`DOW /] ;ASSUME NEGATIVE => DOWN + SKIPL B + MOVEI A,[ASCIZ /`UP /] + CALL TKDSMS + MOVM A,B + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) +TKDSM5: SETZM EOLFLG ; NO CLEARING + SKIPE HCDS(BP) ;NEED CLEARING? + SKIPGE -2(P) ;AND WANT CLEARING? + SKIPA A,[-1] ;NO OR NO + SETZ A, ;YES AND YES, IT'S NEEDED + MOVEM A,EOLFLG ;SAVE IT + SKIPN DISCPH ;GET HPOS IF ANY + JRST POP21J + MOVEI A,[ASCIZ /`RIG /] + CALL TKDSMS + MOVE A,DISCPH + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) + JRST POP21J + +TKDSMS: SAVE B + HRLI A,440700 +TKDSS2: ILDB B,A + JUMPE B,CPOP2J + IDPB B,-3(P) + JRST TKDSS2 + +TKDSMN: SOJE A,CPOPJ + SAVE [IDPB A,-4(P)] + JRST TKCPS5 +] + +IFN HP2645,[ +SUBTTL HP2645 + +HPTB: 24.,,79. ;DISPATCH VECTOR FOR HP2645 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL HPCPS + CALL HPCEOL + CALL HPCEOS + CALL HPCLRS + CALL HPMCLS + CALL HPDSMV + CALL HPDMV1 + CALL HPINSL + CALL HPDELL + CALL HPINSC + CALL HPDELC + JFCL + + +; HPCPS - OUTPUT HP2645 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +HPCPS: SAVE A ; SAVE AC + MOVE A,[440700,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + CALL HPMOVE ; GET COMMANDS TO DO CURSOR MOVEMENT + MOVE A,[440700,,HPBUF] ; SEND COMMANDS + PSOUT ; ... + REST A ; RESTORE AC + RET + + +; HPMOVE - CALCULATE HP2645 CURSOR POSITIONING COMMANDS. +; ARGUMENTS: +; A B.P. TO OUTPUT BUFFER (UPDATED ON RETURN) +; B LINE,,COLUMN + +HPMOVE: SAVE B ; SAVE ACS + SAVE C ; ... + JUMPE B,[ ; SIMPLE HOME + MOVEI C,33 ; $H WILL DO + IDPB C,A + MOVEI C,"H + IDPB C,A + JRST HPMOV1 + ] +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + HLRZ B,-1(P) ; GET LINE NO. + CALL HPNO ; OUTPUT AS DECIMAL NO. + HRRZ B,-1(P) ; GET COLUMN NO. + JUMPE B,[ ; IF COLUMN NO. IS ZERO THEN USE DIRECT + MOVEI C,"R ; CURSOR POSITION FOR LINE NO. ONLY + IDPB C,A + MOVEI C,^M ; THEN FOLLOW WITH A CR + IDPB C,A ; ... + JRST HPMOV1 + ] + MOVEI C,"r ; TERMINATE LINE NO. + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI C,"C ; TERMINATE COLUMN NO. + IDPB C,A ; ... +HPMOV1: MOVEI C,0 ; TERMINATE WITH A NULL + IDPB C,A ; ... + REST C ; RESTORE ACS + REST B ; ... + RET + +; INTERNAL SUBROUTINE - OUTPUT B AS DECIMAL NO. +HPNO: IDIVI B,10. ; CONVERT TO TENS AND ONES DIGITS + JUMPE B,HPN1 ; SKIP TENS DIGIT IF ZERO + ADDI B,"0 ; CONVERT TENS DIGIT TO ASCII + IDPB B,A ; OUTPUT TENS DIGIT +HPN1: ADDI C,"0 ; CONVERT ONES DIGIT TO ASCII + IDPB C,A ; OUTPUT ONES DIGIT + RET + + +; HPCEOL - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF LINE. + +HPCEOL: HRROI A,[ASCIZ "K"] + PSOUT + RET + + +; HPCEOS - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF SCREEN. + +HPCEOS: HRROI A,[ASCIZ "J"] + PSOUT + RET + + +; HPCLRS - OUTPUT HP2645 COMMANDS TO CLEAR THE SCREEN. + +HPCLRS: HRROI A,[ASCIZ "HJ"] + PSOUT + RET + + +; HPINSL - OUTPUT HP2645 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +HPINSL: MOVEI A,"L ; $L - INSERT LINE + JRST HPDEL1 + + +; HPDELL - OUTPUT HP2645 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +HPDELL: MOVEI A,"M ; $M - DELETE LINE +HPDEL1: SAVE B ; SAVE AC + MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. + CALL HPCPS ; MOVE TO DESIRED LINE NO. + MOVEI B,33 ; ESC +HPID1: EXCH A,B + PBOUT ; OUTPUT ESC + EXCH A,B + PBOUT ; OUTPUT "L" OR "M" + SOJG Q,HPID1 + REST B ; RESTORE AC + RET + +HPDELC: HRROI A,[ASCIZ "P"] + PSOUT + RET +HPINSC: HRROI A,[ASCIZ "Q R"] + PSOUT + RET + +; HPMCLS - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED LINE AND CLEAR +; IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER TIME. +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +HPMCLS: SAVE A ; ... + SAVE B ; ... + MOVE A,[440700,,MORMCL] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,C ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; PUT IN COMMANDS TO MOVE TO DESIRED LINE + MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH + DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE + MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE + IDPB B,A ; ... + MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... + REST B ; RESTORE ACS + REST A ; ... + RET + + +; HPDSMV - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +HPDSMV: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE + MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH + DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE + MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE + IDPB B,A ; ... + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM1 ; YES, ALREADY THERE +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A +HPDSM1: MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... +HPDSM2: SUBI A,HPBUF ; CALCULATE NO. OF BYTES WE'VE GENERATED + MULI A,4 ; (SEE HAKMEM NOTE 165) + SUBI B,1-4(A) ; ... + MOVNI A,(B) ; CALCULATE BYTE ADDRESS TO START AT, + ADD A,[DISBUF*4] ; I.E. DISBUF*4-NBYTES + IDIVI A,4 ; CONVERT TO B.P. + HRL A,(B)[441000 ? 341000 ? 241000 ? 141000] ; ... + MOVE B,[441000,,HPBUF] ; B.P. TO BUFFER +HPDSM3: ILDB C,B ; GET BYTE FROM HPBUF + JUMPE C,HPDSM4 ; ZERO BYTE TERMINATES + IDPB C,A ; PUT INTO DISBF1 + JRST HPDSM3 +HPDSM4: REST C ; RESTORE ACS + REST B ; ... + REST A ; ... + RET + + +; HPDMV1 IS JUST LIKE HPDSMV, EXCEPT THAT IT DOES NOT CLEAR. + +HPDMV1: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM2 ; YES, ALREADY THERE + MOVEI C,33 ; SEND THE START OF THE CURSOR POSITIONING + DPB C,A ; SEQUENCE + MOVEI C,"& ; ... + IDPB C,A ; ... + MOVEI C,"a ; ... + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A ; ... + JRST HPDSM1 + +];IFN HP2645 + +IFN I400,[ +SUBTTL INFOTON 400 + +I400TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) + CALL I4CPS + CALL I4CEOL + CALL I4CEOS + CALL I4CLRS + CALL I4MCLS + CALL I4DSMV + CALL I4DMV1 + CALL I4INSL + CALL I4DELL + CALL I4INSC + CALL I4DELC + CALL I4RST + +I4CPS: HRROI A,[ASCIZ /[/] ;] + PSOUT + JUMPE B,I4CPS8 ; SKIP ALL THIS FOR HOMING + HLRZ A,B ; VERTICAL POS + AOS A ; USES 1 BASED ADDRESSING + CALL I4PAR + HRRZ A,B + JUMPE A,I4CPS8 + PUSH P,A + MOVEI A,"; + PBOUT + POP P,A + AOS A + CALL I4PAR +I4CPS8: MOVEI A,"H + PBOUT + RET + +I4ESC: SAVE A + HRROI A,[ASCIZ /[/] ;] + PSOUT + REST A + PBOUT + RET + +I4PAR: SAVE B + IDIVI A,10. + JUMPE A,I4PAR1 + ADDI A,"0 + PBOUT +I4PAR1: MOVEI A,"0(B) + PBOUT + JRST CPOP2J + +I4CEOL: MOVEI A,"N + JRST I4ESC + +I4CEOS: MOVEI A,"J + JRST I4ESC + +I4CLRS: HRROI A,[ASCIZ //] ;] + PSOUT + RET + +I4MCLS: HRROI A,[ASCIZ //] ;] SET UP RIGHT MODE + PSOUT + MOVEI A,1(C) + IDIVI A,10. + LSH A,14.+1 + LSH B,7+1 + ADDI A,(B) + ADD A,[.BYTE 7 ? 33 ? "[ ? "0 ? "0 ? "H] ;] + MOVEM A,MORMCL + MOVE A,[.BYTE 7 ? 33 ? "[ ? "N] ;] + MOVEM A,MORMCL+1 + RET + +I4DSMV: MOVEI C,5 ; INDEX INTO DISBF1 + MOVE A,[.BYTE 8 ? 33 ? "[ ? "2 ? "N ] ;] + MOVEM A,DISBF1(C) + SOS C + JRST I4DMV3 ; ENTER REST OF CODE + +I4DMV1: MOVEI C,5 ; INDEX INTO DISBF1 +I4DMV3: MOVE A,DISCPH + AOS A + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,8+4 + ADD A,[.BYTE 8 ? "; ? "0 ? "0 ? "H ] + MOVEM A,DISBF1(C) + SOS C +I4DSM2: MOVEI A,1(BP) + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "[ ? "0 ? "0 ] ;] + MOVEM A,DISBF1(C) + RET + +I4INSL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSTION CURSOR TO IT +I4INS1: HRROI A,[ASCIZ //] ;]]] + PSOUT + PUSHJ P,I4PAD ;PAD THE INSERT + SOJG Q,I4INS1 ;AND LOOP IF MORE TO DO + RET + +I4DELL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSITION CURSOR TO IT +I4DEL1: HRROI A,[ASCIZ //] ;]]] HAVE TO SWITCH MODES AND BACK + PSOUT + PUSHJ P,I4PAD ;PAD FOR THE DELETION + SOJG Q,I4DEL1 ;AND LOOP IF MORE TO DO + RET + +I4PAD: MOVE A,OSPEED ;GET SPEED IN BPS (IN A TO PRESERVE C FR IDIVI) + IDIVI A,600. ;FIND NUMBER OF PADDING CHAR'S + MOVEI B,(A) + MOVEI A,177 ;PAD WITH RUBOUTS + PBOUT + SOJG B,.-1 + RET + +I4INSC: HRROI A,[ASCIZ / /] ;]] ECHH! + PSOUT + RET + +I4DELC: MOVEI A,"P + JRST I4ESC + +I4RST: HRROI A,[ASCIZ //] ;] RESET ROLL + PSOUT + RET + +] ;IFN I400 + +IFN I100,[ +SUBTTL INFOTON 100 + +I100TB: 24.,,79. ;DISPATCH VECTOR FOR I100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL I1CPS + CALL I1CEOL + CALL I1CEOS + CALL I1CLRS + CALL I1MCLS + CALL I1DSMV + CALL I1DMV1 + CALL I1INSL + CALL I1DELL + JFCL + JFCL + JFCL + +I1INSL: SKIPA A,["L] ;$L - INSERT LINE +I1DELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"f + CALL I1ESC + MOVEI A,40 + PBOUT + MOVEI A,40(BP) + PBOUT +I1INS1: MOVE A,(P) ; GET DESIRED FUNCTION AGAIN + CALL I1ESC + SOJG Q,I1INS1 + JRST CPOP1J + + +I1CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST I1ESC] + MOVEI A,"f ;ELSE SEND $f + CALL I1ESC + MOVEI A,40(B) ;+40 + PBOUT + HLRZ A,B + ADDI A,40 ;+40 + JRST I1ES1 + +I1CEOL: MOVEI A,"K ;CLEAR EOL +I1ESC: SAVE A + MOVEI A,33 + PBOUT + REST A +I1ES1: PBOUT + RET + +I1CLRS: MOVEI A,"H ;CLEAR SCREEN + CALL I1ESC +I1CEOS: MOVEI A,"J ;CLEAR EOS + JRST I1ESC + +I1MCLS: LSH C,7.+1 + ADD C,[.BYTE 7 ? 33 ? "f ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "K ? 0) + MOVEM C,MORMCL+1 + RET + +I1DSMV: SAVE B + MOVEI B,40(BP) + LSH B,16.+4 + IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "f] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST I1DSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $f ? $K + MOVEM B,DISBF1+5 + JRST CPOP2J +I1DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $f ? $K ? ... + MOVEM B,DISBF1+4 + CALL I1DMV1 + JRST CPOP2J + +I1DMV1: MOVE A,DISCPH ; GET WANTED HPOS + LSH A,8 + IORI A,(BP) ;DESIRED VPOS + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "f ? 40 ? 40] + MOVEM A,DISBF1+5 ;$f + RET +] ;I100 + +IFN TK4023,[ +SUBTTL TEKTRONIX 402 (UGH) 3 + +; Note - this currently runs with the screen (except the mode line) in +; inverse video, for greater readability. If you don't like this see +; T3CLRS for how to fix it. + +TK43TB: 24.,,77. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL T3CPS + CALL T3CEOL + CALL T3CEOS + CALL T3CLRS + CALL T3MCLS + CALL T3DSMV + CALL T3DMV1 +REPEAT 5,JFCL + +T3CPS: MOVEI A,28. + PBOUT + MOVEI A,41(B) ; X POS + PBOUT + HLRZ A,B ; Y POS + ADDI A,40 + PBOUT + RET + +T3CLRS: SAVE A + SAVE B + SAVE C + MOVEI A,33 ; ESCAPE + PBOUT + MOVEI A,^L ; FORMFEED + PBOUT + + MOVSI C,-24. ; AOBJN PTR +T3CLR1: HRLOI B,(C) ; GO TO X = -1 + CALL T3CPS + MOVEI A,31. ; SET A PROTECTED ATTRIBUTE + PBOUT + MOVEI A,"J ; NOTE - MAKE THIS "B FOR NON-INVERT SCREEN + PBOUT + AOBJN C,T3CLR1 + SETZ B, ; GO BACK HOME + CALL T3CPS + JRST POP321 + +T3MCLS: MOVE A,[[.BYTE 7 ? 28. ? 41 ? 40 ? 31. ? "@ + 33 ? "O ? 1 ? 1 ? 1 + 1 ? 28. ? 40 ? 40 ? 31. + "B],,MORMCL] + BLT A,MORMCL+3 + LSH C,1+7 + ADDM C,MORMCL+2 + LSH C,7 + ADDM C,MORMCL + RET + +T3DSMV: SAVE B + MOVE B,[[.BYTE 8 ? 28. ? 41 ? 40 ? 31. + "@ ? 33 ? "O ? 0 + 0 ? 0 ? 0 ? 28. + 41 ? 40 ? 40 ? ^H],,DISBF1+2] + BLT B,DISBF1+5 + MOVE B,DISCPH + LSH B,8 + ADDI B,(BP) + LSH B,8+4 + ADDM B,DISBF1+2 + LSH B,8 + ADDM B,DISBF1+5 + JRST CPOP2J + +T3DMV1: SAVE B + MOVE B,DISCPH ; X POS + LSH B,8. + ADDI B,40(BP) ; Y POS + LSH B,4 + ADD B,[.BYTE 8 ? 0 ? 28. ? 41 ? 0] + MOVEM B,DISBF1+5 + JRST CPOP2J + +T3CEOS: +T3CEOL: SAVE A + SAVE B + SAVE C + HRROI A,[.BYTE 7 ? 31. ? "H ? 33 ? "O] + PSOUT + SKIPN C,OSPEED ; GOTTA PAD? + JRST T3CEO1 ; ASSUME THE WORST + SETZ A, + CAIL C,4800. + HRROI A,[.BYTE 7 ? 1 ? 1] + CAIL C,9600. +T3CEO1: HRROI A,[.BYTE 7 ? 1 ? 1 ? 1 ? 1] + SKIPE A + PSOUT + MOVE B,TTLPOS ; MUST REPOSITION CURSOR + CALL T3CPS + HRROI A,[.BYTE 7 ? 40 ? ^H] + PSOUT + JRST POP321 + +] ;IFN TK4023 + +IFN ANNARB,[ +SUBTTL ANN ARBOR + +AATB: 40.,,78. ;DISPATCH TABLE FOR ANN ARBOR + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL AACPS ;NOTE: WIDTH MUST BE 78 DUE TO CRETINOUS + CALL AACEOL ;AUTO CRLF AND SCROLL AFTER WRITING IN COLUMN 79. + CALL AACEOS ;SO THE "!" MUST GO IN COLUMN 78. + CALL AACLRS + CALL AAMCLS + CALL AADSMV + CALL AADMV1 + JFCL + JFCL + JFCL + JFCL + JFCL + + +; AACPS - OUTPUT ANN ARBOR CURSOR POSITIONING COMMANDS TO TERMINAL. + +; ARGUMENT: +; B LINE,,COLUMN + +AACPS: JUMPE B,[MOVEI A,^K ; SIMPLE HOME? + PBOUT ; YES, USE HOME COMMAND INSTEAD OF ABSOLUTE + RET] ; POSITIONING + MOVEI A,^O ; SEND START OF ABSOLUTE CURSOR POSITION + PBOUT ; SEQUENCE + SAVE B ; SAVE LINE,,COLUMN + MOVEI A,(B) ; GET COLUMN NO. + IDIVI A,10. ; CONVERT TO FUNNY BCD REPRESENTATION + LSH A,4 ; ... + IOR A,B ; ... + PBOUT ; OUTPUT + HLRZ A,(P) ; GET LINE NO. + CAIL A,20. ; THIS IS WEIRD + ADDI A,12. ; ... + ADDI A,100 + PBOUT + REST B ; RESTORE CURSOR POSITION + RET + + +AACEOS: ; CLOSE ENOUGH FOR MOST THINGS +AACEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUBI C,80. ; MAKE HPOS-80 + HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + MOVE B,TTLPOS + CALL AACPS + POP P,C + POP P,B + POP P,A + RET + + +AACLRS: MOVEI A,^L + PBOUT + RET + + +; AAMCLS - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED LINE AND +; CLEAR IT. THE COMMANDS ARE PUT IN MORMCL, WHICH IS OUTPUT AT SOME LATER +; TIME. ACTUALLY WE SIMPLY PUT THE LINE NO. IN MORMCL AND CLRMOR HAS A +; SPECIAL TEST WHICH JUMPS TO CLRM16 (SIGH). + +; ARGUMENT: +; C LINE NO. TO BE CLEARED + +AAMCLS: MOVSM C,MORMCL + RET + +CLRM16: SAVE A + SAVE B + MOVE B,MORMCL + CALL AACPS + MOVEM B,TTLPOS + CALL AACEOL + JRST POP21J + + +; AADSMV - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +AADSMV: SETZM EOLFLG ; NO CLEARING + SKIPN HCDS(BP) ; NEED CLEARING? + SETOM EOLFLG ; YES, SET FLAG TO DO IT LATER +; FALL THROUGH TO AADMV1 + + +; AADMV1 IS JUST LIKE AADSMV, EXCEPT THAT IT DOES NOT CLEAR. + +AADMV1: SAVE B ; SAVE AC + MOVE A,DISCPH ; GET COLUMN NO. + IDIVI A,10. + LSH A,4 + IORI A,^O_8.(B) + LSH A,8. + ADDI A,100(BP) + CAIL BP,20. + ADDI A,12. + LSH A,4 ; SHIFT INTO HIGH 32 BITS OF THE WORD + MOVEM A,DISBF1+5 ; ^O COLUMN LINE + REST B ; RESTORE AC + RET + +] ; IFN ANNARB + +IFN C100,[ +SUBTTL HDS C100 +; SUPPORT FOR THE HUMAN DESIGNED SYSTEMS' CONCEPT-100 AND CONCEPT-APL +; TERMINALS. +; +; NOTES: THESE TERMINALS MUST BE IN `PROGRAMMER MODE' FOR THINGS LIKE +; CURSOR ADDRESSING TO WORK; WE ALWAYS PUT THE TERMINAL IN THIS MODE, +; WHICH IS THE CORRECT ONE FOR FULL-DUPLEX SYSTEMS, AT EACH SCREEN CLEAR, +; UNDER THE ASSUMPTION THAT THE FIRST USEFUL THING DONE BY EMACS IS TO CLEAR +; THE SCREEN. LEAVING THE TERMINAL IN THIS MODE CAN'T HURT. +; +; THE CONCEPT SERIES NEEDS A FAIR AMOUNT OF FILL CHARACTERS FOR MOST +; OF THE MORE COMPLICATED FUNCTIONS; AT WORST, 50 MS. OF FILL WOULD BE +; NEEDED (EG, FOR AN INSERT-CHARACTER FUNCTION AT THE START OF A FULL +; SCREEN). IN THIS CODE, WE'VE TRIED TO PARAMETRIZE THE FILL FACTOR +; FOR EACH FUNCTION, AND COMPUTE THE ACTUAL AMOUNT OF FILL (NULS ARE +; USED), DEPENDING ON THE SPEED. NOTE THAT WE CAN ONLY USE 79. COLUMNS +; ON THE CONCEPT, AS PROBLEMS OCCUR WITH LINE FEEDS IF AUTO-CRLF HAS +; HAPPENED ON THE LAST LINE OF THE WINDOW (IT'S TOO UGLY TO DESCRIBE +; HERE). + +C100TB: 24.,,78. ; CONCEPT DESCRIPTOR TABLE: SIZE, + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ; CAPABILITIES, + CALL CPCPS ; ROUTINES: CURSOR POSITIONING + CALL CPCEOL ; CLEAR TO END OF LINE + CALL CPCEOS ; CLEAR TO END OF SCREEN + CALL CPCLRS ; CLEAR SCREEN + CALL CPMCLS ; BUILD --MORE-- CLEARER + CALL CPDSMV ; SET UP DISBF1 FOR MOVING TO, CLEARING LINE + CALL CPDMV1 ; DITTO, BUT DON'T DO ANY CLEARING + CALL CPINSL ; INSERT SOME LINES + CALL CPDELL ; DELETE 'EM, TOO + CALL CPINSC ; INSERT A CHAR + CALL CPDELC ; AND MAYBE DELETE ONE + CALL CPTRST ; RESET THE TERMINAL (RESET WINDOW) + CALL CPWUP ; MOVE LINES VIA WINDOWING UP + CALL CPWDN ; DOWN + +; FUNCTION CODES (FOR DELAY CALCULATIONS); IF YOU EVER CHANGE THESE, CHANGE +; THE DELAY TABLE IN CPFILC, TOO. + +%FCCES==0 ; CLEAR TO END OF SCREEN, +%FCCEL==1 ; CLEAR TO END OF LINE, +%FCCLS==2 ; CLEAR SCREEN, +%FCINL==3 ; INSERT LINE, +%FCDLL==4 ; DELETE LINE + +; POSITION CURSOR TO (VERTICAL POSTION,,HORIZONTAL POSTION) IN B + +CPCPS: JUMPE B,[HRROI A, [.BYTE 7 ? 33 ? "? ? 0] ; GOING HOME IS EASY + PSOUT ; OUTPUT `$?' + RET ] ; AND GET OUT + SAVE C ; SAVE WORK REG + MOVE C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 0] ; BUILD POSITIONER IN C + HLRZ A, B ; GET VERTICAL POSITION + LSH A, 7 ; MOVE IT INTO POSITION + IORI A, (B) ; FOLLOWED BY THE HORIZONTAL + LSH A, 7+1 ; POSITION + ADD C, A ; DROP IT IN + HRROI A, C ; FINALLY, OUTPUT IT ALL + PSOUT ; ... + REST C ; GET BACK WORK REG + RET ; ALL DONE + +; CLEAR TO END OF SCREEN + +CPCEOS: + HRROI A, [.BYTE 7 ? 33 ? ^E ? 0] ; OUTPUT CLEAR-ALL TO + PSOUT ; END OF WINDOW + PUSH P, [1] ; WORST CASE ASSUMED + MOVEI A, %FCCES ; AND FILL APPROPRIATELY + CALL CPFILL ; FOR THIS FUNCTION AND SPEED + RET ; EVERYONE'S HAPPY + +; CLEAR TO END OF LINE + +CPCEOL: HRROI A, [.BYTE 7 ? 33 ? ^U ? 0] ; OUTPUT CLEAR-ALL TO + PSOUT ; END OF LINE + MOVEI A, %FCCEL ; FILL FOR THIS FUNCTION + PUSH P, [1] ; NO MULTIPLIER NEEDED + CALL CPFILL + RET ; ALL OK + +; CLEAR SCREEN ENTIRELY (SEE NOTE ABOVE) + +CPCLRS: HRROI A, [.BYTE 7 ? 33 ? "U ? ^L ? 0] ; MAGIC MUMBLE TO GO INTO + PSOUT ; `PROGRAMMER MODE' AND CLEAR SCREEN + MOVEI A, %FCCLS ; DELAY APPROPRIATELY + PUSH P, [1] ; NO MULTIPLIER + CALL CPFILL + RET + +; SET UP MORMCL TO CLEAR (--MORE--) LINE AT VERTICAL POSITION IN C + +CPMCLS: LSH C, 7+7+1 ; SHIFT POSITION TO FINAL RESTING PLACE + ADD C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 33] ; ADD IN POSITIONER + MOVEM C, MORMCL ; PUT WHERE IT'LL BE USEFUL + MOVSI C, (.BYTE 7 ? ^U) ; FINALLY, DROP IN A CLEAR TO END + MOVEM C, MORMCL+1 ; OF LINE + RET ; ALL DONE + +; *HACK* ROUTINE CALLED BY CLRMOR ROUTINE ABOVE, TO OUTPUT MORMCL, +; FOLLOWED BY APPROPRIATE DELAY. + +CLRM17: JSR SAV123 ; NEED THESE FOR WORK + MOVEI A, 101 ; STANDARD OUT PORT + HRROI B, MORMCL ; OUTPUT MORMCL + MOVNI C, 9. ; POSITION, CLEAR, AND DELAY + SOUT ; ZAP + JRST POP321 ; ALL DONE + +; SET UP DISBF1 TO MOVE TO LINE (VERTICAL POSITION) IN BP, CLEAR +; LINE, AND GO TO HORIZONTAL POSITION IN DISCPH ON THAT LINE. +; NOTE: WE'RE ASSUMING YOU DON'T NEED MORE THAN 5 OR 6 DELAYING NULS +; AT FULL SPEED FOR CLEARING-ALL TO END OF LINE. + +CPDSMV: SAVE B ; STASH WORK REG AWAY + MOVEI A, 40(BP) ; GET VERTICAL COORDINATE + LSH A, 8.+4. ; MOVE IT INTO POSITION + ADD A, [.BYTE 8. ? 33 ? "a ? 0 ? 40] ; MAKE POSITIONER + MOVSI B, (.BYTE 8. ? 33 ? ^U) ; AND CLEAR-ALL-ER TO E-O-L + SETZM DISBF1+5 ; ASSUME NO HORIZONTAL MOTION + SETZM DISBF1+4 ; ... + SKIPN DISCPH ; DO WE NEED HORIZONTAL MOTION AFTER? + JRST [ MOVEM A, DISBF1+2 ; NO, JUST DUMP IT ALL + MOVEM B, DISBF1+3 + JRST CPOP2J ] ; OUT AND RETURN + MOVEM A, DISBF1+1 ; YES, PUT DOWN POSITIONER AND CLEARER + MOVEM B, DISBF1+2 + SETZM DISBF1+3 ; MAKE SURE THE PADDING NULLS ARE THERE + MOVEI B, (BP) ; GET VERTICAL COORDINATE + LSH B, 8. ; POSITION IT + ADD B, DISCPH ; GET HORIZONTAL POSITION + LSH B, 4 ; GET INTO THE RIGHT SLOT + ADD B, [.BYTE 8. ? 33 "a ? 40 ? 40] ; FINALLY FINISH IT UP + MOVEM B, DISBF1+5 ; AND DROP IT INTO THE DISPLAY BUFFER + JRST CPOP2J ; ALL DONE + + +; SET UP DISBF1 TO MOVE TO POSITION AS CODED BY (BP, DISCPH); DON'T +; CLEAR ANYTHING. + +CPDMV1: SETZM DISBF1+3 ; CLEAR OUT UNUSED PART OF DISPLAY + SETZM DISBF1+4 ; BUFFER + MOVEI A, (BP) ; GET VERTICAL POSITION + LSH A, 8 ; MAKE ROOM FOR HORIZONTAL + IOR A, DISCPH ; POSITION + LSH A, 4 ; ACCOUNT FOR POSITION OF 4 8.-BIT BYTES + ADD A, [.BYTE 8 ? 33 ? "a ? 40 ? 40] ; BUILD POSITIONER + MOVEM A, DISBF1+5 ; AND DROP INTO ITS FINAL RESTING PLACE + RET ; ALL DONE + + +; INSERT AND DELETE C(Q) LINES (AT THE VERTICAL POSITION IN BP); ON +; CONCEPT'S, THE CURSOR DOESN'T MOVE. + + ; ENTER HERE WITH SCREEN SIZE IN A +CPINSW: SAVE B ; (USED BY CPWIN ROUTINE ONLY) + PUSH P, A ; AND PUT IT WHERE USED LATER + JRST CPINS5 ; GO JOIN COMMON CODE + +CPINSL: SAVE B ; SAVE A WORK REG + PUSH P, [24.] ; AT THIS POINT, ASSUME FULL SCREEN +CPINS5: MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + POP P, B ; GET WINDOW SIZE INTO B + SUBI B, (BP) ; AND COMPUTE NUMBER OF LINES BEING MOVED +CPINS1: HRROI A, [.BYTE 7 ? 33 ? ^R ? 0] ; FOR EACH LINE TO BE + PSOUT ; INSERTED, `$^R' DOES IT + PUSH P, B ; PASS # LINES FOR FILL ACTION + MOVEI A, %FCINL ; AND DELAY APPROPRIATELY + CALL CPFILL + HRROI A, [.BYTE 7 ? 33 ? "< ? 0] ; NOW, GO ONTO NEXT LINE + PSOUT + SOJ B, ; BUMP DOWN NUMBER OF LINES BEING SHOVED DOWN + SOJG Q, CPINS1 ; DO FOR NUMBER OF LINES REQUESTED + REST B ; GET BACK WORK REG + RET ; ALL DONE + +CPDELL: SAVE B ; SAVE A WORK REG + MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + MOVEI B, 24. ; COMPUTE NUMBER OF LINES + SUBI B, (BP) ; BEING AFFECTED +CPDEL1: HRROI A, [.BYTE 7 ? 33 ? ^B ? 0] ; DELETE A LINE + PSOUT ; ... + PUSH P, B ; PASS # LINES FOR FILL ACTION, AND + MOVEI A, %FCDLL ; WAIT FOR THIS SLOW + CALL CPFILL ; TERMINAL + SOJG Q, CPDEL1 ; DO IT NUMBER OF TIMES REQUESTED + REST B ; GET BACK WORK REG + RET + +; INSERT AND DELETE CHARACTER; THE INSERT-CHARACTER WORKS BY ACTUALLY +; ENTERING INSERT MODE, DROPPING IN A SPACE TO MAKE ROOM, AND LEAVING +; INSERT MODE; THEN, MOVE BACK OVER THE SPACE. + +CPINSC: SAVE B ; STASH WORK REGS + SAVE C ; ... + MOVEI A, .PRIOU ; PRIMARY OUT PORT + HRROI B, [.BYTE 7 ? 33 ? ^P ? 40 ? 33 ? 0 ? ^H] ; OUTPUT IT ALL + MOVNI C, 6 ; BYTE COUNT + SOUT ; OUT SHE GOES + REST C ; RESTORE WORK REGS + REST B ; ... + RET + +CPDELC: HRROI A, [.BYTE 7 ? 33 ? ^Q ? 0] ; DELETE CHARACTER IN LINE + PSOUT + RET + +; ROUTINE TO FILL (WITH NULS) APPROPRIATELY FOR ANY GIVEN FUNCTION +; (AS CODED BY %FCXXX, ABOVE). THE FUNCTION CODE IS IN A. +; CLOBBERS A. THE FILL FACTOR (E.G., NUMBER OF LINES AFFECTED) IS +; AT -1(P), AND IS PEELED OFF THE STACK. + +CPFILL: EXCH B, (P) ; GET RETURN ADDRESS, SAVE WORK REG + EXCH B, -1(P) ; GET FILL FACTOR, SAVE RETURN ADDRESS + CALL CPFILC ; COMPUTE HOW MANY NULS ARE NEEDED (TO A) + SAVE C ; GET JSYS WORK REG + MOVNI C, (A) ; GET DELAY COUNT + MOVEI A, .PRIOU ; PRIMARY OUTPUT + HRROI B, [.BYTE 7 ; LOTS OF NULLS + REPEAT 100., 0 + ] + SOUT ; OUTPUT AS MANY NULLS AS NEEDED + REST C ; RESTORE WORK REG + REST B ; DONE WITH B + RET ; DONE WITH US + + +; ROUTINE TO COMPUTE HOW MANY NULS ARE NEEDED TO FILL AFTER A GIVEN +; FUNCTION; %FCXXX CODE IS IN A, FILL FACTOR IN B. +; RETURNS RESULT IN A. + +CPFILC: MOVE A, (A) [ ; GET DELAY BASED ON CODE (>1200,,<=1200) + 48.,,1. ; CLEAR TO END OF SCREEN (%FCCES) + 6.,,1. ; CLEAR TO END OF LINE (%FCCEL) + 48.,,3. ; CLEAR SCREEN (%FCCLS) + 4.,,1. ; INSERT LINE (%FCINL) + 4.,,1. ; DELETE LINE (%FCDLL) + ] + SAVE C ; STASH WORK REGISTER + SKIPE C, OSPEED ; GET SPEED WE'RE RUNNING AT + CAILE C, 1200. ; AND IF IT'S GREATER THAN 1200 BAUD, + MOVS A, A ; USE LEFT HALF + TLZ A, -1 ; USE WHATEVER IS IN RIGHT HALF NOW + IMULI A, (B) ; MULTIPLY BY FILL FACTOR + REST C ; RESTORE WORK REG + RET ; ALL DONE, RESULT IS IN A + +; MOVE LINES AROUND ON SCREEN USING HARDWARE WINDOWING TO WIN ON SPEED. +; (SIGH; THIS CODE WILL PROBABLY BE USELESS WHEN THEY SPEED UP INSERT/ +; DELETE LINE). SEE MOVWIN ROUTINE FOR INPUTS. + +CPWDN: SAVE B ; SAVE WORK REG + MOVEI B, (BP) ; GET DESTINATION LINE (TOP LINE OF WINDOW) + MOVE A, BOTLIN ; GET # OF LINES IN + SUBI A, (B) ; HARDWARE WINDOW + CALL CPSETW ; SET UP THE WINDOW + SETZ BP, ; WANNA INSERT C(Q) LINES AT TOP OF SCREEN + CALL CPINSW ; GO INSERT THEM + CALL CPWRST ; RESET THE HARDWARE WINDOW TO WHOLE SCREEN + JRST CPOP2J ; RESTORE B AND GET OUT + +; HERE TO MOVE A GROUP OF LINES UP + +CPWUP: SAVE B ; SAVE A WORKING REGISTER + SAVE A ; SAVE JSYS WORK REGS + SAVE C + MOVE B, BP ; GET DESTINATION LINE (TOP OF NEW WINDOW) + MOVE A, BOTLIN ; GET # OF LINES + SUBI A, (B) ; IN WINDOW + CALL CPSETW ; SET THE WINDOW + MOVEI B, (A) ; GET # OF LAST LINE IN WINDOW + SUBI B, 1 ; ... + HRLZ B, B ; MAKE INTO (VPOS,,HPOS) OF LAST LINE + CALL CPCPS ; GO THERE + MOVEI A, .PRIOU ; TTY OUT PORT + HRROI B, [.BYTE 7 ; MAKE LOTS OF S WITH PADDING + REPEAT 24., ^J ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + ] + MOVNI C, (Q) ; GET NEGATIVE # OF LINES TO MOVE UP + IMULI C, 7 ; TIME # CHARS PER LINE SHIFT + SOUT ; SCROLL IT UP WITH S + CALL CPWRST ; RESET WINDOW + REST C ; GET BACK WORK REGS + REST A + JRST CPOP2J ; RESTORE B AND GET OUT + +; WINDOW-SETTING UTILITY ROUTINES +; SET UP A WINDOW; A/ # OF LINES WANTED ON SCREEN, B/ LINE # OF HOME + +CPSETW: JSR SAV123 ; SAVE WORK REGS + SAVE D + SAVE E + MOVE D, [.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 40] + MOVE E,[.BYTE 7 ? 80.+40 ? 0 ? 0 ? 0 ? 0] ; GET SKELETON + LSH B, 7+7+1 ; GET STARTING LINE AND + LSH A, 1 ; LENGTH INTO POSITION + ADD D, B ; AND DROP THEM IN + ADD D, A + MOVEI A, .PRIOU + HRROI B, D ; NOW SET THE WINDOW + MOVNI C, 10. + SOUT + REST E + REST D + JRST POP321 ; RESTORE WORK REGS + +; RESET THE HARDWARE WINDOW TO ITS FULL (?) GLORY + +CPWRST: JSR SAV123 ; SAVE WORK REGS + MOVEI A, .PRIOU + HRROI B, [.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 24.+40 ? 80.+40 ? 0 ? 0 ? 0] + MOVNI C, 10. + SOUT ; OUTPUT WINDOW-RESET SEQUENCE + JRST POP321 ; ALL DONE + + +; RESET THE WHOLE TERMINAL, UPON EXIT. + +CPTRST: SAVE B ; SAVE WORK REG + CALL CPWRST ; RESET THE WINDOW + MOVE B,TTLPOS + CALL CPCPS ; GO THERE + JRST CPOP2J ; RESTORE B AND GET OUT + +] ;C100 + +IFN IQ120,[ +SUBTTL SOROC IQ 120 + +IQ12TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL IQCPS + CALL IQCEOL + CALL IQCEOS + CALL IQCLRS + CALL IQMCLS + CALL IQDSMV + CALL IQDMV1 +REPEAT 5,JFCL + +IQCPS: JUMPE B,[ + MOVEI A,^^ ;SAVE A LITTLE FOR HOME + PBOUT + RET ] + HRROI A,[ASCIZ /=/] + PSOUT + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + PBOUT + RET + +IQCEOL: HRROI A,[ASCIZ /T/] ;CLEAR EOL + PSOUT + RET + +IQCEOS: HRROI A,[ASCIZ /Y/] ;CLEAR EOS + PSOUT + RET + +IQCLRS: HRROI A,[ASCIZ /+/] ;CLEAR SCREEN + PSOUT + RET + +IQMCLS: LSH C,14.+1 ;SETUP MORMCL TO CLEAR LINE IN C + ADD C,[.BYTE 7 ? 33 ? "= ? 40 ? 40 ? 33] + MOVEM C,MORMCL + MOVSI C,(.BYTE 7 ? "T ? 0) + MOVEM C,MORMCL+1 + RET + +IQDSMV: SAVE B ;SETUP DISBF1 TO GO TO POSITION FROM BP AND DISCPH + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "T] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "=] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IQDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $= ? $T + MOVEM B,DISBF1+5 + JRST CPOP2J +IQDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $= ? $T ? ... + MOVEM B,DISBF1+4 + CALL IQDMV1 + JRST CPOP2J + +IQDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] + MOVEM A,DISBF1+5 ;$= + RET +] ;IQ120 + +IFN TK4025\ANNARB,[ +SPACES: ASCII / / +] ; IFN TK4025\ANNARB +];IFN TNX + +SUBTTL INTERRUPT HANDLERS + +IFN ITS,[ + +TSINTP: MOVEM 16,INTACS+16 ;SAVE ALL ACS. + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVE C,TSINT +TSIL: HRRZ A,TSINT+1 ;GET THE PC IN CASE THE INTERRUPT ROUTINE WANTS TO CHECK IT FOR TYIIOT + JUMPL C,TSIN2 ;INT IN SECOND WORD + TLZE C,%PJATY + JRST TSINTA + TLZE C,%PJRLT + JRST TSINTC + TLZE C,%PJWRO + TYPRE [PUR] + TRZE C,%PIMPV ;MPV => CREATE THE NONEXISTENT CORE AND RETRY. + JRST TSINT4 + TRZE C,%PIPDL + TYPRE [PDL] +TSIN2A: MOVSI 16,INTACS + BLT 16,16 + .SUSET [.SJPC,,INTJPC] + .DISMI TSINT+1 + +TSINTA: SKIPE RGETTY ;TTY GIVEN BACK TO TECO INTERRUPT. + SKIPL CLRMOD ;THIS FEATURE CAN BE DISABLED FOR DEBUGGING. + JRST TSIL + SETOM PJATY ;SAY THAT WE SHOULD CLEAR THE SCREEN AND REDISPLAY COMPLETELY. + SETOM DISOMD + JRST TSIL + +TSINTC: SETOM CLKFLG ;REAL-TIME CLOCK INTERRUPT. SAY IT'S TIME TO RUN THE HANDLER. + CAIE A,TYIIOT ;IF WE ARE NOW WAITING FOR INPUT, RUN IT RIGHT AWAY, + JRST TSIL + MOVEI A,TSINTD + MOVEM A,TSINT+1 ;BUT FIRST EXIT FROM INTERRUPT LEVEL AND RESTORE ACS. + JRST TSIL + +TSINTD: CALL RLTCLK + JRST TYIIOT + +TSINT4: SOS TSINT+1 + CAIL A,HUSED ;MPV INT: CATCH JUMPS TO RANDOMNESS. + .VALUE + .SUSET [.RMPVA,,A] ;GET ADR START OF MISSING PAGE. + LSH A,-12 + MOVE B,A + IMULI B,2000*5 + CAMGE B,QRWRT ;ALL OF IMPURE STRING SPACE MARKED AS EXISTING SHOULD + .VALUE ;REALLY EXIST, OR THERE'S A BUG. + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + SYSCAL CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,%JSELF ? %CLIMM,,-1(A) ? %CLIMM,,%JSNEW] + .LOSE %LSSYS + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +TSINT6: SKIPE DISPRR ;HANDLE INTERRUPT FROM ALTMODE + JRST TSIL ;DO NOTHING IF INSIDE ^R. + SETCMM TSINAL ;REMEMBER PARITY OF ALTMODES, + SKIPN TSINAL ;IF SECOND, STOP DISPLAYING BUFFER. + JRST [ AOS TSALTC ;COUNT NUMBER OF $$ PAIRS SEEN. + JRST TSIL] + CALL TTYAC2 ;IF FIRST ALTMODE, SAY THAT NEXT CHARACTER MUST INTERRUPT + JRST TSIL ;SO WE CAN TELL AT INT. LEVEL. WHETHER THIS IS A $$ PAIR. + +TSIN2: TRZN C,TYPIN ;SECOND WORD INTERRUPT. IS IT TYPE-IN? + JRST TSIN2A ;THAT'S ALL THERE IS. +TSINT1: MOVEI A,CHTTYI + .ITYIC A, + JRST TSIL + HRRZ CH,TSINT+1 + CAIN CH,ASLEE2 ;IF M.P. IS INSIDE A :^S, WAKE IT UP + AOS TSINT+1 ;(IT HAS ARRANGED FOR ALL CHARS TO INTERRUPT) + TRZ A,SHIFT+SHIFTL + HRRZ CH,A + ANDI CH,177 + CAIN CH,33 ;ALTMODE => MUST SEE IF FOLLOWING CHAR IS AN ALTMODE. + JRST TSINT6 + SETZM TSINAL ;ELSE TELL NEXT CHAR (IF ALTMODE) THAT PREV. CHAR. WASN'T ONE. + CAIE A,^G + CAIN A,CONTRL+"G + JRST TSINT3 ;NOW CHECK FOR ALL FORMS OF ^G. + CAIE A,CONTRL+"G+40 + JRST TSIL +TSINT3: TLNN FF,FLNOIN ;UNLESS IT IS JUST DISPLAYING, ... + SKIPE RREBEG ;DONT SET IF IN A ^R + SETOM STOPF + SKIPLE CH,NOQUIT + JRST TSIL + HRRZ A,TSINT+1 + AOJL CH,TSINT5 ;-2FSNOQUIT$ => DON'T FLUSH INPUT & OUTPUT. + SKIPE RGETTY + JRST TSINT7 ;ON DISPLAYS, CAN'T .RESET MAIN OUTPUT SINCE COULD LOSE TRACK OF SCREEN + HLRZ CH,(A) + ANDI CH,777740 + CAIN A,DISSI1 + AOSA A,TSINT+1 + CAIN CH,(.IOT CHDPYO,) ;ON PRINTING TTY DON'T RETURN TO HUNG OUTPUT .IOT + AOS A,TSINT+1 + .RESET CHDPYO, + .RESET CHTTYO, +TSINT7: .RESET CHTTYI, + SETOM UNRCHC + SETZM TYISRC ;FLUSH ANY EXECUTING KBD MACRO. + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK ;FLUSH DEFINING A KBD MACRO. + MOVE CH,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(CH) + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,TSINT+1 + MOVEI CH,CONTRL+"G ;IF NOW INSIDE ^R, STICK A ^G IN AS INPUT + SKIPN RREBEG ;INSTEAD OF SETTING STOPF (WHICH WE AVOIDED DOING). + MOVEM CH,UNRCHC + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + SKIPE RREBEG + SETOM ORESET ;SIGNAL TYPEOUT ROUTINES TO STOP TYPING +TSINT5: SKIPN RREBEG + JRST TSIL + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT, ERR, OR DO NOTHING ACCORDING TO NOQUIT. + JRST TSIL +] + +IFN TNX,[ +;^G INTERRUPT COMES HERE +TSINT: MOVEM 16,INTACS+16 ;SAVE ACS + MOVEI 16,INTACS + BLT 16,INTACS+15 +TSINT3: SKIPE B,SAVMOD ;RESTORE TTY MODE REQUESTED? + CALL FFRRT2 ;YES, DO IT THEN + TLNN FF,FLNOIN + SKIPE RREBEG ;FROM ^R? + SETOM STOPF + SKIPLE B,NOQUIT ;QUIT NOT ALLOWED? + JRST TSIL ;YES, RETURN RIGHT AWAY + MOVEI CH,CONTRL+"G + AOJL B,TSINT5 ;WANTS CLEAR INPUT? + MOVEI A,.PRIIN ;YES + CFIBF + SETOM UNRCHC ;NOTHING WAITING + SETZM TYISRC + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK + MOVE A,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(A) + SKIPE RREBEG + SETOM ORESET + SKIPN RREBEG ;IF FROM ^R, ... +TSINT5: MOVEM CH,UNRCHC ;PRETEND TO READ IT RATHER THAN SETTING STOPF + HRRZ A,INTPC1 + CAIE A,WAITX ;NOT INPUT IF RUNNING INFERIOR + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,INTPC1 ;DONT GET HUNG UP ON READING FROM TTY + SKIPN RREBEG ;RETURN IF FROM ^R + JRST TSIL + CAIN A,WAITX ;RUNNING AN INFERIOR? + JRST [ SETZM STOPF ;DON'T QUIT OUT OF FZ + MOVEM A,INTPC1 ;SAVE RETURN PC + MOVEI A,^G ;RING CHIMES + PBOUT + MOVE A,INTACS+A ;GET FORK HANDLE + FFORK ;FREEZE IT + JRST TSIL] ;DEBRK TO PROCESS TERMINATION CODE + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT IF REQUESTED +TSIL: MOVSI 16,INTACS ;RETURN + BLT 16,16 + DEBRK + +NXPINT: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI 1,.FHSLF + GTRPW + MOVEI B,(A) ;GET WORD THAT GOT PAGE FAULT + ANDI A,-1 + LSH A,-12 + IMULI B,5 + CAMGE B,QRWRT + .VALUE + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +CNTRLC: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI CH,^C + CALL ECHOCH + CALL .EXIT + JRST TSIL + +.EXIT: SKIPN SAVMOD ;UNLESS FROM INSIDE GTJFN + CALL DPYRST ;TAKE TERMINAL OUT OF DISPLAY MODE + MOVEI A,.PRIOU ;TENEX EXEC DOESNT KNOW ALWAYS KNOW + RFMOD +IFN 20X,[SKIPE PAGMOD ;WAS PAGE MODE IN EFFECT? + TROE B,TT%PGM ;YES, IS IT NOW? + CAIA + STPAR + MOVE B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE + SFPOS +] +IFN 10X,[CALL ECHOCR ;CANNOT TELL MONITOR POSITION, SO GO TO BOL + TRON B,100 ;ABOUT RESTORING ASCII DATA MODE + SFMOD + MOVEI A,.FHJOB + SETO B, ;AND JOB TERMINAL INTERRUPT MASK + STIW +] + MOVEI B,BEG .SEE CIRC + HALTF ;STOP HERE + +PAGON: SETOM PJATY ;MUST ASSUME WE MESSED UP THE SCREEN +IFN 20X,[ + SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE + JRST DOSTIW +];20X + MOVEI A,.PRIOU + RFMOD +IFN 20X,[ + LDB C,[.BP TT%PGM,B] + MOVEM C,PAGMOD ;SAVE CURRENT PAGE MODE SETTING FIRST +];20X + TRZE B,TT%PGM\TT%DAM ;MAKE SURE PAGE MODE TURNED OFF + SKIPN RGETTY ;ON DISPLAYS + JRST DOSTIW + SFMOD + STPAR + +DOSTIW: MOVEI A,.FHSLF + RPCAP + JUMPGE C,CPOPJ ;NO ^C CAPABILITY + MOVEI A,.FHJOB ;RESTORE INTERRUPT MASKS +IFN 10X,TLO A,400000 + MOVE B,[042000,,000020] ;^C & ^G + MOVE C,RRMACT+CONTRL+"T ;IF ^T NOT ASSIGNED AS COMMAND + CAIN C,RRUNDF + TRO B,100000 ;ALLOW IT AS INTERRUPT TO SYSTEM + MOVSI C,040000 ;^C DEFERRED + STIW + RET + +LEVTAB: INTPC + INTPC1 + INTPC2 +CHNTAB: 2,,TSINT ;^G +IFN 20X,3,,ASLEE2 ;ANYTHING TO WAKE FROM :^S +.ELSE 0 + 1,,CNTRLC ;CONTROL-C INTERRUPT +IFN 20X,3,,TSINTC ;CLOCK INTERRUPT + BLOCK .ICPOV-<.-CHNTAB> + 1,,[CIS ? TYPRE [PDL] ] ;PUSHDOWN OVERFLOW + BLOCK .ICTOD-<.-CHNTAB> +IFN 10X,3,,TSINTC ;10X IIT INTERRUPT + BLOCK .ICNXP-<.-CHNTAB> + 2,,NXPINT ;NEW PAGE CREATED + BLOCK 36.-<.-CHNTAB> +];END IFN TNX + +SUBTTL BIGPRINTING + +.FNPNT: +IFN ITS,[SYSCAL RFDATE,[%CLIMM,,CHFILI ? %CLOUT,,PTLFCD] + SETOM PTLFCD +] + MOVEI A,PPA + HRRM A,LISTF5 + PUSHJ P,.+1 ;PRINT THE BIGPRINT TWICE. + MOVEI A,ERDEV+DEFFN1-DEFDEV ;FN1 + CALL .FNPT2 + MOVEI A,ERDEV+DEFFN2-DEFDEV ;FN2 + CALL .FNPT2 + JRST FORMF + +;BIGPRINT THE FILENAME WHOSE ADDRESS IS IN A +.FNPT2: +IFN TNX,MOVE C,A +IFN TNX,CALL .ST26B +IFN ITS,MOVE A,(A) + PUSH P,A + TRNN FF,FRARG + PUSHJ P,PTLAB +.FN3: MOVE A,(P) + MOVEI C,4 + PUSHJ P,CRR1 + SOJN C,.-1 + MOVEI TT1,7 +.FN239: MOVEI J,3 +.FN249: SETZM B + ROTC A,6 + MOVEI T,3 +.FN259: XCT LDBT1-1(T) + IMULI B,10101 + SETZM E + TRNE TT,2 + HRLM B,E + CAIG T,1 + JRST .FN269 + TRNE TT,1 + HRRM B,E +.FN269: PUSHJ P,[JUMPN A,TYPR + CAIE T,1 ;DON'T PRINT TRAILING SPACES. + JRST TYPR + JRST SIXNTY] + IDIVI B,10101 + SOJN T,.FN259 + JUMPE A,.FN279 + MOVEI CH,40 + REPEAT 3,PUSHJ P,PPA + JRST .FN249 +.FN279: MOVE A,(P) + PUSHJ P,CRR1 + SOJN J,.FN249 + SOJN TT1,.FN239 +CPOP1J: +POPAJ: POP P,A + POPJ P, + +IFN ITS,[ +PTLAB: PUSHJ P,CRR1 + MOVE E,DEFDEV + CALL SIXNTY ;OUTPUT DEVICE NAME + MOVEI CH,": + XCT LISTF5 + MOVE E,DEFDIR + CALL SIXNTY ;AND THE SNAME + MOVEI CH,"; + XCT LISTF5 + CALL LISTF4 + .SUSET [.RUNAM,,E] + PUSHJ P,TYPR + PUSHJ P,LISTF4 + PUSHJ P,GDATIM ;GET DATE AND TIME + POPJ P, ;SYSTEM DOESN'T HAVE THEM, QUIT HERE + PUSHJ P,GLPDTM ;WIN, ALSO GET CRUD FOR PHASE OF MOON + MOVE E,TIME ;GET TIME FOR PRINTING OUT + DPB E,[301400,,CTIME+1] + LSH E,-14 + DPB E,[61400,,CTIME] + LSH E,-14 + DPB E,[301400,,CTIME] + MOVE E,CTIME + PUSHJ P,TYPR + MOVE E,CTIME+1 + PUSHJ P,SIXNTY + PUSHJ P,LISTF4 + PUSHJ P,SYMDAT ;TYPE OUT DATE + PUSHJ P,LISTF4 ;TYPE ANOTHER TAB + PUSHJ P,POM ;PUSH OUT PHASE OF MOON + SKIPG PTLFCD + POPJ P, + PUSHJ P,LISTF4 + MOVEI A,[ASCIZ \CREATED \] + PUSHJ P,ASCIND +PTLAB9: MOVEI A,"0 + HRRM A,DPT5 + TLZ FF,FLNEG +IRPS Q,R,[270400/220500/330700] + LDB C,[Q,,PTLFCD] + MOVEI TT,1 + PUSHJ P,DPT1 +IFSE R,/,[ MOVEI CH,"/ + PUSHJ P,@LISTF5 +] +TERMIN + CALL SPSP + HRRZ A,PTLFCD + LSH A,-1 +IRPS Q,R,[6:6:0] + IDIVI A,12 + PUSH P,B +IFN Q,[ IDIVI A,Q + PUSH P,B + PUSH P,["R-"0] +] +.ELSE PUSH P,A +TERMIN + MOVEI IN,10 +PTLAB3: POP P,CH + ADDI CH,"0 + PUSHJ P,@LISTF5 + SOJG IN,PTLAB3 + POPJ P, +] + +IFN TNX,[ +PTLAB: PUSHJ P,CRR1 + MOVEI A,ERDEV + CALL ASCIND + MOVEI CH,": ;DEVICE: + XCT LISTF5 + MOVEI CH,"< + XCT LISTF5 + MOVEI A,ERDEV+DEFDIR-DEFDEV + CALL ASCIND ;DIRECTORY + MOVEI CH,"> + XCT LISTF5 + CALL LISTF4 ;TYPE TAB + GJINF + MOVEI B,(A) ;LOGIN DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + HRROI A,BAKTAB + SETOB B,C + ODTIM + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + CALL POM ;INSERT PHASE OF MOON + SKIPG PTLFCD + RET + CALL LISTF4 + MOVEI A,[ASCIZ /Last written /] + CALL ASCIND + MOVE A,CHFILI +IFN 20X,[ + MOVEI B,B + MOVEI C,1 + RFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,B + GTFDB +] + HRROI A,BAKTAB + SETZ C, + ODTIM + MOVEI A,BAKTAB + JRST ASCIND + +.ST26B: SETZ A, + MOVE OUT,[440600,,A] + MOVEI IN,6 + HRLI C,440700 +.ST26C: ILDB CH,C + JUMPE CH,CPOPJ + SUBI CH,40 + IDPB CH,OUT + SOJG IN,.ST26C + RET +] + +IFN ITS,[ +AOFDIR: SYSCAL OPEN,[[.BAI,,CHRAND] ? DEFDEV ? ['.FILE.] ? [SIXBIT/(DIR)/] ? DEFDIR] + JRST OPNER1 + POPJ P, + +GFDBLK: MOVE CH,[440700,,FDRBUF] + MOVEM CH,FDRP + HRLI CH,-FDRBFL + SKIPN NOQUIT + SKIPL STOPF ;CHECK FOR QUIT; IF SO, PLAY LIKE EOF + .IOT CHRAND,CH + HRLI CH,EOFCHR_<18.-7> + HLLZM CH,(CH) + POPJ P, +] + +IFN ITS,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + PUSHJ P,FRD + PUSH P,B + SETZM PTLFCD + PUSHJ P,.FNPT2 + POP P,A + PUSHJ P,.FNPT2 + JRST FORMF +] +IFN TNX,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + SETZM PTLFCD + CALL FRD0 ;GET FILESPEC + JRST OPNER1 + PUSH P,A + MOVSI C,001000 + CALL SYMLS2 ;PRINT FILENAME + MOVSI C,000100 + CALL SYMLS2 ;AND EXTENSION + POP P,A + RLJFN ;GET RID OF IT + JFCL + JRST FORMF + +SYMLS2: HRROI A,BAKTAB + MOVE B,-1(P) + JFNS + MOVEI A,BAKTAB + JRST .FNPT2 ;AND BIGPRINT IT +] + +LDBT1: REPEAT 3,LDB TT,LDBT2-1+.RPCNT*7(TT1) + +LDBT2: REPEAT 21.,[%T1==.RPCNT/7 + %T2==.RPCNT-%T1*7 + CH5.7T(B+200+<2*%T1+5*%T2>_12.) + ] + +CH5.7T: 0 ;SP +DEFINE .. A,B,C,D,E,F,G,H + IFSN H,,[PRINTC /CH5.7T LOSE! +/] + A_31.+B_26.+C_21.+D_16.+E_11.+F_6+G_1 +TERMIN + + .. 4,4,4,4,4,0,4,, ;! + .. 12,12,12,0,0,0,0,, ;" + .. 12,12,37,12,37,12,12,, ;# + .. 4,17,24,16,5,36,4,, ;$ + .. 36,31,2,4,10,23,3,, ;% + .. 4,12,4,10,25,22,15,, ;& + .. 4,4,4,0,0,0,0,, ;' + .. 2,4,10,10,10,4,2,, ;( + .. 10,4,2,2,2,4,10,, ;) + .. 0,25,16,33,16,25,0,, ;* + .. 0,0,4,33,4,0,0,, ;+ + .. 0,0,0,0,14,4,10,, ;, + .. 0,0,0,16,0,0,0,, ;- + .. 0,0,0,0,0,14,14,, ;. + .. 0,1,2,4,10,20,0,, ;/ + .. 16,21,23,25,31,21,16,, ;0 + .. 4,14,4,4,4,4,16,, ;1 + .. 16,21,1,2,4,10,37,, ;2 + .. 16,21,1,6,1,21,16,, ;3 + .. 2,6,12,37,2,2,2,, ;4 . . . OK, BEELER? + .. 37,20,36,1,1,21,16,, ;5 + .. 16,21,20,36,21,21,16,, ;6 + .. 37,1,2,4,10,20,20,, ;7 + .. 16,21,16,21,21,21,16,, ;8 + .. 16,21,21,17,1,21,16,, ;9 + .. 0,14,14,0,14,14,0,, ;: + .. 0,14,14,0,14,4,10,, ; ; + .. 0,2,4,10,4,2,0,, ;< + .. 0,0,37,0,37,0,0,, ;= + .. 0,10,4,2,4,10,0,, ;> + .. 16,21,2,4,4,0,4,, ;? + .. 16,21,27,25,27,20,17,, ;@ + .. 16,21,21,37,21,21,21,, ;A + .. 36,21,21,36,21,21,36,, ;B + .. 16,21,20,20,20,21,16,, ;C + .. 36,21,21,21,21,21,36,, ;D + .. 37,20,20,36,20,20,37,, ;E + .. 37,20,20,36,20,20,20,, ;F + .. 16,21,20,20,23,21,16,, ;G + .. 21,21,21,37,21,21,21,, ;H + .. 16,4,4,4,4,4,16,, ;I + .. 7,1,1,1,1,21,16,, ;J + .. 21,22,24,34,22,21,21,, ;K + .. 20,20,20,20,20,20,37,, ;L + .. 21,33,25,21,21,21,21,, ;M + .. 21,21,31,25,23,21,21,, ;N + .. 16,21,21,21,21,21,16,, ;O + .. 36,21,21,36,20,20,20,, ;P + .. 16,21,21,21,25,22,15,, ;Q + .. 36,21,21,36,21,21,21,, ;R + .. 16,21,20,16,1,21,16,, ;S + .. 37,4,4,4,4,4,4,, ;T + .. 21,21,21,21,21,21,16,, ;U + .. 21,21,21,21,21,12,4,, ;V + .. 21,21,21,21,21,25,12,, ;W + .. 21,21,12,4,12,21,21,, ;X + .. 21,21,12,4,4,4,4,, ;Y + .. 37,2,4,16,4,10,37,, ;Z + .. 6,4,4,4,4,4,6,, ;[ + .. 0,20,10,4,2,1,0,, ;\ + .. 14,4,4,4,4,4,14,, ;] + .. 4,16,25,4,4,4,4,, ;^ + .. 0,4,10,37,10,4,0,, ;_ + + IFN .-CH5.7T-64.,.. ,,,,,,,69 + + +SUBTTL DISPATCH TABLES + +;^T DISPATCH TABLE +EDDPTB: +REPEAT 3., BELL ;^@ - ^B + EDCPY ;^C COPY NEXT CHAR + EDD ;^D DELETE NEXT CHAR + BELL ;^E + ED% ;^F HELP TYPE REST OF THIS LINE, CR-LF, WHAT'S BEEN DONE SO FAR + BELL ;^G QUIT (NEVER GETS HERE) + BELL ;^H + EDOV ;^I TAB, TAKE AS CHAR + EDOV ;^J LINEFEED TAKE AS CHAR + BELL ;^K + EDL ;^L COPY REST OF LINE W/O ECHO AND END EDIT + EDCR ;^M CR - END EDIT + EDN ;^N COPY THRU NEXT SPACE OR EOL + EDO ;^O DELETE THRU NEXT SPACE + EDP ;^P ENTER/LEAVE PUT(INSERT) MODE + EDQ ;^Q TAKE "T" AS CHAR ("T" IS CHAR FOLLOWING ^P IN TYPIN STRING) + EDR ;^R COPY REST OF LINE + EDS ;^S COPY TO CHAR "T" + EDT ;^T DELETE TO CHAR "T" +REPEAT 2,BELL ;^U - ^V + 400000,,EDW ;^W DELETE TO LAST SPACE +REPEAT 3, BELL ;^X - ^Z + EDALT ;^[ (ALTMODE) COPY REST WITH ECHO AND END EDIT ;] +REPEAT 4, BELL ; ^[, ^\, ^], ^^ AND ^_ + +;THE ERROR TABLE: EACH WORD HAS THE 3-CHAR MESSAGE IN LH, +;POINTER TO ASCIZ STRING IN RH. +;THE TABLE IS SORTED WITH THE 3-CHAR MESSAGE AS THE KEY. +;THE FIRST ARG TO ERRDEF IS THE 3-CHAR MESSAGE. IT MUST +;CONSIST OF 3 SIXBIT CHARACTERS. +;THE SECOND ARG TO ERRDEF IS WHAT SHOULD BE GIVEN AS THE ARG +;TO THE TYPRE MACRO. IT MUST CONSIST OF 3 SQUOZE CHARS. +;IN TECO LISTINGS, CROSS-REFS GO UNDER THE NAME WHICH +;IS THE ARG TO ERRDEF. IN CREFS, THEY ARE UNDER THE LABEL ACTUALLY +;USED, WHICH HAS AN "ER$" CONCATENATED ON TO THE FRONT. +;OF TYPRE TO CHECK FOR THEM. + +IF1 [ +ERTOTL==0 ;ON PASS 1, ERTOTL ACCUMULATES AMOUNT OF STRING SPACE NEEDED FOR MESSAGES. + ;ALSO DEFINE THE LABELS FOR THE WORDS IN THIS TABLE. +DEFINE ERRDEF A,B,C/ +ER$!B ERTOTL==ERTOTL+<5+4+.LENGTH |C|+4>/5 + BLOCK 1 +TERMIN +] + +IF2 [ +ERNEXT==ERSTRT ;ON PASS 2, PUT THE STRINGS WHERE THEY BELONG, AND THE 3-CHAR NAMES HERE. + +DEFINE ERRDEF A,B,C/ +ER$!B SIXBIT /A/ ERNEXT*5-INIQRB+1 +ERTMP==. +.=ERNEXT + .BYTE 7 + 0 + QRSTR + ERLEN==<4+4+.LENGTH |C|> + ERLEN&177 + &177 + 0 + .BYTE + ASCII |A C| +ERNEXT==. +.=ERTMP +TERMIN +] + +ERRTAB: ERRDEF [..E]..E:,Bad value in q-reg ..E (output radix) + ERRDEF [2<1]2%1:,The second argument was less than the first + ERRDEF [AFN]AFN:,Ambiguous FS flag name + ERRDEF [AOR]AOR:,Argument out of range + ERRDEF [ARG]ARG:,Bad argument + ERRDEF [AVN]AVN:,Ambiguous variable or macro name. + ERRDEF [BD"]BD%:,Bad condition after " -- should be G,L,N,E,B,C,D,A or U + ERRDEF [BEL]BEL:,A built-in ^R command called from macro signaled an error + ERRDEF [CMD]CMD:,A char that isn't a TECO command was executed + ERRDEF [CNM]CNM:,Caller wasn't a macro (it was TECO internal code) + ERRDEF [DCD]DCD:,A disabled command was executed + ERRDEF [DSI]DSI:,Damned screw infinitely + ERRDEF [ERP]ERP:,Attempted :< ... ^\ with no closing > first + ERRDEF [ESR]ESR:,Empty sort record +;[ + ERRDEF [ICB]ICB:,Illegal ^] command + ERRDEF [IEC]IEC:,Illegal "E" command + ERRDEF [IFC]IFC:,Illegal "F" command + ERRDEF [IFN]IFN:,Illegal FS flag name + ERRDEF [IQN]IQN:,Invalid q-register name + ERRDEF [ILN]ILN:,Invalid local q-register number + ERRDEF [ISK]ISK:,Invalid sort key - "^P" command + ERRDEF [KCB]KCB:,Kill currently selected buffer + ERRDEF [M^R]M%R:,Attempted to macro a meaningless number + ERRDEF [NDO]NDO:,No device open for output - try "EW" + ERRDEF [NFC]NFC:,No free channels to pop into + ERRDEF [NFI]NFI:,No file open for input - try doing "ER" + ERRDEF [NHP]NHP:,Nonexistent horizontal position + ERRDEF [NIB]NIB:,You have addressed a character not in the buffer + ERRDEF [NIM]NIM:,Not inside a macro + ERRDEF [NOP]NOP:,Specified type of IO channel hasn't been pushed + ERRDEF [NRA]NRA:,File not random access + ERRDEF [N^R]N%R:,Not in ^R - command meaningful only inside ^R + ERRDEF [PDL]PDL:,Pushdown stack full + ERRDEF [PUR]PUR:,Attempted write in pure page + ERRDEF [RDO]RDO:,Attempt to modify a read-only buffer + ERRDEF [QIT]QIT:,^G typed on TTY and FS NOQUIT$ was negative + ERRDEF [QNB]QNB:,Q-register not buffer - attempt to select a string or number + ERRDEF [QNN]QNN:,Q-register not numeric + ERRDEF [QNS]QNS:,Q-register not string or buffer + ERRDEF [QRF]QRF:,Q-regs failed, probably TECO bug + ERRDEF [QRP]QRP:,Q-register PDL overflow or underflow + ERRDEF [SFL]SFL:,Search failed + ERRDEF [SNI]SNI:,Semicolon not in iteration + ERRDEF [SNR]SNR:,There is no valid search string to repeat + ERRDEF [STL]STL:,String argument too long + ERRDEF [STS]STS:,Dispatch string too short +;[[[ + ERRDEF [TMN]TMN:,Too many macro, ^]q-register, ^]^X, or ^]^Y nestings + ERRDEF [UBP]UBP:,Unbalanced parentheses found with an FL-type command + ERRDEF [UCT]UCT:,Unseen catch tag + ERRDEF [UEB]UEB:,FL-type command encountered end of buffer. + ERRDEF [UEC]UEC:,Unexpected end of command + ERRDEF [UGT]UGT:,Unseen go-tag + ERRDEF [UMC]UMC:,Unmatched ")" or ">" as a command + ERRDEF [URK]URK:,Buffer space or library space exhausted + ERRDEF [UTC]UTC:,Unterminated conditional + ERRDEF [UTI]UTI:,Unterminated iteration or errset (missing ">"?) + ERRDEF [UVN]UVN:,Undefined variable or macro name + ERRDEF [WLO]WLO:,FS OFACCP$ when old access pointer wasn't multiple of 5 + ERRDEF [WNA]WNA:,Wrong number of arguments + +LERTAB==.-ERRTAB + +IF2 IFN ERNEXT-EREND,.ERR LOSSAGE IN ERRTAB. + +; E COMMANDS DISPATCH TABLES + +ETAB: JRST EQMRK ;? + TYPRE [IEC] ;@ + TYPRE [IEC] ;A + TYPRE [IEC] ;B + JRST UICLS ;C + JRST DELE ;D + JRST EXITE ;E + JRST EFCMD ;F + JRST EGET ;G + TYPRE [IEC] ;H + JRST EICMD ;I + JRST EJCMD ;J + TYPRE [IEC] ;K + JRST CNTRU1 ;L + JRST LISTFM ;M + JRST RENAM ;N + TYPRE [IEC] ;O + JRST BPNTRD ;P +IFN ITS,JRST ALINK ;Q +IFN TNX,TYPRE [IEC] ;Q + JRST .OPNRD ;R + TYPRE [IEC] ;S + JRST ETCMD ;T + TYPRE [IEC] ;U + TYPRE [IEC] ;V + JRST WWINIT ;W +IFN TNX,JRST EXITX ;X +.ELSE TYPRE [IEC] + JRST LISTF ;Y + JRST LISTFM ;Z + JRST PSHIC ;[ + JRST PSHOC ;\ + JRST POPIC ;] + JRST POPOC ;^ + JRST FCOPY ;_ + +LETAB==.-ETAB + +;MUST BE SORTED BY FLAG NAME + +DEFINE FLG A,B,C + .1STWD SIXBIT/A/ +IFB C,[FSNORM,,]IFNB C,[C,,]B+IFB B,A +TERMIN + +FLAGS: FLG ADLINE, ;SIZE OF LINE ADJUST FILLS (FA) + FLG ALTCOU,TSALTC,FSALTC ;# CMD STRINGS WAITING TO BE READ. + FLG BACKAR,0,FSBAKA ;RETURN ARGS OF OLD MACRO FRAME + FLG BACKDE,MACDEP,FSRNLY ;DEPTH OF MACRO PDL. + FLG BACKPC,0,FSBAKP ;RETURN RELATIVE PC OF OLD MACRO FRAME + FLG BACKQP,0,FSBAKQ ;RETURN QPDL UNWIND POINTER OF OLD MACRO FRAME + FLG BACKRE,0,FSBKRT ;RETURN CONTROL TO SPECIFIED FRAME. + FLG BACKST,0,FSBAKS ;RETURN STRING POINTER TO MACRO ON MACRO PDL. + FLG BACKTR,0,FSBAKT ;TRACES BACK THE MACRO PDL. + FLG BBIND,0,FSBBIND ;PUSH OR POP CURRENT BUFFER CONVENIENTLY. + FLG BCONS,0,FSBCON ;RETURN A NEW BUFFER. + FLG BCREAT,0,FSCRBF ;CREATE NEW BUFFER (AND SELECT IT). + FLG BKILL,0,FSKILB ;ARG = POINTER TO BUFFER TO BE KILLED. + FLG BOTHCA, ;NONZERO => SEARCHES IGNORE CASE DISTINCTIONS. + FLG BOUNDA,0,FSBOUN ;BOUNDARIES OF PART OF BUFFER BEING EDITED. + FLG BSNOLF ;NOT 0 => BACKWARD MOTION SHOULDN'T BE FOLLOWED BY A LF. + FLG CASE,CASNRM ;SET CASE-SHIFTING MODE. + FLG CASENO,CASE ;SET CURRENT CASE-LOCK STATE. +IFN TNX,FLG CCLFNA,0,FSCCLF ;RETURN STRING FOR JFN IN 1 AT NORMAL ENTRY+2 + FLG CLKINT,0,FSCLKI ;SET CLOCK INTERVAL. + FLG CLKMAC,CLKMAC ;CLOCK HANDLER ROUTINE. + FLG CTLMTA,RRCMQT ;NEGATIVE => CONTROL-META-LETTER SSELF INSERTING. + FLG DATASW,0,FSSWIT ;PDP10 CONSOLE SWITCHES. + FLG DATE,0,FSDATE ;RETURN CURRENT DATE IN DISK FORMAT. + FLG DDEVICE,DEFDEV,FSSTRR ;DEFAULT DEVICE AND FILENAMES. + FLG DDFAST,0,FSDDFS ;-1 IF DEFAULT DEVICE IS "FAST". + FLG DFILE,0,FSDFILE ;DEFAULT FILE'S NAMES, AS STRING. + FLG DFN1,DEFFN1,FSSTRR + FLG DFN2,DEFFN2,FSSTRR + FLG DFORCE, ;NOT 0 => FINISH DISPLAY DESPITE PENDING INPUT, DON'T UPDATE MODE LINE. + FLG DSNAME,DEFDIR,FSDSNM + FLG DVERSI,DEFFN3,FSDVER ;DEFAULT FN2 AS NUMBER < AND > SPECIAL + FLG DWAIT ;NONZERO => DON'T ALLOW MUCH STUFF IN TTY OUTPUT BUFFER. + FLG ECHOAC,ECHACT ;-1 => ECHO AREA IS ACTIVE (CRUFT SHOULD BE CLEARED BY ^R). + FLG ECHOCH,ECHCHR ;NONZERO => INHIBIT SCAN-ECHOING THIS ^R COMMAND. + FLG ECHODI,0,FSECDS ;(WRITE-ONLY) ECHO-MODE DISPLAY-MODE OUTPUT OF ARG. + FLG ECHOER,ERRECH ;NONZERO => TYPE ERR MSGS IN ECHO AREA. + FLG ECHOFL,ECHFLS ;NONZERO => CLEAR ECHO AREA AFTER EACH COMPLETE ^R COMMAND. + FLG ECHOLI,0,FSECLS ;# OF COMMAND LINES. + FLG ECHOOU,0,FSECOT ;(WRITE-ONLY) ECHO-MODE OUTPUT OF ARGUMENT. + FLG ERR,LASTER,FSERR ;SIGNAL AN ARBITRARY ERROR. + FLG ERRFLG,ERRFL1 ;WHEN ..B OR ..G MACROED, THIS + ;HAS 0 OR ERROR CODE OF CMD STRING JUST ENDED. + FLG ERROR,LASTER, ;ERROR CODE OF MOST RECENT ERROR. + FLG EXIT,0,FSEXIT ;DO .BREAK 16, TO INTERUPT SUPERIOR. + FLG FDCONV,0,FSDCNV ;CONVERT NUMERIC TO ASCII FILE DATES. + FLG FILEPA, ;CHAR TO PAD LAST WD OF OUTPUT FILE WITH. + FLG FLUSHED,MORFLF ;0 => NOT AFTER --FLUSHED, 1 => RUBOUT, -1 => OTHER FLUSHAGE. + FLG FNAMSY, ;0 => IF ONLY ONE FILENAME, IT IS FN2. + ;> 0 => ONLY ONE FILENAME IS FN1. + ;< 0 => ONLY ONE FNAME IS FN1, AND FN2 IS ">". + FLG GAPLEN,EXTRAC,FSRNLY ;SIZE OF GAP. + FLG GAPLOC,GPT,FSROCA ;CHAR ADDR OF GAP. + FLG HEIGHT,NVLNS,FSRNLY ;NUMBER OF LINES TO DISPLAY + FLG HELPCH, ;CHARACTER TO INVOKE "HELP" MACRO + FLG HELPMAC, ;MACRO TO CALL IF USER TYPES "HELP" KEY. + FLG HPOSIT,0,FSHPOS ;PHYSICAL POSITION OF A 2741 TYPEBALL IF IT TYPED FROM THE PREVOUS CARRET + FLG HSNAME,,FSDIRH ;HOME DIRECTORY NAME. + FLG I&DCHR,CID ;NONZERO => TRY TO USE CHAR I/D. + FLG I&DLIN,LID ;NONZERO => TRY TO INSERT AND DELETE LINES. + FLG I.BASE, ;INPUT RADIX FOR #S FOLLOWED BY ".". + FLG IBASE, ;ORDINARY INPUT RADIX. + FLG IFACCE,0,FSIFAC ;(WRITE-ONLY) SET INPUT FILE ACCESS PTR + FLG IFCDAT,CHFILI,FSFDAT ;NUMERIC CREATION DATE OF INPUT FILE. + FLG IFDEVI,ERDEV,FSSTRR ;DEVICE NOW READING FROM. +IFN ITS,FLG IFDUMP,CHFILI,FSDUMP ;FILE HAS BEEN DUMPED BIT. +IFN TNX,FLG IFFDB,CHFILI,FSIFDB ;READ OR MODIFY FILE DESCRIPTOR BLOCK + FLG IFFN1,,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING. + FLG IFFN2,,FSSTRR ;FN2 OF FILE NOW OPEN FOR READING. + FLG IFILE,0,FSIFILE ;FILENAMES OF FILE NOW READING , AS STRING. + FLG IFLENG,0,FSIFLEN ;(R-O) LENGTH OF INPUT FILE. + FLG IFMTAP,CHFILI,FSMTAP ;DO .MTAPE ON INPUT FILE. +IFN ITS,FLG IFREAP,CHFILI,FSREAP ;DON'T REAP BIT. + FLG IFSNAM,,FSSTRR ;SNAME OF FILE NOW READING FROM. + FLG IFVERS,,FSFVER ;VERSION OF FILE OPEN FOR READING. + FLG IMAGEO,0,FSIMAG ;(WRITE-ONLY) IMAGE MODE OUTPUT OF ARG + FLG INCOUN,INCHCT ;NUMBER OF INPUT CHARACTERS SO FAR. + FLG INSLEN,INSLEN ;LENGTH OF THE LAST INSERT STRING +IFN ITS,FLG JNAME,.RJNAM,FSRSYS ;GET TECO'S JNAME. +IFN TNX,FLG JNAME,0,FSGTNM + FLG LASTPA,,FSRNLY ;SET BY TECO TO 0 AFTER READING LAST PAGE OF IPUT FILE. + FLG LINES,NLINES ;NUMBER OF LINES TO DISPLAY + FLG LISPT,INITFL ;NONZERO => TECO WAS STARTED AT ALTERNATE ENTRY + ;POINT SIGNIFYING THAT SUPERIOR IS A LISP. + FLG LISTEN,0,FSLISN ;DO .LISTEN, MAYBE PROMPT VIA FS ECHOT. +IFN TNX,FLG LOADAV,0,FSLOAD ;1 MINUTE LOAD AVERAGE +IFN ITS,FLG MACHIN,,FSRNLY ;READ MACHINE NAME +IFN TNX,FLG MACHIN,0,FSMACH + FLG MODECH,MODCHG ;NONZERO SAYS MODMAC MUST BE CALLED. + FLG MODEMA,MODMAC ;NONZERO => IS MACRO TO RECOMPUTE ..J WHEN NECESSARY. + FLG MODIFI,MODIFF ;SET NONZERO WHEN BUFFER WRITTEN IN. +IFN ITS,FLG MPDISP,0,FSMPDS ;DISPLAY OUTPUT TO M.P. AREA. +IFN ITS,FLG MSNAME ;READ WORKING DIRECTORY NAME +IFN TNX,FLG MSNAME,0,FSDIRS ;READ CURRENT CONNECTED DIRECTORY + FLG NLAROW, ;<>0=> DON'T ALLOW _ COMMAND + FLG NOOPAL, ;SAY WHAT TO TO WITH ALTMODES AS COMMANDS. + ;0 => ERROR, -1 => IGNORE, 1 => LIKE ^_. + FLG NOQUIT,,FSNQIT ;0 => ^G QUITS NORMALLY. + ;POS => ^G JUST SETS STOPF; NO QUITTING. + ;NEG => ^G CAUSES ERRSETABLE "QIT" ERROR. + FLG OFACCE,0,FSOFAC ;(WRITE-ONLY) SET OUTPUT FILE ACCESS POINTER + FLG OFCDAT,CHFILO,FSFDAT ;DATE OF OUTPUT FILE (NUMERIC) + FLG OFILE,0,FSOFILE ;REAL NAMES OF LAST OUTPUT FILE CLOSED. + FLG OFLENG,0,FSOFLEN ;LENGTH OF OUTPUT FILE. + FLG OFMTAP,CHFILO,FSMTAP ;DO .MTAPE ON OUTPUT FILE. + FLG OFVERS,,FSFVER ;VERSION LAST OUTPUT FILE + FLG OLDFLU,OLDFLF ;OLD VALUE OF FS FLUSHED, IN NEXT ^R COMMAND AFTER THE FLUSHED ONE. + FLG OLDMOD,DISOMD ;LAST ..J VALUE DISPLAYED. + FLG OSPEED ;OUTPUT SPEED IN BAUD, OR 0 IF UNKNOWN. + FLG OSTECO,TNX+10X,FSVAL ;OPERATING SYSTEM, 0 => ITS, + ;1 => TWENEX, 2 => TENEX + FLG OUTPUT,OUTFLG ;-1 => OUTPUT TO FILE DISABLED. + FLG PAGENU, ;PAGE # IN CURRENT INPUT FILE. + FLG PJATY ;NONZERO => SCREEN NEEDS REFRESHING. + FLG PROMPT,PROMCH ;0, OR ASCII VALUE OF PROMPT CHAR. + FLG PUSHPT,0,FSPSPT ;DO ^V + FLG QPHOME,0,FSQPHO ;QREG PDL SLOT - WHERE IT WAS PUSHED FROM. + FLG QPPTR,0,FSQPPT ;QREG PDL PTR + FLG QPSLOT,0,FSQPSL ;QREG PDL SLOT (ARG SAYS WHICH ONE) + FLG QPUNWI,0,FSQPUN ;UNWIND QREG PDL. + FLG QUIT,STOPF ;NEGATIVE => A ^G-QUIT HAS BEEN REQUESTED. + FLG QVECTO,0,FSQVEC ;RETURN A NEW QREG VECTOR BUFFER. + FLG RANDOM,RDMNMS ;RANDOM # GENERATOR'S SEED. + FLG READON ;NON-0 => DONT ALLOW MODIFICATION OF THIS BUFFER + FLG REALAD,BEG,FSRNLY ;PHYS CHAR ADDR OF BEGINNING OF BUFFER. + FLG REFRES,REFRSH ;MACRO TO REDISPLAY WHOLE SCREEN. + FLG REREAD,UNRCHC ;-1, OR TTY CHARACTER TO RE-READ. + FLG RGETTY, ;NON-0=> DISPLAY TERMINAL + FLG RUBCRL ;NON-0 => RUBOUT AND ^D DELETE A WHOLE CRLF AT ONCE. + FLG RUNTIM,0,FSRUNT ;NUMBER OF MICROSECONDS OF CPU TIME USED + FLG SAIL,DISSAI ;NON0 => TTY ASSUMED TO PRINT SAIL CHAR SET. + FLG SEARCH,SFINDF ;VALUE RETURNED BY THE LAST SEARCH + FLG SERROR,SRCERR ;NONZERO => FAILING SERACHES ARE ERRORS EVEN IN ITERATIONS. + FLG SHOWMO,SHOMOD ;NOT 0 => FR SHOULD PRINT ..J ON PRINTING TTY. + FLG SHPOS,0,FSSHPS ;LIKE FS HPOS BUT CTL CHARS APPEAR AS ON SCREEN. + FLG SSTRING,0,FSSSTR ;CURRENT SEARCH STRING, AS A STRING. + FLG STEPDE,STEPDE ;MAXIMUM MACRO PDL DEPTH FOR STEPPING TO GO ON. + FLG STEPMA,STEPFL ;NONZERO => SINGLE STEP MACROS, LINE AT A TIME. + FLG SUPERI,SUPHND ;MACRO TO HANDLE REQUESTS FROM SUPERIOR. + FLG SVALUE,SFINDF ;VALUE RETURNED BY LAST SEARCH. + FLG TOPLIN ;1ST LINE TO USE FOR BUFFER DISPLAY. + FLG TRACE,<(.BP FRTRACE)>,FSWBIT ; -1 IFF IN TRACE MODE. + FLG TRUNCA,DISTRN ;CONTROLS TRUNCATION VS. CONTINUATION OF TYPED LINES. + ;NEGATIVE => TRUNCATE, ELSE CONTINUE. + FLG TTMODE,TTMODE +IFN 20X,FLG TTPAGM,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY. + FLG TTYOPT,,FSRNLY ;TTY'S TTYOPT VARIABLE. +IFN 20X,FLG TTYPAG,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYSMT,,FSRNLY ;TTY'S TTYSMT VARIABLE. + FLG TYIBEG,INCHRR + FLG TYICOU,INCHCT + FLG TYISIN,TYISNK ;MACRO CALLED WITH EACH INPUT CHARACTER, FOR DEFINING KBD MACRO + FLG TYISOU,TYISRC ;MACRO CALLED TO GET INPUT CHARS FROM KBD MACRO. + FLG TYOHAS,0,FSHCD ;HASH CODE OF SCREEN LINE. + FLG TYOHPO,CHCTHP,FSRNLY ;HPOS OF TYPEOUT, AT THE MOMENT. + FLG TYPEOU,TYOFLG ;-1 => NEXT TYPEOUT GOES AT SCREEN TOP. + ;ELSE TYPEOUT HAS BEEN DONE AND MORE TYPEOUT FOLLOWS IT. +IFN ITS,FLG UHSNAM,0,FSUHSN ;GET HSNAME OF A USER FROM DDT. +IFN ITS,FLG UINDEX,.RUIND,FSRSYS ;GET TECO'S JOB NUMBER. +IFN TNX,FLG UINDEX,0,FSJOBN +IFN ITS,FLG UMAILF,0,FSUML ;GET FILENAME OF A USER'S MAIL FILE FROM DDT. +IFN ITS,FLG UNAME,.RUNAME,FSRSYS ;GET TECO'S UNAME. +IFN TNX,FLG UNAME,0,FSDIR2 + FLG UPTIME,0,FSUPTI ;SYSTEM UP TIME IN 60'TH'S. + FLG UREAD,<(.BP (FLIN))>,FSBIT ;-1 IF INPUT FILE, ELSE 0. + FLG UWRITE,<(.BP (FLOUT))>,FSBIT ;-1 IFF OUTPUT FILE OPEN, ELSE 0. + FLG VARMAC, ;NONZERO => ENABLE FEATURE TO RUN MACRO WHEN VARIABLE CHANGES. + FLG VB,0,FSVB ;BEGV, BUT CAN BE PUSHED/POPPED. + FLG VERBOS,VERBOS ;<>0=> DISPLAY MOBY ERROR MESSAGES + FLG VERSIO,.FVERS,FSVAL ;VERSION NUMBER OF THIS TECO + FLG VZ,0,FSVZ ;Z-ZV, BUT CAN BE PUSHED/POPPED. + FLG WIDTH,NHLNS,FSWIDTH ;SIZE OF THE TYPED\DISPLAYED LINE + FLG WINDOW,GEA ;CHAR ADDR (REL BEGV) OF 1ST CHAR IN WINDOW + FLG WORD,0,FSWORD ;GET OR SET SOME WORD IN THE CURRNET BUFFER. +IFN ITS,FLG XJNAME,.RXJNA,FSRSYS ;INSERT .XJNAME IN BUFFER +IFN TNX,FLG XJNAME,0,FSGTN0 + FLG XPROMP,RUBENC ;0, OR CHAR TO TYPE NEXT TIME DISINI DONE. +IFN ITS,FLG XUNAME,.RXUNA,FSRSYS ;INSERT .XUNAME IN BUFFER +IFN TNX,FLG XUNAME,0,FSDIR2 + FLG YDISAB, ;DISABLES Y COMMAND IN VARIOUS WAYS + FLG Z,Z,FSROCA ;# CHARS IN BUFFER (Z COMMAND IS 1 + # OF LAST CHAR IN RANGE BEING EDITED.) + FLG ^HPRIN,DISPBS ;PRINT BS AS BS? NEGATIVE => YES. + FLG ^IDISA,TABMOD ;0 => TABS INSERT 1 => ERROR -1 => IGNORE. + FLG ^LINSE,FFMODE ;NON0 => ^L'S READ FROM FILE GO IN BUFFER. + FLG ^MPRIN,DISPCR ;STRAY CR CAN COME OUT AS CR? NEGATIVE => YES. + FLG ^PCASE,PSCASE ;NONZERO => ^P SORT IGNORES CASE. + FLG ^RARG,RRRPCT ;BASIC ^R-MODE ARGUMENT (SET BY ^V) + FLG ^RARGP,RRARGP ;0 => USE 1 INSTEAD OF FS ^RARG$. + FLG ^RCCOL,RRCCOL ;COMMENT COLUMN FOR ^R MODE. + FLG ^RCMAC,0,FSCRMA ;MACROS ASSOCIATED WITH CHARS. + FLG ^RDISP,RRDISM ;MACRO TO RUN WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. + FLG ^RECHO,RRECHO ;CONTROLS ECHOING OF CHARACTERS READ IN BY ^R. + FLG ^RENTER,RRENTM ;MACROED WHEN ^R IS ENTERED. + FLG ^REXIT,0,FSCREX ;EXIT FROM ^R WHEN EXECUTED. + FLG ^REXPT,RR4TCT ;EXPONENT-OF-4, INCREMENTED BY ^U. + FLG ^RHPOS,RRHPOS ;HPOS OF CURSOR IN ^R MODE. + FLG ^RINCO,INCHRR ;TOTAL # OF INPUT CHARS, AT START OF LAST ^R COMMAND. + FLG ^RINDI,0,FSINDT ;TRACE ^R INDIRECT COMMAND DEFINITIONS. + FLG ^RINHI,RRINHI ;NONZERO INHIBITS ALL DISPLAY UPDATING. + FLG ^RINIT,0,FSCRIN ;INITIAL VALUE OF FS ^R CMACRO$ + FLG ^RINSE,0,FSRRINS ;INTERNAL ^R 1-CHAR INSERT ROUTINE. + FLG ^RLAST,RRLAST ;MOST RECENT ^R-MODE CHAR (EXCEPT ARG-SETTING CHARS) + FLG ^RLEAVE,RRLEVM ;MACROED WHEN ^R EXITS (BUT NOT IF ERR'D OR THROWN THRU) + FLG ^RMARK,RRMKPT ;THE ^R-MODE MARK, SET BY ^T. -1 => NO MARK NOW. + FLG ^RMAX,RRTTMX ;MAX # CHARS OF INSERT OR DELETE TO TYPE OUT. + FLG ^RMCNT,RRMCC1 ;THE COUNTER USED TO TELL WHEN TO CALL SEC'Y MACRO. + ;INITTED FROM FS ^RMDLY, COUNTED DOWN TO 0. + FLG ^RMDLY,RRMCCT ;# OF ^R CMDS TO DO BETWEEN INVOCATIONS OF SEC'Y MACRO. + FLG ^RMODE,DISPRR,FSRNLY ;NONZERO IN ^R MODE. + FLG ^RMORE,RRMORF ;> 0 SAYS USE --MORE-- INSTEAD OF --TOP-- IN ^R MODE. + ;< 0 SAYS USE NEITHER --MORE-- NOR --TOP--. + FLG ^RNORM,RRXINV ;THIS IS THE REAL DEFINITION OF ANY ^R-MD CHAR + ;DEFINED TO BE "SELF-INSERTING". INITIALLY + ;IS AN INTERNAL ENTRY TO FS ^RINS$. + FLG ^RPREV,RRPRVC ;THE ^R-MODE COMMAND CHAR BEFORE THE ONE IN ^R LAST. + FLG ^RREPL,RRRPLC ;CONTROLS INSERTION VS REPLACEMENT BY NORMAL CHARS. + FLG ^RRUBO,0,FSRRRUB ;INTERNAL ^R RUBOUT ROUTINE. + FLG ^RSCAN,RRSCAN ;NONZERO => ^R ON PRINTING TTY PRINTS CHARS MOVED OVER. + FLG ^RSUPP,RRALQT ;NONZERO SUPPRESSES BUILTIN COMMANDS + FLG ^RTHRO,0,FSCRTH ;THROW TO INNERMOST ^R INVOCATION. + FLG ^RUNSU,RRUNQT + FLG ^RVPOS,RRVPOS ;VPOS OF CURSOR IN ^R MODE. + FLG _DISAB,NLAROW + FLG %BOTTO, ;PERCENT AT BOTTOM BARRED TO CURSOR. + FLG %CENTE, ;PERCENT FROM TOP TO PREFERRED LOCATION FOR CURSOR (WHEN WINDOW CHOSEN) + FLG %END, ;PERCENT AT BOTTOM BARRED TO CURSOR WHEN WINDOW CHOSEN. +IFN ITS,FLG %OPLSP,<(.BP (%OPLSP))>,FSOPTL ;VALUE OF JOB'S %OPLSP BIT (SUPERIOR IS LISP). + FLG %TOCID,<(.BP (%TOCID))>,FSTTOL ;VALUE OF TTY'S %TOCID BIT. + FLG %TOFCI,<(.BP (%TOFCI))>,FSTTOL ;VALUE OF TTY'S %TOFCI BIT. + FLG %TOHDX,<(.BP (%TOHDX))>,FSTTOL ;VALUE OF TTY'S %TOHDX BIT. + FLG %TOLID,<(.BP (%TOLID))>,FSTTOL ;VALUE OF TTY'S %TOLID BIT. + FLG %TOLWR,<(.BP (%TOLWR))>,FSTTOL ;VALUE OF TTY'S %TOLWR BIT. + FLG %TOMOR,<(.BP (%TOMOR))>,FSTTOL ;VALUE OF TTY'S %TOMOR BIT. + FLG %TOOVR,<(.BP (%TOOVR))>,FSTTOL ;VALUE OF TTY'S %TOOVR BIT. + FLG %TOP, ;PERCENT OF SCREEN AT TOP BARRED TO CURSOR. + FLG %TOROL,<(.BP (%TOROL))>,FSTTOL ;VALUE OF TTY'S %TOROL BIT. + FLG %TOSAI,<(.BP (%TOSAI))>,FSTTOL ;VALUE OF TTY'S %TOSAI BIT. + FLG *RSET,UNWINF ;NONZERO PREVENTS AUTOMATIC QRP UNWINDING. + FLG .CLRMO,CLRMOD ;NONZERO => CLEAR SCREEN WHEN TTY GIVEN BACK BY SUPERIOR. + FLG .KILMO,KILMOD ;(NORMALLY NON-0) 0 MAKES FSBKILL$ A NOOP. + FLG .TYINX,0,FSTBNXT ;ILDB THAT POINTER AND RING IT AROUND TO GET NEXT OLD TYI CHAR. + FLG .TYIPT,TYIBFP,FSRNLY ;POINTER TO NEXT TYI CHARACTER IN RING BUFFER. + FLG :EJPAG,LHIPAG,FSEJPG ;# OF LOWEST PAGE IN USE BY PURE STRING SPACE +IFN TNX,FLG :ETMOD,ETMODE ;BITMASK OF FIELDS TO DEFAULT IN :ET COMMAND +FLAGSL==<.-FLAGS>/2 + +FLAGD==FLAGS+1 + + <-1>_-1 ;THIS TERMINATES THE AMBIGUITY TEST AT FSFND. + BLOCK 4 ;FOR PATCHING (HARD BUT POSSIBLE) + +IFCERR==TYPRE [IFC] + +FDTB: JRST FCTLAT ;^@ + JRST FCACMD ;^A + JRST FMEMQ ;^B +TYPIFC: IFCERR ;^C + IFCERR ;^D + JRST FCECMD ;^E + JRST FCTLF ;^F + JRST FCTLG ;^G + IFCERR ;^H + IFCERR ;^I + IFCERR ;^J + JRST FCTLK ;^K + REPEAT ^R-^K-1,IFCERR + JRST RRALTR ;^R + JRST TABSRC ;^S + REPEAT ^X-^S-1,IFCERR + JRST FCTLX ;^X + JRST FCTLY ;^Y ;[ + REPEAT 4,IFCERR ;^Z - ^] + JRST FCTLUP ;^^ + IFCERR ;^_ + IFCERR ;SPACE + IFCERR ;! + JRST FDQUOT ;" + IFCERR ;# + JRST FSCASE ;$ + REPEAT 3,IFCERR ;%-' + JRST FOPEN ;( + JRST FCLOSE ;) + JRST FNOOP ;* + JRST CTLL ;+ + REPEAT "6-"+-1,IFCERR + JRST FSIXB ;6 + REPEAT ";-"6-1,IFCERR + JRST FSEMIC ;; + JRST FLSSTH ;< + JRST FEQ ;= + IFCERR ;> + JRST FLSCMD ;? + IFCERR ;@ + JRST ADJUST ;A + JRST FBCMD ;B + JRST LOWCON ;C + JRST FDCMD ;D + JRST FECMD ;E + IFCERR ;F + JRST FGCMD ;G + IFCERR ;H + JRST FTYI ;I + JRST FJCL ;J + JRST FKCMD ;K + JRST FLCMD ;L + JRST FMCMD ;M + JRST FNCMD ;N + JRST FOCMD ;O + JRST FDATTY ;P + JRST QLEN ;Q + JRST FRCMD ;R + JRST FSET ;S + JRST FTYPE ;T + JRST FUCMD ;U + JRST FVIEW ;V + JRST FWCMD ;W + JRST FXCMD ;X + JRST FYCMD ;Y +IFE TNX,IFCERR ;Z +IFN TNX,JRST FZCMD ;Z + JRST FPUSH ;[ + IFCERR ;\ + JRST FPOP ;] + JRST FAPPRX ;^ + JRST SERCHA ;_, LIKE NORMAL _ CMD. +IFN .-FDTB-140,[PRINTX \FDTB LOSS +\] + + +DTB: HRROI B,CNTRAT ;^@ + MOVEI B,COR ;^A + HRROI B,CTLB ;^B + TYPRE [CMD] ;^C + TYPRE [CMD] ;^D + TYPRE [CMD] ;^E + HRROI B,CNTRLF ;^F + TYPRE [CMD] ;^G - TS QUIT + TYPRE [CMD] ;^H - BACKSPACE + JRST TAB ;^I - TAB + MOVEI B,CD ;^J - LINE FEED + HRROI B,DECDMP ;^K - VALRET SOMETHING + HRROI B,CTLL ;^L - FORM FEED + HRROI B,CTLM ;^M - CARR RET + HRROI B,CNTRLN ;^N + HRROI B,SYMLST ;^O + HRROI B,PSORT ;^P + TYPRE [CMD] ;^Q + HRROI B,RRENTR ;^R + HRROI B,ASLEEP ;^S + HRROI B,EDIT ;^T - EDIT + HRROI B,CNTRLU ;^U + HRROI B,CTLV ;^V + JRST CTLW ;^W + HRROI B,GMARG1 ;^X + HRROI B,GMARG2 ;^Y + HRROI B,RANDOM ;^Z + JRST ALTCMD ;ALTMODE + MOVEI B,MEXIT ;^\ + TYPRE [CMD] ;[ ;^] + HRROI B,CNTRUP ;^^ + JRST LGOGO ;^_ + + MOVEI B,SPACE ; + MOVEI B,EXCLAM ;! + MOVEI B,DQUOTE ;" + MOVEI B,CXOR ;# + HRROI B,NEWAS ;$ + HRROI B,PCNT ;% + MOVEI B,CAND ;& + JRST CD5A ;' + MOVEI B,OPEN ;( + MOVEI B,CLOSE ;) + MOVEI B,TIMES ;* + MOVEI B,PLUS ;+ + MOVEI B,COMMA ;, + MOVEI B,MINUS ;- + JRST PNT ;. + MOVEI B,SLASH ;/ +REPEAT 12,JRST CDNUM ;DIGITS 0 - 9. + JRST ACOLON ;: + MOVEI B,SEMICL ; ; + MOVEI B,LSSTH ;< + HRROI B,PRNT ;= + JRST GRTH ;> + HRROI B,QUESTN ;? + JRST ASLSL ;@ + HRROI B,APPEND ;A + HRROI B,BCMD ;B + HRROI B,CHARAC ;C + HRROI B,DELETE ;D + HRROI B,ECMD ;E + HRROI B,FCMD ;F + HRROI B,QGET ;G + HRROI B,HOLE ;H + HRROI B,INSERT ;I + HRROI B,JMP ;J + HRROI B,KILL ;K + HRROI B,LINE ;L + MOVEI B,MAC ;M + HRROI B,SERCHP ;N + MOVEI B,OG ;O + HRROI B,PUNCH ;P + HRROI B,QREG ;Q + HRROI B,REVERS ;R + HRROI B,SERCH ;S + HRROI B,TYPE ;T + HRROI B,USE ;U + HRROI B,VIEW ;V + MOVEI B,CD ;W + HRROI B,X ;X + HRROI B,YANK ;Y + HRROI B,END1 ;Z + HRROI B,OPENB ;[ + HRROI B,BAKSL ;\ + HRROI B,CLOSEB ;] + JRST ASLSL ;^ + JRST BAKARR ;_ +IFN .-DTB-140,.ERR DTB WRONG # ENTRIES. + +CONSTANTS + +PAT: +PATCH": BLOCK 200 +PATCHE": 0 + +HUSED: INFORM [TOP OF PURE]\.-1 + +LOC <.+1777>&776000 +VARIABLES +IFN .&1777, .ERR VARIABLES! + +HIMPUR:: + +;IF ^R VARIABLES DON'T FIT IN LOW IMPURE, PUT THEM HERE. +IFG +RRVARL-1777, RRVARB:: BLOCK RRVARL + +;^R-MODE COMMAND DISPATCH TABLE. POSITIVE => BUILTIN COMMAND; +;RH IS DISP. ADDR, LH IS EXTRA INFO (SECONDARY DISP. ADDR). +;NEGATIVE => IT IS STRING POINTER TO MACRO. +RRMACT: +;NON-CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRXINS ;^@ - ^G +REPEAT 3,RRINSC,,RRREPI ;^H, ^I, ^J NEVER REPLACE, REGARDLESS OF FS ^R REPLACE$ + RRXINS ;^K + RRXINS ;^L + RRCRLF,,RRREPT ;^M +REPEAT 33-^M-1,RRXINS ;^N - ^Z + RREXIT ;ALTMODE +REPEAT "A+40-ALTMOD-1,RRXINS ;^\ - ` +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS. +REPEAT 4,RRXINS ;LOWERCASE SPECIAL CHARACTERS. + RRRUB + +.SEE RRITAB ;MUST BE CHANGED WHEN THE ENTRIES BELOW ARE CHANGED. +;CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRUNDF ;CONTROL-^@ TO CONTROL-^G +REPEAT 3,200,,RRINDR ;CONTROL-BS TO CONTROL-LF. +REPEAT 2,RRUNDF ;CONTROL-^K AND CONTROL-^L. + 200,,RRINDR ;CONTROL-CR +REPEAT 33-^M-1,RRUNDF ;CONTROL-^N THROUGH CONTROL-^Z. + 200,,RRINDR ;CONTROL-ALTMODE. +REPEAT "--33-1,RRUNDF ;CONTROL-^\ TO CONTROL-, + RRCMNS ;CONTROL-MINUS +REPEAT "0-"--1,RRUNDF ;CONTROL-. TO CONTROL-/ +REPEAT 10.,RRCDGT ;CONTROL-0 THRU CONTROL-9 +REPEAT 100-"9-1,RRUNDF ;CONTROL-: TO CONTROL-? + RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + 300,,RRINDR ;^H + 300,,RRINDR ;^I + 300,,RRINDR ;^J + RRKILL ;^K + RRCTLL ;^L + RRINSC,,RRREPI ;^M + RRNEXT ;^N + RRCTLO,,RRREPT ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;^[ + RRUNDF ;^\ + RRBRC ;^] + RRUNDF ;^^ + RRUNDF ;^_ + RRUNDF ;^` +REPEAT 32,40,,RRINDR ;^ +REPEAT 4,RRUNDF ;^{ ^| ^} ^~ + RRCRUB ;CONTROL-RUBOUT. +IFN .-RRMACT-400,,.ERR + +;META CHARS: +REPEAT "-,RRXINS + RRCMNS +REPEAT "0-"--1,RRXINS +REPEAT 10.,RRCDGT +REPEAT "A+40-"9-1,RRXINS +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS INDIRECT THRU UPPERCASE. +REPEAT 5,RRXINS + +;CONTROL-META CHARS: MOSTLY SELF-INSERTING, BUT SOME ARE INDIRECT THROUGH OTHERS. +REPEAT ^H,RRXINS ;^@ THRU ^G +REPEAT 3,200,,RRINDR ;^H THRU ^J +REPEAT 2,RRXINS ;^K, ^L + 200,,RRINDR ;^M +REPEAT 33-^M-1,RRXINS ;^N TO ^Z + 200,,RRINDR ;ALTMODE +REPEAT "--33-1,RRXINS ;^\ TO COMMA + RRCMNS ;MINUS SIGN +REPEAT "0-"--1,RRXINS ;. TO / +REPEAT 10.,RRCDGT ;0 TO 9 +REPEAT "H-"9-1,RRXINS ;: TO G +REPEAT 3,300,,RRINDR ;H, I, J +REPEAT "`-"J,RRXINS ;K TO ` +REPEAT 32,40,,RRINDR ;a to z +REPEAT 200-172-1,RRXINS ;{ TO RUBOUT. + +IFN .-RRMACT-1000,.ERR + +RRMACL==1000 ;LENGTH OF RRMACT + +SUBTTL INITIAL CONTENTS OF STRING AND BUFFER SPACE + +;; BUFFER AND MACRO CALL FRAMES. MORE CAN BE CREATED, PUSHING COMMAND BUFFER UP. + +MFSTRT: REPEAT MFNUM-3, REPEAT MFBLEN-1,[ 0 ?] . + REPEAT MFBLEN, 0 +MFBUF1: MFBFR,,INIBEG ;BUFFER FRAME FOR INITIALLY SELECTED BUFFER. + REPEAT MFBLEN-2,INIBEG + 0 +MFSBUF: MFBFR,,INISRB ;THIS BUFFER HOLDS THE COMPILED SEARCH STRING. + REPEAT 4,INISRB + INISRE + 0 +MFEND1:: + +CBUF: BLOCK CBUFSZ ;COMMAND BUFFER FOR NON-^R MAIN LOOP. + +;INITIAL CONTENTS OF STRING SPACE: + +INIQRB==5*. +ERSTRT: BLOCK ERTOTL ;STRINGS FOR ERROR MESSAGES GO HERE. +EREND:: +INIDLM:: + <.BYTE 7 ? 177 ? QRSTR ? 4 ? 5 ? 0> + REPEAT ^M, ASCII / / + ASCII / + / ;CR. ENDS COMMENTS IN LISP. + REPEAT 33-^M-1, ASCII / / + ASCII / A / ;ALTMODE + REPEAT 40-33, ASCII / / ;34 THRU SPACE + ASCII / A / ;! + ASCII / A / ;" + ASCII / A / ;# + REPEAT "%-"$+1, ASCII /AA / ;$, %. + ASCII / A / ;& + ASCII / ' / ;' + ASCII / ( / ;( + ASCII / ) / ;) + ASCII / A / ;* + ASCII / A / ;+ + ASCII / / ;, + ASCII / A / ;- + ASCII /AA / ;. + ASCII . / . ;/ + REPEAT "0-"/-1, ASCII / A / + REPEAT "9-"0+1, ASCII /AA / + REPEAT ";-"9-1, ASCII / A / + ASCII / ; / + REPEAT "A-";-1, ASCII / A / + REPEAT "Z-"A+1, ASCII /AA / + REPEAT "a-"Z-1, ASCII / A / + REPEAT "z-"a+1, ASCII /AA / + REPEAT "|-"z-1, ASCII / A / + ASCII / | / + REPEAT 176-"|, ASCII / A / + ASCII / / +IFN .-INIDLM-201,.ERR WRONG TABLE LENGTH +INI..O==5*. + <.BYTE 7 ? QRBFR ? MFBUF1&177 ? MFBUF1_<-7>&177 + MFBUF1_<-14.>&177> +INISRS==5*. + <.BYTE 7 ? QRBFR ? MFSBUF&177 ? MFSBUF_<-7>&177 ? MFSBUF_<-16>&177> +INIQRW==5*. + +;INITIAL CONTENTS OF BUFFER SPACE. + +INIBUF==5*<&<-2000>> +INISRB==INIBUF +INISRE==INISRB+5*<1+STBLSZ> +INIBEG==INISRE+5 +INITOP==INIBEG+5 + +END BOOT diff --git a/src/e142/teco.mid.886 b/src/e142/teco.mid.886 new file mode 100644 index 00000000..b491f309 --- /dev/null +++ b/src/e142/teco.mid.886 @@ -0,0 +1,23050 @@ +; -*-MIDAS-*- + +;ITS TECO and EMACS should serve as a lesson to all +;of what can be achieved when programmers' creativity is not crushed +;by administrators whose main concern is stifling humor, +;stamping out all possibility of enthusiasm, and forbidding +;everything that isn't compulsory. +;They were produced in a humane anarchy where one man designs, +;implements, and then documents the feature that inspires him. +;They were produced by people who could laugh enough to +;name many years of effort the Incompatible Timesharing System. +;Of course, the whole story is imaginary. Working conditions +;which do not crush the spirit can't be practical. +;You can't run a team that way if you expect to meet the deadline. +;TECO doesn't really exist; you were only dreaming it. + +;ITS TECO was built by RMS on the work of others +;at the MIT Artificial Intelligence Lab +;(not to be confused with the Laboratory for Computer Science). +;It was converted to run on Twenex by MMCM at SRI. + +;TECO is available to those who like the way it is, +;on a basis of communal co-operation: +;you are welcome to make improvements, but only if you consult +;with the other user sites, and send your changes +;to MIT to be merged in and distributed to everyone. +;You owe your improvements to us in return for what you see here. +;If anyone asks you for a copy, make sure he gets in touch with +;the MIT AI Lab so he can get the latest stuff. + +.SYMTAB 8001. ;SHOULD BE PLENTY + +TITLE TECO + +; RESET THE SYSTEM CONDITIONALS NOT SPECIFIED BY /T AT ASSEMBLY TIME. +IFNDEF ITS, ITS==0 +IFNDEF 10X, 10X==0 +IFNDEF 20X, 20X==0 +IFG ITS+10X+20X-1, .FATAL TWO OPERATING SYSTEMS SPECIFIED +IFNDEF SUMXSW, SUMXSW==0 +IFNDEF STANSW, STANSW==SUMXSW + +; IF NO SYSTEM SPECIFIED THEN DEFAULT TO THE ONE WE'RE ASSEMBLING ON. +IFE ITS\10X\20X,[ +IFE .OSMIDAS-SIXBIT/ITS/, ITS==1 +IFE .OSMIDAS-SIXBIT/TENEX/, 10X==1 +IFE .OSMIDAS-SIXBIT/TWENEX/,20X==1 +] +IFE ITS\10X\20X, .FATAL NO OPERATING SYSTEM SPECIFIED + +TNX==:10X\20X ; TNX MEANS EITHER TENEX OR TWENEX + +IFN TNX,[ +IFNDEF EMCSDV,EMCSDV==0 ; CAUSES TRANSLATION OF TO EMACS: FOR TNX +IFNDEF INFODV,INFODV==0 +.DECSAV +IFN .OSMIDAS-SIXBIT/TENEX/,[ + IFN .OSMIDAS-SIXBIT/TWENEX/,[ + IF1 [ + .INSRT SYS:TNXDFS + .TNXDF + .INSRT SYS:TWXBTS + ]]] +] + +GLITCH==177 +ALTMOD==33 +IFN ITS,EOFCHR==3 ;PADDING CHARACTER FOR FILES. +IFN TNX,EOFCHR==0 + +IRPS AC,,FF A B C D E J BP T TT TT1 IN OUT CH Q P +AC=.IRPCNT +TERMIN + +A0==TT ;ACS FOR .I PSEUDO. +A1==TT1 + +.XCREF FF,P,A,B,C,IN,OUT,CH,T + +IFN 0,[ ;I HOPE THAT EVERYTHING THAT DEPENDS ON ORDER OF ACS +MUL: MULI: DIV: DIVI: IDIV: IDIVI: ;WILL X-REF TO ONE OF THESE. +ROTC: ASHC: LSHC: CIRC: +BLT: JFFO: +.OPEN: .RDATIM: +] + +IFN ITS,[ +CHTTYI==1 +CHFILI==3 +CHFILO==4 +CHRAND==6 ;FOR READING FILE DIRECTORIES +CHDPYO==7 ;BLOCK MODE DISPLAY OUTPUT FOR ASSEMBLED-IN ^P-CODE STRINGS. +CHERRI==11 +CHECHO==12 ;ECHO-MODE OUTPUT FOR RUBOUT. +CHECDS==13 ;FOR FS ECHO DISPLAY$ ONLY. +CHSIO==14 ;SUPER IMAGE OUTPUT. +CHTTYO==15 ;NORMAL TYPEOUT. + +TYPIN==1_ +TSMSK==%PJATY\%PJWRO\%PJRLT,,%PIPDL+%PIMPV +TSMSK1==TYPIN + +%TSNEA==1000 ;BIT 4.1 IN TTYSTS: ECHO IN MP AREA EVEN IF AN ECHO AREA EXISTS. + ;FOR THE SAKE OF THE ECHOIN SYSTEM CALL AND RRECIN. + +OPNLBP==220600 ;B.P. TO OPEN LOSS CODE IN CHANNEL STATUS. +];IFN ITS + +SUBTTL FLAGS IN FF + +;RIGHT HALF FLAGS + +FR==525252 ;BIT TYPEOUT PREFIX. +FRARG==1 ;THIS COMMAND HAS A POSTCOMMA ARG +FRARG2==2 ;THIS COMMAND HAS A PRECOMMA ARG +FRCLN==4 ;THIS COMMAND WAS GIVEN THE COLON MODIFIER +FRUPRW==10 ;THIS COMMAND WAS GIVEN THE ATSIGN OR UPARROW MODIFIER. +FRALT==20 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FROP==40 ;SET WHEN ARITH OP NEEDS A RIGHT ARG. +FRSYL==200 ;A SYLLABLE IS AVAIL TO USE AS RIGHT OPERAND OF ARITH OP. +FRFIND==2000 ;FA AND FILENAME READER USE THIS. +FRQMRK==4000 ;LAST COMMAND STRING HAD ERROR; "?" IN COMMAND READER PRINTS LAST FEW CHARS. +FRNOT==10000 ;RANDOM FLAG USED BY SEVERAL COMMANDS +FRTRACE==20000 ;TRACE IN PROGRESS: PRINT TECO COMMANDS AS EXECUTED. +FRBACK==40000 ;SEARCH IN REVERSE (ARGUMENT NEGATIVE) +FRQPRN==100000 ;IN ('S SAVED FLAGS, 1 => THIS ( WAS A Q-REG NAME, SO + ;CLOSE SHOULD RETURN TO QREGXR. +FRSPAC==200000 ;IN FA, PREVIOUS CHAR WAS A SPACE. + +;LEFT HALF FLAGS + +FL==1,,525252 ;BIT TYPEOUT PREFIX +FLNEG==1 ;DPT-ING A NEGATIVE NUMBER +FLDIRDPY==2 ;SET => LAST COMMAND WAS FILE COMMAND, SO DISPLAY DIR INSTEAD OF BUFFER +FLIN==200 ;INPUT FILE OPEN. +FLOUT==400 ;OUTPUT FILE OPEN +FLNOIN==400000 ;INSIDE ^R, 1 => THIS IS A ^ V, AND SHOULD READ NO INPUT. + + +SUBTTL OPCODES AND BITS + +TYPR4=37000,, +NUUOS==1 + +CALL=PUSHJ P, +SAVE=PUSH P, +REST=POP P, +RET=POPJ P, + +IF1 EXPUNGE EDIT ;STUPID WORTHLESS EXTENDED INSTRUCTION GETS IN THE WAY. +EXPUNGE DMOVE,DMOVEM ;TWENEX PEOPLE ARE TEMPTED TO USE THESE AND SCREW TENEX. + +.XCREF CALL,REST,SAVE,RET + +BP7==440700 + +;BITS IN 12-BIT AND 9-BIT CHARACTERS +CONTRL==200 +META==400 +SHIFT==1000 +SHIFTL==2000 +TOP==4000 + +SUBTTL DOUBLE-DOT Q-REGS + +IFNDEF NQSETS,NQSETS==3 +NQREG==<"Z-"A+1+"9-"0+1>*NQSETS +.QCRSR==10. ;..A HOLDS CURSOR. +.QBFDS==.QCRSR+1 ;..B HOLDS MACRO EXECUTED AT END OF CMD STRING IF BUFFER DISPLAY WANTED (FLDIRDPY IS OFF) +.QCPRT==.QBFDS+1 ;..C IS UNUSED +.QDLIM==.QCPRT+1 ;..D HOLDS DISPATCH FOR FW, "B, "C, ^B IN SEARCHES. +.QBASE==.QDLIM+1 ;..E HOLDS OUTPUT RADIX FOR = AND \. (INITIALY 10.) +.QCRMC==.QBASE+1 ;..F HOLDS ^R MODE SECRETARY MACRO. +.QFDDS==.QCRMC+1 ;..G HOLDS MACRO EXECUTED AFTER COMMAND STRING TO DISPLAY FILE DIRECTORY. +.QVWFL==.QFDDS+1 ;..H IS NONZERO IF THERE HAS BEEN TYPEOUT BY PRGM (SUPPRESS BUFFER DISPLAY) +.QPT1==.QVWFL+1 ;..I HOLDS WHAT . HAD AT START OF CMD STRING. +.QMODE==.QPT1+1 ;..J HOLDS "MODE" STRING, DISPLAYED ON THE --MORE-- LINE. +.QRRBF==.QMODE+1 ;..K HAS WHAT WAS KILLED IN ^R MODE. +.QRSTR==.QRRBF+1 ;..L HOLDS MACRO EXECUTED WHEN TECO IS $G'D. +.QLOCL==.QRSTR+1 ;..M IS UNUSED +.QUNWN==.QLOCL+1 ;..N HOLDS STRING MACROED BEFORE QREG UNWOUND. +.QBUFR==.QUNWN+1 ;..O HOLDS CURRENT BUFFER. +.QERRH==.QBUFR+1 ;..P HOLDS ERROR-HANDLER MACRO. +.QSYMT==.QERRH+1 ;..Q HOLDS SYMBOL TABLE SCANNED FOR Q CONTRUCT. +.Q..Z==10.+"Z-"A ;..Z HOLDS SAME AS ..O, INITIALLY. + +.QKS==0 ;..0, ..1, ..2 USED BY ^P SORT. +.QKE==1 +.QDL==2 +.Q..0==0 ;OTHER NAMES FOR ..0, ..1, ..2 +.Q..1==.Q..0+1 +.Q..2==.Q..1+1 +.Q..3==.Q..2+1 + +IF2 [ +$QCRSR==QTAB+36.*2+.QCRSR +$QCRMC==QTAB+36.*2+.QCRMC +$QMODE==QTAB+36.*2+.QMODE +$QUNWN==QTAB+36.*2+.QUNWN +$QBUFR==QTAB+36.*2+.QBUFR +$Q..0==QTAB+36.*2+.Q..0 +$QMODE==QTAB+36.*2+.QMODE +$QERRH==QTAB+36.*2+.QERRH +] + +IFNDEF LIOPDL,LIOPDL==8 ;IO PDL SIZE (MUST BE < ITS'S) +IFNDEF FDRBFL,FDRBFL==40 ;SIZE OF FILE DIR READING BUFFER. +IFNDEF LPDL,LPDL==200 ;SIZE OF REGULAR PDL. +IFNDEF MFNUM,MFNUM==25. ;[ ;INITIAL # OF FRAMES FOR MACRO OR ^] CALLS, OR ITERATIONS. +IFNDEF MFMAX,MFMAX==105. ;MAXIMUM NUMBER OF FRAMES. +IFNDEF MFINCR,MFINCR==20. ;NUMBER OF NEW FRAMES TO ALLOCATE AT ONCE. +IFNDEF GCTBL,GCTBL==100 +IFNDEF SLPQWR,SLPQWR==20000 ;# WDS TO EXPAND IMPURE STRING SPACE BY. +IFNDEF SLPWRD,SLPWRD==400 ;# WDS TO EXPAND BUFFER GAP BY. +IFNDEF GCOFTN,GCOFTN==5*2000*10. ;# CHARS OF IMPURE STRINGS WRITTEN TO CAUSE A GC. +IFNDEF LPF,LPF==400 ;QREG PDL # WDS (2 WDS/ENTRY) +IFNDEF STBLSZ,STBLSZ==300 ;SEARCH TABLE SIZE. +IFNDEF CBUFSZ,CBUFSZ==10. ;INITIAL # WDS IN CMD BUFFER. +IFNDEF MACPSZ,MACPSZ==<2*MFMAX+8>/9 ;# WDS IN MACRO PDL (4-BIT BYTES) +IFNDEF FSPSPL,FSPSPL==20 ;LENGTH OF RING BUFFER OF POINT. +IFNDEF UTBSZ,UTBSZ==40 ;LENGTH OF I-O BUFFERS. +IFNDEF LHIMAX,LHIMAX==400 ;NUMBER OF 1ST PAGE NOT AVAIL FOR :EJ +IFNDEF TYIBSZ,TYIBSZ==20. ;RECORD LAST 60 CHARACTERS TYPED. +IFNDEF CTRLT,CTRLT==0 ;WE DO NOT WANT THE OLD ^T COMMAND. + +SPD==60.*60.*24. ;NUMBER OF SECONDS IN A DAY (FITS IN A HALFWORD) + +SUBTTL MACROS + +DEFINE DBP7 A + ADD A,[70000,,] + SKIPGE A + SUB A,[430000,,1] +TERMIN + +DEFINE INSIRP A,B + IRPS ZZZ,,[B] + A,ZZZ +TERMIN TERMIN + +DEFINE CONC CONC1,CONC2 +CONC1!CONC2!TERMIN + +;ERROR MACRO: TYPRE [ERRCODE] +DEFINE TYPRE A + TYPR4 ER$!A +TERMIN + +IF2 ISKER1==TYPRE [ISK] ;"INVALID SORT KEY" ERROR, IF WITHIN A ^P COMMAND. +DEFINE ISKERR + SKIPE PSSAVP + TYPRE [ISK] +TERMIN + +;GIVEN MACPTR OR CTXPTR, SKIP IF THAT STACK IS NOT EMPTY. +DEFINE SKNTOP X + SKIPN A,X +TERMIN + +;SAY HOW ASSEMBLY IS PROGRESSING, AND HOW MUCH CORE IT TAKES SO FAR. +DEFINE INFORM A,B +IF1,[PRINTX \A = B +\]TERMIN + +;SUPPY AN ARITH OP WITHOUT A RIGHT ARG WITH 1 AS AN ARG. +;OPTIONALLY (IF FOO IS Z, O OR N) DEFAULT NO ARG TO AN ARG OF 1, +;PERHAPS SETTING OR CLEARING THE ARGUMENT FLAG (IF FOO IS O OR Z) +DEFINE ARGDFL FOO ;FOO SHOULD BE "O", "Z", "N" OR NULL. +IFNB FOO,TR!FOO!E FF,FRARG + TRZE FF,FROP + CALL ARGDF0 +TERMIN + +SUBTTL SYSTEM-DEPENDENT MACROS TO REDUCE CONDITIONALS ELSEWHERE + +IFN ITS,[ +DEFINE TSOPEN A,B + .OPEN A,B + .LOSE %LSFIL + TERMIN + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN + +DEFINE UTFARG +DEFDEV ? DEFFN1 ? DEFFN2 ? DEFDIR TERMIN + +DEFINE 4WDARG (START) +START ? START+1 ? START+2 ? START+3 TERMIN + +;MAKE NEXT TTY INPUT NOT WAIT FOR AN ACTIVATION CHARACATER. +DEFINE TTYACT + CALL TTYAC1 +TERMIN + +;WAIT FOR OUTPUT TO FINISH; RETURN # CHARS OF AVAILABLE INPUT IN AC "X". +DEFINE LISTEN X + .LISTEN X, +TERMIN + +DEFINE CIS + .SUSET [.SPICL,,[-1]] +TERMIN + +DEFINE CLOSEF X + .CLOSE X, +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT. + MOVE Q,[-<<.LENGTH /STRING/+4>/5>,,[ASCIC /STRING/]] +TERMIN +] + +IFN TNX,[ +DEFINE .VALUE + JSR ERRRET +TERMIN + +DEFINE TTYACT +TERMIN + +DEFINE STRCNC STR1,STR2 +ASCIZ \STR1!STR2\ +TERMIN + +DEFINE LISTEN X +IFN X-1,SAVE 1 +IFN X-2,SAVE 2 + MOVEI 1,.CTTRM + SKIPE DWAIT + DOBE + SIBE + SKIPA X,2 + SETZ X, +IFN X-2,REST 2 +IFN X-1,REST 1 +TERMIN + +DEFINE CLOSEF X + MOVE 1,X + CLOSF + JFCL + SETZM X +TERMIN + +DEFINE DISSTR *STRING* ;GENERATE AN ARG FOR DISIOT + HRROI Q,[ASCIZ /STRING/] +TERMIN + +IFNDEF .FNAM3,.FNAM3==.FVERS +] + +SUBTTL DISPLAY VARIABLES + +LOC 41 + JSR UUOH +IFN ITS,JSR TSINT +IFN ITS,LOC 100 +IFN TNX,LOC 140 ;DONT GET SMASHED BY LINK VARIABLES + +RGETTY: 0 ;TCTYP VARIABLE OF TTY. +TTYOPT: 0 ;TTYOPT VARIABLE OF TERMINAL. +TTYSMT: 0 ;TTYSMT VARIABLE OF TERMINAL. +OSPEED: 0 ;OUTPUT LINE SPEED IN BAUD, OR 0 IF UNKNOWN. +NVLNS: 0 ;# VERTICAL LINES ON CONSOLE +NHLNS: 0 ;# HORIZONTAL POSITIONS ON CONSOLE +USZ: 0 ;# VERTICAL LINES USABLE FOR DISPLAY. MUST FOLLOW NHLNS. +IFN USZ-NHLNS-1,.ERR +NELNS: 0 ;# ECHO LINES (NVLNS-USZ). USUALLY 3, SET BY FS ECHO $ +MXNVLS==70. +MXNHLS==160. +TOPLIN: 0 ;# OF 1ST LINE OF SCREEN TO USE FOR BUFFER DISPLAY. +NLINES: 0 ;# LINES OF BUFFER TO DISPLAY, 0 => DEFAULT + ; (2 ON TTYS, AS MANY AS WILL FIT ON DISPLAYS) +VSIZE: 0 ;# OF LINES FOR VBD TO USE (SAME AS NLINES, OR THE DEFAULT # OF LINES). +BOTLIN: 0 ;# OF 1ST LINE BELOW WINDOW. +RRTOPM: 0 ;BOTTOM OF "TOP MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %TOP) +RRBOTM: 0 ;TOP OF "BOTTOM MARGIN" WHERE CURSOR SHOULDNT GO (SET BY %BOTTOM) +DISTRN: 0 ;-1 => TRUNCATE LINES, ELSE CONTINUE THEM. +DISPCR: 0 ;-1 => STRAY CR REALLY DOES A CR. + ;IF NOT OUTPUT AS CR, IT IS OUTPUT AS UPARROW-M. + ;ALSO SIMILARLY CONTROLS WHETHER STRAY LF'S ARE OUTPUT AS LF OR ^-J. +DISPBS: 0 ;-1 => ^H OUTPUT AS BS. OTHERWISE IT IS OUTPUT AS UPARROW-H. +DISSAI: 0 ;ASSUME CTL CHARS ARE 1-POSITION GRAPHICS INSTEAD OF PRINTING AS ^-MUMBLE. +LID: 0 ;NONZERO => TRY TO USE INSERT/DELETE LINE TO MOVE TEXT AROUND. +CID: 0 ;NONZERO => USE CHAR I/D FOR SIMPLE ^R INSERT/DELETE COMMANDS +IFN ITS,[ + .BYTE 8 ;STRINGS TO OUTPUT IN SUPERIMAGE OUTPUT MODE: +EXPUNG DISCPV DISC1V DISCPH MORMCV +DISCMV=,. ;SET CURSOR AND CLEAR LINE. + %TDMV0 ? DISCPV: 0 ? 0 ? %TDEOL +DISCM1=,. ;SET CURSOR, DON'T CLEAR LINE. + %TDNOP ? %TDMV0 ? DISC1V: 0 ? DISCPH: 0 + .BYTE +IFN 700000&(DISCPH),[ ;IF MIDAS DEFINED ALL THE TAGS 1 BYTE TO SMALL, FIX THEM UP. +IRPS XX,,DISCPV DISCPH DISC1V +.AOP IBP,1,XX +EXPUNGE XX +XX=IFN .AVAL1-1,[.AVAL1] .ELSE [.AVAL2] ; KLUDGE FOR KL'S +TERMIN +]] ;IFN ITS +DISVP: -1 ;VERT POS. OF LAST LINE GIVEN TO DISLIN, REGARDLESS OF + ;WHETHER THE LINE ACTUALLY HAD TO BE IOTTED. + ;(-1 ==> JUST WENT TO TOP OF SCREEN) + ;IF DISLIN SEES IT IS HACKING SAME LINE AS PREVIOUS + ;CALL TO DISLIN, IT DOESN'T CLEAR THE LINE. +DISVP1: 0 ;VERT. POS. OF MAIN PRGM AREA TTY CURSOR. + ;TO MOVE TO LINE , DO AN LF INSTEAD OF + ;THE USUAL ^PV. +DISFLF: 0 ;-1 ==> FORCE DISLIN TO SET CURSOR POS. + +CHCTBP: 0 ;BP. FOR CHCT TO STUFF CHARS. +CHCTVS: 0 ;LAST +1 LINE FOR CHCT TO USE (= BOTLIN EXCEPT DURING TYPEOUT ON PRINTING TTY) +CHCTHP: 0 ;POSITION IN TYPED LINE (FOR CONTINUATION AND TABS) +CHCTCF: 0 ;-1 ==> LAST CHAR GIVEN TO CHCT WAS ^M. +CHCIGN: 0 ;-1 => OUTPUTTING TRUNCATED PORTION OF LINE. +CHCTAD: 0 ;CHCT PUSHJ'S @. WITH EACH LINE. +CHCTVP: 0 ;VERT. POS. OF THAT LINE. +CHCTHC: 0 ;HASH CODE OF THAT LINE. +CHCTBL: 0 ;WHEN @CHCTAD CALLED, THIS HOLDS CHAR ADDR 1ST CHAR + ;IN THE LINE BEING DISPLAYED. (ASSUMING THAT + ;DISAD WAS CALLED WITH IN HOLDING ADDR + ;OF THE CHAR AFTER THE ONE BEING OUTPUT.) +CHCTNL: 0 ;WHEN @CHCTAD CALLED, THIS WD >0 => CHAR ADDR + ;1ST CHAR TO APPEAR ON NEXT SCREEN LINE (IF ANY) + ;-1 => NEXT CALL TO @CHCTAD WILL BE ON SAME SCREEN LINE. +CHCRHP: 0 ;WHEN @CHCTAD CALLED, THIS IS HPOS AT WHICH TTY CURSOR WILL BE LEFT (FOR SCPOS) +CHCOVP: 0 ;WHEN @CHCTAD CALLED, INDICATES A STRAY ^M OR ^H WAS JUST IOTTED. +ORESET: 0 ;OUTPUT STOPPED BY QUIT NOW IN PROGRESS +MORFLF: 0 ;USER HAS FLUSHED TYPEOUT (1 => WITH RUBOUT, -1 => WITH OTHER CHAR) +OLDFLF: 0 ;GETS VALUE OF MORFLF WHEN TYPEOUT IS UN-FLUSHED AGAIN (RETURN TO ^R, ETC). +MORNXT: 0 ;NONZERO => NEXT CHAR OUTPUT SHOULD TRIGGER A --MORE--. +MORESW: 0 ;0 => NO --MORE-- OR ANYTHING. 1 => --BOT--. 2 => --TOP--. 3 => --MIDDLE--. +MS%UP==1 ;VALUES 0, 1, 2 AND 3 ARE MADE OF THESE 2 BITS. +MS%DWN==2 ;MS%UP MEAN'S THERE'S TEXT ABOVE THE SCREEN; MS%DWN, THAT THERE'S TEXT BELOW. + ;IF IT'S 3 THEN THE LH IS THE PERCENTAGE OF THE FILE ABOVE SCREEN. +MS%MOR==4 ;4 MEANS THAT --MORE-- IS BEING DISPLAYED. +MS%FLS==5 ;5 MEANS THAT --MORE--FLUSHED IS BEING DISPLAYED. +DISOMD: -1 ;WHAT $QMODE HAD WHEN LAST DISPLAYED. + ;IF $QMODE NE DISOMD, MUST REDISPLAY THE MODE. +MODCHG: 0 ;POSITIVE => ..J NEEDS TO BE RECOMPUTED, SO RUN MODMAC. + ;NEGATIVE => IT IS -2* A FS QP PTR$. IF POP PAST THERE, MUST RUN MODMAC. +MODMAC: 0 ;NON-0 => IT IS MACRO TO RECOMPUTE ..J WHEN IT IS ABOUT TO BE DISPLAYED. +TYOFLG: -1 ;>= 0 ==> TYPEOUT INITTED. +ECHACT: 0 ;-1 => SOMETHING WAS PRINTED IN THE ECHO AREA, SO ^R SHOULD CLEAR IT. FS ECHO ACTIVE$ + ;1 => CLEAR AFTER NEXT COMMAND BUT NOT AFTER THIS COMMAND. +ECHFLS: 0 ;NONZERO TO ENABLE THE ECHACT FEATURE. FS ECHO FLUSH$. +ECHCHR: 0 ;-1 => LAST COMMAND HAS TYPED OUT, SO ^R SHOULDN'T ECHO IT. + ;OTHERWISE, IT IS CHARACTER OR STRING TO ECHO. + ;(PRINTING TERMINALS ONLY). +RUBENC: 0 ;NONZERO => IS CHAR OR STRING TO TYPE BEFORE TYPING ANYTHING ELSE + ;(EG, \, AFTER A RUBOUT IN ^R IN SCANNING MODE). FS XPROMPT$. +BSNOLF: 0 ;-1 => BACKWARD MOTION AND RUBBING OUT SHOULDN'T DO LF'S (PRINTING TTY ONLY). +DISADP: 0 ;WHEN DISAD IS CALLED, THIS SHOULD HOLD C(PT)+1. + ;USED BY DISAD TO DECIDE WHEN TO OUTPUT CURSOR. +TTYMAC: 0 ;MACRO FOR FS TTY INIT$ TO CALL TO RESET TTY PARAMETERS FOR USER OPTIONS. + +IFNDEF DISBFL,DISBFL==MXNHLS/4+1 ;LENGTH OF TTY IOT BUFFER. + +IFN TNX,[ +EOLFLG: 0 ;KLUDGE FLAG FOR TERMINALS WITH NO CLEOL +SGTTYP: 0 ;PLACE TO SAVE GTTYP TERMINAL INDEX +PADCHR: 177 ;CHARACTER FOR PADDING, -1 => USE DELAY INSTEAD OF PADDING. +TIMPDS: .BYTE 7 ;ASCIZ STRING OF RUBOUTS OR WHATEVER + REPEAT 99.,177 +TIMPDE: 0 + .BYTE +VT1BUF:: ;USED ALSO BY VT100 FOR SCROLLING COMMANDS +HPBUF: BLOCK 4 ;BUFFER FOR HP CURSOR MOTION COMMANDS +DISBF1: BLOCK 6 ;HOLDS STUFF TO SET CURSOR POS FOR THE LINE IN DISBUF. +] +IFN ITS,[ ;DISBF1 AND DISBUF IOTTED AT ONCE. +DISBF1: BLOCK 2 ;IF NO CURSOR MOTION NEEDED, THIS HOLDS %TDNOP (0 ON TENEX). +] +DISBUF: BLOCK DISBFL ;BUFFER FOR TEXT TO BE IOTTED TO TTY. +DISBFC: 0 ;# CHARS SPACE LEFT IN DISBUF. + +DISPRR: 0 ;NON0 => PDL LEVEL AT RRDISP. + ;CAUSES CRSR POS AT PT TO BY REMEMBERED, ETC. +GEA: 0 ;-1, OR OLD ADDR (REL TO BEG) OF 1ST CHAR OF BUFFER DISPLAYED. +%TOP: 10. ;PERCENT OF SCREEN CURSOR SHOULDN'T ENTER AT TOP. +%BOTTO: 10. ;SIMILAR, FOR BOTTOM. +%CENTE: 40. ;PERCENT FROM TOP CURSOR SHOULD GO WHEN WINDOW CHANGES. +%END: 30. ;WHEN WINDOW MOVED, CURSOR MUST BE >= THIS MUCH FROM BOTTOM. +CLRMOD: -1 ;-1 => CLEAR SCREEN IN DISTOP IF TTY + ;HAD BEEN TAKEN AWAY AND RETURNED BY TECO'S SUPERIOR. + ;0 => DON'T DO THAT. + ;1 => DISABLE ALL SCREEN-CLEARING, EWVEN BY ^L AND F+ +PJATY: -1 ;-1 => WE JUST GOT A %PJATY INT, SO SHOULD REDISPLAY WHOLE SCREEN SOON. +REFRSH: 0 ;NONZERO => MACRO IT WHEN WANT TO CLEAR SCREEN DUE TO PJATY + ;(INSTEAD OF MACROING FS ^R DISPLAY$). +VREMEM: 0 ;NON0 WHEN DISPLAYING STUFF THAT'S IN BUFFER. +RRINHI: 0 ;NON-0 INHIBITS ALL DISPLAY UPDATING (FS ^R INHIBIT$) +RRECBP: 0 ;NONZERO INDICATES WE RESTARTED TECO OUT OF RRECIN, SO CALL RRECI5. +RRECSD: 0 ;IF SPACE'S DEFINITION EQUALS THIS, SPACE CAN BE ECHOED. USE FOR AUTO-FILL. +TTMODE: 0 ;NON-0 => DISPLAY BUFFER AFTER CMD STRINGS EVEN IF PRINTING TTY. +HCDS: BLOCK MXNVLS ;HASH CODES OF LINES ON SCREEN +HCDSE: 0 + +LINBEG: BLOCK MXNVLS ;1 WD / LINE ON SCREEN, SET BY VBD AS FOLLOWS: + ;BITS 3.9 - 1.1 -- CHAR ADDR OF 1ST CHAR ON THE LINE + ;BITS 4.9 - 4.1 -- HPOS THAT CHARACTER STARTED IN. +LINEND: BLOCK MXNVLS ;FOR EACH LINE, THE HPOS OF THE END OF THE LINE: + ;THE HPOS THAT THE NEXT CHARACTER ON IT WOULD HAVE HAD. +DWAIT: 0 ;WAIT FOR OUTPUT TO FINISH BETWEEN LINES, TO AVOID BUFFERING UP LOTS OF STUFF. +DFORCE: 0 ;FORCE DISPLAY TO FINISH DESPITE PENDING INPUT. DON'T UPDATE MODELINE. +SHOMOD: 0 ;ON PRINTING TTY, FR TYPES OUT ..J IF THIS IS NONZERO. + +SUBTTL ITS FILE AND INTERRUPT VARIABLES + +IFN ITS,[ +TIME: 0 ;TIME IN SIXBIT +DATE: 0 ;DATE IN SIXBIT +PDTIME: 0 ;# SECONDS SINCE BEGINNING OF YEAR +LPDTIM: 0 ;LOCALIZED " +YEAR: 0 ;YEAR AND FLAGS +CDATE: SIXBIT/ 00,19/ +CTIME: SIXBIT / : : / +0 + +INTJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU WERE INTERRUPTED FROM +UUOJPC: 0 ;PLACE THAT JUMPED TO WHERE YOU UUO'D FROM, IF IT WAS ILLEGAL MUUO. + +TSINT: 0 + 0 + .SUSET [.RJPC,,INTJPC] + JRST TSINTP + +INTACS: BLOCK 20 + +TTYST1: 322020,,202020 ;ACTIVATE ON ^C (AND OTHER RANDOM CTL CHARS) + ;OUTPUT CTL CHARS IN IMAGE MODE. +TTYST2: 332033,,300220 ;ACT. ON ^G (^S), RUB, ALT; INT. ON ^G (^S) ,ALTMODE; OUTPUT CR IN IMAGE. +TTYSTS: 0 ;3RD ARG FOR TTYSET. +DEFDEV: 0 ;DEFAULT FILENAMES. DEFAULT DEVICE INITTED TO MACHINE NAME. +DEFFN1: SIXBIT /@/ +DEFFN2: SIXBIT />/ +DEFFN3==DEFFN2 ;GENERATION NUMBER IS THE SAME AS SECOND FILENAME +DEFDIR: 0 ;CURRENT SNAME. +ERDEV: 0 ;LIKE EIDEV BUT FOR DEV BEING READ. +RUTF1: 0 ;REAL FILE NAMES +RUTF2: 0 ;ON READ +ERSNM: 0 ;AND SNAME BEING READ. +ROUDEV: 0 ;REAL FILE NAMES OF LAST OUTPUT FILE EXPLICITLY CLOSED. DEVICE NAME. +ROUFN1: 0 ;FN1 OF IT. +ROUFN2: 0 ;FN2 OF IT. +ROUSNM: 0 ;SNAME OF IT. + +MACHIN: 0 ;SIXBIT NAME OF MACHINE. + +FDRBUF: BLOCK FDRBFL ;BUFFER FOR READING FROM CHRAND. +FDRBFE: _29. +FDRP: 0 ;BYTE POINTER TO FDRBUF + +CHPOPX: TRNE\TRNN T,1 ;SEE IF THIS PUSHED IOCHNL IS THE RIGHT DIRECTION +GCHN2: CAIN E,. ;DON'T USE CHNL AS TEMP + ;IF ITS THE ONE WE WANT TO POP INTO. + +IOP: -LIOPDL,,IOPDL-1 ;POINTER TO LOCAL IO PDL +IOPDL: BLOCK LIOPDL ;LOCAL IO PDL +];IFN ITS + +SUBTTL TWENEX FILE AND INTERRUPT VARIABLES + +IFN TNX,[ + NFKS==10 ;NUMBER OF SUBFORKS THERE CAN BE AT ONE TIME (NOT COUNTING EXECFK). +EXECFK: -1 ;FORK HANDLE FOR EXEC (FZ$ := PUSH) +RUNFRK: 0 ;FORK HANDLE OF CURRENTLY RUNNING PROCESS (WITHIN FZ). +FRKJCL: 0 ;STRING OF JCL FOR THE FORK +FRKTAB: BLOCK NFKS ;TABLE OF FORK HANDLES, INDEXED BY FZ ARGUMENT NUMBER +INTACS: BLOCK 20 ;SAVE ACS ON INTERRUPTS +INTPC: 0 ;INTERRUPT SAVED PCS FOR THE THREE LEVELS. +INTPC1: 0 +INTPC2: 0 +BOOTP: 0 ;P SAVED HERE TO BE DUMPED IN EJ FILES (SINCE SSAVE DOESN'T SAVE ACS). +DISCPH: 0 ;STARTING HPOS FOR THIS LINE +FCITYI: 0 ;HIGH ORDER BITS ARENT PARITY (CROCK NEEDED FOR DM1520) +IFN 20X,[ +PAGMOD: 0 ;NON-ZERO => LEAVE TERMINAL IN PAGE MODE (FOR ^S/^Q) +] +ITTYMD: BLOCK 3 ;PLACE TO SAVE INITIAL TTY MODES TO RESTORE BEFORE CALLING SUBFORK. +FTTYMD: 0 ;INFERIOR FORK STPAR +IFN SUMXSW,[ +HLDCHR: 0 ;Place to keep the hold char while it's turned off +] +ECHOP: -1 ;ARE WE IN ECHO AREA? +ECHOF2: 0 ;MUST TECO EXPLICITLY ECHO INPUT? +ECHOL0: 0 ;VPOS OF FIRST LINE OF ECHO AREA +ECHOPS: 0 ;CURRENT POSITION IN ECHO AREA +ECODPF: 0 ;FS ECHO DISPLAY: WAS ^P LAST CHARACTER SEEN? +ECODPS: 0 ;SAVED POSITION FOR ^PS IN ECHO AREA +SAVMOD: 0 ;SFMOD TO BE RESTORED ON ^G INTERRUPT (FOR :ET), ELSE 0 +TTLPOS: 0 ;REAL SCREEN POSITION (INTERNAL RFPOS/SFPOS EQUIVALENT) +OPNJFN: 0 ;JFN BEFORE OPENF +CHFILI: 0 ;INPUT FILE JFN +CHFILO: 0 ;OUTPUT FILE JFN +DEFDEV: ASCII /DSK/ ;DEFAULT DEVICE + 0 +DEFDIR: BLOCK 20 ;DIRECTORY NUMBER +DEFFN1: ASCII /FILE/ ;DEFAULT TO SOMETHING RANDOM + BLOCK 17 ;NAME +DEFFN2: BLOCK 20 ;EXTENSION +DEFFN3: 0 ;GENERATION NUMBER +ERDEV: BLOCK 63 ;SAME FORMAT - LAST READ FILE'S NAME +ROUDEV: BLOCK 63 ;DITTO - REAL OUTPUT FILENAMES +IFE STANSW,[ +ETMODE: 37 ;BITMASK OF FIELDS TO DEFAULT FOR :ET COMMAND +];IFE STANSW +IFN STANSW,[ +ETMODE: 0 ;BITMASK OF FIELDS TO DEFAULT FOR :ET COMMAND +];IFN STANSW +CCLJFN: 0 ;JFN IN 1 IF STARTED AT NORMAL ENTRY+2 +INIOP: -LIOPDL,,INIPDL-1 ;INPUT I/O PDL POINTER +INIPDL: BLOCK LIOPDL ;INPUT I/O PDL +OUTIOP: -LIOPDL,,OUIPDL-1 ;OUTPUT I/O PDL POINTER +OUIPDL: BLOCK LIOPDL ;OUTPUT I/O PDL + +SAVABC: 0 ;JSR HERE TO SAVE AC'S A, B, AND C ON THE STACK + SAVE A + SAVE B + SAVE C + JRST @SAVABC + +ERRRET: 0 + MOVEM 17,77 ;SAVE ALL ACS IN CASE WANT TO DO A DUMP + MOVEI 17,60 + BLT 17,76 + HRROI A,[ASCIZ /Internal error at /] + ESOUT + MOVEI A,.PRIOU + HRRZ B,ERRRET + MOVEI C,10 + NOUT + JFCL +ERRRST: MOVSI 17,60 ;RESTORE ACS FOR IMMEDIATE DEBUGGING (ERRRSTG FROM DUMP ALSO) + BLT 17,17 + HALTF + JRST @ERRRET + + +%TOERS==40000 ;CAN SELECTIVELY ERASE +%TOHDX==20000 ;HALF DUPLEX (BOUND TO LOSE SOMEWHERE) +%TOMVB==10000 ;CAN BS +%TOSAI==4000 ;SAIL CHAR SET +%TOSA1==2000 ;USE SAIL CHAR SET +%TOOVR==1000 ;CAN OVERWRITE +%TOMVU==400 ;CAN MOVE THE CURSOR UP +%TOMOR==200 ;MORE PROCESSING +%TOROL==100 ;ROLL +%TOLWR==20 ;HAS LOWERCASE KEYBOARD +%TOFCI==10 ;HAS 12 BIT INPUT CAPABILITY +%TOLID==2 ;HAS LINE I/D +%TOCID==1 ;HAS CHAR I/D +] +;[ + +SUBTTL RCH, CHARACTER SYNTAX TABLES, ^] + +UUOQ: 0 +UUOH: 0 + MOVEM Q,UUOQ + LDB Q,[331100,,40] + CAIN Q,TYPR4_-33 + JRST ETYP2A +IFN ITS,.SUSET [.RJPC,,UUOJPC] + MOVE Q,UUOQ + .VALUE + TYPRE [DSI] + +SKRCH: SKIPG COMCNT + TYPRE [UEC] +RCH: SOSGE COMCNT + JRST RCH2 ;NOTE RCH2 LOOKS AT OUR RETURN ADDRESS. + ILDB CH,CPTR + XCT RCHDTB(CH) ;DO SPECIAL STUFF OR JFCL.. +TRACS: POPJ P,TYOS ;OR JRST TYOS IN TRACE MODE. + SKIPN MACPTR ;RCHDTB ENTRY SKIPS IF SHOULD CHANGE CHAR'S CASE. + XORI CH,40 ;BUT NEVER CHANGE CASE OF CHARS IN MACROS. + JRST TRACS + +;[[[[ +RCHDTB: REPEAT 33,JFCL +RCHALT: JFCL ENDARG ;OR JRST IF SHOULD END A ^]^X + REPEAT ^]-34,JFCL +RCHBRC: JRST CTLBRC ;^] + REPEAT "?-^],JFCL + SKIPL RCHSFF ;@ + REPEAT 26.,SKIPL CASE ;UPPER CASE LETTERS + REPEAT 5,SKIPL RCHSFF ;[\]^_ + JFCL ;` + REPEAT 26.,SKIPG CASE ;LOWER CASE LETTERS. + REPEAT 5,JFCL ;{|}~ +IFN .-200-RCHDTB, .ERR RCHDTB WRONG SIZE. + +SQUOTP: 0 ;;SIGN => READING SUPER-QUOTED MACRO. + ;4.8 => READING DELIMITER-PROTECTED MACRO. +DLMF2: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT 4.8 OF SQUOTP SHOULD BE SET +SQUOF2: 0 ; " " " " " " SIGN OF SQUOTP " " " +BRC1CF: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THAT ONLY ONE CHARACTER SHOULD BE GOBBLED +BRCUAV: 0 ;INTERNAL FLAG FOR CTLBRC INDICATES THE Q-REGISTER + ;SHOULD BE USED AS A NUMERIC VALUE (IE. ASCII VALUE) + +BRC1: 0 ;[ ZERO => HANDLE ^] NORMALLY + ;[[[[[; -1 => DO-NOT EXPAND MACROS, BUT HANDLE ^]^],^]$,^]^V,AND ^]^Q NORMALLY +BRCFLG: 0 ;[ ;SET TO -1 BY ^]'S THAT INSERT UNPREDICTABLE STUFF. + ;[ ;SET IT TO 0 AND TEST IT LATER TO SEE IF ANY ^]'S HAVE HAPPENED. + ;[ ;ALSO, ^]^V LEAVES THE CHARACTER HERE ON RETURN, AS IT WAS + ;BEFORE BEING TRUNCATED TO 7 BITS. + +CASE: 0 ;DESIRED INPUT CASE. + ;0 => LEAVE CASE OF CHARS ALONE, + ;<0 => WANT CHARS IN LOWER CASE, + ;>0 => WANT CHARS IN UPPER CASE. + ;NEGATED BY CASE-SHIFT AND CASE-LOCK CHARS. +CASNRM: 0 ;NORMAL CASE - REINIT. CASE AT START OF CMD STRING. + ;THIS IS WHAT FSCASE SETS. +CASDIS: 0 ;NONZERO => PUT CASESHIFTS IN OUTPUT. +CASSFT: -1 ;CASE-SHIFT CHAR, OR -1 IF NONE. +CASLOK: -1 ;CASE-LOCK CHAR, OR -1 IF NONE. +RCHSFD: 0 ;SAVED NORMAL CONTENTS OF RCHDTB ENTRY FOR + ;CASE-:SHIFT CHAR (RCHDTB ENTRY NOW IS ) +RCHLOD: 0 ;SAVED NORMAL RCHDTB ENTRY FOR CASE-LOCK CHAR. +RCHSFF: 0 ;-1 => LAST CHAR WAS A CASE-SHIFT. + ;USED TO CAUSE A CASE SHIFT TO QUOTE ITSELF. + +SUBTTL ADDRESS SPACE ORGANIZATION + +;;; THE 1ST 2 PAGES ARE THE "LOW IMPURE", CONTAINING SPECIAL-PURPOSE VARIABLES. +;;; THEN COMES THE PURE CODE, FROM "INIT" TO "HUSED". +;;; THEN COMES THE HIGH IMPURE, STARTING WITH A FEW SPECIAL-PURPOSE VARIABLES, +;;; FOLLOWED BY THE ^R COMMAND DISPATCH TABLE. + +;;; THEN COME THE DYNAMICALY ALLOCATED AREAS: +; THE COMMAND BUFFER IS USED FOR OLD-FASHIONED (NON-^R) TECO TOP-LEVEL COMMAND READIN. +CBUFLO: 10740,,CBUF ;SET TO BP -> BOTTOM OF COMMAND BUFFER. +CBUFH: CBUF+CBUFSZ-1 ;-> LAST WD OF COMMAND BUFFER + +; IMPURE STRING SPACE CONTAINS STRINGS AND BUFFERS' POINTER-STRINGS. +; BOTH START WITH A FLAG CHARACTER (QRSTR OR QRBFR, RESPECTIVELY), FOLLOWED +; BY 3 CHARACTERS HOLDING A NUMBER. IN A STRING, THAT NUMBER IS THE LENGTH, +; INCLUDING THE FOUR HEADER CHARACTERS, AND THE DATA FOLLOWS THE NUMBER. +; IN A BUFFER POINTER-STRING, THE NUMBER IS THE ADDRESS OF THE BUFFER'S FRAME. +; EITHER KIND OF OBJECT IS REPRESENTED IN QREGS, AS VALUES, ETC. BY A NUMBER +; WHICH IS THE CHARACTER ADDRESS RELATIVE TO THE START OF THE SPACE, PLUS SETZ. +QRBUF: INIQRB ;CHAR ADDR START OF IMPURE STRING SPACE +QRWRT: INIQRW ;CHAR ADDR 1ST CHAR ABOVE IMPURE STRING SPACE. +QRSTR==177 ;PREFIX CHAR FOR STRING (FOLLOWED BY 3 CHARS HOLDING + ;21-BIT SIZE OF STRING INCLUDING 4 HEADER BYTES, FOLLOWED BY TEXT). +QRBFR==176 ;PREFIX CHAR FOR BUFFER POINTER (FOLLOWED BY 3 CHARS + ;HOLDING ADDR OF POINTER-BLOCK (IN MACRO-FRAME SPACE)). + +; THEN COMES A GAP, CONTAINING NON-EXISTENT MEMORY, FOLLOWED BY BUFFER SPACE. +; EVERY BUFFER'S DATA AREA IS A SUBSET OF BUFFER SPACE, AND BUFFER SPACE +; IS USED FOR NO OTHER PURPOSE. +; BUFFER SPACE STARTS AND ENDS ON WORD BOUNDARIES, BUT BUFFERS NEED NOT START ON THEM. +; EACH BUFFER ENDS ON A WORD BOUNDARY, AND IS FOLLOWED BY ONE UNUSED WORD, +; WHICH IS INCLUDED IN BUFFER SPACE. ASIDE FORM THOSE UNUSED WORDS, EVERY WORD +; IN BUFFER SPACE CONTAINS PART OF AT LEAST ONE BUFFER. +; BUFFER DATA IS POINTED TO BY BUFFER FRAMES (SEE MFBFR), +.SEE BEG ; OR, FOR THE CURRENT BUFFER, BY BEG, ETC. +BFRBOT: INIBUF ;CHAR ADDR BOTTOM OF BUFFER SPACE (= BEG OF LOWERMOST BUFFER) +BFRTOP: INITOP ;CHAR ADDR TOP OF BUFFER SPACE (> Z OF UPPERMOST BUFFER) + +; THE MEMORY ABOVE BUFFER SPACE CAN CONTAIN ^P-SORT TABLES. IT CAN +; ALSO CONTAIN RANDOM DATA USED ENTIRELY WITHIN A SINGLE COMMAND. +MEMT: <1777+INITOP/5>_-10. ;NUMBER OF 1ST PAGE OF NXM ABOVE BUFFER SPACE. + +; ABOVE THE RANDM DATA THERE IS A GAP, RUNNING TO THE TOP OF MEMORY OR TO THE +; BEGINNING OF PURE STRING SPACE, WHICH STRETCHES DOWN FROM THE TOP OF MEMORY. +; OBJECTS IN PURE STRING SPACE LOOK LIKE OBJECTS IN IMPURE STRING SPACE, AND +; ARE POINTED TO BY NUMBERS WHICH ARE SETZ PLUS THE ABSOLUTE CHARACTER ADDRESS. +LHIPAG: LHIMAX ;LOWEST PAGE IN USE BY PURE STRING SPACE. + +INSINP: 0 ;WHILE INSERTING, PDL LEVEL AT INSLUP, ELSE 0. +INSLEN: 0 ;LENGTH OF THE LAST STRING INSERTED OR SEARCHED FOR. +TOTALC: 0 ;# CHARS AT END OF GAP NOT YET USED BY INSERT. +INSRCH: 0 ;INSN FOR INSERT TO XCT TO GET A CHAR. +INSDLM: 0 ;THE DELIMITER FOR THIS INSERT +INSBP: -1 ;NORMALLY -1 => NO ACTION. + ;INSERT AND FCECMD SET IT TO 0, SIGNALLING RCH + ;THAT BP SHOULD BE SAVED IN INSBP IF THERE IS A CHANCE + ;THAT A GC WILL OCCUR (EG IF PUSMAC IS CALLED). + ;BFRRLC WILL THEN RELOCATE INSBP AS A BYTE POINTER + ;EVENTUALLY RCH WILL COPY INSBP BACK TO BP AND ZERO INSBP. + +;VARIABLES DESCRIBING THE CURRENTLY SELECTED BUFFER. +BFRSTR: SETZ INI..O-INIQRB ;INTERNAL VERSION OF $QBUFR; + ;-> POINTER-STRING OF CURRENT BUFFER. +BFRPTR: MFBUF1 ;-> BUFFER FRAME FOR CURRENT BUFFER (IN MACRO-FRAME SPACE). +BEG: INIBEG ;CHARACTER ADDRESS OF BEGINNING OF BUFFER +BEGV: INIBEG ;CHAR ADDR BEGINNING OF AREA BEING EDITED. +PT: INIBEG ;CHARACTER ADDRESS OF "POINTER" +GPT: INIBEG ;CHARACTER ADDRESS OF THE BEGINNING OF THE GAP +ZV: INIBEG ;CHAR ADDR 1ST CHAR AFTER AREA BEING EDITED. +Z: INIBEG ;CHARACTER ADDRESS OF FIRST CHARACTER AFTER BUFFER +EXTRAC: 0 ;SIZE OF GAP (# CHARS) + JRST SUPCMD ;START TECO HERE TO REQUEST SPACE IN BUFFER, ETC. +SUPARG: 0 ;HOW MUCH SPACE IS WANTED. RETURNS WITH .BREAK 16,100000 +MODIFF: 0 ;NONZERO IFF THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. + ;SET BY WRITING; CAN BE SET OR CLEARED BY USER. +READON: 0 ;NON-0 DISALLOWS MODIFYING THIS BUFFER; CAN BE SET OR CLEARED BY USER + +;VARS ASSOCIATED WITH COMPUTATION OF NUMERIC ARGUMENTS. +LEV: 0 ;DEPTH IN PARENTHESES. +NUM: 0 +SARG: 0 ;ARG BEFORE COMMA FOUND HERE IF FRARG2 FLAG SET. +DLIM: ADD C,SYL ;THIS INSN SET BY ARITH OPS. +SYL: 0 +OSYL: 0 +IBASE: 10. ;INPUT RADIX FOR NUMBERS NOT FOLLOWED BY "." +I.BASE: 8 ;INPUT RADIX FOR NUMBERS FOLLOWED BY ".". + +;VARS USED BY TYPE-IN, AND LIS. +TYIBUF: BLOCK TYIBSZ ;BUFFER WHICH HOLDS LAST TYIBSZ*3 INPUT CHARACTERS. +TYIBFP: 441400,,TYIBUF ;POINTER FOR STORING IN TYIBUF. +TYIBFQ: 441400,,TYIBUF ;PTR FOR READING. COPIED FROM TYIBFP AFTER EACH CHAR STORED. +TYISNK: 0 ;MACRO TO BE CALLED WITH EACH TYPED-IN CHARACTER (BUT NOT REREAD ONES) + ;IN ADDITION TO PROCESSING THE CHARACTER NORMALLY. FOR DEFINING MACROS. +TYISRC: 0 ;NONZERO => MACRO TO SUPPLY "TYPE-IN" CHARACTERS. FOR EXECUTING MACROS. + +ECHOFL: 0 ;NONZERO => SYSTEM ECHOING IS TURNED ON. +LTYICH: 0 ;LAST CHAR READ FROM TTY, FOR DETECTING $$. +UNRCHC: -1 ;-1, OR CHARACTER TO BE RE-READ. +INCHCT: 0 ;NUMBER OF CHARACTERS READ FROM TTY SO FAR. +INCHRR: 0 ;VALUE OF INCHCT AT LAST TIME THROUGH RRLP1. + ;INCHCT-INCHRR IS LENGTH OF THIS ^R COMMAND IN INPUT CHARS. +HELPMA: 0 ;FS HELP MAC$: NONZERO => MACRO TO RUN WHEN "HELP" KEY IS TYPED. +HELPCH: TOP+"H ;FS HELP CHAR$: CHARACTER TO INVOKE HELP MACRO +PROMCH: "& ;THE PROMPT-CHARACTER; FS PROMPT $. 0 => NO PROMPTING. +CMFLFL: 0 ;-1 READ COMMAND OR INIT FILE +;[[ +CTLBRF: 0 ;-1 IF READING CHARACTER AFTER A ^] OR ^]^Q (IN TECO CMD STRING). +CBMAX: 0 ;LENGTH OF WHAT IS NOW IN CBUF. +SAVCMX: 1 ;CBMAX OF LAST CBUF STRING THAT WAS LONGER THAN 3 WORDS. +SAVCW1: 0 ;AND 1ST 3 WDS OF THAT CMD STRING. +SAVCW2: 0 ;THESE VARS COPIED BACK INTO CBMAX, CMD BUFFER, +SAVCW3: 0 ;AND CPTR BY LISCY (^Y AS FIRST CHAR TYPED) +SAVCPT: 0 ;(SAVED CPTR) SO IT CAN RESTORE LAST LONG COMMAND. + +FSPSPB: BLOCK FSPSPL ;RING BUFFER OF PT. +FSPSPP: 4400,,FSPSPB-1 ;RING BUFFER POINTER, -> LAST USED ENTRY. + +LISTF5: CALL . ;XCT THIS TO OUTPUT A CHARACTER. +DPT5: MOVEI CH,40 ;RH HAS CHARTO PAD A PRINTED NUMBER WITH. + +SUBTTL MACRO CALL FRAMES + +;MACRO AND ITERATION HANDLING LIST STRUCTURE: +;EACH CELL HAS MFBLEN WORDS. +;LISTS ARE LINKED THRU THE LAST WORD. +;THE FIRST 2 WORDS ARE RELOCATED BY GC. +;POINTERS TO NON-FREE BLOCKS ACTUALLY POINT TO THE +;LAST WORD OF THE BLOCK. + +MFBLEN==7 ;# WORDS PER CELL. + +;[ ;MACRO OR ^] INVOKATION LIST... +;(POINTED TO BY MACPTR) +MFCCNT==0 ;COMCNT +MFCPTR==1 ;CPTR +MFCSTR==2 ;CSTR +MFARG1==3 ;MARG1 +MFARG2==4 ;MARG2 +MFPF==5 ;MACSPF +MFLINK==6 ;MACPTR + ;LH HAS SAVED LH(MACBTS). + +;[[[ ;^]^X READ CELL. ^]^X IS A SPECIAL KLUDGE TO ALLOW STRING ARGUMENTS + ;TO BE READ FROM THE PREVIOUS COMMAND STRING LEVEL. IT TRIES TO BE + ;CLEVER ABOUT WHAT IT DOES WHEN OTHER ^] STRINGS ARE ENCOUNTERED WHILE + ;SCANNING FOR THE END OF THE ARGUMENT, DEFINED BY THE FIRST + ;ENCOUNTERED THAT ISN'T PROTECTED AGAINST TRIPPING THE CATCH (IE., BY QUOTING IT)> +;THESE CELLS FORM A LIST POINTED TO BY CTXPTR. + ;COMCNT + ;CPTR + ;CSTR + ;MARG1 + ;MARG2 + ;UNUSED. +;[ ;CTXPTR + +;ITERATION OR ERRSET (:< -- >)CELL +;THESE FORM A LIST POINTED TO BY ITRPTR. + ;COMCNT + ;CPTR + ;CSTR +MFICNT==3 ;ITERCT +MFMACP==4 ;MACPDP + MFERS1==40 ;THE 40 BIT IN THE LH (THE EXTRA BIT OF THE BYTE POINTER WHICH IS MACPDP) + ;IS USED TO INDICATE THAT THIS IS AN @:< TYPE OF ERRSET. +MFPF==5 ;LH OF THIS WORD HAS RH OF P, RH HAS RH OF PF. + ;AS THEY WERE WHEN THE < WAS EXECUTED. + ;ITRPTR + +;BUFFER FRAME - DISTINGUISHED BY NEGATIVE 1ST WORD OF BLOCK. +MFBBTS==760000 ;THESE ARE ALL THE BITS IN MFBEG WORDS. +MFBFR==400000 ;1 => THIS IS A BUFFER FRAME. +MFMARK==200000 ;GC MARK BIT FOR BUFFER FRAME. +MFQVEC==100000 ;BIT INDICATING MARK THRU THE WORDS OF THIS BUFFER +MFMODIF==040000 ;1 => THIS BUFFER HAS BEEN WRITTEN IN RECENTLY. +MFREADO==020000 ;1 => DONT ALLOW MODIFICATION OF THIS BUFFER + +MFBEG==0 ;HOLDS WHAT WOULD BE IN BEG IF THIS BUFFER WERE SELECTED. + ;AS WELL AS MFBFR AND MFMARK IN THE LH. +MFBEGV==1 ;SIMILAR, BUT FOR BEGV, AND NO MFBFR OR MFMARK. +MFPT==2 ;SIMILAR, FOR PT. +MFGPT==3 ;SIMILAR, FOR GPT. +MFZV==4 ;SIMILAR, FOR ZV. +MFZ==5 ;SIMILAR, FOR Z. +MFEXTR==6 ;SIMILAR, FOR EXTRAC. + +;THE FREE STORAGE LIST OF CELLS IS POINTED TO BY MFFREE, +;AND LINKED THROUGH THE LAST (MFLINK) WORD OF THE CELL, +;AND TERMINATED WITH A 0. +;THE MFCPTR OF A FREE CELL CONTAINS 0. +;POINTERS TO FREE CELLS ACTUALLY POINT TO THE WORD +;BEFORE THE FIRST WORD OF THE CELL. +;IF THE 1ST WORD OF A CELL IS NEGATIVE (MFBFR IS SET) THE CELL IS A BUFFER FRAME. + +MFFREE: MFSTRT-1 ;MACRO FRAME FREE LIST POINTER. +MFEND: MFEND1 ;END OF SPACE ALLOCATED TO MACRO FRAMES. + +COMCNT: 0 ;NUMBER OF CHARACTERS LEFT IN CURRENT LEVEL OF COMMAND STRING +CPTR: 0 ;BYTE POINTER TO COMMAND STRING (CURRENT LEVEL) +CSTR: 0 ;THE TECO STRING OBJECT WE ARE NOW EXECUTING PART OF. + ;IF EXECUTING SOMETHING NOT IN A TECO STRING, THIS IS BP TO ILDB 1ST CHAR. +MARG1: 0 ;FIRST NUMERIC MACRO ARGUMENT (GOTTEN BY ^X INSIDE MACRO) +MARG2: 0 ;SECOND NUMERIC MACRO ARGUMENT (FETCHED BY ^Y) +MACSPF: 0 ;PF COPIED INTO THIS WORD WHEN MACRO IS CALLED. + +MACPTR: 0 ;POINTER TO THE LAST CELL IN THE MACRO INVOKATION AND +;[ ;^] INVOKATION LIST +MACDEP: 0 ;NUMBER OF FRAMES IN MACPTR STACK (INCLUDING THOSE VIA MACXP). + +CTXPTR: 0 ;[ ;POINTER TO LAST CELL IN THE ^]^X INVOKATION LIST + +MACBTS: 0 ;BITS IN LH SAYING HOW MANY ARGS GIVEN TO CURRENT MACRO. +MFBA1==400000 ;1 => 2 ARGS WERE GIVEN. +MFBA2==200000 ;1 => AN ARG WAS GIVEN. +MFBATSN==100000 ;1 => @ WAS SPECIFIED IN THE CALL TO THIS MACRO. + + +ITRPTR: 0 ;RH PTR TO INNERMOST ITERATION OR ERRSET CELL + ;LH PTR TO INNERMOST ERRSET CELL (OR 0) +ITERCT: 0 ;# PASSES LEFT IN INNERMOST ITERATION. + +;[[[[[ ;THE MACRO PDL CONSISTS OF 4-BIT BYTES, ONE PER MACRO CALL +;OR ^]-CALL (INCLUDING ^]^X). +;MACRO PDL OVERFLOW IS IMPOSSIBLE BECAUSE THE RATIO OF MACRO-PDL +;TO MACRO CELL SPACE INSURES THAT THE LATTER WILL RUN OUT FIRST. +;ONE ENTRY PUSHED FOR EACH ^] CALL (INCLUDING ^]^X) OR M COMMAND. +;0 => MACRO CALL THAT DIDN'T SUPERQUOTE OR DELIMITER-PROTECT. +;1 - 7 => MACRO CALL. 4 BIT => HAD BEEN LOOKING FOR $ AT RCHALT. +; 1 AND 2 BITS: SUBTRACT 1, THEN GET OLD 4.8, 4.9 OF SQUOTP. +;10 => NULL ENTRY, IGNORE WHEN POPPING. +;11 THRU 17 => ^]^X CALL, LOW 3 BUTS SAME AS FOR 1 - 7. + +MACPDP: 400,,MACPDL-1 ;MACRO PDL PTR, -> HIGHEST USED BYTE. +MACPDL: BLOCK MACPSZ +MACXP: 0 ;P IN LAST CALL TO MACXCT OR MACXQ. + +SUBTTL SORT AND SEARCH VARIABLES + +;^P SORT VARIABLES: +PSMEM: 0 ;WD ADDR 1ST WD OF ^P SORT TABLE + ;(WHICH LIVES ABOVE THE BUFFER) +PSMEMT: 0 ;WD ADDR 1ST WD OF LAST ENTRY OF TABLE + ;ENTRIES ARE ADDED AT THE END, AND ARE 4 WDS LONG. +PSSAVP: 0 ;P SAVED INSIDE ^P, OR 0. USED TO TELL WHETHER A SORT IS IN PROGRESS. + ;ALSO USED TO DETECT UNWINDING OUT OF A SORT. +PSZF: 0 ;SET TO -1 TO INDICATE LAST RECORD HAS BEEN FOUND. +PSCASE: 0 ;NONZERO => ^P-SEARCH IGNORES CASE. (FS ^PCASE) + +LPSDBK==4 ;SORT TABLE ENTRIES ARE 4 WDS LONG: + ;0TH WD CHAR ADDR START OF KEY, RELATIVE TO BEG. + ;LATER REPLACED BY BP TO ILDB KEY. + ;1ST WD -<# CHARS IN RECORD>,,-<# CHARS IN KEY> + ;2ND WD CHAR ADDR START OF RECORD, RELATIVE TO BEG. + ;3RD WD POINTER (RELATIVE TO PSMEM) TO NEXT ENTRY, + ;OR -1 FOR LAST ENTRY. TABLE IS SORTED + ;BY CHANGING THESE POINTERS. + +;SEARCH VARIABLES: +PNCHFG: 0 ;0 => S OR FB OR REVERSE SEARCH, 1 => _, -1 => N +SEARG: 0 ;# TIMES TO SEARCH. 1 FOR FB; + ;= ABS VAL. OF NUMERIC ARG FOR S, _, N. +SRCBEG: 0 ;CHARACTER NUMBER (REL TO BEG) OF START OF SEARCH RANGE. +SRCEND: 0 ;CHARACTER NUMBER (REL TO BEG) OF END OF SEARCH RANGE. +SRCERR: 0 ;-1 => FAILING SEARCHES SHOULD BE ERRORS EVEN INSIDE ITERATIONS. +BBP: 0 ;BP. TO 1ST CHAR IN RANGE TO BE SEARCHED. +ZBP: 0 ;BP TO CHAR AFTER LAST CHAR IN RANGE TO BE SEARCHED. +BBP1: 0 ;NOT USED IN FORWARD SEARCH. + ;FOR BACKWARD SEARCH, IT IS THE SAME AS BBP + ;UNLESS THE GAP IS BETWEEN BBP AND WHERE WE ARE SEARCHING, + ;IN WHICH CASE BBP1 POINTS TO THE FIRST CHARACTER AFTER THE GAP. +ZBP1: 0 ;IF GAP IS WITHIN RANGE OF SEARCH, + ;BP TO 1ST CHAR POS WITHIN THE GAP; OTHERWISE, SAME AS ZBP. + ;WHEN FWD SEARCH CROSSES THE GAP, ZBP1 SET FROM ZBP +SLP4N: 0 ;WHEN E MOVES TEMPORARILY FORWARD OVER THE GAP, WHILE TESTING ONE ALTERNATIVE, +SLP4N1: 0 ;SLP4 AND SLP4-1 ARE SAVED IN THESE TWO WORDS. + ;WHEN E IS RESET FROM C, THEY ARE RESTORED FROM THESE WORDS. +SLP1P: JRA B,. ;SLP1D\SLP1I INSTRUCTION EXECUTED WHEN TIME TO READ ANOTHER CHARACTER +TEM1: 0 ;0, OR BP TO START OF LAST INSTANCE FOUND. +TEM2: 0 ;0, OR BP TO END OF LAST INSTANCE FOUND. + +SFINDF: 0 ;VALUE OF THE LAST SEARCH (WHETHER :-SEARCH OR NOT) + +SBFRS: SETZ INISRS-INIQRB ;STRING-POINTER THAT PRESERVES SEARCH-BUFFER. +SBFRP: MFSBUF ;-> SEARCH BUFFER HEADER. +STBLP: INISRB/5 ;ADDRESS OF SEARCH BUFFER BODY. +STBLPX: INISRB/5,,SLP1P ;ALWAYS THE SAME FUNCTION OF STBLP. + +SFXOR: 0 ;ASCII /QQQQQ/, IF 1ST CHAR OF SEARCH STRING IS Q, INSIDE SFAST. +SFASAD: SFAFN0,SFAFC0 ;ADDRESS TO ENTER APPROPRIATE MAIN LOOP OF SFAST. + ;DEPENDS ON WHETHER CASE BEING IGNORED FOR 1ST CHAR OF STRING. + +SUBTTL MORE VARIABLES + +GCPTR: 0 +GCNRLC: 0 ;-1 => GC SHOULDN'T RELOCATE STRINGS, JUST FLUSH UNNEEDED BUFFERS. +QRGCMX: INIQRB+GCOFTN ;GC IMPURE STRINGS WHEN QRWRT GETS THIS LARGE. +STOPF: 0 ;FS QUIT$. NEGATIVE == QUIT DESIRED (FS QUIT) + ;^G AT INT LVL SETS STOPF; SETTING STOPF CAUSES + ;QUITTING ACTION UNDER CONTROL OF NOQUIT. +NOQUIT: 0 ;(FS NOQUIT) 0 => ^G QUITS TO TECO'S TOP LEVEL. + ;POSITIVE => ^G JUST SETS STOPF FOR PROGRAM TO TEST. + ;NEGATIVE => ^G CAUSES "QIT" ERROR (ERRSETABLE). +CLKFLG: 0 ;-1 => IT IS TIME TO RUN THE REAL-TIME CLOCK ROUTINE. +CLKINT: 0 ;SETTING OF FS CLK INT$. +CLKMAC: 0 ;POINTER TO REAL-TIME CLOCK ROUTINE. +RUNFLG: 0 ;-1 ==> TECO HAS BEEN RUN. Q..Q, ETC. HAVE BEEN INITTED. +VARMAC: 0 ;NONZERO => ENABLE FEATURE OF CALLING MACRO WHEN A NAMED VARIABLE IS SET. +LASTER: 0 ;MOST RECENT ERROR MESSAGE (A STRING POINTER). +ERRFLG: 0 ;-1 WHILE PROCESSING AN ERROR. +ERRFL1: 0 ;FS ERRFLG$ - NEGATIVE (-) =. PROTECT 1ST LINES OF SCREEN + ;FROM REDISPLAY (ASSUMING THEY CONTAIN ERROR MESSAGE). SET BY FG. +VERBOS: 0 ;IF NON-ZERO, DISPLAY WHOLE ERROR MESSAGE STRING IMMEDITAELY +ERR1: 0 +ERR2: 0 +ERRECH: 0 ;-1 => TYPE ERR MSGS IN ECHO AREA. + +PTLFCD: 0 ;PTLAB FILE CREATION DATE + +STABP: ;THIS IS THE CACHE FOR JUMPS ("O" COMMAND) +SYMS: BLOCK 20 ;THESE HOLD THE CPTRS AT SOME JUMPS; +VALS: BLOCK 20 ;THESE, THE CPTRS OF TAGS JUMPED TO; +CNTS: BLOCK 20 ;THESE, THE COMCNTS AT THOSE TAGS. +SYMEND: ;ENTRIES ARE IN PAIRS. EACH JUMP CPTR SELECTS A PAIR + ;THE ENTRIES IN A PAIR ARE USED FIFO BY NEW JUMPS. + +PF: -LPF-1,,PFL-1 ;Q REGISTER PDL POINTER +PFL: BLOCK LPF +;QREG PDL ENTRIES ARE 2 WORDS EACH. +;THE FIRST WORD CONTAINS THE DATA PUSHED. +;THE SECOND CONTAINS INFO ON WHERE PUSHED FROM: +; EITHER THE CORE LOCATION PUSHED FROM, +; THE QREG NAME (FOR Q$FOO$ Q-REGS), +; OR THE INDEX IN FLAGD OF THE FS FALG THAT WAS PUSHED. +; THESE ARE DISTINGUISHED BY WHETHER THE NUMBER IS < FLAGSL. + +PDL: BLOCK LPDL +BAKTAB: ;"\" COMMAND WITH ARG "PRINTS" INTO THESE WORDS. +LTABS==100. +STAB: ;WITHIN "O" COMMAND SEARCH, HOLDS THE TAG NAME. +LBF: ;OUTPUT BUFFER FOR "@" AND "^O" COMMANDS. +GCTAB: BLOCK GCTBL +IFG LTABS-GCTBL,BLOCK LTABS-GCTBL + ;USES OF GCTAB: + ;JCL READ INTO IT. USED AS BUFFER BY E_. USED BY ALINK + ;TO HOLD SOME TEMPS. + +QRB: QTAB ;POINTER TO BLOCK OF QREGS WITH NO "."'S IN NAME. +QRB.: QTAB+36. ;POINTER TO BLOCK OF ONE-"." QREGS. +QRB..: QTAB+36.*2 ;POINTER TO BLOCK OF ".." QREGS. +QTAB: BLOCK NQREG + +CTLCF: 0 ;SET BY ^C, SAYS EXIT AFTER COMMAND DONE. + +UTIBUF: BLOCK UTBSZ ;BUFFER FOR READING FROM CHFILI +UTIBE: 0 ;WORD TO HOLD A ^C STUCK ON TO DETECT EOB +UTRLDT: 350700,, ;B.P. TO THE ^C TERMINATING FILLED PART OF UTIBUF +UTYIP: 010700,,0 ;B.P. FOR UNLOADING UTIBUF + +UTOBUF: BLOCK UTBSZ ;BUFFER FOR WRITING TO CHFILO +UTOBE: +UTYOP: 010700,,0 ;B.P. FOR STUFFING UTOBUF +UTYOCT: 0 + +IMQUIT: 0 ;-1 SAYS ^G SHOULD QUIT IMMEDIATELY. + ;SET EG. DURING SEARCHES, WHICH DON'T NEED TO CLEAN UP. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + ;SET TO 1 ONLY AT TECO STARTUP AND WITHIN LIS. + +GOXFLS: 0 ;ZEROED BY GO. -1 => GO SHOULD POP ALL THE WAY TO THE TOP LEVEL. + ;1 => GOX1 SHOULD JUST OMIT PUSHING STUFF. + +TSINAL: 0 ;-1 => LAST INT. CHAR. WAS ALTMODE. (FOR FINDING $$ AT INT LVL) +TSALTC: 0 ;# OF $$'S ITYIC'D BUT NOT IOT'D. + +PAGENU: 0 ;PAGE # IN INPUT FILE. +LASTPA: -1 ;0 IF HAVE YANKED LAST PAGE OF INPUT FILE. + +IFN ITS,MSNAME: 0 ;WORKING DIRECTORY. +HSNAME: 0 ;HOME DIRECTORY (SIXBIT IN ITS, DIR # IN TWENEX). +OUTFLG: 0 ;-1 => OUTPUT TO EW'D FILE DISABLED. +FILEPA: EOFCHR ;CHAR TO PAD LAST WORD OF OUTPUT FILES WITH. +RDMNMS: 3.14 ;USED BY RANDOM # GENERATOR. VALUE OF FS RANDOM +DOWNF: 0 ;-1 => DOING AN FLD +SEXPFL: 0 ;-1 => FL IS LOOKING FOR S-EXP, NOT LIST. + ;S-EXP MEANS EITHER WORD OR LIST, WHICHEVER STARTS FIRST. +FFRRCT: 0 ;IN FILENAME READER = <# OF FILENAMES> -1 +FNAMSY: 0 ;0 => IF ONLY 1 FILENAME IN STRING, IT IS FN2. + ;NOT 0 => IT IS FN1 (LIKE ALL OTHER PROGRAMS). (FS FNAMSYNTAX) +ADLINE: 60. ;SIXTY CHARACTERS PER LINE OF ADJUSTED TEXT (FA) +NOOPAL: -1 ;IGNORE ALTMODES IF NEGATIVE. + ;STRAY ALTMODES ARE ERRORS IF THIS IS 0. THEY ARE LIKE ^_ IF >0. +NLAROW: 0 ;0 => "_" LEGAL. 1 => ILLEGAL. -1 => "_" TREATED AS "-". +YDISAB: 0 ;0 => Y IS LEGAL. 1 => ILLEGAL. -1 => Y TREATED AS ^ Y. +TABMOD: 0 ;0 => TAB INSERTS, 1 => TAB ILLEGAL, -1 => TAB IGNORED. +FFMODE: 0 ;NON0 => ^L'S READ FROM FILE GO IN BFR. + ;0 => ^L AT END OF PAGE Y'D OR FILE ^Y'D + ;IS THROWN AWAY, AND PW GENERATES A ^L. +UNWINF: 0 ;0 => UNWIND QREG PDL AFTER EACH COMMAND STRING. +BOTHCA: 0 ;NONZERO => SEARCH DOESN'T DISTINGUISH UPPER AND LOWER CASE. +SKNBPT: 0 ;B.P. TO LDB 1ST CHAR OF THE STRING IN .QDLIM. + ;HAS A IN INDEX FIELD. +KILMOD: -1 ;0 => FS BKILL SHOULDN'T REALLY KILL. +SLPNCR: 0 ;-1 => SLPN00 SHOULDN'T CLEAR LOW BITS. +YANKMT: 0 ;0 EXCEPT INSIDE YANK, HAS WHAT MEMT HAD AT START OF YANK. + ;USED TO ELIMINATE EXCESS LOW-BIT CLEARING. +TRCOUT: 0 ;NONZERO WHILE OUTPUTTING TRACE OUTPUT. + ;USED TO PREVENT TRACE OUTPUT FROM CLOBBERING TOP LINE OF SCREEN. +PUREFL: 0 ;-1 => TECO HAS BEEN PURIFIED. +INITF1: 0 ;SET TO -1 BY STARTUP CODE SO THAT ..L WILL BE MACROED + ;NEXT TIME THROUGH THE LOOP AT GO. +INITFL: 0 ;TECO WAS STARTED AT INIT+2, SAYING IT IS UNDER A LISP. +STEPFL: 0 ;-1 => TECO MACRO LINE-STEPPING FEATURE ENABLED: + ;CR AS A COMMAND DOES ^VW AND THEN QUITS IF CHAR IS ^G, + ;ENTERS ^R IF CHAR IS ^R, SETS STEPFL TO 0 IF CHAR IS ^P. + ;ELSE, CAN BE A MACRO TO CALL TO DO THE STEPPING. +STEPDE: -1 ;MAXIMUM MACRO PDL DEPTH (FS BACKDEPTH) AT WHICH TO ALLOW STEPPING, OR -1. +SETPP: 0 ;OLD CONTENTS OF P BEFORE MOST RECENT CALL TO SETPP. DEBUGGING ONLY. +SUPHND: 0 ;FS SUPERIOR$ - MACRO TO HANDLE REQUESTS FROM SUPERIOR. + +SUBTTL BOOTSTRAP FOR EJ FILES + +IF2 PURP1==INIT/2000 ;# OF 1ST PURE CODE PAGE +IF2 PURPL==/2000 ;# OF 1ST PAGE ABOVE PURE CODE. + +BOOT: JRST BOOT1 ;THIS IS THE START ADDRESS WRITTEN INTO EJ FILES. +IFN ITS,.VALUE +.ELSE JRST BOOT1 ;REENTER SAME AS START + SETOM INITFL ;START AT START + 2 => SET FS LISPT. +IFN TNX,MOVEM 1,CCLJFN ;TWENEX - SAVE THE JFN WE WERE GIVEN FOR FS CCL FNA$ +BOOT1: SKIPE LIMPUR ;WERE WE JUST LOADED, OR WERE WE RESTARTED? + JRST INIT ;RESTARTED => PURE CODE ALREADY PRESENT, SO DO NORMAL RESTART. +IFN ITS,[ + SYSCAL OPEN,[[.UII,,CHFILI] ? ['DSK,,] ? ['TECPUR] ? [.FNAM2] ? ['.TECO.]] + .LOSE %LSFIL ;TECO PURE FILE NOT FOUND. + .IOT CHFILI,A + SKIPE A + .LOSE ;NOT A PDUMP FILE?? + .ACCESS CHFILI,[INIT+2000] ;GOBBLE TECO'S PURE PAGES OUT OF THE PDUMP FILE. + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBNDR ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHFILI] + .LOSE %LSFIL + .CLOSE CHFILI, +] +IFN TNX,[ + MOVE P,BOOTP + MOVSI 1,(GJ%OLD\GJ%SHT) +RADIX 10. +IFN 20X,[ IFN EMCSDV, HRROI 2,[STRCNC [EMACS:TECPUR.EXE.]\.FNAM3 ] + .ELSE HRROI 2,[STRCNC [PS:TECPUR.EXE.]\.FNAM3 ] +] +IFN 10X, HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +RADIX 8 + GTJFN + .VALUE +IFN 20X,[IOR 1,[.FHSLF,,GT%ADR] + MOVE 2,[PURP1*2,,PURPL*2] +] +IFN 10X,HRLI 1,.FHSLF + GET +] + SETOM PJATY ;SCREEN NEEDS COMPLETE REDISPLAY SINCE WE HAVEN'T INITTED IT. + MOVEI TT,LHIMAX ;WE HAVE NO LIBRARIES LOADED IN YET. + MOVEM TT,LHIPAG + JRST INIT + +CONSTA ;WITHOUT THIS, OUR LITERALS WOULD BE IN THE PURE CODE. + +RRVARX:: IF2 IFNDEF RRVARB, RRVARB:: BLOCK RRVARL + +IF2 VPAT: VPATCH: + +INFORM [END OF LOW IMPURE]\.-1 +LOC .\1777 ;MOVE TO LAST WORD OF PAGE +LIMPUR:: -1 ;0 => THIS IS AN EJ FILE JUST LOADED; IT MUST GET TECO'S PURE PAGES. + +SUBTTL ^R MODE VARIABLES + +;^R REAL TIME EDIT MODE VARIABLES. ON PASS 2 WE PUT THEM IN LOW IMPURE IF THEY FIT, +;OTHERWISE IN HIGH IMPURE. + +RRVARL==53. ;NUMBER OF WORDS OF ^R VARIABLES. + +IF2 [ ;BY THE TIME WE GET HERE ON PASS 2, RRVARB WILL + ;HAVE THE DESIRED LOCATION OF THE ^R VARIABLES BLOCK. +RRTMPV==. ? LOC RRVARB + +RRHPOS: 0 ;CURRENT CURSOR HPOS & VPOS: REFLECT +RRVPOS: 0 ;CURRENT VALUE OF PT, EVEN IF SCREEN HASN'T CAUGHT UP. +RROHPO: -1 ;WHAT RRHPOS HELD LAST TIME CURSOR ACTUALLY WAS MOVED. +RROVPO: -1 ;IF THESE DIFFER FROM CURRENT POS, MUST MOVE CURSOR. +RRCMMT: -1 ;0 IF IN COMMENT MODE. +RRCCOL: 0 ;COLUMN IN WHICH THE COMMENTS SHOULD START. +RRMNVP: 0 ;THE VPOS OF UPPERMOST LINE THAT NEEDS REDISPLAY, + ;OR 377777,,-1 MEANING NO LINES NEED REDISPLAY, + ;OR -1 MEANING DON'T TRUST LINBEG AT ALL; DO FULL REDISPLAY. + ;IF RRMNVP IS POSITIVE AND FINITE, ALL LINBEGS FROM TOPLIN + ;DOWN THRU THE RRMNVP'TH LINE (INCLUSIVE) MUST BE ACCURATE OR YOU WILL LOSE! +RRMNHP: 0 ;LEFTMOST COLUMN ON THAT LINE THAT NEEDS REDISPLAY. +RRMAXP: 0 ;NON0 => LARGEST VALUE OF PT AT WHICH BUFFER WAS CHANGED. +RRMSNG: 0 ;NON0 => SOME TEXT AFTER RRMAXP IS MISSING FROM THE SCREEN. +RRRPCT: 0 ;NUMERIC ARG SPEC'D WITH ^V OR CTL-DIGITS. +RRARGP: 0 ;NONZERO => RRRPCT HAS BEEN SET (ELSE IT DEFAULTS TO 1). +RR4TCT: 0 ;# OF OCCURRENCES OF ^U. THE NUMERIC ARG TO A COMMAND IS RRRPCT*(4 ^ RR4TCT) +RUBCRL: 0 ;-1 => ^D AND RUBOUT DELETE A WHOLE CRLF AT ONE BLOW. +RRLAST: 0 ;MOST RECENT ^R-MODE CHAR THAT WASN'T AN ARGUMENT-SETTING COMMAND +RRPRVC: 0 ;WHAT WAS IN RRLAST BEFORE ITS CURRENT CONTENTS. +RRRPLC: 0 ;-1 => NORMAL CHARS REPLACE (X = DIX$) + ;1 => THAT, AND META-CHARS INSERT (LIKE ETV) +RRMCCT: 0 ;FS CRMDLY -- # CHARS TO HANDLE BETWEEN + ;INVOCATIONS OF SECRETARY MACRO. +RRMCC1: 0 ;THIS IS USED TO COUNT THAT MANY CHARS. +RRNCCR: 0 ;SET TO -1 DURING REDISPLAY IF THE PTR + ;COMES AFTER A CR. THAT MEANS RRHPOS IS WRONG + ;AND SHOULD BE COMPUTED BY CALLING RRBTCR. +RRCCHP: 0 ;TEMP. IN CHCT; SAVES HPOS AT START OF EACH CHAR. +RRERFL: 0 ;TEMP. THAT SAVES ERRFL1 OVER CALL TO VBD. +RROLDZ: 0 ;VALUE OF Z, AT TIME OF LAST REDISPLAY THAT WASN'T INTERRUPTED BY TYPEIN. +RROLZV: 0 ;VALUE OF ZV, AT THAT TIME. +RRIDVP: 0 .SEE RRLID ;VPOS AT WHICH WE SHOULD INSERT/DELETE LINES. +RRIDLB: 0 ;OLD LINBEG OF THAT LINE. +RRIDBK: 0 ;# OF NEWLY MADE BLANK LINES BEFORE THAT LINE. +RRCIDP: 0 ; POS => THIS INSERT OR DELETE IS RIGHT BEFORE A TAB. + ; NEG => THIS INSERT OR DELETE IS USING I/D CHAR (SPECIAL CASE, NOT RRLCHG). +RRUNQT: 0 ;-1 => TEMPORARILY REENABLE BUILTIN COMMANDS. +RRALQT: -1 ;NONNEG => DISABLE BUILTIN COMMANDS, BUT + ;THIS WD'S CONTENTS ARE CHAR THAT REENABLES THEM TEMPORARILY. +RRCMQT: 0 ;-1 => ALL CONTROL-META-LETTERS,ETC. ARE SELF-INSERTING (FOR EDITING MACROS). +RREZ: INIBEG ;WHEN ^R MODE IS EXITED, Z, BEG AND PT +RREBEG: INIBEG ;ARE SAVED IN THESE 3 VARS. IF ^R IS REENTERED +RREPT: INIBEG ;WITH ARGS, THEY ARE COMPARED WITH THESE VALUES. + ;RREBEG IS 0 WHILE ^R IS ACTUALLY IN CONTROL. + ;NOT 0 DURING NORMAL COMMAND EXECUTION, INCLUDING MACROS CALLED FROM ^R. + ;0 PREVENTS ^G FROM QUITTING AT INT LVL. +RREVPS: 0 ;REMEMBER RRVPOS AND RRHPOS AT EXIT, IN CASE WE REENTER +RREHPS: 0 ;WITH ONE ARGUMENT. +RREBUF: 0 ;REMEMBER BUFFER THAT ^R WAS PREVIOUSLY DISPLAYING (AS STRING PTR). +RRMKPT: -1 ;THE MARK USED BY ^T, ^X, ^W. +RRSCAN: 0 ;NONZERO => VARIOUS COMMANDS PRINT WHAT THEY STEP OVER/INSERT/DELETE. +RRTTMX: 50. ;FS ^RMAX$. MAX # CHARS OF INSERT TO BE WILLING TO SCAN ON PRINTING TTY. +RRECHO: 0 ;-1 => ECHO THE ^R COMMANDS EXECUTED. 0 => ECHO ONLY ON PRINTING TTY +RRMORF: 0 ;POSITIVE => USE --MORE-- INSTEAD OF --TOP--, ETC., EVEN THOUGH IN ^R. + ;NEGATIVE => DON'T USE EITHER --MORE-- OR --TOP--, ETC. WHEN IN ^R. +RRXINV: 0 ;THIS IS THE REAL DEFINITION OF "SELF-INSERTING CHARS", 0 => SELF-INSERT +RRPARN: 0 ;THIS GETS RUN BY ANY "SELF-INSERTING CHAR" WHOSE LISP SYNTAX IN ..D IS ")". +RRENTM: 0 ;FS ^R ENTER$, NONZERO => MACRO IT WHEN ENTER ^R. +RRLEVM: 0 ;FS ^R LEAVE$, NONZERO => MACRO IT WHEN LEAVE ^R. +RRDISM: 0 ;FS ^R DISPLAY$, NONZERO => MACRO WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. +RUBMAC: 0 ;FS RUB MACRO$, NONZERO => MACRO TO DO DELETE WITH NUMERIC ARG. + +;DEBUGGING VARIABLES: +RRDHPS: 0 ;REMEMBERS RRHPOS BEFORE LAST REDISPLAY. +RRDVPS: 0 ;SAME FOR RRVPOS +RRDMHP: 0 ;SAME FOR RRMNHP +RRDMVP: 0 ;SAME FOR RRMNVP +RRDPT: 0 ;REMEMBER 1ST CHAR DISPLAYED IN LAST REDISPLAY. +IFN .-RRVARB-RRVARL, .ERR RRVARL ISN'T SET RIGHT. + +LOC RRTMPV + +] ;END IF2 + +SUBTTL INITIALIZATION + +INIT: SKIPE RUNFLG ;RESTARTING => DON'T CLOBBER BUFFER, Q-REGS. + JRST GOZ + SETZ FF, + MOVE P,[-LPDL,,PDL-1] +GOZ: SETZM SQUOTP ;NONZERO SQUOTP CAN INTERFERE WITH INSASC. + SETOM PJATY ;SCREEN CONTENTS HAVE BEEN RANDOMLY CLOBBERED. + MOVE CH,LIMPUR ;CH GETS 0 IF THIS IS EITHER TECO JUST LOADED + ; OR AN EJ FILE JUST LOADED + AND CH,RUNFLG +IFN ITS,[ + MOVE E,[-8,,[.SMASK,,[TSMSK] ? .SMSK2,,[TSMSK1] ;SET MASKS, + .SPICL,,[-1] ? .SWHO1,,[0] + .RSNAME,,Q ? .RHSNAME,,HSNAME + .RIOS+CHFILI,,A ? .RIOS+CHFILO,,C]] + .SUSET E + JUMPN CH,GOZ4B ;IF TS TECO OR SOME EJ FILE HAS JUST BEEN LOADED, + MOVEM Q,MSNAME ;THEN OUR .SNAME IS THE MSNAME. + MOVEM Q,DEFDIR ;AND ALSO SHOULD BE OUR DEFAULT SNAME. +GOZ4B: SKIPN A ;ALSO SEE IF DISK CHNLS REALLY STILL OPEN, IN CASE THIS IS A RESTART. + CALL UICLS ;IF THEY AREN'T, TECO SHOULDN'T THINK THEY ARE. + SKIPN C + TLZ FF,FLOUT + SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,MACHIN ]] + .LOSE %LSSYS + .I DEFDEV=MACHIN +];IFN ITS +IFN TNX,[ + CIS ;FORGET ANY INTERRUPTS IN PROGRESS + MOVEI A,.FHSLF + MOVE B,[LEVTAB,,CHNTAB] + SIR + EIR +IFN 20X,MOVE 2,[740400,,020000] ; CHANNELS 0-3, 9 AND 22 +IFN 10X,MOVE 2,[700410,,020000] ; CHANNELS 0-2, 9, 14 AND 22 + AIC + RPCAP + TRZ 2,-1 ;ONLY ENABLE LH CAPS + IOR 3,2 + EPCAP + JUMPGE 3,GOZ4A ; NO ^C CAPABILITY? + MOVE A,[.TICCC,,2] + ATI ; ^C ON CHANNEL 2 +GOZ4A: +IFN TNX,[MOVEI A,.PRIOU + RFCOC + MOVEM B,ITTYMD+1 + MOVEM C,ITTYMD+2 + RFMOD + MOVEM B,ITTYMD ;SAVE TTY MODES + MOVEM B,FTTYMD +IFN 20X,[ + LDB A,[.BP TT%PGM,B] + MOVEM A,PAGMOD ; SAVE INITIAL TERMINAL PAGE MODE SETTING +];20X +];TNX + JUMPN CH,GOZ4B + GJINF +IFN 20X,[ + TLNE 1,-1 + TLO 1,040000 ; MAKE SURE THIS LOOKS LIKE A DIRECTORY + MOVEM 1,HSNAME ; HSNAME IS DIRECTORY CORRESPONDING TO USER + MOVSI 1,(GJ%OFG\GJ%SHT) ; PARSE ONLY + HRROI 2,DEFFN1 + GTJFN + JRST GOZ4B + CALL FFSET3 ; SET DEFAULTS FROM IT + RLJFN + JFCL +] +IFN 10X,[ + MOVEM A,HSNAME ; HSNAME IS JUST USER + HRROI A,DEFDIR ; CANNOT JUST DO GTJFN, CAUSE LOSING TENEX FILESYSTEM WILL FAIL + DIRST ; ON SECOND ATTEMPT + JFCL +] +GOZ4B: SKIPN 1,CHFILI + JRST GOZ4 + GTSTS + TLNN 1,(GS%OPN) ; FILE STILL OPEN? + CALL UICLS ; NO +GOZ4: SKIPN 1,CHFILO + JRST GOZ5 + GTSTS + TLNN 1,(GS%OPN) + TLZ FF,FLOUT +];IFN TNX + +GOZ5: SETOM LIMPUR ;MAKE SURE A SECOND $G WON'T MAKE BOOT REBOOT. + CALL INITTY ;INITIALIZE TTY AND FLAGS ABOUT WHAT KIND AND HOW TO TREAT IT. + MOVEI A,[ASCIZ *-!-*] ;USE -!- FOR CURSOR ON PRINTING TTYS. + SKIPE C,RGETTY + MOVEI A,[ASCIZ */\*] ;USE /\ ON DISPLAYS. +IFN ITS,[ + CAIN C,%TNIML + MOVEI A,[ASCIZ //] ;BUT USE "I-BEAM" ON IMLACS. +] +IFN TNX,[ + CAIN C,DM25I + MOVEI A,[ASCIZ /_/] ;WHAT PEOPLE ARE USED TO ON DATAMEDIAS +] + HRLI A,BP7 + MOVE CH,QRB.. + ADDI CH,.QCRSR + CALL INSASC ;INSERT ASCII STRING IN Q-REG ..A. + SETOM INITF1 ;CAUSE ..L TO BE RUN. +GOZ3: SETZM CPTR ;CPTR MIGHT POINT INTO PURE STRING SPACE WHICH IS NOW NXM. + SKIPE C,CLKINT ;IF WE HAD CLOCK INTERRUPTS, TURN THEM BACK ON. + CALL FSCLKI + JFCL +IFN ITS,[ + SKIPE RRECBP + CALL RRECI5 +] + SKIPE RUNFLG + JRST CTLW + +;STUFF TO DO WHEN STARTED UP THE 1ST TIME ONLY. + MOVE CH,QRB.. + MOVEI A,10. + MOVEM A,.QBASE(CH) ;INIT. OUTPUT RADIX. + MOVE A,[SETZ 1+INIDLM*5-INIQRB] + MOVEM A,.QDLIM(CH) + HRRI A,INI..O-INIQRB + MOVEM A,.QBUFR(CH) + MOVEM A,.Q..Z(CH) + MOVE IN,BEG ;MAKE SURE THE BOTTOM PAGE OF BUFFER EXISTS + CALL GETCHR ;TO PREVENT CONFUSING THE CODE AT FLSCOR + SETOM RUNFLG ;SAY TECO HAS BEEN RUN. + MOVEI A,[ASCIZ/ 5FSQVECTOU..Q 2U:..Q(0)/] + CALL MACXCW ;PUT AN EMPTY SYMBOL TABLE IN ..Q. + MOVEI A,TYOA + HRRM A,LISTF5 ;CAUSE OUTPUT ROUTINES TO TYPE ON TTY. + MOVEI A,[ASCIZ/IMPURE /] + SKIPN PUREFL + CALL ASCIND + MOVE A,[.FNAM1] + MOVEI C,". + CALL SIXINT + MOVEI C,.FVERS + CALL DPT +IFN ITS,[ + .SUSET [.RXUNAME,,C] + .CALL GOZO1 ; OPEN ; TECO + CAIA + JRST GOZ7 + MOVSI C,(SIXBIT/*/) + .CALL GOZO1 ; OPEN ;* TECO + CAIA + JRST GOZ7 + .CALL GOZO2 ; LAST RESORT IS .TECO.;* TECO + CAIA +GOZ7: SETOM CMFLFL ;BUT IF INIT FILE EXISTS, USE IT, +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. + +GOZO1: SETZ ? SIXBIT/OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? C ? [SIXBIT /TECO/] ? SETZ HSNAME + +GOZO2: SETZ ? SIXBIT /OPEN/ ? [.BAI,,CHFILI] + [SIXBIT/DSK/] ? [SIXBIT/*/] ? [SIXBIT/TECO/] ? SETZ [SIXBIT/.TECO./] +] +IFN TNX,[ + MOVSI 1,(GJ%OLD\GJ%SHT) + HRROI 2,[ASCIZ /TECO.INIT/] + GTJFN + JRST GOZ6 + MOVE 2,[36._30.+OF%RD] + OPENF + JRST GOZ6 + MOVEM 1,CHFILI + SETOM CMFLFL +GOZ6: JRST CTLW ;DROP INTO MAIN LOOP AS IF AFTER ^G. +] + +;OPEN THE TTY CHANNELS AND SET VARIOUS VARS ACCORDING TO TYPE OF TTY. +;ON T(W)ENEX A NUMERIC ARGUMENT SPECIFIES THE TERMINAL TYPE CODE, OVERRIDING WHAT THE SYSTEM SAS. +FSTTYI: +IFN ITS,[ +INITTY: TSOPEN CHTTYI,[[%TIFUL+40,,'TTY]] ;INITIALIZE TTY. + TSOPEN CHDPYO,[[%TJCTN+%TJDIS+.BAO,,'TTY]] ;BLOCK OUTPUT FOR DISIOT. + TSOPEN CHECHO,[[%TJECH+%TJPP2+.UAO,,'TTY]] ;ECHO MODE OUTPUT. + TSOPEN CHECDS,[[%TJECH+%TJPP2+%TJCTN+%TJDIS+.UAO,,'TTY]] ;FOR FS ECHO DISPLAY$. + TSOPEN CHSIO,[[%TJSIO+%TJCTN+.UAO,,'TTY]] ;SUPER-IMAGE OUTPUT. + TSOPEN CHTTYO,[[%TJCTN+.UAO,,'TTY]] ;NORMAL TYPE OUT. + PUSHJ P,SETTTM ;SET UP RGETTY, STTYS. + MOVEM CH,RGETTY + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['OSPEED] ? %CLOUT,,OSPEED] + SETZM OSPEED + MOVE A,OSPEED + CAIGE A,10 ;AVOID LOSING ON OLD ITS ON WHICH OSPEED IS A SPEED CODE. + SETZM OSPEED + SYSCAL TTYVAR,[%CLIMM,,CHTTYO ? ['SMARTS] ? %CLOUT,,TTYSMT] + SETZM TTYSMT + .CALL RSSB ;SET NVLNS, NHLNS, TTYOPT. + .VALUE + MOVE A,NHLNS +] +IFN TNX,[ + MOVE CH,C + TRNN FF,FRARG + JRST INITT1 + CAIGE CH,MAXTTY + SKIPGE CH + TYPRE [AOR] +INITT1: TRZN FF,FRARG ;READ TTY TYPE FROM SYSTEM UNLESS ARGUMENT IS SPECIFIED. +INITTY: CALL RTTYTP ;IF CALLED INTERNALLY, DON'T LOOK AT ARGUMENT + MOVEM CH,RGETTY + CALL SETTTM +IFN 20X,[MOVEI A,.CTTRM + RFMOD + LDB C,[.BP TT%LEN,B] ;TERMINAL LENGTH + MOVEM C,NVLNS + LDB C,[.BP TT%WID,B] ;TERMINAL WIDTH + MOVEM C,NHLNS + MOVEI B,.MORSP ;READ TTY'S SPEED + MTOPR + MOVEI C,(C) ;GET OUTPUT SPEED + CAILE C,9600. ;DONT GET CONFUSED BY NVT'S OR PTY'S + SETZ C, +] +IFN 10X,MOVEI C,2400. ;DEFAULT LINE SPEED FOR 10X + MOVEM C,OSPEED ;SAVE IT + MOVE C,TTYTBS(CH) ;GET DISPATCH VECTOR FOR TERMINAL +IFN 20X,SKIPG A,NVLNS ;USE CURRENT SETTING IF REASONABLE + HLRZ A,0(C) ;ENTRY 0 IS PAGE SIZE + ANDI A,777 + MOVEM A,NVLNS ;NUMBER OF VERTICAL LINES + MOVE A,1(C) ;ENTRY 1 IS TTY OPTION BITS + MOVEM A,TTYOPT +IFN 20X,SOSG A,NHLNS ;CURRENT WIDTH, LESS ONE FOR ! + HRRZ A,0(C) ;NUMBER OF HORIZONTAL LINES +] + CAILE A,MXNHLS ;MUST BE IN RANGE + MOVEI A,MXNHLS + MOVEM A,NHLNS + SETCM A,TTYOPT ;GET OPTION BITS FOR THIS TERMINAL + TLNE A,%TOOVR ;TTY CAN'T OVERPRINT => + SETZM DISPCR ;DON'T LET STRAY CR'S TRY TO DO SO. + TLNE A,%TOOVR+%TOMVB ;DON'T LET BS OVERPRINT IF TTY CAN'T BS. + SETZM DISPBS + SETZM DISSAI + TLNN A,%TOSA1 ;:TCTYP SAIL => WE SHOULD USE SAIL CHAR SET. + SETOM DISSAI + SETCA A, ;CAN'T ERASE SELECTIVELY => CAN'T USE DISPLAY FEATURES. + TLC A,%TOERS+%TOMVU + TLCE A,%TOERS+%TOMVU + JRST [ MOVSI C,377777 ;WE SHOULD NEVER DO --MORE--, + MOVEM C,NVLNS + SETZM TOPLIN ;WE CAN'T START DISPLAY IN MIDDLE OF SCREEN. +IFN ITS,[ MOVSI C,%TSMOR ;SYSTEM SHOULD DO **MORE** PROCESSING. + ANDCAM C,TTYSTS + ] + SETZB C,RGETTY ;ALSO PRETEND TO BE PRINTING TTY. + CALL FSECL1 ;AND NO ECHO LINES. + SETZM VERBOS + TLNN A,%TOOVR + SETOM BSNOLF ;ON GLASS TTY, PULL VARIOUS OVERPRINT-ERASE HACKS. + SKIPE A,TTYMAC ;RUN FS TTY MAC$ TO RESET PARAMETERS. + JRST MACXQ + RET] + SETOM VERBOS ;WANT LONG ERROR MESSAGES ON DISPLAYS. + SETZM CHCTVP + SETZM CHCTCF + SETOM DWAIT + MOVE C,OSPEED ;SET DWAIT IF TTY'S SPEED IS KNOWN TO BE 600 BAUD OR LESS. + CAIG C,600. + SKIPN C + SETZM DWAIT + LDB C,[.BP (%TOLID),A] + MOVEM C,LID ;IF TTY CAN INSERT/DELETE LINES, DEFAULT IS TO USE THEM. + LDB C,[.BP (%TOCID),A] + MOVEM C,CID ;LIKEWISE CHAR I/D +IFN TNX,[ + CAIE CH,C100I + CAIN CH,VT100I ;UNTIL THE RIGHT %TO BIT DEFINED + MOVNS LID ;HACK SCROLL REGION FOR MOVING TEXT RIGHT + LDB C,[.BP (%TOFCI),A] ;CAN IT GENERATE BONA FIDE HIGH ORDER BITS? + MOVEM C,FCITYI ;YES, DONT MISTAKE THEM FOR PARITY THEN +] + MOVE C,NVLNS + CAIL C,MXNVLS + MOVEI C,MXNVLS + MOVEM C,NVLNS + CAMG C,TOPLIN + SETZM TOPLIN + IDIVI C,6 ;COMPUTE # ECHO LINES. + CAIGE C,3 + MOVEI C,3 + CALL FSECL1 ;AND SET THAT MANY. + CALL ECHOCR ;FRESH LINE IN ECHO AREA. + SKIPE A,TTYMAC ;RUN FS TTY MAC$ TO RESET PARAMETERS. + JRST MACXQ + RET + +SUBTTL ECHOING CONTROL + +IFN ITS,[ +;REINITIALIZE TTYSTS, TTYST1, TTYST2; +;TURN ON ECHOING, AND SET ECHOFL TO INDICATE THAT WAS DONE. +SETTTM: .CALL RTTYS1 + .VALUE + MOVE TT,TTYST1 + MOVE TT1,TTYST2 + ANDCM TT,[202020,,202020] ;HAVE ECHOING ON IFF + ANDCM TT1,[202020,,202020] ;FS ECHOLINES $ IS >=0. + SKIPL NELNS + IOR TT,[202020,,202020] + SKIPL NELNS + IOR TT1,[202020,,200020] + TLO Q,%TSCLE+%TSACT+%TSMOR + SKIPN RGETTY + TLZ Q,%TSMOR + .CALL STTYS1 + .VALUE + SETOM ECHOFL + TLZ Q,%TSINT+%TSSAI + MOVEM Q,TTYSTS + RET + +TTYAC2: HRROS (P) + CAIA +TTYAC1: HRRZS (P) +TTYAC4: SAVE Q + SAVE TT + SAVE TT1 + SAVE CH + .CALL RTTYS1 + .LOSE %LSFIL + TLZ Q,#%TSSAI + IOR Q,TTYSTS + SKIPGE CH,-4(P) + TLO Q,%TSINT + .CALL STTYS1 + .LOSE %LSFIL + REST CH + REST TT1 + REST TT + JRST POPQJ + +RSSB: SETZ + SIXBIT /CNSGET/ + %CLIMM,,CHDPYO + %CLOUT,,NVLNS + %CLOUT,,NHLNS + %CLOUT,,TT ;TCTYP + %CLOUT,,TT ;TTYCOM + 400000+%CLOUT,,TTYOPT + +RTTYS1: SETZ + SIXBIT \TTYGET\ + %CLIMM,,CHTTYI + %CLOUT,,TT + %CLOUT,,TT1 + %CLOUT,,Q + %CLOUT,,CH + 400000+%CLOUT,,CH ;TCTYP VARIABLE + +STTYS1: SETZ + SIXBIT \TTYSET\ + %CLIMM,,CHTTYI + TT + TT1 + SETZ Q +] + +IFN TNX,[ + +;RETURN TECO INTERNAL TTY TYPE IN CH. +RTTYTP: MOVEI 1,.PRIIN + GTTYP ; GET TERMINAL TYPE + MOVEM B,SGTTYP ; SAVE TYPE FOR DPYRST + CAMN 2,[SIXBIT /4023/] ; BBN'S WAY OF DOING TTY TYPES + MOVEI 2,TK4023 + CAME 2,[SIXBIT /4024/] ; SAME THING AS 4025 + CAMN 2,[SIXBIT /4025/] + MOVEI 2,TK4025 + CAMN 2,[SIXBIT /HP/] + MOVEI 2,HP2645 + CAMN B,[SIXBIT /C100/ ] + MOVEI B,C100 + CAMN B,[SIXBIT /T1061/] + MOVEI B,TL1061 + MOVE CH,TTYTYP(2) ; GET TERMINAL TYPE DISPATCH + RET + +; DO INITIAL SETUP +SETTTM: SAVE C + MOVSI A,.TICCG ; ^G ON CHANNEL 0 + SKIPG NOQUIT ; IF QUITTING IS ALWAYS DISABLED, DO NOT ARM + ATI ; ^G, SO THAT IT WILL ARRIVE AS A COMMAND AT + ; THE CORRECT TIME (THIS IS FOR RMODE). + CALL DOSTIW ; SETUP TERMINAL INT MASK + MOVEI A,.PRIIN + RFMOD ; GET TTY MODE WORD + SKIPE CH,RGETTY ; PRINTING? + TRZA 2,TT%DAM ; NO, BINARY MODE THEN + TRO 2,1_6\TT%ECO ; YES, MAKE SURE DATA MODE NORMAL + SFMOD +IFN 20X,[ + SKIPGE PAGMOD ; WANT PAGE MODE LEFT ON? + JRST .+4 ; YES, DONT MESS WITH IT + JUMPE CH,SETTM1 + TRZE 2,TT%PGM ; TURN OFF PAGE MODE ON DISPLAY + STPAR +] +IFN SUMXSW,[ + SETZ 1, ; zero = none + JSYS 633 ; STCHA -- sets hold char to ac1 + SKIPE 1 ; don't save if already off + MOVEM 1,HLDCHR ; save previous setting for later restore +] +SETTM1: SETOM ECHOF2 ; ASSUME ECHO + SKIPE RGETTY ; PRINTING TTY'S ECHO FOR THEMSELVES + SKIPGE NELNS ; FS ECHOLINES >= 0 ? + SETZM ECHOF2 ; NO, ECHO OFF + SETOM ECHOFL ; SAY WE DID SOMETHING + JUMPN CH,POPCJ ; DONE UNLESS PRINTING + MOVE B,[.BYTE 2 ? 1 ? 1 ? 1 ? 0 ? 1 ? 1 ? 1 ? 2 ? 2 ? 3 ? 2 ? 1 ? 1 ? 2 ? 1 ? 1 ? 1 ? 1] +IFN 10X,MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 3] +.ELSE MOVE C,[.BYTE 2 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 3 ? 1 ? 1 ? 1 ? 1] + SFCOC + JRST POPCJ ; AND RETURN +] ;TNX + + +;TURN OFF ECHOING. CLOBBERS A AND B. +NOECHO: SETZM ECHOFL +IFN ITS,[ + MOVE A,TTYSTS ;ECHO IN M.P. AREA, NOT ECHO AREA + TLO A,%TSNEA ;(ECHOING HAPPENS ONLY IN AN ECHOIN SYSTEM CALL). + SYSCAL TTYSET,[%CLIMM,,CHTTYI + [020202,,020202] ;NOTHING ECHOES, EVERYTHING ACTIVATES, + [030202,,120202] ;^G INTERRUPTS, CR OUTPUT IN IMAGE MODE. + A] + .LOSE %LSFIL +] +IFN TNX,[ + SETZM ECHOF2 ;SAY DONT ECHO THINGS FOR DISPLAY TERMINAL + SKIPE RGETTY + RET + MOVEI A,.PRIOU + RFMOD + TRZ B,TT%ECO ;TURN OFF ECHOS ON PRINTING TERMINAL + SFMOD +] + RET + +SUBTTL TERMINAL INPUT + +;READ A CHARACTER FROM THE TTY. +TYI: CALL TYINH +TYIH: CAIN CH,TOP+"H ;IS THIS THE "HELP" KEY? +TYIURH: SKIPN HELPMAC ;YES, IS THERE A HELP MACRO? + RET ;JUST RETURN THE CHARACTER + CALL [ CALL SAVACS ;PRESERVE ACS AND CURRENT TECO VALUES. + MOVE A,HELPMAC + CALL MACXCP + JRST RSTACS] + SKIPN RREBEG ;IF FS HELPMAC$ RUN INSIDE ^R, RETURN FROM TYI SO THAT + RET ;RRLP1 CAN GO TO RRLP AND MAKE SPACE REDISPLAY THE SCREEN. + JRST TYI ;AFTER RUNNING FS HELP$, TRY AGAIN TO READ A CHARACTER. + +TYIW0: CALL TYIWN0 ;DONT CHECK STOPF, BUT DO UNREAD AND HELP CHAR + JRST TYIH + +;READ CHARACTER, CHECK FOR AND STANDARDIZE HELP CHARACTER, BUT DONT RUN HELP MACRO +TYINH: SKIPGE STOPF + CALL QUIT1 +TYIWN0: MOVE CH,UNRCHC ;GOBBLE ANY UNREAD CHARACTER. + SETOM UNRCHC + JUMPGE CH,CPOPJ + SKIPE TYISRC ;IF THERE IS A "TYI SOURCE", CALL IT. + JRST [ PUSH P,[TYIWN0] + CALL SAVACS + MOVE A,TYISRC ;SINCE IT CAN'T RETURN A VALUE UNCLOBBERED, + CALL MACXCP ;IT SHOULD SET FS REREAD$ TO THE CHARACTER. + JRST RSTACS] ;AND WE RETURN TO TYIWN0 TO GOBBLE IT. + SKIPGE CLKFLG + CALL RLTCLK +IFN ITS,TYIIOT: .IOT CHTTYI,CH +IFN TNX,[ + EXCH A,CH + PBIN +TYIIOT: SKIPN RGETTY ;ON PRINTING TERMINAL +IFN 10X, CAIE A,37 ;ON 10X CONVERT 37 TO CR +IFN 20X, CAIE A,^M ;ON 20X, AFTER A CR, + JRST TYI5 +IFN 20X,PBIN ;FLUSH THE LF + MOVEI A,^M +TYI5: EXCH A,CH + SKIPN FCITYI ;ARE HIGH ORDER BITS PARITY BITS? + ANDI CH,177 ;YES, MASK THEM OFF (SOME TERMINALS GENERATE PARITY) + TRZE CH,200 ;CONVERT EDIT TO META AT LOWEST LEVEL + TRO CH,META + SKIPE ECHOF2 + CALL ECHOCH ;ECHO IT IF REQUESTED, AND SYSTEM DIDN'T ECHO IT. +] + ANDI CH,777+TOP + CAME CH,HELPCH ;TURN OUR HELP CHARACTER INTO TOP-H. + JRST TYI6 + CALL TYI4 + MOVEI CH,TOP+"H + RET + +TYI6: SKIPE DISPRR ;WHEN OUTSIDE OF ^R, + JRST TYI7 + CAIN CH,33 ;DETECT ALTMODE-ALTMODE. + CAME CH,LTYICH + JRST TYI2 + SOSGE TSALTC ;FOUND ONE! DECREMENT COUNT OF PAIRS REMAINING TO BE READ. + AOS TSALTC +TYI7: HRLI CH,-1 ;MAKE SURE 2ND ALTMODE OF PAIR CAN'T COUNT AS FIRST OF ANOTHER. +TYI2: MOVEM CH,LTYICH + ANDI CH,#META#CONTRL ;TURN ASCII CTL CHARS INTO 9-BIT ONES, + CAIE CH,^M + CAIG CH,^J ;EXCEPT FOR ^H, ^I, ^J, ^M AND ALTMODE. + CAIGE CH,^H + CAIN CH,33 + JRST TYI3 + TRNN CH,TOP+140 ;ALSO, DON'T ALTER THINGS WHICH HAVE THE "TOP" BIT. + IORI CH,CONTRL+100 +TYI3: IOR CH,LTYICH ;NOW RESTORE THE CONTROL AND META BITS, AND FLUSH TOP. + ANDI CH,CONTRL+META+177 +TYI4: IDPB CH,TYIBFP ;RECORD THE INPUT CHARACTER IN THE RING BUFFER FOR SUCH. + CALL TYI1 + SKIPN TYISNK ;INVOKE FS TYISINK$ IF THERE IS ONE + RET + CALL SAVACS + MOVE C,CH ;WITH THE CHARACTER AS ARGUMENT. + MOVE A,TYISNK + CALL MACXCP + JRST RSTACS + +FSTBBK: IBP TYIBFQ ;FS .TYIBACK$: BACK UP TYIBFP ONE CHARACTER. + IBP TYIBFQ ;ADVANCE IT TWICE, THEN BACK UP A WORD. + SOS A,TYIBFQ + CAMN A,[001400,,TYIBUF-1] + ADDI CH,TYIBSZ ;IF BACK BEFORE START OF BUFFER, WRAP TO END. + MOVEM A,TYIBFQ + RET + +FSTBNXT:ILDB A,TYIBFQ ;FS .TYINXT$: GET NEXT OLD TYI CHARACTER. + AOS (P) + MOVE CH,TYIBFQ + CAMN CH,[001400,,TYIBUF+TYIBSZ-1] + SUBI CH,TYIBSZ + MOVEM CH,TYIBFQ + RET + +TYI1: AOS INCHCT ;BUMP COUNT OF INPUT CHARACTERS READ SO FAR. + EXCH CH,TYIBFP ;PUSH THE CHARACTER ONTO THE RING BUFFER OF INPUT. + CAMN CH,[001400,,TYIBUF+TYIBSZ-1] + SUBI CH,TYIBSZ + MOVEM CH,TYIBFQ + EXCH CH,TYIBFP + RET + +;CONVERT CHAR. IN CH FROM TV CHAR SET TO ASCII. +TYINRM: TRZ CH,META ;CONTROL-^-MUMBLE JUST BECOMES ^-MUMBLE. + TRZN CH,CONTRL + RET + CAIN CH,177 + RET ;CONTROL-RUBOUT SHOULD BE RUBOUT, NOT "?". + CAIE CH,40 ;CONTROL-SPACE IS ^@. + TRZE CH,100 ;NOTE TV CHAR SET HAS CONTROL-LOWERCASE LETTERS! + ANDCMI CH,40 ;THEY SHOULD CONVERT JUST LIKE CONTROL-UPPERCASE LETTERS. + RET + +SUBTTL PURIFY + +IFN ITS,[ +;DUMPIT$G TO DO $Y THEN PURIFY, WITH THE BONUS THAT IT REFUSES +;TO WORK ON A TECO THAT HAS BEEN RUN. +DUMPIT: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /Y +P/] + +;PURIFY$G TO MAKE PURE THE PAGES THAT ARE SUPPOSED TO BE PURE. +PURIFY: SKIPE RUNFLG + .VALUE + .VALUE [ASCIZ /B P/] + MOVEI P,PDL + MOVE A,[PURP1-PURPL,,PURP1] + SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A] + .LOSE %LSFIL + SETOM PUREFL + MOVE A,[.FNAM2] + .VALUE [ASCIZ \ +A/ ..UFILE+2/ 1Q +..UFILE+3/ 1'.TECO. +..UFILE+1/ 1'TECPUR +:Purified + +:PDUMP\] + JRST INIT +] + +IFN TNX,[ +PURIFY: SKIPE RUNFLG + .VALUE + SETOM PUREFL + HLRE 2,116 ;BLT OUT THE SYMBOL TABLE + AOS 1,116 ;FIRST ADDRESS OF SYMBOLS+1 + HRLI 1,-1(1) + SETZM -1(1) ;ZERO IT OUT + SUBI 2,(1) ;GET LAST WORD OF THEM + MOVM 2,2 + BLT 1,(2) ;AND ZERO THE REST OF THEM + SETZM 116 ;ZERO POINTER TOO FOR DDT + + MOVEI 1,.FHSLF + MOVE 2,[3,,BOOT] + SEVEC ;SET UP OUR ENTRY VECTOR + + MOVSI 1,(GJ%SHT) +RADIX 10. +IFN 10X,HRROI 2,[STRCNC [TECO.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECO.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%CPY+SS%RD+SS%EXE+<-600,,0>] + SETZ 3, + SSAVE + ERJMP PFYERR +RADIX 10. + MOVSI 1,(GJ%SHT) +IFN 10X,HRROI 2,[STRCNC [TECPUR.SAV;]\.FNAM3 ] +.ELSE HRROI 2,[STRCNC [TECPUR.EXE.]\.FNAM3 ] +RADIX 8 + GTJFN + JRST PFYERR + HRLI 1,.FHSLF + MOVE 2,[SS%RD+SS%EXE+] + SSAVE + ERJMP PFYERR + JRST INIT + +PFYERR: MOVEI 1,.PRIOU ;ERROR WHILE PURIFYING, GIVE THE PERSON A HINT WHAT HAPPENED + HRLOI 2,.FHSLF ;LAST ERROR THIS PROCESS + SETZ 3, + ERSTR + JFCL + JFCL + .VALUE +] ;IFN TNX + +SUBTTL SUBROUTINES FOR COMMAND STREAM CHARACTER READER RCH + +;COME HERE ON TRYING TO READ PAST THE END OF A COMMAND STRING LEVEL. +RCH2: SAVE A ;POP OFF MACRO FRAME + SETZM COMCNT ;DON'T LET COMCNT BE -1 -- WOULD SCREW IF ERROR HANDLER DOES BACKTRACE. + SKIPN A,MACPTR ;0 MEANS TRIED TO POP OUT OF TOP-LEVEL + JRST INSCHK +RCH2A: CALL ERSTST ;REFUSE TO POP OUT OF MACRO CONTAINING UNTERMINATED "<" OR ":<". + LDB CH,MACPDP ;TRY TO POP MACPDL ENTRY FOR THE MACRO-CALL. + TRNE CH,10 + JRST RCH2B ;TOP OF MACPDL ISN'T A MACRO-CALL ENTRY! + HRRE A,(A) + JUMPGE A,RCH2D ;ARE WE POPPING OUT OF A MACXQ (MIDAS TO TECO CALL)? + HRRZ A,-1(P) ;YES, ONLY ALLOWED FROM COMMAND LOOP. + CAIE A,CDRCH + JRST INSCHK ;INSIDE A COMMAND => ERROR. +RCH2D: MOVE A,MACPTR + CALL DECDCH ;IT IS ONE, RESTORE RCHALT AND SQUOTP AS IT SAYS. + CALL POPMAC ;POP THE MACRO-STRING-FRAME. + CALL POPMP ;ACTUALLY DEECREMENT MACPDP. +RCH2C: REST A + SKIPL MACPTR ;ARE WE POPPING OUT OF A MACXQ? + JRST RCH ;NO, TRY AGAIN, READ FROM WHAT WE POPPED INTO. + MOVE CH,MACXP ;YES, RESTORE PDL LEVEL TO THAT AT + POP CH,MACXP ;CALL TO MACXQ, AND PREPARE TO RETURN. + POP CH,MACPTR + JRST SETP1 ;SET P FROM CH AND ADJUST LEV. + +RCH2B: CAIN CH,10 ;A NULL ENTRY? FLUSH IT AND TRY AGAIN. + JRST [CALL POPMP ? JRST RCH2A] + MOVEI CH,4 ;[ ;CAN'T POP SINCE ^]^X'D INTO, + MOVEM CH,COMCNT ;[ ;INSTEAD ^]^X UP ANOTHER LEVEL. + MOVE CH,[BP7,,[ASCIZ//]] + MOVEM CH,CPTR + MOVEM CH,CSTR + SKIPGE MACPTR ;I THINK TECO LOSES IF IT USES UP + .VALUE ;[ ;ALL OF A MACXQ'D STRING WITH A ^]^X. + JRST RCH2C + +;THE RCHDTB ENTRY FOR THE CASE SHIFT CHAR IS +RCHSFT: SKIPN MACPTR ;IN MACRO, CASE SHIFT ISN'T SPECIAL. +RCHSF1: SKIPE RCHSFF ;IF PREV. CHAR WAS SHIFT, THIS ONE IS QUOTED. + POPJ P, ;PRETEND NOT TO BE A CASE-SHIFT. + MOVNS CASE ;ELSE ASK TO READ NEXT CHAR IN THE OTHER CASE, + MOVE CH,-1(P) ;GET RET. ADDR OF READ RTN, + SETOM RCHSFF ;QUOTE NEXT CHAR IF CASE-SHIFT OR LOCK. + XCT -1(CH) ;RE-CALL THE READ RTN. (TRACES IF NEC) + MOVNS CASE ;RESTORE CASE TO WHAT IT HAD BEEN. + SETZM RCHSFF +POP1J: SUB P,[1,,1] ;RETURN FROM THE CALL TO RCH + POPJ P, ;SINCE CHAR WAS ALREADY TRACED. + +RCHLOK: SKIPN MACPTR ;RCHDTB ENTRY FOR CASE-LOCK CALLS HERE.. + SKIPE RCHSFF ;IF IN MACRO OR QUOTED BY A CASESHIFT, + POPJ P, ;DO NOTHING SPECIAL. + MOVNS CASE ;ELSE SWITCH THE CASE WE WANT CHARS IN, +RCHTRY: SUB P,[1,,1] + REST CH + JRST -1(CH) ;AND GO READ THE NEXT CHAR. + +;OUTPUT CHARACTER IN CH WHOSE EXECUTION IS TRACED. +.SEE TRACS ;TRACS CONTAINS JRST TYOS WHEN TRACING IS ON. +;CLOBBERS NO ACS. +TYOS: SKIPE BRC1 + RET + SAVE Q + SAVE CH + SETOM TRCOUT + PUSHJ P,TYO + MOVE CH,(P) + CAIE CH,^M ;DON'T MAKE CR COME OUT AS ^M. + PUSHJ P,DISFLS + SETZM TRCOUT + REST CH +POPQJ: REST Q + RET + +;COME HERE IF POP OUT OF MACXQ'D OR TOP-LEVEL STRING IN THE MIDDLE OF A COMMAND. +INSCHK: SKIPN INSINP ;IF WITHIN AN INSERT, WE COULD JUST ERR OUT + TYPRE [CNM] + MOVE P,INSINP ;BUT THAT WOULD LOSE THE STUFF INSERTED SO FAR. + SETZM INSINP ;SO TELL INSDUN TO DO THE CNM ERROR + JRST INSDUN ;AND CAUSE INSERT TO FINISH UP. + +SUBTTL MACRO FRAME ALLOCATION + +;FREE UP A CELL OF MACRO CALL SPACE. +;A -> 1ST WD OF CELL, MINUS 1. +FLSFRM: ANDI A,-1 ;MAKE SURE NO GARBAGE BLOCK IS PUT ON THE FRAME FREELIST. + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + SETZM MFCPTR+1(A) + SETZM MFBEG+1(A) + EXCH CH,MFFREE + MOVEM CH,MFLINK+1(A) + MOVE CH,MFFREE + HRRZM A,MFFREE + POPJ P, + +;OBTAIN A FREE CELL OF MACRO CALL CELL SPACE. +;RETURN POINTER TO WD BEFORE 1ST WD OF CELL, IN A. +GETFRM: SKIPG A,MFFREE + JRST GETFR1 + ANDI A,-1 + CAMGE A,MFEND + CAIGE A,MFSTRT-1 + .VALUE + MOVE A,MFLINK+1(A) + EXCH A,MFFREE + POPJ P, + +GETFR1: CALL GCNRL ;GC, PERHAPS FREEING FRAMES USED BY BUFFERS. + SKIPE MFFREE + JRST GETFRM ;ONE WAS FREED. + CALL GETFR2 + JRST GETFRM + +GETFR2: CALL SAVACS ;MAKE MFINCR MORE MACRO FRAMES, + SAVE TOTALC + MOVE A,MFEND ;UNLESS WE ALREADY HAVE THE MOST WE ARE ALLOWED TO HAVE. + CAILE A,MFSTRT+*MFBLEN + TYPRE [TMN] + MOVEI C,MFINCR*MFBLEN*5 ;NUMBER OF CHARS WORTH OF SPACE WE WILL ALLOCATE. + CALL SLPQGT ;MAKE SURE IMPURE STRING SPACE HAS ROOM TO MOVE UP THAT FAR. + HRRZ BP,CBUFLO + IMULI BP,5 + MOVE TT,QRWRT ;GET START AND END OF RANGE OF CORE TO MOVE UP, IN CHARS. + HRRZ CH,INSBP ;NOTE THAT IF A STRING IS NOW BEING WRITTEN JUST PAST QRWRT, + ADDI CH,1 ;IT MUST BE INCLUDED IN RANGE TO MOVE. + IMULI CH,5 + CAML CH,BFRBOT + JRST GETFR7 + CAMGE TT,CH + MOVE TT,CH +GETFR7: MOVEI C,MFINCR*MFBLEN ;GET NUMBER OF WORDS TO MOVE UP BY. + CALL SLPN0Q + SAVE E + MOVE A,MACPTR + CALL GETFR5 ;RELOCATE ALL BYTE POINTERS IN MACRO, CTX AND ITERATION FRAMES. + MOVE A,CTXPTR + CALL GETFR5 + MOVE A,ITRPTR + CALL GETFR5 + CAML D,CSTR ;IF CPTR IS A B.P. TO A STRING, RELOCATE IT. + ADDM C,CPTR + REST E + ADDM E,QRBUF ;ADD # CHARS MOVED BY (SET BY SLPN0Q) TO + ADDM E,QRWRT ;BOUNDS OF IMPURE STRING SPACE. + MOVE D,BFRBOT + IDIVI D,5 + HRRZ E,INSBP + CAIL E,@CBUFLO ;IF INSBP IS IN THE COMMAND BUFFER OR IMPURE STRING SPACE, + CAMLE E,D ;RELOCATE IT. + JRST GETFR4 ;(THESE TESTS EXCLUDE THE SPECIAL VALUES, 0 AND -1). + ADDM C,INSBP +GETFR4: ADDM C,CBUFLO + ADDM C,CBUFH ;UPDATE BOUNDS OF COMMAND BUFFER. + MOVE A,MFEND + ADDB C,MFEND ;MARK ADDITIONAL SPACE AS IN USE BY MACRO FRAMES. + SOS A +GETFR3: CALL FLSFRM ;NOW "FREE" ALL THE NEWLY ALLOCATED FRAMES SO THEY CAN BE USED. + ADDI A,MFBLEN ;NOTE THAT THE ARG TO FLSFRM MUST BE THE FRAME ADDR MINUS 1. + CAIE A,-1(C) + JRST GETFR3 + REST TOTALC + JRST RSTACS + +;IF A POINTS TO THE START OF A LIST OF MACRO FRAMES, +;RELOCATE THOSE MFCPTR'S OF FRAMES IN THE LIST WHICH POINT AT STRINGS. +;C IS THE AMOUNT TO RELOCATE BY. +GETFR5: MOVE D,QRWRT + TLO D,400000 ;D GETS THE LARGEST NUMBER WHICH IS A STRING POINTER. + MOVE E,MACXP ;IF THIS LIST IS MACPTR, IT MAY HAVE POINTERS THRU THE STACK. +GETFR6: JUMPE A,CPOPJ ;EXIT ON REACHING END OF LIST. + CAML D,MFCSTR-MFLINK(A) ;RELOCATE THE CPTR IF THE CSTR INDICATES THAT THE CPTR + ADDM C,MFCPTR-MFLINK(A) ;POINTS INTO AN IMPURE STRING. + HRRE A,MFLINK-MFLINK(A) ;NOTE THAT A POINTS AT THE MFLINK WORD, NOT THE START OF THE FRAME. + JUMPGE A,GETFR6 ;NOW ADVANCE TO THE NEXT FRAME IN THE LIST. + MOVE A,-1(E) ;BUT MAYBE ADVANCE DOWN A LINK MADE BY A MACXQ CALL. + MOVE E,(E) + JRST GETFR6 + +;[ +SUBTTL ^] + +;[ ;THE RCHDTB ENTRY FOR ^] IS +;NOTE THIS CAN RETURN TO THE CALLING PUSHJ, TO RETRY IT. +CTLBRC: JUMPL CH,TRACS + SKIPGE SQUOTP + JRST TRACS + CALL TRACS + SETZM BRC1CF + SETZM BRCUAV + SETOM DLMF2 + SETZM SQUOF2 +BRCREC: PUSHJ P,[ ;[ ;^]@ OF A STRING RETURNS HERE TO READ 1ST CHAR OF STRING. + SKIPG COMCNT + TYPRE [UEC] + SOS COMCNT + ILDB CH,CPTR + POPJ P,] + ;[ ;^]@ OF A NUMBER RETURNS HERE WITH NUMBER IN CH. + CALL TRACS +BRCRC2: INSIRP PUSH P,A B TT TT1 BP ;BP MUST BE LAST - SEE EXPMAC. + SETZ A, + PUSHJ P,QNMGE2 + JRST QLET + SKIPE BRC1 + JRST BRCRT5 + CALL QLGET + JRST BRCNVL + JRST EXPMAC + +QLET: SKIPE A + TYPRE [IQN] +INSIRP POP P,BP TT1 TT B A ;[ + CAIE CH,^] + CAIN CH,ALTMOD + JRST BRCPRT + CAIN CH,"$ + JRST RET33 + CAIN CH,^Q + JRST BRCCTQ + CAIN CH,^T + JRST BRCCTT + CAIN CH,^S + JRST BRCCTS + CAIN CH,^A + JRST BRC1CH + CAIN CH,^V + JRST BRCCTV + SKIPE BRC1 + JRST BRCRC3 + CAIN CH,"@ + JRST BRCIND + CAIN CH,^X + JRST BRCCTX + CAIN CH,^Y + JRST BRCCTY + TYPRE [ICB] + +BRCRC3: CAIN CH,"@ + JRST BRCREC + CAIE CH,^X + CAIN CH,^Y + JRST BRCRT + TYPRE [ICB] + +BRCCTS: SETOM SQUOF2 + SETOM DLMF2 + JRST BRCREC + +BRCCTT: SETZM DLMF2 + JRST BRCREC + +BRC1CH: SETOM BRC1CF + JRST BRCREC + +BRCIND: SAVE [BRCREC+1] + JRST BRCREC ;CALL BRCREC, THEN GO TO BRCRC2. + +BRCCTV: SETOM BRCUAV + JRST BRCREC + +BRCNVL: SKIPN BRCUAV + TYPRE [QNS] + SETOM BRCFLG + INSIRP POP P,BP TT1 TT B + MOVE CH,A + HRROM A,BRCUAV ;LEAVE UNTRUNCATED VALUE FOR QNMGET. + ANDI CH,177 + CALL TRACS + SKIPE SQUOF2 + HRLI CH,-1 + JRST POPAJ + +BRCCTQ: CALL SKRCH +BRCPRT: HRLI CH,-1 ;RETURN THE CHARACTER SUPERQUOTED. + POPJ P, + +;SET SQUOTP ACC TO SQUOF2, DLMF2 AND TURN OFF RCHALT. +;ALSO SAVE OLD STATE OF THOSE VARS AS BITS IN CH FOR PUSHING ON MACPDP +FLGENC: SETZ CH, + SKIPE DLMF2 ;SET SQUOTP ACC. TO SQUOF2, DLMF2 + TLO CH,2^5 + SKIPE SQUOF2 + TLO CH,4^5 ;AND SET CH ACC TO PREVIOUS SQUOTP AND RCHALT + EXCH CH,SQUOTP + IORM CH,SQUOTP + ROT CH,2 .SEE MACPDP ;SET UP CH AS A MACPDL ENTRY + ADDI CH,1 + HLRZ A,RCHALT + CAIN A,(CALL) + ADDI CH,4 + MOVEI A,(JFCL) ;ALSO TURN OFF RCHALT. + HRLM A,RCHALT + POPJ P, + +DECDCH: TRNN CH,3 + POPJ P, ;THIS ENTRY DIDN'T PUSH SQUOTP, RCHALT. + SUBI CH,1 + DPB CH,[420200,,SQUOTP] + TRNN CH,4 + SKIPA CH,[(JFCL)] + MOVEI CH,(CALL) + HRLM CH,RCHALT + POPJ P, + +;A HAS STRING OBJECT, B HAS LENGTH, BP HAS POINTER TO IT. +;PUSH A CALL TO THAT OBJECT ONTO THE RCH INPUT STREAM. +;NOTE TOP OF PDL HAS VALUE THAT WAS IN BP WHEN RCH WAS CALLED. +EXPMAC: SETOM BRCFLG + MOVE BP,(P) ;SAVE BP, AND GET OUR CALLER'S BP. + CALL PUSMA0 ;PUSH MACRO PDL, RELOCATING BP IF BUFFERS MOVE. + MOVEM BP,(P) ;GIVE CALLER'S BP BACK TO HIM, RELOCATED IF NEC. + CALL QLGET0 ;REDECODE ADDR OF STRING (MAYBE PUSMA0 MADE FRAMES AND CHANGED IT). + SKIPE BRC1CF + MOVEI TT,1 + MOVEM A,CSTR + MOVEM BP,CPTR + SKIPE BRC1CF ;IF WANT WHOLE STRING, + CAMLE TT,B ;OR IF WANT MORE CHARS THAN STRING HAS, + MOVE TT,B ;USE STRING LENGTH RATHER THAN DESIRED # CHARS. + MOVEM TT,COMCNT + MOVE B,PF + MOVEM B,MACSPF + SETZM MACBTS ;[ ;THERE ARE NO ARGS IN A ^] CALL. + SETZ CH, ;IF NOT SETTING ANY FLAGS, PUSH 0 ON MACPDL. + SKIPN SQUOF2 + SKIPE DLMF2 + CALL FLGENC ;ELSE COMPUTE WHAT TO PUSH. + IDPB CH,MACPDP +BRCRT5: INSIRP POP P,BP TT1 TT B +BRCRT4: REST A +BRCRT: REST CH + JRST -1(CH) ;RETRY THE RCH. + +RET33: MOVEI CH,ALTMOD + POPJ P, + +;[ ;PERFORM A PUSH INTO A ^]^X. +BRCCTX: SKIPE BRC1CF + JRST BRCCTY + SETOM BRCFLG + PUSH P,A + HRRZ A,-2(P) + CAIE A,BCYRCH+1 ;[[ ;IF THE ^]^X WAS IN THE CHARACTER THAT A ^]^Y WAS TRYING TO READ, + JRST BRCCX2 + PUSH P,RCHALT + HRLZI A,(JFCL) ;[ ;PERFORM A RECURSIVE ^]^Y, + HLLM A,RCHALT + PUSHJ P,BRCCTY + POP P,RCHALT ;[ ; WE HAVE ADVANCED PAST THE ^]^X IN THIS MACRO LEVEL. + CAIN CH,ALTMOD ;IF WHAT WE JUST GOT IS AN ALTMODE, THAT'S OK; RETURN IT. + JRST BRCRT4 + MOVE A,CPTR ;[ ;BUT OTHERWISE, THIS ^]^X HAS LONGER TO RUN, + PUSH P,CH ;SO WE MUST BACK UP OVER IT. +BRCCX1: DBP7 A + AOS COMCNT + LDB CH,A ;[ + CAIE CH,^] ;[ ;SO BACK UP UNTIL WE GET TO THE ^]. + JRST BRCCX1 + DBP7 A ;AND BACK UP ONE CHAR FURTHER. + AOS COMCNT + MOVEM A,CPTR + POP P,CH ;[ ;THEN RETURN THE THING WE GOT FROM THE RECURSIVE ^]^Y. + JRST POPAJ + +BRCCX2: CALL BRCCX0 + JRST BRCRT4 + +;[ ;PUSH INTO A ^]^X, AS A SUBROUTINE, NOT CALLED BY RCH. RETURNS WITH A NORMAL POPJ. +BRCCX0: PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC ;SET SQUOTP, GET OLD STATE IN CH. + ADDI CH,10 ;[ ;INDICATE PUSHED BY ^]^X, NOT MACRO CALL. + IDPB CH,MACPDP + MOVEI A,(CALL) + HRLM A,RCHALT ;[ ;START LOOKING FOR AN $ TO END ^]^X. + SKIPGE MACPTR ;[ ;TRYING TO ^]^X OUT OF A MACXQ => PHONY UP NULL ARG. + CALL ENDAR2 + RET + +ENDARG: MOVEM A,(P) + CALL ENDAR2 + JRST BRCRT4 + +ENDAR2: CALL ERSTST + LDB CH,MACPDP + TRNN CH,10 + JRST ENDAR1 ;[ ;POPPING ^]^X BUT MACPDP SAYS MACRO CALL. + CAIN CH,10 ;NULL ENTRY ON MACPDP? FLUSH IT. + JRST [CALL POPMP ? JRST ENDAR2] +ENDAR5: CALL DECDCH ;[ ;A ^]^X ENTRY, UNBIND SQUOTP AND RCHALT. + CALL POPMP ;AND REMOVE THE ENTRY FROM THE STACK. + JRST ENDAR4 + +ENDAR1: SAVE MACPDP +ENDAR3: CALL POPMP + CALL ERSTST + LDB CH,MACPDP ;[ ;LOOK DOWN MACPDP FOR A ^]^X ENTRY. + CAIG CH,10 + JRST ENDAR3 ;THE ENTRIES ABOVE MUST BE 0 OR 10 . + CALL DECDCH ;FOUND THE ENTRY, RESTORE SQUOTP. + MOVEI CH,10 ;REPLACE THE ENTRY WITH A NULL. + DPB CH,MACPDP + REST MACPDP +ENDAR4: CALL PUSMA0 + JRST POPCTX + +BRCCTY: SETOM BRCFLG + PUSH P,A ;HANDLE ^Y OR ^F^X. + PUSHJ P,PUSCX0 + SKNTOP MACPTR + TYPRE [NIM] + PUSHJ P,POPMAC + CALL FLGENC + ADDI CH,10 + IDPB CH,MACPDP + SKIPGE MACPTR ;IF OUR CALLER WAS MACHINE-LANGUAGE TECO, + SKIPA CH,[ALTMOD] ;DON'T TRY TO POP INTO IT; PHONY UP AN ALTMODE. +BCYRCH: PUSHJ P,RCH + SKIPGE SQUOTP + HRLI CH,-1 + SAVE CH + CALL ENDAR2 + REST CH + REST A + RET + +;F^K COMMAND FOR READING STRING ARGUMENTS: + +;DO F^K$. IF YOU WERE CALLED BY A MACRO, IT WILL ACT LIKE ;[ +; :I*^]^X$, GOBBLING A STRING ARG FROM THAT MACRO. +;OTHERWISE, IT ACTS LIKE M$*F^K HOOK*$$, +; WHICH SHOULD READ AN ARGUMENT FROM THE TERMINAL, PROMPTING. +; IF THE USER RUBS OUT PAST THE START OF THE ARGUMENT, +; M$*F^K HOOK*$ SHOULD EXIT FROM THE F^K'ING MACRO WITH -2FS BACK RETURN$. + +;:F^K RETURNS A NEGATIVE VALUE IF THE CURRENT MACRO'S CALLER WAS TECO INTERNAL CODE. +;IT RETURNS A NONNEGATIVE NUMBER IF THE CALLER WAS ANOTHER MACRO. + +;CALLING A MACRO WITH @M MAKES F^K WITHIN THAT MACRO BELIEVE THAT THE +;MACRO WAS CALLED FROM TECO INTERNAL CODE. + +FCTLK: SKIPN A,MACPTR + TYPRE [CNM] ;BARF IF NO CALLER AT ALL + HRRE A,(A) + MOVE T,MACBTS ;@M IS TREATED LIKE A CALL FROM INSIDE TECO. + TLNE T,MFBATSN + SETO A, + TRZE FF,FRCLN ;FOR :F^K, RETURN NEGATIVE IF CALLER IS TECO CODE. + JRST POPJ1 + JUMPL A,FCTLK1 ;NO COLON. JUMP IF CALLER IS ^R OR OTHER TECO CODE. + CALL FNOOP ;CALLER IS A MACRO. FLUSH . + MOVE A,CPTR ;BACK UP OVER THE ALTMODE, SO THAT IT WILL TERMINATE THE + DBP7 A ;ARG WHICH THE :I* WILL READ. + MOVEM A,CPTR + AOS COMCNT + SETZM SQUOF2 + SETOM DLMF2 + CALL BRCCX0 ;[ ;SIMULATE GOBBLING A ^]^X. DELIMITER PROTECT, BUT NO SUPERQUOTING. +FCTLK0: TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + MOVEI CH,A + MOVE OUT,[CALL RCH] + MOVEM OUT,INSRCH + AOS (P) + JRST PSI ;THEN SIMULATE A :I* AND RETURN ITS VALUE. + +FCTLK1: MOVEI A,[ASCIZ /FM*F HOOK*/] + HRLI A,440700 + MOVE BP,A + MOVEI B,14. ;THIS IS THE NUMBER OF CHARACTERS IN THAT ASCIZ STRING!! + REST T ;DISCARD RETURN ADDRESS, SINCE MAC2 WILL JUMP TO MAIN LOOP. + CAIN T,CDRET + .VALUE + JRST MAC2 ;[ ;WE CAN'T USE MACXQ, SINCE WE NEED TO HAVE ^]^X WORK THROUGH THIS. + +PUSMA0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSMAC + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSMAC + EXCH BP,INSBP + RET + +PUSMAC: SAVE A + PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,MACPTR] + PUSH A,... +TERMIN MOVEM A,MACPTR + AOS MACDEP + HLL A,MACBTS + HLLM A,(A) + JRST POPAJ + +POPMAC: SKNTOP MACPTR + TYPRE [CNM] +POPMA1:IRP ...,,[MACPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,MACPTR + HRLS MACPTR + HLLZM A,MACBTS + SOS MACDEP + RET + +PUSCX0: SKIPE INSBP ;SHOULD BP BE RELOCATED? + JRST PUSCTX + EXCH BP,INSBP ;YES; PUT IT WHERE GC LOOKS. + CALL PUSCTX + EXCH BP,INSBP + RET + +PUSCTX: PUSHJ P,GETFRM +IRP ...,,[COMCNT,CPTR,CSTR,MARG1,MARG2,MACSPF,CTXPTR] + PUSH A,... +TERMIN MOVEM A,CTXPTR + HLL A,MACBTS + HLLM A,(A) + POPJ P, + +POPCTX: SKNTOP CTXPTR + JRST [.VALUE ? JRST GO] +IRP ...,,[CTXPTR,MACSPF,MARG2,MARG1,CSTR,CPTR,COMCNT] + POP A,... +TERMIN + CALL FLSFRM + MOVE A,CTXPTR + HRLS CTXPTR + HLLZM A,MACBTS + RET + +;DECREMENT MACPDP. +POPMP: MOVE CH,MACPDP + ADD CH,[40000,,] + JUMPGE CH,POPMP1 + CAML CH,[440000,,] + SUB CH,[440000,,1] +POPMP1: MOVEM CH,MACPDP + POPJ P, + +;IF ABOUT TO POP MACPDP, MAKE SURE NOT POPPING +;OUT OF A LEVEL CONTAINING AN UNTERMINATED ERRSET OR ITERATION. +ERSTST: HRRZ CH,ITRPTR ;ADDR OF BLOCK FOR INNERMOST ERRSET OR ITERATION. + JUMPE CH,CPOPJ ;THERE IS NONE IN PROGRESS. + MOVE CH,MFMACP-MFBLEN+1(CH) ;GET THE MACPDP VALUE AT TIME IT WAS ENTERED. + TLZ CH,40 + CAME CH,MACPDP ;ARE WE POPPING THAT LEVEL? + RET + TSC CH,ITRPTR ;YES. WHICH IS IT - AN ERRSET OR AN ITERATION? + TRNN CH,-1 + TYPRE [ERP] ;AN ERRSET. + TYPRE [UTI] ;AN ITERATION. + +SUBTTL ERRORS + +;FE -- INSERT A "TECO ERROR" FILE IN THE BUFFER BEFORE PT. +;:FE -- INSERT A LIST OF NAMES OF FS FLAGS. +;FE -- INSERT IN BUFFER THE 3-LETTER CODE + ;AND MESSAGE ASSOCIATED WITH ERROR CODE +;^ FE$ -- RETURNS THE ERROR CODE ASSOCIATED WITH THE 3-CHAR + ;MESSAGE . +FECMD: TRZE FF,FRUPRW + JRST FECMU + MOVSI T,-LERTAB + MOVEI A,TYOM ;TYPEOUT INTO BUFFER AT PT. + HRRM A,LISTF5 + CALL GAPSLP + TRNE FF,FRCLN ;:FE - INSERT LIST OF FS FLAGS. + JRST FECMD3 + TRZN FF,FRARG + JRST FECMD2 ;NO ARG, INSERT A LINE FOR EACH ERROR. + MOVE A,C ;AN ARG (ERROR CODE) IS JUST A STRING, SO GET IT. +FECMD6: CALL QGET3 + JRST CRR1 + +FECMD2: SAVE PT ;SAVE CURRENT PT SO CAN SET UP INSLEN. +FECMD5: MOVE A,ERRTAB(T) + HRLI A,400000 ;MAKE STRING PTR TO NEXT ERROR MESSAGE. + SAVE T + CALL FECMD6 ;INSERT EACH ERROR MESSAGE IN THE BUFFER. + REST T + AOBJN T,FECMD5 + REST C ;C GETS OLD PT. + SUB C,PT + MOVNM C,INSLEN ;FKD WILL DELETE THE WHOLE TABLE. + RET + +FECMD3: MOVSI T,-FLAGSL +FECMD4: MOVE E,FLAGS(T) ;GET THE NEXT FLAG'S NAME + CALL TYPR ;AND TYPE IT OUT INTO BUFFER. + CALL CRR1 ;EACH NAME GOES ON A LINE. + AOBJP T,CPOPJ ;WHEN THRU, UNBIND LISTF5 AND DONE. + AOJA T,FECMD4 ;HANDLE NEXT FLAG NAME. + +;HANDLE ^ FE. +FECMU: CALL FSIXR ;READ ARG, MAKE SIXBIT WORD IN A. + JFCL + HLRZ C,A + MOVSI A,-LERTAB ;NOW SEARCH ERROR TABLE FOR THIS ERROR. +FECMU2: HLRZ TT,ERRTAB(A) + CAIE TT,(C) + AOBJN A,FECMU2 ;STOP WHEN FIND IT, OR AT END OF ERRTAB. + CAIN A,LERTAB ;IS IT THE END? + JRST NRET0 ;YES, NO SUCH ERROR MESSAGE, RETURN 0. + HRRZ A,ERRTAB(A) + HRLI A,400000 ;ELSE RETURN POINTER TO THE ERROR STRING. + JRST POPJ1 + +;ROUTINE FOR FS ERR$. +FSERR: MOVE A,LASTER + TRNN FF,FRARG + JRST POPJ1 ;READING ONLY - RETURN LAST ERROR'S CODE. + MOVEM C,LASTER + JRST DISTOE + +;FG -- MAKE A STANDARD ERROR REPORT (USEFUL IN ERROR HANDLER MACROS). +;IF ARG, PRINT STANDARD ERROR MESSAGE FOR THAT ERROR CODE. + ;AND IF ":", DO IT AT TOP OF SCREEN. + ;Q..H IS NOT CHANGED BY FG EVEN IF IT DOES TYPEOUT. +;IF "^", THROW AWAY TYPE AHEAD. +;IN ANY CASE, TYPE A BELL. +FGCMD: MOVE A,QRB.. + SAVE .QVWFL(A) + TRZE FF,FRARG + CALL FGCMDP + MOVE A,QRB.. + REST .QVWFL(A) + SKIPE ERRECH ;IF WE TYPED THE ERR MSG IN THE ECHO AREA, + SETZM ECHACT + TRZN FF,FRUPRW + JRST TYPBEL +IFN ITS,.RESET CHTTYI, +IFN TNX,[MOVEI A,.PRIIN ;CLEAR INPUT + CFIBF] + SETZM TSINAL + SETZM TSALTC + SETOM UNRCHC +TYPBEL: SKIPE TYISNK + HRRZM P,MODCHG ;IF CLEARING TYISNK, REMOVE "DEF" FROM EMACS MODE LINE. + SETZM TYISNK + SETZM TYISRC +IFN ITS,.IOT CHECHO,[^G] +IFN TNX,[SAVE A + MOVEI A,^G + PBOUT + REST A] + JRST FSECO6 + +FGCMDP: JUMPE C,CPOPJ ;THERE WS NO ERROR => DON'T PRINT ERROR MESSAGE. + TRZE FF,FRCLN + CALL [ SKIPN ERRECH + JRST DISTOT + SKIPGE PJATY ;IF SCREEN MUST BE REDISPLAYED, CLEAR IT NOW RATHER THAN + CALL DISIN0 ;AFTER THE ERROR MESSAGE IS PRINTED. + MOVEI CH,^M + JRST FSECO1] + MOVE D,VERBOS +FGCMD3: HRRZM P,ERRFL1 ;DON'T LET FS ERRFLG$ STOP THIS FROM PRINTING. + MOVEI A,TYOA + SKIPE ERRECH ;IF SPECIFIED, TYPE IN ECHO AREA. + MOVEI A,FSECO1 + HRRM A,LISTF5 + CALL FGCMD1 + MOVEI CH,"? + CALL @LISTF5 + SKIPE ERRECH + RET + CALL DISFLS + MOVE E,TOPLIN + SUB E,CHCTVP ;HOW MANY LINES WERE USED? + SOS E + MOVEM E,ERRFL1 ;MAKE SURE THOSE LINES AREN'T ERASED BY REDISPLAY. + RET + +FGCMD1: MOVE A,C ;PRINT CONTENTS OF STRING IN C. + CALL QLGET0 + RET +FGCMD2: JUMPE B,CPOPJ + ILDB CH,BP + CAIN CH,^I ;IF D IS ZERO, STOP AT FIRST TAB. + JUMPE D,CPOPJ + CALL @LISTF5 + SOJA B,FGCMD2 + +;HANDLE TOP-LEVEL ^X COMMAND: PRINT THE FULL EROR MESSAGE FOR THE LAST ERROR. +FECMD8: MOVE C,LASTER + SETO D, + JRST FGCMD3 + +;COME HERE TO REPORT SYSTEM CALL ERROR, ASSUMING THE FILE NAMES ARE IN DEFDEV, ETC. +IFN ITS,[ +OPNER1: .SUSET [.RBCHN,,CH] ;GET # OF CHANNEL IN ERROR, + LSH CH,27 + IOR CH,[.STATUS CH] + XCT CH ;READ THE ERROR CODE, + LDB CH,[220600,,CH] +OPNER4: SAVE CH ;ENTER HERE WITH ERRCODE IN RH(CH), TO PRETEND I.T.S GAVE AN ERROR. + HRLZS (P) + MOVEI C,70. ;WRITE A STRING CONTAINING FILENAMES AND I.T.S. ERROR MESSAGE. + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVSI E,'OPN + CALL SIXNTY ;FIRST IN THE STRING GOES "OPN" FOLLOWED BY 3-DIGIT ERROR CODE. + LDB CH,[.BP (700),(P)] + CALL DGPT + LDB CH,[.BP (70),(P)] + CALL DGPT + LDB CH,[.BP (7),(P)] + CALL DGPT + MOVEI CH,40 + REPEAT 2,XCT LISTF5 ;THEN 2 SPACES. + CALL LFILE ;THEN THE FILENAMES. + MOVEI CH,40 + REPEAT 3,XCT LISTF5 ;3 SPACES. + REST E + SYSCAL OPEN,[%CLIMM,,CHERRI ? ['ERR,,] ? %CLIMM,,3 ? E] + JRST .-1 +OPNER2: .IOT CHERRI,CH ;COPY INTO STRING, STOPPING AT CRLF OR FF. + CAIE CH,^M + CAIN CH,^L + JRST [.CLOSE CHERRI, + JRST OPNER3] + XCT LISTF5 + JRST OPNER2 +] + +IFN TNX,[ +OPNER0: MOVE A,OPNJFN + RLJFN + JFCL +OPNER1: TRZA FF,FRNOT ;PRINT DEFAULTS IN ERROR MESSAGE +OPNER2: TRO FF,FRNOT + MOVEI A,.FHSLF ;GET THIS FORKS LAST JSYS ERROR MESSAGE +IFN 10X,[MOVE C,[4,,BAKTAB+4] + BLT C,BAKTAB+10 ;GETER ON TENEX SMASHES 4-10 +] + GETER +IFN 10X,[MOVS C,[4,,BAKTAB+4] + BLT C,10 +] + CAIA +OPNER4: TRZ FF,FRNOT ;PRINT ERROR MESSAGE + PUSH P,2 ;ENTER HERE TO FAKE ERROR FROM 2 + MOVEI C,70. ;MAKE ENOUGH STRING SPACE + CALL QOPEN + MOVSI E,'OPN ;INSERT OPN + CALL SIXNTY + POP P,2 + LDB CH,[070100,,2] + CALL DGPT + LDB CH,[060300,,2] + CALL DGPT + LDB CH,[030300,,2] + CALL DGPT + LDB CH,[000300,,2] + CALL DGPT + MOVEI CH,40 ;AND TWO SPACES + REPEAT 2,XCT LISTF5 + TRZE FF,FRNOT ;PRINT FILENAME DEFAULTS? + JRST OPNER5 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT DEFAULTS + MOVEI CH,40 + REPEAT 3,XCT LISTF5 +OPNER5: MOVE A,[440700,,BAKTAB] + SETZ C, + ERSTR + JFCL + JFCL +IFN 10X,IDPB C,A ;STUPID 10X JSYS DOESNT MAKE ASCIZ + MOVEI A,BAKTAB + CALL ASCIND ;AND INSERT IT TOO +] +OPNER3: CALL QCLOSV ;NOW FINISH THE STRING'S HEADER, AND RETURN POINTER IN A. + MOVEM A,LASTER ;REMEMBER IT AS THE MOST RECENT ERROR'S CODE. + JRST DISTOE ;NOW GET CAUGHT BY ERRSET INVOKE ERROR HANDLER. + +;TYPR4 UUO (TYPRE MACRO) COMES HERE. +ETYP2A: HRRZ CH,@40 ;ERROR, AND IT CAN BE HANDLED NORMALLY; GET THE ERROR CODE. + HRLI CH,400000 + MOVEM CH,LASTER ;REMEMBER AS CODE OF MOST RECENT ERROR. + JRST DISTOE ;GET CAUGHT BY ERRSET OR POP. + +IMMQIT: SETOM IMQUIT ;ALLOW QUITS TO HAPPEN AT ANY TIME, + SKIPL STOPF ;AND QUIT IF ALREADY PENDING. + RET +QUIT0: ;CALL HERE IF STOPF IS SET, WHEN IT IS ACCEPTABLE TO QUIT. +QUIT1: SETZM ORESET ;RE-ALLOW TYPEOUT NOW THAT WE GOT THRU WITH THE COMMAND + SKIPLE NOQUIT + SKIPLE IMQUIT + CAIA ;NOQUIT POSITIVE => NO QUITTING AT ALL (UNLESS IMQUIT OVERRIDES) + RET + SETZM STOPF ;ELSE QUIT, AND CLEAR FLAG SAYING WE NEED TO QUIT. +IFN 20X,[MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] + CALL DISRST ;THROW AWAY ANYTHING IN DISBUF. + SKIPG IMQUIT ;IMQUIT POSITIVE ONLY AT STARTUP AND IN COMMAND READER + SKIPN NOQUIT ;IF QUITTING SHOULD GO TO TOP LEVEL, DO SO. + CAIA + TYPRE [QIT] ;NOQUIT NEGATIVE WANTS TO SIGNAL AN ERROR. + CIS ;CLEAR ANY INTERRUPTS IN PROGRESS. + SETOM RROVPO + CALL TYPBEL + SETZM ECHACT +IFN ITS,[.IOT CHECHO,["^] + .IOT CHECHO,["G] +] +IFN TNX,[MOVEI CH,"^ + CALL ECHOC1 + MOVEI CH,"G + CALL ECHOC1 +] + JRST GOX1 + +DELQIT: SETZM IMQUIT ;STOP ALLOWING QUITS INSIDE COMMANDS, AND EXIT. + RET + +;CALL HERE TO SIGNAL AN ERROR, AFTER SETTING LASTER. +;DISTOE RETURNS TO AN ERRSET IF THERE IS ONE; OTHERWISE, IT GOES TO +;GOX1 TO ENTER A BREAK LOOP, INVOKE THE ERROR HANDLER, OR POP TO ^R OR TOP LVL. +DISTOE: MOVE Q,PT ;ERROR CHECK: IS PT OUT OF BUFFER BOUNDS? + CAMG Q,ZV + CAMGE Q,BEGV + .VALUE + TRNN P,-1 + .VALUE + CIS + SKIPL ERRFLG ;WERE WE ALREADY INVOLVED IN STARTING TO HANDLE AN ERROR? + JRST DISTOW + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P ;YES; GIVE UP TRYING TO RECOVER AND POP ALL THE WAY UP, + PUSHJ CH,SETP ;SINCE TRYING TO HANDLE THIS ERROR NORMALLY WILL PROBABLY + ;CAUSE ANOTHER ERROR. + SETZM ERRFL1 ;PREVENT TYPEOUT OF THE MESSAGE FROM BEING SUPPRESSED. + CALL DISTOT + MOVEI CH,TYOA + HRRM CH,LISTF5 ;NOT CAUGHT BY ERRSET, PREPARE FOR TYPEOUT. + MOVEI A,[ASCIZ/ERROR WHILE ENTERING ERROR HANDLER! POPPING TO TOP LEVEL. +/] + CALL ASCIND + CALL ERESET + JRST CTLW + +DISTOW: SETOM ERRFLG + CALL ERESET + HLRZ Q,ITRPTR + JUMPE Q,GOX1 ;IF WITHIN AN ERRSET + MOVE CH,MFMACP-MFBLEN+1(Q) + TLNE CH,MFERS1 ;WHICH IS NOT REALLY AN ERROR CATCH (:@< ... >), + JRST GOX1 + HLRZ CH,MFPF-MFBLEN+1(Q) + HRRZ A,DISPRR ;AND WHICH HAS NO ^R INSIDE IT + SKIPE A + CAIG A,(CH) + JRST ERRP3 ;THEN THROW TO THE ERRSET. + JRST GOX1 ;ELSE GIVE TO THE ^R OR TO ERROR HANDLER. + +;COME WHEN ERROR IS CAUGHT BY ERRSET. +ERRP3: CALL UNWIND ;POP SOME STUFF OF MACRO PDL, ETC. + JRST ERRP4 ;DOESN'T SKIP IF HAVE FINISHED UNWINDING; CH = RH(ITRPTR) + JRST ERRP3 ;SKIPS 1 AFTER POPPING MACRO CALLED BY "M" CMD. + MOVE CH,MACXP + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SKIPS 2 AFTER POPPING A MACXQ OR MACXCW. + JRST ERRP3 + +ERRP4: HRROI Q,MFCSTR-MFBLEN+1(CH) + POP Q,CSTR ;POSITION AT THE FRONT OF THE ERRSET + POP Q,CPTR + POP Q,COMCNT + JRST INCMA0 ;THEN SEARCH FOR THE >. + +;CLEAN UP WHEN ERROR OR QUIT HAPPENS, IN CASE VARIABLES WERE SCREWED. +;THIS STUFF DONE REGARDLESS OF WHETHER ERROR WAS CAUGHT BY ERRSET. +ERESET: SETOM INSBP + SETZM DISFLF + SETZM IMQUIT + SETZM INSINP + SETZM INSBP + SETZM TRCOUT + SETZM BRC1 + SETZM SLPNCR + SETZM YANKMT +IFN ITS,.CLOSE CHRAND, ;IN CASE WE QUIT OUT OF READING FILE DIR. + MOVE A,QRB.. ;MAKE SURE BFRPTR AND BFRSTR AGREE WITH ..O. + MOVE C,.QBUFR(A) ;A PDL OVERFLOW IN CERTAIN PLACES CAN CONFUSE THEM. + JRST BFRSET + +;FS ERR THROW - THROW TO INNERMOST ERROR-CATCHING COMMAND LOOP. +;IT CAN BE EITHER A TECO COMMAND LOOP, A ^R, OR AN ERROR CATCH (:@< ... >). +FSERTH: HLRZ Q,ITRPTR + JUMPE Q,FSERT1 ;IF WITHIN AN ERRSET + MOVE CH,MFMACP-MFBLEN+1(Q) + TLNN CH,MFERS1 ;WHICH IS REALLY AN ERROR CATCH (:@< ... >), + JRST FSERT1 + HLRZ CH,MFPF-MFBLEN+1(Q) + HRRZ A,DISPRR ;AND WHICH HAS NO ^R INSIDE IT + SKIPE A + CAIG A,(CH) + JRST [ ;THEN THROW TO THE ERROR CATCH. + MOVEM C,LASTER ;MAKE IT RETURN FS ERR THROW'S ARG. + SETOM ERRFLG + JRST ERRP3] +FSERT1: SKIPN A,DISPRR ;OTHERWISE, IF INSIDE A ^R, RETURN TO THAT ^R. + JRST GO + TRZ FF,FRARG+FRARG2 + SKIPE MACXP + CAML A,MACXP ;IF DON'T WANT A BREAK LOOP AND INSIDE A ^R, RETURN TO THAT ^R. + JRST [SETZM RREBEG + JRST RRTHRW] ;HOW TO DO IT DEPENDS ON WHETHER WE CALLED ANY MACROS FROM IT. + JRST FSCRTH + +;TRY TO UNWIND MACRO PDL AND ITERATIONS UNTIL REACH INNERMOST ERRSET. +;DON'T SKIP IF REACH THERE. SKIP 1 IF POP AN ORDINARY MACR (IN WHICH CASE +;UNWINDING ISN'T FINISHED). SKIP 2 AFTER POPPING A MACRO CALLED +;BY A MACXQ. +UNWIND: HRRO A,ITRPTR ;FIND INNERMOST ERRSET OR ITERATION, + SKIPN ITRPTR ;[ ;IF NO ITERATION, POP ANY MACRO OR ^]^X. + SKIPA CH,[400,,MACPDL-1] + MOVE CH,MFMACP-MFBLEN+1(A) + TLZ CH,40 + CAMN CH,MACPDP ;[ ;ANY MACRO OR ^]^X CALLS INSIDE IT => POP THEM. + JRST UNWINI ;ELSE HANDLE THE ERRSET OR ITERATION. +UNWINM: LDB CH,MACPDP ;[ ;IS IT A MACRO? OR A ^]^X? + CAIN CH,10 + JRST UNWIN2 ;IT'S A NULL, THROW IT AWAY. + TRNE CH,10 + JRST UNWIN1 ;[ ;IT'S A ^]^X. + SKIPN MACPTR + .VALUE ;MACPDP AND MACPTR OUT OF PHASE?? + CALL DECDCH ;IT'S A MACRO CALL, RESTORE SQUOTP, ETC. + CALL POPMAC ;POP STRING PTR, ETC. + AOS (P) ;SKIP 1 OR 2 DEPENDING. + SKIPGE MACPTR + AOS (P) + JRST POPMP + +UNWIN1: CALL DECDCH ;[ ;POP A ^]^X. + CALL POPCTX + CALL PUSMAC +UNWIN2: CALL POPMP + JRST UNWIND + +UNWINI: SKIPN ITRPTR ;TRYING TO UNWIND WHEN NO ITERATION OR MACRO => + .VALUE ;UNWIND'S CALLER'S END TEST FAILED. + HLRZ CH,ITRPTR ;IS THIS AN ERRSET OR AN ITERATION? + CAIN CH,(A) + RET ;REACHED AN ERRSET. + CALL ITRPOP ;AN ITERATION - POP IT + JRST UNWIND ;AND LOOK AT THE NEXT ONE OUT. + +;FS ^R EXIT - WITHIN A MACRO CALLED FROM ^R, RETURN FROM THE ^R. +;FS ^R THROW - WITHIN A MACRO CALLED FROM ^R, RETURN TO ^R. +FSCREX: SKIPA Q,[FSCRE1,,MEXIT1] +FSCRTH: MOVE Q,[FSCRT1,,MEXIT1] + SKIPN DISPRR ;NOT INSIDE ^R => ERROR. + TYPRE [N%R] + JRST MEXIT1 + +;FS BACK RETURN$: RETURN TO A SPECIFIED FRAME (SPECIFIED A LA FS BACK ARGS$). +FSBKRT: CALL BACKTR ;A GETS A POINTER TO THE FRAME TO RETURN TO. + MOVE Q,[FSBKR2,,FSBKR1] + SOS A ;REMEMBER ADDR OF FRAME (MINUS 1, + MOVEM A,GCTAB ; AS IT WILL BE WHEN ON THE FREELIST). + JRST MEXIT1 + +FSBKR1: SKIPA B,[CD5A] ;AFTER POPPING A MACRO FRAME, B GETS HOW TO RETURN +FSBKR2: MOVEI B,CPOPJ ;TO THAT FRAME, DEPENDING ON WHETHER IT WAS A MACXQ. + MOVE A,GCTAB + CAME A,MFFREE ;IF THE FRAME JUST POPPED INTO AND FREED WAS THE RIGHT ONE, + JRST MEXIT1 ;RETURN TO IT. ELSE, KEEP POPPING. + JRST (B) + +;^\ - IN A MACRO, RETURN FROM IT, POPPING QREGS AND ITERATIONS. +;:^\ DOESN'T POP QREGS. +MEXIT: SKIPN MACPTR + TYPRE [NIM] ;"EXIT MACRO" IF NOT INSIDE ONE? + MOVE Q,[CPOPJ,,CD5A] +;RH(Q) HAS WHERE TO GO AFTER POPPING A MACRO CALLED BY "M". +;LH(Q) HAS WHERE TO GO AFTER POPPING A MACXQ. +MEXIT1: MOVE C,MACSPF ;PLACE TO POP TO. + TRZN FF,FRCLN ;POP THE QREG PDL UNLESS :^\. + JRST [ SAVE Q + CALL FSQPU0 + REST Q + JRST .+1] +MEXIT2: CALL UNWIND ;POP A MACRO OR ITERATION. + JRST [ CALL ITRPOP ;HERE IF ENCOUNTER AN ERRSET. + JRST MEXIT2] + JRST (Q) ;POPPED AN ORDINARY MACRO. + MOVE CH,MACXP ;POPPED A MACRO CALLED BY A MACXQ. + POP CH,MACXP + POP CH,MACPTR + PUSHJ CH,SETP1 ;SET P FROM CH, UNWIND STUFF, THEN POPJ P, + HLRZ CH,Q + JRST (CH) + +FSCRE1: SKIPA C,[RREXI0] +FSCRT1: MOVEI C,RRTHRW + SKIPE A,MACXP ;WE HAVE JUST POPPED THE MACRO CALLED FROM ^R, IF + CAMG A,DISPRR ;THE NEXT POSSIBLE CANDIDATE MACRO FRAME + JRST (C) ;IS TOO FAR OUT ON THE CONTROL STACK. + JRST MEXIT1 ;NO, POP THE INNERMOST MACRO AGAIN. + +SUBTTL QUIT/ERROR REINITIALIZATION + +;COME HERE ON INITIALIZATION, QUIT, AND ^W COMMAND. +CTLW: SETOM GOXFLS ;POP TO TOP LEVEL; DON'T INVOKE ERROR HANDLER OR MAKE BREAK LOOP + +;COME HERE ON ERROR. +;IMQUIT IS POSITIVE IF WE QUIT OUT OF LIS (TECO COMMAND READER). IT MEANS + ;WE SHOULD STAY IN THE COMMAND LEVEL THAT WAS CALLING LIS. +;OTHERWISE, IF $QERRH (Q..P) IS NONZERO, IT IS THE ERROR HANDLER MACRO TO CALL. +;OTHERWISE, IF UNWINF (FS*RSET$) IS NONZERO, CREATE A BREAK LOOP. +GOX1: SKIPN CH,LEV ;COMPUTE THE PDL LEVEL AT THE INNERMOST + MOVE CH,[-LPDL,,PDL-1] + SKIPN Q,MACXP ;INVOCATION OF THE COMMAND LOOP OR ^R. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q ;NAMELY, MUST BE INSIDE ALL OPEN-PARENS, + MOVE CH,Q ;INSIDE ALL MACXQ'S, ABOVE BOTTOM OF STACK, + SKIPN Q,DISPRR ;AND ABOVE DISPRR. + MOVE Q,[-LPDL,,PDL-1] + CAMGE CH,Q + MOVE CH,Q + SKIPGE GOXFLS ;MAYBE WE HAVE BEEN RQ'D TO POP ALL THE WAY TO TOP. + MOVE CH,[-LPDL,,PDL-1] + CAME P,CH ;MUSTN'T PUSHJ CH, IF CH=P, SINCE RET. ADDR WOULD BE UNPROTECTED + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING SOME STUFF; THEN POPJ P, + SKIPL TYOFLG ;IF TYPEOUT IN PROGRESS, FORCE IT OUT. + CALL DISFLS + SETZM CTLCF + SKIPE CPTR + CALL ERRP2 ;MARK THE CURRENT PC FOR "?" TO DISPLAY. + MOVE C,IMQUIT + SETZM IMQUIT + MOVE TT,BEG + SKIPN E,RREBEG ;MUSTN'T RUN OUTSIDE ^R WITH RREBEG ZERO. + MOVEM TT,RREBEG + SKIPL ERRFLG + SETZM LASTER ;IF NO ERROR, MAKE SURE FS ERROR IS 0. + HRRZM P,ERRFL1 ;AS YET, NO ERROR MESSAGE PRINTED (THOUGH MAY CHANGE) + SKIPN GOXFLS ;IF WE'RE POPPING TO TOP, DON'T PUSH NOW. + SKIPLE C ;IF THIS IS TECO STARTUP, OR QUIT OUT OF COMMAND READER, + JRST GOX4 ;THERE'S REALLY NOTHING TO PUSH NOW. + SKIPN UNWINF ;ENTER BREAK LOOP? + SKIPE $QERRH ;OR HAVE AN ERROR HANDLER? + CAIA + JRST GOX4 ;NEITHER; NO NEED TO PUSH. + JUMPN E,GOX5 ;IF ERROR OCCURRED ACTUALLY INSIDE ^R (NOT WITHIN A MACRO) + SAVE [[ MOVE P,DISPRR + REST A + JRST RRLP]] ;THEN SIMULATE A MACXQ CALL WHICH, WHEN RETURNED FROM, WILL + SAVE MACPTR ;RETURN TO ^R. + SAVE MACXP + SETOM MACPTR + MOVEM P,MACXP +GOX5: JSP T,OPEN1 ;NOW PUSH VALUES + CALL PUSMAC ;AND THE CURRENT MACRO (THAT ERRED). + CALL FLGENC ;ENCODE AND SAVE SQUOTP AND RCHALT + IDPB CH,MACPDP + MOVE CH,PF ;REMEMBER THE QREG PDL LEVEL ON ENTRY TO THE ERROR HANDLER. + MOVEM CH,MACSPF + SETZM SQUOTP + CALL GOCPY ;IF CBUF IS ON MACRO PDL, COPY IT TO A STRING + ;SINCE CBUF IS LIKELY TO BE OVERWRITTEN NOW. + SKIPE A,$QERRH ;IF THE USER HAS AN ERROR HANDLER, GO TO IT. + JRST [ TRO FF,FRCLN ;WE ALREADY PUSHED THE ERRING MACRO; NO NEED TO PUSH AGAIN. + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + JRST MAC5] ;NOW RUN THE ERROR HANDLER. +GOX4: TRO FF,FRARG\FRCLN\FRUPRW + SKIPGE GOXFLS ;GOXFLS AND ERRFLG IMPLY THIS IS "ERROR ENTERING ERROR HANDLER" + TRZ FF,FRCLN ;SO DON'T OVERWRITE THAT LINE WITH THE ERROR MSG. + SKIPE C,LASTER ;NO USER ERROR-HANDLER, SO IF RESPONDING TO AN ERROR, + CALL FGCMD ;PRINT STANDARD ERROR MESSAGE, FLUSH TYPEAHEAD, AND TYPE A BELL. + SETOM UNRCHC ;IF WE ARE ^G-QUITTING BACK TO TECO CMD LOOP, FLUSH THE ^G. + SETZM TYISRC + SETZM TYISNK + SETOM TYOFLG ;FORCE TYPEOUT TO RE-INIT. + SKIPN RGETTY + CALL CRR + SETZM ERRFLG ;ERROR PROCESSING NOW FINISHED. + SKIPE UNWINF ;IF *RSET IS ON, ENTER A COMMAND LOOP. + JRST GO + JRST FSERTH ;OTHERWISE EXIT TO SOME SORT OF COMMAND LOOP. + +;ALTMODE AS COMMAND. +ALTCMD: SKIPGE NOOPAL ;FS NOOPALT NEGATIVE => IGNORE ALTMODE. + JRST CD5 + SKIPN NOOPAL ;POSITIVE => ALTMODE IS LIKE ^_. + TYPRE [DCD] ;ERROR IN MACROS, IGNORE AT TOP LEVEL. +LGOGO: + ;COME HERE WHEN EXECUTE ^_, PERHAPS ALTMODE. + CALL FLSOUT ;EMPTY OUTPUT BUFFER INTO OUTPUT FILE. +IFN ITS,[ + .SUSET [.RJNAM,,A] + CAME A,['HACTRN] + .LOGOUT +] + AOSN CTLCF ;IF READ ^C, + CALL FSEXI1 ;RETURN TO DDT. + HRRZM P,ERRFL1 +GO: MOVE A,GOXFLS ;IF WE'RE REQUESTED TO POP ALL THE WAY + SETZM GOXFLS + SKIPE UNWINF ;OR NOT IN *RSET MODE, + JUMPGE A,GO2 + MOVE CH,[-LPDL,,PDL-1] + CAME CH,P + PUSHJ CH,SETP ;SET P FROM CH, UNWINDING OUT OF ^R OR SORT OR PARENS. + SETZM MACXP + SETZM NOQUIT + SETZM MACPTR + SETZM MACDEP + SETZM CTXPTR + SETZM ITRPTR + MOVE A,[400,,MACPDL-1] + MOVEM A,MACPDP + MOVEI A,MFSTRT-1 ;NOW PUT ALL CELLS ON THE FREE LIST. + SETZM MFFREE + MOVE B,MFEND +GO1: SKIPL MFBEG+1(A) .SEE MFBFR ;FREE ALL MACRO FRAMES, EXCEPT THOSE OF BUFFERS. + CALL FLSFRM ;FREE IT. + ADDI A,MFBLEN + CAIGE A,-1(B) + JRST GO1 + MOVE C,PFINI ;UNWIND QREG PDL. + CALL FSQPU0 +GO2: MOVEI A,(JFCL) + HRLM A,RCHALT + SETZM SQUOTP + SETZM MACBTS ;THERE ARE NO MACRO ARGS IN TOP-LEVEL CMD STRING. + CALL FLSCM1 ;FLUSH SOME CORE, AND FORCE OUT OUTPUT BUFFER. + SKIPL TYOFLG ;FORCE ALL TYPEOUT TO BE PRINTED. + CALL DISFLS + SETZM IMQUIT + SKIPN ECHOFL + CALL SETTTM ;TURN ECHOING BACK ON IF NECESSARY. + SKIPE MORFLF ;IF PREVIOUS COMMAND FLUSHED, + SETOM TYOFLG ;NEXT TYPEOUT WILL REINIT AND UN-FLUSH. + SETZM MORFLF + MOVE C,QRB.. + MOVE C,.QPT1(C) ;GET WHAT . WAS WHEN LAST CMD STRING STARTED. + CALL FSPSPT ;PUSH ON . RING BUFFER. + MOVE CH,QRB.. ;MACRO ..L IF THAT'S APPROPRIATE. + MOVE A,.QRSTR(CH) + AOSN INITF1 + JUMPN A,GOXX + CALL VIEW2 ;NOW GO TRY TO DISPLAY DIR. OR BUFFER. + JRST LIS + +GOXX: TRO FF,FRCLN ;DO A :M TO ..L, MAKING IT THE TOP LEVEL MACRO FRAME + JRST MAC5 ;LEAVING MACPDL EMPTY. + +;FIND THE MACRO FRAME THAT IS EXECUTING OUT OF CBUF, COPY THE CONTENTS +;OF CBUF INTO A STRING, AND MAKE THE MACRO FRAME POINT TO THAT STRING INSTEAD. +;THE GOAL IS TO FREE UP CBUF FOR RE-USE WHEN COMMAND READER IS ENTERED +;IN A BREAK LOOP. +;DOESN'T PROMISE TO RPESERVE ANY ACS. +GOCPY: MOVEI A,MFSTRT +GOCPY1: SKIPGE MFBEG(A) .SEE MFBFR ;DONT CONSIDER BUFFER FRAMES. + JRST GOCPY2 + HRRZ C,MFCPTR(A) ;WHERE DOES B.P. OF MACRO FRAME POINT? + JUMPE C,GOCPY2 ;IGNORE FREE CELLS; THERE MAY BE SOME -> CBUF. + CAIL C,@CBUFLO + CAIL C,@CBUFH + JRST GOCPY2 + JRST GOCPY3 ;CPTR OF THIS FRAME POINTS WITHIN CBUF! + +GOCPY2: ADDI A,MFBLEN + CAMGE A,MFEND ;SCAN ALL FRAMES. + JRST GOCPY1 + RET ;NO FRAME POINTS IN CBUF - NO COPYING NEED BE DONE. + +GOCPY3: HRRZ E,CBMAX ;HOW LONG IS USED PART OF CBUF? + MOVEI C,4(E) ;GET THAT MUCH SPACE, PLUS SOME FOR STRING HEADER + CALL SLPQGT + MOVEI B,QRSTR + MOVEI C,4(E) + CALL QHDRW1 ;WRITE HEADER OF STRING; B.P. RETURNED IN BP TO IDPB TEXT. + MOVE C,E + MOVE IN,CBUFLO ;AND GET B.P. TO ILDB TEXT TO COPY. +GOCPY4: ILDB CH,IN + IDPB CH,BP + SOJG C,GOCPY4 + MOVE BP,QRWRT + SUB BP,QRBUF + TLO BP,400000 + MOVEM BP,MFCSTR(A) ;STORE STRING POINTER TO NEWLY CONSTRUCTED STRING IN MACRO FRAME. + MOVEI BP,4(E) + ADDB BP,QRWRT ;CLOSE THE FINISHED STRING; ET CHAR ADDR 1 + LAST CHAR. + SUB BP,MFCCNT(A) ;GET NEW CHAR ADDR OF CHAR CPTR SHOULD ILDB NEXT + CALL GETIBP ;AND SET UP CPTR -> SAME CHARACTER IN ITS NEW HOME. + MOVEM BP,MFCPTR(A) + RET + +SUBTTL F? COMMAND + +;F? COMMAND - MBOX CONTROL. +;ARGUMENT IS BIT-DECODED. NO ARG, OR ARG=0, IMPLIES ARG=30 . +;BIT 1.1 - CLOSE GAP. MAY BE NEEDED FOR COMMUNICATION WITH OTHER PROGRAMS +; THAT DON'T UNDERSTAND THE GAP. +;BIT 1.2 - GC STRING SPACE. USEFUL BEFORE DUMPING OUT OR IF IT IS SUSPECTED +; MANY STRINGS HAVE RECENTLY BEEN DISCARDED. +;BIT 1.3 - SWEEP THE JUMP CACHE. NECESSARY IF A STRING'S CONTENTS HAVE BEEN +; ALTERED BY THE F^E COMMAND, AND IT IS A MACRO THAT MIGHT +; HAVE CONTAINED "O" COMMANDS. +;BIT 1.4 - FLUSH UNOCCUPIED CORE. GOOD TO DO EVERY SO OFTEN, OR IF IT IS +; LIKELY THE BUFFER HAS JUST SHRUNK. +;BIT 1.5 - CLOSE THE GAP, IF IT IS > 5000 CHARACTERS. GOOD TO DO EVERY SO +; OFTEN, IN CASE USER DELETES LARGE AMOUNTS OF TEXT; SAY, +; WHENEVER EXCESS CORE IS FLUSHED. +FLSCMD: ARGDFL + SKIPE C + TRNN FF,FRARG ;NO ARG SAME AS ARG OF 30. +FLSCM1: MOVEI C,30 + HRLM C,(P) + CALL FLSOUT ;FIRST, FORCE OUT OUTPOUT BUFFER. + HLRZ C,(P) + MOVE A,EXTRAC + TRNE C,20 + CAIG A,5000 ;"20" BIT MEANS CLOSE GAP IF VERY LARGE. + TRNE C,1 ;"1" BIT MEANS CLOSE GAP IN ANY CASE. + CALL SLPSHT + TRNE C,2 ;IF "2" BIT IS SET IN ARG, DO A GC, + JRST GCC ;THAT INCLUDES FLUSHING CORE AND SWEEPING CACHE. + TRNN C,4 ;"4" BIT MEANS SWEEP JUMP CACHE. + JRST FLSCM2 + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 +FLSCM2: TRNN C,10 ;"10" BIT MEANS FLUSH UNUSED CORE. + RET +FLSCOR: JSR SAVABC + MOVE A,BFRTOP ;OTHERWISE JUST FLUSH CORE. + CAMN A,BFRBOT ;DON'T FLUSH ALL PAGES, ELSE THE + ADDI A,1 ;GAP BETWEEN IMPURE STRINGS AND BUFFER WOULD FILL UP. + ADDI A,2000*5-1 + IDIVI A,5*2000 ;A_ # PAGES WE'RE REALLY USING. + MOVE C,MEMT ;C_ # OF LAST PAGE WE HAVE. + SUBM A,C ;C HAS -<# PAGES TO FLUSH> + JUMPE C,POPCBA + MOVE J,A +IFN ITS,[ + HRLM C,A ;A HAS AOBJN -> PAGES TO BE FLUSHED. + SKIPGE A ;WE'RE TRYING TO CORE UP??? + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A] + .VALUE +] +IFN TNX,[ + MOVEI B,(A) ;FIRST BLOCK TO DO + ASH B,1 ;MAKE A PAGE NUMBER + HRLI B,.FHSLF + SETO A, ;SAY UNMAP + ASH C,1 +IFN 20X,[MOVM C,C ;NUMBER OF PAGES + HRLI C,(PM%CNT) + PMAP ;UNMAP THEM +] +IFN 10X,[PMAP ;TENEX -- NO MULTIPLE PMAPS + AOJGE C,.+2 + AOJA B,.-2 +]] + MOVEM J,MEMT ;UPDATE # OF FIRST K OF NXM. + JRST POPCBA + +SUBTTL TECO COMMAND STRING READER + +LISCRF: CALL ECHOCR +LIS: HRRZM P,IMQUIT ;^G DURING TYPEIN QUITS IMMEDIATELY. + SETZM NOQUIT + SKIPGE STOPF ;PERFORM ANY PENDING QUIT. + CALL QUIT0 + SKIPN ECHOFL + CALL SETTTM ;MAKE SURE ECHOING IS ON. + SETZM RCHSFF + .I CASE=CASNRM ;REINIT THE INPUT CASE. + TTYACT ;TO SET "ACTIVATE ON NEXT CHAR REGARDLESS" AGAIN + CALL VBDACU + JFCL + SETZM CTLBRF + MOVE C,QRB.. + SETZM .QVWFL(C) + MOVE B,CBUFLO ;BP TO BEFORE CMD BUFF. + MOVE TT,CBMAX ;WAS THE PREVIOUS CMD STRING A LONG ONE? + CAIGE TT,10. + JRST LISSRT ;NO, IT WAS SHORT. + MOVEM TT,SAVCMX ;YES, THIS IS CMD STRING FOR ^Y TO INSERT. + MOVEI TT,SAVCW1-1 ;SO SAVE INFO ON IT SO SHORT CMDS + PUSH TT,1(B) ;WON'T CLOBBER THE BEGINNING OF IT. + PUSH TT,2(B) + PUSH TT,3(B) + .I SAVCPT=CPTR +LISSRT: SETZM CBMAX ;CBMAX COUNTS CHARS IN CMD STRING BEING READ IN + SETZM COMCNT + MOVEM B,CPTR ;INIT CPTR FOR EXECUTION OF THE CMD STRING + MOVEM B,CSTR + MOVE C,CBUFH + ;HANDLE ":TECO FOO BAR" FROM DDT + SKIPGE CMFLFL ;READING FROM INIT FILE => GO YANK AND XCT IT. + JRST LISINI +LI1: SKIPE RGETTY ;IF NO DISPLAY, + JRST LILUP + SKIPE CH,PROMCH ;PROMPT UNLESS PROMPTING DISABLED. + CALL TYANOW +;FALLS THROUGH TO READ THE FIRST CHARACTER. + +;FALLS THROUGH. +;LOOP AFTER HANDLING A CHAR OTHER THAN ALTMODE. +LILUP: TRZ FF,FRALT ;SAY THE PRECEDING CHAR WASN'T ALTMODE. +LI2: MOVE C,CBUFH + CAILE C,(B) ;LOOP BACK HERE AFTER ALTMODE, WITH FRALT SET. + JRST LI3 + ADDI C,100 ;IF WE'VE FILLED THE COMMAND BUFFER, MAKE IT BIGGER. + SAVE C + MOVEI C,500 ;MAKE SURE WHEN IMPURE STRING SPACE IS MOVED UP + CALL SLPQGT ;IT WON'T REACH BUFFER SPACE. + REST C + MOVE E,QRWRT ;LAST WD TO MOVE UP IS LAST IN IMPURE STRING SPACE. + IDIVI E,5 + MOVE J,QRBUF + IDIVI J,5 + SUBM E,J + MOVE CH,(E) + MOVEM CH,100(E) + SOS E + SOJGE J,.-3 + MOVEI T,500 + ADDM T,QRBUF + ADDM T,QRWRT +LI3: MOVEM C,CBUFH + SETZM CTLCF + CALL TYI ;READ CHARACTER FROM TERMINAL. + CALL TYINRM + MOVEI TT,^J ;PRETEND THAT EVERY CR IS FOLLOWED BY A LF. + CAIN CH,^M + MOVEM TT,UNRCHC + SKIPL CTLBRF ;[ ;LET ^]^Q QUOTE A ^C +IFN ITS, CAIE CH,^C +IFN TNX, CAIE CH,^Z ;^C IMPLIES GO + JRST LI3Z + SETOM CTLCF ;BACK TO DDT IF FINISH COMMAND STRING WITHOUT ERROR. + JRST LISEOF ;IT ALSO TERMINATES THE COMMAND STRING. + +LI3Z: CAME B,CBUFLO ;IF THIS IS 1ST CHAR, SOME CHARS ARE SPECIAL. + JRST LI3D1 ;NO, NORMAL. + JRST LISFST + +;COME HERE AFTER READING A CHAR, WHEN THE CMD BUFFER IS EMPTY. +LISFST: CAIN CH,^R + JRST RRIMMD +IFN CTRLT,[ + CAIN CH,^T + JRST EDIT +] + CAIN CH,^U ;^U => DISPLAY FILE DIR USING USER'S MACRO. + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) + TLO FF,FLDIRDPY + SETZM IMQUIT + JRST GO] + CAIN CH,^V + JRST [ MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + CALL POPPT ;POP . RING BUFFER. + JFCL + MOVE CH,QRB.. + MOVEM A,.QPT1(CH) ;PREVENT AUTOMATIC RE-PUSH. + JRST GO] + CAIN CH,^X + SKIPN LASTER + CAIA + JRST [CALL FECMD8 ? JRST GO] + CAIN CH,^Y + JRST LISCY + TRNN FF,FRQMRK + JRST LI3D1 + CAIN CH,"? + JRST ERRTYP +LI3D1: PUSHJ P,CKCH + JRST LISCRF ;RUBOUT ON AN EMPTY BUFFER. + JRST [SETZM CTLBRF ? JRST LILUP] ;A CHAR WAS RUBBED. +LISTOR: AOS CBMAX + IDPB CH,B + AOSE CTLBRF ;[[ ;WAS THIS CHAR PRECEDED BY ^] OR ^]^Q? + JRST LISBR1 ;NO. + CAIN CH,^Q ;YES, ^Q=> NEXT CHAR ALSO QUOTED. +LISBRC: SETOM CTLBRF + JRST LILUP ;[ ;QUOTED ^] AND ALTMODE AREN'T SPECIAL. + + ;[[ BRACKETS MUST BALANCE FOR CONDITIONALS. +LISBR1: CAIN CH,^] ;NOT QUOTED, ^] QUOTES NEXT CHAR. + JRST LISBRC + CAIE CH,ALTMOD ;ALTMODE => CHECK FOR ALT-ALT, MAYBE END STRING. + JRST LILUP + TRON FF,FRALT ;SAY JUST SAW AN ALTMODE, + JRST LI2 + JRST LISDUN ;PREV. CHAR ALSO ALTMODE => END STRING. + +CKCH: CAIE CH,177 + JRST POPJ2 ;OK CHAR - RETURN, SKIPPING TWO + CAMN B,CBUFLO + POPJ P, ;RUBBED TO BEGINNING - NO SKIP + LDB CH,B + PUSHJ P,FSECOR + DBP7 B + SOS CBMAX + JRST POPJ1 ;RUBBED ONE CHAR - RETURN, SKIPPING ONE + +;COME HERE ON ^C ON TTY. +LISEOF: MOVEI CH,ALTMOD ;DUMMY UP TWO ALTMODES. + IDPB CH,B + AOS CBMAX + IDPB CH,B + AOS CBMAX + +;COME HERE AFTER HANDLING AND STORING ALTMODE-ALTMODE +LISDUN: MOVEI CH,^_ ;^_ TO STOP EXECUTION OF CMD STRING. + IDPB CH,B + AOS TT,CBMAX + MOVEM TT,COMCNT + +;INITIALIZE RANDOM STUFF FOR ANOTHER CMD STRING. + SETZM IMQUIT + SETZM ERRFLG ;DON'T IGNORE 1ST LINE OF NEXT V-COMMAND. +IFN TNX,SETZM ECHOP ;NOT IN ECHO AREA ANY MORE + SKIPN RGETTY + PUSHJ P,CRR + TRZ FF,#FRTRACE + MOVE A,PT ;Q..I _ . . + SUB A,BEG + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW BUFFER DISPLAY. + MOVEM A,.QPT1(CH) ;PUT . INTO Q..I. + JRST CD + +POPJ2: AOS (P) +CPOPJ1: POPJ1: + AOS (P) + POPJ P, + +LISINI: CALL RRED1 ;INIT FILE OPEN ON CHFILI; PREPARE TO YANK IT. + MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS. + MOVEI A,[ASCIZ /^ Y :M(HFX*)/] + SETZM CMFLFL ;COMMAND FILE HAS BEEN HANDLED (ALMOST) + SETZM IMQUIT + CALL MACXCW ;XCT THAT STRING, TO YANK AND XCT THE INIT FILE. + JRST GO + +;CONTROL-Y WAS 1ST CHAR TYPED -- +; INSERT LAST COMMAND STRING INTO BUFFER, THEN REDISPLAY. +LISCY: MOVE CH,QRB.. + SETZM .QVWFL(CH) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^Y. + SETOM SQUOTP ;[ ;DON'T LET ^] EXPAND WHEN WE REREAD CMD STRING. + SETOM BRC1 + .I COMCNT=SAVCMX + HRROI TT,SAVCW3 ;RESTORE THE LAST LONG (>7 CHARS) CMD STRING + POP TT,3(B) ;.I <3RD WD OF CMD BUFFER>=SAVCW3 + POP TT,2(B) + POP TT,1(B) + MOVE B,SAVCPT + SETO OUT, + +LISCY1: CALL SKRCH ;READ CHAR FROM CMD STRING, DON'T TRACE. + MOVE C,COMCNT ;IF WE'VE REACHED THE $$^_ AT THE END, + CAIGE C,3 ;DON'T PUT THE $ IN THE BUFFER. + JRST [JUMPL OUT,GO ;IF CMD STRING WASN'T ALL READ, + MOVEM OUT,PT ;PUT PT AFTER LAST CHAR THAT WAS. + JRST GO] + CALL TYOMGS ;INSERT NEXT CHAR OF CMD STRING INTO BUFFER. + CAMN B,CPTR ;THE PTR SHOULD END UP AT THE POINT + MOVE OUT,PT ;COMMAND STRING READING STOPPED. + JRST LISCY1 + +;? WAS 1ST CHAR TYPED AFTER ERR MSG, RETYPE LAST FEW CHARS. +ERRTYP: HRRZM P,ERRFL1 ;DON'T LET ERRFL1 PREVENT OUR TYPEOUT FROM APPEARING. + MOVE B,ERR2 + MOVEI C,8*5 + SUBI B,8 + ILDB CH,B + CAMG C,ERR1 + PUSHJ P,TYO + CAME B,ERR2 + SOJA C,.-4 + JRST GO + +;MARK THE CURRENT MACRO PC FOR ERRTYP TO TYPE OUT. +ERRP2: MOVEI A,COMCNT + CALL MFBEGP ;C GETS CURRENT PC IN CHARS IN CURRENT MACRO. + TRO FF,FRQMRK + MOVEM C,ERR1 ;SAVE THAT, AND B.P. TO LAST CHAR READ. + MOVE A,CPTR + MOVEM A,ERR2 + RET + +SUBTTL ^R MODE + +;GET LENGTH CODE OF CHAR IN CH INTO A. +;SKIP IF NOT A CTL CHAR. NOTE THAT CALLING DISAD6 MAY BE +;EQUIVALENT TO DOING CALL .+1 . +DEFINE RRCHRG + SKIPE CASDIS ;IN -1F$ MODE, HANDLE SLASHIFICATION. + CALL DISAD6 + MOVEI A,(CH) + IDIVI A,6 + LDB A,RRCHBP(B) + CAIN CH,177 ;RUBOUT PRINTS AS ^? OR AS INTEGRAL SIGN, SO TREAT IT AS A CTL CHAR. + SKIPA A,[1] + CAIGE CH,40 +TERMIN + +;ENTRY FOR ^R 1ST CHAR TYPED IN CMD STRING. +RRIMMD: SAVE [GO] + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;ALLOW A BUFFER DISPLAY TO SHOW RESULTS OF ^R. + SETZM IMQUIT + +;^R EXECUTED AS A COMMAND. +RRENTR: .I CASE=CASNRM + TLZA FF,FLNOIN ;SAY INPUT IS ACCEPTIBLE. +;"^ V" COMMAND WITHIN A MACRO CALLED FROM ^R MODE COMES HERE. +RRNOIN: TLO FF,FLNOIN ;ENTRY TO DISPLAY ONCE AND RETURN, PROCESSING NO INPUT. + CALL RREARG ;PROCESS ARGS IF ANY, DECIDE WHAT REDISPLAY NEEDED. + ;ALSO MAKE SURE RRHPOS AND RRVPOS ARE REASONABLE. + SAVE FF ;REMEMBER WHETHER THIS IS ^R OR ^ V, FOR RREAR0. + SAVE PF ;SAVE QPDL PTR SO EXITING ^R CAN POP WHAT FS ^R ENTER PUSHES. + SAVE DISPRR + CALL [MOVEM P,DISPRR ;SET UP PDL RESTORATION POINT + RET] ;FOR ERRORS CAUGHT BY ^R. + JUMPL FF,RRNOI2 + SKIPE A,RRENTM + CALL RRMACR +RRNOI2::SETOM ECHCHR ;ENTERING ^R SHOULDN'T ECHO A COMMAND. @V SHOUDLN'T ECHO ONE. + TLNN FF,FLNOIN + SETOM RRLAST +;DROPS THROUGH. + +SUBTTL ^R MODE REDISPLAY + +;DROPS THROUGH. + +;MAIN LOOP OF ^R EDIT: ROUTINES DISPATCHED TO WILL POPJ TO HERE. +RRLP: CAIA + CALL RRTTY1 ;BUILT-IN COMMANDS SKIP TO "RETURN ONE VALUE", SO SCAN CURSOR MOTION. + CALL RRTTYE ;PRINTING TTY IN SCAN MODE, IF COMMAND DOESN'T TYPE OUT, ECHO IT. + SETZM STOPF + SETZM ORESET + JUMPL FF,RRLP6 ;THIS IS ^R AS OPPOSED TO ^V + CALL RRARGF ;THEN FLUSH ARGS IF COMMAND WASN'T AN ARG-SETTER. + SKIPN RRLAST ;AND IF THE LAST COMMAND WAS NOT AN ARG-SETTER, + JRST RRLP6B + MOVE CH,INCHCT ;THEN A COMMAND HAS JUST ENDED, SO SAVE FS TYI COUNT IN FS TYI BEG. + SKIPL UNRCHC ;BUT DON'T INCLUDE ANY CHARACTER THA REDISPLAY + JRST RRLP4 + SKIPL PJATY ;SCREEN GOT CLOBBERED, OR LOTS OF CHANGES HAPPENED, => + SKIPGE RRMNVP ;MUST CHECK THE WINDOW BEFORE DISPLAYING ANYTHING. + JRST RRLP4 + CALL RRWBLS ;IS OLD WINDOW STILL GOOD? + CALL [ TRO FF,FRUPRW ;NO => CHOOSE A NEW ONE FROM SCRATCH, AND + JRST RRALT6] ;TRY SCROLLING THE TEXT WITH INSERT/DELETE LINE. + MOVE A,RRMAXP ;RRMAXP=1 IS SET TO INHIBIT UPDATING IN RRDLB AND RRINSC. + CAIN A,1 ;IT DOESN'T INDICATE ANY CHANGES HAVE ACTUALLY OCCURRED. + SETZM RRMAXP + SKIPN RRMAXP ;ANY REDISPLAY REQUIRED? + SKIPE RRMSNG + CAIA + JRST RRLP3 ;NO, JUST MOVE CURSOR IF NEC. + MOVE A,RRMNVP + CAML A,BOTLIN ;IF ALL REQUIRED REDISPLAY IS REALLY OFF BOTTOM OF SCREEN, + JRST [ CALL RRDIS2 ;SAY IT'S BEEN DONE, AND MOVE THE CURSOR IF NEC. + JRST RRLP3] + JUMPE OUT,RRLP2F ;RUN FS ^R DISPLAY, UNLESS WE JUST FINISHED RUNNING IT. + SKIPN A,RRDISM ;ABOUT TO DISPLAY; FIRST CALL USER'S MACRO. + JRST RRLP2F + CALL RRMACR + SETZ OUT, ;MARK FS ^R DISPLAY AS RUN, THIS TIME, TO AVOID INFINITE LOOP. + TRNN FF,FRARG2 ;IF 0 OR 2 VALUES, RECONSIDER WHAT DISPLAY TO DO + TRNN FF,FRARG + SETO OUT, + JRST RRLP6A + +;HERE IF PART OF THE SCREEN NEEDS REDISPLAY BUT NOT WHOLE SCREEN. +RRLP2F: SETOM RRIDLB ;IF NO INSERT/DELETE LINE, CAUSE ASSOCIATED CODE TO DO NOTHING. + SKIPE LID ;IF THE TERMINAL HAS INSERT/DELETE LINE, SEE HOW MANY LINES OF + CALL RRLID ;BOTTOM OF WINDOW WILL STILL BE GOOD IF SHIFTED A FEW LINES. + CALL CHCTI0 ;INIT. FOR CALLING DISAD. + SETZM CHCTBP + AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET) + HLLOS DISBFC + MOVEI TT,CPOPJ + MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS. + .I RRDHPS=RRHPOS ;SAVE INFO FOR DEBUGGING. + .I RRDVPS=RRVPOS + .I RRDMHP=RRMNHP + .I RRDMVP=RRMNVP + SAVE PT + SAVE RRHPOS + SAVE RRVPOS +RRLP2G: MOVE A,RRMNVP ;FIND THE 1ST CHAR IN THE 1ST LINE + MOVEM A,RRVPOS + LDB TT,[3300,,LINBEG(A)] ;WHICH WAS ALTERED, + MOVEM TT,PT + MOVE TT,LINBEG(A) + ASH TT,-33 + MOVEM TT,RRHPOS ;AND WHAT COLUMN IT WAS TYPED IN. + MOVEM TT,CHCTHP ;IN CASE LINE DOESN'T START AT LEFT MARGIN + ;(DUE PERHAPS TO LF WITHOUT CR) + CALL CHCTL4 ;INIT CHCTHC WITH SPACES. + SETZ T, ;T GETS THE LARGEST HPOS THAT ACTUALLY EXISTS ON THE LINE. + ;IF THE LINE ENDS SHORT OF RRMNHP, WE RESET RRMNHP TO THAT AND RETRY. +RRLP2B: MOVE TT,RRHPOS ;MOVE FORWARD TILL WE FIND 1ST CHAR + CAML TT,RRMNHP ;THAT FALLS IN THE 1ST ALTERED COLUMN. + JRST RRLP2C + MOVE TT,PT + CAML TT,ZV + JRST RRLP2C + CALL RRFORW + CAMGE T,RRHPOS + MOVE T,RRHPOS + MOVE TT,RRVPOS + CAME TT,RRMNVP ;BUT DON'T LET US MOVE PAST THE END OF + JRST RRLP2D ;THE LINE WE'RE SUPPOSED TO START ON. + CALL DISAD2 ;PUT THE CHARACTERS WE SKIP OVER INTO THE LINE'S HASH CODE. + JRST RRLP2B + +RRLP2D: MOVEM T,RRMNHP ;HERE IF THE LINE DOESN'T EXTEND AS FAR RIGHT AS RRMNHP SAYS. + CALL CHCTI0 ;SET RRMNHP BACK TO THE LARGEST HPOS ON THE LINE, AND TRY AGAIN. + JRST RRLP2G ;SO WE DISPLAY FROM THE VERY END OF THE LINE. + +RRLP2C: MOVE IN,PT ;CHAR ADDR 1ST CHAR TO BE OUTPUT. + CAML IN,BEGV + CAMLE IN,ZV + .VALUE + MOVEM IN,RRDPT ;REMEMBER WHERE OUTPUT STARTD, FOR DEBUGGING. + .I DISVP1=CHCTVP=DISVP=RRVPOS=RRMNVP + CALL DISLI6 + MOVEI TT,DISLIN + MOVEM TT,CHCTAD + .I CHCTVS=BOTLIN + SETZM MORNXT +;NOW THINK ABOUT REDISPLAYING ONLY PART OF A LINE, MAYBE USING I/D CHAR. + MOVE A,RRMAXP + MOVE BP,RRMNVP ;NOW IS THE LAST THING THAT CHANGED + MOVEI TT,1(BP) ;THIS WON'T WORK ON THE LAST LINE ON THE SCREEN + CAML TT,BOTLIN ;BECAUSE THERE ISN'T A LINBEG GIVING ITS END ADDRESS. + JRST RRLP2H + SUB A,Z ;ON THE SAME LINE AS THE FIRST CHANGE? + ADD A,RROLDZ + ADDI A,2 ;CHANGES MUST END BEFORE THE CRLF BEFORE THE NEXT LINE. + SAVE CHCTHP + CAMGE A,LINBEG+1(BP) + CALL RRLCHG ;IF SO, USE MORE EFFICIENT PARTIAL-LINE UPDATING PROCEDURE. + CAIA + JRST [ ;IF IT WINS, WE ARE FINISHED! + SUB P,[1,,1] + REST RRVPOS + REST RRHPOS + REST PT + JRST RRLP5] + REST CHCTHP + .I RRHPOS=CHCTHP + .I RRVPOS=RRMNVP +RRLP2H: MOVE TT,RRMNVP + CAME TT,BOTLIN ;UNLESS IT'S THE --MORE-- LINE, + SKIPN CHCTHP ;IF WE'RE DISPLAYING A WHOLE LINE, DON'T CLEAR UNLESS CHECKSUM + JRST [ SETOM DISVP ;SAYS IT HAS ACTUALLY CHANGED. + SETOM DISVP1 + JRST RRLP2E] + CALL RRMVC ;DISPLAYING ONLY PART OF A LINE: CHECKSUM MECHANISM WOULD LOSE, + CALL CLREOL ;SO CLEAR THE PART WE WANT TO CLEAR, + SETOM HCDS(TT) ;AND DISABLE THE CHECKSUM MECHANISM TO FORCE OUTPUTTING. +RRLP2E: REST RRVPOS + REST RRHPOS + REST PT + SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + CALL VBDOK3 ;DO THE DISPLAYING. ALL PREPARATIONS NECESSARY FOR VBDOK3 + ;SHOULD BE DONE BEFORE THE CALL TO RRLCHG. + CALL RRDIS2 ;INDICATE NOW REDISPLAY NOT NEEDED. + JRST RRLP5 + +;REDISPLAY CHANGES ENTIRELY WITHIN ONE LINE. +;IN CONTAINS THE CHAR ADDR AT WHICH CHANGES START. WE DON'T CLOBBER IN. +;SKIP IF WE SUCCEED IN BEING ABLE TO DO ANYTHING. +;OTHERWISE, NOTHING HAS BEEN DONE TO THE SCREEN +;AND THE MORE GENERAL TECHNIQUE MUST BE USED. +RRLCHG: SKIPE RRMSNG ;CAN'T WORK IF THINGS AFTER RRMAXP MIGHT BE BAD ON SCREEN. + RET + PUSH P,IN + MOVE BP,RRMNVP + MOVEM BP,RRVPOS + MOVE T,LINEND(BP) ;IF LINE USED TO BE CONTINUED, GIVE UP. + CAMLE T,NHLNS ;WE CAN TELL BECAUSE ITS END HPOS WILL BE PAST THE ! COLUMN. + JRST RRLCHQ + SETZ D, ;D BECOMES NONZERO AFTER WE ENCOUNTER THE FIRST TAB. + SETO T, +RRLCH1: CAMN IN,RRMAXP ;WHEN WE REACH THE CHARACTER AT WHICH CHANGES STOP, + MOVE T,RRHPOS ;REMEMBER THE HPOS. + CAMLE T,RRHPOS ;IF ANYTHING PAST END OF CHANGES BACKSPACES AND OVERSTRIKES + JRST RRLCHQ ;WITH THE CHANGED STUFF, WE CAN'T WIN WITH I/D CHAR. + CALL RREOLT + JRST RRLCH2 ;WHEN WE REACH THE END OF THE LINE, WANT THE HPOS THERE TOO. + CALL RRFORW + JUMPL T,RRLCHC + CAIE CH,^I ;IF WE FIND A TAB AFTER THE END OF THE CHANGES, + JRST RRLCHC + JUMPL D,RRLCHC ;THEN WE MUST INCLUDE EVERYTHING UP THRU THE FIRST SUCH TAB + MOVEM IN,RRMAXP ;AS TEXT TO BE REDISPLAYED, AS IF IT HAD ALL BEEN CHANGED. + SETO D, ;SET D TO SAY WE HAVE FOUND ONE TAB SO MORE TABS NO TROUBLE. + ;TEXT CONTAINING TABS CAN'T BE COUNTED ON TO MOVE RIGIDLY WHEN STUFF IS + ;INSERTED OR DELETED BEFORE IT, UNLESS A TAB IMMEDIATELY PRECEDES IT. +RRLCHC: MOVE TT,RRVPOS + CAME TT,RRMNVP ;GIVE UP IF THE LINE IS CONTINUED. + JRST RRLCHQ + JRST RRLCH1 + +RRLCH2: JUMPL T,RRLCHQ ;IF HAVEN'T FOUND END OF CHANGES, A CRLF HAS BEEN INSERTED, + ;SO GIVE UP. WE WIN ONLY IF THE LINE IS STILL ONE LINE. + MOVE A,RRHPOS ;GET CURRENT NEEDED END-HPOS OF TEXT FOLLOWING THE CHANGE. + MOVE BP,RRVPOS + SUB A,LINEND(BP) ;SUBTRACT OLD END-HPOS TO GET DISTANCE TO MOVE RIGHT. +;WE NOW HAVE GATHERED ALL THE INFORMATION. +;DECIDE WHETHER IT IS FASTER TO REWRITE ONLY PART OF THE LINE. + MOVE B,RRHPOS + SUB B,T ;GET NUMBER OF CHARS THAT WE COULD AVOID REPRINTING. + LSH B,-1 ;WE WIN IF THAT'S MORE THAN TWICE THE NUMBER OF + MOVM TT,A + CAMGE B,TT ;INSERTS OR DELETES WE MUST DO. + JRST RRLCHQ + SKIPN CID ;IF TERMINAL CAN'T DO INSERT OR DELETE CHARACTER, + JUMPN A,RRLCHQ ;WE WIN ONLY IN THE CASE THAT NONE ARE NECESSARY. + SKIPL A + SUB T,A ;GET MINIMUM OF DESIRED STARTING HPOS AND OLD STARTING HPOS. + CAMGE T,RRMNHP ;BUT CAN'T MOVE ANYTHING THAT DOES OR WILL OVERLAP + ;WITH THE TEXT TO THE LEFT OF THE CHANGED AREA + JRST RRLCHQ ;(PATHOLOGICAL CASE OF INSERTING OR DELETING A BACKSPACE). + ADDM A,LINEND(BP) + MOVE TT,TTYOPT ;IF NO CHANGE IN NUMBER OF CHARS, AND NO OVERPRINTING, + TLNN TT,%TOOVR ;JUST MOVE CURSOR ONCE. + JUMPE A,RRLCH5 + HRLZS BP + HRR BP,T + CALL SETCUR ;MOVE CURSOR THERE. + JUMPL A,RRLCH4 + JUMPE A,RRLCH3 + CALL INSCHR ;INSERT OR DELETE CHARACTERS, MOVING TEXT AFTER THE CHANGE + JRST RRLCH3 ;TO ITS DESIRED LOCATION. + +RRLCH4: MOVMS A + CALL DELCHR +RRLCH3: +;; NOW, ON A TERMINAL THAT CAN OVERPRINT, WE MUST ERASE THE REMAINING CHANGED AREA. +;; WE CAN DO THAT BY BACKSPACING OVER THE AREA DOING %TDDLF'S. +;; ON A TERMINAL THAT CANNOT OVERPRINT, WE NEED ONLY MOVE THE CURSOR BACK TO THAT POINT. +;; THE CURRENT CURSOR HPOS IS IN T. THE DESIRED ONE IS IN RRMNHP. + MOVE TT,TTYOPT + TLNN TT,%TOOVR + JRST RRLCH5 +RRLCH6: CAMN T,RRMNHP ;TILL WE BACK UP TO THE STARTING POSITION, + JRST RRLCH7 + MOVEI CH,^H ;FOR EACH POSITION, DO ONE BACKSPACE AND ONE ERASE-CHAR. + CALL TYOINV + CALL ERSCHR + SOJA T,RRLCH6 + +RRLCH5: HRLZ BP,RRVPOS + HRR BP,RRMNHP ;GET POSITION OF START OF CHANGES. + CALL SETCUR +RRLCH7: MOVE IN,(P) ;GET RANGE CONTAINING NEW TEXT, AND TYPE IT OUT. + MOVE BP,RRVPOS + SAVE LINEND(BP) + SAVE LINBEG+1(BP) ;DISLIN WOULD WANT TO CLOBBER THESE! +RRLCH8: CAMN IN,RRMAXP + JRST RRLCH9 + CALL GETINC + CALL DISAD + JRST RRLCH8 + +RRLCH9: CALL DISFLS ;FORCE OUT WHAT WE HAVE SENT THROUGH DISAD. + SETZM CHCTBP ;NOW SET UP FOR JUST COMPUTING HASH CODE, NOT OUTPUTTING. + AOS CHCTBP ;(MUSTN'T BE 0, OR CHCTHC WOULDN'T BE SET) + HLLOS DISBFC + MOVEI TT,CPOPJ + MOVEM TT,CHCTAD ;MAKE SURE DISLIN NOT CALLED, IN CASE STRAY CR OR BS. +RRLCHA: CALL RREOLT ;NOW FINISH "OUTPUTTING" UP TO THE END OF THE LINE, + JRST RRLCHB + CALL GETINC ;BUT SINCE CHCTAD IS A NO-OP NOTHING WILL COME OUT. + CALL DISAD ;HOWEVER, THE HASH CODE FOR THE LINE WILL BE CALCULATED. + JRST RRLCHA + +RRLCHB: MOVE BP,RRVPOS + MOVE T,CHCTHC + MOVEM T,HCDS(BP) ;STORE THE NEW CORRECT HASH CODE. + REST LINBEG+1(BP) + REST LINEND(BP) + MOVE T,Z + SUB T,RROLDZ ;UPDATE LINBEGS OF ALL FOLLOWING LINES. + CALL RRINS3 + CALL RRDIS2 ;NO MORE REDISPLAY IS NECESSARY NOW. + SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + AOS -1(P) ;WE HAVE WON - RETURN SKIPPING. +RRLCHQ: REST IN ;WE HAVE LOST - RETURN NON-SKIPPING. + RET + +;TEST THE WINDOW FOR VALIDITY, ASSUMING RRVPOS IS CORRECT. +;MUCH FASTER THAN AN ACTUAL VBDBLS. +;CLOBBERS A, IN, TT, TT1. +RRWBLS: MOVE A,RRVPOS + SKIPN GEA + JRST RRWBL1 + CAMGE A,RRTOPM ;CURSOR TOO NEAR TOP => NEW WINDOW. + RET +RRWBL1: MOVE TT,MORESW + TRNN TT,MS%DWN ;IF THERE'S STUFF PAST THE SCREEN BOTTOM, + JRST RRWBL2 ;WE DON'T WANT CURSOR TOO NEAR BOTTOM. + CAML A,RRBOTM + RET +RRWBL2: CAMGE A,BOTLIN ;IF CURSOR'S BELOW BOTTOM, WE MUST SHIFT THE WINDOW. + JRST POPJ1 ;ELSE, OLD WINDOW IS STILL GOOD. + MOVE IN,PT ;EXCEPTION: CURSOR AT FRONT OF --MORE-- LINE + CAMG A,BOTLIN ;AT END OF BUFFER AFTER A CRLF, + CAME IN,ZV ;IS CONSIDERED AT THE END, RATHER THAN BELOW IT. + RET + SUBI IN,2 + CALL RREOLT ;SO CHECK FOR THE CRLF. + JRST POPJ1 + RET + +;COME HERE HAVING DETERMINED THAT A FULL SCREEN REDISPLAY IS NEEDED. +RRLP4: MOVE A,RRDISM ;DO FULL REDISPLAY, TESTING PREVIOUS WINDOW. + JUMPE A,RRLP5A + CALL RRMACR + SKIPL GEA ;ON RETURN, IS REDISPLAY STILL NEEDED OR WAS IT ALREADY DONE? + SKIPGE RRMAXP + JRST RRLP5A + SKIPGE PJATY ;IF SEEMS TO HAVE BEEN DONE, MAYBE WE SHOULDN'T DO IT. + SKIPE RRMSNG + CAIA + JRST RRLP6 +RRLP5A: SETOM RROVPO ;WHEN WE STOP DISPLAYING, MUST REPOSITION PHYSICAL CURSOR. + .I RRERFL=ERRFL1 + SETOM RRIDLB ;IN FULL REDISPLAY, NONE OF THE TEXT ALREADY ON THE SCREEN CAN BE REUSED. + CALL RRDISP ;NORMAL (VBD) DISPLAY, MAYBE CHANGING WINDOW. + CALL RRDIS2 ;REDISPLAY NOW NOT NEEDED, + SKIPL RRERFL ;UNLESS THIS REDISPLAY DIDN'T DISPLAY THE TOP LINE + JRST RRLP5 + .I RRMNVP=TOPLIN ;(PRESERVING AN ERR MSG) IN WHICH CASE REDISPLAY AFTER NEXT CMD. + SETZM RRMNHP + .I RRMAXP=GEA+BEGV +RRLP5: .I RROLDZ=Z + .I RROLZV=ZV + AOSN RRNCCR ;IF CHAR BEFORE PT WAS A CR, RRHPOS WASN'T SET + ;(DUE TO THE FACT THAT A CR ISN'T OUTPUT UNTIL THE + ;NEXT CHAR IS SEEN) + CALL [ SOS PT ;HPOS AND VPOS ARE CORRECT FOR BEFORE + JRST RRFORW] ;THE CR, SO SPACE OVER IT. + MOVE A,RRHPOS ;DON'T LET THE CURSOR BE OVER THE "!" + CALL RRFOR3 ;OF A CONTINUATION. +RRLP3: MOVE T,MORESW + CALL DISMD ;REDISPLAY Q..J IF IT HAS CHANGED, NOT CHANGING --MORE-- STATUS. + SKIPE RGETTY + CALL RRMVC ;PUT THE HARDWARE CURSOR AT THE POINTER. + JRST RRLP1 + +RRDISX: MOVEI T,RRLP1 ;COME HERE TO QUIT DISPLAYING BECAUSE INPUT WAITING. + MOVE CH,DISPRR + MOVEM T,(CH) ;PREVENT RRARGF FROM BEING CALLED. +;COME HERE IF STOP DISPLAYING SINCE KNOW NO MORE DISPLAY NEEDED. +RRDISF: MOVE P,DISPRR + .I RROLZV=ZV + MOVE T,Z + SUB T,RROLDZ + ADDM T,RROLDZ +RRDISG: MOVE A,T ;NOW UPDATE THE LINBEG WORDS OF THE REMAINING SCREEN LINES. + AOS TT,BP + CAMLE TT,BOTLIN + .VALUE + JRST RRFXR1 + +RRDISP: SKIPN RGETTY + JRST RRDIS3 + .I RRMNVP=TOPLIN ;IF DISPLAYING IS INTERRUPTED, MAKE + SETZM RRMNHP ;WE RESTART THE RIGHT WAY. + SETOM RRMSNG ;SAY WE CAN'T STOP DISPLAYING AT RRMAXP. + JRST VBDRR + +RRDIS1: MOVE CH,CHCTHP ;CALL HERE WHEN CURSOR IS OUTPUT, + MOVEM CH,RRHPOS ;OR AT END OF BUFFER IF PT IS THERE. + MOVE CH,CHCTCF ;IF THE LAST CHAR WAS CR, + MOVEM CH,RRNCCR ;SAY WE DON'T KNOW CORRECT HPOS. + MOVE CH,CHCTVP + MOVEM CH,RRVPOS ;REMEMBER SCREEN POS. OF CURSOR. + POPJ P, + +RRDIS2: SETZM RRMAXP ;HERE TO DECLARE THAT NO REDISPLAY IS NEEDED. + SETZM RRMSNG + HRLOI TT,377777 + MOVEM TT,RRMNVP + MOVEM TT,RRMNHP + POPJ P, + +;MOVE THE CURSOR TO THE PLACE SPECIFIED BY RRVPOS AND RRHPOS. +;ASSUMES THAT RROHPO, RROVPO HOLD CURRENT ACTUAL LOCATION OF CURSOR, +;OR -1 IF THE OLD POSITION IS NOT KNOWN. CLOBBERS Q. + +RRMVC: MOVE Q,RRHPOS + SKIPN RGETTY + MOVEM Q,CHCTHP + SKIPE RGETTY + CAME Q,RROHPO ;IF NEITHER COORD NEEDS TO BE CHANGED, + JRST RRMVC1 + MOVE Q,RRVPOS + CAMN Q,RROVPO + RET ;DON'T BOTHER TO DO ANYTHING. +RRMVC1: SAVE BP + HRRZ BP,RRHPOS + HRL BP,RRVPOS + HRRZM BP,RROHPOS + HLRZM BP,RROVPOS + CALL SETCUR + JRST POPBPJ + +;HERE TO SEE IF ANY OF THE TEXT ON THE SCREEN, PAST ALL CHANGES WE MUST DISPLAY, +;CAN STILL BE USED IF WE CAN MOVE IT TO THE RIGHT LINE ON THE SCREEN +;(USING INSERT/DELETE LINE). SOMETIMES WE ACTUALLY MOVE THE TEXT AND BLT THE TABLES. +;USUALLY WE JUST SET RRIDVP TO THAT LINE'S VPOS AND RRIDLB TO ITS LINBEG WORD +;(RELOCATED TO CONTAIN A CURRENT ADDRESS RATHER THAN A HISTORICAL ONE). +;RRIDBK IS SET TO THE NUMBER OF BLANK LINES WHICH NOW PRECEDE THAT STILL-USEFUL LINE. +;IT IS USED IN RECOGNIZING WHERE THAT LINE IS GOING TO BE WANTED ON THE SCREEN +;AS SOON AS THE FIRST BLANK LINE IS REACHED IN TYPEOUT. THIS REDUCES WASTEFUL DISPLAY. +RRLID: CALL RRLID2 ;FIND THE TEXT TO BE PRESERVED, SET RRIDLB AND RRDVP. + RET ;NO SKIP MEANS NO TEXT ON SCREEN MAY BE PRESERVED. + MOVE BP,RRMNVP + MOVE TT1,RRIDLB + CAME TT1,LINBEG(BP) ;IF THAT TEXT OUGHT TO BE MOVED UP TO WHERE WE WILL START + RET ;DISPLAYING (IE, WE ARE DISPLAYING THAT SOME LINES WERE KILLED) +;DELETE LINES OF TEXT FROM C(BP) TO C(RRIDVP). + SOS BP + MOVE CH,RRMSNG + IOR CH,RRMAXP + CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT". + RET ;IF DSLID DECIDED TO ABORT, THAT'S OK. + SETZM RRMAXP ;ALL CHANGES ARE BEING HANDLED BY THE LINE-DELETE, SO THERE AREN'T ANY MORE. +;; OTHER PLACES JUMP TO RRLID5, BUT MUST SET UP CH AND BP AS ABOVE. +RRLID5: JUMPN CH,[ ;RRMSNG SAYS THAT THE STUFF BELOW DELETION POINT MAY NEED REDISPLAY + ;EVEN THOUGH IT'S AFTER RRMAXP, SO WE MUSNT'T TRY TO SKIP OVER IT. + MOVE TT,RRIDLB ;BUT GIVE THAT PLACE AN ACCURATE LINBEG TO RESTART + MOVEM TT,LINBEG+1(BP) ;REDISPLAY WITH. + RET] + MOVE BP,BOTLIN ;NOW ALL THAT NEEDS DISPLAYING ARE THE NEW BLANK LINES AT THE BOTTOM. + SUB BP,Q ;SO GET THE VPOS OF THE FIRST OF THEM, + CAMLE BP,TOPLIN ;AND START DISPLAYING AT THE LINE BEFORE IT, + SOS BP ;SINCE THAT'S THE LAST ONE WITH A VALID LINBEG. + EXCH BP,RRMNVP + SETZM RRMNHP ;NOTE THAT DSLID SETS RRMSNG. + MOVE CH,Z + SUB CH,RROLDZ ;NOW RELOCATE LINBEGS OF ALL LINES PAST OLD RRMNVP THRU NEW RRMNVP, +RRLID4: CAMLE BP,RRMNVP ;SINCE LINBEGS OF ALL LINES ABOVE RRMNVP ARE SUPPOSED TO BE + JRST RRLID6 ;CORRECT WITHOUT NEEDING RELOCATION. + ADDM CH,LINBEG(BP) + AOJA BP,RRLID4 + +RRLID6: MOVE CH,ZV ;DON'T LEAVE RRMNVP POINTING PAST THE END OF THE BUFFER. +RRLID7: MOVE BP,RRMNVP ;IF THE LINE IT POINTS AT IS AT OR AFTER THE END OF BUFFER, + CAMLE BP,TOPLIN ;MOVE IT BACK TO THE LINE THAT ACTUALLY FOLLOWS THE END. + CAME CH,LINBEG(BP) ;CHANGED FROM LINBEG-1(BP) SO DOESN'T LOSE ON A BUFFER + RET ;WHICH DOES NOT END WITH A CRLF. + SOS RRMNVP + JRST RRLID7 + +;DETERMINE WHETHER ANY OF THE LINES AT THE BOTTOM OF THE SCREEN CAN BE PRESERVED +;(PERHAPS MOVING THEM UP OR DOWN WITH INSERT/DELETE LINE). +;SKIP IF THERE ARE ANY, SETTING RRIDVP TO THE VPOS OF THE FIRST, AND RRIDLB +;TO THAT LINE'S LINBEG (UPDATED TO BE CORRECT WITH CURRENT Z, RATHER THAN RROLDZ). +RRLID2: SETOM RRIDLB + SETZM RRIDBK + MOVE OUT,RROLDZ + SUB OUT,Z ;COMPUTE ADDRESS BEYOND WHICH NO BUFFER CHANGES HAVE OCCURRED, + ADD OUT,RRMAXP ;RELOCATED TO MATCH OLD LINBEG WORDS. + MOVE BP,TOPLIN +RRLID1: CAMN BP,BOTLIN + RET ;REACH END OF WINDOW => NO EXISTING TEXT STILL GOOD. DON'T SET RRIDLB. + LDB TT1,[3300,,LINBEG(BP)] + CAMLE OUT,TT1 ;SEE WHICH LINE IS THE FIRST TO START AFTER THAT POINT. + AOJA BP,RRLID1 + ADD TT1,Z + SUB TT1,RROLDZ + CAMN TT1,BEGV ;A LINE IS ACCEPTABLE ONLY IF ITS TEXT IS STILL AT THE FRONT OF A LINE. + JRST RRLID3 ;SO REQUIRE THAT IT BE AT FRONT OF BUFFER OR AFTER A CRLF. + MOVE IN,TT1 + SUBI IN,2 + CALL GETINC + CAIE CH,^M + AOJA BP,RRLID1 ;IF THIS LINE NOT GOOD FOR THIS REASON, NEXT LINE PROBABLY STILL GOOD. + CALL GETCHR + CAIE CH,^J + AOJA BP,RRLID1 +RRLID3: MOVEM BP,RRIDVP ;RRIDVP POINTS AT 1ST LINE NOT INVALIDATED, OR AT BOTLIN IF ALL INVALID + MOVE TT1,LINBEG(BP) + ADD TT1,Z ;GET ADDR OF BEGINNING OF TEXT THAT CAN BE SAVED IF MOVED UP OR DOWN, + SUB TT1,RROLDZ ;RELOCATED TO BE THE CURRENT ADDRESS, NOT THE ADDR IT HAD + MOVE TT,TT1 + TLZ TT,777000 ;DON'T TRY TO MOVE FOLLOWING TEXT IF IT IS NULL (IT STARTS AT Z). + CAMN TT,ZV + RET + MOVEM TT1,RRIDLB ;WHEN LAST DISPLAYED. + MOVE IN,TT + SETOM RRIDBK ;NOW HOW MANY BLANK LINES ARE THERE BEFORE THAT POINT? +RRLID8: SOS IN ;SCAN BACKWARDS COUNTING THEM AND PUT NUMBER IN RRIDBK. + CAMGE IN,BEGV ;IF REACH BEG OF BFR JUST BEFORE A CRLF, THEN EACH CRLF WE PASSED + JRST [ AOS RRIDBK ;COUNTS FOR ONE BLANK LINE. + JRST POPJ1] + CALL GETCHR + CAIE CH,^J ;OTHERWISE, THE LAST CRLF WE FIND IS REALLY THE END OF A NONBLANK LINE + JRST POPJ1 ;AND SHOULDN'T COUNT. TO ARRANGE THAT, WE START COUNTING AT -1. + CAMG IN,BEGV + JRST POPJ1 + SOS IN + CALL GETCHR + CAIE CH,^M + JRST POPJ1 + AOS RRIDBK + JRST RRLID8 + +SUBTTL PRINTING TERMINAL ^R DISPLAY + +;DISPLAY CURRENT LINE AND PUT TTY CURSOR IN RIGHT PLACE, FOR PRINTING TTY SCAN MODE. +RRDIS3: SKIPN RRSCAN + RET + CALL RRBTCR + SETZM RRVPOS ;TYPE LINE UP TO POINT (0T) + SETZM RUBENC + CALL DISTOT + SETZ C, + CALL GETAG7 ;FIND RANGE (0F^@). + JFCL + .I GEA=E-BEGV + CALL TYPE2 ;TYPE IT. + TRO FF,FRCLN + MOVEI C,1 + CALL GETAG7 ;NOW TYPE TO END OF LINE. + JFCL + CAMN C,E + RET + CALL TYPE2 ;AND BS OVER IT, SAYING MUST DO A LF IF WE ARE AT THE END OF THE LINE. + JRST RRTTY2 + +;HERE TO HANDLE CURSOR MOTION, ON PRINTING TERMINAL IN SCAN MODE. +RRTTY: SKIPN RRSCAN + JRST RRBTCR + TRNN FF,FRARG ;IF WE KNOW NOTHING ABOUT THIS OPERATION, DON'T DISPLAY. + JRST RRBTCR ;WE COULDN'T DO ANYTHING BUT ^L; LET USER DECIDE ON THAT. + TRNE FF,FRARG2 + JRST RRTTID ;JUMP IF IT'S AN INSERT/DELETE OPERATION. + CALL RRMAC3 + SKIPGE RRMNVP + RET + MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,CPOPJ +RRTTY1: SKIPN RGETTY ;HERE TO SCAN MOTION CAUSED BY BUILT-IN ^F, ETC. + SKIPN RRSCAN + RET + MOVE A,RRVPOS ;SHOW THE USER THE CURSOR MOTION IN SOME NICE WAY. + SUB A,RREVPS ;UNLESS WE'RE ON THE SAME LINE, OR THE NEXT ONE, + JUMPL A,CPOPJ + CAIL A,2 ;DON'T JUST GO OFF AND PRINT LOTS OF GARBAGE; + RET ;LET USER DECIDE WHETHER TO REDISPLAY THE BUFFER. + MOVE C,PT + MOVE E,RREPT ;FORWARD HORIZONTAL MOTION => TYPE CHARS MOVED OVER. +RRTTY4: CAMGE E,C + JRST RRTTYF + CAMG E,C ;NO MOTION, EVEN, => STILL PREVENT ECHOING. + JRST RRTTY3 +RRTTY2: SKIPE A,RUBENC ;NO NEED TO LF BETWEEN TWO BACKWARD MOTION CMDS. + CAIN A,^J ;ASIDE FROM THAT, IF LAST THING DONE WANTED STUFF TYPED, + CAIA ;TYPE IT. + CALL RUBEND + CALL RRMVC ;BUT IF BACKWARD MOTION, JUST MOVE BACK TO HPOS, BUT + MOVEI A,^J + SKIPN BSNOLF + MOVEM A,RUBENC ;MAKE SURE WE TYPE A LF BEFORE TYPING ANYTHING ON THIS LINE. +RRTTY3: SETOM ECHCHR ;MAKE THIS COMMAND NOT BE ECHOED. + RET + +RRTTYF: SAVE DISPCR ;HERE TO SCAN FORWARD MOTION: TYPE CHARS MOVED OVER, + SETOM DISPCR ;WITH FS ^M PRINT$ SET TO -1 SO THAT STRAY CR AND LF + CALL TYPE2 ;COME OUT AS THEMSELVES. + REST DISPCR + RET + +;COME HERE AFTER A COMMAND. IF IN SCAN MODE ON PRINTING TTY, AND COMMAND DIDN'T +;TYPE ANYTHING, ECHO IT (BY TYPING THE CHAR OR STRING IN FS ECHO CHAR$). +RRTTYE: MOVE CH,ECHCHR + CAME CH,[-1] + SKIPE RGETTY + RET + SKIPGE GEA ;DON'T ECHO A ^L OR SIMILAR CHAR. + RET + SKIPE RRSCAN + SKIPN RRLAST ;DON'T ECHO ARG-SETTING COMMANDS. + RET + CAIL CH, + CALL TYINRM ;IF IT'S A CHAR (NOT A STRING) CONVERT TO 7-BIT. + JRST FSECO1 + +RUBEND: SAVE CH ;AND IF THERE'S ANYTHING TO TYPE (SUCH AS LF AFTER + SKIPE CH,RUBENC ;BACKWARD MOTION IN ^R MODE), TYPE IT. + CALL FSECOR + SETZM RUBENC + JRST POPCHJ + +;COME HERE TO HANDLE A COMMAND THAT RETURNED 2 VALUES, ON A PRINTING TTY IN SCAN MODE. +RRTTID: MOVE CH,ECHCHR ;DON'T DO IT OUR WAY IF COMMAND HAS ALREADY TYPED OUT. + AOJE CH,RRBTCR + MOVE C,NUM + MOVE E,SARG + CAML E,C + EXCH C,E + CALL GETANU ;E, C GET THE CHAR ADDRS OF START AND END OF CHANGED RANGE. + CAME C,PT ;WE DON'T KNOW HOW TO HANDLE IT UNLESS POINT WAS PUT AT END. + JRST RRBTCR + .I C-E + CAML TT,RRTTMX ;IS SIZE OF RANGE CHANGED BELOW THRESHHOLD? + JRST RRBTCR ;TOO MANY CHANGES => DON'T PRINT THEM. + CAMN E,RREPT ;DID CHANGES START AT THE OLD POINT? + JRST RRTTI1 + SAVE C ;IF NOT, MOVE BACK TO WHERE CHANGES STARTED. + SAVE E + SAVE PT + MOVEM C,PT ;MOVE RRVPOS, RRHPOS TO THE POSITION OF THAT PLACE. + CALL RRMAC3 + REST PT ;BUT DON'T REALLY SET PT THERE. + MOVE C,(P) + MOVE E,RREPT ;NOW "MOVE BACK" THERE "FROM" WHERE PT USED TO BE. + CALL RRTTY4 + REST E + REST C +RRTTI1: CALL RRBTCR + CAME E,C ;NOW TYPE ALL THE NEW TEXT, LEAVING CURSOR AT POINT + JRST RRTTYF ;SINCE POINT IS WHERE THE NEW TEXT ENDS. + RET + +SUBTTL ^R COMMAND DISPATCH + +;COME HERE TO HANDLE INPUT (NO DISPLAY NEEDED OR INPUT KNOWN TO BE WAITING). +RRLP1: TLNE FF,FLNOIN ;IF WE'RE DOING AN "^ V", RETURN + CALL RREXIT ;(DOESN'T COME BACK) AFTER DISPLAYING ONCE. +IFN ITS,CALL RRECIN ;HAVE SYSTEM ECHO AND INSERT PRINTING CHARACTERS, MAYBE. + CALL TYIW0 ;READ A CHARACTER + CAIN CH,TOP+"H ;IGNORE "HELP" (FS HELPMAC$ ALREADY RUN, IF APPROPRIATE), + JRST RRLP ;BUT DO GO TO RRLP SO SPACE WILL FLUSH HELPMAC'S TYPEOUT. + ANDI CH,777 + MOVEM CH,$Q..0 ;PUT CHAR WHERE USER MACRO DEFINITION CAN FIND IT. + MOVEM CH,RRLAST ;ALSO PUT IT IN FS ^R LAST$. + MOVEM CH,ECHCHR ;FOR PRINTING TTY, REMEMBER WHICH CHAR TO ECHO. + SKIPN RGETTY + SKIPE RRECHO ;DECIDE WHETHER TO ECHO ^R INPUT. + SKIPGE RRECHO + CALL [CALL TYINRM ;MUST NORMALIZE CHARACTER BEFORE OUTPUTTING, + JRST FSECO1] + MOVE CH,$Q..0 ;(IN CASE WE CALLED TYINRM). + SAVE [RRLP] + CALL RRARGD ;PUT VALUE OF COMMAND'S ARG IN C. +RRLP7: CALL RRLEA2 ;NOW SET UP "RRE" VARS IN CASE RRTTY CALLED AFTER CMD. + MOVE TT,QRB.. + SETZM .QVWFL(TT) ;COMMAND WILL SET ..H TO SAY ^R SHOULD WAIT BEFORE DISPLAYING. + CAMN CH,CASSFT ;F$ CASE CTL CHRS DON'T HAVE FIXED VALUES. + JRST RRSFT + CAMN CH,CASLOK ;SO THE DISPATCH TABLE CAN'T CHECK FOR THEM. + JRST RRLOK + CALL RRCASC ;IF IN F$ MODE, DO CASE CONVERSION. + TRNN CH,META + JRST RRLP7I + TRNE CH,CONTRL ;META NON-CONTROL CHARACTERS ALL SELF-INSERT + JRST RRLP7J + SKIPLE RRRPLC ;IF IN FS ^R REPLACE$ > 0 MODE. + JRST RRXINS +RRLP7J: TRNE CH,CONTRL ;CONTROL-META LETTERS SELF INSERT IF FS CTLMTA$ NEGATIVE. + TRNN CH,100 + JRST RRLP7I + SKIPGE RRCMQT + JRST RRXINS +RRLP7I: +;"INDIRECT" (RRINDR) DEFINITIONS LOOP BACK HERE. +RRIND1: MOVE E,RRMACT(CH) ;GET CURRENT DEFINITION OF CHARACTER. + SKIPL RRALQT ;UNLESS DEFINITIONS ARE SUPPRESSED, + SKIPGE RRUNQT + JRST RRLP7D ;USE THE DEFINITION + CAME CH,RRALQT ;ELSE IF THIS IS NOT THE UNQUOTING CHAR, + JRST RRLP7B ;MAKE IT SELF-INSERTING. + SETOM RRUNQT ;IF IT IS, REENABLE DEFINITIONS FOR 1 COMMAND. + SETZM RRLAST ;DON'T FLUSH NEXT COMMAND'S ARGUMENT. + RET + +;DEFINITION OF "NORMAL SELF-INSERTING" CHARACTERS. +RRXINS: SKIP + SKIPN E,RRXINV ;GET THE DEFINITION INTENDED FOR SUCH CHARACTERS + MOVE E,[RRDINS,,RRREPI] ;OR THE DEFAULT DEFINITION, + SAVE CH + CALL RRLP7D ;AND RUN IT. + CAIA + AOS -1(P) + CALL SKNBCP ;IF THE CHARACTER HAS THE LISP SYNTAX OF CLOSEPAREN, + REST A + ILDB CH,SKNBPT + SKIPE RGETTY + SKIPN A,RRPARN + RET + CAIN CH,") + CALL RRMACR ;THEN RUN THE CLOSEPAREN MACRO. + JFCL + RET + +;HANDLE A CHARACTER IN SUPPRESS MODE. +RRLP7B: JUMPL E,RRLP7E ;IF ITS DEF. IS A MACRO, SEE WHETHER IT STARTS WITH "W". + MOVEI A,(E) + CAIE A,RRINDR + CAIN CH,177 + JRST RRLP7D ;RUBOUT WORKS EVEN IN SUPPRESS MODE. +RRLP7F: CAIN CH,CONTRL+"M ;OTHER CHARS BECOME SELF-INSERTING. + SKIPA E,[RRCRLF,,RRREPT] + JRST RRXINS +RRLP7D: SKIPGE A,E ;COME HERE TO USE WHATEVER DEFINITION IS IN E. + JRST RRMAC0 ;EITHER A MACRO OR A BUILT-IN FUNCTION. +RRLP7H: TRZ FF,FRCLN\FRUPRW + LDB A,[331100,,(E)] ;BUILT-INS MUST START WITH A "SKIP" (THAT DOESN'T SKIP EVER). +IFN ITS,CAIE A,.BREAK_-33 ;DON'T BE CONFUSED BY BREAKPOINTS. +IFN TNX,CAIE A,JSYS_-33 ;BPT MAYBE? + CAIN A,SKIP_-33 + JRST (E) + TYPRE [M%R] + +RRLP7E: MOVE A,E ;MACRO-CHAR. TYPED IN SUPPRESS MODE. + CALL QLGET1 + JRST RRLP7F + ILDB TT,BP ;WHAT IS ITS 1ST CHARACTER? + CAIE TT,"W+40 + CAIN TT,"W ;IF IT DOESN'T START WITH A "W" THEN THE DEFINITION IS SUPPRESSED. + JUMPG B,RRLP7D ;IF IT STARTS WITH "W", THEN EXECUTE DEFINITION EVEN IN SUPPRESS MODE. + JRST RRLP7F + +SUBTTL ^R CHARACTER FORWARD/BACKWARD + +;^B - MOVE BACKWARDS ONE CHARACTER. +;UPDATES RRHPOS AND RRVPOS. LEAVES THE CHAR MOVED OVER IN CH. +;LEAVES PT IN IN. CLOBBERS OUT, TT, TT1, A, B, C. +RRBACK: MOVE IN,BEGV ;ERROR IF AT BEGINNING OF BUFFER. + CAML IN,PT + JRST RRERR +RRBAC4: SOS IN,PT ;GET THE CHAR BEFORE THE PTR + CALL GETCHR +RRBAC0: RRCHRG ;GET CHAR'S DISPATCH TYPE CODE IN A. CLOBBERS B. + XCT RRBACT(A) +RRBAC1: SOS A,RRHPOS + JUMPGE A,CPOPJ +RRBAC3: ADD A,NHLNS ;MOVED OVER LINE-CONTINUATION. + MOVEM A,RRHPOS ;GO BACK TO PREV. LINE'S END. +RRBACV: SOS RRVPOS + POPJ P, + +RRBACT: SOSA A,RRHPOS ;ORD. CHAR., BACK 1 POS. + JRST RRBACC ;NON-FORMATTING CONTROL CHARS. + JRST RRBACH ;^H, CHECK ^HPRINT FLAG. + JRST RRBACR ;^M, SPECIAL. + JRST RRBACL ;^J, UP 1 LINE. + SAVE [RRBTCR] ;TAB, COMPUTE RRHPOS BY MOVING FWD + ;FROM PREVIOUS CR. + JRST RRBAC2 ;2-POS CTL CHARS NO AFFECTED BY FS SAIL (^P AND ^C). + +RRBACR: ADDI IN,1 ;CR: IS IT FOLLOWED BY LF? + CALL GETCHR + MOVEI A,(CH) + MOVEI CH,^M + CAMGE IN,ZV + CAIE A,^J ;IF THIS CR REALLY CAME OUT AS CR, + SKIPGE DISPCR + JRST RRBTCR ;COMPUTE HPOS THE HARD WAY. + SUBI IN,1 +RRBAC2: SOS RRHPOS ;IF IT CAME OUT AS UPARROW-M, + JRST RRBAC1 ;TREAT AS 2-POS CTL CHAR. + +RRBACL: SUBI IN,1 ;LF: SEE IF PREV. CHAR IS CR. + CALL GETINC + MOVEI A,(CH) + MOVEI CH,^J + CAML IN,BEGV + CAIE A,^M ;BASED ON THAT AND ON DISPCR, DECIDE HOW LF WAS PRINTED OUT. + SKIPGE DISPCR + JRST RRBACV + JRST RRBAC2 + +RRBACH: SKIPL DISPBS ;MOVE BACK OVER ^H - IF IT CAME OUT AS + JRST RRBACC ;UPARROW-H, TREAT AS ORDINARY CTL CHAR. + MOVE A,RRHPOS ;ELSE, IF WE KNOW IT CAME OUT AS A BACKSPACE, IT'S SIMPLE. + CAIG A,2 + JRST RRBTCR ;NEAR MARGIN, WE CAN'T BE SURE, SO MUST SCAN FORWARD. + AOS RRHPOS + RET + +;NON-FORMATTING CONTROL CHARS, CHECK SAIL FLAG. +RRBACC: SKIPN DISSAI + JRST RRBAC2 ;NORMALLY, MOVE BACK 2 POS. + JRST RRBAC1 ;IN SAIL MODE, MOVE 1 POS. + +;^F -- MOVE FWD 1 CHAR. SEE THE COMMENTS BEFORE RRBACK. +RRFORW: MOVE IN,PT ;ERROR IF AT END OF BUFFER. + CAML IN,ZV + JRST RRERR + CALL GETINC +RRFOR0: AOS PT + RRCHRG + XCT RRFORT(A) ;DISPATCH ON TYPE OF CHAR. +RRFOR1: AOS A,RRHPOS +RRFOR3: CAMGE A,NHLNS ;HAVE WE MOVED PAST RIGHT MARGIN? + POPJ P, + CAMN A,NHLNS ;CHECK FOR JUST REACHING THE RIGHT MARGIN. + JRST [ SAVE CH ;IF REACH RIGHT MARGIN, MUST + MOVE IN,PT ;CONTINUE PROVIDED WE'RE NOT AT + CALL RREOLT ;THE END OF THE LINE. + JRST POPCHJ ;AT END OF LINE, NOTHING TO DO. + REST CH ;NOT AT EOL, CONTINUE. + MOVE A,RRHPOS + JRST .+1] + SUB A,NHLNS + MOVEM A,RRHPOS +RRFORV: AOS RRVPOS + POPJ P, + +RRFORT: AOSA A,RRHPOS ;ORDINARY CHAR, MOVE FWD 1 POS. + JRST RRFORC ;NON-FORMATTING CONTROLS. + JRST RRFORH ;MOVE FWD OVER ^H - CHECK ^HPRINT FLAG. + JRST RRFWCR ;^M, SPECIAL. + JRST RRFORL ;^J, DOWN 1 LINE. + JRST RRFOTB ;^I + JRST RRFOR2 ;2-POS CTL CHRS NOT AFFECTED BY FS SAIL (^P AND ^C). + +RRFOTB: MOVE TT,RRHPOS + MOVEI A,10(TT) + ANDCMI A,7 ;A HAS NEXT TAB STOP'S POSITION. + CAMLE A,NHLNS ;BUT IF THAT'S OFF THE SCREEN, TAB STOP IS RIGHT MARGIN, + CAMN TT,NHLNS ;UNLESS WE'RE ALREADY AT THE MARGIN, IN WHICH CASE + CAIA ;WE CAN TAB 8 SPACES INTO NEXT LINE VIA CONTINUATION. + MOVE A,NHLNS + MOVEM A,RRHPOS + JRST RRFOR3 + +RRFWCR: SKIPGE DISPCR + JRST RRFWC1 + CALL GETCHR ;CR - SEE IF NEXT CHAR IS LF. + MOVEI A,(CH) + MOVEI CH,^M ;MAKE SURE WE RETURN CHAR BEING PASSED IN CH. + CAMGE IN,ZV + CAIE A,^J + JRST RRFOR2 ;NO, CR CAME OUT AS UPARROW-M +RRFWC1: SETOM RRHPOS ;(RRHPOS WILL BE AOS'D TO 0) + JRST RRFOR1 + +RRFORL: SKIPGE DISPCR ;LF: BASED ON WHETHER A CR PRECEDES IT AND ON DISPCR, + JRST RRFORV + SUBI IN,2 + CALL GETCHR ;DECIDE HOW THE LF CAME OUT AND THEREFORE + MOVEI A,(CH) + MOVEI CH,^J + MOVE TT,IN + ADDI IN,2 + CAML TT,BEGV + CAIE A,^M ;HOW TO MOVE OVER IT. + JRST RRFOR2 + JRST RRFORV + +RRFORH: SKIPGE DISPBS ;MOVING FWD OVER ^H -IF CAME OUT AS + SKIPN RRHPOS + JRST RRFORC + JRST RRBAC1 ;REAL ^H, MOVE BACK 1 POS + +;NON-FORMATTING CONTROLS, CHECK FS SAIL FLAG. +RRFORC: SKIPE DISSAI ;IN SAIL MODE, THEY'RE 1-POS GRAPHICS. + JRST RRFOR1 +RRFOR2: AOS RRHPOS ;ELSE TREAT AS 2-POS CTL CHAR. + JRST RRFOR1 + +;MAKE SURE RRHPOS IS CORRECT BY MOVING BACK TO THE LAST CR THAT +;REALLY CAME OUT AS A CR, AND MOVING FORWARD AGAIN. PT IS UNCHANGED. +;THE LARGEST HPOS THAT OCCURS ON THE LINE UP TO PT IS RETURNED IN OUT. +;PT IS RETURNED IN IN. CLOBBERS TT, TT1. +;A CONTAINS ADDR OF THE CR WE WENT BACK TO (+1), AND B HAS VPOS DIFFERENCE FROM THERE. +RRBTCR: SAVE CH + SAVE RRVPOS ;VPOS WILL BE ALTERED WHILE WE MOVE FWD + ;BUT WE REALLY DON'T WANT IT CHANGED. +RRBTC5: SAVE PT ;REMEMBER WHERE TO STOP WHEN MOVE FWD AGAIN. + MOVE A,GEA ;1ST, FIGURE OUT WHERE TO STOP MOVING BACKWARD + ADD A,BEGV ;IF WE DON'T FIND A CR. 1ST CHAR ON SCREEN + ;IS ONE PLACE. BEGINNING OF BFR IS ANOTHER. + SKIPL GEA + CAMLE A,PT ;(AT BOTH PLACES, HPOS MUST BE 0) + MOVE A,BEGV ;USE WHICHEVER WE'LL REACH SOONER. + MOVE B,PT ;STOP IN ANY CASE AFTER MOVING BACK 10000 CHARS. + SUBI B,10000. ;AT THAT POINT, BETTER TO CHOOSE A NEW WINDOW AND START OVER! + CAMG B,A ;NOW B GETS WHICHEVER OF THOSE TWO STOPPING POINTS IS REACHED FIRST. + MOVE B,A + SETZ OUT, ;ON 1ST PASS OUT=-1 => AN LF HAS BEEN PASSED GOING BACKWARDS. +RRBTC0: MOVE IN,PT + CAMG IN,B ;REACHED A STOPPING POINT => WHICH KIND? + JRST [ CAMN B,A ;A LEGITIMATE ONE (BEG OR TOP OF SCREEN) => + JRST RRBTC1 ;WE CAN JUST SCAN FORWARD FROM THERE. + REST PT + CALL [ CALL SAVACS + SETO A, + CALL VBDBLS ;ELSE, COMPUTE A NEW TOP OF SCREEN + JRST RSTACS] + JRST RRBTC5] ;AND TRY AGAIN. + SOS IN,PT + CALL GETINC ;ELSE, KEEP GOING BACK. + CAIN CH,^J + SETO OUT, ;REACHED LF => SAY NOT ON LINE WE STARTED ON. + CAIE CH,^M ;REACHED CR => SEE WHETHER IT CAME OUT AS ONE. + JRST RRBTC0 + JUMPE OUT,RRBTC0 ;BUT DON'T STOP AT ANY CR IF WE HAVEN'T GONE UP AT LEAST ONE LINE. + SKIPGE DISPCR + JRST RRBTC4 + CALL GETCHR + CAIE CH,^J + JRST RRBTC0 + AOS PT ;START AFTER THE CR AND THE LF. +RRBTC4: AOS PT ;START AFTER THE CR. +RRBTC1: SETZB OUT,RRHPOS ;AT THE CR, KNOW HPOS IS 0. + SAVE PT ;REMEMBER WHERE WE WENT BACK TO, TO RETURN IT IN A. + SAVE RRVPOS +RRBTC2: MOVE IN,PT ;REACHED WHERE WE STARTED? + CAMN IN,-2(P) + JRST RRBTC3 ;YES, FLUSH STACK & EXIT. + CALL RRFORW ;MOVE FWD TILL GET THERE. + MOVE A,RRVPOS ;IF WE'VE MOVED TO ANOTHER LINE, + CAME A,(P) + JRST [ MOVEM A,(P) ;THEN THE CHARS SEEN SO FAR ARE NOT ON THE SAME + SETZ OUT, ;LINE RRBTCR STARTED ON, SO THEY DON'T COUNT + JRST RRBTC2] ;IN OUT'S VALUE. + CAML OUT,RRHPOS ;IF CURRENT HPOS IS > LARGEST SO FAR, + JRST RRBTC2 + MOVE OUT,RRHPOS ;UPDATE MAXIMUM-HPOS-ON-CURRENT-LINE. + JRST RRBTC2 + +RRBTC3: REST B ;RETURN IN B THE VPOS DIFFERENCE WE MOVED OVER. + REST A ;RETURN IN A THE ADDR OF WHERE WE WENT BACK TO. + SUB P,[1,,1] + REST RRVPOS + SUB B,RRVPOS + JRST POPCHJ + +SUBTTL ^R MODE SYSTEM ECHO FOR SELF-INSERTING CHARACTERS + +IFN ITS,[ +RRECIN: SKIPN RRMAXP ;SYSTEM ECHO CAN'T BE USED IF WE HAVE PENDING REDISPLAY. + SKIPE RRMSNG + RET + MOVE IN,PT + CAMN IN,GPT ;ECHOING ALLOWED ONLY IF THE GAP IS AT POINT, AND NONEMPTY, + SKIPN EXTRAC + RET + MOVE D,NHLNS ;COMPUTE HPOS AT WHICH SYSTEM ECHOING MUST STOP + MOVE A,RRMACT+40 ;(WHICH DEPENDS ON WHETHER AUTO-FILL IS ON. + CAMN A,RRECSD ; CHECK THE DEFINITION OF SPACE TO FIND OUT). + MOVE D,ADLINE + CAMLE D,RRHPOS ;CAN'T USE SYSTEM ECHOING IF AT OR PAST THAT POINT. + SKIPE TYISNK ;CAN'T USE ECHOING WHILE DEFINING A KEYBOARD MACRO. + RET ;(WE COULD MAKE RRECI5 HANDLE IT, BUT WHAT IF + ; TYI SINK GETS AN ERROR ON ONE OF THE CHARS? + ; YOU SHOULD FIND OUT RIGHT AWAY). + SKIPE RRXINV ;CAN'T USE ECHOIN IF ALL "NORMAL" CHARACTERS ARE NOW FUNNY. + RET + CALL RREOLT ;(IN) ;ECHOING IS GOOD ONLY AT THE END OF A LINE. + CAIA + RET + .LISTEN A, ;WAIT FOR OUTPUT TO FINISH. IF THERE IS OUTPUT WAITING, + ;THEN ECHOING MIGHT BE DELAYED, AND A BREAK CHARACTER COULD + ;COME IN, AND ITS OUTPUT MIGHT HAPPEN BEFORE THE ECHOING! + JUMPN A,CPOPJ ;DON'T BOTHER COMPUTING BREAK TABLES IF NON-ECHOED INPUT HERE. +;COMPUTE THE BREAK TABLE. + SETZM SKNBPT + SKIPE RRPARN ;IF WE HAVE A CLOSEPAREN MACRO TO BE HACKED, + CALL SKNBCP ;GET POINTER TO LDB LISP SYNTAX OF CHAR IN A. + IBP SKNBPT + SETZ A, ;A SAYS WHICH ASCII CHARACTER. +RRECI1: MOVSI B,400000 ;B IS THE BIT FOR THAT CHARACTER. + SETO C, ;C IS THE BIT MASK BEING CONSTRUCTED. + MOVEI TT,RRXINS ;TT IS WHAT A NORMAL CHARACTER'S DEFINITION LOOKS LIKE. +RRECI2: CAMN TT,RRMACT(A) ;PROCESS 32 CHARS. MAKE A BIT MASK SAYING + ANDCM C,B ;WHICH OF THEM ARE NOT NORMAL SELF-INSERTING CHARACTERS. + LDB CH,SKNBPT ;IF CLOSEPAREN CHARS RUN A MACRO, AND THIS CHAR IS ONE, + CAIN CH,") ;THEN IT CAN'T BE ECHOED. NOTE THAT IF THERE IS NO MACRO, + IOR C,B ;SKNBPT WILL BE ZERO SO CH WILL BE ZERO. + LSH B,-1 + AOS A + TRNE A,37 + JRST RRECI2 + PUSH P,C ;PUSH THE NEXT WORD OF BIT MASK ON THE STACK, + CAIE A,140 ;THEN MAKE ANOTHER WORD FOR THE NEXT 32 CHARACTERS. + JRST RRECI1 + MOVSI B,400000 ;LOWER CASE ARE DIFFERENT SINCE THEY CAN BE INDIRECT. + MOVE TT1,[40,,RRINDR] +RRECI3: CAME TT1,RRMACT(A) ;SO START FROM THE WORD FOR UPPER CASE CHARS, AND TURN ON + IOR C,B ;THE BIT FOR ANY LOWER CASE CHAR THAT FAILS TO INDIRECT. + CAMN TT,RRMACT(A) ;BUT TURN IT OFF FOR ANY THAT IS SELF INSERTING + ANDCM C,B ;IN ITS OWN RIGHT (SUCH AS BRACES, TILDE, ETC). + LDB CH,SKNBPT ;IF CLOSEPAREN CHARS RUN A MACRO, AND THIS CHAR IS ONE, + CAIN CH,") ;THEN IT CAN'T BE ECHOED. NOTE THAT IF THERE IS NO MACRO, + IOR C,B ;SKNBPT WILL BE ZERO SO CH WILL BE ZERO. + LSH B,-1 + AOS A + CAIE A,200 + JRST RRECI3 + PUSH P,C + SKIPN DISSAI ;IF NOT IN SAIL MODE, CHARS 0-37 CAN'T BE INSERTED BY ECHOIN. + SETOM -3(P) + MOVSI A,400000 ;IF SPACE'S DEFINITION EQUALS FS ^R EC SP, WE CAN ECHO IT. + MOVE B,RRMACT+40 + CAMN B,RRECSD + ANDCAM A,-2(P) +;THE BREAK TABLE IS PUSHED. HOW MANY CHARACTERS CAN WE HANDLE? + MOVE B,D + SUB B,RRHPOS ;B GETS MAX NUMBER OF CHARACTERS TO HANDLE, + CAML B,EXTRAC ;WHICH CAN'T BE MORE THAN SIZE OF GAP. + MOVE B,EXTRAC + SKIPG E,RRMCCT + JRST RRECI6 + CAML B,RRMCC1 + MOVE B,RRMCC1 +RRECI6: MOVE BP,PT + CALL GETIBP ;BP GETS B.P. TO WHERE TO PUT THEM. + MOVEM BP,RRECBP ;SAVE OLD VALUE SO WE CAN SEE, AFTERWARD, WHAT GOT INSERTED. + MOVE E,PT +;THIS LABEL USED BY INTERRUPT ROUTINES TO SEE IF WE ARE INSIDE THE ECHOIN, AND EXIT IT IF SO. +RRECI7: SYSCAL ECHOIN,[%CLIMM,,CHTTYI ? BP ? B ? %CLIMM,,-3(P) ? %CLIMM,,BEG] + JFCL + MOVE T,PT + SUB T,E ;T HAS NUMBER OF CHARACTERS INSERTED. + JUMPE T,RRECIX ;0 => CAN JUST EXIT, BUT MAKE SURE RRECBP IS 0. + MOVE BP,RRVPOS + CALL RRINS3 ;UPDATE LINBEGS OF FOLLOWING LINES. + EXCH E,PT + CALL RRMOV ;UPDATE LINEND OF THIS LINE, AND RRHPOS, + MOVE TT,RRHPOS ;BY SCANNING OVER NEWLY INSERTED STUFF. + MOVE BP,RRVPOS + MOVEM TT,LINEND(BP) + MOVEM TT,RROHPO ;ALSO NOTE THAT THE TERMINAL CURSOR IS WHERE IT OUGHT TO BE. + CALL RRECI5 ;PUT INSERTED CHARS INTO THE TYPE-IN RING BUFFER. +RRECIX: SETZM RRECBP ;CLEAR THIS, OR ELSE ^Z $G WOULD DO RANDOM THINGS. +POP4J: SUB P,[4,,4] + RET + +;FIND ALL THE CHARS JUST INSERTED BY AN ECHOIN, AND PUT THEM IN THE TYI BUFFER. +;THIS IS CALLED ON RESTART AND BY QUITTING, IF RRECBP IS NONZERO. +RRECI5: MOVE A,RRECBP + MOVE BP,PT + CALL GETIBP + SETZM RRECBP +RRECI4: CAMN A,BP ;SIMULATE TYPING THE INSERTED CHARACTERS IN + RET + ILDB B,A ;BY PUTTING THEM IN THE TYI BUFFER RING + IDPB B,TYIBFP ;SO FS .TYINXT$ WILL SEE THEM. + CALL TYI1 + SETOM MODIFF ;ANY CHARACTERS INSERTED => BUFFER IS MODIFIED NOW. + SKIPLE RRMCCT + SOS RRMCC1 ;ADVANCE TOWARD RUNNING SECRETARY MACRO. + JRST RRECI4 +] ;IFN ITS + +SUBTTL ^R MODE ARGUMENT PROCESSING + +;^U - MULTIPLY REPEAT COUNT OR WHATEVER BY 4. +RR4TIM: SKIP + AOS RR4TCT + MOVEI TT,1 + JRST RRNXI2 ;SET RRARGP TO SAY NON-NULL ARG. + +;^V - READ IN A NUMERIC ARGUMENT. +;THE CHARS OF THE ARG ARE ECHOED IN THE ECHO AREA. +;^G CANCELS THE ARG. ANY OTHER NON-DIGIT IS TREATED AS A COMMAND +;WHICH USES THE ARG (THIS INCLUDES RUBOUT). THE ARG IS LEFT IN RRRPCT. +RRARG: SKIP C,[0] ;WE'LL COMPUTE ARG'S VALUE IN C. + CALL RRECSP ;TYPE A SPACE AT BOTTOM OF SCREEN. +RRARG0: CALL TYIW0 ;READ CHAR: EITHER PART OF ARG, OR NEXT COMMAND. + MOVEM CH,$Q..0 ;IF THE LATTER, IT WILL EXPECT TO BE IN Q..0. + CAIN CH,"- + JUMPE C,[SAVE [RRARGN] ;1ST CHAR IS "-" => NEGATE ARG. + JRST RRARG1] + CAIL CH,"0 + CAILE CH,"9 + JRST RRARGX ;NON-DIGIT: TERMINATE ARG. + IMUL C,IBASE ;DIGIT: PUT IT IN ARG. + ADDI C,-"0(CH) +RRARG1: CALL FSECO1 ;AND PRINT IT IN THE ECHO AREA. + JRST RRARG0 + +RRARGX: MOVEM C,RRRPCT ;SAVE AWAY THE ARG WE READ. + MOVEM CH,UNRCHC ;REPROCESS THE ARG-TERMINATING CHAR AS A COMMAND WITH THAT ARG + JRST RRNXIT ;SAY THERE'S AN ARG IN RRRPCT. + +RRARGN: MOVNS RRRPCT + RET + +RRCMNS: SKIP ;CONTROL-MINUS: SET BIT SAYING NEGATE THE ARGUMENT. + MOVEI TT,5 + JRST RRNXI2 + +RRCDGT: SKIP TT,RRRPCT ;CONTROL-DIGITS: ACCUMULATE AN ARGUMENT. + IMUL TT,IBASE + ANDI CH,77 ;WIN FOR META DIGITS AND C-M-DIGITS. + ADDI TT,-60(CH) + MOVEM TT,RRRPCT +RRNXIT: MOVEI TT,3 +RRNXI2: IORM TT,RRARGP + SETZM RRLAST ;SAY THIS IS ARG-SETTING COMMAND SO WON'T CLOBBER RRPRVC OR FLUSH ARG. + JRST POPJ1 ;SKIPPING IS LIKE RETURNING ONE VALUE TO ^R. + +;COMMANDS THAT WANT TO BE REPEATED A NUMBER OF TIMES EQUAL +;TO THE NUMERIC ARG DISPATCH THRU HERE. +;(THAT IS, THE DISPATCH WD HOLDS ,,RRREPT ) +RRREPT: SKIP ;TELL RRLP7H ERROR-CHECK WE'RE GOOD GUYS. + HLRZS E ;PUT IN RH. +RRREP1: JUMPLE C,POPJ1 ;C HAS -<# TIMES ALREADY DONE> + CAIN C,1 ;IF CALLING FOR THE LAST TIME, THEN IF COMMAND SKIPS WE SHOULD. + JRST (E) ;(THUS RETURNING 1 VAL IF CALLED WITH M COMMAND, OR TRIGGERING RRTTY). + SAVE E + HRLM CH,(P) ;SAVE CMD RTN ADDR AND THE CHAR. + SAVE C ;AND # TIMES REMAINING. + CALL (E) ;DO IT ONCE + JFCL + SKIPGE STOPF ;LET USER QUIT OUT OF C-U 100000 C-F. + CALL QUIT1 + REST C + REST E + HLRZ CH,E + SOJA C,RRREP1 + +;LIKE RRREPT, BUT IF REPEAT COUNT IS > 8 THEN SAY IN ADVANCE THAT +;REDISPLAY IS NEEDED (TO INHIBIT UPDATING). +;USED TO REPEAT INSERT COMMANDS, SO THAT ^U^UA DOESN'T +;RUN SLOWLY BY TYPING OUT AN A AT A TIME. +RRREPI: SKIP + HLRZS E +RRREP2: CAIG C,8 + JRST RRREP1 + SKIPN RRMAXP ;RRMAXP=1 INHIBITS UPDATING BUT DOESN'T MARK ANY ACTUAL PART + AOS RRMAXP ;OF THE BUFFER AS NEEDING REDISPLAY. THE INSERT RTN WILL CHANGE + JRST RRREP1 ;RRMAXP TO INCLUDE WHAT IT INSERTS. + +;COMPUTE THE ARGUMENT FROM THE EXPLICIT ARGUMENT AND +;THE POWER-OF-4. RETURN IN C. +RRARGD: MOVE TT,RRARGP ;GET THE EXPLICIT ARG, OR 1 IF NONE SPEC'D. + TRNE TT,2 + SKIPA C,RRRPCT + MOVEI C,1 + TRNE TT,4 ;IF ^- SET THE 4 BIT, NEGATE THE ARG. + MOVNS C + MOVE TT,RR4TCT ;THEN MULTIPLY BY 4 FOR EACH ^U. + SOJGE TT,[LSH C,2 ? JRST .] + RET + +;AFTER A COMMAND, IF IT DIDN'T IDENTIFY ITSELF AS AN ARGUMENT-SETTING COMMAND +;(BY CLEARING RRLAST), FLUSH THE ARGUMENT THAT THE COMMAND USED. +RRARGF: SKIPN TT,RRLAST ;IF THE LAST COMMAND DIDN'T PRESERVE OR MAKE AN ARG, + RET + MOVEM TT,RRPRVC ;REMEMBER IT AS "PREVIOUS COMMAND" FOR NEXT COMMAND, + SETZM RRARGP ;SAY TO GIVE NEXT COMMAND THE DEFAULT ARG (1) + SETZM RR4TCT ;AND CLEAR ARG ACCUMULATION VARIABLES. + SETZM RRRPCT + SETZM RRUNQT + RET + +;COME HERE FOR ^G. +RRQUIT: SKIP TT,CASNRM ;NOTE: THIS RTN IS CALLABLE BY RRLP7H, SO NEED "SKIP" + MOVEM TT,CASE ;IN F$ MODE, UNDO ANY CASE-LOCKAGE. + SETOM RRMKPT ;ELIMINATE THE MARK. + SKIPE NELNS + CALL ECHOCR ;GO TO NEW LINE IN ECHO REGION + SETOM RROVPO ;FORCE CURSOR REPOSITIONING + +;ERROR DETECTED BY RR EDIT: +RRERR: SKIP + SKIPE RREBEG ;IF NOT INSIDE ^R, GIVE A TECO ERROR. + TYPRE [BEL] + MOVE P,DISPRR + JRST TYPBEL ;TYPE A BELL AND REENTER MAIN LOOP. + +;"UNDEFINED" ^R COMMAND CHARACTERS HAVE THIS DEFINITION, WHICH TYPES A BELL +;AND RETURNS 1 VALUE. THIS AVOIDS GETTING A "BEL" ERROR, IF UNDEFINED CHAR +;IS RUN WITH M^R. +RRUNDF: SKIP + AOS (P) + JRST TYPBEL + +;EXPECT CHAR ADDR IN "IN", SKIP UNLESS IT POINTS TO THE END +;OF THE BUFFER OR THE END OF A LINE. CLOBBERS TT, TT1 +RREOLT: CAMN IN,ZV + POPJ P, ;AT EOF. + SAVE CH + CALL GETINC + CAIN CH,^M + CAMN IN,ZV + SOJA IN,POPCH1 ;BEFORE A CR THAT'S THE LAST CHAR. + CALL GETCHR + SUBI IN,1 + CAIE CH,^J +POPCH1: AOS -1(P) ;BEFORE A STRAY CR => NOT AT EOL. + JRST POPCHJ ;BEFORE A CRLF => EOL. + +;IF A CHARACTER 'S DEFINITION IS ,,RRINDR, IT IS AN INDIRECT PTR +;TO THE DEFINITION OF THE CHARACTER -. USED TO HANDLE +;THE LOWER CASE CONTROL CHARACTERS SUCH AS 341 = CTL-LOWERCASE-A. +;ALSO USED TO MAKE CONTROL-H EQUIVALENT TO BACKSPACE; SIMILAR FOR TAB & LF. +RRINDR: SKIP + HLRZS E ;GET + SUB CH,E + JRST RRIND1 ;GO USE DEF'N OF -. + +SUBTTL ^R MODE SINGLE CHARACTER DELETION AND INSERTION + +RRDLNB: MOVNS C ;HERE FOR DELETE BACKWARD WITH NEGATIVE ARG. + JRST RRCTD1 + +;^D -- DELETE FORWARD. (D) +RRCTLD: SKIP + JUMPGE C,RRCTD1 + MOVNS C + MOVEM C,RRRPCT ;IF NEGATIVE ARG, SET ITS NEGATION UP AS ARG + .I RRARGP=3 + SETZM RR4TCT + MOVEI CH,177 ;AND TURN INTO RUBOUT. + JRST RRIND1 + +RRCTD1: SKIPE RRARGP ;IF WE HAVE AN EXPLICIT ARGUMENT, + SKIPN A,RUBMAC ;CALL THE SUPPLIED MULTI-CHARACTER DELETE MACRO. + CAIA + JRST [ MOVNS C ;CALL WITH NEGATIVE ARG (NUMBER TO RUB OUT). + JRST RRMAC0] + JSP E,RRREP1 ;ELSE REPEAT WHAT FOLLOWS THAT MANY TIMES: + MOVE IN,PT + CAML IN,ZV + JRST RRERR + JSP E,RRTYPP ;ON PRINTING TTY, MAYBE TYPE SCAN INFO + CALL [ SETCM E,TTYOPT + CALL GETCHR ;GET CHARACTER ABOUT TO DELETE + MOVEI A,(CH) + MOVEI CH,"/ + TLNE E,%TOOVR\%TOMVB ;IF CAN BACKSPACE AND OVERPRINT, OVERPINT A SLASH. + CAIN A,^M ;ABOUT TO DELETE A CRLF, TYPE A SLASH. + CALL FSECOR + MOVEI CH,^H ;BS OVER IT IF OVERPRINTING + TLNN E,%TOOVR\%TOMVB + CALL FSECOR + MOVEI CH,(A) ;GET CHARACTER AGAIN + CALL FSECOR + SKIPN BSNOLF + RET + JRST RRMVC] ;THEN ECHO THE CHAR BEING DELETED. + SKIPN RUBCRL ;IF FS RUBCRLF$ NONZERO, + JRST RRDLF + CALL RREOLT ;IF BEFORE A CRLF, DELETE BOTH CHARS. + JRST [ CALL GAPSLP + CALL DEL1F ;DELETE THEM AT ONCE, AND DON'T TRY TO DO UPDATING. + CALL DEL1F + MOVE BP,RRVPOS + MOVE T,RRHPOS + MOVNI A,2 + JRST RRFXM1] + +;INTERNAL ROUTINE TO DELETE FORWARD. +RRDLF: CALL RRFORW ;MOVE OVER THE CHAR, THEN DELETE IT BACKWARD. + +;INTERNAL ROUTINE TO DELETE BACKWARD (-D). DELETED CHAR LEFT IN CH. +;CLOBBERS A,B,IN,OUT,TT,TT1,Q, T, BP +RRDLB: SETOM RRMKPT + MOVE IN,PT ;ERROR AT BEGINNING OF BUFFER. + CAMG IN,BEGV + JRST RRERR + SAVE RRVPOS ;REMEMBER VPOS TO RIGHT OF CHARACTER. + CALL RRBACK ;ACCOUNT FOR CURSOR POS CHANGE DUE TO DELETION. + CALL GAPSLP + CALL RRCRDI + CALL DEL1F ;DELETE FORWARD FROM BUFFER, NO CURSOR HACKERY. + CAIE CH,^H ;DELETING CHARS THAT MOVE LEFT IS HARD. + CAIN CH,^M + JRST RRDLB4 + CAIE CH,^I + SKIPN DISSAI + CAIL CH,40 ;BETTER NOT BE DIFFICULT CHARACTER + CAIN CH,177 + JRST RRDLB4 ;IF IT IS, JUST REDISPLAY + CALL RRICHK ;SEE WHETHER IT'S EASY TO UPDATE SCREEN. + REST A + CAMN A,BP ;IF EFFECTS OF CHANGE REACH PREV. LINE, + SKIPE RRMAXP ;OR IF REDISPLAY WILL BE DONE ANYWAY. + JRST RRDLB1 ;DON'T BOTHER TO DO IT HERE. + CALL RRMVC ;UPDATE THE SCREEN NOW: + MOVNI T,1 ;UPDATE LINBEG WORDS OF ALL LINES + CALL RRINS3 ;BELOW THIS ONE. + MOVE BP,RRVPOS + SKIPGE T,RRCIDP + JRST [ SETOM HCDS(BP) ;IF MOVING CHARS TO NEW HPOSES, WE CAN'T FIX THE HASHCODE. + SOS LINEND(BP) + MOVEI A,1 + JRST DELCHR] + CALL CHCTHR ;ELSE REMOVE THIS CHARACTER FROM THE HASH CODE; RRHPOS IS HPOS. + JUMPG T,ERSCHR ;NOW GO CLEAR OUT THE APPROPRIATE PARTS OF THE SCREEN. + MOVE T,RRHPOS + MOVEM T,LINEND(BP) ;AT END OF LINE => CURRENT POS IS NEW END-OF-LINE POS. + JRST CLREOL + +RRDLB4: SUB P,[1,,1] ;FLUSH SAVED VPOS. FROM STACK. + SKIPGE DISPCR + SETZ T, ;DELETING A REAL STRAY CR => MUST REDISPLAY WHOLE LINE + ;TO GET RID OF OVERSTRUCK CHAR IN POSITION 0. +RRDLB1: MOVNI A,1 ;1 CHAR DELETED AT VPOS, HPOS IN BP,T. + JRST RRFXM1 + +FSRRRU: ARGDFL Z ;FS ^R RUBOUT$ + SAVE [RRLEA1] ;AFTERWARDS SET RREPT, RREHPS, RREVPS. + JSP E,RRREP2 + JRST RRDLB ;RUB OUT SPEC'D # OF CHARS WITH NO TAB OR CRLF HACKS. + +;BUILT-IN DEFINITION OF RUBOUT: DECODE ARGUMENT. +RRRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + SKIPE RRARGP ;ELSE, EXPLICIT ARG MEANS CALL + SKIPN A,RUBMAC ;THE MULTI-CHAR DELETE MACRO, IF ANY. + CAIA + JRST RRMAC0 + JSP E,RRREP2 ;REPEAT ARG TIMES WHAT FOLLOWS (BUT FIRST OTHER STUFF) +RRRUBD: SKIPN RRRPLC ;RUBOUT IN OVERWRITE MODE MEANS + JRST RRRUB1 + MOVE IN,PT ;REPLACE PREVIOUS CHARACTER WITH A SPACE. + CAMG IN,BEGV ;BUT THERE MUST BE A PREVIOUS CHARACTER, + JRST RRRUB1 + SOS IN + CALL GETCHR + CAIE CH,^J ;AND IT MUSTN'T BE ONE OF THESE FUNNY ONES. + CAIN CH,^M + JRST RRRUB1 + CAIE CH,^I + CAIN CH,^H + JRST RRRUB1 + CAIN CH,^L + JRST RRRUB1 + CALL RRBACK ;SO REPLACE PREV. CHAR WITH A SPACE BY BACKING UP + MOVEI CH,40 ;AND DOING AN OVERWRITE-MODE INSRT OF A SPACE. + MOVEM CH,$Q..0 + CALL RRDINS + JFCL + JRST RRBACK ;THEN BACK UP OVER THE SPACE AGAIN. + +RRRUB1: CALL RRDLB ;DELETE ONE CHAR BACKWARD + SKIPE RUBCRL ;AND THEN IF FS RUBCRLF$ NONZERO, AFTER RUBBING OUT A ^J + CAIE CH,^J + JRST RRRUBP + MOVE IN,PT ;FLUSH A CR BEFORE IT, TOO. + SOS IN + CAMGE IN,BEGV + JRST RRRUBP + CALL GETCHR + CAIN CH,^M + CALL RRDLB +RRRUBP: JSP E,RRTYPP ;ON PRINTING TTY, IF SCANNING, TYPE THE RUBBED CHARACTER. + CAIA ;NOTICE THAT IF RUBBING A CRLF WE COME HERE FOR THE CR + RET ;WHICH WILL ECHO AS CRLF. + MOVE E,TTYOPT + TLNE E,%TOMVB ;ON TTY THAT CAN'T BS, SURROUND RUBBED STUFF WITH \'S. + JRST RRRUBB + MOVEI IN,"\ + SAVE CH + MOVEI CH,"\ + CAME IN,RUBENC ;IF NOT YET INSIDE A \ PAIR, START ONE. + CALL FSECO1 + SETZM RUBENC ;IF INSIDE ONE ALREADY, DON'T END IT YET. + REST CH + CALL FSECOR ;TYPE THE RUBBED CHARACTER. + MOVEM IN,RUBENC ;FOLLOW WITH A \ WHEN WE STOP RUBBING OUT. + RET + +RRRUBB: CALL RRTTY2 ;MOVE CURSOR TO RIGHT PLACE. THIS KING OF RUBOUT CAN INTERMIX + MOVEI CH,"/ ;WITH BACKWARD MOTION. + CALL FSECOR ;OVERSTRIKE A / (MAY ERASE OR NOT, WHO CARES?) + JRST RRMVC + +;CTL-RUBOUT: LIKE RUBOUT, BUT CONVERTS TABS INTO SPACES FIRST. +RRCRUB: SKIP + JUMPL C,RRDLNB ;NEGATIVE ARG => REALLY DELETE FORWARD. + SKIPE RRARGP ;ELSE, EXPLICIT ARG MEANS CALL + SKIPN A,RUBMAC ;THE MULTI-CHAR DELETE MACRO, IF ANY. + JRST RRCRU2 + MOVEM C,NUM + SETOM SARG ;FOR TAB-HACKING, GIVE IT -1 AS ^X ARG. + TRO FF,FRARG2 + JRST RRMAC7 ;FRARG2 WON'T BE SET, BUT THAT DOESN'T MATTER. + +RRCRU2: JSP E,RRREP2 ;REPEAT THE FOLLOWING ARG TIMES: + SAVE RRHPOS + CALL RRBACK ;WE NEED HPOS BOTH BEFORE AND AFTER CHAR TO BE FLUSHED, + REST E ;IF IT'S A TAB. + CAIE CH,^I + JRST [ CALL RRFORW ;NOT TAB => UNDO THE RRBACK + JRST RRRUBD] ;AND DO A NORMAL RUBOUT. + CALL GAPSLP + SAVE PT + AOS (P) + CALL DEL1F ;ELSE FLUSH THE TAB AND PUT IN APPRO. # OF SPACES + SUB E,RRHPOS +RRCRU1: MOVEI CH,40 + CALL TYOM + SOS PT + CALL RRFORW ;MOVING FORWARD OVER THEM + SOJG E,RRCRU1 ;LEAVING US IN INITIAL STATE EXCEPT TAB REPLACED BY SPACES. + REST T + SUB T,PT + MOVNS T ;T HAS CHANGE IN PT DUE TO OUR INSERTION. + MOVE BP,RRVPOS + CAMGE BP,TOPLIN ;IF THE CHANGE IS ABOVE THE SCREEN, RELOCATE ALL LINBEGS IN THE WINDOW. + MOVE BP,TOPLIN + CAMGE BP,BOTLIN ;IF THIS CHANGE IS OFF THE END OF THE SCREEN, WE ARE DONE. + CALL RRINS3 ;RELOCATE LINBEG TABLE FOR WHAT WE HAVE DONE. + JRST RRRUBD ;THEN DELETE THE LAST SPACE. + +;COME HERE WHEN CASE-SHIFT IS READ. +RRSFT: MOVNS CASE ;READ NEXT CHAR IN ABNORMAL CASE. + AOSE RCHSFF + SETOM RCHSFF ;RESTORE TO NORMAL AFTER NEXT CHAR. + SKIPN RCHSFF ;ALLOW THE CASE-SHIFT TO QUOTE ITSELF. + JRST RRLP7J + +;TYPE THE CHAR IN Q..0 AS A PROMPT, IF THERE IS NO INPUT AVAILABLE. +RRECO1: SKIPE RGETTY + SKIPGE RRECHO ;ON DISPLAY TTY, IF NOT ECHOING THE COMMAND, + RET + MOVEI A,[ASCIZ /0^V^:FT..00 /] + JRST RRMACR + +;COME HERE FOR CASE-LOCK AS A COMMAND. +RRLOK: MOVNS CASE + POPJ P, + +;^O - INSERT CRLF, THEN BACK UP OVER IT. +RRCTLO: CALL RRCRL1 ;INSERT CRLF + JFCL + AOS (P) + CALL RRBACK ;THEN BACK OVER IT. + JRST RRBACK + +;^M - INSERT ^M AND ^J. +RRCRLF: CALL RRCMRU ;REMOVE TAB-SEMI'S FROM LINE WE'RE ON. +RRCRL1: MOVEI CH,^M + CALL RRINS ;INSERT THE ^M. + MOVEI CH,^J + JRST RRINSQ ;INSERT THE ^J. + +;^Q -- READ NEXT CHAR AND INSERT IT. +RRQUOT: SKIP + SAVE C + CALL RRECO1 ;FINISH DISPLAYING, MAYBE PROMPT WITH A "^Q". + CALL TYI ;READ THE CHAR TO BE QUOTED. + CALL TYINRM + REST C + JSP E,RRREP1 ;NOTE ^Q MUST DO ITS OWN REPETITION. + JRST RRINSQ ;OTHERWISE ^V5^Q WOULD READ AND INSERT 5 CHARS. + ;INSTEAD OF READING 1 CHAR AND INSERTING + ;IT 5 TIMES. + +;THIS IS THE DEFAULT DEFINITION OF "SELF-INSERTING" CHARACTERS: +;NORMALLY, JUST INSERT. META-CHARS INSERT. IF FS ^R REPLACE$ NONZERO, +;NON-META CHARS REPLACE INSTEAD (BUT AT END OF LINE, THEY INSERT). +RRDINS: MOVE CH,$Q..0 + TRNN CH,META + SKIPN RRRPLC + JRST RRINSC + MOVE IN,PT + CAML IN,ZV ;AT END OF BUFFER, JUST INSERT. + JRST RRINSC + CALL GETCHR ;HERE IF SUPPOSED TO TRY TO REPLACE. + CAIE CH,^M ;AT END OF LINE? + CAIN CH,^J + JRST RRINSC ;YES => INSERT, DON'T REPLACE. + CAIE CH,^H + CAIN CH,^L + JRST RRINSC + CAIN CH,^I + JRST RRDINT +RRDIN0: AOS (P) + CALL RRICH9 ;CHECK FOR VARIOUS CONDITIONS PROHIBITING UPDATING. + CALL RRFORW + SAVE RRHPOS ;WHAT IS HPOS AFTER THE CHAR WE ARE REPLACING?? + CALL RRBACK ;DELETE THAT CHARACTER. + SAVE CH + SAVE RRHPOS + CALL GAPSLP + CALL DEL1F + MOVE CH,$Q..0 + CALL TYOM ;INSERT THE NEW CHARACTER. + SOS PT + MOVE BP,RRVPOS + CALL RRFORW ;WHAT IS THE HPOS AFTER THE NEW CHARACTER? + REST T ;T GETS HPOS BEFORE THIS CHARACTER. + REST B ;B HAS CHAR WE ARE REPLACING. + REST A ;A GETS HPOS AFTER CHAR WE REPLACED. + CAMN A,RRHPOS ;HPOS AFTER THIS CHAR SAME AS AFTER OLD => WE CAN REWRITE ON SCREEN, + CAME BP,RRVPOS ;AS LONG AS IT DOESN'T CONTINUE THE LINE. + JRST RRDIN3 + CAIE CH,ALTMOD ;EITHER CHAR IS ALTMODE => CAN'T UPDATE. + CAIN B,ALTMOD + JRST RRDIN3 + SKIPE RRMAXP + JRST RRDIN3 + EXCH T,RRHPOS ;T GETS HPOS AFTER (LIKE A), RRHPOS GETS HPOS BEFORE CHAR. + EXCH CH,B + CAIN CH,11 + MOVEI CH,40 + CALL CHCTHR ;UPDATE HASH CODE OF LINE FOR CHAR BEING REPLACED. + MOVE CH,B + CALL CHCTHI ;UPDATE THE HASH CODE OF THE LINE FOR CHAR BEING INSERTED. + CALL RRMVC ;MOVE TO HPOS OF START OF CHARACTER. + SUB A,RRHPOS ;A GETS NUMBER OF POSITIONS THE CHARACTER TAKES. + CAIE A,1 + SETOM HCDS(BP) ;MORE THAN 1 => WE CAN'T FIX THE HASH CODE, SO CALL FOR REDISPLAY. + MOVE TT,TTYOPT + TLNN TT,%TOOVR ;IF TERMINAL CAN OVERPRINT, WE MUST CLEAR THE SPOTS. + JRST RRDIN2 +RRDIN1: CALL ERSCHR ;CLEAR OUT THAT MANY POSITIONS. + MOVEI CH,40 + CALL TYOINV + SOJG A,RRDIN1 + SETOM RROHPO + CALL RRMVC ;THEN RESTORE CURSOR POSITION. +RRDIN2: MOVEM T,RRHPOS ;SET HPOS TO ITS VALUE AFTER THE NEW CHARACTER. + MOVEM T,RROHPO + MOVE CH,$Q..0 ;NOW PRINT THE NEW CHARACTER AT THE DESIRED PLACE. + SKIPE CASDIS + CALL DISAD6 + JRST TYOINV + +RRDIN3: SETZ A, ;HERE TO UPDATE RRMNVP, RRMNHP, RRMAXP IF CAN'T UPDATE SCREEN. + JRST RRFXM1 ;T HAS HPOS OF CHAR, BP HAS VPOS. + +RRDINT: .I RRHPOS+1 ;BEFORE A TAB => INSERT UNLESS TAB NOW TAKING ONLY 1 SPACE. + TRNN TT,7 + JRST RRDIN0 +RRINSC: MOVE CH,$Q..0 +RRINSQ: AOS (P) + TRZ FF,FRARG2 + JRST RRINS + +FSRRINS:MOVE CH,C ;USER-INTERFACE TO RRINS: FS ^R INSERT$ + +;INSERT CHAR IN CH. +;CLOBBERS A, B, IN, OUT, TT, TT1, CH, Q, T, BP +RRINS: CALL TYINRM ;CONVERT CHARACTER TO ASCII. + SETOM RRMKPT + SKIPN RRMAXP + CAIN CH,^I ;INSERTING ANY CTL CHAR BUT TAB IS HARD. + JRST RRINS2 + CAIL CH,40 + CAIN CH,177 + AOSA RRMAXP +RRINS2: CALL RRICHK ;SEE IF OBVIOUSLY CAN'T UPDATE SCREEN NOW. + CALL RRCRDI + CALL [ CALL TYOMGS ;INSERT CHAR AFTER PT. + SOS PT + POPJ P,] + MOVE Q,RRHPOS + CALL RRFORW ;THEN MOVE FORWARD OVER IT. + MOVEI A,1 ;(FOR RRFXM1) 1 CHAR INSERTED. + CAMN BP,RRVPOS ;CHAR MOVED TO NEXT LINE => MUST REDISPLAY + SKIPE RRMAXP ;IF REDISPLAY ALREADY NEEDED, DON'T TRY TO UPDATE FOR THIS. + JRST RRFXM1 + SKIPE RRCIDP ;IF GOING TO DO SOMETHING WITH CHAR I/D + CAIE CH,^I ;MUST BE AN EASY CHAR + CAIA + JRST RRFXM1 ;FOR TABS REDISPLAY REQUIRED + MOVE T,Q + EXCH T,RRHPOS ;POSITION CURSOR AT HPOS BEFORE THE CHARACTER. + CALL RRMVC + CALL CHCTHI ;USE THAT HPOS TO UPDATE LINE'S HASH CODE. + CAIN CH,^I ;AFTER A TAB, THE HASH CODE WAS NOT UPDATED PROPERLY. + SETOM HCDS(BP) + MOVEM T,RRHPOS + MOVEM T,RROHPO + MOVEI T,1 ;UPDATE LINBEG WDS OF ALL LINES + CALL RRINS3 ;BELOW THIS LINE. + MOVEI A,1 + SKIPGE RRCIDP ;IF USING CHAR I/D FOR THIS + CALL INSCHR ;INSERT THE SPACE FOR IT FIRST + MOVE BP,RRVPOS + SKIPN CASDIS ;IF CASE FLAGGING MIGHT BE HAPPENING, + SKIPGE RRCIDP ;OR IF WE ARE MOVING OTHER CHARACTERS AROUND, + SETOM HCDS(BP) ;THEN UPDATING THE HASH CODE LOST, SO CALL FOR REDISPLAY OF LINE. + SKIPE CASDIS ;OUTPUT CHARACTER, WITH CASE-SHIFT IF ANY. + CALL DISAD6 + SKIPG RRCIDP ;IF AT END OF LINE OR INSERTING, UPDATE REMEMBERED LINE-END-HPOS. + AOS LINEND(BP) + MOVE TT,RRHPOS + SKIPN RRCIDP ;INSERTING AT END OF LINE => CURRENT HPOS IS NEW END-OF-LINE HPOS. + MOVEM TT,LINEND(BP) ;THIS IS USUALLY SAME AS AOS'ING BUT NOT WHEN TAB IS INSERTED! + JRST TYOINV + +RRINS3: ADDM T,RROLDZ + ADDM T,RROLZV + JRST RRDISG + +;CHECK FOR SOME OF THE THINGS THAT WOULD RULE OUT UPDATING THE +;SCREEN IMMEDIATELY FOR AN INSERT OR DELETE. IF ANY IS +;FOUND, LEAVE RRMAXP NONZERO (THIS WON'T CONFUSE RRLP BECAUSE +;WE'LL SET RRMAXP ANYWAY IN ORDER TO CAUSE REDISPLAY) +;REDISPLAY WILL ALWAYS WORK, BUT UPDATING IS FASTER. +;CLOBBERS A, B, IN, OUT, TT, TT1 +RRICHK: HRROS (P) ;SET SIGN FOR CHECKING INSERTION AND DELETION. + CAIA +RRICH9: HRRZS (P) ;CLEAR SIGN FOR CHECKING FOR REPLACEMENT. + SETZM RRCIDP ;SO FAR NO TAB OR CHAR I/D STUFF APPEARS TO BE NECESSARY. + SKIPN RRINHI + SKIPE RRMSNG + JRST RRICH2 + SKIPE RRMAXP ;REDISPLAY NECESSARY ANYWAY => + RET ;IT WILL FIX SCREEN; WE NEEDN'T. + SAVE CH + SKIPN RGETTY + JRST RRICH1 ;CAN'T UPDATE IF THERE'S A CURSOR STRING. + MOVE CH,RRVPOS ;IF CURSOR IS OFF SCREEN, + CAML CH,TOPLIN + CAML CH,BOTLIN ;DON'T UPDATE, REDISPLAY IS NEEDED. + JRST RRICH1 + SKIPL -1(P) + JRST RRICH4 + MOVE IN,PT + CALL RREOLT ;UPDATING FOR INSERT/DELETE POSSIBLE ONLY AT END OF LINE. + CAIA + JRST RRICH3 ;UNLESS BEFORE TAB OR CHAR I/D CAN BE USED +RRICH4: LISTEN A ;MANY UPDATES DON'T BEAT 1 REDISPLAY. + SKIPN TYISRC + CAIL A,5 + JRST RRICH1 + SKIPL DISPCR ;IF THERE ARE NO REAL BS'S OR STRAY CR'S + SKIPGE DISPBS + CAIA + JRST POPCHJ ;NO NEED FOR THE NEXT TEST. + CALL RRBTCR ;PERHAPS, DUE TO BACKSPACES, SOMETHING + CAMG OUT,RRHPOS ;EARLIER IN THE LINE APPEARS FARTHER + JRST POPCHJ ;RIGHT ON THE SCREEN (EG ABC/\) +RRICH1: REST CH +RRICH2: AOS RRMAXP ;CAUSE CALLER NOT TO TRY UPDATING. + RET + +;CHECK FOR CONDITIONS THAT MIGHT ALLOW US TO AVOID REDISPLAY EVEN IF +;NOT AT THE END OF THE LINE, IF RETURNS SUCCESSFUL, RRCIDP WILL BE +;POSITIVE IF WE ARE BEFORE A TAB THAT TAKES MORE THAN 1 SPACE AND SO +;CAN INSERT BY OVERWRITING, OR NEGATIVE IF WE ARE TO USE CHAR I/D +RRICH3: SKIPE CASDIS ;DONT GET SCREWED BY FLAGGING + JRST RRICH1 ;JUST REDISPLAY IN THAT CASE + CALL GETINC ;GET NEXT CHAR + CAIE CH,^I ;IS IT A TAB? + JRST RRICH5 ;NO, TRY CHAR I/D MAYBE + .I RRHPOS+1 ;GET NUMBER OF CHARS IT USES + TRNN TT,7 ;IF MORE THAN ONE + JRST RRICH1 + AOS RRCIDP ;SAY HACKING A TAB, + JRST RRICH4 ;AND GO CONTINUE CHECKS + +RRICH5: SKIPE CID ;TRY TO USE CHAR I/D? + CALL RRNTBP ;CHECK THAT THE LINE HAS NO TABS AFTER THIS IN IT + JRST RRICH1 ;NO, FORGET IT, MUST REDISPLAY + SETOM RRCIDP ;SAY USE CHAR I/D FOR THIS ONE + JRST RRICH4 ;AND CONTINUE CHECKING + +;CONVERT LOWER CASE TO UPPER OR VICE VERSA, ACC. TO FS CASE $ +;FOR SHIFT OR LOCK CHARS, RCHSFT AND RCHLOK MIGHT GET CALLED! +RRCASC: TRNE CH,CONTRL+META + RET + CAIL CH,100 ;[ ;XCTING WOULD LOSE ON ALTMODE, ^]. + XCT RCHDTB(CH) ;SKIPS FOR CHARS WHOSE CASE IS WRONG. + CAIA + XORI CH,40 ;CHANGE TO THE OTHER CASE. + MOVEM CH,$Q..0 + AOSN RCHSFF + MOVNS CASE ;IF PREV. CHAR WAS CASE SHIFT, UN-COMPLIMENT CASE. + POPJ P, + +;CHECK IF THE CURRENT LINE HAS TABS IN IT AFTER PT, WHICH MIGHT MAKE +;AVOIDING REDISPLAY TOO HARD, SKIP IF NONE FOUND AND BUFFER LINE DOES NOT +;WRAP AROUND TO SEVERAL SCREEN LINES +RRNTBP: SAVE BP + MOVE IN,PT + CALL GETIBI ;GET POINTER TO CURRENT POSITION +RRNTB1: CAMN IN,ZV + JRST RRNTB3 ;AT THE VERY END, OK NO TABS THEN + CAMN IN,GPT + CALL FEQGAP ;MOVE OVER GAP + ILDB CH,BP +RRNTB2: CAIN CH,^I ;IS IT A TAB? + JRST POPBPJ ;YES, FAILURE THEN + CAIE CH,^M ;GOT TO CR? + AOJA IN,RRNTB1 ;NO, KEEP LOOKING + AOJ IN, + CAMN IN,ZV + JRST RRNTB3 + CAMN IN,GPT + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;REALLY AT CRLF? + AOJA IN,RRNTB2 ;NO, STRAY CR + SUBI IN,1 ;CHECK HPOS JUST BEFORE THE CR. +RRNTB3: SKIPGE DISTRN ;IF WE ARE JUST TO TRUNCATE LONG LINES + JRST POPBP1 ;THAT'S ENOUGH CHECKING, SKIP RETURN +INSIRP PUSH P,RRHPOS RRVPOS PT E + MOVE E,IN + CALL RRMOV ;FIND POSITION OF END OF LINE (AS OF LAST REDISPLAY) + MOVE TT,RRHPOS ;GET NEW VALUES + MOVE TT1,RRVPOS +INSIRP POP P,E PT RRVPOS RRHPOS + CAME TT1,RRVPOS ;ON THE SAME LINE? + JRST POPBPJ ;NO, MUST REDISPLAY THEN + CAMGE TT,NHLNS ;ALSO IF THIS WOULD BE DISPLAYED PAST END OF LINE +POPBP1: AOS -1(P) ;SUCCESS RETURN + JRST POPBPJ + +;TAKE CARE OF THE POSSIBILITY THAT CHANGING THE BUFFER AFTER PT MAY +;CHANGE WHAT APPEARS ON THE SCREEN BEFORE PT. (FOR EXAMPLE, +;INSERTING OR DELETING A LF AFTER A CR.) +;FOLLOW A CALL TO RRCRDI WITH AN INSN THAT CHANGES THE BUFFER +;AFTER PT, BUT DOESN'T CHANGE PT, AND DOESN'T CLOBBER BP OR T. +;ON RETURN, PT IS UNCHANGED, RRHPOS AND RRVPOS +;ARE CORRECT, AND BP,T CONTAIN THE V AND HPOS OF A PLACE ON THE SCREEN +;BEFORE WHICH NOTHING NEEDS TO CHANGE. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRCRDI: SAVE CH + SAVE PT + CALL RRCRDB ;MOVE BACK TO BEFORE ALL BEFORE-EFFECTS. + MOVE IN,PT + CAMN IN,(P) ;IF WE DIDN'T MOVE BACK AT ALL, NO PROBLEM. + JRST RRCRDX + SUB IN,BEG ;ELSE REMEMBER HOW FAR BACK WE MOVED, + EXCH IN,(P) ;RELATIVE TO BEG IN CASE BUFFER MOVES. + MOVEM IN,PT ;GIVE PT THE RIGHT VALUE FOR USER'S RTN, + MOVE CH,-1(P) ;AND CH. + MOVE T,RRHPOS ;GET HPOS AND VPOS OF PLACE WE MOVED BACK TO, + MOVE BP,RRVPOS ;TO RETURN TO OUR CALLER. + XCT @-2(P) ;DO WHAT CALLER WANTED DONE. + MOVE IN,(P) ;SET PT TO WHERE WE MOVED BACK TO + ADD IN,BEG + EXCH IN,PT ;BUT REMEMBER ITS REAL VALUE. + MOVEM IN,(P) +RRCRD1: CALL RRFORW ;THEN MOVE FWD OVER WHAT WE MOVED + CAME IN,(P) ;BACK OVER. + JRST RRCRD1 + SUB P,[1,,1] + JRST POPCH1 + +RRCRDX: MOVE T,RRHPOS ;NO PROBLEM OF BEFORE-EFFECTS, JUST + MOVE BP,RRVPOS ;RETURN THE HPOS AND VPOS, AND EXIT + SUB P,[1,,1] ;TO THE USER'S BUFFER-MUNGING INSN. + JRST POPCHJ + +RRCRDB: MOVE IN,PT + SUBI IN,1 ;ARE WE AFTER A CR? IF SO, IT MAY CHANGE FORM. + CAMGE IN,BEGV + POPJ P, ;AT BEGINNING OF BUFFER, NO PROBLEM. + CALL GETCHR ;ARE WE AFTER A CR? + CAIN CH,^M ;IF SO, IT MIGHT CHANGE FORM. + CALL [ SKIPL DISPCR ;IF IT CAN COME OUT AS "^M" + JRST RRBACK ;THEN IT CAN PROPAGATE BEFORE-EFFECTS. + JRST POP1J] ;ELSE, IT GUARANTEES NO BEFORE-EFFECTS. + MOVE IN,PT + SUBI IN,2 ;IF IN HORIZ. POS. 0, AND + SKIPG RRHPOS + CAMGE IN,BEGV ;NOT NEAR THE BEGINNING OF BUFFER, + POPJ P, + CALL GETINC ;AND NOT SHORTLY AFTER A CR (NOTE THIS + CAIN CH,^M ;CATCHES A PRECEDING CRLF) + RET + CALL GETCHR + SKIPGE DISPBS ;AND NOT RIGHT AFTER A ^H THAT REALLY BACKSPACES (THEN MOVING BACK + CAIE CH,^H ;OVER IT WOULD UNDERESTIMATE!) + CALL RRBACK ;THEN MAYBE "!" MUST BE WRITTEN OR ERASED AT END OF PREVIOUS LINE. + POPJ P, + +SUBTTL LEAVE ^R, UPWARD OR DOWNWARD + +;ALTMODE - LEAVE ^R MODE. +RREXIT: SKIP A,RREBEG + JUMPN A,FSCREX ;IF COMING FROM M.^R$, DO A FS^REXIT$. +RREXI0: MOVE CH,QRB.. ;DON'T INHIBIT REDISPLAY AT NEXT OPPORTUNITY (UNLESS RRLEVM TYPES) + SETZM .QVWFL(CH) + TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPGE -3(A) + JRST RREXI2 ;^ V - LEAVE FLNOIN ON. + SKIPE A,RRLEVM ;IF EXITING ^R, RUN FS ^R LEAVE$. + CALL RRMACR + TLZ FF,FLNOIN +RREXI2: MOVE P,DISPRR + SUB P,[1,,1] ;POP OFF RET ADDR AT RRLP + REST DISPRR + CALL RRLEAV ;SET UP "RRE" VARIABLES. + SETOM ECHCHR ;A ^R COMMAND WHICH CALLS ^R SHOULDN'T HAVE ECHOING WHEN IT RETURNS. + ANDCMI FF,FRARG+FRARG2 + SKIPE DISPRR ;IF EXITING THE OUTERMOST LEVEL OF ^R, + JRST RREXI1 + CALL SETTTM ;TURN ON SYSTEM ECHOING AGAIN. + MOVE CH,QRB.. + SKIPE A,.QCRMC(CH) ;EXECUTE THE SECRETARY MACRO IF ANY. + CALL MACXQ +RREXI1: REST C ;POP QREG PDL PTR SAVED AT ENTRY TO ^R + CALL FSQPU0 ;UNWIND PDL DOWN TO THAT LEVEL. + JRST POP1J + +RRTHRW: MOVE CH,DISPRR ;RETURN TO ^R MAIN LOOP. + PUSHJ CH,SETP1 + MOVEI TT,RRLP ;RETURN TO IT AT NORMAL RETURN, NO MATTER WHERE WE LEFT IT FROM. + MOVEM TT,(P) + .I RRLAST=RRPRVC ;MAKE SURE ARGS GET FLUSHED. + JRST RREAR0 ;WE'RE COMING FROM OUTSIDE ^R, SO MUST OFFICIALLY RE-ENTER. + +RRLEAV: .I RREZ=Z + .I RREBEG=BEG +RRLEA1: +RRLEA2: .I RREPT=PT + .I RREHPS=RRHPOS + .I RREVPS=RRVPOS + .I RREBUF=BFRSTR + RET + + +;[ ;HANDLE THE ^] COMMAND IN ^R MODE. +;CLOBBERS ALL ACS. SKIPS. +RRBRC: SKIP + MOVEI A,[ASCIZ /[0[1MU0:I1 +<^V^:FT0 FIU0 :I110 Q0-."N0;'> +F^:M(:I* F^:M1(]1]0) ) /] + +RRMAC0: SKIP ;SUPPLY ^R-STYLE NUMERIC ARG AS ARG TO MACRO. + MOVEM C,NUM ;SUPPLY THE COMMAND'S ARG, OR 1 (THE DEFAULT), TO THE MACRO, + TRZ FF,FRARG + SKIPE RRARGP +RRMAC6: IORI FF,FRARG ;AND TELL IT IT HAS AN ARG IF THE ARG IS NON-DEFAULTED. + JRST RRMAC5 + +;CALL THE MACRO IN A WITH NO ARG., AND LOOK AT ITS RETURNED VALUES TO DECIDE +;HOW TO UPDATE THE ^R-MODE VARIABLES. +RRMACR: ANDCMI FF,FRARG + SETZM NUM +RRMAC5: SETZM SARG + TRZ FF,FRARG2 ;IN ANY CASE THE MACRO DOESN'T HAVE 2 ARGS. +RRMAC7: ANDCMI FF,FRCLN\FRSYL\FROP ;TURN OFF RANDOM FLAGS. + CALL RRLEAV ;SET UP THE "RRE" VARIABLES. + CALL MACXQW ;EXECUTE THE MACRO. + JRST RREAR0 + +SUBTTL PROCESS ARGUMENTS/VALUES GIVEN TO ^R + +RREAR0: TLO FF,FLNOIN ;EXECUTING COMMANDS CLOBBERS FLNOIN, SO RESTORE IT + MOVE A,DISPRR + SKIPL -3(A) + TLZ FF,FLNOIN ;TO SAY WHETHER THIS IS ^R OR ^ V. +RREARG: SKIPE ECHOFL + CALL NOECHO +RREAR1: CALL VBDACU ;MAKE SURE FS ALTCOUNT IS IN PHASE WITH REALITY + JFCL + MOVE C,NLINES + CALL WINSET ;COMPUTE SIZE AND POS OF WINDOW, SET RRTOPM. RRBOTM, BOTLIN, VSIZE. + MOVMS DISTRN ;TRUNCATION SCREWS ^R-MODE. + MOVE T,BFRSTR + CAME T,RREBUF ;IF BUFFER HAS BEEN SWITCHED ON US, RECOMPUTE THE DISPLAY! + SETOM RRMNVP + .I RRHPOS=RREHPS + .I RRVPOS=RREVPS + MOVE A,BEG ;RELOCATE ALL ^R-MODE POINTERS INTO BUFFER. + SUB A,RREBEG + SETZM RREBEG ;DECLARE ^R IN CONTROL; PREVENT ^G INT LVL QUIT. + ADDM A,RREPT + ADDM A,RREZ + SKIPN RGETTY + JRST RRTTY + CALL RRFXRL ;RELOCATE LINBEG TABLE BY A. + MOVE BP,TOPLIN + MOVE T,GEA ;IF CURRENT FS WINDOW$ IS NOT CONSISTENT WITH LINBEGS, + ADD T,BEGV ;WE SHOULDN'T HAVE BEEN FED ANY ARGS, + LDB B,[3300,,LINBEG(BP)] + CAMN B,T + CAMLE B,ZV ;SO FLUSH THEM. SAME GOES IF FS WINDOW$ IS IMPOSSIBLE. + TRZ FF,FRARG + MOVE C,QRB.. + SKIPE TT,MORFLF ;IF OUR MACRO RAN INTO A --MORE--FLUSHED, + SETOM TYOFLG ;DON'T LET IT STAY AROUND TO PLAGUE NEXT COMMAND, +; SKIPE MORFLF +; SETZM .QVWFL(C) ;AND WE CAN ALSO REDISPLAY RIGHT NOW. +;REMOVED SO THAT FLUSHING WITH A RUBOUT WILL CAUSE REDISPLAY AFTER THE NEXT INPUT CHAR. +;IS NOT EXPECTED TO AFFECT WHAT HAPPENS WHEN YOU FLUSH WITH NON-RUBOUT. + SETZM MORFLF + MOVEM TT,OLDFLF + MOVE TT,MORESW + SKIPN .QVWFL(C) ;DOES STUFF ON SCREEN WANT TO BE PRESERVED? + JRST [ CAIE TT,MS%FLS ;NO: BUT IF MODE LINE SAYS --MORE--FLUSHED, + JRST RREAR2 ;WE MUST ACT TO PREVENT LOSS AT RRLP3. + JRST RREAR4] + SETZM .QVWFL(C) + CALL TYINH ;YES: WAIT TILL USER TYPES A CHARACTER SAYING + CAIE CH,40 + MOVEM CH,UNRCHC ;HE HAS READ THE STUFF (DON'T FLUSH THE CHARACTER UNLESS IT'S A SPACE) +RREAR4: CALL RRLRDS ;NOW MAKE SURE THAT THE BUFFER IS REDISPLAYED AFTER THIS CHARACTER + SETOM RRMSNG ;NOTE LINES MAY NEED REDISPLAY EVEN IF AFTER RRMAXP. + SETZM ERRFL1 ;NO NEED TO PROTECT AN ERROR MESSAGE PAST NEXT INPUT CHARACTER. +RREAR2: MOVE C,NUM ;GETARG WANTS 2ND VALUE IN C. + MOVE E,SARG ;AND 1ST VALUE IN E. + SKIPL RRMNVP ;*IF THIS IS A SCREW, AT LEAST DO THIS IN RREAR3* + TRNN FF,FRARG ;MACRO RETURNED NO ARG => + JRST RRMAC1 ;DON'T ASSUME ANYTHING. + SKIPGE GEA ;PREVENT CONFUSION IF ALREADY KNOW GOING TO DO FULL REDISPLAY. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => ONLY PT HAS CHANGED. + JRST RRMAC3 + CAML E,C + EXCH C,E ;DO F^@ - PREVENT 2<1 ERROR BY ORDERING THE ARGS PROPERLY. + CALL GETANU ;TURN MACRO'S VALUES INTO CHAR ADDRS. + CALL RRLMOV ;FIND VPOS IN BP OF LOWEST UNCHANGED LINE. + JRST RRMAC3 ; CHANGES ARE BELOW SCREEN, NOTHING TO DO. + CAMGE BP,TOPLIN + JRST RREAR3 ;IF CHANGES REACH PAST TOP, SCROLL DOWN. + MOVE TT,Z + SUBM TT,RREZ ;RREZ _ CHANGE IN # CHARS IN BUFFER. + SAVE PT + CALL RRHMOV + CALL RRCRDB ;MOVE BACK TO ELIMINATE BEFORE-EFFECTS. + REST E ;WE ARE JUST BEFORE 1ST PLACE ON SCREEN + MOVE BP,RRVPOS ;THAT WAS CHANGED. MARK THIS AS PLACE + MOVE T,RRHPOS ;THAT REDISPLAY MUST START BEFORE. + CALL RRDLB2 ;UPDATE RRMNVP AND RRMNHP. + CALL RRQMOV ;GET BACK CORRECT PT, MOVE FWD TO THERE, GETTING CORRECT HPOS AND VPOS. + MOVE E,C + MOVE A,RREZ + JRST RRFXMX ;UPDATE RRMAXP. + +;HERE FOR CHANGES THAT REACH PAST TOP OF SCREEN. +;FIGURE OUT WHERE CHANGES STOP, AND CHOOSE A NEW WINDOW TO PUT THAT POINT +;ON THE SAME LINE WHERE IT IS NOW, THUS AVOIDING REDISPLAYING THE UNCHANGED TEXT. +RREAR3: MOVE A,Z + SUB A,RREZ + MOVE E,C ;FIRST, ADJUST RRMAXP FOR THE CHANGES MADE. + CALL RRFXMX + CALL RRLID2 ;THEN, FIND 1ST UNALTERED LINE'S POS IN BUFFER AND SCREEN + JRST RRMAC1 ;THERE IS NONE => DO FULL REDISPLAY. + MOVE A,RRIDVP ;A GETS THAT LINE'S VPOS. + SUB A,TOPLIN + LDB E,[014300,,A] + ADD A,E ;IF IT IS IN THE BOTTOM 1/3 OF THE SCREEN, + ADD A,TOPLIN + CAML A,BOTLIN ;MIGHT AS WELL RE-CENTER THE WHOLE THING. + JRST RRMAC1 + SAVE PT + LDB A,[3300,,RRIDLB] + MOVEM A,PT ;OTHERWISE, PICK A WINDOW THAT DOESN'T REQUIRE IT TO MOVE. + MOVE A,RRIDVP ;CALCULATE WINDOW PUTTING PT AT VPOS IN A. + CALL VBDBL1 + MOVEM B,RRVPOS + MOVE A,RRIDLB ;OK, POINT OF LAST CHANGE HASN'T MOVED ON SCREEN, + ASH A,-33 ;BUT CURSOR MIGHT NOT BE AT THE END OF CHANGED REGION. + MOVEM A,RRHPOS ;SO FIGURE OUT WHERE THE CURSOR IS. + REST E + CALL RRMOV +;HERE TO SAY REDISPLAY MUST START AT THE TOP OF THE SCREEN, BUT NOT REQUIRE TESTING THE WINDOW. +;SAYS NOTHING ABOUT WHERE REDISPLAY NEEDS TO END. +RRLRDS: MOVE TT,TOPLIN ;NOW THAT WINDOW HAS BEENCHANGED, EVERY LINE NEEDS REDISPLAY. + CAMGE TT,RRMNVP ;IF RRMNVP IS -1, DON'T FORGET THAT FACT! + MOVEM TT,RRMNVP + SETZM RRMNHP + MOVE A,GEA ;AND WE MUST SET UP FIRT LINE'S LINBEG SO DISPLAY STARTS OFF RIGHT. + ADD A,BEGV ;WE COULD JUST SETOM RRMNVP, BUT THEN THE WINDOW, WHICH WE KNOW IS + MOVEM A,LINBEG(TT) ;VALID, WOULD BE WASTEFULLY REBLESSED. + RET + +;FIGURE OUT CURRENT CURSOR POSITION OF CHAR ADDR IN E. +;USES THE OLD LINBEGS AND RRMNVP, AS A SHORTCUT. +RRQMOV: CALL RRLMOV + JFCL + CAMGE BP,TOPLIN + MOVE BP,TOPLIN +;ASSUMES BP WAS SET UP BY CALLING RRLMOV. +RRHMOV: MOVEM BP,RRVPOS ;SET PT, RRVPOS AND RRHPOS TO VALUES + LDB TT,[3300,,LINBEG(BP)] + MOVEM TT,PT ;AT START OF LINE ON WHICH 1ST CHANGE LIES. + MOVE TT,LINBEG(BP) ;THOSE ARE STILL VALID, SINCE NOTHING CHANGED ABOVE THEM. + ASH TT,-33 + MOVEM TT,RRHPOS + JRST RRMOV ;THEN SCAN FROM THERE TO THE DESIRED POINT. + +;FIND IN BP THE VERTICAL POSITION OF THE LOWEST LINE +;WHICH, AS OF LAST DISPLAY (NOT, NOT, NOW) BEGAN BEFORE THE CHAR ADDR IN E. +RRLMOV: MOVE BP,RRMNVP + CAMN BP,[377777,,777777] + JRST RRLMO1 + LDB TT,[3300,,LINBEG(BP)] + CAMGE TT,E + JRST POPJ1 +RRLMO1: MOVE BP,TOPLIN + SOS BP +RRMAC2: MOVEI TT,1(BP) + CAME BP,RRMNVP ;WE CAN'T USE A VPOS WHOSE LINBEG DOESN'T EXIST OR ISN'T VALID. + CAMN TT,BOTLIN + JRST POPJ1 + LDB TT,[3300,,LINBEG+1(BP)] + CAML TT,RROLZV ;IF CHANGES WERE INSERTION AT END OF BFR, WE WANT TO FIND THE LINE + JRST [ CAMGE BP,TOPLIN ;WHICH CONTAINS THE LAST OF THE OLD TEXT CHARACTERS. + MOVE BP,TOPLIN ;INSERTION INTO EMPTY BUFFER IS A CHANGE STARTING WITH LINE 0. + JRST POPJ1] + ;IF CHANGES START AT 1ST CHAR OF NEXT LINE, WE NEED NOT SCAN THIS LINE, + CAMN TT,E ;UNLESS NEXT LINE STARTS IN MID-CHARACTER, + SKIPL LINBEG+1(BP) ;IN WHICH CASE THE CHAR REALLY BEGINS ON THIS LINE. + CAMLE TT,E ;IF CHANGES START BEFORE NEXT LINE, MUST SCAN THIS LINE. + JRST POPJ1 + ;THIS CHANGED FROM CAML SO THAT ^K'ING TOP LINE OF SCREEN + ;WOULD NOT END UP SAYING CHANGES REACH PAST TOP OF SCREEN, ETC. + AOJA BP,RRMAC2 ;IF CHANGES START AFTER END OF LINE, NEED NOT SEARCH IT. + +;UPDATE THE "MINIMUM SCREEN POSITION THAT CHANGED" +;USING DICTIONARY ORDER ON RRVPOS, RRHPOS. +RRDLB2: CAML BP,BOTLIN ;DON'T EVER LET RRMNVP BECOME AS LARGE AS BOTLIN. + JRST [ MOVE BP,BOTLIN + SOJA BP,.+1] + CAMLE BP,RRMNVP + POPJ P, + CAMGE BP,TOPLIN ;DON'T ALLOW RRMNVP TO BECOME LESS THAN TOPLIN. + SETO BP, ;MAKE IT -1 (WHICH IS SPECIAL) IF CHANGES GO OFF TOP. + EXCH BP,RRMNVP + CAMG BP,RRMNVP + CAMG T,RRMNHP + MOVEM T,RRMNHP + POPJ P, + +RRFXM1: MOVE E,PT + CALL RRDLB2 +;UPDATE RRMAXP. SIGNED # CHARS INSERTED OR DELETED IN A, +;PLACE INSERTED OR DELETED IN E. +RRFXMX: MOVE T,RRMAXP ;NOTE RRMAXP MAY HAVE THE SPECIAL VALUE INFINITY (LARGEST POS NUMBER) + AOS T + CAILE T,1 ;IN WHICH CASE IT SHOULDN'T BE RELOCATED. + ADDM A,RRMAXP ;RELOCATE OLD VALUE IN CASE IT'S ABOVE WHERE CHANGE HAPPENED. + CAML E,RRMAXP + MOVEM E,RRMAXP ;MAKE SURE RRMAXP IS ABOVE PLACE CHANGE HAPPENED. + POPJ P, + +;SET PT TO VALUE IN E, UPDATING CURSOR POS. +;CLOBBERS A,B,TT,TT1,IN,OUT +RRMOV: CAMN E,PT ;PT SAME AS MARK => DO NOTHING. + POPJ P, + MOVE A,E + SUB A,PT ;MOVING A LONG DISTANCE => DON'T BOTHER TO KEEP TRACK OF + MOVMS A ;CHANGES IN VPOS AND HPOS. JUST GO THERE AND RECOMPUTE HPOS. + CAIL A,10000. + SKIPN RGETTY + CAIA + JRST RRMOVL + CAML E,PT + JRST RRMOVF ;PT BEFORE DESIRED PT => GO FWD. +RRMOVB: CALL RRBACK + CAMN E,IN ;REACHED THE DESIRED PT YET? + RET + SKIPL A,RRVPOS ;GONE ABOVE TOP OF SCREEN? + JRST RRMOVB + MOVNS A ;ON TERMINAL WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + ADD A,TOPLIN + CAMGE A,VSIZE ;TILL WE GET A SCREEN HEIGHT ABOVE THE TOP OF THE SCREEN. + SKIPN LID ;UNTIL THAT POINT, THERE MAY BE SOME ADVANTAGE IN SCROLLING + CAIA ;THE SCREEN DOWN, AND FOR THAT WE NEED TO KEEP THE VPOS. + JRST RRMOVB +RRMOVL: MOVEM E,PT ;IT'S PROBABLY FASTER TO REQUEST COMPLETE RECOMPUTATION. + JRST RRMAC1 + +RRMOVF: MOVE TT,RRVPOS + ADDI TT,3 + SAVE TT +RRMOVG: CALL RRFORW + CAMN E,IN + JRST POP1J + MOVE TT,RRVPOS + MOVE TT1,(P) ;IF GO AT LEAST 3 LINES (FOR RRTTY'S SAKE, TO AVOID HAVING LONG JUMPS + CAML TT,TT1 ;LOOK LIKE MOTION TO NEXT LINE) AND + CAMG TT,BOTLIN ;GONE BELOW BOTTOM OF SCREEN, THEN DON'T BOTHER SCANNING IT OUT. + JRST RRMOVG + SUB TT,BOTLIN ;ON TTY WITH INSERT/DELETE LINE, KEEP TRACK OF VPOS + CAMGE TT,VSIZE ;TILL A SCREEN HEIGHT BELOW THE BOTTOM, IN CASE WE CAN + SKIPN LID ;SAVE DISPLAY BY SCROLLING THE TEXT UPWARD. + CAIA + JRST RRMOVG + SUB P,[1,,1] + JRST RRMOVL + +;,F^R - REPORT CHANGES BETWEEN , TO ^R WITHOUT DISPLAYING ANYTHING. +;F^R TELLS ^R NOT TO REMEMBER ANYTHING FROM ITS PREVIOUS DISPLAYING. + +;:F^R FORCES A VALID FS WINDOW$ TO BE CALCULATED NOW. +;SET FS WINDOW TO -1 FIRST, TO FORCE A NEW WINDOW TO BE COMPUTED FROM SCRATCH. +;DO A F^R FIRST TO AVOID ASSUMING THAT FS ^R VPOS$ IS VALID. +;:F^R CHOOSES A WINDOW THAT PUTS POINT ON LINE +FS TOPLIN$ +;A NEGATIVE COUNTS FROM THE BOTTOM OF THE USABLE WINDOW. +;IF THE WINDOW IS CHANGED, THAT FACT IS REPORTED TO ^R IMMEDIATELY, +;SO YOU CAN RETURN ONE VALUE TO ^R IF YOU ARE SURE YOU DON'T INVALIDATE IT. + +;@:F^R IS LIKE :F^R EXCEPT THAT, IF INSERT/DELETE LINE ARE AVAILABLE, +;IT IMMEDIATELY SHIFTS STUFF ON THE SCREEN TO REDUCE EVENTUAL REDISPLAY. + +;,@ F^R SAYS LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) NEED REDISPLAY. +RRALTR: TRNE FF,FRCLN + JRST RRALT1 + TRNE FF,FRUPRW ;^F^R IS FOR EXITING THE MINIBUFFER. + JRST RRMNX + TRNN FF,FRARG ;NO ARG => SAY ALL HAS CHANGED. + JRST RRMAC1 + TRNN FF,FRARG2 ;1 ARG => SAY NOTHING HAS. ^R WILL KNOW ANYWAY + RET ;IF POINT HAS BEEN CHANGED. + MOVE A,BEG ;2 ARGS => REPORT MODIFICATIONS TO PART OF BUFFER. + SUBM A,RREBEG + EXCH A,RREBEG + CALL RRFXRL + CALL RREAR2 + .I RREZ=Z + JRST RRLEA2 + +RRALT1: SKIPGE C ; :F^R COMES HERE. + ADD C,VSIZE ;A NEGATIVE ARG COUNTS FROM WINDOW BOTTOM. + ADD C,TOPLIN ;ALL ARGS ARE RELATIVE TO WINDOW, NOT ABSOLUTE ON SCREEN. + MOVE A,C + TRNE FF,FRARG ;NO ARG => TEST OLD WINDOW, BASED ON RRVPOS. + JRST RRALT2 + SKIPL GEA ;OLD WINDOW NOT KNOWN OR RRVPOS REPORTED SUSPECT => + SKIPGE RRMNVP + JRST RRALT7 ;SKIP THE FAST CHECK, AND DO ORDINARY BLESSING. + MOVE B,PT ;THE FAST CHECK IS ONLY APPLICABLE WHEN POINT IS + CAME B,RREPT ;AT THE PLACE WE HAVE REMEMBERED THE VPOS OF. + JRST RRALT7 + CALL RRWBLS + CAIA ;FAST CHECK APPLICABLE AND LOSES => NEW WINDOW CERTAINLY NEEDED, + RET +RRALT6: SETOB A,GEA ; SO TELL VBDBLS NOT TO BOTHER WITH THE OLD ONE. +RRALT2: CAML A,TOPLIN + CAML A,BOTLIN +RRALT7: SETO A, + SAVE GEA + SAVE RRVPOS + CALL VBDBLS + REST E ;E HAS PREVIOUS VPOS OF POINT. + REST A ;A HAS PREVIOUS ADDRESS OF TOP LINE. + MOVEM B,RREVPS ;B HAS NEW VPOS OF POINT. + MOVEM B,RRVPOS + .I RREHPS=CHCTHP + .I RREPT=PT ;WHEN WE RETURN TO ^R IT SHOULD KNOW WHICH POINT RREVPS REFERS TO. + CAMN A,GEA ;IF THE WINDOW IS ACTUALY CHANGED, + RET + SKIPE LID ;AND WE CAN'T OR SHOULDN'T MOVE THE TEXT, + TRNN FF,FRUPRW + JRST RRALT5 + SKIPL RRMNVP + JRST RRALT3 +RRALT5: SETOM RRMSNG ;JUST TELL ^R THAT EVERY LINE NEEDS REDISPLAY + JRST RRLRDS ;BUT WINDOW IS CERTAINLY GOOD. + +;HERE TO TRY TO MOVE TEXT ON THE SCREEN WITH INSERT/DELETE LINE +RRALT3: MOVN C,B ;HOW FAR ARE WE MOVING TEXT, AND WHICH WAY? + ADD C,E + MOVM E,C ;GET MAGNITUDE OF DISTANCE MOVED. + CAML E,VSIZE ;MOVING MORE THAN SCREEN HEIGHT => ALL OF OLD WINDOW GOING OFF SCREEN + JRST RRALT5 ;SO DON'T BOTHER WITH THIS. + MOVE BP,TOPLIN ;THE LINE THAT WILL MOVE TO POSITION TOPLIN + MOVE E,C ;IS NOW ON THE SCREEN AT POSITION TOPLIN+C(C). + ADD E,BP ;TELL DSLID WHAT THAT POSITION IS. + MOVEM E,RRIDVP ;FOR DOWNWARD MOTION, THAT LINE IS FICTITIOUS, BUT DSLID KNOWS THAT. + JUMPL C,RRALT4 + ;MOVING UP => PRETEND DELETED THE FIRST FEW LINES ON THE SCREEN. + CAML E,RRMNVP ;CAN'T WIN IF CHANGES TO TEXT EXTEND ABOVE WHAT WILL BECOME + JRST RRALT5 ;THE FIRST LINE ON THE SCREEN, SINCE IN THAT CASE ITS LINBEG IS WRONG. + MOVE TT,LINBEG(E) + MOVEM TT,RRIDLB ;RRIDLB GETS LINBEG OF WHAT WILL BECOME THE TOP LINE ON SCREEN. + MOVE TT,RRMNVP + MOVNS C ;RRMNVP MOVES UP WITH THE TEXT, IF IT ISN'T INFINITY. + CAME TT,[SETZ-1] + ADDM C,RRMNVP ;NOTE IT CAN'T GO PAST TOPLIN, DUE TO CAML E,RRMNVP ABOVE. + SOS BP + MOVE CH,RRMSNG ;SET UP CH FOR RRLID5. + IOR CH,RRMAXP + CALL DSLID ;MOVE THE STUFF UP, RIGHT NOW. BP HAS -1 PLUS LINE WE ARE "AT". + JRST RRALT5 ;IF DSLID DECIDED TO ABORT, THAT'S OK. JUST REDISPLAY. + JRST RRLID5 ;GO DO BOOKKEEPING FOR MOTION JUST DONE. + +RRALT4: AOS RRIDVP ;COMPENSATE FOR DIFFERENT MEANING OF THIS AND BP IF MOVING TEXT DOWN. + CALL DSLID ;MOVE IT. + JFCL + MOVE CH,RRIDLB ;SAY THAT CHANGES REACH PAST ALL THE BLANK LINES JUST MADE + TLZ CH,777000 ;AT THE TOP OF THE SCREEN. JUST SETTING RRMSNG DOESN'T WORK + ADDI CH,1 ;SINCE RRLID RUNS AND THINKS THAT THOSE BLANK LINES CONTAIN + CAML CH,RRMAXP ;VALID TEXT. BUT RRMAXP AS SET HERE SAYS THAT TEXT IS USELESS. + MOVEM CH,RRMAXP + JRST RRLRDS ;THEN SAY EVERY LINE MIGHT NEED REDISPLAY. + +;HERE FOR ,^ F^R SAYING LINES FROM TOP (INCLUSIVE) TO BOTTOM (EXCLUSIVE) +;NEED REDISPLAY. +RRMNX: CAML C,RRMNVP ;HANDLE END OF RANGE OF VPOS'S BY SETTING RRMAXP TO CORRESPOND TO IT, + JRST RRMNX1 ;OR, IF LINBEGS AROUND THERE ARE UNKNOWN, BY SETTING RRMSNG. + LDB T,[3300,,LINBEG(C)] + MOVEM T,RRMAXP + JRST RRMNX2 + +RRMNX1: SETOM RRMSNG +RRMNX2: MOVE BP,E ;HANDLE BEGINNING OF RANGE OF VPOS'S BY SETTING RRMNVP THERE. + SETZ T, + JRST RRDLB2 + +;,FM - MOVE DOWN TO HPOS , LINES DOWN. +;,^ FM - MOVE UP TO HPOS , - LINES UP. +;NORMALLY, EXACT VALUE OF HPOS IS NEEDED TO STOP SCAN. +;BUT COLON MODIFYER => ANY LARGER HPOS IS ALSO OK. +;IF SCAN DOESN'T FIND AN ACCEPTABLE HPOS ON THE DESIRED LINE +;THEN EITHER A NIB ERROR OR A NHP ERROR WILL RESULT. +;FM TRIES TO AVOID STOPPING BETWEEN A CR AND ITS LF. +FMCMD: TRNE FF,FRARG2 + TRNN FF,FRARG + TYPRE [WNA] + CALL RRBTCR ;MAKE SURE RRHPOS IS CORRECT FOR CURRENT BUFFER AND PT. + ADD E,RRVPOS ;E IS DESTINATION VPOS. + MOVE IN,PT + TRNE FF,FRUPRW + JRST FMBACK ;NOW FORWARD AND BACKWARD MOTION DIVERGE. +FMFWD: CAMGE E,RRVPOS ;IF WENT PAST TARGET LINE, WITHOUT STOPPING ON IT, BARF. + JRST [ CALL RRBCRL ;MOVE BACK TO END OF DESIRED LINE. + TYPRE [NHP]] + CAME E,RRVPOS ;IF HAVE REACHED TARGET VPOS, + JRST FMFWD1 + TRNE FF,FRCLN + CAML C,RRHPOS ;AND HAVE REACHED TARGET HPOS, + CAMN C,RRHPOS + RET +FMFWD1: CAML IN,ZV + TYPRE [NIB] ;AT END OF BUFFER WITHOUT REACHING TARGET => BARF. + CALL RRFORW + JRST FMFWD + +FMBACK: CAMLE E,RRVPOS ;WENT PAST TARGET VPOS WITHOUT FINDING TARGET HPOS => BARF. + JRST [ CALL RRFCRL ;RETURN TO DESIRED LINE BEFORE COMPLAINING. + TYPRE [NHP]] + CAME E,RRVPOS ;REACHED TARGET VPOS + JRST FMBAC1 + TRNE FF,FRCLN + CAML C,RRHPOS + CAMN C,RRHPOS + RET +FMBAC1: CAMG IN,BEGV + TYPRE [NIB] + CALL RRBCRL + JRST FMBACK + +;MOVE FORWARD OVER EITHER A SINGLE CHAR OR A CRLF. +RRFCRL: CALL RRFORW + CAIE CH,^M + RET + CALL GETCHR + CAIE CH,^J + RET + JRST RRFORW + +;MOVE BACKWARD OVER EITHER A SINGLE CHAR OR A CR-LF PAIR. +RRBCRL: CALL RRBACK ;MOVE BACK 1 CHAR, + CAIE CH,^J ;AND IF THAT LEAVES US BETWEEN A CR AND ITS LF, + RET ;MOVE BACK 1 MORE. + SOS IN + CALL GETINC + CAIE CH,^M + RET + JRST RRBACK + +SUBTTL ^R COMMAND DISPATCH TABLE MANAGEMENT + +;FS ^R INIT$ RETURNS THE INITIAL SETTING OF FS ^R CMAC$. +;THE UPARROW FLAG HAS THE SAME MEANING AS FOR FS ^R CMAC$. +FSCRIN: TRZN FF,FRARG + TYPRE [WNA] + CALL TYIABN ;IF DON'T HAVE UPARROW FLAG, CONVERT ASCII ARG TO 9-BIT. + MOVEI CH,(C) + TRZN CH,META + TRNN C,CONTRL + SKIPA A,[RRXINS] ;META OR NON-CONTROL CHARS ARE SELF-INSERTING (EXCEPT RUBOUT) + MOVEI A,RRUNDF ;MOST CONTROLS ARE ERRORS. + LDB Q,[.BP 177,CH] + CAIL Q,40+"A + CAILE Q,40+"Z + CAIA ;IF THE ASCII PART IS LOWER CASE, + MOVE A,[40,,RRINDR] ;IT IS A "RRINDR" CHAR (INDIRECT). + CAIN CH,CONTRL+33 ;CONTROL-ALTMODE GOES INDIRECT THROUGH ALTMODE. + MOVE A,[200,,RRINDR] ;AND SIMILAR FOR CONTROL-META-ALTMODE. + CAIL CH,CONTRL+^H ;SIMILAR FOR CONTROL-BS, CONTROL-TAB, CONTROL-LF, + CAILE CH,CONTRL+^J ;CONTROL-CR, AND META EQUIVALENTS. + CAIN CH,CONTRL+^M + MOVE A,[200,,RRINDR] + CAIL CH,CONTRL+"H + CAILE CH,CONTRL+"J + JRST FSCRI1 + MOVE A,[300,,RRINDR] + JRST POPJ1 + +FSCRI1: CAIN C,33 ;ALTMODE ON TV IS NOT SAME AS CTL-[ ;] + MOVEI A,RREXIT + CAIN C,^M ;SIMILARLY, HANDLE CR (WHICH IS NOT CTL-M) + MOVE A,[RRCRLF,,RRREPT] + CAIL C,^H + CAILE C,^J + CAIA + MOVE A,[RRINSC,,RRREPI] + CAIL Q,"0 ;CONTROL, META AND C-M-DIGITS ALL ADD TO ARGUMENT TO NEXT CMD. + CAILE Q,"9 + JRST FSCRI2 + TRNE C,CONTRL+META + MOVEI A,RRCDGT +FSCRI2: CAIE Q,"- ;C-MINUS, M-MINUS AND C-M-MINUS ALL SET "NEGATE ARG" FLAG + JRST FSCRI3 + TRNE C,CONTRL+META + MOVEI A,RRCMNS +FSCRI3: CAIN C,177 ;RUBOUT IS A RUBOUT. + MOVEI A,RRRUB + CAIN C,CONTRL+177 ;CTL-RUBOUT IS TAB-HACKING RUBOUT. + MOVEI A,RRCRUB + CAIL C,CONTRL+"@ + CAILE C,CONTRL+"_ + JRST POPJ1 + SUBI C,CONTRL+"@ ;AS A LAST RESORT, LOOK CHAR UP IN RRITAB. + ROT C,-1 + HRRZ A,RRITAB(C) ;INDEX TO HALFWORD OF INITIAL VALUE TABLE. + SKIPL C + HLRZ A,RRITAB(C) + TRZN A,400000 ;400000 BIT => DEFINITION GOES THROUGH RRREPT. + JRST POPJ1 + HRLZS A + HRRI A,RRREPT + JRST POPJ1 + + +;TABLE OF INITIAL ^R-MODE DEFINITIONS OF CONTROL CHARACTERS. +.SEE RRMACT ;CHANGE RRMACT WHEN YOU CHANGE THIS. +.BYTE 22 +RRITAB: RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + RRINDR ;CONTROL-H (THIS ENTRY NOT ACTUALLY USED) + RRINDR ;CONTROL-I " + RRINDR ;CONTROL-J " + RRKILL ;^K + RRCTLL ;^L + 400000+RRINSC ;CONTROL M + RRNEXT ;^N + 400000+RRCTLO ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;CONTROL-[ ;] + RRUNDF ;^\ + RRBRC ;[ ;^] + RRUNDF ;^^ + RRUNDF ;^_ +.BYTE + +;GET OR SET THE MACRO ASSOCIATED WITH A CHARACTER +;(IF A CHAR HAS AN ASSOCIATED MACRO, WHEN THAT CHAR IS READ IN +;^R-MODE, THE MACRO IS CALLED INSTEAD OF THE USUAL ACTION FOR +;THAT CHARACTER.) +;^^FS^RCMAC$ GETS, Q,^^FS^RCMAC$ SETS. +;CHARACTER IS ASSUMED TO BE ASCII. IF UPARROW FLAG IS ON, +;THE CHARACTER IS TREATED AS 9-BIT INSTEAD. +;DEPOSITS IN -1(P)! ASSUMES THE CALLER WAS THE FS COMMAND DISPATCH! +FSCRMA: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => SETTING, ELSE GETTING. + CALL TYIABN ;IF FRUPRW OFF, CONVERT ASCII ARG TO 9-BIT. + MOVE E,C + MOVE C,SARG + CAIGE E,RRMACL ;LAST ARG OUT OF RANGE => ERROR. + SKIPGE E + TYPRE [AOR] + ADDI E,RRMACT ;E -> WORD TO BE SET OR GOTTEN. + HRLM E,-1(P) .SEE FSCALL + JRST FSNOR1 + +TYIABN: TRZN FF,FRUPRW ;IF FRUPRW IS OFF, CONVERT ASCII CHAR IN C TO 9-BIT. + CAIL C,40 + RET + CAIE C,33 + CAIN C,^M + RET + CAIL C,^H + CAILE C,^J + ADDI C,300 + RET + +; FS ^R IND RETURNS THE CHAR CODE THAT INDIRECTS TO (MAY BE ITSELF). +FSINDT: TRZ FF,FRARG ;FLUSH ARG OR WE WILL ADD TO IT. + CAIGE C,512. + CAIGE C,0 + TYPRE [AOR] + HRRZ A,C ;INITIALLY ASSUME CHAR NOT INDIRECT. +FSIND1: HRRZ T,RRMACT(A) + CAIE T,RRINDR + JRST POPJ1 ;NOT INDIRECT => RETURN IT. + HLRE T,RRMACT(A) ;ELSE COMPUTE THE CHAR IT INDIRECTS TO. + SUB A,T + JRST FSIND1 + +;, F^S SEARCHES BUFFER IN STARTING AT WORD +;FOR A WORD CONTAINING . RETURNS IDX OF FIRST SUCH, OR -1 IF NONE. +;, :F^S SEARCHES ^R DEFINITION TABLE. +TABSRC: TRNN FF,FRARG + TYPRE [WNA] + MOVE J,[-RRMACL,,RRMACT] + TRNE FF,FRCLN ;COLON => SEARCH ^R DEFINITION TABLE. + JRST TABSR1 + CALL QREGX ;ELSE READ QREG NAME + MOVE BP,A + CALL QBGET1 ;AND DECODE CONTENTS AS BUFFER. + MOVE T,MFBEGV(B) ;B HAS FRAME ADDR; MAKE AOBJN TO CONTENTS. + IDIVI T,5 + HRRZ J,T + MOVE T,MFZV(B) + IDIVI T,5 + SUBM J,T + HRL J,T +TABSR1: HRLS E + ADD E,J ;1ST ARG IS # OF ENTRIES AT FRONT OF TABLE NOT TO TEST. + CAME C,(E) + AOBJN E,.-1 + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + JUMPGE E,NRETM1 ;RETURN -1 IF DON'T FIND THE OBJECT. + SUB E,J + HRRZ A,E + JRST POPJ1 ;ELSE RETURN INDEX FIRST FIND IT AT. + +SUBTTL MISCELANEOUS ^R MODE COMMANDS + +RRCTLL: SKIP ;^L COMMAND. + SKIPN RGETTY ;^L WITH ARG PRINTS SPEC'D # OF LINES (FOR PRINTING TTY'S). + JRST RRDISL + CALL CTLL +RRMAC1: SETOM RRMNVP ;CAUSE WINDOW TO BE TESTED, + SETOM RRMSNG ;AND THE WHOLE BUFFER TO BE REDISPLAYED. + JRST RRBTCR ;IN CASE THAT DOESN'T HAPPEN FOR A WHILE + ;MAKE SURE WE HAVE A REASONABLE RRHPOS. + +RRDISL: SETZM RUBENC ;HERE FOR ^L; DISPLAY LINES OF BUFFER. + CALL CRR + CALL CRR + CALL WINSET ;SET WINDOW SIZE TO LINES. + CALL VBDRR ;DO THE DISPLAY. + CALL RRDIS3 ;THEN DO A 0T SO USER SEES WHERE CURSOR IS. + MOVE C,NLINES ;RESTORE NORMAL WINDOW SIZE. + JRST WINSET + +RRMAC3: ADDB A,RREPT ;RELOCATE OLD PT FOR BUFFER MOTION. + CAML A,BEGV ;OLD CURSOR-LOCATION NO LONGER INSIDE BUFFER => + CAMLE A,ZV ;CAN'T MOVE FROM THERE, MUST REDISPLAY SLOW WAY. + JRST RRMAC1 + MOVE E,PT + SKIPN RGETTY ;ELSE, USE EITHER RRMOV OR RRQMOV TO DETERMINE NEW VPOS/HPOS, + JRST RRMOV1 ;GUESSING WHICH ONE WILL BE FASTER; BUT ON TTY'S USE ONLY RRMOV. + MOVE TT,A + SUB TT,PT + MOVMS TT + CAIL TT,30. + JRST RRQMOV +RRMOV1: MOVEM A,PT ;THAT IS WHERE RRHPOS AND RRVPOS ARE RIGHT FOR. + JRST RRMOV + +RRERST: SAVE Q +RRERS1: CAML CH,DISPRR ;POPPING OUT OF A MACXQ: POPPING OUT OF A ^R-INVOCATION? + JRST POPQJ + SOS Q,DISPRR ;IF SO, RESTORE DISPRR'S VALUE OUTSIDE THAT INVOCATION. + POP Q,DISPRR + SKIPE DISPRR ;IF THIS ^R WAS THE OUTERMOST, + JRST RRERS1 + SAVE TT + SAVE TT1 + SAVE CH + CALL SETTTM ;RESTORE NORMAL TTYSET. + REST CH + REST TT1 + REST TT + JRST POPQJ + +;RTNS TO HANDLE THE MARK. + +;SET THE MARK AT PT. +RRMARK: SKIP + SKIPE RR4TCT ;^U^T EXCHANGES MARK WITH PT. + JRST RREXCH +RRMRK1: .I RRMKPT=PT-BEG + POPJ P, + +;EXCHANGE THE MARK AND PT. +RREXCH: SKIP + SKIPGE E,RRMKPT + JRST RRERR ;NO MARK => CAN'T EXCHANGE. + ADD E,BEG ;TURN INTO CHAR ADDR. + SAVE PT ;REMEMBER NEW VALUE OF MARK. + CALL RRMOV ;MOVE PT TO OLD MARK. + REST TT ;SET MARK TO OLD PT. + SUB TT,BEG + MOVEM TT,RRMKPT + JRST RRTTY ;ON PRINTING TERMINAL, GO SHOW CURSOR MOTION. + +;DO FX..K ON EVERYTHING FROM PT TO THE MARK. +RRFX: SKIP + SKIPGE A,RRMKPT + JRST RRERR + ADD A,BEG + CAMN A,PT ;DELETING NO CHARS => + JRST RRFXXT ;DON'T CLOBBER QREG ..K. + CAMG A,PT + CALL RREXCH ;MAKE SURE PT IS BEFORE MARK. + MOVE E,PT + MOVE A,RRMKPT + ADD A,BEG + MOVE C,A + SUBM E,A + CALL RRFXMX ;SET RRMAXP + CALL RRCRDI ;WORRY ABOUT BEFORE-EFFECTS. + CALL [ CALL RRDLB2 ;SET RRMNVP, RRMNHP FROM T,BP. + MOVE CH,QRB.. + ADDI CH,.QRRBF + CALL FXCMD2 ;DO THE FX. D _ AMOUNT BEG CHANGED. + MOVE A,D + JRST RRFXRL] ;RELOCATE VARIOUS PTRS THAT MUCH +RRFXXT: SETOM RRMKPT ;ELIMINATE THE MARK. + POPJ P, + +;RELOCATE RR MODE'S VARIOUS PTR THAT ARE KEPT AS CHAR ADDRS, +;BY THE AMOUNT IN A. (IN CASE THE BUFFER WAS MOVED) +;CLOBBERS TT +RRFXRL: MOVE TT,RRMAXP ;NOTE THAT IF RRMAXP IS INFINITY IT SHOULDN'T BE CHANGED. + AOS TT + CAILE TT,1 ;ALSO IF IT IS ZERO. + ADDM A,RRMAXP + ADDM A,RROLDZ + MOVE TT,TOPLIN +RRFXR1: CAMN TT,BOTLIN + RET + ADDM A,LINBEG(TT) + AOJA TT,RRFXR1 + +;KILL LINES STARTING AT PT, AND PUT IN QREG ..K. +RRKILL: SKIP + CALL RRMRK1 + CALL RRNEX1 + JRST RRFX + +;^S -- READ CHAR, AND SEARCH FOR THAT CHAR. +RRSRCH: SKIP + SAVE C + CALL RRECO1 ;MAYBE PROMPT WITH A ^S. + REST NUM + MOVEI A,[ASCIZ/FIU..0 :S..0 /] + JRST RRMAC6 + +RRCTLB: SKIP ;^B MOVES BACKWARD - IT IS -^F. + MOVNS C +RRCTLF: SKIP ;^F MOVES FORWARD, BUT ON PRINTING TTY IT ECHOES. + AOS (P) + JUMPL C,RRCB1 ;WORK FOR NEGATIVE ARGS. + JSP E,RRREP1 + MOVE IN,PT + CALL RREOLT + CALL RRFORW + JRST RRFORW + +RRCB1: MOVNS C + JSP E,RRREP1 + CALL RRBACK ;MOVE BACK AT LEAST ONE CHARACTER. + SOS IN + CAMLE IN,BEGV ;IF IT IS A LF, AND THE PRECEDING CHAR IS A CR, + CAIE CH,^J + RET + CALL GETCHR + CAIE CH,^M + RET + JRST RRBACK ;MOVE BACK OVER THAT AS WELL. + +;JSP E,RRTYPP SKIPS UNLESS WE ARE SCANNING (SHOULD PRINT SCANNED CHARACTERS). +RRTYPP: SKIPN RGETTY + SKIPN RRSCAN + JRST 1(E) + JRST (E) + +;^P -- WITH ARGUMENT , DOES -@L. +RRPREV: SKIP ;CALCULATE , + MOVNS C + JRST RRNEX2 ; IS -. + +;^A -- MOVE TO BEGINNING OF LINE. +;WITH ARGUMENT , DOES -1@L. +RRBEG: SKIP + SOJA C,RREND2 + +;^E -- MOVE TO END OF LINE (:@L). WITH ARGUMENT , DO :@L. +RREND: SKIP +RREND1: TRO FF,FRCLN +RREND2: AOS (P) + JRST RRNEX1 + +;^N -- MOVE TO BEGINNING OF NEXT LINE. (@L) +;WITH ARGUMENT , DOES @L. +RRNEXT: SKIP +RRNEX2: AOS (P) + SAVE [RRCMIN] ;DO COMMENT-MODE STUFF AT START AND FINISH OF MOTION. + CALL RRCMRU +RRNEX1: MOVE IN,PT + TRO FF,FRUPRW + CALL GETAG4 ;COMPUTE WHERE WE'RE GOING TO. + JFCL + ADD E,C ;THE WAY THE L COMMAND DOES. + SUB E,PT + JRST RRMOV ;THEN GO THERE. + +;CALL HERE WHEN LEAVING A LINE. +;IN COMMENT MODE, TAB-SEMI'S ARE REMOVED BY THIS RTN. +RRCMRU: SKIPGE RRCMMT + POPJ P, ;DO NOTHING IF NOT COMMENT MODE. +RRCMR1: SAVE C + MOVEI C,1 + CALL RREND1 + JFCL + REST C + MOVE IN,PT + CAMG IN,BEGV + POPJ P, ;DO NOTHING AT BEGINNING OF BUFFER. + SOS IN + CALL GETCHR ;IF CHAR BEFORE PT IS A SEMI, + CAIE CH,"; + POPJ P, +RRCMR0: CALL RRDLB ;DELETE IT, AND ANY TABS BEFORE IT. + MOVE IN,PT + CAMG IN,BEGV + POPJ P, + SOS IN + CALL GETCHR + CAIE CH,^I + CAIN CH,40 + JRST RRCMR0 + POPJ P, + +RRCMS1: SETZ C, + CALL RRNEX1 + +;CALL HERE WHEN ENTER A LINE. +;IN COMMENT MODE, TAB-SEMI WILL BE INSERTED. +RRCMIN: SKIPGE RRCMMT + RET ;NOT COMMENT MODE. +RRCMI0: MOVE IN,PT ;MOVE UP TO EXISTING COMMENT + CALL RREOLT ;OR END OF LINE. + JRST RRCMI1 ;REACHED END, INSERT TAB-SEMI. + CALL GETCHR + CAIN CH,"; + JRST RRFORW ;REACHED SEMI, STOP AFTER IT. + CALL RRFORW + JRST RRCMI0 ;ELSE KEEP LOOKING. + +RRCMI1: MOVEI CH,^I ;INSERT TABS TILL REACH COMMENT COLUMN + CALL RRINS + MOVE A,RRHPOS + CAMGE A,RRCCOL ;REACHED THE COMMENT COLUMN? + JRST RRCMI1 ;NO, MORE TABS TO INSERT. + MOVEI CH,"; ;YES, INSERT THE SEMI. + JRST RRINS + +;^C -- COMPLEMENT COMMENT MODE. +RRCMSW: SKIP ;IF NUMERIC ARG, IT IS SETTING OF COMMENT COLUMN. + CAIE C,1 + MOVEM C,RRCCOL + AOSE A,RRCMMT ;IF WAS -1, MAKE IT 0. + SETOB A,RRCMMT ;WAS >=0, MAKE IT -1. + CALL RRECSP ;THEN INDICATE WHICH MODE WE'RE IN. + MOVE CH,(A)1+[ "T ? "C ] + CALL FSECO1 + XCT (A)1+[CALL RRCMR1 ;LEAVING COMMENT MODE, REMOVE SEMI. + CALL RRCMS1] ;WHEN ENTER COMMENT MD, INSERT SEMI. +;TYPE A SPACE IN THE ECHO REGION, MAKING SURE CURSOR WILL +;BE REPOSITIONED IN THE DISPLAY REGION. PRESERVE ALL ACS. +RRECSP: SAVE CH + MOVEI CH,40 + CALL FSECO1 + JRST POPCHJ + +;^R -- SET COMMENT COLUMN FROM CURRENT HPOS. +RRCMCS: SKIP A,RRHPOS + SKIPGE RRCMMT ;NO EFFECT UNLESS IN COMMENT MODE. + POPJ P, + MOVEM A,RRCCOL + POPJ P, + +;TABLES USED BY RRCHRG. THE ENTRY FOR EACH +;CHARACTER IS AN INDEX INTO RRFORT OR RRBACT. + +RRCHBP: REPEAT 6,<360600-<6*.RPCNT>_12.>,,RRCHTB(A) + +;CODES IN RRCHTB ARE: + ;0 - 1-POSITION CHARACTER. + ;1 - ORDINARY CTL CHAR - USUALLY 2-POSITION, BUT 1-POSITION IN SAIL MODE. + ;2 - BACKSPACE. + ;3 - CR + ;4 - LF + ;5 - TAB. + ;6 - SPECIAL CTL CHARACTER - 2-POSITION EVEN IN SAIL MODE. + +RRCHTB: .BYTE 6 + 1 ;^@ + 1 ;^A + 1 ;^B + 1 ;^C + 1 ;^D + 1 ;^E + 1 ;^F + 1 ;^G + 2 ;^H + 5 ;^I + 4 ;^J + 1 ;^K + 1 ;^L + 3 ;^M + 1 ;^N + 1 ;^O + 1 ;^P + 1 ;^Q + 1 ;^R + 1 ;^S + 1 ;^T + 1 ;^U + 1 ;^V + 1 ;^W + 1 ;^X + 1 ;^Y + 1 ;^Z + 0 ;ALTMODE, 1 POSITION. + 1 ;[ ;^] + 1 ;^\ + 1 ;^^ + 1 ;^_ + .BYTE + +IFN CTRLT,[ + +SUBTTL OBSOLETE ^T COMMAND + +EDIT: CALL GAPSLP + SKIPE ECHOFL + CALL NOECHO + TRZ FF,FRARG+FRARG2+FRUPRW ;FRARG ON = INSERT MODE, OFF = OVERWRITE MODE + ;FRARG2 ON = IN IS POINTING TO CR + ;FRUPRW ON = BACKWARDS RUB MODE + SETZM COMCNT + MOVE B,CBUFLO + SKIPA IN,PT +ED0.0: POP P,A ;PURGE EXTRA PUSHJ P, +ED0: PUSHJ P,CRR + TRZ FF,FRUPRW ;TURN OFF "\" FLAG +ED1: PUSHJ P,DISFLS + PUSHJ P,TYI + CALL TYINRM + MOVE A,CH + MOVEI CH,"\ + CAIL A,40 + JRST EDLIS + SKIPL C,EDDPTB(A) ;IS IT A RUBBACK COMMAND + JRST ED11 ;NO + TRON FF,FRUPRW ;TURN ON "\" FLAG +ED12: PUSHJ P,TYOA ;AND IF WAS OFF, TYPE "\" +ED13: MOVE CH,A + PUSHJ P,@C + PUSHJ P,TYO + JRST ED1 + +ED11: TRZE FF,FRUPRW ;TURN OFF "\" FLAG + JRST ED12 ;IF IT WAS ON, PRINT "\" + JRST ED13 + +BELL: CALL TYPBEL + JRST CPOPJ1 + +EDLIS: CAIE A,177 + JRST EDLIS1 + TRON FF,FRUPRW + PUSHJ P,TYOA + JRST .+3 +EDLIS1: TRZE FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + PUSHJ P,CKCH + JRST ED0 + JRST ED1 + PUSHJ P,EDOV + JUMPL CH,ED1 + PUSHJ P,TYO + JRST ED1 + +ED%: MOVEI CH,"# + PUSHJ P,TYO + PUSH P,IN + PUSH P,FF +ED%1: PUSHJ P,CGETIN + JUMPL CH,ED%2 ;END OF LINE OR BUFFER + PUSHJ P,TYO + JRST ED%1 +ED%2: POP P,FF + POP P,IN + PUSHJ P,CRR + MOVE A,COMCNT + JUMPLE A,CPOPJ1 + MOVE B,CBUFLO + ILDB CH,B + PUSHJ P,TYO + SOJG A,.-2 + JRST CPOPJ1 +EDOV: MOVE A,CH + TRNN FF,FRARG ;IN INSERT MODE + PUSHJ P,CGETIN ;NO + SKIPA CH,A +EDCPY: PUSHJ P,CGETIN + JUMPL CH,CPOPJ +EDCPY1: IDPB CH,B + AOS COMCNT + POPJ P, + +CGETIN: MOVNI CH,1 + TRNE FF,FRARG2 + POPJ P, + CAML IN,ZV ;AT END OF BUFFER + JRST CGETI1 + PUSHJ P,GETCHR + CAIN CH,15 +CGETI1: TROA FF,FRARG2 + AOJA IN,CPOPJ + MOVNI CH,1 + POPJ P, + +EDCR: PUSHJ P,CRR +EDCR2: TRNE FF,FRARG2 + JRST EDCR1 + PUSHJ P,CGETIN + JRST EDCR2 +EDCR1: MOVE C,IN ;GET ADDR AFTER END OF OLD LINE, + MOVE E,PT ;GET ADDR OF START OF IT, + CALL DELET1 ;TURN THAT INTO GAP. + MOVE C,COMCNT ;NOW INSERT SPACE FOR NEW LINE, + CALL SLPGET ;BP GETS BP TO IDPB INTO SPACE. + MOVE A,COMCNT + JUMPE A,EDCR3 + MOVE B,CBUFLO + ILDB CH,B + IDPB CH,BP + SOJG A,.-2 +EDCR3: TRZ FF,FRARG+FRUPRW+FRARG2 + SETZM COMCNT + SETOM UNRCHC + PUSHJ P,SETTTM + JRST GO + +RTYI: PUSHJ P,TYI + CALL TYINRM + CAIE CH,177 + POPJ P, + MOVEI CH,"\ + TRON FF,FRUPRW + PUSHJ P,TYOA + MOVE CH,A + SUB P,[1,,1] + POPJ P, + +EDD: PUSHJ P,CGETIN ;DELETE NEXT CHAR + JUMPL CH,BELL ;BELL IF NONE + MOVEI CH,"% + POPJ P, + +EDP: MOVEI CH,"< ;COMPLEMENT STATE OF INSERT/OVERWRITE MODE + TRCE FF,FRARG + MOVEI CH,"> + POPJ P, + +EDS: PUSHJ P,RTYI ;COPY THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDS1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDS1 ;KEEP LOOKING + POP P,FF + POP P,IN + JRST EDN1 +EDN: PUSHJ P,EDCPY ;COPY THRU 1ST SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAIN CH," + JRST EDN + MOVEI A," +EDN1: PUSHJ P,EDCPY + JUMPL CH,CPOPJ1 + PUSHJ P,TYO + CAME CH,A + JRST EDN1 + JRST CPOPJ1 + +EDS2: POP P,FF + POP P,IN + JRST BELL + +EDQ: PUSHJ P,RTYI ;QUOTE NEXT CHAR + JRST EDOV + +EDT: PUSHJ P,RTYI ;DELETE THRU "T" + MOVE A,CH + PUSH P,IN + PUSH P,FF +EDT1: PUSHJ P,CGETIN + TRNE FF,FRARG2 + JRST EDS2 ;AT EOL AND NOT FOUND + CAME CH,A + JRST EDT1 + POP P,FF + POP P,IN + JRST EDO1 + +EDO: PUSHJ P,CGETIN ;DELETE THRU NEXT SPACE AFTER 1ST NON-SPACE OR TO EOL + JUMPL CH,CPOPJ1 + MOVE A,CH + MOVEI CH,"% + PUSHJ P,TYO + CAIN A," + JRST EDO + MOVEI A," +EDO1: PUSHJ P,CGETIN + JUMPL CH,CPOPJ1 + CAMN CH,A + SETOM A + MOVEI CH,"% + PUSHJ P,TYO + JUMPL A,CPOPJ1 + JRST EDO1 + +EDR: TROA FF,FRARG+FRUPRW ;FRARG ON = ECHO +EDL: TRZ FF,FRARG+FRUPRW ;FRUPRW ON = DONT END EDIT +EDL1: TRNE FF,FRARG2 + JRST EDL2 + PUSHJ P,EDCPY + JUMPL CH,EDL2 + TRNE FF,FRARG + PUSHJ P,TYO + JRST EDL1 +EDL2: TRZ FF,FRARG + TRZE FF,FRUPRW + JRST CPOPJ1 ;DON'T END EDIT + PUSHJ P,CRR ;CR-LF THEN END EDIT + JRST EDCR1 + +EDW: LDB CH,B ;RUBBACK TO 1ST NON-SPACE, THEN BACK TO 1ST SPACE + CAIE CH," + JRST EDW1 + MOVEI CH,177 + PUSHJ P,CKCH + JRST ED0.0 + JRST EDW +EDW1: LDB CH,B + CAIN CH," + JRST CPOPJ1 ;FOUND SPACE, QUIT + MOVEI CH,177 ;TO TELL CKCH TO RUBBACK + PUSHJ P,CKCH + JRST ED0.0 ;NOTHING TO RUB + JRST EDW1 + .VALUE ;SHOULD NEVER GET HERE + +EDALT: TRO FF,FRARG ;COPY REST W/ ECHO AND END EDIT + TRZ FF,FRUPRW + JRST EDL1 + +] ;IFN CTRLT + +SUBTTL TECO COMMAND DISPATCH / ARGUMENT ARITHMETIC + +CD: SETZM NUM ;FLUSH ANY ARGUMENT, OR : OR ^. + SETZM SARG + TRZA FF,FRARG+FRARG2+FROP+FRUPRW+FRCLN+FRSYL +CD2B: TROA FF,FROP+FRARG ;COME HERE FROM ARITH OPS, NEED 2ND ARG. +CD2A: MOVSI A,(ADD C,);SET UP DLIM FOR THE DEFAULT + ;CONDITION OF ADDING THE OLD VALUE + ;WITH ANY NEW NUMBER ENTERED + HLLM A,DLIM ;PUT THE APPROPRIATE OPERATOR AWAY + CLEARM SYL ;CLEAR THE NEW NUMBER ENTERED + CLEARM OSYL ;ALSO CLEAR ITS OCTAL INTERPRETATION +CD5: MOVE A,QRWRT ;IF IMPURE STRING SPACE HAS INCREASED BY + CAML A,QRGCMX ;GCOFTN CHARS SINCE PREVIOUS GC, + PUSHJ P,GC ;GC THE IMPURE STRINGS. +CD5A: SKIPGE STOPF ;IF THE USER HAS ^G'ED, TRY TO QUIT, + CALL QUIT0 ;TRY TO QUIT (CHECK NOQUIT). + CALL RCH ;GET THE NEXT COMMAND CHARACTER +CDRCH: TRNE CH,100 ;CONVERT LOWER CASE TO UPPER. + ANDCMI CH,40 + SETZB B,SQUOTP + TRZ FF,FRNOT ;RESET MORE FLAGS + XCT DTB(CH) ;EXECUTE THE ENTRY FROM THE DISPATCH TABLE +CD5B: TLZ FF,FLDIRDPY ;RESET THE "DISPLAY THE FILE DIRECTORY BIT", THIS INSURES + ;THAT AN E COMMAND WILL ONLY DISPLAY THEBUFFER IF IT IS THE LAST COMMAND + MOVE C,NUM ;GET THE OLD VALUE + TRZN FF,FRSYL + JRST CD5C + XCT DLIM ;THEN PERFORM THE SAVED OPERATION + MOVEM C,NUM ;AND MAKE IT THE NEW OLD VALUE +CD5C: MOVE E,SARG ;GET THE SECOND ARGUMENT TO THE COMMAND (IF ANY) + JUMPGE B,(B) ;IF B POSITIVE, THEN JUMP TO IT. + PUSHJ P,(B) ;IF B NEGATIVE, PUSHJ +CDRET: JRST CD ;NON-SKIP RETURNING COMMANDS DON'T RETURN VALUE +VALREC: TROE FF,FRARG ;IF HAVE ARG FROM BEFORE, NOT GOBBLED, + JRST VALRET ;DO ARITH. WITH IT & THIS CMD'S VALUE. + MOVEM A,NUM ;IF NO ARG OR THIS CMD USED IT, ITS + TRZ FF,FROP ;VALUE IS ALL THE ARG WE HAVE. + JRST CD2A + +CDNUM: JFCL 10,.+1 ;CLEAR OVERFLOW FLAG. + MOVE A,OSYL ;ASSEMBLE THIS DIGIT INTO A NUMBER + IMUL A,I.BASE ;(USUALLY OCTAL) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) + MOVEM A,OSYL + JFCL 10,.+1 + MOVE A,SYL + IMUL A,IBASE ;AND IN DECIMAL (USUALLY) + JFCL 10,[TLC A,400000 ;ALLOW OVERFLOW INTO SIGN BIT. + JRST .+1] + ADDI A,-60(CH) +VALRET: MOVEM A,SYL ;SAVE IT AS A VALUE + TRZ FF,FROP ;DON'T HAVE ARITH OP WAITING FOR 2ND ARG +CD7: TRO FF,FRARG+FRSYL ;DECLARE THAT THERE IS AN ARGUMENT AND A CURRENT VALUE + JRST CD5 ;AND RETURN + + +;ARGDFL MACRO CALLS HERE IF FROP WAS SET, AFTER CLEARING IT. +;ARGDFL IS USED TO DEFAULT "-" TO "-1", ETC. +ARGDF0: SETZM SYL ;PRETEND A "1" HAD PRECEDED THIS CMD, + AOS SYL ;AFTER THE OPERATOR THAT NEEDS 2ND ARG, + XCT DLIM ;DO THE ARITHMETIC, + POPJ P, + +PNT: MOVE A,OSYL + TRNE FF,FRSYL + JRST VALRET + MOVE A,PT + SUB A,BEG + JRST VALRET + +CNTRAT: ARGDFL Z, ;^@ - TAKES 1 ARG, RETURNS .,.+ARG OR .+ARG,. . + TRZE FF,FRARG2 + JRST [ TRZE FF,FRCLN ;M,N:^@ RETURNS N,M. + JRST [ MOVE B,C + MOVE A,E + JRST 2VALS] + MOVE A,C ;M,N^@ RETURNS N-M. + SUB A,E + JRST POPJ1] + MOVE B,PT + ADD C,PT + MOVE A,C + CAMG A,B ;MAKE SURE ARGS ARE IN RIGHT ORDER. + EXCH A,B + JRST HOLE0 + +HOLE: MOVE B,BEGV + MOVE A,ZV +HOLE0: SUB B,BEG ;RETURN 2 CHAR ADDRS AS VALUES. + SUB A,BEG ;CHANGE THEM TO CHARACTER NUMBERS (REL TO BEG, THAT IS) +2VALS: MOVEM B,SARG ;RETURN 2 VALUES IN B, A. + TRO FF,FRARG2 + JRST POPJ1 + +END1: SKIPA A,ZV +BCMD: MOVE A,BEGV +FSROC1: SUB A,BEG + JRST POPJ1 + +;F^X COMMAND - WITHIN MACRO, RETURN THE MACRO ARGS +;(AS MANY AS IT WAS CALLED WITH). +FCTLX: MOVE A,MARG2 ;GET THE VALUES THE MACRO'S ARGS HAVE IF THEY EXIST. + MOVE B,MARG1 + MOVE C,MACBTS ;GET THE BITS THAT SAY WHETHER THEY DO. +;ENTER HERE DO F^X ON SOME OLD MACRO FRAME, WITH ITS DATA IN A, B, C. +FCTLX2: TRZ FF,FRARG+FRARG2+FROP+FRSYL + SETZM NUM ;FLUSH ALL TRACES OF ARGUMENTS. + SUB P,[1,,1] ;THROW AWAY RET ADDR (VALREC-1); WE WILL JUMP INTO COMMAND LOOP. + TLNN C,MFBA1 ;IF THERE'S A 1ST ARG, + JRST FCTLX1 + MOVEM B,SARG ;PUT IT AWAY + TRO FF,FRARG2 ;AND SAY THERE IS ONE. +FCTLX1: TLNE C,MFBA2 + JRST VALREC ;IF THERE'S A 2ND ARG, SET IT UP AS CURRENT VALUE. + JRST CD2A ;IF THERE ISN'T, SET UP NO CURRENT VALUE BUT DON'T CLEAR FRARG2. + +;F^Y COMMAND - TAKES 0,1 OR 2 ARGS, AND RETURNS 0 IF NO ARGS, 1 IF ONLY A 2ND ARG, +;2 IF ONLY A 1ST ARG (EG 1,F), 3 IF TWO ARGS (EG 1,2F). +;IN ADDITION, 4 IS ADDED TO THE RESULT IF THE COLON FLAG IS SET, +;AND 8 IS ADDED TO THE RESULT IF THE ATSIGN FLAG IS SET. +FCTLY: LDB A,[.BP FRARG+FRARG2+FRCLN+FRUPRW,FF] + TRZ FF,FRARG+FRARG2+FRUPRW+FRCLN + JRST POPJ1 + +;^M - FLUSH CURRENT VALUE +CTLM: MOVE A,CPTR ;^M. IF NEXT CHAR IS ^J, READ IT NOW. + ILDB CH,A + CAIN CH,^J + SKIPN COMCNT ;THIS IS SO THAT, IF FS STEP CALLS A MACRO, + CAIA ;THE POINTER IN AN FS BACKTRACE$ IS AT A NICE-LOOKING PLACE. + CALL RCH +CTLM2: SKIPN A,STEPFL + RET + MOVE B,STEPDE ;DON'T STEP IF DEEPER IN MACRO CALLS THAN USER-SUPPLIED LIMIT. + CAMGE B,MACDEP + JUMPGE B,CPOPJ + SETZ C, ;(DON'T GIVE THE STEP MACRO A NONZERO ARG) + CALL QLGET0 + CAIA ;IF FS STEP IS A NONZERO NUMBER, DO OUR BUILT-IN STEPPING. + JRST MACXCP ;IF IT'S A STRING, MACRO IT AND RETURN ITS VALUE. + MOVE A,QRB.. + SKIPE .QVWFL(A) + JRST CTLM1 + TRZ FF,FRARG+FRARG2+FRCLN + TRO FF,FRUPRW ;IN LINE-STEPPING MODE (SEE FS STEP$), + CALL VIEW1B ;DO ^VW, AND DECODE VALUE OF CHARACTER READ +CTLM1: MOVE A,QRB.. + SETZM .QVWFL(A) ;AND ALLOW BUFFER DISPLAY AFTER COMMAND. + TRZ FF,FRUPRW+FRCLN + CALL FTYI + JFCL + CAIN A,^F + JRST [ SETZM NOQUIT ;^F QUITS EVEN WHEN QUITTING NOT ALLOWED. + SETOM STOPF + RET] + CAIN A,^R + JRST [ CALL RRENTR ; ENTER ^R MODE + JRST CTLM1] ;THEN DECODE ANOTHER CHARACTER. + CAIN A,^P + SETZM STEPFL ;OR TURN OFF STEPPING + RET + +CAND: MOVSI A,(AND C,) + JRST CD2B +COR: MOVSI A,(IOR C,) + JRST CD2B +BAKARR: HRROI B,SERCHA ;_ IS EITHER SEARCH-AND-YANK OR SAME AS -. + SKIPLE NLAROW ;FS _DISABLE POSITIVE => "_" IS ERROR. + TYPRE [DCD] ;"DISABLED COMMAND" + SKIPN NLAROW ;FS _DISABLE IS NEGATIVE => "_" IS TREATED AS "-". + JRST CD5B ;FS _DISABLE IS 0 => "_" IS SEARCH-AND-YANK. +MINUS: MOVSI A,(SUB C,) + JRST CD2B +TIMES: MOVSI A,(IMUL C,) + JRST CD2B +SLASH: MOVSI A,(IDIV C,) + JRST CD2B +CXOR: MOVSI A,(XOR C,) + JRST CD2B +PLUS: MOVSI A,(ADD C,) + JRST CD2B + +SPACE: TRNE FF,FROP ;SPACE BETWEEN NUMBERS IS LIKE PLUS, + JRST CD5A ;BUT SPACE NEXT TO AN ARITHMETIC OPERATOR IS IGNORED. + JRST CD2A + +COMMA: TRZN FF,FRARG + JRST COMMA1 + MOVEM C,SARG + TROE FF,FRARG2 + TYPRE [WNA] +COMMA1: SETZM NUM ;NO ACCUMULATED 1ST ARG ANYMORE, + JRST CD2A ;INIT. FOR NEW ARG, DON'T CLEAR FRCLN. + +ASLSL: TROA FF,FRUPRW ;TURN ON THE UPARROW FLAG +ACOLON: TRO FF,FRCLN ;TURN ON THE COLON FLAG + JRST CD5A ;AND GO BACK FOR MORE + +;HANDLE (, ), F(, F) + +FOPEN: SUB P,[1,,1] ;F( - PUSH VALUES BUT DON'T FLUSH THEM. + SKIPA T,[CD5A] +OPEN: MOVEI T,CD ;( - PUSH AND FLUSH VALUES. +OPEN1: TRZ FF,FRQPRN ;SAY THIS ( ISN'T A QREG NAME. +OPEN2: SAVE NUM + HLLZ CH,DLIM + HRR CH,FF ;REMEMBER CURRENT FRCLN, FRUPRW, FRARG2. + TRNE FF,FRARG2 + SAVE SARG ;SAVE 2ND ARG IF THEE IS ONE. + SAVE CH + SAVE LEV + MOVEM P,LEV + JRST (T) + +FCLOSE: SUB P,[1,,1] ;F) - POP AND THROW AWAY VALUES. CALLED WITH PUSHJ. + SKIPA T,[CD5A] +CLOSE: HRROI T,CD5A ;) - POP AND RETURN VALUES. RH(T) IS RET. ADDR., SIGN=0 => THROW AWAY. +CLOSE2: CAME P,LEV + TYPRE [UMC] ;NOT ALLOWED IF TOP OF STACK DOESN'T HAVE SOME PUSHED VALS. + SKIPN Q,ITRPTR + JRST CLOSE1 + HLRZ Q,-1(Q) + CAIN Q,(P) + TYPRE [UMC] ;DON'T ALLOW SEQUENCE "(<)" - WOULD SCREW UP ">". +CLOSE1: REST LEV + REST CH + ANDCMI CH,#FRARG2#FRCLN#FRUPRW#FROP#FRARG#FRQPRN + TRNE CH,FRARG2 + REST B + REST A + TRNN CH,FRQPRN + JUMPGE T,(T) ;FOR F), DO NOTHING WITH THE POPPED STUFF. + EXCH A,NUM ;ELSE RESTORE SAVED ARG VALUES AND OPERATOR. + HLLM CH,DLIM + TRNE CH,FRARG2 + MOVEM B,SARG + TRZE CH,FRQPRN ;FOR Q( - ), WE HANDLE THE FLAGS A SPECIAL WAY. + JRST QREGXR + TRNE FF,FRARG ;NORMALLY, WE SET UP THE VALUE WITHIN THE PARENS AS A SYLLABLE + TRZ CH,FROP ;TO DO ARITHMETIC ON. SO THE PREVIOUS OPERATOR GETS A RIGHT OPERAND. + TRNE FF,FRARG + IORI FF,FRSYL + MOVEM A,SYL + IORI FF,(CH) + JRST (T) + +;SET P FROM CH, AND FORGET ABOUT ALL ('S +;THAT WERE IN THE PART OF THE STACK THAT HAS BEEN FLUSHED. +;ALSO PERFORM APPROPRIATE ACTIONS IN CASE POPPING PAST A ^R OR A SORT. +;THEN EXIT WITH POPJ P, (NOTE P HAS CHANGED, SO CALL WITH PUSHJ CH, +;BUT DON'T DARE DO THAT IF P=CH, SINCETHAT WOULD LEAVE THE RETURN +;POINTER ON STACK ABOVE P, CAUSING TIMING ERROR WITH INT. LEVEL). +SETP: MOVEM P,SETPP + CAMLE CH,P + .VALUE ;MOVING PDL POINTER UPWARDS?? + SKIPE DISPRR ;IF POPPING OUT OF A ^R, + CALL RRERST ;UNBIND SOME STUFF. + CAMGE CH,PSSAVP + SETZM PSSAVP ;DETECT ERRING OUT THROUGH A ^P, AND RELEASE SORT TABLES. +;HERE IF KNOWN NOT TO BE EXITING A ^R OR ^P. +SETP1: SKIPE LEV ;IF THERE IS AN (, + CAML CH,LEV ;AND IT'S NO LONGER BENEATH P, + JRST [ MOVE P,CH ? RET] + HRRZ P,LEV + CAIL P,PDL + CAIL P,PDL+LPDL + .VALUE + MOVE P,LEV ;FLUSH THE INNERMOST "(" + REST LEV + JRST SETP1 ;AND EXAMINE THE NEXT ONE. + +SUBTTL VIRTUAL CHARACTER ADDRESS SUBROUTINES + +CHKC: CAML E,BEGV ;BARF IF E NOT IN BUFFER. + CAMLE E,ZV + TYPRE [NIB] + RET + +CHK: CAMG C,ZV + CAMGE C,BEGV + TYPRE [NIB] + RET + +CHK1: CAMG E,BEGV + MOVE E,BEGV + CAML C,ZV + MOVE C,ZV + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +CHK1A: CAMG E,BEG + MOVE E,BEG + CAML C,Z + MOVE C,Z + CAMLE E,C + TYPRE [2%1] ;2<1 + RET + +GETIBI: SKIPA BP,IN +GETIB.: MOVE BP,PT +GETIBV: CAML BP,GPT + ADD BP,EXTRAC +GETIBP: SOSA TT,BP +GETBP: MOVE TT,BP + IDIVI TT,5 + MOVE BP,BTAB(TT1) + HRRI BP,(TT) + TLZ BP,17 + POPJ P, + +;CONVERT THE BYTE POINTER IN BP TO A CHARACTER ADDRESS +GETCA: LDB TT,[360600,,BP] ;GET POSITION FIELD IN TT + MOVEI BP,1(BP) ;CLEAR OUT LH OF BYTE POINTER + IMULI BP,5 + IDIVI TT,7 + SUBI BP,1(TT) + POPJ P, + +GETINC: MOVE TT,IN + AOSA IN +GETCHR: MOVE TT,IN + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + LDB CH,BTAB(TT1) + POPJ P, + +PUTINC: MOVE TT,OUT + AOSA OUT +PUT: MOVE TT,OUT + CAML TT,GPT + ADD TT,EXTRAC + IDIVI TT,5 + DPB CH,BTAB(TT1) + POPJ P, + + 440700+TT,, ;FOR SORT +BTAB: 350700+TT,, + 260700+TT,, + 170700+TT,, + 100700+TT,, + 10700+TT,, + +;CALL GETARG TO DECODE 0,1 OR 2 ARGS AS "T", "K", "X", ETC. DO. +;RETURNS IN E,C THE CHAR ADDRS OF BEGINNING AND END OF RANGE. +;SKIPS IF THERE WERE 0 OR 1 ARG; DOESN'T SKIP IF WERE 2. +;THE CALL TO GETARG SHOULD BE FOLLOWED BY A CALL TO CHK1 +;OR CHK1A, TO MAKE SURE THE ARGS ARE IN RANGE, IF THERE ARE 2 ARGS. + +;HERE TO AVOID LOOKING AT THE UPARROW FLAG. ALSO, CHECK RANGE USING VIRTUAL BOUNDS. +GETANU: SAVE FF + ANDCMI FF,FRUPRW + CALL GETARG + CALL CHK1 + REST FF + ANDCMI FF,FRCLN + RET + +;WITH THE UPARROW MODIFIER, WE STOP ONLY AT CRLFS, NOT STRAY LF'S. +GETARG: TRNE FF,FRARG2 + JRST GETAG6 + ARGDFL O +GETAG7: MOVE IN,PT +GETAG4: SAVE CH + SAVE B + JUMPLE C,GETAG2 + MOVE BP,IN + CAML BP,GPT + ADD BP,EXTRAC + CALL GETIBP +GETAR1: CAMN IN,ZV + JRST GETAG5 + CAMN IN,GPT ;REACHING THE GAP => MOVE OVER IT. + CALL FEQGAP + ILDB CH,BP + CAIE CH,^J ;SCN UNTIL THE NEXT LF. + AOJA IN,GETAR1 + TRNN FF,FRUPRW ;IF WE HAVE THE UPARROW FLAG, + AOJA IN,GETAR2 + MOVE CH,BP ;CHECK THAT BEFORE THIS LF THERE IS A CR. + DBP7 CH + LDB CH,CH + TRNE FF,FRCLN ;IF WE HAVE COLON FLAG, WE WILL STOP BEFORE THE CR, + CAME IN,PT ;SO INSIST THAT THE CR ITSELF BE AFTER OUR STARTING POINT. + CAIE CH,^M + AOJA IN,GETAR1 + AOJ IN, +GETAR2: SOJG C,GETAR1 ;FOUND LF OR CRLF AS APPROPRIATE. IN POINTS AFTER THE LF. +GETAG1: TRZE FF,FRCLN + CALL GETAG8 + CAMG IN,BEGV + MOVE IN,BEGV +GETAG5: REST B + REST CH + MOVE E,PT + MOVE C,IN + TRZ FF,FRCLN\FRUPRW ;TURN IT OFF IF NOT ALREADY DONE + TLZE FF,FLNEG + EXCH C,E + AOS (P) + RET + +GETAG8: SUBI IN,2 + PUSHJ P,GETCHR + CAIE CH,15 + AOJA IN,GETAG9 + POPJ P, + +GETAG9: PUSHJ P,GETCHR + CAIE CH,12 + AOJ IN, + POPJ P, + +GETAG6: ADD C,BEG + ADD E,BEG + TRZ FF,FRCLN\FRUPRW + POPJ P, + +GETAG2: SOS IN +GETAG0: CAMGE IN,BEGV + AOJA IN,GETAG3 + PUSHJ P,GETCHR + CAIE CH,12 + SOJA IN,GETAG0 + TRNN FF,FRUPRW + JRST GETAR3 + CAMN IN,BEGV + JRST GETAG3 + SUBI IN,1 + CALL GETINC + CAIE CH,^M + SOJA IN,GETAG0 +GETAR3: AOJLE C,GETAG2 + AOJ IN, +GETAG3: TLO FF,FLNEG + JRST GETAG1 + +SUBTTL FUNDAMENTAL TECO COMMANDS + +REVERS: TRNE FF,FRARG2 ;R MOVES BACK N CHARACTERS. + JRST LINE ;MAKE FLR MOVE RIGHT OVER A LIST. + ARGDFL Z + MOVNS C + JRST REVER1 + +CHARAC: ARGDFL Z +REVER1: ADD C,PT +JMP1: CAML C,BEGV ;IS THE SPEC'D POS. WITHIN BFR'S LIMITS? + CAMLE C,ZV + JRST [TRZE FF,FRCLN ;NO, FOR :C, ETC. + JRST NRET0 ;RETURN FAILURE. + TYPRE [NIB]] ;NO :, THIS IS ERROR. + MOVEM C,PT + TRZE FF,FRCLN + JRST NRETM1 ;FOR :C, ETC. SAY SUCCESSFUL. + POPJ P, + +JMP: TRZN FF,FRARG + SKIPA C,BEGV + ADD C,BEG + JRST JMP1 + +LINE: CALL GETARG ;GET PT AND DESIRED PT IN C,E. DO GOBBLE UPARROW FLAG. + CALL CHK1 ;MAKE SURE ARGS ARE WITHIN VIRT. BUFFER. + ADD C,E + SUB C,PT ;IF EITHER ARG EQUALED PT, PT IS NOW THE OTHER ONE. + JRST JMP1 + +KILL: PUSHJ P,GETARG + PUSHJ P,CHK1 + JRST DELET1 + +DELETE: ARGDFL Z +DELET0: JUMPE C,CPOPJ ;DELETING 0 CHARS. + MOVE E,PT + ADD C,PT ;C,E HAVE 2 ENDS OF RANGE TO DELETE. + CALL CHK ;MAKE SURE C IS IN THE BUFFER. + +;MAIN DELETE RTN. C,E VIRTUAL CHAR ADDRS -> ENDS OF STUFF TO DELETE +;SETS PT TO PLACE DELETED FROM, LEAVES GAP THERE TOO. +.SEE FXCMD ;MUSTN'T CLOBBER A OR D. +DELET1: CAMG C,E ;GET UPPER END IN C, LOWER IN E. + EXCH C,E + MOVEM E,PT ;TELL GAPSLP WHERE TO PUT GAP (IF CALL IT) + SKIPE READON ;IF NOT ALLOWED TO MODIFY BUFFER + TYPRE [RDO] ;BARF OUT HERE + CAML C,GPT ;IF THE GAP IS IN OR NEXT TO + CAMLE E,GPT ;THE AREA BEING DELETED, OK. + CALL GAPSLP ;ELSE MOVE IT TO BE SO. + MOVEM E,GPT ;NOW TURN THE AREA INTO GAP. + SUB C,E +DELETB: SETOM MODIFF ;WE ARE CHANGING THE BUFFER CONTENTS. + ADDM C,EXTRAC + MOVNS C + ADDM C,ZV + ADDM C,Z + POPJ P, + +DEL1B: SOS PT ;DELETE 1 CHARACTER BACKWARDS FROM PT. + SOS GPT +DEL1F: SOS ZV ;DELETE 1 FORWARDS FROM PT. + SOS Z + AOS EXTRAC + RET + +SUBTTL F^E REPLACE CHARACTERS COMMAND + +;F^E$ - REPLACE STRING INTO BUFFER STARTING AT POSITION . +;:F^E$ - REPLACE IN QREG (EITHER STRING OR BUFFER WORKS). +;REPLACING IS LIKE INSERTING AND THEN DELETING AS MANY CHARS AS WERE INSERTED. +FCECMD: ARGDFL + TRZN FF,FRCLN + JRST FCE1 ;INSERT IN BUFFER? + TRZN FF,FRARG + TYPRE [WNA] + CALL QREGX ;NO, QREG. WHICH ONE? + CALL QLGET0 ;LENGTHH IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + SKIPL C + CAMLE C,B ;MAKE SURE ARG IS IN RANGE + TYPRE [AOR] + CALL GETCA + ADD BP,C ;ADJUST B.P. TO PLACE TO START REPLACING AT. + CALL GETBP + SETZ A, ;THERE'S NO GAP TO WORRY ABOUT. + JRST FCE2 + +FCE1: SKIPE READON ;ALLOWED TO MUNGE THIS BUFFER? + TYPRE [RDO] ;NO + SETOM MODIFF ;HERE WE ARE CHANGING THE CURRENT BUFFER'S CONTENTS. + TRZE FF,FRARG ;NO ARG, AND REPLACING IN BUFFER => USE ".". + JRST FCE5 + MOVE C,PT + SUB C,BEG +FCE5: MOVE BP,GPT ;REPLACE IN BUFFER. + CALL GETIBP ;MAKE B.P. TO START OF GAP SO WE CAN TELL WHEN WE REACH GAP. + MOVE A,BP + MOVE BP,BEG + ADD BP,C ;GET VIRT. CHAR ADDR OF WHERE TO START REPLACING + CAML BP,BEGV + CAMLE BP,ZV + TYPRE [AOR] + CALL GETIBV ;TURN INTO REAL CHAR ADDR, THEN BP. + ADD C,BEG ;TURN STOP ADRD IN C INTO ADDR REL. TO VIRTUAL BEG, + SUB C,BEGV ;SINCE MUST BE COMPARED WITH VIRTUAL SIZE. + MOVE B,ZV + SUB B,BEGV ;GET LENGTH OF BUFFER. +FCE2: SUB B,C ;C HAS CHARS FROM PLACE WE START TO END OF BUFFER OR QREG. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;FIND OUT WHAT STRING ARG DELIMITER WE'RE USING. + CALL RCH + MOVEM CH,INSDLM +FCE3: CALL RCH ;THIS IS THE INNER LOOP OF FCE + SKIPE SQUOTP + JRST FCE4 + CAMN CH,INSDLM ;CHECK CHAR FOR DELIMITERNESS UNLESS SUPERQUOTED, ETC. + JRST FCEEND +FCE4: SOJL B,[TYPRE [STL]] ;CHECK FOR END OF BUFFER OR QREG. + CAMN A,BP + CALL FEQGAP ;CHECK FOR GAP - MOVE B.P. IN BP OVER IT. + IDPB CH,BP + JRST FCE3 + +FCEEND: SETOM INSBP + RET + +SUBTTL INSERTION COMMANDS + +;INSERT ASCIZ STRING <- BP IN A, INTO Q-REG IN CH. +INSASC: TRO FF,FRCLN ;SAY INSERT IN Q-REG. + SAVE CH + SAVE [0] + SETZM INSDLM ;DELIMITER IS THE ^@ ENDING THE ASCIZ. + MOVE CH,[ILDB CH,A] + MOVEM CH,INSRCH ;GET CHARS BY ILDB-ING BP. + JRST INSAS1 + +FNCMD: MOVE CH,[CALL RCH] ;FN = [..N:I..N BUT PREVENTS QUIT IN BETWEEN. ;] + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QUNWN + CALL OPENB2 + JRST PSI + +CNTRLF: MOVN C,INSLEN ;^F -- SAME AS "FKDI". + CALL DELET0 + TRZ FF,FRARG ;MAKE SURE ^F DOESN'T INSERT ASCII(N). + JRST INSERT + +TAB: HRROI B,TAB0 ;HERE FOR TAB. DECIDE WHETHER IT'S + SKIPLE TABMOD + TYPRE [DCD] ;DISABLED, + SKIPE TABMOD + MOVEI B,SPACE ;IGNORED (LIKE SPACE, ACTUALLY), + JRST CD5B ;OR ENABLED (IN WHICH CASE COME BACK TO TAB0). + +TAB0: PUSHJ P,TYOMGS ;USED FOR ENTRY FROM SELF-INSERTING CHARACTERS + ANDCMI FF,FRCLN\FRUPRW\FRARG\FRARG2 +INSERT: TRNE FF,FRARG ;IF GIVEN AN ARG, + JRST INS1C ;THEN JUST INSERT THAT CHARACTER + MOVE OUT,[CALL RCH] ;SAY TO USE RCH TO GET CHARACTERS TO INSERT + MOVEM OUT,INSRCH + TRNN FF,FRCLN ;IF NOT GOING TO A Q REG + JRST INS1 ;THEN SKIP THIS STUFF + PUSHJ P,QREGVS ;OTHERWISE GET THE Q-REG NAME + JUMPE B,INS0 ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS PSI, THEN RETURNS TO INSERT'S CALLER. + JRST INS0 + +;PSI IS USED BY THINGS THAT WANT TO INSERT A STRING ARG INTO A SPECIFIC QREG. +;THE QREG ADDRESS SHOULD BE IN CH. +PSI: SETZ B, + TRO FF,FRCLN +INS0: SAVE CH ;REMEMBER WHICH QREG TO STORE IN. + SAVE B + CAIA +INS1: PUSHJ P,GAPSLP ;GET THE GAP AROUND THE HOME COUNTRY + MOVEI CH,ALTMOD ;GET THE TEMPORARY APROX- + ;IMATION TO THE DELIMITER + TRZE FF,FRUPRW ;IF IT ISN'T RIGHT (THE UPARROW + ;INDICATOR IS TURNED ON) + PUSHJ P,RCH ;THEN GET THE RIGHT ONE + MOVEM CH,INSDLM ;AND SAVE IT AS THE ONE TO USE + TRNN FF,FRCLN ;IF NOT INTO A Q-REG, THEN JUMP + JRST INS2 ;FORWARD +INSAS1: MOVE C,BFRBOT ;GET # CHARS UNUSED AFTER IMPURE STRING SPACE, + SUB C,QRWRT + SUBI C,4 ;WE'LL CERTAINLY NEED 4 FOR HEADER OF NEW STRING. + ;INS5 WILL PUT THAT IN TOTALC, # CHARS FREE TO USE. + MOVE BP,QRWRT ;START STRING AT START OF FREE SPACE, + ADDI BP,4 ;BEGIN THE TEXT AFTER WHERE HEADER'LL GO. + JRST INS5 + +INS2: MOVE BP,PT ;NEXT, GET THE POINTER ADDRESS + MOVE C,EXTRAC ;# CHARS FREE TO STORE IN IS GAP SIZE. +INS5: MOVEM C,TOTALC + CALL GETIBP ;GET BP FOR IDPB INTO GAP. + MOVEM P,INSINP .SEE INSCHK ;GO TO INSDUN ON CNM ERROR, TO CLEAN UP. + SETZM INSBP ;MAKE SURE BP IS RELOCATED IF BUFFER MOVES INSIDE GETFRM INSIDE RCH. + +;HERE IS THE LOOP THAT GETS CHARACTERS AND PUTS THEM IN THE BUFFER +INSLUP: XCT INSRCH ;GET A CHARACTER (RCH AUTOMATICALLY + ;[ ;TAKES CARE OF ALL ^] CALLS AND MACRO + ;RETURNS) +INSDCK: SKIPE SQUOTP ;UNLESS WITHIN QUOTED MACRO, + JRST INSDIR + CAMN CH,INSDLM ;THEN SEE IF IT IS THE DELIMITER + JRST INSDUN ;IF SO, YOU'RE ALMOST DONE +INSDIR: SOSGE TOTALC + CALL INSSL1 + IDPB CH,BP + JRST INSLUP + +INSSL1: SETOM INSBP .SEE BFRRL3 ;FAKE OUT THE ERROR CHECK AT BFRRL3+EPSILON + CALL INSSLP + SETZM INSBP + RET + +INSSLP: MOVN C,TOTALC ;HOW MANY CHARS ALREADY KNOWN NEEDED.? + TRNE FF,FRCLN + JRST SLPQRG ;:I, MOVE UP BUFFER AT LEAST THAT MUCH. + ADD C,EXTRAC + JRST SLPSAV ;ELSE MAKE GAP > THAT MUCH BIGGER. + +INSDUN: SETOM INSBP + CALL GETCA + AOS OUT,BP ;CHAR ADDR 1ST PLACE NOT STORED IN. + TRNN FF,FRCLN ;IF YOU'RE NOT USING A Q-REG + JRST INS4 ;THEN EVERYTHING IS MUCH SIMPLER + SKIPGE TOTALC ;IF INSERTING 0 CHARS, MAKE SURE SPACE FOR HEADER. + CALL INSSL1 +INSDU1: MOVE C,BP ;GET END OF STRING, + MOVE BP,QRWRT ;AND PLACE START OF HEADER SHOULD BE. + SUB C,BP ;# CHARS WE USED (TEXT SIZE +4) + MOVEI B,QRSTR ;THIS IS THE CHAR TO START THE HEADER + CALL QHDRW0 ;WRITE A STRING HEADER AT <- CHAR ADDR IN BP. +INS3: REST B ;GET BACK INFO ON QREG. + REST CH ;GET BACK ADDR OF QREG TO STORE IN. + CALL QCLOSE ;STORE IN IT; OUT HAS CHAR ADDR END OF STRING. + ;QRWRT HAS CHAR ADDR OF BEINNING. UPDATES ALL PTRS. + JRST INSRT1 + +INS4: MOVEM BP,PT + MOVEM BP,GPT + MOVE CH,TOTALC ;# CHARS OF GAP WE DIDN'T USE. + EXCH CH,EXTRAC ;IS WHAT'S LEFT OF THE GAP. + SUB CH,EXTRAC ;AMOUNT WE DID USE + MOVEM CH,INSLEN ;IS # CHARS INSERTED. + ADDM CH,Z ;THAT MANY MORE CHARS NOW. + ADDM CH,ZV +INSRT1: SKIPN INSINP ;0 => WAS CLEARED BY INSCHK, WAS CNM ERROR. + TYPRE [CNM] + SETZM INSINP ;NO LONGER IN MIDDLE OF INSERT. + TRZ FF,FRCLN+FRUPRW ;IF THIS IS :I*, WE ARE RETURNING VALUE SO MUST CLEAR THESE + RET ;BY HAND. + +INS1C: ARGDFL + TRNN FF,FRARG2 ;,I - INSERT TIMES. + MOVEI E,1 + SKIPGE E +TYPAOR: TYPRE [AOR] + TRZE FF,FRCLN + JRST INS1CQ ;INTO QREG? + MOVE CH,NUM ;INTO BUFFER. + ANDCMI FF,FRCLN + PUSHJ P,GAPSLP + SKIPN C,E + RET + CALL SLPGET ;GET C(C) CHARS SPACE, AND B.P. IN BP. + IDPB CH,BP + SOJG C,.-1 + RET + +TYOMGS: CALL GAPSLP +TYOM: SAVE C + PUSH P,TT + PUSH P,TT1 + SAVE BP + MOVEI C,1 + CALL SLPGE1 + IDPB CH,BP + REST BP + POP P,TT1 + POP P,TT +POPCJ: REST C + RET + +;:I -- INSERT 1 CHAR IN QREG. +;,:I -- INSERT COPIES OF CHARACTER. +;:I* -- RETURNS A STRING CONTAINING THE CHARACTER . +INS1CQ: CALL QREGVS ;GET ADDR OF QREG IN CH. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + ;FLUSH ARG IN CASE :I* - OTHERWISE WOULD ADD ARG TO VALUE. + JUMPE B,INS1CR ;IS THE QREG SUBSCRIPTED? (:I:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS INS1CR, THEN RETURNS TO INSERT'S CALLER. +INS1CR: SAVE B + MOVEI C,4(E) ;NEED 4 CHARS FOR HEADER, + CONTENTS. + CALL SLPQGT ;MOVE BUFFER UP IF NEC. + MOVEI B,QRSTR ;1ST CHARACTER, FOR HEADER. + MOVEI C,4(E) ;LENGTH, FOR HEADER. + CALL QHDRW1 ;WRITE THE STRING HEADER, LEAVE BP IN BP. + MOVE C,E + MOVE A,NUM + IDPB A,BP + SOJG C,.-1 + MOVEI OUT,4(E) ;GET ADDR 1ST CHAR THIS NEW STRING DOESN'T USE. + ADD OUT,QRWRT + REST B + JRST QCLOSE ;UPDATE QRWRT; STORE STRING IN QREG <- CH. + +SUBTTL GAP CONTROL + +IFNDEF SLPAMT,SLPAMT==SLPWRD*5 ;MAKE GAP IN UNITS OF THIS MANY CHARS. +IFNDEF SLPQAM,SLPQAM==SLPQWR*5 ;MOVE BUFFER UP IN UNITS OF THIS MANY. + +;MAKE SOME SPACE BY MOVING A SEGMENT OF MEMORY UPWARD. +;REAL CHARACTER ADDR. OF BOTTOM CHAR. OF SEGMENT TO MOVE IN BP +;REAL CHAR ADDR OF SEGMENT IN TT. +;MINIMUM AMOUNT OF SPACE (# OF CHRS) IN C. +;SPACE IS MADE ONLY IN MULTIPLES OF A WORD. +SLPN00: MOVE D,BFRTOP + SUB D,BEG ;GET NUMBER OF CHARS WE WILL HAVE TO MOVE. + CAIL D,2000*5*5 ;IF MORE THAN 5K WORDS, IT PAYS TO MAKE LOTS OF SPACE. + SKIPA D,[2000] ;SO MAKE IT A K AT A TIME, AND USE PAGE-MAPPING. + MOVEI D,100 ;ELSE JUST MAKE 100 WORDS AT A TIME. + MOVE E,@BFRPTR + TLNE E,MFQVEC ;IN A QVECTOR, MAKE ONLY 100 WORDS OF SPACE + MOVEI D,100 ;SINCE THEY NEVER GET VERY BIG. + MOVE E,D + IMULI D,5 + ADDI C,-1(D) ;ROUND C, THE NUMBER OF CHARS OF SPACE WE NEED, + IDIV C,D ;UP TO A MULTIPLE OF WHAT'S IN D, + IMUL C,E ;BUT CONVERT IT TO WORDS INSTEAD OF CHARACTERS. +;HERE TO MAKE SPACE FOR IMPURE STRING SPACE. +SLPN0Q: IDIVI BP,5 + ADDI TT,4 + IDIVI TT,5 + MOVE E,TT + ADD E,C ;ADDR OF LAST WD TO MOVE INTO, + 1. + SKIPE PSSAVP ;IF SORTING, + CAMGE E,PSMEM ;IF WE'D BE CLOBBERING SORT TABLES, MOVE THEM TOO. + JRST SLPN01 + MOVE TT,PSMEMT ;LAST WD TO MOVE UP IS LAST WD OF SORT TABLES, + ADDI TT,3 + ADDM C,PSMEM ;RELOCATE POINTERS TO SORT TABLES. + ADDM C,PSMEMT + MOVE E,TT + ADD E,C +SLPN01: ADDI E,2000 + LSH E,-10. + CAML E,LHIPAG ;DON'T IMPINGE ON PURE STRING SPACE! LEAVE 1K EMPTY IN BETWEEN. + TYPRE [URK] +IFN ITS,[ + TRNN C,1777 ;IF MAKING SPACE IN UNITS OF A K, DO IT BY PAGE MAPPING + JRST SLPN0P ;TO AVOID HAVING TO SWAP EVERYTHING IN. +SLPN0W: ] + SUBM TT,BP ;BP _ # WDS TO MOVE. + HRLI TT,-1 ;TT HAS -1,,LAST WD + 1. + SUB TT,[1,,1] ;MAKE -> LAST WD (1ST POP WILL MOVE IT) + MOVEI D,(C) + HRLI D,(POP TT,(TT)) + MOVE E,[SOJGE BP,D] + MOVE J,[JRST SLPN02] + JRST E +SLPN02: MOVE E,C ;GET BACK # WDS ADDED, + IMULI E,5 + ADDM E,TOTALC + POPJ P, + +IFN ITS,[ +SLPN0P: CAILE TT,2000(BP) ;MAKE SURE WE HAVE AT LEAST A K LEFT TO DO! + SKIPE PSSAVP ;USE PAGE-MAPPING ONLY IF NO SORT TABLE! WE'D CLOBBER IT! + JRST SLPN0W +SLPN03: MOVEI D,-1(TT) + LSH D,-10. ;COMPUTE # OF TOP PAGE TO MOVE, + MOVEI E,1777(TT) + ADD E,C ;AND # OF PAGE TO MOVE IT INTO, + 1. + LSH E,-10. + CAMLE E,MEMT ;SINCE WE ARE MOVING UP THE BOUNDARY OF BUFFER SPACE MEMORY, + MOVEM E,MEMT ;WE MUST REMEMBER THAT. + SUBI E,1 ;NOW CONVERT TO EXACT PAGE TO MOVE INTO. + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSELF ? D] + .LOSE %LSSYS + SUBI TT,1 + ANDI TT,-2000 ;SET TT TO TOP OF WHAT STILL NEEDS TO BE MOVED. + CAILE TT,2000(BP) ;KEEP MOVING PAGES UNTIL LESS THAN A PAGE REMAINS. + JRST SLPN03 +SLPN0R: CAMG E,D ;NOW, MAKE FRESH PAGES WHERE THE NEWLY CREATED GAP IS. + JRST SLPN0W + SOS E ;ENOUGH TO MAKE SURE WE DON'T HAVE ANYTHING IN THE MAP TWICE + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? E ? %CLIMM,,%JSNEW] + .LOSE %LSSYS ;IS EXACTLY THE RIGHT NUMBER. + JRST SLPN0R +] ;IFN ITS + +;MAKE SURE GAP AT LEAST SOME MINIMUM SIZE +;(# CHARS IN C) +SLPSAV: CAMG C,EXTRAC + RET + CALL SAVACS + SUB C,EXTRAC ;HOW MANY MORE CHARS NEEDED? + MOVE BP,GPT ;GET ACTUAL ADDR OF END OF GAP. + ADD BP,EXTRAC + MOVE TT,BFRTOP ;GET ACTUAL ADDR OF END OF BUFFER. + SAVE Z + SAVE MEMT + PUSHJ P,SLPN00 + MOVEI D,@D ;GET ADDR LAST WD OF NEWLY MADE GAP. + REST BP ;DON'T NEED TO CLEAR NEWLY OBTAINED CORE. + SKIPE YANKMT + MOVE BP,YANKMT + LSH BP,10. + CAML D,BP + SOS D,BP + MOVEI BP,1 ;PREPARE TO CLEAR LOW BITS OF WDS THAT NEED IT. + REST A ;ANY WD PREVIOUSLY PART OF THIS BUFFER DOESN'T NEED IT. + IDIVI A,5 +SLPSA2: CAMGE D,A + JRST SLPSA1 + ANDCAM BP,(D) + SOJA D,SLPSA2 + +SLPSA1: ADDM E,EXTRAC + MOVE T,E + MOVE TT,Z + CALL BFRRLC + JRST RSTACS + +;LIKE SLPGET, BUT FOR COMMANDS THAT EITHER INSERT IN THE BUFFER +;OR CONS UP AND RETURN A STRING. SUCH COMMANDS SHOULD ALSO EXIT THRU SLPXIT. +SLP: TRNE FF,FRCLN + JRST QOPEN + +;INSERT C(C) CHARS AT PT, MAKING SPACE IF NEC. +;PUTS PT AFTER THEM. BRINGS THE GAP TO PT. +;DON'T ACTUALLY PUT ANYTHING IN THOSE CHARS, +;RATHER RETURN IN BP A BP. TO IDPB INTO THEM. +;CLOBBERS TT, TT1. PRESERVES C! +SLPGET: CALL GAPSLP +SLPGE1: CAMLE C,EXTRAC ;HAVE ENOUGH ROOM FOR THE CHARS? + CALL SLPSAV ;NO, STRETCH GAP. + MOVE BP,PT + ADDM C,PT ;UPDATE VARS FOR INSERTION OF THOSE CHARS. + ADDM C,GPT + MOVNS C ;DELETE - CHARS TO UPDATE Z, ZV, EXTRAC. + CALL DELETB ;DELETB NEGATES C. + SOJA BP,GETBP ;MAKE REMEMBERED PT (IN BP) INTO BP. + +;MAKE SURE UNUSED SPACE AFTER IMPURE STRING SPACE AT LEAST C(C) CHARS. +;MAY MOVE BUFFER, IN WHICH CASE ALL BUFFER POINTERS WILL +;BE UPDATED AS NECESSARY. +SLPQGT: ADD C,QRWRT ;CHAR ADDR LAST CHAR WE'LL NEED. + SUB C,BFRBOT ;THAT CHAR IN BUFFER? + JUMPL C,CPOPJ ;NO, HVE ENOUGH ROOM. + +;GET AT LEAST C(C) MORE UNUSED SPACE FOR IMPURE STRINGS. +;WILL MOVE BUFFER AND UPDATE ALL BUFFER POINTERS. +SLPQRG: CALL SAVACS + MOVE BP,BFRBOT ;MOVE ENTIRE BUFFER. + MOVE TT,BFRTOP ;GET REAL ADDR. END OF BUFFER. + ADDI C,SLPQAM-1 + IDIVI C,SLPQAM ;# OF UNIT INCREMENTS WE NEED. + IMULI C,SLPQWR ;# OF WDS TO MOVE THE BUFFER. + CALL SLPN0Q ;MOVE IT. + MOVE BP,BFRBOT + IDIVI BP,5 +SLPQR1: SETZM (BP) ;CLEAR ALL WORDS OF SPACE JUST MADE. + AOJ BP, ;NOTE THAT BFRBOT HAS NOT BEEN RELOCATED YET, SO IT POINTS AT + SOJG C,SLPQR1 ;THE BOTTOM OF THE SPACE JUST MADE. + MOVE T,E + CALL BFRMOV ;RELOCATE ALL PTRS TO BUFFER. + JRST RSTACS + +;WRITE A STRING HEADER. B HAS INITIAL CHARACTER (QRSTR OR QRBFR), +;C HAS CONTENTS (LENGTH OR BUFFER FRAME ADDRESS). +;BP IS LEFT WITH A B.P. TO LAST CHAR. OF HEADER. +;CLOBBERS C,T,TT. +QHDRW1: MOVE BP,QRWRT ;WRITE HEADER IN FIRST FREE SPOT. +QHDRW0: CALL GETBP ;ASSUME BP HAS CHAR ADDR OF PLACE TO WRITE. + DPB B,BP + IDPB C,BP + LSH C,-7 + IDPB C,BP + LSH C,-7 + IDPB C,BP + RET + +QCLOSV: CALL GETCA ;WHERE DID WE STOP IDPB'ING? + AOS BP + MOVE C,BP + MOVE BP,QRWRT ;BP GETS PLACE TO WRITE HEADER. + MOVE OUT,C ;OUT GETS NEW VALUE FOR QRWRT. + SUB C,BP ;C GETS LENGTH OF WHAT WE JUST WROTE (INCL HEADER) + MOVEI B,QRSTR + CALL QHDRW0 ;WRITE THE HEADER + MOVEI CH,A ;TELL QCLOSE TO STORE INTO A, + SETZ B, ;WHICH IS NOT A NAMED VARIABLE. + JRST QCLOSE + +;MAKE SURE THERE IS SPACE IN IMPURE STRING SPACE FOR C(C) CHARS, +;THEN SET UP LISTF5 TO IDPB THRU BP INTO IMPURE STRING SPACE. +QOPEN: SAVE C + ADDI C,4 ;HEADER OF STRING NEDS SPACE TOO. + CALL SLPQGT ;MAKE SURE EXISTS ENOUGH SPACE. + REST C + MOVE BP,QRWRT ;START WRITING INTO UNUSED IMPURE STRING SPACE + ADDI BP,4 ;SKIPPING ROOM FOR THE NEW STRING'S HEADER-TO-BE. + CALL GETIBP + MOVEI A,[IDPB CH,BP ? RET] + HRRM A,LISTF5 + POPJ P, + +;ASSUME A STRING HAS BEEN STORED IN THE AREA ABOVE QRWRT, +;UPDATE QRWRT AND STORE STRING PTR IN QREG. +QCLOSQ: TDZA B,B ;QREG ADDR IN CH, AND CERTAINLY NOT A NAMED VARIABLE. +QCLOSP: REST CH ;QREG ADDR IS ON STACK. B IS AS RETURNED BY QREGX. +QCLOSE: EXCH OUT,QRWRT ;QREG ADDR IN CH. B IS AS RETURNED BY QREGX. + SUB OUT,QRBUF + TLO OUT,400000 + MOVE C,OUT + JRST USE2 ;STORE VALUE IN QREG, WITH ERROR CHECKING ETC. + +;CLOSE UP THE GAP, AND SAY IT IS AT PT. +SLPSHT: SKIPN EXTRAC ;NOTHING TO DO IF NO GAP. + JRST GAPSLN + SAVE Q +SLPSH1: MOVE Q,Z + CAMN Q,GPT + JRST SLPSH2 + EXCH Q,PT + SAVE Q + CALL GAPSLP ;THEN MOVE THE GAP TO PT. + REST PT +SLPSH2: REST Q + CALL GAPKIL ;NOW GAP IS AT END, JUST FORGET ABOUT IT. +GAPSLN: SAVE PT ;GAP LENGTH IS 0, MAKES NO DIFFERENCE WHERE + REST GPT ;WE SAY THE GAP IS LOCATED. + RET + +;ASSUMING THAT THE GAP IS AT THE END OF THE CURRENT BUFFER, +;CLOSE IT UP. CLOBBERS NO ACS. RELOCATES ALL NECESSARY POINTERS +;IN BUFFER FRAMES (AND BFRTOP). +GAPKIL: SAVE A + SAVE C + SAVE B + MOVE A,Z + ADD A,EXTRAC + IDIVI A,5 ;WHAT WORD DOES THE THING AFTER THE BUFFER + MOVE C,A ;ACTUALLY START IN? + IMULI A,5 + ADDI A,5 + CAML A,BFRTOP ;IF THERE'S NOTHING AFTER THE BUFFER, JUST CHANGE A FEW POINTERS + JRST [ MOVE A,Z ;IN PARTICULAR BFRTOP POINTED AFTER GAP, + IDIVI A,5 + IMULI A,5 ;MAKE IT -> CHAR ADDR OF WORD BNDRY + ADDI A,5 ;AFTER THE END OF THE BUFFER. + MOVEM A,BFRTOP + JRST GAPKI1] + SAVE C ;THERE'S ANOTHER BUFFER AFTER THIS ONE. + MOVE A,Z + IDIVI A,5 ;WHAT WORD SHOULD IT START IN (ACTUALLY 1 LESS THAN) + HRL A,(P) ;AND -1+ + HRRZ C,A + SUB C,(P) ;C HAS - + ADD A,[1,,1] ;,, + MOVEM A,(P) + MOVE A,BFRTOP + IDIVI A,5 ;WORD FOR BLT TO STOP MOVING OUT OF (PLUS 1) + ADDI A,-1(C) + EXCH C,(P) + BLT C,(A) + EXCH T,(P) ;GET # WORDS THINGS MOVED BY. + IMULI T,5 + SAVE TT + MOVE TT,Z + ADD TT,EXTRAC + CALL BFRRLC ;RELOCATE PTRS TO BUFFERS WE MOVED. + REST TT + REST T +GAPKI1: SETZM EXTRAC +POPCBA: REST C +POPBAJ: REST B +POPAJ: REST A + RET + +;MOVE THE GAP TO PT. +GAPSLP: SKIPE READON ;ALLOWED TO MODIFY? + TYPRE [RDO] + SETOM MODIFF ;IF WE CARE WHERE GAP IS, WE MUST BE ABOUT TO MUNG THE BUFFER. +GAPSL0: SKIPN EXTRAC ;NO GAP REALLY => + JRST GAPSLN ;JUST SAY IT'S AT PT, REALLY DOESN'T MATTER. + SAVE Q + MOVE Q,PT + CAMN Q,GPT ;GAP ALREADY AT PT => NOTHING TO DO. + JRST POPQJ + CAMG Q,GPT ;MOVING GAP DOWN => DIFFERENT. + JRST GAPDN + REST Q + CALL SAVACS +GAPUP3: MOVE BP,GPT ;MOVE 1ST FEW CHARS 1 AT A TIME. + CAMN BP,PT ;(WHEN GET HERE 2ND TIME, + JRST RSTACS ;MIGHT BE NOTHING TO MOVE) + ADD BP,EXTRAC ;GET FETCHING PTR -> ABOVE GAP. + CALL GETIBP + MOVE TT,GPT + IDIVI TT,5 ;GET STORING PTR -> BELOW GAP. + MOVE A,PT + SUB A,GPT ;GET TOTAL # CHARS TO BE MOVED. + JUMPE TT1,[SOJA TT,GAPUP2] +GAPUP0: SUBI TT1,5 ;(WILL INCREM. TO 0 WHEN REACH WD BNDRY) +GAPUP1: ILDB IN,BP ;GET A CHAR FROM ABOVE GAP, + DPB IN,BTAB+5(TT1) ;PUT IT BELOW GAP, + AOS GPT ;SAY GAP HAS MOVED UP 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + AOJN TT1,GAPUP1 ;EFFECTIVELY IBP THE STORING PTR. +GAPUP2: CAIGE A,5 ;BOTTOM OF GAP NOW ON WD BNDRY, + AOJA TT,GAPUP0 ;< 1 WDS LEFT => KEEP GOING CHAR BY CHAR. + MOVEI C,1(TT) ;GET ADDR 1ST WD TO MOVE DOWN INTO. + MOVE 10,PT + ADD 10,EXTRAC ;REAL ADDR 1ST CHAR NOT TO MOVE DOWN. + SUBI 10,5 ;DON'T MOVE THE LAST 5 CHARS WITH FAST LOOP (CAN GARBAGE). + IDIVI 10,5 ;10 -> HIGHEST WD TO MOVE DOWN FROM. NOTE 10 = T. + MOVN 12,EXTRAC + IDIVI 12,5 ;12 GETS <# WDS OF GAP, ROUNDED UP>. 13 <- # CHARS ROUNDED BY. + JUMPE 13,[ ;HERE IF CAN USE BLT (ALL ON WORD BNDRYS). + ADD 10,12 ;10 GETS ADDR OF LAST WD TO MOVE DOWN TO. + SUBM C,12 ;12 GETS 1ST ADDR TO MOVE FROM. + MOVEI 11,1(10) + SUB 11,C ;11 GETS # OF WORDS TO MOVE. + IMULI 11,5 + ADDM 11,GPT ;UPDATE GPT FOR WHAT WE'RE DOING HERE. + HRLI C,(12) + BLT C,(10) + JRST GAPUP3] + ADDI 12,-1(10) ;12 -> HIGHEST WD TO MOVE DOWN INTO. + MOVNM 13,11 + IMULI 11,7 + MOVNI 14,-43(11) + SUBI C,1(12) ;C HAS MINUS # WDS TO MOVE + JUMPE C,[AOS TT,12 ;WOULD MOVE 0 WORDS (CAN HAPPEN) => DO REST BY CHARS. + SETZ TT1, + JRST GAPUP0] + MOVN 15,C ;UPDATE GPT FOR THE WDS WE'RE MOVING. + IMULI 15,5 + ADDM 15,GPT + MOVE 13,12 + HRLI 10,(MOVE B,(C)) + HRLI 11,(LSHC A,) + MOVE 12,[LSH A,1] + HRLI 13,(MOVEM A,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPUP3] + MOVE A,@10 + ROT A,-1 + MOVE 15,.+1 + AOJLE C,10 + +;MOVE THE GAP DOWN (IE MOVE CHARS FROM PT TO GPT UP) +GAPDN: MOVE Q,PT + ADD Q,PT + ADD Q,PT + ADD Q,Z ;COMPUTE WEIGHTED AVERAGE OF PT AND Z, THEN COMPARE WITH GPT + LSH Q,-2 + CAMG Q,GPT ;IS GPT CLOSER TO PT, OR TO Z? + CALL [ SAVE PT ;GPT IS MUCH CLOSER TO Z THAN TO POINT. SO FASTEST THING + MOVE Q,Z ;IS TO MOVE GAP TO Z, ADJUST WITH GAPADJ, AND + MOVEM Q,PT ;MOVE IT DOWN AGAIN USING A POP-LOOP. + CALL GAPSLP + REST PT + RET] + REST Q ;GPT CLOSER TO PT; FASTER TO MOVE GAP DIRECTLY TO POINT. + CALL SAVACS + MOVE BP,GPT + CAMN BP,Z ;IF GAP IS AT END OF BUFFER, WE CAN ADJUST ITS SIZE A LITTLE + CALL GAPADJ ;AND THEREBY ENABLE WHAT FOLLOWS TO USE A BLT. +GAPDN3: MOVE BP,GPT ;MOVE THE 1ST FEW CHARS UP, + CAMN BP,PT ;(FOR GETTING HERE 2ND TIME WITH + JRST RSTACS ;TO BE MOVED) + CALL GETBP ;GET PTR FOR FETCHING CHARS BELOW GAP, + MOVE TT,GPT + ADD TT,EXTRAC ;GET PTR FOR STORING ABOVE GAP. + IDIVI TT,5 + MOVE A,GPT ;GET TOTAL # CHARS MUST MOVE UP. + SUB A,PT + SOJL TT1,GAPDN2 ;ALREADY MOVING TO WD BNDRY. +GAPDN1: DBP7 BP ;GET PTR -> LAST CHAR BELOW GAP. + LDB CH,BP + DPB CH,BTAB(TT1) ;MOVE IT BELOW TOP OF GAP. + SOS GPT ;GAP HAS MOVED DOWN 1 CHAR. + SOJLE A,RSTACS ;GAP HAS REACHED PT => DONE. + SOJGE TT1,GAPDN1 ;EFFECTIVELY DBP7 THE OUTPUT BP. +GAPDN2: CAIGE A,5 ;TOP OF GAP NOW ON WD BNDRY +GAPDN5: SOJA TT,[ADDI TT1,5 ;< 1 WD LEFT, KEEP + JRST GAPDN1] ;CHAR AT A TIME. + MOVE 13,EXTRAC ;MOVE AS MUCH AS CAN, WD AT A TIME. + IDIVI 13,5 + IMULI 14,7 + MOVN 11,14 + MOVEI 14,-43(14) + MOVE B,PT + ADDI B,4 + IDIVI B,5 + MOVE 15,GPT + IDIVI 15,5 + MOVEI C,(15) + SUB C,B + JUMPE C,[MOVE TT,GPT ;IF CAN'T MOVE ANYTHING WORD-WISE AFTER ALL, + ADD TT,EXTRAC ;REENTER CHAR-AT-A-TIME LOOP + IDIVI TT,5 + SOJA TT1,GAPDN5] + MOVE 7,B + MOVN 15,C ;MAKE GPT REFLECT THE MOTION OF GAP + IMULI 15,5 ;THAT IS NOW ABOUT TO BE DONE. + ADDM 15,GPT + JUMPE 11,GAPDN4 ;(TRANSLATING BY INTEGRAL # OF WDS.) + ADDI 13,1(7) + HRLI 7,(MOVE A,(C)) + HRLOI 10,(LSH A,) + HRLI 11,(LSHC A,) + MOVE 12,[ANDCMI B,1] + HRLI 13,(MOVEM B,(C)) + HRLI 14,(LSHC A,) + MOVE 16,[JRST GAPDN3] + MOVE B,@7 + MOVE 15,.+1 + SOJGE C,7 + +GAPDN4: HRLI 13,(POP 7,(7)) ;EXTRAC = 0 MOD 5, NEED NOT ROTATE + ADDI 7,-1(C) ;-> HIGHEST WD TO MOVE FROM + HRLI 7,-1 ;PREVENT PDL OV. + MOVE 15,[JRST GAPDN3] ;INSN THAT EXITS LOOP. + MOVE 14,.+1 + SOJGE C,13 ;C HAS # WDS TO MOVE. + +;WHEN THE GAP IS AT Z, WE CAN ADJUST ITS SIZE WITHIN A RANGE OF 5 WITHOUT MOVING ANYTHING. +;IF WE WANT TO MOVE THE GAP DOWN, ADJUSTING ITS SIZE TO A MULTIPLE OF 5 +;WILL ENABLE US TO USE A POP-LOOP INSTEAD OF A SLOWER LOOP. + +GAPADJ: MOVE A,Z + IDIVI A,5 ;IF EXTRAC IS A MULTPLE OF 5, REAL Z (Z+EXTRAC) MOD 5 IS THIS REMAINDER + MOVE IN,Z + ADD IN,EXTRAC ;SO GET REAL Z + IDIVI IN,5 + IMULI IN,5 ;AND ADJUST IT TO EQUAL THAT, MOD 5, + ADD IN,B ;WITHOUT CHANGING WHICH WORD IT POINTS AT. + SUB IN,Z ;BUT Z CAN'T CHANGE, SO THE CHANGE IN REAL Z + MOVEM IN,EXTRAC ;MUST ALL BE DUE TO CHANGE IN EXTRAC. + RET + +SUBTTL STRING SPACE GARBAGE COLLECTION + +GCNRL: SETOM GCNRLC ;GC TO RECLAIM MACRO FRAMES. DON'T MOVE IMPURE STRINGS. + CAIA ;(THEREFORE, CAN BE CALLED IN MID-COMMAND) +GC: +GCC: SETZM GCNRLC + CALL SAVACS +IFN ITS,[ + MOVE A,[-2,,[.SWHO1,,[.BYTE 2,3,3 ? 1 ? 6 ? 6] + .SWHO2,,[SIXBIT/QR GC/]]] + .SUSET A +] + CALL MEMTOP ;A -> 1ST UNUSED WORD ABOVE BFR & SORT TABLES. + HRLI A,4400 + MOVEM A,GCPTR ;GCPTR HAS B.P. TO IDPB INTO HIGH CORE. + PUSH P,A ;REMEMBER WHAT ITS STARTING VALUE WAS. + MOVE C,BFRPTR ;COPY BEG, ETC. INTO CURRENT BUFFER'S + CALL NEWBFR ;FRAME, SO THE LATTER IS UP TO DATE. + CLEARM STABP + MOVE T,[STABP,,STABP+1] + BLT T,SYMEND-1 ;CLEAR THE JUMP CACHE, SINCE IT WILL NOW BECOME INVALID. + MOVEI T,CSTR ;MARK CSTR + PUSHJ P,GCMA +GCC1: MOVEI T,MFSTRT+MFCSTR ;MARK ALL MACRO FRAMES' STRINGS. +GCC2: SKIPGE MFBEG-MFCSTR(T) ;DON'T MARK BUFFER FRAMES THIS WAY. + JRST GCC4 + ADDI T,MFARG1-MFCSTR + CALL GCM ;MARK MACRO ARG 1 (MAY BE A STRING POINTER) + ADDI T,MFARG2-MFARG1 + CALL GCM ;MARK MACRO ARG 2 + SUBI T,MFARG2-MFCSTR ;POINT TO CSTR AGAIN + SKIPE (T) + PUSHJ P,GCMA +GCC4: ADDI T,MFBLEN + CAMGE T,MFEND + JRST GCC2 +GCC3: HRRZ T,PF ;MARK THE QREG PDL. + CAIL T,PFL ;MARK BOTH VALUES AND ADDRS, SINCE "ADDR" MIGHT BE A NAME-STRING. +GCC5: CALL GCM + CAILE T,PFL + SOJA T,GCC5 + HRRZ T,LEV ;NOW MARK ALL SAVED VALUES +GCC7: SKIPN A,T ;OF ALL PAREN'S. + JRST GCC8 ;WE'VE REACHED THE OUTERMOST; WE'RE DONE. + SUBI T,2 ;GET ADDR OF LAST SAVED VALUE. + CALL GCM + SUBI T,1 ;GET ADDR OF 1ST (IF THERE ARE 2) + MOVE TT,2(T) ;GET THE WORD WHICH SAYS HOW MANY. + TRNE TT,FRARG2 ;IF THERE ARE 2, MARK THE 1ST. + CALL GCM + MOVE T,(A) ;NOW HANDLE NEXT PAREN OUT. + JRST GCC7 + +GCC8: MOVE T,[-NQREG,,QTAB] + CALL GCM + AOBJN T,.-1 + MOVE T,[-RRMACL,,RRMACT] + CALL GCM + AOBJN T,.-1 +IRPS XX,,DISOMD SBFRS BFRSTR MARG1 MARG2 SARG NUM SYL RRXINV RRENTM RRLEVM RRDISM REFRSH LASTER STEPFL HELPMAC ECHCHR CLKMAC TYISNK TYISRC RREBUF MODMAC TTYMAC RUBMAC RRECSD RRPARN + MOVEI T,XX + CALL GCM +TERMIN +IFN 20X,[ + MOVEI T,FRKJCL + CALL GCM +] + POP P,A + MOVE T,A ;STARTING GCPTR MINUS CURRENT + SUB T,GCPTR ;GIVES -<# WDS IDPB'D> + HRLM T,A ;AOBJN -> TABLE OF POINTERS. + ADDI A,1 + MOVEM A,GCPTR + JUMPGE A,GCE ;NO ENTRIES => NO IMPURE STRINGS TO GC. + SKIPE GCNRLC ;IF SHOULDN'T MOVE IMPURE STRINGS, SKIP THAT PART. + JRST GCE5 + CALL GCSORT ;ELSE SORT GCTAB INTO ORDER STRINGS APPEAR IN MEMORY. + CALL GCSWP ;COMPRESS STRING SPACE, USING GCPTR TABLE TO RELOCATE POINTERS. + MOVE IN,OUT + IMULI IN,5 ;COMPUTE WHERE IMPURE STRING SPACE NOW ENDS. + JRST GCE1 ;GO FLUSH EXCESS PAGES, MAYBE MOVING BUFFER SPACE DOWNWARD. + +;MARK THE TECO OBJECT POINTER IN THE WORD WHICH RH(T) POINTS AT. +;IF THE OBJECT IS A POINTER, WE PUSH AN ENTRY ONTO GCPTR. +GCM: MOVE IN,(T) + TLZE IN,400000 ;RETURN IF NOT A STRING POINTER OR IF POINTS AT THE ERROR MESSAGES. + CAIGE IN,EREND*5-INIQRB + RET ;NO NEED TO MARK BUILT-IN ERROR MESSAGES SINCE NOT SWEPT. + ADD IN,QRBUF +GCM3: CAML IN,QRBUF + CAML IN,QRWRT ;FINISH CHECKING THAT IT REALLY POINTS INTO IMPURE STRING SPACE. + RET + CALL GETCHR ;DOES IT POINT AT A 177 OR 176? + CAIN CH,QRBFR + JRST GCMB ;176 => THIS IS A BUFFER. + CAIE CH,QRSTR ;177 => THIS IS A STRING. + RET ;ANYTHING ELSE => THIS IS NEITHER. DON'T MARK IT. + +;PUSH A GCPTR ENTRY FOR POINTER LOCATION RH(T) AND STRING ADDRESS C(IN). +GCM2: IDPB IN,GCPTR + IDPB T,GCPTR + POPJ P, + +;FOUND A POINTER TO A BUFFER. +GCMB: MOVE BP,IN + CALL GCM2 ;MARK THE 4-CHAR STRING THAT WE GO INDIRECT THROUGH, + CALL GETBP ;GO INDIRECT THROUGH IT TO GET FRAME ADDRESS + CALL QLGET4 ;RETURNS -4 + JUMPL B,CPOPJ ;DEAD BUFFER HAS NO BUFFER FRAME. + MOVSI IN,MFMARK ;AND MARK THE BUFFER FRAME AS LIVING. + IOR IN,4(B) + EXCH IN,4(B) + TLNN IN,MFMARK ;IF THE FRAME WASN'T ALREADY MARKED, + TLNN IN,MFQVEC ;AND MUST BE MARKED THROUGH, DO SO. + RET + SAVE T + MOVE T,MFBEG+4(B) + TLZ T,MFBBTS + IDIVI T,5 ;FIRST, MARK BELOW THE GAP. + MOVE TT,MFGPT+4(B) + CALL GCMBR + MOVE T,MFGPT+4(B) + ADD T,MFEXTR+4(B) + IDIVI T,5 ;THEN MARK ABOVE GAP (GPT+EXTRAC TO Z+EXTRAC) + MOVE TT,MFZ+4(B) + ADD TT,MFEXTR+4(B) + CALL GCMBR +POPTJ: REST T + RET + +;MARK INDIRECT THROUGH A RANGE OF WORDS (IN A QVECTOR). +GCMBR: SAVE B ;T HAS WORD ADDR, TT CHAR ADDR. + IDIVI TT,5 ;MARK ALL TEH WORDS FROM T TO TT. + SUBM T,TT + HRL T,TT + SKIPGE T + CALL GCM + AOBJN T,.-1 + REST B + RET + +;HERE TO MARK A BYTE POINTER, SUCH AS CPTR. T POINTS AT THE CSTR WORD OF A +;COMCNT, CPTR, CSTR TRIPLE. IF THE POINTER POINTS INTO IMPURE STRING SPACE, +;WE PUSH A GCPTR ENTRY POINTING AT THE CPTR WORD BUT GIVING THE CHAR ADDR EQUIVALENT +;AS ITS STRING ADDRESS. +GCMA: SAVE GCPTR + CALL GCM ;MARK THE CSTR WORD, AS AN ORDINARY TECO OBJECT. + REST TT + CAMN TT,GCPTR ;IF IT DOESN'T NEED RELOCATION, NEITHER DOES CPTR. + RET + MOVE IN,1(TT) ;IF CSTR NEEDS IT, SO DOES CPTR; PUSH A MARKER FOR CPTR + IDPB IN,GCPTR ;GIVING THE SAME "CHAR ADDR TO RELOCATE ACCORDING TO" + MOVEI IN,CPTR-CSTR(T) + IDPB IN,GCPTR ;WHICH THE CSTR USED, BUT POINTING AT THE CPTR INSTEAD OF THE CSTR. + RET + +;SORT THE POINTER TABLE TO FACILITATE SWEEPING. +;THE POINTERS GO IN THE SAME ORDER AS THE STRINGS THEY POINT AT. +GCSORT: HRRZ A,GCPTR + HLRE B,GCPTR + SUBM A,B + MOVSI C,10 + +;RECURSIVE RADIX-EXCHANGE SORT. +;A POINTS TO FIRST ENTRY IN THIS SUB-SORT. +;B POINTS TO LAST ENTRY + 1 +;C HAS ONE BIT SET, THAT BIT MOST SIGNIFICANT BIT TO SORT ON FOR THIS SUB-SORT. +GCSWPS==2 ;2 WORDS PER TABLE ENTRY. + +GCSRT: HRLM B,(P) ;SAVE UPPER BOUND + CAIL A,-GCSWPS(B) + JRST GCSRT7 ;ONE OR ZERO ENTRIES + PUSH P,A ;SAVE LOWER BOUND +GCSRT3: TDNN C,(A) ;BIT SET IN LOWER ENTRY? + JRST GCSRT4 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN + SUBI B,GCSWPS ;YES, NOW BACK UP UPPER POINT + TDNE C,(B) ;BIT CLEAR IN UPPER ENTRY? + JRST GCSRT5 ;NO, CHECK FOR END, DECREMENT B, AND TRY AGAIN +REPEAT GCSWPS,[ ;BIT SET IN LOWER ENTRY AND CLEAR IN UPPER => EXCHANGE ENTRIES + MOVE D,.RPCNT(A) + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A) +] +GCSRT4: ADDI A,GCSWPS ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY +GCSRT5: CAME A,B ;ANY MORE ENTRIES LEFT? + JRST GCSRT3 ;YES, GO PROCESS THEM + ;A AND B NOW BOTH POINT TO FIRST ENTRY WITH BIT SET + ROT C,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT + POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT + JUMPL C,GCSRT6 ;JUMP IF NO MORE KEY TO SORT ON + PUSHJ P,GCSRT ;SORT BOTTOM PART OF TABLE + HLRZ B,(P) ;RESTORE UPPER BOUND (SORT CLOBBERED A TO MIDDLE) + PUSHJ P,GCSRT ;SORT TOP PART OF TABLE +GCSRT6: ROT C,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER C" +GCSRT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED + RET + +;SWEEP THE IMPURE STRING SPACE, DISCARDING GARBAGE BY MOVING THE GOOD STUFF DOWN. +GCSWP: MOVE IN,QRBUF + ADDI IN,EREND*5-INIQRB + IDIVI IN,5 ;IN GETS PLACE WE EXPECT NEXT OLD STRING (GARBAGE OR NOT) TO START. + MOVE OUT,IN ;OUT GETS PLACE TO PUT NEXT NON-GARBAGE STRING. + MOVE Q,GCPTR ;Q IS USED TO STEP THROUGH THE POINTER TABLE. + SETZ BP, ;THERE IS NO PENDING BLT, YET. +;WHEN BP IS NONZERO, IT IS THE AC FOR A PENDING BLT. WHEN WE SEE A NON-GARBAGE STRING, +;WE KNOW IT NEEDS TO BE BLT'ED (USUALLY), BUT WE DON'T DO THE BLT UNTIL WE COME +;TO SOME ACTUAL GARBAGE. THAT WAY WE BLT CONTIGUOUS NON-GARBAGE STRINGS TOGETHER. +;INSTEAD OF BLT'ING, WE SET UP BP AS THE BLT AC (OLD START,,NEW START) AS A REMINDER. + +;COME HERE TO EXAMINE THE NEXT POINTER AND SEE WHETHER WE HAVE FOUND A GAP OF GARBAGE. +GCSWPL: JUMPGE Q,GCBLT ;NO MORE POINTERS => FINISHED SWEEPING. DO ANY PENDING BLT. + MOVE A,(Q) ;WHERE DOES THE NEXT NON-GARBAGE STRING START? + IDIVI A,5 + JUMPE BP,GCSWP2 + CAMG A,IN ;STARTS IN THE EXPECTED PLACE => IT IS CONTIGUOUS WITH + JRST GCSWP1 ;PREVIOUS NON-GARBAGE, SO DON'T BLT NOW. + CALL GCBLT ;NOT CONTIGUOUS => BETTER BLT THE OLD STUFF. +;HERE FOR THE BEGINNING OF A CONTIGUOUS RUN OF NON-GARBAGE; SET BP NONZERO +GCSWP2: MOVE IN,A + HRRZ BP,OUT ;AND MAKE BP DESCRIBE HOW THIS STUFF WILL HAVE TO BE BLT'ED. + HRL BP,A +GCSWP1: SAVE BP ;NOW FIND OUT WHERE THIS STRING ENDS. + SETZ B, ;B GETS (EVENTUALLY) LENGTH OF STRING-OBJECT + MOVE BP,(Q) + CALL GETBP ;WHICH IS IT? A BUFFER OR A STRING? + LDB CH,BP + CAIN CH,QRBFR ;IF IT'S A BUFFER, THERE'S REALLY JUST A 4-CHAR HEADER HERE. + JRST GCSWP3 + CAIE CH,QRSTR ;IF IT'S A STRING, THERE'S THE HEADER PLUS DATA. + .VALUE + CALL QLGET4 ;HOW MUCH DATA? +GCSWP3: ADDI B,3 ;B GETS LENGTH OF HEADER + (DATA IF ANY) - 1. + MOVE BP,(Q) + ADDB BP,B ;BOTH B AND BP HAVE CHAR ADDR OF LAST CHAR. + CALL GETBP ;BP GETS BP TO LDB LAST CHAR. + MOVEI A,1(BP) ;A GETS ADDR OF WORD AFTER THE END OF THIS STRING. + REST BP + SUB A,IN ;NOW INCREASE IN TO EQUAL THAT, AND INCREASE OUT THE SAME AMOUNT. + ADD IN,A ;NEW VALUE OF IN IS WHERE THE NEXT STRING SHOULD START IF IT IS CONTIG. + ADD OUT,A ;ACTUALLY, IT CAN START IN THE PREVIOUS WORD IF IT IS REALLY CONTIG. + ;THE CAMG ABOVE WILL NOT SKIP IN EITHER CASE. +;NOW RELOCATE ALL THE POINTERS INTO THIS STRING. +;B IS CHAR ADDR REL QRBUF OF LAST CHAR OF STRING. +;ALL POINTERS LESS THAN OR EQUAL TO THAT POINT INTO THIS STRING. + MOVE C,OUT + SUB C,IN ;C GETS # OF WORDS (NEGATIVE ALWAYS) THIS STRING IS MOVING BY. + MOVE D,C + IMULI D,5 ;D GETS # OF CHARACTERS. +GCSWPR: CAMGE B,(Q) ;AFTER THE LAST POINTER INTO THIS STRING, + JRST GCSWPL ;GO EXAMINE THE NEXT AND MAYBE BLT THIS ONE, ETC. + MOVE A,1(Q) + SKIPL (A) ;ELSE RELOCATE. RELOCATE POSITIVE QTYS (B.P.S) BY WORDS, + ADDM C,(A) + SKIPGE (A) ;RELOCATE NEGATIVE ONES (TECO OBJECTS) BY CHARS. + ADDM D,(A) + AOBJN Q,.+1 + AOBJN Q,GCSWPR ;LOOK AT ALL PTRS. IF RUN OUT, DO ANY PENDING BLT AND WE'RE DONE. + +;DO THE PENDING BLT DESCRIBED BY BP. OUT, THE PLACE TO START THE NEXT GOOD STRING, +;TELLS US WHERE THE BLT SHOULD STOP. +GCBLT: JUMPE BP,CPOPJ + CAIN OUT,(BP) + .VALUE + MOVS C,BP + CAME C,BP ;DON'T DO THE BLT IF IT IS SHIFTING BY 0 WORDS. + BLT BP,-1(OUT) + SETZ BP, + RET + +GCE5: SKIPA IN,QRWRT +GCE: MOVE IN,QRBUF +GCE1: MOVE CH,IN ;GC AGAIN AFTER GCOFTN CHARS + ADDI CH,GCOFTN ;OF IMPURE STRING ARE CREATED. + SKIPL GCNRLC + MOVEM CH,QRGCMX + MOVE A,QRWRT ;REMEMBER OLD TOP OF IMPURE STRING SPACE FOR SAKE OF LOW BIT CLEARING. + CAMGE A,IN ;GC PRODUCED NEGATIVE FREE SPACE? + .VALUE + MOVEM IN,QRWRT ;CHAR ADDR ABOVE END OF STRING SPACE. + ADDI IN,SLPQAM*2 ;LEAVE 2*SLPQAM CHARS SPACE TO WRITE MORE STRINGS INTO, + MOVE CH,IN + ADDI CH,SLPQAM + CAML CH,BFRBOT ;AND IF BUFFER SPACE STARTS AT LEAST SLPQAM ABOVE THAT POINT, + MOVE IN,BFRBOT ;MOVE IT DOWN TO THAT POINT. ELSE DON'T MOVE IT. + IDIVI IN,5 +IFN ITS,[ + MOVE CH,QRWRT + ADDI CH,2000*5-1 ;COMPUTE 1ST PAGE IMPURE STRINGS DON'T NEED. + IDIVI CH,2000*5 + LDB Q,[121000,,IN] ;AND 1ST PAGE BUFFER NEEDS. + SUBM CH,Q ;-<# PAGES WE CAN FLUSH> + JUMPE Q,GCE2 + SKIPL Q + .VALUE + SAVE CH + HRLI CH,(Q) ;AOBJN -> PAGES TO FLUSH. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? CH] + .LOSE %LSSYS + REST CH + IMULI CH,2000*5 + CAML A,CH ;BETTER NOT CLEAR LOW BITS IN THE PAGES WE JUST FLUSHED. + MOVE A,CH +GCE2: +] + SAVE A + MOVEI A,MFSTRT ;LOOK AT ALL BUFFER FRAMES, +GCE3: MOVE T,MFBEG(A) ;AND RELEASE ALL THE DEAD ONES. + TLNN T,MFBFR + JRST GCE4 ;THIS IS A MACRO CALL, NOT A BUFFER. + TLZN T,MFMARK + JRST [ CALL KILBFR ;THIS ONE IS DEAD. + JRST GCE4] + MOVEM T,MFBEG(A) ;CLEAR THE MARK-BIT. +GCE4: ADDI A,MFBLEN + CAMGE A,MFEND + JRST GCE3 + REST A + IDIVI A,5 + CAML A,IN ;DON'T CLEAR LOW BITS IN CORE THAT BUFFERS WILL OCCUPY. + MOVE A,IN + MOVE T,QRWRT ;NOW, CLEAR LOW BITS BY CLEARING ALL OF THE EXISTING + ADDI T,4 ;CORE FROM THE TOP OF THE OCCUPIED PORTION OF + IDIVI T,5 ;IMPURE STRING SPACE UP TO BUFFER SPACE. + CAMG A,T + JRST GCE7 + MOVE C,[SIXBIT /LBCLR/] + MOVEM C,(T) ;STORE THIS RECOGNIZABLE CONSTANT TO CLEAR THE LOW BIT + HRL T,T ;(FOR SAKE OF DEBUGGING). + ADDI T,1 + CAIL A,1(T) + BLT T,-1(A) +GCE7: MOVE T,BFRBOT ;C(IN) IS THE PLACE BUFFER SPACE + IDIVI T,5 ;SHOULD START; MOVE IT DOWN IF NEC. + CAMG T,IN + JRST GCE6 + SUBM IN,T + HRLS IN + SUB IN,T + MOVSS IN + MOVE C,BFRTOP + IDIVI C,5 + ADDI C,(T) + BLT IN,(C) + CALL BFRMVW +GCE6: CALL FLSCOR +IFN ITS,.SUSET [.SWHO1,,[0]] + JRST RSTACS + +;PUSHJ HERE, AND IT RETURNS WITH ACS 0-16 SAVED. +IFN P-17,.ERR PDL POINTER NOT AC17 +.SEE CIRC ;THIS DEPENDS ON THE ORDER OF THE AC'S +SAVACS: ADD P,[16,,16] ;MAKE ROOM ON STACK FOR 1 THRU 16. + MOVEM 1,-15(P) ;SAVE 1 + MOVEI 1,-14(P) + HRLI 1,2 + BLT 1,(P) ;USE 1 TO SAVE THE REST + MOVE 1,-15(P) ;RESTORE 1. + SKIPL P + TYPRE [PDL] + SAVE -16(P) ;PUT RETURN PC ON TOP OF STACK, + MOVEM 0,-17(P) ;SAVE AC 0 IN ITS PLACE, + RET + +;JRST RSTACS TO UNDO A SAVACS, THEN POPJ OUT OF THE ROUTINE THAT CALLED THE SAVACS. +RSTACS: MOVSI 16,-16(P) ;GET START OF WHERE THEY ARE + HRRI 16,0 + BLT 16,16 ;RESTORE THE REST + SUB P,[17,,17] + RET + +RST321: REST C ;JSP A,RST321 TO POP ACS 3 2 AND 1 OFF THE STACK + REST B + EXCH A,(P) + RET + +SUBTTL BUFFER SELECTION, CREATION AND KILLING + +;A -> BUFFER FRAME; FREE THE FRAME AND THE SPACE IT POINTS TO. +;CLOBBERS C,E,T,TT. +KILBFR: MOVSI C,MFREADO + ANDCAM C,(A) ;MAKE READ-ONLY BUFFER WRITEABLE SO WE DON'T GET ERROR EMPTYING IT. + MOVEI C,(A) + SAVE BFRPTR + CALL NEWBFR ;SELECT THAT BUFFER FRAME AS CURRENT. + MOVE C,Z + MOVE E,BEG + CALL DELET1 ;DELETE ALL THE TEXT IN IT. + MOVEI C,5 ;FAKE GAPKIL INTO CLOSING UP THE 1-WORD INTER-BUFFER + ADDM C,EXTRAC ;GAP, AS WELL AS THE ACTUAL SPACE OCCUPIED BY THIS BFR. + MOVNI C,5 + ADDM C,Z + CALL GAPKIL ;FLUSH ALL SPACE IN BUFFER AREA USED BY THIS BUFFER. + SETZM MFBEG(A) ;FREE THE BUFFER FRAME BY CLEARING MFBFR BIT + SAVE A + SOJ A, + CALL FLSFRM ;AND PUTTING ON FREELIST (WHOSE POINTERS -> FRAME-1) + REST A + REST C ;NOW RESELECT THE BUFFER THAT WAS CURRENT AT CALL. + ;WITH OUT DESELECTING THE NOW-DEAD BUFFER + JRST NEWBF1 ;(THE IDEA IS TO AVOID SETTING ITS MFBFR BIT). + +;C -> BUFFER FRAME; SELECT IT AS CURRENT. SETS UP BEG, ETC. +;CLOBBERS C,T,TT. +NEWBFR: MOVE T,BFRPTR ;COPY BEG, ETC. BACK INTO THE FRAME + MOVE TT,T ;THEY CAME FROM. + HRLI T,BEG ;(THAT IS, THE ONE CEASING TO BE CURRENT) + HLL C,MFBEG(TT) ;DON'T CLOBBER THE MFBFR AND MFMARK BITS. + BLT T,MFEXTR(TT) + HLLZ T,C ;WE SAVE THE BITS IN LH(C) TO AVOID USING ANY STACK. + ANDI C,-1 ;A PDL OV IN HERE WOULD BE HORRIBLE. + AND T,[MFBBTS-MFMODIF-MFREADO,,] + SKIPE MODIFF + TLO T,MFMODIF ;STORE MODIFF OF DESELECTED BUFFER AS A BIT. + SKIPE READON + TLO T,MFREADO ;AND FS READ ONLY$ + IORM T,MFBEG(TT) +NEWBF1: MOVEM C,BFRPTR ;REMEMBER WHICH FRAME NOW CURRENT. + SKIPL T,(C) ;SELECTING A FRAME WHICH ISN'T A BUFFER? + .VALUE + LDB TT,[.BP (MFREADO),T] + MOVEM TT,READON ;RESTORE READONLY FLAG + AND T,[MFMODIF,,] + MOVEM T,MODIFF ;RESTORE THE MODIFF OF THE BUFFER BEING SELECTED. + MOVSS C + HRRI C,BEG + BLT C,EXTRAC ;SET UP VARS FOR IT. + MOVSI T,MFBBTS ;BUFFER FLAG BITS SHOULD BE IN MFBEG BUT NOT BEG. + ANDCAM T,BEG + RET + +;FSWORD$ RETURNS WORD OF BUFFER CONTAINING CHARACTER AFTER +;,FSWORD$ ALSO SETS THAT WORD TO . NOTE THAT NO WORD EVER +;CONTAINS PART OF 2 DIFFERENT BUFFERS, BECAUSE OF FSBCREATE$'S ALLOCATION POLICY. +FSWORD: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRARG2 + IORI FF,FRARG ;2 ARGS => WRITING; ELSE READING. + ADD C,BEG ;GET VIRT CHAR ADDRESS OF A CHAR IN DESIRED WORD. + CALL CHK ;"NIB" IF OUTSIDE BUFFER BOUNDS. + TRNN FF,FRARG ;WRITING IN FS WORD$ MODIFIES BUFFER CONTENTS. + JRST FSWRD1 + SKIPE READON ;ALLOWED TO MODIFY THIS BUFFER? + TYPRE [RDO] + SETOM MODIFF +FSWRD1: CAMLE C,GPT ;CONVERT VIRTUAL ADDRESS TO REAL ADDRESS. + ADD C,EXTRAC + IDIVI C,5 ;GET ADDRESS OF WORD CONTAINING CHAR AFTER SPEC'D CHAR ADDR. + MOVE E,C ;PUT ADDRESS OF FLAG-WORD IN E FOR FSNORM + MOVE C,SARG ;AND VALUE TO STORE (IF ANY) IN C, THE ARGUMENT TO FSNORM. + JRST FSNOR1 ;NOW READ AND MAYBE WRITE THE BUFFER WORD. + +BFRMVW: IMULI T,5 +BFRMOV: MOVE TT,BFRBOT + ADDM T,BFRBOT + ADDM T,BEG + ADDM T,BEGV + ADDM T,PT + ADDM T,GPT + ADDM T,ZV + ADDM T,Z + JRST BFRRLC + +;RELOCATE POINTERS INTO BUFFER SPACE WHEN PART OF IT MOVES. +;ALL POINTERS IN ALL BUFFER FRAMES ARE CHANGED IF THEY ARE +;LARGER THAN C(TT) WHICH IS PRESUMABLY THE CHAR ADDR AT WHICH +;SOMETHING GREW OR SHRANK. C(T) IS THE AMOUNT TO ADD TO EACH +;POINTER. DOES NOT RELOCATE BEG, BEGV, PT, GPT, ZV OR Z. +;BYTE POINTERS IN MACRO FRAMES, AND CPTR AND INSBP, ARE ALSO RELOCATED. +;CLOBBERS A,C. RELOCATES BFRTOP PROPERLY. +BFRRLC: SKIPL @BFRPTR ;CURRENT BUFFER HEADER ISN'T A BUFFER HEADER? + .VALUE + SAVE BP + MOVE A,BFRTOP ;TO SAVE TIME, IF WE CAN FIGURE OUT THAT THE CHANGE + SUBI A,5 ;TOOK PLACE IN THE UPPERMOST BUFFER, THEN WE KNOW NO + CAMLE TT,A ;BUFFER HAS TO BE RELOCATED. + JRST BFRRL3 ;SO WE DON'T HAVE TO TEST THEM ALL. + MOVEI A,MFSTRT ;SCAN ALL BUFFER FRAMES. +BFRRL1: SKIPL C,MFBEG(A) .SEE MFBFR + JRST BFRRL4 ;THIS FRAME ISN'T A BUFFER FRAME. + TLZ C,MFBBTS ;IT IS A BUFFER FRAME. + CAME A,BFRPTR + CAMGE C,TT ;IS IT HIGH ENOUGH IN MEMORY TO BE RELOCATED? + JRST BFRRL2 +INSIRP ADDM T(A),MFBEG MFBEGV MFPT MFGPT MFZV MFZ + ADD C,T + CAMGE C,BFRBOT ;BUFFER RELOCATED TO BELOW BUFFER SPACE? + .VALUE +BFRRL2: ADDI A,MFBLEN + CAMGE A,MFEND + JRST BFRRL1 +BFRRL3: MOVE BP,CPTR ;RELOCATE CPTR - MAYBE WE'RE EXECUTING OUT OF A BUFFER NOW. + CALL BFRRL5 + MOVEM BP,CPTR + SKIPE INSINP + SKIPE INSBP + CAIA + .VALUE ;IN INSERT, AND INSBP ISN'T SAVING IT?? + MOVE BP,INSBP + CALL BFRRL5 + MOVEM BP,INSBP + ADDM T,BFRTOP + SKIPL @BFRPTR + .VALUE +POPBPJ: REST BP + RET + +BFRRL4: MOVE BP,MFCPTR(A) ;MACRO FRAME FOUND: IF THE CPTR POINTS AT A BUFFER, + CALL BFRRL5 ;RELOCATE IT IF THAT BUFFER IS MOVING. + MOVEM BP,MFCPTR(A) + JRST BFRRL2 + +BFRRL5: SAVE TT ;BP HAS A B.P. EITHER RELOCATE IT, OR SKIP IF IT'S UNCHANGED. + CALL GETCA + REST TT + CAMGE BP,BFRTOP + CAMGE BP,TT + JRST POPJ1 ;IF WE SKIP, BP IS CLOBBERED, BUT CALLER SHOULD ASSUME UNCHANGED. + ADD BP,T ;RELOCATE THE POINTER IF NEC. + SAVE TT + CALL GETBP + REST TT + RET + +BFRSE2: MOVEM B,PF ;SPECIAL ENTRY FROM FSQPUN + ;STORE BACK QREG PDL PTR; OTHERWISE ERROR QNB WOULD + ;CAUSE A LOOP DUE TO AUTOMATIC UNWIND. +;SELECT THE BUFFER IN THE Q-REG CH POINTS AT (PRESUMABLY ..O), PROVIDED IT IS LEGITIMATE. +;OTHERWISE, CLOBBER THE QREG BACK TO THE CURRENTLY SELECTED BUFFER. +BFRSE1: SAVE C + MOVE C,BFRSTR + EXCH C,(CH) + CALL BFRSET ;WHILE WE SELECT IT, KEEP THE OLD, GOOD BUFFER IN ..O. + MOVEM C,(CH) ;THEN PUT NEW ONE BACK IN ..O WHEN ERROR CAN'T HAPPEN. + JRST POPCJ + +;ASSUME C HAS A STRING PTR TO A BUFFER'S POINTER STRING; +;MAKE THAT BUFFER CURRENT. CLOBBERS BP,T,TT. +BFRSET: SAVE C + SAVE CH + SAVE B + SAVE C + CALL QBGET + SKIPN C,B + TYPRE [QNB] ;SELECTING A KILLED BUFFER? + REST BFRSTR + REST B + CALL NEWBFR + REST CH + JRST POPCJ + +;C HAS STRING PTR TO PTR STRING OF BUFFER. +;RETURN IN B THE ADDR OF THE FRAME. +;RETURN IN CH A BP TO 1ST CHAR OF POINTER STRING. +;CLOBBERS BP,T,TT. +QBGET: MOVE BP,C +QBGET2: ADD BP,QRBUF + TLZE BP,400000 + CAML BP,QRWRT + TYPRE [QNB] + CALL GETBP + LDB CH,BP + CAIE CH,QRBFR + TYPRE [QNB] + MOVE CH,BP + CALL QLGET4 ;FORM NEXT 3 CHARS INTO NUMBER IN B + ADDI B,4 ;QLGET4 SUBTRACTS 4; WE MUST COMPENSATE. + RET + +;HERE TO DECODE A BUFFER POINTER IN BP, AND ALSO MAKE SURE, IN CASE IT IS THE +;SELECTED BUFFER, THAT THE WORDS IN THE BUFFER BLOCK ARE UP TO DATE. +QBGET1: CAME BP,BFRSTR + JRST QBGET2 + SAVE C + MOVE C,BFRPTR + CALL NEWBFR + REST C + JRST QBGET2 + +;FS BCREATE$ -- CREATE A NEW BUFFER, AND MAKE IT CURRENT. +FSCRBF: CALL FSCRB1 + MOVEI CH,$QBUFR ;ADDR OF QREG TO STORE IN. + CALL QCLOSQ + MOVEM OUT,BFRSTR ;SET INTERNAL Q..O AS WELL. + MOVE C,A + JRST NEWBFR ;SET PREDIGESTED Q..O (BFRPTR) AS WELL. + +;FS BCONS$ -- RETURNS A NEWLY CREATED BUFFER. +FSBCON: CALL FSCRB1 +FSBCO1: MOVEI CH,A + CALL QCLOSQ + JRST POPJ1 + +;FS QVECTOR$ -- RETURNS A QREG VECTOR BUFFER. +FSQVEC: CALL FSCRB1 + MOVSI T,MFQVEC + IORM T,(A) ;NOTE A -> BUFFER FRAME. + JRST FSBCO1 + +FSCRB1: TRZN FF,FRARG + SETZ C, ;C HAS # OF CHARS OF SPACE TO MAKE IN THE BUFFER. + SAVE C ;(SPACE IS NOT INITIALIZED). + MOVEI C,4 + CALL SLPQGT ;GET SPACE FOR POINTER-STRING. + ;NOW THE BUFFERS WON'T MOVE, SO WE CAN SET + ;UP THE POINTERS IN THE FRAME. + CALL GETFRM ;OBTAIN FRAME FOR BUFFER; ADDR IN A. + MOVEI A,1(A) ;GETFRM ACTUALLY GIVES ADDR OF FRAME MINUS 1. + SETZM MFEXTR(A) + MOVE C,BFRTOP ;PUT THIS NEW BUFFER AT TOP OF MEM. +INSIRP MOVEM C(A),MFBEGV MFPT MFGPT MFZV MFZ + TLO C,MFBFR ;MARK THIS FRAME AS A BUFFER FRAME + MOVEM C,MFBEG(A) + TLZ C,MFBFR + IDIVI C,5 ;FIND WHICH WORD WE START IN + HRLZ TT,C ;MAKE A BLT POINTER TO ZERO STARTING FROM THERE. + HRRI TT,1(C) + REST C ;HOW MUCH SPACE DO WE WANT? + ADDM C,MFZV(A) ;INCLUDE IT IN THE BUFFER BY SETTING Z AND ZV. + ADDB C,MFZ(A) + IDIVI C,5 ;WHICH WORD DO WE END IN? + SETZM -1(TT) ;ZERO ALL THE SPACE, INCLUDING THAT WORD. + CAIE C,-1(TT) + BLT TT,(C) + IMULI C,5 ;FIND THE NEXT WORD BOUNDARY, FOR NEW TOP OF BUFFER SPACE. + ADDI C,5 + MOVEM C,BFRTOP ;EACH BUFFER GETS A WORD OF SPACE SO THEY'RE SEPARATED. + MOVEI B,QRBFR ;NOW CREATE THE POINTER STRING IN SPACE ALREADY RESERVED. + MOVE C,A ;IT SHOULD CONTAIN THE ADDR OF THE BUFFER FRAME. + CALL QHDRW1 + MOVEI OUT,4 + ADD OUT,QRWRT + RET + +;FS BKILL$ -- TAKES ARG = STRING POINTER TO PTR STRING OF BUFFER, +;AND KILLS THAT BUFFER. THAT IS, THE BUFFER FRAME AND TEXT ARE FREED, +;AND THE PTR STRING IS CHANGED TO BE A DEAD BUFFER. IF NO ARG, +;[ ;DO " Q..O(]..O[A)UA QA-Q..O"NFSBKILL$' ]A ". +FSKILB: TRZE FF,FRARG ;IF THERE'S AN ARG, USE IT. + JRST FSKIL1 + SAVE $QBUFR ;OTHERWISE, POP QREG PDL INTO Q..O, + MOVEI CH,$QBUFR + CALL CLOSB2 + REST C ;AND IF POPPED VALUE DIFFERS FROM PREV. CONTENTS, + CAMN C,$QBUFR ;KILL THE PREVIOUS CONTENTS. + RET +FSKIL1: SKIPN KILMOD + RET ;ALLOW THIS TO BE DISABLED FOR DEBUGGING. + CALL QBGET ;GET ADDR OF FRAME IN B. + CAMN B,BFRPTR + TYPRE [KCB] ;KILL A BUFFER WHILE IT'S SELECTED? + SKIPN A,B + RET ;KILLING A DEAD BUFFER. + SETZ Q, + IDPB Q,CH ;STORE 0'S IN BUFFER-FRAME-ADDR IN PTR STRING. + IDPB Q,CH + IDPB Q,CH + JRST KILBFR ;FREE FRAME AND TEXT. + +;F[B BIND$ -- PUSH THE CURRENT BUFFER. F]B BIND$ -- POP IT. +FSBBIN: TRNN FF,FRARG + JRST FSBBI3 ;NO ARG => MUST BE PUSHING. + JUMPGE C,FSBBI3 ;ARG IS POSITIVE => MUST BE SIZE OF BUFFER TO MAKE, SO WE'RE PUSHING. + SAVE BFRSTR ;ARG => POPPING. REMEMBER THE INNER BINDING BEING FLUSHED. + MOVEM C,$QBUFR + CALL BFRSET ;SELECT THE OLD BINDING (IN C) + REST C ;KILL THE INNER BINDING AFTER THAT SUCCEEDS. + JRST FSKIL1 + +FSBBI3: TRO FF,FRARG + CALL FSBCONS ;PUSHING THE SEARCH TABLE: MAKE A NEW ONE, + JFCL + SAVE BFRSTR ;SAVE THE OLD ONE TO RETURN, AND SELECT NEW ONE. + MOVE C,A + CALL BFRSET + MOVEM A,$QBUFR +POPAJ1: REST A ;THEN RETURN THE OLD ONE (TO GO ON QREG PDL). + JRST POPJ1 + +;EMACS BUFFER SWITCH LOCAL VARIABLE SWAPPING + +;,F^G - DO A LOCAL VARIABLE SWAP FOR THE EMACS BUFFER TABLE. +; IS THE BUFFER WHICH IS THE EMACS BUFFER TABLE. +; IS THE WORD OFFSET (VIRTUAL) OF AN ENTRY IN IT. +; IS THE POSITION WITHIN THAT ENTRY OF THE FIRST LOCAL VARIABLE. +;LOCAL VARIABLES FILL ALL THE REST OF THE ENTRY FROM THERE +; (THE TOTAL LENGTH OF THE ENTRY IS ITS FIRST WORD). +;EACH LOCAL VARIABLE TAKES TWO WORDS: +; THE FIRST IS THE NAME AS A STRING POINTER, OR THE :FSQPHOME$ OF A ^R COMMAND SLOT OR Q-REG, +; AND THE SECOND IS THE SWAPPED-OUT VALUE. + +;@F^G ONLY STORES THE CURRENT VALUES INTO THE BUFFER TABLE. +;:F^G ONLY GETS NEW VALUES OUT OF THE BUFFER TABLE. + +;NOTE: WE ASSUME THAT THE GAP IN THE BUFFER TABLE IS NOT IN THE MIDDLE OF THIS ENTRY! +;IT IS OK IF IT IS DIRECTLY IN FRONT OR BEHIND THE ENTRY. + +FCTLG: EXCH C,E ;HAHA I THOUGHT , PUT IN C AND IN E, SO MAKE IT THAT WAY. + CALL QREGX ;READ QREG CONTAINING THE BUFFER TABLE. + MOVE BP,A + CALL QBGET1 ;B GETS PTR TO BUFFER TABLE'S BUFFER FRAME. + IMULI C,5 ;C HAS CHARACTER POINTER TO START OF EMACS BUFFER'S ENTRY. + ADD C,MFBEGV(B) + CAML C,MFGPT(B) + ADD C,MFEXTR(B) + IDIVI C,5 ;C NOW HAS WORD ADDRESS OF START OF ENTRY. + MOVE D,(C) ;D HAS LENGTH OF ENTRY. + ADD C,E ;C NOW GETS POINTER TO FIRST LOCAL VARIABLE ENTRY. + SUB D,E ;D HAS # OF WORDS LEFT (TWICE NUMBER OF LOCAL VARS). + JUMPLE D,CPOPJ + +;HACK THE NEXT LOCAL VAR. C POINTS TO THE WORD IN THE BUFFER TABLE HOLDING ITS NAME. +;D HAS THE NUMBER OF WORDS OF LOCAL VARS LEFT TO HACK IN THIS BUFFER. +FCTLG1: MOVE A,(C) + CALL FCTLG2 ;LOAD NAME OF NEXT LOCAL VAR INTO GCTAB. + JRST FCTLG4 ;IT ISN'T A STRING => IT IS ADDRESS IN RRMACT. + MOVE IN,QRB.. ;GET STRING POINTER TO SYMBOL TABLE. + MOVE A,.QSYMT(IN) + SAVE C + SAVE D + SAVE FF + TRZ FF,FRCLN\FRUPRW\FRARG\FRARG2 + TRO FF,FRUPRW ;INSIST ON EXACT MATCH IN LOCAL VARIABLE NAME. + CALL FOCMD3 ;LOOK UP THAT VARIABLE IN THE SYMBOL TABLE. IN GETS S.T.E. ADDRESS. + TYPRE [UVN] + REST FF + MOVEI CH,1(IN) ;CH GETS ADDR OF VALUE WORD IN S.T.E. + MOVE IN,-1(P) ;IN GETS ADDR OF LOCAL VARIABLE ENTRY./ + MOVE D,(CH) ;BEGIN THE EXCHANGE, + MOVE C,1(IN) + TRNN FF,FRCLN ;COLON MEANS DON'T STORE IN THE BUFFER TABLE. + MOVEM D,1(IN) + TRNN FF,FRUPRW ;ATSIGN MEANS DON'T SET THE VARIABLE. + CALL [ SKIPE VARMAC ;IF SETTING THE VAR CAN CALL A MACRO, + JRST USE3 ;USE USE3 TO DO IT SO THAT THE MACRO GETS CALLED. + MOVEM C,(CH) ;OTHERWISE JUST STORE. + RET] + REST D + REST C + JRST FCTLG6 + +FCTLG5: MOVE CH,1(IN) ;FETCH BOTH VALUES, TO EXCHANGE THEM. + MOVE Q,1(C) + TRNN FF,FRCLN ;IF NO COLON, STORE IN THE BUFFER TABLE. + MOVEM CH,1(C) + TRNN FF,FRUPRW ;IF NO ATSIGN, SET THE Q-REG. + MOVEM Q,1(IN) +FCTLG6: ADDI C,2 ;MOVE PAST THIS LOCAL VAR AND DECREMENT COUNT OF REMAINING ONES. + SUBI D,2 + JUMPG D,FCTLG1 + RET ;AFTER HACKING ALL LOCAL VARS, WE ARE DONE. + +;GIVEN A STRING POINTER IN A, LOAD THE STRING INTO STAB WITH J POINTING AT THE END. +;SKIPS UNLESS THE OBJECT IN A REALLY IS A STRING. +;CLOBBERS B,BP,CH,TT,TT1. +FCTLG2: CALL QLGET0 ;GET BP TO VAR NAME STRING IN BP AND LENGTH IN B. + RET + MOVEI J,STAB-1 + JUMPE B,POPJ1 +FCTLG3: ILDB CH,BP ;FETCH NEXT CHAR OF VARIABLE NAME STRING + CAIL CH,"A+40 ;CONVERT LETTERS TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;AND STORE IN STAB FOR OUR LOOKUP. + SOJG B,FCTLG3 + JRST POPJ1 + +FCTLG4: MOVE IN,A ;HERE IF A LOCAL'S "NAME" ISN'T A STRING. + CAIGE IN,RRMACT+1000 ;IT SHOULD POINT INTO RRMACT OR AT A Q-REG. + CAIGE IN,RRMACT + CAIGE IN,QTAB+NQREG + CAIGE IN,QTAB + CAIA ;SKIP IF NOT THE ADDRESS OF A LEGITIMATE LOCAL Q-REGISTER. + SOJA IN,FCTLG5 ;GO SWAP THE CONTENTS OF THAT WORD. + CAIL IN,FLAGSL*2 ;IF IT ISN'T A LOCAL Q-REG, MAYBE IT'S AN FS FLAG. + TYPRE [ILN] ;THEY ARE REPRESENTED BY INDICES INTO THE TABLE FLAGS. + SAVE C + SAVE D + MOVE B,IN ;GET ADDRESS OF FLAG ROUTINE, FOR FSFND. + MOVE C,1(C) ;GET VALUE TO SWAP IN AS ARG TO FLAG ROUTINE. + SAVE FF + TRZ FF,FRCLN+FRARG+FRARG2 + TRZN FF,FRUPRW ;IF NO ATSIGN, SET THE FLAG. + TRO FF,FRARG + CALL FSFND ;IN ANY CASE, CALL FLAG ROUTINE SO WE GET THE OLD VALUE + TYPRE [WNA] ;DIDN'T RETURN A VALUE + REST FF + REST D + REST C + TRNN FF,FRCLN ;WHICH, IF NO COLON, WE STORE IN THE BUFFER TABLE. + MOVEM A,1(C) + JRST FCTLG6 + +SUBTTL SEARCH COMMANDS + +;GET ARGUMENTS TO SEARCH +GSARG: TRZ FF,FRBACK ;CLEAR SOME FLAGS + ARGDFL Z, ;GET ARGUMENT OR OPERATOR CONVERTED TO VALUE + MOVMM C,SEARG ;STORE # OCCURRENCES TO LOOK FOR. + JUMPL C,GSARGN ;J IF SEARCHING BACKWARDS. + MOVE E,PT ;ELSE RANGE TO SEARCH IS PT TO ZV. + MOVE C,ZV +GSARG2: MOVEI B,SLP1I ;GET-CHAR RTN FOR MOVING FWD. +GSARG1: HRRM B,SLP1P ;STORE GET CHAR RTN ADDR. +GSAPCH: MOVE BP,E ;CHAR ADDR BOTTOM OF RANGE. + CAML E,GPT ;IF CHAR ADDRESSED IS ABOVY RANGE, PT TO IT. + ADD BP,EXTRAC + CALL GETBP + MOVEM BP,BBP ;SAVE BP'S TO BOTTOM OF RANGE. + MOVEM BP,BBP1 + MOVE BP,C ;MAKE PTR TO TOP OF RANGE: + CAMG C,GPT ;IF IT IS BEYOND GAP, + CAML E,GPT ;OR BOTTOM IS AT GAP, + ADD BP,EXTRAC ;RELOCATE TO PT ABOVE GAP, + CALL GETBP + MOVEM BP,ZBP + MOVEM BP,ZBP1 + CAMGE E,GPT ;IS THE GAP WITHIN RANGE OF SEARCH? + CAMG C,GPT + JRST GSARG7 + TRNN FF,FRBACK + JRST GSARG4 + MOVE BP,GPT ;IN BACKWARD SEARCH, MUST STOP AT GAP + ADD BP,EXTRAC ;TO MOVE OVER IT. + CALL GETBP + MOVEM BP,BBP1 +GSARG4: MOVE BP,GPT ;FOR MOVING FWD OVER GAP, + CALL GETBP + MOVEM BP,ZBP1 ;NEED BP TO START OF GAP. +GSARG7: SUB E,BEG + SUB C,BEG + MOVEM E,SRCBEG ;REMEMBER RANGE SEARCHED, FOR ^B COMMAND. + MOVEM C,SRCEND + POPJ P, + +GSARGN: MOVE E,BEGV ;BACKWARDS, RANGE IS BEGV TO PT. + MOVE C,PT +GSARG6: TRO FF,FRBACK + MOVEI B,SLP1D ;RTN TO GET CHARS BACKWARDS. + SETZM PNCHFG ;NEVER READ FROM FILE IF BACKWARD SEARCH FAILS. + JRST GSARG1 + +GSARGB: TRZ FF,FRBACK ;BOUNDED SEARCH. + MOVEI J,1 ;GO ONLY ONCE. + MOVEM J,SEARG + TRNE FF,FRARG2 + CAMG E,C ;IF FB HAS 2 ARGS, IN REVERSE ORDER, + JRST GSARG5 + EXCH C,E ;THEN DO BACKWARDS BOUNDED SEARCH. + CALL GETARG + CALL CHK1 + JRST GSARG6 + +GSARG5: CALL GETARG ;GET RANGE IN C,E. + CALL CHK1 + JRST GSARG2 + + ;SEARCH COMMANDS + +SERCHA: HRRZM P,PNCHFG ;_ COMMAND. PNCHFG POSITIVE. + CAIA +SERCHP: SETOM PNCHFG ;N COMMAND. PNCHFG NEGATIVE. + CAIA +SERCH: SETZM PNCHFG ;S COMMAND. PNCHFG ZERO. + CALL GSARG ;HANDLE ARG, SET UP DISPATCHES. + JRST SERCH1 + +;FB -- BOUNDED SEARCH. ARGS LIKE K,T. (:FB IS LIKE :S, NOT :K). +FBCMD: SAVE FF ;SAVE FRCLN. + ANDCMI FF,FRCLN\FRUPRW + CALL GSARGB ;GET RANGE OF BUFFER, SET UP DISPATCHES. + SETZM PNCHFG + REST A + ANDI A,FRCLN\FRUPRW ;RESTORE: FLAG SO IT WILL SAY WHETHER TO RETURN A VALUE. + IORI FF,(A) +SERCH1: MOVEI CH,ALTMOD ;NOW TO CHOOSE A TEXT TERMINATOR, DEFAULT IS ALTMODE + TRNE FF,FRUPRW ;UPARROW TYPED? + CALL RCH ;YES, GET NEXT CHARACTER INSTEAD + HRRM CH,INSDLM ;STORE AS DELIMITER + MOVE E,SBFRP ;ADDRESS OF SEARCH BUFFER HEADER BLOCK. + MOVE TT,MFZ(E) + MOVE E,MFBEGV(E) ;CHAR ADDRS OF BEGINNING AND END OF SEARCH BUFFER. + IDIVI E,5 + AOS E + MOVEM E,STBLP ;WORD ADDRESS OF SEARCH BUFFER BODY, + 1 (START OF DATA) + HRLM E,STBLPX + IDIVI TT,5 + SUBM E,TT ;- + HRLI E,-1(TT) ;AOBJN -> SEARCH BUFFER + SETO D, ;SAY THERE ISN'T A CHAR TO BE REREAD. + TRZE FF,FRUPRW + JRST SERCH2 + CALL RCH ;IF NOT AN ^-TYPE ARG, CHECK FOR NULL ARG + SKIPE SQUOTP + JRST SERCH3 ;DON'T BE CONFUSED BY SUPERQUOTED ALTMODES. + CAIN CH,ALTMOD ;WHICH MEANS REPEAT PREVIOUS SEARCH. + JRST SRLC +SERCH3: MOVE D,CH ;ELSE CAUSE THE CHAR TO BE REREAD. + TLZ D,4^5 ;DON'T LET IT BE NEGATIVE. + JRST SERCH2 + +;REPEAT THE PREVIOUS SEARCH. THE SEARCH BUFFER CONTAINS POINTERS INTO ITSELF. +;ALL THOSE POINTERS MUST BE RELOCATED IF THE SEAECH BUFFER HAS MOVED SINCE THE LAST +;TIME IT WAS USED. E -> BUFFER BODY BOTTOM. CLOBBERS E,D,TT. +SRLC: SKIPN -1(E) ;DOES BUFFER SAY IT IS VALID? + TYPRE [SNR] + HRRZ TT,(E) ;RH OF 1ST WORD OF TABLE SHOULD POINT TO 2ND. + SUBI TT,1(E) ;SUBTRACT REAL ADDR OF 2ND, GIVES AMOUNT BUFFER HAS MOVED. + MOVNS TT + HRLZ TT1,TT ;WE MAY WANT TO RELOCATE LH'S AS WELL AS RH'S. + JUMPE TT,SRN3 ;DON'T BOTHER RELOCATING IF RLOC. AMOUNT IS 0. +SRLC1: ADDM TT1,(E) ;LH OF EACH SUBSTRING HEADER IS A POINTER. + HRRZ D,(E) + CAIN D,SLP1P ;REACHED END OF TABLE? + JRST SRN3 + ADDM TT,(E) ;NO; RH IS ALSO A POINTER. + HLRZ E,(E) ;FIND NEXT SUBSTRING. + JRST SRLC1 + +;NOW COMPILE SEARCH TABLE +SERCH2: SETZM -1(E) ;WHILE WE SET UP STBL IT IS INVALID. +SCPL: HRRZ C,E ;SAVE LOCATION OF BEGINNING OF BLOCK (LOOP POINT FOR CONTROL O) + MOVEI CH,1(E) ;GET RIGHT HALF OF UPCOMING HEADER + PUSHJ P,SDEP ;DEPOSIT IN TABLE +SCPL1: TDZA A,A ;CLEAR INDEX AND FALL INTO LOOP +SCNOT: TRC A,1 ;CONTROL N, COMPLEMENT 1 BIT INDEX + SKIPGE CH,D ;IF THERE'S A CHAR TO REREAD, USE IT. + CALL RCH ;ELSE GET NEXT CHARACTER. + SETO D, ;FLUSH THE SAVED CHAR IF ANY. + SKIPGE SQUOTP + JRST SCNSP ;SUPERQUOTED CHAR. + SKIPE SQUOTP + JRST SCNDL ;DELIM-PROTECTED CHAR. + CAMN CH,INSDLM ;IF TEXT TERMINATOR (RH MODIFIED), + JRST SCPX ;THEN DONE COMPILING, GO DO IT +SCNDL: CAILE CH,^X + JRST SCNSP + CAIN CH,^X ;IF CONTROL X (FOR "ANY CHARACTER"), + ADDI A,XSER ;THEN SET INDEX + CAIN CH,^B ;IF CONTROL B (FOR BREAK CHARACTER) + ADDI A,BSER ;THEN SET INDEX + CAIN CH,^N ;IF CONTROL N (FOR "NOT") + JRST SCNOT ;THEN CLOBBER INDEX AND GET NEXT CHARACTER + CAIN CH,^O ;IF CONTROL O ("OR"), + JRST SCPOR ;THEN GENERATE NEW HEADER + CAIN CH,^Q ;IF CONTROL Q (QUOTES THE NEXT CHARACTER), + CALL RCH ;THEN REALLY USE NEXT CHARACTER, SKIPPING ABOVE TESTS +SCNSP: SKIPE BOTHCA ;BOTHCASE=0 => CASES ARE DISTINCT. + TRNN CH,100 ;BOTHCASE=1 => CASE IGNORED FOR LETTERS ONLY. + JRST SCNSP1 ;BOTHCASE=-1 => CASE IGNORED FOR ALL CHARS > 100 . + ANDI CH,-1 ;SUPERQUOTED CHARS STIL GET CONVERTED. + CAIL CH,"A+40 ;IF IGNORING CASE FOR A CHARACTER, CONVERT IT TO + CAILE CH,"Z+40 ;UPPER CASE HERE, ND ALSO WHIE SEARCHING THE BUFFER. + SKIPG BOTHCA + ANDCMI CH,40 +SCNSP1: TRNE A,-2 ;IF INDEX CLOBBERED, + SKIPA CH,(A) ;THEN GET TABLE ENTRY + HLL CH,CHSER(A) ;INDEX NOT CLOBBERED OUT OF EXISTENCE, TURN INTO CAIE OR CAIN + PUSHJ P,SDEP ;DEPOSIT TABLE ENTRY + JRST SCPL1 ;LOOP + +SDEP: MOVEM CH,(E) ;ADD AN ENTRY TO THE SEARCH TABLE + AOBJN E,CPOPJ ;RETURN IF TABLE NOT FULL + TYPRE [STL] + +SCPX: TDZA B,B ;TEXT TERMINATOR ENCOUNTERED +SCPOR: MOVEI B,SCPL ;CONTROL O + MOVE CH,[JRST WIN] ;SET FINAL TABLE ENTRY (EXECUTED => THIS STRING FOUND) + CAIN C,-1(E) + HRRI CH,WINNL1 ;BUT FOR NULL STRINGS, USE WINNL1 INSTEAD WIN. + PUSHJ P,SDEP ;DEPOSIT + HRLM E,(C) ;STORE POINTER TO THIS HEADER IN LH(LAST HEADER) + JUMPN B,(B) ;JUMP IF NOT TEXT TERMINATOR + MOVS A,STBLPX ;GET LIST CIRCULIZER/POINTER TO ROUTINE TO READ NEXT CHAR. + MOVSM A,(E) ;STORE IN TABLE (THIS LAST ENTRY, DON'T INCREMENT E OR CHECK FOR OVERFLOW) + SETOM -1(A) ;SEARCH TABLE NOW COMPILED. + MOVEI E,1(E) + IMULI E,5 + MOVE A,SBFRP + MOVEM E,MFZV(A) ;ZV OF SEARCH BUFER POINTS TO END OF REGION BEING USED. + JRST SRN3 + + ;TABLES FOR COMPILING SEARCH TABLE + +XSER: JFCL ;CONTROL X + CAIA ;NOT CONTROL X + +BSER: PUSHJ P,SKNBRK ;CONTROL B + PUSHJ P,SKBRK ;NOT CONTROL B + +CHSER: CAIN A, ;NORMAL CHARACTERS (HLL'ED WITH CHAR. IN RIGHT HALF) + CAIE A, ;NOT CHAR. + +;SEARCH TABLE FORMAT + +;FOLLOWING IS COMPILATION OF "SFOO SP)" + ;EVERY WORD ASSEMBLED WITH ",," IS A SUBSTRING HEADER. + +;STBLP POINTS HERE: +;TEM: .+5,,.+1 ;HEADER, LH POINTS TO NEXT COMPARISON STRING + ;RH POINTS TO TABLE THIS COMPARISON STRING +; CAIN A,"F ;IF THE TEST IS TO SUCCEED THEN THE INSTRUCTION SHOULD NOT SKIP +; CAIE A,"O ;THE CHARACTERS ARE IN A +; CAIN A,"O +; JRST WIN ;DOES JRST WIN IF ENTIRE STRING HAS BEEN FOUND +; .+10,,.+1 ;THIS LAST COMPARISON STRING BUT LH STILL POINTS SOMEWHERE +; CAIN A,40 +; CAIE A,"S +; CAIN A,"P +; PUSHJ P,SKBRK ;SKBRK => , SKNBRK =>  +; JFCL +; CAIN A,") +; JRST WIN +; .+2,,.+1 +; JRST WINNL1 +; TEM,,SLP1P ;FINAL HEADER, LH POINTS TO FIRST HEADER MAKING LIST CIRCULAR + ;RH POINTS TO A JRA B, + +;MAIN SEARCH LOOP + +SLP2LC: OFFSET 17-9-. +SLP2==. + LDB A,C ;GET CHARACTER + XCT (B) ;COMPARE WITH FIRST CHARACTER THIS COMPARISON STRING + ;SKIP => THIS CHARACTER LOSES, TRY NEXT COMPARISON STRING + ;NO SKIP => THIS CHARACTER WINS, TRY NEXT ONE + ;WIN ON STRING => JRST WIN + ;THIS CHARACTER TOTALLY LOSES ON ALL COMPARISON STRINGS => EXECUTE SLP1P + ;^ => B := FIRST HEADER IN SEARCH TABLE + SKIPA E,C ;WIN THIS CHARACTER, GET POINTER FOR CHECKING FUTURE CHARACTERS + JRA B,.-2 ;LOSE THIS COMPARISON STRING, TRY NEXT +SLP3==. + ILDB A,E ;GET NEXT CHARACTER + XCT 1(B) ;EXECUTE NEXT TABLE ENTRY + CAMN E,ZBP ;IT CLAIMS TO HAVE WON; WAS IT AT END OF BUFFER? +SLP4:: JRA B,SLP2 ;LOSE, TRY NEXT COMPARISON STRING + AOJA B,SLP3 ;WIN THIS CHARACTER, TRY NEXT + +IFN .-17,.ERR SLP2 WRONG TABLE LENGTH + + OFFSET 0 + +;FALLS THROUGH. +;ASSUMING THE SEARCH TABLE IS SET UP, DO THE SEARCHING. +SRN3: TRZ FF,FRARG+FRARG2 + SETOB A,SFINDF ;A NULL SEARCH OR SEARCHING 0 TIMES SHOULD STATE THAT IT WON. + SKIPE SEARG ;IF ARGUMENT ZERO, (ENTRY FOR "AGAIN" COMMAND) + JRST SRN2 + TRNE FF,FRCLN ;THEN WIN, DON'T BOTHER ACTUALLY SEARCHING. + JRST POPJ1 ;RETURN -1 AS VALUE IF ONE IS WANTED. + RET + +SRN2: CALL SKNBCP ;SET UP SKNBPT FROM Q..D, FOR SKNBRK'S SAKE. + SETZM TEM2 ;NO WINNING SEARCHES FOR SRCV TO DOCUMENT + MOVE C,BBP ;GET PLACE TO START; NORMALLY LOW END + TRNE FF,FRBACK + MOVE C,ZBP ;BUT HIGH END IF REVERSE. +;FOR SEARCH WITH REPEAT COUNT, REPETITIONS COME BACK HERE. +SRN2RP: MOVE E,C ;INIT. BP TO END OF STRING IN CASE FIND NULL STRING. + MOVS 16,[SLP2,,SLP2LC] ;GET POINTER FOR BLTING IN MAIN LOOP + BLT 16,16 ;BLT IN MAIN LOOP + SKIPGE BOTHCA ;IN BOTH-CASES MODE, + MOVE SLP2,[JRST SLPLO1] + SKIPGE BOTHCA ;IGNORE THE CASE OF THE CHARS SEARCHING. + MOVE SLP3,[JRST SLPLOW] + SKIPLE BOTHCA ;BOTHCA POSITIVE => IGNORE CASE OF LETTERS ONLY. + MOVE SLP2,[JRST SLPLO3] + SKIPLE BOTHCA + MOVE SLP3,[JRST SLPLO2] + CALL IMMQIT ;IT'S OK TO QUIT OUT OF MIDDLE OF SEARCH. + MOVE B,ZBP + TRNN FF,FRBACK ;IF GAP IS IN THE RANGE + CAMN B,ZBP1 ;AND WE'RE STARTING BEFORE IT, + JRST SRN1 + MOVE SLP4,[JRST SLP1Z] ;TEMP. PTR ADVANCE + HRRI SLP4-1,ZBP1 ;WILL ENCOUNTER GAP BEFORE END. + MOVEM SLP4,SLP4N + MOVEM SLP4-1,SLP4N1 +SRN1: MOVE B,@STBLP ;INITIALIZE LIST POINTER + HLRZ A,B + TRNE FF,FRBACK ;IF BACKWARDS, ENTER NORMAL LOOP. + JRST WINNUL + HRRZ A,(A) ;IF THERE IS ONLY ONE ALTERNATIVE IN THE SEARCH STRING + CAIE A,SLP1P + JRST SRN5 + HLRZ A,(B) ;AND THE 1ST CHAR OF SEARCH STRING + CAIE A,(CAIN A,) ;IS NOT A SPECIAL SEARCH CHARACTER, + JRST SRN5 + MOVEI A,SFAST ;THEN WE CAN GO FAST + HRRM A,SLP1P ;USE THE GET-NEXT-CHAR ROUTINE THAT CAN SKIP FAST + HRRZ A,(B) ;OVER UNINTERESTING REGIONS. + MOVEI D,SFAFN0 ;WHICH MAIN LOOP SHOULD WE USE? + SKIPE BOTHCA ;SFAFC0 IGNORES THE 40 BIT; SFAFN0 DOESN'T. + CAIGE A,100 ;IS THE 1ST CHAR ONE WHOSE CASE WE WANT TO IGNORE? + JRST SRN4 ;NO. + CAIL A,"A + CAILE A,"Z + SKIPG BOTHCA + MOVEI D,SFAFC0 ;YES. +SRN4: MOVEM D,SFASAD ;TELL SFAST WHERE TO GO. +REPEAT 4,[ROT A,7 ;GENERATE AN ASCII CONSTANT WITH 1ST CHAR OF SEARCH + TRO A,@(B) ;REPEATED 5 TIMES. +] + LSH A,1 + MOVEM A,SFXOR +SRN5: CAMN C,ZBP + JRST WINNUL + JRST SLP1K + +;ROUTINE TO GET NEXT CHARACTER GOING FORWARD UNDER SPECIAL CIRCUMSTANCES. +;MAY SKIP FAST OVER MANY CHARACTERS BEFORE FINALLY STOPPING WITH A CHARACTER IT CAN'T +;QUICKLY RULE OUT. +SFAST: TLNE C,760000 + JRST SLP1I ;GO SLOW IF NOT STARTING NEW WORD. + HRRZ A,ZBP1 + CAIN A,(C) ;OR IF NEAR GAP OR END OF RANGE + JRST SLP1I + SUBM C,A + HRL C,A ;AOBJN -> RANGE OF WORDS WE CAN SCAN FAST. + JRST @SFASAD ;TO SFAFN0 OR SFAFC0. + +;THIS IS THE SFAST MAIN LOOP THAT DOESN'T IGNORE THE 40 BIT OF THE CHARACTER. +SFAFNL: MOVE A,(C) + XOR A,SFXOR ;XOR NEXT WORD WITH ASCII/QQQQQ/ WHERE Q IS CHAR WE'RE LOOKING FOR. + TLNN A,(177_35) ;IS 1ST CHAR OF WORD THE ONE WE WANT? + JRST SFAF1 + TLNN A,(177_26) ;OR THE 2ND? + JRST SFAF2 + TDNN A,[177_17] + JRST SFAF3 + TRNN A,177_10 + JRST SFAF4 + TRNN A,177_1 + JRST SFAF5 +SFAFN0: AOBJN C,SFAFNL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +;MAIN LOOP THAT IGNORES THE 40 BIT. +SFAFCL: MOVE A,(C) + XOR A,SFXOR + TLNN A,(137_35) ;ONLY DIFFERENCE IS THAT EACH MASK OMITS THE 40 BIT. + JRST SFAF1 + TLNN A,(137_26) + JRST SFAF2 + TDNN A,[137_17] + JRST SFAF3 + TRNN A,137_10 + JRST SFAF4 + TRNN A,137_1 + JRST SFAF5 +SFAFC0: AOBJN C,SFAFCL ;NO NEED TO STOP IN THIS WORD; LOOK AT NEXT. + HRLI C,350700 ;APPROACHING GAP OR END OF RANGE; SLOW DOWN. + JRST SLP1K ;ONLY THE SLOW ROUTINE KNOWS HOW TO HANDLE THEM. + +SFAF1: HRLI C,350700 ;MUST EXAMINE 1ST CHAR THIS WORD - SO DROP INTO + JRST SLP2+2 ;MAIN SEARCH LOOP. + +SFAF2: HRLI C,260700 + JRST SLP2+2 + +SFAF3: HRLI C,170700 + JRST SLP2+2 + +SFAF4: HRLI C,100700 + JRST SLP2+2 + +SFAF5: HRLI C,010700 + JRST SLP2+2 + +;GET NEXT CHARACTER SEARCHING BACKWARDS + +SLP1E: MOVEM C,ZBP ;INITIALIZATION, SET CEILING FOR SEARCH +SLP1D: CAMN C,BBP1 ;AT BEGINNING OF BUFFER OR END OF GAP? + JRST SLP1F ;YES, FIGURE OUT WHICH. + ADD C,[70000,,] ;NO, DECREMENT C, + JUMPGE C,SLP2 ;AND GO BACK INTO LOOP + SUB C,[430000,,1] + JRST SLP2 + +SLP1F: CAMN C,BBP + JRST LOSE ;REALLY AT START OF RANGE, SEARCH FAILED. + JRST SLP1G ;MOVED BACK TO GAP, GO OVER IT. + +;GET NEXT CHARACTER SEARCHING FORWARDS + +SLP1I: IBP C ;INCREMENT TO NEXT CHARACTER +SLP1K: CAME C,ZBP1 ;AT START OF GAP OR END OF RANGE? + JRST SLP2 ;NO, KEEP GOING + CAMN C,ZBP ;WHICH ONE IS IT? + JRST LOSE ;IT'S END OF RANGE. +;MOVE OVER GAP TO GET NEXT CHARACTER +SLP1G: INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT ;COMPUTE A B.P. TO OTHER SIDE OF GAP. + TRNE FF,FRBACK + AOSA BP ;BACKWARD => 1ST CHAR OF GAP, + ADD BP,EXTRAC ;FWD => LAST CHAR OF GAP. + CALL GETIBP + MOVE C,BP + MOVE BP,BBP ;ALREADY PASSED GAP SOLOOK FOR BNDRYS + MOVEM BP,BBP1 ;OF RANGE INSTEAD. + MOVE BP,ZBP + TRNN FF,FRBACK + MOVEM BP,ZBP1 + XORI SLP4-1,ZBP#ZBP1 + MOVEM SLP4-1,SLP4N1 + XOR SLP4,[#] + MOVEM SLP4,SLP4N +INSIRP POP P,TT1 TT BP + HRRZ A,SLP1P ;NOW WE'RE ACROSS GAP SO RETRY FETCHING NEXT CHAR. + JRST (A) + +SLP1Z: XCT SLP4-1 + CAIA + JRA B,SLP2 + MOVE SLP4-1,[CAMN E,ZBP] + MOVE SLP4,[JRA B,SLP1Z1] + INSIRP PUSH P,BP TT TT1 + MOVE BP,GPT + ADD BP,EXTRAC + CALL GETIBP + MOVE E,BP +INSIRP POP P,TT1 TT BP + JRST SLP3 + +SLP1Z1: MOVE SLP4-1,SLP4N1 + MOVE SLP4,SLP4N + JRST SLP2 + +SLPLOW: ILDB A,E ;COME HERE FROM SLP3 IN BOTHCASES MODE. + CAIL A,140 + SUBI A,40 + JRST SLP3+1 + +SLPLO1: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,140 + SUBI A,40 + JRST SLP2+1 + +SLPLO2: ILDB A,E ;COME HERE FROM SLP3 WHEN IGNORING CASE FOR LETTERS ONLY. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP3+1 + SUBI A,40 + JRST SLP3+1 + +SLPLO3: LDB A,C ;SIMILAR, FOR SLP2. + CAIL A,"A+40 + CAILE A,"Z+40 + JRST SLP2+1 + SUBI A,40 + JRST SLP2+1 + +;HERE IF SEARCH FAILS TO FIND THE STRING. EITHER READ NEXT PAGE, OR COMMAND HAS FAILED. +LOSE: SKIPE PNCHFG ;IS IT AN N OR _ COMMAND? + SKIPL LASTPA ;IF SO, AND NOT AT EOF, TRY READING MORE FROM FILE. + JRST LOSE2 ;OTHERWISE, SEARCH HAS REALLY FAILED. + MOVEI C,1 ;MAYBE PUNCH ONCE + SETZM IMQUIT ;DON'T QUIT OUT OF I-O - MIGHT GARBLE FILE. + TRZ FF,FRARG + CALL [ SKIPGE PNCHFG ;PUNCH? + JRST PUNCHA ;YES + JRST YANK] ;NO + MOVE E,BEGV ;GET RANGE TO SEARCH = WHOLE BUFFER, + MOVE C,ZV + CALL GSAPCH ;SET BBP, ZBP. + JRST SRN2 ;SEARCH NEW BUFFER + +LOSE2: SETZM SFINDF ;SEARCH LOST, CLEAR FLAG FOR SEMICOLON + PUSHJ P,SRCV ;SET PT (IF THIS WAS REPEATED SEARCH, MAYBE WE FOUND IT ONCE). + TRZE FF,FRCLN ;IF COLON TYPED FOR SEARCH, + JRST NRET0 ;THEN RETURN 0 AS VALUE + MOVE TT,ITRPTR ;ARE WE WITHIN AN ITERATION? + TSC TT,ITRPTR ;(BUT ERRSETS DON'T COUNT). + TRNN TT,-1 + SKIPE PSSAVP ;OR ARE WE WITHIN A ^P-SORT? + SKIPE SRCERR ;YES. IF SRCERR IS 0, INHIBIT THE ERROR. + TYPRE [SFL] + RET + +WINNL1: MOVE E,C ;NULL SEARCH STRING FOUND. +;THIS SEARCH WINS, MAYBE DO SOME MORE +WIN: MOVEM C,TEM1 ;SAVE C, (BYTE POINTER TO FIRST CHARACTER IN FOUND STRING) + MOVEM E,TEM2 ;AND E, ( " TO LAST CHARACTER IN FOUND STRING) + SOSLE SEARG ;THIS LAST SEARCH? + JRST WIN3 ;NO, KEEP GOING +WIN1: PUSHJ P,SRCV ;PICK UP THE PIECES (ENTRY FOR FOUND NULL STRING AT END OF BUFFER) + TRZ B,-1 ;YES, CHASE DOWN LIST LOOKING FOR THIS LIST POINTER + MOVE C,@STBLP ;GET INITIAL POINTER + MOVNI A,1 ;INITIALIZE COUNT +WIN2: TRZ C,-1 ;CLEAR OUT RIGHT HALF OF THIS LIST ENTRY + CAME C,B ;IS THIS THE ONE? + JRA C,[SOJA A,WIN2] ;NO, TRY NEXT + MOVEM A,SFINDF ;STORE FS SVALUE$ + TRZE FF,FRCLN ;RETURN SFINDF AS VALUE IFF IT'S A ":S". + AOS (P) + RET + +;HERE TO SEARCH OVER AGAIN. CLEAN UP FOR RE-ENTERING SEARCH LOOP. +WIN3: TRNE FF,FRBACK + JRST WIN3R + MOVE BP,E + CALL GETCA ;BP GETS REAL CHAR ADDR CORRESPONDING TO END OF INSTANCE FOUND. + MOVE C,ZBP ;IF FORWARD, THEN START FROM END OF THE INSTANCE WE JUST FOUND (IN E), + CAMLE BP,GPT ;AND IF THAT MEANS SKIPPING OVER THE GAP, FIX UP ZBP1 TO MATCH ZBP. + MOVEM C,ZBP1 + MOVE C,E + JRST SRN2RP + +WIN3R: MOVE E,ZBP ;IF BACKWARD, START FROM BEGINNING OF WHAT WE FOUND, + MOVEM C,ZBP ;BUT PREVENT OVERLAP BY SETTING END OF RANGE TO THERE. + MOVE BP,C + CALL GETCA + CAME E,ZBP1 ;IF THE GAP WASN'T OR IS NO LONGER IN THE RANGE, + CAMGE BP,GPT + MOVEM C,ZBP1 ;THEN ZBP1 SHOULD EQUAL ZBP. + JRST SRN2RP + +;SEARCHING STARTING AT END OF BUFFER, DON'T WIN FOR FORWARD NON-NULL SEARCH + +WINNUL: MOVE A,[JRST WINNL1] ;SET UP A AS CONSTANT FOR COMPARISON AGAINST MEMORY +WINNL2: CAMN A,(B) ;IF AGREEMENT, + JRST WINNL1 ;THEN NULL COMPARISON STRING, WIN, KIND OF + CAME B,STBLPX ;IF THIS ISN'T LAST ENTRY IN TABLE, + JRA B,WINNL2 ;THEN TRY NEXT ONE + TRNN FF,FRBACK ;NO NON-NULL COMPARISON STRINGS, IF SEARCHING FORWARD, + JRST LOSE ;THEN LOSE + JRA B,SLP1E ;SEARCHING BACKWARDS => RE-INITIALIZE LIST POINTER, FALL IN + +;PICK UP PIECES FROM SEARCH; COMPUTE NEW VALUE OF PT. + +SRCV: SETZM IMQUIT + SKIPN BP,TEM2 ;GET POINTER TO LAST CHARACTER IN FOUND STRING + JRST SRCVX ;NO WINNERS THIS BUFFER + MOVE C,TEM1 ;GET POINTER TO FIRST CHARACTER IN FOUND STRING + TRNE FF,FRBACK ;IF SEARCH WAS BACKWARDS, + EXCH C,BP ;THEN REALLY WANT THEM INTERCHANGED + ;BP NOW HAS TECO'S . IN BYTE POINTER FORM + ;C HAS BYTE POINTER TO OTHER END OF STRING FOUND + PUSHJ P,GETCA ;CONVERT BP TO CHARACTER ADDRESS + EXCH BP,C ;GET OTHER BYTE POINTER IN BP + PUSHJ P,GETCA ;CONVERT TO CHARACTER ADDRESS + CAMLE C,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL, + SUB C,EXTRAC + CAMLE BP,GPT ;CONVERT CHAR ADDR OF END TO VIRTUAL. + SUB BP,EXTRAC + SUB BP,C ;DIFFERENCE = LENGTH OF LAST SEARCH STRING FOUND. + MOVEM C,PT ;GO THERE. +SRCVX: MOVNM BP,INSLEN ;STORE SIGNED LENGTH OF LAST SEARCH STRING FOUND + ;SIGN OF LLSSF IS OPPOSITE THAT OF ARG TO SEARCH FROM WHICH IT WAS SET + POPJ P, + +FKCMD: MOVN A,INSLEN ;"FK" - + JRST POPJ1 + +;FS S STRING$ - READ OR SET THE DEFAULT SEARCH STRING. +FSSSTR: CALL FSSSTV ;FIRST, CONS UP A STRING CONTAINING THE OLD VALUE. + TRZE FF,FRARG ;THEN, IF WE HAVE AN ARG, SET THE DEFAULT FROM IT: + CAMN C,[-1] ;ARG OF -1 MEANS "INVALID SEARCH STRING"; JUST DON'T SET. + JRST POPJ1 + JSP T,GCPUSA ;MUST SET. PUSH VALUE TO RETURN WHERE GC WILL RELOCATE IT. + MOVEI A,[ASCIZ /[0 U0 0S0 ]0/] + SAVE SFINDF + CALL MACXCP ;SET SEARCH STRING DEFAULT BY PASSING ARG TO AN S COMMAND. + REST SFINDF +;POP A GCPUSA'D VALUE AND RETURN IT AS COMMAND'S VALUE. +GCPOPV: REST LEV + SUB P,[1,,1] + JRST POPAJ1 + +GCPUSA: SAVE A ;PUSH THE VALUE IN A AND ARRANGE FOR GC TO RELOCATE IT + SAVE [0] ;WHILE IT IS ON THE STACK. THIS IS DONE BY MAKING + SAVE LEV ;IT LOOK LIKE A "(" BLOCK. + MOVEM P,LEV + JRST (T) + +;RETURN IN A A STRING CONTAINING THE CURRENT DEFAULT SEARCH STRING. PRESERVE C. +FSSSTV: MOVE E,SBFRP + MOVE CH,MFZV(E) + MOVE E,MFBEGV(E) + IDIVI E,5 ;GET WORD ADDR'S OF START AND END OF SEARCH TABLE. + IDIVI CH,5 + AOS E ;SKIP OVER THE VALID-WORD AT THE START. + SETO A, + SKIPN -1(E) ;BUT IF THE TABLE'S CONTENTS AREN'T VALID, RETURN -1. + POPJ P, + SAVE C ;ELSE WE'LL RETURN A STRING. WHAT'S A BOUND ON LENGTH WE NEED? + SAVE [POPCJ] + MOVE C,CH + SUB C,E ;TWICE LENGTH OF SEARCH TABLE IS ENOUGH. + LSH C,1 + CALL QOPEN ;ALLOCATE THAT SPACE, SET UP LISTF5 TO STORE INTO STRING. + AOS E ;SKIP THE FIRST POINTER-PAIR IN THE SEARCH TABLE. +FSSSTL: SETZ C, + HLRZ TT,(E) ;GET LH AND RH OF NEXT SEARCH TABLE WORD. + HRRZ TT1,(E) + CAIN TT1,SLP1P ;SLP1P IN RH IDENTIFIES END OF SEARCH TABLE + JRST QCLOSV ;SO FINISH UP THE STRING'S HEADER AND RETURN IT. + CAIL TT1,HUSED ;AN RH THAT'S AN ADDRESS IN BUFFER SPACE + JRST [ MOVEI CH,^O ;INDICATES A DIVISION BETWEEN ALTERNATIVE STRINGS, + JRST FSSST2] ;SO WE NEED A ^O FOR IT. + CAIN TT,(JRST) ;JRST INSN MUST BE JRST WIN OR WINNUL, WHICH IS AT THE END OF + AOJA E,FSSSTL ;EVERY ALTERNATIVE. IT CORRESPONDS TO NO CHAR IN USER'S ARG. + CAIN TT,(JFCL) + MOVSI C,(ASCII //) ;JFCL IS GENERATED BY A ^X. + CAIN TT,(CAIA) + MOVSI C,(ASCII //) ;CAIA COMES FROM A ^N^X. + CAIN TT1,SKNBRK + MOVSI C,(ASCII //) ;CALL SKNBRK COMES FROM ^B. + CAIN TT1,SKBRK + MOVSI C,(ASCII //) ;CALL SKBRK COMES FROM ^N^B. + JUMPE C,FSSST1 ;ANYTHING ELSE MUST BE ORDINARY, OR A ^N. + MOVEI A,C + CALL ASCIND ;IF ^X OR ^B, OR ^N OF ONE, STORE IN STRING THE STUFF IN C. + AOJA E,FSSSTL + +FSSST1: MOVEI CH,^N + CAIN TT,(CAIE A,) ;DECIDE BETWEEN ORDINARY CHAR AND ^N'D CHARACTER. + XCT LISTF5 + MOVEI CH,^Q ;IF CHAR IS ONE THAT WOULD BE SPECIAL, MUST QUOTE IT. + CAIE TT1,^B + CAIN TT1,^X + XCT LISTF5 + CAIE TT1,^Q + CAIN TT1,^O + XCT LISTF5 + CAIN TT1,^N + XCT LISTF5 + MOVE CH,TT1 ;[ + CAIN CH,^] + XCT LISTF5 ;[ ;^] HAS ITS OWN WAY TO BE QUOTED. +FSSST2: XCT LISTF5 + AOJA E,FSSSTL + +SUBTTL ..D DELIMITER DISPATCH USAGE + +;SKNBRK SKIPS UNLESS THE CHARACTER IN A IS A DELIMITER CHARACTER. +;THE SET OF DELIMITERS IS DEFINED BY THE CONTENTS OF QREG ..D, +;WHICH SHOULD BE A STRING CONTAINING 5*128. CHARACTERS, FORMING A +;DISPATCH TABLE. EACH ASCII CHAR HAS A 5-CHAR DISPATCH ENTRY WHOSE +;FIRST TWO CHARACTERS ONLY ARE SIGNIFICANT. +;THE FIRST CHARACTER IS THE MOST GENERAL: IF IT IS NOT A SPACE, THEN +;THE CHARACTER WHOSE ENTRY IT IS IS NOT A DELIMITER. +;INITIALLY ALL NON-SQUOZE CHARACTERS ARE DELIMITERS. +;THE SECOND CHARACTER SAYS HOW LISP HANDLES THE CHAR BEING HANDLED. +;THE POSSIBLE DISPATCH CHARS ARE "(", ")", "/", "|", "A" AND " ". +;SKNBRK ASSUMES THAT SKNBPT HAS BEEN SET UP BY SKNBCP ALREADY. +;CLOBBERS D. +SKNBRK: LDB D,SKNBPT + CAIN D,"A + AOS (P) + RET + +DQT3: CALL SKNBCP ;SKIP IF CHAR IN C IS DELIMITER; RECOMPUTES SKNBPT. + MOVE A,C +SKBRK: LDB D,SKNBPT ;SKIP IF CHAR IN A IS DELIM. SKNBCP SHOULD HAVE BEEN CALLED. + CAIE D,"A + AOS (P) + RET + +;LOOK AT QREG ..D, AND SET UP SKNBPT FOR USE BY SKNBRK. +SKNBCP: MOVE CH,QRB.. + ADDI CH,.QDLIM + CALL QLGET ;BP _ BP TO TEXT. + TYPRE [QNS] + CAIGE B,5*200 ;NOT LONG ENOUGH => ERROR. + TYPRE [STS] + IBP BP ;BP HAS BP TO LDB 1ST CHAR. + TLO BP,A ;LDB BP TO GET DISPATCH OF CHAR IN A. + MOVEM BP,SKNBPT + RET + +;; ^B COMMAND: GO TO BEGINNING OF BUFFER IF LAST SEARCH WAS BACKWARD AND FAILED, +;; OR TO END IF LAST SEARCH WAS FORWARD AND FAILED. SET FS INSLEN$ TO 0 EITHER WAY. +;; IF LAST SEARCH SUCCEEDED, DON'T MOVE, AND DON'T CHANGE FS INSLEN$. +;; WITH COLON FLAG, IF SEARCH WAS SUCCESSFUL DO FKC. +CTLB: TRZ FF,FRARG\FRARG2 + MOVN C,INSLEN + SKIPE SFINDF + JRST [ TRZE FF,FRCLN + JRST REVER1 + RET] + SETZM INSLEN + HRRZ A,SLP1P + CAIE A,SLP1D ;WAS LAST SEARCH FORWARD? + SKIPA A,SRCEND ;IF SO, GO TO END + MOVE A,SRCBEG ;ELSE GO TO BEGINNING. + ADD A,BEG + MOVEM A,PT + RET + +SUBTTL F AND FS COMMAND DISPATCH + +;F-COMMAND SUBDISPATCH. +FCMD: PUSHJ P,LRCH + XCT FDTB(CH) + POPJ P, + JRST POPJ1 + +;FS COMMAND. +FSET: MOVE B,[440600,,D] + MOVE E,[440600,,J] + SETO BP, + SETZB D,J +;D GETS THE SPEC'D NAME; J GETS MASK TO THOSE CHARS IN THE WORD WHICH WERE SPEC'D. +FSLUP: CALL RCH + ANDI CH,-1 + TRNE CH,100 + ANDCMI CH,40 ;CONVERT TO LOWER CASE. + CAILE CH,40 + JRST FSCHAR ;NON-CONTROLS ARE FOR REAL. + CAIN CH,ALTMOD + SKIPGE SQUOTP ;ALTMODE ENDS NAME UNLESS SUPERQUOTED. + CAIA ;OTHERWISE, ^X IS TREATED AS IF IT WERE AN UPARROW AND AN X. + JRST FSLKUP + MOVEI TT,'^ + CAIE CH,40 ;SPACE, UNLIKE CTL CHARS, IS JUST IGNORED. + TLNN B,770000 ;CTL CHARS ALSO IGNORED IF ALREADY HAVE 6 CHARS. + JRST FSLUP + IDPB TT,B + IDPB BP,E + +FSCHAR: HRREI CH,-40(CH) ;GET SIXBIT, IGNORING LH SINCE MIGHT BE -1 + TLNE B,770000 ;[ ;IF THE CHAR WAS QUOTED WITH ^]^Q + IDPB CH,B + TLNE E,770000 + IDPB BP,E + JRST FSLUP + +FSLKUP: MOVE B,[-FLAGSL*2,,FLAGS] + +;BINARY SEARCH IN VECTOR OF FLAGS <- AOBJN IN B +;FOR VALUE IN D. CLOBBERS B,E,TT. +FSLUKB: HLRE E,B + HRLI B,E ;B IS INDEX OF E. + MOVNS TT,E +;B -> INSIDE AREA, IDX OF E. +;E = SIZE OF LAST STEP. +;TT = # WDS LEFT IN PART OF AREA AFTER B. +;LEAVES B POINTING TO LAST FLAG WHOSE NAME IS < DESIRED NAME +;(NOTE: IF ALL FLAGS ARE >= DESIRED NAME, B -> 1ST FLAG). +;THEN GOES TO FSLUK1. +FSLUK0: CAILE E,(TT) ;E_MAX(LAST STEP,SPACE LEFT) + MOVEI E,(TT) + CAIN E,2 ;ONLY 1 ENTRY TO SEARCH THRU => DONE. + JRST FSLUK1 + LSH E,-1 ;STEP = .5* SIZE OF STUFF TO SEARCH. + TRZE E,1 ;ROUND UP TO EVEN NUMBER. + ADDI E,2 + CAMG D,@B ;E.A. IS RH(B)+STEP. + JRST FSLUK0 ;THAT'S TOO FAR, DON'T MOVE B. + HRRI B,@B ;NOT TOO FAR, SET PTR THERE. + SUBI TT,(E) ;WE'RE CLOSER TO END NOW. + JRST FSLUK0 + +FSLUK1: CAMLE D,(B) ;(THIS PREVENTS LOSSAGE IF SUPPOSED TO FIND 1ST FLAG IN TABLE) + ADDI B,2 + MOVEI B,-FLAGS(B) ;POINT TO 1ST FLAG GREATER THAN OR EQUAL TO DESIRED. + MOVE E,FLAGS(B) + AND E,J ;IF THIS FLAG DOESN'T MATCH SPEC'D NAME, NONE DOES. + CAME D,E + TYPRE [IFN] + CAMN D,FLAGS(B) ;EXACT MATCH IS NEVER CONSIDERED AMBIGUOUS. + JRST FSFND + MOVE E,FLAGS+2(B) ;ELSE, DOES THE NEXT FLAG AFTER THE ONE FOUND + AND E,J ;ALSO MATCH THE SPECIFIED NAME? + CAMN D,E + TYPRE [AFN] ;YES - SPEC'D NAME IS AMBIGUOUS. +FSFND: MOVS E,FLAGD(B) + HRLM B,(P) +FSCALL: CALL (E) ;SOME ROUTINES WILL DEPOSIT IN -1(P)! THEY ALL CREF FSCALL. + RET ;(THEIR GOAL IS TO FAKE OUT FPUSH VIA THE INSN AT .+1) + HLRZ E,(P) ;FOR FLAGS THAT RETURN VALUE, MAKE SURE INDEX OF FLAG IS + JRST POPJ1 ;IN E, FOR FPUSH TO WORK. + +SUBTTL FS FLAG ROUTINES + +;[ ;F]$ POPS QREG PDL INTO THAT FLAG. +;[ ;F]^RCMAC$ WORKS, ETC. +FPOP: MOVEI CH,E ;CH HAS ADDR TO POP INTO. + CALL CLOSB2 + TRON FF,FRARG + SKIPA C,E ;MAKE POPPED VALUE COME BEFORE ANY SPEC'D ARG. + TRO FF,FRARG2 + CALL FSET ;SET THE FLAG, RETURNING THE OLD VALUE OF THE FLAG. + JFCL + RET ;RETURN NO VALUE. + +;F[$ PUSHES THAT FLAG ONTO THE QREG PDL. +;F[^RCMAC$, ETC., WORK. ;]] +FPUSH: MOVE B,PF ;IF WE ARE ABOUT TO OVERFLOW QREG PDL, DETECT THAT + CAMN B,PFTOP ;BEFORE SETTING THE FLAG. + JRST OPENB1 + CALL FSET ;DO FS$, WHICH LEAVES INDEX IN FLAGD IN E. + TYPRE [WNA] ;FLAG HAS NO VALUE, AND YOU WANT TO PUSH IT?? + TRNE FF,FRARG2 ;BARF IF TRY TO PUSH FS BOUNDARIES$, SINCE IT DOESN'T WIN. + TYPRE [WNA] + MOVEI CH,A + CALL OPENB2 ;PUSH THE VALUE FROM A, WHERE FSET LEFT IT, + MOVEM E,(B) ;THEN SET "WHERE PUSHED FROM" FIELD TO THE INDEX OF THIS + ;FLAG IN THE FLAGS TABLE, + ;THUS TELLING AUTO-UNWIND TO POP THE FLAG BY DOING FPOP. + RET + +;HERE ARE THE COMMONLY USED FS FLAG ROUTINES. + +IFN ITS,FSSTRR:: FSDSNM:: FSNQIT:: FSDIRH:: +IFN TNX,FSFVER:: +FSNORM: HLRZS E ;HERE TO READ/SET NORMAL FLAG; E -> WORD HOLDING VALUE. +FSNOR1: MOVE A,(E) +FSNOR2: ARGDFL + TRZN FF,FRARG + JRST POPJ1 + MOVEM C,(E) + CAIE E,CASNRM ;IF SET CASNRM, ALSO SET CASDIS. + JRST POPJ1 + ANDI C,1 + MOVEM C,CASDIS + JRST POPJ1 + +FSVAL: HLRZ A,E ;HERE TO RETURN CONSTANT VALUE (AS FOR FS VERSIO$) + JRST POPJ1 + +IFN ITS,[ +FSRSYS: HRRI E,A ;HERE TO READ A PARTICULAR .SUSET VAR (AS FOR FS OPTION$) + .SUSET E + JRST POPJ1 + +FSOPTL: .SUSET [.ROPTIO,,B] ;READ BIT IN LH OF .OPTION. C SAYS WHICH BIT. + JRST FSBIT1 +] + +FSRNLY: MOVE A,E ;READ-ONLY FLAG'S ADDR IN LH(E) + JRA A,POPJ1 + +FSROCA: MOVE A,E ;READ ONLY CHAR. ADDR, RETURN RELATIVE TO BEG. + JRA A,FSROC1 + +FSWBIT: ARGDFL + HRRI E,FF ;HERE IF WE WANT TO BE ABLE TO WRITE A BIT AS WELL AS READ IT. + MOVE B,FF ;LH(E) HAS B.P. L.H., AND WE ASSUME THE BIT IS IN FF. + SKIPE C ;WE MUST SAVE THE OLD FF SO WE CAN RETURN THE OLD SETTING OF THE BIT. + SETO C, ;ANY NONZERO ARG MEANS TURN THE BIT TO 1. + TRNE FF,FRARG + DPB C,E + CAMN E,[.BP FRTRACE] + CALL QUEST1 ;IF THE BIT JUST CHANGED IS FRTRACE, SET TRACS TOO. + JRST FSBIT1 + +FSBIT: SKIPA B,FF ;LH(E) HAS B.P. L.H., TO FETCH BIT IN FF. +FSTTOL: HLLZ B,TTYOPT ;TEST BIT IN LH(TTYOPT). +FSBIT1: HRRI E,B + LDB E,E ;FETCH THE DESIRED BIT. + SKIPN E +NRET0: TDZA A,A ;VALUE IS 0 IF BIT CLEAR, +NRETM1: SETO A, ;-1 IF SET. + JRST POPJ1 + +;ALTCOUNT FLAG, # COMMAND STRINGS TYPED AHEAD BY USER. +FSALTC: CALL VBDACU ;DO LISTEN TO UPDATE TSALTC, + JFCL + JRST FSNORM ;THEN DO NORMAL FS ON TSALTC. + +;READ OR SET # OF COMMAND LINES. +FSECLS: MOVE A,NELNS ;GET CURRENT # OF CMD LINES, + ARGDFL + TRZE FF,FRARG + CALL FSECL1 ;AND SET IT IF NEC. + JRST POPJ1 + +;DESIRED # ECHO LINES IN C. (OR - => NO ECHO, BUT -1 ECHO LINES) +FSECL1: SKIPGE E,C ;GET ARG IF POSITIVE, + SETCA E, ;OR -1-ARG IF NEGATIVE. + CAML E,NVLNS ;VALUE TOO LARGE => WOULD CRASH TECO. + TYPRE [AOR] + SKIPN RGETTY + JRST FSECL3 + MOVE T,NVLNS + SUB T,NELNS ;IN CASE WE ARE REDUCING NELNS, ZERO OUT HASH CODES OF ALL LINES +FSECL2: SETOM HCDS-1(T) ;THAT WERE PREVIOUSLY IN THE ECHO AREA (AND THE OLD MORE LINE). + CAME T,NVLNS + AOJA T,FSECL2 +FSECL3: MOVEM C,NELNS + MOVE C,NVLNS ;TOTAL # LINES - # ECHO LINES + SUB C,E +IFN TNX,[ + MOVEM C,ECHOL0 ;SAVE FIRST LINE OF ECHO AREA + HRLZM C,ECHOPS ;AND SET UP AS NEW ECHO POSITION +] + SUBI C,1 ;DEDUCT 1 LINE FOR THE --MORE-- + MOVEM C,USZ ;= # LINES FOR BUFFER DISPLAY. + SETOM DISOMD ;INDICATE DISPLAYED "MODE" (Q..J) IS OUT OF DATE. +IFN ITS,[ + SYSCAL SCML,[%CLIMM,,CHTTYI ? E] + .LOSE %LSFIL +] + SKIPE ECHOFL ;IF ECHOING NOMINALLY "ON" (THAT IS, NOT OFF DUE TO ^R OR ^T) + CALL SETTTM ;THEN MAYBE CHANGING THIS FLAG TURNS IT OFF OR ON. + SETOM TYOFLG ;USZ HAS CHANGED, SO MAKE SURE TYPEOUT KNOWS ABOUT IT. + RET + +;READ OR SET FS TOP LINE$. DON'T LET IT BE SET OUT OF RANGE. +;DON'T LET IT BE NONZERO ON A PRINTING TERMINAL. +FSTPLN: TRNN FF,FRARG + JRST FSNORM + SKIPN RGETTY + JUMPN C,FSTPLL + CAMGE C,USZ + JUMPGE C,FSNORM +FSTPLL: TYPRE [AOR] + +FSWIDTH:TRNE FF,FRARG + CAIG C,MXNHLS + JRST FSNORM + TYPRE [AOR] + +IFN 20X,[ +FSTTPG: MOVE A,PAGMOD ;GET CURRENT PAGE MODE STATE + TRNE FF,FRARG ;IF ANY ARG + MOVEM C,PAGMOD ;SETUP NEW ONE + JUMPGE C,CPOPJ1 ;AND IF NOT -1, DONT NEED TO CHANGE YET + SAVE A + MOVEI A,.PRIOU + RFMOD + TRON B,TT%PGM ;TURN ON PAGE MODE WHILE IN TECO + STPAR + REST A + JRST CPOPJ1 +] + +FSRUNT: +IFN ITS,[ + .SUSET [.RRUNT,,A] + MULI A,4069. ;CONVERT TO NANOSEC., + DIV A,[1.^6] ;THEN TO MILLISEC. +] +IFN TNX,[ + MOVEI A,.FHSLF ;THIS FORK + RUNTM ;RUNTIME IN MS. +] + JRST POPJ1 + +FSUPTI: +IFN ITS,.RDTIME A, ;RETURN THE SYSTEM UP TIME - FS UPTIME $ +IFN TNX,TIME ;SYSTEM UPTIME IN MS. + JRST POPJ1 + +FSSWIT: +IFN ITS,.RDSW A, +IFN TNX,SWTCH ;FOR WHAT ITS WORTH + JRST POPJ1 ;RETURN PDP10 CONSOLE SWITCHES. + +FSDDFS: +IFN ITS,[ + MOVE A,DEFDEV ;RETURN -1 IF DEFAULT DEVICE IS "FAST". + CAME A,MACHINE + JRST NRET0 +] + JRST NRETM1 ;ONLY ITS HAS ANY SLOW DEVICES. + +IFN ITS,[ +..RHSNAM==16 ? ..RMAIL==17 + +;,FS U HSNAME$ RETURNS IN SIXBIT THE HSNAME OF ON MACHINE . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED FOR THE CURRENT MACHINE. +FSUHSN: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RHSNAM,,A] + MOVE A,B + TRZ FF,FRARG\FRARG2 + JRST POPJ1 + +;,FS UMAIL$ SETS DEFAULT FILENAMES TO MAIL FILE OF ON . +;BOTH ARGS SHOULD BE SIXBIT. CAN BE OMITTED MEANING USE THAT USER'S HOME MACHINE. +FSUML: MOVE A,SARG + MOVE B,C + .BREAK 12,[..RMAIL,,A] + MOVEM A,DEFDEV + MOVEM B,DEFFN1 + MOVEM C,DEFDIR + MOVE A,[SIXBIT /MAIL/] + MOVEM A,DEFFN2 + RET +];IFN ITS + +FSEJPG: MOVE A,LHIPAG ;READ OR WRITE FS :EJ PAGE$. + ARGDFL + TRZN FF,FRARG + JRST POPJ1 + CAML C,LHIPAG ;ILLEGAL TO SET IT TO A SMALLER VALUE SINCE PAGES DON'T EXIST. + CAILE C,LHIMAX ;ILLEGAL TO SET ABOVE TOP OF ADDRESS SPACE. + TYPRE [AOR] + EXCH C,LHIPAG +;NOW FLUSH THE PAGES WE HAVE REMOVED FROM PURE STRING SPACE. +IFN ITS,[ + MOVE B,C + SUB B,LHIPAG ;B GETS MINUS NUMBER OF PAGES FS :EJPAGE$ HAS ADVANCED OVER. + JUMPE B,POPJ1 + HRL C,B ;C GETS AOBJN TO PAGES TO BE FLUSHED. + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? C] + .LOSE %LSSYS +];IFN ITS +IFN TNX,[ + MOVE B,C + SUB C,LHIPAG ;NEGATIVE NUMBER OF K + JUMPE C,POPJ1 + MOVM C,C + LSHC B,1 ;TRANSLATE FROM K TO PAGES. + HRLI B,.FHSLF ;THIS FORK + SAVE A ;PRESERVE WHAT FS EJPAGE IS GOING TO RETURN. + SETO A, +IFN 20X,[ + HRLI C,(PM%CNT) ;COUNT GIVEN + PMAP +];IFN 20X +IFN 10X,[ +FSEJP1: PMAP + SOJLE C,FSEJP2 + AOJA B,FSEJP1 +FSEJP2: +];IFN 10X + REST A +];IFN TNX + JRST POPJ1 + +;RETURN CURRENT DATE/TIME IN DISK FILE DATE FORMAT. +FSDATE: +IFN ITS,[ + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS +] +IFN TNX,GTAD ;GET TIME IN SYSTEM INTERNAL FORMAT (ASSUME WILL + JRST POPJ1 ;BE PASSED ALONG TO FS F DCONV$ UNMUNGED) + +FSFDAT: +IFN ITS,[ + HLRZS E ;CREATION DATE OF FILE ON CHNL IN LH(E) + ARGDFL + SYSCAL RFDATE,[E ? %CLOUT,,A] + JRST OPNER1 + TRZN FF,FRARG + JRST POPJ1 + SYSCAL SFDATE,[E ? C] + JRST OPNER1 + JRST POPJ1 +] +IFN TNX,[ + HLRZS E + SKIPG A,(E) ;GET THE JFN + JRST [ CAIN E,CHFILI + TYPRE [NFI] + TYPRE [NDO] + ] + ARGDFL + SAVE C ;SAVE ANY ARG + MOVE B,[1,,.FBWRT] + MOVEI C,A + GTFDB ;GET THE OLD WRITE DATE + ERJMP OPNER1 + REST C + TRZN FF,FRARG ;WRITING ON THIS FLAG? + JRST POPJ1 ;NO, JUST RETURN +FSFDT2: SAVE A + MOVE A,(E) + SETO B, + HRLI A,.FBWRT + CHFDB ;YES, CHANGE IT + REST A ;AND RETURN OLD VALUE + JRST POPJ1 +] + +;"FS FDCONV $" IS LIKE "\" BUT HANDLES FILE DATES INSTEAD NUMBERS. +FSDCNV: TRNE FF,FRARG + JRST FSDCN2 ;ARG => GO TURN IT INTO STRING IN BUFFER + JRST FSDCNI ;ELSE PARSE A DATE OUT OF THE BUFFER. + +IFN ITS,[ +FSDCNI: SAVE [0] ;PUSH WORD TO ACCUM. THE DATE IN. +FSDCN0: MOVE OUT,[-6,, [40,, ;MONTH + 1,, ;DAY + 1000,, ;YEAR + 3600.*2 ;HOUR (IN TERMS OF 1/2 SEC) + 60.*2 ;MINUTE + 2]] ;SECOND + JRST FSDCN4 + +FSDCN3: MOVE IN,PT + CAMN IN,ZV ;AT END OF BUFFER => RETURN WHAT WE HAVE + JRST FSDCN1 + CALL GETINC + CAIN CH,^M ;STOP BEFORE A CR. + JRST FSDCN1 + AOS PT ;ELSE MOVE OVER DELIMITER +FSDCN4: MOVE Q,PT + SAVE OUT + CALL BAKSL ;READ THE NEXT NUMBER + JFCL + REST OUT + CAMN Q,PT + JRST FSDCN1 ;NO NUMBER => FINISHED. + IMUL A,(OUT) ;ELSE PUT THIS # IN RIGHT PLACE + ADDM A,(P) ;IN THE DATE BEING ACCUMULATED. + AOBJN OUT,FSDCN3 ;HAVEN'T READ ALL 6 YET => KEEP GOING. +FSDCN1: REST A ;A HAS DATE TO RETURN. + CAMN OUT,@FSDCN0 ;IF DATE IN BUFFER WAS NULL, + SETO A, ;RETURN -1 + JRST POPJ1 + +FSDCN2: MOVEM C,PTLFCD + MOVEI TT,TYOM + HRRM TT,LISTF5 ;PRINT THE DATE INTO MEMORY. + CALL [ TRNN FF,FRCLN + JRST GAPSLP + MOVEI C,18. + JRST QOPEN] + SKIPL PTLFCD ;DATE IS -1 => LEAVE EMPTY. + CALL PTLAB9 + JRST SLPXIT +] ;IFN ITS + +IFN TNX,[ +FSDCNI: CALL GAPSL0 ;MOVE GAP TO PT, BUT ARENT MUNGING BUFFER + CALL GETIB. ;GET BYTE POINTER TO . + MOVE A,BP + SETZ B, + IDTIM ;READ IN TIME + SETO B, +IFN 20X,DBP7 A ;MAKE RESULTING BYTE POSITIONS CONSISTANT + MOVE BP,A ;GET UPDATED BYTE POINTER + CALL GETCA ;GET CHARACTER ADDR + SUB BP,EXTRAC ;MOVE OVER GAP + MOVEM BP,PT ;UPDATE . + MOVE A,B ;VALUE TO RETURN + JRST POPJ1 + +FSDCN2: MOVEI A,TYOM ;INTO BUFFER + HRRM A,LISTF5 + HRROI A,BAKTAB ;STRING SPACE + MOVE B,C + TRNE FF,FRARG2 + SKIPA C,SARG ;USE ANY SECOND ARG AS THE FORMAT + MOVSI C,(OT%NMN\OT%DAM\OT%SLA) ;ELSE DEFAULT TO DD/MM/YY HH:MM:SS + ODTIM + LDB C,[350700,,BAKTAB] ;IF ITS FORMAT, MUST MAKE UP FOR ODTIM LOSSAGE + TRNN FF,FRARG2 + CAIE C,40 + JRST FSDCN3 + MOVEI C,"0 ;BY CONVERTING LEADING SPACE TO 0 + DPB C,[350700,,BAKTAB] +FSDCN3: MOVEI C,20. ;MAKE ENOUGH ROOM + CALL [ TRNN FF,FRCLN + JRST GAPSLP + JRST QOPEN] + MOVEI A,BAKTAB + CALL ASCIND ;INSERT IT + JRST SLPXIT + +FSJOBN: GJINF ;GET JOB NUMBER + MOVEI A,(C) + JRST CPOPJ1 + +FSGTNM: GETNM ;GET SIXBIT JOB NAME + MOVE C,A ;SET UP AS AN ARG + JRST FSIXST ;AND GO MAKE A STRING OF IT + +FSMACH: MOVE A,[SIXBIT/LHOSTN/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; GET LOCAL HOST NO. + JUMPE B,FSMAC1 ; TRY ALTERNATIVE METHOD IF NO LHOSTN + JUMPL A,FSMAC1 ; OR IF LHOSTN IS NEGATIVE (TOPS-20 RELEASE 3 + ; HAS A LHOSTN ENTRY ON ALL SYSTEMS) + MOVE B,A + HRROI A,BAKTAB + CVHST ; CONVERT HOST NO. TO NAME + JRST FSMAC1 ; NO STRING FOR THAT HOST + MOVEI B,0 ; MAKE SURE STRING IS ASCIZ + IDPB B,A ; ... + JRST FSSTR3 +FSMAC1: SETZM BAKTAB ; FOR THE MOMENT RETURN 0 + JRST FSSTR3 + +FSCCLF: SKIPN A,CCLJFN ;FS CCL FNA$ - IF STARTED AT +2, ... + JRST CPOPJ1 ;NOT, RETURN 0 + MOVEI B,(A) + HRROI A,BAKTAB ;RETURN STRING OF JFN GIVEN + MOVE C,[111110,,000001] ;AS DSK:NAM.EXT.GEN + JFNS + MOVEI A,(B) + RLJFN + JFCL + SETZM CCLJFN ;DONT HAVE STRAY JFNS AROUND LATER + JRST FSSTR3 ;MOVE STRING FROM BAKTAB AND RETURN STRING POINTER + +FSNQIT: MOVE A,NOQUIT ;GET PREVIOUS SETTING + ARGDFL + TRZN FF,FRARG ;IF NO ARG, + JRST POPJ1 ;RETURN IT + MOVEM C,NOQUIT ;SETUP NEW ONE + JUMPG A,FSNQT2 ;CHANGING FROM POSITIVE + JUMPLE C,POPJ1 ;IF NOT CHANGING TO POSITIVE, NOTHING TO DO + SAVE A + MOVEI A,.TICCG + DTI ;ELSE TURN OFF ^G INTERRUPT + JRST POPAJ1 +FSNQT2: JUMPG C,POPJ1 ;NOTHING IF CHANGING TO POSITIVE + SAVE A + MOVSI A,.TICCG ;ELSE RE-ASSIGN ^G INTERRUPT + ATI + JRST POPAJ1 + +FSLOAD: MOVE A,[SIXBIT/SYSTAT/] ; SYSGT ARG: SIXBIT TABLE NAME + SYSGT ; FIND TABLE NO. OF SYSTAT TABLE + JUMPE B,FSLOA1 ; IF NOT FOUND THEN RETURN ZERO + MOVEI A,(B) ; GETAB ARG: TABLE NO. IN RH + HRLI A,14 ; AND OFFSET IN LH + GETAB ; GET ENTRY 14 OF SYSTAT TABLE: 1 MINUTE LOAD + ; AVERAGE + TDZA B,B ; IF ERROR RETURN ZERO + MOVE B,A +FSLOA1: HRROI A,BAKTAB + MOVE C,[FL%ONE\FL%PNT\020200] + JSYS 233 ;FLOUT MAYBE SHOULD BE RENAMED + SETZM BAKTAB + JRST FSSTR3 +];IFN TNX + +IFN TNX,[ + +FSDIRH: MOVE B,HSNAME ;HOME DIRECTORY + JRST FSDIR3 +FSDIR2: GJINF + SKIPA B,A ;LOGIN DIR +FSDIRS: GJINF ;CONNECTED DIR +FSDIR3: HRROI A,BAKTAB + DIRST ;INTO STRING SPACE + SETZM BAKTAB +FSSTR3: MOVEI E,BAKTAB +FSSTR0: MOVEI C,10 ;GET ENOUGH STRING + CALL QOPEN + MOVEI A,(E) + CALL ASCIND ;INSERT IT +FSSTR2: CALL QCLOSV ;AND RETURN STRING POINTER + JRST POPJ1 + +FSDSNM: TRO FF,FRNOT ;FLAG TO FLUSH DIRST PUNCTUATION +FSSTRR: HLRZS E ;GET DESIRED ADDRESS + TRZN FF,FRARG ;ANY ARG? + JRST FSSTR0 ;NO, RETURN THE STRING THEN + HRLI E,440700 ;MAKE BYTE POINTER + SKIPL A,C ;GET ARG - SHOULD BE A STRING + CAIA + CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING + TYPRE [ARG] ;NOT A STRING? +FSSTR1: ILDB CH,BP + TRNE CH,100 ;MAKE SURE IS UPPERCASE + TRZ CH,40 + CAIN CH,": ;LOOK LIKE STRUCTURE PUNCTUATION FROM DIRST + TRNN FF,FRNOT ;AND ON THE LOOKOUT FOR THAT? + CAIA + JRST FSDSN2 ;YES, GO HANDLE THAT + CAIE CH,"< + CAIN CH,"> ;IF PART OF DIRECTORY PUNCTUATION + TRNN FF,FRNOT ;AND LOOKING FOR IT - SKIP MOVING CHAR + IDPB CH,E + SOJG B,FSSTR1 ;MOVE STRING INTO DESIRED PLACE + MOVEI CH,^@ ;AND END WITH A NULL + IDPB CH,E + RET +FSDSN2: MOVEI CH,^@ + IDPB CH,E + MOVE CH,DEFDIR ;IF : SEEN IN DIRECTORY, MOVE STRUCTURE + MOVEM CH,DEFDEV ;OVER TO DEVICE + MOVE CH,DEFDIR+1 + MOVEM CH,DEFDEV+1 + MOVE E,[440700,,DEFDIR] ;AND RESET POINTER TO DIRECTORY + SOJA B,FSSTR1 +] ;IFN TNX + +;RETURN THE HORIZ POS. OF THE CURRENT POINTER SETTING, +;ASSUMING THAT BACKSPACES AND STRAY CR'S COME OUT AS SUCH. +; ^HPRINT AND ^MPRINT FLAGS ARE NOT LOOKED AT. +FSHPOS: MOVE BP,BEGV + SOS C,BP + SETZ A, + MOVE BP,PT + CAMN BP,BEGV + JRST POPJ1 + MOVE IN,BP + SOS BP +FSHPOL: SOS IN + CALL GETCHR + CAIE CH,^M + CAMN C,IN + JRST FSHPOT + JRST FSHPOL + +FSHPOD: AOS IN + CALL GETCHR + CAIE CH,^J + CAIN CH,GLITCH + JRST FSHPOT + CAIN CH,^I + JRST [ ADDI A,10 + TRZ A,7 + JRST FSHPOT] + CAIN CH,ALTMOD + AOJA A,FSHPOT + CAIN CH,^H + SOJA A,FSHPOT + CAIGE CH," + AOJ A, + AOJ A, +FSHPOT: CAME IN,BP + JRST FSHPOD + JRST POPJ1 + +;RETURN HPOS COUNTING CTL CHARS AS THEY APPEAR, BUT NOT COUNTING CONTINUATION. +FSSHPS: SAVE NHLNS + .I NHLNS=1000000. + CALL RRBTCR + MOVE A,RRHPOS + REST NHLNS + SAVE A + CALL RRBTCR + REST A + JRST POPJ1 + +;READ OR SET THE VIRTUAL BUFFER BOUNDARIES - THE RANGE OF +;BUFFER THAT ALL OTHER COMMANDS ARE ALLOWED TO TOUCH. +FSBOUN: TRNN FF,FRARG + JRST HOLE ;NO ARG => RETURN BOUNDS, LIKE H COMMAND + MOVE E,SARG + CALL GETARG ;ELSE CALCULATE NEW BOUNDS, + CALL CHK1A + CALL HOLE ;SET UP THE VALUES TO BE RETURNED, + JFCL +FSBOU1: CALL CHK1A ;MAKE SURE BEG CONVERT STRING ARG TO "SIXBIT", SAME AS :I*. + MOVE A,C + TRZE FF,FRUPRW+FRCLN + JRST POPJ1 ;:F6 CONVERTS "SIXBIT" TO STRING: RETURN THE ARG. + JRST QGET4 ;F6 INSERTS "SIXBIT" ARG IN BUFFER: ENTER "G" COMMAND. +] + +IFN ITS,[ +;F6 COMMAND. +FSIXB: TRZN FF,FRARG + JRST FSIXR ;NO ARG => READ IN STRING AND CONVERT TO SIXBIT. + TRZE FF,FRUPRW+FRCLN ; :F6 RETURNS STRING CONTAINING THE CHARS OF THE SIXBIT. + JRST FSIXST + MOVE E,C ;TREAT ARG AS WD OF SIXBIT AND INSERT IN BUFFER. + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + JRST SIXNTY ;GO INSERT THE SIXBIT. +] + +;READ IN A STRING , AND RETURN CONVERTED TO SIXBIT IN A. IGNORE CONTROL CHARS. SKIPS. +FSIXR: MOVE OUT,[440600,,A] + SETZ A, +FSIXRL: CALL LRCH + CAIN CH,ALTMOD + JRST POPJ1 + CAIL CH,40 + TLNN OUT,770000 + JRST FSIXRL + SUBI CH,40 + IDPB CH,OUT + JRST FSIXRL + +FSIXST: AOS (P) ;HERE TO CONVERT SIXBIT TO STRING. + SAVE C + MOVEI C,12. ;WE WILL NEED AT MOST 12 CHARS - MAKE SURE SPACE IS THERE. + CALL QOPEN + REST E ;NOW OUTPUT THE SIXBIT INTO STRING SPACE (LISTF5 AND BP + CALL SIXNTY ;SET UP BY QOPEN). + JRST QCLOSV ;WRITE THE HEADER AND RETURN THE STRING POINTER. + +FSIXFL: AOS (P) ;CONVERT SIXBIT TO STRING, PUTTING "FS" IN FRONT AND ALTMODE BEHIND. + SAVE C + MOVEI C,15. ;WORKS ALMOST LIKE FSIXST. + CALL QOPEN + MOVEI CH,"F ;BUT PUT IN THE "FS" NOW. + IDPB CH,BP + MOVEI CH,"S + IDPB CH,BP + REST E + CALL SIXNTY + MOVEI CH,ALTMOD ;PUT IN THE ALTMODE AT THE END. + IDPB CH,BP + JRST QCLOSV + +IFN ITS,[ +;FS D VERSI$ - RETURN OR SET DEFAULT VERSION NUMBERS +FSDVER: SAVE C + CALL FSFVER ;GET VALUE IN A CORRESPONDING TO OLD VALUE OF DEFAULT FN2. + JFCL + REST T + TRZN FF,FRARG ;ANY ARG GIVEN? + JRST POPJ1 ;NO, GO RETURN DEFAULT + JUMPE T,FSDVR3 ;0 = > + CAMN T,[-2] ;-2 = < + JRST FSDVR4 + JUMPL T,POPJ1 ;ARG IS -1 => DON'T CHANGE ANYTHING. + CAMLE T,[999999.] + TYPRE [ARG] ;ELSE MUST BE REASONABLE VERSION NUMBER. + SETZ C, ;ACCUMULATE IT HERE +FSDVR1: IDIVI T,10. + IORI C,'0(TT) + ROT C,-6 + JUMPN T,FSDVR1 ;KEEP GOING IF MORE NUMBER TO DO +FSDVR2: MOVEM C,DEFFN3 + JRST POPJ1 ;OK, WE SET THE DEFAULT, NOW RETURN PREVIOUS VALUE STILL IN A. + +FSDVR3: SKIPA C,[SIXBIT />/] ;0 = > +FSDVR4: MOVE C,[SIXBIT /" (FS D VERSION$ ONLY) +FSFVER: HLRZS E + SKIPN C,(E) ;GET SECOND FILENAME + JRST FSFVR2 ;BLANK ISNT A NUMBER + SETZ A, ;ACCUMULATE NUMBER HERE + CAMN C,[SIXBIT />/] ;CHECK FOR SPECIAL "NUMBERS" + JRST POPJ1 ;> = 0 + CAMN C,[SIXBIT / IF NEXT CHAR IS SPACE OR CR, IT SHOULD BREAK. +;FRNOT => NO NON-SPACE HAS BEEN SEEN YET ON THIS LINE + ;(SO SPACES SHOULD BE LIKE ORDINARY CHARS) +;FRFIND => PREVIOUS CHAR WAS ^H SO SPACE IS ORDINARY. +;FRSPAC => PREV. CHAR WAS SPACE, SO SPACE SHOULD BE ORDINARY AFTER IT +ADJUST: PUSHJ P,GETANU + EXCH C,E ;THROUGHOUT THE CMD, E -> 1ST CHAR AFTER RANGE TO JUSTIFY. + MOVEM C,PT + CALL GAPSLP + SAVE [0] ;THIS WD HAS STARTING HPOS OF LINE. + +;COME HERE TO PRODUCE 1 MORE LINE OF JUSTIFIED TEXT. +ADJLP0: ANDCMI FF,FRALT + MOVE IN,PT + MOVE D,IN ;D -> 1ST CHAR THAT MIGHT NOT FIT (DON'T KNOW YET) + ANDCMI FF,FRFIND+FRSPAC ;PREV. CHAR WASN'T ^H. OR SPACE. + TRO FF,FRNOT ;NO NON-SPACE HAS BEEN SEEN SO FAR. + MOVE J,(P) ;J HAS HPOS IN OUTPUT LINE, + SETZ OUT, ;OUT IS # WDS FOUND SO FAR. + SETZ Q, ;Q IS 0 IF WE HAVEN'T PASSED A CRLF, OR CHAR ADDR AFTER LAST CRLF. + SETZ C, ;C HAS # WDS AS OF LAST CRLF WE PASSED. + SAVE J ;(P) HAS WHAT J HAD WHEN IN HAD WHAT D HAS. + MOVE BP,IN + ADD BP,EXTRAC + CALL GETIBP ;WE WILL FETCH CHARS VIA BP. +ADJLP1: CAML IN,E + JRST ADJBRK ;PRETEND THERE'S A SPACE AFTER RANGE TO WORK ON. + ILDB CH,BP + AOJ IN, + CAIG CH,40 + JRST ADJCTL +ADJNRM: ANDCMI FF,FRALT\FRNOT\FRFIND\FRSPAC ;NORMAL CHAR ON PASS 1 OF FA. + AOJA J,ADJLP1 + +ADJCTL: CAIN CH,40 + JRST ADJSPC ;SPACE ENDS A WORD. + CAIN CH,^M + JRST ADJCR ;CR ENDS A WORD. + CAIN CH,^I + JRST ADJTAB + CAIN CH,^L ;^L MAKES A BREAK BEFORE AND AFTER THE LINE CONTAINING IT. + JRST ADJFF + CAIE CH,^H + JRST ADJNRM + TRZ FF,FRALT\FRNOT\FRSPAC + IORI FF,FRFIND + SOJGE J,ADJLP1 + AOJA J,ADJLP1 + +ADJFF: JUMPN Q,ADJFF1 ;^L: IF IT'S NOT ON THE LINE WE STARTED HACKING ON THIS CYCLE, + ;FILL UP TO THE CRLF BEFORE THE ^L, THEN CONSIDER IT AGAIN. + JRST ADJSK1 ;JUST SKIP OVER THE ^L, AND WHAT PRECEDES IT ON THE LINE. + +ADJTAB: TRNE FF,FRALT ;COME HERE FOR TAB + SOJA IN,ADJBRK ;TAB AT START OF LINE BREAKS. + IORI J,7 ;ELSE ADVANCE HPOS TO TAB STOP + ADDI J,1 + MOVEM J,-1(P) ;SAY NEXT OUTPUT LINE STARTS AT THAT STOP + JUMPE Q,ADJSK1 ;IF WE HAVEN'T PASSED A CRLF THIS TIME, SKIP PAST ALL BEFORE TAB. +ADJFF1: MOVE IN,Q ;ELSE BACK UP TO THE CRLF AND FILL UP TO IT. + MOVE OUT,C ;THEN NEXT TIME WE'LL SKIP ALL FROM CRLF TO THE TAB. + JRST ADJBRK + +;COME HERE ON SPACE +ADJSPC: TRNE FF,FRALT ;IF 1ST CHAR ON LINE, IT IS A BREAK. + JRST ADJSP1 + TRNN FF,FRFIND\FRSPAC\FRNOT ;ELSE IF SPACE FOLLOWS A WORD, + SKIPA B,BP ;THEN UNLESS + JRST ADJNSP + ILDB B,B ;IT IS FOLLOWED BY A BACKSPACE, WE END A WORD. + CAIE B,^H + JRST ADJSP1 +ADJNSP: TRZ FF,FRFIND\FRALT + AOJA J,ADJLP1 + +ADJCR: TRZE FF,FRFIND ;COME HERE ON CR. + AOJA IN,ADJBRK ;CR PRECEDED BY ^H CAUSES BREAK AFTER FOLLOWING LF. + TRNE FF,FRALT ;THIS CR ENDS NULL LINE => BREAK + SOJA IN,ADJBRK ;BEFORE IT. + ;THE PARAGRAPH WILL BE ENDED, AND WE'LL + ;COME BACK HERE WITH FRALT CLEAR, + ;AND DO THE JUMPE J, BELOW. + TRNE FF,FRNOT ;LINE OF ONLY SPACES IS A BREAK. + AOJA IN,ADJSKP + IBP BP ;SKIP THE LF ASSUMED TO FOLLOW THE CR. + AOS IN + MOVE Q,IN ;REMEMBER CHAR ADDR AND # WDS AS OF MOST RECENT CRLF. + MOVE C,OUT + JUMPE J,ADJSKP ;NULL LINE AT BEGINNING => PASS OVER IT. +ADJSP1: TRNE FF,FRALT ;SPACE AFTER CRLF; BREAK BEFORE THE SPACE + SOJA IN,ADJBRK ;SO SPACE WILL BE REPROCESSED FOR NEXT LINE. + JUMPE OUT,ADJSP2 ;PREVENT LOSSAGE FROM SUPERLONG WORD. + CAMLE J,ADLINE + JRST ADJGO ;WORD JUST ENDED WON'T FIT =>JUSTIFY THE OTHERS & NEW LINE. +ADJSP2: CAIN CH,^M + TRO FF,FRALT ;AFTER ^M, ANOTHER SPACE BREAKS. + TROE FF,FRSPAC ;AFTER A SPACE, DON'T COUNT A NEW WORD, BUT DO ADVANCE HPOS. + AOJA J,ADJLP1 + MOVEM J,(P) ;REMEMBER HOW FAR WE GOT IN BUFFER AND LINE. + MOVE D,IN + AOS J ;IF NEXT WD FITS, WILL NEED 1 POS FOR SPACE. + AOJA OUT,ADJLP1 + +ADJSKP: SETZM -1(P) +ADJSK1: MOVEM IN,PT ;PASS OVER SOME TEXT, NOT FILLING. + SUB P,[1,,1] + CALL GAPSLP + JRST ADJBR3 + +ADJBRK: SETZM (P) ;FILL THE LINE BEFORE A BREAK BUT NOJUST. + MOVE D,IN + TRO FF,FRALT ;INDICATE WE STOPPED AT A BREAK. + JRST ADJBR1 + +;COME HERE AFTER DELIMITING WHAT WILL BECOME ONE LINE, TO JUSTIFY IT. +ADJGO: MOVN J,(P) + ADD J,ADLINE + TRNE FF,FRUPRW ;JUST FILLING => INSERT NO SPACES. + SETZ J, + MOVEM J,(P) ;# SPACES MUST SCATTER THRU LINE. + +;(P) HAS # OF SPACES WE MUST INSERT TO JUSTIFY + ;(0 IF STOPPED AT A BREAK, IN WHICH CASE FRALT SET) +;OUT HAS # OF WORD-BREAKS IN THE LINE. +;-1(P) STILL HAS HPOS TO START NEXT LINE AT. +;E STILL HAS 1ST CHAR NOT TO BE PROCESSED BY THE FA COMMAND. +;D HAS CHAR ADDR OF 1ST CHAR NOT TO BE INCLUDED. +;IF FRALT IS SET (BREAK FOLLOWS), D IS EXACT. +;THE CRLF BEFORE D MAY HAVE PRECEDING SPACES, WHICH ARE DELETED. +;OTHERWISE, D POINTS AFTER THE SPACE OR CRLF AFTER THE LAST WORD TO INCLUDE. +;IN THIS CASE, THERE MAY BE MORE SPACES FOLLOWING, WHICH OUGHT TO BE DELETED. +;A CRLF AFTER THE SPACES SHOULD ALSO BE DELETED. +ADJBR1: SETZ J, + SOSG OUT + MOVEI OUT,1 + ANDCMI FF,FRFIND+FRSPAC + TRO FF,FRNOT ;NO NON-SPACE CHAR SEEN YET. + MOVE IN,PT ;IN IS CHAR ADDR FOR TAKING FROM ABOVE GAP, + MOVE BP,PT + CALL GETIBP ;BP IS BP FOR IDPBNG INTO BOTTOM OF GAP. +ADJGL: CAML IN,E + JRST POP2J ;AT END OF RANGE IN MID-LINE => DON'T PUT IN A CRLF. + CALL GETINC + CAIN CH,^M + JRST ADJGCR + CAIN CH,40 + JRST ADJGS +ADJGS4: CAMLE IN,D ;AT END OF THIS OUTPUT LINE & PAST ALL TRAILING SPACES + JRST ADJDUN ;=> INSERT THE CRLF AND HACK NEXT LINE. + ANDCMI FF,FRNOT+FRSPAC ;NON-SPACE SEEN. + CAIN CH,^H + TROA FF,FRFIND +ADJGS1: ANDCMI FF,FRFIND + IDPB CH,BP ;ORD. CHR., JUST COPY TO BELOW THE GAP. + AOS GPT + AOS PT + JRST ADJGL + +ADJGS: CAME E,IN ;SPACE AT END OF RANGE => DON'T CHECK FOLLOWING CHAR. + TRNE FF,FRNOT+FRFIND + JRST ADJGS1 ;SPACE AFTER BS OR BEFORE 1ST WD IS NORMAL CHAR. + CALL GETINC ;ELSE SEE IF FOLLOWED BY BS. + CAIE CH,^H + SOJA IN,[ ;NO, IT IS A WORD DELIMITER. + TRNN FF,FRALT ;IF LINE DOESN'T END WITH A BREAK, + JRST ADJCR1 ;MAKE SURE EXTRA SPACES PAST END ARE DELETED. + JRST ADJCR2] + MOVEI CH,40 + SOJA IN,ADJGS4 ;YES, IT IS ORDINARY. + +ADJGCR: ANDCMI FF,FRFIND ;CR: DELETE FOLLOWING LF IF ANY. + CALL GETCHR + CAIN CH,^J + CALL ADJDLC +ADJCR2: CAMGE IN,D ;CRLF (OR SPACE, IF THERE'S A BREAK HERE) PAST THE END OF THE LINE + JRST ADJCR1 ;MEANS WE HAVE FINISHED SKIPPING THE EXCESS MULTIPLE SPACES + CALL ADJDLC ;AND WE SHOULD JUST FLUSH THIS ONE AND PREVIOUS ONES + JRST ADJDUN ;AND PUT IN THE CRLF. + +ADJCR1: MOVEI CH,40 ;ALSO REPLACE THE CR WITH A SPACE. + TROE FF,FRSPAC ;A SPACE OR CR WHICH FOLLOWS A SPACE + JRST ADJGS1 ;SHOULD NOT HAVE SPACES INSERTED AFTER IT FOR JUSTIFICATION. + CAMGE IN,D + ADD J,(P) +ADJGS2: CAMGE J,OUT + JRST ADJGS1 + IBP BP ;TIME TO GENERATE A SPACE. + SUB J,OUT + AOS E + AOS D ;RELOC OUR PTRS TO BUFFER SINCE INSERTING CHAR. + AOS IN + CALL TYOM + JRST ADJGS2 ;SEE IF SHOULD INSERT ANOTHER SPACE. + +;COME HERE WHEN WE HAVE DONE PASS 2 ON A WHOLE LINE +ADJDUN: SUBI IN,2 ;WE HAVE JUST PASSED AT LEAST ONE SPACE INTO THE OUTPUT LINE. + JRST ADJEND ;MAKE IN POINT AT IT. IN SHOULD BE GPT-1 NOW. + +ADJDUD: CALL ADJDLB +ADJEND: CALL GETCHR ;DELETE ANY SPACES WHICH WOULD OTHERWISE BE LEFT AT + CAIN CH,40 ;THE END OF THE LINE, BEFORE THE CRLF WE ARE ABOUT TO MAKE. + JRST ADJDUD +ADJDU1: REST J + MOVEI CH,^M ;PRODUCED A LINE, PUT CRLF AFTER IT, REPLACING THE SPACE THERE. + CALL TYOM + MOVEI CH,^J + CALL TYOM + ADDI E,2 ;RELOCATE PTR TO BUFFER ABOVE PLACE INSERTED IN. + SETZM (P) ;NEXT LINE STARTS IN COLUMN 0. +ADJBR3: CAMLE E,PT ;MORE CHARS TO HANDLE => + JRST ADJLP0 ;DO ANOTHER LINE. + JRST POP1J + +ADJDLB: SOS PT + SOS GPT + SOS IN +ADJDLC: AOS EXTRAC ;DELETE THE CHAR AT PT. + SOS Z + SOS E + SOS ZV + SOJA D,CPOPJ + +SUBTTL F^A DISPATCH-TABLE COMMAND + +;"F^A" SCAN THROUGH THE BUFFER, DISPATCHING THROUGH A +;USER-SUPPLIED TABLE ON EACH CHARACTER. +;"^ F^A" SCANS BACKWARDS. +FCACMD: CALL QREGX ;GET DISPATCH TABLE IN A. + LDB OUT,[.BP FRCLN,FF] + TRZ FF,FRCLN + CALL GETANU ;E,C HAVE RANGE TO SCAN. + DPB OUT,[.BP FRCLN,FF] + TRNE FF,FRUPRW + EXCH C,E ;E HAS PLACE TO START; C HAS PLACE TO STOP. + MOVEM E,PT + MOVEI TT,FCA1 ;LOOP POINT IF FCA1 FOR FORWARD SCAN. + TRZE FF,FRUPRW + MOVEI TT,FCA3 ;FCA3 FOR BACKWARD SCAN. + SAVE FF + SAVE TT + MOVE OUT,QRB.. ;SAVE DISPATCH TABLE STRING IN .Q..3 + MOVEM A,.Q..3(OUT) +FCA0: CALL QLGET1 ;GET LENGTH IN B, BP IN BP. + TYPRE [QNS] + CAIGE B,128.*5 + TYPRE [STS] ;STRING TOO SHORT. + JRST @(P) ;FCA1 OR FCA3 + +;LOOP POINT FOR FORWARD SCAN. +;BP HAS BP TO ILDB TABLE; +;C HAS CHAR ADDR OF LAST CHAR TO SCAN + 1. +FCA1: MOVE IN,PT + CAML IN,C + JRST POP2J ;FINISHED SCAN => RETURN. + CALL GETINC + MOVEM IN,PT +FCA4: TRNE FF,FRTRACE + CALL FCATRC ;PRINT PRETTY INFO IF TRACING. + MOVEM CH,.Q..0(OUT) ;SAVE CHAR IN CASE MACRO WANTS IT. + ADD CH,BP ;FIND THE 5 CHARS OF TABLE FOR THIS CHR. + ILDB A,CH ;IS THE FIRST A SPACE? + CAIE A,40 + JRST FCA2 ;NO, MACRO THE 5 CHARS. + ILDB A,CH ;YES, THE NEXT CHAR HOLDS THE WIDTH + SUBI A,100 + ADDM A,.Q..1(OUT) ;OF THIS CHAR, PLUS 100 . + ILDB A,CH ;GET THE 3RD CHAR OF THE FIVE. + CAIN A,40 ;"(" AND ")" ARE SPECIAL, " " IS NORMAL. + JRST @(P) ;FCA1 OR FCA3 + HRRZ CH,(P) ;IT'S SPECIAL. WHICH DIRECTION ARE WE SCANNING? + CAIE A,") ;IF CODE IS ")", + JRST FCAOPN + SKIPGE .Q..1(OUT) ;STOP IF COUNT < 0 AND GOING FORWARD. + CAIE CH,FCA1 + JRST (CH) + JRST POP2J + +FCAOPN: SKIPLE .Q..1(OUT) ;CODE IS "("; STOP IF COUNT > 0 AND GOING BACKWARD. + CAIE CH,FCA3 + JRST (CH) + JRST POP2J + +FCA3: MOVE IN,PT ;LOOP POINT FOR SCANNING BACKWARDS + CAMG IN,C + JRST POP2J + SOS IN,PT + CALL GETCHR + JRST FCA4 + +;IN TRACE MODE, CALL HERE TO PRINT !! FOR EACH CHAR WE PASS. +FCATRC: SAVE CH + MOVEI CH,"! + CALL TYOS + MOVE CH,(P) + CALL TYOS + MOVEI CH,"! + CALL TYOS + JRST POPCHJ + +;HERE FOR A CHAR WHICH REQUIRES THAT WE ACTUALLY MACRO SOME STUFF. +FCA2: MOVN TT,(P) + ADDI TT,FCA1 ;TT IS POS. IFF SCANNING FORWARD. +IFL FCA3-FCA1,.ERR + ASH TT,-43 ;-1 IFF BACKWARD, 0 IFF FORWARD. + IORI TT,1 ;-1 IFF BACKWARD, 1 IFF FORWARD. + MOVEM TT,INSLEN ;MAKE "^F" REPLACE THE CHAR SCANNED. + JUMPG TT,[ SUB C,ZV ;IF FORWARD, STORE END OF RANGE AS DISTANCE FROM Z. + MOVNM C,.Q..2(OUT) + JRST FCA5] + SUB C,BEGV ;GOING BACKWARD, STORE DISTANCE FROM C. + MOVEM C,.Q..2(OUT) +FCA5: MOVE B,.Q..0(OUT) + ADD BP,B + MOVE E,-1(P) + TRNE E,FRCLN ;:F^A TREATS DISPATCH TABLE AS A QVECTOR. + JRST [ IBP BP ;IT EXTRACTS A WORD, AND TREATS IT AS A STRING POINTER TO A MACRO. + MOVE A,(BP) + CALL MACXQ + JRST FCA7] + MOVE A,.Q..3(OUT) + MOVEI B,5 ;MACRO A STRING THAT IS AN INITIAL + ;SEGMENT OF THE DISPATCH TABLE, ENDING AFTER THE + ;FIFTH OF THE CHARS FOR THE CHAR JUST SCANNED. + ;WANT TO SET COMCNT TO 5. + CALL MACXC2 ;EXECUTE THEM. +FCA7: MOVE OUT,QRB.. + MOVE TT,(P) + CAIN TT,FCA1 + JRST [ MOVN C,.Q..2(OUT) + ADD C,ZV ;SEE HOW THE MACRO HAS CHANGED END OF RANGE. + JRST FCA6] ;MUST USE DIFFERENT CODE DEPENDING ON HOW IT WAS STORED. + MOVE C,.Q..2(OUT) + ADD C,BEGV +FCA6: CAMGE C,BEGV ;DON'T LET END OF RANGE GET OUTSIDE VIRTUAL BOUNDARIES. + MOVE C,BEGV + CAMLE C,ZV + MOVE C,ZV + MOVE A,.Q..3(OUT) + JRST FCA0 + +POP2J: SUB P,[2,,2] + POPJ P, + +SUBTTL F^B COMMAND + +;F^B$ - RETURNS -1 IF DOES NOT OCCUR IN ; +; OTHERWISE RETURNS THE POSITION OF THE FIRST OCCURRENCE +; (0 IF IS THE FIRST CHARACTER OF ). +;AT CALL, IS IN C. THIS COULD BE SMARTER: +; IF IS FOUND IN THE MIDDLE OF A SUBSTITUTED QREG WITHIN , +; WE COULD JUST POP OUT OF IT RATHER THAN READING THROUGH IT. +;,F^B$ SKIPS CHARS OF BEFORE LOOKING FOR . +FMEMQ: TRNE FF,FRUPRW + JRST FFIND + TRZN FF,FRARG + TYPRE [WNA] + TRZN FF,FRARG2 + SETZ E, ;E IS PLACE TO START SEARCHING (0, FOR 1ST CHAR, IF NO ARG). + MOVE B,MACPDP + SETZ A, ;A COUNTS THE CHARS WHICH AREN'T . +FMEMQ1: CALL RCH + SKIPN SQUOTP ;NO; REACHED END OF STRING? + CAIE CH,ALTMOD + CAIA ;NO, SEE IF REACHED DESIRED CHARACTER (OUR NUMERIC ARG) + JRST NRETM1 ;YES, RETURN -1 + CAIE C,(CH) + AOJA A,FMEMQ1 ;DIDN'T REACH CHAR BEING SEARCHED FOR. + CAMGE A,E + AOJA A,FMEMQ1 ;REACHED IT, BUT BEFORE WHERE WE ARE SUPPOSED TO BE LOOKING. + CALL FNOOP ;FOUND . NOW IGNORE REST OF STRING + JRST POPJ1 ;AND RETURN THE VALUE, ALREADY IN A. + +;HERE FOR ^ F^B$ - FIND NEXT OCCURRENCE IN THE BUFFER +;OF A CHARACTER NOT IN , AND RETURN .,. +;^:F^B$ RETURNS .,. +;AN ARGUMENT OF -1 CAUSES SCANNING TO GO BACKWARDS INSTEAD. +;THUS, ^ F^B $K KILLS ALL SPACES AFTER POINT, AND ^-F^B $K KILLS ALL THOSE BEFORE. +;WITH 2 ARGS ,, WE JUMP TO AND THEN SCAN TOWARD . +FFIND: JSP BP,FLCMD1 ;FLCMD1 CALLS US TO MOVE POINT TO OTHER END OF RANGE, + ;THEN CALCULATES AND RETURNS THE RANGE AS TWO VALUES. + CALL INDARG ;READ IN THE STRING. ST+1 HAS 1ST CHAR. + TRNN FF,FRARG2 + JRST FFINDA + ADD C,BEG ;2 ARGS GIVE RANGE TO SCAN. CONVERT TO INTERNAL CHAR ADDRS. + ADD E,BEG + CALL CHKC ;BARF IF E NOT IN BUFFER. + CALL CHK ;BARF IF C NOT IN BUFFER. + MOVEM E,PT ;1ST ARG SAYS WHERE TO START THE SCAN. + MOVE OUT,C ;2ND ARG SAYS WHERE TO STOP. + SUB C,E ;SIGN OF C GETS DIRECTION OF SEARCH (AS IF JUST 1 ARG). + JRST FFINDZ + +FFINDA: SKIPL C ;HERE FOR JUST 1 ARG. OUT GETS PLACE TO STOP SCAN. + SKIPA OUT,ZV + MOVE OUT,BEGV +FFINDZ: MOVE IN,PT ;J POINTS AT WORD AFTER THE LAST CHAR IN STAB. + CALL GETIBI ;GOING FWD => GET B.P. TO ILDB CHAR AFTER POINT. + JUMPL C,FFINDB ;GOING BACKWARD => ALTER THAT. +FFINDC: CAMN IN,OUT ;IN AND PT ARE THE SAME. BP HAS B.P. TO ILDB CHAR AT PT. + RET + CAMN IN,GPT ;HANDLE MOVING ACROSS THE GAP. + CALL FEQGAP + ILDB CH,BP +FFINDS: MOVEI A,STAB ;HERE FOR EITHER FWD OR BACKWD SCAN, TO SEE IF CHAR IS IN +FFIND1: CAMN A,J ;THE STRING. + JRST [ TRNN FF,FRCLN ;NO => FOR NON-COLON, WE HAVE FOUND END OF RANGE. + RET + JRST FFIND2] + CAME CH,(A) + AOJA A,FFIND1 + TRNE FF,FRCLN ;YES => FOR ^:F^B WE HAVE FOUND THE END OF THE RANGE. + RET +FFIND2: JUMPL C,FFINDD ;NOT AT END => MOVE TO NEXT CHARACTER. + AOS IN,PT + JRST FFINDC + +FFINDB: IBP BP ;MOVE BACKWARRD, THE FIRST TIME. + CAIA +FFINDD: SOS IN,PT ;MOVE BACKWARD AGAIN. + CAMN IN,OUT + RET + CAMN IN,GPT + CALL DWNGAP + DBP7 BP + LDB CH,BP + JRST FFINDS + +;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD IN STAB. +;LEAVE J -> LAST WORD USED IN STAB + 1. USED BY @F^B. +;CLOBBERS A, CH. +INDARG: MOVEI J,STAB +INDA1: CALL RCH + SKIPE SQUOTP + JRST INDA2 + CAIN CH,ALTMOD + RET +INDA2: CAIN J,STAB+LTABS + TYPRE [STL] + HRRZM CH,(J) + AOJA J,INDA1 + +SUBTTL WORD AND LIST PARSING COMMANDS + +FWCMD: MOVEI BP,WORDSP + JRST .+2 +FLCMD: MOVEI BP,LISTSP +FLCMD1: ARGDFL Z + CALL IMMQIT ;ALLOW IMMEDIATE QUITTING IN CASE WE HAVE FAR TO SEARCH. + SAVE PT + SETZM SEXPFL + CALL (BP) + MOVE E,PT + REST C + MOVEM C,PT + CAMGE C,E + EXCH C,E + SUB C,BEG + SUB E,BEG + MOVEM E,SARG + MOVE A,C + TRZ FF,FRUPRW+FRCLN + TRO FF,FRARG2 + SETZM IMQUIT ;STOP ALLOWING IMMEDIATE QUITTING. + JRST POPJ1 + +FUCMD: JSP BP,FLCMD1 + SETZM DOWNF + MOVM D,C + MOVNS D +FUCMD1: JUMPE D,CPOPJ + HLRES C + JRST LISTSQ + +FDCMD: JSP BP,FLCMD1 + SETOM DOWNF + MOVM D,C + JRST FUCMD1 + +;THIS ROUTINE TAKES ARG IN C, AND DOES FWL. +;FS INSLEN IS SET TO LENGTH OF LAST WORD OR INTER-WORD-SPACE SEEN +;(NOTE IF YOU START WITHIN A WORD, FS INSLEN$ MIGHT NOT BE WHAT YOU WANT). +;IF SEXPFL IS SET, ASSUMES WAS REACHED FROM ^ FL, AND GOES BACK THERE +;AFTER FINDING ONE WORD. +;THE UPARROW FLAG CAUSES SCANNING TO BE FOR LISP ATOMS INSTEAD OF WORDS. +WORDSP: CALL SKNBCP ;INITIALIZE SO WE CAN CALL SKNBRK. + TRNE FF,FRUPRW + IBP SKNBPT ;FOR LISP, USE 2ND CHAR OF DISPATCH ENTRY RATHER THAN 1ST. + JUMPL C,WBACK + JUMPE C,CPOPJ + CALL LFINIT ;SET UP E, IN, BP. +WFVBA1: SKIPE SEXPFL ;HERE TO START WORD-GAP, TREATING LAST CHAR SEEN AS PART OF PREV. WORD. + JRST LFLOOP + MOVE B,E ;SAVE E IN B EVERY SO OFTEN. E-B WILL BE VALUE OF INSLEN. + SOSA B +WFSBEG: MOVE B,E ;LIKE WFVBA1, BUT COUNT LAST TERMINATOR AS PART OF THIS GAP. + SKIPE SEXPFL + JRST LFDSP +WFSLUP: SOJLE E,WFSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT + CAIE A,"; + CAIN A,"A + JRST WFSEND + CAIE A,"/ + CAIN A,"| + JRST WFSEND + JRST WFSLUP + +WFSEND: TRNE FF,FRCLN +WFVBA2: SOJLE C,WFDONC + MOVE B,E + CAIN A,"| + JRST WFVBAR ;WIN IN CASES LIKE |FOO||BAR| + JRST WFWDSP ;NOW PROCESS CHAR THAT STARTS THE WORD AS IF FOUND IT INSIDE WORD + +;HERE WHEN A :FW FINDS START OF WORD AND THINK'S IT IS FINISHED. +WFDONC: TRNN FF,FRUPRW ;IF IT WAS AN ^:FW, AND LAST CHAR WAS A ', BACK UP OVER IT. + JRST WFDONE + CAMN E,IN + CALL DWNGAP + AOS E ;AND KEEP BACKING UP PAST ALL '-TYPE CHARS. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST WFDONC + SOJA E,WFDONE + +WFWLUP: SOJLE E,WFWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL FEQGAP ;MAKE BP POINT ABOVE IT. + ILDB A,BP + LDB A,SKNBPT +WFWDSP: CAIE A,"; + CAIN A,"A + JRST WFWLUP + CAIN A,"' ;' CHARS CAN CONTINUE A WORD, BUT NOT START ONE. + JRST WFWLUP + CAIN A,"/ + JRST WFSLSH + CAIN A,"| ;| INSIDE WORD IS CASE OF FOO|BAR|, WHICH IS 2 WORDS, + JRST [ TRNE FF,FRCLN ;SO END THIS WORD AND IMMEDIATELY START ANOTHER. + MOVE B,E + JRST WFVBA2] +WFWEND: TRNE FF,FRCLN + JRST WFSBEG + SOJG C,WFSBEG +WFDONE: SUB B,E + SUB E,ZV + MOVNS E + JRST WORD12 + +WFSEOB: TRC FF,FRCLN ;WENT FWD PAST Z, BETWEEN WORDS. +WFWEOB: SOJG C,TYPNIB ;WENT FWD PAST Z, IN MIDDLE OF WORD. + TRNE FF,FRCLN + JRST TYPNIB + JRST WFDONE + +WFSLSH: CALL LFSLSH ;HANDLE A SLASH-CHARACTER GOING FORWARD. + JRST WFWLUP + +WFVBAR: CALL LFVBAR ;VERTICAL BAR: SKIP TO MATCHING ONE. + TRNN FF,FRCLN ;IF TIME TO STOP MOVING, MAKE SURE CLOSING VBAR + SOJLE C,[SOJA E,WFDONE] ;COUNTS AS PART OF WORD, NOT PART OF GAP. + ;IF MUST KEEP GOING, DO SO, BUT DON'T COUNT + JRST WFVBA1 ;THE VBAR AS PART OF THE GAP THAT'S STARTING. + +;MOVE BACKWARDS OVER WORDS. + +WBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +WBVBA1: SKIPE SEXPFL + JRST LBLOOP + MOVE B,E + SOSA B +WBSBEG: MOVE B,E + SKIPE SEXPFL + JRST LBDSP +WBSLUP: SOJL E,WBSEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIE A,"A + CAIN A,"| + JRST WBSEND + CAIN A,"; + JRST WBSEND + CAIE A,"/ + JRST WBSLUP +WBSLSH: SAVE E ;FOUND A SLASH GOING BACKWARD. + SAVE BP ;IF IT'S SLASHED, IT ENDS A WORD; ELSE FOLLOWING CHAR + CALL REALP ;IS SLASHED AND ENDS THE WORD. + JFCL ;BIT 1.1 OF CH IS 1 IF SLASH IS SLASHED. + REST BP + REST E + TRNE CH,1 + JRST WBSEND + IBP BP + AOJ E, +WBSEND: TRNE FF,FRCLN +WBVBA2: SOJLE C,WBDONE + MOVE B,E + CAIN A,"| + JRST WBVBAR + JRST WBWDSP + +WBWLUP: SOJL E,WBWEOB + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT +WBWDSP: CAIE A,"; + CAIN A,"A + JRST WBWLUP + CAIN A,"| + JRST [ TRNE FF,FRCLN + MOVE B,E + JRST WBVBA2] + CAIE A,"' + CAIN A,"/ + JRST WBWLUP + SAVE BP + SAVE E + CALL REALP + JFCL + REST E + REST BP + TRNE CH,1 + JRST WBWLUP +WBWEND: TRNE FF,FRCLN + JRST WBSBEG + SOJG C,WBSBEG +WBDONE: SUBM E,B + AOJ E, + ADD E,BEGV +WORD12: MOVEM E,PT + MOVEM B,INSLEN + TRZ FF,FRCLN+FRUPRW + RET + +WBSEOB: TRC FF,FRCLN +WBWEOB: SOJG C,TYPNIB + TRNE FF,FRCLN + JRST TYPNIB + JRST WBDONE + +WBVBAR: CALL LBVBAR ;MOVE BACK OVER A VERTICAL BAR GROUPING. +WBVBA4: JUMPE E,WBVBA3 ;THEN BACK OVER ALL ' CHARACTERS BEFORE IT. + SAVE E + SAVE BP + SOJ E, + CAMN E,IN ;IF WE'VE REACHED THE GAP, + CALL DWNGAP ;MAKE BP POINT BELOW IT. + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + JRST [ SUB P,[2,,2] + JRST WBVBA4] + REST BP + REST E +WBVBA3: TRNN FF,FRCLN ;IF IT'S TIME TO STOP MOVING, SAY WE STOPPED AFTER PASSING THE + SOJLE C,[SOJA E,WBDONE] ;VBAR, INSTEAD OF BEFORE, AS WE WOULD STOP AT A SPACE. + JRST WBVBA1 ;IF KEEP MOVING, DON'T INCLUDE THE VBAR IN THE NEW GAP. + +LISTSP: TRNE FF,FRUPRW + SETOM SEXPFL + SETZB D,DOWNF + JUMPE C,CPOPJ +LISTSQ: CALL SKNBCP ;SET UP SKNBPT FROM ..D + IBP SKNBPT + JUMPL C,LBACK + CALL LFINIT ;SET UP BP, E, IN. +LFLOOP: SOJLE E,LFEOB ;AFTER THIS INSN E HAS # CHARS LEFT TO SCAN. + CAMN E,IN ;IF WE'RE ABOUT TO ILDB INTO THE GAP, CROSS IT: + CALL FEQGAP ;(BP <- BP TO ILDB 1ST CHAR AFTER GAP). + ILDB A,BP + LDB A,SKNBPT ;GET DISPATCH ENTRY OF THIS CHARACTER. +LFDSP: CAIN A,"/ + JRST [ TRNE FF,FRUPRW ;FOR ^ FL, REMEMBER SLASH STARTS AN ATOM. + JUMPE D,WFSEND + CALL LFSLSH + JRST LFLOOP] + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WFSEND + CALL LFVBAR + JRST LFLOOP] + CAIE A,"; + CAIN A,"A ;SEMICOLON AND LETTERS START ATOMS. + TRNN FF,FRUPRW + JRST LFFOO1 + JUMPE D,WFSEND +LFFOO1: CAIN A,"( + JRST LFLPAR + CAIE A,") + JRST LFLOOP + SKIPE DOWNF + AOJA D,LFLOOP + AOJL D,LFLOOP + SETZ D, ;MAKE SURE 2FLL SAME AS FLL FLL. + SOJG C,LFLOOP +LFDONE: SUB E,ZV + TRC FF,FRCLN + JRST LISTX + +LFEOB: JUMPL D,[TYPRE [UBP]] ;UNBALANCED PARENTHESES +TYPNIB: TYPRE [NIB] + +LFSLSH: SOJLE E,TYPUEB ;HANDLE "/" GOING FORWARD. + CAMN E,IN ;IF WE'VE REACHED THE GAP, MAKE BP CROSS IT. + CALL FEQGAP + IBP BP + RET + +TYPUEB: TYPRE [UEB] + +LFLPAR: TRNE FF,FRCLN ;:FL => STOP BEFORE ( INSTEAD OF AFTER IT AS FOR FD. + JUMPE D,[SOJE C,LFCDON ;ALSO, :FL BACKS OVER ''S WHILE FD DOESN'T. + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LFLOOP + SOJG D,LFLOOP + JRST LFDONE + +LFCDON: MOVNS E + ADD E,ZV ;TURN INTO CHAR ADDR OF THE (. + TRZ FF,FRCLN ;DON'T LET LISTX MUNG IT. + TRNE FF,FRUPRW ;FOR ^:FL, +LFCDO1: CAMG E,BEGV ;SCAN BACKWARD PAST ANY QUOTES BEFORE THE (. + JRST LISTX + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + SOJA E,LFCDO1 + JRST LISTX + +LFVBAR: SOJLE E,TYPUEB ;HANDLE "|" GOING FORWARD. + CAMN E,IN + CALL FEQGAP ;WHEN REACH GAP, MOVE OVER IT. + ILDB A,BP + LDB A,SKNBPT ;DECODE NEXT CHARACTER. + CAIN A,"/ + JRST [ CALL LFSLSH ;SLASH => DON'T CHECK NEXT CHAR FOR BEING A "|". + JRST LFVBAR] + CAIE A,"| + JRST LFVBAR ;FIRST UNSLASHIFIED "|" ENDS THE STRING. + RET + +;MOVE BACKWARD OVER LISTS. + +LBACK: MOVMS C + CALL LBINIT ;SET UP BP, E, IN. +LBLOOP: SOJL E,LFEOB + CAMN E,IN ;IF ABOUT TO DLDB INTO LAST CHAR OF GAP, + CALL DWNGAP ;MAKE BP -> LOWEST CHAR. OF GAP. + DBP7 BP +LBDSP: LDB A,BP + LDB A,SKNBPT + CAIN A,"| + JRST [ TRNE FF,FRUPRW + JUMPE D,WBSEND + CALL LBVBAR + JRST LBLOOP] + TRNN FF,FRUPRW ;IF ^ FL, NOTE THAT LETTERS AND SLASH START ATOMS + JRST LBFOO1 + CAIN A,"A + JUMPE D,WBSEND + CAIN A,"/ ;FOR SLASH, THE CHAR AFTER IT (ALREADY SCANNED) + JUMPE D,WBSLSH ;IS ALSO PART OF THE ATOM. +LBFOO1: CAIN A,") + JRST LBRPAR + CAIE A,"( + JRST LBLOOP + CALL REALP + JRST LBQOTD + SKIPE DOWNF + AOJA D,LBLOOP + AOJL D,LBLOOP + SETZ D, + SOJG C,LBLOOP + TRNN FF,FRUPRW ;FOUND MATCHING OPENPAREN. NOW, IF PASSING SEXPS, + JRST LBDONE +LBQOT1: MOVE B,E ;SKIP OVER ANY NO-SLASHIFIED '-LIKE CHARACTERS + SOJL E,LBQOT2 ;THAT PRECEDE THE OPENPAREN. + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"' + CALL REALP +LBQOT2: SKIPA E,B + JRST LBQOT1 +LBDONE: ADD E,BEGV +LISTX: MOVMM E,PT + TRZE FF,FRCLN + AOS PT + POPJ P, + +LBVBAR: CALL REALP ;HANDLE "|" GOING BACKWARDS. + RET +LBVBLP: SOJL E,TYPUEB + CAMN E,IN + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"| + CALL REALP + JRST LBVBLP + RET + +LBRPAR: CALL REALP ;HANDLE ")", MOVING BACKWARD. + JRST LBQOTD + TRNE FF,FRCLN + JUMPE D,[SOJE C,LBDONE + AOJA C,.+1] + SKIPN DOWNF + SOJA D,LBLOOP + SOJG D,LBLOOP + JRST LBDONE + +LBQOTD: MOVEI A,"A ;SLASHIFIED PAREN HAS "ALPHABETIC" SYNTAX + TRNE FF,FRUPRW ;AND CAN START (END?) AN ATOM. + JUMPE D,WBSEND + JRST LBLOOP + +;INITIALIZATION AND AUXILIARY ROUTINES FOR FW AND FL. + +;SET UP BP, E, IN FOR GOING FORWARD. +LFINIT: MOVE BP,PT + CAML BP,GPT + ADD BP,EXTRAC ;GET REAL CHAR ADDR OF CHAR AFTER PT. + CALL GETIBP + MOVE IN,ZV + SUB IN,GPT ;THIS IS WHAT E WILL HAVE WHEN GAP IS REACHED. + MOVE E,ZV + SUB E,PT + AOJA E,CPOPJ + +;BP GETS A B.P. TO THE 1ST CHARACTER OF THE GAP, TO DLDB INTO THE REGION +;BELOW THE GAP. +DWNGAP: MOVE BP,GPT + JRST GETBP + +;SET UP BP, E, IN FOR GOING BACKWARD. +LBINIT: MOVE BP,PT + CAMLE BP,GPT ;BP GETS REAL CHAR ADDR +1 OF CHAR BEFORE PT. + ADD BP,EXTRAC + CALL GETBP ;BP SET UP FOR DLDB. + MOVE E,PT + SUB E,BEGV + MOVE IN,GPT ;IN USED FOR DETECTING THAT GAP IS REACHED. + SUB IN,BEGV ;CHECK: IF PT = GPT NOW, E WILL = IN THE FIRST TIME THRU. + SOJA IN,CPOPJ + +;DURING BACKWARD SCAN, CHECK WHETHER THE CHAR JUST REACHED WAS SLASHIFIED. +;MOVES BP AND E BACK OVER THE SLASHES, LEAVES THEM AS IF 1ST OF THE SLASHES +;WAS JUST GOBBLED. IF # SLASHES IS EVEN (CHAR IS NOT SLASHIFIED), +;BIT 1.1 OF CH WILL BE 0, AND REALP WILL SKIP. +REALP: SETZI CH, +REALP3: SOJL E,REALP1 + CAMN IN,E + CALL DWNGAP + DBP7 BP + LDB A,BP + LDB A,SKNBPT + CAIN A,"/ + AOJA CH,REALP3 + IBP BP +REALP1: AOJ E, + TRNN CH,1 + AOS (P) + POPJ P, + +;F^F IS TH HAIRY FORWARD-ONLY LIST PARSER. +;IT TAKES A "STATE" WHICH INCLUDES THE PAREN DEPTH AS AN ARGUMENT, +;PARSES FROM POINT TO A SPECIFIED PLACE, AND RETURNS THE UPDATED STATE. +;DO ,F^F AND IT RETURNS THE NEW STATE. +;THE STATE'S RH IS TH PAREN DEPTH. THE LH IS BITS, AS FOLLOWS: +; 100,, => INSIDE A COMMENT. +; 4,, => INSIDE VERTICAL BARS. +; 2,, => INSIDE OR RIGHT AFTER AN ATOM. +; 1,, => SLASHIFIED. +;WE ARE INSIDE (AS OPPOSED TO ADJACENT TO) AN ATOM IF 4,, OR 1,, IS SET, +;OR IF 2,, IS SET AND THH NEXT CHARACTER HAS A OR / SYNTAX. +;WHEN WE RETURN, Q..0 GETS THE ADDRESS AFTER THE LAST OPEN-| OR ; SEEN; +;Q..1 GETS THE ADDRESS OF THE LAST UNMATCHED (, OR -1; +;Q..2 GETS THE ADDRESS OF THE START OF THH LAST SEXP, OR -1. + +;SCANNING STOPS WHEN IT REACHES THE SPECIFIED ADDRESS, +; OR WHEN THE PAREN DEPTH REACHES 0. +;FOR :F^F, SCAN ALSO STOPS WHEN AFTER ANY ATOM-START CHARACTER. + + +FCTLF: TRZE FF,FRARG + TRZN FF,FRARG2 + TYPRE [WNA] ;WE MUST HAVE 2 ARGS. AND DISCARD THEM. + SETZ OUT, + TRZE FF,FRCLN ;OUT GETS BITS OF STATE WHICH ARE TERMINATING CONDITIONS. + MOVSI OUT,7 + ADD C,BEG + CALL CHK ;CALCULATE AND VALIDATE ADDRESS TO STOP SCANNING AT. + CALL SKNBCP + IBP SKNBPT ;SKNBPT IS B.P. TO LDB LISP SYNTAX OF CHAR IN CH. + MOVEI TT,CH ;PUT "CH" IN INDEX FIELD TO MAKE THAT TRUE. + DPB TT,[220600,,SKNBPT] + SKIPGE A,E ;KEEP THE STATE IN A. NEGATIVE NUMBER AS ARG + ANDI A,-1 ;MEANS A NEGATIVE PAREN DEPTH, WITH STATE BITS 0. + MOVE CH,QRB.. + SETOM .Q..0(CH) ;SO FAR WE HAVE NOT SEEN ANY ( OR |. + MOVE IN,PT + CALL GETIBI ;IN GETS SCAN POINT AS VIRT ADDR, BP GETS BP TO ILDB. + CAMLE IN,C + TYPRE [2%1] + MOVE Q,P + SETZB D,B ;D HAS ADDR+1 OF START OF SEXP THHT ENDED LAST, OR 0. + ;B HAS STATE BEFORE LAST CHARACTER SCANNED. +FCTLFL: TLNN B,7 ;IF LAST CHAR WASN'T IN OR AFTER AN ATOM, + TLNN A,7 ;AND THIS ONE WAS, + CAIA ;THEN WE HAVE JUST STARTED AN ATOM, + MOVE D,IN ;SO REMEMBER . AS ADDR+1 OF LAST SEXP'S START. + MOVE B,A + TDNN A,OUT ;STOP CONDITION MET OR REACHED END OF RANGE => + CAMN IN,C ;RETURN, SETTING APPRO. Q-REGS. + JRST FCTLFX + CAMN IN,GPT + CALL FEQGAP ;WHEN WE COME TO TH GAP, MOVE TH B.P. OVER IT. + AOS IN,PT + ILDB CH,BP + TLZE A,1 ;PREVIOUS CHARACTER WAS SLASH => DON'T CHECK THIS ONE. + JRST FCTLFL + TLZ A,2 + LDB CH,SKNBPT + TLNE A,100 ;INSIDE A COMMENT, ONLY CR IS INTERESTING. + JRST [ CAIN CH,^M + TLZ A,100 + JRST FCTLFL] + CAIN CH,"/ + JRST [ TLO A,3 + JRST FCTLFL] + CAIN CH,"| + JRST [ MOVE CH,IN ;| => COMPLEMENT IN-|-NESS, + SUB CH,BEG ;AND IF THIS IS ENTERING A PAIR, + TLCN A,4 ; REMEMBER THE ADDRESS IN Q..0. + MOVEM CH,@QRB.. + JRST FCTLFL] + TLNE A,4 + JRST FCTLFL ;WITHIN VERTICAL BARS => ONLY | AND / ARE SPECIAL. + CAIN CH,"; + JRST [ MOVE CH,IN ;ELSE ; STARTS A COMMENT, AND REMEMBER ITS ADDRESS. + SUB CH,BEG + MOVEM CH,@QRB.. + TLO A,100 + JRST FCTLFL] + CAIN CH,"A + TLO A,2 + CAIN CH,"( + JRST [ HRRI A,1(A) ;( => PUSH ITS ADDRESS+1 SO WE CAN + PUSH P,IN ;FIND THE LAST UNMATCHED ONE. + JRST FCTLF1] ;ALSO INCREMENT THE DEPTH COUNTER. + CAIE CH,") + JRST FCTLFL + CAME Q,P ;) => POP ADDR+1 OF THE MATCHING (, IF ANY. + POP P,D ;IT BECOMES THE ADDR+1 OF THE LAST SEXP TO START. + HRRI A,-1(A) ;DECREMENT THE DEPTH. +FCTLF1: TRNE A,-1 ;IF THE DEPTH EVER BECOMES 0 AFTER A PAREN, EXIT. + JRST FCTLFL +FCTLFX: CAME Q,P ;EXIT: GET ADDRESS OF LAST UNMATCHED (, + SOSA IN,(P) ;OR -1 IF THERE IS NONE. + SKIPA IN,[-1] + SUB IN,BEG + MOVE CH,QRB.. + MOVEM IN,.Q..1(CH) ;STORE THAT IN Q..1 + SOSLE D + SUB D,BEG ;TURN D INTO REL CHAR ADDR OF + MOVEM D,.Q..2(CH) ;THE START OF THE LAST SEXP. PUT IN Q..2 + MOVE P,Q ;FLUSH SAVED ( ADDRESSES FROM THE STACK. + JRST POPJ1 ;RETURN THE NEW STATE, WHICH IS IN A. + +SUBTTL MISCELANEOUS F- COMMANDS + +;FX - PUT TEXT INTO AND DELETE IT. FX* RETURNS THE TEXT. +;AC D HAS # CHARS BUFFER WAS MOVED (BY CREATION OF THE STRING) +FXCMD: CALL QREGVS ;THIS CAN MAKE US SKIP! + CALL GETANU ;TAKES ARGS LIKE X, K, ETC. + SKIPA +FXCMD2: SETZ B, ;HERE WITH CH POINTING AT QREG, ASSUMED NOT IN A QVECTOR. + SAVE C + SAVE E ;REMEMBER BOTH ON PDL. + SAVE BEG ;X10 MAY MOVE BUFFER, MUST KNOW HOW MUCH. + CALL X12 ;GO PUT IN QREG (WHICH MIGHT BE AC A - SEE QREGVS) + REST D + SUB D,BEG ;-<# CHARS BUFFER MOVED UP> + REST E + REST C ;GET THE ENDS BACK, + MOVNS D + ADD E,D ;RELOCATE REMEMBERED PTRS. + ADD C,D + MOVEM C,PT + JRST DELET1 + +FTYI: CALL DISMDI ;UPDATE MODE DISPLAY (Q..J) IF NEC. + SKIPL UNRCHC + JRST FTYI1 + TTYACT ;MAKE SURE NEXT CHARACTER ACTIVATES - UNLESS WE ALREADY HAVE IT. +FTYI1: CALL TYI + TRZE FF,FRCLN ;:FI READS CHAR AND DOESN'T GOBBLE. + MOVEM CH,UNRCHC + TRZN FF,FRUPRW ;@FI RETURNS UNNORMALIZED CHARACTER. + CALL TYINRM ;NORMAL FI RETURNS NORMAILZED CHARACTER. + MOVE A,CH + JRST POPJ1 + +CNTRUP: CALL RCH ;^^ - RETURN ASCII FOR NEXT CHAR IN CMD STRING. [ + MOVEI A,(CH) ;DISCARD LH, WHICH IS NONZERO FOR ^]^Q'D CHAR. + JRST POPJ1 + +;? COMMAND, COMPLEMENT TRACE MODE. :? TURNS OFF TRACE MODE. +QUESTN: TRNE FF,FRCLN + TRZA FF,FRTRACE + TRC FF,FRTRACE +QUEST1: MOVSI A,(JRST) + TRNN FF,FRTRACE + MOVSI A,(RET) + HRRI A,TYOS + MOVEM A,TRACS + POPJ P, + +FCTLAT: CALL GETARG ;F^@ - TAKES RANGE OF BUFFER, + JFCL + CAMG C,E ;RETURNS 2 ARGS DELIMITING THAT RANGE + EXCH C,E ;IN NUMERIC ORDER. 2,1F^@ GIVES 1,2. + MOVE B,E + MOVE A,C + ANDCMI FF,FRARG+FRARG2 + JRST HOLE0 + +;F*$ -- NO-OP. +;[ ;MAINLY USEFUL FOR F*^]^X$ +FNOOP: JSP B,RDALTC + POPJ P, + JRST FNOOP + +;READ 1 CHAR OF STRING ARG, TURNING UNQUOTED DOLLARSIGNS TO ALTMODES. +;AT END OF ARG, FAIL TO SKIP. +RDALTC: PUSHJ P,RCH + SKIPE SQUOTP + JRST 1(B) + CAIN CH,ALTMOD + JRST (B) + CAIN CH,"$ + MOVEI CH,ALTMOD + JRST 1(B) + +;^V WITH ARG -- PUSH ARGUMENT ON RING BUFFER OF PT. RETURNS NO VALUE. +;NORMALLY, DOESN'T PUSH IF ARG SAME AS CURRENT TOP. :^V PUSHES IN ANY CASE. +FSPSPT: MOVE E,FSPSPP ;GET RING BUFFER POINTER. + LDB CH,E ;GET LAST VALUE PUSHED. + TRZE FF,FRCLN ;UNLESS THIS IS :^V, + JRST FSPSP1 + CAMN C,CH + RET ;DON'T PUSH THE SAME THING TWICE IN A ROW. +FSPSP1: CAMN E,[4400,,FSPSPB+FSPSPL-1] + SUBI E,FSPSPL ;AT END, RING AROUND TO BEGINNING. + IDPB C,E + MOVEM E,FSPSPP + RET + +;^V COMMAND -- WITHOUT ARG, POP TOP OF RING BUFFER OF PT INTO PT; +;THEN RETURN WHAT REMAINS ON TOP OF RING BUFFER (IF THAT VALUE IS +;PUT IN Q..I, THE TOP-LEVEL WILL AVOID PUSHING WHEN IT IS NEXT ENTERED). +;:^V RETURNS VALUE ON TOP OF RING BUFFER. +;^V WITH ARG PUSHES - SEE ABOVE. +CTLV: TRNE FF,FRARG + JRST FSPSPT +POPPT: MOVE E,FSPSPP + MOVE A,(E) ;GET LAST THING PUSHED. + TRZE FF,FRCLN + JRST POPJ1 ;:^V JUST RETURNS VALUE ON TOP OF RING BUFFER. + ADD A,BEG ;PREPARE TO SET PT FROM IT. + SUBI E,1 ;DECREMENT THE RING BUFFER POINTER. + CAMN E,[4400,,FSPSPB-1] + ADDI E,FSPSPL + MOVEM E,FSPSPP + MOVE C,A ;TAKE THE VALUE JUST POPPED. + CALL CHK ;ERR OUT IF IT ISN'T INSIDE THE BUFFER. + MOVEM A,PT ;JUMP THERE IF IT IS. + MOVE A,(E) ;RETURN WHAT IS NOW AT THE TOP. + JRST POPJ1 + +;^Z -- INSERT RANDOM LETTERS BEFORE PT. +;^Z WITHOUT ARG -- RETURN A RANDOM NUMBER. +RANDOM: ARGDFL + JUMPE C,RNDNUM + JUMPLE C,CPOPJ + CALL SLPGET ;INSERT C(C) CHARS, RET. BP. IN BP. +RNDLUP: MOVSI A,123467 + FMPB A,RDMNMS + IDIVI A,26. + MOVEI CH,"A(B) + IDPB CH,BP + SOJG C,RNDLUP + POPJ P, + +RNDNUM: MOVSI A,132476 + FMPB A,RDMNMS + TLZ A,400000 + JRST POPJ1 + +SUBTTL COMMUNICATION WITH SUPERIOR JOB + +FSEXI1: TLZ FF,FLDIRDPY ;COME HERE TO HANDLE ^C TYPED AT TECO COMMAND READER. + MOVEI C,100000 +FSEXIT: MOVEI B,BEG .SEE CIRC +IFN ITS,.BREAK 16,(C) ;FS EXIT +IFN TNX,JRST .EXIT + RET + +SUPCMD: MOVE C,SUPARG ;JUMP HERE IF SUPERIOR STARTS TECO AT BFR BLOCK + 7. + MOVEM C,NUM ;FETCH THE ARG IN BFR BLOCK + 8, AND MAKE IT CURRENT ARGUMENT. + TRO FF,FRARG + SKIPE A,SUPHND ;IF TECO MACRO HANDLER SUPPLIED, RUN IT GIVING IT + JRST MAC5 ;THE ARG OUR SUPERIOR GAVE. + CALL GAPSLP + SKIPLE C ;OTHERWISE, IF ARG IS POSITIVE INSURE AT LEAST THAT MUCH GAP. + CALL SLPGET + MOVEI C,500000 ;DO AN $X RETURN IN CASE $X'ING FROM DDT. + JRST FSEXIT + +;^K$ -- VALRET . +DECDMP: CALL DECDMX ;FORMULATE STRING + MOVEI B,BEG .SEE CIRC + SKIPGE PJATY ;MAKE SURE WE DON'T CLEAR PJATY IF IT WAS ALREADY ON. + TRZ FF,FRUPRW +IFN ITS,.VALUE (A) ;SUPERIOR EXPECTS 2 TO POINT TO BEG +IFN TNX,[ + HRLI A,440700 +IFN 20X,[ + RSCAN ;BEST WAY WE HAVE TO RETURN A STRING TO THE EXEC + TDN + SETZ A, + RSCAN + TDN +] +IFN 10X,[ + MOVE CH,A ;BYTE POINTER TO CHARS TO DO + MOVEI A,.CTTRM +DECDM2: ILDB B,CH + JUMPE B,DECDM3 + STI ;STUFF INTO TERMINAL'S INPUT BUFFER + JRST DECDM2 +DECDM3: +] + CALL .EXIT +] + TRZE FF,FRUPRW + SETZM PJATY ;^ FLAG => SUPPRESS AUTOMATIC REDISPLAY. + POPJ P, + +DECDMX: CALL MEMTOP ;GET ADDR OF 1ST WD ABOVE BFR IN A. + AOS OUT,A + IMULI OUT,5 ;GET CHAR ADDR 1ST CHAR IN THAT WD. + SUB OUT,EXTRAC ;SINCE PUTINC WILL ADD EXTRAC. + JSP B,RDALTC + JRST DECDM1 + CALL PUTINC ;STUFF CHARS THERE, ABOVE BUFFER. + JRST RDALTC + +DECDM1: SETZ CH, ;AFTER STRING, PUT ^@ + CALL PUTINC ;TO TELL DDT IT'S THE END. + SETZM 1(TT) ;ZERO NEXT WD SO DDT WILL STOP FETCHING. + RET + +;FZ - MANIPULATE INFERIOR PROCESS +; FZ$ CREATE FORK, RETURNS FORK INDEX +; 0FZ$ CREATE EXEC FORK (FILESPEC FROM STRING) +; FZ$ "PUSH" +; NFZ$ RESUME FORK N +; -NFZ$ KILL FORK N + +IFN TNX,[ +FZCMD: CALL DECDMX ;BUFFER STRING + HRRO B,A + TRZE FF,FRARG ;ARG GIVEN? + JRST FZCMD3 ;YES - MORE CHECKING + MOVE A,0(B) ;NO - SEE IF NULL STRING ARG + TLNN A,774000 + JRST .PUSH ;YES - DO PUSH + CALL NEWFRK ;ELSE - CREATE NEW FORK + MOVEM B,RUNFRK ;SAVE FORK INDEX +FZCMD1: CALL SETFRK ;SET FORK TTY STATE +FZCMD2: CALL GOFRK ;START UP FORK + MOVE A,RUNFRK ;NO - RETURN FORK INDEX + JRST POPJ1 ;RETURN OK + +FZCMD3: SKIPN A,NUM ;EXPLICIT 0? + JRST .PUSH0 ;YES - MAYBE "PUSH" + JUMPL A,KILFRK ;IF NEGATIVE, THEN KILL FORK + MOVEM A,RUNFRK ;SAVE FORK INDEX + CAILE A,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(A) + TYPRE [ARG] + CALL SETFRK ;SET FORK STATES + TRNE FF,FRARG2 ;HAVE PRE-COMMA ARG? + JRST FZCMD2 ;YES - START FORK AND WAIT FOR TERMINATION + SAVE C ;SAVE AC + SAVE A ;SAVE FORK HANDLE + RFSTS ;GET FORK STATUS AND PC + HLRZ C,A ;COPY FORK STATUS + REST A ;RESTORE FORK HANDLE + TRZE C,(RF%FRZ) ;FORK FROZEN? + RFORK ;YES, WARM IT UP + CAIE C,.RFHLT ;HALTED? + CAIN C,.RFFPT + SFORK ;YES, START IT AT PC RETURNED BY RFSTS + REST C ;RESTORE AC + JRST WAITA ;WAIT FOR TERMINATION + +;RUN AN EXEC PROCESS + +.PUSH0: MOVE A,0(B) ;CHECK NULL STRING + SKIPLE EXECFK ;CHECK EXISTING EXEC FORK + TLNN A,774000 + JRST .PUSH ;NULL STRING OR NO EXISTING FORK + MOVE A,EXECFK ;KILL OFF OLD FORK + KFORK +IFN 20X, ERJMP .+1 + SETOM EXECFK ;SAY NO EXEC +.PUSH: SETZM RUNFRK ;0 - EXEC FORK INDEX + SKIPLE A,EXECFK ;HAVE EXEC? + JRST FZCMD1 ;YES - USE IT + MOVE A,0(B) ;SEE IF NULL STRING + TLNN A,774000 +IFN 20X, HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/] +IFN 10X, HRROI B,[ASCIZ /EXEC.SAV/] + SETZM EXECFK ;FLAG TO SAVE FORK HANDLE + CALL NEWFRK ;CREATE AN EXEC FORK + JRST FZCMD1 ;RUN EXEC AND RETURN + +;KILL FORK (INDEX IN A) + +KILFRK: MOVN B,A ;GET POSITIVE INDEX + CAILE B,NFKS ;CHECK VALIDITY + TYPRE [AOR] + SKIPN A,FRKTAB-1(B) + TYPRE [ARG] + KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + SETZM FRKTAB-1(B) + RET ;RETURN NO VALUE. + +;SET UP TTY MODES FOR RUNNING INFERIOR + +SETFRK: SKIPGE PJATY ;DON'T CLEAR THIS IF ALREADY ON + TRZ FF,FRUPRW + SAVE A ;SAVE FORK HANDLE + TRNN FF,FRUPRW ;UNLESS DISPLAY WILL BE LEFT ALONE + CALL DPYRST ;RESET TERMINAL (IF DPY) + MOVEI A,.CTTRM ;CONTROLLING TERMINAL + MOVE B,FTTYMD ;RESTORE TTY MODES + STPAR + MOVE B,ITTYMD + SFMOD + MOVE B,ITTYMD+1 + MOVE C,ITTYMD+2 + SFCOC +IFN SUMXSW,[ + MOVE 1,HLDCHR ;get hold character + JSYS 633 ;restore it (STCHA) +] + MOVEI A,.FHJOB ;SETUP TERMINAL INTERUPT WORD + SETO B, + SETZ C, + STIW + MOVEI A,.TICCG ;CTRL-G + MOVE B,0(P) ;FORK HANDLE + CAMN B, EXECFK ;THIS THE EXEC? + DTI ;YES - TURN OFF C-G + JRST POPAJ ;RESTORE FORK HANDLE AND EXIT + +;START INFERIOR (HANDLE IN A) + +GOFRK: TRNN FF,FRARG2 + TDZA B,B ;NO ARG - SPECIFY 0 + MOVE B,SARG ;GET ARG IF SPECIFIED + SFRKV ;START INFERIOR + +WAITA: SAVE A + GETNM ;SAVE OUR JOB NAME + EXCH A,(P) + WFORK ;WAIT FOR FORK TO TERMINATE +WAITX: ;SPECIAL LABEL FOR TSINT +RETFRK: EXCH A,(P) ;SAVE FORK HANDLE + SETNM + MOVEI A,.CTTRM + RFMOD + MOVEM B,FTTYMD ;SAVE INFERIOR TERMINAL MODES +IFN 20X,[ + LDB A,[.BP TT%PGM,B] + MOVEM A,PAGMOD ;UPDATE STATE OF TERMINAL PAGE MODE +];20X + CALL PAGON ;RESTORE DPY + TRZE FF,FRUPRW + SETZM PJATY ;^ FLAG => SUPPRESS AUTO REDISPLAY + MOVSI A,.TICCG ;MAKE SURE ^G ASSIGNED ON CHANNEL 0 + ATI + JRST POPAJ ;RESTORE HANDLE AND EXIT + +;CREATE A NEW FORK FOR PROGRAM NAMED BY POINTER IN B +;IF EXECFK IS 0, WE WANT TO CREATE AN EXEC FORK. +;OTHERWISE, WE ALLOCATE AN INDEX AND RETURN IT IN B. + +NEWFRK: MOVSI A,(GJ%SHT\GJ%OLD) + GTJFN + JRST OPNER1 + SAVE A ;SAVE JFN + MOVSI A,(CR%CAP) ;PASS ON CAPABILITIES + CFORK + JRST FRKC3 + EXCH A,0(P) ;SAVE FORK HANDLE GET JFN + SKIPN FRKJCL ;WANTS JCL? + JRST NEWFR1 + MOVEI B,(A) ;YES, GET JFN + HRROI A,BAKTAB + MOVSI C,001000 + JFNS + PUSH P,B ;SAVE JFN AGAIN + MOVEI B,40 + IDPB B,A + PUSH P,A ;SAVE STRING POINTER + SKIPL A,FRKJCL ;GET JCL - SHOULD BE A STRING + CAIA + CALL QLGET0 ;GET BYTE POINTER AND SIZE OF STRING + JRST [ POP P,(P) ;NOT A STRING + POP P,A ;JFN + RLJFN + JFCL + POP P,A ;FORK + KFORK + SETZM FRKJCL ;DONT GET IT AGAIN + TYPRE [ARG]] + POP P,A +NEWFR2: ILDB CH,BP + IDPB CH,A + SOJG B,NEWFR2 + MOVEI B,12 + IDPB B,A + MOVEI B,0 + IDPB B,A + HRROI A,BAKTAB ;STICK IN THE JCL + RSCAN + JFCL + SETZM FRKJCL ;DONT GET IT AGAIN + POP P,A ;NOW GET THE JFN AGAIN +NEWFR1: HRL A,0(P) ;FORK,,JFN + GET ;GET FILE +IFN 20X, ERJMP FRKC4 + REST A ;RESTORE FORK HANDLE + SKIPN EXECFK ;WANT THIS HANDLE? + JRST [ MOVEM A,EXECFK + RET] + MOVSI B,-NFKS + SKIPE FRKTAB(B) ;IN USE? + AOBJN B,.-1 ;YES - TRY NEXT + JUMPG B,FRKC5 ;TABLE FULL? + MOVEM A,FRKTAB(B) ;SAVE NEW HANDLE + MOVEI B,1(B) ;RETURN NEW INDEX IN B + RET + +FRKC3: REST A ;JFN ON STACK + RLJFN ;RELEASE JFN IN A + JFCL + JRST OPNER1 + +FRKC4: TLZ A,-1 ;JFN + RLJFN + JFCL + REST A ;FORK HANDLE ON STACK + KFORK ;FLUSH FORK +IFN 20X, ERJMP .+1 + JRST OPNER1 + +FRKC5: KFORK ;KILL OFF FORK +IFN 20X, ERJMP .+1 + MOVEI B,CFRKX3 + JRST OPNER4 +];TNX (FZ COMMAND) + +;FJ -- INSERT THE CMD STRING FROM DDT IN THE BUFFER. +;IF NO STRING, INSERTS NOTHING. STRING WILL USUALLY END WITH CRLF. +FJCL: PUSHJ P,FJCLRD ;READ IN THE COMMAND STRING, + SKIPN GCTAB + POPJ P, ;NOTHING TO DO IF STRING NULL. + MOVE A,[BP7,,GCTAB] + MOVEI C, ;COUNT THE CHARS IN E. +FJCL1: ILDB CH,A + JUMPE CH,FJCL2 + CAIE CH,^M ;^M AND ^@ END THE STRING. + AOJA C,FJCL1 + ADDI C,2 ;^M COUNTS AS 2 CHARS, ^@ AS NONE. +FJCL2: CALL SLPGET ;INSERT C(C) CHARS, BP IN BP FOR IDPB. + MOVE A,[BP7,,GCTAB] +FJCL3: ILDB CH,A ;COPY THE CHARS INTO THE SPACE. + JUMPE CH,CPOPJ ;STOP BEFORE A ^@. + IDPB CH,BP + CAIE CH,^M ;AFTER ^M, STORE ^J AND DONE. + JRST FJCL3 + MOVEI CH,^J + IDPB CH,BP + POPJ P, + +;READ THE CMD STRING FROM DDT INTO GCTAB. +FJCLRD: +IFN 20X,[ + SETZB A,B + RSCAN ;GET RSCAN BUFFER + TDN + SETZ B, + MOVE B,[BP7,,GCTAB] + SETZM GCTAB + MOVN C,A ;GET NUMBER OF CHARACTERS IN IT +FJCLR2: JUMPGE C,FJCLR5 ;If no chars rescanned, we have no JCL. + PBIN ;Flush the first word of the rscan line. + CAIL A,"A+40 ;Make it upper case + CAILE A,"Z+40 ;For easy reading later + TRNA + SUBI A,40 + IDPB A,B + CAILE A,40 ;Find end of invoking field + AOJA C,FJCLR2 + AOJGE C,FJCLR5 ;Reached end already => no JCL for us. + CAIGE A,40 ;Is separator? + JRST FJCLR3 ;No, a terminator. Ignore the JCL. + MOVE B,GCTAB ;Look at first word + CAME B,[ASCII/RUN /] ;Should anything more follow? + CAMN B,[ASCII/R /] + JRST FJCLR3 ;R or RUN means ignore the JCL. + JRST FJCLR4 + +FJCLR3: CALL FJCLR4 ;Ignore the JCL: read it all in, +FJCLR5: SETZM GCTAB ;but say there was none. + RET +FJCLR4: +] + SETZM GCTAB + MOVE A,[GCTAB,,GCTAB+1] + BLT A,GCTAB+GCTBL-2 +IFN ITS,[ + MOVEM A,GCTAB+GCTBL-1 ;LAST WD NOT 0 TO STOP STORING. +;FIRST, RETURN WITH GCTAB ZEROED IF THERE IS NO JCL. + .SUSET [.ROPTIO,,A] + TLNN A,OPTCMD ;HAS SUPERIOR SAID IT HAS CMD STRING? + POPJ P, ;NO, RETURN AS IF READ 0 FROM IT. +;THERE IS JCL, SO READ IT INTO GCTAB. + .BREAK 12,[5,,GCTAB] +] +IFN 20X,[ + MOVEI A,-1 ;READ FROM CONTROLLING TERMINAL + HRROI B,GCTAB + SIN ;THE REST OF THE RSCAN STRING +] + RET + +SUBTTL F=, F~ STRING COMPARISON + +;F=$ OR F=$ +;COMPARES THE STRINGS AND RETURNS A NUMBER WHOSE SIGN IS NEGATIVE +;IF QREG OR BUFFER RANGE IS LESS; POSITIVE, IF GREATER; 0, IF THE +;TWO STRINGS ARE EQUAL. +;IF THE VALUE IS NONZERO, ITS ABS VALUE IS 1 + THE POSITION OF THE FIRST +;DIFFERENCE; I.E., 1 IF THE FIRST CHARACTERS DIFFER. +;A STRING IS GREATER THAN ANY INITIAL SEGMENT OF IT. +;F~ (OR F^) COMPARES SIMILARLY BUT IGNORES CASE DIFFERENCES. +FAPPRX: TRO FF,FRNOT +FEQ: TRNE FF,FRARG\FRCLN + JRST FEQ0 ;NUMERIC ARG => USE BUFFER RANGE. + SAVE FF ;PRESERVE FRNOT OVER QREGX. + CALL QREGX ;ELSE READ NAME OF QREG. + REST FF + CALL QLGET0 ;GET LENGTH IN B, BP TO ILDB IN BP. + TYPRE [QNS] + SETZB D,IN ;THERE'S NO GAP TO SKIP OVER. + AOJA IN,FEQ1 + +FEQ0: CALL GETANU ;DECODE 1 OR 2 ARGS AS FOR K, T, X ETC. + MOVE D,GPT ;D GETS CHAR ADDR OF START OF GAP. + MOVE B,C ;B GETS # CHARS, + SUB B,E + MOVE BP,E + CAML E,GPT + ADD BP,EXTRAC ;IN CASE RANGE STARTS AFTER GAP. + MOVE IN,BP + CALL GETIBP ;BP GETS BP TO ILDB 1ST CHAR. +FEQ1: SETZ A, ;ORDER OF STRINGS NOT KNOWN YET. + ;WHEN ORDER IS DETERMINED, A WILL GET 1 OR -1. + MOVE E,B ;REMEMBER INITIAL VALUE OF B. + SETZM INSBP ;MAKE SURE RCH RELOCATES BP. + MOVEI CH,ALTMOD + TRZE FF,FRUPRW ;UPARROW SAYS USE DELIMITER OTHER THAN ALTMD. + CALL RCH + MOVEM CH,INSDLM ;REMEMBER THE DELIMITER. + TRZ FF,FRARG+FRCLN+FRARG2 +;GET THE NEXT CHAR FROM THE STRING ARG. +FEQLUP: CALL RCH ;READ IT. + SKIPE SQUOTP ;IF NOT QUOTED OR DELIM-PROTECTED, + JRST FEQLU1 + CAMN CH,INSDLM ;SEE IF IT IS THE DELIMITER. + JRST FEQEND +FEQLU1: JUMPN A,FEQLUP ;INEQUALITY SEEN => JUST SKIPPING TO END OF STRING ARG NOW. + SOJL B,FEQEN1 ;END OF QREG BUT NOT END OF STRING ARG => QREG IS LESS. + CAMN D,IN ;ELSE GET NEXT CHAR OF QREG OR BUFFER. + CALL FEQGAP ;SKIP OVER GAP IF HAVE REACHED IT. + AOS IN + ILDB C,BP + CAIN C,(CH) ;CHARS EQUAL => NO DECISION YET, + JRST FEQLUP ;KEEP LOOKING. + TRNN FF,FRNOT ;NO MATCH => IF F^, TRY IGNORING CASE. + JRST FEQNE + CAIL C,"A+40 + CAILE C,"Z+40 + CAIA + SUBI C,40 + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN C,CH + JRST FEQLUP +FEQNE: CAIL C,(CH) ;QREG OR BUFFER GREATER => + AOJA A,FEQLUP ;RETURN POSITIVE; ELSE NEGATIVE. +FEQEN1: SOJA A,FEQLUP ;EITHER WAY, SKIP OVER REST OF STRING ARG. + +FEQEND: SETOM INSBP + JUMPN A,FEQEN2 ;END OF STRING ARG: RETURN ANSWER IF KNOWN. + SOJL B,POPJ1 ;ELSE QREG ENDING NOW TOO => EQUAL. + AOJ A, ;STRING ARG FINISHED, OTHER NOT => STRING ARG IS SMALLER. +FEQEN2: SUB E,B ;INITIAL VALUE OF B - CURRENT + IMUL A,E ;GIVES 1+POSITION OF 1ST DIFFERENCE. + JRST POPJ1 + +FEQGAP: MOVE BP,GPT ; BP GETS BP TO ILDB 1ST CHAR AFTER GAP. + ADD BP,EXTRAC + JRST GETIBP + +SUBTTL CASE CONVERSION + +;FC - TAKES ARGS LIKE K, CONVERTS AREA OF BUFFER TO LOWER CASE +;PT GOES BEFORE THE SAME CHARACTER BEFORE AND AFTER. +;^ FC CONVERTS TO UPPER CASE. +;:FC RETURNS , CONVERTED TO UPPER CASE. +LOWCON: TRZE FF,FRCLN + JRST LOWCO3 ;:FC GOES OFF. + PUSHJ P,GETANU + MOVE IN,E + SUB C,IN + SKIPE READON + TYPRE [RDO] + SETOM MODIFF ;WE ARE ABOUT TO CHANGE THE BUFFER CONTENTS. + CALL GETIBI ;GET IN BP B.P. TO ILDB CHARS STARTING WHERE IN POINTS. +LOWCO1: SOJL C,CPOPJ + CAMN IN,GPT ;WHEN REACH GAP, MOVE B.P. OVER IT. + CALL FEQGAP + ILDB CH,BP + TRNE FF,FRUPRW + JRST LOWCO5 + CAIG CH,"Z + CAIGE CH,"A + JRST LOWCO2 +LOWCO6: XORI CH,40 +LOWCO2: DPB CH,BP ;PUT CHAR INTO FRONT OF GAP, + AOJA IN,LOWCO1 + +LOWCO5: CAIG CH,40+"Z ;CONVERTING TO UPPER CASE: + CAIGE CH,40+"A + JRST LOWCO2 + JRST LOWCO6 ;LOWER CASE CHARS GET SHIFTED, + +LOWCO3: TRZN FF,FRARG + TYPRE [WNA] + MOVE A,C ;HANDLE :FC. TO GET VALUE, START WITH ARG, + TRZ FF,FRUPRW ;DON'T LEAVE ^ FLAG ON; DON'T LET ARG INTERFERE WITH VALUE. + CALL QLGET0 ;ARG IS STRING => CONVERT ALL CHARS OF THE STRING. + CAIA + JRST LOWCO4 + ANDI C,177 + CAIG C,40+"Z + CAIGE C,40+"A + CAIA + XORI A,40 + JRST POPJ1 + +LOWCO4: AOS (P) + MOVE C,B ;ARG IS STRING; MAKE NEW STRING = OLD ONE CONVERTED TO U.C. + MOVE E,BP ;SAVE PTR TO OLD STRING; QOPEN RETURNS PTR TO NEW ONE IN BP. + CALL QOPEN ;MEANWHILE C HAS SIZE NEEDED FOR NEW ONE, = SIZE OF OLD. + JUMPE B,QCLOSV +LOWCO7: ILDB TT,E ;COPY OLD STRING + CAIL TT,"A+40 + CAILE TT,"Z+40 + CAIA + SUBI TT,40 ;CONVERT EACH CHARACTER IF NECESSARY. + IDPB TT,BP ;STORE INTO THE NEW STRING. + SOJG B,LOWCO7 + JRST QCLOSV ;THEN FINISH THE NEW STRING'S HEADER AND RETURN IT. + +NEWAS: ARGDFL ;DOLLARSIGN COMMAND. + CALL FSCASF ;UNLESS IN -1$, NO CASE SHIFT OR LOCK. + SKIPGE C + MOVEI IN,"/ ;-1$, USE / AS THE CASE-SHIFT, NO CASE-LOCK. + JRST FSCAS1 + +FSCASV: MOVE A,CASNRM ;COMPUTE VALUE FOR FS CASE TO RETURN. + SKIPL CH,CASSFT ;IF THERE'S A CASE-SHIFT, PUT IT IN BUFFER.. + CALL TYOMGS + SKIPL CH,CASLOK ;SAME FOR CASE-LOCK. + CALL TYOM + JRST POPJ1 + +FSCASE: TRNN FF,FRARG ;FS CASE -- NO ARG => RETURN STATUS INFO. + JRST FSCASV + ARGDFL + CALL FSCASF ;READ THE STRING ARG WITH NO CASE SHIFT OR CASE LOCK. + CALL RCH ;READ WHAT MIGHT BE THE CASE-SHIFT. + CAIN CH,ALTMOD ;NULL STRING ARG => NEITHER. + JRST FSCAS1 ;(NOTE IN, OUT HOLD -1) + MOVEI IN,(CH) ;ELSE 1ST CHAR OF ARG IS CASE-:SHIFT. + CALL RCH ;AND THERE MAY BE A CASE-LOCK. + CAIN CH,ALTMOD + JRST FSCAS1 ;NO MORE CHARS IN ARG => NO CASE-LOCK. + MOVEI OUT,(CH) +FSCAS0: JSP B,RDALTC ;IGNORE REST OF STRING ARG. + CAIA + JRST FSCAS0 +FSCAS1: CAMN IN,OUT ;TRYING TO MAKE SAME CHAR SHIFT & LOCK? + SETO IN, ;JUST USE IT AS LOCK. + MOVEM C,CASNRM ;SIGN OF ARG IS NORMAL INPUT CASE. + MOVEM C,CASE ;SET CURRENT CASE TO NEW NORMAL. + ANDI C,1 + MOVEM C,CASDIS ;ARG ODD => FLAG ON OUTPUT. + MOVEM IN,CASSFT ;THEN STORE AWAY NEW SHIFT AND LOCK CHARS, + MOVEM OUT,CASLOK + MOVE TT,[CALL RCHSFT] ;ACTUALLY MAKE THE NEW CASE-SHIFT + SKIPL IN ;(IF ANY) + EXCH TT,RCHDTB(IN) ;ACT LIKE ONE. + MOVEM TT,RCHSFD ;MAKE SURE CAN UNDO THAT EXCH. + MOVE TT,[CALL RCHLOK] + SKIPL OUT ;SIMILAR FOR THE NEW CASE-LOCK. + EXCH TT,RCHDTB(OUT) + MOVEM TT,RCHLOD + POPJ P, + +;CAUSE THE CASE-SHIFT AND CASE-LOCK, IF ANY, TO BECOME NORMAL. +;CHARACTERS AGAIN, WITH NO CASE-SHIFT OR -LOCK IN EXISTENCE. +;SETOM'S IN, OUT. CLOBBERS TT, TT1. +FSCASF: MOVE TT,RCHLOD ;FIRST TURN THE OLD SHIFT AND LOCK CHARS + SKIPL TT1,CASLOK ;INTO NORMAL CHARS. + MOVEM TT,RCHDTB(TT1) + MOVE TT,RCHSFD + SKIPL TT1,CASSFT + MOVEM TT,RCHDTB(TT1) + SETOB IN,CASSFT ;THEN SAY THERE ARE NONE. + SETOB OUT,CASLOK + POPJ P, + +SUBTTL Q-REGISTER NAME READERS + +;ROUTINES TO READ IN SUFFIX QREG ARGS: + +;THERE ARE SEVERAL TYPES OF SUFFIX QREGS, AND VARIOUS ROUTINES ALLOW CERTAIN SUBSETS. +;A LETTER (OR DOTS AND A LETTER, OR A ^R OR ^^ NAME) NAMES A FIXED LOCATION IN TECO. +;AN EXPRESSION IN PARENTHESES IS A READ-ONLY QREG "CONTAINING" THE VALUE OF THE EXP. +;A * IS A WRITE-ONLY QREG AND WHAT IS WRITTEN IN IT IS THE COMMAND'S VALUE. +;:() WHERE IS A QREG CONTAINING A Q-VECTOR, IS A SUBSCRIPTING EXPRESSION. +; IN THIS CASE, THE QREG IS ONE WORD IN THE QVECTOR. +; IS A LONG-NAME QREG. THE NAME IS LOOKED UP IN THE SYMBOL TABLE +; (A QVECTOR IN ..Q) WITH FO TO FIND THE WORD IN THAT QVECTOR HOLDING THE VALUE. + +;THE REASON THERE ARE SEVERAL ROUTINES IS THAT ONLY READING-ONLY COMMANDS +;ALLOW (-) QREGS, AND ONLY WRITING-ONLY COMMANDS ALLOW *. +;QREGS IS THE BASIC ROUTINE (NEITHER * NOR PARENS), QREGX ALLOWS PARENS, +;AND QREGVS ALLOWS *. + +;THE ROUTINES HAVE SIMILAR VALUE CONVENTIONS: +;A CONTAINS THE CONTENTS OF THE QREG, +;CH CONTAINS ITS ADDRESS (BAKTAB, FOR PAREN-QREGS WHICH CAN'T BE WRITTEN) +;B CONTAINS AN INDICATION OF WHICH TYPE OF NAME WAS READ. + ;NORMALLY, IT IS ZERO. FOR :(), IT IS POSITIVE; FOR NAME, IT IS NEGATIVE. + ;IN EITHER OF THOSE TWO CASES, THE RH POINTS AT THE BUFFER BLOCK OF THE QVECTOR + ;CONTAINING THE SLOT. THAT IS SO THAT COMMANDS LIKE :I CAN TELL IF THAT QVECTOR + ;IS RELOCATED AND CORRECT ACCORDINGLY (SEE QREGVA). +;IN, FOR A NAME QREG (B IS NEGATIVE), CONTAINS A TECO STRING POINTER TO THE +;INTERNED NAME OF THE QREG AS FOUND IN THE SYMBOL TABLE. + +;READ EITHER A QREG NAME OR AN EXPRESSION IN PARENS, WHOSE VALUE +;IS USED AS THE "CONTENTS" OF THE QREG. CONTENTS RETURNED IN A. CLOBBERS ALL ACS +;EXCEPT C,E. ALSO ALLOWS SUBSCRIPTED QVECTORS, LIKE QREGS. +QREGX: CALL SKRCH + CAIE CH,"( + JRST QREGS0 + TRO FF,FRQPRN ;MARK THIS ( AS BEING FROM QREGX. + MOVEI T,CD + JRST OPEN2 ;SAVE ARGS, ETC; WILL COME BACK WHEN ")" IS SEEN + +QREGXR: MOVE C,NUM ;TO HERE. A HAS VALUE WITHIN THE PARENS. + MOVE E,SARG ;RESTORE THE SAVED ARGS. + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW + IORI FF,(CH) + SETZ B, ;RETURN B AS 0 TO SHOW THIS WASN'T A SUBSCTRIPTED QREG. + MOVEI CH,BAKTAB ;MAKE SURE, IF CALLER TRIES TO WRITE OUR QREG, NO HARM DONE. + RET + +;HERE TAKE CARE OF "SIMPLE" (..A OR ...^RX) TYPE QREG NAMES. +QREGXX: SETZB A,B + CALL QNMGE2 ;HERE FROM QREGX OR QREGS IF IT'S AN ORDINARY QREG NAME AFTER ALL. + TYPRE [IQN] + MOVE A,(CH) + POPJ P, + +;HERE TO READ EITHER QREG NAME OR "*" MEANING RETURN AS VALUE INSTEAD OF SETTING QREG. +;ASSUMES -1(P) IS CALLER'S RETURN ADDRESS, AND AOS'S IT SO CALLER RETURNS THE VALUE. +QREGVS: CALL SKRCH ;HERE TO ALLOW EITHER * OR SUBSCRIPTING. + CAIE CH,"* + JRST QREGS0 + MOVEI CH,A ;SUPPLY AC A AS ADDR OF "QREG". + SETZB A,B ;SAY ITS VALUE IS 0 (FOR THINGS LIKE ^ X). + AOS -1(P) ;MAKE OUR CALLER SKIP-RETURN + RET + +;READ IN A QREG NAME, ALLOWING SUBSCRIPTING (AS IN Q:.Q(10) = 10TH ELT OF Q-VECTOR IN .Q) +;ON RETURN FROM THIS OR ANY OTHER QREG-READING ROUTINE, IF B IS NONZERO +;THEN THE QREG WAS SUBSCRIPTED, AND B POINTS AT THE BUFFER BLOCK OF THE Q-VECTOR. +;WE ALSO HANDLE "LONG QREG NAMES" AS IN QFOO, SINCE THAT IS IMPLEMENTED +;BY MEANS OF INDEXING (INTO THE SYMBOL TABLE QVECTOR). +QREGS: CALL SKRCH +QREGS0: CAIN CH,ALTMOD + JRST QREGN ;CHECK FOR Q$FOO$ CONSTRUCT. + CAIE CH,": + JRST QREGXX + CALL QREGX ;FIRST, READ THE QREG WHICH IS THE Q-VECTOR TO SUBSCRIPT. + SAVE A ;SAVE IT AS IF IN A (. + SAVE [0] + SAVE LEV + MOVEM P,LEV + CALL QREGX ;THEN READ THE VALUE OF THE INDEX. + MOVE IN,A + MOVEI T,.+2 + JRST CLOSE2 ;POP STUFF OFF, LEAVING Q-VECTOR IN A. + MOVE BP,A + CALL QBGET1 ;GET BUFFER-BLOCK ADDR IN B. + SKIPN B + TYPRE [QNB] + IMULI IN,5 ;GET VIRTUAL CHAR ADDR INSIDE Q-VECTOR OF DESIRED WORD. + ADD IN,MFBEG(B) + TLZ IN,MFBBTS + CAML IN,MFBEGV(B) ;COMPLAIN IF NOT INSIDE VIRTUAL BOUNDS. + CAML IN,MFZV(B) + TYPRE [NIB] + CAML IN,MFGPT(B) + ADD IN,MFEXTR(B) ;TURN INTO REAL ADDRESS. + IDIVI IN,5 + MOVE A,(IN) ;FETCH CONTENTS OF WORD, + MOVE CH,IN ;AND ALSO RETURN ITS ADDRESS, FOR "U", ETC. + RET + +;COMMANDS THAT DO CONSING, AFTER CALLING QREGVS, SHOULD, IF B IS NONZERO, +;DO A JSP TT,QREGVA TO WORRY ABOUT CHANCE THAT CONSING WILL MOVE THE Q-VECTOR. +;QREGVA SAVES STUFF, CALLS BACK TO DO THE WORK, THEN FIXES UP AND RETURNS TO COMMAND'S CALLER. +;IF B IS NEGATIVE, THE QREG IS A NAMED VARIABLE, AND WE MAY NEED TO CALL A MACRO +;WHEN ITS VALUE CHANGES. WE PRESERVE B FOR USE2 TO ACCOMPLISH THAT. +QREGVA: SAVE B ;REMEMBER ADDR OF BUFFER BLOCK OF QVECTOR + SAVE CH ;REMEMBER ADDRESS OF WORD IN QVECTOR. + MOVE CH,MFBEGV(B) + IDIVI CH,5 ;BUT CONVERT IT INTO AN INDEX RELATIVE TO QVECTOR'S B. + MOVNS CH + ADDM CH,(P) + MOVEI CH,A ;NOW CALL THE COMMAND BACK, GETTING RESULT IN A. + SETZ B, + CALL (TT) + MOVE B,-1(P) ;NOW CONVERT REL. IDX. INTO QVECTOR BACK INTO ADDRESS. + MOVE CH,MFBEGV(B) + IDIVI CH,5 + ADD CH,(P) + SUB P,[2,,2] + MOVE C,A ;NOW GO STORE VALUE IN QREG. + JRST USE2 + +;HERE AFTER SEEING A QREG NAME STARTS WITH AN ALTMODE, AS IN QFOO. [ +QREGN: SETZM SQUOTP ;Q^]A WHERE A HOLDS $FOO$ SHOULD WIN. + SAVE C + SAVE E ;FO CLOBBERS ALL ACS + SAVE FF + MOVE A,QRB.. + MOVE A,.QSYMT(A) ;GET THE PTR TO THE QVECTOR USED AS SYMBOL TABLE. + MOVE BP,A + CALL QBGET1 + SAVE B + TRZ FF,FRCLN\FRARG\FRARG2\FRUPRW + CALL FOCMD0 ;DO FO TO READ IN THE "FOO" AND SEARCH SYMBOL TABLE. + JFCL ;PUTS VAL IN A AND ADDR OF S.T.E. IN IN. + MOVEI CH,1(IN) ;CH GETS ADDR OF SLOT IN QVECTOR HOLDING THE VALUE. + MOVE IN,(IN) ;IN GETS THE STRING WHICH IS THE FULL NAME. + REST B ;RETURN IN B THE BUFFER BLOCK OF THE QVECTOR + TLO B,400000 + REST FF ;(FOR RELOCATION HACKERY IN QREGVA FOR :I AND X). + REST E + JRST POPCJ + +;SKIP IF CHAR IN CH IS A LETTER OR A DIGIT. ALSO, CONVERT LOWER +;CASE LETETRS TO UPPER CASE. +QRVTST: CAIL CH,"0 + CAILE CH,"9 + CAIA + JRST POPJ1 + CAIL CH,"A + CAILE CH,"Z + CAIA + JRST POPJ1 + CAIL CH,"A+40 + CAILE CH,"Z+40 + POPJ P, + SUBI CH,40 + JRST POPJ1 + +;READ IN A QREG NAME, AND RETURN IN CH THE ADDRESS OF THE QREG. +;CLOBBERS A AND CH. +QNMGET: SETZI A, + CALL SKRCH +QNMGE2: CAIN CH,". + AOJA A,QNMGET+1 + CAIE CH,^R + CAIN CH,^^ + JRST QNMGE3 + CALL QRVTST + RET + CAILE A,NQSETS-1 + RET + AOS (P) +QNMGE1: MOVEI CH,-"0(CH) + CAILE CH,9 + SUBI CH,"A-"9-1 + ADD CH,QRB(A) + RET + +QNMGE3: LSH A,7 ;HANDLE QREG NAME CONTAINING "^R" OR "^^": + CAIN CH,^^ + XORI A,100 +QNMGE5: SETZM BRCUAV ;[ ;IF A ^]^V IS DONE, BRCUAV WILL BECOME NEGATIVE. + CALL SKRCH ;READ IN NAME OF ^R-MODE CHARACTER + SKIPGE BRCUAV ;[ ;THE POINT OF THIS IS THAT ^]^V TRUNCATES TO 7 BITS, + HRRZ CH,BRCUAV ;BUT WE HAVE TO GET BACK THE 9-BIT VALUE. + XOR CH,A ;GET THE SPECIFIED CHAR. IN TV CHAR SET. + ANDI CH,777 + ADDI CH,RRMACT ;THE "QREG" IS THE RRMACT ENTRY FOR THE CHARACTER. + JRST POPJ1 + +;F^^ -- CONVERT A ^R-COMMAND NAME INTO A NUMBER (F^^.^R. RETURNS 174. = 256) +;:F^^ -- IF IS A VALID Q-REG NAME, RETURN THE +;:FSQPHOME$ OF THE Q-REG. OTHERWISE, RETURN 0. +FCTLUP: TRZE FF,FRCLN + JRST FCUP1 + CALL QNMGET + TYPRE [ARG] + MOVEI A,-RRMACT(CH) + CAIL A,1000 + TYPRE [ARG] + JRST POPJ1 + +FCUP1: TRZ FF,FRARG + MOVE A,C ;:F^^. + CALL QLGET0 ;DECODE THE STRING, B.P. IN BP AND LENGTH IN B. + JRST NRET0 + SETZ A, ;COUNT NUMBER OF DOTS IN A. +FCUP2: SOJL B,NRET0 ;STRING EXHAUSTED => NOT VALID. + ILDB CH,BP + CAIN CH,". ;NEXT CHAR IS A DOT => JUST COUNT IT. + AOJA A,FCUP2 + CAIE CH,^R ;NON-DOT => WE'RE NEAR THE END NOW. + CAIN CH,^^ + JRST FCUP3 ;^R CHARACTER DEFN NAMES ARE OK TOO. + CALL QNMGE2 ;ELSE FIGURE OUT THE QREG NAME, + SETZ CH, ;NO SKIP MEANS IT ISN'T A VALID ONE, SO RETURN 0. + MOVE A,CH ;ELSE QNMGE2 LEFT THE DESIRED VALUE IN CH. + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +FCUP3: LSH A,7 ;^R CHARACTER DEFN NAME => PUT DOTS IN CTL AND META BITS, + CAIN CH,^^ + XORI A,100 ;FOR ^^ CONTROLIFY WHAT FOLLOWS. + SOJL B,NRET0 ;STRING EXHAUSTED RIGHT AFTER THE ^R OR ^^ => LOSE. + ILDB CH,BP + XOR A,CH ;ELSE MERGE CHAR WITH DOTS AND RETURN. + ANDI A,777 + ADDI A,RRMACT + JUMPN B,NRET0 ;WE WIN PROVIDED STRING IS NOW EXHAUSTED. + JRST POPJ1 + +;FO COMMAND - BINARY SEARCH A TABLE FOR A GIVEN STRING. +;FOLLOW BY QREG WHICH POINTS TO A STRING OR BUFFER CONTAINING THE TABLE +;(MUST BE ON A WORD BOUNDARY, SO USELESS WITH IMPURE STRINGS). +;AFTER THE QREG NAME COMES THE STRING TO SEARCH FOR. +;THE FIRST WORD OF THE TABLE MUST CONTAIN THE SIZE (IN WORDS) OF +;ALL THE ENTRIES; AFTER IT COME THE ENTRIES. THE FIRST WORD OF EACH ENTRY +;IS ASSUMED TO BE THE POINTER TO THE NAME-STRING TO SEARCH FOR. +;IF THE TABLE IS A PURE STRING, THAT PONTER IS RELATIVE TO THE TABLE ITSELF. +;PLAIN FO GETS AN ERROR (UVN OR AVN) IF THE TARGET NAME IS MISSING OR AMBIGUOUS; +;OTHERWISE, IT RETURNS THE VALUE IN THE SECOND WORD OF THE ENTRY. +;:FO RETURNS THE OFFSET OF THE ENTRY FOUND; IF THE TARGET IS NOT FOUND +;OR AMBIGUOUS, MINUS THE OFFSET OF THE ENTRY TO INSERT BEFORE IS RETURNED. +;FO RETURNS THE VALUE OF THE VARIABLE IF IT IS DEFINED, OTHERWISE. +;"^" MODIFIER => DON'T ALLOW ABBREVIATIONS, JUST EXACT MATCHES. +FOCMD: CALL QREGX ;READ THE QREG NAME. +FOCMD0: MOVEI J,STAB-1 ;THEN ACCUMULATE STRING TO SEARCH FOR IN STAB. + MOVEI B,40 ;B HOLDS PREVIOUS CHARACTER, FOR COMPRESSING SPACES. + TRZ FF,FRNOT +FOCMD1: CALL ORCH ;READ CHAR, CONVERT LETTERS TO U.C. + CAIN CH,ALTMOD + SKIPE SQUOTP + CAIA + JRST FOCMD2 + SKIPGE SQUOTP ;ALLOW FOR SUPERQUOTED SPACES + HRLI CH,-1 + CAIN CH,^I + MOVEI CH,40 ;CONVERT ALL TABS TO SPACES. + CAIN CH,40 ;CHECK FOR MULTIPLE OR LEADING WHITESPACE. + CAIE B,40 ;IF THIS CHAR AND PREVIOUS BOTH SPACING, IGNORE THIS ONE. + CAIA + JRST FOCMD1 + MOVE B,CH ;REMEMBER THIS CHAR AS PREVIOUS FOR NEXT. + HRRZS CH + CAMN J,[LTABS,,STAB+LTABS-1] + TYPRE [STL] + PUSH J,CH ;REMEMBER CHAR IN STAB. + JRST FOCMD1 + +FOCMD2: CAIN B,40 ;FLUSH TRAILING SPACES. + SOS J +;ENTER HERE FROM F^G COMMAND. +FOCMD3: CALL QLGET0 ;GET TABLE LENGTH IN CHARS IN B, B.P. TO ILDB IN BP. + TYPRE [QNS] + IBP BP + HLRZ A,BP + CAIE A,350700 ;TABLE MUST START ON WORD BOUNDARY. + TYPRE [ARG] + MOVE C,(BP) ;C GETS ENTRY SIZE IN WORDS, FROM 1ST WORD OF TABLE. + MOVE OUT,B + IDIVI OUT,5 ;SIZE MUST BE INTEGRAL # OF WORDS. + SKIPE OUT+1 .SEE CH + TYPRE [ARG] + SOS CH,OUT ;OUT GETS TABLE SIZE, NOT COUNTING 1ST WORD (SIZE PER ENTRY). + IDIV CH,C + SKIPE CH+1 .SEE Q + TYPRE [ARG] ;TABLE MUST BE INTEGRAL NUMBER OF ENTRIES. + MOVEI IN,1(BP) ;IN -> 1ST WORD (NOT COUNTING ENTRY-SIZE WORD AT FRONT). + ADD OUT,IN ;OUT -> LAST WORD + 1 + HRRZ E,BP + IMULI E,5 ;E GETS CHAR ADDR OF START OF TABLE (INCLUDING DOPE WORD). + CAML E,BFRTOP ;IF TABLE IS A PURE STRING, SET FRNOT, INDICATING + TRO FF,FRNOT ;NAME POINTERS ARE RELATIVE TO BOTTOM OF STRING (NEED E ADDED). + SUBI E,4 + TLO E,400000 + MOVE T,OUT ;SAVE BOUNDS OF WHOLE TABLE AS [E,T) ;] + HRRZS J ;J POINTS AT END OF STUFF IN STAB. + CAIGE J,STAB + JRST FOCMDU ;ARG NULL AFTER HACKING IT => NO GOOD. + JRST FOCMDN + +;NOW TRY TO NARROW THE RANGE [IN,OUT) WHICH THE OBJECT MIGHT BE IN. ;] +;E HAS CHAR ADDR START OF TABLE MINUS 4 (WITH SIGN SET), +;T -> WORD AFTER END, C HAS ENTRY SIZE IN WORDS, +;J POINTS TO LAST USED WORD IN STAB. +FOCMDN: MOVE CH,OUT + SUB CH,IN + CAMG CH,C + JRST FOCMDF ;NARROWED TO ONE ENTRY => IT'S THAT OR NOTHING. + IDIV CH,C ;HOW MANY ENTRIES THEN? + MOVE D,CH + LSH D,-1 ;BINARY SEARCH STEP IS HALF THAT MANY. + IMUL D,C + ADD D,IN ;GET PTR TO MIDDLE OF RANGE; COMPARE THAT POINT WITH TARGET. + CALL FOCMP + JRST [ MOVE OUT,D ;TARGET IS LESS => NARROW TO BOTTOM HALF-RANGE. + JRST FOCMDN] + JRST [ MOVE IN,D ;TARGET IS MORE => NARROW TO TOP HALF-RANGE. + JRST FOCMDN] + MOVE IN,D + JRST FOCMDW ;TARGET IS EQUAL => WE CERTAINLY WIN. + +;NARROWED TO JUST ONE ENTRY; IS IT GOOD? +FOCMDF: CAML IN,T + JRST FOCMDU + MOVE D,IN ;FIRST OF ALL, THIS ENTRY IS THAT LAST ONE L.E. TARGET. + CALL FOCMP ;SO ADVANCE TO THE FIRST ONE G.E. THE TARGET + CAIA + ADD IN,C ;SINCE THE TARGET MIGHT BE ABBREVIATION FOR THAT ONE. + CAML IN,T ;DETECT CASE THAT TARGET IS GREATER THAN ALL SYMBOLS + JRST FOCMDU + MOVE OUT,IN + ADD OUT,C + MOVE A,(IN) + CALL FOCMDA ;DOES TARGET ABBREVIATE ENTRY'S NAME? + JRST FOCMDU ;NO => TARGET NOT FOUND, RETURN 0. + JUMPE B,FOCMDW ;YES, MAY BE GOOD. IF EXACT MATCH, CERTAINLY GOOD. + TRNE FF,FRUPRW ;"^" AND NOT EXACT MATCH => IT'S "UNDEFINED". + JRST FOCMDU + CAMN OUT,T + JRST FOCMDW ;NO FOLLOWING ENTRY => NAME CAN'T BE AMGIBUOUS. + MOVE A,(OUT) ;DOES FOLLOWING ENTRY ALSO WIN? + CALL FOCMDA + JRST FOCMDW ;NO => THIS ENTRY WINS! + TRNE FF,FRARG ;AMBIGUOUS NAME. IF HAVE DEFAULT (ARG), RETURN IT. + JRST FOCMDU + TRZN FF,FRCLN ;OR ELSE MAYBE GIVE ERROR, + TYPRE [AVN] +FOCMDL: MOVEI A,-1(IN) ;MAYBE RETURN MINUS THE PLACE TO PUT THE NAME. + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + IDIVI E,5 ;E GETS WORD BEFORE THE WORD TABLE STARTS IN. + SUBM E,A + JRST POPJ1 + +FOCMDU: TRZE FF,FRARG ;HERE IF NAME IS UNDEFINED; IN -> PLACE TO INSERT IT. + JRST [ TRZ FF,FRCLN\FRUPRW + MOVE A,NUM + JRST POPJ1] + TRZN FF,FRCLN + TYPRE [UVN] + JRST FOCMDL + +FOCMDW: MOVE A,1(IN) ;FOUND THE TARGET. RETURN EITHER 2ND WORD OF ENTRY + TRZ FF,FRARG\FRUPRW + TLZ E,400000 + TRZN FF,FRCLN + JRST POPJ1 + MOVEI A,-1(IN) + IDIVI E,5 + SUB A,E + JRST POPJ1 ;OR THE INDEX OF THE ENTRY. + +;SKIP IF THE STRING IN STAB IS AN ABBREVIATION FOR THE STRING A POINTS TO +;(A HOLDS TECO STRING POINTER). +FOCMDA: TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;SKIP IF TARGET ABBREVIATES THE STRING A POINTS TO. + TYPRE [QNS] + MOVEI Q,STAB +FOCMDG: CAMLE Q,J + JRST POPJ1 ;JUMP IF TARGET ABBREVIATES ENTRY'S NAME. + JUMPE B,CPOPJ ;TARGET DOESN'T ABBREVIATE ENTRY'S NAME => TARGET NOT FOUND. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAME CH,(Q) + RET + SOS B + AOJA Q,FOCMDG + +;COMPARE STRING IN STAB (TARGET) WITH STRING THAT @(D) POINTS TO. SKIP ONCE +;IF TARGET BIGGER, SKIP TWICE IF EQUAL. +FOCMP: MOVE A,(D) ;GET THIS ENTRY'S NAME. + TRNE FF,FRNOT ;IF TABLE IS PURE STRING, "NAME POINTERS" ARE + ADD A,E ;ACTUALLY RELATIVE. + CALL QLGET0 ;DECODE AS STRING. + TYPRE [QNS] + MOVEI Q,STAB ;Q SCANS TARGET, BP SCANS THIS ENTRY'S NAME. +FOCMPL: JUMPE B,[CAMLE Q,J + JRST POPJ2 ;IF BOTH STRINGS EXHAUSTED, THEUY ARE EQUAL. + JRST POPJ1] ;TARGET HAS MORE => IT IS BIGGER. + CAMLE Q,J + RET ;TARGET EMPTY, BUT THIS ENTRY NAME HAS MORE => TARGET LESS. + ILDB CH,BP + CAIL CH,"A+40 + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMGE CH,(Q) + JRST POPJ1 ;TARGET IS BIGGER. + CAMLE CH,(Q) + RET ;TARGET SMALLER. + SOS B + AOJA Q,FOCMPL ;EQUAL SO FAR, KEEP LOOKING. + +SUBTTL DECODE A STRING POINTER + +;CH HAS QREG IDX; DON'T SKIP IF QREG NOT STRING. +;ELSE SKIP WITH B HOLDING # CHARS OF TEXT IN STRING (NOT INCLUDING HEADER), +;BP HOLDING A B.P. TO ILDB THE TEXT. CLOBBERS TT, TT1. +QLGET: MOVE A,(CH) +QLGET0: CAML A,[SETZ+LHIMAX*5*2000] + RET ;CAN'T BE EITHER PURE OR IMPURE SPACE. +QLGET1: MOVE BP,A + TLZ BP,400000 ;FLUSH THE SIGN BIT (SET IN ALL POINTERS) + CAMGE BP,BFRTOP ;IF IT'S IMPURE SPACE, + ADD BP,QRBUF ;POINTER IS RELATIVE TO START OF IMPURE SPACE. +QLGET2: PUSHJ P,GETBP +QLGET3: LDB B,BP + CAIN B,QRBFR + JRST QLGET5 + CAIE B,QRSTR + RET + AOS (P) +QLGET4: ILDB B,BP + ILDB TT,BP + ROT TT,7 + IOR B,TT + ILDB TT,BP + LSH TT,14. + IOR B,TT + SUBI B,4 + RET + +;HANDLE THE CASE IN WHICH QLGET IS CALLED ON QREG HOLDING A BUFFER. +QLGET5: CALL QLGET4 ;GET ADDR OF HEADER, MINUS 4, IN B. + ADDI B,4 + JUMPE B,CPOPJ ;GIVE 0 AS LENGTH OF DEAD BUFFER + SAVE T + SAVE C + MOVEI C,(B) ;IF THIS BUFFER IS CURRENT, THE VALUES IN ITS HEADER + CAMN C,BFRPTR ;MAY BE OUT OF DATE. UPDATE THEM BY RESELECTING. + CALL NEWBFR + MOVE BP,MFGPT(B) + CAMG BP,MFBEGV(B) + JRST QLGET6 + CAML BP,MFZV(B) ;IF THE GAP IS WHERE IT WILL DO HARM, THEN MOVE IT TO WHERE IT WON'T. + JRST QLGET6 + SAVE BFRPTR ;PUSH CURRENT BUFFER, + MOVEI C,(B) ;SELECT THE ONE BEING QLGET'ED + CALL NEWBFR + SAVE PT + MOVE BP,ZV + MOVEM BP,PT ;PUT PT WHERE WE WANT THE GAP TO BE + CALL GAPSL0 ;AND MOVE THE GAP THERE. (WITHOUT SETTING MODIFF, NOT REALLY MODIFYING) + REST PT + REST C ;POP THE SELECTED BUFFER. + CALL NEWBFR +QLGET6: REST C + MOVE BP,MFBEGV(B) ;GET VIRT ADDR OF BEGINNING OF BUFFER + MOVE T,MFZV(B) + SUB T,BP ;GET LENGTH OF BUFFER. + CAML BP,MFGPT(B) + ADD BP,MFEXTR(B) ;CONVERT VIRT ADDR TO REAL ADDR. + MOVE B,T + REST T + AOS (P) + JRST GETIBP ;RETURN IN BP, B.P. TO ILDB BUFFER. + +SUBTTL Q-REGISTER COMMANDS + +;FQ - RETURN LENGTH OF TEXT IN , OR -1 IF NOT TEXT. +QLEN: PUSHJ P,QREGX + PUSHJ P,QLGET0 +RETM1A: SKIPA A,[-1] + MOVE A,B + JRST POPJ1 + +;Q - RETURN CONTENTS OF QREG AS A NUMBER. +QREG: AOS (P) + JRST QREGX + +;% - INCREMENT , RETURN NEW VALUE. +PCNT: CALL QREGS ;READ QREG NAME, GET IDX IN CH. + AOS C,A ;INCREMENT. PUT IN C FOR USE2 AND IN A TO RETURN. + AOS (P) ;WE ALWAYS RETURN A VALUE. + JRST USE2 ;GO STORE BACK IN QREG. + +;U - PUT NUMERIC ARG IN . 2 ARGS => USE 2ND, RETURN 1ST. +USE: TRZN FF,FRARG + TYPRE [WNA] + ARGDFL + CALL QREGS +USE1: CAIN CH,A ;MAKE SURE U* IS A NO-OP. + JRST POPJ1 + TRZN FF,FRARG2 ;M,NUQ SHOULD RETURN M. + JRST USE2 + MOVE A,E + AOS (P) +;STORE THE CONTENTS OF C INTO THE QREG IN CH. +;B IS ASSUMED TO CONTAIN WHAT QREGX LEAVES THERE. +USE2: CAIN CH,$QBUFR ;SELECT A NEW BUFFER BEFORE! SETTING ..O, IN CASE IT GETS ERROR. + CALL BFRSET + SKIPE VARMAC + JUMPL B,USE3 ;IF SETTING A NAMED VARIABLE, SEE IF THERE'S A MACRO TO RUN. + MOVEM C,(CH) + RET + +USE3: SAVE A + SAVE B + SKIPN A,1(CH) ;LOOK AT THE THIRD WORD OF THE NAMED VARIABLE'S DATA BLOCK. + JRST USE4 ;(IF VARMAC IS SET, WE ASSUME THAT WORD EXISTS). + CALL QLGET0 ;IS IT A STRING? + JRST USE4 + ILDB B,BP ;DOES IT START WITH "!"? + CAIN B,"! + CALL [ CALL SAVACS ;BOTH YES => CALL IT WITH NEW VALUE OF VARIABLE AS ARG. + CALL MACXCP + JRST RSTACS] +USE4: MOVEM C,(CH) ;THEN, OR IN ANY CASE, SET THE VARIABLE. + JRST POPBAJ + +;FP RETURNS AN INDICATION OF 'S DATA TYPE: +;-4 => NUMBER (NOT IN RANGE FOR PURE OR IMPURE STRING SPACE) +;-3 => PURE OBJECT WITH MEANINGLESS HEADER +;-2 => IMPURE OBJECT WITH MEANINGLESS HEADER +;-1 => DEAD BUFFER +;0 => LIVING BUFFER +;1 => Q-VECTOR. +;100 => PURE STRING +;101 => IMPURE STRING +FDATTY: MOVNI A,4 + TRZN FF,FRARG + TYPRE [WNA] + TLZN C,400000 ;MUST BE CLOSE TO 400000,, TO BE ANYTHING BUT A NUMBER. + JRST POPJ1 + MOVE BP,C + CAML C,BFRBOT ;IS IT IN RANGE FOR IMURE SPACE? + JRST [ MOVE D,LHIPAG + IMULI D,5*2000 + CAMGE C,[LHIMAX*5*2000] ;NO, WHAT ABOUT PURE SPACE? + CAMGE C,D + JRST POPJ1 ;NO, ORDINARY NUMBER + AOJA A,FDATT2] ;YES, SEE WHAT KIND OBJECT (A _ -3) + ADD BP,QRBUF ;ADDR'S IN IMPURE SPACE ARE REL. TO QRBUF. + MOVNI A,2 +;A HAS -2 FOR IMPURE SPACE, -3 FOR PURE SPACE. +;SEE IF OBJECT IS STRING, BUFFER OR NOTHING. +FDATT2: CALL GETIBP + ILDB B,BP + CAIN B,QRSTR ;STRING => RETURN 100. OR 101. + JRST [ ADDI A,103. + JRST POPJ1] + CAME A,[-3] ;PURE AND NOT STRING => RETURN -3. + CAIE B,QRBFR ;IF IMPURE, MAYBE IT IS A BUFFER OR QVECTOR. + JRST POPJ1 ;NOTHING => RETURN -3 OR -2. + CALL QLGET4 ;BUFFER: IS IT STILL ALIVE? + ADDI B,4 ;B GETS BUFFER BLOCK ADDR, OR 0 IF DEAD BUFFER. + JUMPE B,RETM1A ;RETURN -1 IF DEAD. + MOVEI A,0 + MOVE C,(B) + TLNE C,MFQVEC + AOS A ;IF Q-VECTOR, RETURN 1, ELSE 0. + JRST POPJ1 + +QGET3: TRZ FF,FRARG\FRARG2 + JRST QGET4 + +;G COMMAND -- INSERT QREG IN BUFFER BEFORE PT. +;,G -- GET RANGE OF CHARS , FROM QREG. +;FS INSLEN$ IS SET TO # CHARS INSERTED. +;:G -- RETURN THE 'TH CHARACTER OF . +QGET: CALL QREGX +QGET4: CALL QLGET0 + JRST [ MOVE C,A ? JRST BAKSL1] + TRNN FF,FRARG + SETZ C, + CAMLE C,B ;MAKE SURE UNCOMMA'D ARG, IF ANY, IS WITHIN RANGE + MOVE C,B ;[0 , ] + SKIPGE C + SETZ C, + TRNE FF,FRARG ;DETECT THE 1-ARG CASE (ONLY LEGAL WITH COLON). + TRNE FF,FRARG2 + CAIA + JRST QGET7 + TRNN FF,FRARG2 ;(IF NO ARGS, C AND E MAY BE RANDOM. PREVENT 2<1 ERROR). + SETZB C,E + SKIPGE E + SETZ E, + CAMLE E,C ;MAKE SURE ARGS ARE IN INCREASING ORDER. + TYPRE [2%1] + TRNN FF,FRARG2 + SKIPA C,B ;IF NO ARGS, # CHARS TO INSERT IS LENGTH OF QREG. + SUB C,E ;IF ARGS, IT IS DIFFERENCE BETWEEN ARGS. + MOVEM C,INSLEN +QGETI: SAVE A + CALL SLP ;INSERT BUFFER SPACE OR PREPARE TO WRITE AT QRWRT. LEAVE BP. IN BP. + MOVE IN,BP + REST A + JUMPE C,SLPXIT + CALL QLGET0 ;IN CASE QREG IS BUFFER AND WAS MOVED BY SLPGET, + .VALUE ;RECOMPUTE THE BYTE PTR TO IT. + JUMPE E,QGET1 ;IF NOT STARTING AT BEGINNING OF STRING, + CALL GETCA ;MAKE B.P. -> ARG1'TH CHAR OF QREG. + ADD BP,E + CALL GETBP +QGET1: HLRZ CH,BP + HLRZ D,IN + CAIN CH,010700 + CAIE D,010700 ;IF WE'RE AT A WORD BOUNDARY IN BOTH QREG AND BUFFER, + JRST QGET2 + CAIGE C,5 ;AND TRANSFERING AT LEAST 1 WORD, + JRST QGET2 + IDIVI C,5 ;DO A BLT TO AVOID LOSING LOW BITS. + MOVEI CH,1(IN) + HRLI CH,1(BP) + ADD BP,C ;AND UPDATE BOTH B.P.'S TO POINT AFTER WHAT WE'RE BLT'ING. + ADD IN,C + BLT CH,(IN) + SKIPN C,D ;# CHARS NOT TRANSFERED BY THE BLT. + JRST QGET6 +QGET2: ILDB CH,BP + IDPB CH,IN + SOJG C,QGET2 +QGET6: MOVE BP,IN ;IF WRITING A STRING, SLPXIT REQUIRES B.P. TO LAST CHAR IN BP. +SLPXIT: TRZN FF,FRCLN ;WRITING IN BUFFER => FINISHED. + RET + TRZ FF,FRUPRW+FRARG+FRARG2 ;WRITING A STRING => FINISH CONSING AND RETURN IT. + AOS (P) + JRST QCLOSV + +QGET7: TRZN FF,FRCLN ;1 ARG TO G IS BAD NUMBER UNLESS WE HAVE A COLON. + TYPRE [WNA] + CAML C,B + TYPRE [ARG] + TRZ FF,FRUPRW+FRARG + CALL GETCA ;INCREMENT THE B.P. IN BP BY THE # CHARS WHICH IS THE ARG. + ADD BP,C + CALL GETBP + ILDB A,BP ;AND FETCH THAT CHARACTER AND RETURN IT AS VALUE OF :G. + JRST POPJ1 + +X: CALL QREGVS + CALL GETANU ;X COMMAND, GET ENDS OF AREA IN C,E. +X12: TRZ FF,FRARG\FRARG2 ;FLUSH ARG; AVOIDS LOSSAGE FOR X* WHICH RETURNS VALUE. + JUMPE B,X10 ;IS THE QREG SUBSCRIPTED? (X:Q(IDX)) + JSP TT,QREGVA ;IF SO, EXTRA HAIR IN CASE OUR CONSING + ;MOVES THE Q-VECTOR CONTAINING THE Q-REG. + ;CALLS X10, THEN RETURNS TO INSERT'S CALLER. + +X10: SAVE CH + SAVE B + TRZE FF,FRUPRW + PUSHJ P,QLGET0 ;APPENDING TO QREG-GET PREVIOUS LENGTH/LOCATION + SETZB B,BP + SAVE B + SAVE BP + CALL CHK1 + SUB C,E ;C HAS # CHARS TO X AWAY + ADDI C,4 ;THEN INCLUDE 4 CHARS FOR HEADER. + ADD C,-1(P) ;HOW MUCH SPACE, INCLUDING OLD STRING WE ARE APPENDING TO? + SAVE C + MOVN J,BEG + CALL SLPQGT ;MAKE SURE HAVE ENOUGH SPACE IN IMPURE STRING SPACE. + ADD J,BEG ;CHANGE IN BEG = AMOUNT BUFFER MOVED. + ADD E,J ;RELOCATE ADDR OF START OF AREA OF BUFFER TO X FROM. + MOVE C,(P) ;GET LENGTH INCL. HEADER. + MOVEI B,QRSTR ;AND 1ST CHAR FOR HEADER. + CALL QHDRW1 ;WRITE THE HEADER IN BOTTOM OF FREE AREA. + REST C + SUBI C,4 ;C HAS LENGTH NOT INCL. HEADER. + SKIPN J,-1(P) ;ANY CHARS TO APPEND TO? + JRST X8 + SUB C,J ;YES, COUNT OFF THAT MANY AS INSERTED, + MOVE OUT,(P) ;GET BP TO ILDB OLD TEXT TO APPEND TO, +X7: ILDB CH,OUT ;AND COPY INTO NEW STRING. + IDPB CH,BP + SOJG J,X7 +X8: MOVE IN,E +X1: SOJL C,X2 ;MAYBE INSERTED ALL THE CHARS. + CALL GETINC ;IF NOT, INSERT THE NEXT. + IDPB CH,BP + JRST X1 + +X2: CALL GETCA + AOS OUT,BP ;GET CHAR ADDR OF LAST+1. + TRZ FF,FRCLN\FRUPRW + SUB P,[2,,2] ;FLUSH INFO ON OLD STRING TO APPEND TO. + REST B + JRST QCLOSP ;POP QREG ADDR AND STORE STRING IN IT. + +SUBTTL Q-REGISTER PDL + +;[ - PUSH ONTO QREG PDL. ;] +OPENB: ARGDFL ;MAKE -[0 THE SAME AS -1[0 ;]] + CALL QREGX ;READ THE QREG VALUE IN A AND ADDR IN CH. + SAVE CH + SKIPLE B ;IF THIS QREG IS REALLY AN ELT OF A QVECTOR, + TYPRE [IQN] ;AUTO-UNWIND WOULD LOSE, SO COMPLAIN. + SKIPGE B + MOVE CH,IN ;FOR NAME QREGS, PUSH INTERNED NAME-STRING AS QREG ADDR. + SAVE B ;PRESERVE FLAG FOR USE1. + MOVE B,PF + CAMN B,PFTOP ;CHECK FOR OVERFLOW BEFORE WRITING ANYTHING. + TYPRE [QRP] + PUSH B,A ;THEN PUSH OLD CONTENTS + CALL OPENB3 ;GO PUSH ADDR OF QREG (FOR UNWINDING) AND RETURN. + REST B + REST CH ;GET BACK ACTUAL LOCATION OF QREG + TRZN FF,FRARG ;AND IF WE HAVE ARG, STORE ARG INTO IT. + RET + JRST USE1 ;DO IT VIA USE SO THAT STORING INTO ..O WORKS. + +OPENB2: MOVE B,PF + CAMN B,PFTOP ;DETECT OVERPUSH BEFORE A PDLOV INT HAPPENS. +OPENB1: TYPRE [QRP] + PUSH B,(CH) +OPENB3: PUSH B,CH +FSQPU2: MOVEM B,PF + POPJ P, + +;[[ ;] - POP FROM QREG PDL INTO . ]* POPS AND RETURNS AS VALUE. +CLOSEB: CALL QREGVS ;CAN MAKE US SKIP! + CAIA +;POP INTO ADDRESS SUPPLIED IN CH. ASSUME IT'S NOT A NAMED VARIABLE. +CLOSB2: SETZ B, ;B SUPPLIES INFORMATION TO USE2. + MOVE A,PF + CAMN A,PFINI ;DETECT UNDERFLOW FIRST THING. + TYPRE [QRP] + POP A,C + POP A,C ;C GETS VALUE POPPED FROM SLOT. + MOVEM A,PF ;MARK SLOT GONE BEFORE WE STORE, SINCE USE2 CAN ERR. + JRST USE2 + +;FS QPPTR $ -- GET OR SET QREG PDL POINTER. +;TAKES AND RETURNS # ENTRIES ON STACK. +FSQPPT: HRRZ A,PF + SUBI A,PFL-1 ;GET 2*<# ENTRIES NOW ON STACK> + LSH A,-1 ;A HAS VALUE TO RETURN. + TRZN FF,FRARG + JRST POPJ1 ;NO ARG => JUST RETURN THE VALUE. + CALL FSQPRG ;CONVERT ARG TO NEW PDL PTR. + MOVEM C,PF ;STORE NEW CONTENTS. + JRST POPJ1 + +;HANDLE ARGUMENT DECODING FOR FS QP SLOT, FS QP PTR, AND FS QP UNWIND. +FSQPRG: ARGDFL + JUMPL C,FSQPR1 + LSH C,1 ;ARG -> PTR TRANSFORMATION IS INVERSE OF + HRLI C,(C) ;PTR -> VALUE TRANSFORMATION DONE ABOVE. + ADD C,PFINI + CAMLE C,PF + JRST TYPAOR ;DON'T ALLOW REF. TO CELLS ABOVE CURRENT POINTER POS. + RET + +FSQPR1: LSH C,1 ;NEGATIVE ARG IS RELATIVE TO CURRENT POINTER. + HRLI C,-1(C) + ADD C,PF + CAMGE C,PFINI ;DON'T ALLOW REF BELOW BOTTOM OF QREG PDL. + JRST TYPAOR + RET + +PFINI: -LPF-1,,PFL-1 +PFTOP: -1,,PFL+LPF-1 + +;FS QP HOME$ RETURNS A STRING WHICH IS THE NAME OF THE Q-REG THAT WAS +;PUSHED INTO PDL SLOT . :FSQP HOME$ RETURNS A NUMBER THAT ENCODES +;THAT NAME - SUCH NUMBERS ARE USEFUL IN THAT, IN A GIVEN TECO, EACH QREG +;HAS A UNIQUE NUMBER. WITH NO COLON, IF THE SLOT WAS PUSHED WITH +;F[FOO$, WE RETURN "FSFOO$". ;] +;^ FS QPHOME$ CONVERTS AN NUMBER WHICH IS A :FSQPHOME VALUE INTO A +;DESCRIPTIVE FSQPHOME$-STYLE STRING. SO :FSQPHOME$ ^ FSQPHOME$ = FSQPHOME$. +FSQPHO: TRZN FF,FRARG + TYPRE [WNA] + TRZE FF,FRUPRW + JRST FSQPH2 + CALL FSQPRG ;FIND SLOT . + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + MOVE C,2(C) ;GET WHERE PUSHED FROM. + MOVE A,C +FSQPH2: TRZE FF,FRCLN ;NUMERIC FORM MAY BE WHAT WE WANT. + JRST POPJ1 ;OTHERWISE, MUST DECODE AND TURN INTO STRING: + ;ALREADY A STRING => IT IS VARIABLE NAME; PUT ALTMODES AROUND IT. + JUMPL C,[ MOVEM C,NUM + MOVEI A,[ASCIZ /[0 :I*Q0/] ;] + JRST MACXQV] ;THAT'S DONE MOST EASILY BY TECO COMMANDS. + MOVEI A,[ASCIZ /:I**/] + CAIN C,BAKTAB ;IF A [(...) PUSHED THIS SLOT, RETURN "*". ;] + JRST MACXQV + CAIGE C,FLAGSL*2 ;IF AN F[ PUSHED THIS, ;] + JRST [ MOVE C,FLAGS(C) ;RETURN NAME OF FLAG IN ASCII. + JRST FSIXFL] + MOVE E,C + MOVEI C,6 ;OTHERWISE IT WAS A NORMAL QREG OR A ^R COMMAND DEFINITION. + CALL QOPEN ;SO START CONSING UP A STRING WITH THE NAME. + MOVEI CH,"Q + IDPB CH,BP + CAIGE E,RRMACT + JRST FSQPH1 + SUBI E,RRMACT ;IT WAS A ^R COMMAND. WHAT WAS 9-BIT CHARACTER? + IDIVI E,200 + CALL FSQPH. ;PUT OUT 1 DOT FOR CTL, 2 FOR META, 3 FOR BOTH. + MOVEI CH,^R + IDPB CH,BP +FSQPH3: IDPB J,BP ;THEN THE ASCII PART OF THE CHARACTER. + AOS (P) + JRST QCLOSV ;INISH CONSING THE STRING AND RETURN IT. + +FSQPH1: SUBI E,QTAB ;ORDINARY OLD-FASHIONED QREG. + IDIVI E,36. ;HOW MANY DOTS? + CALL FSQPH. + ADDI J,"0 ;CONVERT WHAT'S LEFT TO A LETTER OR DIGIT. + CAILE J,"9 ;(STARTS OUT AS IDX IN QRB, QRB. OR QRB..). + ADDI J,"A-"0-10. + JRST FSQPH3 + +FSQPH.: MOVEI CH,". ;OUTPUT DOTS THRU BP IN BP. J SAYS HOW MANY. + JUMPE E,CPOPJ + IDPB CH,BP + SOJA E,FSQPH. + +MACXQV: CALL MACXQW ;EXECUTE A MACRO IN A AND RETURN THE VALUE IT RETURNS. + MOVE A,NUM + TRZ FF,FRARG\FRARG2\FRUPRW\FRCLN + JRST POPJ1 + +; FS QPSLOT $ -- RETURNS CONTENTS OF SLOT . +;,FS QPSLOT $ ALSO SETS THE SLOT TO . +FSQPSL: MOVE E,SARG + TRZN FF,FRARG ;MUST HAVE ARG TO KNOW WHICH SLOT. + TYPRE [WNA] + TRZE FF,FRARG2 ;IF 1 ARG, IT'S SLOT #, IN C. + TRO FF,FRARG ;IF 2, SLOT #'S IN C, NEW VALUE IN E. + CALL FSQPRG ;FIND ADDRESS OF DESIRED SLOT IN C. + CAML C,PF ;FSQPGR ALLOWS CURRENT PDL PTR AS ARG, BUT THAT ISN'T + TYPRE [AOR] ;LEGAL AS THE NUMBER OF A SLOT. + EXCH C,E + AOJA E,FSNOR1 ;WORD TO GET OR SET IS 2ND WORD OF SLOT. + +; FS QPUNWIND $ -- UNWINDS QREG PDL TO LEVEL . +;THAT IS, POPS EACH ENTRY BACK INTO THE QREG IT WAS PUSHED FROM. +FSQPUN: TRZN FF,FRARG ;NO ARG => ASSUME 0. + SETZ C, + PUSHJ P,FSQPRG ;COMPUTE LEVEL TO UNWIND TO FROM ARG. +FSQPU0: SAVE STOPF ;DON'T QUIT WHILE UNWINDING!! + SETZM STOPF ;MIGHT WANT TO SET NOQUIT INSTEAD, BUT THIS IS SAFER. +FSQPU7: MOVE B,PF +FSQPU1: CAMG B,C ;DOWN TO DESIRED LEVEL? + JRST [ REST STOPF + JRST FSQPU2] ;JUST SET PF & EXIT + POP B,CH ;POP 1 ENTRY + JUMPL CH,FSQPU5 ;JUMP IF "QREG ADDR" IS A STRING - MEANS IT IS QREG NAME, A LA QFOO. +IF2 IFG FLAGSL*2-QTAB,.ERR QRP CAN'T TELL [ FROM F[ + ;]] + CAIGE CH,FLAGSL*2 ;IF ENTRY WAS MADE BY AN F[, POP INTO FLAG. ;] + JRST FSQPU4 + CAIN CH,$QUNWN ;IF UNWINDING Q..N, + JRST [ MOVE A,(CH) + POP B,(CH) ;POP IT, STORING OR SAVING ALL TEMPS, + JRST FSQPU3];AND GO MACRO IT. + POP B,(CH) + CAIN CH,$QBUFR ;IF UNWINDING Q..O, WE'RE SELECTING A NEW BUFFER. + CALL BFRSE2 + JRST FSQPU1 + +FSQPU4: SAVE C ;HANDLE UNWINDING AN FS FLAG. + POP B,C ;GET OLD FLAG VALUE, AS ARG. + MOVS E,FLAGD(CH) + SAVE FF + IORI FF,FRARG ;SAY THERE'S AN ARG. + MOVEM B,PF + CALL (E) ;SET THE FLAG. + JFCL + REST FF ;DON'T LET THE ROUTINE CLOBBER THE VALUES. + REST C + JRST FSQPU7 + +FSQPU3: JUMPE A,FSQPU1 + JSP T,OPEN1 ;HANDLE UNWINDING Q..N; MUST PRESERVE TEMPS. +FSQPU6: SAVE C + MOVEM B,PF + CALL MACXQW ;EXECUTE THE INNER BINDING OF ..N (WHICH IS IN A). + REST C + HRROI T,FSQPU7 + TRZ FF,FRARG+FRARG2+FRSYL+FROP + JRST CLOSE2 ;POP WHAT OPEN PUSHED, AND GO TO FSQPU0 + +FSQPU5: MOVE A,CH ;POP INTO LONG-NAMED QREG WHOSE NAME IS IN CH. + JSP T,OPEN1 + MOVEM A,SARG + TRO FF,FRARG\FRARG2 + TRZ FF,FRCLN\FRUPRW\FRSYL\FROP + POP B,NUM + MOVEI A,[ASCIZ /[0 U0/] ;] + JRST FSQPU6 + +SUBTTL M SUBROUTINE CALL COMMAND + +;M SAVES CURRENT EXECUTION POINTERS AND THEN EXECUTES CONTENTS OF . + ; MAY CONTAIN TEXT OR THE ADDRESS OF A BUILT-IN FUNCTION. +;:M JUMPS INTO THE STRING IN AND DOESN'T RETURN - BUILT-IN FUNCTIONS NOT ALLOWED. +MAC: CALL QREGX ;GET A NAME AND PUT ITS ENTRY IN A + CAIL CH,RRMACT ;FOR M^R ETC, PUT THE CHARACTER WHOSE DEFINITION IS BEING RUN + CAIL CH,RRMACT+1000 + JRST MAC6 + SUBI CH,RRMACT ;IN Q..0. + MOVEM CH,$Q..0 +MAC6: MOVE CH,$Q..0 +MAC5: CALL QLGET0 ;REALLY TEXT? IF SO, LENGTH IN B, BP TO ILDB TEXT IN BP. + JSP T,MACN ;NOT REALLY TEXT; USE AS BUILT-IN FUNCTION ADDRESS. + TRNE FF,FRCLN ;IF YOU ARE DOING A :M, DON'T PUSH THE CALLING STRING + JRST MAC3 +MAC2: MOVEM BP,INSBP ;ELSE PUSH THE STRING CONTAINING THE "M" BEFORE JUMPING. + CALL PUSMAC ;WE SAVE THE B.P. TO THE MACRO BEING CALLED IN INSBP + MOVE BP,INSBP ;SO IT WILL BE RELOCATED BY GETFR2. + MOVEI CH,0 + IDPB CH,MACPDP ;PUSH A 0 (MACRO CALL) ENTRY. + .I MACSPF=PF ;REMEMBER QREG PDL LEVEL FOR THIS FRAME TO POP TO. + SETZM MACBTS +MAC3: MOVEM A,CSTR ;STORE TECO OBJECT POINTER TO WHAT WE'RE CALLING. + SETZ TT, ;PUT IN MACBTS INDICATIONS OF HOW MANY ARGS THERE ARE. + TRNE FF,FRARG ;MFBA1 AND MFBA2 ARE SIMPLY SET. + TLO TT,MFBA2 + TRNE FF,FRARG2 + TLO TT,MFBA1 + TRNE FF,FRUPRW ;MFBATSN IS SET TO WHETHER THERE WAS AN @, EXCEPT + TLO TT,MFBATSN + MOVSI C,MFBATSN ;THAT :M WITH NO @ DOES NOT CLEAR MFBATSN IF IT WAS SET. + ANDM C,MACBTS + IORM TT,MACBTS + MOVEI C,1 + TRZE FF,FRUPRW ;GET THE FIRST MACRO ARGUMENT (OR, IF NONE, + TRNE FF,FRARG ;EITHER 0 OR (IF FRUPRW) 1). + MOVE C,NUM + ARGDFL + MOVEM C,MARG2 ;SAVE IT AS THE THING ^Y GETS + MOVE C,SARG ;TRY FOR A SECOND ARGUMENT + TRNN FF,FRARG2 + MOVEI C,0 ;IF NONE, THEN 0 + MOVEM C,MARG1 ;SIGH + MOVEM B,COMCNT ;STORE LENGTH OF TEXT AS LENGTH OF MACRO. + MOVEM BP,CPTR ;GIVE RCH THE BP TO THE TEXT. + ILDB CH,BP ;NOW, START EXECUTING THE MACRO, BUT FIRST + CAIE CH,"W+40 ;UNLESS THE FIRST CHARACTER IS "W", MAYBE INVOKE FS STEPMAC$ + CAIN CH,"W + JUMPN B,CD + CALL CTLM2 + JRST CD + +;A IS ADDR 1ST WD ASCIZ STRING, EXECUTE STRING AS MACRO. +MACXCW: HRLI A,BP7 +MACXCT: SETO B, ;A IS BP -> STRING. + MOVE BP,A ;MUST COUNT # CHARS IN STRING. +MACXC1: ILDB CH,A + AOJ B, + JUMPN CH,MACXC1 + MOVE A,BP ;GIVE THE BYTE POINTER AS THE FS BACK STR$ SINCE THERE'S NO + JRST MACXC2 ;ACTUAL TECO OBJECT POINTER WE CAN USE. + +MACXQW: JUMPGE A,MACXCW ;EXECUTE EITHER A QREG OR AN ASSEMBLED-IN ASCII STRING. + ;DISTINGUISH THEM SINCE STRING QREGS ARE NEGATIVE. + +;A HAS CONTENTS OF A QREG; PUSHJ HERE TO EXECUTE IT, POPJ'ING AFTER IT FINISHES. +MACXQ: CALL QLGET0 ;GET LENGTH AND STARTING BP OF STRING. + JSP T,MACN1 ;(QREG CONTAINS A NUMBER; PUSHJ TO THAT LOCATION). +MACXC2: TRZ FF,FRUPRW + SAVE MACPTR + SAVE MACXP + MOVEM P,MACXP .SEE RCH2 + SETOM MACPTR ;-1 SAYS CALLED FROM MACXP. + JRST MAC2 + +MACN: TRZE FF,FRCLN ;HERE WHEN AN "M" COMMAND CALLS A BUILT-IN FUNCTION. + SETZM COMCNT ;:M TO BUILTIN => JUST DISCARD REST OF STRING AT THIS LEVEL. + SAVE [CDRET] ;POPJ TO EITHER (JRST TO) CD, OR VALREC IF SKIP. + MOVEI T,2+[ SUB P,[1,,1] ? JRST MAC5] +;T HAS 2+ ADDR TO GO TO IF THIS NUMBER "TURNS OUT" TO BE A STRING AFTER ALL. +;2+ IS SO CAN JSP AFTER A FAILING CALL TO QLGET0. +MACN1: ARGDFL ;MACROING A QREG CONTAINING A NUMBER. + TRNN FF,FRARG + MOVEI C,1 + MOVE E,A + ANDI A,-1 + CAIE A,RRINDR ;TRACE THRU INDIRECTD DEFINITIONS HERE, SO THAT + JRST RRLP7H + HLRE A,E ;IF THE ULTIMATE TARGET IS A STRING, WE CAN MACRO IT + SUB CH,A ;WITH OUT GOING THROUGH RRMACR. + MOVE A,RRMACT(CH) + JRST -2(T) + +;FSBACKTRACE$ - INSERT IN THE BUFFER THE TEXT OF THE MACRO IN FRAME . +;LEAVE POINT AT THE PC OF THAT FRAME. +FSBAKT: CALL BACKTR ;FIND THE FRAME THE USER SPECIFIED. +FSBAK1: CALL MFBEGP ;GET STARTING B.P. IN B AND CURRENT PC IN C. + SAVE B + ADD C,MFCCNT(A) ;C GETS TOTAL SIZE OF MACRO. + MOVEM C,INSLEN ;INSERT SPACE IN BUFFER TO HOLD THE STRING. + CALL SLPGET + MOVN A,MFCCNT(A) + ADDM A,PT + MOVE IN,BP + REST BP + JRST QGET1 + +;FS BACK PC$ - RETURN RELATIVE PC (OFFSET FROM 1ST CHAR) OF MACRO IN FRAME . +;,FS BACK PC$ - SET RELATIVE PC OF THAT FRAME TO . +; SETTIN THE PC TO A VERY LARGE NUMBER PUTS IT AT THE END OF THE STRING. +FSBAKP: CALL BACKTR + CALL MFBEGP ;C GETS CURRENT RELATIVE PC. + SAVE C + TRZN FF,FRARG2 ;DO WE WANT TO CHANGE IT? + JRST POPAJ1 + ADD C,MFCCNT(A) + MOVE E,SARG + CAMLE E,C ;IF ARG IS GREATER THAN # OF CHARS IN STRING, MAKE POINT AT END. + MOVE E,C + SKIPGE E ;NEGATIVE PC'S ARE MEANINGLESS. + TYPRE [AOR] + ADD BP,E ;IF SO, ADD DESIRED PC TO CHAR ADDR OF START + CALL GETBP ;CONVERT TO B.P. AND STORE AS THE FETCH POINTER. + MOVEM BP,MFCPTR(A) + SUB E,(P) ;GET THE DIFFERENCE BETWEEN NEW PC AND OLD + MOVNS E + ADDM E,MFCCNT(A) ;AND UPDATE NUMBER-OF-CHARS-TO-GO BY THAT MUCH. + JRST POPAJ1 + +;FS BACK QP PTR$ - RETURN FS QP PTR$ OF BOTTOM OF QP FRAME +;BELONGING TO MACRO FRAME . THIS IS THE QP PTR WHICH +;^\'ING THAT FRAME WOULD UNWIND TO. +FSBAKQ: CALL BACKTR + HRRZ A,MFPF(A) ;GET SAVED QREG PDL POINTER, + SUBI A,PFL-1 ;CONVERT IT TO A PDL DEPTH INDEX. + LSH A,-1 + JRST POPJ1 + +;FS BACK ARGS$ - RETURN ARGS OF MACRO FRAME . +FSBAKA: CALL BACKTR ;GET POINTER TO FRAME IN A. + MOVE C,MFLINK(A) ;GET FRAME'S SAVED MACBTS, MARG1, MARG2 + MOVE B,MFARG1(A) + MOVE A,MFARG2(A) + JRST FCTLX2 ;AND RETURN APPROPRIATE VALUES, A LA F^X. + +;FS BACK STRING$ - RETURN STRING POINTER TO MACRO BEING EXECUTED IN FRAME . +;IF THAT MACRO ISN'T A STRING, WE RETURN A BYTE POINTER (A NUMBER). +;THERE IS NO WAY TO DECODE SUCH BYTE POINTERS, BUT THEY CAN BE COMPARED RELIABLY. +FSBAKS: CALL BACKTR ;GET FRAME POINTER IN A. + MOVE A,MFCSTR(A) + JRST POPJ1 + +;SUBROUTINES FOR FS BACK WHATEVER. + +;A POINTS AT A MACRO FRAME (OR AT COMCNT); RETURN IN B A B.P. TO THE MACRO'S START, +;AND IN C THE DISTANCE IN CHARACTERS OF THE CURRENT PC FROM THE START. +MFBEGP: MOVE BP,MFCPTR(A) + CALL GETCA + MOVE C,BP + SAVE A + MOVE A,MFCSTR(A) + CALL QLGET0 + MOVE BP,A + MOVE B,BP ;B GETS B.P. TO START OF MACRO. + CALL GETCA ;BP GETS CHAR ADDR OF IT. + SUB C,BP + JRST POPAJ + +;RETURN IN A A POINTER TO THE MACRO FRAME SPECIFIED BY THE DEPTH IN C. +;IF C IS POSITIVE, IT IS COUNTING FROM THE BOTTOM OF THE STACK +;(0 = OUTERMOST FRAME). IF IT IS NEGATIVE, IT COUNTS DOWN FROM THE +;CURRENT FRAME (-1 = THIS FRAME'S CALLER). +BACKTR: ARGDFL Z + MOVNS C + SKIPG C + ADD C,MACDEP ;C NOW HAS NUMBER OF FRAMES TO GO OUT FROM CURRENT ONE. + SOJL C,TYPAOR ;ILLEGAL TO REFER TO CURRENT FRAME, SINCE IT ISN'T STORED THE SAME WAY. + MOVE B,MACXP + HRRE A,MACPTR ;START WITH TOP OF MACPTR STACK (CURRENT MACRO'S CALLER). +BACKT0: JUMPGE A,BACKT2 + HRRE A,-1(B) ;WHENEVER A MACXQ CALL IS FOUND, GO BACK THROUGH IT. + MOVE B,(B) + JRST BACKT0 + +BACKT2: JUMPE A,TYPAOR + JUMPE C,[ ;HAVE WE GONE OUT ENOUGH FRAMES? + SUBI A,MFLINK + RET] + HRRE A,(A) ;NO, GO OUT ONE FRAME MORE. + SOJA C,BACKT0 + +GMARG2: SKIPA A,MARG2 +GMARG1: MOVE A,MARG1 + JRST POPJ1 + +SUBTTL CONVERT NUMBERS TO STRINGS + +BAKSL: TRZ FF,FRUPRW + TRZE FF,FRARG + JRST BAKS1A + SETZ A, + MOVE IN,PT + PUSHJ P,GETINC + TRZE FF,FRCLN + CAIE CH,"- + JRST BAKSL7 + TRO FF,FRARG +BAKSLA: PUSHJ P,GETINC +BAKSL7: CAMLE IN,ZV + JRST BAKSL3 +BAKSL6: CAIG CH,"9 + CAIGE CH,"0 + SOJA IN,BAKSL2 + JFCL 10,.+1 + IMUL A,IBASE + JFCL 10,[TLC A,400000 ? JRST .+1] ;MAKE OVERFLOW ACT AS IF UNSIGNED MULTIPLY. + ADDI A,-60(CH) + JRST BAKSLA + +BAKSL3: MOVE IN,ZV +BAKSL2: TRZE FF,FRARG + MOVNS A + MOVEM IN,PT + JRST POPJ1 + +;\ WRITE IN BASE IN ..E, INTO BUFFER. :\ CONS INTO STRING AND RETURN IT. +;,\ USE COLUMNS, MAKING LEADING SPACES IF NEEDED. +BAKS1A: MOVEI TT,40 + HRRM TT,DPT5 + TRZN FF,FRARG2 + JRST BAKSL1 + CAIL E,LTABS*5 ;DON'T ALLOW USELESSLY LARGE 1ST ARGS + TYPRE [AOR] ;SINCE MAKING THEM WORK PROPERLY WOULD BE A PAIN. + SOS TT,E + SKIPA BP,[DPT1] +BAKSL1: MOVEI BP,DPT + MOVE T,[(700)BAKTAB-1] + MOVEI E,0 + MOVEI CH,[IDPB CH,T ? AOJA E,CPOPJ] + HRRM CH,LISTF5 + PUSHJ P,(BP) + MOVE C,E + MOVEM C,INSLEN + CALL SLP ;INSERT THEM, OR PREPARE TO WRITE STRING. GET BP IN BP. + MOVE T,[440700,,BAKTAB] +BAKSLL: ILDB CH,T ;COPY THE PRINTED STUFF INTO INSERTED SPACE. + IDPB CH,BP + SOJG C,BAKSLL + JRST SLPXIT ;IN CASE OF :\, FINISH CONSING THE STRING. + +SUBTTL CONTROL CONSTRUCTS + +FDQUOT: SUB P,[1,,1] ;F" LIKE " BUT ARGUMENT REMAINS AS WELL AS BEING TESTED. + SKIPA A,[CD2A] +DQUOTE: MOVEI A,CD + CALL LRCH ;READ THE CONDITION NAME (B, C, G, L, E, N, #) + CAIN CH,"# ;IS THIS AN "ELSE"? + JRST [ CALL NOGO ;YES, FAIL: SKIP TO THE ', + JRST CD2A] ;RETURN WITHOUT FLUSHING VALUE. + CAIN CH,"' + JRST VCOND + SAVE A ;REMEMBER RETURN ADDRESS (CD OR CD2A). + CALL CONDIT ;DECODE THE CONDITION, + XCT A ;TEST IT, + TRC FF,FRCLN ;TAKE THE EQV OF ITS SUCCESS AND THE COLON FLAG. + TRZN FF,FRCLN + JRST CTLM2 ;NON-: CONDITION WON OR :-CONDITION LOST, INVOKE STEPPER AND RETURN. +NOGO: MOVEI A,0 ;CONDITION FAILED. SKIP TO THE ' AND CHECK FOR AN ELSE. + MOVE C,COMCNT ;REMEMBER WHERE STARTING FROM, SO IF HAVE UTC ERROR + MOVE E,CPTR ;CAN SIGNAL IT AT THE ". +NOGO1: SOSGE COMCNT + JRST [ MOVEM C,COMCNT + MOVEM E,CPTR + TYPRE [UTC]] + ILDB CH,CPTR + CAIN CH,"" + AOJA A,NOGO1 + CAIE CH,"' + JRST NOGO1 + SOJGE A,NOGO1 + CALL TRACS ;FOUND THE TERMINATING '. MENTION IT IF TRACING. + MOVE A,COMCNT + MOVE BP,CPTR +NOGO2: SOJL A,CPOPJ ;AFTER THE MATCHING ', CHECK FOR AN ELSE ("#) + ILDB CH,BP ;IS THE NEXT CHAR A DOUBLEQUOTE? + CAIE CH,^M + CAIN CH,^J ;ALLOW CRLFS TO INTERVENE BEFORE THE DOUBLEQUOTE. + JRST NOGO2 ;JUST PASS THEM BY. + SKIPGE TABMOD + CAIE CH,^I + CAIN CH,40 + JRST NOGO2 ;ALSO ALLOW SPACES BETWEEN. + CAIN CH,"! ;ALSO ALLOW TAGS BETWEEN. + JRST NOGO3 + CAIE CH,"" + RET ;NO - THERE IS NO "ELSE" + SOJL A,CPOPJ ;MAKE SURE A "#" FOLLOWS THE """". + ILDB B,BP + CAIE B,"# + RET + CALL TRACS ;THERE IS AN ELSE - TRACE THE " AND #. + MOVEI CH,"# + CALL TRACS + MOVEM BP,CPTR ;RESUME EXECUTION INSIDE THE ELSE CLAUSE. + MOVEM A,COMCNT + JRST CTLM2 ;WE HAVE JUST ENETERED AN ELSE CLAUSE, SO INVOKE STEPPER. + +NOGO3: SOJL A,CPOPJ + ILDB CH,BP ;SKIP UNTIL THE NEXT "!", THEN CONTINUE LOOKING FOR '"#'. + CAIE CH,"! + JRST NOGO3 + JRST NOGO2 + +;READ THE NAME OF A CONDITION, AND RETURN IN A +;AN INSTRUCTION TO SKIP IF THE CONDITION IS TRUE. +CONDIT: TRNN FF,FRARG + TYPRE [WNA] ;THIS IS A NUMERIC CONDITIONAL: SNARF THE ARG. + MOVEI A,C +IRPC Z,,[GLNE] + CAIN CH,"Z + HRLI A,(SKIP!Z) +TERMIN + CAIN CH,"A + MOVE A,[CALL DQTLET] + CAIN CH,"D + MOVE A,[CALL DQTDGT] + CAIN CH,"U + MOVE A,[CALL DQTUC] + CAIN CH,"C + MOVE A,[CALL DQT1] + CAIN CH,"B + MOVE A,[CALL DQT3] ;B => GET INSN TO SKIP IF GIVEN A BREAK CHARACTER. + TLNN A,-1 ;IF WE DIDN'T RECOGNIZE THE CONDITION, SIGNAL AN ERROR. + TYPRE [BD%] + RET + +DQT1: PUSHJ P,DQT3 ;SKIP IF CHAR IN C IS NOT A BREAK CHARACTER. + AOS (P) + RET + +DQTLET: CAIG C,"Z+40 ;SKIP IF CHARACTER IN C IS A LETTER. + CAIGE C,"A+40 +DQTUC: CAIG C,"Z ;SKIP IF THE CHARACTER IN C IS AN UPPER-CASE LETTER. + CAIGE C,"A + RET + JRST POPJ1 + +DQTDGT: CAIG C,"9 ;SKIP IF THE CHARACTER IN C IS A DIGIT. + CAIGE C,"0 + RET + JRST POPJ1 + +VCOND: CALL LRCH ;"' COMMAND: TEST A CONDITION, + CALL CONDIT ;BUT RETURN -1 IF IT SUCCEEDS, OR ELSE 0. + XCT A ;THUS, 0"'N RETURNS 0 BUT 1"'N RETURNS -1. + TRC FF,FRCLN + TRZ FF,FRARG + SAVE [CDRET] + TRZN FF,FRCLN + JRST NRETM1 + JRST NRET0 + +EXCLAM: SETOM BRC1 ;HANDLE "!" AS A COMMAND. + CALL SKRCH ;[ ;SKIP UNTIL THE NEXT "!". BRC1 INHIBITS MOST ^] FORMS. + CAIE CH,"! + JRST .-2 + SETZM BRC1 + CALL TRACS ;IN TRACE MODE, TRACE A SECOND "!" TO MINIMIZE USER CONFUSION. + JRST CD5A + +LRCH: PUSHJ P,RCH + TRNE CH,100 + ANDCMI CH,40 + POPJ P, + +;HANDLE THE "O" COMMAND: O$ JUMPS TO !!. ":O" DOES NOT ERR IF TAG UNFOUND. +OG: MOVE A,CPTR ;FIRST, LOOK IN THE JUMP CACHE FOR ADDR OF "O" CMD. + MOVE C,A + ANDI C,16 ;GET INDEX IN CACHE OF ENTRY PAIR THAT'S APPRO. + CAMN A,SYMS(C) ;IS FIRST ENTRY FOR THIS "O"? + JRST OGFND + CAMN A,SYMS+1(C) ;IS THE SECOND? + AOJA C,OGFND ;IF FOUND, GET PLACE TO JUMP TO FROM CACHE ENTRY. +;THIS JUMP NOT IN CACHE; MUST ACTUALLY SEARCH. + SAVE CPTR ;PUSH INFO ON WHERE TO STORE INTO CACHE WHEN FIND TAG. + SAVE C ;THESE 2 WORDS ARE NOT USED FOR ANY OTHER PURPOSE. + CALL OARG ;READ IN THE STRING ARG. + MOVEI A,COMCNT + CALL MFBEGP ;FIND START OF CURRENT MACRO. + EXCH BP,B ;NOW BP HAS BP TO START, B HAS STRING POINTER TO MACRO, + ADD C,COMCNT ;C HAS TOTAL SIZE OF MACRO. + CAMGE B,BFRTOP + CAMGE B,QRWRT ;ARE WE IN A STRING? OR IN A BUFFER OR CBUF? + CAMGE B,QRBUF + SETOM BRCFLG ;JUMPS IN BUFFERS AND CBUF AREN'T CACHED, + ;SINCE THE DATA AT A GIVEN LOCATION IS LIKELY TO CHANGE. + +;NOW SEARCH FOR THE DESIRED LABEL. + TRNE FF,FRUPRW + SOS J +OG4: MOVEI D,STAB +OG5: CAIN D,1(J) + JRST OG3 + SOJL C,OGUGT ;COMPARE MACRO CHAR BY CHAR AGAINST TAG. + ILDB CH,BP + CAIL CH,"A+40 ;CONVERT TO UPPER CASE. + CAILE CH,"Z+40 + CAIA + SUBI CH,40 + CAMN CH,(D) + AOJA D,OG5 + TLNE BP,760000 ;AT WORD BOUNDARY => TRY TO SKIP WORDS FAST. + JRST OG4 +OG6: SUBI C,5 + JUMPL C,OG7 ;NOT A WHOLE WORD LEFT TO SCAN => CAN'T GO FAST. + MOVE D,1(BP) ;ELSE GET THE NEXT WORD + XOR D,[ASCII /!!!!!/] ;AND SEE IF THERE ARE ANY !'S IN IT. + TLNE D,(177_35) + TLNN D,(177_26) + JRST OG7 + TRNE D,177_1 + TRNN D,177_10 + JRST OG7 + TDNN D,[177_17] + JRST OG7 + AOJA BP,OG6 ;THERE ARE NONE, SO WKIP THIS WORD. + +OG7: ADDI C,5 ;FOUND AN !, SO SCAN SLOWLY TO LOCALIZE IT. + JRST OG4 + +;COME HERE WHEN WE HAVE FOUND THE TAG BY SEARCHING. +OG3: MOVEM C,COMCNT ;SET COMMAND-READING POINT TO WHERE WE FOUND THE TAG. + MOVEM BP,CPTR + REST A ;REMEMBER IDX OF CACHE ENTRY TO STORE IN. + REST B ;REMEMBER CPTR OF "O" TO PUT IN CACHE + SKIPE BRCFLG + JRST OGXIT ;BUT MAYBE CACHE IS INHIBITED FOR THIS JUMP. + EXCH B,SYMS(A) ;STORE THIS JUMP IN 1ST ENTRY OF PAIR, AND MOVE + MOVEM B,SYMS+1(A) ;OLD CONTENTS OF 1ST ENTRY INTO 2ND. + MOVE B,COMCNT + EXCH B,CNTS(A) ;CACHE ENTRY CONTAINS CPTR OF "O", + MOVEM B,CNTS+1(A) ;CPTR OF TAG, AND COMCNT OF TAG. + MOVE BP,CPTR + EXCH BP,VALS(A) + MOVEM BP,VALS+1(A) + JRST OGXIT + +OGFND: TRNE FF,FRTRACE + CALL OARG ;IF TRACING, READ IN ARGUMENT SO IT WILL SHOW IN TRACE. + MOVE A,VALS(C) ;COME HERE WHEN THE JUMP IS FOUND IN THE CACHE. + MOVEM A,CPTR + MOVE A,CNTS(C) + MOVEM A,COMCNT +OGXIT: TRZ FF,FRCLN + TRZN FF,FRUPRW + JRST CD + MOVEI CH,"! + CALL TRACS + JRST EXCLAM ;@ O => WE'RE INSIDE A LABEL, SO WE MUST SKIP TO THE END. + +OGUGT: TRZN FF,FRCLN ;COME HERE IF TAG IS NOT FOUND. + TYPRE [UGT] + SUB P,[2,,2] + JRST CD + +;READ IN A STRING ARG, AND SAVE IT 1 CHAR PER WORD +;IN STAB, WITH AN ! BEFORE AND AFTER. LEAVE J -> LAST +;WORD USED IN STAB. USED BY "O" AND "F;". ;[ +;BRCFLG LEFT NONZERO IFF SOME UNPREDICTABLE ^] CALLS TOOK PLACE. +;CLOBBERS A, CH. +OARG: MOVEI J,STAB+1 + MOVEI A,41 + MOVEM A,-1(J) + SETZM BRCFLG ;[ ;ANY ^] CALLS WE WORRY ABOUT WILL SET BRCFLG. +OGNF1: CAIN J,STAB+LTABS + TYPRE [STL] + CALL ORCH + HRRZM CH,(J) + SKIPN SQUOTP + CAIE CH,ALTMOD + AOJA J,OGNF1 + MOVEM A,(J) + RET + +ORCH: CALL RCH ;READ CHAR AND CONVERT L.C. LETTERS (ONLY) TO U.C. + CAIL CH,"A+40 + CAILE CH,"Z+40 + RET + SUBI CH,40 + RET + +;SEMICOLON AND ITERATIONS. + +SEMICL: SKIPN ITRPTR + TYPRE [SNI] + TRNN FF,FRARG + MOVE C,SFINDF + TRNN FF,FRUPRW ;UNLESS THE ^ FLAG IS SET, CONVERT SIGN TO NONZERO-NESS. + ASH C,-35. + MOVE A,[JUMPN C,CD] ;THEN WIN (KEEP ITERATING) IF NONZERO, + TRNE FF,FRCLN ;OR, IF COLON, WIN IF ZERO. + HRLI A,(JUMPE C,) + XCT A +INCMA0: MOVEI CH,"> ;"TRACE" A ">" TO HELP USER UNDERSTAND. + CALL TRACS + MOVEI A,0 + MOVE BP,CPTR + MOVE C,COMCNT ;SEARCH FOR THE ">" THAT ENDS THIS ITERATION. +INCMA1: SOJL C,[HRRO A,ITRPTR + CALL ITRPOP + TYPRE [UTI]] + ILDB CH,BP + CAIN CH,"< + AOJA A,INCMA1 + CAIE CH,"> + JRST INCMA1 + SOJGE A,INCMA1 + MOVEM BP,CPTR + MOVEM C,COMCNT + +;HERE THE CODE FOR ">", ";", "F;", AND ERRORS INSIDE ERRSETS, +;MERGES INTO ONE. +INCMA2: HRRO A,ITRPTR ;PTR TO INNERMOST ITER OR ERRSET. + HLRZ TT,ITRPTR ;TO INNERMOST ERRSET. + MOVEI E,(A) + CALL FSEMIP ;SKIP IF THIS ITERATION WAS A CATCH. + CAIN TT,(A) ;SKIP UNLESS IT WAS AN ERRSET. + SKIPA TT,[-1] ;TT HAS -1 IF CATCH OR ERRSET, + SETZ TT, ;0 FOR ORDINARY ITERATION. + CALL ITRPOP ;POP THE ITERATION FRAME. + JUMPE TT,CD ;FOR ORDINARY ITER'S, THAT'S ALL. +;EXITING A CATCH OR ERRSET: 1ST, WE MAY HAVE JUST UNWOUND +;AND NEED TO RESET PDLS. 2ND, WE MUST RETURN A VALUE SAYING +;WHETHER WE EXITED NORMALLY. + TRZ FF,FRARG+FRARG2+FROP+FRSYL+FRCLN+FRUPRW + AOS A,ERRFLG ;EXITING ERRSET, WAS THERE ERROR? + JUMPN A,[SETZ A, ? JRST VALREC] ;RETURN 0 IF NO ERROR. + HLRZ CH,C + HRLI CH,1-PDL-LPDL(CH) + CAME P,CH ;IF CH=P, SETP IS NOT NEEDED, AND RET. ADDR WOULD BE ABOVE P! + PUSHJ CH,SETP ;MOVE P,CH , CHECK FOR UNWINDING PARENS, SORT OR ^R, THEN POPJ P, + HRLI C,1-PFL-LPF(C) + CALL FSQPU0 ;ON ERROR IN ERRSET, UNWIND QREG PDL + MOVE A,LASTER + JRST VALREC + +;A CONTAINS ITRPTR'S RH; POP OFF AN ITERATION. +ITRPOP: POP A,ITRPTR + POP A,C + POP A,(A) + POP A,ITERCT + MOVEI A,-MFICNT(A) + JRST FLSFRM + +;> AS COMMAND RETURNS TO THE MATCHING < (END ITERATION). +GRTH: SKNTOP ITRPTR + TYPRE [UMC] + TRZE FF,FRUPRW ;@> IGNORES ITERATION COUNT, AND ALWAYS LOOPS BACK. + JRST GRTH1 ;THIS IS FOR THE SAKE OF THE ! CONSTRUCT. + SOSN ITERCT ;OTHERWISE, DECREMENT COUNT AND DON'T LOOP IF IT RUNS OUT. + JRST INCMA2 +GRTH1: HRRO A,ITRPTR + MOVE CH,MFMACP-MFBLEN+1(A) + TLZ CH,40 + CAME CH,MACPDP ;IF MATCHED < WAS AT A DIFFERENT STACK LEVEL, + TYPRE [UMC] ;THIS IS AN ERROR. + SUBI A,MFBLEN-MFCPTR-1 + POP A,CPTR ;OTHERWISE, RESTORE THE "PC" SAVED BY THE <. + POP A,COMCNT + MOVEI CH,^M ;THEN IF WE ARE IN TRACE MODE MAKE THE TRACE LOOK GOOD. + CALL TRACS + MOVEI CH,^J + CALL TRACS + MOVEI CH,"< + CALL TRACS + JRST CD + +FLSSTH: SUB P,[1,,1] +LSSTH: PUSHJ P,GETFRM + MOVE TT,PF + HRLI TT,(P) + MOVE TT1,MACPDP ;IN WITH MACPDP, SET BIT MFERS1 TO REMEMBER THE @ FLAG. + TRZE FF,FRUPRW + TLO TT1,MFERS1 +INSIRP PUSH A,COMCNT CPTR CSTR ITERCT TT1 TT ITRPTR + HRRM A,ITRPTR ;STORE PTR TO INNERMOST ITER OR ERRSET. + TRZE FF,FRCLN ;IF THIS IS ERRSET, SET PTR TO + HRLM A,ITRPTR ;INNERMOST ERRSET. + TRZE FF,FRARG + JRST LSSTH2 + SETOM ITERCT + JRST CD + +LSSTH2: JUMPLE C,INCMA0 + MOVEM C,ITERCT + JRST CD + +CNTRLN: SETOM GEA + TRNE FF,FRARG + MOVEM C,NLINES + TRZN FF,FRCLN + RET + AOSE TTMODE + SETOM TTMODE + POPJ P, + +;F;$ - THROW TO , RETURNING 1 (OR F;'S ARG, IF ANY) FROM THE F<...>. +FSEMIC: TRZN FF,FRARG + MOVEI C,1 + SAVE C + CALL OARG ;READ INTO STAB, WITH "!"'S. +;NOW LOOK AT ALL ITERATIONS, INNERMOST FIRST, FOR ONE WHICH +;IS A CATCH WITH THE APPROPRIATE TAG. + HRRZ E,ITRPTR +FSEMI1: JUMPE E,[TYPRE [UCT]] ;UNSEEN CATCH TAG. + CALL FSEMIP ;IS THIS ITERATION A CATCH? + JRST FSEMI2 ;NO, LOOK AT NEXT ONE OUT. + IBP BP + MOVEI D,STAB ;YES, COMPARE ITS TAB WITH . + MOVE A,MFCCNT-MFBLEN+1(E) +FSEMI3: SOJL A,FSEMI2 ;F< TAG ENDED TOO SOON - MISMATCH. + ILDB TT,BP + CAIL TT,"A+40 ;CONVERT L.C. LETTERS TO U.C. + CAILE TT,"Z+40 + CAIA + SUBI TT,40 + CAME TT,(D) + JRST FSEMI2 ;THE CHARS DIFFER. + ADDI D,1 ;ADVANCE TO NEXT CHAR IN + CAME D,J + JRST FSEMI3 +;WE'VE FOUND A CATCH WITH OUR TAG! + REST LASTER ;VALUE TO BE RETURNED FROM F<...>, WHERE ERRP3 WANTS IT. + SETOM ERRFLG ;FAKE INCMA2 INTO RETURNING NEGATIVE. +FSEMI4: HRRO A,ITRPTR ;POP OFF ALL ITERATIONS INSIDE THE + CAIN E,(A) ;CATCH WE'RE POPPING TO. + JRST [ HRLM E,ITRPTR ;THEN PRETEND THIS CATCH WAS AN ERRSET + JRST ERRP3] ;AND ERR OUT OF IT. + CALL ITRPOP + JRST FSEMI4 + +;COME HERE IF ITERATION ISN'T A CATCH, OR HAS WRONG TAG. +FSEMI2: HRRZ E,MFLINK-MFBLEN+1(E) + JRST FSEMI1 + +;E -> AN ITERATION FRAME. SKIP IF THAT ITERATION IS REALLUY A +;CATCH. IN THAT CASE, RETURN IN BP B.P. TO ILDB THE "<". +FSEMIP: MOVE BP,MFCPTR-MFBLEN+1(E) + SUBI BP,1 ;BACK UP BP BY 2 CHARS. +REPEAT 3,IBP BP + ILDB C,BP ;FETCH THE CHAR BEFORE THE "<" + CAIE C,"F+40 + CAIN C,"F ;IF IT'S "F", THIS ITERATION'S A CATCH. + AOS (P) + RET + +SUBTTL ^P SORT COMMAND + +;THE SORT TABLE IS A TABLE OF POINTERS TO SORT RECORDS. +;PSMEM POINTS AT THE FIRST ENTRY. PSMEMT POINTS PAST THE LAST ONE. +;EACH ENTRY IS 4 (LPSDBK) WORDS LONG. +;THE 1ST WORD OF AN ENTRY IS EITHER A B.P. TO THE START OF THE RECORD'S KEY + ;OR THE KEY ITSELF IF IT IS A NUMBER. +;THE SECOND WORD'S RH IS THE LENGTH OF THE KEY IF THE KEY IS A STRING, + ;OR -1 IF THE KEY IS A NUMBER. +;THE SECOND WORD'S LH IS MINUS THE LENGTH OF THE RECORD IN CHARACTERS. +;THE THIRD WORD IS THE CHAR ADDR OF THE START OF THE RECORD. +;THE FOURTH WORD POINTS TO THE NEXT ENTRY (IN ORIGINAL ORDER BEFORE SORT, + ;IN SORTED ORDER AFTER. THIS IS THE LINK FOR A LIST SORT). + +PSORT: ISKERR ;CAN'T SORT WITHIN SORT. + SAVE FF ;REMEMBER FRCLN (PSI SETS IT) + MOVE CH,[JRST [ + CALL RCH ;READ CHAR, + SKIPGE SQUOTP ;SUPERQUOTED => + JRST INSDIR ;JUST INSERT. + CAIE CH,"$ ;ELSE REPLACE $ BY ALTMODE + JRST INSDCK + MOVEI CH,ALTMOD + JRST INSDIR]] ;AND CHECK FOR DELIMITER UNLESS DELIM PROTECTED. + MOVEM CH,INSRCH + MOVE CH,QRB.. + ADDI CH,.QKS ;GET ARGS + CALL PSI ;IN PSEUDO Q-REGS + MOVE CH,QRB.. + ADDI CH,.QKE + CALL PSI + MOVE CH,QRB.. + ADDI CH,.QDL + CALL PSI + CALL MEMTOP + MOVEM P,PSSAVP ;INDICATE A SORT IS IN PROGRESS. + MOVEM A,PSMEM + MOVEM A,PSMEMT + MOVE T,A + SETZM PSZF + MOVE TT,ZV + SUB TT,BEGV ;# CHARS IN RANGE BEING EDITED. + JUMPE TT,PSXIT ;SORTING NO CHARS IS NOOP. + MOVE C,BEGV ;START FROM BEGINNING + MOVEM C,PT +;DROPS THROUGH. + +;DROPS THROUGH. +;LOOP HERE TO DELIMIT THE NEXT RECORD AND ITS KEY. +PS4: SUB C,BEG ;KEEP ALL ADDRS RELATIVE TO BEG IN CASE IMPURE STRINGS MOVE BUFFER. + MOVEM C,2(T) ;3RD WORD OF POINTER: CHAR ADDR OF RECORD. + PUSH P,C + MOVE A,QRB.. + MOVE A,.QKS(A) ;FIND BEGINNING OF KEY + CALL MACXQ + MOVE T,PSMEMT + MOVE C,PT + SUB C,BEG ;FOR NOW, KEEP CHAR ADDR REL BUFFER, WILL CHANGE TO BP LATER. + PUSH P,C + MOVEM C,(T) ;IS 1ST POINTER WORD + MOVE A,QRB.. + MOVE A,.QKE(A) ;FIND END OF KEY + PUSHJ P,PS2 + SKIPGE C ;BARF IF THE KEY IS NEGATIVE IN LENGTH (WOULD THINK IT WAS NUMERIC). + TYPRE [ISK] + TRNN FF,FRARG ;IF "END OF KEY" MACRO RETURNS A VALUE, THAT VALUE IS THE KEY. + JRST PS8 + MOVE A,NUM ;STORE IT INSTEAD OF THE CHAR ADDR OF THE KEY. + MOVEM A,(T) ;STORE -1 AS "KEY LENGTH" TO IDENTIFY THIS KEY AS NUMBER + MOVNI C,1 ;INSTEAD OF A STRING. +PS8: MOVEM C,1(T) ;#CHARS IN KEY FOR RH(2ND WORD OF TABLE ENTRY) + MOVE A,QRB.. + MOVE A,.QDL(A) ;FIND NEXT RECORD + PUSHJ P,PS1 +PS7: MOVNS C + SKIPL C + TYPRE [ESR] ;SORT-RECORD WITH NO CHARACTERS (OR NEGATIVE NUMBER???) + HRLM C,1(T) ;-LENGTH OF RECORD FOR AOBJN + ADDI T,LPSDBK ;NEXT POINTER + MOVEM T,PSMEMT + MOVE C,PT + SKIPL PSZF ;DID WE RUN OUT + JRST PS4 ;NO + MOVE A,ZV + MOVEM A,PT + CALL GAPSLP + MOVEI C,20. ;MAKE SURE THERE'S A GAP AFTER RANGE BEING + CALL SLPSAV ;SORTED, SO BLT OF SORTED STUFF WON'T CLOBBER A FEW CHARS. + MOVE A,PSMEM ;LOWER BOUND + MOVE B,PSMEMT ;UPPER BOUND. +PS7A: CAMN A,B ;NOW CONVERT ADDRS REL. TO BEG TO WHAT WE REALLY WANT. + JRST PS7B ;ALL RECORDS HANDLED. + HRRE E,1(A) + JUMPL E,PS7C ;IF THE KEY IS A STRING, NOT A NUMBER, + MOVE E,(A) ;GET ADDR START OF KEY, + ADD E,BEG + IDIVI E,5 ;CONVERT TO BP. TO 1ST BIT. + ADD E,BTAB-1(J) + TLZ E,17 + MOVEM E,(A) +PS7C: ADDI A,LPSDBK + MOVE E,A + SUB E,PSMEM + MOVEM E,-1(A) ;MAKE ENTRY'S 3RD WD POINT TO NEXT ENTRY. + JRST PS7A ;DO NEXT RECORD. + +PS1: SKIPGE PSZF ;ALREADY AT END => NOOP INSTEAD OF USER'S MACRO. + JRST PS2A +PS2: SETOM SFINDF + CALL MACXQ +PS2A: MOVE T,PSMEMT + POP P,J ;RETURN POINT + POP P,E ;OLD PT-BEG + ADD E,BEG + MOVE C,PT + SKIPL SFINDF ;IF THE LAST SEARCH FAILED + SKIPA C,ZV + CAML C,ZV ;OR WE'RE AT THE END OF THE BUFFER + SETOM PSZF ;THEN THIS RECORD IS THE LAST ONE. + SUB C,E ;# CHARS IN C + JRST (J) + +;RETURN IN A A PTR TO THE 1ST UNUSED WORD OF HIGH MEM. +MEMTOP: MOVE A,BFRTOP + IDIVI A,5 + SUBI A,3 + SKIPE PSSAVP + MOVE A,PSMEMT + ADDI A,4 + POPJ P, + +PS7B: SETOM -1(A) ;LAST ENTRY'S LINK WORD IS NIL. + MOVE A,(P) ;RESTORE FRCLN AS IT WAS AT CALL TO PSORT. + TRNE A,FRCLN + IORI FF,FRCLN + HRRZ J,PSMEMT ;DYNAMICALLY ALLOCATED PDL + PUSHJ J,PS3 ;SORT POINTERS + MOVE T,BEGV ;SET UP FOR LATER BLT + IDIVI T,5 + HRRM T,J ;DESTINATION = WORD CONTAINING BEGV + MOVE CH,(T) ;MUST HAVE CHARS BEFORE BEGV IN WD + HLL C,BTAB-1(TT) ;GET BPT TO NEW BUFFER AREA + TLZ C,77 + HRR C,PSMEMT ;WHICH OVERWRITES SORT PDL + HRLM C,J ;SOURCE FOR BLT + MOVEM CH,(C) ;SAVE CHARS +PS6: ADD A,PSMEM ;CHANGE REL PTR TO ABS, -> NEXT TAB ENTRY. + HLRE E,1(A) ;- # CHARS IN RECORD. + JUMPE E,PS5 + MOVE BP,2(A) ;CHAR ADDR START OF RECORD. + ADD BP,BEG + CALL GETIBP +PS6A: ILDB CH,BP ;MOVE THE RECORD. + IDPB CH,C + AOJL E,PS6A +PS5: MOVE A,3(A) ;GET PTR TO NEXT RECORD'S ENTRY. + JUMPGE A,PS6 ;IF THERE IS ANOTHER, LOOP BACK. + MOVE A,ZV + IDIVI A,5 + BLT J,1(A) ;DONE, MOVE IT DOWN + CALL FLSCOR +PSXIT: SETZM PSSAVP ;TURN OFF SORT FLAG. + MOVE A,BEGV + MOVEM A,PT + JRST POP1J + +;ACTUALLY SORT THE LIST OF SORT TABLE ENTRIES, +;BY REARRANGING THE LINK WORDS SO THAT THEY ARE LINKED +;IN SORTED ORDER. +PS3: SETZ E, ;POINT TO THE HEAD OF THE LIST O SORT. + MOVE C,PSMEMT ;C _ LENGTH(E) + SUB C,PSMEM + LSH C,-2 + +;(DEFUN NSORT (N) (COND ((= N 1) (CHOP1)) +; (T (MERGE (NSORT (/ N 2)) (NSORT (- N (/ N 2))))))) +;E HOLDS L, C HOLDS N, J USED AS PDL PTR, VALUE RETURNED IN A. +PS3NSORT: CAIN C,1 + JRST PS3NS1 + PUSH J,C + LSH C,-1 ;THIS IS N/2 + PUSHJ J,PS3NSORT ;(NSORT (/ N 2)) + POP J,C + PUSH J,A + AOJ C, + LSH C,-1 ;(- N (/ N 2)) + PUSHJ J,PS3NSORT ;(NSORT (- N (/ N 2))) + POP J,C ;A, C HAVE ARGS TO MERGE. + MOVEI B,D ;B -> TAIL OF ACCUMULATED MERGED LIST, + ;D WILL EVENTUALLY POINT TO ITS HEAD. +PS3MRG: JUMPL C,PS3TK1 ;1ST ARG EMPTY => TAKE FROM 2ND. + JUMPL A,PS3TKB ;2ND EXHAUSTED => TAKE FROM FIRST. + MOVE TT,PSMEM ;ELSE GET PTRS TO AND SIZES OF THE KEYS + MOVE TT1,PSMEM + ADD TT,A ;BELONGING TO THE HEADS OF 1ST AND 2ND ARG. + ADD TT1,C + TRNE FF,FRCLN ;^ ^P - SORT IN REVERSE ORDER. + EXCH TT,TT1 + MOVE CH,(TT) ;CH IS BP TO ILDB KEY OF 2ND, + MOVE Q,(TT1) ;Q, FOR 1ST. + HRRE TT,1(TT) ;# CHARS IN KEY OF 2ND, + HRRE TT1,1(TT1) ;SAME FOR 1ST. + JUMPGE TT1,PS3CM3 + JUMPGE TT,PS3TKB ;1ST KEY A NUMBER, 2ND A STRING => 1ST IS LESS. + CAML Q,CH + JRST PS3TKA ;BOTH NUMBERS => 1ST KEY NUMBER GREATER => TAKE 2ND. + JRST PS3TKB + +PS3CM3: JUMPL TT,PS3TKA ;2ND KEY A NUMBER, 1ST A STRING => 2ND IS LESS. + +;COMPARE TWO KEYS WHICH ARE STRINGS, GO TO PS3TKA IF 2ND KEY IS LESS, ELSE PS3TKB. +PS3CMP: SOJL TT1,PS3TKB ;FIRST KEY ENDED, IT IS .LE., SO USE IT. + SOJL TT,PS3TKA ;2ND KEY ENDED, IT IS .L., TAKE 2ND. + ILDB T,CH ;ELSE LOOK AT NEXT CHAR OF EACH. + ILDB BP,Q + SKIPN PSCASE ;IF WE SHOULD IGNORE CASE, + JRST PS3CM1 + CAIGE T,"A+40 + JRST PS3CM2 + CAIG T,"Z+40 + SUBI T,40 +PS3CM2: CAIGE BP,"A+40 + JRST PS3CM1 + CAIG BP,"Z+40 + SUBI BP,40 +PS3CM1: CAIN T,(BP) + JRST PS3CMP ;CHARS EQUAL => KEEP LOOKING. + CAIG T,(BP) + JRST PS3TKA ;CHAR FROM 2ND IS LESS, TAKE 2ND. +PS3TKB: MOVEM C,(B) ;"TAKE 1ST"; ENTRY AT HEAD OF 1ST ARG + ADD C,PSMEM ;IS LESS THAN THAT AT HEAD OF 2ND, SO + MOVEI B,3(C) ;TRANSFER IT TO TAIL OF MERGED LIST + MOVE C,(B) ;AND ADVANCE DOWN THE 1ST ARG. + JRST PS3MRG + +PS3TKA: MOVEM A,(B) ;"TAKE 2ND"; LIKE "TAKE 1ST" BUT FOR 2ND ARG. + ADD A,PSMEM + MOVEI B,3(A) + MOVE A,(B) + JRST PS3MRG + +PS3TK1: JUMPGE A,PS3TKA ;1ST EXHAUSTED; 2ND ISN'T => TAKE 2ND. + SETOM (B) ;BOTH ARGS EXHAUSTED => MERGE FINISHED, TERMINATE LIST. + MOVE A,D ;RETURN VALUE IN A. + POPJ J, + +PS3NS1: MOVEI A,(E) ;(NSORT 1) COMES HERE. + ADD E,PSMEM ;RETURN THE HEAD OF LIST TO BE SORTED, + MOVE T,E + MOVE E,3(T) ;REPLACING THAT LIST WITH ITS CDR, + SETOM 3(T) ;AND MAKING THE HEAD'S CDR NIL. + POPJ J, + +SUBTTL INPUT FROM FILES + +APPEND: ARGDFL + TRZE FF,FRCLN + JRST APPNDL + TRZN FF,FRARG + JRST YANK2 + ADD C,PT + SOS IN,C + CAMGE IN,ZV + CAMGE IN,BEGV + JRST APPND2 ;J IF OUT OF RANGE OF BUFFER. + ANDCMI FF,FRARG2 + PUSHJ P,GETCHR + MOVE A,CH + JRST POPJ1 + +APPND2: TRZN FF,FRARG2 ;IF ONLY ARG, OUT OF RANGE IS ERROR. + TYPRE [NIB] + MOVE A,E ;2 ARGS => RETURN 1ST ARG. + JRST POPJ1 + +APPNDL: TRNN FF,FRARG ;:A - APPEND LINES, OR TO ^L, + MOVEI C,1 ;WHICHEVER COMES FIRST. + TLNN FF,FLIN + RET + SAVE PT + MOVE OUT,ZV ;TEMPORARILY PUT PT AT END SO + MOVEM OUT,PT ;TYOM WILL INSERT AT END. + CALL GAPSLP +APPNL2: PUSHJ P,UTYI + SKIPN FFMODE + CAIE CH,^L + SKIPL LASTPA ;AT EOF => UTYI WAS RETURNING DUMMY CHARS; IGNORE THEM. + JRST APPNL1 + PUSHJ P,TYOM + CAIN CH,^L + JRST APPNL1 + CAIE CH,^J ;END OF LINE + JRST APPNL2 + SOJG C,APPNL2 +APPNL1: REST PT + CAIE CH,^L + RET + AOS PAGENU +;CLOSE THE INPUT FILE IF IT IS EMPTY EXCEPT FOR PADDING. +APPNL4: CALL UTYI ;READ AHEAD 1 CHAR TO SEE IF ANYTHING + SKIPL LASTPA ;IS LEFT IN THE FILE. + RET ;NO => LEAVE FILE MARKED "EOF". + MOVE A,UTYIP ;ELSE ARRANGE TO RE-READ THAT CHAR. + DBP7 A + MOVEM A,UTYIP + POPJ P, + +;Y => READ ONE PAGE FROM THE OPEN INPUT FILE, +;DESTROYING PREVIOUS CONTENTS OF BUFFER. +;IF NO FILE OPEN, JUST EMPTY THE BUFFER. +;THE FS YDISABLE$ FLAG MAY TURN Y INTO AN ERROR. +;^ Y READS IN ALL THE REST OF THE FILE. +YANK: SKIPGE YDISAB + IORI FF,FRUPRW ;YDISAB NEGATIVE => Y IS ^Y. + SKIPLE YDISAB + TYPRE [DCD] ;FS YDISABLE POSITIVE => "Y" IS ILLEGAL. +YANKEE: MOVE E,BEGV + MOVE C,ZV ;FIRST, KILL CURRENT CONTENTS. + CALL DELET1 +YANK2: TLNN FF,FLIN + JRST UTLSTP ;NO FILE OPEN => INSERT NOTHING. + TRNE FF,FRUPRW + JRST YANKAL ;"^ Y" IS HANDELD SEPARATELY. + .I YANKMT=MEMT ;PREVENT EXCESS CLEARING OF LOW BITS IN SLPSAV + MOVE BP,ZV ;GET PLACE TO INSERT AT. + EXCH BP,PT ;GET GAP THERE. + CALL GAPSLP + MOVEM BP,PT + MOVE BP,BEG + CAME BP,Z ;IF BUFFER IS EMPTY NOW, + JRST YANK3 + MOVE BP,BEG ;ADJUST VALUE OF BEG SO THAT + IDIVI BP,5 ;THE BUFFER STARTS IN THE SAME PART OF A WORD + ;AS THE EMPTY PART OF UTOBUF FOR ORDINARY Y. + HLL BP,UTYOP ;(MAKES IT MORE LIKELY THAT PW CAN GO FAST) + TLNN BP,760000 ;MAKE SURE WE DON'T MOVE BEG TO + SUBI BP,1 ;A DIFFERENT WORD. + CALL GETCA ;TURN INTO CHAR ADDR OF LAST CHAR BEFORE BUFFER + SUB BP,BEG + AOS TT,BP ;TURN INTO DISPLACEMENT OF NEW BEG FROM OLD + ADDB TT,BEG ;UPDATE BEG. + CAMGE TT,BFRBOT ;NEW BEG ISN'T SUPPOSED TO BE OUTSIDE BUFFER SPACE. + .VALUE + ADDM BP,BEGV ;SHIFT ALL THE OTHER BUFFER POINTERS JUST LIKE BEG + ADDM BP,PT + ADDM BP,GPT + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC +YANK3: MOVE BP,ZV + AOS PAGENU + SAVE D + PUSHJ P,GETIBP + MOVE OUT,BP + MOVE IN,[YPG,,A] + BLT IN,BP + MOVE IN,UTYIP + SKIPN Q,EXTRAC + JRST YPGNRM + JRST A + +YPG: ILDB CH,IN ;A + CAIE CH,EOFCHR ;B + CAIN CH,14 ;C + JRST YPG1 ;D + IDPB CH,OUT ;E + SOJG Q,A ;J + JRST YPGNRM ;BP + +YPG1: MOVEM IN,UTYIP ;WE JUST ILDB'D ^C OR ^L. + HRRZ TT,IN + CAIN TT,UTIBE + JRST YPG2 ;JUST END OF UTIBUF - RELOAD IT. + CAIE CH,EOFCHR + JRST YPG3 ;IT WAS A ^L - GO INSERT IT AND RETURN. + CAME IN,UTRLDT + JRST E ;^C INSIDE THE FILE - INSERT IT AND KEEP GOING. + CALL UTLSTP ;EOF - MARK FILE AS AT EOF. +YPG1A: MOVE BP,OUT + CALL GETCA + AOS BP + MOVE E,ZV ;GET PLACE WHERE INSERTED FILE STARTS, FOR YANKX'S USE. + CALL YPG1B ;UPDATE BUFFER BLOCK FOR CHARS WE HAVE READ IN. + REST D + JRST YANKX ;NOW MAYBE DELETE PADDING OR A TRAILING ^L. + +YPG1B: SETZM YANKMT + MOVEM BP,GPT + SUB BP,ZV ;# CHARS YANKED. + ADDM BP,Z + ADDM BP,ZV + MOVNS BP + ADDM BP,EXTRAC + POPJ P, + +YPG3: IDPB CH,OUT ;ENCOUNTERED A ^L - INSERT IT, + CALL APPNL4 ;MARK THE FILE CLOSED IF THERE'S NOTHING LEFT IN IT + JRST YPG1A ;THEN FINISH UP AS IF REACHED EOF. + +YPG2: CALL UTRLD2 ;EOB AND CAN'T GO FAST, RELOAD UTIBUF. + MOVE IN,UTYIP + JRST A ;TRY AGAIN TO READ A CHARACTER. + +YPGNRM: SAVE C ;COME HERE WHEN RUN OUT OF GAP TO YANK INTO. + MOVE C,EXTRAC + ADDI C,5* ;C <- AMOUNT OF GAP WE WANT. + MOVN Q,EXTRAC + CALL SLPSAV + REST C + ADD Q,EXTRAC + JRST A + +;HANDLE "^ Y" AND "^ A" - READ IN ALL OF INPUTR FILE, THEN +;REMOVE PADDING FROM END, AND MAYBE REMOVE A TRAILING ^L. +YANKAL: MOVE C,ZV + SAVE C ;MOVE POINT TO ZV, SAVING ZV AND OLD POINT. + EXCH C,PT + SAVE C + CALL FYCMDA ;THEN INSERT THE WHOLE FILE THERE. + CALL GAPSLP ;AND MOVE THE GAP TO THE END OF WHAT WAS INSERTED. + REST PT ;POINT IS NOW SAME AS AT ENTRY, BUT GPT = ZV. + REST E ;THIS IS OLD VALUE OF ZV - WHERE THE FILE STARTS. + CALL UICLS + CALL YANKX ;DELETE PADDING CHARS AT END. + JRST FLSCM1 ;FLUSH EXCESS CORE. + +;DELETE BACKWARDS FROM GPT ALL CONSECUTIVE ^C'S AND ^@'S; +;THEN, IF FS ^LINSERT$ IS 0, DELETE A FORMFEED IF ANY. +;REFUSES TO DELETE BACK PAST WHERE E POINTS. +YANKX: MOVE IN,GPT +YANKX1: MOVEI C,1 + CAMN E,IN + RET + SOS IN + CALL GETCHR + CAIE CH,^C + JUMPN CH,YANKX2 + SOS GPT + CALL DELETB ;DELETE 1 CHAR AFTER GPT (SINCE C HAS 1). + JRST YANKX1 + +YANKX2: CAIN CH,^L ;GOT ALL ^C'S AND ^@'S - NOW MAYBE TAKE A ^L. + SKIPE FFMODE + RET + SOS GPT + JRST DELETB + +;INSERT ALL OF THE OPEN INPUT FILE BEFORE POINT. +;FY WITH NO ARGUMENT USES THIS, AS DOES "^ Y". +FYCMDA: CALL FSIFLEN ;HOW MUCH SPACE DO WE NEED? + JFCL + .I YANKMT=MEMT ;IN CASE MUST MAKE SEVERAL TRIES, PREVENT EXCESS LOW-BIT CLEARING. + JUMPL A,FYCMD7 +IFN ITS,[ + SYSCAL RFPNTR,[%CLIMM,,CHFILI ? %CLOUT,,C] + SETZ C, + IMULI C,5 ;IF WE ARE NOT POINTING AT THE FRONT OF THE FILE, WE DON'T + SUB A,C ;HAVE AS MUCH TO READ, SO WE DON'T NEED AS MUCH SPACE. + SKIPGE C,A ;IF KNOW HOW MUCH SPACE, READ WHOLE FILE AT ONCE. +] +IFN TNX,[ + MOVE C,A ;SAVE SIZE OF FILE + MOVE A,CHFILI + RFPTR + TDZA B,B ;FAILED, ASSUME 0 BUT DONT PMAP + JUMPE B,FYPMAP ;IF AT START OF FILE STILL, CAN READ IT IN FAST + IMULI B,5 + SUB C,B + SKIPGE C +] +FYCMD7: MOVEI C,2000*5 ;ELSE GET 1K AT A TIME. + CALL FYCMD6 ;READ THAT MUCH. + SKIPE LASTPA ;IS THERE ANY MORE IN THE FILE? + JRST FYCMD7 ;YES, SO GET MORE. + SETZM YANKMT + RET + +IFN TNX,[ +;MAP IN INPUT FILE USING PMAP'S +FYPMAP: CALL GAPSLP ;MOVE GAP TO PT + SAVE C ;SAVE SIZE OF INPUT FILE + MOVE A,GPT + IDIVI A,1000*5 ;GET PAGE TO START MAPPING INTO + JUMPE B,.+2 .SEE CIRC + AOJ A, + SAVE A ;SAVE PAGE NUMBER + IMULI A,1000*5 ;GET CHARACTER ADDRESS + IDIVI C,1000*5 ;GET NUMBER OF PAGES IN INPUT FILE + JUMPE D,FYPMA1 .SEE CIRC + AOJ C, + SUBI D,1000*5 ;D IS - +FYPMA1: SAVE C ;SAVE IT + IMULI C,1000*5 ;BACK INTO CHARACTERS + SUB C,GPT ;GET SIZE OF GAP WE WILL NEED FOR ALL THIS + ADDB C,A ;END OF LAST PAGE TO BE MAPPED + CALL SLPSAV ;MAKE SURE THERE IS THAT MUCH ROOM FOR IT + SUB A,EXTRAC ;COMPUTE SIZE OF GAP AFTER END OF NEW PAGES + ADD D,A ;D IS - + HRLZ A,CHFILI ;GET INPUT FILE AGAIN + MOVE B,-1(P) ;FIRST PROCESS PAGE + HRLI B,.FHSLF +IFN 20X,[ + REST C ;NUMBER OF PAGES AGAIN + HRLI C,(PM%CNT\PM%RD\PM%CPY\PM%PLD) ;READ, COPY, PRELOAD + PMAP ;READ IN THE WHOLE FILE. +] +IFN 10X,[ + REST T ;COUNT OF PAGES TO MAP + JUMPE T,FYPMA3 ;EMPTY FILE DOES NO PMAPS + MOVSI C,(PM%RD\PM%EX\PM%CPY) ;THIS IS THE SECOND BIGGEST CROCK +FYPMA2: PMAP + SOJLE T,FYPMA3 + AOJ A, + AOJA B,FYPMA2 +FYPMA3: +] + REST A ;GET FIRST PAGE AGAIN + IMULI A,1000*5 ;GET CHARACTER ADDRESS OF START OF MAPPED IN FILE + SUB A,GPT ;COMPUTE NEW SIZE OF GAP ON THIS END + MOVEM A,EXTRAC + REST A ;SIZE OF INPUT FILE AGAIN + ADDM A,PT ;PT TO END OF STUFF JUST INSERTED + ADDM A,ZV + SUB A,D ;FOR NOW SET END HIGH SO GETS BLTED ALONG WITH REST OF + ADDM A,Z + CALL SLPSHT ;CLOSE UP THE LOWER GAP + ADDM D,Z ;FIX UP END OF BUFFER + MOVNM D,EXTRAC ;SIZE OF UPPER GAP + JRST UTLSTP ;TELL EVERYONE AT EOF NOW +] + +;FY - READ CHARACTERS FROM THE INPUT FILE, OR UNTIL EOF, +;AND INSERT THEM IN THE BUFFER BEFORE POINT. NO PADDING CHARACTERS ARE +;FLUSHED, SO ALL IS UNDER PROGRAMMER CONTROL. IF THE TRANSFER GOES TO A WORD +;BOUNDARY, AND STARTS AT A WORD BOUNDARY IN THE FILE, THEN IT IS +;SUITABLE FOR READING IN BINARY DATA. TO MAKE THAT HAPPEN, WE SOMETIMES +;INSERT SOME SPACES IN THE BUFFER TO PRODUCE CORRECT ALIGNMENT, +;AND THEN DELETE THEM WHEN FINISHED READING. +FYCMD: TLNN FF,FLIN + TYPRE [NFI] + TRNN FF,FRARG + JRST FYCMDA ;NO ARG => READ THE WHOLE FILE. + JUMPL C,TYPAOR ;NEGATIVE ARG NOT ALLOWED. +FYCMD6: SAVE C + MOVE BP,UTYIP ;FOR SPEED, LEAVE ENOUGH SPACE BEFORE INSERTING THE FILE + CALL GETCA ;TO ENABLE TRANSFER TO GO WORDWISE. + MOVEI BP,1(BP) + SUB BP,PT + IDIVI BP,5 + SKIPE BP,T + ADDI BP,5 + SAVE BP + ADD C,BP ;THAT MUCH, PLUS # CHARS BEING READ, IS AMT OF SPACE WE NEED. + CALL GAPSLP ;GET GAP TO POINT. + CALL SLPSAV ;MAKE SURE THERE'S ENOUGH SPACE. + MOVE C,-1(P) + MOVE BP,PT + ADD BP,(P) ;LEAVE THE FEW CHARS OF SPACE TO REACH PROPER ALIGNMENT. + CALL GETIBP ;CREATE B.P. FOR IDPB'ING INTO THE GAP. +FYCMD0: JUMPE C,FYCMDE + MOVE A,UTYIP ;AND LOOK AT B.P. WE'LL ILDB FROM. + HRRZ B,UTRLDT + ADD B,[(010700)-1] +FYCMDW: TLNN A,760000 + JRST FYCMD1 ;JUMP IF CAN START GOING WORD-WISE. +FYCMDS: CAMN A,B + JRST FYCMDR ;IF UTIBUF EXHAUSTED, MUST RELOAD IT. + ILDB CH,A ;OTHERWISE, TRANSFER ONE MORE CHARACTER + IDPB CH,BP + SOJG C,FYCMDW + MOVEM A,UTYIP +FYCMDE: CALL UTEOF ;IF THERE'S NOTHING LEFT IN THE INPUT FILE, MARK IT "AT EOF". + MOVE E,-1(P) + SUB E,C ;# CHARS ACTUALLY READ IN + ADD E,(P) ;PLUS # CHARS OF SPACE LEFT AT FRONT. + ADDM E,GPT ;"INSERT" THE DATA AND THE SPACE AT FRONT. + ADDM E,ZV ;BUT DON'T CHANGE POINT, YET. + ADDM E,Z + SUBM E,EXTRAC + MOVNS EXTRAC + REST C ;C HAS # CHARS OF SPACE THAT'S NOW IN THE BUFFER + SUB P,[1,,1] + JUMPE C,FYCMD8 + SUB E,C ;E HAS # CHARS OF REAL DATA NOW INSERTED. + CALL GAPSLP ;GET GAP TO POINT, WHICH STILL POINTS VBEFORE THE SPACE + CALL DELETB ;AND DELETE THE SPACE. +FYCMD8: ADDM E,PT ;NOW MAKE POINT GO AFTER THE INSERTED DATA. + RET + +FYCMDR: CAME A,[010700,,UTIBE-1] + JRST FYCMDE ;IF LAST INPUT BUFFER WASN'T FULL, THIS IS EOF. + CALL UTRLD2 ;ELSE, READ ANOTHER INPUT BUFFER AND CONTINUE TRANSFERING. + JRST FYCMD0 + +;HERE TO ATTEMPT A WORD-WISE TRANSFER. +FYCMD1: MOVEM A,UTYIP + CAIGE C,5 ;DON'T BOTHER TRYING TO GO FAST IF < 1 WHOLE WORD LEFT. + JRST FYCMDS + IDIVI C,5 .SEE D + IBP BP + SUB B,A ;IF THEER'S ANYTHING LEFT IN UTIBUF, MUST USE IT FIRST. + JUMPE B,FYCMDI ;LH'S CANCEL SINCE BOTH ARE 010700. + IBP A + HRL BP,A + CAMLE B,C ;# WORDS TO TRANSFER RIGHT NOW = + MOVE B,C ;MIN (, ). + ADDM B,UTYIP ;REMOVE THAT MANY WORDS FROM THE BUFFER. + SUB C,B ;# WORDS THAT WILL BE LEFT EMPTY AFTER USING UP UTIBUF? + ADD B,BP + BLT BP,-1(B) ;TRANSFER WHAT'S LEFT OF UTIBUF. + IMULI C,5 + HRRZ BP,B + JRST FYCMD2 + +;GOING WORD AT A TIME, AND UTIBUF IS EMPTY, SO GET DIRECTLY FROM FILE. +FYCMDI: +IFN ITS,[ + CAIGE C,100000 ;DON'T TRY TO IOT MORE THAN 32K AT A TIME. + JRST FYCMD4 + IMULI C,5 + ADD D,C ;SO PUT TOTAL # CHARS TO GET, MINUS 32K OF CHARS, IN D, + SUBI D,5*100000 + MOVEI C,100000 ;AND GET ONLY 32K RIGHT NOW. +FYCMD4: MOVNS C + HRL BP,C ;AOBJN -> BUFFER WORDS TO TRANSFER INTO. + .IOT CHFILI,BP + HLRE C,BP +] +IFN TNX,[ + SAVE B + MOVE A,CHFILI ;INPUT FILE + MOVEI B,(BP) ;FIRST WORD TO READ INTO + HRLI B,444400 + MOVNS C + SIN + MOVEI BP,1(B) ;UPDATE FIRST WORD NOT READ INTO + HRL BP,C ;UPDATE COUNT LEFT TO DO + REST B +] + IMUL C,[-5] +FYCMD2: ADD C,D ;# CHARS WE WERE SUPPOSED TO TRANSFER BUT HAVEN'T YET. + JUMPL BP,FYCMD3 ;EOF => WE WILL NEVER GET THEM, SO INSERT WHAT WE HAVE GOT. + ADD BP,[(010700)-1] ;GET BACK B.P. TO IDPB THE REST OF THE DATA + JRST FYCMD0 ;RELOAD BUFFER TO XFER LAST FEW CHARS 1 AT A TIME. + +FYCMD3: CALL UTLSTP + JRST FYCMDE + +;READ NEXT CHARACTER FROM OPEN INPUT FILE, AND RETURN IT IN CH. +;UP TO A WORD OF ^C'S OR ^@'S BEFORE THE END OF THE FILE WILL BE IGNORED. +;IF TRY TO READ PAST EOF, FS LASTPAGE$ WILL BE SET TO 0, AND ^L WILL BE RETURNED. +UTYI: ILDB CH,UTYIP + CAILE CH,EOFCHR + RET + CAIE CH,EOFCHR + JUMPN CH,CPOPJ + HRRZ CH,UTYIP + CAIN CH,UTIBE + JRST UTYIR ;EXHAUSTED BUFFER => REALOD IT AND TRY AGAIN. +UTYI4: MOVE CH,UTYIP + CAMN CH,UTRLDT + JRST UTYIE ;READ PAST EOF => CLOSE FILE AND RETURN A ^L. +;^C OR ^@ INSIDE THE FILE - IS IT PADDING BEFORE EOF? + HRLI CH,010700 + IBP CH + CAME CH,UTRLDT ;MORE THAN 1 WORD FROM THE END => IT ISN'T PADDING. + JRST UTYI5 + ANDI CH,-1 + CAIE CH,UTIBE ;THIS LAST WORD OF INPUT BUFFER => WE DON'T KNOW WHETHER + JRST UTYI1 ;THERE ARE MORE WORDS IN THE FILE, + MOVE CH,UTIBE-1 ;SO FIND OUT BY PUTTING THIS WORD AT BEGINNING OF BUFFER + MOVEM CH,UTIBUF ;AND FILLING UP THE REST IF POSSIBLE. + MOVE CH,UTIBE + MOVEM CH,UTIBUF+1 + MOVNI CH,UTIBE-UTIBUF-1 + ADDM CH,UTYIP + ADDM CH,UTRLDT + CALL UTRLD3 ;NOW TRY FILLING REST OF INPUT BUFFER. + JRST UTYI4 ;WE NOW HAVE ENOUGH INFO TO ANSWER OUR QUESTION. + +;COME HERE WHEN A ^C OR ^@ IS FOUND IN THE LAST WORD OF THE FILE, TO LOOK +;AHEAD AND SEE IF REST OF THE CHARS IN LAST WORD ARE ALL ^C OR ^@. +UTYI1: SAVE UTYIP +UTYI3: ILDB CH,UTYIP + CAIE CH,^C + JUMPN CH,UTYI2 + MOVE CH,UTYIP + CAME CH,UTRLDT + JRST UTYI3 + SUB P,[1,,1] ;ALL ARE ^C OR ^@ => RETURN CLOSING FILE. +UTYIE: CALL UTLSTP + MOVEI CH,^L + RET + +UTYI2: REST UTYIP ;NOT ALL PADDING => THIS ^C OR ^@ IS REALLY DATA, AND SO ARE THE REST. +UTYI5: LDB CH,UTYIP + RET + +UTYIR: CALL UTRLD2 + JRST UTYI ;GO BACK AND TRY AGAIN + +;"EC" COMMAND -- CLOSE THE INPUT FILE AND MARK IT CLOSED. +UICLS: CALL UTLSTP ;FIRST, SET "AT EOF" SO ATTEMPTS TO READ WILL GET ^C'S. + CLOSEF CHFILI + TLZ FF,FLIN + RET + +;REFILL THE INPUT BUFFER. +UTRLD2: MOVE CH,[10700,,UTIBUF-1] + MOVEM CH,UTYIP +IFN ITS,[ + SKIPA CH,[UTIBUF-UTIBE,,UTIBUF] +UTRLD3: MOVE CH,[UTIBUF+1-UTIBE,,UTIBUF+1] + .IOT CHFILI,CH + HRRM CH,UTRLDT ;FIRST ADR. NOT LOADED BY SYS + JUMPGE CH,CPOPJ + MOVEI CH,EOFCHR + DPB CH,UTRLDT ;STORE EOF THERE + POPJ P, +] +IFN TNX,[ + JSR SAVABC ;SAVE ACS + MOVE B,[444400,,UTIBUF] ;POINTER TO BUFFER + MOVNI C,UTIBE-UTIBUF ;COUNT TO READ +UTRLD4: MOVE A,CHFILI ;INPUT FILE + SIN + AOJ B, ;WILL BE OF THE FORM 004400,,ADDR-1 + HRRM B,UTRLDT ;FIRST ADDR NOT LOADED + JUMPE C,POPCBA ;HAVE WE REACHED EOF? + MOVEI CH,EOFCHR ;YES + DPB CH,UTRLDT + JRST POPCBA +UTRLD3: JSR SAVABC + MOVE B,[444400,,UTIBUF+1] ;TRY TO FILL THE REST OF THE BUFFER + MOVNI C,UTIBE-UTIBUF-1 + JRST UTRLD4 +] + +;SEE IF THE INPUT FILE IS AT EOF. IF SO, SET FS LASTPA, ETC. +;TO TELL THE USER THAT IT IS. +UTEOF: SKIPL LASTPA + RET ;ALREADY AT EOF => NO CHANGE. + MOVE CH,UTYIP + IBP CH + CAME CH,UTRLDT ;MORE LEFT IN INPUT BUFFER => NOT EOF + RET + ANDI CH,-1 + CAIE CH,UTIBE ;NONE LEFT IN INPUT BUFFER, AND BUFFER WASN'T A FULL ONE, + JRST UTLSTP ;=> CLEARLY AT EOF. + CALL UTRLD2 ;AT END OF BUFFER => TRY READING SOME MORE TO SEE + JRST UTEOF ;IF AT EOF. + +;INDICATE THAT THE INPUT FILE IS AT EOF. ALL ATTEMPTS TO READ MORE +;WILL JUST ENCOUNTER ANOTHER EOF. +UTLSTP: SETZM LASTPA ;SAY "EOF" TO ANYONE WHO ASKS. + MOVE CH,[010700,,[ASCIC//]-1] + MOVEM CH,UTYIP ;SET UP BUFFER TO APPEAR TO BE JUST BEFORE AN EOF + IBP CH ;SO THAT ANY ATTEMPT TO READ A CHARACTER WILL SEE EOF + MOVEM CH,UTRLDT ;AND COME RIGHT BACK HERE. + RET + +;FS IF LENGTH$ - READ LENGTH OF OPEN INPUT FILE. +FSIFLEN:TLNN FF,FLIN + TYPRE [NFI] + MOVEI A,CHFILI +IFN ITS,[ +FSIFL1: SYSCAL FILLEN,[A ? %CLOUT,,A] + SKIPA A,[-1] +] +IFN TNX,[ +FSIFL1: MOVE A,(A) ;INPUT FILE + MOVE B,[2,,.FBBYV] + MOVEI C,A + GTFDB + EXCH A,B + LDB C,[.BP FB%BSZ,B] ;GET BYTE SIZE + CAIN C,7 ;IF 7, ALREADY HAVE WHAT WE WANT + JRST POPJ1 + CAIN C,36. ;IF 36, KNOW HOW MANY WORDS ALREADY + JRST .+4 + MOVEI B,36. + IDIVI B,(C) ;GET NUNBER OF BYTES IN A WORD + IDIVI A,(B) ;GET NUMBER OF WORDS +] + IMULI A,5 ;INTO CHARACTERS + JRST POPJ1 + +FSOFLEN:TLNN FF,FLOUT + TYPRE [NDO] + MOVEI A,CHFILO + JRST FSIFL1 + +;SET INPUT FILE ACCESS POINTER TO CHAR # IN C. +FSIFAC: TLNN FF,FLIN + TYPRE [NFI] +IFN ITS,[ + MOVEI A,CHFILI + .CALL RFACCB + TYPRE [NRA] ;NOT RANDOM ACCESS FILE. + IDIVI C,5 ;CHANGE ARG TO WORD #. + .ACCES CHFILI,C ;FIND THAT WORD. +] +IFN TNX,[ + IDIVI C,5 ;CONVERT TO WORD # + MOVE A,CHFILI + MOVE B,C ;GET ARG + SFPTR + TYPRE [NRA] +] + SETOM LASTPA ;EVEN IF FILE WAS AT EOF, IT WON'T BE ANY MORE. + CALL UTRLD2 ;FILL UP THE INPUT BUFFER + HRRZ CH,UTRLDT + CAIN CH,UTIBUF ;DID WE GET ANYTHING? + JRST UTLSTP ;NO, .ACCESS WENT TO EOF. + JUMPE D,CPOPJ ;YES, ADVANCE IN WORD TO SPEC'D CHARACTER IF IT ISN'T THE 1ST. + IBP UTYIP + SOJG D,.-1 + RET + +SUBTTL OUTPUT TO FILES + +;P COMMAND WITH 2 ARGS. +PUNCHB: CALL GETARG + CALL CHK1A +PUNCHF: ;PUNCH OUT RANGE SPEC'D BY C,E. + CAMGE E,GPT + CAMG C,GPT ;IF GAP IS INSIDE RANGE TO BE PUNCHED, WE MUST BE CAREFUL. + JRST PUNCHG + PUSH P,C + MOVE C,GPT + CALL PUNCHG ;FIRST, PUNCH EVERYTHING UP TO THE GAP. + MOVE E,GPT + MOVE TT,EXTRAC + IDIVI TT,5 + JUMPE TT1,[ ;IF GAP DOESN'T DESTROY ALIGNMENT, JUST PUNCH EVERYTHING AFTER THE GAP. + POP P,C + JRST PUNCHG] +PUNCHJ: MOVE E,GPT ;GAP DESTROYS ALIGNMENT; IT IS FASTEST TO ADJUST ALIGNMENT OURSELVES + MOVE C,E ;BY MOVING THE GAP UP PAST THE TEXT TO BE OUTPUT. + ADDI C,4*5*2000 ;MOVE THE GAP PAST AT MOST 4K AT A TIME + SUB C,UTYOCT ;(PLUS ENOUGH TO FILL OUTPUT BUFFER, TO INSURE IT'S EMPTY AT NEXT STOP) + MOVE T,(P) ;AND THEN OUTPUT THAT 4K. + CAMG T,C ;WHEN LESS THAN 4K REMAIN TO BE DONE, + JRST [ POP P,C ;WE DO WHAT IS LEFT AND EXIT. + JRST PUNCHH] + CALL PUNCHH + JRST PUNCHJ + +PUNCHH: SAVE PT ;MOVE THE GAP UP PAST END OF RANGE TO BE TRANSFERRED NOW, + MOVEM C,PT + CALL GAPSL0 ;WITHOUT MARKING THE BUFFER AS MODIFIED, HOWEVER. + REST PT +PUNCHG: MOVE IN,E + MOVE BP,IN + SUBM C,IN ;IN GETS COUNT OF CHARS REMAINING. + JUMPLE IN,CPOPJ + PUSHJ P,GETIBV ;BP GETS BP TO FETCH FROM BUFFER. +PCHF1: MOVE TT,UTYOP + HLRZ OUT,BP + CAMN TT,[010700,,UTOBUF-1] ;UTOBUF EMPTY AND + CAIE OUT,010700 ;NEXT CHR IN BUFFER IS 1ST IN A WD => + JRST PCHF2 +PCHF3: CAIGE IN,5 ;TRY .IOTING OUT OF BUFFER. + JRST PCHF2 + ADDI BP,1 + MOVE CH,IN ;GET # WDS FULL IN BUFFER AFTER WHERE WE ARE. + IDIVI CH,5 +IFN ITS,[ + CAIL CH,4000 + MOVEI CH,4000 ;DON'T OUTPUT MORE THAN 2K AT ONCE. + MOVNS CH + HRLI BP,(CH) ;BP HAS AOBJN -> WDS IN BUFFER. + .IOT CHFILO,BP +] +IFN TNX,[ + JSR SAVABC ;SAVE ACS + MOVNS C,CH ;NUMBER OF CHARS + MOVEI B,(BP) ;FIRST WORD + HRLI B,444400 + MOVE A,CHFILO ;OUTPUT FILE + SOUT + HRRI BP,1(B) ;FIRST ADDR NOT WRITTEN + JSP A,RST321 ;RESTORE ACS +] + IMULI CH,5 ;# CHARS JUST OUTPUT. + ADD IN,CH ;THAT MANY FEWER LEFT. + SUBI BP,1 ;CHANGE BP BACK TO BP TO NEXT CHAR. + HRLI BP,010700 + JRST PCHF3 ;HANDLE REMAINING CHARS. + +PCHF2: MOVN OUT,UTYOCT + CAMLE OUT,IN + MOVE OUT,IN ;OUT GETS # OF CHARS TO XFER INTO OUTPUT BUFFER. + PUSH P,OUT + JUMPE OUT,PPG1 + MOVE E,[PPG,,A] + BLT E,D + JRST A + +PPG: ILDB CH,BP ;A + IDPB CH,TT ;B + SOJG OUT,A ;C + JRST PPG1 ;D + +PPG1: POP P,OUT + MOVEM TT,UTYOP + ADDM OUT,UTYOCT ;UPDATE MINUS NUMBER OF FREE CHARS REMAINING IN BUFFER. + SKIPL UTYOCT + CALL UTYOA + SUB IN,OUT + JUMPG IN,PCHF1 + RET + +POPDJ: POP P,D + POPJ P, + +;THIS IS THE HIGHER LEVELS OF THE P COMMAND. +PUNCH: SKIPGE OUTFLG ;CHECK FOR OUTPUT DISABLED OR NO FILE OPEN. + RET + TLNN FF,FLOUT + TYPRE [NDO] + TRNE FF,FRARG2 + JRST PUNCHB ;2-ARG P COMMAND. + MOVE T,CPTR + ILDB T,T ;ELSE PEEK AT NEXT CHAR TO SEE IF IT IS W. + ANDCMI T,40 + SKIPE COMCNT + CAIE T,"W +PUNCHA: SETZ T, ;ENTER HERE FOR N AND EE COMMANDS. + SKIPGE OUTFLG ;IF T IS NONZERO, DON'T READ, JUST OUTPUT. + RET + TLNN FF,FLOUT + TYPRE [NDO] + MOVE D,C ;D HAS NUMBER OF PAGES TO OUTPUT. + JUMPL D,CPOPJ +PUN1: SAVE D + SAVE T + PUSHJ P,PUNCHR + TRZ FF,FRARG + SKIPN (P) + CALL YANKEE + REST T + REST D + MOVE E,ZV + CAMN E,BEGV ;KEEP FEEDING PAGES THROUGH UNTIL COUNT RUNS OUT + SKIPE LASTPA ;OR WE ARE AT EOF WITH AN EMPTY BUFFER. + SOJG D,PUN1 +CPOPJ: POPJ P,VIEW1 + +PUNCHR: SKIPGE STOPF ;IN BETWEEN PAGES, + CALL QUIT0 ;TRY TO QUIT IF DESIRED (CHECKS NOQUIT). + MOVE E,BEGV + MOVE C,ZV + SKIPE FFMODE ;IN FFMODE, ANY ^L DESIRED IS ALREADY IN BFR. + JRST PUNCHF + CALL PUNCHF ;IF ^L'S READ GET THROWN AWAY, + MOVEI CH,^L ;MUST REGENERATE THEM ON OUTPUT. + JRST PPA + +;FORCE OUT CONTENTS OF OUTPUT BUFFER. CLOBBERS A, B, C. +FLSOUT: TLNN FF,FLOUT + RET ;NO OUTPUT FILE. + MOVE B,UTYOP + IBP B ;-> WD NEXT OUTPUT CHAR WILL GO IN. + MOVEI A,@B + MOVNI C,-UTOBUF(A) ;# WDS FILLED UP IN FRONT END OF BFR. + JUMPE C,CPOPJ +IFN ITS,[ + HRLZI A,(C) + HRRI A,UTOBUF ;AOBJN -> FILLED PART. + .IOT CHFILO,A +] +IFN TNX,[ + SAVE C + SAVE B + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + SOUT + REST B + REST C +] + MOVE A,(B) ;GET THE PARTIALLY FILLED WORD. + MOVEM A,UTOBUF ;PUT IT IN 1ST WD OF BUFFER, + ADDM C,UTYOP ;BACK THE BP UP THE RIGHT # WDS. + IMULI C,5 + ADDM C,UTYOCT ;MORE SPACE IN OUTPUT BUFFER NOW. + POPJ P, + +;OUTPUT CHAR IN CH TO OUTPUT FILE, IF ANY. +PPA: +PPA2: SKIPGE OUTFLG + RET + TLNE FF,FLOUT + JRST UTYO + RET + +UTYO: IDPB CH,UTYOP + AOSGE UTYOCT + POPJ P, +UTYOA: MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT +IFN ITS,[ + MOVE CH,[UTOBUF-UTOBE,,UTOBUF] + .IOT CHFILO,CH + MOVE CH,[10700,,UTOBUF-1] + EXCH CH,UTYOP + POPJ P, +] +IFN TNX,[ + JSR SAVABC ;SAVE ACS + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,[444400,,UTOBUF] ;POINTER TO BUFFER + MOVNI C,UTOBE-UTOBUF ;COUNT + SOUT + MOVE CH,[10700,,UTOBUF-1] ;UPDATE BUFFER POINTER + EXCH CH,UTYOP + JRST POPCBA ;RESTORE ACS AND RETURN +] ;IFN TNX + +;SET ACCESS POINTER OF OUTPUT FILE TO CHAR # IN C, +;WHICH MUST BE A MULTIPLE OF 5. ERROR IF ANY CHARS IN OUTPUT +;BUFFER ARE LOST (WHICH WILL BE THE CASE UNLESS OUTPUT STOPPED +;ON A WORD BOUNDARY). +FSOFAC: TLNN FF,FLOUT + TYPRE [NDO] +IFN ITS,[ + MOVEI A,CHFILO + .CALL RFACCB + TYPRE [NRA] +] + SAVE C + CALL FLSOUT ;FORCE OUT THE OUTPUT BUFFER. + REST C + MOVN A,UTYOCT ;ANYTHING NOT FORCED OUT?? + CAIE A,UTBSZ*5 + TYPRE [WLO] + IDIVI C,5 ;GET WORD # IN FILE OF DESIRED POSITION. + SKIPE D + TYPRE [ARG] ;ARG NOT MULTIPLE OF 5?? +IFN ITS,.ACCES CHFILO,C +IFN TNX,[ + MOVE A,CHFILO ;OUTPUT FILE + MOVE B,C + SFPTR ;SET POINTER + TYPRE [NRA] +] + RET + +SUBTTL I/O COMMANDS + +ECMD: TLO FF,FLDIRDPY ;DISPATCH FOR E-COMMANDS. + PUSHJ P,LRCH + ANDI CH,-1 + CAIN CH,^U + JRST EUHACK + CAIGE CH,"? ;IF CHARACTER BEYOND "?, DISPATCH ON IT. + TYPRE [IEC] + XCT ETAB-"?(CH) + +RLTCLK: CALL SAVACS ;RUN THE REAL TIME CLOCK HANDLER. DON'T CLOBBER ANYTHING. + SETZM CLKFLG + SKIPE A,CLKMAC + CALL MACXCP + SETZM CLKFLG + JRST RSTACS + +IFN ITS,[.SEE %%TNX% ;WHERE THIS MOBY CONDITIONAL ENDS + +ASLEEP: CALL IMMQIT + TRZE FF,FRCLN + JRST ASLEE1 + TRZE FF,FRARG + .SLEEP C, + JRST DELQIT + +ASLEE1: AOS (P) ;:^S 1) RETURNS RESULT OF FS LISTEN$ +ASLEE4: TRZ FF,FRARG ; 2) SLEEPS ONLY AS LONG AS THERE IS NO INPUT AVAIL. + SKIPN TYISRC + SKIPL UNRCHC + SKIPA A,[1] + .LISTEN A, + JUMPN A,DELQIT + JUMPE C,DELQIT + CALL TTYAC2 +ASLEE2: .SLEEP C, + JRST ASLEE4 + +EQMRK: CALL FFRRDD ;E?$ 0 IF FILE EXISTS, ELSE (NUMERIC) ERROR CODE. + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;TRY TO OPEN; A GETS 0 OR I.T.S. ERROR CODE + JFCL + SETZM IMQUIT + .CLOSE CHRAND, + JRST POPJ1 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS. VALUE SAVED IN CLKINT BY FSNORM. +FSCLKI: TRNN FF,FRARG + JRST FSNORM + SKIPE C ;OR TURN OFF REAL TIME CLOCK, WITH ARG OF 0. + SKIPA A,[%RLSET,,C] + MOVSI A,%RLFLS + .REALT A, + JRST FSNORM + +SUBTTL EG COMMAND + +EGET: PUSH P,LISTF5 + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY ;EGET TO INSERT IN THE BUFFER + PUSHJ P,GDATIM + JFCL + PUSHJ P,GLPDTM + SKIPG E,DATE ;THE DATE + SETZ E, ;IF SYSTEM DOESN'T KNOW DATE, USE 6 SPACES. + CALL TYPR + CALL CRR1 + SKIPG E,TIME + SETZ E, + CALL TYPR ;INSERT TIME FROM SIXBIT WORD, + CALL CRR1 + MOVE A,DEFDIR ;THE CURRENT SYSTEM NAME + PUSHJ P,SIXINS + CALL LFILE ;INSERT CURRENT DEFAULT FILE NAMES. + CALL CRR1 + TLNN FF,FLIN ;THE NAMES OF THE FILE OPEN FOR READING (IF ANY) + JRST EGET2 ;(NONE, LEAVE BLANK LINE - EVENTUALLY REPLACE THIS CRUFT WITH .RCHST) + MOVE A,ERSNM + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,ERDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,RUTF1 + MOVEI C,40 + PUSHJ P,SIXINT + SKIPA A,RUTF2 +EGET2: SETZI A, + PUSHJ P,SIXINS + SKIPL TIME + PUSHJ P,SYMDAT ;THE DATE IN STANDARD SYMBOLIC FORM + PUSHJ P,CRR1 + LDB CH,[320300,,YEAR] ;A THREE DIGIT NUMBER + PUSHJ P,DGPT ;FIRST DIGIT DAY OF WEEK (0 => SUNDAY) + LDB CH,[270300,,YEAR] ;SECOND DIGIT DAY OF WEEK OF BEGINNING OF YEAR + PUSHJ P,DGPT + LDB CH,[410300,,YEAR] ;THIRD DIGIT 3 BITS + ;4 BIT 1 => NORMAL YEAR AFTER 2/28 + ;2 BIT 1 => LEAP YEAR + ;1 BIT 1 => DAYLIGHT SAVINGS TIME IN EFFECT + PUSHJ P,DGPT + PUSHJ P,CRR1 + PUSHJ P,POM ;THE PHASE OF THE MOON + PUSHJ P,CRR1 + POP P,LISTF5 + POPJ P, + + ;VARIOUS TIME GETTING ROUTINES + +GDATIM: .RDATIM A, ;GET TIME IN A, DATE IN B + MOVEM A,TIME ;STORE SIXBIT TIME + MOVEM B,DATE ;STORE SIXBIT DATE + JUMPGE A,POPJ1 ;IF TIME AVAILABLE THEN SKIP-RETURN + POPJ P, ;NOT AVAILABLE, DON'T SKIP (BUT LEAVE TIME AND DATE NEGATIVE) + +GLPDTM: .RLPDT A, ;GET VARIOUS TIMES IN BINARY + MOVEM B,YEAR ;SAVE YEAR AND FLAGS + MOVEM A,LPDTIM ;SAVE LOCALIZED # SECONDS SINCE BEGINNING OF YEAR + TLNE B,400000 ;IF NORMAL YEAR AFTER FEB 28, + SUBI A,SPD ;THEN BACK UP A DAY + TLNE B,100000 ;IF DAYLIGHT SAVINGS TIME IN EFFECT, + SUBI A,3600. ;THEN BACK UP AN HOUR + MOVEM A,PDTIME ;SAVE # SECONDS SINCE BEGINNING OF YEAR + POPJ P, + + ;TYPE OUT (THROUGH LISTF5) THE DATE IN ENGLISH + +SYMDAT: PUSHJ P,DOW ;TYPE DAY OF WEEK + REPEAT 2,PUSHJ P,SPSP ;TYPE TWO SPACES + MOVE E,DATE ;GET DATE + DPB E,[221400,,CDATE] ;DEPOSIT SIXBIT FOR DAY OF MONTH + LDB CH,[220100,,DATE] ;GET FIRST DIGIT OF MONTH + LDB E,[140400,,DATE] ;GET SECOND DIGIT OF MONTH + IMULI CH,10. ;MULTIPLY THE FIRST DIGIT TO ITS PROPER WEIGHTING + ADD E,CH ;ADD TOGETHER TO GET MONTH + MOVE E,MONTHS-1(E) ;GET MONTH IN SIXBIT + PUSHJ P,SIXNTY ;TYPE OUT MONTH + MOVE E,CDATE ;GET FIRST PART OF DATE + PUSHJ P,TYPR ;TYPE OUT + MOVE E,DATE ;GET DATE + MOVEI IN,2 ;LIMIT TYPEOUT TO TWO CHARACTERS + JRST TYPR3 ;TYPE OUT LAST TWO DIGITS OF YEAR AND RETURN + +MONTHS: IRPS S,,[JAN FEB MARCH APRIL +MAY JUNE JULY AUG SEPT OCT NOV DEC] + SIXBIT /S/ +TERMIN + + ;TYPE OUT DAY OF WEEK + +DOW: LDB A,[320300,,YEAR] ;GET DAY OF WEEK (0 => SUNDAY) + MOVE A,DOWTBL(A) ;GET SIXBIT FOR DAY (EXCEPT FOR THE "DAY") + PUSHJ P,SIXIN1 ;TYPE OUT + MOVSI A,(SIXBIT /DAY/) ;NOW FOR THE "DAY" + JRST SIXIN1 ;TYPE IT OUT AND RETURN + +DOWTBL: IRPS DAY,,[SUN MON TUES WEDNES THURS FRI SATUR] + SIXBIT /DAY/ + TERMIN + + ;TYPE OUT THE PHASE OF THE MOON + +POM: PUSHJ P,GNDS0 ;GET NUMBER OF DAYS SINCE 1/1/0000 + MULI A,SPD ;CONVERT TO SECONDS IN A AND B + JFCL 17,.+1 ;CLEAR FLAGS FOR FOLLOWING + ADD B,PDTIME ;# SECONDS SINCE BEGINNING OF YEAR + ADD B,SYNOFS ;THE MOON DOESN'T QUITE BELIEVE IN THE GREGORIAN CALENDAR SYSTEM + JFCL 4,[AOJA A,.+1] ;CRY1 + ASHC A,2 ;CONVERT TO QUARTER SECONDS + DIV A,SYNP ;DIVIDE BY NUMBER OF SECONDS IN A PERIOD TO GET NUMBER OF QUARTERS SINCE THEN + ASH B,-2 ;CONVERT REMAINDER TO SECONDS (# SECONDS INTO THIS QUARTER) + PUSH P,B ;SAVE REMAINDER + IDIVI A,4 ;GET QUARTER IN B + MOVE A,[SIXBIT /NM+ FQ+ FM+ LQ+/](B) ;GET SIXBIT CRUFT IN A (I REFUSE TO CHANGE THE 1Q!!!) + PUSHJ P,SIXIN1 ;TYPE IT OUT + POP P,B ;RESTORE # SECONDS INTO THIS PERIOD +TDHMS: MOVEI E,TDHMST ;SET POINTER TO TABLE +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + PUSHJ P,[AOJA E,TDHMS1] ;INCREMENT INDEX WHILE RECURSING + HLRZ C,(P) +TDHMS2: PUSHJ P,DPT ;TYPE OUT IN DECIMAL + HLLZ A,(E) ;GET SIXBIT CRUFT + SOJA E,SIXIN1 ;BACK UP INDEX, TYPE OUT, AND RETURN + +TDHMST: SIXBIT /S./+60. ;SECONDS + SIXBIT /M./+60. ;MINUTES + SIXBIT /H./+24. ;HOURS + SIXBIT /D./+<,-1> ;DAYS + +SYNP: 2551443. +SYNOFS: 690882. + + ;GET NUMBER OF DAYS SINCE 1/1/0000 (AS OF 1/1/CURRENT YEAR) IN A + +GNDS0: MOVEI C,@YEAR ;GET YEAR + MOVEI A,-1(C) ;ALSO GET YEAR-1 IN A + IMULI C,365. ;FIRST APPROXIMATION + IDIVI A,4 + ADD C,A ;ADD NUMBER OF YEARS DIVISIBLE BY 4 + IDIVI A,25. + SUB C,A ;SUBTRACT NUMBER OF YEARS DIVISIBLE BY 100 + IDIVI A,4 + ADD A,C ;ADD CRUD ALREADY CALCULATED TO NUMBER OF YEARS DIVISIBLE BY 400 + AOJA A,CPOPJ + +SUBTTL FILENAME READER FOR ITS + +;FILENAME PARSING ROUTINES. FFRDEV READS DEV AND SNAME ONLY. +;FFRRDD (ET CMD) READS ENTIRE NAME. +;FRD LEAVES THE NAMES IN A, B NOT SETTING DEFFN1 AND DEFFN2. +FFRDEV: TROA FF,FRNOT +FRD: TRZ FF,FRNOT + TROA FF,FRALT +ETCMD: +FFRRDD: TRZ FF,FRALT+FRNOT + MOVE A,DEFFN1 + MOVE B,DEFFN2 + SETOM FFRRCT + TRO FF,FRFIND +FF1: MOVEI E,0 + MOVE C,[440600,,E] +FF2: PUSHJ P,LRCH + SKIPGE SQUOTP + JRST FF3 + SKIPN SQUOTP + CAIE CH,ALTMOD + CAIN CH,40 + JRST FFTRM + CAIN CH,^I + JRST FFTRM + CAIE CH,^X + CAIN CH,^A ;^A OR ^X REFERS TO DEFAULT FIRST FILENAME. + JRST FFCTLX + CAIE CH,^Y + CAIN CH,^B ;^B OR ^Y REFERS TO SECOND DEFAULT FILE NAME + JRST FFCTLY + CAIN CH,"; + JRST FFSYSN + CAIN CH,": + JRST FFDEVN + CAIN CH,^Q + PUSHJ P,LRCH ;^Q QUOTES NEXT CHAR. +FF3: HRREI CH,-40(CH) + JUMPL CH,FF2 ;IGNORE CONTROL CHARACTERS. + TLNE C,770000 + IDPB CH,C + JRST FF2 + +;STORE NAME IN E AS SNAME, AND RESET DEVICE TO DSK IF APPROPRIATE. +FFSYSN: SKIPE E + MOVEM E,DEFDIR + .SUSET [.SSNAM,,E] + TRNN FF,FRFIND + JRST FF1 ;DEVICE HAS BEEN SPECIFIED + LDB C,[301400,,DEFDEV] + CAIE C,' ML + CAIN C,' AI + JRST FF1 + CAIE C,' MC + CAIN C,' ML + JRST FF1 + CALL FFDEV2 + JRST FF1 + +FFDEVN: PUSH P,[FFEND] +FFDEV1: JUMPE E,CPOPJ ;STORE THE CONTENTS OF E AS A DEVICE NAME, IF NOT NULL. + TRZ FF,FRFIND + CAMN E,['DSK,,] +FFDEV2: MOVE E,MACHIN + MOVEM E,DEFDEV + RET + +FFCTLX: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^X, + MOVE E,DEFFN1 ;GET THE DEFAULT FN1, + JRST FFTRM ;AND STORE IT AS A NAME. + +FFCTLY: CALL FFSTOR ;STORE AWAY ANY NAME TERMINATED BY THE ^Y, + MOVE E,DEFFN2 ;GET THE DEFAULT FN2, + JRST FFTRM ;AND STORE IT TOO. + +;STORE AWAY A "NORMAL FILENAME", IN E. IGNORE IT IF NULL. +FFSTOR: JUMPE E,CPOPJ + TRNE FF,FRNOT + JRST FFDEV1 + AOSE FFRRCT + MOVE A,B + MOVE B,E + RET + +;HERE AFTER A NAME IS TERMINATED WITH SOMETHING OTHER THAN : OR ; (IT'S A NORMAL NAME). +FFTRM: CALL FFSTOR +FFEND: CAIE CH,ALTMOD + JRST FF1 + SKIPL FNAMSY + SKIPA E,DEFFN2 + MOVSI E,'>_14 + SKIPE FNAMSY ;NONZERO FNAMSY SAYS + SKIPE FFRRCT ;IF ONLY ONE FILENAME + CAIA + JRST FFTRM ;USE ">" OR PREVIOUS DEFAULT AS SECOND. + TRZE FF,FRALT + RET + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + RET + +FSIFILE:SKIPA E,[ERDEV] ;FS I FILE$ - DESCRIBE OPEN INPUT FILE. +FSOFIL: MOVEI E,ROUDEV ;FS O FILE$ - DESCRIBE LAST CLOSED OUTPUT FILE. + AOSA (P) +FSDFRD: MOVEI E,DEFDEV + SAVE C + MOVEI C,14.*4 ;14 CHARS PER FILENAME >> ENOUGH + CALL QOPEN ;MAKE SURE ENOUGH SPACE, SET UP BP AND LISTF5 TO STORE INTO STRING. + MOVE A,3(E) ;WRITE THE DATA THROUGH THAT BYTE POINTER. + MOVEI C,"; + CALL SIXINT ;FIRST SNAME AND ";" AND A TAB + MOVEI CH,40 + IDPB CH,BP + MOVE A,(E) + MOVEI C,": ;THEN DEVICE NAME, ":", AND A TAB + CALL SIXINT + MOVEI CH,40 + IDPB CH,BP + MOVE A,1(E) ;THEN FN1 AND A TAB + MOVEI C,40 + CALL SIXINT + MOVE A,2(E) ;AND THE FN2. + CALL SIXIN1 + CALL QCLOSV + JRST POPCJ + +;FILE COPY +FCOPY: PUSHJ P,FFRRDD + MOVE A,[.BAI,,CHRAND] + CALL IMMQIT + .CALL RREDB ;OPEN FOR INPUT, NAMES IN DEFDEV ETC. + JRST OPNER1 + TRNN FF,FRUPRW ;^ E_ => XFER REAL FILENAMES OF SOURCE TO DEFAULTS. + JRST FCOPY3 + SYSCAL RFNAME,[ %CLIMM,,CHRAND ? 4WDARG( <%CLOUT,,DEFDEV>)] + .LOSE %LSFIL +FCOPY3: PUSHJ P,FFRRDD + SYSCAL OPEN,[[.BAO,,CHERRI] ? DEFDEV ? [SIXBIT/_TECO_/] ? [SIXBIT/_COPY_/] ? DEFDIR] + JRST OPNER1 + TRNN FF,FRCLN ;:E_ => TRANSFER INPUT FILE DATE TO OUTPUT FILE. + JRST FCOPY2 + SYSCAL RFDATE,[%CLIMM,,CHRAND ? %CLOUT,,Q] + SETOM Q + SYSCAL SFDATE,[%CLIMM,,CHERRI ? Q] + JFCL +FCOPY2: MOVE T,[-GCTBL,,GCTAB] + .IOT CHRAND,T + JUMPL T,FCOPY4 + MOVE T,[-GCTBL,,GCTAB] + .IOT CHERRI,T + JRST FCOPY2 + +FCOPY4: .CLOSE CHRAND, + MOVSI T,-GCTAB-1(T) + EQVI T,-1#GCTAB + .IOT CHERRI,T + SYSCAL RENMWO,[%CLIMM,,CHERRI ? DEFFN1 ? DEFFN2] + .VALUE + .CLOSE CHERRI, + JRST DELQIT + +BPNTRD: PUSHJ P,.OPNRD + TRZ FF,FRARG + JRST .FNPNT + +.OPNRD: PUSHJ P,FFRRDD +RRED: TLZ FF,FLIN ;IN CASE OPEN FAILS, INDICATE NOTHING IS OPEN. + CALL UTLSTP + MOVE A,[2,,CHFILI] + MOVE C,NUM + TRNE FF,FRARG ;IF HAVE ARG, IOR IT INTO OPEN-MODE. + TLO A,(C) + TRZE FF,FRARG2 ;PRE-COMMA ARG MEANS DON'T UPDATE REFERENCE DATES + TLO A,10 + CALL IMMQIT + TLZ A,1 ;MAKE SURE MODE USED FOR INPUT OPEN IS EVEN! + .CALL RREDB ;OPEN NAMES IN DEFDEV ETC, MODE,,CHNL IN A. + JRST OPNER1 ;FAILURE. + SETZM IMQUIT + SETZM PAGENU ;HAVE READ 0 PAGES SO FAR. + SETOM LASTPA ;NOT ON LAST PAGE AS FAR AS TECO KNOWS. + CALL RREDGN ;DO .RCHST, SET UP ERDEV, ERSNM, RUTF1, RUTF2. +;COME HERE TO START "OFFICIALLY" READING A FILE ALREADY OPEN. +RRED1: TLO FF,FLIN + MOVEI CH,^C + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOS CH + HRRM CH,UTRLDT + POPJ P, + +RREDB: SETZ ? SIXBIT/OPEN/ ? A ? UTFARG ? 403000,,A + +RREDGN: MOVE A,DEFDIR + SYSCAL RFNAME,[%CLIMM,,CHFILI ? 4WDARG( <%CLOUT,,ERDEV>)] + .VALUE + SKIPN ERSNM ;IF DEVICE DOESN'T USE SNAME, GIVE CURRENT SNAME. + MOVEM A,ERSNM + RET + +;IO PUSH-DOWN COMMANDS + +;E[ => PUSH INPUT CHANNEL +PSHIC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + MOVEI CH,CHFILI ;SET ARG TO FOLLOWING + TLNN FF,FLIN ;IF FILE NOT OPEN, + JRST PSHIC2 + PUSHJ P,PSHCK ;E := WORD ADR OR DIE BECAUSE NOT RANDOM ACCESS + MOVE A,UTYIP ;GET BYTE POINTER + IBP A ;MAKE SURE IT POINTS *TO* THE WORD TO GET THE NEXT BYTE FROM + MOVEI T,(A) + SUB T,UTRLDT + HRREI T,(T) ;GET -<# WORDS TO GO TO END OF BUFFER> + JUMPE T,PSHIC2 ;JUMP IF AT END OF BUFFER, DON'T NEED TO DO .ACCESS + ADD E,T ;CALCULATE DESIRED WORD ADDRESS + .ACCESS CHFILI,E ;CLOBBER TO DESIRED +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA. + LSH E,1 + SUB E,LASTPA ;LASTPA HOLDS 0 OR -1. + LSH E,2 + TLNE FF,FLIN ;SAVE STATE OF FLIN TOO. + ADDI E,2 + HRRI A,1(E) ;LOW BIT SET SAYS INPUT CHNL. + PUSHJ P,CHPSH ;DO THE PUSH + JRST UICLS ;CLOBBER POINTERS AND RETURN + + ;E] => POP INTO INPUT CHANNEL + +POPIC: TLZ FF,FLDIRDPY ;DON'T DISPLAY DIRECTORY. + PUSHJ P,UICLS ;CLOBBER POINTERS FIRST + MOVE CH,[TRNN T,CHFILI] ;TRNN SKIPS IF THIS RIGHT KIND OF PDL ENTRY, CHFILI CHANNEL TO POP INTO + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + LDB CH,[020100,,A] + MOVNM CH,LASTPA + LDB CH,[031700,,A] + MOVEM CH,PAGENU + .STATUS CHFILI,CH ;GET CHANNEL STATUS + TRNE CH,77 ;IF NO DEVICE OPEN NOW + TRNN A,2 ;OR NONE WAS OPEN THEN, + JRST UTLSTP ;SAY WE'RE AT END OF FILE (MUST ALWAYS SAY THAT IF FLIN OFF) + TLO FF,FLIN ;OTHERWISE, SAY A FILE IS OPEN + CALL UTRLD2 ;RE-FILL INPUT BUFFER. + HRRI A,UTIBUF ;CONVERT BACK TO BYTE POINTER + DBP7 A ;DECREMENT TO GET RELOCATED ORIGINAL POINTER. + MOVEM A,UTYIP ;STORE AS POINTER + JRST RREDGN ;DO RFNAME; SET UP ERDEV, ERSNM, RUTF1, RUTF2. + + ;CHECK THE VALIDITY OF THE INPUT FILE OPEN ON CHANNEL SPECIFIED BY CH + +PSHCK: HRRZ A,CH ;GET CHANNEL + .CALL RFACCB + TYPRE [NRA] + RET + +RFACCB: SETZ ? 'RFPNTR ? A ? MOVEM E ((SETZ)) + + ;E\ => PUSH OUTPUT CHANNEL + +PSHOC: TLZ FF,FLDIRDPY ;DON'T TRY TO CONTROL U + CALL FLSOUT ;FORCE OUT BUFFER, EXCEPT 1 WD (LEFT IN 1ST WD OF BUFFER) + MOVE B,UTYOP ;GET B.P. TO SHIFT POS. FIELD INTO A. + IBP B ;GET BP TO PLACE NEXT CHAR GOES (RH = UTOBUF). + LDB A,[73500,,UTOBUF] ;GET 1ST 4 CHRS FROM THAT WD + ;(5TH CAN'T BE USED, SINCE FLSOUT WOULD HAVE OUTPUT THE WD) + LSHC A,7 ;LEFT-JUSTIFY CHARACTERS AND SHIFT MEAT OF BYTE POINTER IN, LEAVE BIT 1.1 BLANK (=> OUTPUT) + MOVEI CH,CHFILO ;PUT CHANNEL SPECIFICATION IN CH + PUSHJ P,CHPSH ;PUSH THE CHANNEL (ALSO PUSH A ONTO LOCAL PDL) + TLZ FF,FLOUT + RET ;CLOBBER BUFFER POINTERS AND RETURN + + ;E^ => POP INTO OUTPUT CHANNEL + +POPOC: TLZ FF,FLDIRDPY\FLOUT ;DON'T TRY TO CONTROL U + MOVE CH,[TRNE T,CHFILO] ;GET CHANNEL AND TEST INSTRUCTION IN T (INSTRUCTION SKIPS IF THIS RIGHT PDL ENTRY) + PUSHJ P,CHPOP ;POP INTO THE CHANNEL + .STATUS CHFILO,C + TRNN C,77 + POPJ P, ;POPPED AN UNOPENED CHANNEL. + MOVEM A,UTOBUF ;STORE BACK PARTIALLY FILLED WORD + MOVE C,[700,,UTOBUF] ;GET BYTE POINTER LESS POSITION FIELD IN C + DPB A,[350700,,C] ;DEPOSIT POS FIELD + EXTRA LOW BIT + DBP7 C + MOVEM C,UTYOP ;STORE BACK NEW POINTER + ANDI A,177 ;MASK A TO POSITION FIELD_1 + IDIVI A,7_1 ;GET # CHARACTERS STILL TO BE PROCESSED THIS WORD - 1 IN A + ADDI A,*5-4 ;CONVERT TO NUMBER OF CHARACTERS YET TO OUTPUT + MOVNM A,UTYOCT ;STORE AS COUNT REMAINING + TLO FF,FLOUT ;FILE OPEN + RET + + ;PUSH THE IO CHANNEL SPECIFIED BY CH + +CHPSH: MOVE C,IOP ;GET IO PDL POINTER + PUSHJ P,CHPSH1 ;DO THE PUSH + MOVEM C,IOP ;STORE BACK UPDATED POINTER + POPJ P, + +CHPSH1: PUSH C,A + MOVE Q,[.IOPUS] + DPB CH,[270400,,Q] + XCT Q + POPJ P, + +CHPOP2: MOVE Q,[.IOPOP] + DPB E,[270400,,Q] + XCT Q + RET + + ;IO POP INTO THE CHANNEL SPECIFIED BY CH + +CHPOP: HLLM CH,CHPOPX ;STORE VALIDITY CHECKING INSTRUCTION + HRRM CH,GCHN2 ;STORE CHANNEL IN CHANNEL SEARCH ROUTINE (MAKE IT SKIP OVER IT) + MOVEI E,17 ;SET FIRST CHANEL FOR GCHN TO TRY + MOVE C,IOP ;GET IO PDL POINTER + HRRZ A,C ;GET RH IN A + MOVE B,[TYPRE [NOP] +] ;NOT ON PDL: EXECUTED IF SPECIFIED TYPE OF CHANNEL HASN'T BEEN PUSHED + PUSHJ P,CHPOP1 ;DO THE POP + XCT B ;LOST, DO THE APPROPRIATE THING + MOVEM C,IOP ;STORE BACK UPDATED POINTER + MOVE A,B ;PUT RETURN LOCAL PDL WORD IN A FOR ROUTINE THAT CALLED THIS ONE + MOVE CH,E ;RESTORE CH FOR CALLING ROUTINE + POPJ P, + + ;ENTRY ON TOP OF PDL WRONG TYPE, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + +CHPOP3: PUSH P,T ;SAVE LOCAL DESCRIPTOR WORD ON MAIN PDL + PUSHJ P,GCHN ;GET A FREE CHANNEL TO POP INTO + JRST POPAJ ;NO CHANNELS AVAILABLE + PUSHJ P,CHPOP2 ;POP INTO CHANNEL + HRLM E,-1(P) ;SAVE CHANNEL NUMBER POPPED INTO + PUSHJ P,[SOJA A,CHPOP1] ;TRY AGAIN ON ORIGINAL TASK + SOS -1(P) ;LOSE, CAUSE RETURN NOT TO SKIP + HLRZ CH,-1(P) ;RESTORE CHANNEL NUMBER, THIS TIME IN CH FOR PUSH BACK + POP P,A ;RESTORE LOCAL PDL ENTRY, BUT IN A + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPSH1 ;PUSH BACK CHANNEL AND RETURN + + +CHPOP1: CAIGE A,IOPDL ;IF A DOESN'T POINT INTO PDL, + RET ;THEN NOT ON PDL , UNSCREW PDL AND DO TYPRE [NOP] + POP C,T ;POP LOCAL PDL ENTRY INTO T + XCT CHPOPX ;SKIP IF THIS THE RIGHT KIND OF PDL ENTRY + JRST CHPOP3 ;WRONG KIND OF ENTRY, POP IT SOMEWHERE ELSE, RECURSE, THEN PUSH IT BACK + MOVE E,CH ;RIGHT KIND OF ENTRY, SAVE ORIGINAL CHANNEL SPECIFICATION IN E + MOVE B,T ;WIN, SAVE LOCAL PDL ENTRY FOR TOP LEVEL + AOS (P) ;CAUSE RETURN TO SKIP + JRST CHPOP2 + + ;FIND A FREE CHANNEL TO POP INTO + +GCHN: ;GCHN NAME OF ENTRY TRANSFERED TO, GCHN2 NAME OF INSTRUCTION TO ADDRESS MODIFY + XCT GCHN2 ;RH MODIFIED, CHANNEL REALLY TRYING TO POP INTO SO LEAVE IT ALONE + JRST GCHN3 ;DON'T POP INTO THIS CHANNEL + MOVE T,[.STATUS T] + DPB E,[270400,,T] + XCT T ;GET STATUS OF CHNL CONSIDERING POPPING INTO. + TRNN T,77 ;DEVICE OPEN ON CHANNEL? + JRST POPJ1 ;NO, RETURN WINNING +GCHN3: SOJGE E,GCHN ;LOSE, TRY NEXT CHANNEL + MOVE B,[TYPRE [NFC] +] ;NO FREE CHANNELS TO POP INTO + POPJ P, ;NON-SKIP RETURN + +EXITE: HRLOI C,377777 ;INFINITY + TRO FF,FRARG + MOVE E,BEGV ;PUNCH OUT IF BUFFER NONEMPTY + CAMN E,ZV + SKIPE LASTPA ;OR AN INPUT FILE IS OPEN + PUSHJ P,PUNCHA + CALL UICLS + JRST EFCMD + +;EF COMMAND - CLOSE OUTPUT FILE. +EFCMD: PUSHJ P,FRD ;READ FILENAMES TO CLOSE UNDER. +EFCMD1: MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + TLNN FF,FLOUT + TYPRE [NDO] + CAIA +EFCMDA: CALL UTYO ;PAD WITH THE CHARACTER IN FS FILEPAD TO WORD BNDRY. + MOVE CH,UTYOP + HRR CH,FILEPAD + TLNE CH,760000 + JRST EFCMDA + CALL FLSOUT ;FORCE OUT THE BUFFER (INCL. PADDING). + TRZE FF,FRCLN + JRST EFCMD2 + SYSCAL RENMWO,[%CLIMM,,CHFILO ? DEFFN1 ? DEFFN2] ;GIVE FILE ITS ULTIMATE SPEC'D NAME. + JRST OPNER1 +EFCMD2: SYSCAL RFNAME,[%CLIMM,,CHFILO ? 4WDARG( <%CLOUT,,ROUDEV>)] + .LOSE %LSFIL ;SET FS OFILE$ SO USER CAN FIND WHICH VERSION # IT WAS. + .CLOSE CHFILO, + TLZ FF,FLOUT + POPJ P, + +;EJ - OPEN FILE FOR READING AND LOAD IMPURE AREAS AS DUMPED IN FILE. +;TAKES A FILENAME ARGUMENT. DOES NOT ALTER THE DEFAULT SNAME. +;AFTER LOADING, TECO IS RESTARTED, WHICH MEANS M..L WILL BE DONE. +;^ EJ - WRITE ALL IMPURE AREAS INTO A FILE OPEN FOR WRITING, AND +;FILE IT AWAY AS SPEC'D NAMES. + +;FORMAT OF FILE: +;1ST WORD: SIXBIT/TECO/+1 (FOR ERROR CHECKING) +;2ND WORD: .FVERS OF TECO DOING THE DUMPING. + ;PREVENTS TECOS FROM LOADING DUMP FILES OF OTHER VERSIONS. +;3RD WORD: JRST 1, AS REQUIRED TO MARK THE BEGINNING OF SBLK DATA IN A BIN FILE +;THEN COME SBLK DATA BLOCKS SPECIFYING RANGES OF CORE TO LOAD, +;AND THEN TWO COPIES OF THE START ADDRESS (BOOT). + +;: EJ - OPEN FILE FOR READING AND MAP IT INTO CORE JUST UNDER LHIPAG. +;LHIPAG IS SET TO POINT AT THE BEGINNING OF THE FILE, AND A PURE +;STRING POINTER TO THE START OF THE FILE IS RETURNED. THIS COMMAND +;DOES NOT USE THE FILE FORMAT USED BY PLAIN EJ AND ^ EJ; IN FACT, +;THE FILE IS JUST A CORE IMAGE. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR + TLNN FF,FLOUT ;^ EJ. + TYPRE [NDO] + MOVE A,[-3,,[SIXBIT /TECO/+1 + .FVERS + JRST 1]] + .IOT CHFILO,A ;SAY THIS IS A TECO DUMP FILE, AND WHAT + ;TECO VERSION DUMPED IT. + HRROI A,P + JSP T,EJWBLK + MOVE A,[20-HCDS,,20] + JSP T,EJWBLK ;DUMP LOW IMPURE. + MOVE A,[HCDSE-LIMPUR,,HCDSE] + JSP T,EJWBLK ;EXCEPT FOR THE SCREEN-LINE HASH CODES. + MOVE A,QRWRT + ADDI A,4 + IDIVI A,5 ;ADDR LAST WORD OF IMPURE STRING SPACE. + SUBI A,HIMPUR ;LENGTH OF HIGH IMPURE. + MOVNS A + HRLZS A + HRRI A,HIMPUR + JSP T,EJWBLK ;DUMP OUT HIGH IMPURE. + MOVE A,BFRBOT + IDIVI A,5 + MOVE C,BFRTOP + IDIVI C,5 + SUBM A,C ;- + HRL A,C ;AOBJN TO BUFFER SPACE. + JSP T,EJWBLK ;DUMP OUT BUFFER SPACE. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;OUTPUT THE STARTING ADDRESS + MOVE TT,[-4,,2] ;OUTPUT AN INDIRECT SYMBOL TABLE POINTER BLOCK, + MOVE A,[-4,,[SIXBIT /DSK/ ? SIXBIT /TECPUR/ ? .FNAM2 ? SIXBIT /.TECO./]] + JSP T,EJWBL1 ;WHICH NEEDS A CHECKSUM LIKE ALL OTHERS. + HRROI A,[JRST BOOT] + .IOT CHFILO,A ;AND THEN ANOTHER COPY, THUS MARKING OFF A NULL SYMBOL TABLE. + JRST EFCMD ;RENAME AND CLOSE FILE. + +;A HAS AOBJN POINTER TO RANGE OF DATA; WRITE AN SBLK DESCRIBING IT. +EJWBLK: MOVE TT,A +;HERE IF TT CONTAINS BLOCK HEADER, DISTINCT FROM THE POINTER TO THE DATA. +EJWBL1: HRROI C,TT ;FIRST WE NEED TO WRITE THE AOBJN ITSELF. + .IOT CHFILO,C + .IOT CHFILO,A ;THEN WRITE THE DATA IN THAT RANGE. + MOVE TT1,TT ;THEN COMPUTE THE CHECKSUM IN TT, INCLUDING THE AOBJN WORD + ROT TT,1 + ADD TT,(TT1) ;AND THEN THE DATA WORDS. + AOBJN TT1,.-2 + HRROI C,TT + .IOT CHFILO,C ;OUTPUT THE CHECKSUM. + JRST (T) + +;EJ AND :EJ COMMANDS (THE INPUT VERSIONS OF EJ). +EJCMDR: TRZ FF,FRARG ;DON'T PASS ANY ARG TO .OPNRD; USE BLOCK ASCII MODE ALWAYS. + CALL .OPNRD ;READ FILE SPEC & OPEN FILE + TRZN FF,FRCLN ;:EJ? + JRST EJCMD2 + SYSCAL FILLEN,[%CLIMM,,CHFILI ? %CLOUT,,A] + JRST OPNER1 + ADDI A,1777 ;HOW MANY PAGES LONG IS THE FILE? + LSH A,-10. + MOVNS C,A + ADD C,LHIPAG ;IF IT WILL END JUST BELOW LHIPAG, WHERE SHOULD IT START? + CAMG C,MEMT ;LEAVE AT LEAST ONE EMPTY PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;NO ROOM - CAN WE FLUSH SOME WASTAGE FROM BUFFER SPACE? + CAMG C,MEMT + TYPRE [URK] ;NO, THERE'S REALLY NO ROOM. + RET] + HRL C,A + SYSCAL CORBLK,[%CLIMM,,200000 ? %CLIMM,,%JSELF ? C ? %CLIMM,,CHFILI] + JRST OPNER1 + CALL UICLS ;ALL PAGES MAPPED; DON'T NEED THE FILE NOW. + ADDB A,LHIPAG ;ADJUST LHIPAG FOR PAGES WE HAVE GOBBLED. + IMULI A,5*2000 + TLO A,400000 ;RETURN A STRING POINTER TO BOTTOM OF FILE. + JRST POPJ1 + +EJCMD2: MOVE A,[-3,,C] ;ORDINARY "EJ". CHECK FIRST 3 WORDS OF FILE. + .IOT CHFILI,A .SEE IDIVI ;CONSECUTIVE AC'S USED HERE. + CAMN C,[SIXBIT/TECO/+1] + CAME D,[.FVERS] ;DUMPED BY DIFFERENT TECO VERSION, + TYPRE [AOR] ;OR NOT A TECO DUMP FILE. + CAME E,[JRST 1] + TYPRE [AOR] + .SUSET [.SMSK2,,[0]] ;INTERRUPT MIGHT DO TTYSET FROM NEWLY CLOBBERED VARS. + MOVE E,LHIPAG ;SINCE WE AREN'T OVERWRITING PURE STRING SPACE + ;MUSTN'T FORGET WHERE IT STARTS. + MOVE D,MSNAME ;ALSO DON'T CLOBBER MSNAME. + MOVE T,MEMT ;.IOT'S CAN MAKE MEMORY BUT CAN'T FLUSH ANY. + MOVE J,INITFL +EJCMD1: HRROI A,C + .IOT CHFILI,A ;READ NEXT BLOCK HEADER + JUMPGE C,EJCMD3 ;POSITIVE => END OF BLOCK DATA; RESTART TECO, RUNNING Q..L. + .IOT CHFILI,C ;LOAD DATA OF BLOCK, +EJCMD4: HRROI A,C .SEE TSINT4 ;MPV HERE OK EVEN IF BELOW QRWRT. + .IOT CHFILI,A ;SKIP THE CHECKSUM. + JRST EJCMD1 ;READ NEXT BLOCK. + +EJCMD3: MOVEM E,LHIPAG + INSIRP MOVEM D,MSNAME DEFDIR + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL ;FS LISPT$ SHOULD NOT BE CHANGED BY AN EJ. + .I SAVCMX=CBMAX=1 + .CLOSE CHFILI, + JRST INIT + +RENAM: PUSHJ P,FFRRDD + PUSHJ P,FRD + CALL IMMQIT + SYSCAL RENAME,[UTFARG ? A ? B] + JRST OPNER1 + MOVEM A,DEFFN1 + MOVEM B,DEFFN2 + JRST DELQIT + +ALINK: PUSHJ P,FFRRDD ;GET LINK NAME + CAME A,[SIXBIT/>/] + CAMN B,[SIXBIT/>/] + JRST ALINK1 ;MAKING LINK FROM FOO > WON'T DELETE ANYTHING. + MOVEI A,CHRAND + CALL IMMQIT + .CALL RREDB ;ELSE SEE IF ANY FILE WITH THAT NAME. + JRST ALINK1 + MOVEI CH,%EEXFL ;GET ERROR CODE FOR "FILE ALREADY EXISTS", + JRST OPNER4 ;SIGNAL AN ERROR WITH MESSAGE READ FROM SYSTEM. + +ALINK1: SETZM IMQUIT + MOVE A,[DEFDEV,,GCTAB] + BLT A,GCTAB+3 ;SAVE THE LINK NAMES, + CALL FFRRDD ;READ NAMES LINKED TO. + CALL ALINK2 ;GET CORRECT SNAME TO LINK TO IN C. + MOVE T,[GCTAB,,DEFDEV] + BLT T,DEFDIR ;BRING BACK LINK NAMES, + CALL IMMQIT + SYSCAL MLINK,[UTFARG ? A ? B ? C] + JRST OPNER1 + JRST DELQIT + +ALINK2: MOVE C,DEFDIR + MOVS T,DEFDEV ;CONVERT COM: TO COMMON;, ETC. + CAIN T,'COM + MOVE C,['COMMON] + CAIN T,'SYS + MOVSI C,'SYS + CAIN T,'TPL + MOVE C,['.LPTR.] + RET + +UNREAP==2 + +;READ OR WRITE DON'T-REAP BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSREAP: HLRZS E + SYSCAL FILBLK,[E ? %CLOUT,,A ? %CLOUT,,A ? %CLOUT,,A] + JRST OPNER1 + LDB A,[.BP (UNREAP),A] + MOVE B,['SREAPB] + JRST FSREA1 + +;READ OR WRITE DUMPED BIT OF FILE OPEN ON CHANNEL IN LH(E). +FSDUMP: HLRZS E + SYSCAL RDMPBT,[E ? %CLOUT,,A] + JRST OPNER1 + MOVE B,['SDMPBT] +FSREA1: TRZN FF,FRARG + JRST POPJ1 + SYSCAL CALL,[B ? E ? C] + JRST OPNER1 + JRST POPJ1 + +WWINIT: TRNN FF,FRCLN + CALL FFRDEV ;SET DEFAULT DEV AND SNAME + TRNE FF,FRCLN + CALL FFRRDD ;OR SET DEFAULT DEV, SNAME AND FILENAMES. +EICMD: +WINIT: MOVE A,DEFFN1 + MOVE B,DEFFN2 + TRZE FF,FRCLN ;:EW, :EI USE SPEC'D NAMES TO OPEN AS, + JRST WINIT1 + MOVE A,[SIXBIT/_TECO_/] ;WITHOUT COLON, OPEN AS _TECO_ OUTPUT. + MOVE B,['OUTPUT] +WINIT1: TLZ FF,FLOUT + CALL IMMQIT + MOVEI T,100000 ;^ EW OPENS IN WRITE-OVER MODE. + TRZN FF,FRUPRW +WINIT2: MOVEI T,0 ;OTHERWISE, USE NORMAL WRITE. + SYSCAL OPEN,[[3,,CHFILO] ? DEFDEV ? A ? B ? DEFDIR ? 4000,,T] + JRST WINIT3 + SETZM IMQUIT + JSP T,FHAK ;INIT. BUFFER POINTERS. + TLO FF,FLOUT + POPJ P, + +WINIT3: .STATUS CHFILO,D ;IF WRITE-OVER OPEN FAILS FOR "FILE NOT FOUND" + LDB D,[220600,,D] + CAIN D,%ENSFL + JUMPN T,WINIT2 + JRST OPNER1 + +FHAK: TLO FF,FLOUT + MOVE CH,[10700,,UTOBUF-1] + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT + JRST 1(T) + +;DO .MTAPE ON CHANNEL IN E, WITH ARGS IN C AND SARG. +FSMTAP: HRLZS E + HRRI E,C ;E GETS CHANNEL,,ADDRESS + HRL C,SARG ;LH(C) GETS COUNT (DEFAULT IS 1). + TRNN FF,FRARG2 + HRLI C,1 + .MTAPE E, + JFCL + MOVE A,C + JRST POPJ1 + +DELE: TRZE FF,FRCLN + JRST DELE1 ; :ED IS DELETE INPUT FILE. + PUSHJ P,FFRRDD + SYSCAL DELETE,[UTFARG] + JRST OPNER1 + POPJ P, + +DELE1: TLNN FF,FLIN + TYPRE [NFI] + SYSCAL DELEWO,[%CLIMM,,CHFILI] + .LOSE %LSFIL + POPJ P, + +LISTF: CALL FFRDEV ;EY COMMAND - READ DEV NAME. +CNTRU1: CALL VBDACU ;IF THERE'S A CMD STRING PENDING, + RET ;DON'T BOTHER OPENING THE DIR. + SETZ CH, + CALL DISINI + SKIPA OUT,[CHCT] +LISTFM: MOVEI OUT,TYOM ;EZ AND EM COMMANDS. + TRNE CH,20 + CALL FFRDEV + TLZ FF,FLDIRDPY + HRRM OUT,LISTF5 + CALL AOFDIR +LISTF2: HRRZ OUT,LISTF5 + CALL GFDBLK + CAIN OUT,TYOM ;IF DUMPING CRUD INTO BUFFER, + JRST LSTF3 ;THEN DO IT FAST +LISTF6: ILDB CH,FDRP + CAIE CH,EOFCHR + CAIN CH,14 + JRST LISTF% + CALL @LISTF5 + JRST LISTF6 + +LSTF3: ANDI CH,-1 + CAIE CH,FDRBUF ;DONT ALLOW TO BACK UP BEFORE BEGINNING + SUBI CH,1 ;BACK UP TO LAST WORD .IOT'ED INTO + CAIE CH,FDRBUF ;IF NOT POINTING TO BEGINNING OF BUFFER, + SUBI CH,1 ;THEN BACK UP A WORD FOR "FORM FEED AT END OF LAST WORD" SCREW + MOVEI E,-FDRBUF(CH) ;GET INDEX INTO BUFFER IN E + IMULI E,5 ;CONVERT E TO NUMBER OF CHARACTERS UP TO THIS WORD + HRLI CH,440700 ;CONVERT TO BYTE POINTER TO WORD +LSTF4: ILDB A,CH ;GET CHARACTER FROM LAST WORD (DOES THIS LOOK BACKWARDS TO YOU?) + CAIE A,14 ;IF FORM FEED, + CAIN A,EOFCHR ;OR IF EOF CHARACTER, + JRST .+2 ;THEN FOUND END + AOJA E,LSTF4 ;HAVEN'T FOUND END YET, LOOP BACK + JUMPE E,CPOPJ ;IF NO CHARACTERS THEN THAT'S ALL FOR THIS ROUTINE + MOVEI C,(E) + CALL SLPGET ;INSERT THAT MANY CHARS, GET IDPB BP IN BP. + ILDB CH,FDRP ;NOW GET CHARACTER TO COPY + IDPB CH,BP ;COPY IT + SOJG E,.-2 ;DO IT THE APPROPRIATE NUMBER OF TIMES + IBP FDRP ;INCREMENT FDRP TO MAKE IT APPEAR THAT THE ACTUAL EOF CHARACTER WAS ENCOUNTERED + + ;PROCESS THE NEXT BLOCK OF THE FILE DIRECTORY BEING LISTED + +LISTF%: SKIPN MORFLF + JRST LSTF%2 + HRRZ A,LISTF5 ;USER HAS "FLUSHED", SEE IF TYPING OUT + CAIN A,CHCT + JRST LSTF%3 ;TYPING OUT, STOP NOW +LSTF%2: HRRZ CH,FDRP + CAIN CH,FDRBFE + JRST LISTF2 ;MORE TO COME +LSTF%3: .CLOSE CHRAND, + HRRZ A,LISTF5 + CAIN A,CHCT + JRST DISCLG + POPJ P, + +IFN 0,%%TNX%: +] ;END IFN ITS CONDTIONAL + +SUBTTL TWENEX FILE COMMANDS + +IFN TNX,[.SEE %%TNX. ;END OF THIS CONDITIONAL + +ASLEEP: TRZN FF,FRARG + SETZ C, + LSH C,5 ;CONVERT 30THS OF A SECONDS TO MS (MORE OR LESS) + TRZE FF,FRCLN ;:^S? + JRST ASLEE1 ;YES + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND + MOVE A,C + DISMS + JRST DELQIT + +ASLEE1: JUMPE C,FSLISN ;0:^S IS JUST LIKE FSLISTEN$, SO SAVE TIME THAT ATI, DTI WOULD TAKE. + CALL IMMQIT ;SLEEP FOR N 30TH'S OF A SECOND +ASLEE5: MOVEI A,.PRIIN ;ALSO IF WE ALREADY KNOW THE ANSWER + SIBE + JRST ASLEE4 ;DONT EVEN GO TO SLEEP + SKIPGE UNRCHC + SKIPE TYISRC + JRST ASLEE4 +IFN 10X,[ + CAIGE C,50. ;TENEX DOESNT HAVE TYPEIN INTERRUPT, SO TAKE 50. MS NAPS + SKIPA A,C ;LESS THAN INCREMENT, SLEEP FOR REMAINDER + MOVEI A,50. ;ELSE JUST FOR 50. + DISMS + SUBI C,50. + JUMPG C,ASLEE5 ;STILL TIME TO GO + SETZ B, ;TIME RAN OUT, RETURN 0 +] +IFN 20X,[ + MOVE A,[.TICTI,,1] + ATI ;ASSIGN ANY TYPEIN TO CHANNEL 1 + MOVE A,C + DISMS ;SLEEP OR GET AWAKENED + SETZ B, ;RETURN 0 + JRST ASLEE3 + +ASLEE2: CIS ;FLUSH INTERRUPTS + MOVEI A,.PRIIN + SIBE ;RETURN FS LISTEN + CAIA + SETZ B, ;NOTHING WAITING +ASLEE3: MOVEI A,.TICTI ;UNARM ANY INPUT INTERRUPT + DTI +] +ASLEE4: SETZM IMQUIT + MOVE A,B + JRST CPOPJ1 + +EQMRK: MOVSI A,(GJ%OLD) + CALL FRD ;E? RETURN 0 IF FILE EXISTS + JRST CPOPJ1 ;IT DOESNT, JUST RETURN ERROR CODE THEN + RLJFN ;GET RID OF THE JFN + JFCL + SETZ A, ;RETURN 0 FOR SUCCESS + JRST CPOPJ1 + +;SOMEONE SHOULD DEFINE THESE IN TWXBTS +.TIMAL==5 +.TIMEL==1 + +IFN 10X,[ ;STUPID TENICES CANT STANDARDIZE THIS +IF1 [ +PRINTX \IIT JSYS TYPE (0 - NONE, 1 - BBN, 2 - SUMEX): \ +.TTYMAC FOO +.IIT==FOO +TERMIN +IFE .IIT-1,IIT=JSYS 247 ;NOT EVEN THE SAME JSYS NUMBER +IFE .IIT-2,IIT=JSYS 630 +]] +.ELSE .IIT==0 + +;FS CLK INTERVAL$ - SET REAL TIME CLOCK INTERVAL IN 60THS OF SECONDS. VALUE SAVED IN CLKINT. +FSCLKI: TRNN FF,FRARG + JRST FSNORM + SAVE C ;PRESERVE ARG. +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMAL] ;DELETE ALL TIMERS FOR THIS FORK + MOVEI C,3 ;LOSING SYSTEM CHECKS CHANNEL EVEN WHEN NOT USED FOR ANYTHING + TIMER +] +IFE .IIT-1,[ + MOVE A,[100000,,.FHSLF] ;DELETE ALL BEFORE THIS TIME + HRLOI B,377777 ;INFINITY + IIT +] + JFCL ;IGNORE ERRORS + REST C + SAVE CLKINT ;GET OLD SETTING, TO RETURN IT. + MOVEM C,CLKINT + CALL FSCLK2 ;SET UP NEXT INTERRUPT, IF DESIRED. + REST A + JRST POPJ1 ;RETURN VALUE. + +FSCLK2: SKIPN B,CLKINT ;GET LENGTH OF REAL-TIME INTERVAL + RET ;NO MORE TO DO IF 0 + LSH B,4 ;CONVERT TO MSEC, APPROXIMATELY. +IFN 20X,[ + MOVE A,[.FHSLF,,.TIMEL] ;SET ELAPSED TIME + MOVEI C,3 ;ON CHANNEL 3 + TIMER +] +IFE .IIT-1,[ + MOVE A,[400000,,.FHSLF] + IIT +] +IFE .IIT-2,[ + MOVE C,B ;NUMBER OF MS UNTIL TIME + MOVEI A,.FHSLF + MOVSI B,10 ;ON CHAN 14. + IIT +] + JFCL ;IGNORE ERROR HERE AS WELL + RET + +TSINTC: SETOM CLKFLG ;REAL-TIME INTERRUPT, SAY IT IS TIME TO RUN HANDLER +INSIRP PUSH P,A B C + HRRZ A,INTPC2 ;GET WHERE INTERRUPT CAME FROM + CAIN A,TYIIOT ;WAITING FOR INPUT? + CALL [ SUBI A,1 ;YES, RUN THE HANDLER NOW, BUT IN CASE AN ERRSET GOES OFF + MOVEM A,INTPC2 ;DURING THE MACRO EXECUTION, ENSURE WE RESTART THE PBIN + JRST RLTCLK] ;AND DONT EVER FALL THROUGH WITH GARBAGE USER DIDNT TYPE + CALL FSCLK2 ;SETUP NEW TIMER FOR NEXT TIME +INSIRP POP P,C B A + DEBRK + ERJMP [JRST @INTPC2] ;NEEDLESS TO SAY THE INDIRECTION WONT WORK IN THE ERJMP ITSELF + +EGET: SAVE LISTF5 ;EG - INSERT STUFF INTO BUFFER + MOVEI A,TYOM + HRRM A,LISTF5 + CALL GAPSLP + TLZ FF,FLDIRDPY + HRROI A,BAKTAB + SETO B, ;CURRENT TIME + MOVSI C,(OT%NMN\OT%DAM) + ODTIM + MOVE A,[350700,,BAKTAB+1] + MOVEI C,1 + CALL EGETYP + MOVE A,[440700,,BAKTAB] + MOVEI C,2 + CALL EGETYP + CALL CRR1 + MOVE A,[100700,,BAKTAB+1] + MOVEI C,3 + CALL EGETYP + CALL CRR1 + GJINF ;CONNECTED DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + MOVEI E,DEFDEV + CALL FSDFR1 ;INSERT CURRENT FILENAME DEFAULTS + CALL CRR1 + TLNN FF,FLIN ;HAVE AN OPEN INPUT FILE? + JRST EGET2 + MOVEI E,ERDEV ;YES, INSERT IT'S REAL NAME + CALL FSDFR1 +EGET2: CALL CRR1 + HRROI A,BAKTAB ;CURRENT DATE IN ENGLISH FORMAT + SETO B, + MOVSI C,(OT%DAY\OT%FDY\OT%4YR\OT%DAM\OT%SPA\OT%NTM\OT%SCL) + ODTIM ;"MONDAY, NOV 28 1977" + MOVE A,[440700,,BAKTAB] + MOVEI C,3 ;REPLACE THIRD SPACE WITH COMMA + ILDB B,A + CAIE B,40 + JRST .-2 + SOJG C,.-3 + MOVEI B,", + DPB B,A + MOVEI A,BAKTAB + CALL ASCIND + CALL CRR1 + CALL CRR1 + CALL POM ;THE PHASE OF THE MOON (CLOSE) + CALL CRR1 + REST LISTF5 ;RESTORE THINGS + RET + +EGETYP: ILDB CH,A ;INSERT 2 CHARS AND THEN FLUSH THE NEXT ONE C TIMES + CAIN CH,40 + MOVEI CH,"0 + XCT LISTF5 + ILDB CH,A + XCT LISTF5 + SOJLE C,CPOPJ + IBP A + JRST EGETYP + +;TYPE OUT PHASE OF THE MOON +POM: GTAD + SUB A,SYNOFS ;OFFSET TO NEAREST NEW MOON TO DAY 0 + IDIV A,SYNP ;DIVIDE INTO QUARTER PERIODS + ANDI A,3 ;GET PERIOD + MOVEI A,PHSNMS(A) + CALL ASCIND ;TYPE ITS NAME + MULI B,24.*60.*60. ;CONVERT TO SECONDS + LSH C,1 ;FLUSH DUPLICATE SIGN BIT + LSHC B,17. ;GET ONE WORD PRODUCT + MOVEI E,TDHMST +TDHMS1: IDIVI B,@(E) + JUMPE B,TDHMS2 + HRLM C,(P) + CALL [AOJA E,TDHMS1] ;INCREMENT AND RECURSE + HLRZ C,(P) +TDHMS2: CALL DPT ;TYPE IN IN DECIMAL + HLLZ A,(E) + SOJA E,SIXIN1 ;BACK UP, TYPE AND RETURN +; USE SOME OTHER OUTPUT ROUTINE, SUCH AS SIXNTY OR ASCIND. + +PHSNMS: ASCII /NM+/ + ASCII /FQ+/ + ASCII /FM+/ + ASCII /LQ+/ + +TDHMST: SIXBIT /S./+60. + SIXBIT /M./+60. + SIXBIT /H./+24. + SIXBIT /D./+<,-1> + +SYNP: <29.53059&<777,,-1>>_-6 ;LENGTH OF QUARTER IN GTAD UNITS +SYNOFS: 22,,253553 ;18 DAYS AND A BIT + +FRDOLD: MOVSI A,(GJ%OLD) ;INSIST ON OLD FILE + CALL FRD + JRST OPNER1 ;DOESNT EXIST, ERROR +IFN 10X,[ ;THIS IS EXTREMELY DISTASTEFUL + SKIPN DEFFN2 ;IS THERE SUPPOSED TO BE AN EXTENSION? + RET ;NO, OK THEN + MOVE B,A ;YES, WE MUST CHECK FOR A GROSS MISFEATURE IN THE TENEX FILESYSTEM, + HRROI A,BAKTAB ;WHEREBY IF FILE WITH DEFAULT FN2 DOES NOT EXIST BUT A FILE WITH A NULL + MOVSI C,000200 ;FN2 DOES, IT WILL STILL BE FOUND + JFNS ;SEE WHAT THE EXTENSION OF THE FILE WE GOT IS + MOVE A,B + LDB B,[350700,,BAKTAB] + JUMPN B,CPOPJ ;NON-NULL, OK + RLJFN ;FOO! WE HAVE BEEN SCREWED, GET RID OF LOSING JFN + JFCL + MOVEI 2,GJFX19 + JRST OPNER4 ;AND FAKE NO SUCH EXTENSION ERROR +] +.ELSE RET + +FRD0: TDZA A,A +FRDFOU: MOVSI A,(GJ%FOU) +; GET A JFN FROM A FOLLOWING STRING, USING THE CURRENT DEFAULTS +; TAKES GTJFN FLAGS IN 1 RETURNS +1 A/ ERROR CODE OR +2 A/ JFN +FRD: CALL FFRRDD ;CONVERT STRING TO FILESPEC FORMAT +FF5: SETZ B, +FF5A: MOVE C,[.NULIO,,.NULIO] + SETO D, ;USE ALL DEFAULT FIELDS +FF4: MOVEM C,BAKTAB+.GJSRC + TRNN D,1 ;DEFAULT GENERATION NUMBER? + TRZA A,-1 ;NO, USE 0 THEN + HRR A,DEFFN3 ;GET DEFAULT GENERATION NUMBER + MOVEM A,BAKTAB+.GJGEN +.GJFN1==.GJNAM +.GJFN2==.GJEXT +IRPS STR,,[FN2 FN1 DIR DEV] + ROT D,-1 + TRNE D,1 ;DEFAULT THIS FIELD? + SKIPN DEF!STR ;AND HAVE A DEFAULT? + TDZA A,A ;NO OR NO + HRROI A,DEF!STR ;YES, GET IT + MOVEM A,BAKTAB+.GJ!STR +TERMIN + SETZM BAKTAB+.GJPRO + SETZM BAKTAB+.GJACT + MOVEI A,BAKTAB + GTJFN + RET ;SINGLE RETURN + JRST CPOPJ1 ;SKIP RETURN WITH THE JFN + +;READ A FILESPEC, SETTING DEFAULTS FROM IT +FFRDEV: +FFRRDD: SAVE A + CALL MEMTOP ;GET A POINTER TO START OF FREE BUFFER SPACE + HRLI A,440700 ;MAKE IT A BYTE POINTER + SAVE A ;SAVE IT FOR LATER + SETZ B, ;RESET FLAGS +FFST0: SETZB TT,(A) ;ZERO LAST CHARACTER INSERTED + MOVSI C,(A) + HRRI C,1(A) + BLT C,17(A) ;AND AREA WE WILL BE INSERTING INTO +FFST1: CALL RCH ;GET A CHARACTER + SKIPGE SQUOTP ;SUPERQUOTED? + JRST FFSTQ2 ;YES, INSERT IT QUOTED THEN + TRNE CH,100 ;UPPERCASE UNQUOTED LETTERS + ANDCMI CH,40 + SKIPN SQUOTP ;NOT A TERMINATOR? + CAIE CH,33 ;ELSE ALTMODE TERMINATES + CAIA + JRST FFST4 + TLNE B,040000 ;PARSING DIRECTORY NAME? + JRST FFSTDR ;YES, INSERT IT THEN + CAIE CH,^A + CAIN CH,^X ;WANTS FIRST NAME DEFAULT? + JRST FFSCTX + CAIE CH,^B + CAIN CH,^Y ;WANTS SECOND NAME DEFAULT? + JRST FFSCTY + CAIE CH,^V ;^V OR ... + CAIN CH,^Q ;^Q QUOTES ANOTHER CHARACTER + JRST FFSTQT + CAIN CH,40 ;TRANSLATE SPACE TO DOT + JRST FFSTSP + CAIN CH,": ;END OF DEVICE NAME + JRST FFSTCL + CAIN CH,"< ;MAYBE PART OF DIRECTORY + JRST FFSTLT + CAIN CH,"> ;DITTO + JRST FFSTGT + CAIN CH,". ;NOTICE WHEN WE GET THE DOT + JRST FFSTDT + CAIN CH,"; ;MAYBE PART OF DIRECTORY FOR ITS + JRST FFSTSM +IFN 20X,[CAIE CH,"[ ;THESE NEED TO BE QUOTED + CAIN CH,"] +] +IFN 10X,CAIN CH,"_ ;THIS NEEDS TO BE QUOTED ON TENEX + JRST FFSTQ2 + CAIE CH,"( + CAIN CH,") + JRST FFSTQ2 + CAIE CH,"@ + CAIN CH,"^ + JRST FFSTQ2 +FFST2: MOVEI TT,(CH) ;SAVE LAST CHAR INSERTED +FFST3: IDPB CH,A ;STICK IT IN + JRST FFST1 ;AND GET ANOTHER CHAR + +FFSTQT: CALL RCH ;^Q QUOTES NEXT CHAR +FFSTQ2: MOVEI C,^V + CAIE TT,^V ;UNLESS ^V WAS LAST TO GO IN + IDPB C,A ;INSERT ONE + HRROI TT,(CH) ;SAY CHAR WAS QUOTED + JRST FFST3 ;AND INSERT IT + +FFSTDR: CAIE CH,"> ;WAITING FOR DIRECTORY + JRST FFST2 + TLZ B,040000 +FFSTB4: +IFN EMCSDV\INFODV,[ ;IF CERTAIN DIRECTORIES ARE SPECIAL + MOVE C,DEFDEV ;THEY ARE SPECIAL ONLY IF NO DEVICE SPECIFIED, OR DSK:. + TLNE B,010000 ;DID USER SPECIFY DEVICE? + CAMN C,[ASCII/DSK/] ;YES. DID SHE SPECIFY DSK:? (NECESSARY!!!) + SKIPA + JRST FFSTB5 ;THE DIR NAME IS NOT SPECIAL. SO FUNNY-STR: WORKS. + HRRZ A,(P) ;GET ADDRESS OF STRING + MOVE C,(A) ;AND FIRST WORD THEREOF +IFN EMCSDV,[ + CAMN C,[ASCII /EMACS/] ;STARTS WITH EMACS + SKIPN 1(P) ;AND ENDS RIGHT AWAY? +IFE INFODV,SKIPA +] +IFN INFODV,CAMN C,[ASCIZ /INFO/] + JRST [ MOVEM C,DEFDEV ;MAKE THAT THE DEFAULT DEVICE AS WELL + SETZM DEFDEV+1 + JRST FFSTB6] +FFSTB5: SKIPE DEFDEV+1 + JRST FFSTB6 + MOVE C,DEFDEV ;IF NEW DIRECTORY IS NOT A SPECIAL ONE, + CAME C,[ASCII /INFO/] ;THEN IF THE DEVICE IS EMACS: OR INFO: + CAMN C,[ASCII /EMACS/] + TLNE B,010000 ;AND WASN'T JUST SPECIFIED EXPLICITLY, + JRST FFSTB6 + MOVE C,[ASCIZ /DSK/] ;RESET IT TO DSK. + MOVEM C,DEFDEV +] ;END EMCSDV\INFODV +FFSTB6: SKIPA A,[DEFDIR] +FFSTB0: MOVEI A,DEFFN1 +FFSTB1: HRL A,(P) ;GET START OF WHERE IT IS +FFSTB2: MOVEI C,17(A) ;GET END + BLT A,(C) ;MOVE THE DEFAULT IN +FFSTB3: MOVE A,(P) ;GET FRESH STRING POINTER + JRST FFST0 ;AND CONTINUE + +FFSCTX: SKIPA A,[DEFFN1,,0] ;INSERT DEFAULT FN1 +FFSCTY: MOVSI A,DEFFN2 ;INSERT FN2 + TLO B,400000 ;THESE ARE ITS CONSTRUCTS + JUMPE TT,FFSCT2 ;UNLESS NOTHING SEEN YET, + MOVEI C,DEFFN1 ;SET UP WHAT WE HAVE AS FN1 + HRL C,(P) + MOVEI CH,17(C) + BLT C,(CH) +FFSCT2: HRRI A,DEFFN1 ;ASSUME SETTING FN1 + TLOE B,200000 ;UNLESS DOT SEEN ALREADY + HRRI A,DEFFN2 ;IN WHICH CASE, FN2 + JRST FFSTB2 ;GO SET THEM AND CONTINUE + +FFSTSP: JUMPE TT,FFST1 ;SPACE - IF NOTHING YET, FLUSH IT IN ALL CASES + TLO B,400000 ;ELSE IT IS ITS STYLE + TLOE B,200000 ;IF ALREADY HAVE A DOT, + JRST FFST1 ;JUST FLUSH IT + JRST FFSTB0 ;ELSE GO SET FN1 FROM WHAT WE HAVE + +FFSTCL: HRRZ A,(P) ;: - GET FIRST WORD FOR DEVICE + TLO B,010000 ;USER SPECIFIED A DEVICE + MOVE C,(A) + MOVEM C,DEFDEV + MOVE C,1(A) + MOVEM C,DEFDEV+1 + JRST FFSTB3 ;AND GO GET MORE + +FFSTLT: JUMPGE B,FFSTL2 ;< - IF NOT ITS, MUST BE DIRECTORY + SKIPA C,[.GJLEG] ;ELSE WANT OLDEST VERSION +FFSTGT: MOVEI C,.GJDEF ;> - WANT NEWEST VERSION + MOVEM C,DEFFN3 ;SET UP DEFAULT GEN NUMBER + SETZM DEFFN2 ;AND DEFAULT FN2 TO NULL + TLOA B,320000 ;BOTH NAMES SEEN +FFSTL2: TLO B,040000 ;LOOK FOR DIRECTORY NAME + JRST FFST1 + +FFSTDT: JUMPL B,FFSTQ2 ;QUOTE IT IF ITS STYLE + TLOE B,200000 ;ALREADY HAVE A DOT? + JRST FFSTD2 ;YES, MUST BE END OF FN2 OR GENERATION NUMBER + JUMPN TT,FFSTB0 ;NON NULL STRING, MUST TERMINATE FN1 + TLO B,400000 ;ELSE ITS STYLE, + JRST FFSTQ2 ;SO INSERT IT QUOTED +FFSTD2: TLOE B,100000 ;ALREADY HAVE BOTH DOTS? + JRST FFSTD3 ;YES, MUST BE END OF GENERATION NUMBER THEN + MOVEI A,DEFFN2 ;ELSE, SET DEFAULT FN2 + JRST FFSTB1 ;AND RETURN +FFSTD3: TLOE B,020000 ;EVERYTHING SEEN + JRST FFST1 ;ALREADY ALL SEEN, FLUSH IT THEN + CALL FFSGEN ;GET GENERATION NUMBER FROM STRING + JRST FFSTB3 ;AND RETURN + +FFSTSM: TLNE B,200000 ;IF DOT SEEN ALREADY, + JRST FFSTD2 ;TREAT IT AS A DOT NOW + TLO B,400000 ;ELSE, ITS'S ITS STYLE + JRST FFSTB4 ;AND THE DIRECTORY + +FFST4: POP P,A ;GET BACK STRING POINTER + TLNE B,020000 ;IF EVERYTHING SEEN ALREADY, + JRST POPAJ ;DONE + TLNE B,300000 ;IF EITHER FN1 OR FN2 SEEN, + SETZM DEFFN3 ;RESET THE GENERATION NUMBER + JUMPE TT,POPAJ ;IF NOTHING YET, DONE + TLNE B,040000 ;IF WAITING FOR DIR, + JRST FFST4D ;FINISH IT UP + TLNE B,100000 ;IF PARSING GENERATION NUMBER + JRST FFST4G ;GO DO THAT + TLNE B,200000 ;IF PARSING FN2, + JRST FFST4B + SKIPLE C,FNAMSY ;FS FNAM SYNTAX$ > 0 => DEFAULT FN1 + JRST FFST4A ;GO SET FN1 + JUMPE C,FFST4B ;0 => GO SET FN2 + SETZM DEFFN2 ;DEFAULT TO FOO..0 +FFST4A: SKIPA C,[DEFFN1] ;SETTING DEFFN1 +FFST4B: MOVEI C,DEFFN2 ;SETTING DEFFN2 +FFST4C: HRLI C,(A) ;SOURCE + MOVEI A,17(C) + BLT C,(A) ;SET IT UP + JRST POPAJ ;AND RETURN +FFST4D: MOVEI C,DEFDIR ;SETTING DIRECTORY + JRST FFST4C +FFST4G: CALL FFSGN0 ;SET GENERATION NUMBER + JRST POPAJ ;AND RETURN + +FFSGEN: MOVE A,-1(P) ;GET STARTING POINTER +FFSGN0: SETZB TT,C ;INIT NUMBER + ILDB CH,A ;PEEK FIRST CHAR + CAIE CH,"- ;NEGATIVE? + JRST FFSGN2 ;NO + SETO C, ;SAY NEGATIVE NUMBER +FFSGN1: ILDB CH,A ;GET CHARACTER +FFSGN2: CAIL CH,"0 + CAILE CH,"9 + JRST FFSGN3 + IMULI TT,10. + ADDI TT,-"0(CH) + JRST FFSGN1 +FFSGN3: SKIPGE C ;NEGATIVE? + MOVNS TT ;YES + MOVEM TT,DEFFN3 ;SET UP DEFAULT GEN NUMBER + RET + +;SET UP DEFAULTS FROM STRING FOLLOWING +ETCMD: TRZN FF,FRCLN ;:ET? + JRST FFRRDD ;NO + +FFRRTT: CALL ECOPOS ;POSITION TO CURRENT PLACE IN ECHO AREA + CALL DPYRST ;RESET DISPLAY MODE + MOVEI A,.CTTRM + RFMOD + MOVEM B,SAVMOD ;SAVE TTY MODE (ALSO FOR ^G TO USE) + TRO B,1_6\TT%ECO ;MAKE SURE ECHO ON AND DATA MODE OK + SFMOD +IFN 20X,[ + BKJFN + JRST FFRRT0 + BIN ;GET THE LAST CHARACTER TYPED + CAIN B,15 ;CR? + BIN ;YES, READ THE LF TOO +FFRRT0: ];20X + SETOM IMQUIT ;ALLOW ^G'ING OUT OF GTJFN + TRZN FF,FRARG ;:ET - GET FROM TTY IN ECHO AREA + TLZA A,-1 + HRLZ A,C ;ANY ARGUMENT IS THE GTJFN FLAGS + TLO A,(GJ%FLG) ;RETURN FLAGS AS WELL + SETZ B, ;NO STRING + MOVE C,[.PRIIN,,.PRIOU] ;FROM TTY: + MOVE D,ETMODE ;WITH FS :ET MODE MASK OF DEFAULTS TO USE + CALL FF4 + JRST [CALL FFRRT1 ;RESTORE TTY MODE FIRST + JRST OPNER2] ;THEN REPORT ERROR + PUSH P,A ;SAVE JFN + CALL FFSET ;SET UP DEFAULTS FROM IT + ANDI A,-1 + RLJFN ;FLUSH REAL JFN + JFCL + POP P,A ;GET BACK JFN FLAGS + TLNE A,(GJ%UHV\GJ%NHV) ;IF THE VERSION CAME FROM GTJFN NOT THE USER, + SETZM DEFFN3 ;SETUP VERSION NUMBER DEFAULT RIGHT + TLNN A,(GJ%VER) ;IF VERSION NUMBER HAD WILDCARDS + JRST FFRRT1 + HRROI B,-3 + MOVEM B,DEFFN3 ;SET IT TO DEFAULT RIGHT +FFRRT1: SETZM IMQUIT ;NO MORE ^G AFTER THIS + MOVE B,SAVMOD ;RESTORE TTY MODE AFTER GTJFN +FFRRT2: MOVEI A,.PRIOU + SFMOD + SETZM SAVMOD ;AND NO MODE TO RESTORE + MOVEI A,VT100I + CAME A,RGETTY + RET + HRROI A,[ASCIZ "<[?2l"] ;] ;BACK INTO VT52 MODE FOR VT100 + PSOUT + RET + +;SET UP FILENAME DEFAULTS FROM A JFN IN 1 +ROUNMS: MOVEI E,ROUDEV ;GIVE FILENAMES FOR LAST REAL OUTPUT FILE + JRST FFSET1 + +RREDGN: SKIPA E,[ERDEV] ;FOR LAST READ FILE +FFSET: MOVEI E,DEFDEV ;FOR CURRENT DEFAULTS +FFSET1: SETZM (E) + MOVSI C,(E) + HRRI C,1(E) + BLT C,ERDEV-1-DEFDEV(E) ;ZERO OUT BLOCK FIRST + SAVE A ;SAVE JFN TO SET THEM FROM + ANDI A,-1 + MOVE B,[1,,.FBGEN] + MOVEI C,C + GTFDB + ERJMP FFSET2 ;FAILED, LEAVE AT 0 + HLRZM C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER +FFSET2: MOVE B,(P) +JS%FN1==JS%NAM +JS%FN2==JS%TYP +IRPS STR,,[DEV DIR FN1 FN2] + HRROI A,DEF!STR-DEFDEV(E) + MOVSI C,(JS%!STR)&101100 + JFNS +TERMIN + JRST POPAJ +FFSET3: MOVEI E,DEFDEV ;SETUP DEFAULTS + SAVE A + JRST FFSET2 + +FSIFIL: SKIPA E,[ERDEV] ;DESCRIBE INPUT FILE +FSOFIL: MOVEI E,ROUDEV ;DESCRIBE LAST OUTPUT FILE + AOSA (P) +FSDFRD: MOVEI E,DEFDEV ;DESCRIBE DEFAULTS + SAVE C + MOVEI C,140. ;BE SURE LONG ENOUGH + CALL QOPEN + CALL FSDFR1 +FSDFRT: CALL QCLOSV ;CLOSE UP Q REG SPACE AND GIVE STRING + JRST POPCJ + +;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E +FSDFR1: +;PRODUCE STRING OF DEFAULTS CONTAINED IN BLOCK POINTED TO BY E +FSDFR1: MOVEI A,DEFDEV-DEFDEV(E) + CALL ASCIND ;DEVICE + MOVEI CH,": + LDB A,[350705,,DEFDEV-DEFDEV] + SKIPE A ;NO USELESS PUNCTUATION. + CALL @LISTF5 + LDB A,[350705,,DEFDIR-DEFDEV] ;IS THERE A DIRECTORY TO BE MENTIONED? + JUMPE A,FSDFR2 + MOVEI CH,"< + CALL @LISTF5 + MOVEI A,DEFDIR-DEFDEV(E) ;DIRECTORY + CALL ASCIND + MOVEI CH,"> + CALL @LISTF5 +FSDFR2: MOVEI A,DEFFN1-DEFDEV(E) ;NAME + CALL ASCIND + MOVEI CH,". + CALL @LISTF5 + MOVEI A,DEFFN2-DEFDEV(E) ;EXTENSION + CALL ASCIND +IFN 10X,MOVEI CH,"; +.ELSE MOVEI CH,". + CALL @LISTF5 + HRRE C,DEFFN3-DEFDEV(E) ;GENERATION NUMBER + JRST DPT + +;FILE COPY +FCOPY: CALL FRDOLD ;GET FIRST FILENAME + MOVE B,[7_30.+OF%RD] ;OPEN FOR 7 BIT READ + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SAVE A + CALL FRDFOU ;GET SECOND ONE + JRST OPNER1 + MOVE B,[7_30.+OF%WR] + MOVEM A,OPNJFN + OPENF + JRST [ POP P,A + RLJFN + JFCL + JRST OPNER0 + ] + TRNN FF,FRCLN ;: E_ XFER INPUT FILE DATES TOO + JRST FCOPY2 + EXCH A,(P) ;INPUT FILE +IFN 20X,[ + MOVEI B,T + MOVEI C,1 + RFTAD + EXCH A,(P) + SFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,C + GTFDB + EXCH A,(P) + HRLI A,.FBWRT + SETO B, + CHFDB + ANDI A,-1 +] +FCOPY2: EXCH A,(P) ;GET INPUT FILE + MOVE B,[440700,,GCTAB] + MOVNI C,GCTBL*5 + SIN + ADDI C,GCTBL*5 ;GET NUMBER OF WORDS REALLY TRANSFERED + JUMPE C,FCOPY4 ;NONE, EOF + MOVN C,C + MOVE B,[440700,,GCTAB] + EXCH A,(P) ;OUTPUT FILE + SOUT + JRST FCOPY2 +FCOPY4: CLOSF ;CLOSE INPUT FILE + JFCL + REST A ;FILE JUST WRITTEN + CLOSF + JFCL + JRST DELQIT + +;OPEN INPUT FILE AND BIGPRINT NAME ON OUTPUT DEVICE +BPNTRD: CALL .OPNRD + TRZ FF,FRARG + JRST .FNPNT + +;OPEN FILE FOR READ +.OPNRD: CALL FRDOLD + TLZN FF,FLIN ;JUST IN CASE + JRST RRED2 + EXCH A,CHFILI + CLOSF + JFCL + SKIPA A,CHFILI +RRED2: MOVEM A,CHFILI +IFN 20X,MOVE B,[36._30.+OF%RD] +IFN 10X,MOVE B,[36._30.+OF%RD+OF%EX] ;THIS IS THE BIGGEST CROCK + TRZE FF,FRARG2 ;PRE-COMMA ARG MEANS DON'T UPDATE REFERENCE DATES + TRO B,OF%PDT + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + SETZM PAGENU + SETOM LASTPA + CALL RREDGN ;SET UP REAL FILENAMES OF INPUT FILE + +;HERE TO ACTUALLY START READING FROM IT +RRED1: TLO FF,FLIN + MOVEI CH,EOFCHR + DPB CH,[350700,,UTIBE] + MOVE CH,[010700,,UTIBE-1] + MOVEM CH,UTYIP + AOJ CH, + HRRM CH,UTRLDT + RET + +; I/O PDL COMMANDS +;E[ - PUSH INPUT JFN AND STATE +PSHIC: TLZ FF,FLDIRDPY + TLNN FF,FLIN ;ANYTHING OPEN NOW? + JRST PSHIC2 + MOVE A,CHFILI ;GET CURRENT POSITION + RFPTR + TYPRE [NRA] + MOVE C,UTYIP ;GET CURRENT POINTER + IBP C ;FIGURE HOW MANY WORDS WE HAVENT USED + MOVEI T,(C) + SUB T,UTRLDT + HRREI T,(T) + JUMPE T,PSHIC2 + ADD B,T ;RESET BYTE POSITION BEFORE THEM + SFPTR + TYPRE [NRA] +PSHIC2: MOVE E,PAGENU ;SAVE PAGENU AND LASTPA + LSH E,1 + SUB E,LASTPA + LSH E,2 + TLNE FF,FLIN ;AND STATE OF FLIN + ADDI E,2 + HRRI C,1(E) + MOVE A,INIOP ;GET INPUT PDL POINTER + PUSH A,CHFILI ;PUSH JFN + PUSH A,C ;PUSH STATE THEREOF + MOVEM A,INIOP ;UPDATE PDL POINTER + TLZ FF,FLIN + SETZM CHFILI ;FORGET JFN + JRST UTLSTP ;SET TO SEE EOF + +;E] - POP INPUT JFN +POPIC: TLZ FF,FLDIRDPY + CALL UICLS ;CLOSE ANYTHING WE HAVE NOW + MOVE C,INIOP ;GET INPUT PDL POINTER + POP C,CH ;GET STATE FLAGS + LDB A,[020100,,CH] + MOVNM A,LASTPA ;STATE OF LASTPA + LDB A,[031700,,CH] + MOVEM A,PAGENU ;STATE OF PAGENU + POP C,A ;GET JFN + MOVEM C,INIOP ;UPDATE PDL POINTER + GTSTS + TLNE B,(GS%OPN) ;IS IT OPEN? + TRNN CH,2 ;AND WE THOUGHT ONE WAS TOO? + RET ;NO OR NO, FORGET IT + TLO FF,FLIN ;YES, SAY ONE IS NOW + MOVEM A,CHFILI ;STORE AWAY JFN + SAVE CH + CALL UTRLD2 ;GET A BUFFER FULL + REST CH + HRRI CH,UTIBUF + DBP7 CH + MOVEM CH,UTYIP ;UPDATE BUFFER POINTER + JRST RREDGN ;AND SET REAL FILENAMES + +;E\ - PUSH OUTPUT JFN +PSHOC: TLZ FF,FLDIRDPY + CALL FLSOUT ;FLUSH ANY CURRENT OUTPUT THRU + MOVE B,UTYOP ;GET POINTER TO OUTPUT BUFFER + IBP B + LDB A,[073500,,UTOBUF] + LSHC A,7 + MOVE C,OUTIOP ;GET OUTPUT PDL + PUSH C,CHFILO ;SAVE JFN + PUSH C,A ;SAVE STATE OF JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + TLZ FF,FLOUT ;SAY NO FILE TO WRITE ON NOW + RET + +;E^ - POP OUTPUT CHANNEL +POPOC: TLZ FF,FLDIRDPY\FLOUT ;PERHAPS NO FILE TO WRITE + MOVE C,OUTIOP ;GET OUTPUT PDL POINTER + POP C,CH ;GET STATE + POP C,A ;GET JFN + MOVEM C,OUTIOP ;UPDATE PDL POINTER + GTSTS + TLNN B,(GS%OPN) ;FILE NOW OPEN? + RET ;NO, DONE THEN + MOVEM A,CHFILO ;YES, UPDATE BUFFER POINTERS + MOVEM CH,UTOBUF + MOVE C,[000700,,UTOBUF] + DPB CH,[350700,,C] + DBP7 C + MOVEM C,UTYOP + ANDI CH,177 + IDIVI CH,7_1 + ADDI CH,*5-4 + MOVNM CH,UTYOCT ;AND COUNT OF REMAINING BYTES + TLO FF,FLOUT ;SAY WE HAVE AN OUTPUT FILE NOW + RET + +EXITE: HRLOI C,377777 ;EE - WRITE OUT FILE AND CLOSE IT + TRO FF,FRARG + MOVE E,BEGV ;ANYTHING IN THE BUFFER? + CAMN E,ZV + SKIPE LASTPA ;OR THE INPUT FILE? + CALL PUNCHA ;YES, WRITE IT OUT THEN + CALL UICLS ;CLOSE ANY INPUT FILE + JRST EFCMD ;AND GO CLOSE AND RENAME OUTPUT FILE + +EXITX: TLNN FF,FLOUT ;IF NO OUTPUT FILE + CALL FFRRDD ;STILL READ AND SET DEFAULTS + TLNE FF,FLOUT ;IF HAVE AN OUTPUT FILE, + CALL EXITE ;FINISH IT UP +IFN 20X,[ + MOVE A,[.PRAST,,.FHSLF] ;SET THIS FORK + MOVEI B,[1 ;MAGIC FOR THE EXEC + 400740,,2 + 0] + MOVEI C,3 ;LENGTH + PRARG ;SET PROCESS ARG BLOCK +] +IFN 10X,[ ;THIS IS THE ONLY WAY TO GET BACK CCL FOR 10X +RUN==47000,,35 ;1050 UUO + MOVE A,[1,,[SIXBIT /SYS/ + SIXBIT /CCL/ + 0 ? 0 ? 0 ? 0]] + RUN A, ;SWAP IN CCL AND DO LAST COMMAND AGAIN + JFCL +] + JRST .EXIT ;AND QUIT BACK TO EXEC + +EFCMD: CALL FFRRDD ;GET FILE DEFAULTS FOR REAL OUTPUT +EFCMD1: TLNN FF,FLOUT ;MUST HAVE AN OUTPUT FILE + TYPRE [NDO] + TDZA A,A ;RESET COUNT OF FILLER BYTES +EFCMDA: CALL UTYO + MOVE CH,UTYOP + HRR CH,FILEPA ;PAD TO EVEN WORD WITH FILEPAD + TLNE CH,760000 + AOJA A,EFCMDA + PUSH P,A ;SAVE COUNT OF FILLER BYTES + CALL FLSOUT ;FLUSH OUT LAST OF BUFFER + MOVE A,CHFILO + RFPTR ;GET WHERE WE ARE + SETZ B, + IMULI B,5 ;INTO CHARS + SUBM B,(P) ;LESS FILLERS + TLO A,(CO%NRJ) ;CLOSE, BUT SAVE JFN + CLOSF + JFCL +IFN 10X,[ + HRRZS CH,A ;SAVE JFN + DVCHR + HRRI A,(CH) ;GET JFN BACK INTO RH + TLNE A,(DV%TYP) ;CHECK FOR DSK: + JRST EFCMD5 ;DO NOT ATTEMPT CHFDB IF NOT +] + HRLI A,.FBSIZ ;SET FILE SIZE + SETO B, + POP P,C ;TO NOT INCLUDE FILLERS + CHFDB + ERJMP EFCMD5 ;MAYBE ONLY WRITE ACCESS, NO FDB + HRLI A,.FBBYV ;AND SET BYTE SIZE + MOVSI B,(FB%BSZ) + MOVSI C,000700 ;TO BE 7-BIT + CHFDB +EFCMD5: MOVSI C,DEFDEV-ERDEV ;SEE IF FILENAME DEFAULTS HAVE CHANGED +EFCMD4: MOVE B,DEFDEV(C) + CAME B,ROUDEV(C) + JRST EFCMD3 ;DIFFERENT, MUST DO RENAME + AOBJN C,EFCMD4 + ANDI A,-1 ;GET JUST JFN +EFCMD2: CALL ROUNMS ;SET UP REAL NAMES OF OUTPUT FILE + RLJFN ;THRU WITH THE JFN + JFCL + TLZ FF,FLOUT ;NO MORE OUTPUT FILE + SETZM CHFILO + RET +EFCMD3: MOVSI A,(GJ%FOU) + CALL FF5 ;GET JFN FOR NEW NAME + JRST OPNER1 + MOVEI B,(A) + MOVE A,CHFILO ;RENAME OUTPUT FILE TO IT + RNAMF + JRST OPNER1 + MOVEI A,(B) + JRST EFCMD2 + +;EJ - LOAD IMPURE PORTIONS FROM FILE +;:EJ LOAD LIBRARY FILE INTO PURE STRING SPACE. +;^ EJ - WRITE OUT IMPURE PORTIONS IN A BOOTABLE FORMAT +;DUMP FILES CAN BE IDENTIFIED BECAUSE THEY HAVE 'TEC,,VERSION-NUMBER +;IN THE .FBUSW WORD IN THE FDB. + +EJCMD: TRZN FF,FRUPRW + JRST EJCMDR ;READ IN + TLZN FF,FLOUT ;^ EJ + TYPRE [NDO] ;MUST HAVE AN OUTPUT FILE ALREADY + MOVEM P,BOOTP ;SSAVE DOESNT SAVE AC'S + MOVE A,CHFILO + TLO A,(CO%NRJ) + CLOSF + JFCL ;CLOSE FAKE OUTPUT FILE + HRLI A,(DF%EXP) + DELF ;AND GET RID OF IT + JFCL + SETZM CHFILO ;DONT HAVE THIS SET IN THE DUMPED OUT FILE + SETZM FRKTAB + MOVE A,[FRKTAB,,FRKTAB+1] + BLT 1,FRKTAB+NFKS-1 ;FORGET ANY INFERIORS + CALL FRDFOU ;GET REAL OUTPUT FILE + JRST OPNER1 + CALL ROUNMS ;SET UP REAL OUTPUT NAMES + HRLI A,.FBUSW + SETO B, + MOVE C,[SIXBIT /TEC/+.FVERS] ;TO IDENTIFY A DUMP FILE + CHFDB + MOVE TT,[-<_-9>,,SS%CPY\SS%RD\SS%EXE+0] + MOVEM TT,BAKTAB ;LOW IMPURE + MOVE TT,QRWRT + ADDI TT,4 + IDIVI TT,5000 + SUBI TT,HIMPUR_-9 + MOVNI TT,1(TT) ;NEGATIVE OF NUMBER OF PAGES + HRLI TT,SS%CPY\SS%RD\SS%EXE+HIMPUR_-9 + MOVSM TT,BAKTAB+1 ;START OF HIGH IMPURE + MOVE B,BFRBOT + IDIVI B,5000 ;STARTING PAGE OF BUFFER SPACE + MOVE C,BFRTOP + IDIVI C,5000 + SUBM B,C ;-LENGTH + HRLI B,-1(C) ;- + TRO B,SS%CPY\SS%RD\SS%EXE + MOVEM B,BAKTAB+2 + HRLI A,.FHSLF + MOVEI B,BAKTAB + SETZB C,BAKTAB+3 + SETZM LIMPUR ;MAKE SURE THE EJ FILE LOADS TECPUR IF RUN + SSAVE ;SAVE THOSE IMPURE PAGES + SETOM LIMPUR + RET + +;INPUT VERSIONS +EJCMDR: CALL FRDOLD ;GET FILE + TRZN FF,FRCLN + JRST EJCMD2 ;EJ - MAP IN IMPURE AREAS + MOVE B,[36._30.+OF%RD] + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SIZEF + TYPRE [URK] ;SOME SORT OF ERROR HERE + ASH C,-1 ;CONVERT PAGES TO BLOCKS + MOVNI B,(C) + ADD B,LHIPAG ;WITHIN RANGE? + CAMG B,MEMT ;LEAVE AT LEAST ONE BLANK PAGE ABOVE BUFFER SPACE. + CALL [ CALL FLSCOR ;BUT SEE IF THERE IS ANYTHING WASTED WE CAN FLUSH + CAMG B,MEMT ;BEFORE DECIDING IT'S FATAL. + TYPRE [URK] + RET] + MOVEM B,LHIPAG ;UPDATE BOTTOM PAGE + ASHC B,1 ;CONVERT BACK TO BLOCKS + HRLI B,.FHSLF + HRLZS A ;JFN + HRLI C,(PM%CNT\PM%RD) +IFN 10X,[ + MOVEI D,(C) + PMAP ;10X - NO MULTIPLE PMAP'S + SOJLE D,.+3 + AOJ A, + AOJA B,.-3 +] +.ELSE PMAP ;MAP IN THOSE PAGES + HLRZ A,A + CLOSF + JFCL + HRRZ A,LHIPAG ;RETURN POINTER + IMULI A,12000 + TLO A,400000 + JRST POPJ1 + +EJCMD2: MOVE B,[1,,.FBUSW] ;CHECK USER SETTABLE WORD + MOVEI C,C + GTFDB + CAME C,[SIXBIT /TEC/+.FVERS] ;A COMPATIBLE DUMP FILE? + TYPRE [AOR] ;NOPE + MOVE E,LHIPAG + MOVE T,MEMT + MOVE J,INITFL ;SAVE THESE GUYS + HRLI A,.FHSLF + GET ;THIS SHOULD ONLY HAVE IMPURE PAGES + MOVEM E,LHIPAG + MOVE B,D + HRROI A,DEFDIR + DIRST + JFCL + CAMLE T,MEMT + MOVEM T,MEMT + MOVEM J,INITFL + .I SAVCMX=CBMAX=1 ;RESTORE THEM + SETOM PJATY ;WE JUST LOADED INVALID HCDS, SO NEED ALL LINES REDISPLAYED. + JRST INIT ;RESTART OURSELVES + +;RENAME FILE 1 TO FILE 2 +RENAM: CALL FRDOLD ;GET FIRST FILE + SAVE A + CALL FRDFOU ;GET SECOND FILE + JRST OPNER1 + CALL IMMQIT + MOVEI B,(A) + REST A + RNAMF ;DO THE RENAME + JRST OPNER1 + MOVEI A,(B) + RLJFN + JFCL + JRST DELQIT + +;DELETE A FILE +DELE: CALL FRDOLD ;GET OLD FILE JFN + TRNE FF,FRUPRW ;@ED MEANS EXPUNGE THE FILE TOO. + HRLI A,(DF%EXP) + DELF ;DELETE IT + JRST OPNER1 +IFN 10X,[ + RLJFN ;ON TENEX, MUST GET RID OF JFN TOO. + JFCL +];10X + RET + +WWINIT: CALL FFRRDD ;EW - GET FILENAME DEFAULTS +EICMD: TRNE FF,FRUPRW ;^EW MEANS CAN OVERWRITE + TDZA A,A ;NO GTJFN FLAGS THEN + MOVSI A,(GJ%FOU) ;OTHERWISE USER OUTPUT DEFAULTS + CALL FF5 ;GET JFN FROM DEFAULTS + JRST OPNER1 + EXCH A,CHFILO + JUMPLE A,WWINI0 + TLO A,(CZ%ABT) ;GET RID OF ANY OLD FILE + CLOSF + JFCL +WWINI0: MOVE A,CHFILO + MOVE B,[36._30.+OF%WR] ;OPEN FOR WRITE + TRNE FF,FRUPRW ;AND IF IN OVERWRITE MODE, + TRO B,OF%RD ;READ TOO, SO FILE NOT CLOBBERED + CALL IMMQIT + MOVEM A,OPNJFN + OPENF + JRST OPNER0 + SETZM IMQUIT + TLO FF,FLOUT ;SAY WE HAVE ONE + MOVE CH,[DEFDEV,,ROUDEV] ;SAVE CURRENT FILENAME DEFAULTS + BLT CH,ROUDEV+ERDEV-DEFDEV-1 + MOVE CH,[010700,,UTOBUF-1] ;REINIT BUFFER POINTER + MOVEM CH,UTYOP + MOVNI CH,*5 + MOVEM CH,UTYOCT ;AND BUFFER COUNT + RET + +; DO MTOPR ON JFN FROM LH E, WITH ARGS IN C AND SARG +FSMTAP: HLRZS E + MOVE A,(E) + MOVE C,SARG + MTOPR + ERJMP OPNER1 + MOVE A,C ;ANY ARG RETURNED IN 3 + JRST POPJ1 + +; READ OR MODIFY FDB FOR INPUT FILE +FSIFDB: TRZN FF,FRARG + TYPRE [WNA] + TLNN FF,FLIN + TYPRE [NFI] + HLRZS E + MOVE A,(E) + MOVEI B,(C) ;FIRST WORD TO DO + HRLI B,1 ;ONE WORD + MOVEI C,D ;WHERE TO PUT IT + GTFDB + TRZN FF,FRARG2 ;WAS THERE A SECOND ARGUMENT? + JRST FSFDB2 ;NO, JUST RETURN OLD VALUE + HRLI A,(B) ;WORD TO CHANGE + MOVE C,SARG ;NEW VALUE + MOVE B,C + XOR B,D ;GENERATE MASK FOR NEW VALUES + CHFDB + ERJMP OPNER1 +FSFDB2: MOVE A,D + JRST CPOPJ1 + +;DIRECTORY DISPLAY COMMANDS +LISTF: CALL LSTFRD ;GET FILESPEC FROM FOLLOWING STRING +CNTRU1: CALL LSTFR2 ;USE DEFAULT (DEV:*.*.*) + CALL VBDACU ;SEE IF THERE IS ANY COMMAND WAITING + RET ;RETURN RIGHT AWAY + SETZ CH, + CALL DISINI ;INIT DISPLAY + MOVEI OUT,CHCT ;TYPE OUT + JRST LISTF1 + +LISTFM: MOVEI OUT,TYOM ;TYPE INTO MEMORY + TRNE CH,20 ;EZ? + CALL LSTFRD ;YES, READ FROM USER + CALL LSTFR2 ;NO, USE DEFAULTS +LISTF1: SAVE A ;SAVE THE JFN + TLZ FF,FLDIRDPY ;DONT NEED IT AGAIN + HRRM OUT,LISTF5 + +LISTF2: HRROI A,BAKTAB ;INTO FREE SPACE + HRRZ B,(P) + TRNE FF,FRARG ;USE USERS FORMAT IF AN ARGUMENT OF IT + SKIPA C,NUM + MOVE C,[1_27.+1_24.+1_21.+JS%SIZ+JS%LWR+JS%LRD+JS%PSD+JS%PAF] + JFNS ;ALONG WITH SIZE AND READ AND WRITE DATES + TRNE FF,FRARG2 ;WHAT ABOUT 'GIVE AUTHOR' ARG? + JRST LISTFE ;ANY ARG MEANS DON'T GIVE AUTHOR + MOVEI CH,", + IDPB CH,A + EXCH A,B +IFN 20X,[ + HRLI A,.GFLWR ;AND THE LAST WRITER TOO + GFUST + ERJMP [DBP7 B ;DON'T LEAVE TRAILING COMMA + JRST .+1] + EXCH A,B +] +IFN 10X,[ + SAVE A + SAVE B + MOVE B,[1,,.FBUSE] ;LAST USER WHO WROTE + MOVEI C,2 ;PUT DIRECTORY NUMBER IN B + GTFDB + REST A + HLRZ B,B ;MAKE IT ACCEPTABLE + DIRST ;PUT DIRECTORY NUMBER THERE + ERJMP [DBP7 A + JRST .+1] + REST B +] + +LISTFE: MOVEI CH,^M ;AND A CRLF + IDPB CH,A + MOVEI CH,^J + IDPB CH,A + MOVEI CH,^@ + IDPB CH,A ;END WITH NULL + + HRRZ OUT,LISTF5 ;GET WHERE IT GOES + CAIN OUT,TYOM ;INTO MEMORY? + JRST LISTF8 ;YES, DO IT FAST THEN + MOVEI A,BAKTAB ;START OF WHERE STRING IS + CALL ASCIND ;TYPE THIS LINE OUT + SKIPL MORFLF ;--MORE-- FLUSHED? + JRST LISTF3 ;NO + POP P,A ;GET BACK JFN + RLJFN ;GET RID OF IT + JFCL + JRST LISTF7 ;DONE + + +LISTF8: MOVEI C,-BAKTAB(A) ;NUMBER OF WORDS + IMULI C,5 + LSH A,-30. + HRREI A,-36.+7(A) ;NULL DOESNT COUNT + IDIVI A,7 + SUB C,A ;GET TOTAL NUMBER OF CHARS USED + CALL SLPGET ;MAKE THAT MUCH ROOM + MOVE A,[440700,,BAKTAB] +LISTF6: ILDB CH,A ;INSERT GIVEN NUMBER OF CHARACTERS + IDPB CH,BP + SOJG C,LISTF6 + +LISTF3: MOVE A,(P) ;GET BACK MULTI JFN + GNJFN ;GET NEXT FILE + CAIA ;NONE LEFT + JRST LISTF2 ;TAKE CARE OF IT TOO + POP P,A ;FLUSH JFN +LISTF7: HRRZ A,LISTF5 ;IF GOING TO DISPLAY AREA, + CAIN A,CHCT + JRST DISCLG ;FINISH UP DISPLAY + RET + +LSTFRD: AOSA (P) ;GET A FILENAME FROM THE USER +LSTFR2: TLZA FF,FRNOT ;GET JUST DEFAULTS + TLO FF,FRNOT + SAVE DEFFN1 ;TEMPROARILY USE *.* + SAVE DEFFN2 + SAVE DEFFN3 + MOVSI A,() + MOVEM A,DEFFN1 ;SET THEM UP + MOVEM A,DEFFN2 + MOVEI A,-3 ;AND .* + HRRM A,DEFFN3 + MOVSI A,(GJ%IFG\GJ%OLD) ;ALLOW MULTIPLE INPUT FILESPECS + TLNE FF,FRNOT ;READING FROM STRING? + JRST LSTFR4 ;YES, GET IT +IFN 10X,HRROI B,[ASCIZ /*.*;*/] +.ELSE HRROI B,[ASCIZ /*.*.*/] ;DEFAULT STRING IF NOT FOM USER +LSTFR5: CALL FF5A + JRST OPNER1 +LSTFR3: REST DEFFN3 + REST DEFFN2 + REST DEFFN1 + RET +LSTFR4: CALL FFRRDD ;READ FILESPEC STRING + JRST LSTFR5 + +IFN 0,%%TNX.: +] ;END IFN TNX CONDITIONAL + +;FS DFILE$ -- THE DEFAULT FILE NAMES, AS A STRING. CAN BE READ OR SET. +FSDFILE:CALL FSDFRD ;FIRST GET VALUE TO RETURN FROM OLD FILENAMES. + TRZN FF,FRARG ;IF HAVE ARG, SET FILENAMES TO IT BY INSERTING IT + JRST POPJ1 ;INTO AN ET COMMAND. + JSP T,GCPUSA ;MEANWHILE, KEEP VALUE WHERE IT WILL BE RELOCATED. + MOVEI A,[ASCIZ /[0 U0 ET0 ]0/] + CALL MACXCP + JRST GCPOPV + +;HERE TO MACRO STRING PTR OR ASCIZ ADDR IN A, WITH ARG IN C, SAVING CURRENT VALUE STATUS. +MACXCP: JSP T,OPEN1 + JUMPGE A,.+3 ;IF ITS A POINTER, NOT AN ASCIZ STRING, THEN + CALL QLGET0 ;IF NOT GOOD STRING POINTER, GET ERROR NOW, BECAUSE PAST RRMAC5 + TYPRE [QNS] ;WE WILL NOT BE IN SAFE STATE FOR GETTING ERRORS. + MOVEM C,NUM + CALL [ SKIPE RREBEG ;IF ^R IS DOING THIS, MUST CALL MACRO USING RRMAC. + JRST MACXQW ;SO THAT TECO KNOWS WE ARE LEAVING ^R. + JRST RRMAC5] + TRZ FF,FRARG\FRARG2\FRCLN\FRUPRW\FROP\FRSYL + HRROI T,CPOPJ + JRST CLOSE2 + +SUBTTL OUTPUT ROUTINES THAT USE LISTF5 + +;COME HERE FOR DPT OF NEGATIVE NUMBER. +DPT2: CAMN C,[SETZ] ;CAN'T NEGATE THIS! MUST WORK SPECIALLY + JRST DPTMNF + MOVNS C ;OTHERWISE PRINT THE MAGNITUDE, PRECEDED BY A "-". + TLO FF,FLNEG +RDPT: SOJA TT,DPT6 + +DPT: TDZA TT,TT ;DECIMAL PRINT, NO LEADING ZEROS. +SLDPT: MOVEI TT,2 ;DECIMAL PRINT, WITH AT LEAST 3 POSITIONS USED. +DPT1: JUMPL C,DPT2 +DPT6: MOVE D,QRB.. + MOVM CH,.QBASE(D) + SOJLE CH,[ + MOVEI C,10. ;IF ..E HOLDS 0, 1 OR -1, REPLACE BY 10. + MOVEM C,.QBASE(D) + TYPRE [..E]] + IDIV C,.QBASE(D) +DPT8: HRLM D,(P) + JUMPGE D,DPT7 ;HANDLE NEGATIVE REMAINDER (IMPLIES NEG. RADIX). + MOVE D,QRB.. + HRLZ D,.QBASE(D) + MOVNS D + ADDM D,(P) + AOS C +DPT7: SKIPE C + CALL RDPT + TLZE FF,FLNEG + SAVE ["--"0,,DPT3] +DPT3: JUMPLE TT,DPT4 + XCT DPT5 + PUSHJ P,@LISTF5 + SOJG TT,.-1 +DPT4: HLRE CH,(P) +DGPT: ADDI CH,"0 + CAILE CH,"9 ;FOR "DIGITS" ABOVE 9, USE LETTERS. + ADDI CH,"A-"9-1 + JRST @LISTF5 + +DPTMNF: MOVE D,QRB.. ;HANDLE PRINTING OF 400000,, + MOVE D,.QBASE(D) + CAIE D,8 ;PRINT IT WITH A "-" SIGN, EXCEPT IN OCTAL. + TLO FF,FLNEG + SAVE D + LSHC C,-35. ;NOTE LOW BIT OF E IS 0, SINCE QRB.. ISN'T TOO BIG. + DIV C,(P) + SUB P,[1,,1] + JRST DPT8 + +;= PRINTS . +;,= PRINTS ,. +;,= PRINTS ,. +;^ => PRINT IN ECHO AREA. : => OMIT THE . +PRNT: ARGDFL ;-= MEANS -1=. + TRNN FF,FRARG+FRARG2 + TYPRE [WNA] + TRNN FF,FRARG2 + JRST PRNT2 + EXCH C,E ;= WITH 2 ARGS: + CALL PRNT3 ;PRINT THE 1ST ARG, + MOVEI CH,", + CALL @LISTF5 ;A COMMA, + EXCH C,E ;AND THE SECOND ARG. + TRNE FF,FRARG +PRNT2: PUSHJ P,PRNT3 + TRNN FF,FRUPRW + SAVE [DISFLS] ;IF ORDINARY TYPEOUT, MUST FORCE IT OUT WHEN DONE. + TRNE FF,FRCLN + RET + JRST CRR1 + +PRNT3: MOVEI A,TYO + TRNE FF,FRUPRW + MOVEI A,FSECO2 + HRRM A,LISTF5 + JRST DPT + +CRR: MOVEI CH,TYO + HRRM CH,LISTF5 + PUSHJ P,CRR1 + JRST DISFLS + +CRR1: MOVEI CH,15 + PUSHJ P,@LISTF5 + MOVEI CH,12 + JRST @LISTF5 + +CTLQM: SKIPA CH,[^Q] +SPSP: MOVEI CH,40 + JRST @LISTF5 + +FORMF: MOVEI CH,^M + CALL @LISTF5 + MOVEI CH,^L + JRST @LISTF5 + +IFN ITS,[ +LFILE: MOVE A,DEFDIR + MOVEI C,"; + PUSHJ P,SIXINT + MOVE A,DEFDEV + MOVEI C,": + PUSHJ P,SIXINT + MOVE A,DEFFN1 + MOVEI C,40 + PUSHJ P,SIXINT + MOVE A,DEFFN2 +] ;IFN ITS + +;OUTPUT A WORD OF SIXBIT, WITH ^Q'S AS NEC. SO TECO CAN READ BACK IN AS FILENAME. +SIXIN1: JUMPE A,CPOPJ + MOVEI B,0 + ROTC A,6 +IFN ITS,[ + JUMPE B,SIXIN2 + CAIE B,': + CAIN B,'; +SIXIN2: PUSHJ P,CTLQM +] + MOVEI CH,40(B) + PUSHJ P,@LISTF5 + JRST SIXIN1 + +SIXINT: PUSHJ P,SIXIN1 ;INSERT IN THE BUFFER THE SIXBIT WORD IN A + MOVE CH,C ;AND THE ASCII CHAR IN C + JRST @LISTF5 + +SIXINS: PUSHJ P,SIXIN1 + JRST CRR1 ;END WITH CRLF + +;OUTPUT ASCIZ STRING <- A, THRU LISTF5. +ASCIND: HRLI A,BP7 ;GET BP TO STRING. +ASCIN1: ILDB CH,A + JUMPE CH,CPOPJ + XCT LISTF5 + JRST ASCIN1 + +SIXNTY: PUSH P,OUT + MOVE OUT,E +SIXNT1: SETZ CH, + ROTC OUT,6 + ADDI CH,40 + CALL @LISTF5 + JUMPN OUT,SIXNT1 + REST OUT + POPJ P, + +TYPR: MOVEI IN,6 +TYPR3: MOVE OUT,[(600)E-1] + ILDB CH,OUT + ADDI CH,40 + XCT LISTF5 + SOJG IN,.-3 +TYPR2A: POPJ P,LISTF4 + +SLTAB: LISTF4: + MOVEI CH,^I + JRST @LISTF5 + +SUBTTL TERMINAL I/O FS FLAGS + +;FS LISTEN$ - RETURN NONZERO IFF INPUT IS AVAILABLE. +;IF NONZERO ARG, THEN IF NO INPUT AVAILABLE PRINT IT AS ASCII CHAR IN ECHO AREA. +FSLISN: SKIPN TYISRC + SKIPL A,UNRCHC ;RETURN -1 IF INPUT IS AVAILABLE FROM ANY SOURCE. + JRST POPJ1 + LISTEN A + JUMPG A,NRETM1 + TRZE FF,FRARG ;OTHERWISE, IF THERE'S AN ARG, + SKIPN RGETTY + JRST POPJ1 + AOS (P) + JRST FSECOT ;TYPE IT IN ECHO MODE (ON DISPLAYS ONLY) + +IFN ITS,[ +;FS MP DISPLAY$ - OUTPUT CHARACTER OR STRING TO M.P. AREA IN DISPLAY MODE. +FSMPDS: SKIPGE CH,C + JSP CH,FSMPD1 + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJDIS] + .LOSE %LSFIL + RET +] + +;TO HANDLE A STRING BY LOOPING OVER THE CHARACTERS, OR HANDLE A SINGLE CHARACTER, DO +; SKIPGE CH,C +; JSP CH,FSMPD1 +; ... HANDLE ONE CHARACTER IN CH. +FSMPD1: HRRM CH,LISTF5 + SETO D, + JRST FGCMD1 + +;FS ECHO DISPLAY$ - OUTPUT CHAR OR STRING IN DISPLAY MODE (^P IS SPECIAL) TO THE ECHO AREA. +;ARG IN C; CLOBBERS CH. +FSECDS: SKIPGE CH,NELNS + SETCM CH,NELNS + JUMPE CH,CPOPJ ;DO NOTHING IF THERE'S NO ECHO AREA. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPGE CH,C + JRST [ JSP CH,FSMPD1 ;IF ARG IS A STRING, TYPE THE CHARS IN IT. + CAIN CH,^M ;FSMPD1 CALLS BACK HERE WITH SUCCESSIVE CHARS. + JRST FSECD2 ;BUT IN A STRING, CR SHOULD COME OUT AS A STRAY CR, NOT CRLF. + JRST .+1] +IFN ITS,.IOT CHECDS,CH +IFN TNX,CALL ECHODP ;OUTPUT ^P CODE IN ECHO AREA + JRST FSECO5 + +IFN TNX,FSMPDS: ;CLOSEST WE CAN COME - NOTHING SHOULD DO IT ANYWAY +FSIMAG: SKIPGE CH,C ;FS IMAGE OUT$ - OUTPUT CHARACTER OR STRING IN SUPER-IMAGE MODE. + JSP CH,FSMPD1 ;IF IT'S A STRING, CALL .+1 FOR EACH CHARACTER. +IFN ITS,.IOT CHSIO,CH +IFN TNX,[ + MOVEI A,(CH) + PBOUT +] + JRST FSECO6 + +;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS STRAY CR. +FSECO2: CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + SKIPN RGETTY ;ON PRINTING TTY, MUST TYPE USING NORMAL MECHANISM; OTHERWISE + JRST TYO ;CHCTHP WOULD NOT BE UPDATED AND SPURIOUS CONTINUATIONS WOULD HAPPEN + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +FSECD2: +IFN ITS,[ + SYSCAL IOT,[%CLIMM,,CHECHO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +IFN TNX,CALL ECHOC0 ;OUTPUT CHARACTER IN ECHO AREA + JRST FSECO5 + +;FS ECHO OUT - OUTPUT ARG IN ECHO MODE (WRITE-ONLY) +FSECOT: MOVE CH,C ;OUTPUT CHAR TO ECHO AREA; ^M COMES OUT AS CRLF. +;INTERNAL ENTRY POINT WITH CHARACTER IN CH. THIS MUST PRESERVE ALL ACS EXCEPT CH AND Q. +FSECO1: SKIPN RGETTY ;ON PRINTING TTY, WE WILL USE NORMAL TYPEOUT, WHICH MEANS + SAVE [DISFLS] ;THAT AFTERWARD WE MUST FORCE IT OUT. + CALL FSECO7 ;IF PJATY SET, CLEAR SCREEN NOW SO DON'T LOSE ECHO AREA TYPEOUT. + JUMPL CH,[ ;IF ARG IS A STRING, TYPE OUT ALL ITS CHARACTERS. + CALL SAVACS + SAVE [RSTACS] + MOVE C,CH + JSP CH,FSMPD1 + JRST FSECO2] ;USE FSECO2 SO CR COMES OUT A A STRAY CR. + SKIPN RGETTY + JRST [ CAIN CH,^M + JRST CRR + JRST TYO] + SKIPE RUBENC ;IF PREVIOUS COMMAND WANTED A CHAR TYPED BY US, TYPE IT. + CALL RUBEND +FSECOR: +IFN ITS,.IOT CHECHO,CH ;ARG IS CHAR IN CH; OUTPUT IN ECHO MODE. +IFN TNX,CALL ECHOCH +FSECO5: SKIPG ECHACT + SETOM ECHACT ;MAKE SURE ECHO AREA IS CLEARED. +FSECO6: SETOM RROVPO ;IN CASE IN ^R MODE, + SETOM RROHPO ;MAKE SURE CURSOR GETS REPOSITIONED. + SETOM ECHCHR + RET + +FSECO7: AOSE PJATY ;CLEAR SCREEN IF IT SAYS IT NEEDS TO BE CLEARED SOON. + RET + CALL CTLL1 + SETOM RRMSNG ;MAKE SURE ^R REDISPLAYS EVERYTHING NEXT TIME. + JRST RRLRDS + +SUBTTL TERMINAL OUTPUT COMMANDS + +;FV$ -- DISPLAY +FVIEW: TROE FF,FRCLN ;:FV DOESN'T START AT TOP OF SCREEN. + JRST FVIEW1 ;AND IT DOES TYPEOUT INSTEAD OF DISPLAY. + CALL DISINI + JRST FVIEW1 + +;FT$ -- TYPE +FTYPE: TRNE FF,FRUPRW ;^ FT TYPES STRING IN ECHO AREA. + JRST [ CALL IMMQIT + TRNN FF,FRCLN ;^:FT DOES DOES SO ONLY IF NO INPUT AVAILABLE. + JRST FTYECH + SKIPGE UNRCHC + SKIPE TYISRC + JRST FNOOP + LISTEN A + JUMPE A,FTYECH + JRST FNOOP] ;THERE'S INPUT; IGNORE STRING INSTEAD TYPING IT. + TRZE FF,FRCLN ;:FT STARTS AT TOP OF SCREEN. + SETOM TYOFLG + CALL DISINT +FVIEW1: MOVEI BP,CHCT + CALL IMMQIT +FTYLUP: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + CAIA + JRST FTEND +FTYCHR: ANDI CH,177 + CALL (BP) + JRST FTYLUP + +FTEND: CALL DELQIT + TRNE FF,FRCLN + JRST DISCLG + SKIPGE TYOFLG + RET + JRST DISFLS + +FTYEC1: ANDI CH,-1 ;REMEMBER SUPRQUTED CHARS HAVE L.H. SET! + CALL [ CAIE CH,^M + CAIN CH,^J + JRST FSECO2 + JRST FSECO1] +FTYECH: CALL RCH + SKIPN SQUOTP + CAIE CH,33 + JRST FTYEC1 + CALL DELQIT + SKIPN RGETTY + JRST DISFLS + RET + +;V COMMAND, AND ALL VARIATIONS THEREOF. EXIT WITH JRST RET. +VIEW: TRZE FF,FRUPRW + JRST [ CALL VIEW1B ;"^ V" - DO APPRO. KIND OF DISPLAY + JRST VIEW1A] ;THEN CHECK FOR FOLLOWING W. + SKIPN RGETTY + JRST VIEW1A + PUSHJ P,DISINI + SETOM VREMEM ;TRY TO DISPLAY BFR AT SAME PLACE + PUSHJ P,GETARG + CALL CHK1A + MOVE A,E + SUB A,BEGV + SKIPGE A + SETO A, + MOVEM A,GEA + .I DISADP=PT+1 ;TELL DISAD WHERE TO PUT CURSOR. + MOVEI J,DISAD + PUSHJ P,TYPE1 +VIEW1: PUSHJ P,DISCLG +VIEW1A: MOVE T,CPTR + ILDB C,T + CAIE C,"W + CAIN C,"W+40 + SKIPN COMCNT + POPJ P, + CALL RCH ;FLUSH THE "W" OF "VW". + TRZ FF,FRARG2+FRARG+FRCLN + JRST FTYI ;READ IN CHAR, RETURN AS NUMBER. + +VIEW1B: SKIPE DISPRR ;"^ V": IN ^R MODE, DO A ^R-STYLE DISPLAY + JRST RRNOIN + JRST VIEW3A ;ELSE DO STANDARD DISPLAY. + +EUHACK: CALL FFRDEV ;E^U -- READ FILENAME, THEN DO + JRST CNTRLU ;WHATEVER DIR DISPLAY THE USER WANTS. + +;COME HERE FROM GO, AFTER THE END OF A COMMAND STRING +;(WHETHER IT ENDED SUCCESSFULLY OR NOT) +;DECIDE WHETHER AND HOW TO DISPLAY. +VIEW2: ANDCMI FF,FRCLN + TLZE FF,FLDIRDPY ;FRCLN _ FLDIRDPY +;^U COMMAND - DO USER'S SELECTED TYPE OF DIRECTORY DISPLAY. +CNTRLU: IORI FF,FRCLN + MOVE CH,QRB.. + TRNN FF,FRCLN + SKIPA A,.QBFDS(CH) ;FLDIRDPY WAS OFF, WE WANT BUFFER DISPLAY. + MOVE A,.QFDDS(CH) ;IT WAS ON, WE WANT DIR DISPLAY. + JUMPE A,VIEW3B ;USER HASN'T SUPPLIED MACRO: DO ^V OR :^V. + JRST MACXQ ;DO THE MACRO. + +TYPE: PUSHJ P,GETANU ;T COMMAND: DECODE ARGS. + MOVEI J,FSECO2 ;^ T TYPES IN ECHO AREA. + TRZN FF,FRUPRW +TYPE2: MOVEI J,TYO ;TYPE RANE IN E,C. +TYPE1: MOVE IN,E +TYPE3: SKIPN MORFLF + SKIPE STOPF + RET + CAML IN,C + JRST TYPE5 + PUSHJ P,GETINC + PUSHJ P,(J) + JRST TYPE3 + +TYPE5: CAIE J,TYO + SKIPN RGETTY + SKIPGE TYOFLG + POPJ P, + JRST DISFLS ;FORCE THE TYPEOUT OUT, IF THE M.P. AREA TYPEOUT MECHANISM WAS USED. + +SUBTTL BUFFER DISPLAY + +;COME HERE AFTER EACH CMD STRING, +;IF USER HAS NOT SUPPLIED A MACRO TO BE INVOKED. +VIEW3B: TRZ FF,FRARG + MOVE TT,QRB.. + SKIPE .QVWFL(TT) + POPJ P, ;DON'T DISPLAY IF CMDS IN STRING INHIBITED IT. + SKIPE RGETTY ;SHOULD WE EVER DISPLAY ON THIS TERMINAL + JRST VIEW3A + TRNN FF,FRCLN ;ELSE, ON PRINTING TTY, NO DISPLAY OF DIRS, + SKIPN TTMODE ;BUFFER DISPLAYED ONLY IN :^N MODE. + RET +VIEW3A: TRZE FF,FRCLN + JRST CNTRU1 + CALL VBDACU ;UPDATE TSALTC, SKIP IF OK TO DISPLAY. + POPJ P, +VBD: SETO A, + CALL VBDBLS ;MAKE SURE WE HAVE A VALID WINDOW (BLESS IT) + JRST VBDDIS ;THEN DISPLAY FROM THERE. + +VBDRR: SETO A, + CALL VBDBL1 ;HERE TO DISPLAY FOR ^R, WITH OUTPUT AND WINDOW SET UP. ON DISPLAYS ONLY! + MOVEM B,RRVPOS + JRST VBDDIS + +;A/ -1 => MAKE SURE THAT WE HAVE A VALID WINDOW. +;A/ VPOS => CHOOSE WINDOW TO PUT PT AT THAT VPOS. +VBDBLS: SETOM TYOFLG ;SINCE WE ARE SCREWING UP VPOS AND HPOS, TYPEOUT SHOULD REINIT. + MOVE C,NLINES + CALL WINSET +VBDBL1: SAVE %END + SAVE CHCTVS ;ON PRINTING TTY'S WE MUSTN'T CHANGE THE WINDOW SIZE FOR GOOD. + .I CHCTVS=BOTLIN ;BUT DURING BUFFER DISPLAY, RESTRICT TO # LINES. + CALL VBDRR2 ;CALCULATE NEW ABSOLUTE WINDOW ADDRESS IN A. + .I GEA=A-BEGV + REST CHCTVS + REST %END + RET + +VBDRR2: JUMPGE A,[ SETOM %END ;IF VPOS FOR PT SPEC'D EXPLICITLY, USE IT. + JRST VBDN5] ;ALSO TURN OFF MARGIN CHECKING FOR ZV. + SKIPE RGETTY ;NOT DATAPOINT => NO DESIRE TO DISPLAY FROM SAME PLACE. + SKIPGE IN,GEA ;OR NO OLD PLACE TO START FROM => + JRST VBDNEW ;START FROM SCRATCH. + ADD IN,BEGV ;TRY THE OLD START. + CAMLE IN,PT ;NO GOOD TO START AFTER POINTER. + JRST VBDNEW + JRST VBDTRY ;ELSE SEE IF OLD WINDOW STILL GOOD. + +;SET THE VARIABLES THAT DESCRIBE THE SIZE AND POSITION OF THE WINDOW +;AND THE MARGINS (REGIONS WHERE WE DON'T WANT THE POINTER TO BE); NAMELY, +;RRTOPM, RRBOTM, BOTLIN, AND VSIZE. +;C SHOULD CONTAIN NLINES (OR SOMETHING TO USE INSTEAD). +WINSET: SAVE D + SKIPGE C + SETZ C, ;NEGATIVE # LINES NOT ALLOWED. + SAVE J + SKIPL J,TOPLIN + CAML J,USZ + SETZM TOPLIN ;IF FS TOP LINE$ IS INVALID, SET IT TO 0 INSTEAD. + REST J + SKIPE C + ADD C,TOPLIN ;C HAS DESIRED LAST LINE (+1) TO USE, OR 0 FOR WHOLE SCREEN. + CAML C,USZ + SETZ C, ;CAN'T USE MORE LINES THAN WE HAVE. + SKIPN C + MOVE C,USZ ;NO SPECIFICATION, OR BAD SPEC, => USE TILL SCREEN BOTTOM. + CAIL C,MXNVLS ;IF THAT'S INFINITELY MANY LINES, USE 2 LINES. + MOVEI C,2 + MOVEM C,BOTLIN ;STORE DESIRED LAST LINE (+1) IN BOTLIN. + SUB C,TOPLIN + MOVEM C,VSIZE + IMUL C,%TOP ;COMPUTE MARGINS THAT CURSOR MUSN'T GO OUTSIDE. + IDIVI C,100. + ADD C,TOPLIN + MOVEM C,RRTOPM + MOVE C,VSIZE + IMUL C,%BOTTO + IDIVI C,100. + SUB C,BOTLIN + MOVNM C,RRBOTM + JRST POPDJ + +;TRY TO MAKE SURE TSALTC IS UP TO DATE. TSALTC CAN GET WRONG IF TTY IS +;RETURNED TO DDT AND IT THROWS AWAY ALL THE INPUT. +VBDACU: SKIPN TSALTC ;UPDATE TSALTC (IN CASE DDT HAS FLUSHED + SKIPE TSINAL ;THE $$'S THAT INT'D US) (SKIP IF ENDS UP 0) + CAIA + JRST POPJ1 + LISTEN CH, + JUMPN CH,CPOPJ + SETZM TSALTC ;NO INPUT CHARS WAITING => NO $$'S. + SETZM TSINAL ;AND NO STRAY $. + HRROS LTYICH + JRST POPJ1 + +;COME HERE TO SEE IF THE PREVIOUS WINDOW (ADDR IN IN) CAN BE REUSED (GEA > -1). +;IN THIS CASE, CAN GO TO VBDNEW IF THE WINDOW IS BAD, OR CAN RETURN WINDOW IN A. +;COME HERE FROM VBDNEW WITH A TENTATIVE WINDOW ADDRESS IN IN (WHICH MAY BE TOO +;CLOSE TO BEG) TO FIND A MORE PRECISE WINDOW (GEA = -1). +;IN THIS CASE, C HOLDS -, AND WE ALWAYS RETURN. +;WE ALWAYS RETURN THE NEW VPOS OF POINT IN B. +;WE SHOULD NEVER BE CALLED WITH A WINDOW THAT IS AFTER POINT. +VBDTRY: CALL CHCTI0 ;INIT VARIOUS TEMPS FOR TYPEOUT. + SETZ T, ;INITIAL HPOS IS 0 (VBDL UPDATES) + SETZM MORFLF ;THIS MIGHT HAVE STOPPED LAST VBDTRY. + CALL MEMTOP ;OUT GETS ADDR OF FREE STORAGE, + MOVE OUT,A ;FOR TABLE OF LINE-BEGINNING ADDRESSES. + MOVE A,IN ;A _ THE START WE'RE TRYING NOW. + CAMLE A,PT + .VALUE + CALL GETIBI ;BP IN BP TO FETCH CHARS TO TYPE, STARTING AT IN. + MOVEI TT,VBDL ;CALL VBDL TO "OUTPUT" A LINE. + MOVEM TT,CHCTAD + SETZB TT,CHCTBP ;TELL CHCT TO THROW AWAY CHARS. + HLLOM TT,DISBFC ;IT WILL NEVER FILL UP ITS INFINITE SINK. + MOVE TT,TOPLIN ;START "PRINTING" WHERE WE WILL LATER REALLY START PRINTING. + MOVEM TT,CHCTVP + ADD TT,OUT ;STORE BEGINNING OF 1ST LINE DISPLAYED AS 1ST CHAR DISPLAYED. + MOVEM IN,(OUT) +VBD0: CAMN IN,PT ;REACHED PT => + JRST VBDPT ;CHECK WHETHER THIS WINDOW IS OK. +VBDPT2: CAMN IN,ZV ;(COMES BACK IF CAN'T TELL YET, + ;NEAR END OF SCREEN BUT OK IF END OF BUFFER FITS) + JRST VBD3 ;AT END, SEE IF MADE IT ON TO SCREEN. + CAMN IN,GPT ;IF AT GAP, MOVE BP OVER IT. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 ;OUTPUT NEXT CHAR. + SKIPN MORFLF + JRST VBD0 + JRST VBDNEW ;OFF END OF SCREEN AND PT TOO LOW. + +VBD3: MOVE TT,CHCTVP ;REACHED ZV BEFORE FLUSHING, + CAMN TT,BOTLIN ;WINDOW OK IF ZV IS ON SCREEN ABOVE --MORE-- LINE + CAMN T,CHCTHP ;OR IF ZV IS ON IT BUT NO CHARS TYPED ON IT + CAIA + JRST VBDNEW + +;REACHED PT DURING VBD0 LOOP. +VBDPT: SKIPGE GEA ;CAME TO VBDTRY FROM VBDNEW => + JRST VBDDWN ;ZERO IN ON BEST WINDOW. + CAMN A,BEGV ;TRYING TO RE-USE WINDOW => + JRST VBDPT1 ;UNLESS WE STARTED AT START OF BUFFER, + MOVE TT,RRTOPM + CAMLE TT,CHCTVP ;SHOULDN'T HAVE PT < %TOP PERCENT OF SCREEN FROM TOP. + JRST VBDNEW +VBDPT1: MOVE B,CHCTVP ;MIGHT BE OK, REMRMBER # OF LINE WITH PT. + CAMN B,BOTLIN ;IF WE'RE ON THE --MORE-- LINE + CAMN T,CHCTHP ;WE'RE REALLY OFF BOTTOM, BAD WINDOW. + CAIA + JRST VBDNEW + CAML B,RRBOTM ;NOT IN LAST %BOTTOM PERCENT OF SCREEN OR + CAMN IN,ZV ;ALREADY AT BUFFER END => + RET ;CAN'T BE TO NEAR BOTTOM. IT'S GOOD; RETURN IT. + CALL DISBAR + JRST VBDPT2 ;ELSE SEE IF END OF BUFFER FITS ON SCREEN. + +;CHCT CALLS HERE WITH EACH LINE DURING VBDTRY. +;SETS UP THE LINE-BEGINNING ADDRESS ENTRY FOR THE LINE. +;LEAVES HORIZ POS. START OF NEXT LINE IN T. +VBDL: MOVE Q,CHCTVP + MOVE TT1,Q + ADD TT1,OUT + MOVE T,CHCTNL ;STORE ADDRESS OF 1ST CHAR ON LINE. + MOVEM T,1(TT1) + MOVE T,CHCTHP ;RETURN H.P. AFTER LINE. + MOVE TT1,GEA ;IF GOING TO GO TO VDBDWN, + AOJE TT1,CPOPJ ;MAKE SURE ALL THE LINE'S STARTS ARE STORED. + CAMN Q,BOTLIN ;AT BOTTOM OF SCREEN => + SETOM MORFLF ;STOP THE LOOP AT VBDTRY. + POPJ P, + +;START FROM SCRATCH, FIGURING OUT A NEW WINDOW. +;RETURN THE NEW WINDOW ADDRESS IN A, AND THE NEW VPOS OF POINT IN B. +VBDNEW: SKIPGE DISTRN + JRST VIEW2A ;IN TRUNCATE MODE, EVERYTHING EASIER. + MOVE A,VSIZE ;PRETEND WE'RE STARTING AT MIDDLE OF SCREEN. + IMUL A,%CENTER + IDIVI A,100. + SKIPGE A + SETZ A, + MOVE T,VSIZE + CAMG T,A + MOVEI A,-1(T) + ADD A,TOPLIN +;HERE FROM RREAR3; A HAS DESIRED VPOS OF PT. +VBDN5: SETOM GEA ;SO NEXT TIME REACH VBDPT WON'T COME HERE AGAIN. + CALL CHCTI0 + SETZM CHCTBP ;MAKE SURE WE DON'T TRY USING UP INFINITE AMOUNTS OF DISBUF. + MOVEM A,CHCTVP + SETZB T,MORFLF + MOVE BP,PT + CAMN BP,BEGV ;IF PT = BEGV, WINDOW MUST START AT BEGV. + JRST [ MOVE A,BP + MOVE B,TOPLIN + RET] + MOVEI C,CPOPJ ;TELL DISAD NOT TO DO ANYTHING WITH THE LINES IT CONSTRUCTS. + MOVEM C,CHCTAD + SAVE CHCTVP ;SAVE TOPLINE+#CENTER. + MOVE TT,VSIZE + IMUL TT,%END + JUMPL TT,VBDN6 + IDIVI TT,100. + SAVE TT ;REMEMBER #END (TOTAL*%END/100) + IMUL TT,NHLNS ;ARE WE WITHIN #END*WIDTH*2 CHARS OF END OF BUFFER? + LSH TT,1 + CAIL TT,1000. ;IF NOT FOR THIS, SMALL %END'S WOULD BE IGNORED UNLESS PT VERY NEAR Z. + MOVEI TT,1000. ;RATHER, THEY MEAN "PUT Z VERY NEAR SCREEN END, IF IT'S ON SCREEN AT ALL" + ADD TT,BP + CAMGE TT,ZV ;IF SO, DON'T LEAVE MORE THAN #END BLANK LINES AT BOTTOM. + JRST VBDN4 ;IF NOT, ASSUME WE WON'T LEAVE THEM & DON'T WASTE TIME. + CAMN BP,ZV ;WE'RE AT END OF BUFFER => + JRST [SOS IN,BP ;NEED FULL SCREEN ABOVE PT. + CALL GETCHR ;IF LAST CHAR ISN'T LF, + CAIE CH,^J ;MAKE SURE THE LAST UNTERMINATED LINE + AOS CHCTVP ;DOESN'T END UP OFF SCREEN BOTTOM. + JRST VBDN2] + CAMLE BP,GPT + ADD BP,EXTRAC + CALL GETIBP ;SEE HOW MANY LINESOF TEXT THERE ARE BETWEEN PT AND BUFFER END. + MOVE IN,PT + SKIPE RGETTY + SKIPE RREBEG + CALL DISBAR ;STARTING AT THE PTR SO MAKE CURSOR (EXCEPT IN ^R ON DISPLAY TTY). + MOVE E,BOTLIN ;IF WE GET DOWN TO VPOS = TOTAL-#END, WE CAN PUT CURSOR + SUB E,(P) ;AT THE USUAL PLACE (#CENTER), SO STOP COUNTING LINES. +VBDN1: CAMN IN,ZV + JRST VBDN2 ;ALL USED UP, SEE HOW MANY LINES THAT MADE. + CAMG E,CHCTVP + JRST VBDN4 + CAMN IN,GPT ;WHEN AT GAP, MOVE BP OVER GAP. + CALL FEQGAP + ILDB CH,BP + ADDI IN,1 + CALL DISAD2 + JRST VBDN1 + +VBDN2: MOVE C,CHCTVP ;REACHED END OF BFR WITHOUT REACHING VPOS = TOTAL-#END. + CAME T,CHCTHP ;MAYBE WE STARTED ANOTHER LINE NOT COUNTED IN VPOS. COUNT IT TOO + JRST [ CAME C,BOTLIN ;UNLESS IT'S REALLY OFF + AOS C ;BOTTOM OF SCREEN. + JRST .+1] + SUB C,A ;# LINES WE PRINTED IN VBDN1 LOOP. + ADD C,(P) ;PLUS MAX # BLANK LINES TO LEAVE BELOW THEM, + MOVNS C ;GIVES MAX # LINES WE CAN ALLOW BELOW PT. + ADD C,BOTLIN ;SUBTRACT FROM WINDOW BOTTOM TO GIVE MIN VPOS FOR PT. + MOVEM C,-1(P) ;(SMALLER THAN AND INSTEAD OF TOPLIN+#CENTER WHICH WE SAVED). +VBDN4: SUB P,[1,,1] ;NO LONGER NEED #END. +VBDN6: MOVNS C,(P) ;GET BACK #CENTER OR CORRECTED # OF LINES WE WANT ABOVE PT. + ADD C,TOPLIN ;-<# LINES NEEDED ABOVE PT> + CALL VBDN7 ;IN GETS PLACE WHERE THOSE LINES START. + REST C ;- . + JRST VBDTRY + +;RETURN IN IN THE CHAR ADDR OF A SPOT C(C) LINES UP FROM POINT. +;MORE PRECISELY, IT MUST BE AT LEAST C(C) SCREEN LINES UP, BUT MAY BE MORE, +;BUT SHOULDN'T BE TOO MUCH MORE FOR THE SAKE OF EFFICIENCY. +;LIKE DOING -@L BUT WITH CUTOFF IN CASE THERE ARE NO CRLFS IN THE BUFFER. +VBDN7: MOVE E,C ;FIND PLACE BACK FROM POINT FAR ENOUGH + SUBI E,2 ;TO FILL UP THAT MANY SCREEN LINES (PLUS 2) + IMUL E,NHLNS ;WITH JUST CONTINUATION LINES. + ADD E,PT + CAMGE E,BEGV ;THERE, OR BEGINNING OF BUFFER, IS WHERE WE CUT OFF. + MOVE E,BEGV + MOVE IN,PT ;NOW, LOOK BACK THAT MANY LINES FROM POINT, BUT NOT PAST THERE. +VBDN7L: SOS IN ;LOOP HERE OVER LINES. +VBDN7C: CAMGE IN,E ;LOOP HERE OVER CHARACTERS. + AOJA IN,CPOPJ + CALL GETCHR ;EXAMINE NEXT CHAR BACK FOR BEING A LF. + CAIE CH,^J + SOJA IN,VBDN7C + CAMN IN,E + RET + SUBI IN,1 ;IF SO, SEE IF WHAT PRECEDES IT IS A CR. + CALL GETINC + CAIE CH,^M + SOJA IN,VBDN7C + AOJLE C,VBDN7L ;IF SO, THAT'S ONE LINE DOWN. + AOJA IN,CPOPJ ;WHEN WE'VE GONE ENOUGH LINES, LEAVE IN -> CHAR AFTER THE LF. + +;COME HERE IN VBDTRY TO SEE WHETHER OUR GUESS FOR GEA WAS GOOD. +;IT'S NO GOOD IF POINT WOULD APPEAR FARTHER DOWN THE SCREEN THAN EXPECTED/ +;SINCE WE REMEMBERED WHERE IN THE BUFFER EACH SCREEN LINE STARTED, +;WE CAN IMMEDIATELY FIND THE CHARACTER THE RIGHT NUMBER OF LINES UP FROM POINT. +;C HAS THE NUMBER OF SCREEN LINES DESIRED ABOVE POINT. +VBDDWN: SAVE A + SAVE RRHPOS + SAVE RRVPOS ;FIRST WORRY ABOUT THINGS LIKE: + .I RRHPOS=CHCTHP + .I RRVPOS=CHCTVP + AOSN RRNCCR ;WHAT IF POINT IS RIGHT AFTER A CR? IN THAT CASE + CALL [ SOS PT ;THE CR HASN'T REALLY BEEN OUTPUT YET. + JRST RRFORW] ;SO ADJUST OUR SCREEN POSITION TO BE AFTER THE CR. + MOVE A,RRHPOS + CALL RRFOR3 ;ALSO, MAYBE THE NEXT CHARACTER WOULD CAUSE A CONTINUATION. + MOVE A,RRHPOS + MOVEM A,CHCTHP + MOVE A,RRVPOS ;ADJUST SCREEN POSITION FOR THAT, IF NECESSARY. + EXCH A,CHCTVP + ADD A,OUT ;IN CASE WE DO START A CONTINUATION LINE, + PUSH A,PT ;ENTER IN THE TABLE WHERE THAT CONTINUATION STARTS. + REST RRVPOS + REST RRHPOS + REST A + MOVN B,C + CAMLE B,CHCTVP + MOVE B,CHCTVP + ADD C,CHCTVP ;(C STILL HAD - # LINES WANTED ABOVE PTR) + JUMPLE C,CPOPJ ;NOT MORE THAN MAX, OK. + ADD C,TOPLIN + ADD C,OUT + MOVE A,(C) ;ELSE FIND 1ST CHAR ON THE LINE WE SHOULD START WITH. + RET + +;DISPLAY THE BUFFER STARTING AT THE WINDOW IN GEA. +VBDDIS: SAVE CHCTVS + SAVE [[ REST CHCTVS + RET]] + SAVE BOTLIN + CALL DISINI ;SET UP FOR DISPLAY. + REST BOTLIN ;DISINI RESETS BOTLIN IGNORING FS LINES, WHICH IS WRONG. + .I CHCTVS=BOTLIN + MOVE TT,QRB.. ;DISPLAY SHOULDN'T INHIBIT ANOTHER DISPLAY OF SAME STUFF. + SETZM .QVWFL(TT) + SETOM VREMEM + MOVE TT,TOPLIN + MOVEM TT,CHCTVP + MOVE IN,GEA + ADD IN,BEGV + MOVEM IN,LINBEG(TT) +VBDOK3: MOVEM IN,CHCTBL ;REMEMBER CHAR ADDR START OF 1ST LINE + ;(DISAD WILL SET CHCTBL FOR LATER LINES) + CALL GETIBI + SETZM MORNXT +VBDOK1: CAMN IN,ZV ;STOP IF NO MORE CHARS. + JRST DISCLG + MOVE TT,CHCTVP ;STOP IF PAST END OF SCREEN. + CAML TT,CHCTVS + CALL DISMOR ;DO IT VIA DISMOR SO WE RETURN TO ^R PROPERLY. + SKIPN MORFLF + SKIPGE ORESET ;STOP IF FLUSHED OR QUITTING. + JRST DISCLG + CAMN IN,PT ;OUTPUT THE CURSOR IF BEFORE PT. + CALL DISBAR + CAMN IN,GPT ;IF AT GAP, MOVE B.P. IN BP OVER IT. + CALL FEQGAP + MOVE TT,CHCTHP + CAME TT,NHLNS ;IF ABOUT TO CONTINUE A LINE + SKIPN DISBFC ;OR IF THE BUFFER IS FULL, + JRST VBDSLO ;OUTPUT 1 CHARACTER SLOWLY TO CONTINUE OR EMPTY THE BUFFER. + SKIPGE DISTRN + JRST VBDSLO + SKIPE CASDIS ;IF WE NEED CASE-FLAGGING, OR + JRST VBDSLO + SKIPL CHCTCF ;IF WE HAVE AN UNPROCESSED CR, + JRST VBDFAS ;MUST GO THRU DISAD SINCE ONLY DISAD KNOWS HOW TO HACK ONE. +VBDSLO: ILDB CH,BP + AOS IN +VBDSL1: .I RRCCHP=CHCTHP + CALL DISAD2 ;OUTPUT THE CHAR. + JRST VBDOK1 + +;IF WE GET HERE, WE KNOW WE CAN GO AT LEAST 1 CHAR BEFORE REACHING PT, GPT, ZV, +;THE RIGHT MARGIN, OR THE END OF DISBUF. +;A HAS THE HPOS TIMES 7, E HAS THE HASH CODE, BP HAS THE BP AND IN HAS THE CHAR ADDRESS. +;TT HAS THE HPOS TO STOP AT, TIMES 7. OUT HAS THE BP TO STOP AT. CH HOLDS THE CHAR. +VBDFAS: MOVE OUT,BP + MOVE BP,ZV ;CONSIDER PT, GPT AND ZV; BP GETS WHICHEVER IS SMALLEST + CAMGE IN,GPT + CAMG BP,GPT + CAIA + MOVE BP,GPT ;YET BEYOND WHERE IN IS NOW. + CAMGE IN,PT + CAMG BP,PT + CAIA + MOVE BP,PT + SOS BP ;CONVERT CHAR ADDR IN BP TO THE B.P. TO LDB THE PREVIOUS CHAR. + CALL GETIBV + IBP BP ;(GETIBV FOLLOWED BY IBP = GETBV). + EXCH OUT,BP + MOVE A,CHCTHP ;A GETS 7 TIMES THE HPOS. WE USE IT FOR SHIFTING FOR THE HASH CODE. + IMULI A,7 ;ALSO, TT GETS 7 TIMES THE LINE WIDTH AND THAT IS AN END TEST. + MOVE TT,NHLNS + IMULI TT,7 + MOVE E,CHCTHC ;E IS WHERE WE ACCUMULATE THE CHECKSUM. +VBDFLP: ILDB CH,BP + XCT VBDTBL(CH) ;FOR FUNNY CHARS, GO SOMEPLACE ELSE. +VBDNRM: IDPB CH,CHCTBP ;STORE CHAR INTO OUTPUT. + ROT CH,(A) + ADD E,CH ;UPDATE THE HASH CODE OF THE LINE. +VBDTRT: ADDI A,7 + CAME BP,OUT ;STOP IF REACH PT, GPT OR ZV. + CAMN A,TT ;STOP IF REACH RIGHT MARGIN. + CAIA ;IN EITHER CASE, INCREMENT HPOS FOR CHAR WE JUST DID. + JRST VBDFLP +;HERE EITHER IN = PT,GPT OR ZV, OR ELSE WE ARE ABOUT TO CONTINUE A LINE. +;SO VBDOK1 IS GUARANTEED TO DO 1 CHAR THE SLOW WAY BEFORE VBDFAS IS REACHED. +VBDOUT: CALL VBDSTO ;STORE BACK CHCTHC, CHCTHP, AND IN + JRST VBDOK1 + +VBDTBL: JRST VBDCTL ;^@ +REPEAT 6,JRST VBDCTL ;^A THRU ^F + JRST VBDCTL ;^G + JRST VBDBS ;^H + JRST VBDTAB ;^I + JRST VBDLF ;^J +REPEAT 2,JRST VBDCTL ;^K, ^L + JRST VBDCR ;^M +REPEAT 13.,JRST VBDCTL ;^N THRU ^Z + JRST VBDALT ;ALTMODE +REPEAT 4,JRST VBDCTL ;^\ THRU ^_ +REPEAT 137,JFCL ;NORMAL GRAPHICS CHARACTERS + JRST VBDCTL ;RUBOUT IS LIKE A CTL CHAR. +IFN .-VBDTBL-200,.ERR WRONG TABLE LENGTH + +VBDSTO: IDIVI A,7 ;CONVERT A BACK TO HPOS TIMES 1. + EXCH A,CHCTHP ;A IS UPDATED CHCTHP + SUB A,CHCTHP ;OLD CHCTHP MINUS NEW CHCTHP (A NEGATIVE NUMBER) + ADDM A,DISBFC ;IS ALSO - <# OF CHARS IDPB'D>. + MOVEM E,CHCTHC + SAVE BP + CALL GETCA + AOS IN,BP + CAMLE IN,GPT + SUB IN,EXTRAC + REST BP + RET + +VBDCR: SETOM CHCTCF ;CR => SET FLAG FOR NEXT CHAR AND HANDLE IT WITH DISAD. + JRST VBDOUT + +VBDCTL: SKIPE DISSAI ;MOST CONTROL CHARS ARE NORMAL IN SAIL MODE, LOSING OTHERWISE. + JRST VBDNRM +VBDBS:: VBDLF:: +VBDLOS: CALL VBDSTO ;HERE FOR A CHAR THAT MUST BE HANDLED WITH DISAD. + JRST VBDSL1 ;WE KNOW THAT IN DOESN'T = PT, GPT, OR ZV, OR WE WOULN'T HAVE + ;GOT EVEN THIS FAR, SO IT'S SAFE TO GO STRAIGHT TO VBDSLO. + +VBDALT: MOVE TT1,TTYOPT + TLNN TT1,%TOSAI + MOVEI CH,"$ + JRST VBDNRM + +VBDTAB: MOVEI CH,40 ;OUTPUT SPACES + IDPB CH,CHCTBP + ROT CH,(A) ;UPDATING HASH CODE OF LINE + ADD E,CH + ADDI A,7 ;AND INCREMENTING THE HPOS + TRNE A,7 ;TILL WE REACH A TAB STOP. NOTE 7*HPOS IS A MULTIPLE OF 8 IFF HPOS IS. + CAMN A,TT ;THE END OF THE LINE COUNTS AS A TAB STOP. + CAIA + JRST VBDTAB + SUBI A,7 + JRST VBDTRT ;RE-ENTER NORMAL LOOP, EXIT IF REACHED OBSTACLE. + +VIEW2A: MOVE C,VSIZE + ADDI C,1 ;(IF C ODD, WANT LINE WITH PT CENTERED) + LSH C,-1 + SAVE FF + TRZ FF,FRCLN\FRUPRW + PUSHJ P,GETAG7 ;GET 1 + LAST CHAR ADR TO PRINT IN E + JFCL + MOVN C,VSIZE + CAMN IN,BEGV ;IF BUFFER NOT EMPTY, + JRST VIEW2B + SOS IN + CALL GETINC ;LOOK AT LAST CHAR, NOT CHANGING IN. + CAIE CH,^J ;IF NOT LF, IT COUNTS AS A LINE. + AOS C +VIEW2B: PUSHJ P,GETAG4 ;THEN MOVE 2*N BACKWARD FROM THERE, GET 1ST TO DISPLAY. + JFCL + MOVE A,E ;DISPLAY AS MUCH AS WILL FIT. + REST FF + RET + +SUBTTL SINGLE CHARACTER TERMINAL OUTPUT, BUFFERED + +;OUTPUT ROUTINES. OUTPUT CHAR IN CH AS DESCRIBED, CLOBBERING ONLY Q. + +;"DISPLAY" - OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD: MOVE Q,CHCTHP + MOVEM Q,RRCCHP + CAMN IN,DISADP ;IF THIS CHAR COMES AFTER POINTER, + CALL DISBAR ;OUTPUT CURSOR. + +;DON'T OUTPUT CURSOR, DO CASE-FLAGGING. +DISAD2: SKIPN CASDIS ;IF IN -1F$ MODE + JRST CHCT + SAVE .-1 ;DO CASE-FLAGGING: ROUTINE FOR 1 CHAR IS CHCT. + +;CALL DISAD6 ? OUTPUT 1 CHAR ? POPJ P, ;TO OUTPUT A CASESHIFT IF NEC. +DISAD6: SKIPGE CASSFT ;DON'T TRY OUTPUTTING CASESHIFT + POPJ P, ;IF THERE ISN'T ANY. + CAME CH,CASSFT ;PUT CASE-SHIFTS BEFORE + CAMN CH,CASLOK ;CASE-SHIFTS AND CASE-:LOCKS. + JRST DISAD3 + CAILE CH,"Z+40 ;LOWER CASE SPECIAL CHARACTERS ALWAYS NEED CASESHIFTS. + CAIN CH,177 + CAIN CH,"@+40 + JRST DISAD3 + CAIL CH,"A+40 ;LOWER CASE LETTERS NEED THEM IS NORMAL CASE IS UPPER. + CAILE CH,"Z+40 + JRST DISAD4 + SKIPG CASNRM + RET + JRST DISAD3 ;PUT SLASHES BEFORE LOWER. + +DISAD4: SKIPL CASNRM ;IF NORMAL CASE IS LOWER, + RET + CAIL CH,"A ;PUT CASE-SHIFTS BEFORE UPPER CASE. + CAILE CH,"Z + RET +DISAD3: SAVE [DISAD5] ;CASESHIFT NEEDED; ARRANGE TO OUTPUT IT, + SAVE -1(P) ;THEN POPJ TO OUTPUT ORIGINAL CHAR. + HRLM CH,-2(P) + MOVE CH,CASSFT + POPJ P, ;PDL HAS 1-CHAR-RTN ? DISAD5 ? CHAR,,1-CHAR-RTN. + +;OUTPUT A CURSOR. +DISBAR: PUSH P,CH + SKIPE RREBEG + JRST DISBA1 + CALL RRDIS1 + SKIPE RGETTY + JRST POPCHJ +DISBA1: +INSIRP PUSH P,TT TT1 BP A B + MOVE CH,QRB.. ;GET ADDR OF CURSOR QREG + ADDI CH,.QCRSR + CALL QLGET + JRST DISBA2 ;NOT TEXT, NO CURSOR. + AOSN CHCTCF ;FORCE OUT ANY BUFFERED CR BEFORE THE CURSOR. + CALL CHCT5 + MOVE A,BP +DISBA3: SOJL B,DISBA2 ;LENGTH OF TEXT WAS IN B, + ILDB CH,A ;GET AND OUTPUT CHARS OF CURSOR. + CALL [ CAIN CH,^H + JRST DISBBS ;OUTPUT BS AS REAL BACKSPACE. + CAIL CH,40 ;OUTPUT CTL CHARS OTHER THAN ^H IN IMAGE MODE. + JRST CHCT + JRST CHCT4] + JRST DISBA3 + +DISBA2: INSIRP POP P,B A BP TT1 TT +POPCHJ: POP P,CH + POPJ P, + +;TTY AND DISPLAY ROUTINES. +;"TYPEOUT" - DON'T TYPE CURSOR, DO NOTICE CASDIS. +TYO: PUSHJ P,DISINT ;INIT. TYPEOUT. + JRST DISAD2 + +TYANOW: PUSHJ P,TYOA ;TYPEOUT, NO CURSOR, NO SLASH. + JRST DISFLS ;FORCE IT OUT IMMEDIATELY. + +TYOA: PUSHJ P,DISINT ;"TYPEOUT" + +;NO CURSOR, DON'T DO CASE FLAGGING. +CHCT: SKIPE MORNXT + CALL DISMOR + SKIPN ORESET + SKIPE MORFLF ;DON'T OUTPUT AFTER -FLUSHED. + POPJ P, + CAIN CH,^J + JRST CHCTLF ;LF => OUTPUT LINE. + AOSN CHCTCF ;ELSE FORCE OUT SAVED UP CR. + CALL CHCT5 + CAIN CH,177 + JRST CHCT0A ;RUBOUT COMES OUT AS ^? . + CAIL CH,40 ;NON-CTL CHARS. ONE POSITION. + JRST CHCT1A + CAIN CH,^I ;TAB => OUTPUT SEVERAL SPACES. + JRST CHCTTB + CAIN CH,^H + JRST CHCTBS + CAIN CH,^M ;REMEMBER A CR, NEXT CHAR WILL DECIDE. + JRST [SETOM CHCTCF ? POPJ P,] + CAIN CH,33 ;ALTMODE => OUTPUT. + JRST [ MOVE Q,TTYOPT + TLNN Q,%TOSAI ;ON TERMINALS WHICH CAN HANDLE ONE, SEND REAL ALTMODE. + MOVEI CH,"$ ;OTHERWISE SEND DOLLARSIGN. + CALL CHCT1A + JRST RET33] ;IN EITHER CASE DON'T CLOBBER CH. +CHCT0A: SKIPE DISSAI ;IN SAIL MODE, CTL CHARS OUTPUT AS THEMSELVES + JRST CHCT1A ;AND ASSUMED TO TAKE 1 POS. ON SCREEN. +CHCT0B: HRLM CH,(P) + MOVEI CH,"^ ;OTHER CTL CHARS => OUTPUT "^" + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + CALL CHCT1A + HLRZ CH,(P) + XORI CH,100 ;AND UN-CTLED CHAR. + CALL CHCT +DISAD5: HLRZ CH,(P) + POPJ P, + +;OUTPUT AN ORDINARY PRINTING CHARACTER. +;WHEN A FULL LINE HAS BEEN ACCUMULATED, CALL @CHCTAD +;WITH HASH CODE IN CHCTHC, VERT. POS. IN CHCTVP, +;HORIZ. POS. AFTER LINE IN CHCTHP. +CHCT1A: MOVE Q,CHCTHP + CAMGE Q,NHLNS ;IF FILLED LINE, CONTINUE IT. + JRST CHCT2 + PUSH P,CH + SKIPGE DISTRN ;TRUNCATING MEANS IGNORING CHARS TILL NEXT CR. + JRST [ MOVEI CH,"! ;IF WE'VE JUST BEGUN TO TRUNCATE, + SKIPL CHCIGN ;PUT IN AN EXCL. + CALL CHCT4 + SETOM CHCIGN ;START IGNORING MOST CHARS. + JRST CHCT1B] + MOVEI CH,"! + CALL CHCT4 ;PUT A ! AT END OF LINE. + AOS CHCTHP + MOVEM IN,CHCTNL + SOS CHCTNL ;ADDR OF 1ST CHAR OF LINE AFTER THIS ONE. + SETZM CHCTCF + CALL CHCTL0 ;NOW DO A CRLF. +CHCT1B: POP P,CH +CHCT2: SKIPL CHCTHP + CALL CHCT4 ;OUTPUT THE CHAR IF NECESSARY, + AOS CHCTHP + RET + +;PUT THE CHAR IN CH INTO THE BUFFER AND THE HASH-CODE. +;IF THE BUFFER (<- CHCTBP) IS FULL, OUTPUT IT FIRST. +CHCT4: SKIPL CHCIGN + SKIPN CHCTBP + POPJ P, + SOSG DISBFC ;IF BUFFER FULL,FLUSH IT + JRST [ PUSH P,CH + SETOM CHCTNL + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + PUSHJ P,@CHCTAD + POP P,CH + JRST .+1] + IDPB CH,CHCTBP ;STORE CHAR IN CALLER'S BUFFER. + +;MERGE CHARACTER IN CH INTO THE HASH CODE FOR THIS LINE. +;THE HASHING DEPENDS ON THE HPOS. WE GET IT FROM CHCTHP. +CHCTH: HRLM CH,(P) + MOVE Q,CHCTHP + IMULI Q,7 + ROT CH,(Q) + ADDM CH,CHCTHC + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR INSERTION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHI: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +;HERE WE GET THE HPOS FROM RRHPOS. USED FOR DELETION OF +;SINGLE CHARACTERS, TO UPDATE THE HCODE OF THE LINE AT VPOS IN BP. +CHCTHR: HRLM CH,(P) + MOVE Q,RRHPOS + IMULI Q,7 + ROT CH,(Q) + MOVNS CH + ADDM CH,HCDS(BP) + HLRZ CH,(P) + RET + +CHCTTB: MOVEI CH,40 ;TAB: OUTPUT A SPACE. + PUSHJ P,CHCT1A + MOVE CH,CHCTHP ;NOT AT TAB STOP => + SKIPN MORFLF ;GO OUTPUT ANOTHER UNLESS FLUSHED + TRNN CH,7 + JRST CHCTT1 + CAME CH,NHLNS + JRST CHCTTB +CHCTT1: MOVEI CH,11 + RET + +;INIT. FOR CHCT. +CHCTI0: SETZM CHCTCF ;NO PENDING ^M. + SETZM CHCOVP + SETZM CHCTHP + SETZM CHCIGN ;NOT BEYOND RIGHT MARGIN. +CHCTI1: AOS CHCTVP + SETZM CHCTHC ;INIT. ACCUMULATION OF HASH CODE. + POPJ P, + +CHCT5: PUSH P,CH ;FORCE OUT CR FOLLOWED BY OTHER THAN LF. + SKIPL DISPCR ;-1 => DO REAL CR. + JRST CHCT5A + MOVE CH,CHCTHP + MOVEM CH,CHCRHP + SETZM CHCTHP ;REAL CR: ZERO HORIZ POSITION, + SETZM CHCIGN ;NO LONGER PAST RIGHT MARGIN. + MOVEI CH,^M ;NOW FORCE OUT THE BUFFER, AND, + CALL CHCTIM ;ON PRINTING TTY, OUTPUT A REAL CR. + JRST POPCHJ + +CHCT5A: MOVEI CH,"^ ;SHOULDN'T OVERPRINT, PRINT AS ^M. + MOVE Q,TTYOPT + TLNE Q,%TOSAI + MOVEI CH,13 ;(OR UPARROW, ON TTY'S WITH SAIL CHAR SET) + CALL CHCT1A + MOVEI CH,"M + CALL CHCT1A + MOVE CH,CHCTHP ;IF WE CONTINUE THE LINE RIGHT AFTER THE ^M, WE SHOULD REALIZE + MOVEM CH,RRCCHP ;THAT THE NEXT CHAR STARTS IN COLUMN 0 OF NEXT LINE, NOT COLUMN -2! + JRST POPCHJ + +CHCTBS: SKIPL DISPBS ;DISPBS < 0 => PRINT AS BS. + JRST CHCT0A +DISBBS: SKIPN CHCTHP ;CAN'T DO ANYTHING AT LEFT MARGIN. + JRST CHCT0A ;^H AT COLUMN 0 => TYPE ^H. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SOS CHCTHP + MOVEI CH,^H ;IF WE'RE REALLY PRINTING, OUTPUT REAL ^H. +CHCTIM: SAVE CH + SETOM CHCTNL + SETOM DISFLF + CALL @CHCTAD ;SEND WHAT WE HAVE SO FAR. + SETZM DISFLF + REST CH +CHCTI9: SAVE CH + MOVE CH,CHCTAD + CAIE CH,DISLIN ;DON'T SEND THE ^H OR ^M IF WE'RE NOT REALLY TYPING. + JRST POPCHJ + MOVE CH,CHCTVP ;NO NEED TO SEND CR NOW IF WILL MOVE DOWN ANYWAY, + CAME CH,DISVP ;SINCE IN THAT CASE THE CURSOR MOTION WILL BE DONE BEFORE NEXT LINE. + JRST POPCHJ + REST CH + SETOM CHCOVP ;INDICATE DOING OVERPRINTING: NEXT DISLIN MUSTN'T %TDMV1 (IMLAX LOSE). + JRST TYOINV + +;COME HERE TO OUTPUT A LF. CALLED BY THE ROUTINE TO OUTPUT STRAY CR. +;CLOBBERS ONLY Q. LEAVES A ^J IN CH. +CHCTLF: MOVEM IN,CHCTNL + AOSE CHCTCF ;IF HAVE UNPROCESSED CR, OUTPUT IT. + JRST [ SKIPL DISPCR ;NO CR; WHAT DO WE DO FOR STRAY LF? + JRST CHCT0B ;MAYBE OUTPUT AS ^ AND J. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + JRST CHCTL1] + SETZM RRCCHP +CHCTL0: SETZM CHCIGN ;STOP IGNORING CHARS IF HAD TRUNCATED LINE. + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + SETZM CHCTHP ;REFLECT IT IN HORIZ. POS. +CHCTL1: PUSHJ P,@CHCTAD ;LF ENDS LINE, TELL CALLER ABOUT IT. + MOVEI CH,^M ;ON NON-DISPLAY, MUST ACTUALLY DO THE CR IF WANTED. + SKIPN CHCTCF + SKIPE RGETTY + CAIA + CALL CHCTI9 + PUSHJ P,CHCTI1 ;INIT NEW LINE. + SKIPL CH,CHCTNL + MOVEM CH,CHCTBL + MOVE CH,CHCTVP ;IF NOW PAST END OF SCREEN, NEXT CHARACTER MUST DO A --MORE--. + CAMN CH,CHCTVS + SETOM MORNXT +CHCTL4: SKIPG CH,CHCTHP + JRST CHCTL3 + MOVE Q,CHCTHC ;PUT SPACES IN HASH CODE. +CHCTL2: ROT Q,7 ;FOR THE INDENT IN LINE WE'RE STARTING WITH. + ADDI Q,40 + SOJG CH,CHCTL2 + MOVEM Q,CHCTHC +CHCTL3: MOVEI CH,^J + POPJ P, + +SUBTTL HANDLE BOTTOM-OF-SCREEN CONDITION + +;PRINT --MORE--, RETURN SETTING MORFLF IF FLUSHED, CLOBBERING ONLY Q. +;IN ^R MODE, EXIT RESTORING P FROM DISPRR. +DISMOR: MOVE Q,CHCTAD + CAIE Q,DISLIN ;IF NOT REALLY PRINTING OUT, DON'T DO --MORE--ING. + RET + SKIPN RREBEG + JRST [ MOVE P,DISPRR ;IN ^R MODE: WE WANT TO POP BACK TO ^R PDL LEVEL. + SKIPN RGETTY ;^R MODE ON PRINTING TTY: WE'RE ALREADY IN POSITION. + RET + MOVEI T,MS%DWN ;^R ON DISPLAY: CHOOSE AMONG --TOP--, --MIDDLE-- + SKIPE GEA + TRO T,MS%UP + SKIPE RRMORF ;AND --MORE-- IF FS ^R MORE IS > 0. + MOVEI T,MS%MOR + SKIPGE RRMORF ;USE NONE AT ALL IF FS ^R MORE IS < 0. + SETZ T, + SETZ A, + TRNE T,MS%UP ;IF NOT SAYING --MORE-- AND HAVE TEXT ABOVE AND BELOW SCREEN, + CALL DISMO6 ;COMPUTE FRACTION OF TEXT ABOVE + HRLM A,T ;AND INCLUDE THAT IN THE MODE LINE. + JRST DISMD] ;UPDATE --MORE-- LINE AND RETURN TO ^R. + SKIPN RGETTY + JRST [ CALL DISFLS ;ON PRINTING TTY, JUST ASSUME FLUSHED. + SETOM MORFLF ;AFTER PRINTING THE LF THAT CAUSED THE --MORE-- + RET] + SKIPN ORESET + SKIPE MORFLF + RET ;ALREADY FLUSHED. + SAVE CH + SAVE T + SETZM MORESW + MOVEI T,MS%MOR ;REDISPLAY --MORE-- LINE AND PUT --MORE-- ON IT. + CALL DISMD + SKIPGE CTLCF ;^C IMPLIES FLUSH IT. + JRST DISMO2 + TTYACT +IFN TNX,[SAVE ECHOF2 + SETZM ECHOF2] ;DONT ECHO IT NOW + PUSHJ P,TYINH +IFN TNX,REST ECHOF2 + CAIN CH,40 ;READ A SPACE => + JRST [ SAVE CHCTHP + SAVE CHCTHC + PUSHJ P,DISTOP ;TOP OF SCREEN, THEN TRY AGAIN. + REST CHCTHC + REST CHCTHP + SKIPL VREMEM ;IF DISPLAYING STUFF THAT'S IN BUFFER, + JRST DISMOX + MOVE Q,CHCTBL ;REMEMBER WHERE THIS SCREENFULL STARTED, + SUB Q,BEGV ;NEXT BUFFER DISPLAY WILL TRY TO START AT SAME PLACE. + MOVEM Q,GEA + JRST DISMOX] + CAIE CH,177 ;ELSE RE-READ UNLESS RUBOUT. + MOVEM CH,UNRCHC + HRRZM P,MORFLF + CAIE CH,177 ;SET MORFLF (FS FLUSHED$) TO NONZERO, POSITIVE IFF RUBOUT. +DISMO2: SETOM MORFLF + DISSTR /-FLUSHED/ + PUSHJ P,DISIOT ;PUT FLUSHED ON THE --MORE-- LINE + MOVEI T,MS%FLS + MOVEM T,MORESW ;AND REMEMBER THAT THAT IS WHAT'S THERE. +IFN TNX,[SKIPE ECHOF2 + CALL ECHOCH] ;ECHO IT NOW +DISMOX: REST T + REST CH + RET + +;A GETS PERCENT OF BUFFER ABOVE START OF WINDOW. +DISMO6: SAVE B + MOVE A,GEA + ADD A,BEGV + SUB A,BEG ;GET WINDOW START REL. TO BEG. + MOVE B,Z + SUB B,BEG ;GET Z REL. TO BEG. + IMULI A,100. + IDIV A,B ;A GETS WINDOW AS PERCENT OF Z. +POPBJ: REST B + RET + +SUBTTL SEND THE TERMINAL OUTPUT BUFFER + +;CALL HERE TO FORCE OUT BUFFERED OUTPUT. +;CALL AFTER EACH TECO COMMAND THAT DOES OUTPUT. +DISFLS: AOSN CHCTCF ;FORCE OUT ANY UNPROCESSED CR. + CALL CHCT5 ;THIS CAN BE A SCREW IF BETWEEN THAT CR AND A LF! + SETOM CHCTNL + SETOM DISFLF ;FORCE DISLIN TO MOVE CURSOR + MOVE Q,CHCTHP + MOVEM Q,CHCRHP + PUSHJ P,DISLIN ;.IOT IT. + SETZM DISFLF + POPJ P, + +;OUTPUT THE BUFFER. +DISLIN: SKIPE TSALTC ;IF A CMD STRING IS WAITING TO BE READ, + SETOM MORFLF ;GIVE UP TYPEING OUT. + SKIPN ORESET + SKIPE MORFLF + JRST DISRST + SAVE T + SAVE BP +DISLI7: SKIPN BP,CHCTVP ;IF ABOUT TO WRITE ON TOP LINE + JRST [ SKIPN TRCOUT ;BECAUSE OF TRACE MODE, + JRST .+1 + DISSTR / +/ + CALL DISIOT ;CLEAR 1ST LINE AND USE SECOND INSTEAD. + AOS BP,CHCTVP ;THIS WAY ERROR MESSAGES DON'T CLOBBER ANY TRACE OUTPUT. + SETZM HCDS + JRST .+1] + MOVE CH,CHCTHC + SKIPN RGETTY + JRST DISLI0 ;ON PRINTING TTY, NO OLD LINE REMAINS ON SCREEN. + +;; SET UP LINBEG OF FOLLOWING LINE, AND MAYBE MOVE TEXT BELOW UP OR DOWN ON SCREEN. + CAML BP,CHCTVS ;IF WE'RE WITHIN THE SCREEN AREA, + JRST DISLI8 + SKIPN RREBEG + SKIPGE CHCTNL ;IN ^R, IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLI8 ;COMPUTE THE LINBEG WORD FOR THE LINE THAT WILL FOLLOW THIS ONE: + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SKIPG Q,RRIDLB ;IF CAN INSERT/DELETE, SEE IF THAT TEXT IS PRESENT ON THE SCREEN + JRST DISLI8 + CAMN Q,T + JRST DISLI9 ;AND IF SO, MOVE IT TO THE LINE AFTER THIS ONE. + CAML T,Q ;IF WE HAVE ALREADY HACKED RRIDLB AND PASSED IT, DO NOTHING NOW. + JRST DISLI8 + SUB Q,RRIDBK ;ELSE MAYBE WE HAVE REACHED THE BLANK LINES PRECEDING RRIDLB. + SUB Q,RRIDBK + CAMG T,Q + JRST DISLI8 + SUB T,Q ;IF SO, FIGURE OUT FROM RRIDBK HOW MANY BLANK LINES REMAIN + ASH T,-1 ;TO BE PRINTED, AND FROM THAT, WHAT VPOS TO COPY RRIDLB TO. + SUB T,RRIDBK ;BUT THERE IS A FUNNY WAY TO TELL DSLID THAT. + ADDM T,RRIDVP +DISLI9: CALL DSLID ;MOVE THE TEXT ACCORDING TO Q AND BP. + JFCL + SETOM RRIDLB ;DON'T TRY TO MOVE IT AGAIN; WOULD GET CONFUSED. + +;; WE ARE NOW FINISHED WORRYING ABOUT MOVING THE TEXT BELOW THIS LINE ON THE SCREEN. +DISLI8: +IFN ITS,[MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDNOP] + MOVEM Q,DISBF1 ;INITIALLY ASSUME NO POSITIONING NEEDED + MOVEM Q,DISBF1+1 +] +IFN TNX,[ + SETZM DISBF1 ;CLEAR OUT CURSOR POSITIONING + MOVE Q,[DISBF1,,DISBF1+1] + BLT Q,DISBF1+5 +] + CAML BP,CHCTVS ;IF WE'RE AT BOTTOM OF SCREEN; MUST OUTPUT, SO THAT + JRST [ MOVEM BP,DISVP + MOVEM BP,DISVP1 ;WE WILL CALL DISMOR IF NECESSARY, BUT ARRANGE NOT TO CLEAR + JRST DISLI4] + AOSG CHCOVP + JRST DISLI1 + AOSG ERRFL1 ;IF ERRFL1 (FS ERRFLG$) IS <0, IT IS - # LINE OF ERROR MSGS ON SCREEN, + JRST DISLI3 ;SO COUNT OFF THAT MANY LINES BEFORE OUTPUTTING. + CAMN CH,HCDS(BP) ;OUTPUT ONLY IF HASH CODE DIFFERS, + SKIPE DISFLF ;OR IF INSIST ON OUTPUTTING + JRST DISLI4 + JRST DISLI3 + +DISLI4: +IFN ITS,[ + DPB BP,[DISCPV] ;PREPARE TO SET VERT. POS. + DPB BP,[DISC1V] + MOVE Q,DISCM1 ;IF SAME LINE AS BEFORE, JUST MOVE CURSOR; DON'T CLEAR. + MOVEM Q,DISBF1+1 + CAMN BP,DISVP + JRST DISLN3 + MOVE Q,DISCMV + LDB T,[DISCPH] + JUMPN T,[ ;IF NOT STARTING IN COL 0, MUST GO TO COL 0, CLEAR, THEN SET CURSOR. + MOVEM Q,DISBF1 + JRST DISLN3] + MOVEM Q,DISBF1+1 ;IF STARTING IN COL 0, JUST GO TO COL 0 AND CLEAR. + JUMPE BP,DISLN3 + MOVEI T,-1(BP) ;IF MOVING DOWN 1 LINE, AND GOING TO COL 0, DO IT WITH A %TDCRL. + MOVE Q,[.BYTE 8 ? %TDNOP ? %TDNOP ? %TDNOP ? %TDCRL] + CAMN T,DISVP1 + MOVEM Q,DISBF1+1 +DISLN3: +] +IFN TNX,[ + MOVEI Q,DISMOV ;ASSUME CLEAR TOO + CAMN BP,DISVP + MOVEI Q,DISMV1 ;DONT NEED TO + CALL (Q) ;SET UP DISBF1 RIGHT +] + MOVEM BP,DISVP1 ;REMEMBER WHAT LINE THE CURSOR IS ON. + JRST DISLN4 ;GO OUTPUT POSITIONING & LINE. + +DISLI0: SKIPL DISVP ;ON PRINTING TTY, + CAMN BP,DISVP ;IF NOT SAME LINE AS BEFORE, LINEFEED. + JRST DISLI1 +IFN ITS,[HRROI Q,[ASCIC/ +/] + CALL DISIOT +] +IFN TNX,CALL ECHLF2 + JRST DISLN4 + +DISLN4: SKIPN RGETTY + JRST DISLI1 + CAMGE BP,CHCTVS ;HERE WHEN WE KNOW WE MUST OUTPUT THE LINE. STORE NEW HASHCODE. + MOVEM CH,HCDS(BP) + MOVE T,CHCRHP ;RECORD HPOS OF END OF LINE. + MOVEM T,LINEND(BP) +DISLI1: SKIPGE Q,CHCTBP ;GET THE STUFFING B.P. AND MAKE NORMALIZE IT + SUB Q,[400000,,1] ;BY CONVERTING 441000,,FOO TO 041000,,FOO-1 + SETZ T, +DISLI2: TLNE Q,700000 ;COUNT THE NUMBER OF UNUSED BYTES IN THE LAST WORD + AOJA T,[IBP Q ? JRST DISLI2] ;OF THE OUTPUT BUFFER. + MOVEI Q,1-DISBF1(Q) + LSH Q,2 + SUBM Q,T ;# OF CHARS TO BE OUTPUT. + CALL DISSIOT ;OUTPUT THAT MANY CHARS STARTING AT DISBF1 +DISLI3: MOVEM BP,DISVP ;INDICATE WHERE WE HAVE PUT THE CURSOR. + MOVEI T,1(BP) + SKIPE RGETTY ;ON A DISPLAY, CONSIDER STOPPING OUTPUT BECAUSE OF INPUT AVAIL. + CAML T,CHCTVS ;AVOID BOUNDARY LOSSAGE: DON'T STOP ON --MORE-- LINE + JRST DISLN1 ;OR THE LINE BEFORE IT (WOULD SET --MORE-- LINE'S LINBEG). + SKIPN RREBEG + SKIPGE CHCTNL ;IF AFTER THIS BUFFERFULL STARTS A NEW LINE, + JRST DISLN1 +;SET UP LINBEG WORD FOR LINE AFTER THIS ONE, IN CASE WE DECIDE TO STOP DISPLAYING NOW. +;IF WE DO, THE LINBEG WORD FOR THE NEXT LINE IS NECESSARY FOR STARTING UP AGAIN. + MOVE T,RRCCHP ;STARTING HPOS IS CURRENT HPOS UNLESS + CAME T,CHCTHP ;WE ARE CONTINUING IN MIDDLE OF A CHAR, + SUB T,NHLNS ;IN WHICH CASE IT IS MINUS THE NUMBER + ;OF POSITIONS USED ON PREV. LINE BY THIS CHAR. + LSH T,33 ;PUT STARTING HPOS IN TOP 9 BITS. + ADD T,CHCTNL ;PUT STARTING PT OF LINE IN LOW 33 BITS. + SETZM DISFLF ;IN CASE WE EXIT, MAKE SURE DISFLF DOESN'T STAY SET. + MOVE Q,CHCTNL + CAMLE Q,RRMAXP ;IF NEXT LINE STARTS PAST THE END OF ALL CHANGES, + SKIPE RRMSNG ;AND ALL UNCHANGED LINES ARE PROPERLY ON THE SCREEN, + JRST DISLN2 + MOVE Q,LINBEG+1(BP) + ADD Q,Z ;AND WE ARE ABOUT TO DISPLAY THE SAME CHARACTERS THAT ARE ON THE LINE + SUB Q,RROLDZ ;ALREADY (TAKING INTO ACCOUNT INSERTIONS AND DELETIONS SINCE + CAMN T,Q ;OLD LINBEG WAS STORED), THEN WE NEED NOT REALLY REDISPLAY. + JRST RRDISF ;SO STOP DISPLAYING AND RETURN TO ^R. +DISLN2: AOS BP + MOVEM T,LINBEG(BP) + MOVEM BP,RRMNVP ;IF THERE IS INPUT, STOP DISPLAYING; LATER START FROM NEXT LINE. + SETZM RRMNHP ;THUS MAKE SURE REDISPLAY STARTS THIS FAR UP AT LEAST. + SKIPE DFORCE + JRST DISLN6 ;FS DFORCE$ MEANS FINISH DISPLAY EVEN IF INPUT IS WAITING. +IFN ITS,[ + SKIPE DWAIT ;FOR VERY SLOW TTYS, WAIT BETWEEN LINES SO WE STOP DISPLAYING FAST + .LISTEN T, ;WHEN THERE IS TYPE-IN. + .STATUS CHTTYI,T ;ARE CHARS AVAILABLE FOR ^R TO PROCESS? + ANDI T,2000 ;IF SO, STOP DISPLAYING AND PROCESS THEM. +] +IFN TNX,[ + SAVE A + SAVE B + MOVEI A,.CTTRM + SKIPE DWAIT ;DO DOBE ONLY IF SLOW TERMINAL + DOBE ;(DONT USE LISTEN MACRO) + SIBE ;ANY CHARACTERS FOR ^R TO PROCESS? + TDZA T,T ;YES + SETO T, ;NO + REST B + REST A +] +DISLN6: JUMPE T,[SKIPE LID ;IF DOING INSERT/DELETE, SET RRMSNG INSTEAD OF UPPING RRMAXP + JRST [ SETOM RRMSNG ;SINCE THE LATTER WOULD SCREW IF THIS NEW INPUT WANTS + JRST RRDISX] ;TO INSERT OR DELETE LINES. + MOVE T,CHCTNL ;MAKE SURE NEXT REDISPLAY DOESN'T + CAMLE T,RRMAXP ;STOP BEFORE REACHING THIS FAR DOWN. + MOVEM T,RRMAXP ;WITHOUT THIS, + JRST RRDISX] ;LOSES IF TYPED QUICKLY. +DISLN1: REST BP + REST T +DISLI6: MOVE Q,CHCTHP ;REMEMBER STARTING HORIZ POS. OF NEXT LINE. +IFN ITS,DPB Q,[DISCPH] +IFN TNX,MOVEM Q,DISCPH +DISRST: MOVE Q,[441000,,DISBUF] + MOVEM Q,CHCTBP ;RE-INIT BUFFERING. + MOVEI Q,4*DISBFC-6 + MOVEM Q,DISBFC + POPJ P, + +;HERE IN REDISPLAY ON TERMINALS WITH INSERT/DELETE LINE +;WHEN WHAT'S LEFT ON THE SCREEN BELOW CURSOR IS VALUABLE, IF MOVED TO THE RIGHT PLACE. +;WE MOVE IT THERE AND THEN RESUME DISPLAYING. +;BP HAS VPOS OF LINE ABOUT TO BE OUTPUT, WHEN CALLED FROM DISLIN. +;THIS MEANS THAT FOR UPWARD MOTION WE MOVE THINGS UP TO LINES STARTING FROM 1(BP), +;WHEREAS FOR DOWNWARD MOTION WE MOVE DOWN FROM LINES STARTING FROM (BP). +;THE DISTANCE THAT LINES MOVE ACROSS IS (RRIDVP)-(BP)-1 IN EITHER CASE. +;OTHER CALLERS MUST ARRANGE BP AND RRIDVP ACCORDINGLY. +;WE CLOBBER ONLY Q. +;SKIPS IF WE REALLY DO MOVE TEXT. +DSLID: MOVE Q,RRIDVP ;GET OLD POSITION OF TEXT WE WANT TO MOVE UP OR DOWN. + SUBI Q,1(BP) ;Q GETS # LINES TO MOVE IT UP (OR - # TO MOVE IT DOWN). +;Q=0 IS A SPECIAL CASE- NO MOTION OF THE STUFF ON THE SCREEN IS NECESSARY! + JUMPE Q,CPOPJ ;THE NON-INSERT-DELETE MECHANISMS FOR RROLDZ WILL WIN IN THIS CASE. +IFN ITS,[SAVE 0 ;PUSH THE CURRENT CURSOR POS SO WE CAN AVOID CHANGING IT. + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,(P)] + .LOSE %LSFIL +] +.ELSE SAVE TTLPOS + SAVE Q + SAVE BP + JUMPL Q,DSLIDD +;WE WANT TO MOVE STUFF UP. + AOS BP + ADD BP,-1(P) ;CHECK FOR SCREW CASE THAT THERE REALLY AREN'T ANY USEFUL LINES + CAML BP,BOTLIN ;LEFT TO MOVE UP. IF WE DIDN'T CHECK, DSLID5 WOULD CLOBBER LOW CORE. + JRST DSLID4 + SUB BP,BOTLIN + MOVNS BP ;HOW MANY LINES ARE WE PRESERVING? + IMULI BP,5 ;IF IT'S NOT AT LEAST 1/5 AS MANY AS HOW FAR WE ARE MOVING THEM, + CAMGE BP,Q ;GIVE UP AND REWRITE THEM ALL. + JRST DSLID4 + MOVE BP,(P) + AOS BP + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE OF SCREEN? + JRST [CALL SCRLUP ;YES, SCROLL Q LINES UP THEN + JRST DSLID8] + CALL DELLIN ;DELETE THAT MANY LINES BELOW WHERE CURSOR IS NOW. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,-1(P) ;NOW GO THAT MANY LINES ABOVE MODE LINE (TO WHERE TEXT OF MODE LINE IS) + CALL INSLIN ;AND INSERT EMPTY LINES TO PUSH MODE LINE BACK TO RIGHT PLACE. +DSLID8: MOVE Q,(P) + AOS BP,Q ;Q GETS NEW VPOS OF UPPERMOST LINE MOVED UP. + ADD BP,-1(P) ;BP GETS THE VPOS IT CAME FROM. + SAVE A +DSLID5: MOVE A,LINBEG(BP) ;COPY UP THE LINBEGS FOR THE LINES MOVED UP. + MOVEM A,LINBEG(Q) + MOVE A,LINEND(BP) + MOVEM A,LINEND(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + AOS BP + AOS Q + CAMGE BP,BOTLIN ;STOP WHEN BP POINTS AT THE WINDOW END, WHICH WASN'T MOVED UP. + JRST DSLID5 + REST A +DSLID6: SETZM HCDS(Q) ;ZERO THE HASH CODES FOR THE INSERTED BLANK LINES. + AOS Q + CAMGE Q,BOTLIN + JRST DSLID6 + SETOM RRMSNG ;NOW, WE MUST THINK ABOUT DISPLAYING ALL THE WAY TO END OF WINDOW, + ;SO THAT WE WILL FILL THOSE BLANK LINES WITH WHAT BELONGS THERE. +DSLID3: MOVE BP,-2(P) ;NOW RESTORE CURSOR TO POSITION IT HAD ON ENTRY TO DSLID. + CALL SETCU1 + AOS -3(P) +DSLID4: REST BP ;SO THAT WE FILL IN THOSE BLANK LINES. + REST Q + JRST POP1J + +;HERE TO MOVE TEXT DOWNWARD. +DSLIDD: MOVMS -1(P) ;GET POSITIVE # OF LINES TO MOVE DOWN. + MOVE BP,BOTLIN + SUB BP,-1(P) + MOVE Q,BP + SOS Q + CAMG Q,(P) ;DETECT FUNNY CASE WHERE THE NUMBER OF LINES LEFT IS LESS THAN + JRST DSLID4 ;THE DISTANCE DOWN WE MUST MOVE THEM. GIVE UP IN THAT CASE. + SUB Q,(P) ;GET NUMBER OF LINES TO BE PRESERVED. + IMULI Q,5 ;IF THAT ISN'T AT LEAST 1/5 THE DISTANCE THEY ARE MOVING, DON'T BOTHER. + CAMGE Q,-1(P) + JRST DSLID4 + MOVE Q,-1(P) + SKIPGE LID ;TERMINAL CAN SCROLL MIDDLE? + JRST [MOVE BP,(P) ;YES, GET TOP LINE AGAIN + CALL SCRLDN ;SCROLL Q LINES DOWN + JRST DSLID9] + CALL DELLIN ;FIRST, DELETE SOME LINES JUST ABOVE THE MODE LINE. + MOVE BP,(P) + MOVE Q,-1(P) + CALL INSLIN ;THEN, INSERT THE SAME NUMBER JUST BELOW THIS LINE. +DSLID9: MOVE Q,BOTLIN + SOS Q + MOVE BP,Q + SUB BP,-1(P) + SAVE A + SAVE LINBEG+1(BP) ;REMEMBER LINBEG OF FIRST LINE THAT MOVES OFF SCREEN BOTTOM. +DSLID1: MOVE A,LINBEG(BP) ;COPY DOWN THE LINBEGS FOR THE LINES MOVED DOWN. + MOVEM A,LINBEG(Q) + MOVE A,LINEND(BP) + MOVEM A,LINEND(Q) + MOVE A,HCDS(BP) + MOVEM A,HCDS(Q) ;ALSO COPY THE HASH CODES OF THE COPIED LINES. + SOS BP + SOS Q + CAML BP,-2(P) ;STOP AFTER MOVING THE HIGHEST LINE TO BE MOVED. + JRST DSLID1 +DSLID7: MOVE A,LINBEG+1(BP) ;FILL THE LINBEGS OF THE NEWLY CREATED BLANK LINES WITH + MOVEM A,LINBEG(Q) ;SOMETHING MEANINGFUL: THE LINBEG OF THE FIRST FOLLOWING LINE. + SETZM HCDS(Q) ;CLEAR THE HASHCODES OF THE NEWLY MADE BLANK LINES. + SETZM LINEND(Q) + CAIE Q,1(BP) + SOJA Q,DSLID7 + REST A ;GET BACK LINBEG OF LINE MOVED OFF BOTTOM OF SCREEN. + SKIPN DFORCE ;DFORCE => MODE LINE SHOULD NOT BE UPDATED BY THIS REDISPLAY. + SKIPE RRMSNG ;IF RRMSNG IS SET THEN THE LINBEGS AREN'T EVEN VALID FOR + JRST DSLID2 ;WHAT FOLLOWS, BUT SOMEONE ELSE WILL HANDLE IT. + SKIPN RRMORF + CAMN A,RROLZV ;IF THERE WAS DISPLAYED TEXT ON THAT LINE, + JRST DSLID2 + MOVE A,MORESW ;THEN THE MODE LINE SHOULD SAY --MIDDLE-- OR --TOP-- NOW. + TRON A,MS%DWN ;IF IT ISN'T ALREADY RIGHT, + SETZM DISOMD ;MAKE SURE THAT IT WILL BE REDISPLAYED + MOVEM A,MORESW ;SAYING THE RIGHT THING. + TRNN A,MS%UP ;THIS INCLUDES FIGURING OUT THE % ABOVE SCREEN + JRST DSLID2 + CALL DISMO6 ;IF STUFF WAS OFF THE TOP ALREADY AND NOW ALSO OFF THE BOTTOM. + HRLM A,MORESW +DSLID2: REST A + JRST DSLID3 + +SUBTTL INITIALIZE DISPLAY OUTPUT + +;INIT FOR DISPLAY OUTPUT. +DISINI: SETOM TYOFLG ;"TYPEOUT" NO LONGER INITTED. + SETOM ECHCHR ;IF ^R COMMAND DOES DISPLAYING IT SHOULDN'T BE ECHOED ON PRINTING TTY. + MOVE Q,QRB.. + SETOM .QVWFL(Q) +DISIN0: SETZM VREMEM +DISTO1: PUSHJ P,CHCTI0 ;INIT FOR CHCT. + MOVEI Q,DISLIN ;TELL IT TO CALL DISLIN EACH LINE. + MOVEM Q,CHCTAD + PUSHJ P,DISLI6 ;INIT. BUFFERING. + +;MOVE TO TOP OF SCREEN. +DISTOP: AOSN PJATY + JRST [ CALL CTLL1 + JRST DISTO1 ] ;REINIT IN CASE FS REDISPLAY$ DID SOME TYPEOUT. + SETZM MORFLF ;UNDO A FLUSHED. + SETZM MORNXT + SETZM OLDFLF + SETOM DISVP + SETZM DISVP1 + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPN RGETTY + JRST [ SETZM TOPLIN + SKIPE RUBENC ;ON PRINTING TTY, NORMALLY ADVANCE TO CLEAN LINE, + JRST RUBEND ;BUT DO SOMETHING SPECIAL IF WAS PREARRANGED. + JRST CRIF] + SAVE C + MOVE C,NLINES ;SET UP WINDOW SIZE FROM USER-SETTABLE FLAGS (LINES AND TOPLINE). + CALL WINSET + REST C + MOVE Q,TOPLIN + MOVEM Q,CHCTVP + MOVE Q,BOTLIN + SKIPN RGETTY + MOVE Q,USZ + MOVEM Q,CHCTVS + SKIPGE ERRFL1 + RET + JRST HOMCUR ;BRING CURSOR TO TOP LEFT. + +;START "TYPEOUT" AT TOP OF SCREEN. +DISTOT: SETOM TYOFLG ;FORCE RE-INIT. + +;INIT FOR TYPEOUT, PREVENT BUFFER DISPLAY. +;ALL TYPEOUT ROUTINES MUST COME HERE. +DISINT: MOVE Q,QRB.. + SETOM .QVWFL(Q) + SETOM ECHCHR ;IF ^R COMMAND DOES TYPEOUT IT SHOULDN'T BE ECHOED ON PRINTING TTY. + AOSN TYOFLG ;IF NO PREVIOUS TYPEOUT, + JRST DISIN0 + SKIPE RUBENC + CALL RUBEND + RET + +CTLL: SKIPLE CLRMOD ;SCREEN-CLEARING MAY BE DISABLED. + RET + MOVE Q,QRB.. + SETZM .QVWFL(Q) ;ALLOW BUFFER DISPLAY. + SETOM TYOFLG ;NEXT TYPEOUT WILL START AT TOP OF SCREEN. + SETOM GEA ;ALLOW NEW TEXT WINDOW TO BE CHOSEN. + SETZM MORFLF ;FLUSHING A --MORE-- DOESN'T LAST PAST CLEARING THE SCREEN. + SETZM OLDFLF + SKIPGE PJATY + JRST CTLL1 + SKIPE RGETTY + SKIPN NLINES ;IF NOT USING WHOLE SCREEN FOR WINDOW NOW, + SKIPE TOPLIN ;CLEAR JUST WHAT'S IN THE WINDOW. + JRST CTLL2 + +;HERE TO DO A REAL CLEAR-SCREEN. +CTLL1: SETZM PJATY ;HERE TO CLEAR WHOLE SCREEN. + SETZM MORESW ;BE AWARE THAT --MORE-- IS BEING ERASED. + SETZM ECHACT ;ECHO AREA IS NOW CLEAR. + CALL CLRSCN + SETOM RROVPO ;SHOW RRTTY THAT IT NEEDN'T ECHO THE COMMAND. + SETOM DISOMD ;REDISPLAY THE "MODE" ON THE --MORE-- LINE. + SETZM HCDS ;SET HASH CODES TO 0 + MOVE Q,[HCDS,,HCDS+1] + BLT Q,HCDSE-1 ;SINCE 0 IS CODE FOR A NULL LINE + SKIPN REFRSH ;IF USER HAS A REFRESH ROUTINE, RUN IT. + RET + CALL SAVACS ;SAVING ALL ACS, AND DOING A (-) AROUND IT. + MOVE A,REFRSH + CALL MACXCP + JRST RSTACS + +CTLL2: SKIPE RGETTY ;ON DISPLAYS, EFFECTIVELY CLEAR ECHO AREA WITH A CR. + CALL ECHOCR + CALL DISINI ;CLEAR WINDOW AREA BY DOING A "BUFFER DISPLAY" OF NO CHARACTERS. + SETO IN, + CALL DISCLR ;NOW "REST OF SCREEN", MEANING ALL OF WINDOW. + MOVE Q,QRB.. + SETZM .QVWFLA(Q) + RET + +;"CLOSE" A BUNCH OF DISPLAY OUTPUT - CLEAR LINES FROM CURSOR TO END OF WINDOW. +DISCLG: CAME IN,PT + JRST DISCL3 + SKIPN RREBEG + CALL RRDIS1 +DISCL3: SETZM VREMEM + SETOM TYOFLG ;FORCE NEXT TYPEOUT TO CALL DISINT + CALL DISFLS ;FORCE OUT ANY INCOMPLETE LINE. + SKIPN ORESET + SKIPE MORFLF ;IF WE WERE FLUSHED AT A --MORE--, JUST UN-FLUSH. + RET + SKIPN RGETTY ;ELSE, ON DISPLAY TTY, CLEAR REST OF SCREEN + RET + AOS CHCTVP + CALL DISCLR ;CLEAR OUT REST OF LINES IN DISPLAY AREA. SET LINBEGS FROM IN. +;MAKE SURE THE --MORE-- LINE DOESN'T SAY "--MORE--", AND HAS THE +;CORRECT MODE DISPLAYED ON IT. +DISCLJ: MOVEI T,MS%UP + SKIPE GEA ;FIGURE OUT WHETHER WE WANT AN EMPTY --MORE-- FIELD, OR A --BOT--. + SKIPE RREBEG + SETZ T, + SKIPE RRMORF + SETZ T, + JRST DISMD ;AND UPDATE THE --MORE-- LINE IF IT ISN'T WHAT WE WANT. + +;CLEAR LINES FROM CHCTVP DOWN TO END OF DISPLAY AREA. +;IN CAN HAVE ADDRESS OF END OF BUFFER, IF PREVIOUS LINES HOLD DATA FROM BUFFER. +;IF IN CONTAINS -1, WE CLEAR LINES EVEN IF ALREADY CLEAR. +DISCLR: MOVE BP,CHCTVP + CAML BP,CHCTVS ;STOP CLEARING AT END OF WINDOW, OR END OF SCREEN. + RET + SKIPLE IN + MOVEM IN,LINBEG(BP) ;ABOUT TO CLEAR A LINE: SET ITS LINBEG TO END OF BUFFER. + SKIPN HCDS(BP) ;LINE ALREADY CLEAR => DON'T CLEAR IT. + JUMPGE IN,DISCL1 + SETZM HCDS(BP) ;CLEAR A LINE BY CLEARING THE HASH CODE, + HRLZS BP ;MOVING TO THE LINE + CALL SETCUR + CALL CLREOL ;AND CLEARING VIA THE SYSTEM. +DISCL1: AOS CHCTVP + JRST DISCLR + +;,FS TYO HASH$ SETS HASH CODE OF LINE. +FSHCD: TRZN FF,FRARG + TYPRE [AOR] + MOVE E,SARG + SKIPL C ;REQUIRE VPOS TO BE IN RANGE. + CAML C,USZ + TYPRE [AOR] + MOVE A,HCDS(C) + TRZE FF,FRARG2 + MOVEM E,HCDS(C) + JRST POPJ1 + +SUBTTL MODE LINE DISPLAY + +FRCMD: TRZE FF,FRCLN + JRST CLRMOR ;:FR => CLEAR THE MORE LINE ENTIRELY. + SKIPN RGETTY ;FR => ON PRINTING TTY, MAYBE TYPE OUT THE MODE. + JRST DISMDP ;FOR IMPLICIT FR'S SUCH AS FI AND ^R, WE NEVER DO THAT. +;REDISPLAY THE MODE LINE AND RETURN CURSOR TO WHERE IT IS, +;PROVIDED THERE IS NO INPUT AVAILABLE. +DISMDI: MOVE Q,$QMODE ;UPDATE MODE DISPLAY IF IT IS NECESSARY + SKIPN RGETTY ;ON PRINTING TTY, WE DISPLAY IT DIFFERENTLY. + RET + MOVE T,PFINI + SUB T,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES T + CAMG T,MODCHG ;IF FS MODE CHANGE$ LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF FS MODE CHANGE$ IS POS, WE MUST RUN FS MODE MAC$ + JRST .+3 + CAMN Q,DISOMD + RET + SKIPN TYISRC + SKIPL UNRCHC + RET + LISTEN Q, + JUMPN Q,CPOPJ ;DON'T UPDATE MODE LINE IF INPUT AVAILABLE. + MOVE T,MORESW ;DON'T CHANGE THE --MORE-- OR WHATEVER, + CAIN T,MS%FLS ;EXCEPT GET RID OF A "FLUSHED". + MOVEI T,MS%MOR +IFN ITS,[ + HRROI Q,[ASCIC/S/] ;AVOID CLOBBERING CURSOR POSITION. + CALL DISIOT + CALL DISMD ;NO INPUT: DISPLAY THE NEW "MODE" + HRROI Q,[ASCIC/R/] + JRST DISIOT +] +IFN TNX,[ + SAVE B + MOVE B,TTLPOS ;MOVE CURSOR BACK WHERE IT WAS BEFORE + CALL DISMD + JRST SETCU3 +] + +DISMDP: SKIPN SHOMOD ;ONLY DISPLAY MODE ON PRINTING TTY IF FS SHOWMODE$ IS SET. + RET + MOVEM Q,DISOMD ;AND THEN ALWAYS SHOW IT EVEN IF HAVE INPUT. + CALL CRIF ;GET FRESH LINE + CALL DISMD2 ;TYPE OUT MODE + JRST CRIF ;AND ANOTHER NEW LINE + +;UPDATE, IF NECESSARY, THE "MODE" DISPLAYED ON THE --MORE-- LINE. +;THE "MODE" IS A TEXT STRING STORED IN Q..J. THE CONTENTS OF THAT QREG ARE +;ALWAYS VISIBLE ON THE --MORE-- LINE. THE IDEA IS FOR THE USER TO BE +;ABLE TO TELL IMMEDIATELY WHAT MODE HE IS IN (WHERE THE MODES ARE DEFINED +;BY HIS MACROS PACKAGE). +;T SHOULD HAVE THE DESIRED MORESW VALUE SAYING WHETHER WE WANT --MORE-- OR --TOP-- OR WHAT. +DISMD: MOVE Q,PFINI + SUB Q,PF ;COMPARE -2*(FS QP PTR$) WITH FS MODE CHANGE$ + HRRES Q + CAMG Q,MODCHG ;IF FS MODE CHANGE$ IS LESS, WE MUST RUN FS MODE MAC$ + SKIPLE MODCHG ;IF IT IS POSITIVE, WE MUST RUN IT TOO. + CALL [ + CALL SAVACS + SETZM MODCHG ;CLEAR THE FLAG. + SETZB C,E ;PASS 0 AS ARG TO USER'S MACRO. + SKIPE A,MODMAC + CALL MACXCP ;CALL USER'S MACRO TO RECOMPUTE IT + JRST RSTACS] + CAME T,MORESW ;IF THE DESIRED STATE OF --MORE-- OR NOT IS CHANGED, + JRST DISMD9 + MOVE Q,$QMODE ;OR THE DESIRED MODE STRING IS CHANGED, WE MUST REDISPLAY THE LINE. + CAMN Q,DISOMD + RET +DISMD9: SKIPN RGETTY ;NO MODE IS SHOWN ON PRINTING TTY'S. + RET + SKIPE DFORCE ;DON'T UPDATE MODE IF FS D FORCE$ IS SET. + RET +DISMD2: MOVE Q,$QMODE + MOVEM Q,DISOMD +INSIRP PUSH P,A B TT TT1 BP CH + MOVE A,Q + CALL CLRMOR ;CLEAR THE WHOLE --MORE-- LINE. + SETOM RROHPO ;REMEMBER THAT I.T.S. CURSOR POS. IS BEING CLOBBERED. + SETOM RROVPO + CALL QLGET0 + JRST DISMD1 ;MODE STRING IS NULL? + MOVE TT,NHLNS ;NO => TRUNCATE IT IF TOO BIG TO A SIZE THAT WILL FIT + SKIPE T + SUBI TT,7 ;TOGETHER WITH THE --TOP-- OR WHATEVER. + TRNE T,MS%MOR ;OR, IF IT MIGHT BE --MORE---FLUSHED, + SUBI TT,9 ;LEAVE ROOM FOR THAT. + CAML B,TT + MOVE B,TT +DISMD3: SOJL B,DISMD1 ;DISPLAY THE ..J STRING, OR AS MANY CHARS OF IT AS B SAYS. + ILDB CH,BP +IFN ITS,[ ;OUTPUT WITH %TJECH SET SO CTL CHARS DON'T COME OUT IN IMAGE MODE. + SYSCAL IOT,[%CLIMM,,CHTTYO ? CH ? %CLBIT,,%TJECH] + .LOSE %LSFIL +] +.ELSE CALL TYOIN1 + JRST DISMD3 + +DISMD1: +INSIRP POP P,CH BP TT1 TT B A + MOVEM T,MORESW + JUMPE T,CPOPJ ;IF WE ARE SUPPOSED TO HAVE --MORE-- OR SOMETHING, WRITE IT. + SKIPN RGETTY + RET + TLNN T,-1 ;IF % ABOVE SCREEN IN LH IS NONZERO, PRINT THAT. + CAIN T,3 ;IF IN MIDDLE OF BUFFER BUT PERCENT IS 0, PRINT 1%. + JRST DISMD5 + CAIL T,5 ;WE SHOULDN'T GET HERE WANTING TO DISPLAY --MORE--FLUSHED! + .VALUE + MOVE Q,DISMD4-1(T) +IFN ITS,HRLI Q,-2 +IFN TNX,HRLI Q,-1 + JRST DISIOT + +DISMD4: +IFN ITS,[ + [ASCIC *--BOT--*] + [ASCIC *--TOP--*] + 0 + [ASCIC /--MORE--/] +] +IFN TNX,[ + [ASCIZ *--BOT--*] + [ASCIZ *--TOP--*] + 0 + [ASCIZ /--MORE--/] +] + +;OUTPUT --NN%-- WHERE N IS IN LH(T). +DISMD5: DISSTR /--/ + CALL DISIOT + SAVE CH + HLRZ CH,T + SKIPN CH ;PRINT 01% INSTEAD OF 00%, SINCE 00% WHEN NOT AT TOP + MOVEI CH,1 ;MIGHT BE PARADOXICAL. + IDIVI CH,10. + ADDI CH,"0 + CALL TYOINV + MOVEI CH,"0(Q) + CALL TYOINV + REST CH + DISSTR /%--/ + JRST DISIOT + +;CLEAR THE --MORE-- LINE. +CLRMOR: HRLZ BP,USZ + CALL SETCUR + JRST CLREOL + +SUBTTL CURSOR CONTROL SUBROUTINES + +IFN ITS,[ +;SCROLL Q LINES UP AND DOWN AT VPOS IN BP +SCRLUP: +SCRLDN: .VALUE ;ITS DOESNT SUPPORT THIS YET. + +;DELETE # OF LINES IN Q AT VPOS IN BP. +DELLIN: SAVE [%TDDLP] + JRST DELLI1 + +;INSERT # LINES IN Q AT VPOS IN BP. +INSLIN: SAVE [%TDILP] +DELLI1: SAVE [440800,,DISBF1] ;ACCUMULATE STRING IN DISBF1. + SAVE A + MOVEI A,%TDMV0 ;FIRST A COMAND TO SET DESIRED VPOS, AND HPOS 0. + IDPB A,-1(P) + IDPB BP,-1(P) + SETZ A, + IDPB A,-1(P) + MOVEI A,3 ;IF INSERTING/DELETING 0 LINES, JUST MOVE THE CURSOR. + JUMPE Q,DELLI2 ;DON'T PUT IN A %TDILP OR %TDDLP. + MOVE A,-2(P) ;THEN A COMMAND TO INSERT OR DELETE + IDPB A,-1(P) + IDPB Q,-1(P) ;THE SPECIFIED NUMBER OF LINES. + MOVEI A,5 +DELLI2: MOVE Q,[441000,,DISBF1] ;THEN OUTPUT THE STRING. + SYSCAL SIOT,[%CLIMM,,CHSIO ? Q ? A] + .LOSE %LSFIL + REST A + SUB P,[2,,2] + RET + +;OUTPUT C(T) CHARS STARTING AT DISBF1, WITH SUPER-IMAGE SIOT. +DISSIOT:MOVE Q,[441000,,DISBF1] + SKIPN RGETTY + MOVE Q,[441000,,DISBUF] + SKIPN RGETTY + SUBI T,4* +DISLI5: ILDB CH,Q ;SKIP ALL %TDNOP'S AT THE BEGINNING. + CAIN CH,%TDNOP + SOJG T,DISLI5 + JUMPE T,CPOPJ ;NO CHARS REALLY NEED TO BE SENT => RETURN. + ADD Q,[100000,,] + MOVEI CH,CHSIO + SKIPN RGETTY ;ON PRINTING TTYS, DON'T USE SUPER-IMAGE MODE. + MOVEI CH,CHTTYO +DISSI1: SYSCAL SIOT,[CH ? Q ? T] + .LOSE %LSFIL + SKIPN RGETTY + RET + MOVE Q,NHLNS + CAML Q,CHCRHP + MOVE Q,CHCRHP + SYSCAL SCPOS,[CH ? BP ? Q] + .LOSE %LSFIL + RET + +;MOVE CURSOR AND TELL ITS WHERE IT IS. ON A PRINTING TTY, DON'T ACTUALLY CHANGE +;THE VERTICAL POSITION, IN CASE THE TTY IS A STORAGE TUBE. CLOBBERS BP AND Q. +SETCUR: SKIPE RGETTY + JRST SETCU2 + SYSCAL RCPOS,[%CLIMM,,CHTTYO ? %CLOUT,,Q] + .LOSE %LSFIL + HLL BP,Q +SETCU2: CALL SETCU1 + HLRZ Q,BP + ANDI BP,-1 + SYSCAL SCPOS,[%CLIMM,,CHTTYO ? Q ? BP] + .LOSE %LSFIL + RET + +;MOVE CURSOR USING SUPERIMAGE MODE TO POSITION SPECD AS VPOS,,HPOS IN BP. +;CLOBBERS Q. +SETCU1: SAVE BP + SAVE [441000,,DISBF1] + SAVE A + MOVEI A,%TDMV0 + IDPB A,-1(P) + HLRZ Q,BP + IDPB Q,-1(P) + IDPB BP,-1(P) + MOVEI A,3 + JRST DELLI2 + +ECHOCR: .IOT CHECHO,[^M] + RET + +CLRSCN: HRROI Q,[ASCIC/C/] + JRST DISIOT + +HOMCUR: HRROI Q,[ASCIC/T/] + JRST DISIOT + +ERSCHR: HRROI Q,[ASCIC/K/] + JRST DISIOT + +;INSERT CHARACTERS. THE NUMBER TO INSERT IS IN A. +INSCHR: JUMPE A,CPOPJ + .IOT CHSIO,[%TDICP] + .IOT CHSIO,A + RET + +;DELETE CHARACTERS. THE NUMBER TO DELETE IS IN A. +DELCHR: JUMPE A,CPOPJ + .IOT CHSIO,[%TDDCP] + .IOT CHSIO,A + RET + +CRIF: HRROI Q,[ASCIC /A/] + JRST DISIOT + +CLREOL: HRROI Q,[ASCIC/L/] +DISIOT: .IOT CHDPYO,Q + RET + +;IMMEDIATE TYPEOUT, NO HASH-CODING. +TYOINV: .IOT CHTTYO,CH + POPJ P, +] ;IFN ITS + +IFN TNX,[ +;FUNDAMENTAL DISPLAY OPERATIONS, ON A TERMINAL-INDEPENDANT BASIS. + +;THE TTYTYP TABLE TRANSLATES TWENEX TERMINAL TYPE CODES TO TECO INTERNAL TERMINAL TYPES. +;THE TECO INTERNAL TYPE IS WHAT LIVES IN RGETTY. BY SETTING FS RGETTY, THE USER +;CAN CHOOSE ANY TERMINAL TYPE HE LIKES. +;INTERNAL TYPES 0 AND 1 ARE FOR PRINTING TTYS AND GLASS TTYS. +;HIGHER TYPE CODES ARE FOR DISPLAYS. + +DEFINE DEFTYP TYPE,TABLE,SYMBOL +IFNDEF TYPE,[ +PRINTX \GTTYP index for TYPE = \ +.TTYMAC FOO +IFB FOO,TYPE==-1 +.ELSE TYPE==FOO +IFG TYPE-NTTYPE+1,.ERR FOO is too large to be a GTTYP index +TERMIN +] +%%TYPE==%%TYPE+1 + +TABLE +SYMBOL==:%%TYPE + +IFG TYPE,[ +%%TMP==. +LOC TTYTYP+TYPE +%%TYPE +LOC %%TMP +] +TERMIN + + +NTTYPE==30. ;1+ LARGEST TWENEX TERMINAL TYPE. SIZE OF TTYTYP TABLE. +TTYTYP: BLOCK NTTYPE ;INTERNAL TYPE (RGETTY), INDEXED BY GTTYP TYPE + ;DEFTYP FILLS IN THE WORDS OF THIS TABLE. + +IF2 [ +PRINTX /GTTYP indices for "glass ttys", separated by commas: / +.TTYMAC TYPES +IRPS TYPE,,TYPES +IFG TYPE-NTTYPE+1,.ERR TYPE is too large to be a GTTYP index +LOC TTYTYP+TYPE + 1 +TERMIN TERMIN +LOC TTYTYP+NTTYPE +] + +;DEVICE DEPENDANT ROUTINE DISPATCH TABLE, INDEXED BY RGETTY +TTYTBS: PRINTB + GLASTB +%%TYPE==1 +DEFTYP DM2500,DM25TB,DM25I +DEFTYP H1500,HZ15TB,HZ15I +DEFTYP VT52,VT52TB,VT52I +DEFTYP DM1520,DM15TB,DM15I +DEFTYP IMLAC,IMLCTB,IMLCI +DEFTYP VT05,VT05TB,VT05I +DEFTYP TK4025,TK40TB,TK40I +DEFTYP VT61,VT61TB,VT61I +DEFTYP TL4041,TL40TB,TL40I +DEFTYP FOX,FOXTB,FOXI +DEFTYP HP2645,HPTB,HPI +DEFTYP I400,I400TB,I400I +DEFTYP TK4023,TK43TB,TK43I +DEFTYP ANNARB,AATB,AAI +DEFTYP C100,C100TB,C100I +DEFTYP IQ120,IQ12TB,IQ12I +DEFTYP VT100,VT10TB,VT100I +DEFTYP I100,I100TB,I100I +DEFTYP TL1061,TL40TB,TL106I +DEFTYP HEATH,HTHTB,HTHI +DEFTYP VC404,VC44TB,VC44I ;Volker-Craig. +DEFTYP CNCPT,CNCPTB,CNCPI ;CN Railroad Stupid Terminal. +DEFTYP TVI912,TVITB,TVII ;TeleVideo. May be ADM-2. +DEFTYP OWL,OWLTB,OWLI +DEFTYP BANTAM,BANTB,BANTI +DEFTYP DM3045,DM34TB,DM34I +DEFTYP DM3052,DM35TB,DM35I +DEFTYP HMOD1,HZM1TB,HMD1I ;Hazeltine Modular One + +MAXTTY==%%TYPE+1 + +PRINTB: 377777,,79. ;PRINTING TERMINAL DISPATCH VECTOR + (%TOOVR+%TOMVB+%TOLWR) +REPEAT 14,JFCL + +GLASTB: 377777,,79. ;"GLASS TTY" DISPATCH VECTOR + (%TOMVB+%TOLWR) +REPEAT 14,JFCL + +;;; HERE IS WHAT A TERMINAL TYPE TABLE LOOKS LIKE. + +IFN 0,[ + +;;; DISPATCH VECTOR FOR FOO TERMINAL. +FOOTB: 3000+24.,,79. ; 24 LINES, 79 COLS NOT INCLUDING CONTINUATION COLUMN. + ; 3 MSEC PER LINE MOVED FOR I/D LINE OPERATIONS. + ; THIS IS THE TOTAL FOR INSERTION PLUS DELETION. + ; IT WILL SOMEDAY BE USED FOR OPTIMIZATION CALCULATIONS. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) ; BITS SAYING WHAT TERMINAL CAN DO. +;;; REMAINING ENTRIES ARE INSTRUCTIONS WHICH MAY NOT CLOBBER ANYTHING BUT A +;;; UNLESS IT SAYS OTHERWISE FOR THE PARTICULAR ENTRY. + CALL FOOCPS ; MOVE CURSOR. B CONTAINS VPOS,,HPOS. CAN CLOBBER A,B. + CALL FOCEOL ; CLEAR TO END OF LINE. + CALL FOCEOS ; CLEAR TO END OF SCREEN (NOT VERY IMPORTANT). + CALL FOCLRS ; CLEAR SCREEN AND HOME CURSOR. + JFCL ; SLOT NOW UNUSED. + CALL FODSMV ; DEPOSIT APPROPRIATE CHARACTERS IN DISBF1. + ; GIVEN A VPOS IN BP AND HPOS IN DISCPH, STORES CHARACTERS + ; IN DISBF1 THROUGH DISBF1+5 TO MOVE THE CURSOR + ; TO THAT POSITION AND CLEAR THE ENTIRE LINE. + ; THIS WILL USUALLY INVOLVE MOVING TO THE FRONT OF THE LINE, + ; CLEARING TO END OF LINE, THEN MOVING TO THE FINAL SPOT. + ; IT IS MOST EFFICIENT TO USE THE LAST FEW WORDS OF DISBF1 + ; (AS MANY AS NECESSARY) LEAVING THE FIRST FEW WDS ALONE. + CALL FODMV1 ; LIKE THE PREVIOUS ROUTINE EXCEPT DON'T CLEAR THE LINE. + CALL FOINSL ; INSERT LINES. BP SAYS WHICH VPOS, Q SAYS HOW MANY. + ; MAY CLOBBER A AND B. + CALL FODELL ; DELETE LINES. ARGS AS ABOVE. MAY CLOBBER A AND B. + CALL FOINSC ; INSERT CHARACTER AFTER THE CURSOR. + CALL FODELC ; DELETE CHARACTER AFTER THE CURSOR. + CALL FOORST ; TAKE TERMINAL OUT OF DISPLAY MODES USED BY TECO + ; (FOR RETURNING TO EXEC, ETC.). +] ;IFN 0 + +;SET CURSOR POSITION TO VPOS,,HPOS IN 2 +CURPOS: SETOM ECHOP +CURPS0: SAVE B ;SAVE DESIRED POSITION + CALL CURPS1 ;DO WORK FIRST + REST TTLPOS + RET +CURPS1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CURSOR POSITIONING + T,,2 ;ENTRY 2 IN DEVICE TABLE + +;DISPATCH BY RGETTY INTO TABLE INDEXED BY POINTER AFTER CALLER +DDPYTB: SAVE T + MOVE T,RGETTY ;GET INTERNAL TERMINAL TYPE + MOVE T,TTYTBS(T) ;GET DISPATCH VECTOR + XCT @(A) ;CALL APPROPRIATE ROUTINE + REST T + JRST POPAJ + +;CLEAR TO END OF LINE +CLREOL: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOL + T,,3 ;ENTRY 3 IN TABLE + +;CLEAR TO END OF SCREEN +CLREOS: SAVE A + JSP A,DDPYTB ;DISPATCH FOR CLEAR EOS + T,,4 ;ENTRY 4 IN TABLE + +;CLEAR SCREEN +CLRSCN: SAVE A + SETZM TTLPOS ;SAY WE ARE AT HOME + SETOM ECHOP + MOVE A,ECHOL0 ;FIRST LINE OF ECHO AREA + HRLZM A,ECHOPS ;RESET ECHO POSITION + JSP A,DDPYTB + T,,5 ;CLEAR SCREEN ENTRY 5 IN TABLE + +;INSERT LINES +INSLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT LINE + T,,11 ;ENTRY 11 IN TABLE + +;DELETE LINES +DELLIN: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE LINE + T,,12 ;ENTRY 12 IN TABLE + +;INSERT C(A) CHARACTERS +INSCHR: SAVE Q + MOVE Q,A + CALL INSCH1 + JRST POPQJ + +;INSERT C(Q) CHARACTERS. CLOBBERS Q. +INSCH1: JUMPE Q,CPOPJ + SAVE A + JSP A,DDPYTB ;DISPATCH FOR INSERT CHAR + T,,13 ;ENTRY 13 IN TABLE + +;DELETE C(A) CHARACTERS +DELCHR: JUMPE A,CPOPJ + CALL DELCH1 + SOJG A,.-1 + RET + +DELCH1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DELETE CHAR + T,,14 ;ENTRY 14 IN TABLE + +;SET UP DISBF1 TO CLEAR LINE FIRST +DISMOV: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMOV + T,,7 ;ENTRY 7 IN TABLE + +;DONT CLEAR IT, JUST GO THERE +DISMV1: SAVE A + JSP A,DDPYTB ;DISPATCH FOR DISMV1 + T,,10 ;ENTRY 10 IN TABLE + +;TAKE TERMINAL OUT OF DISPLAY MODE +DPYRST: SAVE A + JSP A,DDPYTB ;DISPATCH FOR TERMINAL RESET + T,,15 ;ENTRY 15 IN TABLE + +;SCROLL Q LINES UP +SCRLUP: SAVE A + JSP A,DDPYTB + T,,16 + +;SCROLL Q LINES DOWN +SCRLDN: SAVE A + JSP A,DDPYTB + T,,17 + +;LOW LEVEL INTERFACES TO DEVICE DEPENDANT ROUTINES + +DISSIO: JSR SAVABC ;SAVE ACS + SKIPN RGETTY + JRST [ MOVE B,[441000,,DISBUF] + SUBI T,4* + JUMPG T,DISSI2 + JRST POPCBA] + MOVE B,[441000,,DISBF1] +DISSI2: ILDB CH,B + JUMPN CH,DISSI3 ;FLUSH INITIAL NULLS + SOJG T,DISSI2 + JRST POPCBA ;NOTHING TO DO +DISSI3: MOVEI A,.PRIOU + ADD B,[100000,,0] ;MAKE BYTE POINTER + MOVNI C,(T) ;NUMBER OF CHARACTERS TO OUTPUT + SOUT + SETOM ECHOP ;NO LONGER IN ECHO AREA IF WE WERE + SKIPN RGETTY ;DONE IF PRINTING + JRST POPCBA + MOVE B,NHLNS + CAML B,CHCRHP + MOVE B,CHCRHP ;UPDATE HORIZONTAL POSITION + HRLI B,(BP) + MOVEM B,TTLPOS ;UPDATE CURSOR POSITION +IFN TK4025\ANNARB\HMOD1,[ + MOVE A,RGETTY ;HAVE TO KLUDGE CLEOL + CAIE A,AAI + CAIN A,TK40I + JRST DISSTK + CAIE A,HMD1I + JRST POPCBA +DISSTK: SKIPGE EOLFLG ;POSTPONED CLEARING NEEDED? + CALL CLREOL ;YES, FAKE IT +] ;TK4025\ANNARB\HMOD1 + JRST POPCBA + +;SET CURSOR POS TO VPOS,,HPOS IN BP. CLOBBERS AT MOST Q. +SETCU1:: +SETCUR: SKIPN RGETTY ;ON PRINTING TERMINAL + JRST SETCU2 ;USE BS OR SPACE TO DO WHAT WE CAN + SAVE B ;SAVE ACS + MOVE B,BP ;GET DESIRED POSITION +SETCU3: CALL CURPOS ;GO THERE + JRST POPBJ + +SETCU2: SAVE A ;HANDLE "CURSOR MOTION" ON PRINTING TTY + TRNN BP,-1 ;MOVE TO START OF LINE? + JRST [MOVEI A,^M ;YES, DO IT FAST + PBOUT + JRST POPAJ] + SAVE B + MOVEI A,.PRIOU + RFPOS ;GET CURRENT POSITION + ANDI B,-1 ;SHOULD ONLY BE ASKED TO HANDLE HORIZ MOTION + SUBI B,(BP) ;GET DIFFERENCE + JUMPE B,POPBAJ ;ALREADY THERE, NOTHING TO DO + MOVEI A,^H ;USE BS IF MOVING LEFT + JUMPL B,[MOVMS B ;BUT IF MOVING RIGHT + MOVEI A,40 ;USE SPACE + JRST .+1] + PBOUT + SOJG B,.-1 + JRST POPBAJ + +;RETURN CURSOR TO UPPER LEFT CORNER OF SCREEN. +HOMCUR: SAVE B + SETZ B, + CALL CURPOS + JRST POPBJ + +;OUTPUT ASCIZ STRING Q POINTS AT. +DISIOT: EXCH A,Q + PSOUT + EXCH A,Q + RET + +;OUTPUT A CHARACTER, PUTTING UPARROW BEFORE CONTROL CHARS AND RUBOUT. FOR THE MODE LINE. +TYOIN1: CAIN CH,ALTMOD + MOVEI CH,"$ + CAIE CH,177 + CAIGE CH,40 ;IN MODE LINE, IT'S GOOD FOR CR AND LF TO BE PRINTED WITH UPARROWS TOO. + CAIN CH,^I ;BUT NOT TAB, SINCE THAT CAN WORK OK AS A FORMATTER. + JRST TYOINV + SAVE A + MOVEI A,"^ + PBOUT + MOVE A,CH + XORI A,100 + PBOUT + JRST POPAJ + +;ITS-STYLE ASCII MODE OUTPUT. +TYOINV: SKIPN RGETTY ;SIMPLE ON PRINTING TERMINAL + JRST [ EXCH A,CH + PBOUT + EXCH A,CH + RET ] + SAVE A + SAVE B + MOVEI A,.PRIOU + MOVE B,TTLPOS + CAIN CH,^I + JRST [ADDI B,10 ;TAB - MOVE TO NEXT TAB STOP + TRZ B,7 + CALL CURPS0 + JRST POPBAJ] + CAIN CH,^J + ADD B,[1,,0] ;LF - MOVE TO NEXT LINE + CAIN CH,^M + TRZ B,-1 ;CR - MOVE TO START OF LINE + EXCH B,CH + BOUT + EXCH B,CH + CAIL CH,40 + AOJ B, ;PRINT CHAR, COUNT ONE POSITION + MOVEM B,TTLPOS + JRST POPBAJ + +;GET FRESH LINE +CRIF: SAVE A + SAVE B + MOVEI A,.PRIOU + RFPOS + HRROI A,[ASCIZ/ +/] + TRNE B,-1 + PSOUT + JRST POPBAJ + +SUBTTL SIMULATE ITS ECHO AND ^P FOR TWENEX + +;ECHO CHARACTER IN CH, IN THE ECHO AREA. +ECHOC0: HRROS (P) ;FLAG THAT CR SHOULD COME OUT AS STRAY ONE + CAIA +ECHOCH: HRRZS (P) + SAVE CH + TRZE CH,CONTRL + TRZ CH,100 + ANDI CH,177 ;CLEAR OTHER RANDOM BITS + CAIN CH,177 ;RUBOUTS DONT ECHO + JRST POPCHJ + CAIN CH,^J ;LF? + JRST ECHOLF + CAIN CH,^M ;CR? + JRST ECOCR0 + CAIN CH,33 ;ESC COMES OUT AS $ + MOVEI CH,"$ + CAIN CH,^I ;TAB? + JRST ECHOTB + CAIN CH,^H ;BS? + JRST ECHOBS + CAIL CH,40 ;CONTROL-MUMBLE? + JRST ECHOC3 + MOVEI CH,"^ ;YES, PRINT ^-MUMBLE + CALL ECHOC1 + MOVE CH,(P) + TRO CH,100 +ECHOC3: CALL ECHOC1 ;PRINT SINGLE CHARACTER + JRST POPCHJ + +ECHOLF: SKIPN RGETTY + JRST ECHLF3 +ECHLF1: CALL ECHOC2 ;ADVANCE TO NEXT LINE + JRST POPCHJ +ECHLF3: CALL ECHLF2 + JRST POPCHJ + +ECHLF2: SAVE A + SAVE B + MOVEI A,.PRIOU ;MONITOR WONT LET US TYPE A BARE LF, SO... +IFN 20X,[ + RFPOS + SAVE B + TRZ B,-1 ;FIRST PRETEND WE ARE AT THE LEFT MARGIN ALREADY + SFPOS +] + MOVEI B,^J ;THEN TYPE IT + BOUT +IFN 20X,[ + RFPOS ;GET LINE IT THINKS THAT PUTS US ON + HLLM B,(P) + REST B ;AND SET UP TO REALLY BE IN MIDDLE OF IT + SFPOS +] + JRST POPBAJ + +ECHOCR: HRRZS (P) ;ALWAYS CRLF + SAVE CH + MOVEI CH,^M +ECOCR0: SKIPN RGETTY + JRST [CALL ECHOC1 ;ON PRINTING TTY, JUST TYPE IT + JRST POPCHJ] ;AND RETURN + HLLZS ECHOPS ;GO TO START OF THIS LINE + SKIPGE -1(P) ;OUTPUT STRAY CR? + JRST ECOTB2 ;YES, JUST GO TO START OF LINE THEN + JRST ECHLF1 ;ELSE ADVANCE A LINE AND CLEAR IT + +ECHOC1: SKIPE RGETTY + CALL ECOPOS + EXCH CH,A + PBOUT + EXCH CH,A + SKIPN RGETTY + RET + AOS CH,ECHOPS + ANDI CH,-1 ;GET HPOS + CAMGE CH,NHLNS + JRST ECHOC4 ;STILL WITHIN RANGE + HLLZS ECHOPS ;START OF NEW LINE +ECHOC2: HLRZ CH,ECHOPS + AOJ CH, + CAML CH,NVLNS + HRRZ CH,ECHOL0 + HRLM CH,ECHOPS + CALL ECOPS0 + JRST CLREOL + +ECHOC4: MOVE CH,ECHOPS ;MAKE SURE KNOW OUR POSITION RIGHT + MOVEM CH,TTLPOS + RET + +ECHOTB: SKIPN RGETTY + JRST ECHOC3 + HRRZ CH,ECHOPS + ADDI CH,8 + TRZ CH,7 + CAML CH,NHLNS + SETZ CH, + HRRM CH,ECHOPS + JUMPE CH,ECHLF1 ;ADVANCE TO NEXT LINE IF WRAP AROUND +ECOTB2: CALL ECOPS0 + JRST POPCHJ + + +ECHOBS: SKIPN RGETTY + JRST ECHOC3 + SOS CH,ECHOPS ;DECREMENT POSITION + TRNE CH,400000 ;BUT DON'T WRAP AROUND + AOS ECHOPS + JRST ECOTB2 + +ECOPS0: SETOM ECHOP ;HERE TO BE SURE WE GO THERE FIRST +ECOPOS: AOSE ECHOP + RET + SAVE A + SAVE B + MOVE B,ECHOPS + CALL CURPS0 + JRST POPBAJ + +;SIMULATE DISPLAY TYPEOUT IN ECHO AREA (IE INTERPRET ^P CODES) +ECHODP: AOSG C,ECODPF ;HAD A ^P LAST TIME? + JRST ECODP0 ;YES, OF SOME SORT + CAIE CH,^P ;^P NOW? + JRST ECHOC1 ;THAT WAS EASY ENUF + SETOM ECODPF ;YES, SAY SO FOR NEXT TIME + RET +ECODP0: AOJLE C,ECODP1 ;^PH OR ^PV? + SETZM ECODPF + SKIPGE C,ECODTB-"A(CH) + CALL ECOPOS ;SEE IF WE SHOULD MOVE TO RIGHT SPOT FIRST + JRST (C) ;DISPATCH FOR THIS ONE + +ECODP1: AOJLE C,ECODP2 ;^PV SEEN? + MOVEI C,-10(CH) ;GET DESIRED HPOS + CAMLE C,NHLNS + MOVE C,NHLNS + HRRM C,ECHOPS +ECODP3: SETZM ECODPF + JRST ECOPS0 ;MOVE THE CURSOR THERE + +ECODP2: MOVEI C,-10(CH) ;GET DESIRED VPOS + SETZM ECODPF + CAMGE C,ECHOL0 + MOVE C,ECHOL0 + CAMLE C,NVLNS + MOVE C,NVLNS ;GET IT IN RANGE + JRST ECODP3 + +ECODTB: ECODPA ;A - ADVANCE TO FRESH LINE + ECODPB ;B - MOVE BACKWARD + ECODPC ;C - CLEAR ECHO AREA + ECHOC2 ;D - MOVEM DOWN + -1,,CLREOS ;E - CLEAR TO END OF SCREEN + ECODF0 ;F - MOVE FORWARD + CPOPJ ;G + ECODPH ;H - SET HORIZONTAL POSITION + CPOPJ ;I + CPOPJ ;J + -1,,ECODPK ;K - ERASE CURRENT CHARACTER POSITION + -1,,CLREOL ;L - CLEAR TO END OF LINE + CPOPJ ;M - MORE - SHOULNDT BE DOING THAT, RIGHT? + CPOPJ ;N - DITTO + CPOPJ ;O + ECODPP ;P - OUTPUT ^P + ECODPQ ;Q - OUTPUT ^C + [MOVE C,ECODPS ? MOVEM C,ECHOPS ? JRST ECOPS0] ;R - RESTORE POSITION + [MOVE C,ECHOPS ? MOVEM C,ECODPS ? RET] ;S - SAVE POSITION + ECODPT ;T - GO TO TOP OF ECHO AREA + ECODPU ;U - MOVE UP + ECODPV ;V - SET VERTICAL POSITION + CPOPJ ;W + ECODPX ;X - BACKSPACE AND ERASE CHARACTER + CPOPJ ;Y + ECODPZ ;Z - HOME DOWN + -1,,INSLIN ;[ INSERT LINE + -1,,DELLIN ;\ DELETE LINE + -1,,CLREOL ;] SAME AS ^PL + -1,,INSCHR ;^ INSERT CHARACTER + -1,,DELCHR ;_ DELETE CHARACTER + +ECODPA: MOVE C,ECHOPS ;^PA - MOVE TO FRESH LINE + TRNN C,-1 ;AT START OF A LINE NOW? + RET ;YES + JRST ECHOCR ;NO, TYPE CRLF + +ECODPB: HRRZ C,ECHOPS ;^PB - MOVE BACKWARD + SOJL C,ECODB2 +ECODB1: HRRM C,ECHOPS ;STILL WITHIN RANGE, GO THERE + JRST ECOPS0 +ECODB2: MOVE C,NHLNS ;MOVE TO LAST LINE - 2 + SUBI C,2 + HRRM C,ECHOPS + JRST ECODPU ;AND UP A LINE + +ECODPC: SKIPN RGETTY ;^PC - CLEAR ECHO AREA + JRST ECHOCR ;TYPE CRLF ON PRINTING TERMINAL + CALL ECODPT ;MOVE TO TOP OF ECHO AREA + JRST CLREOS ;AND CLEAR TO END OF SCREEN + +ECODF0: HRRZ C,ECHOPS ;^PF - MOVE FORWARD + AOJ C, + CAMLE C,NHLNS + SETZ C, ;WRAP AROUND ON THE SAME LINE + JRST ECODB1 ;GO THERE + +ECODPH: SKIPA C,[-2] ;^PH - SET HORIZONTAL POSITION +ECODPV: MOVNI C,3 ;^PV - SET VERTICAL POSITION + MOVEM C,ECODPF + RET + +ERSCHR: +ECODPK: +IFN IMLAC,[ + MOVE A,RGETTY + CAIN A,IMLCI ;BS OVERWRITES ON IMLAX + SKIPA A,[-1,,[.BYTE 7 ? 177 ? 204-176 ? 0]] +] + HRROI A,[.BYTE 7 ? 40 ? 10 ? 0] ;^PK - ERASE CURRENT CHAR + PSOUT + RET + +ECODPP: SKIPA CH,[^P] ;^PP - TYPE ^P +ECODPQ: MOVEI CH,^C ;^PQ - TYPE ^C + JRST ECHOC1 ;JUST TYPE IT OUT + +ECODPZ: MOVE C,NVLNS ;^PZ - HOME DOWN + SOSA C ;NUMBER OF LINES -1 +ECODPT: MOVE C,ECHOL0 ;^PT MOVE TO TOP + HRLZM C,ECHOPS + JRST ECOPS0 ;GO THERE + +ECODU2: SKIPA C,NVLNS ;GO TO BOTTOM LINE +ECODPU: HLRZ C,ECHOPS ;^PU - MOVE UP + SOJL C,ECODU2 ;STILL IN RANGE? + HRLM C,ECHOPS + JRST ECOPS0 ;YES, GO THERE + +ECODPX: MOVE C,ECHOPS ;^PX ERASE LAST CHARACTER + TRNN C,-1 ;AT START OF LINE? + JRST ECODX2 + CALL ECOPOS + SOJ C, + MOVEM C,ECHOPS + MOVEI A,^H + PBOUT + JRST ECODPK +ECODX2: HRR C,NHLNS + SUB C,[1,,2] + MOVEM C,ECHOPS + CALL ECOPS0 ;MOVE TO LAST COL -2 OF LAST LINE + JRST CLREOL ;AND CLEAR TO END + +IFN DM2500,[ +SUBTTL DM2500 + +DM25TB: 2000+24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) + CALL DMCPS + CALL DMCEOL + CALL DMCEOL ;CLOSEST WE CAN COME + CALL DMCLRS + JFCL + CALL DMDSMV + CALL DMDMV1 + CALL DMINSL + CALL DMDELL + CALL DMINSC + CALL DMDELC + CALL DMRST + +DMCPS: JUMPE B,[MOVEI A,^B ;HOME IS EASY + PBOUT + RET] + MOVEI A,^L ;ELSE ^L + PBOUT + HRRZ A,B + XORI A,"` + PBOUT + HLRZ A,B + XORI A,"` +DMCP2: PBOUT + RET + +DMCEOL: MOVEI A,^W + JRST DMCP2 + +DMCLRS: MOVEI A,^^ + PBOUT ;[ +DMRST: MOVEI A,^] ;RESTORE ROLL MODE + JRST DMCP2 + +DMINSL: SAVE C + SAVE B + CALL DMINS1 ;POSITION RIGHT AND ENTER I/D MODE + MOVEI A,30. ;COMPUTE AMOUNT OF FILL NEEDED + SUBI A,(BP) ;((30.-(BP))*OSPEED-2400.)/14400. + JUMPL A,[SETZ B, + JRST DMINS2] + SKIPN B,OSPEED ;SPEED OF OUTPUT + MOVEI B,9600. ;ASSUME MAX IF UNKNOWN + IMULI B,(A) + SUBI B,2400. + IDIVI B,14400. ;MAGIC NUMBER IN B +DMINS2: MOVEI A,^J ;INSERT A LINE + PBOUT + MOVEI A,177 ;FILL CHARACTER + SKIPE C,B ;GET NUMBER OF FILL CHARS NEEDED + PBOUT + SOJG C,.-1 ;OUTPUT THAT MANY + SOJG Q,DMINS2 ;REPEAT FOR NUMBER OF LINES REQUESTED + REST B +DMINS3: REST C + MOVEI A,^X + JRST DMCP2 + +DMDELL: SAVE C + CALL DMINS1 +DMDEL2: MOVEI A,^Z ;DELETE A LINE + PBOUT + MOVEI A,177 ;ONE FILL CHAR + SKIPE C,OSPEED + CAIL C,9600. + PBOUT ;ONLY FOR 9600 BAUD OR MORE THOUGH + SOJG Q,DMDEL2 + JRST DMINS3 + +DMINS1: HRROI A,[.BYTE 7 ? ^L ? "` ? 0] + PSOUT + MOVEI A,(BP) + XORI A,"` + PBOUT + MOVEI A,^P + PBOUT + RET + +DMDSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 + XOR B,[.BYTE 8 ? ^L ? "` ? "` ? ^W] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST DMDSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL DMDSM1 + LSH A,4 +DMDSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST POPBJ + +DMDSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + XOR B,[.BYTE 8 ? 0 ? ^L ? "` ? "`] + RET + +DMDMV1: SAVE B + SETZB A,B + CALL DMDSM1 + JRST DMDSM2 + +DMINSC: SAVE C + HRROI A,[.BYTE 7 ? ^P ? ^\ ? ^X ? 0] + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + HRROI A,[.BYTE 7 ? ^P ? 40 ? 177 ? ^X ? ^H ? 40 ? ^H] ;USE HAIRY ONE + PSOUT + REST C + SOJG Q,DMINSC + RET + +DMDELC: HRROI A,[.BYTE 7 ? ^P ? ^H ? 0] + PSOUT + SAVE C + MOVEI A,177 + SKIPE C,OSPEED + CAIL C,9600. ;IF AT 9600 OR MORE, + PBOUT ;NEED ONE FILL CHAR + JRST DMINS3 +] ;DM2500 + +IFN H1500\HMOD1,[ +SUBTTL H1500 AND HAZELTIME MODULAR ONE + +IFN HMOD1,[ +HZM1TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR HZ1500 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL HZCPS + CALL HZ1EOL + CALL HZ1EOS + CALL HZCLRS + JFCL + CALL HZ1DSM + CALL HZDMV1 + CALL HZINSL + CALL HZDELL +REPEAT 3,JFCL +] ;HMOD1 + +IFN H1500,[ +HZ15TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR HZ1500 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL HZCPS + CALL HZCEOL + CALL HZCEOS + CALL HZCLRS + JFCL + CALL HZDSMV + CALL HZDMV1 + CALL HZINSL + CALL HZDELL +REPEAT 3,JFCL +];H1500 + +HZCPS: SAVE C + MOVE C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRRZ A,B + ADDI A,140 + CAIL A,177 + SUBI A,140 + DPB A,[170700,,C] + HLRZ A,B + LSH A,7+1 + IOR C,A + HRROI A,C + PSOUT + REST C + RET + +IFN H1500,[ ;THE STUPID MODULAR ONE DOESN'T HAVE THESE FUNCTIONS. +HZCEOL: HRROI A,[.BYTE 7 ? 176 ? ^O ? 177 ?0] + PSOUT + RET + +HZCEOS: HRROI A,[.BYTE 7 ? 176? ^X ?177?177?177?177?177?0] + PSOUT + RET +];H1500 + +IFN HMOD1,[ +HZ1EOS: ;CEOL IS AS CLOSE AS WE CAN COME TO CEOS +HZ1EOL: PUSH P,A ;CLEAR TO END OF SCREEN - WE PUT OUT + PUSH P,B ; ENOUGH SPACES TO GET TO END OF LINE + PUSH P,C ; EXCEPT IF AT LEFT HAND, KILL THE LINE + SKIPGE C,EOLFLG ; NO. OF SPACES SET? + JRST HZ1EO1 ; YES, USE THAT + HRRZ C,TTLPOS ;C _ CURRENT POSITION + JUMPE C,HZ1DIL ;IF C = 0 THEN DELETE; INSERT + SUBI C,80. ;C _ - (80 - CURPOS) = NO. SPACES NEEDED +HZ1EO1: HRROI B,SPACES + MOVEI A,.PRIOU + SOUT ;PUT OUT THAT MANY SPACES + SETZM EOLFLG + MOVE B,TTLPOS ;GO BACK WHERE WE WERE BEFORE + CALL HZCPS + JRST POPCBA + +HZ1DIL: HRROI A,[.BYTE 7 ? 176 ? 19. ? 176 ? 26. ? 0] ;DELETE, INSERT LINE + PSOUT + JRST POPCBA +] ;HMOD1 + +HZCLRS: HRROI A,[.BYTE 7 ? 176? ^\ ?177?177?177?177?0] + PSOUT + RET + +HZINSL: CALL HZIDPS +HZINS1: HRROI A,[.BYTE 7 ? 176 ? ^Z ? 0] + PSOUT + MOVEI A,32. + CALL EXPPAD + SOJG Q,HZINS1 + RET + +HZDELL: CALL HZIDPS +HZDEL1: HRROI A,[.BYTE 7 ? 176 ? ^S ? 0] + PSOUT + MOVEI A,4 + CALL EXPPAD + SOJG Q,HZDEL1 + RET + +HZIDPS: SAVE C + MOVEI C,140(BP) + LSH C,7+1 + IOR C,[.BYTE 7 ? 176 ? ^Q ? "` ? "` ? 0] + HRROI A,C + PSOUT + REST C + RET + +IFN H1500,[ +;MOVE TO LINE START, CEOL, MOVE TO HPOS ON SAME LINE +HZDSMV: SAVE B + MOVEI A,(BP) ;DESIRED VPOS + LSH A,4 + IOR A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] ;MOVE TO LINE START + MOVE B,[.BYTE 8 ? 176 ? ^O ? 177 ? 177] ;CEOL + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + SETZM DISBF1+5 ;ASSUME NO HORIZ POSITIONING NECSY + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST POPBJ ;YES, DONT NEED SECOND CURSOR ADDRESS THEN +HZDSM2: MOVE A,[.BYTE 8 ? 176 ? ^Q ? "` ? "`] + CALL HZDSM1 + MOVEM A,DISBF1+5 + JRST POPBJ +] ;H1500 + +IFN HMOD1,[ +;THE MOD. 1 VERSION OF HZDSMV DEPENDS UPON THE EOLFLG KLUDGE TO DO +; THE CLEARING, SO IT IS OTHERWISE EQUIVALENT TO HZDMV1 ONLY +HZ1DSM: MOVE T,CHCRHP ; NEW LINE LENGTH + SUB T,LINEND(BP) ; MINUS OLD LINE LENGTH + MOVEM T,EOLFLG ; IS NEGATIVE NO. OF CHARACTERS TO CLEAR + ;JRST HZDSM1 +] ;IFN HMOD1 + +HZDSM1: SAVE A + DPB BP,[041000+P,,] ;VPOS + MOVE B,DISCPH + DPB B,[141000+P,,] ;HPOS + JRST POPAJ + +HZDMV1: SAVE B + SETZM DISBF1+3 ? SETZM DISBF1+4 + JRST HZDSM2 + +] ;H1500 + +IFN VT52\VT61\VT100\TL4041\TL1061\HEATH,[ +SUBTTL VT52S OF VARIOUS SORTS + +IFN VT52,[ +VT52TB: 24.,,79. ;DISPATCH VECTOR FOR VIRGIN VT52 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + JFCL + CALL VTDSMV + CALL VTDMV1 +REPEAT 5,JFCL +] ;VT52 +IFN VT61,[ +VT61TB: 24.,,79. ;DISPATCH VECTOR FOR VT61 +IFE VT61-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + JFCL + CALL VTDSMV + CALL VTDMV1 + CALL VTINSL + CALL VTDELL + CALL VTINSC + CALL VTDELC + JFCL + +;THE VT61 FLAVOUR OF I/D LINE/CHAR FOR A VT52 +VTINSL: SKIPA A,["F] ;$PF - INSERT LINE +VTDELL: MOVEI A,"D ;$PD - DELETE LINE + SAVE A + MOVEI A,"Y + CALL OUTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT +VTINS1: MOVEI A,"P + CALL OUTESC + MOVE A,(P) ;GET DESIRED FUNCTION AGAIN + PBOUT + SOJG Q,VTINS1 + JRST POPAJ + +VTDELC: HRROI A,[.BYTE 7 ? 33 ? "P ? "S ? 0] + PSOUT + RET + +VTINSC: HRROI A,[.BYTE 7 ? 33 ? "P ? "I ? 40 ? 33 ? "P ? "I+40 ? 10 ? 0] + PSOUT + SOJG Q,VTINSC + RET +] ;VT61 + +IFN TL4041\TL1061,[ +TL40TB: 8.*1000+24.,,79. ;DISPATCH VECTOR FOR TELERAY 4041 +IFE TL1061-VT52,IFE TL4041-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOFCI) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + JFCL + CALL VTDSMV + CALL VTDMV1 + CALL TLINSL + CALL TLDELL + CALL TLINSC + CALL TLDELC + JFCL + +;THE TELERAY 4041 VERSION OF I/D LINE/CHAR +TLINSL: SKIPA A,["L] ;$L - INSERT LINE +TLDELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"Y + CALL OUTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT + REST A ;GET DESIRED FUNCTION AGAIN +TLDEL1: CALL OUTESC + SAVE A + MOVE A,RGETTY + CAIE A,TL106I + JRST TLDEL2 + MOVEI A,50. + CALL TIMPAD +TLDEL2: REST A + SOJG Q,TLDEL1 + RET + +TLDELC: MOVEI A,"Q + JRST OUTESC + +TLINSC: MOVEI A,"P + CALL OUTESC + SOJG Q,TLINSC + RET +] ;TL4041,TL1061 + +IFN VT100,[ +VT10TB: 24.,,79. ;DISPATCH VECTOR FOR VT100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) ;HAS BETTER THAN LID + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VT1CLR + JFCL + CALL VTDSMV + CALL VTDMV1 +REPEAT 4,JFCL ;LID ROUTINES NEVER GET CALLED + CALL VT1RST + CALL VT1SUP + CALL VT1SDN + + +VT1CLR: HRROI A,[ASCIZ "<[?2lHJ"] ;] + PSOUT + RET + +VT1RST: HRROI A,[ASCIZ /<78/] ;] RESET SCROLL REGION + PSOUT + RET + +;SCROLL Q LINES STARTING WITH LINE IN BP UP +VT1SUP: PUSH P,["D] ;INDEX NEEDED TO CAUSE SCROLLING (DOESNT TAKE ARGUMENT) + JSP A,VT1SCR ;SETUP SCROLL REGION AND BYTE POINTER IN A + MOVE B,BOTLIN ;POSITION TO BOTTOM OF SCROLL REGION, OFFSET +VT1UP2: CALL VT1ARG + MOVEI B,"H + IDPB B,A + MOVEI B,0 + IDPB B,A ;MAKE ASCIZ OF POSITIONING STUFF + HRROI A,VT1BUF + PSOUT ;TYPE IT ALL OUT +VT1UP3: MOVE A,-2(P) ;GET CURSOR COMMAND + CALL OUTESC ;SCROLL RIGHT DIRECTION + MOVEI A,10. + CALL EXPPAD + SOJG Q,VT1UP3 + HRROI A,[ASCIZ /[?2l/] ;] BACK INTO VT52 MODE (MAYBE ALWAYS ANSI?) + PSOUT + JRST POPCBA ;ALSO FLUSH SCROLLING COMMAND + +VT1SDN: PUSH P,["M] ;REVERSE INDEX TO SCROLL + JSP A,VT1SCR ;SETUP SCROLL REGION + MOVEI B,1(BP) ;MOVE TO TOP LINE, OFFSET + JRST VT1UP2 + +VT1SCR: PUSH P,B + PUSH P,C + PUSH P,A ;SAVE RETURN ADDRESS AS WELL + MOVE A,[440700,,VT1BUF] ;MAKE STRING POINTER + MOVEI B,33 + IDPB B,A + MOVEI B,"< ;ENTER ANSI MODE + IDPB B,A + MOVEI B,1(BP) ;STARTING LINE, OFFSET + CALL VT1ARG + MOVEI B,"; + IDPB B,A + MOVE B,BOTLIN ;BOTTOM LINE, OFFSET + CALL VT1AR1 + MOVEI B,"r ;SET SCROLL REGION + IDPB B,A + RET + +VT1ARG: MOVEI C,33 + IDPB C,A + MOVEI C,"[ ;] + IDPB C,A +VT1AR1: IDIVI B,10. + JUMPE B,VT1AR2 ;NO TENS DIGIT + ADDI B,"0 + IDPB B,A ;ELSE PUT IT IN +VT1AR2: ADDI C,"0 + IDPB C,A ;AND DIGITS + RET +];VT100 + +IFN HEATH,[ +HTHTB: 5*1000+24.,,79. +IFE HEATH-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ; IF SAME TO SYSTEM, USER WILL + ; SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ; ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + JFCL + CALL VTDSMV + CALL VTDMV1 + CALL HTINSL + CALL HTDELL + CALL HTINSC + CALL HTDELC + JFCL + +HTINSC: MOVEI A,"@ + CALL OUTESC + CALL OUTNSP + MOVEI A,^H + CALL OUTN + MOVEI A,"O + JRST OUTESC + +HTDELC: MOVEI A,"N + JRST OUTESC + +HTINSL: SKIPA A,["L] +HTDELL: MOVEI A,"M + SETZM PADCHR ;MUST USE NULLS FOR PADDING + SAVE A + MOVEI A,"Y + CALL OUTESC + MOVEI A,40(BP) + PBOUT + MOVEI A,40 + PBOUT + CAILE Q,3 ;;;IF OVER 2 + JRST HTANSI ;USE ANSI MODE +HTINS1: MOVE A,(P) + CALL OUTESC + MOVEI A,30 + CALL TIMPAD + SOJG Q,HTINS1 + JRST POPAJ + +HTANSI: HRROI A,[ASCIZ "<["] ; ] + PSOUT + MOVE A,Q + IDIVI A,10. + ADDI A,"0 + CAIE A,"0 + PBOUT + MOVEI A,"0(B) + PBOUT + REST A + PBOUT +HTANS1: MOVEI A,30 + IMULI A,(Q) + CALL TIMPAD + HRROI A,[ASCIZ "[?2h"] ; ] + PSOUT + RET + +] ;IFN HEATH + +VTCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST OUTESC] + MOVEI A,"Y ;ELSE SEND $Y + CALL OUTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + PBOUT + RET + +VTCEOL: MOVEI A,"K ;CLEAR EOL + JRST OUTESC + +VTCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL OUTESC +VTCEOS: MOVEI A,"J ;CLEAR EOS + CALL OUTESC + MOVE A,RGETTY + CAIE A,VT52I ;REAL VT52 NEEDS PADDING AFTER CLEAR SCREEN + RET + SAVE C + MOVE A,OSPEED ;ABOVE 4800 BAUD, TO AVOID ^S^Q LOSSAGE. + SETZ C, + CAIN A,9600. + MOVEI C,26. ;26 RUBOUTS AT 9600 BAUD, 5 AT 4800 + CAIE A,4800. ;(EMPIRICALLY DETERMINED. DON'T ASK ME WHY). + MOVEI C,5 + MOVE A,C + CALL EXPPAD + JRST POPCJ + +VTDSMV: SAVE B + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST VTDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $Y ? $K + MOVEM B,DISBF1+5 + JRST POPBJ +VTDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... + MOVEM B,DISBF1+4 + CALL VTDMV1 + JRST POPBJ + +VTDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] + MOVEM A,DISBF1+5 ;$Y + RET +] ;VT52 + +IFN FOX\OWL\BANTAM,[ +SUBTTL FOX AND OWL + +IFN FOX,[ +FOXTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER FOX + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL FXCPS + CALL FXCEOL + CALL FXCEOS + CALL FXCLRS + JFCL + CALL FXDSMV + CALL FXDMV1 +REPEAT 5,JFCL + REPEAT 5,JFCL +];FOX + +IFN OWL,[ +OWLTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER OWL + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL FXCPS + CALL FXCEOL + CALL OWCEOS + CALL OWCLRS + JFCL + CALL FXDSMV + CALL FXDMV1 + CALL OWINSL + CALL OWDELL + CALL OWINSC + CALL OWDELC + JFCL +];OWL + +IFN BANTAM,[ +BANTB: 24.,,79. ;DISPATCH VECTOR FOR PERKIN-ELMER BANTAM + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL FXCPS + CALL BTCEOL ; ONLY THESE THREE ARE DIFFERENT + CALL BTCEOS ; ... + CALL BTCLRS ; ... + JFCL + CALL FXDSMV + CALL FXDMV1 + REPEAT 5,JFCL +];BANTAM + +FXCPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST OUTESC] + MOVEI A,"X ;ELSE SEND $X + CALL OUTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,"Y ;$Y + CALL OUTESC + MOVEI A,40(B) ;+40 + PBOUT + RET + +FXCEOL: MOVEI A,"I ;CLEAR EOL + JRST OUTESC + +FXCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL OUTESC + MOVEI A,"J ;FOX NEEDS DELAY LIKE VT52 + CALL OUTESC ;TO ALLOW CLEAR TO WORK + MOVE A,OSPEED ;CHECK SPEED + CAIG A,2400. ;HIGH SPEED? + RET ;NO, EASY WAY + MOVEI A,100. ;DELAY 100 MSEC + DISMS ;SINCE SENDING PADDING MESSES SCREEN UP + RET + +FXCEOS: MOVEI A,"J ;CLEAR EOS + JRST OUTESC + +IFN OWL,[ +OWCLRS: MOVEI A,"H ;CLEAR SCREEN + CALL OUTESC +OWCEOS: MOVEI A,"J ;CLEAR EOS + CALL OUTESC + SAVE BP + MOVEI BP,0 ;OWL NEEDS PADDING FOR THIS. + CALL OWIDPD + JRST POPBPJ +];OWL + +FXDSMV: SAVE B + MOVEI B,(BP) ;DESIRED VPOS + SKIPE A,DISCPH ;DESIRED HPOS = 0? + JRST FXDSM2 ;NO, MUST GO THERE AFTERWARDS + LSH B,8+4 + ADD B,[.BYTE 8 ? 33 ? "X ? 40 ? 33] ;$X$ + MOVE A,[.BYTE 8 ? "Y ? 40 ? 33 ? "I] ;Y$I +FXDSM1: MOVEM B,DISBF1+4 + MOVEM A,DISBF1+5 + JRST POPBJ +FXDSM2: LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? 33 ? "X ? 40] ;$X + MOVEM B,DISBF1+3 + MOVE B,[.BYTE 8 ? 33 ? "Y ? 40 ? 33] ;$Y<0>$ + ADD A,[.BYTE 8 ? "I ? 33 ? "Y ? 40] ;I$Y + JRST FXDSM1 + +FXDMV1: MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "X] + MOVEM A,DISBF1+4 ;$X + MOVEI A,(BP) ;DESIRED VPOS + LSH A,24. + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 40 ? 33 ? "Y ? 40] + MOVEM A,DISBF1+5 ;$Y + +IFN OWL,[ +; OWINSL - OUTPUT OWL COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT +OWINSL: MOVEI A,"L ; $L - INSERT LINE + JRST OWDEL1 + +; OWDELL - OUTPUT OWL COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE +OWDELL: MOVEI A,"M ; $M - DELETE LINE +OWDEL1: SAVE B ; SAVE AC + MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. + SAVE A + CALL FXCPS ; MOVE TO DESIRED LINE NO. + REST A + MOVEI B,33 ; ESC +OWID1: EXCH A,B + PBOUT ; OUTPUT ESC + EXCH A,B + PBOUT ; OUTPUT "L" OR "M" + CALL OWIDPD ;PAD THE INSERT/DELETE. + SOJG Q,OWID1 + JRST POPBJ + +;PAD AN INSERT OR DELETE LINE OPERATION. +;EACH OPERATION REQUIRES 5MS PADDING PER LINE MOVED. +;THE VPOS OF THE LINE WE ARE OPERATING ON IS IN BP. +OWIDPD: SAVE A + MOVE A,NVLNS + SUB A,BP ;NUMBER OF LINES BEING MOVED. + IMULI A,5 + CALL TIMPAD + JRST POPAJ + +OWDELC: HRROI A,[ASCIZ "O"] + PSOUT + RET + +OWINSC: HRROI A,[.BYTE 7 ? " ? "N ? 40 ? 177 ? 177 ? 177 ? 177 ? ^H ? 0] + PSOUT + SOJG Q,OWINSC + RET +];OWL + +IFN BANTAM,[ +BTCEOS: ; HAVE TO JUST FAKE CLEAR TO EOS WITH CEOL +BTCEOL: SKIPA A,["I] ; CLEAR EOL +BTCLRS: MOVEI A, "K ; CLEAR SCREEN, NO MOVEMENT NEEDED + CALL OUTESC ; DO IT + MOVEI A,20. ; MUST PAD FOR 20 MS + JRST TIMPAD +] ;BANTAM +] ;FOX, OWL AND BANTAM + +IFN DM1520,[ +SUBTTL DM1520 + +DM15TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 1520 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL D1CPS + CALL D1CEOL + CALL D1CEOS + CALL D1CLRS + JFCL + CALL D1DSMV + CALL D1DMV1 +REPEAT 5,JFCL + +D1CPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY + PBOUT + RET] + MOVEI A,^^ ;ELSE ^^ + PBOUT + MOVEI A,40(B) + PBOUT + HLRZ A,B + ADDI A,40 +D1CP2: PBOUT + RET + +D1CEOS: MOVEI A,^K ;ERASE EOS + JRST D1CP2 ;[ +D1CEOL: MOVEI A,^] ;ERASE EOL + JRST D1CP2 +D1CLRS: MOVEI A,^L ;ERASE SCREEN + JRST D1CP2 + +D1DSMV: SAVE B + SETZB A,B + MOVEI B,(BP) ;DESIRED VPOS + LSH B,8+4 ;[ + ADD B,[.BYTE 8 ? ^^ ? 40 ? 40 ? ^] ] + SKIPN DISCPH ;DESIRED HPOS = 0? + JRST D1DSM2 ;YES, DONT NEED SECOND CURSOR ADDRESS THEN + LSHC A,16.-4 + CALL D1DSM1 + LSH A,4 +D1DSM2: MOVEM A,DISBF1+4 + MOVEM B,DISBF1+5 + JRST POPBJ + +D1DSM1: IOR B,DISCPH + LSHC A,8. + IORI B,(BP) + LSHC A,4 + ADD B,[.BYTE 8 ? 0 ? ^^ ? 40 ? 40] + RET + +D1DMV1: SAVE B + SETZB A,B + CALL D1DSM1 + JRST D1DSM2 +] ;DM1520 + +IFN DM3052,[ +DM35TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 3000 +IFE DM3052-VT52,(%TOERS+%TOMVB+%TOMVU+%TOLWR) ;IF SAME TO SYSTEM, USER WILL SET FSI&DXXX +.ELSE (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ;ELSE KNOW HAS THESE + CALL VTCPS + CALL VTCEOL + CALL VTCEOS + CALL VTCLRS + JFCL + CALL VTDSMV + CALL VTDMV1 + CALL D5INSL + CALL D5DELL + CALL D5INSC + CALL D5DELC + JFCL + +D5DELC: HRROI A,[.BYTE 7 ? 33 ? "P ? 33 ? "D ? 33 ? "Q ? 0] + PSOUT + RET + +D5INSC: MOVEI A,"P + CALL OUTESC ;ENTER INSERT MODE + CALL OUTNSP ;INSERT SPACES + MOVEI A,"Q ;LEAVE INSERT MODE + CALL OUTESC + MOVEI A,^H ;BACK OVER THEM. + JRST OUTN + +D5INSL: SAVE B ;SAVE AC + MOVS B,BP ;VTCPS ARG + CALL VTCPS ;MOVE TO LOCATION + MOVEI A,"P ;TURN INSERT DELETE MODE ON + CALL OUTESC + MOVEI A,12 ;LINE FEED GETS US INSERT LINE + CALL OUTN + MOVEI A,"Q ;TURN OFF INSERT DELETE MODE + CALL OUTESC + JRST POPBJ + +D5DELL: SAVE B ;SAVE AC + MOVS B,BP ;VTCPS ARG + CALL VTCPS ;MOVE TO LOCATION + MOVEI A,"P ;TURN INSERT DELETE MODE ON + CALL OUTESC +D5DL1: MOVEI A,"A ; A DELETES A LINE + CALL OUTESC + SOJG Q,D5DL1 ;MORE LINES... + MOVEI A,"Q ;TURN OFF INSERT DELETE MODE + CALL OUTESC + JRST POPBJ +] ;DM3052 + +IFN DM3045,[ +SUBTTL DM3045 +DM34TB: 24.,,79. ;DISPATCH VECTOR FOR DATAMEDIA 3000 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) ;KNOW HE HAS THESE + CALL D3CPS + CALL D3CEOL + CALL D3CEOS + CALL D3CLRS + JFCL + CALL D3DSMV + CALL D3DMV1 + JFCL + JFCL + CALL D3INSC + CALL D3DELC + JFCL + +D3CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST OUTESC] + MOVEI A,"Y ;ELSE SEND $Y + CALL OUTESC + HRRZ A,B + ADDI A,40 ;+40 + PBOUT + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + RET + +D3CEOL: MOVEI A,"K ;CLEAR EOL + JRST OUTESC + +D3CLRS: MOVEI A,"H ;CLEAR SCREEN + CALL OUTESC +D3CEOS: MOVEI A,"J ;CLEAR EOS + JRST OUTESC + +D3DSMV: SAVE B + MOVEI B,40(BP) + LSH B,16.+4 + IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "Y] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST D3DSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $Y ? $K + MOVEM B,DISBF1+5 + JRST POPBJ + +D3DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $Y ? $K ? ... + MOVEM B,DISBF1+4 + CALL D3DMV1 + JRST POPBJ + +D3DMV1: MOVE A,DISCPH ;DESIRED HPOS + LSH A,8 + IOR A,BP + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "Y ? 40 ? 40] + MOVEM A,DISBF1+5 ;$Y + RET + +D3DELC: MOVEI A,"B + JRST OUTESC + +D3INSC: MOVEI A,"R + CALL OUTESC + SOJG Q,D3INSC + RET +] ;DM3045 + +IFN IMLAC,[ +SUBTTL IMLAX + +IMLCTB: 44.,,88. ;DISPATCH TABLE FOR IMLAX + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID+%TOOVR) + CALL IMCPS + CALL IMCEOL + CALL IMCEOS + CALL IMCLRS + JFCL + CALL IMDSMV + CALL IMDMV1 + CALL IMINSL + CALL IMDELL + CALL IMINSC + CALL IMDELC + JFCL + +IMCPS: MOVEI A,217 ;%TDMV0 + CALL IMCEO2 + HLRZ A,B ;VPOS + AOJ A, ;AVOID SENDING NULL + PBOUT + MOVEI A,1(B) ;HPOS +IMCPS2: PBOUT + RET + +IMCEOS: MOVEI A,202 ;%TDEOF +IMCEO2: SAVE A + MOVEI A,177 ;SEND > 200 BY ESCAPING FIRST + PBOUT + REST A + SUBI A,176 ;SEND REST + JRST IMCPS2 +IMCEOL: MOVEI A,203 ;%TDEOL + JRST IMCEO2 +IMCLRS: MOVEI A,220 ;%TDCLR + JRST IMCEO2 + +IMINSL: SKIPA A,[223] ;%TDILP +IMDELL: MOVEI A,224 ;%TDDLP + SAVE A ;SAVE DESIRED FUNCTION + MOVEI A,217 ;%TDMV0 TO BEGINNING OF DESIRED LINE + CALL IMCEO2 + MOVEI A,1(BP) ;VPOS + PBOUT + MOVEI A,1 + PBOUT + REST A ;GET BACK DESIRED FUNCTION + CALL IMCEO2 + MOVEI A,(Q) ;GET REPEAT COUNT + JRST IMCPS2 + +IMINSC: MOVEI A,225 ;%TDICP + CALL IMCEO2 + MOVE A,Q ;NUMBER OF CHARS TO INSERT. + JRST IMCPS2 + +IMDELC: MOVEI A,226 ;%TDDCP + CALL IMCEO2 + MOVEI A,1 + JRST IMCPS2 + +IMDSMV: SAVE B + MOVEI B,1(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 1 ? 177 ? 203-176] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 177 ? 217-176] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IMDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST %TDMV0 ? %TDEOL + MOVEM B,DISBF1+5 + JRST POPBJ +IMDSM2: MOVEM A,DISBF1+3 ;HPOS TOO, %TDMV0 ? %TDEOL ? ... + MOVEM B,DISBF1+4 + +IMDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 177 ? 217-176 ? 1 ? 1] + MOVEM A,DISBF1+5 ;%TDMV0 + RET +] + +IFN VT05,[ +SUBTTL VT05 + +VT05TB: 20.,,71. ;DISPATCH VECTOR FOR VT05 + (%TOERS+%TOMVB+%TOMVU) ;CANT EVEN DISPLAY LOWERCASE + CALL V0CPS + CALL V0CEOL + CALL V0CEOS + CALL V0CLRS + JFCL + CALL V0DSMV + CALL V0DMV1 +REPEAT 5,JFCL + +;[ +V0CPS: JUMPE B,[MOVEI A,^] ;HOME IS EASY + JRST V0EOS2] ;WELL, AS EASY AS ANYTHING ELSE + MOVEI A,^N + PBOUT + HLRZ A,B + ADDI A,40 + CALL V0EOS2 ;TYPE YPOS+40 AND FILL (MUST FILL IN THE MIDDLE OF IT!) + MOVEI A,40(B) ;THEN XPOS+40 + PBOUT + RET + ;[ +V0CLRS: MOVEI A,^] ;HOME + CALL V0EOS2 ;WITH FILL +V0CEOS: MOVEI A,^_ ;CLEAR EOS +V0EOS2: PBOUT +V0FILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE +REPEAT 4,PBOUT ;OF THE CURSOR ADDRESSING) + RET +V0CEOL: MOVEI A,^^ + JRST V0EOS2 + +V0DSMV: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + MOVE B,[.BYTE 8 ? 0 ? 0 ? 40 ? ^^] + SKIPE DISCPH ;ANY HPOS? + JRST V0DSM2 ;YES + MOVEM A,DISBF1+3 + MOVEM B,DISBF1+4 + JRST POPBJ +V0DSM2: MOVEM A,DISBF1+1 + MOVEM B,DISBF1+2 +V0DSM3: MOVEM A,DISBF1+4 + MOVE B,DISCPH ;GET HPOS + ADDI B,40 + LSH B,8+4 + MOVEM B,DISBF1+5 + JRST POPBJ + +V0DMV1: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^N ? 0) + JRST V0DSM3 + +] ;IFN VT05 + +IFN TK4025,[ +SUBTTL TEKTRONIX 4025S + +; BECAUSE OF THE LOOSING FEATURE OF THE 4025 TERMINALS THAT WILL NOT ALLOW IT +; TO INSERT A LINE ABOVE THE TOP LINE, WE HAVE TO FAKE IT INTO THINKING IT +; HAS ONLY 33 LINES, STARTING ONE FROM THE TOP. +TK40TB: 33.,,78. ;DISPATCH TABLE FOR TEKTRONIX 4025 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL TKCPS + CALL TKCEOL + CALL TKCEOS + CALL TKCLRS + JFCL + CALL TKDSMV + CALL TKDMV1 + CALL TKINSL + CALL TKDELL + CALL TKINSC + CALL TKDELC + JFCL + + +; TKCPS - OUTPUT TEK4025 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +TKCPS: JUMPE B,[HRROI A,[ASCIZ / +`UP34;`DOW;/] + JRST TKCLR2] ;IF HOME, BE SURE TO RESYNCH + SAVE B ;SAVE DESIRED POSITION + SAVE TTLPOS ;WHERE WE ARE NOW. + HLRZ B,TTLPOS ;JUST ROW + CAIL B,28. ;CAN'T TRUST IT IF AT MODE LINE OR BELOW + JRST TKCPS8 ;SO USE FUDGED ABSOLUTE + HLRZ A,-1(P) ;GET NEW + SUBI B,(A) ;GET OLD-NEW + JUMPE B,TKCPS1 ;NO DIFF THERE + HRROI A,[ASCIZ /`DOW/] ;ASSUME NEGATIVE => DOWN + SKIPL B + HRROI A,[ASCIZ /`UP/] ;POSITIVE => UP + PSOUT + CALL TKCPS7 +TKCPS1: REST B ;GET BACK OLD + ANDI B,-1 ;JUST COL + HRRZ A,(P) ;GET NEW + SUBI B,(A) + JUMPE B,POPBJ + JUMPE A,[MOVEI A,^M ;FASTER IF GOING TO BEGINNING OF LINE + PBOUT + JRST POPBJ] + HRROI A,[ASCIZ /`RIG/] ;ASSUME NEGATIVE => RIGHT + SKIPL B + HRROI A,[ASCIZ /`LEF/] + PSOUT + CALL TKCPS7 + JRST POPBJ + +TKCPS7: MOVM A,B + SOJE A,TKCPS3 +TKCPS2: CALL TKCPS4 +TKCPS3: MOVEI A,"; + PBOUT + RET + +TKCPS4: SAVE [PBOUT] +TKCPS5: SAVE B + AOJ A, ;OFFSET TO 1,1 AS ORIGIN + IDIVI A,10. + JUMPE A,TKCPS6 + MOVEI A,"0(A) + XCT -1(P) +TKCPS6: MOVEI A,"0(B) + XCT -1(P) + JRST POPBAJ + +TKCPS8: + HRROI A,[ASCIZ / +`UP34;/] + PSOUT + REST B ;POP OFF OLD STUFF + HLRZ B,(P) ;GET LINE + AOJ B, ;THE REAL LINE IS ONE LOWER + HRROI A,[ASCIZ /`DOW/] + PSOUT + CALL TKCPS7 +TKCPS9: HRRZ B,(P) + JUMPE B,POPBJ + HRROI A,[ASCIZ /`RIG/] + PSOUT + CALL TKCPS7 + JRST POPBJ + + +TKCEOS: ; CLOSE ENOUGH FOR MOST THINGS +TKCEOL: PUSH P,A ; SAVE ACs + PUSH P,B + PUSH P,C + SKIPGE C,EOLFLG ; NO. OF SPACES SET? + JRST TKCEO1 ; YES, USE THAT + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUBI C,79. ; MAKE HPOS-79 FOR NEGATIVE COUNT +TKCEO1: HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + SETZM EOLFLG + MOVEI A,^M + PBOUT ; BACK TO LEFT + HRRZ B,TTLPOS ; GET BACK OLD POS + JUMPE B,POPCBA + HRROI A,[ASCIZ /`RIG/] + PSOUT + CALL TKCPS7 + JRST POPCBA + +TKCLRS: HRROI A,[ASCIZ /`ERA;/] +TKCLR2: PSOUT + RET + +TKINSC: HRROI A,[ASCIZ "`ICH;"] + PSOUT + CALL OUTNSP + HRROI A,[ASCIZ "`LEF"] + PSOUT + SOSE A,Q + JRST TKCPS2 + JRST TKCPS3 + +TKDELC: HRROI A,[ASCIZ /`DCH;/] + JRST TKCLR2 + +; TKDELL - OUTPUT TEK4025 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +TKDELL: MOVS B,BP + CALL TKCPS + MOVEM B,TTLPOS + HRROI A,[ASCIZ /`DLI/] + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 ;ACCOUNT FOR INCREMENTING THAT WILL BE DONE + + +; TKINSL - OUTPUT TEK4025 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +TKINSL: MOVSI B,-1(BP) + JUMPGE B,.+2 + MOVEI B,0 ; THIS WILL LOSE BUT ITS BETTER THAN NOTHING + CALL TKCPS + MOVEM B,TTLPOS + SKIPN BP ;IF NOT THE TOP LINE, WE CAN SKIP THIS + CALL [HRROI A,[ASCIZ /`UP;/] + PSOUT ;DON'T ASK, IT IS THE DUMB TERMINAL'S FAULT + RET] + HRROI A,[ASCIZ /`ILI/] + PSOUT + MOVEI A,(Q) + SOS A + CALL TKCPS2 + HRROI A,[ASCIZ /`UP/] ;REPOSITION CURSOR + PSOUT + MOVEI A,(Q) + SOJA A,TKCPS2 + +TKDMV1: HRROS (P) ; DON'T WANT CLEARING + SAVE [141000,,DISBF1+1] + JRST TKDSM2 +TKDSMV: HRRZS (P) ; WANT CLEARING + SKIPE DISCPH ;ANY HPOS? + SAVE [441000,,DISBF1] ;YES, WILL NEED WHOLE BUFFER + SAVE [141000,,DISBF1+1] +TKDSM2: SAVE B + MOVE B,TTLPOS + MOVEI A,^M + TRNE B,-1 ;IF NOT THERE ALREADY... + IDPB A,-1(P) ;START AT BEGINNING OF CURRENT LINE + HLRZS B ;GET CURRENT ROW + SUBI B,(BP) ;GET OLD-NEW + JUMPE B,TKDSM5 ;ALREADY ON RIGHT LINE + MOVEI A,[ASCIZ /`DOW /] ;ASSUME NEGATIVE => DOWN + SKIPL B + MOVEI A,[ASCIZ /`UP /] + CALL TKDSMS + MOVM A,B + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) +TKDSM5: MOVE T,CHCRHP ; NEW LINE LENGTH + SUB T,LINEND(BP) ; MINUS OLD LINE LENGTH IS NEGATIVE NO. OF CHARACTERS TO CLEAR + SKIPL -2(P) ; WANT CLEARING? + MOVEM T,EOLFLG ; YES, SET IT UP + SKIPN DISCPH ;GET HPOS IF ANY + JRST POPBAJ + MOVEI A,[ASCIZ /`RIG /] + CALL TKDSMS + MOVE A,DISCPH + CALL TKDSMN + MOVEI A,"; + IDPB A,-1(P) + JRST POPBAJ + +TKDSMS: SAVE B + HRLI A,440700 +TKDSS2: ILDB B,A + JUMPE B,POPBJ + IDPB B,-3(P) + JRST TKDSS2 + +TKDSMN: SOJE A,CPOPJ + SAVE [IDPB A,-4(P)] + JRST TKCPS5 +] + +IFN HP2645,[ +SUBTTL HP2645 + +HPTB: 24.,,79. ;DISPATCH VECTOR FOR HP2645 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) + CALL HPCPS + CALL HPCEOL + CALL HPCEOS + CALL HPCLRS + JFCL + CALL HPDSMV + CALL HPDMV1 + CALL HPINSL + CALL HPDELL + CALL HPINSC + CALL HPDELC + JFCL + + +; HPCPS - OUTPUT HP2645 CURSOR POSITIONING COMMANDS TO TERMINAL. +; ARGUMENT: +; B LINE,,COLUMN + +HPCPS: SAVE A ; SAVE AC + MOVE A,[440700,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + CALL HPMOVE ; GET COMMANDS TO DO CURSOR MOVEMENT + MOVE A,[440700,,HPBUF] ; SEND COMMANDS + PSOUT ; ... + JRST POPAJ + + +; HPMOVE - CALCULATE HP2645 CURSOR POSITIONING COMMANDS. +; ARGUMENTS: +; A B.P. TO OUTPUT BUFFER (UPDATED ON RETURN) +; B LINE,,COLUMN + +HPMOVE: SAVE B ; SAVE ACS + SAVE C ; ... + JUMPE B,[ ; SIMPLE HOME + MOVEI C,33 ; $H WILL DO + IDPB C,A + MOVEI C,"H + IDPB C,A + JRST HPMOV1 + ] +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + HLRZ B,-1(P) ; GET LINE NO. + CALL HPNO ; OUTPUT AS DECIMAL NO. + HRRZ B,-1(P) ; GET COLUMN NO. + JUMPE B,[ ; IF COLUMN NO. IS ZERO THEN USE DIRECT + MOVEI C,"R ; CURSOR POSITION FOR LINE NO. ONLY + IDPB C,A + MOVEI C,^M ; THEN FOLLOW WITH A CR + IDPB C,A ; ... + JRST HPMOV1 + ] + MOVEI C,"r ; TERMINATE LINE NO. + IDPB C,A ; ... + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI C,"C ; TERMINATE COLUMN NO. + IDPB C,A ; ... +HPMOV1: MOVEI C,0 ; TERMINATE WITH A NULL + IDPB C,A ; ... + REST C ; RESTORE ACS + JRST POPBJ + +; INTERNAL SUBROUTINE - OUTPUT B AS DECIMAL NO. +HPNO: IDIVI B,10. ; CONVERT TO TENS AND ONES DIGITS + JUMPE B,HPN1 ; SKIP TENS DIGIT IF ZERO + ADDI B,"0 ; CONVERT TENS DIGIT TO ASCII + IDPB B,A ; OUTPUT TENS DIGIT +HPN1: ADDI C,"0 ; CONVERT ONES DIGIT TO ASCII + IDPB C,A ; OUTPUT ONES DIGIT + RET + + +; HPCEOL - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF LINE. + +HPCEOL: MOVEI A,"K + JRST OUTESC + + +; HPCEOS - OUTPUT HP2645 COMMANDS TO CLEAR TO END OF SCREEN. + +HPCEOS: MOVEI A,"J + JRST OUTESC + + +; HPCLRS - OUTPUT HP2645 COMMANDS TO CLEAR THE SCREEN. + +HPCLRS: HRROI A,[ASCIZ "HJ"] + PSOUT + RET + + +; HPINSL - OUTPUT HP2645 COMMANDS TO INSERT SEVERAL BLANK LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO INSERT +; Q NO. OF LINES TO INSERT + +HPINSL: MOVEI A,"L ; $L - INSERT LINE + JRST HPDEL1 + + +; HPDELL - OUTPUT HP2645 COMMANDS TO DELETE SEVERAL LINES. +; ARGUMENTS: +; BP LINE NO. AT WHICH TO DELETE +; Q NO. OF LINES TO DELETE + +HPDELL: MOVEI A,"M ; $M - DELETE LINE +HPDEL1: SAVE B ; SAVE AC + MOVS B,BP ; HPCPS ARG: LINE NO.,,COLUMN NO. + CALL HPCPS ; MOVE TO DESIRED LINE NO. + MOVEI B,33 ; ESC +HPID1: EXCH A,B + PBOUT ; OUTPUT ESC + EXCH A,B + PBOUT ; OUTPUT "L" OR "M" + SOJG Q,HPID1 + JRST POPBJ ; RESTORE AC + +HPDELC: MOVEI A,"P + JRST OUTESC + +HPINSC: MOVEI A,"Q + CALL OUTESC + CALL OUTNSP + MOVEI A,"R + CALL OUTESC + MOVEI A,^H + JRST OUTN + +; HPDSMV - CALCULATE HP2645 COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +HPDSMV: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + HRLZ B,BP ; HPMOVE ARG: LINE NO.,,COLUMN NO. + CALL HPMOVE ; MOVE TO BEGINNING OF SPECIFIED LINE + MOVEI B,33 ; CLOBBER TERMINATING ZERO BYTE WITH + DPB B,A ; AN ESCAPE - 1ST PART OF CLEOL SEQUENCE + MOVEI B,"K ; PUT IN "K" - 2ND PART OF CLEOL SEQUENCE + IDPB B,A ; ... + SKIPN B,DISCPH ; DESIRED COLUMN ZERO? + JRST HPDSM1 ; YES, ALREADY THERE +IRP X,,[33,"&,"a] ; SEND THE START OF THE CURSOR POSITIONING + MOVEI C,X ; SEQUENCE + IDPB C,A +TERMIN + CALL HPNO ; OUTPUT COLUMN NO. AS DECIMAL NO. + MOVEI B,"C ; TERMINATE COLUMN NO. AND CURSOR POSITIONING + IDPB B,A +HPDSM1: MOVEI B,0 ; TERMINATE WITH ZERO BYTE + IDPB B,A ; ... +HPDSM2: SUBI A,HPBUF ; CALCULATE NO. OF BYTES WE'VE GENERATED + MULI A,4 ; (SEE HAKMEM NOTE 165) + SUBI B,1-4(A) ; ... + MOVNI A,(B) ; CALCULATE BYTE ADDRESS TO START AT, + ADD A,[DISBUF*4] ; I.E. DISBUF*4-NBYTES + IDIVI A,4 ; CONVERT TO B.P. + HRL A,(B)[441000 ? 341000 ? 241000 ? 141000] ; ... + MOVE B,[441000,,HPBUF] ; B.P. TO BUFFER +HPDSM3: ILDB C,B ; GET BYTE FROM HPBUF + JUMPE C,POPCBA ; ZERO BYTE TERMINATES + IDPB C,A ; PUT INTO DISBF1 + JRST HPDSM3 + JRST POPCBA + + +; HPDMV1 IS JUST LIKE HPDSMV, EXCEPT THAT IT DOES NOT CLEAR. + +HPDMV1: SAVE A ; SAVE ACS + SAVE B ; ... + SAVE C ; ... + MOVE A,[441000,,HPBUF] ; HPMOVE ARG: B.P. TO BUFFER + MOVE B,DISCPH ; HPMOVE ARG: LINE NO.,,COLUMN NO. + HRL B,BP ; ... + CALL HPMOVE ; MOVE TO SPECIFIED POSITION + JRST HPDSM2 + +];IFN HP2645 + +IFN I400,[ +SUBTTL INFOTON 400 + +I400TB: 4*1000+24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID+%TOLID) + CALL I4CPS + CALL I4CEOL + CALL I4CEOS + CALL I4CLRS + JFCL + CALL I4DSMV + CALL I4DMV1 + CALL I4INSL + CALL I4DELL + CALL I4INSC + CALL I4DELC + CALL I4RST + +I4CPS: MOVEI A,33 + PBOUT + JUMPE B,I4CPS8 ; SKIP ALL THIS FOR HOMING + HLRZ A,B ; VERTICAL POS + AOS A ; USES 1 BASED ADDRESSING + CALL I4PAR + HRRZ A,B + JUMPE A,I4CPS8 + PUSH P,A + MOVEI A,"; + PBOUT + POP P,A + AOS A + CALL I4PAR +I4CPS8: MOVEI A,"H + PBOUT + RET + +I4PAR: SAVE B + IDIVI A,10. + JUMPE A,I4PAR1 + ADDI A,"0 + PBOUT +I4PAR1: MOVEI A,"0(B) + PBOUT + JRST POPBJ + +I4CEOL: MOVEI A,"N + JRST OUTESC + +I4CEOS: MOVEI A,"J + JRST OUTESC + +I4CLRS: HRROI A,[ASCIZ /2Q2J/] + PSOUT + RET + +I4DSMV: MOVEI C,5 ; INDEX INTO DISBF1 + MOVE A,[.BYTE 8 ? 33 ? "[ ? "2 ? "N ] ;] + MOVEM A,DISBF1(C) + SOS C + JRST I4DMV3 ; ENTER REST OF CODE + +I4DMV1: MOVEI C,5 ; INDEX INTO DISBF1 +I4DMV3: MOVE A,DISCPH + AOS A + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,8+4 + ADD A,[.BYTE 8 ? "; ? "0 ? "0 ? "H ] + MOVEM A,DISBF1(C) + SOS C +I4DSM2: MOVEI A,1(BP) + IDIVI A,10. + LSH A,8 + ADDI A,(B) + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "[ ? "0 ? "0 ] ;] + MOVEM A,DISBF1(C) + RET + +I4INSL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSTION CURSOR TO IT +I4INS1: HRROI A,[ASCIZ /Q/] + PSOUT + MOVE A,Q ;PUT OUT NUMBER OF LINES + CALL I4PAR + MOVEI A,"L ;AND THE INSERT COMMAND + PBOUT + JRST I4PAD + +I4DELL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,I4CPS ;POSITION CURSOR TO IT +I4DEL1: HRROI A,[ASCIZ /Q/] + PSOUT + MOVE A,Q ;PUT OUT NUMBER OF LINES + CALL I4PAR + MOVEI A,"M ;DELETE LINES + PBOUT + JRST I4PAD + +;I4PAD IS ASSUMED TO BE DONE AFTER A LINE OPERATION, SO IT PUTS OUT +; A $2Q AFTER THE PADDING, TO RETURN US TO CHARACTER MODE. AC Q +; CONTAINS THE NUMBER OF LINES INSERTED OR DELETED. +I4PAD: MOVEI A,16. ;PAD 16 MSEC. + IMULI A,(Q) ;TIMES NUMBER OF LINES + CALL TIMPAD + HRROI A,[ASCIZ /2Q/] ;PUT BACK IN CHAR MODE + PSOUT + RET + +I4INSC: HRROI A,[ASCIZ /4h/] + PSOUT ;ENTER INSERT MODE + CALL OUTNSP ;INSERT SPACES + HRROI A,[ASCIZ /4l/] ;LEAVE INSERT MODE. + PSOUT + MOVEI A,^H ;BACK OVER THEM. + JRST OUTN + +I4DELC: MOVEI A,"P + JRST OUTESC + +I4RST: MOVEI A,"Q ;RESET ROLL + JRST OUTESC + +] ;IFN I400 + +IFN I100,[ +SUBTTL INFOTON 100 + +I100TB: 24.,,79. ;DISPATCH VECTOR FOR I100 + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID) + CALL I1CPS + CALL I1CEOL + CALL I1CEOS + CALL I1CLRS + JFCL + CALL I1DSMV + CALL I1DMV1 + CALL I1INSL + CALL I1DELL + JFCL + JFCL + JFCL + +I1INSL: SKIPA A,["L] ;$L - INSERT LINE +I1DELL: MOVEI A,"M ;$M - DELETE LINE + SAVE A + MOVEI A,"f + CALL OUTESC + MOVEI A,40 + PBOUT + MOVEI A,40(BP) + PBOUT +I1INS1: MOVE A,(P) ; GET DESIRED FUNCTION AGAIN + CALL OUTESC + SOJG Q,I1INS1 + JRST POPAJ + + +I1CPS: JUMPE B,[MOVEI A,"H ;HOME IS EASY + JRST OUTESC] + MOVEI A,"f ;ELSE SEND $f + CALL OUTESC + MOVEI A,40(B) ;+40 + PBOUT + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + RET + +I1CEOL: MOVEI A,"K ;CLEAR EOL + JRST OUTESC + +I1CLRS: MOVEI A,"H ;CLEAR SCREEN + CALL OUTESC +I1CEOS: MOVEI A,"J ;CLEAR EOS + JRST OUTESC + +I1DSMV: SAVE B + MOVEI B,40(BP) + LSH B,16.+4 + IOR B,[.BYTE 8 ? 40 ? 0 ? 33 ? "K] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "f] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST I1DSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $f ? $K + MOVEM B,DISBF1+5 + JRST POPBJ +I1DSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $f ? $K ? ... + MOVEM B,DISBF1+4 + CALL I1DMV1 + JRST POPBJ + +I1DMV1: MOVE A,DISCPH ; GET WANTED HPOS + LSH A,8 + IORI A,(BP) ;DESIRED VPOS + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "f ? 40 ? 40] + MOVEM A,DISBF1+5 ;$f + RET +] ;I100 + +IFN TK4023,[ +SUBTTL TEKTRONIX 402 (UGH) 3 + +; Note - this currently runs with the screen (except the mode line) in +; inverse video, for greater readability. If you don't like this see +; T3CLRS for how to fix it. + +TK43TB: 24.,,77. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL T3CPS + CALL T3CEOL + CALL T3CEOS + CALL T3CLRS + JFCL + CALL T3DSMV + CALL T3DMV1 +REPEAT 5,JFCL + +T3CPS: MOVEI A,28. + PBOUT + MOVEI A,41(B) ; X POS + PBOUT + HLRZ A,B ; Y POS + ADDI A,40 + PBOUT + RET + +T3CLRS: SAVE A + SAVE B + SAVE C + MOVEI A,33 ; ESCAPE + PBOUT + MOVEI A,^L ; FORMFEED + PBOUT + + MOVSI C,-24. ; AOBJN PTR +T3CLR1: HRLOI B,(C) ; GO TO X = -1 + CALL T3CPS + MOVEI A,31. ; SET A PROTECTED ATTRIBUTE + PBOUT + MOVEI A,"J ; NOTE - MAKE THIS "B FOR NON-INVERT SCREEN + PBOUT + AOBJN C,T3CLR1 + SETZ B, ; GO BACK HOME + CALL T3CPS + JRST POPCBA + +T3DSMV: SAVE B + MOVE B,[[.BYTE 8 ? 28. ? 41 ? 40 ? 31. + "@ ? 33 ? "O ? 0 + 0 ? 0 ? 0 ? 28. + 41 ? 40 ? 40 ? ^H],,DISBF1+2] + BLT B,DISBF1+5 + MOVE B,DISCPH + LSH B,8 + ADDI B,(BP) + LSH B,8+4 + ADDM B,DISBF1+2 + LSH B,8 + ADDM B,DISBF1+5 + JRST POPBJ + +T3DMV1: SAVE B + MOVE B,DISCPH ; X POS + LSH B,8. + ADDI B,40(BP) ; Y POS + LSH B,4 + ADD B,[.BYTE 8 ? 0 ? 28. ? 41 ? 0] + MOVEM B,DISBF1+5 + JRST POPBJ + +T3CEOS: +T3CEOL: SAVE A + SAVE B + SAVE C + HRROI A,[.BYTE 7 ? 31. ? "H ? 33 ? "O] + PSOUT + SKIPN C,OSPEED ; GOTTA PAD? + JRST T3CEO1 ; ASSUME THE WORST + SETZ A, + CAIL C,4800. + HRROI A,[.BYTE 7 ? 1 ? 1] + CAIL C,9600. +T3CEO1: HRROI A,[.BYTE 7 ? 1 ? 1 ? 1 ? 1] + SKIPE A + PSOUT + MOVE B,TTLPOS ; MUST REPOSITION CURSOR + CALL T3CPS + HRROI A,[.BYTE 7 ? 40 ? ^H] + PSOUT + JRST POPCBA + +] ;IFN TK4023 + +IFN ANNARB,[ +SUBTTL ANN ARBOR + +AATB: 40.,,78. ;DISPATCH TABLE FOR ANN ARBOR + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL AACPS ;NOTE: WIDTH MUST BE 78 DUE TO CRETINOUS + CALL AACEOL ;AUTO CRLF AND SCROLL AFTER WRITING IN COLUMN 79. + CALL AACEOS ;SO THE "!" MUST GO IN COLUMN 78. + CALL AACLRS + JFCL + CALL AADSMV + CALL AADMV1 + JFCL + JFCL + JFCL + JFCL + JFCL + + +; AACPS - OUTPUT ANN ARBOR CURSOR POSITIONING COMMANDS TO TERMINAL. + +; ARGUMENT: +; B LINE,,COLUMN + +AACPS: JUMPE B,[MOVEI A,^K ; SIMPLE HOME? + PBOUT ; YES, USE HOME COMMAND INSTEAD OF ABSOLUTE + RET] ; POSITIONING + MOVEI A,^O ; SEND START OF ABSOLUTE CURSOR POSITION + PBOUT ; SEQUENCE + SAVE B ; SAVE LINE,,COLUMN + MOVEI A,(B) ; GET COLUMN NO. + IDIVI A,10. ; CONVERT TO FUNNY BCD REPRESENTATION + LSH A,4 ; ... + IOR A,B ; ... + PBOUT ; OUTPUT + HLRZ A,(P) ; GET LINE NO. + CAIL A,20. ; THIS IS WEIRD + ADDI A,12. ; ... + ADDI A,100 + PBOUT + JRST POPBJ ; RESTORE CURSOR POSITION + + +AACEOS: ; CLOSE ENOUGH FOR MOST THINGS +AACEOL: JSR SAVABC ; SAVE ACs + SKIPGE C,EOLFLG ; NO. OF SPACES SET? + JRST AACEO1 ; YES, USE THAT + HRRZ C,TTLPOS ; GET CURRENT POSITION + SUBI C,80. ; MAKE HPOS-80 +AACEO1: HRROI B,SPACES + MOVEI A,.PRIOU + SOUT + SETZM EOLFLG + MOVE B,TTLPOS + CALL AACPS + JRST POPCBA + + +AACLRS: MOVEI A,^L + PBOUT + RET + + +; AADSMV - CALCULATE ANN ARBOR COMMANDS TO MOVE TO THE SPECIFIED POSITION AND +; CLEAR THE WHOLE LINE. THE COMMANDS ARE PUT IN DISBF1, AS CLOSE TO DISBUF +; AS POSSIBLE. 8 BIT BYTES ARE USED. + +; ARGUMENTS: +; BP LINE NO. +; DISCPH COLUMN NO. + +AADSMV: MOVE T,CHCRHP ; NEW LINE LENGTH + SUB T,LINEND(BP) ; MINUS OLD LINE LENGTH + MOVEM T,EOLFLG ; IS NEGATIVE NO. OF CHARACTERS TO CLEAR +; FALL THROUGH TO AADMV1 + + +; AADMV1 IS JUST LIKE AADSMV, EXCEPT THAT IT DOES NOT CLEAR. + +AADMV1: SAVE B ; SAVE AC + MOVE A,DISCPH ; GET COLUMN NO. + IDIVI A,10. + LSH A,4 + IORI A,^O_8.(B) + LSH A,8. + ADDI A,100(BP) + CAIL BP,20. + ADDI A,12. + LSH A,4 ; SHIFT INTO HIGH 32 BITS OF THE WORD + MOVEM A,DISBF1+5 ; ^O COLUMN LINE + JRST POPBJ ; RESTORE AC + +] ; IFN ANNARB + +IFN C100,[ +SUBTTL HDS C100 +; SUPPORT FOR THE HUMAN DESIGNED SYSTEMS' CONCEPT-100 AND CONCEPT-APL +; TERMINALS. +; +; NOTES: THESE TERMINALS MUST BE IN `PROGRAMMER MODE' FOR THINGS LIKE +; CURSOR ADDRESSING TO WORK; WE ALWAYS PUT THE TERMINAL IN THIS MODE, +; WHICH IS THE CORRECT ONE FOR FULL-DUPLEX SYSTEMS, AT EACH SCREEN CLEAR, +; UNDER THE ASSUMPTION THAT THE FIRST USEFUL THING DONE BY EMACS IS TO CLEAR +; THE SCREEN. LEAVING THE TERMINAL IN THIS MODE CAN'T HURT. +; +; THE CONCEPT SERIES NEEDS A FAIR AMOUNT OF FILL CHARACTERS FOR MOST +; OF THE MORE COMPLICATED FUNCTIONS; AT WORST, 50 MS. OF FILL WOULD BE +; NEEDED (EG, FOR AN INSERT-CHARACTER FUNCTION AT THE START OF A FULL +; SCREEN). IN THIS CODE, WE'VE TRIED TO PARAMETRIZE THE FILL FACTOR +; FOR EACH FUNCTION, AND COMPUTE THE ACTUAL AMOUNT OF FILL (NULS ARE +; USED), DEPENDING ON THE SPEED. NOTE THAT WE CAN ONLY USE 79. COLUMNS +; ON THE CONCEPT, AS PROBLEMS OCCUR WITH LINE FEEDS IF AUTO-CRLF HAS +; HAPPENED ON THE LAST LINE OF THE WINDOW (IT'S TOO UGLY TO DESCRIBE +; HERE). + +C100TB: 24.,,78. ; CONCEPT DESCRIPTOR TABLE: SIZE, + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOLID+%TOCID) ; CAPABILITIES, + CALL CPCPS ; ROUTINES: CURSOR POSITIONING + CALL CPCEOL ; CLEAR TO END OF LINE + CALL CPCEOS ; CLEAR TO END OF SCREEN + CALL CPCLRS ; CLEAR SCREEN + JFCL ; UNUSED AS OF NOW. + CALL CPDSMV ; SET UP DISBF1 FOR MOVING TO, CLEARING LINE + CALL CPDMV1 ; DITTO, BUT DON'T DO ANY CLEARING + CALL CPINSL ; INSERT SOME LINES + CALL CPDELL ; DELETE 'EM, TOO + CALL CPINSC ; INSERT A CHAR + CALL CPDELC ; AND MAYBE DELETE ONE + CALL CPTRST ; RESET THE TERMINAL (RESET WINDOW) + CALL CPWUP ; MOVE LINES VIA WINDOWING UP + CALL CPWDN ; DOWN + +; FUNCTION CODES (FOR DELAY CALCULATIONS); IF YOU EVER CHANGE THESE, CHANGE +; THE DELAY TABLE IN CPFILC, TOO. + +%FCCES==0 ; CLEAR TO END OF SCREEN, +%FCCEL==1 ; CLEAR TO END OF LINE, +%FCCLS==2 ; CLEAR SCREEN, +%FCINL==3 ; INSERT LINE, +%FCDLL==4 ; DELETE LINE + +; POSITION CURSOR TO (VERTICAL POSTION,,HORIZONTAL POSTION) IN B + +CPCPS: JUMPE B,[MOVEI A,"? ; GOING HOME IS EASY + JRST OUTESC ] ; OUTPUT `$?' + SAVE C ; SAVE WORK REG + MOVE C, [.BYTE 7 ? 33 ? "a ? 40 ? 40 ? 0] ; BUILD POSITIONER IN C + HLRZ A, B ; GET VERTICAL POSITION + LSH A, 7 ; MOVE IT INTO POSITION + IORI A, (B) ; FOLLOWED BY THE HORIZONTAL + LSH A, 7+1 ; POSITION + ADD C, A ; DROP IT IN + HRROI A, C ; FINALLY, OUTPUT IT ALL + PSOUT ; ... + JRST POPCJ + +; CLEAR TO END OF SCREEN + +CPCEOS: MOVEI A,^E ; OUTPUT CLEAR-ALL TO + CALL OUTESC ; END OF WINDOW + PUSH P,[1] ; WORST CASE ASSUMED + MOVEI A,%FCCES ; AND FILL APPROPRIATELY + CALL CPFILL ; FOR THIS FUNCTION AND SPEED + RET ; EVERYONE'S HAPPY + +; CLEAR TO END OF LINE + +CPCEOL: MOVEI A,^U ; OUTPUT CLEAR-ALL TO + CALL OUTESC ; END OF LINE + MOVEI A,%FCCEL ; FILL FOR THIS FUNCTION + PUSH P,[1] ; NO MULTIPLIER NEEDED + CALL CPFILL + RET ; ALL OK + +; CLEAR SCREEN ENTIRELY (SEE NOTE ABOVE) + +CPCLRS: HRROI A, [.BYTE 7 ? 33 ? "U ? ^L ? 0] ; MAGIC MUMBLE TO GO INTO + PSOUT ; `PROGRAMMER MODE' AND CLEAR SCREEN + MOVEI A, %FCCLS ; DELAY APPROPRIATELY + PUSH P, [1] ; NO MULTIPLIER + CALL CPFILL + RET + +; SET UP DISBF1 TO MOVE TO LINE (VERTICAL POSITION) IN BP, CLEAR +; LINE, AND GO TO HORIZONTAL POSITION IN DISCPH ON THAT LINE. +; NOTE: WE'RE USING 15 NULS FOR PADDING FOR CLEAR TO END OF LINE. + +CPDSMV: SAVE B ; STASH WORK REG AWAY + MOVEI A,40(BP) ; GET VERTICAL COORDINATE + LSH A,8.+4. ; MOVE IT INTO POSITION + ADD A,[.BYTE 8. ? 33 ? "a ? 0 ? 40] ; MAKE POSITIONER + MOVSI B,(.BYTE 8. ? 33 ? ^U) ; AND CLEAR-ALL-ER TO E-O-L + SETZM DISBF1+3 ; SET UP PADDING NULS + SETZM DISBF1+4 ; ... + SKIPN DISCPH ; DO WE NEED HORIZONTAL MOTION AFTER? + JRST [ MOVEM A,DISBF1+1 ; NO, JUST DUMP IT ALL + MOVEM B,DISBF1+2 ; ... + SETZM DISBF1+5 ; PADDING NULS + JRST POPBJ ] ; OUT AND RETURN + MOVEM A,DISBF1+0 ; YES, PUT DOWN POSITIONER AND CLEARER + MOVEM B,DISBF1+1 + SETZM DISBF1+2 ; PADDING NULS + MOVEI B,40(BP) ; GET VERTICAL COORDINATE + LSH B,8. ; POSITION IT + ADD B,DISCPH ; GET HORIZONTAL POSITION + LSH B,4 ; GET INTO THE RIGHT SLOT + ADD B,[.BYTE 8. ? 33 "a ? 0 ? 40] ; FINALLY FINISH IT UP + MOVEM B,DISBF1+5 ; AND DROP IT INTO THE DISPLAY BUFFER + JRST POPBJ ; ALL DONE + + +; SET UP DISBF1 TO MOVE TO POSITION AS CODED BY (BP, DISCPH); DON'T +; CLEAR ANYTHING. + +CPDMV1: SETZM DISBF1+3 ; CLEAR OUT UNUSED PART OF DISPLAY + SETZM DISBF1+4 ; BUFFER + MOVEI A, (BP) ; GET VERTICAL POSITION + LSH A, 8 ; MAKE ROOM FOR HORIZONTAL + IOR A, DISCPH ; POSITION + LSH A, 4 ; ACCOUNT FOR POSITION OF 4 8.-BIT BYTES + ADD A, [.BYTE 8 ? 33 ? "a ? 40 ? 40] ; BUILD POSITIONER + MOVEM A, DISBF1+5 ; AND DROP INTO ITS FINAL RESTING PLACE + RET ; ALL DONE + + +; INSERT AND DELETE C(Q) LINES (AT THE VERTICAL POSITION IN BP); ON +; CONCEPT'S, THE CURSOR DOESN'T MOVE. + + ; ENTER HERE WITH SCREEN SIZE IN A +CPINSW: SAVE B ; (USED BY CPWIN ROUTINE ONLY) + PUSH P, A ; AND PUT IT WHERE USED LATER + JRST CPINS5 ; GO JOIN COMMON CODE + +CPINSL: SAVE B ; SAVE A WORK REG + PUSH P, [24.] ; AT THIS POINT, ASSUME FULL SCREEN +CPINS5: MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + POP P,B ; GET WINDOW SIZE INTO B + SUBI B,(BP) ; AND COMPUTE NUMBER OF LINES BEING MOVED +CPINS1: MOVEI A,^R ; FOR EACH LINE TO BE + CALL OUTESC ; INSERTED, `$^R' DOES IT + PUSH P,B ; PASS # LINES FOR FILL ACTION + MOVEI A,%FCINL ; AND DELAY APPROPRIATELY + CALL CPFILL + MOVEI A,"< ; NOW, GO ONTO NEXT LINE + CALL OUTESC + SUBI B,1 ; BUMP DOWN NUMBER OF LINES BEING SHOVED DOWN + SOJG Q,CPINS1 ; DO FOR NUMBER OF LINES REQUESTED + JRST POPBJ + +CPDELL: SAVE B ; SAVE A WORK REG + MOVEI B, 40(BP) ; FIRST, GO TO THE LINE ASKED FOR + LSH B, 7+7+1 + ADD B, [.BYTE 7 ? 33 ? "a ? 0 ? 40 ? 0] + HRROI A, B + PSOUT + MOVEI B, 24. ; COMPUTE NUMBER OF LINES + SUBI B, (BP) ; BEING AFFECTED +CPDEL1: MOVEI A,^B ; DELETE A LINE + CALL OUTESC ; ... + PUSH P,B ; PASS # LINES FOR FILL ACTION, AND + MOVEI A,%FCDLL ; WAIT FOR THIS SLOW + CALL CPFILL ; TERMINAL + SOJG Q,CPDEL1 ; DO IT NUMBER OF TIMES REQUESTED + JRST POPBJ + +; INSERT AND DELETE CHARACTER; THE INSERT-CHARACTER WORKS BY ACTUALLY +; ENTERING INSERT MODE, DROPPING IN A SPACE TO MAKE ROOM, AND LEAVING +; INSERT MODE; THEN, MOVE BACK OVER THE SPACE. + +CPINSC: MOVEI A,^P ; ENTER INSERT CHARACTER MODE + CALL OUTESC ; ... + SAVE Q ; SAVE INSERT COUNT +CPIC1: MOVEI A,40 ; INSERT SPACES + PBOUT ; ... + MOVEI A,%FCCEL ; FILL FOR THIS FUNCTION + PUSH P,[1] ; NO MULTIPLIER NEEDED + CALL CPFILL + SOJG Q,CPIC1 + REST Q ; RESTORE INSERT COUNT + MOVEI A,33 ; EXIT INSERT CHARACTER MODE + PBOUT ; ... + MOVEI A,0 ; ... + PBOUT ; ... + MOVEI A,^H ; BACK OVER INSERTED SPACES + JRST OUTN ; ... + +CPDELC: MOVEI A,^Q ; DELETE CHARACTER IN LINE + CALL OUTESC ; ... + MOVEI A,%FCCEL ; FILL FOR THIS FUNCTION + PUSH P,[1] ; NO MULTIPLIER NEEDED + CALL CPFILL + RET + +; ROUTINE TO FILL APPROPRIATELY FOR ANY GIVEN FUNCTION +; (AS CODED BY %FCXXX, ABOVE). THE FUNCTION CODE IS IN A. +; CLOBBERS A. THE FILL FACTOR (E.G., NUMBER OF LINES AFFECTED) IS +; AT -1(P), AND IS PEELED OFF THE STACK. + +CPFILL: EXCH B,(P) ; GET RETURN ADDRESS, SAVE WORK REG + EXCH B,-1(P) ; GET FILL FACTOR, SAVE RETURN ADDRESS + CALL CPFILC ; COMPUTE HOW MANY NULS ARE NEEDED (TO A) + CALL EXPPD1 ; SEND THAT MANY RUBOUTS + JRST POPBJ + + +; ROUTINE TO COMPUTE HOW MANY NULS ARE NEEDED TO FILL AFTER A GIVEN +; FUNCTION; %FCXXX CODE IS IN A, FILL FACTOR IN B. +; RETURNS RESULT IN A. + +CPFILC: MOVE A,(A)[ ; GET DELAY BASED ON CODE (>1200,,<=1200) + 48.,,1. ; CLEAR TO END OF SCREEN (%FCCES) + 15.,,1. ; CLEAR TO END OF LINE (%FCCEL) + 48.,,3. ; CLEAR SCREEN (%FCCLS) + 4.,,1. ; INSERT LINE (%FCINL) + 4.,,1. ; DELETE LINE (%FCDLL) + ] + SAVE C ; STASH WORK REGISTER + SKIPE C,OSPEED ; GET SPEED WE'RE RUNNING AT + CAILE C,1200. ; AND IF IT'S GREATER THAN 1200 BAUD, + MOVS A,A ; USE LEFT HALF + TLZ A,-1 ; USE WHATEVER IS IN RIGHT HALF NOW + IMULI A,(B) ; MULTIPLY BY FILL FACTOR + JRST POPCJ + +; MOVE LINES AROUND ON SCREEN USING HARDWARE WINDOWING TO WIN ON SPEED. +; (SIGH; THIS CODE WILL PROBABLY BE USELESS WHEN THEY SPEED UP INSERT/ +; DELETE LINE). SEE MOVWIN ROUTINE FOR INPUTS. + +CPWDN: SAVE B ; SAVE WORK REG + MOVEI B, (BP) ; GET DESTINATION LINE (TOP LINE OF WINDOW) + MOVE A, BOTLIN ; GET # OF LINES IN + SUBI A, (B) ; HARDWARE WINDOW + CALL CPSETW ; SET UP THE WINDOW + SETZ BP, ; WANNA INSERT C(Q) LINES AT TOP OF SCREEN + CALL CPINSW ; GO INSERT THEM + CALL CPWRST ; RESET THE HARDWARE WINDOW TO WHOLE SCREEN + JRST POPBJ ; RESTORE B AND GET OUT + +; HERE TO MOVE A GROUP OF LINES UP + +CPWUP: JSR SAVABC + MOVE B, BP ; GET DESTINATION LINE (TOP OF NEW WINDOW) + MOVE A, BOTLIN ; GET # OF LINES + SUBI A, (B) ; IN WINDOW + CALL CPSETW ; SET THE WINDOW + MOVEI B, (A) ; GET # OF LAST LINE IN WINDOW + SUBI B, 1 ; ... + HRLZ B, B ; MAKE INTO (VPOS,,HPOS) OF LAST LINE + CALL CPCPS ; GO THERE + MOVEI A, .PRIOU ; TTY OUT PORT + HRROI B, [.BYTE 7 ; MAKE LOTS OF S WITH PADDING + REPEAT 24., ^J ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + ] + MOVNI C, (Q) ; GET NEGATIVE # OF LINES TO MOVE UP + IMULI C, 7 ; TIME # CHARS PER LINE SHIFT + SOUT ; SCROLL IT UP WITH S + CALL CPWRST ; RESET WINDOW + JRST POPCBA + +; WINDOW-SETTING UTILITY ROUTINES +; SET UP A WINDOW; A/ # OF LINES WANTED ON SCREEN, B/ LINE # OF HOME + +CPSETW: JSR SAVABC ; SAVE WORK REGS + SAVE D + SAVE E + MOVE D,[.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 40] + MOVE E,[.BYTE 7 ? 80.+40 ? 0 ? 0 ? 0 ? 0] ; GET SKELETON + LSH B, 7+7+1 ; GET STARTING LINE AND + LSH A, 1 ; LENGTH INTO POSITION + ADD D, B ; AND DROP THEM IN + ADD D, A + MOVEI A, .PRIOU + HRROI B, D ; NOW SET THE WINDOW + MOVNI C, 10. + SOUT + REST E + REST D + JRST POPCBA ; RESTORE WORK REGS + +; RESET THE HARDWARE WINDOW TO ITS FULL (?) GLORY + +CPWRST: JSR SAVABC ; SAVE WORK REGS + MOVEI A,.PRIOU + HRROI B,[.BYTE 7 ? 33 ? "v ? 40 ? 40 ? 24.+40 ? 80.+40 ? 0 ? 0 ? 0] + MOVNI C,10. + SOUT ; OUTPUT WINDOW-RESET SEQUENCE + JRST POPCBA ; ALL DONE + + +; RESET THE WHOLE TERMINAL, UPON EXIT. + +CPTRST: SAVE B ; SAVE WORK REG + CALL CPWRST ; RESET THE WINDOW + MOVE B,TTLPOS ; BELOW WILL NOT WORK FOR :ET +; HLLZ B, C100TB ; GET (WINDOW LENGTH,,0) +; SUB B, [1,,0] ; BUMP DOWN FOR ADDRESS OF LAST LINE + CALL CPCPS ; GO THERE + JRST POPBJ ; RESTORE B AND GET OUT + +] ;C100 + +IFN IQ120,[ +SUBTTL SOROC IQ 120 + +IQ12TB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR) + CALL IQCPS + CALL IQCEOL + CALL IQCEOS + CALL IQCLRS + JFCL + CALL IQDSMV + CALL IQDMV1 +REPEAT 5,JFCL + +IQCPS: JUMPE B,[ + MOVEI A,^^ ;SAVE A LITTLE FOR HOME + PBOUT + RET ] + MOVEI A,"= + CALL OUTESC + HLRZ A,B + ADDI A,40 ;+40 + PBOUT + MOVEI A,40(B) ;+40 + PBOUT + RET + +IQCEOL: MOVEI A,"T ;CLEAR EOL + JRST OUTESC + +IQCEOS: MOVEI A,"Y ;CLEAR EOS + JRST OUTESC + +IQCLRS: MOVEI A,"+ ;CLEAR SCREEN + JRST OUTESC + +IQDSMV: SAVE B ;SETUP DISBF1 TO GO TO POSITION FROM BP AND DISCPH + MOVEI B,40(BP) + LSH B,24.+4 + IOR B,[.BYTE 8 ? 0 ? 40 ? 33 ? "T] + MOVE A,[.BYTE 8 ? 0 ? 0 ? 33 ? "=] + SKIPE DISCPH ;DESIRED HPOS = 0? + JRST IQDSM2 ;NO, MUST GO THERE AFTERWARDS + MOVEM A,DISBF1+4 ;JUST $= ? $T + MOVEM B,DISBF1+5 + JRST POPBJ +IQDSM2: MOVEM A,DISBF1+3 ;NEED HPOS TOO, USE $= ? $T ? ... + MOVEM B,DISBF1+4 + CALL IQDMV1 + JRST POPBJ + +IQDMV1: MOVEI A,(BP) ;DESIRED VPOS + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] + MOVEM A,DISBF1+5 ;$= + RET +] ;IQ120 + +IFN VC404,[ + +SUBTTL VC404 + +VC44TB: 24.,,79. ;DISPATCH VECTOR FOR VC404 + (%TOERS+%TOMVB+%TOMVU+%TOLWR) ;CANT EVEN DISPLAY LOWERCASE + CALL VCCPS + CALL VCCEOL + CALL VCCEOS + CALL VCCLRS + JFCL + CALL VCDSMV + CALL VCDMV1 +REPEAT 5,JFCL + +VCCPS: JUMPE B,[MOVEI A,^Y ;HOME IS EASY + JRST VCEOS2] ;WELL, AS EASY AS ANYTHING ELSE + MOVEI A,^P + PBOUT + HLRZ A,B + ADDI A,40 + PBOUT + MOVEI A,40(B) + PBOUT + RET + +VCCLRS: MOVEI A,^X ;HOME + JRST VCEOS2 ;WITH FILL + +VCCEOS: MOVEI A,^W ;CLEAR EOS +VCEOS2: PBOUT +VCFILL: SETZ A, ;NEEDS 4 NULLS (CANT BE RUBOUTS CAUSE SENT IN MIDDLE +REPEAT 2,PBOUT ;OF THE CURSOR ADDRESSING) + RET + +VCCEOL: MOVEI A,^V + JRST VCEOS2 + +VCDSMV: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^P ? 0) + IOR A,[.BYTE 8 ? 0 ? 0 ? 40 ? ^V] + SKIPE DISCPH ;ANY HPOS? + JRST VCDSM2 ;YES + MOVEM A,DISBF1+3 + SETZM DISBF1+4 + JRST POPBJ + +VCDSM2: MOVEM A,DISBF1+1 + SETZM DISBF1+2 +VCDSM3: MOVE B,DISCPH ;GET HPOS + ADDI B,40 + LSH B,8+4 + TDZN A,[.BYTE 8 ? 0 ? 0 ? 377] + IOR A,B + MOVEM A,DISBF1+4 + SETZM DISBF1+5 + JRST POPBJ + +VCDMV1: SAVE B + MOVEI A,40(BP) + LSH A,16.+4 + TLO A,(.BYTE 8 ? ^P ? 0) + JRST VCDSM3 +] ;IFN VC404 + +IFN CNCPT,[ + +SUBTTL CN/CP TERMINAL (INFOTON 130) + +CNCPTB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID+%TOLID) + CALL CNCPS + CALL CNCEOL + CALL CNCEOS + CALL CNCLRS + JFCL + CALL CNDSMV + CALL CNDMV1 + CALL CNINSL + CALL CNDELL + CALL CNINSC + CALL CNDELC + JFCL + +CNCPS: JUMPE B,[MOVEI A,"H + JRST OUTESC] + MOVEI A,"Y + CALL OUTESC + HLRZ A,B ; VERTICAL POS + CALL CNPAR + HRRZ A,B + JRST CNPAR +CNPAR: SAVE B + IDIVI A,16. + CAIL A,10. + ADDI A,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. + ADDI A,"0 + PBOUT + CAIL B,10. + ADDI B,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. + MOVEI A,"0(B) + PBOUT + JRST POPBJ + +CNCEOL: MOVEI A,"K + JRST OUTESC + +CNCEOS: MOVEI A,"J + JRST OUTESC + +CNCLRS: MOVEI A,14 + PBOUT + RET + +CNDSMV: MOVEI C,5 ; INDEX INTO DISBF1 + MOVE A,[.BYTE 8 ? 33 ? "K ] + MOVEM A,DISBF1(C) + SOS C + JRST CNDMV3 ; ENTER REST OF CODE + +CNDMV1: MOVEI C,5 ; INDEX INTO DISBF1 +CNDMV3: MOVE A,DISCPH + IDIVI A,16. + CAIL A,10. + ADDI A,7 ;A HEX DIGIT OF 10. SHOULD BE "A, NOT "9+1. + LSH A,8 + CAIL B,10. + ADDI B,7 + ADDI A,(B) + LSH A,16.+4 + ADD A,[.BYTE 8 ? "0 ? "0 ] + MOVEM A,DISBF1(C) + SOS C +CNDSM2: MOVEI A,(BP) + IDIVI A,16. + CAIL A,10. + ADDI A,7 + LSH A,8 + CAIL B,10. + ADDI B,7 + ADDI A,(B) + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "Y ? "0 ? "0 ] + MOVEM A,DISBF1(C) + RET + +CNINSL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,CNCPS ;POSTION CURSOR TO IT +CNINS1: MOVEI A,"L + CALL OUTESC + PUSHJ P,CNPAD ;PAD THE INSERT + SOJG Q,CNINS1 ;AND LOOP IF MORE TO DO + RET + +CNDELL: HRLZ B,BP ;GET TARGET LINE + PUSHJ P,CNCPS ;POSITION CURSOR TO IT +CNDEL1: MOVEI A,"M ;HAVE TO SWITCH MODES AND BACK + CALL OUTESC + PUSHJ P,CNPAD ;PAD FOR THE DELETION + SOJG Q,CNDEL1 ;AND LOOP IF MORE TO DO + RET + +;PAD 16 MSEC +CNPAD: MOVEI A,16. + JRST TIMPAD + +CNINSC: HRROI A,[ASCIZ /E /] ;ALTMODE E SPACE BACKSPACE. + PSOUT + SOJG Q,CNINSC + RET + +CNDELC: MOVEI A,"F + JRST OUTESC +] ;IFN CNCPT + +IFN TVI912,[ + +SUBTTL TVI-912/920 + +TVITB: 24.,,79. + (%TOERS+%TOMVB+%TOMVU+%TOLWR+%TOCID) ;No %TOLID since too slow. + CALL TVCPS + CALL TVCEOL + CALL TVCEOS + CALL TVCLRS + JFCL + CALL TVDSMV + CALL TVDMV1 + CALL TVINSL + CALL TVDELL + CALL TVINSC + CALL TVDELC + JFCL + +TVCPS: JUMPE B,[MOVEI A,36 ;IF ADDRESS IS HOME, + PBOUT ; SEND ^^ + RET] + MOVEI A,"= + CALL OUTESC + HLRZ A,B + ADDI A,40 + PBOUT + MOVEI A,40(B) + PBOUT + JRST TVPAD2 + +TVCEOL: MOVEI A,"t + JRST OUTESC + +TVCEOS: MOVEI A,"y + CALL OUTESC + JRST TVPAD2 + +TVCLRS: MOVEI A,"* + CALL OUTESC + +;PAD 1/10 SECOND. +TVPAD2: MOVEI A,100. + JRST TIMPAD + +TVINSL: HRLZ B,BP ;GET TO LINE + CALL TVCPS +TVINS1: MOVEI A,"E + CALL OUTESC + CALL TVPAD + SOJG Q,TVINS1 + RET + +TVDELL: HRLZ B,BP ;GET TO LINE + CALL TVCPS +TVDEL1: MOVEI A,"R + CALL OUTESC + CALL TVPAD + SOJG Q,TVDEL1 + RET + +TVDELC: MOVEI A,"W + JRST OUTESC + +TVINSC: MOVEI A,"Q + CALL OUTESC + SOJG Q,TVINSC + RET + +TVDSMV: SAVE B + MOVEI A,40(BP) + LSH A,8+4 + IOR A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] + MOVEM A,DISBF1+0 + MOVE A,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] + MOVEM A,DISBF1+1 + MOVE B,[.BYTE 8 ? 33 ? "t ? 177 ? 177] + MOVEM B,DISBF1+2 + MOVE B,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] + MOVEM B,DISBF1+3 + SKIPE B,DISCPH + CALL TVDMV1 + JRST POPBJ + +TVDMV1: MOVEI A,(BP) + LSH A,8 + IOR A,DISCPH + LSH A,4 + ADD A,[.BYTE 8 ? 33 ? "= ? 40 ? 40] + MOVEM A,DISBF1+4 + MOVE A,[.BYTE 8 ? 177 ? 177 ? 177 ? 177] + MOVEM A,DISBF1+5 + RET + +;PAD FOR 1/2 SECOND. +TVPAD: MOVEI A,500. + JRST TIMPAD +] ;TVI912 + +OUTNSP: MOVEI A,40 +OUTN: SAVE Q + PBOUT + SOJG Q,.-1 + REST Q + RET + +;OUTPUT AN ALTMODE FOLLOWED BY THE CHARACTER IN A, PRESERVING ALL ACS. +OUTESC: SAVE A + SAVE B + MOVSI B,(ASCII//) + DPB A,[260700,,B] + HRROI A,B + PSOUT + JRST POPBAJ + +;PAD WITH A SPECIFIC NUMBER OF RUBOUTS (IN A). +EXPPAD: SAVE B + CALL EXPPD1 ;OUTPUT THEM ALL. + JRST POPBJ + +;PAD FOR A SPECIFIC LENGTH OF TIME. +;A CONTAINS THE NUMBER OF MSEC. WE CLOBBER A AND B. +TIMPAD: SKIPGE B,PADCHR ;PADDEL NONZERO MEANS WAIT INSTEAD OF PADDING. + JRST [ SAVE A + MOVEI A,.PRIOU + DOBE + REST A + DISMS + RET] + IMUL B,[<.BYTE 7 ? 1 ? 1 ? 1 ? 1 ? 1>_-1] + LSH B,1 + CAME B,TIMPDS ;CHECK THAT WE HAVE THE RIGHT PAD CHARACTER + JRST [ MOVEM B,TIMPDS + MOVE B,[TIMPDS,,TIMPDS+1] + BLT B,TIMPDE-1 + JRST .+1] + IMUL A,OSPEED + CAIGE A,8000. ;IF MUCH LESS THAN 1 CHAR NEEDED, DON'T SEND ANY. + RET + ADDI A,10000.-1 + IDIVI A,10000. ;GET NUMBER OF CHARS TO SEND + CAIL A,99. ;WE ONLY HAVE 99. RUBOUTS, + JRST [ SAVE A ;SO IF WE NEED MORE THAN THAT, SEND 99. AT A TIME. + HRROI A,TIMPDS + PSOUT + REST A + SUBI A,99. + JRST .-1] +EXPPD1: JUMPE A,CPOPJ + PUSH P,C + MOVN C,A + MOVEI A,.PRIOU ;NUMBER OF RUBOUTS TO OUTPUT + HRROI B,TIMPDS + SOUT + JRST POPCJ + +IFN TK4025\ANNARB\HMOD1,[ +SPACES: ASCII / / +] ; IFN TK4025\ANNARB\HMOD1 +];IFN TNX + +SUBTTL INTERRUPT HANDLERS + +IFN ITS,[ + +TSINTP: MOVEM 16,INTACS+16 ;SAVE ALL ACS. + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVE C,TSINT +TSIL: HRRZ A,TSINT+1 ;GET THE PC IN CASE THE INTERRUPT ROUTINE WANTS TO CHECK IT FOR TYIIOT + JUMPL C,TSIN2 ;INT IN SECOND WORD + TLZE C,%PJATY + JRST TSINTA + TLZE C,%PJRLT + JRST TSINTC + TLZE C,%PJWRO + TYPRE [PUR] + TRZE C,%PIMPV ;MPV => CREATE THE NONEXISTENT CORE AND RETRY. + JRST TSINT4 + TRZE C,%PIPDL + TYPRE [PDL] +TSIN2A: MOVSI 16,INTACS + BLT 16,16 + .SUSET [.SJPC,,INTJPC] + .DISMI TSINT+1 + +TSINTA: CAIN A,RRECI7 ;TTY GIVEN BACK TO TECO INTERRUPT. + AOS TSINT+1 ;IF INSIDE AN ECHOIN, FINISH IT NOW, SO WE CAN CLEAR THE SCREEN. + SKIPE RGETTY + SKIPL CLRMOD ;THIS FEATURE CAN BE DISABLED FOR DEBUGGING. + JRST TSIL + SETOM PJATY ;SAY THAT WE SHOULD CLEAR THE SCREEN AND REDISPLAY COMPLETELY. + SETOM DISOMD + JRST TSIL + +TSINTC: SETOM CLKFLG ;REAL-TIME CLOCK INTERRUPT. SAY IT'S TIME TO RUN THE HANDLER. + CAIN A,RRECI7 ;IF IN MIDDLE OF AN ECHOIN, RETURN FROM IT. + AOS TSINT+1 ;THEN ^R WILL CALL TYI AND THAT WILL RUN THE HANDLER. + CAIE A,TYIIOT ;IF WE ARE NOW WAITING FOR INPUT, RUN IT RIGHT AWAY, + JRST TSIL + MOVEI A,TSINTD + MOVEM A,TSINT+1 ;BUT FIRST EXIT FROM INTERRUPT LEVEL AND RESTORE ACS. + JRST TSIL + +TSINTD: CALL RLTCLK + JRST TYIIOT + +TSINT4: SOS TSINT+1 + CAIL A,HUSED ;MPV INT: CATCH JUMPS TO RANDOMNESS. + .VALUE + .SUSET [.RMPVA,,C] ;GET ADR START OF MISSING PAGE. + LSH C,-12 + CAIN A,EJCMD4 + JRST TSIN4A + MOVE B,C + IMULI B,2000*5 + CAMGE B,QRWRT ;ALL OF IMPURE STRING SPACE MARKED AS EXISTING SHOULD + .VALUE ;REALLY EXIST, OR THERE'S A BUG. +TSIN4A: AOS A,C + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + SYSCAL CORBLK,[%CLIMM,,%CBWRT ? %CLIMM,,%JSELF ? %CLIMM,,-1(A) ? %CLIMM,,%JSNEW] + .LOSE %LSSYS + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +TSINT6: SKIPE DISPRR ;HANDLE INTERRUPT FROM ALTMODE + JRST TSIL ;DO NOTHING IF INSIDE ^R. + SETCMM TSINAL ;REMEMBER PARITY OF ALTMODES, + SKIPN TSINAL ;IF SECOND, STOP DISPLAYING BUFFER. + JRST [ AOS TSALTC ;COUNT NUMBER OF $$ PAIRS SEEN. + JRST TSIL] + CALL TTYAC2 ;IF FIRST ALTMODE, SAY THAT NEXT CHARACTER MUST INTERRUPT + JRST TSIL ;SO WE CAN TELL AT INT. LEVEL. WHETHER THIS IS A $$ PAIR. + +TSIN2: TRZN C,TYPIN ;SECOND WORD INTERRUPT. IS IT TYPE-IN? + JRST TSIN2A ;THAT'S ALL THERE IS. +TSINT1: MOVEI A,CHTTYI + .ITYIC A, + JRST TSIL + HRRZ CH,TSINT+1 + CAIN CH,ASLEE2 ;IF M.P. IS INSIDE A :^S, WAKE IT UP + AOS TSINT+1 ;(IT HAS ARRANGED FOR ALL CHARS TO INTERRUPT) + TRZ A,SHIFT+SHIFTL + HRRZ CH,A + ANDI CH,177 + CAIN CH,33 ;ALTMODE => MUST SEE IF FOLLOWING CHAR IS AN ALTMODE. + JRST TSINT6 + SETZM TSINAL ;ELSE TELL NEXT CHAR (IF ALTMODE) THAT PREV. CHAR. WASN'T ONE. + CAIE A,^G + CAIN A,CONTRL+"G + JRST TSINT3 ;NOW CHECK FOR ALL FORMS OF ^G. + CAIE A,CONTRL+"G+40 + JRST TSIL +TSINT3: TLNN FF,FLNOIN ;UNLESS IT IS JUST DISPLAYING, ... + SKIPE RREBEG ;DONT SET IF IN A ^R + SETOM STOPF + SKIPLE CH,NOQUIT + JRST TSIL + HRRZ A,TSINT+1 + AOJL CH,TSINT5 ;-2FSNOQUIT$ => DON'T FLUSH INPUT & OUTPUT. + SKIPE RGETTY + JRST TSINT7 ;ON DISPLAYS, CAN'T .RESET MAIN OUTPUT SINCE COULD LOSE TRACK OF SCREEN + HLRZ CH,(A) + ANDI CH,777740 + CAIN A,DISSI1 + AOSA A,TSINT+1 + CAIN CH,(.IOT CHDPYO,) ;ON PRINTING TTY DON'T RETURN TO HUNG OUTPUT .IOT + AOS A,TSINT+1 + .RESET CHDPYO, + .RESET CHTTYO, +TSINT7: .RESET CHTTYI, + SETOM UNRCHC + SETZM TYISRC ;FLUSH ANY EXECUTING KBD MACRO. + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK ;FLUSH DEFINING A KBD MACRO. + MOVE CH,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(CH) + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,TSINT+1 + MOVEI CH,CONTRL+"G ;IF NOW INSIDE ^R, STICK A ^G IN AS INPUT + SKIPN RREBEG ;INSTEAD OF SETTING STOPF (WHICH WE AVOIDED DOING). + MOVEM CH,UNRCHC + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + SKIPE RREBEG + SETOM ORESET ;SIGNAL TYPEOUT ROUTINES TO STOP TYPING +TSINT5: SKIPN RREBEG + JRST TSIL + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT, ERR, OR DO NOTHING ACCORDING TO NOQUIT. + JRST TSIL +] + +IFN TNX,[ +;^G INTERRUPT COMES HERE +TSINT: MOVEM 16,INTACS+16 ;SAVE ACS + MOVEI 16,INTACS + BLT 16,INTACS+15 +TSINT3: SKIPE B,SAVMOD ;RESTORE TTY MODE REQUESTED? + CALL FFRRT2 ;YES, DO IT THEN + TLNN FF,FLNOIN + SKIPE RREBEG ;FROM ^R? + SETOM STOPF + SKIPLE B,NOQUIT ;QUIT NOT ALLOWED? + JRST TSIL ;YES, RETURN RIGHT AWAY + MOVEI CH,CONTRL+"G + AOJL B,TSINT5 ;WANTS CLEAR INPUT? + MOVEI A,.PRIIN ;YES + CFIBF + SETOM UNRCHC ;NOTHING WAITING + SETZM TYISRC + SKIPE TYISNK + HRRZM P,MODCHG ;MAKE MODE LINE RECOMPUTE SO IT WON'T SAY WE ARE DEFINING. + SETZM TYISNK + MOVE A,QRB.. ;STUFF ON SCREEN CAN GO AWAY. + SETZM .QVWFL(A) + SKIPE RREBEG + SETOM ORESET + SKIPN RREBEG ;IF FROM ^R, ... +TSINT5: MOVEM CH,UNRCHC ;PRETEND TO READ IT RATHER THAN SETTING STOPF + HRRZ A,INTPC1 + CAIE A,WAITX ;NOT INPUT IF RUNNING INFERIOR + CALL TYI4 ;PUT THE ^G IN THE TYPE-IN RING BUFFER. + MOVEI CH,TYI + CAIN A,TYIIOT + MOVEM CH,INTPC1 ;DONT GET HUNG UP ON READING FROM TTY + SKIPN RREBEG ;RETURN IF FROM ^R + JRST TSIL + CAIN A,WAITX ;RUNNING AN INFERIOR? + JRST [ SETZM STOPF ;DON'T QUIT OUT OF FZ + MOVEM A,INTPC1 ;SAVE RETURN PC + MOVEI A,^G ;RING CHIMES + PBOUT + MOVE A,INTACS+A ;GET FORK HANDLE + FFORK ;FREEZE IT + JRST TSIL] ;DEBRK TO PROCESS TERMINATION CODE + CAIE A,TYIIOT + SKIPE IMQUIT + CALL QUIT0 ;QUIT IF REQUESTED +TSIL: MOVSI 16,INTACS ;RETURN + BLT 16,16 + DEBRK + +NXPINT: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI 1,.FHSLF + GTRPW + HRRZS B,A ;GET WORD THAT GOT PAGE FAULT + LSH A,-12 + IMULI B,5 + CAMGE B,QRWRT + .VALUE + AOS A + CAML A,LHIPAG ;DON'T GRAB INFINITE CORE. + TYPRE [URK] + CAMLE A,MEMT ;IF THIS PAGE IS ABOVE ALL OTHERS, ADJUST MEMT. + MOVEM A,MEMT + JRST TSIL + +CNTRLC: MOVEM 16,INTACS+16 + MOVEI 16,INTACS + BLT 16,INTACS+15 + MOVEI CH,^C + CALL ECHOCH + CALL .EXIT + JRST TSIL + +.EXIT: SKIPN SAVMOD ;UNLESS FROM INSIDE GTJFN + CALL DPYRST ;TAKE TERMINAL OUT OF DISPLAY MODE + MOVEI A,.PRIOU ;TENEX EXEC DOESNT KNOW ALWAYS KNOW + RFMOD +IFN 20X,[SKIPE PAGMOD ;WAS PAGE MODE IN EFFECT? + TROE B,TT%PGM ;YES, IS IT NOW? + CAIA + STPAR + HRRZ B,TTLPOS ;LET MONITOR KNOW WHERE WE ARE ON THE LINE + SFPOS +] +IFN 10X,[ +IFE SUMXSW,CALL ECHOCR ;CANNOT TELL MONITOR POSITION, SO GO TO BOL + TRON B,100 ;ABOUT RESTORING ASCII DATA MODE + SFMOD +IFN SUMXSW,[ + HRRZ B,TTLPOS ;where we are on page + SFPOS ;tell monitor, as in tops20 + MOVE 1,HLDCHR ;get old hold char + JSYS 633 ;restore it +];IFN SUMXSW + MOVEI A,.FHJOB + SETO B, ;AND JOB TERMINAL INTERRUPT MASK + STIW +] + MOVEI B,BEG .SEE CIRC + HALTF ;STOP HERE + +PAGON: SETOM PJATY ;MUST ASSUME WE MESSED UP THE SCREEN +IFN 20X,[ + SKIPGE PAGMOD ;IF NOT MESSING WITH PAGE MODE + JRST DOSTIW +];20X + MOVEI A,.PRIOU + RFMOD +IFN 20X,[ + LDB C,[.BP TT%PGM,B] + MOVEM C,PAGMOD ;SAVE CURRENT PAGE MODE SETTING FIRST +];20X + TRZE B,TT%PGM\TT%DAM ;MAKE SURE PAGE MODE TURNED OFF + SKIPN RGETTY ;ON DISPLAYS + JRST DOSTIW + SFMOD + STPAR +IFN SUMXSW,[ + SETZ 1, ; zero to turn hold off + JSYS 633 ; STCHA -- turn off hold + MOVEM 1,HLDCHR ; save for later +] + +DOSTIW: MOVEI A,.FHSLF + RPCAP + JUMPGE C,CPOPJ ;NO ^C CAPABILITY + MOVEI A,.FHJOB ;RESTORE INTERRUPT MASKS +IFN 10X,TLO A,400000 + MOVE B,[042000,,000020] ;^C & ^G + MOVE C,RRMACT+CONTRL+"T ;IF ^T NOT ASSIGNED AS COMMAND + CAIN C,RRUNDF + TRO B,100000 ;ALLOW IT AS INTERRUPT TO SYSTEM + MOVSI C,040000 ;^C DEFERRED + STIW + RET + +LEVTAB: INTPC + INTPC1 + INTPC2 +CHNTAB: 2,,TSINT ;^G +IFN 20X,3,,ASLEE2 ;ANYTHING TO WAKE FROM :^S +.ELSE 0 + 1,,CNTRLC ;CONTROL-C INTERRUPT +IFN 20X,3,,TSINTC ;CLOCK INTERRUPT + BLOCK .ICPOV-<.-CHNTAB> + 1,,[CIS ? TYPRE [PDL] ] ;PUSHDOWN OVERFLOW + BLOCK .ICTOD-<.-CHNTAB> +IFN 10X,3,,TSINTC ;10X IIT INTERRUPT + BLOCK .ICNXP-<.-CHNTAB> + 2,,NXPINT ;NEW PAGE CREATED + BLOCK 36.-<.-CHNTAB> +];END IFN TNX + +SUBTTL BIGPRINTING + +.FNPNT: +IFN ITS,[SYSCAL RFDATE,[%CLIMM,,CHFILI ? %CLOUT,,PTLFCD] + SETOM PTLFCD +] + MOVEI A,PPA + HRRM A,LISTF5 + PUSHJ P,.+1 ;PRINT THE BIGPRINT TWICE. + MOVEI A,ERDEV+DEFFN1-DEFDEV ;FN1 + CALL .FNPT2 + MOVEI A,ERDEV+DEFFN2-DEFDEV ;FN2 + CALL .FNPT2 + JRST FORMF + +;BIGPRINT THE FILENAME WHOSE ADDRESS IS IN A +.FNPT2: +IFN TNX,MOVE C,A +IFN TNX,CALL .ST26B +IFN ITS,MOVE A,(A) + PUSH P,A + TRNN FF,FRARG + PUSHJ P,PTLAB +.FN3: MOVE A,(P) + MOVEI C,4 + PUSHJ P,CRR1 + SOJN C,.-1 + MOVEI TT1,7 +.FN239: MOVEI J,3 +.FN249: SETZM B + ROTC A,6 + MOVEI T,3 +.FN259: XCT LDBT1-1(T) + IMULI B,10101 + SETZM E + TRNE TT,2 + HRLM B,E + CAIG T,1 + JRST .FN269 + TRNE TT,1 + HRRM B,E +.FN269: PUSHJ P,[JUMPN A,TYPR + CAIE T,1 ;DON'T PRINT TRAILING SPACES. + JRST TYPR + JRST SIXNTY] + IDIVI B,10101 + SOJN T,.FN259 + JUMPE A,.FN279 + MOVEI CH,40 + REPEAT 3,PUSHJ P,PPA + JRST .FN249 +.FN279: MOVE A,(P) + PUSHJ P,CRR1 + SOJN J,.FN249 + SOJN TT1,.FN239 + JRST POPAJ + +IFN ITS,[ +PTLAB: PUSHJ P,CRR1 + MOVE E,DEFDEV + CALL SIXNTY ;OUTPUT DEVICE NAME + MOVEI CH,": + XCT LISTF5 + MOVE E,DEFDIR + CALL SIXNTY ;AND THE SNAME + MOVEI CH,"; + XCT LISTF5 + CALL LISTF4 + .SUSET [.RUNAM,,E] + PUSHJ P,TYPR + PUSHJ P,LISTF4 + PUSHJ P,GDATIM ;GET DATE AND TIME + POPJ P, ;SYSTEM DOESN'T HAVE THEM, QUIT HERE + PUSHJ P,GLPDTM ;WIN, ALSO GET CRUD FOR PHASE OF MOON + MOVE E,TIME ;GET TIME FOR PRINTING OUT + DPB E,[301400,,CTIME+1] + LSH E,-14 + DPB E,[61400,,CTIME] + LSH E,-14 + DPB E,[301400,,CTIME] + MOVE E,CTIME + PUSHJ P,TYPR + MOVE E,CTIME+1 + PUSHJ P,SIXNTY + PUSHJ P,LISTF4 + PUSHJ P,SYMDAT ;TYPE OUT DATE + PUSHJ P,LISTF4 ;TYPE ANOTHER TAB + PUSHJ P,POM ;PUSH OUT PHASE OF MOON + SKIPG PTLFCD + POPJ P, + PUSHJ P,LISTF4 + MOVEI A,[ASCIZ \CREATED \] + PUSHJ P,ASCIND +PTLAB9: MOVEI A,"0 + HRRM A,DPT5 + TLZ FF,FLNEG +IRPS Q,R,[270400/220500/330700] + LDB C,[Q,,PTLFCD] + MOVEI TT,1 + PUSHJ P,DPT1 +IFSE R,/,[ MOVEI CH,"/ + PUSHJ P,@LISTF5 +] +TERMIN + CALL SPSP + HRRZ A,PTLFCD + LSH A,-1 +IRPS Q,R,[6:6:0] + IDIVI A,12 + PUSH P,B +IFN Q,[ IDIVI A,Q + PUSH P,B + PUSH P,["R-"0] +] +.ELSE PUSH P,A +TERMIN + MOVEI IN,10 +PTLAB3: POP P,CH + ADDI CH,"0 + PUSHJ P,@LISTF5 + SOJG IN,PTLAB3 + POPJ P, +] + +IFN TNX,[ +PTLAB: PUSHJ P,CRR1 + MOVEI A,ERDEV + CALL ASCIND + MOVEI CH,": ;DEVICE: + XCT LISTF5 + MOVEI CH,"< + XCT LISTF5 + MOVEI A,ERDEV+DEFDIR-DEFDEV + CALL ASCIND ;DIRECTORY + MOVEI CH,"> + XCT LISTF5 + CALL LISTF4 ;TYPE TAB + GJINF + MOVEI B,(A) ;LOGIN DIRECTORY + HRROI A,BAKTAB + DIRST + SETZM BAKTAB + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + HRROI A,BAKTAB + SETOB B,C + ODTIM + MOVEI A,BAKTAB + CALL ASCIND + CALL LISTF4 + CALL POM ;INSERT PHASE OF MOON + SKIPG PTLFCD + RET + CALL LISTF4 + MOVEI A,[ASCIZ /Last written /] + CALL ASCIND + MOVE A,CHFILI +IFN 20X,[ + MOVEI B,B + MOVEI C,1 + RFTAD +] +IFN 10X,[ + MOVE B,[1,,.FBWRT] + MOVEI C,B + GTFDB +] + HRROI A,BAKTAB + SETZ C, + ODTIM + MOVEI A,BAKTAB + JRST ASCIND + +.ST26B: SETZ A, + MOVE OUT,[440600,,A] + MOVEI IN,6 + HRLI C,440700 +.ST26C: ILDB CH,C + JUMPE CH,CPOPJ + SUBI CH,40 + IDPB CH,OUT + SOJG IN,.ST26C + RET +] + +IFN ITS,[ +AOFDIR: SYSCAL OPEN,[[.BAI,,CHRAND] ? DEFDEV ? ['.FILE.] ? [SIXBIT/(DIR)/] ? DEFDIR] + JRST OPNER1 + POPJ P, + +GFDBLK: MOVE CH,[440700,,FDRBUF] + MOVEM CH,FDRP + HRLI CH,-FDRBFL + SKIPN NOQUIT + SKIPL STOPF ;CHECK FOR QUIT; IF SO, PLAY LIKE EOF + .IOT CHRAND,CH + HRLI CH,EOFCHR_<18.-7> + HLLZM CH,(CH) + POPJ P, +] + +IFN ITS,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + PUSHJ P,FRD + PUSH P,B + SETZM PTLFCD + PUSHJ P,.FNPT2 + POP P,A + PUSHJ P,.FNPT2 + JRST FORMF +] +IFN TNX,[ +SYMLST: MOVEI CH,PPA + HRRM CH,LISTF5 + SETZM PTLFCD + CALL FRD0 ;GET FILESPEC + JRST OPNER1 + PUSH P,A + MOVSI C,001000 + CALL SYMLS2 ;PRINT FILENAME + MOVSI C,000100 + CALL SYMLS2 ;AND EXTENSION + POP P,A + RLJFN ;GET RID OF IT + JFCL + JRST FORMF + +SYMLS2: HRROI A,BAKTAB + MOVE B,-1(P) + JFNS + MOVEI A,BAKTAB + JRST .FNPT2 ;AND BIGPRINT IT +] + +LDBT1: REPEAT 3,LDB TT,LDBT2-1+.RPCNT*7(TT1) + +LDBT2: REPEAT 21.,[%T1==.RPCNT/7 + %T2==.RPCNT-%T1*7 + CH5.7T(B+200+<2*%T1+5*%T2>_12.) + ] + +CH5.7T: 0 ;SP +DEFINE .. A,B,C,D,E,F,G,H + IFSN H,,[PRINTC /CH5.7T LOSE! +/] + A_31.+B_26.+C_21.+D_16.+E_11.+F_6+G_1 +TERMIN + + .. 4,4,4,4,4,0,4,, ;! + .. 12,12,12,0,0,0,0,, ;" + .. 12,12,37,12,37,12,12,, ;# + .. 4,17,24,16,5,36,4,, ;$ + .. 36,31,2,4,10,23,3,, ;% + .. 4,12,4,10,25,22,15,, ;& + .. 4,4,4,0,0,0,0,, ;' + .. 2,4,10,10,10,4,2,, ;( + .. 10,4,2,2,2,4,10,, ;) + .. 0,25,16,33,16,25,0,, ;* + .. 0,0,4,33,4,0,0,, ;+ + .. 0,0,0,0,14,4,10,, ;, + .. 0,0,0,16,0,0,0,, ;- + .. 0,0,0,0,0,14,14,, ;. + .. 0,1,2,4,10,20,0,, ;/ + .. 16,21,23,25,31,21,16,, ;0 + .. 4,14,4,4,4,4,16,, ;1 + .. 16,21,1,2,4,10,37,, ;2 + .. 16,21,1,6,1,21,16,, ;3 + .. 2,6,12,37,2,2,2,, ;4 . . . OK, BEELER? + .. 37,20,36,1,1,21,16,, ;5 + .. 16,21,20,36,21,21,16,, ;6 + .. 37,1,2,4,10,20,20,, ;7 + .. 16,21,16,21,21,21,16,, ;8 + .. 16,21,21,17,1,21,16,, ;9 + .. 0,14,14,0,14,14,0,, ;: + .. 0,14,14,0,14,4,10,, ; ; + .. 0,2,4,10,4,2,0,, ;< + .. 0,0,37,0,37,0,0,, ;= + .. 0,10,4,2,4,10,0,, ;> + .. 16,21,2,4,4,0,4,, ;? + .. 16,21,27,25,27,20,17,, ;@ + .. 16,21,21,37,21,21,21,, ;A + .. 36,21,21,36,21,21,36,, ;B + .. 16,21,20,20,20,21,16,, ;C + .. 36,21,21,21,21,21,36,, ;D + .. 37,20,20,36,20,20,37,, ;E + .. 37,20,20,36,20,20,20,, ;F + .. 16,21,20,20,23,21,16,, ;G + .. 21,21,21,37,21,21,21,, ;H + .. 16,4,4,4,4,4,16,, ;I + .. 7,1,1,1,1,21,16,, ;J + .. 21,22,24,34,22,21,21,, ;K + .. 20,20,20,20,20,20,37,, ;L + .. 21,33,25,21,21,21,21,, ;M + .. 21,21,31,25,23,21,21,, ;N + .. 16,21,21,21,21,21,16,, ;O + .. 36,21,21,36,20,20,20,, ;P + .. 16,21,21,21,25,22,15,, ;Q + .. 36,21,21,36,21,21,21,, ;R + .. 16,21,20,16,1,21,16,, ;S + .. 37,4,4,4,4,4,4,, ;T + .. 21,21,21,21,21,21,16,, ;U + .. 21,21,21,21,21,12,4,, ;V + .. 21,21,21,21,21,25,12,, ;W + .. 21,21,12,4,12,21,21,, ;X + .. 21,21,12,4,4,4,4,, ;Y + .. 37,2,4,16,4,10,37,, ;Z + .. 6,4,4,4,4,4,6,, ;[ + .. 0,20,10,4,2,1,0,, ;\ + .. 14,4,4,4,4,4,14,, ;] + .. 4,16,25,4,4,4,4,, ;^ + .. 0,4,10,37,10,4,0,, ;_ + + IFN .-CH5.7T-64.,.. ,,,,,,,69 + + +SUBTTL DISPATCH TABLES + +IFN CTRLT,[ + +;^T DISPATCH TABLE +EDDPTB: +REPEAT 3., BELL ;^@ - ^B + EDCPY ;^C COPY NEXT CHAR + EDD ;^D DELETE NEXT CHAR + BELL ;^E + ED% ;^F HELP TYPE REST OF THIS LINE, CR-LF, WHAT'S BEEN DONE SO FAR + BELL ;^G QUIT (NEVER GETS HERE) + BELL ;^H + EDOV ;^I TAB, TAKE AS CHAR + EDOV ;^J LINEFEED TAKE AS CHAR + BELL ;^K + EDL ;^L COPY REST OF LINE W/O ECHO AND END EDIT + EDCR ;^M CR - END EDIT + EDN ;^N COPY THRU NEXT SPACE OR EOL + EDO ;^O DELETE THRU NEXT SPACE + EDP ;^P ENTER/LEAVE PUT(INSERT) MODE + EDQ ;^Q TAKE "T" AS CHAR ("T" IS CHAR FOLLOWING ^P IN TYPIN STRING) + EDR ;^R COPY REST OF LINE + EDS ;^S COPY TO CHAR "T" + EDT ;^T DELETE TO CHAR "T" +REPEAT 2,BELL ;^U - ^V + 400000,,EDW ;^W DELETE TO LAST SPACE +REPEAT 3, BELL ;^X - ^Z + EDALT ;^[ (ALTMODE) COPY REST WITH ECHO AND END EDIT ;] +REPEAT 4, BELL ; ^[, ^\, ^], ^^ AND ^_ + +] ;IFN CTRLT + +;THE ERROR TABLE: EACH WORD HAS THE 3-CHAR MESSAGE IN LH, +;POINTER TO ASCIZ STRING IN RH. +;THE TABLE IS SORTED WITH THE 3-CHAR MESSAGE AS THE KEY. +;THE FIRST ARG TO ERRDEF IS THE 3-CHAR MESSAGE. IT MUST +;CONSIST OF 3 SIXBIT CHARACTERS. +;THE SECOND ARG TO ERRDEF IS WHAT SHOULD BE GIVEN AS THE ARG +;TO THE TYPRE MACRO. IT MUST CONSIST OF 3 SQUOZE CHARS. +;IN TECO LISTINGS, CROSS-REFS GO UNDER THE NAME WHICH +;IS THE ARG TO ERRDEF. IN CREFS, THEY ARE UNDER THE LABEL ACTUALLY +;USED, WHICH HAS AN "ER$" CONCATENATED ON TO THE FRONT. +;OF TYPRE TO CHECK FOR THEM. + +IF1 [ +ERTOTL==0 ;ON PASS 1, ERTOTL ACCUMULATES AMOUNT OF STRING SPACE NEEDED FOR MESSAGES. + ;ALSO DEFINE THE LABELS FOR THE WORDS IN THIS TABLE. +DEFINE ERRDEF A,B,C/ +ER$!B ERTOTL==ERTOTL+<5+4+.LENGTH |C|+4>/5 + BLOCK 1 +TERMIN +] + +IF2 [ +ERNEXT==ERSTRT ;ON PASS 2, PUT THE STRINGS WHERE THEY BELONG, AND THE 3-CHAR NAMES HERE. + +DEFINE ERRDEF A,B,C/ +ER$!B SIXBIT /A/ ERNEXT*5-INIQRB+1 +ERTMP==. +.=ERNEXT + .BYTE 7 + 0 + QRSTR + ERLEN==<4+4+.LENGTH |C|> + ERLEN&177 + &177 + 0 + .BYTE + ASCII |A C| +ERNEXT==. +.=ERTMP +TERMIN +] + +ERRTAB: ERRDEF [..E]..E:,Bad value in q-reg ..E (output radix) + ERRDEF [2<1]2%1:,The second argument was less than the first + ERRDEF [AFN]AFN:,Ambiguous FS flag name + ERRDEF [AOR]AOR:,Argument out of range + ERRDEF [ARG]ARG:,Bad argument + ERRDEF [AVN]AVN:,Ambiguous variable or macro name. + ERRDEF [BD"]BD%:,Bad condition after " -- should be G,L,N,E,B,C,D,A or U + ERRDEF [BEL]BEL:,A built-in ^R command called from macro signaled an error + ERRDEF [CMD]CMD:,A char that isn't a TECO command was executed + ERRDEF [CNM]CNM:,Caller wasn't a macro (it was TECO internal code) + ERRDEF [DCD]DCD:,A disabled command was executed + ERRDEF [DSI]DSI:,Damned screw infinitely + ERRDEF [ERP]ERP:,Attempted :< ... ^\ with no closing > first + ERRDEF [ESR]ESR:,Empty sort record +;[ + ERRDEF [ICB]ICB:,Illegal ^] command + ERRDEF [IEC]IEC:,Illegal "E" command + ERRDEF [IFC]IFC:,Illegal "F" command + ERRDEF [IFN]IFN:,Illegal FS flag name + ERRDEF [IQN]IQN:,Invalid q-register name + ERRDEF [ILN]ILN:,Invalid local q-register number + ERRDEF [ISK]ISK:,Invalid sort key - "^P" command + ERRDEF [KCB]KCB:,Kill currently selected buffer + ERRDEF [M^R]M%R:,Attempted to macro a meaningless number + ERRDEF [NDO]NDO:,No device open for output - try "EW" + ERRDEF [NFC]NFC:,No free channels to pop into + ERRDEF [NFI]NFI:,No file open for input - try doing "ER" + ERRDEF [NHP]NHP:,Nonexistent horizontal position + ERRDEF [NIB]NIB:,You have addressed a character not in the buffer + ERRDEF [NIM]NIM:,Not inside a macro + ERRDEF [NOP]NOP:,Specified type of IO channel hasn't been pushed + ERRDEF [NRA]NRA:,File not random access + ERRDEF [N^R]N%R:,Not in ^R - command meaningful only inside ^R + ERRDEF [PDL]PDL:,Pushdown stack full + ERRDEF [PUR]PUR:,Attempted write in pure page + ERRDEF [RDO]RDO:,Attempt to modify a read-only buffer + ERRDEF [QIT]QIT:,^G typed on TTY and FS NOQUIT$ was negative + ERRDEF [QNB]QNB:,Q-register not buffer - attempt to select a string or number + ERRDEF [QNN]QNN:,Q-register not numeric + ERRDEF [QNS]QNS:,Q-register not string or buffer + ERRDEF [QRF]QRF:,Q-regs failed, probably TECO bug + ERRDEF [QRP]QRP:,Q-register PDL overflow or underflow + ERRDEF [SFL]SFL:,Search failed + ERRDEF [SNI]SNI:,Semicolon not in iteration + ERRDEF [SNR]SNR:,There is no valid search string to repeat + ERRDEF [STL]STL:,String argument too long + ERRDEF [STS]STS:,Dispatch string too short +;[[[ + ERRDEF [TMN]TMN:,Too many macro, ^]q-register, ^]^X, or ^]^Y nestings + ERRDEF [UBP]UBP:,Unbalanced parentheses found with an FL-type command + ERRDEF [UCT]UCT:,Unseen catch tag + ERRDEF [UEB]UEB:,FL-type command encountered end of buffer. + ERRDEF [UEC]UEC:,Unexpected end of command + ERRDEF [UGT]UGT:,Unseen go-tag + ERRDEF [UMC]UMC:,Unmatched ")" or ">" as a command + ERRDEF [URK]URK:,Buffer space or library space exhausted + ERRDEF [UTC]UTC:,Unterminated conditional + ERRDEF [UTI]UTI:,Unterminated iteration or errset (missing ">"?) + ERRDEF [UVN]UVN:,Undefined variable or macro name + ERRDEF [WLO]WLO:,FS OFACCP$ when old access pointer wasn't multiple of 5 + ERRDEF [WNA]WNA:,Wrong number of arguments + +LERTAB==.-ERRTAB + +IF2 IFN ERNEXT-EREND,.ERR LOSSAGE IN ERRTAB. + +; E COMMANDS DISPATCH TABLES + +ETAB: JRST EQMRK ;? + TYPRE [IEC] ;@ + TYPRE [IEC] ;A + TYPRE [IEC] ;B + JRST UICLS ;C + JRST DELE ;D + JRST EXITE ;E + JRST EFCMD ;F + JRST EGET ;G + TYPRE [IEC] ;H + JRST EICMD ;I + JRST EJCMD ;J + TYPRE [IEC] ;K + JRST CNTRU1 ;L + JRST LISTFM ;M + JRST RENAM ;N + TYPRE [IEC] ;O + JRST BPNTRD ;P +IFN ITS,JRST ALINK ;Q +IFN TNX,TYPRE [IEC] ;Q + JRST .OPNRD ;R + TYPRE [IEC] ;S + JRST ETCMD ;T + TYPRE [IEC] ;U + TYPRE [IEC] ;V + JRST WWINIT ;W +IFN TNX,JRST EXITX ;X +.ELSE TYPRE [IEC] + JRST LISTF ;Y + JRST LISTFM ;Z + JRST PSHIC ;[ + JRST PSHOC ;\ + JRST POPIC ;] + JRST POPOC ;^ + JRST FCOPY ;_ + +LETAB==.-ETAB + +;MUST BE SORTED BY FLAG NAME + +DEFINE FLG A,B,C + .1STWD SIXBIT/A/ +IFB C,[FSNORM,,]IFNB C,[C,,]B+IFB B,A +TERMIN + +FLAGS: FLG ADLINE, ;SIZE OF LINE ADJUST FILLS (FA) + FLG ALTCOU,TSALTC,FSALTC ;# CMD STRINGS WAITING TO BE READ. + FLG BACKAR,0,FSBAKA ;RETURN ARGS OF OLD MACRO FRAME + FLG BACKDE,MACDEP,FSRNLY ;DEPTH OF MACRO PDL. + FLG BACKPC,0,FSBAKP ;RETURN RELATIVE PC OF OLD MACRO FRAME + FLG BACKQP,0,FSBAKQ ;RETURN QPDL UNWIND POINTER OF OLD MACRO FRAME + FLG BACKRE,0,FSBKRT ;RETURN CONTROL TO SPECIFIED FRAME. + FLG BACKST,0,FSBAKS ;RETURN STRING POINTER TO MACRO ON MACRO PDL. + FLG BACKTR,0,FSBAKT ;TRACES BACK THE MACRO PDL. + FLG BBIND,0,FSBBIND ;PUSH OR POP CURRENT BUFFER CONVENIENTLY. + FLG BCONS,0,FSBCON ;RETURN A NEW BUFFER. + FLG BCREAT,0,FSCRBF ;CREATE NEW BUFFER (AND SELECT IT). + FLG BKILL,0,FSKILB ;ARG = POINTER TO BUFFER TO BE KILLED. + FLG BOTHCA, ;NONZERO => SEARCHES IGNORE CASE DISTINCTIONS. + FLG BOUNDA,0,FSBOUN ;BOUNDARIES OF PART OF BUFFER BEING EDITED. + FLG BSNOLF ;NOT 0 => BACKWARD MOTION SHOULDN'T BE FOLLOWED BY A LF. + FLG CASE,CASNRM ;SET CASE-SHIFTING MODE. + FLG CASENO,CASE ;SET CURRENT CASE-LOCK STATE. +IFN TNX,FLG CCLFNA,0,FSCCLF ;RETURN STRING FOR JFN IN 1 AT NORMAL ENTRY+2 + FLG CLKINT,CLKINT,FSCLKI ;SET CLOCK INTERVAL. + FLG CLKMAC,CLKMAC ;CLOCK HANDLER ROUTINE. + FLG CTLMTA,RRCMQT ;NEGATIVE => CONTROL-META-LETTER SSELF INSERTING. + FLG DATASW,0,FSSWIT ;PDP10 CONSOLE SWITCHES. + FLG DATE,0,FSDATE ;RETURN CURRENT DATE IN DISK FORMAT. + FLG DDEVICE,DEFDEV,FSSTRR ;DEFAULT DEVICE AND FILENAMES. + FLG DDFAST,0,FSDDFS ;-1 IF DEFAULT DEVICE IS "FAST". + FLG DFILE,0,FSDFILE ;DEFAULT FILE'S NAMES, AS STRING. + FLG DFN1,DEFFN1,FSSTRR + FLG DFN2,DEFFN2,FSSTRR + FLG DFORCE, ;NOT 0 => FINISH DISPLAY DESPITE PENDING INPUT, DON'T UPDATE MODE LINE. + FLG DSNAME,DEFDIR,FSDSNM + FLG DVERSI,DEFFN3,FSDVER ;DEFAULT FN2 AS NUMBER < AND > SPECIAL + FLG DWAIT ;NONZERO => DON'T ALLOW MUCH STUFF IN TTY OUTPUT BUFFER. + FLG ECHOAC,ECHACT ;-1 => ECHO AREA IS ACTIVE (CRUFT SHOULD BE CLEARED BY ^R). + FLG ECHOCH,ECHCHR ;NONZERO => INHIBIT SCAN-ECHOING THIS ^R COMMAND. + FLG ECHODI,0,FSECDS ;(WRITE-ONLY) ECHO-MODE DISPLAY-MODE OUTPUT OF ARG. + FLG ECHOER,ERRECH ;NONZERO => TYPE ERR MSGS IN ECHO AREA. + FLG ECHOFL,ECHFLS ;NONZERO => CLEAR ECHO AREA AFTER EACH COMPLETE ^R COMMAND. + FLG ECHOLI,0,FSECLS ;# OF COMMAND LINES. + FLG ECHOOU,0,FSECOT ;(WRITE-ONLY) ECHO-MODE OUTPUT OF ARGUMENT. + FLG ERR,LASTER,FSERR ;SIGNAL AN ARBITRARY ERROR. + FLG ERRFLG,ERRFL1 ;WHEN ..B OR ..G MACROED, THIS + ;HAS 0 OR ERROR CODE OF CMD STRING JUST ENDED. + FLG ERROR,LASTER, ;ERROR CODE OF MOST RECENT ERROR. + FLG ERRTHROW,0,FSERTH ;THROW TO ERROR-CATCHING COMMAND LOOP (^R OR :@<). + FLG EXIT,0,FSEXIT ;DO .BREAK 16, TO INTERUPT SUPERIOR. + FLG FDCONV,0,FSDCNV ;CONVERT NUMERIC TO ASCII FILE DATES. + FLG FILEPA, ;CHAR TO PAD LAST WD OF OUTPUT FILE WITH. + FLG FLUSHED,MORFLF ;0 => NOT AFTER --FLUSHED, 1 => RUBOUT, -1 => OTHER FLUSHAGE. + FLG FNAMSY, ;0 => IF ONLY ONE FILENAME, IT IS FN2. + ;> 0 => ONLY ONE FILENAME IS FN1. + ;< 0 => ONLY ONE FNAME IS FN1, AND FN2 IS ">". +IFN 20X,FLG FORKJC,FRKJCL ;JCL FOR THE GIVEN FORK + FLG GAPLEN,EXTRAC,FSRNLY ;SIZE OF GAP. + FLG GAPLOC,GPT,FSROCA ;CHAR ADDR OF GAP. + FLG HEIGHT,NVLNS,FSRNLY ;NUMBER OF LINES TO DISPLAY + FLG HELPCH, ;CHARACTER TO INVOKE "HELP" MACRO + FLG HELPMAC, ;MACRO TO CALL IF USER TYPES "HELP" KEY. + FLG HPOSIT,0,FSHPOS ;PHYSICAL POSITION OF A 2741 TYPEBALL IF IT TYPED FROM THE PREVOUS CARRET + FLG HSNAME,,FSDIRH ;HOME DIRECTORY NAME. + FLG I&DCHR,CID ;NONZERO => TRY TO USE CHAR I/D. + FLG I&DLIN,LID ;NONZERO => TRY TO INSERT AND DELETE LINES. + FLG I.BASE, ;INPUT RADIX FOR #S FOLLOWED BY ".". + FLG IBASE, ;ORDINARY INPUT RADIX. + FLG IFACCE,0,FSIFAC ;(WRITE-ONLY) SET INPUT FILE ACCESS PTR + FLG IFCDAT,CHFILI,FSFDAT ;NUMERIC CREATION DATE OF INPUT FILE. + FLG IFDEVI,ERDEV,FSSTRR ;DEVICE NOW READING FROM. +IFN ITS,FLG IFDUMP,CHFILI,FSDUMP ;FILE HAS BEEN DUMPED BIT. +IFN TNX,FLG IFFDB,CHFILI,FSIFDB ;READ OR MODIFY FILE DESCRIPTOR BLOCK + FLG IFFN1,,FSSTRR ;FN1 OF FILE NOW OPEN FOR READING. + FLG IFFN2,,FSSTRR ;FN2 OF FILE NOW OPEN FOR READING. + FLG IFILE,0,FSIFILE ;FILENAMES OF FILE NOW READING , AS STRING. + FLG IFLENG,0,FSIFLEN ;(R-O) LENGTH OF INPUT FILE. + FLG IFMTAP,CHFILI,FSMTAP ;DO .MTAPE ON INPUT FILE. +IFN ITS,FLG IFREAP,CHFILI,FSREAP ;DON'T REAP BIT. + FLG IFSNAM,,FSSTRR ;SNAME OF FILE NOW READING FROM. + FLG IFVERS,,FSFVER ;VERSION OF FILE OPEN FOR READING. + FLG IMAGEO,0,FSIMAG ;(WRITE-ONLY) IMAGE MODE OUTPUT OF ARG + FLG INCOUN,INCHCT ;NUMBER OF INPUT CHARACTERS SO FAR. + FLG INSLEN,INSLEN ;LENGTH OF THE LAST INSERT STRING +IFN ITS,FLG JNAME,.RJNAM,FSRSYS ;GET TECO'S JNAME. +IFN TNX,FLG JNAME,0,FSGTNM + FLG LASTPA,,FSRNLY ;SET BY TECO TO 0 AFTER READING LAST PAGE OF IPUT FILE. + FLG LINES,NLINES ;NUMBER OF LINES TO DISPLAY + FLG LISPT,INITFL ;NONZERO => TECO WAS STARTED AT ALTERNATE ENTRY + ;POINT SIGNIFYING THAT SUPERIOR IS A LISP. + FLG LISTEN,0,FSLISN ;DO .LISTEN, MAYBE PROMPT VIA FS ECHOT. +IFN TNX,FLG LOADAV,0,FSLOAD ;1 MINUTE LOAD AVERAGE +IFN ITS,FLG MACHIN,,FSRNLY ;READ MACHINE NAME +IFN TNX,FLG MACHIN,0,FSMACH + FLG MODECH,MODCHG ;NONZERO SAYS MODMAC MUST BE CALLED. + FLG MODEMA,MODMAC ;NONZERO => IS MACRO TO RECOMPUTE ..J WHEN NECESSARY. + FLG MODIFI,MODIFF ;SET NONZERO WHEN BUFFER WRITTEN IN. +IFN ITS,FLG MPDISP,0,FSMPDS ;DISPLAY OUTPUT TO M.P. AREA. +IFN ITS,FLG MSNAME ;READ WORKING DIRECTORY NAME +IFN TNX,FLG MSNAME,0,FSDIRS ;READ CURRENT CONNECTED DIRECTORY + FLG NLAROW, ;<>0=> DON'T ALLOW _ COMMAND + FLG NOOPAL, ;SAY WHAT TO TO WITH ALTMODES AS COMMANDS. + ;0 => ERROR, -1 => IGNORE, 1 => LIKE ^_. + FLG NOQUIT,,FSNQIT ;0 => ^G QUITS NORMALLY. + ;POS => ^G JUST SETS STOPF; NO QUITTING. + ;NEG => ^G CAUSES ERRSETABLE "QIT" ERROR. + FLG OFACCE,0,FSOFAC ;(WRITE-ONLY) SET OUTPUT FILE ACCESS POINTER + FLG OFCDAT,CHFILO,FSFDAT ;DATE OF OUTPUT FILE (NUMERIC) + FLG OFILE,0,FSOFILE ;REAL NAMES OF LAST OUTPUT FILE CLOSED. + FLG OFLENG,0,FSOFLEN ;LENGTH OF OUTPUT FILE. + FLG OFMTAP,CHFILO,FSMTAP ;DO .MTAPE ON OUTPUT FILE. + FLG OFVERS,,FSFVER ;VERSION LAST OUTPUT FILE + FLG OLDFLU,OLDFLF ;OLD VALUE OF FS FLUSHED, IN NEXT ^R COMMAND AFTER THE FLUSHED ONE. + FLG OLDMOD,DISOMD ;LAST ..J VALUE DISPLAYED. + FLG OSPEED ;OUTPUT SPEED IN BAUD, OR 0 IF UNKNOWN. + FLG OSTECO,TNX+10X,FSVAL ;OPERATING SYSTEM, 0 => ITS, + ;1 => TWENEX, 2 => TENEX + FLG OUTPUT,OUTFLG ;-1 => OUTPUT TO FILE DISABLED. +IFN TNX,FLG PADCHR ;-1 => USE DELAY INSTEAD OF PADDING. + FLG PAGENU, ;PAGE # IN CURRENT INPUT FILE. + FLG PJATY ;NONZERO => SCREEN NEEDS REFRESHING. + FLG PROMPT,PROMCH ;0, OR ASCII VALUE OF PROMPT CHAR. + FLG PUSHPT,0,FSPSPT ;DO ^V + FLG QPHOME,0,FSQPHO ;QREG PDL SLOT - WHERE IT WAS PUSHED FROM. + FLG QPPTR,0,FSQPPT ;QREG PDL PTR + FLG QPSLOT,0,FSQPSL ;QREG PDL SLOT (ARG SAYS WHICH ONE) + FLG QPUNWI,0,FSQPUN ;UNWIND QREG PDL. + FLG QUIT,STOPF ;NEGATIVE => A ^G-QUIT HAS BEEN REQUESTED. + FLG QVECTO,0,FSQVEC ;RETURN A NEW QREG VECTOR BUFFER. + FLG RANDOM,RDMNMS ;RANDOM # GENERATOR'S SEED. + FLG READON ;NON-0 => DONT ALLOW MODIFICATION OF THIS BUFFER + FLG REALAD,BEG,FSRNLY ;PHYS CHAR ADDR OF BEGINNING OF BUFFER. + FLG REFRES,REFRSH ;MACRO TO REDISPLAY WHOLE SCREEN. + FLG REREAD,UNRCHC ;-1, OR TTY CHARACTER TO RE-READ. + FLG RGETTY,RGETTY,FSRNLY ;NON-0=> DISPLAY TERMINAL + FLG RUBCRL ;NON-0 => RUBOUT AND ^D DELETE A WHOLE CRLF AT ONCE. + FLG RUBMAC ;MACRO TO DO DELETE IN ^R OF MORE THAN ONE CHAR. + FLG RUNTIM,0,FSRUNT ;NUMBER OF MICROSECONDS OF CPU TIME USED + FLG SAIL,DISSAI ;NON0 => TTY ASSUMED TO PRINT SAIL CHAR SET. + FLG SEARCH,SFINDF ;VALUE RETURNED BY THE LAST SEARCH + FLG SERROR,SRCERR ;NONZERO => FAILING SERACHES ARE ERRORS EVEN IN ITERATIONS. + FLG SHOWMO,SHOMOD ;NOT 0 => FR SHOULD PRINT ..J ON PRINTING TTY. + FLG SHPOS,0,FSSHPS ;LIKE FS HPOS BUT CTL CHARS APPEAR AS ON SCREEN. + FLG SSTRING,0,FSSSTR ;CURRENT SEARCH STRING, AS A STRING. + FLG STEPDE,STEPDE ;MAXIMUM MACRO PDL DEPTH FOR STEPPING TO GO ON. + FLG STEPMA,STEPFL ;NONZERO => SINGLE STEP MACROS, LINE AT A TIME. + FLG SUPERI,SUPHND ;MACRO TO HANDLE REQUESTS FROM SUPERIOR. + FLG SVALUE,SFINDF ;VALUE RETURNED BY LAST SEARCH. + FLG TOPLIN,TOPLIN,FSTPLN ;1ST LINE TO USE FOR BUFFER DISPLAY. + FLG TRACE,<(.BP FRTRACE)>,FSWBIT ; -1 IFF IN TRACE MODE. + FLG TRUNCA,DISTRN ;CONTROLS TRUNCATION VS. CONTINUATION OF TYPED LINES. + ;NEGATIVE => TRUNCATE, ELSE CONTINUE. + FLG TTMODE,TTMODE +IFN 20X,FLG TTPAGM,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) +IFN TNX,FLG TTYFCI,FCITYI ;WHETHER OR NOT TO FLUSH HIGH ORDER BIT + FLG TTYINI,0,FSTTYI ;RE-INIT THE VARS RELATING TO TYPE OF TTY. + FLG TTYMAC,TTYMAC ;MACRO FOR FS TTY INIT$ TO CALL. + FLG TTYOPT, ;TTY'S TTYOPT VARIABLE. +IFN 20X,FLG TTYPAG,PAGMOD,FSTTPG ;PAGE MODE HANDLING (^Q/^S) + FLG TTYSMT, ;TTY'S TTYSMT VARIABLE. + FLG TYIBEG,INCHRR + FLG TYICOU,INCHCT + FLG TYISIN,TYISNK ;MACRO CALLED WITH EACH INPUT CHARACTER, FOR DEFINING KBD MACRO + FLG TYISOU,TYISRC ;MACRO CALLED TO GET INPUT CHARS FROM KBD MACRO. + FLG TYOHAS,0,FSHCD ;HASH CODE OF SCREEN LINE. + FLG TYOHPO,CHCTHP,FSRNLY ;HPOS OF TYPEOUT, AT THE MOMENT. + FLG TYPEOU,TYOFLG ;-1 => NEXT TYPEOUT GOES AT SCREEN TOP. + ;ELSE TYPEOUT HAS BEEN DONE AND MORE TYPEOUT FOLLOWS IT. +IFN ITS,FLG UHSNAM,0,FSUHSN ;GET HSNAME OF A USER FROM DDT. +IFN ITS,FLG UINDEX,.RUIND,FSRSYS ;GET TECO'S JOB NUMBER. +IFN TNX,FLG UINDEX,0,FSJOBN +IFN ITS,FLG UMAILF,0,FSUML ;GET FILENAME OF A USER'S MAIL FILE FROM DDT. +IFN ITS,FLG UNAME,.RUNAME,FSRSYS ;GET TECO'S UNAME. +IFN TNX,FLG UNAME,0,FSDIR2 + FLG UPTIME,0,FSUPTI ;SYSTEM UP TIME IN 60'TH'S. + FLG UREAD,<(.BP (FLIN))>,FSBIT ;-1 IF INPUT FILE, ELSE 0. + FLG UWRITE,<(.BP (FLOUT))>,FSBIT ;-1 IFF OUTPUT FILE OPEN, ELSE 0. + FLG VARMAC, ;NONZERO => ENABLE FEATURE TO RUN MACRO WHEN VARIABLE CHANGES. + FLG VB,0,FSVB ;BEGV, BUT CAN BE PUSHED/POPPED. + FLG VERBOS,VERBOS ;<>0=> DISPLAY MOBY ERROR MESSAGES + FLG VERSIO,.FVERS,FSVAL ;VERSION NUMBER OF THIS TECO + FLG VZ,0,FSVZ ;Z-ZV, BUT CAN BE PUSHED/POPPED. + FLG WIDTH,NHLNS,FSWIDTH ;SIZE OF THE TYPED\DISPLAYED LINE + FLG WINDOW,GEA ;CHAR ADDR (REL BEGV) OF 1ST CHAR IN WINDOW + FLG WORD,0,FSWORD ;GET OR SET SOME WORD IN THE CURRNET BUFFER. +IFN ITS,FLG XJNAME,.RXJNA,FSRSYS ;INSERT .XJNAME IN BUFFER +IFN TNX,FLG XJNAME,0,FSGTNM + FLG XPROMP,RUBENC ;0, OR CHAR TO TYPE NEXT TIME DISINI DONE. +IFN ITS,FLG XUNAME,.RXUNA,FSRSYS ;INSERT .XUNAME IN BUFFER +IFN TNX,FLG XUNAME,0,FSDIR2 + FLG YDISAB, ;DISABLES Y COMMAND IN VARIOUS WAYS + FLG Z,Z,FSROCA ;# CHARS IN BUFFER (Z COMMAND IS 1 + # OF LAST CHAR IN RANGE BEING EDITED.) + FLG ^HPRIN,DISPBS ;PRINT BS AS BS? NEGATIVE => YES. + FLG ^IDISA,TABMOD ;0 => TABS INSERT 1 => ERROR -1 => IGNORE. + FLG ^LINSE,FFMODE ;NON0 => ^L'S READ FROM FILE GO IN BUFFER. + FLG ^MPRIN,DISPCR ;STRAY CR CAN COME OUT AS CR? NEGATIVE => YES. + FLG ^PCASE,PSCASE ;NONZERO => ^P SORT IGNORES CASE. + FLG ^RARG,RRRPCT ;BASIC ^R-MODE ARGUMENT (SET BY ^V) + FLG ^RARGP,RRARGP ;0 => USE 1 INSTEAD OF FS ^RARG$. + FLG ^RCCOL,RRCCOL ;COMMENT COLUMN FOR ^R MODE. + FLG ^RCMAC,0,FSCRMA ;MACROS ASSOCIATED WITH CHARS. + FLG ^RDISP,RRDISM ;MACRO TO RUN WHEN ABOUT TO DO NONTRIVIAL REDISPLAY. + FLG ^RECHO,RRECHO ;CONTROLS ECHOING OF CHARACTERS READ IN BY ^R. + FLG ^RECSD,RRECSD ;IF SPACE'S DEFINITION EQUALS THIS, RRECIN CAN ECHO SPACES. + FLG ^RENTER,RRENTM ;MACROED WHEN ^R IS ENTERED. + FLG ^REXIT,0,FSCREX ;EXIT FROM ^R WHEN EXECUTED. + FLG ^REXPT,RR4TCT ;EXPONENT-OF-4, INCREMENTED BY ^U. + FLG ^RHMIN,RRMNHP,FSRNLY ;HPOS OF FIRST CHANGE ON SCREEN NEEDING REDISPLAY. + FLG ^RHPOS,RRHPOS ;HPOS OF CURSOR IN ^R MODE. + FLG ^RINCO,INCHRR ;TOTAL # OF INPUT CHARS, AT START OF LAST ^R COMMAND. + FLG ^RINDI,0,FSINDT ;TRACE ^R INDIRECT COMMAND DEFINITIONS. + FLG ^RINHI,RRINHI ;NONZERO INHIBITS ALL DISPLAY UPDATING. + FLG ^RINIT,0,FSCRIN ;INITIAL VALUE OF FS ^R CMACRO$ + FLG ^RINSE,0,FSRRINS ;INTERNAL ^R 1-CHAR INSERT ROUTINE. + FLG ^RLAST,RRLAST ;MOST RECENT ^R-MODE CHAR (EXCEPT ARG-SETTING CHARS) + FLG ^RLEAVE,RRLEVM ;MACROED WHEN ^R EXITS (BUT NOT IF ERR'D OR THROWN THRU) + FLG ^RMARK,RRMKPT ;THE ^R-MODE MARK, SET BY ^T. -1 => NO MARK NOW. + FLG ^RMAX,RRTTMX ;MAX # CHARS OF INSERT OR DELETE TO TYPE OUT. + FLG ^RMCNT,RRMCC1 ;THE COUNTER USED TO TELL WHEN TO CALL SEC'Y MACRO. + ;INITTED FROM FS ^RMDLY, COUNTED DOWN TO 0. + FLG ^RMDLY,RRMCCT ;# OF ^R CMDS TO DO BETWEEN INVOCATIONS OF SEC'Y MACRO. + FLG ^RMODE,DISPRR,FSRNLY ;NONZERO IN ^R MODE. + FLG ^RMORE,RRMORF ;> 0 SAYS USE --MORE-- INSTEAD OF --TOP-- IN ^R MODE. + ;< 0 SAYS USE NEITHER --MORE-- NOR --TOP--. + FLG ^RNORM,RRXINV ;THIS IS THE REAL DEFINITION OF ANY ^R-MD CHAR DEFINED + ;TO BE "SELF-INSERTING". ZERO MEANS ACTUALLY SELF-INSERT. + FLG ^RPAREN,RRPARN ;THIS GETS RUN FOR SELF-INSERTING CHARS THAT HAVE ")" SYNTAX. + FLG ^RPREV,RRPRVC ;THE ^R-MODE COMMAND CHAR BEFORE THE ONE IN ^R LAST. + FLG ^RREPL,RRRPLC ;CONTROLS INSERTION VS REPLACEMENT BY NORMAL CHARS. + FLG ^RRUBO,0,FSRRRUB ;INTERNAL ^R RUBOUT ROUTINE. + FLG ^RSCAN,RRSCAN ;NONZERO => ^R ON PRINTING TTY PRINTS CHARS MOVED OVER. + FLG ^RSUPP,RRALQT ;NONZERO SUPPRESSES BUILTIN COMMANDS + FLG ^RTHRO,0,FSCRTH ;THROW TO INNERMOST ^R INVOCATION. + FLG ^RUNSU,RRUNQT + FLG ^RVMIN,RRMNVP,FSRNLY ;VPOS OF FIRST CHANGE ON SCREEN NEEDING REDISPLAY. + FLG ^RVPOS,RRVPOS ;VPOS OF CURSOR IN ^R MODE. + FLG _DISAB,NLAROW + FLG %BOTTO, ;PERCENT AT BOTTOM BARRED TO CURSOR. + FLG %CENTE, ;PERCENT FROM TOP TO PREFERRED LOCATION FOR CURSOR (WHEN WINDOW CHOSEN) + FLG %END, ;PERCENT AT BOTTOM BARRED TO CURSOR WHEN WINDOW CHOSEN. +IFN ITS,FLG %OPLSP,<(.BP (%OPLSP))>,FSOPTL ;VALUE OF JOB'S %OPLSP BIT (SUPERIOR IS LISP). + FLG %TOCID,<(.BP (%TOCID))>,FSTTOL ;VALUE OF TTY'S %TOCID BIT. + FLG %TOFCI,<(.BP (%TOFCI))>,FSTTOL ;VALUE OF TTY'S %TOFCI BIT. + FLG %TOHDX,<(.BP (%TOHDX))>,FSTTOL ;VALUE OF TTY'S %TOHDX BIT. + FLG %TOLID,<(.BP (%TOLID))>,FSTTOL ;VALUE OF TTY'S %TOLID BIT. + FLG %TOLWR,<(.BP (%TOLWR))>,FSTTOL ;VALUE OF TTY'S %TOLWR BIT. + FLG %TOMOR,<(.BP (%TOMOR))>,FSTTOL ;VALUE OF TTY'S %TOMOR BIT. + FLG %TOOVR,<(.BP (%TOOVR))>,FSTTOL ;VALUE OF TTY'S %TOOVR BIT. + FLG %TOP, ;PERCENT OF SCREEN AT TOP BARRED TO CURSOR. + FLG %TOROL,<(.BP (%TOROL))>,FSTTOL ;VALUE OF TTY'S %TOROL BIT. + FLG %TOSAI,<(.BP (%TOSAI))>,FSTTOL ;VALUE OF TTY'S %TOSAI BIT. + FLG *RSET,UNWINF ;NONZERO PREVENTS AUTOMATIC QRP UNWINDING. + FLG .CLRMO,CLRMOD ;NONZERO => CLEAR SCREEN WHEN TTY GIVEN BACK BY SUPERIOR. + FLG .KILMO,KILMOD ;(NORMALLY NON-0) 0 MAKES FSBKILL$ A NOOP. + FLG .TYIBA,0,FSTBBK ;DECREMENT THE FS .TYIPT$ POINTER. + FLG .TYINX,0,FSTBNXT ;ILDB THAT POINTER AND RING IT AROUND TO GET NEXT OLD TYI CHAR. + FLG .TYIPT,TYIBFQ,FSRNLY ;POINTER TO NEXT TYI CHARACTER IN RING BUFFER. + FLG :EJPAG,LHIPAG,FSEJPG ;# OF LOWEST PAGE IN USE BY PURE STRING SPACE +IFN TNX,FLG :ETMOD,ETMODE ;BITMASK OF FIELDS TO DEFAULT IN :ET COMMAND +FLAGSL==<.-FLAGS>/2 + +FLAGD==FLAGS+1 + + <-1>_-1 ;THIS TERMINATES THE AMBIGUITY TEST AT FSFND. + BLOCK 4 ;FOR PATCHING (HARD BUT POSSIBLE) + +IFCERR==TYPRE [IFC] + +FDTB: JRST FCTLAT ;^@ + JRST FCACMD ;^A + JRST FMEMQ ;^B +TYPIFC: IFCERR ;^C + IFCERR ;^D + JRST FCECMD ;^E + JRST FCTLF ;^F + JRST FCTLG ;^G + IFCERR ;^H + IFCERR ;^I + IFCERR ;^J + JRST FCTLK ;^K + REPEAT ^R-^K-1,IFCERR + JRST RRALTR ;^R + JRST TABSRC ;^S + REPEAT ^X-^S-1,IFCERR + JRST FCTLX ;^X + JRST FCTLY ;^Y ;[ + REPEAT 4,IFCERR ;^Z - ^] + JRST FCTLUP ;^^ + IFCERR ;^_ + IFCERR ;SPACE + IFCERR ;! + JRST FDQUOT ;" + IFCERR ;# + JRST FSCASE ;$ + REPEAT 3,IFCERR ;%-' + JRST FOPEN ;( + JRST FCLOSE ;) + JRST FNOOP ;* + JRST CTLL ;+ + REPEAT "6-"+-1,IFCERR + JRST FSIXB ;6 + REPEAT ";-"6-1,IFCERR + JRST FSEMIC ;; + JRST FLSSTH ;< + JRST FEQ ;= + IFCERR ;> + JRST FLSCMD ;? + IFCERR ;@ + JRST ADJUST ;A + JRST FBCMD ;B + JRST LOWCON ;C + JRST FDCMD ;D + JRST FECMD ;E + IFCERR ;F + JRST FGCMD ;G + IFCERR ;H + JRST FTYI ;I + JRST FJCL ;J + JRST FKCMD ;K + JRST FLCMD ;L + JRST FMCMD ;M + JRST FNCMD ;N + JRST FOCMD ;O + JRST FDATTY ;P + JRST QLEN ;Q + JRST FRCMD ;R + JRST FSET ;S + JRST FTYPE ;T + JRST FUCMD ;U + JRST FVIEW ;V + JRST FWCMD ;W + JRST FXCMD ;X + JRST FYCMD ;Y +IFE TNX,IFCERR ;Z +IFN TNX,JRST FZCMD ;Z + JRST FPUSH ;[ + IFCERR ;\ + JRST FPOP ;] + JRST FAPPRX ;^ + JRST SERCHA ;_, LIKE NORMAL _ CMD. +IFN .-FDTB-140,[PRINTX \FDTB LOSS +\] + + +DTB: HRROI B,CNTRAT ;^@ + MOVEI B,COR ;^A + HRROI B,CTLB ;^B + TYPRE [CMD] ;^C + TYPRE [CMD] ;^D + TYPRE [CMD] ;^E + HRROI B,CNTRLF ;^F + TYPRE [CMD] ;^G - TS QUIT + TYPRE [CMD] ;^H - BACKSPACE + JRST TAB ;^I - TAB + MOVEI B,CD ;^J - LINE FEED + HRROI B,DECDMP ;^K - VALRET SOMETHING + HRROI B,CTLL ;^L - FORM FEED + HRROI B,CTLM ;^M - CARR RET + HRROI B,CNTRLN ;^N + HRROI B,SYMLST ;^O + HRROI B,PSORT ;^P + TYPRE [CMD] ;^Q + HRROI B,RRENTR ;^R + HRROI B,ASLEEP ;^S +IFN CTRLT,HRROI B,EDIT ;^T +.ELSE TYPRE [CMD] ;^T + HRROI B,CNTRLU ;^U + HRROI B,CTLV ;^V + JRST CTLW ;^W + HRROI B,GMARG1 ;^X + HRROI B,GMARG2 ;^Y + HRROI B,RANDOM ;^Z + JRST ALTCMD ;ALTMODE + MOVEI B,MEXIT ;^\ + TYPRE [CMD] ;[ ;^] + HRROI B,CNTRUP ;^^ + JRST LGOGO ;^_ + + MOVEI B,SPACE ; + MOVEI B,EXCLAM ;! + MOVEI B,DQUOTE ;" + MOVEI B,CXOR ;# + HRROI B,NEWAS ;$ + HRROI B,PCNT ;% + MOVEI B,CAND ;& + JRST CD5A ;' + MOVEI B,OPEN ;( + MOVEI B,CLOSE ;) + MOVEI B,TIMES ;* + MOVEI B,PLUS ;+ + MOVEI B,COMMA ;, + MOVEI B,MINUS ;- + JRST PNT ;. + MOVEI B,SLASH ;/ +REPEAT 12,JRST CDNUM ;DIGITS 0 - 9. + JRST ACOLON ;: + MOVEI B,SEMICL ; ; + MOVEI B,LSSTH ;< + HRROI B,PRNT ;= + JRST GRTH ;> + HRROI B,QUESTN ;? + JRST ASLSL ;@ + HRROI B,APPEND ;A + HRROI B,BCMD ;B + HRROI B,CHARAC ;C + HRROI B,DELETE ;D + HRROI B,ECMD ;E + HRROI B,FCMD ;F + HRROI B,QGET ;G + HRROI B,HOLE ;H + HRROI B,INSERT ;I + HRROI B,JMP ;J + HRROI B,KILL ;K + HRROI B,LINE ;L + MOVEI B,MAC ;M + HRROI B,SERCHP ;N + MOVEI B,OG ;O + HRROI B,PUNCH ;P + HRROI B,QREG ;Q + HRROI B,REVERS ;R + HRROI B,SERCH ;S + HRROI B,TYPE ;T + HRROI B,USE ;U + HRROI B,VIEW ;V + MOVEI B,CD ;W + HRROI B,X ;X + HRROI B,YANK ;Y + HRROI B,END1 ;Z + HRROI B,OPENB ;[ + HRROI B,BAKSL ;\ + HRROI B,CLOSEB ;] + JRST ASLSL ;^ + JRST BAKARR ;_ +IFN .-DTB-140,.ERR DTB WRONG # ENTRIES. + +CONSTANTS + +PAT: +PATCH": BLOCK 200 +PATCHE": 0 + +HUSED: INFORM [TOP OF PURE]\.-1 + +LOC <.+1777>&776000 +VARIABLES +IFN .&1777, .ERR VARIABLES! + +HIMPUR:: + +;IF ^R VARIABLES DON'T FIT IN LOW IMPURE, PUT THEM HERE. +IFG +RRVARL-1777, RRVARB:: BLOCK RRVARL + +;^R-MODE COMMAND DISPATCH TABLE. POSITIVE => BUILTIN COMMAND; +;RH IS DISP. ADDR, LH IS EXTRA INFO (SECONDARY DISP. ADDR). +;NEGATIVE => IT IS STRING POINTER TO MACRO. +RRMACT: +;NON-CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRXINS ;^@ - ^G +REPEAT 3,RRINSC,,RRREPI ;^H, ^I, ^J NEVER REPLACE, REGARDLESS OF FS ^R REPLACE$ + RRXINS ;^K + RRXINS ;^L + RRCRLF,,RRREPT ;^M +REPEAT 33-^M-1,RRXINS ;^N - ^Z + RREXIT ;ALTMODE +REPEAT "A+40-ALTMOD-1,RRXINS ;^\ - ` +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS. +REPEAT 4,RRXINS ;LOWERCASE SPECIAL CHARACTERS. + RRRUB + +.SEE RRITAB ;MUST BE CHANGED WHEN THE ENTRIES BELOW ARE CHANGED. +;CONTROL, NON-META CHARACTERS: +REPEAT ^H,RRUNDF ;CONTROL-^@ TO CONTROL-^G +REPEAT 3,200,,RRINDR ;CONTROL-BS TO CONTROL-LF. +REPEAT 2,RRUNDF ;CONTROL-^K AND CONTROL-^L. + 200,,RRINDR ;CONTROL-CR +REPEAT 33-^M-1,RRUNDF ;CONTROL-^N THROUGH CONTROL-^Z. + 200,,RRINDR ;CONTROL-ALTMODE. +REPEAT "--33-1,RRUNDF ;CONTROL-^\ TO CONTROL-, + RRCMNS ;CONTROL-MINUS +REPEAT "0-"--1,RRUNDF ;CONTROL-. TO CONTROL-/ +REPEAT 10.,RRCDGT ;CONTROL-0 THRU CONTROL-9 +REPEAT 100-"9-1,RRUNDF ;CONTROL-: TO CONTROL-? + RRUNDF ;^@ + RRBEG ;^A + RRCTLB ;^B + RRCMSW ;^C + RRCTLD ;^D + RREND ;^E + RRCTLF ;^F + RRQUIT ;^G + 300,,RRINDR ;^H + 300,,RRINDR ;^I + 300,,RRINDR ;^J + RRKILL ;^K + RRCTLL ;^L + RRINSC,,RRREPI ;^M + RRNEXT ;^N + RRCTLO,,RRREPT ;^O + RRPREV ;^P + RRQUOT ;^Q + RRCMCS ;^R + RRSRCH ;^S + RRMARK ;^T + RR4TIM ;^U + RRARG ;^V + RRFX ;^W + RREXCH ;^X + RRUNDF ;^Y + RRUNDF ;^Z + RRUNDF ;^[ + RRUNDF ;^\ + RRBRC ;^] + RRUNDF ;^^ + RRUNDF ;^_ + RRUNDF ;^` +REPEAT 32,40,,RRINDR ;^ +REPEAT 4,RRUNDF ;^{ ^| ^} ^~ + RRCRUB ;CONTROL-RUBOUT. +IFN .-RRMACT-400,,.ERR + +;META CHARS: +REPEAT "-,RRXINS + RRCMNS +REPEAT "0-"--1,RRXINS +REPEAT 10.,RRCDGT +REPEAT "A+40-"9-1,RRXINS +REPEAT 26.,40,,RRINDR ;LOWERCASE LETTERS INDIRECT THRU UPPERCASE. +REPEAT 5,RRXINS + +;CONTROL-META CHARS: MOSTLY SELF-INSERTING, BUT SOME ARE INDIRECT THROUGH OTHERS. +REPEAT ^H,RRXINS ;^@ THRU ^G +REPEAT 3,200,,RRINDR ;^H THRU ^J +REPEAT 2,RRXINS ;^K, ^L + 200,,RRINDR ;^M +REPEAT 33-^M-1,RRXINS ;^N TO ^Z + 200,,RRINDR ;ALTMODE +REPEAT "--33-1,RRXINS ;^\ TO COMMA + RRCMNS ;MINUS SIGN +REPEAT "0-"--1,RRXINS ;. TO / +REPEAT 10.,RRCDGT ;0 TO 9 +REPEAT "H-"9-1,RRXINS ;: TO G +REPEAT 3,300,,RRINDR ;H, I, J +REPEAT "`-"J,RRXINS ;K TO ` +REPEAT 32,40,,RRINDR ;a to z +REPEAT 200-172-1,RRXINS ;{ TO RUBOUT. + +IFN .-RRMACT-1000,.ERR + +RRMACL==1000 ;LENGTH OF RRMACT + +SUBTTL INITIAL CONTENTS OF STRING AND BUFFER SPACE + +;; BUFFER AND MACRO CALL FRAMES. MORE CAN BE CREATED, PUSHING COMMAND BUFFER UP. + +MFSTRT: REPEAT MFNUM-3, REPEAT MFBLEN-1,[ 0 ?] . + REPEAT MFBLEN, 0 +MFBUF1: MFBFR,,INIBEG ;BUFFER FRAME FOR INITIALLY SELECTED BUFFER. + REPEAT MFBLEN-2,INIBEG + 0 +MFSBUF: MFBFR,,INISRB ;THIS BUFFER HOLDS THE COMPILED SEARCH STRING. + REPEAT 4,INISRB + INISRE + 0 +MFEND1:: + +CBUF: BLOCK CBUFSZ ;COMMAND BUFFER FOR NON-^R MAIN LOOP. + +;INITIAL CONTENTS OF STRING SPACE: + +INIQRB==5*. +ERSTRT: BLOCK ERTOTL ;STRINGS FOR ERROR MESSAGES GO HERE. +EREND:: +INIDLM:: + <.BYTE 7 ? 177 ? QRSTR ? 4 ? 5 ? 0> + REPEAT ^M, ASCII / / + ASCII / + / ;CR. ENDS COMMENTS IN LISP. + REPEAT 33-^M-1, ASCII / / + ASCII / A / ;ALTMODE + REPEAT 40-33, ASCII / / ;34 THRU SPACE + ASCII / A / ;! + ASCII / A / ;" + ASCII / A / ;# + REPEAT "%-"$+1, ASCII /AA / ;$, %. + ASCII / A / ;& + ASCII / ' / ;' + ASCII / ( / ;( + ASCII / ) / ;) + ASCII / A / ;* + ASCII / A / ;+ + ASCII / / ;, + ASCII / A / ;- + ASCII /AA / ;. + ASCII . / . ;/ + REPEAT "0-"/-1, ASCII / A / + REPEAT "9-"0+1, ASCII /AA / + REPEAT ";-"9-1, ASCII / A / + ASCII / ; / + REPEAT "A-";-1, ASCII / A / + REPEAT "Z-"A+1, ASCII /AA / + REPEAT "a-"Z-1, ASCII / A / + REPEAT "z-"a+1, ASCII /AA / + REPEAT "|-"z-1, ASCII / A / + ASCII / | / + REPEAT 176-"|, ASCII / A / + ASCII / / +IFN .-INIDLM-201,.ERR WRONG TABLE LENGTH +INI..O==5*. + <.BYTE 7 ? QRBFR ? MFBUF1&177 ? MFBUF1_<-7>&177 + MFBUF1_<-14.>&177> +INISRS==5*. + <.BYTE 7 ? QRBFR ? MFSBUF&177 ? MFSBUF_<-7>&177 ? MFSBUF_<-16>&177> +INIQRW==5*. + +;INITIAL CONTENTS OF BUFFER SPACE. + +INIBUF==5*<&<-2000>> +INISRB==INIBUF +INISRE==INISRB+5*<1+STBLSZ> +INIBEG==INISRE+5 +INITOP==INIBEG+5 + +END BOOT diff --git a/src/e142/teco.symbols b/src/e142/teco.symbols new file mode 100644 index 00000000..e8317105 Binary files /dev/null and b/src/e142/teco.symbols differ diff --git a/src/e142/teco.symbols.783 b/src/e142/teco.symbols.783 new file mode 100644 index 00000000..899645a1 Binary files /dev/null and b/src/e142/teco.symbols.783 differ diff --git a/src/e142/teco.symbols.784 b/src/e142/teco.symbols.784 new file mode 100644 index 00000000..899645a1 Binary files /dev/null and b/src/e142/teco.symbols.784 differ diff --git a/src/e142/tecord.differences b/src/e142/tecord.differences new file mode 100644 index 00000000..32e5bbfb --- /dev/null +++ b/src/e142/tecord.differences @@ -0,0 +1,54 @@ + DIFFERENCES BETWEEN ITS TECO AND TWENEX TECO, VERSION 589 + + +EG does not insert a 3-digit number with leap year information, + but rather a blank line. + +EO (set dumped on tape bit) does not exist. + +EQ (create link) does not exist. + +ER is the same as ER. + +EX$ + if a file is open for output, does EE$, then instructs the EXEC + to repeat the last CCL type command (load, execute, compile, debug). + +FS CCL FNAME$ + a string, in the same format as FS D FILE$, of the jfn given in AC1 if + TECO was started at the CCL entry point; or zero if it was not or the + filename has already been read. + +FS D VERSION$ + -1 has its usual meaning, since all versions are numeric. + +FS FDCONVERT$ + when given two args, will use the first as the ODTIM format. When given + no arg, will do an IDTIM from the buffer, and can thus parse formats + other than those created by FS FDCONV$ with an arg. + +FS HELP MAC$ + there is no way to input a HELP on 20X. + +FS OS TECO$ + returns the operating system TECO is running on, 0 for ITS, 1 for 20X. + +FS UPTIME$ + returns its value in milliseconds, rather than 30ths of seconds. + + + + +SIXBIT quantities. + + commands which return a SIXBIT word as a value, actually return string + pointers on twenex. The F6 commands do not convert strings to sixbit, + but just pass strings through, so that the difference can be made trans- + parent by using them after any command that returns a SIXBIT quantity. + +filenames. + + TECO attempts to convert as much as possible ITS style filenames to + 20X style, including quoting special characters, to allow many more + macros to work without conversion. + diff --git a/src/e142/tvedit. b/src/e142/tvedit. new file mode 100644 index 00000000..ac1b1d9f --- /dev/null +++ b/src/e142/tvedit. @@ -0,0 +1,67 @@ +!* -*-TECO-*- ! + +!~Filename~:! !Commands for somewhat TVEDIT like EMACS environment.! +EMACS + +!& Setup EMACS Library:! !S Set up for TVEDIT environment.! + + 0fo..q TVEDIT_setup_hook[0 + fq0"g m0 ' !* Run users macro if any.! + + m.m^R_Exchange_Characters u.T + m.m^R_Down_Real_Line u..J + 16.fs ^R init u..M + m.m^R_Up_Real_Line u..^ + m.m^R_Forward_Word u..) + m.m^R_Backward_Word u..( + m.m^R_TVEDIT_Next_page u..N + m.m^R_TVEDIT_Previous_page u..P + 2fs ^R init u..< + 6fs  init u..> + q..>, 440.fs ^R c macro + q..<, 577.fs ^R c macro + m.m^R_Goto_Beginning u..{ + m.m^R_Goto_End u..} + m.m^R_End_of_Real_Line u..] + m.m^R_Beginning_of_Real_Line u..[ + 4fs ^R init u..K + m.m^R_TVEDIT_Return_to_superior u:.X() + q.Z u:.X() + eremacs.init @y :m(hfx*) + +!^R TVEDIT Next Page:! !^R Move to the next page in the buffer.! + + 1m(m.m^R_Set_Bounds_Page) + 0,fs z fs bound +  + +!^R TVEDIT Previous Page:! !^R Move to the previous page in the buffer.! + + -1m(m.m^R_Set_Bounds_Page) + 0,fs z fs bound +  + +!& Read Filename:! !S Read a filename from the tty. +A non-zero argument means file will be use for output +(for version number defaulting). The prompt should be +supplied as a string argument, without trailing colon or +space. Returns a string of the filename read.! + + :I*[1 !* Read prompt argument.! + ET:<>FOO..0 ET !* Clear all defaults.! + + FN FS RGETTY"N !* Set up for when done (in case ^G).! + 0FO..QFlush_Prompts"N !* Maybe erase what just happened.! + FS ECHO DIS + CFS ECHO DIS '' + "# FS ECHO LINES-1"N !* Else at least a crlf.! + ^ FT !* Provided it wont erase it.! +''  + + FS LISTEN"E !* Prompt unless user's starting typing.! + FS RGETTY"N + FS ECHO DIS CFS ECHO DIS' !* Clear echo area.! + ^ FT 1:_' !* Give prompt.! + + "N 400000.+' 60000. :ET !* Get filename from tty.! + FS D FILE !* And return a string of it.! diff --git a/src/e142/tvedit._ej b/src/e142/tvedit._ej new file mode 100644 index 00000000..9dcfd0d4 --- /dev/null +++ b/src/e142/tvedit._ej @@ -0,0 +1,41 @@ +(W +[0+8+FQ(+4)[1 +0FO10F"G+Q1 +'W+FQ()+4U1 +FQ1"L0' +,Q1:M(Q1+4(]1]0)) + @I9E]kkrZfy/GZ3='."(& Setup TVEDIT`0fo..qTVEDIT setup hook[0 +fq0"gm0' +m.m^R Down Real Lineu..J +m.m^R Up Real Lineu..^ +m.m^R Forward Wordu..) +m.m^R Backward Wordu..( +m.m^R TVEDIT Next pageu..N +m.m^R TVEDIT Previous pageu..P +2fs^Rinitu..< +6fsinitu..> +q..>,440.fs^Rcmacro +q..<,577.fs^Rcmacro +m.m^R Goto Beginningu..{ +m.m^R Goto Endu..} +m.m^R End of Real Lineu..] +m.m^R Beginning of Real Lineu..[ +4fs^Rinitu..K +m.m^R TVEDIT Return to superioru.Z +q.Zu:.X() +0^R TVEDIT Next Page11m(m.m^R Set Bounds Page) +0,fszfsbound +^R TVEDIT Previous Page2-1m(m.m^R Set Bounds Page) +0,fszfsbound + ^R TVEDIT Return to Superior'f+ +fm(m.m^R Return to Superior)~Filename~ +TVEDIT~DOC~ ~Filename~:Commands for somewhat TVEDIT like EMACS environment. +~DOC~ & Setup TVEDIT&S Set up for TVEDIT environment. +~DOC~ ^R TVEDIT Next Page-^R Move to the next page in the buffer. +!~DOC~ ^R TVEDIT Previous Page1^R Move to the previous page in the buffer. +&~DOC~ ^R TVEDIT Return to Superior!^R Clears the screen first. +~DIRECTORY~`& Setup TVEDIT +^R TVEDIT Next Page +^R TVEDIT Previous Page +^R TVEDIT Return to Superior + ~INVERT~[1Q1 diff --git a/src/e142/tvlib.chart b/src/e142/tvlib.chart new file mode 100644 index 00000000..915e7e7f --- /dev/null +++ b/src/e142/tvlib.chart @@ -0,0 +1,216 @@ +EMACS ^R-Command Chart (as of 03/10/79 11:05:44): + +Non-Control Non-Meta Characters: + +Backspace moves back one character (or several). +Tab ^R Tab to Tab Stop +Linefeed ^R Indent New Line +Return ^R CRLF +Altmode ^R Prefix Meta +Rubout deletes characters backwards. + +Control Characters: + + .. ^R Complement SAIL Mode +Backspace moves back one character (or several). +Tab ^R Tab to Tab Stop +Linefeed ^R Indent New Line +Return ^R CRLF +Altmode exits from ^R mode. +Space ^R Set/Pop Mark +% .. ^R Replace String +- .. is part of the next command's argument. +0 thru 9 is part of the next command's argument. +; .. ^R Indent for Comment +< .. ^R Mark Beginning += .. ^R Where Am I +> .. ^R Mark End +@ .. ^R Set/Pop Mark +A .. ^R Backward Sentence +B .. moves back one character (or several). +C .. ^R Prefix Control-Meta +D .. ^R Backward Kill Word +E .. ^R Forward Sentence +F .. moves forward one character (or several). +G .. quits execution of any command. +H .. moves back one character (or several). +I .. ^R Tab to Tab Stop +J .. ^R Indent New Line +K .. ^R Kill Line +L .. ^R Next Screen +M .. is bare TECO's Control-M +N .. ^R Down Comment Line +O .. inserts one CRLF (or several) after point. +P .. ^R Up Real Line +Q .. ^R Quoted Insert +R .. ^R Reverse Search +S .. ^R Incremental Search +U .. ^R Universal Argument +V .. ^R Quote Control Char +W .. ^R Backward Kill Word +X .. is a prefix character. See below. +Y .. ^R Un-kill +Z .. ^R Prefix Control-Meta +\ .. ^R Half Window Up +] .. ^R Half Window Down +^ .. ^R Prefix Control +Rubout deletes backwards, turning tabs into spaces. + Meta Characters: + +Tab ^R End of Real Line +Linefeed ^R Down Real Line +Return moves to the beginning of the next line. +Altmode ^R Prefix Control-Meta +Space moves forward one character (or several). +# .. ^R Change Font Word +% .. ^R Query Replace +' .. ^R Upcase Digit +( .. ^R Backward Word +) .. ^R Forward Word +, .. ^R Kill Region +- .. is part of the next command's argument. +. .. ^R Copy Region +/ .. ^R Describe +0 thru 9 is part of the next command's argument. +; .. ^R Indent for Comment +< .. moves back one character (or several). += .. ^R Where Am I +> .. moves forward one character (or several). +? .. ^R Describe +@ .. ^R Mark Word +A .. ^R Repeat Skip/Zap +B .. ^R Reverse Skip +C .. ^R Uppercase Initial +D .. ^R Kill Word +E .. ^R Forward Sentence +F .. ^R Forward Word +G .. ^R Nth Page +H .. ^R Mark Paragraph +J .. ^R Indent New Comment Line +K .. deletes one character (or several) forward. +L .. ^R Lowercase Word +M .. ^R Mark Paragraph +N .. ^R Refresh Line +P .. ^R Nth Page +Q .. ^R Fill Paragraph +R .. ^R Move to Screen Edge +S .. ^R Skip to Character +T .. ^R Exchange Words +U .. ^R Uppercase Word +V .. ^R Previous Screen +W .. ^R Next Window +X .. ^R Execute Completed MM Command +Y .. ^R Un-kill Pop +Z .. ^R Zap to Character +[ .. ^R Backward Paragraph +\ .. ^R Delete Horizontal Space +] .. ^R Forward Paragraph +^ .. ^R Up Real Line +_ .. ^R Indent Rigidly +{ .. ^R Goto Beginning +} .. ^R Goto End +Rubout moves back one character (or several). + Control-Meta Characters: + +Backspace ^R Mark Defun +Tab ^R Indent for LISP +Linefeed ^R Down Real Line +Return ^R Back to Indentation +( .. ^R Beginning of Real Line +) .. ^R End of Real Line +- .. is part of the next command's argument. +0 thru 9 is part of the next command's argument. +; .. ^R Kill Comment +< .. ^R Beginning of Real Line += .. ^R Indicate Page/line +> .. ^R End of Real Line +? .. ^R Documentation +@ .. ^R Set/Pop Mark +A .. ^R Backward Kill Sentence +B .. ^R Backward Sexp +C .. exits from ^R mode. +D .. ^R Kill Sentence +E .. ^R End of DEFUN +F .. ^R TV Return to Superior +G .. ^R Format Code +H .. ^R Mark Defun +I .. ^R Indent for LISP +J .. ^R Down Real Line +K .. ^R Kill Line +L .. ^R Beginning of Real Line +M .. ^R Mark Sentence +N .. ^R New Window +O .. ^R Split Line +P .. ^R Backward List +Q .. ^R Fill Region +R .. ^R Reposition Window +S .. ^R Center Line +T .. ^R Exchange Sexps +U .. ^R Backward Up List +V .. ^R Scroll Other Window +W .. ^R Scroll Other Window +X .. ^R Execute Minibuffer +Y .. ^R Append Next Kill +Z .. exits from ^R mode. +[ .. ^R Beginning of DEFUN +\ .. ^R Bottom of Screen +] .. ^R End of DEFUN +^ .. ^R Top of Screen +Rubout ^R Backward Kill Sexp + +Control-X is an escape prefix command with these subcommands: + +^X ^B List Buffers +^X ^C ^R Return to Superior +^X ^D ^R Directory Display +^X ^E ^R Edit File +^X ^F ^R Find File +^X Tab ^R Toggle Overwrite Mode +^X ^L ^R Lowercase Region +^X ^N ^R Set Goal Column +^X ^O ^R Delete Blank Lines +^X ^P ^R Mark Page +^X ^Q ^R Do Not Write File +^X ^R ^R Read File +^X ^S ^R Save File +^X ^T ^R Mini Visited File +^X ^U ^R Uppercase Region +^X ^V ^R Visit File +^X ^W Write File +^X ^X ^R Exchange Point and Mark +^X ^Z ^R TV Return to Superior +^X Altmode ^R Re-execute Minibuffer +^X # ^R Change Font Region +^X ( ^R Define Keyboard Macro +^X . ^R Set Fill Prefix +^X 1 ^R One Window +^X 2 ^R Two Windows +^X 3 ^R View Two Windows +^X 4 ^R Modified Two Windows +^X : ^R Set Column +^X ; ^R Set Comment Column +^X = ^R Where Am I +^X A ^R Append to Buffer +^X B Select Buffer +^X D ^R Dired +^X F ^R Set Fill Column +^X G ^R Get Q-reg +^X H ^R Mark Whole Buffer +^X I ^R Toggle Overwrite Mode +^X K Kill Buffer +^X L ^R Count Lines Page +^X M Mail +^X N ^R Set Bounds Region +^X O ^R Other Window +^X P ^R Set Bounds Page +^X R ^R RMAIL +^X W ^R Set Bounds Full +^X X ^R Put Q-reg +^X [ ^R Previous Page +^X ] ^R Next Page +^X ^ ^R Grow Window +^X _ ^R Underline Region +^X { ^R Mark Beginning +^X } ^R Mark End +^X ~ ^R Not Modified +^X Rubout ^R Backward Kill Sentence diff --git a/src/e142/twenex.instal b/src/e142/twenex.instal new file mode 100644 index 00000000..50fba62c --- /dev/null +++ b/src/e142/twenex.instal @@ -0,0 +1,65 @@ +@. Note: The file TECO.FILES describes all of the files and what + they are used for. + +A. TECO + The TECO that supports EMACS is written in MIDAS, a dialect + of assembly language; assembling will require the MIDAS + assembler, MIDAS.EXE, and the JSYS bit definitions, + TWXBTS.MID, in addition to the source file, TECO.nnn. + [Note: since the MIDAS assembler doesn't understand TWENEX + version numbers, the version number of the source of TECO + must be contained in the file's extension. It must be there, + in order for TECO dump files to appropriately point to one + another.] + + 1. vs EMACS: and vs INFO: + If the system configuration does not include an + directory, and one cannot be easily setup, it is possible to + have TECO translate references to this directory to the + correspondingly named device, which can then point to any + directory. If the assembly switch EMCSDV is set non-zero, + this translation is enabled; the batch control file, + EMACS.CTL has the correct provisions for setting this + switch. Likewise INFODV will cause tranlation of the INFO + directory. + If your system has more than one structure, then you should + also setup system logical names for EMACS: and INFO:, in order + that files will be found that are on PS:, even when you are + connected to another structure, and turn on these switches. + + 2. Terminal types + TECO has display support for various common terminal types, + which are conditionally assembled and assigned to GTTYP + indices. On pass 1, the assembler will type a prompt for + each known terminal type and expect either the GTTYP index + for that terminal type (which can be the corresponding JSYS + mnemonic), or just a CR to assemble out that terminal type + altogether. The batch control file shows assembly for DEC + VT52s and VT05s, and blank lines for other types, and should + be appropriately modified to correspond to the system + configuration. + + 3. Files produced + After the assembly, starting the resultant program at + symbolic location PURIFY will generate two binary files, + TECO.EXE.nnn, and TECPUR.EXE.nnn, the former is a stand + alone version of the TECO, and need not be kept around + after EMACS.EXE and INFO.EXE have been made, and + the latter the binary file that EMACS will load when started + up. + +B. EMACS + The NEMACS.EXE produced by the DUMP macro (see batch control + file) should be installed as SYS:EMACS.EXE, perhaps after + verifying that it basically runs. Other EMACS binary files + live in either or EMACS: depending on the + configuration (vide supra). + +C. INFO + In addition to EMACS' self documenting features, the INFO + library provides a means of perusing the EMACS documentation + (or any documentation suitably formatted for that matter). + Most files are of the form SUBJECT.., but see above + about INFO:. TECORD.nnn is the complete documentation + of the TECO itself that supports EMACS. + \ No newline at end of file diff --git a/src/e142/varg._ej b/src/e142/varg._ej new file mode 100644 index 00000000..fa8c70ef Binary files /dev/null and b/src/e142/varg._ej differ diff --git a/src/e142/wordab. b/src/e142/wordab. new file mode 100644 index 00000000..1b2babf0 --- /dev/null +++ b/src/e142/wordab. @@ -0,0 +1,1055 @@ +!* -*-TECO-*- *! +!* This source is compiled with IVORY, not PURIFY! +!* This is what used to be XWORDA, now the official WORDAB. It will + * (at least for a while) check when reading word abbrev files and use the + * WABCON library to convert the old style formats to the one used now (QWABL + * format). All mention of QWABL might not want to appear in comments + * presented to the user and take out other "temporary" sounding things. + * One note: old uses of names with & WORDAB were changed to begin & WRDAB, + * so that doing MM Aproposword wouldn't produce a very confusing list.! + +!~FILENAME~:! !Word Abbrev Mode package. Documentation in INFO under EMACS.! +WORDAB + +!& Setup WORDAB Library:! !S Run when WORDAB is loaded. Calls a hook. +Calls WORDAB SETUP HOOK, if it exists. That can do things like + auto-loading a file of abbreviations. +Then appends & WRDAB Set Mode Line Hook to Set Mode Line Hook. + Thus, anything put on those hook variables should not return by ^\.! + + [1[2 !* save regs! + 6*5fsQVectoru.e !* .E: QVector of random WORDAB variables.! + m.m& WRDAB Mode or Global Expandu:.e(0) !* .E(0): abbrev lookup subroutine! + m.m& Expandu:.e(1) !* .E(1): & Expand subroutine.! + 0u:.e(2) !* .E(2): abbrev.! + 0u:.e(3) !* .E(3): . where expansion/fill starts.! + 0u:.e(4) !* .E(4): expansion (maybe auto-filled).! + 0u:.e(5) !* .E(5): any text before expansion that! + !* filling moved to next line.! + + 1,m.m& Setup Compressed WORDAB Librariesu1 !* 0 if nonexistant! + q1"n fm1' !* Create defaults variables etc.! + + 0fo..qWORDAB SETUP HOOKu1 !* 1: Setup Hook or 0.! + q1"n m1' !* Call the hook if there is one.! + m.m& WRDAB Set Mode Line Hooku1 !* 1: WORDAB SML hook.! + 0fo..qSet Mode Line Hooku2 !* 2: Old SML hook.! + q2"e q1'"# :i*21'm.vSet Mode Line Hookw + !* install our SML hook if none previous,! + !* otherwise append to SML hook! +  + +!Old Word Abbrev Character Describe:! !C Tell what char does after expanding. +This command will ask you to type a character, e.g. Space, which runs the +word abbrev expander and then calls the old definition for that +character. The description for that old definition will be given, e.g. +the description for ^R Auto-Fill Space.! + + [0[1 + 1,(:i*Type word abbrev key to describe: )m.i !* Prompt, prepare! + @fiu0 !* 0: 9-bit key code.! + q0fs^RCMacro-(m.m^R Abbrev Expand And Call Old Char)"n + q0m(m.m& Charprint) + ft does not run ^R Abbrev Expand And Call Old Char. It runs + q0fs^RCMacro :m(m.mDescribe)' + 8[..e q0:\u1 ]..e !* 1: Code as octal string.! + qMM # WRDAB Old 1u1 !* 1: Old function.! + ftAfter possibly expanding,  q0m(m.m& Charprint) ft runs  + q1:m(m.mDescribe) + +!^R Abbrev Expand Only:! !^R Expand last word, but insert nothing after it. +If given an argument, will feep if last word isn't an abbrev.! +!^R Abbrev Expand ! !* For & Set Word Abbrev Chars.! + .( !* Save point for checking if expanded.! + 0,0a"c m:.e(0)' !* Expand! + )-."e ff"g fg'' 1 !* Feep if ARG and no expansion.! + +!^R Abbrev Expand And Call Old Char:! !^R Expand last word, then run old char. +The "old" function run by the character after the expansion check may be + described by MM Old Word Abbrev Character Describe which will ask you to + type the character to describe. +Explicit ARG inhibits expanding.! +!^R Abbrev Expand ! + ff"E !* No expanding if an ARG.! + 0,0a"c m:.e(0)'' !* Expand, no insert.! + [.1 8[..e q..0fs^RIndirect:\u.1 ]..e !* .1: Octal for char.! + f @:mMM # WRDAB Old .1 !* Call old char function.! + +!^R Abbrev Expand And Self-Insert:! !S Expand last word if an abbrev. +Giving an explicit numeric argument inhibits expansion, just inserting that + many copies of char that ran this.! +!^R Abbrev Expand ! + ff"e 0,0a"c m:.e(0)'' + f@:m(q..0fs^RIndirectfs^Rinit) + +!& WRDAB Mode or Global Expand:! !S Expand previous word if mode or global abbrev.! + -fwx*[.1 qMode[.2 !* .1: Last word, .2: Mode name.! + :fo..qX .1 .2 Abbrevf"lw :fo..qX .1 * Abbrevf"lw''u.2 + !* .2: Abbrev ..Q offset! + :m:.e(1) !* expand! + +!& Global Expand:! !S Expand previous word if global abbrev.! + -fwx*[.1 !* .1: Last word! + :fo..qX .1 * Abbrevf"lw'[.2 !* .2: Abbrev ..Q offset! + :m:.e(1) !* expand! + +!& Expand:! !S .1 is abbrev, .2 is ..Q offset +A pre-comma ARG inhibits auto-filling. (Since ^^M, e.g. is called by + some to insert CRLF but not auto-fill.)! +!* +Say last word is "foo" and current mode is "ala": +If X foo ala Abbrev (for current mode ala) exists, it has exp. +Else if X foo * Abbrev exists (global abbrev), it contains expansion. + (Thus any mode abbrev "foo" overrides a global abbrev "foo".) +If expansion occurs: + If a hyphen to left of last word, and Word Abbrev Prefix Mark points + before it, then the hyphen is removed, gluing prefix to expansion. +If first letter of abbrev is capitalized, first letter of expansion will + be capitalized too. +If first and last letter of abbrev is capitalized (e.g. all letters), + we do more upper-casing, controlled by WORDAB All Caps: + If 0 then the first letter of each word in expansion is capitalized. + If non-0 then the entire expansion is upper-cased. + For one-word expansions, the former choice is meaninless so we do the + latter, fully upper-casing the single word. +In fill mode, line may be broken. +The comment for the abbrev variable is a string-number that tells the + number of times the abbrev has been used.! + +!* .E(2) is set to the word replaced. If there was a + prefix glued, "-" is prepended. + .E(3) is set to where expansion/fill starts. + .E(4) contains (maybe auto-filled) expansion and + anything before expansion that was also filled. + .E(5) is any text before expansion that filling + moved to next line. ! + + !* .1: abbrev.! + !* .2: ..Q-offset for abbrev var.! + [..0 !* ???! + q:..q(q.2+2)[.3 !* .3: usage-count string for ab var.! + q.3fp-101"N :i:..q(q.2+2)1' !* If count was numeric, e.g. set by! + !* local mode of file, make string of 1.! + "# .(g.3)j .(\+1:\u:..q(q.2+2))j fq.3d' !* Increment usage-count (string).! + + -fq.1d !* Delete the abbrev.! + 0,0a--"E !* Hyphen to left, ! + -1fo..qWord Abbrev Prefix Mark+1-."E !* ...and a prefix just before it.! + :i.1-.1 !* Update last word to include hyphen.! + -d'' !* ...So remove hyphen, gluing prefix on.! + + + .u:.e(3) !* .E(3): Save point for! + !* unexpanding later.! + .[.4 !* .4: Point before expansion.! + g:..q(q.2+1) !* Insert the expansion.! + .[.5 !* .5: Point after expansion.! + -1[.7 !* .7: start at char 0 (we increment 1st)! + fq.1[.8 !* .8: get length of Q.1! + <%.7-q.8; !* dont search beyond the end of string! + q.7 :g.1"a0;'> !* but find the first alphabetic char ! + q.7 :g.1"u !* 1st letter of abbrev was capitalized.! + q.4j :fwl !* find where to start capitaliztion.! + 1 @fc !* So capitalize expansion.! + q.8-1 :g.1"u !* Last letter of abbrev was capitalized.! + 0fo..qWordab All Caps"e !* Supposed to uppercase first letters.! + 0u.3 !* ... .3: 0 word count.! + :< 2:fwl .-q.5; %.3w !* ... .3: Iter over expansion, count! + !* ... words.! + 1 @fc >w !* ... Cap each word in expansion.! + q.3"e q.4,q.5 @fc'' !* ... One-word expansion means all caps.! + "# !* Supposed to cap whole expansion.! + q.4,q.5 @fc'' !* ...So uppercase everything.! + ' !* End of first let capped.! + q.1u:.e(2) !* .E(2): Save abbrev for! + !* unexpanding later.! + :i:.e(5) !* .E(5): Initially! + !* assume that nothing before expansion! + !* will be moved to next line by filling.! + q.5j !* Move to end of expansion.! + q.4,q.5 f !* Tell ^R of changes to buffer.! + + + !* In-line, fast auto-filler.! + !* This repeats line-breaking if! + !* need be since expansion may be! + !* several words long. ! + ff-1"G oUPDATE ' !* No auto-fill if pre-comma ARG.! + 0fo..qAuto Fill Mode"E oUPDATE ' !* No break if not in mode.! + 0fo..qFill Columnf"e w fsWidth-10'u.1 !* .1: Fill column.! + fsSHpos-q.1-2"l oUPDATE' !* No break.! + m.m^R Indent New Comment Line !* I: ^R Indent New Comment Line! + q.5(:fx.5 !* .5: Rest of line after expn.! + )-q.4f !* Repeat til place to break.! + .-q.4"L .u:.e(3) !* .E(3): Update! + !* expansion start if filling changed it.! + .,q.4x:.e(5) !* .E(5): Stuff before! + !* expansion that filling moved to next! + !* line.! + .u.4' !* .4: Updated expansion start.! + @f k !* Kill whitespace around break.! + :fx.3 !* .3: Rest of line.! + @mIw !* This work for dif modes???! + :0L.,(:2Lg.3).f> !* Tell ^R of fill changes.! + :l .(g.5)j !* End of auto-filler, get rest of line.! + + !UPDATE! + + q.4,.x:.e(4) !* .E(4): Save! + !* auto-filled text in case of unexpand.! +  + +!^R Unexpand Last Word:! !^R Undo last expansion, leaving the abbrev. +If there was a prefix that was glued onto the expansion, it will be separated + from the abbrev by a hyphen. +The abbrev's usage-count is decremented.! +!* +The expansion starts at .E(3) and its text is contained + in .E(4), as a check against the start. This text + may include text before the expansion that was moved to the next line + by auto-filling. +Replaces expansion with .E(2), the abbrev, preceded by + .E(5), text that was moved by filling. +.E(2) may start with "-" in which case stuff after hyphen is + the abbrev; a hyphen is inserted to separate the prefix from abbrev. ! + + z-.[.4 !* .4: Z - original point.! + fn z-q.4j !* When exit, restore orig point.! + q:.e(2)"e fg @ft +No last expansion 0fsEchoActivew 1 ' + q:.e(2)[.1 !* .1: String of last abbrev.! + q:.e(4)[.3 !* .3: Expansion for that abbrev.! + 0,1 :g.1 [.2 !* .2: First letter of abbrev.! + .2--"E !* Abbrev/expansion had a prefix.! + 1,fq.1 :g.1 u.1' !* .1: Remove hyphen from abbrev.! + "# :i.2' !* .2: Prefix separator or null.! + q:.e(3)[.5 !* .5: Start of expansion.! + 1:"N zj' !* Go to expansion start.! + fq.3f~.3"n fg @ft +No last expansion 0fsEchoActivew 1 ' !* tell him! + fq.3d !* Remove the expansion.! + .,(g:.e(5) !* Get pre-abbrev, post-fill text.! + g.2 !* Insert any prefix indicator.! + g.1). f !* Get the abbrev and tell ^R of changes.! + + :i*Fundamental fo..qMODEu.2 !* .2: Mode name.! + :fo..qX .1 .2 Abbrevf"G u.2' !* .2: Mode ab ..q-offset.! + "# :fo..qX .1 * Abbrevf"G u.2'' !* .2: Global ab ..q-offset.! + !* .2: ..Q-offset for abbrev var.! + q:..q(q.2+2)[.3 !* .3: usage-count string for ab var.! + .(g.3)j .(\-1:\u:..q(q.2+2))j fq.3d !* Decrement usage-count (string).! + + 1  + +!Word Abbrev Mode:! !WORDAB:! !C Mode for expanding word-abbrevs. +No arg or non-zero arg sets the mode, Word Abbrev Mode. +0 arg clears the mode. +Runs Word Abbrev Hook if any, with arg of new mode setting. If none, + the following keys are set: + ^X ^A runs ^R Add Mode Word Abbrev, + ^X ^H runs ^R Inverse Add Mode Word Abbrev, + ^X + runs ^R Add Global Word Abbrev, + ^X - runs ^R Inverse Add Global Word Abbrev, + M-' runs ^R Word Abbrev Prefix Mark, + C-M-Space runs ^R Abbrev Expand Only, and + ^XU runs ^R Unexpand Last Word. +Giving this command 1 as a pre-comma argument means that you only use global + abbrevs, and things are set up to be faster (e.g. faster expansion + checking since it doesn't have to check both global and local abbrevs). +Each of the following chars: + ~@#;$%^&*()-_=+[]\|:'`"{},<.>/?, Space, Return, +will run ^R Abbrev Expand And Self-Insert, or ^R Abbrev Expand And Call Old + Char. +Tab runs ^R Abbrev Expand for Tab.! + [.2[.3 + ff&1"E 1u.3' !* .3: Mode on if no arguments.! + "# "'N,0u.3' !* .3: Mode on if non-zero argument.! + !* Note that ,0^@ negates its arg.! + q.3m.vWord Abbrev Modew !* Set mode variable.! + + ff&2"n "n m.m& Global Expandu:.e(0)' + "# m.m& WRDAB Mode or Global Expandu:.e(0)'' + + 0fo..qWord Abbrev Hooku.2 !* .2: Hook function.! + + q.2"N q.3 m.2' !* Call the hook, if any.! + + q.3"E !* Turn OFF word abbrev mode.! + q.2"E 0u:.x(U) !* If didnt call hook undefine our ^X keys! + 0u:.x() !* ...! + 0u:.x() !* ...! + 0u:.x(-) !* ...! + 0u:.x(+)' !* ...! + m(m.m& Set Mode Line) !* Update modes displayed, and things! + !* like auto-filling space.! + ' !* End of turn OFF mode.! + + !* Turn ON word abbrev mode.! + 0fo..qWORDAB Ins Chars"E !* If no $ins$, ! + :i*!~@#;$%^&*-_=+[]()\|:`"'{},<.>/? + m.vWORDAB Ins Charsw + !* Let any migrate to $old$ if need.! + :i* m.vWORDAB Old Charsw' !* ...! + + q.2"E !* If didnt call hook, set up special ! + m.m^R Unexpand Last Word u:.x(U) !* ...^R macros.! + m.m^R Add Mode Word Abbrev u:.x() !* ! + m.m^R Inverse Add Mode Word Abbrev u:.x() !* ! + m.m^R Add Global Word Abbrev u:.x(+) !* ! + m.m^R Inverse Add Global Word Abbrev u:.x(-) !* ! + m.m^R Abbrev Expand Only u... w !* C-M-Space.! + m.m^R Word Abbrev Prefix Mark(!"!) u..' !* ! + ff&2"n q:.x()(q:.x(+)u:.x())u:.x(+) !* ! + q:.x()(q:.x(-)u:.x())u:.x(-)'' !* ! + :m(m.m& Set Mode Line) !* Update modes displayed and set keys.! + +!Define Word Abbrevs:! !C Define word abbrevs from buffer.! +!* Format of buffer: + ::= null | + ::= : " " + may be more than one line, and may have '"'s in it as long as + they are quoted with another '"'. + ::= + ::= null | ( ) + ::= null | +For now nothing else, no :s in . + is the name of a major mode (e.g. LISP), if abbrev is to be + effective only in that mode. It is ommitted if the abbrev is to be + effective in all modes. + is a usage-count for the abbrev -- i.e. how many times the + abbrev has been used before. + is any number (including 0) of spaces and tabs.! + + [.1[.2[.4 + g(q..o(f[BBindw)) !* Temp buf, init with defns.! + bj 0s <:s;ric> !* Teco-quote alts, ^]s.! + zj i + !* Ensure something after final quote! + + bj + < .-z; + :s:; -d !* End of .! + 0fx.1 !* .1: .! + @f  k !* Remove .! + 0,1a-("E d :flfx.2 d' !* .2: name. )! + "# :i.2*' !* .2: * for global.! + @f  k !* Remove .! + @f0123456789 fx.4 !* .4: usage-count.! + fq.4"E :i.40' !* .4: 0-string by default.! + @f  k !* Remove .! + 0,1a-34"N :i*No quote to start expansionfsErr + ' !* Ensure format.! + d i:i* !* Delete quote, make command.! + 0s" !'! <:s"e :i*No quote to end expansionfsErr' !* ! + 0,1a-":@; c> !'! !* Find unquoted doublequote.! + 0,1a-15."n :i*Possible unquoted " in expansion -- final " not at end of linefsErr !''!' + -d !* Remove endquote.! + iM.VX .1 .2 Abbrevw !* Make expansion command.! + i M.CX .1 .2 Abbrev.4 !* Make set-comment command.! + l> !* Next abbrev defn.! + j 0s"" <:s; -d> !* Take quote-quoters off.! + m( hx* ) !* Define by running buffer.! +  + +!List Word Abbrevs:! !C List abbrevs and their expansions.! +!* See documentation on Insert Word Abbrevs for details.! + [.1 f[BBindw !* Construct list in temp buffer.! + m(m.mInsert Word Abbrevs) + bj i +abbrev: (mode) count "expansion" + + +ht ft +Done. +  + +!Insert Word Abbrevs:! !C Insert abbrevs defined and their expansions. +Format is acceptable to MM Define Word Abbrevs. +In particular, any double-quotes (the '"' character) in an expansion will be + quoted with another double-quote. E.g. HE SAID "HELLO" becomes HE SAID + ""HELLO"".! + + [1[2[3[4[5[6 + q..ou1 !* 1: Original buffer.! + f[BBind q..ou6 [..o !* 6: Temporary buffer.! + :fo..qX u2 !* 2: $X ^@$ offset, before any abbrevs.! + q2"L -q2u2' !* 2: $X ^@$ offset, positive.! + !* 2: Running ..Q index for abbrevs.! + q1u..o i + + -l !* All abbrev defn lines start and end! + !* with CRLF.! + fq..q/5-q2/3( !* Number of var slots to examine in ..Q.! + q2-1u2 !* 2: Start ..Q - 1.! + )< q:..Q(%2)u3 !* 3: Next variable name.! + q:..Q(%2)u4 !* 4: Next variable value.! + q:..Q(%2)u5 !* 5: Next variable comment.! + q4fp"L oNEXT' !* Skip variable if value is number.! + !* (Local vars become 0 when not in their! + !* buffer.)! + f~(0,2:g3)X "N oNEXT' !* Skip this variable if not $X ...$, ! + f~(fq3-7,fq3:g3) Abbrev"N oNEXT' !* ...or if not $... Abbrev$.! + 2,fq3-7g3 !* Insert abbrev and mode part of vname.! + -s d i:  !* Have abbrev, :, TAB to mode.! + 1a-*"E d'"# i( :l i)' !* Null if global, or ().! + 9i g5 i " !'! !* Get comment (usage count).! + "f4:"l q6u..o g4 !* Select temporary buffer to fix up! + j 0s" <:s; i"> !''! hx4 q1u..o' !'! !* quotes -- they have to! + !* be quoted with another quote.! + g4 i" + !'! !* Insert value (expansion).! + + !NEXT! > !* Repeat for next variable.! + +  + +!Make Word Abbrev:! !C Make first string argument expand to second one. +After doing MM Make Word Abbrevfoofind outer otter, typing "foo" will + automatically expand to "find outer otter". +3rd string argument, if any, is the mode for the abbrev. +No 3rd string argument means use the current mode. +3rd string argument = "*" means this make a global abbrev. +This command defines just one abbrev, as compared to Define Word + Abbrevs which defines several abbrevs from a list in the buffer.! + + :i*( :i*( :i*[.3)[.2)[.1 !* .1: Abbrev.! + !* .2: Expansion.! + !* .3: Mode or * or null.! + fq.3"E qMODEu.3' !* .3: Mode or *.! + + q.1,q.2 m(m.m& Check And Make Word Abbrev).3 !* Define.! + w 1  + +!& Check And Make Word Abbrev:! !S ARG1 abbrev, ARG2 expn, string arg mode. +String argument is "*" or space-modename, e.g. " TECO". +Checks for break characters in abbrev (not allowed).! + + :i*[2 [1 [3 !* 1,2,3: abbrev, mode, expansion.! + q1[4 [5 !* 4: Abbrev copy, for letter checking.! + fq1< 0,1:g4u5 !* 5: 1st char in rest of abbrev copy.! + 5"b fg @ft +Break chars not allowed in abbrev 0fsEchoActivew 1 ' + 1,fq4:g4u4> !* 4: Each iter, chop off one letter.! + + m.m& Shorten String !* S: & Shorten String.! + + 0fo..qX 1 2 Abbrevu4 !* 4: 0 or old expansion.! + q4"N f=34"N FG !* Already defined, ask confirm.! + q4mSu4 !* 4: short form of old expansion.! + @ftRedefine "1" from "4"?  !''''! !* ...! + 1m(m.m& Yes or No)"E @ftNot redefined. !* tell him! + 0fsEchoActivew 1 '' !* dont flush the message! + "# @ftAlready so defined. !* tell him, and! + 0fsEchoActivew 1 '' !* Dont reset usage-count.! + + q3m.vX 1 2 Abbrevw !* Define expansion.! + m.cX 1 2 Abbrev0 !* Set usage-count comment string.! + + @:i*|m.m& Make Non-Usage Abbrev Variable +q..q[..o +| fo..qLately Changed Abbrevsu4 !* 1: Lately.! + + q3m(m.m& Teco Quote String)u3 !* 3: Expansion with s, s.! + + @:i*|4 +MVX 1 2 Abbrev30|( + )m.vLately Changed Abbrevsw !* Update Lately! +  + +!Write Incremental Word Abbrev File:! !C Write file of changed abbrevs. +Writes to file given by string argument. +(This does not reset the default filename for Write Word Abbrev File and + Read Word Abbrev File. I'm not sure of the correctness of this, though.) +Defaults to home directory, INCABS >. +See Read Incremental Word Abbrev File.! + + [1 + e[e\ fne^e] f[DFile 1f[FNamSyntax !* Save I/O channels, filename.! + etDSK: fsHSNamefsDSNamew etINCABS > !* Default to home directory.! + 4,f Incremental Filef"e w'u1 !* Read string argument *! + f[BBind g(:i* fo..qLately Changed Abbrevs) !* Get QWABL file! + !* commands for changed abbrevs into! + !* temporary buffer.! + z"e :i*No incremental abbrevs to write fsErr' !* Better to err than! + !* print a message, since more useable! + !* by other commands.! + + eihpef1 !* Write to filename STRARG.! + er fsIFileu1 ec @ft +Written: 1 + 0fsEchoActivew 1 + +!Read Incremental Word Abbrev File:! !C Load some abbrevs that changed. +String argument is filename that contains incremental abbrev definitions, + e.g. written by Write Incremental Word Abbrev File. + Default is home directory, INCABS >. +(This does not reset the default filename for Write Word Abbrev File and + Read Word Abbrev File. I'm not sure of this, but it seems correct.)! + + [1 f[DFile !* Save default fielname *! + e[ fne] f[DFile 1f[FNamSyntax !* Save input channel, filename.! + etDSK: fsHSNamefsDSNamew etINCABS > !* Default to home directory.! + 4,f Incremental word abbrev filef"e w'u1 !* Read string argument *! + et1 !* Set default from argument *! + f[BBindw er @y !* Read in QWABL file. *! + m( hx*f(m.vLately Changed Abbrevsw) ) !* Save it in Lately and! + !* then macro it to define abbrevs.! +  !* Call it. *! + +!& Teco Quote String:! !S Takes string as NUMARG, returns with ^]^]s, ^]s.! + f[BBind g() !* Insert NUMARG into temp buffer.! + bm(m.m& Teco Quote Area) !* Quote in that buffer.! + hx*  !* Return contents as string.! + +!& Teco Quote Area:! !S Quote altmodes and ^]s in ARG1,point.! + .-z( !* Save point at end of area. *! + < .,:fb; ir > !* Quote altmodes, ^]s.! + )+zj  !* Restore point at area end, exit.! + +!^R Inverse Add Mode Word Abbrev:! !^R Define expansion for word before point. +Numeric argument n means nth word before point is to be an abbrev (e.g. + you thought it already was, and you are now n words beyond). + No numeric argument means the word just before point, same as argument + of 1. +Reads a one-line expansion for the abbrev, defines it, and expands it.! + + qMode[.4 + .-z[.0 !* .0: Orig .-z.! + -:fwl !* Move back to end of abbrev.! + -fwx*[.1 !* .1: Abbrev.! + 1,m(m.m& Read Line)Expansion for .4 abbrev ".1": [.2 !''! + !* .2: 0 or expansion string.! + q.2"e 1' !* 0, abort.! + fq.2"e 1' !* Null, abort.! + m(m.mMake Word Abbrev).1.2 !* Current mode abbrev.! + @m(m.m^R Abbrev Expand Only)f !* Expand abbrev before point.! + q.0+zj !* Back to orig point.! + 1 !* Return, display done already.! + +!^R Inverse Add Global Word Abbrev:! !^R Define expansion for word before point. +Numeric argument n means nth word before point is to be an abbrev (e.g. + you thought it already was, and you are now n words beyond). + No numeric argument means the word just before point, same as argument + of 1. +Calls & Read Line to get the expansion for that abbrev. (No multi-line.) +Defines that abbrev, and then expands the abbrev before point. +Aborts if & Read Line is aborted, or if the expansion is null.! + + .-z[.0 !* .0: Orig .-z.! + -:fwl !* Move back to end of abbrev.! + -fwx*[.1 !* .1: Abbrev.! + 1,m(m.m& Read Line)Expansion for global abbrev ".1": [.2 !''! + !* .2: 0 or expansion string.! + q.2"e 1' !* 0, abort.! + fq.2"e 1' !* Null, abort.! + m(m.mMake Word Abbrev).1.2* !* Current mode abbrev.! + @m(m.m^R Abbrev Expand Only)f !* Expand abbrev before point.! + q.0+zj !* Back to orig point.! + 1 !* Return, display done already.! + +!^R Add Mode Word Abbrev:! !^R Reads mode abbrev for words before point. +Negative ARG means to delete the word abbrev. (If there is no such mode + abbrev, but there is a global, it asks if it should kill the global.) +Positive ARG (>0) means expansion is last ARG words. +Zero ARG means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +The abbrev is only effective when in the current mode (e.g. LISP).! + "L f @:m(m.m^R Kill Mode Word Abbrev) ' !* Neg ARG, delete.! + :i*FUNDAMENTAL fo..qMODE [.1 !* .1: Current major mode.! + f @m(m.m& Add Word Abbrev).1.1 Abbrev !* Call with SP ! + !* for varname, MODE Abbrev as prompt.! + w 1  + +!^R Add Global Word Abbrev:! !^R Reads global abbrev for words before point. +Negative ARG means to delete the word abbrev, + calls ^R Kill Global Word Abbrev. +Positive ARG (>0) means expansion is last ARG words. +Zero ARG means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +The abbrev is effective in all major modes.! + "L f @:m(m.m^R Kill Global Word Abbrev) ' !* Neg ARG, delete.! + f @m(m.m& Add Word Abbrev)*Global Abbrev !* Call with * ! + !* stringarg for varname, Global... as! + !* prompt string.! + w 1  + +!& Add Word Abbrev:! !S Reads an abbrev for words before point. +Stringarg1 is "*" for global abbrev, and space-modename for a mode abbrev, + e.g. " TECO". +Stringarg2 is & Read Line prompt. +Calls & Read Line to read the abbrev. +ARG non-0 means expansion is last ARG words. (Includes breaks in between + words, but not those before first or after last word.) +ARG 0 means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +If the abbrev is already defined, user is asked if redefinition wanted. +The abbrev must not contain any break characters. +Abbrev variable is constructed: X abbreviation Abbrev. It + contains a string which is the expansion.! + :i* [.2 !* .2: Modename part of varname.! + [.3[.4[.5.[.6 fnq.6j !* .6: Auto-restoring point.! + + 1:"N FG F*w 1 ' !* No expansion found.! + !* .3: expansion start.! + Q.3,. fx.3 !* .3: expansion.! + m.m& Shorten String !* S: & Shorten String.! + m.m& Read Line !* R: & Read Line.! + q.3mSu.4 !* .4: Short expansion string.! + 1,mR for ".4": [.1 !''! !* .1: Abbrev.! + q.1"E 1 ' !* Abort.! + + q.1,q.3 m(m.m& Check And Make Word Abbrev).2 !* Define.! + 1  + + 0fo..qAbbrev Auto Save Mode"N !* Maybe should otherwise ask?! + 0fo..qAbbrev Auto Save Count+1u.4 !* In which case this before.! + q.4-(20fo..qAbbrev Auto Save Delay)"G !* ...! + 0m.vAbbrev Auto Save Countw + @ft +(Abbrev Auto Save) m(m.mWrite Word Abbrev File) !* Use default...! + 0fsEchoActive !* dont clear the echo area! + '"# q.4m.vAbbrev Auto Save Countw'' + 1  !* Exit.! + +!& Shorten String:! !S Produce a short string, showing beginning/end. +ARG is a string pointer.! + [.3[.4[.5 !* .3: Long ARG string.! + fq.3-40"G !* If expan is long, only show part.! + 0,16:g.3u.4 !* .4: first 16 letters of exp.! + fq.3-16,fq.3:g.3u.5 !* .5: last 16 letters.! + :i.4.4.....5' !* .4: first and last 16 letters.! + "# q.3u.4' !* .4: expan is short, whole expan.! + q.4  !* Return short string.! + +!^R Word Abbrev Prefix Mark:! !^R Mark point as end of a prefix. +Expansion of the prefix may occur unless an ARG is given. +Sets Word Abbrev Prefix Mark to point and inserts a hyphen.! +!^R Abbrev Expand ! + ff"E !* No expanding if an ARG.! + 0,0a"c m:.e(0)'' !* Expand! + . m.vWord Abbrev Prefix Markw + .,(i-).  !* Hyphen is deleted when! + !* expansion occurs.! + +!& WRDAB Set Mode Line Hook:! !S Tell & Set Mode Line if display " Abbrev".! +!* *** NOT YET *** Inserts " Abbrev", and passes along any given string (old style +hooks accumulated a string of mode line things instead of inserting). +Call & WRDAB Process Options Hook (isnt anymore on that hook). +This is appended to Set Mode Line Hook.! ++0(fsQPPtr !* Q: Unwind to here for auto-popping.! + )[.0 !* .0: Previous hooks value.! + + m(m.m& WRDAB Process Options Hook) !* This way dont have to call! + !* & Process Options every buffer sw.! + 0fo..qWord Abbrev Mode"N !* In Word Abbrev Mode.! + q.0"E :i.0 Abbrev'"# :i.0.0 Abbrev'' !* .0: Append abbrev.! + !* Now return appended strings: ! + !* (Return by running off, not ^\, so! + !* that appending hooks will work.)! + q.0( qQfsQPUnwindw !* Auto-pop all pushed qregs.! + !* Next exit with new string.! + !* Exit without ^\, no CRLF.! + ) +!^R Kill Mode Word Abbrev:! !^R Causes mode abbrev typed to be expunged. +Same as ^R Add Mode Word Abbrev with a negative ARG.! + :i*Fundamental fo..qMODE[.2 !* .2: Mode name.! + 1, m(m.m& Read Line)Kill .2 Abbrev: [.1 !* .1: Abbrev.! + q.1"E ' !* Abort.! + 0fo..qX .1 .2 Abbrev"E !* No such mode abbrev.! + 0fo..qX .1 * Abbrev"E !* And no global either.! + FG @ft".1" is neither .2 mode nor global abbrev. !''! + 0fsEchoActivew 1 ' !* Do nothing, and dont erase message! + "# FG @ft".1" is not a .2 mode abbrev, but is a global abbrev. +Kill it? !''! + 1m(m.m& Yes Or No)"E !* ask him! + @ft Not killed. 0fsEchoActivew 1 ' !* he said no! + :i.2*'' !* .2: Reset to kill global.! + m(m.mKill Variable)X .1 .2 Abbrev !* Expunge abbrev.! + + :i* fo..qLately Changed Abbrevsu.4 !* .1: $Lately$.! + @:i*|.4 +m(m.mKill Variable)X .1 .2 Abbrev| m.vLately Changed Abbrevsw + !* Update lately.! + w 1  + +!^R Kill Global Word Abbrev:! !^R Causes global abbrev typed to be expunged. +Same as ^R Add Global Word Abbrev with a negative ARG.! + 1, m(m.m& Read Line)Kill Global Abbrev: [.1 !* .1: Abbrev.! + q.1"E ' !* Abort.! + 0fo..qX .1 * Abbrev"E !* No such.! + FG @ft".1" is not a global abbrev. !* so tell him! + 0fsEchoActivew 1  !''! ' !* and let it stay on the screen! + m(m.mKill Variable)X .1 * Abbrev !* Expunge abbrev.! + + :i* fo..qLately Changed Abbrevsu.4 !* .1: $Lately$.! + @:i*|.4 +m(m.mKill Variable)X .1 * Abbrev| m.vLately Changed Abbrevsw + !* Update lately! + w 1  + +!Kill All Word Abbrevs:! !C No word abbrevs are defined after this.! +!* For use in conjunction with editing what MM Insert Word Abbrevs inserts, + and then after MM Kill All..., doing MM Define Word Abbrevs.! + [.1[.2[.3 + q..q[..o zj !* Buffer: symbol table.! + !* Will go thru symtab backwards looking! + !* for word abbrev variables.! + + :f !* End of COND.! + > !* End of iter over all entries.! +  + +!Edit Word Abbrevs:! !C Go into ^R mode, editing word abbrev definitions. +Note that any '"'s are doubled so that the syntax is unambiguous. E.g. + if the abbrev 'xsay' is to expand to 'He said "Hello"', then it will be: + xsay: 1 "He said ""Hello""" +^R mode is entered. When exited normally, (e.g. by ^C^C) the buffer will + be considered as new definitions of word abbrevs. +^G will abort MM Edit Word Abbrevs, leaving word abbrevs untouched.! + @:i*| 1m.vAbort Edit Word Abbrevsw !* Signal abort.! + fs^RExitw |[.G !* Define ^G to signal abort.! + 0m.vAbort Edit Word Abbrevsw !* Signal not to abort at start.! + f[BBind !* Get a temp buffer, ! + m(m.mInsert Word Abbrevs) bj !* ...and set up list to edit.! + :i*Edit Word Abbrevs[..J !* Set mode line.! +  !* Edit.! + fsEchoDisw CfsEchoDisw !* Clear echo area.! + 0fo..qAbort Edit Word Abbrevs"E !* No abort signalled.! + m(m.mKill All Word Abbrevs) !* Erase prev abbrev defns.! + m(m.mDefine Word Abbrevs) !* Define new ones from buffer list.! + @ftWord abbrevs redefined. !* Tell user.! + 0fsEchoActivew !* Dont clear echo area after! + ' !* Done redefinitions.! + "# FG @ftWord abbrevs NOT redefined. !* Confirm abort.! + 0fsEchoActivew' !* and dont clear echo area after! + m(m.mKill Variable)Abort Edit Word Abbrevs !* Clean up.! +  + +!Sort Word Abbrevs:! !C Sort a word abbrev list in the buffer by count. +The most-frequently used abbrevs appear at the top of the list.! + bj < .-z; !* Go thru whole buffer.! + .-(:l)."E k'"# l'> !* Kill blank lines.! + + :  !* Sort record is a line.! + :s"$f"Lw !* Goto beginning of expansion.! + -fwl \'!'! !* Sort key is possible usage-count.! + l !* To end of record.! +  + +!& WRDAB Off PO Check:! !S Check list of chars for expanders, fix. +q.1: List of characters. +q.6: ^R Macro to check against. +q.7: Subroutine to call if char runs .6.! + -1[.4[.5 !* .4: Index into .1.! + < %.4-fq.1; !* Stop when done with .1.! + q.4:g.1u.5 !* .5: Charcode for next INS char.! + q.5-q.6"E q.5m.7' > !* If same, fix it.! +  + +!& WRDAB On PO Check:! !S Check list of expand characters for changes and fix. +q.1: List of characters. +q.6: ^R Macro to check against. +q.7: Subroutine to call if change.! + -1[.4[.5 !* .4: Index into .1.! + < %.4-fq.1; !* Stop when done with .1.! + q.4:g.1u.5 !* .5: Charcode for next INS char.! + q.5-q.6"N q.5m.7' > !* If changed, fix it.! +  + +!& WRDAB Process Options Hook:! !S Check for characters to change. +Calls a subroutine to see-if/do any expand characters need updating. +Is a little slow for someone who makes Word Abbrev Mode local. Could fix.! + [.0[.1[.6[.7[.8 + 0fo..qMM ^R Abbrev Expand for Tabf"EoRST'u.0 !* .0: Tab expander.! + 0fo..qWord Abbrev Mode"N !* word abbrev mode?! + qI-q.0"n !* turn on Tab?! + qIm(m(m.m& Global or Local)I)MM # WRDAB Old 11 + !* Yes, save old tab in either global! + !* (using .V) or local (using .L) var.! + q.0uI' !* and set it to tab expander.! + 0fo..qMM & WRDAB On PO Checkf"EoRST'u.0 !* .0: Checker loop.! + 0fo..qMM & WRDAB Turn On Ins Charf"EoRST'u.7 !* .7: Turn on ins.! + 0fo..qMM & WRDAB Turn On Old Charf"EoRST'u.8 !* .8: Turn on old.! + ' !* End WAM on conditional.! + "# qI-q.0"E !* Must turn off Tab.! + qMM # WRDAB Old 11uI' !* ...! + 0fo..qMM & WRDAB Off PO Checkf"EoRST'u.0 !* .0: Checker loop.! + 0fo..qMM & WRDAB Turn Off Ins Charf"EoRST'u.7 !* .7: Turn off ins.! + 0fo..qMM & WRDAB Turn Off Old Charf"EoRST'u.8 !* .8: Turn off old.! + ' !* End WAM off conditional.! + 0fo..qWORDAB Ins Charsu.1 !* .1: 0 or inserting breaks.! + q.1"E :i.1' !* .1: Make sure a string. (But no! + !* consing unless have to.)! + + 0fo..qMM ^R Abbrev Expand And Self-Insertf"EoRST'u.6 !* .6: ^R Ins! + m.0 !* Check them, fix.! + + 0fo..qWORDAB Old Charsu.1 !* .1: Call-old breaks.! + q.1"E :i.1' !* ...! + 0fo..qMM ^R Abbrev Expand And Call Old Charf"EoRST'u.6 !* .6: Old Char! + q.8u.7 !* .7: Old version for m.0.! + m.0 !* Check them, fix.! + +  !* KEEP HERE IF NOT ON HOOK! + + !RST! !* Ensure MM-variables exist.! + + m.m& WRDAB Process Options Hookm.vMM & WRDAB Process Options Hookw + m.m^R Abbrev Expand for Tabm.vMM ^R Abbrev Expand for Tabw + m.m& WRDAB On PO Checkm.vMM & WRDAB On PO Checkw + m.m& WRDAB Turn On Ins Charm.vMM & WRDAB Turn On Ins Charw + m.m& WRDAB Turn On Old Charm.vMM & WRDAB Turn On Old Charw + m.m& WRDAB Off PO Checkm.vMM & WRDAB Off PO Checkw + m.m& WRDAB Turn Off Ins Charm.vMM & WRDAB Turn Off Ins Charw + m.m& WRDAB Turn Off Old Charm.vMM & WRDAB Turn Off Old Charw + m.m^R Abbrev Expand And Self-Insertm.vMM ^R Abbrev Expand And Self-Insertw + m.m^R Abbrev Expand And Call Old Charm.vMM ^R Abbrev Expand And Call Old Charw + +f:m(m.m& WRDAB Process Options Hook) !* Try again now.! + + +!& WRDAB Turn On Ins Char:! !S Make a ^R Abbrev Expand And Self-Insert key. +ARG: 9-bit of key to use. +If is FS^RInit, then becomes expand-ins. +Otherwise becomes a call-old expander, and character is moved from WORDAB + Ins Chars to WORDAB Old Chars.! + + [.0 !* .0: Ascii for key.! + q.0[.4 !* .4: Keys macro.! + q.4fp"L !* Is builtin.! + m.m^R Abbrev Expand And Self-Insertu.0 !* Set ins.! + ' !* And return.! + + f~.4!^R Abbrev Expand -19"e ' !* If not already an expander, ! + qWORDAB Ins Chars[.1 !* .1: $ins$! + f.1[.2 !* .2: Position in $ins$! + 0,q.2:g.1[.3 !* .3: Ins chars before this one.! + q.2+1,fq.1:g.1u.1 !* .1: Ins chars after.! + :iWORDAB Ins Chars.3.1 !* $ins$: Take out this char.! + qWORDAB Old Charsu.1 !* .1: $old$! + :i.2 !* .2: This char, string.! + :iWORDAB Old Chars.1.2 !* $old$: Add this char.! + + m.m^R Abbrev Expand And Call Old Charu.0 !* Set key.! + [.6 8[..e :\u.6 ]..e !* .6: Octal string for char.! + q.4m(m(m.m& Global or Local).0)MM # WRDAB Old .6 + !* Yes, save old char in either global! + !* (using .V) or local (using .L) var.! +  + +!& WRDAB Turn On Old Char:! !S Make a ^R Abbrev Expand And Call Old Char key. +ARG: 9-bit of key to use.! + + [.0 !* .0: Old char 9-bit.! + q.0[.1 !* .1: Old char macro.! + q.1fp"G !* If not a builtin now, ! + f~.1!^R Abbrev Expand -19"E !* If already an expander, ! + '' !* ...then quit while ahead.! + m.m^R Abbrev Expand And Call Old Charu.0 !* Set key.! + [.6 8[..e :\u.6 ]..e !* .6: Octal string for char.! + q.1m(m(m.m& Global or Local).0)MM # WRDAB Old .6 + !* Yes, save old char in either global! + !* (using .V) or local (using .L) var.! +  + +!& WRDAB Turn Off Ins Char:! !S Reset char ARG to builtin.! + [.0 !* .0: 9-bit.! + fs^RInitu.0  !* Reset.! + +!& WRDAB Turn Off Old Char:! !S Reset char ARG to what was before.! + [.6 8[..e :\u.6 ]..e !* .6 Octal string for char.! + 0fo..qMM # WRDAB Old .6[.1 !* .1: Maybe old char function.! + [.2 !* .2: 9-bit.! + q.1u.2  !* Reset key.! + +!^R Abbrev Expand for Tab:! !^R Expands abbrevs when Tab inserts at point. +If Tab will not insert any whitespace at point, no expansion is attempted. + (E.g. the Tab is reindenting the line, but point is mid-line.) +Old Tab is in MM # WRDAB Old 11. +Explicit ARG inhibits expanding.! +!^R Abbrev Expand ! + 0,0a[.1 !* .1: Char to left before tabbing.! + .,.f !* Tell  that buffer is modified so! + !* that simple-minded tabs calling! + !* fs^RInsert wont be too primitive! + !* and echo a tab which might thus get! + !* echoed twice here.! + f@mMM # WRDAB Old 11f !* Call old Tab.! + 0,0a"B q.1"C !* If now break to left and before wasnt,! + !* then Tab inserted here.! + ff"E !* Can expand if no ARG.! + -@f k !* Kill white to left.! + 0,0a"c m:.e(0)' !* Expand! + f @mMM # WRDAB Old 11f''' !* Call old Tab function again.! + 1 + +!& Global or Local:! !S Return Q.L if argument is a local q-register. Q.V otherwise.! + [1[2[3[9 !* save regs! + [ -1:fsQPHome(]*w)u3 !* get home of our q-register argument! + qBuffer Indexu9 q9+8u2 !* ! + q:.b(q9)-9/2u1 !* ! + q1< q:.b(%2)-q3"e q.L ' %2w > !* if q-register is local then return! + !* .L! + q.V  !* else return .V! + +!Read Word Abbrev File:! !C Define word abbrevs from a file of definitions. +Stringarg is word abbrev definition file. Default is ;WORDAB DEFNS.! + + f[DFile 1f[FnamSyntax !* Save default filename *! + 0fo..qLast Word Abbrev Filef"n fsDFilew' !* Either last-used or *! + "#w etDSK:WORDAB DEFNS fsHSnamefsDSnamew' !* else a default. *! + 4,f Word Abbrev Filef"ew'fsDFilew !* Read string argument *! + fsDFilem.vLast Word Abbrev Filew !* save for defaulting *! + f[BBind er @y !* Read in QWABL file. *! + + !* See if old-style format in definition file: ! + + 10f~m.m& Make "n !* All QWABL files start that way, and! + fsDFile[1 !* no old style file can.! + m(m.mRun Library)WABCONConvert Old Word Abbrev File1 + !* That defined and converted.! + er @y hx*m.vQWABL Definitionsw !* Save for fast definition accesses.! + ' !* Done -- the convert defined them.! + + !* The file is in the new style: ! + + hx* m.vQWABL Definitionsw !* Save for fast definition accesses. *! + mQWABL definitions  !* Call it. *! + +!Write Word Abbrev File:! !C Write a definition file for all defined abbrevs. +Stringarg filename. Default is WORDAB DEFNS. +Argument present means do not write out usage counts. +Default filenames come from last definition filename used.! + [.0[.1[.2[.3[.4[.5 f[DFile !* save regs! + 1f[FnamSyntax !* Lone fn is first fn. *! + 0fo..qLast Word Abbrev Filef"n fsDFilew' + "#w etDSK:WORDAB DEFNS fsHSnamefsDSnamew' + 4,f Word Abbrev Filef"ew'u.0 !* Read string argument *! + et.0 fsDFileu.0 !* .0: Set default fn. *! + q.0m.vLast Word Abbrev Filew !* Save for next time. *! + + f[BBind !* Temp buffer. *! + m.m& Teco Quote Area !* Q: & Teco Quote Area. *! + :fo..qX u.2 !* .2: $X ^@$ offset, before any abbrevs.! + q.2"L -q.2u.2' !* .2: $X ^@$ offset, positive.! + !* .2: Running ..Q index for abbrevs.! + ff&1"E !* QWABL file has usage counts. *! + ^i|m.m& Make Usage Abbrev Variable !* V: Will be variable-maker. *! +|'"# !* QWABL file has no usage counts. *! + ^i|m.m& Make Non-Usage Abbrev Variable !* V: Will be variable-maker. *! +|' + iq..q[..o !* Will select symtab buffer. *! + + fq..q/5-q.2/3( !* Number of var slots to examine in ..Q.! + q.2-1u.2 !* .2: Start ..Q - 1.! + )< q:..Q(%.2)u.3 !* .3: Next variable name.! + q:..Q(%.2)u.4 !* .4: Next variable value.! + q:..Q(%.2)u.5 !* .5: Next variable comment.! + q.4fp"L oNEXT' !* Skip variable if value is number.! + !* (Local vars become 0 when not in their! + !* buffer.)! + f~(0,2:g.3)X "N oNEXT' !* Skip this variable if not $X ...$, ! + f~(fq.3-7,fq.3:g.3) Abbrev"N oNEXT' !* ...or if not $... Abbrev$.! + iMV.3 !* Insert var-maker call, varname. *! + .(g.4)mQ i !* Insert expansion, quote alts, ^]s. *! + ff&1"E g.5 i' !* Insert usage if no argument or only *! + !* pre-comma argument. *! + i + + !NEXT! > !* Repeat for next variable.! + + hx* m.vQWABL Definitionsw !* Save for quick definition accesses. *! + 1,m(m.m Write File).0 !* Write it out. *! +  + +!Word Abbrev Apropos:! !C List abbrevs or expansions containing stringarg. +String argument is some pattern to find, either in abbrev, modename, or + expansion. It is a standard Teco search string; e.g. you can do: + MM Word Abbrev Apropos$foo^Obar$ which will match foo OR bar. +Currently this command only works "approximately" -- it may miss definitions + that have changed via Edit Word Abbrevs, or were only defined by Define + Word Abbrevs. It will however catch all definitions read in from a file + or defined one by one by the user.! + + :i*[0[1 !* 0: String argument to match.! + f[BBindw !* Temp buffer.! + 0fo..qQWABL Definitionsu1 !* 1: Get word abbrevs.! + q1"n g1 j 2:k' !* ... and kill setup stuff.! + 0fo..qLately Changed Abbrevsu1 !* 1: Add in recent ones.! + q1"n .(g1)j 2:k' !* ... and kill setup stuff.! + !* Those 2:ks leave a blank line at top, for boundary conditions.! + + j <:s +m(m.mKill Variable)X ; 2r .,(:lr).x1 !* 1: Killed abbrev name.! + 0lk fsZ-.fsVZw !* Will kill instances of that abbrev! + !* above the point of kill.! + j<:s +MV1; 0l .,(3s).k> !* Kill instances of that abbrev.! + 0fsVZw > !* Look for more to kill.! + + bj <:s +MVX ;  + + > !* Separate abbrevs, no funny matches.! + + bj l + < :s0; !* Find a match.! + -s + + fkc .,(fwl).t ft:  !* Type abbrev.! + c 0,1a-*"N !* This is a mode abbrev.! + ft( .,(s Abbrev fkc).t ft)' !* Type mode if any.! + ft "!'! !* Type up to expansion.! + s Abbrev !* Find beginning of expansion.! + .,(sr).t !* Find end and type.! + ft" + !'! !* ! + :s + +; > !* Ready for next matching abbrev.! + + ftDone. + +  + +!& Make Usage Abbrev Variable:! !S Like .V and .C combined, for speed. +STRARG1 is abbrev variable name. +STRARG2 is abbrev expansion with altmodes, ^]s quoted with ^]s. +STRARG3 is usage-count string. +Assumes ..Q is selected as buffer (..O).! + :i*[.1 !* .1: Abbrev varname. *! + :i*[.2 !* .2: Abbrev expansion. *! + :i*[.0 !* .0: Usage count string. *! + :FO..Q.1[.3 !* .3: Variable index. *! + Q.3"L -Q.3*5J 15,0I 15R q.1,.FSWORDW 0,.+10FSWORDW !* .3 neg *! + -Q.3U.3' !* .3: Pos index. *! + q.3+1*5j q.2,.fswordw !* Stick in expansion string. *! + 5c q.0,.fswordw  !* Stick in usage count string. *! + +!& Make Non-Usage Abbrev Variable:! !S Like .V and .C combined, for speed. +STRARG1 is abbrev variable name string. +STRARG2 is abbrev expansion string. +Assumes ..Q is selected as buffer (..O).! + :i*[.1 !* .1: Abbrev varname. *! + :i*[.2 !* .2: Abbrev expansion. *! + :FO..Q.1[.3 !* .3: Variable index. *! + Q.3"L -Q.3*5J 15,0I 15R q.1,.FSWORDW 0,.+10FSWORDW !* .3 neg *! + -Q.3U.3' !* .3: Pos index. *! + q.3+1*5j q.2,.fswordw !* Stick in expansion string. *! +  diff --git a/src/e142/wordab._ej b/src/e142/wordab._ej new file mode 100644 index 00000000..16f04f37 Binary files /dev/null and b/src/e142/wordab._ej differ diff --git a/src/e142/wordab._ej.547 b/src/e142/wordab._ej.547 new file mode 100644 index 00000000..4d837e07 --- /dev/null +++ b/src/e142/wordab._ej.547 @@ -0,0 +1,820 @@ +pW[0 +8+fq(+4)[1 +0fo10 f"g +q1 ' ++fq()+4u1 +fq1"l 0' +,q1:m(q1+4(]1 ]0))]T^8H  mw3(32:c:u::n{ t ~5?-=) +))6)B)b)r!n!}1~2 +22)/:/H11GR&y'%0&&alu$7+3m3z(](h8!8-(#(x 5=5J#6p2N2\u!DRN`Te$g$v"I"W . :!/!>ijV)V6KKA[AdA8ADdd i.iCh/hB;o;YY*OON\NkA A^F^U_#_2``Z4ZFb4bEbVbh`saazb G%G3\\ GjGx[k[{GGGUII==*MM)dBdR]|^ +ff C'C@>OTaTsRqSPmQO+O@[$[6Z_ZpB1BAYRYd;D;N;8;?nOnU& Setup WORDAB LibraryQ[1[2 +6*5fsQVectoru.e +m.m& WRDAB Mode or Global Expandu:.e(0) +m.m& Expandu:.e(1) +0u:.e(2) +0u:.e(3) +0u:.e(4) +0u:.e(5) +1,m.m& Setup Compressed WORDAB Librariesu1 +q1"n fm1' +0fo..qWORDAB SETUP HOOKu1 +q1"n m1' +m.m& WRDAB Set Mode Line Hooku1 +0fo..qSet Mode Line Hooku2 +q2"e q1'"# :i*21'm.vSet Mode Line Hookw +&Old Word Abbrev Character Describe}[0[1 + 1,(:i*Type word abbrev key to describe: )m.i +@fiu0 +q0fs^RCMacro-(m.m^R Abbrev Expand And Call Old Char)"n + q0m(m.m& Charprint) + ft does not run ^R Abbrev Expand And Call Old Char. It runs + q0fs^RCMacro :m(m.mDescribe)' + 8[..e q0:\u1 ]..e +qMM # WRDAB Old 1u1 +ftAfter possibly expanding,  q0m(m.m& Charprint) ft runs  + q1:m(m.mDescribe) ^R Abbrev Expand OnlyB!^R Abbrev Expand ! +.( +0,0a"c m:.e(0)' +)-."e ff"g fg'' 1&^R Abbrev Expand And Call Old Charu!^R Abbrev Expand ! + ff"E +0,0a"c m:.e(0)'' +[.1 8[..e q..0fs^RIndirect:\u.1 ]..e +f @:mMM # WRDAB Old .1$^R Abbrev Expand And Self-InsertU!^R Abbrev Expand ! + ff"e 0,0a"c m:.e(0)'' + f@:m(q..0fs^RIndirectfs^Rinit)!& WRDAB Mode or Global Expand`-fwx*[.1 qMode[.2 +:fo..qX .1 .2 Abbrevf"lw :fo..qX .1 * Abbrevf"lw''u.2 +:m:.e(1)& Global Expand7-fwx*[.1 +:fo..qX .1 * Abbrevf"lw'[.2 +:m:.e(1) & Expand+[..0 +q:..q(q.2+2)[.3 +q.3fp-101"N :i:..q(q.2+2)1' +"# .(g.3)j .(\+1:\u:..q(q.2+2))j fq.3d' +-fq.1d +0,0a--"E +-1fo..qWord Abbrev Prefix Mark+1-."E +:i.1-.1 +-d'' +.u:.e(3) +.[.4 +g:..q(q.2+1) +.[.5 +-1[.7 +fq.1[.8 +<%.7-q.8; +q.7 :g.1"a0;'> +q.7 :g.1"u +q.4j :fwl +1 @fc +q.8-1 :g.1"u +0fo..qWordab All Caps"e +0u.3 +:< 2:fwl .-q.5; %.3w +1 @fc >w +q.3"e q.4,q.5 @fc'' +"# +q.4,q.5 @fc'' +' +q.1u:.e(2) +:i:.e(5) +q.5j +q.4,q.5 f +ff-1"G oUPDATE ' +0fo..qAuto Fill Mode"E oUPDATE ' +0fo..qFill Columnf"e w fsWidth-10'u.1 +fsSHpos-q.1-2"l oUPDATE' +m.m^R Indent New Comment Line +q.5(:fx.5 +)-q.4f +.-q.4"L .u:.e(3) +.,q.4x:.e(5) +.u.4' +@f k +:fx.3 +@mIw +:0L.,(:2Lg.3).f> +:l .(g.5)j +!UPDATE! + + q.4,.x:.e(4) +^R Unexpand Last Word>z-.[.4 +fn z-q.4j +q:.e(2)"e fg @ft +No last expansion 0fsEchoActivew 1 ' + q:.e(2)[.1 +q:.e(4)[.3 +0,1 :g.1 [.2 +.2--"E +1,fq.1 :g.1 u.1' +"# :i.2' +q:.e(3)[.5 +1:"N zj' +fq.3f~.3"n fg @ft +No last expansion 0fsEchoActivew 1 ' +fq.3d +.,(g:.e(5) +g.2 +g.1). f +:i*Fundamental fo..qMODEu.2 +:fo..qX .1 .2 Abbrevf"G u.2' +"# :fo..qX .1 * Abbrevf"G u.2'' +q:..q(q.2+2)[.3 +.(g.3)j .(\-1:\u:..q(q.2+2))j fq.3d +1 Word Abbrev Mode +WORDAB= [.2[.3 + ff&1"E 1u.3' +"# "'N,0u.3' +q.3m.vWord Abbrev Modew +ff&2"n "n m.m& Global Expandu:.e(0)' + "# m.m& WRDAB Mode or Global Expandu:.e(0)'' + + 0fo..qWord Abbrev Hooku.2 +q.2"N q.3 m.2' +q.3"E +q.2"E 0u:.x(U) +0u:.x() +0u:.x() +0u:.x(-) +0u:.x(+)' +m(m.m& Set Mode Line) +' +0fo..qWORDAB Ins Chars"E +:i*!~@#;$%^&*-_=+[]()\|:`"'{},<.>/? + m.vWORDAB Ins Charsw +:i* m.vWORDAB Old Charsw' +q.2"E +m.m^R Unexpand Last Word u:.x(U) +m.m^R Add Mode Word Abbrev u:.x() +m.m^R Inverse Add Mode Word Abbrev u:.x() +m.m^R Add Global Word Abbrev u:.x(+) +m.m^R Inverse Add Global Word Abbrev u:.x(-) +m.m^R Abbrev Expand Only u... w +m.m^R Word Abbrev Prefix Mark(!"!) u..' +ff&2"n q:.x()(q:.x(+)u:.x())u:.x(+) +q:.x()(q:.x(-)u:.x())u:.x(-)'' +:m(m.m& Set Mode Line)Define Word Abbrevs[.1[.2[.4 + g(q..o(f[BBindw)) +bj 0s <:s;ric> +zj i + +bj + < .-z; + :s:; -d +0fx.1 +@f  k +0,1a-("E d :flfx.2 d' +"# :i.2*' +@f  k +@f0123456789 fx.4 +fq.4"E :i.40' +@f  k +0,1a-34"N :i*No quote to start expansionfsErr + ' +d i:i* +0s" !'! <:s"e :i*No quote to end expansionfsErr' +0,1a-":@; c> !'! +0,1a-15."n :i*Possible unquoted " in expansion -- final " not at end of linefsErr !''!' + -d +iM.VX .1 .2 Abbrevw +i M.CX .1 .2 Abbrev.4 +l> +j 0s"" <:s; -d> +m( hx* ) +List Word Abbrevsr[.1 f[BBindw +m(m.mInsert Word Abbrevs) + bj i +abbrev: (mode) count "expansion" + + +ht ft +Done. + Insert Word Abbrevs [1[2[3[4[5[6 + q..ou1 +f[BBind q..ou6 [..o +:fo..qX u2 +q2"L -q2u2' +q1u..o i + + -l +fq..q/5-q2/3( +q2-1u2 +)< q:..Q(%2)u3 +q:..Q(%2)u4 +q:..Q(%2)u5 +q4fp"L oNEXT' +f~(0,2:g3)X "N oNEXT' +f~(fq3-7,fq3:g3) Abbrev"N oNEXT' +2,fq3-7g3 +-s d i:  +1a-*"E d'"# i( :l i)' +9i g5 i " !'! +"f4:"l q6u..o g4 +j 0s" <:s; i"> !''! hx4 q1u..o' !'! +g4 i" + !'! +!NEXT! > +Make Word Abbrevr:i*( :i*( :i*[.3)[.2)[.1 +fq.3"E qMODEu.3' +q.1,q.2 m(m.m& Check And Make Word Abbrev).3 +w 1  & Check And Make Word Abbrev`:i*[2 [1 [3 +q1[4 [5 +fq1< 0,1:g4u5 +5"b fg @ft +Break chars not allowed in abbrev 0fsEchoActivew 1 ' + 1,fq4:g4u4> +m.m& Shorten String +0fo..qX 1 2 Abbrevu4 +q4"N f=34"N FG +q4mSu4 +@ftRedefine "1" from "4"?  !''''! +1m(m.m& Yes or No)"E @ftNot redefined. +0fsEchoActivew 1 '' +"# @ftAlready so defined. +0fsEchoActivew 1 '' +q3m.vX 1 2 Abbrevw +m.cX 1 2 Abbrev0 +@:i*|m.m& Make Non-Usage Abbrev Variable +q..q[..o +| fo..qLately Changed Abbrevsu4 +q3m(m.m& Teco Quote String)u3 +@:i*|4 +MVX 1 2 Abbrev30|( + )m.vLately Changed Abbrevsw +&Write Incremental Word Abbrev File[1 + e[e\ fne^e] f[DFile 1f[FNamSyntax +etDSK: fsHSNamefsDSNamew etINCABS > +4,f Incremental Filef"e w'u1 +f[BBind g(:i* fo..qLately Changed Abbrevs) +z"e :i*No incremental abbrevs to write fsErr' +eihpef1 +er fsIFileu1 ec @ft +Written: 1 + 0fsEchoActivew 1%Read Incremental Word Abbrev FileJ[1 f[DFile +e[ fne] f[DFile 1f[FNamSyntax +etDSK: fsHSNamefsDSNamew etINCABS > +4,f Incremental word abbrev filef"e w'u1 +et1 +f[BBindw er @y +m( hx*f(m.vLately Changed Abbrevsw) ) +& Teco Quote String3f[BBind g() +bm(m.m& Teco Quote Area) +hx* & Teco Quote Area).-z( +< .,:fb; ir > +)+zj #^R Inverse Add Mode Word AbbrevQqMode[.4 + .-z[.0 +-:fwl +-fwx*[.1 +1,m(m.m& Read Line)Expansion for .4 abbrev ".1": [.2 !''! +q.2"e 1' +fq.2"e 1' +m(m.mMake Word Abbrev).1.2 +@m(m.m^R Abbrev Expand Only)f +q.0+zj +1%^R Inverse Add Global Word AbbrevH.-z[.0 +-:fwl +-fwx*[.1 +1,m(m.m& Read Line)Expansion for global abbrev ".1": [.2 !''! +q.2"e 1' +fq.2"e 1' +m(m.mMake Word Abbrev).1.2* +@m(m.m^R Abbrev Expand Only)f +q.0+zj +1^R Add Mode Word Abbrev"L f @:m(m.m^R Kill Mode Word Abbrev) ' +:i*FUNDAMENTAL fo..qMODE [.1 +f @m(m.m& Add Word Abbrev).1.1 Abbrev +w 1 ^R Add Global Word Abbreve"L f @:m(m.m^R Kill Global Word Abbrev) ' +f @m(m.m& Add Word Abbrev)*Global Abbrev +w 1 & Add Word Abbrev+:i* [.2 +[.3[.4[.5.[.6 fnq.6j +1:"N FG F*w 1 ' +Q.3,. fx.3 +m.m& Shorten String +m.m& Read Line +q.3mSu.4 +1,mR for ".4": [.1 !''! +q.1"E 1 ' +q.1,q.3 m(m.m& Check And Make Word Abbrev).2 +1  + + 0fo..qAbbrev Auto Save Mode"N +0fo..qAbbrev Auto Save Count+1u.4 +q.4-(20fo..qAbbrev Auto Save Delay)"G +0m.vAbbrev Auto Save Countw + @ft +(Abbrev Auto Save) m(m.mWrite Word Abbrev File) +0fsEchoActive +'"# q.4m.vAbbrev Auto Save Countw'' + 1 & Shorten Stringb[.3[.4[.5 +fq.3-40"G +0,16:g.3u.4 +fq.3-16,fq.3:g.3u.5 +:i.4.4.....5' +"# q.3u.4' +q.4 ^R Word Abbrev Prefix Marka!^R Abbrev Expand ! + ff"E +0,0a"c m:.e(0)'' +. m.vWord Abbrev Prefix Markw + .,(i-).  +& WRDAB Set Mode Line Hook+0(fsQPPtr +)[.0 +m(m.m& WRDAB Process Options Hook) +0fo..qWord Abbrev Mode"N +q.0"E :i.0 Abbrev'"# :i.0.0 Abbrev'' +q.0( qQfsQPUnwindw +)^R Kill Mode Word Abbrev +:i*Fundamental fo..qMODE[.2 +1, m(m.m& Read Line)Kill .2 Abbrev: [.1 +q.1"E ' +0fo..qX .1 .2 Abbrev"E +0fo..qX .1 * Abbrev"E +FG @ft".1" is neither .2 mode nor global abbrev. !''! + 0fsEchoActivew 1 ' +"# FG @ft".1" is not a .2 mode abbrev, but is a global abbrev. +Kill it? !''! + 1m(m.m& Yes Or No)"E +@ft Not killed. 0fsEchoActivew 1 ' +:i.2*'' +m(m.mKill Variable)X .1 .2 Abbrev +:i* fo..qLately Changed Abbrevsu.4 +@:i*|.4 +m(m.mKill Variable)X .1 .2 Abbrev| m.vLately Changed Abbrevsw +w 1 ^R Kill Global Word Abbrev61, m(m.m& Read Line)Kill Global Abbrev: [.1 +q.1"E ' +0fo..qX .1 * Abbrev"E +FG @ft".1" is not a global abbrev. +0fsEchoActivew 1  !''! ' +m(m.mKill Variable)X .1 * Abbrev +:i* fo..qLately Changed Abbrevsu.4 +@:i*|.4 +m(m.mKill Variable)X .1 * Abbrev| m.vLately Changed Abbrevsw +w 1 Kill All Word Abbrevs8[.1[.2[.3 + q..q[..o zj +:f +> +Edit Word Abbrevs3@:i*| 1m.vAbort Edit Word Abbrevsw +fs^RExitw |[.G +0m.vAbort Edit Word Abbrevsw +f[BBind +m(m.mInsert Word Abbrevs) bj +:i*Edit Word Abbrevs[..J + +fsEchoDisw CfsEchoDisw +0fo..qAbort Edit Word Abbrevs"E +m(m.mKill All Word Abbrevs) +m(m.mDefine Word Abbrevs) +@ftWord abbrevs redefined. +0fsEchoActivew +' +"# FG @ftWord abbrevs NOT redefined. +0fsEchoActivew' +m(m.mKill Variable)Abort Edit Word Abbrevs +Sort Word AbbrevsEbj < .-z; +.-(:l)."E k'"# l'> +:  +:s"$f"Lw +-fwl \'!'! +l +& WRDAB Off PO Check@-1[.4[.5 +< %.4-fq.1; +q.4:g.1u.5 +q.5-q.6"E q.5m.7' > +& WRDAB On PO Check@-1[.4[.5 +< %.4-fq.1; +q.4:g.1u.5 +q.5-q.6"N q.5m.7' > + & WRDAB Process Options Hook [.0[.1[.6[.7[.8 + 0fo..qMM ^R Abbrev Expand for Tabf"EoRST'u.0 +0fo..qWord Abbrev Mode"N +qI-q.0"n +qIm(m(m.m& Global or Local)I)MM # WRDAB Old 11 +q.0uI' +0fo..qMM & WRDAB On PO Checkf"EoRST'u.0 +0fo..qMM & WRDAB Turn On Ins Charf"EoRST'u.7 +0fo..qMM & WRDAB Turn On Old Charf"EoRST'u.8 +' +"# qI-q.0"E +qMM # WRDAB Old 11uI' +0fo..qMM & WRDAB Off PO Checkf"EoRST'u.0 +0fo..qMM & WRDAB Turn Off Ins Charf"EoRST'u.7 +0fo..qMM & WRDAB Turn Off Old Charf"EoRST'u.8 +' +0fo..qWORDAB Ins Charsu.1 +q.1"E :i.1' +0fo..qMM ^R Abbrev Expand And Self-Insertf"EoRST'u.6 +m.0 +0fo..qWORDAB Old Charsu.1 +q.1"E :i.1' +0fo..qMM ^R Abbrev Expand And Call Old Charf"EoRST'u.6 +q.8u.7 +m.0 + +!RST! +m.m& WRDAB Process Options Hookm.vMM & WRDAB Process Options Hookw + m.m^R Abbrev Expand for Tabm.vMM ^R Abbrev Expand for Tabw + m.m& WRDAB On PO Checkm.vMM & WRDAB On PO Checkw + m.m& WRDAB Turn On Ins Charm.vMM & WRDAB Turn On Ins Charw + m.m& WRDAB Turn On Old Charm.vMM & WRDAB Turn On Old Charw + m.m& WRDAB Off PO Checkm.vMM & WRDAB Off PO Checkw + m.m& WRDAB Turn Off Ins Charm.vMM & WRDAB Turn Off Ins Charw + m.m& WRDAB Turn Off Old Charm.vMM & WRDAB Turn Off Old Charw + m.m^R Abbrev Expand And Self-Insertm.vMM ^R Abbrev Expand And Self-Insertw + m.m^R Abbrev Expand And Call Old Charm.vMM ^R Abbrev Expand And Call Old Charw + +f:m(m.m& WRDAB Process Options Hook) +& WRDAB Turn On Ins Char[.0 +q.0[.4 +q.4fp"L +m.m^R Abbrev Expand And Self-Insertu.0 +' +f~.4!^R Abbrev Expand -19"e ' +qWORDAB Ins Chars[.1 +f.1[.2 +0,q.2:g.1[.3 +q.2+1,fq.1:g.1u.1 +:iWORDAB Ins Chars.3.1 +qWORDAB Old Charsu.1 +:i.2 +:iWORDAB Old Chars.1.2 +m.m^R Abbrev Expand And Call Old Charu.0 +[.6 8[..e :\u.6 ]..e +q.4m(m(m.m& Global or Local).0)MM # WRDAB Old .6 +& WRDAB Turn On Old Char@[.0 +q.0[.1 +q.1fp"G +f~.1!^R Abbrev Expand -19"E +'' +m.m^R Abbrev Expand And Call Old Charu.0 +[.6 8[..e :\u.6 ]..e +q.1m(m(m.m& Global or Local).0)MM # WRDAB Old .6 +& WRDAB Turn Off Ins Char[.0 +fs^RInitu.0 & WRDAB Turn Off Old CharJ[.6 8[..e :\u.6 ]..e +0fo..qMM # WRDAB Old .6[.1 +[.2 +q.1u.2 ^R Abbrev Expand for Tab!^R Abbrev Expand ! + 0,0a[.1 +.,.f +f@mMM # WRDAB Old 11f +0,0a"B q.1"C +ff"E +-@f k +0,0a"c m:.e(0)' +f @mMM # WRDAB Old 11f''' +1& Global or Localv[1[2[3[9 +[ -1:fsQPHome(]*w)u3 +qBuffer Indexu9 q9+8u2 +q:.b(q9)-9/2u1 +q1< q:.b(%2)-q3"e q.L ' %2w > +q.V Read Word Abbrev Filef[DFile 1f[FnamSyntax +0fo..qLast Word Abbrev Filef"n fsDFilew' +"#w etDSK:WORDAB DEFNS fsHSnamefsDSnamew' +4,f Word Abbrev Filef"ew'fsDFilew +fsDFilem.vLast Word Abbrev Filew +f[BBind er @y +10f~m.m& Make "n +fsDFile[1 +m(m.mRun Library)WABCONConvert Old Word Abbrev File1 +er @y hx*m.vQWABL Definitionsw +' +hx* m.vQWABL Definitionsw +mQWABL definitions Write Word Abbrev File/[.0[.1[.2[.3[.4[.5 f[DFile +1f[FnamSyntax +0fo..qLast Word Abbrev Filef"n fsDFilew' + "#w etDSK:WORDAB DEFNS fsHSnamefsDSnamew' + 4,f Word Abbrev Filef"ew'u.0 +et.0 fsDFileu.0 +q.0m.vLast Word Abbrev Filew +f[BBind +m.m& Teco Quote Area +:fo..qX u.2 +q.2"L -q.2u.2' +ff&1"E +^i|m.m& Make Usage Abbrev Variable +|'"# +^i|m.m& Make Non-Usage Abbrev Variable +|' + iq..q[..o + + fq..q/5-q.2/3( +q.2-1u.2 +)< q:..Q(%.2)u.3 +q:..Q(%.2)u.4 +q:..Q(%.2)u.5 +q.4fp"L oNEXT' +f~(0,2:g.3)X "N oNEXT' +f~(fq.3-7,fq.3:g.3) Abbrev"N oNEXT' +iMV.3 +.(g.4)mQ i +ff&1"E g.5 i' +i + + !NEXT! > +hx* m.vQWABL Definitionsw +1,m(m.m Write File).0 +Word Abbrev Apropos.:i*[0[1 +f[BBindw +0fo..qQWABL Definitionsu1 +q1"n g1 j 2:k' +0fo..qLately Changed Abbrevsu1 +q1"n .(g1)j 2:k' +j <:s +m(m.mKill Variable)X ; 2r .,(:lr).x1 +0lk fsZ-.fsVZw +j<:s +MV1; 0l .,(3s).k> +0fsVZw > +bj <:s +MVX ;  + + > +bj l + < :s0; +-s + + fkc .,(fwl).t ft:  +c 0,1a-*"N +ft( .,(s Abbrev fkc).t ft)' +ft "!'! +s Abbrev +.,(sr).t +ft" + !'! +:s + +; > +ftDone. + +  & Make Usage Abbrev Variable +:i*[.1 +:i*[.2 +:i*[.0 +:FO..Q.1[.3 +Q.3"L -Q.3*5J 15,0I 15R q.1,.FSWORDW 0,.+10FSWORDW +-Q.3U.3' +q.3+1*5j q.2,.fswordw +5c q.0,.fswordw $& Make Non-Usage Abbrev Variable:i*[.1 +:i*[.2 +:FO..Q.1[.3 +Q.3"L -Q.3*5J 15,0I 15R q.1,.FSWORDW 0,.+10FSWORDW +-Q.3U.3' +q.3+1*5j q.2,.fswordw + +~FILENAME~ +WORDAB~DOC~ ~FILENAME~CWord Abbrev Mode package. Documentation in INFO under EMACS. + ~DOC~ & Setup WORDAB Library*S Run when WORDAB is loaded. Calls a hook. +Calls WORDAB SETUP HOOK, if it exists. That can do things like + auto-loading a file of abbreviations. +Then appends & WRDAB Set Mode Line Hook to Set Mode Line Hook. + Thus, anything put on those hook variables should not return by ^\. +,~DOC~ Old Word Abbrev Character Describe+C Tell what char does after expanding. +This command will ask you to type a character, e.g. Space, which runs the +word abbrev expander and then calls the old definition for that +character. The description for that old definition will be given, e.g. +the description for ^R Auto-Fill Space. + +~DOC~ ^R Abbrev Expand Onlyv^R Expand last word, but insert nothing after it. +If given an argument, will feep if last word isn't an abbrev. +,~DOC~ ^R Abbrev Expand And Call Old Char +^R Expand last word, then run old char. +The "old" function run by the character after the expansion check may be + described by MM Old Word Abbrev Character Describe which will ask you to + type the character to describe. +Explicit ARG inhibits expanding. +*~DOC~ ^R Abbrev Expand And Self-InsertS Expand last word if an abbrev. +Giving an explicit numeric argument inhibits expansion, just inserting that + many copies of char that ran this. +'~DOC~ & WRDAB Mode or Global Expand6S Expand previous word if mode or global abbrev. +~DOC~ & Global Expand.S Expand previous word if global abbrev. +~DOC~ & ExpandS .1 is abbrev, .2 is ..Q offset +A pre-comma ARG inhibits auto-filling. (Since ^^M, e.g. is called by + some to insert CRLF but not auto-fill.) + +~DOC~ ^R Unexpand Last WordL^R Undo last expansion, leaving the abbrev. +If there was a prefix that was glued onto the expansion, it will be separated + from the abbrev by a hyphen. +The abbrev's usage-count is decremented. +~DOC~ Word Abbrev Mode~DOC~ WORDABRC Mode for expanding word-abbrevs. +No arg or non-zero arg sets the mode, Word Abbrev Mode. +0 arg clears the mode. +Runs Word Abbrev Hook if any, with arg of new mode setting. If none, + the following keys are set: + ^X ^A runs ^R Add Mode Word Abbrev, + ^X ^H runs ^R Inverse Add Mode Word Abbrev, + ^X + runs ^R Add Global Word Abbrev, + ^X - runs ^R Inverse Add Global Word Abbrev, + M-' runs ^R Word Abbrev Prefix Mark, + C-M-Space runs ^R Abbrev Expand Only, and + ^XU runs ^R Unexpand Last Word. +Giving this command 1 as a pre-comma argument means that you only use global + abbrevs, and things are set up to be faster (e.g. faster expansion + checking since it doesn't have to check both global and local abbrevs). +Each of the following chars: + ~@#;$%^&*()-_=+[]\|:'`"{},<.>/?!, Space, Return, +will run ^R Abbrev Expand And Self-Insert, or ^R Abbrev Expand And Call Old + Char. +Tab runs ^R Abbrev Expand for Tab. +~DOC~ Define Word Abbrevs(C Define word abbrevs from buffer. +~DOC~ List Word Abbrevs*C List abbrevs and their expansions. +~DOC~ Insert Word AbbrevsC Insert abbrevs defined and their expansions. +Format is acceptable to MM Define Word Abbrevs. +In particular, any double-quotes (the '"' character) in an expansion will be + quoted with another double-quote. E.g. HE SAID "HELLO" becomes HE SAID + ""HELLO"". +~DOC~ Make Word AbbrevfC Make first string argument expand to second one. +After doing MM Make Word Abbrevfoofind outer otter, typing "foo" will + automatically expand to "find outer otter". +3rd string argument, if any, is the mode for the abbrev. +No 3rd string argument means use the current mode. +3rd string argument = "*" means this make a global abbrev. +This command defines just one abbrev, as compared to Define Word + Abbrevs which defines several abbrevs from a list in the buffer. +&~DOC~ & Check And Make Word Abbrev +S ARG1 abbrev, ARG2 expn, string arg mode. +String argument is "*" or space-modename, e.g. " TECO". +Checks for break characters in abbrev (not allowed). +,~DOC~ Write Incremental Word Abbrev File5C Write file of changed abbrevs. +Writes to file given by string argument. +(This does not reset the default filename for Write Word Abbrev File and + Read Word Abbrev File. I'm not sure of the correctness of this, though.) +Defaults to home directory, INCABS >. +See Read Incremental Word Abbrev File. ++~DOC~ Read Incremental Word Abbrev FilefC Load some abbrevs that changed. +String argument is filename that contains incremental abbrev definitions, + e.g. written by Write Incremental Word Abbrev File. + Default is home directory, INCABS >. +(This does not reset the default filename for Write Word Abbrev File and + Read Word Abbrev File. I'm not sure of this, but it seems correct.) +~DOC~ & Teco Quote String9S Takes string as NUMARG, returns with ^]^]s, ^]s. +~DOC~ & Teco Quote Area-S Quote altmodes and ^]s in ARG1,point. +)~DOC~ ^R Inverse Add Mode Word AbbrevZ^R Define expansion for word before point. +Numeric argument n means nth word before point is to be an abbrev (e.g. + you thought it already was, and you are now n words beyond). + No numeric argument means the word just before point, same as argument + of 1. +Reads a one-line expansion for the abbrev, defines it, and expands it. ++~DOC~ ^R Inverse Add Global Word Abbrev]^R Define expansion for word before point. +Numeric argument n means nth word before point is to be an abbrev (e.g. + you thought it already was, and you are now n words beyond). + No numeric argument means the word just before point, same as argument + of 1. +Calls & Read Line to get the expansion for that abbrev. (No multi-line.) +Defines that abbrev, and then expands the abbrev before point. +Aborts if & Read Line is aborted, or if the expansion is null. +!~DOC~ ^R Add Mode Word Abbrev@^R Reads mode abbrev for words before point. +Negative ARG means to delete the word abbrev. (If there is no such mode + abbrev, but there is a global, it asks if it should kill the global.) +Positive ARG (>0) means expansion is last ARG words. +Zero ARG means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +The abbrev is only effective when in the current mode (e.g. LISP). +#~DOC~ ^R Add Global Word Abbrevl^R Reads global abbrev for words before point. +Negative ARG means to delete the word abbrev, + calls ^R Kill Global Word Abbrev. +Positive ARG (>0) means expansion is last ARG words. +Zero ARG means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +The abbrev is effective in all major modes. +~DOC~ & Add Word AbbrevMS Reads an abbrev for words before point. +Stringarg1 is "*" for global abbrev, and space-modename for a mode abbrev, + e.g. " TECO". +Stringarg2 is & Read Line prompt. +Calls & Read Line to read the abbrev. +ARG non-0 means expansion is last ARG words. (Includes breaks in between + words, but not those before first or after last word.) +ARG 0 means expansion is between point and MARK. +If FS ^R Mark set, then for any ARG expansion between . and FS ^RMark. +If the abbrev is already defined, user is asked if redefinition wanted. +The abbrev must not contain any break characters. +Abbrev variable is constructed: X abbreviation Abbrev. It + contains a string which is the expansion. +~DOC~ & Shorten StringPS Produce a short string, showing beginning/end. +ARG is a string pointer. +$~DOC~ ^R Word Abbrev Prefix Mark!^R Mark point as end of a prefix. +Expansion of the prefix may occur unless an ARG is given. +Sets Word Abbrev Prefix Mark to point and inserts a hyphen. +$~DOC~ & WRDAB Set Mode Line Hook2S Tell & Set Mode Line if display " Abbrev". +"~DOC~ ^R Kill Mode Word Abbrevg^R Causes mode abbrev typed to be expunged. +Same as ^R Add Mode Word Abbrev with a negative ARG. +$~DOC~ ^R Kill Global Word Abbrevk^R Causes global abbrev typed to be expunged. +Same as ^R Add Global Word Abbrev with a negative ARG. + +~DOC~ Kill All Word Abbrevs/C No word abbrevs are defined after this. +~DOC~ Edit Word Abbrevs9C Go into ^R mode, editing word abbrev definitions. +Note that any '"'s are doubled so that the syntax is unambiguous. E.g. + if the abbrev 'xsay' is to expand to 'He said "Hello"', then it will be: + xsay: 1 "He said ""Hello""" +^R mode is entered. When exited normally, (e.g. by ^C^C) the buffer will + be considered as new definitions of word abbrevs. +^G will abort MM Edit Word Abbrevs, leaving word abbrevs untouched. +~DOC~ Sort Word AbbrevsxC Sort a word abbrev list in the buffer by count. +The most-frequently used abbrevs appear at the top of the list. +~DOC~ & WRDAB Off PO CheckS Check list of chars for expanders, fix. +q.1: List of characters. +q.6: ^R Macro to check against. +q.7: Subroutine to call if char runs .6. +~DOC~ & WRDAB On PO Check$S Check list of expand characters for changes and fix. +q.1: List of characters. +q.6: ^R Macro to check against. +q.7: Subroutine to call if change. +&~DOC~ & WRDAB Process Options Hook9S Check for characters to change. +Calls a subroutine to see-if/do any expand characters need updating. +Is a little slow for someone who makes Word Abbrev Mode local. Could fix. +"~DOC~ & WRDAB Turn On Ins CharlS Make a ^R Abbrev Expand And Self-Insert key. +ARG: 9-bit of key to use. +If is FS^RInit, then becomes expand-ins. +Otherwise becomes a call-old expander, and character is moved from WORDAB + Ins Chars to WORDAB Old Chars. +"~DOC~ & WRDAB Turn On Old CharQS Make a ^R Abbrev Expand And Call Old Char key. +ARG: 9-bit of key to use. +#~DOC~ & WRDAB Turn Off Ins Char"S Reset char ARG to builtin. +#~DOC~ & WRDAB Turn Off Old Char*S Reset char ARG to what was before. +"~DOC~ ^R Abbrev Expand for Tab ^R Expands abbrevs when Tab inserts at point. +If Tab will not insert any whitespace at point, no expansion is attempted. + (E.g. the Tab is reindenting the line, but point is mid-line.) +Old Tab is in MM # WRDAB Old 11. +Explicit ARG inhibits expanding. +~DOC~ & Global or LocalES Return Q.L if argument is a local q-register. Q.V otherwise. + +~DOC~ Read Word Abbrev FileC Define word abbrevs from a file of definitions. +Stringarg is word abbrev definition file. Default is ;WORDAB DEFNS. + ~DOC~ Write Word Abbrev FileZC Write a definition file for all defined abbrevs. +Stringarg filename. Default is WORDAB DEFNS. +Argument present means do not write out usage counts. +Default filenames come from last definition filename used. +~DOC~ Word Abbrev AproposC List abbrevs or expansions containing stringarg. +String argument is some pattern to find, either in abbrev, modename, or + expansion. It is a standard Teco search string; e.g. you can do: + MM Word Abbrev Apropos$foo^Obar$ which will match foo OR bar. +Currently this command only works "approximately" -- it may miss definitions + that have changed via Edit Word Abbrevs, or were only defined by Define + Word Abbrevs. It will however catch all definitions read in from a file + or defined one by one by the user. +&~DOC~ & Make Usage Abbrev VariableXS Like .V and .C combined, for speed. +STRARG1 is abbrev variable name. +STRARG2 is abbrev expansion with altmodes, ^]s quoted with ^]s. +STRARG3 is usage-count string. +Assumes ..Q is selected as buffer (..O). +*~DOC~ & Make Non-Usage Abbrev VariableyS Like .V and .C combined, for speed. +STRARG1 is abbrev variable name string. +STRARG2 is abbrev expansion string. +~DIRECTORY~ & Setup WORDAB Library +Old Word Abbrev Character Describe +^R Abbrev Expand Only +^R Abbrev Expand And Call Old Char +^R Abbrev Expand And Self-Insert +& WRDAB Mode or Global Expand +& Global Expand +& Expand +^R Unexpand Last Word +Word Abbrev Mode +WORDAB +Define Word Abbrevs +List Word Abbrevs +Insert Word Abbrevs +Make Word Abbrev +& Check And Make Word Abbrev +Write Incremental Word Abbrev File +Read Incremental Word Abbrev File +& Teco Quote String +& Teco Quote Area +^R Inverse Add Mode Word Abbrev +^R Inverse Add Global Word Abbrev +^R Add Mode Word Abbrev +^R Add Global Word Abbrev +& Add Word Abbrev +& Shorten String +^R Word Abbrev Prefix Mark +& WRDAB Set Mode Line Hook +^R Kill Mode Word Abbrev +^R Kill Global Word Abbrev +Kill All Word Abbrevs +Edit Word Abbrevs +Sort Word Abbrevs +& WRDAB Off PO Check +& WRDAB On PO Check +& WRDAB Process Options Hook +& WRDAB Turn On Ins Char +& WRDAB Turn On Old Char +& WRDAB Turn Off Ins Char +& WRDAB Turn Off Old Char +^R Abbrev Expand for Tab +& Global or Local +Read Word Abbrev File +Write Word Abbrev File +Word Abbrev Apropos +& Make Usage Abbrev Variable +& Make Non-Usage Abbrev Variable + ~INVERT~[1 Q1 diff --git a/src/e142/xworda._ej b/src/e142/xworda._ej new file mode 100644 index 00000000..ecdc0bc9 Binary files /dev/null and b/src/e142/xworda._ej differ