Google
 

Trailing-Edge - PDP-10 Archives - scratch - 10,7/unscsp/dump/dump.mac
There are 7 other files named dump.mac in the archive. Click here to see a list.
00010	TITLE DUMP - PROGRAM TO DUMP ARBITRARY FILES IN PRINTABLE FORMAT
00020	SUBTTL DON BLACK/DAL  - VERSION 4 - 12 AUGUST 1972
00030	;COPYRIGHT (C) 1974,1978,1979 BY
00040	
00050	;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
00060	;
00070	;
00080	;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
00090	;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
00100	;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
00110	;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
00120	;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
00130	;TRANSFERRED.
00140	;
00150	;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
00160	;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
00170	;CORPORATION.
00180	;
00190	;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
00200	;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
00205	
00210	VWHO==0		;WHO LAST EDITED THIS PROGRAM
00220	VDUMP==4	;VERSION OF DUMP
00230	VPATCH==0	;PATCH LETTER
00240	VEDIT==232	;EDIT NUMBER
00250	
00260		LOC	137
00270		BYTE	(3)VWHO(9)VDUMP(6)VPATCH(18)VEDIT
00280		XALL
00290		TWOSEG
00300		RELOC	400000
00310	
00320	;AC'S
00330	
00340	SF=0		;SCANER FLAGS
00350	T1=1		;TEMP AC'S
00360	T2=2		; ..
00370	T3=3		; ..
00380	T4=4		; ..
00390	P1=5		;PRESERVED AC'S
00400	P2=6		; ..
00410	N=7		;HOLDS A NUMBER
00420	C=10		;HOLD A CHARACTOR
00430	M=11		;MESSAGE POINTER
00440	F=12		;FLAGS
00450	FM=13		;SCAN STORES MASKS IN HERE
00460	DL=14		;ANOTHER WORD OF FLAGS (NONE SET BY COMMAND SCANER)
00470	P=17		;PUSH DOWN POINTER
00480	
00490	;I/O CHANNELS
00500	
00510	IC==6		;INPUT FILE
00520	OC==7		;OUTPUT CHANNEL
00530	
00540	;EXTERNALS IN COMMAND SCANNER
00550	
00560		EXTERNAL	.FILIN,.GTSPC,.ISCAN,.MKPJN,.POPJ1,.SAVE2,.SAVE4
00570		EXTERNAL	.SIXSW,.TIALT,.TIAUC,.VSCAN,E.UKK
00580		EXTERNAL	.SWDPB,.NAME
00590	
00600		SEARCH C,SCNMAC
     
00010		SUBTTL	LOADING INSTRUCTIONS
00020	
00030	REPEAT 0,<
00040	
00050	IF YOU HAVE MACRO 47:
00060	
00070		.R PIP
00080		*T.MAC=TTY:
00090			%.C==-3
00100		^Z
00110		.LOAD T.MAC+<C.MAC,SCNMAC.MAC>,DUMP.MAC,SCAN.REL,HELPER.REL
00120	
00130	IF YOU HAVE MACRO 50 (OR LATER):
00140	
00150		.LOAD C.UNV+SCNMAC.UNV+DUMP.MAC,SCAN.REL,HELPER.REL
00160	
00170	>
     
00010		SUBTTL REVISION HISTORY
00020	
00030	;EDITS 2 THRU 157 IN NO SPECIAL ORDER:
00040	;
00050	;A) AC'S WERE CHANGED AS FOLLOWS:
00060	;	F WAS MOVED FROM 7 TO 12
00070	;	V WAS ELIMINATED
00080	;	N WAS MOVED FROM 14 TO 7
00090	;	M WAS MOVED FROM 15 TO 11
00100	;	C WAS MOVED FROM 16 TO 10
00110	;	FM WAS ADDED AS 13
00120	;	DL WAS ADDED AS 14
00130	;
00140	;B) ASCII AND SIXBIT OUTPUT MODES WERE REDEFINED AS FOLLOWS:
00150	;	ASCII IS A SINGLE RIGHT JUSTIFIED CHARACTER IF
00160	;		BITS 0 TO 28 ARE ALL ZERO. IT IS 5 LEFT JUSTIFIED
00170	;		CHARACTERS IF BITS 0 TO 28 ARE NON-ZERO. CONTROL
00180	;		CHARACTERS PRINT AS BLANKS.
00190	;	SIXBIT IS A SINGLE RIGHT ADJUSTED CHARACTER IF BITS 0
00200	;		TO 29 ARE ZERO. IF BITS 0 TO 29 ARE NOT ZERO
00210	;		IT IS TREATED AS 6 SIXBIT CHARACTERS.
00220	;
00230	;C) THE TDUMP COMMAND HAS BEEN IMPLEMENTED TO DUMP TO BOTH TTY: AND
00240	;	OUTPUT FILE.
00250	;
00260	;D) DEFINITION OF DOUBLE QUOTE HAS BEEN CORRECTED. IT WAS DEFINED AS
00270	;	41 SHOULD BE 42.
00280	;
00290	;E) MACRO DEFINITIONS WERE MOVED FROM DUMP.MAC TO SCNMAC.MAC.
00300	;
00310	;F) THE FOLLOWING SINGLE LETTERS WERE MADE TO MATCH COMMANDS:
00320	;	D IS UNIQUE FOR	DUMP
00330	;	I		INPUT
00340	;	M		MODE
00350	;	O		OUTPUT
00360	;	T		TDUMP
00370	;
00380	;G) TABLES AND CALLS WERE MODIFIED TO USE SCAN NOT SCANNER.
00390	;
00400	;H) A TABLE OF ABSENT DEFAULTS WAS BUILT FOR PRE-SETTING SWITCHES.
00410	;
00420	;I) THE FOLLOWING BUILT IN SYMBOLS HAVE BEEN CREATED:
00430	;	.	THE ADDRESS OF THE LAST WORD TYPED OUT.
00440	;	$	THE LAST BYTE TYPED OUT
00450	;	%	THE LAST VALUE THE EXPRESSION EVALUATOR RETURNED.
00460	;
00470	;J) DUMP NOW LOOKS FOR CCL FILES IN TMPCOR PRIOR TO LOOKING ON DISK.
00480	;
00490	;K) SCAN IS USED INSTEAD OF SCANNER
     
00010	;L) THE /TYPE SWITCH APPLIES TO EACH INPUT FILE SPECIFIED (INPUT
00020	;	FILE AND SYMBOL FILE)
00030	;
00040	;M) NUMBERS WERE CHANGED TO SYMBOLIC DEFINITIONS. SOME SYMBOLS
00050	;	ARE DEFINED IN C.MAC.
00060	;
00070	;N) THE TITLE COMMAND WAS MADE TO WORK
00080	;
00090	;O) POOR AND NON-WORKING CODE USED FOR STORING LISTS WAS CORRECTED.
00100	;
00110	;P) THE INPUT CHARACTER AC (C) HAS THE FOLLOWING POSSIBLE STATES:
00120	;	-2	END OF FILE
00130	;	-1	END OF LINE (LF-VT-FF)
00140	;	0	ESCAPE
00150	;	1-177	ASCII CHARACTER
00160	;
00170	;Q) A CASE WHERE DUMP WOULD LOOP FOREVER HAS BEEN CORRECTED. THIS WAS
00180	;	CAUSED BY THE INDEX OVERFLOWING.
00190	;
00200	;R) WIDTH, JUSTIFY, AND MODE LISTS WERE IMPLEMENTED.
00210	;
00220	;S) SPECIAL PATTERNS IN STRINGS NOW WORK CORRECTLY.
00230	;
00240	;T) QUOTED STRINGS NOW WORK CORRECTLY. THE FOLLOWING FIXES WERE INVOLVED:
00250	;	1) END OF LINE GETS YOU OUT OF QUOTED STRING MODE.
00260	;	2) ; HAS NO EFFECT IN A QUOTED STRING
00270	;	3) MULTIPLE SPACES AND TABS ARE PRESERVED
00280	;
00290	;U) " HAS BEEN ADDED AS AN OPERATOR MEANING TAKE THE LEFT HALF WORD
00300	;	AND MOVE IT TO THE RIGHT HALF EXTENDING THE SIGN BIT.
00310	;
00320	;V) CPOPJ HAS BEEN CHANGED TO .POPJ AND CPOPJ1 HAS BEEN CHANGED TO
00330	;	.POPJ1. BOTH ROUTINES HAVE BEEN MOVED TO SCAN.
00340	;
00350	;W) THE NUMERIC INPUT ROUTINE HAS BEEN FIXED TO WORK FOR NUMBER WHICH
00360	;	FILL ALL 36 BITS. PRIOR TO THIS FIX 777777777777(8) WAS
00370	;	CHANGED TO 377777777777(8) DURING OCTAL INPUT
00380	;
00390	;X) THE INPUT ROUTINES WERE CONVERTED TO READ A SYMBOL FILE.
00400	;
00410	;Y) FULL SUB-FILE DIRECTORY SUPPORT HAS BEEN ADDED.
00420	;
00430	;Z) JOBDAT SYMBOLS HAVE BEEN CHANGED FROM JOBXXX TO .JBXXX
     
00010	;AA) THE FILE READING ROUTINES READ THE FIRST BLOCK OF
00020	;	THE FILE. PRIOR TO THIS FIX IF THE FIRST WORD OF THE FILE
00030	;	WAS REQUESTED THE READ-IN ROUTINES WOULD THINK THE BLOCK
00040	;	WAS IN CORE AND RETURN ZERO.
00050	;
00060	;BB) THE OUTPUT FORMATTER HAS BEEN REWRITTEN TO FIX SEVERAL BUGS. IN ADDITION
00070	;	THE FOLLOWING EXTERNAL CHANGES HAVE BEEN MADE:
00080	;	1	"WORD NOT IN FILE" PRINTS INSTEAD OF "\\\\".
00090	;	2.	NEGATIVE ADDRESSES LIST AS SUCH.
00100	;	3	AFTER ATTEMPTING TO PRINT NXM A REFERANCE
00110	;		TO AN EXISTANT LOCATION MUST BE MADE TO TURN PRINTING
00120	;		BACK ON.
00130	;	4	RADIX 50 IS NOW A SUPPORTED MODE
00140	;	5	OCTAL NOW PRINTS IN FIXED FORMAT OF XXXXXX,XXXXXX
00150	;	6	A LINE IS NEVER SPLIT BETWEEN THE MINUS SIGN AND
00160	;		THE NUMBER.
00170	;	7	LOCATIONS MAY BE PRINTED OUT AS SYMBOLIC INSTRUCTIONS.
00180	;
00190	;CC) NEGATIVE NUMBERS PRINT OUT AS -NUMBER AND NOT A SEQUENCE OF SPECIAL
00200	;	CHARACTERS.
00210	;
00220	;DD) ADDRESS ARE NOW FOLLOWED BY /<TAB> NOT /<SPACE>
00230	;
00240	;EE) THE SYFILE COMMAND SPECIFIES A FILE FOR A SYMBOL TABLE.
00250	;
00260	;FF) THE XTRACT COMMAND READS THE SYMBOL FILE LOOKING FOR DDT'S
00270	;	SYMBOL TABLE POINTER AND EXTRACTING THE SYMBOL TABLE.
00280	;
00290	;GG) SYMBOLS ARE NOW ACCEPTED ON TYPE-IN. IF THE SYMBOL IS
00300	;	MULTIPLY DEFINED IT MUST BE PRECEDED BY A PROGRAM NAME.
00310	;	E.G. DUMP:EXPSYM
00320	;
00330	;HH) SYMBOLS ARE AVAILABLE FOR TYPE OUT IN SYMBOLIC INSTRUCTIONS.
00340	;
00350	;II) A PERMUTATION VECTOR IS COMPUTED FOR THE SYMBOL TABLE. THIS ALLOWS
00360	;	A BINARY SEARCH OF THE SYMBOL TABLE  WHEN LOOKING FOR A SYMBOL
00370	;	MATCHING A VALUE.
00380	;
     
00010	;EDITS NOT SPECIFICALY LISTED ARE PART OF THE EDIT NUMBER PRIOR TO
00020	;	THEM. E.G. EDIT CLOSED OUT IN MIDDLE TO RELOAD THE MONITOR
00030	;	USES 2 EDIT NUMBERS. THE EDIT NUMBER IS INCREMENTED EVERY
00040	;	TIME THE FILE IS EDITED.
00050	
00060	;EDITS AFTER 157:
00070	
00080	;160) ADD REVISION HISTORY
00090	
00100	;161) FIX LCHR TO HANDLE <TAB> CORRECTLY. PRIOR TO THIS EDIT IT
00110	;	CONSIDERED <TAB> A SINGLE PRINT POSITION.
00120	
00130	;162) MAKE 20 THRU 24 ILLEGAL IN A LISTING FILE. ONLY END OF LINE
00140	;	NOW VALID ARE FORM FEED, LINE FEED AND VERTICAL TAB.
00150	
00160	;163) MAKE FNDADR RETURN NXM IF ADDRESS IS NEGATIVE
00170	
00180	;164) REMOVE JUNK AFTER THE NOT IN FILE MESSAGE
00190	
00200	;165) SCAN SYMBOL TABLE FOR OPCODES AFTER TRYING BUILT
00210	;	IN TABLE
00220	
00230	;166) RELOAD T1 AFTER CALL TO VAL2SY IF WE WANT NUMERIC OUTPUT.
00240	
00250	;167) DO NOT OUTPUT NULLS
00260	
00270	;170) REMOVE LOC/ FROM BLANK LINES.
00280	
00290	;171)	CLEAN UP LISTING
00300	
00310	;172) IMPROVE FNDDAE TO:
00320	;	1. RETURN NXM IF ADDRESS IS .GT. 777777
00330	;	2. RETURN NXM IF ADDRESS IS BETWEEN LOW AND HIGH SEGS
00340	;	3. REMEMBER FIRST 200 WORDS OF CORE IMAGE
00350	
00360	;173) MORE OF 172
00370	
00380	;174) ADD CODE TO MAKE LOOKING FOR A DAEMON CATEGORY INDEPENDENT
00390	;	OF THE ORDER IN WHICH THE CATEGORIES ARE WRITTEN
00400	
00410	;200) CLEANUP NXM MESSAGE, FIX BAD LOGIC, RANDOM FIXES
00420	;	TO THE LISTING.
00430	
00440	
00450	;203) AC'S DO NOT CONTAIN THE RIGHT VALUES. BUFFER IS REMEMBERED FROM
00460	;	SYMBOL FILE WHICH IS NOT RIGHT. FIX: DO NOT LOAD BUFFER DURING
00470	;	XTRACT COMMAND.
00480	
00490	;204) ILL MEM REF AT CMPRED CAUSED BY CALLING CMPRED WRONG. FIX:
00500	;	CALL CORRECTLY AND FIX THE COMMENTS ON CMPRED.
     
00010	;205) PART OF LISTING MISSING. ADD A LIST PSEUDO-OP
00020	
00030	;206) THE PRESENT DEFAULTS HAVE BEEN CHANGED FOR SEVERAL
00040	;	COMMANDS. THE NEW PRESENT DEFAULTS ARE:
00050	;	ADDRESS		ON
00060	;	AUTOFORMAT	ON
00070	;	NUMPAGE		1
00080	;	NOTE: A PRESENT DEFAULT IS THE DEFAULT WHEN
00090	;	      THE SWITCH IS GIVEN WITHOUT AN ARGUMENT.
00100	
00110	;207) INPUT, OUTPUT, SYFILE ETC. WITHOUT AN ARGUMENT
00120	;	ARE NOW IGNORED. PRIO TO THIS EDIT THEY
00130	;	CAUSED A HALT.
00140	
00150	;210) THE CLOSE COMMAND NOW CLEARS THE FILE OPEN BIT. IT
00160	;	ALSO FORCES APPEND MODE.
00170	
00180	;211) THE ALL COMMAND CAN NOW BE TERMINATED BY AN <ESC>
00190	
00200	;212) FIX .HGH AND .SHR FILES TO DUMP CORRECTLY. THIS INVOLVES
00210	;	STARTING THE /ALL SWITCH AT THE RIGHT PLACE AND MAKING
00220	;	ALL ADDRESSES BELOW THE HISEG NXM.
00230	
00240	;214) " OPERATOR GIVEN MORE PRECEDENCE. ALSO HRL CHANGED
00250	;	TO HLR AS INTENDED.
00260	
00270	;215) DATRED NOW LOOKS FOR ERRORS
00280	
00290	;216) SOMETIMES THE NUMBERS DO NOT LINE UP. CRLF GETS OUTPUT
00300	;	IN PAD FIELD. CURE: SEE IF CRLF NEEDED AND
00310	;	PUT OUT FIRST IF IT IS REQUIRED AT ALL.
00320	
00330	;217) IF AN INPUT COMMAND IS GIVEN PRIOR TO A SYFILE
00340	;	COMMAND THE INPUT FILE NAME IS USED AS THE
00350	;	DEFAULT FOR XTRACT.
00360	
00370	;220) 1B0 DOES NOT GET OUTPUT CORRECTLY. FIX: MAKE RADIX
00380	;	PRINTER ADD ONE SO MOVM WILL RETURN
00390	;	A POSITIVE NUMBER.
00400	
00410	;221) TITLES DO NOT WORK QUITE RIGHT. FIX: MAKE THE
00420	;	SPECIAL PATTERN <FF> CALL NEWPAG.
00430	
00440	;222) CALL OSCAN TO READ USER SPECIFIC DEFAULTS. THIS IS A FILE
00450	; 	IN THE USERS AREA CALLED SWITCH.INI WHICH CONTAINS A LIST
00460	;	OF SWITCHES ON A LINE BEGINING WITH DUMP:
00470	
00480	;223)	IGNORE SPACES NEXT TO &
     
00010	
00020	;224) IF A LINE ENDS IN THE MIDDLE OF A QUOTED STRING ^? SOMETIMES
00030	;	GETS PRINTED. FIX: TEST FOR END OF LINE MORE OFTEN. 
00040	;	***NOTE: A WELL FORMED STRING MUST END WITH A QUOTE.
00050	
00060	;225) CALLI'S DO NOT PRINT CORRECTLY. FIX: ADD DEVSTS TO TABLE.
00070	
00080	;226) IF AN I/O ERROR TOOK PLACE ON A CLOSE COMMAND USER GOT THE WRONG
00090	;	ERROR MESSAGE. FIX: TEST RIGHT HALF OF STATUS
00100	
00110	;227) ANY FILE WHICH IS LESS THAN 8 BLOCKS LONG AND IS NOT IN COMPRESSED
00120	;	FORMAT LOOKED ZERO WHEN THE FIRST WORD WAS EXAMINED. FIX: LOAD
00130	;	T1 WITH WORD FROM BUFFER PRIOR TO LOOKING FOR ERRORS. IF AN 
00140	;	ERROR TOOK PLACE IT WILL NOT CAUSE WRONG TYPEOUT.
00150	
00160	;230) THE XTRACT COMMAND DID NOT WORK CORRECTLY WITH MORE THAN 1 INPUT
00170	;	FILE. FIX: ADD CURRENT SIZE OF SYMBOL TABLE WHEN ASKING FOR
00180	;	CORE.
00190	
00200	;231) LEFTMARGIN WORKS ON TTY: NOT ON LPT:. DIAGNOSIS: LINE FEED COMES
00210	;	OUT AFTER SPACES. FIX: PUT OUT LINE FEED FIRST.
00220	
00230	;232) CHANGE MODE TO MODES IN COMMAND TABLE. REMOVE LISTAB.
00240	
00250	;REV::
00260	
     
00010		SUBTTL	PARAMETERS AND DEFAULTS
00020	
00030	
00040	;BIT POSITIONS FOR FLAGS WHICH MUST BE IN BYTE PTRS
00050	
00060	FP.ADDR==0		;BIT 0 IF ADDRESSES TO BE INCLUDED IN OUTPUT
00070	FP.APP==1		;BIT 1 IF TO APPEND TO OUTPUT
00080	FP.AUTO==2		;BIT 2 IF AUTOFORMATTING ON
00090	FP.INST==3		;BIT 3 IF INSTRUCTION MODE SELECTED
00100	FP.PROG==4		;BIT 4 IF PROGSYM ON
00110	FP.SUBT==5		;BIT 5 IF SUBTITLES REQUESTED
00120	
00130	;FLAGS LH F
00140	
00150	L.ADDR==(1B<FP.ADDR>)	;SET IF ADDRESSES TO BE OUTPUT
00160	L.APP==(1B<FP.APP>)	;SET IF APPEND TO OUTPUT FILE, CLEAR IF SUPERSEDE
00170	L.AUTO==(1B<FP.AUTO>)	;SET IF AUTOFORMATTING ON
00180	L.INST==(1B<FP.INST>)	;SET IF INSTRUCTION MODE SELECTED
00190	L.PROG==(1B<FP.PROG>)	;SET IF PROGSYM ON
00200	L.SUBT==(1B<FP.SUBT>)	;SET IF SUBTITLES REQUESTED
00210	L.TITL==(1B6)		;SET IF TITLE SPECIFIED
00220	L.IOPN==(1B7)		;SET IF INPUT FILE OPEN
00230	L.OOPN==(1B10)		;SET IF OUTPUT FILE OPEN
00240	L.IEOF==(1B8)		;SET IF EOF ON INPUT FILE
00250	;L.NAS==(1B9)		;SET IF OUTPUT NOT ASCII ONLY OR SIXBIT ONLY
00260	;L.ASCO==(1B11)		;SET IF OUTPUT IS ASCII
00270	;L.SIXO==(1B12)		;SET IF OUTPUT IS SIXBIT
00280	L.SYM==(1B13)		;SET IF AN OUTPUT MODE REQUIRES SYMBOL LOOKUP
00290	L.NXM==(1B14)		;SET IF TRIED TO FIND NON-EXISTENT LOCATION IN INPUT FILE
00300	L.ALLD==(1B15)		;SET IF DUMPING ALL OF INPUT FILE
00310	L.OTTY==(1B16)		;SET IF OUTPUT DEVICE IS A TTY
00320	L.TDMP==(1B17)		;SET IF OUTPUT TO TTY AND OUTPUT DEVICE
     
00010	;FLAGS RH F
00020	
00030	R.CON1==1B18		;SET IF DUMPING CONTENTS, NOT JUST ADDR
00040	R.ANY==1B19		;SET IF ANYTHING FOUND IN EXPEVA
00050	R.CMAL==1B20		;SET IF COMMA LEGAL (LEFT ANGLE BRACKET SEEN)
00060	R.CONB==1B21		;SET IF BYTE DESCRIPTOR WAS CONTENTS, NOT JUST ADDR
00070	R.RPN==1B22		;SET IN EXPRESSION EVALUATOR FOR RIGHT PAREN, ETC.
00080	R.CNT==1B23		;SET IF ONLY COUNTING CHARS, NOT OUTPUTTING
00090	R.SCNT==1B24		;SAVE COUNT BIT IN FORMAT SUBROUTINE
00100	R.OVR==R.CONB		;SET IF OUTPUT LINE OVERFLOWS RIGHT MARGIN
00110	R.LFD==R.CMAL		;SET IF LEADING LF LISTED IN OUTPUT SUBROUTINE
00120	R.FFD==R.RPN		;SET IF LEADING FF LISTED IN OUTPUT SUBROUTINE
00130	R.LKF==R.OVR		;USED IN OPEN OUTPUT ROUTINE
00140	R.LTAB==1B25		;USED IN LISTING TABS
00150	R.NORE==1B26		;SET IN FORMAT ROUTINE TO PREVENT RECURSION
00160	R.PHED==1B27		;SET IF TO OUTPUT PAGE HEADER BEFORE NEXT CHAR
00170	R.LHED==1B28		;SET IF TO OUTPUT LINE HEADER BEFORE NEXT CHAR
00180	R.MARS==1B29		;SET IF TO OUTPUT SPACES FOR LEFT MARGIN
00190	R.RLH==1B30		;REMEMBERS R.HED IN PAGE HEADER SUBROUTINE
00200	
00210	;FLAGS IN LH OF DL
00220	
00230	DL.JUS==(1B1)		;SET IF END OF JUSTIFY LIST NOT YET SEEN
00240	DL.WID==(1B2)		;SET IF END OF WIDTH LIST NOT YET SEEN
00250	DL.SYM==(1B3)		;SET IF READING SYMBOL FILE NOT SAVE FILE
00260	DL.FBR==(1B4)		;SET IF WE NEED TO SORT SYMBOL TABLE
00270	DL.PNF==(1B5)		;USED TO SCAN SYMBOL TABLE WHEN GOING
00280	DL.MDL==(1B6)		; FROM SYMBOLIC TO BINARY
00290	DL.SNF==(1B7)		;FLAG SET WHEN DOING BINARY SCAN AND SYMBOL
00300				; IS NOT FOUND (USED TO PREVENT LOOP)
00310	DL.NBR==(1B8)		;FLAG SET IF LAST CALL TO VALUE SYMBOL CONVERTER
00320				; (VAL2SY) GAVE ERROR RETURN.
00330	DL.NXM==(1B9)		;<NXM> OUTPUT
00340	DL.TR5==(1B10)		;SET TO 1 WHEN SCANING SYMBOL TABLE AND AN
00350				; UNDEFINED SYMBOL IS SEEN. IT CAUSES RADIX50
00360				; GENERATOR TO OUTPUT TO TTY:.
00370	DL.XCT==(1B11)		;SET TO 1 IF ONLY AN EXACT MATCH WILL DO
00380				; WHEN TYPING OUT SYMBOLS
00390	DL.ANXM==(1B12)		;SET IF USER DID A CORE ZERO, DCORE.
00400	DL.SYF==(1B13)		;SET BY SYFILE
     
00010	;MISC
00020	
00030		ND	PDLEN,200
00040		ND	LN.DRB,6
00050		ND	WINSIZ,2000
00060		ND	FBMTIM,5
00070		ND	EC.FBM,3
00080		ND	POSSHF,^D30
00090	
00100	PHLINS==4	;NUMBER OF LINES OUTPUT IN PAGE HEADER
00110		ND	MINLPG,PHLINS	;MINIMUM NUMBER OF LINES PER PAGE
00120	IFL MINLPG-PHLINS-1,<MINLPG==PHLINS+1 ;MUST NOT BE LESS THAN LINES IN PAGE HEADER+1>
00130	
00140	;DAEMON CATEGORIES
00150	
00160	CA.JOB==1	;JOB INFORMATION
00170	CA.CNF==2	;CONFIGURATION TABLE
00180	CA.DDB==3	;DDB'S
00190	CA.COR==4	;USER'S CORE
00200	
00210		ND	CA.MAX,4
00220	
00230	;DEVCHR BITS
00240	
00250	DV.TTY==(1B5)		;TTY
00260	DV.DIR==(1B15)		;DIRECTORY DEVICE
00270	
00280	
00290	;FLAGS IN RADIX50 SYMBOLS
00300	
00310	ST.SPD==(1B0)	;IF 1 DO NOT TYPE OUT THIS SYMBOL
00320	ST.SPI==(1B1)	;IF 1 DO NOT MATCH ON INPUT
00330	ST.LCL==(1B2)	;IF 1 THIS IS A LOCAL
00340	ST.GLB==(1B3)	;IF 1 THIS IS A GLOBAL
00350	ST.PGM==(17B3)	;IF ALL 4 BITS ARE ZERO THIS IS A PROGRAM NAME
00360	ST.SIN==(5B3)	;GLOBAL WICH DOES NOT TYPE OUT
00370	ST.KIL==(14B3)	;TYPE $$K TO DDT ON THIS SYMBOL
     
00010	;ASCII CHARS
00020	
00030	C.LF==12	;LINE FEED
00040	C.VT==13	;VERTICAL TAB
00050	C.FF==14	;FORM FEED
00060	C.CR==15	;CARRIAGE RETURN
00070	C.ALT==33	;ALTMODE
00080	C.DQ==42	;DOUBLE QUOTE
     
00010	;DEFAULTS FOR VERB TABLES
00020	
00030	DM	ADR,ONOFOF,ONOFON,ONOFON
00040	DM	CAT,CA.MAX,CA.COR,CA.COR
00050	DM	INS,1,1,1
00060	DM	IRX,^D10,^D10,^D10
00070	DM	LMG,0,0,0
00080	DM	LNP,0,^D50,^D50
00090	DM	NPG,10000,0,1
00100	DM	ORX,^D10,^D8,^D8
00110	DM	PGL,0,^D50,^D50
00120	DM	RMG,0,^D60,^D60
00130	
00140	ND	AD.TYP,T.DATA
00150	
     
00010	;JUSTIFY KEYS
00020	
00030	J.LFT==0	;LEFT JUSTIFY
00040	J.CEN==1	;CENTER JUSTIFY
00050	J.RHT==2	;RIGHT JUSTIFY
00060	
00070	J.END==<1_J.S>-1	;END OF LIST MARKER
00080	
00090	J.S==2		;NUMBER OF BITS IN JUSTIFY FIELDS
     
00010	;MODES KEYS
00020	
00030		DEFINE	MODXM<
00040		MODXMC <NULL,ASCII,SIXBIT,RADIX5,OCTAL,SOCTAL,DECIMA,FLOAT,SYMBOL,SMART,NUMERI,ALL>
00050	>
00060	
00070		DEFINE	MODXMC(A)<
00080		ZZ==-1
00090		IRP A,<
00100		M.'A==<ZZ==ZZ+1>
00110	>>
00120		MODXM
00130	
00140	M.END==<1_M.S>-1	;END OF LIST MARKER
00150	
00160	M.S==4		;NUMBER OF BITS IN MODES FIELD
     
00010	;SUBTITLE KEYS
00020	
00030	SUBT.S==7		;STANDARD ASCII CHARACTER SIZE
00040	
00050	SUBT.E==0		;END OF SUBTITLE CHARACTER
00060	
00070	
00080	
00090	;TITLE KEYS
00100	
00110	TIT.S==7		;STANDARD ASCII CHARACTER SIZE
00120	
00130	TIT.EN==0		;END OF TITLE CHARACTER
     
00010	;TYPE KEYS FOR FILE TYPE
00020	
00030		DEFINE	TYPXM<
00040		TYPXMC <TMP,DAE,SHR,SAV,HGH,LOW,XPN,DMP,SDSK,DDIR,DECT,DATA>
00050	>
00060	
00070		DEFINE	TYPXMC(A)<
00080		ZZ==0
00090		IRP A,<T.'A==<ZZ==ZZ+1>>>
00100	
00110	;DEFINE TYPES
00120	
00130		TYPXM
00140	
00150	T.EEND==T.DMP	;END OF EXTENSIONS WHICH ARE ALSO TYPES
     
00010	;WIDTH KEYS
00020	
00030	W.END==<1_W.S>-1	;END OF LIST MARKER
00040	
00050	W.S==9		;NUMBER OF BITS IN WIDTH FIELDS
     
00010		DEFINE VERBSW<
00020	
00030	SP	ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
00040	SP	*ALL,,ALLDMP
00050	SS	APPEND,<POINT 1,F,FP.APP>,1
00060	SP	AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
00070	SP	BEGIN,,BEGIN
00080	SP	CATEGORY,CATNUM,CATRED,CAT
00090	SP	CLOSE,,CLSFIL
00100	SP	COFILE,C.ZER,CGTFIL
00110	SP	COMPARE,,CMPDMP
00120	SP	DELSYM,,DELSYM
00130	SP	DO,,DOPROC
00140	SP	*DUMP,,DMPBYT
00150	SP	EJECT,,EJECT
00160	SP	END,,ENDPRC
00170	SP	EXIT,,XIT
00180	SP	IF,,IFPROC
00190	SP	INDEX,,E.NIMP
00200	SP	*INPUT,I.ZER,IGTFIL
     
