; -*-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)

;;; 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)

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)
	 IDBP C,B
	ILDB C,A
	JUMPN C,.-2	;<
	MOVEI C,">
	IDPB C,B
	SETZ C,
	IDPB C,B
	MOVSI A,(RC%EMO)		; Want exact match
	HRROI B,STRBUF	
	RCDIR				; Error shouldn't happen
	 ERJMP [SETZ C, ? JRST .+1]
	MOVE A,C			; Get dir # into A
	POP P,C
];T20
	POP P,B
	POPJ P,

; TRFD - TENEX-style Filename Reader.
;	Takes input from RCH.
;	Deposits name strings into filblk F points to.
;	Clobbers A,B,C,D, (and AA,T,TT due to FNCHK)
; Uses FRFEXT flag to see if already read extension (type) or not.
;	Refuses to accept existing defaults for version, ;T, account,
;	protection, or JFN.  It will also zap an existing directory
;	default if a device is specified, and vice versa.  This is so that
;	logical names will win a little better.
; 	Implements crufty ^R hack (if see ^R, act as if just starting to
;	read filename, so effect is stuff before ^R has set defaults.)

TRFD:	TRZ FF,FRNNUL
	SETZM $FJFN(F)	; Zap JFN since the filename we'll read won't match it.
	SETZM $FACCT(F)	; Also zap other things that we don't want defaulted.
	SETZM $FPROT(F)
	SETZM $FTEMP(F)
	SETZM $FVERS(F)
TRFD01:	TRZ FF,FRFEXT+FRFDEV+FRFDIR	; Jump here if ^R seen.
TRFD10:	PUSHJ P,GPASST	; remove tabs, spaces and get first non-tab/space
	TRNN FF,FRCMND	; If parsing command line,
	 CAIE A,";	; or if char isn't semicolon,
	  JRST TRFD21	; just handle normally.
TRFD15:	PUSHJ P,RCH	; Semi-colon and not command line, it's a comment!
	CAIE A,^M	; So flush rest, up to EOL.
	 JRST TRFD15
	POPJ P,

TRFD1:	TLO FF,FLUNRD	; come here to re-read last char
TRFD2:	PUSHJ P,RCH	; Get char
TRFD21:	CAIE A,40	; Space? (come here to scan already-read char)
	 CAIN A,^I	; or tab?
	  JRST [TRNE FF,FRCMND	; Space/tab, if reading command line
		 JRST TRFD2	; then ignore and continue scanning (for switches), but
		JRST TRFD15]	; if not in cmd line, go flush entire rest of line!
	CAIN A,^M	; End of line?
	 POPJ P,	; If so, obviously done.
	CAIN A,^R	; Crufty ^R hack?
	 JRST TRFD01	; Sigh, pretend starting over.
	TRNN FF,FRCMND	; Must we check for cmd line frobs?
	 JRST TRFD22	; Nope, skip them.

	; Must check for chars special only in command line.
	CAIN A,"=
	 MOVEI A,"_
	CAIE A,"_	; backarrow is filename terminator...
	 CAIN A,",	; as is comma.
	  POPJ P,
	CAIN A,"!	; For CCL hacking...
	 POPJ P,	.SEE RFDRUN
;	PUSHJ P,CMDSW	; Check for switches...
;	 JRST TRFD21	; got some, process next char (returned by CMDSW)
			; Skips if none, drop thru.

	; Now see if char signifies start of anything in particular.
TRFD22:	CAIE A,"<	; Start of directory name?
	 JRST TRFD24	; No
	PUSHJ P,RCH
	PUSHJ P,TRFDW	; Read word, starting with next char
TRFD23:	CAIN A,".	; Allow . as part of directory name
	 JRST [	PUSHJ P,TRFDW5	; Read a continuation to this word
		JRST TRFD23]	; And try again
	MOVEI D,$FDIR	; Set up index.
	CAIN A,">	; Terminator should be end of dir name...
	 PUSHJ P,RCH	; If so, get next to avoid scan of ">".
			; else bleah, but aren't supposed to fail...
	TRNN FF,FRFDEV	; Unless a device has been explicitly given,
	 SETZM $FDEV(F)	; zap any furnished default.  0 means DSK.
	TRO FF,FRFDIR	; Now say dir was explicitly given.
	JRST TRFD6	; Go store it.
TRFD24:	CAIN A,".	; Start of $FTYPE or $FVERS (20x)?
	 JRST [	MOVEI D,$FTYPE	; Assume reading $FTYPE field,
		TLNE FF,FL20X	; always if 10X, but if really on 20X, then
		 TRON FF,FRFEXT	; use $FTYPE only if not already seen.
		  JRST TRFD4	; $FTYPE - jump to get word & store.
		PUSHJ P,TRFDNM	; $FVERS - 20X and $FTYPE already seen. Get #.
		 MOVEM B,$FVERS(F)	; Store it away if successful.
		JRST TRFD1]		; and go re-read delimiting char.

	CAIN A,";	; Start of $FVERS (10x) or attribute?
	 JRST [	PUSHJ P,RCH	; Find what next char is.
		CAIL A,"a	; Must uppercasify.
		 CAILE A,"z
		  CAIA
		   SUBI A,40
		CAIN A,"T	; Temporary file?
		 JRST [	SETOM $FTEMP(C)
			JRST TRFD2]
		CAIN A,"A	; Account?
		 JRST [	MOVEI D,$FACCT	; Set index, and
			JRST TRFD4]	; go gobble following word.
		CAIN A,"P	; Protection?
		 JRST [	MOVEI D,$FPROT	; Set index, and
			JRST TRFD4]	; go gobble following word.
		TLO FF,FLUNRD	; Not alpha, try numeric.  Re-read char,
		PUSHJ P,TRFDNM	; trying to parse as number.
		 MOVEM B,$FVERS(F)	; Win, parsed as number! Store it.
		JRST TRFD1]	; If none of above, ignore ";" entirely.

	PUSHJ P,TRFDW	; Let's try reading it as word,
	JUMPLE C,APOPJ	; If nothing read, assume it's some terminating delimiter.
	CAIN A,":	; Else have something, check trailing delim for special cases
	 JRST [	MOVEI D,$FDEV		; Aha, a device.
		PUSHJ P,RCH		; Flush the terminator & get next char.
		TRNN FF,FRFDIR		; Unless dir was explicitly given,
		 SETZM $FDIR(F)		; zap furnished default. 0 uses connected dir.
		TRO FF,FRFDEV		; Say device was explicitly given, and
		JRST TRFD6]		; store name away.
	MOVEI D,$FNAME	; Else assume it's the filename.
	JRST TRFD6


