TITLE	MACRO.V36
SUBTTL	 RPG/CMF/JF/PMH/DMN	7-SEPT-71
;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.


	LOC	<JOBVER==137>
	OCT	37
	RELOC
	MLON

REPEAT 0,<
	ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)

	SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW		GIVES VARIABLES IN LOW SEGMENT
CCLSW		GIVES RAPID PROGRAM GENERATION FEATURE
FTDISK		GIVES DISK FEATURES
RUNSW		USE RUN UUO FOR "DEV:NAME!"
TEMP		TMPCOR UUO IS TO BE USED
RENTSW		ASSEMBLE REENTERANT PROGRAMS

>
SUBTTL	DEFAULT ASSEMBLY SWITCH SETTINGS

IFNDEF PURESW,<PURESW==1>

IFNDEF RUNSW,<RUNSW==1>

IFNDEF RENTSW,<RENTSW==1>

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

IFNDEF TEMP,<TEMP==1>

IFNDEF FTDISK,<FTDISK==0>

SUBTTL	OTHER PARAMETERS

.PDP==	^D40		;BASIC PUSH-DOWN POINTER
IFNDEF LPTWID,<LPTWID==^D132>	;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/8>		;USEFUL WIDTH IN MAIN LISTING
.CPL==	.LPTWD-^D40		;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==^D5		;IFIDN COMPARISON BLOCK SIZE
.R1B==^D18
.LEAF==4		;SIZE OF BLOCKS IN MACRO TREE

NCOLS==LPTWID/^D40		;NUMBER OF COLUMNS IN SYMBOL TABLE
IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D79>>
IFNDEF NUMBUF,<NUMBUF==2	;NUMBER OF INPUT BUFFERS>

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

IFN PURESW,< HISEG >

;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   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]
OPDEF   MTWAT.  [MTAPE   0]
OPDEF   MTREW.  [MTAPE   1]
OPDEF   MTEOT.  [MTAPE  10]
OPDEF   MTSKF.  [MTAPE  16]
OPDEF   MTBSF.  [MTAPE  17]

			;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

;USEFUL MACROS

DEFINE FORERR(AC,ABC)<
        MOVE    AC,SEQNO2
        MOVEM   AC,ABC'SEQ
        MOVE    AC,PAGENO
        MOVEM   AC,ABC'PG
>


IFN CCLSW,<		;ASSEMBLE IF RUN UUO IMPLEMENTED
NUNSET:	SKIPN	ACDEV
	MOVSI	ACDEV,(SIXBIT /SYS/)	;USE SYS IF NONE SPECIFIED
IFN RUNSW,<
	MOVEM ACDEV,RUNDEV
	MOVEM ACFILE,RUNFIL	;STORE FILE NAME
	PUSHJ PP,DELETE		;COMMAND FILE
	SETZM RUNPP
	MOVEI 16,RUNDEV	;XWD 0,RUNDEV
	TLNE IO,CRPGSW	;WAS RPG IN PROGRESS?
	HRLI 16,1	;YES  START NEXT AT C(JOBSA)+1
	RUN 16,		;DO "RUN DEV:NAME"
	HALT		;SHOULD'T RETURN. HALT IF IT DOES
>
IFE RUNSW,<POPJ	PP, >

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
	CAIN	C,14
	SKIPE	SEQNO
	JRST	ASSEM2
	PUSHJ	PP,OUTFF
	PUSHJ	PP,OUTLI
	JRST	ASSEM1

ASSEM2:	AOS	TAGINC
	CAIN	C,15
	JRST	ASSEM3
	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
	JRST	ASSEM1
ASSEM3:	PUSHJ	PP,STOUT+1
	JRST	ASSEM1

SUBTTL	STATEMENT PROCESSOR

STMNT:	TLZ	FR,INDSW
	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
	SKIPE	C
	TLO	IO,IORPTC
	SKIPN	AC2,AC0
	POPJ	PP,
	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 FLAG
	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
	TRZE	V,LITF		;VALID IN LITERAL?
	SKIPN	LITLVL		;NO, ARE WE IN A LITERAL?
	JRST	0(V)		;NO, GO TO APPRORIATE PROCESSOR
	MOVE	AC0,AC2

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
	PUSHJ	PP,EVALHA	;EVALUATE EXPRESSION
	JRST	STOW		;YES,STOW THE CODE AND EXIT

STMNT8:	SETZB	AC0,RC		;CLEAR VALUE AND RELOCATION
	TRO	ER,ERRO		;FLAG AS UNDEIFNED OP-CODE
	JRST	OPD

		;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)
			;UNTIL A LINE TERMINATOR IS SEEN.
STOUTS:	TLO	IO,IOENDL
STOUT:	TLO	IO,IORPTC
	PUSHJ	PP,BYPAS1
	CAIN	C,14		;COMMA?
	SKIPL	STPX		;YES, ERROR IF CODE STORED
	CAIN	C,33
	TLOA	IO,IORPTC
	TRO	ER,ERRQ
STOUT1:	PUSHJ	PP,CHARAC
	CAIGE	C,CR
	CAIG	C,HT
	JRST	STOUT1
	JRST	OUTLIN
	SUBTTL	LABEL PROCESSOR

LABEL:	JUMPAD	LABEL4		;COMPARE IF NON-SYMBOLIC
	JUMPE	AC0,LABEL5	;ERROR IF BLANK
	MOVEM	AC0,TAG
	HLLZS	AC0,TAGINC
	TLO	IO,DEFCRS	;THIS IS A DEFINITION
	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	MOVSI	ARG,SYMF!UNDF!TAGF	;NOT FOUND
	TLNE	ARG,EXTF	;UNDEFINED ON PASS1
	JRST	LABEL3		;NO, FLAG ERROR
	TLZN	ARG,UNDF!VARF
	JRST	LABEL2		;YES, CHECK EQUALITY
LABEL1:	MOVE	V,LOCA	;WFW
	MOVE	RC,MODA
	TLO	ARG,TAGF
	JRST	INSERT		;INSERT/UPDATE AND EXIT

LABEL2:	HRLOM	V,LOCBLK	;SAVE LIST LOCATION
	TLNE	ARG,40
	JRST	LABEL6
LABEL0:	CAMN	V,LOCA		;DOES IT COMPARE WITH PREVIOUS? WFW
	CAME	RC,MODA
LABEL3:	TLOA	ARG,MDFF	;NO, FLAG MULTIPLY DEFINED AND SKIP
	POPJ	PP,
	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,IOPAGE	;NO, FLAG PHASE ERROR
	POPJ	PP,

LABEL6:	JUMP1	LABEL1
	TRO	ER,IOMSTR
	TLZ	ARG,40
	PUSHJ	PP,UPDATE
	JRST	LABEL0
SUBTTL	ATOM PROCESOR
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
	SKIPN	0,5
	TLNN	IO,NUMSW	;AND NUMERIC,
	JRST	NUMER2
	LSHC	AC0,^D35(SX)
	LSH	RC,^D35(SX)
	JRST	ATOM1
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,BYPAS1
	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
	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

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

GETDEL:	PUSHJ	PP,BYPAS1
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	AC0,1
	TDCA	AC0,[-1]
GETDE2:	MOVNS	AC0		;YES, NEGATE VALUE
	MOVNS	RC		;AND RELOCATION
POPOUT:	POPJ	PP,		;EXIT
QUOTE0:	ASH	AC0,7
	IOR	AC0,C
QUOTES:	PUSHJ	PP,CHARAC
	CAIN	C,CR
	JRST	QUOTE2
	CAIE	C,42
	JRST	QUOTE0
	PUSHJ	PP,CHARAC	;LOOK AT NEXT CHAR.
	CAIN	C,42
	JRST	QUOTE0
QUOTE2:	TLO	IO,IORPTC
	JRST	GETDEL
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,RX
	PUSHJ	PP,CELLSF
	MOVE	AC2,AC0
	MOVEI	AC0,^D36
	JUMPE	AC2,QUAL2A
	LSH	AC2,-1
	SOJA	AC0,.-2
SUBTTL	NUMBER PROCESSOR

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
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
	FORERR	(C,LIT)
SQB5:	JSP	AC2,SVSTOW
SQB3:	PUSHJ	PP,STMNT
	TLNE FR,MWLFLG		;CALL IT ] IF NOT MULTI-WORD FLAG
	CAIN C,75		;CHECK FOR ]
	JRST SQB1
	TLO IO,IORPTC
	PUSHJ PP,BYPAS1
	CAIN C,33 		;COMMENT?
	TLOA IO,IORPTC
	TRO ER,ERRQ
SQB4:	PUSHJ PP,CHARAC
	CAIGE C,CR		;LOOK FOR END OF LINE
	CAIN C,HT
	JRST SQB4
	PUSHJ PP,OUTIML		;DUMP
	JRST SQB3
SQB1:	TLZ IO,IORPTC
	PUSHJ PP,STOLIT
	JSP AC2,GTSTOW
	POP PP,EXTPNT
	POP PP,FR
	SKIPE LITLVL		;WERE WE NESTED?
	JUMP1 NUMER2		;YES, FORCE ERROR IF PASS 1
	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	NUM31		;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

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
	CAIE	C,45		;"E"?
	TDZA	AC0,AC0
	PUSHJ	PP,CELL
	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,BYPAS1	;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
BYPAS1:	PUSHJ	PP,GETCHR
BYPAS2:	JUMPE	C,.-1
	POPJ	PP,
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
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		;YES, TREAT ACCORDINGLY
	PUSHJ	PP,SEARCH	;SEARCH FOR MACRO OR SYMBOL
	JRST	EVOP		;NOT FOUND, TRY FOR OP-CODE
	SKIPL	ARG		;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

	SKIPE	C		;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,OPD		;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:	TRZE	V,LITF		;CLEAR LIT INVALID FLAG
	JRST	EVOPX		;PSEUDO-OP THAT GENERATES NO DATA JUMPS
	HLLZ	AC0,V
EVOPD:	SKIPE	C		;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	EVERRU
	TLNN	ARG,EXTF
	JRST	EVTSTR
	HRRZ	RC,ARG		;GET ADRES WFW
	HRRZ	ARG,EXTPNT	;SAVE IT WDW
	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, NEGATIVE AC0 AND RC