00010	SP	IOFFSET,,IOFPRC
00020	SP	INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
00030	SP	IRADIX,IRADIX,.SWDEC##,IRX
00040	SP	JUSTIFY,,JUSPRC
00050	SP	LEFTMARGIN,LMARGN,EXPSTO,LMG
00060	SP	LINEPAGE,LINPAG,LINPGS,LNP
00070	;SP	LISTAB,,LISPRC
00080	SP	*MODES,,MODPRC
00090	SP	NUMPAGE,PAGNUM,EXPSTO,NPG
00100	SP	OOFFSET,,OOFPRC
00110	SP	ORADIX,ORADIX,.SWDEC##,ORX
00120	SP	*OUTPUT,O.ZER,OGTFIL
00130	SP	PAGELIMIT,PAGLIM,EXPSTO,PGL
00140	SP	POP,,POPPRC
00150	SL	PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
00160	SP	PUSH,,PUSHPR
00170	SP	RIGHTMARGIN,RMARGN,EXPSTO,RMG
00180	SP	SKPBLOCKS,SBLOCK,EXPSTO
00190	SP	SKPFILES,SFILES,EXPSTO
     
00010	SP	SORT,,E.NIMP
00020	SS	SUBTITLE,<POINT 1,F,FP.SUBT>,1
00030	SS	SUPERSEDE,<POINT 1,F,FP.APP>,0
00040	SP	SYMBOL,,SYMPRC
00050	SP	SYFILE,S.ZER,SGTFIL
00060	SP	TABSYM,,TSYMPR
00070	SP	TCOMPARE,,TCMDMP
00080	SP	*TDUMP,,TDMBYT
00090	SP	TSORT,,E.NIMP
00100	SP	TITLE,,TITPRC
00110	SL	TYPE,F.ZER+%TYP,TYPE
00120	SP	WIDTH,,WIDPRC
00130	SP	XTRACT,,XPROC
00140	>	;END SWTCHS MACRO
00150	
     
00010	DEFINE	SWTCHS,<VERBSW>
00020		DOSCAN(VERB)
     
00010		RELOC
00020	IBUF:	BLOCK	200	;INPUT BUFFER (MUST BE HERE SO WE CAN PHASE CODE
00030				; INTO IT)
00040		RELOC
     
00010	;TABLE OF SWITCHES WHICH ARE LEGAL IN SWITCH.INI 
00020	; THIS SWITCHES MAY BE PLACED IN A FILE ON THE USERS AREA WHICH
00030	; WILL SET HIS USERS SPECIFIC DEFAULTS.
00040		DEFINE SWTCHS<
00050	
00060	SP	ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
00070	SS	APPEND,<POINT 1,F,FP.APP>,1
00080	SP	AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
00090	SP	CATEGORY,CATNUM,CATRED,CAT
00100	SP	INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
00110	SP	IRADIX,IRADIX,.SWDEC##,IRX
00120	SP	JUSTIFY,,JUSPRC
00130	SP	LEFTMARGIN,LMARGN,.SWDEC##,LMG
00140	SP	LINEPAGE,LINPAG,LINPGS,LNP
00150	SP	*MODES,,MODPRC
00160	SP	NUMPAGE,PAGNUM,.SWDEC##,NPG
00170	SP	ORADIX,ORADIX,.SWDEC##,ORX
00180	SP	PAGELIMIT,PAGLIM,.SWDEC##,PGL
00190	SL	PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
00200	SP	RIGHTMARGIN,RMARGN,.SWDEC##,RMG
00210	SS	SUPERSEDE,<POINT 1,F,FP.APP>,0
00220	SL	TYPE,F.ZER+%TYP,TYPE
00230	SP	WIDTH,,WIDPRC
00240	>	;END SWTCHS MACRO
00250	
00260	
     
00010		XALL
00020		DOSCAN	(OPTN)
00030		XALL
     
00010	
00020	;SPECIAL TABLE OF ABSENT DEFAULTS
00030	
00040		DEFINE	SL(A,B,C,D)<
00050		EXP	D	;DEFAULT FOR /'A
00060		>
00070	
00080		DEFINE	SP(A,B,C,D)<
00090		EXP	AD.'D	;DEFAULT FOR /'A
00100		>
00110	
00120		DEFINE	SS(A,B,C)<
00130		EXP	0	;DEFAULT FOR /'A
00140		>
00150	
00160		AD.==0
00170		XALL
00180	
00190	ABSTAB:	VERBSW
     
00010		DEFINE	SL(NAME,RESULT,TABLE,DEFAULT),<
00020		X NAME,TABLE'.T-1,<RESULT>,DEFAULT,-TABLE'.L
00030	>
00040	
00050		DEFINE SP(NAME,RESULT,PROCESSOR,ABBR),<
00060		X NAME,PROCESSOR,<RESULT>,PD.'ABBR,MX.'ABBR
00070	>
00080	
00090		DEFINE SS(NAME,RESULT,VALUE),<
00100		X NAME,0,<RESULT>,VALUE,0
00110	>
     
00010	;AND FINALLY, THE KEY-WORD VALUES
00020	
00030	KEYS	ONOF,<ON,OFF>
00040	KEYS	CATM,<JOB,CONFIG,DDB,CORE>
00050	KEYS	DENS,<0,2,5,8>
00060	KEYS	JUST,<LEFT,CENTER,RIGHT>
00070	KEYS	PARI,<,ODD,EVEN>
     
00010		DEFINE	TYPXMC(A)<
00020		XLIST
00030		IRP A,<SIXBIT \A\>
00040		LIST>
00050	
00060	TYPE.T:	TYPXM
00070	TYPE.L==.-TYPE.T
00080	
00090		DEFINE	MODXMC(A)<
00100		XLIST
00110		IRP A,<SIXBIT \A\>
00120		LIST>
00130	
00140	MODE.T:	MODXM
00150	MODE.L==.-MODE.T
00160	
00170	
     
00010	SUBTTL	BUILT-IN SYMBOLS
00020	
00030	;THIS IS A TABLE OF SPECIAL BUILT IN SYMBOLS. THE USERS SYMBOL TABLE
00040	; IS SEARCHED FOR THE SYMBOL AND IF IT IS NOT FOUND THE BUILT-IN TABLE
00050	; IS TRIED. THE S MACRO HAS 2 ARGUMENTS: THE FIRST IS THE SYMBOL AND
00060	; THE SECOND IS THE LOCATION WITHIN DUMP CONTAINING THE VALUE OF THAT
00070	; SYMBOL.
00080	
00090		DEFINE MSYM,<
00100		S	<.>,SAVE4.	;THE ADDRESS OF THE LAST WORD TYPED OUT
00110					; THIS IS THE LOCATION COUNTER.
00120		S	<$>,SAVE4$	;THE LAST BYTE TYPED OUT.
00130		S	<%>,SAVEXP	;THE LAST THE THE EXPERSSION EVALUATOR
00140					; RETURNED. THIS IS A SORT OF . IMMEDIATE
00150					; SO D UUOCON:UCLJMP&%+100 IS THE SAME AS
00160					; D UUOCON:UCLJMP&UUOCON:UCLJMP+100
00170	>
00180	
00190		XALL
00200		DEFINE	S(A,B),<
00210		RADIX50	0,A		;A IN RADIX50
00220	>
00230	
00240	MSYMTB:	MSYM			;BUILT-IN SYMBOL TABLE
00250	L.MSYM==.-MSYMTB
00260	
00270		DEFINE	S(A,B)<
00280		EXP	B		;POINTER TO VALUE OF A
00290	>
00300	MSYMAD:	MSYM
     
00010	SUBTTL	ROUTINE TO HANDLE EXPRESSION VALUED SWITCHES
00020	;SUBROUTINE TO GET AN EXPRESSION AND STORE
00030	;ARGS	P1=INDEX IN VERB TABLE
00040	
00050	EXPSTO:	HRRZ	T1,VERBD(P1)	;PICK UP DEFAULT
00060		SKIPE	T2,VERBP(P1)	;PICK UP STORAGE LOCATION
00070		DPB	T1,T2		;STOR DEFAULT IF WE KNOW WHERE
00080		PUSHJ	P,EXPEVA	;EVALUATE THE EXPRESSION
00090		HLRZ	T2,VERBM(P1)	;GET MAX LEGAL VALUE
00100		JUMPE	T2,EXPST1	;JUMP IF NO MAX
00110		CAMLE	T1,T2		;SKIP IF VALUE SPECIFIED .LE. MAX
00120		JRST	E.MAX		;NO. ERROR.
00130	EXPST1:	SKIPN	T2,VERBP(P1)	;GET THE POINTER
00140		POPJ	P,		;NONE.
00150		MOVE	N,T1		;N=VALUE TO BE STORED
00160		MOVEI	P2,[0
00170			    VERBP(P1)]
00180		PJRST	.SWDPB##	;STORE THE VALUE
     
00010	SUBTTL INITIALIZE
00020	
00030						;REPEAT FOR EACH SUPPORTED
00040						; ENTRY POINT.
00050	DUMP:	REPEAT	2,<JSP	T3,DUMPGO>	;T3 _ ADDRESS OF ENTRY
00060	DUMPGO:	SUBI	T3,DUMP+1	;CONVERT TO OFFSET
00070		HRRZM	T3,SAOFST#	;STORE FOR SCAN TO LOOK AT
00080		RESET
00090		MOVE	P,PDL		;SET UP PUSH DOWN LIST POINTER
00100	
00110	;HERE TO CLEAR CORE
00120	
00130		SETZB	F,ZER		;CLEAR FLAGS AND FIRST LOC OF CORE
00140		MOVE	T1,[XWD ZER,ZER+1]
00150		BLT	T1,EZER
00160	
00170	;HERE TO INIT SCANNER
00180	
00190		MOVE	1,[3,,[0
00200			   SAOFST,,'DMP'
00210			    0]]
00220		PUSHJ	P,.ISCAN	;CALL SCAN
00230	
00240	
00250	;HERE TO SCAN SWITCH.INI FOR USER SPECIFIC DEFAULTS
00260	
00270		SETZM	FM		;CLEAR THE MASK WORD
00280		MOVSI	P1,-OPTNL	;LENGTH OF OPTION TABLE
00290	OPTSET:	HLRZ	T1,OPTNP(P1)	;GET THE POINTER TYPE
00300		CAIN	T1,004400	;FULL WORD VALUE?
00310		SETOM	@OPTNP(P1)	;YES-- -1 IS FLAG FOR UNKNOWN
00320		AOBJN	P1,OPTSET	;LOOP OVER THAT TABLE
00330		MOVE	1,[4,,[IOWD OPTNL,OPTNN
00340			        XWD OPTND,OPTNM
00350				XWD 0,OPTNP
00360				EXP -1]]
00370		PUSHJ	P,.OSCAN##	;SCAN THE FILE
     
00010	;HERE TO STORE ABSENT DEFAULTS
00020	
00030		MOVSI	P1,-VERBL	;MINUS LENGTH OF VERB TABLES
00040	ABDEFS:	SKIPN	T1,VERBP(P1)	;GET THE POINTER
00050		JRST	ABDEF1		;IF NONE SKIP SWITCH
00060		MOVE	T3,@T1		;GET THE WORD WITH THE BYTE
00070		HLRZ	T2,T1		;GET THE SIZE PART
00080		CAIN	T2,004400	;IS IT A FULL WORD
00090		JRST	[AOJN T3,ABDEF1	;YES--JUMP IF KNOWN ALREADY
00100			 JRST ABDEF2]	; ELSE FILL IN DEFAULT
00110		AOS	T1		;BYTES HAVE A MASK WORD
00120		LDB	T1,T1		;GET THE MASK
00130		JUMPN	T1,ABDEF1	;SKIP IF FILLED IN
00140	ABDEF2:	MOVE	T1,ABSTAB(P1)	;ABSENT DEFAULT
00150		PUSHJ	P,EXPST1	;STORE DEFAULT
00160	ABDEF1:	AOBJN	P1,ABDEFS
00170	;HERE TO SET UP TABLES
00180	
00190		MOVSI	T2,-LSTTAB-1
00200		MOVE	T1,.JBFF	;FIRST AVAILABLE LOCATION
00210		MOVEM	T1,TABVEC(T2)	;STORE AS ORIGIN OF EACH TABLE
00220		AOBJN	T2,.-1
00230	
00240	;HERE TO SET UP IOWD'S
00250	
00260		MOVE	T1,[IOWD 200,IBUF]
00270		MOVEM	T1,INPLST
00280		MOVE	T1,[IOWD WINSIZ,WINDOW]
00290		MOVEM	T1,WINLST
00300	
     
00010	;HERE TO SET UP DEFAULTS
00020	
00030	OTDEFS:	TLO	F,L.ADDR+L.APP+L.AUTO+L.INST+L.PROG
00040		MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
00050		PUSHJ	P,MKPNTR
00060		MOVEI	P2,MODNDX	
00070		MOVEI	T1,M.OCTA	;OCTAL
00080		PUSHJ	P,STOBYT
00090		MOVEI	T1,M.END	;END OF LIST
00100		PUSHJ	P,STOBYT
00110		MOVE	P1,J.Y		;BYTE POINTER FOR JUSTIFY LIST
00120		PUSHJ	P,MKPNTR
00130		MOVEI	P2,JUSNDX	
00140		MOVEI	T1,J.END	;START WITH NULL LIST
00150		PUSHJ	P,STOBYT
00160	
00170		MOVE	P1,W.Y		;BYTE POINTER FOR WIDTH LIST
00180		PUSHJ	P,MKPNTR
00190		MOVEI	P2,WIDNDX	
00200		MOVEI	T1,W.END
00210		PUSHJ	P,STOBYT
00220	
00230		MOVSI	T1,(SIXBIT .LPT.) ;DEFAULT OUTPUT DEVICE
00240		MOVEM	T1,O.DEV
00250		MOVSI	T1,(SIXBIT .DSK.)
00260		MOVEM	T1,I.DEV	;INPUT DEFAULT IS DSK
00270		MOVEM	T1,S.DEV
00280		MOVEM	T1,C.DEV
00290		PJOB	T1,		;GET JOB NUMBER
00300		PUSHJ	P,.MKPJN	;CONVERT TO SIXBIT IN LH
00310		MOVS	T4,T1		;GET JOB NUMBER
00320		HRRI	T4,(SIXBIT .DAE.)
00330		MOVEM	T4,O.NAM	;DEFAULT OUTPUT NAME
00340		MOVEM	T4,I.NAM	;DEFAULT INPUT NAME
00350		MOVEM	T4,S.NAM	;DEFAULT SYMBOL NAME
00360		MOVEM	T4,C.NAM	;DEFAULT COMPARISON FILE NAME
00370		MOVSI	T1,(SIXBIT .LSD.)
00380		MOVEM	T1,O.EXT	;DEFAULT OUTPUT EXTENSION
     
00010	SUBTTL MAIN LOOP
00020	
00030	;HERE FOR MAIN LOOP - CALL COMMAND SCANNER
00040	
00050		MOVE	1,[6,,[IOWD VERBL,VERBN
00060				XWD VERBD,VERBM
00070				XWD 0,VERBP
00080				EXP -1
00090				XWD FAREAL,FAREA
00100				XWD 0,PAREA]]
00110		MOVEI	DL,I.ZER
00120		PUSHJ	P,.VSCAN
00130		JRST	XIT
     
00010	SUBTTL VERB PROCESSORS
00020	;SUBROUTINE TO READ FILE SPECIFIER AND STORE IN APPROPRIATE BLOCK
00030	
00040	IGTFIL:	TLZ	F,L.IOPN!L.IEOF	;NOTE INPUT NOT OPEN
00050		SETZM	I.DEV+%TYP	;ALLOW NEW TYP SPECIFICATION
00060		PUSHJ	P,GETFIL	;GO GET THE SPEC
00070		MOVEI	T2,S.ZER	;LOAD THE ADDRESS OF SYFILE BLOCK
00080		TLNN	DL,DL.SYF	;SYFILE COMMAND GIVEN?
00090		PJRST	CPYSPC		;NO--NEW DEFAULT
00100		POPJ	P,		;YES--NO CHANGE
00110	
00120	OGTFIL:	PUSHJ	P,CLSFIL	;CLOSE CURRENT OUTPUT FILE
00130		TLZ	F,L.OOPN!L.OTTY	;NOTE OUTPUT FILE NOT OPEN
00140		SETZM	LINNUM		;START AT TOP OF PAGE
00150		JRST	GETFIL
00160	
00170	SGTFIL:	TLO	DL,DL.SYF	;FLAG SYFILE GIVEN
00180	CGTFIL:
00190	GETFIL:	JUMPLE	C,.POPJ		;RETURN IF NULL SPEC
00200		PUSHJ	P,.FILIN	;READ FILE SPECIFIER
00210		MOVEI	T1,F.ZER	;POINT TO BLANK SPEC
00220		MOVEI	T2,F.LEN	;LENGTH OF SAME
00230		PUSHJ	P,.GTSPC	;BLT THE SPEC FROM SCAN
00240		HRRZ	T2,VERBP(P1)	;ADDR OF BLOCK TO STORE RESULT
00250	CPYSPC:	SKIPE	T1,F.ZER+%DEV	;SKIP IF NO DEVICE SPECIFIED
00260		MOVEM	T1,%DEV(T2)	;STORE DEVICE IN BLOCK
00270		SKIPE	T1,F.ZER+%NAM	;SKIP IF NO NAME SPECIFIED
00280		MOVEM	T1,%NAM(T2)	;STORE NAME IF BLOCK
00290		SKIPE	T1,F.ZER+%EXT	;SKIP IF NO EXT SPECIFIED
00300		MOVEM	T1,%EXT(T2)
00310		SKIPE	T1,F.ZER+%DIR	;SKIP IF DIRECTORY SPECIFIED
00320		MOVEM	T1,%DIR(T2)
00330		SKIPE	T1,F.ZER+%MOD
00340		MOVEM	T1,%MOD(T2)
00350		SKIPE	T1,%TYP+F.ZER
00360		MOVEM	T1,%TYP(T2)
00370		POPJ	P,
     
00010	INSTST:
00020	AUTOST:
00030	ADDRST:	SKIPA	T1,[IOWD ONOF.L,ONOF.T] ;PTR TO LIST FOR ON OR OFF
00040	CATRED:	MOVE	T1,[IOWD CATM.LT,CATM.T] ;PTR TO LIST OF CATEGORIES
00050	;	PJRST	LSTSTO		;FALL INTO LSTSTO
00060	
00070	;SUBROUTINE TO FIND A SWITCH VALUE IN A LIST
00080	;ARGS	T1=IOWD PTR TO LIST OF LEGAL SWITCHES
00090	
00100	LSTSTO:	MOVEM	T1,KEYPTR	;SAVE IOWD PTR TO LIST OF LEGAL VALUES
00110		HRRZ	T1,VERBD(P1)	;GET DEFAULT
00120		SKIPE	T2,VERBP(P1)	;SKIP IF NO STORAGE PTR
00130		DPB	T1,T2		;STORE DEFAULT FIRST
00140		JUMPLE	C,.POPJ		;EXIT IF NO VALUE SPECIFIED
00150		PUSHJ	P,KLOOK		;FIND VALUE SPECIFIED IN LIST
00160		AOJA	T1,EXPST1	;+1 FOR INTERNAL FORM AND STORE
     
00010	;SUBROUTINE TO EXIT TO MONITOR - CLOSES OUTPUT FIRST
00020	
00030	XIT:	PUSHJ	P,CLSFIL	;CLOSE OUTPUT FILE
00040		EXIT	1		;EXIT TO MONITOR
00050		EXIT
00060	
00070	;SUBROUTINE TO CLOSE OUTPUT FILE
00080	
00090	CLSFIL:	TLZN	F,L.OOPN	;SKIP IF OUTPUT FILE OPEN
00100		POPJ	P,		;NOOP IF NOT OPEN
00110		TLO	F,L.APP		;FORCE APPEND MODE
00120		CLOSE	OC,
00130		GETSTS	OC,N		;GET STATUS
00140		RELEAS	OC,		;GIVE UP THE DDB
00150		TRNN	N,IO.ERR	;SKIP IF ANY ERRORS
00160		POPJ	P,
00170		M.FAIO	<ERROR CLOSING OUTPUT FILE, STATUS =>
00180	
00190	;SUBROUTINE TO STORE LINES PER PAGE AND WORRY ABOUT MINIMUM
00200	
00210	LINPGS:	PUSHJ	P,EXPSTO	;STORE LINES PER PAGE AS SPECIFIED
00220		MOVEI	T1,MINLPG	;GET MINIMUM
00230		CAMLE	T1,LINPAG	;SKIP IF SPECIFIED GE MINIMUM
00240		MOVEM	T1,LINPAG	;NO, STORE MINIMUM
00250		POPJ	P,
00260	
00270	GETSPC:	MOVEI	T1,F.ZER
00280		MOVEI	T2,F.LEN
00290		PUSHJ	P,.GTSPC
00300		MOVE	T1,F.ZER+%TYP
00310		MOVEM	T1,%TYP(P1)
00320		POPJ	P,
     
00010	;SUBROUTINE TO ACCEPT A TITLE
00020	
00030	TITPRC:	PUSHJ	P,.SAVE4
00040		TLO	F,L.TITL	;NOTE PRESENCE OF TITLE
00050		MOVEI	P2,TITNDX	 ;INDEX IN TABLE VECTOR
00060		MOVE	P1,TIT.Y	;BYTE POINTER FOR TITLE
00070		PUSHJ	P,MKPNTR	;MAKE A REAL POINTER
00080	TITPR1:	JUMPLE	C,TITPRX	;EXIT AT END OF LINE
00090		PUSHJ	P,.TIALT	;READ NEXT CHAR
00100		MOVE	T1,C
00110		PUSHJ	P,STOBYT	;STORE IN TITLE TABLE
00120		JRST	TITPR1		;AND LOOP TILL END OF LINE
00130	TITPRX:	MOVEI	T1,TIT.EN	;MARK END OF TITLE
00140		PJRST	STOBYT
00150	
00160	;SUBROUTINE TO EVALUATE MODES LIST
00170	
00180	MODPRC:	MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
00190		PUSHJ	P,MKPNTR	;CLEAR THE INDIRECT BIT
00200		MOVEI	P2,MODNDX	;INDEX IN TABLE VECTOR
00210		MOVE	T1,[IOWD MODE.L,MODE.T]
00220		PJRST	TABPRC		;PROCESS LIST
     
00010	;SUBROUTINE TO EVALUATE JUSTIFY LIST
00020	
00030	JUSPRC:	MOVE	P1,J.Y		;BYTE POINTER FOR JUSTIFY LIST
00040		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00050		MOVEI	P2,JUSNDX	 ;INDEX IN TABLE VECTOR
00060		MOVEI	T1,J.END	;START WITH EMPTY LIST
00070		PUSHJ	P,STOBYT	;STORE END OF LIST
00080		MOVE	P1,J.Y
00090		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00100		MOVE	T1,[IOWD JUST.LT,JUST.T]
00110	;	PJRST	TABPRC		;PROCESS LIST
00120	
00130	;SUBROUTINE TO READ TTY AND STORE A SERIES OF BYTES FOR KEY WORDS
00140	;ARGS	T1=AOBJN PTR TO LIST OF KEY WORDS
00150	;	P1=BYTE POINTER (TO BE INCREMENTED)
00160	;	P2=INDEX IN TABLE VECTOR OF TABLE
00170	
00180	TABPRC:	MOVEM	T1,KEYPTR	;SAVE POINTER TO LIST OF KEYWORDS
00190	TABPR1:	JUMPLE	C,TABPR2	;EXIT AT END OF LINE
00200		PUSHJ	P,KLOOK		;FIND KEY WORD IN LIST
00210		PUSHJ	P,STOBYT	;STORE VALUE
00220		JRST	TABPR1
00230	TABPR2:	SETO	T1,		;END OF LIST FLAG
00240		PJRST	STOBYT		;STORE IT
00250	
00260	;SUBROUTINE TO LOOK UP A KEY WORD IN A LIST
00270	;ARGS	KEYPTR=IOWD PTR TO LIST OF LEGAL VALUES
00280	;VALUES	T1=INDEX IN LIST IF FOUND
00290	
00300	KLOOK:	PUSHJ	P,.SIXSW	;GET KEYWORD
00310		MOVE	T1,KEYPTR	;PTR TO LIST OF KEY WORDS
00320		PUSHJ	P,.NAME		;LOOK IT UP
00330		  JRST	E.UKK		;UNKNOWN KEY WORD
00340		HRRZ	T2,KEYPTR	;ADDR OF BEGINNING OF LIST
00350		MOVEI	T1,-1(T1)
00360		SUB	T1,T2		;INDEX IN LIST IS VALUE
00370		POPJ	P,
     
00010	;SUBROUTINE TO EVALUATE WIDTH LIST
00020	
00030	WIDPRC:	MOVE	P1,W.Y		;BYTE POINTER FOR WIDTH LIST
00040		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00050		MOVEI	P2,WIDNDX	;INDEX IN TABLE VECTOR
00060		MOVEI	T1,W.END	;START WITH EMPTGY LIST
00070		PUSHJ	P,STOBYT	;STORE END OF LIST
00080		MOVE	P1,W.Y
00090		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00100	WIDPR1:	JUMPLE	C,WIDPR2	;EXIT AT END OF LINE
00110		PUSHJ	P,EXPEVA	;EVALUATE EXPRESSION
00120		PUSHJ	P,STOBYT	;STORE IT
00130		JRST	WIDPR1
00140	WIDPR2:	MOVEI	T1,W.END	;MARK END OF LIST
00150		PJRST	STOBYT		; AND STORE IT
00160	
00170	EJECT:	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
00180		PJRST	NEWPAG		;OUTPUT PAGE EJECT AND PAGE HEADER
     
00010	;SUBROUTINE TO DUMP ALL OF FILE
00020	
00030	ALLDMP:	JUMPG	C,E.EXP
00040		PUSH	P,C		;SAVE LAST CHAR INPUT
00050		SETZM	SAVADR		;START AT LOCATION 0
00060		SETZM	SAVPOS		;START OF WORD
00070		MOVEI	T1,^D36		;36 BIT BYTES
00080		MOVEM	T1,SAVSIZ
00090		HRLOI	T1,377777	;GO TO END OF FILE
00100		MOVEM	T1,TRMADR
00110		SETZM	TRMPOS
00120		MOVEI	T1,1		;INCREMENT BY 1 WORD
00130		MOVEM	T1,INCADR
00140		SETZM	INCPOS
00150		PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
00160		PUSHJ	P,NEWLIN
00170		SETZB	T1,INCSIZ
00180		TRO	F,R.CON1	;NOTE DUMPING CONTENTS
00190		PUSHJ	P,FNDADR	;GET CONTENTS OF ZERO
00200		TLNN	F,L.NXM		;SKIP IF NXM ALREADY
00210		PUSHJ	P,OUTPT		;OUTPUT LOCATION 0
00220		MOVE	T1,%TYP(DL)	;TYPE OF INPUT FILE
00230		MOVE	T2,CATNUM	;CATEGORY IN CASE ITS DAEMON FILE
00240		CAIN	T1,T.DAE	;SKIP IF NOT A DAEMON FILE
00250		CAIE	T2,CA.COR	;SKIP IF CORE CATEGORY
00260		JRST	ALLDM1		;NO, JUST GO AHEAD
00270		TRO	F,R.CON1	;SET CONTENTS BIT
00280		MOVEI	T1,.JBREL	;ADDR OF .JBREL
00290		PUSHJ	P,FNDADR	;RETRIEVE .JBREL
00300		MOVEM	T1,LOWREL	;SAVE FOR LATER
00310	ALLDM1:	TLO	F,L.ALLD	;NOTE DUMPING WHOLE FILE
00320		MOVE	T2,HGHOFF	;GET OFFSET FOR HISEG
00330		CAIE	T1,T.HGH	;IS THIS A HIGH SEG
00340		CAIN	T1,T.SHR	; OR A .SHR SEG?
00350		MOVEM	T2,SAVADR	;YES--START AT 400000
00360		PJRST	DMPXC0
     
00010	;SUBROUTINE TO EXECUTE A DUMP REQUEST
00020	
00030	DMPBYT:	TLZA	F,L.TDMP	;DO NOT DUMP ON TTY
00040	TDMBYT:	TLO	F,L.TDMP	;ALSO DUMP ON TTY:
00050		JUMPLE	C,.POPJ		;GIVE UP IF NOTHING TO DO
00060		TLZ	DL,DL.NXM	;CAUSE ANOTHER MESSAGE
00070		PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
00080		PUSH	P,C		;SAVE BREAK
00090		PUSHJ	P,NEWLIN	;START DUMP ON NEW LINE
00100		POP	P,C		;RESTORE C
00110		MOVE	T2,SAVADR	;GET LAST ADDRESS TYPED OUT
00120		MOVEM	T2,SAVE4.	;SAVE FOR .
00130		MOVE	T2,OUTVAL	;GET LAST BYTE TYPED OUT
00140		MOVEM	T2,SAVE4$	;SAVE FOR $
00150	DMPBYS:	TRZ	F,R.CON1	;CLEAR CONTENTS FLAG
00160		PUSHJ	P,EXPEV0	;EVALUATE FIRST EXPRESSION
00170		MOVEM	T1,SAVEXP	;STORE FOR %
00180		CAIN	C," "		;SEE IF DELIMITER IS A SPACE AND
00190		PUSHJ	P,.TIAUC##	; IF SO GET ANOTHER CHAR.
00200		CAIN	C,"'"		;SKIP IF NOT A STRING COMING
00210		TRNE	F,R.ANY		;SKIP IF STRING AND NO DUMP DESC.
00220		JRST	DMPBY1		;DO BYTE FIRST
00230		JRST	DMPEXA		;NOTHING TO DUMP
00240	DMPBY1:	MOVE	T2,POSTMP	;POSITION SPECIFIED
00250		MOVEM	T2,SAVPOS
00260		MOVE	T2,SIZTMP
00270		MOVEM	T2,SAVSIZ
00280		PUSH	P,C		;SAVE LAST CHAR INPUT
00290		MOVEM	T1,SAVADR	;ASSUME VALUE ONLY, SAVE AS ADDRESS
00300		TRNN	F,R.CONB	;SKIP IF ACTUALLY CONTENTS OF ADDRESS
00310		JRST	DMPBY2
00320		TRO	F,R.CON1	;NOTE DUMPING CONTENTS
00330		MOVE	T2,ADRTMP	;ADDRESS FETCHED
00340		MOVEM	T2,SAVADR	;IS ADDRESS TO SAVE
00350	DMPBY2:	PUSHJ	P,OUTPT		;OUTPUT VALUE OF FIRST BYTE
00360		SETZM	INCSIZ		;DEFAULT SIZE INCREMENT
00370		MOVEI	T1,1		;DEFAULT POSITION=0(+1 FOR OFFSET)
00380		MOVEM	T1,INCPOS	;STORE DEFAULT POSITION INCREMENT
00390		MOVEM	T1,INCADR	;STORE DEFAULT ADDRESS INCREMENT
00400		MOVEI	T1,^D37		;DEFAULT END AT END OF THIS WORD
00410		MOVEM	T1,TRMPOS
00420		MOVE	T1,SAVADR	;ADDRESS OF THIS WORD
00430		MOVEM	T1,TRMADR
00440		SKIPLE	C,(P)		;RESTORE LAST CHAR INPUT, SKIP IF END OF LINE
00450		CAIE	C,"&"		;SKIP IF TERMINATING BYTE SPECIFIED
00460		JRST	DMPXC0		;END OF THAT BYTE DESCRIPTOR, GET NEXT
     
00010		SETZM	POSTMP
00020		SETZM	SIZTMP
00030		PUSHJ	P,EXPEVA	;EVALUATE TERMINATING BYTE SPECIFIER
00040		CAIN	C," "		;IGNORE TRAILINGE SPACES
00050		PUSHJ	P,.TIAUC##	; ..
00060		MOVEM	T1,TRMADR	;SAVE TERMINATING ADDRESS
00070		SKIPN	T1,POSTMP	;POSITION VALUE, SKIP IF SPECIFIED
00080		MOVEI	T1,1		;0 (+1 FOR OFFSET) IS DEFAULT
00090		MOVEM	T1,TRMPOS
00100		CAIE	C,"&"		;SKIP IF INCREMENT SPECIFIED
00110		JRST	DMPXCT		;NO, USE DEFAULT INCREMENT
00120		SETZM	POSTMP
00130		SETZM	SIZTMP
00140		PUSHJ	P,EXPEVA	;EVALUATE INCREMENT
00150		MOVEM	T1,INCADR	;SAVE INCREMENT ADDRESS
00160		MOVE	T1,POSTMP	;POSITION INCREMENT
00170		MOVEM	T1,INCPOS
00180		MOVE	T1,SIZTMP	;SIZE INCREMENT
00190		MOVEM	T1,INCSIZ
     
