PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/unscsp/dump/dump.mac

TITLE DUMP - PROGRAM TO DUMP ARBITRARY FILES IN PRINTABLE FORMAT
SUBTTL DON BLACK/DAL  - VERSION 4 - 12 AUGUST 1972
;COPYRIGHT (C) 1974,1978,1979 BY

;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

VWHO==0		;WHO LAST EDITED THIS PROGRAM
VDUMP==4	;VERSION OF DUMP
VPATCH==0	;PATCH LETTER
VEDIT==232	;EDIT NUMBER

	LOC	137
	BYTE	(3)VWHO(9)VDUMP(6)VPATCH(18)VEDIT
	XALL
	TWOSEG
	RELOC	400000

;AC'S

SF=0		;SCANER FLAGS
T1=1		;TEMP AC'S
T2=2		; ..
T3=3		; ..
T4=4		; ..
P1=5		;PRESERVED AC'S
P2=6		; ..
N=7		;HOLDS A NUMBER
C=10		;HOLD A CHARACTOR
M=11		;MESSAGE POINTER
F=12		;FLAGS
FM=13		;SCAN STORES MASKS IN HERE
DL=14		;ANOTHER WORD OF FLAGS (NONE SET BY COMMAND SCANER)
P=17		;PUSH DOWN POINTER

;I/O CHANNELS

IC==6		;INPUT FILE
OC==7		;OUTPUT CHANNEL

;EXTERNALS IN COMMAND SCANNER

	EXTERNAL	.FILIN,.GTSPC,.ISCAN,.MKPJN,.POPJ1,.SAVE2,.SAVE4
	EXTERNAL	.SIXSW,.TIALT,.TIAUC,.VSCAN,E.UKK
	EXTERNAL	.SWDPB,.NAME

	SEARCH C,SCNMAC
	SUBTTL	LOADING INSTRUCTIONS

REPEAT 0,<

IF YOU HAVE MACRO 47:

	.R PIP
	*T.MAC=TTY:
		%.C==-3
	^Z
	.LOAD T.MAC+<C.MAC,SCNMAC.MAC>,DUMP.MAC,SCAN.REL,HELPER.REL

IF YOU HAVE MACRO 50 (OR LATER):

	.LOAD C.UNV+SCNMAC.UNV+DUMP.MAC,SCAN.REL,HELPER.REL

>
	SUBTTL REVISION HISTORY

;EDITS 2 THRU 157 IN NO SPECIAL ORDER:
;
;A) AC'S WERE CHANGED AS FOLLOWS:
;	F WAS MOVED FROM 7 TO 12
;	V WAS ELIMINATED
;	N WAS MOVED FROM 14 TO 7
;	M WAS MOVED FROM 15 TO 11
;	C WAS MOVED FROM 16 TO 10
;	FM WAS ADDED AS 13
;	DL WAS ADDED AS 14
;
;B) ASCII AND SIXBIT OUTPUT MODES WERE REDEFINED AS FOLLOWS:
;	ASCII IS A SINGLE RIGHT JUSTIFIED CHARACTER IF
;		BITS 0 TO 28 ARE ALL ZERO. IT IS 5 LEFT JUSTIFIED
;		CHARACTERS IF BITS 0 TO 28 ARE NON-ZERO. CONTROL
;		CHARACTERS PRINT AS BLANKS.
;	SIXBIT IS A SINGLE RIGHT ADJUSTED CHARACTER IF BITS 0
;		TO 29 ARE ZERO. IF BITS 0 TO 29 ARE NOT ZERO
;		IT IS TREATED AS 6 SIXBIT CHARACTERS.
;
;C) THE TDUMP COMMAND HAS BEEN IMPLEMENTED TO DUMP TO BOTH TTY: AND
;	OUTPUT FILE.
;
;D) DEFINITION OF DOUBLE QUOTE HAS BEEN CORRECTED. IT WAS DEFINED AS
;	41 SHOULD BE 42.
;
;E) MACRO DEFINITIONS WERE MOVED FROM DUMP.MAC TO SCNMAC.MAC.
;
;F) THE FOLLOWING SINGLE LETTERS WERE MADE TO MATCH COMMANDS:
;	D IS UNIQUE FOR	DUMP
;	I		INPUT
;	M		MODE
;	O		OUTPUT
;	T		TDUMP
;
;G) TABLES AND CALLS WERE MODIFIED TO USE SCAN NOT SCANNER.
;
;H) A TABLE OF ABSENT DEFAULTS WAS BUILT FOR PRE-SETTING SWITCHES.
;
;I) THE FOLLOWING BUILT IN SYMBOLS HAVE BEEN CREATED:
;	.	THE ADDRESS OF THE LAST WORD TYPED OUT.
;	$	THE LAST BYTE TYPED OUT
;	%	THE LAST VALUE THE EXPRESSION EVALUATOR RETURNED.
;
;J) DUMP NOW LOOKS FOR CCL FILES IN TMPCOR PRIOR TO LOOKING ON DISK.
;
;K) SCAN IS USED INSTEAD OF SCANNER
;L) THE /TYPE SWITCH APPLIES TO EACH INPUT FILE SPECIFIED (INPUT
;	FILE AND SYMBOL FILE)
;
;M) NUMBERS WERE CHANGED TO SYMBOLIC DEFINITIONS. SOME SYMBOLS
;	ARE DEFINED IN C.MAC.
;
;N) THE TITLE COMMAND WAS MADE TO WORK
;
;O) POOR AND NON-WORKING CODE USED FOR STORING LISTS WAS CORRECTED.
;
;P) THE INPUT CHARACTER AC (C) HAS THE FOLLOWING POSSIBLE STATES:
;	-2	END OF FILE
;	-1	END OF LINE (LF-VT-FF)
;	0	ESCAPE
;	1-177	ASCII CHARACTER
;
;Q) A CASE WHERE DUMP WOULD LOOP FOREVER HAS BEEN CORRECTED. THIS WAS
;	CAUSED BY THE INDEX OVERFLOWING.
;
;R) WIDTH, JUSTIFY, AND MODE LISTS WERE IMPLEMENTED.
;
;S) SPECIAL PATTERNS IN STRINGS NOW WORK CORRECTLY.
;
;T) QUOTED STRINGS NOW WORK CORRECTLY. THE FOLLOWING FIXES WERE INVOLVED:
;	1) END OF LINE GETS YOU OUT OF QUOTED STRING MODE.
;	2) ; HAS NO EFFECT IN A QUOTED STRING
;	3) MULTIPLE SPACES AND TABS ARE PRESERVED
;
;U) " HAS BEEN ADDED AS AN OPERATOR MEANING TAKE THE LEFT HALF WORD
;	AND MOVE IT TO THE RIGHT HALF EXTENDING THE SIGN BIT.
;
;V) CPOPJ HAS BEEN CHANGED TO .POPJ AND CPOPJ1 HAS BEEN CHANGED TO
;	.POPJ1. BOTH ROUTINES HAVE BEEN MOVED TO SCAN.
;
;W) THE NUMERIC INPUT ROUTINE HAS BEEN FIXED TO WORK FOR NUMBER WHICH
;	FILL ALL 36 BITS. PRIOR TO THIS FIX 777777777777(8) WAS
;	CHANGED TO 377777777777(8) DURING OCTAL INPUT
;
;X) THE INPUT ROUTINES WERE CONVERTED TO READ A SYMBOL FILE.
;
;Y) FULL SUB-FILE DIRECTORY SUPPORT HAS BEEN ADDED.
;
;Z) JOBDAT SYMBOLS HAVE BEEN CHANGED FROM JOBXXX TO .JBXXX
;AA) THE FILE READING ROUTINES READ THE FIRST BLOCK OF
;	THE FILE. PRIOR TO THIS FIX IF THE FIRST WORD OF THE FILE
;	WAS REQUESTED THE READ-IN ROUTINES WOULD THINK THE BLOCK
;	WAS IN CORE AND RETURN ZERO.
;
;BB) THE OUTPUT FORMATTER HAS BEEN REWRITTEN TO FIX SEVERAL BUGS. IN ADDITION
;	THE FOLLOWING EXTERNAL CHANGES HAVE BEEN MADE:
;	1	"WORD NOT IN FILE" PRINTS INSTEAD OF "\\\\".
;	2.	NEGATIVE ADDRESSES LIST AS SUCH.
;	3	AFTER ATTEMPTING TO PRINT NXM A REFERANCE
;		TO AN EXISTANT LOCATION MUST BE MADE TO TURN PRINTING
;		BACK ON.
;	4	RADIX 50 IS NOW A SUPPORTED MODE
;	5	OCTAL NOW PRINTS IN FIXED FORMAT OF XXXXXX,XXXXXX
;	6	A LINE IS NEVER SPLIT BETWEEN THE MINUS SIGN AND
;		THE NUMBER.
;	7	LOCATIONS MAY BE PRINTED OUT AS SYMBOLIC INSTRUCTIONS.
;
;CC) NEGATIVE NUMBERS PRINT OUT AS -NUMBER AND NOT A SEQUENCE OF SPECIAL
;	CHARACTERS.
;
;DD) ADDRESS ARE NOW FOLLOWED BY /<TAB> NOT /<SPACE>
;
;EE) THE SYFILE COMMAND SPECIFIES A FILE FOR A SYMBOL TABLE.
;
;FF) THE XTRACT COMMAND READS THE SYMBOL FILE LOOKING FOR DDT'S
;	SYMBOL TABLE POINTER AND EXTRACTING THE SYMBOL TABLE.
;
;GG) SYMBOLS ARE NOW ACCEPTED ON TYPE-IN. IF THE SYMBOL IS
;	MULTIPLY DEFINED IT MUST BE PRECEDED BY A PROGRAM NAME.
;	E.G. DUMP:EXPSYM
;
;HH) SYMBOLS ARE AVAILABLE FOR TYPE OUT IN SYMBOLIC INSTRUCTIONS.
;
;II) A PERMUTATION VECTOR IS COMPUTED FOR THE SYMBOL TABLE. THIS ALLOWS
;	A BINARY SEARCH OF THE SYMBOL TABLE  WHEN LOOKING FOR A SYMBOL
;	MATCHING A VALUE.
;
;EDITS NOT SPECIFICALY LISTED ARE PART OF THE EDIT NUMBER PRIOR TO
;	THEM. E.G. EDIT CLOSED OUT IN MIDDLE TO RELOAD THE MONITOR
;	USES 2 EDIT NUMBERS. THE EDIT NUMBER IS INCREMENTED EVERY
;	TIME THE FILE IS EDITED.

;EDITS AFTER 157:

;160) ADD REVISION HISTORY

;161) FIX LCHR TO HANDLE <TAB> CORRECTLY. PRIOR TO THIS EDIT IT
;	CONSIDERED <TAB> A SINGLE PRINT POSITION.

;162) MAKE 20 THRU 24 ILLEGAL IN A LISTING FILE. ONLY END OF LINE
;	NOW VALID ARE FORM FEED, LINE FEED AND VERTICAL TAB.

;163) MAKE FNDADR RETURN NXM IF ADDRESS IS NEGATIVE

;164) REMOVE JUNK AFTER THE NOT IN FILE MESSAGE

;165) SCAN SYMBOL TABLE FOR OPCODES AFTER TRYING BUILT
;	IN TABLE

;166) RELOAD T1 AFTER CALL TO VAL2SY IF WE WANT NUMERIC OUTPUT.

;167) DO NOT OUTPUT NULLS

;170) REMOVE LOC/ FROM BLANK LINES.

;171)	CLEAN UP LISTING

;172) IMPROVE FNDDAE TO:
;	1. RETURN NXM IF ADDRESS IS .GT. 777777
;	2. RETURN NXM IF ADDRESS IS BETWEEN LOW AND HIGH SEGS
;	3. REMEMBER FIRST 200 WORDS OF CORE IMAGE

;173) MORE OF 172

;174) ADD CODE TO MAKE LOOKING FOR A DAEMON CATEGORY INDEPENDENT
;	OF THE ORDER IN WHICH THE CATEGORIES ARE WRITTEN

;200) CLEANUP NXM MESSAGE, FIX BAD LOGIC, RANDOM FIXES
;	TO THE LISTING.


;203) AC'S DO NOT CONTAIN THE RIGHT VALUES. BUFFER IS REMEMBERED FROM
;	SYMBOL FILE WHICH IS NOT RIGHT. FIX: DO NOT LOAD BUFFER DURING
;	XTRACT COMMAND.

;204) ILL MEM REF AT CMPRED CAUSED BY CALLING CMPRED WRONG. FIX:
;	CALL CORRECTLY AND FIX THE COMMENTS ON CMPRED.
;205) PART OF LISTING MISSING. ADD A LIST PSEUDO-OP

;206) THE PRESENT DEFAULTS HAVE BEEN CHANGED FOR SEVERAL
;	COMMANDS. THE NEW PRESENT DEFAULTS ARE:
;	ADDRESS		ON
;	AUTOFORMAT	ON
;	NUMPAGE		1
;	NOTE: A PRESENT DEFAULT IS THE DEFAULT WHEN
;	      THE SWITCH IS GIVEN WITHOUT AN ARGUMENT.

;207) INPUT, OUTPUT, SYFILE ETC. WITHOUT AN ARGUMENT
;	ARE NOW IGNORED. PRIO TO THIS EDIT THEY
;	CAUSED A HALT.

;210) THE CLOSE COMMAND NOW CLEARS THE FILE OPEN BIT. IT
;	ALSO FORCES APPEND MODE.

;211) THE ALL COMMAND CAN NOW BE TERMINATED BY AN <ESC>

;212) FIX .HGH AND .SHR FILES TO DUMP CORRECTLY. THIS INVOLVES
;	STARTING THE /ALL SWITCH AT THE RIGHT PLACE AND MAKING
;	ALL ADDRESSES BELOW THE HISEG NXM.

;214) " OPERATOR GIVEN MORE PRECEDENCE. ALSO HRL CHANGED
;	TO HLR AS INTENDED.

;215) DATRED NOW LOOKS FOR ERRORS

;216) SOMETIMES THE NUMBERS DO NOT LINE UP. CRLF GETS OUTPUT
;	IN PAD FIELD. CURE: SEE IF CRLF NEEDED AND
;	PUT OUT FIRST IF IT IS REQUIRED AT ALL.

;217) IF AN INPUT COMMAND IS GIVEN PRIOR TO A SYFILE
;	COMMAND THE INPUT FILE NAME IS USED AS THE
;	DEFAULT FOR XTRACT.

;220) 1B0 DOES NOT GET OUTPUT CORRECTLY. FIX: MAKE RADIX
;	PRINTER ADD ONE SO MOVM WILL RETURN
;	A POSITIVE NUMBER.

;221) TITLES DO NOT WORK QUITE RIGHT. FIX: MAKE THE
;	SPECIAL PATTERN <FF> CALL NEWPAG.

;222) CALL OSCAN TO READ USER SPECIFIC DEFAULTS. THIS IS A FILE
; 	IN THE USERS AREA CALLED SWITCH.INI WHICH CONTAINS A LIST
;	OF SWITCHES ON A LINE BEGINING WITH DUMP:

;223)	IGNORE SPACES NEXT TO &

;224) IF A LINE ENDS IN THE MIDDLE OF A QUOTED STRING ^? SOMETIMES
;	GETS PRINTED. FIX: TEST FOR END OF LINE MORE OFTEN. 
;	***NOTE: A WELL FORMED STRING MUST END WITH A QUOTE.

;225) CALLI'S DO NOT PRINT CORRECTLY. FIX: ADD DEVSTS TO TABLE.

;226) IF AN I/O ERROR TOOK PLACE ON A CLOSE COMMAND USER GOT THE WRONG
;	ERROR MESSAGE. FIX: TEST RIGHT HALF OF STATUS

;227) ANY FILE WHICH IS LESS THAN 8 BLOCKS LONG AND IS NOT IN COMPRESSED
;	FORMAT LOOKED ZERO WHEN THE FIRST WORD WAS EXAMINED. FIX: LOAD
;	T1 WITH WORD FROM BUFFER PRIOR TO LOOKING FOR ERRORS. IF AN 
;	ERROR TOOK PLACE IT WILL NOT CAUSE WRONG TYPEOUT.

;230) THE XTRACT COMMAND DID NOT WORK CORRECTLY WITH MORE THAN 1 INPUT
;	FILE. FIX: ADD CURRENT SIZE OF SYMBOL TABLE WHEN ASKING FOR
;	CORE.

;231) LEFTMARGIN WORKS ON TTY: NOT ON LPT:. DIAGNOSIS: LINE FEED COMES
;	OUT AFTER SPACES. FIX: PUT OUT LINE FEED FIRST.

;232) CHANGE MODE TO MODES IN COMMAND TABLE. REMOVE LISTAB.

;REV::

	SUBTTL	PARAMETERS AND DEFAULTS


;BIT POSITIONS FOR FLAGS WHICH MUST BE IN BYTE PTRS

FP.ADDR==0		;BIT 0 IF ADDRESSES TO BE INCLUDED IN OUTPUT
FP.APP==1		;BIT 1 IF TO APPEND TO OUTPUT
FP.AUTO==2		;BIT 2 IF AUTOFORMATTING ON
FP.INST==3		;BIT 3 IF INSTRUCTION MODE SELECTED
FP.PROG==4		;BIT 4 IF PROGSYM ON
FP.SUBT==5		;BIT 5 IF SUBTITLES REQUESTED

;FLAGS LH F

L.ADDR==(1B<FP.ADDR>)	;SET IF ADDRESSES TO BE OUTPUT
L.APP==(1B<FP.APP>)	;SET IF APPEND TO OUTPUT FILE, CLEAR IF SUPERSEDE
L.AUTO==(1B<FP.AUTO>)	;SET IF AUTOFORMATTING ON
L.INST==(1B<FP.INST>)	;SET IF INSTRUCTION MODE SELECTED
L.PROG==(1B<FP.PROG>)	;SET IF PROGSYM ON
L.SUBT==(1B<FP.SUBT>)	;SET IF SUBTITLES REQUESTED
L.TITL==(1B6)		;SET IF TITLE SPECIFIED
L.IOPN==(1B7)		;SET IF INPUT FILE OPEN
L.OOPN==(1B10)		;SET IF OUTPUT FILE OPEN
L.IEOF==(1B8)		;SET IF EOF ON INPUT FILE
;L.NAS==(1B9)		;SET IF OUTPUT NOT ASCII ONLY OR SIXBIT ONLY
;L.ASCO==(1B11)		;SET IF OUTPUT IS ASCII
;L.SIXO==(1B12)		;SET IF OUTPUT IS SIXBIT
L.SYM==(1B13)		;SET IF AN OUTPUT MODE REQUIRES SYMBOL LOOKUP
L.NXM==(1B14)		;SET IF TRIED TO FIND NON-EXISTENT LOCATION IN INPUT FILE
L.ALLD==(1B15)		;SET IF DUMPING ALL OF INPUT FILE
L.OTTY==(1B16)		;SET IF OUTPUT DEVICE IS A TTY
L.TDMP==(1B17)		;SET IF OUTPUT TO TTY AND OUTPUT DEVICE
;FLAGS RH F

R.CON1==1B18		;SET IF DUMPING CONTENTS, NOT JUST ADDR
R.ANY==1B19		;SET IF ANYTHING FOUND IN EXPEVA
R.CMAL==1B20		;SET IF COMMA LEGAL (LEFT ANGLE BRACKET SEEN)
R.CONB==1B21		;SET IF BYTE DESCRIPTOR WAS CONTENTS, NOT JUST ADDR
R.RPN==1B22		;SET IN EXPRESSION EVALUATOR FOR RIGHT PAREN, ETC.
R.CNT==1B23		;SET IF ONLY COUNTING CHARS, NOT OUTPUTTING
R.SCNT==1B24		;SAVE COUNT BIT IN FORMAT SUBROUTINE
R.OVR==R.CONB		;SET IF OUTPUT LINE OVERFLOWS RIGHT MARGIN
R.LFD==R.CMAL		;SET IF LEADING LF LISTED IN OUTPUT SUBROUTINE
R.FFD==R.RPN		;SET IF LEADING FF LISTED IN OUTPUT SUBROUTINE
R.LKF==R.OVR		;USED IN OPEN OUTPUT ROUTINE
R.LTAB==1B25		;USED IN LISTING TABS
R.NORE==1B26		;SET IN FORMAT ROUTINE TO PREVENT RECURSION
R.PHED==1B27		;SET IF TO OUTPUT PAGE HEADER BEFORE NEXT CHAR
R.LHED==1B28		;SET IF TO OUTPUT LINE HEADER BEFORE NEXT CHAR
R.MARS==1B29		;SET IF TO OUTPUT SPACES FOR LEFT MARGIN
R.RLH==1B30		;REMEMBERS R.HED IN PAGE HEADER SUBROUTINE

;FLAGS IN LH OF DL

DL.JUS==(1B1)		;SET IF END OF JUSTIFY LIST NOT YET SEEN
DL.WID==(1B2)		;SET IF END OF WIDTH LIST NOT YET SEEN
DL.SYM==(1B3)		;SET IF READING SYMBOL FILE NOT SAVE FILE
DL.FBR==(1B4)		;SET IF WE NEED TO SORT SYMBOL TABLE
DL.PNF==(1B5)		;USED TO SCAN SYMBOL TABLE WHEN GOING
DL.MDL==(1B6)		; FROM SYMBOLIC TO BINARY
DL.SNF==(1B7)		;FLAG SET WHEN DOING BINARY SCAN AND SYMBOL
			; IS NOT FOUND (USED TO PREVENT LOOP)
DL.NBR==(1B8)		;FLAG SET IF LAST CALL TO VALUE SYMBOL CONVERTER
			; (VAL2SY) GAVE ERROR RETURN.
DL.NXM==(1B9)		;<NXM> OUTPUT
DL.TR5==(1B10)		;SET TO 1 WHEN SCANING SYMBOL TABLE AND AN
			; UNDEFINED SYMBOL IS SEEN. IT CAUSES RADIX50
			; GENERATOR TO OUTPUT TO TTY:.
DL.XCT==(1B11)		;SET TO 1 IF ONLY AN EXACT MATCH WILL DO
			; WHEN TYPING OUT SYMBOLS
DL.ANXM==(1B12)		;SET IF USER DID A CORE ZERO, DCORE.
DL.SYF==(1B13)		;SET BY SYFILE
;MISC

	ND	PDLEN,200
	ND	LN.DRB,6
	ND	WINSIZ,2000
	ND	FBMTIM,5
	ND	EC.FBM,3
	ND	POSSHF,^D30

PHLINS==4	;NUMBER OF LINES OUTPUT IN PAGE HEADER
	ND	MINLPG,PHLINS	;MINIMUM NUMBER OF LINES PER PAGE
IFL MINLPG-PHLINS-1,<MINLPG==PHLINS+1 ;MUST NOT BE LESS THAN LINES IN PAGE HEADER+1>

;DAEMON CATEGORIES

CA.JOB==1	;JOB INFORMATION
CA.CNF==2	;CONFIGURATION TABLE
CA.DDB==3	;DDB'S
CA.COR==4	;USER'S CORE

	ND	CA.MAX,4

;DEVCHR BITS

DV.TTY==(1B5)		;TTY
DV.DIR==(1B15)		;DIRECTORY DEVICE


;FLAGS IN RADIX50 SYMBOLS

ST.SPD==(1B0)	;IF 1 DO NOT TYPE OUT THIS SYMBOL
ST.SPI==(1B1)	;IF 1 DO NOT MATCH ON INPUT
ST.LCL==(1B2)	;IF 1 THIS IS A LOCAL
ST.GLB==(1B3)	;IF 1 THIS IS A GLOBAL
ST.PGM==(17B3)	;IF ALL 4 BITS ARE ZERO THIS IS A PROGRAM NAME
ST.SIN==(5B3)	;GLOBAL WICH DOES NOT TYPE OUT
ST.KIL==(14B3)	;TYPE $$K TO DDT ON THIS SYMBOL
;ASCII CHARS

C.LF==12	;LINE FEED
C.VT==13	;VERTICAL TAB
C.FF==14	;FORM FEED
C.CR==15	;CARRIAGE RETURN
C.ALT==33	;ALTMODE
C.DQ==42	;DOUBLE QUOTE
;DEFAULTS FOR VERB TABLES

DM	ADR,ONOFOF,ONOFON,ONOFON
DM	CAT,CA.MAX,CA.COR,CA.COR
DM	INS,1,1,1
DM	IRX,^D10,^D10,^D10
DM	LMG,0,0,0
DM	LNP,0,^D50,^D50
DM	NPG,10000,0,1
DM	ORX,^D10,^D8,^D8
DM	PGL,0,^D50,^D50
DM	RMG,0,^D60,^D60

ND	AD.TYP,T.DATA

;JUSTIFY KEYS

J.LFT==0	;LEFT JUSTIFY
J.CEN==1	;CENTER JUSTIFY
J.RHT==2	;RIGHT JUSTIFY

J.END==<1_J.S>-1	;END OF LIST MARKER

J.S==2		;NUMBER OF BITS IN JUSTIFY FIELDS
;MODES KEYS

	DEFINE	MODXM<
	MODXMC <NULL,ASCII,SIXBIT,RADIX5,OCTAL,SOCTAL,DECIMA,FLOAT,SYMBOL,SMART,NUMERI,ALL>
>

	DEFINE	MODXMC(A)<
	ZZ==-1
	IRP A,<
	M.'A==<ZZ==ZZ+1>
>>
	MODXM

M.END==<1_M.S>-1	;END OF LIST MARKER

M.S==4		;NUMBER OF BITS IN MODES FIELD
;SUBTITLE KEYS

SUBT.S==7		;STANDARD ASCII CHARACTER SIZE

SUBT.E==0		;END OF SUBTITLE CHARACTER



;TITLE KEYS

TIT.S==7		;STANDARD ASCII CHARACTER SIZE

TIT.EN==0		;END OF TITLE CHARACTER
;TYPE KEYS FOR FILE TYPE

	DEFINE	TYPXM<
	TYPXMC <TMP,DAE,SHR,SAV,HGH,LOW,XPN,DMP,SDSK,DDIR,DECT,DATA>
>

	DEFINE	TYPXMC(A)<
	ZZ==0
	IRP A,<T.'A==<ZZ==ZZ+1>>>

;DEFINE TYPES

	TYPXM

T.EEND==T.DMP	;END OF EXTENSIONS WHICH ARE ALSO TYPES
;WIDTH KEYS

W.END==<1_W.S>-1	;END OF LIST MARKER

W.S==9		;NUMBER OF BITS IN WIDTH FIELDS
	DEFINE VERBSW<

SP	ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
SP	*ALL,,ALLDMP
SS	APPEND,<POINT 1,F,FP.APP>,1
SP	AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
SP	BEGIN,,BEGIN
SP	CATEGORY,CATNUM,CATRED,CAT
SP	CLOSE,,CLSFIL
SP	COFILE,C.ZER,CGTFIL
SP	COMPARE,,CMPDMP
SP	DELSYM,,DELSYM
SP	DO,,DOPROC
SP	*DUMP,,DMPBYT
SP	EJECT,,EJECT
SP	END,,ENDPRC
SP	EXIT,,XIT
SP	IF,,IFPROC
SP	INDEX,,E.NIMP
SP	*INPUT,I.ZER,IGTFIL
SP	IOFFSET,,IOFPRC
SP	INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
SP	IRADIX,IRADIX,.SWDEC##,IRX
SP	JUSTIFY,,JUSPRC
SP	LEFTMARGIN,LMARGN,EXPSTO,LMG
SP	LINEPAGE,LINPAG,LINPGS,LNP
;SP	LISTAB,,LISPRC
SP	*MODES,,MODPRC
SP	NUMPAGE,PAGNUM,EXPSTO,NPG
SP	OOFFSET,,OOFPRC
SP	ORADIX,ORADIX,.SWDEC##,ORX
SP	*OUTPUT,O.ZER,OGTFIL
SP	PAGELIMIT,PAGLIM,EXPSTO,PGL
SP	POP,,POPPRC
SL	PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
SP	PUSH,,PUSHPR
SP	RIGHTMARGIN,RMARGN,EXPSTO,RMG
SP	SKPBLOCKS,SBLOCK,EXPSTO
SP	SKPFILES,SFILES,EXPSTO
SP	SORT,,E.NIMP
SS	SUBTITLE,<POINT 1,F,FP.SUBT>,1
SS	SUPERSEDE,<POINT 1,F,FP.APP>,0
SP	SYMBOL,,SYMPRC
SP	SYFILE,S.ZER,SGTFIL
SP	TABSYM,,TSYMPR
SP	TCOMPARE,,TCMDMP
SP	*TDUMP,,TDMBYT
SP	TSORT,,E.NIMP
SP	TITLE,,TITPRC
SL	TYPE,F.ZER+%TYP,TYPE
SP	WIDTH,,WIDPRC
SP	XTRACT,,XPROC
>	;END SWTCHS MACRO