EVGETD:	PUSHJ	PP,BYPAS2		
	TLNE	CS,6		;NON BLANK FIELD
	TLO	IO,IORPTC	;YES,SET FLAG
EVNUM:	POP	PP,SDEL		;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,AC2		;POP PREVIOUS RELOCATABILITY
	POP	PP,AC1		;AND PREVIOUS VALUE
	LDB	PS,[POINT 3,PS,29]	;TYPE OF OPERATION TO PS
	JRST	.(PS)		;PREFORM PROPER OPERATION
	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
	SKIPN	RC		;COMMON RELOCATION TEST
	SKIPE	AC2
	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
	SKIPE	PR
	TRO	ER,ERRR
	JRST	EVNUM

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
	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
	JRST	STOWI

STOL06:	MOVEI	SX,LITAB
	MOVE	ARG,STPX
	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 MODE 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
	CAIG	C,172		;CHECK FOR LOWER CASE
	CAIGE	C,141
	SKIPA			;NOT LOWER CASE
	SUBI	C,40		;CONVERT LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIX BIT
	CAIN	C,7
	JRST	GETCHR
	CAILE	C,77
	JRST	GETCS1
	JUMPGE	C,GETCS
	ADDI	C,27
	JUMPE	C,GETCS
	TLOA	IO,IORPTC	;REPEAT CHARACTER

GETCS1:	TDO	IO,[XWD IORPTC,ERRQ]
	MOVEI	C,33
GETCS:	MOVE	CS,CSTAT(C)	;GET STATUS BITS
	POPJ	PP,		;EXIT

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:	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	CS,7
	ANDCAM	CS,CPL		;MASK
	POPJ	PP,		;EXIT

CHARAX:	LDB	C,LBUFP		;GET LAST CHARACTER
	POPJ	PP,		;EXIT
CHARL:	PUSHJ	PP,CHARAC	;GET AND TEST 7-BIT ASCII
	CAIE	C,LF		;LINE OR FORM FEED OR VT?
	CAIN	C,FF
	SKIPA	CS,LITLVL	;IN LITERAL?
	POPJ	PP,		;EXIT
	JUMPN	CS,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,00,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
	IDPB	AC0,LBUFP
	JUMP1	OUTL30		;BRANCH IF PASS ONE
	JUMPN	AC0,OUTL02	;JUMP IF ANY ERRORS TO FORCE PRINTING
	SKIPL	STPX		;SKIP IF NO CODE, OTHERWISE
	TLZ	IO,IOMAC	;FORCE MACRO PRINTING
	TLNN	IO,IOMSTR!IOPROG!IOMAC
OUTL02:	IOR	IO,OUTSW	;FORCE IT.
	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 FALL THROUGH
	PUSHJ	PP,OUTL		
	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
	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)	;
OUTL22:	PUSHJ	PP,ONC		;PRINT IT
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
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
	PUSHJ	PP,OUTCR	;OUTPUT CARRIAGE RETURN
	JRST	OUTL26		;TEST FOR MORE BINARY

OUTL30:	AOS	CS,STPX		;PASS ONE
	ADDM	CS,LOCO		;INCREMENT OUTPUT LOCATION
	PUSHJ	PP,STOWI	;INITIALIZE STOW
	TLZ	AC0,ERRORS-ERRM-ERRP-ERRV-400000
	JUMPE	AC0,OUTLI3	;JUMP IF ERRORS
	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
	JRST	OUTL25		;OUTPUT BASIC LINE

OUTLER:	ASH AC0,-4
	MOVE CS,[POINT 6,[SIXBIT /PRINTQXADLRUVNOPEM/]]
OUTLE2:	ILDB	C,CS		;GET ERROR MNEMONIC
	JUMPGE	AC0,OUTLE4	;BRANCH IF NOT FLAGGED
	ADDI	C,40
	PUSHJ	PP,OUTL
	AOS	ERRCNT		;INCREMENT ERROR COUNT
OUTLE4:	LSH	AC0,1		;SHIFT NEXT FLAG INTO SIGN BIT
	JUMPN	AC0,OUTLE2	;TEST FOR END
	POPJ	PP,		;EXIT
OUTPL:	IBP	LBUFP
OUTIM1:	JUMP1	OUTLI3
	PUSH	PP,IO
	TDZ	IO,TYPERR
	TLNN	IO,250000
	IOR	IO,OUTSW
	PUSH	PP,C
	TLNN	FR,2000
	PUSHJ	PP,CLSCRF
OUTIM2:	MOVE	CS,TABP
	PUSHJ	PP,OUTASC	;OUTPUT TABS
	DPB	C,LBUFP
	MOVEI	CS,LBUF
	PUSHJ	PP,SOUT20
	POP	PP,C
	HLLM	IO,0(PP)
	POP	PP,IO
	JRST	OUTLI2
OUTLI:	TLNE	IO,IOPALL	;SUPRESSING ALL
	SKIPN	MACLVL
	TLZA	IO,IOMAC	;NO, CLEAR MAC FLAG
	TLO	IO,IOMAC	;YES, SET FLAG
OUTLI3:	TRZ	IO,ERRORS!LPTSW!TTYSW
OUTLI2:	MOVE	CS,[POINT 7,LBUF]	;INITIALIZE BUFFERS
	MOVEM	CS,LBUFP
	MOVEI	CS,130
	MOVEM	CS,CPL
	MOVE	CS,[POINT 7,TABI,6]
	MOVEM	CS,TABP
	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 TERRMINATOR
	SETZM	ASGBLK
	SETZM	LOCBLK
	POPJ	PP,
OUTIML:	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 ACO 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
OUTML1:	TLZ CS,ERRORS-ERRM-ERRP-ERRV-400000
	JUMPE CS,OUTLI2
	TRZ ER,ERRM!ERRP!ERRV!400000
	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
	POPJ	PP,
	JUMP1	VARA1
	PUSHJ	PP,OUTCR
	PUSHJ	PP,OUTSYM
	MOVEI	CS,[SIXBIT /UNASSIGNED, DEFINED AS @/]
	PUSHJ	PP,OUTSIX
	HRLO	CS,V
	TDZ	CS,RC
UOUT1:	PUSHJ	PP,ONC1
	JRST	HIGHQ
				;OUTPUT THE ENTRIES

EOUT:	MOVEI	C,0		;INITIALIZE THE COUNT
	MOVE	SX,SYMBOL
	MOVE	SDEL,0(SX)
EOUT1:	SOJL	SDEL,EOUT2
	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:	MOVEI	[ASCIZ /SYMBOL TABLE/]
	HRRM	SUBTTX		;SET NEW SUB-TITLE
	PUSHJ PP,OUTFF		;FORCE NEW PAGE
	MOVEI ARG,NCOLS		;SET UP FOR NCOLS ACROSS SYMBOL TABLE
	MOVEM ARG,SYMCNT	;STORE ANSWER
	PUSHJ PP,LOUT1		;OUTPUT THEM
	MOVE	ARG,SYMCNT
	CAIE	ARG,NCOLS
	JRST	OUTCR		;NO, NEED CR
	POPJ	PP,

LOUT1:	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRNN	ARG,SYMF
	TRNN	ARG,MACF!SYNF
	TRNE	ARG,40		;SKIP AND CLEAR MRP
	POPJ	PP,		;NO, TRY AGAIN
	MOVEI	MRP,0
	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
	TLNE	IO,2000
	JUMPE	MRP,POPOUT
	JUMPGE	MRP,LOUT10
	HLRZ	RC,V		;PUT POINTER/FLAGS IN RC
	TRNE	RC,-2		;POINTER?
	MOVS	RC,0(RC)	;YES
	HLL	V,RC		;STORE LEFT HALF