00010	DMPXCT:	MOVEM	C,(P)		;SAVE LAST CHAR INPUT
00020	DMPXC0:	MOVE	T1,SAVADR	;ADDR OF LAST BYTE OUTPUT
00030		MOVE	T2,SAVPOS	;POSITION LAST OUTPUT
00040		LSH	T2,POSSHF
00050		ADD	T2,SAVSIZ	;MAKE POSITION, SIZE WORD
00060		MOVE	T3,INCADR	;INCREMENT ADDRESS
00070		MOVE	T4,INCPOS	;INCREMENT POSITION
00080		LSH	T4,POSSHF
00090		ADD	T4,INCSIZ	;MAKE INCREMENT POSITION,SIZE WORD
00100		PUSHJ	P,ADDBYT	;INCREMENT BYTE
00110		JOV	DMPEX		;IF WE WENT FROM +INF TO -INF DO NOT
00120					; LOOP FOR EVER.
00130		CAMLE	T1,TRMADR	;SKIP IF NOT YET UP TO TERMINATING ADDRESS
00140		JRST	DMPEX
00150		MOVEM	T1,SAVADR	;SAVE NEW ADDR
00160		LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET NEW POSITION
00170		MOVEM	T1,SAVPOS
00180		MOVE	T1,SAVADR
00190		CAME	T1,TRMADR	;SKIP IF IN LAST WORD
00200		JRST	DMPXC1		;NO, GO AHEAD WITH DUMP
00210		MOVE	T1,SAVPOS	;POSITION
00220		CAMLE	T1,TRMPOS	;SKIP IF NOT YET PAST LAST BYTE IN WORD
00230		JRST	DMPEX		;ALL DONE, EXIT
00240	DMPXC1:	TLNN	DL,DL.WID	;SKIP IF WE CONTROL OUR OWN WIDTHS
00250		PUSHJ	P,LSPC3		;ELSE OUTPUT 3 SPACES
00260		MOVE	T1,SAVADR
00270		TRNE	F,R.CON1	;SKIP IF ONLY ADDRESSES ARE VALUES DUMPED
00280		PUSHJ	P,FNDBYT	;FIND CONTENTS OF ADDRESS
00290		TLNN	F,L.ALLD	;SKIP IF DUMPING WHOLE FILE
00300		JRST	DMPXC2		;NO, GO AHEAD
00310		TLNE	F,L.NXM		;NO SKIP IF END OF FILE
00320		JRST	DMPEX		;YES, END AT NXM
00330		MOVE	T2,%TYP(DL)	;TYPE OF INPUT FILE
00340		MOVE	T3,CATNUM	;CATEGORY IN CASE ITS A DAEMON FILE
00350		CAIN	T2,T.DAE	;SKIP IF NOT A DAEMON FILE
00360		CAIE	T3,CA.COR	;YES, SKIP IF CORE CATEGORY
00370		JRST	DMPXC2		;NO, GO AHEAD
00380		MOVE	T2,LOWREL	;SIZE OF LOW SEGMENT
00390		CAMLE	T2,SAVADR	;SKIP IF ADDR PAST END OF LOW SEGMENT
00400		JRST	DMPXC2		;NO, GO AHEAD WITH LOW SEGMENT ADDR
00410		ADDI	T2,1		;POSSIBLE BEGINNING OF HIGH SEG
00420		CAIGE	T2,400000	;SKIP IF LOW SEG GT 400000
00430		MOVEI	T2,400000	;NO, HIGH SEG STARTS AT 400000
00440		CAMG	T2,SAVADR	;SKIP IF ADDR BETWEEN SEGMENTS
00450		JRST	DMPXC2		;NO, GO AHEAD WITH HIGH SEG ADR
00460		MOVEM	T2,SAVADR	;MOVE UP TO BEGINNING OF HIGH SEG
00470		JRST	DMPXC0		;AND START UP HIGH SEG
00480	DMPXC2:	PUSHJ	P,OUTPT		;OUTPUT IT
00490		JRST	DMPXC0		;AND LOOP FOR ALL BYTES REQUESTED
     
00010	DMPEX:	POP	P,C		;RESTORE LAST CHAR INPUT
00020	DMPEXA:	JUMPLE	C,DMPENX	;EXIT IF END OF LINE
00030		CAIE	C,"'"		;SKIP IF STRING COMING
00040		JRST	DMPBYS		;NO, GET NEXT DUMP DESCRIPTOR
00050		PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
00060	DMPEX1:	JSP	T2,DMPTTG	;GET NEXT CHAR OF STRING
00070	DMPEX2:	CAIE	C,C.DQ		;SKIP IF DOUBLE QUOTE
00080		JRST	DMPEX3		;NO, LOOK FOR SPECIAL PATTERN
00090		JSP	T2,DMPTTG	;YES, TAKE NEXT CHAR LITERALLY
00100		JRST	DMPEX8		;AND OUTPUT IT
00110	DMPEX3:	CAIN	C,"'"		;SKIP IF NOT END OF STRING
00120		JRST	DMPEXX		;ALL DONE, GET NEXT DUMP DESCRIPTOR
00130		CAIN	C,"^"		;SKIP IF NOT CONTROL-LETTER
00140		JRST	DMPEX6
00150		CAIN	C,"\"		;SKIP IF NOT LOWER-CASE
00160		JRST	DMPEX7
00170		CAIE	C,"<"		;SKIP IF START OF SPECIAL PATTERN
00180		JRST	DMPEX8		;NO, JUST OUTPUT IT STRAIGHT
00190		PUSHJ	P,.SIXSW	;GET NEXT GROUP OF ALPHNUMERICS
00200		CAIE	C,">"		;SKIP IF REAL PATTERN
00210		JRST	DMPEX5		;NO, OUTPUT AS CHARS SEEN
00220		MOVSI	T2,-LSPCHR
00230		MOVE	M,N		;COPY SIXBIT VALUE
00240		HRR	M,SPCHAR(T2)	;MAKE RH MATCH
00250		CAME	M,SPCHAR(T2)	;SKIP IF MATCH PATTERN
00260		AOBJN	T2,.-2		;NO, TRY ALL LEGAL PATTERNS
00270		JUMPGE	T2,DMPEX4	;JUMP IF NOT LEGAL PATTERN
00280		HRRZ	M,SPCHAR(T2)	;M=ADDR OF STRING ACTUALLY WANTED
00290		PUSH	P,C		;SAVE C
00300		CAIN	M,SPS.FF	;IS THIS A FORM FEED?
00310		JRST	[PUSHJ P,NEWPAG	;YES--DO ALL THE CORRECT THINGS
00320			 JRST  .+2]	; AND SKIP OUTPUT
00330		PUSHJ	P,LSTR		;OUTPUT THAT
00340		POP	P,C		;PUT C BACK. IT SHOULD BE SUFFICIENT
00350					; TO DO A MOVEI C," " HERE BUT WHY
00360					; NOT DO IT RIGHT.
00370		JRST	DMPEX1
00380	DMPEX4:	MOVEI	C,">"		;END WITH RIGHT ANGLE BRACKET
00390	DMPEX5:	PUSH	P,C		;SAVE TERMINATING CHAR
00400		MOVEI	C,"<"		;WE KNOW THERE WAS A LEFT ANGLE BRACKET
00410		PUSHJ	P,LCHR
00420		MOVE	T2,N		;ALPHA CHARS WE READ
00430		PUSHJ	P,LSIX		;TYPE THEM
00440		POP	P,C		;NOW THE LAST CHAR
00450		JUMPLE	C,DMPENX	;HANDLE UNEXPECTED EOL
00460		JRST	DMPEX2		;AND INVESTIGATE THAT
     
00010	DMPEX6:	JSP	T2,DMPTTG	;GET NEXT CHAR
00020		HRRZI	C,-100(C)	;MAKE CONTROL LETTER
00030		CAIE	C,"'"-100	;SKIP IF END OF STRING
00040		JRST	DMPEX8
00050		MOVEI	C,"^"		;OUTPUT TERMINAL ^
00060		PUSHJ	P,LCHR
00070		JRST	DMPEXX		;AND EXIT
00080	DMPEX7:	JSP	T2,DMPTTG	;GET NEXT CHAR
00090		ADDI	C,40		;MAKE UPPER CASE
00100		CAIE	C,"'"+40	;SKIP IF END OF STRING
00110		JRST	DMPEX8
00120		MOVEI	C,"\"		;OUTPUT TERMINAL \
00130		PUSHJ	P,LCHR
00140	DMPEXX:	JSP	T2,DMPTTG	;GT NEXT CHAR
00150		JUMPG	C,DMPBYS	;KEEP GOING IF NOT END OF INPUT LINE
00160	DMPENX:	TLNN	F,L.OTTY	;SKIP IF OUTPUT DEVICE IS A TTY
00170		PJRST	LCRLF		;NO, EXIT
00180		PUSHJ	P,LCRLF		;YES, FINISH OFF LINE
00190		PJRST	CLSFIL		;AND CLOSE TO GET THE OUTPUT TO THE USER NOW
00200	
00210	DMPEX8:	PUSHJ	P,LCHR		;OUTPUT THE CHAR
00220		JRST	DMPEX1		;AND LOOK AT NEXT CHAR
00230	
00240	
00250	;ROUTINE TO GET NEXT CHAR IN A STRING
00260	
00270	DMPTTG:	JUMPLE	C,DMPENX	;EXIT IF EOL
00280		PUSHJ	P,.TICHE##	;GET A BYTE BUT DO NOT PRE-PROCESS
00290		JUMPG	C,(T2)		;RETURN WITH REAL BYTE
00300		JRST	DMPENX		;EOL--EXIT
     
00010		DEFINE	SPCTM(A)<IRP A,<XWD SIXBIT \   A\,SPS.'A>>
00020	
00030	SPCHAR:	SPCTM	<EL,VT,FF,AL,HT>
00040	LSPCHR==.-SPCHAR
00050	
00060	SPS.EL:	ASCIZ	.
00070	.
00080	SPS.VT:	<C.VT_^D29>
00090	SPS.FF:	<C.FF_^D29>
00100	SPS.AL:	<C.ALT_^D29>
00110	SPS.HT:	ASCIZ .	.
00120	
00130	BEGIN:
00140	CMPDMP:
00150	DELSYM:
00160	DOPROC:
00170	ENDPRC:
00180	IFPROC:
00190	IOFPRC:
00200	LISPRC:
00210	OOFPRC:
00220	POPPRC:
00230	PUSHPR:
00240	SYMPRC:
00250	TCMDMP:
00260	TSYMPR:
00270		JRST	E.NIMP
     
00010	SUBTTL EVALUATE EXPRESSION
00020	
00030	;SUBROUTINE TO EVALUATE AN EXPRESSION
00040	
00050	EXPEVA:	PUSHJ	P,EXPEV0	;EVALUATE EXPRESSION
00060		MOVEM	T1,SAVEXP	;STORE FOR %
00070		TLNN	F,L.NXM		;EVALUATE OK?
00080		POPJ	P,		;RETURN
00090		HRLZ	N,ADRTMP	;PICK UP ADDRESS
00100		M.FAIO	<NXM at>	;GIVE MESSAGE
00110	
00120	EXPEV0:	TRZ	F,R.CONB!R.ANY	;NOTE NOT YET REQUIRED TO SEARCH FILE
00130		TLZ	F,L.NXM		;CLEAR NXM FLAG
00140		JUMPLE	C,.POPJ		;EXIT IF END OF LINE
00150		PUSHJ	P,.SAVE2	;PRESERVE P1 AND P2
00160		HRRZ	P1,OPRTAB	;SET UP PTR TO OPERATOR STACK
00170		HRRZ	P2,OPNTAB	;AND OPERAND STACK
00180		SUBI	P1,1		;MAKE PUSH DOWN PTR
00190		SUBI	P2,1		;MAKE PUSH DOWN PTR
00200	EXPEV1:	PUSHJ	P,EXPSYM	;GET NEXT SYMBOL
00210		JUMPE	T1,EXPE2A	;ASSUME 0 IF A UNARY OPERATOR
00220	EXPEV2:	TRNE	F,R.RPN		;SKIP IF NOT AFTER RIGHT PAREN
00230		JRST	E.EXP		;RIGHT PAREN MUST BE FOLLOWED BY UNARY OPERATOR
00240		TRO	F,R.ANY		;NOTE SOMETHING FOUND
00250	EXPE2A:	SETZ	T2,
00260		TRZN	F,R.RPN		;RIGHT PAREN SHOULD NOT PUSH 0
00270		PUSHJ	P,PSHOPN	;PUT VALUE ON OPERAND STACK
00280		MOVSI	T2,-LPRECL	;MINUS LENGTH OF PRECEDENCE TABLE
00290		CAIN	C," "		;IF IT IS A BLANK TRY TO
00300		PUSHJ	P,.TIAUC## 	; GET A BETTER OPERATOR.
00310		CAIN	C,C.DQ		;IS IT A DOUBLE QUOTE?
00320		MOVEI	C,"W"		;YES--CONVERT TO DOUBLE-U
00330		CAIN	C,"<"		;CONVERT LEFT ANGLE BRACKET TO "X" FOR
00340		MOVEI	C,"X"		;INTERNAL EASE
00350		CAIN	C,">"		;AND RIGHT ANGLE BRACKET TO "Y"
00360		MOVEI	C,"Y"
00370		CAIE	C,","		; AND COMMA TO "Z" - SKIP IF COMMA SPECIFIED
00380		JRST	EXPEV4		;NO, GO AHEAD
00390		MOVEI	C,"Z"
00400		TRZN	F,R.CMAL	;SKIP IF COMMA LEGAL
00410		JRST	EXPEOX		;NO, END OF EXPRESSION
     
00010	EXPEV4:	HLL	C,PRECLS(T2)	;LH C=PRECEDENCE OF NEXT SYMBOL ON LIST
00020		CAME	C,PRECLS(T2)	;SKIP IF FOUND CHAR IN LIST
00030		AOBJN	T2,EXPEV4	;NO, TRY NEXT
00040		JUMPGE	T2,EXPEOX	;EXIT IF TERMINATOR NOT OPERAND
00050		HRR	C,T2		;RH C=INDEX IN EXECUTION TABLE FOR THIS OPERAND
00060		HLLZ	T2,C		;T2=PRECEDENCE ONLY
00070	EXPEV5:	TLNE	P1,-1		;SKIP IF OPERATOR STACK EMPTY
00080		CAMLE	T2,(P1)		;SKIP IF NEW OPERATOR LE STACK
00090		JRST	NOUNST		;NO, DONT UNSTACK
00100		HLLZ	T1,(P1)		;T1=PRECEDENCE OF OPERAND ON STACK
00110		CAML	T2,T1		;SKIP IF NEW LT STACK (NOT EQUAL)
00120		JRST	EXPEV6		;NEW EQ STACK
00130		CAMN	T1,[XWD LPNPRE,0] ;SKIP IF STACK NOT LEFT PAREN
00140		CAMN	T2,[XWD RPNPRE,0] ;SKIP IF NEW NOT RIGHT PAREN
00150		JRST	EXPEV7		;UNSTACK LEFT PAREN IF RIGHT PAREN
00160		JRST	NOUNST		;ELSE DONT UNSTACK LEFT PAREN
00170	EXPEV6:	CAME	T2,[XWD LPNPRE,0] ;LEFT PAREN DOESN'T UNSTACK OTHER LEFT PAREN
00180		CAMN	T2,[XWD FUNPRE,0] ;NOR DO FUNNIES UNSTACK EACH OTHER
00190		JRST	NOUNST		;OTHERWISE EQUALS UNSTACK EACH OTHER
00200	EXPEV7:	PUSHJ	P,UNSTAK	;UNSTAK LAST OPERATOR ON STACK
00210		TLNE	F,L.NXM		;NO SKIP IF NXM
00220		JRST	EXPEX1		;GIVE UP IF NXM
00230		TRNE	F,R.RPN		;SKIP IF NOT RIGHT PAREN
00240		JRST	EXPEV1		;ALL DONE IF RIGHT PAREN
00250		JRST	EXPEV5		;AND LOOP TILL DONT UNSTACK
00260	NOUNST:	HLRZ	T2,C		;T2=PRECEDENCE OF NEW OPERATOR
00270		CAIN	T2,RBKPRE	;SKIP IF NOT RIGHT ANGLE BRACKET
00280		TRO	F,R.CMAL	;NOTE COMMA IS LEGAL AFTER ANGLE BRACKET
00290		HLRZ	T1,P1		;LENGTH OF OPERATOR STACK
00300		ADDI	T1,1		;+1=LENGTH NEEDED
00310		SUB	T1,OPRLEN	;NEEDED-LENGTH=WORDS NEEDED TO ADD
00320		JUMPLE	T1,NOUNS1	;JUMP IF ALREADY LONG ENOUGH
00330		PUSH	P,P2		;SAVE P2
00340		MOVEI	P2,OPRNDX	 ;INDEX IN TABLE VECTOR FOR OPERATOR STACK TABLE
00350		ADDI	T1,4		;GET SOME MORE ROOM
00360		ADDM	T1,(P)		;FIX UP OTHER PUSH DOWN POINTER
00370		PUSHJ	P,GETCOR	;EXPAND TABLE
00380		POP	P,P2
00390	NOUNS1:	PUSH	P1,C		;PUT OPERATOR ON OPERATOR STACK
00400		JRST	EXPEV1		;AND GET NEXT OPERAND
     
00010	EXPEOX:	TLNN	P1,-1		;SKIP IF MORE OPERATORS ON OPERATOR STACK
00020		JRST	EXPEX1		;NO MORE TO UNSTACK
00030		PUSHJ	P,UNSTAK	;UNSTACK LAST OPERATOR
00040		TLNN	F,L.NXM		;SKIP IF NXM
00050		JRST	EXPEOX		;LOOP TILL ALL UNSTACKED
00060	EXPEX1:	MOVE	P1,P2
00070		MOVE	T1,OPRLEN
00080		SUBI	T1,4		;KEEP MINIMAL LENGTH
00090		MOVEI	P2,OPRNDX	
00100		JUMPLE	T1,EXPEX2	;JUMP IF DONT HAVE ENOUGH TO GIVE SOME BACK
00110		SUBM	T1,P1		;FIX UP PUSH DOWN PTR
00120		MOVNS	P1
00130		PUSHJ	P,GIVCOR	;GIVE BACK EXCESS CORE
00140	EXPEX2:	HRRES	C		;RESTORE C TO ITS NATURAL SELF
00150		MOVE	T1,OPNLEN
00160		SUBI	T1,4
00170		MOVEI	P2,OPNNDX	
00180		CAILE	T1,0		;SKIP IF DONT HAVE MUCH
00190		PUSHJ	P,GIVCOR	;GIVE BACK EXCESS CORE
00200		TLNE	F,L.NXM		;NO SKIP IF NXM
00210		POPJ	P,
00220		HLRZ	T1,P1		;LENGTH OF OPERAND STACK
00230		SUBI	T1,2
00240		JUMPN	T1,E.EXP	;JUMP IF NOT EXACTLY 1 ITEM ON STACK
00250		POP	P1,T1		;T1=VALUE
00260		POP	P1,T2		;T2=POSITION,SIZE WORD
00270		POPJ	P,
     
00010	;SUBROUTINE TO PUSH AN OPERAND ON THE OPERAND STACK
00020	;ARGS	T1=VALUE
00030	;	T2 BITS 0-5=POSITION+1
00040	;	T2 BITS 6-35=SIZE
00050	
00060	PSHOPN:	PUSH	P,T1
00070		PUSH	P,T2
00080		HLRZ	T1,P2		;CURRENT LENGTH OF OPERAND STACK
00090		ADDI	T1,2		;LENGTH NEEDED
00100		CAMGE	T1,OPNLEN	;SKIP IF TABLE NOT BIG ENOUGH
00110		JRST	PSHOP1		;OK
00120		PUSH	P,P2
00130		MOVEI	P2,OPNNDX	 ;INDEX IN TABLE VECTOR
00140		ADDI	T1,10		;MAKE IT BIGGER
00150		PUSHJ	P,GETCOR	;EXPAND TABLE
00160		POP	P,P2
00170	PSHOP1:	POP	P,T2		;RESTORE VALUE OF OPERAND
00180		POP	P,T1
00190		PUSH	P2,T2		;PUSH OPERAND ON OPERAND STACK
00200		PUSH	P2,T1		;FIRST POSITION,SIZE, THEN VALUE
00210		POPJ	P,
00220	
00230	;SUBROUTINE TO UNSTACK THE OPERATOR ON TOP OF THE OPERATOR STACK
00240	
00250	UNSTAK:	TLNN	P2,-2		;SKIP IF SOMETHING ON THE OPERAND STACK
00260		JRST	E.EXP		;SIGH
00270		PUSH	P,T2		;SAVE T2
00280		POP	P2,T1		;LAST OPERAND
00290		POP	P2,T2		;POSITION,SIZE WORD
00300		HRRZ	T3,(P1)		;INDEX IN INSTRUCTION TABLE
00310		XCT	OPER(T3)	;EXECUTE INSTRUCTION FOR OPERATOR
00320		POP	P1,T1		;THROW AWAY OPERATOR
00330		POP	P,T2		;RESTORE T2
00340		POPJ	P,
     