DEFINE	SWTCHS,<VERBSW>
	DOSCAN(VERB)
	RELOC
IBUF:	BLOCK	200	;INPUT BUFFER (MUST BE HERE SO WE CAN PHASE CODE
			; INTO IT)
	RELOC
;TABLE OF SWITCHES WHICH ARE LEGAL IN SWITCH.INI 
; THIS SWITCHES MAY BE PLACED IN A FILE ON THE USERS AREA WHICH
; WILL SET HIS USERS SPECIFIC DEFAULTS.
	DEFINE SWTCHS<

SP	ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
SS	APPEND,<POINT 1,F,FP.APP>,1
SP	AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
SP	CATEGORY,CATNUM,CATRED,CAT
SP	INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
SP	IRADIX,IRADIX,.SWDEC##,IRX
SP	JUSTIFY,,JUSPRC
SP	LEFTMARGIN,LMARGN,.SWDEC##,LMG
SP	LINEPAGE,LINPAG,LINPGS,LNP
SP	*MODES,,MODPRC
SP	NUMPAGE,PAGNUM,.SWDEC##,NPG
SP	ORADIX,ORADIX,.SWDEC##,ORX
SP	PAGELIMIT,PAGLIM,.SWDEC##,PGL
SL	PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
SP	RIGHTMARGIN,RMARGN,.SWDEC##,RMG
SS	SUPERSEDE,<POINT 1,F,FP.APP>,0
SL	TYPE,F.ZER+%TYP,TYPE
SP	WIDTH,,WIDPRC
>	;END SWTCHS MACRO


	XALL
	DOSCAN	(OPTN)
	XALL

;SPECIAL TABLE OF ABSENT DEFAULTS

	DEFINE	SL(A,B,C,D)<
	EXP	D	;DEFAULT FOR /'A
	>

	DEFINE	SP(A,B,C,D)<
	EXP	AD.'D	;DEFAULT FOR /'A
	>

	DEFINE	SS(A,B,C)<
	EXP	0	;DEFAULT FOR /'A
	>

	AD.==0
	XALL

ABSTAB:	VERBSW
	DEFINE	SL(NAME,RESULT,TABLE,DEFAULT),<
	X NAME,TABLE'.T-1,<RESULT>,DEFAULT,-TABLE'.L
>

	DEFINE SP(NAME,RESULT,PROCESSOR,ABBR),<
	X NAME,PROCESSOR,<RESULT>,PD.'ABBR,MX.'ABBR
>

	DEFINE SS(NAME,RESULT,VALUE),<
	X NAME,0,<RESULT>,VALUE,0
>
;AND FINALLY, THE KEY-WORD VALUES

KEYS	ONOF,<ON,OFF>
KEYS	CATM,<JOB,CONFIG,DDB,CORE>
KEYS	DENS,<0,2,5,8>
KEYS	JUST,<LEFT,CENTER,RIGHT>
KEYS	PARI,<,ODD,EVEN>
	DEFINE	TYPXMC(A)<
	XLIST
	IRP A,<SIXBIT \A\>
	LIST>

TYPE.T:	TYPXM
TYPE.L==.-TYPE.T

	DEFINE	MODXMC(A)<
	XLIST
	IRP A,<SIXBIT \A\>
	LIST>

MODE.T:	MODXM
MODE.L==.-MODE.T


SUBTTL	BUILT-IN SYMBOLS

;THIS IS A TABLE OF SPECIAL BUILT IN SYMBOLS. THE USERS SYMBOL TABLE
; IS SEARCHED FOR THE SYMBOL AND IF IT IS NOT FOUND THE BUILT-IN TABLE
; IS TRIED. THE S MACRO HAS 2 ARGUMENTS: THE FIRST IS THE SYMBOL AND
; THE SECOND IS THE LOCATION WITHIN DUMP CONTAINING THE VALUE OF THAT
; SYMBOL.

	DEFINE MSYM,<
	S	<.>,SAVE4.	;THE ADDRESS OF THE LAST WORD TYPED OUT
				; THIS IS THE LOCATION COUNTER.
	S	<$>,SAVE4$	;THE LAST BYTE TYPED OUT.
	S	<%>,SAVEXP	;THE LAST THE THE EXPERSSION EVALUATOR
				; RETURNED. THIS IS A SORT OF . IMMEDIATE
				; SO D UUOCON:UCLJMP&%+100 IS THE SAME AS
				; D UUOCON:UCLJMP&UUOCON:UCLJMP+100
>

	XALL
	DEFINE	S(A,B),<
	RADIX50	0,A		;A IN RADIX50
>

MSYMTB:	MSYM			;BUILT-IN SYMBOL TABLE
L.MSYM==.-MSYMTB

	DEFINE	S(A,B)<
	EXP	B		;POINTER TO VALUE OF A
>
MSYMAD:	MSYM
SUBTTL	ROUTINE TO HANDLE EXPRESSION VALUED SWITCHES
;SUBROUTINE TO GET AN EXPRESSION AND STORE
;ARGS	P1=INDEX IN VERB TABLE

EXPSTO:	HRRZ	T1,VERBD(P1)	;PICK UP DEFAULT
	SKIPE	T2,VERBP(P1)	;PICK UP STORAGE LOCATION
	DPB	T1,T2		;STOR DEFAULT IF WE KNOW WHERE
	PUSHJ	P,EXPEVA	;EVALUATE THE EXPRESSION
	HLRZ	T2,VERBM(P1)	;GET MAX LEGAL VALUE
	JUMPE	T2,EXPST1	;JUMP IF NO MAX
	CAMLE	T1,T2		;SKIP IF VALUE SPECIFIED .LE. MAX
	JRST	E.MAX		;NO. ERROR.
EXPST1:	SKIPN	T2,VERBP(P1)	;GET THE POINTER
	POPJ	P,		;NONE.
	MOVE	N,T1		;N=VALUE TO BE STORED
	MOVEI	P2,[0
		    VERBP(P1)]
	PJRST	.SWDPB##	;STORE THE VALUE
SUBTTL INITIALIZE

					;REPEAT FOR EACH SUPPORTED
					; ENTRY POINT.
DUMP:	REPEAT	2,<JSP	T3,DUMPGO>	;T3 _ ADDRESS OF ENTRY
DUMPGO:	SUBI	T3,DUMP+1	;CONVERT TO OFFSET
	HRRZM	T3,SAOFST#	;STORE FOR SCAN TO LOOK AT
	RESET
	MOVE	P,PDL		;SET UP PUSH DOWN LIST POINTER

;HERE TO CLEAR CORE

	SETZB	F,ZER		;CLEAR FLAGS AND FIRST LOC OF CORE
	MOVE	T1,[XWD ZER,ZER+1]
	BLT	T1,EZER

;HERE TO INIT SCANNER

	MOVE	1,[3,,[0
		   SAOFST,,'DMP'
		    0]]
	PUSHJ	P,.ISCAN	;CALL SCAN


;HERE TO SCAN SWITCH.INI FOR USER SPECIFIC DEFAULTS

	SETZM	FM		;CLEAR THE MASK WORD
	MOVSI	P1,-OPTNL	;LENGTH OF OPTION TABLE
OPTSET:	HLRZ	T1,OPTNP(P1)	;GET THE POINTER TYPE
	CAIN	T1,004400	;FULL WORD VALUE?
	SETOM	@OPTNP(P1)	;YES-- -1 IS FLAG FOR UNKNOWN
	AOBJN	P1,OPTSET	;LOOP OVER THAT TABLE
	MOVE	1,[4,,[IOWD OPTNL,OPTNN
		        XWD OPTND,OPTNM
			XWD 0,OPTNP
			EXP -1]]
	PUSHJ	P,.OSCAN##	;SCAN THE FILE
;HERE TO STORE ABSENT DEFAULTS

	MOVSI	P1,-VERBL	;MINUS LENGTH OF VERB TABLES
ABDEFS:	SKIPN	T1,VERBP(P1)	;GET THE POINTER
	JRST	ABDEF1		;IF NONE SKIP SWITCH
	MOVE	T3,@T1		;GET THE WORD WITH THE BYTE
	HLRZ	T2,T1		;GET THE SIZE PART
	CAIN	T2,004400	;IS IT A FULL WORD
	JRST	[AOJN T3,ABDEF1	;YES--JUMP IF KNOWN ALREADY
		 JRST ABDEF2]	; ELSE FILL IN DEFAULT
	AOS	T1		;BYTES HAVE A MASK WORD
	LDB	T1,T1		;GET THE MASK
	JUMPN	T1,ABDEF1	;SKIP IF FILLED IN
ABDEF2:	MOVE	T1,ABSTAB(P1)	;ABSENT DEFAULT
	PUSHJ	P,EXPST1	;STORE DEFAULT
ABDEF1:	AOBJN	P1,ABDEFS
;HERE TO SET UP TABLES

	MOVSI	T2,-LSTTAB-1
	MOVE	T1,.JBFF	;FIRST AVAILABLE LOCATION
	MOVEM	T1,TABVEC(T2)	;STORE AS ORIGIN OF EACH TABLE
	AOBJN	T2,.-1

;HERE TO SET UP IOWD'S

	MOVE	T1,[IOWD 200,IBUF]
	MOVEM	T1,INPLST
	MOVE	T1,[IOWD WINSIZ,WINDOW]
	MOVEM	T1,WINLST

;HERE TO SET UP DEFAULTS

OTDEFS:	TLO	F,L.ADDR+L.APP+L.AUTO+L.INST+L.PROG
	MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
	PUSHJ	P,MKPNTR
	MOVEI	P2,MODNDX	
	MOVEI	T1,M.OCTA	;OCTAL
	PUSHJ	P,STOBYT
	MOVEI	T1,M.END	;END OF LIST
	PUSHJ	P,STOBYT
	MOVE	P1,J.Y		;BYTE POINTER FOR JUSTIFY LIST
	PUSHJ	P,MKPNTR
	MOVEI	P2,JUSNDX	
	MOVEI	T1,J.END	;START WITH NULL LIST
	PUSHJ	P,STOBYT

	MOVE	P1,W.Y		;BYTE POINTER FOR WIDTH LIST
	PUSHJ	P,MKPNTR
	MOVEI	P2,WIDNDX	
	MOVEI	T1,W.END
	PUSHJ	P,STOBYT

	MOVSI	T1,(SIXBIT .LPT.) ;DEFAULT OUTPUT DEVICE
	MOVEM	T1,O.DEV
	MOVSI	T1,(SIXBIT .DSK.)
	MOVEM	T1,I.DEV	;INPUT DEFAULT IS DSK
	MOVEM	T1,S.DEV
	MOVEM	T1,C.DEV
	PJOB	T1,		;GET JOB NUMBER
	PUSHJ	P,.MKPJN	;CONVERT TO SIXBIT IN LH
	MOVS	T4,T1		;GET JOB NUMBER
	HRRI	T4,(SIXBIT .DAE.)
	MOVEM	T4,O.NAM	;DEFAULT OUTPUT NAME
	MOVEM	T4,I.NAM	;DEFAULT INPUT NAME
	MOVEM	T4,S.NAM	;DEFAULT SYMBOL NAME
	MOVEM	T4,C.NAM	;DEFAULT COMPARISON FILE NAME
	MOVSI	T1,(SIXBIT .LSD.)
	MOVEM	T1,O.EXT	;DEFAULT OUTPUT EXTENSION
SUBTTL MAIN LOOP

;HERE FOR MAIN LOOP - CALL COMMAND SCANNER

	MOVE	1,[6,,[IOWD VERBL,VERBN
			XWD VERBD,VERBM
			XWD 0,VERBP
			EXP -1
			XWD FAREAL,FAREA
			XWD 0,PAREA]]
	MOVEI	DL,I.ZER
	PUSHJ	P,.VSCAN
	JRST	XIT
SUBTTL VERB PROCESSORS
;SUBROUTINE TO READ FILE SPECIFIER AND STORE IN APPROPRIATE BLOCK

IGTFIL:	TLZ	F,L.IOPN!L.IEOF	;NOTE INPUT NOT OPEN
	SETZM	I.DEV+%TYP	;ALLOW NEW TYP SPECIFICATION
	PUSHJ	P,GETFIL	;GO GET THE SPEC
	MOVEI	T2,S.ZER	;LOAD THE ADDRESS OF SYFILE BLOCK
	TLNN	DL,DL.SYF	;SYFILE COMMAND GIVEN?
	PJRST	CPYSPC		;NO--NEW DEFAULT
	POPJ	P,		;YES--NO CHANGE

OGTFIL:	PUSHJ	P,CLSFIL	;CLOSE CURRENT OUTPUT FILE
	TLZ	F,L.OOPN!L.OTTY	;NOTE OUTPUT FILE NOT OPEN
	SETZM	LINNUM		;START AT TOP OF PAGE
	JRST	GETFIL

SGTFIL:	TLO	DL,DL.SYF	;FLAG SYFILE GIVEN
CGTFIL:
GETFIL:	JUMPLE	C,.POPJ		;RETURN IF NULL SPEC
	PUSHJ	P,.FILIN	;READ FILE SPECIFIER
	MOVEI	T1,F.ZER	;POINT TO BLANK SPEC
	MOVEI	T2,F.LEN	;LENGTH OF SAME
	PUSHJ	P,.GTSPC	;BLT THE SPEC FROM SCAN
	HRRZ	T2,VERBP(P1)	;ADDR OF BLOCK TO STORE RESULT
CPYSPC:	SKIPE	T1,F.ZER+%DEV	;SKIP IF NO DEVICE SPECIFIED
	MOVEM	T1,%DEV(T2)	;STORE DEVICE IN BLOCK
	SKIPE	T1,F.ZER+%NAM	;SKIP IF NO NAME SPECIFIED
	MOVEM	T1,%NAM(T2)	;STORE NAME IF BLOCK
	SKIPE	T1,F.ZER+%EXT	;SKIP IF NO EXT SPECIFIED
	MOVEM	T1,%EXT(T2)
	SKIPE	T1,F.ZER+%DIR	;SKIP IF DIRECTORY SPECIFIED
	MOVEM	T1,%DIR(T2)
	SKIPE	T1,F.ZER+%MOD
	MOVEM	T1,%MOD(T2)
	SKIPE	T1,%TYP+F.ZER
	MOVEM	T1,%TYP(T2)
	POPJ	P,
INSTST:
AUTOST:
ADDRST:	SKIPA	T1,[IOWD ONOF.L,ONOF.T] ;PTR TO LIST FOR ON OR OFF
CATRED:	MOVE	T1,[IOWD CATM.LT,CATM.T] ;PTR TO LIST OF CATEGORIES
;	PJRST	LSTSTO		;FALL INTO LSTSTO

;SUBROUTINE TO FIND A SWITCH VALUE IN A LIST
;ARGS	T1=IOWD PTR TO LIST OF LEGAL SWITCHES

LSTSTO:	MOVEM	T1,KEYPTR	;SAVE IOWD PTR TO LIST OF LEGAL VALUES
	HRRZ	T1,VERBD(P1)	;GET DEFAULT
	SKIPE	T2,VERBP(P1)	;SKIP IF NO STORAGE PTR
	DPB	T1,T2		;STORE DEFAULT FIRST
	JUMPLE	C,.POPJ		;EXIT IF NO VALUE SPECIFIED
	PUSHJ	P,KLOOK		;FIND VALUE SPECIFIED IN LIST
	AOJA	T1,EXPST1	;+1 FOR INTERNAL FORM AND STORE
;SUBROUTINE TO EXIT TO MONITOR - CLOSES OUTPUT FIRST

XIT:	PUSHJ	P,CLSFIL	;CLOSE OUTPUT FILE
	EXIT	1		;EXIT TO MONITOR
	EXIT

;SUBROUTINE TO CLOSE OUTPUT FILE

CLSFIL:	TLZN	F,L.OOPN	;SKIP IF OUTPUT FILE OPEN
	POPJ	P,		;NOOP IF NOT OPEN
	TLO	F,L.APP		;FORCE APPEND MODE
	CLOSE	OC,
	GETSTS	OC,N		;GET STATUS
	RELEAS	OC,		;GIVE UP THE DDB
	TRNN	N,IO.ERR	;SKIP IF ANY ERRORS
	POPJ	P,
	M.FAIO	<ERROR CLOSING OUTPUT FILE, STATUS =>

;SUBROUTINE TO STORE LINES PER PAGE AND WORRY ABOUT MINIMUM

LINPGS:	PUSHJ	P,EXPSTO	;STORE LINES PER PAGE AS SPECIFIED
	MOVEI	T1,MINLPG	;GET MINIMUM
	CAMLE	T1,LINPAG	;SKIP IF SPECIFIED GE MINIMUM
	MOVEM	T1,LINPAG	;NO, STORE MINIMUM
	POPJ	P,

GETSPC:	MOVEI	T1,F.ZER
	MOVEI	T2,F.LEN
	PUSHJ	P,.GTSPC
	MOVE	T1,F.ZER+%TYP
	MOVEM	T1,%TYP(P1)
	POPJ	P,
;SUBROUTINE TO ACCEPT A TITLE

TITPRC:	PUSHJ	P,.SAVE4
	TLO	F,L.TITL	;NOTE PRESENCE OF TITLE
	MOVEI	P2,TITNDX	 ;INDEX IN TABLE VECTOR
	MOVE	P1,TIT.Y	;BYTE POINTER FOR TITLE
	PUSHJ	P,MKPNTR	;MAKE A REAL POINTER
TITPR1:	JUMPLE	C,TITPRX	;EXIT AT END OF LINE
	PUSHJ	P,.TIALT	;READ NEXT CHAR
	MOVE	T1,C
	PUSHJ	P,STOBYT	;STORE IN TITLE TABLE
	JRST	TITPR1		;AND LOOP TILL END OF LINE
TITPRX:	MOVEI	T1,TIT.EN	;MARK END OF TITLE
	PJRST	STOBYT

;SUBROUTINE TO EVALUATE MODES LIST

MODPRC:	MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
	PUSHJ	P,MKPNTR	;CLEAR THE INDIRECT BIT
	MOVEI	P2,MODNDX	;INDEX IN TABLE VECTOR
	MOVE	T1,[IOWD MODE.L,MODE.T]
	PJRST	TABPRC		;PROCESS LIST
;SUBROUTINE TO EVALUATE JUSTIFY LIST

JUSPRC:	MOVE	P1,J.Y		;BYTE POINTER FOR JUSTIFY LIST
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	MOVEI	P2,JUSNDX	 ;INDEX IN TABLE VECTOR
	MOVEI	T1,J.END	;START WITH EMPTY LIST
	PUSHJ	P,STOBYT	;STORE END OF LIST
	MOVE	P1,J.Y
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	MOVE	T1,[IOWD JUST.LT,JUST.T]
;	PJRST	TABPRC		;PROCESS LIST

;SUBROUTINE TO READ TTY AND STORE A SERIES OF BYTES FOR KEY WORDS
;ARGS	T1=AOBJN PTR TO LIST OF KEY WORDS
;	P1=BYTE POINTER (TO BE INCREMENTED)
;	P2=INDEX IN TABLE VECTOR OF TABLE

TABPRC:	MOVEM	T1,KEYPTR	;SAVE POINTER TO LIST OF KEYWORDS
TABPR1:	JUMPLE	C,TABPR2	;EXIT AT END OF LINE
	PUSHJ	P,KLOOK		;FIND KEY WORD IN LIST
	PUSHJ	P,STOBYT	;STORE VALUE
	JRST	TABPR1
TABPR2:	SETO	T1,		;END OF LIST FLAG
	PJRST	STOBYT		;STORE IT

;SUBROUTINE TO LOOK UP A KEY WORD IN A LIST
;ARGS	KEYPTR=IOWD PTR TO LIST OF LEGAL VALUES
;VALUES	T1=INDEX IN LIST IF FOUND

KLOOK:	PUSHJ	P,.SIXSW	;GET KEYWORD
	MOVE	T1,KEYPTR	;PTR TO LIST OF KEY WORDS
	PUSHJ	P,.NAME		;LOOK IT UP
	  JRST	E.UKK		;UNKNOWN KEY WORD
	HRRZ	T2,KEYPTR	;ADDR OF BEGINNING OF LIST
	MOVEI	T1,-1(T1)
	SUB	T1,T2		;INDEX IN LIST IS VALUE
	POPJ	P,
;SUBROUTINE TO EVALUATE WIDTH LIST

WIDPRC:	MOVE	P1,W.Y		;BYTE POINTER FOR WIDTH LIST
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	MOVEI	P2,WIDNDX	;INDEX IN TABLE VECTOR
	MOVEI	T1,W.END	;START WITH EMPTGY LIST
	PUSHJ	P,STOBYT	;STORE END OF LIST
	MOVE	P1,W.Y
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
WIDPR1:	JUMPLE	C,WIDPR2	;EXIT AT END OF LINE
	PUSHJ	P,EXPEVA	;EVALUATE EXPRESSION
	PUSHJ	P,STOBYT	;STORE IT
	JRST	WIDPR1
WIDPR2:	MOVEI	T1,W.END	;MARK END OF LIST
	PJRST	STOBYT		; AND STORE IT

EJECT:	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
	PJRST	NEWPAG		;OUTPUT PAGE EJECT AND PAGE HEADER
;SUBROUTINE TO DUMP ALL OF FILE

ALLDMP:	JUMPG	C,E.EXP
	PUSH	P,C		;SAVE LAST CHAR INPUT
	SETZM	SAVADR		;START AT LOCATION 0
	SETZM	SAVPOS		;START OF WORD
	MOVEI	T1,^D36		;36 BIT BYTES
	MOVEM	T1,SAVSIZ
	HRLOI	T1,377777	;GO TO END OF FILE
	MOVEM	T1,TRMADR
	SETZM	TRMPOS
	MOVEI	T1,1		;INCREMENT BY 1 WORD
	MOVEM	T1,INCADR
	SETZM	INCPOS
	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
	PUSHJ	P,NEWLIN
	SETZB	T1,INCSIZ
	TRO	F,R.CON1	;NOTE DUMPING CONTENTS
	PUSHJ	P,FNDADR	;GET CONTENTS OF ZERO
	TLNN	F,L.NXM		;SKIP IF NXM ALREADY
	PUSHJ	P,OUTPT		;OUTPUT LOCATION 0
	MOVE	T1,%TYP(DL)	;TYPE OF INPUT FILE
	MOVE	T2,CATNUM	;CATEGORY IN CASE ITS DAEMON FILE
	CAIN	T1,T.DAE	;SKIP IF NOT A DAEMON FILE
	CAIE	T2,CA.COR	;SKIP IF CORE CATEGORY
	JRST	ALLDM1		;NO, JUST GO AHEAD
	TRO	F,R.CON1	;SET CONTENTS BIT
	MOVEI	T1,.JBREL	;ADDR OF .JBREL
	PUSHJ	P,FNDADR	;RETRIEVE .JBREL
	MOVEM	T1,LOWREL	;SAVE FOR LATER
ALLDM1:	TLO	F,L.ALLD	;NOTE DUMPING WHOLE FILE
	MOVE	T2,HGHOFF	;GET OFFSET FOR HISEG
	CAIE	T1,T.HGH	;IS THIS A HIGH SEG
	CAIN	T1,T.SHR	; OR A .SHR SEG?
	MOVEM	T2,SAVADR	;YES--START AT 400000
	PJRST	DMPXC0
;SUBROUTINE TO EXECUTE A DUMP REQUEST

DMPBYT:	TLZA	F,L.TDMP	;DO NOT DUMP ON TTY
TDMBYT:	TLO	F,L.TDMP	;ALSO DUMP ON TTY:
	JUMPLE	C,.POPJ		;GIVE UP IF NOTHING TO DO
	TLZ	DL,DL.NXM	;CAUSE ANOTHER MESSAGE
	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
	PUSH	P,C		;SAVE BREAK
	PUSHJ	P,NEWLIN	;START DUMP ON NEW LINE
	POP	P,C		;RESTORE C
	MOVE	T2,SAVADR	;GET LAST ADDRESS TYPED OUT
	MOVEM	T2,SAVE4.	;SAVE FOR .
	MOVE	T2,OUTVAL	;GET LAST BYTE TYPED OUT
	MOVEM	T2,SAVE4$	;SAVE FOR $
DMPBYS:	TRZ	F,R.CON1	;CLEAR CONTENTS FLAG
	PUSHJ	P,EXPEV0	;EVALUATE FIRST EXPRESSION
	MOVEM	T1,SAVEXP	;STORE FOR %
	CAIN	C," "		;SEE IF DELIMITER IS A SPACE AND
	PUSHJ	P,.TIAUC##	; IF SO GET ANOTHER CHAR.
	CAIN	C,"'"		;SKIP IF NOT A STRING COMING
	TRNE	F,R.ANY		;SKIP IF STRING AND NO DUMP DESC.
	JRST	DMPBY1		;DO BYTE FIRST
	JRST	DMPEXA		;NOTHING TO DUMP
DMPBY1:	MOVE	T2,POSTMP	;POSITION SPECIFIED
	MOVEM	T2,SAVPOS
	MOVE	T2,SIZTMP
	MOVEM	T2,SAVSIZ
	PUSH	P,C		;SAVE LAST CHAR INPUT
	MOVEM	T1,SAVADR	;ASSUME VALUE ONLY, SAVE AS ADDRESS
	TRNN	F,R.CONB	;SKIP IF ACTUALLY CONTENTS OF ADDRESS
	JRST	DMPBY2
	TRO	F,R.CON1	;NOTE DUMPING CONTENTS
	MOVE	T2,ADRTMP	;ADDRESS FETCHED
	MOVEM	T2,SAVADR	;IS ADDRESS TO SAVE
DMPBY2:	PUSHJ	P,OUTPT		;OUTPUT VALUE OF FIRST BYTE
	SETZM	INCSIZ		;DEFAULT SIZE INCREMENT
	MOVEI	T1,1		;DEFAULT POSITION=0(+1 FOR OFFSET)
	MOVEM	T1,INCPOS	;STORE DEFAULT POSITION INCREMENT
	MOVEM	T1,INCADR	;STORE DEFAULT ADDRESS INCREMENT
	MOVEI	T1,^D37		;DEFAULT END AT END OF THIS WORD
	MOVEM	T1,TRMPOS
	MOVE	T1,SAVADR	;ADDRESS OF THIS WORD
	MOVEM	T1,TRMADR
	SKIPLE	C,(P)		;RESTORE LAST CHAR INPUT, SKIP IF END OF LINE
	CAIE	C,"&"		;SKIP IF TERMINATING BYTE SPECIFIED
	JRST	DMPXC0		;END OF THAT BYTE DESCRIPTOR, GET NEXT
	SETZM	POSTMP
	SETZM	SIZTMP
	PUSHJ	P,EXPEVA	;EVALUATE TERMINATING BYTE SPECIFIER
	CAIN	C," "		;IGNORE TRAILINGE SPACES
	PUSHJ	P,.TIAUC##	; ..
	MOVEM	T1,TRMADR	;SAVE TERMINATING ADDRESS
	SKIPN	T1,POSTMP	;POSITION VALUE, SKIP IF SPECIFIED
	MOVEI	T1,1		;0 (+1 FOR OFFSET) IS DEFAULT
	MOVEM	T1,TRMPOS
	CAIE	C,"&"		;SKIP IF INCREMENT SPECIFIED
	JRST	DMPXCT		;NO, USE DEFAULT INCREMENT
	SETZM	POSTMP
	SETZM	SIZTMP
	PUSHJ	P,EXPEVA	;EVALUATE INCREMENT
	MOVEM	T1,INCADR	;SAVE INCREMENT ADDRESS
	MOVE	T1,POSTMP	;POSITION INCREMENT
	MOVEM	T1,INCPOS
	MOVE	T1,SIZTMP	;SIZE INCREMENT
	MOVEM	T1,INCSIZ
DMPXCT:	MOVEM	C,(P)		;SAVE LAST CHAR INPUT
DMPXC0:	MOVE	T1,SAVADR	;ADDR OF LAST BYTE OUTPUT
	MOVE	T2,SAVPOS	;POSITION LAST OUTPUT
	LSH	T2,POSSHF
	ADD	T2,SAVSIZ	;MAKE POSITION, SIZE WORD
	MOVE	T3,INCADR	;INCREMENT ADDRESS
	MOVE	T4,INCPOS	;INCREMENT POSITION
	LSH	T4,POSSHF
	ADD	T4,INCSIZ	;MAKE INCREMENT POSITION,SIZE WORD
	PUSHJ	P,ADDBYT	;INCREMENT BYTE
	JOV	DMPEX		;IF WE WENT FROM +INF TO -INF DO NOT
				; LOOP FOR EVER.
	CAMLE	T1,TRMADR	;SKIP IF NOT YET UP TO TERMINATING ADDRESS
	JRST	DMPEX
	MOVEM	T1,SAVADR	;SAVE NEW ADDR
	LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET NEW POSITION
	MOVEM	T1,SAVPOS
	MOVE	T1,SAVADR
	CAME	T1,TRMADR	;SKIP IF IN LAST WORD
	JRST	DMPXC1		;NO, GO AHEAD WITH DUMP
	MOVE	T1,SAVPOS	;POSITION
	CAMLE	T1,TRMPOS	;SKIP IF NOT YET PAST LAST BYTE IN WORD
	JRST	DMPEX		;ALL DONE, EXIT