LOUT10:	PUSH PP,RC	;SAVE FOR LATER
	PUSHJ	PP,OUTSYM	;OUTPUT THE NAME
	MOVE RC,0(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 AC0,RC
	TRNE RC,-2
	HLLZS AC0,RC
	TLZE RC,-1
	TRO RC,2
	HRL MRP,RC
	MOVEI	RC,0
	TRNE	ARG,NOOUTF	;ENTRY DMN
	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
	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
	PUSHJ	PP,OUTTAB	
	HRLO	CS,V
	TDZ	CS,RC		;SET RELOCATION
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTTAB
	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	AC0,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 SOUT30
	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

SOUT30:	MOVEI	CS,SOUTC(MRP)
	PUSHJ	PP,OUTAS0
	SOSLE	SYMCNT
	JRST	OUTAB2
	MOVEI	CS,3
	MOVEM	CS,SYMCNT
	JRST	OUTCR

SOUT20:	PUSHJ	PP,OUTAS0
	JRST	OUTCR

       <ASCII /EXT/>!60        ;DMN
SOUTC:	 EXP     10
       <ASCII /INT/>!04
       <ASCII /EXT/>!60
       <ASCII /DLD/>!50 
       <ASCII /INT/>!04        ;DMN
				;OUTPUT THE BINARY

BOUT:	HRLO	CS,LOCO		;PICKUP THE LOCATION
	PUSHJ	PP,ONC		;OUTPUT IT TO THE LISTING FILE
	PUSHJ	PP,DSTOW	;GET THE CODE
	PUSH PP,RC	;SAVE RELOCATION
	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 AC0,RC	;MAKE NON-RELOC
	JRST BOUT30	;PROCESS
	TRNN RC,-2
	JRST BOUT30

BOUT20:	HRRM AC1,0(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
	PUSHJ	PP,ONC
	HRLO	CS,AC0
	TDZ	CS,RC		;SET RELOCATION
	PUSHJ	PP,ONC
	HRRZ	CS,LOCO		;CS = RIGHT RELOCATION
	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		;EXIT CODE
	POP PP,RC	;RETREIVE 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(11)	;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 AC0,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
	SKIPA
	SUBI	C,40		;CONVERT TO LOWER CASE
	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
NOUT3:

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

IFN RENTSW,<
HOUT:
	MOVE	AC0,HHIGH	;GET HIGH SEG IF TWO SEGMENTS
	MOVEI	RC,1		;RELOCATABL
	PUSHJ	PP,COUT		;OUTPUT IT
	SETZB	AC0,RC
	JRST	COUT		;OUTPUT THE HIGHEST LOCATION>

VOUT:	SKIPN	RC,VECREL	;IS VECTOR ABSOLUTE ZERO?
	SKIPE	VECTOR		;ALSO CHECK RELOCATION
	SKIPA	
	POPJ	PP,		;YES, EXIT
	MOVE	AC0,VECTOR	;ACO 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
STOWZ:	MOVEI	RC,0		;USE STANDARD FORM
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	;INCREMEMT 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 ERRRO 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
	CAIN	AC1,0(RC)	;DOES IT MATCH
	JRST	STOWT0		;EXTERNAL OR RELOCATION ERROR
	HRRI	RC,0
	TRO	ER,ERRE
STOWT0:	HLLZS	EXTPNT
	POPJ	PP,		;EXIT

	;EXTERNAL LEFT
STOWT1:	HLRZ	AC1,EXTPNT	;GET LEFT HALF
	CAIN	AC1,0(RC)	;SEE ABOVE
	JRST	STOWT2
	HRRI	RC,0
	TRO	ER,ERRE
STOWT2:	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,"'"
	TLNN	CS,1		;RELOCATABLE?
	PUSHJ	PP,OUTC		;OUTPUT IF EXTERN OR RELOCATABLE
	POPJ	PP,		;EXIT

DNC:	IDIVI	C,^D10
	HRLM	CS,0(PP)
	SKIPE	C
	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		;OUTPUTASCII 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:	AOS	LITLVL
	PUSHJ	PP,STMNT
	SOS	LITLVL
	SKIPL	STPX
	PUSHJ	PP,DSTOW
	TLZN	RC,-2
	TRZE	RC,-2
	TRO	ER,ERRE
	MOVEM	AC0,VECTOR
	MOVEM	RC,VECREL
	PUSHJ	PP,VARA
	PUSHJ	PP,LIT1
	JUMP2	ENDP2
	PUSHJ	PP,UOUT
	PUSHJ	PP,REC2
	PUSHJ	PP,INZ

PASS20:	SETZM	CTLSAV
	PUSHJ	PP,COUTI
	PUSHJ	PP,EOUT		;OUTPUT THE ENTRIES
	PUSHJ	PP,OUTSET
	XWD	 6,NOUT		;OUTPUT THE HISEG BLOCK
PASS21:	MOVEI	1
	HRRM	BLKTYP		;SET FOR TYPE 1 BLOCK
	TLZ	FR,P1!MWLFLG	;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
IFN RENTSW,<
	MOVE	AC0,HHIGH
	CAMN	AC0,LOCO
	HRRZM	AC2,HHIGH
>
	TLNN	FR,CREFSW
	TLNN	IO,IOCREF	;CLOSE CREF IF NECESSARY
	SKIPA
	PUSHJ	PP,CLSCR2	;CLOSE IT UP
	HRR	ER,OUTSW	;SET OUTPUT SWITCH
	SKIPN	TYPERR
	TRO	ER,TTYSW
	PUSHJ	PP,UOUT		;OUTPUT UNDEFINEDS
	TRO	ER,TTYSW
	SKIPG	C,ERRCNT	;GET ERROR COUNT AND CHECK FOR POSITIVE
	JRST	NOERW
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 ERRMS3]	;LOAD TO PRINT
ONERW:	MOVEI CS,ERRMS2		;ONE ERROR DECTECTED
ONERW1:	PUSHJ PP,OUTSIX		;PRINT
	JRST ENDP2D
NOERW:	MOVEI CS,ERRMS1
	TLNE IO,CRPGSW		;IF RPG, DON'T PRINT MESSAGE
	TRZ	IO,TTYSW	;NO TTY OUTPUT
	IOR	IO,OUTSW	;UNLESS NEEDED FOR LISTING
	PUSHJ PP,OUTCR
	JRST ONERW1
ENDP2D:	PUSHJ	PP,OUTCR
IFN	CCLSW,<TLNE IO,CRPGSW	;IF RPG, DON'T PRINT PGM BREAK
	TRZ	IO,TTYSW	;...>
IFE	CCLSW,<	SKIPA	;SO PRGEND CODE CAN WORK>
	IOR	IO,OUTSW	;...
	PUSHJ	PP,OUTCR
	MOVEI	CS,[SIXBIT /PROGRAM BREAK IS @/]
	PUSHJ	PP,OUTSIX
IFN RENTSW,<
	HRLO	CS,HHIGH	;GET PROGRAM BREAK
	PUSHJ	PP,UOUT1>
	PUSHJ	PP,OUTCR
	TLNE	FR,RIMSW!R1BSW	;RIM MODE?
	PUSHJ	PP,RIMFIN	;YES, FINISH IT
	HRR	IO,OUTSW
	PUSHJ	PP,OUTSET
	XWD	2,SOUT		;OUTPUT THE SYMBOLS (BLKTYP-2)
	PUSHJ	PP,OUTSET
	XWD	7,VOUT		;OUTPUT TRANSFER VECTOR (..-7)
IFN RENTSW,<
	PUSHJ	PP,OUTSET
	XWD	5,HOUT		;OUTPUT HIGHEST RELOCATABLE (..-5)>
	PUSHJ	PP,COUTD
	JRST	FINIS
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
	PUSHJ	PP,OUTFF
	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
	JRST	GOTEND

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,

IOSET:	JUMP1	POPOUT		;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)
	HLRZ	SX,AC0		;STORE FLAGS
	PUSHJ	PP,STOUTS	;POLISH OFF LINE
	TLOA	IO,0(SX)	;NOW SUPPRESS PRINTING
IORSET:	TDZ	IO,AC0		;RESET  FLAG IOPALL/IOPROG
	POPJ	PP,

BLOCK0:	PUSHJ	PP,HIGHQ	
	PUSHJ	PP,EVALEX	;EVALUATE
	TRZE	RC,-1		;EXTERNAL OR RELOCATABLE?
	PUSHJ	PP,QEXT		;UPDATE ASSEMBLY LOCATION
	ADDM	AC0,LOCO	;SAVE START OF BLOCK
BLOCK1:	EXCH	AC0,LOCA	;UPDATE OUTPUT LOCATION
	ADDM	AC0,LOCA
BLOCK2:	HRLOM	AC0,LOCBLK
	JUMP2	POPOUT
	TRNE	ER,ERRU
	TRO	ER,ERRV
	POPJ	PP,

PRINT0:	MOVNI	AC0,5
	ADDM	AC0,ERRCNT
	TRO	ER,400000
	POPJ	PP,

REMAR0:	PUSHJ	PP,GETCHR
	CAIE	C,EOL
	JRST	REMAR0
	POPJ	PP,
LIT0:	PUSHJ	PP,BLOCK1
LIT1:	JUMP2	LIT20

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

	PUSHJ	PP,STOUTS
	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:	PUSHJ	PP,STOUTS
	MOVE	SX,LITAB
LIT21:	SOSGE	LITNUM
	JRST	LIT22
	MOVE	AC0,-2(SX)	;WFW
	MOVE	RC,-1(SX)	;WFW
	MOVE SX,0(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
	SETZM	0(SX)		;CLEAR FORWARE 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	V,1		;NUMBER TO ADD TO
	ADDM	V,0(AC1)	;UPDATE COUNT
VARA1:	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
	SKIPL	AC1
	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
	JRST STOW		;STOW CODE AND EXIT

IFPASS:	TLZ 14,4
	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
IFB2:	PUSHJ	PP,CHARAC	;GET FIRST NON-BLANK
	CAIN	C,74
	AOJA	RC,IFB2
	CAIN	C,76
	SOJLE	RC,IFXCT
	CAIE	C," "		;BLANK
	TRO	AC0,0(RC)
	JRST	IFB2
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

IFIDN0:	HLRZS	AC0
	MOVEI	V,2*.IFBLK-1
	SETZM	IFBLK(V)	;CLEAR COMPARISON BLOCK
	SOJGE	V,.-1
	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
	SKIPL	V		;DID WE FINISH STRING
	XORI	AC0,1		;NO, TOGGLE REQUEST
	JRST	IFEXIT		;DO NOT TURN ON IORPTC WFW

IFCL:	HRLI	RC,(POINT 7,,)
IFCL1:	PUSHJ	PP,CHARAC	;GET AND LIST CHARACTERS
	CAIE	C,74		;SKIP SPACES
	JRST	IFCL1
	MOVEI	SX,30
IFCL2:	PUSHJ	PP,CHARAC
	CAIN	C,76
	POPJ	PP,
	IDPB	C,RC
	SOJLE	SX,POPOUT
	JRST	IFCL2

IFEX2:	PUSHJ	PP,GETCHR
	CAIN	C,EOL		;EXIT WITH ERROR IF END OF LINE
	JRST	ERRAX
	CAIN	C,34		;"<"?
	AOJA	IFEX2		;YES, INCREMENT COUNT
	CAIE	C,36		;">"?
	JRST	IFEX2		;NO, TRY AGAIN
	SOJGE	IFEX2		;YES, TEST FOR MATCH
	PUSHJ	PP,BYPAS1	;YES, MOVE TO NEXT DELIMITER
	AOJA	AC0,STOWZ	;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	;ALLOW FORWARD REFERENCE
	TRO	ER,ERRA
	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
	POPJ	PP,		;NO, EXIT
EXTER0:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	EXTER3		;INVALID, ERROR
	PUSHJ	PP,SSRCH	;OK, SEARCH SYMBOL TABLE
	JRST	EXTER2		;NOT THER, INSERT IT
	TLNN	ARG,EXTF!VARF!UNDF
	TROA	ER,ERRE		;FLAG ERROR AND BYPASS
	TLNE	ARG,EXTF	;VALID, ALREADY DEFINED
	JRST	EXTER3
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,1		;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)
	MOVE	ARG,-1(SX)	;GET THE SIXBIT FOR THE NAME
	MOVEM	ARG,1(V)	;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS
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	;EVALUTE EXPRESSION
	TLZN	RC,-2		;WAS AN EXTERNAL FOUND?
	TRZE	RC,-2
	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
	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
	JRST	ERRAX		;YES "A" ERROR
	PUSHJ	PP,INSERT	;NO, INSERT/UPDATE
	TLZ	IO,DEFCRS	;JUST IN CASE
	PUSHJ	PP,BYPAS1
	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
	HRROM	RC,ASGBLK
	MOVEM	V,LOCBLK
	POPJ	PP,

