Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
sources/atsign.mid
There are no other files named atsign.mid in the archive.
; -*-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 ;<PAGE #>,,<LINE # -1>
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)
;;; BOB Bob Knight (KNIGHT@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 <n> 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 <null>.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[<left>,<right>,<top>,<bottom>] to
;;; set the margins (where arguments are in mils).
;;; Note that at CMU the <right> and <bottom> 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<sp>: 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)
;;; 23-Apr-86 RMK Use FONTS: instead of hardwiring the directory name on
;;; the NIC
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 <CMU20FLG+T20FLG>&SITE!TERMIN
DEFINE NOT20
IFE <CMU20FLG+T20FLG>&SITE!TERMIN
DEFINE TNX
IFN <CMU20FLG+T20FLG+10XFLG>&SITE!TERMIN
DEFINE NOTNX
IFE <CMU20FLG+T20FLG+10XFLG>&SITE!TERMIN
DEFINE CMU
IFN <CMU10FLG+CMU20FLG>&SITE!TERMIN
DEFINE NOCMU
IFE <CMU10FLG+CMU20FLG>&SITE!TERMIN
DEFINE BOTS ;TOPS-10 LIKE OPERATING SYSTEM
IFN <T10FLG+SAIFLG+CMU10FLG>&SITE!TERMIN
DEFINE NOBOTS
IFE <T10FLG+SAIFLG+CMU10FLG>&SITE!TERMIN
DEFINE DOS
IFN <T10FLG+SAIFLG+CMU10FLG>&SITE!TERMIN
DEFINE NODOS
IFE <T10FLG+SAIFLG+CMU10FLG>&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>-<SIXBIT /SRI-NI/>,[
XGPFMT==:ITSFLG ; ITS type XGP cmds, but require /D[C]
; to select Canon. Later fix up?
FNTDSN==:144 ; <FONTS> 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&<ITSFLG\SAIFLG\CMU10FLG\CMU20FLG\T20FLG\10XFLG>
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&<CMU10FLG>!TERMIN
DEFINE NOCMUXGP
IFE XGPFMT&<CMU10FLG>!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==:<PUSHJ P,> ; Handy
RET==:<POPJ P,>
DEFINE DROPTHRUTO X
IF2, IFN .-X, .ERR THIS DROPTHRUTO SHOULD BE A JRST
TERMIN
ITS,[ TYO=:.IOT TYOC,
TYI=:.IOT TYIC,
DEFINE OUTWDS REG<ADDRWD,COUNT
HRRO REG,ADDRWD
TLC REG,<-1>+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=:<JSR LOSE>
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<ADDRWD,COUNT
IRPS X,,[A B C]
IFN REG-X, PUSH P,X
TERMIN
MOVNI C,COUNT
HRRZ B,ADDRWD
HRLI B,444400
MOVE A,JFNCHS+UTOC
SOUT
IRPS X,,[C B A]
IFN REG-X, POP P,X
TERMIN
TERMIN
];TNX
DOS,[
IF1, EXPUNGE .BAI,.BAO,.BII,.BIO ;IN CASE WE ARE ASSEMBLING ON ITS
BOTS,[
IF1, EXPUNGE .VALUE,.CLOSE,.DISMISS
IF2, .VALUE==:JSR LOSE ;IF2 BECAUSE LOSE ISN'T DEFINED YET IN PASS 1
TYO=:OUTCHR
TYI=:INCHWL
.CLOSE==:RELEASE ;CLOSE ENOUGH APPROXIMATION
.DISMISS==:JRST 2,@0 ;AGAIN, A CLOSE APPROXIMATION (FOR RETURNING FROM PDL OVERFLOWS)
];BOTS
.BAI==:0 ;ASCII INPUT MODE
.BAO==:0 ;ASCII OUTPUT MODE
.BII==:14 ;IMAGE INPUT MODE
.BIO==:14 ;IMAGE OUTPUT MODE
DEFINE OUTWDS REG<ADDRWD,COUNT\OLOOP ;THIS MIGHT WANT TO BE A SUBROUTINE
IFE N-REG, .ERR REGISTER N ILLEGAL AS AN ARG TO OUTWDS
PUSH P,N
MOVEI N,COUNT
SKIPA REG,ADDRWD
OLOOP: POP P,N
SUB N,OUTHED+2
JUMPG N,[PUSH P,N
SKIPGE N,OUTHED+1
.VALUE ;DON'T HANDLE BYTE POINTERS WITH P=36.
ADD N,OUTHED+2
EXCH N,OUTHED+1
HRLI N,(REG)
HRRI N,1(N)
BLT N,@OUTHED+1
ADD REG,OUTHED+2
SETZM OUTHED+2
OUT UTOC,
JRST OLOOP ;Loop if successful
GETSTS UTOC,N
.VALUE
TRZ N,740000
SETSTS UTOC,(N)
JRST OLOOP ]
MOVN N,N
EXCH N,OUTHED+2
SUB N,OUTHED+2
SKIPGE OUTHED+1
.VALUE ;DON'T HANDLE BYTE POINTERS WITH P=36.
ADD N,OUTHED+1
EXCH N,OUTHED+1
HRLI N,(REG)
HRRI N,1(N)
BLT N,@OUTHED+1
POP P,N
IF2, EXPUNGE OLOOP
TERMIN
];DOS
SUBTTL DEFAULT ASSEMBLY PARAMETERS
IFNDEF VSPNRM,VSPNRM==:4 ;DEFAULT VSP
CMU10,IFNDEF PGNSPC,PGNSPC==:.LENGTH \DEVx:FILNAM.EXT[X999XX99]\
IFNDEF PGNSPC,PGNSPC==:.LENGTH \DIRNAM;FILNAM FILNM2\
T10,IFNDEF NFILES,NFILES==:32. ;DON'T WASTE TOO MUCH SPACE ON FILES
CMU,IFNDEF NFILES,NFILES==:200. ;BUT CMU OFTEN WANTS MORE
TNX,IFNDEF NFILES,NFILES==:200. ;SO DOES TNX
IFNDEF NFILES,NFILES==:64. ;MAX # FILES ALLOWED
DOS,XGP,IFNDEF LINBFR,LINBFR==:400 ;MUST HAVE ROOM FOR ENOUGH OF FNT FILES.
DOS,IFNDEF LINBFR,LINBFR==:200 ;NO POINT IN TRYING TO READ TOO MUCH AT A TIME
IFNDEF LINBFR,LINBFR==:1000 ;LENGTH OF INPUT BUFFER
IFNDEF LSLBUF,LSLBUF==:1000 ;LENGTH OF OUTPUT BUFFER
CMU,IFNDEF LSYLBUF,LSYLBUF==:400.;CMU SOMETIMES NEEDS LONG JCL
TNX,IFNDEF LSYLBUF,LSYLBUF==:400.;SO DOES TNX
IFNDEF LSYLBUF,LSYLBUF==:100 ;LENGTH OF SYLLABLE/JCL BUFFER
IFNDEF NFNTS,NFNTS==:3 ;# FONTS ALLOWED.
IFNDEF MINPGL,MINPGL==:45. ;SMALLEST ALLOWED PAGEL.
IFNDEF MINLNL,MINLNL==:50. ;SMALLEST ALLOWED LINEL.
IFNDEF MAXVSP,MAXVSP==:20. ;LARGEST VSP THAT CAN BE SPEC'D WITH A POSITIVE ARG TO /V.
BOTS,IFNDEF FNAMCW,FNAMCW==29. ;BOTS OFTEN PRINTS DEVx:
IFNDEF FNAMCW,FNAMCW==24. ;THIS IS THE COLUMN WIDTH WHEN LISTING FILES IN TITLES
NODOS,[ ;THESE WILL BE ROUNDED UP TO MULTIPLES OF 1K IN PDLIN1.
IFNDEF PDLDLN,PDLDLN==:400 ;SIZE OF PDL SPACE
IFNDEF LRCILN,LRCILN==:2000 ;INITIAL SIZE OF LRC AREA (IT CAN GROW, AT FIRST)
IFNDEF LRCDLN,LRCDLN==:40.*2000 ;DEFAULT SIZE OF INPUT LREC INFO SPACE (40K)
IFNDEF SYMDLN,SYMDLN==:40.*2000 ;DEFAULT SIZE OF SYMTAB SPACE (40K)
IFNDEF DATILN,DATILN==:2000 ;INITIAL SIZE OF DATA AREA (IT CAN GROW)
IF2 IFG .JBFF1+PDLDLN+LRCDLN+SYMDLN+DATILN-776000, .ERR DEFAULT SPACE ALLOCATIONS TOO BIG
];ITS OR TNX
DOS,[
IFNDEF PDLDLN,PDLDLN==:200 ;SIZE OF PDL
IFNDEF LRCILN,LRCILN==:1 ;INITIAL SIZE OF LRC AREA (IT CAN GROW, AT FIRST)
T10,IFNDEF LRCDLN,LRCDLN==:2000 ;I GUESS DEC IS TIGHT FOR CORE --RHG
IFNDEF LRCDLN,LRCDLN==:10000 ;DEFAULT SIZE OF INPUT LREC INFO SPACE.
IFNDEF SYMDLN,SYMDLN==:20000 ;DEFAULT SIZE OF SYMTAB SPACE.
IFNDEF DATILN,DATILN==:1 ;INITIAL SIZE OF DATA AREA (IT CAN GROW)
];DOS
IFNDEF ENTDLN,ENTDLN==:10000 ;DEFAULT ENTBUF SIZE IN 8-BIT BYTES
IFNDEF DIRDLN,DIRDLN==:4000 ;DEFAULT DIRBUF SIZE IN 18-BIT BYTES
CMU,IFNDEF DFMARG,DFMARG==:394. ;AT CMU, USE 1CM MARGINS
IFNDEF DFMARG,DFMARG==:500. ;DEFAULT MARGIN (IN MILS)
IFNDEF DFLMAR,DFLMAR==:DFMARG ;LEFT MARGIN
IFNDEF DFRMAR,DFRMAR==:DFMARG ;RIGHT MARGIN
IFNDEF DFTMAR,DFTMAR==:DFMARG ;OUTPUT TOP MARGIN
IFNDEF DFBMAR,DFBMAR==:DFMARG ;BOTTOM MARGIN
IFNDEF DFHMAR,DFHMAR==:DFMARG ;HOLE MARGIN -- NORMALLY ADDED TO DFLMAR
IF2 [ ;PASS 2, SINCE CODTYP VALUES NOT DEFINED YET IN PASS 1
ITS,IFNDEF DFLANG,DFLANG==:CODMID
CMU,IFNDEF DFLANG,DFLANG==:CODRND
SAI,IFNDEF DFLANG,DFLANG==:CODFAI
TNX,IFNDEF DFLANG,DFLANG==:CODMID
IFNDEF DFLANG,DFLANG==:CODMID ;DEFAULT LANGUAGE
];IF2
SAI,IFNDEF QUEBFL,QUEBFL==100 ;LENGTH OF BUFFER FOR XSPOOL COMMAND.
SUBTTL FLAG DEFINITIONS
;;; FLAGS IN LH OF ACCUMULATOR F
FL==:1,,525252 ;BIT TYPEOUT MASK
FLREFS==:400000 ;REFERENCE STUFF
FLSHRT==:100000 ;SHORT MULTI-FILE NAMES
FLINSRT==:40000 ;LIST ALL INSERTED FILES
FLXGP==:20000 ;XGP HACKERY
FLCREF==:10000 ;CREF FOR ALL FILES WANTED
FLBS==:4000 ;CTRL/H REALLY GOES OUT AS CTRL/H
FLSCR==:2000 ;STRAY CR'S REALLY OVERSTRIKE
; (ALSO CONTROLS STRAY LINEFEEDS)
FLCTL==:1000 ;CTRL CHARS GO OUT AS THEMSELVES
FLARB==:400 ;ARBITRARILY LONG SYMBOLS
FLFNT2==:200 ;TEXT IS DIFFERENT FONT FROM CRUFT
FLFNT3==:100 ;COMMENTS ARE DIFFERENT FONT FROM TEXT
FL2REF==:40 ;TWO REFS PER LINE (PDP-11 CODE)
FLASCI==:20 ;SYMBOLS ARE IN ASCII (ELSE SIXBIT)
; (NOBODY USES THIS PRESENTLY)
FLDATE==:10 ;WANT DATE IN HEADINGS
FLNOLN==:4 ;NO STUFF AT ALL ON LEFT
FLQPYM==:2 ;COPYRIGHT MESSAGE
FLSUBT==:1 ;SUBTITLES TABLE OF CONTENTS
;;; FLAGS IN RH OF F.SWIT OF EACH FILE-BLOCK.
;;; SOME (THOSE IN TEMPF) ARE KEPT IN F FOR FILE BEING PROCESSED.
;;; NOTE THAT DURING SWITCH PROCESSING MOST OF THESE LIVE IN F,
;;; AND MOST OF THE FR FLAGS AREN'T IN USE YET. EXCEPTION IS FR1SW.
FS==:525252 ;BIT TYPEOUT MASK
FSNCHG==:4000 ;SET IF FILE IS DISCOVERED TO BE UNCHANGED SINCE PREVIOUS
;LISTING WAS MADE. VALUE CALCULATED BY CPRU.
;UNCHANGED FILE ARE NOT LISTED.
FSLRNM==:2000 ;DON'T CAUSE ANY PAGE TO HAVE A SLASHIFIED PAGE NUMBER,
;EVEN IF THAT REQUIRES RELISTING LOTS OF PAGES (/1J).
FSLALL==:1000 ;RELIST ALL OF THIS FILE (/-J).
FSGET==:400 ;THIS IS AN LREC FILE, AND .INSRT ALL FILES MENTIONED IN IT.
FSNSMT==:200 ;NO SYMBOL TABLE PRINTOUT FOR THIS FILE
FSNOIN==:100 ;IGNORE FILE EVEN ON PASS 1. USED TO SUPPRESS PASS 1
;FOR .INSRT'ED FILES THAT AREN'T REALLY RELEVANT.
FSLREC==: 40 ;THIS FILE IS A LISTING RECORD FILE
FSQUOT==:20 ;THIS FILE WAS SPEC'D WITH A SINGLE-QUOTE.
FSARW==:10 ;THIS FILE'S SPEC HAD A "_".
FSMAIN==:4 ;THIS FILE IS THE ONE WHOSE FN2 SHOULD BE USED FOR THE LREC FILE.
FSSUBT==:2 ;THIS FILE HAS AT LEAST ONE SUBTITLE SPECIFIED, SO RESERVE
;THE FIRST LINE OF EACH PHYSICAL PAGE FOR A SUBTITLE.
.SEE FR1SW
FSAUX==:1 ;THIS FILE CONTAINS A ".AUXIL", SO IT IS AN AUXILIARY FILE.
;SYMBOLS THAT APPEAR ONLY AUXILIARY FILES WHICH ARE NOT
;BEING LISTED ARE NOT MENTIONED IN CREFS.
TEMPF==:FSLREC+FSARW+FSQUOT+FSNOIN+FSNCHG
;THESE FLAGS ARE MOVED FROM F.SWIT INTO AC F FOR EACH FILE DURING PASS1 AND PASS2.
;;; FLAGS IN RH OF ACCUMULATOR F
FR==:525252 ;BIT TYPEOUT MASK
FRSYL1==:400000 ;FIRST SYLLABLE OF LINE ALREADY SEEN
FRVSL1==:200000 ;VIRTUAL FIRST SYLLABLE SEEN
FRIF==:100000 ;SOME KIND OF IF SEEN
FRLET==:40000 ;LETTER SEEN (OR . OR $ OR %)
FRSQZ==:20000 ;SQUOZE CHAR SEEN
FRNCHG==:FSNCHG ;THIS FLAG SET IN F FROM F.SWIT OF CURRENT FILE.
FRNOIN==:FSNOIN ;THESE 4 FLAGS SET IN F FROM F.SWIT OF CURRENT FILE.
FRLREC==:FSLREC ? FRQUOT==:FSQUOT ? FRARW==:FSARW
FR1SW==:2 ;SET BY "/", CLEARED BY "(" - CAUSES RETURN TO FILENAME
;READER AFTER PROCESSING ONE SWITCH.
FRAUX==:FSAUX
;USED ONLY IN PASS 2
FRFNT3==:4 ;BUSY OUTPUTTING IN FONT 3
FRLCR==:2 ;LAST CHAR WAS CR (FOR SLURP)
FRLTAB==:1 ;LAST CHAR WAS TAB, SPACE, LF, FF
;USED ONLY IN MOBY.
FRPSHRT==:2 ;IN MOBY, INDICATES PAGE IS SHORT, SO SHRINK LETTERS VERTICALLY
FRLSHRT==:1 ;IN MOBY, INDICATES LINES ARE SHORT, SO SHRINK LETTERS HORIZONTALLY.
SUBTTL FORMAT OF SYMBOL TABLE
;;; THE SYMBOL TABLE GROWS UPWARD, INITIALLY FROM LOCATION SYMBOT.
;;; THE CURRENT LOW ADDRESS OF THE SYMBOL TABLE IS IN SYMLO.
;;; DURING PASS 1, SP CONTAINS A PDL POINTER TO THE SYMBOL TABLE
;;; WHICH IS USED TO PUSH NEW ENTRIES. AT THE END OF PASS 1,
;;; THE HIGHEST ADDRESS USED +1 IS DEPOSITED IN LOCATION SYMHI.
;;; THE SYMBOL TABLE IS THEN SORTED (SEE SORT), SO THAT PASS 2
;;; MAY USE A BINARY SEARCH LOOKUP TECHNIQUE.
;;; EACH ENTRY IN THE SYMBOL TABLE IS FOUR WORDS LONG. (THE
;;; ROUTINES SORT, LOOK, AND NLOOK DEPEND ON THIS FACT!)
;;; THE FORMAT OF EACH ENTRY IS AS FOLLOWS:
S.==:,-1 ;MASK FOR BIT TYPEOUT MODE.
C.==:,-1
S.NAME==:0 ;NAME OF SYMBOL. IF SINGLE WORD SYMBOLS ARE
; BEING USED (THE FLAG FLARB IS OFF), THEN THIS
; WORD CONTAINS THE SINGLE WORD OF THE NAME.
; OTHERWISE IT CONTAINS AN AOBJN POINTER TO THE
; NAME, WHICH IS IN CONSECUTIVE WORDS IN THE
; DATA AREA.
S.FILE==:1 ;THE LEFT HALF CONTAINS A POINTER TO THE FILE
; BLOCK (SEE FILES) FOR THE FILE IN WHICH THE
; DEFINITION WAS FOUND.
S.TYPE==:1 ;THE RIGHT HALF CONTAINS THE ADDRESS OF DATA
; DESCRIBING THE TYPE OF SYMBOL DEFINITION
.SEE ATYPE ; (E.G. MACRO, ==, .GLOBAL). TYPES ARE DEFINED BY ATYPE.
S.PAGE==:2 ;THE LEFT HALF CONTAINS THE PAGE NUMBER FOR
; THE DEFINITION.
S.LINE==:2 ;THE RIGHT HALF CONTAINS THE LINE NUMBER -1.
S.BITS==:3 ;THE LEFT HALF CONTAINS VARIOUS BITS PERTAINING
; TO THE SYMBOL DEFINED. THESE ARE:
%S==1,,525252
%SDUPL==:400000 ;THIS ENTRY IS PRECEDED BY ONE
; WITH THE SAME NAME. %SDUPL
; MUST BE THE SIGN BIT - SEE NLOOK8
%SXCRF==:200000 ;THIS SYMBOL WAS SEEN IN A
; .XCREF - DO NOT CREF
%SREFD==:100000 ;THIS SYMBOL WAS REFERENCED ON
; PASS 2 - USED TO PUT *'S IN
; THE SYMBOL TABLE (NOT FULLY
; WINNING IF NOT ALL FILES
; WERE SEEN ON PASS 2)
%SXSYM==:40000 ;DO NOT PRINT THIS SYMBOL IN THE
; SYMBOL TABLE - IT IS PRESENT FOR
; CREF PURPOSES ONLY
S.CREF==:3 ;THE RIGHT HALF IS A POINTER TO A LINKED CHAIN
; OF CREF DATA FOR THIS SYMBOL. ONLY THE FIRST
; ENTRY OF SEVERAL WITH THE SAME NAME WILL HAVE
; CREF DATA. CREF DATA BLOCKS ARE THREE WORDS
; LONG, AND ARE EXACTLY LIKE THE LAST THREE
; WORDS OF A SYMBOL TABLE ENTRY. A POINTER TO A
; CREF ENTRY POINTS TO THE WORD BEFORE THE
; THREE-WORD BLOCK. THE S.NAME WORD IN A CREF
; DATA BLOCK IS NOT MEANINGFUL. THE S.CREF WORD
; IS USED TO CHAIN CREF DATA INTO A LINKED LIST.
LSENT==:4 ;LENGTH OF SYMBOL TABLE ENTRY
C.FILE==:S.FILE
C.TYPE==:S.TYPE
C.PAGE==:S.PAGE
C.LINE==:S.LINE
C.CREF==:S.CREF
SUBTTL FORMAT OF AN LREC FILE
;THE FIRST WORD OF AN LREC FILE SHOULD NOW BE SIXBIT/LREC/+1.
;ATTEMPTS TO USE FILES WHICH DO NOT SATISFY THAT CRITERION
;CAUSE ERROR MESSAGES.
;THE REST OF FILE IS COMPOSED OF ENTRIES, ONE AFTER THE OTHER.
;EACH ENTRY DESCRIBES HOW ONE FILE WAS TREATED IN THE LISTING
;THAT THE LREC FILE DESCRIBES. THERE IS AN ENTRY FOR ALL FILES EXCEPT
;LREC FILES AND BACKARROW-SINGLEQUOTE FILES.
;AN ENTRY BEGINS WITH 4 WORDS GIVING THE SNAME, DEV, FN1 AND FN2 OF THE FILE.
;THEN COME 0 OR MORE SUBENTRIES, FOLLOWED BY A -1 SIGNIFYING THE END
;OF THE ENTRY.
;A SUBENTRY CONSISTS OF A WORD HOLDING THE SUBENTRY TYPE,
;A WORD WHOSE LH HAS MINUS THE NUMBER OF DATA WORDS IN THE SUBENTRY,
;FOLLOWED BY DATA WORDS WHOSE SIGNIFICANCE DEPENDS ON THE SUBENTRY TYPE.
;THE SUBENTRY TYPES THAT NOW EXIST ARE:
LR.==:,-1 ;MASK FOR BIT TYPEOUT MODE.
LR.PAG==:1 ;THE DATA WORDS ARE THE PAGE TABLE OF THE FILE.
LR.SYM==:2 ;THE DATA WORDS ARE THE SYMBOL TABLE OF THE FILE.
;THAT IS, THE SYMBOL TABLE OF THE LISTING BUT LIMITED
;TO SYMBOLS DEFINED IN THIS FILE. CURRENTLY, THIS SUBENTRY
;IS IGNORED ON INPUT, AND NEVER WRITTEN.
LR.SWT==:3 ;THERE IS 1 DATA WORD, THE F.SWIT VALUE FOR THE FILE.
LR.PSW==:4 ;HOLDS INFO ON SETTINGS ON NON-PER-FILE SWITCHES
;IF ONE ENTRY IN THE FILE HAS AN LR.PSW
;SUBENTRY, ALL ENTRIES SHOULD HAVE THEM, AND
;THEY SHOULD ALL HAVE THE SAME CONTENTS.
;THE SETTINGS RECORDED IN THIS SUBENTRY ARE USED
;WHEN /G IS SPEC'D AS THE DEFAULTS FOR ALL THE
;SWITCHES. THERE ARE 12. WORDS OF DATA:
;WD 1 THE VALUE OF F
;WD 2 THE VALUE OF LINEL
;WD 3 THE VALUE OF PAGEL
;WD 4 THE VALUE OF UNIVCT
;WD 5 THE VALUE OF CODTYP
;WD 6 THE VALUE OF TRUNCP
;WD 7 THE VALUE OF SINGLE
;WD 8 THE VALUE OF PRLSN
;WD 9 THE VALUE OF SYMLEN
;WD 10 THE VALUE OF QUEUE
;WD 11 BIT-DECODED: BIT 1.1 = 1 IFF NOTITLE IS NONZERO.
; BIT 1.2 = 1 IFF REALPG IS NONZERO.
; BITS 1.3, 1.4 = VALUE OF NXFDSP (TO BE SIGN-EXTENDED)
;WD 12 THE VALUE OF SYMTRN
LR.FNT==:5 ;HOLDS INFO ON SPEC'D FONTS. PRESENT ONLY IF FONTS HAVE
;BEEN SPECIFIED. CONTAINS AN IMAGE OF FNTF0 THROUGH FNTFE-1,
;AS THEY WERE WHEN LREC FILE WAS MADE. THUS, THERE ARE
;FNTFL WORDS PER FONT, AND NFNTS FONTS. @ WILL NOT COMPLAIN
;IF HANDED A LONGER LR.FNT BLOCK BUT WILL IGNORE THE EXTRA FONTS.
LR.XGP==:6 ;HOLDS PARAMETERS RELEVANT TO FONTS. RIGHT NOW THERE ARE
;FIVE, THE VSP (FROM FNTVSP) AND THE FOUR MARGINS.
LR.CRF==:7 ;CONTAINS INFO ON THE OUTPUT FILE FOR CREF TABLES AND
;UNIVERSAL SYMBOL TABLES. THERE ARE 5 DATA WORDS, WHICH ARE
;CRFSNM, CRFDEV, CRFFN1, CRFFN2, CRFOFL
;THE ABSENCE OF THIS SUBENTRY IS EQUIVALENT TO THE PRESENCE
;OF ONE WITH CRFOFL CONTAINING 0.
LR.CPY==:10 ;THE COPYRIGHT MESSAGE, FROM CPYMSG.
LR.OUT==:11 ;4 WORDS: THE SNAME, DEV, FN1, FN2 DEFAULTS FOR OUTPUT FILES
;0 => NOT SPECIFIED, SO USE @'S STANDARD DEFAULT EACH TIME.
;I.E. 0 AS SNAME MEANS USE MSNAME OF USER RUNNING @.
LR.DAT==:12 ;CREATION DATE OF THE SOURCE FILE.
SUBTTL GENERALLY USEFUL MACROS.
DEFINE INSIRP A,B
IRPS X,,B
A,X
TERMIN TERMIN
DEFINE DBP7 X
ADD X,[070000,,]
SKIPGE X
SUB X,[430000,,1]
TERMIN
DEFINE CONC A,B
A!B!TERMIN
;;; USEFUL NREVERSE MACRO. QUICKLY REVERSES A LINKED LIST.
;;; FIRST ARG IS AC CONTAINING LIST, NEXT TWO ARE SCRATCH AC'S.
;;; FOURTH IS OFFSET OF CDR POINTER (MUST BE IN RH OF WORD).
;;; FIFTH IS CODE TO EXECUTE ON EACH LOOP, REFERRING TO
;;; AC POINTING AT CURRENT NODE AS X. REVERSED LIST IS LEFT
;;; IN AC WHERE LIST WAS SUPPLIED.
DEFINE NREVERSE AC1,AC2,AC3,Z,CODE\TAG1,TAG2,TAG3,MAC1
DEFINE MAC1 X
CODE
TERMIN
JUMPE AC1,TAG3
SETZ AC2,
TAG1: HRRZ AC3,Z(AC1)
HRRM AC2,Z(AC1)
MAC1 AC1
JUMPE AC3,TAG3
HRRZ AC2,Z(AC3)
HRRM AC1,Z(AC3)
MAC1 AC3
JUMPE AC2,TAG2
HRRZ AC1,Z(AC2)
HRRM AC3,Z(AC2)
MAC1 AC2
JUMPN AC1,TAG1
SKIPA AC1,AC2
TAG2: MOVEI AC1,(AC3)
TAG3:
EXPUNGE MAC1
TERMIN
SUBTTL UUO AND INTERRUPT HANDLERS
IFN 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 + <LARGEST LEGAL DEVICE VALUE>
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 + <LARGEST LEGAL CODTYP VALUE>
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-<WIDTH OF REF MESS>, 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 (/<N>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 (/<N>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 <FONTS>
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,<TLINEL> FOR TRUNCP NOT 0
2PUTNX: 0 ;CAIA FOR TRUNCP 0; CAIL CC,<TLINEL> 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-<EXTLEN*<UTOC-UTIC>>, .ERR OUFIL PLACED WRONG FOR FLOSE
IFN INSFIL-INFIL-<EXTLEN*<INSC-UTIC>>, .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>,,<OLD PAGE NUMBER>. 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 ;<BASELINE>*512.+<HEIGHT>,,<WIDTH> 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*<NFNTS-1>
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 <directory> 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:
;;; <KWIC POINTER>,,<ALPHA POINTER> ;OPTIONAL
;;; NODE: -<# CHARS>,,<NEXT POINTER>
;;; <PAGE NUMBER>,,<FILE BLOCK>
;;; ... 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: <UNUSED>,,<NEXT POINTER>
;;; <SYMBOL>,,<TYPE>
;;; WHERE SOMEWHERE IN THE DATA AREA ARE:
;;; SYMBOL: -<# CHARS>,,<POINTER TO CHARS>
;;; AND SIMILARLY FOR TYPE.
;;;
;;; MIDAS HAS SAME FORMAT, BUT <TYPE> IS <FLAGS> (SEE BELOWO) AND SYMBOL
;;; HAS USUAL MIDAS FORM.
ADEFLS: 0 ;LINKED LIST OF @DEFINE CRUD
;;; FLAGS IN <TYPE>
%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-<EXTLEN*UTIC>+.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+<LSYLBUF*5>] ; 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=:<JUMPA 16,> ; but 10X needs JRST.
ERXJMP==:<ERJMP_-27> ; For easier code writing
ERXCAL==:<ERCAL_-27>
ERXJPA==:<ERJMPA_-27>
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,[-<<PURTOP+1777-PURBOT>_-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<EOF> 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:<directory> 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] ; <directory>
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==<T20FLG+10XFLG>
IFN TNXSW,[
ITSSW==<DECSW==0>
;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 <desired JFN>,,<temp JFN>)
]
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)
IDPB 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>*<avg # strings/file>*<avg # words/string>+<# wds for constants>
LFNBUF==<MAXIND+5>*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 /<N>A TURN ON FLARB
JRST FPSCNF
TLO F,FLARB
JUMPE B,FPSWS
MOVEM A,SYMTRN ;/<N>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[<left>,<right>,<top>,<bottom>] 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[<left>,<right>,<top>,<bottom>,<hole>] - 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:"
IFE <.SITE 0>-<SIXBIT /SRI-NI/>,[
MOVE CC,[SIXBIT/FONT/]
] ;SRI-NIC
IFN <.SITE 0>-<SIXBIT /SRI-NI/>,[
MOVSI CC,'DSK
] ;SRI-NIC
SKIPN FNTDEV(L) ;DEFAULT THE OTHER NAMES.
MOVEM CC,FNTDEV(L)
IFE <.SITE 0>-<SIXBIT /SRI-NI/>,[
CAMN CC,[SIXBIT/FONT/]
JRST [ ;IF USING LOGICAL NAME, DON'T SUPPLY A DIR
SETZM FNTSNM(L)
JRST NOFDIR]
] ;SRI-NIC
MOVE CC,[FNTDSN]
SKIPN FNTSNM(L)
MOVEM CC,FNTSNM(L)
IFE <.SITE 0>-<SIXBIT /SRI-NI/>,[
NOFDIR:
] ;SRI-NIC
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-<EXTLEN*UTIC>+.RBPRV(CH)] ;*** CREATION DATE
HRLZM B,F.CRDT(A)
LDB B,[170300,,INFIL-<EXTLEN*UTIC>+.RBEXT(CH)] ;DON'T FORGET THE HIGH ORDER BITS
DPB B,[360300,,F.CRDT(A)]
LDB B,[141300,,INFIL-<EXTLEN*UTIC>+.RBPRV(CH)] ;RH HAS TIME IN MINUTES.
HRRM B,F.CRDT(A)
MOVE B,INFIL-<EXTLEN*UTIC>+.RBNAM(CH)
MOVEM B,F.RFN1(A)
HLLZ B,INFIL-<EXTLEN*UTIC>+.RBEXT(CH)
MOVEM B,F.RFN2(A)
SKIPE B,INFIL-<EXTLEN*UTIC>+.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-<EXTLEN*UTIC>+.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 -<LENGTH OF BLOCK>
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<CR>" 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 -<LENGTH>,,< -> 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 <X-LINEL>*<X-PAGEL>,[ ;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> = -<LENGTH OF DATA>
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 <LAST LINE ON PAGE>
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 <N> CORRESPONDS TO OLD PAGE <M>
;AND NEW PAGE <N>+<X> CORRESPONDS TO OLD PAGE <M>-<Y>.
;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 <PAGE #>,,<LINE #>-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, <SYM><SPACE>= AND <SYM><SPACE>: 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 ;<SYM><SPACE><SQUOZE> - PROCESS THE 1ST <SYM>
CAIE CH,"=
CAIN CH,": ;<SYM><SPACE><COLON>, 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 ;<SYM><SPACE><RANDOM> => 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 <CR> 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 ;<CR> 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 <FILE>,,<TYPE>
PUSH SP,N ;PUSH <PAGE #>,,<LINE # -1>
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 ;'<S-EXP> 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
;;; <NOT FOUND>
;;; <FOUND>
;;; 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 <SP>MM/DD/YY
NOITS, SUBI A,15. ;ALLOW FOR <SP>MM/DD/YY<SP>HH:MM
SKIPGE A
SETZ A,
MOVEM A,PLINEL ;HORIZ INDENT FOR "PAGE <N>" 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:]<DIR>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 <NN><CR>"
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 <NEW PAGE TABLE ENTRY ADDR> 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: (<New Number> = <Old Number>):
/]
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 <NEW #>=<OLD #>
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: <NEW1>=<OLD1> THRU <NEW2>=<OLD2>.
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 <NEW>=<OLD>
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 <TAB STOPS>
;;;
;;; -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 ; <esc>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 <SP>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 ; <directory> or PS:<directory>
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,>-<SIXBIT /MIT-XX/>,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. <CRLF> 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==<Y_5>+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, <PAGE #>-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 ;<SHOULDN'T COME HERE>
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_<LOG2LOB-.RPCNT-1>>(C)
CAME L,(D)
JRST .+4
CAML R,1(D)
JRST .+3
JRST .+3
CAML L,(D)
ADDI C,3_<LOG2LOB-.RPCNT-1>
] ;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