DMPXC1:	TLNN	DL,DL.WID	;SKIP IF WE CONTROL OUR OWN WIDTHS
	PUSHJ	P,LSPC3		;ELSE OUTPUT 3 SPACES
	MOVE	T1,SAVADR
	TRNE	F,R.CON1	;SKIP IF ONLY ADDRESSES ARE VALUES DUMPED
	PUSHJ	P,FNDBYT	;FIND CONTENTS OF ADDRESS
	TLNN	F,L.ALLD	;SKIP IF DUMPING WHOLE FILE
	JRST	DMPXC2		;NO, GO AHEAD
	TLNE	F,L.NXM		;NO SKIP IF END OF FILE
	JRST	DMPEX		;YES, END AT NXM
	MOVE	T2,%TYP(DL)	;TYPE OF INPUT FILE
	MOVE	T3,CATNUM	;CATEGORY IN CASE ITS A DAEMON FILE
	CAIN	T2,T.DAE	;SKIP IF NOT A DAEMON FILE
	CAIE	T3,CA.COR	;YES, SKIP IF CORE CATEGORY
	JRST	DMPXC2		;NO, GO AHEAD
	MOVE	T2,LOWREL	;SIZE OF LOW SEGMENT
	CAMLE	T2,SAVADR	;SKIP IF ADDR PAST END OF LOW SEGMENT
	JRST	DMPXC2		;NO, GO AHEAD WITH LOW SEGMENT ADDR
	ADDI	T2,1		;POSSIBLE BEGINNING OF HIGH SEG
	CAIGE	T2,400000	;SKIP IF LOW SEG GT 400000
	MOVEI	T2,400000	;NO, HIGH SEG STARTS AT 400000
	CAMG	T2,SAVADR	;SKIP IF ADDR BETWEEN SEGMENTS
	JRST	DMPXC2		;NO, GO AHEAD WITH HIGH SEG ADR
	MOVEM	T2,SAVADR	;MOVE UP TO BEGINNING OF HIGH SEG
	JRST	DMPXC0		;AND START UP HIGH SEG
DMPXC2:	PUSHJ	P,OUTPT		;OUTPUT IT
	JRST	DMPXC0		;AND LOOP FOR ALL BYTES REQUESTED
DMPEX:	POP	P,C		;RESTORE LAST CHAR INPUT
DMPEXA:	JUMPLE	C,DMPENX	;EXIT IF END OF LINE
	CAIE	C,"'"		;SKIP IF STRING COMING
	JRST	DMPBYS		;NO, GET NEXT DUMP DESCRIPTOR
	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
DMPEX1:	JSP	T2,DMPTTG	;GET NEXT CHAR OF STRING
DMPEX2:	CAIE	C,C.DQ		;SKIP IF DOUBLE QUOTE
	JRST	DMPEX3		;NO, LOOK FOR SPECIAL PATTERN
	JSP	T2,DMPTTG	;YES, TAKE NEXT CHAR LITERALLY
	JRST	DMPEX8		;AND OUTPUT IT
DMPEX3:	CAIN	C,"'"		;SKIP IF NOT END OF STRING
	JRST	DMPEXX		;ALL DONE, GET NEXT DUMP DESCRIPTOR
	CAIN	C,"^"		;SKIP IF NOT CONTROL-LETTER
	JRST	DMPEX6
	CAIN	C,"\"		;SKIP IF NOT LOWER-CASE
	JRST	DMPEX7
	CAIE	C,"<"		;SKIP IF START OF SPECIAL PATTERN
	JRST	DMPEX8		;NO, JUST OUTPUT IT STRAIGHT
	PUSHJ	P,.SIXSW	;GET NEXT GROUP OF ALPHNUMERICS
	CAIE	C,">"		;SKIP IF REAL PATTERN
	JRST	DMPEX5		;NO, OUTPUT AS CHARS SEEN
	MOVSI	T2,-LSPCHR
	MOVE	M,N		;COPY SIXBIT VALUE
	HRR	M,SPCHAR(T2)	;MAKE RH MATCH
	CAME	M,SPCHAR(T2)	;SKIP IF MATCH PATTERN
	AOBJN	T2,.-2		;NO, TRY ALL LEGAL PATTERNS
	JUMPGE	T2,DMPEX4	;JUMP IF NOT LEGAL PATTERN
	HRRZ	M,SPCHAR(T2)	;M=ADDR OF STRING ACTUALLY WANTED
	PUSH	P,C		;SAVE C
	CAIN	M,SPS.FF	;IS THIS A FORM FEED?
	JRST	[PUSHJ P,NEWPAG	;YES--DO ALL THE CORRECT THINGS
		 JRST  .+2]	; AND SKIP OUTPUT
	PUSHJ	P,LSTR		;OUTPUT THAT
	POP	P,C		;PUT C BACK. IT SHOULD BE SUFFICIENT
				; TO DO A MOVEI C," " HERE BUT WHY
				; NOT DO IT RIGHT.
	JRST	DMPEX1
DMPEX4:	MOVEI	C,">"		;END WITH RIGHT ANGLE BRACKET
DMPEX5:	PUSH	P,C		;SAVE TERMINATING CHAR
	MOVEI	C,"<"		;WE KNOW THERE WAS A LEFT ANGLE BRACKET
	PUSHJ	P,LCHR
	MOVE	T2,N		;ALPHA CHARS WE READ
	PUSHJ	P,LSIX		;TYPE THEM
	POP	P,C		;NOW THE LAST CHAR
	JUMPLE	C,DMPENX	;HANDLE UNEXPECTED EOL
	JRST	DMPEX2		;AND INVESTIGATE THAT
DMPEX6:	JSP	T2,DMPTTG	;GET NEXT CHAR
	HRRZI	C,-100(C)	;MAKE CONTROL LETTER
	CAIE	C,"'"-100	;SKIP IF END OF STRING
	JRST	DMPEX8
	MOVEI	C,"^"		;OUTPUT TERMINAL ^
	PUSHJ	P,LCHR
	JRST	DMPEXX		;AND EXIT
DMPEX7:	JSP	T2,DMPTTG	;GET NEXT CHAR
	ADDI	C,40		;MAKE UPPER CASE
	CAIE	C,"'"+40	;SKIP IF END OF STRING
	JRST	DMPEX8
	MOVEI	C,"\"		;OUTPUT TERMINAL \
	PUSHJ	P,LCHR
DMPEXX:	JSP	T2,DMPTTG	;GT NEXT CHAR
	JUMPG	C,DMPBYS	;KEEP GOING IF NOT END OF INPUT LINE
DMPENX:	TLNN	F,L.OTTY	;SKIP IF OUTPUT DEVICE IS A TTY
	PJRST	LCRLF		;NO, EXIT
	PUSHJ	P,LCRLF		;YES, FINISH OFF LINE
	PJRST	CLSFIL		;AND CLOSE TO GET THE OUTPUT TO THE USER NOW

DMPEX8:	PUSHJ	P,LCHR		;OUTPUT THE CHAR
	JRST	DMPEX1		;AND LOOK AT NEXT CHAR


;ROUTINE TO GET NEXT CHAR IN A STRING

DMPTTG:	JUMPLE	C,DMPENX	;EXIT IF EOL
	PUSHJ	P,.TICHE##	;GET A BYTE BUT DO NOT PRE-PROCESS
	JUMPG	C,(T2)		;RETURN WITH REAL BYTE
	JRST	DMPENX		;EOL--EXIT
	DEFINE	SPCTM(A)<IRP A,<XWD SIXBIT \   A\,SPS.'A>>

SPCHAR:	SPCTM	<EL,VT,FF,AL,HT>
LSPCHR==.-SPCHAR

SPS.EL:	ASCIZ	.
.
SPS.VT:	<C.VT_^D29>
SPS.FF:	<C.FF_^D29>
SPS.AL:	<C.ALT_^D29>
SPS.HT:	ASCIZ .	.

BEGIN:
CMPDMP:
DELSYM:
DOPROC:
ENDPRC:
IFPROC:
IOFPRC:
LISPRC:
OOFPRC:
POPPRC:
PUSHPR:
SYMPRC:
TCMDMP:
TSYMPR:
	JRST	E.NIMP
SUBTTL EVALUATE EXPRESSION

;SUBROUTINE TO EVALUATE AN EXPRESSION

EXPEVA:	PUSHJ	P,EXPEV0	;EVALUATE EXPRESSION
	MOVEM	T1,SAVEXP	;STORE FOR %
	TLNN	F,L.NXM		;EVALUATE OK?
	POPJ	P,		;RETURN
	HRLZ	N,ADRTMP	;PICK UP ADDRESS
	M.FAIO	<NXM at>	;GIVE MESSAGE

EXPEV0:	TRZ	F,R.CONB!R.ANY	;NOTE NOT YET REQUIRED TO SEARCH FILE
	TLZ	F,L.NXM		;CLEAR NXM FLAG
	JUMPLE	C,.POPJ		;EXIT IF END OF LINE
	PUSHJ	P,.SAVE2	;PRESERVE P1 AND P2
	HRRZ	P1,OPRTAB	;SET UP PTR TO OPERATOR STACK
	HRRZ	P2,OPNTAB	;AND OPERAND STACK
	SUBI	P1,1		;MAKE PUSH DOWN PTR
	SUBI	P2,1		;MAKE PUSH DOWN PTR
EXPEV1:	PUSHJ	P,EXPSYM	;GET NEXT SYMBOL
	JUMPE	T1,EXPE2A	;ASSUME 0 IF A UNARY OPERATOR
EXPEV2:	TRNE	F,R.RPN		;SKIP IF NOT AFTER RIGHT PAREN
	JRST	E.EXP		;RIGHT PAREN MUST BE FOLLOWED BY UNARY OPERATOR
	TRO	F,R.ANY		;NOTE SOMETHING FOUND
EXPE2A:	SETZ	T2,
	TRZN	F,R.RPN		;RIGHT PAREN SHOULD NOT PUSH 0
	PUSHJ	P,PSHOPN	;PUT VALUE ON OPERAND STACK
	MOVSI	T2,-LPRECL	;MINUS LENGTH OF PRECEDENCE TABLE
	CAIN	C," "		;IF IT IS A BLANK TRY TO
	PUSHJ	P,.TIAUC## 	; GET A BETTER OPERATOR.
	CAIN	C,C.DQ		;IS IT A DOUBLE QUOTE?
	MOVEI	C,"W"		;YES--CONVERT TO DOUBLE-U
	CAIN	C,"<"		;CONVERT LEFT ANGLE BRACKET TO "X" FOR
	MOVEI	C,"X"		;INTERNAL EASE
	CAIN	C,">"		;AND RIGHT ANGLE BRACKET TO "Y"
	MOVEI	C,"Y"
	CAIE	C,","		; AND COMMA TO "Z" - SKIP IF COMMA SPECIFIED
	JRST	EXPEV4		;NO, GO AHEAD
	MOVEI	C,"Z"
	TRZN	F,R.CMAL	;SKIP IF COMMA LEGAL
	JRST	EXPEOX		;NO, END OF EXPRESSION
EXPEV4:	HLL	C,PRECLS(T2)	;LH C=PRECEDENCE OF NEXT SYMBOL ON LIST
	CAME	C,PRECLS(T2)	;SKIP IF FOUND CHAR IN LIST
	AOBJN	T2,EXPEV4	;NO, TRY NEXT
	JUMPGE	T2,EXPEOX	;EXIT IF TERMINATOR NOT OPERAND
	HRR	C,T2		;RH C=INDEX IN EXECUTION TABLE FOR THIS OPERAND
	HLLZ	T2,C		;T2=PRECEDENCE ONLY
EXPEV5:	TLNE	P1,-1		;SKIP IF OPERATOR STACK EMPTY
	CAMLE	T2,(P1)		;SKIP IF NEW OPERATOR LE STACK
	JRST	NOUNST		;NO, DONT UNSTACK
	HLLZ	T1,(P1)		;T1=PRECEDENCE OF OPERAND ON STACK
	CAML	T2,T1		;SKIP IF NEW LT STACK (NOT EQUAL)
	JRST	EXPEV6		;NEW EQ STACK
	CAMN	T1,[XWD LPNPRE,0] ;SKIP IF STACK NOT LEFT PAREN
	CAMN	T2,[XWD RPNPRE,0] ;SKIP IF NEW NOT RIGHT PAREN
	JRST	EXPEV7		;UNSTACK LEFT PAREN IF RIGHT PAREN
	JRST	NOUNST		;ELSE DONT UNSTACK LEFT PAREN
EXPEV6:	CAME	T2,[XWD LPNPRE,0] ;LEFT PAREN DOESN'T UNSTACK OTHER LEFT PAREN
	CAMN	T2,[XWD FUNPRE,0] ;NOR DO FUNNIES UNSTACK EACH OTHER
	JRST	NOUNST		;OTHERWISE EQUALS UNSTACK EACH OTHER
EXPEV7:	PUSHJ	P,UNSTAK	;UNSTAK LAST OPERATOR ON STACK
	TLNE	F,L.NXM		;NO SKIP IF NXM
	JRST	EXPEX1		;GIVE UP IF NXM
	TRNE	F,R.RPN		;SKIP IF NOT RIGHT PAREN
	JRST	EXPEV1		;ALL DONE IF RIGHT PAREN
	JRST	EXPEV5		;AND LOOP TILL DONT UNSTACK
NOUNST:	HLRZ	T2,C		;T2=PRECEDENCE OF NEW OPERATOR
	CAIN	T2,RBKPRE	;SKIP IF NOT RIGHT ANGLE BRACKET
	TRO	F,R.CMAL	;NOTE COMMA IS LEGAL AFTER ANGLE BRACKET
	HLRZ	T1,P1		;LENGTH OF OPERATOR STACK
	ADDI	T1,1		;+1=LENGTH NEEDED
	SUB	T1,OPRLEN	;NEEDED-LENGTH=WORDS NEEDED TO ADD
	JUMPLE	T1,NOUNS1	;JUMP IF ALREADY LONG ENOUGH
	PUSH	P,P2		;SAVE P2
	MOVEI	P2,OPRNDX	 ;INDEX IN TABLE VECTOR FOR OPERATOR STACK TABLE
	ADDI	T1,4		;GET SOME MORE ROOM
	ADDM	T1,(P)		;FIX UP OTHER PUSH DOWN POINTER
	PUSHJ	P,GETCOR	;EXPAND TABLE
	POP	P,P2
NOUNS1:	PUSH	P1,C		;PUT OPERATOR ON OPERATOR STACK
	JRST	EXPEV1		;AND GET NEXT OPERAND
EXPEOX:	TLNN	P1,-1		;SKIP IF MORE OPERATORS ON OPERATOR STACK
	JRST	EXPEX1		;NO MORE TO UNSTACK
	PUSHJ	P,UNSTAK	;UNSTACK LAST OPERATOR
	TLNN	F,L.NXM		;SKIP IF NXM
	JRST	EXPEOX		;LOOP TILL ALL UNSTACKED
EXPEX1:	MOVE	P1,P2
	MOVE	T1,OPRLEN
	SUBI	T1,4		;KEEP MINIMAL LENGTH
	MOVEI	P2,OPRNDX	
	JUMPLE	T1,EXPEX2	;JUMP IF DONT HAVE ENOUGH TO GIVE SOME BACK
	SUBM	T1,P1		;FIX UP PUSH DOWN PTR
	MOVNS	P1
	PUSHJ	P,GIVCOR	;GIVE BACK EXCESS CORE
EXPEX2:	HRRES	C		;RESTORE C TO ITS NATURAL SELF
	MOVE	T1,OPNLEN
	SUBI	T1,4
	MOVEI	P2,OPNNDX	
	CAILE	T1,0		;SKIP IF DONT HAVE MUCH
	PUSHJ	P,GIVCOR	;GIVE BACK EXCESS CORE
	TLNE	F,L.NXM		;NO SKIP IF NXM
	POPJ	P,
	HLRZ	T1,P1		;LENGTH OF OPERAND STACK
	SUBI	T1,2
	JUMPN	T1,E.EXP	;JUMP IF NOT EXACTLY 1 ITEM ON STACK
	POP	P1,T1		;T1=VALUE
	POP	P1,T2		;T2=POSITION,SIZE WORD
	POPJ	P,
;SUBROUTINE TO PUSH AN OPERAND ON THE OPERAND STACK
;ARGS	T1=VALUE
;	T2 BITS 0-5=POSITION+1
;	T2 BITS 6-35=SIZE

PSHOPN:	PUSH	P,T1
	PUSH	P,T2
	HLRZ	T1,P2		;CURRENT LENGTH OF OPERAND STACK
	ADDI	T1,2		;LENGTH NEEDED
	CAMGE	T1,OPNLEN	;SKIP IF TABLE NOT BIG ENOUGH
	JRST	PSHOP1		;OK
	PUSH	P,P2
	MOVEI	P2,OPNNDX	 ;INDEX IN TABLE VECTOR
	ADDI	T1,10		;MAKE IT BIGGER
	PUSHJ	P,GETCOR	;EXPAND TABLE
	POP	P,P2
PSHOP1:	POP	P,T2		;RESTORE VALUE OF OPERAND
	POP	P,T1
	PUSH	P2,T2		;PUSH OPERAND ON OPERAND STACK
	PUSH	P2,T1		;FIRST POSITION,SIZE, THEN VALUE
	POPJ	P,

;SUBROUTINE TO UNSTACK THE OPERATOR ON TOP OF THE OPERATOR STACK

UNSTAK:	TLNN	P2,-2		;SKIP IF SOMETHING ON THE OPERAND STACK
	JRST	E.EXP		;SIGH
	PUSH	P,T2		;SAVE T2
	POP	P2,T1		;LAST OPERAND
	POP	P2,T2		;POSITION,SIZE WORD
	HRRZ	T3,(P1)		;INDEX IN INSTRUCTION TABLE
	XCT	OPER(T3)	;EXECUTE INSTRUCTION FOR OPERATOR
	POP	P1,T1		;THROW AWAY OPERATOR
	POP	P,T2		;RESTORE T2
	POPJ	P,
	DEFINE PRECMC<
ZZ==1
RPNPRE==ZZ
	X	<)>
	X	<+,->
	X	<*,/>
	X	<^>
	X	<W>