TRFD4:	PUSHJ P,RCH	; Here when must gobble next char,
TRFD5:	PUSHJ P,TRFDW	; here when first char of wd already read.
TRFD6:	PUSHJ P,FNCHKZ	; Note this can return and store a null string!
	ADDI D,(F)	; Get address (filblk+index), and
	MOVEM A,(D)	; store string pointer in the appropriate place.
	TRO FF,FRNNUL	; Say non-null spec seen,
	JRST TRFD1	; and go re-read the delimiter, to process it.

; TRFDW - Read a word (string), for use by TNXRFD.  Copies sequence of
;	acceptable filename chars into FNBUF, until non-valid char seen.
;	A/ First char of word,
;	Returns A/ delimiting char, C/ count of chars in string,
;	clobbers nothing else.

TRFDW4:	SUBI A,40	; Make lowercase
TRFDW5:	IDPB A,FNBWP	; Deposit into FNBUF,
	PUSHJ P,RCH	; get next char,
	AOSA C		; and bump count, skipping over zap instruction.
TRFDW:	 SETZ C,	; When called, zero cnt of chars in string.
	CAIL A,"A	; See if char is uppercase alpha,
	 CAILE A,"Z
	  CAIA
	   JRST TRFDW5
	CAIL A,"a	; or lowercase alpha,
	 CAILE A,"z
	  CAIA
	   JRST TRFDW4
	CAIL A,"0	; or numeric,
	 CAILE A,"9
	  CAIA
	   JRST TRFDW5
	CAIE A,"$	; or dollarsign
	 CAIN A,"-	; or hyphen
	  JRST TRFDW5
	CAIN A,"_	; Backarrow is special case, because
	 JRST [	TRNN FF,FRCMND	; if reading command,
		 TLNN FF,FL20X	; or running on 10X,
		  POPJ P,	; must treat as delimiter.
		JRST TRFDW5]
	CAIN A,^V	; ^V is quote char...
	 JRST [	PUSHJ P,RCH	; Quote, get next.
		CAIE A,^M	; Quote anything but this.
		 CAIN A,0	; or this.
		  POPJ P,	; time to exit.
		PUSH P,A	; Quote it!  Save char,
		MOVEI A,^V	; so that a quoter can precede it.
		IDPB A,FNBWP	; Fortunately this hair
		POP P,A		; only needs care
		IDPB A,FNBWP	; for quoted chars, which are
		JRST TRFDW5]	; rare.
	TLNE FF,FL20X	; Are we on a 10X?
	 POPJ P,	; If not, anything at this point is delimiter.
	CAIL A,41	; Check general bounds
	 CAIL A,137	; Range from space to _ exclusive.
	  POPJ P,	; If outside that, delimiter.
	CAIL A,72	; This range includes :, ;, <, =, >
	 CAILE A,76
	  CAIA
	   POPJ P,	; delimiter.
	CAIE A,".
	 CAIN A,",
	  POPJ P,
	CAIE A,"*
	 CAIN A,"@
	  POPJ P,
	; Finally, check out chars which are acceptable to 10X but which
	; might be delimiter in cmd line...
	TRNN FF,FRCMND
	 JRST TRFDW5	; Not hacking cmd line, it's an OK char.
	CAIE A,"/
	 CAIN A,"(
	  POPJ P,
	CAIN A,"!
	 POPJ P,
	JRST TRFDW5	; at long last done.


; TRFDNM - Read numerical string, halt when non-digit
;	seen, leaves result (decimal) in B, with delimiting char in A.
;	One peculiarity is skip return if no numerical char is seen at all;
;	else doesn't skip and B has a valid number.

TRFDNM:	PUSHJ P,RCH		; First char needs special check.
	CAIL A,"0
	 CAILE A,"9
	  JRST POPJ1		; Not a number at all?
	TDZA B,B
TRFDN2:	 IMULI B,10.
	ADDI B,-"0(A)		; Convert to number
	PUSHJ P,RCH		; Get following chars.
	CAIL A,"0
	 CAILE A,"9
	  POPJ P,		; Nope, not digit so treat as delimiter.
	JRST TRFDN2	; Yep, a number


;; Extra stuff to support ATSIGN use of MIDAS code

.SCALAR LASTCH, RCHBP
RCH:	TLZE FF,FLUNRD
	 SKIPA A,LASTCH
	  ILDB A,RCHBP
	CAIN A,
	 MOVEI A,^M
	MOVEM A,LASTCH
	POPJ P,

GPASST:	PUSHJ P,RCH
	CAIE A,40
	 CAIN A,^I
	  JRST GPASST
	POPJ P,

] ;IFN TNXSW