ASSIG1:	PUSH	PP,AC0
	MOVEI	AC0,0
	PUSHJ	PP,GETCHR
	CAIN	C,35		;EQUALS?
	TLOA	AC0,NOOUTF	;YES, NOT OUT TO DDT WFW
	TLO	IO,IORPTC
	MOVEM	AC0,HDAS	;STORE THESE BITS WFW
	SETZM	EXTPNT
	PUSHJ	PP,EVALEX	;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
	JRST	ASSIG4
ASSIG2:	HLRZ	RC,0(PP)
	TRNN	RC,-2
	JRST	ASSIG3
	HLRZ	ARG,EXTPNT
	CAME	RC,ARG
	JRST	ASSIG4
ASSIG3:	TLO	IO,DEFCRS
	PUSHJ	PP,SSRCH
	MOVSI	ARG,400000
	IOR	ARG,HDAS
	TLZA	ARG,UNDF!VARF!40	;CANCEL UNDEFINED AND VARIABLE FLAGS
ASSIG4:	TRO	ER,ERRE
	SETZM	EXTPNT		;FOR REST OF WORLD
	TRNE	ER,ERRORS-ERRQ
	TLO	ARG,UNDF	;YES,SO TURN UNDF ON
	POP	PP,RC
	POP	PP,V
	TLNE	ARG,TAGF!EXTF
	JRST	ERRAX
	JRST	INSERT
LOC0: PUSHJ	PP,HIGHQ	;AC0=0,0
	HRR	AC0,LOCO
	EXCH	AC0,RELLOC
	PUSHJ	PP,BYPAS1
	TLO	IO,IORPTC
	CAIE	C,EOL
	PUSHJ	PP,EVALXQ
	HLL	AC0,RELLOC
	HRRZM	AC0,LOCA	;SET ASSEMBLY LOCATION
	HRRZM	AC0,LOCO	;AND OUTPUT LOCATION
	HLRZM	AC0,MODA	;SET MODE
	HLRZM	AC0,MODO
	JRST	BLOCK2

IFN RENTSW,<
HISEG0:	PUSHJ	PP,HIGHQ	;SET CURRENT PROGRAM BREAK
	PUSHJ	PP,COUTD	;DUMP CURRENT TYPE OF BLOCK
	PUSH	PP,BLKTYP
	MOVEI	AC0,3
	MOVEM	AC0,BLKTYP
	PUSHJ	PP,BYPAS1	;GO GET EXPRESSION
	TLO	IO,IORPTC
	PUSHJ	PP,EVALXQ	;CHECK FOR EXTERNAL
	HRRZM	AC0,LOCA	;SET LOC COUNTERS
	HRRZM	AC0,LOCO
	MOVEI	RC,1		;ASSUME RELOCATABLE
	PUSHJ	PP,COUT
	MOVEM	RC,MODA		;SET MODES
	MOVEM	RC,MODO
	PUSHJ	PP,COUTD
	POP	PP,BLKTYP
	JRST	BLOCK2
HIGHQ:	JUMP1	POPOUT
HIGHQ1:	SKIPN	MODO
	POPJ	PP,
	MOVE	V,LOCO		;GET ASSEMBLY LOCATION
	CAMLE	V,HHIGH		;IS IT GREATER THAN "HIGH"?
	MOVEM	V,HHIGH		;YES, REPLACE WITH LARGER VALUE
	POPJ	PP,>
IFE RENTSW,<
HIGHQ:	JUMP1	POPOUT
HIGHQ1:	MOVE	V,LOCO
	POPJ	PP,
>
ONML:	TLOA	FR,MWLFLG	;MULTI-WORD LITERALS OK
OFFML:	TLZ	FR,MWLFLG
	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
SUPRS1:	SETZM EXTPNT
	POPJ PP,

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

TITLE0:	JUMP2 REMAR0
	MOVEI SX,.TBUF-1
	HRRI AC0,TBUF
	PUSHJ PP,SUBTT1		;GO READ IT
	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:	JUMP1 REMAR0		;OTHERWISE EXIT IF PASS ONE
	MOVEI SX,.SBUF-1
	HRRI SBUF
SUBTT1:	PUSHJ PP,BYPAS1		;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
	SOJGE SX,SUBTT3		;TEST FOR BUFFER FULL
	DPB RC,AC0		;END, STORE TERMINATOR
	POPJ PP,
IFN CCLSW,<
PRNAM:	TLNN IO,CRPGSW		;NOT IF NOT RPG
	POPJ PP,
	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
	MOVEI C,OTBUF
	DDTOUT C,
	MOVEI C,[ASCIZ /
/]
	DDTOUT C,
	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,SAVERC
	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, EXIT WITH ERROR
	TLO	ARG,SYNF	;FLAG AS SYNONYM
	TLNE	ARG,EXTF	;EXTERNAL?
	HRRZ	V,ARG		;YES, RELPACE WITH POINTER
	MOVEI	SX,SSRCH	;SET FLAG
	JRST	SYN2

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	PURGE5
	PUSHJ	PP,MSRCH	;SEARCH MACRO SYMBOL TABLE
	JRST	PURGE2		;NOT FOUND, TRY SYMBOLS
	TLNE	ARG,MACF	;MACRO?
	PUSHJ	PP,REFDEC	;YES, DECREMENT THE REFERENCE
	JRST	PURGE4		;REMOVE SYMBOL FROM TABLE

PURGE2:	PUSHJ	PP,SSRCH	;TRY OPERAND SYMBOL TABLE
	JRST	PURGE3		;NOT FOUND GET NEXT SYMBOL
	TRNN	RC,-2		;CHECK COMPLEX EXTERNAL
	TLNE	RC,-2
	TLNE	ARG,SYNF
	SKIPA
	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:	MOVE	AC0,V		;PUT VALUE IN AC0
OP:
OPD:	SKIPA	2,[POINT 4,0(PP),12]
IOP:	MOVSI	AC2,(POINT 9,0(PP),11)
	PUSH	PP,RC
	PUSH	PP,AC0		;STACK CODE
	PUSH	PP,AC2
	PUSHJ	PP,EVALEX	;EVALUATE FIRST EXPRESSION
	POP	PP,AC2
	JUMPNC	OP2
	LDB	AC1,AC2
	ADD	AC1,AC0
	DPB	AC1,AC2
	SKIPE	RC		;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
	JRST	STOW		;NO,STOW CODE AND EXIT
EVADR:	TLCE	AC0,-1		;OK IF ALL 0'S
	TLNN	AC0,-1
	SKIPA
	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,20
	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,EVALEX		;EVALUATE
	MOVSS	EXTPNT		;WFW
	MOVSS	V,AC0		;SWAP HALVES
	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
	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
	TLNE	SX,-1		;IS LEFT HALF ZERO?
	TRO	ER,ERRQ		;NO FLAG FORMAT ERROR
OP2A:	ADDM	AC0,-1(PP)	;MERGE WITH PREVIOUS VALUE
	ADDM	RC,-2(PP)
	CAIE	C,11		;")"?
	JRST	ERRAX		;NO, FLAG ERROR
	JRST	BYPAS1		;YES, BYPASS PARENTHESIS

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
	SKIPA	
	SUBI	C,40		;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
	JRST	ERRAX
	MOVE	SX,SEQNO2
	MOVEM	SX,TXTSEQ
	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
	MOVEI	AC0,0		;CLEAR WORD
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

ASC50:	TDZA	RC,SDEL		;TEST FOR ASCIIZ
ASC55:	TROA	ER,ERRA		;SIXBIT FOUND EXIT
ASC60:	PUSHJ	PP,BYPAS1	;POLISH OFF TERMINATE
	SETZM	INTXT		;WE ARE OUT OF IT
	ANDCM	RC,STPX		;STORE AT LEAST ONE WORD
	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
	HRLM	AC0,0(PP)	;SET LEFT HALF
	HRLM	RC,-1(PP)
	MOVSS	EXTPNT		;WFW
	JRST	OP1A		;EXIT THROUGH OP

IOWD0:	PUSHJ	PP,EVALXQ	;EVALUATE AND TEST FOR EXTERNAL
	CAIE	C,14		;","?
	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,BYPAS1	;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
	CAIGE	AC0,0
	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

	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	;YET, GET SYMBOL
	POPJ	PP,
	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,
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	;INITIALZE 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
	PUSH	MP,MRP		;STACK PREVIOUS READ POINTER
REPEA5:	HLRZ	MRP,@REPPNT
REPEA8:	MOVEI	C,LF
	JRST	RSW1

REPEND:	SOSL	REPEXP
	JRST	REPEA5
	HRRZ	V,REPPNT	;GET START OF TREE
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	POP	MP,MRP
	POP	MP,REPPNT
	POP	MP,REPEXP
	JRST	RSW0
REPZ:	MOVE	SDEL,SEQNO2
	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
	JRST	GETCHR

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
	MOVEM	SX,DEFSEQ
	MOVE	SX,PAGENO
	MOVEM	SX,DEFPG
	SETOM INDEF
	MOVEI	SX,0
DEF02:	PUSHJ	PP,GCHAR
	CAIN	C,74
	JRST	DEF20
	CAIE	C,50
	JRST	DEF02
DEF10:	PUSHJ	PP,GETSYM		;YES, GET DUMMY SYMBOL
	TRO	ER,ERRA		;FLAG ERROR
	ADDI	SX,1000		;INCREMENT ARG COUNT
	PUSH	PP,AC0		;STACK IT
	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
	AOS	ARG,SX
	PUSHJ	PP,SKELI	;INITIALIZE MACRO SKELETON
	MOVE	AC0,PPTMP2	;GET NAME
	MOVEM	PP,PPTMP2
	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
	MOVSI	ARG,MACF
	PUSHJ	PP,INSERT	;INSERT/UPDATE
	TLZ	IO,DEFCRS	;JUST IN CASE
	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
	CAIG	CS,"Z"+40	;CONVERT LOWER CASE
	CAIGE	CS,"A"+40
	SKIPA	
	SUBI	CS,40
	CAIL	CS,40
	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
	CAIN	C,74
	AOJA	SDEL,DEF30
	CAIN	C,76
	SOJL	SDEL,DEF70
	CAIE	C,47		;IS THIS A '?
	JRST	DEF30
	SKIPE	SDEL
