; -*-MIDAS-*- .SYMTAB 9001.,8000. 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) ;;; MIT Michael Travers (MTravers@BBND) ;;; 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 MIT 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. 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 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 7, JRST 1MBRK ;^D - ^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 ITS,[ 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 ];ITS 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