diff --git a/README.md b/README.md index 2fa4731a..dd9d1be1 100644 --- a/README.md +++ b/README.md @@ -65,6 +65,7 @@ There's a [DDT cheat sheet](doc/DDT.md) for Unix users. 5. Remaining programs are rebuilt: + - @, cross reference generation tool - ARCDEV, transparent file system access to archive files. - ARCSAL, archive salvager. - ARGUS, alerts you when specified users login or logout. diff --git a/build/build.tcl b/build/build.tcl index 09d06781..5dfe0e5b 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -767,6 +767,11 @@ respond "*" ":midas sys1;ts bye_sysen1;bye\r" expect ":KILL" respond "*" ":link device;chaos bye,sys1;ts bye\r" +# @ +respond "*" ":midas sys;ts @_sysen1;@\r" +respond "Use what filename instead?" "sysen2;\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" diff --git a/src/sysen1/@.695 b/src/sysen1/@.695 new file mode 100644 index 00000000..858b1d82 --- /dev/null +++ b/src/sysen1/@.695 @@ -0,0 +1,16502 @@ +; -*-MIDAS-*- + +.SYMTAB 8001.,2000. + +ITSFLG==:1 ;POSSIBLE VALUES OF "SITE". MUST PRECEDE +CMU10FLG==:2 ;"TITLE" SO THAT USER CAN DEFINE "SITE" +SAIFLG==:4 ;EXPLICITLY USING (T) SWITCH. +T10FLG==:10 ;TOPS-10 +10XFLG==:20 ; TENEX, sort of +CMU20FLG==:40 ;THIS PROBABLY WORKS -- JMN +T20FLG==:100 ;TOPS-20, SORT OF + +TITLE ATSIGN + +SUBTTL AC'S, SITE INFO, AND VERSION + +IFNDEF VERSION,[ + VERSION==.FVERS + IFE VERSION-662.,SUBVER==1 ;SET SUBVERSION IF WE EDITED AWAY FROM MIT + IFL VERSION,[ ; if .FNAM2 not numeric + PRINTX "What is @'s version number? " + .TTYMAC VRS + VERSION==VRS + TERMIN + ];IFL VERSION +];IFNDEF VERSION +IFNDEF SUBVER,SUBVER==0 + +IF2,[; This exists for compiling @ with CCL-type MIDAS + NOITS,[ + NOCMU,[ + PRINTX/... is halfway +/ + ];NOCMU + ];NOITS +];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 + +;;; This was added to help track down a phase error + +basedot=. +define outdot X,Y + printx /Y: .=X +/ +termin +define here X + outdot \.-basedot,X +termin + + +SUBTTL BUREAUCRACY: WHO DID WHAT TO @ WHEN + +;;; ***** PEOPLE WHO HAVE HACKED THE PROGRAM ***** +;;; GLS Guy L. Steele Jr. (GLS@MIT-MC) +;;; RMS Richard M. Stallman (RMS@MIT-AI) +;;; RHG/RG02 Richard H. Gumpertz (Gumpertz@CMU-10A) +;;; MRC Mark Crispin (MRC@SU-AI) +;;; MOON David A. Moon (MOON@MIT-MC) +;;; EAK Earl A. Killian (EAK@MIT-MC) +;;; MT Michael Travers (MT@MIT-XX) +;;; JMN Joseph M. Newcomer (Newcomer@CMU-10A) +;;; KLH Ken Harrenstien (KLH@MIT-AI/SRI-NIC) + +;;; THE AUTHORITATIVE SOURCE FOR @ IS [MIT-AI]SYSEN1;@ > + +;; 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 BOTS +;;; " " Added "extended LOOKUP" code under BOTS +;;; " " Added creation date printing to PTLAB for BOTS +;;; 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 BOTS copyrights +;;; " " Added SITNAM stuff +;;; " " Fixed /nS printout on title page +;;; " " Fixed bug causing last page to always be printed under BOTS +;;; 26 Apr 76 MRC Fixed PPN printout lossage under BOTS +;;; 15 Jun 76 Moon Added /L[UCONS] +;;; 05 Sep 76 MRC Fixed assembly error in BOTS +;;; 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 BOTS 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 BOTS +;;; " " Made BOTS 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 BOTS 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. +;;; Also fixed DEVICE defaulting after parsing NONE: in +;;; FPDEF to assume DSK unless explicitly set to NONE: again +;;; " " Fixed 1LOOP/1DONE1 to avoid a page table for skipped files +;;; 19 Oct 78 RHG Renamed 1INSRO to 1INSOP to avoid potential confusion with 1INSR0 +;;; 20 Oct 78 RHG Changed 2OCLSQ to type the number of pages in a file. +;;; 22 Nov 78 MT Added .DEFMAC and .RDEFMAC hacks for assembly langs. +;;; 6 Feb 79 JLK Changes to Gould spooler commands. +;;; 18 Feb 79 RMS Made ITS version get /L from -*-language-*- +;;; Made ITS left margin 128 again. +;;; No tab before subtitles in /# mode. +;;; 13 May 79 MT Let XGP header-page stuff be included for ITSXGP, NOITS sites. +;;; 16 May 79 MT Treat tab as space in FAIL. +;;; 8 Jul 79 RHG Changed 1RSUBT to recall CKLNM when LF is encountered. +;;; 5 Sep 79 RHG Changed TTIL to ignore naked LFs. +;;; Added TEXTP and positive FAILP settings +;;; Added /> and /= switches +;;; 7 Sep 79 " Added /M[,,,] to +;;; set the margins (where arguments are in mils). +;;; Note that at CMU the and are +;;; effectively ignored because we do no FONT hackery. +;;; Also added 000XCR as combo for 000X and CRLOUT. +;;; 8 Sep 79 " Fixed SUBOUT to not truncate the longest SUBTITLE. +;;; Note that SUBLEN is now unused and maybe should not be computed. +;;; Added some more NONE: hacking to FPDEF and FPSFND. +;;; Also, got a bit ANAL and lined up many comments. +;;; 9 Sep 79 " Changed WLRWX to suppress LR.CPY subentry if FLQPYM off. +;;; 10 Sep 79 " Changed default margins for CMU and fixed a few typos. +;;; 4 Oct 79 " Moved up the FMT=1 in CMU style .XGO files +;;; Also fixed a typo that caused /Y to turn on magically. +;;; 5 Oct 79 " Changed TAB in PALX11 to act like SPACE, for FOO: etc. +;;; 18 Oct 79 MT Added ITSOUT to print ITS filenames on non-ITS systems +;;; Make .DEFMAC work under MIDAS, FAIL, and DAPX modes. +;;; 19 Oct 79 RHG Upped NFILES at CMU to 200. +;;; 22 Oct 79 EAK Changed assembly conditionals, flags, etc. VERSION +;;; now determined by .FVERS, SITE by .OSMIDAS. .DECSAV +;;; is used instead of .DECREL. .DECTWO still used on +;;; two-seg systems. +;;; 18 Nov 79 RHG Changed RLRRX to check EMARGIN before clobbering the margins. +;;; Changed CAIN CH,^J to CAIE CH,^J in 2TEXGP on the suspicion +;;; that the former was a typo. Forgive me if I erred. +;;; Changed TABHED to use FNAMCW instead of 24. +;;; Fixed FPSMNP to use H instead of A as the JSP register when calling FPSNUM +;;; Added DEVICE, etc. as a replacement for FLXGP and QUEUE, but +;;; haven't made them do anything yet. The intention is to +;;; add DOVER PRESS file output. For now, however, +;;; device DOVER will look much like device LPT. +;;; Temporarily, /0X will indicate DOVER output, but this is VERY TEMPORARY. +;;; 20 Nov 79 " Added SUBVER hacking +;;; Changed ITSOUT to FNTOUT and made it OK for SAIL which +;;; has ITS-like XGP code. +;;; Deleted some unreferenced labels. +;;; 10 Dec 79 " Got rid of /0X kludge and added /D[device]. +;;; Split DEVDOV into DEVPDO, DEVLDO, and DEVTDO. +;;; Added /" to hack per-page headings +;;; Fixed SLTBL to put entry for "/" in the right place. +;;; Fixed SLALT to clear FRLTAB +;;; Fixed FPSNUM so it could be called more than once for the same number. +;;; Added 2PUTIT to 2PATCH and 2PUTCH for DOVER hacking +;;; Changed FNTEXP to hold KSTID for new CMU style fonts. +;;; Made /F[...] work at CMU. +;;; 11 Dec 79 " Made 1LOOP look at NORENUM in addition to FSLRNM. +;;; 12 Dec 79 " Changed default PAGEL and LINEL for Dover to conform +;;; to 1cm margins instead of 1/2". +;;; 3 JAN 80 RMS PRESS file output. +;;; LNLDOT and PGLDOT are now per-device tables. +;;; QU.GLD is flushed. QUEUE now says either yes or no. +;;; DEVGLP is flushed -- only one device code is needed for the Gould. +;;; TEXGPP is set for /L[TEXT]/X mode. +;;; /X now means "treat as graphics device, and default to XGP". +;;; It takes no other args. Queueing is turned off by /-D. +;;; Totally rearranged pass 2. +;;; Output page formatting and syntactic processing +;;; are now coroutines. +;;; 17 JAN 80 RMS Month and day names abbreviated to fit in field on dover. +;;; 2PUTIT flushed. 2TAB exists for outputting a tab in tables. +;;; SWPRIN now doesn't output some switches when they are +;;; on by default. +;;; 19 Jan 80 RHG Got rid of duplicate definition of PTQDAT under BOTS. +;;; Defined .BAI, .BAO, .BII, .BIO appropriately for BOTS. +;;; Added PRESS, NOPRESS, XGPRES, NOXGPRES macroes. +;;; Got rid of some undefined symbols in NOPRESS mode. +;;; Made all calls on 2INOPN and 2OUTOP use .Bxx to specify mode. +;;; " " Turned on PRESS mode at CMU +;;; 20 Jan 80 " Replaced .OUTPT with OUTWDS and merged in some fixes from RMS. +;;; 21 Jan 80 " Merged calls on 2OUTFNT and PRSINI into a single dispatch table. +;;; Started getting rid of assembly-time testing of +;;; DEVIXGP vs DEVCXGP in favor of run-time tests. +;;; XGPP is used to do this magic. +;;; Fixed a bug in SLLF3 -- it wasn't incrementing CC. +;;; Made things call SPCOUT and other small optimizations. +;;; 22 Jan 80 RMS Allowed spaces at places in press font names. +;;; Width always obtained from FONTS WIDTHS even if font is defaulted. +;;; Made SYN in Macro and Fail take args in right order (old, new). +;;; Made "sym ;" in Fail cref properly. +;;; Made /M[...] switch actually do something. +;;; 22 Jan 80 RHG Changed FWIDTH to use 16-bit bytes. +;;; Allowed spaces in more places in DOVER font names. +;;; Moved FWIDFL to impure so FLOSE can fix it on error. +;;; Got rid of setting NFNTS=2 at CMU -- that is handled in FNTSWT now. +;;; Delayed calling SYMINI until after FNTCPT so that +;;; FWIDTH (which is called by FNTCPT) can still grow LRCPTR. +;;; " " Fixed /M[...] again -- the IBP had no argument! +;;; " " Changed PRESSP to be >0 for LANDSCAPE and TWOUP. +;;; Although now probably not necessary, added code to obey NFNTS. +;;; " " Changed FWIDTH to check the ROTATION. +;;; 23 Jan 80 " Changed BEGUND to work even if PRESSX is zero. +;;; Changed PRESS COVER SHEET to give out-file name, not in-file +;;; Got rid of some bogus I's (as in IDIVI and MOVEI) which +;;; were screwing up margins and tabs slightly. +;;; Changed all default margins to 1/2". If any of +;;; the funny old values were fudged due to screwed up +;;; devices, then that fudging really belongs in the +;;; device-dependent output code, not the margin values. +;;; " " Changed FWIDTH to not add the baseline to the HEIGHT. +;;; It is already included! Changed VSP interpretation +;;; for PRESS files to compensate, roughly, for +;;; different dot size from XGP: kludge = multiply by 13! +;;; Changed default margins at CMU to get /120w in SAIL 8. +;;; Changed default PRESS font to SAIL 8 at CMU. +;;; Made BOTS 2OUTOP remember the PPN of the output file. +;;; Added CRLOU0 calls to keep PRSTA2 from getting confused. +;;; Switched PRSTAB to using fancy tabbing. +;;; Upped ENTCNT to allow for more ENTITY commands that produces. +;;; Changed FNTCPT to work for DOVER font names less than 13 characters long. +;;; 24 Jan 80 RMS Made /D[Dover] not queue for XGP printing. +;;; Flushed default linel and pagel for Dover - always computed afresh. +;;; Flushed RANDF. Flushed /?. Made /: make a file auxiliary. +;;; 24 Jan 80 RHG Changed DFLMAR to 1 inch to allow for hole punching. +;;; Deleted DOVER TWOUP -- no reasonable way to pair +;;; the pages when running in comparison mode. +;;; Reassigned DEVLDO since no one should have used it yet anyway. +;;; Added code for DEVLDO. +;;; Changed PRSPIN to account for FNTBAS when initializing PRESSY. +;;; Rechanged FNTCPT check of font names. +;;; Made SYMINI truncate LRCLEN if too long, except on ITS +;;; Added ENTDLN and DIRDLN. +;;; Made DLRPS print decimal too. +;;; where I am not sure exactly what to do. +;;; 25 Jan 80 " Made PRSDIR use F.RDEV on cover sheet if appropriate. +;;; Changed date printing format to not use abbreviations. +;;; Got rid of the CMU tiny margin hack for /120W +;;; Added SP000X, equivalent to SPCOUT and then 000X. +;;; Similarly SL000X, except it prints a "/". +;;; Similarly CM000X, except it prints a ",". +;;; Similarly CH000X, except it prints an arbitrary character. +;;; Changed PRESS cover sheets to not include seconds under BOTS. +;;; Made 2LOOP work right when /> is on. +;;; Made FNTCPT recompute PAGEL and LINEL if DEVICE changes +;;; 26 Jan 80 RHG Made SAILA 8 the default at CMU instead of SAIL 8. +;;; SAILA 8 has ASCII placement of characters. +;;; Changed PMSTIM to update CC even if not printing seconds. +;;; 28 Jan 80 " Yet another change to 2LOOP to get /1> to work. +;;; 28 JAN 80 RMS Changing devices sets linel and pagel overriding lrec file. +;;; Flushed nonworking hack to make Dover cover sheets use GACHA12. +;;; Fixed FNTCPT to check SNM and FN1 of font files for nonzero. +;;; Cover sheet can't use input file name if there isn't one (@CREF files). +;;; Reabbreviated day and month names for ITS version. +;;; 31 Jan 80 RMS Fixed premature truncation of qpyrt msg. +;;; 6 Feb 80 MT Fixed up Press file support for DEC version +;;; Fixed bug in FILOUT where CC wasn't getting incremented +;;; 10 Feb 80 RMS Made ;;;;, if next char is not ;, start a subtitle in Lisp mode. +;;; Made subtitles ended by a ^L not cause lossage. +;;; Made a single ^L just before EOF not count as a blank page. +;;; Output the bottom margin for ITS XGP files. +;;; 5 Mar 80 RMS Made very narrow Dover fonts win (more than 256 printing chars +;;; in a row may be output) +;;; Put in a warning for use of a variable width Dover font, +;;; but patched it out because LPT8 is variable width! +;;; 10 Mar 80 RMS Fixed excess push when scanning a non-listed file on p2 for cref data. +;;; 26 Mar 80 RMS Fixed PDL screwup at SLBS for press files. +;;; 29 May 80 RHG Changed FWIDTH to only use a scaleable font +;;; entry if there is no exact match for size. +;;; Changed /M[...] to have a fifth margin -- the +;;; "hole" margin as in the CMU PDP-10 "DOVER" program. +;;; It is added to either the LEFT or TOP margin +;;; as appropriate. +;;; Added DFMARG and made it 1cm (instead of 0.5") at CMU. +;;; Fixed DLRDUN to properly update C after finding D non-zero. +;;; Made PRESS files always have FN2 PRESS (not PRT). +;;; Deleted some unreferenced labels. +;;; 13-Jul-80 JMN Added device ANADEX +;;; Also, modified conditionals so that TNXFLG and +;;; CMUFLG are now independent variables, not +;;; mutually exclusive variables. Producing a version +;;; which will run, except for a small number of +;;; JSYS calls, under the compatibility package. +;;; BOTS/NOBOTS are now conditioned on TNXFLG, if +;;; TNXFLG is 0, BOTS can be true, if TNXFLG is 1, +;;; BOTS is false (NOBOTS true) +;;; Note that NOBOTS is *NOT* equivalent to ITS +;;; 13 Jul 80 RHG Fixed 1SUBT0 to skip spaces, not everything else. +;;; Also fixed 1RSUBT to not double the first character of the line. +;;; 13 Jul 80 RHG/JMN Switching to device LPT or ANADEX from a raster +;;; device now sets the correct margin values base +;;; on the default values +;;; 13-Jul-80 JMN Never output tabs to a device which does not +;;; support them (routine 2TAB/2TAB2) +;;; 14-Jul-80 JMN Device ANADEX now outputs XON code for +;;; each page +;;; 19-Jul-80 JMN EXTENSIVE rehacking of all BOTS/NOITS conditionals +;;; It looked like NOITS=BOTS, and NOBOTS=ITS. This is +;;; NO LONGER TRUE!!! +;;; CMU20/NOCMU20 conditionals represent another point +;;; in the set of conditionals. With a little hacking, +;;; CMU20 might turn into the TNX/NOTNX conditional +;;; Current status is that CMU20 compiles semi-JSYS code +;;; and will accept and print out tops-20 directory names. +;;; -NO- changes in the format of LRC files has been made +;;; to accomodate longer names; current 6/3 format is +;;; retained. Some enJSYSing of the code, but mostly this +;;; runs using PA1050 to fake it. It looks like it would +;;; be easy to do, but I haven't time for at least a month. +;;; Until this code is certified for ITS, ITS users should +;;; probably consider the reorganization of the conditionals +;;; as representing undebugged code. +;;; 7 Aug 80 RMS Renamed old DOS conditional to BOTS, +;;; created another named DOS which includes CMU20FLG +;;; whereas BOTS excludes it. Merged duplicate +;;; BOTS and CMU20FLG conditionals into single DOS ones. +;;; 7 Aug 80 RMS Fixed bug in 1MIDAS processing '"' at end of line. +;;; 23 Oct 80 MRC Fixed SAIFLG, added T20FLG, renamed DECFLG to T10FLG. +;;; Fixed lots of bugs in the TOPS-20 code while I was +;;; at it! +;;; 12 Feb 81 RMS Made PRSCHS preserve CH. +;;; 19 Feb 81 RMS Fixed bug finding subtitles when files are printed in +;;; sorted order. +;;; 8 Aug 81 KLH Pushed ATSIGN over the hump to full TNX-ization. +;;; 10X stands for Tenex, T20 for Tops-20; TNX means +;;; both. Added lots of TNX stuff all over, cleaned up +;;; a few sections, made PLINEL variable. +;;; Even though PA1050 is no longer needed, filenames +;;; are still truncated to 6.3. Eventually the TNX +;;; routines from MIDAS could be included for full +;;; capability. +;;; 20 Nov 81 JMN Fixed up kludge about host name (looking at serial +;;; number) to use network jsys code to get network +;;; site. Thanks to Aaron Wohl for the jsys magic. +;;; Also fixed one-word machine name lossage for TOPS-20 +;;; Device Anadex no longer outputs XON code (Anadex +;;; changed their software!) +;;; Site=CMU20FLG is broken, because of a whole lot of +;;; invalid assumptions people have made while patching +;;; in switch changes. E.g., CMU20 => T20, but conditionals +;;; seem to include multiple instances of code (TNX style) +;;; which I haven't the patience to debug. The result is +;;; that I just set Anadex device code to always compile +;;; unless somebody sets the Anadex switch explicitly off. +;;; CMUC version is just compiled as a TOPS-20 version now. +;;; 7-Dec-81 JMN Modified /Q switch such that /0Q is the same as /Q, +;;; /1Q causes the copyright notice to be underlined +;;; Noted that the last line of the file is not +;;; terminated with a CRLF. I originally thought this +;;; was true only for the copyright line, but +;;; it appears that it is true even if copyright is +;;; not printed. Therefore made printng a terminal CRLF +;;; conditioned on the Anadex device switch, which is +;;; the device which becomes confused if the last line +;;; isn't properly concluded +;;; Note that TNX versions don't write OLR files because +;;; Twenex version numbers provide this capability (I +;;; thought I'd broken something!) +;;; 16-Jan-81 KLH Added /D[Canon] as an ersatz XGP which accepts +;;; ITS XGP format files, but has different resolution. +;;; Fixed bug at FPSFN3, the minus-flag in B wasn't +;;; being saved during font filename parsing. +;;; Noticed a 10X monitor bug: GTJFN of a FN1 all by itself +;;; will cause "No such version" error on 10X, even tho +;;; the GJ%OFG bit is set!!! Not sure if buggy on T20 too. +;;; Apparently only sure way to win is to parse the string +;;; completely like MIDAS does, rather than trying to +;;; get GTJFN to do the work. +;;; Fixed FPDFN3 to only zap last 3 chars of file extension +;;; if on DOS system, rather than NOITS. +;;; Fixed MCRFN4 to account for overlarge page #'s (was +;;; running CREF lines off the right margin). In general, +;;; any text of more than 10,000 lines per page is going +;;; to lose grossly... in case anyone didn't know this. +;;; (the doc doesn't mention this sort of thing) +;;; 1-Mar-82 JMN Added device Florida (Florida Data Systems OSP-130) +;;; 10-Mar-82 JMN Replaced GJ%OLD in 2OUTOP with GJ%FOU. Got error if +;;; output file didn't exist (bogus!) +;;; In UnJFN, never suppress device in JFNS because system +;;; default is /connected/ device, not PS: +;;; Fixed bug in TF6TOB, if DIRST fails, AC1 is destroyed +;;; 29-Jun-82 KLH Took out the ADD C,FNTBAS at FNTCPP-3 (calculating +;;; default # lines on page) because it seems to be +;;; completely wrong-headed; it was screwing up +;;; our Canon spooler (which is diligent about going to +;;; next page if a line runs over BOTMAR). If someone +;;; can explain why it works for XGP, and prove it isn't +;;; an XGP bug, please do so. +;;; FINALLY!!!!! Replaced losing TNX GTJFN filename parser +;;; with by-hand parser from MIDAS source. Incomplete +;;; filenames now default sensibly, tho still have sixbit +;;; restrictions on FN1 and EXT. +;;; 25-Sep-82 KLH Increased DIRDLN to 4000 (so can list ITS) + +SUBTTL SYSTEM-DEPENDENT DEFINITIONS + +;;; ***** DETERMINE WHERE WE ARE ***** + +IFNDEF SITE,[ + IFE .OSMIDAS-SIXBIT/ITS/, SITE==:ITSFLG + IFE .OSMIDAS-SIXBIT/DEC/, SITE==:T10FLG + IFE .OSMIDAS-SIXBIT/CMU/, SITE==:CMU10FLG + IFE .OSMIDAS-SIXBIT/SAIL/, SITE==:SAIFLG + IFE .OSMIDAS-SIXBIT/TENEX/, SITE==:10XFLG + IFE .OSMIDAS-SIXBIT/TWENEX/, SITE==:T20FLG +];IFNDEF SITE + +IFNDEF SITE,[ + PRINTX /Site = ITS, SAI, CMU10, CMU20, T10, T20, or 10X? / + .TTYMAC X + SITE==:X!FLG + TERMIN +];IFNDEF SITE +IFNDEF SITE, .FATAL SITE NOT SPECIFIED. + +IFNDEF SITNAM,[ + IFE SITE-ITSFLG,SITNAM==:SIXBIT/ITS/ + IFE SITE-CMU10FLG,SITNAM==:SIXBIT/CMU/ + IFE SITE-CMU20FLG,SITNAM==:SIXBIT/CMU/ + IFE SITE-SAIFLG,SITNAM==:SIXBIT/SAIL/ + IFE SITE-T10FLG,SITNAM==:SIXBIT/TOPS10/ + IFE SITE-10XFLG,SITNAM==:SIXBIT/TENEX/ + IFE SITE-T20FLG,SITNAM==:SIXBIT/TOPS20/ +];IFNDEF SITNAM + +IFNDEF LISPSW,LISPSW==SITE#T10FLG ;>0 => HANDLE LISP AND UCONS CODE. +IFNDEF MUDLSW,MUDLSW==SITE&ITSFLG ;>0 => HANDLE MUDDLE CODE. + +IRPS X,,ITS:CMU10:CMU20:SAI:T10:10X:,Y,,NOITS:NOCMU10:NOCMU20:NOSAI:NOT10:NO10X: + DEFINE Y +IFN SITE-X!FLG!TERMIN + DEFINE X +IFE SITE-X!FLG!TERMIN +TERMIN + DEFINE T20 +IFN &SITE!TERMIN + DEFINE NOT20 +IFE &SITE!TERMIN + DEFINE TNX +IFN &SITE!TERMIN + DEFINE NOTNX +IFE &SITE!TERMIN + + DEFINE CMU +IFN &SITE!TERMIN + + DEFINE NOCMU +IFE &SITE!TERMIN + + DEFINE BOTS ;TOPS-10 LIKE OPERATING SYSTEM +IFN &SITE!TERMIN + DEFINE NOBOTS +IFE &SITE!TERMIN + + DEFINE DOS +IFN &SITE!TERMIN + DEFINE NODOS +IFE &SITE!TERMIN + +BOTS,[ IFNDEF OUTSTR,[ ; Get BOTS defs if needed + SAI,.INSRT SYS:SAIDFS + CMU,.INSRT SYS:CMUDFS + T10,.INSRT SYS:DECDFS + .DECDF + ];IFNDEF OPEN +];BOTS + +ITS,[ IFNDEF .OPEN,[.INSRT SYS:ITSDFS ; Get ITS defs if needed + .ITSDF + ];IFNDEF .OPEN +];ITS + +TNX,[ IFNDEF GTJFN,[.INSRT SYS:TNXDFS ; Get TNX defs if needed + .TNXDF + ];IFNDEF GTJFN +];TNX + + ; True site-dependent (as opposed to OS-dependent) stuff +IFE <.SITE 0>-,[ + XGPFMT==:ITSFLG ; ITS type XGP cmds, but require /D[C] + ; to select Canon. Later fix up? + FNTDSN==:144 ; directory on SRI-NIC +] ;SRI-NIC + +IFNDEF XGPFMT,[ ;WHAT SORT OF XGP COMMANDS DO WE WANT TO OUTPUT? + CMU,XGPFMT==:CMU10FLG ;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 +IFNDEF ANAFLG,[ ; Support Anadex 9500/9501? + ANAFLG==:1 ; yes + IFNDEF ANAFLG, ANAFLG==:0 +];IFNDEF ANAFLG + +IFNDEF FLAFLG,[ ; Support Florida Data Systems OSP/130 + FLAFLG==:1 ; yes + IFNDEF FLAFLG, FLAFLG==:0 +];IFNDEF FLAFLG + + ;NONZERO TO ALLOW PRESS FILE OUTPUT. +IFNDEF PRSFLG,PRSFLG==:SITE& + +IRPS X,,ITS,Y,,ITSXGP:,Z,,NOITSXGP: + DEFINE Y +IFE XGPFMT-X!FLG!TERMIN + DEFINE Z +IFN XGPFMT-X!FLG!TERMIN +TERMIN + DEFINE CMUXGP +IFN XGPFMT&!TERMIN + DEFINE NOCMUXGP +IFE XGPFMT&!TERMIN + + DEFINE XGP +IFN XGPFMT!TERMIN + DEFINE NOXGP +IFE XGPFMT!TERMIN + + DEFINE PRESS +IFN PRSFLG!TERMIN + DEFINE NOPRESS +IFE PRSFLG!TERMIN + + DEFINE ANADEX +IFN ANAFLG!TERMIN + + DEFINE NOANADEX +IFE ANAFLG!TERMIN + + DEFINE FLORIDA +IFN FLAFLG!TERMIN + DEFINE NOFLORIDA +IFE FLAFLG!TERMIN + + DEFINE XGPRES +IFN PRSFLG\XGPFMT!TERMIN + DEFINE NOXGPRES +IFE PRSFLG\XGPFMT!TERMIN + +XGP,[IFNDEF FNTDSN,[ ;WHAT IS DEFAULT DIRECTORY FOR FONT FILES? + IFE SITE-ITSFLG,FNTDSN=:SIXBIT/FONTS/ + IFE SITE-CMU10FLG,FNTDSN=:1343,,303360 ;A730KS00 + IFE SITE-CMU20FLG,[ + FNTDSN==:0 + ];IFE SITE-CMU20FLG + IFE SITE-SAIFLG,FNTDSN=:SIXBIT/XGPSYS/ + IFE SITE-T10FLG,[ + PRINTX /Default PPN for font files = / + .TTYMAC X + FNTDSN==:X + TERMIN + ];IFE SITE-T10FLG + IFE SITE-10XFLG,[ + PRINTX /Default directory number for font files = / + .TTYMAC X + FNTDSN==:X + TERMIN + ];IFE SITE-10XFLG + IFE SITE-T20FLG,[ + PRINTX /Default directory number for font files = / + .TTYMAC X + FNTDSN==:X + TERMIN + ];IFE SITE-T20FLG +];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 ***** + +NOBOTS, STRT=:1000,, ;ASCIZ STRING TYPEOUT +BOTS, STRT=:OUTSTR ;BOTS 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 ***** + +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. ***** + +CALL==: ; Handy +RET==: + +DEFINE DROPTHRUTO X +IF2, IFN .-X, .ERR THIS DROPTHRUTO SHOULD BE A JRST +TERMIN + +ITS,[ TYO=:.IOT TYOC, + TYI=:.IOT TYIC, +DEFINE OUTWDS REG+COUNT + .IOT UTOC,REG +TERMIN +DEFINE SYSCAL NAME,ARGS + .CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))] +TERMIN +];ITS + +TNX,[ +IF1, EXPUNGE .VALUE,.CLOSE,.DISMISS +IF1, EXPUNGE .BAI,.BAO,.BII,.BIO ; In case we are assembling on ITS + .BAI==<.BAO==<.BII==<.BIO==0>>> ; Currently useless +IF2, .VALUE=: +DEFINE .CLOSE ARG + CALL [ PUSH P,A + SKIPE A,JFNCHS+ARG + CLOSF + NOP + SKIPE A,JFNCHS+ARG + RLJFN + NOP + SETZM JFNCHS+ARG + POP P,A + RET] +TERMIN +DEFINE .DISMISS ARG +IF2, IFN .JBTPC-ARG, .ERR .DISMISS arg not .JBTPC, must fix code! + DEBRK +TERMIN + +DEFINE TYI (CHL) +IFE A-CHL,PBIN +.ELSE [ CALL [ PUSH P,A + PBIN + MOVEM A,CHL + POP P,A + RET]] +TERMIN + +DEFINE TYO (CHL) +;IFE A-CHL,PBOUT +IFN 0, ; Always fail for now, until fix stupid arg problem + ; ( see BUGCMP for explanation of lossage) +.ELSE [ CALL [ PUSH P,A + MOVE A,CHL + PBOUT + POP P,A + RET]] +TERMIN + +DEFINE OUTWDS REG 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 TWOSEG, .DECTWO +IFE TWOSEG,[ + ITS, .SBLK ? LOC 100 + NOITS,[ + NOSAI,.DECSAV ? LOC 140 + SAI,.DECREL + ];NOITS +];IFE TWOSEG +RL0:: ;RELOCATABLE 0 -- MUST BE DEFINED BEFORE ANY ASSEMBLED CODE + +ZZZ==. ? LOC 41 + JSR UUOH +ITS, JSR .JBCNI +DOS, LOC .JBAPR ? TSINT0 +LOC ZZZ ? EXPUNGE ZZZ + +UUOH: 0 ;UUO HANDLER +ITS,[ SKIPE DEBUG + .SUSET [.RJPC,,UUOJPC] +];ITS + 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 + 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). +];ITS +NODOS,[ +IF1 EXPUNGE .JBFF ;IN CASE ASSEMBLING ON DEC SYSTEM +.JBFF: .JBFF1 ; (BUT FOR USE ON ITS/TNX). +];NODOS + +TNX,[ +IF1 EXPUNGE .JBTPC +.JBTPC: 0 ; Saved PC for interrupts +10X, ERJCNT: 0 ; Count of times ERJMP/ERCAL simulated. +];TNX + +SUBTTL VARIABLES PERTAINING TO COMMAND SWITCHES + +DEVICE: DEVLPT ;TYPE OF PRINTING DEVICE FOR WHICH WE ARE PREPARING OUTPUT +DEV==:,-1 ;BIT TYPEOUT MASK +DEVLPT==:0 ;LINE PRINTER +DEVIXGP==:1 ;ITS XGP +DEVCXGP==:2 ;CMU XGP +ITSXGP,DEVXGP==:DEVIXGP +CMUXGP,DEVXGP==:DEVCXGP +DEVGLD==:3 ;GOULD LPT +DEVLDO==:4 ;Xerox Dover printer, landscape orientation +DEVPDO==:5 ;Xerox Dover printer, portrait orientation +DEVANA==:6 ; Anadex something +DEVCGP==:7 ; Canon LBP-10 hacking XGP-type input +DEVFLA==:10 ; Florida something +DEVMAX==:11 ;1 + + +XGPP: 0 ;0 => DEVICE DOESN'T CONTAIN XGP, -1 => DEVIXG, +1 => DEVCXG + ;-2 => DEVCGP (ersatz ITS XGP) + +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 ;NEGATIVE IFF CODTYP HOLDS CODFAI (FAIL CODE); POSITIVE IF CODM10 (MACRO-10 CODE). +PALX11: 0 ;NONZERO IFF CODTYP HOLDS CODP11 (PALX-11 CODE). +DAPXP: 0 ;NONZERO IFF CODTYP HOLDS CODDAP (DAPX16 CODE). +TEXTP: 0 ;NEGATIVE IFF CODTYP CONTAINS CODTXT; POSITIVE IFF CODRND +TEXGPP: 0 ;NONZERO FOR /L[TEXT] /D[XGP] + +LINEL: 0 ;OUTPUT LINE LENGTH +PAGEL: 0 ;OUTPUT PAGE LENGTH, AS SPECIFIED. +TLINEL: 0 ;LINEL-, I.E. TEXT LINEL +IPLINEL: 0 ; For page-num lines; TLINEL minus date and page-num (const) +PLINEL: 0 ; IPLINEL minus current filename length (variable) +PAGEL1: 0 ;OUTPUT PAGE LENGTH MINUS 2 LINES FOR QOPYRT MSG IF THERE IS ONE. + +TRUNCP: -1 ;POS => TRUNCATE OUTPUT LINES AT RIGHT MARGIN. + ;NEG => CONTINUE THEM. + ;0 => NEITHER (LET THEM RUN ON). + +CPYUND: 0 ;0 => do not underline copyright notice (regular) + ;POS => underline copyright notice +SINGLE: 0 ;NON-ZERO => ONLY ONE OUTPUT FILE (/S) +PRLSN: 0 ;NON-ZERO => PRINT DEC LSN'S AS PART OF TEXT (/K) +NORFNM: 0 ;NON-ZERO => DON'T RECORD REAL FILE NAME IN LREC FILE -- USE THAT SPEC'ED BY USER +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 FILE FOR PRINTING. +QU.YES==0 ;0 => QUEUE FOR PRINTING ON SPECIFIED PRINTING DEVICE. +QU.GLD==1 ;1 => QUEUE FOR GOULD LPT. OBSOLETE. CHANGED TO DEVICE/ DEVGLD AND QU.YES. +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. +HEDING: 0 ;NEGATIVE => NO HEADING; POSITIVE => LEAVE THAT MANY LINES WITH NO TEXT, JUST HEADING (/") +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. +FISORF: 0 ;NON-ZERO => SORT FILENAMES ON TITLE PAGE + ;POSITIVE => SORT THEM WHEN DOING PASS 2 AS WELL + +;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. +ETRUNCP: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) +ECODTYP:0 ;NONZERO => CODTYP WAS EXPLICITLY SPEC'D (/? OR /L) + ;AFTER RLREC, NONZERO IF EITHER EXPLICITLY SPEC'D OR SET BY RLREC. +EDEVICE:0 ;NONZERO => DEVICE WAS EXPLICITLY SPEC'D (/something) +EUNIVCT:0 ;NONZERO => UNIVCT WAS EXPLICITLY SPEC'D (/U) +ESINGLE:0 ;NONZERO => SINGLE WAS EXPLICITLY SPEC'S (/S) +EPRLSN: 0 ;NONZERO => PRLSN WAS EXPLICITLY SPEC'D (/K) +ENORFNM:0 ;NONZERO => NORFNM WAS EXPLICITLY SPEC'D (/=) +ECPYUND:0 ;NONZERO => CPYUND was explicitly specified (/Q) +ESYMLEN:0 ;NONZERO => SYMLEN WAS EXPLICITLY SPEC'D (/S) +EFNTVSP:0 ;NONZERO IF FNTVSP WAS EXPLICITLY SPEC'D (/V) +EMARGIN:0 ;NONZERO IF MARGINS WERE EXPLICITLY SPEC'D (/M[...]) +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 (/&). +EHEDING:0 ;NONZERO => HEDING WAS EXPLICITLY SPEC'D (/"). +ENXFDSP:0 ;NONZERO => NXFDSP WAS EXPLICITLY SPEC'D (/!). +ESYMTRN:0 ;NONZERO => SYMTRN WAS EXPLICITLY SPEC'D (/A) +EFISORF:0 ;NONZERO => FISORF WAS EXPLICITLY SPEC'D (/>) + +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/TNX, 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. + +PRESS,[ + +SUBTTL PRESS FILE OUTPUT VARIABLES + +PRESSP: 0 ;NONZERO IF WE ARE WRITING A PRESS FILE. + ; <0 => PORTRAIT, >0 => LANDSCAPE + +;PRESS FILE OUTPUT REQUIRES BUFFERING UP LOTS OF GARBAGE. +;THIS BUFFER IS USED FOR ACCUMULATING ENTITY COMMANDS +;AS THE DATA IS PUT INTO SLBUF. +ENTBUF: 0 ;AOBJN POINTER TO ENTITY BUFFER FOR PRESS FILE OUTPUT. +ENTBPT: 0 ;8-BIT BYTE POINTER FOR FILLING BUFFER. +ENTCNT: ENTDLN ;NUMBER OF BYTES LEFT IN BUFFER. INITIAL VALUE IS DESIRED SIZE. + +;THIS BUFFER IS USED FOR ACCUMULATING THE PART DIRECTORY OF THE FILE. +;IT CONTAINS AN 18-BIT BYTE FOR EACH PART -- THE NUMBER OF PDP-10 WORDS USED FOR THAT PART. +DIRBUF: 0 ;AOBJN POINTER TO BUFFER FOR PART DIRECTORY. +DIRBPT: 0 ;9-BIT BYTE POINTER FOR FILLING BUFFER. +DIRCNT: DIRDLN ;COUNT OF BYTES LEFT IN BUFFER. INITIAL VALUE IS DESIRED SIZE. + +PRTCBP: 0 ;B.P. TO START OF THIS RUN OF PRINTING CHARACTERS IN SLBUF. + ;FOR COMPUTING ENTITY COMMANDS TO OUTPUT THEM. + ;ZERO AFTER A CR, LF, ETC. + +PAGWDS: 0 ;NUMBER OF PDP-10 WORDS OUTPUT TO FILE FOR THIS PAGE SO FAR. + ;THIS COUNTER DOES NOT INCLUDE THE DATA STILL IN SLBUF. + +PRESSF: 0 ;FONT NUMBER (ORIGIN 0) OF THE CURRENT FONT +PRESSX: 0 ;XPOS OF CURSOR POSITION ON PAGE. +PRESSY: 0 ;YPOS OF BASELINE OF CURRENT LINE. +PRESSW: 0 ;WIDTH OF PAGE IN DOTS EXCL. MARGINS. +PRESSH: 0 ;HEIGHT OF PAGE IN DOTS EXCL. MARGINS. + +PRSXY: 0 ;"SET X",,"SET Y" COMMANDS (SET IN PRSINI) + +ITS,[ +FWIDFL: SIXBIT /FONTS/ ;FILENAME OF FILE CONTAINING FONT WIDTHS. + SIXBIT /DSK/ + SIXBIT /FONTS/ + SIXBIT /WIDTHS/ +];ITS +SAI,[ +FWIDFL: 0 + SIXBIT /SYS/ + SIXBIT /FONTS/ + SIXBIT /WID/ +];SAI +CMU10,[ +FWIDFL: XWD 43441,105470 ;[S200DV00] + SIXBIT /SSL/ ;on "Standard Search List" + SIXBIT /FONTS/ + SIXBIT /WID/ +];CMU10 +CMU20,[ +FWIDFL: XWD 0,0 + SIXBIT /FON/ ;on FON: + SIXBIT /FONTS/ + SIXBIT /WID/ +];CMU20 +TNX,[ ; Someday probably want +NOCMU20,[ +FWIDFL: 0 + SIXBIT /SYS/ + SIXBIT /FONTS/ + SIXBIT /WID/ +];NOCMU20 +];TNX +T10,[ +FWIDFL: 0 ; Requires def of FON: for -10 or -20 + SIXBIT /FON/ + SIXBIT /FONTS/ + SIXBIT /WID/ +];T10 +];PRESS + +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 +NODOS, 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 +IFLE LSLBUF-200, .ERR LSLBUF must be greater than 200 for XSLBUF +;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, OUTRFS 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. + +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) + +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/PAGEL. + ;(FOR EXAMPLE, WE'RE ON A CONTINUATION PAGE IF OUTVP > PAGEL). +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 + +SYNCH: 0 ;SAVED CONTENTS OF CH FOR SYNTACTIC PARSING COROUTINE. +SYNCP: 0 ;SAVED CONTENTS OF CH FOR SYNTACTIC PARSING COROUTINE. +SYNACS: BLOCK H-A+1 ;SAVED CONTENTS OF A THRU H FOR SYNTACTIC PARSING COROUTINE. +SYNP: 0 ;SAVED CONTENTS OF P FOR SYNTACTIC PARSING COROUTINE. +IFNDEF SYNPLN,SYNPLN==40 +SYNPDL: BLOCK SYNPLN ;PDL FOR SYNTACTIC PARSING COROUTINE. +MAINP: 0 ;SAVED NORMAL STACK POINTER WHILE INSIDE COROUTINE. + +UNDRLN: 0 ;NONZERO IF IN MIDDLE OF AN UNDERLINE. + ;FOR PRESS FILES, WILL CONTAIN -1,,HPOS OF START OF UNDERLINE. +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. +OUTFLG: 0 ;NONZERO WHILE IN SYNTACTIC COROUTINE + ;IF THIS PAGE IS BEING PRINTED. + +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. + +SLURPY: 0 .SEE SLURP,XSLURP ;PASS 2 CHAR INPUT ROUTINE. RETURNS CHAR IN CH. +;SLURPY IS THE ROUTINE USED BY 2GETCH +;TO GET A CHARACTER FOR PASS 2 SYNTACTIC PROCESSING. +;THIS CAN BE XSLURP, WHICH DOES NOT LIST THE CHARACTER, +;SLURP, WHICH DOES LIST IT, OR SLURPG, WHICH LISTS BUT SCANS XGP CODES +;FOR DETECTING END OF LINE AND END OF PAGE. +;THE SETTING DEPENDS ON THE LANGUAGE, WHETHER THE FILE IS BEING LISTED, +;AND WHETHER THE CURRENT INPUT PAGE IS BEING LISTED. + +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. + +DOS,[ +INHED: BLOCK 3 +OUTHED: BLOCK 3 + +CMU10,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 + +];DOS + +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. + ; On TNX, uses GTAD format. +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 +CFILNM: BLOCK 10 ; ASCIZ filename for CFILE, set during P2 by 2INIPL. +TNX, BLOCK 3*40. ; TNX has long filenames! +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) + +TNX,[ +NAMSIZ==:40. ; big buffer for accumulating filenames +NAMBLK: BLOCK NAMSIZ ; here it is +JFNBLK: BLOCK 17 ; for longform JFN +];TNX + +FILES: BLOCK LFBLOK ;BLOCKS OF FILE SPECS (SHOULD BE ENOUGH) +REPEAT NFILES-1, CONC FIL,\.RPCNT+1,: BLOCK LFBLOK +EFILES: 0 + +FILSRT: BLOCK NFILES+1 ;ADDRESSES OF ALL INPUT FILES (ALPHABETICAL BY FILENAMES IF FISORF NONZERO) + +DLRECF: BLOCK 2 ;FILE NAMES FOR /_ SWITCH OUTPUT (DLREC). +ITS, SIXBIT /DLREC >/ +NOITS, SIXBIT /DLREC LST/ + +DLRDEV: 0 ;VALUE OF "DEVICE" FOUND IN LREC FILE WE ARE DLREC'ING. + +SUBTTL FILE VARIABLES AND OTHERS + +TNX,[ +JFNCHS: BLOCK 20 ; Holds JFNs for channels (UTOC, UTIC, INSC) +] + +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 +FNTWDN: 0 ;WIDTH OF FONT 1 +FNTHGT: 0 ;THE HEIGHT OF THE HIGHEST FONT +FNTBAS: 0 ;BASELINE OF THE FONT WHOSE BASELINE IS LARGEST. + +MARGIN: ;THE FIVE MARGINS (IN MILS) +MARG.L: DFLMAR +MARG.T: DFTMAR +MARG.R: DFRMAR +MARG.B: DFBMAR +MARG.H: DFHMAR + +;NOTE: FONT NFNTS+1 IS USED IN PRESS FILES FOR THE TITLE PAGE. SEE PRSFDR. +FNTF0: OFFSET -. ;TABLE OF FONT FILES. DON'T ADD ANY WORDS - SEE LR.FNT. +FNTSNM::0 ;FILENAMES OF FONT ... +FNTDEV::0 ;FOR DOVER, FAMILY NAME IS IN FNTSNM - FNTFN1 AS SIXBIT. +FNTFN1::0 ;FNTFN2 IS FACE CODE,,SIZE CODE. +FNTFN2::0 +FNTSIZ::0 ;*512.+,, OF FONT. +FNTID:: 0 ;NON-ZERO => FONT EXPLICITLY SPEC'D. THIS ALSO HOLDS THE KSTID IF THERE IS ONE +FNTFL:: OFFSET 0 + IFN FNTFL-6, .ERR YOU SHOULDN'T CHANGE FNTFL OR YOU WILL LOSE WHEN GIVEN OLD LREC FILES + 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 +AMACHINE: block 20 ; ASCIZ name of site if machine = 0 +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 + +BOTS, SYSBUF: BLOCK 10 ;Buffer for printing system name +TNX, SYSBSZ==:12 +TNX, SYSBUF: BLOCK SYSBSZ ; buffer for printing system name +CMU10, PPNBUF=:SYSBUF ;Buffer for converting special CMU PPNs +TNX,[ +PPNSIZ==:20. ; buffer size for PPN +PPNBUF: BLOCK PPNSIZ ; Buffer for converting TWENEX PPNs to names +STRBUF: ASCII/PS:/ ;BUFFER FOR STRUCTURE NAME + 0 ;(IN CASE STRUCTURE NAME IS 6 CHARACTERS) +TFILNM: BLOCK 7+41.+40.+40. ; For building ASCIZ filename +];TNX + +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\ +IFDEF STANSW,IFN STANSW,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, BLOCK 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 +NOSAI,[ +IFE TWOSEG, LOC <.+1777>&776000 +];NOSAI +IFN TWOSEG, LOC RL0+400000 +PURBOT:: + +CRLFZ: ASCIZ / +/ ; Might as well stick this here. + +SUBTTL VARIOUS DEFAULT 2ND FILENAMES AND OTHER MAGIC TABLES. + +ITS,[ +IPTFN2: SIXBIT/>/ +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/ +T10,CODTXT::0 +TNX,CODTXT::0 +CODMDL:: SIXBIT/MDL/ +CODH16:: SIXBIT/H16/ +CODMAX:: OFFSET 0 + +LRCFN2: SIXBIT/LRC/ +ALRFN2: 0 +OLRFN2: SIXBIT/OLR/ +CRDFN2: SIXBIT/ATC/ +T10,FNDFN2: SIXBIT/KST/ +TNX,FNDFN2: SIXBIT/KST/ +CMU,FNDFN2: SIXBIT/KST/ +SAI,FNDFN2: SIXBIT/FNT/ + +];NOITS + +OPTFN2: OFFSET -. + DEVLPT:: + ITS, SIXBIT/@/ + NOITS, SIXBIT/LST/ + DEVIXG:: + ITS, SIXBIT/@XGP/ + NOITS, SIXBIT/XGP/ + DEVCXG:: SIXBIT/XGO/ + DEVGLD:: + ITS, SIXBIT/@XGP/ + NOITS, SIXBIT/GLD/ + DEVLDO:: SIXBIT/PRESS/ + DEVPDO:: SIXBIT/PRESS/ + DEVANA:: SIXBIT/ANA/ + DEVCGP:: SIXBIT/CGP/ + DEVFLA:: SIXBIT/FLA/ + DEVMAX::OFFSET 0 + +SUBTTL LINE AND PAGE LENGTH BY DEVICE + +;DEFAULT LINE LENGTH IN CHARS, IF NO FONTS SPECIFIED. +;ZERO FOR A DEVICE FOR WHICH FONTS ARE ALWAYS THOUGHT ABOUT. +LNL: OFFSET -. +DEVLPT:: 120. +DEVIXG:: 84. +DEVCXG:: 120. +DEVGLD:: 132. +DEVLDO:: 0 +DEVPDO:: 0 +DEVANA:: 132. +DEVCGP:: 119. +DEVFLA:: 132. +DEVMAX::OFFSET 0 + +;DEFAULT PAGE LENGTH IN LINES, IF NO FONTS SPECIFIED. +;ZERO FOR A DEVICE FOR WHICH FONTS ARE ALWAYS THOUGHT ABOUT. +PGL: OFFSET -. +DEVLPT:: SAI,[54.] .ELSE 60. +DEVIXG:: 60. +DEVCXG:: 77. +DEVGLD:: 62. +DEVLDO:: 0 +DEVPDO:: 0 +DEVANA:: 60. +DEVCGP:: 85. +DEVFLA:: 60. +DEVMAX::OFFSET 0 + +;DOTS PER INCH HORIZONTALLY, OR 0 FOR A NON-GRAPHIC DEVICE. +;FOR PRESS FILE OUTPUT, THESE ARE ACTUALLY MICAS, NOT DOTS. +DOTPIH: OFFSET -. +DEVLPT:: 0 +DEVIXG:: 200. +DEVCXG:: 183. +DEVGLD:: 200. +DEVLDO:: 2540. +DEVPDO:: 2540. +DEVANA:: 0 +DEVCGP:: 240. +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +;DOTS PER INCH VERTICALLY, OR 0 FOR A NON-GRAPHIC DEVICE. +;FOR PRESS FILE OUTPUT, THESE ARE ACTUALLY MICAS, NOT DOTS. +DOTPIV: OFFSET -. +DEVLPT:: 0 +DEVIXG:: SAI,[199] .ELSE 192. +DEVCXG:: 183. +DEVGLD:: 189. +DEVLDO:: 2540. +DEVPDO:: 2540. +DEVANA:: 0 +DEVCGP:: 240. +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +;LINE LENGTH IN DOTS, OR 0 FOR A NON-GRAPHIC DEVICE. +;FOR PRESS FILE OUTPUT, THESE ARE ACTUALLY MICAS, NOT DOTS. +LNLDOT: OFFSET -. +DEVLPT:: 0 +DEVIXG:: 20.*85. +DEVCXG:: 1539. +DEVGLD:: 20.*85. +DEVLDO:: 2540.*11. +DEVPDO:: 254.*85. +DEVANA:: 0 +DEVCGP:: 1980. ; Theoretically 2040 but right margin has 60-pixel bug +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +;PAGE HEIGHT IN DOTS, OR 0 FOR A NON GRAPHICS DEVICE. +;FOR PRESS FILE OUTPUT, THESE ARE ACTUALLY MICAS, NOT DOTS. +PGLDOT: OFFSET -. +DEVLPT:: 0 +DEVIXG:: SAI,[2194.] .ELSE 192.*11. +DEVCXG:: 183.*11. +DEVGLD:: 2080. +DEVLDO:: 254.*85. +DEVPDO:: 2540.*11. +DEVANA:: 0 +DEVCGP:: 240.*11. ; Should be able to hack full page. +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +;NONZERO FOR DEVICE THAT FORCES /X. +;NEGATIVE FOR A DEVICE THAT WANTS PRESS FILES. +;THE RIGHT HALF ENCODES STUFF FOR PRESSP OR XGPP +;NOTE: A DEVICE ALLOWS /X IF ITS PGLDOT (OR, LNLDOT) IS NONZERO. +FRCXGP: OFFSET -. +DEVLPT:: 0 +DEVIXG:: 0,,-1 +DEVCXG:: 1 +DEVGLD:: 0 +DEVLDO:: -1,,1 +DEVPDO:: -1 +DEVANA:: 0 +DEVCGP:: 0,,-2 +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +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: HRRO A,40 +TNX, PSOUT +NOTNX,[ HRLI A,440700 + CAIA +STRT1: TYO B + ILDB B,A + JUMPN B,STRT1 +] + JRST UUORET + +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, + +;FLOSE AND FLOSEI UUOS. +FLOSE0: 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 + STRT CRLFZ +TNX,[ + CALL TF6TOA ; Convert filename block to ASCIZ + STRT TFILNM ; Type it out +];TNX +NOTNX,[ + 6TYP 1(A) ;PRINT NAME OF FILE WE WERE TRYING TO OPEN. + TYO [":] +ITS, 6TYP (A) +ITS, TYO [";] + 6TYP 2(A) +ITS, TYO [" ] +DOS, TYO [".] + 6TYP 3(A) +];NOTNX + +BOTS,[ SKIPN B,(A) + JRST FLOSE7 + TYO [133] ; "[" ] +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] +CMU10,[ MOVE A,[B,,PPNBUF] ;CMU => POSITIVE => FUNNY CMU PPN. + DECCMU A, + JRST FLOSOC + OUTSTR PPNBUF + JRST FLOSRB +FLOSOC: +];CMU10 + HLRZ L,B ;DEC => POSITIVE => PRINT HALFORDS NUMERICALLY. + TYPNUM 8.,L + TYO [",] + HRRZI L,(B) + TYPNUM 8.,L +];NOSAI +FLOSRB: TYO [135] ; [ "]" +];BOTS +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 +DOS,[ 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) +];DOS +TNX,[ MOVEI A,.PRIOU + MOVE B,[.FHSLF,,-1] + SETZ C, + ERSTR + NOP + NOP +];TNX + +;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 + +DOS,[ [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)/ +];DOS + +DOS,[ +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 +];DOS +TNX,[ ; This should be improved. +LOSE0: PUSH P,A + HRROI A,[ASCIZ /Unexpected error - LOSE! +/] + PSOUT + HALTF + POP P,A + JRST 2,@LOSE +];TNX + +SUBTTL GOBBLE ONE LINE FROM TTY + +TTILA: CALL TTILAX ; Prompt and read a line + MOVE CP,[440700,,SYLBUF] +TTILA2: ILDB CH,CP + CAIE CH,40 ; Ignore spaces/tabs + CAIN CH,^I + JRST TTILA2 + CAIE CH,0 + CAIN CH,^M ; If hit end of line and nothing seen, + JRST TTILA ; get another line. + RET ; Something on line, win. + +TTILAX: +ITS, MOVEI CH,[ASCIZ/@/] ;PROMPT AND READ A LINE. +BOTS,CMU, MOVEI CH,[ASCIZ/@/] +BOTS,NOCMU, MOVEI CH,[ASCIZ/*/] ; Use * since it is conventional +10X, MOVEI CH,[ASCIZ/*/] ; and @ is a screw on TENEX! +CMU20, MOVEI CH,[ASCIZ /AT>/] +T20,NOCMU20, MOVEI CH,[ASCIZ /ATSIGN>/] + JRST TTILPR + +;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. +; TTILPR entry uses addr of ASCIZ string in CH as prompt if nonzero. +TTIL: SETZ CH, ; No prompt +TTILPR: CAIE CH,0 + STRT (CH) ; Print out prompt string if one + MOVE CP,[440700,,SYLBUF] ;BP -> START OF BUFFER. +NOT20,[ + PUSH P,CH ; Save prompt for possible ctl-R + SETZM IP ;0 CHARS READ SO FAR. + +TTIL1: TYI CH ;READ NEXT CHAR. +10X,[ CAIN CH,^_ ; Tenex EOL crock? + MOVEI CH,^M ; Yeah, substitute CR. +];10X +NOITS,[ NO10X,[ ; Do this for T20 and DOS + CAIN CH,^M ;IGNORE CR'S + JRST TTIL1 + CAIN CH,^J ;AND CONVERT LF'S TO CR'S + MOVEI CH,^M +];NO10X +];NOITS +NODOS,[ + CAIN CH,^U ;CHECK FOR SPECIAL RUBOUT-PROC. CHARS. + JRST TTILX ;^U => CANCEL WHOLE LINE. + CAIN CH,177 + JRST TTILRB ;RUBOUT => CANCEL LAST CHAR. + CAIE CH,^L + CAIN CH,^R ; ^R = retype line + JRST [STRT CRLFZ ; Go to new line + SKIPE CH,(P) ; Get back prompt string if any + STRT (CH) + SETZ CH, + PUSH P,CP + IDPB CH,CP ; Make string thus far ASCIZ + POP P,CP + STRT SYLBUF ; Output it. + JRST TTIL1] + CAIN CH,^J + JRST [ TYO [^M] + JRST TTIL1 ] +];NODOS +NOTNX,[ + CAIE CH,^C ;^C AND ^Z TURN INTO CR. + CAIN CH,^Z + JRST [STRT CRLFZ + MOVEI CH,^M ;LINE WAS TERMINATED, PUT ^M AT END OF BUFFER. + IDPB CH,CP + POP P,CH + POPJ P,] +];NOTNX + IDPB CH,CP ;ELSE PUT CHAR IN BUFFER. + AOS IP + CAIE CH,^M ;THEY AND CR TERMINATE THE LINE. + JRST TTIL1 ;OTHER CHARS => KEEP READING. + POP P,CH + 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: STRT CRLFZ ;COME HERE FOR ^U, OR RUBOUT WITH EMPTY BUFFER. + POP P,CH + SOS (P) ;RETURN TO THE PUSHJ WHICH CALLED TTIL OR TTILA. + POPJ P, +];NOT20 +T20,[ + PUSH P,A + PUSH P,B + PUSH P,C + MOVE A,CP ; Destination BP + MOVE B,[RD%BEL+RD%CRF+] ; Break on EOL, only store LF + SKIPE C,CH + HRROI C,(CH) ; Prompt string if any + RDTTY ; Get a line + .VALUE ; Shouldn't happen + LDB CH,A ; Get terminating char + CAIN CH,^J ; LF? + MOVEI CH,^M ; Yes, substitute CR. + DPB CH,A + POP P,C + POP P,B + POP P,A + POPJ P, +];T20 + +SUBTTL T(W)ENEX INTERRUPT HANDLER + +TNX,[ +LEVTAB: .JBTPC ? 0 ? 0 ; Addrs to save PC's in +CHNTAB: BLOCK 36. ; Dispatch for each int + %%.SAV==. + LOC CHNTAB+.ICPOV ? 1,,TSINT0 ; PDL overflow +10X, LOC CHNTAB+.ICEOF ? 1,,EOFINT ; EOF condition +10X, LOC CHNTAB+.ICILI ? 1,,ILIINT ; Illeg instr (check for ERJMP) + LOC %%.SAV + EXPUNGE %%.SAV + +T20, ERJMPA=:ERJMP ; ERJMPA is for places where T20 needs ERJMP +10X,[ ERJMPA=: ; but 10X needs JRST. + +ERXJMP==: ; For easier code writing +ERXCAL==: +ERXJPA==: + +EOFINT: +ILIINT: PUSH P,A + PUSH P,B + MOVE A,.JBTPC ; Get PC we got interrupted from + LDB B,[271500,,(A)] ; Get op-code and AC field of instr + CAIN B,ERXJPA + JRST ERJFAK + CAIE B,ERXJMP ; Is it a magic cookie? + CAIN B,ERXCAL + JRST ERJFAK + AOJ A, + LDB B,[271500,,(A)] ; Try next instr + CAIE B,ERXJMP ; Any better luck? + CAIN B,ERXCAL + JRST ERJFAK + .VALUE ; Bad, bad. +ERJFAK: AOS ERJCNT ; Bump cnt of times won (for kicks) + CAIN B,ERXCAL ; See which action to hack + JRST ERJFK2 ; Go handle ERCAL, messy. + MOVEI A,@(A) ; ERJMP, get the jump address desired + MOVEM A,.JBTPC ; Make it the new PC + POP P,B + POP P,A + DEBRK +ERJFK2: MOVEI B,@(A) ; Get jump address + MOVEM B,.JBTPC ; Make it the new PC + POP P,B + AOJ A, ; old PC needs to be bumped for return + EXCH A,(P) ; Restore old A, and save PC+1 on stack + DEBRK + +; (Actually, since ERCAL is not special except after a JSYS, it would +; still work if the ERCAL-simulation didn't bump the PC; control would +; just drop through to the next instruction on return. Might confuse +; people looking through the stack frames, though.) +];10X +];TNX + +SUBTTL PDL OVERFLOW INTERRUPT HANDLER + +TSINT0: MOVEM A,INTASV + MOVEM B,INTBSV +NOTNX,[ SKIPL A,.JBCNI + TRNN A,200000 ;ONLY INTERESTED IN PDL OVERFLOW + .VALUE +];NOTNX + HRRZ A,.JBTPC ; Get PC + 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 +TNX, MOVEI B,2000 ; Don't need anything special, a page ref will win. +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 + CAIN B,SYNPDL+SYNPLN + 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 +];ITS +TNX, MOVEI B,-2000 ; Emulate ITS + JRST TSINTF + +PDLFUL: SETZ A, + CAMN B,PDLEND + MOVEI A,[ASCIZ/PDL /] + CAMN B,LRCEND + JRST [ MOVEI A,[ASCIZ/LREC /] + JRST PDLFU2] + CAMN B,SYMEND + MOVEI A,[ASCIZ/Symbol /] +PDLFU2: CAIN A, + MOVEI A,[ASCIZ /Mysterious /] + STRT (A) + STRT [ASCIZ/data area is full. Try again with different space allocations./] +ITS, .VALUE +TNX, HALTF +DOS, 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] + SYSCAL CORBLK,[1000,,%CBNDR ? 1000,,%JSELF ? A] + .LOSE %LSSYS + SETZM DEBUG + .VALUE [ASCIZ ":PDUMP DSK:SYS;TS @"] +];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 THE 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 + JUMPL IP,DOINP1 ;JUMP IF REACH EOF + SUB IP,[1,,1] ;SAVE LAST WORD FOR NEXT DOINPT. + 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, + +DOINP1: SETZM LFILE ;IF WE DON'T FILL THE BUFFER, IT'S EOF. + POPJ P, + +];ITS + +DOS,[ +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 +];DOS + +TNX,[ +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. + PUSH P,A ? PUSH P,B ? PUSH P,C + HLRO C,IP ; Get neg count + MOVEI B,(IP) ; Get destination addr + HRLI B,444400 ; Make it a word bp + MOVE A,JFNCHS+UTIC + SIN ; Perhaps should handle SIN errors? + ERJMP .+1 ; Assume any error is EOF. + MOVEI IP,(B) ; Put back updated addr + CAIL B, ; but if BP isn't 444400, then + ADDI IP,1 ; really pointing to next word. + HRL IP,C ; Put back updated count + POP P,C ? POP P,B ? POP P,A + JUMPL IP,DOINP1 ;JUMP IF REACH EOF + SUB IP,[1,,1] ;SAVE LAST WORD FOR NEXT DOINPT. + 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, + +DOINP1: SETZM LFILE ;IF WE DON'T FILL THE BUFFER, IT'S EOF. + POPJ P, +];TNX + +;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 + PUSHJ P,2PAGE1 +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 + MOVEI A,(SP) + CAIL A,SLBUF+LSLBUF + .VALUE + CAIL A,XSLBUF + PUSHJ P,2OUTB1 +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 BIT T%1WRD 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 FOR REFS. +;;; T%NPRT,, MEANS DO NOT PRINT THIS DEFINITION IN THE CREF. + +T%BIND==1 +T%TAG==2 +T%NPRT==4 +T%NREF==200000 +T%1WRD==400000 ;NO SECOND WORD FOLLOWS. +T%FLGS==600000 ;FLAGS ALLOWED IN LH OF FIRST WORD. + +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,,[%PIPDL]] ;PDL OVERFLOW +TNX,[ MOVEI A,.FHSLF + MOVE B,[LEVTAB,,CHNTAB] + SIR ; Set int table addrs +T20, MOVE B,[1_<35.-.ICPOV>] ; Activate on these ints +10X, MOVE B,[<1_<35.-.ICPOV>>+<1_<35.-.ICEOF>>+<1_<35.-.ICILI>>] + AIC + EIR ; Enable PSI +];TNX +DOS, 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 + CAMG C,LRCLEN ;and if that's more than the default + SKIPA C,LRCLEN + MOVEM C,LRCLEN ;Use it instead + ADD C,PDLEND ;See where LRCEND should be + SUB C,LRCEND +DOS, JUMPE C,SYMIN1 ;Jump if lrec area already as long as it needs to be. +NODOS, JUMPLE C,SYMIN1 ;On ITS/TNX, we don't truncate it. + ADDM C,LRCEND ;otherwise fix LRCEND + ADDM C,.JBFF ;initializing DP below will take care of the .CORE UUO, if needed +DOS,[ MOVNI C,(C) ;if not ITS/TNX, we must fix LH(LRCPTR) + HRLZI C,(C) + ADDM C,LRCPTR +];DOS +SYMIN1: SKIPE TEXTP ;IF THIS LISTING ISN'T USING SYMBOLS, WE DON'T + TDZA C,C ;NEED TO ALLOCATE ANY SYM SPACE. + MOVN C,SYMLEN + JSP L,PDLIN1 + MOVEM B,SYMEND + MOVE SP,A + HRRZM SP,SYMLO + AOS SYMLO + MOVNI C,DATILN + JSP L,PDLIN1 + MOVE DP,A + 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 +NODOS,[ TRO B,1777 ;MAKE SURE ON PAGE BOUNDARY + TRZ C,1777 ;AND THAT ASKING FOR AN INTEGRAL NUMBER OF PAGES +ITS,[ 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 +];NODOS +DOS, TRO B,3 .SEE SORT ;WHICH ASSUMES THAT SYMTAB ENTRIES START + MOVEI A,(B) ;ON 4-WORD BOUNDARIES. +NODOS, HRLI A,-2000 +DOS, HRL A,C + SUB B,C +IFE TWOSEG, CAILE B,777777 ;TOO MUCH CORE?? +IFN TWOSEG, CAILE B,377777 ;TOO MUCH CORE?? + JRST PDLIN9 ; Ugh. lose. + HRRZM B,.JBFF + AOS .JBFF +DOS,[ MOVE C,B + CORE C, + JRST PDLIN9 +];DOS + JRST (L) + +PDLIN9: STRT [ASCIZ / +Storage space overflow! +/] + .VALUE + +SYSINI: +ITS,[ SYSCAL OPEN,[1000,,TYIC ? 5000,,.UAI ? ['TTY,,]] + .LOSE %LSFIL + SYSCAL OPEN,[1000,,TYOC ? 5000,,.UAO ? ['TTY,,]] + .LOSE %LSFIL + SYSCAL SSTATU,[ ;READ NAME OF MACHINE ("AI", "MC", "ML", OR "DM") + REPEAT 6,[ ? %CLOUT,,MACHINE ]] + .LOSE %LSSYS +];ITS +CMU10,[ 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 +];CMU10 +TNX,.ERR This 1-word lossage should be fixed. +T20,[ + movei 1,.lhost ; ask for host name + getab + jrst MFail ; couldn't get it + move 3,1 ; put host # in AC3 + movei 1,.gthns ; read host table + hrroi 2,amachine ; where to put it + gthst ; read the ascii host name + jrst MFail ; couldn't + setzm machine ; indicate ASCII value is valid +MFail: +];T20 + 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 +];REPEAT 2 +];ITS +BOTS,[ 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 +];BOTS +TNX,[ SETO B, + SETZ D, + ODCNV ; Break down current time + HLRZ A,B ; Get full year number + IDIVI A,100. + IDIVI B,10. ; Get tens and ones digits in B and C + ADDI B,"0 + ADDI C,"0 + MOVE A,[CPYBP] + IDPB B,A + IDPB C,A +];TNX + 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 +10X,[ MOVEI A,.PRIIN + BKJFN ; Back up to get invoking char + JRST POPJ1 + PBIN ; Get it + CAIE A,40 ; If not a space + JRST POPJ1 ; then no JCL. + CALL TTIL ; JCL, get it! Don't JRST, to avoid TTIL's + RET ; weird restart (which would call JCLGET) +];10X +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 +T20,[ SETZ A, + RSCAN ; See if any JCL + JRST POPJ1 + JUMPLE A,POPJ1 + PBIN ; Have something! Get char + CAIE A,"a + CAIN A,"A ; If not "A" for "ATSIGN" + JRST RSCAN1 +GOSCEL: CAIN A,^J ; assume line is not a good cmd string. + JRST POPJ1 ; (this is pretty dumb, though) + PBIN + JRST GOSCEL + +RSCAN1: PBIN ; Search for space + CAIN A,^J + JRST POPJ1 + CAIE A,<" > + JRST RSCAN1 + JRST TTIL ; Found it, start reading cmd line. +];T20 +NOSAI,NOT20,JRST POPJ1 + +SUBTTL TOP LEVEL + +GO: +DOS,[ JFCL ;We don't care wether we get run with a CCL linkage or not + RESET ;AREN'T WE NICE AND PROPER +IFN TWOSEG, HLLZS .JBSA ;CLOBBER .JBSA SINCE WE CAN'T BE RESTARTED ANYWAY +IFE TWOSEG,[ ;Why the hell is this here? The monitor should do this on RESET UUO -RHG + HLRE A,.JBSYM ;Get the symbol table length + MOVN A,A + ADDI A,.JBFF1 ;add in the top of the low segment + HRLZM A,.JBSA ;and set the low segment length + MOVEM A,.JBFF +];IFE TWOSEG +];DOS +TNX,[ JFCL + RESET + MOVEI A,.FHSLF + SETO B, ; Set value of -1 for the + SCVEC ; compat entry vector, to flush PA1050. +];TNX + 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 [".] + TYPNUM 10.,[VERSION] +IFN SUBVER,[ + TYO [".] + TYPNUM 10.,[SUBVER] +];IFN SUBVER + STRT CRLFZ + PUSHJ P,TTILA ;READ COMMAND FROM TTY, PROMPTING WITH "@". +GO2: + PUSHJ P,FPARSE ;INTERPRET COMMAND STRING. + PUSHJ P,FPDEF ;DEFAULT MOST FILENAMES + PUSHJ P,RLREC ;READ IN LISTING RECORD INPUT FILES. + PUSHJ P,FPDLNG ;FIGURE LANG. OUT FROM INPUT FILES & SET DECODED FLAGS. + PUSHJ P,FPDDED ;DEDUCE SOME THINGS FROM THE SWITCH SETTINGS. + 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. + MOVEM F,REALF ;SAVE VALUE OF F TO BE PUT IN LREC OUTPUT FILE. + SKIPE B,FNTSPC .SEE DEVLPT ; see note below + MOVE B,DEVICE ; see note below + SKIPE DOTPIH(B) ; only RHG understands these three instructions -jmn + PUSHJ P,FNTCPT ;COMPUTE DEFAULT PAGEL, LINEL FROM FONTS. + PUSHJ P,SYMINI ;ALLOCATE SYMBOL SPACE AND DATA SPACE. +ITS,[ MOVE B,DEVICE + CAIN B,DEVGLD ;BARF FOR /X /D[GOULD] + TLNN F,FLXGP + JRST GO7 + SKIPN FNTSPC ;WITH NO /F[FONTS] + JRST [ STRT [ASCIZ \/X[GOULD] requires specified fonts!\] + JRST ERRDIE ] +GO7: ];ITS + SKIPLE OLDFL ;LREC FILE EDIT MODE? + JRST GO5 ;YES, OMIT CERTAIN PASSES. + SKIPE TEXTP ;If the languge is [RANDOM] 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 + 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+FSAUX ;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 +NOXGPRES,TLZ F,FLXGP\FLFNT2\FLFNT3 + MOVEM F,ODEFSW + SKIPL B,DEVICE ;DEFAULT THE PAGEL AND LINEL, ASSUMING THAT FONTS WERE NOT + CAIL B,DEVMAX ;SPECIFIED. IF THEY WERE SPECIFIED, FNTCPT WILL OVERRIDE THIS + .VALUE + MOVE A,LNL(B) + SKIPN LINEL + MOVEM A,LINEL + MOVE A,PGL(B) + SKIPN PAGEL + MOVEM A,PAGEL + POPJ P, + + +FPENDF: TRZ F,FSSUBT ;THIS CAN BE GARBAGE, HERE. IT SHOULD BE ZERO. + 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 + +NOTNX,[ +;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 +BOTS,[ CAIN CH,". + JRST FPDOT + CAIN CH,"[ ;] + JRST FPSPC +];BOTS + 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. + +BOTS,[ +FPDOT: AOS 3(L) ;"." IMPLIES FN2 SHOULD NOT BE DEFAULTED, EVEN IF NULL. +];BOTS +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 +BOTS,[ CAIN CH,"[ ;] + JRST FPPPN + CAIE CH,". + JRST FPNAME + MOVEI CC,FPNTAB+1 + JRST FPFIL2 +];BOTS +ITS, JRST FPNAME + +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 + +BOTS,[ +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, DROPTHRUTO FPPPN3 + +;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: +T10,[ + 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 + +CMU10,[ 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 +];CMU10 +];NOSAI + +FPPPN4: STRT [ASCIZ/Bad PPN: [/] ;] + MOVE A,FPPNBP + JRST FPSBD3 +];BOTS +]; NOTNX + + +TNX,[ +;;; Read a filename up to a comma or line terminator +;;; Parse it using JFN calls, and then pack up the bitsies +;;; into SIXBIT cells +FPFILE: + MOVE CP,[440700,,NAMBLK] + SETZ CC, +FPLOOP: ILDB CH,IP ; get a character + CAIN CH,", ; interesting delimiter? + JRST FPSPC ; yes + JUMPGE L,FPLOO1 ; [scanning spec in switch? + CAIN CH,"] ; yes, close bkt can terminate it + JRST FPSPC + JRST FPLOO2 ; not bkt; don't accept switches etc. +FPLOO1: CAIE CH,"( ; any delimiters of interest? + CAIN CH,"_ + JRST FPSPC ; yes + CAIE CH,"^X + CAIN CH,"/ + JRST FPSPC ; likewise + CAIN CH,"' ; quote + JRST [TROE F,FSQUOT .SEE FPQUOT + IORI F,FSNOIN + JRST FPLOOP] + +FPLOO2: CAIN CH,"^Q ; quoting char? + ILDB CH,IP ; yes, get next + CAIE CH,^M ; line end? + CAIN CH,^I ; or tab? + JRST FPSPC ; yes, terminator + CAIL CH,140 ; do casefold + SUBI CH,40 + IDPB CH,CP ; stuff it away + JRST FPLOOP ; get more + +FPSPC: SETZ A, ; delimit string we've accumulated + IDPB A,CP ; so it is ASCIZ for GTJFN + + MOVE A,[440700,,NAMBLK] + PUSHJ P,TNXRFD + +IFN 0,[ +;;; Now, set up the longform GTJFN arguments that are not already +;;; set up by the GTJFN routine + + MOVE B,[.NULIO,,.NULIO] + MOVEM B,JFNBLK+.GJSRC + SETZM JFNBLK+.GJDEV + SETZM JFNBLK+.GJDIR + SETZM JFNBLK+.GJNAM + SETZM JFNBLK+.GJEXT + SETZM JFNBLK+.GJPRO + SETZM JFNBLK+.GJACT + SETZM JFNBLK+.GJJFN +T20,[ MOVE B,[G1%NLN,,0] ; no long names, no other extended args + MOVEM B,JFNBLK+.GJF2 ; first (and only) extended arg + +;;; Now call the GTJFN routine + MOVE A,[GJ%OFG+GJ%XTN+JFNBLK] ; flags,,block +];T20 +10X, MOVE A,[GJ%OFG+JFNBLK] ; 10X doesn't have extended JFN + HRROI B,NAMBLK + PUSHJ P,CVJFN ; Get JFN + JRST FILBOG ; bogus filespec + PUSHJ P,UNJFN + RLJFN ; Release JFN, don't need any more + NOP +] ;IFN 0 + +FPSWL: + CAIE CH,^M ; terminator of interest + CAIN CH,", + POPJ P, + CAIE CH,^X + CAIN CH,"_ + POPJ P, + CAIN CH,"( + JRST FPSWS + CAIN CH,"/ + JRST FP1SW + POPJ P, +FPNAME: ; switch routines return here (gah!) + ILDB CH,IP ; pick up next character after switch + JRST FPSWL ; and go decode it + +FILBOG: MOVEI A,.PRIOU + MOVE B,[.FHSLF,,-1] + SETZ C, + ERSTR + JFCL + JFCL + POPJ P, ; nonskip return + +;;; Now, we UNPARSE the filename and pack each string into a +;;; SIXBIT word + +UNJFN: PUSH P,D + PUSH P,A ; save JFN + HRROI A,NAMBLK ; where to write string + HRRZ B,(P) ; get JFN back + MOVE C,[100000,,0] ; device, unless system default + SETZ D, ; zero + JFNS ; get device + PUSHJ P,JFN6 ; convert to sixbit, return in A + MOVEM A,1(L) + + ; Convert dev: to PPN +T20,[ HRROI A,NAMBLK + HRRZ B,(P) + MOVE C,[100000,,0] ; device and no punctuation + SETZ D, + JFNS + PUSH P,A ; save string pointer + PUSHJ P,JFN6 ; check for nullness + JUMPN A,JFNNZD ; non-null + MOVE A,[ASCII /PS/] ; dummy device + MOVEM A,NAMBLK + MOVE A,[260700,,NAMBLK] ; pointer to just past it + MOVEM A,(P) +JFNNZD: + MOVEI A,": ; Punctuation + IDPB A,(P) ; put it into string + MOVE A,NAMBLK ;PRESERVE STRUCTURE NAME + MOVE B,NAMBLK+1 + MOVEM A,STRBUF + MOVEM B,STRBUF+1 + MOVE A,(P) ; where to write directory name + HRRZ B,-1(P) ; get JFN back + MOVE C,[20000,,1] ; + JFNS ; convert to string + POP P,A ; pointer to where it should be + ILDB B,A ; anything? + SKIPN B + JRST FILZPP + MOVSI A,(RC%EMO) ; Want exact match + HRROI B,NAMBLK + RCDIR ; Error shouldn't happen + MOVE B,C ; Get dir # into B +];T20 +10X,[ HRROI A,NAMBLK + HRRZ B,(P) + MOVE C,[20000,,0] ; "directory" + JFNS + MOVE A,[440700,,NAMBLK] + ILDB B,A ; Anything? + JUMPE B,FILZPP + SETZ A, + HRROI B,NAMBLK + STDIR + .VALUE ; No match - should never happen + .VALUE ; ambiguous - ditto + MOVE B,A ; Get dir # into B +];10X + +FILZPP: MOVEM B,(L) + ; Get filename (FN1) + HRROI A,NAMBLK + HRRZ B,(P) + MOVE C,[002000,,0] + JFNS + PUSHJ P,JFN6 + MOVEM A,2(L) + ; Get extension/filetype (FN2) + HRROI A,NAMBLK + HRRZ B,(P) + MOVE C,[000200,,0] + JFNS + PUSHJ P,JFN6 + MOVEM A,3(L) + POP P,A ; restore JFN + POP P,D + POPJ P, + +;;; convert string in NAMBLK to SIXBIT and leave in A +JFN6: PUSH P,CH + MOVE B,[440600,,A] + MOVE C,[440700,,NAMBLK] + SETZ A, +JFN6A: ILDB CH,C + JUMPE CH,JFN6B + SUBI CH,40 + IDPB CH,B + TLNE B,770000 + JRST JFN6A +JFN6B: POP P,CH + POPJ P, + +;;; Convert the JFNBLK spec to a JFN +;;; LH of A is flags, RH of A is pointer to JFN block +;;; B points to file descriptor string, or 0 + +CVJFN: HLLZM A,JFNBLK+.GJGEN ; store flags + HRLI A,0 ; clear left half + GTJFN + POPJ P, ; error + AOS (P) + POPJ P, ; skip return +];TNX + +SUBTTL File Description Storage (FILBLK's) + +TNXSW== +IFN TNXSW,[ +ITSSW== +;VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + +] ;TNXSW + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - ATSIGN TNX filename reader. +; Takes BP in A to ASCIZ string to parse. +; Takes L as ptr to filename block to fill out. +; Clobbers nothing. + + +TNXRFD: +.BEGIN RFDBLK +MAXIND==100. +FL20X==400000 +FLUNRD==200000 +FRCMND==2 +FRNNUL==1 + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +FRFN1==4 +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. +FRARRO==10 + +F=R ; F must not == L. +FF=R+1 +AA=R+2 +T=R+3 +TT=R+4 + INSIRP PUSH P, A B C D F FF AA T TT + SETZ FF, ; set up flags +T20, TLO FF,FL20X + MOVEI F,FB ; Point to scratch FB + MOVEM A,RCHBP ; Save BP to asciz string + SETZM FB + MOVE A,[FB,,FB+1] + BLT A,FB+L$FBLK-1 + PUSHJ P,TRFD + INSIRP POP P, TT T AA FF F D C B + PUSH P,F + MOVEI F,FB + PUSHJ P,CVFSIX ; Convert to sixbit entries + IRP STF,,[DIR,DEV,FN1,FN2] + MOVE A,$F6!STF(F) + MOVEM A,(L).IRPCNT + TERMIN + PUSHJ P,TDIRNM + CAIE A, ; If got a dir number, + SETZM 1(L) ; Zap the device field. + MOVEM A,0(L) ; Else keep it anyway, store result. + POP P,F + + POP P,A +APOPJ: POPJ P, + +; TDIRNM - Given filblk pointed to by F, returns in A the dir # +; for dev/dir combination. Returns 0 if failure. + +TDIRNM: SKIPN A,$FDIR(F) ; Get BP to dir name + POPJ P, ; Not specified, leave all alone. + PUSH P,B +10X,[ + MOVE B,A + SETZ A, + STDIR + SETZ A, ; No match - should never happen + SETZ A, ; ambiguous - ditto +];10X +T20,[ PUSH P,C + SKIPN A,$FDEV(F) ; Device exists? + MOVE A,[440700,,[ASCIZ /PS/]] ; dummy device + SKIPA B,[440700,,STRBUF] + IDPB C,B + ILDB C,A + JUMPN C,.-2 + MOVEI C,": + IDPB C,B + MOVEI C,"< ;> + IDPB C,B + SKIPA A,$FDIR(F) + IDBP C,B + ILDB C,A + JUMPN C,.-2 ;< + MOVEI C,"> + IDPB C,B + SETZ C, + IDPB C,B + MOVSI A,(RC%EMO) ; Want exact match + HRROI B,STRBUF + RCDIR ; Error shouldn't happen + ERJMP [SETZ C, ? JRST .+1] + MOVE A,C ; Get dir # into A + POP P,C +];T20 + POP P,B + POPJ P, + +; TRFD - TENEX-style Filename Reader. +; Takes input from RCH. +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +TRFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN +; PUSHJ P,CMDSW ; Check for switches... +; JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair + POP P,A ; only needs care + IDPB A,FNBWP ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + + +;; Extra stuff to support ATSIGN use of MIDAS code + +.SCALAR LASTCH, RCHBP +RCH: TLZE FF,FLUNRD + SKIPA A,LASTCH + ILDB A,RCHBP + CAIN A, + MOVEI A,^M + MOVEM A,LASTCH + POPJ P, + +GPASST: PUSHJ P,RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + POPJ P, + +] ;IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +FNBUF: block LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +;VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +;PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and +; ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + .VALUE ; sigh + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +.END RFDBLK + +] ;IFN TNXSW + +SUBTTL COMMAND LINE SWITCH PARSER + +FP1SW: TRO F,FR1SW ;JUST ONE SWITCH + JRST FPSW0 + +FPSCL2: PUSHJ P,FPSCLS +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: MOVM A,A + JUMPE B,(H) + JUMPG B,1(H) + MOVN A,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: STRT CRLFZ + JRST ERRDIE + +FPSVAL: STRT [ASCIZ \Bad value for switch: \] + JRST FPSBD1 + +FPSCNF: STRT [ASCIZ \Conflicting switch: \] + JRST FPSBD1 + +SUBTTL MACROS FOR SWITCH DEFINITIONS + +;INSIST ON 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, + +SUBTTL MISC. SWITCHES + +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,,,,FLCREF + 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,,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, + +FPSBS: SWSW FLBS,,,,FLBS + JRST FPSWS + +FPSINS: SWSW FLINSRT,,,,FLINSRT + JRST FPSWS + +FPSMAI: MOVE CH,IP + ILDB CH,CH + CAIN CH,"[ ;] + JRST FPSMAR ;/M[,,,] sets the margins + SWSW (FSMAIN),,,,(FSMAIN) + SETOM EMSWT + JRST FPSWS + +FPSAUX: SWSW (FSAUX),,,,(FSAUX) ;MAKE FILE BE AUXILIARY (LIKE .AUXIL), OR MAKE IT NOT BE. + 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 + +FPSHED: JSP H,FPSNUM ;/-" => NO PER-PAGE HEADING; /n" => LEAVE n LINE WITH NO TEXT, JUST HEADING + MOVEI A,1 + MOVEM A,HEDING + SETOM EHEDING + JRST FPSWS + +FPSSOR: JSP H,FPSNUM ;/0> = > NO SORT; /-> => SORT FILES ON TITLE PAGE; /> => SORT PASS 2 TOO + MOVEI A,1 + MOVEM A,FISORF + SETOM EFISORF + JRST FPSWS + +FPSNOR: SETOM ENORFNM ;/= => STORE USER SPEC'D FILE NAME (INSTEAD OF REAL) IN LREC FILE + SETZM NORFNM + TLNN B,400000 + SETOM NORFNM + 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: setom ECPYUND ; mark as explicitly set + jsp h,FPSNUM ; see if numeric arg + setz a, ; if none, make it zero + movem a,CPYUND ; save it + 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 EFNTVSP + 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 H,FPSNUM ;"P" - SET PAGE TO START LISTING AT. + JRST FPSVAL + MOVEM A,F.MINP(L) + JRST FPSWS + +FPSSBT: SWSW FLSUBT,,,,FLSUBT + JRST FPSWS + +FPSCTL: SWSW FLCTL,,,,FLCTL + JRST FPSWS + +SUBTTL SWITCHES HAVING TO DO WITH SPECIFYING THE LANGUAGE. + +FPSRND: SW ,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: 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 FPSRND ;"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 + +SUBTTL XGP RELATED SWITCHES + +NOXGPRES,[ +FPSXGP: FPSFNT: + STRT [ASCIZ \This @ doesn't support the XGP. /X and /F not allowed.\] + JRST FPSBD2 +];NOXGPRES + +XGPRES,[ +FPSXGP: SWSW FLXGP,,,,FLXGP+FLFNT2+FLFNT3 + JRST FPSWS + +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". + JUMPL A,[SETZM FNTSPC ;/-F turns off FNTSPC + JRST FPSXGP ] + JUMPE 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 B +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,B F D R L FPNTBP CP CC + JRST FPSXGP +];XGPRES + +FPSMAR: SETOM EMARGIN ;M[,,,,] - set margins (in mils) + IBP IP ;SKIP THE OPENBRACKET. + HRLZI B,-5 +FPSMA2: PUSHJ P,FPSGNM + CAIA + MOVEM A,MARGIN(B) + CAIE CH,", + CAIN CH,40 + AOBJN B,FPSMA2 + JRST FPSCL2 + +FPSGNM: PUSHJ P,FPSPSP ;GET A NUMBER + CAIL CH,"0 + CAILE CH,"9 + POPJ P, ;SORRY -- NONE THERE + MOVEI A,-"0(CH) +FPSGN2: ILDB CH,IP + CAIL CH,"0 + CAILE CH,"9 + JRST POPJ1 + IMULI A,10. + ADDI A,-"0(CH) + JRST FPSGN2 + +SUBTTL PRINTING-DEVICE RELATED SWITCHES + +FPSDEV: SKIPN B ;IF THERE IS ANY NUMERIC ARGUMENT, + JUMPE A,FPSDE1 + SETZM QUEUE ;SET QUEUE TO EITHER YES + SKIPE B + SETOM QUEUE ;OR NO. +FPSDE1: MOVE CH,IP ;IS THERE A DEVICE NAME ARGUMENT? + ILDB CH,CH + CAIE CH,"[ ;] + JRST FPSWS + IBP IP ;GOBBLE THE OPEN BRACKET + PUSHJ P,FPSPSP ;PASS SPACES + PUSHJ P,FPS6BT ;READ SIXBIT WORD INTO B + LDB A,[360600,,B] ;1ST CHAR IN A. + CAIN A,'L + JRST FPSLPT ;"L" => LPT +XGP,[ CAIN A,'X + JRST [ MOVEI A,DEVXGP ;"X" => XGP + JRST FPSDV3] + CAIN A,'C + JRST [ MOVEI A,DEVCGP ;"C" => CGP (Canon ersatz XGP) + JRST FPSDV3] +];XGP +ANADEX,[CAIN A,'A ; A => ANADEX + JRST [ MOVEI A,DEVANA + JRST FPSDV4] +];ANADEX +FLORIDA,[CAIN A,'F ; F => FLORIDA + jrst [MOVEI A,DEVFLA + JRST FPSDV4] +];FLORIDA +PRESS,[ CAIE A,'D + JRST FPSDV2 + CAIE CH,40 ;"D" => DOVER + CAIN CH,", + PUSHJ P,FPSPSP + CAIE CH,^M ;[ ;IS THERE AN ORIENTATION SPEC'D? + CAIN CH,"] + JRST FPSPDO ;NO, ASSUME PORTRAIT + PUSHJ P,FPS6BT ;READ SIXBIT WORD INTO B + LDB A,[360600,,B] ;1ST CHAR IN A. + CAIE A,'P + CAIN A,'V + JRST FPSPDO ;"V" (for vertical) and "P" => PORTRAIT + CAIE A,'L + CAIN A,'H + JRST [MOVEI A,DEVLDO ;"H" (for horizontal) and "L" => LANDSCAPE + JRST FPSDV3 ] +];PRESS +FPSDV2: STRT [ASCIZ/Bad printing-device specification: /] + JRST FPSBD1 + +FPSLPT: MOVEI A,DEVLPT + JRST FPSDV4 + +FPSPDO: MOVEI A,DEVPDO +FPSDV3: SW FLXGP +FPSDV4: MOVEM A,DEVICE ;SET PRINTING-DEVICE TYPE + SETOM EDEVICE + MOVE B,LNL(A) ;AND ALSO SET LINEL AND PAGEL, + SKIPN ELINEL ;UNLESS THEY WERE PREVIOUSLY SET EXPLICITLY BY SWITCHES. + MOVEM B,LINEL + MOVE B,PGL(A) + SKIPN EPAGEL + MOVEM B,PAGEL + JRST FPSCL2 + +SUBTTL GOBBLE SIZE INFO FROM FONT FILES + +XGPRES,[ +;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. +PRESS,[ MOVE A,DEVICE ;FONT NAMES FOR THE DOVER ARE NOT FILENAMES. + SKIPGE FRCXGP(A) ;THERE IS A DIFFERENT WAY OF READING THEM. + JRST FPSDF +];PRESS +NOXGP, POPJ P, +XGP,[ 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 FNTID(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 FNTNON ;SPECIFY IT AS DEVICE "NONE:" + 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,.BII + MOVEI A,(L) ;OPEN THE FONT FILE, IN IMAGE MODE. + PUSHJ P,2INOPN + JRST 1+[JRST FPSFN4 + FLOSE UTIC,FNTSNM(L) + JFCL CPOPJ ] + PUSH P,IP ;READ IN A LARGE AMOUNT OF IT. + PUSHJ P,2RDAHD + PUSHJ P,DOINPT + JRST POPIPJ + POP P,IP + MOVS CC,FNTFN2(L) + CAIN CC,'FNT + JRST FPSFN6 + CAIN 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. +FPSFNE: FLOSEI FLSFNT,FNTSNM(L) + JFCL CPOPJ ;IF HE DOESN'T, RETURN. + +FPSFN5: MOVE CC,INBFR+2 ;KST FILE: ITS OR CMU? + TRNE CC,1 + JRST FPSFN9 + CAIE CC,2 ;MAKE SURE IT IS REALLY NEW CMU + JRST FPSFNE + SKIPLE CC,INBFR + MOVEM CC,FNTID(L) + SKIPA A,[177] ;SEARCH FOR CHAR WITH MAX INCR +FPSFN8: CAMGE R,INBFR+10.(A) + MOVE R,INBFR+10.(A) + SOJGE A,FPSFN8 + HLRZ R,R ;USE MAX INCR AS WIDTH OF FONT + MOVE CC,INBFR+1 ;GET FONT HEIGHT + MOVE A,INBFR+2 ;GET FONT BASELINE + JRST FPSFN7 + +FPSFN9: HRRZ CC,INBFR+1 ;ITS 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, + +POPIPJ: POP P,IP + POPJ P, +];XGP + +FNTNON: SETZM FNTSNM(L) ;HE SAID "NONE" -- CLEAR THE FONT + SETZM FNTDEV(L) + SETZM FNTFN1(L) + SETZM FNTFN2(L) + SETZM FNTSIZ(L) + SETOM FNTID(L) + POPJ P, +];XGPRES + +PRESS,[ + +;READ IN A FONT NAME FOR PRESS FILE USE. +;THESE FONT NAMES ARE NOT FILE NAMES. THEY CONTAIN +;A FAMILY NAME, A FACE CODE, AND A POINT SIZE. +;WE STORE THE FAMILY NAME IN 3 WORDS OF SIXBIT (FNTSNM - FNTFN1) +;AND THE FACE CODE,,POINT SIZE IN FNTFN2. +;L INDEXES THE FONT WE ARE READING. +;RETURN ON FINDING A COMMA, CLOSEBRACKET, OR CONTROL CHARACTER. +FPSDF: PUSHJ P,FPSPSP ;SKIP ANY LEADING SPACES. ;[ + CAIE CH,"] ;IF THE FIRST NONSPACE IS A TERMINATOR, + CAIN CH,", ;THIS FONT IS NOT BEING SPECIFIED. + POPJ P, ;LEAVE IT ALONE. + CAIG CH,40 + POPJ P, + SETZM FNTSNM(L) + SETZM FNTDEV(L) + SETZM FNTFN1(L) + SKIPA A,[440600,,FNTSNM(L)] ;STUFF FAMILY NAME DOWN THIS BP. +FPSDF1: ILDB CH,IP + CAIL CH,"0 ;THE FAMILY NAME SHOULD BE ENDED BY A DIGIT. + CAILE CH,"9 + CAIN CH,40 ;OR SPACES AND THEN A DIGIT + JRST FPSDF2 + CAIL CH,40 ;[ + CAIN CH,"] ;IF WE FIND A NAME TERMINATOR, BARF, SINCE + JRST FPSDFL ;THERE OUGHT TO BE A POINT SIZE HERE. + CAIN CH,", + JRST FPSDFL + CAIGE CH,140 + ADDI CH,40 + CAME A,[000600,,FNTFN1(L)] + IDPB CH,A + JRST FPSDF1 + +;FOUND END OF FAMILY NAME. +FPSDF2: CAIN CH,40 + PUSHJ P,FPSPSP + CAIL CH,"0 + CAILE CH,"9 + JRST FPSDFL ;ERROR IF THE NEXT THING IS NOT A SIZE +;NOW READ IN THE POINT SIZE + TDZA A,A ;ACCUMULATE DECIMAL NUMBER IN A. +FPSDF4: IMULI A,10. + ADDI A,-"0(CH) + ILDB CH,IP + CAIL CH,"0 + CAILE CH,"9 ;STOP AND STORE THE NUMBER AT FIRST NON-DIGIT + CAIA + JRST FPSDF4 + MOVEM A,FNTFN2(L) +;NOW ALL CHARACTERS BEFORE THE NEXT SPACE OR TERMINATOR SHOULD BE THE FACE CODE. + SETO A, ;ACCUMULATE THE FACE CODE AS ZERO BITS IN A. + CAIN CH,40 +FPSDF3: PUSHJ P,FPSPSP + CAIL CH,40 ;[ + CAIN CH,"] ;CHECK FOR A TERMINATOR. + JRST FPSDF5 ;IF WE FIND ONE, STORE WHAT WE GOT. + CAIN CH,", + JRST FPSDF5 + CAIL CH,140 + SUBI CH,40 + CAIN CH,"E ;THE CHARACTERS "ECILB" SET BITS IN A. + TRZ A,1 ;"E" MEANS EXTENDED, "C" MEANS COMPRESSED, + CAIN CH,"C + TRZ A,2 + CAIN CH,"I ;"I" MEANS ITALIC, + TRZ A,4 + CAIN CH,"L ;"L" MEANS LIGHT, "B" MEANS BOLD. + TRZ A,10 + CAIN CH,"B + TRZ A,20 + JRST FPSDF3 + +FPSDF5: TRNE A,3 ;EXTENDED COMPRESSED IS AN ERROR, + TRNN A,30 ;AS IS LIGHT BOLD + JRST FPSDFC + SETZ B, + TRNN A,1 ;TURN BITS IN A INTO XROX FACE CODE IN B. + ADDI B,12. + TRNN A,2 + ADDI B,6 + TRNN A,4 + ADDI B,1 + TRNN A,10 + ADDI B,4 + TRNN A,20 + ADDI B,2 + HRLM B,FNTFN2(L) ;STORE FACE CODE. +;HERE AT END OF SO-FAR VALID FONT NAME, HAVING SKIPPED ANY SPACES. + SETOM EFNTF ;FONTS HAVE BEEN EXPLICITLY SPECIFIED + SETOM FNTID(L) ;THIS FONT HAS BEEN EXPLICITLY SPECIFIED. + CAIE CH,", ;[ + CAIN CH,"] ;SHOULD NOW HAVE REACHED VALID TERMINATOR. + POPJ P, + STRT [ASCIZ /Garbage in font name: /] + JRST FPSBD1 + +;HERE IF FONT NAME IS ENDED AT THE END OF THE FAMILY NAME (POINT SIZE MISSING). +;IT MIGHT STILL BE LEGAL, IF THE NAME IS "NONE". +FPSDFL: MOVE A,FNTSNM(L) + CAME A,[SIXBIT/NONE/] ;ALLOW SPECIFICATION OF FONT "NONE" TO + CAMN A,[SIXBIT/NONE:/] ;ELIMINATE THE SPECIFICATION OF THIS FONT. + JRST FNTNON + STRT [ASCIZ /No point size in font name: /] + JRST FPSBD1 + +FPSDFC: STRT [ASCIZ /Self-contradictory face code in font name: /] + JRST FPSBD1 + +];PRESS + +SUBTTL SWITCH DISPATCH TABLE + +;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 ;! /-! => KEEP MISSING FILES; /1! => LOSE THEM; /0! => KEEP AFTER ASKING + FPSHED ;" /-" => SET SPACE DEVOTED TO PER-PAGE HEADINGS + FPSNLN ;# SUPPRESS LINE NUMBERS WITHIN PAGE + 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 10., FPSDIG ;0-9 + FPSAUX ;: MAKE THIS FILE AUXILIARY. +REPEAT 2, FPSBAD ;; < + FPSNOR ;= NO REAL FILENAMES IN LREC + FPSSOR ;> SORT FILE NAMES + FPSBAD ;? + FPSLRC ;@ LREC FILE(S) + FPSARB ;A ARBITRARILY LONG SYMBOLS + FPSBAD ;B + FPSCRF ;C MAKE CREF TABLE AT END OF LISTING. + FPSDEV ;D SPECIFY PRINTING DEVICE AND WHETHER TO QUEUE + FPSDBL ;E CROSS FILE REFS ABBREVIATED FILE NAME + FPSFNT ;F SPECIFY FONTS + FPSUSF ;G GO THROUGH LREC FILE TO .INSRT FILES MENTIONED. IMPLIES /@. + FPSBS ;H /H => ^H OUT AS REAL BACKSPACE; /-H => OUTPUT AS UPPARROW-H + FPSINS ;I /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). + ; OR SET MARGINS + 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 /U => /-U => UNIVERSAL 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. +NOITS, 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) +FPDEF2: 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 FPDEF3 ] + PUSHJ P,FPDFN2 ;OTHERWISE, DEFAULT THE FN2 IF NECESSARY, AND OPEN THE FILE. + JRST 1+[JRST FPDEF2 + FLOSE UTIC,F.ISNM(A) + JFCL ERRDIE] ; Was FPDEF3, but needs a real file for + ; FPRCHS to have any hope of working! +FPDEF3: MOVE CH,[UTIC,,CHSTAT] + PUSHJ P,FPRCHS ;DO .RCHST, SET UP F.RDEV, ETC. +DOS, CLOSE UTIC,20 ;ON TOPS-10, TRY TO SAVE THE NAME BLOCKS, ETC. +TNX, .CLOSE UTIC, +ITS,[ .CLOSE UTIC, + MOVE CH,F.RFN2(A) + CAMN CH,OPTFN2+DEVIXG ;IF FOO > TURNS OUT TO BE FOO @XGP, THE LUSER IS LOSING. + JRST 1+[JRST FPDEF2 ;IF HE RESPECIFIES IT, GO PROCESS WHAT HE GAVE. + FLOSEI FLSOIN,F.ISNM(A) + JFCL ERRDIE ] ;IF HE REFUSES, COMMIT SUICIDE. +];ITS +FPDEF1: ADDI A,LFBLOK ;OUTPUT FN2 WILL BE DEFAULTED IN 2LOOP + 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,.BAI ;USE ASCII BLOCK INPUT FOR OUR OPENS. + SKIPE F.IFN2(A) + JRST FPDFN3 +NOITS,[ PUSHJ P,2INOPN ;TRY NULL EXTENSION, THEN TRY THE DEFAULT. + CAIA + JRST POPJ1 ;NULL WORKED, SO RETURN -- FILE ALREADY OPEN. + MOVE H,CODTYP + MOVE H,IPTFN2(H) ;NOITS, DEFAULT FN2 IS APPROPRIATE TO LANGUAGE. +];NOITS +ITS,[ SKIPN TEXGPP + 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-LFBLOK +FPDLN3: ADDI A,LFBLOK + SKIPN ECODTYP +FPDLN0: CAML A,SFILE + JRST DECODT + 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. + JRST DECODT + JRST DECODT +];ITS +NOITS,[ MOVEI R,CODMAX-1 ;BOTS, FN2 = MID IMPLIES MIDAS (CODMID), ETC. +FPDLN1: CAMN H,IPTFN2(R) + JRST FPDLN2 + SOJGE R,FPDLN1 + JRST FPDLN3 +];NOITS +FPDLN2: MOVEM R,CODTYP ;HERE TO STORE THE DETERMINED CODTYP AND SAY IT WAS SPECD. + XCT FPDLNT(R) ;GET SWITCH DEFAULTS FOR THAT CODTYP. + JRST DECODT ;SKIPS ONLY FOR CODTXT + SKIPN ENXFDSP + SETOM NXFDSP ;THEN WE ALSO WANT /-! +XGP, TLO F,FLXGP ;AND /X +DECODT: SKIPL R,CODTYP ;SET THE DECODED LANGUAGE FLAGS + CAIL R,CODMAX + .VALUE + XCT MAPCOD(R) + POPJ P, + + +;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\FLASCI +CODM10:: JFCL +CODUCO:: TLO F,FLARB +CODTXT:: CAIA +CODMDL:: TLO F,FLARB\FLASCI +CODDAP:: JFCL +CODMAX:: OFFSET 0 + + +;THIS TABLE CONTAINS THE CODE TO SET THE DECODED LANGUAGE FLAGS. +MAPCOD: OFFSET -. +CODMID:: JFCL +CODRND:: HRRZM P,TEXTP +CODFAI:: SETOM FAILP +CODP11:: SETOM PALX11 +CODLSP:: JFCL +CODM10:: HRRZM P,FAILP +CODUCO:: JFCL +CODTXT:: SETOM TEXTP +CODMDL:: JFCL +CODDAP:: SETOM DAPXP +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,.BAI + 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 + +;DEDUCE SOME THINGS FROM THE SWITCH SETTINGS, +;DEFAULT SOME SWITCHES FROM EACH OTHER, ETC. +;AFTER ALL OTHER SOURCES OF INFORMATION ARE EXHAUSTED, INCL. LREC FILE. + +FPDDED: MOVE A,DEVICE ;FIX UP DEVICE AS NEEDED + SKIPN EDEVICE + SKIPE LNLDOT(A) ;IF OUR DEFAULT (NOT SPECIFIED) IS A CHARACTERS-ONLY DEVICE + JRST FPDDE1 +XGP,[ TLNN F,FLXGP ;BUT /X IS SPECIFIED, + JRST FPDDE1 + MOVEI A,DEVXGP ;THEN USE THE XGP. + MOVEM A,DEVICE +];XGP +FPDDE1: SKIPG B,FRCXGP(A) ;IF THE DEVICE IS XGP + JRST FPDDE2 + HRREM B,XGPP + SKIPGE TEXTP ;IF /L[TEXT] + SETOM TEXGPP ;SET FLAG FOR SPECIAL MODE OF PARSING XGP FILES. +FPDDE2: +PRESS,[ JUMPGE B,FPDDE3 + HRREM B,PRESSP + SKIPGE TEXTP + JRST [ STRT [ASCIZ */L[Text]/D[Dover] is not implemented yet. +*] + JRST ERRDIE] + SETOM FNTSPC ;FOR THE DOVER, FONTS ARE ALWAYS "EXPLICITLY SPECIFIED". +CMU, MOVE A,[SIXBIT/SAILA/] +TNX, MOVE A,[SIXBIT/SAIL/] +SAI, MOVE A,[SIXBIT/SAIL/] +NOCMU,NOSAI,NOTNX,MOVSI A,(SIXBIT /LPT/) + MOVEI B,8. + MOVEI L,FNTF0 +FPDDE4: CAIN L,FNTF0+FNTFL + TLNE F,FLFNT2+FLFNT3 + CAIN L,FNTF0+2*FNTFL + TLNE F,FLFNT3 + SKIPE FNTSNM(L) ;DEFAULT EACH UNSPECIFIED FONT WHICH IS IN USE + JRST FPDDE5 + MOVEM A,FNTSNM(L) + SETZM FNTDEV(L) + SETZM FNTFN1(L) + MOVEM B,FNTFN2(L) + SETOM FNTID(L) ;PRETEND FONT WAS EXPLICITLY SPEC'D + SETOM EFNTF ;SO THAT WE READ THE WIDTH FROM THE FONTS WIDTHS FILE. +FPDDE5: ADDI L,FNTFL + CAIE L,FNTFE + JRST FPDDE4 +FPDDE3: +];PRESS + POPJ P, + +;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. + SETZM F.CRDT(A) + HLRZS CH +ITS,[ SYSCAL RFNAME,[ CH ? %CLOUT,,F.RDEV(A) ? %CLOUT,,F.RFN1(A) + %CLOUT,,F.RFN2(A) ? %CLOUT,,F.RSNM(A)] + .LOSE %LSFIL +;; NOW GET THE FILE CREATION DATE. + SYSCAL RFDATE,[ CH ? %CLOUT,,F.CRDT(A)] + JFCL +];ITS +TNX,[ + PUSH P,A ? PUSH P,B ? PUSH P,C ? PUSH P,D + PUSH P,L + MOVEI L,F.RSNM(A) ; Set up pointer + MOVE A,JFNCHS(CH) ; Get JFN for channel + CALL UNJFN ; Store in 6bit + POP P,L +T20, MOVE B,[1,,.FBCRE] ; Get day/time of last write to file +10X, MOVE B,[1,,.FBWRT] ; This is 10X equivalent. + MOVEI C,F.CRDT + ADD C,-3(P) ; F.CRDT(A) + GTFDB ; Get GTAD format creation date + POP P,D ? POP P,C ? POP P,B ? POP P,A +] + +DOS,[ LSH CH,LGEXTL + 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 ;If DSKCHR fails, then B still contains the .RBDEV + MOVE B,STRINF+.DCSNM +];NOSAI + MOVEM B,F.RDEV(A) +];DOS + 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 + +SUBTTL FILE NAME SORTING + +;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 + SETZM 1(P) + SKIPN FISORF + POPJ P, +;NOW BUBBLE-SORT THE TABLE. + HLRZ C,B +FISOR4: JUMPE C,CPOPJ + SETZ C, ;MAKE ANOTHER BUBBLE-SORT PASS: + MOVEI B,FILSRT ;B SCANS THRU, C GETS -1 IF WE MADE AN EXCHANGE THIS PASS. +FISOR3: SKIPE A,(B) ;LOOP POINT WITHIN ONE PASS. + SKIPN D,1(B) ;REACHED LAST POINTER IN TABLE? + JRST FISOR4 ;YES, CHECK FOR ANOTHER PASS + MOVE L,F.IFN1(A) ;GET THIS FILE'S FN1 AND NEXT FILE'S. + MOVE CH,F.IFN1(D) + CAMN L,CH ;IF FN1 MATCHES + SKIPA L,F.IFN2(A) ;THEN SORT ON BASIS OF FN2 + CAIA + MOVE CH,F.IFN2(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 + +SUBTTL COMPUTE WIDTH & HEIGHT FROM FONT SIZE INFO + +;COME HERE AFTER READING INPUT LREC FILES. DO NOTHING IF NOT FNTSPC. +;COMPUTE THE DEFAULT PAGE AND LINE SIZE FROM THE CHARACTERISTICS +;OF THE FONTS. +FNTCPT: +IFGE NFNTS-2,[ + SKIPE FNTSNM+FNTF0+FNTFL ;IF FONT 2 HAS BEEN SPEC'D, + TLO F,FLFNT2 ;WE OUGHT TO USE IT. +];IFGE NFNTS-2 +IFGE NFNTS-3,[ + SKIPE FNTSNM+FNTF0+2*FNTFL + TLO F,FLFNT2+FLFNT3 ;I DON'T THINK IT WORKS TO USE 3 BUT NOT 2. +];IFGE NFNTS-3 + ;NOTE THAT THIS UPDATED INFO IN F DOES NOT GO IN THE LREC OUTPUT FILE. + +REPEAT NFNTS,[ ;HAVE ANY OF THE FONTS BEEN SPECIFIED? + SKIPN FNTSNM+FNTF0+.RPCNT*FNTFL + SKIPE FNTFN1+FNTF0+.RPCNT*FNTFL + JRST FNTCP2 +];REPEAT NFNTS + SETZM FNTSPC ;NO - SAY SPECIFIED FONT NAMES ARE NO LONGER IN USE. + ;THIS IS SO IF THE USER UN-SPECIFIES ALL FONTS WITH NONE: + ;@ WILL CEASE BELIEVING THAT FONT FILE NAMES HAVE BEEN SPEC'D. +PRESS,[ SKIPE PRESSP ;IF WE ARE ON A DOVER + .VALUE ;DIE A HORRIBLE DEATH WITHOUT FONTS +];PRESS + POPJ P, + +FNTCP2: +PRESS,[ SKIPE PRESSP ;IF PRESS FILE, COMPUTE FONT WIDTHS FROM FONTS WIDTHS FILE. + PUSHJ P,FWIDTH +];PRESS + MOVSI A,-NFNTS ;FIRST, COMPUTE MAX WIDTH OF FONTS, AND MAX HEIGHT. +FNTCP3: SKIPN B,FNTSIZ+FNTF0(A) + JRST FNTCP4 ;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 +FNTCP4: ADDI A,FNTFL-1 + AOBJN A,FNTCP3 + 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. + MOVE B,DEVICE + SKIPE EDEVICE + JRST FNTCP5 + SKIPN EMARGIN + SKIPE EFNTF ;IF DEVICE OR MARGINS OR FONTS WERE EXPLICITLY SPEC'D, +FNTCP5: SKIPE ELINEL ;AND LINEL WASN'T, COMPUTE LINEL FROM FONT WIDTH. + JRST FNTCPL + MOVN C,MARG.L ;GET MARGINS + SUB C,MARG.R + CAIE B,DEVLDO ;for most devices + SUB C,MARG.H ;the holes are at the left + IMUL C,DOTPIH(B) ;CONVERT TO NEGATIVE RASTER POINTS. + IDIVI C,1000. + ADD C,LNLDOT(B) ;AND GET THE NUMBER OF POINTS WE HAVE TO WORK WITH +;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 D,NTABS + LSH D,3 + MOVE L,D + IMUL D,FNTWDN ;GET TOTAL LINEL, MINUS AMOUNT OF SPACE WE NEED FOR + SUB C,D ;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 EDEVICE + SKIPE EMARGIN + JRST FNTCP6 + SKIPN EFNTVSP ;IF DEVICE OR MARGIN OR VSP WAS JUST EXPLICITLY SPEC'D + SKIPE EFNTF ;OR FONTS WERE, +FNTCP6: SKIPE EPAGEL ;BUT PAGEL WASN'T, + JRST FNTCPP + MOVN C,MARG.T ;GET MARGINS + SUB C,MARG.B + CAIN B,DEVLDO ;for /D[Dover Landscape] + SUB C,MARG.H ;the holes are at the top + IMUL C,DOTPIV(B) ;CONVERT TO NEGATIVE RASTER POINTS. + IDIVI C,1000. + ADD C,PGLDOT(B) ;AND GET THE NUMBER OF POINTS WE HAVE TO WORK WITH + MOVE D,FNTVSP ;GET THE "LEADING" BETWEEN LINES +PRESS,[ SKIPE PRESSP ;FOR THE DOVER + IMULI D,13. ;USE A KLUDGE TO FUDGE IT TO MICAS +];PRESS + ;COMPUTE PAGEL FROM FONTS AND VSP. + ADD C,D ;ASSUME 1ST LINE VSP IS IGNORED, SO RECLAIM IT + ADD D,FNTHGT ;FIND TOTAL POINTS PER LINE +;;; ADD C,FNTBAS ;WHAT THE FUCK WAS THIS FOR???? + IDIV C,D ;FIND # WHOLE LINES THAT WILL FIT + MOVEM C,PAGEL +FNTCPP: POPJ P, + +PRESS,[ + +;GET THE WIDTHS OF THE FONTS FROM THE FONT WIDTHS FILE. +FWIDTH: MOVE A,DEVICE ;WE ARE ALWAYS CALLED, BUT DO NOTHING + SKIPL FRCXGP(A) ;UNLESS WE WILL BE WRITING PRESS FILES. + POPJ P, + MOVEI R,.BII + MOVEI A,FWIDFL ;OPEN THE FONT FILE, IN IMAGE MODE. + PUSHJ P,2INOPN + FLOSE UTIC,FWIDFL + JFCL ERRDIE + EXCH DP,LRCPTR + PUSH P,DP ;BEFORE WE READ IN THE FILE, ARRANGE TO FLUSH IT LATER. +;READ THE ENTIRE FILE INTO THE DATA AREA. +ITS,[ AOBJN DP,FWIDR2 ;TURN DP INTO AOBJN PTR TO SPACE LEFT. +FWIDR: SUB DP,[1,,1] ;NEED MORE SPACE - TURN IT BACK TO A PDL PTR + PUSHJ DP,.+1 ;CAUSE PDLOV INT THAT ALLOCATES MORE SPACE. +FWIDR2: .IOT UTIC,DP ;READ AS MUCH AS WE HAVE SPACE FOR + JUMPGE DP,FWIDR ;REACHED EOF? IF NOT, JUMP. + SUB DP,[1,,1] ;TURN DP BACK TO PDL POINTER. +];ITS +TNX,[ + AOBJN DP,FWIDR2 ;TURN DP INTO AOBJN PTR TO SPACE LEFT. +FWIDR: SUB DP,[1,,1] ;NEED MORE SPACE - TURN IT BACK TO A PDL PTR + PUSHJ DP,.+1 ;CAUSE PDLOV INT THAT ALLOCATES MORE SPACE. +FWIDR2: + PUSH P,A ? PUSH P,B ? PUSH P,C + HLRO C,DP ; Get neg count + MOVEI B,(DP) ; Get destination addr + HRLI B,444400 ; Make it a word bp + MOVE A,JFNCHS+UTIC + SIN ; Perhaps should handle SIN errors? + ERJMP .+1 ; Assume any error is EOF. + MOVEI DP,(B) ; Put back updated addr + CAIL B, ; but if BP isn't 444400, then + ADDI DP,1 ; really pointing to next word. + HRL DP,C ; Put back updated count + POP P,C ? POP P,B ? POP P,A + JUMPGE DP,FWIDR ;REACHED EOF? IF NOT, JUMP. + SUB DP,[1,,1] ;TURN DP BACK TO PDL POINTER. +];TNX +DOS,[ +FWIDR: SOSGE D,INHED+2 + JRST FWIDR3 +FWIDR2: ILDB R,INHED+1 ;MAYBE THIS SHOULD USE A BLT (AND A DUMMY PUSH) + PUSH DP,R ; AS IN RLRRL and PRSINA + SOJGE D,FWIDR2 +FWIDR3: PUSHJ P,INSOME + JRST FWIDR +];DOS + .CLOSE UTIC, + +;NOW PROCESS THE THREE FONTS ONE AT A TIME. + MOVEI L,FNTF0 +FWIDF: SKIPN FNTSNM(L) + JRST FWID9 + MOVE A,(P) + HRLI A,002000 ;A GETS B.P. TO ILDB THROUGH THE FILE. + SETOB R,SLBUF ;WHEN WE LEARN THE FAMILY CODE, PUT IT IN R. + ;IF WE FIND A SCALEABLE FONT ON THE WAY< PUT IT IN SLBUF +FWID1: ILDB CH,A ;READ THRU THE "IXN" ENTRIES TO ASSOCIATE + LSH CH,-12. + CAIE CH,1 ;FAMILY CODES WITH EACH OF THE FAMILIES WE HAVE. + JRST FWID6 + ILDB D,A ;GET FAMILY CODE OF THIS ENTRY. + TLC A,003000 ;READ 8-BIT BYTES FOR A WHILE + IBP A ;IGNORE THE SIZE OF THE FAMILY NAME, WE DON'T NEED IT. + MOVEI B,19. + MOVE C,[440600,,SLBUF+1] +FWID3: ILDB CH,A ;COPY THE NAME OF THIS ENTRY'S FAMILY INTO SLBUF+1. + SKIPE CH ;TURN IT INTO SIXBIT AT THE SAME TIME. + SUBI CH,40 + IDPB CH,C + SOJG B,FWID3 + TLC A,003000 ;SWITCH BACK TO 16-BIT BYTES + MOVE B,FNTSNM(L) ;COMPARE EACH FAMILY NAME WE ARE USING + CAME B,SLBUF+1 ;WITH THE FAMILY NAME IN THE IXN ENTRY. + JRST FWID1 ;NOTE WE IGNORE THE LAST CHARACTER. WE ONLY HAVE 18 + MOVE B,FNTDEV(L) ;CHARACTERS OF FONT NAME DATA. + CAME B,SLBUF+2 + JRST FWID1 + MOVE B,FNTFN1(L) + CAME B,SLBUF+3 + JRST FWID1 + MOVE R,D ;NAMES MATCH. SAVE FAMILY CODE IN THIS FONT'S DATA + JRST FWID1 ;NOW LOOK AT NEXT "IXN" ENTRY. + +FWID2: ILDB CH,A ;NOW LOOK AT TYPE 4 ENTRIES + LSH CH,-12. +FWID6: CAIE CH,4 ;IF WE RUN OUT, WE ARE LOSING, SINCE ONE SHOULD APPLY. + JRST [ SKIPL CH,SLBUF ;UNLESS THERE WAS A SCALEABLE FONT + JRST [ HRRZ D,FNTFN2(L) ;IN WHICH CASE USE IT + IMULI D,2540. + JRST FWID8 ] + STRT [ASCIZ /Undefined Dover font: /] + MOVE A,[TYO CH] + PUSHJ P,PRSPFN + JRST ERRDIE ] + TLC A,003000 ;READ 8-BIT BYTES FOR A WHILE + ILDB B,A ;FAMILY CODE + ILDB C,A ;FACE CODE + ILDB CH,A ;FIRST CHARCTER NUMBER IN FONT + MOVEM CH,SLBUF+1 + ILDB CH,A ;LAST CHARACTER NUMBER IN FONT + MOVEM CH,SLBUF+2 + TLC A,003000 ;SWITCH BACK TO 16-BIT BYTES + ILDB CH,A ;SIZE OF FONT DESCRIBED BY THIS ENTRY. + MOVEM CH,SLBUF+3 + ILDB CH,A ;ROTATION OF FONT DESCRIBED BY THIS ENTRY. + MOVEM CH,SLBUF+4 + ILDB D,A ;START ADDR OF SEGMENT WHICH CONTAINS DATA ON THIS FONT. + ILDB CH,A ; (IT'S A DOUBLE WORD) + LSH D,16. + IOR CH,D +IFN 0,[ IBP A ? IBP A ] ;WE SKIP THE SEGMENT LENGTH IN THE AOJA'S BELOW + CAMN R,B ;COMPARE FAMILY CODE -- IT MUST MATCH + SKIPE SLBUF+4 ;DON'T GET FOOLED BY ROTATED FONTS + AOJA A,FWID2 ;KEEP LOOKING IF NO MATCH + HLRZ B,FNTFN2(L) + CAME B,C ;FACE CODE MUST ALSO MATCH. + AOJA A,FWID2 + SKIPN B,SLBUF+3 ;IS IT A SCALABLE ENTRY? + JRST [ MOVEM CH,SLBUF ;IF SO, SAVE IT FOR LATER + AOJA A,FWID2 ] ;IN CASE THERE IS NOTHING BETTER + IMULI B,72. ;CONVERT SIZE IN ENTRY FROM MICAS TO POINTS, + ADDI B,1270. ;ROUNDING TO NEAREST POINT. + IDIVI B,2540. + CAME B,FNTFN2(L) ;SIZE IN ENTRY MUST EQUAL SPECIFIED, + AOJA A,FWID2 + MOVEI D,72000. ;DUMMY SCALING FACTOR FOR ABSOLUTE FONT SIZES +FWID8: LDB A,[014300,,CH] + ADD A,(P) + HRLI A,002000 ;A NOW POINTS TO ILDB START OF CORRECT WORD + TRNE CH,1 + IBP A ;MAKE IT THE RIGHT ALTO-WORD ALSO. + +;WE MUST NOW READ OUT THE WIDTHS FROM THE DATA SEGMENTS. + IBP A ;READ THE BOUNDING BOX INFO. + ILDB B,A ;THE SECOND WORD OF IT IS THE BASELINE DEPTH (NEGATIVE). + TRNE B,100000 + ORCMI B,77777 ;EXTEND THE SIGN + IMUL B,D ;AND CONVERT THE BASELINE TO MICAS + IDIV B,[-72000.] + MOVE CH,B ;SAVE IT FOR LATER + IBP A + ILDB B,A ;FOURTH WORD OF BOUNDING BOX IS THE HEIGHT ABOVE BASELINE. + IMUL B,D ;CONVERT HEIGHT TO MICAS + IDIVI B,72000. + TDNN B,[-1000] + TDNE CH,[-1000] ;LOSE IF EITHER EXCEEDS 9 BITS. + .VALUE + LSH CH,9. + IORI CH,(B) + HRLZM CH,FNTSIZ(L) ;STORE THE HEIGHT AND THE BASELINE POSITION. + ILDB CH,A ;READ IN THE FLAGS WORD. + TRNE CH,100000 + JRST [ ILDB B,A ;FOR FIXED-WIDTH FONT, JUST GET WIDTH. + JRST FWIDW] +IFN 0,[ + SKIPN EFNTF ;IF FONTS WERE SPECIFIED THIS TIME, + JRST FWIDW2 + STRT [ASCIZ /Warning: font /] + PUSH P,A ;WARN ABOUT ANY VARIABLE-WIDTH FONTS. + PUSH P,B + MOVE A,[TYO CH] + PUSHJ P,PRSPFN + POP P,B + POP P,A + STRT [ASCIZ / is variable width. +/] +];END IFN 0 +FWIDW2: MOVE C,SLBUF+1 ;ELSE READ PAST THE WIDTHS OF ALL THE CHARACTERS +FWIDW1: ILDB CH,A + CAIN C,40 ;SAVING THE ONE FOR SPACE. + MOVE B,CH + CAMGE C,SLBUF+2 ;STOP WHEN WE HAVE PROCESSED ALL THE CHARACTERS. + AOJA C,FWIDW1 +FWIDW: IMUL B,D ;CONVERT WIDTH TO MICAS + IDIVI B,72000. + HRRM B,FNTSIZ(L) ;STORE THE WIDTH OF THE FONT. +FWID9: ADDI L,FNTFL ;ADVANCE TO NEXT FONT. + CAIE L,FNTFE + JRST FWIDF + POP P,A ;NOW FIND (NEGATIVE OF) NUMBER OF WORDS IN DATA AREA FOR THE FILE + SUBI A,(DP) + HRLI A,-1(A) ;AND BACK UP DP TO FREE THEM ALL. + ADD DP,A + EXCH DP,LRCPTR + POPJ P, +];PRESS + +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,.BII ;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 +TNX,[ + PUSH P,A ? PUSH P,B + MOVE A,JFNCHS+UTIC + BIN ; Read 1st word (maybe do error checking?) + ERJMP [POP P,B ? POP P,A + RET] + MOVE R,B + POP P,B ? POP P,A +];TNX +DOS,[ PUSHJ P,INSOME ;GET FIRST BUFFER FULL + SOSGE INHED+2 + POPJ P, ;EMPTY FILE => FORGET IT + ILDB R,INHED+1 +];DOS + 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,[ AOBJN DP,RLRRL2 ;TURN DP INTO AOBJN PTR TO SPACE LEFT. +RLRRL: SUB DP,[1,,1] ;NEED MORE SPACE - TURN IT BACK TO A PDL PTR + PUSHJ DP,.+1 ;CAUSE PDLOV INT THAT ALLOCATES MORE SPACE. +RLRRL2: .IOT UTIC,DP ;READ AS MUCH AS WE HAVE SPACE FOR + JUMPGE DP,RLRRL ;REACHED EOF? IF NOT, JUMP. + SUB DP,[1,,1] ;TURN DP BACK TO PDL POINTER. +];ITS +TNX,[ + AOBJN DP,RLRRL2 ;TURN DP INTO AOBJN PTR TO SPACE LEFT. +RLRRL: SUB DP,[1,,1] ;NEED MORE SPACE - TURN IT BACK TO A PDL PTR + PUSHJ DP,.+1 ;CAUSE PDLOV INT THAT ALLOCATES MORE SPACE. +RLRRL2: + PUSH P,A ? PUSH P,B ? PUSH P,C + HLRO C,DP ; Get neg count + MOVEI B,(DP) ; Get destination addr + HRLI B,444400 ; Make it a word bp + MOVE A,JFNCHS+UTIC + SIN ; Perhaps should handle SIN errors? + ERJMP .+1 ; Assume any error is EOF. + MOVEI DP,(B) ; Put back updated addr + CAIL B, ; but if BP isn't 444400, then + ADDI DP,1 ; really pointing to next word. + HRL DP,C ; Put back updated count + POP P,C ? POP P,B ? POP P,A + JUMPGE DP,RLRRL ;REACHED EOF? IF NOT, JUMP. + SUB DP,[1,,1] ;TURN DP BACK TO PDL POINTER. +];TNX +DOS,[ +RLRRL: SOSGE D,INHED+2 + JRST RLRRL3 +RLRRL2: ILDB R,INHED+1 + PUSH DP,R + SOJGE D,RLRRL2 +RLRRL3: PUSHJ P,INSOME + JRST RLRRL +];DOS + .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,IPTFN2 ;IF /L[TEXT], FN2 ISN'T A VERSION #, SO LET USER SPECIFY IT + SKIPL TEXGPP ;AND REMEMBER IT FROM THE LREC FILE. + 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 + IFE *,[ ;LINEL AND PAGEL ARE OVERRIDDEN IF DEVICE WAS CHANGED. + SKIPE EDEVICE + JRST .+3 + ] + 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 +;FIX UP OBSOLETE VALUES OF VARIABLE "QUEUE". + SKIPG QUEUE .SEE QU.GLD + JRST RLRRP1 + SETZM QUEUE + MOVEI R,DEVGLD + SKIPN EDEVICE + MOVEM R,DEVICE +RLRRP1: AOBJP D,RLRRS ;NEXT WORD IN LR.PSW IS A WORD OF BITS, WHICH WE MUST DECODE. + LDB R,[.BP 1,(D)] ;BIT 1.1 IS SET IFF NOTITLE SHOULD BE NONZERO. + SKIPN ENOTIT + MOVEM R,NOTITL + LDB R,[.BP 2,(D)] ;BIT 1.2 IS SET IF REALPG SHOULD BE NONZERO. + SKIPN EREALPG + MOVEM R,REALPG + LDB R,[.BP 14,(D)] ;BITS 1.3, 1.4 GO INTO TOP 2 BITS OF NXFDSP, + ROT R,-2 + SKIPN ENXFDSP + MOVEM R,NXFDSP ;THUS SETTING NXFDSP TO EITHER SIGN OR ZERO + LDB R,[.BP 60,(D)] ;BITS 1.5, 1.6 GO INTO TOP 2 BITS OF FISORF + ROT R,-2 + SKIPN EFISORF + MOVEM R,FISORF + LDB R,[.BP 100,(D)] ;BIT 1.7 IS SET IFF NORFNM SHOULD BE NONZERO. + SKIPN ENORFNM + MOVEM R,NORFNM + ldb R,[.BP 200,(D)] ;BIT 1.8 is set iff underlining copyright notice + skipn ECPYUND + Movem R,CPYUND +IRPS X,,[SYMTRN DEVICE HEDING] + AOBJP D,RLRRS + MOVE R,(D) + SKIPN E!X ;SET THOSE NUMERIC SWITCHES USER DIDN'T OVERRIDE. + MOVEM R,X +TERMIN + JRST RLRRS + +;HANDLE LR.XGP SUBENTRY +RLRRX: HRRZ R,C + SUBM R,D + MOVE R,(D) ;GET THE DATA WORD + SKIPN EFNTVSP ;AND SET VSP, UNLESS USER ALREADY DID. + MOVEM R,FNTVSP + AOBJP D,RLRRS + CAMLE D,[-4,,-1] ;THERE SHOULD BE AT LEAST FOUR MORE WORDS IF THERE ARE ANY + .VALUE + SKIPE EMARGIN + JRST RLRRS + HRRZI R,MARGIN ;WHICH ARE THE MARGIN SETTINGS + HRLI R,(D) + BLT R,MARGIN+4-1 + CAMG D,[-5,,-1] ;IF THERE IS A FIFTH WORD + SKIPA R,4(D) ; THEN USE IT AS THE HOLE MARGIN + SETZ R, ; OTHERWISE USE ZERO FOR COMPATIBILITY + MOVEM R,MARG.H + 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+FNTID(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. + SKIPGE FNTID-FNTFL+1(R) ;UNLESS WE HAVE A KSTID SQUIRRELLED AWAY THERE + SETZM FNTID-FNTFL+1(R) ;MAKE SURE FNTID 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-SINGLEQUOTE 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. +DLREC: PUSH P,2PUTX ? MOVSI A,(JFCL) ? MOVEM A,2PUTX + PUSH P,2PUTNX ? MOVSI A,(CAIA) ? MOVEM A,2PUTNX + PUSH P,DEVICE ? SETZM DEVICE +PRESS, PUSH P,PRESSP ? SETZM PRESSP +REPEAT 4,[ + SKIPE B,OUTFIL+.RPCNT ;XFER /O-SPECIFIED DEFAULT DEV AND SNAME INTO FILENAME BLOCK. + MOVEM B,DLRECF+.RPCNT +];REPEAT 4 + MOVSI B,'DSK ;IF IT DOESN'T SAY, WE HAVE FURTHER DEFAULTS. + SKIPN DLRECF+1 ;NOTE 2LOOPD WILL DEFAULT THE SNAME. FN1 AND FN2 FIXED. + MOVEM B,DLRECF+1 + MOVEI A,DLRECF-F.OSNM + PUSHJ P,2LOOPO + 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] +DLREC5: PUSHJ P,CRLOUT +;HANDLE NEXT SUBENTRY. +DLREC3: SKIPGE (C) + JRST DLRE ;JUMP IF END OF ENTRY. + PUSHJ P,2OUTPJ ;EMPTY BUFFER IF NECESSARY. + 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 + PUSHJ P,SPCOUT + 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: MOVE A,OFILE ;ELSE CLOSE FILE. + PUSHJ P,2OCLS +PRESS, POP P,PRESSP + POP P,DEVICE + POP P,2PUTNX + POP P,2PUTX + POPJ P, + +;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 + MOVEI CH,"( + PUSHJ P,CH000X + 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. + HLRZ A,S.PAGE(C) + PUSHJ P,SP000X + HRRZ A,S.LINE(C) + ADDI A,1 + MOVEI CH,"- + PUSHJ P,CH000X + MOVEI B,[ASCIZ/ (FILE /] ;SAY WHICH FILE DEFINITION IS IN + PUSHJ P,ASCOUT + 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 "?" + CAME B,DLRPSD + JRST DLRPS3 + MOVE A,(C) ;WHEN WE COME TO THE DEVICE CODE, SAVE IT AWAY + MOVEM A,DLRDEV ;SO WE CAN KNOW HOW TO PRINT THE FONTS. +DLRPS3: JSP H,SIXOUT + 2PATCH "= + SKIPGE A,(C) ;IF THE VALUE IS POSITIVE + JRST DLRPS4 + PUSHJ P,SP000X ;THEN PRINT IT IN DECIMAL + MOVEI B,[ASCIZ/. = /] + PUSHJ P,ASCOUT +DLRPS4: 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/ +DLRPSD: SIXBIT/DEVICE/ + SIXBIT/HEDING/ + SIXBIT/?/ ;SPECIAL FOR ANY EXTRAS + +;HANDLE LR.SWT SUBENTRY +DLRSW: MOVEI B,[ASCIZ/F.SWIT=/] + PUSHJ P,ASCOUT + 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 + MOVNS A,D + PUSHJ P,000X + MOVEI B,[ASCIZ / Extra words follow the meaningful data in this block. +/] + PUSHJ P,ASCOUT + HRLI D,(D) + ADD C,D + JRST DLREC3 + +;HANDLE LR.FNT SUBENTRY. +DLRF: SKIPN FNTSIZ(C) + JRST DLRF1 ;NOTHING KNOWN FOR THIS FONT => PRINT NOTHING. + PUSHJ P,DLRF2 ;PRINT THE FONT'S NAME + MOVSI B,(SIXBIT/ (/) + JSP H,SIXOUT + MOVE A,FNTSIZ(C) ;AND SIZE WORD. + 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 + +DLRF2: +PRESS,[ MOVE CH,DLRDEV ;IF OUR DEVICE WANTS PRESS FILES, FONT NAMES AREN'T FILENAMES. + SKIPGE FRCXGP(CH) ;DON'T USE PRESSP HERE! SEE DLREC. + JRST [ MOVEI L,(C) + MOVE A,[PUSHJ P,CHROUT] ;PRINT OUT PRESS FILE FONT NAME. + JRST PRSPFN ] +];PRESS + MOVEI L,-F.RSNM(C) + JRST FNTOUT + +;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,000XCR + CAML D,[-4] ;IF THERE ARE FOUR MORE WORDS + JRST DLRDUN + MOVEI B,[ASCIZ/MARGINS=/] ;THEN WE HAVE MARGINS TO PRINT + PUSHJ P,ASCOUT +REPEAT 4,[ + MOVE A,1+.RPCNT(C) +IFE .RPCNT, PUSHJ P,000X +IFN .RPCNT, PUSHJ P,CM000X +];REPEAT 4 + ADD C,[5,,5] + ADDI D,5 + JUMPE D,DLREC5 + MOVE A,(C) + PUSHJ P,CM000X + PUSHJ P,CRLOUT + JRST DLRDUN + +;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. +NODOS,[ +DEFINE WLRWWD X,(Y) +IFNB [Y]MOVE X,Y + IDPB X,C + SOSG D + PUSHJ P,WLRWO +TERMIN +];NODOS +DOS,[ +DEFINE WLRWWD X,(Y) +IFNB [Y]MOVE X,Y + SOSGE OUTHED+2 + PUSHJ P,WLRWO + IDPB X,OUTHED+1 +TERMIN +];DOS + +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,.BIO ;WE WANT IMAGE OUTPUT. +NODOS, MOVE H,[SIXBIT/LREC/] ;OPEN _@_ LREC ON ITS. +DOS, ;H WAS SET UP IN WLRECR + PUSHJ P,2OUTOP + FLOSE UTOC,F.OSNM(A) + JFCL CPOPJ +NODOS,[ 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. +];NODOS + 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: +TNX, RET ; TNX has version numbers, so no danger. +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". + SYSCAL DELETE,[F.ODEV(A) ? F.OFN1(A) ? OLRFN2 ? F.OSNM(A)] + JFCL + SYSCAL RENAME,[F.ODEV(A) ? F.OFN1(A) ? F.OFN2(A) ? F.OSNM(A) ? F.OFN1(A) ? OLRFN2] + JFCL +];ITS +DOS,[ 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, +];DOS + 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 +TNX,[ + SUBI C,SLBUF-1 ;# WDS OF DATA PUT IN SLBUF. + MOVNI C,(C) + JUMPGE C,WLRWO2 + PUSH P,A ? PUSH P,B + MOVE A,JFNCHS+UTOC + MOVE B,[444400,,SLBUF] + SOUT ; Out it goes (maybe do error checking?) + POP P,B ? POP P,A +WLRWO2: MOVE C,[004400,,SLBUF-1] + MOVEI D,LSLBUF ;BUFFER NOW EMPTY; RE-INIT STORING IN IT. + POPJ P, +];TNX +DOS,[ 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, +];DOS + +;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 NORFNM + SKIPN B,F.RSNM(A) ;WRITE THE SNAME + MOVE B,F.ISNM(A) + WLRWWD B +NOCMU,[ ;UNDER CMU, USE THE SPECIFIED DEVICE, NOT THE REAL DEVICE + SKIPN NORFNM + SKIPN B,F.RDEV(A) ;WRITE THE DEV +];NOCMU + MOVE B,F.IDEV(A) + WLRWWD B + SKIPN NORFNM + SKIPN B,F.RFN1(A) ;WRITE THE FN1 + MOVE B,F.IFN1(A) + WLRWWD B + SKIPN NORFNM + 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,-14. ;-14. 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 + SKIPE FISORF ;BIT 1.5 REFLECTS NONZERONESS OF FISORF + TRO B,20 + SKIPGE FISORF ;BIT 1.6 IS SIGN BIT OF FISORF. + TRO B,40 + SKIPE NORFNM ;BIT 1.7 MEANS NORFNM IS NONZERO + TRO B,100 + SKIPE CPYUND ;BIT 1.8 means underline copyright + TRO B,200 + WLRWWD B ;OUTPUT THE ENCODED WORD. + INSIRP WLRWWD B,SYMTRN DEVICE HEDING + 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 + DROPTHRUTO WLRWX2 + +;DROPS THROUGH +WLRWX2: WLRWWI R,LR.XGP ;WRITE OUT THE VSP AND MARGIN INFO + WLRWWI L,-6 + WLRWWD B,FNTVSP ;VSP GOES IN LR.XGP +REPEAT 5,[ + MOVE B,MARGIN+.RPCNT ;AS DO THE MARGINS + WLRWWD B +];REPEAT 5 + SKIPN FNTSPC + JRST WLRWX + WLRWWI R,LR.FNT ;FONT TABLE GOES IN LR.FNT + WLRWWI L,-NFNTS*FNTFL +WLRWX1: WLRWWD CH,FNTF0(B) + AOBJN B,WLRWX1 +WLRWX: MOVE R,REALF ;CHECK IF COPYRIGHT MESSAGE BEING PRINTED + TLNN R,FLQPYM + JRST WLRWD ;AND DON'T DUMP ONE IF NOT + WLRWWI R,LR.CPY ;OUTPUT QOPYRIGHT MESSAGE IN LR.CPY + WLRWWI L,-LCPYMSG +WLRWQ: WLRWWD CH,CPYMSG(B) + AOBJN B,WLRWQ +WLRWD: 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,[ ;WE NO LONGER KEEP SYMBOL TABLES IN THE LREC FILE. + 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 D,DEVICE + SKIPE TEXGPP ;IF /L[TEXT] AND /D[XGP ITS], MARK 1ST PAGE AS CHANGED, SINCE + JRST [ CAIE D,DEVIXG ;IT PROBABLY CONTAINS XGP COMMANDS WHOSE LOSS WOULD SCREW. + CAIN D,DEVCGP + SETZM (B) + JRST .+1] +];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, +;C HAS # OF LAST LINE ON PREVIOUS PAGE. +CPRL1: HLRZ D,1(B) ;# LINES ON THIS PAGE. + HRRZ R,1(B) + SKIPG TEXTP ;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 TRUNCATED? + 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: SKIPN 1CKSFL ;IF WE DON'T NEED ANY CHECKSUMMING + SKIPN TEXTP ;AND WE DON'T HAVE ANY SYMBOLS, + JRST 1STAR1 + TLNE F,FLSUBT ;AND DON'T NEED TO SCAN FOR SUBTITLES + SKIPG TEXTP ;IN /L[RANDOM] + 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 + SKIPGE TEXTP + 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. + SKIPE TEXTP ;FOR /L[TEXT] AND /L[RANDOM] + SKIPL B,F.OLRC(A) ;WHERE THERE IS AN OLD LREC FILE + JRST 1LOOP3 + SKIPN NORENUM ;AND WE DON'T HAVE TO DROP GAPS + TRNE F,FSLALL+FSLRNM + JRST 1LOOP3 + MOVE B,3(B) + CAME B,F.RFN2(A) ;AND THE EXTENSIONS MATCH + JRST 1LOOP3 + SKIPE B,F.OCRD(A) ;AND THE CREATION DATES AND TIMES MATCH + CAME B,F.CRDT(A) + JRST 1LOOP3 +1NOCHG: MOVEI B,FSNCHG ;WE CAN SKIP COMPARING. + IORM B,F.SWIT(A) + JRST 1DONE1 + +1LOOP3: MOVEI R,.BAI + 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::1MIDAS ;MACRO-11/PALX IS SIMILAR TO MIDAS +CODLSP::1LISP +CODM10::1FAIL ;MACRO-10 IS SIMILAR TO FAIL +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 + SKIPE TEXGPP ;FOR XGP TEXT FILES SINCE ^L ISN'T ALWAYS END OF PAGE, + ;WE MUST USE A SPECIAL HAIRY PARSE ROUTINE. + 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 + SKIPL TEXTP + 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,[ .SEE 2TEXGT +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 FCNT -internal to LOOK and the XGP + JRST 1CKXGP ;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 + CAIN CH,^M ;ANYTHING OTHER THAN CR OR LF INDICATES THIS LINE IS NON-BLANK. + JRST 1RSUB0 + CAIN CH,^J + JRST 1RSUBT +;-RHG 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: MOVEI A,1FTBL ;USE THE "FAIL" DISPATCH TABLE FOR PARSING. + JRST 1MIDA1 + +1DAPX: MOVEI A,"/ ; SET COMMENT CHARACTER TO SLASH + MOVEM A,COMC + +;;; 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 ;JRST FOR NON-SQUOZE, SKIP FOR LOWER CASE. + SUBI CH,40 ;CONVERT TO SIXBIT (LOWER CASE IS ALREADY OK) + IDPB CH,CP ;SAVE SQUOZE CHAR IN SYLLABLE + JRST 1MLOOP + +PTLO==. ? .==PTHI ;SWITCH BACK TO PURE SEGMENT. + +1MDLR: SUBI CH,40 + IDPB CH,CP ;$ IS NORMALLY PART OF A SYMBOL, + SKIPN PALX11 ;BUT IN PALX WE IGNORE SUCH SYMBOLS IF + JRST 1MDLR1 ;THE $ IS PRECEDED BY ONLY DIGITS + 1GETCH ;AND IT IS THE LAST CHAR IN THE SYMBOL. + XCT NSQOZP(CH) + JRST 1MDLR1 + TRO F,FRSQZ + JRST 1MXCT + +1MDLR1: TRO F,FRLET+FRSQZ + JRST 1MLOOP + +1FUPAR: SKIPLE FAILP ;UPARROW (^) IN FAIL OR MACRO-10. + 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 + +;LOOK AT CHAR IN CH, NORMALLY IGNORED, +;JUST IN CASE IT IS A FORMATTING CHARACTER OR ^C. +;SHOULD IMMEDIATELY FOLLOW THE 1GETCH. +DEFINE LINBRK + CAIN CH,^C + PUSHJ P,1MORE0 + CAIE CH,^M + CAIN CH,^L + JRST 1MNSYX + CAIN CH,^J + JRST 1MNSYX +TERMIN + +1MDQT1: 1GETCH ;DOUBLE QUOTE IN PALX-11: IGNORE 2 CHARS. + LINBRK +1MSQT1: 1GETCH ;SINGLE QUOTE IN PALX-11: IGNORE 1 CHAR. + LINBRK + JRST 1MNSYL + +1MGOBL: 1GETCH ;GOBBLE A CHAR AFTER ", ', OR ^ IN MIDAS CODE. + LINBRK +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: PUSH P,CH ;SPACE OR TAB IN FAIL CODE: IT MAY BE BETWEEN THE + MOVE CH,IP ;SYMBOL AND THE COLON OF A LABEL, ETC. + ILDB CH,CH ;PEEK NEXT CHARACTER + XCT NSQOZP(CH) + JRST 1FSPCB ; - PROCESS THE 1ST + CAIE CH,"= + CAIN CH,": ;, ETC., MEANS IGNORE THE SPACE + CAIA ;SO THAT THE SYMBOL GETS PROCESSED BY THE DEFINER. + CAIN CH,"_ + JRST [ POP P,CH + JRST 1MLOOP] +1FSPCB: POP P,CH + 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 1MSYN + 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 1MALU0 + +; PSEUDOS FOR DAPX16 +1MBRKD: CAMN A,[SIXBIT \.STITL\] + JRST 1MSUBT + CAMN A,[SIXBIT \EQUALS\] + JRST 1MSYN + JRST 1MALU0 + +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/INTERN/] + JRST 1M.GLO + CAME A,[SIXBIT/EXTERN/] + CAMN A,[SIXBIT/GLOBAL/] + JRST 1M.GLO +; TRY LOOKING IN .DEFMAC TABLE +1MALU0: 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 + 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: SKIPLE FAILP + 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: MOVEI A,[F%SYN] ;MACRO "SYN" OPERATOR DEFINES SECOND SYM FROM FIRST. + TRNE F,FRSYL1 ;IGNORE UNLESS IT'S FIRST SYLLABLE ON A LINE. + JRST 1MNSYL + JSP H,1MSGET ;SKIP ONE SYLLABLE, + JSP H,1MSGET ;DEFINE THE NEXT. + JSP H,DEFSYM + JRST 1MSEMX + +1MSYN: SKIPA A,[F%SYN] ;MIDAS "EQUALS" OPERATOR. +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 ^I-^D, JRST 1MBRK ;^D-^H + JRST 1MSPAC ;^I (TAB, TREAT LIKE SPACE) +REPEAT 40-^J, JRST 1MBRK ;^J-^_ + JRST 1MSPAC ;SPACE + JRST 1MBRK ;! + JRST 1MGLO ;" + JRST 1MBRK ;# + JRST 1MDLR ;$ - FUNNY IN PALX. + TRO F,FRLET+FRSQZ ;% + JRST 1MBRK ;& + JRST 1MVAR ;' +REPEAT 4, JRST 1MBRK ;( ) * + + JRST 1MCOMA ;, + JRST 1MBRK ;- + TRO F,FRLET+FRSQZ ;. + JRST 1MSEMI ;/ +REPEAT 10., 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 ^I-^D, JRST 1MBRK ;^D - ^H + JRST 1FSPAC ;^I (TAB, TREAT LIKE SPACE) + JRST 1MBRK ;^J + JRST 1FUPAR ;^K +REPEAT ^X-^L, JRST 1MBRK ;^L THROUGH ^W + PUSHJ P,1FUNDR ;^X (SAIL UNDERSCORE) SAME AS ".". +REPEAT 40-^Y, 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 8., CAIA ;&-- + JFCL ;. + CAIA ;/ +REPEAT 10., 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: CAIE CH,40 ;SKIP ANY LEADING SPACES AND TABS. + CAIN CH,^I ;THEY ARE NOT INCLUDED IN THE SUBTITLE. + JRST [1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 + JRST 1SUBT0 ] + +1SUBT1: CAIE CH,^L ;CH HAS NEXT POSSIBLE CHARACTER OF SUBTITLE + CAIN CH,^M + JRST 1SUBT9 ; OR FF 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. + MOVEI A,FSSUBT ;SET "THIS FILE HAS SUBTITLES" BIT. + MOVE D,CFILE + SKIPN TEXTP ;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: +NOITS,[ 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. +];NOITS + CAMN R,F.IFN1(A) + JRST POPCHJ +1INSR3: ADDI A,LFBLOK + CAME A,SFILE + JRST 1INSR2 + JUMPN B,1INSR6 +NOITS,[ 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. +];NOITS +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,[ SYSCAL OPEN,[1000,,INSC ? 5000,,.BAI ? INSDEV ? INSFN1 ? INSFN2 ? INSSNM] + POPJ P, + JRST POPJ1 +];ITS +TNX,[ PUSH P,A ? PUSH P,B + MOVEI A,INSSNM + CALL TF6TOA ; Get filename in ASCIZ + HRROI B,TFILNM ; Point to asciz string + MOVE A,[GJ%OLD+GJ%SHT] + GTJFN + JRST 1INSO9 + HRRZM A,JFNCHS+INSC ; Save JFN + MOVE B,[440000,,0+OF%RD] + OPENF + JRST [ MOVE A,JFNCHS+INSC + RLJFN + NOP + SETZM JFNCHS+INSC + JRST 1INSO9] + AOS -2(P) +1INSO9: POP P,B ? POP P,A + RET +];TNX + +DOS,[ 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 +];DOS + +1MFNAM: SETZ A, + MOVE B,[440600,,A] +1MFNM1: 1GETCH + CAIN CH,^C + PUSHJ P,1MORE0 +BOTS, CAIE CH,"[ ;] +TNX, 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: +BOTS,[ CAIN CH,"[ ;] ;IN DEC VERSION, BRACKET STARTS A PPN. + PUSHJ P,1.IPPN +];BOTS +TNX,[ CAIN CH,"< ; ;IN TOPS-20 VERSION, BROKET STARTS A DIRECTORY NAME. + PUSHJ P,1.IPPN +];TNX + 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 + +BOTS,[ +;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 +CMU10,[ +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, +];CMU10 +1.IPP4: MOVEM A,INSSNM + POPJ P, + +NOCMU,1.IPP2: +1.IPPL: 1GETCH + CAIE CH,^M ;[ + CAIN CH,"] + POPJ P, + JRST 1.IPPL +];BOTS +TNX,[ +;DIRECTORY READER FOR .INSRT'S IN TNX VERSION. + +1.IPPN: SETZB A,B + 1GETCH ; + CAIN CH,"> + POPJ P, ;IGNORE <> +1.IPP2: JUMPN B,1.IPPL ; + SETZM PPNBUF ; Clear out PPNBUF + MOVE B,[PPNBUF,,PPNBUF+1] + BLT B,PPNBUF+PPNSIZ-1 + MOVE B,[440700,,PPNBUF] +T20, MOVEI A,"< ? IDPB A,B ; T20 needs punctuated dir + +1.IPP5: CAIE CH,^M ;DON'T LOOK TOO FAR + SKIPE PPNBUF+PPNSIZ-1 + JRST 1.IPPL + IDPB CH,B + 1GETCH + CAIE CH,"> ;LOOP TILL WE FIND A CLOSE BRACKET + JRST 1.IPP5 +T20,[ IDPB CH,B + MOVSI A,(RC%EMO) ; Want exact match + HRROI B,PPNBUF + RCDIR ; convert to funny octal + ERJMP [SETZ B, ; No such dir... should pass error better. + JRST .+1] + MOVE A,B +];T20 +10X,[ HRROI B,PPNBUF + SETZ A, + STDIR + SETZ A, ; no match -- should pass error better. + SETZ A, ; ambiguous +];10X + +1.IPP4: MOVEM A,INSSNM + POPJ P, + +1.IPPL: 1GETCH + CAIE CH,^M ; + CAIN CH,"> + POPJ P, + JRST 1.IPPL +];TNX + +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: TLNE F,FLARB ;SKIP IF SINGLE WORD SYMS + JRST DEFSY1 + MOVE D,SYLBUF + TLCE D,400000 ;MAKE PDP-10 SIGNED COMPARISONS WORKS LIKE UNSIGNED + JRST DEFSY7 + SKIPN FAILP ;IN FAIL & MACRO-10, SYMBOLS CAN'T START WITH DIGITS. + SKIPE PALX11 ;IN PDP11 CODE, IGNORE "LOCAL" N$ SYMBOLS. + TLNN D,200000 + JRST DEFSY7 + JRST (H) + +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 +DEFSY7: AOS NSYMSF ;COUNT # SYMS DEFINED IN EACH FILE + PUSH SP,D ;PUSH OUT INTO SYM TBL ENTRY + 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) + TLZ B,#T%BIND#T%TAG ;CLEAR ALL BUT THESE TWO BITS. + 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) + +CRFSYM: 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: +REPEAT 3,[ + 1GETCH ;HERE ON SEMICOLON IN LISP CODE. + CAIN CH,^C + PUSHJ P,1MORE0 + CAIE CH,"; ;ARE THERE FOUR SEMICOLONS IN A ROW? + JRST 1LTKC2 ;IF NOT, JUST IGNORE REST OF LINE. +];REPEAT 3 + 1GETCH ;IF FOUR SEMIS, ARE THERE FIVE? IF FIVE, IT IS NOT A SUBTITLE + CAIN CH,^C + PUSHJ P,1MORE0 + CAIN CH,"; + JRST 1LTKC1 ;SO JUST IGNORE THE COMMENT. + DBP7 IP ;EXACTLY FOUR SEMICOLONS. BACK UP OVER THE NON-SEMICOLON + PUSHJ P,1SUBT ;SINCE IT IS PART OF THE SUBTITLE. READ IN THE SUBTITLE. + JRST 1LTKC2 ;IT STOPS AT A ^M OR ^L WHICH ENDS THE COMMENT TOO. + +1LTKC1: 1GETCH ;COMMENT SEEN, AND IT ISN'T A SUBTITLE (FOUR SEMIS) + CAILE CH,^M ;SUPER-FAST SCAN UNTIL ^M + JRST 1LTKC1 + CAIN CH,^C + PUSHJ P,1MORE0 +1LTKC2: CAIN CH,^M + JRST 1LBCR + CAIE CH,^L + JRST 1LTKC1 + 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 13., 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 10., JFCL ;0-9 + JFCL ;: + PUSHJ P,1LTOKC ;; +REPEAT 5, TRO F,FRLET ;< = > ? @ +REPEAT 26., TRO F,FRLET ;A-Z +REPEAT 5, TRO F,FRLET ;[ \ ] ^ _ + JRST 1LTOK1 ;` +REPEAT 26., PUSHJ P,1LTLC ;a-z + PUSHJ P,1LTLC ;{ + 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 13., 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 10., JFCL ;0-9 + JFCL ;: + JRST 1LTOKB ;; +REPEAT 5, TRO F,FRLET ;< = > ? @ +REPEAT 26., TRO F,FRLET ;A-Z +REPEAT 3, TRO F,FRLET ;[ \ ] +REPEAT 2, JFCL ;^ _ + JRST 1lTOKB ;` +REPEAT 26., PUSHJ P,1LTLC ;a-z + PUSHJ P,1LTLC ;{ + 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 13., JRST 1LVB1 ;^N-^Z + PUSHJ P,1LALT ; +REPEAT 4, JRST 1LVB1 ;^\-^_ + JFCL ;SPACE +REPEAT 14., JFCL ;! " # $ % & ' ( ) * + , - . + PUSHJ P,1LTSL1 ;/ +REPEAT 10., JFCL ;0-9 +REPEAT 7, JFCL ;: ; < = > ? @ +REPEAT 26., JFCL ;A-Z +REPEAT 5, JFCL ;[ \ ] ^ _ + JFCL ;` +REPEAT 26., JFCL ;a-z DON'T CONVERT CASE INSIDE VBARS. + JFCL ;{ + 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,T%1WRD(B) ;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) + TRZ B,T%FLGS + 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 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 PASS 2 + +2START: PUSHJ P,2INIT ;COMPUTE CONSTANT PARAMETERS. + SETZM OFILE ;NO OUTPUT FILE OPEN YET. + SETZM 1CKSFL ;TURN OFF CHECK-SUMMING, FOR BENEFIT OF CKLNM + MOVEI A,FILES + SKIPG FISORF ;IF WE ARE SORTING THE FILES IN PASS 2 + JRST 2LOOP + MOVEI A,FILSRT ;THEN WE ITERATE DIFFERENTLY +2LOOP0: HRRZM A,FISORF + SKIPN A,(A) + JRST 2END +2LOOP: MOVEM A,CFILE + CAML A,SFILE + JRST 2END ;FINISH PASS 2 IF NO MORE FILES. + 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 OR SCAN LREC FILES, OR FILES BEING IGNORED. + JRST 2DONE + TRC F,FSQUOT+FSARW + TRCN F,FSQUOT+FSARW ;ARROW SINGLEQUOTE FILES JUST SPECIFY + JRST [ PUSHJ P,2LOOPD ;OUTPUT FILES TO BE OPENED. + JRST 2DONE] +;THIS FILE IS A REAL LIVE INPUT FILE. + TRNN F,FSQUOT\FSNCHG ;IF FILE IS UNCHANGED OR QUOTED, DON'T LIST IT. + JRST 2LOOP6 +;HOWEVER, IT MAY STILL BE NECESSARY TO OPEN AN OUTPUT FILE FOR IT IF +; WE WILL HAVE NON-FILE-ASSOCIATED OUTPUT TO PRINT AND +; THERE IS NO SPECIAL OUTPUT FILE SPECIFIED FOR IT (/C[FILE]) AND +; THIS IS OUR LAST CHANCE TO OPEN AN OUTPUT FILE FOR IT. + 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. +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 2DONE ;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 [PUSHJ P,2LOOPD ;YES, IT DOES. + JRST 2LOOP1] + 2PAGE ;NO, BUT MOVE TO TOP OF PAGE + SKIPE DEVICE .SEE DEVLPT + JRST 2LOOP1 + 2PAGE ;IF LPT, LEAVE BLANK PAGE. +2LOOP1: PUSHJ P,2FILE1 ;OPEN, PROCESS AND CLOSE THIS INPUT FILE. +2DONE: SKIPLE A,FISORF ;ADVANCE THROUGH SORTED FILE TABLE IF WE ARE USING IT. + AOJA A,2LOOP0 + HRRZ A,CFILE ;OR THROUGH NON-SORTED FILE TABLE. + ADDI A,LFBLOK + JRST 2LOOP + +;COMPUTE PARAMETERS FOR PASS 2. WE FIND THE VALUES FOR THE VARIABLES +; LOOKIT, 2PUTX, 2PUTNX, 2PUTTC, NTABS, TLINEL, PLINEL AND PAGEL1, +; WHOSE VALUES REMAIN CONSTANT. +2INIT: MOVEI A,LOOK + TLNE F,FLARB + MOVEI A,NLOOK + MOVEM A,LOOKIT ;CHOOSE SYMBOL LOOKUP ROUTINE FOR 1 WD OR LONG NAMES. + MOVSI A,(JFCL) + SKIPE TRUNCP + MOVSI A,(CAIGE CC,) + HLLM A,2PUTX ;CHOOSE TRUNCATION/CONTINUATION INSTRUCTIONS. + 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 CONTINUING. + MOVEM A,2PUTTC + PUSHJ P,2NTABS ;COMPUTE SIZE OF REFERENCES AT FRONT OF EACH LINE. + MOVEM A,NTABS + LSH A,3 + MOVNS A + ADD A,LINEL + MOVEM A,TLINEL ;TLINEL = # POSITIONS ROOM FOR TEXT PER LINE. + SUBI A,.LENGTH " PAGE MAJ/MIN.CNT" + ;SUBTRACT # TO LEAVE FOR " PAGE 69/1.1" + SKIPN NOCOMP ;IF LISTING IN FULL + SKIPE REALPG ;OR IF USING REAL PAGE NUMBERS + ADDI A,4 ;THEN AD BACK THE "/MIN" WHICH CAN'T HAPPEN + TLNE F,FLDATE +ITS, SUBI A,9. ;ALLOW FOR MM/DD/YY +NOITS, SUBI A,15. ;ALLOW FOR MM/DD/YYHH:MM + SKIPGE A + SETZ A, + MOVEM A,PLINEL ;HORIZ INDENT FOR "PAGE " AT TOP OF EACH PAGE. + MOVEM A,IPLINEL ; Set actual base for horiz ident (see 2INIPL) + MOVE A,PAGEL + TLNE F,FLQPYM + SUBI A,2 + MOVEM A,PAGEL1 + POPJ P, + +;COMPUTE THE NUMBER OF POSITIONS AT THE BEGINNING OF EACH TEXT LINE +;WE WILL NEED FOR REFERENCES. RETURN THAT VALUE DIVIDED BY 8 IN A. +2NTABS: MOVEI A,3 ;FIND EFFECTIVE LINEL + 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, + POPJ P, + +; Initialize PLINEL and filename header for page-number line, to adjust +; for maximum room. +; Called from 2FILE1 each time a new file is opened. + +2INIPL: + PUSH P,A ? PUSH P,B +NOTNX,[ MOVE A,IPLINEL ; Due to current lack of neat filename + SUBI A,PGNSPC ; output rtns, just use constant here. + MOVEM A,PLINEL +];NOTNX + +TNX,[ +;; MOVE B,[440700,,CFILNM] +;; CALL TF6TOB ; Get filename in ASCIZ + HRROI A,CFILNM ; Point to home for current filename string + MOVE B,JFNCHS+UTIC ; This SHOULD be the JFN for current file! + MOVE C,[211110,,1] ; Get [dev:]FNM.EXT;VER + JFNS + MOVE A,[440700,,CFILNM] + CALL LBPASZ ; Find length of string + MOVE B,IPLINEL ; Get intermediate page-num line length + SUBI B,(A) ; subtract filename length + MOVEM B,PLINEL ; and store actual room avail. +];TNX + POP P,B ? POP P,A + RET + +;DO ALL PROCESSING ON ONE INPUT FILE, WRITING ALL OUTPUT ASSOCIATED WITH IT. +;THE APPROPRIATE OUTPUT FILE IS ALREADY OPEN. +;IF FSNCHG OR FSQUOT IS SET, DO NOT LIST, JUST SCAN. +;IF THERE IS NO NEED TO LIST OR TO SCAN, WE ARE NOT CALLED. +2FILE1: 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. + POPJ P,] + MOVEI R,.BAI + PUSHJ P,2INOPN ;OPEN FOR ASCII INPUT ON UTIC. + FLOSE UTIC,F.ISNM(A) + JFCL CPOPJ + PUSHJ P,2RDAHD + PUSHJ P,DOINPT + JRST CPOPJ + CALL 2INIPL ; File wins, use filename len to set PLINEL. +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 + MOVE B,SUBTLS + MOVEM B,SUBPTR + TRNE F,FSQUOT+FSNCHG ;IF FILE'S BEING LISTED, + JRST 2LOOP5 + SKIPL TEXGPP ;IF /L[TEXT]/X, + 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 + SKIPE DEVICE .SEE DEVLPT + JRST 2LOOP7 + PUSHJ P,TITLES ;IF LPT, PRINT AN EXTRA TITLE PAGE + 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: SETO B, + PUSHJ P,2FILE ;SCAN AND LIST THE TEXT OF THE FILE. + .CLOSE UTIC, + HRRZ IP,CFILE ;OUTPUT THE SYMBOL TABLE IF DESIRED. + SKIPGE UNIVCT + SETZ IP, + TRNN F,FSNSMT + PUSHJ P,SYMLST + PUSH P,IPLINEL ; Restore basic setting of PLINEL, + POP P,PLINEL ; just in case anything else will need it. + POPJ P, + +;HERE TO SCAN A FILE WHICH IS NOT BEING LISTED. +2LOOP5: MOVEI B,0 + PUSHJ P,2FILE ;SCAN FILE. DON'T LIST IT. + .CLOSE UTIC, + POPJ P, + +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: +; There appears to be a bug in which if there is a copyright message +; the terminal CRLF following the message is not printed. This seems +; to confuse some printing devices. Therefore, before closing the file +; we want to print a terminal CRLF to terminate the last line which is the +; copyright line (I think this is true even when a symbol table or cref +; also appears) +; +; Upon later inspectiion it appears that this is true at least if no +; cref or symbol table is produced. Since this confuses the Anadex +; printer, I'm putting in a version conditioned to the Anadex switch... +; This is also set up to do the same for the Florida Data Systems OSP-130 +NoAnadex,[ + tlne F,FLQPYM ; is copyright being done? + pushj p,CRLOUT ; yes, terminate the last one + ] +IFN ANAFLG!FLAFLG,[ + MOVE B,DEVICE + CAIN B,DEVANA ; skip if not anadex + pushj p,CRLOUT + MOVE B,DEVICE + CAIN B,DEVFLA ; skip if not Florida OSP-130 + pushj p,CRLOUT + ] + +ITS,[ MOVEI CH,^C + TLNE F,FLXGP +];ITS + SETZ CH, + PUSHJ P,2OCLSO + SETZM OFILE ;NO OUTPUT FILE OPEN ANY MORE. +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: +PRESS,[ SKIPE PRESSP + JRST PRSDIR +];PRESS +REPEAT 5, 2PATCH + SUBI SP,SLBUF + TRNN SP,-1 + POPJ P, + OUTWDS CH,[SLBUF],0(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,[ +NOT10,[ +NOTNX,[ + SKIPL QUEUE + STRT [ASCIZ\ -- queued\] +];NOTNX +];NOT10 +];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: MOVE CH,DEVICE ;DO NOTHING IF THIS DEVICE CAN'T QUEUE + SKIPE 2QUETB(CH) ;OR QUEUES IN ANOTHER WAY. + .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:/] + MOVE C,DEVICE + CAIN C,DEVGLD + 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,DEVGLD ;OR "NAME/HW/NOHEADING" FOR /-X/D[GOULD] + 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 + +2QUETB: OFFSET -. +DEVLPT:: 0 ;FOR LPT, QUEUED SIMPLY BY OUTPUTTING TO TPL:. +DEVIXG:: -1 ;THESE DEVICES CAN DO QUEUEING. +DEVCXG:: 0 ;UNTIL WE WRITE CODE, CMU CAN'T DO QUEUEING. +DEVGLD:: -1 +DEVLDO:: 0 ;WE CAN'T QUEUE FOR THE DOVER. +DEVPDO:: 0 +DEVANA:: 0 +DEVCGP:: 0 +DEVFLA:: 0 +DEVMAX::OFFSET 0 +];ITS + +CMU, 2QUEUE: POPJ P, +T10, 2QUEUE: POPJ P, +TNX, 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: MOVE CH,DEVICE + SKIPN 2QUETB(CH) + POPJ P, + 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 *] + CAIE CH,DEVLDO ;DOVER? + CAIN CH,DEVPDO + MOVEI B,[ASCIZ *DOVER *] +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, + +2QUETB: OFFSET -. +DEVLPT:: -1 ;THESE DEVICES CAN DO QUEUEING. +DEVIXG:: -1 +DEVCXG:: 0 ;UNTIL WE WRITE CODE, CMU CAN'T DO QUEUEING. +DEVGLD:: 0 +DEVLDO:: -1 ;WE CAN QUEUE FOR THE DOVER. +DEVPDO:: -1 +DEVANA:: 0 +DEVCGP:: 0 +DEVFLA:: 0 +DEVMAX::OFFSET 0 + +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. +DOS, ;H HAS THE DESIRED PROTECTION (OR 0 FOR DEFAULT) IN BITS 0-8, REST ZERO + +ITS,[ +2OUTOP: 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 +TNX,[ +2OUTOP: PUSH P,A ? PUSH P,B + MOVEI A,F.OSNM(A) + CALL TF6TOA ; Get filename in ASCIZ + HRROI B,TFILNM ; Point to asciz string + MOVE A,[GJ%FOU+GJ%SHT] + GTJFN + JRST 2OUTO9 + HRRZM A,JFNCHS+UTOC ; Save JFN + MOVE B,[440000,,0+OF%WR] + OPENF + JRST [ MOVE A,JFNCHS+UTOC + RLJFN + NOP + SETZM JFNCHS+UTOC + JRST 2OUTO9] + AOS -2(P) +2OUTO9: POP P,B ? POP P,A + RET +];TNX + +DOS,[ +2OUTOP: MOVEM R,OUTCHN + 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, + JUMPN CH,2OUTO2 ;IF PPN WASN'T SPEC'D + SKIPE CH,OUFIL+.RBNAM+3 + MOVEM CH,F.OSNM(A) ;THEN SAY WHAT WE FOUND +2OUTO2: MOVSI CH,004400 ;ALWAYS USE 36-BIT BYTE POINTERS + MOVEM CH,OUTHED+1 + 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, +];DOS + +;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. +SAI, SKIPE B,FNTSPC .SEE DEVLPT + SKIPL B,DEVICE + CAIL B,DEVMAX + .VALUE + MOVE B,OPTFN2(B) + 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,[ SKIPN DEVICE .SEE DEVLPT ;ON ITS, NON-XGP LISTINGS GO TO TPL BY DEFAULT + SKIPE QUEUE .SEE QU.YES ;AS LONG AS SIMPLE QUEUEING IS ON. + CAIA + MOVSI B,'TPL +];ITS + SKIPN F.ODEV(A) + MOVEM B,F.ODEV(A) + MOVEI R,.BAO ;USE MODE = ASCII OUTPUT. +PRESS,[ SKIPE PRESSP ;IF WE SUPPORT PRESS FILES, MAKE THIS OUTPUT FILE + MOVEI R,.BIO ;THEN USE IMAGE MODE OUTPUT +];PRESS +ITS, MOVE H,[SIXBIT/OUTPUT/] +DOS, SETZ H, ;USE DEFAULT PROTECTION + PUSHJ P,2OUTOP ;OPEN OUTPUT NAMES IN OTFSNM, ETC. ON UTOC. + FLOSE UTOC,F.OSNM(A) + JFCL ERRDIE + MOVE SP,[010700,,SLBUF-1] + SKIPL A,DEVICE + CAIL A,DEVMAX + .VALUE + PUSHJ P,@INIDVTB(A) ;WRITE THE FONT INFO, OR WHATEVER + SETZM OUTPAG + JRST POPAJ + +INIDVTB:OFFSET -. +DEVLPT::CPOPJ +DEVIXG::2FNTIX +DEVCXG::2FNTCX +DEVGLD::2FNTIX +DEVLDO::PRSINI +DEVPDO::PRSINI +DEVANA::ADAINI +DEVCGP::2FNTIX ; Like ITS XGP +DEVFLA::FLAINI +DEVMAX::OFFSET 0 + +SUBTTL XGP COMMANDS OUTPUT + +;WRITE A PAGE OF XGP COMMANDS DESCRIBING THE FONTS AND VSP KNOWN TO @. + +NOXGP,[ +2FNTCX==:CPOPJ +2FNTIX==:CPOPJ +];NOXGP + +XGP,[ + +2FNTCX: TLNE F,FLXGP ;PREFIX THESE COMMANDS ONLY IF /X + SKIPE TEXGPP ;AND NOT /L[TEXT]. + POPJ P, + SKIPN FNTSPC + JRST 2NFNT1 +REPEAT NFNTS,[ + MOVEI L,FNTF0+.RPCNT*FNTFL-F.RSNM + SKIPE F.RFN1(L) + SKIPG B,FNTID+F.RSNM(L) + CAIA + PUSHJ P,[ + CAIG B,32. ;FONTS WITH KSTID'S LEQ 32 ARE ON THE DSK + POPJ P, + HRLM B,(P) + 2PATCH 177 ;EXEC + 2PATCH 55 + IBP SP .SEE 2PATCH ;LEAVE ROOM FOR COUNT + MOVE H,SP ;SAVE POSITION OF COUNT + MOVEI CC,1 ;PRE-COUNT THE "/" + MOVEI B,[ASCIZ/SHIP /] + PUSHJ P,ASCOUT + PUSHJ P,FNTOUT + LDB A,[.BP <(00377777)>,(P)] + PUSHJ P,SL000X + DPB CC,H ;AND FIX UP THE COUNT + POPJ P, ] +];REPEAT NFNTS +2NFNT1: PUSH P,CC ;FOR IDIVI CH, + 2PATCH 177 ;SET FORMAT=1 + 2PATCH 63 + 2PATCH 1 + 2PATCH 177 ;SET TOPMAR + 2PATCH 3 + MOVE CH,MARG.T + IMUL CH,DOTPIV+DEVCXG + IDIVI CH,1000. + ROT CH,-7 + 2PATCH + ROT CH,7 + 2PATCH + 2PATCH 177 ;SET VERT + 2PATCH 1 + MOVE CH,FNTVSP + ROT CH,-7 + 2PATCH + ROT CH,7 + 2PATCH + 2PATCH 177 ;SET LFTMAR + 2PATCH 2 + MOVE CH,MARG.L + ADD CH,MARG.H + IMUL CH,DOTPIH+DEVCXG + IDIVI CH,1000. + POP P,CC + ROT CH,-7 + 2PATCH + ROT CH,7 + 2PATCH + SKIPN FNTSPC + JRST CRLOU2 +IFN 0,[ 2PATCH 177 ;UB + 2PATCH 15 +];IFN 0 +REPEAT 2,[ + 2PATCH 177 ;A= or B= + 2PATCH 61+.RPCNT + SKIPE FNTFN1+FNTF0+.RPCNT*FNTFL + SKIPG CH,FNTID+FNTF0+.RPCNT*FNTFL + MOVEI CH,0 + ROT CH,-7 + 2PATCH + ROT CH,7 + 2PATCH +];REPEAT 2 + 2PATCH 177 ;UA + 2PATCH 14 + JRST CRLOU2 + +2FNTIX: TLNE F,FLXGP ;PREFIX THESE COMMANDS ONLY IF /X + SKIPE TEXGPP ;AND NOT /L[TEXT]. + 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 + MOVE B,[SIXBIT\/LMAR=\] + JSP H,SIXOUT + MOVE A,MARG.L + ADD A,MARG.H + IMUL A,DOTPIH+DEVIXG + IDIVI A,1000. + PUSHJ P,000XCR + MOVEI B,[ASCIZ\/RMAR=\] + PUSHJ P,ASCOUT + MOVN A,MARG.R + IMUL A,DOTPIH+DEVIXG + IDIVI A,1000. + ADD A,LNLDOT+DEVIXG + PUSHJ P,000XCR + MOVEI B,[ASCIZ\/TMAR=\] + PUSHJ P,ASCOUT + MOVE A,MARG.T + IMUL A,DOTPIV+DEVIXG + IDIVI A,1000. + PUSHJ P,000XCR + MOVEI B,[ASCIZ\/BMAR=1 +/XLINE=\] + PUSHJ P,ASCOUT + MOVE A,FNTVSP + PUSHJ P,000XCR +];SAI + +NOSAI,[ MOVEI B,[ASCIZ /;SKIP 1 +;LFTMAR /] + PUSHJ P,ASCOUT + MOVE A,MARG.L + ADD A,MARG.H + MOVE B,DEVICE + IMUL A,DOTPIH(B) + IDIVI A,1000. + PUSHJ P,000XCR + MOVEI B,[ASCIZ/;TOPMAR /] + PUSHJ P,ASCOUT + MOVE A,MARG.T + MOVE B,DEVICE + IMUL A,DOTPIV(B) + IDIVI A,1000. + PUSHJ P,000XCR + MOVEI B,[ASCIZ /;BOTMAR /] + PUSHJ P,ASCOUT + MOVE A,MARG.B + MOVE B,DEVICE + IMUL A,DOTPIV(B) + IDIVI A,1000. + PUSHJ P,000XCR + 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,000XCR ;TELL XGP PROGRAM ABOUT DESIRED VSP: ";VSP " +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,SP000X + MOVEI B,[ASCIZ /, LINEL = /] + PUSHJ P,ASCOUT + MOVE A,LINEL + PUSHJ P,000XCR +];NOSAI + 2PATCH ^L + JRST 2OUTPJ +];XGP + +;PRINT A LIST OF THE FONTS SPECIFIED, SEPARATED BY COMMAS. CLOBBERS A,B,H,L,CH. +2OUTF1: +REPEAT NFNTS,[ +IFN .RPCNT,2PATCH [",] + MOVEI L,FNTF0+.RPCNT*FNTFL-F.RSNM ;F.RSNM COMPENSATES FOR FILOUT + PUSHJ P,2OUTF9 +];REPEAT NFNTS + POPJ P, + +2OUTF9: +PRESS,[ MOVE CH,DEVICE ;IF OUR DEVICE WANTS PRESS FILES, FONT NAMES AREN'T FILENAMES. + SKIPGE FRCXGP(CH) ;DON'T USE PRESSP HERE! SEE DLREC. + JRST [ MOVEI L,F.RSNM(L) ;TURN L BACK TO INDEX INTO FNTSNM. + MOVE A,[PUSHJ P,CHROUT] ;PRINT OUT PRESS FILE FONT NAME. + JRST PRSPFN ] +];PRESS + SKIPE F.RFN1(L) ;DON'T PRINT ANYTHING FOR UNSPECIFIED FONTS. + JRST FNTOUT + POPJ P, + SUBTTL Assorted Anadex printer code + +NOANADEX,ADAINI==:CPOPJ +ANADEX,[ +ADAINI: + POPJ P, +]; ANADEX + +SUBTTL Assorted Florida Data OSP-130 code +NOFLORIDA,FLAINI==:CPOPJ +FLORIDA,[ +FLAINI: + POPJ P, +];FLORIDA + +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 +TNX,[ + CALL TF6TOA ; Get filename in ASCIZ + PUSH P,A ? PUSH P,B + HRROI B,TFILNM ; Point to asciz string + MOVE A,[GJ%OLD+GJ%SHT] + GTJFN + JRST 2INOP9 + HRRZM A,JFNCHS+UTIC ; Save JFN + MOVE B,[440000,,0+OF%RD] + OPENF + JRST [ MOVE A,JFNCHS+UTIC + RLJFN + NOP + SETZM JFNCHS+UTIC + JRST 2INOP9] + HRLOI D,377777 ; For now, too lazy to get length. + POP P,B ? POP P,A +];TNX +DOS,[ MOVEM R,INCHN + 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 +];DOS + 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, +TNX,[ +2INOP9: POP P,B ? POP P,A + JRST POPCHD +];TNX + +2RDAHD: +ITS,[ HRROI D,INBFRW + .IOT UTIC,D + SKIPGE D + SETZM LFILE +];ITS +TNX,[ PUSH P,A ? PUSH P,B + MOVE A,JFNCHS+UTIC + BIN ; Probably should check for error. + ERJMP [SETZM LFILE ; Assume EOF + JRST .+2] ; Skip over the MOVEM + MOVEM B,INBFRW + POP P,B ? POP P,A +];TNX + POPJ P, + +SUBTTL T(W)ENEX file handling routines + +TNX,[ + + +; TF6TOA - Convert a 4-wd SIXBIT filename block to an ASCIZ string in TFILNM +; A - ptr to block +TF6TOA: PUSH P,B + MOVE B,[440700,,TFILNM] + SETZM TFILNM ; Ensure string initially empty + CALL TF6TOB + POP P,B + RET + +TF6TOB: PUSH P,A ? PUSH P,C ? PUSH P,D + MOVE D,A + SKIPE A,1(D) ; Device name + JRST [ +T20,[ SKIPE (D) ; If T20, then only output dev if no dir, + JRST .+1 ; since the DIRST will hack the "dev"! +] + CALL TF6OUT + MOVEI C,": + IDPB C,B + JRST .+1] + MOVE A,B + SKIPE B,(D) ; Directory name (if any) + JRST [ +10X, MOVEI C,"< ? IDPB C,A + MOVE C,A ; Preserve byte pointer in case of failure + DIRST ; T20 adds punctuation by itself. + ERCAL [MOVE A,C ; If fail, restore old byte pointer + POPJ P,] +10X, MOVEI C,"> ? IDPB C,A + JRST .+1] + MOVE B,A + MOVE A,2(D) ; Should always have filename! + CALL TF6OUT + MOVEI C,". + IDPB C,B + SKIPE A,3(D) ; Extension can be null + CAIN A,1 ; (also allow for our null-spec convention) + CAIA + CALL TF6OUT + SETZ C, + IDPB C,B + POP P,D ? POP P,C ? POP P,A + RET + +TF6OUT: PUSH P,C ? PUSH P,D + MOVE D,A + JRST TF6OU3 +TF6OU2: SETZ C, + LSHC C,6 + ADDI C,40 + IDPB C,B +TF6OU3: JUMPN D,TF6OU2 + POP P,D ? POP P,C + RET + +; LBPASZ - Get length of ASCIZ string. +; A - BP to string +; Returns A - # chars + +LBPASZ: PUSH P,B ? PUSH P,C + MOVE B,A + TDZA A,A +LBPAS1: ADDI A,1 + ILDB C,B + JUMPN C,LBPAS1 + POP P,C ? POP P,B + RET +];TNX + +SUBTTL PRESS FILE OUTPUT ROUTINES + +NOPRESS,PRSINI==:CPOPJ + +PRESS,[ + +;INITIALIZE THE ENTITY AND PART DIRECTORY BUFFERS, AND SP, FOR PRESS FILE OUTPUT. +;ALSO INIT VARIOUS OTHER RANDOM VARIABLES WE NEED. +PRSINI: HRLI SP,041000 ;MAKE SP AN 8-BIT B.P. + MOVE CH,LINEL + IMUL CH,FNTWID + MOVEM CH,PRESSW ;COMPUTE EFFECTIVE PAGE WIDTH (NOT INCL MARGINS) + MOVN CH,MARG.T + SUB CH,MARG.B + MOVE H,DEVICE + CAIN H,DEVLDO ;for /D[Dover Landscape] + SUB CH,MARG.H ; the holes are at the top + IMULI CH,2540. + IDIVI CH,1000. ;CONVERT MILS TO MICAS. + ADD CH,PGLDOT(H) ;COMPUTE EFFECTIVE PAGE HEIGHT (NOT INCL MARGINS) + MOVEM CH,PRESSH + MOVE CH,[356,,357] ;COMPUTE THE "SET X" AND "SET Y" COMMANDS + SKIPL PRESSP + MOVS CH,CH ;FOR LANDSCAPE DOVER THEY ARE SWAPPED + MOVEM CH,PRSXY + SKIPE ENTBUF ;IS THERE AN ENTITY BUFFER YET? + JRST PRSIN1 + MOVE CH,ENTCNT ;GET SIZE. + ASH CH,-2 ;GET # OF PDP-10 WORDS + CAIGE CH,200 ;AT LEAST THIS BIG + MOVEI CH,200 + HRROI H,1(DP) + TLC H,-1(CH) + MOVEM H,ENTBUF ;STORE AOBJN POINTER TO SPACE WE WILL USE. + PUSHJ P,PRSINA ;ALLOCATE THE SPACE +PRSIN1: HLRE CH,ENTBUF ;ENTBUF EXISTS; INIT POINTERS TO IT. + LSH CH,2 + MOVNM CH,ENTCNT ;NUMBER OF FREE BYTES + HRRZ CH,ENTBUF + HRLI CH,441000 + MOVEM CH,ENTBPT ;STORING POINTER. +;NOW ALLOCATE PART DIR BUFFER. + SKIPE DIRBUF ;IS THERE A PART DIR BUFFER YET? + JRST PRSIN2 + SOSG CH,DIRCNT ;GET SIZE. + TDZA CH,CH ;WE NEED AT LEAST ONE WORD + ASH CH,-1 ;GET # OF PDP-10 WORDS + HRROI H,1(DP) + TLC H,1-1(CH) + MOVEM H,DIRBUF ;STORE AOBJN POINTER TO SPACE WE WILL USE. + PUSHJ P,PRSINA ;ALLOCATE THE SPACE +PRSIN2: HLRE CH,DIRBUF ;DIRBUF EXISTS; INIT POINTERS TO IT. + LSH CH,1 + MOVNM CH,DIRCNT ;NUMBER OF FREE BYTES + HRRZ CH,DIRBUF + HRLI CH,442200 + MOVEM CH,DIRBPT ;STORING POINTER. + PUSHJ P,PRSFDR + JRST PRSPIN ;INIT FOR FIRST PAGE. + +PRSINA: HLLO CH,DP ;FIRST TAKE WHAT WE CAN GET CHEAPLY + CAMGE CH,H ;IS IT MORE THAN WE NEED? + HLLO CH,H ;YES, TAKE JUST WHAT WE NEED + TSC CH,CH + ADD DP,CH + ADD H,CH + PUSH DP, ;MAKE SURE CORE IS ALLOCATED + AOBJN H,PRSINA + POPJ P, + +;OUTPUT THE FONT DIRECTORY PART. +PRSFDR: PUSH P,ENTBPT + PUSH P,ENTCNT + MOVE B,ENTBUF + SETZM (B) ;CLEAR OUT ENTITY BUFFER (THE PART WE WILL USE) + AOS (B) ;SET THE LOW ORDER BIT IN EACH WORD SO OBVIOUSLY NOT AN ASCII FILE + HRLZI D,(B) ;SO OUR PADDING WILL BE ZEROES. + HRRI D,1(B) + BLT D,128.-1(B) + SETZ B, ;B COUNTS FONT WE ARE OUTPUTTING. + ;@'S FONTS 1, 2 AND 3 ARE PRESS FILE FONTS 0, 1 AND 2. +;OUTPUT THE NEXT FONT'S NAME. +PRSFD1: MOVE C,B + IMULI C,FNTFL + ADDI C,FNTF0 ;GET ADDRESS OF DATA BLOCK OF THIS FONT. + SKIPN FNTSNM(C) ;MENTION ONLY THE FONTS WHICH ARE SPECIFIED. + JRST PRSFD6 + MOVEI A,16. ;ENTRY LENGTH IN WORDS. + PUSHJ P,PRSEWD + MOVEI A,0 ;FONT SET 0 + PUSHJ P,PRSEBT + MOVE A,B ;FONT NUMBER IN B. + PUSHJ P,PRSEBT + MOVEI A,0 ;USE ALL THE CHARACTERS OF THE FONT, 0 - 127. + PUSHJ P,PRSEBT + MOVEI A,127. + PUSHJ P,PRSEBT + PUSHJ P,PRSFD2 ;OUTPUT FONT FAMILY NAME. C IS ITS ADDRESS. + HLRZ A,FNTFN2(C) + PUSHJ P,PRSEBT ;OUTPUT FONT FACE CODE. + SETZ A, + PUSHJ P,PRSEBT ;START WITH CHARACTER 0 OF THE FONT. + HRRZ A,FNTFN2(C) + PUSHJ P,PRSEWD ;OUTPUT SIZE OF FONT. + SKIPG PRESSP + TDZA A,A + MOVEI A,90.*60. + PUSHJ P,PRSEWD ;OUTPUT ROTATION +PRSFD6: CAIE B,NFNTS-1 ;OUTPUT FONTS 0, 1, 2. + AOJG B,PRSFD1 + SETZ A, + PUSHJ P,PRSEWD ;END THE FONT DIRECTORY. + OUTWDS A,ENTBUF,200 ;OUTPUT A FULL RECORD. + SOSGE DIRCNT ;COUNT OFF SPACE IN DIRBUF + .VALUE ;CAN'T OVERFLOW SINCE WE ARE JUST STARTING. + MOVEI A,128. + IDPB A,DIRBPT ;SAVE LENGTH OF THIS PART FOR LATER + POP P,ENTCNT + POP P,ENTBPT + POPJ P, + +;OUTPUT A FONT FAMILY NAME AS A 20 BYTE BCPL STRING. +;C CONTAINS INDEX INTO FONT NAME TABLES. CLOBBERS A. +PRSFD2: PUSH P,B + PUSH P,C + ADD C,[440600,,FNTSNM] + PUSH P,C ;SAVE POINTER TO START OF FAMILY NAME, SO WE CAN SCAN TWICE. + MOVNI B,18. ;B COUNTS NUMBER OF CHARACTERS (MINUS 18) +PRSFD3: ILDB A,C + JUMPE A,PRSFD4 + AOJL B,PRSFD3 +PRSFD4: MOVEI A,18.(B) ;NOW A HAS EXACTLY THE COUNT OF CHARACTERS. + PUSHJ P,PRSEBT ;STORE THE COUNT. + POP P,C + MOVEI B,19. ;NOW OUTPUT 19 CHARS OF STRING +PRSFD5: SKIPE A ;FILL IT OUT WITH ZEROS. + ILDB A,C + SKIPE A + ADDI A,40 + PUSHJ P,PRSEBT + SOJG B,PRSFD5 ;JUMP HERE TO OMIT A FONT WHICH ISN'T SPECIFIED. + POP P,C + POP P,B + POPJ P, + +;PRINT TO OUTPUT FILE THE NAME OF A FONT. L INDEXES THE FONT. +;A SHOULD CONTAIN THE INSTRUCTION FOR OUTPUTTING A CHARACTER IN CH. +;CLOBBERS B AND CH. +PRSPFN: SKIPN (L) ;OUTPUT NOTHING IF FONT NOT SPECIFIED. + POPJ P, + PUSH P,A ;SAVE OUTPUT INSN. + MOVE A,[440600,,FNTSNM(L)] +PRSPF1: ILDB CH,A ;FETCH SIXBIT CHARACTERS OF FONT NAME, + JUMPE CH,PRSPF2 + ADDI CH,40 ;CONVERT TO ASCII AND OUTPUT. + XCT (P) + CAME A,[000600,,FNTFN1(L)] ;STOP AFTER 3 WORDS IF IT DOESN'T RUN OUT BEFORE THEN. + JRST PRSPF1 +PRSPF2: MOVEI CH,40 + XCT (P) + PUSH P,C + MOVE C,-1(P) + HRRZ A,FNTFN2(L) ;OUTPUT POINT SIZE. + PUSHJ P,PRSPF8 + POP P,C + HLRZ A,FNTFN2(L) ;GET FACE CODE, TURN INTO LETTERS AND PRINT. + CAIGE A,12. ;SEE FPSDF FOR THE INVERSE TRANSFORMATION, + JRST PRSPF3 ;WITH COMMENTS. + MOVEI CH,"E + XCT (P) + SUBI A,12. +PRSPF3: CAIGE A,6 + JRST PRSPF4 + MOVEI CH,"C + XCT (P) + SUBI A,6 +PRSPF4: TRZN A,1 + JRST PRSPF5 + MOVEI CH,"I + XCT (P) +PRSPF5: CAIGE A,4 + JRST PRSPF6 + MOVEI CH,"L + XCT (P) + SUBI A,4 +PRSPF6: CAIGE A,2 + JRST PRSPF7 + MOVEI CH,"B + XCT (P) +PRSPF7: JRST POPAJ + +;PRINT DECIMAL NUMBER IN A OUTPUTTING CHAR IN CH THROUGH INSN IN C. +PRSPF8: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,PRSPF8 + HLRZ CH,(P) + ADDI CH,"0 + XCT C + POPJ P, + +;CONSTRUCT AN ENTITY COMMAND FOR SOME PRINTING CHARACTERS THAT ARE IN SLBUF. +;PRTCBP IS THE BP TO ILDB THE FIRST OF THEM. SP POINTS AT THE LAST. +PRSCHS: PUSH P,A + MOVE A,SP ;COMPUTE NUMBER OF CHARACTERS FROM PRTCBP TO SP. + SUB A,PRTCBP + JUMPE A,POPAJ ;EXIT DOING NOTHING IF SP HASN'T BEEN TOUCHED. + PUSH P,B + PUSH P,CH + LDB B,[410300,,SP] + LDB CH,[410300,,PRTCBP] + ANDI A,-1 + LSH A,2 ;GET 4* WORDS OF DIFFERENCE + SUB CH,B ;PLUS EXTRA BYTES OF DIFFERENCE + ADD A,CH ;TO GET NUMBER OF CHARACTERS IN THE RANGE. + PUSH P,A + PUSH P,A + HLRZ A,PRSXY ;"SET X" COMMAND + PUSHJ P,PRSEBT + MOVE A,PRESSX + PUSHJ P,PRSEWD ;WITH X POS AS ARGUMENT, TWO BYTES. +PRSCH1: MOVEI A,360 ;"SHOW CHARACTERS" COMMAND. + PUSHJ P,PRSEBT + MOVE A,(P) + CAIL A,400 + MOVEI A,377 + PUSHJ P,PRSEBT ;ARG IS NUMBER OF CHARS. MAX AT ONE TIME IS 377, + MOVNS A ;SO IF THERE ARE MORE THAN THAT, + ADDB A,(P) ;COUNT THEM OFF + JUMPN A,PRSCH1 ;AND DO IT SEVERAL TIMES. + POP P,A + POP P,A + MOVEM SP,PRTCBP ;REMEMBER WHERE NEXT "SHOW CHARACTERS" SHOULD START. + IMUL A,FNTWID + ADDM A,PRESSX ;INCREMENT X POSITION OVER THE CHARACTERS. + POP P,CH + JRST POPBAJ + +;SELECT FONT. FONT NUMBER IN A. CLOBBERS A. +PRSFNT: PUSHJ P,PRSCHS ;DEAL WITH ANY ACCUMULATED PRINTING CHARACTERS. + MOVEM A,PRESSF ;SAVE FONT FOR FUTURE REFERENCE BY PRSTAB + ADDI A,160 ;ADD "FONT" COMMAND CODE TO FONT NUMBER. + JRST PRSEBT + +;UNDERLINE ON THIS LINE FROM SAVED X POSITION IN UNDRLN TO CURRENT X POSITION. +PRSUND: PUSHJ P,PRSCHS ;FORCE OUT PRINTING CHARS TO LEARN CURRENT X POS. + HLRZ A,PRSXY ;"SET X" TO X POS OF START OF UNDERLINE. + PUSHJ P,PRSEBT + HRRZ A,UNDRLN + PUSHJ P,PRSEWD + HRRZ A,PRSXY ;"SET Y" TO A LITTLE BELOW THE BASELINE. + PUSHJ P,PRSEBT + MOVE A,PRESSY + ADDI A,51. ;DOWN 0.02" FOR TOP OF UNDERLINE. + SKIPG PRESSP ;IF PORTRAIT ORIENTATION + SUBI A,51.+51.+24. ; THEN Y GOES THE OTHER WAY + PUSHJ P,PRSEWD + MOVEI A,376 ;"SHOW RECTANGLE" FOR THE UNDERLINE. + PUSHJ P,PRSEBT + MOVEI A,24. + SKIPL PRESSP ;FOR LANDSCAPE ORIENTATION PUT OUT THE THICKNESS EARLY. + PUSHJ P,PRSEWD ;FOLLOWED BY THICKNESS (ABOUT 1/100 INCH). + MOVE A,PRESSX + SUB A,UNDRLN + PUSHJ P,PRSEWD ;1ST ARG IS WIDTH OF UNDERLINE. + MOVEI A,24. + SKIPG PRESSP ;FOR LANDSCAPE ORIENTATION THE THICKNESS IS ALREADY OUT. + PUSHJ P,PRSEWD ;FOLLOWED BY THICKNESS (ABOUT 1/100 INCH). + HRRZ A,PRSXY ;SET Y POSITION BACK TO BASELINE. + PUSHJ P,PRSEBT + MOVE A,PRESSY + SETZM UNDRLN + DROPTHRUTO PRSEWD + +;OUTPUT NUMBER IN A AS TWO BYTES TO ENTITY BUFFER. +PRSEWD: ROT A,-8 + IDPB A,ENTBPT + ROT A,8 + SOS ENTCNT +;OUTPUT BYTE IN A TO ENTITY BUFFER. +PRSEBT: IDPB A,ENTBPT + SOSL ENTCNT + POPJ P, +PRSP7: STRT [ASCIZ/Entity buffer is full. Try larger value in ENTCNT. +/] + .VALUE + +;MOVE TO NEXT LINE OF PAGE. SET THE Y POSITION TO THE NEW BASELINE. +;Y DECREASES DOWN THE PAGE. CLOBBERS NO ACS. +PRSLIN: PUSHJ P,PRSCHS + SETZM PRESSX + CAIA +;MOVE VERTICALLY DOWN ("OUTPUT A ^J"). +PRSLF: PUSHJ P,PRSCHS + PUSH P,A + HRRZ A,PRSXY ;"SET Y" COMMAND + PUSHJ P,PRSEBT + MOVE A,FNTVSP + IMULI A,13. ;USE A KLUDGE TO FUDGE IT TO MICAS + ADD A,FNTHGT + SKIPG PRESSP ;IF PORTRAIT ORIENTATION + MOVN A,A ;THEN LF DECREASES Y + ADDB A,PRESSY + PUSHJ P,PRSEWD + JRST POPAJ + +;JUMP THROUGH THIS TABLE TO HANDLE ASCII CONTROL-CHARS FROM 10 THRU 15. +PRSFMT: PRSBS ;^H + PRSTAB ;^I + PRSLF ;^J + PRSNRM ;^K + PRSPAG ;^L + PRSCR ;^M + +PRSNRM: 2PATCH + POPJ P, + +;MOVE TO LEFT MARGIN ("OUTPUT A ^M"). +PRSCR: PUSHJ P,PRSCHS + SETZM PRESSX + POPJ P, + +;DO THE EQUIVALENT OF A TAB, IN A PRESS FILE. +PRSTAB: PUSHJ P,PRSCHS + INSIRP PUSH P,A B + MOVE A,NTABS ;COMPUTE LEFT MARGIN OF TEXT + LSH A,3 + MOVE CH,FNTWDN + IMUL A,CH + CAMG A,PRESSX ;IF WE ARE TO THE LEFT OF THAT + SKIPN PRESSF ;OR WE ARE IN FONT 1 ANYWAY + TDZA A,A ;THEN REF THE TAB TO REAL LEFT MARGIN + MOVE CH,FNTWID + SUB A,PRESSX ;GET NEGATIVE OF OUR POSITION + LSH CH,3 + IDIV A,CH ;GET THAT MOD TAB WIDTH (ALSO NEGATIVE) + ADD B,CH + ADDM B,PRESSX ;AND TAB APPROPRIATELY + JRST POPBAJ + +;DO A BACKSPACE TO A PRESS FILE. +PRSBS: PUSHJ P,PRSCHS + PUSH P,A + MOVN A,FNTWID + ADDM A,PRESSX + JRST POPAJ + +;FINISH A PAGE. +PRSPAG: PUSHJ P,PRSCHS ;MAKE ENTITY COMMAND FOR LAST FEW CHARS IN SLBUF. + MOVEI CH,SLBUF-1 + SKIPN PAGWDS ;DON'T OUTPUT AN EMPTY PAGE. + CAIE CH,(SP) + TDZA CH,CH ;CLEAR CH FOR LATER + POPJ P, + INSIRP PUSH P,A B C + IDPB CH,SP ;OUTPUT AT LEAST 2 DATA BYTES OF ZERO, +PRSP1: IDPB CH,SP + TLNE SP,300000 ;PLUS ENOUGH MORE TO GET TO PDP-10 WORD BOUNDARY + JRST PRSP1 + MOVEM SP,PRTCBP ;DON'T CALL PRSCHS FROM 2OUTB1. + PUSHJ P,2OUTB1 ;NOW FORCE OUT ALL OF SLBUF EVEN IF IT ISN'T FULL. + ;SINCE WE ARE ON A PDP-10 WORD BNDRY, NOTHING IS LEFT. + MOVE A,ENTCNT ;MAKE SURE WE HAVE ROOM FOR THE ENTITY TRAILER + CAIGE A,24. + JRST PRSP7 + MOVEI CH,377 + SKIPA A,ENTBPT +PRSP3: IDPB CH,A ;NOW PAD ENTITY TO PDP-10 WORD BOUNDARY WITH NO-OP COMMANDS. + TLNE A,300000 + JRST PRSP3 + +;NOW WRITE ENTITY TRAILER IN ENTBUF TO TERMINATE THE ENTITY COMMANDS. + HRLI A,042000 ;SWITCH TO WRITING 16-BIT ALTO WORDS + SETZ CH, + IDPB CH,A ;STORE ENTITY TYPE (0) & FONT SET (0) +REPEAT 2,IDPB CH,A ;STORE STARTING DATA BYTE NUMBER + MOVE B,PAGWDS ;STORE NUMBER OF DATA BYTES IN 2 WORDS. + LSH B,2 + SUBI B,2 ;BUT OMIT 2 BYTES OF THE PADDING FROM THE COUNT + ROT B,-16. ;BECAUSE THEY ARE REALLY THE REQUIRED WORD OF ZERO + IDPB B,A ;BETWEEN THE DATA LIST AND THE ENTITY LIST + ROT B,16. + IDPB B,A + SKIPL PRESSP + SKIPA B,MARG.T + MOVE B,MARG.L + ADD B,MARG.H ;DON'T FORGET SPACE FOR THE HOLES + IMULI B,2540. + IDIVI B,1000. ;COMPUTE LEFT MARGIN IN MICAS. + IDPB B,A ;OUTPUT IT (XE). + SKIPL PRESSP + SKIPA B,MARG.L + MOVE B,MARG.B + IMULI B,2540. + IDIVI B,1000. ;COMPUTE BOTTOM MARGIN IN MICAS. + IDPB B,A ;OUTPUT IT (YE) + SETZ CH, ;STORE ZERO AS LEFT AND BOTTOM +REPEAT 2,IDPB CH,A + MOVE B,PRESSW ;STORE WIDTH OF PAGE IN MICAS AS WIDTH OF ENTRY. + MOVE CH,PRESSH ;STORE HEIGHT OF PAGE IN MICAS AS HEIGHT OF ENTRY. + SKIPL PRESSP ;FOR LANDSCAPE ORIENTATION + EXCH B,CH ;WE SWAP THEM + IDPB B,A + IDPB CH,A ;A NOW POINTS 2 BYTES INTO A PDP-10 WORD. + MOVEI B,1(A) ;COMPUTE LENGTH IN PDP-10 WORDS OF ENTRY. + SUB B,ENTBUF + MOVEI CH,(B) + ADDM CH,PAGWDS ;ACCUMULATE INTO TOTAL SIZE OF PAGE. + LSH CH,1 ;GET SIZE OF ENTRY, IN ALTO WORDS. + IDPB CH,A ;STORE IN LAST TWO BYTES OF ENTRY, FILLING OUT PDP-10 WORD. + OUTWDS A,ENTBUF,0(B) ;OUTPUT A BLOCK + HRRZ A,ENTBUF ;RE-INITIALIZE POINTERS IN ENTBUF. + HRLI A,441000 + MOVEM A,ENTBPT + HLRE A,ENTBUF + LSH A,2 + MOVNM A,ENTCNT + MOVE B,PAGWDS ;GET LENGTH OF THIS ENTITY IN PDP-10 WORDS + TLNE B,-1 ;MAKE SURE IT FITS IN 18 BITS + .VALUE + SOSGE DIRCNT ;CHECK FOR ROOM IN DIRBUF + JRST [ STRT [ASCIZ/Part directory buffer is full. Try larger value in DIRCNT. +/] + .VALUE ] + IDPB B,DIRBPT ;STORE THAT NUMBER FOR USE IN PART DIRECTORY. + TRCN B,177 ;CHECK IF WE NEED PADDING + JRST PRSP6 ;IF NONE NEEDED, DO NOTHING + ANDI B,177 + OUTWDS A,ENTBUF,1(B) ;CHOOSE SOME RANDOM GARBAGE TO PAD WITH +PRSP6: + INSIRP POP P,C B A + DROPTHRUTO PRSPIN + +;DROPS THROUGH +;INIT FOR NEXT PAGE. +PRSPIN: SETZM PAGWDS ;ZERO WORDS IN NEXT PAGE, SO FAR. + MOVE SP,[041000,,SLBUF-1] + MOVEM SP,PRTCBP ;NO PRINTING CHARACTERS IN IT YET. + SETZM PRESSX ;X POS SET TO LEFT MARGIN. + PUSH P,A + HRRZ A,PRSXY ;"SET Y" COMMAND + PUSHJ P,PRSEBT + MOVE A,FNTHGT ;Y POS SET UP FOR FIRST LINE OF PAGE. + SUB A,FNTBAS + SKIPL PRESSP ;FOR PORTRAIT ORIENTATION + JRST PRSPI2 + MOVN A,A ;WE GO THE OTHER WAY FROM THE TOP + ADD A,PRESSH +PRSPI2: MOVEM A,PRESSY + PUSHJ P,PRSEWD + JRST POPAJ + +;OUTPUT THE PART DIRECTORY AND DOCUMENT DIRECTORY OF A PRESS FILE. +;WHEN WE RETURN, THE FILE IS READY TO BE CLOSED. +;PRESERVES A AND L. +PRSDIR: PUSH P,A + PUSH P,L + PUSHJ P,PRSPAG ;FORCE OUT LAST PAGE. +IFL LSLBUF-200, .ERR LSLBUF must be at least 200 for PRSDIR + MOVE SP,[042000,,SLBUF-1] ;USE SLBUF TO ACCUMULATE PART DIRECTORY. + HRRZ CP,DIRBUF ;CP POINTS AT PART'S INFO IN PART DIR BUFFER. + HRLI CP,442200 + SETZB R,L ;R HAS PART NUMBER; L HAS ACCUMULATED RECORD COUNT + MOVEI D,1 ;1ST PART IS TYPE 1 (FONT DIR) +PRSD1: CAMN CP,DIRBPT ;FINISHED ALL PARTS? + JRST PRSD2 + MOVEM SP,PRTCBP + PUSHJ P,2OUTPJ ;MAYBE FORCE OUT BUFFER IF GETTING FULL. + IDPB D,SP ;OUTPUT PART TYPE AS WORD. + IDPB L,SP ;OUTPUT STARTING RECORD NUMBER + ILDB A,CP ;GET LENGTH IN ALTO WORDS + LSH A,1 + ADDI A,377 ;CONVERT TO RECORD COUNT + IDIVI A,400 + ADD L,A ;ACCUMULATE IN TOTAL LENGTH + IDPB A,SP ;OUTPUT. + XORI B,377 + IDPB B,SP + SETZ D, ;ALL PARTS EXCEPT 0 ARE TYPE 0 (PRINTED PAGE). + AOJA R,PRSD1 + +;PAD AND ACTUALLY WRITE OUT THE PART DIRECTORY. +PRSD2: MOVEM SP,PRTCBP ;FORGET ABOUT MAKING ENTITY COMMANDS. + PUSHJ P,2OUTB1 ;FORCE OUT WHAT WE HAVE COMPUTED. + MOVE B,PAGWDS + TRCN B,177 + JRST PRSD4 + ANDI B,177 + OUTWDS A,ENTBUF,1(B) ;AND OUTPUT SOME RANDOM PADDING +;NOW OUTPUT DOCUMENT DIRECTORY. +PRSD4: SETZM PAGWDS + MOVEI A,27183. ;WORD 0 IS A MAGIC CHECK FOR THIS REALLY BEING A PRESS FILE. + IDPB A,SP + MOVE A,R + LSH A,2 ;FIRST, HOW MANY RECS IN PART DIR? COMPUTE FROM # OR PARTS. + ADDI A,377 + IDIVI A,400 ;A HAS # RECS IN PART DIR. + MOVE D,A + ADDI A,1(L) ; + # RECS IN THE PARTS, + 1 FOR THIS RECORD, GIVES TOTAL SIZE + IDPB A,SP ;WHICH GOES IN WORD 1. + IDPB R,SP ;WORD 2 IS NUMBER OF PARTS + IDPB L,SP ;WORD 3 IS RECORD AT WHICH PART DIR STARTS. + IDPB D,SP ;WORD 4 IS SIZE OF PART DIR. + SETO D, + IDPB D,SP ;WORD 5 ("BACKPOINTER") IS UNUSED BY US + MOVEI A,112115 ;WORDS 6,7 SHOULD BE SECONDS SINCE 00:00, 1 JAN 1901. +REPEAT 2,IDPB A,SP ; A RECENT CONSTANT WILL SUFFICE. + MOVEI A,1 +REPEAT 2,IDPB A,SP ;WORDS 8,9 SAY PRINT ONE COPY. +REPEAT 2,IDPB D,SP ;WORDS 10,11 ARE RANGE OF PAGES. -1 FOR BOTH MEANS ALL PAGES. + IDPB D,SP ;WORD 12 IS PRINTING MODE. USE THE DEFAULT. + MOVEI B,200-13. + IDPB D,SP ;PAD WITH -1'S TO WORD 200 + SOJG B,.-1 +;NOW OUTPUT FILENAME, FOR DOVER TITLE PAGE. + TLC SP,003000 ;SWITCH TO 8-BIT BYTES + IBP SP ;SKIP OVER THE BYTE WHICH WILL HOLD THE STRING LENGTH. + PUSH P,SP ;SAVE BP TO THIS BYTE, TO STORE THROUGH LATER + SETZ CC, ;CC WILL COUNT THE CHARACTERS FOR US. + MOVE L,OFILE + CAIL L,FILES ;USUALLY USE THE OUTPUT FILE'S NAME AS FILENAME FOR + CAIL L,EFILES ;PRESS FILE HEADER PAGE. + JRST PRSD5 + MOVE CH,F.OFN1(L) ;BUT, IF THIS OUTPUT FILE CORRESPONDS TO AN INPUT FILE + CAMN CH,F.RFN1(L) ;WHICH HAS THE SAME FN1 AS THE OUTPUT FILE, + SKIPE SINGLE ;AND /S HAS NOT BEEN SPECIFIED, USE INPUT FILE'S NAME. +PRSD5: MOVEI L,F.ODEV-F.RDEV(L) ;THEN USE THE OUTPUT FILENAME INSTEAD OF THE INPUT + PUSHJ P,FILOUM + POP P,A + MOVEI B,26.*2 + PUSHJ P,PRSDPD ;PAD TO 26 WORDS LONG. +;NOW OUTPUT USER'S NAME, FOR TITLE PAGE. + IBP SP ;SKIP OVER THE BYTE WHICH WILL HOLD THE STRING LENGTH. + PUSH P,SP ;SAVE BP TO THIS BYTE, TO STORE THROUGH LATER + SETZ CC, ;CC WILL COUNT THE CHARACTERS FOR US. +ITS,[ .SUSET [.RXUNAME,,B] + JSP H,SIXOUT +];ITS +BOTS,[ +SAI,[ GETPPN B, + JFCL ;IN CASE THE SILLY SKIP HITS US + HRLZS B + JSP H,SIXOUT +];SAI +NOSAI,[ 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 + TRNN C,77 ; WAS LAST CHAR A SPACE? + PUSHJ P,SPCOUT ; YES, PRINT A SPACE + HRROI B,32 ; .GTNM2 + GETTAB B, ; GET SECOND HALF OF USER NAME + SETZ B, ; SICK MONITOR + JSP H,SIXOUT +];NOSAI +];BOTS +TNX,[ + GJINF ; Get user # (10X: logged-in dir #) in A + MOVE B,A ; (clobbers A-D) + HRROI A,PPNBUF + DIRST ; Output dir or user string + SETZM PPNBUF + MOVEI B,PPNBUF + CALL ASCOUT +];TNX + POP P,A + MOVEI B,16.*2 + PUSHJ P,PRSDPD ;PAD TO 16 WORDS LONG. +;NOW OUTPUT TODAY'S DATE FOR TITLE PAGE. + IBP SP ;SKIP OVER THE BYTE WHICH WILL HOLD THE STRING LENGTH. + PUSH P,SP ;SAVE BP TO THIS BYTE, TO STORE THROUGH LATER + SETZ CC, ;CC WILL COUNT THE CHARACTERS FOR US. +ITS,[ .CALL [ SETZ ? 'RQDATE ? SETZM R] + SETZ R, + PUSHJ P,PTQNM ;PRINT DATE, NO PHASE OF MOON. +];ITS +TNX,[ SETO A, ; Use current time + CALL DATNXC ; Convert to DEC fmt in A,B + CALL PTDATE ; Print it. +] +BOTS,[ DATE A, ; DATE AND TIME + MSTIME B, + IDIVI B,60.*1000. ;BUT DON'T PRINT THE SECONDS + IMULI B,60.*1000. + PUSHJ P,PTDATE ; PRINT THEM +];BOTS + POP P,A + MOVEI B,<200-16.-26.>*2 ;PAD OUT REST OF RECORD. + PUSHJ P,PRSDPD + OUTWDS A,[SLBUF],200 + POP P,L + JRST POPAJ + +;A POINTS AT START OF BCPL STRING, SP AT END, CC HAS TEXT LENGTH. +;STORE THE LENGTH, AND PAD STRING TO DESIRED LENGTH IN B. +PRSDPD: CAIL CC,(B) + .VALUE ;OVERFLOW SHOULD NEVER BE POSSIBLE. + DPB CC,A ;STORE COUNT AT FRONT OF "BCPL STRING". + TDZA A,A +PRSD3: IDPB A,SP + CAIGE CC,-1(B) ;PAD STRING TO DESIRED LENGTH. + AOJA CC,PRSD3 + POPJ P, + +];PRESS + +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: MOVEI CH,10(CC) + TRZ CH,7 ;GET NEXT TAB STOP POSITION. + CAML CH,LINEL ;NO ROOM ON THIS LINE => GO TO NEXT. + JRST 2DLTP5 + PUSHJ P,2TAB ;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: MOVEI CH,10(CC) ;COMPUTE NEXT TAB STOP POSITION. + TRZ CH,7 + MOVEI CH,10.(CH) + CAML CH,LINEL ;NO ROOM ON THIS LINE => GO TO NEXT. + JRST 2DLYP5 + PUSHJ P,2TAB ;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: MOVEI CH,10(CC) + TRZ CH,7 + ADDI CH,10. + CAML CH,LINEL + JRST 2PRTP5 + PUSHJ P,2TAB + 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 [ PUSHJ P,CRLOUT + PUSHJ P,2OUTPJ + JRST 2RPLP4 ] + MOVEI CH,40 +REPEAT 2, 2PATCH +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 * PAGEL, WE WANT A NEW PAGE + CAML B,PAGEL ;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 + PUSHJ P,2TAB + MOVE B,[SIXBIT/LISTED/] + JSP H,SIXOUT + SOJLE L,2PGM5B + PUSHJ P,2TAB + PUSHJ P,2TAB + 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 + PUSHJ P,2TAB + MOVE B,[SIXBIT/AS/] + JSP H,SIXOUT + SOJLE L,2PGM5D + PUSHJ P,2TAB + PUSHJ P,2TAB + 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, + PUSHJ P,2TAB ;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, + PUSHJ P,2TAB ;PUTTING 2 TABS AFTER EACH COLUMN BUT THE LAST. + PUSHJ P,2TAB + JRST 2PGM4 + +;FINISHED PRINTING 1 LINE. +2PGM8: AOS N,OUTVP + CAML N,PAGEL1 ;ROOM FOR ANOTHER LINE ON THIS PAGE? + JRST 2PGM8C + PUSHJ P,CRLOU0 ;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 LISTING THE FILE TEXT + +;SCAN FOR REFERENCES AND MAYBE LIST THE TEXT OF THE INPUT FILE. +;B IS NEGATIVE IF THE FILE SHOULD BE LISTED. +2FILE: PUSH P,B + MOVE A,SUBTLS + MOVEM A,SUBPTR + SETZ N, ;FIRST INPUT PAGE WILL BE PAGE 1. + MOVE A,CFILE + 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 + PUSHJ P,COINIT ;INITIALIZE SYNTACTIC COROUTINE + SETOM FFSUPR ;AVOID FORMFEED BEFORE FIRST OUTPUT PAGE. +2FILE2: MOVE B,(P) + PUSHJ P,2PGPRT ;SCAN AND MAYBE LIST NEXT PAGE. PASS IT WHETHER TO LIST. + JUMPG CH,2FILE2 ;DO PAGES UNTIL EOF. + JRST POPBJ + +;SCAN AND MAYBE LIST THE NEXT PAGE OF THE INPUT FILE. +;B IS NEGATIVE IF THE FILE AS A WHOLE SHOULD BE LISTED. +;IF THE FILE IS BEING LISTED, WE MUST DECIDE WHETHER TO LIST THIS PAGE. +;WHEN WE RETURN, CH HAS 0 FOR EOF OR ^L FOR NORMAL END OF PAGE. +2PGPRT: TRO N,-1 ;THE INCREMENT BEFORE 1ST LINE WILL MAKE N = 0 (LINE 1). + ADD N,[1,,] ;INCREMENT THE PAGE NUMBER. +ITS,[ HLRZ CH,N + HRLI CH,(SIXBIT/P2/) + .SUSET [.SWHO3,,CH] +];ITS +;SHOULD THIS INPUT PAGE BE LISTED? SHOULD IT BE SCANNED? + JUMPE B,2PGPR2 ;NOT LISTED IF FILE IS NOT BEING LISTED. + SKIPN PAGTPT ;NO PAGE TABLE => LIST PAGE IF ITS # IS LARGE ENOUGH. + JRST [ HLRZ CH,N + JRST 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,[SLURP] ;DO LIST. +2PGPR2: MOVEI CH,XSLURP ;DON'T LIST. + SKIPL TEXTP + JRST 2PGPR4 + CAIN CH,SLURP + MOVEI CH,2TEXTG +2PGPR4: MOVEM CH,SLURPY + CAIE CH,XSLURP ;IF IT'S BEING LISTED, + JRST OUTIP ;MAKE ONE OR MORE LISTING PAGES FROM IT. + TLNN F,FLCREF ;IF NOT LISTED, BUT WE ARE MAKING A CREF, + SKIPE TEXGPP ;OR THIS IS A /L[TEXT]/X FILE + JRST OUTSKP ;WE MUST SCAN THE INPUT DATA CAREFULLY. +;NO NEED TO SCAN THIS PAGE AT ALL. SKIP IT AS FAST AS POSSIBLE. +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: CAIN CH,^L ;FF => STOP SKIPPING. + POPJ P, + CAIE CH,^C ;^C => MAYBE READ MORE INPUT. + JRST 2PGPR3 + MOVEI A,(IP) + CAME A,LASTIP ;IF IT'S AT THE END OF THE BUFFER, BUFFER'S EMPTY. + JRST 2PGPR3 ;ELSE ^C IS REAL. SKIP IT. + PUSHJ P,DOINPT ;IF BUFFER IS EMPTY READ MORE + JRST [ SETO CH, ;NO MORE => RETURN EOF CODE. + POPJ P,] + JRST 2PGPR3 ;IF WE GOT MORE, GET 1ST CHAR FROM IT. + +;SKIP OVER ONE INPUT FILE PAGE, PROCESSING THE REFERENCES WITHIN IT. +;SLURPY IS POINTING TO XSLURP, SO OUTLD WON'T ACTUALLY OUTPUT ANYTHING. +OUTSKP: SETZ B, + PUSHJ P,OUTLD + JUMPL CH,CPOPJ + CAIE CH,^L + JRST OUTSKP + POPJ P, + +;OUTPUT ONE INPUT PAGE'S DATA INTO ONE OR MORE PAGES OF OUTPUT LISTING. +;RETURN TERMINATING CONDITION IN CH: -1 FOR EOF, ^L FOR NORMAL END OF PAGE. +OUTIP: SETZM OUTVP ;OUTVP KEEPS COUNTING # OF OUTPUT LINES USED FOR TEXT + ;THROUGH ALL THE SUBPAGES FOR THIS INPUT PAGE. + SETOM 2MCCOL ;NOT WITHIN ANY COMMENT. + SETZM CONTIN ;FIRST LINE IS NOT A CONTINUATION. + PUSHJ P,XSLAHD ;DON'T OUTPUT A BLANK PAGE IF THIS INPUT PAGE + MOVE CH,A + JUMPL A,CPOPJ ;IS AN EMPTY ONE AT END OF FILE (LAST CHAR IN FILE IS A ^L). +;OUTPUT ONE OUTPUT PAGE OR SUBPAGE OF LISTING DATA. +OUTPP: AOSN FFSUPR + JRST OUTPP4 + 2PAGE +;FIRST, OUTPUT PAGE HEADING LINES IF DESIRED. +OUTPP4: MOVE A,TLINEL ;RESTORE THE USUAL LINEL FOR LISTING LINES. + HRRM A,2PUTNX + HRRM A,2PUTX + SKIPL TEXTP + SKIPGE HEDING ;SUPPRESS HEADING ENTIRELY? + JRST OUTPP1 + MOVE A,CFILE + MOVE A,F.SWIT(A) + TRNE A,FSSUBT ;WANT A SUBTITLE? + JRST OUTPPS + SKIPE HEDING ;WANT SOME LINES DEVOTED TO JUST HEADING? + JRST OUTPPH + SKIPN ETVFIL ;IF ETV FILE OR CONTINUATION PAGE, + SKIPE OUTVP + JRST OUTPPH ;DON'T USE FIRST LINE FOR TEXT. +;HERE IF PAGE HEADING LINE SHOULD ALSO CONTAIN THE FIRST LINE OF TEXT. + MOVE A,PLINEL ;NEITHER => FIRST TEXT LINE MUST HAVE "PAGE N" AT END + SUBI A,2 + HRRM A,2PUTNX ;SO IT MUST HAVE A SMALLER TRUNCATION POINT. + HRRM A,2PUTX + PUSHJ P,OUTLL ;PROCESS THAT LINE. + PUSH P,CH ;SAVE TERMINATING CONDITION. + PUSHJ P,OUTLPN ;ADD "PAGE N" TO END OF LINE. + MOVE A,TLINEL ;RESTORE THE USUAL LINEL FOR LISTING LINES. + HRRM A,2PUTNX + HRRM A,2PUTX + POP P,CH + JRST OUTPP2 ;TERMINATE THE LINE AND DO REMAINING TEXT LINES NORMALLY. + +OUTPPS: PUSHJ P,OUTSUB ;OUTPUT SUBTITLE LINE. + JRST OUTPP0 + +OUTPPH: MOVN CC,NTABS ;IF NO SUBTITLE BUT RESERVED HEADING LINES, + LSH CC,3 ;THE FIRST ONE CONTAINS JUST "PAGE N". + PUSHJ P,OUTLPN ;IT REPLACES THE SUBTITLE LINE. +OUTPP0: MOVE A,HEDING + PUSHJ P,CRLOUT ;OUTPUT AS MANY LINES AS DESIRED, BUT AT LEAST ONE FOR SUBTITLE. + SOJG A,.-1 ;EVEN IF HEDING IS 0. +OUTPP1: PUSHJ P,OUTLL ;OUTPUT ONE LINE SANS CRLF. +OUTPP2: JUMPL CH,OUTPPE ;IF INPUT PAGE IS ENDING, END OUTPUT PAGE. + CAIN CH,^L + JRST OUTPPE + AOS A,OUTVP ;HAVE WE FILLED UP THE OUTPUT PAGE? + TLNE F,FLQPYM + ADDI A,2 + IDIV A,PAGEL + JUMPE B,OUTPPC ;IF FULL, END THIS AND START ANOTHER SUBPAGE. + PUSHJ P,CRLOU0 + JRST OUTPP1 + +OUTPPC: TLNE F,FLQPYM ;TIME FOR A CONTINUATION PAGE (NEW SUBPAGE). + PUSHJ P,CPYOUB ;OUTPUT QOPYRIGHT MESSAGE IF DESIRED. + JRST OUTPP + +OUTPPE: PUSH P,CH + TLNE F,FLQPYM ;END OF INPUT PAGE SEEN. + PUSHJ P,CPYOUB ;OUTPUT QOPYRIGHT MESSAGE IF DESIRED. + POP P,CH + POPJ P, + +;OUTPUT A SUBTITLE LINE AT THE TOP OF A PAGE. +OUTSUB: PUSHJ P,BEGUND ;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. + TLNN F,FLNOLN ;UNLESS WE HAVE /#, OUTPUT A TAB + PUSHJ P,2TAB2 + HLRZ C,N + SKIPA A,SUBPTR ;LOOK FOR CORRECT SUBTITLE BLOCK +OUTSU7: HRRZ A,(A) + MOVEM A,SUBPTR +OUTSU0: HRRZ B,1(A) + CAME B,CFILE ;CHECK WHETHER THIS BLOCK IS FOR CURRENT FILE + JRST OUTSU9 + HLRZ B,1(A) + CAMLE B,C ;IF SAME FILE, BUT PAGE NUMBER TOO BIG, WE MUST + JRST OUTSU6 ; BE ON A PAGE BEFORE THE FIRST SUBTITLE IN THE FILE + HRRZ D,(A) ;NOW LOOK AT THE NEXT SUBTITLE BLOCK + JUMPE D,OUTSU8 ;THERE ISN'T ANY, SO USE THIS ONE + HRRZ B,1(D) + CAME B,CFILE + JRST OUTSU8 ;NEXT IS FOR ANOTHER FILE, SO USE THIS ONE + HLRZ B,1(D) + CAMG B,C + JRST OUTSU7 ;WE ARE NOT LESS THAN PAGE NUMBER OF NEXT, SO ADVANCE AND RETRY +OUTSU8: HLRE D,(A) ;A HAS CORRECT BLOCK - GET CHARACTER COUNT + ADD A,[440700,,2] ;GET BYTE POINTER TO ASCII + JUMPN D,OUTSUC + JRST OUTSU6 ;NULL SUBTITLE?? + +OUTSU9: CAML B,CFILE + .VALUE ;SUBTITLE LIST SCREWED UP + HRRZ A,(A) + MOVEM A,SUBPTR + JUMPE A,OUTSU6 + HRRZ B,1(A) + CAME B,CFILE ;FSSUBT WAS SET, SO THERE MUST BE A SUBTITLE FOR US + JRST OUTSU9 + JRST OUTSU0 + +OUTSUC: 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,OUTSUC ; OR WHEN WE RUN OUT OF SUBTITLE CHARS +OUTSU6: SUBI CC,4 ;MAKE CC CORRECT HPOS IN TEXT AREA + PUSHJ P,OUTLPN ;AND OUTPUT THE "PAGE NNN". THIS ENDS THE UNDERLINING. + POPJ P, + +;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. +OUTLPN: MOVE A,OUTVP + IDIV A,PAGEL + MOVEI D,(A) ;SAVE SUBPAGE NUMBER +OUTL0B: PUSHJ P,SPCOUT ;OUTPUT SPACES UNTIL PLINEL IS REACHED + CAMG CC,PLINEL + JRST OUTL0B + PUSHJ P,BEGUND ;START UNDERLINING IF HAVEN'T ALREADY DONE SO. +XGP,[ TLNN F,FLFNT2 + JRST OUTL0C + MOVEI CH,1 + PUSHJ P,FNTSWT +OUTL0C: ] +ITS,[ MOVE A,CFILE ;PRINT FILE NAMES + MOVE B,F.RFN1(A) + JSP H,SIXOUT + PUSHJ P,SPCOUT + MOVE A,CFILE + MOVE B,F.RFN2(A) + JSP H,SIXOUT +];ITS +TNX,[ MOVEI B,CFILNM + CALL ASCOUT ; Output ready-made filename! +];TNX +DOS,[ MOVE L,CFILE + PUSHJ P,FILOUT +];DOS + TLNN F,FLDATE + JRST OUTL0W + PUSHJ P,SPCOUT + 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,SP000X + 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 + PUSHJ P,SL000X +OUTL0D: SKIPN A,D ;WHAT SUBPAGE #? + JRST OUTL0L ;NONE + MOVEI CH,". + PUSHJ P,CH000X +OUTL0L: JRST ENDUND ;WE'VE FINISHED OUTPUTTING THE "PAGE NNN" + +;OUTPUT ONE LINE OF LISTING DATA, SANS CRLF OR FF. +;THIS DOES NOT NECESSARILY MEAN AN ENTIRE LINE OF THE INPUT FILE. +;CONTINUATION LINES ARE PROCESSED BY SEPARATE CALLS TO OUTLL. +;INSIDE, CC HOLDS THE HPOS IN THE TEXT AREA (NOT COUNTING SPACE LEFT FOR REFS). +;RETURN IN CH THE LINE TERMINATOR, OR 0 FOR CONTIN LINE, OR -1 FOR EOF. +OUTLL: MOVEI CH,1 + TLNE F,FLFNT2 ;SELECT FONT 1 FOR THE REFS TO BE OUTPUT IN. + PUSHJ P,FNTSWT + PUSHJ P,OUTNSP ;LEAVE SPACE FOR REFS AT BEGINNING. SET LASTSP AND THISSP. + SETZ CC, + TRZ F,FRFNT3 + TLNN F,FLFNT2 ;IF USING MULTIPLE FONTS, SELECT RIGHT ONE FOR START OF LINE DATA. + JRST OUTLL1 ; MORE MAGIC FONT SHIFTS + MOVEI CH,2 + SKIPE MDLCMT + MOVEI CH,3 + PUSHJ P,FNTSWT ;FONT 2 (OR 3, IF INSIDE A COMMENT HELD OVER FROM BEFORE). + SKIPE MDLCMT + TRO F,FRFNT3 +OUTLL1: SETZM LSYL1P + SETZM LSYL ;CLEAR SYLLABLE INFO + SETZM LSYL2 + SETO B, + PUSHJ P,OUTLD ;OUTPUT THE TEXT DATA FOR ONE LINE. + MOVE B,CONTIN ;TELL OUTRFS WHETHER THIS OUTPUT LINE WAS A CONTINUATION. + SETZM CONTIN ;REMEMBER FOR NEXT TIME WHETHER NEXT LINE IS ONE. + SKIPN CH + SETOM CONTIN + PUSH P,CH + PUSHJ P,OUTRFS ;FILL IN THE SPACE LEFT EARLIER FOR THE REFS. + 2OUTBF + POP P,CH + POPJ P, + +;LEAVE SPACE IN SLBUF FOR THE REFERENCES FOR A LINE OF LISTING. +;SP IS BUMPED PAST THEM. THE OLD SP, POINTING TO IDPB THE SPACE, +;IS SAVED IN LASTSP. THE NEW SP, POINTING TO THE START OF THE TEXT, +;IS SAVED IN THISSP. +OUTNSP: MOVEM SP,LASTSP + MOVE A,NTABS + LSH A,3 + MOVEI B,5 ;B GETS NUMBER OF CHARACTERS PER WORD. +PRESS,[ SKIPE PRESSP + MOVEI B,4 +];PRESS + IDIV A,B ;DIVIDE BY BYTES/WD TO GET NUMBER OF WORDS + ADD SP,A ;AND NUMBER OF EXTRA BYTES. + JUMPE B,OUTNS1 + IBP SP + SOJG B,.-1 +OUTNS1: MOVEM SP,THISSP ;NOW SAVE SP FOR BEGINNING OF TEXT + POPJ P, + +;;; FILL IN THE REFERENCES AT THE BEGINNING OF THE LINE BEING OUTPUT +;;; FROM POINTERS IN LSYL/LSYL2. +;;; LASTSP POINTS TO THE PLACE WHERE THEY SHOULD GO. +;;; THISSP POINTS TO THE PLACE WHERE THEY SHOULD END. +;;; 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 +;;; B IS NEGATIVE IF THIS LINE IS A CONTINUATION OF A PREVIOUS LINE. +;;; THIS MEANS DON'T OUTPUT A LINE NUMBER. +OUTRFS: PUSH P,SP ;SAVE POINTER TO END OF LINE'S TEXT. + MOVE SP,LASTSP ;SET UP TO WRITE INTO SPACE LEFT FOR REFS BY OUTNSP. + 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: PUSHJ P,DBPSP + JRST OUTL2C + +DBPSP: IBP SP ;BACK UP SP. HOW, DEPENDS ON BYTE SIZE, + IBP SP ;WHICH IS 8 FOR PRESS FILES AND 7 FOR OTHERS. + IBP SP +PRESS, SKIPN PRESSP + IBP SP + SOS SP + POPJ P, + +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: PUSHJ P,SX999S ;*** NO REFS AT ALL -- JUST PUSH OUT LINE NUMBER + MOVEI CH,40 +REPEAT 3, 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 + PUSHJ P,SX999S ;*** 2REFS, MULTI-FILE, SHORT. + 2PATCH 40 +OUT2R6: 2PATCH 40 + JRST OUT2R3 + +OUT2R2: PUSHJ P,999XS ;*** 2REFS, MULTI-FILE, LONG. + JRST OUT2R4 + +;OUTPUT THE NUMBER IN A AS 4 CHARS A LA 999X, UNLESS B IS NEGATIVE. +;IN THAT CASE, OUTPUT 4 SPACES. +999XS: JUMPGE B,999X + MOVEI CH,40 +REPEAT 4, 2PATCH + POPJ P, + +;OUTPUT THE NUMBER IN A AS 4 CHARS A LA X999, UNLESS B IS NEGATIVE. +;IN THAT CASE, OUTPUT 4 SPACES. +SX999S: 2PATCH 40 +X999S: JUMPGE B,X999 + MOVEI CH,40 +REPEAT 4, 2PATCH + POPJ P, + +OUTL4: PUSHJ P,SX999S ;*** SINGLE, MULTI-FILE, LONG -- 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: CAME SP,THISSP ;DID WE USE UP EXACTLY THE SPACE LEFT? + .VALUE + POP P,SP + POPJ P, + +;;; 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, ;PRINTING REAL PAGE # => SET LINE # OFFSET TO 0. + JRST OUTRF2 ] + 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 + SKIPL (P) + SOJA CC,SPCOUT + 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 +SL000X: MOVEI CH,"/ + JRST CH000X + +SUBTTL PASS 2 SYNTACTIC SCANNING AND LISTING WITHIN A LINE + +;WE READ, PROCESS AND OUTPUT THE DATA OF ONE OUTPUT LINE +;BY RESUMING THE SYNTACTIC PARSING COROUTINE. +;IT RETURNS AT THE END OF A LINE, HAVING DEVOURED THE LINE TERMINATING CHARACTERS. +;AT THAT TIME, CH CONTAINS THE TERMINATOR OF THE LAST LINE, +;OR ELSE -1 FOR EOF OR 0 FOR A CONTINUATION LINE. + +;ACS A THROUGH H, AND CH, AND THE STACK, ARE PRESERVED +;BETWEEN INVOCATIONS OF THE COROUTINE. + +;IF THE COROUTINE LOOKS AT @MAINP, IT IS NONZERO IF OUTPUT IS WANTED. + +;INITIALIZE THE COROUTINE FOR SYNTACTIC PARSING. +COINIT: MOVE A,[-SYNPLN,,SYNPDL-1] + PUSH A,[COINI2] + MOVEM A,SYNP + POPJ P, + +COINI2: JSP H,SLLF2 ;ADVANCE TO FIRST LINE. + SKIPL CH,CODTYP ;DISPATCH ON FORMAT OF FILE. + CAIL CH,CODMAX + .VALUE + JRST @COINI1(CH) + +COINI1: 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 + +;READ, PROCESS AND MAYBE OUTPUT THE DATA OF ONE TEXT LINE +;BY RESUMING THE SYNTACTIC PARSING COROUTINE. +;RETURN AT THE END OF THE LINE HAVING DEVOURED THE LINE TERMINATING CHARACTERS. +;(IF WE ARE NOT OUTPUTTING, WE MAY NOT RETURN TILL END OF PAGE). +;IF WE SHOULD NOT OUTPUT, SLURPY SHOULD HOLD XSLURP AND B SHOULD BE 0. +;IF WE SHOULD OUTPUT, NEITHER OF THOSE SHOULD BE TRUE. +OUTLD: MOVEM B,OUTFLG + MOVEM P,MAINP + MOVE P,SYNP + MOVE CH,[SYNACS,,A] + BLT CH,H + MOVE CH,SYNCH + MOVE CP,SYNCP + POPJ P, + +;AT THE END OF AN OUTPUT LINE (EITHER CRLF OR CONTINUATION) +;THE COROUTINE CALLS THIS FUNCTION TO RETURN. +;ACS A THROUGH H, AND CH, AND THE STACK, ARE PRESERVED +;BETWEEN INVOCATIONS OF THE COROUTINE. +OUTRTN: SKIPN MAINP + .VALUE + MOVEM CH,SYNCH + MOVEM CP,SYNCP + MOVE CH,[A,,SYNACS] + BLT CH,SYNACS+H-A + MOVEM P,SYNP + MOVE P,MAINP + SETZM MAINP ;ZERO MAINP FOR ERROR CHECK ABOVE. + MOVE CH,SYNCH + CAIE CH,^J ;IF ORDINARY END OF LINE, + POPJ P, + PUSHJ P,XSLAHD ;SEE IF END OF PAGE FOLLOWS IMMEDIATELY. + CAIN A,^L + ILDB CH,IP ;IF SO, GOBBLE THE ^L NOW AND RETURN REPORTING EOP. + POPJ P, + +SUBTTL PASS 2 READ INPUT FILE CHARACTER + +;THE 2GETCH MACRO DOES JSP H,@SLURPY. SLURPY CAN POINT HERE OR AT SLURP. +;XSLURP IS USED WHEN THE CHARACTERS SHOULD BE RETURNED TO BE SCANNED +;BUT NOT PUT INTO THE LISTING FILE. +;RETURNS CHAR IN CH, OR -1 FOR EOF. CLOBBERS ONLY A. +;UPDATES SEVERAL ACS. +;TXTIGN INHIBITS CHECKING FOR THE END OF A LINE. + +XSLURP: ILDB CH,IP + 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 +XSLCR: PUSHJ P,XSLAHD ;YES; LOOK AHEAD TO SEE IF WE HAVE A CRLF. + MOVEI CH,^M + CAIN A,^J ;IF SO, SET FRLCR AS FLAG FOR THE LF. + TRO F,FRLCR + JRST (H) + +XSLCR2: CAIN CH,^L + JRST XSLFF + CAIE CH,^J + JRST (H) + TRZN F,FRLCR + TLNE F,FLSCR + CAIA + JRST (H) + SKIPE @OUTFLG ;DON'T CO-RETURN ON EACH LINE IF NOT LISTING. +XSLFF: PUSHJ P,OUTRTN + TRO F,FRLTAB + TRZ F,FRLCR + SKIPE LNDFIL ;ALSO SKIP ANY CRETINOUS SOS LINE NUMBERS. + PUSHJ P,CKLNM + HRRI N,1(N) + JRST (H) + +;COME HERE ON ^C, WHICH MIGHT BE REAL, OR MIGHT MEAN BUFFER EMPTY. +XSLCC: MOVEI A,(IP) + CAME A,LASTIP ;IF IT'S AT THE END OF THE BUFFER, BUFFER'S EMPTY. + JRST (H) ;ELSE ^C IS REAL. + PUSHJ P,DOINPT ;IF BUFFER IS EMPTY READ MORE + JRST SLEOF + JRST XSLURP ;IF WE GOT MORE, GET 1ST CHAR FROM IT. + +;PEEK AHEAD AT THE NEXT INPUT CHARACTER. RETURN IT IN A. CLOBBER NOTHING ELSE. +;IF AT EOF, RETURN -1. +;THIS CAN BE USED IN THE SYNTACTIC COROUTINE OR IN THE MAIN PROGRAM. +XSLAHD: MOVE A,IP + ILDB A,A ;LOOK AHEAD. IF NOT ^C, WE HAVE THE DATA. + CAIE A,^C + POPJ P, + MOVE A,IP ;IF ^C, IS IT END OF BUFFER? + IBP A + ANDI A,-1 + CAME A,LASTIP + JRST [ PUSHJ P,EOFP1 ;NO => IS IT EOF PADDING? + SKIPA A,[-1] ;IF EOF PADDING, RETURN -1 + MOVEI A,^C ;IF NOT, IT'S A REAL ^C IN THE FILE. + POPJ P,] + PUSHJ P,DOINPT ;END OF BUFFER => READ NEW BUFFER AND LOOK AGAIN. + JRST [ SETO A, ;NO MORE DATA LEFT TO READ => EOF. + POPJ P,] + JRST XSLAHD + +SUBTTL PASS 2 READ INPUT FILE CHARACTER, LIST IT AND RETURN IT + +;THIS IS JUST LIKE XSLURP EXCEPT THAT IT OUTPUTS CHARACTERS +;OTHER THAN LINE AND PAGE ENDING ONES TO SLBUF. +;IT IS USED WHEN WE ARE LISTING THE FILE AS WELL AS SCANNING. + +SLURP: ILDB CH,IP + XCT SLTBL(CH) +SLURP1: 2PUTCH + AOJA CC,(H) + +;RANDOM CONTROL CHARACTER. OUTPUT AS ITSELF, OR AS UPARROW AND PRINTING CHAR. +SLCTL: TLNE F,FLCTL + JRST SLURP1 +SLCTL1: MOVE A,CH + 2PUTCH "^ + MOVEI CH,(A) + XORI CH,100 + AOJ CC, + 2PUTCH + XORI CH,100 + AOJA CC,(H) + +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 SLEOF + JRST SLURP + +SLEOF: SETO CH, + PUSHJ P,OUTRTN + .VALUE + +;COME HERE WHEN ^C OR ^@ SEEN IN FILE +SLCC1: PUSHJ P,EOFP1 ;IF IT'S EOF PADDING, REPORT EOF. + JRST SLEOF + SKIPG XGPP ;IF NOT THE CMU XGP, QUOTE NULLS IF APPROPRIATE. + JUMPE CH,SLFMTC + JRST SLCTL + +;WHEN WE SEE A ^C IN THE FILE, IS IT PADDING AT END OF FILE? +;SKIP IF IT IS REAL, DON'T SKIP IF IT IS PADDING. +EOFP1: SKIPLE LFILE ;IF NOT IN LAST WORD OF FILE, IT'S NOT PADDING. + JRST POPJ1 + HRRZ A,LASTIP ;ELSE BACK UP FROM END, + HRLI A,350700 + PUSH P,CH +EOFP1A: CAMN A,IP ;AND IF ONLY MORE ^C'S, NULLS, AND ^L'S FOLLOW THIS CHAR, + JRST POPCHJ ;IT IS PADDING. + DBP7 A + LDB CH,A + JUMPE CH,EOFP1A + CAIE CH,^C + CAIN CH,^L + JRST EOFP1A +PPCH1J: POP P,CH + JRST POPJ1 + +;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 +PRESS, SKIPN PRESSP + TLNN F,FLXGP ;BUT NEEDS QUOTING ON THE XGP (BUT NOT IN PRESS FILES). + JRST SLURP1 + MOVEI A,(CH) ;OUTPUT CHAR IN CH, PRECEDED BY A RUBOUT TO XGP-QUOTE IT. + XCT 2PUTNX .SEE 2PUTCH + XCT 2PUTTC + CAIA + JRST (H) + 2PATCH 177 + SKIPG XGPP + JRST SLRUB2 + 2PATCH 34 +SLRUB2: 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 .SEE 2PUTCH + 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 + MOVEI CH,3 + PUSHJ P,FNTSWT +2PUTN5: +];IFGE NFNTS-3 + MOVE CH,COMC + JRST SLURP1 + +SLCR: PUSHJ P,XSLAHD + CAIE A,^J + JRST SLCR1 + IORI F,FRLCR ;SIGNAL THE LF WE KNOW IS COMING THAT IT IS PART + JRST (H) ;OF A CRLF. + +SLCR1: 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 +PRESS,[ SKIPE PRESSP ;IN PRESS FILE, CAN'T USE CR OR TAB. + JRST [ PUSHJ P,PRSCHS ;SO FORCE OUT ANY PRINTING CHARACTERS, + IMULI CC,FNTWID ;AND SET THE X POS TO A VALUE BASED ON NTABS. + LSH CC,3 + MOVEM CC,PRESSX + JRST (H)] +];PRESS + 2PATCH ^M + MOVEI CH,^I +SLURP3: 2PATCH + SOJG CC,SLURP3 + MOVEI CH,^M + JRST (H) + + +IFN ANAFLG!FLAFLG,[ +SLGLEQ: PUSH P,B .SEE 2MXCRF ; to understand PUSH + MOVE B,DEVICE +ANADEX,[ + CAIE B,DEVANA ; skip if anadex + JRST SLGNC1 ; see if some other type, or done + POP P,B + PUSH P,CH ; save input char, leq or geq + MOVEI CH,^^ ; underline on + 2PUTCH + MOVE CH,0(P) ; get input char back + ADDI CH,40 ; convert to < or > + CAIN CH,75 ; except ?> first goes to = + ADDI CH,1 ; so make it go to > + 2PUTCH + MOVEI CH,^_ ; underline off + 2PUTCH + POP P,CH ; return original + ADDI CC,1 ; moved only one position + JRST 0(H) +SLGNC1: +]; ANADEX +FLORIDA,[ + CAIE B,DEVFLA ; skip if OSP-130 + JRST SLGNC2 ; see if some other type, or done + POP P,B + PUSH P,CH ; save input char, leq or geq + MOVEI CH,33 ; underline on + 2PUTCH + MOVEI CH,'E ; E + 2PUTCH + MOVE CH,0(P) ; get input char back + ADDI CH,40 ; convert to < or > + CAIN CH,75 ; except ?> first goes to = + ADDI CH,1 ; so make it go to > + 2PUTCH + MOVEI CH,33 ; underline off + 2PUTCH + MOVEI CH,'R + 2PUTCH + POP P,CH ; return original + ADDI CC,1 ; moved only one position + JRST 0(H) +SLGNC2: ] + POP P,B + JRST SLCTL ; otherwise, treat as normal control +]; ANADEX!FLORIDA + +SLLF: TRZE F,FRLCR + JRST [ SETZ A, + JRST SLLF1] + TLNN F,FLSCR ;LF: IF FLSCR=1, WE COUNT LINES BY LF'S. + JRST SLFMTC ;STRAY LF WHEN FLSCR=0 IS A FORMATTING CHAR WHOSE FORMATTING + ;ACTION ISN'T DESIRED. + SKIPA A,CC +SLFF: MOVEI A,0 +SLLF1: PUSHJ P,OUTRTN ;CO-RETURN TO OUTPUT PROCESS. + JUMPE A,SLLF2 +SLLF3: PUSHJ P,SPCOUT ;ON NEXT LINE, START BY SPACING OUT TO DESIRED COLUMN. + CAMGE CC,A + JRST SLLF3 + MOVEI CH,^J +SLLF2: TRO F,FRLTAB ;RESET SYNTACTIC STATE FOR NEW LINE. + TRZ F,FRLCR + SKIPE LNDFIL ;ALSO SKIP ANY CRETINOUS SOS LINE NUMBERS. + PUSHJ P,CKLNM2 + HRRI N,1(N) + JRST (H) + +SLBS: TLNE F,FLBS ;FLBS => ^H OVERPRINTS. OTHERWISE, IT IS LIKE RANDOM CONTROLS. + SOJGE CC,[ +PRESS,[ SKIPE PRESSP + JRST [ PUSH P,H + JRST PRSBS] +];PRESS + 2PUTCH + JRST (H) ] + AOJA CC,SLFMTC + +SLTAB: TRO F,FRLTAB ;HANDLE TAB. +PRESS,[ SKIPE PRESSP ;PRESS FILES CAN'T CONTAIN TABS. USE SPACES. + JRST SLTAB2 +];PRESS +ANADEX,[ + PUSH P,B .SEE 2MXCRF ; to understand push + MOVE B,DEVICE + CAIN B,DEVANA ; skip if not device andadex + JRST [POP P,B + JRST SLTAB2] ; device ANADEX cannot handle tabs + POP P,B + +]; ANADEX +FLORIDA,[ + PUSH P,B + MOVE B,DEVICE + CAIN B,DEVFLA ; skip if not florida OSP-130 + JRST [POP P,B + JRST SLTAB2] + POP P,B +]; FLORIDA + 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. +SLTAB2: 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: TRZ F,FRLTAB + TLNE F,FLCTL + JRST SLURP1 +ANADEX,[ + MOVE B,DEVICE + CAIE B,DEVANA ; skip if device anadex + JRST SLURP4 + 2PUTCH 177 ; we want to use 177 (rubout) for altmode to Anadex + JRST SLALT1 +SLURP4: +];ANADEX + 2PUTCH "$ +ANADEX,SLALT1: + MOVEI CH,33 ;ALTMODE NORMALLY PRINTS AS $ BUT RETURNS ALTMODE TO CALLER. + AOJA CC,(H) + +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 SLFF ;^L + JRST SLCR ;^M +REPEAT 15, JRST SLCTL ;^N-^Z + JRST SLALT ;ALTMODE +IFE ANAFLG!FLAFLG,[ +REPEAT 4, JRST SLCTL ;^\-^_ +];ANAFLG!FLAFLG +IFN ANAFLG!FLAFLG,[ + JRST SLGLEQ ;^\ - leq [ + JRST SLGLEQ ;^] - geq +REPEAT 2, JRST SLCTL ;^^-^_ +];IFN ANAFLG!FLAFLG + TRO F,FRLTAB ;SPACE +REPEAT 14., TRZ F,FRLTAB ;! " # $ % & ' ( ) * + , - . + JRST SLSLSH ;/ +REPEAT 10., TRZ F,FRLTAB ;0-9 + TRZ F,FRLTAB ;: + JRST SLSEMI ;; +REPEAT 5, TRZ F,FRLTAB ;< = > ? @ +REPEAT 26., TRZ F,FRLTAB ;A-Z +REPEAT 6, TRZ F,FRLTAB ;[ \ ] ^ _ ` +REPEAT 26., TRZ F,FRLTAB ;a-z +REPEAT 4, TRZ F,FRLTAB ;{ | } ~ + JRST SLRUB ;RUBOUT + +IFN .-SLTBL-200, .ERR WRONG LENGTH TABLE + +;IN CONTINUATION MODE (TRUNCP < 0) 2PUTTC CALLS HERE (XCT'D BY 2PUTCH). +2PUTNL: PUSH P,CH + SETZ CH, + PUSHJ P,OUTRTN ;CORETURN TO FINISH ONE LINE. + SKIPE LNDFIL ;IF THIS FILE HAS LINE NUMBERS + SKIPN PRLSN ;AND WE ARE PRINTING THEM + JRST 2PUTN9 ;THEN THE NEXT LINE NEEDS AN EXTRA TAB. + PUSHJ P,2TAB + SETZ CC, +2PUTN9: SKIPGE 2MCCOL ;IF WE ARE NOT IN A COMMENT, THAT'S ALL. + JRST 2PUTN2 + 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 2PUTN3 ;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 + PUSHJ P,2TAB + JRST 2PUTN6 + +2PUTN7: MOVEI CH,40 +2PUTN8: CAML CC,2MCCOL + SOJA CC,2PUTN3 ;WE'VE REACHED DESIRED COL. + 2PATCH ;OTHERWISE, 1 MORE SPACE. + AOJA CC,2PUTN8 + +2PUTN3: PUSH P,H + JSP H,2PUTN4 + POP P,H +2PUTN2: POP P,CH + POPJ P, + +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 + SETZM SYLBUF + MOVE CP,[440600,,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 ^ + CAIN CH,^M + JRST 2MXCT +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 + CAME CH,COMC + SKIPGE 2MTBL(CH) ;IF FOLLOWING CHAR IS SQUOZE, OR THE COMMENT STARTER, + JRST 2MBRK ;PROCESS THE PRECEDING SYLLABLE. + JRST 2MLOOP ;IF SPACE FOLLOWED BY NON-SQUOZE, IGNORE THE SPACE. + +2FBAKA: SKIPLE FAILP + 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: SKIPLE FAILP + 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 + SKIPN FAILP ;DON'T CREF TWICE FOR SYMBOLS IN ENTRY. + JRST 2MBRK3 + CAME A,[SIXBIT \EXTERN\] + CAMN A,[SIXBIT \ENTRY\] + JRST 2MSUBT + CAME A,[SIXBIT \GLOBAL\] + CAMN A,[SIXBIT \INTERN\] + JRST 2MSUBT +2MBRK3: CAME A,[SIXBIT \.GLOBA\] + 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,CRFSYM ;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 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 2MCTL ;^ +REPEAT 2, JRST 2MBRK ;_ ` +REPEAT 26., 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 + 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 HAIR, AND OUTPUT EXACTLY WHAT WE FIND IN THE FILE. +;SINCE WE ARE ESSENTIALLY USING XSLURP, WE DON'T CORETURN AFTER EACH LINE, +;ONLY AFTER EACH PAGE. +.SEE XSLURP +2TEXT: SETZM TXTIGN +XGP,[ SKIPE TEXGPP + JRST 2TEXGP +];XGP +PRESS,[ SKIPE PRESSP + JRST 2TEXT2 +];PRESS +2TEXT1: 2GETCH ;EITHER XSLURP (NO SKIP) OR 2TEXTG (SKIPS). + JRST 2TEXT1 + 2PATCH + CAIL CH,40 + JRST 2TEXT1 + 2OUTBF + JRST 2TEXT1 + +PRESS,[ +2TEXT2: 2GETCH + JRST 2TEXT2 + CAIGE CH,16 ;IN PRESS FILES, CAN'T USE FORMATTING CONTROLS. + JRST 2TEXT3 +2TEXT4: 2PATCH + JRST 2TEXT2 + +2TEXT3: CAIGE CH,10 + JRST 2TEXT4 + PUSHJ P,@PRSFMT-10(CH) ;MUST CALL SPECIAL ROUTINE FOR THEM. + 2OUTBF ;MUST ALSO EMPTY THE BUFFER EVERY SO OFTEN. + JRST 2TEXT2 +];PRESS + +;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 + CAIE 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,[ .SEE 1CKXTB +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 -maybe should be JRST 2TEXK0 + JRST 2TEXGP ;15 UB -maybe should be JRST 2TEXK0 + 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= -maybe should be JRST 2TEXK2 + MOVEI B,2 ;62 B= -maybe should be JRST 2TEXK2 + JRST 2TEXK1 ;63 FMT + MOVEI B,8. ;64 RVEC + JRST 2TEXIC ;65 RVFL + MOVEI B,1 ;66 HNUM + JRST 2TEXGP ;67 FCNT -internal to LOOK and the XGP + JRST 2TEXGP ;70 BREAK + JRST 2TEXKC ;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 VARIOUS NUMERICAL PRINT ROUTINES + +;;; ALL NUMERIC OUTPUT ROUTINES TAKE ARGUMENT IN A. + +;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, + +;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 + SOJA CC,SPCOUT + +;PRINT AS MANY DIGITS AS NECESSARY, AND IGNORE RIGHT MARGIN, BUT UPDATE CC. +;DOESN'T WORK AT ALL FOR NEGATIVE NUMBERS. +CM000X: MOVEI CH,", +CH000X: PUSHJ P,CHROUT +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,12. ;GET IN FORM MMDDYY +IRPC X,,[ //] + 2PATCH "X + ADDI CC,1 +REPEAT 2,[ + SETZ A, + LSHC A,6 + 2PATCH 40(A) + ADDI CC,1 +] ;END OF REPEAT 2 +TERMIN + POPJ P, +] ;ITS + +NOITS,[ PUSH P,C ; IS THIS PUSH REALLY NECESSARY? +BOTS, DATE A, ; GET DATE +TNX,[ SETO A, + CALL DATNXC + PUSH P,B +] + IDIVI A,31. ; GET DAYS + PUSH P,B ; SAVE THEM + IDIVI A,12. ; GET MONTHS + JSP H,DEC2TY ; TYPE IT + 2PATCH "/ + AOJ CC, + POP P,B ; RESTORE B + JSP H,DEC2TY ; TYPE DAYS + 2PATCH "/ + AOJ CC, + MOVEI B,63.(A) ; GET YEARS + JSP H,DEC2TY ; TYPE IT + PUSHJ P,SPCOUT +BOTS, MSTIME B, +TNX, POP P,B + IDIVI B,60.*1000. + IMULI B,60.*1000. + PUSHJ P,PMSTIM + ADDI CC,5 + JRST POPCJ + +DEC2TY: AOJ B, ;PRINT (B)+1 AS A 2-CHAR DECIMAL NUMBER. + IDIVI B,10. ; SEPARATE + 2PATCH "0(B) + 2PATCH "0(C) + ADDI CC,2 + JRST (H) +] ;NOITS + +SUBTTL VARIOUS OUTPUT UTILITY ROUTINES + +;CALL 000X AND THEN CRLOUT +000XCR: PUSHJ P,000X + +;TYPE CRLF. CALL WITH PUSHJ. UPDATES CC AND OUTVP. +CRLOUT: AOS OUTVP +CRLOU0: SETZ CC, +CRLOU1: +PRESS,[ SKIPE PRESSP + JRST PRSLIN +];PRESS +CRLOU2: 2PATCH ^M + 2PATCH ^J + 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 + +;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, + +SUBTTL FILE AND FONT NAME OUTPUT ROUTINES + +;L -> FILEBLOCK; PRINT REAL FILE NAMES. +NOTNX,[ +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: +];NOTNX + +TNX,[ +FILOUT: +FILOUM: + PUSH P,C +T20,[ + ; output arpanet (or I suppose DECnet, someday) host name here + ; use the DEC "::" convention for a node name + skipe machine ; is machine zero? + jrst filoux ; no, no arpanet host name + movei b,amachine ; point to name + pushj p,ascout ; output it + movei ch,": ; double colon + pushj p,chrout + movei ch,": + pushj p,chrout +filoux: +] +T20, SKIPN B,F.RSNM(L) ; T20: DIRST will print out device field + SKIPN B,F.RDEV(L) ; device present? + JRST FILOU2 ; No, skip it. + JSP H,SIXOUT + MOVEI CH,": + PUSHJ P,CHROUT ; dev: or machine: + +FILOU2: SKIPN B,F.RSNM(L) ; If no directory #, + JRST FILOU9 ; don't print anything. + MOVE A,[440700,,PPNBUF] +10X, MOVEI CH,"< ? IDPB CH,A + MOVE CH,A ; Save BP in case of error + DIRST ; Dir # is in B + ERCAL [MOVE A,CH ; Error, restore BP + POPJ P,] +10X, MOVEI CH,"> ? IDPB CH,A + SETZ CH, + IDPB CH,A + MOVEI B,PPNBUF + PUSHJ P,ASCOUT ; or PS: +FILOU9: +];TNX +;EITHER THE TNX CODE OR THE NOTNX CODE +;DROPS THROUGH INTO HERE. +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: +BOTS,[ 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 + MOVEI CH,", + PUSHJ P,CHROUT + 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 + MOVEI CH,", + PUSHJ P,CHROUT + HRRZ A,F.RSNM(L) + PUSHJ P,OCTP +];NOSAI ;[ +FILOU5: MOVEI CH,"] + PUSHJ P,CHROUT +FILOU4:: +];BOTS +POPCJ: POP P,C + POPJ P, + +TNX,FNMOUT==:SIXOUT +DOS,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, +];ITS + +NOITSXGP,FNTOUT==:FILOUT +ITSXGP,[ +ITS,FNTOUT==:FILOUT +NOITS,[ +IFN <.SITE 0,>-,FNTOUT==:FILOUT +.ELSE [ +;Print an ITS-style file name on a non-ITS system (for XGP purposes). +; Assumes directory is FONTS. MIT-XX +;is the only machine that should use this, most likely. +FNTOUT: MOVE B,[SIXBIT /FONTS/] + JSP H,FNMOUT + MOVEI CH,"; + PUSHJ P,CHROUT + MOVE B,F.RFN1(L) + JSP H,FNMOUT + SKIPN B,F.RFN2(L) + POPJ P, + PUSHJ P,SPCOUT + JSP H,FNMOUT + POPJ P, +];NOSAI +];NOITS +];ITSXGP + +SUBTTL COPYRIGHT MESSAGE OUTPUT ROUTINES + +;LINEFEED DOWN TILL REACH BEGINNING OF LAST LINE OF CURRENT PAGE. +CPYBOT: MOVE C,OUTVP + IDIV C,PAGEL ; FOR COPYRIGHT MSG + SUB D,PAGEL1 +CPYBO1: AOJGE D,2OUTPJ + PUSHJ P,CRLOUT + JRST CPYBO1 + +CPYOUB: PUSHJ P,CPYBOT ;GO TO PAGE BOTTOM AND OUTPUT CPYRT MSG. +CPYOUT: + pushj P,CRLOUT ; two CRLFs precede message if we come in here + pushj P,CRLOUT ; ... + MOVEI C,5*LCPYMSG-4 ;OUTPUT COPYRIGHT MSG less extra CRLFs + MOVE D,[100700,,CPYMSG] +; The above change, eliminating the two CRLFs from the string and putting +; them in explicitly, is necessary because some printing devices which can +; underline (Anadex and that class of printers) usually turn the underlining +; off at a CRLF. Since we want to support such printers, the change was +; made to get the CRLFs out before the Underlining +CPYOU0: skiple cpyund ; underline requested? + pushj p,Begund ; yes, go start it +CPYOU1: ILDB CH,D ;COPY OUT THE STRING. + JUMPE CH,CPYOU2 + CAIN CH,^M ;HOWEVER, CR (ASSUMED TO BE PART OF CRLF) + JRST [ IBP D ;MUST GO THROUGH CRLOUT SO PRESS FILES WIN. + PUSHJ P,CRLOUT + SOJA C,CPYOU3] + 2PATCH +CPYOU3: SOJG C,CPYOU1 +CPYOU2: + skiple CPYUND ; underline active? + pushj P,endund ; yes, turn it off + JRST 2OUTPJ + +CPYSAY: MOVEI C,5*LCPYMSG-4 ;JUST SAY WHAT COPYRIGHT MSG IS, WITHOUT DOUBLE CRLF + MOVE D,[100700,,CPYMSG] + JRST CPYOU0 + +;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=PAGEL1, IT'S BECAUSE OF A SEQUENCE SUCH AS + CAMN A,PAGEL1 ;AOS OUTVP ? IF OUTVP=PAGEL1 THEN CPYPAG ELSE CRLOUT, + SOS OUTVP ;SO OUTVP REALLY SHOULD BE PAGEL1-1 IN THIS CASE. + TLNE F,FLQPYM + PUSHJ P,CPYOUB + 2PAGE + SETZM OUTVP + POP P,D +POPCAJ: POP P,C + JRST POPAJ + +SUBTTL FORMAT-INDEPENDENT LOW LEVEL OUTPUT + +;CALL HERE TO FORCE OUT SLBUF IF IT IS GETTING FULL. +2OUTPJ: PUSH P,B + 2OUTBF +POPBJ: POP P,B + POPJ P, + +;SUBROUTINE USED BY 2OUTBF MACRO. UNCONDITIONALLY FORCE OUT SLBUF. +;MAY CLOBBER A AND B. MAY MOVE THE UNFINISHED WORD, AND RELOCATE SP. +2OUTB1: MOVEI B,(SP) + TLNN SP,700000 ;IF SP POINTS AFTER A WORD BOUNDARY, + MOVEI B,1(B) ;MAKE SURE WE OUTPUT EVERY LAST WORD. + SUBI B,SLBUF +PRESS,[ SKIPN PRESSP + JRST 2OUTB2 + PUSH P,B + PUSHJ P,PRSCHS + POP P,B + ADDM B,PAGWDS ;IF PRESS FILE, MUST COUNT WORDS OUTPUT IN THIS PAGE. + PUSHJ P,2OUTB2 + MOVEM SP,PRTCBP + POPJ P, +];PRESS +2OUTB2: JUMPE B,2OUTB3 + OUTWDS A,[SLBUF],0(B) +2OUTB3: MOVE A,(SP) + HRRI SP,SLBUF + TLNN SP,700000 + SOSA SP + MOVEM A,SLBUF + POPJ P, + +;SUBROUTINE WHICH IMPLEMENTS THE 2PAGE MACRO. +2PAGE1: AOS OUTPAG +PRESS,[ SKIPE PRESSP + JRST PRSPAG +];PRESS + 2PATCH ^M + 2PATCH ^L +XGP,[ MOVEI CH,1 ;EACH PAGE SHOULD START IN FONT 1 UNTIL IT ASKS OTHERWISE. + TLNE F,FLFNT2 ;THIS MAKES XGP AND PRESS FILES COMPATIBLE IN THIS REGARD. + PUSHJ P,FNTSWT +];XGP + POPJ P, + +;OUTPUT A TAB TO THE OUTPUT FILE. DO SPECIAL HACKERY FOR PRESS FILES. +;WE UPDATE CC, AND DO NOT TRUNCATE OR CONTINUE. +IFN ANAFLG!FLAFLG,[ +2TAB: MOVE B,DEVICE + CAIE B,DEVANA + JRST 2TAB5 +; Code for devices which do not support tabs +2TAB1: MOVEI CH,40 +2TAB3: 2PATCH + ADDI CC,1 + TRNE CC,7 ; there yet? + JRST 2TAB3 ; no + POPJ P, +2TAB2: ; alternate magic entry point + MOVE B,DEVICE + CAIN B,DEVANA ; Anadex printer? + JRST 2TAB1 ; yes + CAIA +2TAB5: TRZ CC,7 + ADDI CC,10 +PRESS,[ SKIPE PRESSP + JRST PRSTAB +];PRESS + 2PATCH ^I + POPJ P, +]; IFN ANAFLG!FLAFLG +IFE ANAFLG!FLAFLG,[ +2TAB: TRZ CC,7 +2TAB2: ADDI CC,10 +PRESS,[ SKIPE PRESSP + JRST PRSTAB +];PRESS + 2PATCH ^I + POPJ P, +];IFE ANAFLG!FLAFLG + +;BEGIN UNDERLINING. NO-OP IF DEVICE NOT SUITABLE OR IF ALREADY UNDERLINING. +BEGUND: SKIPE UNDRLN + POPJ P, +PRESS,[ SKIPN PRESSP + JRST BEGUN1 + PUSHJ P,PRSCHS ;FORCE OUT PRINTING CHARS SO PRESSX IS UP TO DATE. + MOVE CH,PRESSX ;SAVE X-POSITION OF START OF UNDERLINE. + HRROM CH,UNDRLN + POPJ P, + +BEGUN1: +];PRESS + SETOM UNDRLN +ANADEX,[ ; skip if device Anadex + MOVE B,DEVICE + CAIE B,DEVANA + JRST BEGUN2 + 2PATCH ^^ + POPJ P, +BEGUN2: +];ANADEX +FLORIDA,[ + MOVE B,DEVICE + CAIE B,DEVFLA + JRST BEGUN3 + 2PATCH 33 + 2PATCH "E + POPJ P, +BEGUN3: +];FLORIDA + TLNN F,FLXGP + POPJ P, + 2PATCH 177 +ITSXGP,[2PATCH 1 + 2PATCH 46 +];ITSXGP +CMUXGP,[2PATCH 53 + 2PATCH 30 +];CMUXGP + POPJ P, + +;STOP UNDERLINING. +ENDUND: SKIPN UNDRLN + POPJ P, +PRESS,[ SKIPE PRESSP + JRST PRSUND +];PRESS + SETZM UNDRLN +ANADEX,[ ; skip if device ANADEX + MOVE B,DEVICE + CAIE B,DEVANA + JRST ENDUN1 + 2PATCH ^_ + POPJ P, +ENDUN1: +];ANADEX +FLORIDA,[ + MOVE B,DEVICE + CAIE B,DEVFLA + JRST ENDUN2 + 2PATCH 33 + 2PATCH "R + POPJ P, +ENDUN2: +];FLORIDA + TLNN F,FLXGP + POPJ P, + 2PATCH 177 +ITSXGP,[2PATCH 1 + 2PATCH 47 + 2PATCH 2 +];ITSXGP +CMUXGP,[2PATCH 53 + 2PATCH 0 +];CMUXGP + POPJ P, + +;SWITCH FONTS. FONT NUMBER IN CH. +;NOTE THAT @'S FONT NUMBERS ARE ORIGIN 1, WHILE THOSE IN FILES ARE ORIGIN 0. +FNTSWT: +PRESS,[ SKIPE PRESSP + JRST [ PUSH P,A + MOVEI A,-1(CH) + PUSHJ P,PRSFNT + JRST POPAJ ] +];PRESS + TLNN F,FLXGP + POPJ P, + HRLM CH,(P) + 2PATCH 177 + SKIPLE XGPP ;CMU XGP IS DIFFERENT + JRST [ HLRZ CH,(P) + CAILE CH,2 ;CMU ALLOWS ONLY TWO FONTS. + MOVEI CH,2 + 2PATCH 13(CH) ;USING CODE 14 or 15 + POPJ P, ] + 2PATCH 1 + HLRZ CH,(P) + 2PATCH -1(CH) + 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 ;O + 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 + SETO A, + TLNN F,FLDATE ;SAY -% IF % SWITCH IS NOT SET. + PUSHJ P,SWPRSN + JFCL "% + SWPRN HEDING ,["] + 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: PUSHJ P,SWPRDV ;D + SWPR1 L,FLSHRT ,E + 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 + PUSHJ P,SWPRM ;M[...] + SWPR1 L,FLREFS ,N,SENSE=N + SWPRN F.MINP(R) ,P + SWPR1 L,FLSCR ,R + SKIPE TEXTP + 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 AND/OR PAGEL + SWPRN LINEL ,W + MOVE CH,DEVICE + SKIPE FRCXGP(CH) ;DON'T MENTION /X IF DEVICE IMPLIES IT. + JRST SWPRI2 + SWPR1 L,FLXGP ,X +SWPRI2: MOVEI CH, "Y + SKIPE REALPG + PUSHJ P,SWPRSW + SWPR1 L,FLSUBT ,Z + SWPR1 L,FLCTL ,^ + SKIPE A,NXFDSP + PUSHJ P,SWPRSN + JFCL "! + MOVEI CH, "= + SKIPE NORFNM + PUSHJ P,SWPRSW + SKIPE A,FISORF + PUSHJ P,SWPRSN ;< + JFCL "> + SKIPE FNTSPC + PUSHJ P,SWPRFF ;F ;MENTION SPEC'D FONT FILES IF ANY. + TLNE F,FLQPYM + PUSHJ P,SWPRQ ;Q ;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 A D-SWITCH DESCRIBING THE DEVICE +SWPRDV: MOVSI B,(SIXBIT \D[\) ;] + JSP H,SIXOUT + SKIPL CH,DEVICE + CAIL CH,DEVMAX + .VALUE + MOVE B,SWPRDT(CH) + PUSHJ P,ASCOUT + JRST SWPRF2 + +SWPRDT: OFFSET -. +DEVLPT::[ASCIZ /LPT/] +DEVIXG:: + SAI,[[ASCIZ /XGP SAIL/]] + NOSAI,[[ASCIZ /XGP ITS/]] +DEVCXG::[ASCIZ /XGP CMU/] +DEVGLD::[ASCIZ /Gould/] +DEVLDO::[ASCIZ /Dover Landscape/] +DEVPDO::[ASCIZ /Dover Portrait/] +DEVANA::[ASCIZ /Anadex/] +DEVCGP::[ASCIZ /Canon "XGP"/] +DEVFLA::[ASCIZ /Florida/] +DEVMAX::OFFSET 0 + +;PRINT OUT AN F-SWITCH DESCRIBING NUMBER OF FONTS. +SWPRF: +IFGE NFNTS-3,[ + SKIPN FNTSPC ;BUT IF FONT NAMES ARE SPECIFIED TOO, + JRST SWPRF1 ;MAYBE THEY WOULD IMPLY THIS. IN THAT CASE, OMIT THIS. + SKIPN FNTSNM+FNTF0+2*FNTFL ;IF HAVE NAMES FOR FONT 3, CAN OMIT. + SKIPE FNTFN1+FNTF0+2*FNTFL + POPJ P, +];IFGE NFNTS-3 +IFGE NFNTS-2,[ + TLNE F,FLFNT3 ;FONT 3 WANTED BUT NO NAME => NEED /3F. + JRST SWPRF1 + SKIPN FNTSNM+FNTF0+FNTFL ;ELSE HAVE NAME FOR FONT 2 => CAN OMIT. + SKIPE FNTFN1+FNTF0+FNTFL + POPJ P, +];IFGE NFNTS-2 +SWPRF1: MOVEI CH,5(CC) ;WE DO WANT TO SAY /NF. + 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 + SKIPL CH,CODTYP + CAIL CH,CODMAX + .VALUE + 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 + +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 M[...] SWITCH +SWPRM: MOVE A,MARG.L + MOVE B,MARG.R + CAIN A,DFLMAR + CAIE B,DFRMAR + JRST SWPRM2 + MOVE A,MARG.T + MOVE B,MARG.B + CAIN A,DFTMAR + CAIE B,DFBMAR + JRST SWPRM2 + MOVE A,MARG.H + CAIN A,DFHMAR + POPJ P, ;Suppress /M[...] if all defaults +SWPRM2: MOVSI B,(SIXBIT\M[\) ;] + JSP H,SIXOUT +REPEAT 5,[ + MOVE A,MARGIN+.RPCNT +IFE .RPCNT, PUSHJ P,000X +IFN .RPCNT, PUSHJ P,CM000X +];REPEAT 5 + JRST SWPRF2 + +;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 + skipg CPYUND ; underlining on? + jrst SWPRQ0 ; no + movsi B,(sixbit \1\) ; yes, print 1 + jsp h,SIXOUT ; ... +SWPRQ0: + MOVSI B,(SIXBIT \Q[\) ;] + JSP H,SIXOUT +; here we save CPYUND so that we don't get the cover page value underlined + push p,CPYUND + setzm CPYUND + PUSHJ P,CPYSAY ;[ + pop p,CPYUND ; restore CPYUND + 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 + JRST PTLAB9 +];ITS + +BOTS,[ +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: PUSHJ P,SPCOUT + 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 ] +CMU10,[ MOVE A,[B,,PPNBUF] + DECCMU A, + JRST PTLAB2 + MOVEI B,PPNBUF + PUSHJ P,ASCOUT + JRST PTLAB1 +PTLAB2: +];CMU10 + 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 + TRNN C,77 ; WAS LAST CHAR A SPACE? + PUSHJ P,SPCOUT ; YES, PRINT A SPACE + 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 + MOVEI B,[ASCIZ/Listing of /] + PUSHJ P,ASCOUT + HRRZ L,CFILE ; *** FILE NAME + PUSHJ P,FILOUT + JRST PTLAB9 +];BOTS + +TNX,[ +PTLAB: MOVE A,[SIXBIT /SYSVER/] + SYSGT ; So code will always win + JUMPGE A,[SKIPE B,MACHINE + JSP H,SIXOUT + JRST PTLAB0 ] + HLLZ C,B +PTLAB5: MOVEI A,(B) ; Table # in RH + HRLI A,(C) ; word # in LH + GETAB ; Get system name word + JRST [ SKIPE B,MACHINE + JSP H,SIXOUT + JRST PTLAB0 ] + MOVEM A,SYSBUF(C) + SKIPE SYSBUF+SYSBSZ-2 ;SYSTEM NAME TOO LONG? + JRST PTLAB6 + AOBJN C,PTLAB5 ;NO, GET SOME MORE +PTLAB6: MOVEI B,SYSBUF + PUSHJ P,ASCOUT + +PTLAB0: +CMU20,[ ; +IFN 0,[ ; + ; + PUSHJ P,SPCOUT + GETPPN B, ; GET USER PPN + JFCL ; (JACCT SKIP) + HRROI A,PPNBUF + HRROI C,STRBUF + PPNST + movei A,PPNBUF ; make a byte pointer to + hrli A,440700 ; <36,7> +PPscan: ildb B,A ; get character + jumpe B,PPdone ; null, punt this + caie B,"< ; start of id + jrst PPscan ; no, try next + movei C,PPNBUF ; create copy-to pointer + setz D, ; set case shifter for upper case + hrli C,440700 ; <36,7> + idpb B,C ; store opening terminator +PPmovit: + ildb B,A ; get char + caige B,"Z ; upper case?? + caige B,"A ; could be + skipa ; > Z or < A + TRO B,0(D) ; set bit if necessary + movei D,40 ; set case shifter for l.c. + CAIN B,". ; "." of subdirectory + setz D, ; shifter for u.c. + idpb B,C ; store char + cain B,"> ; end of id? + setz B, ; yes, treat as end of string + jumpn B,PPMOVIT ; if not null, go on + idpb B,C ; store terminator +PPDONE: + MOVEI B,PPNBUF + PUSHJ P,ASCOUT + JRST PTLAB1 +];IFN 0 +];CMU20 +PTLAB2: +PTLAB1: +REPEAT 2,PUSHJ P,SPCOUT + GJINF ; Get user # (10X: logged-in dir #) in A + MOVE B,A ; (clobbers A-D) + HRROI A,PPNBUF + DIRST ; Output dir or user string + SETZM PPNBUF + MOVEI B,PPNBUF + CALL ASCOUT + PUSHJ P,SPCOUT + SETO A, ; Use current date/time + CALL DATNXC + PUSHJ P,PTMOON ; PRINT THEM, AND PHASE OF MOON. + PUSHJ P,CRLOUT + MOVEI B,[ASCIZ/Listing of /] + PUSHJ P,ASCOUT + HRRZ L,CFILE ; *** FILE NAME + PUSHJ P,FILOUT + JRST PTLAB9 +];TNX + +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 + +;PRINT A DISK-FORMAT DATE IN R, AS "WHENSDAY, DAY MONTH YEAR HH:MM:SS PHASEOFMOON" +;PTQNM MEANS OMIT PHASE OF MOON. + +PTQDAT: TDZA C,C +PTQNM: SETO C, +TNX,[ MOVE A,R + CALL DATNXC ; Convert GTAD-style to DEC-style +];TNX +ITS,[ +;TURN IT INTO A DEC FORMAT DATE IN A AND TIME (IN MSEC) IN B. + 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,[ HRRZ B,R + IMULI B,60.*1000. ; CONVERT TIME TO MSEC. + HLRZ A,R ;A GETS JUST THE DATE. +];DOS + JUMPN C,PTDATE ;PRINT DATE AND TIME. + 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 ". + ADDI CC,2 + 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. + +IFN TNX,[ +; DATNXC - Convert TNX-style date/time to DEC-style. +; A - GTAD-format date/time +; returns +; A - DEC-style date +; B - time after midnight in millisec + +DATNXC: PUSH P,C + PUSH P,D + MOVE B,A + ODCNV ; Break it down + HLRZ A,B ; Get full year + SUBI A,1964. + CAIGE A, ; If negative for some reason, + SETZ A, ; set to beginning of time. + IMULI A,12. + ADDI A,(B) ; Add month # (0 based) + IMULI A,31. + HLRZ B,C ; Get day # (0 based) + ADDI A,(B) ; Now have total # days + MOVEI B,(D) ; Get # secs + IMULI B,1000. ; Sigh, get msec. + POP P,D + POP P,C + POPJ P, +] + +;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 + PUSHJ P,SPCOUT +PTDAT3: MOVE B,R ;*** DAY + ADDI B,DAYS(R) + PUSHJ P,ASCOUT + MOVEI CH,", + PUSHJ P,CSPOUT + AOS A,$DAY ;*** DATE + PUSHJ P,000X + PUSHJ P,SPCOUT + MOVE B,$MONTH + ADDI B,MONTHS(B) + PUSHJ P,ASCOUT + MOVE A,$YEAR +SP000X: PUSHJ P,SPCOUT + JRST 000X + +ITS,[ +DAYS: ;TWO WORDS PER DAY OF ASCIZ STRING +IRPS X,,Sun Mon Tues Wed Thurs Fri Sat + ASCIZ /X/ +IFL .LENGTH /X/-5, 0 +TERMIN + +MONTHS: ;TWO WORDS PER MONTH OF ASCIZ STRING +IRPS X,,Jan Feb March April May June July Aug Sept Oct Nov Dec + ASCIZ /X/ +IFL .LENGTH /X/-5, 0 +TERMIN +];ITS + +NOITS,[ +DAYS: ;TWO WORDS PER DAY OF ASCIZ STRING +IRPS X,,Sunday Monday Tuesday Wednesday Thursday Friday Saturday + ASCIZ /X/ +IFL .LENGTH /X/-5, 0 +TERMIN + +MONTHS: ;TWO WORDS PER MONTH OF ASCIZ STRING +IRPS X,,January February March April May June July August September October November December + ASCIZ /X/ +IFL .LENGTH /X/-5, 0 +TERMIN +];NOITS + +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 + ADDI CC,5 + JUMPE B,CPOPJ + 2PATCH [":] + IDIVI B,10. + 2PATCH "0(B) + 2PATCH "0(C) + ADDI CC,3 + 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: PUSHJ P,CRLOU1 ;LOOP FOR LINE WITHIN A GROUP + 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) + +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 + PUSHJ P,DBPSP + JRST SYML8] + 2PATCH 40 + JRST SYML4 + +;COME HERE AT END OF A LINE +SYML8: AOS A,OUTVP + CAML A,PAGEL1 + JRST SYML8C + PUSHJ P,CRLOU1 + 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 CONSIDERi PRINTING NAME OF + JRST TABHD6 + 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,FNAMCW+2 ;TAB STOPS ARE FNAMCW APART, BUT LEAVE AT + SUB C,(P) ; LEAST 2 SPACES BETWEEN NAMES + IDIVI C,FNAMCW + IMULI C,FNAMCW + ADD C,(P) + MOVE D,LINEL + SUBI D,FNAMCW ;NEED AT LEAST FNAMCW 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*FNAMCW+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, + JUMPE L,TABHD0 ; THEN MAY PRINT NO MORE FILE NAMES, + SKIPE @-1(P) + MOVEI CH,". ; SO USE "..." TO SHOW THERE ARE MORE +TABHD0: +REPEAT 3, 2PATCH + MOVEI B,[ASCIZ / /] + PUSHJ P,ASCOUT + PUSHJ P,DATOUT ;PRINT TODAY'S DATE. + MOVEI B,[ASCIZ / Page /] + PUSHJ P,ASCOUT + MOVEI A,1(N) ;PRINT PAGE NUMBER + PUSHJ P,ROMAN + JRST TABHD3 + +TABHD7: JUMPE L,TABHD8 ;IF FORCING A PAGE #, THEN NO MORE FILENAMES + PUSHJ P,FILOUT ;OUTPUT FILE NAME + JUMPN IP,TABHD8 ;IF ONLY ONE FILE THEN THATS ALL +TABHD6: AOS L,-1(P) + SKIPE L,-1(L) + JRST TABHD1 ;ELSE KEEP GOING UNTIL ALL INPUT FILES MENTIONED. +TABHD8: SKIPE L,OUTVP ;SKIP IF FIRST LINE + JRST TABHD2 + PUSHJ P,SPCOUT ; FAKE OUT THE WORLD TO GET 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 + SKIPLE TEXTP ;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,10. ;GET # CHARS SPACE AVAIL FOR SUBTITLES + 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) + CAIE A,(IP) + JUMPN IP,SUBT8 ;FORGET THIS ONE -- WRONG FILE + 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: PUSHJ P,2TAB ;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 + PUSHJ P,2TAB ;ANOTHER TAB, + MOVEI CC,1 + 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 + CAMGE CC,R + AOJA CC,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: PUSHJ P,2TAB ; MOVE TO THE NEXT TAB STOP + 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 + 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 + CAMGE CH,PAGEL1 + JRST CRLOU1 +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: HRRZ A,S.TYPE(D) ;IF THIS IS A DEFINITION OF A TYPE THAT SAYS + SKIPGE (A) .SEE T%1WRD ;"DON'T PRINT IT IN THE CREF", + TDZA A,A ;THEN JUST RETURN. + MOVE A,1(A) + TLNE A,T%NPRT + POPJ P, + 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 + PUSHJ P,2TAB ;AND TAB IN ON IT SO WE KNOW IT'S A CONTINUATION. +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,8. ;TRY AGAIN. THIS TIME, WE'LL BE IN THE "SAME" FILE + JRST MCRFNT ;AND WILL GO TO MCRFN2. + +MCRFN2: HLRZ A,S.PAGE(D) + HLRZ B,S.FILE(D) ;FILE SYM IS DEFINED IN + SKIPN REALPG + SKIPL B,F.PAGT(B) ;PAGE TABLE OF FILE + JRST [ SETZ B, ;FILE HAS NONE. + JRST MCRFN3 ] + 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,S.TYPE(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] + HRRZ CH,1(CH) ;BUT NORMALLY, THE FLAG CHAR IS THE SECOND WORD OF THE TYPE. +MCRFN6: 2PATCH + HRRZ A,S.LINE(D) + ADDI A,1(B) + IDIVI A,1000. + JUMPE A,MCRFN4 + 2PATCH "0(A) + ADDI CC,1 ;Account for oversize page #. +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: +ITS,[ SKIPE DEBUG + .VALUE + .LOGOUT + .BREAK 16,40000 ;KILL SELF, DO .RESET INPUT. +];ITS +TNX,[ SKIPE DEBUG + .VALUE + HALTF +];TNX +DOS,[ SKIPE DEBUG + PUSHJ P,DEATH1 + RESET ;DON'T CLOSE ANYTHING!!!! + EXIT +];DOS + +;JRST HERE ON SUCCESSFUL COMPLETION OF THE OPERATION. +DEATH: +ITS,[ SKIPE DEBUG + .VALUE ;WHEN DEBUGGING, INHIBIT DEATH. + .LOGOUT 1, +];ITS +TNX,[ SKIPE DEBUG + .VALUE + HALTF +];TNX +DOS,[ + SKIPE DEBUG + PUSHJ P,DEATH1 + EXIT + +DEATH1: OUTSTR [ASCIZ /Done! +/] + POP P,LOSE ;GO TO DDT IF THERE IS ONE; ELSE JUST EXIT 1, + JRST LOSE3 +];DOS + +LITTER: CONSTA + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 +PURTOP:: +.JBFF1:: ;FOR BENEFIT OF ITS, TO INITIALIZE .JBFF + +PTHI==. ? .==PTLO ;SWITCH TO IMPURE AREA +VPATCH: BLOCK 10 +IMPTOP:: + + LOC PTHI ; switch to pure for dumping symbols + +END GO diff --git a/src/sysen1/@.diff b/src/sysen1/@.diff new file mode 100644 index 00000000..5a315f04 --- /dev/null +++ b/src/sysen1/@.diff @@ -0,0 +1,2073 @@ + +;COMPARISON OF DSK:SYSEN1;@ 695 AND DSK:GUEST4;SKEF NEWAT +;OPTIONS ARE /E /L /W /3 + +**** FILE DSK:SYSEN1;@ 695, 2-5 (1616) AFTER P=: +1) ;;; GLS Guy L. Steele Jr. (GLS@MIT-MC) +1) ;;; RMS Richard M. Stallman (RMS@MIT-AI) +1) ;;; RHG/RG02 Richard H. Gumpertz (Gumpertz@CMU-10A) +1) ;;; MRC Mark Crispin (MRC@SU-AI) +1) ;;; MOON David A. Moon (MOON@MIT-MC) +1) ;;; EAK Earl A. Killian (EAK@MIT-MC) +1) ;;; MT Michael Travers (MT@MIT-XX) +1) ;;; JMN Joseph M. Newcomer (Newcomer@CMU-10A) +1) ;;; KLH Ken Harrenstien (KLH@MIT-AI/SRI-NIC) +1) ;;; THE AUTHORITATIVE SOURCE FOR @ IS [MIT-AI]SYSEN1;@ > +1) ;; WARNING: RMS, MRC, AND GLS DON'T TAKE THIS BUREAUCRACY VERY SERIOUSLY. +**** FILE DSK:GUEST4;SKEF NEWAT, 2-5 (1616) AFTER P=: +2) ;;; GLS Guy L. Steele Jr. (GLS@MIT-MC) +2) ;;; RMS Richard M. Stallman (RMS@MIT-AI) +2) ;;; RHG/RG02 Richard H. Gumpertz (Gumpertz@CMU-10A) +2) ;;; MRC Mark Crispin (MRC@SU-AI) +2) ;;; MOON David A. Moon (MOON@MIT-MC) +2) ;;; EAK Earl A. Killian (EAK@MIT-MC) +2) ;;; MT Michael Travers (MT@MIT-XX) +2) ;;; JMN Joseph M. Newcomer (Newcomer@CMU-10A) +2) ;;; KLH Ken Harrenstien (KLH@MIT-AI/SRI-NIC) +2) ;;; LNZ Leonard N. Zubkoff (Zubkoff@CMU-20C) +2) ;;; SKEF J. Skeffington Wholey (Wholey@CMU-20C) +2) ;;; THE AUTHORITATIVE SOURCE FOR @ IS [MIT-AI]QUUX;@ > +2) ;; WARNING: RMS, MRC, AND GLS DON'T TAKE THIS BUREAUCRACY VERY SERIOUSLY. +*************** + +**** FILE DSK:SYSEN1;@ 695, 2-476 (27936) AFTER P=: +1) ;;; 16-Jan-81 KLH Added /D[Canon] as an ersatz XGP which accepts +1) ;;; ITS XGP format files, but has different resolution. +1) ;;; Fixed bug at FPSFN3, the minus-flag in B wasn't +1) ;;; being saved during font filename parsing. +1) ;;; Notiyr 10X monitor bug: GTJFN of a FPal by itself +1) ;;; will cause "No such version" error on 10X, even tho +1) ;;; the GJ%OFG bit is set!!! Not sure if buggy on T20 too. +1) ;;; Apparently only sure way to win is to parse the string +1) ;;; completely like MIDAS does, rather than trying to +1) ;;; get GTJFN to do the work. +1) ;;; Fixe#PFN3 to only zap last 3 chars of file extension +1) ;;; if on DOS system, rather than NOITS. +1) ;;; Fixed MCRFN4 to account for overlarge page #'s (was +1) ;;; running CREF lines off the right margin). In general, +1) ;;; any text of more than 10,000 lines per page is going +1) ;;; to lose grossly... in case anyone didn't know this. +1) ;;; (the doc doesn't mention this sort of thing) +1) ;;; 1-Mar-82 JMN Added device Florida (Florida Data Systems OSP-130) +**** FILE DSK:GUEST4;SKEF NEWAT, 2-478 (28007) AFTER P=: +2) ;;; 1-Mar-82 JMN Added device Florida (Florida Data Systems OSP-130) +*************** + +**** FILE DSK:SYSEN1;@ 695, 2-499 (29260) AFTER P=: +1) ;;; 29-Jun-82 KLH Took out the ADD C,FNTBAS at FNTCPP-3 (calculating +1) ;;; default # lines on page) because it seems to be +1) ;;; completely wrong-headed; it was screwing up +1) ;;; our Canon spooler (which is diligent about going to +1) ;;; ; page if a line runs over BOTM4A If someone +1) ;;; can explain why it works for XGP, and prove it isn't +1) ;;; an XGP bug, please do so. +1) ;;; FINALLY!!!!! R6aed losing TNX GTJFN filename parser +1) ;;; with by-hand parser from MIDAS source. Incomplete +1) ;;; filenames now default sensibly, tho still have sixbit +1) ;;; restrictin FN1 and EXT. +1) ;;; 25-Sep-82 KLH Increased DIRDLN to 4000 (so can list ITS) +1) SUBTTL SYSTEM-DEPENDENT DEFINITIONS +**** FILE DSK:GUEST4;SKEF NEWAT, 2-484 (28366) AFTER P=: +2) ;;; 17-Mar-82 JMN Removed device Florida since we didn't get it after all +2) ;;; 0rd2eice Sanders +2) ;;; 17-Mar-82 JMN Experienced numerous problems with copyrights coming +2) ;;; out on the next page. Looking at the code after +2) ;;; OUTPP2, I found that the IDIVI and test for +2) ;;; zero remainder make sense only if the increment is +2) ;;; 1! Stepping by more than 1, as is done a few +2) ;;; instructions before that, will cause the +2) ;;; test to fail. +2) ;;; 28-May-82 LNZ Change Sanders support to handle margins properly; that +2) ;;; is, send VMON rather than VMOFF. +2) ;;; 7-Jun-82 JMN Fixed GETHST code so that if it fails (such as on a +2) ;;; non-TOPS-20AN system) AT keeps running +2) ;;; 21-Aug-82 SKEF Added "new" LREC format for TNX sites. Groups start +2) ;;; with an ascii string which is the name of the file, +2) ;;; followed by a zero WORD, followed by data. In @ file +2) ;;; blocks, SNAME is a byte pointer to the file name. +2) ;;; NAMBLK is now an area in which name strings are consed. +2) SUBTTL SYSTEM-DEPENDENT DEFINITIONS +*************** + +**** FILE DSK:SYSEN1;@ 695, 3-85 (32031) AFTER P=: +1) ; True site-dependent (as opposed to OS-dependent) stuff +1) IFE <.SITE 0>-,[ +1) XGPFMT==:ITSFLG ; ITS type XGP cmds, but require /D[C] +1) ; to select Canon. Later fix up? +1) FNTDSN==:144 ; directory on SRI-NIC +1) ] ;SRI-NIC +1) IFNDEF XGPFMT,[ ;WHAT SORT OF XGP COMMANDS DO WE WANT TO OUTPUT? +**** FILE DSK:GUEST4;SKEF NEWAT, 4-2 (31482) AFTER P=: +2) IFNDEF XGPFMT,[ ;WHAT SORT OF XGP COMMANDS DO WE WANT TO OUTPUT? +*************** + +**** FILE DSK:SYSEN1;@ 695, 4-13 (32674) AFTER P=: +1) IFNDEF FLAFLG,[ ; Support Florida Data Systems OSP/130 +1) FLAFLG==:1 ; yes +1) IFNDEF FLAFLG, FLAFLG==:0 +1) ];IFNDEF FLAFLG +1) ;NONZERO TO ALLOW PRESS FILE OUTPUT. +**** FILE DSK:GUEST4;SKEF NEWAT, 4-12 (31871) AFTER P=: +2) ifNDEF VFXFLG,[ ; Support Sanders VariFlex S700 +2) VFXFLG==:1 ; yes +2) IFNDEF VFXFLG, VFXFLG==:0 +2) ];IFNDEF VFXFLG +2) ;NONZERO TO ALLOW PRESS FILE OUTPUT. +*************** + +**** FILE DSK:SYSEN1;@ 695, 4-48 (33345) AFTER P=: +1) DEFINE FLORIDA +1) 1 LAFLG!TERMIN +1) DEFINE NOFLORIDA +1) IFE FLAFLG!TERMIN +1) DEFINE XGPRES +**** FILE DSK:GUEST4;SKEF NEWAT, 4-47 (32535) AFTER P=: +2) DEFINE VARIFLEX +2) IFN VFXFLG!TERMIN +2) DEFINE NOVARIFLEX +2) IFE VFXFLG!TERMIN +2) 1"ƓNE XGPRES +*************** + +**** FILE DSK:SYSEN1;@ 695, 7-44 (40070) AFTER OLOOP: +1) IFNDEF DIRDLN,DIRDLN==:4000 ;DEFAULT DIRBUF SIZE IN 18-BIT BYTES +1) CMU,IFNDEF DFMARG,DFMARG==:394. ;AT CMU, USE 1CM MARGINS +**** FILE DSK:GUEST4;SKEF NEWAT, 7-44 (39264) AFTER OLOOP: +2) IFNDEF DIRDLN,DIRDLN==:2000 ;DEFAULT DIRBUF SIZE IN 18-BIT BYTES +2) CMU,IFNDEF DFMARG,DFMARG==:394. ;AT CMU, USE 1CM MARGINS +*************** + +**** FILE DSK:SYSEN1;@ 695, 10-4 (46919) AFTER C.CREF==: +1) ;THE FIRST WORD OF AN LREC FILE SHOULD NOW BE SIXBIT/LREC/+1. +1) ;ATTEMPTS TO USE FILES WHICH DO NOT SATISFY THAT CRITERION +1) ;CAUSE ERROR MESSAGES. +1) ;THE REST OF FILE IS COMPOSED OF ENTRIES, ONE AFTER THE OTHER. +**** FILE DSK:GUEST4;SKEF NEWAT, 10-4 (46113) AFTER C.CREF==: +2) ;THE FIRST WORD OF AN LREC FILE SHOULD NOW BE SIXBIT/LREC/+1 FOR NOTNX SYSTEMS +2) ;AND SIXBIT/LREC/+2 FOR TNX SYSTEMS. THE LREC FORMATS DIFFER IN THE WAY A +2) ;FILENAME IS STORED. THE FORMAT FOR NOTNX SYSTEMS WILL BE CALLED THE "OLD" +2) ;FORMAT, AND THE TNX FORMAT WILL BE CALLED THE "NEW" FORMAT. +2) ;ATTEMPTS TO USE FILES WHICH DO NOT SATISFY THE PROPER CRITERION (WITH RESPECT +2) ;TO TNX-ISHNESS) CAUSE ERROR MESSAGES. +2) ;THE REST OF FILE IS COMPOSED OF ENTRIES, ONE AFTER THE OTHER. +*************** + +**** FILE DSK:SYSEN1;@ 695, 10-11 (47310) AFTER C.CREF==: +1) ;AN ENTRY BEGINS WITH 4 WORDS GIVING THE SNAME, DEV, FN1 AND FN2 OF THE FILE. +1) ;THEN COME 0 OR MORE SUBENTRIES, FOLLOWED BY A -1 SIGNIFYING THE END +**** FILE DSK:GUEST4;SKEF NEWAT, 10-14 (46772) AFTER C.CREF==: +2) ;AN OLD FORMAT ENTRY BEGINS WITH 4 WORDS GIVING THE SNAME, DEV, FN1 AND FN2 OF +2) ;THE FILE. A NEW FORMAT ENTRY BEGINS WITH AN ASCIZ STRING GIVING THE FILENAME +2) ;FOLLOWED BY A 0 WORD. +2) ;THEN COME 0 OR MORE SUBENTRIES, FOLLOWED BY A -1 SIGNIFYING THE END +*************** + +**** FILE DSK:SYSEN1;@ 695, 13-14 (52678) AFTER DEVPDO==: +1) DEVANA==:6 ; Anadex something +1) DEVCGP==:7 ; Canon LBP-10 hacking XGP-type input +1) DEVFLA==:10 ; Florida something +1) DEVMAX==:1"]A+ +1) XGPP:,a => DEVICE DOESN'T CONTAIN XGP, -1 => DEVIXG, +1 => DEVCXG +1) ;-2 => DEVCGP (ersatz ITS XGP) +1) sTP: DFLANG ;TYPE OF INPUT EXPECTED (WHAT LANGUAGE IT'S IN) +**** FILE DSK:GUEST4;SKEF NEWAT, 13-14 (52245) AFTER DEVPDO==: +2) DEVMAX==:10 ;1 + +2) XGPP: 0 ;0 => DEVICE DOESN'T CONTAIN XGP, -1 => DEVIXG, +1 => DEVCXG +2) CODTYP: DFLANG ;TYPE OF INPUT EXPECTED (WHAT LANGUAGE IT'S IN) +*************** + +**** FILE DSK:SYSEN1;@ 695, 15-56 (61203) AFTER FWIDFL: +1) FWIDFL: XWD 0,0 +1) SIXBIT /FON/ ;on FON: +1) SIXBIT /FONTS/ +1) SIXB5/ID/ +1) ];CMU20 +**** FILE DSK:GUEST4;SKEF NEWAT, 15-56 (60622) AFTER FWIDFL: +2) FWIDFL: 440700,,[asciz /FON:Fonts.Wid/] +2) ];CMU20 +*************** + +**** FILE DSK:SYSEN1;@ 695, 15-63 (61337) AFTER FWIDFL: +1) FWIDFL: 0 +1) SIXBIT /SYS/ +1) SIXBIT /FONTS/ +1) SIXBIT /WID/ +1) ];NOCMU20 +**** FILE DSK:GUEST4;SKEF NEWAT, 15-60 (60723) AFTER FWIDFL: +2) čL: 440700,,[asciz /PnF9onts.Wid/] +2) OMU20 +*************** + +**** FILE DSK:SYSEN1;@ 695, 19-6 (69932) AFTER F.==: +1) F.ISNM==:0 ;INPUT SNAME +1) F.IDEV==:1 ;INPUT DEVICE +**** FILE DSK:GUEST4;SKEF NEWAT, 19-6 (69307) AFTER ˞u +2) ˤӝM==:0 ;INPUT SNAME, or byte pointer to name string +2) F.IDEV==:1 ;INPUT DEVICE +*************** + +**** FILE DSK:SYSEN1;@ 695, 19-55 (72246) AFTER MULTI: +1) NAMSIZ==:40. ; big buffer for accumulating filenames +1) NAMBLK: BLOCK NAMSIZ ; here it is +1) JFNBLK: BLOCK 17 ; for longform JFN +**** FILE DSK:GUEST4;SKEF NEWAT, 19-55 (71653) AFTER MULTI: +2) NAMSIZ==:200. ; big buffer for accumulating filenames +2) NAMBLK: BLOCK NAMSIZ ; here it is +2) NAMEND:: ; and here it isn't +2) NAMNXT: NAMBLK ; pointer to next free word in it +2) JFNBLK: BLOCK 17 ; for longform JFN +*************** + +**** FILE DSK:SYSEN1;@ 695, 22-14 (78304) AFTER CRDFN2: +1) IPTFN2: OFFSET -. +**** FILE DSK:GUEST4;SKEF NEWAT, 22-14 (77795) AFTER CRDFN2: +2) NOTNX,[ +2) IPTFN2: OFFSET -. +*************** + +**** FILE DSK:SYSEN1;@ 695, 22-26 (78555) AFTER T10,CODTXT +1) TNX,CODTXT::0 +1) CODMDL:: SIXBIT/MDL/ +**** FILE DSK:GUEST4;SKEF NEWAT, 22-27 (78055) AFTER T10,CODTXT +2) CODMDL:: SIXBIT/MDL/ +*************** + +**** FILE DSK:SYSEN1;@ 695, 22-36 (78734) AFTER T10,FNDFN2 +1) TNX,FNDFN2: SIXBIT/KST/ +1) CMU,FNDFN2: SIXBIT/KST/ +1) SAI,FNDFN2: SIXBIT/FNT/ +1) OTS +1) OPTFN2: OFFSET -. +**** FILE DSK:GUEST4;SKEF NEWAT, 22-36 (78219) AFTER T10,FNDFN2 +2) CMU,FNDFN2: SIXBIT/KST/ +2) SAI,FNDFN2: SIXBIT/FNT/ +2) ];NOTNX +2) TNX,[ +2) IPTFN2: OFFSET -. +2) CODMID:: 440700,,[ASCIZ /MID/] +2) CODRND:: 440700,,[0] +2) CODFAI:: 440700,,[ASCIZ /FAI/] +2) CODP11:: 440700,,[ASCIZ /M11/] +2) CODLSP:: 440700,,[ASCIZ /LSP/] +2) CODM10:: 440700,,[ASCIZ /MAC/] +2) CODUCO:: 440700,,[0] +2) CODTXT:: 440700,,[0] +2) CODMDL:: 440700,,[ASCIZ /MDL/] +2) CODH16:: 440700,,[ASCIZ /H16/] +2) CODMAX:: OFFSET 0 +2) LRCFN2: 440700,,[ASCIZ /LREC/] +2) ALRFN2: 440700,,[ASCIZ /LRC/] +2) )F2: 440700,,[ASCIZ /OLR/] +2) CRDFN2: 440700,,[ASCIZ /ATC/] +2) TNX,FNDFN2: 440700,,[ASCIZ /KST/] +2) ];TNX +2) ];NOITS +2) NOTNX,[ +2) OPTFN2: OFFSET -. +*************** + +**** FILE DSK:SYSEN1;@ 695, 22-56 (79111) AFTER OPTFN2: +1) DEVCGP:: SIXBIT/CGP/ +1) DEVFLA:: SIXBIT/FLA/ +1) DEVMAX::OFFSET 0 +1) SUBTTL LINE AND PAGE LENGTH BY DEVICE +**** FILE DSK:GUEST4;SKEF NEWAT, 22-80 (79099) AFTER OPTFN2: +2) DEVVFX:: SIXBIT/VFX/ +2) DEVMAX::OFFSET 0 +2) ];NOTNX +2) TNX,[ +2) OPTFN2: OFFSET -. +2) DEVLPT:: 440700,,[ASCIZ/LST/] +2) kI i40700,,[ASCIZ/XGP/] +2) DEVCXG:: 440700,,[ASCIZ/XGO/] +2) DEVGLD:: 440700,,[ASCIZ/GLD/] +2) DEVLDO:: 440700,,[ASCIZ/PRESS/] +2) DEVPDO:: 440700,,[ASCIZ/PRESS/] +2) DEVANA:: 440700,,[ASCIZ/ANA/] +2) DEVVFX:: 440700,,[ASCIZ/VFX/] +2) DEVMAX::OFFSET 0 +2) ];TNX +2) SUBTTL LINE AND PAGE LENGTH BY DEVICE +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-14 (79460) AFTER DEVANA: +1) DEVCGP:: 119. +1) DEVFLA:: 132. +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-14 (79739) AFTER DEVANA: +2) DEVVFX:: 132. +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-28 (79753) AFTER DEVANA: +1) DEVCGP:: 85. +1) DEVFLA:: 60. +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-27 (80017) AFTER DEVANA: +2) DEVVFX:: 60. +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-42 (80043) AFTER DEVANA: +1) DEVCGP:: 240. +1) DEVFLA:: 0 +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-40 (80293) AFTER DEVANA: +2) DEVVFX:: 960. +2) DEVMAOFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-56 (80346) AFTER DEVANA: +1) DEVCGP:: 240. +1) DEVFLA:: 0 +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-53 (80584) AFTER DEVANA: +2) DEVVFX:: 288. +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-70 (80642) AFTER DEVANA: +1) DEVCGP:: 1980. ; Theoretically 2040 but right margin has 60-pixel bug +1) DEVFLA:: 0 +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-66 (80868) AFTER DEVANA: +2) DEVVFX:: 8160. +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-84 (81015) AFTER DEVANA: +1) DEVCGP:: 240.*11. ; Should be able to hack full page. +1) kF. a +1) kMX::OFA0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-79 (81174) AFTER DEVANA: +2) DEVVFX:: 3168. +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 23-100 (81416) AFTER DEVANA: +1) DEVCGP:: 0,,-2 +1) DEVFLA:: 0 +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 23-94 (81523) AFTER DEVANA: +2) DEVVFX:: 0 +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 26-20 (84247) AFTER FLSNLR: +1) FLSFNT::[ASCIZ /Font file not in known format (KST or FNT)/] +**** FILE DSK:GUEST4;SKEF NEWAT, 26-20 (84338) AFTER FLSNLR: +2) TNX,FLSNNL::[ASCIZ /Old format LREC file. Run ZAPLRC.EXE to convert this file to the new format./] +2) FLSFN[SCIZ file not in known format (KST  +*************** + +**** FILE DSK:SYSEN1;@ 695, 37-19 (105886) AFTER SYSINI: +1) TNX,.ERR This 1-word lossage should be fixed. +1) T20,[ +**** FILE DSK:GUEST4;SKEF NEWAT, 37-19 (106078) AFTER SYSINI: +2) T20,[ +*************** + +**** FILE DSK:SYSEN1;@ 695, 37-28 (106160) AFTER SYSINI: +1) jrst MFail ; couldn't +1) setzm machine ; indicate ASCII value is valid +**** FILE DSK:GUEST4;SKEF NEWAT, 37-27 (106305) AFTER SYSINI: +2) erjmp MFail ; couldn't +2) setzm machine ; indicate ASCII value is valid +*************** + +**** FILE DSK:SYSEN1;@ 695, 37-106 (107924) AFTER GOSCEL: +1) CAIE A,"a +1) CAIN A,"A ; If not "A" for "ATSIGN" +1) JRST RSCAN1 +1) ËÃ3AY҄w assume line is not (3d cmd string. +1) JRST POPJ1 ; (this is pretty dumb, though) +1) PBIN +1) JRST GOSCEL +1) T.ЅIN h)rch for space +**** FILE DSK:GUEST4;SKEF NEWAT, 37-105 (108070) AFTER GOSCEL: +2) ; CAIE A,"a +2) ; CAIN A,"A ; If not "A" for "ATSIGN" +2) ; JRST RSCAN1 +2) ;GOSCEL: CAIN A,^J ; assume line is not a good cmd string. +2) ; JRST POPJ1 ; (this is pretty dumb, though) +2) ; PBIN +2) ; JRST GOSCEL +2) RSCAN1: PBIN ; Search for space +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-7 (117783) AFTER FPFILE: +1) MOVE CP,[440700,,NAMBLK] +1) SETZ CC, +**** FILE DSK:GUEST4;SKEF NEWAT, 43-7 (117936) AFTER FPFILE: +2) move cp, namnxt ; get addr of next file name word +2) hrli cp, 440700 ; make it a 7 bit byte pointer +2) ;wm cp, LS.sore b=2wtr in file block +2) SETZ CC, +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-35 (118577) AFTER FPLOO2: +1) JRST FPLOOP ; get more +**** FILE DSK:GUEST4;SKEF NEWAT, 43-37 (118858) AFTER FPLOO2: +2) hrrz a, cp ; get address +2) cail a, namend ; skip if we haven't destroyed things +2) jrsPfy"]e ranAflenam9ce +2) JRST FPLOOP ; get more +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-40 (118702) AFTER FPSPC: +1) MOVE A,[440700,,NAMBLK] +1) PUSHJ P,TNXRFD +1) IFN 0,[ +1) ;;; Now, su the longform GTJFN arguments that are naready +**** FILE DSK:GUEST4;SKEF NEWAT, 43-45 (119122) AFTER FPSPC: +2) ;;; Now, set up the longform GTJFN arguments that are not already +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-63 (119336) AFTER FPSPC: +1) HRROI B,NAMBLK +1) PUSHJ P,CVJFN ; Get JFN +1) JRST FILBOG ; bogus filespec +1) PUSHJ P,UNJFN +1) RLJFN h)eyAJFN, don't any more +1) NOP +1) ] ;IFN 0 +1) FPSWL: +**** FILE DSK:GUEST4;SKEF NEWAT, 43-64 (119701) AFTER FPSPC: +2) MOVE B,0(P) ; Filename from file block +2) PUSHJ P,CVJFN ; Get JFN +2) JRST FILBOG ; bogus filespec +2) HRRI B,1(CP) ; 1 plus addr of last char -> A +2) MOVEM B,NAMNXT ; point to next free name word +2) RLJFN ; Release JFN, don't need any more +2) NOP +2) +2) FPSWL: +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-96 (119991) AFTER FILBOG: +1) ;;; SIXBIT word +1) UNJFN: PUSH P,D +1) PUSH P,A ; save JFN +1) HRROI A,NAMBLK ; where to write string +1) HRRZ B,(P) ; get JFN back +**** FILE DSK:GUEST4;SKEF NEWAT, 43-97 (120455) AFTER FILBOG: +2) ;;; SIXBIT word. +2) UNJFN: pusx,Ar +2) PUSH P,D +2) PUSH P,A ; save JFN +2) hrro a, namnxt ; where to write string +2) hrr r, a ; address for call to JFN6 +2) HRRZ0("DwAQ ack +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-105 (120219) AFTER UNJFN: +1) PUSHJ P,JFN6 ; convert7ixbit, return in A +1) MOVEM A,1(L) +1) ; Convert dev: to PPN +1) T20,[ HRROI A,NAMBLK +1) HRRZ B,(P) +1) 3g֋0[c00000,,0] ; device and no punctuation +1) SETZ D, +1) JFNS +1) PUSH P,A ; save string pointer +1) PUSHJ P,JFN6 ; check for nullness +1) JUMPN A,JFNNZD ; non-null +1) MOVE A,[ASCII /PS/] ; dummy device +1) MOVEM A,NAMBLK +1) MOVE A,[260700,,NAMBLK] ; pointer to just past it +1) MOVEM A,(P) +1) JFNNZD: +1) MOVEI A,": ; Punctuation +1) IDPB A,(P) ; put it into string +1) MOVE A,NAMBLK ;PRESERVE STRUCTURE NAME +1) MOVE B,NAMBLK+1 +1) MOVEM A,STRBUF +1) MOVEM B,STRBUF+1 +1) MOVE A,(P) ; where to write directory name +1) HRRZ B,-1(P) ; get JFN back +1) MOVE C,[20000,,1] ; +1) JFNS ; convert to string +1) POP P,A ; pointer to where it should be +1) ILDB B,A ; anything? +1) SKIPN B +1) JRST FILZPP +1) MOVSI A,(RC%EMO) ; Want exact match +1) HRROI B,NAMBLK +1) RCDIR ; Error shouldn't happen +1) MOVE B,C ; Get dir # into B +1) ];T20 +1) 10X,[ HRROI A,NAMBLK +1) HRRZ B,(P) +1) MOVE C,[20000,,0] ; "directory" +1) JFNS +1) MOVE A,[440700,,NAMBLK] +1) ILDB B,A ; Anything? +1) JUMPE B,FILZPP +1) SETZ A, +1) HRROI B,NAMBLK +1) STDIR +1) .VALUE ; No match - should never happen +1) .VALUE ; ambiguous - ditto +1) MOVE B,A ; Get dir # into B +1) ];10X +1) +**** FILE DSK:GUEST4;SKEF NEWAT, 43-108 (120736) AFTER UNJFN: +2) hrri d, 1(a) ; see if we ran out of string space +2) cail d, namend +2) jrst fnsgon ; yup, all gone +2) movem d, namnxt ; update next filename pointer +2) PUSHJ P,JFN6 ; convert to sixbit, return in A +2) 3g֋`c(L) +2) ; Convert dev: to PPN@@@@We have to hack this sometime? +2) ;T20,btro a, namnxt ; pointer to next filename string +2) ; HRRZ B,(P) +2) ; MOVE C,[100000,,0] ; device and no punctuation +2) ; SETZ D, +2) ; JFNS +2) ; hrri d, 1(a) ; see if we ran out of string space +2) ; cail d, namend +2) bPjst fnsgon ; yup, all gone +2) ; movem d, namnxt ; update next filename pointer +2) ; PUSH P,A ; save string pointer +2) ; PUSHJ P,JFN6 ; check for nullness +2) ; JUMPN A,JFNNZD ; non-null +2) ; MOVE A,[ASCII /PS/] ; dummy device +2) ; MOVEM A,NAMBLK +2) ; MOVE A,[260700,,NAMBLK] ; pointer to just past it +2) ; MOVEM A,(P) +2) ;JFNNZD: MOVEI A,": ; punctuation +2) ; IDPB A,(P) ; put it into string +2) ; MOVE A,NAMBLK ;PRESERVE STRUCTURE NAME +2) ; MOVE B,NAMBLK+1 +2) ; MOVEM A,STRBUF +2) ; MOVEM B,STRBUF+1 +2) ; MOVE A,(P) ; where to write directory name +2) ; HRRZ B,-1(P) ; get JFN back +2) ; MOVE C,[20000,,1] ; +2) ; JFNS ; convert to string +2) ; POP P,A ; pointer to where it should be +2) ; ILDB B,A ; anything? +2) ; SKIPN B +2) ; JRST FILZPP +2) ; MOVSI A,(RC%EMO) ; Want exact match +2) ; HRROI B,NAMBLK +2) ; RCDIR ; Error shouldn't happen +2) ; MOVE B,C ; Get dir # into B +2) ;];T20 +2) ;10X,[ HRROI A,NAMBLK +2) ; HRRZ B,(P) +2) ; MOVE C,[20000,,0] ; "directory" +2) ; JFNS +2) ; MOVE A,[440700,,NAMBLK] +2) ; ILDB B,A ; Anything? +2) ; JUMPE B,FILZPP +2) ; SETZ A, +2) ; HRROI B,NAMBLK +2) ; STDIR +2) ; .VALUE ; No match - should never happen +2) ; .VALUE ; ambiguous - ditto +2) ; MOVE B,A ; Get dir # into B +2) ;];10X +2) +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-158 (121533) AFTER FILZPP: +1) HRROI A,NAMBLK +1) HRRZ B,(P) +**** FILE DSK:GUEST4;SKEF NEWAT, 43-168 (122474) AFTER FILZPP: +2) hrro a, namnxt ; next free filename string +2) :9rKa ; address for call JN6 +2) HRRZ B,(P) +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-162 (121591) AFTER FILZPP: +1) PUSHJ P,JFN6 +**** FILE DSK:GUEST4;SKEF NEWAT, 43-173 (122599) AFTER FILZPP: +2) hrri d, 1(a) ; see if we ran out of string space +2) cail d, namend +2) jrst fnsgon ; yup, all gone +2) movem d, namnxt ; update next filename pointer +2) PUSHJ P,JFN6 +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-165 (121654) AFTER FILZPP: +1) HRROI A,NAMBLK +1) HRRZ B,(P) +**** FILE DSK:GUEST4;SKEF NEWAT, 43-180 (122813) AFTER FILZPP: +2) hrro a, namnxt ; next free filename string +2) hrr Ka ; address for call JN6 +2) HRRZ B,(P) +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-169 (121712) AFTER FILZPP: +1) PUSHJ P,JFN6 +**** FILE DSK:GUEST4;SKEF NEWAT, 43-185 (122938) AFTER FILZPP: +2) hrri d, 1(a) ; see if we ran out of string space +2) cail d, namend +2) jrst fnsgon ; yup, all gone +2) movem d, namnxt ; update next filename pointer +2) PUSHJ P,JFN6 +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-173 (121777) AFTER FILZPP: +1) POPJ P, +1) nݠe9ing in NAMS%o SIXBIT and leave in A +1) JFN6: PUSH P,CH +1) MOVE B,[440600,,A] +1) MOVE C,[440700,,NAMBLK] +1) SETZ A, +1) JFN6A: ILDB CH,C +1) 2͡E CH,JFN6B +1) SUBI CH,40 +**** FILE DSK:GUEST4;SKEF NEWAT, 43-193 (123154) AFTER FILZPP: +2) pop p, r +2) POPJ P, +2) ;;; convert string starting at what R points to to SIXBIT and leave in A +2) JFN6: PUSH P,CH +2) MOVE B,[440600,,A] +2) hrli r, 440700 +2) SETZ A, +2) JFN6A: ILDB CH,r +2) JUMPE CH,JFN6B +2) SUBI CH,40 +*************** + +**** FILE DSK:SYSEN1;@ 695, 43-185 (121994) AFTER JFN6A: +1) JRST JFN6A +1) JFN6B: POP P,CH +1) POPJ P, +1) nݠonvert the JFNBLK sptPJN +**** FILE DSK:GUEST4;SKEF NEWAT, 43-206 (123392) AFTER JFN6A: +2) JRST JFN6A +2) JFN6B: POP P,CH +2) POPJ P, +2) ;;; Ce:h JFNBLK spec to a JFN +*************** + +**** FILE DSK:SYSEN1;@ 695, 44-2 (122328) AFTER CVJFN: +1) SUBTTL File Description Storage (FILBLK's) +1) TNXSW== +1) IFN T)Y[ +1) ITSSW== +1) ;VBLK +1) ; Definitions for indices into a FILBLK. +1) ; Scratch block FB is formed while defining indices... +1) FB: OFFSET -. +1) ; Lots of crocks depend on the exact order of these 4 items. +1) $F6DEV:: 0 ; SIXBIT Device name +1) $F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +1) $F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +1) $F6DIR:: 0"DASIXBIT Directory (may be numerical PPN) +1) L$F6BLK==. +1) $FVERn IFGEN:H w File vers; Qor generation). NUMBER, not string. +1) IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +1) $FDEV:: 0 ; Device name +1) $FDIR:: 0 ; Directory name +1) $FNAME:: 0 ; File name (i.e. main name) +1) $FTYPE:: $FEXT:: 0 ; File type (or extension) +1) $FTEMP:: 0 ; -1 => File is a temporary file. +1) $FACCT:: 0 ; Account string +1) $FPROT:: 0 ; Protection string +1) $FJFN:: 0 ; JFN for file (may be ,,) +1) ] +1) IFN ITSSW\aӯ,[ +1) $FDEV==:$F6DEV ; These definitions made so some common code can do +1) $FDIR==:$F6DIR ; the right things. +1) $FNAME==:$F6FNM +1) $FTYPE==:$F6TYP +1) $FEXT==:$F6TYP +1) ] +1) L$FBLK==. ; Length of a FILBLK. +1) OFFSET 0 ; End of index definitions. +1) ] ;TNXSW +1) IFN TNXSW,[ ; Moby conditional for Tenex reader. +1) ; TNXRFD - ATSIGN TNX filename reader. +1) ; Takes BP in A to ASCIZ string to parse. +1) ; Takes L as ptr to filename block to fill out. +1) baX nothing. +1) TNXRFD: +1) .BEGIN RFDBLK +1) MAXIND==100. +1) FL20X==400000 +1) FLUNRD==200000 +1) FRCMND==2 +1) FRNNUL==1 +1) IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +1) IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +1) FRFN1==4 +1) IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. +1) FRARRO==10 +1) F=R ; F must not == L. +1) FF=R+1 +1) AA=R+2 +1) T=R+3 +1) TT=R+4 +1) INSIRP PUSH P, A B C D F FF AA T TT +1) SETZ FF, ; set up flags +1) T20, TLO FF,FL20X +1) MOVEI F,FB ; Point to scratch FB +1) MOVEM A,RCHBP ; Save BP to asciz string +1) SETZM FB +1) MOVE A,[FB,,FB+1] +1) BLT A,FB+L$FBLK-1 +1) PUSHJ P,TRFD +1) INSIRP POP P, TT T AA FF F D C B +1) PUSH P,F +1) MOVEI F,FB +1) PUSHJ P,CVFSIX ; Convert to sixbit entries +1) IRP STF,,[DIR,DEV,FN1,FN2] +1) MOVE A,$F6!STF(F) +1) MOVEM A,(L).IRPCNT +1) TERMIN +1) PUSHJ P,TDIRNM +1) CAIE A, ; If got a dir number, +1) SETZM 1(L) ; Zap the device field. +1) MOVEM A,0(L) ; Else keep it anyway, store result. +1) POP P,F +1) POP P,A +1) APOPJ: POPJ P, +1) ; TDIRNM - Given filblk pointed to by F, returns in A the dir # +1) ; for dev/dir combination. Returns 0 if failure. +1) TDIRNM: SKIPN A,$FDIR(F) ; Get BP to dir name +1) POPJ P, ; Not specified, leave all alone. +1) PUSH P,B +1) 10X,[ +1) MOVE B,A +1) SETZ A, +1) STDIR +1) SETZ A, ; No match - should never happen +1) SETZ A, ; ambiguous - ditto +1) ];10X +1) T20,[ PUSH P,C +1) SKIPN A,$FDEV(F) ; Device exists? +1) MOVE A,[440700,,[ASCIZ /PS/]] ; dummy device +1) SKIPA B,[440700,,STRBUF] +1) IDPB C,B +1) ILDB C,A +1) JUMPN C,.-2 +1) MOVEI C,": +1) IDPB C,B +1) MOVEI C,"< ;> +1) IDPB C,B +1) SKIPA A,$FDIR(F) +1) IDBP C,B +1) ILDB C,A +1) JUMPN C,.-2 ;< +1) MOVEI C,"> +1) IDPB C,B +1) SETZ C, +1) IDPB C,B +1) MOVSI A,(RC%EMO) ; Want exact match +1) HRROI B,STRBUF +1) RCDIR ; Error shouldn't happen +1) ERJMP [SETZ C, ? JRST .+1] +1) MOVE A,C ; Get dir # into A +1) POP P,C +1) ];T20 +1) POP P,B +1) POPJ P, +1) ; TRFD - TENEX-style Filename Reader. +1) ; Takes input from RCH. +1) ; Deposits name strings into filblk F points to. +1) ; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +1) ; Uses FRFEXT flag to see if already read extension (type) or not. +1) ; Refuses to accept existing defaults for version, ;T, account, +1) ; protection, or JFN. It will also zap an existing directory +1) ; default if a device is specified, and vice versa. This is so that +1) ; logical names will win a little better. +1) ; Implements crufty ^R hack (if see ^R, act as if just starting to +1) ; read filename, so effect is stuff before ^R has set defaults.) +1) TRFD: TRZ FF,FRNNUL +1) SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. +1) SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. +1) SETZM $FPROT(F) +1) SETZM $FTEMP(F) +1) SETZM $FVERS(F) +1) TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +1) TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space +1) TRNN FF,FRCMND ; If parsing command line, +1) CAIE A,"; ; or if char isn't semicolon, +1) JRST TRFD21 ; just handle normally. +1) TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! +1) CAIE A,^M ; So flush rest, up to EOL. +1) JRST TRFD15 +1) POPJ P, +1) TRFD1: TLO FF,FLUNRD ; come here to re-read last char +1) TRFD2: PUSHJ P,RCH ; Get char +1) TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) +1) CAIN A,^I ; or tab? +1) JRST [TRNE FF,FRCMND ; Space/tab, if reading command line +1) JRST TRFD2 ; then ignore and continue scanning (for switches), but +1) JRST TRFD15] ; if not in cmd line, go flush entire rest of line! +1) CAIN A,^M ; End of line? +1) POPJ P, ; If so, obviously done. +1) CAIN A,^R ; Crufty ^R hack? +1) JRST TRFD01 ; Sigh, pretend starting over. +1) TRNN FF,FRCMND ; Must we check for cmd line frobs? +1) JRST TRFD22 ; Nope, skip them. +1) ; Must check for chars special only in command line. +1) CAIN A,"= +1) MOVEI A,"_ +1) CAIE A,"_ ; backarrow is filename terminator... +1) CAIN A,", ; as is comma. +1) POPJ P, +1) CAIN A,"! ; For CCL hacking... +1) POPJ P, .SEE RFDRUN +1) ; PUSHJ P,CMDSW ; Check for switches... +1) ; JRST TRFD21 ; got some, process next char (returned by CMDSW) +1) ; Skips if none, drop thru. +1) ; Now see if char signifies start of anything in particular. +1) TRFD22: CAIE A,"< ; Start of directory name? +1) JRST TRFD24 ; No +1) PUSHJ P,RCH +1) PUSHJ P,TRFDW ; Read word, starting with next char +1) TRFD23: CAIN A,". ; Allow . as part of directory name +1) JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word +1) JRST TRFD23] ; And try again +1) MOVEI D,$FDIR ; Set up index. +1) CAIN A,"> ; Terminator should be end of dir name... +1) PUSHJ P,RCH ; If so, get next to avoid scan of ">". +1) ; else bleah, but aren't supposed to fail... +1) TRNN FF,FRFDEV ; Unless a device has been explicitly given, +1) SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. +1) TRO FF,FRFDIR ; Now say dir was explicitly given. +1) JRST TRFD6 ; Go store it. +1) TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? +1) JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, +1) TLNE FF,FL20X ; always if 10X, but if really on 20X, then +1) TRON FF,FRFEXT ; use $FTYPE only if not already seen. +1) JRST TRFD4 ; $FTYPE - jump to get word & store. +1) PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. +1) MOVEM B,$FVERS(F) ; Store it away if successful. +1) JRST TRFD1] ; and go re-read delimiting char. +1) CAIN A,"; ; Start of $FVERS (10x) or attribute? +1) JRST [ PUSHJ P,RCH ; Find what next char is. +1) CAIL A,"a ; Must uppercasify. +1) CAILE A,"z +1) CAIA +1) SUBI A,40 +1) CAIN A,"T ; Temporary file? +1) JRST [ SETOM $FTEMP(C) +1) JRST TRFD2] +1) CAIN A,"A ; Account? +1) JRST [ MOVEI D,$FACCT ; Set index, and +1) JRST TRFD4] ; go gobble following word. +1) CAIN A,"P ; Protection? +1) JRST [ MOVEI D,$FPROT ; Set index, and +1) JRST TRFD4] ; go gobble following word. +1) TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, +1) PUSHJ P,TRFDNM ; trying to parse as number. +1) MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. +1) JRST TRFD1] ; If none of above, ignore ";" entirely. +1) PUSHJ P,TRFDW ; Let's try reading it as word, +1) JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. +1) CAIN A,": ; Else have something, check trailing delim for special cases +1) JRST [ MOVEI D,$FDEV ; Aha, a device. +1) PUSHJ P,RCH ; Flush the terminator & get next char. +1) TRNN FF,FRFDIR ; Unless dir was explicitly given, +1) SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. +1) TRO FF,FRFDEV ; Say device was explicitly given, and +1) JRST TRFD6] ; store name away. +1) MOVEI D,$FNAME ; Else assume it's the filename. +1) JRST TRFD6 +1) TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +1) TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +1) TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! +1) ADDI D,(F) ; Get address (filblk+index), and +1) MOVEM A,(D) ; store string pointer in the appropriate place. +1) TRO FF,FRNNUL ; Say non-null spec seen, +1) JRST TRFD1 ; and go re-read the delimiter, to process it. +1) ; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +1) ; acceptable filename chars into FNBUF, until non-valid char seen. +1) ; A/ First char of word, +1) ; Returns A/ delimiting char, C/ count of chars in string, +1) ; clobbers nothing else. +1) TRFDW4: SUBI A,40 ; Make lowercase +1) TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, +1) PUSHJ P,RCH ; get next char, +1) AOSA C ; and bump count, skipping over zap instruction. +1) TRFDW: SETZ C, ; When called, zero cnt of chars in string. +1) CAIL A,"A ; See if char is uppercase alpha, +1) CAILE A,"Z +1) CAIA +1) JRST TRFDW5 +1) CAIL A,"a ; or lowercase alpha, +1) CAILE A,"z +1) CAIA +1) JRST TRFDW4 +1) CAIL A,"0 ; or numeric, +1) CAILE A,"9 +1) CAIA +1) JRST TRFDW5 +1) CAIE A,"$ ; or dollarsign +1) CAIN A,"- ; or hyphen +1) JRST TRFDW5 +1) CAIN A,"_ ; Backarrow is special case, because +1) JRST [ TRNN FF,FRCMND ; if reading command, +1) TLNN FF,FL20X ; or running on 10X, +1) POPJ P, ; must treat as delimiter. +1) JRST TRFDW5] +1) CAIN A,^V ; ^V is quote char... +1) JRST [ PUSHJ P,RCH ; Quote, get next. +1) CAIE A,^M ; Quote anything but this. +1) CAIN A,0 ; or this. +1) POPJ P, ; time to exit. +1) PUSH P,A ; Quote it! Save char, +1) MOVEI A,^V ; so that a quoter can precede it. +1) IDPB A,FNBWP ; Fortunately this hair +1) POP P,A ; only needs care +1) IDPB A,FNBWP ; for quoted chars, which are +1) JRST TRFDW5] ; rare. +1) TLNE FF,FL20X ; Are we on a 10X? +1) POPJ P, ; If not, anything at this point is delimiter. +1) CAIL A,41 ; Check general bounds +1) CAIL A,137 ; Range from space to _ exclusive. +1) POPJ P, ; If outside that, delimiter. +1) CAIL A,72 ; This range includes :, ;, <, =, > +1) CAILE A,76 +1) CAIA +1) POPJ P, ; delimiter. +1) CAIE A,". +1) CAIN A,", +1) POPJ P, +1) CAIE A,"* +1) CAIN A,"@ +1) POPJ P, +1) ; Finally, check out chars which are acceptable to 10X but which +1) ; might be delimiter in cmd line... +1) TRNN FF,FRCMND +1) JRST TRFDW5 ; Not hacking cmd line, it's an OK char. +1) CAIE A,"/ +1) CAIN A,"( +1) POPJ P, +1) CAIN A,"! +1) POPJ P, +1) JRST TRFDW5 ; at long last done. +1) ; TRFDNM - Read numerical string, halt when non-digit +1) ; seen, leaves result (decimal) in B, with delimiting char in A. +1) ; One peculiarity is skip return if no numerical char is seen at all; +1) ; else doesn't skip and B has a valid number. +1) TRFDNM: PUSHJ P,RCH ; First char needs special check. +1) CAIL A,"0 +1) CAILE A,"9 +1) JRST POPJ1 ; Not a number at all? +1) TDZA B,B +1) TRFDN2: IMULI B,10. +1) ADDI B,-"0(A) ; Convert to number +1) PUSHJ P,RCH ; Get following chars. +1) CAIL A,"0 +1) CAILE A,"9 +1) POPJ P, ; Nope, not digit so treat as delimiter. +1) JRST TRFDN2 ; Yep, a number +1) ;; Extra stuff to support ATSIGN use of MIDAS code +1) .SCALAR LASTCH, RCHBP +1) RCH: TLZE FF,FLUNRD +1) SKIPA A,LASTCH +1) ILDB A,RCHBP +1) CAIN A, +1) MOVEI A,^M +1) MOVEM A,LASTCH +1) POPJ P, +1) GPASST: PUSHJ P,RCH +1) CAIE A,40 +1) CAIN A,^I +1) JRST GPASST +1) POPJ P, +1) ] ;IFN TNXSW +1) SUBTTL TENEX misc. Filename Routines, FS string storage +1) IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! +1) ; To handle filenames of ASCIZ strings instead of SIXBIT words, each +1) ; word has instead a byte pointer to an ASCIZ string. For purposes of +1) ; easy comparison, all of these bp's point into FNBUF, and a routine +1) ; (FNCHK) is provided which checks a just-stored string and returns a bp +1) ; to either this string, if unique, or to a previously stored string if +1) ; it is the same as the one just stored (which is then flushed). Thus +1) ; strings can be compared for equality simply by a comparison of their +1) ; byte pointers. While not necessary, strings are stored beginning on +1) ; word boundaries for easier hacking. +1) ; <# files>**+<# wds for constants> +1) LFNBUF==*5*3+20 ; Enough to hold strings for all output files, +1) ; all translated files, and all .insrt files encountered. +1) ; Later a GC'er can be hacked up so that of the latter only +1) ; enough for the max .insrt level need be allocated. +1) FNBUF: block LFNBUF +1) ; Macro to easily define constant strings for comparison purposes +1) DEFINE DEFSTR *STR* +1) 440700,,%%FNLC +1) %%LSAV==. +1) LOC %%FNLC +1) ASCIZ STR +1) %%FNLC==. +1) LOC %%LSAV +1) TERMIN +1) %%FNLC==FNBUF +1) ] ; IFN TNXSW!!! +1) ; If not assembling for TENEX, the following strings become +1) ; simple SIXBIT values. This makes it possible to write simple +1) ; code to work for both TENEX and non-TENEX without messy conditionals. +1) IFE TNXSW,[EQUALS DEFSTR,SIXBIT] +1) FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +1) FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +1) FSTTY: DEFSTR /TTY/ +1) FSNUL: DEFSTR /NUL/ +1) FSPTP: DEFSTR /PTP/ +1) FSATSN: DEFSTR /@/ +1) FSSBSY: DEFSTR /SUBSYS/ +1) FSPROG: DEFSTR /PROG/ +1) FSMID: DEFSTR /MID/ +1) FSMDAS: DEFSTR /MIDAS/ +1) FSGRTN: DEFSTR />/ +1) FSCRF: DEFSTR /CRF/ +1) FSCREF: DEFSTR /CREF/ +1) FSERR: DEFSTR /ERR/ +1) FSLST: DEFSTR /LST/ +1) FSLIST: DEFSTR /LIST/ +1) FSSAV: DEFSTR /SAV/ +1) FSEXE: DEFSTR /EXE/ +1) IFN TNXSW,[ +1) ;VBLK +1) FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +1) FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +1) FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +1) FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +1) ;PBLK +1) EXPUNG %%FNLC +1) ; NOTE - provided MIDAS never restarts, no initialization is necessary to +1) ; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) +1) ; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +1) ; which will be "canonical" for comparison purposes. +1) ; Clobbers A,B,T,TT,AA +1) ; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. +1) FNCHKZ: MOVE B,FNBWP ; Get write ptr, +1) LDB A,B ; see if last char was 0, +1) JUMPE A,FNCHK0 ; if so can skip one clobberage. +1) SETZ A, +1) IDPB A,B ; zero out bytes, +1) FNCHK0: TLNE B,760000 ; until at end of word. +1) JRST .-2 +1) ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. +1) MOVEM B,FNBWP +1) FNCHK: HRRZ B,FNBWP ; See if write ptr +1) CAML B,FNBEP ; has hit end of FNBUF, and +1) ; ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. +1) .VALUE ; sigh +1) MOVE A,FNBBP ; A - bp to start of existing string +1) MOVE AA,FNBLWP ; AA - bp to start of new string to store +1) FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str +1) MOVEI TT,(AA) ; TT - current addr, new str +1) CAIL T,(TT) ; If addrs are same, or overran somehow, +1) JRST [ MOVE A,AA ; didn't find any match, accept new string. +1) MOVE B,FNBWP +1) MOVEM B,FNBLWP ; Set up new last-write-ptr +1) POPJ P,] +1) FNCHK3: MOVE B,(T) +1) CAMN B,(TT) ; Compare strings, full word swoops. +1) JRST [ TRNE B,377 ; equal, last char zero? +1) AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string +1) ; Found it! Flush just-stored string, don't want duplicate. +1) MOVEM AA,FNBWP ; Clobber write ptr to previous value. +1) POPJ P,] +1) ; Not equal, move to next string to compare +1) MOVEI B,377 ; Check for ASCIZ, +1) TDNE B,(T) ; moving to end of current string +1) AOJA T,.-1 +1) HRRI A,1(T) ; and updating BP to point at new string. +1) JRST FNCHK2 ; (T gets pointed there too at FNCHK2). +1) ; CVSSIX - Converts ASCIZ string to SIXBIT word. +1) ; A/ BP to ASCIZ string, +1) ; Returns SIXBIT word in A. Clobbers nothing else. +1) CVSSIX: PUSH P,B +1) PUSH P,C +1) PUSH P,D +1) MOVE D,A +1) SETZ A, +1) MOVE B,[440600,,A] +1) JRST CVSSX3 +1) CVSSX2: CAIL C,140 +1) SUBI C,40 ; Uppercase force +1) SUBI C,40 ; cvt to 6bit +1) IDPB C,B ; deposit +1) TLNN B,770000 ; If BP at end of word, +1) JRST CVSSX5 ; leave loop. +1) CVSSX3: ILDB C,D +1) JUMPN C,CVSSX2 +1) CVSSX5: POP P,D +1) POP P,C +1) POP P,B +1) POPJ P, +1) ; CVFSIX - Takes current filblk (pointed to by F) and puts the +1) ; right stuff in $F6 entries. +1) CVFSIX: PUSH P,A +1) PUSH P,B +1) MOVSI B,-L$F6BL +1) CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string +1) PUSHJ P,CVSSIX ; Convert to 6bit +1) ADDI B,$F6DEV(F) ; Get index to right place to store. +1) MOVEM A,(B) +1) SUBI B,$F6DEV(F) ; restore aobjn pointer... +1) AOBJN B,CVFSX2 +1) POP P,B +1) POP P,A +1) POPJ P, +1) CVFTAB: $FDEV(F) +1) $FNAME(F) +1) $FEXT(F) +1) $FDIR(F) +1) IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. +1) .END RFDBLK +1) ] ;IFN TNXSW +1) SUBTTL COMMAND LINE SWITCH PARSER +**** FILE DSK:GUEST4;SKEF NEWAT, 44-2 (123727) AFTER CVJFN: +2) SUBTTL COMMAND LINE SWITCH PARSER +*************** + +**** FILE DSK:SYSEN1;@ 695, 57-36 (150988) AFTER FPSFN0: +1) FPSFN3: INSIRP PUSH P,CC CP FPNTBP L R D F B +1) FPSFNP==:.-FPSFN3 +**** FILE DSK:GUEST4;SKEF NEWAT, 52-36 (135982) AFTER FPSFN0: +2) FPSFN3: INSIRP PUSH P,CC CP FPNTBP L R D F +2) FPSFNP==:.-FPSFN3 +*************** + +**** FILE DSK:SYSEN1;@ 695, 57-47 (151442) AFTER FPSFN1: +1) INSIRP POP P,B F D R L FPNTBP CP CC +1) JRST FPSXGP +**** FILE DSK:GUEST4;SKEF NEWAT, 52-47 (136434) AFTER FPSFN1: +2) INSIRP POP P,F D R L FPNTBP CP CC +2) JRST FPSXGP +*************** + +**** FILE DSK:SYSEN1;@ 695, 59-22 (152532) AFTER FPSDE1: +1) CAIN A,'C +1) JRST [ MOVEI A,DEVCGP ;"C" => CGP (Canon ersatz XGP) +1) JRST FPSDV3] +1) ];XGP +**** FILE DSK:GUEST4;SKEF NEWAT, 54-22 (137522) AFTER FPSDE1: +2) ];XGP +*************** + +**** FILE DSK:SYSEN1;@ 695, 59-30 (152709) AFTER FPSDE1: +1) FLORIDA,[CAIN A,'F ; F => FLORIDA +1) jrst [MOVEI A,DEVFLA +1) JRST FPSDV4] +1) ];FLORIDA +1) PRESS,[ CAIE A,'D +**** FILE DSK:GUEST4;SKEF NEWAT, 54-27 (137615) AFTER FPSDE1: +2) VARIFLEX,[CAIN A,'V ; V - Variflex +2) jrst [MOVEI A,DEVVFX +2) JRST FPSDV4] +2) ];VARIFLEX +2) PRESS,[ CAIE A,'D +*************** + +**** FILE DSK:SYSEN1;@ 695, 64-10 (164749) AFTER FPDFN2: +1) MOVE H,CODTYP +1) MOVE H,IPTFN2(H) ;NOITS, DEFAULT FN2 IS APPROPRIATE TO LANGUAGE. +1) ];NOITS +**** FILE DSK:GUEST4;SKEF NEWAT, 59-10 (149657) AFTER FPDFN2: +2) NOTNX,[ MOVE H,CODTYP +2) MOVE H,IPTFN2(H) ;NOITS, DEFAULT FN2 IS APPROPRIATE TO LANGUAGE. +2) ];NOTNX +2) , move b, codtyp ; get cod2n +2) move b, (b) +2) call defext ; default extension of block in a to name in b +2) ];TNX +2) ];NOITS +*************** + +**** FILE DSK:SYSEN1;@ 695, 64-18 (164962) AFTER FPDFN2: +1) MOVEM H,F.IFN2(A) +1) FPDFN3: +1) DOS, HLLZS F.IFN2(A) ;DEFAULTING'S PAST, SO FLUSH THE RH "FOO." USES TO AVOID IT. +1) JRST 2INOPN ;IF IT SKIPS, WE DO TOO! +1) ;DEFAULT DIRECTORY OF LREC FILE. +1) ;NOTE OUTPUT FN2 DEFAULTED IN WLREC. INPUT FN2 DEFAULTED IN RLREC. +**** FILE DSK:GUEST4;SKEF NEWAT, 59-23 (150012) AFTER FPDFN2: +2) NOTNX, MOVEM H,F.IFN2(A) +2) FPDFN3: +2) NOITS, HLLZS F.IFN2(A) ;DEFAULTING'S PAST, SO FLUSH THE RH "FOO." USES TO AVOID IT. +2) JRST 2INOPN ;IF IT SKIPS, WE DO TOO! +2) ;DEFAULT DIRECTORY OF LREC FILE.@*@* +2) ;NOTE OUTPUT FN2 DEFAULTED IN WLREC. INPUT FN2 DEFAULTED IN RLREC. +*************** + +**** FILE DSK:SYSEN1;@ 695, 68-33 (171942) AFTER FPRCHS: +1) ] +1) DOS,[ LSH CH,LGEXTL +**** FILE DSK:GUEST4;SKEF NEWAT, 63-33 (157004) AFTER FPRCHS: +2) ];TNX +2) DOS,[ LSH CH,LGEXTL +*************** + +**** FILE DSK:SYSEN1;@ 695, 70-100 (177986) AFTER FNTCP6: +1) ;COMPUTE PAGEL FROM FONTS AND VSP. +1) ADD C,D ;ASSUME 1ST LINE VSP IS IGNORED, SO RECLAIM IT +1) ADD D,FNTHGT ;FIND TOTAL POI)ER LINE +1) ;;; ADD C,FNTBAS ;WHAT THE FUCK WAS THIS FOR???? +1) IDIV C,D ;FIND # WHOLE LINES THAT̙ FIT +1) MOVEM C,PAGEL +**** FILE DSK:GUEST4;SKEF NEWAT, 65-100 (163052) AFTER FNTCP6: +2) ADD C,D ;COMPUTE PAGEL FROM FONTS AND VSP. +2) ADD D,FNTHGT +2) ADD C,FNTBAS +2) IDIV C,D +2) MOVEM C,PAGEL +*************** + +**** FILE DSK:SYSEN1;@ 695, 72-32 (185721) AFTER RLRR1: +1) PUSHJ P,[ SKIPN F.IFN2(A) +1) JRST RLRRD ;OPEN INPUT LREC FILE WITH RLRRD TO DEFAULT FN2 +**** FILE DSK:GUEST4;SKEF NEWAT, 67-33 (170638) AFTER RLRR1: +2) TNX,[ call getext ; see if this file has an extension +2) call [skipn b +2) jrst rlrrd +2) jrst 2inopn] +2) caia +2) jrst rlrr1a +2) ];TNX +2) NOTNX,[ PUSHJ P,[ SKIPN F.IFN2(A) +2) JRST RLRRD ;OPEN INPUT LREC FILE WITH RLRRD TO DEFAULT FN2 +*************** + +**** FILE DSK:SYSEN1;@ 695, 72-37 (185873) AFTER RLRR1: +1) ITS, .STATUS UTIC,B ;ON ITS, ANY ERROR OTHER THAN "FILE NOT FOUND" +1) ITS, LDB B,[220600,,B] ;MEANS WE WOULD PROBABLY BE UNABLE TO CREATE THE LREC FILE, +1) ITS, pdAB,%ENq ;SO WE SHO" ΓfYACOMPLAIN. +1) ITS, JRST RLRR1E +1) MOVE R,SFILE ;CAN'T FIND THE INPUT LREC FILE!! WAS IT THE ONLY FILE SPEC'D? +**** FILE DSK:GUEST4;SKEF NEWAT, 67-45 (170932) AFTER RLRR1: +2) ITS,[ .STATUS UTIC,B ;ON ITS, ANY ERROR OTHER THAN "FILE NOT FOUND" +2) LDB B,[220600,,B] ;MEANS WE WOULD PROBABLY BE UNABLE TO CREATE THE LREC FILE, +2) CAIE B,%ENSFL ;SO WE SHOULD DEFINITELY COMPLAIN. +2) JRST RLRR1E +2) ];ITS +2) MOVE R,SFILE ;CAN'T FIND THE INPUT LREC FILE!! WAS IT THE ONLY FILE SPEC'D? +*************** + +**** FILE DSK:SYSEN1;@ 695, 72-49 (186599) AFTER RLRR1E: +1) RLRR1B: STRT [ASCIZ /(LREC file new - listing all files in full) +1) /] +1) POPJ P, +**** FILE DSK:GUEST4;SKEF NEWAT, 67-57 (171652) AFTER RLRR1E: +2) ];NOTNX +2) RLRR1B: STRT [ASCIZ /(LREC file new - listing all files in full) +2) /] ; @@@@ make this work +2) POPJ P, +*************** + +**** FILE DSK:SYSEN1;@ 695, 72-62 (186971) AFTER RLRR1C: +1) RLRRD: MOVE CH,LRCFN2 ;FIRST TRY "LREC" OR "LRC" AS FN2. +**** FILE DSK:GUEST4;SKEF NEWAT, 67-72 (172060) AFTER RLRR1C: +2) TNX,[ +2) rlrrd: push p, f.isnm(a) ; save pointer to file name +2) move8 rcfn2 ; while we munPoce... +2) call defext +2) call 2inopn ; try to open with first try at extension +2) jrst rlrrd1 +2) pop p, ch ; throw away old file name pointer +2) move ch, f.isnm(a) ; copy into output file name +2) movem ch, f.osnm(a) +2) jrst popj1 +2) rlrrd1: pop p, f.isnm(a) ; restore the unmunged file name +2) move b, alrfn2 ; munge again with alternate extension +2) call defext +2) call 2inopn +2) jfcl ; this is our last chance +2) move ch, f.isnm(a) h1y into output file name +2) movem ch, f.osnm(a) +2) dropthruto popj1 +2) ];TNX +2) NOTNX,[ +2) RLRRD: MOVE CH,LRCFN2 ;FIRST TRY "LREC" OR "LRC" AS FN2. +*************** + +**** FILE DSK:SYSEN1;@ 695, 72-72 (187224) AFTER RLRRD1: +1) POPJ1: AOSA (P) +**** FILE DSK:GUEST4;SKEF NEWAT, 67-103 (172924) AFTER RLRRD1: +2) ];NOTNX +2) POPJ1: AOSA (P) +*************** + +**** FILE DSK:SYSEN1;@ 695, 73-23 (187753) AFTER RLRR1A: +1) CAMN R,[SIXBIT/LREC/+1] ;THIS IS WHAT IT SHOULD BE. +1) JRST RLRR2 ;FILE LOOKS LIKE LREC FILE. +**** FILE DSK:GUEST4;SKEF NEWAT, 68-23 (173464) AFTER RLRR1A: +2) TNX,[ camn r, [sixbit /LREC/ + 2] ; this is what i9uld be for new lrec +2) jrst rlrr2 +2) came r, [sixbit /LREC/ + 1] ; might be old format +2) jrst rlrr1y ; nope, just a losing file +2) flosei flsnnl, 0(a) ; "File is old format LREC file." +2) jrst rlrr1z ; he wants to press on anyway... +2) ];TNX +2) NOTNX,[ CAMN R,[SIXBIT/LREC/+1] ;THIS IS WHAT IT SHOULD BE. +2) JRST RLRR2 ;FILE ˧$ˋ LREC FILE. +*************** + +**** FILE DSK:SYSEN1;@ 695, 73-27 (187961) AFTER RLRR1A: +1) FLOSEI FLSNLR,F.ISNM(A) ;"FILE IS NOT AN LREC FILE". +1) JFCL [ PUSH DP,R ;BUT USER INSISTS? OK, ASSUME IT IS ONE +1) JRST RLRR2] +**** FILE DSK:GUEST4;SKEF NEWAT, 68-34 (173979) AFTER RLRR1A: +2) ];NOTNX +2) rlrr1y: FLOSEI FLSNLR,F.ISNM(A) ;"FILE IS NOT AN LREC FILE". +2) rlrr1z: JFCL [ PUSH DP,R ;BUT USER INSISTS? OK, ASSUME IT IS ONE +2) JRST RLRR2] +*************** + +**** FILE DSK:SYSEN1;@ 695, 73-76 (189630) AFTER S)R3: +1) RLRRE: HRLZI D,(C) ;COME HERE FOR EACH ENTRY IN FILE. C -> ENTRY. +1) HRRI D,INSSNM +**** FILE DSK:GUEST4;SKEF NEWAT, 68-84 (175671) AFTER RLRRL3: +2) RLRRE: hlrz d,(c) ;COME HERE FOR EACH ENTRY IN FILE. C -> ENTRY. +2) TNX,[ hrr c ; build byte pointer for TNX long file name +2) hrli d, 440700 +2) movem d, inssnm ; store as input file name +2) skipe (c) ; move ahead until 0 word +2) aobjn c, .-1 +2) push p, [0] ; save specified fn2 +2) add c, [1,,1] ; move to subentries +2) ];TNX +2) NOTNX,[ HRLZI D,(C) +2) HRRI D,INSSNM +*************** + +**** FILE DSK:SYSEN1;@ 695, 73-82 (189902) AFTER RLRRE: +1) PUSHH(,S ;NOW SKIP OVER SUBE)IkPOCESS3AVED SWITCHES, ETC. +**** FILE DSK:GUEST4;SKEF NEWAT, 68-101 (176224) AFTER RLRRE: +2) ];NOTNX +2) PUSHJ P,RLRRS ;NOW SKIP OVER SUBENTRIES, PROCESSING SAVED SWITCHES, ETC. +*************** + +**** FILE DSK:SYSEN1;@ 695, 76-16 (196657) AFTER MLREC1: +1) ADD B,[4,,4] ;ADVANCE PAST FILENAMES AT BEGINNING OF ENTRY. +1) ;ADVANCE PAST THE NEXT SUBENTRY. +**** FILE DSK:GUEST4;SKEF NEWAT, 71-16 (182990) AFTER MLREC1: +2) TNX,[ skipe (b) ; move ahead until 0 word +2) aobjn b,.-1 +2) add b,[1,,1] ; mov:oA}qe +2) ];TNX +2) NOTNX`ĉ[i,,4] .ĭANCE PAST FILENAMES 5BGINNING OF ENTRY. +2) ;ADVANCE PAST THE NEXT SUBENTRY. +*************** + +**** FILE DSK:SYSEN1;@ 695, 77-31 (199464) AFTER XLREC2: +1) WLRDF: SKIPE A,WLRECP +**** FILE DSK:GUEST4;SKEF NEWAT, 72-31 (185905) AFTER XLREC2: +2) TNX,[ +2) wlrdf: skipn a, wlrecp +2) ret +2) call getext ; get extension for file in a +2) skipq ; if b = 0, no :ezwAgiven +2) (9e ; otherwise there was one +2) move b, lrcfn2 ; just grab default extension +2) jrst defext ; cons up name with extension & return +2) ];TNX +2) NOTNX,[ +2) WLRDF: SKIPE A,WLRECP +*************** + +**** FILE DSK:SYSEN1;@ 695, 78-2 (200251) AFTER WLREC3: +1) SUBTTL LREC DUMPING ROUTINES ( EBUGGING) +**** FILE DSK:GUEST4;SKEF NEWAT, 72-67 (186969) AFTER WLREC3: +2) ];NOTNX +2) SUBTTL LREC DUMPING ROUTINES (FOR DEBUGGING) +*************** + +**** FILE DSK:SYSEN1;@ 695, 82-42 (208231) AFTER WLREC: +1) WLRWWD B,[SIXBIT/LREC/+1] ;1ST WORD OF LREC FILE IS SIXBIT/LREC/+1 +1) MOVEI A,FILES ;LOOK AT ALL FILES, +**** FILE DSK:GUEST4;SKEF NEWAT, 77-42 (194961) AFTER WLREC: +2) TNX, wlrwwd b,[sixbit /LREC/ + 2] ; 1st word is sixbit /LREC/ + 2 for TNX +2) NOTNX, WLRWWD B,[SIXBIT/LREC/+1] ;1ST WORD OF LREC FILE IS SIXBIT/LREC/+1 +2) 3g֋( 3" ;LOA ALL FILES, +*************** + +**** FILE DSK:SYSEN1;@ 695, 84-50 (212474) AFTER WLRW: +1) WLRWWD B +1) NOCMU,[ ;UNDER CMU, USE THE SPECIFIED DEVICE, NTE REAL DEVICE +**** FILE DSK:GUEST4;SKEF NEWAT, 79-50 (199285) AFTER WLRW: +2) TNX,[ hrrz b, b ; address of file block pointer +2) hrrz b, (b) ; address of file block +2) hrrz b, (b) ; address of filename string +2) push p,l ? push p,r ; save good old l & r +2) wlrwn0: move l,(b) ; get the word +2) wlrwwd l ; write it out +2) aos b +2) ldb r, [350700,,l] ; see if first byte was 0 +2) jumpe r, wlrwn1 ; finish up if so +2) ldb r, [260700,,l] ; how about 2nd? +2) jumpe r, wlrwn1 +2) ldb r, [170700,,l] ; etc. +2) jumpy,A9w1 +2) ldb r, [100700,,l] +2) :e r, wlrwn1 +2) ldb r, [010700,,l] +2) jumpe r, wlrwn1 +2) jrst wlrwn0 ; go for next word of file name +2) wlrwn1: setz l, ; write out a zero word +2) wlrwwd l +2) pop p,r ? pop 6 wood old r & l +2) jrst wlrwss ; go down to switch setting writing outing ing +2) ];TNX +2) NOTNX, WLRWWD B +2) NOCMU,[ ;UNDER CMU, USE THE SPECIFIED DEVICE, NOT THE REAL DEVICE +*************** + +**** FILE DSK:SYSEN1;@ 695, 84-65 (212813) AFTER WLRW: +1) WLRWWI R,LR.PSW ;SAVE ALL SWITCH SETTINGS. +1) WLRWPLY-14. .ֱi$AL.H. +**** FILE DSK:GUEST4;SKEF NEWAT, 79-88 (200355) AFTER wlrwn1: +2) WLRWSS: WLRWWI R,LR.PSW ;SAVE ALL SWITCH SETTINGS. +2) WLRWWI L,-14. ;-14. IN L.H. +*************** + +**** FILE DSK:SYSEN1;@ 695, 86-24 (216834) AFTER CPRF: +1) JRST [ CAIE D,DEVIXG ;IT PROBABLY CONTAINS XGP COMMANDS WHOSE LOSS WOULD SCREW. +1) CAIN D,DEVCGP +1) SETZM (B) +1) JRST .+1] +1) ];ITSXGP +**** FILE DSK:GUEST4;SKEF NEWAT, 81-24 (204383) AFTER CPRF: +2) CAIE D,DEVIXG ;IT PROBABLY CONTAINS XGP COMMANDS WHOSE LOSS WOULD SCREW. +2) CAIA +2) SETZM (B) +2) ];ITSXGP +*************** + +**** FILE DSK:SYSEN1;@ 695, 143-14 (316870) AFTER 2OCLS: +1) ; This is also set up to do the same for the Florida Data Systems OSP-130 +1) |, +**** FILE DSK:GUEST4;SKEF NEWAT, 138-14 (304391) AFTER 2OCLS: +2) ; This is also set up to do the same for the Sanders S700 Variflex +2) NoAnadex,[ +*************** + +**** FILE DSK:SYSEN1;@ 695, 143-19 (317052) AFTER 2OCLS: +1) IFN ANAFLG!FLAFLG,[ +1) MOVE B,DEVICE +**** FILE DSK:GUEST4;SKEF NEWAT, 138-19 (304566) AFTER 2OCLS: +2) IFN ANAFLG!VFXFLG,[ +2) MOVE B,DEVICE +*************** + +**** FILE DSK:SYSEN1;@ 695, 143-24 (317165) AFTER 2OCLS: +1) CAIN B,DEVFLA ; skip if not Florida OSP-130 +1) pushj p,CRLOUT +**** FILE DSK:GUEST4;SKEF NEWAT, 138-24 (304679) AFTER 2OCLS: +2) CAIN B,DEVVFX ; skip if not Sanders Variflex +2) pushj p,CRLOUT +*************** + +**** FILE DSK:SYSEN1;@ 695, 144-61 (319863) AFTER DEVPDO: +1) DEVANA:: 0 +1) DEVCGP:: 0 +1) DEVFLA:: 0 +1) DEVMAX::OFFSET 0 +1) ];ITS +1) CMU, 2QUEUE: POPJ P, +1) T10, 2QUEUE: POPJ P, +**** FILE DSK:GUEST4;SKEF NEWAT, 139-61 (307378) AFTER DEVPDO: +2) DEVANA:: 0 +2) DEVVFX:: 0 +2) DEVMAX::OFFSET 0 +2) ];ITS +2) ;CMU, 2QUEUE: POPJ P, ; screwing assembly with SITE==CMU20FLG! +2) T10, 2QUEUE: POPJ P, +*************** + +**** FILE DSK:SYSEN1;@ 695, 145-43 (321133) AFTER DEVPDO: +1) DEVANA:: 0 +1) DEVCGP:: 0 +1) DEVFLA:: 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 140-43 (308681) AFTER DEVPDO: +2) DEVANA:: 0 +2) DEVFLA:: 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 147-6 (323316) AFTER 2LOOPD: +1) REPEAT 4,[ +**** FILE DSK:GUEST4;SKEF NEWAT, 142-6 (310853) AFTER 2LOOPD: +2) TNX,[ skipn b, outfil ; skip if outfil was given +2) jrst 2loopo +2) movem b, f.osnm(a) ; make that the filename here +2) jrst 2loopz ; go and open it up +2) 2loopo: push p, a ; save a +2) skipe a, ofile ; close output file if one is open +2) call 2oclsq +2) move a, (p) ; look at file block again +2) move b, f.isnm(a) ; get input name +2) movem b, f.osnm(a) ; copy to output name +2) movei a, f.osnm(a) ; move to output filename +2) skipe b, fntspc ; grab default extension in b +2) skipl b, device +2) cail b, devmax +2) .value +2) move b, optfn2(b) +2) call defext ; defaultify extension of output name +2) ;w a, ( +Dw restore pointer to 7 fileok +2) movem a, ofile +2) 2loopz: +2) ];TNX +2) NOTNX,[ +2) REPEAT 4,[ +*************** + +**** FILE DSK:SYSEN1;@ 695, 147-48 (324663) AFTER 2LOOPO: +1) ITS, MOVE H,[SIXBIT/OUTPUT/] +**** FILE DSK:GUEST4;SKEF NEWAT, 142-70 (312887) AFTER 2LOOPO: +2) ];NOTNX +2) ITS, MOVE H,[SIXBIT/OUTPUT/] +*************** + +**** FILE DSK:SYSEN1;@ 695, 147-69 (325124) AFTER DEVANA: +1) DEVCGP::2FNTIX ; Like ITS XGP +1) DEVFLA::FLAINI +1) DEVMAX::OFFSET 0 +**** FILE DSK:GUEST4;SKEF NEWAT, 142-92 (313357) AFTER DEVANA: +2) DEVVFX::VFXINI +2) DEVMAX::OFFSET 0 +*************** + +**** FILE DSK:SYSEN1;@ 695, 152-2 (329558) AFTER ADAINI: +1) SUBTTL Assorted Florida Data OSP-130 code +1) NOFLORbAYFLAINI==:CPOPJ +1) FLORIDA,[ +1) FLAINI: +1) POPJ P, +1) ];FLORIDA +1) SUBTTL PASS 2 INPUT FILE OPEN ROUTINES +**** FILE DSK:GUEST4;SKEF NEWAT, 147-1 (317757) AFTER ADAINI: +2) SUBTTL Assorted Sanders Variflex +2) NOVARIFLEX,FLAINI==:CPOPJ +2) VARIFLEX,[ +2) VFXINI: +2) ; first of all, compute number of lines per page and establish all the +2) ; vertical formatting parameters +2) move A,PGLDOT+DEVVFX ; get paper height +2) movei B,[ASCIZ /FL/] +2) pushj P,RCLNUM ; output numeric RCL +2) movei B,[ASCIZ /VMON/] +2) pushj P,OUTRCL ; turn on vertical forms control +2) move B,MARG.T ; get top marg in mils +2) imul B,DOTPIV+DEVVFX ; compute in 1K VEPs +2) addi B,500. ; round +2) idivi B,1000. ; convert to VEPs +2) push P,A +2) push P,B +2) move A,B ; send it out +2) movei B,[ASCIZ /TM/] +2) pushj P,RCLNUM +2) pop P,B +2) pop P,A +2) sub A,B ; deduct top margin +2) move B,MARG.B ; get bottom margin in mils +2) imul B,DOTPIV+DEVVFX ; compute in 2VPs +2) addi B,500. ; round +2) idivi B,1000. ; convert to VEPs +2) push P,A +2) push P,B +2) move A,B +2) movei B,[ASCIZ /BM/] +2) pushj P,RCLNUM +2) pop P,B +2) pop P,A +2) sub A,B ; deduct b:opin +2) idivi A,48. ; divide by Veps/Line +2) skipn EPAGEL ; did user give explicit page length? +2) movem A,PAGEL ; no, store this value +2) ; Now output the horizontal parameters, and update the LNL parameter +2) +2) move A,LNLDOT+DEVVFX ; get paper width +2) movei B,[ASCIZ /FW/] +2) pushj P,RCLNUM ; output numeric RCL +2) move B,MARG.L ; get left marg in mils +2) add B,MARG.H ; add hole margin in mils +2) imul B,DOTPIH+kVX ; compute in 1K HEPs +2) addi B,500. ; round +2) idivi B,1000. ; convert to HEPs +2) push P,A +2) push P,B +2) move A,B ; send it out +2) movei B,[ASCIZ /LM/] +2) pushj P,RCLNUM +2) pop P,B +2) pop P,A +2) <A,B ; deduct left margin +2) ;w0MRG.R ; get right marw n mils +2) imul B,DOTPIH+DEVVFX ; compute in 1K HEPs +2) addi B,500. ; round +2) idivi B,1000. ; convert to HEPs +2) push P,A +2) push P,B +2) move A,B +2) movei B,[ASCIZ /RM/] +2) pushj P,Rs'U +2) pop P,B +2) pop P,A +2) sub A,B ; deduct right margin +2) imuli A,16. ; multiply by Chars/In (Using GOUS1617) +2) idiv A,DOTPIH+DEVVFX ; divide by Heps/In +2) skipn ELINEL ; did user give /W? +2) movem A,LINEL .n9re as chars/line +2) ; now, finally select the font +2) movei B,[ASCIZ /AF0,GOUS1617/] +2) pushj P,outRCL +2) movei B,[ASCIZ /SF0/] +2) pushj P,outRCL +2) pushj P,2INIT ; re-initialize pass 2 values! +2) 4'Е P, +2) ; OUTRCL --- write an unparamterized RCL command +2) ; B - pointer to ASCIZ string +2) hA- preserved +2) OUTRCL: push P,A +2) push P,B +2) 2patCH "! +2) pop P,B +2) pushj P,ASCRCL +2) 2patCH "! +2) pop P,A +2) popj P, +2) ; RCLNUM --- write an RCLand with a numeric argument +2) ; B - pointer to ASCIZ string +2) ; A - numeric value +2) ; -9eerved +2) RCLNUM: push P,A +2) push P,B +2) 2patCH "! +2) pop P,B +2) pushj P,ASCRCL +2) move A,(P) +2) pushj P,000X ; write out number +2) 2patCH "! +2) pop P,A +2) popj P, +2) ];VARIFLEX +2) SUBTTL PASS 2 INPUT FILE OPEN ROUTINES +*************** + +**** FILE DSK:SYSEN1;@ 695, 154-9 (332027) AFTER 2RDAHD: +1) TF6TOA: PUSH P,B +1) MOVE B,[440700*FLNM] +1) SETZM TFILNM ; Ensure string initially empty +1) CALL TF6TOB +**** FILE DSK:GUEST4;SKEF NEWAT, 149-9 (322792) AFTER 2RDAHD: +2) ; If the left hand side of the SNAME is -1, the right hand side is the address +2) ; of a long file name. In this case, we just copy the string into TFILNM and +2) ; everyone should be happy. +2) TF6TOA: PUSH P,B +2) hlrz b,(a) ; check SNAME +2) 8 b,440700;real quick hack for testing... would be W.] +2) jrst tf6to0 +2) push p,a ; copy long file name into TFILNM +2) push p,c +2) hrrz a,(a) +2) hrli a,440700 +2) move b,[440700,,tfilnm] +2) ildb c,a +2) idpb c,b +2) jumpn c,.-2 +2) pop p,c +2) pop p,a +2) pop p,b +2) ret +2) tf6to0: STRT [asciz /Old format file block encountered. TNX @ Bug./] +2) MOVE B,[440700,,TFILNM] +2) push p,B ; insure string is initially empty because +2) ; of various problems with non-robust code +2) ; around JSYSes +2) setz B, +2) IDPB B,(P) +2) pop P,B +2) MOVE B,[440700,,TFILNM] +2) CALL TF6TOB +*************** + +**** FILE DSK:SYSEN1;@ 695, 154-30 (332475) AFTER TF6TOB: +1) 10X, MOVEI C,"< ? IDPB C,A +1) MOVE C,A ; Preserve byte pointer in case of failure +1) DIRST ; T20 adds punctuation by itself. +1) ERCAL [MOVE A,C ; If fail, restore old byte pointer +1) POPJ P,] +1) 10X, MOVEI C,"> ? IDPB C,A +1) JRS+c] +**** FILE DSK:GUEST4;SKEF NEWAT, 149-56 (323925) AFTER TF6TOB: +2) 10X, MOVEI C,"< +2) 10X, IDPB C,A +2) move C,A ; preserve byte pointer +2) "bIuw T20 adds punctuatio1yA=9f. +2) ercal [ move A,C ; if fail, restore old byte pointer +2) popj P,] +2) ; ...otherwise, DIRST has updated the pointer +2) ,,,3g֋I C,"> +2) 10X, IDPB C,A +2) JRST .+1] +*************** + +**** FILE DSK:SYSEN1;@ 695, 154-74 (333357) AFTER LBPAS1: +1) ];TNX +**** FILE DSK:GUEST4;SKEF NEWAT, 149-105 (324864) AFTER LBPAS1: +2) ;;; DefExt defaults the extension of a file name i:h file bloch8onted to +2) ;;; by A to the string pointed to by B. +2) defext: push p,c ? push p,d ? push p,h ; save these things +2) push p, b ; save b on top +2) move b, 0(a) ; copy file name +2) move h, namnxt +2) hrli h, 440700 +2) movem h, 0(a) ; replace file name with the one we're making +2) defex1: ildb c, b +2) jumpe c, se2 ; end of file 1 if end of string +2) cain c, ". ; or we hit a dot +2) jrst defex2 +2) idpb c, h +2) hrrz d, h ; see if we've run out of filename space +2) caige d, namend +2) jrst defex1 ; if not, keep looping +2) jrst fnsgon ; all gone +2) defex2: movei c, ". ; throw a dot down +2) idpb c, h +2) pop p, b ; get extn +2) defex3: ildb c, b +2) idpb c, h +2) jumpe c, defex4 +2) hrrz d, h ; see if we've run out of filename space +2) caige d, namend +2) jrst defex3 ; nah, keep copying +2) jrst fnsgon ; all gone +2) defex4: aos h ; save new next filename pointer +2) hrrm h, namnxt +2) pop p,h ? pop p,d ? pop p,c +2) ret +2) ;;; GetExt returns a7ter to the file's extensii r zero. +2) getext: push p,c ? push p,d ; save c & d +2) move c, 0(a) ; get pointer to filename +2) getex1: ildb d, c +2) jumpe d, getex2 ; return zero if end of string +2) caie d, ". ; return pointer if we've hit a dot +2) jrst getex1 ; else keep on looping +2) move b, c +2) pop p,d ? pop p,c ; restore c & d +2) ret +2) getexNp p,d ? pop p,c ; re}7 c & d +2) setz b, +2) ret +2) ;;; FNSGon tells the luser that we're out of filename space, and dies. +2) fnsgon: STRT [ASCIZ /Out of filename space! +2) /] +2) jrst errdie +2) ];TNX +*************** + +**** FILE DSK:SYSEN1;@ 695, 162-71 (349333) AFTER PRSD4: +1) CAIL L,EFILES ;PRESS FILE HEADER PAGE. +1) JRST PRSD5 +1) MOVE CH,F.OFN1(L) ;BUT, IF THIS OUTPUT FILE CORRESPONDS TO AN INPUT FILE +1) CAMN CH,F.RFN1(L) ;WHICH HAS THE SAME FN1 AS THE OUTPUT FILE, +**** FILE DSK:GUEST4;SKEF NEWAT, 157-71 (342393) AFTER PRSD4: +2) TNX, NOP +2) NOTNX,[ CAIL L,EFILES ;PRESS FILE HEADER PAGE. +2) JRST PRSD5 +2) ];NOTNX +2) TNX,[ move b, f.osnm(l) ; pointer to file name +2) call ascout ; shove it out +2) N +2) NOTNX͟PC,F.OFN1(L) ;BUT$ATHIS jPT FILE CORQiПNDS TO AN 3Ű +2) CAMN CH,FԣNc(L) ;$Ñ ATHE SAME FN1 AS$EAjP#IE, +*************** + +**** FILE DSK:SYSEN1;@ 695, 162-78 (349705) AFTER PRSD5: +1) POP P,A +**** FILE DSK:GUEST4;SKEF NEWAT, 157-83 (342884) AFTER PRSD5: +2) ];NOTNX +2) POP P,A +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-26 (387191) AFTER SLURP3: +1) IFN ANAFLG!FLAFLG,[ +1) SLGLEQ: PUSH P,B .SEE 2MXCRF ; to understand PUSH +**** FILE DSK:GUEST4;SKEF NEWAT, 176-25 (380377) AFTER SLURP3: +2) IFN ANAFLG!VFXFLG,[ +2) SLGLEQ: PUSH P,B .SEE 2MXCRF h:oAe}0*ӑ +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-48 (387767) AFTER SLGNC1: +1) FLORIDA,[ +1) CAIE B,DEVFLA ; skip if OSP-130 +1) JRST SLGNC2 .se if some 4e type, or done +**** FILE DSK:GUEST4;SKEF NEWAT, 176-47 (380953) AFTER SLGNC1: +2) VARIFLEX,[ +2) CAIE B,DEVVFX ; skip if Sanders S700 +2) JRST SLGNC2 ; see if some other type, or done +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-53 (387917) AFTER SLGNC1: +1) MOVEI CH,33 ; underline on +1) 2PUTCH +1) MOVEI CH,'E ; E +1) 2PUTCH +1) MOVE CH,0(P) ; get input char back +**** FILE DSK:GUEST4;SKEF NEWAT, 176-52 (381109) AFTER SLGNC1: +2) movei B,[ASCIZ /BU/] +2) pushj P,OutRCL +2) MOVE CH,0(P) ; get input char back +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-62 (388148) AFTER SLGNC1: +1) MOVEI CH,33 ; underline off +1) 2PUTCH +1) MOVEI CH,'R +1) 2PUTCH +1) POP P,CH ; return original +**** FILE DSK:GUEST4;SKEF NEWAT, 176-59 (381308) AFTER SLGNC1: +2) movei B,[ASCIZ /EU/] +2) pushj P,OutRCL +2) 4' ! ; return nal +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-72 (388364) AFTER SLGNC2: +1) ]; ANADEX!FLORIDA +1) SLLF: TRZE F,FRLCR +**** FILE DSK:GUEST4;SKEF NEWAT, 176-67 (381501) AFTER SLGNC2: +2) ]; ANADEX!VARIFLEX +2) SLLF: TRZE F,FRLCR +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-118 (389550) AFTER SLTAB: +1) FLORIDA,[ +1) PUSH P,B +1) MOVE B,DEVICE +1) CAIN B,DEVFLA ; skip if not florida OSP-130 +1) JRST [POP P,B +**** FILE DSK:GUEST4;SKEF NEWAT, 176-113 (382688) AFTER SLTAB: +2) VARIFLEX,[ +2) PUSH P,B +2) MOVE B,DEVICE +2) CAIN B,DEVVFX ; skip if not Sanders S700 +2) JRST [POP P,B +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-125 (389683) AFTER SLTAB: +1) ]; FLORIDA +1) TLNE F,FLXGP ;IN XGP LISTINGS, MUST CONVERT TABS TO SPACES +**** FILE DSK:GUEST4;SKEF NEWAT, 176-120 (382819) AFTER SLTAB: +2) ]; VARIFLEX +2) TLNE F,FLXGP ;IN XGP LISTINGS, MUST CONVERT TABS TO SPACES +*************** + +**** FILE DSK:SYSEN1;@ 695, 181-153 (390317) AFTER SLURP4: +1) 2PUTCH "$ +**** FILE DSK:GUEST4;SKEF NEWAT, 176-148 (383454) AFTER SLURP4: +2) VARIFLEX,[ +2) 3g֋ B,DEVICE +2) CAIE B,DEVVFX +2) jrst SLURP5 +2) 2PUTCH "= +2) movei B,[ASCIZ /NE/] +2) pushj P,outRCL +2) 2PATCH "/ +2) jrst SLALT1 +2) SLURP5: +2) ];VARIFLEX +2) 2PUTCH "$ +*************** + +**** FILE DSK:SYSEN1;@ 695, 182-2 (390437) AFTER ANADEX,SLA +1) SLTBL: JRST SLNUL ;^@ +**** FILE DSK:GUEST4;SKEF NEWAT, 176-164 (383733) AFTER ANADEX,SLA +2) SLVFX: +2) VARIFl, +2) move B,DEVICE +2) caie B,DEVVFX +2) jrst SLURP1 ; nothing special if not Variflex +2) movei B,[ASCIZ /IC/] +2) pushj P,OutRCL ; insert it +2) ];VARIFLEX +2) NOVARIFLEX,[ +2) 2PUTCH "! +2) ];NOVARIFLEX +2) movei CH,'! +2) aoja0QH) +2) SLTBL: JRST SLNUL ;^@ +*************** + +**** FILE DSK:SYSEN1;@ 695, 182-14 (390705) AFTER SLTBL: +1) IFE ANAFLG!FLAFLG,[ +1) REPEAT 4, JRST SLCTL ;^\-^_ +1) ];ANAFLG!FLAFLG +1) IFN ANAFLG!FLAFLG,[ +1) JRST SLGLEQ ;^\ - leq [ +**** FILE DSK:GUEST4;SKEF NEWAT, 177-14 (384238) AFTER SLTBL: +2) IFE ANAFLG!VFXFLG,[ +2) REPEAT 4, JRST SLCTL ;^\-^_ +2) ];ANAFLG!VFXFLG +2) IFN ANAFLG!VFXFLG,[ +2) JRST SLGLEQ ;^\ - leq [ +*************** + +**** FILE DSK:SYSEN1;@ 695, 182-21 (390878) AFTER SLTBL: +1) ];IFN ANAFLG!FLAFLG +1) TRO F,FRLTAB ;SPACE +1) REPEAT 14., TRZ F,FRLTAB ;! " # $ % & ' ( ) * + , - . +1) JRST SLSLSH ;/ +**** FILE DSK:GUEST4;SKEF NEWAT, 177-21 (384411) AFTER s*B: +2) ];IFN ANAFLG!VFXFLG +2) TROFLTAB ;SPACE +2) IFE VFXFLG,[ +2) TRZ F,FRLTAB ;! +2) ] +2) IFN VFXFLG,[ +2) jrst SLVw! +2) ] +2) REPEAT 13., TRZ F,FRLTAB ;" # $ % & ' ( ) * + , - . +2) JRST SLSLSH ;/ +*************** + +**** FILE DSK:SYSEN1;@ 695, 196-26 (411285) AFTER SIXOUT: +1) ;OUTPUT ASCIZ STRING POINTED TO BY ADDRESS IN B. +**** FILE DSK:GUEST4;SKEF NEWAT, 191-26 (404888) AFTER SIXOUT: +2) VARIFLEX,[ +2) ; OUTPUT ASCIZ STRING POINTED TO BY ADDRESS IN B. +2) ; DOEh'OhDTE CC OR O+P] CRLF'S M6PB INCLUDED. +2) ; +2) ASCRCL: HRLI B,440700 +2) ASCRC1: ILDB CH,B +2) JUMPE CH,CPOPJ +2) 2PATCH +2) jrst ASCRC1 +2) ]; VARIFLEX +2) ;OUTPUT ASCIZ STRING POINTED TO BY ADDRESS IN B. +*************** + +**** FILE DSK:SYSEN1;@ 695, 197-53 (414120) AFTER FILOU2: +1) MOVE CH,A ; Save BP in case of error +1) DIRST ; Dir # is in B +1) ERCAL [MOVE A,CH ; Error, restore BP +1) POPJ P,] +1) ,,,MOVEI CH,"! H,A +**** FILE DSK:GUEST4;SKEF NEWAT, 192-53 (407943) AFTER FILOU2: +2) move ch,A +2) DIRST ; Dir # is in B +2) ercal [move A,CH ; in case of error, A was destroyed +2) popj P,] +2) 10X, MOVEI CH,"> ? IDPB CH,A +*************** + +**** FILE DSK:SYSEN1;@ 695, 197-157 (416219) AFTER ITS,FNTOUT +1) NOITS,[ +1) IFN <.SITE 0,>-,FNTOUT==:FILOUT +1) .ELSE [ +1) ;Print an ITS-style file name on a non-ITS system (for XGP purposes). +1) ; Assumes directory is FONTS. MIT-XX +1) ;is the onPmz44a shouue this, mo}lkely. +**** FILE DSK:GUEST4;SKEF NEWAT, 192-157 (410032) AFTER ITS,FNTOUT +2) SAI,FNTOUT==:FILOUT +2) NOITS,[ +2) NOSAI,[ +2) ;Print an ITS-style file name on a non-ITS system (for XGP purposes). +2) pl onlyh3oY and ")? + JRST 1ULOSE ;NO--COMPLAIN ABOUT A MISMATCH + MOVEI A,U%FORM ;TELL THE NEXT HIGHER LEVEL WHAT WE WERE. + POPJ P, ;AND RETURN + + +;-------------------------------------------------------- +; PARSE AN ATOM +; +; RETURNS: +; A/ U%ATOM (TYPE) +; B/ # OF CHARS IN THE PNAME +; SYLBUF et seq/ PNAME (IN ASCII) +; +;-------------------------------------------------------- + +1UBKSL: MOVE CP,[440700,,SYLBUF] ;"\"-QUOTED CHARS ALSO START ATOMS. + XCT UPATOM ; PERFORM PARSING EXIT ROUTINE +1UATM4: 1GETCH + CAIN CH,^M ;IF IT'S A CR, GO DO CR HANDLING. + PUSHJ P,1UCR2 ; AND PROCEED. + CAIN CH,^L ;IF IT'S A FORM-FEED, MOVE TO NEXT PAGE ALWAYS. + PUSHJ P,1UFF2 ; (HANDLE THE FORM-FEED AND COME BACK HERE.) + JRST 1UATM2 ; SKIP ATOM-INIT CODE + + +1UATOM: MOVE CP,[440700,,SYLBUF] ;BYTE PTR TO ATOM BUFFER + XCT UPATOM ;PERFORM PARSING EXIT ROUTINE + +1UATM2: IDPB CH,CP ;STORE AWAY THE 1ST CHAR +1UATM1: 1GETCH ;GRAB THE NEXT CHARACTER + XCT 1UTBL2(CH) ;DISPATCH ON NEW CHAR +1UATM3: DBP7 IP ;BACK INPUT UP ONE CHAR. + MOVEI B,0 ;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES + SETZ H, ;EXCESS CHARACTER COUNTER +1UATM5: IDPB B,CP + TLNE CP,760000 ;ARE WE AT THE END OF A WORD? + AOJA H,1UATM5 ; NO. KEEP CLEARING, AND COUNT CLEARED CHARS + + MOVEI A,U%ATOM ;RETURN THE TYPE + MOVNI R,(CP) + HRLI R,SYLBUF-1(R) + HRRI R,SYLBUF + MOVEI B,(CP) ;ADDRESS OF LAST WORD IN PNAME + SUBI B,SYLBUF-1 ; LESS START, GIVING LENGTH OF PNAME IN WORDS + IMUL B,CHS%WD ; TIMES CHARS/WORD GIVES CHAR COUNT + SUBI B,(H) ; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME + POPJ P, + + +;------------------------------------------------ +; PARSE A LIST +;------------------------------------------------ + +1ULIST: XCT UPLIST ;PERFORM ANY PASING EXIT ROUTINE +1ULST2: MOVE A,[PUSHJ P,1UTFN2] + MOVE A,[PUSHJ P,1UTFN2] + PUSHJ P,1UOBJ ;READ ALL THE OBJECTS IN THE LIST + JRST 1ULIST ;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET + CAIE A,U%LCLS ;IF IT WASN'T A ")", + JRST 1ULOSE ;--COMPLAIN AND RETURN TO TOP LEVEL + MOVEI A,U%LIST ;DATA TYPE + POPJ P, + + +;------------------------------------------------ +; PARSE A "{"-OBJECT +;------------------------------------------------ + +1UBKT: XCT UPBRKT ;PASING EXIT + PUSHJ P,1UOBJ ;SCAN ALL THE OBJECTS IN THE WHATEVER + JRST 1UBKT ;UNTIL WE HIT THE END + CAIE A,U%CBKT ;IF IT ISN'T A CLOSE BRACKET("]") + JRST 1ULOSE ;COMPLAIN HORRIBLY + MOVEI A,U%BKT ;TYPE + POPJ P, ;RETURN TO HIGHER LEVEL. + + +;------------------------------------------------ +; PARSE A VECTOR +;------------------------------------------------ + +1UVECT: XCT UPVECT + PUSHJ P,1UOBJ ;READ EVERY OBJECT IN THE VECTOR + JRST 1UVECT + CAIE A,U%VCLS ;IF NOT A CLOSE BRACKET "]", + JRST 1ULOSE ;PUNT + MOVEI A,U%VECT + POPJ P, + + +;------------------------------------------------ +; PARSE A UVECTOR +;------------------------------------------------ + +1UUVCT: XCT UPUVEC ;PARSING EXIT ROUTINE + PUSHJ P,1UOBJ + JRST 1UUVCT + CAIN A,U%VCLS ;CAN BE CLOSED BY "]" + JRST 1UUV1 + CAIE A,U%UCLS ;OR BY A "!]". + JRST 1ULOSE +1UUV1: MOVEI A,U%UVCT + POPJ P, + + +;------------------------------------------------ +; PARSE A SEGMENT +;------------------------------------------------ + +1USEG: XCT UPSEG ;PARSING EXIT ROUTINE + PUSHJ P,1UOBJ + JRST 1USEG + CAIN A,U%FCLS ;CAN BE ENDED BY JUST A ">", + JRST 1USEG1 + CAIE A,U%SCLS ;OR BY A "!>" + JRST 1ULOSE +1USEG1: MOVEI A,U%SEG + POPJ P, + + +;------------------------------------------------ +; QUOTED-OBJECT HANDLER +;------------------------------------------------ + +1UQUOT: PUSHJ P,1UOBJ ;SKIP PRECISELY 1 OBJECT + SKIPA + JRST 1ULOSE ;COMPLAINING IF IT'S NOT THERE + MOVEI A,U%QUOT + POPJ P, + + +;------------------------------------------------ +; HANDLE A #TYPE... +;------------------------------------------------ + +1UTYPE: PUSHJ P,1UOBJ ;GRAB AN ATOM + CAIE A,U%ATOM ;(IF NOT AN ATOM, + JRST 1ULOSE ; COMPLAIN ABOUT IT) + JSP H,UBLOOK ; IF IT'S A SPECIAL ATOM, + JRST 1UTYP1 ; (NOPE...) + HLRZ C,UBARRAY+2(C) ;GET HANDLER ADDRESS + PUSHJ P,(C) ;INVOKE HANDLER. + JRST 1UTYP2 ;(SKIPPED TO HANDLE OBJECT IN DEFAULT MANNER) +1UTYP1: PUSHJ P,1UOBJ ;GET THE NEXT OBJECT (THE REAL GUTS) + SKIPA + JRST 1ULOSE +1UTYP2: MOVEI A,U%TYPE + POPJ P, + + +;------------------------------------------------ +; EXCL (!) HANDLER +;------------------------------------------------ + +1UEXCL: 1GETCH ; GET THE NEXT CHARACTER + CAIN CH," ; IF IT'S A BLANK, KEEP LOOKING. + JRST 1UEXCL + + CAIN CH,"< ;HANDLE + JRST 1USEG ;SEGMENT-EVALUATION + + CAIN CH,"[ ;UVECTORS + JRST 1UUVCT + + CAIN CH,"\ ;CHARACTER DATA + JRST 1UCHAR + + CAIN CH,"> ;END OF A SEGMENT + JRST 1USCLS + + CAIN CH,"] ;END OF A UVECTOR + JRST 1UUCLS + + CAIN CH,". ;LVAL + JRST 1UDOT + + CAIN CH,", ;GVAL + JRST 1UCOMA + + CAIE CH,"" ;ALSO CHARACTER + JRST 1ULOSE ;(DIDN'T FIND ANYTHING) + + DROPTHRUTO 1UCHAR ;THIS IS A CONSISTENCY CHECK, NOT A COMMENT. + + +;------------------------------------------------ +; CHARACTER DATA-TYPE HANDLER +;------------------------------------------------ + +1UCHAR: 1GETCH ;IGNORE THAT CHARACTER + CAIN CH,3 ;CONTROL-C? + PUSHJ P,1MORE0 ;YES. GET NEXT CHUNK OF BUFFER. + CAIN CH,^J ;IF IT'S A LF + PUSHJ P,1ULF2 + CAIN CH,^M ;IF IT'S A CR + PUSHJ P,1UCR2 ;;GO HANDLE IT. + MOVEI A,U%CHAR ;SAY IT WAS A CHARACTER + POPJ P, + + +;------------------------------------------------ +; STRING PARSER +;------------------------------------------------ + +1USTR1: 1GETCH ; FOR READING "\"-QUOTED CHARACTERS + +1USTR: 1GETCH ;(ENTRY PT) GET NEXT CHAR IN STRING +1USTR2: CAIN CH,3 ;IF CONTROL-C, + PUSHJ P,1MORE0 ;GET MORE INPUT BUFFER (IF ANY) + CAIN CH,^J ;LINE-FEED HANDLER + JRST 1ULF3 + CAIN CH,^M ;CARRIAGE-RETURN HANDLER + JRST 1UCR3 + CAIN CH,"\ ;MUDDLE QUOTE CHARACTER? + JRST 1USTR1 ;YES. IGNORE THE NEXT CHAR + CAIE CH,"" ;END OF THE STRING? + JRST 1USTR ;NO -- KEEP READING + MOVEI A,U%STR ;TELL THE CALER IT'S A STRING + POPJ P, ;AND RETURN. + + +1UCR3: PUSHJ P,1UCR2 ;HANDLE THE CR (AND LF) + CAIN CH,^J + JRST 1USTR2 ;DON'T BOTHER WITH ANOTHER CHARACTER. + JRST 1USTR + +1ULF3: PUSHJ P,1ULF2 + JRST 1USTR + + +;------------------------------------------------ +; COMMENT HANDLER +;------------------------------------------------ + +1USEMI: PUSHJ P,1UOBJ ;IGNORE THE NEXT OBJECT. + JRST 1UOBJ ;AND FORGET WE SAW ANYTHING. + JRST 1ULOSE ;BAD BUSINESS IF IT'S NOT BALANCED. + + + +;------------------------------------------------ +; GVAL HANDLER +;------------------------------------------------ + +1UCOMA: PUSHJ P,1UOBJ ;SKIP THE NEXT OBJECT + POPJ P, + JRST 1ULOSE + + +;------------------------------------------------ +; LVAL HANDLER +;------------------------------------------------ + +1UDOT: PUSHJ P,1UOBJ ;SKIP THE NEXT OBJECT. + POPJ P, + JRST 1ULOSE + + + +;------------------------------------------------ +; +; VARIOUS CLOSING BRACKET HANDLERS +; +; THESE ALL SKIP-RETURN TO INDICATE +; THAT THEY ARE CLOSING-BRACKETS OF +; VARIOUS KINDS. +; +;------------------------------------------------ + +1ULCLS: MOVEI A,U%LCLS ; ) + AOS (P) + POPJ P, + +1UFCLS: MOVEI A,U%FCLS ; > + AOS (P) + POPJ P, + +1UVCLS: MOVEI A,U%VCLS ; ] + AOS (P) + POPJ P, + +1USCLS: MOVEI A,U%SCLS ; !> + AOS (P) + POPJ P, + +1UUCLS: MOVEI A,U%UCLS ; !] + AOS (P) + POPJ P, + +1UCBKT: MOVEI A,U%CBKT ; } + AOS (P) + POPJ P, + + +;------------------------------------------------ +; HANDLE CR, LF, AND FF +;------------------------------------------------ + +1UCR: PUSHJ P,1UCR2 + JRST 1UOBJ + + +1UCR2: TLNE F,FLSCR ;CHECK STRAY-CR IGNORE FLAG + POPJ P, + 1GETCH ; GET NEXT CHARACTER + CAIN CH,^J ;LINE FEED? + ADDI N,1 + POPJ P, + + + + + +1ULF: PUSHJ P,1ULF2 + JRST 1UOBJ + + +1ULF2: TLNE F,FLSCR ; CHECK IGNORE-STRAY-LF FLAG + ADDI N,1 ; BUMP THE LINE COUNT + POPJ P, + + + +1UFF: PUSHJ P,1UFF2 ;MOOVE TO THE NEXT PAGE + JRST 1ULOOP ;AND FORCE A RETURN TO TOP-LEVEL. + + +1UFF2: SKIPE LNDFIL ; IF THIS FILE HAS SOS LINE NUMBERS, + PUSHJ P,CKLNM ; GET AROUND IT + TRO N,-1 ; KILL LINE NUMBER + AOJ N, ; bump page no. +ITS,[ + HLRZ B,N ; SHOW PAGE NO IN PEEK + HRLI B,[SIXBIT/P1/] + .SUSET [.SWHO3,,B] + ] ; END ITS + POPJ P, ;RETURN TO PLAY WITH FF ELSEWHERE. + + + +;------------------------------------------------ +; READ A LOCAL-VARIABLE LIST +; AND MAKE THE DEFINITIONS +;------------------------------------------------ + +1ULOCL: PUSH P,UPLIST ;PUSH LIST PARSING EXIT. + MOVE A,[JRST UDFL1] ; HANDLER FOR THE LOCAL-VARIABLE LIST + MOVEM A,UPLIST + PUSHJ P,1UOBJ ;GRAB THE NEXT OBJECT, + SKIPA + JRST 1ULOSE ;WHICH -MUST- INCLUDE AN ARGS LIST. + + CAIE A,U%LIST ;IF IT WASN'T A LIST + JRST 1ULOSE ;COMPLAIN, SINCE IT BETTER BE. + POP P,UPLIST ;GET BACK OLD LIST HANDLER (PROBABLY THE NULL ONE) + POPJ P, ;RETURN TO NORMAL FORM HANDLER + + +;------------------------------------------------ +; LIST-PARSING EXIT ROUTINE +; TO HANDLE LOCALIZATION LISTS +; FOR 1ULOCL +;------------------------------------------------ + +UDFL1: PUSH P,UPLIST ; PUSH THE POINTER TO THIS + MOVE A,[JRST UDFL2] ; TO GET NAMES OF INITIALIZED LOCALS + MOVEM A,UPLIST +UDFL1A: PUSHJ P,1UOBJ ;GET THE NEXT OBJECT + SKIPA + JRST UDFL9 ;POTENTIAL END OF LIST -- GO CHECK IT. + MOVE B,A + MOVE A,R + MOVEI R,U%LOCL ; (LOCAL-VARIABLE FLAG) + CAIN B,U%ATOM ;IF THIS IS AN ATOM, + PUSHJ P,1UNAM2 ; GO DEFINE IT AS A LOCAL. + JRST UDFL1A ;GO BACK FOR MORE. + + +UDFL2: PUSH P,UPLIST ; PUSH POINTER TO THIS + MOVE A,[JFCL] + MOVEM A,UPLIST ; IGNORE ANY LISTS AT LOWER LEVELS. + PUSHJ P,1UOBJ ; GET THE FIRST OBJECT + SKIPA + JRST 1ULOSE ; AN INITTED LOCAL LIST CANNOT BE NULL. + MOVE B,A + MOVE A,R + MOVEI R,U%LOCL + CAIN B,U%ATOM ;IF THIS IS AN ATOM, + PUSHJ P,1UNAM2 ; DEFINE IT + +UDFL2A: PUSHJ P,1UOBJ ;SKIP THE REST OF THE LIST. + JRST UDFL2A + +UDFL9: POP P,UPLIST ;POP THE HANDLER SPEC + CAIE A,U%LCLS ;IF THIS ISN'T THE END OF A LIST + JRST 1ULOSE ; COMPLAIN + MOVEI A,U%LIST ;TELL IT WE HAD LA LIST, AND + POPJ P, ;RETURN TO NEXT HIGHER LEVEL. + + +;---------------------------------------------------------------- +; DISPATCH TABLE FOR TOKEN LOOKUP +;---------------------------------------------------------------- + +1UTBL: + +REPEAT 3., JRST 1UOBJ ; ^@ - ^B + PUSHJ P,1MORE ; ^C +repeat 6., JRST 1UOBJ ; ^D THRU ^I + JRST 1ULF ; LINE FEED + JRST 1UOBJ ; ^K + JRST 1UFF ; FORM FEED + JRST 1UCR ; CARRIAGE RETURN +REPEAT 18., JRST 1UOBJ ;IGNORE CTRL-CHARS. THRU ^_. + JRST 1UOBJ ;IGNORE SPACES + JRST 1UEXCL ;EXCLAMATION POINT + JRST 1USTR ; " +REPEAT 5, JRST 1UATOM ; # TO ' + JRST 1ULIST ; ) + JRST 1ULCLS ; ( +REPEAT 2, JRST 1UATOM ; * AND + + JRST 1UCOMA ; , + JRST 1UATOM ; - + JRST 1UDOT ; . +REPEAT 12., JRST 1UATOM ; / THRU : + JRST 1USEMI ; SEMICOLON + JRST 1UFORM ; < + JRST 1UATOM ; = + JRST 1UFCLS ; > +REPEAT 28., JRST 1UATOM ; ?, @, AND A-Z (UPPER CASE) + JRST 1UVECT ; + JRST 1UBKSL ; \ + JRST 1UVCLS ; +REPEAT 29., JRST 1UATOM ; ^, _, AND a-z (LOWER CASE) + JRST 1UBKT ; + JRST 1UATOM ; | + JRST 1UCBKT ; + JRST 1UATOM ; ~ + JRST 1UOBJ ; RUBOUT +IFN .-1UTBL-200, .ERR 1UTBL IS THE WRONG SIZE. + +;---------------------------------------------------------------- +; DISPATCH TABLE FOR END-OF-ATOM HUNT. +;---------------------------------------------------------------- + + +1UTBL2: +REPEAT 3., JRST 1UATM3 + PUSHJ P,1MORE ; ^C +REPEAT 29., JRST 1UATM3 ; END OF ATOM + JRST 1UATM2 ; ! + JRST 1UATM3 ; " +REPEAT 4, JRST 1UATM2 ; STILL IN THE ATOM +REPEAT 3, JRST 1UATM3 ; OUT +REPEAT 2, JRST 1UATM2 + JRST 1UATM3 ; , +REPEAT 14., JRST 1UATM2 ; - THRU : +REPEAT 2, JRST 1UATM3 ; ; AND < + JRST 1UATM2 ; = + JRST 1UATM3 ; > +REPEAT 28., JRST 1UATM2 ; ?, @, AND A-Z (UPPER CASE) + JRST 1UATM3 ; + JRST 1UATM4 ; \ + JRST 1UATM3 ; +REPEAT 29., JRST 1UATM2 ; ^, _, AND a-z (LOWER CASE) + JRST 1UATM3 ; + JRST 1UATM2 ; | + JRST 1UATM3 ; + JRST 1UATM2 ; ~ + JRST 1UATM3 ; RUBOUT + + +IFN .-1UTBL2-200, .ERR 1UTBL2 IS THE WRONG SIZE. + + +SUBTTL PASS 1 MUDDLE EXIT ROUTINE VECTOR FOR PARSING +;------------------------------------------------ +; DISPATCH TABLE FOR PARSE +; EXIT ROUTINES +; +; -These are used for special-purpose +; processing of MUDDLE objects, such +; as the use of a list for specifying +; the local variables in a function. +; +; -The exit routine receives control +; as soon as an object is recognized, +; and before anything else occurs. It +; may perform any processing it sees +; fit, and then returns to the main +; object parser to either snarf the +; rest of the object, or to verify +; that we have hit its end. +; +;------------------------------------------------ + +PTHI==. ? .==PTLO ;THIS TABLE IS IMPURE + +UPFRM: JFCL ;FORM +UPATOM: JFCL ;ATOM +UPLIST: JFCL ;LIST +UPBRKT: JFCL ;BRACKETED THING +UPVECT: JFCL ;VECTOR +UPUVEC: JFCL ;UVECTOR +UPSEG: JFCL ;SEGMENT + +PTLO==. ? .==PTHI ;BACK TO PURE CODE. + +SUBTTL PASS 1 MUDDLE SPECIAL ATOM HANDLERS +;----------------------------------------------------------- +; PROGRAMS FOR SPECIAL ATOMS +;----------------------------------------------------------- + +1UDFN: MOVEI R,U%FUNC ;DEFINE + PUSHJ P,1UNAME ;GO NAME THE FUNCTION. + PUSHJ P,1ULOCL ;GO READ LIST OF LOCALIZED ATOMS + POPJ P, ;AND RETURN TO REGULAR FORM HANDLER. + + +1UDFM: MOVEI R,U%MACR ;DEFMAC + JRST 1UNAME + +1UFCN: PUSHJ P,1ULOCL ; -- READ LOCAL VARIABLE LIST + POPJ P, ;AND RETURN TO THE REGULAR FORM HANDLER + +1UPCKG: MOVEI R,U%PCKG ;PACKAGE + JRST 1UNAME + +1USETG: MOVEI R,U%GLBL ;SETG + JRST 1UNAME + +1UNTYP: MOVEI R,U%TYPE ;NEWTYPE + JRST 1UNAME + +1UTFCN: PUSH P,UPLIST ; #FUNCTION HANDLER + MOVE A,[JRST 1UTFN2] + MOVEM A,UPLIST + PUSHJ P,1UOBJ ;GET THE BODY OF THE FUNCTION + CAIE A,U%LIST ;MUST BE A LIST + JRST 1ULOSE ;AND NOT AN UNBALANCED CLOSE BKT + + POP P,UPLIST ;GET BACK LIST EXIT ROUTINE + POPJ P, + + +1UTFN2: PUSHJ P,1ULOCL ;READ LOCAL VARIABLE LIST + MOVE A,[JFCL] + MOVEM A,UPLIST + JRST 1ULST2 ;GO READ REST OF THE LIST. + + + +SUBTTL MUDDLE OBJECT-ARRAY AND SEARCH ROUTINES +;----------------------------------------------------------- +; MUDDLE SYMBOL-DEFINITION ROUTINE +;----------------------------------------------------------- + +1UNAME: PUSH P,R ;SAVE TYPE TO STOW IN ATOM'S SYMTBL SLOT + PUSHJ P,1UOBJ ;GET NEXT ITEM + SKIPA + JRST 1UNM1 ;POP R AND GO CONTINUE SCAN (1UFRM2) + CAIE A,U%ATOM ;IS IT AN ATOM? + JRST 1UNM2 ;NO, CAN'T DEFINE + MOVE A,R ;AOBJN POINTER TO THE SYMBOL. + POP P,R +1UNAM2: JSP H,LDEFSYM ;JUST AS THE LISP (PG.101, LINE 011) + HRRM R,S.TYPE(L) ;PUT TYPE IN + MOVEM N,S.PAGE(L) ;PUT IN POINT IT WAS DEFINED. + POPJ P, ; RETURN TO PASING THE MAIN FORM. + + +1UNM1: POP P,R ; BAIL OUT, AFTER CLEAING STACK + JRST 1ULOSE ; AND COMPLAIN ABOUT BAD SYNTAX. + + +1UNM2: POP P,R ; PUNT THIS FORM. + POPJ P, + + +;------------------------------------------------ +; MACROS FOR DEFINING UATOMS +;------------------------------------------------ + +IF1 [ ;ON PASS 1, JUST LEAVE ROOM IN TABLE FOR THE ATOM + DEFINE UATOM JUNK/ + BLOCK 3 +TERMIN + ] ;END IF1 + +IF2 [ ; ON PASS 2 ASSEMBLE THE ATOM HEADERS IN-LINE, AND + ; PNAMES AT "UPNAME", USING ATMPTR AS AN OFFSET. + + DEFINE UATOM NAME=DEFINE,1L=1USUBR,2L=2USUBR,1K=1VSUBR,2K=2VSUBR + ATMPTR ;PNAME POINTER + 1L,,2L ;HANDLERS FOR PASS1,,PASS2 + 1K,,2K ;HANDLERS FOR #atom ... PASS1,,PASS2 +ZZ==. +.==ATMPTR ;MOVE INTO PNAME TABLE + ASCIZ /NAME/ +ATMPTR==. +.==ZZ ;RETURN TO MAINLINE. + TERMIN + +ATMPTR==UPNAME ;INITIALIZE THE ATOM NAME POINTER + ] ;END OF IF2. + +.XCREF UATOM + +1USUBR:2USUBR:1VSUBR:2VSUBR: STRT [ASCIZ/ Invalid use of a special atom. +/] + JRST 1ULOSE + + + + +;----------------------------------------------------------- +; ATOM TABLE FOR MUDDLE DEFINITIONS +; (MUST BE IN ALPHABETICAL ORDER) +;----------------------------------------------------------- + +UBARRAY: + UATOM ,1UDFN ;DEFINE + UATOM DEFMAC,1UDFM + UATOM FUNCTION,1UFCN,,1UTFCN + UATOM NEWTYPE,1UNTYP + UATOM PACKAGE,1UPCKG + UATOM PROG,1UFCN + UATOM REPEAT,1UFCN + UATOM SETG,1USETG + +;----------------------------------------------------------- +; FILL TABLE OUT TO POWER-OF-2 LENGTH +;----------------------------------------------------------- + +MUBARRAY==:<.-UBARRAY>/3 + +RADIX 2. +LOG2MUB==:CONC .LENGTH /,\MUBARRAY-1,/ +RADIX 8. + +REPEAT <1_LOG2MUB>-MUBARRAY,[ + [377777777777] + 1LSUBR,,2LSUBR + 1KSUBR,,2KSUBR +] ;END OF REPEAT <1_LOG2MUB>-MUBARRAY + +UPNAME: BLOCK 2*MUBARRAY + ;LEAVE SPACE FOR PNAMES. ON P2, ATOM NAME ASSEMBLES INTO THIS SPACE. + + + +;------------------------------------------------ +; MUDDLE SPECIAL-ATOM LOOKUP ROUTINE +; TAKES AN AOBJN POINTER TO THE ATOM +; NAME (IN SYLBUF) IN R. SKIPS IF THE +; ATOM IS FOUND, WITH OFFSET INTO +; UBARRAY IN C. IF NOT FOUND, NO SKIP. +;------------------------------------------------ + +UBLOOK: MOVE A,R + HLRZ R,A ;ROUTINE TO FIND SPECIAL ATOMS + CAIGE R,-2 ;IF NONE ARE FOUND, DOESN'T SKIP. + JRST (H) ;IF ARE FOUND, OFFSET FROM UBARRAY IS LEFT + MOVE L,(A) ;IN C AND IT SKIPS. + CAIE R,-1 + SKIPA R,1(A) + SETZ R, + SETZ C, +REPEAT LOG2MUB,[ + HRRZ D,UBARRAY+<3_>(C) + CAME L,(D) + JRST .+4 + CAML R,1(D) + JRST .+3 + JRST .+3 + CAML L,(D) + ADDI C,3_ +] ;END OF REPEAT LOG2MUB + HRRZ D,UBARRAY(C) + CAMN L,(D) + CAME R,1(D) + JRST (H) + JRST 1(H) ;THIS ENDS UBLOOK. + + + +SUBTTL PASS 2 PROCESSING FOR MUDDLE CODE + +2MUDDL: MOVEM P,LISPP ;SAVE STACK PTR FOR RETURNS TO TOP-LEVEL IN PARSE + +2ULOOP: SETZM MDLCMT ;GET OUT OF COMMENT MODE. + TLNE F,FLFNT3 ;REVERT TO "MAIN TEXT" FONT, IF NEED BE. + TRNE F,FRFNT3 + JRST 2ULUP2 + 2PATCH 177 ;XGP ESCAPE + 2PATCH 1 ;"FONT SELECT" + 2PATCH 1 ; FONT 2 +2ULUP2: MOVE P,LISPP ;RETURN-TO-TOP-LEVEL BRANCH TARGET + PUSHJ P,2UOBJ ;PROCESS THE NEXT MUDDLE OBJECT + JRST 2ULUP2 ;AND CONTINUE UNTIL END OF FILE. + +2ULOSE: JRST 2ULOOP ;FORCE HIM BACK TO TOP LEVEL. NO MESSAGE 2ND PASS. + + +;-------------------------------------------------------- +; MUDDLE OBJECT PARSER +;-------------------------------------------------------- + +2UOBJ: TRZE F,FRSQZ ;IF THE READ-AHEAD FLAG IS SET, THEN + JRST 2UOBJ1 ;DON'T BOTHER READING A CHARACTER (RESETS THE FLAG, TOO) + 2GETCH +2UOBJ1: XCT 2UTBL(CH) ; PERFORM CHARACTER-DEPENDENT ACTIONS. + POPJ P, ; RETURN TO A HIGHER LEVEL + + + +;-------------------------------------------------------- +; PARSE A FORM +;-------------------------------------------------------- + + +2UFORM: PUSHJ P,2UOBJ ;READ EVERY OBJECT IN THE FORM + JRST 2UFORM + CAIE A,U%FCLS ;MAKE SURE WE ENDED WITH A > + JRST 2ULOSE + MOVEI A,U%FORM + POPJ P, + + + +;-------------------------------------------------------- +; PARSE AN ATOM +; +; RETURNS: +; A/ U%ATOM (TYPE) +; B/ # OF CHARS IN THE PNAME +; SYLBUF et seq/ PNAME (IN ASCII) +; +;-------------------------------------------------------- + +2UBKSL: MOVE CP,[440700,,SYLBUF] ;"\"-QUOTED CHARS ALSO START ATOMS. + XCT UPATOM ; PERFORM PARSING EXIT ROUTINE +2UATM4: 2GETCH + JRST 2UATM2 ; SKIP ATOM-INIT CODE + + +2UATOM: MOVE CP,[440700,,SYLBUF] ;BYTE PTR TO ATOM BUFFER + XCT UPATOM ;PERFORM PARSING EXIT ROUTINE + +2UATM2: IDPB CH,CP ;STORE AWAY THE 1ST CHAR +2UATM1: 2GETCH ;GRAB THE NEXT CHARACTER + XCT 2UTBL2(CH) ;DISPATCH ON NEW CHAR +2UATM3: TRO F,FRSQZ ;SET READ-AHEAD FLAG FOR 2UOBJ MAIN LOOP. + MOVEI B,0 ;FILL OUT THIS WIRD OF SYLBUF WITH ZEROES + SETZ H, ;EXCESS CHARACTER COUNTER +2UATM5: IDPB B,CP + TLNE CP,760000 ;ARE WE AT THE END OF A WORD? + AOJA H,2UATM5 ; NO. KEEP CLEARING, AND COUNT CLEARED CHARS + + MOVNI R,(CP) + HRLI R,SYLBUF-1(R) + HRRI R,SYLBUF + MOVEI B,(CP) ;ADDRESS OF LAST WORD IN PNAME + SUBI B,SYLBUF-1 ; LESS START, GIVING LENGTH OF PNAME IN WORDS + IMUL B,CHS%WD ; TIMES CHARS/WORD GIVES CHAR COUNT + SUBI B,(H) ; LESS CLEARED CHARS GIVES TRUE LENGTH OF PNAME + + MOVE A,R + 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 A LIST +;------------------------------------------------ + +2ULIST: PUSHJ P,2UOBJ ;READ ALL THE OBJECTS IN THE LIST + JRST 2ULIST ;UNTIL WE HIT AN UNMATCHED CLOSE BRACKET + CAIE A,U%LCLS ;IF IT WASN'T A ")", + JRST 2ULOSE ;--COMPLAIN AND RETURN TO TOP LEVEL + MOVEI A,U%LIST ;DATA TYPE + POPJ P, + + +;------------------------------------------------ +; PARSE A "{"-OBJECT +;------------------------------------------------ + +2UBKT: PUSHJ P,2UOBJ ;SCAN ALL THE OBJECTS IN THE WHATEVER + JRST 2UBKT ;UNTIL WE HIT THE END + CAIE A,U%CBKT ;IF IT ISN'T A CLOSE BRACKET("]") + JRST 2ULOSE ;COMPLAIN HORRIBLY + MOVEI A,U%BKT ;TYPE + POPJ P, ;RETURN TO HIGHER LEVEL. + + +;------------------------------------------------ +; PARSE A VECTOR +;------------------------------------------------ + +2UVECT: PUSHJ P,2UOBJ ;READ EVERY OBJECT IN THE VECTOR + JRST 2UVECT + CAIE A,U%VCLS ;IF NOT A CLOSE BRACKET "]", + JRST 2ULOSE ;PUNT + MOVEI A,U%VECT + POPJ P, + + +;------------------------------------------------ +; PARSE A UVECTOR +;------------------------------------------------ + +2UUVCT: PUSHJ P,2UOBJ + JRST 2UUVCT + CAIN A,U%VCLS ;CAN BE CLOSED BY "]" + JRST 2UUV1 + CAIE A,U%UCLS ;OR BY A "!]". + JRST 2ULOSE +2UUV1: MOVEI A,U%UVCT + POPJ P, + + +;------------------------------------------------ +; PARSE A SEGMENT +;------------------------------------------------ + +2USEG: PUSHJ P,2UOBJ + JRST 2USEG + CAIN A,U%FCLS ;CAN BE ENDED BY JUST A ">", + JRST 2USEG1 + CAIE A,U%SCLS ;OR BY A "!>" + JRST 2ULOSE +2USEG1: MOVEI A,U%SEG + POPJ P, + + +;------------------------------------------------ +; QUOTED-OBJECT HANDLER +;------------------------------------------------ + +2UQUOT: PUSHJ P,2UOBJ ;SKIP PRECISELY 1 OBJECT + SKIPA + JRST 2ULOSE ;COMPLAINING IF IT'S NOT THERE + MOVEI A,U%QUOT + POPJ P, + + +;------------------------------------------------ +; HANDLE A #TYPE... +;------------------------------------------------ + +2UTYPE: PUSHJ P,2UOBJ ;GRAB AN ATOM + CAIE A,U%ATOM ;(IF NOT AN ATOM, + JRST 2ULOSE ; COMPLAIN ABOUT IT) + MOVE A,R ;GET AOBJN PTR TO THE ATOM + JSP H,@LOOKIT ;IF IT WAS NOT SEEN ON PASS 1, + SKIPA ; IGNORE IT. ELSE + JSP H,REFSYM ;MAKE A CREF ENTRY FOR IT. + PUSHJ P,2UOBJ ;GET THE NEXT OBJECT (THE REAL GUTS) + SKIPA + JRST 2ULOSE + MOVEI A,U%TYPE + POPJ P, + + +;------------------------------------------------ +; EXCL (!) HANDLER +;------------------------------------------------ + +2UEXCL: 2GETCH ; GET THE NEXT CHARACTER + CAIN CH," ; IF IT'S A BLANK, KEEP LOOKING. + JRST 2UEXCL + + CAIN CH,"< ;HANDLE + JRST 2USEG ;SEGMENT-EVALUATION + + CAIN CH,"[ ;UVECTORS + JRST 2UUVCT + + CAIN CH,"\ ;CHARACTER DATA + JRST 2UCHAR + + CAIN CH,"> ;END OF A SEGMENT + JRST 2USCLS + + CAIN CH,"] ;END OF A UVECTOR + JRST 2UUCLS + + CAIE CH,"" ;ALSO CHARACTER + JRST 2ULOSE ;(DIDN'T FIND ANYTHING) + + DROPTHRUTO 2UCHAR ;THIS IS A CONSISTENCY CHECK, NOT A COMMENT. + + +;------------------------------------------------ +; CHARACTER DATA-TYPE HANDLER +;------------------------------------------------ + +2UCHAR: 2GETCH ;IGNORE THAT CHARACTER + MOVEI A,U%CHAR ;SAY IT WAS A CHARACTER + POPJ P, + + +;------------------------------------------------ +; STRING PARSER +;------------------------------------------------ + +2USTR1: 2GETCH ; FOR READING "\"-QUOTED CHARACTERS + +2USTR: 2GETCH ;(ENTRY PT) GET NEXT CHAR IN STRING + CAIN CH,"\ ;MUDDLE QUOTE CHARACTER? + JRST 2USTR1 ;YES. IGNORE THE NEXT CHAR + CAIE CH,"" ;END OF THE STRING? + JRST 2USTR ;NO -- KEEP READING + MOVEI A,U%STR + POPJ P, + + +;------------------------------------------------ +; COMMENT HANDLER +;------------------------------------------------ + +2USEMI: PUSH P,MDLCMT ;PUSH THE STATE OF THE "COMMENT" FLAG + SETOM MDLCMT ;WE'RE INSIDE A COMMENT NOW, FOR SURE. + SETOM 2MCCOL + TLNE F,FLFNT3 + TRNE F,FRFNT3 + JRST 2USMI2 + 2PATCH 177 + 2PATCH 1 + 2PATCH 2 +2USMI2: PUSHJ P,2UOBJ ;IGNORE THE NEXT OBJECT. + SKIPA + JRST 2ULOSE ;BAD BUSINESS IF IT'S NOT BALANCED. + POP P,MDLCMT ;GET BACK OLD COMMENT SWITCH. + SKIPE MDLCMT ;IF WE'RE OUT OF THE OUTERMOST COMMENT, + POPJ P, + TLNN F,FLFNT2 ;(AND WE'RE USING MULTIPLE FONTS) + POPJ P, + 2PATCH 177 ;SWITCH BACK TO THE TEXT FONT + 2PATCH 1 + 2PATCH 2 + POPJ P, + + + +;------------------------------------------------ +; GVAL HANDLER +;------------------------------------------------ + +2UCOMA: PUSHJ P,2UOBJ ;SKIP THE NEXT OBJECT + POPJ P, + JRST 2ULOSE + + +;------------------------------------------------ +; LVAL HANDLER +;------------------------------------------------ + +2UDOT: PUSHJ P,2UOBJ ;SKIP THE NEXT OBJECT. + POPJ P, + JRST 2ULOSE + + + +;------------------------------------------------ +; +; VARIOUS CLOSING BRACKET HANDLERS +; +; THESE ALL SKIP-RETURN TO INDICATE +; THAT THEY ARE CLOSING-BRACKETS OF +; VARIOUS KINDS. +; +;------------------------------------------------ + +2ULCLS: MOVEI A,U%LCLS ; ) + AOS (P) + POPJ P, + +2UFCLS: MOVEI A,U%FCLS ; > + AOS (P) + POPJ P, + +2UVCLS: MOVEI A,U%VCLS ; ] + AOS (P) + POPJ P, + +2USCLS: MOVEI A,U%SCLS ; !> + AOS (P) + POPJ P, + +2UUCLS: MOVEI A,U%UCLS ; !] + AOS (P) + POPJ P, + +2UCBKT: MOVEI A,U%CBKT ; } + AOS (P) + POPJ P, + + + + +;------------------------------------------------ +; DISPATCH TABLE FOR TKOEN LOOKUP +;------------------------------------------------ + + +2UTBL: + +REPEAT 3., JRST 2UOBJ ; ^@ - ^B + JRST 2UOBJ +repeat 6., JRST 2UOBJ ; ^D THRU ^I + JRST 2UOBJ + JRST 2UOBJ ; ^K + JRST 2UOBJ + JRST 2UOBJ +REPEAT 18., JRST 2UOBJ ;IGNORE CTRL-CHARS. THRU ^_. + JRST 2UOBJ ;IGNORE SPACES + JRST 2UEXCL ;EXCLAMATION POINT + JRST 2USTR ; " +REPEAT 5, JRST 2UATOM ; # TO ' + JRST 2ULIST ; ) + JRST 2ULCLS ; ( +REPEAT 2, JRST 2UATOM ; * AND + + JRST 2UCOMA ; , + JRST 2UATOM ; - + JRST 2UDOT ; . +REPEAT 12., JRST 2UATOM ; / THRU : + JRST 2USEMI ; SEMICOLON + JRST 2UFORM ; < + JRST 2UATOM ; = + JRST 2UFCLS ; > +REPEAT 28., JRST 2UATOM ; ?, @, AND A-Z (UPPER CASE) + JRST 2UVECT ; + JRST 2UBKSL ; \ + JRST 2UVCLS ; +REPEAT 29., JRST 2UATOM ; ^, _, AND a-z (LOWER CASE) + JRST 2UBKT ; + JRST 2UATOM ; | + JRST 2UCBKT ; + JRST 2UATOM ; ~ + JRST 2UOBJ ; RUBOUT +IFN .-2UTBL-200, .ERR 2UTBL IS THE WRONG SIZE. + +;---------------------------------------------------------------- +; DISPATCH TABLE FOR END-OF-ATOM HUNT. +;---------------------------------------------------------------- + + +2UTBL2: +REPEAT 3., JRST 2UATM3 + JRST 2UATM3 +REPEAT 29., JRST 2UATM3 ; END OF ATOM + JRST 2UATM2 ; ! + JRST 2UATM3 ; " +REPEAT 4, JRST 2UATM2 ; STILL IN THE ATOM +REPEAT 3, JRST 2UATM3 ; OUT +REPEAT 2, JRST 2UATM2 + JRST 2UATM3 ; , +REPEAT 14., JRST 2UATM2 ; - THRU : +REPEAT 2, JRST 2UATM3 ; ; AND < + JRST 2UATM2 ; = + JRST 2UATM3 ; > +REPEAT 28., JRST 2UATM2 ; ?, @, AND A-Z (UPPER CASE) + JRST 2UATM3 ; + JRST 2UATM4 ; \ + JRST 2UATM3 ; +REPEAT 29., JRST 2UATM2 ; ^, _, AND a-z (LOWER CASE) + JRST 2UATM3 ; + JRST 2UATM2 ; | + JRST 2UATM3 ; + JRST 2UATM2 ; ~ + JRST 2UATM3 ; RUBOUT + + +IFN .-2UTBL2-200, .ERR 2UTBL2 IS THE WRONG SIZE. + + \ No newline at end of file