CPEEK1:	PUSHJ	PP,WCHAR
	PUSHJ	PP,GCHAR
	CAIE	C,47
	JRST	DEF32
	JRST	CPEEK1
DEF40:	MOVEI	AC0,0		;CLEAR ATOM
	MOVSI	AC1,(POINT 6,AC0)	;SET POINTER
DEF42:	PUSH	PP,C
	TLNE	AC1,770000
	IDPB	CS,1
	PUSHJ	PP,GCHAR	;GET NEXT CHARACTER
	MOVE	CS,C
	CAIG	CS,"Z"+40
	CAIGE	CS,"A"+40
	SKIPA	
	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 TP

DEF46:	SKIPN	1(SX)		;END OF LIST?
	JRST	DEF51		;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,0776020(SX)	;(<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
DEF48:	MOVE	PP,PPTMP2		;RESET PUSHDOWN POINTER
	TLO	IO,IORPTC		;ECHO LAST CHARACTER
	JRST	DEF31

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	BYPAS1
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
	MOVE	SDEL,SEQNO2
	MOVEM	SDEL,CALSEQ
	MOVE	SDEL,PAGENO
	MOVEM	SDEL,CALPG
	HLRZ	V,0(V)
	AOS	SDEL,0(V)	;INCREMENT ARG COUNT
	LSHC	SDEL,-^D<9+36>	;ZERO SDEL, GET ARG COUNT IN SX
	ANDI	SX,777		;MASK
	PUSH	PP,V		;STORE COUNT OF ARGS
	PUSH	PP,RP		;STACK FOR MACPNT
	JUMPE	SX,MAC20	;TEST FOR NO ARGS
	PUSHJ	PP,CHARAC
	CAIE	C,"("		;"("
	TROA	SDEL,-1		;YES, END OF ARGUMENT STRING

MAC10:	PUSHJ	PP,GCHAR
	CAIG	C,CR
	CAIGE	C,LF
	SKIPA
	JRST	MAC21
	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
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
	SKIPA
	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
	SOJG	SX,MAC10	;BRANCH IF NO MORE ARGS
MAC20:	TLZN	IO,IORPTC
	PUSHJ	PP,CHARAC
MAC21:	EXCH	MP,RP
MAC21A:	PUSH	MP,[-1]		;NO MISSING ARGS
	SOJGE	SX,MAC21A
	SETZM	0(MP)
	LDB	C,LBUFP
	MOVEI	SX,"^"
	JUMPAD	MAC24
	CAIN	C,";"
	SKIPE	MRP
	JRST	MAC24
	PUSHJ	PP,STOUT	;LIST COMMOENT 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
	PUSH	MP,MACPNT
	POP	PP,MACPNT
	PUSH	MP,C
	PUSH	MP,MRP		;STACK WORD COUNT
	POP	PP,MRP		;STACK MACRO 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	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)
	SKIPE	C		;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
	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
	HLRZ	CS,0(MRP)
	SKIPE	MACENL		;CHECK UPROCESSED END LEVEL
	JUMPE	CS,MACEN0	;THEN POP THE MACRO STACK NOW
	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,0(C)
	PUSH	MP,IRPPOI

	HRRZM	C,IRPARP
	MOVEM	AC0,IRPCF	;IRPC FLAG FOUND IN AC0
	SETOM	AC0,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,WCHAR
	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
	SKIPG	CS,IRPARG
	JRST	IRPPOP		;EXIT IF NOT VALID ARGUMENT
	HLRZ	C,0(CS)		;INITIALIZE POINTER
	MOVEM	C,IRPARG
IRPSET:	EXCH	MRP,IRPARG		;SWAP READ POINTERS
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON FOR DATA
	HRRZM	ARG,@IRPARP	;STORE NEW DS POINTER
	SETZB	SX,SDEL		;ZERO FOUND FLAG AND BRACKET COUNT
IRPSE1:	PUSHJ	PP,MREADS
	CAIE	C,177		;SPECIAL?
	AOJA	SX,IRPSE2	;NO, FLAG AS FOUND
	MOVEM	MRP,V
	PUSHJ	PP,MREADS	;LOOK AT NEXT CHARACTER
	MOVE	MRP,V
	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
	HLRZ	MRP,@IRPPOI	;SET FOR NEW SCAN
	JRST	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,MRP		;RESTORE CELLS
	POP	MP,IRPPOI
	POP	MP,@IRPARP
	POP	MP,IRPARG
	POP	MP,IRPARP
	POP	MP,IRPSW
	POP	MP,IRPCF
	JRST	REPEA8
GETDS:	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
	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	;WRITE INTO SKELETON
	PUSHJ	PP,WWORD
	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END CODE
	POP	PP,MWP		;RESTORE MACRO WRITE POINTER
	POP	PP,WWRXX
	MOVE	V,ARG		;SET UP FOR REFINC

GETDS1:	PUSHJ PP,REFINC		;INCREMENT REFERENCE
	PUSH MP,V		;STACK V FOR DECREMENT
	PUSH MP,MRP		;STACK READ POINTER
	HLRZ MRP,0(V)		;FORM READ POINTER
	JRST RSW0		;EXIT

DSEND:	POP MP,MRP
	POP MP,V
	PUSHJ PP,REFDEC		;DECREMENT REFERENCE
	JRST RSW0		;EXIT
SKELI1:	MOVEI	ARG,1	;ENTRY FOR SINGLE ARG
SKELI:	MOVE	MWP,LADR
	PUSHJ	PP,SKELWL	;GET POINTER WORD
	HRRZM	MWP,WWRXX	;SAVE FIRST ADDRESS
	PUSHJ	PP,SKELWL
	HRRM	ARG,0(MWP)	;STORE COUNT
	HRRZ	ARG,WWRXX	;SET FIRST ADDRESS
	;SKEW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)

SKELWL:	SKIPE	V,NEXT		;GET FIRST FREE ADDRESS
	JRST	SKELW1		;IF NON-ZERO, UPDATE FREE
	AOS	V,FREE		;INCREMENT BY LEAF SIZE
	CAML	V,SYMBOL	;OVERFLOW?
	PUSHJ	PP,XCEED	;YES, BOMB OUT
	SETZM	(V)		;CLEAR LINK

SKELW1:	HLL	V,0(V)		;GET ADDRESS
	HLRM	V,NEXT		;UPDATE NEXT
	HRLM	V,0(MWP)	;STORE LINK IN FIRST WORD OF LEAF
	HRRZ	MWP,V
	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:	SKIPE	MACLVL
	JRST	MREADS		;IF GETTING CHAR. FROM TREE
GCHAR:	PUSHJ	PP,CHARAC	;GET ASCII CHARACTER
	CAIE	C,LF		;TEST FOR LF, VT OR FF
	CAIN	C,FF
	PUSHJ	PP,OUTIM1	;YES, LIST IT
	POPJ	PP,

WCHARQ:	SKIPE	MACLVL
	JRST	WCHAR
WCHAR:	TLNN	MWP,770000	;END OF WORD?
	PUSHJ	PP,SKELWL	;YES, GET ANOTHER
	IDPB	C,MWP
	POPJ	PP,

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

WWRXE:	PUSHJ	PP,WWORD	;WRITE LAST WORD
	HRRZS	(MWP)		;ZERO LEFT HALF OF LAST LEAF
	HRRM	MWP,@WWRXX	;SET POINTER TO END
	POPJ	PP,
MREAD:	PUSHJ	PP,MREADS	;READ ON 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		;YES
	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

MREADS:	TLNE	MRP,770000	;HAVE WE FINISHED WORD?
	JRST	MREADC		;STILL CHAR. IN LEAF
	HLRZ	MRP,0(MRP)	;YES, GET LINK
	HRLI	MRP,(POINT 7,,21)	;SET POINTER
MREADC:	ILDB	C,MRP		;GET CHARACTER
	POPJ	PP,

REFINC:	HLRZ	CS,0(V)		;GET POINTER TO FREE
	AOS	0(CS)		;INCREMENT REFERENCE
	POPJ	PP,