00010		DEFINE PRECMC<
00020	ZZ==1
00030	RPNPRE==ZZ
00040		X	<)>
00050		X	<+,->
00060		X	<*,/>
00070		X	<^>
00080		X	<W>
00090	FUNPRE==ZZ
00100		X	<[,@,\>
00110	RBKPRE==ZZ
00120		X	<X,Y>
00130		X	<Z>
00140	LPNPRE==ZZ
00150		X	<(>
00160		>
00170	
00180		DEFINE	X(A)<
00190	IRP A,<
00200		XWD	ZZ,"A">
00210	ZZ==ZZ+1
00220	>
00230	
00240	PRECLS:	PRECMC
00250	LPRECL==.-PRECLS
     
00010		DEFINE	X(A)<
00020	ZZ==ZZ+1
00030	IRP A,<
00040	IFIDN <A> <+>,<
00050		PUSHJ	P,EXPADD>
00060	
00070	IFIDN <A> <->,<
00080		PUSHJ	P,EXPSUB>
00090	
00100	IFIDN <A> <*>,<
00110		IMULM	T1,(P2)>
00120	
00130	IFIDN <A> </>,<
00140		PUSHJ	P,EXPDIV>
00150	
00160	IFIDN <A> <^>,<
00170		PUSHJ	P,EXPON>
00180	
00190	IFIDN <A> <[>,<
00200		PUSHJ	P,CONT36>
00210	
00220	IFIDN <A> <@>,<
00230		PUSHJ	P,CONT23>
00240	IFIDN <A> <\>,<
00250		PUSHJ	P,CONT18>
00260	
00270	IFIDN <A> <(>,<
00280		PUSHJ	P,EXPRPN>
00290	
00300	IFIDN <A> <)>,<
00310		JRST	E.EXP>
00320	
00330	IFIDN <A> <W>,<
00340		HLREM	T1,(P2)>
00350	
00360	IFIDN <A> <X>,<
00370		PUSHJ	P,EXPRBK>
00380	
00390	IFIDN <A> <Z>,<
00400		PUSHJ	P,EXPCMA>
00410	
00420	IFIDN <A> <Y>,<
00430		JRST	E.EXP>
00440	>>
     
00010	OPER:	PRECMC
     
00010	EXPADD:	POP	P2,T3		;POP NEXT TO LAST OPERAND
00020		POP	P2,T4
00030		PUSHJ	P,ADDBYT	;ADD THE LAST TWO
00040		PUSH	P2,T2		;AND PUT THAT ON THE STACK
00050		PUSH	P2,T1
00060		POPJ	P,
00070	
00080	EXPSUB:	EXCH	T1,(P2)		;LAST OPERAND ON STACK
00090		SUBM	T1,(P2)		;SUBTRACT FROM NEXT TO LAST AND STORE ON STACK
00100		POPJ	P,
00110	
00120	EXPDIV:	EXCH	T1,(P2)		;LAST OPERAND ON STACK
00130		IDIVM	T1,(P2)		;DIVIDE NEXT TO LAST BY LAST AND STORE ON STACK
00140		POPJ	P,
00150	
00160	EXPON:	JUMPG	T1,EXPON1	;JUMP IF POSITIVE POWER
00170		MOVEI	T1,1		;ANYTHING TO NEGATIVE POWER IS 1
00180		SKIPE	(P2)		;EXCEPT 0 WHICH IS 0
00190		MOVEM	T1,(P2)
00200		POPJ	P,
00210	EXPON1:	MOVE	T2,(P2)		;NUMBER TO BE RAISED TO A POWER
00220	EXPON2:	SOJLE	T1,.POPJ	;JUMP IF RAISED TO POWER DESIRED
00230		IMULM	T2,(P2)		;RAISE TO ANOTHER POWER
00240		JRST	EXPON2		;AND LOOP TILL DONE
00250	
00260	EXPCMA:	TLNN	P2,-2		;SKIP IF SOMETHING ON OPERAND STACK
00270		JRST	E.EXP		;ERROR IF OPERAND STACK EMPTY
00280		MOVEM	T1,-1(P2)	;STORE SIZE
00290		MOVE	T1,(P2)		;GET LAST OPERAND ON STACK=POSITION
00300		MOVEM	T1,SIZTMP	;SAVE AS SIZE
00310		ADDI	T1,1		;MAKE LAST OPERAND=POSITION NON-ZERO
00320		LSH	T1,POSSHF
00330		ORM	T1,-1(P2)	;AND STORE AS POSITION OF OPERAND ON TOP OF STACK
00340		POPJ	P,
00350	
00360	EXPRBK:	TRZN	F,R.CMAL	;SKIP IF NO COMMA SEEN
00370		JRST	EXPRB1		;THIS IS A SIZE FIELD
00380		ADDI	T1,1		;IT IS POSITION, MAKE NON-ZERO
00390		LSH	T1,POSSHF
00400		MOVE	T2,T1		;T2=POSITION, 0 FOR SIZE
00410	EXPRB1:	MOVEM	T2,-1(P2)	;STORE POSITION, SIZE FOR TOP OF STACK
00420		LSH	T2,-POSSHF	;SHIFT BACK
00430		MOVEM	T2,POSTMP	;STORE FOR LATER
00440		JRST	EXPRP1		;AND GET RID OF LEFT ANGLE BRACKET
00450	
00460	EXPRPN:	MOVEM	T2,-1(P2)	;STORE OPERAND ON TOP OF 0 PUSHED FOR UNARY (
00470		MOVEM	T1,(P2)
00480	EXPRP1:	TRO	F,R.RPN		;SET RIGHT PAREN BIT
00490		POPJ	P,
     
00010	CONT18:	PUSHJ	P,FNDBYT	;GET CONTENTS OF WORD SPECIFIED
00020		TLZ	T1,-1
00030		JRST	CONTEX		;AND EXTRACT PROPER BYTE
00040	
00050	CONT23:	PUSHJ	P,FNDBYT
00060	CON23A:	TLNN	T1,17		;SKIP IF ANY INDEX SPECIFIED
00070		JRST	NOINDX		;NO
00080		PUSH	P,T1
00090		LDB	T1,[POINT 4,T1,17]	;GET INDEX REGISTER
00100		PUSHJ	P,FNDADR	;GET CONTENTS OF INDEX REGISTER
00110		POP	P,T2
00120		TLNE	F,L.NXM		;NO SKIP IF NXM
00130		JRST	CONTEX
00140		EXCH	T1,T2		;T2=CONTENTS OF INDEX REGISTER
00150		ADDI	T1,(T2)
00160	
00170	INDBTS=(@)	;INDIRECT BITS
00180	
00190	NOINDX:	SETZ	T2,		;CLEAR POSITION WORD IN CASE NO MORE INDIRECT
00200		TLZ	T1,-1-INDBTS	;CLEAR ALL BUT INDIRECT BITS
00210		TLZN	T1,(@)		;SKIP IF INDIRECT SPECIFIED
00220		JRST	CONT36		;ALL DONE IF NO MORE INDIRECTING
00230		MOVEM	T1,ADRTMP	;NEW CURRENT ADDRESS
00240		PUSHJ	P,FNDADR	;GET CONTENTS OF THAT LOCATION
00250		TLNN	F,L.NXM		;SKIP IF NXM
00260		JRST	CON23A		;AND LOOP TILL DONE
00270		JRST	CONTEX
00280	
00290	CONT36:	PUSHJ	P,FNDBYT	;GET CONTENTS OF WORD SPECIFIED
00300	CONTEX:	MOVEM	T1,(P2)		;STORE ON TOP OF ZERO PUSHED
00310		TRO	F,R.CONB	;NOTE USED CONTENTS
00320		POPJ	P,
     
00010	;SUBROUTINE TO ADD TWO BYTE DESCRIPTORS
00020	;ARGS	T1,T2=BYTE DESCRIPTOR 1
00030	;	T3,T4=BYTE DESCRIPTOR 2
00040	;VALUES	T1,T2=BYTE DESCRIPTOR 1 + BYTE DESCRIPTOR 2
00050	;BYTE DESCRIPTOR ADDITION IS DEFINED BY:
00060	;	ADDING ADDRESSES, THEN
00070	;	ADDING POSITION; IF OVERFLOWS THE WORD, TAKE PARTIAL BYTE FROM
00080	;	  BOTH WORDS, THEN
00090	;	ADD SIZE INCREMENT TO POSITION; IF OVERFLOWS, RESET TO BEGINNING OF
00100	;	  NEXT WORD, LIKE THE HARDWARE INCREMENTS BYTE POINTERS
00110	
00120	ADDBYT:	JOV	.+1		;CLEAR OVERFLOW
00130		ADD	T1,T3		;ADDRESSES ADD
00140		JUMPE	T4,.POPJ	;NO CHANGE IF INCREMENT POS, SIZE=0
00150		PUSH	P,T1
00160		LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
00170		LDB	T3,[POINT 36-POSSHF,T4,35-POSSHF] ;GET POSITION INCREMENT
00180		ADD	T1,T3		;T1=NEW POSITION
00190		SUBI	T1,1		;BOTH WERE +1, SO MAKE NEW +1
00200	ADDBY1:	CAIGE	T1,^D37		;SKIP IF OVERFLOWED THE WORD
00210		JRST	ADDBY2		;NO, GO ADD SIZE
00220		AOS	(P)		;BUMP ADDRESS TO NEXT WORD
00230		SUBI	T1,^D36		;AND MOVE POSITION BACK 36 BITS
00240		JRST	ADDBY1		;AND SEE IF INTO LAST WORD
00250	ADDBY2:	TLZ	T4,770000	;CLEAR OUT POSITION FIELD
00260		ADD	T1,T4		;ADD INCREMENT SIZE TO POSITION
00270		MOVNS	T4		;-SIZE + BEGINNING OF NEXT
00280		ADDI	T4,^D37		;IS POSITION WHERE BYTE WILL OVERFLOW
00290		CAMG	T1,T4		;SKIP IF NEXT BYTE WILL OVERFLOW WORD
00300		JRST	ADDBY3		;NO, ALL SET
00310		MOVEI	T1,1		;RESET TO BEGINNING OF NEXT WORD
00320		AOS	(P)		;BUMP ADDR
00330	ADDBY3:	DPB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;STORE NEW POSITION
00340		POP	P,T1		;POP FINAL ADDDRESS
00350		POPJ	P,
     
00010	;SUBROUTINE TO READ A SYMBOL
00020	;	T1=NUMBER IF NUMBER, RADIX50 SYMBOL IF SYMBOL
00030	;RETURN	.POPJ IF NUMBER
00040	;	.POPJ1 IF SYMBOL
00050	
00060	REDSYM:	SETZ	T1,
00070		JUMPLE	C,.POPJ1	;EXIT IF END OF LINE
00080		PUSHJ	P,.TIAUC	;GET NEXT CHAR
00090		CAIN	C," "		;IGNORE BLANKS BEFORE A SYMBOL
00100		PUSHJ	P,.TIAUC##	; TO MAKE DUMP EASIER TO USE.
00110		CAIL	C,"0"		;SKIP IF NOT A NUMBER
00120		CAILE	C,"9"		;SKIP IF A NUMBER
00130		JRST	SYMIN		;ASSUME SYMBOL
00140		JRST	RDXIN		;NUMBER, READ IN CURRENT INPUT RADIX
00150	SYMIN:	CAIN	C,"%"		;SKIP IF NOT PERCENT
00160		JRST	SYMPER		;PERCENT IS LEGAL RADIX50 SYMBOL
00170		CAIN	C,"$"
00180		JRST	SYMDOL		;DOLLAR SIGN IS LEGAL RADIX50
00190		CAIN	C,"."
00200		JRST	SYMDOT		;AS IS DOT
00210		CAIL	C,"A"		;SKIP IF NOT A LETTER
00220		CAILE	C,"Z"		;SKIP IF LETTER
00230		JRST	.+2
00240		JRST	SYMLET		;LETTTER
00250		CAIL	C,"0"		;SKIP IF NOT A NUMBER
00260		CAILE	C,"9"		;SKIP IF A NUMBER
00270		JRST	.POPJ1		;NOT A RADIX50 SYMBOL, EXIT
00280	SYMNUM:	SUBI	C,"0"-1		;"0" IS 1 IN RADIX50
00290		JRST	SYMRD5		;C=RADIX50 VALUE
00300	SYMPER:	SKIPA	C,[47]		;47 IS RADIX50 FOR PERCENT
00310	SYMDOL:	MOVEI	C,46		;46 IS RADIX50 FOR DOLLAR SIGN
00320		JRST	SYMRD5
00330	SYMDOT:	SKIPA	C,[45]		;45 IS RADIX50 FOR PERIOD
00340	SYMLET:	SUBI	C,"A"-13	;"A" IS 13 IN RADIX50
00350	SYMRD5:	IMULI	T1,50
00360		ADD	T1,C
00370		PUSHJ	P,.TIAUC	;GET NEXT CHAR
00380		JRST	SYMIN
     
00010	RDXIN:	SETZ	T1,		;CLEAR THE AC
00020		JOV	RDXIN1		;CLEAR THE OVERFLOW FLAG
00030	RDXIN1:	SUBI	C,"0"
00040		CAIL	C,0		;SEE IF IN RADIX
00050		CAML	C,IRADIX	;SKIP IF A NUMBER IN CURRENT RADIX
00060		JRST	RDXMUL		;END OF NUMBER
00070		IMUL	T1,IRADIX	;MULTIPLY PREVIOUS BY CURRENT RADIX
00080		ADD	T1,C		;+ THIS NUMBER
00090		JOV	[TLO  T1,(1B0)	;OVERFLOW DOES NOT TAKE PLACE
00100			 JRST .+1]	; SO SET BIT ZERO TO MAKE IT HAPPEN
00110		ADDI	C,"0"		;FIX CHAR BACK UP FOR CONKLIN
00120		PUSHJ	P,.TIAUC	;GET NEXT CHAR
00130		JRST	RDXIN1		;AND LOOP
00140	
00150	RDXMUL:	ADDI	C,"0"		;RESET CHAR
00160		POPJ	P,
     
00010	SUBTTL GET BYTE FROM INPUT FILE
00020	
00030	;SUBROUTINE TO EXTRACT A BYTE FROM THE INPUT FILE
00040	;ARGS	T1=ADDRESS OF WORD DESIRED
00050	;	T2=POSITION, SIZE DESIRED
00060	
00070	FNDBYT:	PUSHJ	P,.SAVE2	;SAVE P1,P2
00080		MOVEM	T1,ADRTMP	;SAVE ADDRESS
00090		LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
00100		CAIN	T1,0		;SKIP IF SPECIFIED
00110		MOVEI	T1,1		;NO, ASSUME 0 (+OFFSET)
00120		MOVEM	T1,POSTMP	;SAVE POSITION
00130		TLZ	T2,770000
00140		MOVEI	T1,^D36		;DEFAULT IS FULL WORD
00150		CAIN	T2,0		;SKIP IF SIZE SPECIFIED
00160		MOVE	T2,T1		;USE DEFAULT
00170		MOVEM	T2,SIZTMP
00180		MOVEI	P2,BYTNDX	 ;INDEX IN TABLE VECTOR FOR BYTE TABLE
00190		MOVE	T1,T2		;T1=SIZE IN BITS
00200		ADDI	T1,^D35
00210		IDIVI	T1,^D36		;CONVERT TO WORDS
00220		SUB	T1,BYTLEN	;SEE IF TABLE LONG ENOUGH
00230		JUMPLE	T1,FNDBY1	;JUMP IF BIG ENOUGH, GET RID OF EXCESS
00240		PUSHJ	P,GETCOR	;EXPAND TABLE
00250		JRST	FNDBY2
00260	FNDBY1:	JUMPE	T1,FNDBY2	;JUMP IF EXACTLY RIGHT SIZE
00270		MOVNS	T1		;T1=EXCESS
00280		PUSHJ	P,GIVCOR	;GIVE BACK EXCESS
00290	FNDBY2:	MOVE	P1,BYT.Y	;BYTE POINTER FOR STORING BYTE
00300		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00310		MOVE	T1,ADRTMP	;ADDRESS OF WORD TO FETCH
00320		PUSHJ	P,FNDADR	;GET FIRST WORD
00330		TLNE	F,L.NXM		;NO SKIP IF NXM
00340		POPJ	P,
00350		MOVE	T2,POSTMP	;POSITION
00360		ADD	T2,SIZTMP	;+SIZE
00370		CAILE	T2,^D37		;SKIP IF LE 1 WORD
00380		JRST	FNDBY3		;OVERFLOWS THE WORD
00390	
00400	;HERE IF ALL IN THIS WORD
00410	
00420		MOVE	T3,POSTMP	;POSITION
00430		LSH	T1,-1(T3)	;BITS TO TOP OF T1
00440		SUBI	T2,^D36(T3)	;BITS TO SHIFT RIGHT=36-SIZE
00450		LSH	T1,(T2)		;NOW TO BOTTOM
00460		JRST	FNDBYX		;STORE LAST WORD AND EXIT
     
00010	;HERE IF SPLIT OVER WORD BOUNDARY
00020	
00030	FNDBY3:	MOVE	T2,SIZTMP	;GET SIZE
00040		CAILE	T2,^D36		;SKIP IF BYTE FITS IN 1 WORD
00050		JRST	FNDBY4		;MORE THAN 36 BITS REQUIRED
00060		PUSH	P,T1		;SAVE FIRST WORD
00070		AOS	T1,ADRTMP	;ADDR OF NEXT WORD
00080		PUSHJ	P,FNDADR	;GET SECOND WORD
00090		POP	P,T2		;RESTORE FIRST WORD
00100		MOVE	T3,POSTMP	;POSITION
00110		LSHC	T1,^D36(T3)	;SHIFT TO TOP OF T1
00120		MOVE	T3,SIZTMP	;SIZE
00130		SUBI	T3,^D36		;-36=BITS TO SHIFT RIGHT
00140		LSH	T1,(T3)		;SHIFT TO BOTTOM OF T1
00150		SOS	ADRTMP		;RESTORE REAL ADDRESS
00160		JRST	FNDBYX		;STORE BYTE AND EXIT
     
00010	;HERE IF MORE THAN 36 BITS REQUIRED
00020	
00030	FNDBY4:	PUSH	P,SIZTMP	;SAVE SIZE
00040		PUSH	P,ADRTMP	;AND ADDRESS
00050	FNDBY5:	PUSH	P,T1		;SAVE CURRENT 36 BITS
00060		AOS	T1,ADRTMP	;ADDRESS OF NEXT WORD
00070		PUSHJ	P,FNDADR	;GET NEXT 36 BITS
00080		POP	P,T2		;RESTORE PREVIOUS 36 BITS
00090		TLNE	F,L.NXM		;NO SKIP IF NXM
00100		POPJ	P,
00110		MOVE	T3,POSTMP	;POSITION
00120		LSHC	T1,^D36(T3)	;SHIFT TO TOP OF T1
00130		MOVE	T4,SIZTMP	;SIZE
00140		SUBI	T4,^D36		;MINUS THESE 36 BITS
00150		JUMPG	T4,FNDBY6	;JUMP IF MORE TO COME
00160		POP	P,ADRTMP	;THIS IS THE LAST, RESTORE ADDRESS
00170		POP	P,SIZTMP
00180		JRST	FNDBYX		;STORE LAST WORD AND EXIT
00190	
00200	FNDBY6:	MOVEM	T4,SIZTMP	;STORE BITS LEFT TO GET
00210		PUSHJ	P,STOBYT	;STORE THESE 36 BITS
00220		MOVNS	T3		;MINUS POSITION
00230		ADDI	T3,^D36		;+36=BITS TO SHIFT TO SAVE REST OF SECOND WORD
00240		LSHC	T1,(T3)		;SAVE PART OF SECOND WORD NOT YET USED
00250		JRST	FNDBY5		;LOOP TILL LAST WORD
00260	
00270	FNDBYX:	PUSHJ	P,STOBYT	;STORE LAST BYTE
00280		MOVE	P1,BYT.Y
00290		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00300		ILDB	T1,P1		;GET FIRST 36 BITS
00310		POPJ	P,
     
00010	;SUBROUTINE TO GET A WORD FROM THE INPUT FILE
00020	;ARGS	T1=ADDRESS OF WORD DESIRED
00030	;VALUES	T1=CONTENTS OF WORD DESIRED
00040	;	BIT L.NXM OF F SET IF NXM
00050	
00060	FNDADR:	JUMPL	T1,RETNXM	;NEGATIVE ADDRESSES ARE NOT IN FILE
00070		PUSHJ	P,.SAVE2	;SAVE P1,P2
00080		TLNN	DL,DL.SYM	;SKIP IF READING SYMBOLS
00090		PUSHJ	P,CMPOFF	;OFFSET IF NECESSARY THE ADDRESS TO FIND
00100		MOVEM	T1,TEMPAD	;ACTUAL ADDRESS TO FETCH
00110		TLZ	F,L.NXM		;CLEAR NXM FLAG
00120	FNDAD1:	SKIPG	T1,%TYP(DL)	;SKIP IF TYPE OF INPUT FILE KNOWN
00130		JRST	NOTYP		;NO, TRY TO FIND OUT
00140		SUBI	T1,1
00150		HLLZS	%EXT(DL)	;CLEAR MASK
00160		SKIPN	T2,%EXT(DL)	;SKIP IF NO EXT KNOWN YET
00170		HLLZ	T2,I.DEX(T1)	;NO, GET DEFAULT
00180		MOVEM	T2,%EXT(DL)
00190		ROT	T1,-1		;DIVIDE BY 2
00200		MOVE	T2,TYPVEC(T1)	;DISPATCH ADDRESS
00210		CAIL	T1,0		;SKIP IF WANT RIGHT HALF
00220		MOVSS	T2		;NO, WANT ADDR IN LH
00230		JRST	(T2)		;CALL ROUTINE TO FIND WORD
00240	
00250	;HERE IF TYPE OF INPUT FILE NOT KNOWN, TRY TO FIND OUT BY ITS EXTENSION
00260	
00270	NOTYP:	PUSHJ	P,.SAVE1		;SAVE P1
00280		MOVEI	P1,(DL)		;POINTER TO FILE SPEC
00290		PUSHJ	P,GETSPC	;PICK UP STICKY DEFAULTS
00300		MOVE	T1,%DEV(DL)	;INPUT DEVICE
00310		DEVCHR	T1,
00320		TLNN	T1,DV.DIR	;SKIP IF A DIRECTORY DEVICE
00330		JRST	NOTYPD		;NO, USE DEFAULT
00340		MOVEI	T1,17		;DIRECTORY DEVICE, LOOK FOR EXTENSIONS
00350		MOVE	T2,%DEV(DL)
00360		SETZ	T3,
00370		OPEN	IC,T1
00380		  JRST	E.LKO		;CANT OPEN INPUT DEVICE
00390		SKIPE	T2,%EXT(DL)	;SKIP IF NO EXT SPECIFIED
00400		JRST	EXTTYP		;LOOK AT EXT SPECIFIED
00410		MOVSI	P1,-I.LDEX
00420		MOVE	T1,%NAM(DL)	;NAME OF INPUT FILE
00430		SETZ	T3,
00440	NOTYP1:	HLLZ	T2,I.DEX(P1)	;NEXT EXT TO TRY
00450		PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
00460		LOOKUP	IC,T1
00470		  AOBJN	P1,NOTYP1	;NO SUCH FILE, TRY NEXT
00480		JUMPGE	P1,E.NSFI	;JUMP IF CANT FIND ANY FILES
00490		HLLM	T2,%EXT(DL)	;STORE EXT USED
00500		HRROI	T1,1(P1)	;T1=TYPE
00510		JRST	EXTTY2		;GO STORE TYPE
     
00010	;HERE IF EXTENSION SPECIFIED
00020	
00030	EXTTYP:	MOVE	T1,%NAM(DL)
00040		SETZ	T3,
00050		PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
00060		LOOKUP	IC,T1
00070		  JRST	E.NSFI
00080		HLLM	T2,%EXT(DL)
00090		MOVSI	T1,-I.LDEX
00100	EXTTY1:	HRR	T2,I.DEX(T1)	;LOOK FOR EXTENSION ON LIST
00110		CAME	T2,I.DEX(T1)	;SKIP IF FOUND IT
00120		AOBJN	T1,EXTTY1
00130		ADDI	T1,1
00140	EXTTY2:	MOVEI	T2,T.TMP
00150		CAIN	T2,(T1)		;SKIP IF NOT TMP FILE
00160		HRRZ	T2,%NAM(DL)	;TYPE FROM NAME OF FILE
00170		CAIN	T2,(SIXBIT .DAE.)	;SKIP IF NOT DAEMON FILE
00180		HRROI	T1,T.DAE	;NNNDAE.TMP IS A DAEMON FILE
00190		CAIL	T1,0		;SKIP IF FOUND ONE
00200	NOTYPD:	MOVEI	T1,AD.TYP	;DEFAULT
00210		HRRZM	T1,%TYP(DL)
00220		JRST	FNDAD1
     
00010	;SUBROUTINE TO FIND A WORD IN A DAEMON FILE
00020	
00030	FNDDAE:	TLNN	F,L.IOPN	;INPUT OPEN?
00040		PUSHJ	P,OPNDAE	;NO--GO SET UP FILE
00050	FNDDA0:	PUSHJ	P,.SAVE1	;SAVE P1
00060		MOVE	T1,CATNUM	;CATEGORY DESIRED FOR THIS BYTE
00070		EXCH	T1,DAECCT	;STORE AS CURRENT CATEGORY AND SAVE LAST
00080		CAMN	T1,DAECCT	;SKIP IF WAS NOT AT THAT CATEGORY
00090		JRST	FNDDA5		;ALREADY IN THE CATEGORY
00100		SETZM	CATBLK		;REWIND THE DAEMON FILE AND SCAN
00110		SETZM	CATWRD		; FROM THE START.
00120	FNDDA3:	AOS	T1,CATBLK	;SET BEGINNING OF CATEGORY TO BLOCK 1 OF FILE
00130		MOVEM	T1,DAECBK	;REMEMBER CURRENT BLOCK
00140		USETI	IC,(T1)		;START AT THAT BLOCK
00150		INPUT	IC,INPLST	;READ THE BLOCK
00160		SETZB	T2,DAECWD	;CLEAR CURRENT WORD IN BLOCK
00170		PUSHJ	P,CATRW1	;SET UP BEGINNING OF CATEGORY
00180		MOVE	T2,DMHEAD	;T2=ADDRESS OF NEXT WORD IN INPUT BUFFER
00190		MOVE	T1,(T2)		;GET CATEGORY NUMBER
00200	FNDDA1:	CAMN	T1,DAECCT	;SKIP IF NOT CATEGORY DESIRED
00210		JRST	FNDDA2		;POSITIONED AT BEGINNING OF CATEGORY
00220		PUSHJ	P,READDM	;GET LENGTH
00230		TLNE	F,L.IEOF	;END OF FILE
00240		PJRST	RETNXM		;YES--RETURN NXM
00250		MOVE	P1,T1
00260	FNDDA4:	PUSHJ	P,READDM
00270		SOJGE	P1,FNDDA4	;READ PAST CATEGORY
00280		JRST	FNDDA1
00290	FNDDA2:	PUSHJ	P,READDM	;READ LENGTH OF CATEGORY
00300		MOVE	T2,DAECBK	;CURRENT BLOCK NUMBER
00310		IMULI	T2,WINSIZ	;CONVERTED TO WORDS
00320		ADD	T2,DAECWD	;PLUS CURRENT WORD NUMBER
00330		SUBI	T2,WINSIZ-1	;- ONE BLOCK+1=OFFSET FROM BEGINNING OF FILE
00340		ADD	T1,T2		;PLUS LENGTH OF CAT=OFFSET OF LAST WORD OF CAT+1
00350		MOVEM	T1,CATLEN	;STORE LAST WORD OF CATEGORY
00360		MOVNM	T2,HGHOFF	;AND OFFSET FOR BEGINNING OF CATEGORY
00370		MOVEI	T1,CATBLK-1
00380		PUSH	T1,DAECBK
00390		PUSH	T1,DAECWD
     
00010	;HERE WHEN SOMEWHERE IN CATEGORY
00020	
00030	FNDDA5:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
00040		MOVE	T2,CATNUM	;CATEGORY
00050		CAIN	T2,CA.COR	;CORE??
00060		JRST	FNDDA6		;YES--GO DO IT
00070		CAMGE	T1,WINADR	;IN THIS WINDOW?
00080		PUSHJ	P,CATREW	;NO--REWIND
00090		JRST	DATRED		;READ AS DATA
00100	
00110	;HERE IF CORE
00120	
00130	FNDDA6:	TLNE	T1,-1		;BITS IN LEFT HALF?
00140		JRST	RETNXM		;YES--NOT IN FILE
00150		TLNE	DL,DL.ANXM	;DO AC'S EXIST
00160		JRST	RETNXM		;NO--DUMB DUMP
00170		TLNN	F,L.IOPN	;INPUT SETUP?
00180		JRST	FNDDA7		;NO--CAN NOT TRUST JOBDAT
00190		TRNN	T1,777600	;LESS THAN 200(8)
00200		TLNE	DL,DL.SYM	;READING SYMBOLS?
00210		JRST	FNDDA7		;YES--DO NOT USE BUFFER IT IS WRONG
00220		JRST	[MOVE T1,JOBDAT(T1) ;YES--RETURN DATA FROM BUFFER
00230			 POPJ P,]	; ..
00240		MOVEI	T2,.JBREL##	;DUMB LOADER
00250		CAMG	T1,JOBDAT(T2)	;SKIP IF NOT IN LOWSEG
00260		JRST	FNDDA7		;IN LOWSEG GO READ
00270		CAIL	T1,400000	;SKIP IF IN HISEG
00280		JRST	RETNXM		;BETWEEN SEGMENTS RETURN NXM
00290	FNDDA7:	CAMGE	T1,WINADR	;BELOW THIS WINDOW
00300		PUSHJ	P,CATREW	;YES--REWIND FILE
00310		JRST	CMPRED		;READ CORE IMAGE
     
00010	;HERE TO SET UP DAEMON FILE
00020	
00030	OPNDAE:	PUSHJ	P,OPNDMP	;OPEN THE FILE
00040		TLNE	DL,DL.SYM	;READING THE SYMBOL FILE
00050		POPJ	P,		;YES--RETURN WITHOUT BUFFERING
00060		TLZ	F,L.IOPN	;CLEAR THE BIT FOR NOW
00070		TLZ	DL,DL.ANXM	;CLEAR CORE 0 BIT
00080		PUSHJ	P,.SAVE1##	;SAVE P1
00090		PUSH	P,CATNUM	;SAVE CATEGORY
00100		PUSH	P,TEMPAD	;SAVE ADDRESS
00110		MOVEI	T1,CA.COR	;MAKE IT LOOK LIKE CORE
00120		MOVEM	T1,CATNUM	; ..
00130		MOVSI	P1,-200		;SIZE OF JOBDAT BUFFER
00140		SETZM	TEMPAD		;CLEAR TEMP POINTER
00150		SETZM	DAECCT		;CLEAR ALL RECOLECTIONS OF
00160		SETZM	CATBLK		; LIFE IN THE PAST.
00170		SETZM	CATWRD
00180		HRLOI	T1,377777	;CAUSE THE WINDOW TO BE
00190		MOVEM	T1,WINADR	; WASHED.
00200	OPNDA1:	PUSHJ	P,FNDDA0	;GET THE WORD
00210		MOVEM	T1,JOBDAT(P1)	;STORE
00220		TLNE	F,L.NXM		;NXM??
00230		TLO	DL,DL.ANXM	;YES -- NO CORE ASSIGNED
00240		AOS	TEMPAD		;ADVANCE POINTER
00250		AOBJN	P1,OPNDA1	;LOOP FOR MORE
00260		POP	P,TEMPAD	;RESTORE LOCALS
00270		POP	P,CATNUM	; ..
00280		TLO	F,L.IOPN	;OPEN NOW
00290		POPJ	P,		;RETURN
     
00010	;SUBROUTINE TO FIND A WORD IN AN EXPANDED FILE
00020	
00030	FNDXPN:
00040	
     
00010	;SUBROUTINE TO FIND A WORD IN A DATA FILE
00020	
00030	FNDTMP:
00040	FNDDAT:	SETZM	HGHOFF		;OFFSET=ZERO
00050		PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
00060		PJRST	DATRED		;AND FIND WORD
00070	
00080	;SUBROUTINE TO FIND A WORD IN A HIGH SEGMENT FILE
00090	
00100	FNDHGH:
00110	FNDSHR:	TLNE	F,L.IOPN	;SKIP IF INPUT NOT YET OPEN
00120		PJRST	DATRED
00130		PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
00140		MOVEI	T2,.JBHCR	;WORD WHICH CONTAINS LOW SEG SIZE
00150		PUSHJ	P,READDM	;READ UP TO .JBHCR
00160		SOJGE	T2,.-1
00170		HRRZS	T1		;RH=SIZE OF LOW SEGMENT
00180		ADDI	T1,1777
00190		TRZ	T1,1777		;ROUND UP TO NEXT K
00200		CAIGE	T1,400000	;WHICH IS START OF HIGH SEG
00210		MOVEI	T1,400000	;BUT MUST BE AT LEAST 400000
00220		MOVEM	T1,HGHOFF	;OFFSET FOR HIGH SEGMENT
00230	
00240	;HERE WHEN INPUT FILE OPEN AND OFFSET KNOWN
00250	
00260	;	PJRST	DATRED
00270	;SUBROUTINE TO READ A WORD FROM A DATA FILE
00280	;ARGS	TEMPAD=ADDRESS OF WORD TO GET
00290	;	HGHOFF=ADDRESS OFFSET FOR FIRST WORD OF FILE
00300	;VALUES	T1=CONTENTS OF WORD DESIRED
00310	
00320	DATRED:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
00330		SUB	T1,HGHOFF	;-OFFSET=WORD NUMBER IN FILE
00340		JUMPL	T1,RETNXM	;RETURN NXM IF NOT THERE
00350		CAML	T1,CATLEN	;SKIP IF NOT PAST END OF FILE
00360		PJRST	DATRD1		;NXM
00370		SUB	T1,WINADR	;SUBTRACT ADDRESS OF BEGINNING OF WINDOW
00380		JUMPL	T1,DATRD2	;JUMP IF WINDOW PAST LOCATION
00390		CAIL	T1,WINSIZ	;SKIP IF IN CURRENT BLOCK
00400		JRST	DATRD2		;NO, READ UP TO IT
00410		SKIPA	T1,WINDOW(T1)	;GET WORD
00420	DATRD1:	TLO	F,L.IEOF!L.NXM	;END OF FILE
00430		POPJ	P,		;AND EXIT
00440	DATRD2:	ADD	T1,WINADR	;ADDRESS DESIRED
00450		LSH	T1,-7		;CONVERT TO BLOCK NUMBER
00460		USETI	IC,1(T1)	;SET TO READ THAT BLOCK
00470		LSH	T1,7		;RESET TO WORD ADDRESS OF BEGINNING OF BLOCK
00480		MOVEM	T1,WINADR	;AND REMEMBER THAT AS THE START OF THE WINDOW
00490		IN	IC,WINLST
00500		  JRST	DATRED
00510		PUSHJ	P,DATRED	;T1 _ WORD (MAY BE JUNK)
00520		JRST	READDE
     
00010	;SUBROUTINE TO FIND A WORD IN A LOW OR SAVE FILE
00020	
00030	FNDLOW:
00040	FNDSAV:	TLNE	F,L.IOPN	;SKIP IF INPUT FILE NOT YET OPEN
00050		JRST	FNDSV1
00060		PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
00070		PUSHJ	P,CATRW2	;SET UP FOR READING
00080	FNDSV1:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
00090		CAMGE	T1,WINADR	;SKIP IF NOT YET TO ADDR
00100		PUSHJ	P,SAVREW	;REWIND SAVE FILE
00110	;	PJRST	CMPRED		;READ WORD FROM COMPRESSED FILE
00120	
00130	;SUBROUTINE TO FIND A WORD IN A COMPRESSED FILE
00140	;ARGS	T1=TEMPAD=ADDRESS OF WORD
00150	;VALUES	T1=CONTENTS OF WORD
00160	;	L.NXM BIT OF F SET IF NXM
00170	;NOTE: CALL WITH T1 .GE. WINADR. CALL SAVREW OR CATREW AS NEEDED
00180	;	TO MEET THIS RESTRICTION.
00190	
00200	CMPRED:	SUB	T1,WINADR	;INDEX OF WORD RELATIVE TO CURRENT WINDOW
00210		CAIGE	T1,WINSIZ	;SKIP IF NOT IN WINDOW
00220		JRST	CMPRD1		;THE DESIRED WORD IS IN THE WINDOW
00230		PUSHJ	P,REDWIN	;READ NEXT WINDOW
00240		MOVE	T1,TEMPAD	;RESTORE ADDRESS DESIRED
00250		TLNN	F,L.IEOF	;SKIP IF NXM
00260		JRST	CMPRED		;LOOP TILL FIND PROPER WINDOW
00270		SUB	T1,WINADR	;INDEX OF WORD IN WINDOW
00280	CMPRD1:	CAMLE	T1,WINLEN	;SKIP IF WORD REALLY CONTAINS DATA
00290	RETNXM:	TLOA	F,L.NXM		;NO, PAST END OF DATA
00300		MOVE	T1,WINDOW(T1)	;RETURN WORD DESIRED
00310		POPJ	P,
     
00010	FNDDDI:
00020	FNDDEC:
00030	FNDDMP:
00040	FNDSDS:
00050		POPJ	P,
     
00010	;SUBROUTINE TO FILL NEXT WINDOW
00020	
00030	REDWIN:	MOVEI	T2,WINSIZ	;SIZE OF WINDOW
00040		MOVEM	T2,WINLEN	;ASSUME FULL WINDOW TO BE STORED
00050		ADDB	T2,WINADR	;NEW ADDRESS OF BEGINNING OF WINDOW
00060		SETZM	WINDOW
00070		MOVE	T1,[XWD WINDOW,WINDOW+1]
00080		BLT	T1,WINDOW+WINSIZ-1 ;CLEAR WINDOW TO START
00090	REDWN1:	SKIPGE	T3,CURIOW	;SKIP IF OLD IOWD EXHAUSTED
00100		JRST	REDWN2
00110		PUSHJ	P,READDM	;READ NEXT IOWD
00120		MOVEM	T1,CURIOW	;SAVE IOWD
00130		JUMPL	T1,REDWN1	;JUMP IF REAL IOWD
00140		SUB	T2,WINADR	;T2=ADDR IN WINDOW OF LAST WORD STORED
00150		MOVEM	T2,WINLEN
00160		TLO	F,L.IEOF	;NOTE END OF INPUT FILE
00170		POPJ	P,
00180	REDWN2:	MOVEI	T1,1(T3)	;T1=ADDR OF NEXT PIECE FROM FILE
00190		HRRZ	T2,T3
00200		CAIE	T2,-1		;SKIP IF ADDR = -1
00210		JRST	REDWN5		;OK
00220		AOSN	T3		;AOBJP WORKS FUNNY BECAUSE OF OVERFLOW
00230		SOSA	T3		;BUT IF WAS -1 POP LOSES
00240		POP	T3,T2		;SO MAKE IT COME OUT RIGHT AFTER FIRST
00250	REDWN5:	MOVE	T2,WINADR	;ADDRESS OF FIRST LOCATION IN WINDOW
00260		SUBM	T1,T2		;T2=INDEX INTO WINDOW
00270		CAIL	T2,WINSIZ	;SKIP IF PIECE STARTS IN THIS WINDOW
00280		POPJ	P,		;NO, WINDOW IS BETWEEN PIECES, ALL ZERO
00290		HRLI	T2,-WINSIZ(T2)
00300	REDWN3:	PUSHJ	P,READDM
00310		MOVEM	T1,WINDOW(T2)	;STORE NEXT WORD
00320		AOBJP	T3,REDWN4	;EXIT IF END OF PIECE FROM INPUT FILE
00330		AOBJN	T2,REDWN3	;LOOP TILL WINDOW FULL
00340		MOVEM	T3,CURIOW	;SAVE IOWD FOR REST OF PIECE FROM FILE
00350		POPJ	P,
00360	REDWN4:	HRRZ	T2,T3		;T2=LAST ADDRESS STORED
00370		SETZM	CURIOW		;NOTE IOWD EXHAUSTED
00380		JRST	REDWN1		;GET NEXT PIECE
     
00010	;SUBROUTINE TO REWIND A SAVE FILE
00020	;SAVES T1
00030	
00040	SAVREW:	MOVEM	T1,CURIOW	;SAVE T1, CURIOW CLOBBERED HERE ANYWAY
00050		USETI	IC,1		;SET TO READ FIRST BLOCK OF FILE
00060		SETZM	DMHEAD		;SET TO RECOMPUTE HEADER
00070		JRST	CATRW2		;FINISH UP
00080	
00090	;SUBROUTINE TO REWIND THE CURRENT CATEGORY FOR DAEMON FILES
00100	
00110	CATREW:	MOVEM	T1,CURIOW	;SAVE T1, CURIOW CLOBBERRED HERE ANYWAY
00120		MOVE 	T1,CATBLK	;BLOCK OF BEGINNING OF CATEGORY
00130		MOVEM	T1,DAECBK	;REMEMBER CURRENT BLOCK
00140		USETI	IC,(T1)
00150		INPUT	IC,INPLST
00160		HRRZ	T2,CATWRD
00170		MOVEM	T2,DAECWD	;REMEMBER CURRENT WORD IN BLOCK
00180	CATRW1:	HRLS	T2
00190		ADD	T2,[XWD -200,IBUF]
00200		MOVEM	T2,DMHEAD
00210	CATRW2:	MOVNI	T1,WINSIZ
00220		MOVEM	T1,WINADR
00230		MOVE	T1,CURIOW	;RESTORE T1
00240		SETZM	CURIOW		;NOTE NO IOWD READY
00250		TLZ	F,L.IEOF	;CLEAR EOF FLAG
00260		POPJ	P,
     
00010	;SUBROUTINE TO READ NEXT WORD FROM INPUT FILE IN DUMP MODE
00020	
00030	READDM:	TLNE	F,L.IEOF	;SKIP IF END OF FILE
00040		POPJ	P,
00050		AOS	DAECWD		;COUNT WORDS READ
00060		MOVE	T1,DMHEAD
00070		AOBJN	T1,READD1
00080		INPUT	IC,INPLST
00090		STATZ	IC,760000	;SKIP IF NO ERRORS
00100		JRST	READDE
00110		AOS	DAECBK
00120		SETZM	DAECWD
00130		MOVE	T1,[XWD -200,IBUF]
00140	READD1:	MOVEM	T1,DMHEAD
00150		MOVE	T1,(T1)
00160		POPJ	P,
00170	
00180	READDE:	GETSTS	IC,N
00190		TRNE	N,IO.EOF	;SKIP IF NOT END OF FILE
00200		JRST	READEO
00210		M.FAIO	<INPUT ERROR STATUS =>
00220	
00230	READEO:	TLO	F,L.IEOF
00240		POPJ	P,
     
00010	;SUBROUTINE TO OPEN THE INPUT FILE IN DUMP MODE
00020	
00030	OPNDMP:	TLNE	F,L.IOPN	;SKIP IF NOT YET OPEN
00040		POPJ	P,		;ALREADY OPEN
00050		PUSHJ	P,.SAVE1##	;SAVE P1
00060		MOVE	P1,(DL)		;POINT TO SPEC
00070		PUSHJ	P,GETSPC	;GET STICKEY DEFAULTS
00080		MOVEI	T1,17		;DUMP MODE
00090		MOVE	T2,%DEV(DL)	;INPUT DEVICE
00100		SETZ	T3,
00110		OPEN	IC,T1
00120		  JRST	E.LKO		;NO SUCH DEVICE
00130		MOVE	T1,%NAM(DL)	;NAME OF INPUT FILE
00140		SETZB	T3,DMHEAD
00150	OPNDM1:	MOVE	T2,%EXT(DL)	;EXTENSION
00160		PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
00170		LOOKUP	IC,T1
00180		  JRST	OPNDM2		;TRY NULL EXTENSION IF NONE SPECIFIED
00190		HLRE	T1,T4		;T1=LENGTH OF FILE
00200		JUMPLE	T1,.+2		;JUMP IF WORDS
00210		LSH	T1,7		;CONVERT BLOCKS TO WORDS
00220		MOVMM	T1,CATLEN	;STORE +LENGTH OF FILE IN WORDS
00230		TLO	F,L.IOPN	;NOTE INPUT FILE OPEN
00240		HRLOI	T1,377777	;WE HAVE NEVER READ THE WINDOW
00250		MOVEM	T1,WINADR	; SO CAUSE US TO READ ON THE NEXT
00260					; TRY.
00270		POPJ	P,		;AND EXIT
00280	OPNDM2:	MOVE	T4,%EXT(DL)
00290		TRNE	T4,-1		;SKIP IF NO EXT WAS SPECIFIED
00300		JRST	E.NSFI		;THERE WAS, CANT FIND FILE SPECIFIED
00310		HRLOM	T4,%EXT(DL)
00320		JRST	OPNDM1		;TRY NULL
     
00010	;SUBROUTINE TO COMPUTE OFFSET FOR AN ADDRESS
00020	;ARGS	T1=ADDRESS
00030	;VALUES	T1=ADDRESS AFTER OFFSET
00040	
00050	CMPOFF:	MOVN	T2,OFFLEN	;MINUS LENGTH OF OFFSET TABLE
00060		JUMPGE	T2,.POPJ	;NO CHANGE IF NO OFFSETS
00070		HRLZS	T2
00080		HRR	T2,OFFTAB	;MAKE AOBJN PTR TO OFFSET TABLE
00090	CMPOF1:	HLRZ	T3,(T2)		;BEGINNING OF THIS OFFSET REGION
00100		HRRZ	T4,(T2)		;ENDING OF THIS REGION
00110		CAML	T1,T3		;SKIP IF ADDRESS NOT IN THIS REGION
00120		CAMLE	T1,T4		;SKIP IF ADDRESS IS IN THIS REGION
00130		JRST	CMPOF2		;NOT IN THIS REGION
00140		ADD	T1,1(T2)	;ADDRESS IS IN THIS REGION, OFFSET
00150		POPJ	P,		;EXIT
00160	CMPOF2:	AOBJP	T2,.POPJ	;LOOK FOR NEXT REGION, EXIT IF NO MORE
00170		AOBJN	T2,CMPOF1	;JUMP IF MORE OFFSETS SPECIFIED
00180		POPJ	P,
00190	
00200	;SUBROUTINE TO STORE A VALUE IN A TABLE
00210	;ARGS	T1=VALUE
00220	;	P1=BYTE POINTER TO BE INCREMENTED
00230	;	P2=INDEX IN TABLE VECTOR
00240	
00250	STOBYT:	PUSH	P,T1		;SAVE VALUE
00260		IBP	P1		;READY BYTE POINTER FOR STORING
00270		TLNE	P1,(@)		;IS INDIRECT BIT ON?
00280		HALT	.		;YES--BUG
00290		MOVEI	T1,(P1)		;ADDR TO STORE INTO
00300		SUB	T1,TABVEC(P2)	;-BEGINNING OF TABLE
00310		CAML	T1,LENVEC(P2)	;CURRENT LENGTH OF TABLE
00320		PUSHJ	P,TABEXP	;EXPAND TABLE
00330		POP	P,T1		;RESTORE VALUE
00340		DPB	T1,P1		;STORE VALUE
00350		POPJ	P,		;AND EXIT
00360	
00370	;SUBROUTINE TO EXPAND TABLE TO BE BIG ENOUGH TO STORE VALUE
00380	;ARGS	T1=SIZE NEEDED - 1
00390	;	P2=INDEX IN TABLE VECTOR
00400	
00410	TABEXP:	SUB	T1,LENVEC(P2)	;SUBTRACT CURRENT SIZE=NUM WORDS NEEDED-1
00420		AOJA	T1,GETCOR	;EXPAND CORE
     
00010	;SUBROUTINE TO CLEAR INDIRECT BIT IN A BYTE POINTER
00020	; NEEDED BECAUSE HARDWARE INCREMENTS THE ADDRESS IN THE
00030	; POINTER AND WE WANT TO INCREMENT THE ADDRESS IT IS
00040	; POINTING TO.
00050	;ARGS:	P1=BYTE POINTER
00060	;VALUE:	P1=BYTE POINTER (FOR SHORT USE)
00070	;USES NO ACS
00080	;
00090	MKPNTR:	PUSH	P,P1	;SAVE OLD POINTER
00100		MOVEI	P1,@P1	;COMPUTE REAL ADDRESS
00110		HLL	P1,(P)	;GET POINTER PART
00120		TLZ	P1,37	;CLEAR INDEX AND INDIRECT
00130		POP	P,(P)	;CLEAR STACK
00140		POPJ	P,	;RETURN
     
00010		SUBTTL	SUBROUTINES FOR LISTING OUTPUT
00020	;SUBROUTINE TO OUTPUT A VALUE
00030	;ARGS	T1=VALUE
00040	;	TABLES INCLUDE MODES, WIDTHS, JUSTIFY, ETC.
00050	
00060	OUTPT:	MOVEM	T1,OUTVAL	;SAVE VALUE TO OUTPUT
00070		PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
00080		SETZM	PADCNT		;CLEAR COUNT OF PAD BYTES
00090		TRZ	F,R.OVR!R.CNT!R.LFD!R.FFD ;CLEAR COUNT AND OVERFLOW BITS
00100		TLNE	F,L.AUTO	;SKIP IF AUTOFORM OFF
00110		TRO	F,R.CNT		;NOTE COUNTING
00120		HRLM	F,(P)		;SAVE HEADER BITS
00130	OUTPTS:	PUSH	P,PAGNUM	;SAVE CURRENT PAGE NUMBER
00140		PUSH	P,CURCHR	;AND CHARACTER COUNTER
00150		PUSH	P,LINNUM	;AND LINE COUNTER, I.E. CURRENT CHAR POSITION
00160		PUSHJ	P,SETWJL	;SET UP WIDTH AND JUSTIFY LISTS
00170		TLNE	F,L.NXM		;NO SKIP IF NXM
00180		JRST	OUTNXM
00190		TLZ	DL,DL.NXM	;NO LONGER IN NXM.
00200		MOVE	P1,[POINT W.S,LPAD] ;POINTER TO TEMP LIST
00210		MOVEM	P1,LPAD.Y	;STORE FOR LATER
00220		MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
00230		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00240		ILDB	T1,P1		;GET FIRST MODE
00250		CAIN	T1,M.END	;SKIP IF NOT END OF LIST
00260		JRST	OUTPTX		;END OF OUTPUT
00270		CAIE	T1,M.ALL	;SKIP IF ALL MODES REQUESTED
00280		JRST	OUTPT1		;OUTPUT VALUE IN THIS MODE
00290		MOVE	P1,[POINT M.S,MODLAL] ;POINTER TO LIST OF ALL MODES
00300		ILDB	T1,P1		;FIRST MODE
00310	OUTPT1:	CAIN	T1,M.ALL
00320		JRST	OUTPTN		;DONT DO "ALL" HERE
00330		ROT	T1,-1
00340		MOVE	T2,MODADR(T1)	;GET ADDRESS OF ROUTINE FOR THIS MODE
00350		CAIL	T1,0		;SKIP IF ADDR IN RIGHT HALF
00360		MOVSS	T2		;ADDR IN LEFT HALF
00370		TLNE	DL,DL.WID	;SKIP IF NO MORE WIDTH SPECS
00380		TLNN	F,L.AUTO	;SKIP IF AUTO-FORMAT ON
00390		JRST	OTPT1A		;JUMP IF NOT AUTOFORMATTING WIDTHS
00400		ILDB	T4,WIDTMP	;GET A WIDTH SPEC.
00410		CAIN	T4,W.END	;SKIP IF NOT DONE
00420		JRST	OTPT1A		;DONE--NO MORE SPECS
00430		ADD	T4,CURCHR	;ADD IN CURRENT POSITION
00440		CAMLE	T4,RMARGN	;SKIP IF THIS WILL FIT
00450		TRO	F,R.OVR		;PUT WHOLE FIELD ON NEW LINE
     
00010	OTPT1A:	TRNE	F,R.CNT		;ARE WE JUST COUNTING?
00020		JRST	OUTPT6		;YES--LIST IS EMPTY
00030		TRZE	F,R.OVR		;DO WE NEED A CRLF?
00040		PUSHJ	P,NEWLIN	;YES--GO DO IT PRIOR TO BLANKS
00050		MOVEI	C," "		;NO--SET UP A BLANK
00060		SOSL	T4,PADCNT	;SKIP IF NO COUNTS LEFT
00070		ILDB	T4,LPAD.Y	;T4 GETS NUMBER OF BLANKS TO STICK
00080					; ON THE FRONT OF THE BYTE TO LINE
00090					; IT UP IN THE FIELD.
00100		JUMPLE	T4,OUTPT6	;JUMP IF NONE REQUIRED
00110		PUSHJ	P,LCHR		;LIST A BLANK
00120		SOJG	T4,.-1		;LOOP FOR ALL WE NEED
     
00010	OUTPT6:	PUSHJ	P,(T2)		;CALL ROUTINE TO OUTPUT VALUE IN THIS MODE
00020		TLNN	DL,DL.WID	;ARE THERE ANY WIDTH SPECS LEFT?
00030		JRST	OUTPT4		;NO--SKIP THE CHECKS
00040		LDB	T2,WIDTMP	;GET THE WIDTH
00050		CAIN	T2,W.END	;IS THIS THE END?
00060		JRST	[TLZ DL,DL.WID	;YES--CLEAR THE BIT
00070			 JRST OUTPT4]	;AND PUNT
00080		MOVE	T1,SAVCCH	;LOAD T1 WITH THE NUMBER OF CHARS
00090					; USED FOR DATA WHEN THAT FIELD WAS
00100					; PRINTED. THIS VALUE IS COMPUTED
00110					; IN ROUTINE FORMAT.
00120		SUB	T2,T1		; LESS WIDTH IS NUMBER OF BLANKS
00130					; TO ADD-ON
00140		TLNN	DL,DL.JUS	;ANY JUSTIFY KEYS LEFT?
00150		SKIPA	T1,[J.LFT]	;NO--ASSUME LEFT
00160		ILDB	T1,JUSTMP	;YES--GET THE KEY
00170		CAIN	T1,J.END	;IS THIS THE END
00180		JRST	[MOVEI T1,J.LFT ;YES--ASSUME LEFT
00190			 TLZ   DL,DL.JUS;CLEAR THE "WE HAVE A BYTE" BIT
00200			 JRST  .+1]	;CONTINUE
00210		JUMPLE	T2,OUTPT4	;JUMP IF NEED NO FILLERS
00220		TRNE	F,R.CNT		;ONLY COUNTING?
00230		JRST	OUTPT5		;YES--GE STORE FIXUP
00240		CAIN	T1,J.RHT	;NO--IS THIS RIGHT JUSTIFIED?
00250		JRST	OUTPT4		;YES--WE DID THAT
00260		CAIN	T1,J.CEN	;IS THIS CENTERED
00270		LSH	T2,-1		;YES--CENTER IT
00280		MOVEI	C," "		;SET UP A BLANK
00290		PUSHJ	P,LCHR		;PRINT IT
00300		SOJG	T2,.-1		;LOOP FOR AS MANY BLANKS AS WE NEED
00310		JRST	OUTPT4		;CONTINUE
00320	OUTPT5:	CAIN	T1,J.LFT	;LEFT JUSTIFICATION?
00330		SETZ	T2,		;YES--NO LEADING BLANKS
00340		CAIN	T1,J.CEN	;IF WE NEED AN ODD NUMPER OF PADS
00350		AOS	T2		; CENTERING A FIELD PUT THE FREE
00360					; SPACE IN FRONT.
00370		CAIN	T1,J.CEN	;CENTER IT
00380		LSH	T2,-1		;YES--HALF LEAD ; HALF TRAIL
00390		IDPB	T2,LPAD.Y	;STORE AWAY
00400		AOS	PADCNT		;COUNT THE BYTE
     
00010	OUTPT4:
00020	OUTPTN:	ILDB	T1,P1		;NEXT MODE
00030		CAIN	T1,M.END	;SKIP IF NOT END OF MODES LIST
00040		JRST	OUTPTX		;END OF OUTPUT
00050		TLNN	DL,DL.WID	;IF WE HAVE A WIDTH LIST DO ADD SPACES
00060		PUSHJ	P,LSPC3		;OUTPUT 3 SPACES BETWEEN MODES
00070		JRST	OUTPT1
00080	OUTNXM:	TLOE	DL,DL.NXM	;FLAG NXM
00090		JRST	OUTPTX		;STILL SAME BLOCK OF NXM
00100		MOVEI	M,[ASCIZ .<word is not in file>.]
00110		PUSHJ	P,LSTR		;OUTPUT NXM INDICATOR
00120		TRO	F,R.OVR			;NOTE LINE OVERFLOW
00130		TRNE	F,R.CNT		;ARE WE COUNTING?
00140		TLZ	DL,DL.NXM	;YES--CAUSE OUTPUT TO HAPPEN AGAIN
00150					; FOR REAL PRINTING
00160	
00170	OUTPTX:	TRZN	F,R.CNT		;SKIP IF WERE COUNTING, NOT OUTPUTTING
00180		JRST	OUTPT3		;ACTUALLY OUTPUT, ALMOST DONE
00190	OUTPT2:	POP	P,LINNUM	;RESET BEGINNING CHARACTER POSITION
00200		POP	P,CURCHR
00210		POP	P,PAGNUM
00220		MOVSI	T1,R.LHED	;RESTORE LINE HEADER BIT
00230		TDNE	T1,(P)
00240		TRO	F,R.LHED
00250		TRZ	F,R.OVR		;CLEAR OVERFLOW FLAG
00260		JRST	OUTPTS		;AND START OVER ACTUALLY OUTPUTTING
00270	
00280	OUTPT3:	POP	P,T1		;IGNORE EARLIER CHAR POSITION
00290		POP	P,T1
00300		POP	P,T1
00310		TLNE	F,L.AUTO	;IF AUTOFORMAT OFF
00320		TRNN	F,R.OVR		;OR NO OVERFLOW,
00330		POPJ	P,		;ALL DONE
00340		PJRST	NEWLIN		;IF OVERFLOW AND AUTOFORMAT ON, CRLF
     
00010	;SUBROUTINE TO SET UP WIDTH AND JUSTIFY LISTS
00020	
00030	SETWJL:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
00040		TLO	DL,DL.WID!DL.JUS;TRY TO FILL AND JUSTIFY
00050		MOVE	P1,J.Y		;BYTE POINTER TO JUSTIFY LIST
00060		PUSHJ	P,MKPNTR	;FIX @ BIT
00070		MOVEM	P1,JUSTMP	;SAVE FOR ILDB'ING
00080		MOVE	P1,W.Y		;BYTE POINTER TO WIDTH LIST
00090		PUSHJ	P,MKPNTR	;FIX @ BIT
00100		MOVEM	P1,WIDTMP	;SAVE FOR LATER
00110		POPJ	P,
     
00010	MODALL==.POPJ
00020	MODNUL==.POPJ
00030	
00040	MODASC:	JSP	T4,FORMAT	;CHECK FOR LINE OVERFLOW
00050		MOVE	C,OUTVAL	;OUTPUT ASCII CHARACTER
00060		MOVEI	M,OUTVAL	;POINT TO OUTPUT VALUE
00070		TDNN	C,[<-1>_7]	;IS IT A SINGLE BYTE
00080		JRST	MODAS1		;YES PRINT AS ONE
00090		HRLI	M,440700	;NO--SET UP A POINTER
00100		MOVEI	T1,5		; FOR 5 CHARS
00110		ILDB	C,M		;GET A CHAR
00120		PUSHJ	P,MODAS1	;TYPE IT
00130		SOJG	T1,.-2		;LOOP FOR WHOLE WORD
00140		POPJ	P,		;RETURN
00150	MODAS1:	CAIG	C,40		;CONTROL CHAR?
00160		MOVEI	C," "		;YES--PRINT A BLANK INSTAED
00170		PJRST	LCHR
00180	
00190	MODSIX:	JSP	T4,FORMAT	;FORMAT THE LINE
00200		MOVE	T1,OUTVAL	;OUTPUT SIXBIT CHARACTER
00210		TDNN	T1,[<-1>_6]	;ONLY 1 CHAR?
00220		PJRST	LCHRS		;YES--LIST 1 CHAR
00230		MOVEI	T3,6	
00240		MOVE	T2,T1		;NO--LIST AS SIX SIXBIT
00250		PJRST	LSIXC		; LETTERS.
00260	
00270	;OUTPUT OUTVAL AS A RADIX 50 SYMBOL
00280	
00290	MODRAD:	JSP	T4,FORMAT	;LINE UP THE OUTPUT
00300		LDB	T1,[POINT 4,OUTVAL,3] ;GET PREFIX
00310		PUSHJ	P,$LOCT
00320		PUSHJ	P,LSPC
00330		MOVE	T1,OUTVAL	;GET THE RADIX 50 SYMBOL
00340	$LRAD:	TLZ	T1,(17B3)	;CLEAR THE CODE BITS
00350	MODR51:	IDIVI	T1,50		;WHY THEY CALL IT RADIX 50
00360		HRLM	T2,(P)		;SAVE REMAINDER
00370		JUMPE	T1,MODR52	;JUMP IF DONE
00380		PUSHJ	P,MODR51	;ELSE LOOP BACK
00390	MODR52:	HLRZ	C,(P)		;GET A CHAR
00400		JUMPE	C,.POPJ		;PUNT IF NULL
00410		ADDI	C,257		;FIX UP
00420		CAILE	C,271
00430		ADDI	C,7
00440		CAILE	C,332
00450		SUBI	C,70
00460		CAIN	C,243
00470		MOVEI	C,256
00480		TLNN	DL,DL.TR5
00490		PJRST	LCHR
00500		MOVE	T1,C
00510		PJRST	.TCHAR##
     
00010	
00020	MODOCT:	MOVE	T1,OUTVAL	;OUTPUT AS L,R
00030		PJRST	LXWD
00040	
00050	MODDEC:	SKIPA	T2,[$LDEC]
00060	MODSOC:	MOVEI	T2,$LOCT
00070		JSP	T4,FORMAT	;DON'T LET THE MINUS BE SPLIT
00080					; OVER LINE BOUNDARIES.
00090		MOVEI	C,"-"		;MINUS SIGN IN CASE NEGATIVE
00100		SKIPGE	OUTVAL		;SKIP IF POSITIVE
00110		PUSHJ	P,LCHR		;OUTPUT MINUS SIGN
00120		MOVM	T1,OUTVAL	;GET POSITIVE VALUE
00130		PJRST	(T2)		;AND OUTPUT IN PROPER RADIX
00140	
00150	MODFLO:	MOVE	T1,OUTVAL	;OUTPUT FLOATING POINT NUMBER
00160		PJRST	LFLT
00170	
     
00010	
00020	MODSYM:	TLNN	F,L.INST	;INSTRUCTION FORMAT?
00030		PJRST	MODOCT		;NO--DUMP AS OCTAL ***TEMP***
00040		JSP	T4,FORMAT	;MAKE LOOK NICE
00050		MOVE	T1,OUTVAL	;PUT IN   WORD
00060		PUSHJ	P,OPDEC		;LOOKUP IN TABLE
00070		  PUSHJ	P,INVOP		;MAKE SOME OPCODE
00080		MOVE	T2,N		;COPY OPCODE
00090		MOVEI	T3,6		;INCLUDE SPACES
00100		PUSHJ	P,LSIXC		;LIST THE OPCODE
00110	PNTAC:	PUSHJ	P,LSPC		;LIST A SPACE
00120		MOVEI	FM,1		;HISTORIC CODE
00130		TLO	DL,DL.XCT	;EXACT MATCH
00140		LDB	T1,[POINT 4,OUTVAL,12] ;GET THE OPCODE
00150		LDB	T2,[POINT 3,OUTVAL,2] ;GET FIRST OCTAL DIGIT
00160		CAIN	T2,7		;SKIP IF NOT I/O
00170		LDB	T1,[POINT 9,OUTVAL,11] ;GET I/O DEVICE CODE
00180		CAIN	T2,7		;IS IT AN I/O INSTRUCTION
00190		TRZ	T1,3		;YES--CLEAR 2 JUNK BITS
00200		JUMPE	T1,ZEROAC	;IS AC=0?
00210		PUSHJ	P,$LSYM		;NO--LIST AS SYMBOL
00220		PUSHJ	P,LCOMMA	; FOLLOWED BY A COMMA
00230	ZEROAC:	MOVSI	T1,(@)		;GET AN INDIRECT BIT
00240		MOVEI	C,"@"		; AND ITS SYMBOL
00250		TDNE	T1,OUTVAL	;IS @ BIT SET
00260		PUSHJ	P,LCHR		;YES--PRINT @
00270		HRRZ	T1,OUTVAL	;GET Y-ADDRESS
00280		MOVEI	FM,2		;HISTOY TABLE INDEX
00290		TLZ	DL,DL.XCT	;ALLOW OFFSET
00300		PUSHJ	P,$LSYM		;LIST AS SYMBOL
00310		LDB	T1,[POINT 4,OUTVAL,17] ;GET INDEX REG.
00320		JUMPE	T1,.POPJ	;JUMP IF ZERO
00330		MOVEI	FM,3		;CODE
00340		TLO	DL,DL.XCT	;LIGHT THE EXACT MATCH BIT
00350		MOVEI	C,"("		;ELSE PRINT IN (
00360		PUSHJ	P,LCHR		;GO LIST
00370		PUSHJ	P,$LSYM		;AND SYMBOL
00380		MOVEI	C,")"		;ADD )
00390		PJRST	LCHR		;GO ADD IT--THEN POPJ
     
00010	INVOP:	MOVE	T1,OUTVAL	;GET THEWORD TO OUTPUT
00020		TDZ	T1,[777,,-1]	;CLEAR OUT JUNK
00030		JUMPE	T1,ZEROP	;GIVE A Z IF ZERO
00040		CAMN	T1,OLDVAL	;SAME AS OLD VALUE?
00050		JRST	OLDOP		;YES--REMEMBER THAT BACK
00060		MOVEM	T1,OLDVAL	;RECALL LAST ARGUMENT
00070		PUSHJ	P,VAL2SY	;SCAN THE SYMBOL TABLE
00080		  TLOA	T2,(1B0)	;NO MATCH
00090		MOVEM	T1,OLDSYM	;SAVE THE SYMBOL
00100		MOVEM	T2,SYMOFF	;SAVE THE OFFSET
00110	OLDOP:	MOVE	T1,SYMOFF	;GET THE OLD OFFSET
00120		JUMPN	T1,ZEROP	;JUMP IF NOT EXACT
00130		MOVE	T1,OLDSYM	;FETCH SYMBOL
00140		MOVEI	N,PNTAC		;HERE WE DO A NONO AND FUDGE THE STACK
00150		MOVEM	N,(P)		;SO WE CAN PRINT THE AC AND RETURN TO
00160		PJRST	$LRAD		;OP DECODER.
00170	ZEROP:	LDB	T1,[POINT 9,OUTVAL,8] ;GET OPCODE
00180		MOVSI	N,'Z  '		;ASSUME ZERO
00190		JUMPE	T1,.POPJ	;JUMP IF GOOD GUESS
00200		LDB	T1,[POINT 3,OUTVAL,2]
00210		IORI	N,20(T1)	;FILL IN OCTAL DIGIT
00220		LSH	N,6		;GET READY FOR NEXT
00230		LDB	T1,[POINT 3,OUTVAL,5]
00240		IORI	N,20(T1)	;FILL IN NEXT DIGIT
00250		LSH	N,6		;GET READY FOR LAST
00260		LDB	T1,[POINT 3,OUTVAL,8]
00270		IORI	N,20(T1)	;PUT IN DIGIT 3
00280		HRLI	N,'UUO'		;ADD UUO
00290		POPJ	P,0		;RETURN
     
00010	;$LSYM -- PRINT A SYMBOL
00020	;CALL WITH:
00030	;	T1=VALUE TO PRINT
00040	;RETURNS NON-SKIP HAVING PRINTED SOMETHING
00050	
00060	$LSYM:	JUMPE	T1,.POPJ	;DO NOT TYPE ZEROS
00070		CAMN	T1,OLDVAL(FM)	;SAME ARGUMENT?
00080		JRST	LSYM2		;YES--GIVE SAME ANSWER
00090		MOVEM	T1,OLDVAL(FM)	;NO--SAVE FOR NEXT TRY
00100		PUSHJ	P,VAL2SY	;CONVERT VALUE
00110		  TLOA	T2,(1B00)	;IT IS A NUMBER
00120		TLZ	T2,(1B00)	;IT IS A SYMBOL
00130		MOVEM	T1,OLDSYM(FM)	;STORE ANSWER
00140		JUMPE	T2,LSYM1	;JUMP IF EXACT MATCH
00150		TLNE	DL,DL.XCT	;DO WE NEED AN EXACT MATCH
00160		TLO	T2,(1B0)	;YES--FORCE NUMERIC MODE
00170	LSYM1:	MOVEM	T2,SYMOFF(FM)	;SYMBOL ERROR
00180	LSYM2:	SKIPGE	T2,SYMOFF(FM)	;SKIP IF SYMBOLIC
00190		JRST	[MOVE T1,OLDVAL(FM) ;RELOAD THE NUMERIC VALUE
00200			 JRST $LNBR]	;LIST AS A NUMBER
00210		MOVE	T1,OLDSYM(FM)	;GET LAST ANSWER
00220		PUSHJ	P,$LRAD		;NO-PRINT SYMBOL
00230		SKIPN	T1,SYMOFF(FM)	;IS THERE AN OFFSET
00240		POPJ	P,		;NO--ALL DONE
00250		MOVEI	C,"+"		;NO--PRINT A PLUS
00260		PUSHJ	P,LCHR		; ..
00270		PJRST	$LNBR		;TYPE IN O RADIX
     
00010	MODSMA:	;IF INSTRUCTION, ELSE ...
00020		POPJ	P,
00030	
00040	
00050	MODNUM: MOVE	T1,OUTVAL	;PICK UP VALUE TO BE OUTPUT
00060		PJRST	LRDX		; AND LIST IN CURRENT RADIX
     
00010	;SUBROUTINE TO START NEW LINE FOR OUTPUT
00020	;ARGS	R.CON1 BIT OF F=1 IF DUMPING CONTENTS
00030	;SAVES T1
00040	
00050	NEWLIN:	PUSHJ	P,LCRLF		;NEW LINE
00060		PJRST	NEWPGX
00070	
00080	;SUBROUTINE TO OUTPUT PAGE EJECT AND REQUEST PAGE HEADER
00090	
00100	NEWPAG:	PUSHJ	P,LEJECT	;OUTPUT PAGE EJECT
00110		TRO	F,R.PHED	;REQUEST PAGE HEADER
00120	NEWPGX:	TRO	F,R.LHED	;REQUEST ADDRESS TO BE TYPED
00130		POPJ	P,
     
00010		SUBTTL OUTPUT SUBROUTINES
00020	
00030	;SUBROUTINE TO OPEN OUTPUT FILE
00040	
00050	OPNOUT:	TLNE	F,L.OOPN	;SKIP IF OUTPUT FILE NOT YET OPEN
00060		POPJ	P,
00070		PUSHJ	P,.SAVE1	;SAVE P1
00080		MOVEI	P1,O.DEV	;POINT TO OUTPUT SPEC
00090		PUSHJ	P,GETSPC	;COPY STICKEY DEFAULTS
00100		SETZM	LINNUM		;CLEAR LINE COUNT
00110		SETZ	T1,		;ASCII MODE
00120		MOVE	T2,O.DEV	;OUTPUT DEVICE
00130		MOVE	T4,T2		;REMEMBER OUTPUT DEVICE FOR DEVCHR
00140		MOVSI	T3,B.OC		;BUFFER HEADER
00150		OPEN	OC,T1		;OPEN OUTPUT DEVICE
00160		  JRST	E.LKO		;CANT OPEN OUTPUT
00170		DEVCHR	T4,		;GET CHARACTERISTICS OF OUTPUT DEVICE
00180		TLNE	T4,DV.TTY	;SKIP IF NOT A TTY
00190		TLO	F,L.OTTY	;NOTE TTY SO WILL CLOSE AFTER EACH DUMP
00200		PUSH	P,.JBFF		;SAVE CURRENT .JBFF
00210		MOVEI	T1,OBUF
00220		MOVEM	T1,.JBFF
00230		OUTBUF	OC,1		;DECLARE 1 OUTPUT BUFFER
00240		POP	P,.JBFF		;AND RESET .JBFF
00250		PUSH	P,P1
00260		MOVEI	P1,FBMTIM	;TIMES TO RETRY IF FILE BEING MODIFIED
00270		PUSH	P,DL		;SAVE DL ON STACK
00280	OPNOU1:	MOVE	T1,O.NAM	;OUTPUT FILE
00290		HLLZ	T2,O.EXT	;EXT
00300		SETZ	T3,		;STANDARD PROTECTION
00310		HRRI	DL,O.DEV	;POINT TO OUTPUT SPEC
00320		PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
00330		TRO	F,R.LKF		;ASSUME LOOKUP WILL FAIL
00340		TLNE	F,L.APP		;SKIP IF SUPERSEDE, NOT IF APPEND
00350		LOOKUP	OC,T1		;APPEND, TRY LOOKUP
00360		  JRST	OAPP1		;SUPERSEDE OR LOOKUP FAILED
00370		TRZ	F,R.LKF		;LOOKUP OK
00380	OAPP1:	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
00390	OSUPER:	ENTER	OC,T1
00400		 JRST	OSUPE
00410		HRR	DL,(P)		;RESTORE RH(DL)
00420		POP	P,P1		;FIX STACK
00430		POP	P,P1		;RESTORE P1
00440		HLRE	T1,T4		;CURRENT LENGTH OF OUTPUT FILE
00450		JUMPGE	T1,OSUP1	;JUMP IF BLOCKS
00460		MOVNS	T1		;MAKE POSITIVE WORDS
00470		ADDI	T1,177
00480		LSH	T1,-7		;CONVERT TO BLOCKS
00490	OSUP1:	TRNN	F,R.LKF		;SKIP IF SUPERSEDE OR LOOKUP FAILED
00500		USETO	OC,1(T1)	;SET TO START WRITING
00510		TLO	F,L.OOPN	;NOTE OUTPUT FILE OPEN
00520		POPJ	P,
     
00010	OSUPE:	SOJLE	P1,E.NSFO	;EXIT IF STILL BUSY
00020		HRRZ	T4,T2		;ERROR CODE
00030		CAIE	T4,EC.FBM	;SKIP IF FILE BEING MODIFIED
00040		JRST	E.NSFO		;NO, SOME OTHER PROBLEM
00050		MOVEI	T4,1
00060		SLEEP	T4,		;SLEEP 1 SECOND
00070		JRST	OPNOU1		;AND TRY AGAIN
00080	
00090	
00100	;SUBROUTINE TO SET UP T4 AS A PPN IF NO SFD SPECIFIED OR A POINTER
00110	; TO THE PATH IF NEEDED.
00120	;USES NO ACS
00130	
00140	IFG LN.DRB-1,<			;IF WE HAVE SFD'S
00150	SETPTH:	MOVE	T4,%DIR(DL)	;SET UP T4 IN CASE
00160		SKIPN	%DIR+2(DL)	;NEED A PATH?
00170		POPJ	P,		;NO--RETURN
00180		PUSHJ	P,.SAVE2	;SAVE P1-P2
00190		MOVSI	P1,-LN.DRB*2	;NUMBER OF BIWORDS
00200		MOVEI	P2,PATH+1	;WHERE TO PUT PATH
00210	STPTH1:	MOVE	T4,(P1)		;PICH UP DIRECTORY WORD
00220		PUSH	P2,T4		;STORE IN PATH
00230		AOBJP	P2,.+2		;SKIP OVER THE MASK
00240		AOBJN	P2,STPTH1	;LOOP FOR MORE
00250		MOVEI	T4,PATH		;POINT TO PATH
00260		POPJ	P,		;RETURN
00270	>
00280	
00290	IFLE LN.DRB-1,<
00300		MOVE	T4,%DIR(DL)	;GET PPN
00310		POPJ	P,		;RETURN
00320	>
     
00010	;LFLT -- LIST WORD AS FLOATING POINT NUMBER
00020	;CALL:	MOVE	T1,WORD
00030	;	PUSHJ	P,LFLT
00040	
00050	LFLT:	POPJ	P,
00060	
00070	;LXWD -- LIST WORD IN XWD FORMAT (N,N)
00080	;CALL:	MOVE	T1,WORD
00090	;	PUSHJ	P,LXWD
00100	;USES T1, T2, T3, C
00110	
00120	LXWD:	JSP	T4,FORMAT	;LINE UP THE OUTPUT
00130		MOVE	T2,[POINT 3,T1]	;BYTE POINTER TO NUMBER
00140		MOVEI	T3,^D12		;12 DIGITS IN A WORD
00150	LXWD1:	ILDB	C,T2		;GET A DIGIT
00160		ADDI	C,60		;MAKE ASCII
00170		PUSHJ	P,LCHR		;TYPE THE DIGIT
00180		CAIN	T3,7		;HALF WAY POINT?
00190		PUSHJ	P,LCOMMA	;TYPE A COMMA
00200		SOJG	T3,LXWD1	;LOOP FOR WHOLE WORD
00210		POPJ	P,		;RETURN
00220	
00230	
00240	
00250	;LDATE -- OUTPUT DATE IN FORM DD-MMM-YY
00260	;CALL:	MOVE	T4,DATE IN SYSTEM FORMAT
00270	;	PUSHJ	P,LDATE
00280	;USES T1, T2, T3, T4,  M, C
00290	
00300	LDATE:	PUSH	P,T4+1
00310		IDIVI	T4,^D31		;GET DAY
00320		MOVEI	T1,1(T4+1)
00330		PUSHJ	P,LDEC2
00340		IDIVI	T4,^D12		;GET MONTH
00350	
00360		MOVE	T1,[ASCII /-Jan--Feb--Mar--Apr--May--Jun--Jul--Aug--Sep--Oct--Nov--Dec-/](T4+1)
00370		POP	P,T4+1
00380		MOVEI	T2,0
00390		MOVEI	M,T1
00400		PUSHJ	P,LSTR
00410		MOVEI	T1,^D64(T4)	;GET YEAR
00420		PJRST	LDEC2Z		;OUTPUT YEAR AND RETURN
     
00010	;LTIME -- OUTPUT TIME IN FORM HH:MM
00020	;CALL:	MOVE	T4,TIME IN MINUTES
00030	;	PUSHJ	P,LTIME
00040	;USES T1, T2, T3, T4, T5, C
00050	
00060	LTIME:	PUSH	P,T4+1		;SAVE T5 (WHICH IS P1)
00070		IDIVI	T4,^D60		;GET HOURS
00080		MOVE	T1,T4
00090		PUSHJ	P,LDEC2		;LIST HOURS
00100		MOVEI	C,":"
00110		PUSHJ	P,LCHR
00120		MOVE	T1,T4		;LIST MINUTES
00130		POP	P,T4+1		;RESTORE T5
00140					;FALL INTO LDEC2Z
00150	
00160	;LDEC2Z -- LIST DECIMAL AT LEAST 2 DIGITS WITH LEADING ZERO
00170	;CALL:	MOVEI	T1,NUMBER
00180	;	PUSHJ	P,LDEC2Z
00190	;USES T1, T2, T3, C
00200	
00210	LDEC2Z:	MOVEI	C,"0"		;SETUP TO PRINT 0 IN CASE NEEDED
00220		CAIGE	T1,^D10		;TEST TO SEE IF NEEDED
00230		PUSHJ	P,LCHR		;YES--SEND IT
00240		PJRST	LDEC		;GO FINISH WORK
00250	
00260	
00270	
00280	;LSTDC2 -- LIST MESSAGE, DECIMAL NUMBER, AND TWO SPACES
00290	;CALL:	MOVEI	M,MESSAGE
00300	;	MOVE	T1,NUMBER
00310	;	PUSHJ	P,LSTDC2
00320	;USES T1, T2, T3, M, C
00330	
00340	LSTDC2:	PUSHJ	P,LSTR		;LIST THE MESSAGE
00350		PUSHJ	P,LDEC		;LIST THE DECIMAL NUMBER
00360		PJRST	LSPC2		;LIST THE TWO SPACES AND RETURN
     
00010	;LDEC4 -- LIST DECIMAL AT LEAST FOUR DIGITS
00020	;LDEC3 -- LIST DECIMAL AT LEAST THREE DIGITS
00030	;LDEC2 -- LIST DECIMAL AT LEAST TWO DIGITS
00040	;CALL:	MOVEI	T1,NUMBER
00050	;	PUSHJ	P,LDEC2
00060	;USES T1, T2, T3, C
00070	
00080	LDEC4:	CAIGE	T1,^D1000	;SEE IF NEEDED
00090		PUSHJ	P,LSPC
00100	LDEC3:	CAIGE	T1,^D100
00110		PUSHJ	P,LSPC
00120	LDEC2:	CAIGE	T1,^D10
00130		PUSHJ	P,LSPC		;YES
00140					;FALL INTO LDEC
00150	
00160	;LDEC -- LIST DECIMAL NUMBER
00170	;LOCT -- LIST OCTAL NUMBER
00180	;LRDX -- LIST VIA PRESET RADIX
00190	;CALL:	MOVEI	T1,NUMBER
00200	;      (MOVEI	T3,RADIX    LRDX ONLY)
00210	;	PUSHJ	P,LDEC/LOCT/LRDX
00220	;USES T1, T2, T3, C
00230	
00240	LDEC:	MOVEI	T3,^D10		;INITIALIZE FOR DECIMAL RADIX
00250		JRST	LRDX1
00260	LRDX:	SKIPA	T3,ORADIX	;INITIALIZE FOR CURRENT OUTPUT RADIX
00270	LOCT:	MOVEI	T3,10		;INITIALIZE FOR OCTAL RADIX
00280	LRDX1:	JSP	T4,FORMAT	;TAKE CARE OF FORMATING
00290		JRST	$LRDX		;OUTPUT
00300	
00310	$LNBR:	MOVE	T3,ORADIX	;PICK UP OUTPUT RADIX
00320		JRST	$LRDX		;PRINT
00330	$LDEC:	SKIPA	T3,[^D10]	;INITIALIZE FOR DECIMAL
00340	$LOCT:	MOVEI	T3,10		;INITIALIZE FOR OCTAL RADIX
00350	$LRDX:	MOVEI	C,"-"		;IN CASE -VE
00360		SKIPGE	T1		;SKIP IF POSITIVE
00370		PUSHJ	P,LCHR		;ELSE PRINT THE MINUS
00380		CAMN	T1,[1B0]	;JUST THE SIGN BIT?
00390		AOS	T1		;YES--MAKE LARGER
00400		MOVM	T1,T1		;MAKE T1 POSITIVE
00410	$LRDX1:	IDIV	T1,T3		;DIVIDE BY RADIX
00420		HRLM	T2,(P)		;SAVE REMAINDER
00430		SKIPE	T1		;SEE IF ANYTHING LEFT
00440		PUSHJ	P,$LRDX1	;YES--LOOP BACK WITH PD LIST
00450		HLRZ	C,(P)		;GET BACK A DIGIT
00460		ADDI	C,"0"		;CONVERT TO ASCII
00470		PJRST	LCHR		;GO LIST IT
     
00010	;LCRLF3 - LIST END OF LINE AND 2 BLANKS
00020	;LCRLF2 - LIST END OF LINE AND 1 BLANK LINE
00030	
00040	LCRLF3:	PUSH	P,LMARGN	;SAVE LEFT MARGIN FOR NOW
00050		SETZM	LMARGN		;CLEAR SO WONT WRITE SPACES
00060		PUSHJ	P,LCRLF		;NEW LINE
00070		JRST	LCRL2A		;AND ANOTHER NEW LINE
00080	LCRLF2:	PUSH	P,LMARGN	;SAVE LEFT MARGIN FOR NOW
00090		SETZM	LMARGN		;;CLEAR SO WONT WRITE SPACES
00100	LCRL2A:	PUSHJ	P,LCRLF		;NEW LINE
00110		POP	P,LMARGN	;RESTORE LEFT MARGIN
00120	
00130	;LCRLF - LIST END OF LINE
00140	;CALL:	PUSHJ	P,LCRLF
00150	;USES M, C
00160	
00170	LCRLF:	TRZ	F,R.LTAB	;CLEAR TAB MEMORY
00180		MOVEI	M,[ASCIZ /
00190	/]
00200		JRST	$LSTR
00210	
00220	;LSTR - LIST ASCII STRING
00230	;CALL:	MOVEI	M,STRING (END WITH 0 BYTE)
00240	;	PUSHJ	P,LSTR
00250	;USES M, C
00260	
00270	LSTR:	JSP	T4,FORMAT
00280	$LSTR:	TLOA	M,440700		;CONVERT TO BYTE POINTER
00290	LSTR1:	PUSHJ	P,LCHR		;OUTPUT CHARACTER
00300		ILDB	C,M		;GET NEXT CHARACTER
00310		JUMPN	C,LSTR1		;LOOP UNLESS NULL
00320		POPJ	P,		;RETURN
00330	
00340	
00350	;LSIXT -- LIST SIXBIT WORD FOLLOWED BY TAB
00360	;CALL:	MOVE	T2,WORD
00370	;	PUSHJ	P,LSIXT
00380	;USES T1, T2, C
00390	
00400	LSIXT:	PUSHJ	P,LSIXN		;OUTPUT WORD
00410		PJRST	LTAB		;GO OUTPUT TAB AND RETURN
     
00010	;LSIX  -- LIST SIXBIT WORD (AT LEAST ONE SPACE)
00020	;LSIXN -- SAME EXCEPT 0 GIVES NO SPACES
00030	;CALL:	MOVE	T2,WORD
00040	;	PUSHJ	P,LSIX/LSIXN
00050	;USES T1, T2, C
00060	
00070	LSIX:	MOVEI	T1,0		;CLEAR NEXT CHARACTER
00080		LSHC	T1,6		;FETCH NEXT CHAR
00090		PUSHJ	P,LCHRS		;LIST IT IN SIXBIT
00100	
00110	LSIXN:	JUMPN	T2,LSIX		;LOOP UNTIL ONLY BLANKS LEFT
00120		POPJ	P,		;RETURN
00130	
00140	
00150	;LSIXC -- LIST SIXBIT WORD FIXED NUMBER OF CHARACTERS
00160	;CALL:	MOVE	T2,WORD
00170	;	MOVEI	T3,NUM CHARS TO PRINT
00180	;	PUSHJ	P,LSIXC
00190	;USES T1, T2, T3, C
00200	
00210	LSIXC:	MOVEI	T1,0		;CLEAR NEXT CHAR
00220		LSHC	T1,6		;GET NEXT CHAR
00230		PUSHJ	P,LCHRS		;LIST IT IN SIXBIT
00240		SOJG	T3,LSIXC	;LOOP UNTIL DONE
00250		POPJ	P,		;RETURN
00260	
00270	
00280	;LSPC3 -- LIST THREE SPACES
00290	;LSPC2 -- LIST TWO SPACES
00300	;CALL:	PUSHJ	P,LSPC2
00310	;USES C
00320	
00330	LSPC3:	PUSHJ	P,LSPC		;DO ONE
00340	LSPC2:	PUSHJ	P,LSPC		;DO ONE
00350		PJRST	LSPC		;DO ANOTHER AND RETURN
     
00010	;SUBROUTINE TO TAKE CARE OF OVERFLOWING LINE OR PAGE
00020	;SAVES	P1, P2
00030	
00040	FORMAT:	TROE	F,R.NORE	;SKIP IF NOT ALREADY IN THIS SUBROUTINE
00050		JRST	(T4)		;DONT RECURSE, JUST PASS THROUGH
00060		MOVEM	M,SAVEM		;SAVE AC'S
00070		MOVE	M,[XWD T1,SAVET1]
00080		MOVEM	F,SAVEF		;SAVE F
00090		BLT	M,SAVEP2
00100		TRZ	F,R.SCNT	;ASSUME COUNT BIT OFF
00110		TROE	F,R.CNT		;SAVE OLD COUNT BIT, SET IT FOR NOW
00120		TRO	F,R.SCNT	;COUNT BIT WAS ON
00130		MOVE	P2,SAVEP2
00140		PUSH	P,PAGNUM	;SAVE CURRENT CHARACTER POSITION
00150		PUSH	P,LINNUM
00160		PUSH	P,CURCHR
00170		PUSHJ	P,FORMT2	;MAKE WIDTH AND JUSTIFY WORK
00180		MOVN	M,CURCHR	;STORE THE CURRENT CHAR. POSITION
00190		MOVEM	M,SAVCCH	; NEGATED, IN SAVCCH
00200		MOVE	M,SAVEM		;RESTORE M
00210		PUSHJ	P,(T4)		;CALL ROUTINE TO COUNT CHARS TO BE OUTPUT
00220		MOVEI	T2,NEWLIN
00230		MOVE	T1,CURCHR	;NEW CHARACTER POSITION
00240		ADDM	T1,SAVCCH	;SAVCCH := WIDTH OF PRINTED FIELD
00250		CAMLE	T1,RMARGN	;SKIP IF NOT YET PAST RIGHT MARGIN
00260		PUSHJ	P,FORMFX	;OUTPUT CRLF FIRST
00270		MOVEI	T2,NEWPAG
00280		MOVE	T1,LINNUM	;NEW LINE NUMBER
00290		CAMLE	T1,LINPAG	;SKIP IF NOT YET PAST END OF PAGE
00300		PUSHJ	P,FORMFX	;OUTPUT PAGE EJECT FIRST
00310		POP	P,CURCHR
00320		POP	P,LINNUM
00330		POP	P,PAGNUM
00340		MOVE	T1,SAVEF
00350		ANDI	T1,R.LHED!R.PHED ;REMEMBER HEADER BITS
00360		IOR	F,T1
00370		TRZE	F,R.SCNT	;SKIP IF WAS SUPPOSED TO OUTPUT
00380		JRST	FORMT1		;NO, JUST COUNT CHARS, LEAVE COUNT BIT ON
00390		TRZ	F,R.CNT		;YES, TURN OFF COUNT BIT
00400		PUSHJ	P,FORMF1	;OUTPUT IT
00410	FORMT1:	MOVE	P1,SAVEP1	;RESTORE P1-P2
00420		MOVE	P2,SAVEP2
00430		TRZ	F,R.NORE
00440		POPJ	P,		;EXIT
00450	
00460	FORMT2:	TRNN	F,R.LHED!R.PHED	;DO WE WANT TO PRINT HEADERS
00470		POPJ	P,		;NO--RETURN
00480		MOVEI	C,200		;FLAG TO GENERATE HEADER
00490		PJRST	LCHR		;GO DO IT
     
00010	FORMFX:	TRNN	F,R.SCNT	;SKIP IF ONLY COUNTING
00020		TRZ	F,R.CNT		;NO, CLEAR COUNT BIT
00030		POP	P,T1		;SAVE RETURN FROM SUBROUTINE
00040		POP	P,CURCHR	;RESTORE ORIGINAL CHARACTER POSITION
00050		POP	P,LINNUM
00060		POP	P,PAGNUM
00070		PUSH	P,T1		;RESTORE RETURN FROM SUBROUTINE
00080		TRZ	F,R.LHED!R.PHED	;DONT WANT LINE OR PAGE HEADER HERE
00090		PUSHJ	P,(T2)		;CALL APPROPRIATE ROUTINE
00100		MOVE	T1,F		;REMEMBER HEADER BITS
00110		ANDI	T1,R.PHED!R.LHED
00120		IORM	T1,SAVEF	;SAVE FOR ROUTINE EXIT
00130		TRO	F,R.CNT
     
00010		POP	P,T1		;SAVE RETURN FROM SUBROUTINE
00020		PUSH	P,PAGNUM
00030		PUSH	P,LINNUM
00040		PUSH	P,CURCHR
00050		PUSH	P,T1		;RESTORE RETURN FROM SUBROUTINE
00060	FORMF1:	MOVE	M,[XWD SAVET1,T1]
00070		BLT	M,P2		;RESTORE ORIGINAL AC'S
00080		MOVE	M,SAVEM
00090		PJRST	(T4)		;CALL OUTPUT ROUTINE
00100	
00110	LEJECT:	MOVEI	C,C.FF
00120		PJRST	LCHR
     
00010	;LCRT -- LIST A CARRAGE RETURN
00020	;LTAB -- LIST TAB
00030	;LSPC -- LIST SPACE
00040	;LCHR -- LIST CHARACTER
00050	;LCHRS-- LIST SIXBIT CHARACTER
00060	;CALL:	(MOVEI	C,CHARACTER    IF LCHR)
00070	;	(MOVEI	T1,CHARACTER IF LCHRS)
00080	;	PUSHJ	P,LTAB/LSPC/LCHR
00090	;USES C EXCEPT LCHR USES NO AC'S
00100	
00110	LCRT:	MOVEI	C,.CHCRT
00120		PJRST	LCHR1
00130	LCOMMA:	SKIPA	C,[","]		;LOAD A COMMA
00140	LCHRS:	MOVEI	C," "-' '(T1)	;CONVERT TO ASCII AND MOVE TO C
00150	LCHR:	JUMPE	C,.POPJ			;DO NOT PRINT NULLS
00160		CAIE	C,"	"		;SEE IF A TAB
00170		JRST	LCHR1		;NO--GO SEND IT
00180	
00190	LTAB:	TRON	F,R.LTAB	;SET/TEST TAB
00200		POPJ	P,		;RETURN IF NOT TWO IN A ROW
00210	
00220	LTAB1:	SKIPA	C,["	"]	;GET THE TAB
00230	LSPC:	MOVEI	C," "		;GET THE SPACE
     
00010	LCHR1:	TRZE	F,R.LTAB	;CLEAR TAB MEMORY
00020		JRST	LCHR3		;IF SET, GO ISSUE ONE
00030		TRZE	F,R.PHED	;SKIP IF DONT WANT PAGE HEADER
00040		PUSHJ	P,PHEAD		;OUTPUT PAGE HEADER
00050		TRZE	F,R.MARS	;SKIP IF DONT NEED LEFT MARGIN SPACES
00060		PUSHJ	P,MARSPC	;OUTPUT SPACES FOR LEFT MARGIN
00070		TRZE	F,R.LHED	;SKIP IF DONT WANT ADDR TYPED
00080		PUSHJ	P,LHEAD		;OUTPUT ADDR AS LINE HEADER
00090		TRZE	F,R.LTAB	;SEE IF LHEAD GOT US INTO A BAD STATE
00100		JRST	LCHR3		; AND IF IT DID CLEAN UP.
00110		CAIN	C,200		;SPECIAL FLAG?
00120		POPJ	P,		;YES--QUIT NOW
00130		JUMPE	C,LCHR6		;JUMP IF NULL
00140		CAIL	C,40		;SKIP IF NON-GRAPHIC
00150		JRST	LCHR5		;OK
00160		PUSH	P,T1
00170		MOVEI	T1,7		;PREPARE FOR POSSIBLE TAB
00180		CAIN	T1,.CHTAB	;IS IT A TAB
00190		IORM	T1,CURCHR	;YES--FORCE TO A TAB STOP
00200		MOVEI	T1,1
00210		LSH	T1,-1(C)	;POSITON BIT FOR CHAR
00220		TDNE	T1,FORMCH	;SKIP IF NOT LEGAL FORM CHAR
00230		JRST	LCHR4		;OK, OUTPUT CHAR AS IS
00240		PUSH	P,C		;SAVE CHAR
00250		MOVEI	C,"^"		;NO, FLAG AS CONTROL LETTER
00260		PUSHJ	P,LCHR
00270		POP	P,C
00280		ADDI	C,100		;AND MAKE GRAPHIC
00290	LCHR4:	POP	P,T1
00300	LCHR5:	AOS	CURCHR		;COUNT CHARS ON THIS LINE
00310	LCHR6:	TRNE	F,R.CNT		;SKIP IF ACTUALLY OUTPUTTING
00320		JRST	LNOWRT		;NO, ONLY COUNTING, DONT OUTPUT
00330		SOSG	B.OC+2		;SEE IF ROOM IN THE BUFFER
00340		JRST	LCHRW		;NO--GO WRITE THIS BUFFER
00350	LCHR2:	TLNE	F,L.OTTY	;IS OUTPUT TO TTY: ?
00360		TLZ	F,L.TDMP	;YES--MAKE TDUMP=DUMP
00370		TLNE	F,L.TDMP	;DOES HE WANT IT ON HIS TTY ALSO?
00380		OUTCHR	C		;YES--DO THAT TOO
00390		IDPB	C,B.OC+1	;YES--SEND CHARACTER
00400	LNOWRT:	CAIL	C,C.LF		;SKIP IF NOT END OF LINE CHAR
00410		CAILE	C,C.CR		;SKIP IF END OF LINE CHAR
00420		POPJ	P,
00430		TRO	F,R.MARS	;NOTE NEED FOR SPACES FOR LEFT MARGIN
00440		SETZM	CURCHR		;RESTART CHAR COUNTER
00450		CAIN	C,C.LF		;SKIP IF NOT LINE FEED
00460		AOS	LINNUM		;YES, COUNT 1 LINE
     
00010		CAIN	C,C.FF		;SKIP IF NOT PAGE EJECT
00020		SETZM	LINNUM
00030		MOVEI	T1,		;INCREMENT FOR VT
00040		CAIN	C,C.VT		;SKIP IF VERTICAL TAB
00050		ADDM	T1,LINNUM
00060		POPJ	P,		;RETURN
00070	
00080	LCHR3:	PUSH	P,C		;SAVE REQUESTED CHARACTER
00090		PUSHJ	P,LTAB1		;SEND A TAB
00100		POP	P,C		;RESTORE CHARACTER
00110		JRST	LCHR1		;PROCEED
     
00010	PHEAD:	SKIPE	LINNUM		;TOP OF FORM?
00020		POPJ	P,		;NO--SHOULD NOT GET HERE
00030		PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
00040		TRZE	F,R.LHED	;SKIP IF LINE HEADER NOT NEEDED
00050		TRO	F,R.RLH		;REMEMBER THAT BIT
00060		PUSHJ	P,LCRT		;LIST THE <CR>
00070		SKIPE	T1,PAGNUM	;SKIP IF NOT NUMBERING PAGES
00080		JRST	NEWPG1		;NUMBERING, T1=CURRENT PAGE NUMBER
00090		TLNN	F,L.TITL	;SKIP IF TITLE SPECIFIED
00100		JRST	NEWPG6		;NO TITLE LINE
00110	NEWPG1:	MOVEI	C,1
00120		IDIVI	T1,^D10
00130		JUMPE	T1,.+2
00140		AOJA	C,.-2		;COUNT CHARS FOR PAGE NUMBER
00150		ADDI	C,7		;PLUS <SPACE>PAGE<SPACE><SPACE>
00160		MOVE	T1,RMARGN	;RIGHT MARGIN
00170		SUB	T1,LMARGN	;MINUS LEFT MARGIN=CHARS LEFT FOR TITLE+PAGE NUM
00180		SUB	T1,C		;MINUS CHARS FOR PAGE NUM=CHARS FOR TITLE
00190		JUMPLE	T1,NEWPG5	;JUMP IF NO ROOM FOR TITLE
00200		SKIPN	TITLEN		;SKIP IF NON-NULL TITLE
00210		JRST	NEWPG4		;NO TITLE
00220		MOVE	P1,TIT.Y	;BYTE POINTER FOR TITLE
00230		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00240	NEWPG3:	ILDB	C,P1		;NEXT CHAR OF TITLE
00250		CAIN	C,TIT.EN	;SKIP IF NOT END OF TITLE
00260		JRST	NEWPG4
00270		PUSHJ	P,LCHR		;OUTPUT THE CHAR
00280		SOJG	T1,NEWPG3	;LOOP FOR NUMBER OF CHARS ALLOWED FOR TITLE
00290		JRST	NEWPG5		;NO MORE ROOM
     
00010	NEWPG4:	SKIPN	PAGNUM		;NO NEED FOR SPACES IF NOT NUMBERING PAGES
00020		JRST	NEWPG6
00030		PUSHJ	P,LSPC		;FINISHED TITLE, FILL OUT WITH SPACES
00040		SOJG	T1,.-1
     
00010	NEWPG5:	SKIPN	PAGNUM		;SKIP IF NUMBERING PAGES
00020		JRST	NEWPG6		;END OF TITLE LINE
00030		MOVEI	M,[ASCIZ . PAGE  .]
00040		PUSHJ	P,$LSTR
00050		MOVE	T1,PAGNUM	;CURRENT PAGE NUMBER
00060		PUSHJ	P,$LDEC		;OUTPUT PAGE NUMBER
00070		AOS	PAGNUM		;AND BUMP COUNT
00080	NEWPG6:	PUSHJ	P,LCRLF		;END OF TITLE LINE
00090		TLNN	F,L.SUBT	;SKIP IF WANT SUBTITLE
00100		JRST	NEWPGE		;NO, ALL DONE
00110		MOVE	T1,RMARGN	;RIGHT MARGIN
00120		SUB	T1,LMARGN	;MINUS LEFT MARGINCHARS FOR SUBTITLE
00130		JUMPLE	T1,NEWPGE	;NO ROOM
00140		MOVE	P1,SUBT.Y	;BYTE POINTER FOR SUBTITLE
00150		PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
00160	NEWPG7:	ILDB	C,P1		;GET NEXT CHAR OF SUBTITLE
00170		CAIN	C,SUBT.E	;SKIP IF NOT END OF SUBTITLE
00180		JRST	NEWPGE
00190		PUSHJ	P,LCHR		;OUTPUT THE CHAR
00200		SOJG	T1,NEWPG7
00210	NEWPGE:	SKIPE	LINNUM		;DO NOT NEED BLANK LINES
00220					; IF NO TITLE GIVEN.
00230		PUSHJ	P,LCRLF3	;2 BLANK LINES AFTER SUBTITLE
00240		TRZE	F,R.RLH		;SKIP IF LINE HEADER WAS NOT REQUESTED
00250		TRO	F,R.LHED	;TURN REQUEST BACK ON
00260		POPJ	P,
     
00010	LHEAD:	TLNE	F,L.ADDR	;SKIP IF ADDR IS OFF
00020		TRNN	F,R.CON1	;SKIP IF DUMPING CONTENTS
00030		POPJ	P,		;NO HEADER
00040		CAIGE	C,40		;REAL CHARACTER?
00050		JRST	[TRO  F,R.LHED	;NO--HOLD OFF
00060			 POPJ P,0]	; UNTILL SOMETHING IS SEEN.
00070		PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
00080		MOVE	T1,SAVADR	;ADDRESS
00090		PUSHJ	P,$LOCT		;OUTPUT ADDRESS
00100		MOVEI	M,[ASCIZ ./	.]
00110		PJRST	$LSTR
00120	
00130	MARSPC:	PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
00140		SKIPN	T1,LMARGN	;SKIP IF NEED SPACES FOR LEFT MARGIN
00150		POPJ	P,		;NO SPACES NEEDED
00160		PUSHJ	P,LSPC		;OUTPUT SPACES OVER TO LEFT MARGIN
00170		SOJG	T1,.-1
00180		POPJ	P,
00190	
00200	;SUBROUTINE TO SAVE AC'S FOR HEADER SUBROUTINES
00210	
00220	SAVHED:	EXCH	T1,(P)		;SAVE T1 AND RETRIEVE RETURN
00230		PUSH	P,T2
00240		PUSH	P,T3
00250		PUSH	P,C
00260		PUSH	P,M
00270		PUSH	P,P1
00280		PUSHJ	P,(T1)		;CALL CALLING SUBROUTINE
00290		POP	P,P1
00300		POP	P,M
00310		POP	P,C
00320		POP	P,T3
00330		POP	P,T2
00340		PJRST	T1POPJ
     
00010	;HERE TO WRITE ONE BUFFER
00020	
00030	LCHRW:	OUT	OC,		;OUTPUT BUFFER
00040		  JRST	LCHR2		;OK--GO DO CHARACTER NOW
00050		PUSH	P,T1		;ERROR--SAVE SOME ACS
00060		PUSH	P,T2		; ..
00070		PUSH	P,T3		; ..
00080		GETSTS	OC,T1		;GET ERROR STATUS
00090		MOVE	T2,T1		;PREPARE TO CLEAR
00100		ANDI	T2,37777	;  BY PRESERVING JUST
00110		SETSTS	OC,(T2)		;  THE CONTROL BITS
00120		OUTSTR	[ASCIZ /
00130	% Listing device output error, status /]
00140		MOVE	T3,[POINT 3,T1,17]  ;SETUP FOR OCTAL TYPEOUT
00150	LCHRWE:	ILDB	T2,T3		;GET DIGIT
00160		ADDI	T2,"0"		;CONVERT TO ASCII
00170		OUTCHR	T2		;TYPE IT
00180		TLNE	T3,(77B5)	;SEE IF DONE YET
00190		JRST	LCHRWE		;NO--LOOP
00200		OUTSTR	[ASCIZ /
00210	/]				;NOTE--ALL THIS DONE HERE IN CASE
00220					;  WRONG SEGMENT IN CORE
00230	
00240		POP	P,T3		;RESTORE ACS
00250		POP	P,T2		; ..
00260		POP	P,T1		; ..
00270		JRST	LCHR2		;AND WRITE NEXT CHARACTER
     
00010	SUBTTL	SYMBOL TABLE LOGIC -- SYMBOL COMMANDS
00020	
00030	;XTRACT -- PULL SYMBOL TABLE FROM .SAV, .SHR, .DAE, .HGH, AND SO ON
00040	
00050	XPROC:	PUSHJ	P,GIVSYM	;GIVE BACK PREMUTATION VECTOR
00060		TLZ	F,L.IOPN	;CAUSE INPUT FILE TO LOOK CLOSED
00070		HRRI	DL,S.ZER	;POINT TO SYFILE
00080		MOVEI	T1,.JBSYM	;LOOK FOR SYMBOL TABLE POINTER
00090		TLO	DL,DL.SYM	;NOTE WE ARE READING SYMBOL TABLE
00100		PUSHJ	P,FNDADR	;GO FIND THE POINTER
00110		TLNN	F,L.NXM		;WAS THERE A POINTER?
00120		SKIPL	T1		;WITH SOMETHING IN IT
00130		JRST	TRYHSM		;NO--GO LOOK IN .JBHSM
00140		MOVEM	T1,SYMPTR	;SAVE SYMBOL TABLE POINTER
00150		PUSHJ	P,GETST		;GO READ IN THE SYMBOL TABLE
00160	TRYHSM:	MOVEI	T1,.JBHSM+1B18	;POINT TO HISEG POINTER
00170		PUSHJ	P,FNDADR	;GO GRAB IT
00180		TLNN	F,L.NXM		;DOES IT EXIST?
00190		SKIPL	T1		;AND IS IT VALID?
00200		JRST	FINXPR		;NO--GO AWAY
00210		CAMN	T1,SYMPTR	;IS IT THE SAME AS .JBSYM
00220		JRST	FINXPR		;YES--GO AWAY
00230		MOVEM	T1,SYMPTR	;SAVE FOR LATER
00240		PUSHJ	P,GETST		;READ HISEG POINTER
00250	FINXPR:	TLZ	F,L.IOPN	;INPUT NO LONGER OPEN
00260		TLZ	DL,DL.SYM	;WE ARE NO LONGER READING SYMBOL TABLE
00270		TLO	DL,DL.FBR	;SET DL.FBR SO FIXSYM WILL GENERATE
00280					; POINTERS.
00290		PUSHJ	P,FIXSYM	;***TEMP*** FIX UP POINTERS NOW
00300		HRRI	DL,I.ZER	;POINT BACK TO INPUT
00310		MOVSI	T1,1		;CAUSE NEW WIDOW TO BE READ
00320		MOVEM	T1,WINADR	; ..
00330		PUSHJ	P,.TCRLF##	;TYPE A CRLF
00340		MOVE	T1,SYMLEN	;GET LENGTH OF SYMBOL TABLE
00350		LSH	T1,-1		;DIVIDE BY TWO
00360		PUSHJ	P,.TDECW##	;TYPE THE DECIMAL WORD
00370		MOVEI	T1,[ASCIZ / symbols eXTRACTed
00380	/]
00390		PJRST	.TSTRG##	;LIST THE STRING AND RETURN
     
00010	SUBTTL SYMBOL TABLE LOGIC -- SUBROUTINES
00020	
00030	;READ SYMBOL TABLE FROM FILE
00040	
00050	GETST:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
00060		HLRE	T1,SYMPTR	;GET POSITIVE WC
00070		MOVM	T1,T1		; IN T1
00080		ADD	T1,SYMLEN	;INCLUDE CURRENT SIZE
00090		MOVEI	P2,SYMNDX	;GET INDEX
00100		PUSHJ	P,GETCOR	;GET THE CORE FROM THE MONITOR
00110		MOVEI	P1,@SYMTAB	;POINT TO SYMTAB
00120		MOVE	P2,SYMPTR	;POINT TO IT IN IMAGE FILE
00130		SOS	P1		;THE PUSH WILL ADD THEN STORE
00140	GETST1:	HRRZ	T1,P2		;GET ADDRESS OF WORD
00150		PUSHJ	P,FNDADR	;GET THE WORD
00160		TLNE	F,L.NXM		;WAS IT THERE?
00170		JRST	GETST2		;NO--NO MORE CORE
00180		PUSH	P1,T1		;STORE THE WORD
00190		AOBJN	P2,GETST1	;LOOP FOR WHOLE TABLE
00200		POPJ	P,		;RETURN
00210	
00220	;HERE IF NOT ALL OF S.T. IN CORE IMAGE FILE
00230	
00240	GETST2:	HLRZ	P1,P1		;GET THE NUMBER OF PUSHES
00250		MOVE	T1,SYMLEN	;GET THE LENGTH OF THE SYMBOL TABLE
00260		SUB	T1,P1		;GET THE NUMBER OF WORDS TO GIVE BACK
00270		MOVEI	P2,SYMNDX	;POINT TO S.T.
00280		PJRST	GIVCOR		;RETURN EXCESS
     
00010	;EVALUATE A SYMBOL -- CALLED FROM EXPRESSION EVALUATER
00020	
00030	EXPSYM:	PUSHJ	P,REDSYM	;READ A SYMBOL
00040		  POPJ	P,		;RETURN -- IT WAS A NUMBER
00050		JUMPE	T1,.POPJ	;ZERO IS NOT A SYMBOL
00060		SETZ	T3,		;ASSUME JUST A SYMBOL
00070		CAIE	C,":"		;WAS IT A ST NAME
00080		JRST	EXPSY1		;NO--JUST LOOKUP
00090		PUSH	P,T1		;YES--SAVE NAME
00100		PUSHJ	P,REDSYM	;GO READ A RADIX 50 SYMBOL
00110		  JRST	E.SYMF		;CANT BE A NUMBER
00120		MOVN	T2,SYNLEN	;T2 := -(LENGTH OF ST NAMES)
00130		MOVSI	T2,(T2)		;SWAP SO IT IS XWD -LENGTH,0
00140		HRRI	T2,@SYNTAB	;GET POINTER TO S.T. NAMES
00150		EXCH	T1,(P)		;GET BACK S.T. NAME
00160		CAME	T1,(T2)		;SCAN TABLE FOR MATCH
00170		AOBJN	T2,.-1		; ..
00180		JUMPGE	T2,E.STNU	;IF NO MATCH S.T. NAME IS UNDEFINED
00190		SUBI	T2,@SYNTAB	;GET BACK INDEX
00200		ADDI	T2,@SYPTAB	;POINT TO VALUE
00210		MOVE	T3,(T2)		;PICK UP S.T. POINTER
00220		POP	P,T1		;RESTORE T1 (SYMBOL TO LOOK FOR)
00230	EXPSY1:	PUSHJ	P,SY2VAL	;CONVERT SYMBOL NAME TO VALUE
00240		  SKIPA	T2,[-L.MSYM,,0]	;UNDEFINED SEE IF BUILT-IN
00250		POPJ	P,		;RETURN VALUE IN T1
00260		CAME	T1,MSYMTB(T2)	;IS THIS IT?
00270		AOBJN	T2,.-1		;NO--LOOP OVER ALL
00280		JUMPG	T2,E.SYMU	;UNDEFINED
00290		MOVE	T1,@MSYMAD(T2)	;PICK UP VALUE
00300		POPJ	P,		;RETURN
     
00010	;SUBROUTINE TO CONVERT SYMBOL TO VALUE
00020	
00030	SY2VAL:	SETZM	SYMPTR		;CLEAR POINTER
00040		TLZ	DL,DL.PNF!DL.MDL;CLEAR STATUS BITS
00050		SKIPN	T2,SYMLEN	;GET SIZE OF SYMBOL TABLE
00060		POPJ	P,		;EMPTY
00070		LSH	T2,-1		;DIVIDE BY 2
00080		MOVN	T4,SYMLEN	;PICK UP -VE LENGTH OF S.T.
00090		SKIPN	T3		;SKIP IF WE HAVE POINTER
00100		HRL	T3,T4		;WE DON'T -- COPY THIS POINTER
00110		ADDI	T3,@SYMTAB	;POINT TO REAL S.T.
00120	SY2VL3:	MOVE	T4,(T3)		;GET SYMBOL
00130		TLZN	T4,ST.PGM	;IS THIS A PROGRAM NAME
00140		JRST	[JUMPE T4,SY2VL4;IGNORE ZEROS
00150			 TLO   DL,DL.PNF;SET FLAG
00160			 JRST  .+1]	;BACK TO MAIN LOOP
00170		CAMN	T4,T1		;IS THIS A HIT
00180		JRST	SY2VL6		;YES--WE WIN (MAYBE)
00190	SY2VL4:	AOBJN	T3,.+1		;ADD 2 TO POINTER
00200		AOBJN	T3,.+2		; AND SEE IF END OF TABLE
00210		MOVE	T3,S2VPTR	;END--POINT BACK TO START
00220		SOJG	T2,SY2VL3	;LOOP FOR WHOLE S.T.
00230		SKIPE	T3,SYMPTR	;SKIP IF NO S.T. SPECIFIED
00240		TLNE	DL,DL.MDL	;SKIP IF NOT MULTIPLY DEFINED
00250		POPJ	P,		;SORRY YOU DO NOT WIN TODAY
00260	SY2VL5:	MOVE	T1,1(T3)	;GET VALUE
00270		JRST	.POPJ1		;SKIP RETURN
00280	
00290	SY2VL6:	MOVE	T4,(T3)		;GET SYMBOL BACK
00300		TLNE	T4,ST.SPI	;CAN WE USE IT?
00310		JRST	SY2VL4		;NO--KEEP LOOKING
00320		TLNN	T4,ST.GLB	;IS IT A GLOBAL?
00330		TLNN	DL,DL.PNF	;OR IN S.T. WE NAMED?
00340		JRST	SY2VL5		;YES--WE WIN
00350		SKIPN	T4,SYMPTR	;SKIP IF LOCAL FOUND BEFORE
00360		JRST	SY2VL7		;NONE. STORE THIS AS VALUE
00370		MOVE	T4,1(T4)	;GET THIS VALUE
00380		CAME	T4,1(T3)	;SAME AS OLD VALUE
00390		TLO	DL,DL.MDL	;NO--MUL DEFINED LCL
00400	SY2VL7:	HRRZM	T3,SYMPTR	;STOR POINTER
00410		JRST	SY2VL4		;KEEP LOOKING
     
00010	;SUBROUTINE TO CONVERT A VALUE TO A SYMBOL
00020	;ARGS:	T1=VALUE
00030	;VALUE:	T1=RADIX50 SYMBOL (WITH FLAGS STILL SET)
00040	;	T2=OFFSET FROM CORRECT SYMBOL
00050	VAL2SY:	JUMPE	T1,.POPJ	;ZERO IS NOT A SYMBOL
00060		SKIPE	SYVLEN		;IS SYVTAB SETUP
00070		JRST	VL2SY2		;YES--SKIP THE SORT
00080		PUSH	P,T1		;SAVE T1
00090		PUSHJ	P,SYMSRT	;NO--GO SORT SYMBOL TABLE
00100		POP	P,T1		;GET T1 BACK
00110	VL2SY2:	MOVE	T2,SYVLEN	;T2 IS CURRENT POINTER IN SYVTAB
00120		JUMPE	T2,.POPJ	;NOT FOUND IF NO SYMBOLS
00130		MOVE	T3,T2		;T3 IS AMOUNT TO ADJUST T2 BY
00140		PUSHJ	P,.SAVE4	;SAVE P1 AND P2
00150		MOVEI	P1,@SYMTAB	;GET THE POINTERS
00160		MOVEI	P2,@SYVTAB	; TO SAVE FUTURE TIME
00170		TLZ	DL,DL.SNF	;CAUSE FULL SCAN
00180	VL2SY1:	AOS	T3		;TAKE CEIL(T3/2)
00190		LSH	T3,-1		;CUT INC IN HALF (BINARY SEARCH)
00200		JUMPE	T3,NOSYMB	;DONE IF CUT DOWN TO ZERO
00210		PUSHJ	P,FNSYMV	;FIND POINTER TO SYMBOL VALUE
00220		MOVE	T4,(C)		;PICK UP VALUE
00230		CAMLE	T4,T1		;IS THIS .GT. WHAT WE WANT?
00240		JRST	VL2BIG		;YES--VALUE TOO BIG
00250		CAMN	T1,T4		;IS THIS THE RIGHT VALUE
00260		JRST	VL2HIT		;YES--RETURN
00270		ADD	T2,T3		;LOOK FOR BIGGER VALUE
00280		JRST	VL2SY3		; ..
00290	VL2BIG:	SUB	T2,T3		;LOOK FOR SMALLER VALUE
00300		SKIPGE	T2		;DEFENSIVE
00310		MOVEI	T2,0		; ..
00320	VL2SY3:	CAIE	T3,1		;LAST 2 WORDS?
00330		JRST	VL2SY1		; ..
00340		TLON	DL,DL.SNF	;WERE WE HERE BEFORE?
00350		JRST	VL2SY1		;NO--TRY ONE MORE TIME
00360		AOJA	T2,NOSYMB	;COUNTERACT EXTRA BUMP
     
00010	NOSYMB:	CAMGE	T1,(C)		;IS VALUE OF SYMBOL SMALLER THAN
00020					; WHAT WE WANT?
00030		SOJA	T2,[JUMPL T2,.POPJ ;NO--BACK UP SOME
00040			    PUSHJ P,FNSYMV ;GET VALUE AND
00050			    JRST .-1]      ;RETRY
00060		SKIPG	(C)		;SKIP IF STILL POSITIVE
00070		POPJ	P,		;NO--THE NO MATCH
00080		MOVE	T2,T1		;COPY VALUE WE WANTED
00090		SUB	T2,(C)		;SUBTRACT WHAT WE FOUND
00100		MOVE	T1,-1(C)	;PICK UP SYMBOL
00110		CAIGE	T2,100		;TOO BIG?
00120		AOS	(P)		;NO--GIVE SKIP RETURN
00130		POPJ	P,		;YES-- FAIL
00140	
00150	VL2HIT:	MOVE	T1,-1(C)	;GET THE SYMBOL
00160		SETZ	T2,0		;CLEAR OFFSET
00170		JRST	.POPJ1		;SKIP RETURN
     
00010	FNSYMV:	MOVE	C,T2		;GET INDEX TO VECTOR
00020		LSH	C,-1		;MAKE SMALLER (HALF WORD ADDRESS)
00030		ADD	C,P2		;ADD IN START OF PERMUTATION VECTOR
00040		MOVE	T4,(C)		;GET POINTER TO S.T.
00050		TRNN	T2,1		;ODD POINTER?
00060		MOVS	T4,T4		;NO--SWAP HALVS
00070		MOVEI	C,1(P1)		;GET POINTER TO VALUES
00080		ADDI	C,(T4)		;ADD IN OFFSET
00090		POPJ	P,		;RETURN
     
00010	;ROUTINE TO FIX UP POINTERS TO LOCAL S.T. WITHIN SYMBOL TABLE
00020	
00030	FIXSYM:	TLZN	DL,DL.FBR	;IS SYMBOL TABLE O.K. ?
00040		POPJ	P,		;YES--RETURN
00050		PUSHJ	P,.SAVE2	;SAVE SOME AC'S
00060		MOVN	T1,SYMLEN	;GET -VE LENGTH OF S.T.
00070		HRLZ	T1,T1		;PUT IN L.H.
00080		HRRI	T1,@SYMTAB	;PUT IN POINTER TO TABLE
00090		MOVEM	T1,S2VPTR	;SAVE FOR LATER
00100		MOVEI	T1,^D100	;NUMBER OF LOCAL S.T.
00110		MOVEI	P2,SYNNDX	;GET INDEX
00120		PUSHJ	P,GETCOR
00130		MOVEI	T1,^D100	;NUMBER OF LOCAL S.T.
00140		MOVEI	P2,SYPNDX	;EXPAND LOCAL S.T.
00150		PUSHJ	P,GETCOR	; ..
00160		MOVEI	P1,@SYNTAB	;POINTER TO NAME TABLE
00170		MOVEI	P2,@SYPTAB	;POINTER TOPOINTER TABLE
00180		SOS	P1		;FIX P1 AND P2 SO THEY
00190		SOS	P2		; CAN BE USED AS PUSH DOWN POINTERS
00200		MOVE	T4,S2VPTR	;POINTER TO S.T.
00210		HLLZ	T2,T4		;COPY INDEX TO START OF S.T.
00220		PUSH	P2,T2		; AND STORE AS FIRST POINTER
00230	FXSYM1:	MOVE	T1,(T4)		;GET SYMBOL
00240		TLNN	T1,ST.PGM	;IS IT A PROGRAM NAME
00250		CAIN	T1,0		; ..
00260		JRST	FXSYM2		;NO--SCAN OVER MORE SYMBOLS
00270		PUSH	P1,T1		;SAVE NAME
00280		MOVE	T2,T4		;COPY POINTER
00290		SUBI	T2,@SYMTAB	;CONVERT BACK TO RELATIVE POINTER
00300		ADD	T2,[2,,2]	;POINT PAST PROGRAM NAME
00310		SKIPGE	T2		;SKIP IF WE ARE NOW DONE
00320		PUSH	P2,T2		;SAVE INDEX
00330	FXSYM2:	AOBJN	T4,.+1		;BUMP POINTER
00340		AOBJN	T4,FXSYM1	;LOOP FOR ALL SYMBOLS
     
00010		HLRZ	P1,P1		;GET SIZE OF TABLE
00020		CAIL	P1,^D100	;TOO BIG?
00030		JRST	[M.FAIL	<TOO MANY PROGRAMS LOADED>
00040	]
00050		MOVE	T1,SYPLEN	;GET LENGTH OF POINTERS
00060		CAME	T1,SYNLEN	;COMPARE WITH NAMES
00070		JRST	[M.FAIL	<BAD SYMBOL TABLE>
00080	]
00090		MOVEI	T1,^D100	;ORIGINAL SIZE
00100		SUBB	T1,P1		;NUMBER OF FREE WORDS
00110		MOVEI	P2,SYNNDX	;GET INDEX TO TABLE
00120		PUSHJ	P,GIVCOR	;RETURN CORE
00130		MOVE	T1,P1		;GET SIZE AGAIN
00140		MOVEI	P2,SYPNDX	;GET POINTER TO OTHER TABLE
00150		PJRST	GIVCOR		;RETURN
     
00010	;HERE TO GIVE BACK SYMBOL TABLE OVERHEAD LISTS
00020	
00030	GIVSYM:	TLO	DL,DL.FBR	;NOTE ST POINTERS ARE JUNK
00040		PUSHJ	P,.SAVE2	;SAVE P1 AND P2
00050		MOVE	T1,SYVLEN	;GET LENGTH OF PERMUTATION VECTOR
00060		MOVEI	P2,SYVNDX	;GET INDEX
00070		PUSHJ	P,GIVCOR	;GIVE BACK CORE
00080		MOVEI	P2,SYPNDX	;GIVE BACK POINTER TABLE
00090		MOVE	T1,SYPLEN	; ..
00100		PUSHJ	P,GIVCOR	; ..
00110		MOVEI	P2,SYNNDX	;GIVE BACK NAME TABLE
00120		MOVE	T1,SYNLEN	; ..
00130		PJRST	GIVCOR		; ..
     
00010	SUBTTL 	SYMBOL TABLE LOGIC -- SORT ROUTINE
00020	
00030	;THIS IS A PERMUTATION VECTOR SORT FIRST DESCRIBED BY
00040	; LUTHER WOODRUM IN VOL. 8 NO. 3 OF THE IBM SYSTEMS
00050	; JOURNAL. THIS VERSION WAS DERIVED FROM A FORTRAN
00060	; SUBROUTINE WRITTEN BY TIM TOMASELLI, VICTOR TRIOLO
00070	; AND CLIVE DAWSON. THE ORIGINAL VERSION WAS WRITTEN
00080	; IN APL.
00090	
00100	APLSRT:	PHASE 	IBUF		;IMPURE CODE
00110	
00120		A=123456		;UNIQUE NUMBER TO PATCH TO BE @SYMTAB
00130		V=707070		;UNIQUE NUMBER TO PATCH TO BE @SYVTAB
00140	
00150		SETZ	P1,		;GLOBAL POINTER TO FIRST UNPROCESSED
00160					; ELEMENT.
00170		MOVE	N,SYMLEN	;N _ SIZE OF S.T.
00180		LSH	N,-1		;FIX TO ALLOW FOR 2 WORD ENTRIES
00190		JUMPE	N,.POPJ		;CAN NOT SORT ZERO LENGTH S.T.
00200		PUSHJ	P,MP		;SORT IT
00210		POP	P,T2		;GET HEADER TO LIST
00220		SETZ	T3,		;CLEAR ITEM NUMBER
00230	A7:!	MOVE	T1,T2		;COPY LINK
00240		MOVE	T2,V(T1)	;GET NEXT ITEM
00250		MOVEM	T3,V(T1)	;STORE INDEX IN ITEM
00260		CAME	T1,T2		;DONE (LAST LINK POINTS TO SELF)
00270		AOJA	T3,A7		;NO--KEEP UNLINKING
00280		MOVN	T3,SYVLEN	;GET -VE SIZE
00290		HRLZS	T1,T3		;FLIP POINTER AROUND
00300	I1:!	MOVE	T4,V(T3)	;SET V[V[I]] _ I
00310		HRLM	T3,V(T4)	; WITHOUT DISTURBING V[I]
00320		AOBJN	T3,I1		;LOOP FOR WHOLE ARRAY
00330		MOVSI	P2,(POINT 18,0)	;BYTE POINTER TO
00340		ADDI	P2,V		; PERMUTATION VECTOR.
00350		MOVE	T2,[A,,V]	;VERY RARE SYMBOL VALUE TO INIT
00360		MOVEM	T2,SAVSYM	; MEMORY WORD.
00370	I2:!	HLRZ	T2,V(T1)	;GET INDEX INTO SYMTAB
00380		LSH	T2,1		;EXPAND BACK AGAIN
     
00010					;ISSPD: IS USED TO GET AT SYMBOL
00020					; IT POINTS TO THE PASSIVE PART
00030					; OF THE DATA(SYMBOL) IT IS 1 LESS
00040					; THAN ALL THE OTHER "A"'S WHICH
00050					; POINT TO THE VALUE.
00060	ISSPD:!	MOVE	T4,A(T2)	;GET SYMBOL
00070		TLNE	T4,ST.PGM	;PROGRAM NAME?
00080		TLNE	T4,ST.SPD	;SPD FLAG ON?
00090		JRST	I3		;YES--PROGRAM NAME ON KILLED ON OUTPUT
00100		MOVE	T4,A(T2)	;GET SYMBOL VALUE
00110		CAMN	T4,SAVSYM	;SAME VALUE?
00120		JRST	I3		;YES--LOOP FOR NEXT ***TEMP***
00130		MOVEM	T4,SAVSYM	;NO--THIS IS NE LAST SYMBOL
00140		IDPB	T2,P2		;ELSE STORE IN VECTOR
00150	I3:!	AOBJN	T1,I2		;LOOP OVER WHOLE TABLE
00160		IDPB	T2,P2		;STORE A PAD BYTE IF NEEDED
00170		MOVEI	T1,1(P2)	;GET SIZE OF FINAL VECTOR
00180		SUBI	T1,V		;GET BACK TO RELATIVE ADDRESS
00190		MOVNS	T1		;MAKE CURRENT LENGTH -VE
00200		ADD	T1,SYVLEN	;ADD IN OLD LENGTH SO RESULT IS
00210					; AMOUNT TO GIVE BACK.
00220		MOVEI	P2,SYVNDX	;GET ITS INDEX
00230		PJRST	GIVCOR		;RETURN WHAT WE DO NOT NEED
     
00010	MP:	CAIN	N,1		;CAN THIS LINK BE FORMED?
00020		JRST	BOTTOM		;YES - JUMP OUT
00030		PUSH	P,N		;SAVE 'N' FOR LATER
00040		ASH	N,-1		;FLOOR(N/2)
00050		PUSHJ	P,MP		;SOME RECURSION IS GOOD FOR THE SOUL
00060		POP	P,N		;GET 'N' BACK
00070		EXCH	N,(P)	
00080		ADDI	N,1		;CIELING OF (N/2)
00090		ASH	N,-1		; ..
00100		PUSHJ	P,MP		;MORE RECURSION
00110		JRST	MERGE		;MERGE ANY CHAINS THAT EXIST
00120	BOTTOM:!MOVEM	P1,V(P1)	;V[P1] _ P1 (LINK TO SELF)
00130		PUSH	P,(P)		;THERE MUST BE A REASON FOR
00140		MOVEM	P1,-1(P)	; THESE 2 INSTRUCTIONS.
00150		AOJA	P1,.POPJ	;P1_P1+1 AND RETURN
00160	
00170	MERGE:!	POP	P,T1		;M1.
00180		POP	P,T2	
00190		MOVE	C,T2		;COPY INDEX
00200		LSH	C,1		;POINT TO VALUE
00210		MOVE	T3,A(C)		;SEE IF A[J] < A[I]
00220		MOVE	C,T1		;COPY INDEX
00230		LSH	C,1		;POINT TO VALUE
00240		CAMGE	T3,A(C)		;SEE WHICH IS BIGGER
00250		EXCH	T1,T2		;EXCHANGE THE INDICIES
00260		PUSH	P,(P)		;STORE T1 ON
00270		MOVEM	T1,-1(P)	; STACK
00280	M2:!	CAME	T1,V(T1)	;M2. [END OF CHAIN] IF P[T1] = T1
00290		JRST	M3		;NO--KEEP DOING
00300		MOVEM	T2,V(T1)	;SET V[T1] _ T2
00310		POPJ	P,		;RETURN
00320	
00330	M3:!	MOVE	T4,T1		;M3. [ADVANCE] SET T4 _ T1
00340		MOVE	T1,V(T1)	;I _ V[I]
00350		MOVE	T3,T1		;GET INDEX
00360		LSH	T3,1		;FIX FOR TABLE SIZE
00370		MOVE	T3,A(T3)	;SEE IF STIILL IN ORDER
00380		MOVE	C,T2
00390		LSH	C,1
00400		CAMGE	T3,A(C)		;IF A[T1] < A[T2]
00410		JRST	M2		;GOTO M2
00420	M4:!	MOVEM	T2,V(T4)	;M4. SET V[T4] _ T2
00430		EXCH	T1,T2		;SWAP AROUND INDICIES
00440		JRST	M2
00450	SAVSYM:!BLOCK	1
00460		DEPHASE
00470	APLSIZ==.-APLSRT
     
00010	
00020	SYMSRT:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
00030		MOVE	T1,SYMLEN	;GET SIZE OF SYMBOL TABLE
00040		LSH	T1,-1		;CUT IN HALF
00050		MOVEI	P2,SYVNDX	;INDEX TO TABEL VECTOR
00060		PUSHJ	P,GETCOR	;GO GET THE CORE WE NEED
00070		MOVE	T1,[APLSRT,,IBUF];BLT POINTER
00080		BLT	T1,IBUF+APLSIZ	;COPY THE CODE
00090		MOVEI	T1,@SYMTAB	;POINTER TO SYMBOLS
00100		ADDI	T1,1		;CAUSE TO POINT TO VALUE WORD
00110		MOVEI	T2,@SYVTAB	;POINTER TO PERMUTATION VECTOR
00120		MOVE	T3,[-APLSIZ,,IBUF] ;AOBJN POINTER
00130	SYNSR1:	HRRZ	T4,(T3)		;GET Y ADDRESS
00140		CAIN	T4,V		;ADDRESS IN PERMUTATION VECTOR
00150		MOVEI	T4,(T2)		;YES--FIX POINTER
00160		CAIN	T4,A		;ADDRESS IN SYMBOL TABLE?
00170		MOVEI	T4,(T1)		;YES--DO THAT TOO
00180		HRRM	T4,(T3)		;STORE BACK
00190		AOBJN	T3,SYNSR1	;LOOP FOR ALL CODE BLTED
00200		SOS	ISSPD		;FIX THE ONE LOOSER
00210		JRST	IBUF		;GO DO THE SORT
     
00010		SUBTTL	OP DECODER
00020	
00030	;DESCRIPTION OF OP DECODER FOR DUMP:
00040	;
00050	;         THE ENTIRE INSTRUCTION SET FOR THE PDP-10 CAN BE COMPACTED INTO
00060	;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL.  THIS OCCURS
00070	;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
00080	;FOR THE PDP-10.  FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
00090	;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
00100	;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
00110	;BEGIN WITH 110(2).
00120	;
00130	;     	THE TABLE TBL IN DUMP CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
00140	;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
00150	;0-37(8):	THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
00160	;	LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
00170	;	EQUAL P.
00180	;
00190	;	THE CONTENTS OF P2 (INSTRUCTION) CONTAIN IN THE RIGHT
00200	;	MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
00210	;	P AND N REFER TO THE CONTENTS OF P2, AND THE OP DECODER
00220	;	WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
00230	;	OF P2X N+1 GIVES THE NUMBER OF BITS IN P2; P GIVES THE
00240	;	POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
00250	;
00260	;	EXAMPLE: P = 6
00270	;	         N = 2
00280	;
00290	;;	C(P2) = .010 101 100(2)
00300	;
00310	;	THE RESULT = D = 010(2) = 2(8)
00320	;
00330	;	D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
00340	;	IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
00350	;	PRINT TEXT OR ARE THE EXTEND BYTE, 41-73(8))
00360	;	ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
00370	;	THE INTERPRETATION.
00380	;
00390	;40(8)	THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
00400	;	IS FINISHED.
00410	;41(8)-72(8)	THE ALPHABET IS ENCODED INTO THIS RANGE.
00420	;	41- A
00430	;	42- B
00440	;	72- Z
00450	;	WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
00460	;	LETTER IS TYPED.
     
00010	;73(8)	THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
00020	;	IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
00030	;	BY <1000-74*2+FIR.> FIRST.
00040	;
00050	;74(8)-777(8)	THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
00060	;	CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE 
00070	;	<A-74(8)+FIR.>RD BYTE IN THE TABLE.
00080	;
     
00010	DEFINE BYT9 (A) <IRP A,<
00020	A>>
00030	
00040	IF1,<
00050	
00060	DEFINE	.ADR	(A) <
00070	%'A==	CLOC
00080	FIR.==	CLOC
00090	DEFINE	.ADR	(B) <
00100	%'B==	CLOC
00110	LASTB==CLOC+74-FIR.>>
00120	
00130	DEFINE	.TRA (A)<CLOC==CLOC+1>
00140	DEFINE .TRAX (A)<CLOC==CLOC+2>
00150	
00160	SYN	.TRA,	.DIS
00170	
00180	DEFINE	.TXT	(A) <
00190	IFNB	<A>,	<IRPC A,<CLOC==CLOC+1>>>
00200	
00210	DEFINE	.END	(A) <
00220	IFNB	<A>,	<IRPC A,<CLOC==CLOC+1>>
00230	CLOC==	CLOC+1>
00240	
00250	>	;END OF IF1
00260	IF2,<
00270	
00280	DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>
00290	
00300	DEFINE .TRA (A) <OUTP %'A+74-FIR.>
00310	
00320	DEFINE .TRAX (A),<OUTP 73
00330		OUTP	74+<Z1==%'A-FIR.-1000+74>
00340		IFL	Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>
00350	
00360	DEFINE .DIS (A) <OUTP A&70/2+A&7-1>
00370	
00380	DEFINE .TXT (A) <IFNB <A>,<IRPC A,<OUTP "A"-40>>>
00390	
00400	DEFINE	.END	(A) <
00410	IFNB	<A>,	<IRPC A,<OUTP "A"-40>>
00420	OUTP	40>
00430	
00440	DEFINE OUTP (A)<
00450	IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
00460	IFE <BINC==BINC-9>-^D27,<BINR1==A>
00470	IFE BINC-^D18,<BINR2==A>
00480	IFE BINC-9,<BINR3==A>
00490		IFE	BINC,<	BYTE (9) BINR1,BINR2,BINR3,<A>
00500		BINC==^D36>
00510	CLOC==CLOC+1 >
00520	>
     
00010	TBL:  ;OPDECODER BYTE TABLE
00020	
00030		XALL
00040	IFDEF	.XCREF	<.XCREF>
00050	
00060	
00070	CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0
00080	BINC== ^D36 ;INIT BYTES/WORD COUNTER
00090	IF1,<	DEFINE	BYTABL,<
00100		XLIST
00110	
00120	;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
00130	;**************TERMINATES AT THE NEXT COMMENT WITH: **************
00140	
00150	BYT9 <
00160		LIST
00170	
00180	.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
00190		.TXT H,.TRA HWT,.TXT T,.TRA ACBM
00200	
00210	
00220	;IO INSTRUCTIONS
00230	
00240	.DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
00250	.ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
00260		.ADR OI,.DIS 01,.TRA O,.TRA I
00270	;UUOS
00280	
00290	.ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
00300		.DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
00310	.TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
00320	.ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
00330	.ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
00340		.ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
00350	.ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
00360		.ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S
00370	
00380	;BYTE AND FLOATING INSTRUCTIONS
00390	
00400	.ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
00410		.TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
00420	.DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
00430		.ADR L,.END L,.TXT,.ADR M,.END M,.TXT
00440	.ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.END,.TRAX I110,.TRA I120,.TXT
00450		.DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N
00460	.TXT FS,.TRA CTYP,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD
00470		.ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B
     
00010	;FWT-FIXED POINT ARITH-MISC
00020	
00030	.ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV
00040		.TRA SH,.TRA H1,.TRA JP
00050	.DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT
00060		.ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22
00070	.ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M
00080		.ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT
00090	.ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB
00100		.ADR DV,.DIS 21,.TXT I,.TRA DV1
00110	.ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL
00120		.ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ
00130	.TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P
00140		.ADR AOB,.DIS 01,.TRA P,.TRA N
00150	.ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO
00160		.ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT
00170	.TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA
00180		.ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP
00190	.DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L
00200		.ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END
00210		.ADR S1,.DIS 21,.END,.TXT,.ADR CTYP,.END C,.TXT
00220	
00230	;ARITH COMP-SKIP-JUMP
00240	
00250	.ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S
00260		.ADR JS,.TXT O,.DIS 31
00270	.TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP
00280	.ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP
00290	.DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E
00300		.ADR N,.END N,.TXT,.END G,.TXT
     
00010	;HALF WORDS
00020	
00030	.ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3
00040	.ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L
00050		.ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS
00060	
00070	;TEST INSTRUCTIONS
00080	
00090	.ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2
00100		.ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L
00110	.ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O
00120		.ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N
00130	
00140	;BOOLEAN
00150	
00160	.ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST
00170	.TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ
00180		.TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR
00190	.ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB
00200		.ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB
00210	.ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB
00220		.ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA
00230	.TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB
     
00010	;INSTRUCTION GROUP 120
00020	.ADR I120,.DIS 11,.TRA DMOV,.DIS 01,.TXT FIX,.TRA FIX2,.DIS 21,.END
00030		.TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R
00040	.ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N
00050		.ADR EM,.DIS 21,.END,.TRA M
00060	
00070	;MORE UUO'S
00080	
00090	.ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END
00100		.TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T
00110	.ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S
00120		.TXT MTAP,.TRA E,.TXT UGET,.TRA F
00130	
00140	;INSTRUCTION GROUP 110 - DF ARITHMETIC
00150	.ADR I110,.DIS 21,.TXT DF,.TRAX DF,.END,.ADR DF,.DIS 02
00160		.END AD,.END SB,.TXT M,.TRA P,.END DV
00170	
00180	;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
00190	>>>
     
00010		BYTABL
00020	IF1,<	BLOCK	<CLOC+3>/4>
00030		IF2,<	IFN BINC-^D36,<BYTE (9) BINR1,BINR2,BINR3,0> >
00040	
00050	IFNDEF CLOC.,<CLOC.==CLOC>
00060	IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>
00070	
     
00010	IF2,<
00020	DEFINE	.ADR	(A) <
00030		PURGE	%'A
00040	>
00050	DEFINE	.DIS	(A)<>
00060	DEFINE	LIST	<>
00070	DEFINE	.TRA	(A)<>
00080	DEFINE	.TRAX	(A)<>
00090	DEFINE	.TXT	(A)<>
00100	DEFINE	.END	(A)<>
00110		BYTABL
00120		PURGE	LIST
00130		LIST
00140		PURGE	BINR1,BINR2,BINR3,OUTP,CLOC,CLOC.,BINC,Z1
00150		PURGE	.TRA,.TRAX,.TXT,.END,BYT9,BYTABL
00160	> ;END IF2
00170	IFDEF	.CREF	<.CREF>
     
00010	;CALLI NAMES
00020	
00030		DEFINE	S(A)<
00040		IRP	A,<
00050		XLIST
00060		<SIXBIT	/A/>
00070		LIST
00080	>>
00090	
00100		MAXNCI==.-CITAB
00110		S	<LIGHTS>;
00120	CITAB:	S	<RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT>;    ;0 TO 5
00130		S	<GETCHR,DDTRL,WAIT,CORE,EXIT,UTPCLR,DATE>;   ;6 TO 14
00140		S	<LOGIN,APRENB,LOGOUT,SWITCH,REASSI,TIMER>;   ;15 TO 22
00150		S	<MSTIME,GETPPN,TRPSET,TRPJEN,RUNTIM,PJOB>;   ;23 TO 30
00160		S	<SLEEP,SETPOV,PEEK,GETLIN,RUN,SETUWP,REMAP>; ;31 T0 37
00170		S	<GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR>;    ;40 TO 45
00180	;END OF 4.72 CALLIS
00190	
00200		S	<SYSSTR,JOBSTR,STRUUO,SYSPHY,FRECHN,DEVTYP>; ;46 TO 53
00210		S	<DEVTYP,DEVPPN,SEEK>;			     ;54 AND 55
00220	
00230	;END OF 5.01 CALLIS
00240	
00250		S	<RTTRP,LOCK,JOBSTS,LOCATE,WHERE,DEVNAM,CTLJOB>; ;56 TO 65
00260		S	<GOBSTR,ACTIVA,DEACTI>;			        ;66 TO 70
00270	
00280	;END OF 5.02 CALLIS
00290	
00300		S	<HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN,OTHUSR>;;71 TO 77
00310		S	<CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN>; ;100 TO 105
00320		S	<FRCUUO,DEVLNM>;                             ;106 TO 107
00330	
00340	;END OF 5.03 CALLIS
00350	
00360		S	<PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.>;   ;110 TO 115
00370		S	<TRMOP.,RESDV.,UNLOK.>;		     ;116 TO 120
00380	;END OF 5.04 CALLIS
00390	
00400		S	<DISK.,DVRST.,DVURS.>
00410	MAXCAL==.-CITAB-1
     
00010	BTAB:	POINT	9,TBL		;TABLE USED TO GET NEXT BYTE POINTER
00020		POINT	9,TBL,8		;FOR TRANSFER BYTE
00030		POINT	9,TBL,17
00040		POINT	9,TBL,26
00050	
00060	
00070	;SUBROUTINE TO LOOKUP AN OPCODE IN THE TABLE AND RETURN ITS
00080	; SIXBIT NAME
00090	;ARG:	T1=BINARY WORD
00100	;VALUE:	N=SIXBIT VALUE
00110	;
00120	; SKIP RETURNS IF VALID OPCODE ELSE JUST POPJ RETURN
00130	;
00140	OPDEC:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
00150		MOVE	N,LASTOP	;GET LAST OPCODE
00160		CAMN	T1,LASBIN	;IS THIS THE SAME
00170		JRST	DCODEX		;YES--GIVE SAME ANSWER
00180		MOVEM	T1,LASBIN	;STORE FOR NEXT TIME
00190		MOVEI	P1,P2		;POINT TO OPCODE
00200		MOVE	P2,T1		;PLACE OPCODE SOMEPLACE SAFE
00210		LSH	P2,-33		;JUST WANT OPCODE
00220		CAIE	P2,47		;IS THIS A CALLI?
00230		JRST	NTCALL		;NO--LOOK UP IN TBL:
00240		HRREI	T1,(T1)		;GET ACT VALUE
00250		CAML	T1,[MAXNCI]	;SMALLER THAN MIN.
00260		CAILE	T1,MAXCAL	;BIGGER THAN MAX.
00270		JRST	NTCALL		;YES--JUST SAY CALLI
00280		MOVE	N,CITAB(T1)	;NO--GET REAL NAME
00290		MOVEM	N,LASTOP	;REMEMBER THIS FOR NEXT TIME
00300		PJRST	.POPJ1		;RETURN
00310	NTCALL:	SETZ	N,		;CLEAR ANSWER
00320		MOVE	C,[POINT 6,N]	;POINTER TO ANSWER
00330		SETZB	T2,T3		;CLEAR TEMP AC'S
00340		MOVE	T4,BTAB		;POINT TO TABLE
00350	DCODE1:	ILDB	T1,T4		;GET A BYTE
00360		CAILE	T1,40		;SKIP IF 0-40 (DISPATCH OR STOP CODE)
00370		CAIL	T1,74		;SKIP IF TRANSFER BYTE
00380		SOJGE	T2,DCODE1	;0-40 OR TRANSFER BYTE LOOP FOR
00390					; C(T2) MORE BYTES.
00400		JUMPG	T2,DCODE1	;JUMP IF DISPATCH AND T2 .GT. 0
00410		SUBI	T1,40		;KNOCK DOWN CODE BY 40.
00420		JUMPE	T1,DCODEX	;JUMP IF STOP CODE
00430		JUMPG	T1,DCODE2	;JUMP IF LETTER OR TRANSFER
00440		DPB	T1,[POINT 5,P1,7];MAKE P1 POINT TO NEXT  
00450		TRZ	T1,-4		; GROUP OF BITS IN 
00460		AOS	T1		; THE OPCODE FIELD.
00470		DPB	T1,[POINT 6,P1,11]
00480		LDB	T2,P1		;GET THE BITS
00490		JRST	DCODE1		;LOOP FOR THIS PART OF OPCODE
     
00010	DCODE2:	HRREI	T1,-33(T1)	;TOTAL SUBTRACTED IS NOW 73. 
00020		JUMPL	T1,DECT		;SO -VE NUMBERS ARE LETTERS.
00030		JUMPG	T1,DCODE3	;AND POSITIVE NUMBERS ARE TRANSFERS.
00040		ILDB	T1,T4		;ZERO(73) IS SPECIAL HACK TO LET US
00050		MOVEI	T1,611(T1)	; GET MORE INTO TABLE FOR KI-10.
00060	DCODE3:	MOVEI	T3,FIR.-1(T1)	;FIR. IS FIRST BYTE WE NEED TO "GOTO"
00070					; SO ALL ADDRESSES ARE KEYED OFF FIR.
00080		IDIVI	T3,4		;9-BIT BYTES. 4 BYTES/WORD.
00090		MOVE	T4,BTAB(T4)	;BYTE POINTER TO WHERE WE JUST JRSTED
00100		ADDI	T4,(T3)		;ADD IN WORD ADDRESS (OFFSET)
00110		JRST	DCODE1		;LOOP TO LOOK AT THAT BYTE.
00120	
00130	DECT:	MOVEI	T1,73(T1)	;CONVERT BACK TO SIXBIT
00140		IDPB	T1,C		;STORE IN N
00150		JRST	DCODE1		;LOOP BACK FOR REST.
00160	
00170	DCODEX:	MOVEM	N,LASTOP	;SAVE FOR NEXT TIME
00180		SKIPE	N		;DONE. DID WE STORE ANYTHING?
00190		AOS	(P)		;YES--SKIP RETURN
00200		POPJ	P,		;NO--PLAIN RETURN
     
     
00010	SUBTTL CORE MANAGEMENT SUBROUTINES
00020	
00030	;SUBROUTINE TO EXPAND A TABLE
00040	;ARGS	T1=WORDS TO GET
00050	;	P2=INDEX IN TABLE VECTOR
00060	
00070	GETCOR:	JUMPE	T1,.POPJ	;JUMP IF NO CHANGE
00080		PUSH	P,T1		;SAVE INCREMENT
00090		ADDM	T1,LENVEC(P2)	;INCREMENT SIZE OF TABLE
00100		ADDB	T1,.JBFF	;AND END OF TABLES
00110		CAMG	T1,.JBREL	;SKIP IF MUST EXPAND CORE
00120		JRST	GETCR1		;ALREADY HAVE ENOUGH
00130		CORE	T1,		;TRY TO EXPAND CORE
00140		  JRST	E.NCOR		;CANT GET ENOUGH CORE
00150	GETCR1:	CAIN	P2,LSTTAB	;SKIP IF NOT LAST TABLE
00160		JRST	T1POPJ
00170		MOVE	T1,(P)		;RESET INCREMENT
00180		PUSH	P,T2
00190		PUSH	P,T3
00200		MOVE	T2,.JBFF	;T2=NEW LAST ADDRESS OF TABLES
00210		SUB	T1,T2		;T1=-OLD LAST ADDRESS
00220		MOVNS	T1		;T1=OLD LAST ADDRESS
00230		HRLI	T1,-1		;MAKE PUSH DOWN PTR SUITABLE FOR POPS
00240		MOVE	T3,TABVEC+1(P2)	;OLD LAST ADDRESS OF NEXT TABLE
00250	GETCR2:	POP	T1,(T2)	;OLD TO NEW LOCATION
00260		CAIG	T3,(T1)		;SKIP IF JUST MOVED FIRST LOC OF TABLE PAST EXPANDED
00270		SOJA	T2,GETCR2	;LOOP TILL DONE
00280		MOVEI	T2,1(P2)	;INDEX OF NEXT TABLE
00290		MOVE	T1,-2(P)	;RESET INCREMENT
00300	GETCR3:	ADDM	T1,TABVEC(T2)	;INCREMENT THE START ADDR OF TABLES THAT FOLLOW
00310		CAIE	T2,LSTTAB	;SKIP IF INCREMENTED LAST TABLE
00320		AOJA	T2,GETCR3	;LOOP FOR THE REST OF THE TABLES
00330		POP	P,T3
00340		POP	P,T2
00350	T1POPJ:	POP	P,T1
00360		POPJ	P,
     
00010	;SUBROUTINE TO CONTRACT A TABLE
00020	;ARGS	T1=WORDS TO GIVE BACK
00030	;	P2=INDEX IN TABLE VECTOR
00040	
00050	GIVCOR:	CAMG	T1,LENVEC(P2)	;SKIP IF GIVING BACK TOO MUCH
00060		JRST	GIVCR1		;OK
00070		PUSH	P,LENVEC(P2)	;SAVE CURRENT LENGTH OF TABLE
00080		MOVEI	T1,[ASCIZ .GIVING BACK TOO MUCH CORE .]
00090		PUSHJ	P,LSTR
00100	;TYPE HOW MUCH, CURRENT LENGTH
00110		POP	P,T1		;RESTORE LENGTH TO GIVE BACK=CURRENT LENGTH
00120	GIVCR1:	JUMPE	T1,.POPJ	;EXIT IF NO CHANGE
00130		MOVNS	T1		;T1=MINUS WORDS TO GIVE BACK
00140		ADDM	T1,LENVEC(P2)	;DECREMENT LENGTH OF TABLE
00150		ADDM	T1,.JBFF	;AND END OF TABLES
00160		CAIN	P2,LSTTAB	;SKIP IF NOT LAST TABLE
00170		JRST	GIVCRE		;NO SHUFFLING NEEDED
00180		PUSH	P,T2
00190		MOVE	T2,TABVEC+1(P2) ;START ADDR OF NEXT TABLE
00200		HRLS	T2		;IN BOTH HALVES
00210		ADD	T2,T1		;RIGHT HALF=NEW START ADDR
00220		BLT	T2,@.JBFF	;MOVE UP TABLES PAST THIS TABLE
00230		MOVEI	T2,1(P2)	;INDEX OF NEXT TABLE
00240	GIVCR2:	ADDM	T1,TABVEC(T2)	;DECREMENET START ADDR OF REST OF TABLES
00250		CAIE	T2,LSTTAB	;SKIP IF DECREMENTED LAST TABLE
00260		AOJA	T2,GIVCR2
00270		POP	P,T2
00280	GIVCRE:	MOVE	T1,.JBREL	;TOTAL SIZE OF CORE
00290		SUB	T1,.JBFF	;MINUS LENGTH NEEDED
00300		CAIGE	T1,4000		;SKIP IF MORE THAN 2K EXCESS
00310		POPJ	P,		;OK, DONT WORRY
00320		MOVNI	T1,2000		;-1K
00330		ADD	T1,.JBREL
00340		CORE	T1,		;GIVE BACK 1 K
00350		  JFCL
00360	.POPJ:	POPJ	P,
     
00010	SUBTTL ERRORS
00020	
00030	;HERE FOR VARIOUS ERRORS
00040	
00050	E.NIMP:	MOVE	N,VERBN(P1)	;NAME OF VERB
00060		M.FAIN	<NOT CODED>
00070	
00080	E.NCOR:	MOVE	N,TABNAM(P2)	;NAME OF TABLE THAT WANTED TO EXPAND
00090		M.FAIN	<CANT EXPAND TABLE>
00100	
00110	E.EXP:	M.FAIL	<SYNTAX ERROR>
00120	
00130	E.MAX:	HRLZ	N,T1		;SET MAXIMUM
00140		M.FAIO	<MAX =>
00150	
00160	E.NSFI:	MOVEI	N,(DL)
00170		M.FAIF	<CANT FIND INPUT FILE - ERROR CODE=>
00180	
00190	E.NSFO:	MOVEI	N,O.ZER
00200		M.FAIF	<CANT ENTER OUTPUT FILE>
00210	
00220	E.LKO:	MOVE N,T2
00230		M.FAIN	<OPEN failure for device>
00240	
00250	E.LKL:	HRLZ	N,T2		;COPY ERROR CODE
00260		M.FAIO	<LOOKUP failure for input device - code>
00270	
00280	E.STNU:	PUSHJ	P,TRDX5		;TYPE IN RADIX 50
00290		MOVEI	T1,[ASCIZ / is a undefined symbol table name
00300	/]
00310		PUSHJ	P,.TSTRG##
00320		PJRST	.FMSGE##
     
00010	E.SYMF:	M.FAIL	<Wrong format for symbol (: must be followed by a symbol)>
00020	E.SYMU:	PUSHJ	P,TRDX5
00030		TLNE	DL,DL.MDL
00040		JRST	E.SMDL
00050		MOVEI	T1,[ASCIZ / is an undefined symbol
00060	/]
00070		pushj	p,.tstrg##
00080		pjrst	.fmsge##
00090	e.smdl:	movei	t1,[asciz / is a multiply defined local
00100	/]
00110		PUSHJ	P,.TSTRG##
00120		PJRST	.FMSGE##
     
00010	;SUBROUTINE TO TYPE A RADIX 50 SYMBOL IN CASE WE NEED IT IN AN ERROR
00020	
00030	TRDX5:	CLRBFI			;PREPARE TO TYPE A ?
00040		PUSH	P,T1
00050		MOVEI	T1,[ASCIZ /
00060	? /]
00070		PUSHJ	P,.TSTRG##
00080		TLO	DL,DL.TR5	;FLAG OUTPUT TO TTY
00090		POP	P,T1
00100		PUSHJ	P,$LRAD		;LIST THE SYMBOL
00110		TLZ	DL,DL.TR5	;CLEAR THE FLAG
00120		POPJ	P,		;RETURN
     
00010	SUBTTL LISTS
00020	
00030	;LIST OF EXTENSIONS TO TRY IF NOT KNOWN
00040	
00050		DEFINE	DEFSYM(A)<
00060		XLIST
00070		IRP A,<SIXBIT	\A\>
00080		LIST>
00090	
00100	C.DEX:	DEFSYM	<DAE,SAV,SHR,HGH,LOW,XPN,DMP>
00110	C.LDEX==.-C.DEX
00120	
00130	S.DEX==C.DEX
00140	S.LDEX==C.LDEX
00150	
00160		DEFINE	TYPXMC(A)<
00170		XLIST
00180		ZZ==0
00190		IRP A,<
00200			IFL ZZ-T.EEND,<
00210			XWD	SIXBIT \   A\,T.'A
00220			>
00230		ZZ==ZZ+1
00240		>
00250		LIST>
00260	
00270	;CALLED BY TYPXM MACRO - DEFINE DEFAULT INPUT EXTENSIONS
00280	
00290	I.DEX:	TYPXM
00300	I.LDEX==.-I.DEX
00310	
00320		DEFINE	TYPXMC(A)<
00330		XLIST
00340		ZZ==0
00350		IRP A,<
00360			IFE ZZ&1,<
00370			DEFINE X(B)<
00380			XWD FND'A,FND'B
00390			>>
00400			IFN ZZ&1,<
00410			X A
00420			>
00430		ZZ==ZZ+1
00440		>
00450		LIST>
00460	
00470	TYPVEC:	TYPXM
     
00010		DEFINE	MODXMC(A)<
00020		XLIST
00030		ZZ==0
00040		IRP A,<
00050			IFE ZZ&1,<
00060			DEFINE X(B)<
00070			XWD MOD'A,MOD'B>>
00080	
00090			IFN ZZ&1,<
00100			X A>
00110		ZZ==ZZ+1>
00120		LIST>
00130	
00140	MODADR:	MODXM
00150	
00160		DEFINE	MODXMC(A)<
00170		XLIST
00180		IRP A,<
00190	
00200		IFE ^D36-YY*M.S,<
00210			EXP	ZZ
00220			ZZ==0
00230			YY==0
00240			>
00250	
00260		ZZ==<ZZ_M.S>+M.'A
00270		YY==YY+1
00280		>
00290		LIST>
00300	
00310	ZZ==0
00320	YY==0
00330	MODLAL:	MODXM
00340		MODXMC	(END)
00350	ZZ==<ZZ_<^D36-YY*M.S>>
00360		EXP	ZZ
     
00010	SUBTTL BYTE POINTERS
00020	
00030	;BYTE POINTERS
00040	
00050	J.Y:	POINT	J.S,@JUSTAB
00060	M.Y:	POINT	M.S,@MODTAB
00070	W.Y:	POINT	W.S,@WIDTAB
00080	TIT.Y:	POINT	TIT.S,@TITTAB
00090	BYT.Y:	POINT	36,@BYTTAB
00100	SUBT.Y:	POINT	SUBT.S,@SUBTAB
00110	
00120	VRBPTR:	IOWD	VERBL,VERBN
00130	PDL:	IOWD	PDLEN,PDLIST
00140	
00150		DEFINE	FORMMC(A)<
00160	ZZ==0
00170	IRP A,<
00180	ZZ==ZZ!<1_<A-1>>>>
00190	
00200		FORMMC	<11,12,13,14,15>
00210	
00220	FORMCH:	EXP	ZZ
00230	
00240	;LITERALS AND VARIABLES
00250	
00260		XLIST
00270	LIT::	LIT
00280		LIST
     
00010	SUBTTL	TABLE POINTERS
00020	
00030	DEFINE	TABLES<
00040		T	SYM,		;SYMBOL TABLE 
00050		T	JUS,		;JUSTIFY KEYS
00060		T	MOD,		;MODE KEYS
00070		T	WID,		;WIDTH KEYS
00080		T	TIT,		;TITLE LINE
00090		T	SUB,		;SUBTITLE
00100		T	OFF,		;OFFSET LIST
00110		T	SYP,		;POINTERS FROM START OF S.T. TO
00120					; A SPECIFIC PROGRAMS S.T.
00130		T	SYN,		;NAMES OF PROGRAMS IN S.T.
00140		T	SYV,		;LIST OF 1/2 WORD BYTES WHICH GIVE
00150					; INDEX FROM START OF S.T. TO NEXT
00160					; LARGER VALUE.
00170		T	OPR,		;OPERATOR STACK
00180		T	OPN,		;OPERAND STACK
00190		T	BYT,		;BYTE TABLE
00200	>
00210	
00220	DEFINE	T(A)<
00230		SIXBIT	/A'TAB/
00240	>
00250	TABNAM:	TABLES
     
00010		RELOC
00020	
00030	DEFINE	T(A)<
00040	A'TAB:	BLOCK	1
00050	A'NDX==.-TABVEC-1>
00060	
00070	ZER:!
00080	TABVEC:!TABLES
00090	LSTTAB==.-TABVEC-1
00100	
00110	DEFINE	T(A)	<
00120	A'LEN:	BLOCK	1>
00130	
00140	LENVEC:!TABLES
     
00010	SUBTTL	DATA AND STORAGE LOCATIONS
00020	
00030	;BLOCK TO GET FILE SPECS FROM SCAN
00040	
00050	F.ZER:	PHASE	0
00060	%DEV:!	BLOCK	1		;DEVICE NAME IN SIXBIT
00070	%NAM:!	BLOCK	1		;FILE NAME IN SIXBIT
00080	%NAMM:!	BLOCK	1		;MASK WITH A 1 FOR EACH NON WILD BIT
00090					; IN FILE NAME. NOT USED BY DUMP.
00100	%EXT:!	BLOCK	1		;EXTENSION IN LEFT HALF AND EXTENSION
00110					; MASK IN RH
00120	%MOD:!	BLOCK	1		;SWITCH WORD
00130	%MODM:!	BLOCK	1		;MASK FOR SWITCH WORD
00140	%DIR:!	BLOCK	2*LN.DRB	;PATH TO FILE. FIRST WORD IS PPN
00150					; THEN PPN MASK. FOLLOWD BY SFD/SFD MASK
00160					; PAIRS.
00170	F.LEN:!	;AMOUNT TO GET FROM SCANS F AREA
00180	FAREA:!
00190	%TYP:!	BLOCK	1		;TYPE OF FILE
00200	FAREAL==.-FAREA	;SIZE OF EXTERNAL F AREA
00210		DEPHASE
00220	
00230	;INPUT SPEC
00240	
00250	I.ZER:!
00260	I.DEV:	BLOCK	1
00270	I.NAM:	BLOCK	1
00280	I.NAMM:	BLOCK	1
00290	I.EXT:	BLOCK	1
00300	I.MOD:	BLOCK	1
00310	I.MODM:	BLOCK	1
00320	I.DIR:	BLOCK	2*LN.DRB
00330	I.TYP:	BLOCK	1
00340	
00350	;COMPARISON FILE
00360	
00370	C.ZER:!
00380	C.DEV:	BLOCK	1
00390	C.NAM:	BLOCK	1
00400	C.NAMM:	BLOCK	1
00410	C.EXT:	BLOCK	1
00420	C.MOD:	BLOCK	1
00430	C.MODM:	BLOCK	1
00440	C.DIR:	BLOCK	2*LN.DRB
00450	C.TYP:	BLOCK	1
     
00010	;OUTPUT FILE
00020	
00030	O.ZER:!
00040	O.DEV:	BLOCK	1
00050	O.NAM:	BLOCK	1
00060	O.NAMM:	BLOCK	1
00070	O.EXT:	BLOCK	1
00080	O.MOD:	BLOCK	1
00090	O.MODM:	BLOCK	1
00100	O.DIR:	BLOCK	2*LN.DRB
00110	O.TYP:	BLOCK	1	
00120	
00130	S.ZER:!
00140	S.DEV:	BLOCK	1
00150	S.NAM:	BLOCK	1
00160	S.NAMM:	BLOCK	1
00170	S.EXT:	BLOCK	1
00180	S.MOD:	BLOCK	1
00190	S.MODM:	BLOCK	1
00200	S.DIR:	BLOCK	2*LN.DRB
00210	S.TYP:	BLOCK	1
00220	
00230	
00240	
00250	PAREA:	BLOCK	FAREAL
     
00010	ADRTMP:	BLOCK	1	;ADDRESS OF WORD IN INPUT FILE
00020	B.OC:	BLOCK	3	;BUFFER HEADER FOR OUTPUT FILE
00030	
00040	;THE NEXT 2 WORDS MUST GO TOGETHER
00050	
00060	CATBLK:	BLOCK	1	;BEGINNING BLOCK OF CURRENT CATEGORY
00070	CATWRD:	BLOCK	1	;BEGINNING WORD OF CURRENT CATEGORY
00080	
00090	CATLEN:	BLOCK	1	;LENGTH OF CURRENT CATEGORY
00100	CATNUM:	BLOCK	1	;CURRENT CATEGORY NUMBER
00110	CURCHR:	BLOCK	1	;CURRENT CHARACTER NUMBER ON LINE
00120	CURIOW:	BLOCK	1	;CURRENT IOWD FOR COMPRESSED FILES
00130	DAECCT:	BLOCK	1	;CURRENT CATEGORY
00140	DAECBK:	BLOCK	1	;CURRENT BLOCK IN DAEMON FILE
00150	DAECWD:	BLOCK	1	;CURRENT WORD IN BLOCK IN DAEMON FILE
00160	DMHEAD:	BLOCK	1	;AOBJN POINTER FOR DUMP MODE INPUT
00170	HGHOFF:	BLOCK	1	;OFFSET FOR HIGH SEGMENT
00180	INCADR:	BLOCK	1	;INCREMENT ADDRESS FOR DUMP
00190	INCPOS:	BLOCK	1	;INCREMENT POSITION
00200	INCSIZ:	BLOCK	1	;INCREMENT SIZE
00210	INPLST:	BLOCK	2
00220	IRADIX:	BLOCK	1	;INPUT RADIX
00230	KEYPTR:	BLOCK	1	;POINTER TO LIST OF KEY WORDS FOR JUSTIFY OR MODES
00240	LINNUM:	BLOCK	1	;LINE NUMBER ON CURRENT PAGE
00250	LINPAG:	BLOCK	1	;LINES PER PAGE
00260	LMARGN:	BLOCK	1	;LEFT MARGIN
00270	LOWREL:	BLOCK	1	;LENGTH OF LOW SEGMENT FOR DAEMON CORE CATEGORY
00280	MAGWRD:	BLOCK	1	;MAGTAPE PARAMETERS
00290	OBUF:	BLOCK	203
00300	ORADIX:	BLOCK	1	;OUTPUT RADIX
00310	OUTVAL:	BLOCK	1	;VALUE TO BE OUTPUT
00320	PAGLIM:	BLOCK	1	;PAGE LIMIT FOR OUTPUT
00330	PAGNUM:	BLOCK	1	;CURRENT PAGE NUMBER IF COUNTING
00340	PDLIST:	BLOCK	PDLEN	;PUSH DOWN LIST
00350	POSTMP:	BLOCK	1	;POSITION WORD
00360	RMARGN:	BLOCK	1	;RIGHT MARGIN
00370	
00380	;THE FOLLOWING BLOCK MUST STAY TOGETHER
00390	
00400	SAVET1:	BLOCK	1
00410	SAVET2:	BLOCK	1
00420	SAVET3:	BLOCK	1
00430	SAVET4:	BLOCK	1
00440	SAVEP1:	BLOCK	1
00450	SAVEP2:	BLOCK	1
00460	SAVEF:	BLOCK	1
00470	SAVEM:	BLOCK	1
00480	
00490	;END BLOCK
     
00010	SAVADR:	BLOCK	1	;CURRENT ADDRESS FOR DUMP
00020	SAVPOS:	BLOCK	1	;CURRENT POSITION FOR DUMP
00030	SAVSIZ:	BLOCK	1	;CURRENT SIZE FOR DUMP
00040	SBLOCK:	BLOCK	1	;BLOCKS TO SKIP ON INPUT
00050	SFILES:	BLOCK	1	;FILES TO SKIP ON INPUT
00060	SIZTMP:	BLOCK	1	;SIZE WORD
00070	TEMPAD:	BLOCK	1
00080	TRMADR:	BLOCK	1	;TERMINATING ADDRESS FOR DUMP
00090	TRMPOS:	BLOCK	1	;TERMINATING SIZE FOR DUMP
00100	WINADR:	BLOCK	1	;ADDRESS OF FIRST WORD IN WINDOW
00110	WINLEN:	BLOCK	1
00120	WINLST:	BLOCK	2
00130	JOBDAT:	BLOCK	200	;BUFFER FOR FIRST PART OF CORE IMAGE
00140	;5 TEMPS USED TO FILL AND JUSTIFY OUTPUT (ROUTINE OUTPT:)
00150	PADCNT:	BLOCK	1
00160	SAVCCH:	BLOCK	1
00170	LPAD.Y:	BLOCK	1
00180	WIDTMP:	BLOCK	1
00190	JUSTMP:	BLOCK	1
00200	LPAD:	BLOCK	12	;LIST OF 9-BIT BYTES USED TO REMEMBER HOW
00210				; MANY BLANKS TO PREFIX A MESSAGE WITH SUCH
00220				; THAT THE RESULT IS CENTERED OR RIGHT
00230				; JUSTIFIED.
00240	S2VPTR:	BLOCK	1	;POINTER TO SYMBOL TABLE USED
00250				; WHEN GOING FROM SYMBOL TO VALUE
00260	SYMPTR:	BLOCK	1	;TEMP USED BY SYMBOL TABLE LOGIC
00270	LASBIN:	BLOCK	1	;THE LAST ARGUMENT TO OP DECODER
00280	LASTOP:	BLOCK	1	;THE SYMBOL FOR THAT OPCODE
00290	OLDVAL:	BLOCK	4	;LAST ARGUMERT TO SYMBOL ENCODER
00300	OLDSYM:	BLOCK	4	;THE ANSWER FOR THAT VALUE
00310	SYMOFF:	BLOCK	4	;THE OFFSET FOR THAT VALUE
00320	SAVE4.:	BLOCK	1	;VALUE OF 1
00330	SAVE4$:	BLOCK	1	;VALUE OF $
00340	SAVEXP:	BLOCK	1	;VALUE OF %
00350	PATH:	BLOCK	11	;SFD PATH
00360	
00370	EZER=.-1
00380	
00390	WINDOW:	BLOCK	WINSIZ
00400	
00410	
00420	PATCH:
00430	PAT:	BLOCK	20		;FOR USE WITH DDT
00440	FRECOR::
00450	DMPEND:	END	DUMP