;STANFORD ASSEMBLY:
	LPTWID==^D120	;120 CHARACTERS/LINE ON LPT AT STANFORD
TITLE	MACRO V.10	
SUBTTL	 RPG/CMF/JF/PMH/DMN	7-SEPT-71
;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.

	VMACRO==10		;VERSION NUMBER
	VUPDATE==0		;DEC UPDATE LEVEL
	VEDIT==0		;EDIT NUMBER
	VCUSTOM==0		;NON-DEC UPDATE LEVEL


	LOC	<JOBVER==137>
	<VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT
	RELOC
	MLON

COMMENT	*	ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)

	SWITCHES ON (NON-ZERO) IN DEC VERSION
CCLSW		GIVES RAPID PROGRAM GENERATION FEATURE
FTDISK		GIVES DISK FEATURES
RENTSW		ASSEMBLE REENTRANT PROGRAMS

	SWITCHES OFF (ZERO) IN DEC VERSION
LNSSW		GIVES LNS VERSION
IIISW		GIVES III FEATURES
OPHSH		GIVES HASH SEARCH OF OPCODES
*
SUBTTL	DEFAULT ASSEMBLY SWITCH SETTINGS


IFNDEF RENTSW,<RENTSW==0>

IFNDEF LNSSW,<LNSSW==0>
IFN LNSSW,<FTDISK==0>

IFNDEF CCLSW,<CCLSW==1>
IFN CCLSW,<FTDISK==1>

IFNDEF UNIVR,<UNIVR==0>

IFNDEF FTDISK,<FTDISK==0>

IFNDEF IIISW,<IIISW==0>

IFNDEF OPHSH,<OPHSH==0>

SUBTTL	OTHER PARAMETERS

.PDP==	^D50		;BASIC PUSH-DOWN POINTER
IFNDEF LPTWID,<LPTWID==^D132>	;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/8>		;USEFUL WIDTH IN MAIN LISTING
.CPL==	.LPTWD-^D32		;WIDTH AVAIABLE FOR TEXT WHEN
				;BINARY IS IN HALFWORD FORMAT
.LPP==^D55	;LINES/PAGE
.STP==	^D40		;STOW SIZE
.TBUF==	^D80		;TITLE BUFFER
.SBUF==	^D80		;SUB-TITLE BUFFER
.IFBLK==^D20		;IFIDN COMPARISON BLOCK SIZE
.R1B==^D18
.UNIV==^D10		;NUMBER OF UNIVERSAL DEFINITIONS
.LEAF==4		;SIZE OF BLOCKS IN MACRO TREE

NCOLS==1		;NUMBER OF COLUMNS IN SYMBOL TABLE
IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D200>>
IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>
IFNDEF NUMBUF,<
IFE LNSSW,<NUMBUF==2	;NUMBER OF INPUT BUFFERS>
IFN LNSSW,<NUMBUF==4	;DOUBLE BUFFER FOR DOUBLE SIZE DEVICES>
>

EXTERN	JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA
IFN CCLSW,<	EXTERN	JOBERR>

	SALL		;SUPPRESS ALL MACROS

;SOME ASCII CHARACTERS

HT==11
LF==12
VT==13
FF==14
CR==15
EOL==33
			;ACCUMULATORS
AC0==	0
AC1=	AC0+1
AC2=	AC1+1
SDEL=	3		;SEARCH INCREMENT
SX=	SDEL+1		;SEARCH INDEX
ARG=	5		;ARGUMENT
V=	6		;VALUE
C=	7		;CURRENT CHARACTER
CS=	C+1		;CHARACTER STATUS BITS
RC=	11		;RELOCATION BITS
MWP=	12		;MACRO WRITE POINTER
MRP=	13		;MACRO READ POINTER
IO=	14		;IO REGISTER (LEFT)
ER==	IO		;ERROR REGISTER (RIGHT)
FR=	15		;FLAG REGISTER (LEFT)
RX==	FR		;CURRENT RADIX (RIGHT)
MP=	16		;MACRO PUSHDOWN POINTER
PP=	17		;BASIC PUSHDOWN POINTER

%OP==	3
%MAC==	5
%DSYM==	2
%SYM==	1
%DMAC==	%MAC+1

OPDEF	RESET	[CALLI	 0]
OPDEF	SETDDT	[CALLI   2]
OPDEF	DDTOUT	[CALLI	 3]
OPDEF	DEVCHR	[CALLI	 4]
OPDEF	WAIT	[MTAPE	 0]
OPDEF	CORE	[CALLI	11]
OPDEF	EXIT	[CALLI	12]
OPDEF	UTPCLR	[CALLI	13]
OPDEF	DATE	[CALLI	14]
OPDEF	APRENB	[CALLI	16]
OPDEF	MSTIME	[CALLI	23]
OPDEF	PJOB	[CALLI	30]
OPDEF	RUN	[CALLI	35]
OPDEF	TMPCOR	[CALLI	44]

			;FR  FLAG REGISTER (FR/RX)
IOSCR== 000001		;NO CR AFTER LINE
MTAPSW==000004		;MAG TAPE
ERRQSW==000010		;IGNORE Q ERRORS
LOADSW==000020		;END OF PASS1 & NO EOF YET
DCFSW==	000040		;DECIMAL FRACTION
RIM1SW==000100		;RIM10 MODE
NEGSW==	000200		;NEGATIVE ATOM
RIMSW==	000400		;RIM OUTPUT
PNCHSW==001000		;RIM/BIN OUTPUT WANTED
CREFSW==002000
R1BSW== 004000		;RIM10 BINARY OUTPUT
TMPSW==	010000		;EVALUATE CURRENT ATOM
INDSW==	020000		;INDIRECT ADDRESSING WANTED
RADXSW==040000		;RADIX ERROR SWITCH
FSNSW== 100000		;NON BLANK FIELD SEEN
MWLFLG==200000		;ON FOR DON'T ALLOW MULTI-WORD LITERALS
P1==	400000		;PASS1

			;IO FLAG REGISTER (IO/ER)
FLDSW==	400000		;ADDRESS FIELD
IOMSTR==200000
ARPGSW==100000		;ALLOW RAPID PROGRAM GENERATION
IOPROG==040000		;SUPRESS LISTING (LIST/XLIST PSEUDO OP)
NUMSW==	020000
IOMAC==	010000		;MACRO EXPANSION IN PROGRESS
IOPALL==004000		;SUPRESS LISTING OF MACRO EXPANSIONS
IONCRF==002000		;SUPRESS OUTPUT OF CREF INFORMATION
CRPGSW==001000		;CURRENTLY IN PROGRESS ON RPG
IOCREF==000400		;WE ARE NOW OUTPUTTING CREF INFO
IOENDL==000200		;BEEN TO STOUT
IOPAGE==000100
DEFCRS==000040		;THIS IS A DEFINING OCCURANCE (MACROS)
IOIOPF==000020		;IOP INSTRUCTION SEEN
MFLSW== 000010		;MULTI-FILE MODE,PRGEND SEEN
IORPTC==000004		;REPEAT CURRENT CHARACTER
IOTLSN==000002		;TITLE SEEN
IOSALL==000001		;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED

OPDEF	JUMP1	[JUMPL	FR,  ]	;JUMP IF PASS 1
OPDEF	JUMP2	[JUMPGE	FR,  ]	;JUMP IF PASS 2

OPDEF	JUMPOC	[JUMPGE	IO,  ]	;JUMP IF IN OP-CODE FIELD
OPDEF	JUMPAD	[JUMPL	IO,  ]	;JUMP IF IN ADDRESS FIELD

OPDEF	JUMPCM	[JUMPL	CS,  ]	;JUMP IF CURRENT CHAR IS COMMA
OPDEF	JUMPNC	[JUMPGE	CS,  ]	;JUMP IF CURRENT CHAR IS NON-COMMA

			;ER ERROR REGISTERS (IO/ER)
ERRM==	000020		;MULTIPLY DEFINED SYMBOL
ERRE==	000040		;ILLEGAL USE OF EXTERNAL
ERRP==	000100		;PHASE DISCREPANCY
ERRO==	000200		;UNDEFINED OP CODE
ERRN==	000400		;NUMBER ERROR
ERRV==	001000		;VALUE PREVIOUSLY UNDEFINED
ERRU==	002000		;UNDEFINED SYMBOL
ERRR==	004000		;RELOCATION ERROR
ERRL==	010000		;LITERAL ERROR
ERRD==	020000		;REFERENCE TO MULTIPLY DEFINED SYMBOL
ERRA==	040000		;PECULIAR ARGUMENT
ERRX==	100000		;MACRO DEFINITION ERROR
ERRQ==	200000		;QUESTIONABLE, NON-FATAL ERROR
ERRORS==777760
LPTSW==	000002
TTYSW==	000001

			;SYMBOL TABLE FLAGS
SYMF==	400000		;SYMBOL
TAGF==	200000		;TAG
NOOUTF==100000		;NO DDT OUTPUT WFW
SYNF==	040000		;SYNONYM
MACF==	SYNF_-1		;MACRO
OPDF==	SYNF_-2		;OPDEF
PNTF==	004000		;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE
UNDF==	002000		;UNDEFINED
EXTF==	001000		;EXTERNAL
INTF==	000400		;INTERNAL
ENTF==	000200		;ENTRY
VARF==	000100		;VARIABLE
MDFF==	000020		;MULTIPLY DEFINED
SPTR==	000010		;SPECIAL EXTERNAL POINTER
SUPRBT==000004		;SUPRESS OUTPUT TO DDT
LELF==	000002		;LEFT HAND RELOCATABLE
RELF==	000001		;RIGHT HAND RELOCATABLE

LITF==  200000		;FLAG FOR PSEUDO-OPS INVALID IN LIT'S
ADDF==  100000		;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES

TNODE==	200000		;TERMINAL NODE FOR EVALEX
SUBTTL	RUN UUO

IFN CCLSW,<
;THIS CODE MUST BE IN FIRST 1K TO ALLOW MAXIMUM SPACE
; FOR OVERWRITING
; 74 APPEARS BECAUSE ONLY LOCS 74 AND BEYOND ARE SAVED BY "SAVE"

IFN CCLSW,<NUNCOM:	IOWD	0,INHERE	;WHERE TO DO IO
	0			;TERMINATE COMMAND LIST
NUNGO2:	IN	BIN,NUNCOM	;READ FILE
	JRST	NUNGO3		;THERE ARE NO ERRORS
NUNERR:	DDTOUT	NUNPNT,		;COMPLAIN
	EXIT			;GIVE UP
NUNERM:	ASCIZ	/?LINKAGE ERROR/
NUNGO3:	SKIPE	12,INHERE+133-74 ;LOOK AT JOBCOR
				;DOES JOB WANT TO RUN IN MORE CORE?
	CAMG	12,JOBREL	;MORE CORE THAN CURRENTLY USED?
	JRST	NUNGO4		;NO, GO BLT PROG
	CORE	12,		;ASK FOR MORE CORE
	JRST	NUNERR		;NOT AVAILABLE
	JRST	NUNGO4		;GO BLT PROGRAM
INHERE:
;THIS CODE MUST BE IN FIRST 1K
NUNSET:	JUMPN	ACDEV,.+2		;DEVICE SPECIFIED?
	MOVSI	ACDEV,(SIXBIT /SYS/)	;NO, USE SYSTEM DEVICE
	JUMPN	ACEXT,.+2		;EXT SPECIFIED?
	MOVSI	ACEXT,(SIXBIT /SAV/)	;NO, USE "SAV"
	MOVEM	ACDEV,NUNDEV		;DEVICE NAME TO USE
	OPEN	BIN,NUNINI		;INIT THE DEVICE
	JRST	EINIT			;ERROR
	MOVEM	ACFILE,NUNDIR		;IS THE FILE AVAILABLE?
	HLLZM	ACEXT,NUNDIR+1		;STASH EXTENSION
	SETZM	NUNDIR+3		;CLEAR PPN
	LOOKUP	BIN,NUNDIR		;LOOK FOR FILE
	JRST	[HLRZ	ACEXT,NUNDIR+1		;WAS EXTENSION "SAV"?
		CAIE	ACEXT,(SIXBIT /SAV/)	;...
		JRST	ERRCF			;GO COMPLAIN
		MOVSI	ACEXT,(SIXBIT /DMP/)	;TRY "DMP" EXTENSION
		JRST	.-3	]		;TRA -3,4
	PUSHJ PP,DELETE		;COMMAND FILE
	MOVE 15,NUNDIR		;GET THE NAME
	CALLI 15,43	;TELL SYSTEM "SETNAM"
	HLRO	15,NUNDIR+3	;GET WORD COUNT
	HRLM	15,NUNCOM	;STASH COUNT
	MOVNS	15		;NEGATIVE COUNT
	MOVEI	16,73(15)	;WHERE TO STOP BLT
	ADDI	15,INHERE	;HOW BIG TO MAKE CORE
	IORI	15,1777		;AN EVEN MULTIPLE OF 1K
	CORE	15,		;ASK TS EXEC FOR CORE
	JRST	[HRROI RC,[SIXBIT /NOT ENUF CORE FOR LINKAGE@/]
		JRST ERRFIN	];GO COMPLAIN
	MOVSI	NUNTOP,NUNAC
	BLT	NUNTOP,NUNTOP	;SET ACS
	HRR	NUNBLT,16	;...
	TLNN	IO,CRPGSW	;WAS RPG IN PROGRESS?
	TLZ	NUNAOS,577000	;NO, DON'T MAKE NEXT AN RPG
	JRST	NUNGO2

NUNAC:	PHASE	0
NUNGO4:	MOVE	NUNLAC,INHERE+74-74	;SETUP FOR NEW DDT
	SETDDT	NUNLAC,		;...
INTERN JOBS41
JOBS41=122		;LOADER WILL GIVE MUL. DEF. GLOBAL IF CHANGED

EXTERN JOB41
	MOVE	NUNLAC,JOBS41+INHERE-74	;RESTORE LOC 41
	MOVEM	NUNLAC,JOB41	;...
NUNBLT:	BLT	NUNTOP,.-.	;MOVE PRGM TO WHERE IT BELONGS
	RESET			;RESET ALL I/O
NUNAOS:	AOS	1,JOBSA		;GET STARTING ADDR FOR RPG
	JRST	0(1)		;GET ON WITH THE GAME
NUNPNT:	NUNERM			;ERROR MESSAGE POINTER
NUNTOP:	XWD	INHERE+1,75
NUNLAC=.
	DEPHASE
>   
	LIST

DELETE:	HRRZ	EXTMP		;IF THE EXTENSION
	CAIE	(SIXBIT/TMP/)	;IS  .TMP
	POPJ	PP,		;RETURN.
	CLOSE	CTL2,		;DELETE
	SETZB	4,5		;THE COMMAND FILE.
	SETZB	6,7
	RENAME	CTL2,4		;
	JFCL
	POPJ	PP,
>
SUBTTL	START ASSEMBLING

ASSEMB:	PUSHJ	PP,INZ		;INITIALIZE FOR PASS
	MOVE	[ASCII /.MAIN/]
	MOVEM	TBUF
	MOVEI	SBUF
	HRRM	SUBTTX

ASSEM1:	PUSHJ	PP,CHARAC	;TEST FOR FORM FEED
	SKIPGE	LIMBO		;CRLF FLAG?
	JRST	ASSEM1		;YES ,IGNORE LF
	CAIN	C,14
	SKIPE	SEQNO
	JRST	ASSEM2
	PUSHJ	PP,OUTFF1
	PUSHJ	PP,OUTLI
	JRST	ASSEM1

ASSEM2:	AOS	TAGINC
	CAIN	C,"\"		;BACK-SLASH?
	TLZA	IO,IOMAC	;YES, LIST IF IN MACRO
	TLO	IO,IORPTC
	PUSHJ	PP,STMNT	;OFF WE GO
	TLZN	IO,IOENDL	;WAS STOUT PRE-EMPTED?
	PUSHJ	PP,STOUT	;NO, POLISH OFF LINE
	JRST	ASSEM1

SUBTTL	STATEMENT PROCESSOR

STMNT:	TLZ	FR,INDSW!FSNSW
	TLZA	IO,FLDSW
STMNT1:	PUSHJ	PP,LABEL
STMNT2:	PUSHJ	PP,ATOM		;GET THE FIRST ATOM
	CAIN	C,35		;"="?
	JRST	ASSIGN		;YES
	CAIN	C,32		;":"?
	JRST	STMNT1		;YES
	JUMPAD	STMNT7		;NUMERIC EXPRESSION
	JUMPN	AC0,STMN2A	;JUMP IF NON NULL FIELD
	SKIPN	LITLVL		;ALLOW COMMA IN LITERALS
	CAIE	C,14		;NULL, COMMA?
	CAIN	C,EOL		;OR END OF LINE?
	POPJ	PP,		;YES,EXIT
	CAIN	C,"]"		;CLOSING LITERAL?
	POPJ	PP,		;YES
	JRST	STMNT9		;NO,AT LEAST SKIP ALL THIS NONSENSE

STMN2A:	JUMPE	C,.+2
	TLO	IO,IORPTC
	PUSHJ	PP,MSRCH	;SEARCH FOR MACRO/OPDEF/SYN
	JRST	STMNT3		;NOT FOUND, TRY OP CODE
	LDB	SDEL,[POINT 3,ARG,5]
	JUMPE	SDEL,ERRAX	;ERROR IF NO FLAGS
	SOJE	SDEL,OPD1	;OPDEF IF 1
	SOJE	SDEL,CALLM	;MACRO IF 2
	JRST	STMNT4		;SYNONYM, PROCESS WITH OP-CODES

STMNT3:	PUSHJ	PP,OPTSCH	;SEARCH OP CODE TABLE
	JRST	STMNT5		;NOT FOUND
STMNT4:	HLLZ	AC0,V		;PUT CODE IN AC0
	TRZ	V,ADDF		;CLEAR ADDRESS NON-VALID FLAG
	TRZE	V,LITF		;VALID IN LITERAL?
	SKIPN	LITLVL		;NO, ARE WE IN A LITERAL?
	JRST	0(V)		;NO, GO TO APPROPRIATE PROCESSOR
	POPJ	PP,		;YES,EXIT

STMNT5:	PUSHJ	PP,SSRCH	;TRY SYMBOLS
	JRST	STMNT8		;NOT FOUND
	TLNE	ARG,EXTF!UNDF	;EXTERNAL OR UNDEFINED?
	JRST	STMNT7		;YES, PROCESS IN EVALEX
	TLNN RC,-2		;CHECK FOR EXTERNAL
	TRNE RC,-2
	JRST STMNT7
	MOVE	AC0,V		;FOUND, PUT VALUE IN AC0
	TLO	IO,NUMSW	;FLAG AS NUMERIC
STMNT7:	TLZ	IO,IORPTC
STMNT9:	PUSHJ	PP,EVALHA	;EVALUATE EXPRESSION
	TLNE	FR,FSNSW	;FIELD SEEN?
	JRST	STOW		;YES,STOW THE CODE AND EXIT
	CAIE	C,"]"-40	;CLOSING LITERAL?
	TRO	ER,ERRQ		;NO, GIVE "Q" ERROR
	POPJ	PP,		;EXIT

STMNT8:repeat 0,<MOVEI	V,0		;ALWAYS START SCAN WITH 0
	CAIL	V,CALNTH	;END OF TABLE?
	JRST	STMN8C		;YES, TRY TTCALLS
	CAME	AC0,CALTBL(V)	;FOUND IT?
	AOJA	V,.-3		;NO,TRY AGAIN
	SUBI	V,NEGCAL	;CALLI'S START AT -1
	HRLI	V,(CALLI)	;PUT IN UUO>
STMN8D:	MOVSI	ARG,OPDF	;SET FLAG FOR OPDEF
STMN8B:	PUSHJ	PP,INSERT	;PUT OPDEF IN TABLE
	JRST	OPD		;AND TREAT AS OPDEF

STMN8C:	SETZ	V,		;START WITH ZERO
	CAIL	V,TTCLTH	;END OF TABLE?
	JRST	STMN8A		;YES, ERROR
	CAME	AC0,TTCTBL(V)	;MATCH?
	AOJA	V,.-3		;NO, KEEP TRYING
	LSH	V,5		;PUT IN AC FIELD (RIGHT HALF)
	HRLZI	V,<(TTCALL)>(V)	;PUT UUO IN LEFT HALF
	JRST	STMN8D		;SET OPDEF FLAG

STMN8A:	SETZB	V,RC		;CLEAR VALUE AND RELOCATION
	TRO	ER,ERRO		;FLAG AS UNDEFINED OP-CODE
	JUMP1	OPD		;TREAT AS STANDARD OP ON PASS1
	MOVSI	ARG,OPDF!UNDF!EXTF	;SET A FEW FLAGS
	JRST	STMN8B		;TO FORCE OUT A MESSAGE

		;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)
			;UNTIL A LINE TERMINATOR IS SEEN.
STOUTS:	TLOA	IO,IOENDL!IORPTC
STOUT:	TLO	IO,IORPTC
	PUSHJ	PP,BYPAS1
	CAIN	C,14		;COMMA?
	SKIPL	STPX		;YES, ERROR IF CODE STORED
	CAIN	C,EOL
	TLOA	IO,IORPTC
	TRO	ER,ERRQ
STOUT1:	PUSHJ	PP,CHARAC
	CAIG	C,CR
	CAIG	C,HT
	JRST	STOUT1
	JRST	OUTLIN		;OUTPUT THE LINE (BIN AND LST)
	SUBTTL	LABEL PROCESSOR
	
LABEL:	JUMPAD	LABEL4		;COMPARE IF NON-SYMBOLIC
	JUMPE	AC0,LABEL5	;ERROR IF BLANK
	TLO IO,DEFCRS		;THIS IS A DEFINITION
	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	MOVSI	ARG,SYMF!UNDF!TAGF	;NOT FOUND
	TLNN	ARG,EXTF	;OPERAND FOUND (SKIP EXIT)
	JRST	LABEL0
	JUMP1	LABEL3		;ERROR ON PASS1
	TLNN	ARG,UNDF	;UNDEFINED ON PASS1
	JRST	LABEL3		;NO, FLAG ERROR
	TLZ	ARG,EXTF!PNTF	;TURN OFF EXT FLAG NOW
LABEL0:	TLZN	ARG,UNDF!VARF	;WAS IT PREVIOUSLY DEFINED?
	JRST	LABEL2		;YES, CHECK EQUALITY
	MOVE	V,LOCA	;WFW
	MOVE	RC,MODA
	TLO	ARG,TAGF
	PUSHJ	PP,PEEK		;GET NEXT CHAR.
	CAIE	C,":"		;SPECIAL CHECK FOR  ::
	JRST	LABEL1		;NO MATCH
	TLO	ARG,INTF	;MAKE IT INTERNAL
	PUSHJ	PP,GETCHR	;PROCESS NEXT CHAR.
	PUSHJ	PP,PEEK		;PREVIEW NEXT CHAR.
LABEL1:	CAIE	C,"!"		;HALF-KILL SIGN
	JRST	LABEL6		;NO
	TLO	ARG,NOOUTF	;YES, SUPPRESS IT
	PUSHJ	PP,GETCHR	;AND GET RID OF IT
LABEL6:	MOVEM	AC0,TAG		;SAVE FOR PASS 1 ERRORS
	HLLZS	TAGINC		;ZERO INCREMENT
	JRST	INSERT		;INSERT/UPDATE AND EXIT

LABEL2:	HRLOM	V,LOCBLK	;SAVE LIST LOCATION
	CAMN	V,LOCA		;DOES IT COMPARE WITH PREVIOUS? WFW
	CAME	RC,MODA
LABEL3:	TLOA	ARG,MDFF	;NO, FLAG MULTIPLY DEFINED AND SKIP
	JRST	LABEL7		;YES, GET RID OF EXTRA CHARS.
	TRO	ER,ERRM		;FLAG MULTIPLY DEFINED ERROR 
	JRST	UPDATE		;UPDATE AND EXIT

LABEL4:	CAMN	AC0,LOCA	;DO THEY COMPARE?
	CAME	RC,MODA
LABEL5:	TRO	ER,ERRP		;NO, FLAG PHASE ERROR
	POPJ	PP,

LABEL7:	SKIPE	LITLVL		;LABEL IN A LITERAL?
	MOVEM	AC0,LITLBL	;YES, SAVE LABEL NAME FOR LATER
	PUSHJ	PP,PEEK		;INSPECT A CHAR.
	CAIN	C,":"		;COLON?
	PUSHJ	PP,GETCHR	;YES, DISPOSE OF IT
	PUSHJ	PP,PEEK		;EXAMINE ONE MORE CHAR.
	CAIN	C,"!"		;EXCLAMATION?
	JRST	GETCHR		;YES, INDEED
	POPJ	PP,
SUBTTL	ATOM PROCESSOR
ATOM:	PUSHJ	PP,CELL		;GET FIRST CELL
	TLNE	IO,NUMSW	;IF NON-NUMERIC
ATOM1:	CAIE	C,42		;OR NOT A BINARY SHIFT,
	POPJ	PP,		;EXIT

	PUSH	PP,AC0		;STACK REGISTERS, ITS A BINARY SHIFT
	PUSH	PP,AC1
	PUSH	PP,RC
	PUSH	PP,RX
	HRRI	RX,^D10		;COMPUTE SHIFT RADIX 10
	PUSHJ	PP,CELLSF	;GET SHIFT
	MOVE	ARG,RC		;SAVE RELOCATION
	POP	PP,RX		;RESTORE REGISTERS
	POP	PP,RC
	POP	PP,AC1
	MOVN	SX,AC0		;USE NEGATIVE OF SHIFT
	POP	PP,AC0
	JUMPN	ARG,NUMER2	;IF NOT ABSOLUTE
	TLNN	IO,NUMSW	;AND NUMERIC,
	JRST	NUMER2		;FLAG ERROR
	LSHC	AC0,^D35(SX)
	LSH	RC,^D35(SX)
	JRST	ATOM1		;TEST FOR ANOTHER
CELLSF:	TLO	IO,FLDSW
CELL:	SETZB	AC0,RC		;CLEAR RESULT AND RELOCATION
	SETZB	AC1,AC2		;CLEAR WORK REGISTERS
	MOVEM	PP,PPTEMP	;SAVE PUSHDOWN POINTER
	TLZ	IO,NUMSW
	TLZA	FR,NEGSW!DCFSW!RADXSW

CELL1:	TLO	IO,FLDSW
	PUSHJ	PP,BYPASS
	LDB	V,[POINT 4,CSTAT(C),14]	;GET CODE
	XCT	.+1(V)		;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE
	JRST	CELL1		;0; BLANK, (TAB OR "+")
	JRST	LETTER		;1; LETTER  ] $ % ( ) , ; >
	TLC	FR,NEGSW	;2; "-"
	TLO	FR,INDSW	;3; "@"
	JRST	NUM1		;4; NUMERIC   0 - 9
	JRST	ANGLB		;5; "<"
	JRST	SQBRK		;6; "["
	JRST	QUOTES		;7; ""","'" 
	JRST	QUAL		;10; "^"
	JRST	PERIOD		;11; "."
	TROA	ER,ERRQ		;12; ERROR, FLAG AND TREAT AS DELIMITER
				;12;	! # & * / : = ? \ _
LETTER:	TLOA	AC2,(POINT 6,AC0,)	;SET BYTE POINTER
LETTE1:	PUSHJ	PP,GETCHR	;GET CHARACTER
	TLNN	CS,6		;ALPHA-NUMERIC?
	JRST	LETTE3		;NO,TEST FOR VARIABLE
	TLNE	AC2,770000	;STORE ONLY SIX BYTES
LETTE2:	IDPB	C,AC2		;RETURN FROM PERIOD
	JRST	LETTE1

LETTE3:	CAIE	C,03		;"#"?
	POPJ	PP,
	JUMPE	AC0,POPOUT	;TEST FOR NULL
	PUSHJ	PP,PEEK		;PEEK AT NEXT CHAR.
	CAIN	C,"#"		;IS IT 2ND #?
	JRST	LETTE4		;YES, THEN IT'S AN EXTERN
	TLO	IO,DEFCRS
	PUSHJ	PP,SSRCH	;YES, SEARCH FOR SYMBOL (OPERAND)
	MOVSI	ARG,SYMF!UNDF	;NOT FOUND, FLAGAS UNDEFINED SYM.
	TLNN	ARG,UNDF	;UNDEFINED?
	JRST	GETCHR		;NO, GET NEXT CHAR AND RETURN
	TLO	ARG,VARF	;YES, FLAG AS A VARIABLE
	TRO	ER,ERRU		;SET UNDEFINED ERROR FLAG
	PUSHJ	PP,INSERZ	;INSERT IT WITH A ZERO VALUE
	JRST	GETDEL

LETTE4:	PUSHJ	PP,GETCHR	;AND SCAN PAST IT
	PUSHJ	PP,GETCHR	;GET RID OF #
	JRST	EXTER1		;PUT IN SYMBOL TABLE

NUMER1:	SETZB	AC0,RC		;RETURN ZERO
NUMER2:	TRO	ER,ERRN		;FLAG ERROR

GETDEL:	PUSHJ	PP,BYPASS
GETDE1:	JUMPE	C,.-1
	MOVEI	AC1,0
GETDE3:	TLO	IO,NUMSW!FLDSW	;FLAG NUMERIC
	TLNN	FR,NEGSW	;IS ATOM NEGATIVE?
	POPJ	PP,		;NO, EXIT
	JUMPE	AC1,GETDE2
	MOVNS	AC1
	TDCA	AC0,[-1]
GETDE2:	MOVNS	AC0		;YES, NEGATE VALUE
	MOVNS	RC		;AND RELOCATION
POPOUT:	POPJ	PP,		;EXIT
QUOTES:	CAIE	C,"'"-40	;IS IT  "'"
	JRST	QUOTE		;NO MUST BE """
	JRST	SQUOTE		;YES

QUOTE0:	TLNE	AC0,376000	;5 CHARACTERS STORED ALREADY?
	TRO	ER,ERRQ		;YES, GIVE WARNING
	ASH	AC0,7
	IOR	AC0,C
QUOTE:	PUSHJ	PP,CHARAC	;GET 7-BIT ASCII
	CAIG	C,15		;TEST FOR LF, VT, FF OR CR
	CAIGE	C,12
	JRST	.+2		;NO, SO ALL IS WELL
	JRST	QUOTE2		;ESCAPE WITH Q ERROR
	CAIE	C,42
	JRST	QUOTE0
	PUSHJ	PP,PEEK		;LOOK AT NEXT CHAR.
	CAIE	C,42
	JRST	QUOTE1		;RESTORE REPEAT LEVEL AND QUIT
	PUSHJ	PP,CHARAC	;GET NEXT CHAR.
	JRST	QUOTE0		;USE IT

QUOTE2:	TRO	ER,ERRQ		;SET Q ERROR
QUOTE1:	JRST	GETDEL

SQUOT0:	TLNE	AC0,770000	;SIX CHARS. STORED ALREADY ?
	TRO	ER,ERRQ		;YES
	LSH	AC0,6
	IORI	AC0,-40(C)	;OR IN SIXBIT CHAR.

SQUOTE:	PUSHJ	PP,CHARAC
	CAIG	C,CR
	CAIGE	C,LF
	JRST	.+2
	JRST	QUOTE1
	CAIE	C,"'"
	JRST	SQUOT0
	PUSHJ	PP,PEEK
	CAIE	C,"'"
	JRST	QUOTE1
	PUSHJ	PP,CHARAC
	JRST	SQUOT0

QUAL:	PUSHJ	PP,BYPAS1	;SKIP BLANKS, GET NEXT CHARACTER
	CAIN	C,42		;"B"?
	JRST	QUAL2		;YES, RADIX=D2
	CAIN	C,57		;"O"?
	JRST	QUAL8		;YES, RADIX=D8
	CAIN	C,46		;"F"?
	JRST	NUMDF		;YES, PROCESS DECIMAL FRACTION
	CAIN	C,54		;"L"?
	JRST	QUALL		;YES
	CAIE	C,44		;"D"?
	JRST	NUMER1		;NO, FLAG NUMERIC ERROR
	ADDI	AC2,2
QUAL8:	ADDI	AC2,6
QUAL2:	ADDI	AC2,2
	PUSH	PP,RX
	HRR	RX,AC2
	PUSHJ	PP,CELLSF
QUAL2A:	POP	PP,RX
	TLNN	IO,NUMSW
	JRST	NUMER1
	JRST	GETDE1

QUALL:	PUSH	PP,FR
	PUSHJ	PP,CELLSF
	MOVE	AC2,AC0
	MOVEI	AC0,^D36
	JUMPE	AC2,QUAL2A
	LSH	AC2,-1
	SOJA	AC0,.-2
SUBTTL	LITERAL PROCESSOR

SQBRK:	PUSH	PP,FR
	PUSH	PP,EXTPNT	;ALLOW EXTERN TO PRECEDE LIT IN XWD
	SETZM	EXTPNT
	SKIPE LITLVL	;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY
	JRST SQB5
	MOVE C,SEQNO2
	MOVEM C,LITSEQ
	MOVE C,PAGENO
	MOVEM C,LITPG
SQB5:	JSP	AC2,SVSTOW
SQB3:	PUSHJ	PP,STMNT
	CAIN C,75	;CHECK FOR ]
	JRST SQB1
	TLO IO,IORPTC
	TLNE	FR,MWLFLG	;CALL IT ] IF NOT MULTI-WORD FLAG
	JRST	SQB2		;BUT REPEAT LAST CHARACTER
	PUSHJ PP,BYPAS1
	CAIN C,EOL
	TLOA IO,IORPTC
	TRO ER,ERRQ
SQB4:	PUSHJ PP,CHARAC
	CAIN	C,";"		;COMMENT?
	JRST	SQB6		;YES, IGNORE SQUARE BRACKETS
	CAIN	C,"]"		;LOOK FOR TERMINAL SQB
	TRNN	ER,ERRORS	;IN CASE OF ERROR IN LITERAL
	JRST	.+2		;NO ALL IS WELL
	JRST	SQB1		;FINISH THE LITERAL NOW!!
	CAIG	C,CR		;LOOK FOR END OF LINE
	CAIN	C,HT
	JRST	SQB4
SQB4A:	PUSHJ	PP,OUTIML	;DUMP
	PUSHJ	PP,CHARAC	;GET ANOTHER CHAR.
	SKIPL	LIMBO		;CRLF FLAG
	TLO	IO,IORPTC	;NO REPEAT
	JRST	SQB3

SQB6:	PUSHJ	PP,CHARAC	;GET A CHARACTER
	CAIG	C,CR
	CAIN	C,HT		;LOOK FOR END OF LINE CHAR.
	JRST	SQB6		;NOT YET
	JRST	SQB4A		;GOT IT

SQB1:	TLZ	IO,IORPTC
SQB2:	PUSHJ	PP,STOLIT
	JSP	AC2,GTSTOW
	SKIPE	LITLBL		;NEED TO FIXUP A LABEL?
	PUSHJ	PP,RELBLE	;YES, USE LOC OF LITERAL
	POP	PP,EXTPNT
	POP	PP,FR
	SKIPE	LITLVL		;WERE WE NESTED?
	JUMP1	NUMER2		;YES, FORCE ERROR IF PASS 1
	JRST	GETDEL

RELBLE:	PUSH	PP,AC0		;SAVE LOCATION COUNTER
	PUSH	PP,RC		;AND RELOCATION
	MOVE	AC0,LITLBL	;SYMBOL WE NEED
	SETZM	LITLBL		;ZERO INDICATOR
	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	JRST	RELBL1		;SHOULD NEVER HAPPEN
	TLNN	ARG,TAGF	;IT BETTER BE A LABEL
	JRST	RELBL1		;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE
	TLZ	ARG,UNDF!EXTF!PNTF	;CLEAR FLAGS NOW
	POP	PP,RC		;GET LITERAL RELOCATION
	MOVE	V,(PP)		;GET VALUE (LOC COUNTER)
	PUSHJ	PP,UPDATE	;UPDATE VALUE
	POP	PP,AC0		;RESTORE LITERAL COUNT
	POPJ	PP,		;RETURN
	
RELBL1:	POP	PP,RC		;RESTORE RC
	POP	PP,AC0	;AND AC0
	POPJ	PP,		;JUST RETURN
ANGLB:	PUSH	PP,FR
	TLZ	FR,INDSW
	PUSHJ	PP,ATOM
	TLNN	IO,NUMSW
	CAIE	C,35
	JRST	ANGLB1
	PUSHJ	PP,ASSIG1
	MOVE	AC0,V
	JRST	ANGLB2

ANGLB1:	PUSHJ	PP,EVALHA
ANGLB2:	POP	PP,FR
	CAIE	C,36
	TRO	ER,ERRN
	JRST	GETDEL

PERIOD:	PUSHJ	PP,GETCHR	;LOOK AT NEXT CHARACTER
	TLNN	CS,2		;ALPHABETIC?
	JRST	PERNUM		;NO, TEST NUMERIC
	MOVSI	AC0,(SIXBIT /./)	;YES, PUT PERIOD IN AC0
	MOVSI	AC2,(POINT 6,AC0,5)	;SET BYTE POINTER
	JRST	LETTE2		;AND TREAT AS SYMBOL

PERNUM:	TLNE	CS,4		;IS IT A NUMBER
	JRST	NUM32		;YES
	MOVE	AC0,LOCA	;NO. CURRENT LOC SYMBOL (.)
	MOVE	RC,MODA		;SET TO CURRENT ASSEMBLY MODE
	JRST	GETDE1		;GET DELIMITER
NUMDF:	TLO	FR,DCFSW	;SET DECIMAL FRACTION FLAG
NUM:	PUSHJ	PP,GETCHR	;GET A CHARACTER
	TLNN	CS,4		;NUMERIC?
	JRST	NUM10		;NO
NUM1:	SUBI	C,20		;CONVERT TO OCTAL
	PUSH	PP,C		;STACK FOR FLOATING POINT
	MOVE	AC0,AC1
	MULI	AC0,0(RX)
	ADD	AC1,C		;ADD IN LAST VALUE
	CAIL	C,0(RX)		;IS NUMBER LESS THAN CURRENT RADIX?
	TLO	FR,RADXSW	;NO, SET FLAG
	AOJA	AC2,NUM		;YES, AC2=NO. OF DECIMAL PLACES

NUM10:	CAIE	C,16		;PERIOD?
	TLNE	FR,DCFSW	;OR DECIMAL FRACTION?
	JRST	NUM30		;YES, PROCESS FLOATING POINT
	LSH	AC1,1		;NO, CLEAR THE SIGN BIT
	LSHC	AC0,^D35	;AND SHIFT INTO AC0
	MOVE	PP,PPTEMP	;RESTORE PP
	SOJE	AC2,GETDE1	;NO RADIX ERROR TEST IF ONE DIGIT
	TLNE	FR,RADXSW	;WAS ILLEGAL NUMBER ENCOUNTERED?
	TRO	ER,ERRN		;YES, FLAG N ERROR
	JRST	GETDE1

NUM30:	CAIE	C,"B"-40	;IF "B" THEN MISSING  "."
NUM31:	PUSHJ	PP,GETCHR
	TLNN	CS,4		;NUMERIC?
	JRST	NUM40		;NO
NUM32:	SUBI	C,20
	PUSH	PP,C
	JRST	NUM31

NUM40:	PUSH	PP,FR		;STACK VALUES
	HRRI	RX,^D10
	PUSH	PP,AC2
	PUSH	PP,PPTEMP
	CAIN	C,45		;"E"?
	JRST	[PUSHJ PP,PEEK	;GET NEXT CHAR
		PUSH PP,C	;SAVE NEXT CHAR
		PUSHJ PP,CELL	;YES, GET EXPONENT
		POP PP,C	;GET FIRST CHAR. AFTER E
		CAIN V,4	;MUST HAVE NUMERICAL STATUS
		JRST	.+2	;SKIP RETURN
		CAIN C,"<"	;ALLOW <EXP>
		JRST	.+2	;SKIP RETURN
		SKIPN	AC0	;ERROR IF NON-ZERO EXPRESSION
		TROA ER,ERRQ	;ALLOW E+,E-
		SETOM	RC	;FORCE NUMERICAL ERROR
		JRST	.+2]	;SKIP RETURN
	MOVEI	AC0,0		;NO, ZERO EXPONENT
	POP	PP,PPTEMP
	POP	PP,SX
	POP	PP,FR
	HRRZ	V,PP
	MOVE	PP,PPTEMP
	JUMPN	RC,NUMER1	;EXPONENT MUST BE ABSOLUTE
	ADD	SX,AC0
	HRRZ	ARG,PP
	ADD	SX,ARG
	SETZB	AC0,AC2
	TLNE	FR,DCFSW
	JRST	NUM60
	JOV	NUM50		;CLEAR OVERFLOW FLAG

NUM50:	JSP	SDEL,NUMUP	;FLOATING POINT
	JRST	NUM52		;END OF WHOLE NUMBERS
	FMPR	AC0,[10.0]	;MULTIPLY BY 10
	TLO	AC1,233000	;CONVERT TO FLOATING POINT
	FADR	AC0,AC1		;ADD IT IN
	JRST	NUM50

NUM52:	JSP	SDEL,NUMDN	;PROCESS FRACTION
	FADR	AC0,AC2
	JOV	NUMER1		;TEST FOR OVERFLOW
	JRST	GETDE1

	TLO	AC1,233000
	TRNE	AC1,-1
	FADR	AC2,AC1		;ACCUMULATE FRACTION
	FDVR	AC2,[10.0]
	JRST	NUM52

NUM60:	JSP	SDEL,NUMUP
	JRST	NUM62
	IMULI	AC0,^D10
	ADD	AC0,AC1
	JRST	NUM60

NUM62:	LSHC	AC1,-^D36
	JSP	SDEL,NUMDN
	LSHC	AC1,^D37
	PUSHJ	PP,BYPAS2
	JRST	GETDE3

	DIVI	AC1,^D10
	JRST	NUM62

NUMUP:	MOVEI	AC1,0
	CAML	ARG,SX
	JRST	0(SDEL)
	CAMGE	ARG,V
	MOVE	AC1,1(ARG)
	AOJA	ARG,1(SDEL)

NUMDN:	MOVEI	AC1,0
	CAMG	V,SX
	JRST	0(SDEL)
	CAMLE	V,ARG
	MOVE	AC1,0(V)
	SOJA	V,3(SDEL)
SUBTTL	GETSYM
GETSYM:	MOVEI	AC0,0		;CLEAR AC0
	MOVSI	AC1,(POINT 6,AC0)	;PUT POINTER IN AC1
	PUSHJ	PP,BYPASS	;SKIP LEADING BLANKS
	TLNN	CS,2		;ALPHABETIC?
	JRST	GETSY1		;NO, ERROR
	CAIE	C,16		;PERIOD?
	JRST	GETSY2		;NO, A VALID SYMBOL
	IDPB	C,AC1		;STORE THE CHARACTER
	PUSHJ	PP,GETCHR	;YES, TEST NEXT CHARACTER
	TLNN	CS,2		;ALPHABETIC?
GETSY1:	TROA	ER,ERRA
GETSY2:	AOS	0(PP)		;YES, SET SKIP EXIT
GETSY3:	TLNN	CS,6		;ALPHA-NUMERIC?
	JRST	BYPAS2		;NO, GET DELIMITER
	TLNE	AC1,770000	;YES, HAVE WE STORED SIX?
	IDPB	C,AC1		;NO, STORE IT
	PUSHJ	PP,GETCHR
	JRST	GETSY3

SUBTTL	EXPRESSION EVALUATOR
CV==	AC0			;CURRENT VALUE
PV==	AC1			;PREVIOUS VALUE
RC==	RC			;CURRENT RELOCATABILITY
PR==	AC2			;PREVIOUS RELOCATABILITY
CS=	CS			;CURRENT STATUS
PS==	SDEL			;PREVIOUS STATUS

EVALHA:	TLO	FR,TMPSW
EVALCM:	PUSHJ	PP,EVALEX	;EVALUATE FIRST EXPRESSION
	PUSH	PP,[0]		;MARK PDL
	JUMPCM	EVALC3		;JUMP IF COMMA
	TLO	IO,IORPTC	;IT'S NOT,SO REPEAT
	JRST	OP		;PROCESS IN OP
EVALC3:
	PUSH	PP,[0]		;STORE ZERO'S ON PDL
	PUSH	PP,[0]		;.......
	MOVSI	AC2,(POINT 4,(PP),12)
	JRST	OP1B		;PROCESS IN OP

EVALEX:	TLO	IO,FLDSW
	PUSH	PP,[XWD TNODE,0]	;MARK THE LIST 200000,,0
	TLZN	FR,TMPSW
EVATOM:	PUSHJ	PP,ATOM		;GET THE NEXT ATOM
	JUMPE	AC0,EVGETD	;TEST FOR NULL/ZERO
	TLOE	IO,NUMSW	;SET NUMERIC, WAS IT PREVIOUSLY?
	JRST	EVGETD+1	;YES, TREAT ACCORDINGLY
	PUSHJ	PP,SEARCH	;SEARCH FOR MACRO OR SYMBOL
	JRST	EVOP		;NOT FOUND, TRY FOR OP-CODE
	JUMPL	ARG,.+2		;SKIP IF OPERAND
	PUSHJ	PP,SSRCH1	;OPERATOR, TRY FOR SYMBOL (OPERAND)
	PUSHJ	PP,QSRCH	;PERFORM CROSS-REFERENCE
	JUMPG	ARG,EVMAC	;BRANCH IF OPERATOR
	MOVE	AC0,V		;SYMBOL, SET VALUE
	JRST	EVTSTS		;TEST STATUS

EVMAC:	TLNE	FR,NEGSW	;UNARY MINUS?
	JRST	EVERRZ		;YES, INVALID BEFORE OPERATOR
	LDB	SDEL,[POINT 3,ARG,5]	;GET MACF/OPDF/SYNF
	SOJL	SDEL,EVERRZ	;ERROR IF NO FLAGS

	JUMPE	C,.+2		;NON-BLANK?
	TLO	IO,IORPTC	;YES, REPEAT CHARACTER
	SOJE	SDEL,CALLM	;MACRO IF 2
	JUMPG	SDEL,EVOPS	;SYNONYM IF 4

	MOVE	AC0,V		;OPDEF
	MOVEI	V,OP		;SET TRANSFER VECTOR
	JRST	EVOPD
EVOP:	TLNE	FR,NEGSW	;OPCODE, UNARY MINUS?
	JRST	EVERRZ		;YES, ERROR

	PUSHJ	PP,OPTSCH	;SEARCH SYMBOL TABLE
	JRST	EVOPX		;NOT FOUND
EVOPS:	TRZ	V,LITF		;CLEAR LIT INVALID FLAG
	TRZE	V,ADDF		;SYNONYM
	JRST	EVOPX		;PSEUDO-OP THAT GENERATES NO DATA JUMPS
	HLLZ	AC0,V
EVOPD:	JUMPE	C,.+2		;OPDEF, NON-BLANK DELIMITER?
	TLO	IO,IORPTC	;YES, REPEAT CHARACTER
	JSP	AC2,SVSTOW
	PUSHJ	PP,0(V)
	PUSHJ	PP,DSTOW
	JSP	AC2,GTSTOW
	TRNE	RC,-2
	HRRM	RC,EXTPNT
	TLNE RC,-2
	HLLM RC,EXTPNT
	JRST	EVNUM

EVOPX:	MOVSI	ARG,SYMF!UNDF
	PUSHJ	PP,INSERZ
EVERRZ:	SETZB	AC0,RC		;CLEAR CODE AND RELOCATION
EVERRU:	TRO	ER,ERRU
	JRST	EVGETD
EVTSTS:	TLNE	ARG,UNDF
	JRST	[TRO	ER,ERRU	;SET UNDEF ERROR
		JUMP1	EVGETD	;TREAT AS UNDF ON PASS1
		JRST	.+1]	;TREAT AS EXTERNAL ON PASS2
	TLNN	ARG,EXTF
	JRST	EVTSTR
	HRRZ RC,ARG	;GET ADRES WFW
	HRRZ ARG,EXTPNT	;SAVE IT WFW
	HRRM RC,EXTPNT	;WFW
	TRNE ARG,-1	;WFW
	TRO	ER,ERRE
	SETZB	AC0,ARG

EVTSTR:	TLNE	ARG,MDFF	;MULTIPLY DEFINED?
	TRO	ER,ERRD		;YES, FLAG IT
	TLNE	FR,NEGSW	;NEGATIVE ATOM?
	PUSHJ	PP,GETDE2	;YES, NEGATE AC0 AND RC

EVGETD:	TLNE	IO,NUMSW	;NON BLANK FIELD
	TLO	FR,FSNSW	;YES,SET FLAG
	PUSHJ	PP,BYPAS2
	TLNE	CS,6		;ALPHA-NUMERIC?
	TLO	IO,IORPTC	;YES, REPEAT IT
EVNUM:	POP	PP,PS		;POP THE PREVIOUS DELIMITER/TNODE
	TLO	PS,4000
	CAMGE	PS,CS		;OPERATION REQUIRED?
	JRST	EVPUSH		;NO, PUT VALUES BACK ON STACK
	TLNN	PS,TNODE	;YES, HAVE WE REACHED TERMINAL NODE?
	JRST	EVXCT		;NO, EXECUTION REQUIRED
	TLNN	CS,170000	;YES, ARE WE POINTING AT DEL? (& ! * / + - _)
	POPJ	PP,		;YES, EXIT
				;NO,FALL INTO EVPUSH

EVPUSH:	PUSH	PP,PS		;STACK VALUES
	PUSH	PP,CV
	PUSH	PP,RC
	PUSH	PP,CS
	JRST	EVATOM		;GET NEXT ATOM

EVXCT:	POP	PP,PR		;POP PREVIOUS RELOCATABILITY
	POP	PP,PV		;AND PREVIOUS VALUE
	LDB	PS,[POINT 3,PS,29]	;TYPE OF OPERATION TO PS
	JRST	.+1(PS)		;PERFORM PROPER OPERATION
	JRST	ASSEM1		;0; SHOULD NEVER GET HERE ;DMN
	JRST	XMUL		;1;
	JRST	XDIV		;2;
	JRST	XADD		;3;
	JRST	XSUB		;4;
	JRST	XLRW		;5; "_"
	TDOA	CV,PV		;6; MERGE PV INTO CV
	AND	CV,PV		;7; AND PV INTO CV
	JUMPN	RC,.+2		;COMMON RELOCATION TEST
EVXCT1:	JUMPE	PR,EVNUM
	TRO	ER,ERRR		;BOTH MUST BE FIXED
	JRST	EVNUM		;GO TRY AGAIN

XSUB:	SUBM	PV,CV
	SUBM	PR,RC
	JRST	EVNUM

XADD:	ADDM	PV,CV
	ADDM	PR,RC
	JRST	EVNUM

XDIV:	IDIV	PR,CV		;CORRECT RELOCATABILITY
	IDIVM	PV,CV
XDIV1:	EXCH	PR,RC		;TAKE RELOCATION OF NUMERATOR
	JRST	EVXCT1

XMUL:	JUMPE	PR,XMUL1	;AT LEAST ONE OPERAND
	JUMPE	RC,XMUL1	;MUST BE FIXED
	TRO	ER,ERRR
XMUL1:	IORM	PR,RC		;GET RELOCATION TO RC
	CAMGE	PV,CV		;FIND THE GREATER
	EXCH	PV,CV		;FIX IN CASE CV=0,OR 1
	IMULM	PV,RC
	IMULM	PV,CV
	JRST	EVNUM
XLRW:	EXCH	PV,CV
	LSH	CV,0(PV)
	LSH	PR,0(PV)
	JRST	XDIV1
	SUBTTL	LITERAL STORAGE HANDLER
	
STOLER:
	SETZB	AC0,RC	;ERROR, NO CODE STORED
	PUSHJ	PP,STOW		;STOW ZERO
	TRO	ER,ERRL		;AND FLAG THE ERROR

STOLIT:	MOVE	SDEL,STPX
	SUB	SDEL,STPY	;COMPUTE NUMBER OF WORDS
	JUMPE	SDEL,STOLER	;ERROR IF NONE STORED
	TRNN	ER,ERRORS	;ANY ERRORS?
	JRST	STOL06		;NO
	JUMP2	STOL22		;YES, NO SEARCH.  BRANCH IF PASS2
	ADDM	SDEL,LITCNT	;PASS ONE, UPDATE COUNT
	JRST	STOWI		;INITIALIZE STOW

STOL06:	MOVEI	SX,LITAB	;PREPARE FOR SEARCH
	MOVE	ARG,STPX	;SAVE IN THE EVENT OF MULTIPLE-WORD
	HRL	ARG,STPY
	MOVE	AC2,LITNUM
	MOVEI	SDEL,0
STOL08:	PUSHJ	PP,DSTOW	;GET VALUE WFW

STOL10:	SOJL	AC2,STOL24	;TEST FOR END
	MOVE	SX,0(SX)	;NO, GET NEXT STORAGE CELL
	MOVE	V,-1(SX)		;GET RELOCATION BITS WFW
	CAMN	AC0,-2(SX)	;DO CODES COMPARE? WFW
	CAME	RC,V		;YES, HOW ABOUT RELOCATION?
	AOJA	SDEL,STOL10	;NO, TRY AGAIN
	SKIPGE	STPX		;YES, MULTI-WORD?
	JRST	STOL26		;NO, JUST RETURN LOCATION
	MOVEM	AC2,SAVBLK+AC2	;YES, SAVE STARTING INFO
	MOVEM	SX,SAVBLK+SX

STOL12:	SOJL	AC2,STOL23	;TEST FOR END
	PUSHJ	PP,DSTOW	;GET NEXT WORD WFW
	MOVE	SX,0(SX)	;UPDATE POINTER
	MOVE	V,-1(SX)		;GET RELOCATION WFW
	CAMN	AC0,-2(SX)	;COMPARE VALUE WFW
	CAME	RC,V		;AND RELOCATION
	JRST	STOL14		;NO MATCH, TRY AGAIN
	SKIPL	STPX		;MATCH, HAVE WE FINISHED SEARCH?
	JRST	STOL12		;NO, TRY NEXT WORD
	JRST	STOL26		;YES, RETURN LOCATION

STOL14:	MOVE	AC2,SAVBLK+AC2	;RESTORE STOW POINTERS
	MOVE	SX,SAVBLK+SX
	HRREM	ARG,STPX
	HLREM	ARG,STPY
	AOJA	SDEL,STOL08	;BETTER LUCK NEXT TIME

STOL22:	MOVE	SDEL,LITNUM
STOL23:	PUSHJ	PP,DSTOW	;DSTOW AND CONVERT
STOL24:	MOVE	SX,LITABX	;GET CURRENT STORAGE
	PUSHJ	PP,GETTOP	;GET NEXT CELL
	MOVEM	AC0,-2(SX)	;STORE CODE WFW
	MOVEM	RC,-1(SX)	;WFW
	MOVEM	SX,LITABX	;SET POINTER TO CURRENT CELL
	AOS	LITNUM		;INCREMENT NUMBER STORED
	AOS	LITCNT		;INCREMENT NUMBER RESERVED
	SKIPL	STPX		;ANY MORE CODE?
	JRST	STOL23		;YES
STOL26:	JUMP1	POPOUT		;EXIT IF PASS ONE
	MOVE	SX,LITHDX	;GET HEADER BLOCK
	HLRZ	RC,-1(SX)	;GET BLOCK RELOCATION
	HRRZ	AC0,-1(SX)
	ADDI	AC0,0(SDEL)	;COMPUTE ACTUAL LOCATION
	POPJ	PP,		;EXIT

SUBTTL	INPUT ROUTINES
GETCHR:	PUSHJ	PP,CHARAC	;GET ASCII CHARACTER
	CAIL	C,"A"+40	;CHECK FOR LOWER CASE
	CAILE	C,"Z"+40
	JRST	.+2		;NOT LOWER CASE
	TRZA	C,100		;CONVERT LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIXBIT
	CAIG	C,77		;CHAR GREATER THAN SIXBIT?
	JUMPGE	C,GETCS		;TEST FOR VALID SIXBIT
	ADDI	C,40		;BACK TO ASCII
	CAIN	C,HT		;CHECK FOR TAB
	JRST	GETCS2		;MAKE IT LOOK LIKE SPACE
	CAIG	C,CR		;GREATER THAN CR
	CAIG	C,HT		;GREATER THAN TAB
	JRST	GETCS1		;IS NOT FF,VT,LF OR CR
	MOVEI	C,EOL		;LINE OR FORM FEED OR V TAB
	TLOA	IO,IORPTC	;REPEAT CHARACTER
GETCS2:	MOVEI	C,0		;BUT TREAT AS BLANK
GETCS:	MOVE	CS,CSTAT(C)	;GET STATUS BITS
	POPJ	PP,		;EXIT

GETCS1:	JUMPE	C,GETCS		;IGNORE NULS
	TRC	C,100		;MAKE CHAR. VISIBLE
	MOVEI	CS,"^"
	DPB	CS,LBUFP	;PUT ^ IN OUTPUT
	PUSHJ	PP,RSW2		;ALSO MODIFIED CHAR.
	TRO	ER,ERRQ		;FLAG Q ERROR
	JRST	GETCHR		;BUT IGNORE CHAR.

CHARAC:	TLZE	IO,IORPTC	;REPEAT REQUESTED?
	JRST	CHARAX		;YES
RSW0:	JUMPN	MRP,MREAD	;BRANCH IF TREE POINTER SET
	PUSHJ	PP,READ
RSW1:	SKIPE	RPOLVL		;ARE WE IN "REPEAT ONCE"?
	JRST	REPO1		;YES
RSW2:	MOVE	CS,LIMBO	;GET LAST CHAR.
	MOVEM	C,LIMBO	;STORE THIS CHAR. FOR RPTC
	CAIN	C,LF		;LF?
	CAIE	CS,CR		;YES,LAST CHAR. A CR?
	JRST	RSW3		;NO
	HRROS	LIMBO		;YES,FLAG
	POPJ	PP,		;AND EXIT

RSW3:	TLNE	IO,IOSALL	;MACRO SUPPRESS ALL?
	JUMPN	MRP,CPOPJ	;YES,DON'T LIST IN MACRO
	SOSG	CPL		;ANY ROOM IN THE IMAGE BUFFER?
	PUSHJ	PP,OUTPL	;NO, OUTPUT THE PARTIAL LINE
	IDPB	C,LBUFP		;YES, STORE IN PRINT AREA
	CAIE	C,HT		;TAB?
	POPJ	PP,		;NO, EXIT
	MOVEI	C,7
	ANDCAM	C,CPL		;MASK
CHARAX:	HRRZ	C,LIMBO		;GET LAST CHARACTER
	POPJ	PP,		;EXIT

CHARL:	PUSHJ	PP,CHARAC	;GET AND TEST 7-BIT ASCII
	CAIG	C,FF		;LINE OR FORM FEED OR VT?
	CAIGE	C,LF
	POPJ	PP,		;NO,EXIT
	SKIPE	LITLVL		;IN LITERAL?
	JRST	OUTIML		;YES
CHARL1:	PUSHJ	PP,SAVEXS	;SAVE REGISTERS
	PUSHJ	PP,OUTLIN	;DUMP THE LINE
	JRST	RSTRXS		;RESTORE REGISTERS AND EXIT
SUBTTL	CHARACTER STATUS TABLE

	DEFINE	GENCS	(OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)
<BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>

	;OPLVL	PRIORITY OF BINARY OPERATORS
	;ATOM	INDEX TO JUMP TABLE AT CELL1
	;AN	TYPE OF CHARACTER
	;	1=OTHER, 2=ALPHA, 4=NUMERIC
	;SQUOZ	VALUE IN RADIX 50
	;OPTYPE	INDEX TO JUMP TABLE AT EVXCT
	;SEQNO	VALUE IN SIXBIT
CSTAT:
	GENCS	00,00,1,00,00,00	; ' '
	GENCS	04,12,1,00,06,01	; '!'
	GENCS	00,07,1,00,00,02	; '"'
	GENCS	00,12,1,00,00,03	; '#'
	GENCS	00,01,2,46,00,04	; '$'
	GENCS	00,01,2,47,00,05	; '%'
	GENCS	04,12,1,00,07,06	; '&'
	GENCS	00,07,1,00,00,07	; '''

	GENCS	00,01,1,00,00,10	; '('
	GENCS	00,01,1,00,00,11	; ')'
	GENCS	02,12,1,00,01,12	; '*'
	GENCS	01,00,1,00,03,13	; '+'
	GENCS	40,01,1,00,00,14	; ','
	GENCS	01,02,1,00,04,15	; '-'
	GENCS	00,11,2,45,00,16	; '.'
	GENCS	02,12,1,00,02,17	; '/'

	GENCS	00,04,4,01,00,20	; '0'
	GENCS	00,04,4,02,00,21	; '1'
	GENCS	00,04,4,03,00,22	; '2'
	GENCS	00,04,4,04,00,23	; '3'
	GENCS	00,04,4,05,00,24	; '4'
	GENCS	00,04,4,06,00,25	; '5'
	GENCS	00,04,4,07,00,26	; '6'
	GENCS	00,04,4,10,00,27	; '7'

	GENCS	00,04,4,11,00,30	; '8'
	GENCS	00,04,4,12,00,31	; '9'
	GENCS	00,12,1,00,00,32	; ':'
	GENCS	00,01,1,00,00,33	; ';'
	GENCS	00,05,1,00,00,34	; '<'
	GENCS	00,12,1,00,00,35	; '='
	GENCS	00,01,1,00,00,36	; '>'
	GENCS	00,12,1,00,00,37	; '?'
	GENCS	00,03,1,00,00,40	; '@'
	GENCS	00,01,2,13,00,41	; 'A'
	GENCS	00,01,2,14,00,42	; 'B'
	GENCS	00,01,2,15,00,43	; 'C'
	GENCS	00,01,2,16,00,44	; 'D'
	GENCS	00,01,2,17,00,45	; 'E'
	GENCS	00,01,2,20,00,46	; 'F'
	GENCS	00,01,2,21,00,47	; 'G'

	GENCS	00,01,2,22,00,50	; 'H'
	GENCS	00,01,2,23,00,51	; 'I'
	GENCS	00,01,2,24,00,52	; 'J'
	GENCS	00,01,2,25,00,53	; 'K'
	GENCS	00,01,2,26,00,54	; 'L'
	GENCS	00,01,2,27,00,55	; 'M'
	GENCS	00,01,2,30,00,56	; 'N'
	GENCS	00,01,2,31,00,57	; 'O'

	GENCS	00,01,2,32,00,60	; 'P'
	GENCS	00,01,2,33,00,61	; 'Q'
	GENCS	00,01,2,34,00,62	; 'R'
	GENCS	00,01,2,35,00,63	; 'S'
	GENCS	00,01,2,36,00,64	; 'T'
	GENCS	00,01,2,37,00,65	; 'U'
	GENCS	00,01,2,40,00,66	; 'V'
	GENCS	00,01,2,41,00,67	; 'W'

	GENCS	00,01,2,42,00,70	; 'X'
	GENCS	00,01,2,43,00,71	; 'Y'
	GENCS	00,01,2,44,00,72	; 'Z'
	GENCS	00,06,1,00,00,73	; '['
	GENCS	00,12,1,00,00,74	; '\'
	GENCS	00,01,1,00,00,75	; ']'
	GENCS	00,10,1,00,00,76	; '^'
	GENCS	10,12,1,00,05,77	; '_'
SUBTTL	LISTING ROUTINES

OUTLIN:	TRNN	ER,ERRORS-ERRQ	;ANY ERRORS?
	TLNE	FR,ERRQSW	;NO, IGNORE Q ERRORS?
	TRZ	ER,ERRQ		;YES, YES, ZERO THE Q ERROR
	HRLZ	AC0,ER		;PUT ERROR FLAGS IN AC0 LEFT
	TDZ	ER,TYPERR
	JUMP1	OUTL30		;BRANCH IF PASS ONE
	JUMPN	AC0,OUTL02	;JUMP IF ANY ERRORS TO FORCE PRINTING
	SKIPL	STPX		;SKIP IF NO CODE, OTHERWISE
	JRST	OUTL01		;NO
	TLNN	IO,IOSALL	;YES,SUPPRESS ALL?
	JRST	OUTL03		;NO
	JUMPN	MRP,CPOPJ	;YES,EXIT IF IN MACRO
	LDB	C,[XWD 350700,LBUF]
	CAIE	C,15		;FIRST CHAR CR?
OUTL01:	TLZ	IO,IOMAC	;FORCE MACRO PRINTING
OUTL03:	TLNN	IO,IOMSTR!IOPROG!IOMAC
OUTL02:	IOR	ER,OUTSW	;FORCE IT.
	IDPB	AC0,LBUFP	;STORE ZERO TERMINATOR AFTER ASCII SRC LINE
	TLNN	FR,CREFSW	;CREF?
	PUSHJ	PP,CLSCRF	;YES, WRITE END OF CREF DATA (177,003)
	JUMPE	AC0,OUTL20	;BRANCH IF NO ERRORS
	TLZE	AC0,ERRM	;M ERROR?
	TLO	AC0,ERRP	;M ERROR SET - SET P ERROR.
	PUSHJ	PP,OUTLER	;PROCESS ERRORS

OUTL20:	SKIPN	RC,ASGBLK
	SKIPE	CS,LOCBLK	;
	SKIPL	STPX		;ANY BINARY?
	JRST	OUTL23		;YES, JUMP
	JUMPE	RC,OUTL22	;SEQUENCE BREAK AND NO BINARY JUMPS
	ILDB	C,TABP		;ASSIGNMENT FALLS THROUGH
	PUSHJ	PP,OUTL		;OUTPUT A TAB.
	ILDB	C,TABP		;OUTPUT 2ND TAB, LOCATION FIELD
	PUSHJ	PP,OUTC		;NEXT IS BINARY LISTING FIELD
	HLLO	CS,LOCBLK	;LEFT HALF OF A 36BIT VALUE
	JUMPL	RC,.+2		;SKIP IF LEFT HALF IS NOT RELOC
	TRZA	CS,1		;IT IS, SET THE FLAG
	TLNE	CS,-1		;SKIP IF ITS A 18BIT VALUE, OTHERWISE
	PUSHJ PP,ONC1		;PRINT LH OF A 36 BIT VALUE IN CS
	HRLO	CS,LOCBLK	;PICK UP THE RIGHT HALF (18BIT VALUE)
	TRZ	CS,0(RC)	;
	PUSHJ	PP,ONC		;PRINT IT
	JRST	OUTL23		;SKIP SINGLE QUOTE TEST
OUTL22:	PUSHJ	PP,ONC		;TAB TO RH AND PRINT IT
	MOVEI	C,"'"
	SKIPE	MODA
	PUSHJ	PP,OUTC
OUTL23:	SKIPL	STPX		;ANY BINARY?
	PUSHJ	PP,BOUT		;YES, DUMP IT
	MOVE	CS,@OUTLI2	;[POINT 7,LBUF]
OUTL24:	ILDB	C,CS
	JUMPE	C,OUTL25
	CAIG	C," "
	JRST	OUTL24
	MOVE	CS,TABP
	PUSHJ	PP,OUTASC	;OUTPUT TABS
OUTL25:	MOVEI	CS,LBUF
	PUSHJ	PP,OUTAS0	;DUMP THE LINE
	TLNE	IO,IOSALL	;SUPPRESSING ALL
	JUMPN	MRP,OUTL27	;YES,EXTRA CR IF IN MACRO
OUTL26:	SKIPGE	STPX		;ANY BINARY?
	JRST	OUTLI		;NO, CLEAN UP AND EXIT
	PUSHJ	PP,OUTLI2	;YES, INITIALIZE FOR NEXT LINE
	PUSHJ	PP,BOUT		;YES, DUMP IT
OUTL27:	PUSHJ	PP,OUTCR	;OUTPUT CARRIAGE RETURN
	JRST	OUTL26		;TEST FOR MORE BINARY

OUTPL:	SKIPN	LITLVL		;IF IN LITERAL
	SKIPL	STPX		;OR CODE GENERATED
	JRST	OUTIM		;JUST OUTPUT THE IMAGE
	SKIPN	ASGBLK		;SKIP IF AN ASSIGNMENT
	JRST	OUTIM		;OTHERWISE OUTPUT IMAGE
	PUSH	PP,C		;SAVE CHAR.
	MOVEI	C,CR
	IDPB	C,LBUFP
	MOVEI	C,LF
	IDPB	C,LBUFP		;FINISH WITH CRLF
	PUSHJ	PP,OUTLIN	;OUTPUT PARTIAL LINE
	POP	PP,C		;RESTORE CHAR.
	JRST	OUTLI2		;INITIALISE REST OF LINE
OUTL30:	AOS	CS,STPX		;PASS ONE
	ADDM	CS,LOCO		;INCREMENT OUTPUT LOCATION
	PUSHJ	PP,STOWI	;INITIALIZE STOW
	TLZ	AC0,ERRORS-ERRM-ERRP-ERRV
	JUMPN	AC0,OUTL32	;JUMP IF ERRORS
	TLNE	IO,IOSALL	;SUPPRESSING ALL/
	JUMPN	MRP,CPOPJ	;YES,EXIT
	JRST	OUTLI1		;NO,INIT LINE

OUTL32:	IDPB	AC0,LBUFP	;ZERO TERNIMATOR
	IOR	ER,OUTSW	;LIST ERRORS
	MOVEI	CS,TAG
	PUSHJ	PP,OUTSIX	;OUTPUT TAG
	HRRZ	C,TAGINC
	PUSHJ	PP,DNC		;CONVERT INCREMENT TO DECIMAL
	PUSHJ	PP,OUTTAB	;OUTPUT TAB
	PUSHJ	PP,OUTLER	;OUTPUT ERROR FLAGS
	PUSHJ	PP,OUTTAB
	MOVEI	CS,SEQNO	;ADDRESS OF SEQUENCE NO.
	SKIPE	SEQNO		;FILE NOT SEQUENCED
	PUSHJ	PP,OUTAS0	;OUTPUT IT
	JRST	OUTL25		;OUTPUT BASIC LINE

OUTLER:	PUSH PP,ER	;SAVE LISTING SWITCHES FOR LATER
	TRNE ER,TTYSW	;IF THIS IS ON, LISTING IS ON TTY
	TRZ ER,ERRORS	;SO SUPPRESS ON TTY
	TDZ ER,OUTSW	;BUT THIS SHOULD ONLY GO TO THE TTY
	MOVE CS,INDIR	;GET FILE NAME
	CAME CS,LSTFIL	;AND SEE IF SAME
	JRST	[MOVEM CS,LSTFIL	;SAVE AS LAST ONE
		MOVEI CS,LSTFIL
		PUSHJ PP,OUTSIX	;LIST NAME
		MOVEI C," "
		PUSHJ PP,OUTL
		MOVE CS,PAGENO	;PRINT PAGE NUMBER TOO
		JRST OUTLE8]
	MOVE CS,PAGENO	;NOW CHECK PAGE NUMBER
	CAME CS,LSTPGN
OUTLE8:	JRST	[MOVEM CS,LSTPGN
		MOVEI CS,[ASCIZ /PAGE /]
		PUSHJ PP,OUTAS0
		MOVE C,PAGENO
		PUSHJ PP,DNC
		PUSHJ PP,OUTCR	;AND NOW FOR THE ERROR LINE
		JRST .+1]
	HLLM ER,(PP)	;RESTORE ER BUT NOT IO (LEFT HALF OF AC)
	POP PP,ER
	MOVE	CS,[POINT 7,[ASCII / QXADLRUVNOPEM/]]
OUTLE2:	ILDB	C,CS		;GET ERROR MNEMONIC
	JUMPGE	AC0,OUTLE4	;BRANCH IF NOT FLAGGED
	PUSHJ	PP,OUTL		;OUTPUT THE CHARACTER
	AOS	ERRCNT		;INCREMENT ERROR COUNT
OUTLE4:	LSH	AC0,1		;SHIFT NEXT FLAG INTO SIGN BIT
	JUMPN	AC0,OUTLE2	;TEST FOR END
	POPJ	PP,		;EXIT
OUTIM1:	TLOA	FR,IOSCR	;SUPPRESS CRLF AFTER LINE
OUTIM:	TLZ	FR,IOSCR	;DON'T FOR PARTIAL LINE
	TLNE	IO,IOSALL	;SUPPRESSING ALL?
	JUMPN	MRP,CPOPJ	;YES ,EXIT IF IN MACRO
	JUMP1	OUTLI1		;BYPASS IF PASS ONE
	PUSH	PP,ER
	TDZ	ER,TYPERR
	TLNN	IO,IOMSTR!IOPROG!IOMAC
	IOR	ER,OUTSW
	PUSH	PP,C		;OUTPUT IMAGE
	TLNN	FR,CREFSW
	PUSHJ	PP,CLSCRF
OUTIM2:	MOVE	CS,TABP
	PUSHJ	PP,OUTASC	;OUTPUT TABS
	IDPB	C,LBUFP		;STORE ZERO TERMINATOR
	MOVEI	CS,LBUF
	PUSHJ	PP,OUTAS0	;OUTPUT THE IMAGE
	TLZN	FR,IOSCR	;CRLF SUPPRESS?
	PUSHJ	PP,OUTCR	;NO,OUTPUT
	POP	PP,C
	HLLM	ER,0(PP)
	POP	PP,ER
	JRST	OUTLI2

OUTLI:	TLNE	IO,IOSALL	;SUPPRESSING ALL
	JUMPN	MRP,OUTLI3	;YES,SET FLAG IN REPEATS ALSO
	TLNE	IO,IOPALL	;MACRO EXPANSION SUPRESS REQUESTED?
	SKIPN	MACLVL		;YES, ARE WE IN MACRO?
	TLZA	IO,IOMAC	;NO, CLEAR MAC FLAG
OUTLI3:	TLO	IO,IOMAC	;YES, SET FLAG

OUTLI1:	TRZ	ER,ERRORS!LPTSW!TTYSW
OUTLI2:	MOVE	CS,[POINT 7,LBUF]	;INITIALIZE BUFFERS
	MOVEM	CS,LBUFP
	MOVE	CS,[POINT 7,TABI,6]
	MOVEM	CS,TABP
	MOVEI	CS,.CPL
	MOVEM	CS,CPL
	MOVSI	CS,(ASCII /	/)
	SKIPE	SEQNO		;HAVE WE SEQUENCE NUMBERS?
	MOVEM	CS,SEQNO	;YES, STORE TAB IN CASE OF MACRO
	MOVEM	CS,SEQNO+1	;STORE TAB AND TERMINATOR
	SETZM	ASGBLK
	SETZM	LOCBLK
	POPJ	PP,
OUTIML:	TLNE	IO,IOSALL	;SUPPRESSING ALL?
	JUMPN	MRP,CPOPJ	;YES,EXIT IF IN MACRO
	TRNN ER,ERRORS-ERRQ	;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS
	TLNE FR,ERRQSW
	TRZ ER,ERRQ
	HRLZ CS,ER
	JUMP1 OUTML1	;CHECK PASS1 ERRORS
	TDZ ER,TYPERR
	JUMPE CS,OUTIM1
	PUSH PP,[0]	;ERRORS SHOULD BE ZEROED
	PUSH PP,C
	PUSH	PP,AC0	;SAVE AC0 IN CASE CALLED FROM ASCII
	MOVE	AC0,CS	;ERROR ROUTINE WANTS FLAGS IN AC0
	IOR ER,OUTSW
	TLNN FR,CREFSW
	PUSHJ PP,CLSCRF	;FIX CREF
	TLZE AC0,ERRM
	TLO AC0,ERRP
	PUSHJ PP,OUTLER	;OUTPUT THEM
	POP	PP,AC0
	JRST OUTIM2	;AND LINE
	
OUTML1:	TLZ CS,ERRORS-ERRM-ERRP-ERRV
	JUMPE CS,OUTLI2	;NONE
	TRZ ER,ERRM!ERRP!ERRV
	TRO ER,ERRL
	PUSH PP,ER	;SAVE
	PUSH PP,C	;SAVE THIS
	PUSH	PP,AC0	;AS ABOVE
	MOVE	AC0,CS		;...
	TDZ ER,TYPERR
	IOR ER,OUTSW
	MOVEI CS,TAG
	PUSHJ PP,OUTSIX
	HRRZ C,TAGINC
	PUSHJ PP,DNC
	PUSHJ PP,OUTTAB
	PUSHJ PP,OUTLER	;DO NOT FORGET ERRORS
	PUSHJ PP,OUTTAB
	MOVEI CS,LBUF	;PRINT REST OF LINE
	PUSHJ PP,SOUT20
	POP	PP,AC0
	POP PP,C
	POP PP,ER
	JRST OUTLI2
SUBTTL	OUTPUT ROUTINES
UOUT:	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRNN ARG,PNTF	;WFW
	TRNN	ARG,UNDF
	JRST	UOUT13		;TEST FOR UNDF!EXTF!PNTF ON PASS2
	JUMP2	UOUT10
	TLNN	IO,IOIOPF	;ANY IOP'S SEEN
	JRST	UOUT12		;NO,MAKE EXTERNAL
	MOVSI	CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE
UOUT1:	CAME	AC0,PRMTBL(CS)	;HAVE WE A MATCH?
	AOBJN	CS,UOUT2	;NO,INCREMENT AND JUMP
	MOVE	ARG,PRMTBL+1(CS);YES,GET VALUE
	MOVEM	ARG,(SX)	;UPDATE SYMBOL TABLE
	POPJ	PP,		;EXIT
UOUT2:	AOBJN	CS,UOUT1	;TEST FOR END

UOUT12:	PUSHJ	PP,EXTER2	;MAKE IT EXTERNAL
	MOVSI	ARG,UNDF	;BUT PUT UNDF BACK ON
	IORM	ARG,(SX)	;SO MESSAGE WILL COME OUT
	POPJ	PP,		;GET NEXT SYMBOL

UOUT13:	JUMP1	CPOPJ	;RECYCLE ON PASS1
	TRC ARG,UNDF!EXTF!PNTF	;CHECK FOR ALL THREE ON
	TRCE ARG,UNDF!EXTF!PNTF	;ARE THEY?
	POPJ	PP,		;NO, RECYCLE
UOUT10:	PUSHJ PP,OUTCR
	PUSHJ	PP,OUTSYM	;OUTPUT THE SYMBOL
	MOVEI	CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL @/]
	JRST	OUTSIX		;POPJ FOR NEXT SYMBOL

UOUT30:	PUSHJ	PP,ONC1		;OUTPUT THE LOCATION
	JRST	HIGHQ		;EXIT THROUGH HIGHQ
				;OUTPUT THE ENTRIES

EOUT:	MOVEI	C,0		;INITIALIZE THE COUNT
	MOVE	SX,SYMBOL
	MOVE	SDEL,0(SX)
EOUT1:	SOJL	SDEL,EOUT2	;TEST FOR END
	ADDI	SX,2
	HLRZ	ARG,0(SX)
	ANDCAI	ARG,SYMF!INTF!ENTF
	JUMPN	ARG,EOUT1	;IF INVALID, DON'T COUNT
	AOJA	C,EOUT1		;BUMP COUNT

EOUT2:	HRLI	C,4		;BLOCK TYPE 4
	PUSHJ	PP,OUTBIN
	SETZB	C,ARG
	PUSHJ	PP,OUTBIN
	MOVE	SX,SYMBOL
	MOVE	SDEL,0(SX)
	MOVEI	V,^D18

EOUT3:	SOJL	SDEL,POPOUT
	ADDI	SX,2
	HLRZ	C,0(SX)
	ANDCAI	C,SYMF!INTF!ENTF
	JUMPN	C,EOUT3
	SOJGE	V,EOUT4		;TEST END OF BLOCK
	PUSHJ	PP,OUTBIN
	MOVEI	V,^D17	;WFW
EOUT4:	MOVE	AC0,-1(SX)
	PUSHJ	PP,SQOZE
	MOVE	C,AC0
	PUSHJ	PP,OUTBIN
	JRST	EOUT3
				;OUTPUT THE SYMBOLS

SOUT:	SKIPN	IONSYM		;SKIP IF NOSYM SEEN
	TRNN	ER,LPTSW!TTYSW	;A LISTING REQUIRED?
	JRST	SOUT1		;NO
	MOVEI	[ASCIZ /SYMBOL TABLE/]
	HRRM	SUBTTX		;SET NEW SUB-TITLE
	PUSHJ	PP,OUTFF	;FORCE NEW PAGE
	PUSHJ PP,LOUT1		;OUTPUT THEM
	JRST	SOUT1		;NOW FOR BLOCK TYPE 2

LOUT1:	PUSHJ	PP,LLUKUP	;SET FOR TABLE SCAN
	TRNN	ARG,SYMF
	TRNN	ARG,MACF!SYNF
	TDZA	MRP,MRP		;SKIP AND CLEAR MRP
	POPJ	PP,		;NO, TRY AGAIN
	TRNE	ARG,INTF
	MOVEI	MRP,1
	TRNE	ARG,EXTF
	MOVNI	MRP,1		;MRP=-1 FOR EXTERNAL
	TRNE	ARG,SYNF	;SYNONYM?
	JUMPL	MRP,POPOUT	;YES, DON'T OUTPUT IF EXTERNAL
	TRNE ARG,SUPRBT		;IF SUPRESSED
;	JUMPGE MRP,POPOUT	;DO NOT OUTPUT UNLESS EXTERNAL
	POPJ	PP,		;DO NOT OUTPUT
	AOS	(PP)		;SET FOR SKIP RETURN IF SYMBOL IS PRINTED
	JUMPGE	MRP,LOUT10	;BRANCH IF NOT EXTERNAL
	HLRZ	RC,V		;PUT POINTER/FLAGS IN RC
	TRNE	RC,-2		;POINTER?
	MOVS	RC,0(RC)	;YES
	HLL	V,RC		;STORE LEFT VALUE

LOUT10:	PUSH PP,RC	;SAVE FOR LATER
	PUSHJ	PP,OUTSYM	;OUTPUT THE NAME
	MOVE RC,(PP)	;GET COPY
	MOVEI	AC1,0
	JUMPLE	MRP,LOUT15	;SET DEFFERRED BITS IF EXTERNAL
	TLNE	RC,-2		;CHECK FOR LEFT FIXUP
	IORI	AC1,40		;AND SET BITS
	TRNE	RC,-2		;CHECK FOR RIGHT FIXUP
	IORI	AC1,20		;AND SET BITS
LOUT15:	TLNE RC,-2	;FIX RELOC AS 0 IF EXTERNAL
	HRRZS RC
	TRNE RC,-2
	HLLZS RC
	TLZE RC,-1
	TRO RC,2
	HRL MRP,RC
	MOVEI RC,0
	TRNE	ARG,ENTF	;ENTRY DMN
	HRRI	MRP,-5
	TRNE ARG,NOOUTF		;SUPRESS OUTPUT? WFW
	ADDI MRP,3		;YES WFW
	TRNE	ARG,UNDF	;UNDEFINED IS EXTERNAL
	HRRI	MRP,2		;SO FLAG AS UXT
	IOR	AC1,SOUTC(MRP)
	MOVE ARG,AC1
	MOVEM AC0,SVSYM		;SAVE IT
	MOVE	AC0,V		;GET THE VALUE
	HLRZ	RC,MRP		;AND THE RELOCATION
	HLLO	CS,V
	TRNE	RC,2		;LEFT HALF RELOCATABLE?
	TRZA	CS,1		;NO, FLAG AND PRINT
	TLNE	CS,-1		;IS THE LEFT HALF ZERO?
	PUSHJ	PP,ONC1		;NO, OUTPUT IT
LOUT11:	PUSHJ	PP,OUTTAB
LOUT30:	HRLO	CS,V
	TDZ	CS,RC		;SET RELOCATION
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTTAB
	POP PP,RC		;GET BACK RELOC AND CHECK EXTERNAL
LOUT60:	MOVEI	CS,SOUTC(MRP)
	PUSHJ	PP,OUTAS0	;EXT/INT
LOUT64:	JRST	OUTCR		;CARRIAGE RETURN AND TRY FOR ANOTHER


	SYN IFBLK,SYMBLK	;SOMEWHERE TO STORE THE POINTERS

LLUKUP:	POP	PP,LOOKX	;INTERCEPT RETURN POP
	MOVE	SX,SYMBOL
	MOVE	SDEL,(SX)
	ADDI	SX,2		;SKIP COUNT OF SYMBOLS
LLUKP2:	MOVEM	SX,SYMBLK	;STORE SYMBOL POINTER IN TABLE
	HRRZ	SX,SYMBLK
	JRST	LLUKP7		;ENTER LOOP

LLUKP1:	MOVEM	SX,SYMBLK	;SAVE IT 
	MOVE	AC0,-1(SX)
	PUSHJ	PP,SRCH7
	HLRZS	ARG
	PUSHJ	PP,@LOOKX
	JRST	[MOVEM SX,SYMBLK
		JRST	.+1]
LLUKP7:	SOJL	SDEL,POPOUT	;TEST FOR END
LLUKP3:	MOVE	SX,SYMBLK	;GET NEXT POINTER
	AOBJP	SX,LLUKP4
	HRRZ	V,SX
	CAMG	V,SYMTOP
	AOJA	SX,LLUKP1
LLUKP6:	PUSHJ	PP,LOUT64	;RESET SYMCNT
	JUMPE	SDEL,POPOUT	;EXIT IF ALL DONE
	JRST	LLUKP3

LLUKP4:	AOJ	SX,
	MOVEM	SX,SYMBLK
	JRST	LLUKP3
SOUT1:	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRNN	ARG,SYMF
	TRNN	ARG,MACF!SYNF
	TDZA	MRP,MRP		;SKIP AND CLEAR MRP
	POPJ	PP,		;NO, TRY AGAIN
	TRNE	ARG,INTF
	MOVEI	MRP,1
	TRNE	ARG,EXTF
	MOVNI	MRP,1		;MRP=-1 FOR EXTERNAL
	TRNE	ARG,SYNF	;SYNONYM?
	JUMPL	MRP,POPOUT	;YES, DON'T OUTPUT IF EXTERNAL
	TRNE ARG,SUPRBT		;IF SUPRESSED
;	JUMPGE MRP,POPOUT	;DO NOT OUTPUT UNLESS EXTERNAL
	POPJ	PP,		;DO NOT OUTPUT
	JUMPGE	MRP,SOUT10	;BRANCH IF NOT EXTERNAL
	HLRZ	RC,V		;PUT POINTER/FLAGS IN RC
	TRNE	RC,-2		;POINTER?
	MOVS	RC,0(RC)	;YES
	HLL	V,RC		;STORE LEFT VALUE

SOUT10:	PUSH PP,RC	;SAVE FOR LATER
	MOVEI	AC1,0
	JUMPLE	MRP,SOUT15	;SET DEFFERRED BITS IF EXTERNAL
	TLNE	RC,-2		;CHECK FOR LEFT FIXUP
	IORI	AC1,40		;AND SET BITS
	TRNE	RC,-2		;CHECK FOR RIGHT FIXUP
	IORI	AC1,20		;AND SET BITS
SOUT15:	TLNE RC,-2	;FIX RELOC AS 0 IF EXTERNAL
	HRRZS RC
	TRNE RC,-2
	HLLZS RC
	TLZE RC,-1
	TRO RC,2
	HRL MRP,RC
	MOVEI RC,0
	TRNE	ARG,ENTF	;ENTRY DMN
	HRRI	MRP,-5
	TRNE ARG,NOOUTF		;SUPRESS OUTPUT? WFW
	ADDI MRP,3		;YES WFW
	IOR	AC1,SOUTC(MRP)
	MOVE ARG,AC1
	PUSHJ	PP,NOUT2	;SQUOZE AND DUMP THE SYMBOL
	MOVEM AC0,SVSYM		;SAVE IT
	MOVE	AC0,V		;GET THE VALUE
	HLRZ	RC,MRP		;AND THE RELOCATION
	PUSHJ	PP,COUT
	POP PP,RC		;GET BACK RELOC AND CHECK EXTERNAL
	TRNN RC,-2		;IS IT?
	JRST SOUT50		;NO
	MOVE AC0,1(RC)		;GET NAME
	MOVEI ARG,60		;EXTERNAL REQ
	PUSHJ PP,SQOZE
	HLLZS RC	;NO RELOC
	PUSHJ PP,COUT	;OUTPUT IT
	MOVE AC0,SVSYM	;GET SYMBOL NAME
	TLO AC0,500000	;SET AS ADDITIVE SYMBOL
	TLZ AC0,200000	;BUT NOT LEFT HALF ETC
	PUSHJ PP,COUT
SOUT50:	MOVSS RC	;CHECK LEFT HALF
	TRNN RC,-2
	JRST SOUT60
	MOVE AC0,1(RC)
	MOVEI ARG,60
	PUSHJ PP,SQOZE
	MOVEI RC,0
	PUSHJ PP,COUT
	MOVE AC0,SVSYM
	TLO AC0,700000
	PUSHJ PP,COUT
SOUT60:	POPJ	PP,

SOUT20:	PUSHJ PP,OUTAS0
	JRST OUTCR

	<ASCII /ENT/>!04	;DMN
	Z
	Z
	<ASCII /SEN/>!44	;SUPRESSED ENTRY
	<ASCII /EXT/>!60
SOUTC:	EXP	10
	<ASCII /INT/>!04
	<ASCII /UXT/>!60	;UNDEFINED EXTERNAL
	<ASCII /SPD/>!50
	<ASCII /SIN/>!44	;DMN
				;OUTPUT THE BINARY

BOUT:	HRLO	CS,LOCO		;PICKUP THE LOCATION
	PUSHJ	PP,ONC		;OUTPUT IT TO THE LISTING FILE
	MOVEI	C,"'"
	SKIPE	MODO		;IF MODE IS NOT ABSOLUTE
	PUSHJ	PP,OUTC		;PRINT A SINGLE QUOTE
	PUSHJ	PP,DSTOW	;GET THE CODE
	PUSH PP,RC	;SAVE RELOC
	PUSH	PP,RC	;AND AGAIN
	TLNE RC,-2	;CHECK LEFT EXTERNAL
	HRRZS RC	;MAKE LEFT NON-RELOC
	TRNN RC,-2	;RIGHT EXT?
	JRST BOUT30	;NO
	HRRZ AC1,AC0	;YES
	JUMPE AC1,BOUT20	;PROCESS IF ZERO CODE THERE
	HLLZS RC	;MAKE NON-RELOC
	JRST BOUT30	;PROCESS

BOUT20:
	HRRM AC1,-1(PP)	;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)
	HRR	AC0,0(RC)	;NO, SET ADDRESS LINK
	MOVE	AC1,LOCO	;GET CURRENT LOCATION
	HRRM	AC1,0(RC)	;SET NEW LINK
	HLRZ	AC1,0(RC)	;GET FLAGS/POINTER
	TRNN	AC1,-2		;POINTER?
	HRR	AC1,RC		;NO, SET TO FLAGS
	HLR	RC,0(AC1)	;PUT FLAGS IN RC
	HRL	AC1,MODO	;GET CURRENT MODE
	TRZE	RC,-2		;LEFT HALF RELOCATABLE+
	TLO	AC1,2		;YES, SET FLAG
	HLLM	AC1,0(AC1)	;STORE NEW FLAGS
BOUT30:	HLLO	CS,AC0
	TLZE	RC,1		;PACK RELOCATION BITS
	TRO	RC,2
	TRNE	RC,2		;LEFT HALF RELOCATABLE?
	TRZ	CS,1		;YES, RESET BIT
	PUSH	PP,AC0		;NEED AN AC
	HLRZ	AC0,-1(PP)	;AC0 = LEFT RELOCATION
	CAILE	AC0,1		;EXTERNAL?
	XORI	CS,EXTF!1	;YES, SET SWITCH
	POP	PP,AC0		;RESTORE
	PUSHJ	PP,ONC
	HRLO	CS,AC0
	TDZ	CS,RC		;SET RELOCATION
	HRRZ	C,(PP)		;C = RIGHT RELOCATION
	CAILE	C,1		;EXTERNAL
	XORI	CS,EXTF!1	;YES, SET SWITCH
	PUSHJ	PP,ONC
BOUT3I:	POP	PP,CS		;GET RID OF ENTRY ON STACK
	HRRZ	CS,LOCO
	TLNE	FR,RIMSW!RIM1SW!R1BSW	;RIM OUTPUT?
	JRST	ROUT		;YES, GO PROCESS

	HRL	CS,MODO
	CAME	CS,MODLOC	;SEQUENCE OR RELOCATION BREAK?
	PUSHJ	PP,COUTD	;YES, DUMP THE BUFFER
	SKIPL	COUTX		;NEW BUFFER?
	JRST	BOUT40		;NO, STORE CODE AND EXIT
	MOVEM	CS,MODLOC	;YES, STORE NEW VALUES
	EXCH	AC0,LOCO
	EXCH	RC,MODO
	PUSHJ	PP,COUT		;STORE BLOCK LOCATION AND MODE
	EXCH	RC,MODO		;RESTORE CURRENT VALUES
	EXCH	AC0,LOCO

BOUT40:	PUSHJ PP,COUT	;EMIT CODE
	POP PP,RC	;RETRIEVE EXTERNAL BITS
	TRNN RC,-2	;RIGHT EXTERNAL?
	JRST BOUT50	;TRY FOR LEFT
	PUSHJ PP,COUTD
	PUSH PP,BLKTYP	;TERMINATE TYPE AND SAVE
	MOVEI AC0,2	;BLOCK TYPE 2
	MOVEM AC0,BLKTYP
	MOVE AC0,1(RC)	;GET SYMBOL
	MOVEI ARG,60	;CODE BITS
	PUSHJ PP,SQOZE	;CONVERT TO RADIX 50
	HLLZS RC	;SYMBOL HAS NO RELOCATION
	PUSHJ PP,COUT	;EMIT
	MOVE AC0,LOCO	;GET CURRENT LOC
	HRLI AC0,400000	;ADDITIVE REQ
	HRR RC,MODO	;CURRENT MODE
	PUSHJ PP,COUT	;EMIT
	MOVSS RC	;NOW FOR LEFT
	TRNN RC,-2
	JRST BOUT60
	JRST BOUT70
BOUT50:	MOVSS RC	;CHECK OTHER HALF
	TRNN RC,-2		;LEFT HALF EXTERNAL?
	JRST BOUT80	;NO, FALSE ALARM
	PUSHJ PP,COUTD	;CHANGE MODE
	PUSH PP,BLKTYP
	MOVEI AC0,2
	MOVEM AC0,BLKTYP
BOUT70:	MOVE AC0,1(RC)
	MOVEI ARG,60
	PUSHJ PP,SQOZE
	HLLZS RC
	PUSHJ PP,COUT
	MOVE AC0,LOCO
	HRLI AC0,600000	;LEFT HALF ADD
	HRR RC,MODO
	PUSHJ PP,COUT	;EMIT
BOUT60:	PUSHJ PP,COUTD	;CHANGE MODE
	POP PP,BLKTYP	;TO OLD ONE
BOUT80:	AOS LOCO
	AOS MODLOC
	POPJ PP,

NOUT:	MOVE	V,[POINT 7,TBUF]	;POINTER TO ASCII LINE
	MOVSI	CS,(POINT 6,AC0)	;POINTER TO SIXBIT AC0
	SETZB	ARG,AC0
NOUT1:	ILDB	C,V		;GET ASCII
	CAIL C,"A"+40
	CAILE C,"Z"+40
	JRST	.+2
	TRZA	C,100		;LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIXBIT
	JUMPLE	C,NOUT3		;TEST FORM NON-SIXBIT
	CAILE	C,77		;AND NOT GREATER THAN SIXBIT
	JRST	NOUT3		;...
	IDPB	C,CS		;DEPOSIT IN AC0
	TLNE	CS,770000	;TEST FOR SIX CHARACTERS
	JRST	NOUT1		;NO, GET ANOTHER
NOUT3:
IFN UNIVR,<SKIPGE	UNIVSN		;IF A UNIVERSAL PROG>
	POPJ	PP,		;RETURN TO PUT IT IN THE TABLE

IFN CCLSW,<	TLNN IO,IOTLSN	;AND IF WE HAVE NOT SEEN A TITLE
	PUSHJ PP,PRNAM	;THEN PRINT THE NAME>
NOUT2:	PUSHJ	PP,SQOZE	;CONVERT TO SIXBIT
	JRST	COUT		;DUMP AND EXIT

HOUT:
	MOVEI	RC,1		;RELOCATABLE
IFN RENTSW,<
	MOVE	AC0,HHIGH	;GET HIGH SEG IF TWO SEGMENTS
	JUMPE	AC0,.+2		;NOT TWO SEGMENTS
	PUSHJ	PP,COUT		;OUTPUT IT >
	MOVE	AC0,HIGH
IFN RENTSW,<
	SKIPE	HHIGH		;ANY TWOSEG HIGH STUFF
	JRST	COUT		;YES,SO NO ABS.>
	PUSHJ	PP,COUT		;OUTPUT THE HIGHEST LOCATION
	MOVE AC0,ABSHI
				;PUT OUT ABS PORTION OF PROGRAM BREAK
	SOJA	RC,COUT		;OUTPUT A WORD OF ZERO AND EXIT

IFN RENTSW,<
HSOUT:	SETZM	HISNSW		;CLEAR FOR PASS2
	MOVE	AC0,SVTYP3	;GET HISEG ARG
	JUMPGE	AC0,.+4		;JUMP IF ONLY HISEG
	HRL	AC0,HIGH1	;GET BREAK FROM PASS 1
	JUMPL	AC0,.+2		;OK IF GREATER THAN 400000
	HRLS	AC0		;SIGNAL TWO SEGMENT TO LOADER
	MOVEI	RC,1		;ASSUME RELOCATABLE
	JRST	COUT		;OUTPUT THE WORD>

VOUT:	SKIPN	RC,VECREL	;IS VECTOR ABSOLUTE ZERO?
	SKIPE	VECTOR		;ALSO CHECK RELOCATION
	JRST	.+2
	POPJ	PP,		;YES, EXIT
	MOVE	AC0,VECTOR	;AC0 SHOULD BE FLAGS

COUT:	AOS	C,COUTX		;INCREMENT INDEX
	MOVEM	AC0,COUTDB(C)	;STORE CODE
	IDPB	RC,COUTP	;STORE RELOCATION BITS
	CAIE	C,^D17		;IS THE BUFFER FULL?
	POPJ	PP,		;NO, EXIT

COUTD:	AOSG	C,COUTX		;DUMP THE BUFFER
	JRST	COUTI		;BUFFER WAS EMPTY
	HRL	C,BLKTYP	;SET BLOCK TYPE
	PUSHJ	PP,OUTBIN	;OUTPUT COUNT AND TYPE
	SETOB	C,COUTY		;INITIALIZE INDEX

COUTD2:	MOVE	C,COUTDB(C)	;GET RELOCATION BITS/CODE
	PUSHJ	PP,OUTBIN	;DUMP IT
	AOS	C,COUTY		;INCREMENT INDEX
	CAMGE	C,COUTX		;TEST FOR END
	JRST	COUTD2		;NO, GET NEXT WORD

COUTI:	SETOM	COUTX		;INITIALIZE BUFFER INDEX
	SETZM	COUTRB		;ZERO RELOCATION BITS
	MOVE	C,[POINT 2,COUTRB]
	MOVEM	C,COUTP		;INITIALIZE BIT POINTER
	POPJ	PP,		;EXIT
STOWZ1:
STOWZ:	MOVEI	RC,0
STOW:
	JUMP1	STOW20		;SKIP TEST IF PASS ONE
	TRNE	RC,-2		;RIGHT HALF ZERO OR 1?
	PUSHJ	PP,STOWT	;NO, HANDLE EXTERNAL
	TLNN	RC,-2		;LEFT HALF ZERO OR 1? WFW
	JRST	STOW10		;YES, SKIP TEST
	MOVSS	RC		;SWAP HALVES
	PUSHJ	PP,STOWT1	;HANDLE EXTERNAL WFW
	MOVSS	RC		;RESTORE VALUES

STOW10:	SKIPE	EXTPNT		;ANY EXTERNALS REMAINING?
	TRO	ER,ERRE		;YES, SET EXTERNAL ERROR FLAG

STOW20:	AOS	AC1,STPX	;INCREMENT POINTER
	MOVEM	AC0,STCODE(AC1)	;STOW CODE
	MOVEM	RC,STOWRC(AC1)	;STOW RELOCATION BITS
	SKIPN	LITLVL		;ARE WE IN LITERAL?
	AOS	LOCA		;NO, INCREMENT ASSEMBLY LOCATION
	CAIGE	AC1,.STP-1	;OVERFLOW?
	POPJ	PP,		;NO, EXIT

	SKIPE	LITLVL		;ARE WE IN A LITERAL?
	TROA	ER,ERRL		;YES, FLAG ERROR BUT DON'T DUMP
	JRST	CHARL1		;NO, SAVE REGISTERS AND DUMP THE BUFFER
	JRST	STOWI		;INITIALIZE BUFFER

DSTOW:	AOS	AC1,STPY	;INCREMENT POINTER
	MOVE	AC0,STCODE(AC1)	;FETCH CODE
	MOVE	RC,STOWRC(AC1)	;FETCH RELOCATION BITS
	CAMGE	AC1,STPX	;IS THIS THE END?
	POPJ	PP,		;NO, EXIT

STOWI:	SETOM	STPX		;INITIALIZE FOR INPUT
	SETOM	STPY		;INITIALIZE FOR OUTPUT
	SETZM	EXTPNT
	POPJ	PP,		;EXIT
SVSTOW:	AOS	LITLVL		;NESTED LITERALS
	PUSH	PP,STPX		;MAKE ROOM FOR ANOTHER
	PUSH	PP,STPY
	MOVE	AC1,STPX
	MOVEM	AC1,STPY
	JRST	0(AC2)

GTSTOW:	POP	PP,STPY		;BACK UP A LEVEL
	POP	PP,STPX
	SOS	LITLVL
	JRST	0(AC2)

	;EXTERNAL RIGHT
STOWT:	HRRZ	AC1,EXTPNT	;GET RIGHT POINTER
	CAIE	AC1,(RC)	;DOES IT MATCH 
	PUSHJ	PP,QEXT		;EXTERNAL OR RELOCATION ERROR
	HLLZS	EXTPNT
	POPJ	PP,		;EXIT

	;EXTERNAL LEFT
STOWT1:	HLRZ	AC1,EXTPNT	;GET LEFT HALF
	CAIE	AC1,(RC)	;SEE ABOVE
	PUSHJ	PP,QEXT
	HRRZS	EXTPNT
	POPJ	PP,		;EXIT
ONC:	ILDB	C,TABP		;ENTRY TO ADVANCE TAB POINTER
	PUSHJ	PP,OUTL		;OUTPUT A TAB
				;OUTPUT 6 OCT NUMBERS FROM CS LEFT
ONC1:	MOVEI	C,6		;CONVERT TO ASCII
	LSHC	C,3		;SHIFT IN OCTAL
	PUSHJ	PP,OUTL		;OUTPUT ASCII FROM C
	TRNE	CS,-1		;ARE WE THROUGH?
	JRST	ONC1		;NO, GET ANOTHER
	MOVEI	C,0		;CLEAR C
	TLNN	CS,1		;RELOCATABLE?
	MOVEI	C,"'"		;YES
	TLNN	CS,EXTF		;OR EXTERNAL
	MOVEI	C,"*"		;YES
ONC2:	JUMPN	C,OUTC		;OUTPUT IF EXTERN OR RELOCATABLE
	POPJ	PP,		;EXIT

DNC:	IDIVI	C,^D10
	HRLM	CS,0(PP)
	JUMPE	C,.+2
	PUSHJ	PP,DNC		;RECURSE IF NON-ZERO
	HLRZ	C,0(PP)
	ADDI	C,"0"		;FORM ASCII
	JRST	PRINT		;DUMP AND TEST FOR END

OUTAS0:	HRLI	CS,(POINT 7,,)	;ENTRY TO SET POINTER
OUTASC:	ILDB	C,CS		;GET NEXT BYTE
	JUMPE	C,POPOUT	;EXIT ON ZERO DELIMITER
	PUSHJ	PP,PRINT
	JRST	OUTASC

OUTSIX:	HRLI	CS,(POINT 6,,)	;OUTPUT SIXBIT
	ILDB	C,CS		;GET SIXBIT
	CAIN	C,40		;"@" DELIMITER?
	POPJ	PP,		;YES, EXIT
	ADDI	C,40		;NO, FORM ASCII
	PUSHJ	PP,OUTL		;OUTPUT ASCII CHAR FROM C
	JRST	OUTSIX+1

OUTSYM:	MOVE	CS,AC0		;PLACE NAME IN CS
OUTSY1:	MOVEI	C,0		;CLEAR C
	LSHC	C,6		;MOVE NEXT SIXBIT CHARACTER IN
	JUMPE	C,OUTTAB	;TEST FOR END
	ADDI	C,40		;CONVERT TO ASCII
	PUSHJ	PP,OUTL		;OUTPUT
	JRST	OUTSY1		;LOOP
OUTSET:	AOS	SX,0(PP)	;GET RETURN LOCATION
	MOVE	SX,-1(SX)	;GET XWD CODE
	HLRM	SX,BLKTYP	;SET BLOCK TYPE
	SETZB	ARG,RC
	PUSHJ	PP,0(SX)	;GO TO PRESCRIBED ROUTINE
	JRST	COUTD		;TERMINATE BLOCK AND EXIT

	;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE

LOOKUP:	POP	PP,LOOKX	;INTERCEPT RETURN POP
	MOVE	SX,SYMBOL
	MOVE	SDEL,0(SX)	;SET FOR TABLE SCAN
LOOKL:	SOJL	SDEL,POPOUT	;TEST FOR END
	ADDI	SX,2
	MOVE	AC0,-1(SX)
	PUSHJ	PP,SRCH7	;LOAD REGISTERS
	HLRZS	ARG
	PUSHJ	PP,@LOOKX	;RETURN TO CALLING ROUTINE
	JRST	LOOKL		;TRY AGAIN
END0:	PUSHJ	PP,EVALCM	;GET A WORD
	SKIPE	EXTPNT		;ANY EXTERNALS?
	TRO	ER,ERRE		;YES, ERROR
	SKIPN	V,AC0		;NON-ZERO?
	JUMPE	RC,.+2		;OR RELOC?
	PUSHJ	PP,ASSIG7	;YES, LIST THE VALUE
	MOVEM	AC0,VECTOR
	MOVEM	RC,VECREL
	PUSHJ	PP,VARA		;FILL OUT SELF-DEFINED VARIABLES
	PUSHJ	PP,STOUTS	;DUMP THE LINE
;	PUSH	PP,IO		;SAVE FLAGS
;	TLO	IO,IOPROG	;XLIST LITS
	PUSHJ	PP,LIT1
;	POP	PP,IO		;GET FLAG BACK
	JUMP2	ENDP2

	PUSHJ	PP,UOUT
	TLNN	IO,MFLSW	;SKIP IF ONLY PSEND
	PUSHJ	PP,REC2
	MOVE	INDIR		;SET UP FIRST AS LAST
	MOVEM	LSTFIL		;PRINTED
	SETZM	LSTPGN
	PUSHJ	PP,INZ
	TLNE	IO,MFLSW	;IF PSEND
	POPJ	PP,		;BACK TO PSEND0
	SKIPE	PRGPTR		;HAVE ANY PRGEND'S BEEN SEEN
	JRST	PSEND3		;YES,GO SET UP AGAIN

PASS20:	SETZM	CTLSAV
	PUSHJ	PP,COUTI
	PUSHJ	PP,EOUT		;OUTPUT THE ENTRIES
	PUSHJ	PP,OUTSET
	XWD	6,NOUT		;OUTPUT THE NAME (BLKTYP-6)
IFN RENTSW,<
	SKIPN	HISNSW		;PUT OUT BLOCK TYPE 3?
	JRST	PASS21		;NO
	PUSHJ	PP,OUTSET
	XWD	3,HSOUT		;OUTPUT THE HISEG BLOCK
PASS21:	>
	MOVEI	1
	HRRM	BLKTYP		;SET FOR TYPE 1 BLOCK
	TLZ	FR,P1		;SET FOR PASS 2 AND TURN OFF FLAG
	TLO	IO,IOPALL	;PUT THESE BACK
	TLZ	IO,IOPROG!IOCREF!DEFCRS	;SO LISTINGS WILL BE THE WAY THEY SHOULD
	TLNN	FR,R1BSW
	JRST	STOWI
	
	MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]
	MOVE C,0(CS)
	PUSHJ PP,PTPBIN
	AOBJN CS,.-2
	PUSHJ	PP,R1BI
	JRST	STOWI
	
R1BLDR:
	PHASE 0
	IOWD $ADR,$ST
$ST:	CONO PTR,60
	HRRI $A,$RD+1
$RD:	CONSO PTR,10
	JRST .-1
	DATAI PTR,@$TBL1-$RD+1($A)
	XCT $TBL1-$RD+1($A)
	XCT $TBL2-$RD+1($A)
$A:	SOJA $A,
$TBL1:	CAME $CKSM,$ADR
	ADD $CKSM,1($ADR)
	SKIPL $CKSM,$ADR
$TBL2:	JRST 4,$ST
	AOBJN $ADR,$RD
$ADR:	JRST $ST+1
$CKSM:	
	DEPHASE

IF2,<	PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>
ENDP2:	PUSHJ	PP,COUTD	;DUMP THE BUFFER
	MOVE	AC0,LOCO	;CHECK TO SEE IF LIT DIFFERED
	SKIPN	MODO		;AND USE SMALLER SINCE AT END
	JRST	[CAMN	AC0,ABSHI
		HRRZM	AC2,ABSHI
		JRST	ENDP2W]
IFN RENTSW,<SKIPE HHIGH		;SKIP IF NOT TWO SEGMENTS
	JRST	[CAMN	AC0,HHIGH
		HRRZM	AC2,HHIGH
		JRST	ENDP2W]>
	CAMN	AC0,HIGH
	HRRZM	AC2,HIGH
ENDP2W:
REPEAT 1,<TLNE	IO,IOCREF	;CLOSE CREF IF NECESSARY>
REPEAT 0,<TLNE FR,CREFSW	;IF CREFFING
	JRST ENDP2Q
	MOVEI SDEL,0
	PUSH PP,DBUF+3	;SO NO PAGE INFO
	DPB SDEL,[POINT 7,DBUF+3,13]
	IOR ER,OUTSW	;MAKE SURE OF OUTPUT
	PUSHJ PP,CREF
	MOVEI C,20	;CODE FOR TITLE
	PUSHJ PP,OUTLST
	PUSH PP,IO	;SAVE THIS
	TLZ IO,IOPAGE	;AND PREVENT PAGE DURING TITLE
	MOVEI CS,TBUF
	PUSHJ PP,OUTAS0
	MOVEI CS,VBUF
	PUSHJ PP,OUTAS0
	POP PP,IO	;RESTORE THE IO WORD
	POP PP,DBUF+3	>	;NEEDS FIX TO CREF
	PUSHJ	PP,CLSCR2	;CLOSE IT UP
ENDP2Q:	HRR	ER,OUTSW	;SET OUTPUT SWITCH
	SKIPN	TYPERR
	TRO	ER,TTYSW
	PUSHJ	PP,UOUT		;OUTPUT UNDEFINEDS
	TRO	ER,TTYSW
	SKPINC	C	;SEE IF WE CAN INPUT A CHAR.
	  JFCL		;BUT ONLY TO DEFEAT ^O
	SKIPG C,ERRCNT	;GET ERROR COUNT AND CHECK FOR POSITIVE
	JRST NOERW	;PRINT NO ERROR MESSAGE
IFN CCLSW,<ADDM C,JOBERR	;REMEMBER ERROR COUNT FOR EXECUTION DELETION>
	PUSHJ PP,OUTCR
	MOVE C,ERRCNT
	CAIN C,1	;1 IS A SPECIAL CASE
	JRST ONERW	;PRINT MESSAGE
	MOVEI	C,"?"		;? FOR BATCH
	PUSHJ	PP,OUTL		;...
	MOVE C,ERRCNT	;PRINT NUMBER OF ERRORS
	PUSHJ PP,DNC
	SKIPA CS,[EXP ERRMS1]	;LOAD TO PRINT
ONERW:	MOVEI CS,ERRMS2	;ONE ERROR DETECTED
ONERW1:	PUSHJ PP,OUTSIX	;PRINT
	JRST ENDP2A
NOERW:	MOVEI CS,ERRMS3
IFN CCLSW,<TLNE IO,CRPGSW!MFLSW	;IF RPG, DON'T PRINT MESSAGE>
IFE CCLSW,<TLNE	IO,MFLSW	;NOR IF MULTI-FILE MODE>
	TRZ	ER,TTYSW		;NO TTY OUTPUT
	IOR	ER,OUTSW	;UNLESS NEEDED FOR LISTING
	PUSHJ PP,OUTCR
	JRST ONERW1

ENDP2A:	PUSHJ PP,OUTCR
	TLNN	IO,MFLSW	;IN A MULTI-PROG FILE?
	JRST	ENDP2D		;NO
	SKIPE	ERRCNT		;ANY ERROR?
	PUSHJ	PP,[MOVEI CS,[ASCIZ /PROGRAM	/]
		PUSHJ PP,OUTAS0	;YES,SO PRINT MESSAGE
		MOVEI	CS,TBUF	;AND TITLE
		PUSHJ PP,OUTAS0	;FOR IDENTIFICATION
		JRST	OUTCR]	;AND A CR-LF
	TRZA	ER,TTYSW	;NO MORE OUTPUT NOW
ENDP2D:
IFN CCLSW,<TLNE IO,CRPGSW	;IF RPG, DON'T PRINT PGM BREAK
	TRZ	ER,TTYSW	;...>
IFE CCLSW,<	SKIPA		;SO PRGEND CODE CAN WORK>
	IOR	ER,OUTSW	;...
	PUSHJ	PP,OUTCR
IFN RENTSW,<
	MOVEI	CS,[SIXBIT /HI-SEG. BREAK IS @/]
	SKIPN	HHIGH		;DON'T PRINT IF ZERO
	JRST	ENDP2C		;IT WAS
	PUSHJ	PP,OUTSIX
	HRLO	CS,HHIGH	;GET THE BREAK
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTCR
ENDP2C:>
	MOVEI	CS,[SIXBIT /PROGRAM BREAK IS @/]
	PUSHJ	PP,OUTSIX	;OUTPUT PROGRAM BREAK
	HRRZ	CS,ABSHI	;GET ABS. BREAK
	CAIG	CS,140		;ANY ABS. CODE
	JRST	[HRLO CS,HIGH	;NO
		JRST	ENDP2B]	;SO DON'T PRINT
	HRLO	CS,HIGH		;GET PROGRAM BREAK
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTCR
	MOVEI	CS,[SIXBIT /ABSLUTE BREAK IS @/]
	PUSHJ	PP,OUTSIX
	HRLO	CS,ABSHI
ENDP2B:	PUSHJ	PP,ONC1
	PUSHJ PP,OUTCR
	TLNE	FR,RIMSW!R1BSW	;RIM MODE?
	PUSHJ	PP,RIMFIN	;YES, FINISH IT
IFN CCLSW,<TLNN	IO,CRPGSW!MFLSW	;IF NOT IN CCL MODE>
IFE CCLSW,<TLNN	IO,MFLSW	;NOR IF IN MULTI-FILE MODE>
	TRO	ER,TTYSW	;PRINT SIZE
	PUSHJ	PP,OUTCR
	MOVE	C,JOBREL
	LSH	C,-^D10
	ADDI	C,1
	PUSHJ	PP,DNC
	MOVEI	CS,[SIXBIT /K CORE USED@/]
	PUSHJ	PP,OUTSIX
	PUSHJ	PP,OUTCR	
	HRR	ER,OUTSW
	PUSHJ	PP,OUTSET
	XWD	2,SOUT		;OUTPUT THE SYMBOLS (BLKTYP-2)
	PUSHJ	PP,OUTSET
	XWD	7,VOUT		;OUTPUT TRANSFER VECTOR (..-7)
	PUSHJ	PP,OUTSET
	XWD	5,HOUT		;OUTPUT HIGHEST RELOCATABLE (..-5)
	PUSHJ	PP,COUTD
	TLNN	IO,MFLSW	;IS IT PRGEND?
	JRST	FINIS		;ALAS, FINISHED
	MOVEI	CS,SBUF		;RESET SBUF POINTER
	HRRM	CS,SUBTTX	;TO SUBTTL
	SETZM	PASS2I		;CLEAR PASS2 VARIABLES
	MOVE	[XWD PASS2I,PASS2I+1]
	BLT	PASS2Z-1	;BUT NOT ALL OF VARIABLES
	JRST	INZ		;RE-INITIALIZE FOR NEXT PROG


RIMFIN:	TLNE FR,R1BSW
	PUSHJ PP,R1BDMP
	SKIPN	C,VECTOR
	MOVSI	C,(JRST 4,)
	TLNN	C,777000
	TLO	C,(JRST)
	PUSHJ	PP,PTPBIN
	MOVEI	C,0
	JRST	PTPBIN
SUBTTL	PASS INITIALIZE
INZ:	AOS	MODA
	AOS	MODO
	SETZM	SEQNO
	SETZM	TAG
	HRRI	RX,^D8
	MOVEI	VARHD
	MOVEM	VARHDX
	MOVEI	LITHD
	MOVEM	LITHDX
	PUSHJ	PP,LITI
	PUSHJ	PP,STOWI
	JRST	OUTLI

RCPNTR:	POINT	1,ARG,^L<RELF>-18	;POINT 1,ARG,22
SUBTTL	PSEUDO-OP HANDLERS

TAPE0:	PUSHJ	PP,STOUTS	;FINISH THIS LINE
	JRST	GOTEND		;AND IGNORE THE REST OF THIS FILE

RADIX0:	PUSHJ	PP,EVAL10	;EVALUATE RADIX D10
	CAIG	AC0,^D10	;IF GREATER THAN 10
	CAIG	AC0,1		;OR LESS THAN 2,
ERRAX:	TROA	ER,ERRA		;FLAG ERROR AND SKIP
	HRR	RX,AC0		;SET NEW RADIX
	POPJ	PP,


XALL0:	TLZ	IO,IOSALL	;TURN OFF MACRO SUPPRESS ALL
IOSET:	JUMP1	POPOUT		;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)
	HLRZ	SX,AC0		;STORE FLAGS
	PUSHJ	PP,STOUTS	;POLISH OFF LINE
	TLO	IO,0(SX)	;NOW SUPRESS PRINTING
	POPJ	PP,

IORSET:	TDZ	IO,AC0		;RESET  FLAG IOPALL/IOPROG
	TLNE	AC0,IONCRF	;RESTORING CREFFING?
	TLZ	IO,DEFCRS	;YES, CLEAR ANY WAITING DEFINING OCCURENCES
	POPJ	PP,

BLOCK0:	PUSHJ	PP,HIGHQ
	PUSHJ	PP,EVALEX	;EVALUATE
	TRZE	RC,-1		;EXTERNAL OR RELOCATABLE?
	PUSHJ	PP,QEXT		;YES, DETERMINE TYPE
	ADDM	AC0,LOCO	;UPDATE ASSEMBLY LOCATION
BLOCK1:	EXCH	AC0,LOCA	;SAVE START OF BLOCK
	ADDM	AC0,LOCA	;UPDATE OUTPUT LOCATION
BLOCK2:	HRLOM	AC0,LOCBLK
	JUMP2	POPOUT
	TRNE	ER,ERRU
	TRO	ER,ERRV
	POPJ	PP,

PRNTX0:	TRO	ER,TTYSW	;SET OUTPUT TO TTY
	JUMP2	PRNTX2		;PASS1?
	TDOA	ER,OUTSW	;YES,OUTPUT TO LSTDEV ALSO
PRNTX2:	ANDCM	ER,OUTSW	;NO,DON'T OUTPUT TO TTY IF IT IS LSTDEV
	PUSHJ	PP,BYPASS	;GET FIRST CHAR.
	TLOA	IO,IORPTC	;REPEAT IT AND SKIP
PRNTX4:	PUSHJ	PP,PRINT	;PRINT THE CHAR.
	PUSHJ	PP,CHARAC	;GET ASCII CHAR.
	CAIG	C,CR		;IF GREATER THAN CR
	CAIG	C,HT		;OR LESS THAN LF
	JRST	PRNTX4		;THEN CONTINUE
	PUSHJ	PP,OUTCR	;OUTPUT A CRLF
	TRZA	ER,TTYSW!LPTSW	;TURN OF OUTPUT
CPOPJ1:	AOS	(PP)		;USEFUL TAG HAS TO GO SOMEWHERE
CPOPJ:	POPJ	PP,		;EXIT

REMAR0:	PUSHJ	PP,GETCHR	;GET A CHARACTER
	CAIE	C,EOL
	JRST	REMAR0
	POPJ	PP,		;EXIT
LIT0:	PUSHJ	PP,BLOCK1
	PUSHJ	PP,STOUTS
LIT1:	JUMP2	LIT20

;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR

	MOVE	AC0,LITCNT
	MOVE	SX,LITHDX
	HRLM	AC0,0(SX)
	MOVE	V,LOCA
	HRL	V,MODA
	MOVEM	V,-1(SX)
	JRST	LIT24

LIT20:	PUSH	PP,LOCA
	PUSH	PP,LOCO
	SKIPN	LITNUM
	JRST	LIT20A
	MOVE	SX,LITHDX
	HRRZ	AC0,-1(SX)
	CAME	AC0,LOCA
	TRO	ER,ERRP
LIT20A:	MOVE	SX,LITAB
LIT21:	SOSGE	LITNUM
	JRST	LIT22
	MOVE	AC0,-2(SX)	;WFW
	MOVE	RC,-1(SX)	;WFW
	MOVE SX,(SX)	;WFW POINTER TO THE NEXT LIT
	PUSHJ	PP,STOW20	;STOW CODE
	MOVEI	C,12		;SET LINE FEED
	IDPB	C,LBUFP
	PUSHJ	PP,OUTLIN	;OUTPUT THE LINE
	JRST	LIT21
LIT22:	HRRZ	AC2,LOCO
	POP	PP,LOCO
	POP	PP,LOCA
	MOVE	SX,LITHDX
	HLRZ	AC0,0(SX)
	SUB AC2,LOCO	;COMPUTE LENGTH USED
	CAMGE AC0,AC2	;USE LARGER
	MOVE AC0,AC2
	ADD AC2,LOCO
LIT24:	ADDM	AC0,LOCA
	ADDM	AC0,LOCO
	PUSHJ	PP,GETTOP
	HRRM	SX,LITHDX
LITI:	SETZM	LITCNT
	SETZM	LITNUM
	MOVEI	LITAB
	MOVEM	LITABX
	JRST	HIGHQ

GETTOP:	HRRZ	AC1,SX		;VARHD
	HRRZ	SX,0(SX)
	JUMPN	SX,POPOUT
	MOVEI	SX,3	;WFW
	ADDB	SX,FREE
	CAML	SX,SYMBOL
	PUSHJ	PP,XCEED
	SUBI	SX,1		;MAKE SX POINT TO LINK
	SETZM	0(SX)		;CLEAR FORWARD LINK
	HRRM	SX,0(AC1)	;STORE ADDRESS IN LAST LINK
	POPJ	PP,
VAR0:	PUSHJ	PP,BLOCK1	;PRINT LOCATION
	PUSHJ PP,VARA
	JRST STOUTS

VARA:	MOVE	SX,VARHDX
	MOVE AC0,LOCA	;GET LOCATION FOR CHECK
	JUMP1 VARB	;DO NOT CHECK START ON PASS 1
	CAME AC0,-1(SX)	;CHECK START OF VAR AREA
	TRO ER,ERRP	;AND GIVE ERROR
VARB:	MOVEM AC0,-1(SX)	;SAVE START FOR PASS 2
	HLRZ	AC0,0(SX)
	ADDM	AC0,LOCA
	ADDM	AC0,LOCO
	PUSHJ	PP,GETTOP
	HRRM	SX,VARHDX
	JUMP2	POPOUT

	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRZN	ARG,VARF
	POPJ	PP,		;NO, EXIT
	TRZ ARG,UNDF		;TURN OFF FLAG NOW
	MOVSI AC0,1		;ADD 1
	ADDM	AC0,0(AC1)	;UPDATE COUNT

	IOR	ARG,MODA	;SET TO ASSEMBLY MODE
	HRL	ARG,LOCA
	MOVSM	ARG,0(SX)	;UPDATE 2ND WRD OF SYM TAB ENTRY
	AOS	LOCA
	AOS	LOCO
	JRST	HIGHQ1
IF:	PUSH	PP,AC0		;SAVE AC0
	PUSH	PP,IO
	PUSHJ	PP,EVALXQ	;EVALUATE AND TEST EXTERNAL
	POP	PP,AC1
	JUMPL	AC1,IFPOP
	TLZ	IO,FLDSW
IFPOP:	POP	PP,AC1		;RETRIEVE SKIP INSTRUCTION
IFSET:	TLO IO,IORPTC		;REPEAT CHARACTER
IFXCT:	XCT	AC1		;EXECUTE INSTRUCTION
	TDZA	AC0,AC0		;FALSE
	MOVEI	AC0,1		;TRUE
IFEXIT:	JUMPOC REPEA1		;BRANCH IF IN OP-CODE FIELD
IFEX1:	PUSHJ PP,GETCHR		;SEARCH FOR "<"
	CAIN C,EOL		;ERROR IF END OF LINE
	JRST ERRAX
	CAIE C,34
	JRST IFEX1
	JUMPE AC0,IFEX2		;TEST FOR 0
	TLO IO,IORPTC		;NO, PROCESS AS CELL
	PUSHJ PP,CELL
	SETZM	INCND		;NOT ANY MORE
	JRST STOW		;STOW CODE AND EXIT

IFPASS:	HRRI	AC0,P1		;MAKE IT TLNX IO,P1
	MOVE	AC1,AC0		;PLACE IT IN AC1
	JRST	IFSET		;EXECUTE INSTRUCTION

IFB0:	HLLO	AC1,AC0		;FORM AND STORE TEST INSTRUCTION
IFB1:	PUSHJ	PP,CHARL	;GET FIRST NON-BLANK
	CAIE	C," "
	CAIN	C,"	"
	JRST	IFB1		;SKIP BLANKS AND TABS
	CAIG	C,CR		;CHECK FOR CARRET AS DELIM.
	CAIGE	C,LF
	SKIPA	SX,SEQNO2
	JRST	ERRAX
	MOVEM	SX,CNDSEQ
	MOVE	SX,PAGENO
	MOVEM	SX,CNDPG
	SETOM	INCND		;SAVE INFO. FOR PASS 1 ERRORS
	CAIN	C,"<"		;LEFT BRACKET?
	SETZB	C,RC		;YES, PREPARE FOR OLD FORMAT
	SKIPA	SX,C		;SAVE FOR COMPARISON
IFB3:	TRO	AC0,1		;SET FLAG
IFB2:	PUSHJ	PP,CHARL	;GET ASCII CHARACTER AND LIST
	CAMN	C,SX		;TEST FOR DELIMITER
	JRST	IFXCT		;FOUND
	CAIE	C," "		;BLANK?
	CAIN	C,"	"	;OR TAB?
	JRST	IFB2		;YES
	JUMPN	SX,IFB3		;JUMP IF NEW FORMAT
	CAIN	C,"<"		;<?
	AOJA	RC,IFB2		;YES, INCREMENT COUNT
	CAIN	C,">"		;>?
	SOJL	RC,IFXCT	;YES, DECREMENT AND EXIT IF DONE
	JRST	IFB3		;GET NEXT CHARACTER

IFDEF0:	HRRI	AC0,UNDF	;MAKE IT TLNX ARG,UNDF
	PUSH	PP,AC0		;STACK IT
	PUSHJ	PP,GETSYM	;TAKES SKIP RETURN IF SYM NAME IS LEGAL
	TROA	ER,ERRA		;ILLEGAL!
	PUSHJ	PP,SEARCH
	JRST	[PUSHJ	PP,OPTSCH
		TLO	ARG,UNDF
		JRST	.+1]
	PUSHJ PP,SSRCH3		;EMIT TO CREF ANYWAY
	JRST	IFPOP		;POP AND EXECUTE INSTRUCTION

IFIDN0:	HLRZS	AC0
	MOVEI	V,2*.IFBLK-1
	SETZM	IFBLK(V)	;CLEAR COMPARISON BLOCK
	SOJGE	V,.-1
	SETZM	.TEMP		;CLEAR STORED DELIMETER
	MOVEI	RC,IFBLK	;SET FOR FIRST BLOCK
	PUSHJ	PP,IFCL		;GET FIRST STRING
	MOVEI	RC,IFBLKA
	PUSHJ	PP,IFCL		;GET SECOND STRING
	MOVEI	V,.IFBLK-1
	MOVE	SX,IFBLK(V)	;GET WORD FROM FIRST STRING
	CAMN	SX,IFBLKA(V)	;COMPARE WITH SECOND STRING
	SOJGE	V,.-2		;EQUAL, TRY NEXT WORD
	JUMPL	V,IFEXIT	;DID WE FINISH STRING
	XORI	AC0,1		;NO, TOGGLE REQUEST
	JRST	IFEXIT	;DO NOT TURN ON IORPTC WFW

IFCL:	PUSHJ	PP,CHARAC	;GET AND LIST CHARACTER
	CAIE	C," "		;SKIP SPACES
	CAIG	C,CR		;ALSO SKIP CR-LF
	CAIGE	C,HT		;AND TAB
	JRST	.+2		;NOT ONE OF THEM
	JRST	IFCL		;SO LONG COMPARISONS WILL WORK
;*** A CROCK SO THAT IFIDN <X>,<X>,<INST.> WILL WORK	***
	CAIE	C,","		;IS IT A COMMA?
	JRST	.+3		;NO
	SKIPN	.TEMP		;YES, WAS PREVIOUS FIELD OLD METHOD?
	JRST	IFCL		;YES, IGNORE COMMA AND SPACES
;	***
	CAIN	C,"<"		;WAS IT LEFT BRACKET?
	SETO	C,		;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET
	MOVEM	C,.TEMP		;STORE TERMINATOR FOR COMPARISON
	MOVEI	SX,5*.IFBLK-1	;LIMIT SEARCH
	HRLI	RC,(POINT 7,,)	;SET UP BYTE IN RC
IFCLR:	PUSHJ	PP,CHARAC
	SKIPLE	.TEMP		;NEW METHOD?
	JRST	IFCLR1		;YES, IGNORE ANGLE BRACKET COUNTING
	CAIN	C,"<"		;ANOTHER LEFT ANGLE?
	SOS	.TEMP		;YES, KEEP COUNT
	CAIN	C,">"		;CLOSING ANGLE
	AOSGE	.TEMP		;MATCHING COUNT?
IFCLR1:	CAMN	C,.TEMP		;TEST FOR DELIMITER
	POPJ	PP,		;EXIT ON RIGHT DELIMITER
	SOJG	SX,.+2		;ANY ROOM IN COMPARISON BLOCK?
	TROA	ER,ERRA		;NO, FLAG ERROR BUT KEEP ON GOING
	IDPB	C,RC		;DEPOSIT BYTE
	JRST	IFCLR


IFEX2:	PUSHJ	PP,GETCHR
	CAIN	C,EOL		;EXIT WITH ERROR IF END OF LINE
	JRST	ERRAX
	CAIN	C,34		;"<"?
	AOJA	AC0,IFEX2	;YES, INCREMENT COUNT
	CAIE	C,36		;">"?
	JRST	IFEX2		;NO, TRY AGAIN
	SOJGE	AC0,IFEX2	;YES, TEST FOR MATCH
	PUSHJ	PP,BYPASS	;YES, MOVE TO NEXT DELIMITER
	SETZM	INCND		;OUT OF CONDITIONAL NOW
	AOJA	AC0,STOWZ1	;STOW ZERO


INTER0:	HLLZM	AC0,INTENT	;AC0 CONTAINS INTF/ENTF FLAGS

INTER1:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	INTER3		;INVALID, SKIP
	PUSHJ	PP,SSRCH	;SEARCH THE TABLE
	MOVSI	ARG,SYMF!INTF!UNDF
	TLNE	ARG,UNDF	;UNDEFINED?
	TRO	ER,ERRA		;YES, FLAG ERROR
	TLNN	ARG,SYNF!EXTF
	TDOA	ARG,INTENT			;SET APPROPRIATE FLAGS
INTER3:	TROA	ER,ERRA		;FLAG ARG EROR AND SKIP
	PUSHJ	PP,INSERQ	;INSERT/UPDATE
	JUMPCM	INTER1
	SETZM EXTPNT	;JUST IN CASE, SO AS NOT TO CONFUSE WORLD
	POPJ	PP,		;NO, EXIT
EXTER0:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	EXTER4		;INVALID, ERROR
EXTER1:	TLO	IO,DEFCRS	;FLAG THIS AS A DEFINITION
	PUSHJ	PP,SSRCH	;OK, SEARCH SYMBOL TABLE
	JRST	EXTER2		;NOT THERE, INSERT IT
	TLNN	ARG,EXTF!VARF!UNDF
	TROA	ER,ERRE		;FLAG ERROR AND BYPASS
	TLNE	ARG,EXTF	;VALID, ALREADY DEFINED?
	JRST	[JUMP1	EXTER3	;YES, BYPASS
		TLZN ARG,UNDF	;SKIP IF UNDEFINED ALSO
		JRST	EXTER3	;CONTINUE
		ANDM ARG,(SX)	;CLEAR UNDF ON PASS 2
		JRST	EXTER2]	;SET UP EXTERNAL NOW
EXTER2:	MOVEI V,2		;NO, GET 2 CELLS FROM THE TREE
	ADDB V,FREE
	CAML	V,SYMBOL	;HAVE WE RUN OUT OF CORE?
	PUSHJ	PP,XCEEDS	;YES, TRY TO BORROW SOME MORE
	SUBI	V,2		;GET RIGHT CELL FOR POINTER
	SETZB	RC,0(V)		;ALL SET, ZERO VALUES
	MOVSI	ARG,SYMF!EXTF
	PUSHJ	PP,INSERT	;INSERT/UPDATE IT
	MOVSI	ARG,PNTF
	IORM	ARG,0(SX)
	SKIPA ARG,-1(SX)		;GET THE SIXBIT FOR THE NAME
EXTER4:	TROA ER,ERRA	;FLAG AS ERROR
	MOVEM ARG,1(V)		;AND STORE THAT IN CASE SYMBOL TABLE MOVES
EXTER3:	JUMPCM	EXTER0
	POPJ	PP,		;NO, EXIT
EVAL10:	PUSH	PP,RX
	HRRI	RX,^D10
	PUSHJ	PP,EVALEX	;EVALUATE
	POP	PP,RX		;RESET RADIX
	JUMPE	RC,POPOUT	;EXIT IF ABSOLUTE

QEXT:	SKIPE	EXTPNT		;ANY POSSIBILITIES?
	TROA	ER,ERRE		;YES, FLAG EXTERNAL ERROR
	TRO	ER,ERRR		;NO, FLAG RELOCATION ERROR
	HLLZS	RC		;CLEAR RELOCATION/EXTERNAL
	POPJ	PP,

EVALXQ:	PUSHJ	PP,EVALEX	;EVALUATE EXPRESSION
	TLZN RC,-2		;LEFT HALF EXTERNAL
	TRZE	RC,-2		;WAS AN EXTERNAL FOUND?
	TRO	ER,ERRE		;YES, FLAG ERROR
	POPJ	PP,		;RETURN
OPDEF0:	PUSHJ	PP,GETSYM	;GET THE FIRST SYMBOL
	POPJ	PP,		;ERROR IF INVALID SYMBOL
	CAIE	C,73		;"["?
	JRST	ERRAX		;NO, ERROR
	PUSH	PP,AC0		;STACK MNEMONIC
	AOS	LITLVL		;SHORT OUT LOCATION INCREMENT
	PUSHJ	PP,STMNT	;EVALUATE STATEMENT
	SKIPGE	STPX		;CODE STORED?
	TROA	ER,ERRA		;NO,"A" ERROR
	PUSHJ	PP,DSTOW	;GET AND DECODE VALUE
	SOS	LITLVL
	EXCH	AC0,0(PP)	;EXCHANGE VALUE FOR MNEMONIC
	PUSH	PP,RC		;STACK RELOCATION
	TLO	IO,DEFCRS	;SAY WE ARE DEFINING IT
	PUSHJ	PP,MSRCH	;SEARCH SYMBOL TABLE
	MOVSI	ARG,OPDF	;NOT FOUND
	POP	PP,RC		;RESTORE VALUES
	POP	PP,V
	TLNE	ARG,SYNF!MACF
	TRO	ER,ERRA		;YES "A" ERROR
	TRNN	ER,ERRA		;ERROR?
	PUSHJ	PP,INSERT	;NO, INSERT/UPDATE
	TLZ IO,DEFCRS		;JUST IN CASE
	PUSHJ	PP,BYPASS
	JRST	STOWI		;BE SURE STOW IS RESET


DEPHA0:	MOVE	AC0,LOCO
	SKIPA	RC,MODO		;SET TO OUTPUT VALUES AND SKIP
PHASE0:	PUSHJ	PP,EVALXQ	;EVALUATE AND CHECK FOR EXTERNAL
	MOVEM	AC0,LOCA	;SET ASSEMBLY LOCATION COUNTER
	MOVEM	RC,MODA
	JRST	BLOCK2
ASSIGN:	JUMPAD	ERRAX		;NO, ERROR
	PUSHJ	PP,ASSIG1
	TLNE	IO,IOSALL	;SUPPRESS ALL?
	JUMPN	MRP,CPOPJ	;IF IN MACRO
ASSIG7:	MOVEM	RC,ASGBLK
	TRNE	RC,-2		;EXTERNAL
	HLLZS	ASGBLK		;YES,CLEAR RELOCATION
	TLNE	RC,1		;LEFT HALF NOT RELOC?
	TLNE	RC,-2		;...
	HRROS	ASGBLK		;YES, SET FLAG
	MOVEM	V,LOCBLK
	POPJ	PP,

ASSIG1:	PUSH	PP,AC0		;SAVE SYMBOL
	SETZB AC0,EXTPNT	;SPECIAL CHECK FOR == WFW
	PUSHJ PP,PEEK		;IS THE NEXT ON =
	CAIE	C,"="
	JRST	ASSIG5
	TLO	AC0,NOOUTF	;YES, NOT OUT TO DDT WFW
	PUSHJ	PP,GETCHR	;PROCESS THE CHAR.
	PUSHJ	PP,PEEK		;CHECK FOR ==: DMN
ASSIG5:	CAIE	C,":"		;IS IT
	JRST	ASSIG6		;NO
	TLO	AC0,INTF	;MAKE INTERNAL
	PUSHJ	PP,GETCHR	;REPEAT IT
ASSIG6:	MOVEM AC0,HDAS		;STORE THESE BITS WFW
	PUSHJ	PP,EVALCM	;EVALUATE EXPRESSION
	EXCH	AC0,0(PP)	;SWAP VALUE FOR SYMBOL
	PUSH	PP,RC
	TRNN RC,-2		;CHECK EXTERNAL AGREEMENT
	JRST ASSIG2
	HRRZS RC
	HRRZ ARG,EXTPNT
	CAME RC,ARG
	PUSHJ	PP,QEXT		;EXTERNAL OR RELOCATION ERROR
ASSIG2:	HLRZ RC,(PP)
	TRNN RC,-2
	JRST ASSIG3
	HLRZ ARG,EXTPNT
	CAME RC,ARG
	PUSHJ	PP,QEXT
ASSIG3:	TLO IO,DEFCRS
	PUSHJ	PP,SSRCH
	MOVSI	ARG,SYMF
	IOR ARG,HDAS	;WFW
	TLNE	ARG,UNDF	;WAS IT UNDEFINED
	TLZ	ARG,EXTF!PNTF	;YES,CLEAR EXTF NOW
	TLZ	ARG,UNDF!VARF	;CANCEL UNDEFINED AND VARIABLE FLAGS
	SETZM EXTPNT		;FOR REST OF WORLD
	POP	PP,RC
	TRNE	ER,ERRORS-ERRQ
	SETZ	RC,		;CLEAR RELOCATION
	POP	PP,V
	TRNE	ER,ERRU		;WAS VALUE UNDEFINED?
	TLO	ARG,UNDF	;YES,SO TURN UNDF ON
	TLNE	ARG,TAGF!EXTF
	JRST	ERRAX
	JRST	INSERT

LOC0:	PUSHJ	PP,HIGHQ	;AC0=0,0
	PUSH	PP,AC0		;SAVE MODE REQUESTED
	HLRZS	AC0		;PUT MODE IN RIGHT HALF
	JUMPN	AC0,RELOC0	;RELOC PSEUDO-OP
	CAMN	AC0,MODO	;SAME AS PRESENT MODE?
	JRST	[HRRZ AC0,LOCO	;YES
		EXCH AC0,ABSLOC	;EXCH VALUES
		JRST	LOC01]
	HRRZ	AC0,LOCO	;NO, GET CURRENT VALUE
	MOVEM	AC0,RELLOC	;SAVE IT
	MOVE	AC0,ABSLOC	;GET LAST RELOC VALUE
LOC01:	PUSHJ	PP,BYPASS	;SKIP BLANKS
	TLO	IO,IORPTC
	CAIE	C,EOL		;USE PREVIOUS VALUE IF NULL ARGUMENT
	PUSHJ	PP,EVALXQ	;GET EXPRESSION AND TEST EXTERNAL
	HRRM	AC0,(PP)	;STORE NEW VALUE
	POP	PP,AC0		;RETRIEVE STORED MODE AND VALUE
LOC10:	HRRZM	AC0,LOCA	;SET ASSEMBLY LOCATION
	HRRZM	AC0,LOCO	;AND OUTPUT LOCATION
	HLRZM	AC0,MODA	;SET MODE
	HLRZM	AC0,MODO
	JRST	BLOCK2

RELOC0:	CAMN	AC0,MODO
	JRST	[HRRZ	AC0,LOCO
		EXCH	AC0,RELLOC
		JRST	LOC01]
	HRRZ	AC0,LOCO
	MOVEM	AC0,ABSLOC
	MOVE	AC0,RELLOC
	JRST	LOC01

IFN RENTSW,<
HISEG1:	PUSHJ	PP,HIGHQ	;SET CURRENT PROGRAM BREAK
	PUSHJ	PP,COUTD	;DUMP CURRENT TYPE OF BLOCK
	SKIPN	HISNSW		;IF WE HAVE SEEN IT BEFORE
	SKIPE	HIGH		;OR ANY RELOC CODE PUT OUT
	TRO	ER,ERRQ		;FLAG AS AN ERROR
	PUSHJ	PP,BYPASS	;GO GET EXPRESSION
	TLO	IO,IORPTC
	PUSHJ	PP,EVALXQ	;CHECK FOR EXTERNAL
	ANDCMI	AC0,1777	;ONLY ALLOWED TO START ON NEW K BOUND
	HRRZM	AC0,LOCA	;SET LOC COUNTERS
	HRRZM	AC0,LOCO
	MOVEI	RC,1		;ASSUME RELOCATABLE
	POPJ	PP,

TWSEG0:	PUSHJ	PP,HISEG1	;COMMON CODE
	JUMPN	AC0,.+2		;ARGUMENT SEEN
	MOVEI	AC0,400000	;ASSUME 400000
	HRRZM	AC0,HMIN	;SET OFSET OF HIGH SEG.
	HRRZM	AC0,HHIGH	;INCASE NO HISEG CODE
	TLOA	AC0,(1B0)	;SIGNAL TWO SEGMENTS AND SKIP

HISEG0:	PUSHJ	PP,HISEG1	;COMMON CODE
HISEG2:	MOVEM	AC0,SVTYP3	;SAVE THE HISEG ARG
	MOVEM	RC,MODA		;SET MODES
	MOVEM	RC,MODO
	SETOM	HISNSW		;WE HAVE ALREADY PUT ONE OUT
	JRST	BLOCK2		;MAKE LISTING HAPPEN RIGHT>

IFE RENTSW,<
	SYN	CPOPJ,HISEG0
	SYN	CPOPJ,TWSEG0>

	SYN	CPOPJ,ONFORM
	SYN	CPOPJ,OFFORM
HIGHQ:
HIGHQ1:	MOVE	V,LOCO	;GET ASSEMBLY LOCATION
	SKIPN	MODO		;IF ASSEMBLY MODE IS ABSOLUTE
	JRST	[CAMLE V,ABSHI	;RECORED ABS HIGHEST ALSO
		MOVEM V,ABSHI
		POPJ PP,]
IFN RENTSW,<SKIPE	HMIN	;IS IT A TWO SEGMENT PROGRAM?
	JRST	[CAMGE	V,HMIN	;YES,IS THIS HIGH SEG.?
		JRST	.+1	;NO,STORE LOW SEGMENT
		CAMLE	V,HHIGH	;YES,IS IT GREATER THAN "HHIGH"?
		MOVEM	V,HHIGH	;YES,REPLACE WITH LARGER VALUE
		POPJ	PP,]>
	CAMLE	V,HIGH		;IS IT GREATER THAN "HIGH"?
	MOVEM	V,HIGH		;YES, REPLACE WITH LARGER VALUE
	POPJ	PP,
	
ONML:	TLZA FR,MWLFLG		;MULTI-WORD LITERALS OK
OFFML:	TLO FR,MWLFLG		;NO
	POPJ PP,

OFFSYM:	SETOM	IONSYM	;SUPRESS SYMBOL TABLE LISTING
	POPJ	PP,

SUPRE0:	PUSHJ PP,GETSYM	;GET A SYMBOL TO SUPRES
	JRST SUPRE1	;ERROR
	PUSHJ PP,SSRCH	;SYMBOL ONLY
	JRST SUPRE1	;GIVE ERROR MESSAGE
	TLOA ARG,SUPRBT	;SET THE SUPRESS BIT
SUPRE1:	TROA ER,ERRA
	IORM ARG,(SX)	;PUT BACK
	JUMPCM SUPRE0	;ANY MORE?
	JRST	SUPRS1

SUPRSA:	PUSHJ PP,LOOKUP	;SUPRESS ALL
	MOVSI ARG,SUPRBT
	IORM ARG,(SX)
SUPRS1:	SETZM EXTPNT	;JUST IN CASE WE LOOKED ONE UP
	POPJ PP,

XPUNG0:	JUMP1	POPOUT
	PUSHJ	PP,LOOKUP
	MOVE	ARG,(SX)	;GET SYMBOL FLAGS
	TLNN	ARG,INTF!ENTF!EXTF!SPTR
	TLOA	ARG,SUPRBT	;LOCAL SYMBOL,SO SUPPRESS IT
	SETZM	EXTPNT
	MOVEM	ARG,(SX)	;RESTORE FLAGS
	POPJ	PP,
TITLE0:	JUMP2	REMAR0
	MOVEI	SX,.TBUF
	HRRI	AC0,TBUF
	PUSHJ PP,SUBTT1	;GO READ IT
	MOVEM	SX,TCNT		;SAVE COUNT OF CHARS. WRITTEN
IFN UNIVR,<SKIPE	UNIVSN		;WAS IT A UNIVERSAL?
	PUSHJ	PP,ADDUNV	;YES  ADD TO TABLE>
	TLOE IO,IOTLSN	;HAVE WE SEEN ONE
IFE CCLSW,<TRO	ER,ERRM		;YES, COMPLAIN>
IFN CCLSW,<TROA	ER,ERRM		;YES, MESSAGE
	JRST 	PRNAM		;PRINT NAME IF FIRST ONE>
	POPJ	PP,		;EXIT OTHERWISE

SUBTT0:	SKIPE	SBUF		;STORE FIRST SUBTTL ON PASS1
	JUMP1	REMAR0		;OTHERWISE EXIT IF PASS ONE
	MOVEI	SX,.SBUF
	HRRI	AC0,SBUF

SUBTT1:	PUSHJ	PP,BYPASS	;BYPASS LEADING BLANKS
	TLO	IO,IORPTC
SUBTT3:	PUSHJ	PP,CHARAC	;GET ASCII CHARACTER
	IDPB	C,AC0		;STORE IN BLOCK
	CAIGE	C,40		;TEST FOR TERMINATOR
	CAIN	C,HT
	SOJG	SX,SUBTT3	;TEST FOR BUFFER FULL
	DPB	RC,AC0		;END, STORE TERMINATOR
	SOJA	SX,CPOPJ	;COUNT NUL AND EXIT

IFN CCLSW,<
PRNAM:	TLNN IO,CRPGSW	;NOT IF NOT RPG
	POPJ PP,
	PUSH	PP,AC0		;SAVE AC0 DMN
	PUSH	PP,RC		;AND RC
	MOVE AC0,[POINT 7,TBUF]
	MOVE SX,[POINT 7,OTBUF]
	MOVEI RC,6	;MAX OF SIX CHRS
PN1:	ILDB C,AC0
	CAILE C," "	;CHECK FOR LEGAL
	CAILE C,"Z"+40	;CHECK AGAINST LOWER CASE Z
	JRST PN2
	IDPB C,SX	;PUT IN OUTPUT BUFFER
	SOJG RC,PN1	;GET MORE
PN2:	MOVEI C,0
	IDPB C,SX	;TERMINATOR
	TTCALL	3,OTBUF
	TTCALL	3,[ASCIZ /
/]
	POP	PP,RC
	POP	PP,AC0		;RESTORE AC0 DMN
	POPJ PP,
>
SYN0:	PUSHJ	PP,GETSYM	;GET THE FIRST SYMBOL
	JRST	ERRAX		;ERROR, EXIT
	PUSHJ	PP,MSRCH	;TRY FOR MACRO/OPDEF
	JRST	SYN3		;NO,0THRY FOR OPERAND
SYN1:	MOVEI	SX,MSRCH	;YES, SET FLAG
SYN2:	PUSHJ	PP,SAVEXS	;SAVE REGISTERS
	JUMPNC	ERRAX		;ERROR IF NO COMMA
	PUSHJ	PP,GETSYM	;GET THE SECOND SYMBOL
	POPJ	PP,
	PUSHJ	PP,@SAVBLK+SX	;SEARCH FOR SECOND SYMBOL
	JFCL
	MOVE	ARG,SAVBLK+ARG	;GET VALUES
	MOVE	RC,SAVBLK+RC
	MOVE	V,SAVBLK+V
	TLNE	ARG,MACF	;MACRO?
	PUSHJ	PP,REFINC	;YES, INCREMENT REFERENCE
	JRST	INSERT		;INSERT AND EXIT

SYN3:	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	JRST	SYN4		;NOT FOUND, TRY OP CODE
	TLO	ARG,SYNF	;FLAG AS SYNONYM
	TLNE	ARG,EXTF	;EXTERNAL?
	HRRZ	V,ARG		;YES, RELPACE WITH POINTER
	MOVEI	SX,SSRCH	;SET FLAG
	TLNN ARG,VARF	;DO NOT LET HIM SYN A VARIABLE
	JRST	SYN2
	JRST ERRAX

SYN4:	PUSHJ	PP,OPTSCH	;SEARCH FOR OP-CODE
	JRST	ERRAX		;NOT FOUND, EXIT WITH ERROR
	MOVSI	ARG,SYNF	;FLAG AS SYNONYM
	JRST	SYN1
PURGE0:	PUSHJ	PP,GETSYM	;GET A MNEMONIC
	JRST	[TRZ ER,ERRA	;CLEAR ERROR
		POPJ	PP,]	;AND RETURN
	PUSHJ	PP,MSRCH	;SEARCH MACRO SYMBOL TABLE
	JRST	PURGE2		;NOT FOUND, TRY SYMBOLS
	PUSH	PP,CS		;SAVE CS AS IT MAY GET GARBAGED
	TLNE	ARG,MACF	;MACRO?
	PUSHJ	PP,REFDEC	;YES, DECREMENT THE REFERENCE
	POP	PP,CS
	JRST	PURGE4		;REMOVE SYMBOL FROM TABLE

PURGE2:	PUSHJ	PP,SSRCH	;TRY OPERAND SYMBOL TABLE
	JRST	PURGE5		;NOT FOUND GET NEXT SYMBOL
	TRNN RC,-2		;CHECK COMPLEX EXTERNAL
	TLNE RC,-2
	TLNE ARG,SYNF
	JRST	.+2
	JRST PURGE3
	TLNE	ARG,EXTF!UNDF	;ERROR IF EXTERNAL OR UNDEFINED
	TLNE	ARG,SYNF	;BUT NOT A SYNONYM
	JRST	PURGE4
PURGE3:	TROA	ER,ERRA		;NOT FOUND, ERROR
PURGE4:	PUSHJ	PP,REMOVE	;REMOVE FROM THE SYMBOL TABLE
PURGE5:	JUMPCM	PURGE0
	POPJ	PP,		;EXIT
OPD1:	TLNE	ARG,UNDF	;IF OPDEF IS UNDEFINED
	TRO	ER,ERRO		;GIVE "O" ERROR
OPD:	MOVE	AC0,V		;PUT VALUE IN AC0
	JRST	OP
IOP:	MOVSI	AC2,(POINT 9,0(PP),11)
	TLOA	IO,IOIOPF	;SET "IOP SEEN" AND SKIP
OP:	MOVSI	AC2,(POINT 4,0(PP),12)
	PUSH	PP,RC
	PUSH	PP,AC0		;STACK CODE 
	PUSH	PP,AC2
	PUSHJ	PP,EVALEX	;EVALUATE FIRST EXPRESSION
	POP	PP,AC2
	JUMPNC	OP2
OP1B:	PUSHJ	PP,GETCHR	;GET A CHARACTER
	JUMPCM XWD5		;PROCESS COMMA COMMA IN XWD
	TLO	IO,IORPTC	;NOT A COMMA,REPEAT IT
	LDB	AC1,AC2
	ADD	AC1,AC0
	DPB	AC1,AC2
	JUMPE	RC,OP1A		;EXTERNAL OR RELOCATABLE?
	PUSHJ	PP,QEXT		;YES, DETERMINE WHICH AND FLAG AN ERROR

OP1A:	PUSHJ	PP,EVALEX	;GET ADDRESS PART
OP2:	PUSHJ	PP,EVADR	;EVALUATE STANDARD ADDRESS
OP3:	POP	PP,AC0		;PUT IN AC0
	POP	PP,RC
	SKIPE	(PP)		;CAME FROM EVALCM?
	JRST	STOW		;NO,STOW CODE AND EXIT
	POP	PP,AC1		;YES,EXIT IMMEDIATELY
	POPJ	PP,

EVADR:				;EVALUATE STANDARD ADDRESS
IFE IIISW,<TLNN	AC0,-1		;OK IF ALL 0'S
	JRST	.+4		;IT WAS
	TLC	AC0,-1		;CHANGE ALL ONES TO ZEROS
	TLCE	AC0,-1		;OK IF ALL 1'S
	TRO	ER,ERRQ		;NO,FLAG Q ERROR>
	ADD	AC0,-1(PP)	;ADD ADDRESS PORTIONS
	HLL	AC0,-1(PP)	;GET LEFT HALF
	TLZE	FR,INDSW	;INDIRECT BIT?
	TLO	AC0,(Z @)	;YES, PUT IT IN
	MOVEM	AC0,-1(PP)	;RE-STACK CODE
	ADD	RC,-2(PP)	;UPDATE RELOCATION
	HRRM	RC,-2(PP)	;USE HALF WORD ADD
	CAIE	C,10		;"("?
	POPJ	PP,		;NO, EXIT

	MOVSS	EXTPNT		;WFW
	PUSHJ	PP,EVALCM	;EVALUATE
	MOVSS	EXTPNT		;WFW
	MOVSS	V,AC0		;SWAP HALVES
IFE IIISW,<MOVSS SX,RC
	IOR	SX,V		;MERGE RELOCATION
	TRNN	SX,-1		;RIGHT HALF ZERO?
	JRST	OP2A		;YES, DO SIMPLE ADD
	MOVE	ARG,RC		;NO, SWAP RC INTO ARG>
IFN IIISW,<MOVSS ARG,RC>
	ADD	V,-1(PP)	;ADD RIGHT HALVES
	ADD	ARG,-2(PP)
	HRRM	V,-1(PP)	;UPDATE WITHOUT CARRY
	HRRM	ARG,-2(PP)
	HLLZS	AC0		;PREPARE LEFT HALVES
	HLLZS	RC
IFE IIISW,<TLNE	SX,-1		;IS LEFT HALF ZERO?
	TRO	ER,ERRQ		;NO FLAG FORMAT ERROR
OP2A:	TLNE	RC,-1		;RELOCATION FOR LEFT HALF?
	PUSHJ	PP,OP2A1	;YES,IS IT LEGAL?
	TLNE	AC0,777000	;OP CODE FIELD USED?
	JRST	[EXCH AC0,-1(PP);YES, GET STORED CODE
		TLNE AC0,777000	;OP CODE FIELD BEEN SET?
		TRO ER,ERRQ	;YES, MOST LIKELY AN ERROR
		EXCH AC0,-1(PP)
		JRST	.+1]	;RETURN TO ADD >
	ADDM	AC0,-1(PP)	;MERGE WITH PREVIOUS VALUE
	ADDM	RC,-2(PP)
	CAIE	C,11		;")"?
	JRST	ERRAX		;NO, FLAG ERROR
				;YES, BYPASS PARENTHESIS
BYPASS:
BYPAS1:	PUSHJ	PP,GETCHR
BYPAS2:	JUMPE	C,.-1		;SKIP TRAILING BLANKS
	POPJ	PP,		;EXIT

IFE IIISW,<
OP2A1:	EXCH	RC,-2(PP)	;GET STORED CODE
	TLNN	RC,-1		;OK IF ALL ZERO
	JRST	OP2A2		;OK SO RETURN
	TLC	RC,-1		;CHANGE ALL ONES TO ZEROS
	TLCE	RC,-1		;OK IF ALL ONES
	TRO	ER,ERRQ		;OTHERWISE A "Q" ERROR
OP2A2:	EXCH	RC,-2(PP)	;GET RC,BACK
	POPJ	PP,		;AND RETURN>


EXPRES:	HRLZ	AC0,RX		;FUDGE FOR OCT0

OCT0:	PUSH	PP,RX
	HLR	RX,AC0
OCT1:	PUSHJ	PP,EVALEX	;EVALUATE
	PUSHJ	PP,STOW		;STOW CODE
	JUMPCM	OCT1
	POP	PP,RX		;YES, RESTORE RADIX
	POPJ	PP,		;EXIT
SIXB10:	MOVSI	RC,(POINT 6,AC0)	;SET UP POINTER
	MOVEI	AC0,0		;CLEAR WORD

SIXB20:	PUSHJ	PP,CHARL	;GET NEXT CHARACTER
	CAMN	C,SX		;IS THIS PRESET DELIMITER?
	JRST	ASC60		;YES
	CAIL C,"A"+40
	CAILE C,"Z"+40
	JRST	.+2
	TRZA	C,100		;CONVERT LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIXBIT
	JUMPL	C,ASC55		;TEST FOR INVALID CHARACTER
	IDPB	C,RC		;NO, DEPOSIT THE BYTE
	TLNE	RC,770000	;IS THE WORD FULL?
	JRST	SIXB20		;NO, GET NEXT CHARACTER
	PUSHJ	PP,STOWZ	;YES, STORE
	JRST	SIXB10		;GET NEXT WORD
ASCII0:	HLLZ	SDEL,AC0	;STORE ASCII/ASCIZ FLAG
ASC10:	PUSHJ	PP,CHARL	;GET FIRST NON-BLANK
	CAIE	C," "
	CAIN	C,HT
	JRST	ASC10
	CAIG C,CR		;CHECK FOR CRRET AS DELIM
	CAIGE C,LF
	SKIPA	SX,SEQNO2
	JRST ERRAX
	MOVEM SX,TXTSEQ		;SAVE SEQ AND PAGE
	MOVE SX,PAGENO
	MOVEM SX,TXTPG
	SETOM INTXT
	MOVE	SX,C		;SAVE FOR COMPARISON
	JUMPG	SDEL,SIXB10	;BRANCH IF SIXBIT

ASC20:	MOVSI	RC,(POINT 7,AC0)	;SET UP POINTER
	TLNE	SDEL,200000	;THIS BIT (AND BIT0) IN FOR COMMENT
	MOVSI RC,440000		;SO NOTHING WILL BE DEPOSITED
IFE IIISW,<MOVEI AC0,0		;CLEAR WORD>
IFN IIISW,<TLNE	SDEL,100000	;ASCID?
	TLZA	SDEL,400000	;YES, ZERO ASCIZ BIT
	TDZA	AC0,AC0		;NO, ZERO WORD
	MOVE	AC0,[BYTE (7) 10,10,10,10,10 (1) 1]	;YES, A WORD FULL OF BACKSPACES>
ASC30:	PUSHJ	PP,CHARL	;GET ASCII CHARACTER AND LIST
	CAMN	C,SX		;TEST FOR DELIMITER
	JRST	ASC50		;FOUND
	IDPB	C,RC		;DEPOSIT BYTE
	TLNE	RC,760000	;HAVE WE FINISHED WORD?
	JRST	ASC30		;NO,GET NEXT CHARACTER
	PUSHJ	PP,STOWZ	;YES, STOW IT
	JRST	ASC20		;GET NEXT WORD

ASC55:	TDZA	CS,CS		;ZERO CS IN CASE NESTED
ASC50:	TDZA	RC,SDEL		;TEST FOR ASCIIZ
	TROA	ER,ERRA		;SIXBIT ERROR EXIT
ASC60:	PUSHJ	PP,BYPAS1	;POLISH OFF TERMINATOR
	SETZM INTXT	;WE ARE OUT OF IT
IFN IIISW,<TLNN	SDEL,100000	;NO EXTRA WORDS FOR ASCID>
	ANDCM	RC,STPX		;STORE AT LEAST ONE WORD
	TLNN SDEL,200000	;GET OUT WITHOUT STORING
	JUMPGE	RC,STOWZ	;STOW
	POPJ	PP,		;ASCII, NO BYTES STORED, SO EXIT
POINT0:
	PUSH	PP,RC		;STACK REGISTERS
	PUSH	PP,AC0
	PUSHJ	PP,EVAL10	;EVALUATE RADIX 10
	DPB	AC0,[POINT 6,0(PP),11]	;STORE BYTE SIZE
	JUMPNC	POINT2
	PUSHJ	PP,EVALEX	;NO, GET ADDRESS
	PUSHJ	PP,EVADR	;EVALUATE STANDARD ADDRESS
	JUMPNC	POINT2
	PUSHJ	PP,EVAL10	;EVALUATE RADIX 10
	TLNE	IO,NUMSW	;IF NUMERIC
	TDCA	AC0,[-1]	;POSITION=D35-RHB
POINT2:	MOVEI	AC0,0		;OTHERWISE SET TO D36
	ADDI	AC0,^D36
	LSH	AC0,^D30
	ADDM	AC0,0(PP)	;UPDATE VALUE
	JRST	OP3
XWD0:
	PUSH	PP,RC
	PUSH	PP,AC0		;STORE ZERO ON STACK
	PUSHJ	PP,EVALEX	;EVALUATE EXPRESSION
	JUMPNC	OP2
XWD5:	SKIPN	(PP)		;ANY CODE YET?
	JRST	XWD10		;NO,USE VALUE IN AC0
	JUMPE	AC0,.+2		;ANYTHING IN AC0?
	TRO	ER,ERRQ		;YES,FLAG "Q"ERROR
	MOVE	AC0,(PP)	;USE PREVIOUS VALUE
	MOVE	RC,-1(PP)	;AND RELOCATION
XWD10:	HRLZM	AC0,0(PP)	;SET LEFT HALF
	HRLZM	RC,-1(PP)
	MOVSS EXTPNT	;WFW
	JRST	OP1A		;EXIT THROUGH OP

IOWD0:	PUSHJ	PP,EVALXQ	;EVALUATE AND TEST FOR EXTERNAL
	CAIE	C,14		;","?
	JRST	[SKIPN	AC0	;IF NZERO AND NO "," SEEN
		TRO ER,ERRQ	;TREAT AS Q ERROR
		SOJA AC0,STOW]	;NO, TREAT AS RIGHT HALF
	PUSH	PP,AC0		;YES, STACK LEFT HALF
	PUSHJ	PP,EVALEX	;WFW
	SUBI	AC0,1
	POP	PP,AC1		;RETRIEVE LEFT HALF
	MOVNS	AC1
	HRL	AC0,AC1
	JRST	STOW		;STOW CODE AND EXIT
BYTE0:	PUSHJ	PP,BYPASS	;GET FIRST NON-BLANK
	CAIE	C,10		;"("?
	JRST	ERRAX		;NO, FLAG ERROR AND EXIT
	PUSH	PP,RC
	PUSH	PP,AC0		;INITIALIZE STACK TO ZERO
	MOVSI	ARG,(POINT -1,(PP))

BYTE1:	PUSH	PP,ARG
	PUSHJ	PP,EVAL10	;EVALUATE RADIX 10
	POP	PP,ARG
	CAIG	AC0,^D36	;TEST SIZE
	JUMPGE	AC0,.+2
	TRO	ER,ERRA
	DPB	AC0,[POINT 6,ARG,11]	;STORE BYTE SIZE

BYTE2:	IBP	ARG		;INCREMENT BYTE
	TRZN	ARG,-1		;OVERFLOW?
	JRST	BYTE3		;NO
	SETZB	AC0,RC		;YES
	EXCH	AC0,0(PP)	;GET CURRENT VALUES
	EXCH	RC,-1(PP)	;AND STACK ZEROS
	PUSHJ	PP,STOW		;STOW FULL WORD

BYTE3:	PUSH	PP,ARG
	PUSHJ	PP,EVALEX	;COMPUTE NEXT BYTE
	POP	PP,ARG
	DPB	AC0,ARG		;STORE BYTE
	HLLO	AC0,ARG
	DPB	RC,AC0		;STORE RELOCATION

	JUMPCM	BYTE2
	CAIN	C,10		;"("?
	JRST	BYTE1		;YES, GET NEW BYTE SIZE
	JRST	OP3		;NO, EXIT
RADX50:	PUSHJ	PP,EVALEX	;EVALUATE CODE
	JUMPN	RC,ERRAX		;ERROR IF NOT ABSOLUTE
	MOVE	ARG,AC0
	JUMPNC	ERRAX
	PUSHJ	PP,GETSYM	;YES, GET SYMBOL
	TRZ	ER,ERRA		;CLEAR ERROR
	PUSHJ	PP,SQOZE	;SQUOZE SIXBIT AND ADD CODE
	JRST	STOW		;STOW CODE AND EXIT


SQOZE:	MOVE	AC1+1,AC0	;PUT SIXBIT IN AC1+1
	MOVEI	AC0,0		;CLEAR RESULT
SQOZ1:	MOVEI	AC1,0
	LSHC	AC1,6		;PUT 6-BIT CHARACTER IN AC1
	LDB	AC1,[POINT 6,CSTAT(AC1),23]	;CONVERT TO RADIX50
	IMULI	AC0,50		;MULTIPLY PREVIOUS RESULT
	ADD	AC0,AC1		;ADD NEW CHARACTER
	JUMPN	AC1+1,SQOZ1	;TEST FOR END
	LSH	ARG,^D30	;LEFT-JUSTIFY CODE
	IOR	AC0,ARG		;MERGE WITH RESULT
	POPJ	PP,

; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY

; HERE IF PRGEND (PASS 1)
PSEND0:	TLO	IO,MFLSW	;PSEND SEEN
	PUSHJ	PP,END0		;AS IF END STATEMENT
	HLLZS	IO		;CLEAR ER(RH)
	SETZM	ERRCNT		;CLEAR ERROR COUNT FOR EACH PROG.
	JUMP2	PSEND2		;DIFFERENT ON PASS2
IFN UNIVR,<SKIPE	UNIVSN		;SEEN A UNIVERSAL
	PUSHJ	PP,UNISYM	;YES, STORE SYMBOLS>
	PUSHJ	PP,PSEND4	;SAVE SYMBOLS, POINTERS AND TITLE
	TLZ	IO,IOTLSN	;CLEAR TITLE SEEN FLAG
PSEND1:	TLZ	IO,MFLSW	 ;FOR NEXT FILE
IFN UNIVR,<SETZM	UNISCH		;CLEAR UNIVERSAL SEARCH TABLE
	MOVE	AC0,[UNISCH,,UNISCH+1]
	BLT	AC0,UNISCH+.UNIV-1
	PUSHJ	PP,OUTFF	;RESET PAGE COUNT>
	MOVSI	AC0,1		;SET SO RELOC 0 WORKS
	JRST	LOC10		;FOR RELOC 0

; HERE IF PRGEND (PASS 2)
PSEND2:	SETZM	SBUF		;SO SUBTTL IS NOT WRONG
	PUSHJ	PP,PSEND5	;PUT TITLE BACK
	PUSHJ	PP,PSEND1	;COMMON  CODE
	JRST	PASS20		;OUTPUT THE ENTRIES

; HERE IF END (PASS 1)
PSEND3:	PUSHJ	PP,PSEND4	;SAVE LAST PROGRAM 
	HLRS	PRGPTR		;REINITIALIZE POINTER
	PUSHJ	PP,PSEND5	;READ BACK FIRST PROGRAM
	JRST	PASS20
;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS
	XTRA==4			;NUMBER OF OTHER LOCATIONS TO SAVE

PSEND4:	MOVE	V,FREE		;GET  NEXT FREE LOCATION
	ADDI	V,LENGTH+.TBUF/5+XTRA
	CAML	V,SYMBOL	;WILL WORST CASE FIT?
	PUSHJ	PP,XCEED	;NO, EXPAND
	MOVS	V,FREE
	HRR	V,PRGPTR	;LAST PRGEND BLOCK
	HLRM	V,(V)		;LINK THIS BLOCK
	SKIPN	PRGPTR		;IF FIRST TIME
	HLLZM	V,PRGPTR	;SET LINK TO START OF CHAIN
	HLRM	V,PRGPTR	;POINTER TO IT
	SETZM	@FREE		;CLEAR LINK WORD
	AOS	FREE		;THIS LOCATION USED NOW
	MOVS	AC0,SYMBOL	;BOTTOM OF SYMBOL TABLE
	HRR	AC0,FREE	;FREE SPACE
	MOVE	V,@SYMBOL	;GET NUMBER OF SYMBOLS
	ASH	V,1		;TWO WORDS PER SYMBOL
	ADDI	V,1		;ONE MORE FOR COUNT
	ADDB	V,FREE		;END OF TABLE WHEN MOVED
	BLT	AC0,(V)		;MOVE TABLE
	HRRZ	AC0,JOBREL	;TOP OF CORE
	SUBI	AC0,1
	MOVEM	AC0,SYMTOP	;FOR NEXT SYMBOL TABLE
	SUBI	AC0,LENGTH	;LENGTH OF INITIAL SYMBOLS
	MOVEM	AC0,SYMBOL	;SET POINTER TO COUNT OF SYMBOLS
	HRLI	AC0,SYMNUM	;BLT POINTER
	BLT	AC0,@SYMTOP	;SET UP INITIAL SYMBOL TABLE
	PUSHJ	PP,SRCHI	;SET UP SEARCH POINTER
	MOVEI	AC0,.TBUF	;MAX NUMBER OF CHARS. IN TITLE
	SUB	AC0,TCNT	;ACTUAL NUMBER
	IDIVI	AC0,5		;NUMBER OF WORDS
	SKIPE	AC1		;REMAINDER?
	ADDI	AC0,1		;YES
	MOVEM	AC0,@FREE	;STORE COUNT
	AOS	FREE		;THIS LOCATION USED NOW
	EXCH	AC0,FREE	;SET UP AC0 FOR BLT
	ADDM	AC0,FREE	;WILL BE AFTER TITLE MOVES
	HRLI	AC0,TBUF	;BLT POINTER
	BLT	AC0,@FREE	;MOVE TITLE
	MOVE	AC2,LITHDX	;POINTER TO LIT INFO.
	MOVE	AC0,-1(AC2)	;SIZE OF PASS1 LOCO
	PUSHJ	PP,STORIT	;SAVE IT IN SYMBOL TABLE
	MOVE	AC2,VARHDX	;SAME FOR VARS
	MOVE	AC0,-1(AC2)
	PUSHJ	PP,STORIT
IFN RENTSW,<
	MOVE	AC0,HISNSW	;GET TWOSEG/HISEG FLAG
	HRR	AC0,HIGH1	;AND PASS1 BREAK
	PUSHJ	PP,STORIT
	JUMPGE	AC0,PSEND6	;NOT TWOSEG
	MOVE	AC0,SVTYP3	;HIGH SEGMENT OFFSET
	PUSHJ	PP,STORIT	;SAVE IT ALSO>
PSEND6:	MOVE	AC0,FREE	;GET NEXT FREE LOCATION
	SUBI	AC0,1		;LAST ONE USED
	HRRZ	V,PRGPTR	;POINTER TO START OF DATA BLOCK
	HRLM	AC0,(V)		;LINK TO END OF BLOCK
	POPJ	PP,		;RETURN

PSENDX:	PUSHJ	PP,XCEED	;NEED TO EXPAND CORE FIRST
PSEND5:	HRRZ	AC0,JOBREL	;GET TOP OF CORE
	SUBI	AC0,1
	MOVEM	AC0,SYMTOP	;TOP OF NEW SYMBOL TABLE
	HRRZ	V,PRGPTR	;ADDRESS OF THIS BLOCK
	JUMPE	V,PSNDER	;ERROR LINK NOT SET UP
	MOVE	AC1,(V)		;NEXT LINK
	MOVE	V,1(V)		;GET ITS SYMBOL COUNT
	ASH	V,1		;NUMBER OF WORDS
	ADDI	V,1		;PLUS ONE FOR COUNT
	SUBI	AC0,(V)		;START OF NEW SYMBOL TABLE
	CAMG	AC0,FREE	;WILL IT FIT
	JRST	PSENDX		;NO, NEED TO EXPAND AND RESET AC0
	ADD	V,PRGPTR	;POINT TO END OF SYMBOL TABLE
	MOVEI	V,1(V)		;THEN TO BEG OF TITLE
	MOVEM	AC0,SYMBOL	;BOTTOM OF NEW TABLE
	HRL	AC0,PRGPTR	;ADDRESS OF FIRST WORD OF BLOCK
	ADD	AC0,[1,,0]	;MAKE BLT POINTER
	HRRM	AC1,PRGPTR	;POINT TO NEXT BLOCK
	BLT	AC0,@SYMTOP	;MOVE TABLE
	PUSHJ	PP,SRCHI	;SET UP POINTER
	MOVE	AC1,(V)		;NUMBER OF WORDS OF TITLE
	MOVEI	AC0,1(V)	;START OF STORED TITLE
	ADD	V,AC1		;INCREMENT PAST TITLE
	ADDI	AC1,TBUF-1	;END OF TITLE
	HRLI	AC0,TBUF	;WHERE TO PUT IT
	MOVSS	AC0		;BLT POINTER
	BLT	AC0,(AC1)	;MOVE TITLE
	TLO	IO,IOTLSN	;SET AS IF TITLE SEEN
	MOVE	AC2,LITHDX	;INVERSE OF ABOVE
	PUSHJ	PP,GETIT
	MOVEM	AC0,-1(AC2)
	MOVE	AC2,VARHDX	;SAME FOR VARS
	PUSHJ	PP,GETIT
	MOVEM	AC0,-1(AC2)
IFN RENTSW,<
	PUSHJ	PP,GETIT	;GET TWO HALF WORDS
	HRRZM	AC0,HIGH1	;PASS1 BREAK
	HLLEM	AC0,HISNSW	;TWOSEG/HISEG FLAG
	JUMPGE	AC0,CPOPJ	;NOT TWOSEG
	PUSHJ	PP,GETIT
	MOVEM	AC0,SVTYP3	;BLOCK 3 WORD>
	POPJ	PP,

STORIT:	MOVEM	AC0,@FREE	;STORE IT IN DATA BLOCK
	AOS	FREE		;ADVANCE POINTER
	POPJ	PP,

GETIT:	MOVE	AC0,1(V)	;FILL AC0 OUT OF PRGEND BLOCK
	AOJA	V,CPOPJ		;INCREMENT AND RETURN

PSNDER:	HRROI	RC,[SIXBIT	/PRGEND ERROR @/]
	JRST	ERRFIN
;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS

IFN UNIVR,<
UNIV0:	JUMP2	TITLE0		;DO IT ALL ON PASS 1
	HRRZ	SX,UNIVNO	;GET NUMBER OF UNIVERSALS SEEN
	CAIL	SX,.UNIV	;ALLOW ONE MORE?
	JRST	UNVERR		;NO, GIVE FATAL ERROR
	AOS	UNIVNO		;ONE MORE NOW
	SETOM	UNIVSN		;AND SET SEEN A UNIVERSAL
	JRST	TITLE0		;CONTINUE AS IF TITLE


ADDUNV:	PUSH	PP,RC		;AN AC TO USE
	PUSHJ	PP,NOUT		;CONVERT TO SIXBIT
	HRRZ	RC,UNIVNO	;GET ENTRY INDEX
	MOVEM	AC0,UNITBL(RC)	;STORE SIXBIT NAME IN TABLE
	HRRZS	UNIVSN		;ONLY DO IT ONCE
	POP	PP,RC		;RESTORE RC
	POPJ	PP,		;AND RETURN

UNVERR:	HRROI	RC,[SIXBIT /TOO MANY UNIVERSALS@/]
	JRST	ERRFIN

UNISYM:	HRRZ	AC0,FREE	;GET HIGHEST FREE LOCATION
	MOVEM	AC0,JOBFF	;INTO JOBFF
	PUSHJ	PP,SUPRSA	;TURN ON SUPPRESS BIT
	PUSH	PP,SYMBOL	;NEED TO SAVE INCASE PRGEND
	MOVE	AC0,SYMTOP	;TOP OF TABLE
	SUB	AC0,SYMBOL	;GET LENGTH OF TABLE
	HRL	ARG,SYMBOL	;BOTTOM OF TABLE
	HRR	ARG,JOBFF	;WHERE TO GO
	HRRZ	RC,UNIVNO	;GET TABLE INDEX
	HRRM	ARG,SYMBOL	;WILL BE THERE SOON
	HRRZM	ARG,UNIPTR(RC)	;STORE IN CORRESPONDING PLACE
	ADDB	AC0,JOBFF	;WHERE TO END
	HRLM	AC0,UNIPTR(RC)	;SAVE NEW SYMTOP
	BLT	ARG,@JOBFF	;MOVE TABLE
	HRRZM	AC0,UNITOP	;SAVE TOP OF TABLES+1
	CAMLE	AC0,MACSIZ	;IN CASE OVER A K BOUND
	MOVEM	AC0,MACSIZ	;DON'T REDUCE SO FAR NOW
	MOVEM	AC0,FREE	;JUST IN CASE IN MACRO
	MOVE	AC0,SRCHX	;SAVE OLD SEARCH POINTER
	PUSHJ	PP,SRCHI	;GET SEARCH POINTER
	EXCH	AC0,SRCHX
	MOVEM	AC0,UNISHX(RC)	;SAVE IT
	SETZM	UNIVSN		;CLEAR FLAG INCASE PRGEND
	POP	PP,SYMBOL	;RESTORE OLD VALUE
	POPJ	PP,		;RETURN

SERCH0:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	ERRAX		;ERROR IF NOT VALID
	MOVEI	RC,1		;START AT ENTRY ONE
	CAIL	RC,.UNIV	;CHECK FOR CONSISTENCY ERROR
	JRST	SCHERR		;CANNOT FIND THIS ONE
	CAME	AC0,UNITBL(RC)	;LOOK FOR MATCH
	AOJA	RC,.-3		;NOT FOUND YET
	MOVE	AC0,RC		;STORE TABLE ENTRY NUMBER
	MOVEI	RC,1		;START AT ENTRY ONE
	CAIL	RC,.UNIV	;CHECK FOR CONSISTENCY ERROR
	JRST	SCHERR		;SHOULD NEVER HAPPEN!!
	SKIPE	UNISCH(RC)	;LOOK FOR AN EMPTY SLOT
	AOJA	RC,.-3		;NOT FOUND YET
	MOVEM	AC0,UNISCH(RC)	;STORE INDEX IN TABLE
	JUMPCM	SERCH0		;LOOK FOR MORE NAMES
	POPJ	PP,		;FINISHED

SCHERR:	MOVSI	RC,[SIXBIT /CANNOT FIND UNIVERSAL@/]
	JRST	ERRFIN		;NAME IN AC0

;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL
UNIERR:	HRROI	RC,[SIXBIT /UNIVERSAL PROGRAM(S) MUST HAVE SAME OUTPUT SPECIFICATION AS OTHER FILES@/]
	JRST	ERRFIN
>
SUBTTL	MACRO/REPEAT HANDLERS

REPEA0:	PUSHJ	PP,EVALXQ	;EVALUATE REPEAT EXP, EXTERNS ARE ILL.
	JUMPNC	ERRAX

REPEA1:	JUMPLE	AC0,REPZ	;PASS THE EXP., DONT PROCESS
	SOJE	AC0,REPO	;REPEAT ONCE
REPEA2:	PUSHJ	PP,GCHARQ	;GET STARTING "<"
	CAIE	C,"<"
	JRST	REPEA2
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON
	PUSH	MP,REPEXP
	MOVEM	AC0,REPEXP
	PUSH	MP,REPPNT	;STACK PREVIOUS REPEAT POINTER
	MOVEM	ARG,REPPNT	;STORE NEW POINTER
	TDZA	SDEL,SDEL	;YES, INITIALIZE BRACKET COUNT AND SKIP

REPEA4:	PUSHJ	PP,WCHARQ	;WRITE A CHARACTER
	PUSHJ	PP,GCHARQ	;GET A CHARACTER
	CAIN	C,"<"		;"<"?
	AOJA	SDEL,REPEA4	;YES, INCREMENT AND WRITE
	CAIE	C,">"		;">"?
	JRST	REPEA4		;NO, WRITE THE CHARACTER
	SOJGE	SDEL,REPEA4	;YES, WRITE IF NON-NEGATIVE COUNT
	MOVSI	CS,(BYTE (7) 177,3)	;SET "REPEAT" END
	PUSHJ	PP,WWRXE	;WRITE END
	SKIPN	LITLVL		;LITERAL MIGHT END ON LINE
	SKIPE	MACLVL		;IF IN MACRO DARE NOT PROCESS
	JRST	.+3		;REST OF LINE SINCE MACRO MIGHT END ON IT
	PUSHJ	PP,BYPASS	;BYPASS
	PUSHJ	PP,STOUTS	;POLISH OF LINE BEFORE PROCESSING REPEAT
	PUSH	MP,MRP		;STACK PREVIOUS READ POINTER
	PUSH	MP,RCOUNT	;SAVE WORD COUNT
	HRRZ	MRP,REPPNT	;SET UP READ POINTER
	SKIPN	MACLVL		;IF IN MACRO GIVE CR-LF FIRST
	SKIPE	LITLVL		;SAME FOR LITERAL
	JRST	REPEA7
	AOJA	MRP,POPOUT	;BYPASS ARG COUNT

REPEA7:	HRRZ	MRP,REPPNT	;SET UP READ POINTER
	ADDI	MRP,1		;BYPASS ARG COUNT
REPEA8:	MOVEI	C,CR
	JRST	RSW1

REPEND:	SOSL	REPEXP
	JRST	REPEA7
	HRRZ	V,REPPNT	;GET START OF TREE
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	POP	MP,RCOUNT
	POP	MP,MRP
	POP	MP,REPPNT
	POP	MP,REPEXP
	SKIPN	LITLVL		;IF IN LITERAL OR
	SKIPE	MACLVL		;IF IN MACRO
	JRST	RSW0		;FINISH OF LINE NOW
	JRST	REPEA8

REPZ:	MOVE SDEL,SEQNO2	;SAVE IN CASE OF END OF FILE
	MOVEM SDEL,REPSEQ
	MOVE SDEL,PAGENO
	MOVEM SDEL,REPPG
	SETOM INREP
	MOVEI SDEL,0	;SET COUNT
REPZ1:	PUSHJ	PP,GCHAR	;GET NEXT CHARACTER
	CAIN	C,"<"		;"<"?
	AOJA	SDEL,REPZ1	;YES, INCREMENT COUNT
	CAIN	C,">"		;">"?
	SOJLE	SDEL,REPZ2	;YES, EXIT IF MATCHING
	JRST	REPZ1		;NO, RECYCLE
REPZ2:	SETZM	INREP	;FLAG OUT OF IT
	SETZM	INCND	;AND CONDITIONAL ALSO
	JRST	STMNT	;AND EXIT

REPO:	PUSHJ	PP,GCHAR	;GET "<"
	CAIE	C,"<"
	JRST	REPO
	SKIPE	RPOLVL		;ARE WE NESTED?
	AOS	RPOLVL		;YES, DECREMENT CURRENT
	PUSH	MP,RPOLVL
	SETOM	RPOLVL
	JRST	STMNT

REPO1:	CAIN	C,"<"
	SOS	RPOLVL
	CAIN	C,">"
	AOSE	RPOLVL
	JRST	RSW2
	POP	MP,RPOLVL
	PUSHJ	PP,RSW2
	JRST	RSW0
DEFIN0:	PUSHJ	PP,GETSYM	;GET MACRO NAME
	JRST	ERRAX		;EXIT ON ERROR
	MOVEM	PP,PPTMP1	;SAVE POINTER
	MOVEM	AC0,PPTMP2	;SAVE NAME
	TLO	IO,IORPTC
	MOVE SX,SEQNO2	;SAVE IN CASE OF EOF
	MOVEM SX,DEFSEQ
	MOVE SX,PAGENO
	MOVEM SX,DEFPG
	SETOM INDEF	;AND FLAG IN DEFINE
	SYN	.TEMP,COMSW	;SAVE SPACE
	SETZB	SX,COMSW	;SET ARGUMENT AND REFERENCE COUNT AND COMMENT SWITCH
DEF02:	PUSHJ	PP,GCHAR	;SEARCH FOR "(" OR "<"
	CAIG	C,FF		;SEARCH FOR END OF LINE
	CAIGE	C,LF		;LF,VT, OR FF
	JRST	.+2		;WASN'T ANY OF THEM
	SETZM	COMSW		;RESET COMMENT SWITCH
	CAIN	C,";"		;COMMENT?
	SETOM	COMSW		;YES, SET COMMENT SWITCH
	SKIPE	COMSW		;INSIDE A COMMENT?
	JRST	DEF02		;YES, IGNORE CHARACTER
	CAIN	C,"<"		;"<"?
	JRST	DEF20		;YES
	CAIE	C,"("		;"("?
	JRST	DEF02		;NO
DEF10:	PUSHJ	PP,GETSYM	;YES, GET DUMMY SYMBOL
	TRO	ER,ERRA		;FLAG ERROR
	ADDI	SX,1		;INCREMENT ARG COUNT
	PUSH	PP,AC0		;STACK IT
	CAIN	C,'<'		;A DEFAULT ARGUMENT COMING UP?
	JRST	DEF80		;YES, STORE IT AWAY
	CAIE	C,11		;")"?
	JRST	DEF10		;NO, GET NEXT DUMMY SYMBOL
DEF12:	PUSHJ	PP,GCHAR
	CAIE	C,"<"		;"<"?
	JRST	DEF12		;NO
DEF20:	PUSH	PP,[0]		;YES, MARK THE LIST
	LSH	SX,9		;SHIFT ARG COUNT
	AOS	ARG,SX
	PUSHJ	PP,SKELI	;INITIALIZE MACRO SKELETON
	MOVE	AC0,PPTMP2	;GET NAME
	TLO IO,DEFCRS
	PUSHJ	PP,MSRCH	;SEARCH THE TABLE
	JRST	DEF24		;NOT FOUND
	TLNN	ARG,MACF	;FOUND, IS IT A MACRO?
	TROA	ER,ERRX		;NO, FLAG ERROR AND SKIP
	PUSHJ	PP,REFDEC	;YES, DECREMENT THE REFERENCE
DEF24:	HRRZ	V,WWRXX		;GET START OF TREE
	SKIPN	.TEMP		;ANY DEFAULT ARGUMENTS TO TAKE CARE OF?
	JRST	DEF25		;NO
	HRRZ	C,1(V)		;GET SHIFTED ARG COUNT
	LSH	C,-9		;GET ARG COUNT BACK
	ADDI	C,1		;ONE MORE FOR TERMINAL ZERO
	ADD	C,.TEMP		;NUMBER OF ITEMS IN STACK
	HRLS	C		;MAKE XWD
	SUB	PP,C		;BACK UP STACK
	MOVE	SDEL,.TEMP	;NUMBER OF WORDS NEEDED
	ADDB	SDEL,FREE	;FROM FREE CORE
	CAML	SDEL,SYMBOL	;MORE CORE NEEDED
	PUSHJ	PP,XCEEDS	;YES, TRY TO GET IT
	SUB	SDEL,.TEMP	;FORM POINTER
	HRLM	SDEL,1(V)	;STORE IT WITH ARG COUNT IN MACRO
	SUBI	SDEL,1		;TO USE FOR PUSHING POINTER INTO STORAGE
	MOVEI	C,1(PP)		;POINT TO START OF STACK
DEF26:	MOVE	ARG,(C)		;GET AN ITEM OFF STACK
	TLNN	ARG,-40		;A POINTER?
	JUMPN	ARG,[PUSH SDEL,ARG	;YES, STORE IT
		AOJA	C,DEF26]	;GET NEXT
	PUSH	PP,ARG		;RESTACK ARGUMENT
	SKIPE	ARG		;FINISHED IF ZERO
	AOJA	C,DEF26	;GET NEXT
	PUSH	SDEL,ARG	;STORE ZERO IN DEFAULT LIST ALSO
DEF25:	MOVSI	ARG,MACF
	MOVEM	PP,PPTMP2	;STORE TEMP STORAGE POINTER
	PUSHJ	PP,INSERT	;INSERT/UPDATE
	TLZ IO,DEFCRS	;JUST IN CASE
	SETZM	ARGF		;NO ARGUMENT SEEN
	SETZM	SQFLG		;AND NO ' SEEN
	TDZA	SDEL,SDEL	;CLEAR BRACKET COUNT
DEF30:	PUSHJ	PP,WCHAR	;WRITE CHARACTER
DEF31:	PUSHJ	PP,GCHAR	;GET A CHARACTER
DEF32:	MOVE	CS,C		;GET A COPY
	CAIN	C,";"		;IS IT A COMMENT
	JRST	CPEEK		;YES CHECK FOR ;;
DEF33:	CAIG CS,"Z"+40		;CONVERT LOWER CASE
	CAIGE CS,"A"+40
	JRST	.+2
	SUBI CS,40
	CAIGE CS,40		;TEST FOR CONTROL CHAR.
	JRST	[SKIPN	SQFLG	;HAS SINGLE QUOTE BEEN SEEN?
		JRST	DEF30	;NO, OUTPUT THIS CHAR.
		PUSH	PP,C	;YES, SAVE CURRENT CHAR
		MOVEI	C,47	;SET UP QUOTE
		PUSHJ	PP,WCHAR;WRITE IT
		POP	PP,C	;GET BACK CURRENT CHAR.
		SETZM	SQFLG	;RESET FLAG
		JRST	DEF30]	;AND CONTINUE 
	CAILE CS,77+40
	JRST	DEF30		;TEST FOR SPECIAL
	MOVE	CS,CSTAT-40(CS)	;GET STATUS BITS
	TLNE	CS,6		;ALPHA-NUMERIC?
	JRST	DEF40		;YES
	SKIPN	SQFLG		;WAS A ' SEEN?
	JRST	DEF36		;NO, PROCESH
	PUSH	PP,C		;YES, SAVE CURRENT CHARACTER
	MOVEI	C,47		;AND PUT IN A '
	PUSHJ	PP,WCHAR	;...
	POP	PP,C		;RESTORE CURRENT CHARACTER
	SETZM	SQFLG		;AND RESET FLAG
DEF36:	CAIE	C,47		;IS THIS A '?
	JRST	DEF35		;NOPE
	SKIPN	ARGF		;YES, WAS LAST THING SEEN AN ARG?
	SETOM	SQFLG		;IF NOT, SET SNGL QUOT FLAG
	SETZM	ARGF		;BUT NOT ARGUMENT IN ANY CASE
	JRST	DEF31		;GO GET NEXT CHARACTER
DEF35:	SETZM	ARGF		;THIS IS NOT AN ARGUMENT
	CAIN	C,"<"		;"<"?
	AOJA	SDEL,DEF30	;YES, INCREMENT COUNT AND WRITE
	CAIN	C,">"		;">"?
	SOJL	SDEL,DEF70	;YES, TEST FOR END
	JRST	DEF30		;NO, WRITE IT

CPEEK:	TLNN	IO,IOPALL	;IF LALL IS ON
	JRST	DEF33		;JUST RETURN
	PUSHJ	PP,PEEK		;LOOK AT NEXT CHAR.
	CAIN	C,";"		;IS IT ;;?
	JRST	CPEEK1		;YES
	MOVE	C,CS		;RESTORE C
	JRST	DEF33		;AND RETURN

CPEEK1:	PUSHJ	PP,GCHAR	;GET THE CHAR.
	CAIE	C,">"		;RETURN IF END OF MACRO
	CAIG	C,CR		;IS CHAR ONE OF
	CAIGE	C,LF		;LF,VT,FF,CR
	JRST	CPEEK1		;NO,SO GET NEXT CHAR.
	JRST	DEF32		;YES,RETURN AND STORE
DEF40:	MOVEI	AC0,0		;CLEAR ATOM
	MOVSI	AC1,(POINT 6,AC0)	;SET POINTER
DEF42:	PUSH	PP,C		;STACK CHARACTER
	TLNE	AC1,770000	;HAVE WE STORED 6?
	IDPB	CS,AC1		;NO, STORE IN ATOM
	PUSHJ	PP,GCHAR	;GET NEXT CHARACTER
	MOVE	CS,C
	CAIG CS,"Z"+40
	CAIGE CS,"A"+40
	JRST	.+2
	SUBI CS,40		;CONVERT LOWER TO UPPER
	CAIL CS,40
	CAILE CS,77+40
	JRST	DEF44		;TEST SPECIAL
	MOVE	CS,CSTAT-40(CS)	;GET STATUS
	TLNE	CS,6		;ALPHA-NUMERIC?
	JRST	DEF42		;YES, GET ANOTHER
DEF44:	PUSH	PP,[0]		;NO, MARK THE LIST
	MOVE	SX,PPTMP1	;GET POINTER TO TOP

DEF46:	SKIPN	1(SX)		;END OF LIST?
	JRST	DEF50		;YES
	CAME	AC0,1(SX)	;NO, DO THEY COMPARE?
	AOJA	SX,DEF46	;NO, TRY AGAIN
	SUB	SX,PPTMP1	;YES, GET DUMMY SYMBOL NUMBER
	LSH SX,4
	MOVSI	CS,<(BYTE (7) 177,101)>(SX)	;SET ESCAPE CODE MACEND
	LSH	AC0,-^D30
	CAIN	AC0,5		;"%"?
	TLO	CS,1000		;YES, SET CRESYM FLAG
	PUSHJ	PP,WWORD	;WRITE THE WORD
	SETOM ARGF		;SET ARGUMENT SEEN FLAG
	SETZM SQFLG		;AND IGNORE ANY ' WAITING TO GET INTO STRING
DEF48:	MOVE	PP,PPTMP2	;RESET PUSHDOWN POINTER
	TLO	IO,IORPTC	;ECHO LAST CHARACTER
	JRST	DEF31		;RECYCLE

DEF50:
	SKIPN	SQFLG		;HAVE WE SEEN A '?
	JRST	DEF51		;NOPE
	MOVEI	C,47		;YES, PUT IT IN
	PUSHJ	PP,WCHAR	;...
	SETZM	SQFLG		;AND CLEAR FLAG
DEF51:	MOVE	C,2(SX)		;GET CHARACTER
	JUMPE	C,DEF48		;CLEAN UP IF END
	PUSHJ	PP,WCHAR	;WRITE THE CHARACTER
	AOJA	SX,DEF51	;GET NEXT

DEF70:	MOVE	PP,PPTMP1	;RESTORE PUSHDOWN POINTER
	MOVSI	CS,(BYTE (7) 177,1)
	PUSHJ	PP,WWRXE	;WRITE END
	SETZM INDEF	;OUT OF IT
	JRST	BYPASS
; HERE TO STORE DEFAULT ARGUMENTS

DEF80:	AOS	.TEMP		;COUNT ONE MORE
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON
	HRL	V,SX		;SYMBOL NUMBER
	PUSH	PP,V		;STORE POINTER
	TDZA	SDEL,SDEL	;ZERO BRACKET COUNT
DEF81:	PUSHJ	PP,WCHARQ	;WRITE A CHARACTER
	PUSHJ	PP,GCHARQ	;GET A CHARACTER
	CAIN	C,"<"		;ANOTHER "<"?
	AOJA	SDEL,DEF81	;YES, INCREMENT AND WRITE
	CAIE	C,">"		;CLOSING ANGLE?
	JRST	DEF81		;NO, JUST WRITE THE CHAR.
	SOJGE	SDEL,DEF81	;YES, WRITE IF NOT END
	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END OF DUMMY ARGUMENT
	PUSHJ	PP,GCHAR	;READ AT NEXT CHAR.
	CAIE	C,")"		;END OF ARGUMENT LIST?
	JRST	DEF10		;NO, GET NEXT SYMBOL
	JRST	DEF12		;YES, LOOK FOR "<"
SUBTTL	MACRO CALL PROCESSOR
CALLM:	SKIPGE	MACENL		;ARE WE TRYING TO RE-ENTER?
	JRST	ERRAX		;YES, BOMB OUT WITH ERROR
	HRROS	MACENL		;FLAG "CALLM IN PROGRESS"
	EXCH	MP,RP
	PUSH	MP,V		;STACK FOR REFDEC
	EXCH	MP,RP
	MOVEM	AC0,CALNAM	;SAVE MACRO NAME INCASE OF ERROR
	MOVE SDEL,SEQNO2	;SAVE IN CASE OF EOF
	MOVEM SDEL,CALSEQ
	MOVE SDEL,PAGENO
	MOVEM SDEL,CALPG
	ADDI	V,1		;POINT TO DUMMY SYMBOL COUNT
	AOS	SDEL,0(V)	;INCREMENT ARG COUNT
	HLLZM	SDEL,.TEMP	;DEFAULT ARG POINTER IF NON-ZERO
	LSHC	SDEL,-^D<9+36>	;ZERO SDEL, GET ARG COUNT IN SX
	ANDI	SX,777		;MASK
	SKIPE	.TEMP		;IF AT LEAST ONE DEFAULT ARG
	HRRM	SX,.TEMP	;STORE COUNT OF ARGS
	PUSH	PP,V		;STACK FOR MRP
	PUSH	PP,RP		;STACK FOR MACPNT
	JUMPE	SX,MAC20	;TEST FOR NO ARGS
	PUSHJ	PP,CHARAC
	CAIE	C,"("		;"("
	TROA	SDEL,-1		;NO, FUDGE PAREN COUNT AND SKIP

MAC10:	PUSHJ	PP,GCHAR	;GET A CHARACTER, LOOK FOR AN ARG
	CAIG C,CR
	CAIGE C,LF
	CAIN	C,";"		;";"?
	JRST	MAC21		;YES, END OF ARGUMENT STRING

	PUSHJ	PP,SKELI1	;NO, INITIALIZE SKELETON
	CAIN	C,"<"		;"<"?
	JRST	MAC30		;YES, PROCESS AS SPECIAL
	CAIE C,176
	CAIN	C,134		;"\"
	JRST	MAC40		;YES, PROCESS SYMBOL

MAC14:	CAIN	C,","		;","?
	JRST	MAC16		;YES; NULL SYMBOL
	CAIN	C,"("		;"("?
	ADDI	SDEL,1		;YES, INCREMENT COUNT
	CAIN	C,")"		;")"?
	SOJL	SDEL,MAC16	;YES, TEST FOR END
	PUSHJ	PP,WCHAR	;WRITE INTO SKELETON
MAC14A:	PUSHJ	PP,CHARAC	;GET NEXT CHARACTER
	CAIG C,CR
	CAIGE C,LF
	JRST	.+2
	JRST	MAC15		;TEST FOR END OF LINE
	CAIE	C,";"		;";"?
	JRST	MAC14		;YES, END OF LINE

MAC15:	TLO	IO,IORPTC
MAC16:	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END
	EXCH	MP,RP
	PUSH	MP,WWRXX
	EXCH	MP,RP
	SOJLE	SX,MAC20	;BRANCH IF NO MORE ARGS
	JUMPGE	SDEL,MAC10	;HAVEN'T SEEN TERMINAL ")" YET
MAC20:	TLZN	IO,IORPTC
	PUSHJ	PP,CHARAC
MAC21:	EXCH	MP,RP
	JUMPE	SX,MAC21B	;NO MISSING ARGS
MAC21A:	PUSH	MP,[-1]		;FILL IN MISSING ARGS
	SKIPN	.TEMP		;ANY DEFAULT ARGS?
	JRST	MAC21C		;NO
	HRRZ	C,.TEMP		;GET ARG COUNT
	SUBI	C,-1(SX)	;ACCOUNT FOR THOSE GIVEN
	HRLZS	C		;PUT IN LEFT HALF
	HLRZ	SDEL,.TEMP	;ADDRESS OF TABLE
MAC21D:	SKIPN	(SDEL)		;END OF LIST
	JRST	MAC21C		;YES
	XOR	C,(SDEL)	;TEST FOR CORRECT ARG
	TLNN	C,-1		;WAS IT?
	JRST	MAC21E		;YES
	XOR	C,(SDEL)	;BACK THE WAY IT WAS
	AOJA	SDEL,MAC21D	;AND TRY AGAIN

MAC21E:	MOVEM	C,(MP)		;REPLACE -1 WITH TREE POINTER
	AOS	1(C)		;INCREMENT REFERENCE
MAC21C:	SOJG	SX,MAC21A
MAC21B:	PUSH	MP,[0]		;SET TERMINAL
	HRRZ	C,LIMBO
	TLNN	IO,IOSALL	;SUPPRESSING ALL?
	JRST	MAC23		;NO
	JUMPN	MRP,MAC27	;IN MACRO?
	CAIE	C,";"		;NO,IN COMMENT?
	JRST	MAC26		;NO
MAC22:	PUSHJ	PP,CHARAC	;YES,GET IT INTO THE LBUF
	CAIG	C,CR		;LESS THAN CR?
	CAIGE	C,LF		;AND GREATER THAN LF?
	JRST	MAC22		;NO GET ANOTHER
MAC26:	HRLZI	SX,70000	;DECREMENT BYTE POINTER
	ADDB	SX,LBUFP
	JUMPGE	SX,MAC27
	HRLOI	SX,347777
	ADDM	SX,LBUFP
MAC27:	HRLI	C,-1		;SET FLAG
	JRST	MAC25

MAC23:	MOVEI	SX,"^"
	JUMPAD	MAC24		;BRANCH IF ADDRESS FIELD
	CAIN	C,";"		;IF SEMI-COLON
	SKIPE	LITLVL		;AND NOT IN A LITERAL
	JRST	MAC24		;NOT BOTH TRUE
	JUMPN	MRP,MAC24	;OR IN A MACRO
	PUSHJ	PP,STOUT	;LIST COMMENT OR CR-LF
	TLNE	IO,IOPALL	;MACRO EXPANSION SUPPRESSION?
	TLO	IO,IOMAC	;  NO, SET TEMP BIT
	TDOA	C,[-1]		;FLAG LAST CHARACTER
MAC24:	DPB	SX,LBUFP	;SET ^ INTO LINE BUFFER
MAC25:	PUSH	MP,MACPNT
	POP	PP,MACPNT
	PUSH	MP,C
	PUSH	MP,RCOUNT	;STACK WORD COUNT
	PUSH	MP,MRP		;STACK MACRO POINTER
	POP	PP,MRP		;SET NEW READ POINTER
	EXCH	MP,RP
	AOS	MACLVL
	HRRZS	MACENL		;RESET "CALLM IN PROGRESS"
	JUMPOC	STMNT2		;OP-CODE FIELD
	JRST	EVATOM		;ADDRESS FIELD

MAC30:	MOVEI	AC0,0		;INITIALIZE BRACKET COUNTER
MAC31:	PUSHJ	PP,GCHAR	;GET A CHARACTER
	CAIN	C,"<"		;"<"?
	ADDI	AC0,1		;YES, INCREMENT COUNT
	CAIN	C,">"		;">"?
	SOJL	AC0,MAC14A	;YES, EXIT IF MATCHING
	PUSHJ	PP,WCHAR	;WRITE INTO SKELETON
	JRST	MAC31		;GO BACK FOR ANOTHER

MAC40:	PUSH	PP,SX		;STACK REGISTERS
	PUSH	PP,SDEL
	HLLM	IO,TAGINC	;SAVE IO FLAGS
	PUSHJ	PP,CELL		;GET AN ATOM
	MOVE	V,AC0		;ASSUME NUMERIC
	TLNE	IO,NUMSW	;GOOD GUESS?
	JRST	MAC41		;YES
	PUSHJ	PP,SSRCH	;SEARCH THE SYMBOL TABLE
	TROA	ER,ERRX		;NOT FOUND, ERROR
MAC41:	PUSHJ	PP,MAC42	;FORM ASCII STRING
	HLL	IO,TAGINC	;RESTORE IO FLAGS
	POP	PP,SDEL
	POP	PP,SX
	TLO	IO,IORPTC	;REPEAT LAST CHARACTER
	JRST	MAC14A		;RETURN TO MAIN SCAN

MAC42:	MOVE	C,V
MAC44:	LSHC	C,-^D35
	LSH	CS,-1
	DIVI	C,0(RX)		;DIVIDE BY CURRENT RADIX
	HRLM	CS,0(PP)
	JUMPE	C,.+2		;TEST FOR END
	PUSHJ	PP,MAC44
	HLRZ	C,0(PP)
	ADDI	C,"0"		;FORM TEXT
	JRST	WCHAR		;WRITE INTO SKELETON
MACEN0:	SOS	MACENL
MACEND:	SKIPGE	C,MACENL	;TEST "CALLM IN PROGRESS"
	AOS	MACENL		;INCREMENT END LEVEL AND EXIT
	JUMPL	C,REPEA8
	EXCH	MP,RP
	POP	MP,MRP		;RETRIEVE READ POINTER
	POP	MP,RCOUNT	;AND WORD COUNT
	MOVEI	C,"^"
	SKIPL	0(MP)		;TEST FLAG
	PUSHJ	PP,RSW2		;MARK END OF SUBSTITUTION
	POP	MP,C
	POP	MP,ARG
	SKIPA	MP,MACPNT	;RESET MP AND SKIP
MACEN1:	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
MACEN2:	AOS	V,MACPNT	;GET POINTER
	MOVE	V,0(V)
	JUMPG	V,MACEN1	;IF >0, DECREMENT REFERENCE
	JUMPL	V,MACEN2	;IF <0, BYPASS
	POP	MP,V		;IF=0, RETRIEVE POINTER
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	MOVEM	ARG,MACPNT
	EXCH	MP,RP
	SOS	MACLVL
	SKIPN	MACENL		;CHECK UNPROCESSED END LEVEL
	JRST	MACEN3		;NONE TO PROCESS
	TRNN	MRP,-1		;MRP AT END OF TEXT
	JRST	MACEN0		;THEN POP THE MACRO STACK NOW
MACEN3:	TRNN	C,77400		;SALL FLAG?
	HRLI	C,0		;YES,TURN IT OFF
	JUMPL	C,REPEA8	;IF FLAG SET SUBSTITUTE
	JRST	RSW1
IRP0:	SKIPN	MACLVL		;ARE WE IN A MACRO?
	JRST	ERRAX		;NO, BOMB OUT
IRP10:	PUSHJ	PP,MREADS	;YES, GET DATA SPEC
	CAIE C,40		;SKIP LEADING BLANKS
	CAIN	C,"("		;"("?
	JRST	IRP10		;YES, BYPASS
	CAIN C,11
	JRST IRP10
	CAIE	C,177		;NO, IS IT SPECIAL?
	JRST	ERRAX		;NO, ERROR
	PUSHJ	PP,MREADS	;YES
	TRZN C,100		;CREATED?
	JRST ERRAX
	CAIL C,40		;TOO BIG?
	JRST ERRAX
	ADD	C,MACPNT	;NO, FORM POINTER TO STACK
	PUSH	MP,IRPCF	;STACK PREVIOUS POINTERS
	PUSH	MP,IRPSW
	PUSH	MP,IRPARP
	PUSH	MP,IRPARG
	PUSH	MP,IRPCNT
	PUSH	MP,0(C)
	PUSH	MP,IRPPOI

	HRRZM	C,IRPARP
	MOVEM	AC0,IRPCF	;IRPC FLAG FOUND IN AC0
	SETOM	IRPSW		;RESET IRP SWITCH
	MOVE	CS,0(C)
	MOVEM	CS,IRPARG

	PUSHJ	PP,MREADS
	CAIE	C,"<"		;"<"?
	JRST	.-2		;NO, SEARCH UNTIL FOUND
	PUSHJ	PP,SKELI1	;INITIALIZE NEW STRING
	MOVEM	ARG,IRPPOI	;SET NEW POINTER

	TDZA	SDEL,SDEL	;ZERO BRACKET COUNT AND SKIP
IRP20:	PUSHJ	PP,WCHAR1
	PUSHJ	PP,MREADS
	CAIN	C,"<"		;"<"?
	AOJA	SDEL,IRP20	;YES, INCREMENT COUNT AND WRITE
	CAIE	C,">"		;">"?
	JRST	IRP20		;NO, JUST WRITE IT
	SOJGE	SDEL,IRP20	;YES, WRITE IF NOT MATCHING
	MOVE	CS,[BYTE (7) 15,177,4]
	PUSHJ	PP,WWRXE	;WRITE END
	PUSH	MP,MRP		;STACK PREVIOUS READ POINTER
	PUSH	MP,RCOUNT	;AND WORD COUNT
	SKIPG	CS,IRPARG
	JRST	IRPPOP		;EXIT IF NOT VALID ARGUMENT
	MOVEI	C,1(CS)		;INITIALIZE POINTER
	MOVEM	C,IRPARG
IRPSET:	EXCH	MRP,IRPARG	;SWAP READ POINTERS
	MOVE	SX,RCOUNT	;SWAP COUNT OF WORDS TO READ
	EXCH	SX,IRPCNT
	MOVEM	SX,RCOUNT
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON FOR DATA
	HRRZM	ARG,@IRPARP	;STORE NEW DS POINTER
	SETZB	SX,SDEL		;ZERO FOUND FLAG AND BRACKET COUNT
	LDB	C,MRP		;GET LAST CHAR
	CAIN	C,","
	SKIPE	IRPCF		;IN IRPC
	JRST	IRPSE1		;NO
	MOVEI	SX,1		;FORCE ARGUMENT
IRPSE1:	PUSHJ	PP,MREADS
	CAIE	C,177		;SPECIAL?
	AOJA	SX,IRPSE2	;NO, FLAG AS FOUND
	PUSHJ	PP,PEEKM	;LOOK AT NEXT CHARACTER
	SETZM	IRPSW		;SET IRP SWITCH
	JUMPG	SX,IRPSE4	;IF ARG FOUND, PROCESS IT
	JRST	IRPPOP		;NO, CLEAN UP AND EXIT

IRPSE2:	SKIPE	IRPCF		;IRPC?
	JRST	IRPSE3		;YES, WRITE IT
	CAIN	C,","		;NO, IS IT A COMMA?
	JUMPE	SDEL,IRPSE4	;YES, EXIT IF NOT NESTED
	CAIN	C,"<"		;"<"?
	ADDI	SDEL,1		;YES, INCREMENT COUNT
	CAIN	C,">"		;">"?
	SUBI	SDEL,1		;YES, DECREMENT COUNT

IRPSE3:	PUSHJ	PP,WCHAR
	SKIPN	IRPCF		;IRPC?
	JRST	IRPSE1		;NO, GET NEXT CHARACTER

IRPSE4:	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END
	MOVEM	MRP,IRPARG	;SAVE POINTER
	MOVE	MRP,RCOUNT	;SAVE COUNT
	MOVEM	MRP,IRPCNT
	HRRZ	MRP,IRPPOI	;SET FOR NEW SCAN
	AOJA	MRP,REPEA8	;ON ARG COUNT
STOPI0:	SKIPN	IRPARP		;IRP IN PROGRESS?
	JRST	ERRAX		;NO, ERROR
	SETZM	IRPSW		;YES, SET SWITCH
	POPJ	PP,

IRPEND:	MOVE	V,@IRPARP
	PUSHJ	PP,REFDEC
	SKIPE	IRPSW		;MORE TO COME?
	JRST	IRPSET		;YES

IRPPOP:	MOVE	V,IRPPOI
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	POP	MP,RCOUNT
	POP	MP,MRP		;RESTORE CELLS
	POP	MP,IRPPOI
	POP	MP,@IRPARP
	POP	MP,IRPCNT
	POP	MP,IRPARG
	POP	MP,IRPARP
	POP	MP,IRPSW
	POP	MP,IRPCF
	JRST	REPEA8
GETDS:				;GET DUMMY SYMBOL NUMBER
	MOVE	CS,C		;USE CS FOR WORK REGISTER
	ANDI	CS,37		;MASK
	ADD	CS,MACPNT	;ADD BASE ADDRESS
	MOVE	V,0(CS)		;GET POINTER FLAG
	JUMPG	V,GETDS1	;BRANCH IF POINTER
	TRNN	C,40		;NOT POINTER, SHOULD WE CREATE?
	JRST	RSW0		;NO, FORGET THIS ARG
	PUSH	PP,WWRXX
	PUSH	PP,MWP		;STACK MACRO WRITE POINTER
	PUSH	PP,WCOUNT	;SAVE WORD  COUNT
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON
	MOVEM	ARG,0(CS)	;STORE POINTER
	MOVE	CS,[BYTE (7) 0,170,170,170,171]	;CREATE A SYMBOL
	ADD	CS,LSTSYM		;LSTSYM= # OF LAST CREATED
	TDZ	CS,[BYTE (7) 0,170,170,170,170]
	MOVEM	CS,LSTSYM
	IOR	CS,[ASCII /.0000/]
	MOVEI C,"."
	PUSHJ PP,WCHAR
	PUSHJ	PP,WWORD	;WRITE INTO SKELETON
	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END CODE
	POP	PP,WCOUNT	;RESTORE WORD COUNT
	POP	PP,MWP		;RESTORE MACRO WRITE POINTER
	POP	PP,WWRXX
	MOVE	V,ARG		;SET UP FOR REFINC

GETDS1:	PUSHJ	PP,REFINC	;INCREMENT REFERENCE
	HRL	V,RCOUNT	;SAVE WORD COUNT
	PUSH	MP,V		;STACK V FOR DECREMENT
	PUSH	MP,MRP		;STACK READ POINTER
	MOVEI	MRP,1(V)	;FORM READ POINTER
	JRST	RSW0		;EXIT

DSEND:	POP	MP,MRP
	POP	MP,V
	HLREM	V,RCOUNT	;RESTORE WORD COUNT
	HRRZS	V		;CLEAR COUNT
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	JRST	RSW0		;EXIT
SKELI1:	MOVEI	ARG,1		;ENTRY FOR SINGLE ARG
SKELI:	SETZ	MWP,		;SIGNAL FIRST TIME THROUGH
	PUSHJ	PP,SKELWL	;GET POINTER WORD
	HRRZM	MWP,WWRXX	;SAVE FIRST ADDRESS
	HRRZM	MWP,LADR	;SAVE START OF LINKED LIST
	HRRZM	ARG,1(MWP)	;STORE COUNT
	SOS	WCOUNT		;ACCOUNT FOR WORD
	HRRZ	ARG,WWRXX	;SET FIRST ADDRESS
	ADDI	MWP,2		;BUMP POINTER
	HRLI	MWP,(POINT 7)	;SET FOR 5 ASCII BYTES
	;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)

SKELW:	SOSLE	WCOUNT		;STILL SOME SPACE IN LEAF?
	POPJ	PP,		;YES, RETURN
SKELWL:	SKIPE	V,NEXT		;GET FIRST FREE ADDRESS
	JRST	SKELW1		;IF NON-ZERO, UPDATE FREE
	MOVE	V,FREE		;GET FREE
	ADDI	V,.LEAF		;INCREMENT BY LEAF SIZE
	CAML	V,SYMBOL	;OVERFLOW?
	PUSHJ	PP,XCEED	;YES, BOMB OUT
	EXCH	V,FREE		;UPDATE FREE
	SETZM	(V)		;CLEAR LINK

SKELW1:	HLL	V,0(V)		;GET ADDRESS
	HLRM	V,NEXT		;UPDATE NEXT
	SKIPE	MWP		;IF FIRST TIME
	HRLM	V,1-.LEAF(MWP)	;STORE LINK IN FIRST WORD OF LEAF
	MOVEI	MWP,.LEAF	;SIZE OF LEAF
	MOVEM	MWP,WCOUNT	;STORE FOR COUNT DOWN
	MOVEI	MWP,(V)		;SET UP WRITE POINTER
	TLO	MWP,(POINT 7,,21)	;2 ASCII CHARS
	POPJ	PP,

	;WWRXX	POINTS TO END OF TREE
	;MWP	IDPB POINTER TO NEXT HOLE
	;NEXT	FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)
	;FREE	POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE
	;LADR	POINTS TO BEG OF LINKED PORTION.
GCHARQ:	JUMPN	MRP,MREADS	;IF GETTING CHAR. FROM TREE
GCHAR:	PUSHJ	PP,CHARAC	;GET ASCII CHARACTER
	CAIG	C,FF		;TEST FOR LF, VT OR FF
	CAIGE	C,LF
	POPJ	PP,		;NO
	JRST	OUTIM1		;YES, LIST IT

WCHARQ:
WCHAR:	
WCHAR1:	TLNN	MWP,760000	;END OF WORD?
	PUSHJ	PP,SKELW	;YES, GET ANOTHER
	IDPB	C,MWP		;STORE CHARACTER
	POPJ	PP,

WWORD:	LSHC	C,7		;MOVE ASCII INTO C
	PUSHJ	PP,WCHAR1	;STORE IT
	JUMPN	CS,WWORD	;TEST FOR END
	POPJ	PP,		;YES, EXIT

WWRXE:	PUSHJ	PP,WWORD	;WRITE LAST WORD
	ADD	MWP,WCOUNT	;GET TO END OF LEAF
	SUBI	MWP,.LEAF	;NOW POINT TO START OF IT
	HRRZS	(MWP)		;ZERO LEFT HALF OF LAST LEAF
	HRRM	MWP,@WWRXX	;SET POINTER TO END
	POPJ	PP,
MREAD:	PUSHJ	PP,MREADS	;READ ONE CHARACTER
	CAIE	C,177		;SPECIAL?
	JRST	RSW1		;NO, EXIT
	PUSHJ	PP,MREADS	;YES, GET CODE WORD
	TRZE C,100		;SYMBOL?
	JRST GETDS		;YES
	CAILE C,4		;POSSIBLY ILLEGAL
	JRST ERRAX		;YUP
	HRRI	MRP,0		;NO, SIGNAL END OF TEXT
	JRST	.+1(C)
	PUSHJ	PP,XCEED
	JRST	MACEND		;1; END OF MACRO
	JRST	DSEND		;2; END OF DUMMY SYMBOL
	JRST	REPEND		;3; END OF REPEAT
	JRST	IRPEND		;4; END OF IRP

MREADI:	HRLI	MRP,700		;SET UP BYTE POINTER
	MOVEI	C,.LEAF-1	;NUMBER OF WORDS
	MOVEM	C,RCOUNT
MREADS:	TLNN	MRP,-1		;FIRST TIME HERE?
	JRST	MREADI		;YES, SET UP MRP AND RCOUNT
	TLNN	MRP,760000	;HAVE WE FINISHED WORD?
	SOSLE	RCOUNT		;YES, STILL ROOM IN LEAF?
	JRST	MREADC		;STILL CHAR. IN LEAF
	HLRZ	MRP,1-.LEAF(MRP);YES, GET LINK
	HRLI	MRP,(POINT 7,,21)	;SET POINTER
	MOVEI	C,.LEAF		;RESET COUNT
	MOVEM	C,RCOUNT
MREADC:	ILDB	C,MRP		;GET CHARACTER
	POPJ	PP,

PEEK:	JUMPN	MRP,PEEKM	;THIS IS A MACRO READ
	PUSHJ	PP,CHARAC	;READ AN ASCII CHAR.
	TLO	IO,IORPTC	;REPEAT  FOR NEXT
	POPJ	PP,		;AND RETURN

PEEKM:	PUSH	PP,MRP		;SAVE MACRO READ POINTER
	PUSH	PP,RCOUNT	;SAVE WORD COUNT
	PUSHJ	PP,MREADS	;READ IN A CHAR.
	POP	PP,RCOUNT	;RESTORE WORD COUNT
	POP	PP,MRP		;RESET READ POINTER
	POPJ	PP,		;IORPTC IS NOT SET
REFINC:	MOVEI	CS,1(V)		;GET POINTER TO TREE
	AOS	0(CS)		;INCREMENT REFERENCE
	POPJ	PP,

REFDEC:	JUMPLE	V,DECERR	;CATASTROPHIC ERROR SOMEWHERE
	MOVEI	CS,1(V)		;GET POINTER TO TREE
	SOS	CS,0(CS)	;DECREMENT REFERENCE
	TRNE	CS,000777	;IS IT ZERO?
	POPJ	PP,		;NO, EXIT
	HRRZ	CS,0(V)		;YES, GET POINTER TO END
	HRL	CS,NEXT		;GET POINTER TO NEXT RE-USABLE
	HLLM	CS,0(CS)	;SET LINK
	HRRM	V,NEXT		;RESET NEXT
	POPJ	PP,

DECERR:	MOVE	AC0,CALNAM	;GET MACRO NAME
	MOVSI	RC,[SIXBIT /ERROR WHILE EXPANDING@/]
	PUSHJ	PP,TYPMSG
	JRST	ERRNE2		;COMMON MESSAGE
A==	0			;ASCII MODE
AL==	1			;ASCII LINE MODE
IB==	13			;IMAGE BINARY MODE
B==	14			;BINARY MODE
DMP==16		;DUMP MODE

CTL==	0			;CONTROL DEVICE NUMBER
IFN CCLSW,<CTL2==4		;INPUT DEV FOR CCL FILE>
BIN==	1			;BINARY DEVICE NUMBER
CHAR==	2			;INPUT DEVICE NUMBER
LST==	3			;LISTING DEVICE NUMBER

;	COMMAND STRING ACCUMULATORS

ACDEV==	1			;DEVICE
ACFILE==2			;FILE
ACEXT==	3			;EXTENSION
ACPPN== 4			;PPN
ACDEL==	4			;DELIMITER
ACPNTR==5			;BYTE POINTER

TIO==	6

TIORW==	1000
TIOLE==	2000
TIOCLD==20000

DIRBIT==4		;DIRECTORY DEVICE
TTYBIT==10		;TTY
MTABIT==20		;MTA
DTABIT==100		;DTA
DISBIT==2000		;DISPLAY
CONBIT==20000		;CONTROLING TTY
LPTBIT==40000		;LPT
DSKBIT==200000		;DSK

;GETSTS ERROR BITS

IOIMPM==400000		;IMPROPER MODE (WRITE LOCK)
IODERR==200000		;DEVICE DATA ERROR
IODTER==100000		;CHECKSUM OR PARITY ERROR
IOBKTL== 40000		;BLOCK TOO LARGE
ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL

SYN	.TEMP,PPN
SUBTTL	I/O ROUTINES
BEG:
IFN CCLSW,<TLZA	IO,ARPGSW	;DON'T ALLOW RAPID PROGRAM GENERATION
	TLO	IO,ARPGSW	;ALLOW RAPID PROGRAM GENERATION>
	HRRZ	MRP,JOBREL	;GET LOWSEG SIZE
	MOVEM	MRP,MACSIZ	;SAVE CORE SIZE
				;DECODE VERSION NUMBER
	MOVEI	PP,JOBFFI	;TEMP PUSH DOWN STACK
	PUSH	PP,[0]		;MARK BOTTOM OF STACK
	LDB	0,[POINT 3,JOBVER,2]	;GET USER BITS
	JUMPE	0,GETE		;NOT SET IF ZERO
	ADDI	0,"0"		;FORM NUMBER
	PUSH	PP,0		;STACK IT
	MOVEI	0,"-"		;SEPARATE BY HYPHEN
	PUSH	PP,0		;STACK IT ALSO
GETE:	HRRZ	0,JOBVER	;GET EDIT NUMBER
	JUMPE	0,GETU		;SKIP ALL THIS IF ZERO
	MOVEI	1,")"		;ENCLOSE IN PARENS.
	PUSH	PP,1
GETED:	IDIVI	0,8		;GET OCTAL DIGITS
	ADDI	1,"0"		;MAKE ASCII
	PUSH	PP,1		;STACK IT
	JUMPN	0,GETED		;LOOP TIL DONE
	MOVEI	0,"("		;OTHER PAREN.
	PUSH	PP,0
GETU:	LDB	0,[POINT 6,JOBVER,17]	;UPDATE NUMBER
	JUMPE	0,GETV		;SKIP IF ZERO
	IDIVI	0,8		;MIGHT BE TWO DIGITS
	ADDI	1,"@"		;FORM ALPHA
	PUSH	PP,1
	JUMPN	0,GETU+1	;LOOP IF NOT DONE
GETV:	LDB	0,[POINT 9,JOBVER,11]	;GET VERSION NUMBER
	IDIVI	0,8		;GET DIGIT
	ADDI	1,"0"		;TO ASCII
	PUSH	PP,1		;STACK
	JUMPN	0,GETV+1	;LOOP
	MOVE	1,[POINT 7,VBUF+1,13]	;POINTER TO DEPOSIT IN VBUF
	POP	PP,0		;GET CHARACTER
	IDPB	0,1		;DEPOSIT IT
	JUMPN	0,.-2		;KEEP GOING IF NOT ZERO
IFN CCLSW,<
	TLZA	IO,CRPGSW	;SET TO INIT NEW COMMAND FILE
M:	TLNN	IO,CRPGSW	;CURRENTLY DOING RPG?>
IFE CCLSW,<M:>
	RESET			;INITIALIZE PROGRAM
	SETZM	BINDEV		;CLEAR INCASE NOT USED NEXT TIME
	SETZM	LSTDEV		;SAME REASON
	SETZM	INDEV		;INCASE OF ERROR
	HRRZ	MRP,MACSIZ	;GET INITIAL SIZE
	CORE	MRP,		;BACK TO ORIGINAL SIZ4
	JFCL			;SHOULD NEVER FAIL
	SETZB	MRP,PASS1I
	MOVE	[XWD PASS1I,PASS1I+1]
	BLT	PASS2X-1	;ZERO THE PASS1 AND PASS2 VARIABLES
	MOVEI	PP,JOBFFI	;SET TEMP PUSH-DOWN POINTER
;	MOVE	CS,[POINT 7,DBUF,6]	;INITIALIZE FOR DATE
;	MSTIME	2,		;GET TIME FROM MONITOR
;	PUSHJ	PP,TIMOUT	;TIME FORMAT OUTPUT
;	DATE	1,		;GET DATE
;	IBP	CS		;PASS OVER PRESET SPACE
;	PUSHJ	PP,DATOUT	;DATE FORMAT OUTPUT
	MOVSI	FR,P1!CREFSW
IFN CCLSW,<TLNE	IO,CRPGSW	;RPG IN PROGRESS?
	JRST	GOSET		;YES, GO READ NEXT COMMAND
	TLNE	IO,ARPGSW	;NO, RPG ALLOWED?
	JRST	RPGSET		;YES, GO TRY
CTLSET:	RELEASE	CTL2,		;IN CASE OF LOOKUP FAILURE>
IFE CCLSW,<CTLSET:>
	MOVSI	IO,IOPALL	;ZERO FLAGS
	INIT	CTL,AL		;INITIALIZE USER CONSOLE
	SIXBIT	/TTY/
	XWD	CTOBUF,CTIBUF
	EXIT			;NO TTY, NO ASSEMBLY
	MOVSI	C,(SIXBIT /TTY/)
	DEVCHR	C,		;GET CHARACTERISTICS
	TLNN	C,10		;IS IT REALLY A TTY
	EXIT			;NO
	INBUF	CTL,1		;INITIALIZE SINGLE CONTROL
	OUTBUF	CTL,1		;BUFFERS
	PUSHJ	PP,CRLF		;OUTPUT CARRIAGE RETURN - LINE FEED
	MOVEI	C,"*"
	IDPB	C,CTOBUF+1
	OUTPUT	CTL,
	INPUT	CTL,
IFN CCLSW,<JRST BINSET		;BEGIN WITH BINARY FILE

RPGSET:
	INIT	CTL2,AL		;LOOK FOR DISK
	SIXBIT	/DSK/		;...
	XWD	0,CTLBLK	;...
	JRST	CTLSET		;DSK NOT THERE

	HRLZI	3,(SIXBIT /MAC/)	;###MAC
	MOVEI	3			;COUNT
	PJOB	AC1,			;RETURNS JOB NO. TO AC1
RPGLUP:	IDIVI	AC1,12			;CONVERT
	ADDI	AC2,"0"-40		;SIXBITIZE IT
	LSHC	AC2,-6			;
	SOJG	0,RPGLUP		;3 TIMES
	MOVEM	3,CTLBUF		;###MAC
	HRLZI	(SIXBIT /TMP/)		;
	MOVEM	CTLBUF+1		;TMP
	SETZM	CTLBUF+3		;PROG-PRO
	LOOKUP	CTL2,CTLBUF		;COMMAND FILE
	JRST	CTLSET			;NOT THERE
	HLRM	EXTMP			;SAVE THE EXTENSION

RPGS2:	INBUF	CTL2,1		;SINGLE BUFFERED
RPGS2A:	INIT	CTL,AL		;TTY FOR CONSOLE MESSAGES
	SIXBIT	/TTY/		;...
	XWD	CTOBUF,0	;...
	EXIT			;NO TTY, NO ASSEMBLY
	OUTBUF	CTL,1		;SINGLE BUFFERED
	MOVE	JOBFF		;REMEMBER WHERE BINARY BUFFERS BEGIN
	MOVEM	SAVFF		;...
	HRRZ	JOBREL		;TOP OF CORE
	CAMLE	MACSIZ		;SEE IF IT HAS GROWN
	MOVEM	MACSIZ		;PREVENTS ADDRESS CHECK ON EXIT
	TLNE IO,CRPGSW	;ARE WE ALREADY IN RPG MODE?
	JRST M	;MUST HAVE COME FROM @ COMMAND, RESET

GOSET:	MOVSI	IO,IOPALL!CRPGSW	;SET INITIAL FLAGS
	MOVEI	CS,CTLSIZ	;MAXIMUM CHARS IN A LINE
	MOVE	AC1,CTLBLK+2	;NUMBER OF CHARACTERS
	MOVEM	AC1,CTIBUF+2	;SAVE FOR PASS 2
	MOVE	AC1,[POINT 7,CTLBUF]	;WHERE TO STASH CHARS
	MOVEM	AC1,CTIBUF+1	;...
GOSET1:	SOSG	CTLBLK+2	;ANY MORE CHARS?
	PUSHJ	PP,[IN CTL2,		;READ ANOTHER BUFFERFUL
		   POPJ	PP,		;EVERYTHING OK, RETURN
		   STATO CTL2,20000	;EOF?
		   JRST	[HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
			JRST ERRFIN]		;GO COMPLAIN
		   PUSHJ PP,DELETE	;CMD FILE
		   EXIT]		;EOF AND FINISHED
	ILDB	C,CTLBLK+1	;GET NEXT CHAR
	MOVE	RC,@CTLBLK+1	;CHECK FOR SEQUENCE NUMBERS
	TRNE	RC,1		;...
	JRST	[AOS	CTLBLK+1	;SKIP OVER ANOTHER 5 CHARS
		MOVNI	RC,5		;...
		ADDM	RC,CTLBLK+2	;...
		JRST	GOSET1	]	;GO READ ANOTHER CHAR
	JUMPE	C,GOSET1	;IGNORE NULLS
	IDPB	C,CTIBUF+1	;STASH AWAY
	AOS	CTIBUF+2	;INCREMENT CHAR. COUNT
	CAIE	C,12		;LINE FEED OR
	CAIN	C,175		;ALTMODE?
	JRST	GOSET2		;YES, FINISHED WITH COMMAND
	CAIE	C,176
	CAIN	C,33
	JRST	GOSET2		;ALTMODE.
	SOJG	CS,GOSET1	;GO READ ANOTHER
	HRROI	RC,[SIXBIT /COMMAND LINE TOO LONG@/]
	JRST	ERRFIN		;GO COMPLAIN
GOSET2:	MOVEI	C,12		;MAKE SURE THERE'S A LF
	IDPB	C,CTIBUF+1	;...
	MOVEM	AC1,CTIBUF+1	;SET POINTER TO BEGINNING
	AOS	CTIBUF+2	;ADD I TO COUNT
	MOVE	SAVFF		;RESET JOBFF FOR NEW BINARY
	MOVEM	JOBFF		;...
	JRST BINSET

RPGS1:	PUSHJ	PP,DELETE	;DELETE COMMAND FILE
	MOVEM	ACDEV,RPGDEV	;GET SET TO INIT
	OPEN	CTL2,RPGINI	;DO IT
	JRST	EINIT		;ERROR
	MOVEM	ACFILE,INDIR	;USE INPUT BLOCK
	MOVEM	ACPPN,INDIR+3	;SET PPN 
	MOVEM	ACEXT,INDIR+1
	LOOKUP	CTL2,INDIR
	JRST	[JUMPN	ACEXT,RPGLOS	;GIVE UP ,EXPLICIT EXTENSION
	MOVSI	ACEXT,(SIXBIT /CCL/)	;IF BLANK TRY CCL
		JRST	.-2	]
	HLRM	ACEXT,EXTMP	;SAVE THE EXTENSION
	HLRZ	JOBSA		;RESET JOBFF TO ORIGINAL
	MOVEM	JOBFF
	TLO	IO,CRPGSW	;TURN ON SWITCH SO WE RESET WORLD
	JRST	RPGS2		;AND GO
RPGLOS:	RELEAS	CTL2,0
	TLZ	IO,CRPGSW	;STOPS IO TO UNASGD CHAN
	JRST	ERRCF		;NO FILE FOUND
>
BINSET:	PUSHJ	PP,NAME1	;GET FIRST NAME
IFN CCLSW,<CAIN	C,"!"		;WAS THIS AN IMPERATIVE?
	JRST	NUNSET		;GET THEE TO A NUNNERY
	CAIN C,"@"	;CHEK FOR A NEW RPG FILE
	JRST RPGS1>
	TLNN	FR,CREFSW	;CROSS REF REQUESTED?
	JRST	LSTSE1		;YES, SKIP BINARY
	CAIN	C,","		;COMMA?
	JUMPE	ACDEV,LSTSET	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	CAIN	C,"_"		;LEFT ARROW?
	JUMPE	ACDEV,LSTSE1	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	JUMPE	ACDEV,M		;IGNORE IF JUST <CR-LF>
	TLO	FR,PNCHSW	;OK, SET SWITCH
	MOVEM	ACDEV,BINDEV	;STORE DEVICE NAME
	MOVEM	ACFILE,BINDIR	;STORE FILE NAME IN DIRECTORY
	JUMPN	ACEXT,.+2	;EXTENSION SPECIFIED?
	MOVSI	ACEXT,(SIXBIT /REL/)	;NO, ASSUME RELOCATABLE BINARY
	MOVEM	ACEXT,BINDIR+1	;STORE IN DIRECTORY
	MOVEM	ACPPN,BINDIR+3	;SET PPN
	OPEN	BIN,BININI	;INITIALIZE BINARY
	JRST	EINIT		;ERROR
	TLZE TIO,TIOLE		;SKIP TO EOT
	MTAPE BIN,10
	TLZE	TIO,TIORW	;REWIND REQUESTED?
	MTAPE	BIN,1		;YES
	JUMPGE	CS,BINSE2	;BRANCH IF NO BACK-SPACE
	MTAPE	BIN,17		;BACK-SPACE A FILE
	AOJL	CS,.-1		;TEST FOR END
	WAIT	BIN,
	STATO	BIN,1B24	;LOAD POINT?
	MTAPE	BIN,16		;NO, GO FORWARD ONE
BINSE2:	SOJG	CS,.-1		;TEST FORWARD SPACING

	TLNE	TIO,TIOCLD	;DIRECTORY CLEAR REQUESTED?
	UTPCLR	BIN,		;YES, CLEAR IT
	OUTBUF	BIN,2		;SET UP TWO RING BUFFER
	CAIN	C,"_"
	JRST	GETSET		;NO LISTING
LSTSET:	PUSHJ	PP,NAME1	;GET NEXT DEVICE
LSTSE1:	CAIE	C,"_"
	JRST	ERRCM
	TLNE	FR,CREFSW	;CROSS-REF REQUESTED?
	JRST	LSTSE2		;NO, BRANCH
	JUMPN	ACDEV,.+2	;YES, WAS DEVICE SPECIFIED?
	MOVSI	ACDEV,(SIXBIT /DSK/)	;NO, ASSUME DSK
	JUMPN	ACFILE,.+2
	MOVE	ACFILE,[SIXBIT /CREF/]
	JUMPN	ACEXT,.+2
MOVSI	ACEXT,(SIXBIT /CRF/)   
LSTSE2:	JUMPE	ACDEV,GETSET	;FORGET LISTING IF NO DEVICE SPECIFIED
	MOVE	AC0,ACDEV
	DEVCHR	AC0,		;GET CHARACTERISTICS
	TLNE	AC0,LPTBIT!DISBIT!TTYBIT
	TLNE	FR,CREFSW	; WAS CROSS-REF REQUESTED?
	AOSA	OUTSW+0*TTYSW	;NO, ASSUME TTY
	JRST	ERRCM		;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY
	TLNE	AC0,CONBIT	;CONTROLING TELETYPE LISTING?
	JRST	GETSET		;YES, BUFFER ALREADY SET
	MOVEM	ACDEV,LSTDEV	;STORE DEVICE NAME
	AOS	OUTSW+0*LPTSW	;SET FOR LPT
	MOVEM	ACFILE,LSTDIR	;STORE FILE NAME
	JUMPN	ACEXT,.+2
	MOVSI	ACEXT,(SIXBIT /LST/)
	MOVEM	ACEXT,LSTDIR+1
	MOVEM	ACPPN,LSTDIR+3	;SET PPN
	OPEN	LST,LSTINI	;INITIALIZE LISTING OUTPUT
	JRST	EINIT		;ERROR
	TLZE TIO,TIOLE
	MTAPE LST,10
	TLZE	TIO,TIORW	;REWIND REQUESTED?
	MTAPE	LST,1		;YES
	JUMPGE	CS,LSTSE3
	MTAPE	LST,17
	AOJL	CS,.-1
	WAIT	LST,
	STATO	LST,1B24
	MTAPE	LST,16
LSTSE3:	SOJG	CS,.-1
	TLNE	TIO,TIOCLD	;DIRECTORY CLEAR REQUESTED?
	UTPCLR	LST,		;YES, CLEAR IT
	OUTBUF	LST,2		;SET UP A TWO RING BUFFER
GETSET:	MOVEI	3,PDPERR
	HRRM	3,JOBAPR	;SET TRAP LOCATION
	MOVEI	3,1B19		;SET FOR PUSH-DOWN OVERFLOW
	APRENB	3,
	SOS	3,PDP		;GET PDP REQUEST MINUS 1
	IMULI	3,.PDP		;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)
	HRLZ	MP,3
	HRR	MP,JOBFF	;SET BASIC POINTER
	MOVE	PP,MP
	SUB	PP,3
	MOVEM	PP,RP		;SET RP
	SUB	PP,3
	ASH	3,1		;DOUBLE SIZE OF BASIC POINTER
	HRL	PP,3
	SUBM	PP,3		;COMPUTE TOP LOCATION
IFN UNIVR,<SKIPN	UNITOP		;IF ANY UNIVERSALS HAVE BEEN SEEN
	JRST	GETSE0		;NO
	HRRZS	3		;GET TOP OF BUFFERS AND STACKS
	CAMLE	3,UNISIZ	;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE
	JRST	UNIERR		;IT WAS, YOU LOSE
	SKIPA	3,UNITOP	;DON'T LOSE THEM
GETSE0:	HRRZM	3,UNISIZ	;STORE UNTIL A UNIVERSAL IS SEEN>
	HRRZM	3,LADR		;SET START OF MACRO TREE
	HRRZM	3,FREE

GETSE1:	HRRZ	JOBREL
	SUBI	1
	MOVEM	SYMTOP		;SET TOP OF SYMBOL TABLE
	SUBI	LENGTH		;SET POINTER FOR INITIAL SYMBOLS
	CAMLE	LADR		;HAVE WE ROOM?
	JRST	GETSE2		;YES

	HRRZ	2,JOBREL	;NO, TRY FOR MORE CORE
	ADDI	2,2000
	CORE	2,
	JRST	XCEED2	;NO MORE, INFORM USER
	JRST	GETSE1		;TRY AGAIN

GETSE2:	MOVEM	SYMBOL		;SET START OF SYMBOL TABLE
	HRLI	SYMNUM
	BLT	@SYMTOP		;STORE SYMBOLS
	PUSHJ	PP,SRCHI	;INITIALIZE TABLE
	MOVE	[XWD CTIBUF+1,CTLSAV]	;SAVE CONTROL INPUT BUFFER
	BLT	CTLS1		;FOR RESCAN ON PASS 2
IFN FTDISK,<MOVSI (SIXBIT /DSK/)	;SET INPUT TO TAKE DSK AS DEV
	MOVEM ACDEVX>
	PUSHJ PP,COUTI	;INIT OUTPUT JUST IN CASE
	PUSHJ	PP,INSET	;GET FIRST INPUT FILE

IFN CCLSW,<TLNE	IO,CRPGSW	;BUT ONLY IF DOING RPG
	TTCALL	3,[ASCIZ /MACRO: /]	;PUBLISH COMPILER NAME>
	MOVE CS,INDIR	;SET UP NAME OF FIRST FILE
	MOVEM CS,LSTFIL	;AS LAST PRINTED
	SETZM	LSTPGN
	JRST	ASSEMB		;START ASSEMBLY
FINIS:	CLOSE	BIN,		;DUMP BUFFER
	TLNE	FR,PNCHSW	;PUNCH REQUESTED?
	PUSHJ	PP,TSTBIN	;YES, TEST FOR ERRORS
	RELEAS	BIN,
	CLOSE	LST,
	SOSLE	OUTSW+0*LPTSW	;LPT TYPE OUTPUT?
	PUSHJ	PP,TSTLST	;YES, TEST FOR ERRORS
	RELEAS	LST,
	RELEAS	CHAR,
	OUTPUT CTL,0	;FLUSH TTY OUTPUT
IFN UNIVR,<SKIPE	UNIVSN		;SKIP IF NOT ASSEMBLING UNIVERSAL
	PUSHJ	PP,UNISYM	;STORE SYMBOLS ETC. FIRST>
	JRST	M		;RETURN FOR NEXT ASSEMBLY
INSET:	MOVEI	JOBFFI		;POINTER TO INPUT BUFFER
	HRRM	JOBFF		;INFORM SYSTEM OF BUFFER AREA
	PUSHJ	PP,NAME2	;GET NEXT COMMAND NAME
	JUMPE	ACDEV,ERRNE	;ERROR  IF NONE LEFT
	MOVEM	ACDEV,INDEV	;STORE DEVICE
	MOVEM	ACFILE,INDIR	;STORE FILE IN DIRECTORY
	MOVEM	ACPPN,INDIR+3	;STORE PPN BEFORE WE LOSE IT
	OPEN	CHAR,INDEVI
	JRST	EINIT		;ERROR
	DEVCHR	ACDEV,		;TEST CHARACTERISTICS
	TLNN	ACDEV,MTABIT	;MAG TAPE?
	JRST	INSET3		;NO
	TLZN	FR,MTAPSW	;FIRST MAG TAPE IN PASS 2?
	JRST	INSET1		;NO
	TLNN	TIO,TIORW	;YES, REWIND REQUESTED?
	SUB	CS,RECCNT	;NO, PREPARE TO BACK-SPACE TAPE
INSET1:	AOS	RECCNT		;INCREMENT FILE COUNTER
	ADDM	CS,RECCNT	;UPDATE  COUNT
	TLZE TIO,TIOLE
	MTAPE CHAR,10
	TLZE	TIO,TIORW	;REWIND?
	MTAPE	CHAR,1		;YES
	JUMPGE	CS,INSET2
	MTAPE	CHAR,17
	MTAPE	CHAR,17
	AOJL	CS,.-1
	WAIT	CHAR,
	STATO	CHAR,1B24
	MTAPE	CHAR,16
INSET2:	SOJGE	CS,.-1

INSET3:	INBUF CHAR,1
	MOVEI ACPNTR,JOBFFI
	EXCH ACPNTR,JOBFF
	SUBI ACPNTR,JOBFFI
	MOVEI ACDEL,NUMBUF*203+1
	IDIV ACDEL,ACPNTR
	INBUF CHAR,(ACDEL)
	JUMPN	ACEXT,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
	MOVSI	ACEXT,(SIXBIT /MAC/)	;BLANK, TRY .MAC FIRST
	PUSHJ	PP,INSETI
INSET4:	PUSHJ	PP,INSETI
	JUMPE	ACEXT,ERRCF	;ERROR IF ZERO
	TLNE	ACDEV,TTYBIT	;TELETYPE?
	SETSTS	CHAR,AL		;YES, CHANGE TO ASCII LINE
				;DO ALL ENTERS HERE FOR LEVEL D
	SKIPE	ENTERS		;HAVE ENTERS BEEN DONE ALREADY?
	JRST	ENTRDN		;YES, DON'T DO TWICE
	SKIPN	ACEXT,LSTDEV	;IS THERE A LIST DEVICE?
	JRST	LSTSE5		;NO SO DON'T DO ENTER
	SKIPN	ACFILE,LSTDIR	;GET FILE NAME INCASE OF ERROR
	JRST	[DEVCHR	ACEXT,	
		TLNE	ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
		JRST	LSTSE4		;YES, GIVE UP BEFORE HARM IS DONE
		SKIPE	ACFILE,INDIR	;USE INPUT FILE NAME
		MOVEM	ACFILE,LSTDIR	;TOO BAD IF ZERO ALSO
		JRST	LSTSE4]
	HLLZ	ACEXT,LSTDIR+1	;EXT ALSO
	MOVE	ACPPN,LSTDIR+3	;SAVE PPN
	LOOKUP	LST,LSTDIR	;PREVIOUS ONE STILL THERE
	JRST	LSTSE4		;NO
	SETZM	LSTDIR		;YES,CLEAR NAME
	MOVEM	ACPPN,LSTDIR+3	;RESET PPN
	RENAME	LST,LSTDIR
	CLOSE	LST,		;IGNORE FAILURE
	MOVEM	ACFILE,LSTDIR	;RESTORE NAME
	HLLZS	LSTDIR+1	;BH 11/19/74 FOR DATE75.  CLEAR RH.
	SETZM	LSTDIR+2	;CLEAR PROTECTION AND DATE
	MOVEM	ACPPN,LSTDIR+3	;SET PPN AGAIN
LSTSE4:	
	ENTER	LST,LSTDIR	;SET UP DIRECTORY
	JRST	ERRCL		;ERROR
LSTSE5:	SKIPN	ACEXT,BINDEV	;A BINARY DEVICE THEN ?
	JRST	ENTRDN		;NO
	SKIPN	ACFILE,BINDIR	;INCASE OF ERROR
	JRST	[DEVCHR	ACEXT,	
		TLNE	ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
		JRST	.+1		;YES, GIVE UP BEFORE HARM IS DONE
		SKIPE	ACFILE,INDIR	;USE INPUT FILE NAME
		MOVEM	ACFILE,BINDIR	;TOO BAD IF ZERO ALSO
		JRST	.+1]
	HLLZS	ACEXT,BINDIR+1	;BH 11/19/74 DATE75.  WAS HLLZ.
	ENTER	BIN,BINDIR	;ENTER FILE NAME
	JRST	ERRCB		;ERROR

ENTRDN:	SETOM	ENTERS		;MAKE SURE ONLY DONE ONCE
REPEAT 0,<
	MOVE	CS,[POINT 7,DEVBUF]
	PUSH	PP,1		;SAVE THE ACCS
	PUSH	PP,2
	PUSH	PP,3
	SKIPN	2,INDIR		;GET INPUT NAME
	JRST	FINDEV		;FINISHED WITH DEVICE
	SETZ	1,		;CLEAR FOR RECEIVING
	LSHC	1,6		;SHIFT ONE CHAR. IN
	ADDI	1,40		;FORM ASCII
	IDPB	1,CS		;STORE CHAR.
	JUMPN	2,.-4		;MORE TO DO?
	MOVEI	1,"	"	;SEPARATE BY TAB
	IDPB	1,CS
	HLLZ	2,INDIR+1	;GET EXT
	JUMPE	2,FINEXT	;NO EXT
	SETZ	1,
	LSHC	1,6		;SAME LOOP AS ABOVE
	ADDI	1,40
	IDPB	1,CS
	JUMPN	2,.-4
FINEXT:	MOVEI	1,"	"
	IDPB	1,CS		;SEPARATE BY TAB
	LDB	1,[POINT 12,INDIR+2,35]	;GET DATE
	LDB	2,[POINT 3,INDIR+1,20]	;BH 11/19/74 DATE75.
	DPB	2,[POINT 3,1,23]	;BH 11/19/74 DATE75.
	JUMPE	1,FINDEV	;NO DATE?
	PUSHJ	PP,DATOUT	;STORE IT
	LDB	2,[POINT 11,INDIR+2,23]	;GET CREATION TIME
	JUMPE	2,FINDEV	;NO TIME (DECTAPE)
	MOVEI	1," "		;SEPARATE BY SPACE
	IDPB	1,CS
	PUSHJ	PP,TIMOU1	;STORE TIME
FINDEV:	SETZ	1,
	MOVEI	2,"	"	;FINAL TAB
	IDPB	2,CS
	IDPB	1,CS		;TERMINATE FOR NOW
	POP	PP,3		;RESTORE ACCS
	POP	PP,2
	POP	PP,1
>
	SKIPN	PAGENO		;IF FIRST TIME THRU
	JRST	OUTFF		;START NEW PAGE
	SETZM PAGENO		;ON NEW FILE, RESET PAGES
	JRST	OUTFF2		;DON'T START NEW PAGE UNLESS FF

INSETI:	HLLZM	ACEXT,INDIR+1	;STORE EXTENSION
	MOVE	ACPPN,INDIR+3	;SAVE PPN
	LOOKUP	CHAR,INDIR
	SKIPA	ACEXT,INDIR+1	;GET ERROR CODE
	JRST	CPOPJ1		;SKIP-RETURN IF FOUND
	TRNE	ACEXT,-1	;ERROR CODE OF 0 IS FILE NOT FOUND
	JRST	ERRCF		;FILE THERE BUT NOT READABLE
	SETZ	ACEXT,		;CLEAR EXT AND TRY AGAIN
	MOVEM	ACPPN,INDIR+3	;RESTORE PPN
	POPJ	PP,
REC2:	MOVS	[XWD CTIBUF+1,CTLSAV]	;RESCAN CONTROL (FROM PASS1 END STMNT)
	BLT	CTIBUF+2	;INPUT BUFFER
	MOVEI	"_"
	HRLM	ACDELX		;FUDGE PREVIOUS DELIMITER
IFN RENTSW,<MOVE HHIGH	;GET HI-SEG BREAK
	MOVEM	HIGH1	;SAVE THE ONE WE GOT ON PASS1 (FOR HISEG)>
	SETZM	PASS2I
	MOVE	[XWD PASS2I,PASS2I+1]
	BLT	PASS2X-1		;ZERO PASS2 VARIABLES
	TLO	FR,MTAPSW!LOADSW	;SET FLAGS 

GOTEND:	MOVE	INDEV		;GET LAST DEVICE
	DEVCHR			;GET ITS CHARACTERISTICS
	TLNE	4		;TEST FOR DIRECTORY (DSK OR DTA)
	JRST	EOT		;YES, SO DON'T WASTE TIME
	JRST	.+3		;NO, INPUT BUFFER BY BUFFER
	IN	CHAR,
	JRST	.-1		;NO ERRORS
	STATO	CHAR,1B22	;TEST FOR EOF
	JRST	.-3		;IGNORE ERRORS

EOT:	PUSHJ	PP,SAVEXS	;SAVE REGISTERS
	PUSHJ	PP,INSET	;GET THE NEXT INPUT DEVICE
	HRROI	RC,[SIXBIT /END OF PASS 1@/]	;ASSUME END OF PASS
	TLZN	FR,LOADSW	;ZERO ONLY ON END OF PASS 1
	HRROI	RC,[SIXBIT /LOAD THE NEXT FILE@/]	;NOT END OF PASS
	TLNN	ACDEV,(1B13!1B15)	;WAS ALL THAT WORK NECESSARY?
	PUSHJ	PP,TYPMSG	;YES

RSTRXS:	MOVSI	RC,SAVBLK	;SET POINTER
	BLT	RC,RC-1		;RESTORE REGISTERS
	MOVE	RC,SAVERC	;RESTORE RC
	POPJ	PP,		;EXIT

SAVEXS:	MOVEM	RC,SAVERC	;SAVE RC
	MOVEI	RC,SAVBLK	;SET POINTER
	BLT	RC,SAVBLK+RC-1	;BLT ALL REGISTERS BELOW RC
	POPJ	PP,		;EXIT
NAME1:	SETZM	ACDEVX		;ENTRY FOR DESTINATION
NAME2:	SETZB	ACDEV,INDIR+2	;ENTRY FOR SOURCE
	MOVEI	ACFILE,0	;CLEAR FILE
	HLRZ	ACDEL,ACDELX	;GET PREVIOUS DELIMITER
	SETZB	TIO,CS
	SETZB	ACEXT,INDIR+3	;RESET EXTENSION AND PROGRAM-NUMBER PAIR
	SETZM	PPN		;CLEAR PPN
NAME3:	MOVSI	ACPNTR,(POINT 6,AC0)	;SET POINTER
	TDZA	AC0,AC0		;CLEAR SYMBOL

SLASH:	PUSHJ	PP,SW0
GETIOC:	PUSHJ	PP,TTYIN	;GET INPUT CHARACTER
	CAIN	C,"/"
	JRST	SLASH
	CAIN	C,"("
	JRST	SWITCH
	CAIN	C,":"
	JRST	DEVICE
	CAIN	C,"."
	JRST	NAME
IFN CCLSW,<CAIE	C,"!"		;IS CHAR AN IMPERATIVE?
	CAIN	C,"@"
	JRST	TERM		;YES, GO DO IT>
	CAIE	C,33		;CHECK FOR THREE FLAVORS OF ALT-MODE
	CAIN	C,176		;...
	JRST	TERM		;...
	CAIG	C,CR		;LESS THAN CR?
	CAIGE	C,LF		;AND GREATER THAN LF?
	CAIN	C,175		;OR 3RD ALTMOD
	JRST	TERM		;YES
IFN FTDISK,<CAIN C,"["
	JRST	PROGNP		;GET PROGRAMER NUMBER PAIR>
	CAIN	C,"="		;EQUALS IS SAME AS LEFT ARROW
	TRCA	C,142		;SO MAKE IT A "_" AND SKIP
	CAIE	C,","
	CAIN	C,"_"
	JRST	TERM
	CAIGE	C,40		;VALID AS SIXBIT?
	JRST	[CAIN C,"Z"-100	;NO,IS IT ^Z
		EXIT		;YES,EXIT FOR BATCH
		JRST	GETIOC]	;JUST IGNORE
	SUBI	C,40		;CONVERT TO 6-BIT
	TLNE	ACPNTR,770000	;HAVE WE STORED SIX BYTES?
	IDPB	C,ACPNTR	;NO, STORE IT
	JRST	GETIOC		;GET NEXT CHARACTER

DEVICE:	JUMPN	ACDEV,ERRCM	;ERROR IF ALREADY SET
	MOVE	ACDEV,AC0	;DEVICE NAME
	JRST	DEVNAM		;COMMON CODE

NAME:	JUMPN	ACFILE,ERRCM	;ERROR IF ALREADY SET
	MOVE	ACFILE,AC0	;FILE NAME
DEVNAM:	MOVE	ACDEL,C		;SET DELIMITER
	JRST	NAME3		;GET NEXT SYMBOL

TERM:	JUMPE	ACDEL,TERM1	;IF NO PREVIOUS TERMINATOR, THEN FILENAME
	CAIN	ACDEL,"_"	;...
	JRST	TERM1		;...
	CAIE	ACDEL,":"	;IF PREVIOUS DELIMITER
	CAIN	ACDEL,","	;WAS COLON OR COMMA
TERM1:	MOVE	ACFILE,AC0	;SET FILE
	CAIN	ACDEL,"."	;IF PERIOD,
	HLLZ	ACEXT,AC0	;SET EXTENSION
	HRLM	C,ACDELX	;SAVE PREVIOUS DELIMITER
	JUMPN	ACDEV,.+2	;IF DEVICE SET USE IT
	SKIPA	ACDEV,ACDEVX	;OTHERWISE USE LAST DEVICE
	MOVEM	ACDEV,ACDEVX	;AND DEVICE
	MOVE	ACPPN,PPN	;PUT PPN IN RIGHT PLACE
IFN FTDISK,<CAIN C,"!"		;IMPERATIVE?
	POPJ	PP,		;YES, DON'T ASSUME DEV
	JUMPE	ACFILE,CPOPJ	;IF THERE IS A FILE,
	JUMPN	ACDEV,.+2	;BUT NO DEVICE
	MOVSI	ACDEV,(SIXBIT /DSK/)	;THEN ASSUME DISK>
	POPJ	PP,		;EXIT
ERRCM:	HRROI	RC,[SIXBIT /COMMAND ERROR@/]
	JRST	ERRFIN

IFN FTDISK,<PROGNP:
PROGN1:	HRLZM	RC,PPN		;COMMA, STORE LEFT HALF
PROGN2:	MOVEI	RC,0		;CLEAR AC
PROGN3:	PUSHJ	PP,TTYIN
	CAIN	C,","
	JRST	PROGN1		;STORE LEFT HALF
	HRRM	RC,PPN		;ASSUME TERMINAL
	CAIN	C,"]"
	JRST	GETIOC		;YES, RETURN TO MAIN SCAN
	CAIL	C,"0"		;CHECK FOR VALID NUMBERS
	CAILE	C,"7"
	JRST	ERRCM		;NOT VALID
	LSH	RC,3		;SHIFT PREVIOUS RESULT
	ADDI	RC,-"0"(C)	;ADD IN NEW NUMBER
	JRST	PROGN3		;GET NEXT CHARACTER>
SWITC0:	PUSHJ	PP,SW1		;PROCESS CHARACTER
SWITCH:	PUSHJ	PP,TTYIN	;GET NEXT CHARACTER
	CAIE	C,")"		;END OF STRING?
	JRST	SWITC0		;NO
	JRST	GETIOC		;YES

SW0:	PUSHJ	PP,TTYIN
SW1:	MOVEI	C,-"A"(C)	;CONVERT FROM ASCII TO NUMERIC
	CAILE	C,"Z"-"A"	;WITHIN BOUNDS? (IS IT ALPHA?)
	JRST	ERRCM		;NO, ERROR
	MOVE	RC,[POINT 4,BYTAB]
	IBP	RC
	SOJGE	C,.-1		;MOVE TO PROPER BYTE
	LDB	C,RC		;PICK UP BYTE
	JUMPE	C,ERRCM		;TEST FOR VALID SWITCH
	CAIG	C,SWTABT-SWTAB	;LEGAL ON SOURCE?
	JUMPL	PP,ERRCM	;NO, TEST FOR SOURCE
	LDB	RC,[POINT 4,SWTAB-1(C),12]
	CAIN	RC,IO
	SKIPN	CTLSAV		;IF PASS2 OR IO SWITCH,
	XCT	SWTAB-1(C)	;EXECUTE INSTRUCTION
	POPJ	PP,		;EXIT
	TLZ	IO,IOSALL	;TAKE CARE OF /X
	POPJ	PP,

DEFINE HELP (TEXT)<
	XLIST
	ASCIZ ?TEXT?
	LIST>

HLPMES:	HELP <
Switches are :-
*/A advance one file
*/B backspace one file
/C produce a cref listing
*/E list macro expansions (LALL)
*/F list in new format (.MFRMT)
/G list in old format (.HWFRMT)
/H type this text
*/L reinstate listing (LIST)
/M suppress ascii in macro and repeat expansion (SALL)
*/N suppress error printout on tty
/O set MLOFF pseudo-op
/P increase size of the pushdown stack
/Q suppress Q errors on the listing
*/S suppress listing (XLIST)
*/T rewind device
*/X suppress all macro expansions (XALL)
*/Z zero the directory
Switches A,B,C,T,W,X, and Z must immediately follow
the device or file to which they refer.
>
	DEFINE	SETSW	(LETTER,INSTRUCTION) <	INSTRUCTION
J=	<"LETTER"-"A">-^D9*<I=<"LETTER"-"A">/^D9>
	SETCOD	\I,J>

	DEFINE	SETCOD		(I,J)
	<BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>

BYTAB0=	0			;INITIALIZE TABLE
BYTAB1=	0
BYTAB2=	0

SWTAB:
	SETSW	Z,<TLO	TIO,TIOCLD	>
	SETSW	C,<TLZ	FR,CREFSW	>
	SETSW	P,<SOS	PDP		>
SWTABT:				;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY
	SETSW	A,<ADDI	CS,1		>
	SETSW	B,<SUBI	CS,1		>
	SETSW	E,<TLZ	IO,IOPALL!IOSALL	>
	SETSW	H,<OUTSTR	HLPMES>
	SETSW	L,<TLZ	IO,IOMSTR	>
	SETSW	M,<TLO	IO,IOPALL!IOSALL	>
	SETSW	N,<HLLOS   TYPERR	>
	SETSW	O,<XCT	OFFML		>
	SETSW	Q,<TLO	FR,ERRQSW	>
	SETSW	S,<TLO	IO,IOMSTR	>
	SETSW	T,<TLO	TIO,TIOLE	>
	SETSW	W,<TLO	TIO,TIORW	>
	SETSW	X,<TLOA	IO,IOPALL	>

BYTAB:				;BYTAB CONTAINS AN INDEX TO SWTAB
				;IT CONSIST OF 9 4BIT BYTES/WORD
				;OR ONE BYTE FOR EACH LETTER

	+BYTAB0			;A-I	BYTE = 1 THROUGH 17 = INDEX
	+BYTAB1			;J-R	BYTE = 0 = COMMAND ERROR
	+BYTAB2			;S-Z

IF2,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2>
TTYIN:	SOSGE	CTIBUF+2	;ENUF CHAR.?
	JRST	TTYERR		;NO
	ILDB	C,CTIBUF+1	;GET CHARACTER
	CAIE	C," "		;SKIP BLANKS
	CAIN	C,HT		;AND TABS
	JRST	TTYIN
	CAIN	C,15		;CR?
	SETZM	CTIBUF+2	;YES,IGNORE REST OF LINE
	CAIG C,"Z"+40		;CHECK FOR LOWER CASE
	CAIGE C,"A"+40
	POPJ	PP,		;NO,EXIT
	SUBI C,40
	POPJ	PP,		;YES, EXIT

TTYERR:	SKIPN	INDEV		;INPUT DEVICE SEEN?
	JRST	ERRCM		;NO, SO MISSING "_"
ERRNE:	HRROI	RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]
ERRNE0:	SKPINC	V	;SEE IF WE CAN INPUT A CHAR.
	  JFCL		;BUT ONLY TO DEFEAT ^O
	PUSHJ PP,TYPMSG	;OUTPUT IT
	SKIPE LITLVL	;SEE IF IN LITERAL
	SKIPN	LITPG	;PAGE 0 MEANS NOT IN A LITERAL REALY
	JRST ERRNE1	;NO, TRY OTHERS
	MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG]
	PUSHJ PP,PRNUM	;GO PRINT INFORMATION
ERRNE1:	MOVEI V,0	;CHECK FOR OTHER PLACES
	SKIPE INDEF
	MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]
	SKIPE INTXT
	MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG]
	SKIPE INREP
	MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]
	SKIPE INCND
	MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]
	SKIPGE MACENL
ERRNE2:	MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]
	JUMPN V,ERRNE3
	SKIPN	LITLVL		;HAD ONE PAGE NUMBER ALREADY
	SKIPA	V,[XWD [SIXBIT /@/],PAGENO]	;BETTER THAN NOTHING
	JRST	.+2
ERRNE3:	PUSHJ PP,PRNUM
	HRROI RC,[SIXBIT /@/]	;WILL GET A RETURN
	JRST ERRFIN

ERRMS1:	SIXBIT / ERRORS DETECTED@/
ERRMS2:	SIXBIT /?1 ERROR DETECTED@/
ERRMS3:	SIXBIT /NO ERRORS DETECTED@/
EINIT:	MOVE	RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
	JRST	ERRFIN
ERRCL:	HRRZ	RC,LSTDIR+1	;GET LST DEV ERROR CODE
	JRST	.+2		;GET ERROR MESSAGE
ERRCB:	HRRZ	RC,BINDIR+1	;GET BIN DEV ERROR CODE
	JUMPN	RC,ERRTYP
	SOJA	RC,ERRTYP	;SPECIAL CASE IF ERROR CODE 0

ERRCF:	HRRZ	RC,INDIR+1	;GET INPUT DEV ERROR CODE
	HLLZ	ACEXT,INDIR+1	;SET UP EXT

ERRTYP:	CAIL	RC,TABLND-TABLE	;IS ERROR CODE LEGAL?
	SKIPA	RC,TABLND	;NO, GIVE CATCH ALL MESSAGE
	MOVE	RC,TABLE(RC)	;YES, PICK UP MESSAGE

ERRFIN:	SKPINC	C		;SEE IN WE CAN INPUT A CHAR.
	  JFCL			;BUT ONLY TO DEFEAT ^O
	PUSHJ	PP,CRLF
	MOVEI	C,"?"
	PUSHJ	PP,TYO
	PUSHJ	PP,TYPMS1
	CLOSE	LST,		;GIVE USER A PARTIAL LISTING
	CLOSE	BIN,40		;BUT NEVER A BUM REL FILE
IFN CCLSW,<AOS	JOBERR		;RECORD ERROR SO EXECUTION DELETED>
	JRST	M

	[SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE
TABLE:	[SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE
	[SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE
	[SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE
	[SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE
	[SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE
	[SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE
	[SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE
	[SIXBIT /(7) NOT A SAV FILE@/],,ACFILE
	[SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE
	[SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE
	[SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE
	[SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE
	[SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE
	[SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE
	[SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE
	[SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE
	[SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE
	[SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE
	[SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE
	[SIXBIT /(23) SFD NOT FOUND@/],,ACFILE
	[SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE
	[SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE
	[SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE

TABLND:	[SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE
TYPMSG:	PUSHJ	PP,CRLF		;MOVE TO NEXT LINE
TYPMS1:	HLRZ	CS,RC		;GET FIRST MESSAGE
	CAIE	CS,-1		;SKIP IF MINUS ONE
	PUSHJ	PP,TYPM2	;TYPE MESSAGE
	HRRZ	CS,RC		;GET SECOND HALF
	PUSHJ	PP,TYPM2

CRLF:	MOVEI	C,CR		;OUTPUT CARRIAGE RETURN
	PUSHJ	PP,TYO
	MOVEI	C,LF		;AND LINE FEED

TYO:	SOSG	CTOBUF+2	;BUFFER FULL?
	OUTPUT	CTL,0		;YES, DUMP IT
	IDPB	C,CTOBUF+1	;STORE BYTE
	CAIG	C,FF		;FORM FEED?
	CAIGE	C,LF		;V TAB OR LINE FEED?
	POPJ	PP,		;NO
	OUTPUT	CTL,0		;YES
	POPJ	PP,		;AND EXIT

TYPM2:	MOVSI	C,(1B0)		;ANTICIPATE REGISTER WORD
	CAIN	CS,ACFILE	;FILE NAME ?
	JRST	[JUMPE	ACEXT,.+1	;YES, TEST FOR EXT
		LSH	ACEXT,-6	;MAKE SPACE FOR "."
		IOR	ACEXT,[SIXBIT /.   @/]
		JRST	TYPM2A]
	CAIG	CS,17		;IS IT?
	MOVEM	C,1(CS)
TYPM2A:	HRLI	CS,(POINT 6,,)	;FORM BYTE POINTER

TYPM3:	ILDB	C,CS		;GET A SIXBIT BYTE
	CAIN	C,40		;"@"?
	JRST	TYO		;YES, TYPE SPACE AND EXIT
	ADDI	C,40		;NO, FORM 7-BIT ASCII
	PUSHJ	PP,TYO		;OUTPUT CHARACTER
	JRST	TYPM3

XCEEDS:	ADDI SX,2000		;ADJUST SYMBOL POINTER
XCEED:	PUSHJ	PP,SAVEXS	;SAVE THE REGISTERS
	HRRZ	1,JOBREL	;GET CURRENT TOP
	MOVEI	0,2000(1)
	CORE	0,		;REQUEST MORE CORE
	JRST	XCEED2		;ERROR, BOMB OUT
	HRRZ	2,JOBREL	;GET NEW TOP

XCEED1:	MOVE	0,0(1)		;GET ORIGIONAL
	MOVEM	0,0(2)		;STORE IN NEW LOCATION
	SUBI	2,1		;DECREMENT UPPER
	CAMLE	1,SYMBOL	;HAVE WE ARRIVED?
	SOJA	1,XCEED1	;NO, GET ANOTHER
	MOVEI	1,2000
	ADDM	1,SYMBOL
	ADDM	1,SYMTOP
	PUSHJ	PP,SRCHI	;RE-INITIALIZE SYMBOL TABLE
	JRST	RSTRXS		;RESTORE REGISTERS AND EXIT

XCEED2:	HRROI	RC,[SIXBIT /INSUFFICIENT CORE@/]
	JRST	ERRNE0
PDPERR:	HRROI	RC,[SIXBIT .PDP OVERFLOW, TRY /P@.]
	JRST	ERRNE0

PRNUM:	HLRZ CS,V	;GET MESSAGE
	PUSHJ PP,TYPM2
	MOVEI	CS,[SIXBIT /ON PAGE@/]
	PUSHJ	PP,TYPM2
	MOVE AC0,(V)	;GET PAGE
	PUSHJ PP,DP1	;PRINT NUMBER
	MOVEI C,40
	PUSHJ PP,TYO
	SKIPN AC1,1(V)	;GET SEQ NUM IF THERE
	POPJ PP,	;NO, RETURN
	MOVEM AC1,OUTSQ
	MOVEI	CS,[SIXBIT /LINE@/]
	PUSHJ	PP,TYPM2
	MOVEI AC0,OUTSQ	;PRINT IT
	OUTPUT CTL,0	;TO MAKE THINGS PRINT IN RIGHT ORDER
	DDTOUT AC0,
	MOVEI C,40
	JRST TYO	;AND RETURN

DP1:	IDIVI AC0,^D10
	HRLM AC1,(PP)
	JUMPE	AC0,.+2
	PUSHJ PP,DP1
	HLRZ C,(PP)
	ADDI C,"0"
	JRST TYO
RIM0:	TDO	FR,AC0		;SET RIM/RIM10 FLAG
	TLNE	FR,PNCHSW	;FORGET IT IF PUNCH RESET
	SETSTS	BIN,IB		;SET TO IMAGE BINARY MODE
	POPJ	PP,

ROUT:	EXCH CS,RIMLOC
	SUB PP,[XWD 1,1]	;CLEAR OUT STACK WFW
	TLNE FR,R1BSW
	JRST ROUT6
	TLNN	FR,RIM1SW
	JRST	ROUT1
	JUMPE	CS,ROUT1	;RIM10 OUTPUT
	SUB	CS,RIMLOC
	JUMPE	CS,ROUT1
	JUMPG	CS,ERRAX
	MOVEI	C,0
	PUSHJ	PP,PTPBIN
	AOJL	CS,.-1
ROUT1:	MOVSI	C,(DATAI PTR,)	;RIM OUTPUT
	HRR C,LOCO		;GET ADDRESS
	TLNE	FR,RIM1SW	;NO DATAI IF RIM10
	AOSA	RIMLOC
	PUSHJ	PP,PTPBIN	;OUTPUT
	MOVE	C,AC0		;CODE
	AOSA	LOCO		;INCREMENT CURRENT LOCATION

OUTBIN:	TLNN	FR,RIMSW!RIM1SW!R1BSW	;EXIT IF RIM MODE
PTPBIN:	TLNN	FR,PNCHSW	;EXIT IF PUNCH NOT REQUESTED
	POPJ	PP,
	SOSG	BINBUF+2	;TEST FOR BUFFER FULL
	PUSHJ	PP,DMPBIN	;YES, DUMP IT
	IDPB	C,BINBUF+1	;DEPOSIT BYTE
	POPJ	PP,		;EXIT

DMPBIN:	OUT	BIN,0		;DUMP THE BUFFER
	POPJ	PP,		;NO ERRORS
TSTBIN:	GETSTS	BIN,C		;GET STSTUS BITS
	TRNN	C,ERRBIT	;ERROR?
	POPJ	PP,		;NO, EXIT
	MOVE	AC0,BINDEV	;YES, GET TAG
	JRST	ERRLST		;TYPE MESSAGE AND ABORT

DMPLST:	OUT	LST,0		;OUTPUT BUFFER
	POPJ	PP,		;NO ERRORS
TSTLST:	GETSTS	LST,C		;ANY ERRORS?
	TRNN	C,ERRBIT
	POPJ	PP,		;NO, EXIT
	MOVE	AC0,LSTDEV
ERRLST:	MOVSI	RC,[SIXBIT /OUTPUT WRITE-LOCK ERROR DEVICE@/]
	TRNE	C,IOIMPM	;IMPROPER MODE?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /OUTPUT DATA ERROR DEVICE@/]
	TRNE	C,IODERR	;DEVICE DATA ERROR?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/]
	TRNE	C,IODTER	;IS IT
	JRST	ERRFIN		;YES
	MOVE	CS,AC0		;GET DEVICE
	DEVCHR	CS,		;FIND OUT WHAT IT IS
	MOVSI	RC,[SIXBIT /OUTPUT QUOTA EXCEEDED ON DEVICE@/]
	TLNN	CS,DSKBIT	;SKIP IF DSK OUTPUT
	MOVSI	RC,[SIXBIT /OUTPUT BLOCK TOO LARGE DEVICE@/]
	JRST	ERRFIN
	
R1BDMP:	SETCM CS,R1BCNT
	JUMPE CS,R1BI
	HRLZS C,CS
	HRR C,R1BLOC
	HRRI C,-1(C)
	MOVEM C,R1BCHK
	PUSHJ PP,PTPBIN
	HRRI CS,R1BBLK
R1BDM1:	MOVE C,0(CS)
	ADDM C,R1BCHK
	PUSHJ PP,PTPBIN
	AOBJN CS,R1BDM1
	MOVE C,R1BCHK
	PUSHJ PP,PTPBIN
R1BI:	SETOM R1BCNT
	PUSH PP,LOCO
	POP PP,R1BLOC
	POPJ PP,

ROUT6:	CAME CS,RIMLOC
	PUSHJ PP,R1BDMP
	AOS C,R1BCNT
	MOVEM AC0,R1BBLK(C)
	AOS LOCO
	CAIN C,.R1B-1
	PUSHJ PP,R1BDMP
	AOS RIMLOC
	POPJ PP,
	

READ0:	PUSHJ	PP,EOT		;END OF TAPE

READ:	SOSGE	IBUF+2		;BUFFER EMPTY?
	JRST	READ3		;YES
READ1:	ILDB	C,IBUF+1	;PLACE CHARACTER IN C
	MOVE CS,@IBUF+1		;CHECK FOR SEQUENCE NUMBER
	TRNN CS,1
	JRST READ1A
	CAIN CS,1		;CHECK FOR SPECIAL
	MOVE CS,[<ASCII/     />+1]
	MOVEM CS,SEQNO
	MOVEM CS,SEQNO2
	MOVNI CS,4
	ADDM CS,IBUF+2		;ADJUST WORD COUNT
REPEAT 4,<	IBP IBUF+1>	;SKIP SEQ NO
	PUSHJ PP,READ	;AND THE TAB
	JRST	READ		;GET NEXT CHARACTER

READ1A:	JUMPE	C,READ		;IGNORE NULL
	CAIN	C,32		;IF IT'S A "^Z"
	MOVEI	C,LF		;TREAT IT AS A "LF"
	CAIE	C,37		;CONTROL _
	POPJ	PP,
	MOVEI	C,"^"		;MAKE CONTROL-SHIFT _ VISIBLE
	PUSHJ	PP,RSW2
	MOVEI	C,"_"
	PUSHJ	PP,RSW2
READ2:	PUSHJ	PP,READ		;YES, TEST FOR LINE FEED
	PUSHJ	PP,RSW2		;LIST IN ANY EVENT
	CAIG	C,FF		;IS IT ONE OF
	CAIGE	C,LF		;LF, VT, OR FF?
	JRST	READ2		;NO
	PUSHJ	PP,OUTIM1	;YES, DUMP THE LINE
	JRST	READ		;RETURN NEXT CHARACTER

READ3:	IN	CHAR,0		;GET NEXT BUFFER
	JRST	READ		;NO ERRORS
	GETSTS	CHAR,C
	TRNN	C,ERRBIT!2000	;ERRORS?
	JRST	READ0		;EOF
	MOVE	AC0,INDEV
	MOVSI	RC,[SIXBIT/ INPUT PHYSICAL END OF TAPE DEVICE@/]
	TRNE	C,2000
	JRST	ERRFIN		;E-O-T
	MOVSI	RC,[SIXBIT /MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/]
	TRNE	C,IOIMPM	;IMPROPER MODE?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /INPUT DATA ERROR DEVICE@/]
	TRNE	C,IODERR	;DEVICE DATA ERROR?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /INPUT CHECKSUM OR PARITY ERROR DEVICE@/]
	TRNN	C,IODTER
	MOVSI	RC,[SIXBIT /INPUT BLOCK TOO LARGE DEVICE@/]
	JRST	ERRFIN

OUTAB2:	PUSHJ	PP,OUTTAB	;PRINT TWO TABS
OUTTAB:	MOVEI	C,HT
PRINT:	CAIE	C,CR		;IS THIS A CR?
	CAIN	C,LF		;OR LF?
	JRST	OUTCR		;YES, GO PROCESS
	CAIN	C,FF		;FORM FEED?
	JRST	OUTFF		;YES, FORCE NEW PAGE
	JRST	OUTL

OUTCR:	TRNN	ER,ERRORS!LPTSW!TTYSW
	POPJ	PP,
	MOVEI	C,CR		;CARRIAGE RETURN, LINE FEED
	PUSHJ	PP,OUTL
	SOSGE	LPP		;END OF PAGE?
	TLO	IO,IOPAGE	;YES, SET FLAG
	TRCA	C,7		;FORM LINE FEED AND SKIP

OUTL:	TLZN	IO,IOPAGE	;NEW PAGE REQUESTED?
	JRST	OUTC		;NO
	JUMP1	OUTC		;YES, BYPASS IF PASS ONE
	PUSH	PP,C		;SAVE C AND CS
	PUSH	PP,CS
	PUSH	PP,ER
	TLNN	IO,IOMSTR!IOPROG
	HRR	ER,OUTSW
	TLNE	IO,IOCREF	;IF DOING CREF OUTPUT NOW
	TLNE	FR,CREFSW	;AND CREFFING (JUST IN CASE)
	JRST	.+2
	PUSHJ	PP,CLSC3	;CLOSE IT OUT
	HLLM	IO,(PP)		;SAVE THIS NEW STATE OF IO
	MOVEI	C,.LPP
	MOVEM	C,LPP		;SET NEW COUNTER
	MOVEI	C,CR
	PUSHJ	PP,OUTC
	MOVEI	C,FF
	PUSHJ	PP,OUTC		;OUTPUT FORM FEED
	MOVEI	CS,TBUF
	PUSHJ	PP,OUTAS0	;OUTPUT TITLE
;	MOVEI	CS,VBUF
;	PUSHJ	PP,OUTAS0	;OUTPUT VERSION
	MOVEI	CS,DBUF
	PUSHJ	PP,OUTAS0	; AND DATE
	MOVE	C,PAGENO
	PUSHJ	PP,DNC		;OUTPUT PAGE NUMBER
	AOSG	PAGEN.		;FIRST PAGE OF THIS NUMBER?
	JRST	OUTL1		;YES
	MOVEI	C,"-"		;NO, PUT OUT MODIFIER
	PUSHJ	PP,OUTC
	MOVE	C,PAGEN.
	PUSHJ	PP,DNC
OUTL1:	PUSHJ	PP,OUTCR
	MOVEI CS,DEVBUF
	PUSHJ PP,OUTAS0
	HRRZ	CS,SUBTTX	;SWITCH FOR SUB-TITLE
	SKIPE	0(CS)		;IS THERE A SUB-TITLE?
	PUSHJ	PP,OUTTAB	;YES, OUTPUT A TAB
	PUSHJ	PP,SOUT20	;OUTPUT ASCII WITH CARRIAGE RETURN
	PUSHJ	PP,OUTCR
	POP	PP,ER
	POP	PP,CS		;RESTORE REGISTERS
	POP	PP,C

OUTC:	TRNE	ER,ERRORS!TTYSW
	PUSHJ	PP,TYO
	TRNN	ER,LPTSW
	POPJ	PP,
OUTLST:	SOSG	LSTBUF+2	;BUFFER FULL?
	PUSHJ	PP,DMPLST	;YES, DUMP IT
COMMENT $ REG DOESN'T LIKE THIS FEATURE ANY MORE 9-5-72
$
	IDPB	C,LSTBUF+1	;STORE BYTE
	POPJ	PP,		;EXIT

PAGE0:	PUSHJ	PP,STOUTS	;PAGE PSEUDO-OP
OUTFF1:	TLNE	IO,IOCREF	;CURRENTLY DOING CREF?
	TLNE	IO,IOPROG	;AND NOT XLISTED?
	JRST	OUTFF		;NO
	HRR	ER,OUTSW
	PUSHJ	PP,CLSCRF
	PUSHJ	PP,OUTCR
	HRRI	ER,0
OUTFF:	TLO	IO,IOPAGE
OUTFF2:	SETOM	PAGEN.
	AOS	PAGENO
	POPJ	PP,

TIMOUT:	IDIVI	2,^D60*^D1000
TIMOU1:	IDIVI	2,^D60
	PUSH	PP,3		;SAVE MINUTES
	PUSHJ	PP,OTOD		;STORE HOURS
	MOVEI	3,":"		;SEPARATE BY COLON
	IDPB	3,CS
	POP	PP,2		;STORE MINUTES
OTOD:	IDIVI	2,^D10
	ADDI	2,60		;FORM ASCII
	IDPB	2,CS
	ADDI	3,60
	IDPB	3,CS
	POPJ	PP,

DATOUT:	IDIVI	1,^D31		;GET DAY
	ADDI	2,1
	CAIG	2,^D9		;TWO DIGITS?
	ADDI	2,7760*^D10	;NO, PUT IN SPACE
	PUSHJ	PP,OTOD		;STORE DAY
	IDIVI	1,^D12		;GET MONTH
	MOVE	2,DTAB(2)	;GET MNEMONIC
	IDPB	2,CS		;DEPOSIT RIGHT MOST 7 BITS
	LSH	2,-7		;SHIFT NEXT IN
	JUMPN	2,.-2		;DEPOSIT IFIT EXISTS
	MOVEI	2,^D64(1)	;GET YEAR
	JRST	OTOD		;STORE IT

DTAB:	"-NAJ-"
	"-BEF-"
	"-RAM-"
	"-RPA-"
	"-YAM-"
	"-NUJ-"
	"-LUJ-"
	"-GUA-"
	"-PES-"
	"-TCO-"
	"-VON-"
	"-CED-"
SUBTTL	MACHINE INSTRUCTION SEARCH ROUTINES
IFE OPHSH,<
OPTSCH:	MOVEI	RC,0
	MOVEI	ARG,1B^L<OP1END-OP1TOP>	;SET UP INDEX
	MOVEI	V,1B^L<OP1END-OP1TOP>/2	;SET UP INCREMENT

OPT1A:	CAMN	AC0,OP1TOP(ARG)	;ARE WE POINTING AT SYMBOL?
	JRST	OPT1D		;YES, GET THE CODE
	JUMPE	V,POPOUT	;TEST FOR END
	CAML	AC0,OP1TOP(ARG)	;NO, SHOULD WE MOVE DOWN?
	TDOA	ARG,V		;NO, INCREMENT
OPT1B:	SUB	ARG,V		;YES, DECREMENT
	ASH	V,-1		;HALVE INCREMENT
	CAIG	ARG,OP1END-OP1TOP	;ARE WE OUT OF BOUNDS?
	JRST	OPT1A		;NO, TRY AGAIN
	JRST	OPT1B		;YES, BRING IT DOWN A PEG
>

IFN OPHSH,<
OPTSCH:	MOVE	ARG,AC0		;GET SIXBIT NAME
	TLZ	ARG,400000	;CLEAR SIGN BIT
	IDIVI	ARG,PRIME	;REM. GOES IN V
	CAMN	AC0,OP1TOP(V)	;ARE WE POINTING AT SYMBOL?
	JRST	OPT1D		;YES
	SKIPN	OP1TOP(V)	;TEST FOR END
	POPJ	PP,		;SYMBOL NOT FOUND
	HLRZ	RC,ARG		;SAVE LHS OF QUOTIENT
	SKIPA	ARG,RC		;GET IT BACK
OPT1A:	ADDI	ARG,(RC)	;INCREMENT ARG
	ADDI	V,(ARG)		;QUADRATIC INCREASE TO V
	CAIL	V,PRIME		;V IS MODULO PRIME
	JRST	[SUBI	V,PRIME
		JRST	.-1]
	CAMN	AC0,OP1TOP(V)	;IS THIS IT?
	JRST	OPT1D		;YES
	SKIPE	OP1TOP(V)	;END?
	JRST	OPT1A		;TRY AGAIN
	POPJ	PP,		;FAILED
>
OPT1D:
IFN OPHSH,<	SETZ	RC,	;CLEAR RELOCATION
	MOVE	ARG,V		;GET INDEX IN RIGHT ACC.>
	IDIVI	ARG,4		;ARG HAS INDEX USED IN OPTTAB
	LDB	V,OPTTAB(V)	;V HAS INDEX TO OPTTAB
	CAIL	V,700		;PSEUDO-OP OR IO INSTRUCTION?
	JRST	OPT1G		;YES
	ROT	V,-^D9		;LEFT JUSTIFY
	HRRI	V,OP		;POINT TO BASIC FORMAT
OPT1F:	AOS	0(PP)		;SET FOR SKIP EXIT
	MOVEI	SDEL,%OP	;SET OP-CODE CROSS-REF FLAG
	JRST	CREF		;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE

OPT1G:	JUMPG	AC0,.+3		;IF ".","$",OR "%" USE TABLE 1
	TLNN	AC0,200000	;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE
	SKIPA	V,OP2TAB-700(V)	;2ND TABLE, FIRST LETTER IS "A" TO "O"
	MOVE	V,OP1TAB-700(V)	;1ST TABLE, ..."P" TO "Z"
	JRST	OPT1F		;EXIT

OPTTAB:
IFE OPHSH,<	POINT	9,OP1COD-1(ARG),35>
	POINT	9,OP1COD  (ARG), 8
	POINT	9,OP1COD  (ARG),17
	POINT	9,OP1COD  (ARG),26
IFN OPHSH,<	POINT	9,OP1COD  (ARG),35>

IFDEF .XCREF,<	.XCREF	;DON'T CREF THIS MESS>
IFE OPHSH,<
	RELOC	.-1
OP1TOP:
	RELOC

	IF1,<N1=0
	DEFINE	X  <N1=N1+1 ;>>

	IF2, <
	N2=^D36
	CC=0
	RELOC	OP1COD
	RELOC
DEFINE	X (SYMBOL,CODE) 
<SIXBIT /SYMBOL/
CC=CC+CODE_<N2=N2-9>
IFE N2, <OUTLIT>>

DEFINE	OUTLIT	<
	RELOC
	+CC
	RELOC
N2=^D36+<CC=0>>>
	SYN X,XX		;JUST THE SAME MACRO>

IFN OPHSH,<
DEFINE XX (SB,CD)<>		;A NUL MACRO
OP1TOP:	IF1,<	BLOCK PRIME>
IF1,<DEFINE X (SB,CD)<>>
IF2,<
DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE_<9*<3-R&3>>>>

DEFINE X (SB,CD)<
SXB=<SIXBIT /SB/>
Q=SXB&-1_-1/PRIME
R=SXB&-1_-1-Q*PRIME
H=Q_-22&777
TRY=1
OPCODE=CD
ITEM Q,\R
IFL PRIME-TRY,<PRINTX HASH FAILURE>>

DEFINE ITEM (QT,RM)<
IFN .%'RM,<R=R+H
IFL PRIME-R,<R=R-R/PRIME*PRIME>
H=H+Q_-22&777
IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>
IFE .%'RM,<.%'RM=SXB
OPSTOR \<R/4>>>>
IF1,<
DEFINE GETSYM (N)<.%'N=0>

N=0
	XLIST
REPEAT PRIME,<GETSYM \N
N=N+1>
DEFINE GETSYM (N)<.$'N=0>
N=0
REPEAT <PRIME/4+1>,<GETSYM \N
N=N+1>
>
	LIST>

IFN OPHSH,<		;PUT THE MOST USED OP CODES FIRST
X	JRST  ,	254
X	PUSHJ , 260
X	POPJ  , 263
X	PUSH  , 261
X	POP   , 262
X	AOS   ,	350
X	ASCIZ ,	701
X	CALLI ,	047
X	EXTERN,	724
X	INTERN,	744
X	JFCL  ,	255
X	JSP   ,	265
X	MOVE  ,	200
X	MOVEI ,	201
X	MOVEM ,	202
X	SETZM ,	402
X	SIXBIT,	717
X	SOS   ,	370
X	TLNE  ,	603
X	TLNN  ,	607
X	TLO   ,	661
X	TLZ   ,	621
X	TLZA  ,	625
X	TLZE  ,	623
X	TLZN  ,	627
X	TRNE  ,	602
X	TRNN  ,	606
X	TRZ   ,	620
>
X	ADD   ,	270
X	ADDB  ,	273
X	ADDI  ,	271
X	ADDM  ,	272

X	AND   ,	404
X	ANDB  ,	407
X	ANDCA ,	410
X	ANDCAB,	413
X	ANDCAI,	411
X	ANDCAM,	412
X	ANDCB ,	440
X	ANDCBB,	443
X	ANDCBI,	441
X	ANDCBM,	442
X	ANDCM ,	420
X	ANDCMB,	423
X	ANDCMI,	421
X	ANDCMM,	422
X	ANDI  ,	405
X	ANDM  ,	406

X	AOBJN ,	253
X	AOBJP ,	252

X	AOJ   ,	340
X	AOJA  ,	344
X	AOJE  ,	342
X	AOJG  ,	347
X	AOJGE ,	345
X	AOJL  ,	341
X	AOJLE ,	343
X	AOJN  ,	346

XX	AOS   ,	350
X	AOSA  ,	354
X	AOSE  ,	352
X	AOSG  ,	357
X	AOSGE ,	355
X	AOSL  ,	351
X	AOSLE ,	353
X	AOSN  ,	356
X	ARG   , 320
IFN IIISW,<X	ASCID , 771>
X	ASCII ,	700
XX	ASCIZ ,	701

X	ASH   ,	240
X	ASHC  ,	244

X	ASUPPR,	705
X	BLKI  ,	702
X	BLKO  ,	703
X	BLOCK ,	704

X	BLT   ,	251

X	BYTE  ,	707

XX	CAI   ,	300
X	CAIA  ,	304
X	CAIE  ,	302
X	CAIG  ,	307
X	CAIGE ,	305
X	CAIL  ,	301
X	CAILE ,	303
X	CAIN  ,	306

X	CALL  ,	040
XX	CALLI ,	047

XX	CAM   ,	310
X	CAMA  ,	314
X	CAME  ,	312
X	CAMG  ,	317
X	CAMGE ,	315
X	CAML  ,	311
X	CAMLE ,	313
X	CAMN  ,	316

XX	CLEAR ,	400
XX	CLEARB,	403
XX	CLEARI,	401
XX	CLEARM,	402

X	CLOSE ,	070
X	COMMEN, 770


X	CONI  ,	710
X	CONO  ,	711
X	CONSO ,	712
X	CONSZ ,	713

XX	DATA. ,	020

X	DATAI ,	714
X	DATAO ,	715
X	DEC   ,	716
X	DEFINE,	717
X	DEPHAS,	720

X	DFN   ,	131

X	DIV   ,	234
X	DIVB  ,	237
X	DIVI  ,	235
X	DIVM  ,	236


X	DPB   ,	137
X	DPBI  ,	136

X	END   ,	721

X	ENTER ,	077

X	ENTRY ,	722

X	EQV   ,	444
X	EQVB  ,	447
X	EQVI  ,	445
X	EQVM  ,	446

X	EXCH  ,	250

X	EXP   ,	723
XX	EXTERN,	724

X	FAD   ,	140
X	FADB  ,	143
X	FADL  ,	141
X	FADM  ,	142

X	FADR  ,	144
X	FADRB ,	147
X	FADRI ,	145
X	FADRM ,	146

X	FDV   ,	170
X	FDVB  ,	173
X	FDVL  ,	171
X	FDVM  ,	172

X	FDVR  ,	174
X	FDVRB ,	177
X	FDVRI ,	175
X	FDVRM ,	176

XX	FIN.  ,	021


X	FMP   ,	160
X	FMPB  ,	163
X	FMPL  ,	161
X	FMPM  ,	162

X	FMPR  ,	164
X	FMPRB ,	167
X	FMPRI ,	165
X	FMPRM ,	166

X	FSB   ,	150
X	FSBB  ,	153
X	FSBL  ,	151
X	FSBM  ,	152

X	FSBR  ,	154
X	FSBRB ,	157
X	FSBRI ,	155
X	FSBRM ,	156

X	FSC   ,	132

X	GETSTS,	062

X	HALT  ,	725
X	HISEG ,	706

X	HLL   ,	500
X	HLLE  ,	530
X	HLLEI ,	531
X	HLLEM ,	532
X	HLLES ,	533
X	HLLI  ,	501
X	HLLM  ,	502
X	HLLO  ,	520
X	HLLOI ,	521
X	HLLOM ,	522
X	HLLOS ,	523
X	HLLS  ,	503
X	HLLZ  ,	510
X	HLLZI ,	511
X	HLLZM ,	512
X	HLLZS ,	513

X	HLR   ,	544
X	HLRE  ,	574
X	HLREI ,	575
X	HLREM ,	576
X	HLRES ,	577
X	HLRI  ,	545
X	HLRM  ,	546
X	HLRO  ,	564
X	HLROI ,	565
X	HLROM ,	566
X	HLROS ,	567
X	HLRS  ,	547
X	HLRZ  ,	554
X	HLRZI ,	555
X	HLRZM ,	556
X	HLRZS ,	557

X	HRL   ,	504
X	HRLE  ,	534
X	HRLEI ,	535
X	HRLEM ,	536
X	HRLES ,	537
X	HRLI  ,	505
X	HRLM  ,	506
X	HRLO  ,	524
X	HRLOI ,	525
X	HRLOM ,	526
X	HRLOS ,	527
X	HRLS  ,	507
X	HRLZ  ,	514
X	HRLZI ,	515
X	HRLZM ,	516
X	HRLZS ,	517

X	HRR   ,	540
X	HRRE  ,	570
X	HRREI ,	571
X	HRREM ,	572
X	HRRES ,	573
X	HRRI  ,	541
X	HRRM  ,	542
X	HRRO  ,	560
X	HRROI ,	561
X	HRROM ,	562
X	HRROS ,	563
X	HRRS  ,	543
X	HRRZ  ,	550
X	HRRZI ,	551
X	HRRZM ,	552
X	HRRZS ,	553

X	IBP   ,	133

X	IDIV  ,	230
X	IDIVB ,	233
X	IDIVI ,	231
X	IDIVM ,	232

X	IDPB  ,	136

X	IF1   ,	726
X	IF2   ,	727
X	IFB   ,	730
X	IFDEF ,	731
X	IFDIF ,	732
X	IFE   ,	733
X	IFG   ,	734
X	IFGE  ,	735
X	IFIDN ,	736
X	IFL   ,	737
X	IFLE  ,	740
X	IFN   ,	741
X	IFNB  ,	742
X	IFNDEF,	743

X	ILDB  ,	134

X	IMUL  ,	220
X	IMULB ,	223
X	IMULI ,	221
X	IMULM ,	222

X	IN    ,	056
XX	IN.   ,	016
X	INBUF ,	064
XX	INF.  ,	026
X	INIT  ,	041
X	INPUT ,	066

XX	INTERN,	744

X	IOR   ,	434
X	IORB  ,	437
X	IORI  ,	435
X	IORM  ,	436


X	IOWD  ,	745
X	IRP   ,	746
X	IRPC  ,	747
X	JCRY  ,	750
X	JCRY0 ,	751
X	JCRY1 ,	752
X	JEN   ,	753

XX	JFCL  ,	255

X	JFFO  , 243
X	JFOV  ,	765
X	JOV   ,	754

X	JRA   ,	267
XX	JRST  ,	254

X	JRSTF ,	755

X	JSA   ,	266
XX	JSP   ,	265
X	JSR   ,	264

XX	JUMP  ,	320
XX	JUMPA ,	324
X	JUMPE ,	322
X	JUMPG ,	327
X	JUMPGE,	325
X	JUMPL ,	321
X	JUMPLE,	323
X	JUMPN ,	326

X	LALL  ,	756

X	LDB   ,	135
X	LDBI  ,	134


X	LIST  ,	757
X	LIT   ,	760
X	LOC   ,	761

X	LOOKUP,	076

X	LSH   ,	242
X	LSHC  ,	246
X	MLOFF , 767
X	MLON  , 766
XX	MOVE  ,	200
XX	MOVEI ,	201
XX	MOVEM ,	202
X	MOVES ,	203
X	MOVM  ,	214
X	MOVMI ,	215
X	MOVMM ,	216
X	MOVMS ,	217
X	MOVN  ,	210
X	MOVNI ,	211
X	MOVNM ,	212
X	MOVNS ,	213
X	MOVS  ,	204
X	MOVSI ,	205
X	MOVSM ,	206
X	MOVSS ,	207


X	MTAPE ,	072
XX	MTOP. , 024

X	MUL   ,	224
X	MULB  ,	227
X	MULI  ,	225
X	MULM  ,	226
XX	NLI.  , 031
XX	NLO.  , 032

X	NOSYM ,	762

X	OCT   ,	763
X	OPDEF ,	764

X	OPEN  ,	050

X	OR    ,	434
X	ORB   ,	437
X	ORCA  ,	454
X	ORCAB ,	457
X	ORCAI ,	455
X	ORCAM ,	456
X	ORCB  ,	470
X	ORCBB ,	473

X	ORCBI ,	471
X	ORCBM ,	472
X	ORCM  ,	464
X	ORCMB ,	467
X	ORCMI ,	465
X	ORCMM ,	466
X	ORI   ,	435
X	ORM   ,	436

X	OUT   ,	057
XX	OUT.  ,	017
X	OUTBUF,	065
XX	OUTF. ,	027
X	OUTPUT,	067

X	PAGE  ,	700
X	PASS2 ,	701
X	PHASE ,	702
X	POINT ,	703

XX	POP   ,	262
XX	POPJ  ,	263

X	PRGEND, 714
X	PRINTX,	704
X	PURGE ,	705

XX	PUSH  ,	261
XX	PUSHJ ,	260

X	RADIX ,	706
X	RADIX5,	707

X	RELEAS,	071

X	RELOC ,	710
X	REMARK,	711

X	RENAME,	055

X	REPEAT,	712

XX	RESET.,	015
X	RIM   ,	715
X	RIM10 ,	735
X	RIM10B, 736

X	ROT   ,	241
X	ROTC  ,	245

X	RSW   ,	716
XX	RTB.  ,	022
X	SALL  , 720
IFN UNIVR,<X	SEARCH, 721>

X	SETA  ,	424
X	SETAB ,	427
X	SETAI ,	425
X	SETAM ,	426
X	SETCA ,	450
X	SETCAB,	453
X	SETCAI,	451
X	SETCAM,	452
X	SETCM ,	460
X	SETCMB,	463
X	SETCMI,	461
X	SETCMM,	462
X	SETM  ,	414
X	SETMB ,	417
X	SETMI ,	415
X	SETMM ,	416
X	SETO  ,	474
X	SETOB ,	477
X	SETOI ,	475
X	SETOM ,	476
X	SETSTS,	060
X	SETZ  ,	400
X	SETZB ,	403
X	SETZI ,	401
XX	SETZM ,	402

XX	SIXBIT,	717

XX	SKIP  ,	330
X	SKIPA ,	334
X	SKIPE ,	332
X	SKIPG ,	337
X	SKIPGE,	335
X	SKIPL ,	331
X	SKIPLE,	333
X	SKIPN ,	336

XX	SLIST.,	025

X	SOJ   ,	360
X	SOJA  ,	364
X	SOJE  ,	362
X	SOJG  ,	367
X	SOJGE ,	365
X	SOJL  ,	361
X	SOJLE ,	363
X	SOJN  ,	366

XX	SOS   ,	370
X	SOSA  ,	374
X	SOSE  ,	372
X	SOSG  ,	377
X	SOSGE ,	375
X	SOSL  ,	371
X	SOSLE ,	373
X	SOSN  ,	376

X	SQUOZE,	707

X	STATO ,	061
X	STATUS,	062
X	STATZ ,	063

X	STOPI ,	722

X	SUB   ,	274
X	SUBB  ,	277
X	SUBI  ,	275
X	SUBM  ,	276

IF2,<IFE OPHSH,<SUBTL:>>
X	SUBTTL,	723
X	SUPPRE,	713
X	SYN   ,	724
X	TAPE  ,	725

X	TDC   ,	650
X	TDCA  ,	654
X	TDCE  ,	652
X	TDCN  ,	656
X	TDN   ,	610
X	TDNA  ,	614
X	TDNE  ,	612
X	TDNN  ,	616
X	TDO   ,	670
X	TDOA  ,	674
X	TDOE  ,	672
X	TDON  ,	676
X	TDZ   ,	630
X	TDZA  ,	634
X	TDZE  ,	632
X	TDZN  ,	636

X	TITLE ,	726

X	TLC   ,	641
X	TLCA  ,	645
X	TLCE  ,	643
X	TLCN  ,	647
X	TLN   ,	601
X	TLNA  ,	605
XX	TLNE  ,	603
XX	TLNN  ,	607
XX	TLO   ,	661
X	TLOA  ,	665
X	TLOE  ,	663
X	TLON  ,	667
XX	TLZ   ,	621
XX	TLZA  ,	625
XX	TLZE  ,	623
XX	TLZN  ,	627

X	TRC   ,	640
X	TRCA  ,	644
X	TRCE  ,	642
X	TRCN  ,	646
X	TRN   ,	600
X	TRNA  ,	604
XX	TRNE  ,	602
XX	TRNN  ,	606
X	TRO   ,	660
X	TROA  ,	664
X	TROE  ,	662
X	TRON  ,	666
XX	TRZ   ,	620
X	TRZA  ,	624
X	TRZE  ,	622
X	TRZN  ,	626

X	TSC   ,	651
X	TSCA  ,	655
X	TSCE  ,	653
X	TSCN  ,	657
X	TSN   ,	611
X	TSNA  ,	615
X	TSNE  ,	613

X	TSNN  ,	617
X	TSO   ,	671
X	TSOA  ,	675
X	TSOE  ,	673
X	TSON  ,	677
X	TSZ   ,	631
X	TSZA  ,	635
X	TSZE  ,	633
X	TSZN  ,	637
X	TTCALL, 051
X	TWOSEG, 731
X	UFA   ,	130
X	UGETF ,	073
X	UJEN  , 100
IFN UNIVR,<X	UNIVER, 737>
X	USETI ,	074
X	USETO ,	075

X	VAR   ,	727

XX	WTB.  ,	023

X	XALL  ,	732

X	XCT   ,	256

X	XLIST ,	733

X	XOR   ,	430
X	XORB  ,	433
X	XORI  ,	431
X	XORM  ,	432

X	XPUNGE, 730
X	XWD   ,	734

X	Z     ,	000

X	.CREF , 740
X	.HWFRM, 742
X	.MFRMT, 743
X	.XCREF, 741


IFN OPHSH,<		;NO-OPS, OLD MNEMONICS,F4 UUOS
X	CAI   ,	300
X	CAM   ,	310
X	CLEAR ,	400
X	CLEARB,	403
X	CLEARI,	401
X	CLEARM,	402
X	JUMP  ,	320
X	JUMPA ,	324
X	SKIP  ,	330
X	RESET.,	015
X	IN.   ,	016
X	OUT.  ,	017
X	DATA. ,	020
X	FIN.  ,	021
X	RTB.  ,	022
X	WTB.  ,	023
X	MTOP. , 024
X	SLIST., 025
X	INF.  , 026
X	OUTF. ,	027
X	NLI.  , 031
X	NLO.  , 032
>
IFE OPHSH,<
IF1, <	BLOCK	N1>
OP1END:	-1B36
OP1COD:	BLOCK	N1/4
	CC>
IFN OPHSH,<
IF2,<
DEFINE SETVAL (N)<EXP	.%'N
PURGE .%'N>
N=0
XLIST
REPEAT PRIME,<SETVAL \N
N=N+1>
LIST
>
OP1COD:	IF1,<	BLOCK <PRIME/4+1>>
IF2,<
DEFINE SETVAL (N)<EXP	.$'N
PURGE .$'N>
N=0
XLIST
REPEAT <PRIME/4+1>,<SETVAL	\N
N=N+1>
>
LIST>

IFDEF .CREF,<	.CREF	;START CREFFING AGAIN>
SUBTTL	PERMANENT SYMBOLS
SYMNUM:	EXP	LENGTH/2	;NUMBER OF PERMANENT SYMBOLS
DEFINE	P	(A,B)<
	SIXBIT	/A/
	XWD	SYMF!NOOUTF,B>

P	@,	0(SUPRBT)
P	??????,	0(SUPRBT)

LENGTH= .-SYMNUM-1			;LENGTH OF INITIAL SYMBOLS

PRMTBL:			;PERMANENT SYMBOLS
P	ADC,	24
P	APR,	0
P	CCI,	14
P	CDP,	110
P	CDR,	114
P	CPA,	0
P	CR,	150
P	DC,	200
P	DCSA,	300
P	DCSB,	304
P	DF,	270
P	DIS,	130
P	DLS,	240
P	DPC,	250
P	DSK,	170
P	DTC,	320
P	DTS,	324
P	LPT,	124
P	MDF,	260
P	MTC,	220
P	MTM,	230
P	MTS,	224
P	PAG,	10
P	PI,	4
P	PLT,	140
P	PTP,	100
P	PTR,	104

P	TMC,	340
P	TMS,	344
P	TTY,	120
P	UTC,	210
P	UTS,	214
IFE LNSSW,<	XLIST	>
IFN LNSSW,<	;SPECIAL DEVICES FOR PEPR
P .A,550
P .AB,434
P .ANG,440
P .B,554
P .BITE,470
P .FA,564
P .GAIN,520
P .GATE,444
P .IA,560
P .INC,514
P .LC,474
P .LG,570
P .PEPR,400
P .RG,574
P .SCON,430
P .STAT,410
P .TC,500
P .TED,540
P .THR,544
P .TRK,404
P .VIEW,524>
	LIST
PRMEND:				;END OF PERMANENT SYMBOLS

	OPDEF	ZL	[Z	LITF]	;INVALID IN LITERALS
	OPDEF	ZA	[Z	ADDF]	;INVALID IN ADDRESSES
	OPDEF	ZAL	[Z	ADDF!LITF]

OP1TAB:

	ZA	PAGE0			;PAGE
	ZAL	PASS20			;PASS2
	ZAL	PHASE0			;PHASE
	Z	POINT0			;POINT
	ZA	PRNTX0			;PRINTX
	ZA	PURGE0			;PURGE
	ZA	RADIX0			;RADIX
	Z	RADX50			;RADIX50,SQUOZE
	ZAL	LOC0	(1)		;RELOC
	ZAL	REMAR0			;REMARK
	ZA	REPEA0			;REPEAT
	ZA	SUPRE0			;SUPRESS
	ZAL	PSEND0			;PRGEND
	ZAL	RIM0	(RIMSW)		;RIM
	DATAI	0,IOP			;RSW
	Z	ASCII0	(1)		;SIXBIT
	ZAL	IOSET	(IOPALL!IOSALL)	;SALL
IFN UNIVR,<	ZAL	SERCH0			;SEARCH>
IFE UNIVR,<	Z	0>
	ZA	STOPI0			;STOPI
	ZA	SUBTT0	(Z (POINT 7,,))	;SUBTTL
	ZA	SYN0			;SYN
	ZAL	TAPE0			;TAPE
	ZA	TITLE0	(Z (POINT 7,,))	;TITLE
	ZAL	VAR0			;VAR

	Z	XPUNG0			;XPUNGE
	ZAL	TWSEG0			;TWOSEGMENTS
	ZAL	XALL0	(IOPALL)	;XALL
	ZAL	IOSET	(IOPROG)	;XLIST
	Z	XWD0			;XWD
	ZAL	RIM0	(RIM1SW)	;RIM10
	ZAL	RIM0	(R1BSW)		;RIM10B
IFN UNIVR,<	ZA	UNIV0	(Z (POINT 7,,))	;UNIVERSAL>
IFE UNIVR,<	Z	0	;UNIVERSAL>
	ZAL	IORSET	(IONCRF)	;.CREF
	ZAL	IOSET	(IONCRF)	;.XCREF
	ZA	OFFORM			;.HWFRMT
	ZA	ONFORM			;.MFRMT
OP2TAB:

	Z	ASCII0	(0)		;ASCII
	Z	ASCII0	(1B18)		;ASCIZ
	BLKI	IOP			;BLKI
	BLKO	IOP			;BLKO
	ZAL	BLOCK0			;BLOCK
	ZA	SUPRSA			;ASUPPRESS
	ZAL	HISEG0			;HISEG
	Z	BYTE0			;BYTE
	CONI	IOP			;CONI
	CONO	IOP			;CONO
	CONSO	IOP			;CONSO
	CONSZ	IOP			;CONSZ
	DATAI	IOP			;DATAI
	DATAO	IOP			;DATAO
	Z	OCT0	(^D10)		;DEC
	ZA	DEFIN0			;DEFINE

	ZAL	DEPHA0			;DEPHASE
	ZAL	END0			;END
	ZA	INTER0	(INTF!ENTF)	;ENTRY
	Z	EXPRES			;EXP
	ZA	EXTER0			;EXTERN
	JRST	4,OP			;HALT
	TLNN	FR,IFPASS		;IF1
	TLNE	FR,IFPASS		;IF2

	TRNE	AC0,IFB0		;IFB
	TLNE	ARG,IFDEF0		;IFDEF
	Z	IFIDN0	(0)		;IFDIF
	SKIPE	IF			;IFE
	SKIPG	IF			;IFG
	SKIPGE	IF			;IFGE
	Z	IFIDN0	(1)		;IFIDN
	SKIPL	IF			;IFL

	SKIPLE	IF			;IFLE
	SKIPN	IF			;IFN
	TRNN	AC0,IFB0		;IFNB
	TLNN	ARG,IFDEF0		;IFNDEF
	ZA	INTER0	(INTF)		;INTERN
	Z	IOWD0			;IOWD
	Z	IRP0	(0)		;IRP
	Z	IRP0	(400000)	;IRPC

	JFCL	6,OP			;JCRY
	JFCL	4,OP			;JCRY0
	JFCL	2,OP			;JCRY1
	JRST	12,OP			;JEN
	JFCL	10,OP			;JOV
	JRST	2,OP			;JRSTF
	ZAL	IORSET	(IOPALL!IOSALL)	;LALL
	ZAL	IORSET	(IOPROG)	;LIST
	ZAL	LIT0			;LIT
	ZAL	LOC0	(0)		;LOC
	ZA	OFFSYM			;NOSYM
	Z	OCT0	(^D8)		;OCT
	ZA	OPDEF0			;OPDEF
	JFCL	1,OP			;JFOV
	ZA	ONML			;MLON
	ZA	OFFML			;MLOFF
	Z	ASCII0	(3B19)		;COMMENT
IFN IIISW,<
	Z	ASCII0	(5B20)		;ASCID>

REPEAT 0,<CALTBL:
				;USER DEFINED CALLI'S GO HERE
	SIXBIT	/LIGHTS/	;-1
CALLI0:	SIXBIT	/RESET/		; 0
	SIXBIT	/DDTIN/		; 1
	SIXBIT	/SETDDT/	; 2
	SIXBIT	/DDTOUT/	; 3
	SIXBIT	/DEVCHR/	; 4
	SIXBIT	/DDTGT/		; 5
	SIXBIT	/GETCHR/	; 6
	SIXBIT	/DDTRL/		; 7
	SIXBIT	/WAIT/		;10
	SIXBIT	/CORE/		;11
	SIXBIT	/EXIT/		;12
	SIXBIT	/UTPCLR/	;13
	SIXBIT	/DATE/		;14
	SIXBIT	/LOGIN/		;15
	SIXBIT	/APRENB/	;16
	SIXBIT	/LOGOUT/	;17
	SIXBIT	/SWITCH/	;20
	SIXBIT	/REASSI/	;21
	SIXBIT	/TIMER/		;22
	SIXBIT	/MSTIME/	;23
	SIXBIT	/GETPPN/	;24
	SIXBIT	/TRPSET/	;25
	SIXBIT	/TRPJEN/	;26
	SIXBIT	/RUNTIM/	;27
	SIXBIT	/PJOB/		;30
	SIXBIT	/SLEEP/		;31
	SIXBIT	/SETPOV/	;32
	SIXBIT	/PEEK/		;33
	SIXBIT	/GETLIN/	;34
	SIXBIT	/RUN/		;35
	SIXBIT	/SETUWP/	;36
	SIXBIT	/REMAP/		;37
	SIXBIT	/GETSEG/	;40
	SIXBIT	/GETTAB/	;41
	SIXBIT	/SPY/		;42
	SIXBIT	/SETNAM/	;43
	SIXBIT	/TMPCOR/	;44
	SIXBIT	/DSKCHR/	;45
	SIXBIT	/SYSSTR/	;46
	SIXBIT	/JOBSTR/	;47
	SIXBIT	/STRUUO/	;50
	SIXBIT	/SYSPHY/	;51
	SIXBIT	/FRECHN/	;52
	SIXBIT	/DEVTYP/	;53
	SIXBIT	/DEVSTS/	;54
	SIXBIT	/DEVPPN/	;55
	SIXBIT	/SEEK/		;56
	SIXBIT	/RTTRP/		;57
	SIXBIT	/LOCK/		;60
	SIXBIT	/JOBSTS/	;61
	SIXBIT	/LOCATE/	;62
	SIXBIT	/WHERE/		;63
	SIXBIT	/DEVNAM/	;64
	SIXBIT	/CTLJOB/	;65
	SIXBIT	/GOBSTR/	;66
	0			;67
	0			;70
	SIXBIT	/HPQ/		;71
	SIXBIT	/HIBER/		;72
	SIXBIT	/WAKE/		;73
	SIXBIT	/CHGPPN/	;74
	SIXBIT	/SETUUO/	;75
	SIXBIT	/DEVGEN/	;76
	SIXBIT	/OTHUSR/	;77
	SIXBIT	/CHKACC/	;100
	SIXBIT	/DEVSIZ/	;101
	SIXBIT	/DAEMON/	;102
	SIXBIT	/JOBPEK/	;103
	SIXBIT	/ATTACH/	;104
	SIXBIT	/DAEFIN/	;105
	SIXBIT	/FRCUUO/	;106
	SIXBIT	/DEVLNM/	;107
	SIXBIT	/PATH./		;110

CALNTH==.-CALTBL
NEGCAL==CALLI0-CALTBL		;NUMBER OF NEGATIVE CALLI'S
>
TTCTBL:	SIXBIT	/INCHRW/	; 0	INPUT A CHAR. AND WAIT
	SIXBIT	/OUTCHR/	; 1	OUTPUT A CHAR.
	SIXBIT	/INCHRS/	; 2	INPUT A CHAR. AND SKIP
	SIXBIT	/OUTSTR/	; 3	OUTPUT A STRING
	SIXBIT	/INCHWL/	; 4	INPUT CHAR., WAIT, LINE MODE
	SIXBIT	/INCHSL/	; 5	INPUT CHAR., SKIP, LINE MODE
	SIXBIT	/GETLCH/	; 6	GET LINE CHARACTERISTICS
	SIXBIT	/SETLCH/	; 7	SET LINE CHARACTERISTICS
	SIXBIT	/RESCAN/	;10	RESET INPUT STREAM TO COMMAND
	SIXBIT	/CLRBFI/	;11	CLEAR TYPEIN BUFFER
	SIXBIT	/CLRBFO/	;12	CLEAR TYPEOUT BUFFER
	SIXBIT	/SKPINC/	;13	SKIPS IF A CHAR. CAN BE INPUT
	SIXBIT	/SKPINL/	;14	SKIPS IF A LINE CAN BE INPUT
	SIXBIT	/IONEOU/	;15	OUTPUT AS AN IMAGE CHAR.

TTCLTH==.-TTCTBL
	SUBTTL	USER-DEFINED SYMBOL SEARCH ROUTINES
MSRCH:	PUSHJ	PP,SEARCH	;PERFORM GENERAL SEARCH
	POPJ	PP,		;NOT FOUND, EXIT
	JUMPG	ARG,MSRCH2	;SKIP-EXIT AND CROSS-REF IF FOUND
	CAME	AC0,1(SX)	;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE
	POPJ	PP,		;NO, EXIT
	ADDI	SX,2		;YES, POINT TO IT
	PUSHJ	PP,SRCH5	;LOAD REGISTERS
MSRCH2:	AOSA	0(PP)		;SET SKIP-EXIT
QSRCH:	JUMPL	ARG,SSRCH3	;BRANCH IF OPERAND
	MOVEI	SDEL,%MAC	;SET OPERATOR FLAG
	TLZE IO,DEFCRS	;IS IT A DEFINITION?
	MOVEI SDEL,%DMAC	;YES
	JRST	CREF		;CROSS-REF AND EXIT

SSRCH:	PUSHJ	PP,SEARCH	;PERFORM GENERAL SEARCH
	POPJ	PP,		;NOT FOUND, EXIT
	JUMPL	ARG,SSRCH2	;SKIP-EXIT AND CROSS-REF IF FOUND
SSRCH1:	CAME	AC0,-3(SX)	;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW
	POPJ	PP,		;NO DICE, EXIT
	SUBI	SX,2		;YES, POINT TO IT
	PUSHJ	PP,SRCH5	;LOAD REGISTERS
SSRCH2:	AOS	0(PP)		;SET FOR SKIP-EXIT
SSRCH3:	MOVEI	SDEL,%SYM	;SET OPERAND FLAG

CREF:	TLNN	IO,IONCRF	;NO CREFFING FOR THIS SYMBOL?
	TLNE	FR,P1!CREFSW	;PASS ONE OR CROSS-REF SUPPRESSION?
	POPJ	PP,		;YES, EXIT
	EXCH	SDEL,C		;PUT FLAG IN C, SACE C
	PUSH	PP,CS
	TLNE IO,IOCREF		;HAVE WE PUT OUT THE 177,102
	JRST CREF3		;YES
	PUSH PP,C		;START OF CREF DATA

REPEAT 0,<	;NEEDS CHANGE TO CREF
	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,102
	PUSHJ PP,OUTLST
	TLO IO,IOCREF	;WE NOW ARE IN THAT STATE
	POP PP,C	;WE HAVE NOW
CREF3:	JUMPE C,NOFLG		;JUST CLOSE IT
	PUSHJ	PP,OUTLST	;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
	MOVSI CS,770000		;COUNT CHRS
	TDZA C,C	;STARTING AT 0
	LSH CS,-6	;TRY NEXT
	TDNE AC0,CS	;IS THAT ONE THERE?
	AOJA C,.-2	;YES
	PUSHJ PP,OUTLST		;PRINT NUMBER OF SYMBOL CONSTITUENTS
	MOVE	CS,AC0

CREF2:	MOVEI	C,0
	LSHC	C,6
	ADDI	C,40
	PUSHJ	PP,OUTLST	;THE ASCII SYMBOL
	JUMPN	CS,CREF2
	MOVEI	C,%DSYM
	TLZE	IO,DEFCRS
	PUSHJ	PP,OUTLST	;MARK IT AS A DEFINING OCCURENCE
NOFLG:	MOVE	C,SDEL
	POP	PP,CS
	POPJ	PP,

CLSCRF:	TRNN ER,LPTSW
	POPJ PP,	;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	MOVEI C,177
	PUSHJ PP,PRINT
	TLZE IO,IOCREF	;WAS IT OPEN?
	JRST CLSCR1	;YES, JUST CLOSE IT
	MOVEI C,102	;NO, OPEN IT FIRST
	PUSHJ PP,OUTLST		;MARK BEGINNING OF CREF DATA
	MOVEI C,177
	PUSHJ PP,OUTLST
CLSCR1:	MOVEI C,103
	JRST OUTLST		;MARK END OF CREF DATA

CLSC3:	TLZ IO,IOCREF
	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,104
	JRST OUTLST	;177,104 CLOSES IT FOR NOW
>	;END OF REPEAT 0
REPEAT 1,<			;WORKS WITH EXISTING CREF
	TLNE IO,IOPAGE
	PUSHJ PP,CRFHDR		;GET CORRECT SUBTTL
	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,102
	PUSHJ PP,OUTLST
	TLO IO,IOCREF	;WE NOW ARE IN THAT STATE
	POP PP,C	;WE HAVE NOW
CREF3:	PUSHJ	PP,OUTLST	;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
	MOVSI CS,770000		;COUNT CHRS
	TDZA C,C	;STARTING AT 0
	LSH CS,-6	;TRY NEXT
	TDNE AC0,CS	;IS THAT ONE THERE?
	AOJA C,.-2	;YES
	PUSHJ PP,OUTLST		;PRINT NUMBER OF SYMBOL CONSTITUENTS
	MOVE	CS,AC0

CREF2:	MOVEI	C,0
	LSHC	C,6
	ADDI	C,40
	PUSHJ	PP,OUTLST	;THE ASCII SYMBOL
	JUMPN	CS,CREF2
	MOVEI	C,%DSYM
	TLZE	IO,DEFCRS
	PUSHJ	PP,OUTLST	;MARK IT AS A DEFINING OCCURENCE
	MOVE	C,SDEL
	POP	PP,CS
	POPJ	PP,

IFN OPHSH,<
SUBTL:	SIXBIT	/SUBTTL/>
CRFHDR:	CAME	AC0,SUBTL	;IS FIRST SYMBOL "SUBTTL"
	JRST	CRFHD1		;NO
	HLLZ	AC0,V
	PUSHJ	PP,SUBTT0	;UPDATE SUBTTL
	MOVE	AC0,SUBTL	;RESTORE ARG.
	MOVEI	V,CPOPJ
CRFHD1:	MOVEI	C,0
	JRST	OUTL

CLSC3:
CLSCRF:	TRNN ER,LPTSW
	POPJ PP,	;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	TLZE IO,IOCREF	;FINISH UP LINE
	JRST CLSCR1
	MOVEI	C,0
	TLNE	IO,IOPAGE	;NEW PAGE?
	PUSHJ	PP,OUTL		;YES,GIVE IT A ROUSING SENDOFF!
	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,102
	PUSHJ PP,OUTLST		;MARK BEGINNING OF CREF DATA
CLSCR1:	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,103
	JRST OUTLST		;MARK END OF CREF DATA
>	;END OF REPEAT 1
SEARCH:	HLRZ	SX,SRCHX
	HRRZ	SDEL,SRCHX

SRCH1:	CAML	AC0,-1(SX)
	JRST	SRCH3
SRCH2:	SUB	SX,SDEL
	LSH	SDEL,-1
	CAMG	SX,SYMTOP
	JUMPN	SDEL,SRCH1
	JUMPN	SDEL,SRCH2
	SOJA	SX,SRCHNO	;NOT FOUND

SRCH3:	CAMN	AC0,-1(SX)
	JRST	SRCH4		;NORMAL / FOUND EXIT
	ADD	SX,SDEL
	LSH	SDEL,-1
	CAMG	SX,SYMTOP
	JUMPN	SDEL,SRCH1
	JUMPN	SDEL,SRCH2
	SOJA	SX,SRCHNO	;NOT FOUND

SRCH4:	AOS	0(PP)		;SET FOR SKIP EXIT
SRCH5:	MOVSI ARG,SUPRBT	;HE IS USING IT, TURN OFF BIT
	ANDCAM ARG,(SX)	; IN THE TABLE
SRCH7:	MOVE ARG,0(SX)		;FLAG AND VALUE TO ARG
	LDB	RC,RCPNTR	;POINT 1,ARG,17
	TLNE ARG,LELF	;CHECK LEFT RELOCATE
	TLO RC,1
	HRRZ	V,ARG
	TLNE ARG,SPTR	;CHECK SPECIAL EXTESN POINTER
	JRST SRCH6
	TLNE	ARG,PNTF
	MOVE	V,0(ARG)		;36BIT VALUE TO V
	JRST	SRCHOK
	
SRCH6:	MOVE V,0(ARG)	;VALUE
	MOVE RC,1(ARG)	;AND RELOC
	TLNE RC,-2	;CHECK AND SET EXTPNT
	HLLM RC,EXTPNT
	TRNE RC,-2	
	HRRM RC,EXTPNT
	JRST	SRCHOK
SRCHNO:IFN UNIVR,<SKIPN	UNISCH+1	;ALLOWED TO SEARCH OTHER TABLES>
	POPJ	PP,		;NO, JUST RETURN
IFN UNIVR,<AOS	V,UNISCH	;GET NEXT INDEX TO TABLE
	CAIE	V,1		;FIRST TIME IN
	JRST	SRCHN1		;YES, SAVE SYMBOL INFO
	HRLM	SX,UNISCH	;SAVE SX AND SET FLAG
	MOVE	ARG,SRCHX	;SEARCH POINTER
	MOVEM	ARG,UNISHX	;TO A SAFE PLACE
	HRR	ARG,SYMBOL
	HRL	ARG,SYMTOP
	MOVEM	ARG,UNIPTR	;STORE ALSO
SRCHN1:	MOVE	V,UNISCH(V)	;GET TRUE INDEX
	JUMPE	V,SRCHKO	;IF ZERO ALL TABLE SCANNED
	MOVE	ARG,UNISHX(V)	;NEW SRCHX
	MOVEM	ARG,SRCHX	;SET IT UP
	MOVE	ARG,UNIPTR(V)	;SYMTOP,,SYMBOL
	HRRZM	ARG,SYMBOL
	HLRZM	ARG,SYMTOP
	JRST	SEARCH		;TRY AGAIN>

SRCHKO:	SETZ	ARG,		;CLEAR ARG SO ZERO STORED
SRCHOK:	IFN UNIVR,<SKIPN	UNISCH		;HAVE WE SEARCH OTHER TABLES>
	POPJ	PP,		;NO, JUST RETURN
IFN UNIVR,<
SYMBCK:	HLRZ	SX,UNISCH	;RESTORE SX
	SETZM	UNISCH		;CLEAR SYMBCK FLAG
	PUSH	PP,V		;SAVE AN AC
	MOVE	V,UNISHX	;SRCHX
	MOVEM	V,SRCHX		;RESTORE ORIGINAL
	MOVE	V,UNIPTR	;SYMTOP,,SYMBOL
	HRRZM	V,SYMBOL
	HLRZM	V,SYMTOP
	JUMPE	ARG,SRCHK2	;TOTALLY UNDEFINED
	PUSH	PP,RC		;SAVE SOME ACCS
	PUSH	PP,ARG
	PUSH	PP,EXTPNT
	SETZB	ARG,EXTPNT	;CLEAR ALL SYMBOL DATA
	SETZB	RC,V
	PUSHJ	PP,INSERT	;INSERT SYMBOL IN TABLE
	POP	PP,EXTPNT	;RESTORE ACCS ETC.
	POP	PP,ARG
	POP	PP,RC
	MOVEM	ARG,(SX)	;SET FLAGS AND VALUE AS IT SHOULD BE
SRCHK2:	POP	PP,V
	POPJ	PP,		;RETURN>

INSERQ:	TLNE	ARG,UNDF!VARF
INSERZ:	SETZB	RC,V
INSERT:	CAME	AC0,-1(SX)	;ARE WE LOOKING AT MATCHING MNEMONIC?
	JRST	INSRT2		;NO, JUST INSERT
	JUMPL	ARG,INSRT1	;YES, BRANCH IF OPERAND
	SKIPL	0(SX)		;OPERATOR, ARE WE LOOKING AT ONE?
	JRST	UPDATE		;YES, UPDATE
	JRST	INSRT2		;NO, INSERT

INSRT1:	SKIPG	0(SX)		;OPERAND, ARE WE LOOKING AT ONE?
	JRST	UPDATE		;YES, UPDATE
	SUBI	SX,2		;NO, MOVE UNDER OPERATOR AND INSERT
INSRT2:	MOVE	SDEL,SYMBOL
	SUBI	SDEL,2
	CAMLE	SDEL,FREE
	JRST	INSRT3
	PUSHJ	PP,XCEEDS
	ADDI	SDEL,2000
INSRT3:	MOVEM	SDEL,SYMBOL	;MAKE ROOM FOR A TWO WORD ENTRY
	HRLI	SDEL,2(SDEL)
	BLT	SDEL,-2(SX)	;PUSH EVERYONE DOWN TWO LOACTIONS
	AOS	@SYMBOL		;INCREMENT THE SYMBOL COUNT
	TLNN RC,-2	;NEED SPECIAL?
	TRNE RC,-2	;LEFT OR RIGHT EXTERNAL?
	JRST INSRT5	;YES, JUMP
	TLNN	V,-1		;SKIP IF V IS A 36BIT VALUE
	JRST	INSRT4		;JUMP, ITS A 18BIT VALUE
	AOS	SDEL,FREE	;36BIT, SO GET A CELL FROM FREE CORE
	CAML	SDEL,SYMBOL	;MORE CORE NEEDED?
	PUSHJ	PP,XCEEDS	;YES
	HRRI	ARG,-1(SDEL)	;POINTER TO ARG
	MOVEM	V,0(ARG)	;36BIT VALUE TO FREE CORE
	TLOA	ARG,PNTF	;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE

INSRT4:	HRR	ARG,V		;18BIT VALUE TO ARG
	DPB	RC,RCPNTR	;FIX RIGHT RELOCATION
	TLNE RC,1
	TLO ARG,LELF	;FIX LEFT RELOCATION
INSRT6:	MOVEM	ARG,0(SX)	;INSERT FLAGS AND VALUE.
	MOVEM	AC0,-1(SX)	;INSERT SYMBOL NAME.
	PUSHJ	PP,SRCHI	;INITILIAZE SRCHX
	JRST	QSRCH		;EXIT THROUGH CREF
	
INSRT5:	MOVEI SDEL,2	;GET TWO CELLS FROM FREE CORE
	ADDB SDEL,FREE
	CAML SDEL,SYMBOL;MORE CORE NEEDED?
	PUSHJ PP,XCEEDS	;YES
	MOVEM RC,-1(SDEL)
	HRRI ARG,-2(SDEL)	;POINTER TO ARG
	MOVEM V,0(ARG)
	TLO ARG,SPTR	;SET SPECIAL POINTER, POINTS TO TWO CELLS
	JRST INSRT6
REMOVE:	SUBI	SX,2		;MOVE EVERYONE UP TWO LOCATIONS
REMOV1:	MOVE	0(SX)
	MOVEM	2(SX)		;OVERWRITE THE DELETED SYMBOL
	CAME	SX,SYMBOL	;SKIP WHEN DONE
	SOJA	SX,REMOV1
	ADDI	SX,2
	MOVEM	SX,SYMBOL
	SOS	0(SX)		;DECREMENT THE SYMBOL COUNT

SRCHI:	MOVEI	AC2,0		;THIS CODE SETS UP SRCHX
	FAD	AC2,@SYMBOL
	LSH	AC2,-^D27
	MOVEI	AC1,1000
	LSH	AC1,-357(AC2)
	HRRM	AC1,SRCHX
	LSH	AC1,1
	ADD	AC1,SYMBOL
	HRLM	AC1,SRCHX
	POPJ	PP,		;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4

UPDATE:	DPB	RC,RCPNTR	;FIX RIGHT RELOCATION
	TLNE ARG,SPTR	;SKIP IF THERE IS NO SPECIAL POINTER
	JRST UPDAT4	;YES, USE THE TWO CELLS
	TLNN RC,-2	;NEED TO CHANGE
	TRNE RC,-2	;ANY CURRENT EXTERNS?
	JRST UPDAT5	;YES ,JUMP
	TLZ ARG,LELF	;CLEAR LELF
	TLNE RC,1	;LEFT RELOCATABLE?
	TLO ARG,LELF	;YES, SET THE FLAG
	TLNE	ARG,PNTF	;WAS THERE A 36BIT VALUE?
	JRST	UPDAT2		;YES, USE IT.
	TLNE	V,-1		;NO,IS THERE A 36BIT VALUE?
	JRST	UPDAT1		;YES, GET A CELL
	HRR	ARG,V		;NO, USE RH OF ARG
UPDAT3:	MOVEM	ARG,0(SX)	;OVERWRITE THE ONE IN THE TABLE
	POPJ	PP,		;AND EXIT

UPDAT1:	AOS	SDEL,FREE	;GET ONE CELL
	CAML	SDEL,SYMBOL	;NEED MORE CORE?
	PUSHJ	PP,XCEEDS	;YES
	HRRI	ARG,-1(SDEL)	;POINTER TO ARG
	TLO	ARG,PNTF	;AND NOTE IT.
UPDAT2:	TLNE ARG,EXTF	;IS THERE A EXTERNAL?
	JRST UPDAT3		;YES, - JUST SAVE A LOCATION
	MOVEM	ARG,0(SX)	;NO, OVERWRITE THE POINTER IN THE TABLE
	MOVEM	V,0(ARG)	;STORE VALUE AS A 36BIT VALUE
	POPJ	PP,		;AND EXIT
	
UPDAT4:	MOVEM ARG,0(SX)	;WE HAVE TWO CELLS, WE USE THEM
	MOVEM V,0(ARG)	;SAVE AS 36BIT VALUE
	MOVEM RC,1(ARG)	;SAVE RELOCATION BITS
	POPJ PP,		;AND EXIT

UPDAT5:	MOVEI SDEL,2		;THERE IS A EXTERNAL
	ADDB SDEL,FREE		;SO WE NEED TWO LOACTIONS
	CAML SDEL,SYMBOL	;NEED MORE CORE?
	PUSHJ PP,XCEEDS		;YES
	MOVEM RC,-1(SDEL)	;SAVE RELOCATION BITS
	HRRI ARG,-2(SDEL)	;SAVE THE POINTER IN ARG
	MOVEM V,0(ARG)		;SAVE A 36BIT VALUE
	TLO ARG,SPTR		;SET SPECIAL PNTR FLAG
	TLZ ARG,PNTF		;CLEAR POINTER FLAG
	JRST UPDAT3		;SAVE THE POINTER AND EXIT

	SUBTTL	CONSTANTS


	SUBTTL PHASED CODE
      SUBTTL PHASED CODE
LSTFIL: BLOCK 1
        SIXBIT /@/      ;SYMBOL TO STOP PRINTING
TAG:    BLOCK   1
        SIXBIT  / + @/
TABI:
	BYTE    (7) 0, 11, 11, 11, 11
SEQNO:  BLOCK   1
        ASCIZ   /       /
BININI: EXP     B
BINDEV: BLOCK   1
        XWD     BINBUF,0
LSTINI: EXP     AL
LSTDEV: BLOCK   1
        XWD     LSTBUF,0
IFN CCLSW,<
NUNINI: EXP     DMP
NUNDEV: BLOCK   1
        XWD     0,0
RPGINI: EXP     AL
RPGDEV: BLOCK 1
        XWD 0,CTLBLK
>
INDEVI:	EXP	A
INDEV:	BLOCK	1
	XWD	0,IBUF
DBUF:	ASCIZ	/                 PAGE /
VBUF:	ASCIZ	/	MACRO /	;MUST BE LAST LOCATIONS IN BLOCK
	BLOCK	3	;ALLOW FOR LONG TITLE

SUBTTL	STORAGE CELLS

PASS1I:

RP:	BLOCK	1

IFE CCLSW,<CTIBUF:	BLOCK	3
CTOBUF:	BLOCK	3
>
IFN CCLSW,<CTLBUF:	BLOCK	<CTLSIZ+5>/5
>
LSTBUF:	BLOCK	3
BINBUF:	BLOCK	3
IBUF:	BLOCK	3
IFN CCLSW,<NUNDIR:>
LSTDIR:	BLOCK	4
BINDIR:	BLOCK	4
INDIR:	BLOCK	4

ACDELX:				;LEFT HALF
BLKTYP:	BLOCK	1		;RIGHT HALF

COUTX:	BLOCK	1
COUTY:	BLOCK	1
COUTP:	BLOCK	1
COUTRB:	BLOCK	1
COUTDB:	BLOCK	^D18

ERRCNT:	BLOCK	1
FREE:	BLOCK	1
IFN RENTSW,<HIGH1:	BLOCK 1
HISNSW:	BLOCK	1
SVTYP3:	BLOCK	1
HMIN:	BLOCK	1	;START OF HIGH SEG. IN TWO SEG. PROG.>
IFBLK:	BLOCK	.IFBLK
IFBLKA:	BLOCK	.IFBLK
LADR:	BLOCK	1
NCOLLS:	BLOCK	1
LIMBO:	BLOCK	1
LBUFP:	BLOCK	1
LBUF:	BLOCK	<.CPL+5>/5
	BLOCK 1
VARHD:	BLOCK	1
VARHDX:	BLOCK	1

LITAB:	BLOCK	1
LITABX:	BLOCK	1
	BLOCK	1
LITHD:	BLOCK	1
LITHDX:	BLOCK	1
LITCNT:	BLOCK	1
LITNUM:	BLOCK	1

LOOKX:	BLOCK	1
NEXT:	BLOCK	1
OUTSW:	BLOCK	1
PDP:	BLOCK	1
RECCNT:	BLOCK	1
SAVBLK:	BLOCK	RC
SAVERC:	BLOCK	1
SBUF:	BLOCK	.SBUF/5
SRCHX:	BLOCK	1
SUBTTX:	BLOCK	1
SVSYM:	BLOCK	1
SYMBOL:	BLOCK	1
SYMTOP:	BLOCK	1

STPX:	BLOCK	1
STPY:	BLOCK	1
STCODE:	BLOCK	.STP
STOWRC:	BLOCK	.STP

TABP:	BLOCK	1
TCNT:	BLOCK	1		;COUNT OF CHARS. LEFT IN TBUF
TBUF:	BLOCK	.TBUF/5
DEVBUF:	BLOCK	6		;STORE NAME.EXT CREATION DATE AND TIME
TYPERR:	BLOCK	1
IONSYM:	BLOCK	1	;-1 SUPRESS LISTING OF SYMBOLS
PRGPTR:	BLOCK	1	;POINTER TO CHAIN OF PRGEND BLOCKS
ENTERS:	BLOCK	1	;-1 WHEN ENTERS HAVE BEEN DONE
IFN UNIVR,<UNIVSN:	BLOCK	1	;-1 WHEN A UNIVERSAL SEEN>

PASS2I:

ABSHI:	BLOCK 1
HIGH:	BLOCK	1
IFN RENTSW,<HHIGH: BLOCK 1	;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.>
ACDEVX:	BLOCK	1
CPL:	BLOCK	1
CTLSAV:	BLOCK	1
CTLS1:	BLOCK	1
EXTPNT:	BLOCK	1
INTENT:	BLOCK	1
INREP:	BLOCK 1
INDEF:	BLOCK 1
INTXT:	BLOCK 1
INCND:	BLOCK	1
CALNAM:	BLOCK	1
CALPG:	BLOCK 1
CALSEQ:	BLOCK 1
DEFPG:	BLOCK 1
DEFSEQ:	BLOCK 1
LITPG:	BLOCK 1
LITSEQ:	BLOCK 1
REPPG:	BLOCK 1
REPSEQ:	BLOCK 1
TXTPG:	BLOCK 1
TXTSEQ:	BLOCK 1
CNDPG:	BLOCK	1
CNDSEQ:	BLOCK	1
IRPCNT:	BLOCK	1
IRPARG:	BLOCK	1
IRPARP:	BLOCK	1
IRPCF:	BLOCK	1
IRPPOI:	BLOCK	1
IRPSW:	BLOCK	1
LITLVL:	BLOCK	1
LITLBL:	BLOCK	1		;NAME OF LABEL DEFINED INSIDE A LITERAL

ASGBLK:	BLOCK	1
LOCBLK:	BLOCK	1

LOCA:	BLOCK	1
LOCO:	BLOCK	1
RELLOC:	BLOCK	1
ABSLOC:	BLOCK	1
LPP:	BLOCK	1
MODA:	BLOCK	1
MODLOC:	BLOCK	1
MODO:	BLOCK	1
IFN CCLSW,<OTBUF:	BLOCK 2>
OUTSQ:	BLOCK 2
PAGEN.:	BLOCK	1
PPTEMP:	BLOCK	1
PPTMP1:	BLOCK	1
PPTMP2:	BLOCK	1

REPCNT:	BLOCK	1
REPEXP:	BLOCK	1
REPPNT:	BLOCK	1
RPOLVL:	BLOCK	1
R1BCNT:	BLOCK 1
R1BCHK:	BLOCK 1
R1BBLK:	BLOCK .R1B
R1BLOC:	BLOCK 1
RIMLOC:	BLOCK	1
TAGINC:	BLOCK	1
VECREL:	BLOCK	1
VECTOR:	BLOCK	1
.TEMP:	BLOCK	1		;TEMPORARY STORAGE
IFN UNIVR,<UNISCH:	BLOCK	.UNIV		;SEARCH TABLE FOR UNIVERSALS>
SQFLG:	BLOCK 1
ARGF:	BLOCK	1
MACENL:	BLOCK	1
MACLVL:	BLOCK	1
MACPNT:	BLOCK	1
WWRXX:	BLOCK	1
RCOUNT:	BLOCK	1		;COUNT OF WORDS STILL TO READ IN LEAF
WCOUNT:	BLOCK	1		;COUNT OF WORDS STILL FREE IN LEAF
PASS2Z:				;ONLY CLEAR TO HERE ON PRGEND
LSTSYM:	BLOCK	1
PAGENO:	BLOCK	1
SEQNO2:	BLOCK 1
PASS2X:

SUBTTL	MULTI-ASSEMBLY STORAGE CELLS

LSTPGN:	BLOCK 1
HDAS:	BLOCK 1
IFN CCLSW,<EXTMP:	BLOCK 1	;HOLDS EXT OF COMMAND FILE (RH)
SAVFF:	BLOCK	1
CTLBLK:	BLOCK	3
CTIBUF:	BLOCK	3
CTOBUF:	BLOCK	3>
MACSIZ:	BLOCK	1		;INITIAL SIZE OF LOW SEG
IFN UNIVR,<
UNISIZ:	BLOCK	1		;TOP OF BUFFERS AND STACKS
UNITOP:	BLOCK	1		;TOP OF UNIVERSAL SYMBOL TABLE
UNIVNO:	BLOCK	1		;NUMBER OF UNIVERSALS SEEN
UNITBL:	BLOCK	.UNIV		;TABLE OF UNIVERSAL NAMES
UNIPTR:	BLOCK	.UNIV		;TABLE OF SYMBOL POINTERS
UNISHX:	BLOCK	.UNIV		;TABLE OF SRCHX POINTERS>
	VAR			;CLEAR VARIABLES

JOBFFI:	BLOCK	203*NUMBUF+1		;INPUT BUFFER PLUS ONE

	END	BEG