REFDEC:	HLRZ	CS,0(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,

A==   0                       ;ASCII MODE
AL==    1                       ;ASCII LINE MODE
IB==    13                      ;IMAGE BINARY MODE
B==     14                      ;BINARY 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
SUBTTL	I/O ROUTINES
BEG:
IFN CCLSW,<TLZA IO,ARPGSW	;DON'T ALLOW RAPID PROGRAM GENERATION
	TLO	IO,ARPGSW	;ALLOW RAPID PROGRAM GENERATION
	TLZA	IO,CRPGSW	;SET TO INITI NEW COMMAND FILE
M:	TLNN	IO,CRPGSW	;CURRENTLY DOING RPG?>
IFE CCLSW,<M:>
	RESET			;INITIALIZE PROGRAM
	SETZB	MRP,PASS1I
	MOVE	[XWD PASS1I,PASS1I+1]
	BLT	PASS2X-1	;ZERO THE PASS1 AND PASS2 VARIABLE
	MOVEI	PP,JOBFFI	;SET TEMP PUSH-DOWN POINTER
	MOVE	CS,[POINT 7,DBUF]	;INITIALIZE FOR DATA
	MSTIME	2,		;GET TIME FROM MONITOR
	IDIVI	2,^D60*^D1000
	IDIVI	2,^D60
	PUSH	PP,3		;SAVE MINUTES
	PUSHJ	PP,OTOD1
	POP	PP,2
	PUSHJ	PP,OTOD1
	DATE	1,
	IDIVI	1,^D31		;GET DAY
	ADDI	2,1
	CAIG	2,^D9		;TWO DIGITS?
	ADDI	2,7760*^D10	;NO, PUT IN SPACE
	PUSHJ	PP,OTOD1	;STORE DAY
	IDIVI	1,^D12		;GET MONTH
	MOVE	2,DTAB(2)	;GET MNEMONIC
	ADDI	CS,1
	MOVEM	2,0(CS)
	MOVEI	2,^D64(1)	;GET YEAR
	PUSHJ	PP,OTOD		;STORE IT
	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:	RELEAS	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
	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,0
	INPUT	CTL,0
IFN CCLSW,<JRST BINSET		;BEGIN WITH BINARY FILE
RPGSET:
IFN TEMP,<HRRZ 3,JOBFF		;GET START OF BUFFER AREA
	HRRM 3,TMPFIL+1	;STORE IN TMPCOR UUO IOWD
	SOS TMPFIL+1		;MAKE IT THE PROPER IOWD FORMAT
	HRRM 3,CTLBLK+1		;DUMMY UP BUFFER HEADER
	MOVE 0,[XWD 2,TMPFIL]	;SET UP FOR TEMP CORE READ
	TMPCOR    		;READ AND DELETE FILE "MAC"
	JRST RPGTMP		;NO SUCH FILE IN CORE TRY DISK
	ADD 3,0			;CALCULATE END OF BUFFER
	MOVEM 3,JOBFF		;FIX JOBFF SO FILE WONT BE KILLED
	IMULI 0,5		;CALCULATE CHARACTER COUNT
	MOVEM 0,CTLBLK+2	;SET UP CHAR CNT IN BUFFER HEADER
	MOVEI 0,440700		;SET UP BYTE POINTER IN HEADER
	HRLM 0,CTLBLK+1		;BUUFER HEADER NOW SET UP
	SETOM TMPFLG		;MARK THAT A TMPCOR UUO WAS DONE
	JRST RPGS2A		;CONTINUE IN MAIN STREAM
RPGTMP:>
	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	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			;...
	TLNE	IO,CRPGSW		;ARE WE ALREAD 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,[POINT 7,CTLBUF]	;WHERE TO STASH CHARS
	MOVEM	AC1,CTIBUF+1	;...
GOSET1:	SOSG	CTLBLK+2		;ANY MORE CHARS?
	PUSHJ	PP,[IFN TEMP,<SKIPE TMPFLG	;TMPCOR UUO IN PROGRESS?
	          EXIT		;YES EXIT>
		 IN CTL2,		;READ ANOTHER BUFFERFUL
		 POPJ PP,		;EVERYTHING OK, RETURN
		 STATO CTL2,20000	;EOF?
		 JRST [HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
			JRST ERRNE0]	;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	;GET NEXT CHAR
	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	ERRNE0		;GO COMPLAIN
GOSET2:	MOVEI	C,12		;MAKE SURE THERE'S A LF
	IDPB	C,CTIBUF+1	;...
	MOVEM	AC1,CTIBUF+1	;SET POINTER TO BEGINNING
	MOVE	AC0,SAVFF	;RESET JOBFF FOR NEW BINARY
	MOVEM	AC0,JOBFF	;...
	JRST BINSET
RPGS1:	PUSHJ	PP,DELETE		;DELETE COMMAND FILE
	MOVEM	ACDEV,RPGDEV	;GET SET TO INIT
	PUSHJ	PP,RPGINI
	MOVEM	ACFILE,INDIR	;USE INPUT BLOCK
	MOVEM	ACEXT,INDIR+1
	LOOKUP	CTL2,INDIR
	JRST	RPGLOS
	HLRM	ACEXT,EXTMP	;SAVE THE EXTENSION
	HLRZ	JOBSA		;RESET JOBFF TO ORIGINAL
	MOVEM	JOBFF
	TLO	IO,CRPGSW	;TURN ON SWITHC 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,"!" 	;CHECK FOR A NEW RPG FILE
	JRST	NUNSET
	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,ERRCM	;IGNORE IF JUST <CR-LF>
	TLO	FR,PNCHSW	;OK, SET SWITCH
	MOVEM	ACDEV,BINDEV	;STORE DEVICE NAME
	MOVEM	ACFILE,INDIR	;STORE FILE NAME IN DIRECTORY
	SKIPN	ACEXT		;EXTENSION SPECIFIED?
	MOVSI	ACEXT,(SIXBIT /REL/)	;NO, ASSUME RELOCATABLE BINARY
	MOVEM	ACEXT,INDIR+1	;STORE IN DIRECTORY
	PUSHJ	PP,BININI	;INITIALIZE BINARY
	TLZE TIO,TIOLE		;SKIP TO EOT
	MTEOT. BIN,
	TLZE	TIO,TIORW	;REWIND REQUESTED?
	MTREW.	BIN,		;YES
	JUMPGE	CS,BINSE2	;BRANCH IF NO BACK-SPACE
	MTBSF.	BIN,		;BACK-SPACE A FILE
	AOJL	CS,.-1		;TEST FOR END
	MTWAT.	BIN,
	STATO	BIN,1B24	;LOAD POINT?
	MTSKF.	BIN,		;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
	ENTER	BIN,INDIR
	JRST	ERREF
	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
	SKIPN	ACDEV		;YES, WAS DEVICE SPECIFIED?
	MOVSI	ACDEV,(SIXBIT /DSK/)	;NO, ASSUME DSK
	SKIPN	ACFILE
	MOVE	ACFILE,[SIXBIT /CREF/]
	SKIPN	ACEXT
	MOVSI	ACEXT,(SIXBIT /LST/)
LSTSE2:	JUMPE	ACDEV,GETSET	;FORGET LISTING IF NO DEVICE SPECIFIED
	MOVEM	ACDEV,LSTDEV
	MOVE	AC0,1
	DEVCHR	AC0,
	TLNN	AC0,2
	TLNE	FR,CREFSW	; WAS CROSS-REF REQUESTED?
	AOSA	OUTSW		;NO, ASSUME TTY
	JRST	ERRCM		;YES, ERROR - CREF DEV MUST NO TBE LPT, DIS OR TTY
	TLNE	AC0,TTYBIT	;CONTROLING TELETYPE LISTING?
	JRST	GETSET		;YES, BUFFER ALREADY SET
	AOS	OUTSW		;SET FOR LPT
	MOVEM	ACFILE,INDIR
	SKIPN	ACEXT
	MOVSI	ACEXT,(SIXBIT /LST/)
	MOVEM	ACEXT,INDIR+1
	PUSHJ	PP,LSTINI
	TLZE	TIO,TIOLE
	MTEOT.	LST,
	TLZE	TIO,TIORW
	MTREW.	LST,
	JUMPGE	CS,LSTSE3
	MTBSF.	LST,
	AOJL	CS,.-1
	MTWAT.	LST,
	STATO	LST,1B24
	MTSKF.	LST,
LSTSE3:	SOJG	CS,.-1
	TLNE	TIO,TIOCLD	;DIRECTORY CLEAR REQUESTED?
	UTPCLR	LST,		;YES, CLEAR IT
	OUTBUF	LST,2		;SET UP A TWO RING BUFFER
	ENTER	LST,INDIR
	JRST	ERREF
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
	HRRZM	3,LADR		;SET START OF MACRO TREE
	HRRZM	3,FREE

GETSE1:	HRRZ	JOBREL
	SKIPE	JOBDDT
	HRRZ	JOBSYM
	SUBI	1
	MOVEM	SYMTOP
	SUBI	LENGTH
	CAMLE	LADR
	JRST	GETSE2

	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
	MOVE	AC0,CTIBUF+1
	MOVEM	AC0,CTLSAV
	MOVSI	AC0,(SIXBIT 'DSK')
	MOVEM	AC0,ACDEVX
	PUSHJ	PP,INSET

	MOVEI	CS,[ASCIZ /MACRO: /]	;PUBLISH COMPILER NAME
	TLNE	IO,CRPGSW	;PUNCH REQUESTED?
	DDTOUT	CS,
	JRST	ASSEMB

FINIS:	CLOSE	BIN,		;DUMP BUFFER
	TLNE	FR,PNCHSW	;PUNCH REQUESTED?
	PUSHJ	PP,TSTBIN	;YES, TEST FOR ERRORS
	RELEAS	BIN,
	CLOSE	LST,
	SOSLE	OUTSW		;LPT TYPE OUTPUT?
	PUSHJ	PP,TSTLST	;YES, TEST FOR ERRORS
	RELEAS	LST,
	CLOSE	CHAR,
	RELEAS	CHAR,
	OUTPUT	CTL,0		;FLUSH TTY OUTPUT
	JRST	M
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
	PUSHJ	PP,INDEVI
	DEVCHR	ACDEV,		;TEST CHARACTERISTICS
	TLNN	ACDEV,MTABIT	;MAG TAPE?
	JRST	INSET3		;NO
	TLZN	FR,MTAPSW	;FIRST MAG TAPE IS 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
	MTEOT.	CHAR,
	TLZE	TIO,TIORW	;REWIND?
	MTREW.	CHAR,		;YES
	JUMPGE	CS,INSET2
	MTBSF.	CHAR,
	MTBSF.	CHAR,
	AOJL	CS,.-1
	MTWAT.	CHAR,
	STATO	CHAR,1B24
	MTSKF.	CHAR,
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	SDEL,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
	MOVSI	SDEL,(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
	POPJ	PP,

INSETI:	HLLM	ACEXT,INDIR+1	;STORE EXTENSION
	LOOKUP	CHAR,INDIR
	TDZA	ACEXT,ACEXT
	AOS	0(PP)
	POPJ	PP,
REC2:	MOVE	CTLSAV
	MOVEM	CTIBUF+1
	MOVEI	"_"
	HRLM	BLKTYP
	SETZM	ACDEVX
	MOVE	[XWD PASS2I,PASS2I+1]
	BLT	PASS2X-1		;ZERO PASS2 VARIABLES
	TLOA	FR,MTAPSW!LOADSW	;SET FLAGS
	INPUT	CHAR,

GOTEND:	STATO	CHAR,1B22		;TEST FOR EOF
	JRST	.-2

EOT:	PUSHJ	PP,SAVEXS		;SAVE REGISTERS
	RELEAS	CHAR,
	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
	MOVE	RC,SAVERC		;RESTORE RC
	POPJ	PP,

SAVEXS:	MOVEM RC,SAVERC		;SAVE RC
	MOVEI	RC,SAVBLK		;SET POINTER
	BLT	RC,SAVBLK+RC-1	;BLT ALL REGISTERS BELOW EC
	POPJ	PP,		;EXIT

NAME2:	SKIPA	ACDEV,ACDEVX
NAME1:	SETZB	ACDEV,INDIR+2
	MOVEI	ACFILE,0		;CLEAR FILE
	HLRZ	ACDEL,ACDELX	;GET PREVIOUS DELIMITER
	SETZB	TIO,CS
	SETZB	ACEXT,INDIR+3	;RESET EXTENSION AND PROGRAM-NUMBER PAIR
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 IMPARTIVE?
	CAIN	C,"@"
	JRST	TERM		;YES, GO DO IT>
	CAIE	C,33		;CHECK FOR THREE FLAVORS OF ALT-MODE
	CAIN	C,176		;...
	JRST	TERM		;...
	CAIE	C,175		;OR 3RD ALTMOD
	CAIN	C,CR		;CR?
	JRST	TERM
	CAIN	C,"["
	JRST	PROGNP
	CAIE	C,","
	CAIN	C,"_"
	JRST	TERM
	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:	SKIPA	ACDEV,0		;ERROR IF ALREADY SET

NAME:	MOVE	ACFILE,AC0	;FILE NAME
	MOVE	ACDEL,C		;SET DELIMITER
	JRST	NAME3

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
	MOVEM	ACDEV,ACDEVX	;USE LAST DEVICE
	CAIN	C,"!"		;IMPERATIVE?
	POPJ	PP,		;YES, DON'T ASSUME DEV
	JUMPE	ACFILE,POPOUT	;IF THERE IS A FILE,
	SKIPN	ACDEV		;BUT NO DEVICE
	MOVSI	ACDEV,(SIXBIT /DSK/)	;THEN ASSUME DISK
	POPJ	PP,		;EXIT

PROGNP:	JUMPL	PP,PROGN2

ERRCM:	HRROI	RC,[SIXBIT /COMMAND ERROR@/]
	JRST	ERRNE0

PROGN1:	HRLZM	RC,INDIR+3
PROGN2:	MOVEI	RC,0		;CLEAR AC
PROGN3:	PUSHJ	PP,TTYIN
	CAIN	C,","
	JRST	PROGN1		;STORE LEFT HALF
	HRRM	RC,INDIR+3
	CAIN	C,135
	JRST	GETIOC
	LSH	RC,3		;SHIFT PREVIOUS RESULT
	ADDI	RC,-"0"(C)	;ADD IN NEW NUMBER
	JRST	PROGN3
SWITC0:	PUSHJ	PP,SW1
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,

	DEFINE	SETSW	(LETTER,INSTRUCTION)	< INSTRUCTION
J=	<"LETTER"-"A">-9*<I=<"LETTER"-"A">/9>
	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	>
	SETSW	L,<TLZ	IO,IOMSTR	>
	SETSW	N,<HLLOS	TYPERR		>
	SETSW	Q,<TLO	FR,ERRQSW	>
	SETSW	S,<TLO	IO,IOMSTR	>
	SETSW	T,<TLO	TIO,TIOLE	>
	SETSW	W,<TLO	TIO,TIORW	>
	SETSW	X,<TLO	IO,IOPALL	>
IFG .-SWTAB-17,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>

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

        +BYTAB0                 ;A-G    BYTE = 1 THROUGH 17 = INDEX
        +BYTAB1                 ;H-N    BYTE = 0 = COMMAND ERROR
        +BYTAB2                 ;O-U

TTYIN:	ILDB	C,CTIBUF+1		;GET CHARACTER
	CAIE	C," "		;SKIP BLANKS
	CAIN	C,HT		;AND TABS
	JRST	TTYIN
	CAIE	C,LF
	POPJ	PP,

ERRNE:	HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]
	PUSHJ PP,TYPMSG
	SKIPN LITLVL		;SET IF IN LITERAL
	JRST ERRNE1		;NO, TRY OTHERS
	MOVE V,[XWD [SIXBIT /LITERAL@/],LITPG]
	PUSHJ PP,PRNUM
ERRNE1:	MOVEI V,0		;CHECK FOR OTHER PLACES
	SKIPE INDEF
	MOVE V,[XWD [SIXBIT /DEFINE@/],DEFPG]
	SKIPE INTXT
	MOVE V,[XWD [SIXBIT /TEXT@/],TXTPG]
	SKIPE INREP
	MOVE V,[XWD [SIXBIT /CONDITIONAL OR REPEAT@/],REPPG]
	SKIPGE MACENL
	MOVE V,[XWD [SIXBIT /MACRO CALL@/],CALPG]
	SKIPE V
	PUSHJ PP,PRNUM		;GO PRINT INFORMATION
	HRROI RC,[SIXBIT /@/]	;WILL GET A RETURN
	JRST ERRNE0

ERRMS3:	SIXBIT / ERRORS DETECTED@/
ERRMS2:	SIXBIT /?1 ERROR DETECTED@/
ERRMS1:	SIXBIT /NO ERRORS DETECTED@/
EINIT:	MOVE	RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
	JRST	ERRNE0
ERREF:	SKIPA	RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
ERRCF:	MOVE	RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]
ERRNE0:	PUSHJ	PP,CRLF
	MOVEI	C,77
	PUSHJ	PP,TYO
	PUSHJ	PP,TYPMS1
	JRST	M
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
	CAIE	C,FF		;FORM FEED?
	CAIN	C,LF		;V TAB OR LINE FEED?
	OUTPUT	CTL,0		;YES
	POPJ	PP,		;AND EXIT

TYPM2:	MOVSI	C,(1B0)		;ANTICIPATE REGISTER WORD
	CAIG	CS,17		;IS IT?
	MOVEM	C,1(CS)
	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)