SUBTTL TENEX misc. Filename Routines, FS string storage

IFN TNXSW,[	.SEE FSDSK	; Part of this page is NOT conditionalized!!

; To handle filenames of ASCIZ strings instead of SIXBIT words, each
; word has instead a byte pointer to an ASCIZ string.  For purposes of
; easy comparison, all of these bp's point into FNBUF, and a routine
; (FNCHK) is provided which checks a just-stored string and returns a bp
; to either this string, if unique, or to a previously stored string if
; it is the same as the one just stored (which is then flushed).  Thus
; strings can be compared for equality simply by a comparison of their
; byte pointers.  While not necessary, strings are stored beginning on
; word boundaries for easier hacking.

	; <# files>*<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:"
	MOVSI CC,'DSK
	SKIPN FNTDEV(L)		;DEFAULT THE OTHER NAMES.
	 MOVEM CC,FNTDEV(L)
	MOVE CC,[FNTDSN]
	SKIPN FNTSNM(L)
	 MOVEM CC,FNTSNM(L)
	MOVE CC,FNDFN2
	SKIPN FNTFN2(L)
	 MOVEM CC,FNTFN2(L)
	MOVEI R,.BII
	MOVEI A,(L)		;OPEN THE FONT FILE, IN IMAGE MODE.
	PUSHJ P,2INOPN
	 JRST 1+[JRST FPSFN4
		FLOSE UTIC,FNTSNM(L)
		JFCL CPOPJ ]
	PUSH P,IP		;READ IN A LARGE AMOUNT OF IT.
	PUSHJ P,2RDAHD
	PUSHJ P,DOINPT
	 JRST POPIPJ
	POP P,IP
	MOVS CC,FNTFN2(L)
	CAIN CC,'FNT
	 JRST FPSFN6
	CAIN CC,'KST		;ERROR IF FONT NOT A KST OR FNT FILE.
	 JRST FPSFN5
	CAIA
	 JRST FPSFN4		;IF USER GIVES A NEW FILENAME, GO TO FPSFN4.
FPSFNE:	FLOSEI FLSFNT,FNTSNM(L)
	 JFCL CPOPJ		;IF HE DOESN'T, RETURN.

FPSFN5:	MOVE CC,INBFR+2		;KST FILE: ITS OR CMU?
	TRNE CC,1
	 JRST FPSFN9
	CAIE CC,2		;MAKE SURE IT IS REALLY NEW CMU
	 JRST FPSFNE
	SKIPLE CC,INBFR
	 MOVEM CC,FNTID(L)
	SKIPA A,[177]		;SEARCH FOR CHAR WITH MAX INCR
FPSFN8:	 CAMGE R,INBFR+10.(A)
	  MOVE R,INBFR+10.(A)
	SOJGE A,FPSFN8
	HLRZ R,R		;USE MAX INCR AS WIDTH OF FONT
	MOVE CC,INBFR+1		;GET FONT HEIGHT
	MOVE A,INBFR+2		;GET FONT BASELINE
	JRST FPSFN7

FPSFN9:	HRRZ CC,INBFR+1		;ITS KST FILE: GET FONT HEIGHT
	HLRZ A,INBFR+1		;GET BASELINE
	ANDI A,777
	HRRZ R,INBFR+4		;GET WIDTH
	JRST FPSFN7		;STORE THEM IN FNTSIZ(L).

FPSFN6:
IFL LINBFR-204,.ERR BAD LINBFR FOR PARSING FNT FILES
	MOVE CC,INBFR+201	;FNT FILE: GET HEIGHT, BASELINE AND WIDTH.
	MOVE A,INBFR+203
	MOVE R,INBFR+202
FPSFN7:	HRLZM CC,FNTSIZ(L)	;STORE FONT HEIGHT.
	DPB A,[331100,,FNTSIZ(L)] ;AND BASELINE
	HRRM R,FNTSIZ(L)	;STORE FONT WIDTH.
	.CLOSE UTIC,		;THAT IS ALL FOLKS
	POPJ P,

POPIPJ:	POP P,IP
	POPJ P,
];XGP

FNTNON:	SETZM FNTSNM(L)		;HE SAID "NONE" -- CLEAR THE FONT
	SETZM FNTDEV(L)
	SETZM FNTFN1(L)
	SETZM FNTFN2(L)
	SETZM FNTSIZ(L)
	SETOM FNTID(L)
	POPJ P,
];XGPRES

