TITLE	MACRO %50A(441)	
SUBTTL	 RPG/CMF/JF/PMH/DMN/JNT/RKH/JBC/ILG	1-Jul-76
;COPYRIGHT 1968,1969,1970,1971,1972,1973,1974,1975,1976  DIGITAL EQUIPMENT CORP., MAYNARD, MASS.

	VMACRO==50		;VERSION NUMBER
	VUPDATE==1		;DEC UPDATE LEVEL
	VEDIT==441		;EDIT NUMBER
	VCUSTOM==2		;NON-DEC UPDATE LEVEL


	LOC	<.JBVER==137>
	<VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT
	RELOC

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

	SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW		GIVES TWO SEGMENT MACRO
CCLSW		GIVES RAPID PROGRAM GENERATION FEATURE
TEMP		TMPCOR UUO IS TO BE USED
FORMSW		USE MORE READABLE FORMATS FOR LISTING (ICCSW)
DFRMSW		DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON)
KI10		GIVES KI10 OP-CODES
KL10		GIVES KL10 OP-CODES

	SWITCHES OFF (ZERO) IN DEC VERSION
STANSW		GIVES STANFORD FEATURES
LNSSW		GIVES LNS VERSION
IIISW		GIVES III FEATURES
OPHSH		GIVES HASH SEARCH OF OPCODES
TENEX		GIVES BBN TENEX FEATURES
POLISH		GIVES EXTERNAL ARITHMETIC EXPRESSIONS
		AND PSECT MULTIPLE RELOCATION COUNTERS
TSTCD		GIVES LINK DEBUGGING AND DEVELOPMENT DIRECTIVES
*
SUBTTL	DEFAULT ASSEMBLY SWITCH SETTINGS

IFNDEF FT.U01,<FT.U01==1>
IFNDEF PURESW,<PURESW==1>

IFNDEF STANSW,<STANSW==0>
IFN STANSW,<CCLSW==1>

IFNDEF LNSSW,<LNSSW==0>

IFNDEF CCLSW,<CCLSW==1>

IFNDEF TEMP,<TEMP==1>


IFNDEF IIISW,<IIISW==0>
IFN IIISW,<
IFNDEF DFRMSW,<DFRMSW==0>>

IFNDEF DFRMSW,<DFRMSW==1>
IFN DFRMSW,<FORMSW==1>

IFNDEF FORMSW,<FORMSW==1>

IFNDEF OPHSH,<OPHSH==0>

IFNDEF KI10,<KI10==1>
IFNDEF KL10,<KL10==1>
IFN KL10,<KI10==1>

IFNDEF TENEX,<TENEX==0>

IFNDEF POLISH,<POLISH==0>
IFNDEF TSTCD,<TSTCD==0>
SUBTTL	REVISION HISTORY

;START OF 50
;114	(6113)	TIDY UP SYMBOL TABLE LISTING
;115		IMPLEMENT BINARY UNIVERSAL FILES
;116	(6272)	CORRECT LISTING OF CERTAIN BYTE FIELDS
;117	(6321)	MINOR FIX FOR I.S.C.
;120	(6245)	LABEL IN LITERAL
;121		ADD PSEUDO-OP .COMMON
;122		ADD PSEUDO-OPS .REQUIRE AND .REQUEST
;123		ADD ^! (XOR) AND ^- (NOT) OPERATORS
;124	(6350)	V ERRORS ON PASS 1
;125	(6483)	X ERRORS ON PASS 1
;126		SOME SLIGHT SPEEDUPS IN BYPASS ROUTINE (NOW A MACRO)
;127		FREE A FLAG BIT FOR POLISH FIXUPS (FUTURE)
;130	(6482)	GENERATE MULTIPLE CREF NO. FOR EXP 1,2,3,,ETC.
;131	(6476)	REMOVE BLANKS AT END OF COMMAND STRING
;132	(6477)	INCORRECT DEFAULT EXT FOR @ FILES
;133	(6475)	MISSING MACRO LISTING WITH SALL
;134	(6506)	FIX BUG IN HASHED OPCODES
;135	(6764)	MAKE OPDEF PRINT VALUE LIKE =
;136	(6803)	ADD SYMBOL .CPU. FOR HOST CPU TYPE
;137	(6765)	BETTER HANDLING OF () IN MACRO CALLS
;140	(6708)	DON'T NEED <> FOR SINGLE LINE CONDITIONALS
;141	(6629)	DON'T CREF .XCREF
;142	(6509)	COUNT PAGES CORRECTLY ON PRGEND
;143	(6698)	GIVE "Q" ERROR  IF MORE THAN 18 BIT VALUES IN XWD
;144		CHANGE EOL CHAR TO LF, QIVE "Q" ERROR ON FREE CR
;145		MAKE "Q" ERRORS PRINT AS WARNINGS INSTEAD OF ERRORS
;146		CALL HELPER TO PRINT HELP TEXT
;147		ADD NEW I/O DEVICE CODES AND NEW UUOS
;150	(6894)	FIX LOCATION COUNTER IN PHASE CODE
;151		ADD FAIL COMPATIBLE PSEUDO-OP .LINK (LINK), .LNKEND (LNKEND), .ORG (ORG)
;152	(7063)	COUNT <> IN CHARACTER LOOKAHEAD
;153	(6981)	VERY LONG SEQUENCED LINES DON'T PRINT CORRECTLY
;154	(7018)	87 CHAR LONG LINE GET EXTRA CR-LF IN LISTING
;155	(7005)	LABEL IN LITERALS AGAIN
;156	(7116)	SUPERSEDED BY 225
;157	(7027)	PRINT SEQUENCED BLANK LINE
;160	(7078)	GARBAGE IN BITS 0-3 OF RADIX-50 IN SOME MACROS
;161	(7373)	MAKE PAGE PSEUDO-OP INCREASE PAGE INCREMENT NO. ONLY
;162		ADD SFD LOGIC
;163	(7435)	SUPERSEDED BY 204
;164		ADD POLISH EXPRESSIONS (NOT SUPPORTED)
;165		REMOVE 0 LISTED ON FIRST LINE AFTER PRGEND
;167	(7462)	ADD ! TO SUPPRESS SYMBOLS
;170	(7638)	FIX ILL MEM REFS ON PRGEND
;171	(8374)	TEST AND GIVE ERROR IF EXP AFTER \ IN MACRO CALL IS A MACRO
;173	(8264)	SAVE AND RESTORE ACCS IN SYN ROUTINE IF CORE EXPANSION IS REQUIRED
;175	(8606)	ONLY USE ASCII 37 AS CONTINUATION CHARACTER IF AT END OF LINE
;176	(8633)	CORRECTLY HANDLE <> IN COMMENTS IN MACROS AFTER ;;
;200		MAKE DEFAULT NUMBER OF BUFFERS BE 5
;201		ADD DATE75 HACK
;202		ADD PSEUDO-OP .DIRECTIVE
;203	(10071)	FIX TWOSEG & PRGEND INTERACTION SO LOAD FORLIB IN LOW SEG
;204	(11044)	CLEAR PNTF IF 18 BIT VALUE (UNLESS EXTERN) AT INSRT4
;205	(10820)	FIX #154 INCASE IN MACROS
;206		ADD TENEX FEATURES
;207		FORCE END STATEMENT IF END NOT SEEN
;210		ADD EXTERNAL START ADDRESS ON END STATEMENT
;211		ALLOW <> IN COMMAND TO BE SAME AS []
;212		PUT ERROR MESSAGES IN STANDARD FORM
;213		PUT ASSEMBLY ERRORS IN CREF TABLE
;214		OUTPUT COMPILER TYPE IN HEADER BLOCK (TYPE 6)
;215	(9810)	DON'T LIST COMMENT BEFORE MACRO EXPANSION IF IN REPEAT
;216		MAKE DEFAULT [DIRECTORY] WORK
;217	(9996)	TURN ON SALL IN LITERALS SO MACRO CALLS DON'T EXPAND
;220	(9633)	MAKE .XCREF APPLY TO SPECIFIC SYMBOLS
;221	(9508)	IF NEXT LINE AFTER TAPE PSEUDO-OP IS FF OR VT LIST IT
;222	(9499)	MORE OF #124
;223	(10393)	FIX ILL MEM REF ON END MACRO
;224	(S-033)	MINOR VERSION NUMBER DECODE LOGIC WRONG
;225	(11907)	REDEFINING MACROS IN PRGENDS
;226	(11929)	MORE OF ABOVE, WHEN A UNIVERSAL FILE HAS BEEN READ
;227	(S-034)	ADD SWITCH /nnL TO GIVE LINES/PAGE, ALSO MAKE 2 LARGER
;230		DON'T SEARCH UNIVERSAL FILE ON LABEL & ASSIGNMENT DEFINITIONS
;231		EXPAND CORE TO HOLD BOTH COPIES IN UNIVERSAL AND PRGEND
;232		ADD .TEXT PSEUDO-OP TO GENERATE ASCIZ BLOCK TYPE FOR LINK-10
;233		CHECK FOR INVALID ARG TO BLOCK PSEUDO-OP
;234		OUTPUT CPU TIME TAKEN FOR ASSEMBLY
;235		ADD .DIRECTIVE KA10,KI10 TO SET BIT IN BLOCK TYPE 6
;236		FIX SALL/XLIST BUG, MAKE XALL ONLY TURN OFF SALL
;237	(12493)	GIVE U ERROR ON LABEL DEFINED AND USED IN SAME LITERAL
;240	(12631)	ENHANCEMENTS TO BINARY UNIVERSALS
;241	(13033) INCORRECT CHECKING OF ACC "C" AGAINST ASCII AT STMNT2+13
;242	(13034) SAVE AC0 (AND SOME OTHERS) AT OUTPL1
;243	(13402) MAKE LOWER CASE WORK WITH SINGLE QUOTES
;244		EXTEND EDIT #210 TO ALLOW EXTERNAL + CONSTANT
;245	(13047)	FLAG QUESTIONABLE USE OF SINGLE QUOTE WITH "Q" ERROR
;246	(13119)	WRITE CREF FILE IN DEFAULT PATH
;247	(12803)	FLAG QUESTIONABLE USE OF # AND ## ON SAME SYMBOL
;250	(13032)	CLEAR MORE ERROR BITS ON PASS1 IN MULTI-LINE LITERAL
;251		FIX PROGRAM BREAK IF LIT STATEMENT IN PRGEND
;252		DON'T GIVE "Q" ERROR ON EXTRA "CR" (SEE EDIT #144)
;253		DON'T PRINT GARBAGE ON PASS1 ERROR IN MULTI-LINE LIT
;254		USE ALL AVAILABLE PRINTING SPACES FOR LONG LINES
;255		FIX UNARY MINUS BUG IN EDIT #164
;256	(13664)	HANDLE SPECIAL EXTERN IN UNIVERSAL CORRECTLY
;257		HANDLE VERTICAL TABS CORRECTLY
;260		FIX BUG IN #140, THROW AWAY JUNK BEFORE COMMA
;261		HANDLE SOS PAGE MARK CORRECTLY
;262		TRAP ILL MEM REF CAUSED BY MISSING CLOSE PAREN IN MACRO ARG LIST (#137)
;263		DON'T DESTROY ACC RC IN LONG LINE OF ASCIZ TEXT
;264		FIX BUG IN #175 CAUSING EXTRA CR-LF
;265		ADD PSECT CODE UNDER POLISH SWITCH, THIS IS VERSION 51 ONLY
;266		FIX LOOP CAUSED BY MISSING ")" IN SEARCH MODS (#240)
;267		DON'T PASS DEFINITION FLAG TO CREF ON ##
;270		DOUBLE SIZE OF BASIC PUSHDOWN STACK
;271		ADD .IF PSEUDO-OP
;272		FIX LOOP CAUSED BY #260 IF EOL ENCOUNTERED
;VERSION 50 (272) RELEASED NOV-74

;273		ADD BYPASS TO FIX ERROR WITH PPN SPEC FOR .REQUIRE & .REQUEST
;274	(14734)	FIX PROBLEM WITH .IF CONDITIONALS
;275	(14723)	FIX SPURIOUS MONRET WITH STICKY PPNS
;276	(14811)	CAUSE * AND / TO GIVE N ERRORS WHEN THEY OVERFLOW
;277		ALLOW ALTMODES TO TERMINATE COMMAND STRINGS AGAIN

;EDITS 300 THROUGH 317 WERE USED FOR MACRO 51

;320	(Q3086)	FIX MCRNES MESSAGE IN DEFINE AFTER SIXBIT//
;321	(Q3085)	FIX LITERALS NOT LISTING IN MACROS AND SOME BOGUS V ERRORS WHEN NOT LALL
;322		CHANGE RADIX50 TO GIVE Q ERROR ON CODE NOT 74 BITS
;323	(14943)	FIX TO MAKE EXTERNALS REFERENCED IN UNIVERSALS WORK
;324	(14957)	FIX FOR E ERRORS WHEN OPDEF REFERENCES EXTERNAL OF SAME NAME
;325	(15043)	CHANGE 152 & 176 TO NOT PRINT ANGLE BRACKETS OR 1 ; AFTER ;;
;326	(15218)	CHANGE MCRNEC MESSAGE TO GIVE UP ASSEMBLY
;327		FIX THE CRLF'S WHEN LALL IS USED IN A MACRO UNDER SALL
;330	(15277)	CORRECT VALUE OF SYMBOL .CPU. FOR KA-10
;331	(15279)	CORRECT OUTPUT OF .TEXT BLOCKS GENERATING MORE THAN 18 WORDS
;332		CORRECTION TO 325 WHEN ;;> IS END OF MACRO
;333	(15280)	^ IS SOMETIMES SWALLOWED WHEN NOT FOLLOWED BY ! OR -
;334	(15293)	DEFAULT MACRO ARGUMENTS ARE NOT SAVED IN BINARY UNIVERSALS
;335	(15406)	SCAN .REQUIRE,.REQUEST WITH FILE SPEC SCANNER, NOT GETSYM
;336	(15485)	CLEAN UP 323 TO MAKE IT THE SAME AS PUBLISHED 256
;337		FIX EDIT 333 TO MAKE ^! ^- WORK AGAIN
;340	(15682)	CHECK FOR FORWARD DEFINED ENTRIES BEFORE MAKING UNDEFINES EXTERNAL
;341		FIX ERRORS WITH DEFAULT ARGUMENTS
;342	(15680)	ADD PORTAL OPCODE
;343	(15683)	DON'T SEARCH UNIVERSALS WHEN DEFINING INTERN,EXTERN,ETC
;344		LIST MOVE [CONO] CORRECTLY
;345	(16130) CORRECT EDIT 335 TO BYPASS EXTRA TABS AND SPACES
;346	(16130) PREVENT RELOC FROM OPERATING ACROSS PRGEND'S
;347	(16250) FIX EDITS 325 AND 332 TO HANDLE MACROS TERMINATING
;	ON THE SAME LINE
;350	(16471) EDIT 345 BREAKS SCANNING OF .REQU??? TYPE ITEM BECAUSE
;	BYPASS MACRO EATS FIRST CHARACTER OF SPEC.
;351	(16335) WHEN AN OPEN ANGLE BRACKET IS MISSING AFTER IRPC,
;	DON'T CRASH WHILE SEARCHING FOR IT.
;352	(16589) FIX '[DEVICE] NOT AVAILABLE' ERROR MESSAGE TYPEOUT
;353		REMOVE EDIT 343
;354	(16804)	FIX EDIT 351 TO ALLOW COMMA BEFORE OPEN BRACKET IN IRP,IRPC
;	ADD 'MISSING OPEN BRACKET' ERROR MESSAGE FOR IRP
;355	(16878)	CHECK ENOUGH CORE ALLOTTED FOR UNIVERSAL FILES WITH PRGEND
;356	(16883)	GIVE ERROR MESSAGE IF UNABLE TO WRITE UNIVERSAL FILE
;357	(17041)	FIX EDITS 333,337 TO MAKE ^!,^- WORK IN A MACRO
;360	(16690)	FIX '[SYMBOL] UNASSIGNED, DEFINED AS IF EXTERNAL' ERROR
;	MESSAGE TYPEOUT
;361	(17046)	FIX EDITS 351,354 TO ALLOW ) BEFORE OPEN ANGLE BRACKET
;362		ADD .DIRECTIVES .OKOVL,.EROVL TO ALLOW * OR / OVERFLOW
;363	(16988)	INSERT UNDEFINED SYMBOL PRECEDED BY UNARY MINUS IN UNDEFINED SYMBOL TABLE
;364	(17147)	ADD SEPARATE 'UNIVERSAL VERSION SKEW' ERROR MESSAGE
;365	(17143)	FIX .CREF,.XCREF FOR MULTIPLY-ENTERED SYMBOLS
;366	(17256)	FIX HANDLING OF FIRST LEVEL ANGLE BRACKETS INSIDE MACROS
;367	(16559)	FIX ERROR HANDLING IN LITERALS
;370	(17387)	FIX .TEXT FLAG HANDLING
;371	(16710)	CORRECT DECREMENTING OF MACROS DEFINED IN UNIVERSALS BELOW 1
;372	(17912)	FIX .XTABM FOR SPECIAL CASES
;373	(17913)	ADD ERROR MESSAGE FOR MISSING < IN REPEAT
;374	(17993)	FIX HANDLING OF RELOCATABLE ARGUMENTS WITH ^L
;375	(17994)	FIX PREVIOUS EDITS TO ^-  AND ^! OPERATORS
;376	(18280)	CORRECT EDIT 367, IT BROKE ERRORS IN SINGLE LINE LITERALS
;377		ADD MCRPGE (PRGEND ERROR) MNEMONIC
;400		PRESERVE OLD .REL FILE AND PRODUCE PARTIAL LISTING AFTER
;		MRCNEC OR MRCPDL ERROR
;401		DON'T ALLOW SHIFT TO DELETE RELOCATION FACTOR
;402	(17904)	FIX "LABEL + OFFSET" FOR LABELS IN LITERALS
;403		REPLACE MCREWU,MCRERU ERROR MESSAGES WITH EXISTING I/O MESSAGES
;404	(18768)	FIX CHECK FOR ! AFTER SYMBOL IN INTERN,EXTERN,SUPRESS,ETC.
;405	(18282)	CHECK FOR DEFAULT PPN SUCH AS [,NNNN] OR [NNNN,]
;406	(18894)	DON'T ALLOW SEMI-INFINITE LOOP IN ASSIGNMENT STATEMENT
;407		EDIT 401 IS A GOOD IDEA,BUT IT BROKE OLD PROGRAMS
;410		GENERAL CLEANUP IN PREPARATION FOR RELEASE.
;411	(18828)	/N SHOULDN'T SUPRESS %....X SYMBOLS IN CREF
;412		CLEAR HISNSW AT PRGEND FOR NEXT PROGRAM
;413		ADD .DIRECTIVE KL10, MAKE IT OK TO HAVE MULTIPLE CPUS
;414		ADD .DIRECTIVES .TCDON/.TCDOFF FOR TESTING NEW LINK CODES
;415		SUPERSEDE EDITS 367,376 FOR CLARITY
;416	(Q0320)	FIX ^- AGAIN. EDITS 375,333 SUPERSEDED.
;417	(Q0316)	EDIT 221 BROKE TAPE PSEUDO-OP WHEN EOF FOLLOWS
;420	(Q0322)	RESET TITLE TO ".MAIN" AT PRGEND
;421	(Q0328)	CLEAN UP THE .DIRECTIVE CODE, ADD .DIRECTIVE NO
;422	(Q0363)	FIX DEFAULT ARG READ-IN FOR DEFINES IN MACROS
;423		MAKE .LINK PSEUDO-OP READ 3RD ARGUMENT CORRECTLY.
;424	(18893)	CHECK FOR ILLEGAL CHARACTERS AT ASTERISK LEVEL.
;425	(19585)	REWORK EDIT 373
;426		CLEAN UP EDITS 351,354,361
;427	(Q0390)	ALLOW NULL EXTENSIONS IN SOURCE SPECIFICATIONS
;430	(20036)	IMPLEMENT "%MCRSOC STATEMENT OUT OF ORDER .COMMON [SYMBOL]" MESSAGE
;431		CLEAN UP UNIVERSAL I/O ERROR MESSAGES
;432		FURTHER CLEANUP FOR RELEASE
;; MACRO 50A	RELEASE IN FALL, 1976
;440		FIX "R" ERRORS (WITH EXTERNAL SYMBOLS) CAUSED BY EDIT 324
;441		FIX "P" ERRORS WHEN SYMBOL FORWARD-REFERENCED ACROSS LITERAL
;
;*****CUSTOMER REVISION HISTORY*****
;1		IMPLEMENT USER PUSHDOWN LIST--FEATURE TEST FT.U01
;2		CLEAR USER PDP ON PRGEND AND END, CHECK FOR STACK UNDERFLOW

;*******************  END OF REVISION HISTORY  *******************
SUBTTL	OTHER PARAMETERS

IFN FT.U01,<$USRLN==^D50> ;LENGTH OF USER PUSH DOWN LIST
.PDP==	^D100		;[270] BASIC PUSH-DOWN POINTER
IFNDEF LPTWID,<LPTWID==^D132>	;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/8>		;USEFUL WIDTH IN MAIN LISTING
.CPL==	.LPTWD-^D32		;WIDTH AVAILABLE FOR TEXT WHEN
				;BINARY IS IN HALFWORD FORMAT
.CPLX==LPTWID-.LPTWD		;[254] EXCESS SPACE IN LAST TAB STOP
IFNDEF .LPP,<			;[227]
	IFE STANSW,<.LPP==^D57	;LINES/PAGE>
	IFN STANSW,<.LPP==^D52	;LINES/PAGE>
>
.STP==	^D40		;STOW SIZE
.TBUF==	^D80		;TITLE BUFFER
.SBUF==	^D80		;SUB-TITLE BUFFER
.IFBLK==^D20		;IFIDN COMPARISON BLOCK SIZE
.R1B==^D18
.UNIV==^D10		;NUMBER OF UNIVERSAL SYMBOL TABLES ALLOWED
.LEAF==4		;SIZE OF BLOCKS IN MACRO TREE
.UVER==5		;[334] VERSION # OF UNV FILE
.SFDLN==5		;[162] NUMBER OF SFD'S ALLOWED

NCOLS==LPTWID/^D32		;NUMBER OF COLUMNS IN SYMBOL TABLE
SGNSGS==^D64			;MAX # OF DISTINCT PSECTS ALLOWED
				;IN ONE ASSEMBLY
SGNDEP==^D16			;MAX PSECT DEPTH ALLOWED
IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D200>>
IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>
IFNDEF NUMBUF,<NUMBUF==5>	;[200] NUMBER OF INPUT BUFFERS

EXTERN	.JBREL,.JBFF,.JBAPR,.JBSA,.JBERR
EXTERN	.HELPR
IFDEF .REQUEST,<.REQUEST REL:HELPER  >	;[122]

LOWL:!				;START OF LOW SEGMENT
IFN PURESW,<TWOSEGMENTS
	RELOC 400000>

	SALL		;SUPPRESS ALL MACROS

;SOME ASCII CHARACTERS

HT==11
LF==12
VT==13
FF==14
CR==15
CZ==32
EOL==33
CLA==37
			;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
%ERR==%MAC

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
POLSW== 000002		;[164] DOING POLISH ON GLOBALS
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
RSASSW==000002		;[265] REFERENCE IS TO A SYMBOL IN ANOTHER PSECT
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

OPDEF	PJRST	[JRST]		;JUMP TO POPJ PP,	;RETURN
OPDEF	HALT	[HALT]		;TO PUT IN CREF TABLE
			;ER ERROR REGISTERS (IO/ER)
ERRS==	000010		;[265] ILLEGAL PSECT USAGE
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
ERROR1==ERRP!ERRM!ERRV!ERRX	;[125] ERRORS THAT PRINT ON PASS 1
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
NCRF==  000040		;[220] DO NOT CREF THIS SYMBOL
MDFF==	000020		;MULTIPLY DEFINED
SPTR==	000010		;SPECIAL EXTERNAL POINTER
SUPRBT==000004		;SUPRESS OUTPUT TO REL AND LISTING
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,[PAGENO,,ABC'PG]
	BLT	AC,ABC'PG+3
>

;MACRO TO BYPASS LEADING TABS AND SPACES
DEFINE BYPASS <
	PUSHJ	PP,GETCHR
	JUMPE	C,.-1
>
SUBTTL	START ASSEMBLING

ASSEMB:	PUSHJ	PP,INZ		;INITIALIZE FOR PASS
	SKIPA	AC1,.+1		;LOCALIZED CODE
	ASCII	/.MAIN/
	MOVEM	AC1,TBUF
	SETZM	TBUF+1		;SIGNAL NOT YET SEEN A TITLE
	MOVEI	SBUF
	HRRM	SUBTTX

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

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

SUBTTL	STATEMENT PROCESSOR

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

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

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

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

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

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

STMN8E:	SETZ	V,		;START AT ZERO
	CAIL	V,MTALTH	;END OF TABLE?
	JRST	STMN8A		;YES, ERROR
	CAME	AC0,MTATBL(V)	;MATCH
	AOJA	V,.-3		;NOT YET
	PUSH	PP,AC0		;SAVE IT
	MOVE	AC0,[POINT 9,MTACOD]
	IBP	AC0		;GET TO RIGHT ONE
	SOJGE	V,.-1		;EVENTUALLY
	LDB	V,AC0		;GET FUNCTION
	HRLI	V,(MTAPE)	;FILL IN OPCODE
	POP	PP,AC0
	JRST	STMN8D

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

	SUBTTL	LABEL PROCESSOR
	
LABEL:	JUMPAD	LABEL4		;COMPARE IF NON-SYMBOLIC
	JUMPE	AC0,LABEL5	;ERROR IF BLANK
	TLO	IO,DEFCRS	;THIS IS A DEFINITION
	SKIPN	LITLVL		;[402] LABEL IN LITERAL?
	JRST	LABL10		;[402] NO
	SETOM	LBLFLG		;[402] SET FLAG
	EXCH	AC0,STPX	;[402]
	MOVEM	AC0,LTGINC	;[402] SET MARKER
	EXCH	AC0,STPX	;[402]
LABL10:	PUSH	PP,UNISCH+1	;[402] SAVE SEARCH LIST
	SETZM	UNISCH+1	;BUT DISALLOW
	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	  MOVSI	ARG,SYMF!UNDF!TAGF	;NOT FOUND
	POP	PP,UNISCH+1	;RESTORE STATUS
	TLNN	ARG,EXTF	;OPERAND FOUND (SKIP EXIT)
	JRST	LABEL0
	JUMP1	LABEL3		;ERROR ON PASS1
	TLNN	ARG,UNDF	;UNDEFINED ON PASS1
	JRST	LABEL3		;NO, FLAG ERROR
	TLZ	ARG,EXTF!PNTF	;TURN OFF EXT FLAG NOW
	JUMPE	V,LABEL0	;NOTHING TO CHAIN IF 0
	MOVE	RC,LOCAL	;GET CURENT POINTER
	MOVEM	RC,1(ARG)	;STORE OVER NAME
	HRRM	ARG,LOCAL	;LINK INTO CHAIN
	MOVE	RC,LOCA		;GET CURRENT LOCATION
	HRLM	RC,(ARG)	;STORE BUT SWAPPED
	LSH	V,-^D17		;SHIFT RELOCATION TO BIT 34
	IOR	V,MODA		;CURRENT RELOCATION
	HRLM	V,1(ARG)	;STORE IT
LABEL0:	TLZN	ARG,UNDF!VARF	;WAS IT PREVIOUSLY DEFINED?
	JRST	LABEL2		;YES, CHECK EQUALITY
	MOVE	V,LOCA		;WFW
	MOVE	RC,MODA
	TLO	ARG,TAGF
	PUSHJ	PP,PEEK		;GET NEXT CHAR.
	CAIE	C,":"		;SPECIAL CHECK FOR  ::
	JRST	LABEL1		;NO MATCH
	TLO	ARG,INTF	;MAKE IT INTERNAL
	PUSHJ	PP,GETCHR	;PROCESS NEXT CHAR.
	PUSHJ	PP,PEEK		;PREVIEW NEXT CHAR.
LABEL1:	CAIE	C,"!"		;HALF-KILL SIGN
	JRST	LABEL6		;NO
	TLO	ARG,NOOUTF	;YES, SUPPRESS IT
	PUSHJ	PP,GETCHR	;AND GET RID OF IT
LABEL6:	MOVEM	AC0,TAG		;SAVE FOR PASS 1 ERRORS
	HLLZS	TAGINC		;ZERO INCREMENT
	JRST	INSERT		;INSERT/UPDATE AND EXIT

LABEL2:	HRLOM	V,LOCBLK	;SAVE LIST LOCATION
IFN POLISH,<
	CAMLE	SX,SGSBOT	;IS IT IN THE
	CAMLE	SX,SGSTOP	; CURRENT PSECT
	JRST	LABEL3>		;NO, FLAG ERROR
	CAMN	V,LOCA		;DOES IT COMPARE WITH PREVIOUS? WFW
	CAME	RC,MODA
LABEL3:	TLOA	ARG,MDFF	;NO, FLAG MULTIPLY DEFINED AND SKIP
	JRST	LABEL7		;YES, GET RID OF EXTRA CHARS.
	TRO	ER,ERRM		;FLAG MULTIPLY DEFINED ERROR 
	JRST	UPDATE		;UPDATE AND EXIT
LABEL4:	CAMN	AC0,LOCA	;DO THEY COMPARE?
	CAME	RC,MODA
LABEL5:	TRO	ER,ERRP		;NO, FLAG PHASE ERROR
	POPJ	PP,

LABEL7:	SKIPN	LITLVL		;[155] LABEL IN A LITERAL?
	JRST	LABEL8		;[155] NO
	MOVEM	AC0,LITLBL	;[155] YES, SAVE LABEL NAME FOR LATER
	MOVE	AC0,STPX	;[155] CURRENT DEPTH
	SUB	AC0,STPY	;[155] MINUS START
	MOVEM	AC0,LITLBL+1	;[155] STORE DEPTH IN LIT
	MOVE	AC0,LITLBL	;[155] RESTORE 0
	TLO	ARG,UNDF	;[237] PUT BACK U FLAG
	IORM	ARG,0(SX)	;[237] INCASE REFERENCED IN SAME LITERAL
	JRST	LABEL9		;DON'T STORE LABEL IN LIT
LABEL8:	MOVEM	AC0,TAG		;SAVE FOR ERRORS
	HLLZS	TAGINC
LABEL9:	PUSHJ	PP,PEEK		;INSPECT A CHAR.
	CAIN	C,":"		;COLON?
	PUSHJ	PP,GETCHR	;YES, DISPOSE OF IT
	PUSHJ	PP,PEEK		;EXAMINE ONE MORE CHAR.
	CAIN	C,"!"		;EXCLAMATION?
	JRST	GETCHR		;YES, INDEED
	POPJ	PP,
SUBTTL	ATOM PROCESSOR
ATOM:	PUSHJ	PP,CELL		;GET FIRST CELL
	TLNE	IO,NUMSW	;IF NON-NUMERIC
ATOM1:	CAIE	C,42		;OR NOT A BINARY SHIFT,
	POPJ	PP,		;EXIT

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

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

LETTE3:	CAIE	C,03		;"#"?
	POPJ	PP,
	JUMPE	AC0,POPOUT	;TEST FOR NULL
	PUSHJ	PP,PEEK		;PEEK AT NEXT CHAR.
	CAIN	C,"#"		;IS IT 2ND #?
	JRST	LETTE4		;YES, THEN IT'S AN EXTERN
	TLO	IO,DEFCRS
	PUSHJ	PP,SSRCH	;YES, SEARCH FOR SYMBOL (OPERAND)
	  MOVSI	ARG,SYMF!UNDF	;NOT FOUND, FLAG AS UNDEFINED SYM.
	TLNN	ARG,UNDF	;UNDEFINED?
	JRST	LETTE5		;[247] NO, BUT SEE IF ALREADY DEFINED AS EXTERNAL
	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
	TLZ	IO,DEFCRS	;[267] MAKE SURE NOT A DEFINITION
	PUSHJ	PP,EXTER5	;[267] PUT IN SYMBOL TABLE
	JRST	GETCHR		;GET RID OF #

LETTE5:	TLNE	ARG,EXTF	;[247] EXTERNAL
	TRO	ER,ERRQ		;[247] YES, FLAG WITH "Q" ERROR
	JRST	GETCHR		;[247] GET NEXT CHAR AND RETURN

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

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

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

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

SQUOT0:	CAIL	C,"a"		;[243] TEST FOR LOWER CASE
	CAILE	C,"z"		;[243] ...
	JRST	.+2		;[243] NO
	SUBI	C," "		;[243]
	TLNE	AC0,770000	;SIX CHARS. STORED ALREADY ?
	TRO	ER,ERRQ		;YES
	LSH	AC0,6
	IORI	AC0,-40(C)	;OR IN SIXBIT CHAR.

SQUOTE:	PUSHJ	PP,CHARAC
	CAIG	C,CR
	CAIGE	C,LF
	JRST	.+2
	JRST	QUOTE2		;[245] FLAG WITH "Q" ERROR
	CAIE	C,"'"
	JRST	SQUOT0
	PUSHJ	PP,PEEK
	CAIE	C,"'"
	JRST	QUOTE1
	PUSHJ	PP,CHARAC
	JRST	SQUOT0

QUAL:	BYPASS			;SKIP BLANKS, GET NEXT CHARACTER
	CAIN	C,'B'		;"B"?
	JRST	QUAL2		;YES, RADIX=D2
	CAIN	C,'O'		;"O"?
	JRST	QUAL8		;YES, RADIX=D8
	CAIN	C,'F'		;"F"?
	JRST	NUMDF		;YES, PROCESS DECIMAL FRACTION
	CAIN	C,'L'		;"L"?
	JRST	QUALL		;YES
	CAIN	C,'-'		;[123] "^-" IS NOT
	JRST	QUALN		;[123]
	CAIE	C,'D'		;"D"?
	JRST	NUMER1		;NO, FLAG NUMERIC ERROR
	ADDI	AC2,2
QUAL8:	ADDI	AC2,6
QUAL2:	ADDI	AC2,2
	PUSH	PP,RX
	HRR	RX,AC2
	PUSHJ	PP,CELLSF
QUAL2A:	POP	PP,RX
	TLNN	IO,NUMSW
	JRST	NUMER1
	JRST	GETDE1

QUALL:	PUSH	PP,FR
	PUSHJ	PP,CELLSF
	MOVE	AC2,AC0
	MOVEI	AC0,^D36
	SETZ	RC,		;[374] IN CASE ARG IS RELOCATABLE
	JUMPE	AC2,QUAL2A
	LSH	AC2,-1
	SOJA	AC0,.-2

QUALN:	MOVE	CS,CSTATN	;[416]GET CHARACTERISTICS FOR "^-"
	JRST	GETDE1		;[416]THEN GET DELIMITER
SUBTTL	LITERAL PROCESSOR

SQBRK:	PUSH	PP,TAG		;[402] SAVE CURRENT TAG
	PUSH	PP,TAGINC	;[402] AND OFFSET
	PUSH	PP,FR
	PUSH	PP,EXTPNT	;ALLOW EXTERN TO PRECEDE LIT IN XWD
IFN FORMSW,<	PUSH	PP,IOSEEN	;[344] SAVE I/O INSTRUCTION SEEN VALUE>
	SETZM	EXTPNT
	SKIPE	LITLVL		;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY
	JRST	SQB5
	FORERR	(C,LIT)
SQB5:	JSP	AC2,SVSTOW
	PUSH	PP,[0]		;[217] STACK A ZERO
	TLNE	IO,IOPALL	;[217] LEAVE ALONE IF LALL ON
	TLNN	IO,IOSALL	;[321] TEST IF SALL ALREADY ON
	SETOM	(PP)		;[217] SIGNAL NOT BY -1
	PUSH	PP,LITERR	;[415]SAVE LITERR FROM PREVIOUS LEVEL
	SETZM	LITERR		;[415]CLEAR IT FOR THIS LEVEL
SQB3:	PUSHJ	PP,STMNT
	IORM	ER,LITERR	;[415]GET CUMMULATIVE ERRORS FOR LEVEL
	CAIN	C,75		;CHECK FOR ]
	JRST	SQB1
	TLO	IO,IORPTC
	TLNE	FR,MWLFLG	;CALL IT ] IF NOT MULTI-WORD FLAG
	JRST	SQB2		;BUT REPEAT LAST CHARACTER
	BYPASS
	CAIN	C,EOL
	TLOA	IO,IORPTC
	TRO	ER,ERRQ
SQB4:	PUSHJ	PP,CHARAC
	CAIN	C,";"		;COMMENT?
	JRST	SQB6		;YES, IGNORE SQUARE BRACKETS
	CAIN	C,"]"		;LOOK FOR TERMINAL SQB
	TRNN	ER,ERRORS	;IN CASE OF ERROR IN LITERAL
	JRST	.+2		;NO ALL IS WELL
	JRST	SQB1		;FINISH THE LITERAL NOW!!
	CAIG	C,FF		;LOOK FOR END OF LINE
	CAIN	C,HT
	JRST	SQB4
SQB4A:	PUSHJ	PP,OUTIML	;DUMP
	PUSHJ	PP,CHARAC	;GET ANOTHER CHAR.
	SKIPL	LIMBO		;CRLF FLAG
	TLO	IO,IORPTC	;NO REPEAT
	JRST	SQB3

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

SQB1:	TLZ	IO,IORPTC
SQB2:	PUSHJ	PP,STOLIT
	POP	PP,LITERR	;[415]RESTORE LITERR FOR NEXT LEVEL
	SKIPE	(PP)		;[217] WAS SALL ORIGINALLY ON?
	TLZ	IO,IOSALL	;[217] NO, SO TURN IT OFF
	POP	PP,(PP)		;[217] GET STACK RIGHT
	JSP	AC2,GTSTOW
	SKIPE	LITLBL		;NEED TO FIXUP A LABEL?
	PUSHJ	PP,RELBLE	;YES, USE LOC OF LITERAL
IFN POLISH,<
	SKIPE	POLITS		;[265] NEED TO FIXUP ANY POLISH?
	PUSHJ	PP,SQBPOL	;[265] YES
>
IFN FORMSW,<	POP	PP,IOSEEN	;[344] RESTORE IOSEEN FOR LISTING>
	POP	PP,EXTPNT
	POP	PP,FR
	POP	PP,TAGINC	;[402] RESTORE PREVIOUS OFFSET
	POP	PP,TAG		;[402] AND LABEL
	SETZM	LBLFLG		;[402] ZERO 'LABEL-IN-LITERAL' FLAG
	SETZM	LTGINC		;[402] AND MARKER
	SKIPE	LITLVL		;WERE WE NESTED?
	JUMP1	NUMER2		;YES, FORCE ERROR IF PASS 1
	JUMP2	GETDEL		;[120] USE VALUE GIVEN IF PASS 2
	TRO	ER,ERRU		;[120] VALUE IS UNDEFINED ON PASS 1
	SETZ	AC0,		;[120] SO SET IT TO 0
	JRST	GETDEL		;[120]

RELBLE:	PUSH	PP,AC0		;SAVE LOCATION COUNTER
	PUSH	PP,RC		;AND RELOCATION
	MOVE	AC0,LITLBL	;SYMBOL WE NEED
	SETZM	LITLBL		;ZERO INDICATOR
	PUSHJ	PP,SSRCH	;SEARCH FOR OPERAND
	JRST	RELBL1		;SHOULD NEVER HAPPEN
	TLNN	ARG,TAGF	;IT BETTER BE A LABEL
	JRST	RELBL1		;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE
	TLZ	ARG,UNDF!EXTF!PNTF	;CLEAR FLAGS NOW
	POP	PP,RC		;GET LITERAL RELOCATION
	MOVE	V,(PP)		;GET VALUE (LOC COUNTER)
	ADD	V,LITLBL+1	;[155] PLUS DEPTH IN LITERAL
	PUSHJ	PP,UPDATE	;UPDATE VALUE
	POP	PP,AC0		;RESTORE LITERAL COUNT
	POPJ	PP,		;RETURN
	
RELBL1:	POP	PP,RC		;RESTORE RC
	POP	PP,AC0		;AND AC0
	POPJ	PP,		;JUST RETURN
IFN POLISH,<			;[265]
;HERE TO FIXUP POLISH EXPRESSIONS INSIDE CURRENT LIT
;AS EACH ONE IS FIXED MOVE IT TO POLIST
SQBPOL:	PUSH	PP,CS		;GET SOME FREE ACCS
	PUSH	PP,AC0		;SAVE LOC
SQBPL1:	MOVE	CS,@POLITS	;GET A BLOCK POINTER
	EXCH	CS,POLITS	;SET FOR NEXT TIME
	MOVE	AC0,CS		;GET A COPY
	EXCH	AC0,POLIST	;STORE IN LIST OF "GOOD" POLISH
	MOVEM	AC0,(CS)	;LINK IN
SQBPL2:	ADDI	CS,1		;FIRST WORD
	MOVE	AC0,(CS)	;GET SOMETHING
	JUMPL	AC0,SQBPL5	;THIS IS AN OPERATOR
	JUMPE	AC0,SQBPL4	;18 BIT VALUE
	SOJE	AC0,SQBPL3	;36 BIT VALUE
	AOJA	CS,SQBPL2	;SYMBOL

SQBPL3:	ADDI	CS,1		;SKIP OVER 2 WORDS
SQBPL4:	AOJA	CS,SQBPL2	;GET NEXT

SQBPL5:	HRRZ	AC0,AC0		;GET OPERATOR ONLY
	CAIGE	AC0,-6		;[265] CHECK FOR STORE OP
	JRST	SQBPL2		;ITS NOT
	MOVE	AC0,0(PP)	;GET ADDRESS
	ADDM	AC0,1(CS)	;ADD TO OFFSET
	HRLM	RC,1(CS)	;SET RELOCATION
	SKIPE	POLITS		;MORE TO DO?
	JRST	SQBPL1		;YES
	POP	PP,AC0		;RESTORE LOC
	POP	PP,CS		;AND SAVED AC
	POPJ	PP,
>
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

PERIOD:	PUSHJ	PP,GETCHR	;LOOK AT NEXT CHARACTER
	TLNN	CS,2		;ALPHABETIC?
	JRST	PERNUM		;NO, TEST NUMERIC
	MOVSI	AC0,'.  '	;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
	SKIPE	AC0		;ARE WE ABOUT TO LOSE SOME DATA?
	TRO	ER,ERRQ		;YES, AT LEAST WARN USER
	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,'.'		;PERIOD?
	TLNE	FR,DCFSW	;OR DECIMAL FRACTION?
	JRST	NUM30		;YES, PROCESS FLOATING POINT
	SETZ	CS,		;AND CLEAR IT
	CAIN	C,'K'		;SEE IF SUFFIX THERE
	MOVEI	CS,3
	CAIN	C,'M'
	MOVEI	CS,6
	CAIN	C,'G'
	MOVEI	CS,9
	JUMPE	CS,NUM12	;NO SUFFIX?
	MOVE	AC0,AC1		;SCALE THE NUMBER
	MULI	AC0,(RX)
	SOJG	CS,.-2
	PUSHJ	PP,GETCHR	;SKIP THE SUFFIX
NUM12:	MOVE	CS,CSTAT(C)	;RESTORE STATUS
	LSH	AC1,1		;NO, CLEAR THE SIGN BIT
	LSHC	AC0,^D35	;AND SHIFT INTO AC0
	MOVE	PP,PPTEMP	;RESTORE PP
	SOJE	AC2,GETDE1	;NO RADIX ERROR TEST IF ONE DIGIT
	TLNE	FR,RADXSW	;WAS ILLEGAL NUMBER ENCOUNTERED?
	TRO	ER,ERRN		;YES, FLAG N ERROR
	JRST	GETDE1

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

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

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

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

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

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

	DIVI	AC1,^D10
	JRST	NUM62

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

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

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

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

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

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

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

	MOVE	AC0,V		;OPDEF
	MOVEI	V,OP		;SET TRANSFER VECTOR
	JRST	EVOPD
EVMAC1:	SKIPL	MACENL		;ALREADY IN CALLM?
	JRST	CALLM		;NO, EVALUATE MACRO
	SETZB	RC,AC0		;ZERO VALUE
	TRO	ER,ERRA		;SET "A" ERROR
	JRST	EVGETD		;CONTINUE EVALUATION

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

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

EVTSTR:	TLNE	ARG,MDFF	;MULTIPLY DEFINED?
	TRO	ER,ERRD		;YES, FLAG IT
	TLNN	FR,NEGSW	;[255] NEGATIVE ATOM?
	JRST	EVGETD		;[255] NO
IFN POLISH,<
	TDNE	RC,[-2,,-2]	;[255] EXTERNALS?
	JRST	NEGEXT		;[255] YES, MUST BE UNARY MINUS
>
	PUSHJ	PP,GETDE2	;[255] NO, JUST NEGATE
EVGETD:	TLNE	IO,NUMSW	;NON BLANK FIELD
	TLO	FR,FSNSW	;YES,SET FLAG
	PUSHJ	PP,BYPAS2
	TLNE	CS,6		;ALPHA-NUMERIC?
	TLO	IO,IORPTC	;YES, REPEAT IT
	CAIN	C,'^'		;[123] IS THIS THE SPECIAL ESCAPE CHAR?
	JRST	EVUPAR		;[123] YES, SEE WHAT FOLLOWS

EVUPAT:				;[333] LABEL FOR RETURN FROM ^
IFN POLISH,<
	TLZN	IO,RSASSW	;INTER-PSECT REFERENCE?
	JRST	EVNUM		;NO
	PUSH	PP,SGWFND	;INX OF PSECT REFERRED TO
	PUSH	PP,[-1]		;DUMMY RELOCATION
	PUSH	PP,CSTATP>	;ADDITIVE PSECT OPERATION
EVNUM:	POP	PP,PS		;POP THE PREVIOUS DELIMITER/TNODE
	TLO	PS,4000
IFN POLISH,<
	TLC	PS,110000	;TEST FOR BITS 2 AND 5
	TLCN	PS,110000	; BOTH ON - MEANS ADDITIVE
	JRST	EVXCT>		; PSECT OPERATION
	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
	TLNE	CS,170000	;[123] YES, ARE WE POINTING AT DEL? (& ! * / + - _)
	JRST	EVPUSH		;[123] NO,FALL INTO EVPUSH
IFN POLISH,<
	TLNE	FR,POLSW	;[164] BEEN RESOLVING POLISH?
	JRST	POLPOP		;[164] YES, OUTPUT IT
>
	POPJ	PP,		;NO, EXIT

;HERE TO HANDLE "^!" 

EVUPAR:	SETZM	UPARRO		;[333] CLEAR ^ COUNTER ONCE IN A WHILE
	PUSHJ	PP,PEEK		;[333] SEE WHAT CHARACTER AFTER ^ IS
	SETZ	CS,		;[333] AND CHECK FOR ! AFTER IT
	CAIN	C,"!"		;[333] IS IT ! FOR ^!
	SKIPA	CS,CSTATX	;[333] YES, GET SPECIAL POINTER
	JRST	EVUPAN		;[416]NOT ^!
	TLZ	IO,IORPTC	;[337] CLEAR REREAD
	SKIPE	MRP		;[357] IF IN A MACRO
	PUSHJ	PP,MREAD	;[357] BETTER DO THIS
	SUBI	C,40		;[333] YES, CHANGE TO SIXBIT
	JRST	EVNUM		;[333] AND EVALUATE
EVUPAN:	MOVEI	C,'^'		;[333] RESTORE C
	MOVE	CS,CSTAT(C)	;[333] AND CS
	SETOM	UPARRO		;[333] SET FLAG FOR CELL1 TO RE-EAT ^
	JRST	EVUPAT		;[333] AND CONTINUE FROM ^

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

EVXCT:	POP	PP,PR		;POP PREVIOUS RELOCATABILITY
	POP	PP,PV		;AND PREVIOUS VALUE
	LDB	PS,[POINT 4,PS,29]	;[123] TYPE OF OPERATION TO PS
IFE POLISH,<
	XCT	EVTAB(PS)	;[123] PERFORM PROPER OPERATION
	JUMPN	RC,.+2		;COMMON RELOCATION TEST
EVXCT1:	JUMPE	PR,EVNUM
	TRO	ER,ERRR		;BOTH MUST BE FIXED
	JRST	EVNUM		;GO TRY AGAIN

EVTAB:	JRST	ASSEM1		;0; SHOULD NEVER GET HERE ;DMN
	JRST	XMUL		;1;
	JRST	XDIV		;2;
	JRST	XADD		;3;
	JRST	XSUB		;4;
	JRST	XLRW		;5; "_"
	IOR	CV,PV		;6; MERGE PV INTO CV
	AND	CV,PV		;7; AND PV INTO CV
	XOR	CV,PV		;10; XOR PV INTO CV
	SETCM	CV,CV		;11;[416] NOT (ONE'S COMPLIMENT)
REPEAT 6,<HALT>			;12-17;[416] JUST INCASE
>
IFN POLISH,<
	CAILE	PS,11		;[265] OPS 12 AND 13
	JRST	POLPSH		;[265]  REQUIRE POLISH FIXUPS
	TDNN	RC,[-2,,-2]	;CHECK FOR EXTERNALS
	TDNE	PR,[-2,,-2]	;IN EITHER OPERAND
	JUMP2	POLPSH		;CAN NOT DO IT HERE
	XCT	PRTAB(PS)	;TEST PREVIOUS RELOCATION
	XCT	RCTAB(PS)	;AND THIS RELOCATION
EVXCT1:	JFCL	17,.+1		;[276] CLEAR OVERFLOW FOR * AND /
	XCT	EVTAB(PS)	;[276] PERFORM PROPER OPERATION
	SKIPL	OKOVFL		;[362] OVERFLOW OK?
	JOV	.+2		;[276] SKIP IF * OR / OVERFLOWED
	SKIPA			;[276] IT'S OK
	TRO	ER,ERRN		;[276] SET N ERROR FOR OVERFLOW
	JRST	EVNUM		;GO TRY AGAIN

EVTAB:	JRST	ASSEM1		;0; SHOULD NEVER GET HERE ;DMN
	IMULM	PV,CV		;1;
	IDIVM	PV,CV		;2;
	JRST	XADD		;3;
	JRST	XSUB		;4;
	JRST	XLRW		;5; "_"
	IOR	CV,PV		;6; MERGE PV INTO CV
	AND	CV,PV		;7; AND PV INTO CV
	XOR	CV,PV		;10; XOR PV INTO CV
	SETCM	CV,CV		;11; NOT (ONE'S COMPLIMENT)
	MOVN	CV,CV		;12; NEGATE (TWO'S COMPLEMENT)
	JFCL			;13;[265] ADDITIVE PSECT OPERATION
REPEAT 4,<HALT>			;14-17; JUST INCASE

NEGEXT:	MOVE	PS,(PP)		;[255] GET DELIMITER OFF STACK
	CAME	PS,[TNODE,,0]	;[255] NOTHING ON YET?
	JRST	EVGETD		;[255] NO?
	MOVSI	PS,4000		;[255] FAKE UP EVPUSH OF
	ADDM	PS,(PP)		;[255]  PS
	PUSH	PP,[0]		;[255]  CV
	PUSH	PP,[0]		;[255]  RC
	PUSH	PP,CSTAT+'-'	;[255]  CS
	TLZ	FR,NEGSW	;[255] CLEAR FLAG
	JRST	EVGETD		;[255] NOW EVALUATE

PRTAB:	JFCL			;0
	JUMPN	PR,POLPSH	;1
	JUMPN	PR,POLPSH	;2
	SKIPE	PR		;3
	SKIPE	PR		;4
REPEAT 4,<JUMPN	PR,POLPSH>	;5, 6, 7, 10
	JFCL			;11

RCTAB:	JFCL			;0
	JUMPN	RC,POLPSH	;1
	JUMPN	RC,POLPSH	;2
	JUMPN	RC,POLPSH	;3
	JUMPE	RC,POLPSH	;4
REPEAT 4,<JUMPN	RC,POLPSH>	;5, 6, 7, 10
	JFCL			;11
>

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

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

IFE POLISH,<
XDIV:	IDIV	PR,CV		;CORRECT RELOCATABILITY
	JFCL	17,.+1		;[276] CLEAR OVERFLOW
	IDIVM	PV,CV
	SKIPL	OKOVFL		;[362] SKIP IF OVERFLOW OK
	JOV	.+2		;[276] SEE IF OVERFLOWED
	SKIPA			;[276] NO
	TRO	ER,ERRN		;[276] YES, SET N ERROR
XDIV1:	EXCH	PR,RC		;TAKE RELOCATION OF NUMERATOR
	JRST	EVXCT1

XMUL:	JUMPE	PR,XMUL1	;AT LEAST ONE OPERAND
	JUMPE	RC,XMUL1	;MUST BE FIXED
	TRO	ER,ERRR
XMUL1:	IORM	PR,RC		;GET RELOCATION TO RC
	CAMGE	PV,CV		;FIND THE GREATER
	EXCH	PV,CV		;FIX IN CASE CV=0,OR 1
	IMULM	PV,RC
	JFCL	17,.+1		;[276] CLEAR OVERFLOW
	IMULM	PV,CV
	SKIPL	OKOVFL		;[362] SKIP IF OVERFLOW OK
	JOV	.+2		;[276] SEE IF OVERFLOW
	SKIPA			;[276] NO
	TRO	ER,ERRN		;[276] YES, SET N ERROR
	JRST	EVNUM
XLRW:	EXCH	PV,CV		;[401][407]
	LSH	CV,0(PV)
	LSH	PR,0(PV)
	JRST	XDIV1
>
IFN POLISH,<
XLRW:	EXCH	PV,CV
	LSH	CV,0(PV)
	JRST	EVNUM
>
IFN POLISH,<			;[164]
;HERE FOR EXTERNAL ARITHMETIC
;CONVERS TO POLISH BLOCK TYPE 11

POLPSH:	JUMP1	EVXCT1		;ONLY SAVE POLISH ON PASS2
	PUSH	PP,POLSTK	;SAVE STACK POINTER
	EXCH	PP,POLSTK	;SAVE PP AND SET UP POLISH STACK
	TLO	FR,POLSW	;SIGNAL STORING POLISH
	PUSH	PP,POLTBL-1(PS)	;STACK OPERATOR
	PUSH	PP,PR		;STACK PREVIOUS RELOCATION
	PUSH	PP,PV		;AND VALUE
	PUSH	PP,RC		;STACK CURRENT
	PUSH	PP,CV
	EXCH	PP,POLSTK	;GET PP BACK
	POP	PP,CV		;USE STACK POINTER FOR VALUE
	MOVE	RC,CV		;AND RELOCATION (ENSURES EXTERNAL)
	JRST	EVNUM		;TRY NEXT ITEM

;HERE TO STORE THE POLISH LIST
;RC  (AND CV) HAVE POINTER TO TOP ITEM IN PUSHDOWN STACK
POLPOP:	MOVE	PV,FREE		;GET NEXT FREE LOCATION
	EXCH	PV,POLIST	;SWAP STACK POINTER
	PUSHJ	PP,POLSTR	;STORE POINTER TO NEXT POLISH BLOCK
	PUSHJ	PP,POLOPF	;STORE FIRST OPERATOR
	PUSHJ	PP,POLFST	;STORE FIRST PART
	PUSHJ	PP,POLSND	;STORE SECOND PART
	SKIPE	PV,POLTYP	;USE PRESET TYPE
	JRST	POLOCT		;IF SET
	SETO	PV,		;STORE OPERATOR OF -1
	JUMPNC	POLOCT		;FOR RIGHT HALF FIXUP
	SUBI	PV,1		;-2 FOR LEFT HALF
POLOCT:	XCT	3+[SETZM EXTPNT		;FULL WORD
		HRRZS	EXTPNT		;LEFT HALF
		HLLZS	EXTPNT](PV)	;RIGHT HALF
	SKIPE	INASGN		;DEFINING A SYMBOL?
	JRST	[SUBI	PV,3		;DIFFERENT STORE OPERATOR
		PUSHJ	PP,POLSTR	;STORE IT
		MOVE	CV,HDAS		;GET FLAGS
		MOVEI	ARG,10		;ASSUME LOCAL
		TLNE	CV,INTF		;IS IT GLOBAL?
		MOVEI	ARG,4		;YES, MAKE GLOBAL
		MOVE	CV,INASGN	;GET SIXBIT SYMBOL
		PUSHJ	PP,SQOZE	;RADIX50
		MOVE	PV,AC0		;CORRECT ACC
		JRST	POLPOR]		;STORE IT
	PUSHJ	PP,POLSTR	;[265] STORE IT
	MOVE	PV,LOCA		;LOCATION
	HRL	PV,MODA		;AND MODE
	SKIPN	LITLVL		;[265] HOWEVER IF IN A LITERAL?
	JRST	POLPOR		;[265] NOT
	MOVE	PV,POLIST	;[265] WE CAN NOT SUPPLY THE STORE ADDRESS YET
	MOVE	CV,(PV)		;[265] SO PUT IN A SPECIAL LIST
	MOVEM	CV,POLIST	;[265] REMOVE FROM REGULAR LIST
	EXCH	PV,POLITS	;[265] STORE IN POLIST LIT LIST
	MOVEM	PV,@POLITS	;[265] LINK TOGETHER
	MOVE	PV,STPX		;[265] STORE DEPTH IN THIS LIT
	SUB	PV,STPY		;[265] WITH NO RELOCATION YET
POLPOR:	PUSHJ	PP,POLSTR
	SETZB	RC,CV		;USE ZERO VALUE AND RELOCATION
POLRET:	MOVE	PV,POLPTR	;RESET INITIAL POLISH POINTER
	MOVEM	PV,POLSTK
	POPJ	PP,		;RETURN

;THIS IS A KLUDGE TO PRODUCE ADDITIVE GLOBALS FOR THE FEW CASES THAT THEY
;CAN HANDLE. I.E. K+GLOBAL, GLOBAL+K, GLOBAL-K
;SO THAT OLD PROGRAMS WILL COMPIL THE SAME WAY AND LOAD WITH THE
;OLD LOADER WITHOUT THE FAILSW CODE
;APART FROM ADDITIVE SYMBOL FIXUPS POLISH BLOCKS ARE MORE POWERFULL
;***** REMOVE SOMEDAY
POLOPF:	HRRZ	PS,1(RC)	;GET FIRST OPERATOR
	CAIE	PS,3		;CAN ONLY HANDLE ADD
	CAIN	PS,4		;AND SUBTRACT
	JRST	POLOP2		;ITS ONE OF THOSE  GIVE IT A TRY
;*****
POLOPX:	SKIPN	SGNMAX		;[265] PSECTS USED?
	JRST	POLOPR		;[265] NO
	PUSH	PP,PV		;[265] SAVE FIRST OP
	HRRO	PV,SGNCUR	;[265] GET CUR PSECT INX
	TRO	PV,400000	;[265] MAKE POLISH OP
	PUSHJ	PP,POLSTR	;[265] STORE IT
	POP	PP,PV		;[265] GET FIRST OP
POLOPR:	HRRZ	PV,1(RC)	;[265] GET OPERATOR
	CAIE	PV,15		;[265] ADDITIVE PSECT OPERATION?
	JRST	POLOPS		;[265] NO
	AOS	0(PP)		;[265] SKIP FIRST OPERAND
	HRRO	PV,3(RC)	;[265] GET PSECT INX
	TROA	PV,400000	;[265] MAKE POLISH OP
POLOPS:	HRRO	PV,1(RC)	;[265] GET OPERATOR AND FLAG IT
	JRST	POLSTR		;STORE IT AND EXIT

;***** MORE OF THIS KLUDGE
POLOP2:	SUBI	PS,3		;MAKES LIFE EASIER
	MOVE	CV,4(RC)	;GET 2ND OPERAND
	JUMPL	CV,POLOPX	;ITS A POINTER, THEREFORE TOO COMPLEX
	MOVE	PV,2(RC)	;AND 1ST OPERAND
	JUMPL	PV,POLOPX	;THIS IS A POINTER
	TDNN	CV,[-2,,-2]	;TEST FOR EXTERN
	JRST	[TRNE	CV,1		;TEST FOR BOTH RELOCATABLE
		TRNN	PV,1
		JRST	POLOP3		;THIS IS NOT EXTERN SO OTHER CAN BE
		JRST	POLOPX]		;CANNOT HANDLE HERE, USE POLISH
	JUMPN	PS,POLOPX	;CAN NOT HANDLE -GLOBAL
	TDNE	PV,[-2,,-2]	;TEST FOR EXTERN HERE
	JRST	POLOPX		;GLOBAL+GLOBAL TOO COMPLEX
POLOP3:	SOS	FREE		;BACKUP FREE COUNTER
	MOVE	PV,@FREE	;GET LAST POINTER
	MOVEM	PV,POLIST	;SET POINTER BACK
	POP	PP,PV		;POP RETURN OFF STACK
	TLZ	FR,POLSW	;CLEAR FLAG JUST IN CASE
;RELOAD RC, CV, PV, AND PR FROM STACK
;AND EXECUTE OPERATOR
	MOVE	PR,2(RC)	;
	MOVE	PV,3(RC)
	MOVE	CV,5(RC)
	MOVE	RC,4(RC)	;THIS ONE LAST OF COURSE
	JUMPN	PS,POLOP5	;DO MINUS
	ADDM	PV,CV
	ADDM	PR,RC
	JRST	POLRET		;RESTORE STACK AND RETURN

POLOP5:	SUBM	PV,CV
	SUBM	PR,RC
	JRST	POLRET
;***** END OF THIS KLUDGE

;HERE TO HANDLE FIRST OPERAND
;HIGHLY RECURSIVE

POLFST:	MOVE	PV,2(RC)	;GET RELOCATION
	JUMPL	PV,POLFSR	;THIS IS ANOTHER POINTER
	TDNE	PV,[-2,,-2]	;IS IT EXTERNAL?
	JRST	POLFS2		;YES
	MOVE	CV,3(RC)	;GET VALUE
POLFS4:	TLNN	PV,-1		;CHECK FOR LEFT HALF VALUE
	TLNE	CV,-1
	JRST	POLFS1		;YES, NEED FULL WORD
	HRL	CV,PV		;XWD RELOC ,, VALUE
	SETZ	PV,		;OPERAND IS 0 FOR 18 BIT VALUE
	PUSHJ	PP,POLSTR
	MOVE	PV,CV
	JRST	POLSTR		;STORE AND EXIT

POLFS1:	MOVEI	PV,1		;OPERAND IS 1 FOR 36 BIT VALUE
	PUSHJ	PP,POLSTR
	MOVE	PV,2(RC)	;RELOCATION
	PUSHJ	PP,POLSTR
	MOVE	PV,CV		;VALUE
	JRST	POLSTR

POLSN2:
POLFS2:	MOVE	CV,1(PV)	;GET SIXBIT SYMBOL INTO AC0
	MOVEI	PV,2		;OPERAND IN 2 FOR SYMBOL
	PUSHJ	PP,POLSTR
	MOVEI	ARG,4		;MAKE GLOBAL REQUEST
	PUSHJ	PP,SQOZE	;TO RADIX-50
	MOVE	PV,CV		;PUT IN RIGHT ACC
	JRST	POLSTR		;STORE IT

POLFSR:	CAME	PV,3(RC)	;CHECK TO MAKE SURE IT REALLY IS A POINTER
	JRST	POLFSN		;NO, ITS A NEGATIVE GLOBAL
	PUSH	PP,RC		;SAVE THIS POINTER
	MOVE	RC,PV		;GET NEXT POINTER
	PUSHJ	PP,POLOPR	;GET OPERATOR
	PUSHJ	PP,POLFST	;GET FIRST OPERAND
	PUSHJ	PP,POLSND	;GET SECOND OPERAND
	POP	PP,RC		;GET BACK PREVIOUS POINTER
	POPJ	PP,		;RETURN TO PREVIOUS LEVEL


POLFSN:	HRROI	PV,14		;TWO'S COMPLIMENT NEGATIVE
	PUSHJ	PP,POLSTR	;STORE OPERATOR
	MOVN	PV,2(RC)	;GET RELOCATION
	TDNE	PV,[-2,,-2]	;CHECK FOR EXTERN
	JRST	POLFS2		;IT IS, CONVERT TO RADIX-50
	MOVN	CV,3(RC)	;GET VALUE
	JRST	POLFS4		;AND STORE IT
;HERE TO HANDLE 2ND OPERAND, ALSO RECURSIVE

POLSNR:	CAME	PV,5(RC)	;MAKE SURE IT REALLY IS
	JRST	POLSNN		;ITS A NEGATIVE GLOBAL
	MOVE	RC,PV		;GET NEXT POINTER
	PUSHJ	PP,POLOPR	;STORE OPERATOR
	PUSHJ	PP,POLFST	;GET 1ST OPERAND
				;AND GET SECOND OPERAND

POLSND:	MOVE	PV,4(RC)	;GET RELOCATION
	JUMPL	PV,POLSNR	;THIS IS A POINTER
	TDNE	PV,[-2,,-2]	;IS IT EXTERNAL?
	JRST	POLSN2		;YES
	MOVE	CV,5(RC)	;GET VALUE
POLSN4:	TLNN	PV,-1		;CHECK FOR LEFT HALF VALUE
	TLNE	CV,-1
	JRST	POLSN1		;YES, NEED FULL WORD
	HRL	CV,PV		;XWD RELOC ,, VALUE
	SETZ	PV,		;OPERAND IS 0 FOR 18 BIT VALUE
	PUSHJ	PP,POLSTR
	MOVE	PV,CV
	JRST	POLSTR		;STORE AND EXIT

POLSNN:	HRROI	PV,14		;TWO'S COMPLIMENT NEGATIVE
	PUSHJ	PP,POLSTR	;STORE OPERATOR
	MOVN	PV,4(RC)	;GET RELOCATION
	TDNE	PV,[-2,,-2]	;CHECK FOR EXTERN
	JRST	POLSN2		;IT IS, CONVERT TO RADIX-50
	MOVN	CV,5(RC)	;GET VALUE
	JRST	POLSN4		;AND STORE IT

POLSN1:	MOVEI	PV,1		;OPERAND IS 1 FOR 36 BIT VALUE
	PUSHJ	PP,POLSTR
	MOVE	PV,4(RC)	;RELOCATION
	PUSHJ	PP,POLSTR
	MOVE	PV,CV		;VALUE
;	JRST	POLSTR

POLSTR:	AOS	SDEL,FREE	;GET A FREE WORD
	CAML	SDEL,SYMBOL	;ENOUGH?
	PUSHJ	PP,XCEED	;NO
	MOVEM	PV,-1(SDEL)	;STORE ONE WORD
	POPJ	PP,

;TABLE OF CORRESPONDENCE BETWEEN MACRO-10 OPERATORS AND BLOCK 11 OPERATORS
POLTBL:	;POLISH VALUE	MACRO-10	OPERATOR
	5		;1		MULTIPLY
	6		;2		DIVIDE
	3		;3		ADD
	4		;4		SUBTRACT
	11		;5		LEFT SHIFT
	10		;6		LOGICAL IOR
	7		;7		LOGICAL AND
	12		;10		LOGICAL XOR
	13		;11		NOT
	14		;12		NEGATE
	15		;13		ADDITIVE PSECT OPERATION

>;END OF IFN POLISH

	SUBTTL	LITERAL STORAGE HANDLER
	
STOLER:
IFE FORMSW,<	SETZB	AC0,RC	;ERROR, NO CODE STORED
	PUSHJ	PP,STOW		;STOW ZERO>
IFN FORMSW,<	MOVEI	AC0,0
	PUSHJ	PP,STOWZ1>
	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
	MOVE	SX,LITERR	;[415]GET TOTAL ERRORS FOR LEVEL
	TRNN	FR,ERRQSW	;[415]IGNORING Q ERRORS?
	TRZ	SX,ERRQ		;[415]YES,SO TURN IT OFF
	TRNN	SX,ERRORS	;[415]DOES LITERAL HAVE ERROR?
	JRST	STOL06		;NO
;**;[441] INSERT 2L,CHANGE COMMENT @STOLIT+8	JBC	21-SEP-76
	TRNE	SX,ERRU		;[441] YES,NO SEARCH IF UNDF SYMBOL ON
	 JRST	STOL22		;[441] PASS1, BRANCH
	JUMP2	STOL22		;[441] BRANCH IF PASS2
	ADDM	SDEL,LITCNT	;PASS ONE, UPDATE COUNT
	JRST	STOWI		;INITIALIZE STOW

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

STOL10:	SOJL	AC2,STOL24	;TEST FOR END
	MOVE	SX,0(SX)	;NO, GET NEXT STORAGE CELL
	MOVE	V,-1(SX)		;GET RELOCATION BITS WFW
	CAMN	AC0,-2(SX)	;DO CODES COMPARE? WFW
	CAME	RC,V		;YES, HOW ABOUT RELOCATION?
	AOJA	SDEL,STOL10	;NO, TRY AGAIN
	SKIPGE	STPX		;YES, MULTI-WORD?
	JRST	STOL13		;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
STOL13:				;YES, RETURN LOCATION
IFN POLISH,<
	SETZM	POLITS		;CLEAR ANY POLISH PENDING
>
	JRST	STOL26

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
IFN FORMSW,<
	MOVE	AC0,FORM
	MOVEM	AC0,-3(SX)>
	MOVEM	SX,LITABX	;SET POINTER TO CURRENT CELL
	AOS	LITNUM		;INCREMENT NUMBER STORED
	AOS	LITCNT		;INCREMENT NUMBER RESERVED
	SKIPL	STPX		;ANY MORE CODE?
	JRST	STOL23		;YES
STOL26:	JUMP1	POPOUT		;EXIT IF PASS ONE
	MOVE	SX,LITHDX	;GET HEADER BLOCK
	HLRZ	RC,-1(SX)	;GET BLOCK RELOCATION
	HRRZ	AC0,-1(SX)
	ADDI	AC0,0(SDEL)	;COMPUTE ACTUAL LOCATION
	POPJ	PP,		;EXIT

SUBTTL	INPUT ROUTINES

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

GETCS1:	JUMPE	C,GETCS		;IGNORE NULS
	TRC	C,100		;MAKE CHAR. VISIBLE
	MOVEI	CS,"^"
	DPB	CS,LBUFP	;PUT ^ IN OUTPUT
	PUSHJ	PP,RSW2		;ALSO MODIFIED CHAR.
	TRO	ER,ERRQ		;FLAG Q ERROR
	JRST	GETCHR		;BUT IGNORE CHAR.
CHARAC:	TLZE	IO,IORPTC	;REPEAT REQUESTED?
	JRST	CHARAX		;YES
RSW0:	JUMPN	MRP,MREAD	;BRANCH IF TREE POINTER SET
	PUSHJ	PP,READ
RSW1:	SKIPE	RPOLVL		;ARE WE IN "REPEAT ONCE"?
	JRST	REPO1		;YES
RSW2:	CAIN	C,LF		;LF?
	JRST	RSW4		;YES, SEE IF LAST CHAR WAS A CR
	MOVEM	C,LIMBO		;STORE THIS CHAR. FOR RPTC
RSW3:	TLNE	IO,IOSALL	;MACRO SUPPRESS ALL?
	JUMPN	MRP,CPOPJ	;YES,DON'T LIST IN MACRO
	SOSG	CPL		;ANY ROOM IN THE IMAGE BUFFER?
	PUSHJ	PP,RSW5		;[254] NO, BUT SEE IF ANY EXCESS WE CAN USE
	IDPB	C,LBUFP		;YES, STORE IN PRINT AREA
	CAIE	C,HT		;TAB?
	POPJ	PP,		;NO, EXIT
	MOVEI	CS,7		;TAB COUNT MASK
	ANDCAM	CS,CPL		;MASK TO TAB STOP
	POPJ	PP,

RSW4:	MOVE	CS,LIMBO	;GET LAST CHAR.
	MOVEM	C,LIMBO		;STORE THIS CHAR. FOR RPTC
	CAIE	CS,CR		;LAST CHAR. A CR?
	JRST	RSW3		;NO
	HRROS	LIMBO		;YES,FLAG
	POPJ	PP,		;AND EXIT

RSW5:	PUSH	PP,C		;[254] NEED AN ACC
	MOVNI	C,.CPLX		;[254] GET EXCESS SPACE
	CAMGE	C,CPL		;[254] ANY ROOM?
	JRST	[POP	PP,C		;[254] YES
		POPJ	PP,]		;[254] JUST RETURN
	POP	PP,C		;[254] NO
	JRST	OUTPL		;[254] OUTPUT THE PARTIAL LINE
CHARAX:	HRRZ	C,LIMBO		;GET LAST CHARACTER
	POPJ	PP,		;EXIT

CHARL:	PUSHJ	PP,CHARAC	;GET AND TEST 7-BIT ASCII
	CAIG	C,FF		;LINE OR FORM FEED OR VT?
	CAIGE	C,LF
	POPJ	PP,		;NO,EXIT
	SKIPE	LITLVL		;IN LITERAL?
	JRST	OUTIML		;YES
CHARL1:	PUSHJ	PP,SAVEXS	;SAVE REGISTERS
	PUSHJ	PP,OUTLIN	;DUMP THE LINE
	JRST	RSTRXS		;RESTORE REGISTERS AND EXIT
;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)
;UNTIL A LINE TERMINATOR IS SEEN.
STOUTS:	TLOA	IO,IOENDL!IORPTC
STOUT:	TLO	IO,IORPTC
	BYPASS
	CAIE	C,EOL		;MOST LIKELY A ; OR EOL CH
	JRST	STOUT2		;IT WASN'T, SEE WHY!
	HRRZ	C,LIMBO		;GET CHARACTER INCASE EOL
	TLZN	IO,IORPTC	;IT WAS , SKIP NEXT GET
STOUT1:	PUSHJ	PP,RSW0
	CAIN	C,CR		;NEED SPECIAL TEST FOR CR
	JRST	STOUT3		;INCASE NOT FOLLOWED BY LF
	CAIG	C,FF
	CAIGE	C,LF
	JRST	STOUT1
	JRST	OUTLIN		;OUTPUT THE LINE (BIN AND LST)

STOUT2:	CAIN	C,14		;COMMA?
	SKIPL	STPX		;YES, ERROR IF CODE STORED
	TRO	ER,ERRQ
	JRST	STOUT1		;PASS OUT TIL END OF LINE

STOUT3:	PUSHJ	PP,RSW0		;GET NEXT CHAR.
	CAIG	C,FF		;GENUINE EOL CHARACTER?
	CAIGE	C,LF
	TLOA	IO,IORPTC	;NO, SO REPEAT IT
	JRST	OUTLIN		;AND DUMP LINE IN ANY CASE
REPEAT 0,<			;[252] DON'T FLAG IT
	TRO	ER,ERRQ		;[144] FLAG EXTRA <CR> WITH "Q" ERROR
>
	SETZ	C,
	DPB	C,LBUFP		;CLEAR LOOK-AHEAD CHAR OUT OF BUFFER
	PUSHJ	PP,OUTLIN	;DUMP UPTO CR AS LINE
	HRRZ	C,LIMBO		;GET C BACK
	JRST	RSW3		;AND PUT CHAR IN NEW  BUFFER
SUBTTL	CHARACTER STATUS TABLE

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

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

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

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

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

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

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

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

CSTATX:	GENCS	04,12,1,00,10,01	;[123]  '^!'
CSTATN:	GENCS	04,12,1,00,11,15	;[123][416]  '^-'
IFN POLISH,<
CSTATP:	GENCS	11,12,1,00,13,13	;ADDITIVE PSECT OPERATION
>
SUBTTL	LISTING ROUTINES

OUTLIN:	TRNN	ER,ERRORS-ERRQ	;ANY ERRORS?
	TLNE	FR,ERRQSW	;NO, IGNORE Q ERRORS?
	TRZ	ER,ERRQ		;YES, YES, ZERO THE Q ERROR
	HRLZ	AC0,ER		;PUT ERROR FLAGS IN AC0 LEFT
	TDZ	ER,TYPERR
	JUMP1	OUTL30		;BRANCH IF PASS ONE
	JUMPN	AC0,OUTL02	;JUMP IF ANY ERRORS TO FORCE PRINTING
	SKIPL	STPX		;SKIP IF NO CODE, OTHERWISE
	JRST	OUTL01		;NO
	TLNN	IO,IOSALL	;YES,SUPPRESS ALL?
	JRST	OUTL03		;NO
	JUMPN	MRP,CPOPJ	;YES,EXIT IF IN MACRO
	LDB	C,[XWD 350700,LBUF]
	CAIE	C,15		;FIRST CHAR CR?
OUTL01:	TLZ	IO,IOMAC	;FORCE MACRO PRINTING
OUTL03:	TLNN	IO,IOMSTR!IOPROG!IOMAC
OUTL02:	IOR	ER,OUTSW	;FORCE IT.
	IDPB	AC0,LBUFP	;STORE ZERO TERMINATOR AFTER ASCII SRC LINE
	TSO	ER,AC0		;[411]RE-FLAG THE ERRORS FOR %....X
	TLNN	FR,CREFSW	;CREF?
	PUSHJ	PP,CLSCRF	;YES, WRITE END OF CREF DATA (177,003)
	MOVE	C,TYPERR	;[411]NOW RESTORE FLAGS AS
	ANDI	C,ERRORS	;[411]THEY WERE SO TTY LISTING IS
	TDZ	ER,C		;[411]WHAT THEY ASKED FOR
	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	C,ASGBLK	;[263]
	SKIPE	CS,LOCBLK	;
	SKIPL	STPX		;ANY BINARY?
	JRST	OUTL23		;YES, JUMP
	JUMPE	C,OUTL22	;[263] SEQUENCE BREAK AND NO BINARY JUMPS
	ILDB	C,TABP		;ASSIGNMENT FALLS THROUGH
	PUSHJ	PP,OUTL		;OUTPUT A TAB.
	ILDB	C,TABP		;OUTPUT 2ND TAB, LOCATION FIELD
	PUSHJ	PP,OUTC		;NEXT IS BINARY LISTING FIELD
	HLLO	CS,LOCBLK	;LEFT HALF OF A 36BIT VALUE
	SKIPL	ASGBLK		;[263] SKIP IF LEFT HALF IS NOT RELOC
	TRZA	CS,1		;IT IS, SET THE FLAG
	TLNE	CS,-1		;SKIP IF ITS A 18BIT VALUE, OTHERWISE
	PUSHJ	PP,ONC1		;PRINT LH OF A 36 BIT VALUE IN CS
	HRLO	CS,LOCBLK	;PICK UP THE RIGHT HALF (18BIT VALUE)
	MOVE	C,ASGBLK	;[263] GET RIGHT HALF RELOCATION
	TRZ	CS,0(C)		;[263] 
	PUSHJ	PP,ONC		;PRINT IT
	JRST	OUTL23		;SKIP SINGLE QUOTE TEST
OUTL22:	PUSHJ	PP,ONC		;TAB TO RH AND PRINT IT
	MOVEI	C,"'"
	SKIPE	MODA
	PUSHJ	PP,OUTC
OUTL23:	SKIPL	STPX		;ANY BINARY?
	PUSHJ	PP,BOUT		;YES, DUMP IT
	MOVE	CS,@OUTLI2	;[POINT 7,LBUF]
OUTL24:	ILDB	C,CS
	CAILE	C," "		;[157]
	JRST	OUTL28		;[157] FOUND A PRINTING CHARACTER
	JUMPN	C,OUTL24	;[157] TRY AGAIN UNLESS TERMINAL 0
	SKIPN	SEQNO		;[157] SEQUENCE NO. ARE WORTH PRINTING
	JRST	OUTL25		;[157] BUT JUST TABS AREN'T
OUTL28:	MOVE	CS,TABP
	PUSHJ	PP,OUTASC	;OUTPUT TABS & SEQ. NO.
OUTL25:	MOVEI	CS,LBUF
	PUSHJ	PP,OUTAS0	;DUMP THE LINE
	TLNE	IO,IOSALL	;SUPPRESSING ALL
	JUMPN	MRP,OUTL27	;YES,EXTRA CR IF IN MACRO
OUTL26:	SKIPGE	STPX		;ANY BINARY?
	JRST	OUTLI		;NO, CLEAN UP AND EXIT
	PUSHJ	PP,OUTLI2	;YES, INITIALIZE FOR NEXT LINE
	TLNN	FR,CREFSW	;[130] CREF REQUESTED?
	TLNE	IO,IOPROG	;[130] YES, THEN IS XLIST ON?
	JRST	.+2		;[130] CREF NOT BEING PRINTED
	PUSHJ	PP,CLSCRF	;[130] CLOSE OUT THIS CREF LINE
	PUSHJ	PP,BOUT		;YES, DUMP IT
OUTL27:	PUSHJ	PP,OUTCR	;OUTPUT CARRIAGE RETURN
	JRST	OUTL26		;TEST FOR MORE BINARY

OUTPL:	SKIPN	LITLVL		;IF IN LITERAL
	SKIPL	STPX		;OR CODE GENERATED
	JRST	OUTIM		;JUST OUTPUT THE IMAGE
	SKIPE	ASGBLK		;[205]
	JRST	OUTPL1		;[205] JUMP IF AN ASSIGNMENT
	SKIPE	LOCBLK		;[205] OR A BLOCK RESERVATION
	SKIPE	MACENL		;[205] STILL IN "CALLM"?
	JRST	OUTIM		;[205] OTHERWISE OUTPUT IMAGE
	JUMPN	MRP,OUTIM	;[205] ALSO IF IN A MACRO
OUTPL1:	PUSHJ	PP,SAVEXS	;[242] SAVE AC0 AND C
	MOVEI	C,CR
	IDPB	C,LBUFP
	MOVEI	C,LF
	IDPB	C,LBUFP		;FINISH WITH CRLF
	PUSHJ	PP,OUTLIN	;OUTPUT PARTIAL LINE
	PUSHJ	PP,RSTRXS	;[242] RESTORE ACS
	JRST	OUTLI2		;INITIALISE REST OF LINE
OUTL30:	AOS	CS,STPX		;PASS ONE
	CAIN	C,FF		;FORM FEED?
	PUSHJ	PP,OUTFF2	;YES, COUNT PAGES FOR PASS1 ERROR
	ADDM	CS,LOCO		;INCREMENT OUTPUT LOCATION
	PUSHJ	PP,STOWI	;INITIALIZE STOW
	TLZ	AC0,ERRORS-ERROR1	;[125]
	JUMPN	AC0,OUTL32	;JUMP IF ERRORS
	TLNE	IO,IOSALL	;SUPPRESSING ALL
	JUMPN	MRP,CPOPJ	;YES,EXIT
	JRST	OUTLI1		;NO,INIT LINE

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

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

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

OUTLI1:	TRZ	ER,ERRORS!LPTSW!TTYSW
OUTLI2:	MOVE	CS,[POINT 7,LBUF]	;INITIALIZE BUFFERS
	MOVEM	CS,LBUFP
IFN FORMSW,<MOVE CS,[POINT 7,TABI]
	MOVSS	HWFMT		;PUT FLAG IN LEFT HALF
	SKIPGE	HWFMT		;BUT IF ONLY HALF-WORD FORMAT>
	MOVE	CS,[POINT 7,TABI,6]
	MOVEM	CS,TABP
	MOVEI	CS,.CPL
IFN FORMSW,<SKIPL HWFMT		;IF MULTI-FORMAT
	SUBI	CS,8		;LINE IS ONE TAB SHORTER
	MOVSS	HWFMT		;BACK AS IT WAS>
	SKIPE	SEQNO		;[153] A SEQUENCED FILE?
	SUBI	CS,8		;[153] YES, SEQ NO TAKES UP SPACE
	MOVEM	CS,CPL
	MOVSI	CS,(ASCII /	/)
	SKIPE	SEQNO		;HAVE WE SEQUENCE NUMBERS?
	MOVEM	CS,SEQNO	;YES, STORE TAB IN CASE OF MACRO
	MOVEM	CS,SEQNO+1	;STORE TAB AND TERMINATOR
	SETZM	ASGBLK
	SETZM	LOCBLK
	POPJ	PP,
OUTIML:	TLNE	IO,IOSALL	;SUPPRESSING ALL?
	JUMPN	MRP,CPOPJ	;YES,EXIT IF IN MACRO
	TRNN	ER,ERRORS-ERRQ		;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS
	TLNE	FR,ERRQSW
	TRZ	ER,ERRQ
	HRLZ	CS,ER
	JUMP1	OUTML1		;CHECK PASS1 ERRORS
	TDZ	ER,TYPERR
	JUMPE	CS,OUTIM1
	PUSH	PP,[0]		;ERRORS SHOULD BE ZEROED
	PUSH	PP,C
	PUSH	PP,AC0		;SAVE AC0 IN CASE CALLED FROM ASCII
	MOVE	AC0,CS		;ERROR ROUTINE WANTS FLAGS IN AC0
	IOR	ER,OUTSW
	TLNN	 FR,CREFSW
	PUSHJ	PP,CLSCRF	;FIX CREF
	TLZE	AC0,ERRM
	TLO	AC0,ERRP
	PUSHJ	PP,OUTLER	;OUTPUT THEM
	POP	PP,AC0
	JRST	OUTIM2		;AND LINE
	
OUTML1:	TLZ	CS,ERRORS-ERROR1-ERRL	;[250] ANY ERRORS TO PRINT ON PASS1?
	JUMPE	CS,[TRZ	ER,ERRORS!LPTSW!TTYSW-ERRN	;[250] NONE
		JRST	OUTLI2]		;[250] BUT "N" IS FOR MULTI-LINE LITS
	TRZ	ER,ERRORS!LPTSW!TTYSW	;[250]
	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
	MOVE	CS,TAG
	PUSHJ	PP,OUTSY1
	MOVEI	CS,[SIXBIT / +@/]
	PUSHJ	PP,OUTSIX
	SKIPN	LBLFLG		;[402] HAS A LABEL OCCURRED IN THIS LITERAL?
JRST	[HRRZ	C,TAGINC	;[402] NO, GET NORMAL INC
	JRST	OUTML2]		;[402]
	MOVE	C,STPX		;[402] GET CURRENT DEPTH
	SUB	C,LTGINC	;[402] SUBTRACT DEPTH OF LABEL
OUTML2:	PUSHJ	PP,DNC		;[402]
	PUSHJ	PP,OUTTAB
	PUSHJ	PP,OUTLER	;DO NOT FORGET ERRORS
	PUSHJ	PP,OUTTAB
	SETZ	AC0,		;[253] SET A ZERO TERMINATOR
	IDPB	AC0,LBUFP	;[253] IN THE OUTPUT BUFFER
	MOVEI	CS,LBUF		;PRINT REST OF LINE
	PUSHJ	PP,SOUT20
	POP	PP,AC0
	POP	PP,C
	POP	PP,ER
	JRST	OUTLI2
SUBTTL	OUTPUT ROUTINES
UOUT:	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRNN	ARG,PNTF	;WFW
	TRNN	ARG,UNDF
	JRST	UOUT13		;TEST FOR UNDF!EXTF!PNTF ON PASS2
	JUMP2	UOUT10
	TLNN	IO,IOIOPF	;ANY IOP'S SEEN
	JRST	UOUT12		;NO,MAKE EXTERNAL
	MOVSI	CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE
UOUT1:	CAME	AC0,PRMTBL(CS)	;HAVE WE A MATCH?
	AOBJN	CS,UOUT2	;NO,INCREMENT AND JUMP
	MOVE	ARG,PRMTBL+1(CS);YES,GET VALUE
	MOVEM	ARG,(SX)	;UPDATE SYMBOL TABLE
	POPJ	PP,		;EXIT

UOUT2:	AOBJN	CS,UOUT1	;TEST FOR END
UOUT12:	TRNE	ARG,ENTF	;[340] SEE IF FORWARD DEFINED
	POPJ	PP,		;[340] YES, THEN DON'T EXTERNAL IT
	PUSHJ	PP,EXTER2	;MAKE IT EXTERNAL
	MOVSI	ARG,UNDF	;BUT PUT UNDF BACK ON
	IORM	ARG,(SX)	;SO MESSAGE WILL COME OUT
	POPJ	PP,		;GET NEXT SYMBOL

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

				;OUTPUT THE ENTRIES

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

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

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

LSOUT:	SKIPN	C,LOCAL		;ANY LOCAL FIXUPS REQUIRED?
	POPJ	PP,		;NO
	MOVS	AC0,(C)		;GET VALUE RIGHT WAY ROUND
	MOVS	RC,1(C)		;AND RELOCATION
	HLRZM	RC,LOCAL	;STORE NEXT POINTER
	PUSHJ	PP,COUT		;OUTPUT THIS WORD
	JRST	LSOUT		;LOOK FOR MORE
				;OUTPUT THE SYMBOLS
SOUT:	SKIPN	IONSYM		;SKIP IF NOSYM SEEN
	TRNN	ER,LPTSW!TTYSW	;A LISTING REQUIRED?
	JRST	SOUT2		;NO
	MOVEI	[ASCIZ /SYMBOL TABLE/]
	HRRM	SUBTTX		;SET NEW SUB-TITLE
	MOVEI	ARG,NCOLS	;SET UP FOR NCOLS ACROSS SYMBOL TABLE
	TRNE	ER,TTYSW	;IS TTY LISTING DEVICE?
	MOVEI	ARG,2		;YES,ONLY 2 COLLUMNS
	MOVEM	ARG,NCOLLS	;STORE ANSWER
IFE POLISH,<
	MOVE	SX,SYMBOL	;START OF TABLE
	MOVE	SDEL,(SX)	;COUNT OF SYMBOLS
>
IFN POLISH,<
	MOVE	SX,SGSBOT	;START OF TABLE
	MOVE	SDEL,SGNCUR	;CUR PSECT INX
	JUMPE	SDEL,SOUTBS	;IS THIS THE BLANK PSECT?
	MOVE	ARG,[XWD SGTTLB,SGLIST]
	BLT	ARG,SGTTLE-SGTTLB+SGLIST-1	;MOVE SUBTTL
	MOVE	AC1,SGTTLE	;'TO' POINTER
	MOVE	AC2,SGTTLF	;'FROM' POINTER
SGTTLL:	ILDB	AC0,AC2		;GET A SIXBIT CHAR
	ADDI	AC0,40		;FORM ASCII
	IDPB	AC0,AC1		;PUT IN SUBTTL
	TLNE	AC2,770000	;DONE SIX CHARS?
	JRST	SGTTLL		;NOT DONE YET
	SETZ	AC0,		;TERMINATE SUBTTL
	IDPB	AC0,AC1		; WITH NULL BYTE
	MOVEI	AC0,SGLIST	;POINTER TO
	HRRM	AC0,SUBTTX	; NEW SUBTTL
SOUTBS:	HRRZ	SDEL,SGSCNT(SDEL)	;COUNT OF SYMBOLS
>
	ADDI	SX,2		;SKIP COUNT
	MOVEM	SX,SXSV		;SAVE PLACE
	MOVEM	SDEL,SDELSV
	MOVE	SX,SPAGNO	;GET LAST SYMBOL PAGE NUMBER
	EXCH	SX,PAGENO	;SWAP WITH OUTPUT PAGE NUMBER
	MOVEM	SX,SPAGNO	;AND STORE IT
	MOVE	SX,[BYTE (7) 0,0,<"S">,<"-">,0]
	IORM	SX,DBUF+4	;FIXUP TITLE

SOUT0:	PUSHJ	PP,SOUTP	;GET PAGE SET UP
	  JRST	SOUT1		;NOTHING TO OUTPUT
	PUSHJ	PP,SOUTF	;DUMP ONE PAGE
	  JRST	SOUT1		;DIDN'T FILL PAGE-DONE
	JRST	SOUT0

IFN POLISH,<
SGTTLB:	ASCII	/SYMBOL TABLE FOR PSECT   /
SGTTLE:	POINT	7,SGTTLE-SGTTLB+SGLIST
SGTTLF:	POINT	6,SGNAME(SDEL)
>
SOUTT:	MOVE	ARG,(SX)	;GET FLAGS
	TLNE	ARG,SUPRBT	;SURPRESSED?
	POPJ	PP,		;YES
	TLNN	ARG,SYMF	;SYMBOL IS OK
	TLNN	ARG,SYNF!MACF	;BUT MACRO OR SYNONYM AREN'T
	AOS	(PP)
	POPJ	PP,
SOUTP:	MOVE	AC1,NCOLLS	;GET COLUMN COUNT
	MOVE	SX,SXSV		;GET POSITION
	MOVE	SDEL,SDELSV	;AND COUNT

SOUTP0:	MOVEM	SX,SYMBLK(AC1)
	HRLM	SDEL,SYMBLK(AC1)	;SAVE IN TABLE
	MOVE	AC0,..LPP	;[227] LINE COUNT

SOUTP1:	JUMPE	SDEL,SOUTP2	;IF NONE LEFT, GO ELSEWHERE
	PUSHJ	PP,SOUTT	;SYMBOL OK?
	  TDZA	RC,RC		;NO
	SETO	RC,		;YES
	ADDI	SX,2		;SET UP FOR NEXT NOW
	SUBI	SDEL,1
	JUMPGE	RC,SOUTP1	;SKIP SYMBOL
	SOJG	AC0,SOUTP1	;COUNT IN SYMBOL
	SOJG	AC1,SOUTP0	;START NEXT COLUMN
	MOVEM	SX,SXSV		;SAVE POSITION
	MOVEM	SDEL,SDELSV
	AOS	(PP)
	POPJ	PP,
SOUTP2:	CLEARM	SDELSV		;FLAG DONE
	CAME	AC1,NCOLLS	;IF ON 1ST COLUMN
	JRST	.+3
	CAMN	AC0,..LPP	;[227] AND FIRST LINE
	POPJ	PP,		;THEN SKIP PRINTING
	SOJLE	AC1,CPOPJ1	;ALREADY GOT THIS LINE
	CLEARM	SYMBLK(AC1)
	SOJG	AC1,.-1		;ZERO ALL OTHERS
	JRST	CPOPJ1
SOUTF:	PUSHJ	PP,OUTFF	;GET TO TOP OF PAGE
	MOVE	AC1,..LPP	;[227]
	MOVEM	AC1,COLSIZ

SOUTF1:	PUSHJ	PP,SOUTL	;DUMP ONE LINE
	  JRST	CPOPJ		;WAS BLANK
	SOSLE	COLSIZ		;ONE MORE DONE
	JRST	SOUTF1		;MORE TO GO
SOUTF2:	JRST	CPOPJ1

SOUTL:	MOVE	AC1,NCOLLS	;SET COLUME COUNT
SOUTL0:	HRRZ	SX,SYMBLK(AC1)
	HLRZ	SDEL,SYMBLK(AC1);GET POSITION IN TABLE
	JUMPE	SDEL,SOUTL3	;NOTHING THERE

SOUTL1:	PUSHJ	PP,SOUTT	;SYMBLE PRINTABLE?
	  JRST	SOUTL2		;CENCOR!!
	PUSHJ	PP,SOUTE	;DUMP OUT ENTRY
	ADDI	SX,2
	SUBI	SDEL,1		;UP TP NEXT ONE
	HRL	SX,SDEL		;SAVE OUR PLACE
	MOVEM	SX,SYMBLK(AC1)
	SOJG	AC1,SOUTL0	;NEXT!
	AOS	(PP)
	JRST	OUTCR		;POLISH OFF LINE

SOUTL2:	ADDI	SX,2
	SOJG	SDEL,SOUTL1	;KEEP SEARCHING
SOUTL3:	CAME	AC1,NCOLLS	;BLANK LINE?
	AOS	(PP)		;NO
	JRST	OUTCR
SOUTE:	MOVE	AC0,-1(SX)
	PUSHJ	PP,OUTSYM	;DUMP SYMBOL OUT
	PUSHJ	PP,SRCH7	;GET VALUE
	TLNN	ARG,EXTF	;EXTERNAL?
	JRST	.+5
	HLRZ	RC,V		;YES, NEED FIXUP
	TRNE	RC,-2
	MOVS	RC,(RC)
	HLL	V,RC

	HLLO	CS,V
	TLNE	RC,-1
	TRZ	CS,1
	TLNE	RC,-2
	TRZ	CS,EXTF
	TLNN	V,-1
	TLNE	RC,-1
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTTAB
	HRLO	CS,V
	TRNE	RC,-1
	TRZ	CS,1
	TRNE	RC,-2
	TRZ	CS,EXTF
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTTAB	;AND TAB, OF COURSE
	PUSHJ	PP,SOUTE8	;ABBREVIATION FOR TYPE
	JRST	OUTTAB		;FINAL TAB

SOUTE8:	TLNN	ARG,INTF!EXTF!ENTF!UNDF!NOOUTF
	 POPJ	PP,		;SKIP JUNK FOR SIMPLE STUFF
	SETZ	CS,
	TLNE	ARG,INTF	;INTERNAL
	MOVEI	CS,1
	TLNE	ARG,EXTF	;EXTERNAL
	MOVEI	CS,-1
	TLNE	ARG,ENTF	;ENTRY
	MOVEI	CS,-5
	TLNE	ARG,NOOUTF	;DDT SURPRESSED
	ADDI	CS,3
	TLNE	ARG,UNDF	;UNDEFINED
	MOVEI	CS,-3		;SET FOR UDF
	MOVEI	CS,SOUTC(CS)	;GET ABREVIATION
	JRST	OUTAS0
SOUT1:	MOVE	SX,PAGENO	;GET LAST SYMBOL PAGE NUMBER
	EXCH	SX,SPAGNO	;SWAP WITH OUTPUT PAGE NUMBER
	MOVEM	SX,PAGENO	;AND STORE IT
	MOVE	SX,[BYTE (7) 0,0,<"S">,<"-">,0]
	ANDCAM	SX,DBUF+4	;FIXUP TITLE
SOUT2:	PUSHJ	PP,SGLKUP	;[265] SET FOR TABLE SCAN
	TRNN	ARG,SYMF
	TRNN	ARG,MACF!SYNF
	TDZA	MRP,MRP		;SKIP AND CLEAR MRP
	POPJ	PP,		;NO, TRY AGAIN
	TRNE	ARG,INTF
	MOVEI	MRP,1
	TRNE	ARG,EXTF
	MOVNI	MRP,1		;MRP=-1 FOR EXTERNAL
	TRNE	ARG,SYNF	;SYNONYM?
	JUMPL	MRP,POPOUT	;YES, DON'T OUTPUT IF EXTERNAL
	TRNE	ARG,SUPRBT	;IF SUPRESSED
	POPJ	PP,		;DO NOT OUTPUT
	JUMPGE	MRP,SOUT10	;BRANCH IF NOT EXTERNAL
	HLRZ	RC,V		;PUT POINTER/FLAGS IN RC
	TRNE	RC,-2		;POINTER?
	MOVS	RC,0(RC)	;YES
	HLL	V,RC		;STORE LEFT VALUE

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

SOUT20:	PUSHJ	PP,OUTAS0
	JRST	OUTCR

	<ASCII /ENT/>!04	;DMN
	0
	<ASCII /UDF/>!60	;UNDEFINED EXTERNAL
	<ASCII /SEN/>!44	;SUPRESSED ENTRY
	<ASCII /EXT/>!60
SOUTC:	EXP	10
	<ASCII /INT/>!04
	<ASCII /SEX/>!60	;SUPPRESSED EXTERNAL (NOT USED YET)
	<ASCII /SPD/>!50
	<ASCII /SIN/>!44	;DMN
				;OUTPUT THE BINARY

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

BOUT20:	HRRM	AC1,-1(PP)	;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)
	HRR	AC0,0(RC)	;NO, SET ADDRESS LINK
	MOVE	AC1,LOCO	;GET CURRENT LOCATION
	HRRM	AC1,0(RC)	;SET NEW LINK
	HLRZ	AC1,0(RC)	;GET FLAGS/POINTER
	TRNN	AC1,-2		;POINTER?
	HRR	AC1,RC		;NO, SET TO FLAGS
	HLR	RC,0(AC1)	;PUT FLAGS IN RC
	HRL	AC1,MODO	;GET CURRENT MODE
	TRZE	RC,-2		;LEFT HALF RELOCATABLE+
	TLO	AC1,2		;YES, SET FLAG
	HLLM	AC1,0(AC1)	;STORE NEW FLAGS
BOUT30:	HLLO	CS,AC0
	TLZE	RC,1		;PACK RELOCATION BITS
	TRO	RC,2
	TRNE	RC,2		;LEFT HALF RELOCATABLE?
	TRZ	CS,1		;YES, RESET BIT
	PUSH	PP,AC0		;NEED AN AC
	HLRZ	AC0,-1(PP)	;AC0 = LEFT RELOCATION
	CAILE	AC0,1		;EXTERNAL?
	XORI	CS,EXTF!1	;YES, SET SWITCH
IFN FORMSW,<
	OR	AC0,HWFMT
	JUMPN	AC0,BOUT3H	;EDIT IN HALF WORD FORMAT IF NOT 0
	MOVE	AC0,FORM	;GET FORM WORD
	MOVEI	C,0		;ZERO FIELD SIZE
BOUT3A:	JFFO	AC0,BOUT3B	;AC1 = FIELD SIZE -1
	JRST	BOUT3C		;NO FIELDS LEFT, JUMP
BOUT3B:	LSH	AC0,1(AC1)	;SHIFT OFF FORM FIELD
	MOVEI	AC1,6(AC1)
	IDIVI	AC1,3		;AC1 = COLUMNS USED + 1
	ADDI	C,(AC1)		;INCREMENT FIELD SIZE
	CAIG	C,^D23		;IS FIELD SIZE GTR 23?
	JRST	BOUT3A		;NO.  CONTINUE
	MOVE	AC1,HWFORM	;USE STANDARD FORM
	MOVEM	AC1,FORM
	MOVEI	C,^D13		;SET FIELD SIZE TO 13
BOUT3C:	MOVEM	C,FLDSIZ	;STORE FIELD SIZE
	MOVE	AC0,FORM	;AC0 = FORM WORD
	TRNN	RC,2		;IS LEFT HALF RELOCATED?
	CAMN	AC0,HWFORM	;NO.  IS FORM HALF WORD?
	JRST	BOUT3H		;YES.  EDIT IN OLD WAY
	IBP	TABP
	CAIL	C,^D16
	IBP	TABP
	ILDB	C,TABP		;GET A TAB
	PUSHJ	PP,OUTL		;OUTPUT IT
	MOVE	AC2,(PP)	;AC2 = INFO TO BE EDITED
	PUSH	PP,CS		;SAVE CS = C+1
BOUT3D:	JFFO	AC0,BOUT3E	;AC1 = FIELD LENGTH - 1
BOUT3E:	LSH	AC0,1(AC1)	;SHIFT OFF FORM FIELD
	MOVEI	C,3(AC1)
	MOVEI	AC1,0
	LSHC	AC1,-2(C)	;AC1 = FIELD INFO
	IDIVI	C,3		;C = # OF OCTAL DIGITS
	MOVE	C+1,AC0		;SAVE AC0
	SKIPE	IOSEEN		;IS THIS A I/O INST.
	PUSHJ	PP,BOUT3J	;YES,SET FIELDS CORRECTLY
	MOVNS	C
	ROT	AC1,(C)
	ROT	AC1,(C)
	ROT	AC1,(C)
	MOVNS	C
BOUT3F:	MOVEI	AC0,6		;EDIT A DIGIT
	LSHC	AC0,3
	EXCH	AC0,C
	PUSHJ	PP,OUTC		;OUTPUT IT
	MOVE	C,AC0
	SOJG	C,BOUT3F	;IF MORE DIGITS,  GO BACK
	JUMPE	C+1,BOUT3G	;JUMP IF END OF WORD
	MOVE	AC0,C+1		;RESTORE AC0
	MOVEI	C," "
	PUSHJ	PP,OUTC		;OUTPUT A SPACE
	JRST	BOUT3D		;PROCESS NEXT FIELD

BOUT3G:	POP	PP,CS		;RESTORE CS = C+1
	MOVEI	C," "
	TRNE	RC,1		;RELOCATABLE?
	MOVEI	C,"'"		;YES
	HRRZ	AC0,-1(PP)	;AC0 = RIGHT RELOCATION
	CAILE	AC0,1		;EXTERNAL?
	MOVEI	C,"*"		;YES
	PUSHJ	PP,ONC2		;STORE POSSIBLE INDICATOR
	POP	PP,AC0
	JRST	BOUT3I		;CONTINUE

BOUT3H:	MOVEI	C,^D15		;SET SIZE TO 15
	MOVEM	C,FLDSIZ	;[116]
	SETZM	IOSEEN		;CLEAR INCASE HWFMT WAS SET
>
	POP	PP,AC0		;RESTORE
	PUSHJ	PP,ONC
	HRLO	CS,AC0
	TDZ	CS,RC		;SET RELOCATION
	HRRZ	C,(PP)		;C = RIGHT RELOCATION
	CAILE	C,1		;EXTERNAL
	XORI	CS,EXTF!1	;YES, SET SWITCH
	PUSHJ	PP,ONC
BOUT3I:	POP	PP,CS		;GET RID OF ENTRY ON STACK
	HRRZ	CS,LOCO
	TLNE	FR,RIMSW!RIM1SW!R1BSW	;RIM OUTPUT?
	JRST	ROUT		;YES, GO PROCESS

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

BOUT40:	PUSHJ	PP,COUT		;EMIT CODE
	POP	PP,RC		;RETRIEVE EXTERNAL BITS
	TRNN	RC,-2		;RIGHT EXTERNAL?
	JRST	BOUT50		;TRY FOR LEFT
	PUSHJ	PP,COUTD
	PUSH	PP,BLKTYP	;TERMINATE TYPE AND SAVE
	MOVEI	AC0,2		;BLOCK TYPE 2
	MOVEM	AC0,BLKTYP
	MOVE	AC0,1(RC)	;GET SYMBOL
	MOVEI	ARG,60		;CODE BITS
	PUSHJ	PP,SQOZE	;CONVERT TO RADIX 50
	HLLZS	RC		;SYMBOL HAS NO RELOCATION
	PUSHJ	PP,COUT		;EMIT
	MOVE	AC0,LOCO	;GET CURRENT LOC
	HRLI	AC0,400000	;ADDITIVE REQ
	HRR	RC,MODO		;CURRENT MODE
	PUSHJ	PP,COUT		;EMIT
	MOVSS	RC		;NOW FOR LEFT
	TRNN	RC,-2
	JRST	BOUT60
	JRST	BOUT70
BOUT50:	MOVSS	RC		;CHECK OTHER HALF
	TRNN	RC,-2		;LEFT HALF EXTERNAL?
	JRST	BOUT80		;NO, FALSE ALARM
	PUSHJ	PP,COUTD	;CHANGE MODE
	PUSH	PP,BLKTYP
	MOVEI	AC0,2
	MOVEM	AC0,BLKTYP
BOUT70:	MOVE	AC0,1(RC)
	MOVEI	ARG,60
	PUSHJ	PP,SQOZE
	HLLZS	RC
	PUSHJ	PP,COUT
	MOVE	AC0,LOCO
	HRLI	AC0,600000	;LEFT HALF ADD
	HRR	RC,MODO
	PUSHJ	PP,COUT		;EMIT
BOUT60:	PUSHJ	PP,COUTD	;CHANGE MODE
	POP	PP,BLKTYP	;TO OLD ONE
BOUT80:	AOS	LOCO
	AOS	MODLOC
	POPJ	PP,
IFN FORMSW,<
BOUT3J:	MOVSS	IOSEEN		;SWAP
	SKIPGE	IOSEEN		;SKIP IF NOT FIRST FIELD
	JRST	[HLLZS IOSEEN		;CLEAR RIGHT HALF
		POPJ	PP,]		;AND RETURN
	MOVSS	IOSEEN		;SWAP BACK
	LSH	AC1,2		;CORRECT  MNEMONIC AND OP CODE
	CAIE	C,1		;IS IT OP CODE?
	POPJ	PP,		;NO,JUST RETURN
	MOVEI	C,2		;TWO CHAR. WIDE NOW
	SETZM	IOSEEN		;DON'T COME AGAIN
	POPJ	PP,		;RETURN
>
NOUT:	MOVE	V,[POINT 7,TBUF]	;POINTER TO ASCII LINE
	MOVSI	CS,(POINT 6,AC0)	;POINTER TO SIXBIT AC0
	SETZB	ARG,AC0
NOUT1:	ILDB	C,V		;GET ASCII
	CAIL	C,"A"+40
	CAILE	C,"Z"+40
	JRST	.+2
	TRZA	C,100		;LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIXBIT
	JUMPLE	C,NOUT3		;TEST FORM NON-SIXBIT
	CAILE	C,77		;AND NOT GREATER THAN SIXBIT
	JRST	NOUT3		;...
	IDPB	C,CS		;DEPOSIT IN AC0
	TLNE	CS,770000	;TEST FOR SIX CHARACTERS
	JRST	NOUT1		;NO, GET ANOTHER
NOUT3:	SKIPGE	UNIVSN		;IF A UNIVERSAL PROG
	POPJ	PP,		;RETURN TO PUT IT IN THE TABLE

IFN CCLSW,<SKIPN TBUF+1		;AND IF WE HAVE NOT SEEN A TITLE
	PUSHJ	PP,PRNAM	;THEN PRINT THE NAME>
	PUSHJ	PP,NOUT2	;[214] DUMP NAME
	MOVSI	AC0,11		;[214] TYPE MARKER
	IOR	AC0,CPUTYP	;[235] CPU  TYPE
	PJRST	COUT		;[214] DUMP AND EXIT

NOUT2:	PUSHJ	PP,SQOZE	;CONVERT TO SIXBIT
	JRST	COUT		;DUMP AND EXIT

HOUT:
IFN POLISH,<
	SETZ	AC0,		;[265] FORCE TO PSECT 0
	SKIPE	SGNMAX		;[265] NO PSECTS
	PUSHJ	PP,SGOUTN	;[265] PUT IT OUT
>
	MOVEI	RC,1		;RELOCATABLE
	MOVE	AC0,HHIGH	;GET HIGH SEG IF TWO SEGMENTS
	JUMPE	AC0,.+2		;NOT TWO SEGMENTS
	PUSHJ	PP,COUT		;OUTPUT IT 
	MOVE	AC0,SGATTR	;[265]
	SKIPE	HHIGH		;ANY TWOSEG HIGH STUFF
	JRST	COUT		;YES,SO NO ABS.
	PUSHJ	PP,COUT		;OUTPUT THE HIGHEST LOCATION
	MOVE	AC0,ABSHI
				;PUT OUT ABS PORTION OF PROGRAM BREAK
	SOJA	RC,COUT		;OUTPUT A WORD OF ZERO AND EXIT

IFN POLISH,<			;[164]
;HERE TO OUTPUT BLOCK TYPE 11
POUT:	SKIPN	POLIST		;ANY POLISH TO OUTPUT?
	POPJ	PP,		;NO
	TLO	FR,POLSW	;SET FLAG
	PUSHJ	PP,COUTD	;DUMP BUFFER UNLESS EMPTY
	MOVE	CS,@POLIST	;GET A BLOCK POINTER
	EXCH	CS,POLIST	;SET FOR NEXT TIME
POUTA:	ADDI	CS,1		;FIRST WORD
	MOVE	AC0,(CS)	;GET SOMETHING
	SETZ	RC,		;CLEAR RELOCATION
	JUMPL	AC0,POUTOP	;THIS IS AN OPERATOR
	PUSHJ	PP,PCOUT	;STORE THIS HALF WORD
	JUMPE	AC0,POUT0	;18 BIT VALUE
	SOJE	AC0,POUT1	;36 BIT VALUE
	HLRZ	AC0,1(CS)	;GET HALF OF SYMBOL
	PUSHJ	PP,PCOUT
	HRRZ	AC0,1(CS)	;GET OTHER HALF
	PUSHJ	PP,PCOUT
	AOJA	CS,POUTA

POUT0:	HLRZ	RC,1(CS)	;GET RELOCATION
	HRRZ	AC0,1(CS)	;AND VALUE
	PUSHJ	PP,PCOUT
	AOJA	CS,POUTA	;GET NEXT

POUT1:	HLRZ	RC,1(CS)	;GET LEFT HALF
	HLRZ	AC0,2(CS)
	PUSHJ	PP,PCOUT
	HRRZ	RC,1(CS)	;RIGHT HALF
	HRRZ	AC0,2(CS)
	PUSHJ	PP,PCOUT
	ADDI	CS,2		;SKIP OVER 2 WORDS
	JRST	POUTA

POUTOP:	HRRZ	AC0,AC0		;GET OPERATOR ONLY
	PUSHJ	PP,PCOUT	;OUTPUT
	CAIGE	AC0,-6		;[265] CHECK FOR STORE OP
	JRST	POUTA		;ITS NOT
	CAIGE	AC0,-3		;CHECK FOR SYMBOL FIXUP
	JRST	POUTSY		;IT IS
	HLRZ	RC,1(CS)	;GET RELOCATION
	HRRZ	AC0,1(CS)	;AND STORE ADDRESS
POUTOQ:	PUSHJ	PP,PCOUT
	TLZ	FR,POLSW	;CLEAR FLAG INCASE END
	JRST	POUT		;SEE IF MORE TO GO

POUTSY:	HLRZ	AC0,1(CS)	;GET LHS SYMBOL
	SETZ	RC,		;NO RELOCATION
	PUSHJ	PP,PCOUT	;OUTPUT IT
	HRRZ	AC0,1(CS)	;GET RHS
	PUSHJ	PP,COUT
	JFFO	PP,POUTOQ	;FOLLOW WITH 0 FOR BLOCK LEVEL (FAIL COMPATIBLE)

PCOUT:	MOVE	C,COUTP		;GET POINTER
	TLNE	C,010000	;LEFT OR RIGHT HALF?
	JRST	PCOUTR		;JUST THE RIGHT HALF
	AOS	C,COUTX		;INCREMENT INDEX
	HRLZM	AC0,COUTDB(C)	;STORE LEFT HALF
	IDPB	RC,COUTP	;AND RELOCATION
	POPJ	PP,

PCOUTR:	MOVE	C,COUTX		;GET CURRENT INDEX
	HRRM	AC0,COUTDB(C)	;STORE RIGHT HALF
	IDPB	RC,COUTP	;AND RELOCATION
	CAIE	C,^D17		;IS THE BUFFER FULL
	POPJ	PP,		;NO
	JRST	COUTD		;YES, DUMP IT

;HERE TO OUTPUT BLOCK TYPE 22 - PSECT NAME
SGOUTN:	PUSHJ	PP,COUTD	;FINISH OFF CURRENT BLOCK
	PUSH	PP,BLKTYP	;SAVE CURRENT BLOCK TYPE
	MOVEI	AC0,22		;BLOCK TYPE 22 IS A
	MOVEM	AC0,BLKTYP	; PSECT NAME
	MOVE	C,SGNCUR	;GET CUR PSECT INX
	MOVE	AC0,SGNAME(C)	;GET PSECT NAME
	SETZ	RC,		;CLEAR RELOCATION
	PUSHJ	PP,COUT		;OUTPUT THE BLOCK
	MOVE	C,SGNCUR	;INDEX AGAIN
	HRRZ	AC0,SGORIG(C)	;GET ORIGIN IF SPECIFIED
	SKIPE	AC0		;NOT
	PUSHJ	PP,COUT
	PUSHJ	PP,COUTD	;FINISH IT OFF
	POP	PP,BLKTYP	;RESTORE CURRENT BLOCK TYPE
	POPJ	PP,		;RETURN

;HERE TO OUTPUT BLOCK TYPE 23 - PSECT LENGTH AND ATTRIBUTES
SGOUTL:	PUSHJ	PP,COUTD	;FINISH OFF CURRENT BLOCK
	PUSH	PP,BLKTYP	;SAVE CURRENT BLOCK TYPE
	MOVEI	AC0,23		;BLOCK TYPE 23 IS A
	MOVEM	AC0,BLKTYP	; PSECT LENGTH
	MOVE	RC,SGNCUR	;GET CUR PSECT INX
	MOVE	AC0,SGNAME(RC)	;GET PSECT NAME
	SETZ	RC,		;CLEAR RELOCATION
	PUSHJ	PP,COUT		;OUTPUT THE NAME
	MOVE	RC,SGNCUR	;GET CUR PSECT INX
	MOVE	AC0,SGATTR(RC)	;GET PSECT LENGTH AND ATTRS
	MOVEI	RC,1		;BREAK IS RELOCATED
	PUSHJ	PP,COUT		;OUTPUT THE LENGTH AND ATTRS
	PUSHJ	PP,COUTD	;FINISH IT OFF
	POP	PP,BLKTYP	;RESTORE CURRENT BLOCK TYPE
	POPJ	PP,		;RETURN
>
HSOUT:	SETZM	HISNSW		;CLEAR FOR PASS2
	MOVE	AC0,SVTYP3	;GET HISEG ARG
	JUMPGE	AC0,.+4		;JUMP IF ONLY HISEG
	HRL	AC0,HIGH1	;GET BREAK FROM PASS 1
	JUMPL	AC0,.+2		;OK IF GREATER THAN 400000
	HRLS	AC0		;SIGNAL TWO SEGMENT TO LOADER
	MOVEI	RC,1		;ASSUME RELOCATABLE
	JRST	COUT		;OUTPUT THE WORD

VOUT:	SKIPN	RC,VECREL	;IS VECTOR ABSOLUTE ZERO?
	SKIPE	VECTOR		;ALSO CHECK RELOCATION
	JRST	.+3		;[244]
	SKIPN	VECSYM		;[244] SEE IF SYMBOLIC
	POPJ	PP,		;YES, EXIT
IFN POLISH,<
	MOVE	AC0,VECFND	;GET START ADR PSECT INX
	MOVEM	AC0,SGNCUR	;POINT CUR PSECT THERE
	SKIPE	SGNMAX		;IF PSECTS WERE USED
	PUSHJ	PP,SGOUTN	; THEN PUT OUT PSECT BLOCK
	MOVE	RC,VECREL>	;GET RELOCATION
	MOVE	AC0,VECTOR	;AC0 SHOULD BE FLAGS
	SKIPN	VECSYM		;[244] 2 WORDS IF SYMBOLIC
	JRST	COUT
	PUSHJ	PP,COUT		;OUTPUT CONSTANT
	MOVE	AC0,VECSYM	;[244] GET SYMBOL
	MOVEI	ARG,60		;[210] MAKE REQUEST
	PUSHJ	PP,SQOZE	;[210] IN RADIX-50
	SETZ	RC,		;[240]

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
COUTT:				;[232] ENTER FROM .TEXT PSEUDO-OP
	PUSHJ	PP,OUTBIN	;OUTPUT COUNT AND TYPE
	SETOB	C,COUTY		;INITIALIZE INDEX

COUTD2:	MOVE	C,COUTDB(C)	;GET RELOCATION BITS/CODE
	CAMN	SDEL,[XWD 440000,0]	;[331] IF .TEXT, ONLY OUTPUT THE RELOCATION
	TRZN	C,1		;[331]  WORD IF IT HAS DATA OR IS NEEDED
				;[331]  FOR A NULL STRING TERMINATOR
	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
IFN POLISH,<
	HRRZ	C,BLKTYP	;[164] IF WE ARE OUTPUTING
	CAIN	C,11		;[164] POLISH BLOCK TYPE 11
	SKIPA	C,[POINT 1,COUTRB]	;[164] USE HALF WORDS
>
	MOVE	C,[POINT 2,COUTRB]
	MOVEM	C,COUTP		;INITIALIZE BIT POINTER
	POPJ	PP,		;EXIT
STOWZ1:
IFN FORMSW,<	MOVE	AC1,HWFORM	;USE STANDARD FORM>
STOWZ:	MOVEI	RC,0
STOW:
IFN FORMSW,<	MOVEM	AC1,FORM	;STORE FORM WORD>
IFN TSTCD,<
	SKIPE	TCDFLG		;[414]TESTING NEW LINK CODES?
	JRST	STOWTC		;[414]YES.
	> ; NFI TSTCD		;[414]
	JUMP1	STOW20		;SKIP TEST IF PASS ONE
	TRNE	RC,-2		;RIGHT HALF ZERO OR 1?
	PUSHJ	PP,STOWT	;NO, HANDLE EXTERNAL
	TLNN	RC,-2		;LEFT HALF ZERO OR 1? WFW
	JRST	STOW10		;YES, SKIP TEST
	MOVSS	RC		;SWAP HALVES
	PUSHJ	PP,STOWT1	;HANDLE EXTERNAL WFW
	MOVSS	RC		;RESTORE VALUES

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

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

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

DSTOW:	AOS	AC1,STPY	;INCREMENT POINTER
	MOVE	AC0,STCODE(AC1)	;FETCH CODE
	MOVE	RC,STOWRC(AC1)	;FETCH RELOCATION BITS
IFN FORMSW,<
	PUSH	PP,STFORM(AC1)
	POP	PP,FORM		;GET FORM WORD
>
	CAMGE	AC1,STPX	;IS THIS THE END?
	POPJ	PP,		;NO, EXIT

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

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

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

	;EXTERNAL LEFT
STOWT1:	HLRZ	AC1,EXTPNT	;GET LEFT HALF
	CAIE	AC1,(RC)	;SEE ABOVE
	PUSHJ	PP,QEXT
	HRRZS	EXTPNT
	POPJ	PP,		;EXIT

IFN TSTCD,<
STOWTC:	SKIPE	RC		;[414]RELOCATABLE OR EXTERNAL?
	PUSHJ	PP,QEXT		;[414]YES,FLAG ERROR
	JUMP1	CPOPJ		;[414]IF PASS 1, RETURN
	MOVE	C,AC0		;[414]GET VALUE
	JRST	OUTBIN		;[414]DEPOSIT INTO REL FILE AND RETURN
> ; NFI TSTCD
ONC:	ILDB	C,TABP		;ENTRY TO ADVANCE TAB POINTER
	PUSHJ	PP,OUTL		;OUTPUT A TAB
				;OUTPUT 6 OCT NUMBERS FROM CS LEFT
ONC1:	MOVEI	C,6		;CONVERT TO ASCII
	LSHC	C,3		;SHIFT IN OCTAL
	PUSHJ	PP,OUTL		;OUTPUT ASCII FROM C
	TRNE	CS,-1		;ARE WE THROUGH?
	JRST	ONC1		;NO, GET ANOTHER
	MOVEI	C,0		;CLEAR C
	TLNN	CS,1		;RELOCATABLE?
	MOVEI	C,"'"		;YES
	TLNN	CS,EXTF		;OR EXTERNAL
	MOVEI	C,"*"		;YES
ONC2:	JUMPN	C,OUTC		;OUTPUT IF EXTERN OR RELOCATABLE
IFN FORMSW,<	SOS	FLDSIZ	;DECREMENT FIELD SIZE>
	POPJ	PP,		;EXIT

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

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

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

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

	;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE

LOOKUP:	POP	PP,LOOKX	;INTERCEPT RETURN POP
	MOVE	SX,SYMBOL
IFE POLISH,<
	MOVE	SDEL,0(SX)	;SET FOR TABLE SCAN
LOOKL:	SOJL	SDEL,POPOUT	;TEST FOR END
>
IFN POLISH,<
	PUSH	PP,0(SX)	;SET FOR TABLE SCAN
LOOKL:	SOSGE	0(PP)		;TEST FOR END
	JRST	LOOKXT		;DONE, EXIT
>
	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

IFE POLISH,<SYN LOOKUP,SGLKUP>
IFN POLISH,<
LOOKXT:	POP	PP,AC0		;THROW AWAY COUNTER
	POPJ	PP,
SGLKUP:	POP	PP,LOOKX	;INTERCEPT RETURN POP
	MOVE	SX,SGNCUR	;GET CUR PSECT INX
	PUSH	PP,SGSCNT(SX)	;SAVE SYM CNT
	HRRZS	0(PP)		;DON'T WANT LEFT HALF
	MOVE	SX,SGSBOT	;GET INIT SYM TAB PTR
	JRST	LOOKL		;REST IS SAME AS FOR FULL CASE
>
END0:
IFN FT.U01,<
	MOVE	V,[IOWD $USRLN,$USSTK] ; RESET USER STACK
	MOVEM	V,$USRPD	; SO DO IT
>; END OF FT.U01
IFN POLISH,<
	HRROS	SGNCUR		;[265] FORCE EVALUATION IN ITS OWN PSECT
>
	PUSHJ	PP,EVALCM	;GET A WORD
IFN POLISH,<
	HRRZS	SGNCUR		;[265] BACK TO NORMAL
>
	SKIPN	V,AC0		;NON-ZERO?
	JUMPE	RC,.+2		;OR RELOC?
	PUSHJ	PP,ASSIG7	;YES, LIST THE VALUE
	SETZM	VECSYM		;[240] INCASE NOT SYMBOLIC
	SKIPN	EXTPNT		;[210] EXTERNAL?
	JRST	END00		;[210] NO
	CAME	RC,EXTPNT	;[210] MAKE SURE SAME
	JRST	[SETZB	AC0,VECSYM	;[244] NO, CLEAR
		TRO	ER,ERRE		;[210] FLAG ERROR
		JRST	.+3]		;[244]
	MOVE	RC,1(RC)	;[244] GET SIXBIT NAME
	MOVEM	RC,VECSYM	;[244] STORE SYMBOL NAME
	SETZB	RC,EXTPNT	;[210] AND CLEAR RELOC
END00:	MOVEM	AC0,VECTOR
	MOVEM	RC,VECREL
IFN POLISH,<
	MOVE	AC1,SGWFND	;[265] GET START ADR PSECT INX
	MOVEM	AC1,VECFND	;[265] SAVE IT
>
	PUSHJ	PP,STOUTS	;DUMP THE LINE
END01:	SETZ	MRP,		;[223] SHOULDN'T BE IN A MACRO BY NOW
IFN POLISH,<
	MOVE	AC1,SGNMAX	;[265] GET HIGHEST PSECT USED
	PUSH	PP,AC1		;[265] SAVE IT
END02:	CAME	AC1,SGNCUR	;[265] IF NOT CURRENT
	PUSHJ	PP,%SWSEG	;[265] SWAP IT
>
	PUSHJ	PP,VARA		;FILL OUT SELF-DEFINED VARIABLES
IFE IIISW,<PUSH	PP,IO		;SAVE FLAGS
	TLO	IO,IOPROG	;XLIST LITS>
	PUSHJ	PP,LIT1
IFE IIISW,<POP	PP,IO		;GET FLAG BACK>
IFN POLISH,<
	SOSL	AC1,0(PP)	;[265] DONE YET?
	JRST	END02		;[265] NO
	POP	PP,AC1		;[265] GET JUNK OFF STACK
>
	JUMP2	ENDP2

	MOVE	HHIGH		;GET HIGH SEG BREAK
	MOVEM	HIGH1		;SAVE FOR TWOSEG/HISEG BLOCK TYPE 3
	PUSHJ	PP,UOUT
	TLNN	IO,MFLSW	;SKIP IF ONLY PSEND
	PUSHJ	PP,REC2
	MOVE	INDIR		;SET UP FIRST AS LAST
	MOVEM	LSTFIL		;PRINTED
	SETZM	LSTPGN
	PUSHJ	PP,INZ1		;[234]
	TLNE	IO,MFLSW	;IF PSEND
	POPJ	PP,		;BACK TO PSEND0
	SKIPE	PRGPTR		;HAVE ANY PRGEND'S BEEN SEEN
	PUSHJ	PP,PSEND3	;YES,GO SET UP AGAIN

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

IF2,<	PURGE	$ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>
ENDP2:	PUSHJ	PP,COUTD	;DUMP THE BUFFER
	MOVE	AC0,LOCO	;CHECK TO SEE IF LIT DIFFERED
	SKIPN	MODO		;AND USE SMALLER SINCE AT END
	JRST	[CAMN	AC0,ABSHI
		HRRZM	AC2,ABSHI
		JRST	ENDP2W]
	SKIPE	HHIGH		;SKIP IF NOT TWO SEGMENTS
	JRST	[CAMN	AC0,HHIGH
		HRRZM	AC2,HHIGH
		JRST	ENDP2W]
	CAMN	AC0,HIGH
	HRRZM	AC2,HIGH
ENDP2W:
IFN POLISH,<
	MOVE	AC1,SGNCUR
	CAMN	AC0,HIGH
	HRRM	AC2,SGATTR(AC1)
>
REPEAT 1,<TLNE	IO,IOCREF	;CLOSE CREF IF NECESSARY>
REPEAT 0,<TLNE	FR,CREFSW	;IF CREFFING
	JRST	ENDP2Q
	MOVEI	SDEL,0
	PUSH	PP,DBUF+3	;SO NO PAGE INFO
	DPB	SDEL,[POINT 7,DBUF+3,13]
	IOR	ER,OUTSW	;MAKE SURE OF OUTPUT
	PUSHJ	PP,CREF
	MOVEI	C,20		;CODE FOR TITLE
	PUSHJ	PP,OUTLST
	PUSH	PP,IO		;SAVE THIS
	TLZ	IO,IOPAGE	;AND PREVENT PAGE DURING TITLE
	MOVEI	CS,TBUF
	PUSHJ	PP,OUTAS0
	MOVEI	CS,VBUF
	PUSHJ	PP,OUTAS0
	POP	PP,IO		;RESTORE THE IO WORD
	POP	PP,DBUF+3>	;NEEDS FIX TO CREF
	PUSHJ	PP,CLSCR2	;CLOSE IT UP
ENDP2Q:	HRR	ER,OUTSW	;SET OUTPUT SWITCH
	SKIPN	TYPERR
	TRO	ER,TTYSW
	PUSHJ	PP,UOUT		;OUTPUT UNDEFINEDS
	TRO	ER,TTYSW
	OUTPUT	CTL,		;CLEAR JUNK OUT OF BUFFER
	SKPINC	C		;SEE IF WE CAN INPUT A CHAR.
	  JFCL			;BUT ONLY TO DEFEAT ^O
	SKIPG	C,QERRS		;ANY Q ERRORS SEEN?
	JRST	ENDPER		;NO, TRY REAL ERRORS
	PUSHJ	PP,OUTCR	;NEW LINE
	MOVEI	C,"%"		;WARNING CHARACTER
	PUSHJ	PP,OUTL
	MOVE	C,QERRS		;GET COUNT
	CAIN	C,1		;1 IS SPECIAL
	JRST	ONERQ
	PUSHJ	PP,DNC		;OUTPUT IT
	SKIPA	CS,[EXP ERRMQ2]
ONERQ:	MOVEI	CS,ERRMQ1
	PUSHJ	PP,OUTSIX
ENDPER:	SKIPG	C,ERRCNT	;GET ERROR COUNT AND CHECK FOR POSITIVE
	JRST	NOERW		;PRINT NO ERROR MESSAGE
IFN CCLSW,<ADDM C,.JBERR	;REMEMBER ERROR COUNT FOR EXECUTION DELETION>
	PUSHJ	PP,OUTCR
	MOVEI	C,"?"		;? FOR BATCH
	PUSHJ	PP,OUTL		;...
	MOVE	C,ERRCNT	;PRINT NUMBER OF ERRORS
	CAIN	C,1		;1 IS A SPECIAL CASE
	JRST	 ONERW		;PRINT MESSAGE
	PUSHJ	PP,DNC
	SKIPA	CS,[EXP ERRMS1]	;LOAD TO PRINT
ONERW:	MOVEI	CS,ERRMS2	;ONE ERROR DETECTED
ONERW1:	PUSHJ	PP,OUTSIX	;PRINT
	JRST	ENDP2A

NOERW:	SKIPE	QERRS		;IF "Q" ERRORS
	PUSHJ	PP,OUTCR	;CLOSE LINE NOW
	MOVEI	CS,ERRMS3
IFN CCLSW,<TLNE IO,CRPGSW!MFLSW	;IF RPG, DON'T PRINT MESSAGE>
IFE CCLSW,<TLNE	IO,MFLSW	;NOR IF MULTI-FILE MODE>
	TRZ	ER,TTYSW	;NO TTY OUTPUT
	IOR	ER,OUTSW	;UNLESS NEEDED FOR LISTING
	SKIPN	QERRS		;ALREADY DONE
	PUSHJ	PP,OUTCR
	JRST	ONERW1

ENDP2A:	PUSHJ	PP,OUTCR
	TLNN	IO,MFLSW	;IN A MULTI-PROG FILE?
	JRST	ENDP2D		;NO
	SKIPN	QERRS		;ANY WARNINGS?
	SKIPE	ERRCNT		;ANY ERROR?
	PUSHJ	PP,[MOVEI CS,[ASCIZ /PROGRAM	/]
		PUSHJ PP,OUTAS0		;YES,SO PRINT MESSAGE
		MOVEI	CS,TBUF		;AND TITLE
		PUSHJ PP,OUTAS0		;FOR IDENTIFICATION
		JRST	OUTCR]		;AND A CR-LF
	TRZA	ER,TTYSW	;NO MORE OUTPUT NOW
ENDP2D:
IFN CCLSW,<TLNE IO,CRPGSW	;IF RPG, DON'T PRINT PGM BREAK
	TRZ	ER,TTYSW	;...>
IFE CCLSW,<	SKIPA		;SO PRGEND CODE CAN WORK>
	IOR	ER,OUTSW	;...
	PUSHJ	PP,OUTCR
	MOVEI	CS,[SIXBIT /HI-SEG. BREAK IS @/]
	SKIPN	HHIGH		;DON'T PRINT IF ZERO
	JRST	ENDP2C		;IT WAS
	PUSHJ	PP,OUTSIX
	HRLO	CS,HHIGH	;GET THE BREAK
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTCR
ENDP2C:	MOVEI	CS,[SIXBIT /PROGRAM BREAK IS @/]
	PUSHJ	PP,OUTSIX	;OUTPUT PROGRAM BREAK
	HRLO	CS,SGATTR	;GET PROGRAM BREAK
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTCR
IFN POLISH,<
	SKIPN	AC1,SGNMAX	;GET PSECT CNT
	JRST	ENDP2E		;PSECTS NOT USED?
	MOVEI	AC2,1
ENDP2F:	MOVEI	CS,[SIXBIT /PSECT   BREAK IS @/]
	PUSHJ	PP,OUTSIX	;OUTPUT PSECT BREAK
	HRLO	CS,SGATTR(AC2)	;GET PSECT BRK
	PUSHJ	PP,ONC1
	MOVE	CS,[SIXBIT / FOR  /]
	MOVEM	CS,SGLIST
	MOVE	CS,SGNAME(AC2)	;GET PSECT NAME
	MOVEM	CS,SGLIST+1
	MOVSI	CS,SIXBIT/   @  /
	MOVEM	CS,SGLIST+2
	MOVEI	CS,SGLIST
	PUSHJ	PP,OUTSIX
	PUSHJ	PP,OUTCR
	AOS	AC2
	SOJG	AC1,ENDP2F	;LOOP THRU PSECT.S
ENDP2E:>
	HRRZ	CS,ABSHI	;GET ABS. BREAK
	CAIG	CS,140		;ANY ABS. CODE
	JRST	ENDP2B		;NO, SO DON'T PRINT
	MOVEI	CS,[SIXBIT /ABSLUTE BREAK IS @/]
	PUSHJ	PP,OUTSIX
	HRLO	CS,ABSHI
	PUSHJ	PP,ONC1
	PUSHJ	PP,OUTCR
ENDP2B:	MOVEI	CS,[SIXBIT /CPU TIME USED @/]
	PUSHJ	PP,OUTSIX	;[234] PRINT THE TIME IT TOOK TO ASSEMBLE
	SETZ	C,		;[234] SO AS TO GET THE RIGHT TIME
	RUNTIM	C,		;[234] GET THE TIME NOW
	SUB	C,RTIME		;[234] MINUS TIME WHEN STARTED
	IDIVI	C,^D1000	;[234] GET MS.
	PUSH	PP,C+1		;[234] SAVE
	IDIVI	C,^D60		;[234] GET SEC. IN C+1, MIN. IN C
	PUSH	PP,C+1		;[234] SAVE SECONDS
	IDIVI	C,^D60		;[234] GET HOURS IN C, MINS. IN C+1
	PUSH	PP,C+1		;[234] SAVE MINS
	JUMPE	C,NOHOUR	;[234] SKIP IF LESS THAN 1 HOUR
	PUSHJ	PP,DNC		;[234] PRINT HOURS
	MOVEI	C,":"		;[234] SEPARATOR
	PUSHJ	PP,OUTC		;[234]
NOHOUR:	POP	PP,CS		;[234] GET MINS
	PUSHJ	PP,DECPT2	;[234] PRINT THEM
	MOVEI	C,":"		;[234]
	PUSHJ	PP,OUTC		;[234]
	POP	PP,CS		;[234] A LITTLE DIFFERENT FOR MS
	PUSHJ	PP,DECPT2	;[234] PRINT SECONDS
	MOVEI	C,"."		;[234] A POINT FOR MS.
	PUSHJ	PP,OUTC		;[234]
	POP	PP,CS		;[234] GET MS.
	PUSHJ	PP,DECPT3	;[234] PRINT MS.
	PUSHJ	PP,OUTCR	;[234] AND A CRLF
	TLNE	FR,RIMSW!R1BSW	;RIM MODE?
	PUSHJ	PP,RIMFIN	;YES, FINISH IT
IFN CCLSW,<TLNN	IO,CRPGSW!MFLSW	;IF NOT IN CCL MODE>
IFE CCLSW,<TLNN	IO,MFLSW	;NOR IF IN MULTI-FILE MODE>
	TRO	ER,TTYSW	;PRINT SIZE
	PUSHJ	PP,OUTCR
	MOVE	C,.JBREL
IFN TENEX,<
	SUB	C,SYMBOL	;[206] ONLY COUNT WHATS REALLY IN USE
	ADD	C,FREE		;[206] EITHER SYMBOLS OR STORAGE
	LSH	C,-9		;[206] IN PAGES
>
IFE TENEX,<
	LSH	C,-^D10
>
	ADDI	C,1
	PUSHJ	PP,DNC
IFE TENEX,<
	MOVEI	CS,[SIXBIT /K CORE USED@/]
>
IFN TENEX,<
	MOVEI	CS,[SIXBIT /  PAGES USED@/]
>
	PUSHJ	PP,OUTSIX
	PUSHJ	PP,OUTCR	
	HRR	ER,OUTSW
	PUSHJ	PP,OUTSET
	XWD	10,LSOUT	;OUTPUT THE LOCALS (..-10)
IFN POLISH,<
	SETZM	SGNCUR		;SET TO BLANK PSECT
	SKIPN	SGNMAX		;WERE PSECTS USED?
	JRST	ENDP2H		;NO
ENDP2G:	PUSHJ	PP,SRCHI	;SET UP SRCHX,SGSBOT,SGSTOP
	PUSHJ	PP,SGOUTL	;OUTPUT PSECT LENGTH BLOCK
ENDP2H:
>
	PUSHJ	PP,OUTSET
	XWD	2,SOUT		;OUTPUT THE SYMBOLS (BLKTYP-2)
IFN POLISH,<
	AOS	SX,SGNCUR	;INCR PSECT INX
	CAMG	SX,SGNMAX	;LAST PSECT DONE?
	JRST	ENDP2G		;NO, DO NEXT PSECT
	SETZM	SGNCUR		;SET TO BLANK PSECT
	PUSHJ	PP,OUTSET	;[164]
	XWD	11,POUT		;[164] OUTPUT THE POLISH (..-11)
	MOVSI	SX,(POINT 2)	;[164] RESET BYTE COUNT
	HLLM	SX,COUTP	;[164] AFTER END OF POLISH
>
	PUSHJ	PP,OUTSET
	XWD	7,VOUT		;OUTPUT TRANSFER VECTOR (..-7)
	PUSHJ	PP,OUTSET
	XWD	5,HOUT		;OUTPUT HIGHEST RELOCATABLE (..-5)
	PUSHJ	PP,COUTD
	TLNN	IO,MFLSW	;IS IT PRGEND?
	JRST	FINIS		;ALAS, FINISHED
	MOVEI	CS,SBUF		;RESET SBUF POINTER
	HRRM	CS,SUBTTX	;TO SUBTTL
	SETZM	PASS2I		;CLEAR PASS2 VARIABLES
	MOVE	[XWD PASS2I,PASS2I+1]
	PUSH	PP,PAGENO	;SAVE PAGE NUMBER IN CASE PRGEND
	BLT	PASS2Z-1	;BUT NOT ALL OF VARIABLES
	POP	PP,PAGENO	;RESTORE IT
;	JRST	INZ		;RE-INITIALIZE FOR NEXT PROG
				; FALL THROUGH
SUBTTL	PASS INITIALIZE

INZ:	SETZ	C,		;[234] GET CURRENT JOB NUMBER
	RUNTIM	C,		;[234] GET RUNTIME FOR LATER
	MOVEM	C,RTIME		;[234] SAVE
INZ1:	AOS	MODA
	AOS	MODO
IFN POLISH,<
	MOVE	AC1,SGNMAX
	MOVSI	AC0,1
	MOVEM	AC0,SGRELC(AC1)
	SOJGE	AC1,.-1
	MOVE	AC1,SGNMAX	;[265] GET HIGHEST PSECT USED
	PUSH	PP,AC1		;[265] SAVE IT
INZ2:	CAME	AC1,SGNCUR	;[265] IF NOT CURRENT
	PUSHJ	PP,%SWSEG	;[265] SWAP IT
>
	MOVEI	VARHD
	MOVEM	VARHDX
	MOVEI	LITHD
	MOVEM	LITHDX
	PUSHJ	PP,LITI
IFN POLISH,<
	SOSL	AC1,0(PP)	;[265] DONE YET?
	JRST	INZ2		;[265] NO
	POP	PP,AC1		;[265] GET JUNK OFF STACK
>
	SETZM	SEQNO
	HRRI	RX,^D8
	PUSHJ	PP,STOWI
IFN FORMSW,<
	HRRES	HWFMT		;SET DEFAULT VALUE BACK>
	JRST	OUTLI

RCPNTR:	POINT	1,ARG,^L<RELF>-18	;POINT 1,ARG,22
;[234] ROUTINE TO PRINT CPU TIME USED

DECPT3:	MOVEI	C,"0"		;[234] FILL WITH ZERO
	CAIG	CS,^D99		;[234] 3 DIGITS?
	PUSHJ	PP,OUTC		;[234] NO
DECPT2:	MOVEI	C,"0"		;[234] FILL WITH ZERO
	CAIG	CS,^D9		;[234] 2 DIGITS?
	PUSHJ	PP,OUTC		;[234] NO
	MOVE	C,CS		;[234] GET VALUE
	PJRST	DNC		;[234] OUTPUT IN DECIMAL AND RETURN

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	PSEUDO-OP HANDLERS

IFN FT.U01,<	;USER PUSH-DOWN LIST
$PDUSR:	PUSH	PP,AC0		;SAVE INSTR FOR LATER
	PUSHJ	PP,GETSYM	;GET SIXBIT SYMBOL TO PUSH/POP
	 JRST	[TRO	ER,ERRA	;NO SYMBOL--FLAKY STATEMENT
		POP	PP,AC0	;KEEP THE STACK HONEST
		POPJ	PP,]	;GIVE UP WITH ERROR FLAG SET
	PUSHJ	PP,SSRCH	;LOOKUP THE SYMBOL
	 JRST	[TRO	ER,ERRU	;SYMBOL MUST BE DEFINED TO PUSH IT
		POP	PP,AC0	;CLEAR PDL
		POPJ	PP,]	;GIVE UP
	POP	PP,AC0		;RESTORE INSTR
	TLNN	AC0,(1B7)	; POP?
	JRST	$PDUS1		; NOPE, DON'T CHECK FOR UNDERFLOW
	HRRZ	AC1,$USRPD	; GET CURRENT STACK POINTER
	CAIGE	AC1,$USSTK	; IS THE STACK EMPTY?
	JRST	[TRO	ER,ERRA	;YES GIVE AN ERROR
		POPJ	PP,]	; GIVE UP WITH AN ERROR
$PDUS1:	MOVE	AC1,$USRPD	;PICK UP USER PDP
	TLO	AC0,(<AC1>B12)	;PUT LOCATION OF PDP IN INSTR
	HRRI	AC0,V		;SET LOCATION OF DATA
	XCT	AC0		;PUSH/POP THE SYMBOL
	MOVEM	AC1,$USRPD	;SAVE PDP FOR LATER
	TLNE	AC0,(1B7)	;WAS THIS A PUSH?
	 PUSHJ	PP,UPDATE	;NO--RESET VALUE OF SYMBOL
	CAIN	C,','		;ANOTHER SYMBOL COMING?
	 JRST	$PDUSR		;YES--GO HANDLE IT
	POPJ	PP,		;NO--GET NEXT STATEMENT
>;END IFN FT.U01

TAPE0:	PUSHJ	PP,STOUTS	;FINISH THIS LINE
	SETZM	EOFFLG		;[417]CLEAR END OF FILE FLAG
	PUSHJ	PP,PEEK		;[221] LOOK AT NEXT CHARACTER
	CAIE	C,VT		;[221] PRINT IF V TAB
	CAIN	C,FF		;[221] OR FORM FEED
	PUSHJ	PP,STOUTS	;[221]
	TLZ	IO,IORPTC	;[221] CLEAR CHARACTER FROM LOOK-AHEAD
	PUSHJ	PP,OUTLI2	;[221] AND FROM LINE BUFFER
	SKIPE	EOFFLG		;[417]IF EOF SEEN DURING PEEKING
	POPJ	PP,		;[417]DON'T SKIP ANOTHER FILE, ELSE
	JRST	GOTEND		;IGNORE THE REST OF THIS FILE

%NOBIN:	TLZE	FR,PNCHSW	;IS REL FILE OPEN?
	CLOSE	BIN,40		;YES, GET RID OF IT
	POPJ	PP,

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


XALL0:	JUMP1	POPOUT		;IGNORE ON PASS 1
	TLZN	IO,IOSALL	;TURN OFF MACRO SUPPRESS ALL
	JRST	IOSET		;NOT SALL ON SO NOTHING TO WORRY ABOUT
	CAIE	C,EOL		;END OF LINE SEEN?
	JRST	XALL1		;NO
	LDB	C,LBUFP		;GET LAST CHARACTER
	CAIN	C,CR		;UNDER SPECIAL CIRCUMSTANCES IT GETS REMOVED
	JRST	XALL1		;[236] NO, ALL IS WELL
	SOSG	CPL		;ANY ROOM?
	PUSHJ	PP,RSW5		;[254] NO, SEE IF ANY EXCESS IN IT
	MOVEI	C,CR		;NOW FOR TERMINAYOR
	IDPB	C,LBUFP		;WILL GET REMOVED LATER
XALL1:	PUSHJ	PP,IOSET	;[236] FINISH OFF LINE
	TRNN	SX,IOPALL	;[236] WAS IT XALL OR XLIST?
	TLO	IO,IOSALL	;[236] IT WAS XLIST
	POPJ	PP,		;[236]

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

IORSET:	TDZ	IO,AC0		;RESET  FLAG IOPALL/IOPROG
	POPJ	PP,

IOLSET:	JUMP1	POPOUT		;[327] SPECIAL FOR LALL, TO SEE IF IN MACRO UNDER SALL
	TLNE	IO,IOSALL	;[327] SEE IF SALL
	JUMPN	MRP,IOLSE1	;[327] AND IN MACRO
	TDZ	IO,AC0		;[327] NO, CHANGE TO LALL
	POPJ	PP,		;[327] AND RETURN

IOLSE1:	PUSHJ	PP,STOUTS	;[327] LALL UNDER MACRO, CLEAR REST OF LINE
	TLZ	IO,IOSALL!IOPALL	;[327] ****** SET TO LALL
	PUSHJ	PP,OUTIM	;[327] FORCE A CRLF
	POPJ	PP,		;[327] AND RETURN

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

REMAR0:	PUSHJ	PP,GETCHR	;GET A CHARACTER
REMAR1:	CAIE	C,EOL
	JRST	REMAR0
	POPJ	PP,		;EXIT

PAGE0:	PUSHJ	PP,STOUTS	;[161] PAGE PSEUDO-OP

PAGE1:	TLNE	IO,IOCREF	;[161] CURRENTLY DOING CREF?
	TLNE	IO,IOPROG	;[161] AND NOT XLISTED?
	JRST	PAGE2		;[161] NO
	HRR	ER,OUTSW	;[161]
	PUSHJ	PP,CLSCRF	;[161]
	PUSHJ	PP,OUTCR
	HRRI	ER,0		;[161]
PAGE2:	TLO	IO,IOPAGE	;[161]
	POPJ	PP,		;[161]

LIT0:	PUSHJ	PP,BLOCK1
	PUSHJ	PP,STOUTS
LIT1:	JUMP2	LIT20

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

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

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

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

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

	PUSHJ	PP,LOOKUP	;SET FOR TABLE SCAN
	TRZN	ARG,VARF
	POPJ	PP,		;NO, EXIT
	TRZ	ARG,UNDF	;TURN OFF FLAG NOW
	MOVSI	AC0,1(V)	;NUMBER TO ADD TO
	ADDM	AC0,0(AC1)	;UPDATE COUNT
VARA1:	ADDI	V,1		;GET LENGTH OF DESIRED BLOCK
	ADDM	V,LOCO
	EXCH	V,LOCA
	ADDM	V,LOCA
	HRL	ARG,V		;GET STARTING LOCATION AND UPDAT PCS
	IOR	ARG,MODA	;SET TO ASSEMBLY MODE
	MOVSM	ARG,0(SX)	;UPDATE 2ND WRD OF SYM TAB ENTRY
	JRST	HIGHQ1
IF:	PUSH	PP,AC0		;SAVE AC0
	PUSH	PP,IO
	PUSHJ	PP,EVALXQ	;EVALUATE AND TEST EXTERNAL
	POP	PP,AC1
	IORI	ER,(AC1)	;[124] RESTORE PREVIOUS ERROR FLAGS
	JUMPL	AC1,IFPOP
	TLZ	IO,FLDSW
IFPOP:	POP	PP,AC1		;RETRIEVE SKIP INSTRUCTION
IFSET:	TLO	IO,IORPTC	;REPEAT CHARACTER
IFXCT:	XCT	AC1		;EXECUTE INSTRUCTION
IFXF:	TDZA	AC0,AC0		;FALSE
IFXT:	MOVEI	AC0,1		;TRUE
IFEXIT:	SETZM	EXTPNT		;JUST IN CASE
IFN POLISH,<
	TLZ	IO,RSASSW	;[265] ...
>
	JUMPOC	IFDO		;[140] BRANCH IF IN OP-CODE FIELD
IFEX1:	PUSHJ	PP,GETCHR	;SEARCH FOR "<"
	CAIN	C,EOL		;ERROR IF END OF LINE
	JRST	ERRAX
	CAIE	C,'<'
	JRST	IFEX1
	JUMPE	AC0,IFEX2	;TEST FOR 0
	TLO	IO,IORPTC	;NO, PROCESS AS CELL
	PUSHJ	PP,CELL
IFN FORMSW,<MOVE AC1,HWFORM	;USE STANDARD FORM>
	SETZM	INCND		;NOT ANY MORE
	JRST	STOW		;STOW CODE AND EXIT

IFDO:	BYPASS			;[140] GET NEXT NON-3LANK
	CAIN	C,EOL		;[272] AT EOL?
	JRST	 REPEA1		;[272] YES, USE OLD METHOD
	CAIE	C,','		;[260] ARE WE AT THE COMMA?
	CAIN	C,'<'		;[260] OR START OF CONDITIONAL?
	CAIA			;[260] YES
	JRST	IFDO		;[260] NOT YET AT COMMA OR ANGLE BRKT
	CAIN	C,','		;[260] IGNORE THE COMMA
	PUSHJ	PP,BYPAS1	;[140] AND GET SOMETHING ELSE
	TLO	IO,IORPTC	;[140] REPEAT LAST CHAR.
	CAIE	C,'<'		;[140] OLD METHOD USED ANGLES
	CAIN	C,EOL		;[140] ALSO OLD IF NEW LINE SEEN
	JRST	REPEA1		;[140] ASSEMBLE CODE BETWEEN ANGLES
	JUMPLE	AC0,REMAR0	;[140] FALSE, TREAT AS COMMENT
	JRST	STMNT		;[140] TRUE, ASSEMBLE IT

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

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

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

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

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

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


INTER0:	HLLZM	AC0,INTENT	;AC0 CONTAINS INTF/ENTF FLAGS
INTER1:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	INTER3		;INVALID, SKIP
	PUSHJ	PP,SSRCH	;SEARCH THE TABLE
	  MOVSI	ARG,SYMF!INTF!UNDF
	PUSHJ	PP,SUPSYM	;[167] SEE IF "!" SEEN
	TLNN	ARG,UNDF	;ALLOW FORWARD REFERENCE
	TLNN	ARG,SYNF!EXTF
	TDOA	ARG,INTENT	;SET APPROPRIATE FLAGS
INTER3:	TROA	ER,ERRA		;FLAG ARG EROR AND SKIP
	PUSHJ	PP,INSERQ	;INSERT/UPDATE
	JUMPCM	INTER1
	SETZM	EXTPNT		;JUST IN CASE, SO AS NOT TO CONFUSE WORLD
IFN POLISH,<
	TLZ	IO,RSASSW	;[265] ...
>
	POPJ	PP,		;NO, EXIT
;.IF SYMBOL ATTRIBUTE

%IF:	PUSHJ	PP,GETSYM	;[271] GET THE SYMBOL
	  JRST	%IFNUMERIC	;[271] MIGHT WANT THIS ATTRIBUTE
	PUSHJ	PP,SEARCH	;[271] GENERAL SEARCH
	  JRST	IFXF		;[271] FAILED IF NOT IN TABLE
	TLO	IO,IORPTC	;[271] GET FIRST CHAR
	PUSHJ	PP,GETSYM	;[271] GET ATTRIBUTE
	  JRST	ERRAX		;[271] MUST BE A SYMBOL
	SETO	AC1,		;[271] MASK
IFLOOP:	MOVSI	AC2,-IFLEN	;[271] AOBJN PTR
	MOVE	SDEL,IFATAB(AC2);[271] GET NAME
	AND	SDEL,AC1	;[271] MASK
	CAMN	AC0,SDEL	;[271] MATCH
	JRST	IFOUND		;[271] GOT IT
	AOBJN	AC2,IFLOOP+1	;[271] LOOP
	JUMPGE	AC1,ERRAX	;[271] NOT IN TABLE
	TDNN	AC0,AC1		;[271] SET MASK
	JRST	IFLOOP		;[271] SET
	LSH	AC1,-6		;[271] TRY NEXT CHAR
	JUMPN	AC1,.-3		;[271] TRY AGAIN
	HALT			;[271] ?

IFOUND:	XCT	IFJTAB(AC2)	;[274]
	  JRST	IFXF		;[271] FALSE
	JRST	IFXT		;[271] TRUE

DEFINE IFATRIB <
XX	SYMBOL,<TLNN	ARG,SYMF>
XX	SYNONYM,<TLNN	ARG,SYNF>
XX	MACRO,<TLNN	ARG,MACF>
XX	OPDEF,<TLNN	ARG,OPDF>
XX	EXTERNAL
XX	ENTRY,<TLNN	ARG,ENTF>
XX	INTERNAL
XX	GLOBAL
XX	LOCAL
XX	LABEL,<TLNN	ARG,TAGF>
XX	ASSIGNMENT
XX	ABSOLUTE,<TLNE	ARG,LELF!RELF>
XX	RELOCATABLE,<TLNN	ARG,LELF!RELF>
XX	LRELOCATABLE,<TLNN	ARG,LELF>
XX	RRELOCATABLE,<TLNN	ARG,RELF>
XX	NUMERIC,JFCL
>

DEFINE XX (A,B)<
	<SIXBIT /A/>
>
IFATAB:	IFATRIB
IFLEN==.-IFATAB

DEFINE XX (A,B)<
 IFB <B>,<
	PUSHJ	PP,%IF'A
>
 IFNB <B>,<
	B
>>
IFJTAB:	IFATRIB

%IFEXTERNAL:
	TLNE	ARG,EXTF	;[271] ENTERNAL?
	AOS	(PP)		;[271] YES
	POPJ	PP,

%IFINTERNAL:
	TLNN	ARG,EXTF!SPTR	;[271] EXTERN?
	AOS	(PP)
	POPJ	PP,

%IFGLOBAL:
	TLNE	ARG,EXTF!INTF!ENTF
	AOS	(PP)
	POPJ	PP,

%IFLOCAL:
	TLNN	ARG,EXTF!SPTR
	AOS	(PP)
	POPJ	PP,

%IFASSIGNMENT:
	TLNE	ARG,SYMF
	TLNE	ARG,TAGF
	POPJ	PP,
	JRST	CPOPJ1

%IFNUMERIC:
	TLNE	IO,NUMSW	;[271] MUST BE NUMERIC
	PUSHJ	PP,GETSYM	;[271] GET ATTRIBUTE
	  JRST	ERRAX		;[271] ERROR
	SETO	AC1,		;[271] MASK
	TDNN	AC0,AC1		;[271] SET IT UP
	JRST	.+3		;[271] DONE
	LSH	AC1,-6
	JRST	.-3		;[271] TRY AGAIN
	MOVE	SDEL,['NUMERI']	;[271] ONLY VALID ONE
	AND	SDEL,AC1	;[271] MASK OUT ONES WE DON'T CARE ABOUT
	CAMN	AC0,SDEL	;[271] MATCH?
	AOS	(PP)		;[271] TRUE
	POPJ	PP,
;ASSIGN PSEUDO-OP FOR TENEX
;ASSIGN SYM1,SYM2,INCR

ASGN:	PUSHJ	PP,COUTD	;DUMP BUFFER
	PUSH	PP,BLKTYP	;SAVE BLOCK TYPE
	MOVEI	AC0,100		;ASSIGN BLOCK TYPE
	MOVEM	AC0,BLKTYP

	PUSHJ	PP,GETSYM	;HERE TO ASGN6 COPIED FROM EXTERN
	JRST	ASGN2
	TLO	IO,DEFCRS	;FLAG AS DEFINITION
	PUSHJ	PP,SSRCH
	JRST	ASGN1
	TLNN	ARG,EXTF!VARF!UNDF
	JRST	ASGN2
	TLNE	ARG,EXTF
	JRST	[JUMP1	ASGN6
		TLZN	ARG,UNDF
		JRST	ASGN6
		ANDM	ARG,(SX)
		JRST	ASGN1]
ASGN1:	MOVEI	V,2
	ADDB	V,FREE
	CAML	V,SYMBOL
	PUSHJ	PP,XCEEDS
	SUBI	V,2
	SETZB	RC,0(V)
	MOVSI	ARG,SYMF!EXTF
	PUSHJ	PP,INSERT
	MOVSI	ARG,PNTF
	IORM	ARG,0(SX)
	MOVE	AC0,-1(SX)
	MOVEM	AC0,1(V)
ASGN6:	MOVE	AC0,-1(SX)
	SETZ	ARG,
	PUSHJ	PP,SQOZE	;CONVERT TO SQUOZE
	PUSHJ	PP,COUT		;OUTPUT FIRST SYMBOL
	JUMPNC	ASGN2		;MUST BE COMMA HERE
	PUSHJ	PP,GETSYM	;SECOND SYMBOL
	JRST	ASGN2
	MOVEI	SDEL,%SYM	;OUTPUT	TO CREF
	PUSHJ	PP,CREF
	SETZ	ARG,
	PUSHJ	PP,SQOZE	;CONVERT TO SQUOZE
	PUSHJ	PP,COUT
	JUMPNC	ASGN3		;COMMA?
	PUSHJ	PP,EVALXQ	;YES, EVALUATE INCREMENT
ASGN4:	PUSHJ	PP,COUT
	JUMP1	ASGN7		;DON'T OUTPUT IF PASS1
	PUSHJ	PP,COUTD	;OUTPUT 3 WORDS
ASGN5:	POP	PP,BLKTYP	;RESTORE BLOCK TYPE
	POPJ	PP,

ASGN3:	MOVEI	AC0,1		;INCREMENT IS 1 IF NOT SPECIFIED
	JRST	ASGN4

ASGN2:	TRO	ER,ERRE		;INDICATE
ASGN7:	PUSHJ	PP,COUTI	;CLEAR OUTPUT BUFFER
	JRST	ASGN5
EXTER0:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	EXTER4		;INVALID, ERROR
EXTER1:	TLO	IO,DEFCRS	;FLAG THIS AS A DEFINITION
EXTER5:	PUSHJ	PP,SSRCH	;[267] OK, SEARCH SYMBOL TABLE
	JRST	EXTER2		;NOT THERE, INSERT IT
	TLNN	ARG,EXTF!VARF!UNDF
	TROA	ER,ERRE		;FLAG ERROR AND BYPASS
	TLNE	ARG,EXTF	;VALID, ALREADY DEFINED?
	JRST	[JUMP1	EXTER3		;YES, BYPASS
		TLZN	ARG,UNDF	;SKIP IF UNDEFINED ALSO
		JRST	EXTER3		;CONTINUE
		ANDM	ARG,(SX)	;CLEAR UNDF ON PASS 2
		JRST	EXTER2]		;SET UP EXTERNAL NOW
EXTER2:	MOVEI	V,2		;NO, GET 2 CELLS FROM THE TREE
	ADDB	V,FREE
	CAML	V,SYMBOL	;HAVE WE RUN OUT OF CORE?
	PUSHJ	PP,XCEEDS	;YES, TRY TO BORROW SOME MORE
	SUBI	V,2		;GET RIGHT CELL FOR POINTER
	SETZB	RC,0(V)		;ALL SET, ZERO VALUES
	MOVSI	ARG,SYMF!EXTF
	PUSHJ	PP,SUPSYM	;[167] SEE IF "!" SEEN
	PUSHJ	PP,INSERT	;INSERT/UPDATE IT
	MOVSI	ARG,PNTF
	IORM	ARG,0(SX)
	SKIPA	ARG,-1(SX)	;GET THE SIXBIT FOR THE NAME
EXTER4:	TROA	ER,ERRA		;FLAG AS ERROR
	MOVEM	ARG,1(V)	;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS
EXTER3:	PUSHJ	PP,SUPSYM	;[167] SEE IF "!" SEEN
	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:
IFN POLISH,<
	TLNE	FR,POLSW	;[164] ANY POLISH EXTERNAL EXPRESSIONS
	JRST	QPOL		;[164] YES, REMOVE  AND FLAG ERROR
>
	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,

IFN POLISH,<
QPOL:	TRO	ER,ERRE		;[164] FLAG EXTERNAL ERROR
	PUSH	PP,AC1		;[164] GET AN AC
	MOVE	AC1,POLIST	;[164] GET LAST ITEM IN LIST
	MOVEM	AC1,FREE	;[164] RESET FREE CORE POINTER
	MOVE	AC1,(AC1)	;[164] GET PREVIOUS ITEM
	MOVEM	AC1,POLIST	;[164] MAKE IT TOP OF LIST
	POP	PP,AC1		;[164]
	POPJ	PP,		;[164]
>

EVALXQ:	PUSH	PP,IO		;[222] SAVE ERROR STATUS
	TRZ	ER,-1		;[222] START AFRESH
	PUSHJ	PP,EVALQ	;[222] EVALUATE EXPRESSION
	TRNE	ER,ERRU		;[222] TEST FOR UNDEF
	TRO	ER,ERRV		;[222] FLAG "V" ERROR
	HLLM	IO,(PP)		;[222] STORE STATUS FLAGS
	IORM	ER,(PP)		;[222] COMPOUND ERRORS
	POP	PP,IO		;[222] RESTORE THEM
	POPJ	PP,		;[222]

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


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

ASSIG1:	PUSH	PP,AC0		;SAVE SYMBOL
	MOVEM	AC0,INASGN	;[164] INCASE POLISH FIXUP REQUIRED
	SETZB	AC0,EXTPNT	;SPECIAL CHECK FOR == WFW
ASSIG4:	PUSHJ	PP,PEEK		;IS THE NEXT ON =
	CAIE	C,"="
	CAIN	C,"!"
	CAIA			;[406]WANT TO SUPRESS SYMBOL
	JRST	ASSIG5		;[406]NOT "=" OR "!",SO SEE IF COLON
	TLOE	AC0,NOOUTF	;[406]TURN ON "NO-OUTPUT" FLAG
	TRO	ER,ERRQ		;[406]IF ALREADY ON, GIVE ERROR
	PUSHJ	PP,GETCHR	;PROCESS THE CHAR.
	PUSHJ	PP,PEEK		;CHECK FOR ==: DMN
ASSIG5:	CAIE	C,":"		;IS IT
	JRST	ASSIG6		;NO
	TLOE	AC0,INTF	;[406]FLAG AS INTERNAL
	TRO	ER,ERRQ		;[406]IF ALREADY ON, ITS AN ERROR
	PUSHJ	PP,GETCHR	;REPEAT IT
	JRST	ASSIG4		;TRY AGAIN (MIGHT BE =:!)

ASSIG6:	MOVEM	AC0,HDAS	;STORE THESE BITS WFW
	PUSHJ	PP,EVALCM	;EVALUATE EXPRESSION
	SETZM	INASGN		;[164] FINISHED WITH POLISH BY NOW
	EXCH	AC0,0(PP)	;SWAP VALUE FOR SYMBOL
	PUSH	PP,RC
	TRNN	RC,-2		;CHECK EXTERNAL AGREEMENT
	JRST	ASSIG2
	HRRZS	RC
	HRRZ	ARG,EXTPNT
	CAME	RC,ARG
	PUSHJ	PP,QEXT		;EXTERNAL OR RELOCATION ERROR
ASSIG2:	HLRZ	RC,(PP)
	TRNN	RC,-2
	JRST	ASSIG3
	HLRZ	ARG,EXTPNT
	CAME	RC,ARG
	PUSHJ	PP,QEXT
ASSIG3:	TLO	IO,DEFCRS
	PUSH	PP,UNISCH+1	;SAVE SEARCH LIST
	SETZM	UNISCH+1	;BUT DISALLOW
	PUSHJ	PP,SSRCH
	  MOVSI	ARG,SYMF
	POP	PP,UNISCH+1	;RESTORE STATUS
	IOR	ARG,HDAS	;WFW
	TLNE	ARG,UNDF	;WAS IT UNDEFINED
	TLZ	ARG,EXTF!PNTF	;YES,CLEAR EXTF NOW
	TLZ	ARG,UNDF!VARF	;CANCEL UNDEFINED AND VARIABLE FLAGS
	SETZM	EXTPNT		;FOR REST OF WORLD
IFN POLISH,<
	TLZ	IO,RSASSW	;[265] ...
>
	POP	PP,RC
	TRNE	ER,ERRORS-ERRQ
	SETZ	RC,		;CLEAR RELOCATION
	POP	PP,V
	TRNE	ER,ERRU		;WAS VALUE UNDEFINED?
	TLO	ARG,UNDF	;YES,SO TURN UNDF ON
	TLNE	ARG,TAGF!EXTF
	JRST	ERRAX
	JRST	INSERT

;LOC, RELOC, AND ORG COME HERE

%ORG:	PUSH	PP,AC0		;SAVE TYPE
	PUSHJ	PP,HIGHQ	;GET LATEST PC
	BYPASS			;SKIP BLANKS
	TLO	IO,IORPTC	;REPEAT LAST
	CAIN	C,EOL		;USE PREVIOUS VALUE IF NULL ARGUMENT
	JRST	ORG03
	PUSHJ	PP,EVALXQ	;GET EXPRESSION AND TEST EXTERNAL
	SKIPGE	(PP)		;ORG?
	HRLM	RC,(PP)		;YES, SAVE RELOC OF ARG
ORG01:	HRRM	AC0,(PP)	;STORE NEW VALUE
IFE POLISH,<
	HLRZ	AC1,(PP)	;GET MODE
	HRRZ	AC0,LOCO	;PC OF OUTPUT
	CAMN	AC1,MODO	;MODE SAME?
	JRST	[MOVEM AC0,@REL1P(AC1)	;SAVE NEW VALUE
		JRST	ORG02]
	MOVEM	AC0,@ABS1P(AC1)	;SAVE NEW VALUE
ORG02:	MOVE	AC0,MODO	;SAVE OLD MODE
	MOVEM	AC0,ORGMOD
>
IFN POLISH,<
	HRRZ	AC0,LOCO	;PC OF OUTPUT
	MOVE	AC1,MODO	;OLD MODE
	MOVEM	AC0,@REL1P(AC1)	;SAVE OLD VALUE
	MOVE	AC0,MODO	;SAVE OLD MODE
	MOVEM	AC0,ORGMOD
	MOVE	AC1,SGNCUR	;CURRENT PSECT INDEX
	MOVE	AC0,HIGH	;SAVE PSECT BREAK
	HRRM	AC0,SGATTR(AC1)
	HRR	AC0,RELLOC	;SAVE PSECT REL PC
	HRL	AC0,ORGMOD	;SAVE PSECT MODE
	MOVEM	AC0,SGRELC(AC1)
>
	POP	PP,AC0		;GET RESULT
ORG2A:	HLRZM	AC0,MODA	;SET MODES
	HLRZM	AC0,MODO
	HRRZM	AC0,LOCA	;AND LOCATIONS
	HRRZM	AC0,LOCO
	JRST	BLOCK2

ORG03:	HRRZ	AC0,ORGMOD	;GET PREV MODE
	SKIPGE	(PP)		;ORG?
	HRLM	AC0,(PP)	;YES, SAVE IT
	HLRZ	AC1,(PP)	;NEW MODE
	MOVE	AC0,@REL1P(AC1)	;GET PREV VALUE
	JRST	ORG01

REL1P:	EXP	ABSLOC
ABS1P:	EXP	RELLOC
	EXP	ABSLOC
;	.PSECT	NAME /ATTRIB,ORIGIN

IFN POLISH,<
%SEGME:	SKIPN	HISNSW		;CAN'T HAVE PSECTS WITH
	SKIPE	UNIVSN		; HISEG, TWOSEG OR
	JRST	ERRSX		; UNIVERSAL
	MOVE	AC2,SGDMAX	;CHECK IF MAX PSECT
	CAILE	AC2,SGNDEP-1	; NESTING DEPTH EXCEEDED
	JRST	ERRSX		;YES
	PUSHJ	PP,GETSYM	;GET PSECT NAME
	  PUSHJ	PP,[SETZ AC0,		;NONE SPECIFIED, BLANK NAME
		TRZ	ER,ERRA		;UNDO GETSYM'S ERR FLAG
		POPJ	PP,]
	MOVE	AC1,SGNMAX	;GET PSECT COUNT
%SEGM1:	CAMN	AC0,SGNAME(AC1)	;SEEN THIS NAME BEFORE?
	JRST	%SEGM2		;YES
	SOJGE	AC1,%SEGM1	;LOOP THRU KNOWN NAMES
	MOVE	AC1,SGNMAX	;CHECK IF MAX DISTINCT PSECT
	CAILE	AC1,SGNSGS-1	; LIMIT EXCEEDED
	JRST	ERRSX		;YES
	AOS	AC1,SGNMAX	;INCR PSECT COUNT
	MOVEM	AC0,SGNAME(AC1)	;STORE PSECT NAME
	MOVSI	AC2,1		;SET MODE TO RELOC
	MOVEM	AC2,SGRELC(AC1)	; AND PC TO ZERO
	HRRZS	SGORIG		;INCASE NOT GIVEN
%SEGM4:	MOVE	SDEL,SYMBOL	;ROOM TO INIT
	SUBI	SDEL,LENGTH	; SYM TAB
	CAMLE	SDEL,FREE	; FOR NEW PSECT?
	JRST	%SEGM3		;YES
	PUSHJ	PP,XCEEDS	;TRY FOR MORE CORE
	JRST	%SEGM4		;START OVER
%SEGM3:	MOVEM	SDEL,SYMBOL	;NEW SYM TAB BOT
	HRLI	SDEL,LENGTH(SDEL)	;OLD SYM TAB BOT
	MOVE	SX,SYMTOP	;SYM TAB TOP
	BLT	SDEL,-LENGTH(SX)	;MOVE SYM TAB DOWN
	HRLI	SDEL,SYMNUM+1	;PTR TO PERM SYM TAB
	HRRI	SDEL,1-LENGTH(SX)	;PERM SYMS GO HERE
	BLT	SDEL,0(SX)	;MOVE PERM SYMS TO NEW PSECT
	MOVE	AC2,SYMNUM	;PERM SYM CNT
	MOVEM	AC2,SGSCNT(AC1)	;SET SYM CNT
	SETZM	SGATTR(AC1)	;ZERO PSECT BRK AND ATTRS
	ADDM	AC2,@SYMBOL	;ADJUST TOTAL SYM CNT
%SEGM2:	AOS	AC2,SGDMAX	;INCR PSECT DEPTH
	MOVEM	AC0,SGLIST(AC2)	;STORE PSECT NAME
%SEGM5:	CAIE	C,'/'		;ATTRIBUTES SPECIFIED?
	JRST	%SEGM9		;NO, TRY VALUE
	PUSH	PP,AC1		;SAVE PSECT INX
	PUSHJ	PP,GETSYM	;GET ATTRIBUTE
	  JRST	%SEGM8		;TOO BAD
; THE BELOW ATTRIBUTES ARE PAIRED; A CONFLICT IS
; FLAGGED IF BOTH OF ANY PAIR ARE SEEN (CUMMULATIVELY)
	MOVE	AC1,AC0		;ATRIB NAME
	SETO	AC2,		;MASK
	LSH	AC1,6		;SHIFT UP 1 CHAR AT A TIME
	LSH	AC2,6		;SAME FOR MASK
	JUMPN	AC1,.-2		;UNTIL CHAR ALL GONE, MASK LEFT
	MOVSI	AC1,-%SGTLN	;AOBJN WORD
%SEGM6:	CAMN	AC0,%SGTBL(AC1)	;ATTRIBUTE FOUND?
	JRST	%SEGM7		;YES, PROCESS IT
	XOR	AC0,%SGTBL(AC1)	;BUT SEE IF WHAT WE HAVE MATCHES
	TDNN	AC0,AC2		;TRUE IF MASKED BITS ARE 0
	JRST	%SEGM7		;YES, IT MATCHES
	XOR	AC0,%SGTBL(AC1)	;PUT NAME BACK
	AOBJN	AC1,%SEGM6	;NO, CHECK NEXT
	SETZ	AC2,		;CLEAR ATTR FLAG
	TRO	ER,ERRQ		;FLAG WARNING
%SEGM7:	MOVEI	AC2,1		;SET ATRIB BIT
	LSH	AC2,-1(AC1)	; IN AC2
	MOVE	AC1,0(PP)	;GET PSECT INX
	HLRZ	AC0,SGATTR(AC1)	;GET PREV ATTRS
	ANDI	AC0,525252	;SELECT LEFT OPTIONS
	LSH	AC0,-1		;SHIFT THEM RIGHT
	AND	AC0,AC2		;COMPARE NEW AND PREVIOUS
	JUMPE	AC0,.+3		;CONFLICTING ATTRIBUTE?
	TRO	ER,ERRQ		;YES, FLAG WARNING
	SETZ	AC2,		; AND IGNORE IT
	HLRZ	AC0,SGATTR(AC1)	;GET PREV ATTRS
	ANDI	AC0,252525	;SELECT RIGHT OPTIONS
	LSH	AC0,1		;SHIFT THEM LEFT
	AND	AC0,AC2		;COMPARE NEW AND PREVIOUS
	JUMPE	AC0,.+3		;CONFLICTING ATTRIBUTE?
	TRO	ER,ERRQ		;YES, FLAG WARNING
	SETZ	AC2,		; AND IGNORE IT
	HRLZS	AC2		;MOVE TO LEFT HALF
	IORM	AC2,SGATTR(AC1)	;MERGE ATTRIBUTES
%SEGM8:	POP	PP,AC1		;RESTORE PSECT INX
	JUMPCM	%SEGM5		;LOOP IF MORE ATTRS
	JRST	%SWSEG		;SWAP PC AND MODE

%SEGM9:	JUMPNC	%SWSEG		;NO VALUE
	PUSH	PP,AC1		;SAVE INDEX
	PUSHJ	PP,EVALCM	;GET IT
	POP	PP,AC1		;RESTORE INDEX
	HRRM	AC0,SGORIG(AC1)	;STORE IT
	JRST	%SWSEG		;SWAP PC AND MODE

%SGTBL:	<SIXBIT /CONCATENATED/>
	<SIXBIT /OVERLAID/>
	<SIXBIT /RWRITE/>
	<SIXBIT /RONLY/>

%SGTLN==.-%SGTBL
%ENDSE:	SKIPN	HISNSW		;CAN'T HAVE PSECTS WITH
	SKIPE	UNIVSN		; HISEG, TWOSEG OR
	JRST	ERRSX		; UNIVERSAL
	MOVE	AC2,SGDMAX	;IF DEPTH IS ALREADY ZERO
	JUMPE	AC2,ERRSX	; THEN .ENDPS IS ILLEGAL
	PUSHJ	PP,GETSYM	;GET PSECT NAME
	JRST	%ENDS1		;NONE SPECIFIED, IGNORE CHECK
	CAME	AC0,SGLIST(AC2)	;DOES IT MATCH CORRES .PSECT NAME
	TRO	ER,ERRQ		;NO, FLAG WARN AND DO IT ANYWAY
%ENDS1:	TRZ	ER,ERRA		;UNDO GETSYM'S ERR FLAG
	SOS	AC2,SGDMAX	;DECR PSECT DEPTH
	MOVE	AC0,SGLIST(AC2)	;NAME OF PSECT TO RESUME
	MOVE	AC1,SGNMAX	;GET PSECT COUNT
	CAME	AC0,SGNAME(AC1)	;NAME MATCH?
	SOJGE	AC1,.-1		;NO, TRY NEXT

;HERE TO SWAP TO NEW PSECT
;ENTER WITH OLD PSECR IN SGNCUR
;NEW PSECT IN AC1
%SWSEG:	PUSH	PP,AC1		;SAVE NEW PSECT INX
	MOVE	AC2,SGNCUR	;GET OLD PSECT INX
	HLRZ	SDEL,SGORIG(AC2)	;ALREADY SETUP LIT/VAR BLOCK
	JUMPN	SDEL,%SWSG1	;YES
	MOVEI	SDEL,.SGLVL+1	;NO
	ADDB	SDEL,FREE	;TRY TO GET IT
	CAML	SDEL,SYMBOL	;WILL IT FIT?
	PUSHJ	PP,XCEED	;NO, XPAND
	SUBI	SDEL,.SGLVL+1	;GET ORIGIN
	HRLM	SDEL,SGORIG(AC2)	;NOW STORE IT
%SWSG1:	MOVSI	AC0,.SGLVZ	;START OF LIT/VAR AREA
	HRRI	AC0,1(SDEL)	;SAVE AREA
	BLT	AC0,.SGLVL(SDEL);STORE IT
	MOVE	AC0,LITLVL	;GET LITLVL
	MOVEM	AC0,(SDEL)	;STORE IT
	HLLZ	AC0,SGORIG(AC1)	;RESTORE NEW LIT/VAR
	JUMPE	AC0,[MOVE AC0,[.SGLVZ,,.SGLVZ+1]	;NOT YET SETUP
		SETZM	.SGLVZ		;CLEAR FIRST WORD
		BLT	AC0,.SGLVZ+.SGLVL	;PLUS REST
		MOVEI	AC0,VARHD	;SET UP AREA
		MOVEM	AC0,VARHDX
		MOVEI	AC0,LITHD
		MOVEM	AC0,LITHDX
		SETZM	LITLVL
		PUSHJ	PP,LITI
		JRST	%SWSG2]		;JOIN COMMON CODE
	AOBJP	AC0,.+1		;BYPASS FIRST WORD
	HRRI	AC0,.SGLVZ	;TO LIT/VAR AREA
	BLT	AC0,.SGLVZ+.SGLVL-1
	HLRZ	SDEL,SGORIG(AC1)	;POINTER TO LIT INFO
	MOVE	AC0,(SDEL)	;GET LITLVL
	MOVEM	AC0,LITLVL	;WE ARE NOW IN
	PUSHJ	PP,HIGHQ	;SET CURRENT PROG BRK
%SWSG2:	MOVE	AC0,SGRELC(AC1)	;GET OLD MODE AND PC
	PUSH	PP,AC0		;SAVE SAME
	HLRZ	RC,AC0		;GET OLD MODE
	SKIPN	RC		;IF ABS MODE
	MOVE	AC0,ABSLOC	; THEN GET ABS PC
	HRRM	AC0,(PP)	;STORE NEW VALUE
	HRRZ	AC0,LOCO	;PC OF OUTPUT
	MOVE	AC1,MODO	;OLD MODE
	MOVEM	AC0,@REL1P(AC1)	;SAVE OLD VALUE
	MOVE	AC0,MODO	;SAVE OLD MODE
	MOVEM	AC0,ORGMOD
	MOVE	AC1,SGNCUR	;CURRENT PSECT INDEX
	MOVE	AC0,HIGH	;SAVE PSECT BREAK
	HRRM	AC0,SGATTR(AC1)
	HRR	AC0,RELLOC	;SAVE PSECT REL PC
	HRL	AC0,ORGMOD	;SAVE PSECT MODE
	MOVEM	AC0,SGRELC(AC1)
	MOVE	AC0,-1(PP)	;GET NEW PSECT INX
	MOVEM	AC0,SGNCUR	;SET SGNCUR TO IT
	JUMP1	.+2		;IF PASS 2 THEN
	PUSHJ	PP,SGOUTN	; OUTPUT PSECT NAME BLOCK
	POP	PP,AC0		;GET RESULT
	HLRZM	AC0,MODA	;SET MODES
	HLRZM	AC0,MODO
	HRRZM	AC0,LOCA	;AND LOCATIONS
	HRRZM	AC0,LOCO
	POP	PP,SGNCUR	;STORE NEW PSECT INX
	MOVE	AC1,SGNCUR	;NEW PSECT INX
	HRRZ	AC0,SGATTR(AC1)	;GET PSECT BRK
	MOVEM	AC0,HIGH	;RESTORE IT
	PUSHJ	PP,SRCHI	;SET UP SRCHX
	POPJ	PP,		;DONE

ERRSX:	TRO	ER,ERRS		;FLAG PSECT USAGE ERROR
	POPJ	PP,		;DONE
>
HISEG1:
IFN POLISH,<
	SKIPE	SGNMAX		;IF PSECTS USED THEN CAN'T USE
	JRST	ERRSX		; HISEG OR TWOSEG
>
	PUSHJ	PP,HIGHQ	;SET CURRENT PROGRAM BREAK
	PUSHJ	PP,COUTD	;DUMP CURRENT TYPE OF BLOCK
	SKIPN	HISNSW		;IF WE HAVE SEEN IT BEFORE
	SKIPE	HIGH		;OR ANY RELOC CODE PUT OUT
	TRO	ER,ERRQ		;FLAG AS AN ERROR
	BYPASS			;GO GET EXPRESSION
	TLO	IO,IORPTC
	PUSHJ	PP,EVALXQ	;CHECK FOR EXTERNAL
	ANDCMI	AC0,1777	;ONLY ALLOWED TO START ON NEW K BOUND
	HRRZM	AC0,LOCA	;SET LOC COUNTERS
	HRRZM	AC0,LOCO
	MOVEI	RC,1		;ASSUME RELOCATABLE
	POPJ	PP,

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

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


IFN FORMSW,<
ONFORM:	HRRES	HWFMT		;ALLOW MULTI-FORMAT LISTING
	POPJ	PP,
OFFORM:	HRROS	HWFMT		;HALF-WORD FORMAT ONLY
	POPJ	PP,	>

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

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

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

SUPRSA:	PUSHJ	PP,LOOKUP	;SUPRESS ALL
	MOVSI	ARG,SUPRBT
	IORM	ARG,(SX)
SUPRS1:	SETZM	EXTPNT		;JUST IN CASE WE LOOKED ONE UP
IFN POLISH,<
	TLZ	IO,RSASSW	;[265] ...
>
	POPJ	PP,

XPUNG0:	JUMP1	POPOUT
	PUSHJ	PP,LOOKUP
	MOVE	ARG,(SX)	;GET SYMBOL FLAGS
	TLNN	ARG,INTF!ENTF!EXTF!SPTR
	TLOA	ARG,SUPRBT	;LOCAL SYMBOL,SO SUPPRESS IT
	SETZM	EXTPNT
IFN POLISH,<
	TLZ	IO,RSASSW	;[265] ...
>
	MOVEM	ARG,(SX)	;RESTORE FLAGS
	POPJ	PP,

NODDT0:	PUSHJ	PP,GETSYM	;GET A SYMBOL TO SUPRES
	  JRST	NODDT1		;ERROR
	PUSHJ	PP,SSRCH	;SYMBOL ONLY
	  JRST	NODDT1		;GIVE ERROR MESSAGE
	PUSHJ	PP,SUPSYM	;SEE IF "!" SEEN
	TLOA	ARG,NOOUTF	;SET THE NO-DDT BIT
NODDT1:	TROA	ER,ERRA
	IORM	ARG,(SX)	;PUT BACK
	JUMPCM	NODDT0		;ANY MORE?
	JRST	SUPRS1

SUPSYM:	CAIE	C,'!'		;[404][167] WANT NO DDT OUTPUT FOR THIS SYMBOL?
	POPJ	PP,		;[167] NO
	TLO	ARG,NOOUTF	;[167] YES, SET FLAG
	PJRST	BYPAS1		;[167] SKIP "!" AND RETURN

;[220] .CREF SYMBOL,SYMBOL,ETC
ONCRF:	PUSHJ	PP,GETSYM	;SEE IF A SYMBOL SPECIFIED
	  JRST	[MOVSI	AC0,IONCRF	;NO, PUT FLAG BACK
		TRZ	ER,ERRA		;CLEAR "A" ERROR
		TLZ	IO,DEFCRS	;CLEAR ANY WAITING DEFINING OCCURENCES
		JRST	IORSET]
ONCRF0:	PUSHJ	PP,SEARCH	;[365] GENERAL SEARCH
	  JRST	ONCRFE		;[365] ERROR
	MOVSI	ARG,NCRF	;[365] NO CREF FLAG IN ARG
	ANDCAM	ARG,(SX)	;[365] TURN OFF NO CREF BIT
	CAMN	AC0,1(SX)	;[365] OTHER ENTRY IN SYMBOL TABLE?
	 ANDCAM	ARG,2(SX)	;[365] TURN OFF NCRF
	CAMN	AC0,-3(SX)	;[365] OTHER ENTRY IN SYMBOL TABLE?
	 ANDCAM	ARG,-2(SX)	;[365] TURN OFF NCRF
	CAIA			;[365]
ONCRFE:	TRO	ER,ERRA		;[365] SET ERROR CONDITION
	JUMPNC	SUPRS1		;GIVE UP IF NO MORE
	PUSHJ	PP,GETSYM	;GET NEXT SYMBOL
	  JRST	ONCRFE		;ERROR
	JRST	ONCRF0

;[220] .XCREF SYMBOL,SYMBOL,ETC
OFFCRF:	PUSHJ	PP,GETSYM	;SEE IF A SYMBOL SPECIFIED
	  JRST	[MOVSI	AC0,IONCRF	;PUT FLAG BACK
		TRZ	ER,ERRA		;CLEAR "A" ERROR
		JRST	IOSET]
OFCRF0:	PUSHJ	PP,SEARCH	;[365] GENERAL SEARCH
	  JRST	OFCRFE		;[365] ERROR
	MOVSI	ARG,NCRF	;[365] NO CREF FLAG IN ARG
	IORM	ARG,(SX)	;[365] SET NO CREF BIT
	CAMN	AC0,1(SX)	;[365] OTHER ENTRY IN SYMBOL TABLE?
	 IORM	ARG,2(SX)	;[365] SET BIT
	CAMN	AC0,-3(SX)	;[365] OTHER ENTRY IN SYMBOL TABLE?
	 IORM	ARG,-2(SX)	;[365] SET BIT
	CAIA			;[365]
OFCRFE:	TRO	ER,ERRA		;[365] FLAG ERROR
	JUMPNC	SUPRS1		;GIVE UP IF NO MORE SYMBOLS
	PUSHJ	PP,GETSYM	;GET NEXT SYMBOL
	  JRST	OFCRFE		;ERROR
	JRST	OFCRF0
TITLE0:	JUMP2	REMAR0
	SKIPE	TBUF+1		;IS THIS THE FIRST TITLE?
	JRST	[TRO	ER,ERRM		;NO, FLAG AS ERROR
		JRST	REMAR0]		;AND IGNORE
	MOVEI	SX,.TBUF
	HRRI	AC0,TBUF
	PUSHJ	PP,SUBTT1	;GO READ IT
	MOVEM	SX,TCNT		;SAVE COUNT OF CHARS. WRITTEN
	SKIPE	UNIVSN		;WAS IT A UNIVERSAL?
	PUSHJ	PP,ADDUNV	;YES  ADD TO TABLE
	SKIPN	TBUF+1		;2ND WORD NON-ZERO SIGNALS TITLE SEEN
	AOS	TBUF+1		;MAKE IT SO
IFN CCLSW,<JRST	PRNAM		;PRINT NAME IF FIRST ONE>
IFE CCLSW,<POPJ	PP,		;EXIT OTHERWISE>

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

SUBTT1:	BYPASS			;BYPASS LEADING BLANKS
	TLO	IO,IORPTC
SUBTT3:	PUSHJ	PP,CHARAC	;GET ASCII CHARACTER
	IDPB	C,AC0		;STORE IN BLOCK
	CAIGE	C,40		;TEST FOR TERMINATOR
	CAIN	C,HT
	SOJG	SX,SUBTT3	;TEST FOR BUFFER FULL
	DPB	RC,AC0		;END, STORE TERMINATOR
	SOJA	SX,REMAR1	;COUNT NULL AND EAT UP ANY REMAINING CHARS.

IFN CCLSW,<
PRNAM:	TLNN	IO,CRPGSW	;NOT IF NOT RPG
	POPJ	PP,
	PUSH	PP,AC0		;SAVE AC0 DMN
	PUSH	PP,RC		;AND RC
	MOVE	AC0,[POINT 7,TBUF]
	MOVE	SX,[POINT 7,OTBUF]
	MOVEI	RC,6		;MAX OF SIX CHRS
	MOVEI	C,HT		;START WITH A TAB
	IDPB	C,SX
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,CR		;END WITH CR-LF
	IDPB	C,SX
	MOVEI	C,LF
	IDPB	C,SX
	SETZ	C,		;TERMINATOR
	IDPB	C,SX
	TTCALL	3,OTBUF
	POP	PP,RC
	POP	PP,AC0		;RESTORE AC0 DMN
	POPJ	PP,
>
SYN0:	PUSHJ	PP,GETSYM	;GET THE FIRST SYMBOL
	  JRST	ERRAX		;ERROR, EXIT
	PUSHJ	PP,MSRCH	;TRY FOR MACRO/OPDEF
	  JRST	SYN3		;NO, TRY FOR OPERAND
SYN1:	MOVEI	SX,MSRCH	;YES, SET FLAG
SYN2:	JUMPNC	ERRAX		;[173] ERROR IF NO COMMA
	PUSH	PP,ARG		;[173] SAVE SOME REGISTERS
	PUSH	PP,RC		;[173]
	PUSH	PP,V		;[173]
	PUSH	PP,SX		;[173] SAVE SEARCH ROUTINE
	PUSHJ	PP,GETSYM	;[173] GET THE SECOND SYMBOL
	  JRST	[SUB	PP,[4,,4]	;[173] PUT STACK BACK
		POPJ	PP,]		;[173] AND GIVE UP
	POP	PP,SX		;[173] RESTORE SEARCH ROUTINE
	PUSHJ	PP,@SX		;[173] SEARCH FOR SECOND SYMBOL
	  JFCL			;[173]
	POP	PP,V		;[173] RESTORE VALUES
	POP	PP,RC		;[173]
	POP	PP,ARG		;[173]
	TLNE	ARG,MACF	;MACRO?
	PUSHJ	PP,REFINC	;YES, INCREMENT REFERENCE
	JRST	INSERT		;INSERT AND EXIT

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

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

PURGE2:	PUSHJ	PP,SSRCH	;TRY OPERAND SYMBOL TABLE
	  JRST	PURGE5		;NOT FOUND GET NEXT SYMBOL
	TDNE	RC,[-2,,-2]	;CHECK COMPLEX EXTERNAL
	TLNE	ARG,SYNF
	JRST	.+2
	JRST	PURGE3
	TLNE	ARG,EXTF!UNDF	;ERROR IF EXTERNAL OR UNDEFINED
	TLNE	ARG,SYNF	;BUT NOT A SYNONYM
	JRST	PURGE4
PURGE3:	TROA	ER,ERRA		;NOT FOUND, ERROR
PURGE4:	PUSHJ	PP,REMOVE	;REMOVE FROM THE SYMBOL TABLE
PURGE5:	JUMPCM	PURGE0
	POPJ	PP,		;EXIT
OPD1:	TLNE	ARG,UNDF	;IF OPDEF IS UNDEFINED
	TRO	ER,ERRO		;GIVE "O" ERROR
OPD:	MOVE	AC0,V		;PUT VALUE IN AC0
	JRST	OP
IOP:	MOVSI	AC2,(POINT 9,0(PP),11)
IFE FORMSW,<	TLOA	IO,IOIOPF	;SET "IOP SEEN" AND SKIP>
IFN FORMSW,<	PUSH	PP,IOFORM	;USE I/O FORM
	JUMPAD	.+2		;[344] IF IN ADDRESS FIELD, DON'T CHANGE IOSEEN
	SETOM	IOSEEN		;[116] SIGNAL  FOR BOUT TO ADJUST FIELDS
	TLO	IO,IOIOPF	;SET "IOP" SEEN
	JRST	OP+2>
OP:	MOVSI	AC2,(POINT 4,0(PP),12)
IFN FORMSW,<	PUSH	PP,INFORM	;USE INST. FORM>
	PUSH	PP,RC
	PUSH	PP,AC0		;STACK CODE 
	PUSH	PP,AC2
	PUSHJ	PP,EVALEX	;EVALUATE FIRST EXPRESSION
	POP	PP,AC2
	JUMPNC	OP2
OP1B:	PUSHJ	PP,GETCHR	;GET A CHARACTER
IFE FORMSW,<JUMPCM XWD5		;PROCESS COMMA COMMA IN XWD>
IFN FORMSW,<JUMPNC .+4		;JUMP IF NO COMMA
	MOVE	AC2,HWFORM	;GET FORM WORD FOR XWD
	MOVEM	AC2,-2(PP)	;REPLACE INSTRUCTION FORM
	JRST	XWD5		;PROCESS COMMA COMMA IN XWD>
	TLO	IO,IORPTC	;NOT A COMMA,REPEAT IT
	LDB	AC1,AC2
	ADD	AC1,AC0
	DPB	AC1,AC2
IFN POLISH,<
	TLNN	FR,POLSW	;[164] DON'T ALLOW EXTERNAL ACS
>
	JUMPE	RC,OP1A		;EXTERNAL OR RELOCATABLE?
	PUSHJ	PP,QEXT		;YES, DETERMINE WHICH AND FLAG AN ERROR

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

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

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

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


EXPRES:	HRLZ	AC0,RX		;FUDGE FOR OCT0

OCT0:	PUSH	PP,RX
	HLR	RX,AC0
IFN POLISH,<
	MOVNI	AC0,3		;[164] PRESET POLISH TYPE SINCE WE
	MOVEM	AC0,POLTYP	;[164] NEED FULL WORD FIXUPS IF POLISH
>
OCT1:	PUSHJ	PP,EVALEX	;EVALUATE
IFN POLISH,<
	TDNE	RC,[-2,,-2]	;[164] TEST FOR EXTERNAL
	PUSHJ	PP,OCTFW	;[164] YES, NEEDS FULL WORD FIXUP
>
IFN FORMSW,<	MOVE	AC1,HWFORM>
	PUSHJ	PP,STOW		;STOW CODE
	JUMPCM	OCT1
	POP	PP,RX		;YES, RESTORE RADIX
IFN POLISH,<
	SETZM	POLTYP		;[164] CLEAR FLAG
>
	POPJ	PP,		;EXIT

IFN POLISH,<
;HERE TO GENERATE FULL WORD FIXUPS FOR EXP EXTERN
;NOTE THIS GENERATES BLOCK TYPE 11 POLISH FIXUPS
;THESE CANNOT BE LOADER BY LOADER UNLESS FAILSW IS ON

OCTFW:	MOVE	PV,FREE		;[164] COPY CODE FROM POLPOP
	EXCH	PV,POLIST	;[164] TO SET UP A NEW BLOCK
	PUSHJ	PP,POLSTR	;[164] STORE POINTER TO LAST
	MOVE	PV,EXTPNT	;[164] GET POINTER TO EXTERNAL SYMBOL
	PUSHJ	PP,POLFS2	;[164] STORE EXTERNAL
	JRST	POLOCT		;[164] AND FIXUP ADDRESS, AND RETURN
>

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?
IFE FORMSW,<	JRST	ASC60		;YES>
IFN FORMSW,<
	JRST	[PUSHJ	PP,BYPAS1
		ANDCM	RC,STPX
		MOVE	AC1,SXFORM
		SETZM	INTXT		;[320] NO LONGER IN TEXT
		JUMPGE	RC,STOWZ
		POPJ	PP,]>
	CAIL	C,"A"+40
	CAILE	C,"Z"+40
	JRST	.+2
	TRZA	C,100		;CONVERT LOWER CASE TO SIXBIT
	SUBI	C,40		;CONVERT TO SIXBIT
	JUMPL	C,ASC55		;TEST FOR INVALID CHARACTER
	IDPB	C,RC		;NO, DEPOSIT THE BYTE
	TLNE	RC,770000	;IS THE WORD FULL?
	JRST	SIXB20		;NO, GET NEXT CHARACTER
IFN FORMSW,<	MOVE	AC1,SXFORM	;SIXBIT FORM>
	PUSHJ	PP,STOWZ	;YES, STORE
	JRST	SIXB10		;GET NEXT WORD
%TEXT1:	TLC	AC0,240000	;[232] CONVERT .TEXT TO COMMENT ON PASS1
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
	CAIA
	JRST	ERRAX
	FORERR	(SX,TXT)
	SETOM	INTXT
	MOVE	SX,C		;SAVE FOR COMPARISON
	JUMPG	SDEL,SIXB10	;BRANCH IF SIXBIT

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

ASC55:	TDZA	CS,CS		;ZERO CS IN CASE NESTED
ASC50:	TDZA	RC,SDEL		;TEST FOR ASCIIZ
	TROA	ER,ERRA		;SIXBIT ERROR EXIT
ASC60:	PUSHJ	PP,BYPAS1	;POLISH OFF TERMINATOR
	SETZM	INTXT		;WE ARE OUT OF IT
IFN FORMSW,<	MOVE	AC1,ASCIIF	;USE ASCII FORM WORD>
IFN IIISW,<TLNN	SDEL,100000	;NO EXTRA WORDS FOR ASCID>
	ANDCM	RC,STPX		;STORE AT LEAST ONE WORD
	TLNN	SDEL,200000	;GET OUT WITHOUT STORING
	JUMPGE	RC,[TLNN SDEL,040000	;.TEXT?
		JRST	STOWZ		;NO, STOW
		JRST	STOTXT]		;YES, STORE IN REL FILE
	POPJ	PP,		;ASCII, NO BYTES STORED, SO EXIT
;[232] .TEXT PSEUDO-OP

%TEXT0:	JUMP1	%TEXT1		;IGNORE ON PASS1
	PUSH	PP,BLKTYP	;SAVE CURRENT TYPE
	PUSHJ	PP,COUTD	;[370] DUMP CURRENT BLOCK
	HLLZ	SDEL,AC0	;[370] FLAG BITS FOR ASCII
	SETZM	BLKTYP		;DON'T KNOW IT YET
	PUSHJ	PP,ASC10	;START PROCESSING
	PUSHJ	PP,STOTXD	;FINISH BLOCK
	POP	PP,BLKTYP	;RESTORE PREVIOUS
	POPJ	PP,

STOTXT:	SKIPN	BLKTYP		;FIRST WORD?
	JRST	[MOVEM	AC0,BLKTYP
		POPJ	PP,]	;SAVE AS BLOCK TYPE
	SKIPN	COUTRB		;2ND WORD
	JRST	[MOVEM	AC0,COUTRB
		POPJ	PP,]
	AOS	C,COUTX		;NO, JUST STORE AS NORMAL
	MOVEM	AC0,COUTDB(C)
	CAIE	C,^D17		;BUFFER FULL?
	POPJ	PP,		;NO

STOTXD:	SKIPN	C,BLKTYP	;[331] SEE IF ANY TEXT TO OUTPUT
	JRST	COUTI		;[331] NO JUST CLEAR COUNTS
	AOS	COUTX		;[331] ACCOUNT FOR STARTING FROM -1
	SETZM	BLKTYP		;[331] CLEAR BLOCKTYPE WORD FOR NEXT BLOCK
	TRNN	C,177_1		;[331] SEE IF RELOCATION WORD IS NEEDED
	AOS	COUTRB		;[331] FIRST WORD OF BLOCK WAS NOT FULL,
				;[331] 2ND WAS 0, PUT THE LSN BIT ON FOR
				;[331] COUTD2 TO CHECK SO THERE WON'T BE
				;[331] AN EXTRA 0 WORD IN THE FILE
	JRST	COUTT		;DUMP BLOCK
POINT0:
IFN FORMSW,<	PUSH	PP,BPFORM	;USE BYTE POINTER FORM WORD>
	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
IFN POLISH,<
	SETOM	POLTYP		;[164] FORCE RIGHT-HALF FIXUP IF POLISH
>
	PUSHJ	PP,EVALEX	;NO, GET ADDRESS
	PUSHJ	PP,EVADR	;EVALUATE STANDARD ADDRESS
IFN POLISH,<
	SETZM	POLTYP		;[164] BACK TO NORMAL
>
	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:
IFN FORMSW,<	PUSH	PP,HWFORM	;USE HALF WORD FORM>
	PUSH	PP,RC
	PUSH	PP,AC0		;STORE ZERO ON STACK
	PUSHJ	PP,EVALEX	;EVALUATE EXPRESSION
	JUMPNC	OP2
XWD5:	SKIPN	(PP)		;ANY CODE YET?
	JRST	XWD10		;NO,USE VALUE IN AC0
	JUMPE	AC0,.+2		;ANYTHING IN AC0?
	TRO	ER,ERRQ		;YES,FLAG "Q"ERROR
	MOVE	AC0,(PP)	;USE PREVIOUS VALUE
	MOVE	RC,-1(PP)	;AND RELOCATION
XWD10:	TLNN	AC0,-1		;[143] LEFT HALF SHOULD BE ZERO
	JRST	XWD11		;[143] IT IS
	TLC	AC0,-1		;[143] OR AT LEST ALL ONES
	TLCE	AC0,-1		;[143] FOR XWD -1,-2 ETC
	TRO	ER,ERRQ		;[143] NO, WARN USER
XWD11:	HRLZM	AC0,0(PP)	;SET LEFT HALF
	HRLZM	RC,-1(PP)
	MOVSS	EXTPNT		;WFW
	JRST	OP1A		;EXIT THROUGH OP

IOWD0:	PUSHJ	PP,EVALQ	;[222] EVALUATE AND TEST FOR EXTERNAL
	CAIE	C,14		;","?
	JRST	[SKIPN	AC0		;IF NZERO AND NO "," SEEN
		TRO ER,ERRQ		;TREAT AS Q ERROR
IFN FORMSW,<	MOVE	AC1,HWFORM	;USE HALF WORD FORM>
		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
IFN FORMSW,<	MOVE	AC1,HWFORM	;USE HALF WORD FORM>
	JRST	STOW		;STOW CODE AND EXIT
BYTE0:	PUSHJ	PP,BYPAS1	;GET FIRST NON-BLANK
	CAIE	C,10		;"("?
	JRST	ERRAX		;NO, FLAG ERROR AND EXIT
IFN FORMSW,<
	PUSH	PP,[1]
	MOVEI	AC0,0
>
	PUSH	PP,RC
	PUSH	PP,AC0		;INITIALIZE STACK TO ZERO
	MOVSI	ARG,(POINT -1,(PP))

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

BYTE2:	IBP	ARG		;INCREMENT BYTE
	TRZN	ARG,-1		;OVERFLOW?
	JRST	BYTE3		;NO
	SETZB	AC0,RC		;YES
	EXCH	AC0,0(PP)	;GET CURRENT VALUES
	EXCH	RC,-1(PP)	;AND STACK ZEROS
IFN FORMSW,<
	MOVE	AC1,HWFORM	;USE STANDARD FORM
	EXCH	AC1,-2(PP)	;GET FORM WORD
>
	PUSHJ	PP,STOW		;STOW FULL WORD

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

IFN FORMSW,<
	MOVEI	AC0,1
	HRRI	ARG,-2
	DPB	AC0,ARG		;STORE FORM BYTE
	HRRI	ARG,0
>
	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
	JUMPNC	ERRAX
	TDZE	AC0,[EXP ^-74]	;[322] MAKE SURE ONLY 74 BITS ON
	TRO	ER,ERRQ		;[322] NOPE, LIGHT Q ERROR
	PUSH	PP,AC0		;[160] SAVE CODE BITS
	PUSHJ	PP,GETSYM	;YES, GET SYMBOL
	TRZ	ER,ERRA		;CLEAR ERROR
	POP	PP,ARG		;[160] PUT CODE INTO ARG
	PUSHJ	PP,SQOZE	;SQUOZE SIXBIT AND ADD CODE
IFN FORMSW,<	MOVE	AC1,HWFORM	;USE STANDARD FORM>
	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,

; .LINK PSEUDO OP.   FORM IS
;
;	.LINK	LNKNO, LNKLOC, LNKNXT
;
;WHERE LNKNO IS THE LINK NUMBER, LNKLOC IS THE LOCATION INTO WHICH
;LINK SHOULD STORE THE CURRENT VALUE OF THE LINK POINTER, AND
;LNKNXT IS AN OPTIONAL ARGUMENT WHICH LINK WILL ACCEPT AS THE
;NEW VALUE OF THE LINK POINTER (IF LNKNXT ABSENT THEN LNKLOC IS
;THE NEW POINTER VALUE).

%LINK:	PUSH	PP,BLKTYP	;SAVE BLOCK TYPE
	PUSH	PP,AC0
	JUMP1	LINK1		;SKIP CODE GEN IF P1
	PUSHJ	PP,COUTD
	MOVEI	AC0,12		;LINK TYPE
	MOVEM	AC0,BLKTYP
LINK1:	PUSHJ	PP,EVALEX	;EVAL CHECK EXT
	POP	PP,AC1		;GET BITS BACK
	JUMPN	RC,LNKERR	;MUST BE ABS
	JUMPNC	LNKERR		;GRNTEE COMMA
	TLNE	AC1,400000	;LNKEND?
	MOVN	AC0,AC0		;YES, NEGATE RESULT
	JUMP1	LINK2		;SKIP IF P1
	PUSHJ	PP,COUT
LINK2:	PUSHJ	PP,EVALXQ	;NO EXTERNALS
	JUMPNC	LINK2A		;[423] THIRD ARGUMENT SPECIFIED?
	HRL	AC0,RC		;[423] YES - MUST FIRST SAVE THE
	PUSH	PP,AC0		;[423] OLD VALUES OF RC, AC0
	PUSHJ	PP,EVALXQ	;[423] READ IN THIRD ARGUMENT
	MOVS	AC0,AC0		;[423] LINK EXPECTS LNKNXT IN THE
	MOVS	RC,RC		;[423] LEFT HALF OF SECOND WORD
	HRR	AC0,(PP)	;[423] RESTORE LNKLOC VALUE
	HLR	RC,(PP)		;[423] AND ITS RELOCATION BIT
	TLNE	RC,1		;[423] LNKNXT RELOCATABLE???
	 TRO	RC,2		;[423] YES - SET FOR COUT TO DEPOSIT
	SUB	PP,[1,,1]	;[423] "POP" BOGUS WORD OFF STACK
LINK2A:	JUMP1	LINK3
	PUSHJ	PP,COUT		;DUMP LOC
	PUSHJ	PP,COUTD	;FINISH BLOCK
LINK3:	POP	PP,BLKTYP	;RESTORE BLKTYP
	POPJ	PP,

LNKERR:	POP	PP,BLKTYP	;RESTORE BLOCK TYPE
	PJRST	ERRAX		;GIVE ERROR RETURN
%INTEG:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	JRST	INTG2		;BAD SYMBOL ERROR
	TLO	IO,DEFCRS	;THIS IS A DEFINTION
	PUSHJ	PP,SSRCH	;SEE IF THERE
	MOVSI	ARG,SYMF!UNDF	;SET SYMBOL AND UNDEFINED IF NOT
	TLNN	ARG,UNDF	;IF ALREADY DEFINED
	JRST	INTG1		;JUST IGNORE
	TLOA	ARG,VARF	;SET VARIABLE FLAG
INTG2:	TROA	ER,ERRA		;SYMBOL ERROR
	PUSHJ	PP,INSERZ	;PUT IN WITH ZERO VALUE (LENGTH OF 1)
INTG1:	JUMPCM	%INTEG
	POPJ	PP,

%ARAY:	MOVEM	PP,ARAYP	;SAVE PUSHDOW POINTER
ARAY2:	PUSHJ	PP,GETSYM
	JRST	ARAY1		;BAD SYMBOL GIVE ERROR AND ABORT
	PUSH	PP,AC0		;SAVE NAME
	JUMPCM	ARAY2		;AND GO ON IF A COMMA
	CAIE	C,"["-40	;MUST BE A [
	JRST	ARAY1
	BYPASS			;OH,	WELL
	TLO	IO,IORPTC
	PUSHJ	PP,EVALXQ	;GET A SIZE
	CAIE	C,"]"-40	;MUST END RIGHT
	JRST	ARAY1
	BYPASS			;??
	HRRZ	V,AC0		;GET VALUE
	SUBI	V,1
NXTVAL:	POP	PP,AC0
	PUSH	PP,V		;SAVE OVER SEARCH
	TLO	IO,DEFCRS
	PUSHJ	PP,SSRCH	;FIND IT
	MOVSI	ARG,SYMF!UNDF
	POP	PP,V		;GET VALUE BACK
	TLNN	ARG,UNDF
	JRST	ARAY3
	TLO	ARG,VARF
	MOVEI	RC,0		;NO RELOC
	PUSHJ	PP,INSERT
ARAY3:	CAME	PP,ARAYP
	JRST	NXTVAL		;STILL NAMES STACKED
	JUMPCM	ARAY2
	POPJ	PP,

ARAY1:	TRO	ER,ERRA		;ERROR EXIT
	MOVE	PP,ARAYP
	POPJ	PP,		;RESET PDL AND GO

;[121] .COMMON SYMBOL [SIZE]
SYN	ARAYP,COMMP		;SAVE SPACE

COMM0:	JUMP1	COMM1		;WASTE OF TIME ON PASS1
	PUSHJ	PP,COUTD	;DUMP CURRENT BLOCK
	PUSH	PP,BLKTYP	;SAVE TYPE
	MOVEI	AC0,20		;COMMON BLOCK TYPE
	MOVEM	AC0,BLKTYP	;SET NEW
COMM1:	MOVEM	PP,COMMP	;SAVE PUSHDOWN POINTER
COMM2:	PUSHJ	PP,GETSYM	;GET A 6-BIT SYMBOL NAME
	  JRST	COMM7		;BAD SYMBOL, GIVE UP
	PUSH	PP,AC0		;SAVE SYMBOL NAME
	JUMPCM	COMM2		;AND GET ANOTHER IF COMMA

	CAIE	C,'['		;MUST BE A [
	JRST	COMM7		;YOU LOSE
	BYPASS			;SKIP ANY LEADING SPACES
	TLO	IO,IORPTC	;BUT NOT LAST CHAR
	PUSHJ	PP,EVALXQ	;GET SIZE OF COMMON
	CAIE	C,']'		;MUST END RIGHT
	JRST	COMM7
	HRRZ	V,AC0		;GET VALUE
				;PUSHDOWN STACK IS IN WRONG ORDER, REVERSE IT
	HRRZ	RC,PP		;TOP ITEM
	HRRZ	ARG,COMMP	;BOTTOM ITEM
	ADDI	ARG,1		;WELL ALMOST
COMM6:	CAIG	RC,(ARG)	;ANYTHING TO MOVE?
	JRST	COMM3		;NO
	MOVE	0,(RC)		;MOVE TOP
	EXCH	0,(ARG)		;TO BOTTOM
	MOVEM	0,(RC)
	SUBI	RC,1		;DECREMENT
	AOJA	ARG,COMM6	;AND TRY AGAIN

COMM3:	JUMP1	[MOVE	AC0,0(PP)	;[430] GET SYMBOL
		PUSHJ	PP,SEARCH	;[430] PERFORM GENERAL SEARCH
		JRST	COMM3A		;[430] NOT FOUND, GOOD
		JUMPL	ARG,CMNERR	;[430] FOUND, OPERAND, WARN
		CAME	AC0,-3(SX)	;[430] MACRO, LOOK ONE SLOT BELOW
		JRST	COMM3A		;[430] NOT FOUND, CONTINUE
		JRST	CMNERR		;[430] WARNING
		]
COMM3A:	POP	PP,AC0		;GET SYMBOL OFF STACK
	JUMP1	.+2		;IGNORE V ON PASS 1
	PUSH	PP,V		;SAVE VALUE
	PUSHJ	PP,EXTER1	;DEFINE AS EXTERNAL
				;NOTE, CS IS NOT ON A COMMA, SO WILL RETURN
	JUMP1	COMM4		;ALL DONE IF PASS1
	SETZ	RC,		;NO RELOCATION
	MOVEI	ARG,4		;FORM RADIX50 04,SYMBOL
	PUSHJ	PP,SQOZE	;IN AC0
	PUSHJ	PP,COUT		;OUTPUT SYMBOL
	POP	PP,V		;GET VALUE BACK
	MOVE	AC0,V		;AND INTO AC0
	PUSHJ	PP,COUT		;SECOND PART OF PAIR
COMM4:	CAME	PP,COMMP	;FINISHED WITH STACKED SYMBOLS
	JRST	COMM3		;NO MORE TO GO
	BYPASS			;GET NEXT DELIMITER
	JUMPCM	COMM2		;MORE TO GO IF COMMA NEXT
COMM5:	JUMP1	CPOPJ
	PUSHJ	PP,COUTD	;DUMP THIS BLOCK
	POP	PP,BLKTYP	;RESTORE LAST
	POPJ	PP,


COMM7:	TRO	ER,ERRA		;FLAG ERROR
	MOVE	PP,COMMP	;RESET PUSHDOWN POINTER
	JRST	COMM5		;RESTORE BLKTYP AND EXIT

CMNERR:	PUSHJ	PP,EWARN	;[430] WARNING
	MOVSI	RC,[SIXBIT /SOC STATEMENT OUT OF ORDER .COMMON@/]	;[430] SYMBOL IN AC0
	PUSHJ	PP,TYPMSG	;[430]
	AOS	QERRS		;[430] COUNT AS WARNING
	JRST	COMM3A		;[430] CONTINUE
;[122] .REQUEST DEV:FILENAME[PPN]

REQUIR:	SKIPA	CS,[16]		;BLOCK TYPE 16
REQUES:	MOVEI	CS,17		;BLOCK TYPE 17
	JUMP1	REMAR0		;IGNORE ON PASS 1
	PUSHJ	PP,COUTD	;DUMP CURRENT
	PUSH	PP,BLKTYP	;SAVE LAST BLOCK TYPE
	MOVEM	CS,BLKTYP	;SET NEW
REQU0:
REPEAT 3,<PUSH	PP,[0]>		;STACK A NULL SPEC INCASE OF ERROR
	BYPASS			;[345] FLUSH EXTRA TABS AND SPACES
	TLO	IO,IORPTC	;[350]BACK OFF BECAUSE SCHGET
				;[350]WILL TRY TO GET THIS CHARACTER
	PUSHJ	PP,SCHGET	;[335] GET PART OF A FILE SPEC
	JUMPE	AC0,REQUER	;[335] ERROR IF NOTHING
	CAIE	C,':'		;WAS THERE A DEVICE
	JRST	REQU1		;NO, GOOD GUESS
	MOVEM	AC0,-2(PP)	;SAVE DEVICE
	PUSHJ	PP,SCHGET	;[335] GET THE FILE NAME
	JUMPE	AC0,REQUER	;[335] ERROR IF NOTHING
REQU1:	MOVEM	AC0,(PP)	;STORE FILE NAME
	CAIN	C,'.'		;[335] SEE IF AN EXTENSION GIVEN
	JRST	REQU4		;[335] YES, GO SKIP IT AND MAKE SURE IT'S
REQU3:				;[335] A .REL FILE, CAUSE THAT'S ALL IT CAN BE
	CAIE	C,'['		;WAS THERE A PPN
	JRST	REQU2		;NO, AS EXPECTED
	BYPASS			;SKIP ANY BLANKS
	TLO	IO,IORPTC
	PUSHJ	PP,EVALXQ	;GET HALF A PPN
	HRLM	AC0,-1(PP)	;STORE IT
	PUSHJ	PP,EVALXQ	;GET OTHER HALF
	HRRM	AC0,-1(PP)	;STORE IT
	CAIE	C,']'		;MUST END ON ]
	JRST	REQUER		;IT DIDN'T
	BYPASS			;[273]HANDLE PPN CORRECTLY
REQU2:	SETZ	RC,		;NO RELOCATION
	POP	PP,AC0		;GET FILE NAME
	PUSHJ	PP,COUT
	POP	PP,AC0		;AND PPN
	PUSHJ	PP,COUT
	POP	PP,AC0		;FINALLY DEVICE
	PUSHJ	PP,COUT
	JUMPCM	REQU0		;MORE TO COME
	PUSHJ	PP,COUTD	;DUMP BLOCK
	POP	PP,BLKTYP	;RESTORE BLOCK TYPE
	POPJ	PP,		;NO

REQU4:	PUSHJ	PP,SCHGET	;[335] GO SCAN OUT EXTENSION
	HLRZ	AC0,AC0		;[335] SWAP FOR CAIE
	CAIE	AC0,'REL'	;[335] SEE IF IT'S FOR .REL
	TRO	ER,ERRQ		;[335] NOPE, TELL HIM ABOUT IT
	JRST	REQU3		;[335] BACK TO LOOK FOR PPN

REQUER:	SUB	PP,[3,,3]	;REMOVE THE THREE ITEMS
	POP	PP,BLKTYP	;RESTORE BLOCK TYPE
	JRST	ERRAX		;AND GIVE UP
;[202] NEW .DIRECTIVE PSEUDO-OP 
;[202] ARGS ARE FUNCTIONS TO BE DONE
;[421] CLEAN UP DIRECTIVE CODE
;[421] ADD .DIRECTIVE NO XXXX WHICH NEGATES EFFECT

%DIREC:
	SETZM	NOFLG		;START W/POSITIVE DIRECTIVE
DIREC1:	PUSHJ	PP,GETSYM	;GET SYMBOL
	  JRST	ERRAX		;MISSING, GIVE ERROR
	CAMN	AC0,[SIXBIT /NO/];IS IT "NO"
	JRST	[ SKIPE  NOFLG  ;IS NEGATIVE FLAG OFF?
		  TROA   ER,ERRQ;NO. DONT ALLOW .DIRECT NO NO XXXX
		  SETOM  NOFLG  ;SET AS NEGATIVE DIRECTIVE
		  TLO IO,IORPTC ;REGET THE DELIMITER
		  JRST DIREC1]	;AND GET NEXT SYMBOL
	MOVSI	ARG,-DIRLEN	;AOBJN WORD
	CAMN	AC0,DIRARG(ARG)	;LOOK FOR MATCH
	JRST	DIRFND		;GOT IT
	AOBJN	ARG,.-2		;LOOP FOR ALL OF TABLE
	JRST	ERRAX		;NOT FOUND, GIVE ERROR

DIRFND:
	SKIPE	NOFLG		;IS THIS A NEGATIVE DIRECTIVE?
	JRST	DIRNDO		;YES,GO PROCESS IT
	XCT	DIPXCT(ARG)	;EXECUTE THE INSTRUCTION
	JRST	DIREND		;SEE IF MORE TO DO
DIRNDO:				;HERE FOR NEGATIVE DIRECTIVE
	SKIPN	DINXCT(ARG)	;ANYTHING THERE TO DO?
	TROA	ER,ERRA		;NO, NOTHING TO DO
	XCT	DINXCT(ARG)	;ELSE DO IT
DIREND:	
	JUMPCM	%DIREC		;GET NEXT SYMBOL IF COMMA FOLLOWS
	POPJ	PP,		;ELSE RETURN

; TABLES FOR DIRECTIVE PROCESSOR

;[421]
; THE DIRMAK MACRO DEFINES THE ARGUMENTS FOR THE .DIRECTIVE PSEUDO-OP
; THE FIRST ENTRY IS THE NAME OF THE PARTICULAR DIRECTIVE
; THE SECOND ENTRY IS THE INSTRUCTION TO EXECUTE IF THE CASE IS
;	.DIRECTIVE XXXXXX
; THE THIRD ARGUMENT IS THE INSTRUCTION TO EXECUTE IF THE CASE IS
;	.DIRECTIVE NO XXXXXX
; IF THERE IS NO LOGICAL NEGATIVE FOR THIS DIRECTIVE, IT SHOULD
; BE LEFT BLANK.
; THE THREE TABLES CREATED ARE  DIRARG, DIPXCT, DINXCT

	DEFINE DIRMAK, <
	XLIST
	X (.NOBIN,<PUSHJ PP,%NOBIN>)		;;DONT GENERATE REL FILE
	X (.ITABM,<SETZM DECTAB>,<SETOM DECTAB>);;INCLUDE TABS IN MACRO ARGS
	X (.XTABM,<SETOM DECTAB>,<SETZM DECTAB>);;EXCLUDE  "" " ""
	X (KA10,<PUSHJ PP,SETKA>)		;;SET PROCESSOR TYPE KA
	X (KI10,<PUSHJ PP,SETKI>)		;;SET PROCESSOR TYPE KI
	X (KL10,<PUSHJ PP,SETKL>)		;;SET PROCESSOR TYPE KL
	X (.OKOVL,<SETOM OKOVFL>,<SETZM OKOVFL>);;ALLOW /,* OVERFLOW
	X (.EROVL,<SETZM OKOVFL>,<SETOM OKOVFL>);;DONT ALLOW /,* OVERFLOW
IFN TSTCD,<
	X (.TCDON,<PUSHJ PP,TCDSET>)		;;DEBUG NEW CODE TYPES
	X (.TCDOF,<SETZM TCDFLG>)		;; ""    ""  ""    ""
> ; END OF IFN TSTCD CONDITIONAL

	LIST
  > ; END OF DIRMAK DEFINITION


; DEFINE TABLE OF DIRECTIVE ARGUMENTS
	DEFINE X($A,$B,$C)< SIXBIT \$A\>

DIRARG:	DIRMAK
	DIRLEN==.-DIRARG

; DEFINE TABLE OF POSITIVE DIRECTIVE ACTIONS
	DEFINE X($A,$B,$C)< $B>

DIPXCT:	DIRMAK

; DEFINE TABLE OF NEGATIVE DIRECTIVE ACTIONS
	DEFINE X($A,$B,$C)< 
	IFB <$C>,<EXP 0>
	IFNB <$C>, <$C> >

DINXCT:	DIRMAK
; [421] SET THE VARIOUS FLAVORS OF CPU FOR LINK TO CHECK

SETKA:	SKIPA	ARG,[1B5]	;[235]
SETKI:	MOVSI	ARG,(2B5)	;[235]
	SKIPA			;[413]SET FOR KI OR KA
SETKL:	MOVSI	ARG,(4B5)	;[413] KA=1 KI=2 KL=4
	IORM	ARG,CPUTYP	;[413]MAKE INCLUSIVE WITH WHAT IS THERE
	POPJ	PP,		;[413]THEN RETURN


; [421] SET TEST CODE UP FOR DEBUGGING NEW LINK TYPES

IFN TSTCD,<
TCDSET:	SETOM	TCDFLG		;[414]SET FLAG ON
	PUSHJ	PP,COUTD	;[414]BIND OFF LAST BLOCK
	POPJ	PP,		;[414]
> ; NFI TSTCD [414]
; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY

; HERE IF PRGEND (PASS 1)
PSEND0:	TLO	IO,MFLSW	;PSEND SEEN
	PUSHJ	PP,END0		;AS IF END STATEMENT
	HLLZS	IO		;CLEAR ER(RH)
	SETZM	ERRCNT		;CLEAR ERROR COUNT FOR EACH PROG.
	SETZM	QERRS		;[145] ...
	JUMP2	PSEND2		;DIFFERENT ON PASS2
	SKIPE	UNIVSN		;SEEN A UNIVERSAL
	PUSHJ	PP,UNISYM	;YES, STORE SYMBOLS
	PUSHJ	PP,PSEND4	;SAVE SYMBOLS, POINTERS AND TITLE
	MOVE	AC0,[ASCII /.MAIN/] ;[420] GET DEFAULT TITLE
	MOVEM	AC0,TBUF	;[420]AND MAKE IT CURRENT TITLE
	SETZM	TBUF+1		;CLEAR TITLE SEEN FLAG
	SETZM	RELLOC		;[346] CLEAR TO PREVENT EFFECTS ACROSS PRGEND
PSEND1:	TLZ	IO,MFLSW	 ;FOR NEXT FILE
	SETZM	UNISCH		;CLEAR UNIVERSAL SEARCH TABLE
	MOVE	AC0,[UNISCH,,UNISCH+1]
	BLT	AC0,UNISCH+.UNIV-1
	TLO	IO,IOPAGE	;[142] SIGNAL NEW PAGE BUT DON'T CHANGE NUMBER
	MOVSI	AC0,1		;SET SO RELOC 0 WORKS
	HRRZM	AC0,LOCA	;[165] SET ASSEMBLY LOCATION
	HRRZM	AC0,LOCO	;[165] AND OUTPUT LOCATION
	HLRZM	AC0,MODA	;[165] SET MODE
	HLRZM	AC0,MODO	;[165]
	POPJ	PP,		;[165]

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

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

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

PSENDX:	PUSHJ	PP,XCEED	;NEED TO EXPAND CORE FIRST
PSEND5:	HRRZ	V,.JBREL	;[170] GET TOP OF CORE
	SETZM	(V)		;[170] CLEAR OR GET ILL MEM REF
	MOVEI	AC0,-1(V)	;[170]
	MOVEM	AC0,SYMTOP	;TOP OF NEW SYMBOL TABLE
	HRRZ	V,PRGPTR	;ADDRESS OF THIS BLOCK
	JUMPE	V,PSNDER	;ERROR LINK NOT SET UP
	MOVE	AC1,(V)		;NEXT LINK
	MOVE	V,1(V)		;GET ITS SYMBOL COUNT
	ASH	V,1		;NUMBER OF WORDS
	ADDI	V,1		;PLUS ONE FOR COUNT
	SUBI	AC0,(V)		;START OF NEW SYMBOL TABLE
	CAMG	AC0,FREE	;WILL IT FIT
	JRST	PSENDX		;NO, NEED TO EXPAND AND RESET AC0
	ADD	V,PRGPTR	;POINT TO END OF SYMBOL TABLE
	MOVEI	V,1(V)		;THEN TO BEG OF TITLE
	MOVEM	AC0,SYMBOL	;BOTTOM OF NEW TABLE
	HRL	AC0,PRGPTR	;ADDRESS OF FIRST WORD OF BLOCK
	ADD	AC0,[1,,0]	;MAKE BLT POINTER
	HRRM	AC1,PRGPTR	;POINT TO NEXT BLOCK
	BLT	AC0,@SYMTOP	;MOVE TABLE
	PUSHJ	PP,SRCHI	;SET UP POINTER
	MOVE	AC1,(V)		;NUMBER OF WORDS OF TITLE
	MOVEI	AC0,1(V)	;START OF STORED TITLE
	ADD	V,AC1		;INCREMENT PAST TITLE
	ADDI	AC1,TBUF-1	;END OF TITLE
	HRLI	AC0,TBUF	;WHERE TO PUT IT
	MOVSS	AC0		;BLT POINTER
	BLT	AC0,(AC1)	;MOVE TITLE
IFN POLISH,<
	PUSHJ	PP,GETIT	;GET PSECT COUNT
	MOVE	AC2,AC0
	MOVEM	AC2,SGNMAX
	PUSHJ	PP,GETIT	;GET PSECT NAME
	MOVEM	AC0,SGNAME(AC2)
	PUSHJ	PP,GETIT	;GET MODE AND PC
	MOVEM	AC0,SGRELC(AC2)
	PUSHJ	PP,GETIT	;GET SYM CNT
	MOVEM	AC0,SGSCNT(AC2)
	PUSHJ	PP,GETIT	;GET BREAK AND ATTRS
	MOVEM	AC0,SGATTR(AC2)
	SOJGE	AC2,.-10
	SETZM	SGNCUR		;SET TO BLANK PSECT
	PUSHJ	PP,SRCHI	;SET UP POINTER
>
	SKIPN	TBUF+1		;CHECK TITLE SEEN FLAG
	AOS	TBUF+1		;AND SET IT NON-ZERO
	PUSHJ	PP,GETIT	;[251]
	MOVEM	AC0,LITHD	;[251]
	MOVE	AC2,LITHDX	;INVERSE OF ABOVE
	PUSHJ	PP,GETIT
	MOVEM	AC0,-1(AC2)
	MOVE	AC2,VARHDX	;SAME FOR VARS
	PUSHJ	PP,GETIT
	MOVEM	AC0,-1(AC2)
	PUSHJ	PP,GETIT
	MOVEM	AC0,(AC2)	;RESTORE COUNT OF VARS
	PUSHJ	PP,GETIT	;GET TWO HALF WORDS
	HRRZM	AC0,HIGH1	;PASS1 BREAK
	HLLEM	AC0,HISNSW	;TWOSEG/HISEG FLAG
	JUMPGE	AC0,CPOPJ	;NOT TWOSEG
	PUSHJ	PP,GETIT
	MOVEM	AC0,SVTYP3	;BLOCK 3 WORD
	POPJ	PP,

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

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

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

UNIV0:	JUMP2	UNIV2		;[226] DO PROPER PASS2 STUFF
	HRRZ	SX,UNIVNO	;GET NUMBER OF UNIVERSALS SEEN
	CAIL	SX,.UNIV	;ALLOW ONE MORE?
	JRST	UNVERR		;NO, GIVE FATAL ERROR
	SETOM	UNIVSN		;AND SET SEEN A UNIVERSAL
	JRST	TITLE0		;CONTINUE AS IF TITLE

UNIV2:	HLLOS	UNIVSN		;[226] ENSURE SET UP FOR UNIVERSAL
	JRST	REMAR0		;[226] AND IGNORE LINE

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

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

UNISYM:	PUSHJ	PP,SUPRSA	;TURN ON SUPPRESS BIT
	SKIPN	UNVSKP		;SKIP IF /U SEEN
	PUSHJ	PP,UNVOUT	;OUTPUT SYMBOL TABLE
	TLNN	IO,MFLSW	;[231] ALSO IN PRGEND?
	JRST	UNISYN		;[231] NO
	MOVE	AC0,@SYMBOL	;[231] GET NO. OF SYMBOLS
	LSH	AC0,1		;[231] 2 WORDS EACH
	ADDI	AC0,1		;[231] PLUS COUNT
	ADD	AC0,FREE	;[231] HOW MUCH WE WILL NEED
	CAML	AC0,SYMBOL	;[231] WILL IT FIT IN WHAT WE HAVE
UNISYK:	PUSHJ	PP,XCEED	;[355] [231] NO, EXPAND
	CAML	AC0,SYMBOL	;[355] ENOUGH?
	JRST	UNISYK		;[355] NO,EXPAND
UNISYN:	PUSH	PP,SYMBOL	;NEED TO SAVE INCASE PRGEND
	MOVE	AC0,SYMTOP	;TOP OF TABLE
	SUB	AC0,SYMBOL	;GET LENGTH OF TABLE
	HRL	ARG,SYMBOL	;BOTTOM OF TABLE
	HRR	ARG,FREE	;WHERE TO GO
	HRRZ	RC,UNIVNO	;GET TABLE INDEX
	HRRM	ARG,SYMBOL	;WILL BE THERE SOON
	HRRZM	ARG,UNIPTR+1(RC)	;STORE IN CORRESPONDING PLACE
	ADDB	AC0,FREE	;WHERE TO END
	HRLM	AC0,UNIPTR+1(RC)	;SAVE NEW SYMTOP
	BLT	ARG,@FREE	;MOVE TABLE
	HRRZM	AC0,UNITOP	;SAVE TOP OF TABLES+1
	CAMLE	AC0,MACSIZ	;IN CASE OVER A K BOUND
	MOVEM	AC0,MACSIZ	;DON'T REDUCE SO FAR NOW
	MOVE	AC0,SRCHX	;SAVE OLD SEARCH POINTER
	PUSHJ	PP,SRCHI	;GET SEARCH POINTER
	EXCH	AC0,SRCHX
	MOVEM	AC0,UNISHX+1(RC)	;SAVE IT
	POP	PP,SYMBOL	;RESTORE OLD VALUE
	SETZM	UNIVSN		;CLEAR FLAG INCASE PRGEND
	AOS	UNIVNO		;SIGNAL ANOTHER UNIVERSAL SAVED
	POPJ	PP,		;RETURN

SERCH0:	PUSHJ	PP,GETSYM	;GET A SYMBOL
	  JRST	ERRAX		;ERROR IF NOT VALID
	MOVE	RC,UNIVNO	;NUMBER OF UNIVERSALS AVAILABLE
	JUMPE	RC,UNVINP	;TRY TO READ SYMBOLS FROM DSK
	CAME	AC0,UNITBL(RC)	;LOOK FOR MATCH
	SOJA	RC,.-2		;NOT FOUND YET
SERCH1:	MOVE	AC0,RC		;STORE TABLE ENTRY NUMBER
	MOVEI	RC,1		;START AT ENTRY ONE
	CAIL	RC,.UNIV	;CHECK FOR CONSISTENCY ERROR
	JRST	SCHERR		;SHOULD NEVER HAPPEN!!
	SKIPE	UNISCH(RC)	;LOOK FOR AN EMPTY SLOT
	AOJA	RC,.-3		;NOT FOUND YET
	MOVEM	AC0,UNISCH(RC)	;STORE INDEX IN TABLE
	CAIE	C,'('		;[240] GIVING FILE SPEC?
	JRST	SERCH4		;[240] NO
SERCH2:	PUSHJ	PP,GETCHR	;[240] YES, GET RID OF IT
	CAIN	C,')'		;[266] LOOK FOR END
	JRST	SERCH3		;[266] FOUND IT
	CAIE	C,EOL		;[266] REACHED END OF LINE?
	JRST	SERCH2		;[266] NO, KEEP LOOKING
	TROA	ER,ERRQ		;[266] GIVE UP AND FLAG ERROR
SERCH3:	PUSHJ	PP,GETCHR	;[240] GET NEXT CHAR
SERCH4:	JUMPCM	SERCH0		;[240] LOOK FOR MORE NAMES
	POPJ	PP,		;FINISHED

VERSKW:	MOVSI	RC,[SIXBIT /UVS UNIVERSAL VERSION SKEW, REASSEMBLE UNIVERSAL@/]	;[364]
	JRST	ERRFIN		;[364] NAME IN AC0

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

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

SCHGET:	SETZ	AC0,		;[240] INITIALIZE
	MOVSI	AC1,(POINT 6,AC0)	;[240]
SCHGNX:	PUSHJ	PP,GETCHR	;[240] GET NEXT CHARACTER
	CAIE	C,'.'		;[240] SPECIAL TEST FOR END OF NAME
	TLNN	CS,6		;[240] OR ANY NON-ALPHANUMERIC
	PJRST	BYPAS2		;[240] SKIP ALL SPACES AND QUIT
	TLNE	AC1,770000	;[240] ALL SIX IN YET?
	IDPB	C,AC1		;[240] NO, STORE THIS ONE
	JRST	SCHGNX		;[240] GET NEXT

SCHOCT:	SETZ	AC0,		;[240] INITIALIZE
SCHONX:	PUSHJ	PP,GETCHR	;[240] GET NEXT CHAR
	TLNN	CS,4		;[240] NUMBER
	PJRST	BYPAS2		;[240] NO, SKIP TRAILING SPACES
	LSH	AC0,3		;[240] MAKE SPACE
	ADDI	AC0,-'0'(C)	;[240] AND STOW DIGIT
	JRST	SCHONX		;[240] GET NEXT
SUBTTL	MACRO/REPEAT HANDLERS

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

REPEA1:	SETZM	COMSW		;[425] SET COMMENT SWITCH
	JUMPLE	AC0,REPZ	;PASS THE EXP., DONT PROCESS
	SOJE	AC0,REPO	;REPEAT ONCE
REPEA2:	PUSHJ	PP,GCHARQ	;GET STARTING "<"
	PUSHJ	PP,COMTST	;[425] IGNORE COMMENTS
	SKIPN	COMSW		;[425] INSIDE A COMMENT?
	CAIG	C," "		;[373] TEXT FORMATTING CHARACTER?
	JRST	REPEA2		;[373] YES, GET NEXT
	CAIE	C,"<"		;[373] "<"?
	JRST	REPMAB		;[373] NO, ERROR
	PUSHJ	PP,SKELI1	;INITIALIZE SKELETON
	PUSH	MP,REPEXP
	MOVEM	AC0,REPEXP
	PUSH	MP,REPPNT	;STACK PREVIOUS REPEAT POINTER
	MOVEM	ARG,REPPNT	;STORE NEW POINTER
	TDZA	SDEL,SDEL	;YES, INITIALIZE BRACKET COUNT AND SKIP

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

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

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

REPMAB:	HRROI	RC,[SIXBIT /MBR MISSING OPEN ANGLE BRACKET FOR REPEAT@/]	;[373]
	JUMP1	.+2		;[373] ONLY COUNT ERROR ON PASS 2
	AOS	ERRCNT		;[373] INCREMENT ERROR COUNT
	JRST	ERRNE0		;[373] COMMON MESSAGE


REPZ:	FORERR	(SDEL,REP)
	SETOM	INREP
REPZ0:	PUSHJ	PP,GCHAR	;[425] GET STARTING <
	PUSHJ	PP,COMTST	;[425] IGNORE COMMENTS
	SKIPN	COMSW		;[425] INSIDE A COMMENT?
	CAIG	C," "		;[425] TEXT-FORMATTING CHARACTER?
	JRST	REPZ0		;[425] YES, GET NEXT
	CAIE	C,"<"		;[425] < ?
	JRST	CORMAB		;[425] NO, ERROR
	MOVEI	SDEL,1		;[425] SET COUNT
REPZ1:	PUSHJ	PP,GCHAR	;GET NEXT CHARACTER
	CAIN	C,"<"		;"<"?
	AOJA	SDEL,REPZ1	;YES, INCREMENT COUNT
	CAIN	C,">"		;">"?
	SOJLE	SDEL,REPZ2	;YES, EXIT IF MATCHING
	JRST	REPZ1		;NO, RECYCLE
REPZ2:	SETZM	INREP		;FLAG OUT OF IT
	SETZM	INCND		;AND CONDITIONAL ALSO
	JRST	STMNT		;AND EXIT

REPO:	PUSHJ	PP,GCHAR	;GET "<"
	PUSHJ	PP,COMTST	;[425] IGNORE COMMENTS
	SKIPN	COMSW		;[425] INSIDE A COMMENT?
	CAIG	C," "		;[425] TEXT-FORMATTING CHARACTER?
	JRST	REPO		;[425] YES, GET NEXT
	CAIE	C,"<"		;[425] < ?
	JRST	CORMAB		;[425] NO, ERROR
	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

CORMAB:	HRROI	RC,[SIXBIT /MBC MISSING OPEN ANGLE BRACKET FOR CONDITIONAL OR REPEAT@/]	;[425]
	JUMP1	.+2		;[425] ONLY COUNT ERROR ON PASS 2
	AOS	ERRCNT		;[425] INCREMENT ERROR COUNT
	JRST	ERRNE0		;[425] COMMON MESSAGE

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

CPEEK:	TLNN	IO,IOPALL	;IF LALL IS ON
	JRST	DEF33		;JUST RETURN
	PUSH	PP,CS		;NEED TO SAVE CS, SINCE CHARAC MAY DESTROY IT
	PUSHJ	PP,PEEK		;LOOK AT NEXT CHAR.
	POP	PP,CS		;RESTORE CS
	CAIN	C,";"		;IS IT ;;?
	JRST	CPEEK0		;[325] YES, GO SCAN LINE MATCHING ANGLE BRAKETS
	MOVE	C,CS		;RESTORE C
	JRST	DEF33		;AND RETURN

CPEEK0:	SETZM	CPEEKC		;[325] CLEAR MATCHING ANGLE COUNTER
CPEEK1:	PUSHJ	PP,GCHAR	;[325] GET A CHARACTER
	CAIN	C,"<"		;[325] SEE IF LEFT ANGLE
	AOJA	SDEL,CPEEKL	;[325] YES, GO ADD TO COUNT
	CAIN	C,">"		;[325] SEE IF RIGHT ANGLE
	SOJA	SDEL,CPEEKR	;[325] YES, GO SUBTRACT FROM COUNT
	CAIG	C,CR		;[325] SEE IF AN
	CAIGE	C,LF		;[325]  END OF LINE CHARACTER
	JRST	CPEEK1		;[325] NO, CONTINUE
CPEK1A:	SKIPL	CPEEKC		;[347] YES, SEE IF UNMATCHED ANGLES
	JRST	CPEEK3		;[332] NO, GO SEE IF END OF MACRO
	PUSH	PP,C		;[325] SAVE EOL CHARACTER
CPEEK2:	MOVEI	C,">"		;[325] SET TO PUT IN SOME RIGHTS
	PUSHJ	PP,WCHAR	;[325] GO DO ONE
	AOSGE	CPEEKC		;[325] SEE IF ENOUGH
	JRST	CPEEK2		;[325] NO, LOOP
	POP	PP,C		;[325] RECOVER EOL CHARACTER
CPEEK3:	JUMPL	SDEL,DEF70	;[332] IF END OF MACRO, LEAVE COMPLETELY
	JRST	DEF32		;[325] AND GET OUT OF LINE

CPEEKL:	AOS	CPEEKC		;[325] ADD IN LEFT ANGLE BRACKET
	JRST	CPEEK1		;[325] TO NEXT CHARACTER
CPEEKR:
	JUMPL	SDEL,CPEK1A	;[366] JUMP IF END OF MACRO
	SOS	CPEEKC		;[325],[347]SUBTRACT OUT RIGHT BRACKET
	JRST	CPEEK1		;[347]CONTINUE
DEF40:	MOVEI	AC0,0		;CLEAR ATOM
	MOVSI	AC1,(POINT 6,AC0)	;SET POINTER
DEF42:	PUSH	PP,C		;STACK CHARACTER
	TLNE	AC1,770000	;HAVE WE STORED 6?
	IDPB	CS,AC1		;NO, STORE IN ATOM
	PUSHJ	PP,GCHAR	;GET NEXT CHARACTER
	MOVE	CS,C
	CAIG	CS,"Z"+40
	CAIGE	CS,"A"+40
	JRST	.+2
	SUBI	CS,40		;CONVERT LOWER TO UPPER
	CAIL	CS,40
	CAILE	CS,77+40
	JRST	DEF44		;TEST SPECIAL
	MOVE	CS,CSTAT-40(CS)	;GET STATUS
	TLNE	CS,6		;ALPHA-NUMERIC?
	JRST	DEF42		;YES, GET ANOTHER
DEF44:	PUSH	PP,[0]		;NO, MARK THE LIST
	MOVE	SX,PPTMP1	;GET POINTER TO TOP

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

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

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

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

MAC10:	PUSHJ	PP,GCHAR	;GET A CHARACTER, LOOK FOR AN ARG
	JUMPE	SDEL,MAC11	;[137] SKIP TEST IF IN ()
	CAIG	C,CR
	CAIGE	C,LF
	CAIN	C,";"		;";"?
	JRST	MAC21		;YES, END OF ARGUMENT STRING

MAC11:	IFE TENEX,<
	SKIPN	DECTAB		;[372] TREAT LEADING TAB UNDER .XTABM AS SPECIAL CASE
	JRST	MAC11A		;[372]
>
	CAIN	C,11		;[372] FLUSH TABS
	JRST	MAC10		;[372]
MAC11A:	SKIPLE	SX		;[372] [137] SKIP IF NO ARGS LEFT
	PUSHJ	PP,SKELI1	;NO, INITIALIZE SKELETON
	CAIN	C,"<"		;"<"?
	JRST	MAC30		;YES, PROCESS AS SPECIAL
	CAIE	C,176
	CAIN	C,134		;"\"
	JRST	MAC40		;YES, PROCESS SYMBOL

MAC14:	CAIN	C,","		;","?
	JRST	MAC16		;YES; NULL SYMBOL
IFE TENEX,<
	SKIPN	DECTAB		;DO TABS DEC'S WAY?
	JRST	.+3		;YES
>
	CAIN	C,11		;FLUSH TABS
	JRST	MAC14A
	JUMPL	SDEL,MAC14B	;[137] IGNORE TEST FOR () IF NOT INSIDE ()
	CAIN	C,"("		;"("?
	ADDI	SDEL,1		;YES, INCREMENT COUNT
	CAIN	C,")"		;")"?
	SOJL	SDEL,MAC16	;YES, TEST FOR END
MAC14B:	SKIPLE	SX		;[137] IGNORE IF NO ARGS LEFT
	PUSHJ	PP,WCHAR	;WRITE INTO SKELETON
MAC14A:	PUSHJ	PP,CHARAC	;GET NEXT CHARACTER
MAC14E:				;[262] INCASE WE REACHED MACEND
	JUMPG	SDEL,MAC14	;[137] IGNORE TEST IF IN ()
	CAIG	C,CR
	CAIGE	C,LF
	JRST	.+2
	JRST	MAC15		;TEST FOR END OF LINE
	CAIE	C,";"		;";"?
	JRST	MAC14		;NO
				;YES, END OF LINE

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

MAC21E:	MOVEM	C,(MP)		;REPLACE -1 WITH TREE POINTER
	AOS	1(C)		;INCREMENT REFERENCE
MAC21C:	SOJG	SX,MAC21A
MAC21B:	PUSH	MP,[0]		;SET TERMINAL
	HRRZ	C,LIMBO
	TLNN	IO,IOSALL	;SUPPRESSING ALL?
	JRST	MAC23		;NO
	JUMPN	MRP,MAC27	;IN MACRO?
	PUSHJ	PP,SEMSRC	;CHECK FOR IMMEDIATE COMMENT
	  JRST	MAC26		;NOT FOUND, CONTINUE
MAC22:	PUSHJ	PP,CHARAC	;YES,GET IT INTO THE LBUF
	CAIG	C,CR		;LESS THAN CR?
	CAIGE	C,LF		;AND GREATER THAN LF?
	JRST	MAC22		;NO GET ANOTHER
MAC26:	PUSHJ	PP,DECLBP	;DECREMENT LINE BUFFER POINTER
MAC27:	HRLI	C,-1		;SET FLAG
	JRST	MAC25

MAC23:	MOVEI	SX,"^"
	DPB	SX,LBUFP	;SET ^ INTO LINE BUFFER
	JUMPAD	MAC25		;BRANCH IF ADDRESS FIELD
	JUMPN	MRP,MAC25	;BRANCH IF ALREADY IN A MACRO
	SKIPN	LITLVL		;[215] BRANCH IF WITHIN A LITERAL
	SKIPE	RPOLVL		;[215] OR IN A REPEAT
	JRST	MAC25
	PUSHJ	PP,RSW3		;OUTPUT C AGAIN (OVERWRITTEN BY "^")
	PUSHJ	PP,SEMSRC	;LOOK FOR A COMMENT
	  JRST	MAC24		;NO COMMENT CONTINUE
	PUSHJ	PP,STOUT	;LIST COMMENT OR CR-LF
	TLNE	IO,IOPALL	;MACRO EXPANSION SUPPRESSION?
	TLO	IO,IOMAC	;  NO, SET TEMP BIT
	TDOA	C,[-1]		;FLAG LAST CHARACTER
MAC24:	PUSHJ	PP,DECLBP	;DECREMENT BYTE POINTER
MAC25:	PUSH	MP,MACPNT
	POP	PP,MACPNT
	PUSH	MP,C
	PUSH	MP,RCOUNT	;STACK WORD COUNT
	PUSH	MP,MRP		;STACK MACRO POINTER
	POP	PP,MRP		;SET NEW READ POINTER
	EXCH	MP,RP
	AOS	MACLVL
	HRRZS	MACENL		;RESET "CALLM IN PROGRESS"
	JUMPOC	STMNT2		;OP-CODE FIELD
	JRST	EVATOM		;ADDRESS FIELD

;ROUTINE TO LOOK FOR A SEMICOLON, IGNORING SPACES AND TABS
; SKIP IF FOUND

	PUSHJ	PP,CHARAC	;FETCH ANOTHER CHARACTER
SEMSRC:	CAIE	C," "		;SPACE?
	CAIN	C,"	"	;OR TAB?
	JRST	.-3		;YES, GET ANOTHER CHARACTER
	CAIN	C,";"		;NO, SEMICOLON?
	AOS	(PP)		;YES, SKIP RETURN
	POPJ	PP,

;ROUTINE TO DEVREMENT BYTE POINTER LBUFP

DECLBP:	HRLZI	SX,70000	;INCREASE P FIELD BY 1 BYTE
	ADDB	SX,LBUFP
	JUMPGE	SX,CPOPJ	;RETURN IF NO OVERFLOW
	HRLOI	SX,347777	;OVERFLOW, BACKUP ONE WORD
	ADDM	SX,LBUFP
	POPJ	PP,
MAC30:	MOVEI	AC0,0		;INITIALIZE BRACKET COUNTER
MAC31:	PUSHJ	PP,GCHAR	;GET A CHARACTER
	CAIN	C,"<"		;"<"?
	ADDI	AC0,1		;YES, INCREMENT COUNT
	CAIN	C,">"		;">"?
	SOJL	AC0,MAC14A	;YES, EXIT IF MATCHING
	SKIPLE	SX		;[137] IGNORE IF NO ARGS LEFT
	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:	JUMPLE	SX,CPOPJ	;[137] NO ARGS LEFT
	MOVE	C,V
MAC44:	LSHC	C,-^D35
	LSH	CS,-1
	DIVI	C,0(RX)		;DIVIDE BY CURRENT RADIX
	HRLM	CS,0(PP)
	JUMPE	C,.+2		;TEST FOR END
	PUSHJ	PP,MAC44
	HLRZ	C,0(PP)
	ADDI	C,"0"		;FORM TEXT
	JRST	WCHAR		;WRITE INTO SKELETON
MACEN0:	SOS	MACENL
MACEND:	HRRZ	C,0(PP)		;[262] GET TOP ADDRESS
	CAIN	C,MAC14E	;[262] WERE WE LOOKING FOR CLOSE PAREN?
	JUMPGE	SDEL,MPAERR	;[262] YES, GIVE USEFUL ERROR MESSAGE
	SKIPGE	C,MACENL	;TEST "CALLM IN PROGRESS"
	AOS	MACENL		;INCREMENT END LEVEL AND EXIT
	JUMPL	C,REPEA8
	EXCH	MP,RP
	POP	MP,MRP		;RETRIEVE READ POINTER
	POP	MP,RCOUNT	;AND WORD COUNT
	MOVEI	C,"^"
	SKIPL	0(MP)		;TEST FLAG
	PUSHJ	PP,RSW2		;MARK END OF SUBSTITUTION
	POP	MP,C
	POP	MP,ARG
	SKIPA	MP,MACPNT	;RESET MP AND SKIP
MACEN1:	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
MACEN2:	AOS	V,MACPNT	;GET POINTER
	MOVE	V,0(V)
	JUMPG	V,MACEN1	;IF >0, DECREMENT REFERENCE
	JUMPL	V,MACEN2	;IF <0, BYPASS
	POP	MP,V		;IF=0, RETRIEVE POINTER
	PUSHJ	PP,REFDEC	;DECREMENT REFERENCE
	MOVEM	ARG,MACPNT
	EXCH	MP,RP
	SOS	MACLVL
	SKIPN	MACENL		;CHECK UNPROCESSED END LEVEL
	JRST	MACEN3		;NONE TO PROCESS
	TRNN	MRP,-1		;MRP AT END OF TEXT
	JRST	MACEN0		;THEN POP THE MACRO STACK NOW
MACEN3:	TRNN	C,77400		;SALL FLAG?
	HRLI	C,0		;YES,TURN IT OFF
	JUMPL	C,REPEA8	;IF FLAG SET SUBSTITUTE
	JRST	RSW2
IRP0:	SKIPN	MACLVL		;ARE WE IN A MACRO?
	JRST	ERRAX		;NO, BOMB OUT
IRP10:	PUSHJ	PP,MREADS	;YES, GET DATA SPEC
	CAIE	C,40		;SKIP LEADING BLANKS
	CAIN	C,"("		;"("?
	JRST	IRP10		;YES, BYPASS
	CAIN	C,11
	JRST	IRP10
	CAIE	C,177		;NO, IS IT SPECIAL?
	JRST	ERRAX		;NO, ERROR
	PUSHJ	PP,MREADS	;YES
	TRZN	C,100		;CREATED?
	JRST	ERRAX
	CAIL	C,40		;TOO BIG?
	JRST	ERRAX
	ADD	C,MACPNT	;NO, FORM POINTER TO STACK
	PUSH	MP,IRPCF	;STACK PREVIOUS POINTERS
	PUSH	MP,IRPSW
	PUSH	MP,IRPARP
	PUSH	MP,IRPARG
	PUSH	MP,IRPCNT
	PUSH	MP,0(C)
	PUSH	MP,IRPPOI

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

IRP15:	PUSHJ	PP,MREADS	;[351] GET A CHARACTER LOOKING FOR "<"
	CAIE	C,"<"		;"<"?
	JRST	[CAIE	C,","	;[426] IGNORE COMMA
		CAIG   C," "	;[351] IGNORE TEXT-FORMATTING CHARACTERS
		JRST	IRP15	;[351]
		CAIE	C,")"	;[361] IGNORE CLOSE PARENTHESIS
		CAIN	C,">"	;[426] IGNORE RIGHT ANGLE BRACKET
		JRST	IRP15	;[354] GO BACK FOR ANOTHER
		JRST	IRPMBI]	;[351] CAN'T FIND BRACKET (OR ILL CHAR)
	PUSHJ	PP,SKELI1	;INITIALIZE NEW STRING
	MOVEM	ARG,IRPPOI	;SET NEW POINTER

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

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

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

IRPSE4:	MOVSI	CS,(BYTE (7) 177,2)
	PUSHJ	PP,WWRXE	;WRITE END
	MOVEM	MRP,IRPARG	;SAVE POINTER
	MOVE	MRP,RCOUNT	;SAVE COUNT
	MOVEM	MRP,IRPCNT
	HRRZ	MRP,IRPPOI	;SET FOR NEW SCAN
	AOJA	MRP,REPEA8	;ON ARG COUNT

IRPMBI:	PUSHJ PP,EFATAL		;[351]FATAL ERROR,TYPE ?MCR
	MOVE	AC0,CALNAM	;[351]FETCH MACRO NAME
	SKIPN	IRPCF		;[354] IRPC?
	JRST	[MOVSI	RC,[SIXBIT/MBI MISSING OPEN BRACKET FOR IRP INSIDE MACRO@/]	;[354] NO
		JRST	IRPERR]	;[354]
	MOVSI	RC,[SIXBIT/MBI MISSING OPEN BRACKET FOR IRPC INSIDE MACRO@/] ;[351]
IRPERR:	PUSHJ	PP,TYPMSG	;[354] [351]OUTPUT MESSAGE
	JUMP1	.+2		;[351]ONLY COUNT ERROR ONCE
	AOS	ERRCNT		;[351]DO DURING PASS2
	JRST	ERRNE2		;[351]COMMON MESSAGE
STOPI0:	SKIPN	IRPARP		;IRP IN PROGRESS?
	JRST	ERRAX		;NO, ERROR
	SETZM	IRPSW		;YES, SET SWITCH
	POPJ	PP,

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

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

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

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

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

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

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

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

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

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

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

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

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

REFDEC:	JUMPLE	V,DECERR	;CATASTROPHIC ERROR SOMEWHERE
	SOS	CS,1(V)		;DECREMENT REFERENCE
	TRNE	CS,000777	;IS IT ZERO?
	POPJ	PP,		;NO, EXIT
	CAMGE	V,UNITOP	;[225] IS THIS IN UNIV AREA?
	JRST	[AOS	1(V)	;[371][225] YES, PUT IT BACK TO DEFINING REFERENCE COUNT
		POPJ	PP,]	;[371] AND DO NOT DELETE IT
	HRRZ	CS,0(V)		;YES, GET POINTER TO END
	HRL	CS,NEXT		;GET POINTER TO NEXT RE-USABLE
	HLLM	CS,0(CS)	;SET LINK
	HRRM	V,NEXT		;RESET NEXT
	POPJ	PP,

DECERR:	PUSHJ	PP,EFATAL	;OUTPUT CR-LF ? MCR
	MOVE	AC0,CALNAM	;GET MACRO NAME
	MOVSI	RC,[SIXBIT /EWE ERROR WHILE EXPANDING@/]
	PUSHJ	PP,TYPMSG
	JRST	ERRNE2		;COMMON MESSAGE

MPAERR:	PUSHJ	PP,EFATAL	;OUTPUT CR-LF ? MCR
	MOVE	AC0,CALNAM	;GET MACRO NAME
	MOVSI	RC,[SIXBIT /MPA MISSING CLOSE PAREN AROUND ARG LIST OF@/]
	PUSHJ	PP,TYPMSG
	JRST	ERRNE2		;COMMON MESSAGE
A==	0			;ASCII MODE
AL==	1			;ASCII LINE MODE
IB==	13			;IMAGE BINARY MODE
B==	14			;BINARY MODE

;  ==   0			;USED BY HELPER AND GETSEGS
CTL==	1			;CONTROL DEVICE NUMBER
IFN CCLSW,<CTL2==5		;INPUT DEV FOR CCL FILE>
BIN==	2			;BINARY DEVICE NUMBER
CHAR==	3			;INPUT DEVICE NUMBER
LST==	4			;LISTING DEVICE NUMBER
UNV==	6			;SYMBOL TABLE FILE (UNIVERSAL)

;	COMMAND STRING ACCUMULATORS

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

TIO==	6

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

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

;GETSTS ERROR BITS

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

SYN	.TEMP,PPN
SUBTTL	I/O ROUTINES
BEG:
IFN CCLSW,<TLZA	IO,ARPGSW	;DON'T ALLOW RAPID PROGRAM GENERATION
	TLO	IO,ARPGSW	;ALLOW RAPID PROGRAM GENERATION>
IFN PURESW,<
	MOVE	MRP,[XWD LOWL,LOWL+1]	;START OF DATA
	SETZM	LOWL		;ZERO FIRST WORD
	BLT	MRP,LOWEND	;AND THE REST
	MOVE	MRP,[XWD LOWH,LOWL] ;PHASED CODE
	BLT	MRP,LOWL+LENLOW	;MOVE IT IN>
	HRRZ	MRP,.JBREL	;GET LOWSEG SIZE
IFN TENEX,<
	CAIL	MRP,377777	;[206] DO WE HAVE ALL OF CORE?
	JRST	.+4		;[206] YES
	MOVEI	MRP,377777	;[206] NO, MAY AS WELL GET IT
	CORE	MRP,		;[206] IT WILL SAVE EXPANSION LATER
	  JFCL			;[206] TOO BAD
	HRRZ	MRP,.JBREL	;[206] GET HIGHEST LOC
>
	MOVEM	MRP,MACSIZ	;SAVE CORE SIZE
				;DECODE VERSION NUMBER
	MOVEI	PP,JOBFFI	;TEMP PUSH DOWN STACK
	PUSH	PP,[0]		;MARK BOTTOM OF STACK
	LDB	0,[POINT 3,.JBVER,2]	;GET USER BITS
	JUMPE	0,GETE		;NOT SET IF ZERO
	ADDI	0,"0"		;FORM NUMBER
	PUSH	PP,0		;STACK IT
	MOVEI	0,"-"		;SEPARATE BY HYPHEN
	PUSH	PP,0		;STACK IT ALSO
GETE:	HRRZ	0,.JBVER	;GET EDIT NUMBER
	JUMPE	0,GETU		;SKIP ALL THIS IF ZERO
	MOVEI	1,")"		;ENCLOSE IN PARENS.
	PUSH	PP,1
GETED:	IDIVI	0,8		;GET OCTAL DIGITS
	ADDI	1,"0"		;MAKE ASCII
	PUSH	PP,1		;STACK IT
	JUMPN	0,GETED		;LOOP TIL DONE
	MOVEI	0,"("		;OTHER PAREN.
	PUSH	PP,0
GETU:	LDB	0,[POINT 6,.JBVER,17]	;UPDATE NUMBER
	JUMPE	0,GETV		;SKIP IF ZERO
	IDIVI	0,^D26		;[224] MIGHT BE TWO DIGITS
	ADDI	1,"@"		;FORM ALPHA
	PUSH	PP,1
	JUMPN	0,GETU+1	;LOOP IF NOT DONE
GETV:	LDB	0,[POINT 9,.JBVER,11]	;GET VERSION NUMBER
	IDIVI	0,8		;GET DIGIT
	ADDI	1,"0"		;TO ASCII
	PUSH	PP,1		;STACK
	JUMPN	0,GETV+1	;LOOP
	MOVE	1,[POINT 7,VBUF+1,20]	;POINTER TO DEPOSIT IN VBUF
	POP	PP,0		;GET CHARACTER
	IDPB	0,1		;DEPOSIT IT
	JUMPN	0,.-2		;KEEP GOING IF NOT ZERO
IFN FORMSW,<IFE DFRMSW,<
	SETOM	PHWFMT		;HALF WORD UNLESS CHANGED BY SWITCH>>
IFN CCLSW,<
	TLZA	IO,CRPGSW	;SET TO INIT NEW COMMAND FILE
M:	TLNN	IO,CRPGSW	;CURRENTLY DOING RPG?>
IFE CCLSW,<M:>
	RESET			;INITIALIZE PROGRAM
	SETZM	BINDEV		;CLEAR INCASE NOT USED NEXT TIME
	SETZM	LSTDEV		;SAME REASON
	SETZM	INDEV		;INCASE OF ERROR
	HRRZ	MRP,MACSIZ	;GET INITIAL SIZE
	CORE	MRP,		;BACK TO ORIGINAL SIZE
	  JFCL			;SHOULD NEVER FAIL
	SETZB	MRP,PASS1I
	MOVE	[XWD PASS1I,PASS1I+1]
	BLT	PASS2X-1	;ZERO THE PASS1 AND PASS2 VARIABLES
	MOVEI	PP,JOBFFI	;SET TEMP PUSH-DOWN POINTER
IFN FORMSW,<
	MOVE	CS,PHWFMT	;GET DEFAULT VALUE (PERMANENT)
	MOVEM	CS,HWFMT	;SET IT (TEMP) >
	MOVE	CS,[POINT 7,DBUF,6]	;INITIALIZE FOR DATE
	MSTIME	2,		;GET TIME FROM MONITOR
	PUSHJ	PP,TIMOUT	;TIME FORMAT OUTPUT
	DATE	1,		;GET DATE
	IBP	CS		;PASS OVER PRESET SPACE
	PUSHJ	PP,DATOUT	;DATE FORMAT OUTPUT
	MOVSI	FR,P1!CREFSW
IFN CCLSW,<TLNE	IO,CRPGSW	;RPG IN PROGRESS?
	JRST	GOSET		;YES, GO READ NEXT COMMAND
	TLNE	IO,ARPGSW	;NO, RPG ALLOWED?
	JRST	RPGSET		;YES, GO TRY
CTLSET:	RELEASE	CTL2,		;IN CASE OF LOOKUP FAILURE>
IFE CCLSW,<CTLSET:>
	MOVSI	IO,IOPALL	;ZERO FLAGS
	INIT	CTL,AL		;INITIALIZE USER CONSOLE
	SIXBIT	/TTY/
	XWD	CTOBUF,CTIBUF
	  EXIT			;NO TTY, NO ASSEMBLY
	MOVSI	C,'TTY'
	DEVCHR	C,		;GET CHARACTERISTICS
	TLNN	C,10		;IS IT REALLY A TTY
	EXIT			;NO
	INBUF	CTL,1		;INITIALIZE SINGLE CONTROL
	OUTBUF	CTL,1		;BUFFERS
	PUSHJ	PP,CRLF		;OUTPUT CARRIAGE RETURN - LINE FEED
	MOVEI	C,"*"
	IDPB	C,CTOBUF+1
	OUTPUT	CTL,
	MOVE	AC1,[POINT 7,CTLBUF]	;BYTE POINTER TO STORE COMMAND
	MOVEI	AC2,1		;[277] INITIALIZE CHARACTER COUNT
CTLS2:	SOSGE	CTIBUF+2	;USUAL SOSG LOOP ON TTY INPUT
	INPUT	CTL,		;GET NEXT BUFFER
	ILDB	0,CTIBUF+1	;GET CHARACTER
	CAIL	AC2,CTLSIZ	;NUMBER OF CHARS. ALLOWED
	JRST	COMERR		;COMMAND LINE TOO LONG
	CAIN	0,CZ		;TEST FOR ^Z
	JRST	CZSTOP		;MONRET TYPE EXIT
	IDPB	0,AC1		;STORE CHAR.
	CAIE	0,33		;TEST FOR ALTMODE
	CAIG	0,FF		;TEST FOR EOL CHAR
	CAIGE	0,LF		;ONE OF FF, VT, OR LF
	AOJA	AC2,CTLS2	;NOT END OF LINE YET
	MOVEM	AC2,CTIBUF+2	;RESET CHAR. COUNT
	MOVE	AC1,[POINT 7,CTLBUF]	;BYTE POINTER TO STORE COMMAND
	MOVEM	AC1,CTIBUF+1	;RESET BYTE POINTER
IFN CCLSW,<JRST BINSET		;BEGIN WITH BINARY FILE

RPGSET:
IFN TEMP,<HRRZ	3,.JBFF		;GET START OF BUFFER AREA
	HRRZ	0,.JBREL	;GET TOP OF CORE
	CAIGE	0,200(3)	;WILL BUFFER FIT?
	JRST	[ADDI 0,200		;NO, GET ENUF CORE
		CORE	0,		;CORE UUO
		JRST	XCEED2		;FAILED, SO GIVE UP
		JRST	.+1]		;CONTINUE
	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,[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,.JBFF		;FIX JOBFF SO FILE WONT BE KILLED
	IMULI	0,5		;CALCULATE CHARACTER COUNT
	ADDI	0,1		;SINCE SOSG HAPPENS AFTER NOT BEFORE
	MOVEM	0,CTLBLK+2	;SET UP CHAR CNT IN BUFFER HEADER
	MOVEI	0,440700	;SET UP BYTE POINTER IN HEADER
	HRLM	0,CTLBLK+1	;BUFFER HEADER NOW SET UP
	SETOM	TMPFLG		;MARK THAT A TMPCOR UUO WAS DONE
	JRST	RPGS2A		;CONTINUE IN MAIN STREAM
RPGTMP:	SETZM	TMPFLG		;JUST IN CASE>
	INIT	CTL2,AL		;LOOK FOR DISK
	SIXBIT	/DSK/		;...
	XWD	0,CTLBLK	;...
	  JRST	CTLSET		;DSK NOT THERE
	HRLZI	3,'MAC'		;###MAC
	MOVEI	3		;COUNT
	PJOB	AC1,		;RETURNS JOB NO. TO AC1
RPGLUP:	IDIVI	AC1,12		;CONVERT
	ADDI	AC2,"0"-40	;SIXBITIZE IT
	LSHC	AC2,-6		;
	SOJG	0,RPGLUP	;3 TIMES
	MOVEM	3,CTLBUF	;###MAC
	HRLZI	'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	.JBFF		;REMEMBER WHERE BINARY BUFFERS BEGIN
	MOVEM	SAVFF		;...
	HRRZ	.JBREL		;TOP OF CORE
	CAMLE	MACSIZ		;SEE IF IT HAS GROWN
	MOVEM	MACSIZ		;PREVENTS ADDRESS CHECK ON EXIT
	TLNE	IO,CRPGSW	;ARE WE ALREADY IN RPG MODE?
	JRST	M		;MUST HAVE COME FROM @ COMMAND, RESET

GOSET:	MOVSI	IO,IOPALL!CRPGSW	;SET INITIAL FLAGS
	MOVEI	CS,CTLSIZ	;MAXIMUM CHARS IN A LINE
	MOVE	AC1,CTLBLK+2	;NUMBER OF CHARACTERS
	MOVEM	AC1,CTIBUF+2	;SAVE FOR PASS 2
	MOVE	AC1,[POINT 7,CTLBUF]	;WHERE TO STASH CHARS
	MOVEM	AC1,CTIBUF+1	;...
GOSET1:	SOSG	CTLBLK+2	;ANY MORE CHARS?
	PUSHJ	PP,[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 /ECF ERROR READING COMMAND FILE@/]
			JRST ERRFIN]		;GO COMPLAIN
		   PUSHJ PP,DELETE	;CMD FILE
		   EXIT]		;EOF AND FINISHED
	ILDB	C,CTLBLK+1	;GET NEXT CHAR
	MOVE	RC,@CTLBLK+1	;CHECK FOR SEQUENCE NUMBERS
	TRNE	RC,1		;...
	JRST	[AOS	CTLBLK+1	;SKIP OVER ANOTHER 5 CHARS
		MOVNI	RC,5		;...
		ADDM	RC,CTLBLK+2	;...
		JRST	GOSET1	]	;GO READ ANOTHER CHAR
	JUMPE	C,GOSET1	;IGNORE NULLS
	CAIE	C," "		;[131] IGNORE SPACES
	CAIN	C,"	"	;[131] AND TABS
	JRST	GOSET1		;[131] ALSO, SAVES SPACE AND COMMAND ERROR
	IDPB	C,CTIBUF+1	;STASH AWAY
	AOS	CTIBUF+2	;INCREMENT CHAR. COUNT
	CAIE	C,12		;LINE FEED OR
	CAIN	C,175		;ALTMODE?
	JRST	GOSET2		;YES, FINISHED WITH COMMAND
	CAIE	C,176
	CAIN	C,33
	JRST	GOSET2		;ALTMODE.
	SOJG	CS,GOSET1	;GO READ ANOTHER
	JRST	COMERR		;GO COMPLAIN

GOSET2:	MOVEI	C,12		;MAKE SURE THERE'S A LF
	IDPB	C,CTIBUF+1	;...
	MOVEM	AC1,CTIBUF+1	;SET POINTER TO BEGINNING
	AOS	CTIBUF+2	;ADD I TO COUNT
	MOVE	SAVFF		;RESET JOBFF FOR NEW BINARY
	MOVEM	.JBFF		;...
	JRST	BINSET
RPGS1:	PUSHJ	PP,DELETE	;DELETE COMMAND FILE
	MOVEM	ACDEV,RPGDEV	;GET SET TO INIT
	OPEN	CTL2,RPGINI	;DO IT
	JRST	EINIT		;ERROR
	MOVEM	ACFILE,INDIR	;USE INPUT BLOCK
	MOVEM	ACPPN,INDIR+3	;SET PPN 
	HLLZM	ACEXT,INDIR+1	;SET FILE EXTENSION
	JUMPN	ACEXT,RPGS1A	;[132] EXPLICIT EXTENSION GIVEN, USE IT
IFE STANSW,<MOVSI ACEXT,'CCL'	;IF BLANK TRY CCL>
IFN STANSW,<MOVSI ACEXT,'RPG'	;IF BLANK TRY RPG>
	HLLZM	ACEXT,INDIR+1	;[132] STORE DEFAULT EXT
	LOOKUP	CTL2,INDIR	;[132]
	  SKIPA	ACEXT,INDIR+1	;[132] FAILED, PICKUP EXT AND ERROR CODE
	JRST	RPGS1B		;[132] SUCCESS
	TRNE	ACEXT,-1	;[132] CHECK FOR ERROR CODE OTHER THAN 0
	JRST	RPGLOS		;[132] YES, YOU LOSE
	SETZB	ACEXT,INDIR+1	;[132] TRY NULL EXT
RPGS1A:	LOOKUP	CTL2,INDIR	;[132]
	  JRST	RPGLOS		;[132] TOTAL FAILURE
RPGS1B:	HLRM	ACEXT,EXTMP	;[132] SAVE THE EXTENSION
	HLRZ	.JBSA		;RESET JOBFF TO ORIGINAL
	MOVEM	.JBFF
	TLO	IO,CRPGSW	;TURN ON SWITCH SO WE RESET WORLD
	JRST	RPGS2		;AND GO

RPGLOS:	RELEAS	CTL2,0
	TLZ	IO,CRPGSW	;STOPS IO TO UNASGD CHAN
	JRST	ERRCF		;NO FILE FOUND
>
BINSET:	PUSHJ	PP,NAME1	;GET FIRST NAME
	  JRST	BINSE3		;NO FILE HERE
	HLLZ	ACEXT,ACEXT	;[427] DISALLOW NULL EXTENSIONS
IFN CCLSW,<CAIN	C,"!"		;WAS THIS AN IMPERATIVE?
	JRST	NUNSET		;GET THEE TO A NUNNERY
	CAIN	C,"@"		;CHECK FOR A NEW RPG FILE
	JRST	RPGS1>
	TLNN	FR,CREFSW	;CROSS REF REQUESTED?
	JRST	LSTSE1		;YES, SKIP BINARY
	CAIN	C,","		;COMMA?
	JUMPE	ACDEV,LSTSET	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	CAIN	C,"_"		;LEFT ARROW?
	JUMPE	ACDEV,LSTSE1	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	JUMPE	ACDEV,M		;IGNORE IF JUST <CR-LF>
	TLO	FR,PNCHSW	;OK, SET SWITCH
	MOVEM	ACDEV,BINDEV	;STORE DEVICE NAME
	MOVEM	ACFILE,BINDIR	;STORE FILE NAME IN DIRECTORY
	JUMPN	ACEXT,.+2	;EXTENSION SPECIFIED?
	MOVSI	ACEXT,'REL'	;NO, ASSUME RELOCATABLE BINARY
	MOVEM	ACEXT,BINDIR+1	;STORE IN DIRECTORY
	MOVEM	ACPPN,BINDIR+3	;SET PPN
	OPEN	BIN,BININI	;INITIALIZE BINARY
	  JRST	EINIT		;ERROR
	TLZE	TIO,TIOLE	;SKIP TO EOT
	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
BINSE3:	CAIN	C,"_"
	JRST	GETSET		;NO LISTING
LSTSET:	PUSHJ	PP,NAME1	;GET NEXT DEVICE
	  JRST	GETSET		;NO FILE HERE
HLLZ	ACEXT,ACEXT
	HLLZ	ACEXT,ACEXT	;[427] DISALLOW NULL EXTENSIONS
LSTSE1:	CAIE	C,"_"
	JRST	ERRCM
	TLNE	FR,CREFSW	;CROSS-REF REQUESTED?
	JRST	LSTSE2		;NO, BRANCH
	JUMPN	ACDEV,.+2	;YES, WAS DEVICE SPECIFIED?
	MOVSI	ACDEV,'DSK'	;NO, ASSUME DSK
	JUMPN	ACFILE,.+2
	MOVE	ACFILE,[SIXBIT /CREF/]
	JUMPN	ACEXT,.+2
	MOVSI	ACEXT,'CRF'
LSTSE2:	JUMPE	ACDEV,GETSET	;FORGET LISTING IF NO DEVICE SPECIFIED
	MOVE	AC0,ACDEV
	DEVCHR	AC0,		;GET CHARACTERISTICS
	TLNE	AC0,LPTBIT!DISBIT!TTYBIT
	TLNE	FR,CREFSW	; WAS CROSS-REF REQUESTED?
	AOSA	OUTSW+0*TTYSW	;NO, ASSUME TTY
	JRST	ERRCM		;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY
	TLNE	AC0,CONBIT	;CONTROLING TELETYPE LISTING?
	JRST	GETSET		;YES, BUFFER ALREADY SET
	MOVEM	ACDEV,LSTDEV	;STORE DEVICE NAME
	AOS	OUTSW+0*LPTSW	;SET FOR LPT
	MOVEM	ACFILE,LSTDIR	;STORE FILE NAME
	JUMPN	ACEXT,.+2
	MOVSI	ACEXT,'LST'
	MOVEM	ACEXT,LSTDIR+1
	MOVEM	ACPPN,LSTDIR+3	;SET PPN
	OPEN	LST,LSTINI	;INITIALIZE LISTING OUTPUT
	  JRST	EINIT		;ERROR
	TLZE	TIO,TIOLE
	MTEOT.	LST,
	TLZE	TIO,TIORW	;REWIND REQUESTED?
	MTREW.	LST,		;YES
	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
GETSET:
IFN FT.U01,<
	MOVE	3,[IOWD $USRLN,$USSTK] ; RESET THE USER PUSH DOWN STACK
	MOVEM	3,$USRPD	; SO DO IT
>;END OF FT.U01
	MOVEI	3,PDPERR
	HRRM	3,.JBAPR	;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,.JBFF	;SET BASIC POINTER
	MOVE	PP,MP
	SUB	PP,3
	MOVEM	PP,RP		;SET RP
	MOVEM	PP,SAVERP
	SUB	PP,3
IFN POLISH,<
	MOVEM	PP,POLSTK	;[164] SAVE INITIAL POLISH FIXUP STACK
	MOVEM	PP,POLPTR	;[164] ONLY CHANGE IF STACK MOVES
	SUB	PP,3		;[164]
>
	ASH	3,1		;DOUBLE SIZE OF BASIC POINTER
	HRL	PP,3
	MOVEM	PP,SAVEPP
	MOVEM	MP,SAVEMP
	SUBM	PP,3		;COMPUTE TOP LOCATION
	SKIPN	UNITOP		;IF ANY UNIVERSALS HAVE BEEN SEEN
	JRST	GETSE0		;NO
	HRRZS	3		;GET TOP OF BUFFERS AND STACKS
	CAMLE	3,UNISIZ	;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE
	JRST	UNIERR		;IT WAS, YOU LOSE
	SKIPA	3,UNITOP	;DON'T LOSE THEM
GETSE0:	HRRZM	3,UNISIZ	;STORE UNTIL A UNIVERSAL IS SEEN
	HRRZM	3,LADR		;SET START OF MACRO TREE
	HRRZM	3,FREE

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

	HRRZ	2,.JBREL	;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
IFN POLISH,<
	MOVE	@SYMBOL		;SYMBOL COUNT
	MOVEM	SGSCNT		; FOR THIS PSECT
>
	PUSHJ	PP,SRCHI	;INITIALIZE TABLE

;HERE TO TEST FOR CPU AND SET VALUE IN .CPU.
;PDP-6 = 1
;KA-10 = 2
;KI-10 = 3
;KL-10 = 4

	MOVEI	V,1		;SET VALUE TO .PDP6. FOR STARTERS
	JFCL	1,.+1		;CLEAR PC CHANGE FLAG
	JRST	.+1		;THEN CHANGE PC
	JFCL	1,.PDP6.	;IF FLAG ON, ITS A PDP6
	HRLOI	1,-2		;CHECK FOR KA-10
	AOBJP	1,.KA10.	;CHECK CARRY BETWEEN HALVES
	SETZ	1,		;CLEAR AC
	BLT	1,0		;AND TRY BLT, KI WILL BE 0 AND
	JUMPE	1,.KI10.	;KL WILL HAVE 1,,1
;	JRST	.KL10.

.KL10.:	AOS	V
.KI10.:	AOS	V
.KA10.:	AOS	V
.PDP6.:	MOVE	AC0,['.CPU. ']
	PUSHJ	PP,SSRCH	;SEE IF THERE ALREADY AND IF NOT
	  PUSHJ	PP,[MOVSI ARG,SYMF!NOOUTF!SUPRBT
		SETZ	RC,
		JRST	INSERT]		;PUT IT IN TABLE
	GETPPN	V,		;[405]GET LOGGED IN PPN
	  JFCL			;[405]ALT. RETURN
	MOVEM	V,MYPPN		;[405]AND REMEMBER IT
IFN POLISH,<
	SETZM	SGNMAX		;INIT TO ONE .PSECT
	SETZM	SGNCUR		;IT IS THE CURRENT .PSECT
	SETZM	SGNAME		;IT IS THE BLANK .PSECT
	MOVSI	1
	MOVEM	SGRELC		;SET THE RELOCATION COUNTER
	SETZM	SGATTR		;ZERO PSECT BRK AND ATTRS
	SETZM	SGDMAX		;ONE .PSECT DEEP
	SETZM	SGLIST		;IT IS THE BLANK .PSECT
>
	MOVE	[XWD CTIBUF+1,CTLSAV]	;SAVE CONTROL INPUT BUFFER
	BLT	CTLS1		;FOR RESCAN ON PASS 2
	MOVSI	'DSK'		;SET INPUT TO TAKE DSK AS DEV
	MOVEM	ACDEVX
	PUSHJ	PP,COUTI	;INIT OUTPUT JUST IN CASE
	PUSHJ	PP,INSET	;GET FIRST INPUT FILE
	  JRST	GETSE3		;ERROR

IFN CCLSW,<TLNE	IO,CRPGSW	;BUT ONLY IF DOING RPG
	TTCALL	3,[ASCIZ /MACRO:/]	;PUBLISH COMPILER NAME>
	MOVE	CS,INDIR	;SET UP NAME OF FIRST FILE
	MOVEM	CS,LSTFIL	;AS LAST PRINTED
	SETZM	LSTPGN
	JRST	ASSEMB		;START ASSEMBLY

GETSE3:	PUSHJ	PP,ERRNE
	JRST	ERRFIN
FINIS:	CLOSE	BIN,		;DUMP BUFFER
	TLNE	FR,PNCHSW	;PUNCH REQUESTED?
	PUSHJ	PP,TSTBIN	;YES, TEST FOR ERRORS
	RELEAS	BIN,
	CLOSE	LST,
	SOSLE	OUTSW+0*LPTSW	;LPT TYPE OUTPUT?
	PUSHJ	PP,TSTLST	;YES, TEST FOR ERRORS
	RELEAS	LST,
	RELEAS	CHAR,
	OUTPUT	CTL,0		;FLUSH TTY OUTPUT
	SKIPE	UNIVSN		;SKIP IF NOT ASSEMBLING UNIVERSAL
	PUSHJ	PP,UNISYM	;STORE SYMBOLS ETC. FIRST
	JRST	M		;RETURN FOR NEXT ASSEMBLY


IFN CCLSW,<
NUNSET:	JUMPN	ACDEV,.+2
	MOVSI	ACDEV,'SYS'	;USE SYS IF NONE SPECIFIED
	MOVEM	ACDEV,RUNDEV
	MOVEM	ACFILE,RUNFIL	;STORE FILE NAME
	SKIPN	SFDADD		;ANY SFD'S?
	JRST	NUNPP		;NO
	HRLI	ACPPN,RUNSFD	;FORM BLT WORD
	MOVSS	ACPPN		;BUT WRONG WAY ROUND
	BLT	ACPPN,RUNSFD+2+.SFDLN
	MOVEI	ACPPN,RUNSFD	;SET UP ADDRESS AGAIN
NUNPP:	MOVEM	ACPPN,RUNPP	;IN PPN
	PUSHJ	PP,DELETE	;COMMAND FILE
	SETZM	RUNFIL+1	;LET MONITOR CHOOSE EXT
	SETZM	RUNFIL+2	;CLEAR ALSO
	SETZM	RUNPP+1		;ZERO CORE ARG
	MOVEI	16,RUNDEV	;XWD 0,RUNDEV
	TLNE	IO,CRPGSW	;WAS RPG IN PROGRESS?
	HRLI	16,1		;YES. START NEXT AT C(.JBSA)+1

;REDUCE THE LOW SEGMENT TO 1K AND DELETE THE HIGH
;BEFORE THE RUN UUO, SAVES CORE AND TIME
	MOVE	1,[1,,RUNEND-1]	;DELETE HIGH & LOW
	MOVE	2,[RUNHI,,RUNLO]
	BLT	2,RUNDEV-1	;BLT CODE DOWN
	JRST	RUNLO		;GO TO IT

RUNHI:	PHASE	LOWL
RUNLO:!	CORE	1,		;CUT DOWN TO 1K
	  JFCL			;TOO BAD
	RUN	16,		;DO "RUN DEV:NAME"
	  HALT			;SHOULDN'T RETURN. HALT IF IT DOES

RUNDEV:!	BLOCK	1
RUNFIL:!	BLOCK	3
RUNPP:!		BLOCK	2
RUNSFD:!	BLOCK	3+.SFDLN
RUNEND:!
	DEPHASE

DELETE:	HRRZ	EXTMP		;IF THE EXTENSION
	CAIE	'TMP'		;IS  .TMP
	POPJ	PP,		;RETURN.
	CLOSE	CTL2,		;DELETE
	SETZB	4,5		;THE COMMAND FILE.
	SETZB	6,7
	RENAME	CTL2,4		;
	  JFCL
	POPJ	PP,
>
INSET:	MOVEI	JOBFFI		;POINTER TO INPUT BUFFER
	HRRM	.JBFF		;INFORM SYSTEM OF BUFFER AREA
	PUSHJ	PP,NAME2	;GET NEXT COMMAND NAME
	  POPJ	PP,		;ERROR RETURN IF NONE LEFT
	AOS	(PP)		;SUCCESS
	MOVEM	ACDEV,INDEV	;STORE DEVICE
	MOVEM	ACFILE,INDIR	;STORE FILE IN DIRECTORY
	MOVEM	ACPPN,INDIR+3	;STORE PPN BEFORE WE LOSE IT
	OPEN	CHAR,INDEVI
	  JRST	EINIT		;ERROR
	DEVCHR	ACDEV,		;TEST CHARACTERISTICS
	TLNN	ACDEV,MTABIT	;MAG TAPE?
	JRST	INSET3		;NO
	TLZN	FR,MTAPSW	;FIRST MAG TAPE IN PASS 2?
	JRST	INSET1		;NO
	TLNN	TIO,TIORW	;YES, REWIND REQUESTED?
	SUB	CS,RECCNT	;NO, PREPARE TO BACK-SPACE TAPE
INSET1:	AOS	RECCNT		;INCREMENT FILE COUNTER
	ADDM	CS,RECCNT	;UPDATE  COUNT
	TLZE	TIO,TIOLE
	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,.JBFF
	SUBI	ACPNTR,JOBFFI
	MOVEI	ACDEL,NUMBUF*203+1
	IDIV	ACDEL,ACPNTR
	INBUF	CHAR,(ACDEL)
	JUMPN	ACEXT,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
	MOVSI	ACEXT,'MAC'	;BLANK, TRY .MAC FIRST
	PUSHJ	PP,INSETI
INSET4:	  PUSHJ	PP,INSETI
	  JUMPE	ACEXT,ERRCF	;ERROR IF ZERO
	TLNE	ACDEV,TTYBIT	;TELETYPE?
	SETSTS	CHAR,AL		;YES, CHANGE TO ASCII LINE
				;DO ALL ENTERS HERE FOR LEVEL D
	SKIPE	ENTERS		;HAVE ENTERS BEEN DONE ALREADY?
	JRST	ENTRDN		;YES, DON'T DO TWICE
	SKIPN	ACEXT,LSTDEV	;IS THERE A LIST DEVICE?
	JRST	LSTSE6		;NO SO DON'T DO ENTER
	SKIPN	ACFILE,LSTDIR	;GET FILE NAME INCASE OF ERROR
	JRST	[DEVCHR	ACEXT,	
		TLNE	ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
		JRST	LSTSE4		;YES, GIVE UP BEFORE HARM IS DONE
		SKIPE	ACFILE,INDIR	;USE INPUT FILE NAME
		MOVEM	ACFILE,LSTDIR	;TOO BAD IF ZERO ALSO
		JRST	LSTSE4]
	HLLZS	ACEXT,LSTDIR+1	;EXT ALSO
	MOVE	ACPPN,LSTDIR+3	;SAVE PPN
	LOOKUP	LST,LSTDIR	;PREVIOUS ONE STILL THERE
	  JRST	LSTSE4		;NO
	SETZM	LSTDIR		;YES,CLEAR NAME
	HLLZS	LSTDIR+1
	MOVEM	ACPPN,LSTDIR+3	;RESET PPN
	RENAME	LST,LSTDIR
	CLOSE	LST,		;IGNORE FAILURE
	MOVEM	ACFILE,LSTDIR	;RESTORE NAME
	SETZM	LSTDIR+2	;CLEAR PROTECTION AND DATE
LSTSE4:	MOVEM	ACPPN,LSTDIR+3	;[246] SET PPN AGAIN
	HLLZS	LSTDIR+1	;ZERO RIGHT HALF OF EXTENSION WORD
	ENTER	LST,LSTDIR	;SET UP DIRECTORY
	  JRST	ERRCL		;ERROR
LSTSE6:	SKIPN	ACEXT,BINDEV	;A BINARY DEVICE THEN ?
	JRST	ENTRDN		;NO
	SKIPN	ACFILE,BINDIR	;INCASE OF ERROR
	JRST	[DEVCHR	ACEXT,	
		TLNE	ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
		JRST	.+1		;YES, GIVE UP BEFORE HARM IS DONE
		SKIPE	ACFILE,INDIR	;USE INPUT FILE NAME
		MOVEM	ACFILE,BINDIR	;TOO BAD IF ZERO ALSO
		JRST	.+1]
	HLLZS	ACEXT,BINDIR+1
	ENTER	BIN,BINDIR	;ENTER FILE NAME
	  JRST	ERRCB		;ERROR

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

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

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

EOT:	PUSHJ	PP,SAVEXS	;SAVE REGISTERS
	SETOM	EOFFLG		;[417]GOING THRU EOF PROCEDURE
	PUSHJ	PP,INSET	;GET THE NEXT INPUT DEVICE
	  JRST	EOT0		;ERROR
	HRROI	RC,[SIXBIT /EP1 END OF PASS 1]@/]	;ASSUME END OF PASS
	TLZN	FR,LOADSW	;ZERO ONLY ON END OF PASS 1
	HRROI	RC,[SIXBIT /LNF LOAD THE NEXT FILE]@/]	;NOT END OF PASS
	TLNE	ACDEV,(1B13!1B15)	;WAS ALL THAT WORK NECESSARY?
	JRST	RSTRXS		;NO
	PUSHJ	PP,EINFO	;CR-LF [
	PUSHJ	PP,TYPMSG	;YES

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

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

EOT0:	JUMP1	[TLON	FR,LOADSW	;PRINT MESSAGE ONCE
		PUSHJ	PP,ERRNE	;ON PASS1
		JRST	EOT1]
	AOS	ERRCNT		;COUNT AS ERROR
	TLO	FR,LOADSW	;USED TO SIGNAL  POPJ RET FROM ERRNE
	PUSHJ	PP,ERRNE	;PRINT ERROR MESSAGE
EOT1:	TLZ	IO,IORPTC
	MOVE	PP,SAVEPP	;RESTORE STACKS
	MOVE	MP,SAVERP
	MOVEM	MP,SAVERP
	MOVE	MP,SAVEMP
	AOBJN	PP,END01	;FAKE END SEEN
NAME1:	SETZM	ACDEVX		;ENTRY FOR DESTINATION
NAME2:	SETZB	ACDEV,INDIR+2	;ENTRY FOR SOURCE
	SETZB	ACFILE,PPN	;CLEAR FILE AND PPN
	HLRZ	ACDEL,ACDELX	;GET PREVIOUS DELIMITER
	SETZB	TIO,CS
	SETZB	ACEXT,INDIR+3	;RESET EXTENSION AND PROGRAM-NUMBER PAIR
	SETZM	SFDADD		;CLEAR FIRST WORD OF SFD BLOCK
	MOVE	AC0,[SFDADD,,SFDADD+1]
	BLT	AC0,SFDADD+2+.SFDLN	;AND REST OF IT
NAME3:	MOVSI	ACPNTR,(POINT 6,AC0)	;SET POINTER
	TDZA	AC0,AC0		;CLEAR SYMBOL

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

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

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

TERME:	TLZA	C,-1		;MAKE INTO 33 BUT GIVE ERROR RET
TERM:	AOS	(PP)		;GIVE SKIP RETURN ON VALID TERMINATOR
	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,
	HLLO	ACEXT,AC0	;[427] SET EXTENSION
	HRLM	C,ACDELX	;SAVE PREVIOUS DELIMITER
	JUMPN	ACDEV,.+2	;IF DEVICE SET USE IT
	SKIPA	ACDEV,ACDEVX	;OTHERWISE USE LAST DEVICE
	MOVEM	ACDEV,ACDEVX	;AND DEVICE
	SKIPN	ACPPN,PPN	;[216] PUT PPN IN RIGHT PLACE
	SKIPN	PPPN		;[216] DO WE HAVE A DEFAULT?
	JRST	TERM2		;[216] PPN IS SETUP
	MOVE	ACPPN,[PSFD,,SFDADD]	;[216] MOVE DEFAULT SFD
	BLT	ACPPN,SFDE	;[216]
	MOVE	ACPPN,PPPN	;[216] AND PPN
TERM2:	CAIN	C,"!"		;IMPERATIVE?
	POPJ	PP,		;YES, DON'T ASSUME DEV
	JUMPE	ACFILE,CPOPJ	;IF THERE IS A FILE,
	JUMPN	ACDEV,.+2	;BUT NO DEVICE
	MOVSI	ACDEV,'DSK'	;THEN ASSUME DISK
	POPJ	PP,		;EXIT

CZSTOP:	EXIT	1,		;[275]MONRET
	JRST	M		;[275]CONTINUE
ERRCM:	HRROI	RC,[SIXBIT /CME COMMAND ERROR@/]
	JRST	ERRFIN

PROGNP:	PUSHJ	PP,GETOCT	;GET AN OCTAL NUMBER IN RC
	SKIPN	RC		;[405] IF ITS 0, USE
	HLRZ	RC,MYPPN	;[405]USE LOGGED IN PROJECT NUMBER
	HRLZM	RC,PPN		;STORE IT
	CAIE	C,","		;MORE?
	JRST	PPNTST		;[216] NO, GIVE UP
	PUSHJ	PP,GETOCT	;GET AN OCTAL NUMBER
	SKIPN	RC		;[405] IF ITS 0, USE
	HRRZ	RC,MYPPN	;[405]MY PROGRAMMER NUMBER
	HRRM	RC,PPN		;STORE IT
	CAIE	C,","		;SFD'S?
	JRST	PPNTST		;[216] NO
	MOVEI	C,SFDADD	;POINT TO DDDSFD BLOCK
	EXCH	C,PPN		;SWAP WITH PPN
	MOVEM	C,SFDADD+2	;STORE IT
	MOVEI	RC,SFDADD+3	;START OF SFD AREA
SFD1:	HRRZS	RC		;CLEAR BYTE POINTER
	CAILE	RC,SFDADD+2+.SFDLN
	JRST	ERRCM		;PATH TOO LONG
	HRLI	RC,(POINT 6)	;BYTE POINTER SETUP
SFD2:	PUSHJ	PP,TTYIN	;GET CHAR
	CAIE	C,">"		;ALT FORM
	CAIN	C,"]"		;END?
	JRST	PPNTST		;[216] YES
	CAIN	C,","		;NEXT SFD
	AOJA	RC,SFD1		;YES, INCREMENT STORE ADDRESS
	SUBI	C,40		;CONVERT TO SIXBIT
	JUMPL	C,ERRCM		;ERROR
	TLNE	RC,770000	;SPACE IN WORD
	IDPB	C,RC		;YES, STORE CHAR.
	JRST	SFD2		;GET NEXT CHAR

GETOCT:	SETZ	RC,		;START WITH ZERO
GETOC1:	PUSHJ	PP,TTYIN
	CAIE	C,","		;TEST FOR COMMA
	CAIN	C,"]"		;AND CLOSE SQB
	POPJ	PP,		;YES, WEVE GOT SOMETHING
	CAIN	C,">"		;ALSO ALT FORM
	POPJ	PP,
IFE STANSW,<
	CAIL	C,"0"		;CHECK FOR VALID NUMBERS
	CAILE	C,"7"
	JRST	ERRCM		;NOT VALID
	LSH	RC,3		;SHIFT PREVIOUS RESULT
	ADDI	RC,-"0"(C)	;ADD IN NEW NUMBER>
IFN STANSW,<LSH	RC,6		;SHIFT PREVIOUS RESULT
	ADDI	RC,-40(C)	;PUT IN NEW CHARACTER>
	JRST	GETOC1		;GET NEXT CHARACTER

;[216] HERE TO TEST FOR DEFAULT PPN
PPNTST:	SKIPN	ACFILE		;SEEN FILE NAME YET?
	SKIPE	AC0		;OR PENDING
	JRST	GETIOC		;NO
	PUSH	PP,AC0		;GET AN AC
	MOVE	AC0,PPN		;GET PPN
	MOVEM	AC0,PPPN	;MAKE IT PERMANENT
	MOVE	AC0,[SFDADD,,PSFD]
	BLT	AC0,PSFDE	;SAME FOR SFDS
	POP	PP,AC0
	JRST	GETIOC
;[216] END OF EDIT
SWITC0:	PUSHJ	PP,SW1		;PROCESS CHARACTER
SWITCH:	PUSHJ	PP,TTYIN	;GET NEXT CHARACTER
	CAIE	C,")"		;END OF STRING?
	JRST	SWITC0		;NO
	JRST	GETIOC		;YES

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

HELP:	PUSH	PP,.JBFF	;SAVE REAL .JBFF
	MOVE	1,.JBREL	;USE JOBREL
	MOVEM	1,.JBFF		;SO HELPER DOESN'T DESTROY SYMBOL TABLE
	MOVE	1,['MACRO ']	;GET MACRO.HLP
	PUSHJ	PP,.HELPR	;CALL HELPER
	POP	PP,.JBFF	;RESTORE JOBFF INCASE CCL MODE
	JRST	M		;RESTART
;[227] HERE FOR /nnL SWITCH TO SET LINES/PAGE

SEELPP:	ADDI	C,"A"-"0"	;TO NUMERIC RANGE
	CAIG	C,9		;IS IT
	JUMPGE	C,.+2
	JRST	ERRCM		;NO, BARF
	MOVE	RC,C		;MOVE VALUE

SEELP1:	PUSHJ	PP,TTYIN	;GET NEXT
	CAIG	C,"9"		;IS IT NUMERIC
	CAIGE	C,"0"		;...
	JRST	SEELP2		;NO, CHECK END
	IMULI	RC,^D10		;MAKE SPACE
	ADDI	RC,-"0"(C)	;AND PUT DIGIT
	JRST	SEELP1		;AND CONTINUE

SEELP2:	CAIE	C,"L"		;END PROPERLY?
	JRST	ERRCM		;NO, BARF
	SUBI	RC,4		;EASIER FOR SYMBOL OUTPUT ROUTINES
	MOVEM	RC,..LPP	;SAVE IN "READ-ONLY"
	POPJ	PP,		;ALL DONE
	DEFINE	SETSW	(LETTER,INSTRUCTION) <	INSTRUCTION
J=	<"LETTER"-"A">-7*<I=<"LETTER"-"A">/7>
	SETCOD	\I,J>

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

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

SWTAB:
	SETSW	Z,<TLO	TIO,TIOCLD	>
	SETSW	C,<TLZ	FR,CREFSW	>
	SETSW	P,<SOS	PDP		>
SWTABT:				;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY
	SETSW	A,<ADDI	CS,1		>
	SETSW	B,<SUBI	CS,1		>
	SETSW	E,<TLZ	IO,IOPALL!IOSALL	>
IFN FORMSW,<	SETSW	F,<SETZM	HWFMT>
		SETSW	G,<SETOM	HWFMT>>
	SETSW	H,<JRST	HELP>
	SETSW	L,<TLZ	IO,IOMSTR	>
	SETSW	M,<TLO	IO,IOPALL!IOSALL	>
	SETSW	N,<HLLOS   TYPERR	>
	SETSW	O,<XCT	OFFML		>
	SETSW	Q,<TLO	FR,ERRQSW	>
	SETSW	S,<TLO	IO,IOMSTR	>
	SETSW	T,<TLO	TIO,TIOLE	>
	SETSW	U,<SETOM UNVSKP		>
	SETSW	W,<TLO	TIO,TIORW	>
	SETSW	X,<TLOA	IO,IOPALL	>
IFG .-SWTAB-37,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>

BYTAB:				;BYTAB CONTAINS AN INDEX TO SWTAB
				;IT CONSIST OF 7 5BIT 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
	+BYTAB3			;V-Z

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

COMERR:	HRROI	RC,[SIXBIT /CTL COMMAND LINE TOO LONG@/]
	JRST	ERRFIN

TTYERR:	SKIPN	INDEV		;INPUT DEVICE SEEN?
	JRST	ERRCM		;NO, SO MISSING "_"
	HRROI	C,EOL		;SIGNAL ERROR
	POPJ	PP,		;AND RETURN

ERRNE:	HRROI	RC,[SIXBIT /NES NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]
ERRNE0:	PUSHJ	PP,EFATAL	;OUTPUT CR-LF ?MCR
	PUSHJ	PP,TYPMSG	;OUTPUT IT
	SKIPE	LITLVL		;SEE IF IN LITERAL
	SKIPN	LITPG		;PAGE 0 MEANS NOT IN A LITERAL REALLY
	JRST	ERRNE1		;NO, TRY OTHERS
	MOVE	V,[XWD [SIXBIT /IN LITERAL@/],LITPG]
	PUSHJ	PP,PRNUM	;GO PRINT INFORMATION
ERRNE1:	MOVEI	V,0		;CHECK FOR OTHER PLACES
	SKIPE	INDEF
	MOVE	V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]
	SKIPE	INTXT
	MOVE	V,[XWD [SIXBIT /IN TEXT@/],TXTPG]
	SKIPE	INREP
	MOVE	V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]
	SKIPE	INCND
	MOVE	V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]
	SKIPGE	MACENL
ERRNE2:	MOVE	V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]
	JUMPN	V,ERRNE3
	MOVE	V,[XWD [SIXBIT /@/],PAGENO]	;BETTER THAN NOTHING
	SKIPE	LITLVL		;HAD ONE PAGE NUMBER ALREADY
	POPJ	PP,
ERRNE3:	PUSHJ	PP,PRNUM
	TLNE	FR,LOADSW	;SEEN END OF FILE YET?
	POPJ	PP,		;YES
	MOVE	PP,SAVEPP	;NO RESET STACK
	MOVE	MP,SAVERP
	MOVEM	MP,RP
	MOVE	MP,SAVEMP
	SETZ	MRP,
	JRST	ASSEM2		;AND CONTINUE

ERRMS1:	SIXBIT / ERRORS DETECTED@/
ERRMS2:	SIXBIT /1 ERROR DETECTED@/
ERRMS3:	SIXBIT /NO ERRORS DETECTED@/
ERRMQ1:	SIXBIT	/1 WARNING GIVEN@/
ERRMQ2:	SIXBIT	/ WARNINGS GIVEN@/
EINIT:	PUSHJ	PP,EFATAL	;[352] ?MCR
	MOVSI	CS,'DNA'	;[352]
	PUSHJ	PP,TYPSYM	;[352] DNA
	MOVEI	C," "		;[352]
	PUSHJ	PP,TYO		;[352] SPACE
	MOVE	RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]	;[352]
	JRST	ERRFN1		;[352] REST OF MESSAGE
ERRCL:	HRRZ	RC,LSTDIR+1	;GET LST DEV ERROR CODE
	JRST	.+2		;GET ERROR MESSAGE
ERRCB:	HRRZ	RC,BINDIR+1	;GET BIN DEV ERROR CODE
	JUMPN	RC,ERRTYP
	SOJA	RC,ERRTYP	;SPECIAL CASE IF ERROR CODE 0

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

ERRTYP:	CAIL	RC,TABLND-TABLE	;IS ERROR CODE LEGAL?
	SKIPA	RC,TABLND	;NO, GIVE CATCH ALL MESSAGE
	MOVE	RC,TABLE(RC)	;YES, PICK UP MESSAGE
	PUSHJ	PP,EFATAL	;PUT OUT CR-LF ?MCR
	MOVSI	CS,'LRE'	;LOOKUP-RENAME-ENTER TYPE
	PUSHJ	PP,TYPSYM
	CAIA			;SKIP CALL TO EFATAL NOW

ERRFIN:	PUSHJ	PP,EFATAL
ERRFN1:	PUSHJ	PP,TYPMSG	;[352]
	CLOSE	LST,		;GIVE USER A PARTIAL LISTING
	CLOSE	BIN,40		;BUT NEVER A BUM REL FILE
	JRST	M

EFATAL:	PUSHJ	PP,OCRLF
	MOVEI	C,"?"
	PUSHJ	PP,TYO
	MOVSI	CS,'MCR'	;IDENTIFY CUSP
IFN CCLSW,<AOS	.JBERR		;RECORD ERROR SO EXECUTION DELETED>
	PJRST	TYPSYM		;AND RETURN

EWARN:	PUSHJ	PP,OCRLF
	MOVEI	C,"%"
	PUSHJ	PP,TYO
	MOVSI	CS,'MCR'	;IDENTIFY CUSP
	PJRST	TYPSYM		;AND RETURN

EINFO:	PUSHJ	PP,OCRLF
	MOVEI	C,"["
	PUSHJ	PP,TYO
	MOVSI	CS,'MCR'	;IDENTIFY CUSP
	PJRST	TYPSYM		;AND RETURN

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

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

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

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

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

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

TYPSYM:	MOVEI	C,0		;CLEAR C
	LSHC	C,6		;MOVE NEXT SIXBIT CHARACTER IN
	JUMPE	C,CPOPJ		;TEST FOR END
	ADDI	C,40		;CONVERT TO ASCII
	PUSHJ	PP,TYO		;OUTPUT
	JRST	TYPSYM		;LOOP

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

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

XCEED2:	HRROI	RC,[SIXBIT /NEC INSUFFICIENT CORE@/]
XCEED3:	TLO	FR,LOADSW	;[326] MAKE SURE IT COMES BACK
	PUSHJ	PP,ERRNE0	;[326] GO PRINT WHERE
	CLOSE	LST,		;[400] GIVE USER A PARTIAL LISTING
	CLOSE	BIN,40		;[400] BUT NEVER A BUM REL FILE
	JRST	M		;[326] START ANOTHER ASSEMBLY

PDPERR:	HRROI	RC,[SIXBIT .PDL PDP OVERFLOW, TRY /P@.]
	MOVE	PP,[IOWD $USRLN,$USSTK] ; RESET BOTH TYPES OF STACKS
	MOVEM	PP,$USRPD	; INCLUDING USER TYPE
	MOVE	PP,SAVEPP	;GET A VALID STACK POINTER
	JRST	XCEED3		;[326] DON'T CONTINUE ASSEMBLY

PRNUM:	HLRZ	CS,V		;GET MESSAGE
	PUSHJ	PP,TYPM2
	MOVEI	CS,[SIXBIT /ON PAGE@/]
	PUSHJ	PP,TYPM2
	MOVE	AC0,(V)		;GET PAGE
	PUSHJ	PP,DP1		;PRINT NUMBER
	MOVEI	C,40
	PUSHJ	PP,TYO
	SKIPN	AC1,1(V)	;GET SEQ NUM IF THERE
	JRST	PRNUM1		;NO, TRY FOR TAG
	MOVEM	AC1,OUTSQ
	MOVEI	CS,[SIXBIT /LINE@/]
	PUSHJ	PP,TYPM2
	OUTPUT	CTL,0		;TO MAKE THINGS PRINT IN RIGHT ORDER
	OUTSTR	OUTSQ		;PRINT SEQUENCE NUMBER
	MOVEI	C," "		;ADD SPACE
	PUSHJ	PP,TYO

PRNUM1:	MOVEI	CS,[SIXBIT /AT@/]
	PUSHJ	PP,TYPM2
	MOVE	CS,2(V)
	PUSHJ	PP,TYPSYM	;PRINT TAG
	MOVEI	CS,[SIXBIT / +@/]
	PUSHJ	PP,TYPM2
	HRRZ	AC0,3(V)
	PUSHJ	PP,DP1		;PRINT DECIMAL INCREMENT
	PJRST	CRLF		;END LINE

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

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

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

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

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

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

READ:	SOSGE	IBUF+2		;BUFFER EMPTY?
	JRST	READ3		;YES
READ1:	ILDB	C,IBUF+1	;PLACE CHARACTER IN C
	MOVE	CS,@IBUF+1	;CHECK FOR SEQUENCE NUMBER
	TRNN	CS,1
	JRST	READ1A
	CAMN	CS,[<ASCII /     />+1]	;[261] HOWEVER IF AN SOS PAGE MARK
	SETZ	CS,		;[261] CLEAR SEQ NO. SO LINE NOT COUNTED
	MOVEM	CS,SEQNO
	MOVEM	CS,SEQNO2
	MOVNI	CS,4
	ADDM	CS,IBUF+2	;ADJUST WORD COUNT
REPEAT 4,<	IBP	IBUF+1>	;SKIP SEQ NO
	PUSHJ	PP,READ		;AND THE TAB
	JRST	READ		;GET NEXT CHARACTER

READ1A:	JUMPE	C,READ		;IGNORE NULL
	CAIN	C,CZ		;IF IT'S A "^Z"
	MOVEI	C,LF		;TREAT IT AS A "LF"
	CAIE	C,CLA		;CONTROL _
	POPJ	PP,
	MOVEI	C,"^"		;MAKE CONTROL _ VISIBLE
	PUSHJ	PP,RSW2
	MOVEI	C,"_"
	PUSHJ	PP,RSW2
	PUSHJ	PP,PEEK		;[175] LOOK AT NEXT CHAR
	CAIG	C,CR		;[175] IF IT IS END OF LINE
	CAIGE	C,LF		;[175]
	JRST	[POP	PP,CS		;[175] GET RETURN ADDRESS
		PUSH	PP,LIMBO	;[175] SAVE NEXT CHAR,RSW1 DESTROYS IT
		MOVEI	C,CLA		;[175] RETORE ^_
		PUSHJ	PP,(CS)		;[175] RETURN TO LIST CHAR ETC
		POP	PP,LIMBO	;[175] SAFE TO STORE NOW
		POPJ	PP,]		;[175] RETURN TO PROGRAM
	TLZ	IO,IORPTC	;[264] USE THE CHAR IN C NOW
	JRST	READ2A		;[264] BUT DON'T LIST TWICE

READ2:	PUSHJ	PP,READ		;YES, TEST FOR LINE FEED
	PUSHJ	PP,RSW2		;LIST IN ANY EVENT
READ2A:	CAIG	C,FF		;[264] IS IT ONE OF
	CAIGE	C,LF		;LF, VT, OR FF?
	JRST	READ2		;NO
	PUSHJ	PP,OUTIM1	;YES, DUMP THE LINE
	JRST	READ		;RETURN NEXT CHARACTER

READ3:	IN	CHAR,0		;GET NEXT BUFFER
	  JRST	READ		;NO ERRORS
	GETSTS	CHAR,C
	TRNN	C,ERRBIT!2000	;ERRORS?
	JRST	READ0		;EOF
	MOVE	AC0,INDEV
READ4:	MOVSI	RC,[SIXBIT/PET INPUT PHYSICAL END OF TAPE DEVICE@/]	;[403]
	TRNE	C,2000
	JRST	ERRFIN		;E-O-T
	MOVSI	RC,[SIXBIT /MDE MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/]
	TRNE	C,IOIMPM	;IMPROPER MODE?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /IDE INPUT DATA ERROR DEVICE@/]
	TRNE	C,IODERR	;DEVICE DATA ERROR?
	JRST	ERRFIN		;YES
	MOVSI	RC,[SIXBIT /ICP INPUT CHECKSUM OR PARITY ERROR DEVICE@/]
	TRNN	C,IODTER
	MOVSI	RC,[SIXBIT /IBL INPUT BLOCK TOO LARGE DEVICE@/]
	JRST	ERRFIN
OUTAB2:	PUSHJ	PP,OUTTAB	;PRINT TWO TABS
OUTTAB:	MOVEI	C,HT
PRINT:	CAIE	C,CR		;IS THIS A CR?
	CAIN	C,LF		;OR LF?
	JRST	OUTCR		;YES, GO PROCESS
	CAIN	C,VT		;[257] VERT TAB?
	JRST	OUTVT		;[257] YES
	CAIN	C,FF		;FORM FEED?
	JRST	OUTFF		;YES, FORCE NEW PAGE
	JRST	OUTL

OUTVT:	PUSH	PP,C+1		;[257] NEED ADJACENT ACC
	MOVEI	C,.LPP		;[257] NO. OF LINES WE STARTED WITH
	SUB	C,LPP		;[257] MINUS NO. OF LINES LEFT
	IDIVI	C,^D20		;[257] HOW MANY WILL VT TAKE
	SUBI	C+1,^D20	;[257] TO GET TO NEXT TAB STOP
	ADDM	C+1,LPP		;[257] ACCOUNT FOR THEM
	POP	PP,C+1		;[257]
	MOVEI	C,VT		;[257] PUT CHAR BACK
	SKIPLE	LPP		;[257] DID WE END PAGE?
	JRST	OUTL		;[257] NO, OUTPUT IT
	TLO	IO,IOPAGE	;[257] YES, NEXT TIME
	JRST	OUTC		;[257] OUTPUT IT

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

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

OUTC:	TRNE	ER,ERRORS!TTYSW
	PUSHJ	PP,TYO
	TRNN	ER,LPTSW
	POPJ	PP,
OUTLST:	SOSG	LSTBUF+2	;BUFFER FULL?
	PUSHJ	PP,DMPLST	;YES, DUMP IT
IFN STANSW,< CAIN C,"@"
	MOVEI C,140
	CAIN C,"_"
	MOVEI C,30
	CAIN C,"^"
	MOVEI C,32
	CAIE C,"\"
	JRST OUTLSS
	MOVEI C,177
	IDPB C,LSTBUF+1
	JRST OUTLST
OUTLSS:	>
	IDPB	C,LSTBUF+1	;STORE BYTE
	POPJ	PP,		;EXIT

OUTFF:	TLOA	IO,IOPAGE	;[161]
OUTFF1:	PUSHJ	PP,PAGE1	;[161] CLOSE CREF
OUTFF2:	SETOM	PAGEN.		;[161]
	AOS	PAGENO		;[161]
	POPJ	PP,		;[161]

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

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

DTAB:	"-NAJ-"
	"-BEF-"
	"-RAM-"
	"-RPA-"
	"-YAM-"
	"-NUJ-"
	"-LUJ-"
	"-GUA-"
	"-PES-"
	"-TCO-"
	"-VON-"
	"-CED-"
;[115] BINARY UNIVERSALS
;HERE TO WRITE OUT UNIVERSAL SYMBOL FILE
;SYMBOL TABLE PLUS MACROS

UNVOUT:	HRRZ	AC0,FREE	;GET HIGHEST FREE LOCATION
	MOVEM	AC0,.JBFF	;INTO JOBFF
	INIT	UNV,B		;INIT DSK FOR OUTPUT
	SIXBIT	/DSK/
	XWD	UNVBUF,0	;OUTPUT ONLY
	JRST	UNVINT		;[431] ERROR
	MOVSI	AC0,'UNV'	;STANDARD EXT
	MOVEM	AC0,UNVDIR+1
	SETZM	UNVDIR+2
	SETZM	UNVDIR+3	;CLEAR PPN
	ENTER	UNV,UNVDIR	;ENTER FILE
	JRST	UNVENT		;[431] ERROR
	MOVEI	SDEL,2*203	;STANDARD DOUBLE BUFFERING
	ADD	SDEL,FREE	;FROM FREE CORE
	CAML	SDEL,SYMBOL	;MORE CORE NEEDED?
	PUSHJ	PP,XCEED	;YES
	SUBI	SDEL,2*203	;BACK TO START OF BUFFER
	MOVEM	SDEL,.JBFF	;SETUP FOR BUFFERS
	OUTBUF	UNV,2		;SET THEM UP
	MOVSI	AC1,777		;SPECIAL MARKER FIRST WORD
	HRRI	AC1,.UVER	;STORE VERSION NUMBER
	PUSHJ	PP,UNVBIN	;LOADER BLOCK 777?
	MOVE	AC1,@SYMBOL	;GET NUMBER OF SYMBOLS
	MOVN	SDEL,AC1
	HRLZS	SDEL
	HRR	SDEL,SYMBOL	;FORM AOBJN POINTER
	PUSHJ	PP,UNVBIN	;OUTPUT NUMBER OF SYMBOLS
	ADDI	SDEL,1		;BYPASS COUNT
UNVLUP:	MOVE	AC1,(SDEL)	;GET SYMBOL
	PUSHJ	PP,UNVBIN
	ADDI	SDEL,1
	MOVE	AC1,(SDEL)	;GET VALUE
	TLNE	AC1,SPTR	;SPECIAL EXTERNAL POINTER?
	JRST	UNVSPT		;YES
	TLNE	AC1,EXTF	;EXTERNAL (BUT NOT SPTR)?
	JRST	UNVEXT		;YES, OUTPUT 2 WORDS
	TLNE	AC1,MACF	;MACRO
	JRST	UNVMAC		;YES, SAVE MACRO TEXT ALSO
	TLNE	AC1,PNTF	;ONLY A POINTER TO VALUE?
	JRST	UNVPTF		;YES
	PUSHJ	PP,UNVBIN	;OUTPUT VALUE
UNVNXT:	AOBJN	SDEL,UNVLUP	;FOR ALL SYMBOLS
	RELEASE	UNV,
	POPJ	PP,

UNVINT:	PUSHJ	PP,EWARN	;[431] NOT FATAL
	AOS	QERRS		;[431] INCREMENT WARNING COUNT
	MOVE	AC0,UNVDIR	;[431] FILENAME IN AC0
	MOVSI	RC,[SIXBIT /UWU UNABLE TO WRITE UNIVERSAL FILE@/]	;[431]
	PJRST	TYPMSG		;[431] TYPE MESSAGE AND EXIT

UNVENT:	PUSHJ	PP,EWARN	;[431] NOT FATAL
	AOS	QERRS		;[431] INCREMENT WARNING COUNT
	MOVSI	CS,'EFU'	;[431] ENTER FAILED UNIVERSAL MNEMONIC
	PUSHJ	PP,TYPSYM	;[431]
	MOVEI	C," "		;[431] THROW IN A SPACE
	PUSHJ	PP,TYO		;[431]
	HRRZ	RC,UNVDIR+1	;[431] GET ERROR BITS
	SKIPN	RC		;[431]
	SOS	RC		;[431] =0 SPECIAL CASE
	CAIL	RC,TABLND-TABLE	;[431] WITHIN BOUNDS?
	JRST	[HLRZ	CS,TABLND	;[431] CATCH-ALL ERR MESS
		JRST	.+2]	;[431]
	HLRZ	CS,TABLE(RC)	;[431] REFERENCE TABLE
	PUSHJ	PP,TYPM2	;[431] GIVE APPROPRIATE MESSAGE
	MOVE	AC0,UNVDIR	;[431] FILE NAME
	MOVSI	RC,[SIXBIT /UNIVERSAL FILE@/]	;[431]
	PJRST	TYPMSG		;[431] FINISH OFF AND EXIT
;HERE FOR EXTERNAL (NOT SPTR)
UNVEXT:	MOVE	AC2,AC1		;GET POINTER
	HLLZ	AC1,AC1		;CLEAR POINTER
	PUSHJ	PP,UNVBIN	;OUTPUT FLAGS
	MOVE	AC1,0(AC2)	;GET FIRST WORD (VALUE)
	PUSHJ	PP,UNVBIN
	MOVE	AC1,1(AC2)	;GET SECOND WORD (SYMBOL)
	PUSHJ	PP,UNVBIN
	JRST	UNVNXT

;HERE FOR 36 BIT VALUE
UNVPTF:	MOVE	AC2,AC1		;GET COPY
	HLLZ	AC1,AC1		;CLEAR POINTER
	PUSHJ	PP,UNVBIN	;OUTPUT FLAGS
	MOVE	AC1,(AC2)	;GET VALUE
	PUSHJ	PP,UNVBIN	;OUTPUT IT
	JRST	UNVNXT

;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVSPT:	MOVE	AC2,AC1		;COPY POINTER
	HLLZ	AC1,AC1		;CLEAR POINTER
	PUSHJ	PP,UNVBIN	;OUTPUT FLAGS
	MOVE	AC1,(AC2)	;GET FIRST WORD
	PUSHJ	PP,UNVBIN	;STORE VALUE
	MOVE	AC1,1(AC2)	;GET RELOCATION WORD
	MOVE	AC2,AC1		;COPY IT
	PUSHJ	PP,UNVBIN
	TRNN	AC2,-1		;RIGHT HALF RELOCATION?
	JRST	.+5		;NO
	MOVE	AC1,(AC2)	;GET VALUE
	PUSHJ	PP,UNVBIN
	MOVE	AC1,1(AC2)	;EXTERNAL SYMBOL
	PUSHJ	PP,UNVBIN
	TLNN	AC2,-1		;LEFT HALF RELOCATION?
	JRST	UNVNXT		;NO
	HLRZS	AC2		;YES, SWAP
	JRST	.-7		;AND OUTPUT

;HERE FOR MACRO
UNVMAC:	MOVE	AC2,AC1		;GET POINTER TO TEXT
	HLLZ	AC1,AC1		;CLEAR POINTER
	PUSHJ	PP,UNVBIN	;OUTPUT FLAGS
	HLRZ	AC1,1(AC2)	;[334] GET DEFAULT VALUES, IF ANY
	MOVEM	AC1,UNVDFA	;[334] SAVE STARTING ADDRESS
	PUSHJ	PP,UNVMCP	;[334] GO DUMP MACRO ITSELF
	SKIPN	AC2,UNVDFA	;[334] SEE IF ANY DEFAULT VALUES (LEFT)
	JRST	UNVNXT		;[334] NO, CONTINUE WITH NEXT SYMBOL
	HRROI	AC1,(AC2)	;[334] SET UP AOBJP POINTER FOR # OF DEFAULTS
	SKIPE	(AC1)		;[334] ARE THERE ANY MORE?
	AOBJP	AC1,.-1		;[334] YES, COUNT AND TRY NEXT
	PUSHJ	PP,UNVBIN	;[334] OUTPUT COUNT WORD
UNVMC1:	HLRZ	AC1,(AC2)	;[334] GET THE AGUMENT # OF THIS DEFAULT
	PUSHJ	PP,UNVBIN	;[334] OUTPUT THE ARGUMENT NUMBER
	MOVE	AC2,(AC2)	;[334] GET ADDRESS OF DEFAULT
	PUSHJ	PP,UNVMCP	;[334] GO OUTPUT, IT LOOKS LIKE MACRO
	AOS	AC2,UNVDFA	;[334] UP POINTER TO DEFAULT BLOCK
	SKIPE	(AC2)		;[334] SEE IF ANY MORE
	JRST	UNVMC1		;[334] YES, GO WRITE THEM OUT
	JRST	UNVNXT		;[334] NO, GO DO NEXT SYMBOL

UNVMCP:	HLL	AC2,(AC2)	;[334] PUT ADDRESS OF NEXT BLOCK IN LEFT
	QQ==0
REPEAT .LEAF,<
	MOVE	AC1,QQ(AC2)
	PUSHJ	PP,UNVBIN
	QQ==QQ+1>
	HLRZS	AC2
	JUMPN	AC2,UNVMCP	;[334] MORE LEAFS TO PROCESS
	POPJ	PP,		;[334] RETURN

UNVBIN:	SOSG	UNVBUF+2
	PUSHJ	PP,DMPUNV
	IDPB	AC1,UNVBUF+1
	POPJ	PP,

DMPUNV:	OUT	UNV,0
	  POPJ	PP,
	GETSTS	UNV,C		;[403] GET STATUS BITS
	TRNN	C,ERRBIT	;[403] ERRORS?
	POPJ	PP,		;[403] NO, EXIT
	MOVSI	AC0,'DSK'	;[431] DEVICE ALWAYS DSK
	JRST	ERRLST		;[403] GIVE ERROR MESSAGE
;HERE TO READ IN UNIVERSAL SYMBOL TABLE

UNVINP:	MOVEM	AC0,UNVDIR	;FILE WE NEED
	PUSH	PP,AC0		;[240] SAVE REAL NAME OF UNV
	MOVSI	AC1,'DSK'	;[240] DEFAULT DEVICE
	MOVEM	AC1,UNVDEV	;[240]
	MOVSI	AC1,'UNV'	;REQUIRED EXT
	MOVEM	AC1,UNVDIR+1
	SETZM	UNVDIR+2
	SETZM	UNVDIR+3
	CAIE	C,'('		;[240] SEE IF USER SUPPLIED FILE SPEC
	JRST	UNVOPN		;[240] NO, USE DEFAULT
	PUSHJ	PP,SCHGET	;[240] GET A NAME
	CAIE	C,':'		;[240] IS IT A DEVICE?
	JRST	UNVCKN		;[240] NO TRY NAME
	MOVEM	AC0,UNVDEV	;[240] YES, SAVE DEVICE
	PUSHJ	PP,SCHGET	;[240] TRY NEXT NAME
UNVCKN:	MOVEM	AC0,UNVDIR	;[240] SAVE NAME
	CAIE	C,'.'		;[240] DOES EXT FOLLOW?
	JRST	.+3		;[240] NO
	PUSHJ	PP,SCHGET	;[240] YES, GET IT
	MOVEM	AC0,UNVDIR+1	;[240] AND STORE IT
	CAIE	C,'['		;[240] A DIRECTORY SPECIFIED?
	JRST	SCHCLP		;[240] NO
	PUSHJ	PP,SCHOCT	;[240] GET PPN
	HRLZM	AC0,UNVDIR+3	;[240] AND SAVE IT
	CAIE	C,','		;[240] CHECK PROG NO.
	TROA	ER,ERRQ		;[240] WARN USER
	PUSHJ	PP,SCHOCT	;[240] GRT IT
	HRRM	AC0,UNVDIR+3	;[240]
	CAIE	C,','		;[240] AN SFD GIVEN?
	JRST	SCHCLB		;[240] NO
	MOVEI	AC0,UNVPTH	;GET PATH PTR
	EXCH	AC0,UNVDIR+3	;[240] SWAP WITH PPN
	MOVEM	AC0,UNVPTH+2	;[240] AND PUT IN PATH
	MOVSI	RC,-.SFDLN	;[240] AOBJN PTR FOR SFDS
SCHSFD:	PUSHJ	PP,SCHGET	;[240] GET SFD NAME
	AOBJP	RC,SCHCLB+1	;[240] SEE IF ENOUGH ROOM
	MOVEM	AC0,UNVPTH+2(RC)	;[240] YES, STORE
	CAIN	C,','		;[240] DOES PATH CONTINUE ON?
	JRST	SCHSFD		;[240] YES
SCHCLB:	CAIE	C,']'		;[240] DOES PATH FINISH PROPERLY?
	TROA	ER,ERRQ		;[240] NO
	PUSHJ	PP,BYPAS1	;[240] EAT UP THE "]"
SCHCLP:	CAIE	C,')'		;[240] FILE SPEC END PROPERLY?
	TROA	ER,ERRQ		;[240] NO
	PUSHJ	PP,BYPAS1	;[240] EAT IT
UNVOPN:	POP	PP,AC0		;[240] UNV NAME BACK IN 0
	OPEN	UNV,UNVINI	;[240] TRY USER SPECIFICATION
	  JRST	UNVUNV		;FAILED
	LOOKUP	UNV,UNVDIR	;SEE IF THERE
	  JRST	UNVUNV		;TRY UNV:
	MOVEM	AC0,UNVDIR	;[240] RESTORE NAME OF UNV 
UNVFND:	AOS	RC,UNIVNO	;BUMP COUNT OF UNIVERSALS
	CAILE	RC,.UNIV	;SEE IF ROOM IN TABLES
	JRST	UNVERR		;NO, GIVE ERROR
	SKIPN	UNIVSN		;IS CURRENT PROG A UNIVERSAL
	JRST	UNVNOT		;NO
	CAIL	RC,.UNIV	;YES, ROOM FOR IT AS WELL?
	JRST	UNVERR		;NO
	MOVE	AC1,UNITBL(RC)	;GET CURRENT NAME
	MOVEM	AC1,UNITBL+1(RC)	;STORE IT IN NEXT SLOT
UNVNOT:	MOVEM	AC0,UNITBL(RC)	;STORE NAME
	HLRE	SDEL,UNVDIR+3	;GET SIZE OF FILE
	MOVMS	SDEL		;IN WORDS
	ADD	SDEL,FREE	;AT TOP OF FREE CORE
	HRRZM	SDEL,UNIPTR(RC)	;SAVE NEW SYMTOP (IN WRONG HALF)
	ADDI	SDEL,2*203	;PLUS  2 BUFFERS
	CAML	SDEL,SYMBOL	;WILL IT FIT?
	PUSHJ	PP,XCEED	;NO, TRY FOR MORE
	CAML	SDEL,SYMBOL	;DID WE GET ENOUGH?
	JRST	.-2		;NO TRY AGAIN
	SUBI	SDEL,2*203	;START OF BUFFERS
	MOVEM	SDEL,.JBFF
	INBUF	UNV,2		;STANDARD DOUBLE BUFFERING
	PUSHJ	PP,UNVREAD	;READ AND IGNORE FIRST WORD (777 MARKER)
	HRRZS	AC1		;GET UNV VERSION #
	SETOM	UNVER%		;[334] KLUDGE SWITCH TO ALLOW VERSION 4
	CAIE	AC1,4		;[334] SEE IF 4 (MIGHT BOMB DEFAULT ARGUMENTS)
	AOSA	UNVER%		;[334] NO, UNVER% IS 0 FOR GOOD FILES
	AOS	AC1		;[334] VERSION 4 NEEDS FUDGING
	CAIE	AC1,.UVER	;BETTER MATCH
	JRST	VERSKW		;[364] YOU LOSE
	PUSHJ	PP,UNVREAD	;READ SYMBOL COUNT (SECOND WORD)
	MOVE	SDEL,AC1	;GET COPY
	LSH	SDEL,1		;TWO WORDS PER SYMBOL
	ADDI	SDEL,1		;PLUS ONE FOR COUNT
	MOVNS	SDEL		;NEGATE
	MOVE	AC2,SDEL	;STORE IT
	ADD	AC2,UNIPTR(RC)	;ADD SYMTOP
	HRLM	AC2,UNIPTR(RC)	;TO FORM SYMBOL
	MOVSS	UNIPTR(RC)	;NOW PUT IN CORRECT HALVES
	MOVN	SDEL,AC1	;GET NO. OF SYMBOLS
	HRLZ	SDEL,SDEL	;TO FORM AOBJN POINTER
	HRR	SDEL,AC2	;POINT TO WHERE TO STORE THEM
	MOVEM	AC1,(SDEL)	;STORE COUNT
	ADDI	SDEL,1		;AND GET PAST IT
UNVRLO:	PUSHJ	PP,UNVREAD	;GET A SYMBOL
	MOVEM	AC1,(SDEL)	;STORE IT
	ADDI	SDEL,1		;INCREMENT PAST IT
	PUSHJ	PP,UNVREAD	;GET  VALUE
	MOVEM	AC1,(SDEL)	;STORE IT
	TLNE	AC1,SPTR	;SPECIAL EXTERNAL POINTER?
	JRST	UNVRSP		;YES
	TLNE	AC1,EXTF	;EXTERNAL (NOT SPTR)?
	JRST	UNVREX		;YES
	TLNE	AC1,MACF	;MACRO?
	JRST	UNVRMC		;YES
	TLNE	AC1,PNTF	;36 BIT VALUE
	JRST	UNVRPT		;YES
UNVRNX:	AOBJN	SDEL,UNVRLO	;GET NEXT
	RELEASE	UNV,
	MOVE	RC,UNIVNO	;POINT TO LAST ENTRY
	MOVE	AC1,UNITBL+1(RC)	;GET NAME INCASE IN UNIV NOW
	SKIPE	UNIVSN		;ARE WE?
	MOVEM	AC1,UNVDIR	;YES, RESET NAME OF OUTPUT FILE
IFN POLISH,<
	PUSH	PP,SGSBOT
	PUSH	PP,SGSTOP
	PUSH	PP,SGSCNT
	PUSH	PP,SGNCUR
>
	PUSH	PP,SYMBOL
	PUSH	PP,SYMTOP	;SAVE EXISTING VALUES
	PUSH	PP,SRCHX
	MOVE	AC1,UNIPTR(RC)	;GET SYMTOP,,SYMBOL
	HLRZM	AC1,SYMTOP
	HLRZM	AC1,FREE	;DON'T FORGET TO SET FREE BEYOND SYMTOP
	HRRZM	AC1,SYMBOL
	HLRZ	AC1,AC1		;TOP LOCATION
	MOVEM	AC1,UNITOP	;SAVE NEW TOP FOR UNIVERSALS
	CAMLE	AC1,MACSIZ	;HAVE WE INCREASED?
	MOVEM	AC1,MACSIZ	;YES, STOP ILL MEM REFS
IFN POLISH,<
	SETZM	SGNCUR
	MOVE	AC0,@SYMBOL
	MOVEM	AC0,SGSCNT
>
	PUSHJ	PP,SRCHI	;SETUP SEARCH POINTER
	MOVE	AC1,SRCHX	;LOAD IT
	MOVEM	AC1,UNISHX(RC)	;SAVE IT
	POP	PP,SRCHX	;RESTORE
	POP	PP,SYMTOP
	POP	PP,SYMBOL
IFN POLISH,<
	POP	PP,SGNCUR
	POP	PP,SGSCNT
	POP	PP,SGSTOP
	POP	PP,SGSBOT
>
	JRST	SERCH1		;AND RETURN

;HERE FOR 36 BIT VALUE
UNVRPT:	PUSHJ	PP,UNVREAD
	AOS	AC2,FREE	;GET A FREE LOC
	SUBI	AC2,1
	MOVEM	AC1,(AC2)	;STORE IT
	HRRM	AC2,(SDEL)	;FIXUP SYMBOL POINTER
	JRST	UNVRNX		;GET NEXT

;HERE FOR EXTERNAL (NOT SPTR)
UNVREX:	MOVEI	AC2,2		;NEED 2 LOCS
	ADDB	AC2,FREE
	SUBI	AC2,2		;POINT TO START OF 2 WORDS
	PUSHJ	PP,UNVREAD	;GET VALUE
	MOVEM	AC1,0(AC2)	;MOST LIKELY 0
	PUSHJ	PP,UNVREAD	;GET NAME
	MOVEM	AC1,1(AC2)
	HRRM	AC2,(SDEL)	;POINT TO VALUE
	JRST	UNVRNX		;GET NEXT

;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVRSP:	MOVEI	AC2,2		;GET 2 LOCATIONS
	ADDB	AC2,FREE	;FROM FREE CORE
	SUBI	AC2,2		;POINT TO START OF 2 WORDS
	PUSHJ	PP,UNVREAD	;GET VALUE
	MOVEM	AC1,(AC2)
	PUSHJ	PP,UNVREAD	;GET RELOCATION
	HRRM	AC2,(SDEL)	;STORE POINTER
	MOVEI	RC,1(AC2)	;POINT TO RELOCATION WORD
	SETZM	(RC)		;CLEAR RELOCATION
	MOVE	AC2,AC1		;STORE PREVIOUS RELOCATION
	TRNN	AC2,-1		;RIGHT HALF RELOCATION?
	JRST	UNVRS2		;NO
	HRR	AC2,FREE	;POINT TO NEXT 2 WORD BLOCK
	HRRM	AC2,(RC)	;POINT TO BLOCK (RELOCATION)
UNVRS1:	PUSHJ	PP,UNVREAD	;GET VALUE
	MOVEM	AC1,(AC2)
	PUSHJ	PP,UNVREAD	;GET EXTERNAL SYMBOL
	MOVEM	AC1,1(AC2)
	HRRI	AC2,2(AC2)	;INCREMENT RIGHT HALF BY 2 WORDS USED
	HRRZM	AC2,FREE	;INCREMENT FREE
UNVRS2:	TLZN	AC2,-1		;LEFT HALF RELOCATION?
	JRST	UNVRNX		;NO, GET NEXT SYMBOL
	HRLM	AC2,(RC)	;FIX LEFT RELOCATION
	JRST	UNVRS1		;AND FILL IN VALUE

;HERE FOR MACRO
UNVRMC:	MOVE	AC2,FREE	;FREE LOC COUNTER
	HRRM	AC2,(SDEL)	;IS WHERE MACRO STARTS
	MOVEM	AC2,UNVDFA	;[334] SAVE STARTING ADDRESS OF MACRO
	PUSHJ	PP,UNVRML	;[334] GO READ IN MACRO DEFINITION
	MOVE	AC1,UNVDFA	;[334] GET STARTING ADDRESS BACK
	HLRZ	AC2,1(AC1)	;[334] GET POINTER FOR ANY DEFAULTS
	JUMPE	AC2,UNVRNX	;[334] NONE, GO DO NEXT SYMBOL
	SKIPE	UNVER%		;[334] MAKE SURE WE WROTE THEM ON DISK
	JRST	UNVRER		;[334] NO, TELL USER
	PUSH	PP,SDEL		;[334] SAVE AOBJN POINTER
	MOVE	AC2,FREE	;[334] GET NEXT FREE ADDRESS
	HRLM	AC2,1(AC1)	;[334] POINT TO IT IN MACRO BODY
	PUSHJ	PP,UNVREAD	;[334] GO READ COUNT OF DEFAULTS
	MOVN	SDEL,AC1	;[334] COPY COUNT TO AOBJN POINTER
	HRRI	SDEL,(AC2)	;[334] SET AOBJN ADDRESS INTO SDEL
	HLRZ	AC2,AC1		;[334] GET COUNT-1 OF DEFAULTS
	ADDI	AC2,2		;[334] CHANGE TO COUNT+1 (+0 WORD)
	ADDB	AC2,FREE	;[334] BUMP FREE BY DEFAULT POINTER BLOCK LENGTH
UNVRM1:	PUSHJ	PP,UNVREAD	;[334] GO READ ARGUMENT NUMBER
	HRLM	AC1,(SDEL)	;[334] SAVE IN POINTER BLOCK
	HRRM	AC2,(SDEL)	;[334] SAVE START OF VALUE (MAY BE SET UP BY UNVRML)
	PUSHJ	PP,UNVRML	;[334] GO COPY DEFAULT VALUE
	AOBJN	SDEL,UNVRM1	;[334] DO ALL DEFAULTS
	SETZM	(SDEL)		;[334] CLEAR END OF BLOCK WORD
	POP	PP,SDEL		;[334] RESTORE BIG AOBJN WORD
	JRST	UNVRNX		;[334] GO DO NEXT SYMBOL

UNVRML:	QQ==0
REPEAT .LEAF,<
	PUSHJ	PP,UNVREAD
	MOVEM	AC1,QQ(AC2)	;STORE
QQ==QQ+1>
	MOVE	AC1,(AC2)	;SEE WHAT FIRST WORD WAS
	TLNN	AC1,-1		;IF ZERO THEN FINISHED
	JRST	UNVRMF		;SET LAST BLOCK POINTER
	MOVEI	AC1,.LEAF(AC2)	;POINT TO NEXT BLOCK
	HRLM	AC1,(AC2)	;FILL IT IN
	ADDI	AC2,.LEAF	;POINT TO IT
	JRST	UNVRML		;AND LOOP

UNVRMF:	MOVE	AC1,(SDEL)	;GET FIRST BLOCK
	HRRM	AC2,(AC1)	;POINT TO LAST
	ADDI	AC2,.LEAF	;POINT TO NEXT FREE
	MOVEM	AC2,FREE
	POPJ	PP,		;[334] RETURN

UNVRER:	MOVSI	RC,[SIXBIT /OUF UNIVERSAL FILE DEFAULT ARGUMENTS LOST, REASSEMBLE@/];[334]
	JRST	ERRFIN		;[334] PRINT THAT HAD DEFAULTS WHICH WERE LOST
UNVREA:	SOSG	UNVBUF+2
	PUSHJ	PP,UNVRIN
	ILDB	AC1,UNVBUF+1
	POPJ	PP,

UNVRIN:	IN	UNV,
	  POPJ	PP,
	GETSTS	UNV,C		;[403] GET STATUS BITS
	TRNN	C,ERRBIT!2000	;[403] ERRORS?
	JRST	UNVRN1		;[431] E-O-F
	MOVE	AC0,UNVDEV	;[403] GET DEVICE
	JRST	READ4		;[403] GIVE I/O ERROR MESSAGE

UNVRN1:	MOVSI	RC,[SIXBIT /ERU UNEXPECTED END-OF-FILE READING UNIVERSAL FILE@/]	;[431] NAME IN AC0
	JRST	ERRFIN		;[431] GIVE ERROR MESSAGE

UNVUNV:	MOVEM	AC0,UNVDIR	;[240] RESTORE REAL NAME
	MOVSI	AC1,'UNV'	;[240] AND DEFAULT EXT
	MOVEM	AC1,UNVDIR+1	;[240]
	SETZM	UNVDIR+2	;[240]
	SETZM	UNVDIR+3	;[240] DEFAULT PATH
	INIT	UNV,B
	SIXBIT	/UNV/
		UNVBUF
	  JRST	UNVSYS
	LOOKUP	UNV,UNVDIR
	  JRST	UNVSYS
	JRST	UNVFND

UNVSYS:	INIT	UNV,B
	SIXBIT	/SYS/
		UNVBUF
	  JRST	SCHERR
	LOOKUP	UNV,UNVDIR	;SEE IF THERE
	  JRST	SCHERR		;NO
	JRST	UNVFND		;GOT IT
SUBTTL	MACHINE INSTRUCTION SEARCH ROUTINES
IFE OPHSH,<
OPTSCH:	MOVEI	RC,0
	MOVEI	ARG,1B^L<OP1END-OP1TOP>	;SET UP INDEX
	MOVEI	V,1B^L<OP1END-OP1TOP>/2	;SET UP INCREMENT

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

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

OPT1G:	JUMPG	AC0,[CAME AC0,['.XCREF']	;[141] DON'T CREF .XCREF
		JRST	.+3		;IF ".","$",OR "%" USE TABLE 1
		MOVE	V,OP1TAB-700(V)	;[217] USE TABLE 1
		JRST	CPOPJ1]		;[217] AND BYPASS CREF
	TLNN	AC0,200000	;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE
	SKIPA	V,OP2TAB-700(V)	;2ND TABLE, FIRST LETTER IS "A" TO "O"
	MOVE	V,OP1TAB-700(V)	;1ST TABLE, ..."P" TO "Z"
	JRST	OPT1F		;EXIT

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

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

	IF1, < N1=0
		LSYM== SIXBIT /ADD/
		DEFINE $FAIL(SYMBOL)< PRINTX ? SYMBOL -BAD OPCODE ORDER>
	DEFINE X (SYMBOL,CODE)<
		 IFL <SIXBIT /SYMBOL/-LSYM>,< $FAIL(SYMBOL)>
		 LSYM== <SIXBIT /SYMBOL/>
		 N1=N1+1>>

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

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

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

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

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

;MACRO TO HANDLE KI10 OP-CODES
IFE KI10,<
DEFINE XK (SB,CD) <>		;NUL MACRO>
IFN KI10,<SYN X,XK		;USUAL X MACRO>

; MACRO TO HANDLE KL10 OP-CODES
IFE KL10,<
	DEFINE XKK (SB,CD) <>  >
IFN KL10, <SYN X,XKK>
IFN OPHSH,<		;PUT THE MOST USED OP CODES FIRST
X	JRST  ,	254
X	PUSHJ , 260
X	POPJ  , 263
X	PUSH  , 261
X	POP   , 262
X	AOS   ,	350
X	ASCIZ ,	701
X	CALLI ,	047
X	EXTERN,	724
X	INTERN,	744
X	JFCL  ,	255
X	JSP   ,	265
X	MOVE  ,	200
X	MOVEI ,	201
X	MOVEM ,	202
X	SETZM ,	402
X	SIXBIT,	717
X	SOS   ,	370
X	TLNE  ,	603
X	TLNN  ,	607
X	TLO   ,	661
X	TLZ   ,	621
X	TLZA  ,	625
X	TLZE  ,	623
X	TLZN  ,	627
X	TRNE  ,	602
X	TRNN  ,	606
X	TRZ   ,	620
>
X	ADD   ,	270
X	ADDB  ,	273
X	ADDI  ,	271
X	ADDM  ,	272
XKK	ADJBP , 133
XKK	ADJSP , 105
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	ARRAY , 771
IFN IIISW,<X	ASCID , 773>
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
XKK	CMPSE , 002
XKK	CMPSG , 007
XKK	CMPSGE, 005
XKK	CMPSL , 001
XKK	CMPSLE, 003
XKK	CMPSN , 006
X	COMMEN, 770


X	CONI  ,	710
X	CONO  ,	711
IFN STANSW,<X	CONS,257>
X	CONSO ,	712
X	CONSZ ,	713
XKK	CVTBDO, 012
XKK	CVTBDT, 013
XKK	CVTDBO, 010

XKK	CVTDBT, 011
XKK	DADD  , 114
XX	DATA. ,	020

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

XK	DFAD  , 110
XK	DFDV  , 113
XK	DFMP  , 112
X	DFN   ,	131
XK	DFSB  , 111

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

XK	DMOVE , 120
XK	DMOVEM, 124
XK	DMOVN , 121
XK	DMOVNM, 125
XKK	DMUL  , 116

X	DPB   ,	137
XKK	DSUB  , 115

XKK	EBLT  , 020
XKK	EDIT  , 004
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

XKK	EXTEND, 123
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

IFN STANSW,<X	FIX   , 130>
IFE STANSW,<XK	FIX   , 122>
XK	FIXR  , 126
XK	FLTR  , 127

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

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

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

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

X	FSC   ,	132

X	GETSTS,	062

X	HALT  ,	725
X	HISEG ,	706

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

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

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

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

X	IBP   ,	133

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

X	IDPB  ,	136

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

X	ILDB  ,	134

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

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

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
X	JSYS  , 104

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
XK	MAP   , 257
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
XKK	MOVSLJ, 016
X	MOVSM ,	206
XKK	MOVSO , 014
XKK	MOVSRJ, 017
X	MOVSS ,	207
XKK	MOVST , 015


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	PORTAL,	757

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

XX	PUSH  ,	261
XX	PUSHJ ,	260

X	RADIX ,	706
X	RADIX5,	707

X	RELEAS,	071

X	RELOC ,	710
X	REMARK,	711

X	RENAME,	055

X	REPEAT,	712

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

X	ROT   ,	241
X	ROTC  ,	245

X	RSW   ,	716
XX	RTB.  ,	022
X	SALL  , 720
X	SEARCH, 721

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

XX	SIXBIT,	717

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

XX	SLIST.,	025

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

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

IFN STANSW,<X SPCWAR,43>
X	SQUOZE,	707

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

X	STOPI ,	722

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

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

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

X	TITLE ,	726

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

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

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

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

X	VAR   ,	727

XX	WTB.  ,	023

X	XALL  ,	732

X	XCT   ,	256

X	XLIST ,	733

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

X	XPUNGE, 730
X	XWD   ,	734

X	Z     ,	000

IFN FT.U01,<
IFN POLISH,<$BEG==762>
IFE POLISH,<$BEG==760>
X	$POP  , $BEG
X	$PUSH , <$BEG+1>
>;END IFN FT.U01
X	.ASSIG, 751
X	.COMMO, 747
X	.CREF , 740
X	.DIREC, 750
IFN POLISH,<
X	.ENDPS,	761
>
X	.HWFRM, 742
X	.IF   , 756
X	.LINK , 753
X	.LNKEN, 754
X	.MFRMT, 743
X	.NODDT, 746
X	.ORG  , 752
IFN POLISH,<
X	.PSECT,	760
>
X	.REQUE, 744
X	.REQUI, 745
X	.TEXT , 755
X	.XCREF, 741


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

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

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

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

PRMTBL:			;PERMANENT SYMBOLS
P	ADC,	24
P	ADC2,	30
P	APR,	0
P	CCI,	14
P	CDP,	110
P	CDR,	114
P	CLK,	70
P	CLK2,	74
P	CPA,	0
P	CR,	150
P	CR2,	154
P	DC,	200
P	DC2,	204
P	DCSA,	300
P	DCSB,	304
P	DDC,	270
P	DDC2,	274
P	DF,	270
P	DIS,	130
P	DIS2,	134
P	DLB,	60
P	DLB2,	160
P	DLC,	64
P	DLC2,	164
P	DLS,	240
P	DLS2,	244
P	DPC,	250
P	DPC2,	254
P	DPC3,	260
P	DPC4,	264
P	DSI,	464
P	DSI2,	474
P	DSK,	170
P	DSK2,	174
P	DSS,	460
P	DSS2,	470
P	DTC,	320
P	DTC2,	330
P	DTS,	324
P	DTS2,	334
P	LPT,	124
P	LPT2,	234
P	MDF,	260
P	MDF2,	264
P	MTC,	220
P	MTM,	230
P	MTS,	224
P	PAG,	10
P	PI,	4
P	PLT,	140
P	PLT2,	144
P	PTP,	100
P	PTR,	104
P	TMC,	340
P	TMC2,	350
P	TMS,	344
P	TMS2,	354
P	TTY,	120
P	UTC,	210
P	UTS,	214
IFE LNSSW,<	XLIST	>
IFN LNSSW,<	;SPECIAL DEVICES FOR PEPR
P .A,550
P .AB,434
P .ANG,440
P .B,554
P .BITE,470
P .FA,564
P .GAIN,520
P .GATE,444
P .IA,560
P .INC,514
P .LC,474
P .LG,570
P .PEPR,400
P .RG,574
P .SCON,430
P .STAT,410
P .TC,500
P .TED,540
P .THR,544
P .TRK,404
P .VIEW,524>
	LIST
PRMEND:				;END OF PERMANENT SYMBOLS

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

OP1TAB:

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

	Z	XPUNG0			;XPUNGE
	ZAL	TWSEG0			;TWOSEGMENTS
	ZAL	XALL0	(IOPALL)	;XALL
	ZAL	XALL0	(IOPROG)	;XLIST
	Z	XWD0			;XWD
	ZAL	RIM0	(RIM1SW)	;RIM10
	ZAL	RIM0	(R1BSW)		;RIM10B
	ZA	UNIV0	(Z (POINT 7,,))	;UNIVERSAL
	ZAL	ONCRF	(IONCRF)	;.CREF
	ZAL	OFFCRF	(IONCRF)	;.XCREF
	ZA	OFFORM			;.HWFRMT
	ZA	ONFORM			;.MFRMT
	ZAL	REQUEST			;.REQUEST
	ZAL	REQUIRE			;.REQUIRE
	ZA	NODDT0			;.NODDT
	ZAL	COMM0			;.COMMON
	ZAL	%DIREC			;.DIRECTIVE
	ZA	ASGN			;.ASSIGN
	ZAL	%ORG	(1B18)		;.ORG
	ZAL	%LINK	(0)		;.LINK
	ZAL	%LINK	(1B18)		;.LNKEND
	Z	%TEXT0	(1B18+1B21)	;.TEXT
	Z	%IF			;.IF
	JRST	1,OP			;[342] PORTAL
IFN POLISH,<
	ZA	%SEGME			;.PSECT
	ZA	%ENDSE			;.ENDPS
>
IFN FT.U01,<
	POP	$PDUSR			;$POP
	PUSH	$PDUSR			;$PUSH
>;END IFN FT.U01
OP2TAB:

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

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

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

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

	JFCL	6,OP			;JCRY
	JFCL	4,OP			;JCRY0
	JFCL	2,OP			;JCRY1
	JRST	12,OP			;JEN
	JFCL	10,OP			;JOV
	JRST	2,OP			;JRSTF

	ZAL	IOLSET	(IOPALL!IOSALL)	;[327] LALL, SEE ***** AT IOLSE1+1 IF CHANGED
	ZAL	IORSET	(IOPROG)	;LIST
	ZAL	LIT0			;LIT
	ZAL	%ORG	(0)		;LOC
	ZA	OFFSYM			;NOSYM
	Z	OCT0	(^D8)		;OCT
	ZA	OPDEF0			;OPDEF
	JFCL	1,OP			;JFOV
	ZA	ONML			;MLON
	ZA	OFFML			;MLOFF
	Z	ASCII0	(3B19)		;COMMENT
	ZAL	%ARAY			;ARRAY
	ZAL	%INTEG			;INTEGER
	ZAL	%LINK	(0)		;LINK
	ZAL	%LINK	(1B18)		;LNKEND
	ZAL	%ORG	(1B18)		;ORG
	ZA	ASGN			;ASSIGN
IFN IIISW,<
	Z	ASCII0	(5B20)		;ASCID>

CALTBL:
				;USER DEFINED CALLI'S GO HERE
	SIXBIT	/LIGHTS/	;-1
CALLI0:	SIXBIT	/RESET/		; 0
	SIXBIT	/DDTIN/		; 1
	SIXBIT	/SETDDT/	; 2
	SIXBIT	/DDTOUT/	; 3
	SIXBIT	/DEVCHR/	; 4
	SIXBIT	/DDTGT/		; 5
	SIXBIT	/GETCHR/	; 6
	SIXBIT	/DDTRL/		; 7
	SIXBIT	/WAIT/		;10
	SIXBIT	/CORE/		;11
	SIXBIT	/EXIT/		;12
	SIXBIT	/UTPCLR/	;13
	SIXBIT	/DATE/		;14
	SIXBIT	/LOGIN/		;15
	SIXBIT	/APRENB/	;16
	SIXBIT	/LOGOUT/	;17
	SIXBIT	/SWITCH/	;20
	SIXBIT	/REASSI/	;21
	SIXBIT	/TIMER/		;22
	SIXBIT	/MSTIME/	;23
	SIXBIT	/GETPPN/	;24
	SIXBIT	/TRPSET/	;25
	SIXBIT	/TRPJEN/	;26
	SIXBIT	/RUNTIM/	;27
	SIXBIT	/PJOB/		;30
	SIXBIT	/SLEEP/		;31
	SIXBIT	/SETPOV/	;32
	SIXBIT	/PEEK/		;33
	SIXBIT	/GETLIN/	;34
	SIXBIT	/RUN/		;35
	SIXBIT	/SETUWP/	;36
	SIXBIT	/REMAP/		;37
	SIXBIT	/GETSEG/	;40
	SIXBIT	/GETTAB/	;41
	SIXBIT	/SPY/		;42
	SIXBIT	/SETNAM/	;43
	SIXBIT	/TMPCOR/	;44
	SIXBIT	/DSKCHR/	;45
	SIXBIT	/SYSSTR/	;46
	SIXBIT	/JOBSTR/	;47
	SIXBIT	/STRUUO/	;50
	SIXBIT	/SYSPHY/	;51
	SIXBIT	/FRECHN/	;52
	SIXBIT	/DEVTYP/	;53
	SIXBIT	/DEVSTS/	;54
	SIXBIT	/DEVPPN/	;55
	SIXBIT	/SEEK/		;56
	SIXBIT	/RTTRP/		;57
	SIXBIT	/LOCK/		;60
	SIXBIT	/JOBSTS/	;61
	SIXBIT	/LOCATE/	;62
	SIXBIT	/WHERE/		;63
	SIXBIT	/DEVNAM/	;64
	SIXBIT	/CTLJOB/	;65
	SIXBIT	/GOBSTR/	;66
	0			;67
	0			;70
	SIXBIT	/HPQ/		;71
	SIXBIT	/HIBER/		;72
	SIXBIT	/WAKE/		;73
	SIXBIT	/CHGPPN/	;74
	SIXBIT	/SETUUO/	;75
	SIXBIT	/DEVGEN/	;76
	SIXBIT	/OTHUSR/	;77
	SIXBIT	/CHKACC/	;100
	SIXBIT	/DEVSIZ/	;101
	SIXBIT	/DAEMON/	;102
	SIXBIT	/JOBPEK/	;103
	SIXBIT	/ATTACH/	;104
	SIXBIT	/DAEFIN/	;105
	SIXBIT	/FRCUUO/	;106
	SIXBIT	/DEVLNM/	;107
	SIXBIT	/PATH./		;110
	SIXBIT	/METER./	;111
	SIXBIT	/MTCHR./	;112
	SIXBIT	/JBSET./	;113
	SIXBIT	/POKE./		;114
	SIXBIT	/TRMNO./	;115
	SIXBIT	/TRMOP./	;116
	SIXBIT	/RESDV./	;117
	SIXBIT	/UNLOK./	;120
	SIXBIT	/DISK./		;121
	SIXBIT	/DVRST./	;122
	SIXBIT	/DVURS./	;123
	SIXBIT	/XTTSK./	;124
	SIXBIT	/CAL11./	;125
	SIXBIT	/MTAID./	;126
	SIXBIT	/IONDX./	;127
	SIXBIT	/CNECT./	;130
	SIXBIT	/MVHDR./	;131
	SIXBIT	/ERLST./	;132
	SIXBIT	/SENSE./	;133
	SIXBIT	/CLRST./	;134
	SIXBIT	/PIINI./	;135
	SIXBIT	/PISYS./	;136
	SIXBIT	/DEBRK./	;137
	SIXBIT	/PISAV./	;140
	SIXBIT	/PIRST./	;141
	SIXBIT	/IPCFR./	;142
	SIXBIT	/IPCFS./	;143
	SIXBIT	/IPCFQ./	;144
	SIXBIT	/PAGE./		;145
	SIXBIT	/SUSET./	;146
	SIXBIT	/COMPT./	;147
	SIXBIT	/SCHED./	;150
	SIXBIT	/ENQ./		;151
	SIXBIT	/DEQ./		;152
	SIXBIT	/ENQC./		;153
	SIXBIT	/TAPOP./	;154
	SIXBIT	/FILOP./	;155
	SIXBIT	/CAL78./	;156
	SIXBIT	/NODE./		;157
	SIXBIT	/ERRPT./	;160
	SIXBIT	/ALLOC./	;161
	SIXBIT	/PERF./		;162

CALNTH==.-CALTBL
NEGCAL==CALLI0-CALTBL		;NUMBER OF NEGATIVE CALLI'S

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

TTCLTH==.-TTCTBL

MTATBL:	SIXBIT	/MTWAT./	;  0
	SIXBIT	/MTREW./	;  1
	SIXBIT	/MTEOF./	;  3
	SIXBIT	/MTSKR./	;  6
	SIXBIT	/MTBSR./	;  7
	SIXBIT	/MTEOT./	; 10
	SIXBIT	/MTUNL./	; 11
	SIXBIT	/MTBLK./	; 13
	SIXBIT	/MTSKF./	; 16
	SIXBIT	/MTBSF./	; 17
	SIXBIT	/MTDEC./	;100
	SIXBIT	/MTIND./	;101

MTALTH==.-MTATBL

MTACOD:	BYTE	(9) 0,1,3,6
	BYTE	(9) 7,10,11,13
	BYTE	(9) 16,17,100,101

	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
;**;[440] DELETE 1 INSTR @MSRCH+6	JBC	3-SEP-76
;**	SETZM	EXTPNT		;[324] RESET EXTERNAL POINTERS WORD
	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
;**;[440] INSERT 1 INSTR @SSRCH1+3	JBC	3-SEP-76
	TLNE	ARG,OPDF	;[440] IF IN OPDEF

	SETZM	EXTPNT		;[324] RESET EXTERNAL POINTERS WORD
	PUSHJ	PP,SRCH5	;LOAD REGISTERS
SSRCH2:	AOS	0(PP)		;SET FOR SKIP-EXIT
SSRCH3:	MOVEI	SDEL,%SYM	;SET OPERAND FLAG

CREF:	TLNE	ARG,NCRF	;[220] .XCREF SEEN?
	JRST	[TLZ	IO,DEFCRS	;[220] CLEAR DEFINITION FLAG
		POPJ	PP,]		;[220] AND DON'T CREF
	TLNN	IO,IONCRF	;NO CREFFING FOR THIS SYMBOL?
	TLNE	FR,P1!CREFSW	;PASS ONE OR CROSS-REF SUPPRESSION?
	POPJ	PP,		;YES, EXIT
	EXCH	SDEL,C		;PUT FLAG IN C, SACE C
	PUSH	PP,CS
	TLNE	IO,IOCREF	;HAVE WE PUT OUT THE 177,102
	JRST	CREF3		;YES
	PUSH	PP,C		;START OF CREF DATA

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

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

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

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

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

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

CLSC3:
CLSCRF:	TRNN	ER,LPTSW
	POPJ	PP,		;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	TLZE	 IO,IOCREF	;FINISH UP LINE
	JRST	CLSCR1
	MOVEI	C,0
	TLNE	IO,IOPAGE	;NEW PAGE?
	PUSHJ	PP,OUTL		;YES,GIVE IT A ROUSING SENDOFF!
	MOVEI	C,177
	PUSHJ	PP,OUTLST
	MOVEI	C,102
	PUSHJ	PP,OUTLST	;MARK BEGINNING OF CREF DATA
CLSCR1:	TRNN	ER,ERRORS	;ANY ERRORS TO CREF
	JRST	CLSCR6		;NO, JUST CLOSE OUT
	MOVE	C,[POINT 6,[SIXBIT /QXADLRUVNOPEMS/]]
	PUSH	PP,ER		;SAVE 
	ANDI	ER,ERRORS	;ONLY LOOK AT THESE
	HRLZ	ER,ER		;PUT FLAGS IN LEFT HALF
CLSCR4:	ILDB	CS,C		;GET NEXT ERROR CODE
	LSH	ER,1		;SHIFT FLAG IN
	JUMPE	ER,CLSCR5	;FINISHED
	JUMPG	ER,CLSCR4	;NOT YET
	PUSH	PP,C		;SAVE BYTE POINTER
	TDO	CS,['%.... ']	;MAGIC SYMBOL
	MOVEI	C,%ERR		;TYPE
	PUSHJ	PP,OUTLST
	MOVEI	C,6		;NO OF CHARS.
	PUSHJ	PP,OUTLST
	SETZ	C,		;CLEAR RECEIVING ACC
	LSHC	C,6		;SHIFT IN CHAR
	ADDI	C,40		;TO ASCII
	PUSHJ	PP,OUTLST
	JUMPN	CS,.-4		;MORE TO DO
	POP	PP,C		;BYTE POINTER BACK
	JUMPN	ER,CLSCR4	;GET NEXT
CLSCR5:	POP	PP,ER		;RESTORE ER
CLSCR6:	MOVEI	C,177
	PUSHJ	PP,OUTLST
	MOVEI	C,103
	JRST	OUTLST		;MARK END OF CREF DATA
>	;END OF REPEAT 1
IFE POLISH,<
SEARCH:	HLRZ	SX,SRCHX
	HRRZ	SDEL,SRCHX

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

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

SRCH4:	AOS	0(PP)		;SET FOR SKIP EXIT
SRCH5:	MOVSI	ARG,SUPRBT	;HE IS USING IT, TURN OFF BIT
	ANDCAM	ARG,(SX)	; IN THE TABLE
SRCH7:	MOVE	ARG,0(SX)	;FLAG AND VALUE TO ARG
	LDB	RC,RCPNTR	;POINT 1,ARG,17
	TLNE	ARG,LELF	;CHECK LEFT RELOCATE
	TLO	RC,1
	HRRZ	V,ARG
	TLNE	ARG,SPTR	;CHECK SPECIAL EXTESN POINTER
	JRST	SRCH6
	TLNE	ARG,PNTF
	MOVE	V,0(ARG)		;36BIT VALUE TO V
	JRST	SRCHOK
	
SRCH6:	MOVE	V,0(ARG)	;VALUE
	MOVE	RC,1(ARG)	;AND RELOC
	TLNE	RC,-2		;CHECK AND SET EXTPNT
	HLLM	RC,EXTPNT
	TRNE	RC,-2	
	HRRM	RC,EXTPNT
	JRST	SRCHOK

SRCHNO:	SKIPN	UNISCH+1	;ALLOWED TO SEARCH OTHER TABLES
	POPJ	PP,		;NO, JUST RETURN
	AOS	V,UNISCH	;GET NEXT INDEX TO TABLE
	CAIE	V,1		;FIRST TIME IN
	JRST	SRCHN1		;YES, SAVE SYMBOL INFO
	HRLM	SX,UNISCH	;SAVE SX AND SET FLAG
	MOVE	ARG,SRCHX	;SEARCH POINTER
	MOVEM	ARG,UNISHX	;TO A SAFE PLACE
	HRR	ARG,SYMBOL
	HRL	ARG,SYMTOP
	MOVEM	ARG,UNIPTR	;STORE ALSO
SRCHN1:	MOVE	V,UNISCH(V)	;GET TRUE INDEX
	JUMPE	V,SRCHKO	;IF ZERO ALL TABLE SCANNED
	MOVE	ARG,UNISHX(V)	;NEW SRCHX
	MOVEM	ARG,SRCHX	;SET IT UP
	MOVE	ARG,UNIPTR(V)	;SYMTOP,,SYMBOL
	HRRZM	ARG,SYMBOL
	HLRZM	ARG,SYMTOP
	JRST	SEARCH		;TRY AGAIN

>
IFN POLISH,<
SEARCH:	PUSHJ	PP,SRCHI	;SET UP SRCHX
	TLZ	IO,RSASSW	;CLR INTER-PSECT REF SWITCH
	HRRZ	AC1,SGNCUR	;GET CUR PSECT INX
	MOVEM	AC1,SGWFND	;SET PSECT WHERE FOUND
	PUSHJ	PP,SRCH		;SEARCH CURRENT PSECT
	  JRST	SRCHSG		;NOPE, TRY OTHER PSECT.S
	JRST	SRCH4S		;COMMON SUCCESSFUL EXIT

SRCHSG:	PUSH	PP,SX		;SAVE SX VALUE
	PUSH	PP,SGNCUR	;SAVE SGNCUR
	PUSH	PP,SGNMAX	;INIT PSECT INX
SRCHSL:	MOVE	V,0(PP)		;GET PSECT INX
	CAMN	V,-1(PP)	;DON'T SEARCH CURRENT
	JRST	SRCHSC		; PSECT AGAIN
	MOVEM	V,SGNCUR	;FUDGE CUR PSECT
	PUSHJ	PP,SRCHI	;SET UP SRCHX
	PUSHJ	PP,SRCH		;SEARCH THIS PSECT
	  JRST	SRCHSC		;NOT HERE EITHER
	MOVE	AC1,SGNCUR	;GET RELEVANT PSECT INX
	MOVEM	AC1,SGWFND	;SET PSECT WHERE FOUND
	SKIPGE	-1(PP)		;WANT TO EVALUATE IN THIS PSECT?
	JRST	SRCH4		;YES, JUST EXIT
	MOVE	ARG,0(SX)	;GET FLAGS
	TLNN	ARG,EXTF	;EXTERNAL?
	JRST	.+3		;NO
	TLNN	ARG,SPTR	;BUT NOT SPECIAL
	JRST	SRCHEX		;YES, MUST STOR IN REQUESTING PSECT
	TLNE	ARG,LELF!RELF	;IF RELOCATABLE THEN
	TLO	IO,RSASSW	; SET INTER-PSECT REF SWITCH
	JRST	SRCH4		;COMMON SUCCESSFUL EXIT

SRCHEX:	POP	PP,AC1	;INDEX
	POP	PP,SGNCUR	;RESTORE
	POP	PP,SX		;WHERE IT SHOULD BE
	MOVEI	SDEL,2		;NEEDS 2 WORDS
	ADDB	SDEL,FREE
	CAML	SDEL,SYMBOL	;WILL IT FIT?
	PUSHJ	PP,XCEEDS	;NO
	SETZM	-2(SDEL)	;VALUE
	MOVEM	AC0,-1(SDEL)	;NAME
	MOVEI	V,-2(SDEL)	;POINTER
	MOVSI	ARG,SYMF!EXTF!PNTF	;FLAGS WE NEED
	PUSHJ	PP,INSERT	;PUT IT IN
	JRST	SEARCH		;TRY AGAIN

SRCHSC:	SOS	V,0(PP)		;BUMP PSECT INX
	JUMPGE	V,SRCHSL	;LOOP IF MORE PSECTS
	POP	PP,AC1		;THROW AWAY PSECT INX
	POP	PP,SGNCUR	;RESTORE SGNCUR
	PUSHJ	PP,SRCHI	;RESET SRCHX
	POP	PP,SX		;RESTORE SX VALUE
	SKIPN	UNISCH+1	;ALLOWED TO SEARCH OTHER TABLES
	POPJ	PP,		;NO, JUST RETURN
	HRLM	SX,UNISCH	;SAVE SX AND SET FLAG
	MOVE	ARG,SRCHX	;SEARCH POINTER
	MOVEM	ARG,UNISHX	;TO A SAFE PLACE
	HRR	ARG,SGSBOT
	HRL	ARG,SGSTOP
	MOVEM	ARG,UNIPTR	;STORE ALSO
SRCHUL:	AOS	V,UNISCH	;GET NEXT INDEX TO TABLE
	MOVE	V,UNISCH(V)	;GET TRUE INDEX
	JUMPE	V,SRCHKO	;IF ZERO ALL TABLE SCANNED
	MOVE	ARG,UNISHX(V)	;NEW SRCHX
	MOVEM	ARG,SRCHX	;SET IT UP
	MOVE	ARG,UNIPTR(V)	;SGSTOP,,SGSBOT
	HRRZM	ARG,SGSBOT
	HLRZM	ARG,SGSTOP
	PUSHJ	PP,SRCH		;SEARCH UNIV SYM TAB
	  JRST	SRCHUL		;NOPE, TRY NEXT ONE
	JRST	SRCH4S		;COMMON SUCCESSFUL EXIT

SRCH4:	POP	PP,AC1		;THROW AWAY PSECT INX
	POP	PP,SGNCUR	;RESTORE SGNCUR
	POP	PP,AC1		;THROW AWAY SX VALUE
SRCH4S:	AOS	0(PP)		;SET FOR SKIP EXIT
SRCH5:	MOVSI	ARG,SUPRBT	;HE IS USING IT, TURN OFF BIT
	ANDCAM	ARG,(SX)	; IN THE TABLE
SRCH7:	MOVE	ARG,0(SX)	;FLAG AND VALUE TO ARG
	LDB	RC,RCPNTR	;POINT 1,ARG,17
	TLNE	ARG,LELF	;CHECK LEFT RELOCATE
	TLO	RC,1
	HRRZ	V,ARG
	TLNE	ARG,SPTR	;CHECK SPECIAL EXTESN POINTER
	JRST	SRCH6
	TLNE	ARG,PNTF
	MOVE	V,0(ARG)	;36BIT VALUE TO V
	JRST	SRCHOK
SRCH6:	MOVE	V,0(ARG)	;VALUE
	MOVE	RC,1(ARG)	;AND RELOC
	TLNE	RC,-2		;CHECK AND SET EXTPNT
	HLLM	RC,EXTPNT
	TRNE	RC,-2	
	HRRM	RC,EXTPNT
	JRST	SRCHOK
>
SRCHKO:	SETZ	ARG,		;CLEAR ARG SO ZERO STORED
SRCHOK:	SKIPN	UNISCH		;HAVE WE SEARCH OTHER TABLES
	POPJ	PP,		;NO, JUST RETURN
SYMBCK:	HLRZ	SX,UNISCH	;RESTORE SX
	SETZM	UNISCH		;CLEAR SYMBCK FLAG
	MOVE	SDEL,UNISHX	;SRCHX
	MOVEM	SDEL,SRCHX	;RESTORE ORIGINAL
IFE POLISH,<
	MOVE	SDEL,UNIPTR	;SYMTOP,,SYMBOL
	HRRZM	SDEL,SYMBOL
	HLRZM	SDEL,SYMTOP
	JUMPE	ARG,CPOPJ	;TOTALLY UNDEFINED
>
IFN POLISH,<
	MOVE	SDEL,UNIPTR	;SGSTOP,,SGSBOT
	HRRZM	SDEL,SGSBOT
	HLRZM	SDEL,SGSTOP
	JUMPE	ARG,CPOPJ	;TOTALLY UNDEFINED
	PUSH	PP,SGNCUR	;SAVE CUR PSECT
	SETZM	SGNCUR		;SET TO BLANK PSECT
	SETZM	SGWFND		;SET PSECT WHERE FOUND
	PUSHJ	PP,SRCHI	;SET UP SRCHX
	PUSHJ	PP,SRCH		;SET UP SX
	  JFCL
>
	TLNE	ARG,SPTR	;[256] SPECIAL EXTERNAL?
	JRST	SYMBKS		;[256] YES
	TLNE	ARG,EXTF	;EXTERNAL?
	JRST	SYMBKX		;YES, NEED 2 MORE CELLS
	TLNN	ARG,PNTF	;36 BIT VALUE FLAG SET?
	JRST	.+3		;[265] NO, PUT IN TABLE AND RETURN
	TLNN	V,-1		;BUT IS IT ONLY 18 BIT VALUE?
	TLZ	ARG,PNTF	;YES, SO ONLY USE 18 BITS
IFE POLISH,<
	JRST	INSERT
	SYN	CPOPJ,SYMBKR
>
IFN POLISH,<
	PUSHJ	PP,INSERT	;[265] STILL HAVE 0 PSECT
SYMBKR:	POP	PP,SGNCUR	;[265] RESTORE CUR PSECT
	POPJ	PP,		;[265]
>

SYMBKX:	PUSH	PP,[EXP	SYMBKR]	;[265] RETURN ADDRESS
	PUSH	PP,1(ARG)	;SAVE SIXBIT NAME
	MOVSI	ARG,SYMF!EXTF!PNTF	;SET ONLY THE REQUIRED FLAGS
				;[265] PUT 2 WORDS IN CORE
SYMBKY:	PUSHJ	PP,INSERZ	;[256] INSERT SYMBOL IN TABLE
	MOVEI	SDEL,2		;GET 2 CELLS FROM FREE CORE
	ADDB	SDEL,FREE
	CAML	SDEL,SYMBOL	;MORE CORE NEEDED?
	PUSHJ	PP,XCEEDS	;YES
	HRRI	ARG,-2(SDEL)	;POINTER TO VALUE
	SETZM	(ARG)		;AND CLEAR IT
	POP	PP,1(ARG)	;STORE SIXBIT VALUE
	MOVEM	ARG,(SX)	;SET FLAGS AND VALUE AS IT SHOULD BE
	POPJ	PP,		;RETURN

SYMBKS:	PUSH	PP,V		;[256] SAVE ADDITIVE VALUE
	PUSH	PP,[Z SYMBKZ]	;[336] SET UP RETURN ADDRESS FOR PJRST
	PUSH	PP,ARG		;[323] SAVE SYMBOL'S FLAGS
	PUSH	PP,UNISCH+1	;[256] ONLY SEARCH MAIN TABLE
	SETZM	UNISCH+1	;[256] ...
	PUSH	PP,AC0		;[256] SAVE SYMBOL WE REALLY WANT
	MOVE	ARG,1(ARG)	;[256] GET POINTER TO DEFINING SYMBOL
	MOVE	AC0,1(ARG)	;[256] AND FINALLY SYMBOL
	PUSHJ	PP,SEARCH	;[256] SEE IF DEFINING GLOBAL IS IN TABLE
	  PUSHJ	PP,[PUSH PP,1(ARG)	;SAVE SIXBIT NAME
		MOVSI	ARG,SYMF!EXTF!PNTF	;SET ONLY THE REQUIRED FLAGS
		JRST	SYMBKY]		;[256] NO, PUT IN SYMBOL TABLE
	POP	PP,AC0		;[256] GET SYMBOL BACK
	PUSHJ	PP,SEARCH	;[256] SETUP SX AGAIN
	  JFCL			;[256] WILL ALWAYS FAIL
	POP	PP,UNISCH+1	;[256] BACK TO MULTIPLE SEARCHES
	HLL	ARG,0(PP)	;[256] RECOVER FLAGS
	HRRZM	ARG,0(PP)	;[256] STACK POINTER TO GLOBAL
	JRST	SYMBKY		;[323] AND DO DUMMY PUSHJ
SYMBKZ:				;[323] FAKE RETURN ADDRESS
	POP	PP,V		;[256] GET OFFSET
	MOVEM	V,0(ARG)	;[256] STORE OFFSET
	JRST	SYMBKR		;[265] RETURN
IFN POLISH,<
SRCH:	HLRZ	SX,SRCHX
	HRRZ	SDEL,SRCHX
SRCH1:	CAML	AC0,-1(SX)
	JRST	SRCH3
SRCH2:	SUB	SX,SDEL
	LSH	SDEL,-1
	CAMG	SX,SGSTOP
	JUMPN	SDEL,SRCH1
	JUMPN	SDEL,SRCH2
	SOJA	SX,SRCHNO	;NOT FOUND
SRCH3:	CAMN	AC0,-1(SX)
	JRST	SRCHYE		;NORMAL / FOUND EXIT
	ADD	SX,SDEL
	LSH	SDEL,-1
	CAMG	SX,SGSTOP
	JUMPN	SDEL,SRCH1
	JUMPN	SDEL,SRCH2
	SOJA	SX,SRCHNO	;NOT FOUND
	SYN	CPOPJ1,SRCHYE	;SKIP RETURN
	SYN	CPOPJ,SRCHNO	;NON-SKIP RETURN
>
INSERQ:	TLNE	ARG,UNDF!VARF
INSERZ:	SETZB	RC,V
INSERT:	CAME	AC0,-1(SX)	;ARE WE LOOKING AT MATCHING MNEMONIC?
	JRST	INSRT2		;NO, JUST INSERT
	JUMPL	ARG,INSRT1	;YES, BRANCH IF OPERAND
	SKIPL	0(SX)		;OPERATOR, ARE WE LOOKING AT ONE?
	JRST	UPDATE		;YES, UPDATE
	JRST	INSRT2		;NO, INSERT

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

INSRT4:	HRR	ARG,V		;18 BIT VALUE ARG
	TLNN	ARG,EXTF	;[204] POSSIBLE TO BE EXT WITH 0 RELOC SO DON'T
	TLZ	ARG,PNTF	;[204] CLEAR POINTER FLAG INCASE SET
INSRT7:	DPB	RC,RCPNTR	;FIX RIGHT RELOCATION
	TLNE	RC,1
	TLO	ARG,LELF	;FIX LEFT RELOCATION
INSRT6:	MOVEM	ARG,0(SX)	;INSERT FLAGS AND VALUE.
	MOVEM	AC0,-1(SX)	;INSERT SYMBOL NAME.
	PUSHJ	PP,SRCHI	;INITILIAZE SRCHX
	JRST	QSRCH		;EXIT THROUGH CREF
	
INSRT5:	MOVEI	SDEL,2		;GET TWO CELLS FROM FREE CORE
	ADDB	SDEL,FREE
	CAML	SDEL,SYMBOL	;MORE CORE NEEDED?
	PUSHJ	PP,XCEEDS	;YES
	MOVEM	RC,-1(SDEL)
	HRRI	ARG,-2(SDEL)	;POINTER TO ARG
	MOVEM	V,0(ARG)
	TLO	ARG,SPTR	;SET SPECIAL POINTER, POINTS TO TWO CELLS
	JRST	INSRT6
REMOVE:
IFN POLISH,<
	MOVEI	AC2,0(SX)	;ADDRESS OF THE SYMBOL
	SUB	AC2,SYMBOL	; - BASE OF SYMBOL TABLE
	LSH	AC2,-1		; / 2 = SYMBOL ORDINAL
	TDZA	AC1,AC1		;INIT PSECT INDEX
	ADDI	AC1,1		;INCREMENT PSECT INDEX
	HRRZ	AC0,SGSCNT(AC1)	;WITHIN THIS PSECT?
	SUB	AC2,AC0
	JUMPG	AC2,.-3		;TRY NEXT PSECT IF NOT
	SOS	SGSCNT(AC1)	;DECREMENT PSECT SYM COUNT
>
	SUBI	SX,2		;MOVE EVERYONE UP TWO LOCATIONS
REMOV1:	MOVE	0(SX)
	MOVEM	2(SX)		;OVERWRITE THE DELETED SYMBOL
	CAME	SX,SYMBOL	;SKIP WHEN DONE
	SOJA	SX,REMOV1
	ADDI	SX,2
	MOVEM	SX,SYMBOL
	SOS	0(SX)		;DECREMENT THE SYMBOL COUNT

SRCHI:	MOVEI	AC2,0		;THIS CODE SETS UP SRCHX
IFE POLISH,<
	FAD	AC2,@SYMBOL
>
IFN POLISH,<
	HRRZ	AC1,SGNCUR
	HRRZ	AC1,SGSCNT(AC1)
	FAD	AC2,AC1
>
	LSH	AC2,-^D27
	MOVEI	AC1,1000
	LSH	AC1,-357(AC2)
	HRRM	AC1,SRCHX
	LSH	AC1,1
IFE POLISH,<
	ADD	AC1,SYMBOL
	HRLM	AC1,SRCHX
>
IFN POLISH,<
	HRLM	AC1,SRCHX
	MOVE	AC1,SYMBOL
	MOVEM	AC1,SGSBOT
	HRRZ	AC2,SGNCUR
	JUMPE	AC2,SRCHI2
SRCHI1:	HRRZ	AC1,SGSCNT-1(AC2)
	LSH	AC1,1
	ADDB	AC1,SGSBOT
	SOJG	AC2,SRCHI1
SRCHI2:	MOVS	AC2,AC1
	ADDM	AC2,SRCHX
	MOVE	AC2,SGNCUR
SRCHI3:	HRRZ	AC1,SGSCNT(AC2)
	LSH	AC1,1
	ADD	AC1,SGSBOT
	MOVEM	AC1,SGSTOP
>
	POPJ	PP,		;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4
UPDATE:	DPB	RC,RCPNTR	;FIX RIGHT RELOCATION
	TLNE	ARG,SPTR	;SKIP IF THERE IS NO SPECIAL POINTER
	JRST	UPDAT4		;YES, USE THE TWO CELLS
	TDNE	RC,[-2,,-2]	;NEED TO CHANGE ANY CURRENT EXTERNS
	JRST	UPDAT5		;YES ,JUMP
	TLZ	ARG,LELF	;CLEAR LELF
	TLNE	RC,1		;LEFT RELOCATABLE?
	TLO	ARG,LELF	;YES, SET THE FLAG
	TLNE	ARG,PNTF	;WAS THERE A 36BIT VALUE?
	JRST	UPDAT2		;YES, USE IT.
	TLNE	V,-1		;NO,IS THERE A 36BIT VALUE?
	JRST	UPDAT1		;YES, GET A CELL
	HRR	ARG,V		;NO, USE RH OF ARG
UPDAT3:	MOVEM	ARG,0(SX)	;OVERWRITE THE ONE IN THE TABLE
IFE POLISH,<
	POPJ	PP,		;AND EXIT
>
IFN POLISH,<
	JRST	UPDAT6		;AND EXIT
>

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

UPDAT5:	MOVEI	SDEL,2		;THERE IS A EXTERNAL
	ADDB	SDEL,FREE	;SO WE NEED TWO LOACTIONS
	CAML	SDEL,SYMBOL	;NEED MORE CORE?
	PUSHJ	PP,XCEEDS	;YES
	MOVEM	RC,-1(SDEL)	;SAVE RELOCATION BITS
	HRRI	ARG,-2(SDEL)	;SAVE THE POINTER IN ARG
	MOVEM	V,0(ARG)	;SAVE A 36BIT VALUE
	TLO	ARG,SPTR	;SET SPECIAL PNTR FLAG
	TLZ	ARG,PNTF	;CLEAR POINTER FLAG
	JRST	UPDAT3		;SAVE THE POINTER AND EXIT
IFN POLISH,<
UPDAT6:	TLNN	IO,DEFCRS	;DEFINING OCCURANCE?
	POPJ	PP,		;NO, RETURN
	TLNE	ARG,EXTF	;EXTERNAL?
	POPJ	PP,		;YES, RETURN
	MOVE	SDEL,SYMBOL	;GET START OF SYM TAB
	SETZ	AC1,		;ZERO PSECT INX
UPDAT7:	HRRZ	AC2,SGSCNT(AC1)	;PSECT SYM CNT
	LSH	AC2,1		;DOUBLE IT
	ADD	SDEL,AC2	;END OF PSECT
	CAMGE	SDEL,SX		;SYM IN THIS PSECT?
	AOJA	AC1,UPDAT7	;NO, TRY NEXT PSECT
	CAMN	AC1,SGNCUR	;IF IT'S IN THE CUR PSECT
	POPJ	PP,		; THEN RETURN
	PUSH	PP,AC1		;SAVE PRESENT PSECT INX
	PUSH	PP,0(SX)	;SAVE SYMBOL STUFF
	PUSH	PP,-1(SX)	; AND NAME
	PUSH	PP,SX		;SAVE PRESENT SYM INX
	PUSHJ	PP,SRCHI	;SET UP SRCHX
	PUSHJ	PP,SRCH		;SET UP NEW SX
	  JFCL
	POP	PP,SDEL		;RESTORE PRESENT SYM INX
	MOVE	AC1,-2(PP)	;GET PRESENT PSECT INX
	CAMG	AC1,SGNCUR	;WHICH WAY TO MOVE?
	JRST	UPDAT9		;DOWN
	ADDI	SX,2		;MUST MOVE THIS ONE ALSO
UPDAT8:	MOVE	AC2,-2(SDEL)	;MOVE PART OF
	MOVEM	AC2,0(SDEL)	; SYMBOL TABLE
	CAILE	SDEL,0(SX)	;ENOUGH MOVED?
	SOJA	SDEL,UPDAT8	;NO
	JRST	UPDT10		;COMMON EXIT
UPDAT9:	HRLI	AC2,1(SDEL)	;FROM HERE
	HRRI	AC2,-1(SDEL)	; TO HERE
	BLT	AC2,-2(SX)	; UNTIL HERE, MOVE!
UPDT10:	POP	PP,-1(SX)	;RESTORE SYMBOL NAME
	POP	PP,0(SX)	; AND STUFF
	POP	PP,AC1		;OLD PSECT INX
	SOS	SGSCNT(AC1)	;DECR ITS SYM CNT
	MOVE	AC1,SGNCUR	;CUR PSECT INX
	AOS	SGSCNT(AC1)	;INCR ITS SYM CNT
	PUSHJ	PP,SRCHI	;SET UP SRCHX
	POPJ	PP,		;RETURN
>
	SUBTTL	CONSTANTS


IFN FORMSW,<
HWFORM:	BYTE	(18) 1,1
INFORM:	BYTE 	(9) 1 (4) 1 (1) 1 (4) 1 (18) 1
IOFORM:	BYTE	(3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1
BPFORM:	BYTE	(6) 1,1 (2) 1 (4) 1 (18) 1
ASCIIF:	BYTE	(7) 1,1,1,1,1
SXFORM:	BYTE	(6) 1,1,1,1,1,1
>

	SUBTTL PHASED CODE

IFN PURESW,<LOWH:
	PHASE	LOWL>

IFN FT.U01,<
$USRPD:	IOWD	$USRLN,$USSTK
>;END IFN FT.U01
IFN TEMP,<TMPFIL: SIXBIT /MAC/
	XWD	-200,0>
LSTFIL:	BLOCK 1
	SIXBIT /@/	;SYMBOL TO STOP PRINTING
TABI:
IFE FORMSW,<	BYTE	(7) 0, 11, 11, 11, 11>
IFN FORMSW,<	BYTE	(7) 11,11, 11, 11, 11>
SEQNO:	BLOCK	1
	ASCIZ	/	/
BININI:	EXP	B
BINDEV:	BLOCK	1
	XWD	BINBUF,0
LSTINI:	EXP	AL
LSTDEV:	BLOCK	1
	XWD	LSTBUF,0
IFN CCLSW,<
RPGINI:	EXP	AL
RPGDEV:	BLOCK 1
	XWD 0,CTLBLK
>
INDEVI:	EXP	A
INDEV:	BLOCK	1
	XWD	0,IBUF

UNVINI:	EXP	B		;[240] OPEN BLOCK FOR BINARY UNV
UNVDEV:	BLOCK	1		;[240] SO USER CAN SPECIFY
	EXP	UNVBUF		;[240]

..LPP:	EXP	.LPP-2		;[227] "READ-ONLY" LINES/PAGE

DBUF:	ASCIZ	/ TI:ME DY-MON-YR PAGE /
VBUF:	ASCIZ	/	MACRO %/	;MUST BE LAST LOCATIONS IN BLOCK
IFE PURESW,<	BLOCK	3	;ALLOW FOR LONG TITLE>
IFN PURESW,<	DEPHASE
	LENLOW==.-LOWH>

SUBTTL	STORAGE CELLS

IFN PURESW,<	RELOC	LOWL
LOWL:	BLOCK	LENLOW+3 >
PASS1I:

RP:	BLOCK	1
IFN POLISH,<
POLSTK:	BLOCK	1		;[164]
POLPTR:	BLOCK	1		;[164]
>
CTLBUF:	BLOCK	<CTLSIZ+5>/5
LSTBUF:	BLOCK	3
BINBUF:	BLOCK	3
IBUF:	BLOCK	3
UNVBUF:	BLOCK	3
LSTDIR:	BLOCK	4
BINDIR:	BLOCK	4
INDIR:	BLOCK	4
UNVDIR:	BLOCK	4
UNVPTH:	BLOCK	2+.SFDLN	;[240] PATH FOR UNV LOOKUP
MYPPN:	BLOCK	1		;[405]LOGGED IN PPN

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

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

UPARRO:	BLOCK	1		;[333] SWITCH WORD FOR RE-EATING ^ IF NOT FOLLOWED BY - OR !
OKOVFL:	BLOCK	1		;[362] -1 == * OR / OVERFLOW OK
DECTAB:	BLOCK	1		;[206] -1 == TABS NOT INCLUDED IN MACRO ARGS
IFN TSTCD,<
TCDFLG:	BLOCK	1		;[414]-1 MEANS TEST MODE, 0 REGULAR MODE
> ; NFI TSTCD
ERRCNT:	BLOCK	1
EOFFLG:	BLOCK	1		;[417]END OF FILE SEEN,NEXT FILE OPENED
NOFLG:	BLOCK	1		;0=DIRECTIVE XXX  -1=DIRECT NO XXXX
QERRS:	BLOCK	1		;COUNT OF "Q" ERRORS
FREE:	BLOCK	1
HIGH1:	BLOCK	1
HISNSW:	BLOCK	1
SVTYP3:	BLOCK	1
HMIN:	BLOCK	1		;START OF HIGH SEG. IN TWO SEG. PROG.
SXSV:	BLOCK	1
SDELSV:	BLOCK	1
COLSIZ:	BLOCK	1
SYMBLK:	BLOCK	1
IFBLK:	BLOCK	.IFBLK
IFBLKA:	BLOCK	.IFBLK
LADR:	BLOCK	1
NCOLLS:	BLOCK	1
LIMBO:	BLOCK	1
LBUFP:	BLOCK	1
LBUF:	BLOCK	<.CPL+5>/5
.SGLVZ==.			;[264] START OF LIT /VAR AREA
	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
.SGLVL==.-.SGLVZ		;[264] LENGTH OF LIT/VAR AREA
LITERR:	BLOCK	1		;[415]

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
IFN POLISH,<
SGNMAX:	BLOCK	1
SGNAME:	BLOCK	SGNSGS+1
SGRELC:	BLOCK	SGNSGS+1
SGSCNT:	BLOCK	SGNSGS+1
SGATTR:	BLOCK	SGNSGS+1
SGORIG:	BLOCK	SGNSGS+1	;[264] LIT/VAR AREA ,, ORIGIN OF PSECT
SGSBOT:	BLOCK	1
SGSTOP:	BLOCK	1
SGWFND:	BLOCK	1
>

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

IFN FORMSW,<
STFORM:	BLOCK	.STP
FORM:	BLOCK	1
HWFMT:	BLOCK	1
FLDSIZ:	BLOCK	1
IOSEEN:	BLOCK	1
>
TABP:	BLOCK	1
TCNT:	BLOCK	1		;COUNT OF CHARS. LEFT IN TBUF
TBUF:	BLOCK	.TBUF/5
DEVBUF:	BLOCK	6		;STORE NAME.EXT CREATION DATE AND TIME
TYPERR:	BLOCK	1
PRGPTR:	BLOCK	1		;POINTER TO CHAIN OF PRGEND BLOCKS
ENTERS:	BLOCK	1		;-1 WHEN ENTERS HAVE BEEN DONE
UNIVSN:	BLOCK	1		;-1 WHEN A UNIVERSAL SEEN
UNVSKP:	BLOCK	1		;-1 IF /U SEEN (DON'T SAVE UNIV)
CPUTYP:	BLOCK	1		;[235] CPU TYPE FOR HEADER BLOCK
IFN FT.U01,<
$USSTK:	BLOCK	$USRLN		;USER PUSH-DOWN STACK
>;END IFN FT.U01

PASS2I:

ABSHI:	BLOCK	1
HIGH:	BLOCK	1
HHIGH:	BLOCK	1		;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.
IFN POLISH,<
SGNCUR:	BLOCK	1
SGDMAX:	BLOCK	1
SGLIST:	BLOCK	SGNDEP+1
>
ACDEVX:	BLOCK	1
CPL:	BLOCK	1
CTLSAV:	BLOCK	1
CTLS1:	BLOCK	1
EXTPNT:	BLOCK	1
INTENT:	BLOCK	1
INREP:	BLOCK	1
INDEF:	BLOCK	1
INTXT:	BLOCK	1
INCND:	BLOCK	1
CALNAM:	BLOCK	1
COMSW:	BLOCK	1		;[425] -1 IF IN COMMENT WHILE LOOKING FOR ANG.BRKT.
;DO NOT SPLIT THIS BLOCK	OF 4 WORDS
PAGENO:	BLOCK	1
SEQNO2:	BLOCK	1
TAG:	BLOCK	1
TAGINC:	BLOCK	1
CALPG:	BLOCK	4
DEFPG:	BLOCK	4
LITPG:	BLOCK	4
REPPG:	BLOCK	4
TXTPG:	BLOCK	4
CNDPG:	BLOCK	4
IRPCNT:	BLOCK	1
IRPARG:	BLOCK	1
IRPARP:	BLOCK	1
IRPCF:	BLOCK	1
IRPPOI:	BLOCK	1
IRPSW:	BLOCK	1
LITLVL:	BLOCK	1
LBLFLG:	BLOCK	1		;[402] -1 IF LABEL HAS OCCURRED INSIDE CURRENT LITERAL
LTGINC:	BLOCK	1		;[402] DEPTH OF LABEL IN LITERAL
LITLBL:	BLOCK	2		;[155] NAME OF LABEL DEFINED INSIDE A LITERAL + VALUE

ASGBLK:	BLOCK	1
LOCBLK:	BLOCK	1

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

REPCNT:	BLOCK	1
REPEXP:	BLOCK	1
REPPNT:	BLOCK	1
RPOLVL:	BLOCK	1
R1BCNT:	BLOCK	1
R1BCHK:	BLOCK	1
R1BBLK:	BLOCK	.R1B
R1BLOC:	BLOCK	1
RIMLOC:	BLOCK	1
VECREL:	BLOCK	1
VECTOR:	BLOCK	1
VECSYM:	BLOCK	1		;[244] GLOBAL SYMBOLIC START ADDRESS
IFN POLISH,<
VECFND:	BLOCK	1
>
.TEMP:	BLOCK	1		;TEMPORARY STORAGE
UNISCH:	BLOCK	.UNIV+1		;SEARCH TABLE FOR UNIVERSALS
SQFLG:	BLOCK	1
ARGF:	BLOCK	1

CPEEKC:	BLOCK	1		;[325] ANGLE COUNT AFTER ;; IN MACRO
MACENL:	BLOCK	1
MACLVL:	BLOCK	1
MACPNT:	BLOCK	1
WWRXX:	BLOCK	1
RCOUNT:	BLOCK	1		;COUNT OF WORDS STILL TO READ IN LEAF
WCOUNT:	BLOCK	1		;COUNT OF WORDS STILL FREE IN LEAF
IONSYM:	BLOCK	1		;-1 SUPRESS LISTING OF SYMBOLS
LOCAL:	BLOCK	1		;LINKED LIST OF LOCAL FIXUPS 
IFN POLISH,<
POLTYP:	BLOCK	1		;[164] PRESET IF POLISH FIXUP TYPE KNOWN
POLIST:	BLOCK	1		;[164] LINKED LIST OF POLISH FIXUP BLOCKS
POLITS:	BLOCK	1		;[265] LINKED LIST OF POLISH FIXUPS TO LITS (TEMP)
>
INASGN:	BLOCK	1		;[267] HOLDS SYMBOL NAME DURING ASSIGN INCASE NEEDS POLISH
SFDADD:	BLOCK	3+.SFDLN	;FOR LOOKUP/ENTER OF SFD PATH
SFDE==.-1			;[216] END OF SFD
PPPN:	BLOCK	1		;[216] DEFAULT PPN
PSFD:	BLOCK	3*.SFDLN	;[216] DEFAULT SFD
PSFDE==.-1			;[216] LAST ADDRESS IN SFD
PASS2Z:				;ONLY CLEAR TO HERE ON PRGEND
LSTSYM:	BLOCK	1
SPAGNO:	BLOCK	1		;PAGE NUMBER FOR SYMBOL TABLES
PASS2X:

SUBTTL	MULTI-ASSEMBLY STORAGE CELLS

SAVEPP:	BLOCK	1		;SAVE PP INCASE NO END STATEMENT
SAVEMP:	BLOCK	1		;MACRO PNTR FOR SAME REASOM
SAVERP:	BLOCK	1		;MACRO READ POINTER
LSTPGN:	BLOCK	1
ARAYP:	BLOCK	1
HDAS:	BLOCK	1
IFN CCLSW,<EXTMP:	BLOCK	1	;HOLDS EXT OF COMMAND FILE (RH)
SAVFF:	BLOCK	1>
CTLBLK:	BLOCK	3
CTIBUF:	BLOCK	3
CTOBUF:	BLOCK	3
IFN TEMP,<TMPFLG:	BLOCK	1>
IFN FORMSW,<PHWFMT:	BLOCK	1>
MACSIZ:	BLOCK	1		;INITIAL SIZE OF LOW SEG
UNISIZ:	BLOCK	1		;TOP OF BUFFERS AND STACKS
UNITOP:	BLOCK	1		;TOP OF UNIVERSAL SYMBOL TABLE
UNIVNO:	BLOCK	1		;NUMBER OF UNIVERSALS SEEN
UNITBL:	BLOCK	.UNIV+1		;TABLE OF UNIVERSAL NAMES
UNIPTR:	BLOCK	.UNIV+1		;TABLE OF SYMBOL POINTERS
UNISHX:	BLOCK	.UNIV+1		;TABLE OF SRCHX POINTERS
UNVDFA:	BLOCK	1		;[334] DEFAULT ARGUMENT POINTER FOR UNIVERSAL I/O 
UNVER%:	BLOCK	1		;[334] OLD UNIVERSAL FILE IF -1, MAY HAVE LOST DEFAULT ARGS
RTIME:	BLOCK	1		;[234] CPU TIME AT START OF PASS1
	VAR			;CLEAR VARIABLES

IFE POLISH,<SYN HIGH,SGATTR>
JOBFFI:	BLOCK	203*NUMBUF+1	;INPUT BUFFER PLUS ONE
IFN PURESW,<LOWEND==.-1
	RELOC >

	END	BEG