XCEED2:	HRROI	RC,[SIXBIT /INSUFFICIENT CORE@/]
	CORE	0		;REQUEST MORE CORE
	JRST	ERRNE0		;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,116
	ADDM	1,SYMTOP
	PUSHJ	PP,SRCHI	;RE-INITIALIZE SYMBOL TABLE
	JRST	RSTRXS	;RESTORE REGISTERS AND EXIT

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

PRNUM:	HLRZ CS,V	;GET MESSAGE
	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,
	MOVEM AC1,OUTSQ
	MOVEI AC0,OUTSQ
	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)
	SKIPE AC0
	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
	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:	OUTPUT	BIN,0		;DUMP THE BUFFER
TSTBIN:	STATO	BIN,740000	;GET STATUS BITS
	POPJ	PP,		;NO, EXIT
	MOVE	AC0,BINDEV	;YES, GET TAG
	JRST	ERRLST

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 0,R1BBLK(C)
	AOS LOCO
	CAIN C,21
	PUSHJ PP,R1BDMP
	AOS RIMLOC
	POPJ PP,
READ0:	PUSHJ	PP,EOT
READ:	SOSG	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 NU
	PUSHJ PP,READ	;AND THE TAB
	JRST	READ		;GET NEXT CHARACTER

READ1A:	JUMPE	C,READ		;IGNORE NULL
	JUMP2	READ1B
	CAIN	C,14
	AOS	PAGENO
READ1B:	CAIN	C,32		;IF IT'S A "^Z"
	MOVEI	C,LF		;TREAT IT AS A "LF"
	CAIE	C,37		;CONTROL _
	POPJ	PP,
READ2:	PUSHJ	PP,READ		;YES, TEST FOR LINE FEED
	PUSHJ	PP,RSW2		;LIST IN ANY EVENT
	CAIE	C,LF		;IS IT LF
	JRST	READ2		;NO
	PUSHJ	PP,OUTIM1		;YES, DUMP THE LINE
	JRST	READ		;RETURN NEXT CHARACTER

READ3:	INPUT	CHAR,0		;GET NEXT BUFFER
	STATO	CHAR,762000	;NO ERRORS
	JRST	READ1
	STATO	CHAR,742000	;ERRORS?
	JRST	READ0		;EOF
	MOVE	AC0,INDEV
	MOVSI	RC,[SIXBIT /INPUT ERROR ON DEVICE@/]
	JRST	ERRNE0
OUTAB2:	PUSHJ	PP,OUTTAB	;PRINT TWO TABS
OUTTAB:	MOVEI	C,HT
PRINT:	CAIN	C,LF		;IS THIS A LF?
	JRST	OUTCR		;YES, GO PROCESS
	CAIN	C,CR		;OR CR?
	POPJ	PP,
	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
	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
	MOVE	C,PAGENO
	PUSHJ	PP,DNC		;OUTPUT PAGE NUMBER
	AOSG	PAGEN.		;FIRST PAGE OF THIS NUMBER?
	JRST	OUTL1
	MOVEI	C,"-"		;NO, PUT OUT MODIFIER
	PUSHJ	PP,OUTC
	MOVE	C,PAGEN.
	PUSHJ	PP,DNC
OUTL1:	PUSHJ	PP,OUTCR
	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
	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
	IDPB	C,LSTBUF+1	;STORE BYTE
	POPJ	PP,
DMPLST:	OUTPUT	LST,0		;OUTPUT BUFFER
TSTLST:	STATO	LST,740000
	POPJ	PP,
	MOVE	0,LSTDEV
ERRLST:	MOVSI	RC,[SIXBIT /DATA ERROR DEVICE@/]
	JRST	ERRNE0
PAGE0:
OUTFF:	AOS	PAGENO
	SETOM	PAGEN.
	TLO	IO,IOPAGE
	POPJ	PP,

OTOD1:	IBP	CS
OTOD:	IDIVI	2,^D10
	ADDI	2,60		;FORM ASCII
	IDPB	2,CS
	ADDI	3,60
	IDPB	3,CS
	POPJ	PP,

DTAB:	ASCII "JAN-"
	ASCII "FEB-"
	ASCII "MAR-"
	ASCII "APR-"
	ASCII "MAY-"
	ASCII "JUN-"
	ASCII "JUL-"
	ASCII "AUG-"
	ASCII "SEP-"
	ASCII "OCT-"
	ASCII "NOV-"
	ASCII "DEC-"
SUBTTL	MACHINE INSTRUCTION SEARCH ROUTINES
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
OPT1D:	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,OPD			;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:	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:
	POINT	9,OP1COD-1(ARG),35
	POINT	9,OP1COD(ARG),8
	POINT	9,OP1COD(ARG),17
	POINT	9,OP1COD(ARG),26