PRESS,[

;READ IN A FONT NAME FOR PRESS FILE USE.
;THESE FONT NAMES ARE NOT FILE NAMES.  THEY CONTAIN
;A FAMILY NAME, A FACE CODE, AND A POINT SIZE.
;WE STORE THE FAMILY NAME IN 3 WORDS OF SIXBIT (FNTSNM - FNTFN1)
;AND THE FACE CODE,,POINT SIZE IN FNTFN2.
;L INDEXES THE FONT WE ARE READING.
;RETURN ON FINDING A COMMA, CLOSEBRACKET, OR CONTROL CHARACTER.
FPSDF:	PUSHJ P,FPSPSP		;SKIP ANY LEADING SPACES.  ;[
	CAIE CH,"]		;IF THE FIRST NONSPACE IS A TERMINATOR,
	 CAIN CH,",		;THIS FONT IS NOT BEING SPECIFIED.
	  POPJ P,		;LEAVE IT ALONE.
	CAIG CH,40
	 POPJ P,
	SETZM FNTSNM(L)
	SETZM FNTDEV(L)
	SETZM FNTFN1(L)
	SKIPA A,[440600,,FNTSNM(L)]	;STUFF FAMILY NAME DOWN THIS BP.
FPSDF1:	 ILDB CH,IP
	CAIL CH,"0		;THE FAMILY NAME SHOULD BE ENDED BY A DIGIT.
	 CAILE CH,"9
	  CAIN CH,40		;OR SPACES AND THEN A DIGIT
	   JRST FPSDF2
	CAIL CH,40	;[
	 CAIN CH,"]		;IF WE FIND A NAME TERMINATOR, BARF, SINCE
	  JRST FPSDFL		;THERE OUGHT TO BE A POINT SIZE HERE.
	CAIN CH,",
	 JRST FPSDFL
	CAIGE CH,140
	 ADDI CH,40
	CAME A,[000600,,FNTFN1(L)]
	 IDPB CH,A
	JRST FPSDF1

;FOUND END OF FAMILY NAME.
FPSDF2:	CAIN CH,40
	 PUSHJ P,FPSPSP
	CAIL CH,"0
	 CAILE CH,"9
	  JRST FPSDFL		;ERROR IF THE NEXT THING IS NOT A SIZE
;NOW READ IN THE POINT SIZE	
	TDZA A,A		;ACCUMULATE DECIMAL NUMBER IN A.
FPSDF4:	 IMULI A,10.
	ADDI A,-"0(CH)
	ILDB CH,IP
	CAIL CH,"0
	 CAILE CH,"9		;STOP AND STORE THE NUMBER AT FIRST NON-DIGIT
	  CAIA
	   JRST FPSDF4
	MOVEM A,FNTFN2(L)
;NOW ALL CHARACTERS BEFORE THE NEXT SPACE OR TERMINATOR SHOULD BE THE FACE CODE.
	SETO A,			;ACCUMULATE THE FACE CODE AS ZERO BITS IN A.
	CAIN CH,40
FPSDF3:	 PUSHJ P,FPSPSP
	CAIL CH,40	;[
	 CAIN CH,"]		;CHECK FOR A TERMINATOR.
	  JRST FPSDF5		;IF WE FIND ONE, STORE WHAT WE GOT.
	CAIN CH,",
	 JRST FPSDF5
	CAIL CH,140
	 SUBI CH,40
	CAIN CH,"E		;THE CHARACTERS "ECILB" SET BITS IN A.
	 TRZ A,1		;"E" MEANS EXTENDED, "C" MEANS COMPRESSED,
	CAIN CH,"C
	 TRZ A,2
	CAIN CH,"I		;"I" MEANS ITALIC,
	 TRZ A,4
	CAIN CH,"L		;"L" MEANS LIGHT, "B" MEANS BOLD.
	 TRZ A,10
	CAIN CH,"B
	 TRZ A,20
	JRST FPSDF3

FPSDF5:	TRNE A,3		;EXTENDED COMPRESSED IS AN ERROR,
	 TRNN A,30		;AS IS LIGHT BOLD
	  JRST FPSDFC
	SETZ B,
	TRNN A,1		;TURN BITS IN A INTO XROX FACE CODE IN B.
	 ADDI B,12.
	TRNN A,2
	 ADDI B,6
	TRNN A,4
	 ADDI B,1
	TRNN A,10
	 ADDI B,4
	TRNN A,20
	 ADDI B,2
	HRLM B,FNTFN2(L)	;STORE FACE CODE.
;HERE AT END OF SO-FAR VALID FONT NAME, HAVING SKIPPED ANY SPACES.
	SETOM EFNTF		;FONTS HAVE BEEN EXPLICITLY SPECIFIED
	SETOM FNTID(L)		;THIS FONT HAS BEEN EXPLICITLY SPECIFIED.
	CAIE CH,",	;[
	 CAIN CH,"]		;SHOULD NOW HAVE REACHED VALID TERMINATOR.
	  POPJ P,
	STRT [ASCIZ /Garbage in font name: /]
	JRST FPSBD1

;HERE IF FONT NAME IS ENDED AT THE END OF THE FAMILY NAME (POINT SIZE MISSING).
;IT MIGHT STILL BE LEGAL, IF THE NAME IS "NONE".
FPSDFL:	MOVE A,FNTSNM(L)
	CAME A,[SIXBIT/NONE/]	;ALLOW SPECIFICATION OF FONT "NONE" TO
	 CAMN A,[SIXBIT/NONE:/]	;ELIMINATE THE SPECIFICATION OF THIS FONT.
	  JRST FNTNON
	STRT [ASCIZ /No point size in font name: /]
	JRST FPSBD1

FPSDFC:	STRT [ASCIZ /Self-contradictory face code in font name: /]
	JRST FPSBD1

];PRESS

SUBTTL	SWITCH DISPATCH TABLE

;INDEX BY SWITCH CHARACTER IN SIXBIT, TO FIND ADDRESS OF HANDLER FOR CHARACTER.
.SEE SWPRIN	;IF YOU CHANGE THIS TABLE, SEE SWPRIN .

;SWITCH ROUTINES SHOULDN'T CLOBBER ACS OTHER THAN A,B,C,H AND CH.
;A AND B CONTAIN PREFIX ARGUMENT INFO WHICH IT IS OK TO DESTROY; WHICH FPSNUM USES.
.SEE FPSNUM, SW, SWSW, SWTYP	;ARE USEFUL IN SWITCH ROUTINES.

;DURING SWITCH PROCESSING, F CONTAINS THOSE FLAGS WHICH MUST! BE ON
;N HAS THOSE WHICH MUST! BE OFF.
;D HAS THOSE DEFAULTED ON, BUT OVERRIDABLE.
;R HAS THOSE DEFAULTED OFF, BUT OVERRIDABLE.

FPSTBL:
		FPSOKM		;!  /-! => KEEP MISSING FILES; /1! => LOSE THEM; /0! => KEEP AFTER ASKING
		FPSHED		;"  /-" => SET SPACE DEVOTED TO PER-PAGE HEADINGS
		FPSNLN		;#  SUPPRESS LINE NUMBERS WITHIN PAGE
		FPSNST		;$  SUPPRESS SYMBOL TABLE (PER-FILE)
		FPSDAT		;%  DATE IN HEADING
		FPSNBG		;&  SUPPRESS BIGPRINT AND PAGE MAP
REPEAT 2,	FPSBAD		;' (
		FPNAME		;)  END SWITCH LIST
REPEAT 2,	FPSBAD		;* +
		FPSWS		;,  IGNORE
		FPSNEG		;-  NEG NUMBER
REPEAT 2,	FPSBAD		;. /
REPEAT 10.,	FPSDIG		;0-9
		FPSAUX		;:  MAKE THIS FILE AUXILIARY.
REPEAT 2,	FPSBAD		;; <
		FPSNOR		;=  NO REAL FILENAMES IN LREC
		FPSSOR		;>  SORT FILE NAMES
		FPSBAD		;?
		FPSLRC		;@  LREC FILE(S)
		FPSARB		;A  ARBITRARILY LONG SYMBOLS
		FPSBAD		;B
		FPSCRF		;C  MAKE CREF TABLE AT END OF LISTING.
		FPSDEV		;D  SPECIFY PRINTING DEVICE AND WHETHER TO QUEUE
		FPSDBL		;E  CROSS FILE REFS ABBREVIATED FILE NAME
		FPSFNT		;F  SPECIFY FONTS
		FPSUSF		;G  GO THROUGH LREC FILE TO .INSRT FILES MENTIONED. IMPLIES /@.
		FPSBS		;H  /H => ^H OUT AS REAL BACKSPACE; /-H => OUTPUT AS UPPARROW-H
		FPSINS		;I  /I => LIST ALL .INSRT ED FILES
		FPSRLS		;J  CONTROLS RELISTING OF UNCHANGED PAGES.
		FPSLNM		;K  (DEC VERSION) PRINT LSN'S AS PART OF TEXT.
		FPSLNG		;L  FOLLOWED BY NAME OF LANGUAGE FILES ARE IN.
		FPSMAI		;M  THIS IS MAIN FILE; KEY LREC FILE FN2 TO IT (IF /G USED).
				;   OR SET MARGINS
		FPSNRF		;N  OMIT CROSS REFERENCES
		FPSOLD		;O  SUPPRESS OUTPUT OF LISTINGS (BUT NOT OF LREC FILE)
				;   OR SET OUTPUT FILE NAME DEFAULTS
		FPSMNP		;P  (PER-FILE) SPEC PAGE TO START LISTING AT.
		FPSCPY		;Q  QOPYRIGHT MESSAGE
		FPSCR		;R  STRAY CR S OUTPUT AS UP-ARROW-M IF -, OVERSTRIKE IF +
		FPSSNG		;S  ONLY ONE OUTPUT FILE
		FPSTRN		;T  -T => CONTINUE; 1T => TRUNCATE; 0T => NEITHER.
		FPSUNV		;U  /U => /-U => UNIVERSAL SYM TAB AFTER EACH FILE
		FPSPGL		;V  ARG SETS PAGE LENGTH OR XGP VSP
		FPSLNL		;W  ARG SETS LINE LENGTH
		FPSXGP		;X  OUTPUT TO XGP
		FPSREL		;Y  PRINT REAL PAGE #S, NOT VIRTUAL.
		FPSSBT		;Z  SUBTITLES TABLE OF CONTENTS
REPEAT 3,	FPSBAD		;[ \ ]
		FPSCTL		;^  OUTPUT CTL CHARS AS THEMSELVES, NOT USING UPARROWS.
		FPSDLR		;_  CALL DLREC TO DESCRIBE LREC FILE.


IFN .-FPSTBL-77,	.ERR WRONG LENGTH TABLE

SUBTTL	FILE NAME AND SWITCH DEFAULTING

FPDEF:	MOVSI C,'FOO		;DEFAULT FILE NAME 1
	MOVSI B,'DSK		;AND DEVICE.
ITS,	.SUSET [.RSNAM,,N]	;DEFAULT INPUT SNAME IS OUR CURRENT SNAME.
NOITS,	SETZ N,
SAI,	DSKPPN N,
	MOVEM N,MSNAME
	MOVEI A,FILES
FPDEF0:	MOVE CH,F.SWIT(A)
	TRNE CH,FSLREC		;LISTING RECORD FILES DEFAULT SPECIALLY.
	 JRST FPDLR
	SKIPE F.IFN1(A)		;DEFAULT THE INPUT FN1, DEV AND SNAME.
	 MOVE C,F.IFN1(A)
	SKIPN F.IFN1(A)
	 MOVEM C,F.IFN1(A)
	SKIPN F.IDEV(A)
	 MOVEM B,F.IDEV(A)
FPDEF2:	MOVE B,F.IDEV(A)
	CAMN B,[SIXBIT /NONE/]	;DEVICE NONE: MEANS LOSE THIS FILE
	JRST [	MOVEI B,FSNOIN
		IORM B,F.SWIT(A)
		MOVSI B,'DSK
		JRST FPDEF1 ]
	TRNE CH,FSARW
	 SKIPE L
	  CAIA
	   MOVSI L,'DSK
	SKIPN F.ISNM(A)
	 MOVEM N,F.ISNM(A)
	MOVE N,F.ISNM(A)
	TRC CH,FSARW\FSQUOT	;DON'T OPEN AN OUTPUT-ONLY FILE FOR INPUT.
	TRCE CH,FSARW\FSQUOT
	 TRNE CH,FSNOIN		;IGNORE '' FILES.
	  JRST FPDEF1
	SKIPLE OLDFL		;IN LREC EDIT MODE, DON'T TRY OPENING FILES.
	 JRST [	SKIPE F.OSNM(A)	;IN LREC FILE EDIT MODE, PERFORM BIDIRECTIONAL
		 MOVE N,F.OSNM(A)
		SKIPE F.ISNM(A)	;DEFAULTING OF NORMAL FILE SNAMES.
		 MOVE N,F.ISNM(A)
		SKIPN F.OSNM(A)
		 MOVEM N,F.OSNM(A)
		SKIPN F.ISNM(A)
		 MOVEM N,F.ISNM(A)
		JRST FPDEF3 ]
	PUSHJ P,FPDFN2		;OTHERWISE, DEFAULT THE FN2 IF NECESSARY, AND OPEN THE FILE.
	 JRST 1+[JRST FPDEF2
		FLOSE UTIC,F.ISNM(A)
		JFCL ERRDIE]	; Was FPDEF3, but needs a real file for
				; FPRCHS to have any hope of working!
FPDEF3:	MOVE CH,[UTIC,,CHSTAT]
	PUSHJ P,FPRCHS		;DO .RCHST, SET UP F.RDEV, ETC.
DOS,	CLOSE UTIC,20		;ON TOPS-10, TRY TO SAVE THE NAME BLOCKS, ETC.
TNX,	.CLOSE UTIC,
ITS,[	.CLOSE UTIC,
	MOVE CH,F.RFN2(A)
	CAMN CH,OPTFN2+DEVIXG	;IF FOO > TURNS OUT TO BE FOO @XGP, THE LUSER IS LOSING.
	 JRST 1+[JRST FPDEF2	;IF HE RESPECIFIES IT, GO PROCESS WHAT HE GAVE.
		FLOSEI FLSOIN,F.ISNM(A)
		JFCL ERRDIE ]	;IF HE REFUSES, COMMIT SUICIDE.
];ITS
FPDEF1:	ADDI A,LFBLOK		;OUTPUT FN2 WILL BE DEFAULTED IN 2LOOP
	CAMGE A,SFILE
	 JRST FPDEF0
	POPJ P,

;OPEN THE FILE SPECIFIED BY F.IDEV(A), ETC., ON UTIC, FOR BLOCK ASCII INPUT.
;IN THE PROCESS, DEFAULT THE FN2.  SKIPS IF SUCCESSFUL.
FPDFN2:	MOVEI R,.BAI		;USE ASCII BLOCK INPUT FOR OUR OPENS.
	SKIPE F.IFN2(A)
	 JRST FPDFN3
NOITS,[	PUSHJ P,2INOPN		;TRY NULL EXTENSION, THEN TRY THE DEFAULT.
	 CAIA
	  JRST POPJ1		;NULL WORKED, SO RETURN -- FILE ALREADY OPEN.
	MOVE H,CODTYP
	MOVE H,IPTFN2(H)	;NOITS, DEFAULT FN2 IS APPROPRIATE TO LANGUAGE.
];NOITS
ITS,[	SKIPN TEXGPP
	 SKIPA H,IPTFN2		;ON ITS, IT IS USUALLY >, BUT FOR /L[TEXT]/X IT IS XGP.
	  MOVSI H,'XGP
];ITS

	MOVEM H,F.IFN2(A)
FPDFN3:
DOS,	HLLZS F.IFN2(A)		;DEFAULTING'S PAST, SO FLUSH THE RH "FOO." USES TO AVOID IT.
	JRST 2INOPN		;IF IT SKIPS, WE DO TOO!

;DEFAULT DIRECTORY OF LREC FILE.
;NOTE OUTPUT FN2 DEFAULTED IN WLREC. INPUT FN2 DEFAULTED IN RLREC.
FPDLR:	SKIPE F.OFN1(A)		;PERFORM BIDIRECTIONAL DEFAULTING OF
	 MOVE C,F.OFN1(A)	;OUTPUT AND INPUT FN1'S.
	SKIPE F.IFN1(A)
	 MOVE C,F.IFN1(A)
	SKIPN F.OFN1(A)
	 MOVEM C,F.OFN1(A)
	SKIPN F.IFN1(A)
	 MOVEM C,F.IFN1(A)
	SKIPN H,F.ODEV(A)	;PERFORM BIDIRECTIONAL DEFAULTING OF
	 SKIPE H,F.IDEV(A)	;OF DEVICE NAME.
	  CAIA
	   MOVSI H,'DSK
	SKIPN F.ODEV(A)
	 MOVEM H,F.ODEV(A)
	SKIPN F.IDEV(A)
	 MOVEM H,F.IDEV(A)
	SKIPN H,F.OSNM(A)	;PERFORM BIDIRECTIONAL DEFAULTING OF
	 SKIPE H,F.ISNM(A)	;OF SNAME.
	  JRST FPDLA2
ITS,	.SUSET [.RSNAM,,H]
SAI,	DSKPPN H,
FPDLA2:	SKIPN F.OSNM(A)
	 MOVEM H,F.OSNM(A)
	SKIPN F.ISNM(A)
	 MOVEM H,F.ISNM(A)
	JRST FPDEF1

;ATTEMPT TO DETERMINE THE LANGUAGE A FILE IS WRITTEN IN FROM ITS FN2.
;ON ITS, THAT ONLY WORKS FOR FN2 = XGP.  OFF ITS, IT WORKS FOR MOST LANGUAGES.
FPDLNG:	MOVEI A,FILES-LFBLOK
FPDLN3:	ADDI A,LFBLOK
	SKIPN ECODTYP
FPDLN0:	 CAML A,SFILE
	  JRST DECODT
	MOVE H,F.SWIT(A)
	TRNN H,FSNOIN+FSLREC	;LREC FILES AND IGNORED FILES SHOULDN'T BE CONSIDERED.
	 SKIPN H,F.IFN2(A)	;CAN'T DO ANYTHING IF FN2 NOT SPECIFIED.
	  JRST FPDLN3
ITS,[	CAME H,['XGP,,]
	 JRST FPDLN1
	MOVEI R,CODTXT
	JRST FPDLN2

FPDLN1:	PUSHJ P,FPDLNE
	 JRST FPDLN3
	MOVEM R,CODTYP		;UNLIKE FN2 OF XGP, -*-TEXT-*- DOES NOT IMPLY /X.
	XCT FPDLNT(R)		;THAT IS WHY WE DON'T JUST GO TO FPDLN2 HERE.
	 JRST DECODT
	JRST DECODT
];ITS
NOITS,[	MOVEI R,CODMAX-1	;BOTS, FN2 = MID IMPLIES MIDAS (CODMID), ETC.
FPDLN1:	CAMN H,IPTFN2(R)
	 JRST FPDLN2
	SOJGE R,FPDLN1
	 JRST FPDLN3
];NOITS
FPDLN2:	MOVEM R,CODTYP		;HERE TO STORE THE DETERMINED CODTYP AND SAY IT WAS SPECD.
	XCT FPDLNT(R)		;GET SWITCH DEFAULTS FOR THAT CODTYP.
	 JRST DECODT		;SKIPS ONLY FOR CODTXT
	SKIPN ENXFDSP
	 SETOM NXFDSP		;THEN WE ALSO WANT /-!
XGP,	TLO F,FLXGP		;AND /X
DECODT:	SKIPL R,CODTYP		;SET THE DECODED LANGUAGE FLAGS
	 CAIL R,CODMAX
	  .VALUE
	XCT MAPCOD(R)
	POPJ P,


;THIS TABLE CONTAINS THE DEFAULT SWITCH SETTINGS FOR EACH LANGUAGE KNOWN TO @.
FPDLNT:	OFFSET -.
CODMID:: JFCL
CODRND:: JFCL
CODFAI:: TLO F,FLCTL
CODP11:: TLO F,FL2REF
CODLSP:: TLO F,FLARB\FLASCI
CODM10:: JFCL
CODUCO:: TLO F,FLARB
CODTXT:: CAIA
CODMDL:: TLO F,FLARB\FLASCI
CODDAP:: JFCL
CODMAX:: OFFSET 0


;THIS TABLE CONTAINS THE CODE TO SET THE DECODED LANGUAGE FLAGS.
MAPCOD:	OFFSET -.
CODMID:: JFCL
CODRND:: HRRZM P,TEXTP
CODFAI:: SETOM FAILP
CODP11:: SETOM PALX11
CODLSP:: JFCL
CODM10:: HRRZM P,FAILP
CODUCO:: JFCL
CODTXT:: SETOM TEXTP
CODMDL:: JFCL
CODDAP:: SETOM DAPXP
CODMAX::OFFSET 0

ITS,[

;TRY TO FIGURE OUT A FILE'S LANGUAGE FROM ITS "PROPERTY LIST" ( -*-FOO-*-).
;A SHOULD POINT AT THE FILE BLOCK.
;SKIP IF SUCCESSFUL, WITH CODTYP VALUE IN R.
FPDLNE:	MOVEI R,.BAI
	PUSHJ P,2INOPN
	 POPJ P,
	PUSHJ P,2RDAHD
	PUSHJ P,DOINPT
	 POPJ P,
FPDLN4:	1GETCH			;SKIP INITIAL BLANK LINES.
	CAIN CH,40
	 JRST FPDLN4
	CAIE CH,^M
	 CAIN CH,^J
	  JRST FPDLN4
	JRST FPDLN6

FPDLN5:	1GETCH			;SCAN THIS LINE FOR -*-.
FPDLN6:	CAIE CH,^M		;GIVE UP AT END OF LINE OR END OF BUFFER.
	 CAIN CH,^C
	  POPJ P,
	CAIE CH,"-
	 JRST FPDLN5
	1GETCH
	CAIE CH,"*
	 JRST FPDLN6
	1GETCH
	CAIE CH,"-
	 JRST FPDLN6		;READ THE WORD THAT FOLLOWS THE -*-.
	PUSHJ P,FPRDSX
	 POPJ P,
	CAIE CH,":		;TERMINATED BY A COLON => IT OUGHT TO BE "MODE:".
	 JRST FPDLN7		;OTHERWISE IT IS ITSELF THE MODE NAME.
	CAMN H,[SIXBIT /MODE/]
	 PUSHJ P,FPRDSX		;"MODE:" => READ THE MODE NAME WHICH FOLLOWS.
	  POPJ P,
FPDLN7:	SETO R,
	CAMN H,[SIXBIT /LISP/]
	 MOVEI R,CODLSP
	CAMN H,[SIXBIT /MUDDLE/]
	 MOVEI R,CODMDL
	CAMN H,[SIXBIT /MIDAS/]
	 MOVEI R,CODMID
	CAMN H,[SIXBIT /TEXT/]
	 MOVEI R,CODTXT
	SKIPL R
	 AOS (P)
	POPJ P,

;READ A SIXBIT WORD INTO H FROM THE FILE VIA 1GETCH.
;SKIPS LEADING BLANKS.  DOES NOT RELOAD AT END OF BUFFER.
;FAILS TO SKIP IF END OF BUFFER OR A ^C IN THE FILE IS SEEN.
FPRDSX:	1GETCH
	CAIN CH,40
	 JRST FPRDSX
	SETZ H,
	MOVE R,[440600,,H]
FPRDS2:	CAIN CH,^C
	 POPJ P,
	CAIE CH,";
	 CAIN CH,40
	  JRST POPJ1
	CAIE CH,"-
	 CAIN CH,":
	  JRST POPJ1
	CAIL CH,140
	 SUBI CH,40
	SUBI CH,40
	TLNE R,770000
	 IDPB CH,R
	1GETCH
	JRST FPRDS2
];ITS

;DEDUCE SOME THINGS FROM THE SWITCH SETTINGS,
;DEFAULT SOME SWITCHES FROM EACH OTHER, ETC.
;AFTER ALL OTHER SOURCES OF INFORMATION ARE EXHAUSTED, INCL. LREC FILE.

FPDDED:	MOVE A,DEVICE		;FIX UP DEVICE AS NEEDED
	SKIPN EDEVICE
	 SKIPE LNLDOT(A)	;IF OUR DEFAULT (NOT SPECIFIED) IS A CHARACTERS-ONLY DEVICE
	  JRST FPDDE1
XGP,[	TLNN F,FLXGP		;BUT /X IS SPECIFIED,
	 JRST FPDDE1
	MOVEI A,DEVXGP		;THEN USE THE XGP.
	MOVEM A,DEVICE
];XGP
FPDDE1:	SKIPG B,FRCXGP(A)	;IF THE DEVICE IS XGP
	 JRST FPDDE2
	HRREM B,XGPP
	SKIPGE TEXTP		;IF /L[TEXT]
	 SETOM TEXGPP		;SET FLAG FOR SPECIAL MODE OF PARSING XGP FILES.
FPDDE2:
PRESS,[	JUMPGE B,FPDDE3
	HRREM B,PRESSP
	SKIPGE TEXTP
	 JRST [	STRT [ASCIZ */L[Text]/D[Dover] is not implemented yet.
*]
		JRST ERRDIE]
	SETOM FNTSPC		;FOR THE DOVER, FONTS ARE ALWAYS "EXPLICITLY SPECIFIED".
CMU,	MOVE A,[SIXBIT/SAILA/]
TNX,	MOVE A,[SIXBIT/SAIL/]
SAI,	MOVE A,[SIXBIT/SAIL/]
NOCMU,NOSAI,NOTNX,MOVSI A,(SIXBIT /LPT/)
	MOVEI B,8.
	MOVEI L,FNTF0
FPDDE4:	CAIN L,FNTF0+FNTFL
	 TLNE F,FLFNT2+FLFNT3
	  CAIN L,FNTF0+2*FNTFL
	   TLNE F,FLFNT3
	    SKIPE FNTSNM(L)	;DEFAULT EACH UNSPECIFIED FONT WHICH IS IN USE
	     JRST FPDDE5
	MOVEM A,FNTSNM(L)
	SETZM FNTDEV(L)
	SETZM FNTFN1(L)
	MOVEM B,FNTFN2(L)
	SETOM FNTID(L)		;PRETEND FONT WAS EXPLICITLY SPEC'D
	SETOM EFNTF		;SO THAT WE READ THE WIDTH FROM THE FONTS WIDTHS FILE.
FPDDE5:	ADDI L,FNTFL
	CAIE L,FNTFE
	 JRST FPDDE4
FPDDE3:
];PRESS
	POPJ P,

;FILL F.RSNM, F.RDEV, F.RFN1 AND F.RFN2 WITH THE "REAL" NAMES OF THE
;FILE OPEN ON THE CHANNEL IN LH(CH), AS OPPOSED TO THE NAMES SPEC'D
;IN THE OPEN. ALSO, ADD FILE'S LENGTH INTO LFILES.
;ALSO PUT THE FILE'S CREATION DATE AND TIME INTO F.CRDT(A).
FPRCHS:	PUSH P,B
	MOVE B,LFILE
	CAMN B,[377777,,777777]	;IF FILE'S LENGTH ISN'T KNOWN,
	 MOVEI B,4000		;ASSUME THIS VALUE.
	ADDM B,LFILES		;ADD TOGETHER ALL FILES' LENGTHS IN LFILES.
	SETZM F.CRDT(A)
	HLRZS CH
ITS,[	SYSCAL RFNAME,[ CH ? %CLOUT,,F.RDEV(A) ? %CLOUT,,F.RFN1(A)
				%CLOUT,,F.RFN2(A) ? %CLOUT,,F.RSNM(A)]
	 .LOSE %LSFIL
;; NOW GET THE FILE CREATION DATE.
	SYSCAL RFDATE,[ CH ? %CLOUT,,F.CRDT(A)]
	 JFCL
];ITS
TNX,[	
	PUSH P,A ? PUSH P,B ? PUSH P,C ? PUSH P,D
	PUSH P,L
	MOVEI L,F.RSNM(A)	; Set up pointer
	MOVE A,JFNCHS(CH)	; Get JFN for channel
	CALL UNJFN		; Store in 6bit
	POP P,L
T20,	MOVE B,[1,,.FBCRE]	; Get day/time of last write to file
10X,	MOVE B,[1,,.FBWRT]	; This is 10X equivalent.
	MOVEI C,F.CRDT
	ADD C,-3(P)		; F.CRDT(A)
	GTFDB			; Get GTAD format creation date
	POP P,D ? POP P,C ? POP P,B ? POP P,A
]

DOS,[	LSH CH,LGEXTL
	LDB B,[001400,,INFIL-<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