FUNPRE==ZZ
	X	<[,@,\>
RBKPRE==ZZ
	X	<X,Y>
	X	<Z>
LPNPRE==ZZ
	X	<(>
	>

	DEFINE	X(A)<
IRP A,<
	XWD	ZZ,"A">
ZZ==ZZ+1
>

PRECLS:	PRECMC
LPRECL==.-PRECLS
	DEFINE	X(A)<
ZZ==ZZ+1
IRP A,<
IFIDN <A> <+>,<
	PUSHJ	P,EXPADD>

IFIDN <A> <->,<
	PUSHJ	P,EXPSUB>

IFIDN <A> <*>,<
	IMULM	T1,(P2)>

IFIDN <A> </>,<
	PUSHJ	P,EXPDIV>

IFIDN <A> <^>,<
	PUSHJ	P,EXPON>

IFIDN <A> <[>,<
	PUSHJ	P,CONT36>

IFIDN <A> <@>,<
	PUSHJ	P,CONT23>
IFIDN <A> <\>,<
	PUSHJ	P,CONT18>

IFIDN <A> <(>,<
	PUSHJ	P,EXPRPN>

IFIDN <A> <)>,<
	JRST	E.EXP>

IFIDN <A> <W>,<
	HLREM	T1,(P2)>

IFIDN <A> <X>,<
	PUSHJ	P,EXPRBK>

IFIDN <A> <Z>,<
	PUSHJ	P,EXPCMA>

IFIDN <A> <Y>,<
	JRST	E.EXP>
>>
OPER:	PRECMC
EXPADD:	POP	P2,T3		;POP NEXT TO LAST OPERAND
	POP	P2,T4
	PUSHJ	P,ADDBYT	;ADD THE LAST TWO
	PUSH	P2,T2		;AND PUT THAT ON THE STACK
	PUSH	P2,T1
	POPJ	P,

EXPSUB:	EXCH	T1,(P2)		;LAST OPERAND ON STACK
	SUBM	T1,(P2)		;SUBTRACT FROM NEXT TO LAST AND STORE ON STACK
	POPJ	P,

EXPDIV:	EXCH	T1,(P2)		;LAST OPERAND ON STACK
	IDIVM	T1,(P2)		;DIVIDE NEXT TO LAST BY LAST AND STORE ON STACK
	POPJ	P,

EXPON:	JUMPG	T1,EXPON1	;JUMP IF POSITIVE POWER
	MOVEI	T1,1		;ANYTHING TO NEGATIVE POWER IS 1
	SKIPE	(P2)		;EXCEPT 0 WHICH IS 0
	MOVEM	T1,(P2)
	POPJ	P,
EXPON1:	MOVE	T2,(P2)		;NUMBER TO BE RAISED TO A POWER
EXPON2:	SOJLE	T1,.POPJ	;JUMP IF RAISED TO POWER DESIRED
	IMULM	T2,(P2)		;RAISE TO ANOTHER POWER
	JRST	EXPON2		;AND LOOP TILL DONE

EXPCMA:	TLNN	P2,-2		;SKIP IF SOMETHING ON OPERAND STACK
	JRST	E.EXP		;ERROR IF OPERAND STACK EMPTY
	MOVEM	T1,-1(P2)	;STORE SIZE
	MOVE	T1,(P2)		;GET LAST OPERAND ON STACK=POSITION
	MOVEM	T1,SIZTMP	;SAVE AS SIZE
	ADDI	T1,1		;MAKE LAST OPERAND=POSITION NON-ZERO
	LSH	T1,POSSHF
	ORM	T1,-1(P2)	;AND STORE AS POSITION OF OPERAND ON TOP OF STACK
	POPJ	P,

EXPRBK:	TRZN	F,R.CMAL	;SKIP IF NO COMMA SEEN
	JRST	EXPRB1		;THIS IS A SIZE FIELD
	ADDI	T1,1		;IT IS POSITION, MAKE NON-ZERO
	LSH	T1,POSSHF
	MOVE	T2,T1		;T2=POSITION, 0 FOR SIZE
EXPRB1:	MOVEM	T2,-1(P2)	;STORE POSITION, SIZE FOR TOP OF STACK
	LSH	T2,-POSSHF	;SHIFT BACK
	MOVEM	T2,POSTMP	;STORE FOR LATER
	JRST	EXPRP1		;AND GET RID OF LEFT ANGLE BRACKET

EXPRPN:	MOVEM	T2,-1(P2)	;STORE OPERAND ON TOP OF 0 PUSHED FOR UNARY (
	MOVEM	T1,(P2)
EXPRP1:	TRO	F,R.RPN		;SET RIGHT PAREN BIT
	POPJ	P,
CONT18:	PUSHJ	P,FNDBYT	;GET CONTENTS OF WORD SPECIFIED
	TLZ	T1,-1
	JRST	CONTEX		;AND EXTRACT PROPER BYTE

CONT23:	PUSHJ	P,FNDBYT
CON23A:	TLNN	T1,17		;SKIP IF ANY INDEX SPECIFIED
	JRST	NOINDX		;NO
	PUSH	P,T1
	LDB	T1,[POINT 4,T1,17]	;GET INDEX REGISTER
	PUSHJ	P,FNDADR	;GET CONTENTS OF INDEX REGISTER
	POP	P,T2
	TLNE	F,L.NXM		;NO SKIP IF NXM
	JRST	CONTEX
	EXCH	T1,T2		;T2=CONTENTS OF INDEX REGISTER
	ADDI	T1,(T2)

INDBTS=(@)	;INDIRECT BITS

NOINDX:	SETZ	T2,		;CLEAR POSITION WORD IN CASE NO MORE INDIRECT
	TLZ	T1,-1-INDBTS	;CLEAR ALL BUT INDIRECT BITS
	TLZN	T1,(@)		;SKIP IF INDIRECT SPECIFIED
	JRST	CONT36		;ALL DONE IF NO MORE INDIRECTING
	MOVEM	T1,ADRTMP	;NEW CURRENT ADDRESS
	PUSHJ	P,FNDADR	;GET CONTENTS OF THAT LOCATION
	TLNN	F,L.NXM		;SKIP IF NXM
	JRST	CON23A		;AND LOOP TILL DONE
	JRST	CONTEX

CONT36:	PUSHJ	P,FNDBYT	;GET CONTENTS OF WORD SPECIFIED
CONTEX:	MOVEM	T1,(P2)		;STORE ON TOP OF ZERO PUSHED
	TRO	F,R.CONB	;NOTE USED CONTENTS
	POPJ	P,
;SUBROUTINE TO ADD TWO BYTE DESCRIPTORS
;ARGS	T1,T2=BYTE DESCRIPTOR 1
;	T3,T4=BYTE DESCRIPTOR 2
;VALUES	T1,T2=BYTE DESCRIPTOR 1 + BYTE DESCRIPTOR 2
;BYTE DESCRIPTOR ADDITION IS DEFINED BY:
;	ADDING ADDRESSES, THEN
;	ADDING POSITION; IF OVERFLOWS THE WORD, TAKE PARTIAL BYTE FROM
;	  BOTH WORDS, THEN
;	ADD SIZE INCREMENT TO POSITION; IF OVERFLOWS, RESET TO BEGINNING OF
;	  NEXT WORD, LIKE THE HARDWARE INCREMENTS BYTE POINTERS

ADDBYT:	JOV	.+1		;CLEAR OVERFLOW
	ADD	T1,T3		;ADDRESSES ADD
	JUMPE	T4,.POPJ	;NO CHANGE IF INCREMENT POS, SIZE=0
	PUSH	P,T1
	LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
	LDB	T3,[POINT 36-POSSHF,T4,35-POSSHF] ;GET POSITION INCREMENT
	ADD	T1,T3		;T1=NEW POSITION
	SUBI	T1,1		;BOTH WERE +1, SO MAKE NEW +1
ADDBY1:	CAIGE	T1,^D37		;SKIP IF OVERFLOWED THE WORD
	JRST	ADDBY2		;NO, GO ADD SIZE
	AOS	(P)		;BUMP ADDRESS TO NEXT WORD
	SUBI	T1,^D36		;AND MOVE POSITION BACK 36 BITS
	JRST	ADDBY1		;AND SEE IF INTO LAST WORD
ADDBY2:	TLZ	T4,770000	;CLEAR OUT POSITION FIELD
	ADD	T1,T4		;ADD INCREMENT SIZE TO POSITION
	MOVNS	T4		;-SIZE + BEGINNING OF NEXT
	ADDI	T4,^D37		;IS POSITION WHERE BYTE WILL OVERFLOW
	CAMG	T1,T4		;SKIP IF NEXT BYTE WILL OVERFLOW WORD
	JRST	ADDBY3		;NO, ALL SET
	MOVEI	T1,1		;RESET TO BEGINNING OF NEXT WORD
	AOS	(P)		;BUMP ADDR
ADDBY3:	DPB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;STORE NEW POSITION
	POP	P,T1		;POP FINAL ADDDRESS
	POPJ	P,
;SUBROUTINE TO READ A SYMBOL
;	T1=NUMBER IF NUMBER, RADIX50 SYMBOL IF SYMBOL
;RETURN	.POPJ IF NUMBER
;	.POPJ1 IF SYMBOL

REDSYM:	SETZ	T1,
	JUMPLE	C,.POPJ1	;EXIT IF END OF LINE
	PUSHJ	P,.TIAUC	;GET NEXT CHAR
	CAIN	C," "		;IGNORE BLANKS BEFORE A SYMBOL
	PUSHJ	P,.TIAUC##	; TO MAKE DUMP EASIER TO USE.
	CAIL	C,"0"		;SKIP IF NOT A NUMBER
	CAILE	C,"9"		;SKIP IF A NUMBER
	JRST	SYMIN		;ASSUME SYMBOL
	JRST	RDXIN		;NUMBER, READ IN CURRENT INPUT RADIX
SYMIN:	CAIN	C,"%"		;SKIP IF NOT PERCENT
	JRST	SYMPER		;PERCENT IS LEGAL RADIX50 SYMBOL
	CAIN	C,"$"
	JRST	SYMDOL		;DOLLAR SIGN IS LEGAL RADIX50
	CAIN	C,"."
	JRST	SYMDOT		;AS IS DOT
	CAIL	C,"A"		;SKIP IF NOT A LETTER
	CAILE	C,"Z"		;SKIP IF LETTER
	JRST	.+2
	JRST	SYMLET		;LETTTER
	CAIL	C,"0"		;SKIP IF NOT A NUMBER
	CAILE	C,"9"		;SKIP IF A NUMBER
	JRST	.POPJ1		;NOT A RADIX50 SYMBOL, EXIT
SYMNUM:	SUBI	C,"0"-1		;"0" IS 1 IN RADIX50
	JRST	SYMRD5		;C=RADIX50 VALUE
SYMPER:	SKIPA	C,[47]		;47 IS RADIX50 FOR PERCENT
SYMDOL:	MOVEI	C,46		;46 IS RADIX50 FOR DOLLAR SIGN
	JRST	SYMRD5
SYMDOT:	SKIPA	C,[45]		;45 IS RADIX50 FOR PERIOD
SYMLET:	SUBI	C,"A"-13	;"A" IS 13 IN RADIX50
SYMRD5:	IMULI	T1,50
	ADD	T1,C
	PUSHJ	P,.TIAUC	;GET NEXT CHAR
	JRST	SYMIN
RDXIN:	SETZ	T1,		;CLEAR THE AC
	JOV	RDXIN1		;CLEAR THE OVERFLOW FLAG
RDXIN1:	SUBI	C,"0"
	CAIL	C,0		;SEE IF IN RADIX
	CAML	C,IRADIX	;SKIP IF A NUMBER IN CURRENT RADIX
	JRST	RDXMUL		;END OF NUMBER
	IMUL	T1,IRADIX	;MULTIPLY PREVIOUS BY CURRENT RADIX
	ADD	T1,C		;+ THIS NUMBER
	JOV	[TLO  T1,(1B0)	;OVERFLOW DOES NOT TAKE PLACE
		 JRST .+1]	; SO SET BIT ZERO TO MAKE IT HAPPEN
	ADDI	C,"0"		;FIX CHAR BACK UP FOR CONKLIN
	PUSHJ	P,.TIAUC	;GET NEXT CHAR
	JRST	RDXIN1		;AND LOOP

RDXMUL:	ADDI	C,"0"		;RESET CHAR
	POPJ	P,
SUBTTL GET BYTE FROM INPUT FILE

;SUBROUTINE TO EXTRACT A BYTE FROM THE INPUT FILE
;ARGS	T1=ADDRESS OF WORD DESIRED
;	T2=POSITION, SIZE DESIRED

FNDBYT:	PUSHJ	P,.SAVE2	;SAVE P1,P2
	MOVEM	T1,ADRTMP	;SAVE ADDRESS
	LDB	T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
	CAIN	T1,0		;SKIP IF SPECIFIED
	MOVEI	T1,1		;NO, ASSUME 0 (+OFFSET)
	MOVEM	T1,POSTMP	;SAVE POSITION
	TLZ	T2,770000
	MOVEI	T1,^D36		;DEFAULT IS FULL WORD
	CAIN	T2,0		;SKIP IF SIZE SPECIFIED
	MOVE	T2,T1		;USE DEFAULT
	MOVEM	T2,SIZTMP
	MOVEI	P2,BYTNDX	 ;INDEX IN TABLE VECTOR FOR BYTE TABLE
	MOVE	T1,T2		;T1=SIZE IN BITS
	ADDI	T1,^D35
	IDIVI	T1,^D36		;CONVERT TO WORDS
	SUB	T1,BYTLEN	;SEE IF TABLE LONG ENOUGH
	JUMPLE	T1,FNDBY1	;JUMP IF BIG ENOUGH, GET RID OF EXCESS
	PUSHJ	P,GETCOR	;EXPAND TABLE
	JRST	FNDBY2
FNDBY1:	JUMPE	T1,FNDBY2	;JUMP IF EXACTLY RIGHT SIZE
	MOVNS	T1		;T1=EXCESS
	PUSHJ	P,GIVCOR	;GIVE BACK EXCESS
FNDBY2:	MOVE	P1,BYT.Y	;BYTE POINTER FOR STORING BYTE
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	MOVE	T1,ADRTMP	;ADDRESS OF WORD TO FETCH
	PUSHJ	P,FNDADR	;GET FIRST WORD
	TLNE	F,L.NXM		;NO SKIP IF NXM
	POPJ	P,
	MOVE	T2,POSTMP	;POSITION
	ADD	T2,SIZTMP	;+SIZE
	CAILE	T2,^D37		;SKIP IF LE 1 WORD
	JRST	FNDBY3		;OVERFLOWS THE WORD

;HERE IF ALL IN THIS WORD

	MOVE	T3,POSTMP	;POSITION
	LSH	T1,-1(T3)	;BITS TO TOP OF T1
	SUBI	T2,^D36(T3)	;BITS TO SHIFT RIGHT=36-SIZE
	LSH	T1,(T2)		;NOW TO BOTTOM
	JRST	FNDBYX		;STORE LAST WORD AND EXIT
;HERE IF SPLIT OVER WORD BOUNDARY

FNDBY3:	MOVE	T2,SIZTMP	;GET SIZE
	CAILE	T2,^D36		;SKIP IF BYTE FITS IN 1 WORD
	JRST	FNDBY4		;MORE THAN 36 BITS REQUIRED
	PUSH	P,T1		;SAVE FIRST WORD
	AOS	T1,ADRTMP	;ADDR OF NEXT WORD
	PUSHJ	P,FNDADR	;GET SECOND WORD
	POP	P,T2		;RESTORE FIRST WORD
	MOVE	T3,POSTMP	;POSITION
	LSHC	T1,^D36(T3)	;SHIFT TO TOP OF T1
	MOVE	T3,SIZTMP	;SIZE
	SUBI	T3,^D36		;-36=BITS TO SHIFT RIGHT
	LSH	T1,(T3)		;SHIFT TO BOTTOM OF T1
	SOS	ADRTMP		;RESTORE REAL ADDRESS
	JRST	FNDBYX		;STORE BYTE AND EXIT
;HERE IF MORE THAN 36 BITS REQUIRED

FNDBY4:	PUSH	P,SIZTMP	;SAVE SIZE
	PUSH	P,ADRTMP	;AND ADDRESS
FNDBY5:	PUSH	P,T1		;SAVE CURRENT 36 BITS
	AOS	T1,ADRTMP	;ADDRESS OF NEXT WORD
	PUSHJ	P,FNDADR	;GET NEXT 36 BITS
	POP	P,T2		;RESTORE PREVIOUS 36 BITS
	TLNE	F,L.NXM		;NO SKIP IF NXM
	POPJ	P,
	MOVE	T3,POSTMP	;POSITION
	LSHC	T1,^D36(T3)	;SHIFT TO TOP OF T1
	MOVE	T4,SIZTMP	;SIZE
	SUBI	T4,^D36		;MINUS THESE 36 BITS
	JUMPG	T4,FNDBY6	;JUMP IF MORE TO COME
	POP	P,ADRTMP	;THIS IS THE LAST, RESTORE ADDRESS
	POP	P,SIZTMP
	JRST	FNDBYX		;STORE LAST WORD AND EXIT

FNDBY6:	MOVEM	T4,SIZTMP	;STORE BITS LEFT TO GET
	PUSHJ	P,STOBYT	;STORE THESE 36 BITS
	MOVNS	T3		;MINUS POSITION
	ADDI	T3,^D36		;+36=BITS TO SHIFT TO SAVE REST OF SECOND WORD
	LSHC	T1,(T3)		;SAVE PART OF SECOND WORD NOT YET USED
	JRST	FNDBY5		;LOOP TILL LAST WORD

FNDBYX:	PUSHJ	P,STOBYT	;STORE LAST BYTE
	MOVE	P1,BYT.Y
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	ILDB	T1,P1		;GET FIRST 36 BITS
	POPJ	P,
;SUBROUTINE TO GET A WORD FROM THE INPUT FILE
;ARGS	T1=ADDRESS OF WORD DESIRED
;VALUES	T1=CONTENTS OF WORD DESIRED
;	BIT L.NXM OF F SET IF NXM

FNDADR:	JUMPL	T1,RETNXM	;NEGATIVE ADDRESSES ARE NOT IN FILE
	PUSHJ	P,.SAVE2	;SAVE P1,P2
	TLNN	DL,DL.SYM	;SKIP IF READING SYMBOLS
	PUSHJ	P,CMPOFF	;OFFSET IF NECESSARY THE ADDRESS TO FIND
	MOVEM	T1,TEMPAD	;ACTUAL ADDRESS TO FETCH
	TLZ	F,L.NXM		;CLEAR NXM FLAG
FNDAD1:	SKIPG	T1,%TYP(DL)	;SKIP IF TYPE OF INPUT FILE KNOWN
	JRST	NOTYP		;NO, TRY TO FIND OUT
	SUBI	T1,1
	HLLZS	%EXT(DL)	;CLEAR MASK
	SKIPN	T2,%EXT(DL)	;SKIP IF NO EXT KNOWN YET
	HLLZ	T2,I.DEX(T1)	;NO, GET DEFAULT
	MOVEM	T2,%EXT(DL)
	ROT	T1,-1		;DIVIDE BY 2
	MOVE	T2,TYPVEC(T1)	;DISPATCH ADDRESS
	CAIL	T1,0		;SKIP IF WANT RIGHT HALF
	MOVSS	T2		;NO, WANT ADDR IN LH
	JRST	(T2)		;CALL ROUTINE TO FIND WORD

;HERE IF TYPE OF INPUT FILE NOT KNOWN, TRY TO FIND OUT BY ITS EXTENSION

NOTYP:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVEI	P1,(DL)		;POINTER TO FILE SPEC
	PUSHJ	P,GETSPC	;PICK UP STICKY DEFAULTS
	MOVE	T1,%DEV(DL)	;INPUT DEVICE
	DEVCHR	T1,
	TLNN	T1,DV.DIR	;SKIP IF A DIRECTORY DEVICE
	JRST	NOTYPD		;NO, USE DEFAULT
	MOVEI	T1,17		;DIRECTORY DEVICE, LOOK FOR EXTENSIONS
	MOVE	T2,%DEV(DL)
	SETZ	T3,
	OPEN	IC,T1
	  JRST	E.LKO		;CANT OPEN INPUT DEVICE
	SKIPE	T2,%EXT(DL)	;SKIP IF NO EXT SPECIFIED
	JRST	EXTTYP		;LOOK AT EXT SPECIFIED
	MOVSI	P1,-I.LDEX
	MOVE	T1,%NAM(DL)	;NAME OF INPUT FILE
	SETZ	T3,
NOTYP1:	HLLZ	T2,I.DEX(P1)	;NEXT EXT TO TRY
	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
	LOOKUP	IC,T1
	  AOBJN	P1,NOTYP1	;NO SUCH FILE, TRY NEXT
	JUMPGE	P1,E.NSFI	;JUMP IF CANT FIND ANY FILES
	HLLM	T2,%EXT(DL)	;STORE EXT USED
	HRROI	T1,1(P1)	;T1=TYPE
	JRST	EXTTY2		;GO STORE TYPE
;HERE IF EXTENSION SPECIFIED

EXTTYP:	MOVE	T1,%NAM(DL)
	SETZ	T3,
	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
	LOOKUP	IC,T1
	  JRST	E.NSFI
	HLLM	T2,%EXT(DL)
	MOVSI	T1,-I.LDEX
EXTTY1:	HRR	T2,I.DEX(T1)	;LOOK FOR EXTENSION ON LIST
	CAME	T2,I.DEX(T1)	;SKIP IF FOUND IT
	AOBJN	T1,EXTTY1
	ADDI	T1,1
EXTTY2:	MOVEI	T2,T.TMP
	CAIN	T2,(T1)		;SKIP IF NOT TMP FILE
	HRRZ	T2,%NAM(DL)	;TYPE FROM NAME OF FILE
	CAIN	T2,(SIXBIT .DAE.)	;SKIP IF NOT DAEMON FILE
	HRROI	T1,T.DAE	;NNNDAE.TMP IS A DAEMON FILE
	CAIL	T1,0		;SKIP IF FOUND ONE
NOTYPD:	MOVEI	T1,AD.TYP	;DEFAULT
	HRRZM	T1,%TYP(DL)
	JRST	FNDAD1
;SUBROUTINE TO FIND A WORD IN A DAEMON FILE

FNDDAE:	TLNN	F,L.IOPN	;INPUT OPEN?
	PUSHJ	P,OPNDAE	;NO--GO SET UP FILE
FNDDA0:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	T1,CATNUM	;CATEGORY DESIRED FOR THIS BYTE
	EXCH	T1,DAECCT	;STORE AS CURRENT CATEGORY AND SAVE LAST
	CAMN	T1,DAECCT	;SKIP IF WAS NOT AT THAT CATEGORY
	JRST	FNDDA5		;ALREADY IN THE CATEGORY
	SETZM	CATBLK		;REWIND THE DAEMON FILE AND SCAN
	SETZM	CATWRD		; FROM THE START.
FNDDA3:	AOS	T1,CATBLK	;SET BEGINNING OF CATEGORY TO BLOCK 1 OF FILE
	MOVEM	T1,DAECBK	;REMEMBER CURRENT BLOCK
	USETI	IC,(T1)		;START AT THAT BLOCK
	INPUT	IC,INPLST	;READ THE BLOCK
	SETZB	T2,DAECWD	;CLEAR CURRENT WORD IN BLOCK
	PUSHJ	P,CATRW1	;SET UP BEGINNING OF CATEGORY
	MOVE	T2,DMHEAD	;T2=ADDRESS OF NEXT WORD IN INPUT BUFFER
	MOVE	T1,(T2)		;GET CATEGORY NUMBER
FNDDA1:	CAMN	T1,DAECCT	;SKIP IF NOT CATEGORY DESIRED
	JRST	FNDDA2		;POSITIONED AT BEGINNING OF CATEGORY
	PUSHJ	P,READDM	;GET LENGTH
	TLNE	F,L.IEOF	;END OF FILE
	PJRST	RETNXM		;YES--RETURN NXM
	MOVE	P1,T1
FNDDA4:	PUSHJ	P,READDM
	SOJGE	P1,FNDDA4	;READ PAST CATEGORY
	JRST	FNDDA1
FNDDA2:	PUSHJ	P,READDM	;READ LENGTH OF CATEGORY
	MOVE	T2,DAECBK	;CURRENT BLOCK NUMBER
	IMULI	T2,WINSIZ	;CONVERTED TO WORDS
	ADD	T2,DAECWD	;PLUS CURRENT WORD NUMBER
	SUBI	T2,WINSIZ-1	;- ONE BLOCK+1=OFFSET FROM BEGINNING OF FILE
	ADD	T1,T2		;PLUS LENGTH OF CAT=OFFSET OF LAST WORD OF CAT+1
	MOVEM	T1,CATLEN	;STORE LAST WORD OF CATEGORY
	MOVNM	T2,HGHOFF	;AND OFFSET FOR BEGINNING OF CATEGORY
	MOVEI	T1,CATBLK-1
	PUSH	T1,DAECBK
	PUSH	T1,DAECWD
;HERE WHEN SOMEWHERE IN CATEGORY

FNDDA5:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
	MOVE	T2,CATNUM	;CATEGORY
	CAIN	T2,CA.COR	;CORE??
	JRST	FNDDA6		;YES--GO DO IT
	CAMGE	T1,WINADR	;IN THIS WINDOW?
	PUSHJ	P,CATREW	;NO--REWIND
	JRST	DATRED		;READ AS DATA

;HERE IF CORE

FNDDA6:	TLNE	T1,-1		;BITS IN LEFT HALF?
	JRST	RETNXM		;YES--NOT IN FILE
	TLNE	DL,DL.ANXM	;DO AC'S EXIST
	JRST	RETNXM		;NO--DUMB DUMP
	TLNN	F,L.IOPN	;INPUT SETUP?
	JRST	FNDDA7		;NO--CAN NOT TRUST JOBDAT
	TRNN	T1,777600	;LESS THAN 200(8)
	TLNE	DL,DL.SYM	;READING SYMBOLS?
	JRST	FNDDA7		;YES--DO NOT USE BUFFER IT IS WRONG
	JRST	[MOVE T1,JOBDAT(T1) ;YES--RETURN DATA FROM BUFFER
		 POPJ P,]	; ..
	MOVEI	T2,.JBREL##	;DUMB LOADER
	CAMG	T1,JOBDAT(T2)	;SKIP IF NOT IN LOWSEG
	JRST	FNDDA7		;IN LOWSEG GO READ
	CAIL	T1,400000	;SKIP IF IN HISEG
	JRST	RETNXM		;BETWEEN SEGMENTS RETURN NXM
FNDDA7:	CAMGE	T1,WINADR	;BELOW THIS WINDOW
	PUSHJ	P,CATREW	;YES--REWIND FILE
	JRST	CMPRED		;READ CORE IMAGE
;HERE TO SET UP DAEMON FILE

OPNDAE:	PUSHJ	P,OPNDMP	;OPEN THE FILE
	TLNE	DL,DL.SYM	;READING THE SYMBOL FILE
	POPJ	P,		;YES--RETURN WITHOUT BUFFERING
	TLZ	F,L.IOPN	;CLEAR THE BIT FOR NOW
	TLZ	DL,DL.ANXM	;CLEAR CORE 0 BIT
	PUSHJ	P,.SAVE1##	;SAVE P1
	PUSH	P,CATNUM	;SAVE CATEGORY
	PUSH	P,TEMPAD	;SAVE ADDRESS
	MOVEI	T1,CA.COR	;MAKE IT LOOK LIKE CORE
	MOVEM	T1,CATNUM	; ..
	MOVSI	P1,-200		;SIZE OF JOBDAT BUFFER
	SETZM	TEMPAD		;CLEAR TEMP POINTER
	SETZM	DAECCT		;CLEAR ALL RECOLECTIONS OF
	SETZM	CATBLK		; LIFE IN THE PAST.
	SETZM	CATWRD
	HRLOI	T1,377777	;CAUSE THE WINDOW TO BE
	MOVEM	T1,WINADR	; WASHED.
OPNDA1:	PUSHJ	P,FNDDA0	;GET THE WORD
	MOVEM	T1,JOBDAT(P1)	;STORE
	TLNE	F,L.NXM		;NXM??
	TLO	DL,DL.ANXM	;YES -- NO CORE ASSIGNED
	AOS	TEMPAD		;ADVANCE POINTER
	AOBJN	P1,OPNDA1	;LOOP FOR MORE
	POP	P,TEMPAD	;RESTORE LOCALS
	POP	P,CATNUM	; ..
	TLO	F,L.IOPN	;OPEN NOW
	POPJ	P,		;RETURN
;SUBROUTINE TO FIND A WORD IN AN EXPANDED FILE

FNDXPN:

;SUBROUTINE TO FIND A WORD IN A DATA FILE

FNDTMP:
FNDDAT:	SETZM	HGHOFF		;OFFSET=ZERO
	PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
	PJRST	DATRED		;AND FIND WORD

;SUBROUTINE TO FIND A WORD IN A HIGH SEGMENT FILE

FNDHGH:
FNDSHR:	TLNE	F,L.IOPN	;SKIP IF INPUT NOT YET OPEN
	PJRST	DATRED
	PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
	MOVEI	T2,.JBHCR	;WORD WHICH CONTAINS LOW SEG SIZE
	PUSHJ	P,READDM	;READ UP TO .JBHCR
	SOJGE	T2,.-1
	HRRZS	T1		;RH=SIZE OF LOW SEGMENT
	ADDI	T1,1777
	TRZ	T1,1777		;ROUND UP TO NEXT K
	CAIGE	T1,400000	;WHICH IS START OF HIGH SEG
	MOVEI	T1,400000	;BUT MUST BE AT LEAST 400000
	MOVEM	T1,HGHOFF	;OFFSET FOR HIGH SEGMENT

;HERE WHEN INPUT FILE OPEN AND OFFSET KNOWN

;	PJRST	DATRED
;SUBROUTINE TO READ A WORD FROM A DATA FILE
;ARGS	TEMPAD=ADDRESS OF WORD TO GET
;	HGHOFF=ADDRESS OFFSET FOR FIRST WORD OF FILE
;VALUES	T1=CONTENTS OF WORD DESIRED

DATRED:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
	SUB	T1,HGHOFF	;-OFFSET=WORD NUMBER IN FILE
	JUMPL	T1,RETNXM	;RETURN NXM IF NOT THERE
	CAML	T1,CATLEN	;SKIP IF NOT PAST END OF FILE
	PJRST	DATRD1		;NXM
	SUB	T1,WINADR	;SUBTRACT ADDRESS OF BEGINNING OF WINDOW
	JUMPL	T1,DATRD2	;JUMP IF WINDOW PAST LOCATION
	CAIL	T1,WINSIZ	;SKIP IF IN CURRENT BLOCK
	JRST	DATRD2		;NO, READ UP TO IT
	SKIPA	T1,WINDOW(T1)	;GET WORD
DATRD1:	TLO	F,L.IEOF!L.NXM	;END OF FILE
	POPJ	P,		;AND EXIT
DATRD2:	ADD	T1,WINADR	;ADDRESS DESIRED
	LSH	T1,-7		;CONVERT TO BLOCK NUMBER
	USETI	IC,1(T1)	;SET TO READ THAT BLOCK
	LSH	T1,7		;RESET TO WORD ADDRESS OF BEGINNING OF BLOCK
	MOVEM	T1,WINADR	;AND REMEMBER THAT AS THE START OF THE WINDOW
	IN	IC,WINLST
	  JRST	DATRED
	PUSHJ	P,DATRED	;T1 _ WORD (MAY BE JUNK)
	JRST	READDE
;SUBROUTINE TO FIND A WORD IN A LOW OR SAVE FILE

FNDLOW:
FNDSAV:	TLNE	F,L.IOPN	;SKIP IF INPUT FILE NOT YET OPEN
	JRST	FNDSV1
	PUSHJ	P,OPNDMP	;OPEN INPUT FILE IN DUMP MODE
	PUSHJ	P,CATRW2	;SET UP FOR READING
FNDSV1:	MOVE	T1,TEMPAD	;ADDRESS DESIRED
	CAMGE	T1,WINADR	;SKIP IF NOT YET TO ADDR
	PUSHJ	P,SAVREW	;REWIND SAVE FILE
;	PJRST	CMPRED		;READ WORD FROM COMPRESSED FILE

;SUBROUTINE TO FIND A WORD IN A COMPRESSED FILE
;ARGS	T1=TEMPAD=ADDRESS OF WORD
;VALUES	T1=CONTENTS OF WORD
;	L.NXM BIT OF F SET IF NXM
;NOTE: CALL WITH T1 .GE. WINADR. CALL SAVREW OR CATREW AS NEEDED
;	TO MEET THIS RESTRICTION.

CMPRED:	SUB	T1,WINADR	;INDEX OF WORD RELATIVE TO CURRENT WINDOW
	CAIGE	T1,WINSIZ	;SKIP IF NOT IN WINDOW
	JRST	CMPRD1		;THE DESIRED WORD IS IN THE WINDOW
	PUSHJ	P,REDWIN	;READ NEXT WINDOW
	MOVE	T1,TEMPAD	;RESTORE ADDRESS DESIRED
	TLNN	F,L.IEOF	;SKIP IF NXM
	JRST	CMPRED		;LOOP TILL FIND PROPER WINDOW
	SUB	T1,WINADR	;INDEX OF WORD IN WINDOW
CMPRD1:	CAMLE	T1,WINLEN	;SKIP IF WORD REALLY CONTAINS DATA
RETNXM:	TLOA	F,L.NXM		;NO, PAST END OF DATA
	MOVE	T1,WINDOW(T1)	;RETURN WORD DESIRED
	POPJ	P,
FNDDDI:
FNDDEC:
FNDDMP:
FNDSDS:
	POPJ	P,
;SUBROUTINE TO FILL NEXT WINDOW

REDWIN:	MOVEI	T2,WINSIZ	;SIZE OF WINDOW
	MOVEM	T2,WINLEN	;ASSUME FULL WINDOW TO BE STORED
	ADDB	T2,WINADR	;NEW ADDRESS OF BEGINNING OF WINDOW
	SETZM	WINDOW
	MOVE	T1,[XWD WINDOW,WINDOW+1]
	BLT	T1,WINDOW+WINSIZ-1 ;CLEAR WINDOW TO START
REDWN1:	SKIPGE	T3,CURIOW	;SKIP IF OLD IOWD EXHAUSTED
	JRST	REDWN2
	PUSHJ	P,READDM	;READ NEXT IOWD
	MOVEM	T1,CURIOW	;SAVE IOWD
	JUMPL	T1,REDWN1	;JUMP IF REAL IOWD
	SUB	T2,WINADR	;T2=ADDR IN WINDOW OF LAST WORD STORED
	MOVEM	T2,WINLEN
	TLO	F,L.IEOF	;NOTE END OF INPUT FILE
	POPJ	P,
REDWN2:	MOVEI	T1,1(T3)	;T1=ADDR OF NEXT PIECE FROM FILE
	HRRZ	T2,T3
	CAIE	T2,-1		;SKIP IF ADDR = -1
	JRST	REDWN5		;OK
	AOSN	T3		;AOBJP WORKS FUNNY BECAUSE OF OVERFLOW
	SOSA	T3		;BUT IF WAS -1 POP LOSES
	POP	T3,T2		;SO MAKE IT COME OUT RIGHT AFTER FIRST
REDWN5:	MOVE	T2,WINADR	;ADDRESS OF FIRST LOCATION IN WINDOW
	SUBM	T1,T2		;T2=INDEX INTO WINDOW
	CAIL	T2,WINSIZ	;SKIP IF PIECE STARTS IN THIS WINDOW
	POPJ	P,		;NO, WINDOW IS BETWEEN PIECES, ALL ZERO
	HRLI	T2,-WINSIZ(T2)
REDWN3:	PUSHJ	P,READDM
	MOVEM	T1,WINDOW(T2)	;STORE NEXT WORD
	AOBJP	T3,REDWN4	;EXIT IF END OF PIECE FROM INPUT FILE
	AOBJN	T2,REDWN3	;LOOP TILL WINDOW FULL
	MOVEM	T3,CURIOW	;SAVE IOWD FOR REST OF PIECE FROM FILE
	POPJ	P,
REDWN4:	HRRZ	T2,T3		;T2=LAST ADDRESS STORED
	SETZM	CURIOW		;NOTE IOWD EXHAUSTED
	JRST	REDWN1		;GET NEXT PIECE
;SUBROUTINE TO REWIND A SAVE FILE
;SAVES T1

SAVREW:	MOVEM	T1,CURIOW	;SAVE T1, CURIOW CLOBBERED HERE ANYWAY
	USETI	IC,1		;SET TO READ FIRST BLOCK OF FILE
	SETZM	DMHEAD		;SET TO RECOMPUTE HEADER
	JRST	CATRW2		;FINISH UP

;SUBROUTINE TO REWIND THE CURRENT CATEGORY FOR DAEMON FILES

CATREW:	MOVEM	T1,CURIOW	;SAVE T1, CURIOW CLOBBERRED HERE ANYWAY
	MOVE 	T1,CATBLK	;BLOCK OF BEGINNING OF CATEGORY
	MOVEM	T1,DAECBK	;REMEMBER CURRENT BLOCK
	USETI	IC,(T1)
	INPUT	IC,INPLST
	HRRZ	T2,CATWRD
	MOVEM	T2,DAECWD	;REMEMBER CURRENT WORD IN BLOCK
CATRW1:	HRLS	T2
	ADD	T2,[XWD -200,IBUF]
	MOVEM	T2,DMHEAD
CATRW2:	MOVNI	T1,WINSIZ
	MOVEM	T1,WINADR
	MOVE	T1,CURIOW	;RESTORE T1
	SETZM	CURIOW		;NOTE NO IOWD READY
	TLZ	F,L.IEOF	;CLEAR EOF FLAG
	POPJ	P,
;SUBROUTINE TO READ NEXT WORD FROM INPUT FILE IN DUMP MODE

READDM:	TLNE	F,L.IEOF	;SKIP IF END OF FILE
	POPJ	P,
	AOS	DAECWD		;COUNT WORDS READ
	MOVE	T1,DMHEAD
	AOBJN	T1,READD1
	INPUT	IC,INPLST
	STATZ	IC,760000	;SKIP IF NO ERRORS
	JRST	READDE
	AOS	DAECBK
	SETZM	DAECWD
	MOVE	T1,[XWD -200,IBUF]
READD1:	MOVEM	T1,DMHEAD
	MOVE	T1,(T1)
	POPJ	P,

READDE:	GETSTS	IC,N
	TRNE	N,IO.EOF	;SKIP IF NOT END OF FILE
	JRST	READEO
	M.FAIO	<INPUT ERROR STATUS =>

READEO:	TLO	F,L.IEOF
	POPJ	P,
;SUBROUTINE TO OPEN THE INPUT FILE IN DUMP MODE

OPNDMP:	TLNE	F,L.IOPN	;SKIP IF NOT YET OPEN
	POPJ	P,		;ALREADY OPEN
	PUSHJ	P,.SAVE1##	;SAVE P1
	MOVE	P1,(DL)		;POINT TO SPEC
	PUSHJ	P,GETSPC	;GET STICKEY DEFAULTS
	MOVEI	T1,17		;DUMP MODE
	MOVE	T2,%DEV(DL)	;INPUT DEVICE
	SETZ	T3,
	OPEN	IC,T1
	  JRST	E.LKO		;NO SUCH DEVICE
	MOVE	T1,%NAM(DL)	;NAME OF INPUT FILE
	SETZB	T3,DMHEAD
OPNDM1:	MOVE	T2,%EXT(DL)	;EXTENSION
	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
	LOOKUP	IC,T1
	  JRST	OPNDM2		;TRY NULL EXTENSION IF NONE SPECIFIED
	HLRE	T1,T4		;T1=LENGTH OF FILE
	JUMPLE	T1,.+2		;JUMP IF WORDS
	LSH	T1,7		;CONVERT BLOCKS TO WORDS
	MOVMM	T1,CATLEN	;STORE +LENGTH OF FILE IN WORDS
	TLO	F,L.IOPN	;NOTE INPUT FILE OPEN
	HRLOI	T1,377777	;WE HAVE NEVER READ THE WINDOW
	MOVEM	T1,WINADR	; SO CAUSE US TO READ ON THE NEXT
				; TRY.
	POPJ	P,		;AND EXIT
OPNDM2:	MOVE	T4,%EXT(DL)
	TRNE	T4,-1		;SKIP IF NO EXT WAS SPECIFIED
	JRST	E.NSFI		;THERE WAS, CANT FIND FILE SPECIFIED
	HRLOM	T4,%EXT(DL)
	JRST	OPNDM1		;TRY NULL
;SUBROUTINE TO COMPUTE OFFSET FOR AN ADDRESS
;ARGS	T1=ADDRESS
;VALUES	T1=ADDRESS AFTER OFFSET

CMPOFF:	MOVN	T2,OFFLEN	;MINUS LENGTH OF OFFSET TABLE
	JUMPGE	T2,.POPJ	;NO CHANGE IF NO OFFSETS
	HRLZS	T2
	HRR	T2,OFFTAB	;MAKE AOBJN PTR TO OFFSET TABLE
CMPOF1:	HLRZ	T3,(T2)		;BEGINNING OF THIS OFFSET REGION
	HRRZ	T4,(T2)		;ENDING OF THIS REGION
	CAML	T1,T3		;SKIP IF ADDRESS NOT IN THIS REGION
	CAMLE	T1,T4		;SKIP IF ADDRESS IS IN THIS REGION
	JRST	CMPOF2		;NOT IN THIS REGION
	ADD	T1,1(T2)	;ADDRESS IS IN THIS REGION, OFFSET
	POPJ	P,		;EXIT
CMPOF2:	AOBJP	T2,.POPJ	;LOOK FOR NEXT REGION, EXIT IF NO MORE
	AOBJN	T2,CMPOF1	;JUMP IF MORE OFFSETS SPECIFIED
	POPJ	P,

;SUBROUTINE TO STORE A VALUE IN A TABLE
;ARGS	T1=VALUE
;	P1=BYTE POINTER TO BE INCREMENTED
;	P2=INDEX IN TABLE VECTOR

STOBYT:	PUSH	P,T1		;SAVE VALUE
	IBP	P1		;READY BYTE POINTER FOR STORING
	TLNE	P1,(@)		;IS INDIRECT BIT ON?
	HALT	.		;YES--BUG
	MOVEI	T1,(P1)		;ADDR TO STORE INTO
	SUB	T1,TABVEC(P2)	;-BEGINNING OF TABLE
	CAML	T1,LENVEC(P2)	;CURRENT LENGTH OF TABLE
	PUSHJ	P,TABEXP	;EXPAND TABLE
	POP	P,T1		;RESTORE VALUE
	DPB	T1,P1		;STORE VALUE
	POPJ	P,		;AND EXIT

;SUBROUTINE TO EXPAND TABLE TO BE BIG ENOUGH TO STORE VALUE
;ARGS	T1=SIZE NEEDED - 1
;	P2=INDEX IN TABLE VECTOR

TABEXP:	SUB	T1,LENVEC(P2)	;SUBTRACT CURRENT SIZE=NUM WORDS NEEDED-1
	AOJA	T1,GETCOR	;EXPAND CORE
;SUBROUTINE TO CLEAR INDIRECT BIT IN A BYTE POINTER
; NEEDED BECAUSE HARDWARE INCREMENTS THE ADDRESS IN THE
; POINTER AND WE WANT TO INCREMENT THE ADDRESS IT IS
; POINTING TO.
;ARGS:	P1=BYTE POINTER
;VALUE:	P1=BYTE POINTER (FOR SHORT USE)
;USES NO ACS
;
MKPNTR:	PUSH	P,P1	;SAVE OLD POINTER
	MOVEI	P1,@P1	;COMPUTE REAL ADDRESS
	HLL	P1,(P)	;GET POINTER PART
	TLZ	P1,37	;CLEAR INDEX AND INDIRECT
	POP	P,(P)	;CLEAR STACK
	POPJ	P,	;RETURN
	SUBTTL	SUBROUTINES FOR LISTING OUTPUT
;SUBROUTINE TO OUTPUT A VALUE
;ARGS	T1=VALUE
;	TABLES INCLUDE MODES, WIDTHS, JUSTIFY, ETC.

OUTPT:	MOVEM	T1,OUTVAL	;SAVE VALUE TO OUTPUT
	PUSHJ	P,OPNOUT	;MAKE SURE OUTPUT FILE OPEN
	SETZM	PADCNT		;CLEAR COUNT OF PAD BYTES
	TRZ	F,R.OVR!R.CNT!R.LFD!R.FFD ;CLEAR COUNT AND OVERFLOW BITS
	TLNE	F,L.AUTO	;SKIP IF AUTOFORM OFF
	TRO	F,R.CNT		;NOTE COUNTING
	HRLM	F,(P)		;SAVE HEADER BITS
OUTPTS:	PUSH	P,PAGNUM	;SAVE CURRENT PAGE NUMBER
	PUSH	P,CURCHR	;AND CHARACTER COUNTER
	PUSH	P,LINNUM	;AND LINE COUNTER, I.E. CURRENT CHAR POSITION
	PUSHJ	P,SETWJL	;SET UP WIDTH AND JUSTIFY LISTS
	TLNE	F,L.NXM		;NO SKIP IF NXM
	JRST	OUTNXM
	TLZ	DL,DL.NXM	;NO LONGER IN NXM.
	MOVE	P1,[POINT W.S,LPAD] ;POINTER TO TEMP LIST
	MOVEM	P1,LPAD.Y	;STORE FOR LATER
	MOVE	P1,M.Y		;BYTE POINTER FOR MODES LIST
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
	ILDB	T1,P1		;GET FIRST MODE
	CAIN	T1,M.END	;SKIP IF NOT END OF LIST
	JRST	OUTPTX		;END OF OUTPUT
	CAIE	T1,M.ALL	;SKIP IF ALL MODES REQUESTED
	JRST	OUTPT1		;OUTPUT VALUE IN THIS MODE
	MOVE	P1,[POINT M.S,MODLAL] ;POINTER TO LIST OF ALL MODES
	ILDB	T1,P1		;FIRST MODE
OUTPT1:	CAIN	T1,M.ALL
	JRST	OUTPTN		;DONT DO "ALL" HERE
	ROT	T1,-1
	MOVE	T2,MODADR(T1)	;GET ADDRESS OF ROUTINE FOR THIS MODE
	CAIL	T1,0		;SKIP IF ADDR IN RIGHT HALF
	MOVSS	T2		;ADDR IN LEFT HALF
	TLNE	DL,DL.WID	;SKIP IF NO MORE WIDTH SPECS
	TLNN	F,L.AUTO	;SKIP IF AUTO-FORMAT ON
	JRST	OTPT1A		;JUMP IF NOT AUTOFORMATTING WIDTHS
	ILDB	T4,WIDTMP	;GET A WIDTH SPEC.
	CAIN	T4,W.END	;SKIP IF NOT DONE
	JRST	OTPT1A		;DONE--NO MORE SPECS
	ADD	T4,CURCHR	;ADD IN CURRENT POSITION
	CAMLE	T4,RMARGN	;SKIP IF THIS WILL FIT
	TRO	F,R.OVR		;PUT WHOLE FIELD ON NEW LINE
OTPT1A:	TRNE	F,R.CNT		;ARE WE JUST COUNTING?
	JRST	OUTPT6		;YES--LIST IS EMPTY
	TRZE	F,R.OVR		;DO WE NEED A CRLF?
	PUSHJ	P,NEWLIN	;YES--GO DO IT PRIOR TO BLANKS
	MOVEI	C," "		;NO--SET UP A BLANK
	SOSL	T4,PADCNT	;SKIP IF NO COUNTS LEFT
	ILDB	T4,LPAD.Y	;T4 GETS NUMBER OF BLANKS TO STICK
				; ON THE FRONT OF THE BYTE TO LINE
				; IT UP IN THE FIELD.
	JUMPLE	T4,OUTPT6	;JUMP IF NONE REQUIRED
	PUSHJ	P,LCHR		;LIST A BLANK
	SOJG	T4,.-1		;LOOP FOR ALL WE NEED
OUTPT6:	PUSHJ	P,(T2)		;CALL ROUTINE TO OUTPUT VALUE IN THIS MODE
	TLNN	DL,DL.WID	;ARE THERE ANY WIDTH SPECS LEFT?
	JRST	OUTPT4		;NO--SKIP THE CHECKS
	LDB	T2,WIDTMP	;GET THE WIDTH
	CAIN	T2,W.END	;IS THIS THE END?
	JRST	[TLZ DL,DL.WID	;YES--CLEAR THE BIT
		 JRST OUTPT4]	;AND PUNT
	MOVE	T1,SAVCCH	;LOAD T1 WITH THE NUMBER OF CHARS
				; USED FOR DATA WHEN THAT FIELD WAS
				; PRINTED. THIS VALUE IS COMPUTED
				; IN ROUTINE FORMAT.
	SUB	T2,T1		; LESS WIDTH IS NUMBER OF BLANKS
				; TO ADD-ON
	TLNN	DL,DL.JUS	;ANY JUSTIFY KEYS LEFT?
	SKIPA	T1,[J.LFT]	;NO--ASSUME LEFT
	ILDB	T1,JUSTMP	;YES--GET THE KEY
	CAIN	T1,J.END	;IS THIS THE END
	JRST	[MOVEI T1,J.LFT ;YES--ASSUME LEFT
		 TLZ   DL,DL.JUS;CLEAR THE "WE HAVE A BYTE" BIT
		 JRST  .+1]	;CONTINUE
	JUMPLE	T2,OUTPT4	;JUMP IF NEED NO FILLERS
	TRNE	F,R.CNT		;ONLY COUNTING?
	JRST	OUTPT5		;YES--GE STORE FIXUP
	CAIN	T1,J.RHT	;NO--IS THIS RIGHT JUSTIFIED?
	JRST	OUTPT4		;YES--WE DID THAT
	CAIN	T1,J.CEN	;IS THIS CENTERED
	LSH	T2,-1		;YES--CENTER IT
	MOVEI	C," "		;SET UP A BLANK
	PUSHJ	P,LCHR		;PRINT IT
	SOJG	T2,.-1		;LOOP FOR AS MANY BLANKS AS WE NEED
	JRST	OUTPT4		;CONTINUE
OUTPT5:	CAIN	T1,J.LFT	;LEFT JUSTIFICATION?
	SETZ	T2,		;YES--NO LEADING BLANKS
	CAIN	T1,J.CEN	;IF WE NEED AN ODD NUMPER OF PADS
	AOS	T2		; CENTERING A FIELD PUT THE FREE
				; SPACE IN FRONT.
	CAIN	T1,J.CEN	;CENTER IT
	LSH	T2,-1		;YES--HALF LEAD ; HALF TRAIL
	IDPB	T2,LPAD.Y	;STORE AWAY
	AOS	PADCNT		;COUNT THE BYTE
OUTPT4:
OUTPTN:	ILDB	T1,P1		;NEXT MODE
	CAIN	T1,M.END	;SKIP IF NOT END OF MODES LIST
	JRST	OUTPTX		;END OF OUTPUT
	TLNN	DL,DL.WID	;IF WE HAVE A WIDTH LIST DO ADD SPACES
	PUSHJ	P,LSPC3		;OUTPUT 3 SPACES BETWEEN MODES
	JRST	OUTPT1
OUTNXM:	TLOE	DL,DL.NXM	;FLAG NXM
	JRST	OUTPTX		;STILL SAME BLOCK OF NXM
	MOVEI	M,[ASCIZ .<word is not in file>.]
	PUSHJ	P,LSTR		;OUTPUT NXM INDICATOR
	TRO	F,R.OVR			;NOTE LINE OVERFLOW
	TRNE	F,R.CNT		;ARE WE COUNTING?
	TLZ	DL,DL.NXM	;YES--CAUSE OUTPUT TO HAPPEN AGAIN
				; FOR REAL PRINTING

OUTPTX:	TRZN	F,R.CNT		;SKIP IF WERE COUNTING, NOT OUTPUTTING
	JRST	OUTPT3		;ACTUALLY OUTPUT, ALMOST DONE
OUTPT2:	POP	P,LINNUM	;RESET BEGINNING CHARACTER POSITION
	POP	P,CURCHR
	POP	P,PAGNUM
	MOVSI	T1,R.LHED	;RESTORE LINE HEADER BIT
	TDNE	T1,(P)
	TRO	F,R.LHED
	TRZ	F,R.OVR		;CLEAR OVERFLOW FLAG
	JRST	OUTPTS		;AND START OVER ACTUALLY OUTPUTTING

OUTPT3:	POP	P,T1		;IGNORE EARLIER CHAR POSITION
	POP	P,T1
	POP	P,T1
	TLNE	F,L.AUTO	;IF AUTOFORMAT OFF
	TRNN	F,R.OVR		;OR NO OVERFLOW,
	POPJ	P,		;ALL DONE
	PJRST	NEWLIN		;IF OVERFLOW AND AUTOFORMAT ON, CRLF
;SUBROUTINE TO SET UP WIDTH AND JUSTIFY LISTS

SETWJL:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	TLO	DL,DL.WID!DL.JUS;TRY TO FILL AND JUSTIFY
	MOVE	P1,J.Y		;BYTE POINTER TO JUSTIFY LIST
	PUSHJ	P,MKPNTR	;FIX @ BIT
	MOVEM	P1,JUSTMP	;SAVE FOR ILDB'ING
	MOVE	P1,W.Y		;BYTE POINTER TO WIDTH LIST
	PUSHJ	P,MKPNTR	;FIX @ BIT
	MOVEM	P1,WIDTMP	;SAVE FOR LATER
	POPJ	P,
MODALL==.POPJ
MODNUL==.POPJ

MODASC:	JSP	T4,FORMAT	;CHECK FOR LINE OVERFLOW
	MOVE	C,OUTVAL	;OUTPUT ASCII CHARACTER
	MOVEI	M,OUTVAL	;POINT TO OUTPUT VALUE
	TDNN	C,[<-1>_7]	;IS IT A SINGLE BYTE
	JRST	MODAS1		;YES PRINT AS ONE
	HRLI	M,440700	;NO--SET UP A POINTER
	MOVEI	T1,5		; FOR 5 CHARS
	ILDB	C,M		;GET A CHAR
	PUSHJ	P,MODAS1	;TYPE IT
	SOJG	T1,.-2		;LOOP FOR WHOLE WORD
	POPJ	P,		;RETURN
MODAS1:	CAIG	C,40		;CONTROL CHAR?
	MOVEI	C," "		;YES--PRINT A BLANK INSTAED
	PJRST	LCHR

MODSIX:	JSP	T4,FORMAT	;FORMAT THE LINE
	MOVE	T1,OUTVAL	;OUTPUT SIXBIT CHARACTER
	TDNN	T1,[<-1>_6]	;ONLY 1 CHAR?
	PJRST	LCHRS		;YES--LIST 1 CHAR
	MOVEI	T3,6	
	MOVE	T2,T1		;NO--LIST AS SIX SIXBIT
	PJRST	LSIXC		; LETTERS.

;OUTPUT OUTVAL AS A RADIX 50 SYMBOL

MODRAD:	JSP	T4,FORMAT	;LINE UP THE OUTPUT
	LDB	T1,[POINT 4,OUTVAL,3] ;GET PREFIX
	PUSHJ	P,$LOCT
	PUSHJ	P,LSPC
	MOVE	T1,OUTVAL	;GET THE RADIX 50 SYMBOL
$LRAD:	TLZ	T1,(17B3)	;CLEAR THE CODE BITS
MODR51:	IDIVI	T1,50		;WHY THEY CALL IT RADIX 50
	HRLM	T2,(P)		;SAVE REMAINDER
	JUMPE	T1,MODR52	;JUMP IF DONE
	PUSHJ	P,MODR51	;ELSE LOOP BACK
MODR52:	HLRZ	C,(P)		;GET A CHAR
	JUMPE	C,.POPJ		;PUNT IF NULL
	ADDI	C,257		;FIX UP
	CAILE	C,271
	ADDI	C,7
	CAILE	C,332
	SUBI	C,70
	CAIN	C,243
	MOVEI	C,256
	TLNN	DL,DL.TR5
	PJRST	LCHR
	MOVE	T1,C
	PJRST	.TCHAR##

MODOCT:	MOVE	T1,OUTVAL	;OUTPUT AS L,R
	PJRST	LXWD

MODDEC:	SKIPA	T2,[$LDEC]
MODSOC:	MOVEI	T2,$LOCT
	JSP	T4,FORMAT	;DON'T LET THE MINUS BE SPLIT
				; OVER LINE BOUNDARIES.
	MOVEI	C,"-"		;MINUS SIGN IN CASE NEGATIVE
	SKIPGE	OUTVAL		;SKIP IF POSITIVE
	PUSHJ	P,LCHR		;OUTPUT MINUS SIGN
	MOVM	T1,OUTVAL	;GET POSITIVE VALUE
	PJRST	(T2)		;AND OUTPUT IN PROPER RADIX

MODFLO:	MOVE	T1,OUTVAL	;OUTPUT FLOATING POINT NUMBER
	PJRST	LFLT


MODSYM:	TLNN	F,L.INST	;INSTRUCTION FORMAT?
	PJRST	MODOCT		;NO--DUMP AS OCTAL ***TEMP***
	JSP	T4,FORMAT	;MAKE LOOK NICE
	MOVE	T1,OUTVAL	;PUT IN   WORD
	PUSHJ	P,OPDEC		;LOOKUP IN TABLE
	  PUSHJ	P,INVOP		;MAKE SOME OPCODE
	MOVE	T2,N		;COPY OPCODE
	MOVEI	T3,6		;INCLUDE SPACES
	PUSHJ	P,LSIXC		;LIST THE OPCODE
PNTAC:	PUSHJ	P,LSPC		;LIST A SPACE
	MOVEI	FM,1		;HISTORIC CODE
	TLO	DL,DL.XCT	;EXACT MATCH
	LDB	T1,[POINT 4,OUTVAL,12] ;GET THE OPCODE
	LDB	T2,[POINT 3,OUTVAL,2] ;GET FIRST OCTAL DIGIT
	CAIN	T2,7		;SKIP IF NOT I/O
	LDB	T1,[POINT 9,OUTVAL,11] ;GET I/O DEVICE CODE
	CAIN	T2,7		;IS IT AN I/O INSTRUCTION
	TRZ	T1,3		;YES--CLEAR 2 JUNK BITS
	JUMPE	T1,ZEROAC	;IS AC=0?
	PUSHJ	P,$LSYM		;NO--LIST AS SYMBOL
	PUSHJ	P,LCOMMA	; FOLLOWED BY A COMMA
ZEROAC:	MOVSI	T1,(@)		;GET AN INDIRECT BIT
	MOVEI	C,"@"		; AND ITS SYMBOL
	TDNE	T1,OUTVAL	;IS @ BIT SET
	PUSHJ	P,LCHR		;YES--PRINT @
	HRRZ	T1,OUTVAL	;GET Y-ADDRESS
	MOVEI	FM,2		;HISTOY TABLE INDEX
	TLZ	DL,DL.XCT	;ALLOW OFFSET
	PUSHJ	P,$LSYM		;LIST AS SYMBOL
	LDB	T1,[POINT 4,OUTVAL,17] ;GET INDEX REG.
	JUMPE	T1,.POPJ	;JUMP IF ZERO
	MOVEI	FM,3		;CODE
	TLO	DL,DL.XCT	;LIGHT THE EXACT MATCH BIT
	MOVEI	C,"("		;ELSE PRINT IN (
	PUSHJ	P,LCHR		;GO LIST
	PUSHJ	P,$LSYM		;AND SYMBOL
	MOVEI	C,")"		;ADD )
	PJRST	LCHR		;GO ADD IT--THEN POPJ
INVOP:	MOVE	T1,OUTVAL	;GET THEWORD TO OUTPUT
	TDZ	T1,[777,,-1]	;CLEAR OUT JUNK
	JUMPE	T1,ZEROP	;GIVE A Z IF ZERO
	CAMN	T1,OLDVAL	;SAME AS OLD VALUE?
	JRST	OLDOP		;YES--REMEMBER THAT BACK
	MOVEM	T1,OLDVAL	;RECALL LAST ARGUMENT
	PUSHJ	P,VAL2SY	;SCAN THE SYMBOL TABLE
	  TLOA	T2,(1B0)	;NO MATCH
	MOVEM	T1,OLDSYM	;SAVE THE SYMBOL
	MOVEM	T2,SYMOFF	;SAVE THE OFFSET
OLDOP:	MOVE	T1,SYMOFF	;GET THE OLD OFFSET
	JUMPN	T1,ZEROP	;JUMP IF NOT EXACT
	MOVE	T1,OLDSYM	;FETCH SYMBOL
	MOVEI	N,PNTAC		;HERE WE DO A NONO AND FUDGE THE STACK
	MOVEM	N,(P)		;SO WE CAN PRINT THE AC AND RETURN TO
	PJRST	$LRAD		;OP DECODER.
ZEROP:	LDB	T1,[POINT 9,OUTVAL,8] ;GET OPCODE
	MOVSI	N,'Z  '		;ASSUME ZERO
	JUMPE	T1,.POPJ	;JUMP IF GOOD GUESS
	LDB	T1,[POINT 3,OUTVAL,2]
	IORI	N,20(T1)	;FILL IN OCTAL DIGIT
	LSH	N,6		;GET READY FOR NEXT
	LDB	T1,[POINT 3,OUTVAL,5]
	IORI	N,20(T1)	;FILL IN NEXT DIGIT
	LSH	N,6		;GET READY FOR LAST
	LDB	T1,[POINT 3,OUTVAL,8]
	IORI	N,20(T1)	;PUT IN DIGIT 3
	HRLI	N,'UUO'		;ADD UUO
	POPJ	P,0		;RETURN
;$LSYM -- PRINT A SYMBOL
;CALL WITH:
;	T1=VALUE TO PRINT
;RETURNS NON-SKIP HAVING PRINTED SOMETHING

$LSYM:	JUMPE	T1,.POPJ	;DO NOT TYPE ZEROS
	CAMN	T1,OLDVAL(FM)	;SAME ARGUMENT?
	JRST	LSYM2		;YES--GIVE SAME ANSWER
	MOVEM	T1,OLDVAL(FM)	;NO--SAVE FOR NEXT TRY
	PUSHJ	P,VAL2SY	;CONVERT VALUE
	  TLOA	T2,(1B00)	;IT IS A NUMBER
	TLZ	T2,(1B00)	;IT IS A SYMBOL
	MOVEM	T1,OLDSYM(FM)	;STORE ANSWER
	JUMPE	T2,LSYM1	;JUMP IF EXACT MATCH
	TLNE	DL,DL.XCT	;DO WE NEED AN EXACT MATCH
	TLO	T2,(1B0)	;YES--FORCE NUMERIC MODE
LSYM1:	MOVEM	T2,SYMOFF(FM)	;SYMBOL ERROR
LSYM2:	SKIPGE	T2,SYMOFF(FM)	;SKIP IF SYMBOLIC
	JRST	[MOVE T1,OLDVAL(FM) ;RELOAD THE NUMERIC VALUE
		 JRST $LNBR]	;LIST AS A NUMBER
	MOVE	T1,OLDSYM(FM)	;GET LAST ANSWER
	PUSHJ	P,$LRAD		;NO-PRINT SYMBOL
	SKIPN	T1,SYMOFF(FM)	;IS THERE AN OFFSET
	POPJ	P,		;NO--ALL DONE
	MOVEI	C,"+"		;NO--PRINT A PLUS
	PUSHJ	P,LCHR		; ..
	PJRST	$LNBR		;TYPE IN O RADIX
MODSMA:	;IF INSTRUCTION, ELSE ...
	POPJ	P,


MODNUM: MOVE	T1,OUTVAL	;PICK UP VALUE TO BE OUTPUT
	PJRST	LRDX		; AND LIST IN CURRENT RADIX
;SUBROUTINE TO START NEW LINE FOR OUTPUT
;ARGS	R.CON1 BIT OF F=1 IF DUMPING CONTENTS
;SAVES T1

NEWLIN:	PUSHJ	P,LCRLF		;NEW LINE
	PJRST	NEWPGX

;SUBROUTINE TO OUTPUT PAGE EJECT AND REQUEST PAGE HEADER

NEWPAG:	PUSHJ	P,LEJECT	;OUTPUT PAGE EJECT
	TRO	F,R.PHED	;REQUEST PAGE HEADER
NEWPGX:	TRO	F,R.LHED	;REQUEST ADDRESS TO BE TYPED
	POPJ	P,
	SUBTTL OUTPUT SUBROUTINES

;SUBROUTINE TO OPEN OUTPUT FILE

OPNOUT:	TLNE	F,L.OOPN	;SKIP IF OUTPUT FILE NOT YET OPEN
	POPJ	P,
	PUSHJ	P,.SAVE1	;SAVE P1
	MOVEI	P1,O.DEV	;POINT TO OUTPUT SPEC
	PUSHJ	P,GETSPC	;COPY STICKEY DEFAULTS
	SETZM	LINNUM		;CLEAR LINE COUNT
	SETZ	T1,		;ASCII MODE
	MOVE	T2,O.DEV	;OUTPUT DEVICE
	MOVE	T4,T2		;REMEMBER OUTPUT DEVICE FOR DEVCHR
	MOVSI	T3,B.OC		;BUFFER HEADER
	OPEN	OC,T1		;OPEN OUTPUT DEVICE
	  JRST	E.LKO		;CANT OPEN OUTPUT
	DEVCHR	T4,		;GET CHARACTERISTICS OF OUTPUT DEVICE
	TLNE	T4,DV.TTY	;SKIP IF NOT A TTY
	TLO	F,L.OTTY	;NOTE TTY SO WILL CLOSE AFTER EACH DUMP
	PUSH	P,.JBFF		;SAVE CURRENT .JBFF
	MOVEI	T1,OBUF
	MOVEM	T1,.JBFF
	OUTBUF	OC,1		;DECLARE 1 OUTPUT BUFFER
	POP	P,.JBFF		;AND RESET .JBFF
	PUSH	P,P1
	MOVEI	P1,FBMTIM	;TIMES TO RETRY IF FILE BEING MODIFIED
	PUSH	P,DL		;SAVE DL ON STACK
OPNOU1:	MOVE	T1,O.NAM	;OUTPUT FILE
	HLLZ	T2,O.EXT	;EXT
	SETZ	T3,		;STANDARD PROTECTION
	HRRI	DL,O.DEV	;POINT TO OUTPUT SPEC
	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
	TRO	F,R.LKF		;ASSUME LOOKUP WILL FAIL
	TLNE	F,L.APP		;SKIP IF SUPERSEDE, NOT IF APPEND
	LOOKUP	OC,T1		;APPEND, TRY LOOKUP
	  JRST	OAPP1		;SUPERSEDE OR LOOKUP FAILED
	TRZ	F,R.LKF		;LOOKUP OK
OAPP1:	PUSHJ	P,SETPTH	;SET UP PATH OR PPN IN T4
OSUPER:	ENTER	OC,T1
	 JRST	OSUPE
	HRR	DL,(P)		;RESTORE RH(DL)
	POP	P,P1		;FIX STACK
	POP	P,P1		;RESTORE P1
	HLRE	T1,T4		;CURRENT LENGTH OF OUTPUT FILE
	JUMPGE	T1,OSUP1	;JUMP IF BLOCKS
	MOVNS	T1		;MAKE POSITIVE WORDS
	ADDI	T1,177
	LSH	T1,-7		;CONVERT TO BLOCKS
OSUP1:	TRNN	F,R.LKF		;SKIP IF SUPERSEDE OR LOOKUP FAILED
	USETO	OC,1(T1)	;SET TO START WRITING
	TLO	F,L.OOPN	;NOTE OUTPUT FILE OPEN
	POPJ	P,
OSUPE:	SOJLE	P1,E.NSFO	;EXIT IF STILL BUSY
	HRRZ	T4,T2		;ERROR CODE
	CAIE	T4,EC.FBM	;SKIP IF FILE BEING MODIFIED
	JRST	E.NSFO		;NO, SOME OTHER PROBLEM
	MOVEI	T4,1
	SLEEP	T4,		;SLEEP 1 SECOND
	JRST	OPNOU1		;AND TRY AGAIN


;SUBROUTINE TO SET UP T4 AS A PPN IF NO SFD SPECIFIED OR A POINTER
; TO THE PATH IF NEEDED.
;USES NO ACS

IFG LN.DRB-1,<			;IF WE HAVE SFD'S
SETPTH:	MOVE	T4,%DIR(DL)	;SET UP T4 IN CASE
	SKIPN	%DIR+2(DL)	;NEED A PATH?
	POPJ	P,		;NO--RETURN
	PUSHJ	P,.SAVE2	;SAVE P1-P2
	MOVSI	P1,-LN.DRB*2	;NUMBER OF BIWORDS
	MOVEI	P2,PATH+1	;WHERE TO PUT PATH
STPTH1:	MOVE	T4,(P1)		;PICH UP DIRECTORY WORD
	PUSH	P2,T4		;STORE IN PATH
	AOBJP	P2,.+2		;SKIP OVER THE MASK
	AOBJN	P2,STPTH1	;LOOP FOR MORE
	MOVEI	T4,PATH		;POINT TO PATH
	POPJ	P,		;RETURN
>

IFLE LN.DRB-1,<
	MOVE	T4,%DIR(DL)	;GET PPN
	POPJ	P,		;RETURN
>
;LFLT -- LIST WORD AS FLOATING POINT NUMBER
;CALL:	MOVE	T1,WORD
;	PUSHJ	P,LFLT

LFLT:	POPJ	P,

;LXWD -- LIST WORD IN XWD FORMAT (N,N)
;CALL:	MOVE	T1,WORD
;	PUSHJ	P,LXWD
;USES T1, T2, T3, C

LXWD:	JSP	T4,FORMAT	;LINE UP THE OUTPUT
	MOVE	T2,[POINT 3,T1]	;BYTE POINTER TO NUMBER
	MOVEI	T3,^D12		;12 DIGITS IN A WORD
LXWD1:	ILDB	C,T2		;GET A DIGIT
	ADDI	C,60		;MAKE ASCII
	PUSHJ	P,LCHR		;TYPE THE DIGIT
	CAIN	T3,7		;HALF WAY POINT?
	PUSHJ	P,LCOMMA	;TYPE A COMMA
	SOJG	T3,LXWD1	;LOOP FOR WHOLE WORD
	POPJ	P,		;RETURN



;LDATE -- OUTPUT DATE IN FORM DD-MMM-YY
;CALL:	MOVE	T4,DATE IN SYSTEM FORMAT
;	PUSHJ	P,LDATE
;USES T1, T2, T3, T4,  M, C

LDATE:	PUSH	P,T4+1
	IDIVI	T4,^D31		;GET DAY
	MOVEI	T1,1(T4+1)
	PUSHJ	P,LDEC2
	IDIVI	T4,^D12		;GET MONTH

	MOVE	T1,[ASCII /-Jan--Feb--Mar--Apr--May--Jun--Jul--Aug--Sep--Oct--Nov--Dec-/](T4+1)
	POP	P,T4+1
	MOVEI	T2,0
	MOVEI	M,T1
	PUSHJ	P,LSTR
	MOVEI	T1,^D64(T4)	;GET YEAR
	PJRST	LDEC2Z		;OUTPUT YEAR AND RETURN
;LTIME -- OUTPUT TIME IN FORM HH:MM
;CALL:	MOVE	T4,TIME IN MINUTES
;	PUSHJ	P,LTIME
;USES T1, T2, T3, T4, T5, C

LTIME:	PUSH	P,T4+1		;SAVE T5 (WHICH IS P1)
	IDIVI	T4,^D60		;GET HOURS
	MOVE	T1,T4
	PUSHJ	P,LDEC2		;LIST HOURS
	MOVEI	C,":"
	PUSHJ	P,LCHR
	MOVE	T1,T4		;LIST MINUTES
	POP	P,T4+1		;RESTORE T5
				;FALL INTO LDEC2Z

;LDEC2Z -- LIST DECIMAL AT LEAST 2 DIGITS WITH LEADING ZERO
;CALL:	MOVEI	T1,NUMBER
;	PUSHJ	P,LDEC2Z
;USES T1, T2, T3, C

LDEC2Z:	MOVEI	C,"0"		;SETUP TO PRINT 0 IN CASE NEEDED
	CAIGE	T1,^D10		;TEST TO SEE IF NEEDED
	PUSHJ	P,LCHR		;YES--SEND IT
	PJRST	LDEC		;GO FINISH WORK



;LSTDC2 -- LIST MESSAGE, DECIMAL NUMBER, AND TWO SPACES
;CALL:	MOVEI	M,MESSAGE
;	MOVE	T1,NUMBER
;	PUSHJ	P,LSTDC2
;USES T1, T2, T3, M, C

LSTDC2:	PUSHJ	P,LSTR		;LIST THE MESSAGE
	PUSHJ	P,LDEC		;LIST THE DECIMAL NUMBER
	PJRST	LSPC2		;LIST THE TWO SPACES AND RETURN
;LDEC4 -- LIST DECIMAL AT LEAST FOUR DIGITS
;LDEC3 -- LIST DECIMAL AT LEAST THREE DIGITS
;LDEC2 -- LIST DECIMAL AT LEAST TWO DIGITS
;CALL:	MOVEI	T1,NUMBER
;	PUSHJ	P,LDEC2
;USES T1, T2, T3, C

LDEC4:	CAIGE	T1,^D1000	;SEE IF NEEDED
	PUSHJ	P,LSPC
LDEC3:	CAIGE	T1,^D100
	PUSHJ	P,LSPC
LDEC2:	CAIGE	T1,^D10
	PUSHJ	P,LSPC		;YES
				;FALL INTO LDEC

;LDEC -- LIST DECIMAL NUMBER
;LOCT -- LIST OCTAL NUMBER
;LRDX -- LIST VIA PRESET RADIX
;CALL:	MOVEI	T1,NUMBER
;      (MOVEI	T3,RADIX    LRDX ONLY)
;	PUSHJ	P,LDEC/LOCT/LRDX
;USES T1, T2, T3, C

LDEC:	MOVEI	T3,^D10		;INITIALIZE FOR DECIMAL RADIX
	JRST	LRDX1
LRDX:	SKIPA	T3,ORADIX	;INITIALIZE FOR CURRENT OUTPUT RADIX
LOCT:	MOVEI	T3,10		;INITIALIZE FOR OCTAL RADIX
LRDX1:	JSP	T4,FORMAT	;TAKE CARE OF FORMATING
	JRST	$LRDX		;OUTPUT

$LNBR:	MOVE	T3,ORADIX	;PICK UP OUTPUT RADIX
	JRST	$LRDX		;PRINT
$LDEC:	SKIPA	T3,[^D10]	;INITIALIZE FOR DECIMAL
$LOCT:	MOVEI	T3,10		;INITIALIZE FOR OCTAL RADIX
$LRDX:	MOVEI	C,"-"		;IN CASE -VE
	SKIPGE	T1		;SKIP IF POSITIVE
	PUSHJ	P,LCHR		;ELSE PRINT THE MINUS
	CAMN	T1,[1B0]	;JUST THE SIGN BIT?
	AOS	T1		;YES--MAKE LARGER
	MOVM	T1,T1		;MAKE T1 POSITIVE
$LRDX1:	IDIV	T1,T3		;DIVIDE BY RADIX
	HRLM	T2,(P)		;SAVE REMAINDER
	SKIPE	T1		;SEE IF ANYTHING LEFT
	PUSHJ	P,$LRDX1	;YES--LOOP BACK WITH PD LIST
	HLRZ	C,(P)		;GET BACK A DIGIT
	ADDI	C,"0"		;CONVERT TO ASCII
	PJRST	LCHR		;GO LIST IT
;LCRLF3 - LIST END OF LINE AND 2 BLANKS
;LCRLF2 - LIST END OF LINE AND 1 BLANK LINE

LCRLF3:	PUSH	P,LMARGN	;SAVE LEFT MARGIN FOR NOW
	SETZM	LMARGN		;CLEAR SO WONT WRITE SPACES
	PUSHJ	P,LCRLF		;NEW LINE
	JRST	LCRL2A		;AND ANOTHER NEW LINE
LCRLF2:	PUSH	P,LMARGN	;SAVE LEFT MARGIN FOR NOW
	SETZM	LMARGN		;;CLEAR SO WONT WRITE SPACES
LCRL2A:	PUSHJ	P,LCRLF		;NEW LINE
	POP	P,LMARGN	;RESTORE LEFT MARGIN

;LCRLF - LIST END OF LINE
;CALL:	PUSHJ	P,LCRLF
;USES M, C

LCRLF:	TRZ	F,R.LTAB	;CLEAR TAB MEMORY
	MOVEI	M,[ASCIZ /
/]
	JRST	$LSTR

;LSTR - LIST ASCII STRING
;CALL:	MOVEI	M,STRING (END WITH 0 BYTE)
;	PUSHJ	P,LSTR
;USES M, C

LSTR:	JSP	T4,FORMAT
$LSTR:	TLOA	M,440700		;CONVERT TO BYTE POINTER
LSTR1:	PUSHJ	P,LCHR		;OUTPUT CHARACTER
	ILDB	C,M		;GET NEXT CHARACTER
	JUMPN	C,LSTR1		;LOOP UNLESS NULL
	POPJ	P,		;RETURN


;LSIXT -- LIST SIXBIT WORD FOLLOWED BY TAB
;CALL:	MOVE	T2,WORD
;	PUSHJ	P,LSIXT
;USES T1, T2, C

LSIXT:	PUSHJ	P,LSIXN		;OUTPUT WORD
	PJRST	LTAB		;GO OUTPUT TAB AND RETURN
;LSIX  -- LIST SIXBIT WORD (AT LEAST ONE SPACE)
;LSIXN -- SAME EXCEPT 0 GIVES NO SPACES
;CALL:	MOVE	T2,WORD
;	PUSHJ	P,LSIX/LSIXN
;USES T1, T2, C

LSIX:	MOVEI	T1,0		;CLEAR NEXT CHARACTER
	LSHC	T1,6		;FETCH NEXT CHAR
	PUSHJ	P,LCHRS		;LIST IT IN SIXBIT

LSIXN:	JUMPN	T2,LSIX		;LOOP UNTIL ONLY BLANKS LEFT
	POPJ	P,		;RETURN


;LSIXC -- LIST SIXBIT WORD FIXED NUMBER OF CHARACTERS
;CALL:	MOVE	T2,WORD
;	MOVEI	T3,NUM CHARS TO PRINT
;	PUSHJ	P,LSIXC
;USES T1, T2, T3, C

LSIXC:	MOVEI	T1,0		;CLEAR NEXT CHAR
	LSHC	T1,6		;GET NEXT CHAR
	PUSHJ	P,LCHRS		;LIST IT IN SIXBIT
	SOJG	T3,LSIXC	;LOOP UNTIL DONE
	POPJ	P,		;RETURN


;LSPC3 -- LIST THREE SPACES
;LSPC2 -- LIST TWO SPACES
;CALL:	PUSHJ	P,LSPC2
;USES C

LSPC3:	PUSHJ	P,LSPC		;DO ONE
LSPC2:	PUSHJ	P,LSPC		;DO ONE
	PJRST	LSPC		;DO ANOTHER AND RETURN
;SUBROUTINE TO TAKE CARE OF OVERFLOWING LINE OR PAGE
;SAVES	P1, P2

FORMAT:	TROE	F,R.NORE	;SKIP IF NOT ALREADY IN THIS SUBROUTINE
	JRST	(T4)		;DONT RECURSE, JUST PASS THROUGH
	MOVEM	M,SAVEM		;SAVE AC'S
	MOVE	M,[XWD T1,SAVET1]
	MOVEM	F,SAVEF		;SAVE F
	BLT	M,SAVEP2
	TRZ	F,R.SCNT	;ASSUME COUNT BIT OFF
	TROE	F,R.CNT		;SAVE OLD COUNT BIT, SET IT FOR NOW
	TRO	F,R.SCNT	;COUNT BIT WAS ON
	MOVE	P2,SAVEP2
	PUSH	P,PAGNUM	;SAVE CURRENT CHARACTER POSITION
	PUSH	P,LINNUM
	PUSH	P,CURCHR
	PUSHJ	P,FORMT2	;MAKE WIDTH AND JUSTIFY WORK
	MOVN	M,CURCHR	;STORE THE CURRENT CHAR. POSITION
	MOVEM	M,SAVCCH	; NEGATED, IN SAVCCH
	MOVE	M,SAVEM		;RESTORE M
	PUSHJ	P,(T4)		;CALL ROUTINE TO COUNT CHARS TO BE OUTPUT
	MOVEI	T2,NEWLIN
	MOVE	T1,CURCHR	;NEW CHARACTER POSITION
	ADDM	T1,SAVCCH	;SAVCCH := WIDTH OF PRINTED FIELD
	CAMLE	T1,RMARGN	;SKIP IF NOT YET PAST RIGHT MARGIN
	PUSHJ	P,FORMFX	;OUTPUT CRLF FIRST
	MOVEI	T2,NEWPAG
	MOVE	T1,LINNUM	;NEW LINE NUMBER
	CAMLE	T1,LINPAG	;SKIP IF NOT YET PAST END OF PAGE
	PUSHJ	P,FORMFX	;OUTPUT PAGE EJECT FIRST
	POP	P,CURCHR
	POP	P,LINNUM
	POP	P,PAGNUM
	MOVE	T1,SAVEF
	ANDI	T1,R.LHED!R.PHED ;REMEMBER HEADER BITS
	IOR	F,T1
	TRZE	F,R.SCNT	;SKIP IF WAS SUPPOSED TO OUTPUT
	JRST	FORMT1		;NO, JUST COUNT CHARS, LEAVE COUNT BIT ON
	TRZ	F,R.CNT		;YES, TURN OFF COUNT BIT
	PUSHJ	P,FORMF1	;OUTPUT IT
FORMT1:	MOVE	P1,SAVEP1	;RESTORE P1-P2
	MOVE	P2,SAVEP2
	TRZ	F,R.NORE
	POPJ	P,		;EXIT

FORMT2:	TRNN	F,R.LHED!R.PHED	;DO WE WANT TO PRINT HEADERS
	POPJ	P,		;NO--RETURN
	MOVEI	C,200		;FLAG TO GENERATE HEADER
	PJRST	LCHR		;GO DO IT
FORMFX:	TRNN	F,R.SCNT	;SKIP IF ONLY COUNTING
	TRZ	F,R.CNT		;NO, CLEAR COUNT BIT
	POP	P,T1		;SAVE RETURN FROM SUBROUTINE
	POP	P,CURCHR	;RESTORE ORIGINAL CHARACTER POSITION
	POP	P,LINNUM
	POP	P,PAGNUM
	PUSH	P,T1		;RESTORE RETURN FROM SUBROUTINE
	TRZ	F,R.LHED!R.PHED	;DONT WANT LINE OR PAGE HEADER HERE
	PUSHJ	P,(T2)		;CALL APPROPRIATE ROUTINE
	MOVE	T1,F		;REMEMBER HEADER BITS
	ANDI	T1,R.PHED!R.LHED
	IORM	T1,SAVEF	;SAVE FOR ROUTINE EXIT
	TRO	F,R.CNT
	POP	P,T1		;SAVE RETURN FROM SUBROUTINE
	PUSH	P,PAGNUM
	PUSH	P,LINNUM
	PUSH	P,CURCHR
	PUSH	P,T1		;RESTORE RETURN FROM SUBROUTINE
FORMF1:	MOVE	M,[XWD SAVET1,T1]
	BLT	M,P2		;RESTORE ORIGINAL AC'S
	MOVE	M,SAVEM
	PJRST	(T4)		;CALL OUTPUT ROUTINE

LEJECT:	MOVEI	C,C.FF
	PJRST	LCHR
;LCRT -- LIST A CARRAGE RETURN
;LTAB -- LIST TAB
;LSPC -- LIST SPACE
;LCHR -- LIST CHARACTER
;LCHRS-- LIST SIXBIT CHARACTER
;CALL:	(MOVEI	C,CHARACTER    IF LCHR)
;	(MOVEI	T1,CHARACTER IF LCHRS)
;	PUSHJ	P,LTAB/LSPC/LCHR
;USES C EXCEPT LCHR USES NO AC'S

LCRT:	MOVEI	C,.CHCRT
	PJRST	LCHR1
LCOMMA:	SKIPA	C,[","]		;LOAD A COMMA
LCHRS:	MOVEI	C," "-' '(T1)	;CONVERT TO ASCII AND MOVE TO C
LCHR:	JUMPE	C,.POPJ			;DO NOT PRINT NULLS
	CAIE	C,"	"		;SEE IF A TAB
	JRST	LCHR1		;NO--GO SEND IT

LTAB:	TRON	F,R.LTAB	;SET/TEST TAB
	POPJ	P,		;RETURN IF NOT TWO IN A ROW

LTAB1:	SKIPA	C,["	"]	;GET THE TAB
LSPC:	MOVEI	C," "		;GET THE SPACE
LCHR1:	TRZE	F,R.LTAB	;CLEAR TAB MEMORY
	JRST	LCHR3		;IF SET, GO ISSUE ONE
	TRZE	F,R.PHED	;SKIP IF DONT WANT PAGE HEADER
	PUSHJ	P,PHEAD		;OUTPUT PAGE HEADER
	TRZE	F,R.MARS	;SKIP IF DONT NEED LEFT MARGIN SPACES
	PUSHJ	P,MARSPC	;OUTPUT SPACES FOR LEFT MARGIN
	TRZE	F,R.LHED	;SKIP IF DONT WANT ADDR TYPED
	PUSHJ	P,LHEAD		;OUTPUT ADDR AS LINE HEADER
	TRZE	F,R.LTAB	;SEE IF LHEAD GOT US INTO A BAD STATE
	JRST	LCHR3		; AND IF IT DID CLEAN UP.
	CAIN	C,200		;SPECIAL FLAG?
	POPJ	P,		;YES--QUIT NOW
	JUMPE	C,LCHR6		;JUMP IF NULL
	CAIL	C,40		;SKIP IF NON-GRAPHIC
	JRST	LCHR5		;OK
	PUSH	P,T1
	MOVEI	T1,7		;PREPARE FOR POSSIBLE TAB
	CAIN	T1,.CHTAB	;IS IT A TAB
	IORM	T1,CURCHR	;YES--FORCE TO A TAB STOP
	MOVEI	T1,1
	LSH	T1,-1(C)	;POSITON BIT FOR CHAR
	TDNE	T1,FORMCH	;SKIP IF NOT LEGAL FORM CHAR
	JRST	LCHR4		;OK, OUTPUT CHAR AS IS
	PUSH	P,C		;SAVE CHAR
	MOVEI	C,"^"		;NO, FLAG AS CONTROL LETTER
	PUSHJ	P,LCHR
	POP	P,C
	ADDI	C,100		;AND MAKE GRAPHIC
LCHR4:	POP	P,T1
LCHR5:	AOS	CURCHR		;COUNT CHARS ON THIS LINE
LCHR6:	TRNE	F,R.CNT		;SKIP IF ACTUALLY OUTPUTTING
	JRST	LNOWRT		;NO, ONLY COUNTING, DONT OUTPUT
	SOSG	B.OC+2		;SEE IF ROOM IN THE BUFFER
	JRST	LCHRW		;NO--GO WRITE THIS BUFFER
LCHR2:	TLNE	F,L.OTTY	;IS OUTPUT TO TTY: ?
	TLZ	F,L.TDMP	;YES--MAKE TDUMP=DUMP
	TLNE	F,L.TDMP	;DOES HE WANT IT ON HIS TTY ALSO?
	OUTCHR	C		;YES--DO THAT TOO
	IDPB	C,B.OC+1	;YES--SEND CHARACTER
LNOWRT:	CAIL	C,C.LF		;SKIP IF NOT END OF LINE CHAR
	CAILE	C,C.CR		;SKIP IF END OF LINE CHAR
	POPJ	P,
	TRO	F,R.MARS	;NOTE NEED FOR SPACES FOR LEFT MARGIN
	SETZM	CURCHR		;RESTART CHAR COUNTER
	CAIN	C,C.LF		;SKIP IF NOT LINE FEED
	AOS	LINNUM		;YES, COUNT 1 LINE
	CAIN	C,C.FF		;SKIP IF NOT PAGE EJECT
	SETZM	LINNUM
	MOVEI	T1,		;INCREMENT FOR VT
	CAIN	C,C.VT		;SKIP IF VERTICAL TAB
	ADDM	T1,LINNUM
	POPJ	P,		;RETURN

LCHR3:	PUSH	P,C		;SAVE REQUESTED CHARACTER
	PUSHJ	P,LTAB1		;SEND A TAB
	POP	P,C		;RESTORE CHARACTER
	JRST	LCHR1		;PROCEED
PHEAD:	SKIPE	LINNUM		;TOP OF FORM?
	POPJ	P,		;NO--SHOULD NOT GET HERE
	PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
	TRZE	F,R.LHED	;SKIP IF LINE HEADER NOT NEEDED
	TRO	F,R.RLH		;REMEMBER THAT BIT
	PUSHJ	P,LCRT		;LIST THE <CR>
	SKIPE	T1,PAGNUM	;SKIP IF NOT NUMBERING PAGES
	JRST	NEWPG1		;NUMBERING, T1=CURRENT PAGE NUMBER
	TLNN	F,L.TITL	;SKIP IF TITLE SPECIFIED
	JRST	NEWPG6		;NO TITLE LINE
NEWPG1:	MOVEI	C,1
	IDIVI	T1,^D10
	JUMPE	T1,.+2
	AOJA	C,.-2		;COUNT CHARS FOR PAGE NUMBER
	ADDI	C,7		;PLUS <SPACE>PAGE<SPACE><SPACE>
	MOVE	T1,RMARGN	;RIGHT MARGIN
	SUB	T1,LMARGN	;MINUS LEFT MARGIN=CHARS LEFT FOR TITLE+PAGE NUM
	SUB	T1,C		;MINUS CHARS FOR PAGE NUM=CHARS FOR TITLE
	JUMPLE	T1,NEWPG5	;JUMP IF NO ROOM FOR TITLE
	SKIPN	TITLEN		;SKIP IF NON-NULL TITLE
	JRST	NEWPG4		;NO TITLE
	MOVE	P1,TIT.Y	;BYTE POINTER FOR TITLE
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
NEWPG3:	ILDB	C,P1		;NEXT CHAR OF TITLE
	CAIN	C,TIT.EN	;SKIP IF NOT END OF TITLE
	JRST	NEWPG4
	PUSHJ	P,LCHR		;OUTPUT THE CHAR
	SOJG	T1,NEWPG3	;LOOP FOR NUMBER OF CHARS ALLOWED FOR TITLE
	JRST	NEWPG5		;NO MORE ROOM
NEWPG4:	SKIPN	PAGNUM		;NO NEED FOR SPACES IF NOT NUMBERING PAGES
	JRST	NEWPG6
	PUSHJ	P,LSPC		;FINISHED TITLE, FILL OUT WITH SPACES
	SOJG	T1,.-1
NEWPG5:	SKIPN	PAGNUM		;SKIP IF NUMBERING PAGES
	JRST	NEWPG6		;END OF TITLE LINE
	MOVEI	M,[ASCIZ . PAGE  .]
	PUSHJ	P,$LSTR
	MOVE	T1,PAGNUM	;CURRENT PAGE NUMBER
	PUSHJ	P,$LDEC		;OUTPUT PAGE NUMBER
	AOS	PAGNUM		;AND BUMP COUNT
NEWPG6:	PUSHJ	P,LCRLF		;END OF TITLE LINE
	TLNN	F,L.SUBT	;SKIP IF WANT SUBTITLE
	JRST	NEWPGE		;NO, ALL DONE
	MOVE	T1,RMARGN	;RIGHT MARGIN
	SUB	T1,LMARGN	;MINUS LEFT MARGINCHARS FOR SUBTITLE
	JUMPLE	T1,NEWPGE	;NO ROOM
	MOVE	P1,SUBT.Y	;BYTE POINTER FOR SUBTITLE
	PUSHJ	P,MKPNTR	;CLEAR INDIRECT BIT IN POINTER
NEWPG7:	ILDB	C,P1		;GET NEXT CHAR OF SUBTITLE
	CAIN	C,SUBT.E	;SKIP IF NOT END OF SUBTITLE
	JRST	NEWPGE
	PUSHJ	P,LCHR		;OUTPUT THE CHAR
	SOJG	T1,NEWPG7
NEWPGE:	SKIPE	LINNUM		;DO NOT NEED BLANK LINES
				; IF NO TITLE GIVEN.
	PUSHJ	P,LCRLF3	;2 BLANK LINES AFTER SUBTITLE
	TRZE	F,R.RLH		;SKIP IF LINE HEADER WAS NOT REQUESTED
	TRO	F,R.LHED	;TURN REQUEST BACK ON
	POPJ	P,
LHEAD:	TLNE	F,L.ADDR	;SKIP IF ADDR IS OFF
	TRNN	F,R.CON1	;SKIP IF DUMPING CONTENTS
	POPJ	P,		;NO HEADER
	CAIGE	C,40		;REAL CHARACTER?
	JRST	[TRO  F,R.LHED	;NO--HOLD OFF
		 POPJ P,0]	; UNTILL SOMETHING IS SEEN.
	PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
	MOVE	T1,SAVADR	;ADDRESS
	PUSHJ	P,$LOCT		;OUTPUT ADDRESS
	MOVEI	M,[ASCIZ ./	.]
	PJRST	$LSTR

MARSPC:	PUSHJ	P,SAVHED	;SAVE AC'S FOR HEADER SUBROUTINES
	SKIPN	T1,LMARGN	;SKIP IF NEED SPACES FOR LEFT MARGIN
	POPJ	P,		;NO SPACES NEEDED
	PUSHJ	P,LSPC		;OUTPUT SPACES OVER TO LEFT MARGIN
	SOJG	T1,.-1
	POPJ	P,

;SUBROUTINE TO SAVE AC'S FOR HEADER SUBROUTINES

SAVHED:	EXCH	T1,(P)		;SAVE T1 AND RETRIEVE RETURN
	PUSH	P,T2
	PUSH	P,T3
	PUSH	P,C
	PUSH	P,M
	PUSH	P,P1
	PUSHJ	P,(T1)		;CALL CALLING SUBROUTINE
	POP	P,P1
	POP	P,M
	POP	P,C
	POP	P,T3
	POP	P,T2
	PJRST	T1POPJ
;HERE TO WRITE ONE BUFFER

LCHRW:	OUT	OC,		;OUTPUT BUFFER
	  JRST	LCHR2		;OK--GO DO CHARACTER NOW
	PUSH	P,T1		;ERROR--SAVE SOME ACS
	PUSH	P,T2		; ..
	PUSH	P,T3		; ..
	GETSTS	OC,T1		;GET ERROR STATUS
	MOVE	T2,T1		;PREPARE TO CLEAR
	ANDI	T2,37777	;  BY PRESERVING JUST
	SETSTS	OC,(T2)		;  THE CONTROL BITS
	OUTSTR	[ASCIZ /
% Listing device output error, status /]
	MOVE	T3,[POINT 3,T1,17]  ;SETUP FOR OCTAL TYPEOUT
LCHRWE:	ILDB	T2,T3		;GET DIGIT
	ADDI	T2,"0"		;CONVERT TO ASCII
	OUTCHR	T2		;TYPE IT
	TLNE	T3,(77B5)	;SEE IF DONE YET
	JRST	LCHRWE		;NO--LOOP
	OUTSTR	[ASCIZ /
/]				;NOTE--ALL THIS DONE HERE IN CASE
				;  WRONG SEGMENT IN CORE

	POP	P,T3		;RESTORE ACS
	POP	P,T2		; ..
	POP	P,T1		; ..
	JRST	LCHR2		;AND WRITE NEXT CHARACTER
SUBTTL	SYMBOL TABLE LOGIC -- SYMBOL COMMANDS

;XTRACT -- PULL SYMBOL TABLE FROM .SAV, .SHR, .DAE, .HGH, AND SO ON

XPROC:	PUSHJ	P,GIVSYM	;GIVE BACK PREMUTATION VECTOR
	TLZ	F,L.IOPN	;CAUSE INPUT FILE TO LOOK CLOSED
	HRRI	DL,S.ZER	;POINT TO SYFILE
	MOVEI	T1,.JBSYM	;LOOK FOR SYMBOL TABLE POINTER
	TLO	DL,DL.SYM	;NOTE WE ARE READING SYMBOL TABLE
	PUSHJ	P,FNDADR	;GO FIND THE POINTER
	TLNN	F,L.NXM		;WAS THERE A POINTER?
	SKIPL	T1		;WITH SOMETHING IN IT
	JRST	TRYHSM		;NO--GO LOOK IN .JBHSM
	MOVEM	T1,SYMPTR	;SAVE SYMBOL TABLE POINTER
	PUSHJ	P,GETST		;GO READ IN THE SYMBOL TABLE
TRYHSM:	MOVEI	T1,.JBHSM+1B18	;POINT TO HISEG POINTER
	PUSHJ	P,FNDADR	;GO GRAB IT
	TLNN	F,L.NXM		;DOES IT EXIST?
	SKIPL	T1		;AND IS IT VALID?
	JRST	FINXPR		;NO--GO AWAY
	CAMN	T1,SYMPTR	;IS IT THE SAME AS .JBSYM
	JRST	FINXPR		;YES--GO AWAY
	MOVEM	T1,SYMPTR	;SAVE FOR LATER
	PUSHJ	P,GETST		;READ HISEG POINTER
FINXPR:	TLZ	F,L.IOPN	;INPUT NO LONGER OPEN
	TLZ	DL,DL.SYM	;WE ARE NO LONGER READING SYMBOL TABLE
	TLO	DL,DL.FBR	;SET DL.FBR SO FIXSYM WILL GENERATE
				; POINTERS.
	PUSHJ	P,FIXSYM	;***TEMP*** FIX UP POINTERS NOW
	HRRI	DL,I.ZER	;POINT BACK TO INPUT
	MOVSI	T1,1		;CAUSE NEW WIDOW TO BE READ
	MOVEM	T1,WINADR	; ..
	PUSHJ	P,.TCRLF##	;TYPE A CRLF
	MOVE	T1,SYMLEN	;GET LENGTH OF SYMBOL TABLE
	LSH	T1,-1		;DIVIDE BY TWO
	PUSHJ	P,.TDECW##	;TYPE THE DECIMAL WORD
	MOVEI	T1,[ASCIZ / symbols eXTRACTed
/]
	PJRST	.TSTRG##	;LIST THE STRING AND RETURN
SUBTTL SYMBOL TABLE LOGIC -- SUBROUTINES

;READ SYMBOL TABLE FROM FILE

GETST:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	HLRE	T1,SYMPTR	;GET POSITIVE WC
	MOVM	T1,T1		; IN T1
	ADD	T1,SYMLEN	;INCLUDE CURRENT SIZE
	MOVEI	P2,SYMNDX	;GET INDEX
	PUSHJ	P,GETCOR	;GET THE CORE FROM THE MONITOR
	MOVEI	P1,@SYMTAB	;POINT TO SYMTAB
	MOVE	P2,SYMPTR	;POINT TO IT IN IMAGE FILE
	SOS	P1		;THE PUSH WILL ADD THEN STORE
GETST1:	HRRZ	T1,P2		;GET ADDRESS OF WORD
	PUSHJ	P,FNDADR	;GET THE WORD
	TLNE	F,L.NXM		;WAS IT THERE?
	JRST	GETST2		;NO--NO MORE CORE
	PUSH	P1,T1		;STORE THE WORD
	AOBJN	P2,GETST1	;LOOP FOR WHOLE TABLE
	POPJ	P,		;RETURN

;HERE IF NOT ALL OF S.T. IN CORE IMAGE FILE

GETST2:	HLRZ	P1,P1		;GET THE NUMBER OF PUSHES
	MOVE	T1,SYMLEN	;GET THE LENGTH OF THE SYMBOL TABLE
	SUB	T1,P1		;GET THE NUMBER OF WORDS TO GIVE BACK
	MOVEI	P2,SYMNDX	;POINT TO S.T.
	PJRST	GIVCOR		;RETURN EXCESS
;EVALUATE A SYMBOL -- CALLED FROM EXPRESSION EVALUATER

EXPSYM:	PUSHJ	P,REDSYM	;READ A SYMBOL
	  POPJ	P,		;RETURN -- IT WAS A NUMBER
	JUMPE	T1,.POPJ	;ZERO IS NOT A SYMBOL
	SETZ	T3,		;ASSUME JUST A SYMBOL
	CAIE	C,":"		;WAS IT A ST NAME
	JRST	EXPSY1		;NO--JUST LOOKUP
	PUSH	P,T1		;YES--SAVE NAME
	PUSHJ	P,REDSYM	;GO READ A RADIX 50 SYMBOL
	  JRST	E.SYMF		;CANT BE A NUMBER
	MOVN	T2,SYNLEN	;T2 := -(LENGTH OF ST NAMES)
	MOVSI	T2,(T2)		;SWAP SO IT IS XWD -LENGTH,0
	HRRI	T2,@SYNTAB	;GET POINTER TO S.T. NAMES
	EXCH	T1,(P)		;GET BACK S.T. NAME
	CAME	T1,(T2)		;SCAN TABLE FOR MATCH
	AOBJN	T2,.-1		; ..
	JUMPGE	T2,E.STNU	;IF NO MATCH S.T. NAME IS UNDEFINED
	SUBI	T2,@SYNTAB	;GET BACK INDEX
	ADDI	T2,@SYPTAB	;POINT TO VALUE
	MOVE	T3,(T2)		;PICK UP S.T. POINTER
	POP	P,T1		;RESTORE T1 (SYMBOL TO LOOK FOR)
EXPSY1:	PUSHJ	P,SY2VAL	;CONVERT SYMBOL NAME TO VALUE
	  SKIPA	T2,[-L.MSYM,,0]	;UNDEFINED SEE IF BUILT-IN
	POPJ	P,		;RETURN VALUE IN T1
	CAME	T1,MSYMTB(T2)	;IS THIS IT?
	AOBJN	T2,.-1		;NO--LOOP OVER ALL
	JUMPG	T2,E.SYMU	;UNDEFINED
	MOVE	T1,@MSYMAD(T2)	;PICK UP VALUE
	POPJ	P,		;RETURN
;SUBROUTINE TO CONVERT SYMBOL TO VALUE

SY2VAL:	SETZM	SYMPTR		;CLEAR POINTER
	TLZ	DL,DL.PNF!DL.MDL;CLEAR STATUS BITS
	SKIPN	T2,SYMLEN	;GET SIZE OF SYMBOL TABLE
	POPJ	P,		;EMPTY
	LSH	T2,-1		;DIVIDE BY 2
	MOVN	T4,SYMLEN	;PICK UP -VE LENGTH OF S.T.
	SKIPN	T3		;SKIP IF WE HAVE POINTER
	HRL	T3,T4		;WE DON'T -- COPY THIS POINTER
	ADDI	T3,@SYMTAB	;POINT TO REAL S.T.
SY2VL3:	MOVE	T4,(T3)		;GET SYMBOL
	TLZN	T4,ST.PGM	;IS THIS A PROGRAM NAME
	JRST	[JUMPE T4,SY2VL4;IGNORE ZEROS
		 TLO   DL,DL.PNF;SET FLAG
		 JRST  .+1]	;BACK TO MAIN LOOP
	CAMN	T4,T1		;IS THIS A HIT
	JRST	SY2VL6		;YES--WE WIN (MAYBE)
SY2VL4:	AOBJN	T3,.+1		;ADD 2 TO POINTER
	AOBJN	T3,.+2		; AND SEE IF END OF TABLE
	MOVE	T3,S2VPTR	;END--POINT BACK TO START
	SOJG	T2,SY2VL3	;LOOP FOR WHOLE S.T.
	SKIPE	T3,SYMPTR	;SKIP IF NO S.T. SPECIFIED
	TLNE	DL,DL.MDL	;SKIP IF NOT MULTIPLY DEFINED
	POPJ	P,		;SORRY YOU DO NOT WIN TODAY
SY2VL5:	MOVE	T1,1(T3)	;GET VALUE
	JRST	.POPJ1		;SKIP RETURN

SY2VL6:	MOVE	T4,(T3)		;GET SYMBOL BACK
	TLNE	T4,ST.SPI	;CAN WE USE IT?
	JRST	SY2VL4		;NO--KEEP LOOKING
	TLNN	T4,ST.GLB	;IS IT A GLOBAL?
	TLNN	DL,DL.PNF	;OR IN S.T. WE NAMED?
	JRST	SY2VL5		;YES--WE WIN
	SKIPN	T4,SYMPTR	;SKIP IF LOCAL FOUND BEFORE
	JRST	SY2VL7		;NONE. STORE THIS AS VALUE
	MOVE	T4,1(T4)	;GET THIS VALUE
	CAME	T4,1(T3)	;SAME AS OLD VALUE
	TLO	DL,DL.MDL	;NO--MUL DEFINED LCL
SY2VL7:	HRRZM	T3,SYMPTR	;STOR POINTER
	JRST	SY2VL4		;KEEP LOOKING
;SUBROUTINE TO CONVERT A VALUE TO A SYMBOL
;ARGS:	T1=VALUE
;VALUE:	T1=RADIX50 SYMBOL (WITH FLAGS STILL SET)
;	T2=OFFSET FROM CORRECT SYMBOL
VAL2SY:	JUMPE	T1,.POPJ	;ZERO IS NOT A SYMBOL
	SKIPE	SYVLEN		;IS SYVTAB SETUP
	JRST	VL2SY2		;YES--SKIP THE SORT
	PUSH	P,T1		;SAVE T1
	PUSHJ	P,SYMSRT	;NO--GO SORT SYMBOL TABLE
	POP	P,T1		;GET T1 BACK
VL2SY2:	MOVE	T2,SYVLEN	;T2 IS CURRENT POINTER IN SYVTAB
	JUMPE	T2,.POPJ	;NOT FOUND IF NO SYMBOLS
	MOVE	T3,T2		;T3 IS AMOUNT TO ADJUST T2 BY
	PUSHJ	P,.SAVE4	;SAVE P1 AND P2
	MOVEI	P1,@SYMTAB	;GET THE POINTERS
	MOVEI	P2,@SYVTAB	; TO SAVE FUTURE TIME
	TLZ	DL,DL.SNF	;CAUSE FULL SCAN
VL2SY1:	AOS	T3		;TAKE CEIL(T3/2)
	LSH	T3,-1		;CUT INC IN HALF (BINARY SEARCH)
	JUMPE	T3,NOSYMB	;DONE IF CUT DOWN TO ZERO
	PUSHJ	P,FNSYMV	;FIND POINTER TO SYMBOL VALUE
	MOVE	T4,(C)		;PICK UP VALUE
	CAMLE	T4,T1		;IS THIS .GT. WHAT WE WANT?
	JRST	VL2BIG		;YES--VALUE TOO BIG
	CAMN	T1,T4		;IS THIS THE RIGHT VALUE
	JRST	VL2HIT		;YES--RETURN
	ADD	T2,T3		;LOOK FOR BIGGER VALUE
	JRST	VL2SY3		; ..
VL2BIG:	SUB	T2,T3		;LOOK FOR SMALLER VALUE
	SKIPGE	T2		;DEFENSIVE
	MOVEI	T2,0		; ..
VL2SY3:	CAIE	T3,1		;LAST 2 WORDS?
	JRST	VL2SY1		; ..
	TLON	DL,DL.SNF	;WERE WE HERE BEFORE?
	JRST	VL2SY1		;NO--TRY ONE MORE TIME
	AOJA	T2,NOSYMB	;COUNTERACT EXTRA BUMP
NOSYMB:	CAMGE	T1,(C)		;IS VALUE OF SYMBOL SMALLER THAN
				; WHAT WE WANT?
	SOJA	T2,[JUMPL T2,.POPJ ;NO--BACK UP SOME
		    PUSHJ P,FNSYMV ;GET VALUE AND
		    JRST .-1]      ;RETRY
	SKIPG	(C)		;SKIP IF STILL POSITIVE
	POPJ	P,		;NO--THE NO MATCH
	MOVE	T2,T1		;COPY VALUE WE WANTED
	SUB	T2,(C)		;SUBTRACT WHAT WE FOUND
	MOVE	T1,-1(C)	;PICK UP SYMBOL
	CAIGE	T2,100		;TOO BIG?
	AOS	(P)		;NO--GIVE SKIP RETURN
	POPJ	P,		;YES-- FAIL

VL2HIT:	MOVE	T1,-1(C)	;GET THE SYMBOL
	SETZ	T2,0		;CLEAR OFFSET
	JRST	.POPJ1		;SKIP RETURN
FNSYMV:	MOVE	C,T2		;GET INDEX TO VECTOR
	LSH	C,-1		;MAKE SMALLER (HALF WORD ADDRESS)
	ADD	C,P2		;ADD IN START OF PERMUTATION VECTOR
	MOVE	T4,(C)		;GET POINTER TO S.T.
	TRNN	T2,1		;ODD POINTER?
	MOVS	T4,T4		;NO--SWAP HALVS
	MOVEI	C,1(P1)		;GET POINTER TO VALUES
	ADDI	C,(T4)		;ADD IN OFFSET
	POPJ	P,		;RETURN
;ROUTINE TO FIX UP POINTERS TO LOCAL S.T. WITHIN SYMBOL TABLE

FIXSYM:	TLZN	DL,DL.FBR	;IS SYMBOL TABLE O.K. ?
	POPJ	P,		;YES--RETURN
	PUSHJ	P,.SAVE2	;SAVE SOME AC'S
	MOVN	T1,SYMLEN	;GET -VE LENGTH OF S.T.
	HRLZ	T1,T1		;PUT IN L.H.
	HRRI	T1,@SYMTAB	;PUT IN POINTER TO TABLE
	MOVEM	T1,S2VPTR	;SAVE FOR LATER
	MOVEI	T1,^D100	;NUMBER OF LOCAL S.T.
	MOVEI	P2,SYNNDX	;GET INDEX
	PUSHJ	P,GETCOR
	MOVEI	T1,^D100	;NUMBER OF LOCAL S.T.
	MOVEI	P2,SYPNDX	;EXPAND LOCAL S.T.
	PUSHJ	P,GETCOR	; ..
	MOVEI	P1,@SYNTAB	;POINTER TO NAME TABLE
	MOVEI	P2,@SYPTAB	;POINTER TOPOINTER TABLE
	SOS	P1		;FIX P1 AND P2 SO THEY
	SOS	P2		; CAN BE USED AS PUSH DOWN POINTERS
	MOVE	T4,S2VPTR	;POINTER TO S.T.
	HLLZ	T2,T4		;COPY INDEX TO START OF S.T.
	PUSH	P2,T2		; AND STORE AS FIRST POINTER
FXSYM1:	MOVE	T1,(T4)		;GET SYMBOL
	TLNN	T1,ST.PGM	;IS IT A PROGRAM NAME
	CAIN	T1,0		; ..
	JRST	FXSYM2		;NO--SCAN OVER MORE SYMBOLS
	PUSH	P1,T1		;SAVE NAME
	MOVE	T2,T4		;COPY POINTER
	SUBI	T2,@SYMTAB	;CONVERT BACK TO RELATIVE POINTER
	ADD	T2,[2,,2]	;POINT PAST PROGRAM NAME
	SKIPGE	T2		;SKIP IF WE ARE NOW DONE
	PUSH	P2,T2		;SAVE INDEX
FXSYM2:	AOBJN	T4,.+1		;BUMP POINTER
	AOBJN	T4,FXSYM1	;LOOP FOR ALL SYMBOLS
	HLRZ	P1,P1		;GET SIZE OF TABLE
	CAIL	P1,^D100	;TOO BIG?
	JRST	[M.FAIL	<TOO MANY PROGRAMS LOADED>
]
	MOVE	T1,SYPLEN	;GET LENGTH OF POINTERS
	CAME	T1,SYNLEN	;COMPARE WITH NAMES
	JRST	[M.FAIL	<BAD SYMBOL TABLE>
]
	MOVEI	T1,^D100	;ORIGINAL SIZE
	SUBB	T1,P1		;NUMBER OF FREE WORDS
	MOVEI	P2,SYNNDX	;GET INDEX TO TABLE
	PUSHJ	P,GIVCOR	;RETURN CORE
	MOVE	T1,P1		;GET SIZE AGAIN
	MOVEI	P2,SYPNDX	;GET POINTER TO OTHER TABLE
	PJRST	GIVCOR		;RETURN
;HERE TO GIVE BACK SYMBOL TABLE OVERHEAD LISTS

GIVSYM:	TLO	DL,DL.FBR	;NOTE ST POINTERS ARE JUNK
	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVE	T1,SYVLEN	;GET LENGTH OF PERMUTATION VECTOR
	MOVEI	P2,SYVNDX	;GET INDEX
	PUSHJ	P,GIVCOR	;GIVE BACK CORE
	MOVEI	P2,SYPNDX	;GIVE BACK POINTER TABLE
	MOVE	T1,SYPLEN	; ..
	PUSHJ	P,GIVCOR	; ..
	MOVEI	P2,SYNNDX	;GIVE BACK NAME TABLE
	MOVE	T1,SYNLEN	; ..
	PJRST	GIVCOR		; ..
SUBTTL 	SYMBOL TABLE LOGIC -- SORT ROUTINE

;THIS IS A PERMUTATION VECTOR SORT FIRST DESCRIBED BY
; LUTHER WOODRUM IN VOL. 8 NO. 3 OF THE IBM SYSTEMS
; JOURNAL. THIS VERSION WAS DERIVED FROM A FORTRAN
; SUBROUTINE WRITTEN BY TIM TOMASELLI, VICTOR TRIOLO
; AND CLIVE DAWSON. THE ORIGINAL VERSION WAS WRITTEN
; IN APL.

APLSRT:	PHASE 	IBUF		;IMPURE CODE

	A=123456		;UNIQUE NUMBER TO PATCH TO BE @SYMTAB
	V=707070		;UNIQUE NUMBER TO PATCH TO BE @SYVTAB

	SETZ	P1,		;GLOBAL POINTER TO FIRST UNPROCESSED
				; ELEMENT.
	MOVE	N,SYMLEN	;N _ SIZE OF S.T.
	LSH	N,-1		;FIX TO ALLOW FOR 2 WORD ENTRIES
	JUMPE	N,.POPJ		;CAN NOT SORT ZERO LENGTH S.T.
	PUSHJ	P,MP		;SORT IT
	POP	P,T2		;GET HEADER TO LIST
	SETZ	T3,		;CLEAR ITEM NUMBER
A7:!	MOVE	T1,T2		;COPY LINK
	MOVE	T2,V(T1)	;GET NEXT ITEM
	MOVEM	T3,V(T1)	;STORE INDEX IN ITEM
	CAME	T1,T2		;DONE (LAST LINK POINTS TO SELF)
	AOJA	T3,A7		;NO--KEEP UNLINKING
	MOVN	T3,SYVLEN	;GET -VE SIZE
	HRLZS	T1,T3		;FLIP POINTER AROUND
I1:!	MOVE	T4,V(T3)	;SET V[V[I]] _ I
	HRLM	T3,V(T4)	; WITHOUT DISTURBING V[I]
	AOBJN	T3,I1		;LOOP FOR WHOLE ARRAY
	MOVSI	P2,(POINT 18,0)	;BYTE POINTER TO
	ADDI	P2,V		; PERMUTATION VECTOR.
	MOVE	T2,[A,,V]	;VERY RARE SYMBOL VALUE TO INIT
	MOVEM	T2,SAVSYM	; MEMORY WORD.
I2:!	HLRZ	T2,V(T1)	;GET INDEX INTO SYMTAB
	LSH	T2,1		;EXPAND BACK AGAIN
				;ISSPD: IS USED TO GET AT SYMBOL
				; IT POINTS TO THE PASSIVE PART
				; OF THE DATA(SYMBOL) IT IS 1 LESS
				; THAN ALL THE OTHER "A"'S WHICH
				; POINT TO THE VALUE.
ISSPD:!	MOVE	T4,A(T2)	;GET SYMBOL
	TLNE	T4,ST.PGM	;PROGRAM NAME?
	TLNE	T4,ST.SPD	;SPD FLAG ON?
	JRST	I3		;YES--PROGRAM NAME ON KILLED ON OUTPUT
	MOVE	T4,A(T2)	;GET SYMBOL VALUE
	CAMN	T4,SAVSYM	;SAME VALUE?
	JRST	I3		;YES--LOOP FOR NEXT ***TEMP***
	MOVEM	T4,SAVSYM	;NO--THIS IS NE LAST SYMBOL
	IDPB	T2,P2		;ELSE STORE IN VECTOR
I3:!	AOBJN	T1,I2		;LOOP OVER WHOLE TABLE
	IDPB	T2,P2		;STORE A PAD BYTE IF NEEDED
	MOVEI	T1,1(P2)	;GET SIZE OF FINAL VECTOR
	SUBI	T1,V		;GET BACK TO RELATIVE ADDRESS
	MOVNS	T1		;MAKE CURRENT LENGTH -VE
	ADD	T1,SYVLEN	;ADD IN OLD LENGTH SO RESULT IS
				; AMOUNT TO GIVE BACK.
	MOVEI	P2,SYVNDX	;GET ITS INDEX
	PJRST	GIVCOR		;RETURN WHAT WE DO NOT NEED
MP:	CAIN	N,1		;CAN THIS LINK BE FORMED?
	JRST	BOTTOM		;YES - JUMP OUT
	PUSH	P,N		;SAVE 'N' FOR LATER
	ASH	N,-1		;FLOOR(N/2)
	PUSHJ	P,MP		;SOME RECURSION IS GOOD FOR THE SOUL
	POP	P,N		;GET 'N' BACK
	EXCH	N,(P)	
	ADDI	N,1		;CIELING OF (N/2)
	ASH	N,-1		; ..
	PUSHJ	P,MP		;MORE RECURSION
	JRST	MERGE		;MERGE ANY CHAINS THAT EXIST
BOTTOM:!MOVEM	P1,V(P1)	;V[P1] _ P1 (LINK TO SELF)
	PUSH	P,(P)		;THERE MUST BE A REASON FOR
	MOVEM	P1,-1(P)	; THESE 2 INSTRUCTIONS.
	AOJA	P1,.POPJ	;P1_P1+1 AND RETURN

MERGE:!	POP	P,T1		;M1.
	POP	P,T2	
	MOVE	C,T2		;COPY INDEX
	LSH	C,1		;POINT TO VALUE
	MOVE	T3,A(C)		;SEE IF A[J] < A[I]
	MOVE	C,T1		;COPY INDEX
	LSH	C,1		;POINT TO VALUE
	CAMGE	T3,A(C)		;SEE WHICH IS BIGGER
	EXCH	T1,T2		;EXCHANGE THE INDICIES
	PUSH	P,(P)		;STORE T1 ON
	MOVEM	T1,-1(P)	; STACK
M2:!	CAME	T1,V(T1)	;M2. [END OF CHAIN] IF P[T1] = T1
	JRST	M3		;NO--KEEP DOING
	MOVEM	T2,V(T1)	;SET V[T1] _ T2
	POPJ	P,		;RETURN

M3:!	MOVE	T4,T1		;M3. [ADVANCE] SET T4 _ T1
	MOVE	T1,V(T1)	;I _ V[I]
	MOVE	T3,T1		;GET INDEX
	LSH	T3,1		;FIX FOR TABLE SIZE
	MOVE	T3,A(T3)	;SEE IF STIILL IN ORDER
	MOVE	C,T2
	LSH	C,1
	CAMGE	T3,A(C)		;IF A[T1] < A[T2]
	JRST	M2		;GOTO M2
M4:!	MOVEM	T2,V(T4)	;M4. SET V[T4] _ T2
	EXCH	T1,T2		;SWAP AROUND INDICIES
	JRST	M2
SAVSYM:!BLOCK	1
	DEPHASE
APLSIZ==.-APLSRT

SYMSRT:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVE	T1,SYMLEN	;GET SIZE OF SYMBOL TABLE
	LSH	T1,-1		;CUT IN HALF
	MOVEI	P2,SYVNDX	;INDEX TO TABEL VECTOR
	PUSHJ	P,GETCOR	;GO GET THE CORE WE NEED
	MOVE	T1,[APLSRT,,IBUF];BLT POINTER
	BLT	T1,IBUF+APLSIZ	;COPY THE CODE
	MOVEI	T1,@SYMTAB	;POINTER TO SYMBOLS
	ADDI	T1,1		;CAUSE TO POINT TO VALUE WORD
	MOVEI	T2,@SYVTAB	;POINTER TO PERMUTATION VECTOR
	MOVE	T3,[-APLSIZ,,IBUF] ;AOBJN POINTER
SYNSR1:	HRRZ	T4,(T3)		;GET Y ADDRESS
	CAIN	T4,V		;ADDRESS IN PERMUTATION VECTOR
	MOVEI	T4,(T2)		;YES--FIX POINTER
	CAIN	T4,A		;ADDRESS IN SYMBOL TABLE?
	MOVEI	T4,(T1)		;YES--DO THAT TOO
	HRRM	T4,(T3)		;STORE BACK
	AOBJN	T3,SYNSR1	;LOOP FOR ALL CODE BLTED
	SOS	ISSPD		;FIX THE ONE LOOSER
	JRST	IBUF		;GO DO THE SORT
	SUBTTL	OP DECODER

;DESCRIPTION OF OP DECODER FOR DUMP:
;
;         THE ENTIRE INSTRUCTION SET FOR THE PDP-10 CAN BE COMPACTED INTO
;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL.  THIS OCCURS
;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
;FOR THE PDP-10.  FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
;BEGIN WITH 110(2).
;
;     	THE TABLE TBL IN DUMP CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
;0-37(8):	THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
;	LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
;	EQUAL P.
;
;	THE CONTENTS OF P2 (INSTRUCTION) CONTAIN IN THE RIGHT
;	MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
;	P AND N REFER TO THE CONTENTS OF P2, AND THE OP DECODER
;	WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
;	OF P2X N+1 GIVES THE NUMBER OF BITS IN P2; P GIVES THE
;	POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
;
;	EXAMPLE: P = 6
;	         N = 2
;
;;	C(P2) = .010 101 100(2)
;
;	THE RESULT = D = 010(2) = 2(8)
;
;	D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
;	IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
;	PRINT TEXT OR ARE THE EXTEND BYTE, 41-73(8))
;	ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
;	THE INTERPRETATION.
;
;40(8)	THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
;	IS FINISHED.
;41(8)-72(8)	THE ALPHABET IS ENCODED INTO THIS RANGE.
;	41- A
;	42- B
;	72- Z
;	WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
;	LETTER IS TYPED.
;73(8)	THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
;	IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
;	BY <1000-74*2+FIR.> FIRST.
;
;74(8)-777(8)	THIS IS A TRANSFER BYTE.  IF THE BYTE IN THIS RANGE IS
;	CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE 
;	<A-74(8)+FIR.>RD BYTE IN THE TABLE.
;
DEFINE BYT9 (A) <IRP A,<
A>>

IF1,<

DEFINE	.ADR	(A) <
%'A==	CLOC
FIR.==	CLOC
DEFINE	.ADR	(B) <
%'B==	CLOC
LASTB==CLOC+74-FIR.>>

DEFINE	.TRA (A)<CLOC==CLOC+1>
DEFINE .TRAX (A)<CLOC==CLOC+2>

SYN	.TRA,	.DIS

DEFINE	.TXT	(A) <
IFNB	<A>,	<IRPC A,<CLOC==CLOC+1>>>

DEFINE	.END	(A) <
IFNB	<A>,	<IRPC A,<CLOC==CLOC+1>>
CLOC==	CLOC+1>

>	;END OF IF1
IF2,<

DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>

DEFINE .TRA (A) <OUTP %'A+74-FIR.>

DEFINE .TRAX (A),<OUTP 73
	OUTP	74+<Z1==%'A-FIR.-1000+74>
	IFL	Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>

DEFINE .DIS (A) <OUTP A&70/2+A&7-1>

DEFINE .TXT (A) <IFNB <A>,<IRPC A,<OUTP "A"-40>>>

DEFINE	.END	(A) <
IFNB	<A>,	<IRPC A,<OUTP "A"-40>>
OUTP	40>

DEFINE OUTP (A)<
IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
IFE <BINC==BINC-9>-^D27,<BINR1==A>
IFE BINC-^D18,<BINR2==A>
IFE BINC-9,<BINR3==A>
	IFE	BINC,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINC==^D36>
CLOC==CLOC+1 >
>
TBL:  ;OPDECODER BYTE TABLE

	XALL
IFDEF	.XCREF	<.XCREF>


CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0
BINC== ^D36 ;INIT BYTES/WORD COUNTER
IF1,<	DEFINE	BYTABL,<
	XLIST

;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
;**************TERMINATES AT THE NEXT COMMENT WITH: **************

BYT9 <
	LIST

.DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
	.TXT H,.TRA HWT,.TXT T,.TRA ACBM


;IO INSTRUCTIONS

.DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
.ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
	.ADR OI,.DIS 01,.TRA O,.TRA I
;UUOS

.ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
	.DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
.TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
.ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
.ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
	.ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
.ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
	.ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S

;BYTE AND FLOATING INSTRUCTIONS

.ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
	.TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
.DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
	.ADR L,.END L,.TXT,.ADR M,.END M,.TXT
.ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.END,.TRAX I110,.TRA I120,.TXT
	.DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N
.TXT FS,.TRA CTYP,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD
	.ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B
;FWT-FIXED POINT ARITH-MISC

.ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV
	.TRA SH,.TRA H1,.TRA JP
.DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT
	.ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22
.ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M
	.ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT
.ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB
	.ADR DV,.DIS 21,.TXT I,.TRA DV1
.ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL
	.ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ
.TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P
	.ADR AOB,.DIS 01,.TRA P,.TRA N
.ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO
	.ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT
.TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA
	.ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP
.DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L
	.ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END
	.ADR S1,.DIS 21,.END,.TXT,.ADR CTYP,.END C,.TXT

;ARITH COMP-SKIP-JUMP

.ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S
	.ADR JS,.TXT O,.DIS 31
.TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP
.ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP
.DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E
	.ADR N,.END N,.TXT,.END G,.TXT
;HALF WORDS

.ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3
.ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L
	.ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS

;TEST INSTRUCTIONS

.ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2
	.ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L
.ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O
	.ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N

;BOOLEAN

.ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST
.TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ
	.TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR
.ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB
	.ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB
.ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB
	.ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA
.TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB
;INSTRUCTION GROUP 120
.ADR I120,.DIS 11,.TRA DMOV,.DIS 01,.TXT FIX,.TRA FIX2,.DIS 21,.END
	.TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R
.ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N
	.ADR EM,.DIS 21,.END,.TRA M

;MORE UUO'S

.ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END
	.TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T
.ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S
	.TXT MTAP,.TRA E,.TXT UGET,.TRA F

;INSTRUCTION GROUP 110 - DF ARITHMETIC
.ADR I110,.DIS 21,.TXT DF,.TRAX DF,.END,.ADR DF,.DIS 02
	.END AD,.END SB,.TXT M,.TRA P,.END DV

;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
>>>
	BYTABL
IF1,<	BLOCK	<CLOC+3>/4>
	IF2,<	IFN BINC-^D36,<BYTE (9) BINR1,BINR2,BINR3,0> >

IFNDEF CLOC.,<CLOC.==CLOC>
IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>

IF2,<
DEFINE	.ADR	(A) <
	PURGE	%'A
>
DEFINE	.DIS	(A)<>
DEFINE	LIST	<>
DEFINE	.TRA	(A)<>
DEFINE	.TRAX	(A)<>
DEFINE	.TXT	(A)<>
DEFINE	.END	(A)<>
	BYTABL
	PURGE	LIST
	LIST
	PURGE	BINR1,BINR2,BINR3,OUTP,CLOC,CLOC.,BINC,Z1
	PURGE	.TRA,.TRAX,.TXT,.END,BYT9,BYTABL
> ;END IF2
IFDEF	.CREF	<.CREF>
;CALLI NAMES

	DEFINE	S(A)<
	IRP	A,<
	XLIST
	<SIXBIT	/A/>
	LIST
>>

	MAXNCI==.-CITAB
	S	<LIGHTS>;
CITAB:	S	<RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT>;    ;0 TO 5
	S	<GETCHR,DDTRL,WAIT,CORE,EXIT,UTPCLR,DATE>;   ;6 TO 14
	S	<LOGIN,APRENB,LOGOUT,SWITCH,REASSI,TIMER>;   ;15 TO 22
	S	<MSTIME,GETPPN,TRPSET,TRPJEN,RUNTIM,PJOB>;   ;23 TO 30
	S	<SLEEP,SETPOV,PEEK,GETLIN,RUN,SETUWP,REMAP>; ;31 T0 37
	S	<GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR>;    ;40 TO 45
;END OF 4.72 CALLIS

	S	<SYSSTR,JOBSTR,STRUUO,SYSPHY,FRECHN,DEVTYP>; ;46 TO 53
	S	<DEVTYP,DEVPPN,SEEK>;			     ;54 AND 55

;END OF 5.01 CALLIS

	S	<RTTRP,LOCK,JOBSTS,LOCATE,WHERE,DEVNAM,CTLJOB>; ;56 TO 65
	S	<GOBSTR,ACTIVA,DEACTI>;			        ;66 TO 70

;END OF 5.02 CALLIS

	S	<HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN,OTHUSR>;;71 TO 77
	S	<CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN>; ;100 TO 105
	S	<FRCUUO,DEVLNM>;                             ;106 TO 107

;END OF 5.03 CALLIS

	S	<PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.>;   ;110 TO 115
	S	<TRMOP.,RESDV.,UNLOK.>;		     ;116 TO 120
;END OF 5.04 CALLIS

	S	<DISK.,DVRST.,DVURS.>
MAXCAL==.-CITAB-1
BTAB:	POINT	9,TBL		;TABLE USED TO GET NEXT BYTE POINTER
	POINT	9,TBL,8		;FOR TRANSFER BYTE
	POINT	9,TBL,17
	POINT	9,TBL,26


;SUBROUTINE TO LOOKUP AN OPCODE IN THE TABLE AND RETURN ITS
; SIXBIT NAME
;ARG:	T1=BINARY WORD
;VALUE:	N=SIXBIT VALUE
;
; SKIP RETURNS IF VALID OPCODE ELSE JUST POPJ RETURN
;
OPDEC:	PUSHJ	P,.SAVE2	;SAVE P1 AND P2
	MOVE	N,LASTOP	;GET LAST OPCODE
	CAMN	T1,LASBIN	;IS THIS THE SAME
	JRST	DCODEX		;YES--GIVE SAME ANSWER
	MOVEM	T1,LASBIN	;STORE FOR NEXT TIME
	MOVEI	P1,P2		;POINT TO OPCODE
	MOVE	P2,T1		;PLACE OPCODE SOMEPLACE SAFE
	LSH	P2,-33		;JUST WANT OPCODE
	CAIE	P2,47		;IS THIS A CALLI?
	JRST	NTCALL		;NO--LOOK UP IN TBL:
	HRREI	T1,(T1)		;GET ACT VALUE
	CAML	T1,[MAXNCI]	;SMALLER THAN MIN.
	CAILE	T1,MAXCAL	;BIGGER THAN MAX.
	JRST	NTCALL		;YES--JUST SAY CALLI
	MOVE	N,CITAB(T1)	;NO--GET REAL NAME
	MOVEM	N,LASTOP	;REMEMBER THIS FOR NEXT TIME
	PJRST	.POPJ1		;RETURN
NTCALL:	SETZ	N,		;CLEAR ANSWER
	MOVE	C,[POINT 6,N]	;POINTER TO ANSWER
	SETZB	T2,T3		;CLEAR TEMP AC'S
	MOVE	T4,BTAB		;POINT TO TABLE
DCODE1:	ILDB	T1,T4		;GET A BYTE
	CAILE	T1,40		;SKIP IF 0-40 (DISPATCH OR STOP CODE)
	CAIL	T1,74		;SKIP IF TRANSFER BYTE
	SOJGE	T2,DCODE1	;0-40 OR TRANSFER BYTE LOOP FOR
				; C(T2) MORE BYTES.
	JUMPG	T2,DCODE1	;JUMP IF DISPATCH AND T2 .GT. 0
	SUBI	T1,40		;KNOCK DOWN CODE BY 40.
	JUMPE	T1,DCODEX	;JUMP IF STOP CODE
	JUMPG	T1,DCODE2	;JUMP IF LETTER OR TRANSFER
	DPB	T1,[POINT 5,P1,7];MAKE P1 POINT TO NEXT  
	TRZ	T1,-4		; GROUP OF BITS IN 
	AOS	T1		; THE OPCODE FIELD.
	DPB	T1,[POINT 6,P1,11]
	LDB	T2,P1		;GET THE BITS
	JRST	DCODE1		;LOOP FOR THIS PART OF OPCODE
DCODE2:	HRREI	T1,-33(T1)	;TOTAL SUBTRACTED IS NOW 73. 
	JUMPL	T1,DECT		;SO -VE NUMBERS ARE LETTERS.
	JUMPG	T1,DCODE3	;AND POSITIVE NUMBERS ARE TRANSFERS.
	ILDB	T1,T4		;ZERO(73) IS SPECIAL HACK TO LET US
	MOVEI	T1,611(T1)	; GET MORE INTO TABLE FOR KI-10.
DCODE3:	MOVEI	T3,FIR.-1(T1)	;FIR. IS FIRST BYTE WE NEED TO "GOTO"
				; SO ALL ADDRESSES ARE KEYED OFF FIR.
	IDIVI	T3,4		;9-BIT BYTES. 4 BYTES/WORD.
	MOVE	T4,BTAB(T4)	;BYTE POINTER TO WHERE WE JUST JRSTED
	ADDI	T4,(T3)		;ADD IN WORD ADDRESS (OFFSET)
	JRST	DCODE1		;LOOP TO LOOK AT THAT BYTE.

DECT:	MOVEI	T1,73(T1)	;CONVERT BACK TO SIXBIT
	IDPB	T1,C		;STORE IN N
	JRST	DCODE1		;LOOP BACK FOR REST.

DCODEX:	MOVEM	N,LASTOP	;SAVE FOR NEXT TIME
	SKIPE	N		;DONE. DID WE STORE ANYTHING?
	AOS	(P)		;YES--SKIP RETURN
	POPJ	P,		;NO--PLAIN RETURN
SUBTTL CORE MANAGEMENT SUBROUTINES

;SUBROUTINE TO EXPAND A TABLE
;ARGS	T1=WORDS TO GET
;	P2=INDEX IN TABLE VECTOR

GETCOR:	JUMPE	T1,.POPJ	;JUMP IF NO CHANGE
	PUSH	P,T1		;SAVE INCREMENT
	ADDM	T1,LENVEC(P2)	;INCREMENT SIZE OF TABLE
	ADDB	T1,.JBFF	;AND END OF TABLES
	CAMG	T1,.JBREL	;SKIP IF MUST EXPAND CORE
	JRST	GETCR1		;ALREADY HAVE ENOUGH
	CORE	T1,		;TRY TO EXPAND CORE
	  JRST	E.NCOR		;CANT GET ENOUGH CORE
GETCR1:	CAIN	P2,LSTTAB	;SKIP IF NOT LAST TABLE
	JRST	T1POPJ
	MOVE	T1,(P)		;RESET INCREMENT
	PUSH	P,T2
	PUSH	P,T3
	MOVE	T2,.JBFF	;T2=NEW LAST ADDRESS OF TABLES
	SUB	T1,T2		;T1=-OLD LAST ADDRESS
	MOVNS	T1		;T1=OLD LAST ADDRESS
	HRLI	T1,-1		;MAKE PUSH DOWN PTR SUITABLE FOR POPS
	MOVE	T3,TABVEC+1(P2)	;OLD LAST ADDRESS OF NEXT TABLE
GETCR2:	POP	T1,(T2)	;OLD TO NEW LOCATION
	CAIG	T3,(T1)		;SKIP IF JUST MOVED FIRST LOC OF TABLE PAST EXPANDED
	SOJA	T2,GETCR2	;LOOP TILL DONE
	MOVEI	T2,1(P2)	;INDEX OF NEXT TABLE
	MOVE	T1,-2(P)	;RESET INCREMENT
GETCR3:	ADDM	T1,TABVEC(T2)	;INCREMENT THE START ADDR OF TABLES THAT FOLLOW
	CAIE	T2,LSTTAB	;SKIP IF INCREMENTED LAST TABLE
	AOJA	T2,GETCR3	;LOOP FOR THE REST OF THE TABLES
	POP	P,T3
	POP	P,T2
T1POPJ:	POP	P,T1
	POPJ	P,
;SUBROUTINE TO CONTRACT A TABLE
;ARGS	T1=WORDS TO GIVE BACK
;	P2=INDEX IN TABLE VECTOR

GIVCOR:	CAMG	T1,LENVEC(P2)	;SKIP IF GIVING BACK TOO MUCH
	JRST	GIVCR1		;OK
	PUSH	P,LENVEC(P2)	;SAVE CURRENT LENGTH OF TABLE
	MOVEI	T1,[ASCIZ .GIVING BACK TOO MUCH CORE .]
	PUSHJ	P,LSTR
;TYPE HOW MUCH, CURRENT LENGTH
	POP	P,T1		;RESTORE LENGTH TO GIVE BACK=CURRENT LENGTH
GIVCR1:	JUMPE	T1,.POPJ	;EXIT IF NO CHANGE
	MOVNS	T1		;T1=MINUS WORDS TO GIVE BACK
	ADDM	T1,LENVEC(P2)	;DECREMENT LENGTH OF TABLE
	ADDM	T1,.JBFF	;AND END OF TABLES
	CAIN	P2,LSTTAB	;SKIP IF NOT LAST TABLE
	JRST	GIVCRE		;NO SHUFFLING NEEDED
	PUSH	P,T2
	MOVE	T2,TABVEC+1(P2) ;START ADDR OF NEXT TABLE
	HRLS	T2		;IN BOTH HALVES
	ADD	T2,T1		;RIGHT HALF=NEW START ADDR
	BLT	T2,@.JBFF	;MOVE UP TABLES PAST THIS TABLE
	MOVEI	T2,1(P2)	;INDEX OF NEXT TABLE
GIVCR2:	ADDM	T1,TABVEC(T2)	;DECREMENET START ADDR OF REST OF TABLES
	CAIE	T2,LSTTAB	;SKIP IF DECREMENTED LAST TABLE
	AOJA	T2,GIVCR2
	POP	P,T2
GIVCRE:	MOVE	T1,.JBREL	;TOTAL SIZE OF CORE
	SUB	T1,.JBFF	;MINUS LENGTH NEEDED
	CAIGE	T1,4000		;SKIP IF MORE THAN 2K EXCESS
	POPJ	P,		;OK, DONT WORRY
	MOVNI	T1,2000		;-1K
	ADD	T1,.JBREL
	CORE	T1,		;GIVE BACK 1 K
	  JFCL
.POPJ:	POPJ	P,
SUBTTL ERRORS

;HERE FOR VARIOUS ERRORS

E.NIMP:	MOVE	N,VERBN(P1)	;NAME OF VERB
	M.FAIN	<NOT CODED>

E.NCOR:	MOVE	N,TABNAM(P2)	;NAME OF TABLE THAT WANTED TO EXPAND
	M.FAIN	<CANT EXPAND TABLE>

E.EXP:	M.FAIL	<SYNTAX ERROR>

E.MAX:	HRLZ	N,T1		;SET MAXIMUM
	M.FAIO	<MAX =>

E.NSFI:	MOVEI	N,(DL)
	M.FAIF	<CANT FIND INPUT FILE - ERROR CODE=>

E.NSFO:	MOVEI	N,O.ZER
	M.FAIF	<CANT ENTER OUTPUT FILE>

E.LKO:	MOVE N,T2
	M.FAIN	<OPEN failure for device>

E.LKL:	HRLZ	N,T2		;COPY ERROR CODE
	M.FAIO	<LOOKUP failure for input device - code>

E.STNU:	PUSHJ	P,TRDX5		;TYPE IN RADIX 50
	MOVEI	T1,[ASCIZ / is a undefined symbol table name
/]
	PUSHJ	P,.TSTRG##
	PJRST	.FMSGE##
E.SYMF:	M.FAIL	<Wrong format for symbol (: must be followed by a symbol)>
E.SYMU:	PUSHJ	P,TRDX5
	TLNE	DL,DL.MDL
	JRST	E.SMDL
	MOVEI	T1,[ASCIZ / is an undefined symbol
/]
	pushj	p,.tstrg##
	pjrst	.fmsge##
e.smdl:	movei	t1,[asciz / is a multiply defined local
/]
	PUSHJ	P,.TSTRG##
	PJRST	.FMSGE##
;SUBROUTINE TO TYPE A RADIX 50 SYMBOL IN CASE WE NEED IT IN AN ERROR

TRDX5:	CLRBFI			;PREPARE TO TYPE A ?
	PUSH	P,T1
	MOVEI	T1,[ASCIZ /
? /]
	PUSHJ	P,.TSTRG##
	TLO	DL,DL.TR5	;FLAG OUTPUT TO TTY
	POP	P,T1
	PUSHJ	P,$LRAD		;LIST THE SYMBOL
	TLZ	DL,DL.TR5	;CLEAR THE FLAG
	POPJ	P,		;RETURN
SUBTTL LISTS

;LIST OF EXTENSIONS TO TRY IF NOT KNOWN

	DEFINE	DEFSYM(A)<
	XLIST
	IRP A,<SIXBIT	\A\>
	LIST>

C.DEX:	DEFSYM	<DAE,SAV,SHR,HGH,LOW,XPN,DMP>
C.LDEX==.-C.DEX

S.DEX==C.DEX
S.LDEX==C.LDEX

	DEFINE	TYPXMC(A)<
	XLIST
	ZZ==0
	IRP A,<
		IFL ZZ-T.EEND,<
		XWD	SIXBIT \   A\,T.'A
		>
	ZZ==ZZ+1
	>
	LIST>

;CALLED BY TYPXM MACRO - DEFINE DEFAULT INPUT EXTENSIONS

I.DEX:	TYPXM
I.LDEX==.-I.DEX

	DEFINE	TYPXMC(A)<
	XLIST
	ZZ==0
	IRP A,<
		IFE ZZ&1,<
		DEFINE X(B)<
		XWD FND'A,FND'B
		>>
		IFN ZZ&1,<
		X A
		>
	ZZ==ZZ+1
	>
	LIST>

TYPVEC:	TYPXM
	DEFINE	MODXMC(A)<
	XLIST
	ZZ==0
	IRP A,<
		IFE ZZ&1,<
		DEFINE X(B)<
		XWD MOD'A,MOD'B>>

		IFN ZZ&1,<
		X A>
	ZZ==ZZ+1>
	LIST>

MODADR:	MODXM

	DEFINE	MODXMC(A)<
	XLIST
	IRP A,<

	IFE ^D36-YY*M.S,<
		EXP	ZZ
		ZZ==0
		YY==0
		>

	ZZ==<ZZ_M.S>+M.'A
	YY==YY+1
	>
	LIST>

ZZ==0
YY==0
MODLAL:	MODXM
	MODXMC	(END)
ZZ==<ZZ_<^D36-YY*M.S>>
	EXP	ZZ
SUBTTL BYTE POINTERS

;BYTE POINTERS

J.Y:	POINT	J.S,@JUSTAB
M.Y:	POINT	M.S,@MODTAB
W.Y:	POINT	W.S,@WIDTAB
TIT.Y:	POINT	TIT.S,@TITTAB
BYT.Y:	POINT	36,@BYTTAB
SUBT.Y:	POINT	SUBT.S,@SUBTAB

VRBPTR:	IOWD	VERBL,VERBN
PDL:	IOWD	PDLEN,PDLIST

	DEFINE	FORMMC(A)<
ZZ==0
IRP A,<
ZZ==ZZ!<1_<A-1>>>>

	FORMMC	<11,12,13,14,15>

FORMCH:	EXP	ZZ

;LITERALS AND VARIABLES

	XLIST
LIT::	LIT
	LIST
SUBTTL	TABLE POINTERS

DEFINE	TABLES<
	T	SYM,		;SYMBOL TABLE 
	T	JUS,		;JUSTIFY KEYS
	T	MOD,		;MODE KEYS
	T	WID,		;WIDTH KEYS
	T	TIT,		;TITLE LINE
	T	SUB,		;SUBTITLE
	T	OFF,		;OFFSET LIST
	T	SYP,		;POINTERS FROM START OF S.T. TO
				; A SPECIFIC PROGRAMS S.T.
	T	SYN,		;NAMES OF PROGRAMS IN S.T.
	T	SYV,		;LIST OF 1/2 WORD BYTES WHICH GIVE
				; INDEX FROM START OF S.T. TO NEXT
				; LARGER VALUE.
	T	OPR,		;OPERATOR STACK
	T	OPN,		;OPERAND STACK
	T	BYT,		;BYTE TABLE
>

DEFINE	T(A)<
	SIXBIT	/A'TAB/
>
TABNAM:	TABLES
	RELOC

DEFINE	T(A)<
A'TAB:	BLOCK	1
A'NDX==.-TABVEC-1>

ZER:!
TABVEC:!TABLES
LSTTAB==.-TABVEC-1

DEFINE	T(A)	<
A'LEN:	BLOCK	1>

LENVEC:!TABLES
SUBTTL	DATA AND STORAGE LOCATIONS

;BLOCK TO GET FILE SPECS FROM SCAN

F.ZER:	PHASE	0
%DEV:!	BLOCK	1		;DEVICE NAME IN SIXBIT
%NAM:!	BLOCK	1		;FILE NAME IN SIXBIT
%NAMM:!	BLOCK	1		;MASK WITH A 1 FOR EACH NON WILD BIT
				; IN FILE NAME. NOT USED BY DUMP.
%EXT:!	BLOCK	1		;EXTENSION IN LEFT HALF AND EXTENSION
				; MASK IN RH
%MOD:!	BLOCK	1		;SWITCH WORD
%MODM:!	BLOCK	1		;MASK FOR SWITCH WORD
%DIR:!	BLOCK	2*LN.DRB	;PATH TO FILE. FIRST WORD IS PPN
				; THEN PPN MASK. FOLLOWD BY SFD/SFD MASK
				; PAIRS.
F.LEN:!	;AMOUNT TO GET FROM SCANS F AREA
FAREA:!
%TYP:!	BLOCK	1		;TYPE OF FILE
FAREAL==.-FAREA	;SIZE OF EXTERNAL F AREA
	DEPHASE

;INPUT SPEC

I.ZER:!
I.DEV:	BLOCK	1
I.NAM:	BLOCK	1
I.NAMM:	BLOCK	1
I.EXT:	BLOCK	1
I.MOD:	BLOCK	1
I.MODM:	BLOCK	1
I.DIR:	BLOCK	2*LN.DRB
I.TYP:	BLOCK	1

;COMPARISON FILE

C.ZER:!
C.DEV:	BLOCK	1
C.NAM:	BLOCK	1
C.NAMM:	BLOCK	1
C.EXT:	BLOCK	1
C.MOD:	BLOCK	1
C.MODM:	BLOCK	1
C.DIR:	BLOCK	2*LN.DRB
C.TYP:	BLOCK	1
;OUTPUT FILE

O.ZER:!
O.DEV:	BLOCK	1
O.NAM:	BLOCK	1
O.NAMM:	BLOCK	1
O.EXT:	BLOCK	1
O.MOD:	BLOCK	1
O.MODM:	BLOCK	1
O.DIR:	BLOCK	2*LN.DRB
O.TYP:	BLOCK	1	

S.ZER:!
S.DEV:	BLOCK	1
S.NAM:	BLOCK	1
S.NAMM:	BLOCK	1
S.EXT:	BLOCK	1
S.MOD:	BLOCK	1
S.MODM:	BLOCK	1
S.DIR:	BLOCK	2*LN.DRB
S.TYP:	BLOCK	1



PAREA:	BLOCK	FAREAL
ADRTMP:	BLOCK	1	;ADDRESS OF WORD IN INPUT FILE
B.OC:	BLOCK	3	;BUFFER HEADER FOR OUTPUT FILE

;THE NEXT 2 WORDS MUST GO TOGETHER

CATBLK:	BLOCK	1	;BEGINNING BLOCK OF CURRENT CATEGORY
CATWRD:	BLOCK	1	;BEGINNING WORD OF CURRENT CATEGORY

CATLEN:	BLOCK	1	;LENGTH OF CURRENT CATEGORY
CATNUM:	BLOCK	1	;CURRENT CATEGORY NUMBER
CURCHR:	BLOCK	1	;CURRENT CHARACTER NUMBER ON LINE
CURIOW:	BLOCK	1	;CURRENT IOWD FOR COMPRESSED FILES
DAECCT:	BLOCK	1	;CURRENT CATEGORY
DAECBK:	BLOCK	1	;CURRENT BLOCK IN DAEMON FILE
DAECWD:	BLOCK	1	;CURRENT WORD IN BLOCK IN DAEMON FILE
DMHEAD:	BLOCK	1	;AOBJN POINTER FOR DUMP MODE INPUT
HGHOFF:	BLOCK	1	;OFFSET FOR HIGH SEGMENT
INCADR:	BLOCK	1	;INCREMENT ADDRESS FOR DUMP
INCPOS:	BLOCK	1	;INCREMENT POSITION
INCSIZ:	BLOCK	1	;INCREMENT SIZE
INPLST:	BLOCK	2
IRADIX:	BLOCK	1	;INPUT RADIX
KEYPTR:	BLOCK	1	;POINTER TO LIST OF KEY WORDS FOR JUSTIFY OR MODES
LINNUM:	BLOCK	1	;LINE NUMBER ON CURRENT PAGE
LINPAG:	BLOCK	1	;LINES PER PAGE
LMARGN:	BLOCK	1	;LEFT MARGIN
LOWREL:	BLOCK	1	;LENGTH OF LOW SEGMENT FOR DAEMON CORE CATEGORY
MAGWRD:	BLOCK	1	;MAGTAPE PARAMETERS
OBUF:	BLOCK	203
ORADIX:	BLOCK	1	;OUTPUT RADIX
OUTVAL:	BLOCK	1	;VALUE TO BE OUTPUT
PAGLIM:	BLOCK	1	;PAGE LIMIT FOR OUTPUT
PAGNUM:	BLOCK	1	;CURRENT PAGE NUMBER IF COUNTING
PDLIST:	BLOCK	PDLEN	;PUSH DOWN LIST
POSTMP:	BLOCK	1	;POSITION WORD
RMARGN:	BLOCK	1	;RIGHT MARGIN

;THE FOLLOWING BLOCK MUST STAY TOGETHER

SAVET1:	BLOCK	1
SAVET2:	BLOCK	1
SAVET3:	BLOCK	1
SAVET4:	BLOCK	1
SAVEP1:	BLOCK	1
SAVEP2:	BLOCK	1
SAVEF:	BLOCK	1
SAVEM:	BLOCK	1

;END BLOCK
SAVADR:	BLOCK	1	;CURRENT ADDRESS FOR DUMP
SAVPOS:	BLOCK	1	;CURRENT POSITION FOR DUMP
SAVSIZ:	BLOCK	1	;CURRENT SIZE FOR DUMP
SBLOCK:	BLOCK	1	;BLOCKS TO SKIP ON INPUT
SFILES:	BLOCK	1	;FILES TO SKIP ON INPUT
SIZTMP:	BLOCK	1	;SIZE WORD
TEMPAD:	BLOCK	1
TRMADR:	BLOCK	1	;TERMINATING ADDRESS FOR DUMP
TRMPOS:	BLOCK	1	;TERMINATING SIZE FOR DUMP
WINADR:	BLOCK	1	;ADDRESS OF FIRST WORD IN WINDOW
WINLEN:	BLOCK	1
WINLST:	BLOCK	2
JOBDAT:	BLOCK	200	;BUFFER FOR FIRST PART OF CORE IMAGE
;5 TEMPS USED TO FILL AND JUSTIFY OUTPUT (ROUTINE OUTPT:)
PADCNT:	BLOCK	1
SAVCCH:	BLOCK	1
LPAD.Y:	BLOCK	1
WIDTMP:	BLOCK	1
JUSTMP:	BLOCK	1
LPAD:	BLOCK	12	;LIST OF 9-BIT BYTES USED TO REMEMBER HOW
			; MANY BLANKS TO PREFIX A MESSAGE WITH SUCH
			; THAT THE RESULT IS CENTERED OR RIGHT
			; JUSTIFIED.
S2VPTR:	BLOCK	1	;POINTER TO SYMBOL TABLE USED
			; WHEN GOING FROM SYMBOL TO VALUE
SYMPTR:	BLOCK	1	;TEMP USED BY SYMBOL TABLE LOGIC
LASBIN:	BLOCK	1	;THE LAST ARGUMENT TO OP DECODER
LASTOP:	BLOCK	1	;THE SYMBOL FOR THAT OPCODE
OLDVAL:	BLOCK	4	;LAST ARGUMERT TO SYMBOL ENCODER
OLDSYM:	BLOCK	4	;THE ANSWER FOR THAT VALUE
SYMOFF:	BLOCK	4	;THE OFFSET FOR THAT VALUE
SAVE4.:	BLOCK	1	;VALUE OF 1
SAVE4$:	BLOCK	1	;VALUE OF $
SAVEXP:	BLOCK	1	;VALUE OF %
PATH:	BLOCK	11	;SFD PATH

EZER=.-1

WINDOW:	BLOCK	WINSIZ


PATCH:
PAT:	BLOCK	20		;FOR USE WITH DDT
FRECOR::
DMPEND:	END	DUMP