IFDEF .XCREF,<	.XCREF	;DON'T CREF THIS MESS>
	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
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
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	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	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
IFN RENTSW, <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	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	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	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,<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	UFA   ,	130
X	UGETF ,	073
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	XWD   ,	734

X	Z     ,	000




IF1, <  BLOCK   N1>
OP1END: -1B36
OP1COD: BLOCK   N1/4
        CC


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!40,B>

P	@,	0
PRMTBL:			;PERMANENT SYMBOLS
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	DRUM,	400
P	DSK,	170
P	DTC,	210
P	DTS,	214
P	LPT,	124
P	MDF,	260
P	MTC,	220
P	MTM,	230
P	MTS,	224
P	PI,	4
P	PLT,	140
P	PTP,	100
P	PTR,	104
P	TDC,	320
P	TDS,	324
P	TMC,	340
P	TMS,	344
P	TTY,	120
P	UTC,	210
P	UTS,	214
P	??????,	0
PRMEND:				;END OF PERMANENT SYMBOLS

LENGTH= .-SYMNUM			;LENGTH OF INITIAL SYMBOLS

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

OP1TAB:

	ZL	PAGE0			;PAGE
	ZL	PASS20			;PASS2
	ZL	PHASE0			;PHASE
	Z	POINT0			;POINT
	ZL	PRINT0			;PRINTX
	ZL	PURGE0			;PURGE
	ZL	RADIX0			;RADIX
	Z	RADX50			;RADIX50,SQUOZE
	ZL	LOC0	(1)		;RELOC
	ZL	REMAR0			;REMARK
	ZL	REPEA0			;REPEAT
	ZL	SUPRE0			;SUPRESS
	Z				;?
	ZL	RIM0	(RIMSW)		;RIM
	DATAI	0,IOP			;RSW
	Z	ASCII0	(1)		;SIXBIT
	Z
	Z
;	ZL	IOSET	(IOPALL!IOSALL)	;SALL
	ZL	STOPI0			;STOPI
	ZL	SUBTT0	(Z (POINT 7,,))	;SUBTTL
	ZL	SYN0			;SYN
	ZL	TAPE0			;TAPE
	ZL	TITLE0	(Z (POINT 7,,))	;TITLE
	ZL	VAR0			;VAR

	Z
	Z
	ZL	IOSET	(IOPALL)	;XALL
	ZL	IOSET	(IOPROG)	;XLIST
	Z	XWD0			;XWD
	ZL	RIM0	(RIM1SW)	;RIM10
	ZL	RIM0	(R1BSW)		;RIM10B
OP2TAB:

	Z	ASCII0	(0)		;ASCII
	Z	ASCII0	(1B18)		;ASCIZ
	BLKI	IOP			;BLKI
	BLKO	IOP			;BLKO
	ZL	BLOCK0			;BLOCK
	ZL	SUPRSA			;ASUPPRESS
IFN RENTSW,<	ZL	HISEG0			;HISEG>
IFE RENTSW,<	Z				;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
	ZL	DEFIN0			;DEFINE

	ZL	DEPHA0			;DEPHASE
	ZL	END0			;END
	ZL	INTER0	(INTF!ENTF)	;ENTRY
	Z	EXPRES			;EXP
	ZL	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
	ZL	INTER0	(INTF)		;INTERN
	Z	IOWD0			;IOWD
	ZL	IRP0	(0)		;IRP
	ZL	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
	ZL	IORSET	(IOPALL)	;LALL
	ZL	IORSET	(IOPROG)	;LIST
	ZL	LIT0			;LIT
	ZL	LOC0	(0)		;LOC
	ZL	IOSET   (IONCRF)	;CREF
;	ZL	OFFSYM			;NOSYM
	Z	OCT0	(^D8)		;OCT
	ZL	OPDEF0			;OPDEF
	JFCL	1,OP			;JFOV
	ZL	ONML			;MLON
	ZL	OFFML			;MLOFF
;	TRN	ASCII0	(3B19)		;COMMENT

	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:	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
	TLOE	IO,IOCREF	;HAVE WE PUT OUT THE 177,102
	JRST	CREF3		;YES
	PUSH	PP,C		;START OF CREF DATA
	MOVEI C,0
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,OUTL	;GET CORRECT SUBTTL
	MOVEI C,177
	PUSHJ PP,OUTLST
	MOVEI C,102
	PUSHJ PP,OUTLST
	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,

CLSCRF:	TRNN ER,LPTSW
	POPJ PP,		;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	TLZE IO,IOCREF	;FINISH UP LINE
	JRST CLSCR1
	MOVEI C,177
	PUSHJ PP,PRINT
	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,POPOUT	;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,POPOUT	;NOT FOUND

SRCH4:	AOS	0(PP)		;SET FOR SKIP EXIT
SRCH5:	MOVSI ARG,SUPRBT	;HE IS USING IT, TURN OFF BIT
	ANDCAM ARG,0(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
	POPJ	PP,

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
	POPJ PP,
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,XCEED
	ADDI	SDEL,2000
	ADDI	SX,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		;SPECIAL LEFT OR RIGHT EXTERNAL?
	TRNE	RC,-2
	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
	HRR	ARG,SDEL	;POINT 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,0(SDEL)
	HRRI ARG,-1(SDEL)	;POINT TO THE 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,0(SX)
	MOVEM	0,2(SX)		;OVERWRITE THE DELETED SYMBOL
	CAME	SX,SYMBOL	;SKIP WHEN DONE
	SOJA	SX,REMOV1
	ADDI	SX,2
	MOVEM	SX,SYMBOL
	SOS	0,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,
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 ANY CURRENT EXTERNS
	TRNE RC,-2
	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
	HRR	ARG,SDEL	;POINT 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 VALUES
	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 RELCATION BITS
	POPJ PP,		;AND EXIT

UPDAT5:	MOVEI SDEL,2		;THERE IS A EXTERNAL
	ADDB SDEL,FREE		;SO WE NEED TWO LOCATIONS
	CAML SDEL,SYMBOL	;NEED MORE CORE?
	PUSHJ PP,XCEEDS		;YES
	MOVEM RC,0(SDEL)	;SAVE RELOCATION BITS
	HRRI ARG,-1(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	STORAGE CELLS

IFN PURESW,<
	LOC	140
>
PASS1I:

RP:	BLOCK	1
IFE CCLSW,<CTIBUF:	BLOCK	3
CTOBUF:	BLOCK	3
>

IFN CCLSW,<CTLBUF:	BLOCK	<CTLSIZ+5>/5
IFN RUNSW,<RUNDEV:	BLOCK	1
RUNFIL:	BLOCK	3
RUNPP:	BLOCK	2>>
LSTBUF:	BLOCK	3
BINBUF:	BLOCK	3
IBUF:	BLOCK	3
IFN CCLSW,<IFE RUNSW,<NUNDIR:>>
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,<HHIGH: BLOCK 1	;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.>
IFBLK:	BLOCK	.IFBLK
IFBLKA:	BLOCK	.IFBLK
LADR:	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
SYMCNT:	BLOCK 1	

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

TABP:	BLOCK	1
TBUF:	BLOCK	.TBUF/5
TYPERR:	BLOCK	1

PASS2I:

ACDEVX:	BLOCK	1
CPL:	BLOCK	1
CTLSAV:	BLOCK	1
EXTPNT:	BLOCK	1
INTENT:	BLOCK	1
INREP:	BLOCK 1	 
INDEF:	BLOCK 1	 
INTXT:	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	 
IRPARG:	BLOCK	1
IRPARP:	BLOCK	1
IRPCF:	BLOCK	1
IRPPOI:	BLOCK	1
IRPSW:	BLOCK	1
LITLVL:	BLOCK	1

ASGBLK:	BLOCK	1
LOCBLK:	BLOCK	1

LOCA:	BLOCK	1
LOCO:	BLOCK	1
RELLOC:	BLOCK	1
LPP:	BLOCK	1
LSTSYM:	BLOCK	1
MACENL:	BLOCK	1
MACLVL:	BLOCK	1
MACPNT:	BLOCK	1
MODA:	BLOCK	1
MODLOC:	BLOCK	1
MODO:	BLOCK	1
IFN CCLSW,<OTBUF:	BLOCK 2 >
OUTSQ:	BLOCK 2
PAGENO:	BLOCK	1
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
SEQNO2:	BLOCK 1	 
TAGINC:	BLOCK	1
VECREL:	BLOCK	1
VECTOR:	BLOCK	1
WWRXX:	BLOCK	1
PASS2X:		 
SUBTTL	MULTI-ASSEMBLY STORAGE CELLS

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	>
IFN TEMP,<TMPFLG:	BLOCK 1>
	VAR			;CLEAR VARIABLES

	SUBTTL	CONSTANTS

IFN TEMP,<TMPFIL: SIXBIT /MAC/
	XWD	-200,0>
TAG:	BLOCK	1
	SIXBIT	/ + @/
TABI:
	BYTE	(7) 0, 11, 11, 11, 11
SEQNO:	BLOCK	1
	ASCIZ	/	/
BININI:	INIT	1,B
BINDEV:	BLOCK	1
	XWD	BINBUF,0
	JRST	EINIT
	POPJ	PP,
LSTINI:	INIT	3,AL
LSTDEV:	BLOCK	1
	XWD	LSTBUF,0
	JRST	EINIT
	POPJ	PP,
	INIT	1,16
       	BLOCK 2
	JRST	EINIT
	POPJ	PP,
IFN CCLSW,<
RPGINI:	INIT	4,1
RPGDEV:	BLOCK 1
 	XWD 0,CTLBLK
	JRST	EINIT
	POPJ	PP,
>
INDEVI:	INIT	2,0
INDEV:	BLOCK	1
	XWD	0,IBUF
	JRST	EINIT
	POPJ	PP,
VBUF:	ASCII	/	MACRO.V36/	;MUST BE LAST LOCATIONS IN BLOCK
DBUF:	ASCIZ	/ TI:ME DY-MON-YR PAGE /
JOBFFI:	BLOCK	203*NUMBUF+1		;INPUT BUFFER PLUS ONES
IFN PURESW,<LOWEND==.-1
	Z
	RELOC>

	END	BEG