Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - midas/omidas.mid
There are no other files named omidas.mid in the archive.
; -*-MIDAS-*-
IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4973.,2000.	;THIS MANY ON DEC SYSTEM
.ELSE .SYMTAB 17393. 	;2001.th prime -- Assemble faster elsewhere.

TITLE MIDAS
SUBTTL INITIAL DEFINITIONS

; AC DEFINITIONS.  FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE
; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC.
; ALSO,
.SEE R1

FF=:0	; FLAGS.  MUST BE AC 0.
AA=:1	; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL.
A=:AA+1	; 2
B=:A+1	; 3
C=:B+1	; 4
D=:C+1	; 5
T=:6	; NOT SO TEMP AS IN MOST PROGS W/ T
TT=:T+1	; 7
I=:10	; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF
SYM=:11	; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR
LINK=:SYM+1
F=:13
CH1=:14	; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH
CH2=:CH1+1 ;" " "
TM=:16	; SUPER TEMPORARY
P=:17	; PDL AC, MUST BE 17.  AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL
	; ASSUMES P=17.


IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T

;OPERATING SYSTEM CONDITIONAL FLAGS:
;  ITSSW IS 1 IF TO RUN ON ITS.
;  DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU).
;  TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX.
;  SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10.
;  CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10.
;  DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE
;   TO BE MOVED TO AFTEREXECUTION IS STARTED.
;  DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1).
;  SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE.
;  TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE).
;  CVTSW IS TO MAKE A MIDAS USING A DECDFS OR TNXDFS FILE GENERATED BY CVT.
;   CVT READS A MONSYM FILE AND MAKES A TNXDFS.MID FILE, ALTHOUGH IT COULD
;   BE HACKED TO READ UUOSYM AND MAKE DECDFS TOO.  THERE IS NO SEPARATE
;   DECBTS OR TWXBTS FILE WHEN USING CVT.

IF1,[	;FOR PASS 1 TTY CONDITIONALS
IFDEF SAILSW,IFN SAILSW,DECSW==1
IFDEF CMUSW,IFN CMUSW,DECSW==1
IFDEF DECDBG,IFN DECDBG,DECSW==1
IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0
IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0
IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0
] ; IF1
IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0	;NON-ZERO => ITS VERSION
IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0	;NON-ZERO => TENEX VERSION
IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0	;NON-ZERO => DEC VERSION
				; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC
				; UUO'S DEFINED TOO ONCE UPON A TIME
IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under?
IFNDEF DECDBG,DECDBG==0		;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT.
IFN DECSW,[
IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0	;NON-ZERO => SAIL VERSION.
IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0	;NON-ZERO => CMU VERSION.
]
IFE DECSW,SAILSW==0 ? CMUSW==0	;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION
IFNDEF SMALSW,SMALSW==DECSW-<CMUSW+SAILSW>	;NON-ZERO => SMALL MIDAS (NORMALLY
						; FOR RANDOM DEC SITES ONLY)
IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW>
				;NON-ZERO => INCLUDE DECBTS
IFNDEF CVTSW,CVTSW==0		;NON-ZERO => BITS DEFINITIONS COME FROM FILES
					; MADE USING CVT
IFN ITSSW\DECSW\TNXSW,TS==1
IFNDEF TS,TS==1			;NON-ZERO => TIME-SHARING VERSION
IFE TS,1PASS
IFNDEF A1PSW,	A1PSW==TS	;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY
IFNDEF BRCFLG,	BRCFLG==0	;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO
				; ARGS, ETC. JUST LIKE BRACKETS.  BRACES ARE SPECIAL
				; IN CONDITIONALS REGARDLESS OF BRCFLG.
IFNDEF CREFSW,	CREFSW==ITSSW	;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT.
IFNDEF LISTSW,	LISTSW==1	;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING.
IFNDEF RCHASW,	RCHASW==TS	;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE
IFNDEF PURESW,	PURESW==TS-SAILSW	;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND
				; DO PAGE SKIPS.  TWO SEGMENTS HURTS EFFICIENCY AT SAIL.
IFNDEF FASLP,	FASLP==1-SMALSW	;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY
				; NOTE!!  IF RUNNING UNDER 10/50 THIS MAKES THINGS
				; SEVERAL K BIGGER THAN OTHERWISE.
IFNDEF .I.FSW,	.I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F
IFNDEF MACSW,	MACSW==1	;NON-ZERO => INCLUDE MACRO PROCESSOR (!)
IFNDEF RUNTSW,	RUNTSW==1	;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY
IFNDEF WRQTSW,	WRQTSW==1	;WRQOTE (MACRO DEFINITION READER) VERSION
	; ^ 0 => SLOW,	 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED
IFE TS,IFNDEF MACL,MACL==6*2000	;MACRO TABLE SIZE
IFN TS,[
IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS.  IF WE HAVE DECBTS OR
IFN TNXSW,IFNDEF MACL,MACL==12*2000	; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE!
IFN DECSW,IFNDEF MACL,MACL==0	;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE.
IFNDEF MXMACL,MXMACL==32.*2000	;MAXIMUM LENGTH MACTAB
]
IFNDEF MACRUM,MACRUM==4		;# WORDS NOT USED AT END OF MACTAB
IFNDEF STRL,STRL==20		;LENGTH OF STRING STORAGE (USED BY GSYL)
IFNDEF DMDEFL,DMDEFL==40	;MAX NO OF DMY ARGS IN DEFINE
IFNDEF DMYAGL,DMYAGL==400	;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED
IFNDEF MPDLL,MPDLL==300		;MACRO PDL LENGTH
IFNDEF DSSIZ,DSSIZ==40		;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL)
IFNDEF BKTABL,BKTABL==40	;MAX NUM .BEGIN BLOCKS.
IFNDEF BKPDLS,BKPDLS==10	;MAXIMUM .BEGIN BLOCK NESTING DEPTH.
IFNDEF BSIZE,BSIZE==37		;PREFERRED SIZE BLOCK  MAX SIZE-3
IFN SMALSW,IFNDEF LPDL,LPDL==200.
IFNDEF LPDL,LPDL==1500.		;LENGTH OF PDL
IFN SMALSW,IFNDEF CONMIN,CONMIN==1000
IFNDEF CONMIN,CONMIN==3300	;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES.
IFNDEF CONMAX,CONMAX==20000	;MAXIMUM SPACE USER CAN ASK FOR.
IFNDEF NCONS,NCONS==100.	;MAXIMUM NUMBER OF CONSTANTS AREAS
IFNDEF NVARS,NVARS==25.		;MAX. NUM. VARIABLES AREAS.
;; MUST INCLUDE TONS OF SYSTEM DEFS
 IFN DECBSW,IFNDEF SYMDSZ,SYMDSZ==4973. ;666.th prime
 IFN TNXSW,IFNDEF SYMDSZ,SYMDSZ==7919. 	;1000.th prime
IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003.
IFNDEF SYMDSZ,SYMDSZ==2707.	;DEFAULT # SYMS IN SYMTAB.
IFNDEF SYMMSZ,SYMMSZ==11657.*2	;# SYMS IF JNAME IS MMIDAS.
IFNDEF SYMMAX,SYMMAX==60000	;MAX SYMTAB SIZE (# SYMS)
IFNDEF FASBL,FASBL==400		;WORDS  USED FOR FASL OUTPUT BUFFER
				; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES
IFNDEF FASATL,FASATL==2000	;WORDS USED FOR FASL ATOM TABLE
				; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S
				; SYMTAB AT LOAD TIME
IFNDEF MINWPS,MINWPS==3		;MIN # WORDS IN SYMTAB ENTRY
IFNDEF MAXWPS,MAXWPS==3		;MAX # ALLOWED (WILL BE BIGGER SOME DAY)
IFNDEF NRMWPS,NRMWPS==3		;DEFAULT #.   2 WDS FOR VALUE & FLAGS, 1 FOR NAME.
; VERSION, FLAGS, ETC.

IF1 [

IFNDEF MIDVRS,[
IFGE .FVERS,[
DEFINE XXX VRS
	MIDVRS=SIXBIT/VRS/
TERMIN
RADIX 10.
XXX \.FVERS
RADIX 8
EXPUNGE XXX
]
.ELSE [
PRINTX /What is MIDAS version number? /
.TTYMAC VRS
	MIDVRS=SIXBIT/VRS/
TERMIN
]
]

;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS
;IS BEING ASSEMBLED TO RUN UNDER.  IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS
;ARE ASSEMBLED WITH THIS MIDAS.  NOTE THAT TNX VERSION ACTUALLY SETS IT
;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE.
IFNDEF OSMIDAS,OSMIDAS==IFE TS,[SIXBIT/BARE/] .ELSE IFN ITSSW,[SIXBIT/ITS/] .ELSE IFN CMUSW,[SIXBIT/CMU/] .ELSE IFN SAILSW,[SIXBIT/SAIL/] .ELSE IFN TNXSW,[SIXBIT/TENEX/] .ELSE SIXBIT/DEC/

;FF FLAGS NOT PUSHED
;LEFT HALF
FL==1,,525252
FLPPSS==400000	;ONE IF PUNCHING PASS; MUST BE SIGN
FLHKIL==100000	;ONE IF SYM TO BE SEMI KILLED IN DDT

FLVOT==  40000	;ALL RCH S MUST GO THRU RCH
	; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR)
FLMAC==  20000	;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN
FLTTY==  10000	;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN
$FLOUT==  4000	;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC)
FLPTPF==  2000	;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP
FLUNRD==  1000	;=> RE-INPUT LAST CHARACTER (SEE RCH)
FL20X==400	; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX.

;FF RIGHT HALF FLAGS

FR==525252
FRFIRWD==400000	;ONE FOR FIRST WORD OF BLOCK
FRSYMS==200000	;ONE IF SYM PUNCH DESIRED
FRLOC==100000	;ONE BETWEEN ABS LOC ASSIGN AND
	;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.)

FRNPSS==40000	;ONE IF TWO PASS ASSEMBLY
FRPSS2==20000	;ONE ON PASS 2

FRINVT==4000	;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL)
FRNLIK==2000	;TEMPORARILY SUPPRESS ADR LINKING
FRGLOL==1000	;ONE IF LOCATION PLUS OFFSET IS GLOBAL

FRBIT7==400	;SET IF LAST TIPLE OF CODEBITS WAS 7.
FRMRGO==200	;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV)

FRCMND==40	;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA.
FRNNUL==20	;SET ON RETURN FROM RFD IFF NONNULL SPEC.
FRARRO==10	;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2.
FRFN1==4	; TELLS RFD THAT 1ST NAME WAS READ.


	; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT.
FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1>

] ;END IF1
;INDICATOR REGISTER

IF1 [

;LEFT HALF
IL==1,,525252
ILGLI==1	;SET ON " CLEARED EACH SYL
ILVAR==2	;SET ON '    "     "   "
ILFLO==4	;FLOATING NUM, SET ON DIGIT AFTER .
ILDECP==10	;DECIMAL PREFER, SET WHEN . SEEN.
ILUARI==20	;1 => RIGHT OPERAND TO UPARROW BEING READ
ILLSRT==40	;RETURN FROM <
ILWORD==400	;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD
ILNPRC==1000	;ONE IF NUMBER ALREADY PROCESSED BY UPARROW
ILMWRD==4000	;SET ON MULTIPLE WORD
ILPRN==10000	;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (.
ILMWR1==20000	;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST
		;WORD OF MULTI-WORD CONSTANT
ILNOPT==40000	;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY
		;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF
		;CONSTANTS OPTIMIZATION

;RIGHT HALF

IR==525252
IRFLD==1	;SET IF FLD NOT NULL
IRSYL==2	;SET IF SYL NOT NULL
IRLET==4	;SET IF SYL IS SYMBOL
IRDEF==10	;SET IF CURRENT EXPR DEFINED
IRNOEQ==20	;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT.
IRCOM==40	;SET IF CURRENT QUAN IS COMMON
IRPERI==100	;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER
IREQL==200	;ONE DURING READING WORD TO RIGHT OF =
IRIOINS==400	;FIRST FIELD OF CURRENT WORD HAS IO INST
IRCONT==1000	;SET IF NOT OK TO END BLOCK
IRPSUD==4000	;SET IF ERROR COMMENTS WILL COME FROM PSEUDO
IRGMNS==20000	;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS
IROP==200000	;SET IF OPERATOR SEEN IN CURRENT FIELD

CALL==PUSHJ P,
RET==POPJ P,
;SAVE=PUSH P,	;DON'T USE SAVE!  IT'S A JSYS ON TENEX AND TWENEX
REST==POP P,
PJRST==JRST	; FOR JRST'ING TO A POPJ'ING ROUTINE.

ETSM=1000,,	;ERROR, TYPE SYM.
ETR=2000,,	;ERROR, ORDINARY MESSAGE.
ERJ=3000,,	;ERROR, NO MESSAGE, RETURN TO ADDR.
ETI=4000,,	;ERROR, IGNORE LINE, RET. TO ASSEM1.
ETA=5000,,	;ERROR, RET. TO ASSEM1.
ETASM=6000,,	;ERROR, TYPE SYM AND RETURN TO ASSEM1
ETF=7000,,	;FATAL ERROR.
TYPR=(37000)	;UUO, TYPE OUT ASCIZ STRING
TYPCR=(36000)	; LIKE TYPR BUT ADDS CR AT END.
] ;END IF1
IF1 [
;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT
;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE
;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE)

;ACTUAL ENTRIES IN GLOTB:
;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED
;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE)
;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1
	;GLOBAL SHOULD BE MULTIPLIED BY IT
;REST OF LH FLAGS:

;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD
ACF==40000	;AC LOW OR HIGH (SWAPF => HIGH)
HFWDF==100000	;MASK GLOBAL TO HALFWORD
SWAPF==200000	;SWAP
MINF==20000	;NEGATIVE OF GLOBAL

IFNDEF LBRKT,LBRKT=="[	;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC.
IFNDEF RBRKT,RBRKT=="]	;RIGHT "
IFNDEF WPS,	WPS==3	;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING.
IFNDEF BKWPB,BKWPB==3	;# WDS/BKTAB ENTRY.
IFNDEF EOFCH,EOFCH==3	;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES.
IFNDEF LBRACE,LBRACE==173
IFNDEF RBRACE,RBRACE==175

;3RDWRD LH. SYM TAB BITS

3REL==600000	;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS
3RLL==400000	;R(LH)
3RLR==200000	;R(RH)
3RLNK==100000	;R(LINK)
3KILL==40000	;FULLY-KILLED SYM (DON'T GIVE TO DDT).
3VP==20000	;VALUE PUNCHED
3SKILL==10000	;SEMI KILL IN DDT
3LLV==4000	;LINKING LOADER MUST INSERT VAL
3VAS2==2000	;VAR SEEN ON PASS TWO WITH '
3VCNT==1000	;USED IN CONSTANT
3MAS==400	;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME
		;(SO ES MUST KEEP SEARCHING).
3NCRF==200	;DON'T CREF THIS SYMBOL.
3MACOK==100	;OK TO (RE)DEFINE THIS SYM AS MACRO.
		;(IE IS A MACRO OR SEEN ONLY IN .XCREF)
3LABEL==40	;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE
3MULTI==20	;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS.
3DOWN==10	;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE.

3DFCLR==737110	;BITS IN LH TO CLEAR ON REDEFINITION.

; FLAGS IN "CONTROL" VARIABLE
.SEE CONTRL
		;LEFT HALF
TRIV==400000	; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE)
		; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS
		; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET)

		;RIGHT HALF
ARIM==    2	; 1 => OUTPUT FORMAT IS RIM
SBLKS==  10	; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS)
ARIM10== 20	; 1 => OUTPUT FORMAT IS PDP-10 RIM
DECREL== 40	; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS)
FASL==  100	; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT  ( "  "  ")
DECSAV==200	; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X

PTR==104	;DEVICE CODE FOR PAPER TAPE READER.

] ;END IF1
IF1 [

;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE

CMMN==0		;COMMON (NOT USED)
PSUDO==40000	;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO),
		; LH WILL BE IN LH OF B WHEN RTN CALLED.
SYMC==100000	;SYM, VALUE IS VALUE OF SYM.
LCUDF==140000	;LOCAL UNDEF
DEFLVR==200000	;DEF LOC VAR, VALUE IS VALUE.
UDEFLV==240000	;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB.
LGBLCB==300000	;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES
DEFGVR==300000	;DEF GLO VAR, VALUE IS VALUE
UDEFGV==340000	;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR.
GLOETY==400000	;GLO ENTRY
GLOEXT==440000	;GLO EXIT
NCDBTS==GLOEXT_<-18.+4>+1	;# CODE BIT TYPES

DEFINE CDBCHK TBLNAM
IFN .-<TBLNAM>-NCDBTS,.ERR TBLNAM LOSES
TERMIN

;LOADER BLOCK TYPES LINK
LLDCM==1	;LOADER COMMAND BLOCK
LABS==2		;ABSOLUTE
LREL==3		;RELOCATABLE
LPRGN==4	;PROG NAME
LLIB==5		;LIBRARY BLOCK
LCOMLOD==6	;LOAD INTO COMMON
LGPA==7		;GLOBAL PARAMETER ASSIGN
LDDSYM==10	;LOCAL SYMS
LTCP==11	;LOAD TIME COND ON PRESENCE
ELTCB==12	;END LOAD TIME COND
LPLSH==22	;POLISH FIXUP

;LOADER COMMANDS
;IN ADR OF LDCMD BLK
LCJMP==1	;JUMP
LCGLO==2	;GLOBAL LOC ASSIGN
LCCMST==3	;SET COMMON BENCHMARK
LCEGLO==4	;END OF GLOBAL BLOCK
LDCV==5		;LOAD TIME COND ON VALUE
LDOFS==6	;LOADER SET GLOBAL OFFSET
LD.OP==7	;LOADER .OP

;LOADER CODEBITS SECOND SPEC AFTER 7
CDEF==0		;DEF
CCOMN==1	;COMMON REL
CLGLO==2	;LOC-GLO REC
CLIBQ==3	;LIBREQ
CRDF==4		;GLO REDEF
CRPT==5		;REPEAT GLOBAL VALUE
CDEFPT==6	;DEFINE SYM AS $.

;DEC RELOCATABLE BLOCK TYPES.
DECWDS==1	;STORAGE WORDS.
DECSYM==2	;SYMBOL DEFS OR GLOBAL ADDITIVE RQS.
DECHSG==3	;LOAD INTO HIGH SEG (FOR .DECTWO)
DECENT==4	;ENTRY NAMES
DECEND==5	;END BLOCK, HAS PROGRAM BREAK.
DECNAM==6	;PROGRAM NAME.
DECSTA==7	;STARTING ADDRESS BLOCK.
DECINT==10	;INTERNAL REQUEST
DECRQF==16	;REQUEST LOADING A FILE
DECRQL==17	;REQUEST LOADING A LIBRARY
] ;END IF1
IF1 [

DEFINE TYPE &STR
TYPR [ASCIZ STR]
TERMIN

DEFINE TYPECR &STR
TYPCR [ASCIZ STR]
TERMIN

DEFINE PRINTA A,B,C,D,E,F
IF1,[PRINTC ~A!B!C!D!E!F
~]
TERMIN

IF1 [DEFINE BNKBLK OP
OP
TERMIN ]

	;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF
	;WHICH IS DUMPED OUT AT END OF ASSEMBLY
	;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS

DEFINE BLCODE NEWCFT
IF1 [BNKBLK [DEFINE BNKBLK OP
OP]NEWCFT
TERMIN ]
IF2 [IRPW X,,[
NEWCFT
]
IRPS Y,,X
Y=Y
.ISTOP TERMIN TERMIN ] TERMIN

		;3RDWRD MANIPULATING MACROS
		;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE

DEFINE 3GET A,B
	MOVE A,ST+2(B)
	TERMIN

		;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD

DEFINE 3GET1 A,B
	MOVE A,2(B)
	TERMIN

		;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE

DEFINE 3PUT A,B
	MOVEM A,ST+2(B)
	TERMIN

		;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD

DEFINE 3PUT1 A,B
	MOVEM A,2(B)
	TERMIN

] ;END IF1
;RANDOM MACRO DEFINITIONS

IF1 [

		;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE

DEFINE SKPST A
	CAIL A,ST
	CAML A,MACTAD
TERMIN

		;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP)

DEFINE INSIRP A,B
	IRPS %ADR,,[B]
		A,%ADR
	TERMIN
TERMIN

DEFINE NOVAL
	TDNE I,[ILWORD,,IRNOEQ\IRFLD]
	 ETSM ERRNVL
TERMIN

DEFINE NOABS
	SKIPGE CONTRL
	 ETASM ERRABS
TERMIN

] ;END IF1

ERRNVL==[ASCIZ /Returns no value/]
ERRABS==[ASCIZ /Allowed only for STINK relocatable format/]

IF1 [

DEFINE MOVEIM B,C
	MOVEI A,C
	MOVEM A,B
TERMIN

DEFINE MOVEMM B,C
	MOVE A,C
	MOVEM A,B
TERMIN
] ;END IF1
IF1 [
IFN 0,[
;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD
;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS
;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE.

DEFINE TYPE2 X=SYM
	MOVE A,X
	CALL SYMTYP
IFSN X,SYM,SKIPE A,X+1
.ELSE	   SKIPE A,SYMX
	 CALL SYMTYP
TERMIN

DEFINE COPY2 X,Y,Z=USING A
	MOVE Z,X
	MOVEM Z,Y
	MOVE Z,X+1
	MOVEM Z,Y+1
TERMIN

DEFINE STORE2 AC,Y,Z=USING A
	MOVEM AC,Y
	MOVE Z,AC!X
	MOVEM Z,Y+1
TERMIN
]

.ELSE [
;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT
;MULTI-WORD SYMBOL NAMES.

DEFINE TYPE2 X=SYM
	MOVE A,X
	CALL SYMTYP
TERMIN

DEFINE COPY2 X,Y,Z=USING A
	MOVE Z,X
	MOVEM Z,Y
TERMIN

DEFINE STORE2 AC,Y,Z=USING A
	MOVEM AC,Y
TERMIN
]

DEFINE USING X
X,TERMIN

] ;END IF1
SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT

;  THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM.  THIS
; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL,
; AND DEC).

IF1 [

DEFINE DEFSYM X/
 IRPS Z,,[X]
  EXPUNGE Z
  .ISTOP
 TERMIN
 X
TERMIN
]; IF1

IFN DECSW\TNXSW,[
IF1 [

IFN TNXSW, EQUALS TEM,.SYMTAB

; INSERT UUO DEFINITIONS FILES AS APPROPRIATE.
IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS
IFN SAILSW,	.INSRT SAIDFS
IFN CMUSW,	.INSRT CMUDFS
IFN TNXSW,	.INSRT TNXDFS

;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES.
IFE CVTSW,[
IFN DECSW,.DECDF DEFSYM
IFN TNXSW,.TNXDF DEFSYM

;INSERT THE BITS DEFINITION FILES AS APPROPRIATE.
;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE
;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY
;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN.

IFN TNXSW, .INSRT TWXBTS
IFN DECBSW,.INSRT DECBTS

];IFE CVTSW

IFN TNXSW,[	; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS
R1==:1		; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND...
R2==:2
R3==:3
R4==:4
R5==:5
]

EXPUNGE HALT
DEFINE HALT
	JRST 4,.
TERMIN

EXPUNGE .VALUE
EQUALS .VALUE HALT

DEFINE .LOSE A
	JRST 4,.-1
TERMIN

IFN TNXSW, EQUALS .SYMTAB,TEM

] ;IF1

IFN DECSW,[	; SELECT OUTPUT FORMAT FOR DEC VERSION
IFN PURESW,.DECTWO
IFE PURESW,.DECREL
	RL0==.
]
IFN TNXSW,[	; SELECT OUTPUT FORMAT FOR TNX VERSION
IFNDEF DECSVF,[	; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL,
  DECSVF==0	; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF.
  IFDEF .DECSAV,DECSVF==1
]
IFN DECSVF,.DECSAV
.ELSE [ IFN PURESW,.DECTWO
	.ELSE .DECREL
      ]
	RL0==0
]
] ;IFN DECSW\TNXSW

IFN ITSSW,[
IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS
		.ITSDF DEFSYM
		] ;IFNDEF .IOT
IFNDEF %PIPDL,.INSRT SYS:ITSBTS
	HALT==.VALUE
	EXPUNG .JBTPC,.JBCNI

DEFINE SYSCAL A,B
	.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
] ;IF1

IFDEF .SBLK,.SBLK	; SELECT OUTPUT FORMAT FOR ITS VERSION
	RL0==0
] ;IFN ITSSW
IFE PURESW,[	;FOLLOWING IF NOT ASSEMBLING PURE CODING

DEFINE PBLK
TERMIN

DEFINE VBLK
TERMIN
]

IFN PURESW,[	;FOLLOWING IF ASSEMBLING PURE CODING

;MEMORY ORGANIZATION PURE CODING

;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION
	;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF
	;IMPURE CODING, NO STORAGE WORDS ALLOWED
;THEN SYM TAB, STARTING AT ST.
;THEN MACRO TABLE (WITH INIT. CODE IN IT)
;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD.
;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS.
;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP")

IFN DECSW\TNXSW,MINPUR==200
IFN ITSSW,MINPUR==160	;BLOCK NUMBER BEGINNING OF PURE CODING

;PURE CODING UNTIL MAXPUR*2000-SOMETHING
;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY
;TO SEPARATE PURE CODING FROM IMPURE

CKPUR==0	;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE

	; PBLK - SWITCH TO CODING ABOVE THE GAP
DEFINE PBLK
IFN CKPUR,.ERR PBLK
IFE CKPUR,[VAR.LC==.
LOC PUR.LC
]CKPUR==1
TERMIN

	; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP.
IFN ITSSW,	 PUR.LC==MINPUR*2000
IFN DECSW,	 PUR.LC==MINPUR*2000+RL0
IFN TNXSW,[
	IFN DECSVF,PUR.LC==MINPUR*2000
	.ELSE	   PUR.LC==MINPUR*2000+20  ;SKIP VESTIGIAL JOBDAT AREA.
]

	; VBLK - SWITCH TO CODING BELOW THE GAP
DEFINE VBLK
IFE CKPUR,.ERR VBLK
IFN CKPUR,[PUR.LC==.
LOC VAR.LC
]CKPUR==0
TERMIN

IFN TNXSW,IFE DECSVF,LOC 200

PBLK		;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK

]		;END PURESW CONDITIONAL

.YSTGW		;SET UP NOW, STORAGE WORDS OK
FOO==.
LOC 41
	JSR ERROR
IFN ITSSW,JSR TSINT
IFN DECSW,[
LOC .JBAPR
	TSINT1
]
LOC FOO

		;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS
		;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB)
		;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL

DSYL==400000	;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN)
DFLD==200000	;FIELD OPERATOR, GETFD
DWRD==100000	;WORD OP, GETWD
DSY1==1000	;SET ONLY IF DSYL SET,
		;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL.
DSYL1==DSYL+DSY1
DSY2==400	;SET FOR _ ONLY.

;ALL CLEAR => WORD TERMINATOR, NO DISPATCH

DTB:	DWRD,,SPACE	;40  SP, TAB, RUBOUT
	DSYL1,,RRL2	;EXCLAIM AND OPEN-BRACE
	DSYL1,,DQUOTE	;"
	DFLD,,XORF	;NUM SIGN
	DSYL,,RBRAK2	;CLOSE-BRACE.
	0		;(USED TO BE PERCENT SIGN)
	DFLD,,ANDF	;AMPERSAND
	DSYL1,,SQUOTE	;'
	DFLD,,LEFTP	;(  50
	DSYL,,RPARN	;)
	DFLD,,MULTP	; STAR  TIMES
	DFLD,,PLS	;+  PLUS
	DWRD,,COMMA	; ,
	DFLD,,MINUS	;-
	DSYL1,,CTLAT	;^@ (56)
	DFLD,,DIVID	;/
	DSYL1,,COLON	;COLON  60
	DSYL,,SEMIC	;SEMI 
	DFLD,,LSSTH	;<
	DSYL1,,EQUAL	;=
	DSYL,,GRTHN	;>
	0		;?
	DSYL1,,ATSGN	;AT SIGN
	DFLD,,LBRAK	;[
	DFLD,,IORF	;BACKSLASH 70
	DSYL,,RBRAK	;]
	DSYL1,,UPARR	;^
	DSYL+DSY2,,BAKAR ;BACKARR
	0		;CR
	0		;(USED TO BE TAB)
	0		;ALL OTHER
	DSYL,,LINEF	;LF (DSYL TO HACK CLNN)
	DSYL,,FORMF	;FORM FEED (")  100
;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS
;EXCEPT FOR EOFCH

GDTAB:	POPJ P,56	; ^@ GETS IGNORED.
	REPEAT 2,POPJ P,76	;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF
		;ON OLD FILES)
IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB.
IFE TS,[POPJ P,76] IFN TS,[JRST RREOF]
	REPEAT 5,POPJ P,76
	POPJ P,40	; TAB
	POPJ P,77	; LF
	POPJ P,76	; VERT TAB
	POPJ P,100	; FORM FEED
	POPJ P,74	; CR
	REPEAT "!-16-1,POPJ P,76
	POPJ P,40	; SPACE
	POPJ P,41	; !
	POPJ P,42	; "
	POPJ P,43	; #
	ADD SYM,%$SQ(D)	; $
	ADD SYM,%%SQ(D)	; %
	POPJ P,46	; &
	POPJ P,47	; '
	POPJ P,50	; (
	POPJ P,51	; )
	POPJ P,52	; *
	POPJ P,53	; +
	POPJ P,54	; ,
	POPJ P,55	; -
	JSP CH1,POINT	; .
	POPJ P,57	; /
	REPEAT 10.,JSP CH2,RR2	; DIGITS
	POPJ P,60	; :
	POPJ P,61	; ;
	POPJ P,62	; <
	POPJ P,63	; =
	POPJ P,64	; >
	POPJ P,65	; ?
	POPJ P,66	; @
IFDEF .CRFOFF,.CRFOFF
IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
	ADD SYM,%!Q!SQ(D)
TERMIN
	POPJ P,67	; [
	POPJ P,70	; \
	POPJ P,71	; ]
	POPJ P,72	; ^
	POPJ P,73	; _
	POPJ P,76	; NOW LOWER CASE GRAVE ACCENT

IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
	ADD SYM,%!Q!SQ(D)
TERMIN
IFDEF .CRFON,.CRFON
	POPJ P,41	;{
	POPJ P,76	;|
	POPJ P,44	;}
	POPJ P,76	;~
	POPJ P,40	; RUBOUT, LIKE SPACE
	IFN .-GDTAB-200,.ERR GDTAB LOSES
NSQTB:	IFDEF .CRFOFF,.CRFOFF
IRPC Q,,0123456789
	ADD SYM,%!Q!SQ(D)
TERMIN

IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%.
%!Q!SQ:	0
	SQUOZE 0,Q/50/50/50/50/50
	SQUOZE 0,Q/50/50/50/50
	SQUOZE 0,Q/50/50/50
	SQUOZE 0,Q/50/50
	SQUOZE 0,Q/50
	SQUOZE 0,Q
TERMIN
IFDEF .CRFON,.CRFON

;FORMAT TABLE(S)
;4.9-4.4 ETC SPECIFY SHIFT
;4.4-3.6 ETC SPECIFY NUMBER BITS
;FIELD SPECS IN REVERSE ORDER

IFORTB:	0		;NCNSN 10 ,
	0		;NCNSF 11 IMPOS
	0		;NCNCN 12 ,,
	2200,,		;NCNCF 13 ,,C
	2200000000	;NCFSN 14 ,B
	0		;NCFSF 15 ,B C
	0		;NCFCN 16 ,B,
	0		;NCFCF 17 ,B,C
	4400000000	;FSNSN 20 A
	0		;FSNSF 21 IMPOS
	0		;FSNCN 22 IMPOS
	0		;FSNCF 23 IMPOS
	2200440000	;FSFSN 24 A B
	2200220044	;FSFSF 25 A B C
	270400440000	;FSFCN 26 A B,
	2227040044	;FSFCF 27 A B,C
	4400000000	;FCNSN 30 A,
	0		;FCNSF 31 IMPOS
	22220000	;FCNCN 32 A,,
	2200002222	;FCNCF 33 A,,B
	2200440000	;FCFSN 34 A,B
	0		;FCFSF 35 A,B C
	0		;FCFCN 36 A,B,
	0		;FCFCF 37 A,B,C
FRTBL==.-IFORTB	;LENGTH OF FORMAT TABLE
VBLK
FORTAB:	BLOCK FRTBL	;ACTUAL FORMAT TABLE
FRTBE=.-1
PBLK
;VARIABLE STORAGE

VBLK

RETURN:	JRST .	;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2)
CDISP:	0	;CURRENT DISPATCH CODE
PPRIME:	0	;PUSH DOWN LIST MARKER  (GETFLD)
SCNDEP:	0	;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL.
CONDLN:	0	;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED
CONDPN:	0	;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED
CONDFI:	0	;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL.
A.SUCC:	0	;NONZERO IFF LAST CONDITIONAL SUCCEEDED.
ASMOUT:	0	;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN [].
ASMDSP:	ASSEM3	;PLACE TO JUMP TO FROM ASSEM1 LOOP.
		;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR []
		;AND .MLLIT ISN'T POS.  LSSTHA AFTER > OR ) SEEN.
		;[ ;CONND AFTER ] SEEN.
ASMDS1:	0	;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS.
ASSEMP:	0	;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL.
ASMI:	0	;REINIT I AT ASSEM2 FROM ASMI.
GLSPAS:	0	;RESTORE GLSP1  AT ASSEM1. SAVED OVER LITERAL.
GLSP1:	0	;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR
GLSP2:	0	;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR
FORMAT:	0	;ACCUMULATES FORMAT WORD
FORPNR:	0	;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB
FLDCNT:	0	;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD
WRD:	0	;ACCUMULATES VALUE OF WORD
WRDRLC:	0	;RELOC OF WRD, MUST COME RIGHT AFTER WRD.
T1:	0	;TEMP
T2:	0	;TEMP
PBITS1:	0	;CURRENT CODE BITS
PBITS2:	0	;NO OF SPECS LEFT IN CURRENT WORD
PBITS4:	0	;POINTER TO WHERE CURRENT CODE BITS WILL GO
OPT1:	0	;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER)
CONTRL:	0	;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS
CDATBC:	0	;CURRENT DATA BLOCK CODE TYPE
SCKSUM:	0	;CKSUM FOR SIMPLE BLOCK FORMAT
IFN A1PSW,[
PRGC:	-1	;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED
OUTN1:	-1	;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED)
OUTC:	-1	;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY
]
LINKL:	0	;SAVE LIMIT OF GLOTB  GETWRD
STRCNT:	0	;COUNT OF CHARS READ (INCL. DELIM) BY GSYL
STRPNT:	0	;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE
ISYMF:	-1	;-1 IF ISYMS HAVE NOT BEEN SPREAD
SMSRTF:	-1	;-1 BEFORE SYMTAB IS COMPACTED AND SORTED.
		;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING.
BITP:	0	;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK
LDCCC:	0	;DEPTH IN LOADTIME CONDS
PARBIT:	0	;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X)
LABELF:	0	;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET.
STGSW:	0	;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS
HKALL:	0	;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE)
LITSW:	0	;-1 => USING A LITERAL GIVES AN ERROR
QMTCH:	0	;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10)
STARTA:	0	;STARTING ADDRESS FOR SBLK, RIM, DECSAV
DECSYA:	0	; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT)
DECBRK:	0	;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT)
DECBRA:	0	;LARGEST ABS. ADDR LOADED INTO.
DECBRH:	0	;LIKE DECBRK BUT FOR ADDRS IN HI SEG.
DECTWO:	MOVE	;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS
		;ADDR START OF HISEG.
ISAV:	0	;I FROM FIELD AT AGETFLD
A.PASS:	0	; .PASS INTSYM, # OF THIS PASS.
A.PPAS:	0	;.PPASS INTSYM, # OF PASSES.
WPSTE:	NRMWPS	;# WORDS PER SYMTAB ENTRY
WPSTE1:	NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED.
WPSTEB:	,-NRMWPS(B)	;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B.
SYMSIZ:	0	;#WDS IN SYMTAB = WPS*<SYMLEN>
SYMLEN:	SYMMSZ	;SYMTAB SIZE (# SYMS)
	;ASSEMBLED-IN VALUE USED AS DEFAULT,  ONLY IF NON-TS.
SYMAOB:	0	;-<# SYMS>,,0
INICLB:	0	;-1 IF INITIALIZATION CODE CLOBBERED.
TTYINS:	0	;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO.
IFN FASLP,[
FASBP:	0	;PNTR TO FASL OUTPUT BUFFER
FASATP:	0	;PNTR TO FASL ATOM TABLE
FASAT1:	0	;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM
		; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9
FASAT2:	0	;BYTE PNTR USED TO STORE ATOM IN
FASIDX:	0	;INDEX NEXT ATOM LOADED INTO FASAT WILL BE
FASPCH:	0	;AMOUNT OF FASAT "PUNCHED"
FASCBP:	440400,,FASB	;BYTE PNTR TO FASL CODE BIT WORD
FASPWB:	0	;FASL CODE AT PWRD
FASBLC:	0	;LOSING BLOCK "COUNT"
FASBLS:	0	;LOSING BLOCK "SYMBOL"
AFRLD:	0	;LIST READ CURRENT DEPTH
AFRLEN:	0	;LIST READ CURRENT LENGTH
AFRDTF:	0	;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT"
AFRFTP:	0	;LIST READ SAVED STATE OF FASATP
AFLTYP:	0	;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE
			;1 "RETURN" LIST
			;2 "RETURN" VALUE OF LIST
]
PBLK
;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS

;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES
;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS.

;EXITS FROM THE ASSEMBLER:
;TPPB OUTPUT BINARY WORD IN A
;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE
	;SPECIFIED BY B, MAY CLOBBER A AND B
;GO9 RETURN POINT FROM FATAL ERRORS
;TYO TYPE OUT CHARACTER IN A
;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE)
;RCHTBL SEE THE RCH ROUTINES

;ENTRIES

;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES
;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P)
;INIT INITIALIZE
;PS1 PASS 1
;PLOD IF APPROPRIATE, PUNCH OUT LOADER
;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION)
;PSYMS PUNCH OUT SYMBOL TABLE

;OTHER ENTRIES

;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE
;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE
;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE
;MIDVRS .FNAM2 OF MIDAS ENGLISH

;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN

;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME
;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO
;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO
;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY)

;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE
;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN,
;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB
;ALSO RCHTBL ONLY EXIT

;LISTING FEATURE GLOBALS:
;PILPT PRINT CHAR IN A
;LISTON LISTING ON/OFF FLAG, -1 => ON
;LISTP SAME WORD AS LISTON.
;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS.
;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT

;CREF FEATURE GLOBALS:
;CRFOUT OUTPUT WORD IN A.
;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT.
;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK
;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR.
;;RCH		;CHARACTER INPUT ROUTINES

IFN RCHASW\MACSW,[
		;SAVE LIMBO1 STATUS AND RH(B)
		;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A)
		;CALLED BY PUSHEM AND PUSHTT

PSHLMB:	HRL B,LIMBO1	;LAST CHARACTER INPUT
	TLZE FF,FLUNRD	;RE-INPUT CHARACTER ON RETURN?
	XCT LSTPLM	;SET B'S SIGN; IF LISTING, JRST PSHLML.
PSHLMN:	EXCH A,RCHMOD	;GET OLD MODE IN A
	DPB A,[360500,,B]	;STORE IN 5 OF HIGH 6 BITS IN B
	PUSH F,B	;SAVE RESULTANT CRUD
	CAMN A,RCHMOD	;COMPARE NEW WITH OLD
	POPJ P,		;SAME => SKIP OVERHEAD OF SETTING NEW MODE
	MOVE A,RCHMOD	;NOW GET NEW MODE
	JRST PSHLM1	;SET UP INSTRUCTIONS FOR NEW MODE

IFN LISTSW,[
;IF LISTING, LSTPLM HOLDS JRST PSHLML
PSHLML:	AOSN PNTSW
	JRST PSHLMM	;LAST WAS BREAK CHR
	REPEAT 4,IBP PNTBP
	SOSA PNTBP
PSHLMM:	SETOM LISTBC
	TLO B,400000
	JRST PSHLMN
]

		;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD)

POPLMB:	POP F,A		;GET WORD THAT PSHLMB PUSHED
	HLRZS A		;JUST INTERESTED IN LEFT HALF
	TRZE A,400000	;SIGN BIT SET?
	TLOA FF,FLUNRD	;YES, SET FLAG TO RE-INPUT LAST CHAR
	TLZA FF,FLUNRD	;NO, CLEAR FLAG.
	XCT POPLML	;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING.
	SETZM LIMBO1	;INITIALIZE FOR DPB
	DPB A,[700,,LIMBO1]	;RESTORE LIMBO1
	LSH A,-<18.-6>	;RIGHT JUSTIFY RCHMOD DESCRIPTOR
	CAMN A,RCHMOD	;COMPARE NEW MODE WITH OLD
	POPJ P,		;SAME => SKIP OVERHEAD OF SETTING NEW MODE
	JRST RCHSET	;SET UP FOR NEW MODE AND RETURN
]
FOO==0		;INITIALIZE COUNTER FOR FOLLOWING

DEFINE RCHBLT SIZE,ADR/
	MOVSI T,FOO(A)
	HRRI T,ADR
	BLT T,<SIZE>-1+ADR
FOO==FOO+<SIZE>
TERMIN

DEFINE RCHMOV ADR/
	MOVE T,FOO(A)
	MOVEM T,ADR
FOO==FOO+1
TERMIN

		;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY

RCHSET:	MOVEM A,RCHMOD	;STORE NEW RCHMOD
PSHLM1:	TLZ FF,FLMAC\FLTTY	;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE)
	XCT RCHTBL(A)	;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG)
	PUSH P,T	;SAVE T, NEED IT FOR TEMP
	RCHBLT 3,RCH2	;FIRST 3 WORDS RCH2
	TLNE FF,FLVOT
	JRST POPTJ	;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE
MDSST1:	RCHBLT 3,RR1	;NEXT 3 RR1
	RCHMOV RRL1	;NEXT WORD RRL1
RCHPSN==FOO		;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH)
	RCHBLT 6,SEMIC	;LAST N SEMIC
POPTJ:	POP P,T
	POPJ P,

IFN LISTSW,[
		;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH)

MDSSET:	TLO FF,FLVOT	;SET FLAG
	MOVEI A,MDSSTB-3	;SET UP AC
	PUSH P,T	;SAVE T FOR RESTORATION
	JRST MDSST1	;NOW SET UP

MDSSTB:	JRST RRL1	;RR1
	HALT
	PUSHJ P,RCH	;RREOF

	PUSHJ P,RCH	;RRL1
IFN .-<MDSSTB-3>-RCHPSN,.ERR LOSSAGE AT MDSSTB.
	PUSHJ P,RCH	;SEMIC
	CAIE A,15
	JRST SEMIC
	JRST SEMICR

		;CLEAR OUT DISPLAY MODE

MDSCLR:	TLZ FF,FLVOT	;CLEAR FLAG
	MOVE A,RCHMOD
	JRST RCHSET	;NOW SET UP FOR REAL IN CURRENT MODE
] ;END IFN LISTSW,
IFN TS,[	;TABLE FOR  RCHSET, INDEXED BY MODE
		;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE

RCHTBL:	MOVEI A,RCHFIL		;0 => INPUT FROM FILE
IFN MACSW,PUSHJ P,RCHMAC	;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR)
IFN RCHASW,[IFE MACSW,HALT
	PUSHJ P,RCHTRC		;2 => TTY, QUIT ON CR
	PUSHJ P,RCHARC		;3 => TTY, DON'T QUIT ON CR
]
	;TABLE FOR INPUTTING FROM FILE
		;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED

RCHFIL:	ILDB A,UREDP	;GETCHR, GET CHARACTER
	CAIG A,14	;SKIP IF TOO BIG TO BE SPECIAL
	XCT RPATAB(A)	;SPECIAL, DO THE APPROPRIATE THING

	JRST RRL1	;RR1
	HALT
	PUSHJ P,[ MOVEI A,0	;^C IN SYMBOL TREATED LIKE A ^@,
		  JRST INCHR3]	;BUT ALSO SEE IF REALLY END OF BUFFER.  THIS GOES IN RREOF.

	ILDB A,UREDP	;RRL1
IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES.
	LDB CH1,[360600,,UREDP]	;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS
	IDIVI CH1,7
	JRST @SEMIC3(CH1)	;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE
	JFCL			;PLACE (IT IS A WORD-BY-WORD LOOP).

;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING
;NOTE:  MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING.
;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY.

RPATAB:
IFN ITSSW,	JFCL		;0, ON I.T.S. IS NORMAL CHARACTER
.ELSE	CALL RPANUL	;0, ON DEC SYSTEM, IGNORE IT.
	JFCL
	JFCL
IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB.
	PUSHJ P,INCHR3	;3, EOFCH
	REPEAT 6,JFCL
	CALL RPALF	;LINE FEED
	JFCL		;13
	PUSHJ P,RPAFF	;FORM FEED
	JRST SEMICR	;FROM SEMIC ONLY, EXIT FROM LOOP

RPAFF:	SKIPE ASMOUT	;FORM FEED
	 SKIPL TEXT4	;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO.
	  CAIA
	   ETR [ASCIZ/Formfeed within <>, () or []/]
	AOS CH1,CPGN
	SETOM CLNN
IFN ITSSW,[
	ADD CH1,[SIXBIT /P0/+1]
	MOVE CH2,A.PASS
	DPB CH2,[300200,,CH1]
	.SUSET [.SWHO3,,CH1]	;PUT THE NEW PAGE # IN THE WHO-LINE.
]
RPALF:	AOS CH2,CLNN
	CAME CH2,A.STPLN
	 RET
	MOVE CH1,CPGN
	CAMN CH1,A.STPPG
	 SETOM TTYBRF
	RET

IFN DECSW\TNXSW,[
RPANUL:	MOVE CH1,@UREDP	;SAW A NULL - IN A LINE NUMBER?
	TRNN CH1,1
	 JRST RCHTRA	;NO, JUST IGNORE IT.
	MOVEI CH1,010700
	HRLM CH1,UREDP	;YES, SKIP THIS WHOLE WORD, THEN
	CALL RCH	;SKIP THE 1ST CHAR AFTER THE LINE NUMBER
	JRST RCHTRA	;RETURN THE NEXT CHAR FROM THIS CALL TO RCH.
]
] ;END IFN TS,
VBLK
LIMBO1:	0		;LAST CHARACTER READ BY RCH
RCHMOD:	0		;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC.
CLNN:	0	;1 LESS THAN LINE # IN CURRENT INPUT FILE.
CPGN:	0	;1 LESS THAN PAGE # IN CURRENT INPUT FILE
A.STPL:	0	;1 LESS THAN LINE # TO STOP AT.
A.STPP:	0	;1 LESS THAN PAGE # TO STOP AT.
		;(STOPPING MEANS INSERTING THE TTY)

;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH)
;CLOBBERS A,CH1,CH2.

RCH:	TLZE FF,FLUNRD
	JRST RCH1	;RE-INPUT LAST ONE
RCH2:	HALT	;ILDB A,UREDP	;ILDB A,CPTR	;GET CHAR
	0	;CAIG A,14	;TRZE A,200	;CHECK FOR SPECIAL
	0	;XCT RPATAB(A)	;PUSHJ P,MACTRM	;SPECIAL, PROCESS
	MOVEM A,LIMBO1	;GOT CHAR, SAVE AS LAST CHAR GOTTEN
IFE TS,RCHLS1==JRST TYPCTL
IFN TS,RCHLS1==RET	;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING)
RCHLST:	RCHLS1		;AOSN PNTSW IF LISTING.
IFN LISTSW,[
	PUSHJ P,PNTR
	CAIG A,15
	JRST RCHL1
RCHL3:	IDPB A,PNTBP
TYPCTL:	POPJ P,	;OR JRST SOMEWHERE
PBLK

RCHL1:	CAIE A,15
	CAIN A,12
	JRST RCHL2
	CAIE A,14
	JRST RCHL3
RCHL2:	MOVEM A,LISTBC
	SETOM PNTSW
	JRST TYPCTL

VBLK
RCH1:	MOVE A,LIMBO1
RCH1LS:	RET		;OR CAILE A,15 IF LISTING.
	RET		;NEEDED IN CASE LISTING.
	CAIE A,15
	CAIN A,12
	JRST RCHL2
	CAIE A,14
	POPJ P,
	JRST RCHL2
PBLK
] ;END IFN LISTSW,

IFE LISTSW,[
PBLK
RCH1:	MOVE A,LIMBO1
	RET
] ;END IFE LISTSW,
;;GETSYL		;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM)

GSYL:	CLEARB SYM,STRCNT
GSYL1:	MOVEI D,6
	MOVE T,[440700,,STRSTO]
	MOVEM T,STRPNT
GSYL3:	AOSG A,STRCNT
	JRST (F)
	PUSHJ P,RCH
	IDPB A,STRPNT	;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1)
A.GSY2:	CAIN A,".
	JRST GSYL1C
	HLRZ CH1,GDTAB(A)
	CAIN CH1,(JSP CH2,)
	JRST GSYL1A	;NUMBER
	PUSHJ P,GSYL1B	;RETURN ONLY ON SYL SEP
	HRRZ A,GDTAB(A)
	MOVE T,LIMBO1
C%:	POPJ P,"%

GSYL1B:	XCT GDTAB(A)	;POPJ FOR SYL SEPS
	SUB P,[1,,1]
GSYL1D:	SOJGE D,GSYL3
	AOJA D,GSYL3

GSYL1C:	ADD SYM,%.SQ(D)
	JRST GSYL1D

GSYL1A:	XCT NSQTB-60(A)
	JRST GSYL1D

		;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND
		;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE)

GTSLD2:	TLNN C,DWRD\DFLD
	JRST GTSLD3	;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE
GETSLD:	PUSHJ P,GETSYL	;ENTRY, GET A SYL
	MOVE C,CDISP	;GET CDISP
	TRNN I,IRSYL
	JRST GTSLD2	;NO SYL
	AOS (P)		;GOT SYL, CAUSE RETURN TO SKIP
GTSLD3:	TLNN C,DWRD\DFLD
	TLO FF,FLUNRD	;CAUSE DELIMITER TO BE RE-INPUT
	POPJ P,

PASSPS:	SKIPA A,LIMBO1
GPASST:	 CALL RCH
	CAIE A,40
	 CAIN A,^I
	  JRST GPASST
	RET
GETSYL:	TLZ I,ILUARI+ILNPRC+ILLSRT
GTSL1:	CLEARB SYM,NUMTAB	;RECUR HERE FOR RIGHT ARG TO ^ AND _.
	MOVE AA,[NUMTAB,,NUMTAB+1]
	AOSN NTCLF
	BLT AA,NUMTAB+10	;NUMTAB NOT CLEAR, HAVE TO CLEAR IT
	MOVEI D,6	;CHARACTER COUNTER FOR BUILDING UP SYM
	SETOM ESBK	;NO SPECIFIC BLOCK DESIRED.
	TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL]
RRL2:	PUSHJ P,RR	;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR
SEMICR:		;RETURN HERE FROM SEMIC WITH CR IN A
	MOVEM A,LIMBO1	;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE
	HRRZ A,GDTAB(A)	;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB
	MOVE C,DTB-40(A)	;GET DTB ENTRY (FLAGS,,JUMP ADR)
	MOVEM C,CDISP	;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1)
RR8:	TLNE C,DSYL	;NOW SEE IF SYL OPERATOR FLAG SET
	JRST (C)	;SET => INTRA-SYLLABLE OPERATOR
RR10:	TRNE I,IRLET	;NOT SET => SYLLABLE TERMINATOR: SYL?
	POPJ P,		;SYL HAS LETTERS
	TRNN I,IRSYL
	JRST CABPOP	;NO SYL
	CAMN SYM,[SQUOZE 0,.]
	JRST PT1	;SYM IS .
		;NUMBER

RR5:	TLNN I,ILNPRC
	PUSHJ P,NUMSL
	TLNN I,ILFLO
	JRST RR9	;NOT FLOATING POINT
	MOVE A,B	;FLOATING, HIGH IN AA,LOW IN A,EXP IN B
	ADDI A,306	;201+105 TO ROUND
	ADDI AA,200	;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE
	JUMPGE AA,.+3	;NOW CHECK FOR OVERFLOW ON ROUNDING
	LSH AA,-1	;OVERFLOW, SHIFT BACK ONE
	AOS A		;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT
	EXCH A,AA	;GET EXPONENT IN AA, REST IN A
	ASHC AA,-10	;SHIFT TO MACHINE FLOATING POINT FORMAT
	SKIPE AA	;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER
	ETR [ASCIZ /Exponent overflow/]
RR9:	TLZ I,ILGLI+ILVAR	;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL
CLBPOP:	TDZA B,B	;CLEAR OUT B (RELOCATION BITS OF VALUE)
CABPOP:	SETZB A,B	;DO JRST CABPOP TO RETURN ZERO AS VALUE
	POPJ P,
RRU:	MOVE A,LIMBO1	;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1
	CAIG A,14	;IF TOO BIG,
	CAIGE A,12	;OR IF TOO SMALL,
	JRST RR1B	;THEN JUST FALL BACK IN
	TLNN FF,FLVOT\FLMAC\FLTTY	;SKIP IF NOT HACKING CPGN/CLNN
	XCT RRUTAB-12(A)	;HACKING, UNHACK FOR HACK COMING UP
	JRST RR1B	;FALL BACK IN

RRUTAB:	SOS CLNN	;LINE FEED (TABLE FOR RRU)
	JRST RR1B	;13
	SOS CPGN	;FORM FEED

		;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER
VBLK
RR:	TLZE FF,FLUNRD	;RE-INPUT LAST CHARACTER?
	JRST RRU	;YES
RR1:	JRST RRL1	;ILDB A,CPTR	;GET CHAR (" " ")
	HALT		;TRZE A,200	;CHECK FOR END OF STRING
RREOF:	PUSHJ P,RCH	;PUSHJ P,MACTRM	;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU
	.SEE RCHTRA	;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE.
RR1B:	XCT GDTAB(A)	;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE)
	TROA I,IRLET\IRSYL	;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS
	TRO I,IRSYL	;NUMBERS RETURN, SET FEWER FLAGS
	SOJGE D,RR1	;DECREMENT SYM COUNTER AND LOOP
	AOJA D,RR1	;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP

RRL1:	PUSHJ P,RCH	;ILDB A,UREDP	;GET CHAR
	XCT GDTAB(A)	;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF)
	TROA I,IRLET\IRSYL
	TRO I,IRSYL
	SOJGE D,RRL1
	AOJA D,RRL1

		;SEMICOLON (GET HERE FROM RR8)

	JRST SEMICL	;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET
;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC.
SEMIC:	PUSHJ P,RCH	;GET CHAR
	CAIE A,15	;SEE IF SPECIAL
	JRST SEMIC	;SPECIAL => DO SOMETHING (JRST SEMICR ON CR)
	JRST SEMICR	;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR

LOC SEMIC+6	;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES
PBLK

SEMICL:	MOVE A,LIMBO1	;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1
	CAIE A,15	;SKIP IF SHOULD TERMINATE SCAN
	JRST SEMIC	;NOT CR, FALL BACK IN
	JRST SEMICR	;DONE

SEMIC2:	
REPEAT 5,[
	ILDB A,UREDP
	CAIG A,15
	 XCT RPATAB(A)
]
	MOVE A,[ASCII /@@@@@/]
SEMIC1:	AOS CH1,UREDP
	MOVE CH1,(CH1)	;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT?
	MOVE CH2,CH1
	AND CH1,A
	AND CH2,[ASCII/     /]
	LSH CH2,1
	IOR CH1,CH2
	CAMN CH1,A
	 JRST SEMIC1	;NO, ADVANCE TO NEXT WORD AND TEST IT.
	MOVEI A,440700
	HRLM A,UREDP
	JRST SEMIC2	;YES, LOOK AT EACH CHAR AND PROCESS IT.

SEMIC3:	REPEAT 6,JRST SEMIC2+3*<5-.RPCNT>
;JSP CH2,RR2 => DIGIT (FROM GDTAB)
;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME

RR2:	XCT NSQTB-"0(A)	;UPDATE SQUOZE.
	TRNE I,IRLET
	JRST 1(CH2)	;SYL IS SYM, DON'T WASTE TIME.
	TRNE I,IRPERI
	TLO I,ILFLO	;DIGIT AFTER . => FLOATING.
MAKNUM:	SETOM NTCLF	;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME
	MOVEI AA,2	;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES
MAKNM1:	MOVE T,ARADIX(AA)	;GET THIS RADIX,
	CAMN T,ARADIX	;REDUNDANT => SKIP THIS PASS.
	 JUMPN AA,MAKNM4
	SKIPGE CH1,HIGHPT(AA)
	JRST MAKNM3
	MUL T,LOWPT(AA)	;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH.
	ADDI TT,-"0(A)	;ADD DIGIT TO LOW PART
	TLZE TT,400000
	AOJ T,		;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT
	JUMPE CH1,MAKNM5	;OLG HIGHPT WAS 0 => SAVE TIME.
	JFCL 17,.+1	;NOW CLEAR OV, ETC.
	IMUL CH1,ARADIX(AA)	;MULTIPLY HIGHPT BY RADIX
	ADD T,CH1	;ADD HIGH PARTS
	JFCL 10,MAKNM2	;JUMP ON OVERFLOW FROM IMUL OR ADD
MAKNM5:	TLNE I,ILFLO
	SOS NUMTAB(AA)	;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT
	MOVEM T,HIGHPT(AA)	;NOW STORE STUFF BACK
	MOVEM TT,LOWPT(AA)
MAKNM4:	SOJGE AA,MAKNM1	;NOW DO ALL THIS FOR NEXT RADIX
	JRST 1(CH2)

MAKNM2:	MOVSI B,400000	;OVERFLOW FROM UPDATING HIGH PARTS
	IORM B,HIGHPT(AA)	;SET SIGN BIT
MAKNM3:	TLNN I,ILFLO
	AOS NUMTAB(AA)	;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS
	JRST MAKNM4

VBLK
NUMTAB:	0	;EXPONENT
	0
	0
HIGHPT:	0	;HIGH PART OF CURRENT NUMBER THIS RADIX
	0	;4.9 => OVERFLOW, TRAILING DIGITS DROPPED
	0
LOWPT:	0	;LOW PART OF CURRENT NUMBER THIS RADIX
	0	;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF
	0	;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE
ARADIX:	10	;CURRENT RADIX
	12
	10

NTCLF:	-1	;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR)
PBLK
;JRST POINT => . (FROM GDTAB)

POINT:	TLO I,ILDECP	;PREFER DECIMAL
	TROE I,IRPERI	;SET PERIOD FLAG
	TRO I,IRLET	;2 POINTS => NAME
	ADD SYM,%.SQ(D)	;UPDATE SYM
	JRST 1(CH1)	;RETURN

RBRAK:	SOSL SCNDEP	;IF A CONDITIONAL TO TERMINATE,
	JRST RBRAK2	;HAVE DONE SO, IGNORE CHAR.
	SETZM SCNDEP
;CLOSES OF ALL KINDS COME HERE.
RPARN:
GRTHN:	MOVE A,LIMBO1
	SKIPE CH1,ASMOUT	;WHAT KIND OF OPEN ARE WE IN?
	CAIN CH1,4	;WITHIN A .ASCII OR
	 JRST RBRAK1	;NOT WITHIN GROUPING => THIS CLOSE IS STRAY.
	CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN?
	 ERJ RBRAK3
RBRAK4:	MOVE CH1,ASMOT2(CH1)
	MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT
RBRAK5:	SETZM CDISP
	JRST RR10	;AND GO TERMINATE WORD.

RBRAK3:	CALL TYOERR	;COME HERE ON CLOSE WRONG FOR OPEN.
		;(EG, ")" MATCHING "<").
	TYPR [ASCIZ/ Seen when /]
	MOVE A,ASMOT1(CH1)
	CALL TYOERR
	TYPR [ASCIZ/ expected
/]
	JRST RBRAK4

RBRAK1:	CAIN CH1,4	;CLOSE INSIDE A .ASCII =>
	 JRST RBRAK5	;TERMINATE WORD BUT DON'T CLOSE ANYTHING.
	SKIPN CONSML	;COME HERE FOR STRAY CLOSE.
	 JRST RRL2
	ERJ .+1
	TYPR [ASCIZ/Stray /]
	MOVE A,LIMBO1	;GET THE CLOSE WE SAW.
	CALL TYOERR
	CALL CRRERR
	JRST RRL2

;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS.
RBRAK2:	SETOM A.SUCC	;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT,
	JRST RRL2	;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE.

FORMF:	TLNN FF,FLVOT\FLMAC\FLTTY	;FORM FEED SYLLABLE OPERATOR ROUTINE
	 PUSHJ P,RPAFF	;UNLESS ALREADY DONE, INCREMENT PAGE #.
	JRST RR10

LINEF:	TLNN FF,FLVOT\FLMAC\FLTTY	;LINE FEED SYLLABLE OPERATOR ROUTINE
	 CALL RPALF
	JRST RR10

CTLAT:
IFN DECSW\TNXSW,[
	TLNN FF,FLVOT\FLMAC\FLTTY	;^@ SYLLABLE OPERATOR ROUTINE.
	 CALL RPANUL
]
	JRST RRL2
;DECIPHER A VALUE FROM NUMTABS
;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B
;AND RADIX USED IN D.

NUMSL:	TLNN I,ILVAR\ILDECP\ILFLO
	 SKIPE B,HIGHPT
	  JRST NUMSLS
	MOVE A,LOWPT	;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX.
	MOVE D,ARADIX	;SAVE RADIX AND HIGH PART FOR ^.
	SETZ AA,
	RET

NUMSLS:	CLEARB TT,D	;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC.
	TLNE I,ILDECP+ILVAR	;NEITHER . NOR ', CURRENT RADIX.
	TLNE I,ILGLI	;" => CURRENT RADIX DESPITE . OR '.
	 JRST NUMSL0
	MOVEI D,1	;DECIMAL UNLESS '
	TLNE I,ILVAR	;WHICH FORCES OCTAL.
	 MOVEI D,2
	MOVE A,ARADIX(D)
	CAMN A,ARADIX	;IF REALLY SAME AS CURRENT RADIX,
	 MOVEI D,0	;COMPUTATION WASN'T DONE FOR THIS VALUE OF D,
			;SO USE COMPUTATIONS DONE FOR CURRENT RADIX.
NUMSL0:	MOVE AA,HIGHPT(D)	;AA := HIGH PART
	MOVE B,LOWPT(D)		;B := LOW PART
	MOVE T,NUMTAB(D)	;T := EXPONENT
	MOVE D,ARADIX(D)	;NO LONGER NEED IDX, GET RADIX VALUE.
	TLNN I,ILFLO
	 JRST FIXNUM	;NOT FLOATING
	TLZ AA,400000	;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW
NUMC1:	JUMPN AA,.+2	;ENTRY FROM UPARR
	JUMPE B,FIX0	;COMPLETELY ZERO => RETURN FIXED ZERO
	JUMPL T,NUMSL1	;JUMP IF EXPONENT NEGATIVE
	JUMPE T,NUMSL2	;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO
		;EXPONENT POSITIVE, DO THE APPROPRIATE THING
NUMSL5:	MULI B,(D)	;MULITIPLY LOW PART BY RADIX
	MULI AA,(D)	;MULTIPLY HIGH PART BY RADIX
	ADD A,B		;A := LOW PART OF HIGH + HIGH PART OF LOW
	TLZE A,400000
	ADDI AA,1	;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH
	MOVE B,C	;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B
NUMSL3:	JUMPE AA,NUMSL4	;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE
	ASHC A,-1	;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1
	ASH A,1
	ASHC AA,-1
	AOJA TT,NUMSL3	;INCREMENT BIT EXPONENT AND TRY AGAIN

NUMSL4:	MOVE AA,A	;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA
	SOJG T,NUMSL5	;COUNT DOWN

NUMSL2:	TLNN I,ILFLO
	 JRST NUMSL9	;NOT FLOATING, DON'T WASTE TIME NORMALIZING.
	SKIPA A,B	;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A
NUMSL7:	ASHC AA,1	;NOW NORMALIZE
	TLNN AA,200000
	SOJA TT,NUMSL7
	SKIPA B,TT	;DONE NORMALIZING, RETURN BINARY EXPONENT IN B
PT1:	TRO I,IRLET
	POPJ P,

NUMSL9:	MOVE A,B
	MOVEI B,0
	ASHC AA,(TT)	;SHIFT 2-WD NUM. BY EXPONENT,
	LSH A,1		;PUT HIGH BIT IN WITH REST.
	JRST FIX1
FIX0:	TLZ I,ILFLO
FIXNUM:	LSHC A,45
FIX1:	LSHC AA,-1
	JUMPE AA,.+2
	ETR [ASCIZ /FIXNUM too big for 36 bits/]
	POPJ P,

NUMSL1:	SKIPA A,B	;EXPONENT NEGATIVE: NORMALIZE NOW
NUMSL8:	ASHC AA,1
NUMSL6:	TLNN AA,200000
	SOJA TT,NUMSL8	;NOT NORMALIZED YET
	AOS T
	MOVEI TM,(D)
	TLNN TM,-1	;GET CONVIENT POWER OF RADIX
	JUMPL T,[	IMULI TM,(D)
			AOJA T,.-1]
	MOVE B,A	;GET NORMALIZED LOW PART IN B
	IDIV AA,TM	;DIVIDE HIGH PART BY APPROPRIATE RADIX
	DIV A,TM
	JUMPL T,NUMSL6
	MOVE B,A
	JRST NUMSL2

UPARR:	TRON I,IRSYL
	 JRST UPCTRC	;"UNARY UPARROW" => GOBBLE CHARS
	TRNE I,IRLET
	 ETR [ASCIZ /Symbolic 1st arg to "^"/]
	PUSHJ P,NUMSL	;DECIPHER NUMTABS
	PUSHJ P,UA3	;GET RIGHT OPERAND IN T
	MOVE TT,B	;EXPONENT
	MOVE B,A	;LOW PART
	PUSHJ P,NUMC1	;T EXP HIGH IN AA LOW IN B TT BIN EXP
	MOVE C,CDISP	;IF A _ WAS DEFERRED WHILE ILUARI WAS SET,
	TLO I,ILNPRC
	CAME C,[DSYL,,BAKAR] ;DO IT NOW.
	 JRST RR10

BAKAR:	TLNE I,ILUARI
	JRST RR5	;RETURN TO UPARROW (WILL COME BACK HERE LATER)
	TRNE I,IRSYL
	TRNE I,IRLET
	JRST BAK1	;NO SYL, OR SYL IS NAME
	CAMN SYM,[SQUOZE 0,.]
	JRST BAK1	;. ALSO NAME
	TLZN I,ILNPRC
	PUSHJ P,NUMSL
	PUSHJ P,UA3
	ADD B,T
	ASHC AA,(B)
	LSH A,1
	LSHC AA,-1
	CLEARB B,AA
	TLZ I,ILFLO
	MOVE C,[DFLD,,CBAKAR]
	EXCH C,CDISP	;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP.
	CAME C,[DSYL,,BAKAR]
	 EXCH C,CDISP
	POPJ P,
UPCTRC:	SETZ T,
UPCTR1:	JSP F,QOTCOM	;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE
	LSH T,7		;SHIFT ACCUMULATED VALUE OVER 7
	CAIL A,140
	 SUBI A,40
	ANDI A,77	;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS
	ADD T,A		;ADD TO ACCUMULATED
	POPJ P,

BAK1:	MOVE TT,[DFLD,,CBAKAR]
	MOVEM TT,CDISP
	JRST RR10

UA3:	HRLM D,(P)	;SAVE RADIX (FOR UPARR)
	JSP LINK,SGTSY	;PUSH I,AA,A,B
	TLO I,ILUARI	;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR)
	PUSHJ P,RCH
	CAIN A,"-
	TROA I,IRGMNS
	TLO FF,FLUNRD
	PUSHJ P,RCH
	CAIN A,"<
	JRST UAR1
	TLO FF,FLUNRD
UA3L:	PUSHJ P,GTSL1	;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE
	TRNE I,IRLET
	JRST UA3S	;NAME
	TLNE I,ILFLO
	ETR [ASCIZ /Floating point 2nd arg to "_"/]
UAR2:	TRZN I,IRGMNS
	SKIPA T,A
	MOVN T,A
	JSP LINK,SGTSY1	;RESTORE GETSYL TEMPS.
	HLRZ D,(P)
	POPJ P,

UA3S:	PUSHJ P,GETVAL	;MAKE NUMBER_NAME WORK
	JRST UA3SR	;GOT VALUE, PROCESS
	JRST UA3L	;NO VALUE, TRY AGAIN

UAR1:	TLO I,ILLSRT
	TRZ I,IRSYL	;(OR ELSE LSSTH GIVES NOS ERROR.)
	SETZB A,B
	PUSHJ P,LSSTH
UA3SR:	JUMPN B,RLCERR	;RELOC ERR
	JRST UAR2

ATSGN:	MOVSI A,20	;ATSIGN
	IORM A,WRD
	TRO I,IRFLD	;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE
		; ^ CHANGED FROM SYL TO FIELD 9/6/70
	JRST RRL2	;FALL BACK IN
DQUOTE:	TRON I,IRSYL
	 JRST DQUOT8
	TRNN I,IRLET	;AFTER NUMBER => CURRENT RADIX.
	 JRST DQUOT7
	PUSHJ P,RCH
	TLO FF,FLUNRD	;NEXT CHAR. SQUOZE?
	HLRZ A,GDTAB(A)
	CAIN A,(POPJ P,)
	 JRST DQUOT7	;NO => MAKE PREV. SYM. GLOBAL.
	CAMN SYM,[SQUOZE 0,.M]	;SPECIAL BLOCK NAMES
	 JRST DQUOTM	;.M MEANS MAIN BLOCK,
	CAMN SYM,[SQUOZE 0,.U]
	 JRST DQUOTU	;.U MEANS SUPERIOR.
	CAMN SYM,[SQUOZE 0,.C]
	 JRST DQUOTC	;.C MEANS CURRENT BLOCK.
	SKIPGE A,ESBK	;GET SPEC'D BLOCK OR CURRENT,
	 HRR A,BKCUR	;LOOK FOR SUBBLOCK OF THAT BLOCK.
	HLL A,BKTAB+1(A)
	ADD A,[1,,]	;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE.
	MOVEI T,0
	SETO D,		;NO POSSIBLE ALTERNATE CHOICE YET.
DQUOT0:	CAME SYM,BKTAB(T)	;LOOK AT ALL BLOCKS SEEN.
	 JRST DQUOT1	;HAS THE NAME WE'RE LOOKING FOR?
	SKIPGE ESBK	;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK,
	 JRST DQUOT4
	CAMN A,BKTAB+1(T)
	 JRST DQUOT2	;SUCH A BLOCK WINS;  ALL OTHERS LOSE.
	JRST DQUOT1

DQUOT4:	SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES.
	 JUMPGE D,DQUOT1
	SKIPE BKTAB+2(T)
	 JUMPL D,DQUOT5
	CAME D,[-1]	;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR
	 CAMN A,BKTAB+1(T)	;OF THE CURRENT BLOCK TO ONE THAT'S NOT.
	  JRST DQUOT5
	JRST DQUOT1

DQUOT5:	HRROI D,(T)	;FOUND A BLOCK WE LIKE BEST SO FAR.
	SKIPE BKTAB+2(T)
	 ANDI D,-1	;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED.
DQUOT1:	ADDI T,BKWPB
	CAMGE T,BKTABP
	 JRST DQUOT0
	HRRZI T,(D)	;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE.
	CAIE T,-1
	 JRST DQUOT2
	MOVE T,BKTABP	;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY.
	CAIL T,BKTABS
	 ETF ERRTMB	;NO ROOM FOR MORE BLOCKS.
	MOVEM SYM,BKTAB(T)
	MOVEM A,BKTAB+1(T)	;ADD BLOCK AT END.
	MOVEI A,BKWPB(T)
	MOVEM A,BKTABP	;POINTS AFTER LAST USED ENTRY.
DQUOT2:	MOVEM T,ESBK
	SETZ SYM,
DQUOT3:	MOVEI D,6	;NEXT CHAR GOES IN 1ST SQUOZE POS.
	JRST RRL2

DQUOTM:	MOVEI T,BKWPB	;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK.
	JRST DQUOT2

DQUOTU:	SKIPGE T,ESBK	;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK,
	 MOVE T,BKCUR
	HRRZ T,BKTAB+1(T)
	JRST DQUOT2	;SPEC. ITS SUPERIOR.

DQUOTC:	SKIPGE T,ESBK	;.C => SPEC THE CURRENT BLOCK.
	 MOVE T,BKCUR
	JRST DQUOT2
SQUOT1:	TLOA I,ILVAR
DQUOT7:	 TLO I,ILGLI
	MOVE A,BKCUR	;IF NO SPEC'D BLOCK,
	SKIPGE ESBK
	 MOVEM A,ESBK	;SPEC. CURRENT BLOCK.
	JRST RRL2

DQUOT8:	SETZ T,
DQUOT9:	JSP F,QOTCON	;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE
	LSH T,7		;SHIFT ACCUMULATED VALUE OVER 7
	ADD T,A		;ADD IN ASCII CHARACTER IN A
	POPJ P,		;RETURN TO SOMETHING

SQUOTE:	TROE I,IRSYL
	 JRST SQUOT1
	SETZ T,
SQUOT9:	JSP F,QOTCON	;SIXBIT SYL
	CAIGE A,40
	 ETR ERRN6B	;NOT SIXBIT
	CAIL A,140
	 SUBI A,40	;CONVERT TO UPPER CASE
	LSH T,6		;SHIFT OVER ACCUMULATED VALUE
	ADDI T,-40(A)	;ADD IN SIXBIT FOR CHARACTER IN A
	POPJ P,

;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS
;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A
;SYL FLAG EXPECTED TO BE ALREADY SET
QOTCON:	SKIPE QMTCH	;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A
	 JRST QOTCO4	;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT
QOTCOM:	CALL RCH	;USE AT LEAST 1 CHAR IN ANY CASE.
	JRST QOTCO1

QOTCO2:	CALL RCH	;USE SUCCEEDING CHARS IF SQUOZE CHARS.
	HLRZ CH1,GDTAB(A)
	CAIN CH1,(POPJ P,)
	 JRST QOTCO3
QOTCO1:	CALL (F)
	JRST QOTCO2

QOTCO3:	CAIN A,""	;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR,
	 JRST DQUOT9	;CONTINUE WITH WHATEVER TYPE OF TEXT
	CAIN A,"'
	 JRST SQUOT9	;IT INDICATES.
	CAIN A,"^
	 JRST UPCTR1
QOTCO6:	TLO FF,FLUNRD
	JRST TEXT5

QOTCO4:	MOVE B,LIMBO1	;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER.
	MOVE SYM,[SQUOZE 0,TEXT]
	JSP TM,ERMARK
QOTCO5:	CALL RCH
	CAMN A,B	;FOUND ANOTHER EXAMPLE OF THE DELIMITER?
	 JRST [	CALL RCH	;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT.
		CAMN A,B
		 JRST .+1
		JRST QOTCO6]	;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT.
	CALL (F)	;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN.
	JRST QOTCO5

;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED)
;OR CR (NOT GOBBLED).
VALRET:	MOVE T,A	;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL
	MOVE B,CDISP	;GET STORED DISPATCH CODE
	TLNN B,DWRD\DFLD
	JRST VALR1	;WORD TERMINATOR
;COME HERE TO RETURN A VALUE, AND ALSO
;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR
TEXT5:	PUSH P,T	;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T
	PUSHJ P,GETSYL	;SEE IF IMMEDIATELY FOLLOWED BY SYL
	TRNE I,IRSYL
	ETR ERRNOS	;NO SEPARATOR BETWEEN TWO VALUES
	POP P,A		;RESTORE VALUE TO RETURN
VALR1:	TRO I,IRSYL
	JRST CLBPOP
;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK,

SGTSY:	PUSH P,I
	PUSH P,AA
	PUSH P,A
	PUSH P,B
	JRST (LINK)

SGTSY1:	POP P,B
	POP P,A
	POP P,AA
	POP P,I
	JRST (LINK)

;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC.

SAVWD1:	PUSH P,A	;SYLL. BEFORE GROUPING NOW STARTING.
	PUSH P,B	;AND ITS RELOC.

SAVWLD:	PUSH P,FORMAT
	PUSH P,FORPNR
	PUSH P,FLDCNT
	PUSH P,GLSP2
	PUSH P,I
	PUSH P,WRD
	PUSH P,WRDRLC
	PUSH P,SYM
	PUSH P,PPRIME
	PUSHJ P,(LINK)
SAVL1==.

;POP OFF WHAT PUSHED BY SAVWLD.  CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ.

USVWLD:	POP P,SYM
	HRRZS SYM
	CAIE SYM,SAVL1
	HALT
	TLZ FF,FLUNRD
	POP P,PPRIME
	POP P,SYM
	POP P,WRDRLC
	POP P,WRD
	TDZ I,[-1-(ILWORD)]
	IOR I,(P)
	POP P,1(P)
	POP P,GLSP2
	POP P,FLDCNT
	POP P,FORPNR
	POP P,FORMAT
	JRST (LINK)
;;GETFD		;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B

		;GET FIELD FOR PSEUDO
		;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO
		;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF
		;SYMBOL SEEN. SYM IS NOT CLOBBERED.

AGETFD:	PUSH P,I	;SAVE I
	TRO I,IRPSUD+IRNOEQ	;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS
	PUSH P,GTVER	;OLD VALUE OF GTVER
	MOVEM SYM,GTVER	;ERROR MSG SHOULD GIVE NAME OF PSEUDO.
	CALL YGETFD
	MOVE SYM,GTVER
	REST GTVER
	MOVEM I,ISAV	;SAVE FLAGS FOR FIELD GOTTEN
POPIJ:	POP P,I
	POPJ P,

;READ A FIELD, NOT PART OF THE CURRENT WORD.
YGETFD:	PUSH P,WRD
	SETZM WRD
	CALL XGETFD
	TLNE I,ILMWRD
	PUSHJ P,IGTXT	;SOAK UP MULTIPLE WORD
	ADD A,WRD	;ADD IN INDEX, INDIRECT FIELDS
	POP P,WRD
	POPJ P,

IFN FASLP,[
FAGTFD:	PUSHJ P,AGETFD	;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL
	MOVE TM,GLSP1
	CAMN TM,GLSP2
	 SKIPE B
	  ETSM [ASCIZ /relocatable or external argument/]
	POPJ P,
]
;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC).
XGETFD:	PUSH P,PPRIME
AGTFD3:	PUSHJ P,GETFLD
	MOVE CH1,CDISP
	TLNN CH1,DWRD
	 TLOA FF,FLUNRD	;DELIMITER IS WORD TERMINATOR => RE-READ IT.
	  TRNE I,IRFLD	;NON-NULL FIELD SUPPLIED => RETURN IT.
	    JRST AGTFD4
	HRRZ C,CDISP	;ELSE COMMA => RETURN NULL VALUE (0)
	CAIN C,SPACE	;SPACE => TRY AGAIN TO READ A FIELD.
	 JRST AGTFD3	;NO FIELD, TRY AGAIN
AGTFD4:	REST PPRIME
	POPJ P,

		;IN RELOCATABLE FORMAT
		;READ FIELD AND COPY OUT AS WORD

RGETFD:	SETZM WRD	;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD
	SETZM WRDRLC
	MOVE A,GLSPAS
	MOVEM A,GLSP1
	MOVEM A,GLSP2
	CALL XGETFD
	ADDM A,WRD
	ADDM B,WRDRLC
	PUSHJ P,PWRDA	;OUTPUT WORD
	TLNE I,ILMWRD
	JRST IGTXT	;SOAK UP MULTI-WORD FIELD
	POPJ P,
;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL.
GETFLD:	PUSH P,GLSP1	;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED.
	MOVEM P,PPRIME
	TRZ I,IRFLD+IROP
GETFD1:	TLNE I,ILMWRD
	JRST GETFD9	;MULTIPLE WORD, RE-CALL PSEUDO
	PUSHJ P,GETSYL
	TRNE I,IRLET
GETFD9:	PUSHJ P,GETVAL	;GET OPERAND (MAYBE SKIPS)
GETFD6:	SKIPA C,CDISP	;GET INFO ON SYLLABLE TERMINATOR
	JRST GETFD1	;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN
	TLNE C,DFLD
	JRST (C)	;FIELD OPERATOR, GO PROCESS
	TRNE I,IRSYL	;NO DISP MEANS FIELD TERMINATOR.
	TRO I,IRFLD
	CAME P,PPRIME	;IF ANY OPERATORS PUSHED,
	 JSP LINK,GETFD8 ;EVAL THEM.
	SUB P,[1,,1]	;FLUSH GLSP1 SAVED AT GETFLD.
	RET

GETFD8:	MOVEI TT,	;END OF FIELD HAS VERY LOW PRIORITY.
	JRST GETFD7

;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT.
;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS,
;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR

GETFDL:	MOVEI LINK,GETFD3	;AFTER MAYBE EVALLING, GO PUSH OPERATOR.
	TRO I,IRFLD+IROP
	TRNN I,IRSYL
	 JRST GETFD5	;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO.
GETFD2:	CAME P,PPRIME	;NO OPS TO LEFT => NOTHING TO EVAL.
	CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT.
	JRST (LINK)	;WAIT UNTIL LATER
GETFD7:	HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK.
	JRST (T)	;GO DO IT NOW (ROUTINE RETURNS TO GETFD4)
GETFD4:	SUB P,[4,,4]
	JRST GETFD2

GETFD5:	MOVSI TT,200	;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY.
GETFD3:	PUSH P,B	;GETFLR(P)
	PUSH P,A	;GETFLV(P)
	HLL C,TT
	PUSH P,C	;GETFLP(P)
	PUSH P,GLSP1	;GETFLG(P)
	JRST GETFD1

GETFLB==,-4	;PDL IDX OF GLSP1 BEFORE LEFT OPERAND.
GETFLR==,-3	;PDL IDX OF RELOC OF LEFT OPERAND.
GETFLV==,-2	;PDL IDX OF VALUE OF LEFT OPERAND.
GETFLP==,-1	;PDL IDX OF PRIO,,DISPATCH
GETFLG==0	;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT)
PLS:	MOVEI C,PLS1	;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION
MINUS2:	MOVSI TT,10	;SET UP PRECEDENCE OF 10 FOR +, -
	JRST GETFDL

MINUS:	JSP C,MINUS2	;MINUS SIGN
	MOVNS A		;NEGATE VALUE OF RIGHT OPERAND
	MOVNS B		;ALSO RELOCATION
	JUMPGE FF,PLS1
	MOVE T,GETFLG(P)
	PUSH P,B
	HRLZI B,MINF
	PUSH P,C
	PUSHJ P,LNKTZ	;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND
	POP P,C
	POP P,B
PLS1:	ADD A,GETFLV(P)	;ADD VALUES
	ADD B,GETFLR(P)	;ADD RELOCATIONS
	JRST GETFD4

LNKTZ:	TDZA C,C
LNKTC1:	MOVE T,GLSP2
LINKTC:	CAML T,GLSP1
	POPJ P,
	SKIPL 1(T)
	XORM B,1(T)
	SKIPL 1(T)
	IORM C,1(T)
	AOJA T,LINKTC
MULTP:	MOVEI C,MULTP1	;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION
DIVID2:	MOVSI TT,20	;20 PRECEDENCE OF MULTIPLICATION, DIVISION
	JRST GETFDL

MULTP1:	SKIPL CONTRL		;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS.
	 JUMPGE FF,MULTR
	MOVE D,GETFLB(P)	;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT?
	CAMN D,GLSP1
	 JRST MULTR
	SKIPGE FF
	 ETR [ASCIZ /Externals multiplied/]
	TLO I,ILNOPT		;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1.
MULTR:	JUMPE B,MULTP3		;JUMP ON RIGHT OPERAND NOT RELOCATED
	SKIPE GETFLR(P)
	 JRST MULTP4		;BOTH OPERANDS RELOCATED
	MOVE T,GETFLV(P)	;GET VALUE OF LEFT OPERAND AND FALL IN
	JRST MULTP5

MULTP3:	MOVE T,A		;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T
	MOVE B,GETFLR(P)	;RELOCATION BITS OF LEFT OPERAND
MULTP5:	MOVE D,GETFLG(P)	;GLOTB POINTER TO BETWEEN OPERANDS
	CAME D,GETFLB(P)
	 JRST GMUL1		;LEFT OPERAND HAS GLOBALS
	CAME D,GLSP1
	 JRST GMUL2		;RIGHT OPERAND HAS GLOBALS
		;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER
GMUL4:	IMUL A,GETFLV(P)	;MULTIPLY VALUES
	IMULB B,T		;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER
	TRZ T,1
	SKIPL CONTRL		;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION
	 JRST GETFD4		;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE
	JUMPE T,GETFD4		;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY).
MULTP4:	ETR [ASCIZ+Relocatable arg to * or / or Boolean+]
	JRST GETFD4

GMUL1:	TLNE FF,FLPPSS	;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND
	CAMN D,GLSP1
	SKIPA CH1,A	;LOOKS OK, GET VALUE IN CH1
	 ETR [ASCIZ /Multiplying two externals/]
	SKIPA D,GETFLB(P)	;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND
GMUL2:	MOVE CH1,GETFLV(P)	;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND
GMUL3:	CAML D,GLSP1
	JRST GMUL4	;TABLE COUNTED OUT
	SKIPGE 1(D)
	AOJA D,GMUL3
	JUMPE CH1,GMUL5	;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK
	LDB CH2,[221200,,1(D)]	;PICK UP MULTIPLICATION FIELD THIS GLOBAL
	SKIPN CH2
	MOVEI CH2,1	;0 => 1
	IMUL CH2,CH1
	CAIN CH2,1
	MOVEI CH2,0	;IF ONE THEN USE ZERO
	DPB CH2,[221200,,1(D)]
	AOJA D,GMUL3


GMUL5:	CLEARM 1(D)
	AOJA D,GMUL3
DIVID:	JSP C,DIVID2	;SLASH, PRECEDENCE = 20
DIVID1:	JUMPN B,MULTP4	;JUMP IF RIGHT OPERAND RELOCATED
	SKIPE GETFLR(P)
	JRST MULTP4	;LEFT OPERAND RELOCATED
	EXCH A,GETFLV(P)
	IDIV A,GETFLV(P)
	MOVEI B,0
	MOVE D,GETFLB(P)
	CAMN D,GLSP1	;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS,
	 JRST GETFD4
	SKIPGE FF	;ON PUNCHING PASS IT'S AN ERROR.
	 ETR [ASCIZ /Division involving externals/]
	TLO I,ILNOPT	;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL.
	JRST GETFD4

		;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30)

ANDF:	MOVSI TT,40	;&
	JSP C,GETFDL
	JSP D,LOGIC1	;GO DO IT
	AND A,GETFLV(P)	;INSTRUCTION ARGUMENT TO LOGIC1

XORF:	MOVSI TT,34	;#
	TRNN I,IRSYL	;IF ABOUT TO BE UNARY,
	MOVNI A,1	;THEN TURN LEFT OPERAND INTO -1
	JSP C,GETFDL
	JSP D,LOGIC1
	XOR A,GETFLV(P)

IORF:	MOVSI TT,30	;\
	JSP C,GETFDL
	JSP D,LOGIC1
	IOR A,GETFLV(P)

		;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS

LOGIC1:	JUMPN B,MULTP4	;NO RELOCATION ALLOWED
	SKIPE GETFLR(P)	;NOW CHECK RELOCATION OF LEFT OPERAND
	 JRST MULTP4
	XCT (D)		;ALL TESTS PASSED, DO IT
	MOVE D,GETFLB(P)	;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS?
	CAMN D,GLSP1
	 JRST GETFD4	;NO.
	SKIPGE FF	;YES.  ON THE PUNCHING PASS, THAT'S AN ERROR.
	 ETR [ASCIZ /External in arg to \, & or #/]
	TLO I,ILNOPT	;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL.
	JRST GETFD4

CBAKAR:	MOVSI TT,100	;BACKARROW AS FIELD OPERATOR, PREC = 100
	JSP C,GETFDL	;RETURN TO GETFLD TO READ 2ND ARGUMENT.
	JSP D,LOGIC1	;FOR EVALUATION, CALL LOGIC1
	    JSP D,.+1	;WHICH EXECUTES THIS INSTRUCTION,
	MOVE T,A	;TO CALL THIS SUBROUTINE.
	MOVE A,GETFLV(P)
	LSH A,(T)
	JRST (D)
;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [	;]
LSSTH9:	JSP LINK,SAVAS1	;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC.
	MOVEM D,ASMOUT	;SAY WHAT KIND OF OPEN WE JUST DID
	JRST ASSEM3	;REENTER ASSEM1 LOOP AT INNER LEVEL.

;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9.
LSSTHA:	SKIPE BYTM	;IN BYTE MODE, DO .WALGN. SINCE ASMDSP
	 JRST A.BY3	;STILL POINTS HERE, WE'LL COME BACK.
	MOVE P,CONSTP
	JSP T,CONNDP	;POP STUFF SAVED BY SAVAS1
	MOVE A,WRD	;RETURN THE WORD IN THE GROUPING
	MOVE B,WRDRLC	;(OUR CALLER WILL USVWLD, CLOBBERING WRD)
	POPJ P,

LSSTH:	MOVEI D,1	;1 FOR <.
	JSP LINK,SAVWD1
	PUSHJ P,LSSTH9
LSSTH3:	JSP LINK,USVWLD	;POP OFF ALL BUTPREVIOUS SYLL.

;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD)
;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR.
LSSTH2:	ADDM A,-1(P)	;SYLL BEFORE GROUPING, PUSHED BY SAVWD1.
	ADDM B,(P)
	TRNE I,IRSYL	;IF WAS SYLL BEFORE GROUPING, ERROR.
	 ETR ERRNOS
LSSTH5:	MOVE A,LIMBO1	;CHECK FOR FOLLOWING SYLL.
	CAIE A,15
	CAIN A,12
	JRST LSSTH6	;DELIMITER CR OR LF
	PUSHJ P,RCH	;NOT CR OR LF, GET NEXT CHAR
	CAIN A,"!	;IGNORE EXCLAMATION POINT
	JRST .-2
	TLO FF,FLUNRD	;CAUSE IT TO BE RE-INPUT
	HLRZ CH1,GDTAB(A)
	CAIE CH1,(POPJ P,)
	JRST LSSTH4	;SQUOZE CHAR. MEANS FOLLOWING SYLL.
	HRRZ CH1,GDTAB(A)
	MOVE CH1,DTB-40(CH1)	;GET DISPATCH FOR CHAR.
	TLNE CH1,DSY1	;MIGHT START SYL => NOS ERROR.
	 JRST LSSTH4
LSSTH7:	PUSHJ P,GTSL1
LSSTH6:	TRO I,IRSYL
	POP P,B
	POP P,A		;VALUE OF GROUPING WAS ADDM'ED INTO THESE.
	TLZE I,ILLSRT	?.SEE UA3
	 RET		;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT.
	JRST GETFD6
LSSTH1:	TLO I,ILWORD	;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD.
	ADDM A,WRD
	ADDM B,WRDRLC
	TRNE I,IRSYL	;IF SYLL BEFORE,
	JRST LSSTH5	;ERROR IF SYL AFTER.
	JRST LSSTH8	;ELSE NO ERROR.

LSSTH4:	ETR ERRNOS	;FOLLOWING SYLL WHEN THAT IS ERROR.
LSSTH8:	TLNE I,ILLSRT	?.SEE UA3
	 JRST LSSTH6
	SUB P,[2,,2]
	JRST GETFD1

ERRNOS:	ASCIZ /Syllables not separated/

POP2J:	SUB P,[2,,2]
	POPJ P,

LEFTP:	MOVEI D,2	;2 FOR ).
	JSP LINK,SAVWD1
	MOVEI C,0
	TRNE I,IROP
	TRNE I,IRSYL
	TLO C,400000	;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL
	PUSH P,C
	PUSHJ P,LSSTH9
	POP P,C
	MOVSM A,T1	;STORE SWAPPED VALUE
	ADDI B,400000	;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT
	HLREM B,T2	;STORE AS RH WITH SIGN EXTENDED
	MOVSI B,400000(B)	;GET RIGHT HALF IN LEFT
	ADDM B,T2	;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE
		;ELSE WHEN KEEPING THE HALFWORDS SEPARATE)
	MOVSI B,SWAPF
	PUSHJ P,LNKTC1
	JSP LINK,USVWLD
	MOVE A,T1
	MOVE B,T2
	JUMPL C,LSSTH1	;ADD TO WHOLE WORD
	JRST LSSTH2

;VERSION OF GETWRD FOR PSEUDO,
;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1.
;SYM SHOULD HOLD NAME OF PSUEUDO.

AGETWD:	MOVEM SYM,GTVER	;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS.
	TRO I,IRPSUD\IRDEF\IRNOEQ
	PUSHJ P,GETWRD
	MOVE SYM,GTVER	;RESTORE SYM.
	TLNE I,ILMWRD
	PUSHJ P,IGTXT	;SOAK UP MULTIPLE WORD
	RET
;;GETWD		;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B

GETWRD:	MOVE T,GLSP1
	MOVEM T,GLSP2
	CLEARM FORMAT	;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB
	CLEARM WRD	;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD
	CLEARM WRDRLC	; " RELOCATION BITS, "
	TDZ I,[ILWORD,,IRIOINS]
	CLEARM FLDCNT	;NO FIELDS YET
	MOVE T,[50100,,FORMAT]	;SET UP BIT POINTER TO FORMAT
	MOVEM T,FORPNR
GTWD1:	PUSHJ P,GETFLD	;READ NEXT FIELD
SPACE6:	MOVEI T,1	;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO
	SKIPA C,CDISP
SPACE5:	REST A
	TLNE C,DWRD
	JRST (C)	;NO DISPATCH MEANS WD TERMINATOR
	MOVE C,GLSP1
	MOVEM C,LINKL	;MARK END OF ACTIVE PART OF GLOTB
	TRNN I,IRFLD
	JRST GETWD2	;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF
	IDPB T,FORPNR	;MARK NON-NULL FIELD IN FORMAT
GTWD4A:	TLO I,ILWORD	;NON-NULL WORD
	MOVE TT,FORMAT
	SKIPN TT,FORTAB-10(TT)	;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD
	ETR [ASCIZ /Undefined format/]
	MOVEM TT,FORMAT		;STORE IN FORMAT
	MOVE T,[301400,,FORMAT]
	MOVEM T,FORPNR
		;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD
GTWD3:	LDB T,FORPNR
	MOVE D,FLDCNT
	CAIG D,2
	IBP FORPNR	;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV
	TRNE I,IRIOINS
	PUSHJ P,INTIOW
	PUSHJ P,INTFLD	;PUT FIELD WHERE IT BELONGS
	SOSGE FLDCNT
	JRST GTWD5	;THIS WAS LAST (FIRST) FIELD
	POP P,GLSP2	;NOT YET, POP OFF MORE
	POP P,GLSP1
	POP P,B
	POP P,A
	JRST GTWD3

GTWD5:	MOVE A,WRD
	MOVE B,WRDRLC
	MOVE C,LINKL
	MOVEM C,GLSP1
	TRZ I,IRIOINS
	POPJ P,
COMMA:	TRNN I,IRFLD	;FIELD DELIMITER WAS COMMA (T HAS 1)
	 JRST COMMA1	;NO FIELD
	IDPB T,FORPNR	;MARK NON-NULL FIELD
COMMA4:	IDPB T,FORPNR	;MARK FIELD TERMINATOR WAS COMMA
	MOVE TT,FLDCNT
	CAIL TT,2
	 ETR [ASCIZ /Comma past the 3rd field of a word/]
PUSHFD:	PUSH P,A	;DONE WITH THIS FIELD, NOW TO GET NEXT
	PUSH P,B
	PUSH P,GLSP1
	PUSH P,GLSP2
	AOS FLDCNT	;ANOTHER FIELD
	MOVE TT,GLSP1
	MOVEM TT,GLSP2
	HRRZ T,FORPNR
	CAIE T,FORMAT
	HRRZS FORPNR	;STABILIZE FORPNR
	TLO I,ILWORD	;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL).
	JRST GTWD1

GETWD2:	SKIPN FORMAT	;LAST FIELD OF WORD IS NULL
	JRST GTWD5	;ENTIRE WORD NULL, MAYBE WERE PARENS.
	SOS FLDCNT
	POP P,GLSP2
	POP P,GLSP1
	POP P,B
	POP P,A
	JRST GTWD4A

COMMA1:	LDB TT,FORPNR	;COMMA TERMINATED NULL FOELD.
	SKIPE FORMAT
	JUMPE TT,COMMA2	;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE.
	IBP FORPNR	;ELSE MARK NULL FIELD IN FORMAT.
	JRST COMMA4

;FIELD SPACE COMMA, PATHOLOGICAL CASE
;(EG MACRO STARTED WITH A COMMA)
COMMA2:	DPB T,FORPNR	;REPLACE SPACE WITH COMMA.
	JRST GTWD1

		;FIELD TERMINATOR IS SPACE (T HAS 1)

SPACE:	MOVE TT,LIMBO1
	CAIE TT,^I	;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE,
	 JRST SPACE4	;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS.
	PUSH P,A
	MOVE TT,GDTAB+40
	PUSHJ P,RCH
	CAMN TT,GDTAB(A)
	JRST .-2	;FLUSH OTHER LOGICAL SPACES
	CAIN A,";	;TAB WAS FOLLOWED BY SEMICOLON:
	 JRST [	PUSH P,B
		TRZ I,IRSYL
		CALL SEMIC	;FLUSH THE COMMENT
		MOVEI T,1
		REST B
		JRST SPACE5]	;AND HANDLE THE C.R.
SPACE3:	POP P,A
	TLO FF,FLUNRD	;CAUSE CHAR TO BE RE-READ NEXT TIME
SPACE4:	TRNN I,IRFLD
	 JRST GTWD1	;NO FIELD
	IDPB T,FORPNR	;T HAS 1, MARK NON-NULL FIELD IN FORMAT
	IBP FORPNR	;MARK FIELD TERMINATOR WAS SPACE
	JRST PUSHFD
;T HAS DESC BYTE, PUT FIELD IN ITS PLACE
;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA.

INTFLD:	MOVE TT,GLSP2
	CAMN TT,GLSP1
	 JUMPE B,INTFD1	;NO GLOBALS, JUMP IF NO RELOCATION
	CAIN T,2222	;LH
	 JRST INTL
	CAIN T,22	;RH
	 JRST INTR
	CAIN T,44	;WHOLE WORD
	 JRST INTW
	SKIPE B
	 ETR [ASCIZ/Relocation attempted in irrelocatable field/]
		;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS
	CAIN T,2704	;HIGH AC
	 JRST INTACH
	CAIN T,504	;AC LOW
	 JRST INTACL
	JUMPGE FF,INTFD1	;JUMP ON NOT PUNCHING PASS
	CAME TT,GLSP1
	 ETR [ASCIZ/Global symbol in illegal field/]
INTFD1:	MOVEI TT,C_12.
	ROTC T,-12.	;SHIFT BYTE POINTER INTO TT
	MOVEI C,0	;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE
	DPB A,TT
	CAMN TT,[2200,,C]
	JRST INTFD2	;RIGHT HALF, DON'T ALLOW CARRY INTO LH
	ADDM C,WRD	;ALLOW CARRY
INTFD3:	ADDM B,WRDRLC	;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER
	POPJ P,

INTFD2:	ADD C,WRD	;ADD RIGHT HALVES
	HRRM C,WRD
	JRST INTFD3

INTIOW:	CAIE T,2704
	CAIN T,504
	TRZA A,3		;IO DEVICE FIELD
	POPJ P,			;NOT "AC" FIELD
	ADDI T,611-504
	POPJ P,
INTR:	HRRE D,B	;RH
	MOVEI B,0
	PUSH P,T
	HRLZI C,HFWDF
	PUSHJ P,LNKTC1	;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME
PRTCL:	MOVE B,D	;GET BACK MAPPED RELOCATION BITS
PRTCL2:	POP P,T
INTW:	MOVE D,GLSP2	;WHOLE WORD
	HRLOI LINK,377777
	CAML D,GLSP1
	JRST INTFD1
	ANDM LINK,1(D)
	AOJA D,.-3

INTL:	HRLZ D,B	;LH
	MOVSI B,SWAPF
	MOVSI C,HFWDF
	PUSH P,T
	MOVE T,GLSP2
INTL2:	CAML T,GLSP1
	JRST PRTCL
	SKIPGE 1(T)	
	AOJA T,INTL2	;INDEX FIELD, ETC => LEAVE ALONE
	IORM C,1(T)	;SET HFWDF
	XORM B,1(T)	;COMPLEMENT SWAP STATUS
	TDNN B,1(T)
	SETZM 1(T)	;SWAPPED TO RH, FLUSH IT
	AOJA T,INTL2

INTACL:	TDZA B,B	;AC LOW
INTACH:	HRLZI B,SWAPF	;AC HIGH
	HRLZI C,ACF
	PUSH P,T
	PUSHJ P,LNKTC1
	MOVEI B,0
	JRST PRTCL2

IOINST:	HLLZ A,B	;IO INSTRUCTION, GET WHICH ONE INTO A
	SKIPN FLDCNT	;THIS FIRST FIELD OF WORD?
	TRO I,IRIOINS	;YES
	JRST CLBPOP	;RETURN VALUE
;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS
;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS
;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE
;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1

ASSEM1:	MOVE P,ASSEMP
	JRST @ASMDSP

;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER.
ASSEM3:	PUSHJ P,RCH
	CAIN A,^I
	 JRST ASSEM2	;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB.
	CAIG A,40
	 JRST ASSEM3	;FLUSH LEADING GARBAGE
	TLO FF,FLUNRD	;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT
;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC.
ASSEM2:	TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL
	TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT
	IOR I,ASMI	;SET DEF AND RESTORE PSEUDF.
	MOVE A,GLSPAS
	SKIPL BYTM
	 MOVEM A,GLSP1
		;GETWRD WILL COPY GLSP1 INTO GLSP2
IFN TS,[AOSN TTYBRF	;DO A ^H-BREAK IF REQUESTED.
	 CALL TTYBRK]
	PUSHJ P,GETWRD
	TLZN I,ILWORD
	 JRST @ASMDSP	;NO WORD ASSEMBLED,TRY AGAIN
	SKIPGE BYTM
	 JRST PBYTE	;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC.
	MOVE AA,ASMOUT	;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY.
	JRST @ASMOT0(AA)

ASSEM6:	SKIPE STGSW	;ASMOT0 POINS HERE. COME IF NOT IN GROUPING.
	 ETR ERRSWD	;STORAGE WORD ASSEMBLED
	PUSHJ P,PWRD	;OUTPUT THE WORD.
	AOS CLOC
	HRRZS CLOC	;INCREM. POINT .
	JRST @ASMDSP	;ASSEM3 OR ASSEM2

ERRSWD:	ASCIZ /Storage word assembled/

ASSEM4:	JSP T,PCONST	;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT.
	JRST @ASMDSP

;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE
;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN.
ASSEMC:	MOVE AA,ASMOUT
	SKIPE CONSML	;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG.
	 XCT ASMOT3(AA)
	JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN.
;JUMP THRU THIS TABLE TO OUTPUT A WORD.
ASMOT0:	ASSEM6?	ASSEM1?	ASSEM1?	ASSEM4? [HALT ]

;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[
ASMOT1:	 "? ?	 "> ?	 ") ?	 "] ?	"?

;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING.
ASMOT2:	[HALT ]?	LSSTHA? LSSTHA? CONND? [HALT ]

;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [
ASMOT3:	HALT
	ETR [ASCIZ /Missing >/]
	ETR [ASCIZ /Missing )/]
	ETR [ASCIZ /Missing ]/]
	HALT

;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE.
ASMOT4:	PBY4 ?	PBY5 ?	PBY5 ?	PBY3 ?	[HALT ]

;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING.
ASMOT5:	"? ?	 "< ?	 "( ?	 "[ ?	"?	;]
;;GETVAL	;GET VALUE OF SYM
		;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED)
		;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B

VBLK
GTVER:	0	;SQUOZE NAME OF CALLING PSEUDO, OR POINTER
		;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF.
PBLK

GETVAL:	PUSHJ P,ES
	 JRST GVNF	;NO STE.
IFN CREFSW,XCT CRFINU	;JFCL OR CALL TO CREF RTN.
	JRST @.+1(A)	;FOUND, DISPATCH ON SQUOZE FLAGS

GVTAB:	GVCOM	;COMMON (UNUSED)
	GVPSEU	;PSEUDO OR MACRO.
	GVSYM	;LOCAL SYMBOL.
	GVUL	;LOCAL UNDEF (MAYBE STINK KNOWS VALUE)
	GVDLV	;DEFINED LOCAL VAR.
	GVULV	;UNDEF LOC VAR.
	GVDGV	;DEF GLO VAR
	GVUGV	;UNDEF GLO VAR
	GVDG	;DEF GLOBAL
	GVUG	;UNDEF GLOBAL

;DEF LOCAL VAR.
GVDLV:	PUSHJ P,GVDLGV	;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB
	TLZN I,ILGLI
	 JRST GVDLV2
	MOVSI T,DEFGVR	;NOW DEF GLO VAR.
	PUSHJ P,VSM2
	JRST GVDG1	;MAYBE OUTPUT GLOBAL DEF. TO STINK.

GVDGV:	PUSHJ P,GVDLGV	;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2
	JRST GVDG2	;MUSN'T PUNCH VALUE, AVARIAB WILL.

GVDLGV:	TRNE FF,FRPSS2	;IF PASS 2
	 TLNN I,ILVAR	;AND THIS TIME HAVE SINGLEQUOTE
	  POPJ P,
	TLO C,3VAS2	;TELL AVARIAB SEEN IN PASS 2 WITH '.
	3PUT C,D
	POPJ P,

GVULV:	TLZN I,ILGLI	;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL.
	 JRST GVUNDF
	PUSHJ P,PLOGLO	;IF SO, TELL STINK SYM IS GLOBAL,
	MOVSI T,UDEFGV	;SYM NOW UNDEF GLO VAR
	PUSHJ P,VSM2
	JRST GVUNDF	;IN EITHER CASE, HANDLE UNDEF SYM.
GVUL:	TLZE C,3MACOK	;UNDEF LOCAL, PRESUMED NUMERIC
	 3PUT C,D	;DON'T LET IT BECOME MACRO AND SCREW PASS2.
	TLNE C,3LLV
	 JRST GVGLTB	;(REALLY DEFINED BUT ONLY STINK KNOWS HOW)
	TLNE I,ILGLI	;IF MAKING GLOBAL, TELL STINK.
	 PUSHJ P,PLOGLO
GVNF1:	TLZE I,ILVAR	;IF ', MAKE VAR (WILL CHECK ILGLI)
	 JRST GVUL1
	TLZN I,ILGLI	;NOT MAKING VAR, MAYBE GLOBAL?
	 JRST GVUNDF	;NO, MAYBE ERROR, MAKE GLOTB ENTRY.
	MOVSI T,GLOEXT
	PUSHJ P,VSM2	;NOW GLOBAL UNDEF,
	JRST GVGLTB	;NO ERROR, JUST GLOTB ENTRY.

GVUL1:	TLZN I,ILGLI	;UNDEF LOCAL BECOMES
	 SKIPA T,[UDEFLV,,]	;UNDEF LOC VAR OR
GVGVAR:	  MOVSI T,UDEFGV	;UNDEF GLO VAR.
GVVAR:	CALL ESDEF	;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK.
	 JFCL
	AOS VARCNT
	HRR B,VARCNT
	PUSHJ P,VSM2	;MAKE IT A VAR,
	JRST GVUNDF	;PRETEND HAD ALREADY BEEN A VAR.

GVUG:	TLZE I,ILVAR	;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR.
	 JRST GVGVAR
GVGLTB:	SKIPGE CONTRL	;UNDEF GLO IN ABS ASSEM =>
	 JRST GVUND1	 ;MAYBE TREAT AS UNDEF.
GVGLT1:	AOS GLSP1	;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY.
	MOVEI T,ST(D)
	HRRZM T,@GLSP1
	JRST CABPOP	;RETURN 0 AS VALUE.

GVNF:
IFN CREFSW,XCT CRFINU	;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES.
	TLNE I,ILVAR+ILGLI	;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY
	 JRST GVNF1	;AND WILL STORE NAME IN STE ANYWAY.
	SKIPGE ESBK	;ELSE IF NO SPEC'D BLOCK,
	 TRNN FF,FRNPSS	;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES.
	  CAIA		;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS.
	   HRRI C,BKWPB
	MOVSI T,LCUDF
	PUSHJ P,VSM2
	JRST GVUNDF	;MAYBE ERROR, MAKE GLOTB ENTRY.

GVCOM:	TRO I,IRCOM	;COMMON: SAY THIS WAS ONE.
	HRRZ A,B	;RETURN RH OF VALUE, ABSOLUTE.
	JRST CLBPOP

GVPSEU:	TLNN I,ILVAR+ILGLI	;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR.
	 JRST (B)		;OTHERWISE, DISPATCH TO IT.
	TLZE I,ILVAR
	 ETSM ERRCBV
	TLZE I,ILGLI
	 ETSM ERRCBG
	JRST (B)	;DISPATCH TO PSEUDO (OR MACCL IF MACRO)
			;EXPECTS LH OF VALUE IN LH OF B.

ERRCBV:	ASCIZ /Can't be a variable/
ERRCBG:	ASCIZ /Can't be global/

GTVL7B:	TLNE C,3RLL	;R(LH)
	 TLO SYM,200000
	TLNE C,3RLR	;R(RH)
	 TLO SYM,100000
	POPJ P,
GVSYM:	TLNN C,3REL
	 TLNE I,ILVAR\ILGLI
	  JRST GVSYM2
	MOVE A,B	;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER.
	SETZ B,
	RET

GVSYM2:	TLZE I,ILVAR	;LOCAL SYM: CAN'T MAKE VARIABLE.
	 ETSM ERRMDV
	TLZN I,ILGLI
	 JRST GVSYM0	;NOT MAKING GLOBAL, GET VALUE & RETURN.
GVSYM1:	MOVSI T,GLOETY	;BECOMES DEF. GLOBAL.
	PUSHJ P,VSM2
	JRST GVDG1	;HANDLE AS IF WAS DEF GLOBAL.

ERRMDV:	ASCIZ /Multiply-defined variable/

GVDG:	TLZE I,ILVAR	;GLOBAL ENTRY
	 ETSM ERRMDV
;COME HERE FOR DEF GLOBAL
GVDG1:	SKIPGE CONTRL
	 JRST GVDLV2	;DON'T PUNCH VALUE IF ABSOLUTE.
	TLNE C,3VP
	 JRST GVDG2	;VALUE PUNCHED ALREADY, NOT AGAIN.
	JUMPGE FF,GVDG2
	TLNN C,3LLV
	 TRNE I,IRPSUD+IREQL
	  JRST GVDG2
	TLO SYM,40000
	PUSH P,WRD
	PUSHJ P,OUTDE2
	POP P,WRD
GVDG2:	TRNN I,IRPSUD\IREQL	;IF INSIDE AN ORDINARY STORAGE WORD,
	 TLNN C,3REL		;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC).
GVDLV2:	  TLNE C,3LLV		;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF.
	   JRST GVGLTB
GVSYM0:	MOVE A,B	;USED IN LBRAK
	LDB B,[.BP (3RLR),C]
	TLNE C,3RLL
	 TLO B,1
	POPJ P,

GVUND1:	MOVE A,CONTRL
	TRNE A,DECREL+FASL	;DEC FMT OR FASL => UNDEF GLOBALS OK.
	 JRST GVGLT1
GVUGV:
GVUNDF:	TRZ I,IRDEF	;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY.
	TRNE I,IRPSUD\IREQL
	 JRST GVUND2	;PSEUDO
	TRNN FF,FRPSS2
	 JRST GVGLT1		;PASS 1
	SKIPN CONDEP
	 ETSM [ASCIZ/Undefined/]
	SKIPE CONDEP
	 ETSM [ASCIZ/Undefined in literal/]
	JRST CABPOP

GVUND2:	HLRZ A,GTVER	;DOES GTVER POINT TO AN INSN?
	JUMPE A,[XCT @GTVER ? JRST CABPOP]
	ERJ .+1		;NO, IT IS NAME OF PSEUDO.
	MOVE A,LINEL
	CAIGE A,75.	;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE.
	 CALL CRRTBX
	TYPE2 SYM	;TYPE NAME OF UNDEF SYM.
	TYPR [ASCIZ/	Undefined in /]
	TYPE2 GTVER
	CALL CRRERR
	JRST CABPOP
;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM
;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS).
;DOESN'T CLOBBER F (FOR WRQOTE)
;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A,
;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C.
;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM.
;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT):
;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN
;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND
;ESL2 HAS 3RDWRD OF BEST.
;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM.
;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM.
;TT HAS -<# STE NOT LOOKED AT YET>
;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE
;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN.
;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T
;LET YOU SEE WHAT YOU ARE GOING TO SHADOW.

ESDEF:	MOVE A,BKCUR	;EVAL SYM IN ORDER TO DEFINE IT:
	SKIPGE ESBK	;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK,
	 MOVEM A,ESBK	;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN

ESDCHK:	SETOM ESLAST	;CALL HERE IF WE MIGHT END UP CALLING DEFCHK,
	SETOM ESL1	;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND
	SETOM ESXPUN	;RIGHT AWAY.
	MOVN TT,SYMLEN
ES:	MOVE C,SYM	;HASH AWAY
	TSC C,SYM	;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE
			;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER.
	MOVMS C		;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER.
	IDIV C,SYMLEN
	IMUL D,WPSTE
	SKIPGE TM,ESBK	;GET BKTAB IDX OF SPEC'D BLOCK
	 HRR TM,BKCUR	;OR -1,,BKTAB IDX OF CURRENT BLOCK.
;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN
;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED.
	SKIPN B,ST(D)
	 JRST ESEND0	;SYM IS KNOWN NOT TO BE DEFINED.
	TLZ B,740000
	CAME B,SYM
	 JRST ESBAD0	;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP
	3GET C,D
	MOVEI A,(C)
	CAIN A,(TM)
	 JRST ESGOOD	;IN THE DESIRED BLOCK => GOOD.
	TDNN C,[3MAS,,-1]	;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER,
	 JUMPL TM,ESGOOD	;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD.
	MOVN TT,SYMLEN	;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT.
	SETOM ESLAST
	SETOM ESL1
	SETOM ESXPUN
	JUMPGE TM,ESIGN
	JRST ESLP1
;LOOK AT THE NEXT STE, WHILE LOOPING.
ESLP:	SKIPN B,ST(D)	;GET SQUOZE IN THIS ST SLOT
	 JRST ESEND	;NOTHING WHERE SYM BELONGS, END SEARCH
	TLZ B,740000	;CLEAR OUT FLAGS
	CAME B,SYM	;COMPARE WITH WANTED
	 JRST ESBAD	;NO MATCH BUT MAYBE KEEP GOING
	3GET C,D	;FOUND SYM, GET 3RDWRD
	MOVEI A,(C)
	CAIN A,(TM)	;DEFINED IN DESIRED BLOCK
	 JRST ESGOOD	; => MUST BE GOOD.
ESLP0:	JUMPGE TM,ESIGN	;BLOCK SPEC'D => ALLOW NO OTHERS.
	TDNE C,[3MAS,,-1]	;IF IN INITIAL SYMS BLK, NO MORE DEFS,
	 JRST ESLP1
	SKIPGE ESL1	;AND NO PREVIOUS DEFS,
	 JRST ESGOOD	;UNREDEFINED INITL SYM MUST BE GOOD.
ESLP1:	HLRZ B,BKTAB+1(C)	;GET LEVEL OF BLOCK DEF. IS IN.
	CAMN A,BKPDL(B)	;SAME AS BLOCK WE'RE IN AT THAT LEVEL?
	 CAMLE B,BKLVL	;AND NOT A BLOCK WE'VE EXITED
	  JRST ESIGN
	CAMG B,ESL1	;OR HIGHER LEVEL THAN PREVIOUS BEST
	 JRST ESIGN
	MOVEM C,ESL2	;REPLACE BEST'S 3RDWRD, LEVEL, ADDR.
	MOVEM B,ESL1
	MOVEM D,SADR
ESIGN:	HRRZM D,ESLAST	;THIS ENTRY LAST SEEN WITH THIS NAME.
	TLNN C,3MAS	;MORE STE'S FOR THIS SYM => 
	 JRST ESEND1
	JRST ESNXT	;KEEP LOOKING.

;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP.
ESBAD0:	MOVN TT,SYMLEN
	SETOM ESLAST
	SETOM ESL1
	SETOB C,ESXPUN
;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN.
ESBAD:	JUMPN B,ESNXT
	SKIPGE A,ESXPUN	;IF THIS IS 1ST EXPUNGED ENTRY SEEN
	 MOVEM D,ESXPUN	;REMEMBER IT FOR DEFINITION.
	SKIPGE A
	 HRROS ESLAST	;AND SET OLD ENTRY'S 3MAS.
ESNXT:	ADD D,WPSTE
	CAML D,SYMSIZ	;AT END => GO TO BEGINNING
	 MOVEI D,0
	AOJN TT,ESLP
	JRST ESEND1	;NOT FOUND.
ESEND0:	MOVEI C,(TM)	;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED
	MOVEM D,ESXPUN
	POPJ P,

ESEND:	SKIPGE A,ESXPUN	;FREE ENTRY CAN BE USED TO DEFINE.
	 MOVEM D,ESXPUN
	SKIPGE A
	 HRROS ESLAST
ESEND1:	SKIPGE ESL1	;NOT FOUND => FIND PLACE TO DEFINE IT.
	 JRST DEFCH1
	MOVE D,SADR	;IDX OF BEST FOUND.
	TRNN FF,FRNPSS
	 JRST ES1PS	;1-PASS, SPECIAL CHECK.
	MOVE C,ESL2	;GET BEST'S 3RDWRD.
ESGOOD:	LDB A,[400400,,ST(D)]	;GET SQUOZE FLAGS IN A.
ES1POK:	MOVE B,ST+1(D)	;VALUE OF SYM. IN B.
			;D HAS IDX OF 1STWRD IN SYM TAB.
			;C HAS 3RDWRD
POPJ1:	AOS (P)
APOPJ:
CPOPJ:	POPJ P,

;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF.
;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK.
DEFCHK:	SKIPGE ESL1	;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE,
	 HRRZM D,ESLAST	;DO IT NOW. (SEE BEFORE ESLP1)
	JRST DEFCH1

ES1PS:	LDB A,[400400,,ST(D)]	;1PASS & FOUND IN CONTAINING BLOCK:
	MOVE C,ESL2
	TRNN C,-1	;INITIAL SYM, OK;
	 JRST ES1POK
	CAIE A,1	;PSEUDO OR MACRO
	 TLNE C,3DOWN	;OR .DOWN'D SYMBOL OK;
	  JRST ES1POK	;ELSE GET NEW STE TO DEF.
DEFCH1:	MOVEI C,(TM)	;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN.
	SKIPL D,ESXPUN	;IF FOUND EXPUNGED OR FREE ENTRY, USE IT.
	 JRST DEFCH2
	SKIPGE D,ESLAST	;ELSE LOOK FOR ONE.
	 ETF ERRSCE
DEFCH4:	MOVE B,ST(D)
	TLZ B,740000
	JUMPE B,DEFCH3	;MUST RETURN 0 IN B IF DON'T SKIP.
	ADD D,WPSTE
	CAML D,SYMSIZ
	 MOVEI D,0
	AOJL TT,DEFCH4	;ASSUME TT LEFT AROUND FROM ES.
	ETF ERRSCE
ERRSCE:	ASCIZ /Symbol table full/

;ESLAST HAS -1 IF NO ENTRY SEEN;  ELSE
;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE.
DEFCH3:	MOVEM D,ESXPUN	;REMEMBER ADDR WHERE CAN DEFINE
	HRROS ESLAST	;LAST PLACE SEEN MUST BE EARLIER.
DEFCH2:	SKIPL A,ESLAST
	 JRST DEFCH5	;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE.
	CAMN A,[-1]
	 POPJ P,		;REALLY NEVER SEEN.
	MOVSI TM,3MAS
	IORM TM,ST+2(A)	;PLACE SEEN IS EARLIER, SET ITS 3MAS.
	POPJ P,

DEFCH5:	TLO C,3MAS	;PLACE TO DEF BEFORE EXISTING STES.
	POPJ P,
;ENTER A SYM IN SYMBOL TABLE
		;B HAS VALUE
		;C HAS 3RDWRD
		;D HAS INDEX INTO ST (PROBABLY SET UP BY ES)
		;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE
		;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED

VSM2LV:	TLOA C,3LLV	;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE
VSM2W:	MOVE B,WRD	;ENTRY TO ENTER VALUE OF WRD STEAD B
VSM2:	MOVE CH1,SYM
	TLZ CH1,740000
	IOR CH1,T	;CH1 := SQUOZE WITH FLAGS
	MOVEM CH1,ST(D)	;STORE SQUOZE
	MOVEM B,ST+1(D)	;STORE VALUE
VSM3A:	3PUT C,D	;STORE 3RDWRD
	POPJ P,

;RETURN THE NUMBER OF SYMTAB SLOTS IN USE.
A.SYMCN:SKIPL A,SMSRTF		;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD
	 JRST CLBPOP		;BEFORE COMPACTION AND RETURN THAT.
	MOVE D,SYMAOB
	SETZ A,
A.SYC1:	MOVE B,ST(D)
	TLZ B,740000
	SKIPE B
	 AOS A
	ADD D,WPSTE1
	AOBJN D,A.SYC1
	JRST CLBPOP
;;EQUAL		;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT

EQUAL:	TLZ FF,FLHKIL
	PUSHJ P,RCH
	CAIE A,"=	;DECIDE WHETHER TO HALF-KILL THE SYM.
	 TLOA FF,FLUNRD
	  TLO FF,FLHKIL
	SETZM LABELF
	CALL RCH
	CAIE A,":	;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE.
	 TLOA FF,FLUNRD
	  SETOM LABELF
	CAMN SYM,[SQUOZE 0,.]	;.=FOO, SAME AS LOC FOO
	 JRST PTEQ
	TDNN I,[ILWORD,,IROP+IRNOEQ]
	 TRNN I,IRLET
	  ETR [ASCIZ/= With bad format or bad context/]
	PUSH P,LABELF
	PUSH P,SYM
	PUSH P,ESBK
	PUSH P,I
	MOVEI A,[ETSM [ASCIZ/Undefined in =/]]
	MOVEM A,GTVER
	TRO I,IRNOEQ+IRDEF+IREQL
	PUSHJ P,GETWRD
	TRNN I,IRDEF
	 JRST ASEM1A	;UNDEFINED SYMS IN VALUE, IGNORE
IFN LISTSW,[
	SKIPN LSTONP
	 JRST EQUAL1	;NOT LISTING.
	SKIPGE LISTPF
	 PUSHJ P,PNTR
	MOVE SYM,WRD
	MOVEM SYM,LISTWD
	MOVE SYM,WRDRLC
	MOVEM SYM,LSTRLC
	SETOM LISTAD
	SETOM LISTPF
EQUAL1:
] ;END IFN LISTSW,
	TDZ I,[-1-(ILMWRD)]
	IOR I,(P)
	TLZ FF,FLUNRD
	POP P,(P)
	POP P,ESBK
	POP P,SYM
	POP P,LABELF
	MOVE A,WRDRLC	;GET RELOCATION
	TDNN A,[-2,,-2]	;SKIP ON NON-STANDARD RELOCATION BITS
	SKIPE LDCCC
	JRST EQG1	;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER
	MOVE A,GLSP1
	CAMN A,GLSP2
	 JRST EQL1	;NO GLOBALS IN DEFINITION
;FALLS THROUGH.
;FALLS THROUGH.
;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT.
EQG1:	IFN CREFSW, XCT CRFLBL	;CREF DEF. OF NORMAL SYM,
	SKIPGE CONTRL
	 JUMPL FF,[ETASM [ASCIZ /Externals in =/]]
	CALL ESDCHK		;SEARCH SYM TAB.
	 JRST EQL2	;NOT FOUND IN CURRENT OR CONTAINING BLKS.
	HRRZI T,(C)	;GET BKTAB IDX OF BLOCK FOUND IN.
	CAIE T,(TM)
	 JRST EQG1A
	XCT EQG1TB(A)	;FOUND IN DESIRED BLOCK.
	JRST ASSEM1

EQG1A:	JUMPN T,EQG2
	CAIN A,PSUDO_-16	;FOUND AS INITIAL PSEUDO => ERROR.
	 ETSM ERRQPA
EQG2:	CALL DEFCHK	;FIND FREE STE TO DEFINE IN DESIRED BLOCK.
	JRST EQL2	;PRETEND WASN'T FOUND.

ERRQPA:	ASCIZ /Shadowing a pseudo-op/
ERRIPA:	ASCIZ /Illegal =/

EQG1TB:	ETSM ERRIPA	;COMMON
	ETSM ERRIPA	;PSEUDO OR MACRO
	JRST EQL2	;SYM
	JRST EQGUL	;LOCAL UNDEF
	ETSM ERRIPA	;DEF LOC VAR
	ETSM ERRIPA	;UNDEF LOC VAR
	ETSM ERRIPA	;DEF GLO VAR
	ETSM ERRIPA	;UNDEF GLO VAR
	JRST EQL7	;GLO ENTRY
	JRST EQL8	;GLO EXIT

EQL8:	PUSHJ P,GLKPNR
	TLZ C,3LABEL\3MULTI
EQL7:	MOVSI T,GLOETY	;GLOBAL PARA ASSIGN
	MOVEI B,0
	TLO SYM,40000
LOPRA1:	PUSH P,CASM1A	;RETURN TO ASSEM1A AFTER FOLLOWING.
	TLNE C,3MULTI
	 ETSM ERRMDT
	SKIPE LABELF
	 TLO C,3LABEL
	TLNE FF,FLHKIL
	 TLOA SYM,400000	;SET FLAG TO HALF-KILL SYM
	TLZA C,3SKILL
	 TLO C,3SKILL	;SET CORRESPONDING FLAG IN 3RDWRD
	PUSHJ P,VSM2LV
	JUMPGE FF,CPOPJ	;JUMP ON NOT PUNCHING PASS
	TRNN I,IREQL	;IF CAME FROM COLON ROUTINE,
	 JRST PDEFPT	;PUNCH "DEFINE SYM AS $.".
	TLO C,3VP	;VALUE PUNCHED
	3PUT C,D	;STORE UPDATED 3RDWRD
	PUSHJ P,EBLK
	MOVEI TT,LGPA
	DPB TT,[310700,,BKBUF]
	PUSHJ P,OUTSM0
	PUSHJ P,PWRDA
	JRST EBLK

EQGUL:	PUSHJ P,LKPNRO	;LOCAL UNDEF, OUTPUT LINK REQUEST.
	TLZ C,3LABEL\3MULTI	;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE.
EQL2:	TLNE I,ILGLI
	 JRST EQL7	;MAKE IT GLOBAL
	MOVSI T,LCUDF	;LOCAL UNDEFINED
	JRST LOPRA1

CASM1A:	JRST ASEM1A
;MAYBE PUNCH OUT LINK REQUEST
;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST
;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B)

GLKPNR:	TLO SYM,40000	;GLO BIT
LKPNRO:	TLNN C,3RLNK
	 TLNE B,-1
	  TROA I,IRCONT
	   POPJ P,	;DON'T PUNCH REQUEST
	MOVE A,CONTRL
	TRNE A,DECREL
	 JRST LKPNDR	;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT
	MOVEI A,6
	PUSHJ P,PBITS
	PUSHJ P,OUTSM0	;PUNCH SYM
	HLRZ A,B
	TLZE C,3RLNK	;RELOC OF LINK PNR
	 TLO A,100000
	HRRZS B		;CLEAR OUT LH OF B
	TRZ I,IRCONT	;OK TO END BLOCK NOW
	JRST $OUTPT	;PUNCH OUT A AND RETURN

LKPNDR:	MOVSI A,DECINT	;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD.
	CALL DECBLK
	SETZ TM,	;COMPUTE RELOC OF ADDRESS AND DATA IN TM.
	TLNE C,3RLNK
	 TRO TM,2
	SKIPE WRDRLC
	 TRO TM,1
	MOVE A,WRD	;ADDRESS TO LINK,,DATA
	HRL A,B
	CALL DECWR1
	JRST EBLK

;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM.
;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH.
;CALL ONLY IN RELOCATABLE ASSEMBLY.
OUTDE2:	MOVEM B,WRD
OUTDE1:	TLNE FF,FLPPSS
	TLO C,3VP	;VALUE PUNCHED
	3PUT C,D
	SKIPGE CONTRL
	 RET
	TRO I,IRCONT
	SETZ A,
	TLNN C,3LABEL	;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE.
	 MOVEI A,CRDF
	CALL P7X	;PUNCH OUT CODE BITS
	PUSHJ P,GTVL7B	;SET RELOCATION BITS IN SQUOZE
	PUSHJ P,OUTSM0
	TRZ I,IRCONT
	JRST OUTWD	;OUTPUT VALUE

;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM
;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL
PLOGLO:	SKIPGE CONTRL
	 RET
	PUSH P,A
	PUSHJ P,PBITS7
	MOVEI A,CLGLO
	PUSHJ P,PBITS
	TLO SYM,400000	;SAY THIS IS NEW STYLE RQ,
	PUSHJ P,OUTSM0	;PUNCH "OLD NAME" = SYMTAB IDX,
	TLC SYM,440000	;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM.
	PUSHJ P,OUTSM
	JRST POPAJ
;NO GLOBALS TO RIGHT OF EQUAL SIGN

EQL1:	PUSHJ P,ESDCHK
	 JRST EQL1A	;NOT FOUND
IFN CREFSW,XCT CRFEQL	;DEF. OCCUR. OF NORMAL SYM. OR INTSYM.
	MOVEI T,(C)	;GET BKTAB IDX OF BLOCK FOUND IN.
	CAIE T,(TM)
	 JRST EQL1F
	SKIPE LABELF	;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
	 TLO C,3LABEL
	XCT EQL1TB(A)	;FOUND IN DESIRED BLOCK => NOW REDEFINE.
	JRST ASSEM1

EQL1F:	JUMPN T,EQL10
	CAIE A,PSUDO_-16
	 JRST EQL10
	MOVEI T,(B)	;FOUND AS PSEUDO IN INITIAL SYMS BLOCK,
	CAIN T,INTSYM	;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC.
	 JRST EQLINT
	ETSM ERRQPA	;SHADOWING AN INITIAL PSEUDO, TELL USER.
EQL10:	CALL DEFCHK	;FOUND IN OUTER BLOCK, GET NEW STE,
	JRST EQL1A	;DEFINE THERE AS IF NOT FOUND.

EQL1TB:	ETSM ERRIPA	;COMMON
	JRST EQL1B2	;PSEUDO OR MACRO
	JRST EQL1B	;SYM
	JRST EQL1C	;LOCAL UNDEF
	ETSM ERRIPA	;DEF LOC VAR
	ETSM ERRIPA	;UNDEF LOC VAR
	ETSM ERRIPA	;DEF GLO VAR
	ETSM ERRIPA	;UNDEF GLO VAR
	JRST EQL1D	;GLO ENTRY
	JRST EQL1E	;GLO EXIT

EQL1E:	PUSHJ P,GLKPNR	;DUMP LINKING POINTER
	CAIA
EQL1D:	 CALL MDTCHK
	PUSHJ P,RCHKT	;GLO ENTRY
EQLB2:	PUSHJ P,RMOVET
	TLNE FF,FLHKIL
	 TLOA SYM,400000
	  TLZA C,3SKILL
	   TLO C,3SKILL
	HRLZI T,GLOETY
	SKIPE LDCCC	;IF IN LOADER CONDITIONAL,
	 TLO C,3LLV	;THEN LOADER MUST SUPPLY VALUE
	PUSHJ P,VSM2W	;DEFINE SYM
	TLO SYM,40000	;SET GLOBAL BIT IN SQUOZE
EQL1CE:	JUMPGE FF,ASEM1A
	PUSHJ P,OUTDE1
ASEM1A:	TLNE I,ILMWRD
	 PUSHJ P,IGTXT
	JRST ASSEM1

;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT)
MDTCHK:	TLNN C,3LABEL
	 JRST MDTCH1
	CALL GVSYM0	;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B
	CAMN A,WRD
	 CAME B,WRDRLC	;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT
MDTCHL:	  TLO C,3MULTI
MDTCH1:	TLNE C,3MULTI	;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG
	 ETSM ERRMDT
	RET
EQL1C:	TLNE I,ILGLI
	 JRST EQL1CA	;MAKE GLOBAL
	PUSH P,C
	PUSHJ P,LKPNRO	;MAYBE OUTPUT LINK REQUEST
	PUSHJ P,RCHKT
	PUSHJ P,RMOVET	;INITIALIZE 3RDWRD
	MOVSI T,SYMC	;SYM
	PUSHJ P,EQA2A	;ENTER DEF IN SYMTAB
	TLNE C,3SKILL
	 TLO SYM,400000
	POP P,AA
	TLNE AA,3VCNT	;USED IN CONSTANT
	 PUSHJ P,CONBUG
	JRST EQL1CE

		;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7

P7X:	MOVEM A,PARBIT	;ENTRY FOR SECOND BYTE IN A
P70:	PUSHJ P,PBITS7	;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7
	SKIPA A,PARBIT	;GET SECOND BYTE BACK
PBITS7:	 MOVEI A,7	;ENTRY TO JUST PUNCH OUT 7
	JRST PBITS

EQL1CA:	PUSHJ P,PLOGLO
	JRST EQL1E
EQA2:	PUSH P,CASM1A
EQA2A:	TLNE FF,FLHKIL
	 TLO C,3SKILL
	JRST VSM2W

EQL1B2:	HRRZ A,B	;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM?
	CAIN A,INTSYM
	 JRST EQLINT	;YES, GO SET WD IT POINTS TO.
	ETSM [ASCIZ /Pseudo or macro ='D/]
EQL1B:	CALL MDTCHK
	PUSHJ P,RCHKT
	TLNE I,ILGLI
	 JRST EQLB2	;WAS LOCAL, MAKE IT GLOBAL
		;WAS LOCAL, LEAVE IT LOCAL
	PUSHJ P,RMOVET	;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD)
	MOVSI T,SYMC	;SYM
	JRST EQA2

EQL1A1:	PUSHJ P,RCHKT
	PUSHJ P,RMOVET
	HRLZI T,SYMC
	JRST EQA2

EQL1A:	SKIPE LABELF	;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
	 TLO C,3LABEL
IFN CREFSW,XCT CRFLBL	;DEF. OCCUR. OF NORMAL SYM.
	TLNN I,ILGLI
	 JRST EQL1A1
	JRST EQL1E

EQLINT:	HLRZS B		;GET ADDR OF WD HOLDING VALUE.
	MOVEMM (B),WRD	;PUT NEW VALUE IN IT.
	JRST ASEM1A
;;.		;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET

VBLK
CLOC:	0	;PUNCHING LOC
CRLOC:	0	;PUNCHING RELOC
OFLOC:	0	;OFSET VAL
OFRLOC:	0	;OFSET RELOC
;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC
SYLOC:	0	;VAL OF LAST TAG
SYSYM:	0	;LAST TAG
SYLOC1:	0	;VALUE OF NEXT TO LAST TAG
SYSYM1:	0	;NEXT TO LAST TAG
GLOCTP:	0	;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL
		;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP
		;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET
		;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP):
		;400 => ARG GLOBAL
PBLK


		;POINT (.) AS PSEUDO-OP

GTVLP:	TRNE FF,FRGLOL
	 JRST GTVLP2	;LOCATION GLOBAL
	MOVE B,OFRLOC	;GET RELOCATION OF OFFSET
	ADD B,CRLOC	;ADD CURRENT RELOCATION
	MOVE A,CLOC	;GET CURRENT LOCATION
	SKIPGE BYTM1	;IF IN BYTE MODE,
	 HLL A,BYTWP	;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB
	ADD A,OFLOC	;NOW ADD OFFSET
	TLZ I,ILFLO+ILDECP+IRPERI	;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER
	POPJ P,


GTVLP2:	MOVEI T,$.H	;LOCATION GLOBAL
	AOS GLSP1
	HRRZM T,@GLSP1	;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT)
	SKIPL BYTM1	;IN BYTE MODE?
	 TDZA A,A	;NO, CLEAR ABS PART OF VALUE
	  HLLZ A,BYTWP	;YES, USE LH(BP) AS ABS PART
	JRST CLBPOP

$.H:	(GLOETY)+SQUOZE 0,$.	;CURRENT LOCATION + OFFSET IN LOADER
$L.H:	(GLOETY)+SQUOZE 0,$L.	;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK
$O.H:	(GLOETY)+SQUOZE 0,$O.	;LOADER OFFSET
$R.H:	(GLOEXT)+SQUOZE 0,$R.	;RELOCATION AS GLOBAL
COLON:	TRNE I,IRLET
	 TRNN I,IRSYL
	  ETA [ASCIZ/Colon without preceding symbol/]
	TLNN I,ILWORD
	 TRNE I,IROP+IRPSUD+IREQL+IRNOEQ
	  ETSM [ASCIZ/Label inside an expression/]
	SKIPE ASMOUT
	 ETSM [ASCIZ /Label inside <>, () or []/]
	TLZ FF,FLHKIL
	PUSHJ P,RCH	;GET NEXT CHAR
	CAIN A,":	;IF NEXT CHAR ANOTHER COLON,
	 TLOA FF,FLHKIL	;THEN SET FLAG TO HALF-KILL
	  TLO FF,FLUNRD	;NOT COLON, CAUSE IT TO BE RE-INPUT
	SKIPE HKALL	;CHECK FOR HALF-KILL-ALL-LABELS MODE.
	 TLO FF,FLHKIL
	MOVE T,CLOC	;GET CURRENT LOCATION
	SKIPGE BYTM1
	 HLL T,BYTWP	;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER
	ADD T,OFLOC	;ADD OFFSET
	MOVEM T,WRD	;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT
	EXCH T,SYLOC	;NOW SET UP STUFF FOR ERROR PRINTOUT
	MOVEM T,SYLOC1
	EXCH SYM,SYSYM
	MOVEM SYM,SYSYM1
	MOVE SYM,SYSYM
	MOVE A,CRLOC	;SET UP RELOCATION
	ADD A,OFRLOC
	MOVEM A,WRDRLC
	SETOM LABELF	;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET.
	SKIPN LDCCC
	 TRNE FF,FRGLOL
	  JRST GCOL1	;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL
	PUSHJ P,ESDCHK	;TRY FINDING CURRENT ENTRY IN ST
	 JRST EQL1A	;NOT ALREADY DEFINED
IFN CREFSW,XCT CRFLBL
COLON1:	MOVEI T,(C)	;BKTAB IDX OF BLOCK FOUND IN,
	CAIE T,(TM)	;FOUND IN DESIRED BLOCK => TRY REDEFINING.
	 JRST COLON3
	TLO C,3LABEL	;CAUSE REDEFINING SYMBOL TO BARF
	XCT COLON2(A)	;BUT MAYBE PRINT ERR MSG FIRST.
	 JRST EQL1B

CASSM1:	JRST ASSEM1

COLON3:	JUMPN T,EQL10	;NOT INITIAL SYM => CAN SHADOW,
	CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM
	 CAME B,WRD	;AND NEW VALUE SAME AS OLD VALUE.
	  CAIA
	   SKIPE WRDRLC
	    ETSM ERRRES	;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER.
	JRST EQL10

ERRRES:	ASCIZ /Pseudo, macro or initial sym as label/
ERRMDT:	ASCIZ /Multiply defined/

COLON2:	TLO C,3MULTI	;COMMON
	ETSM ERRRES	;MACRO OR PSEUDO
	JRST EQL1B	;SYM
	JRST EQL1C	;LOCAL UNDEF
	TLO C,3MULTI
	TLO C,3MULTI
	TLO C,3MULTI
	TLO C,3MULTI	;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR.
	JRST EQL1D	;GLOBAL ENTRY
	JRST EQL1E	;GLO EXIT
;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL

GCOL1:	IFN CREFSW,XCT CRFLBL	;DEFINING ORDINARY SYM.
	SKIPGE CONTRL
	 ETASM [ASCIZ /Virtual label in abs assembly/]
	PUSHJ P,ESDCHK	;FIND ITS SLOT IN ST
	 JRST EQL2	;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES.
	MOVEI T,(C)
	CAIE T,(TM)
	 JRST COLON5
	XCT GCOL1T(A)	;FOUND IN DESIRED BLOCK, REDEFINING.
	JRST EQL2

COLON5:	JUMPN T,EQG2	;SHADOWING, OK UNLESS INITIAL SYM.
	ETSM ERRRES
	JRST EQG2

GCOL1T:	TLO C,3MULTI	;COMMON
	ETSM ERRRES	;PSEUDO.
	JRST EQL2	;SYM.
	JRST EQGUL	;LOCAL UNDEF.
	TLO C,3MULTI	;VAR
	TLO C,3MULTI
	TLO C,3MULTI
	TLO C,3MULTI
	JRST EQL7	;DEF GLO
	JRST EQL8	;UNDEF GLO.


		;PUNCH OUT "DEFINE SYM AS $."

PDEFPT:	MOVEI A,CDEFPT
	PUSHJ P,P7X	;OUTPUT 7 THEN PDEFPT
	JRST OUTSM0	;OUTPUT SYM, WITHOUT BITS
;LOC, BLOCK, .=

ALOC:	PUSHJ P,ALOCRG	;LOC, GET ARG
ALOC1:	SETZM SYLOC	;CLEAR OUT LOC OF LAST TAG
	SETZM SYSYM	;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS
IFN FASLP,[
	SKIPGE TM,CONTRL
	 TRNN TM,FASL
	  JRST .+2
	ETA [ASCIZ /LOC illegal in FASL assembly/]
]	
	TRZE LINK,400	;GLOBALS IN ARG?
	 JRST ALOC2	;YES
	HRRZM A,CLOC	;STORE NEW ABSOLUTE PART OF CURRENT LOCATION
	CALL SLOCF	;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF.
	MOVEI A,LCEGLO	;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION)
	TLZE LINK,400000	;IS CURRENT LOCATION NOW GLOBAL?
	 PUSHJ P,PLDCM	;YES, RESET IT
	MOVE B,WRDRLC	;GET BACK NEW RELOCATION
ALOC2B:	TRZE B,-2	;NO BITS ALLOWED EXCEPT LOW ORDER
	 ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*]
	HRRZM B,CRLOC	;STORE NEW RELOCATION
	SKIPGE CONTRL
	 JRST ASSEM1	;DON'T BOTHER WITH REST IF ABS.
	MOVEI B,2(B)	;LABS OR LREL
	DPB B,[310700,,BKBUF]	;STORE NEW BLOCK TYPE
	MOVEM B,CDATBC	;ALSO STORE AS NORMAL BLOCK TYPE
AOFSTX:	TDNN LINK,[SETZ(SETZ)]	;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET
	 TRZA FF,FRGLOL	;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG
	  TRO FF,FRGLOL	;GLOBAL, SET FLAG
	TRZ LINK,600	;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP
	MOVEM LINK,GLOCTP	;STORE BACK STATUS FLAGS
	JRST ASSEM1

PTEQ:	MOVE SYM,[SQUOZE 0,LOC]
	PUSHJ P,ALOCRG	;.=, GET ARG
	MOVE T,[MINF+HFWDF,,$O.H]	;GLOTB ENTRY IF .+1 DOESN'T SKIP
	TRNE LINK,400000	;OFFSET GLOBAL?
	 JRST PTEQ2	;YES, WANT TO DO LOC ARG-$O."
	PUSHJ P,SBWDOF	;OFFSET IS LOCAL, SUBTRACT FROM ARG
	JRST ALOC1
ABLOCK:	PUSHJ P,ABLKRG	;GET ARG TO "BLOCK" PSEUDOOP.
	TRNE LINK,400	;GLOBALS IN ARG?
	 JRST ABLKG	;GLOBALS IN ARG
	TLNE LINK,400000
	 JRST ABLKG	;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL
IFN FASLP,[
	MOVE D,CONTRL
	TRNN D,FASL	;IN FASL FORMAT, CAN'T SET LOC. CTR.,
	 JRST ABLKF1
	SKIPE B
	 ETA [ASCIZ /BLOCK size relocatable/]
	JUMPGE FF,ABLKF1
	CALL ABLKF	;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS.
	JRST ABLKF1

;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1.  DOESN'T SET THE LOCATION COUNTER.
ABLKF:	JUMPE A,CPOPJ
	JUMPGE FF,CPOPJ
	SETZM WRD
	SETZM WRDRLC
	PUSH P,A
	PUSH P,A
ABLKF2:	CALL FASPW
	MOVEMM GLSP2,GLSP1
	SOSE (P)
	 JRST ABLKF2
	JRST POPBAJ
]

ABLKF1:	JUMPL A,[ETA [ASCIZ /BLOCK size negative/]]
	ADD A,CLOC	;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC
	ADD B,CRLOC	;ALSO ADD RELOCATIONS
	HRRZM A,CLOC	;STORE NEW ABSOLUTE PART OF LOCATION
	CALL SLOCF	;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET
	JRST ALOC2B


SBWDOF:	SUB A,OFLOC	;SUBTRACT OFFSET FROM WRD, ETC. IN A,B
	HRRZM A,WRD	;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S
	SUB B,OFRLOC	;NOW DO RELOCATIONS
	HRRZM B,WRDRLC
	POPJ P,

ABLKG:	TRNE LINK,400000	;GLOBAL BLOCK, IS OFFSET GLOBAL?
	 JRST ABLKG2	;YES, OK TO REFERENCE $L.
	PUSHJ P,SBWDOF	;NO, FOR COMPATIBILITY, DON'T REFERENCE $L.
	SKIPA T,[HFWDF,,$.H]
ABLKG2:	 MOVE T,[HFWDF,,$L.H]
PTEQ2:	AOS GLSP1	;STORE T IN GLOTB
	MOVEM T,@GLSP1
ALOC2:	TLO LINK,400000	;SET GLOBAL LOCATION FLAG
	MOVEI A,LCGLO	;=> GLOBAL LOCATION ASSIGNMENT
	PUSHJ P,PLDCM	;PUNCH OUT GLOBAL LOCATION ASSIGNMENT
	SETZM CLOC	;CLEAR OUT CLOC, NEW RELOCATION NOW
	SETZB B,BKBUF	;ALSO CLEAR OUT HEADER, JUST TO BE SURE
	AOJA B,ALOC2B	;SET RELOCATION TO 1 AND FALL IN

AOFFSET:	PUSHJ P,AOFFS2	;OFFSET, GET ARG
	MOVE A,T
	MOVEM A,WRD	;RESTORE UNTRUNCATED ARG.
	TRZE LINK,400	;GLOBALS IN ARG?
	 TROA LINK,400000	;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG
	  TRZ LINK,400000	;NO GLOBALS IN ARG
	MOVEM A,OFLOC	;STORE NEW OFFSET
	MOVEM B,OFRLOC	;ALSO STORE RELOCATION BITS
	SKIPGE CONTRL	;IN RELOCATABLE,
	 JRST AOFSTX
	MOVEI A,LDOFS	;LOADER OFFSET LOADER COMMAND TYPE
	PUSHJ P,PLDCM	;PUNCH OUT LOADER COMMAND
	JRST AOFSTX
;GET ARG TO LOC, BLOCK, .=, OFFSET

ALOCRG:
ABLKRG:	MOVE A,CLOC
	SKIPN CRLOC
	 JRST [	CAML A,DECBRA	;IF ADDR BEFORE THE LOC WAS ABS,
		 MOVEM A,DECBRA	;UPDATE HIGHEST ABS ADDR IF NEC.
		JRST ABLKR1]
	CAML A,DECTWO		;IT WAS RELOCA; UPDATE HIGHEST
	 JRST [	CAML A,DECBRH	;ADDR OF APPROPRIATE SEG.
		 MOVEM A,DECBRH
		JRST ABLKR1]
	CAML A,DECBRK
	 MOVEM A,DECBRK
AOFFS2:
ABLKR1:	PUSH P,SYM
	PUSHJ P,CONBAD	;ERROR IF IN GROUPING
	REST SYM
	TRNE I,IRNOEQ\IRPSUD\IREQL
	 ETSM [ASCIZ /Inside pseudo or =/]
	TDNE I,[ILWORD,,IRFLD]
	 ETSM ERRNVL
	PUSHJ P,EBLK	;MAYBE END CURRENT OUTPUT BLOCK
	PUSHJ P,AGETWD	;GET ARG
	MOVE LINK,GLOCTP	;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE
	MOVE T,GLSP2
	CAME T,GLSP1
	 TROA LINK,400	;SIGNAL GLOBAL ARG
	  TRZ LINK,400	;LOCAL
	MOVE T,A	;SAVE UNTRUNCATED FOR AOFFSET,
	HRRZS A,WRD	;TRUNCATE FOR LOC, BLOCK, .=.
	TRNN I,IRDEF	;ALL DEFINED?
	 JRST ASSEM1
	SKIPGE CONTRL	;YES, RETURN SKIPPING OVER ARG
	 TRNN LINK,400
	  RET
	MOVE SYM,GTVER
	ETASM [ASCIZ *Argument has externals*]
;;CONSTANTS AND VARIABLES
		;VARIABLES AREA
VBLK

LCNGLO==CONMIN/4
LCONTB==CONMIN

BLCODE [
PCNTB:	BLOCK NCONS*3	;CONSTANTS AREAS TABLE
VARTAB:	BLOCK NVARS
]
CONTBA:	CONTAB	;ADDRESS OF BEGINNING OF CONSTANTS TABLE.
CONTBE:	CONTAB+LCONTB	;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE.
PLIM:	0	;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE.

CONGLA:	CONGLO	;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE.
CONGLE:	CONGLO+LCNGLO	;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE.
CONGOL:	0	;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE.

CONBIA:	CONBIT	;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE.

CONLEN:	CONMIN	;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES.
		;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES
		;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET
		;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA.

		;PCNTB STUFF

		;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL
CSQZ:	0		;SQUOZE COUNTER
		;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET)
		;THIRD WORD LH FLAGS

CGBAL==100000	;GLOBAL (INCLUDING OFFSET)
CTRL==200000	;RELOCATED ( " )
CTDEF==400000	;DEFINED (MUST BE SIGN)

PBCON:	0	;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA
PBCONL:	0	;POINTER TO ABSOLUTE TOP OF PCNTB
CONCNT:	0	;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA)
CONDEP:	0	;DEPTH IN CONSTANTS (0 TOP LEVEL)
CONSAD:	0	;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST.
CONSML:	0	;VALUE OF .MLLIT INTSYM.
		;NEGATIVE => ERROR MODE (DEFAULT)
		;ZERO => OLD MODE.
		;POSITIVE => NEW (MULTI-LINE) MODE.

CONSTP:	0	;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT.
CONSP1:	0

		;VARIABLES FOR VARIABLES CODING

VARCNT:	0	;NO OF VAR IN CURRENT VAR AREA SO FAR
VARPNT:	0	;POINTER TO CURRENT PLACE IN VARTAB
VARCNR:	0	;NO OF TIMES VARIABLES MAY APPEAR
VCLOC:	0	;TEM FOR VARIAB
VECSIZ:	0	;DEFAULT SIZE FOR .VECTOR.

PBLK
;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD
;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS.
;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS
;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT.
;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS
;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM.

LBRAK:	SKIPE LITSW
	 ETR [ASCIZ /Literal/]
	TRO I,IRFLD	;LEFT BRACKET
	JSP LINK,SAVWD1	;SAVE CRUFT
	PUSH P,SCNDEP	;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT.
	JSP LINK,SAVAS1
	MOVEIM ASMOUT,3
	SETZM SCNDEP	;NOT WITHIN CONDITIONALS IN THIS LITERAL.
	AOS CONDEP	;ONE DEEPER IN LITERALS.
	JRST ASSEM3	;GO ASSEMBLE THE WORDS OF THE CONSTANT.

;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE.
PCONS:	SKIPL CONTRL	;IF RELOCATABLE,
	 PUSHJ P,$RSET	;HANDLE STRANGE RELOCATIONS.
	MOVE B,GLSP1
	SUB B,GLSP2	;NUM. GLOBAL ENTRIES FOR THIS WD.
	HLRZ A,WRDRLC	;ONLY 1.1 AND 3.1 BITS MATTER.
	LSH A,1
	IOR A,WRDRLC	;GET THEM INTO 1.1, 1.2 BITS.
	TLNE I,ILNOPT	;REMEMBER ILNOPT ALSO.
	 IORI A,4
	DPB B,[032200,,A]	;AND # GLBLS.
	PUSH P,A	;SAVE THEM ALL.
	HRLI B,(B)	;GET # GLBLS,,# GLBLS .
	JUMPE B,PCONS1
	MOVE A,GLSP2
	MOVSI A,1(A)
	HRRI A,1(P)	;SAVE THE GLBLS, IF ANY.
	ADD P,B
	JUMPGE P,CONFLP
	BLT A,(P)
PCONS1:	PUSH P,WRD
	MOVEM P,ASSEMP	;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW.
	JRST (T)
;JSP LINK,SAVAS1  TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1
;LOOP RECURSIVELY.
.SEE CONNDP	;WHICH IS WHERE THESE THINGS ARE POPPED.
SAVAS1:	SKIPN BYTM	;IF IN BYTM NOW (WILL PUSH AND TURN OFF)
	 JRST LBRAK1
	MOVSI A,BYBYT	;SAVE ALL THE DETAILS.
	HRRI A,1(P)
	ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
	JUMPGE P,CONFLP	;(SOFTWARE-DETECTED PDL-OV)
	BLT A,-BYTMCL(P)
	MOVSI A,BYTMC
	HRRI A,1-BYTMCL(P)
	BLT A,(P)
LBRAK1:	PUSH P,BYTM
	SETZM BYTM
	PUSH P,ASMOUT
	PUSH P,ASMDSP
	PUSH P,ASMI
	PUSH P,GLSPAS	;SAVE ASSEM1 PDL LEVELS.
	PUSH P,ASSEMP
	PUSH P,CONSTP
	MOVE A,I
	ANDI A,IRPSUD+IREQL
	IORI A,IRDEF
	MOVEM A,ASMI	;ASMI IOR'D INTO I AT ASSEM2 LOOP.
	HRRZ A,CPGN
	HRL A,CLNN	;REMEMBER WHERE THIS LITERAL STARTS.
	INSIRP PUSH P,[A SYSYM SYLOC]
	MOVEM P,ASSEMP	;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED.
	MOVEM P,CONSTP	;SO CONND CAN FIND 1ST WD OF CONSTANT.
	MOVEMM GLSPAS,GLSP1
SAVAS2:	MOVEI A,ASSEM3	;IF NOT MULTI-LINE MODE, ARRANGE TO
	SKIPG CONSML	;END THE CONSTANT AFTER 1 WORD.
	 MOVEI A,ASSEMC
	MOVEM A,ASMDSP
	JRST (LINK)
PCONST:	MOVE CH1,ASMDSP	;OUTPUT TO CONST. FROM ASSEM1
	CAIN CH1,CONND	;LAST WD OF CONST?
	 CAME P,CONSTP	;1ST WD?
	  JRST PCONS	;NO, DO THE GENERAL THING.
	SKIPL CONTRL	;THIS MUST BE ONLY WORD OF CONST,
	 PUSHJ P,$RSET	;DON'T BOTHER PUSHING, END CONST. NOW.
	PUSH P,CONSTP
	TLZ I,ILMWRD+ILMWR1	;THIS IS 1ST WD, NO MORE WDS.
	JRST CONND3	;PRETEND JUST POPPED IT.

;COME HERE FROM ASSEM1 TO END A CONSTANT.
CONND:	SKIPE BYTM	;IF IN BYTE MODE, LEAVE IT AND DO .WALGN
	 JRST A.BY3	;(WILL COME BACK SINCE ASMDSP STILL SET)
CONNDW:	MOVEMM CONSP1,CONSTP
	TLZ I,ILMWR1	;THIS IS 1ST WORD COMING UP.
CONND0:	TLZ I,ILMWRD+ILNOPT
	SETZM WRDRLC
	MOVE F,CONSP1	;ADDR IN IN PDL OF NEXT WD.
	CAMN F,ASSEMP
	 JRST CONND2	;J IF NO WORDS.
	MOVE A,1(F)	;GET SAVED NUM GLBLS,,NUM GLBLS
	DPB A,[100,,WRDRLC]
	LSH A,-1	;RESTORE WRDRLC BITS 1.1, 3.1
	DPB A,[220100,,WRDRLC]
	TRNE A,2
	TLO I,ILNOPT	;RESTORE NOOPTF.
	LSH A,-2	;GET # GLBLS.
	HRLI A,(A)	;# GLBLS,,# GLBLS.
	AOBJN F,.+1
	HRRZM F,GLSP2	;ADDR BEFORE 1ST GLOBAL ENTRY.
	ADD F,A
	HRRZM F,GLSP1	;ADDR OF LAST GLOBAL ENTRY.
	MOVE A,1(F)
	MOVEM A,WRD
	AOBJN F,.+1	;POINT TO NEXT CONST WD IF ANY,
	MOVEM F,CONSP1
	CAME F,ASSEMP	;IF MORE WORDS SET ILMWRD
	 TLO I,ILMWRD
	JRST CONND3

CONND2:	INSIRP SETZM,[WRD,GLSP1,GLSP2]
CONND3:	MOVE F,GLSP1
	SUB F,GLSP2
	JUMPE F,SCON	;JUMP IF NOTHING VIRTUAL
	MOVEI B,-1(F)
	MOVN TT,B
	JUMPE B,SCON	;JUMP IF ONLY ONE GLOBAL
		;SORT GLOTB ENTRIES THIS CONSTANT
LSORT:	HRL T,TT	;SET UP AOBJN POINTER TO GLOBALS REMAINING
	HRR T,GLSP2
LSORT2:	MOVE A,1(T)
	CAMLE A,2(T)
	 EXCH A,2(T)	;INTERCHANGE
	MOVEM A,1(T)
	AOBJN T,LSORT2	;INNER LOOP POINT
	SOJG B,LSORT	;OUTER LOOP
		;DROPS THROUGH
;DROPS THROUGH
SCON:	PUSHJ P,RCHKT
	PUSHJ P,RMOVET	;SET UP RELOACTION BITS.
	ROT T,2		;ROTATE TO BOTTOM TWO BITS OF T
	TLNE I,ILMWRD+ILMWR1+ILNOPT
	 JRST NOCON	;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH
	MOVE A,CONTBA
SCON1:	CAML A,PLIM	;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE
	 JRST NOCON	;END OF TABLE, NO MATCH
	MOVE B,WRD
	CAME B,(A)
SCON2:	 AOJA A,SCON1	;VAL DISAGREES
	PUSHJ P,CPTMK	;GET BP TO CONSTANTS-BIT TABLE IN C
	LDB F,C		;GET RELOCATION BITS THIS CONSTANT
	CAME F,T
	 JRST SCON2	;RLC DIFFRS
	MOVE B,CONGLA	;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS
	SKIPA C,GLSP2
SCON2B:	 AOS B		;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR
	CAML B,CONGOL
	 JRST SCON3	;GLOBALS MATCH SO FAR
	CAME A,1(B)	;SKIP IF ONE FOUND
SCON7:	 AOJA B,SCON2B	;NOT YET
	MOVE D,(B)	;FOUND ONE, GET GLOTB ENTRY
	CAME D,1(C)	;COMPARE WITH THIS ENTRY IN GLOTB
	 JRST SCON2	;NO MATCH, FLUSH THIS CONSTANT
	AOJA C,SCON7	;MATCH, TRY NEXT GLOBAL

SCON3:	CAME C,GLSP1	;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB?
	 JRST SCON2	;NO, BACK TO SEARCH
	JRST NOCON4
NOCON:	AOS A,PLIM	;CONSTANT NOT ALREADY IN TABLE
	CAMLE A,CONTBE
	 ETF [ASCIZ/Literal table full/]
	MOVE AA,WRD
	MOVEM AA,-1(A)
	SOS A
	PUSHJ P,CPTMK
	TLNE I,ILNOPT
	 TRO T,4		;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME
	DPB T,C
	MOVE B,GLSP2
NOCON3:	CAML B,GLSP1
	 JRST NOCON4
	SKIPN C,1(B)
	 AOJA B,NOCON3	;THIS ENTRY NOT REALLY HERE
	MOVEM C,@CONGOL
	HRRZS C
	PUSHJ P,NOCON5
	MOVEM A,@CONGOL
	PUSHJ P,NOCON5
	SKPST C,	;SKIP IF IN SYMBOL TABLE
	 AOJA B,NOCON3
	3GET1 D,C	;IN SYMBOL TABLE
	TLO D,3VCNT	;THIS SYM USED IN CONSTANT
	3PUT1 D,C	;UPDATE 3RDWRD TABLE ENTRY
	AOJA B,NOCON3

NOCON5:	AOS AA,CONGOL
	CAML AA,CONGLE
	 ETF [ASCIZ/Constants-global table full/]
	POPJ P,

		;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE
		;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY
		;LEAVES ANSWER IN C
		;BITS IN CONSTANTS-BIT TABLE PER ENTRY:
			;1.2, 1.1 RELOCATION BITS
			;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME

CPTMK:	PUSH P,A
	SUB A,CONTBA
	PUSH P,B
	IDIVI A,12.
	MOVEI C,(A)
	ADD C,CONBIA	;SET UP ADDRESS PART
	IMULI B,3
	DPB B,[360600,,C]	;STORE POSITION FIELD FROM REMAINDER
	TLO C,200	;SET UP SIZE FIELD
POPBAJ:	POP P,B
	JRST POPAJ
NOCON4:	TLON I,ILMWR1
	 MOVEM A,CONSAD	;IF 1ST WD SAVE ADDR.
	TLNE I,ILMWRD	;IF MORE WORDS, HANDLE NEXT.
	 JRST CONND0
	MOVE P,CONSTP	;VALUE OF CONSTP AT CONND.
	MOVE C,GLSPAS	;TO RESTORE GLSP1
	JSP T,CONNDP	;POP STUFF.
	HRRZ A,CONSAD	;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD.
	MOVE B,PBCON	;ADDR OF WDS DESCRIBING CONST. AREA.
	SKIPL 2(B)	;CONST. AREA LOCATION DEFINITE?
	 AOJA C,CONND6	;NO, USE GLOBAL.
	MOVEM C,GLSP1
	HRRZ C,1(B)	;ADD ACTUAL ADDR OF CONST. AREA.
	ADDI A,(C)	;GET C(CONTBA) + ADDR OF CONSTANT.
	LDB B,[420100,,2(B)]
	JRST CONND7

CONND6:	MOVEM C,GLSP1
	MOVEM B,(C)
	MOVEI B,0
CONND7:	SUB A,CONTBA
	JRST LSSTH3	;POP OUT INTO OUTER WORD.

.SEE SAVAS1	;WHICH IS WHAT PUSHES WHAT CONNDP POPS.
CONNDP:	SUB P,[3,,3]	;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN.
CONFL2:	HRL T,ASMOUT	;REMEMBER IF POPPING A LITERAL OR NOT.
	INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM]
	SKIPN BYTM	;IF IN BYTE MODE, POP DETAILS.
	 JRST CONND5
	MOVSI A,1-BYTMCL(P)
	HRRI A,BYTMC
	BLT A,BYTMC+BYTMCL-1
	MOVSI A,1-BYTMCL-LBYBYT(P)
	HRRI A,BYBYT
	BLT A,BYBYT+LBYBYT-1
	SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
CONND5:	HLRZ A,T
	CAIE A,3
	 JRST (T)
	POP P,A
	ADDM A,SCNDEP	;DON'T FORGET ABOUT ANY CONDITIONALS.
	SOS CONDEP	;HAVE POPPED ONE CONSTANT.
	JRST (T)

CONFLS:	MOVE P,ASSEMP	;FLUSH ALL CONSTANTS.
	CAMN P,[-LPDL,,PDL] ;IF IN ANY,
	 JRST (LINK)
	MOVE P,CONSTP	;POINT AFTER ITS PDL ENTRY,
	JSP T,CONNDP	;POP IT,
	JRST CONFLS	;TRY AGAIN.

CONBAD:	SKIPN ASMOUT	;IF IN GROUPING, ERROR.
	POPJ P,
	ETSM [ASCIZ/Within <>, () or []/]
	JRST ASSEM1
;COME HERE FOR PDL-OV ON P.
;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED.
;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1.
;OTHERWISE FATAL ERROR.
CONFLP:	MOVEI LINK,ASSEM1
	MOVEI CH1,ERRPDL
	SKIPE CONDEP
	 JRST CONFL3	;IN A CONSTANT.
	MOVEI P,PDL	;RE-INIT PDL SO NO MORE PDL-OV.
	ETF ERRPDL
ERRPDL:	ASCIZ /PDL overflow/

;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED,
;AND GIVE ERROR MSG.
CONFLM:	MOVE CH1,ASMOUT
	SKIPA CH1,ASMOT3(CH1)
CONFLZ:	 SETZ CH1,	;LIKE CONFLM BUT NO ERR MSG AT END.
CONFL3:	SETO C,
CONFL1:	MOVE P,CONSTP	;GET STACK ABOVE INNERMOST LITERAL.
	REST SYLOC
	REST SYSYM
	REST D		;GET INFO ON WHERE STARTED
	AOSN C		;THE 1ST TIME ONLY, SAY WHAT'S GOING ON.
	 TYPR [ASCIZ/Within groupings: /]
	SKIPE C
	 TYPR [ASCIZ/, /]
	MOVE A,ASMOUT	;SAY WHAT KIND OF GROUPING IS BEING CLOSED
	MOVE A,ASMOT5(A)
	CALL TYOERR	;BY SAYING WHAT CHAR OPENED IT.
	JSP T,CONFL2	;POP REST OF WDS SAVED AT LBRAK.
	TYPR [ASCIZ/ at /]
	MOVEI A,1(D)	;PAGE # GROUPING STARTED ON.
	CALL DPNT	;PRINT IN DECIMAL.
	MOVEI A,"-
	CALL TYOERR
	HLRZ A,D	;LINE NUMBER IT STARTED ON.
	ADDI A,1
	CALL D3PNT2	;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR.
	MOVE A,ASSEMP
	CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO.
	 JRST CONFL1
	CALL CRRERR
	MOVE P,ASSEMP
	JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE)
	ETR (CH1)	;[   NO] OR PDL.
	CALL CRRERR
	JRST (LINK)
;CONSTA

CNSTNT:	NOVAL
	SKIPE ASMOUT	;IF ANY GROUPNGS,
	 JSP LINK,CONFLM	;FLUSH THEM, GIVE ERROR.
	PUSHJ P,CNSTN0
	JRST ASSEM1

CNSTN0:	SOSGE CONCNT	;ENTRY FROM AEND
	 ETF [ASCIZ /Too many constants areas/]
	MOVE B,CLOC
	ADD B,OFLOC
	HRRZ T,PBCON
	TRNN FF,FRPSS2
	 JRST CNST1	;PASS 1

	MOVSI A,CGBAL
	TDZ A,2(T)
	TRNE FF,FRGLOL
	 TLC A,CGBAL
	SKIPN A
	 ETR [ASCIZ /Constants globality phase error/]
	HRRZ B,1(T)
	SUB B,OFLOC
	HRRZS B
	CAME B,CLOC
	 ETR [ASCIZ /Constants location phase error/]
	MOVE B,2(T)
	ROT B,2
	XOR B,CRLOC
	XOR B,OFRLOC
	TRNE B,1
	 ETR [ASCIZ /Constants relocation phase error/]
		;DROPS THROUGH
;DROPS THROUGH
CNST2:	MOVEI D,(T)	;STE IDX IN D FOR OUTSM0
	MOVE SYM,(T)	;GET NAME OF AREA
	TLC SYM,400000#LCUDF	;CLEAR LCUDF, SET HALF-KILL
	TRNE FF,FRGLOL
	 PUSHJ P,PDEFPT	;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA
	MOVE A,CONTBA
CNSTH:	CAML A,PLIM
	 JRST CNSTA	;THRU
	MOVE TT,(A)
	MOVEM TT,WRD
	PUSHJ P,CPTMK
	LDB F,C		;GET THIS CONSTANT'S RELOCATION BITS
	TRZE F,2
	 TLO F,1	;RELOCATE LEFT HALF
	MOVEM F,WRDRLC	;STORE RELOCATION
	MOVEI D,GLOTB	;AND NOW TO SET UP GLOTB!
	MOVEM D,GLSP2
	MOVE C,CONGLA
CNSTC:	CAML C,CONGOL
	 JRST CNSTB	;END OF CONSTANT-GLOBAL TABLE
	CAMN A,1(C)	;POINTS TO THIS CONSTANT?
	 PUSH D,(C)	;YES, STORE ENTRY IN GLOTB
	AOS C
	AOJA C,CNSTC

CNSTB:	HRRZM D,GLSP1	;MARK END OF ACTIVE PART OF GLOTB
	PUSH P,A
	PUSHJ P,PWRD	;OUTPUT THIS CONSTANT
	AOS CLOC	;INCREMENT CLOC TO NEXT
	HRRZS CLOC	;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION)
	POP P,A		;RESTORE POINTER INTO CONSTANTS TABLE
	AOJA A,CNSTH

CNST3:	HLRZ A,1(T)	;GET POINTER TO TOP OF AREA STORED DURING PASS 1
	CAMN A,CLOC	;SAME AS CURRENT?
	 JRST CNSTE	;YES, NO HAIR
	CAMGE A,CLOC	;DIFFERENT; LOWER?
	 ETR [ASCIZ /More constants on pass 2 than 1/]
		;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER
		;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER
	MOVEM A,CLOC	;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE
	PUSHJ P,EBLK	;END CURRENT BLOCK
	CALL SLOCF	;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED
	JRST CNSTE

;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD.
SLOCF:	MOVE A,CLOC	;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT.
	SKIPGE TM,CONTRL
	 TRNN TM,DECREL+FASL	;BUT NOT IN DEC OR FASL OUTPUT FORMATS.
	  HRRM A,BKBUF
	IORI FF,FRLOC	;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED.
	RET
;CONSTA DURING PASS 1

CNST1:	HRRM B,1(T)	;STORE LOCATION OF AREA
	MOVEI D,0
	MOVE A,CRLOC
	ADD A,OFRLOC
	TRNE A,1
	 TLO D,CTRL	;RELOCATED
	TRNE FF,FRGLOL
	 TLO D,CGBAL	;GLOBAL
	IORM D,2(T)	;STORE FLAGS DESCRIBING AREA
	JUMPL FF,CNST2	;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW
	MOVE T,PLIM
	SUB T,CONTBA
	ADDM T,CLOC	;PASS 1, JUST UPDATE CLOC
	HRRZS CLOC

CNSTA:	HRRZ T,PBCON
	TRNE FF,FRGLOL
	 JRST CNSTD	;LOCATION GLOBAL
	TRNN FF,FRNPSS
	 SKIPGE 2(T)
	  JRST CNSTDA	;2 PASS ASSEMBLY OR AREA DEFINED
	TRO I,IRCONT	;1PASS AND NOT DEFINED
	SETZM PARBIT
	PUSHJ P,P70	;DEFINE SYM
	MOVE A,(T)
	TLC A,400000#LCUDF
	SKIPE CRLOC
	TLO A,100000	;RELOCATE
	PUSHJ P,$OUTPT
	HRRZ A,1(T)
	PUSHJ P,$OUTPT	;OUTPUT VALUE, FIRST LOCATION IN AREA
	TRZ I,IRCONT
CNSTDA:	MOVSI A,CTDEF
	IORM A,2(T)	;CALL IT DEFINED
CNSTD:	TRNE FF,FRPSS2
	 JRST CNST3	;PASS 2
	MOVE A,CLOC
	HRLM A,1(T)	;MARK END OF AREA

CNSTE:	MOVE A,CONTBA
	MOVEM A,PLIM
	MOVE A,CONGLA
	MOVEM A,CONGOL
	MOVEI T,3
	ADDB T,PBCON
	CAML T,PBCONL
	 MOVEM T,PBCONL
	AOS A,CSQZ
	MOVEM A,(T)
	POPJ P,
;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE

CONBUG:	MOVE A,CONGLA	;B VAL C FLAGS ST(D) SADR
	PUSH P,T
	PUSH P,C	;SAVE FLAGS
CONBG2:	MOVE C,(P)	;GET FLAGS
	CAML A,CONGOL	;DONE WITH SCAN?
	 JRST CONBG1	;YES
	HRRZ F,(A)	;NO, GET CONSTANT-GLOBAL TABLE ENTRY
	CAIE F,ST(D)	;POINT TO THIS SYM?
	 AOJA A,CONBG6
	PUSH P,B	;YES, SAVE VALUE, ABOUT TO WORK WITH B
	MOVE T,(A)	;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY
	LDB CH2,[221200,,T]	;GET MULTIPLICATION FIELD
	SKIPE CH2
	 IMUL B,CH2	;NON-ZERO => MULTIPLY VALUE OF SYM
	TLNE T,MINF
	 MOVNS B	;NEGATE VALUE
	TLNE T,HFWDF
	 HRRZS B	;TRUNCATE TO HALFWORD
	TLNE T,ACF
	 ANDI B,17	;AC, MASK TO FOUR BITS
	TLNE T,SWAPF
	 MOVSS B	;SWAP VALUE
	TLNE T,ACF
	 LSH B,5	;AC, SHIFT FIVE
	ADD B,@1(A)	;ADD ABS PART OF VALUE
	TLNN T,SWAPF
	 HRRM B,@1(A)	;NOT SWAPPED, STORE LH
	TLNE T,SWAPF
	 HLLM B,@1(A)	;SWAPPED, STORE LH
	TLNN T,HFWDF
	 MOVEM B,@1(A)	;FULL WORD, STORE VALUE
	LDB CH1,[420200+P,,-1]	;GET HIGH BITS OF 3RDWRD, RELOCATION BITS
	TLNE T,HFWDF	;NOW TO MAP RELOCATION BITS
	 TRZ CH1,2
	TLNE T,SWAPF
	 LSH CH1,1
	TRZE CH1,4
	 TRO CH1,1
	PUSH P,A
	HRRZ A,1(A)	;GET POINTER INTO CONSTANTS TABLE
	PUSHJ P,CPTMK
	LDB B,C		;GET RELOCATION BITS
	TLNE T,MINF
	 JRST CONBG8	;NEGATE
	TRNE B,(CH1)
	 ETA ERRCRI
		;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT
		; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE
		;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE
	IOR B,CH1	;LOOKS OK, IOR IN BITS FOR GLOBAL
CONB8A:	DPB B,C		;STORE BACK NEW RELOCATION BITS FOR CONSTANT
	POP P,A
	CLEARM (A)	;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY
	CLEARM 1(A)
	POP P,B
	AOS A
CONBG6:	AOJA A,CONBG2	;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN
CONBG1:	MOVE A,CONGLA
	PUSH P,B
	MOVE B,CONGLA
CONBG7:	CAML A,CONGOL
	 JRST CONBG3
	SKIPN C,(A)
CONBG5:	 AOJA A,CONBG4
	MOVEM C,(B)
	MOVE C,1(A)
	MOVEM C,1(B)
	AOS B
	AOJA B,CONBG5

CONBG4:	AOJA A,CONBG7
CONBG3:	MOVEM B,CONGOL
	POP P,B
	POP P,C
	POP P,T
	POPJ P,
CONBG8:	XORI B,3
	TRNE B,(CH1)
	 ETA ERRCRI
	ANDCB B,CH1
	JRST CONB8A

ERRCRI:	ASCIZ /Multiple relocation in constant/
;VARIAB

AVARIAB:	NOVAL
	SKIPE ASMOUT	;FLUSH ANY GROUPINGS IN PROGRESS.
	 JSP LINK,CONFLM
	PUSHJ P,AVARI0
	JRST ASSEM1

AVARI0:	SOSG VARCNR	;ENTRY FROM AEND
	 ETF [ASCIZ /Too many variable areas/]
	MOVE D,SYMAOB	;SET UP AOBJN POINTER TO ST
	MOVE T,CLOC
	MOVEM T,VCLOC	;STORE AS LOCATION OF VARIABLE AREA
	ADD T,OFLOC
	MOVE C,CRLOC
	ADD C,OFRLOC
	TRNE FF,FRPSS2
	 JRST AVAR1	;PASS 2
	HRL T,VARCNT	;SIZE OF AREA
	TRNE C,1
	TLO T,400000	;RELOCATED
	MOVEM T,@VARPNT
	JRST AVAR2E

AVAR1:	HRRZ A,@VARPNT	;VARIAB DURING PASS 2
	CAIE A,(T)
	 ETR [ASCIZ /Variables location phase error/]
	HLRZ A,@VARPNT
	TRZE A,400000
	XORI C,1
	TRNE C,1
	 ETR [ASCIZ /Variables relocation phase error/]
	SKIPE VARCNT
	 ETR [ASCIZ /Variables area size phase error/]

AVAR2E:	HLRZ T,@VARPNT
	TRNN T,377777
	 JRST AVAR2C	;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB.
AVAR2:	HLRZ LINK,ST(D)	;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE
	CAIL LINK,DEFLVR
	 JRST AVAR2B
	ADD D,WPSTE1
	AOBJN D,AVAR2
	JRST AVAR2C	;ALL SCANNED.

AVAR2B:	3GET C,D	;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT.
	MOVE B,ST+1(D)
	MOVE SYM,ST(D)
	TLZ SYM,740000
	LDB LINK,[400400,,ST(D)]
	CAIE LINK,UDEFLV_-14.
	 CAIN LINK,UDEFGV_-14.
	  JRST AVAR3		;UNDEFINED VARIABLE
	CAIE LINK,DEFGVR_-14.
	 CAIN LINK,DEFLVR_-14.
	  JRST AVAR4		;DEFINED VARIABLE
AVAR2A:	ADD D,WPSTE1
	AOBJN D,AVAR2	;CHECK ENTIRE SYMTAB
AVAR2C:	HLRZ A,@VARPNT	;NOW GET SIZE OF AREA
	TRZ A,400000	;CLEAR OUT RELOCATION CHECK BIT
IFN FASLP,[
	MOVE D,CONTRL
	TRNE D,FASL	;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S.
	 CALL ABLKF
]
	ADD A,VCLOC	;ADD LOCATION OF BEGINNING OF VARIABLE AREA
	MOVEM A,CLOC	;STORE AS NEW CURRENT LOCATION
	PUSHJ P,EBLK
	CALL SLOCF
	CLEARM VARCNT	;INITIALIZE COUNT OF VARIABLES IN NEXT AREA
	AOS VARPNT	;INCREMENT POINTER TO POINT TO NEXT AREA
	POPJ P,
;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN

AVAR3:	CAIN LINK,UDEFGV_-14.	;GLOBAL?
	TLO SYM,40000	;GLOBAL
	PUSHJ P,LKPNRO
	MOVSI T,DEFLVR
	CAIN LINK,UDEFGV_-14.
	MOVSI T,DEFGVR
	TRNE FF,FRGLOL
	 JRST AVAR3A	;LOCATION GLOBAL
	MOVEI B,-1(B)
	ADD B,VCLOC
	ADD B,OFLOC
	MOVE TT,CRLOC
	ADD TT,OFRLOC
	SKIPE TT
	 TLO C,3RLR
	CAIE LINK,UDEFGV_-14.
	TLZN C,3VCNT
	 SKIPA
	  PUSHJ P,CONBUG
AVAR4B:	PUSHJ P,VSM2
	JUMPGE FF,AVAR2A	;IF PUNCHING PASS, OUTPUT DEFINITION.
	PUSHJ P,OUTDE2
	JRST AVAR2A

AVAR4:	TLNE C,3VAS2	;DEFINED VARIABLE FOUND DURING SYMTAB SCAN
	 TLOE C,3VP
	  JRST AVAR2A
	MOVSI T,(LINK)	;CAUSE AVAR4B TO REDEFINE AS SAME TYPE.
	LSH T,14.
	TRNN FF,FRGLOL
	 JRST AVAR4A
AVAR3A:	PUSHJ P,VSM2LV
	JUMPGE FF,AVAR2A
	PUSHJ P,PDEFPT
	MOVEI A,0
	PUSHJ P,PBITS
	PUSHJ P,$OUTPT
	AOS CLOC
	JRST AVAR2A

AVAR4A:	CAIN LINK,DEFGVR_-14.	;DEF VAR, 3VAS2, POINT NOT GLOBAL.
	 JRST AVAR4B	;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1.
	3PUT C,D	;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB.
	JRST AVAR2A	;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1.
;;MAIN		;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS
		;ALL CALLED WITH JSP A,; ALL GLOBAL
		;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN
PS1:	HRRM A,RETURN	;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN
	PUSH P,[ASSEM1-1]	;SIMBLK WILL POPJ1.
IFN A1PSW,[SKIPL PRGC
	JRST A1PAS1	;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS
]
	TRO FF,FRNPSS
IFN ITSSW,JRST SIMBLK	;SELECT SBLK AND ASSEMBLE
IFN DECSW\TNXSW,JRST A.DECRE	;SELECT .DECREL AND ASSEMBLE.

PS2:	HRRM A,RETURN	;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN
	JUMPL FF,PA2A	;JUMP IF PASS 1 ENDED IN 1PASS MODE
	TDO FF,[FLPPSS,,FRPSS2]	;SET PUNCHING PASS AND PASS 2 FLAGS
	PUSHJ P,P2INI	;INITIALIZE
	JRST ASSEM1	;START ASSEMBLING

PA2A:	MOVE A,SYMAOB	;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS
PA2C:	MOVE SYM,ST(A)	;GET SQUOZE THIS SYMTAB ENTRY
	LDB B,[400400,,SYM]	;GET FLAGS
	CAIE B,LCUDF_-14.	;LOCAL UNDEFINED?
	 JRST PA2B	;NOT LOCAL UNDEFINED, DON'T COMPLAIN
	3GET C,A	;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY
	TLZ SYM,740000	;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT
	TLNN C,3LLV	;PROBLEM HANDED TO LINKING LOADER?
	 ETSM [ASCIZ /Undefined/] ;NO
PA2B:	ADD A,WPSTE1	;NOW GO FOR NEXT ST ENTRY
	AOBJN A,PA2C
	JRST RETURN

$INIT:	HRRM A,RETURN	;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT
IFN CREFSW,PUSHJ P,CRFOFF	;DON'T CREF ON 1ST PASS.
IFN LISTSW,CALL LSTOFF	;DON'T LIST ON 1ST PASS.
	SKIPGE ISYMF
	 JRST INIT1	;SPREAD SYMS (RETURNS TO SP4)
	MOVE A,SYMAOB	;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS
INIT4:	SKIPN B,ST(A)
	 JRST INIT2
	3GET C,A
	TRNE C,-1	;INITIAL SYM?
	 CLEARM ST(A)	;NO
INIT2:	ADD A,WPSTE1
	AOBJN A,INIT4
	SETZM BBKCOD
	MOVE A,[BBKCOD,,BBKCOD+1]
	BLT A,EBKCOD	;CLEAR OUT BLANK CODE

SP4:	PUSH P,CRETN
P1INI:	CLEARB I, LDCCC
	INSIRP SETZM,BKBUF ISYMF A.PASS
IFN FASLP,[
	INSIRP SETZM,FASATP FASPCH
	CLEARM FASIDX
]
	MOVEMM DECTWO,[[MOVE]]
	TDZ FF,[FFINIT]		;INITIALIZE MOST FF FLAGS
	MOVEIM A.PPASS,2	;DEFAULT IS 2-PASS.
	PUSHJ P,MACINI	;INITIALIZE MACRO STATUS
	MOVEI A,PCNTB
	MOVEM A,PBCONL
	MOVS A,[BKTAB,,P1INI1]
	BLT A,BKTAB+4
	MOVEIM BKTABP,BKWPB*2
;DROPS IN.
P2INI:	INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL
SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH]
	AOS B,A.PASS
IFN ITSSW,[
	CALL SETWH2		;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1.
	.SUSET [.SWHO3,,A]	;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM
	.SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]]
]
	TDZ FF,[FLUNRD,,FRGLOL]
IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI
NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ]
IFE 1&.IRPCN,IFSN [X], MOVEI A,X
IFN 1&.IRPCN, MOVEM A,X
TERMIN
	MOVE A,CONTBA
	MOVEM A,PLIM
	MOVE A,CONGLA
	MOVEM A,CONGOL
	CLEARM VARCNT
	CLEARM PBITS2
	MOVE A,[440300,,PBITS1]
	MOVEM A,BITP
	MOVEI A,PBITS4
	HRRZM A,PBITS4
	CLEARB I,PBITS1
	MOVEI A,PCNTB
	MOVEM A,PBCON
	MOVE A,[(LCUDF)+<SQUOZE 0,$ >+1]	;< AND > FOR COMPATIBILITY WITH OLD
	MOVEM A,PCNTB
	MOVEM A,CSQZ
	MOVEI A,8
	MOVEM A,ARADIX

IFN ITSSW,[
	MOVEI A,100
	MOVEM A,CLOC
]
.ELSE [
	SETZ A,		; SET LOC COUNTERS APPROPRIATELY
	SKIPGE B,CONTRL
	 TRNE B,DECREL+FASL
	  JRST [SETZM CLOC	; ASSUME RELOCATABLE
		AOS CRLOC	; CRLOC GETS 1
		JRST P2INI5]
	TRNE B,DECSAV	; ASSUME ABSOLUTE
	 MOVEI A,140
	TRNE B,SBLKS
	 MOVEI A,100	; IF SBLK FORMAT ASSUME FOR ITS.
	MOVEM A,CLOC
P2INI5:
]
	SETZM GLOCTP
	MOVEI A,BKBUF+1
	MOVEM A,OPT1
	MOVE A,CONTRL	;IN DEC FORMAT, OUTPUT PROGRAM NAME.
	TRNE A,DECREL
	 CALL DECPGN	;CLOBBERS A
IFN FASLP,[
	SETOM FASBLC	;LOSING BLOCK COUNT
	MOVE A,CONTRL	;IN FASL FORMAT, OUTPUT FASL HEADER
	TRNE A,FASL
	 CALL FASOIN	;INITIALIZE FASL OUTPUT
]
	SETZM DECBRH
	TRO FF,FRSYMS+FRFIRWD
	MOVE A,[IFORTB,,FORTAB]	;INITIALIZE FORMAT TABLE ON EACH PASS
	BLT A,FRTBE
	MOVEIM GLSPAS,GLOTB	;INIT. ASSEM1 PDL LEVELS TO BOTTOM.
	MOVEMM ASSEMP,[[-LPDL,,PDL]]
	MOVEIM ASMDSP,ASSEM3
	SETZM ASMOUT
	SETZM CONSTP
	SETZM SCNDEP	;NOT IN CONDIT. OR CONSTANT.
	SETZM CONDEP
	HRRZM P,CONSML	;START OUT IN MULTI-LINE MODE.
IFN LISTSW,[
	MOVE A,[440700,,LISTBF]
	MOVEM A,PNTBP
	CLEARM LISTPF
	SETOM LISTBC
	SKIPG LISTP1	;IF LIST ON PASS 1
	 JUMPGE FF,CRETN	;OR PUNCHING PASS,
	SKIPE LISTP	;IF WANT LISTING,
	 CALL LSTON	;TURN ON OUTPUT OF LISTING.
]
IFN CREFSW,[
	JUMPGE FF,CRETN
	SKIPE CREFP	;IF C SWITCH WAS SEEN,
	PUSHJ P,CRFON	;TURN ON CREFFING,
]
CRETN:	POPJ P,RETURN

P1INI1:	SQUOZE 0,.INIT ? 0 ? 3
	SQUOZE 0,.MAIN ? 1,,
PLOD:	HRRM A,RETURN	;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT
	PUSHJ P,PLOD1	;PUNCH LOADER
	JRST RETURN	;RETURN

		;PUNCH OUT THE LOADER

PLOD1:	PUSHJ P,FEED1	;LEAVE LOTS OF BLANK PAPER TAPE
	MOVE B,CONTRL
	TRNE B,ARIM10
	 JRST PLOD2	;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN
	TRNN B,SBLKS
	 POPJ P,		;NOT SBLK => DON'T PUNCH LOADER
PLOD1A:	MOVSI B,SLOAD-SLOADP	;PUNCH SBLK LOADER IN RIM FORMAT
	MOVSI C,(DATAI PTR,)
PLOAD1:	MOVE A,C
	PUSHJ P,PPBA
	CAMN C,[DATAI PTR,13]
	 HRRI C,27
	MOVE A,SLOAD(B)
	PUSHJ P,PPBA
	AOS C
	AOBJN B,PLOAD1
	MOVE A,[JRST 1]
	PUSHJ P, PPBA
	JRST FEED1

PLOD2:	MOVSI C,LDR10-ELDR10	;PUNCH SBLK LOADER FOR PDP10 READIN
PLOD3:	MOVE A,LDR10(C)
	PUSHJ P,PPBA
	AOBJN C,PLOD3
	JRST FEED1

		;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT

SLOAD:	CONO PTR,60	;0 RESTART POINT (NEW BLOCK)
	JSP 14,30	;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY
	DATAI PTR,16	;GET HEADER
	MOVE 15,16	;INITIALIZE CHECKSUM
	JUMPGE 16,16	;HEADER .GE. 0 => STARTING INSTRUCTION
	JSP 14,30	;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY
	DATAI PTR,(16)	;READ IN DATA WORD
	ROT 15,1	;NOW UPDATE CHECKSUM
	ADD 15,(16)
	AOBJN 16,5	;LOOP FOR ALL DATA WORDS THIS BLOCK
	MOVEI 14,33	;30 TO RETURN TO 33
	JRST 30		;WAIT FOR READY THEN GO TO 33
		;14 JSP AC FOR ROUTINE AT 30
		;15 CHECKSUM
		;16 AOBJN POINTER (UPDATED HEADER)
	CONSO PTR,10	;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI
	JRST 30
	JRST (14)
	DATAI PTR,16	;33 GET CHECKSUM
	CAMN 15,16	;COMPARE WITH CALCULATED
	JUMPA 1		;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED)
	JRST 4,		;CHECKSUM ERROR
SLOADP==.
;PDP10 SBLK LOADER
;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT
	;BY ASSEMBLER, COMPILER, OR WHATEVER
;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE
;USES ONLY THE AC'S (BUT ALL OF THEM)

LDR10:
	-17,,0		;BLKI POINTER FOR READ SWITCH

LDRC=0		;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD
		;INTO IT DURING HARDWARE READIN, BUT WHO SAYS
		;YOUR PROGRAM CAN'T USE IT?)
OFFSET -.+1		;BEGIN LOADING INTO 1 AS PER HEADER
LDRGO==.
	CONO PTR,60	;START UP PTR (RESTART POINT)
LDRRD==.
	HRRI LDRB,.+2	;INITIALIZE INDEX
LDRW==.
	CONSO PTR,10	;WAIT FOR WORD TO BE AVAILABLE
	JRST .-1
	ROT LDRC,-LDRRD(LDRB)	;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE)
		;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM)
		;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM)
	DATAI PTR,@LDRT1-LDRRD(LDRB)	;READ WORD INTO RIGHT PLACE
		;HEADER => READ INTO C
		;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A
		;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C)
	XCT LDRT1-LDRRD(LDRB)	;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS)
	XCT LDRT2-LDRRD(LDRB)	;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS)
LDRB==.
	SOJA .,		;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION
			;USED AS INDEX INTO TABLES, ETC.

		;TABLE 1
		;INDIRECTED THROUGH FOR DATAI
		;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD
		;ENTRIES EXECUTED IN REVERSE ORDER

LDRT1==.
	CAME LDRC,LDRA	;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE
	ADD LDRC,(LDRA)	;UPDATE CHECKSUM
	SKIPL LDRA,LDRC	;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK

		;TABLE 2
		;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED

LDRT2==.
	JRST 4,LDRGO	;CHECKSUM ERROR
	AOBJN LDRA,LDRW	;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED
LDRA==.
	JRST LDRRD		;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER
		;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK

OFFSET 0
ELDR10==.
;FLAGS IN SQUOZE OF SYMS TO OUTPUT

ABSGLO==040000	;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME)
ABSLCL==100000	;LOCAL
ABSDLI==200000	;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN)
ABSDLO==400000	;DELETE OUTPUT (DON'T TYPE IT OUT)

PSYMS:	HRRM A,RETURN	;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT
	PUSH P,PSYMS	;AT END, POPJ TO RETURN.
	TRNE FF,FRSYMS
	 JRST SYMDMP	;PUNCH SYMS IF NEC.
	SKIPL A,CONTRL
	 JRST SYMDA	;IF RELOCA, PUNCH PROGRAM NAME.
	TRNE A,DECSAV	;IF DEC SAVE FORMAT WITHOUT SYMBOLS
	 JRST SYMDSA	;STILL DUMP START ADDRESS
	TRNN A,DECREL
	 POPJ P,

PSYMSD:	MOVSI A,DECEND
	PUSHJ P,DECBLK	;START AN END-BLOCK.
	MOVE A,DECTWO	;IN 2-SEG PROGRAMS,
	CAME A,[MOVE]
	 JRST [	CAMG A,DECBRH	;OUTPUT HISEG BREAK
		 MOVE A,DECBRH
		MOVEM A,WRD
		MOVEIM WRDRLC,1
		CALL PWRD
		MOVEMM WRD,DECBRK
		CALL PWRD	;FOLLOWED BY LOSEG BREAK
		JRST EBLK]
	MOVEMM WRD,DECBRK	;OUTPUT THE PROGRAM BREAK.
	MOVEIM WRDRLC,1
	PUSHJ P,PWRD
	MOVE A,DECBRA	;OUTPUT HIGHEST ABS. ADDR
	CAIG A,140
	 SETZ A,	;IF IT'S ABOVE THE JOBDAT AREA.
	PUSHJ P,DECWRD
	JRST EBLK

SYMDA:	MOVEI A,LPRGN	;NOW PUNCH PROGRAM NAME
	DPB A,[310700,,BKBUF]
	MOVE A,PRGNM
	TLO A,40000
	PUSHJ P,$OUTPT
	PUSHJ P,EBLK
	TLZ FF,$FLOUT
	POPJ P,

	;DUMP OUT THE SYMBOL TABLE

SYMDMP:	TRZ I,IRCONT	;OK TO END BLOCK
	CLEARM GLSP1
	CLEARM GLSP2
	CLEARM WRDRLC
	MOVE T,CONTRL
	MOVEI A,BKBUF+1
	MOVEM A,OPT1
	CLEARM CLOC
	CLEARM BKBUF
IFN FASLP,[
	TRNE T,FASL
	 JRST SYMDM1
]
IFN ITSSW,[
	TRNE T,SBLKS	; ON ITS, IF OUTPUTTING IN SBLK FMT
	 CALL SYMDDB	; THEN OUTPUT A DEBUGGING INFO BLOCK.
]
	TRNE T,DECREL
	 JRST SYMDMD
	JUMPL T,SSYMD	;JUMP IF NOT STINK

	MOVEI B,LDDSYM	;LOCAL SYMS BLOCK TYPE
	DPB B,[310700,,BKBUF]	;SET BLOCK TYPE
	MOVEM B,CDATBC
	MOVE B,SYMAOB	;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB.
	JRST SSYMDR

SYMDMD:	MOVSI A,DECSYM	;IN DEC FMT, START SYMBOLS BLOCK.
	PUSHJ P,DECBLK
SYMDM1:	MOVE B,SYMAOB
	JRST SSYMDR

IFN ITSSW,[

	; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY)

SYMDDB:	MOVE A,[-7,,3]		;OUTPUT A "DEBUGGING INFORMATION" BLOCK
	MOVE B,A		;UPDATING THE CHECKSUM IN B.
	PUSHJ P,PPB
	MOVE A,[-6,,1]		;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK.
	PUSHJ P,PPBCK
	.SUSET [.RXUNAME,,A]	;CONTAINING NAME OF USER, DATE IN DISK FORMAT,
	PUSHJ P,PPBCK
	SYSCAL RQDATE,[%CLOUT,,A]
	 .LOSE %LSSYS
	PUSHJ P,PPBCK		;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME).
REPEAT 4,[
	MOVE A,INFB+$F6DEV+.RPCNT
	PUSHJ P,PPBCK
]
	MOVE A,B
	PJRST PPB		; PUNCH OUT CHECKSUM & RETURN
] ;IFN ITSSW,
;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE):
	;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST
	;A TEMP
	;B SQUOZE
	;D OUTPUT INDEX INTO SYMTAB
	;CH1 VALUE OF SYM
	;CH2 3RDWRD

SSYMD:	MOVEI D,ST-1
	SETZB C,SMSRTF	;SYMS SORTED => INITIAL SYMS CLOBBERED
	MOVE AA,SYMAOB
SSYMD1:	SKIPE B,ST(AA)		;GET SYM NAME FROM TABLE
	 TDNN B,[37777,,-1]	;MAKE SURE NOT EXPUNGED
	  JRST SSYMDL		;NOT (REALLY) THERE, TRY NEXT
	AOS SMSRTF
	MOVE CH1,ST+1(AA)	;GET VALUE OF SYM
	3GET CH2,AA		;GET 3RDWRD
	TRNE CH2,-1
	 TLNE CH2,3KILL+3LLV
	  JRST SSYMDL		;DON'T PUNCH INITIAL OR KILLED SYMS.
	MOVEI A,0		;INITIALIZE FOR SHIFTING IN FLAGS
	LSHC A,4		;SHIFT FLAGS INTO A
	XCT SSYMDT(A)		;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY
	 JRST SSYMDL
SSYMD2:	LSH B,-4		;SHIFT SQUOZE BACK TO WHERE IT BELONGS
	TLO B,ABSLCL		;SET LOCAL BIT
	TLNE CH2,3SKILL
	 TLO B,ABSDLO		;HALF-KILL SYM
	CAIL A,DEFGVR_-16
	 TLC B,ABSGLO\ABSLCL	;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT,
	CAIGE A,DEFGVR_-16	;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB.
	 SKIPN PRGNM+BKWPB	;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK.
	  HRRI CH2,0
	PUSH D,B		;STORE NAME OF SYM IN OUTPUT SLOT
	PUSH D,CH1		;STORE VALUE 
	PUSH D,CH2		;STORE 3RDWRD
SSYMDL:	ADD AA,WPSTE1
	AOBJN AA,SSYMD1		;LOOP FOR ALL SYMS IN TABLE
	MOVSI CH2,4^5		;1ST BIT TO SORT ON IS TOP BIT,
	MOVEI A,ST		;SORT FROM BOTTOM OF SYMTAB
	MOVEI B,1(D)		;TO WHERE WE FILLED UP TO.
	MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST.
	MOVE C,[TDNN CH2,1(B)]
	JSP AA,SSYMD9
	TLC C,(TDNE#TDNN)	;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST.
	TLC CH1,(TDNE#TDNN)
	MOVEI AA,SSRTX		;NEED ONLY CHANGE C, CH1 THE FIRST TIME.
	JRST SSRTX

SSYMD9:	PUSHJ P,SSRTX		;SORT SYMS ARITHMETICALLY BY VALUE.
	MOVNI B,(B)
	ADDI B,ST		;SIZE OF AREA OF SYMTAB STILL IN USE.
	IDIV B,WPSTE
	HRLZI B,(B)		;-<# SYMTAB ENTRIES>,,
	MOVE T,CONTRL		; GET CONTRL FOR OUTPUT FMT CHECKS
	MOVE A,[SQUOZE 0,GLOBAL]
	MOVEM A,BKTAB	;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK.
	MOVE C,BKTABP
	IDIVI C,BKWPB	;# BLOCKS (INCL. GLOBAL BLOCK).
	CAIN C,2	;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN.
	 SETZM PRGNM+1
	CAIN C,2
	 MOVEI C,1	;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL).
	CAILE C,1	;IF MORE THAN ONE BLOCK IN FILE,
	 TRNN T,DECSAV	;AND OUTPUT FORMAT IS DECSAV,
	  CAIA
	   ADDI C,1	;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME).
			;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME
			;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK.
	MOVSI A,(C)	; <# BLOCKS TO OUTPUT>,,
	SUBM B,A	;-<# ENTRIES IN SYMTAB IN FILE>,,
	LSH A,1		;-<# WDS IN SYMTAB IN FILE>,,
	TRNE T,DECSAV	; IF OUTPUT FORMAT IS DEC SAV,
	 JRST [	HRR A,DECSYA	; GET LOC TO STORE SYMS AT
		MOVE C,A
		MOVE A,[-1,,116-1]	; STORE IT AT .JBSYM
		CALL PPB
		MOVE A,C
		CALL PPB
		HRRI A,-1(A)	; SET -<# WDS IN SYMTAB>,,<LOC-1 TO STORE AT>
		JRST .+1]
	MOVEM A,SCKSUM	;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT)
	PUSHJ P,PPB
	PUSHJ P,BKCNT	;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY.

;DROPS THROUGH.
;DROPS IN IF ABS, JUMPS HERE IF RELOC.
;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND
;SHOULD NOT BE CLOBBERED.
SSYMDR:	PUSH P,B	;-<# SYMS>,,0  ;IT WILL BE -1(P)
	PUSHJ P,BKSRT	;SORT BLOCKS INTO BKTAB1
	MOVE A,BKTAB
	CAME A,[SQUOZE 0,GLOBAL]	;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1
	 SOS D		;ELSE FLUSH .INIT FROM THE END OF BKTAB1.
	SETOM 1(D)	;PUT A -1 AT END OF BKTAB1.
	MOVE B,SCKSUM	;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE)
	PUSH P,[-1]	;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT.
SSYMD3:	AOS F,(P)	;F HAS BKTAB1 IDX OF BLOCK.
	SKIPGE C,BKTAB1(F)	;BKTAB1 ELT HAS BKTAB IDX OR
	 JRST SSYMDX	; -1 AFTER LAST BLOCK.
	SKIPL LINK,CONTRL
	 JRST SSYMD7	;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA.
	TRNE LINK,DECREL+FASL+DECSAV
	 JRST SSYMD6	; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT
	MOVE A,BKTAB(C)
	PUSHJ P,PPBCK	;OUTPUT BLOCK NAME WITH NO FLAG BITS SET.
	HLRZ A,BKTAB+1(C)
	SKIPE A
	 ADDI A,1	;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL).
	HRL A,BKTAB+2(C)	;PUT IN -2*<NUM SYMS>
	ADD A,[-2,,]
SSYMG2:	PUSHJ P,PPBCK	;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY.
	JRST SSYMD6

SSYMD7:	MOVE A,BKTAB(C)	;OUTPUT BLOCK NAME IN RELOCATABLE.
	TLO A,ABSGLO	;TELL STINK IT'S BLOCK NAME.
	PUSHJ P,$OUTPT
	HLRZ A,BKTAB+1(C)
	SUBI A,1
	PUSHJ P,$OUTPT
SSYMD6:	SKIPL C,-1(P)	;AOBJN PTR TO SYMS.
	 JRST SSYMD8	 ;IN CASE NO SYMS.
SSYMD4:	HRRZ A,ST+2(C)	;OUPUT ONLY THE SYMS IN THE BLOCK
	CAME A,BKTAB1(F)	;NOW BEING HANDLED.
	 JRST SSYMD5
	SKIPGE LINK,CONTRL
	 TRNE LINK,DECREL+FASL
	  JRST SYMD2	;SPECIAL IF RELOCA.
	MOVE A,ST(C)
	TRNE LINK,DECSAV
	 CALL RSQZA	; RIGHT-JUSTIFY THE SQUOZE (SIGH)
	PUSHJ P,PPBCK	;1ST, SQUOZE WITH FLAGS.
	MOVE A,ST+1(C)
	PUSHJ P,PPBCK	;2ND, VALUE.
SSYMD5:	ADD C,WPSTE1
	AOBJN C,SSYMD4	;HANDLE NEXT SYM.
SSYMD8:	TRNN LINK,DECSAV
	 JRST SSYMD3	;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK.

	; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST.
	SKIPN PRGNM+BKWPB	;IF ONLY ONE BLOCK IN PGM,
	 JRST SSYMD3		; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME.
	MOVE C,BKTAB1(F)	; GET IDX FOR BLOCK
	MOVE A,BKTAB(C)		; GET BLOCKNAME WITH FLAGS CLEAR
	TLO A,140000		; SET FLAGS TO SAY SYM IS BLOCKNAME
	CALL RSQZA		; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH)
	CALL PPB
	HLRZ A,BKTAB+1(C)	; GET LEVEL OF BLOCK (NO WD COUNTS)
	CALL PPB
	JRST SSYMD3

	; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS.
	; (WHICH ASQOZR RTN DOESN'T)
	; CLOBBERS B.
RSQZA:	PUSH P,A	; SAVE FLAGS
	TLZA A,740000	; ZAP
RSQZA2:	 DPB A,[004000,,(P)]	; UPDATE
	IDIVI A,50
	JUMPE B,RSQZA2
	POP P,A
	POPJ P,
;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY)
;NORMALLY OUTPUT SQUOZE W/ FLAGS  ?  VALUE,
;IF 3LLV SET OUTPUT  PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP.
SYMD2:	LDB A,[400400,,ST(C)]
	MOVE CH1,ST+1(C)	;SSYMDT MAY CHANGE CH1.
	MOVE CH2,ST+2(C)
	XCT SSYMDT(A)	;SKIPS IF SHOULD OUTPUT SYM.
	 JRST SSYMD5
	TLNE CH2,3KILL
	 JRST SSYMD5
	MOVE B,ST(C)
	TLZ B,740000
	JUMPE B,SSYMD5	;UNUSED ENTRY.
	JUMPL LINK,SYMDEC	;J IF DEC OR FASL FMT
	TLNE CH2,3RLL
	 TLO B,200000	;RELOCATE LEFT HALF
	TLNE CH2,3RLR
	 TLO B,100000	;RELOCATE RIGHT HALF
	TLNE CH2,3SKILL
	 TLO B,400000	;HALF-KILL
	MOVEI A,ST(C)
	TLNE CH2,3LLV	;IF STINK HAS VALUE,
	 PUSHJ P,$OUTPT	;GIVE STINK NAME STINK KNOWS SYMBOL BY.
	TLNE CH2,3LLV	;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET
	 TLO B,ABSLCL	;(STINK WILL DO SO OTHERWISE)
	MOVE A,B
	PUSHJ P,$OUTPT	;OUTPUT SYM
	MOVE A,CH1
	TLNN CH2,3LLV	;DON'T OUTPUT VALUE IF DON'T KNOW IT.
	 PUSHJ P,$OUTPT	;OUTPUT VALUE
	JRST SSYMD5

SYMDEC:	IFN FASLP,[
	TRNE LINK,FASL
	 JRST SYMFSL	;FASL ASSMBLY
]
	PUSHJ P,ASQOZR	;RIGHT-JUSTIFY THE SQUOZE,
	TLNE CH2,3SKILL
	 TLO B,ABSDLO	;MAYBE HALFKILL,
	TLO B,ABSGLO
	LDB A,[400400,,ST(C)]
	CAIGE A,DEFGVR_-14.
	 TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL.
	MOVEM B,WRD
	PUSH P,C
	PUSHJ P,DECPW	;FIRST, THE NAME,
	POP P,C
	LDB TM,[420200,,ST+2(C)]
	MOVE A,ST+1(C)	;THEN THE VALUE AND RELOCATION BITS.
	PUSHJ P,DECWR1
	JRST SSYMD5

IFN FASLP,[
SYMFSL:	TLO B,400000	;GET VALUE FROM SECOND WD
	TLNE CH2,3RLL
	 TLO B,200000	;RELOCATE LH
	TLNE CH2,3RLR
	 TLO B,100000
	CAIL A,LGBLCB_<-18.+4>
	 TLO B,40000	;GLOBAL FLAG
	MOVE A,B
	MOVEI B,15	;PUTDDTSYM
	PUSHJ P,FASO
	MOVE A,CH1
	PUSHJ P,FASO1
	JRST SSYMD5
]
;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP.
SSYMDT:	JFCL		;COM
	JFCL		;PSEUDO OR MACRO
	CAIA		;SYM, PUNCH OUT
	TLNN CH2,3LLV	;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT.
	TLZA CH1,-1	;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE)
	JFCL		;UNDEFINED LOCAL VARIABLE
	SKIPL CONTRL	;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS.
	JFCL		;UNDEFINED GLOBAL VARIABLE
	SKIPL CONTRL	;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM.
	JFCL		;GLOBAL EXIT, DON'T PUNCH OUT
IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES.

SSYMDX:	SKIPGE LINK,CONTRL
	 TRNE LINK,DECREL+FASL
	  JRST SSYMG3
	TRNE LINK,DECSAV	; IN DECSAV FORMAT,
	 JRST [	MOVE A,PRGNM	; PGM NAME IS LAST THING IN SYMTAB
		CALL RSQZA
		CALL PPB	; WITH FUNNY VALUE OF
		SETZ A,		; -<# SYMTAB WDS USED BY PGM>,,<RELOC CONSTANT>
		CALL PPB	; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO...
		JRST SSYMG3]
	MOVE A,B	; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM.
	PUSHJ P,PPB
SSYMG3:	SUB P,[2,,2]
	PUSHJ P,EBLK	;END CURRENT OUTPUT BLOCK
	SKIPL A,CONTRL	;RELOCATABLE => OUTPUT PROG NAME.
	 JRST SYMDA
IFN FASLP,[
	TRNE A,FASL
	 POPJ P,
]
	TRNE A,DECREL	;DEC FMT => OUTPUT END BLOCK.
	 JRST PSYMSD
SYMDSA:	MOVE A,STARTA	;NOW GET STARTING INSTRUCTION
	JRST PPB	;PUNCH IT OUT AND RETURN

;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR
;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT)
;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST.  D POINTS AT WHERE IT WAS PUT.
; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS
; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST.

BKSRT:	MOVEI D,BKTAB1-1	;D IS FOR PUSHING INTO BKTAB1.
	MOVSI A,1	;START WITH BLOCK 0 (OUTERMOST, .INIT).
	MOVE LINK,CONTRL

	;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS.
BKSR1:	TRNE LINK,DECSAV
	 JRST [	MOVEI C,(A) ? PUSH D,C ? JRST .+1]
	SETZ C,
BKSR2:	CAME A,BKTAB+1(C)
	 JRST BKSR3	;THIS BLOCK ISN'T A SUBBLOCK.
	ADD A,[1,,]	;LH HAS SUBBLOCK'S LEVEL.
	HRRI A,(C)	;RH HAS SUBBLOCK.
	PUSHJ P,BKSR1	;HANDLE THE SUBBLOCK
	MOVE A,BKTAB+1(C)	; RESTORE A (C IS PRESERVED OVER CALL)
BKSR3:	ADDI C,BKWPB
	CAMGE C,BKTABP
	 JRST BKSR2
	MOVEI C,(A)	; RESTORE C INDEX BKSR1 WAS ENTERED WITH
	TRNE LINK,DECSAV
	 POPJ P,
	PUSH D,C	;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS)
	POPJ P,

PPBCK:	ROT B,1	;OUTPUT WD IN A, UPDATING CKSUM IN B.
	ADD B,A
	JRST PPB
;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF
;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB).

BKCNT:	PUSH P,B
	MOVEI C,0
BKCNT0:	SETZM BKTAB+2(C)	;ZERO 3RD WD OF EACH BKTAB ENTRY.
	ADDI C,BKWPB
	CAMGE C,BKTABP
	 JRST BKCNT0
BKCNT1:	MOVE C,ST+2(B)
	SOS BKTAB+2(C)	;ADD -2 FOR EACH SYM IN THE BLOCK.
	SOS BKTAB+2(C)
	ADD B,WPSTE1
	AOBJN B,BKCNT1
POPBJ:	POP P,B
	POPJ P,

SSRTX:	HRLM B,(P)	;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
	CAIL A,@WPSTEB	;ONLY 1 ENTRY, NOTHING TO DO.
	 JRST SSRTX7
	PUSH P,A	;SAVE START.
SSRTX3:	XCT CH1
	 JRST SSRTX4	;MOVE UP TO 1ST WITH BIT ON.
	SUB B,WPSTE
	XCT C		;MOVE DOWN TO LAST WITH BIT OFF.
	 JRST SSRTX5
	MOVE D,WPSTE
	CAIE D,MAXWPS
	 JRST .+4
REPEAT MAXWPS,[
	MOVE D,.RPCNT(A)	;EXCHANGE THEM,
	EXCH D,.RPCNT(B)
	MOVEM D,.RPCNT(A)]
SSRTX4:	ADD A,WPSTE
SSRTX5:	CAME A,B	;ALL DONE => DO NEXT BIT.
	 JRST SSRTX3	;MORE IN THIS PASS.
	ROT CH2,-1	;NEXT BIT DOWN.
	POP P,A		;A -> START, B -> END OF 1ST HALF.
	JUMPL CH2,SSRTX6	;ALL BITS IN WD DONE, STOP.
	PUSHJ P,(AA)	;DO NEXT BIT ON 1ST HALF.
	HLRZ B,(P)	;A -> END OF 1ST HALF, B -> END OF ALL.
	PUSHJ P,(AA)	;DO SECOND HALF.
SSRTX6:	ROT CH2,1	;LEAVE CH2 AS FOUND IT.
SSRTX7:	HLRZ A,(P)	;LEAVE A -> END OF AREA SORTED.
	POPJ P,
;ARITHMETIC CONDITIONALS (B HAS JUMP<COND> A,)

COND:	PUSH P,B	;SAVE CONDITIONAL JUMP
	PUSHJ P,AGETFD	;GET FIELD TO TEST VALUE OF
CONDPP:	POP P,T		;RESTORE CONDITIONAL JUMP INSTRUCTION
	HRRI T,COND2	;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE
	XCT T		;JUMP IF COND T,ASSEMBLE STRING
COND4:	SETZM A.SUCC	;MOST RECENT CONDIT. FAILED.
COND5:	JSP TM,ERMARK	;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN.
	CALL RCH
	JSP D,RARL4	;INIT FOR THE CONDITIONALIZED STUFF.
	 CAIA
	CALL RARFLS	;READ AND IGNORE THE ARG.
	JRST MACCR

ANULL:	TLO FF,FLUNRD
	JRST COND5

;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN.
A.ELSE:	HRRI B,A.SUCC
	XCT B
	 JRST COND4	;CONDITION FALSE.
	JRST COND2	;TRUE.

;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF,
COND1:	HRRI B,FRPSS2
	XCT B
	JRST COND4	;NO
		;CONDITION TRUE, ASSEMBLE STRING
COND2:	SETOM A.SUCC	;LAST CONDITIONAL SUCCEEDED.
COND6:	PUSHJ P,RCH	;GET NEXT CHAR
	CAIE A,LBRKT
	 JRST [	CAIE A,LBRACE
		 TLO FF,FLUNRD
		JRST MACCR]
	SKIPN SCNDEP	;BRACKET TYPE CONDITIONAL.
	 SKIPE CONDEP
	  JRST COND7
	MOVEMM CONDLN,CLNN	;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED
	MOVEMM CONDPN,CPGN
IFN TS,	MOVEMM CONDFI,INFFN1
COND7:	AOS SCNDEP	;COUNT IT FOR RBRAK'S SAKE.
	JRST MACCR
;IFB, IFNB

SBCND:	PUSH P,B	;SAVE TEST JUMP
	SETZB B,C	;C COUNTS SQUOZE CHARS FOR IFB/IFNB
			;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ
	JSP D,RARG	;INIT FOR READING OF ARG WHOSE BLANKNESS
	 JRST CONDPP	;IS TO BE TESTED.
	JSP D,RARGCH(T)	;READ 1 CHAR,
	 JRST CONDPP	;(NO MORE CHARS)
	HLRZ A,GDTAB(A)	;GET GDTAB ENTRY
	CAIE A,(POPJ P,)	;POPJ => NOT SQUOZE
	 AOJA C,RARGCH(T)
	AOJA B,RARGCH(T)

		;IFDEF, IFNDEF

DEFCND:	PUSH P,SYM
	PUSH P,B	;SAVE CONDITIONAL JUMP
	PUSHJ P,GETSLD	;GET NAME
	 CALL NONAME
	PUSHJ P,ES
	 MOVEI A,0	;UNDEFINED
IFN CREFSW,XCT CRFINU
	CAIN A,GLOEXT_-14.	;GLOBAL EXIT...
	 SKIPL CONTRL	;DURING ABSOLUTE ASSEMBLY?
	  CAIN A,3	;NO, LOCAL UNDEF?
	   MOVEI A,0	;ONE OF THESE => UNDEF
	REST SYM
	EXCH SYM,(P)	;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP.
	JRST CONDPP
;;PWRD		;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF

		;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS

PBITS3:	PUSH P,A
	MOVEI A,14
	MOVEM A,PBITS2	;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS
	MOVE A,[440300,,PBITS1]
	MOVEM A,BITP	;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS
	MOVE A,PBITS1	;NOW GET ACCUMULATED WORD OF BITS
	MOVEM A,@PBITS4	;STORE IN BKBUF
	AOS A,OPT1	;RESERVE SPACE FOR NEW WORD
		;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES
		;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE
	TRNN FF,FRBIT7
	 SOSA A
	  TRO FF,FRINVT
	HRRZM A,PBITS4
	POP P,A
	CLEARM PBITS1
			;DROPS THROUGH
		;OUTPUT RELOCATION CODE BITS IN A

PBITS:	SKIPGE CONTRL
	 POPJ P,	;NOT RELOCATABLE
	SOSGE PBITS2
	 JRST PBITS3	;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN
	CAIN A,7
	 TROA FF,FRBIT7
	  TRZ FF,FRBIT7
	IDPB A,BITP
	POPJ P,

		;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A

OUTSM0:	MOVE A,SYM	;OUTPUT NAME STINK KNOWS SYMBOL BY.
	TLZ A,37777	;FOR LOCALS, THAT'S THE STE ADDR,
	HRRI A,ST(D)
	TLNN SYM,40000	;FOR GLOBALS, THAT'S THE SQUOZE.
	 JRST $OUTPT
OUTSM:	SKIPA A,SYM
OUTWD:	MOVE A,WRD
$OUTPT:	SKIPGE CONTRL	;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY
	 POPJ P,	;DO NOTHING IF ABSOLUTE ASSEMBLY
	PUSH P,AA
	MOVE AA,OPT1
	TRZN FF,FRINVT	;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS
	AOS AA
	MOVEM A,-1(AA)
	MOVE A,CLOC
	TRZE FF,FRFIRWD
	 HRRM A,BKBUF
	POP P,AA
	AOS A,OPT1
	CAIL A,BSIZE+BKBUF
	 TRNE I,IRCONT
	  POPJ P,
		;MAY DROP THROUGH
;END CURRENT OUTPUT BLOCK

EBLK:	PUSH P,T
	PUSH P,TT
	PUSH P,A
	PUSH P,B
	MOVE T,CONTRL
	JUMPGE T,EBLK3	;JUMP IF RELOCATABLE ASSEMBLY
	TRNE T,ARIM10\SBLKS
	 JRST ESBLK
	TRNE T,DECSAV
	 JRST EDSBLK
IFN FASLP,[
	TRNE T,FASL
	JRST FASLE	;FASL HAS NO BLOCKS TO END - IGNORE
]
	TRNE T,DECREL
	 JRST DECEBL
	JRST EBLK5

EBLK3:	MOVE T,PBITS1
	MOVEM T,@PBITS4
	MOVEI T,PBITS4
	MOVEM T,PBITS4
	MOVE T,[440300,,PBITS1]
	MOVEM T,BITP
	CLEARB TT,PBITS2
	CLEARM PBITS1
	MOVEI T,BKBUF
	MOVE B,OPT1	;GET POINTER TO END OF BLOCK
	SUBI B,BKBUF+1	;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER)
	DPB B,[220700,,BKBUF]	;SET COUNT FIELD IN HEADER
	TRZN FF,FRLOC
	 JUMPLE B,EBLK5	;IGNORE NULL BLOCK UNLESS FRLOC SET
	TLO FF,$FLOUT	;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
	PUSHJ P,FEED
EBK1:	CAML T,OPT1	;DONE WITH BLOCK?
	 JRST EBK2	;YES
	MOVE A,(T)	;NO, GET DATA WORD
	JFCL 4,.+1	;UPDATE CHECKSUM
	ADD TT,A
	JFCL 4,[AOJA TT,.+1]
	PUSHJ P,PPB	;OUTPUT WORD
	AOJA T,EBK1
EBK2:	SETCM A,TT	;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM
	PUSHJ P,PPB	;OUTPUT CHECKSUM
	MOVE T,CDATBC	;GET BLOCK TYPE
	DPB T,[310700,,BKBUF]	;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE
	MOVEI T,BKBUF+1
	MOVEM T,OPT1
EBLK4:	TLO FF,$FLOUT	;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
EBLK5:	TRO FF,FRFIRWD
FASLE:	POP P,B
	POP P,A
PTT.TJ:	POP P,TT
	POP P,T
	POPJ P,
;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES

PWRDA:	TROA FF,FRNLIK	;SUPPRESS ADR LINKING
PWRD:	 TRZ FF,FRNLIK	;PERMIT ADR LINKING
IFN LISTSW,[
	SKIPN LSTONP
	 JRST PWRDL	;NOT MAKING LISTING NOW.
	SKIPGE LISTPF
	 PUSHJ P,PNTR
	SETOM LISTPF
	MOVE LINK,WRD
	MOVEM LINK,LISTWD
	MOVE LINK,WRDRLC
	MOVEM LINK,LSTRLC
	MOVE LINK,CLOC
	MOVEM LINK,LISTAD
	MOVE LINK,CRLOC
	DPB LINK,[220100,,LISTAD]
PWRDL:
] ;END IFN LISTSW,
	JUMPGE FF,CPOPJ	;IGNORE IF NOT PUNCHING PASS
	SKIPGE LINK,CONTRL
	 JRST PWRD1	;ABSOLUTE ASSEMBLY
		;RELOCATABLE ASSEMBLY
	PUSHJ P,$RSET	;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD
	MOVE A,GLSP2
	CAMN A,GLSP1
	 JRST PWRD2	;NO GLOBALS

		;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK

	HRLZ B,WRD
	HRR B,WRDRLC
	JUMPN B,PWRD3	;JUMP IF RH NON-ZERO
	TRNN FF,FRNLIK
	 SKIPGE GLOCTP
	  JRST PWRD3	;ADR LINKING SUPPRESSED OR CLOC GLOBAL
	SKIPE LDCCC
	 JRST PWRD3	;IN LOAD TIME CONDITIONALS
	MOVNI T,1	;INITIALIZE T FOR COUNTING
PWRD4:	CAML A,GLSP1
	 JRST PWRD5	;DONE
	HRRZ TT,1(A)	;GET GLOTB ENTRY
	JUMPE TT,PWRD7A
	LDB TT,[400400,,(TT)]	;GET SQUOZE FLAGS FROM SYM
	CAIE TT,DEFGVR_-14.
	 CAIN TT,GLOETY_-14.
	  JRST PWRD3	;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H)
	HLRZ TT,1(A)
	TRNE TT,1777+MINF
	 JRST PWRD3	;NEGATED OR MULTIPLIED
	TRNE TT,HFWDF
	 JRST PWRD7
	TRNE TT,ACF
	 TRNN TT,SWAPF
	  JRST PWRD3	;NOT HIGH AC
PWRD7A:	AOJA A,PWRD4
PWRD7:	TRNE TT,SWAPF
	 AOJA A,PWRD4	;LEFT HALF
	AOJN T,PWRD3	;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF
	MOVEI D,1(A)	;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY
	AOJA A,PWRD4
PWRD5:	AOJE T,PWRD3	;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH
	HRRZ T,(D)	;GET ADR OF SQUOZE
	SKPST T,	;SKIP IF IN SYMBOL TABLE
	 JRST PWRD3	;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL
	PUSH P,T	;HOORAY, WE CAN ADDRESS LINK
	SETZM (D)	;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE
	PUSHJ P,PWRD31	;DUMP OUT THE OTHER GLOBALS
	POP P,D		;GET ST ADR OF THIS AGAIN
	3GET1 A,D
	LDB A,[.BP (3RLNK),A]
	MOVE B,WRDRLC
	TLNE B,1
	 TRO A,2	;RELOCATE LEFT HALF
	PUSHJ P,PBITS	;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY
	HLR A,1(D)	;GET ADR OF LAST
	HLL A,WRD
	PUSHJ P,$OUTPT	;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S
	MOVE A,CLOC	;NOW UPDATE ST ENTRY
	HRLM A,1(D)
	3GET1 B,D
	SKIPN CRLOC
	 TLZA B,3RLNK	;CLOC NOT RELOCATED LAST TIME THIS SYM USED
	  TLO B,3RLNK	;RELOCATED
	3PUT1 B,D
	POPJ P,
PWRD31:	MOVE T,GLSP2	;DUMP ALL GLO S IN GENERAL FORMAT
PWRD3A:	CAML T,GLSP1
	 POPJ P,
	MOVE B,1(T)
	TRNN B,-1
	 AOJA T,PWRD3A
	TLNE B,1777
	 JRST RPWRD	;REPEAT
RPWRD1:	LDB A,[.BP (MINF),B]
	TRO A,4
	PUSHJ P,PBITS
	MOVE  A,(B)	;CODEBITS +SQUOZE FOR SYM
	HLRZ C,A
	TLZ A,740000
	CAIL C,DEFGVR
	 TLOA A,40000	;SYM IS GLO
	  JRST [
		MOVEI C,(B)		;IF WE ARE OUTPUTTING A REFERENCE TO THE
		CAIL C,PCNTB		;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA
		CAIL C,PCNTB+NCONS*3	;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE
		MOVEI A,(B)		;NAME, SINCE THE SYMBOL ISN'T IN THE
		JRST .+1]		;SYMTAB
	TLNE B,SWAPF
	 TLO A,400000
	TLNE B,ACF
	 JRST PWRD3E	;AC HIGH OR LOW
	TLNN B,HFWDF
	 JRST PWRD3F	;ALL THROUGH
	TLO A,100000
	TLNE B,SWAPF
	 TLC A,300000
PWRD3F:	PUSHJ P,$OUTPT
	AOJA T,PWRD3A



RPWRD:	PUSHJ P,PBITS7
	MOVEI A,CRPT
	PUSHJ P,PBITS
	LDB A,[221200,,B]
	PUSHJ P,$OUTPT
	JRST RPWRD1

PWRD3E:	TLO A,300000
	JRST PWRD3F

PWRD3:	PUSHJ P,PWRD31
PWRD2:	PUSHJ P,RCHKT
	HRRZ A,B
	DPB T,[10100,,A]
	PUSHJ P,PBITS
	JRST OUTWD
;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD
;LEAVE RELOC (RH) IN B, RELOC (LH) IN T

RCHKT:	HRRZ B,WRDRLC	;CHECK FOR RELOC. OTHER THAN 0 OR 1.
	HLRZ T,WRDRLC
	TRZN B,-2
	 TRZE T,-2
RLCERR:	  ETSM [ASCIZ /Illegal relocation/]
	POPJ P,

RMOVET:	ROT T,-1
	DPB B,[420100,,T]
	TLZ C,3DFCLR	;SET RELOC BITS IN C
	IOR C,T		;FROM B AND T.
	POPJ P,

		;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT)
		;IF STANDARD THEN JUST RETURN
		;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN
		;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC.

$RSET:	MOVE C,WRDRLC	;GET RELOCATION
	ADDI C,400000	;WANT TO SEPARATE HALFWORDS
	HLRE B,C	;GET LH IN B
	HRREI C,400000(C)	;GET RH IN C (WILL EXCHANGE LATER)
	MOVE A,[SWAPF+HFWDF,,$R.H]	;PUT THIS ON GLOBAL LIST IF LH NEEDS $R.
	TRNE B,-2	;CHECK LH
	 PUSHJ P,$RSET1	;LH NEEDS GLOBAL REFERENCE
	EXCH B,C
	HRLI A,HFWDF
	TRNE B,-2	;CHECK RH
	 PUSHJ P,$RSET1	;RH NEEDS GLOBAL REFERENCE
	HRLZM C,WRDRLC	;RELOC OF LH
	ADDM B,WRDRLC	;COMPLETE SETTING UP WRDRLC
	POPJ P,

$RSET1:	JUMPGE B,$RSET2	;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE
	MOVN T,B	;NEGATIVE, GET MAGNITUDE
	TLOA A,MINF	;SET FLAG TO NEGATE GLOBAL
$RSET2:	 SOSA T,B	;POSITIVE, GET ONE LESS THAN IT IN T
	  TDZA B,B	;NEGATIVE, CLEAR B, RELOCATION LEFT OVER
	   MOVEI B,1	;POSITIVE, SET RELOCATION LEFT OVER TO 1
	CAIN T,1
	 MOVEI T,0	;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1
	TRNE T,-2000
	 ETSM [ASCIZ /Relocation too large/]	;TOO BIG EVEN FOR $RSET
	DPB T,[221200,,A]	;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE
	AOS GLSP1	;NOW PUT $R. ON GLOBAL LIST
	MOVEM A,@GLSP1
	POPJ P,
;PWRD DURING ABSOLUTE ASSEMBLY

PWRD1:	TRNE LINK,DECREL	; DEC REL FMT IS CONSIDERED ABSOLUTE.
	 JRST DECPW
IFN FASLP,[
	TRNE LINK,FASL
	 JRST FASPW	;SO IS FASL
]
	MOVE A,GLSP1
	CAME A,GLSP2
	 ETR ERRILG	;GLOBALS APPEARING ILLEGALLY
	SKIPE WRDRLC
	 ETR ERRIRL	;RELOCATION APPEARING ILLEGALLY
	TRNE LINK,ARIM
	 JRST PRIM	;RIM
	TRNE LINK,DECSAV
	 JRST DSBLK1
SBLKS1:	MOVE A,WRD	;SBLK
	MOVEM A,@OPT1	;STORE WRD IN BKBUF
	MOVE A,CLOC
	TRZE FF,FRFIRWD
	 MOVEM A,BKBUF	;FIRST WORD OF BLOCK, SET UP HEADER
	AOS A,OPT1
	CAIGE A,BKBUF+BSIZE
	POPJ P,		;BKBUF NOT FULL YET

SBLKS2:	SUBI A,BKBUF+1
	JUMPE A,CPOPJ
	MOVNS A
	HRLM A,BKBUF
	PUSHJ P,FEED
	MOVEI T,BKBUF
	CLEARM SCKSUM
SBLK1:	CAML T,OPT1
	 JRST SBLK2
	MOVE A,SCKSUM
	ROT A,1
	ADD A,(T)
	MOVEM A,SCKSUM
	MOVE A,(T)
	PUSHJ P,PPB
	AOJA T,SBLK1

SBLK2:	TRO FF,FRFIRWD
	MOVEI A,BKBUF+1
	MOVEM A,OPT1
	MOVE A,SCKSUM
	JRST PPB

ESBLK:	MOVE A,OPT1
	CAIN A,BKBUF+1
	 JRST EBLK5	;AVOID SETTING $FLOUT IF NULL BLOCK.
	PUSHJ P,SBLKS2
	JRST EBLK4

PRIM:	MOVSI A,(DATAI PTR,)
	HRR A,CLOC
	PUSHJ P,PPB
	MOVE A,WRD
	JRST PPB
; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV)

DSBLK1:	MOVE A,WRD
	MOVEM A,@OPT1	;STORE WRD IN BKBUF
	MOVE A,CLOC
	TRZE FF,FRFIRWD
	 MOVEM A,BKBUF	;FIRST WORD OF BLOCK, SET UP HEADER
	AOS A,OPT1
	CAIGE A,BKBUF+BSIZE
	 POPJ P,	;BKBUF NOT FULL YET, RETURN

DSBLK2:	SUBI A,BKBUF+1
	JUMPE A,CPOPJ
	MOVNS A
	SOS BKBUF	; DEC "IOWD" FMT, POINT AT LOC-1
	HRLM A,BKBUF
	PUSHJ P,FEED
	MOVEI T,BKBUF
DSBLK3:	CAML T,OPT1
	 JRST DSBLK4
	MOVE A,(T)
	PUSHJ P,PPB
	AOJA T,DSBLK3

DSBLK4:	TRO FF,FRFIRWD
	MOVEI A,BKBUF+1
	MOVEM A,OPT1
	POPJ P,

; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK.

EDSBLK:	MOVE A,OPT1
	CAIN A,BKBUF+1
	 JRST EBLK5	;AVOID SETTING $FLOUT IF NULL BLOCK.
	PUSHJ P,DSBLK2
	JRST EBLK4
;END A BLOCK IN DEC FMT. COME FROM EBLK.
DECEBL:	PUSH P,[EBLK5]
DECEB1:	MOVSI A,DECWDS	;JUST INIT. AN ORDINARY BLOCK,

;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A.
DECBLK:	PUSH P,A
	HRRZ A,BKBUF	;GET DATA-WORD COUNT OF CURRENT BLOCK.
	JUMPE A,DECB1	;NO WORDS => CAN IGNORE.
	MOVEI TT,BKBUF+1
DECB0:	MOVE A,-1(TT)	;GET AND PUNCH NEXT WD OF BLOCK.
	PUSHJ P,PPB
	CAME TT,OPT1	;STOP WHEN NEXT WD ISN'T IN BLOCK.
	 AOJA TT,DECB0
DECB1:	POP P,A
	HLLZM A,BKBUF	;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0.
	MOVEI TT,BKBUF+2	;ADDR OF PLACE FOR 1ST DATA WD
	MOVEM TT,OPT1		;(LEAVE SPACE FOR WD OF RELOC BITS)
	MOVE TT,[440200,,BKBUF+1]
	MOVEM TT,BITP	;BP FOR STORING PAIRS OF RELOC BITS.
	SETZM BKBUF+1	;CLEAR THE WD OF RELOC BITS.
	TLO FF,$FLOUT
	POPJ P,

;COME HERE TO OUTPUT A WORD IN DEC FORMAT.
DECPW:	MOVS A,BKBUF
	CAIE A,DECWDS	;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK,
	 JRST DECPW0
	MOVE A,CRLOC	;MUST GO THE LOCATION CTR.
	IDPB A,BITP
	MOVE A,CLOC
	MOVEM A,@OPT1
	AOS OPT1
	AOS BKBUF	;IT COUNTS AS DATA WORD.
DECPW0:	MOVE A,BITP
	TLNE A,77^4	;IF NO ROOM FOR MORE RELOC BITS,
	 JRST DECPW1
	HLLZ A,BKBUF	;START A NEW BLOCK.
	PUSHJ P,DECBLK
	JRST DECPW

DECPW1:	PUSHJ P,$RSET	;SET UP RELOC BITS OF HALVES IN B,C.
	LSH C,1
	IORI B,(C)	;COMBINE THEM.
	MOVE A,GLSP1
	CAME A,GLSP2
	 JRST DECPG	;GO HANDLE GLOBALS.
DECPW3:	IDPB B,BITP	;STORE THE RELOC BITS
	MOVE A,WRD
DECPW2:	MOVEM A,@OPT1	;AND THE VALUE.
	AOS OPT1
	AOS BKBUF
	POPJ P,
;PUT A WORD DIRECTLY INTO DEC FMT BLOCK.
DECWRD:	SETZ TM,
DECWR1:	IDPB TM,BITP	;SKIP A PAIR OF RELOC BITS,
	JRST DECPW2	;STORE THE WORD.

;HANDLE GLOBAL REFS IN DEC FMT.
DECPG:	PUSHJ P,DECPW3	;FIRST, OUTPUT THE WORD,
DECPG0:	MOVSI A,DECSYM
	PUSHJ P,DECBLK	;THEN STRT A SYMBOLS BLOCK.
	MOVE C,GLSP2
	PUSH P,SYM
DECPG1:	CAMN C,GLSP1	;ALL DONE =>
	 JRST DECPG2	;GO START AN ORDINARY BLOCK FOR NEXT WD.
	MOVE A,BITP
	TLNN A,77^4	;BLOCK FULL => START ANOTHER.
	 JRST DECPG0
	AOS C,GLSP2	;GET ADDR OF NEXT GLOBAL REF.
	MOVE B,(C)
	MOVE B,(B)	;GET NAME OF SYM.
	TLZ B,740000
	CAMN B,[SQUOZE 0,$R.]
	 JRST DECPG3	;(DEC'S LOADER HAS NO SUCH HACK.)
	CALL ASQOZR	;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM.
	MOVE A,B
	TLO A,600000	;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ.
	PUSHJ P,DECWRD	;OUTPUT NAME.
	HRRZ A,CLOC	;GET ADDR OF RQ,
	TLO A,400000	;MACRO-10 SETS THIS BIT SO I WILL.
	MOVE B,(C)
	TLNE B,SWAPF	;SWAPPED => TELL LOADER..
	 TLO A,200000
	TLNE B,ACF+MINF
	 ETSM ERRILG	;CAN'T NEGATE GLOBAL OR PUT IN AC.
	MOVE TM,CRLOC
	PUSHJ P,DECWR1	;OUTPUT 2ND WD,
	JRST DECPG1	;GO BACK FOR MORE GLOBAL REFS.

DECPG2:	REST SYM
	JRST DECEB1

DECPG3:	ETR ERRIRL	;WE NEEDED $R. BUT DIDN'T HAVE IT.
	JRST DECPG1

ERRILG:	ASCIZ /Illegal use of external/
ERRIRL:	ASCIZ /Illegal use of relocatables/


;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2)
;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG)
DECPGN:	JUMPGE FF,CPOPJ	;ONLY ON PASS 2.
	PUSH P,[EBLK]
	MOVSI A,DECNAM
	CALL DECBLK
	MOVE B,PRGNM
	CALL ASQOZR
	MOVE A,B
	CALL DECWRD
	MOVSI A,14	;IDENTIFY THIS REL FILE AS MADE BY MIDAS.
	CALL DECWRD
	MOVE A,DECTWO
	CAMN A,[MOVE]
	 RET		;NOT A 2-SEG PROGRAM.
DECP2S:	MOVSI A,DECHSG
	CALL DECBLK	;START A LOAD-INTO-HISEG BLOCK.
	MOVE A,DECTWO
	HRL A,DECBRH	;HISEG BRK,,TWOSEG ORIGIN.
	SKIPL A
	 HRLI A,(A)
	MOVEI TM,1	;RELOCATION IS 1.
	JRST DECWR1
IFN FASLP,[
;INITIALIZE OUTPUT FOR FASL ASSEMBLY
FASOIN:	JUMPGE FF,CPOPJ	;ONLY ON PASS 2
	MOVE A,[SIXBIT /*FASL*/]
	PUSHJ P,PPB
	MOVE A,[MIDVRS]
	LSH A,-6
	TLO A,(SIXBIT /M/)
	PUSHJ P,PPB	;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER)
	MOVE A,[440400,,FASB]	;INITIALIZE FASL OUTPUT BUFFER
	MOVEM A,FASCBP
	MOVEI A,FASB+1
	MOVEM A,FASBP
	POPJ P,


;COME HERE TO OUTPUT A WORD IN FASL FORMAT
FASPW:	MOVE C,FASPCH
	CAME C,FASATP
	 PUSHJ P,FPATB	;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED)
	PUSHJ P,$RSET	;GET RELOC
	PUSH P,C	;SAVE LH RELOC
	MOVEM B,FASPWB	;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1
	MOVE A,GLSP2
FASPW3:	CAME A,GLSP1
	 JRST FASPW1	;LOOK TO SEE ..
FASPW2:	MOVE A,WRD	;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE
	MOVE B,FASPWB
	PUSHJ P,FASO	;OUTPUT WORD IN A WITH FASL CODE IN B
	POP P,TM
	JUMPE TM,FASPW5	;NO LEFT HALF RELOC, OK
	MOVNI A,1	;ACTIVATE FASL HACK FOR LH RELOC
	MOVEI B,7	;WOULD OTHERWISE BE GETDDTSYM
	PUSHJ P,FASO
FASPW5:	MOVE C,GLSP2
FASPW6:	CAMN C,GLSP1
	 POPJ P,
	HRRZ TM,1(C)
	JUMPE TM,[AOJA C,FASPW6]
	MOVE SYM,(TM)	;GET SQUOZE OF SYM
	TLZ SYM,740000	;CLEAR CODE BITS
	HLRZ D,1(C)
	TRZ D,400000	;DONT WORRY ABOUT THAT BIT
	TRZE D,MINF
	TLO SYM,400000	;NEGATE
	CAIN D,SWAPF
	 JRST FSPWSW
	CAIN D,HFWDF
	 JRST FSPWRH
	CAIN D,ACF+SWAPF
	 JRST FSPWAC
	JUMPE D,FSPWWD
	ETSM [ASCIZ /Global in illegal FASL context/]

FSPWWD:	TLOA SYM,140000
FSPWAC:	 TLOA SYM,100000
FSPWRH:	  TLO SYM,40000
FSPWSW:	MOVE A,SYM
	MOVEI B,7	;DDT SYM
	PUSHJ P,FASO
	AOJA C,FASPW6

FASPW1:	HRRZ TM,1(A)	;GLOTB ENTRY
	JUMPE TM,FASPW4
	CAIL TM,AFDMY1
	 CAIL TM,AFDMY2
FASPW4:	  AOJA A,FASPW3
	MOVE C,1(A)	;ITS A LIST STRUCTURE REF
	TLNN C,-1-HFWDF
	 SKIPE FASPWB
	  ETA [ASCIZ /Illegal LISP structure reference/]
	MOVE TM,AFDMY2-AFDMY1(TM)	;GET FASL BITS
	MOVEM TM,FASPWB		;FASL BITS
	CLEARM 1(A)		;FLUSH THAT GUY
	AOJA A,FASPW3

FPATB:	CAMN C,FASATP	;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C
	 POPJ P,		;THRU
	MOVEI B,12	;ATOM TBL INFO
	MOVE A,FASAT(C)
	TRNN A,-1
	 AOJA C,FPATB3	;LIST WORD .. SHOULD HAVE PUNCHED ITSELF
	PUSHJ P,FASO
	HRRZ D,FASAT(C)	;ATOM "LENGTH"
	AOS C
FPATB1:	SOJL D,FPATB2
	MOVE A,FASAT(C)
	PUSHJ P,FASO1
	AOJA C,FPATB1

FPATB3:	ETR [ASCIZ /Internal loss at FPATB3/]
FPATB2:	MOVEM C,FASPCH	;RECORD AMOUNT PUNCHED
	JRST FPATB	;LOOP BACK IF MORE


FASO:	PUSHJ P,FASBO	;WRITE BITS
FASO1:	MOVEM A,@FASBP	;STORE A IN FASL OUTPUT BUFFER
	AOS TM,FASBP
	CAIL TM,FASB+FASBL
	 ETF [ASCIZ /.FASL output block too long/]
	POPJ P,

FASBO:	MOVE TM,FASCBP	;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC
	TLNN TM,770000
	 PUSHJ P,FASBE	;WRITE PREV FASL BLOCK
	IDPB B,FASCBP
	POPJ P,

FASBE:	PUSH P,A
	PUSH P,B
	MOVEI TT,FASB
FASBO2:	CAML TT,FASBP
	 JRST FASBO3
	MOVE A,(TT)
	PUSHJ P,PPB
	AOJA TT,FASBO2

FASBO3:	POP P,B
	POP P,A
	CLEARM FASB	;NEW CODE WORD
	MOVEI TM,FASB+1
	MOVEM TM,FASBP
	SOS FASCBP
	POPJ P,
AFATOM:	PUSH P,B	;SAVE CODEBITS
	SKIPGE B,CONTRL
	TRNN B,FASL
	 ETI [ASCIZ /.ATOM illegal except in FASL assembly/]
	PUSHJ P,AFRATM	;READ "ATOM", RETURN INDEX IN A
	POP P,B
	HLRZS B
AFLST1:	AOS GLSP1
	MOVEI T,AFDMY1(B)	;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN
	HRRZM T,@GLSP1
	MOVEI B,0	;NO RELOCATION
	POPJ P,

;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS
;UNDEF GLOBAL GODEBITS
AFDMY1:	SQUOZE 44,.%VCEL	;EVENTUALLY POINT TO VALUE CELL
	SQUOZE 44,.%SCAL	;EVENTUALLY BECOME "SMASHABLE CALL"
	SQUOZE 44,.%ATM		;EVENTUALLY POINT TO ATOM
	SQUOZE 44,.%ARY		;EVENTUALLY POINT TO ARRAY
AFDMY2:	2			;CODE BITS FOR VALUE CELL REF
	3			;CODE BITS FOR SMASHABLE CALL
	4			;CODE BITS FOR POINTER TO ATOM
	10			;CODE BITS FOR POINTER TO ARRAY

AFRATM:	PUSHJ P,AFRTKN		;READ TOKEN, LEAVING IT AT END OF FASAT
	PUSHJ P,AFRITN		;"INTERN" IT, SKIP IF NOT FOUND
	 POPJ P,		;IF FOUND, INDEX IN A
	PUSHJ P,AFRENT		;ENTER IN FASAT
	POPJ P,

AFRENT:	MOVE A,FASAT1		;STORE FASAT1 IN FASATP
	MOVEM A,FASATP
	AOS A,FASIDX		;RETURN LOAD TIME ATOM INDEX
	POPJ P,

AFRTKN:	MOVE A,FASATP
	ADD A,[700,,FASAT]
	MOVEM A,FASAT2		;BYTE PNTR TO USE TO STORE ATOM
	CLEARM (A)
	CLEARM 1(A)		;MAKE SURE ALL LOW BITS CLEARED
	PUSHJ P,RCH
	CAIN A,"#
	 JRST AFRTK1		;READ NUMBER INTO FIXNUM SPACE
	CAIN A,"&
	 JRST AFRTK2		;READ NUMBER INTO FLONUM SPACE
AFRTKL:	IDPB A,FASAT2		;STORE CHAR
	HRRZ A,FASAT2
	CAIL A,FASAT+FASATL-1
AFTERR:	 ETA [ASCIZ /LISP atom name table full/]
	CLEARM 1(A)
AFRTL2:	PUSHJ P,RCH
	CAIN A,12
	 JRST AFRTL2		;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE
	CAIN A,"/		;SLASH
	 JRST AFRQT		;QUOTE CHAR
	CAIE A,40
	 CAIN A,15
	  JRST AFREND
	CAIE A,";
	 CAIN A,11
	  JRST AFREND
	CAIE A,"(
	 CAIN A,")
	  JRST AFREN2
	CAIL A,"A+40
	 CAILE A,"Z+40
	  JRST AFRTKL		;THAT CHAR WINS, SALT IT
	SUBI A,40
	JRST AFRTKL		;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT.

AFRQT:	PUSHJ P,RCH		;TAKE NEXT CHR NO MATTER WHAT
	JRST AFRTKL

AFRTK1:	SKIPA TM,[100000,,1]	;PUT VAL IN FIXNUM SPACE
AFRTK2:	MOVE TM,[200000,,1]	;PUT IT IN FLONUM SPACE
	PUSH P,TM
	MOVE SYM,[SQUOZE 0,ATOM]
	PUSHJ P,FAGTFD
	POP P,TM
	MOVE B,FASATP
	ADDI B,2
	CAIL B,FASAT+FASATL
	 XCT AFTERR
	MOVEM TM,FASAT-2(B)
	MOVEM A,FASAT-1(B)
	MOVEM B,FASAT1
	POPJ P,			

AFREN2:	TLO FF,FLUNRD		;SAVE ( OR ) AS WELL AS FLUSHING
AFREND:	MOVEI B,5		;PAD END OF P.N. WITH 0 S
	MOVEI TM,0
AFREN1:	IDPB TM,FASAT2
	HRRZ A,FASAT2
	CAIL A,FASAT+FASATL-1
	 XCT AFTERR
	CLEARM 1(A)
	SOJG B,AFREN1
	SUBI A,FASAT
	MOVEM A,FASAT1		;STORE PNTR TO WORD BEYOND ATOM
				; MAYBE PUT THIS IN FASATP
	MOVE B,FASATP		;ADR OF START OF ATOM READ
	SUBI A,1(B)		;COMPUTE LENGTH OF FASAT
	HRRZM A,FASAT(B)	;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD
	
	POPJ P,	

AFRITN:	MOVEI B,0		;"INTERN" LAST ATOM READ IN
	MOVEI A,1		;A CONTAINS RUNTIME ATOM TBL INDEX
				;B INDEX WITHIN FASAT
AFRIT1:	CAML B,FASATP
	 JRST POPJ1		;NOT FOUND
	MOVE C,FASATP		;POINTS AT HEADER OF WORD OF NEW (?) ATOM
	HRRZ D,FASAT(B)		;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH)
	JUMPE D,AFRIT4		;JUMP ON RESERVED FOR LIST
AFRIT2:	MOVE TM,FASAT(C)
	CAME TM,FASAT(B)
	 AOJA B,AFRIT3		;THIS ONE LOSES
	SOJL D,CPOPJ			;THIS ONE WINS!
	AOS B
	AOJA C,AFRIT2

AFRIT3:	SOJL D,[AOJA A,AFRIT1]		;FINISH SPACING OVER THIS GUY
AFRIT4:	AOJA B,AFRIT3

AFENTY:	SKIPGE B,CONTRL
	TRNN B,FASL
	 ETI [ASCIZ /.ENTRY in NON-FASL/]
	SKIPN CRLOC
	 ETI [ASCIZ /.ENTRY when . is absolute/]
	PUSHJ P,AFRATM		;READ FUNCTION NAME
	HRLZS A
	PUSH P,A
	PUSHJ P,AFRATM		;READ TYPE (SUBR, LSUBR, ETC)
	HRRM A,(P)
	MOVE SYM,[SQUOZE 0,.ENTRY]
	PUSHJ P,FAGTFD		;READ ARGS PROP
	JUMPGE FF,ASSEM1	;NOT PUNCHING PASS
	PUSH P,A	
	MOVE C,FASPCH
	CAME C,FASATP
	 PUSHJ P,FPATB		;MAKE SURE ANY NEW ATOMS OUT
	POP P,C
	POP P,A
	MOVEI B,13
	PUSHJ P,FASO
	HRL A,C
	HRR A,CLOC
	PUSHJ P,FASO1
	JRST ASSEM1

AFLIST:	HLRZM B,AFLTYP
	SKIPGE B,CONTRL
	 TRNN B,FASL
	  ETI [ASCIZ /.LIST illegal except in FASL assembly/]
	PUSHJ P,AFRLST	;READ LIST, RTN ATM TBL INDEX IN A
	SKIPN AFLTYP
	 JRST ASSEM1	;JUST EVAL IN LISP AND THROW AWAY VALUE
	MOVEI B,AFDMAI	;"ATOM" INDEX IN AFDMY1 TBL
	JRST AFLST1	;TREAT AS ATOM

AFRLST:	CLEARM AFRLD	;"DEPTH"
	CLEARM AFRLEN	;"LENGTH" OF LIST AT CURRENT LEVEL
	CLEARM AFRDTF	;DOT CONTEXT FLAG
	JUMPGE FF,AFRLI1
	MOVE C,FASPCH
	CAME C,FASATP
	 PUSHJ P,FPATB	;MAKE SURE ALL ATOMS "PUNCHED"
	MOVE A,FASATP
	MOVEM A,AFRFTP	;SAVED STATE OF FASAT POINTER
	MOVE C,AFLTYP
	MOVEI B,16	;EVAL TYPE HACK
	CAIN C,1
	 MOVEI B,5	;LIST TYPE HACK
	PUSHJ P,FASBO	;WRITE CODE BITS
AFRLI1:
AFRL1:	PUSHJ P,RCH
	CAIE A,40	;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS
	 CAIN A,15	;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING
	  JRST AFRL1A
	CAIE A,11
	 CAIN A,12
	  JRST AFRL1A
	CAIN A,"(
	 JRST AFRLO
	CAIN A,")
	 JRST AFRLC
	CAIN A,".
	 JRST AFRDT	;DOT..
	TLO FF,FLUNRD
	SKIPE AFRLD
	 JRST AFRNXT	;READ NEXT GUY THIS LVL
	SKIPE AFRLEN
AFRLO2:	 ETI [ASCIZ /LISP read context error/]
AFRNXT:	SKIPN TM,AFRDTF
	 JRST AFRNX2	;NOT HACKING DOTS, OK
	AOS TM,AFRDTF
	CAIE TM,2
	 JRST AFRLO2	;DIDNT JUST SEE THE DOT
AFRNX2:	PUSHJ P,AFRATM
	JUMPGE FF,AFRNX1	;XFER ON NOT PUNCHING PASS
	PUSHJ P,FASO1	;TELL LOADER TO PUSH THIS ON ITS STACK
AFRNX1:	AOS AFRLEN	;LIST NOW ONE LONGER THIS LVL
	JRST AFRL1

AFRLO:	SKIPN TM,AFRDTF
	 JRST AFRLO3	;NOT HACKING DOTS
	SOJN TM,AFRLO2
	CLEARM AFRDTF
	JRST AFRL1	;IGNORE BOTH . AND (	

AFRLO3:	SKIPE AFRLD	;(
	 JRST AFRLO1
	SKIPE AFRLEN
	 JRST AFRLO2
AFRLO1:	PUSH P,AFRLEN
	CLEARM AFRLEN	;START NEW LVL
	AOS AFRLD	;DEPTH NOW ONE GREATER
	JRST AFRL1

AFRLC:	SOSGE AFRLD	;)
	 JRST AFRLO2	;AT TOP LEVEL, BARF
	MOVE A,AFRLEN
	SKIPN TM,AFRDTF
	 JRST AFRLC2	;NOT HACKING DOTS
	CAIE TM,2
	 JRST AFRLO2
	SOS A		;MAIN LIST NOW ONE SHORTER
	TLOA A,200000	;DOT WITH LAST THING ON STACK
AFRLC2:	TLO A,100000	;TELL LOADER TO MAKE LIST THIS LONG
	JUMPGE FF,AFRLC5
	PUSHJ P,FASO1
AFRLC5:	POP P,AFRLEN	;LENGTH AT PREV LVL
	AOS AFRLEN	;NOW ONE MORE
	CLEARM AFRDTF	;NOT HACKING DOTS NOW
	SKIPE AFRLD	;RETURNING TO TOP LEVEL?
	 JRST AFRL1
	JRST AFRX1	;YES THRU

AFRDT:	SKIPN AFRDTF
	 SKIPN AFRLEN
	  JRST AFRLO2	;DOT IN FIRST POSITION OF LIST
	AOS AFRDTF	;ENTER STATE 1 OF DOT HACKING
	JRST AFRL1

AFRL1A:	SKIPN AFRLD	;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING
	 SKIPN AFRLEN
	  JRST AFRL1
AFRX1:	JUMPGE FF,AFRX2	;NOT PUNCHING PASS
	MOVE A,AFRFTP
	CAME A,FASATP
	 ETR [ASCIZ /Saw atoms in list on pass 2 for first time/]
	SKIPN B,AFLTYP	;TYP LIST OP
	 SKIPA A,[-1,,]
	  MOVSI A,-2	;PUT LIST OR VALUE OF LIST IN ATOM TBL
	PUSHJ P,FASO1	;TERM OP AND PUT IT IN ATOM TBL
	MOVEI A,0
	MOVE B,AFLTYP
	JUMPE B,CPOPJ	;JUST WANT VALUE OF LIST
	CAIN B,1	;ONLY WANT THIS FOR STRAIGHT LIST
	 PUSHJ P,FASO1	;OUTPUT "SXHASH" WORD
	AOS A,FASATP
	CLEARM FASAT-1(A)	;RESERVE SLOT IN FASAT TBL
	MOVEM A,FASPCH		;SAY ALREADY PUNCHED OUT
	AOS A,FASIDX
	POPJ P,		

AFRX2:	TLO I,ILNOPT	;DONT TRY TO OPTIMIZE IF IN CONSTANT
	CLEARB A,B
	POPJ P,
]
;.LIBRA, .LIFS, ETC.

A.LIB:	NOVAL ? NOABS
	HLRZM B,LIBTYP'	;STORE BLOCK TYPE TO OUTPUT
	CLEARM LIBOP	;INITIALIZE SQUOZE FLAGS
	PUSHJ P,EBLK	;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $.
LIB1:	PUSHJ P,GETSYL	;GET NAME
	TRNN I,IRSYL
	 JRST LIB2	;NO SYL, DON'T OUTPUT
	IOR SYM,LIBOP
	TLO SYM,40000
	PUSHJ P,OUTSM
	MOVSI A,400000
	ANDCAM A,LIBOP
LIB2:	MOVE B,CDISP	;GET CDISP
	TLNN B,DWRD\DFLD	;CHECK FOR WORD TERMINATOR
	 JRST LIB3	;WORD TERMINATOR => DONE
	MOVE A,LIBOP
	MOVE B,LIMBO1	;RETRIEVE LAST CHAR READ
	CAIN B,",
	 MOVSI A,400000
	CAIN B,"+
	 TLZ A,200000
	CAIN B,"-
	 TLO A,200000
	MOVEM A,LIBOP'	;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM
	JRST LIB1

LIB3:	MOVE A,LIBTYP	;GET BLOCK TYPE TO OUTPUT
	DPB A,[310700,,BKBUF]
	PUSHJ P,EBLK
	CAIN A,LLIB	;.LIBRA?
	 JRST ARELC1	;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO
	JRST LIB5	;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS

A.ELDC:	NOVAL ? NOABS
	PUSHJ P,EBLK
	MOVEI A,ELTCB
	DPB A,[310700,,BKBUF]
	TRO FF,FRLOC	;MAKE EBLK OUTPUT NULL BLOCK
	PUSHJ P,EBLK
	SOSGE LDCCC
	 CLEARM LDCCC	;LOADER CONDITIONAL UNDERFLOW
	JRST ASSEM1

		;LOADER CONDITIONAL ON VALUE

A.LDCV:	NOVAL ? NOABS
	LSH B,-27.
	PUSH P,B
	PUSHJ P,AGETWD
	POP P,B
	DPB B,[400300,,BKBUF]
	MOVEI A,LDCV
	PUSHJ P,PLDCM
	MOVEI A,0
	DPB A,[400300,,BKBUF]
LIB5:	AOS LDCCC
CCASM1:	JRST ASSEM1
;.GLOBAL, .SCALAR, .VECTOR
;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY.
;   Note that use of ILFLO flag is a crock here.

A.GLOB:	NOVAL
	HLLZ LINK,B	;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS.
A.GLO2:	MOVE A,GLSPAS
	MOVEM A,GLSP1
	SETOM FLDCNT
	PUSHJ P,GETSLD	;GET NAME
	 JRST MACCR	;NO NAME => DONE
	CALL ES
	 JRST A.GLO1
	CAIE A,PSUDO_-14.
	 JRST A.GLO1
	JSP B,GVPSEU	;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN.
	JRST A.GLO2	;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG.

A.GLO1:	IOR I,LINK	;SET THE GLOBAL FLAG OR THE VARIABLE FLAG.
	TLNE LINK,ILVAR	;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE.
	 PUSH P,VARCNT	;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT.
	PUSHJ P,GETVAL	;NOW GET VALUE (CLOBBERS SQUOZE FLAGS)
	 CAIA
	  HALT
	TLNN LINK,ILVAR	; THAT'S IT IF .GLOBAL, ELSE CONTINUE
	 JRST A.GLO2
	PUSH P,LINK	;.VECTOR OR .SCALAR, MUST READ THE SIZE.
	TLO FF,FLUNRD	;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN
	MOVE SYM,[SQUOZE 0,.SCALAR]
	TLNE LINK,ILFLO		; USE RIGHT SYM
	 MOVE SYM,[SQUOZE 0,.VECTOR]
	CALL AGETFD
	REST LINK
	REST B		;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED.
	TRNN A,-1	;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0.
	 HLRZS A
	JUMPN A,A.GLO3	;JUMP IF NONZERO SIZE SPEC'D
	TLNN LINK,ILFLO	; ZERO, USE DEFAULT
	 JRST A.GLO2	; WHICH IS ALWAYS 1 FOR .SCALAR
	SKIPA A,VECSIZ	; AND VECSIZ FOR .VECTOR.
A.GLO3:	TLNE LINK,ILFLO	;NONZERO SIZE, SO
	 MOVEM A,VECSIZ	;DEFAULT MUST BE REMEMBERED FOR .VECTOR.
	SUBI A,1	;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED?
	CAME B,VARCNT	;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...)
	 ADDM A,VARCNT	;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE
	JRST A.GLO2	;RIGHT AMOUNT.

		;.LOP

A.LOP:	NOVAL ? NOABS
	PUSHJ P,EBLK	;TERMINATE CURRENT BLOCK
	REPEAT 3,PUSHJ P,RGETFD	;GET THE FIELDS
	MOVEI A,LD.OP
	PUSHJ P,PLDCN
	JRST ASSEM1

		;.LIBRQ

A.LIBRQ:	NOVAL ? NOABS
A.LBR1:	PUSHJ P,GETSLD
	 JRST MACCR
	PUSHJ P,PBITS7
	MOVEI A,3
	PUSHJ P,PBITS
	TLO SYM,40000
	PUSHJ P,OUTSM
	JRST A.LBR1
A.LNKOT:	AOS (P)	;THIS PSEUDO RETURNS NO VALUE.
	NOVAL

AEND5:	JUMPGE FF,CPOPJ	;IGNORE FOLLOWING ON NOT PUNCHING PASS
	MOVE D,SYMAOB
AEND5A:	MOVE SYM,ST(D)
	LDB T,[400400,,SYM]
	CAIE T,DEFLVR_-14.
	 CAIN T,DEFGVR_-14.
	  JRST AEND5E
	CAIE T,LCUDF_-14.
	 CAIN T,GLOEXT_-14.
	  JRST AEND5B
AEND5C:	ADD D,WPSTE1
	AOBJN D,AEND5A
	POPJ P,

AEND5E:	3GET C,D
	TLNN C,3LLV
	 JRST AEND5C
AEND5B:	HLLZ B,ST+1(D)
	3GET C,D
	TLNN C,3RLNK
	 JUMPE B,AEND5C
	TLZ SYM,740000
	CAIE T,LCUDF_-14.
	 CAIN T,DEFLVR_-14.
	  SKIPA
	   TLO SYM,40000
	PUSHJ P,LKPNRO
	HRRZS ST+1(D)	;CLEAR OUT LIST HEAD POINTER.
	TLZ C,3RLNK	;INDICATE NO LIST.
	3PUT C,D
	JRST AEND5C

		;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS

PLDCM:	PUSH P,LINK	;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S)
	PUSH P,A	;SAVE LOADER COMMAND TYPE
	PUSHJ P,EBLK	;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $.
	PUSHJ P,PWRDA	;PUNCH OUT THE WORD
	POP P,A		;GET BACK LOADER COMMAND TYPE FOR PLDCN
	PUSHJ P,PLDCN	;OUTPUT THE RESULTING BLOCK
PLINKJ:	POP P,LINK	;RESTORE LINK
	POPJ P,

PLDCN:	HRRM A,BKBUF	;STORE LOADER COMMAND TYPE IN BKBUF HEADER
	MOVEI A,LLDCM	;LOADER COMMAND BLOCK TYPE
	DPB A,[310700,,BKBUF]	;STORE BLOCK TYPE IN HEADER
	TRO FF,FRLOC	;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY
	JRST EBLK

;.RELP <ARG> RETURNS RELOCATION OF ARG
A.RELP:	CALL AGETFD
	MOVE A,B
	JRST VALRET

;.ABSP <ARG> RETURNS ABSOLUTE PART OF ARG.
A.ABSP:	CALL AGETFD
	JRST VALRET

;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE.
;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO.
;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY.
A.RL1:	SKIPGE A,CONTRL
	 TRNE A,DECREL\FASL
	  SKIPA B,[1]
	   SETZ B,
	SETZ A,
	RET
AEND:	NOVAL
	SKIPE ASMOUT	; ERROR IF IN GROUPING.
	 JSP LINK,CONFLM	;FLUSH CONSTANTS, GIVE ERROR MSG.
	SKIPE SCNDEP	;IF THERE ARE UNTERMINATED SUCCESSFUL
	 CALL AENDM1	;CONDITIONALS, MENTION THEM.
	MOVE A,BKCUR
	CAIE A,BKWPB	;NOT IN .MAIN BLOCK => ERROR.
	 ETR ERRUMB
	MOVE A,CDISP
	TLNN A,DWRD
	 TLO FF,FLUNRD	;IF LAST TERM. WAS WORD TERM., RE-READ.
IFN LISTSW,[
	MOVE A,[440700,,LISTBF]
	EXCH A,PNTBP
	MOVEM A,LISTTM
]
	PUSHJ P,AVARI0
	PUSHJ P,CNSTN0
	SKIPL A,CONTRL
	 JRST [	PUSHJ P,AEND5	; STINK RELOCATABLE => .LNKOT
		JRST AEND6]
	TRNE A,DECSAV		; IF DECSAV FMT,
	 JRST [	MOVE A,CLOC	; USE LOC COUNTER AT END AS LOC OF SYMBOLS
		SKIPN DECSYA	; UNLESS LOC ALREADY SPECIFIED.
		 MOVEM A,DECSYA
		JRST AEND6]
	TRNN A,DECREL
	 JRST AEND6
	MOVE A,CLOC	;IN DEC FMT, UPDATE HIGHEST ADDR SEEN,
	SKIPN CRLOC	;UPDATE EITHER THE HIGHEST ABS ADDR
	 JRST [	CAML A,DECBRA
		 MOVEM A,DECBRA
		JRST AEND6]
	CAML A,DECTWO	;OR THE HIGHEST REL ADDR IN THE
	 JRST [	CAML A,DECBRH	;APPROPRIATE SEG.
		 MOVEM A,DECBRH
		JRST AEND6]
	CAML A,DECBRK
	 MOVEM A,DECBRK
AEND6:	JUMPL FF,AEND1	;ON PUNCHING PASS, SPECIAL STUFF 
	PUSHJ P,GETWRD	;OTHERWISE EAT UP WORD,
	JRST RETURN	;AND RETURN

AEND1:	PUSHJ P,EBLK
IFN LISTSW,[
	SKIPGE LISTPF
	 PUSHJ P,PNTR
	MOVE A,LISTTM
	MOVEM A,PNTBP
]
	MOVE SYM,[SQUOZE 0,END]
	TLZ I,ILWORD
	PUSHJ P,AGETWD
IFN LISTSW,[
	MOVEM A,LISTWD
	MOVEM B,LSTRLC
	SETOM LISTAD
	SETOM LISTPF
	SKIPE LSTONP
	PUSHJ P,PNTR
	SKIPE LISTP
	 PUSHJ P,LPTCLS	;DONE LISTING
	MOVE A,LISTWD
] ;END IFN LISTSW,
	SKIPL B,CONTRL
	 JRST AEND3	;RELOCATABLE
IFN FASLP,[
	TRNE B,FASL
	 JRST FASEN	;FASL FORM
]
	TRNE B,DECSAV
	 JRST AEND4
	TRNN B,DECREL	;IF DEC FORMAT,
	 JRST AEND1A
	TLNN I,ILWORD	;THEN IF THERE7S A STARTING ADDRESS,
	 JRST AEND2
	MOVSI A,DECSTA	;OUTPUT START-ADDRESS BLOCK.
	PUSHJ P,DECBLK
	PUSHJ P,PWRD
	PUSHJ P,EBLK
	JRST AEND2

IFN FASLP,[
FASEN:	JRST AEND2
]

AEND3:	HRRZ A,CLOC
	HRRM A,BKBUF	;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS
	MOVEI A,LCJMP
	PUSHJ P,PLDCM
	JRST AEND2

	; HERE FOR DECSAV FORMAT.
AEND4:	TLNE A,-1
	 JRST AEND1B	; IF SOMETHING IN LH, MAY BE ENTRY VECTOR.
	MOVE B,A
	MOVE A,[-1,,120-1]	; NOTHING, SO ASSUME SIMPLE JRST. MUST
	PUSHJ P,PPB		; FIRST SAVE S.A. IN .JBSA CROCK.
	MOVE A,B
	PUSHJ P,PPB
	TLO A,(JRST)	; FURNISH JRST FOR PUTTING AT END OF OUTPUT.
	JRST AEND1B

AEND1A:			; CHECK WORD AND MAYBE MAKE IT A JRST
	TLNN A,777000	; CHECK INSTRUCTION PART
	 TLO A,(JRST)	; WANTS JRST
	PUSHJ P,PPB
AEND1B:	JUMPG A,.+3
	 ETR [ASCIZ /Start instruction negative/]
	HRLI A,(JRST)	;END SYMTAB WITH POSITIVE WORD
	MOVEM A,STARTA	;SAVE FOR PUNCHOUT AT END OF SYMTAB
	PUSHJ P,FEED1
AEND2:	PUSH P,[RETURN]
CNARTP:
IFN DECSW\TNXSW,[
	PUSH P,TTYFLG
	SKIPE CCLFLG	;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT
	 AOS TTYFLG	;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING.
	CALL CNTPD
	REST TTYFLG
	RET

CNTPD:
]
	MOVNI D,1
	MOVEI TT,PCNTB
CNTP1:	CAML TT,PBCONL
	 RET
	HRRZ B,1(TT)
	HLRZ A,1(TT)
	CAMN A,B
	 JRST CNTP2
	AOSN D
	 TYPR [ASCIZ /Constants area inclusive
From	To
/]
	LDB B,[.BP (CGBAL),2(TT)]
	SKIPE B
	 TYPR [ASCIZ /Global+/]
	HRRZ B,1(TT)
	PUSHJ P,OCTPNT
	PUSHJ P,TABERR
	HLRZ B,1(TT)
	SOS B
	PUSHJ P,OCTPNT
	PUSHJ P,CRRERR
CNTP2:	ADDI TT,3
	JRST CNTP1

AENDM1:	TYPR [ASCIZ /Unterminated successful bracketed conditionals
The first was at /]
	AOS A,CONDPN
	CALL DPNT
	MOVEI A,"-
	CALL TYOERR
	AOS A,CONDLN
	CALL D3PNT2
IFN TS,[
	TYPR [ASCIZ/ of file /]
	MOVE B,CONDFI
	CALL SIXTYO
]
	JRST CRRERR
AXWORD:	CALL XGETFD	;READ 1ST FIELD,
	TLNE I,ILMWRD
	 CALL IGTXT	;SOAK UP REST OF TEXT PSEUDO.
	HRLM A,WRD
	HRLM B,WRDRLC
	MOVSI C,HFWDF
	MOVSI B,SWAPF
	PUSHJ P,LNKTC1
	PUSH P,GLSP1
	CALL XGETFD	;NOW THE SECOND FIELD
	HRRM A,WRD
	HRRES B
	ADDM B,WRDRLC
	MOVSI C,HFWDF
	MOVEI B,0
	POP P,T
	PUSHJ P,LINKTC
	JRST CABPOP
	
A.NTHWD:CALL AGETFD		;READ THE NUMBER OF THE WORD WE WANT.
	SOJL A,CABPOP		;NEGATIVE OR 0 => RETURN 0.
	SOJL A,A.1STWD		;1 => TURN INTO .1STWD.
			;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD.

A.NTH1:	PUSH P,A
	PUSH P,WRD
	CALL XGETFD
	TLZ FF,FLUNRD
	REST WRD
	REST A
	TLNN I,ILMWRD
	 JRST CABPOP		;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0.
	SOJGE A,A.NTH1

A.1STWD:	CALL XGETFD	;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO,
	CALL IGTXT	;THROW AWAY THE REST.
	MOVE T,A	;RETURN THE VALUE
	JRST TEXT5	;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE.

A.LENGTH:	CALL PASSPS
	PUSH P,[0]
	PUSH P,A
A.LN1:	PUSHJ P,RCH
	AOS -1(P)
	CAME A,(P)
	 JRST A.LN1
	SOS T,-1(P)
	SUB P,[2,,2]
	JRST TEXT5	;RETURN VALUE IN T

ARDIX:	NOVAL
	PUSHJ P,AGETFD		;GET FIELD ARG
	MOVEM A,ARADIX
	JRST MACCR	;RETURN WITHOUT CLOBBERING CURRENT VALUE

A.RADIX:	CALL AGETFD	;READ THE TEMP. RADIX.
	PUSH P,ARADIX	;LAMBDABIND RADIX TO THAT VALUE.
	MOVEM A,ARADIX
	CALL XGETFD	;READ IN THE NEXT FIELD USING THAT RADIX.
	REST ARADIX
	JRST VALRET
;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE.
A.BP:	CALL YGETFD
	MOVEI C,SPACE
	SKIPE CDISP	;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE
	 HRRM C,CDISP	;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT.
	JUMPE A,VALR1
	PUSH P,A
	JFFO A,.+2
	 MOVEI B,36.
	EXCH B,(P)	;(P) HAS # LEADING ZEROS.
	MOVN A,B
	AND A,B		;A HAS ONLY THE LOW BIT OF THE BYTE.
	JFFO A,.+2
	 MOVNI B,1	;B HAS 35.-<# TRAILING ZREROS.>
	MOVEI A,1(B)
	SUB A,(P)	;A HAS SIZE OF BYTE
	LSH A,30	;PUT IN S FIELD OF BP.
	SUB P,[1,,1]
	MOVNS B
	ADDI B,35.	;B HAS # TRAILING ZEROS.
	DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP.
	JRST VALR1

;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE.
;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG.
A.BM:	CALL GETBPT	;READ IN A BYTE POINTER ARG, IN A, POINTING AT T.
	SETZ T,
	SETO C,
A.DPB1:	DPB C,A		;PUT 1'S IN SPEC'D PART OF ACCUM T
	MOVE A,T
	JRST VALRET

;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T.
;RETURN IT IN AC A.
GETBPT:	CALL YGETFD
	TLNN A,-1	;IF ARG ISN'T IN LH, USE RH.
	 HRLI A,(A)
	TLZ A,77	;MAKE BP. -> AC T
	HRRI A,T
	RET

;RETURN # TRAILING ZEROS IN ARGUMENT.
A.TZ:	CALL YGETFD
	MOVN B,A
	AND A,B		;A HAS JUST LOW BIT OF ARG SET.
	JFFO A,.+2
	 MOVNI B,1	;# OF ZEROS BEFORE LOW BIT =
	MOVN A,B	;35. - <# TRAILING ZEROS>
	ADDI A,35.
	JRST VALRET

;RETURN # LEADING ZEROS IN ARG.
A.LZ:	CALL YGETFD
	JFFO A,.+2
	 MOVEI B,36.
	MOVE A,B
	JRST VALRET

;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP,
;RETURNING THE RESULTING WORD.
A.DPB:	CALL YGETFD	;READ STUFF.
	PUSH P,A
	CALL GETBPT	;READ BP AND TURN INTO ACTUAL BP POINTING AT T
	PUSH P,A
	CALL YGETFD	;READ IN WORD AND PUT IN T.
	MOVE T,A
	REST A		;A HAS BP
	REST C		;C HAS STUFF
	JRST A.DPB1	;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD.

;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP
A.LDB:	CALL GETBPT
	PUSH P,A
	CALL YGETFD
	MOVE T,A
	REST A
	LDB A,A
	JRST VALRET

;.IBP BP RETURNS AN INCREMENTED BP.
A.IBP:	CALL YGETFD
	TLNN A,-1	;IF ARG ISN'T IN LH, USE RH.
	 HRLZS A
	IBP A
	JRST VALRET
AWORD:	NOVAL
	PUSHJ P,EBLK
	PUSHJ P,GETWRD	;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"?
	PUSHJ P,PPB
	JRST ASSEM1

;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0.
;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL.
;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL.
;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF.
;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY.
A.KILL:	NOVAL
	HLLZ LINK,B	;REMEMBER BIT TO SET.
A.KIL1:	CALL GETSLD	;READ NEXT SYMBOL NAME.
	 JRST MACCR	;NO MORE, EXIT.
	SKIPE LINK	;EXCEPT FOR .BIND, DO NOTHING ON PASS 1.
	 JUMPGE FF,A.KIL1
	CALL ESDEF	;DEFINE THE SYMBOL, D HAS STE IDX.
	 JRST A.KIL2	;SYMBOL NEVER SEEN.
	IORM LINK,ST+2(D)	;SET THE BIT IN 3RDWRD..
	IOR C,LINK	;(IF .XCREF, PREVENT CREFFING THIS TIME)
IFN CREFSW,XCT CRFINU	;CREF THE SYMBOL
	JRST A.KIL1

A.KIL2:	MOVSI T,LCUDF	;SYMBOL UNDEFINED, MAKE UNDEF LOCAL.
	IOR C,LINK	;WITH THE DESIRED BIT SET.
	TLO C,3MACOK	;SHOULDN'T BE ERROR IF IT BECOMES MACRO.
	CALL VSM2
IFN CREFSW,XCT CRFINU
	JRST A.KIL1

;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS.
AEXPUNG:	NOVAL
AEXPU2:	PUSHJ P,GETSLD	;GET NAME
	 JRST MACCR	;NO MORE NAMES
	PUSH P,[AEXPU2]	;AFTER THIS SYM, POPJ TO READ ANOTHER.
;EXPUNGE 1 SYMBOL, SQUOZE IN SYM.
AEXPU1:	PUSHJ P,ES
	 JFCL		;NOT FOUND, DON'T COMPLAIN, JUST CREF.
IFN CREFSW,XCT CRFDEF
	HRLZI T,400000	;EXPUNGED ZERO SYM
	SKIPE ST(D)
	MOVEM T,ST(D)
	SKIPL CONTRL	;IF RELOCATABLE ANDLOCAL SYMBOL,
	CAIL A,DEFGVR_-33.
	 RET
	PUSHJ P,PBITS7	;TELL STINK TO EXPUNGE SYM.
	MOVEI A,CLGLO
	PUSHJ P,PBITS
	TLO SYM,400000	;SAY IS NEW TYPE RQ,
	PUSHJ P,OUTSM0
	MOVSI A,400000	;NEW NAME NULL => DELETE.
	JRST $OUTPT
;EQUAL SYM1,SYM2	;DEFINE SYM1 SAME AS SYM2.
AEQUAL:	NOVAL
	PUSHJ P,GETSLD
	 ETR ERRTFA
	PUSH P,SYM	;REMEMBER SYM NAME AND BLOCK TO DEF. IN.
	PUSH P,ESBK
	PUSHJ P,GETSLD
	 ETR ERRTFA
IFN CREFSW,XCT CRFINU	;CREF SYM DEFINED AS.
	CALL ES		;LOOK UP SYM TO EQUATE TO.
	 JRST [	REST ESBK	;NOT FOUND => EXPUNGE THE 1ST SYM.
		REST SYM
		JRST AEXPU1]
	REST ESBK
	REST SYM
IFN CREFSW,XCT CRFDEF
	PUSH P,A
	PUSH P,B		;SAVE INFO ON VALUE OF SYM TO EQUATE TO.
	PUSH P,C
	CALL ESDEF
	 MOVEM SYM,ST(D)
	REST B		;3RDWRD OF 2ND SYMBOL.
	REST ST+1(D)	;(WHAT WAS PUSHED FROM B)
	REST A
	DPB A,[400400,,ST(D)]
	TLZ C,3DFCLR	;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #).
	AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL.
	IOR B,C
	3PUT B,D
	JRST MACCR

ERRTFA:	ASCIZ /Too few args - EQUAL/

;.SEE SYM1,SYM2,...	;CREF THOSE SYMS.
A.SEE:	CALL GETSLD	;READ 1 SYMBOL.
	 JRST MACCR	;NONE TO BE READ.
IFN CREFSW,[
	SKIPN CRFONP	;IF CREFFING,
	 JRST A.SEE
	CALL ES
	 MOVEI A,SYMC_-33.
	XCT CRFINU	;CREF THE SYMBOL.
]
	JRST A.SEE
;UUO HANDLING ROUTINE
;41 HAS JSR ERROR

VBLK
ERRCNT:	0	; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT
ERRCCT:	0	;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP.
ERRJPC:	0	;JPC READ WHEN UUO.
ERROR:	0
IFN ITSSW,	.SUSET [.RJPC,,ERRJPC]
	JRST ERRH	;GO HANDLE IT
PBLK
ERRH:	PUSH P,T
	PUSH P,B	;NOT TYPR => ERROR OF SOME KIND
	PUSH P,A
	PUSH P,C
	LDB T,[331100,,40]	;PICK UP OP CODE
	CAIN T,TYPCR_-33	; TYPCR?
	 JRST TYPCR1
	CAIN T,TYPR_-33		; OR TYPR?
	 JRST TYPR1		; YES
		;ERROR OF SOME KIND
	CAIE T,ETASM_-33	;CHECK FOR SPECIAL LOSSAGES AT COLON
	 CAIN T,ETSM_-33
	  CAME SYM,SYSYM	;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE?
	   JRST ERRH1
	MOVE T,SYSYM1

	MOVEM T,SYSYM	;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT
	MOVE T,SYLOC1
	MOVEM T,SYLOC
ERRH1:
IFN TS,[
IFN LISTSW,[
	CALL PNTR	;FORCE OUT BUFFERED LISTING OUTPUT
	CALL PNTCRR	;AND CR, SO USER CAN SEE WHERE ERROR WAS.
]
	PUSHJ P,ERRTFL	;IF NOT SAME FILE AS LAST, PRINT FILE NAME.
]
	SETZM ERRCCT
	AOS ERRCNT	; BUMP ERROR TOTAL
IFN DECSW,AOS .JBERR	; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT
	MOVE A,SYSYM	;GET LAST TAG DEFINED
	JUMPE A,ERR1	;SKIP PRINTOUT IF NONE THERE
	PUSHJ P,SYMTYP	;THERE, TYPE IT OUT
	MOVE B,CLOC	;NOW GET CURRENT LOCATION
	SUB B,SYLOC	;SUBTRACT VALUE OF LAST TAG
	JUMPE B,ERR1	;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG
	MOVEI A,"+	;NOT AT TAG,
	PUSHJ P,TYOERR	;TYPE OUT PLUS SIGN,
	AOS ERRCCT	;(1 MORE CHAR TYPED)
	PUSHJ P,OCTPNT	;THEN TYPE OUT DIFFERENCE IN OCTAL
ERR1:	PUSHJ P,TABERR	;NOW SEPARATE WITH TAB
	MOVE A,ERRCCT
	CAIGE A,8	;MAKE SURE MOVE TO COLUMN 16.
	 PUSHJ P,TABERR
	MOVEI B,[ASCIZ/GL+/]
	SKIPGE GLOCTP	;LOCATION GLOBAL?
	 PUSHJ P,TYPR3	;YES, TYPE OUT THAT FACT.
	MOVE B,CLOC	;GET CURRENT LOCATION
	PUSHJ P,OCTPNT	;TYPE OUT IN OCTAL
;DROPS THROUGH
;DROPS THROUGH.
	PUSHJ P,TABERR
	MOVE A,MDEPTH	;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS
	MOVSI T,-2
	CALL DPNT0	;PRINT, IN 2-CHAR FIELD.
	MOVEI A,".
	CALL TYOERR	;(USED TO BE OCTAL)
	MOVE A,CPGN	;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0)
	PUSHJ P,[AOJA A,D6PNT]	;TYPE IT OUT IN DECIMAL
	MOVEI A,"-
	CALL TYOERR
	MOVE A,CLNN	;ALSO CURRENT LINE NUMBER
	PUSHJ P,[AOJA A,D3PNT2]
	PUSHJ P,TABERR
	MOVEI A,48.	;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS
	MOVEM A,ERRCCT	;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY.
	LDB A,[331100,,40]	;PICK UP OP CODE AGAIN
	CAIGE A,8	;ERROR UUO MAX
	 JRST .+1(A)
	JRST [HALT ? JRST .-1]	;OPCODE 0, OR TOO BIG.
	JRST ERRSM	;ETSM => TYPE SYM AND MESSAGE.
	JRST ERRR	;ETR => JUST PRINT MESSAGE
	JRST ERRJ	;ERJ => RH(40) HAS JUMP ADR
	JRST ERRI	;ETI => IGNORE LINE RET TO ASSEM1
	JRST ERRA	;ETA => RET TO ASSEM1
	JRST ERRASM	;ETASM => TYPE SYM AND GO TO ASSEM1
	JRST IAE	;ERF => FATAL.

ERRJ:	MOVE A,40	;ERJ => RH(40) HAS JUMP ADR
	HRRM A,ERROR
	JRST ERRET1

ERRI:	PUSHJ P,RCH	;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE
	CAIE A,12
	 JRST .-2
ERRA:	MOVEI A,ASSEM1	;ETA => RETURN TO ASSEM1, DON'T TYPE SYM.
	MOVEM A,ERROR
	JRST ERRR

ERRASM:	MOVEI A,ASSEM1	;ETASM => TYPE SYM AND RETURN TO ASSEM1
	MOVEM A,ERROR
ERRSM:	MOVEI C,56.	;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE
	CALL TYPE37	;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE.
	MOVE A,SYM
	PUSHJ P,SYMTYP
	PUSHJ P,TABERR
ERRR:	CALL TYPE40	;TYPE THE ERROR MESSAGE.
ERRET1:	REST C
	POP P,A		;COMMON RETURN POINT FROM UUOS
	POP P,B
	POP P,T
	JRST 2,@ERROR
;FINISH UP AN ERROR UUO'S ERROR MESSAGE.  PRINT THE SPECIFIED STRING
;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S.
TYPE40:	MOVE C,ERRCCT
	CALL TYPE37
	CALL TYPR4	;PRINT THE ASCIZ STRING
	CALL CRRERR
	SKIPN A,DEFNPS	;IF INSIDE A LONG PSEUDO,
	 RET
	MOVE A,DEFNLN
	MOVE B,DEFNPN
	CAMN A,CLNN	;WHICH DIDN'T START IN THIS VERY LINE,
	 CAME B,CPGN
	  JRST TYPE42
	MOVE A,DEFNFI
	CAMN A,INFFN1
	 JRST TYPE43
TYPE42:	MOVEI B,[ASCIZ/	in /]
	CALL TYPR3
	MOVE A,DEFNPS
	CALL SYMTYP	;SAY WHAT PSEUDO, AND WHERE IT STARTED.
	MOVEI B,[ASCIZ/ Starting at /]
	CALL TYPR3
	MOVE A,DEFNPN	;PAGE # -1.
	CALL [AOJA A,DPNT] ;PRINT PAGE #.
	MOVEI A,"-
	CALL TYOERR
	AOS A,DEFNLN
	CALL D3PNT2	;PRINT LINE #.
IFN TS,[
	MOVE B,DEFNFI	;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE.
	CAMN B,INFFN1
	 JRST TYPE41
	MOVEI B,[ASCIZ/ of file /]
	CALL TYPR3
	MOVE B,DEFNFI
	CALL SIXTYO
]
TYPE41:	CALL CRRERR	;AND CRLF.
TYPE43:	MOVE A,ERROR
	CAIE A,ASSEM1	;IF THIS ERROR IS EXITING THE PSEUDO,
	 RET
	SETZM DEFNPS	;SAY WE'RE NOT IN IT ANY MORE.
	SETOM TEXT4
	RET

;JSP TM,ERMARK  IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION
;THAT PSEUDO.  SYM SHOULD CONTAIN THE NAME OF THE PSEUDO.
;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED.
;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD)
ERMARK:	SKIPE DEFNPS
	 JRST (TM)
	MOVEM SYM,DEFNPS
	MOVE SYM,CLNN
	MOVEM SYM,DEFNLN
	MOVE SYM,CPGN
	MOVEM SYM,DEFNPN
	MOVE SYM,INFFN1
	MOVEM SYM,DEFNFI
	MOVE SYM,DEFNPS
	CALL (TM)
	 CAIA
	  AOS (P)
	SETZM DEFNPS
	RET
;C SHOULD HAVE CURRENT HORIZ POS.  IF TYPING THE STRING 40 POINTS AT
;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY.
TYPE37:	HRRZ B,40
	HRLI B,440700	;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR.
	ILDB A,B
	CAIE A,		;AND COUNT CHARS IN THE ERR MSG.
	 AOJA C,.-2
	CAMGE C,LINEL
	 RET
CRRTBX:	MOVEI A,10
	MOVEM A,ERRCCT	;PREVENT THIS FROM BEING DONE TWICE.
	SKIPE TTYFLG
	 RET
	MOVEI A,^M	;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE).
	PUSHJ P,TYOX
	MOVEI A,^J
	PUSHJ P,TYOX
	MOVEI A,^I
	JRST TYOX

		;TYPE OUT SQUOZE (FLAGS OFF) IN A

SYMTYP:	PUSHJ P,SQCCV	;GET NEXT CHAR IN ASCII.
	AOS ERRCCT
	PUSHJ P,TYOERR	;TYPE IT OUT.
	JUMPE B,CPOPJ	;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH)
	IMULI B,50	;LEFT-JUSTIFY REMAINDER
	MOVE A,B	;GET LEFT-JUSTIFIED REMAINDER IN A
	JRST SYMTYP	;TYPE OUT REMAINDER OF SYM

		;TYPE OUT SQUOZE CHARACTER (IN A)

SQCCV:	IDIV A,[50*50*50*50*50]
	CAIG A,10.
	 SOJA A,SQCDTO	;NUMBER (OR BLANK =>SLASH)
	CAIL A,45
	 SKIPA A,SYTB-45(A)	;SPECIAL
	  ADDI A,"A-13	;LETTER
	POPJ P,

SQCDTO:	ADDI A,"0
	POPJ P,

SYTB:	".
	"$
	"%

D3PNT2:	MOVE T,[-3,,400000]	;3 CHAR FIELD, NO ZERO SUPPRESSION.
	JRST DPNT0

DPNT:	TDZA T,T	;ORDINARY DECIMAL PRINT.
D6PNT:	 MOVSI T,-6	;6 CHAR FIELD, ZERO SUPPRESSION.
DPNT0:	IDIVI A,10.
	HRLM B,(P)
	TRNE T,377777	;IF NOT LAST DIGIT,
	 TRNE T,400000	;AND ZERO-SUPPR. WANTED,
	  JRST DPNT2
	JUMPN A,DPNT2	;IF THIS IS A LEADING 0,
	JUMPN B,DPNT2
	MOVEI B," -"0
	HRLM B,(P)	;REPLACE WITH A SPACE.
DPNT2:	AOBJN T,.+2	;J IF NOT ENOUGH CHARS YET.
	JUMPE A,DPNT1	;ENOUGH, DON'T MAKE MORE IF NOT NEEDED.
	CALL DPNT0
	JRST DPNT1
;TYPE HALFWORD IN B IN OCTAL.
OCTPNT:	HRRZ A,B
	IDIVI A,10
	HRLM B,(P)
	JUMPE A,.+2
	PUSHJ P,.-3
	AOS ERRCCT
DPNT1:	HLRZ A,(P)
ADGTYO:	ADDI A,"0
	JRST TYOERR

;TYPE OUT THE SIXBIT WORD IN B

SIXTYO:	JUMPE B,CPOPJ
	MOVEI A,0
	ROTC A,6
	ADDI A,40
	PUSHJ P,TYOERR
	JRST SIXTYO

		;TYPE CRLF

CRR:	MOVEI A,15
	PUSHJ P,TYO
	MOVEI A,12
	JRST TYO

;OP CODE 0 => NO RECOVERY RETURN TO GO9
IAE:	CALL TYPE40	;PRINT THE ERROR MESSAGE.
	SKIPE ASMOUT
	 JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS.
	SKIPE SCNDEP	;MENTION ANY UNTERMINATED SUCCESSFUL
	 CALL AENDM1	;CONDITIONALS.
	MOVEI B,[ASCIZ /Error is fatal.
/]
	CALL TYPR3
IFN ITSSW,[
	.SUSET [.RTTY,,A]
	SKIPL A
	 .RESET TYIC,
]
	JRST GO9

		;TYPR [ASCIZ /STRING/]	;TYPE OUT STRING

TYPR1:	PUSH P,[ERRET1]
TYPR4:	HRRZ B,40	;GET ADR OF BEGINNING OF STRING
TYPR3:	HRLI B,440700	;CONVERT TO BYTE POINTER
TYPR2:	ILDB A,B	;GET NEXT CHAR
	JUMPE A,CPOPJ	;JUMP IF ZERO, END OF STRING
	PUSHJ P,TYOERR	;NON-ZERO, TYPE IT OUT
	JRST TYPR2

		; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF

TYPCR1:	PUSH P,[ERRET1]
	PUSHJ P,TYPR4	; When done, fall thru.

CRRERR:	MOVEI A,^M	;CRLF IN ERROR MESSAGE.
	CALL TYOERR
	SKIPA A,[^J]
TABERR:	MOVEI A,^I	;TAB INN ERROR MESSAGE.
TYOERR:
IFN LISTSW,[
	SKIPE LSTTTY	;OUTPUT TO LISTING UNLESS LSTTTY ZERO.
	 CALL PILPTX
]
	SKIPG LSTTTY
	 JRST TYO	;TO TTY UNLESS LSTTTY POSITIVE.
	RET
;OUTPUT-FORMAT SELECTING PSEUDOS:

;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT
A.SLDR:	NOVAL
	JUMPGE FF,MACCR	;DO NOTHING ON PASS 1.
	PUSHJ P,FEED1	;LEAVE LOTS OF BLANK PAPER TAPE FIRST
	PUSHJ P,PLOD1A	;PUNCH OUT LOADER
SIMBLK:	MOVSI B,SBLKS	;ENTRY FROM PS1, A.SLDR SELECT SBLK
	JRST SIMBL1

SRIM:	MOVE A,SYM	;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL)
	PUSH P,B
	CALL SYMTYP
	TYPR [ASCIZ/ Encountered
/]
	REST B
SIMBL1:	TRO FF,FRNPSS
	HRRI B,TRIV	;SET UP TRIV FLAG FOR LH(CONTRL)
	MOVSS B
	CAME B,CONTRL	;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE
	 CALL EBLK
	MOVE A,CONTRL	;IF OLD MODE WAS RELOCATABLE OF SOME KIND,
	TRNN A,DECREL\FASL
	 JUMPL A,SIMBL2
	SETZM CRLOC	;INITIALIZE LOCATION COUNTER.
	MOVEI A,100	; USE 100 ASSUMING ITS SBLK
	TRNE B,DECSAV
	 MOVEI A,140	; BUT USE 140 FOR DEC ABS.
	MOVEM A,CLOC
SIMBL2:	MOVEM B,CONTRL	;STORE NEW MODE.
	TRNE B,ARIM\ARIM10
	 TRZ F,FRSYMS	;RIM AND RIM10 MODES IMPLY NO SYMBOLS.
	AOS (P)

	;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC
	;CALLED BY OUTPUT SELECTING PSEUDOS
OUTUPD:	NOVAL
IFN A1PSW,[
	TRNE FF,FRNPSS	;IF PASS 1,
	 TLNN FF,$FLOUT
	  JRST OUTCHK
	AOS OUTN1	;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE
OUTCHK:	TLZE FF,$FLOUT
	 AOS OUTC	;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY
]
	RET

ANOSYMS:	NOVAL
	TRZ FF,FRSYMS
	JRST MACCR

A1PASS:	PUSHJ P,OUTUPD
A1PAS1:	TLO FF,FLPPSS
	MOVEIM A.PPASS,1	;SET .PPASS TO 1.
IFN CREFSW,[	SKIPE CREFP	;THIS NOW PUNCHING PASS,
	PUSHJ P,CRFON	;MAYBE TURN ON CREFFING.
]
IFN LISTSW,[
	SKIPE LISTP
	 CALL LSTON	;LIST NOW IF WANT LISTING AT ALL.
]
	MOVE A,CONTRL
	TRNE A,DECREL
	 CALL DECPGN
	TRZA FF,FRNPSS
ARELOC:	 PUSHJ P,OUTUPD
ARELC1:	PUSHJ P,EBLK	;FINISH CURRENT OUTPUT BLOCK
	TRO FF,FRLOC	;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT
	CLEARM CLOC
	MOVEI A,1
	MOVEM A,CRLOC
	CLEARM CONTRL
	SETZM BKBUF
	MOVEI A,LREL
	DPB A,[310700,,BKBUF]
	MOVEM A,CDATBC
	JRST MACCR


	; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT
A.DECSAV:	NOVAL
	MOVSI B,DECSAV	; SET FLAG
	JRST SIMBL1	; THEN HANDLE ALMOST LIKE .SBLK


A.DECTWO:	CALL AGETFD	;READ THE TWOSEG ORIGIN.
	TRNN FF,FRNPSS
	 ETF [ASCIZ /.DECTWO follows 1PASS/]
	MOVE C,ISAV
	TRNN C,IRFLD	;NO ARG => DEFAULT IT TO 400000
	 MOVEI A,400000
	MOVEM A,DECTWO

A.DECREL:	PUSHJ P,OUTUPD
	TRZ FF,FRLOC
	PUSHJ P,EBLK	;FORCE OUT BLOCK IN OTHER FMT.
	MOVE A,[SETZ DECREL]
	CAME A,CONTRL	;SWITCHING TO .DECREL MODE FOR 1ST TIME
	 TRNE FF,FRNPSS	;IN A 1PASS ASSEMBLY
	  JRST A.FAS1
	CALL A.FAS1	;DO THE SWITCH
	 JFCL
	CALL DECPGN	;THEN WRITE THE PROGRAM NAME
	JRST MACCR

A.FAS1:	MOVEM A,CONTRL	;DEC FMT COUNTS AS ABS ASSEMBLY.
	SETZM BKBUF	;(SO EBLK W0N'T OUTPUT ANYTHING)
	SETZM CLOC	;START ASSEMBLING FROM RELOCATABLE 0.
	MOVEI A,1
	MOVEM A,CRLOC
	PUSHJ P,EBLK	;INITIALIZE AN ORDINARY (DECWDS) BLOCK.
	JRST MACCR

IFN FASLP,[
A.FASL:	PUSHJ P,OUTUPD
	PUSHJ P,EBLK
	MOVE A,[SETZ FASL]	;FASL ALSO COUNTS AS ABS
	JRST A.FAS1
]
ATITLE:	NOVAL
	PUSH P,CASSM1	;RETURN TO ASSEM1.
	PUSHJ P,GSYL
	SKIPE SYM
	 MOVEM SYM,PRGNM
	MOVE T,[440700,,STRSTO]
ATIT2:	ILDB A,T	;GET CHAR FROM TITLE STRING
	SOSG STRCNT
	 JRST ATIT3	;CHAR IS SYLLABLE TERMINATOR
IFE ITSSW,[
	SKIPE CCLFLG
	 TRNN FF,FRPSS2
]
	  PUSHJ P,TYO	;NOT TERMINATOR, TYPE OUT AND LOOP BACK
	JRST ATIT2

ATIT3:	CALL ATIT1	;PRINT THE REST OF THIS LINE.
	MOVE A,CONTRL
	TRNE A,DECREL
	 TRNE FF,FRNPSS
	  CAIA
	   ETF [ASCIZ /TITLE follows 1PASS/]
	MOVE A,TTYINS
	ADD A,A.PASS	;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH)
	JUMPG A,CPOPJ
IFDEF GTYIPA,JRST GTYIPA	;GO PUSH TO TTY IF CAN,
IFNDEF GTYIPA,HALT	;WHY DID YOU SET TTYINS IF CAN'T?

ATIT1:	CAIE A,15	;CR?
	 CAIN A,12	;LF?
IFN ITSSW,JRST CRR	;ONE OF THESE, FINISH TYPEOUT WITH CR
.ELSE [	 JRST [	SKIPE CCLFLG
		 TRNN FF,FRPSS2
		  JRST CRR
		RET]
	SKIPE CCLFLG	;NEITHER OF THESE, PRINT CHAR.
	 TRNN FF,FRPSS2	;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL.
]
	   PUSHJ P,TYO
A.ERR1:	PUSHJ P,RCH	;GET NEXT CHAR IN TITLE
	JRST ATIT1

;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG.
A.ERR:	PUSH P,CASSM1	;RETURN TO ASSEM1,
	ERJ A.ERR1	;AFTER NUMBERS AND USER'S STRING.

A.FATAL:PUSH P,[GO9]	;.FATAL - CAUSE A FATAL ERROR.
	ERJ A.ERR1

APRINT:	NOVAL
	HLRZS B		;B SAYS WHETHER PRINTX, PRINTC OR COMMENT.
	JSP TM,ERMARK
	CALL PASSPS
	MOVE T,A
APRIN1:	PUSHJ P,RCH
	CAME A,T
	 JRST (B)	;GO TO APRIN1 FOR COMMENT,
	JRST MACCR

APRIN2:	CAIE A,"!	;COME HERE FOR PRINTX
APRIN3:	PUSHJ P,TYO	;HERE FOR PRINTC
	JRST APRIN1

A.TYO:	NOVAL
	CALL AGETFD	;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG).
	CALL TYOERR
	JRST MACCR

A.TYO6:	NOVAL
	CALL AGETFD	;PSEUDO TO TYPE A WORD OF SIXBIT.
	MOVE B,A
	CALL SIXTYO
	JRST MACCR
;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED.
A.BEGIN:	NOVAL
	SKIPE ASMOUT	;IF IN GROUPING, FLUSH IT & ERROR.
	 JSP LINK,CONFLM
	PUSHJ P,GETSLD	;READ A NAME.
	 MOVE SYM,SYSYM	;NO ARG, USE NAME OF LAST LABEL.
	MOVE A,SYM	;NAME TO USE FOR BLOCK.
	MOVE B,BKLVL	;CURRENT LEVEL + 1
	HRLZI B,1(B)	;IS LEVEL OF NEW BLOCK.
	HRR B,BKCUR	;ITS SUPERIOR IS CURRENT BLOCK.
	MOVEI C,0	;SEE IF AN ENTRY EXISTS FOR THIS BLOCK.
	MOVE AA,A.PASS
A.BEG0:	CAMN A,BKTAB(C)
	 CAME B,BKTAB+1(C)
	  JRST A.BEG1	;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED.
	TDNE AA,BKTAB+2(C)	;FOUND: DEFINED IN THIS PASS?
	 ETSM [ASCIZ /Multiply defined BLOCK/]
	JRST A.BEG2	;NO, SAY IT'S DEFINED.

A.BEG1:	ADDI C,BKWPB	;LOOK THRU ALL ENTRIES.
	CAMGE C,BKTABP
	 JRST A.BEG0
	CAIL C,BKTABS	;ALL ENTRIES USED => ERROR.
	 ETF ERRTMB
	MOVEM A,BKTAB(C)	;ALLOCATE NEW ENTRY
	MOVEM B,BKTAB+1(C)	;STORE NAME, LEVEL, SUPPRO.
	MOVEI A,BKWPB(C)
	MOVEM A,BKTABP	;POINTS TO 1ST UNUSED ENTRY.
A.BEG2:	IORM AA,BKTAB+2(C)	;INDICATE BLOCK SEEN THIS PASS.
	MOVEM C,BKCUR	;NEW BLOCK NOW CURRENT BLOCK,
	AOS A,BKLVL	;ITS LEVEL NOW CURRENT LEVEL,
	CAIL A,BKPDLS	;PUSH IT ON BLOCK PDL
	 ETF [ASCIZ /.BEGIN nesting too deep/]
	MOVEM C,BKPDL(A)
	JRST ASSEM1

ERRTMB:	ASCIZ /Too many symbol blocks/
ERRUMB:	ASCIZ /Unmatched .BEGIN - .END/

;.END - POP CURRENT BLOCK.
A.END:	NOVAL
	SKIPE ASMOUT	;IN GROUPING => TERMINATE IT & ERROR.
	 JSP LINK,CONFLM
	MOVE A,CDISP	;IF FOLLOWED BY WORD TERM,
	TLNN A,DWRD	;CAUSE IT TO BE RE-READ
	 TLO FF,FLUNRD	;SO ARG WILL BE NULL.
	PUSHJ P,GETSLD	;READ ARG.
	 JRST A.END0	;NO ARG.
	MOVE C,BKCUR	;ERROR UNLESS BLOCK BEING TERMINATED
	MOVE A,BKTAB(C)	;HAS SAME NAME AS ARG.
	EXCH A,SYM	;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME)
	CAME A,SYM
	 ETSM ERRUMB	;ERROR, PRINT SYM (BLOCK'S NAME)
A.END0:	MOVE C,BKCUR	;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK.
	CAIG C,BKWPB
	 ETA ERRUMB
	HRRZ C,BKTAB+1(C)
	MOVEM C,BKCUR	;POP INTO FATHER OF PREV. CURRENT BLOCK.
	SOS BKLVL
	JRST ASSEM1
;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER.
;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR.
;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR")
;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N.
;SYMBOL TABLE OUTPUT RTN PUTS -2*<NUM SYMS IN BLOCK> IN 3RD WD.
;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT)
;IN WHICH INITIAL SYMS ARE DEFINED.
;THAT ENTRY'S 2ND AND 3RD WDS ARE 0.
;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH
;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK
;BEFORE YOU DO ANY .BEGIN'S).
;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0.

;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED.
;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK.
;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK.

BKTABS==BKTABL*BKWPB

VBLK
BLCODE [
BKTAB:	BLOCK 3		;ENTRY FOR .INIT BLOCK.
PRGNM:	BLOCK BKTABS-BKWPB	;PROGRAM NAME IS NAME OF MAIN BLOCK.
]
BKTABP:	0	;IDX IN BKTAB OF 1ST UNUSED ENTRY.
BKPDL:	BLOCK BKPDLS	;TABLE OF BLOCKS STARTED, NOT FINISHED.
BKLVL:	0	;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL.
BKCUR:	0	;BKTAB IDX OF CURRENT BLOCK.
ESBK:	0	;-1 OR BLOCK TO EVAL SYM. IN.
ESL1:	0	;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR.
ESL2:	0	;3RDWRD OF BEST SO FAR.
SADR:	0	;SYM TAB IDX OF BEST SO FAR.
ESLAST:	0	;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE
		;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN
ESXPUN:	-1	;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE.
BKTAB1:	BLOCK BKTABL	;USED BY SSYMD.
PBLK

;.SYMTAB ARG	;SAY WANT AT LEAST ARG STE'S IN SYMTAB.
A.SYMTAB:	NOVAL
	PUSH P,[0]	;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED.
	PUSHJ P,AGETFD	;GET DESIRED SYM TAB SIZE.
	CAMG A,SYMLEN	;IF HAVE ENOGH ROOM ALREADY,
	 JRST A.SYM1	;NO NEED TO RE-INIT.
	CAILE A,SYMMAX	;IF WANTS MORE THAN MAXIMUM, ERROR.
	 ETF [ASCIZ/.SYMTAB 1st arg too big/]
	MOVEM A,SYMLEN	;TELL INITS ABOUT NEW SIZE.
	SETOM (P)
A.SYM1:	CALL AGETFD	;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION.
	CAMG A,CONLEN	;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO.
	 JRST A.SYM2
	CAILE A,CONMAX
	 ETF [ASCIZ/.SYMTAB 2nd arg too big/]
	MOVEM A,CONLEN	;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY.
	SETOM (P)
A.SYM2:	CALL AGETFD	;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW.
	JUMPE A,A.SYM3	;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS.
	CAIL A,MINWPS
	 CAILE A,MAXWPS
	  ETF [ASCIZ/.SYMTAB 3rd arg out of range/]
	CAME A,WPSTE
	 SETOM (P)
	MOVEM A,WPSTE
A.SYM3:	REST A		;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED?
	JUMPE A,ASSEM1	;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2.
	MOVE B,PLIM
	CAMN B,CONTBA	;IF THERE HAVE BEEN ANY LITERALS
	 SKIPE INICLB	;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ...
	  ETF [ASCIZ/Too late to do .SYMTAB/]
	MOVE CH1,MACTAD	;SET UP AC -> START OF INIT CODE
	SUBI CH1,MACTBA	;SO IT CAN REFER TO ITSELF.
	PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC.
	PUSHJ P,MACINI	;INIT PTRS TO END OF MACTAB.
	JRST ASSEM1
A.OP:	PUSHJ P,A.OP1	;.OP,
	JRST VALRET	;RETURNS VALUE

A.AOP:	NOVAL
	AOS (P)		;.AOP DOESN'T RETURN VALUE
A.OP1:	PUSHJ P,AGETFD
	PUSH P,A
	PUSHJ P,AGETFD
	PUSH P,A	;PDL NOW HAS FIELD 0 AND FIELD 1
	PUSHJ P,AGETFD
	POP P,B		;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0
	EXCH A,B
	POP P,T		;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2
	TLNN T,(0 17,)	;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE.
	 TLO T,(0 A,)
	TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION,
	 HRRI T,B	;SUPPLY ONE.
	SETOM A.ASKIP'	;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0.
	TLNE T,74000	;AVOID EXECUTING OPCODE ZERO.
	 XCT T
	  SETZM A.ASKIP
	MOVEM A,AVAL1'	;STORE C(AC) AS .AVAL1
	MOVEM B,AVAL2'	;STORE C(E) FOR .AVAL2
	POPJ P,		;RETURN TO WHATEVER

AASCIZ:	TDZA T,T
A.ASCII:	MOVEI T,1
	MOVEM T,AASCF1	;STORE TYPE
	MOVE D,[440700,,T]
	SETZM AASCFT
	JRST AASC1

AASCII:	SKIPA D,[440700,,T]
ASIXBI:	 MOVE D,[440600,,T]
	SETZM AASCFT	;INDICATE NOT .DECTXT
	SETOM AASCF1	;INDICATE REGULAR (NOT ASCIZ)
	JRST AASC1

A.DCTX:	NOVAL
	MOVE A,CONTRL
	TRNN A,DECREL
	 ETA [ASCIZ /.DECTXT in non-DECREL assembly/]
	CALL EBLK
	SETZ B,
	SETOM AASCFT
	SETOM AASCF1	;INDICATE ASCIZ-STYLE PADDING
	MOVE D,[440700,,T]
AASC1:	TLZE I,ILMWRD
	 JRST TEXT2	;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS
	MOVEMM ASMDS1,ASMDSP
	MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO
	MOVEMM DEFNLN,CLNN	;IN CASE THE DELIMITER IS MISSING.
	MOVEMM DEFNPN,CPGN
IFN TS,	MOVEMM DEFNFI,INFFN1
	HLRZ T,B	;GET FILL CHARACTER
	IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW)
	LSH T,1		;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET)
	MOVEM T,AASEFW	;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE
	CALL PASSPS
	MOVEM A,TEXT4	;STORE TERMINATOR
TEXT7:	PUSHJ P,RCH
AASC8:	CAMN A,TEXT4
	 JRST AASC1A	;TERMINATOR
	TLNN D,760000
	 JRST TEXT6	;WORD FULL
TEXT9:	TLNE D,100	;CHECK BOTTOM BIT OF SIZE FIELD OF BP
	 JRST AASC2	;SET => NOT SIXBIT
	SUBI A,40
	CAILE A,77
	 SUBI A,40	;CONVERT LOWER CASE ASCII TO UPPER CASE
	JUMPGE A,.+2
	 ETR ERRN6B
AASC3:	IDPB A,D
	TRO I,IRSYL
	JRST TEXT7

ERRN6B:	ASCIZ /Character not SIXBIT/
;TERMINATOR

AASC1A:	TLNN D,760000	;SKIP UNLESS END OF WORD
	SKIPGE AASCF1	;SKIP UNLESS REGULAR
	 JRST [ MOVE CH1,ASMDS1	;REGULAR OR NOT END OF WORD
		MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO.
		JRST TEXTX]
	MOVEI CH1,1	;END OF WORD AND NOT REGULAR
	JRST AASC1B	;EXTRA 0 NEED FOR Z FLAVOR

AASC2:	CAIN A,"!
	 SKIPG AASCF1
	  JRST AASC3	;NOT .ASCII OR NOT EXCL
	PUSH P,T	;READ FIELD
	PUSH P,TEXT4
	PUSH P,D
	PUSH P,SYM
	PUSH P,ASMOUT	;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT.
	MOVEIM ASMOUT,4	;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1.
	MOVEI SYM,[SETOM ASUDS1]	;NOW TO SET UP UNDEFINED SYM CONDITION
	TLNE FF,FLPPSS
	 MOVE SYM,[SQUOZE 0,.ASCII]	;PUNCHING PASS, UNDEFINED => REAL ERROR
	CLEARM ASUDS1
	PUSHJ P,AGETFD
		;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2
		;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS,
		;CAUSING LOSSAGE IF NOT IN CONSTANT
	REST ASMOUT
	POP P,SYM
	POP P,D
	POP P,TEXT4
	POP P,T
	SKIPGE ASUDS1
	 MOVNI A,1	;HAD UNDEFINED SYMS SO ASSUME MAX
	SKIPGE ASUDS1
	 TLO I,ILNOPT	;ALSO DON'T OPTIMIZE OVER IN CONSTANT
	MOVE CH1,[440700,,AASBF]
	MOVEM CH1,ASBP1
	MOVEM CH1,ASBP2
	PUSH P,[AASC5]
	MOVE CH1,A
AASC6:	LSHC CH1,-35.
	LSH CH2,-1
	DIV CH1,ARADIX
	HRLM CH2,(P)
	JUMPE CH1,.+2
	PUSHJ P,AASC6
	HLRZ A,(P)
	ADDI A,"0
	IDPB A,ASBP1
	POPJ P,

AASC5:	MOVEI A,0
	IDPB A,ASBP1	;END .ASCII NUMBER WITH ZERO
AASC8A:	TLNN D,760000
	 JRST AASC7	;END OF WORD
	ILDB A,ASBP2
	JUMPE A,AASC9
	IDPB A,D
	JRST AASC8A

AASC9:	TLO FF,FLUNRD
	JRST TEXT7
AASC7:	TDZA CH1,CH1
TEXT6:	MOVNI CH1,1	;WORD FULL
AASC1B:	MOVEM CH1,AASCF2
	CLEARM CDISP
	MOVEM A,TEXT8
	MOVE A,T
	SKIPE AASCFT	;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT.
	 JRST [	CALL PPB
		MOVE D,[440700,,T]
		JRST TEXT2A]
	TLO I,ILMWRD	;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD.
	MOVEI T,ASSEM2
	MOVEM T,ASMDSP
	SKIPLE CONSML	;IF NOT MULTI-LINE MODE,
	 JRST CLBPOP
	MOVE T,ASMOUT	;IF THE TEXT IS IN <>'S OR ()'S,
	HRRZ T,ASMOT2(T)
	CAIE T,LSSTHA
	 JRST CLBPOP
	CALL IGTXT	;USE ONLY THE FIRST WORD.
	SKIPE CONSML	;AND ERROR IF IN ERROR MODE.
	 ETR [ASCIZ/Multi-word text pseudo in brackets/]
	JRST CLBPOP

		;GET NEXT WORD

TEXT2:	TRO I,IRFLD
TEXT2A:	MOVE T,AASEFW	;INITIALIZE T TO FILL WORD
	MOVE A,TEXT8	;GET NEXT CHAR (ALREADY READ BY RCH)
	SKIPGE B,AASCF2
	 JRST TEXT9	;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN
	JUMPE B,AASC8A
TEXTX:	SETZM DEFNPS
	SETOM TEXT4
	SKIPN AASCFT
	 JRST TEXT5	;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT.
	MOVE A,T
	CALL PPB	;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD.
	JRST MACCR

VBLK

AASCF1:	0	;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ
AASCF2:	0	;MULTIPLE WORD RETURN FLAG -1 REG 0  FINISH ! HACK 1 OUTPUT FILL WORD FOR Z
AASCFT:	0	;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING  THEM)
TEXT4:	-1	;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO.
TEXT8:	0	;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS
ASBP1:	0	;IDPB TO AASBF ON .ASCII FIELD
ASBP2:	0	;ILDB FROM AASBF "
AASBF:	BLOCK 8	;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY
ASUDS1:	0	;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1
AASEFW:	0	;FILL WORD

PBLK

IGTXT:	TLNN I,ILMWRD
	 RET
	PUSH P,A	;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD
	SKIPLE AASCF2	;DETECT SCREW CASE:  AFTER ASCIZ OF 5 CHARS, DELIMITER IS
	 JRST IGTXT1	;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS.
	PUSHJ P,RCH
	CAME A,TEXT4
	 JRST .-2
IGTXT1:	TLZ I,ILMWRD
	MOVEMM ASMDSP,ASMDS1
	SETZM DEFNPS
	SETOM TEXT4
	JRST POPAJ

;".ASCVL  /X" RETURNS THE ASCII VALUE OF "X".  NOTE THE DELIMITER IS NOT REPEATED
;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE.
A.ASCV:	CALL PASSPS	;SKIP SPACES TO REACH THE DELIMITER.
	CALL RCH	;READ THE CHAR AFTER THE DELIMITER
	MOVE T,A
	JRST TEXT5	;AND RETURN ITS ASCII VALUE.
ASQOZ:	HLLM B,(P)	;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ .
	PUSH P,SYM
	PUSHJ P,AGETFD
	LSH A,36
	PUSH P,A
	PUSHJ P,GETSLD	;GET SYM, SAVE DELIMITER FOR REINPUT
	 CALL NONAME
	REST A
	LDB B,[4000,,SYM]	;GET JUST THE SQUOZE.
	SKIPGE -1(P)
	 PUSHJ P,ASQOZR	;FOR .RSQZ, RIGHT-JUSTIFY IT.
	SUB P,[1,,1]
	ADD A,B
	JRST CLBPOP

;RIGHT-JUSTIFY THE SQUOZE WORD IN B.
ASQOZR:	MOVE SYM,B
	IDIVI SYM,50
	JUMPN LINK,CPOPJ	;LAST ISN'T BLANK, DONE.
	MOVE B,SYM	;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR.
	JRST ASQOZR

		;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY
		;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC.
		;INTSYMS MAY APPEAR TO LEFT OF =

INTSYM:	MOVE A,B	;GET ADR IN LH(A)
	JRA A,CLBPOP	;RETURN IT

		;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B)

STGWS:	HLRES B		;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS.
	ADDB B,STGSW
	SKIPGE B	;BUT DON'T DECREMENT PAST 0.
	 SETZM STGSW
	JRST MACCR	;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO.

		;.TYPE

A.TYPE:	PUSH P,SYM
	PUSH P,SYM
	PUSHJ P,GETSLD	;GET NAME
	 CALL NONAME
	SUB P,[2,,2]
	TRNN I,IRLET	;IF SYLLABLE IS A NUMBER,
	 JRST [	SETO A,	;RETURN -1.
		JRST CLBPOP]
	PUSHJ P,ES	;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A
	 MOVEI A,17	;DIDN'T SKIP, RETURN 17 => UNSEEN
IFN CREFSW,XCT CRFINU
	JRST CLBPOP

NONAME:	MOVE SYM,-2(P)
	ETSM [ASCIZ /No arg/]
	SETZ SYM,
	POPJ P,

		;.FORMAT

A.FORMAT:	PUSHJ P,AGETFD	;GET FIRST FIELD (FORMAT #)
	MOVE B,CDISP	;WORD TERMINATOR ENDED 1ST ARG =>
	TLNN B,DWRD
	 JRST A.FOR1	;RETURN CURRENT SPEC FOR THAT FORMAT.
	PUSH P,A
	PUSHJ P,AGETFD	;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER)
	POP P,B
	MOVEM A,FORTAB-10(B)
	JRST ASSEM1

A.FOR1:	MOVE A,FORTAB-10(A)
	JRST CLBPOP
A.BYTE:	NOVAL
	CLEARM NBYTS	;# BYTES ASSEMBLED
	CLEARM BYTMT	;TOTAL ACTIVE BYTES IN TABLE
	MOVE A,[440700,,BYBYT]	;POINTER TO NEW TABLE
	MOVEM A,BYTMP
A.BY1:	PUSHJ P,AGETFD	;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE
	MOVE C,ISAV
	TRNN C,IRFLD
	 JRST A.BY2	;NO FIELD
	MOVM B,A
	SKIPGE A
	 TRO B,100
	IDPB B,BYTMP
	AOS BYTMT
A.BY2:	TLNE CH1,DWRD	;CDISP LEFT IN CH1 BY AGETFD
	 JRST A.BY1	;NOT WORD TERMINATOR
	SKIPN BYTMT	;WORD TERMINATOR, ANY FIELDS?
	 JRST A.BY3	;NO, DO .WALGN AND RESET TO WORD MODE
	SETOM BYTM	;ENTERING BYTE MODE
	MOVE A,[-LPDL,,PDL]
	CAMN A,ASSEMP
	 SETOM BYTM1
	PUSHJ P,BYSET
	MOVE A,GLSPAS
	MOVEM A,GLSP1
	JRST ASSEM1

		;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD

BYSET:	CLEARM BYTMC	;COUNT OF BYTES PROCESSED THIS TABLE SCAN
	MOVE A,[440700,,BYBYT]	;POINTER TO DESCRIPTOR TABLE
	MOVEM A,BYTMP
	ILDB A,BYTMP	;FIRST DESCRIPTOR BYTE
	AOS BYTMC
	DPB A,[300600,,BYTWP]	;DEPOSIT AS FIRST BYTE SIZE
	POPJ P,

A.BY3:	CLEARM BYTM	;NO LONGER IN BYTE MODE
	MOVE A,[-LPDL,,PDL]
	CAMN A,ASSEMP
	SETZM BYTM1
	JRST A.WAL1

A.WALGN:	NOVAL
A.WAL1:	LDB A,[360600,,BYTWP]
	CAIN A,44
	 JRST ASSEM1	;ALREADY AT BEGINNING OF WORD
	MOVEI A,44
	DPB A,[360600,,BYTWP]	;MAKE IT POINT TO BEGINNING OF WORD
	PUSHJ P,BYSET
	CLEARM T1
	JRST PBY1
BYTIN1:	CLEARM BYTMC
	MOVE A,[440700,,BYBYT]
	MOVEM A,BYTMP
BYTINC:	AOS A,BYTMC
	CAMLE A,BYTMT
	 JRST BYTIN1
	ILDB A,BYTMP
	DPB A,[300600,,BYTWP]
	MOVEM A,T1
	HLLZ A,BYTWP
	IBP A
	TRNN A,-1
	 JRST BYTINR
		;NEXT BYTE GOES IN NEXT WORD
PBY1:	MOVE P,ASSEMP	;PCONS NEEDS THIS.
	MOVEI A,WRD-1
	PUSH A,BYTW	;INTO WRD,
	PUSH A,BYTRLC	;INTO WRDRLC
	CLEARM BYTW
	SETZM BYTRLC
	MOVEI A,44
	DPB A,[360600,,BYTWP]
	MOVE AA,ASMOUT
	JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3

PBY4:	SKIPE STGSW
	 ETR ERRSWD
	PUSHJ P,PWRD	;NOT IN CONST., OUTPUT WORD.
	AOSA CLOC
PBY3:	JSP T,PCONS	;OUTPUT INTO CONST.
PBY5:	MOVE A,GLSPAS
	MOVEM A,GLSP1
BYTINR:	MOVE A,T1	;CURRENT BYTE SIZE
	TRNN A,100
	 JRST @ASMDSP
	SETZB A,B	;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE
	JRST PBY2

PBYTE:	AOS NBYTS
PBY2:	MOVEI AA,WRD-1
	PUSH AA,BYTW	;INTO WRD
	PUSH AA,BYTRLC	;INTO WRDRLC
	IBP BYTWP
	LDB T,[301400,,BYTWP]
	PUSHJ P,INTFLD
	POP AA,BYTRLC	;WRDRLC
	POP AA,BYTW	;WRD
	JRST BYTINC

		;VARIABLES FOR .BYTE, .BYTC, .WALGN

VBLK
BYTM:	0	;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S  ;]
BYTMC:	0	;COUNT CORRESP WITH BYTMP
BYTMP:	0	;POINTER TO BYTE DESC TABLE
BYTMT:	0	;TOTAL ACTIVE BYTES IN TABLE
BYTM1:	0	;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET

;FORMAT OF BYTE DESC TABLE
;SEVEN BIT BYTES
;1.7=0 ASSEMBLE =1 BLANK
;1.1 - 1.6 NUMBER OF BITS

IFNDEF LBYBYT,LBYBYT==5	;LENGTH OF BYBYT
BLCODE [BYBYT:	BLOCK LBYBYT]	;BYTE DESC TABLE, 7 BITS PER DESC

BYTWP:	440000,,BYTW	;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE
BYTW:	0	;WORD BEING ASSEMBLED IN BYTE MODE
BYTRLC:	0	;RELOC OF BYTW.
NBYTS:	0	;NUMBER BYTES ASSEMBLED (FOR .BYTC)
BYTMCL==.-BYTMC
PBLK
;;MACRO PROCESSOR
IFN MACSW,[
		;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A

REDINC:	MOVE CH1,A
	IDIVI CH1,4
	LDB B,PTAB(CH2)
	AOJA A,CPOPJ

VBLK	;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED.
PTAB:	(341000+CH1)MACTBA	;BYTE TABLE
	(241000+CH1)MACTBA
	(141000+CH1)MACTBA
	(41000+CH1)MACTBA
	(341000+CH1)MACTBA+1

	;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN)
	;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD

		;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1

DEFINE BCOMP A,B/
	IDIVI <A>,4
	ADD <A>,(<A>+1)BCOMPT!B
TERMIN

STOPPT:	041000,,MACTBA-1
BCOMPT:	341000,,MACTBA
	241000,,MACTBA
BCOMPU:	141000,,MACTBA
	041000,,MACTBA
	341000,,MACTBA+1

;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1)
;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR.
DEFINE CCOMP A,B/
	MOVEI <A>-1,0
	ASHC <A>-1,2
	SUB <A>,(<A>-1)CCOMPT!B
TERMIN

		;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A

DEFINE CCOMP1 A,B/
	MULI <A>,4
	SUB <A>+1,(A)CCOMPT!B
TERMIN

;FROM HERE THRU CCOMPE SET BY MACINI.
CCOMPB:	0	;4*<41000,,MACTBA>-4
CCOMPT:	REPEAT 5,0	;4*<41000,,MACTBA>+.RPCNT-3
CCOMPE::PBLK

		;BP IN A, DECREMENT IT

DEFINE DBPM A
	ADD A,[100000,,]
	SKIPGE A
	SUB A,[400000,,1]
TERMIN
;SET UP CPTR FROM CHAR ADR IN A

ACPTRS:	MOVEI CH1,(A)	;GET CHAR ADR IN CH1
	BCOMP CH1,-1	;CONVERT TO BYTE POINTER
	MOVEM CH1,CPTR	;STORE COMPUTED CPTR
	POPJ P,

AFCOMP:	HRRZM A,FREEPT	;ENTRY TO STORE C(A) INTO FREEPT
FCOMP:	MOVE CH1,FREEPT	;COMPUTE FREPTB FROM FREEPT
	BCOMP CH1,-1
	MOVEM CH1,FREPTB	;STORE CALCULATED BYTE POINTER
	POPJ P,

STPWR:	MOVEI A,375
	JRST PUTREL

VBLK
PUT377:	MOVEI A,377
PUTREL:	JRST PUTRE1	;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE
	AOS A,FREEPT	;CLOBBERS ONLY A.
	AOS PUTCNT
	CAMGE A,MACHI
	POPJ P,
	JRST GCA
PBLK
PUTRE1:	PUSH P,[IDPB A,FREPTB]
	POP P,PUTREL	;COME HERE ONLY ON 1ST CALL TO PUTREL.
	SETOM INICLB	;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT.
	JRST PUTREL	;NOW GO BACK AND REALLY WRITE CHAR.

;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION
;CLOBBERS A,CH1,CH2.

MACTRM:	CAIN A,176	;376?
	JRST RCHTRA	;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE
	PUSH P,B	;SAVE B
	CAIE A,177
	CAIN A,175
	JRST MRCH1	;377, 375 => STOP
	ADD A,BBASE	;DUMMY, RELOCATE TO POINT TO DUMMY TABLE
	MOVEI B,RCHSAV	;RETURN TO RCHSAV ON END OF DUMMY
	PUSHJ P,PUSHEM	;SAVE CURRENT STATUS
	HRRZ A,(A)	;GET CHAR ADR OF DUMMY
	BCOMP A,-1	;CONVERT TO BYTE POINTER
	MOVEM A,CPTR	;STORE AS NEW CPTR
	MOVE A,TOPP
	MOVEM A,BBASE
RCHTRB:	POP P,B
RCHTRA:	POP P,A	;POP RETURN
	TLZN FF,FLUNRD	;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP.
	 JRST -3(A)
	ANDI A,-1	;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU
	CAIN A,RREOF+1
	 JRST RRU
	PUSH P,A		;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM
	JRST RCH1	;THE CURRENT ATTEMPT TO READ A CHAR.

MRCH1:	MOVE B,MACP
BPOPJ:	POPJ B,		;RETURN AT END OF STRING EXPANSION
;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR

RCHMAC:	TLO FF,FLMAC	;SET FLAG
	JSP A,CPOPJ
RCHMC0:	REPEAT 2,[	;GETCHR, RR1
	ILDB A,CPTR	;GET CHAR
	TRZE A,200	;200 BIT...
	PUSHJ P,MACTRM	;=> SPECIAL, PROCESS
]
	.VALUE
IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES.
	ILDB A,CPTR	;SEMIC
	TRZE A,200
	PUSHJ P,MACTRM
	CAIE A,15
	JRST SEMIC	;NOT YET
	JRST SEMICR	;YET

		;PUSH INPUT STATUS IN FAVOR OF MACRO
		;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER)
		;SEE ALSO PMACP

PUSHEM:	PUSH P,A
	PUSH P,F
	MOVE F,MACP	;GET MACRO PDL POINTER
	MOVE CH1,CPTR
	CCOMP1 CH1,-1	;CONVERT TO CHARACTER ADDRESS
	HRL CH2,BBASE
	PUSH F,CH2	;PUSH BBASE,,CPTR
	MOVEI A,1	;=> EXPAND MACRO
	PUSHJ P,PSHLMB	;SAVE LIMBO1 STATUS AND RETURN
	JRST PSHM1

		;UNDO A PUSHEM
		;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT)

POPEM:	PUSH P,A
	PUSH P,F
	MOVE F,MACP
	PUSHJ P,POPLMB	;RESTORE LIMBO1 STATUS
	POP F,B		;BBASE,,CPTR
	MOVEI CH1,(B)	;GET CHAR ADR IN CH1
	BCOMP CH1,-1	;CONVERT TO BYTE POINTER
	MOVEM CH1,CPTR	;STORE NEW CPTR
PSHM1:	MOVEM F,MACP	;STORE BACK MACRO PDL POINTER
POPFAJ:	POP P,F
POPAJ:	POP P,A
	POPJ P,
PMACP:	MOVE B,MACP	;POP MACRO PDL
	HRRZ A,(B)
	SUB B,[1,,1]
IFN RCHASW,CAIE A,A.TYM8
	CAIN A,AIRR
	JRST A.GO6	;IRP OR .TTYMAC
	CAIN A,REPT1
	JRST A.GO4	;REPEAT
	CAIE A,RCHSV1	;MACRO
	CAIN A,RCHSAV	;ARG
	JRST A.GO6
	.VALUE		;DON'T HAVE RETURN,
	JRST A.GO6	;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT

A.GO4:	HLLZS -1(B)	;REPEAT, CLEAR OUT COUNT REMAINING
A.GO6:	TRO FF,FRMRGO	;EVERYTHING ELSE, SET FLAG TO QUIT
	JRST (A)

		;4.9(B) => .STOP ELSE .ISTOP

A.STOP:	HRRZ A,MACP
	JUMPL B,A.STP1
	HRRZ B,(A)	;.ISTOP
	CAIN B,REPT1
	HLLZS -2(A)	;REPEAT, STOP ALL INTERATIONS
	CAIN B,AIRR
	HRRZS -1(A)	;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE
A.STP1:	MOVE A,STOPPT
	MOVEM A,CPTR	;CAUSE STOP
	JRST POPJ1

A.QOTE:	JFCL
ATERMI:	ETSM [ASCIZ/Not in macro/]
	JRST MACCR	;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS
;PDL STRUCTURE FOR REPEAT
;TWO TWO WORD ENTRIES
;BBASE,,CPTR
;LIMBO1 STATUS,,# TIMES LEFT
;OLD .RPCNT,,BEG OF BODY
;GARBAGE,,REPT1

AREPEAT:	PUSHJ P,AGETFD
	JUMPLE A,COND5	;NO REPEAT PLAY LIKE STRING COND FALSE
	PUSH P,A
	MOVE A,FREEPT
	MOVEM A,PRREPT	;CHAR ADR BEGINNING OF REPEAT
	MOVEI A,373	;CHECK CHAR FOR REPEAT
	PUSHJ P,PUTREL	;STORE AS FIRST CHR OF BODY
	JSP D,RARL1
	 CAIA
	CALL RARGCP	;READ THE ARG & COPY INTO MACRO STORAGE.
	MOVEI A,^M	;IF THE ARG WASN'T BRACKETED,
	TLNE FF,FLUNRD
	 CALL PUTREL	;INCLUDE THE TERMINATING CR.
SWRET1:	PUSHJ P,STPWR	;ALSO RETURN FROM STRING WRITE (.F .I)
	POP P,B		;# TIMES TO GO THROUGH
	PUSHJ P,PUSHEM
	MOVE B,MACP	;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY
	MOVNI T,1
	EXCH T,CRPTCT	;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1
CREPT1:	SETZI TT,REPT1
	EXCH TT,PRREPT	;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE
	HRL TT,T
	PUSH B,TT	;SAVE OLD .RPCNT,,ADDRESS OF BODY.
	PUSH B,CREPT1	;PUSH CRUD,,REPT1 FOR RETURN
	MOVEM B,MACP	;STORE BACK UPDATED MACRO POINTER
	MOVE A,STOPPT
	MOVEM A,CPTR	;CAUSE IMMEDIATE CYCLE
	JRST MACCR

IFN .I.FSW,[	;CODING FOR .I, .F

SWINI:	MOVE A,FREEPT	;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1
	MOVEM A,PRREPT
	MOVEI A,373
	JRST PUTREL

SWRET:	PUSH P,[1]	;REPEAT COUNT
	JRST SWRET1

SWFLS:	MOVE A,PRREPT	;FLUSH RETURN
	PUSHJ P,AFCOMP
	JRST MACCR
]
;RECYCLE AROUND REPEAT

REPT1:	PUSH P,A
	PUSH P,C
	HRRZ A,(B)	;CHAR ADR BEG BODY
	PUSHJ P,REDINC
	CAIE B,373
	 HALT		;FIRST CHAR OF REPEAT BODY NOT 373
	HRRZ C,MACP
	HRRZ B,-2(C)	;# TIMES LEFT
	SOJL B,REPT2	;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH
	AOS CRPTCT
	PUSHJ P,ACPTRS	;SET UP CPTR (CHAR ADR IN A)
	HRRM B,-2(C)	;STORE UPDATED COUNTDOWN
REPT3:	POP P,C
	POP P,A
	JRST REPT6

REPT2:	SOS A	;MOVE BACK TO BEG OF REPEAT
			;(IN CASE GETS STORED INTO FREEPT)
	MOVE CH2,CPTR
	CCOMP CH2,-1	;CONVERT TO CHARACTER ADDRESS
	CAMN CH2,FREEPT
	PUSHJ P,AFCOMP
	MOVE A,[-3,,-2]
	ADDB A,MACP
	HLRZ A,1(A)
	MOVEM A,CRPTCT
	PUSHJ P,POPEM
	JRST REPT3
;STRING CONDITIONALS (IFSE, IFSN)

SCOND:	MOVE A,FREEPT
	MOVEM A,PRSCND
	MOVEM A,PRSCN1
	PUSH P,SYM
	HRRI B,SCONDF
	PUSH P,B		;REMEMBER TEST INSTRUCTION.
	SETOB C,SCONDF
	JSP D,RARG	;COPY THE 1ST OF THE 2 STRINGS
	 CAIA
	CALL RARGCP	;INTO MACRO STORAGE, FOLLOWED BY 375.
	CALL STPWR
	JSP D,RARG	;THEN START READING THE 2ND ARG,
	 JRST SCOND3	;GO TO SCOND3 WHEN REACH END OF 2ND ARG.
	JSP D,RARGCH(T)	;READ NEXT CHAR OF 2ND ARG,
	 JRST SCOND3
	EXCH A,PRSCND
	PUSHJ P,REDINC	;RE-FETCH NEXT CHAR OF 1ST ARG
	EXCH A,PRSCND
	CAMN B,A	;COMPARE CHARACTERS
	 JRST RARGCH(T)	;CHARS EQUAL, KEEP COMPARING.
	CAIL A,"A+40
	 CAILE A,"Z+40	;NOT EQUAL => CONVERT BOTH TO UPPER CASE.
	  CAIA
	   SUBI A,40
	CAIL B,"A+40
	 CAILE B,"Z+40
	  CAIA
	   SUBI B,40
	CAMN B,A	;ARE THEY SAME EXCEPT FOR CASE?
	 JRST RARGCH(T)	;CHARS EQUAL, KEEP COMPARING.
	CLEARM SCONDF	;STRINGS DIFFER
	CALL RARFLS	;IGNORE REMAINDER OF 2ND ARG.
SCOND3:	CLEARB A,C	;END OF (SECOND) STRING ARG ENCOUNTERED
	EXCH C,PRSCN1
	MOVEM C,FREEPT
	PUSHJ P,FCOMP
	EXCH A,PRSCND
	PUSHJ P,REDINC
	CAIE B,375
	CLEARM SCONDF
	REST B
	REST SYM
	XCT B		;DO THE TEST.
	JRST COND4
	JRST COND2
VBLK
BLCODE [DMYDEF:	BLOCK DMDEFL]	;TABLE OF DUMMY NAMES FOR THING BEING DEFINED
DMYTOP:	DMYDEF		;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD
		;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP
DMYBOT:	DMYDEF	;-> 1ST DMYDEF WD USED AT THIS LEVEL.
	;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION
	;WITHIN A DEFINITION YET.

PBLK

PDEF:	PUSHJ P,GSYL	;READ IN SYL
	CAIE T,",	;IF DELIMITING CHR NOT ,
	 JUMPE SYM,CPOPJ	;AND SYM NULL, RETURN
PDEF1:	MOVEM SYM,@DMYTOP	;STORE SYM
	AOS D,DMYTOP		;INCR PNTR
	CAIL D,DMYDEF+DMDEFL	;CHECK FOR TABLE SIZE EXCEEDED
	 ETF [ASCIZ/Too many dummies in DEFINE or IRP/]
	POPJ P,

VBLK
BLCODE [DSTG:	BLOCK DSSIZ]	;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION
RDWRDP:	DSTG		;POINTER TO DSTG, POINTS TO FREE WORD
		;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN
		;BE EXPANDED DURING FIELD READ FOR DUMMY
PBLK

ADDTR1:	CLEARM PUTCNT
ADDTRN:	MOVE A,FREEPT
ADDTR2:	MOVEM A,@RDWRDP
	AOS A,RDWRDP
	CAIL A,DSTG+DSSIZ
	 ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/]
	RET

VBLK
BLCODE [DMYAGT:	BLOCK DMYAGL]	;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED
		;DMYAGT TRACKS WITH THE MACRO PDL;
		;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN
BBASE:	DMYAGT		;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED)
		;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY
TOPP:	DMYAGT		;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER
PBLK

		;ACTIVATE DUMMYS ON TOP OF DSTG TABLE
		;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE

DMYTRN:	MOVE B,TOPP
	MOVEM B,BBASE
	PUSH P,A
DMYTR2:	CAML A,RDWRDP
	JRST DMYTR1
	MOVE B,(A)
	MOVEM B,@TOPP
	AOS B,TOPP
	CAIL B,DMYAGT+DMYAGL
	 ETF [ASCIZ /Too many dummy args active/]
	AOJA A,DMYTR2
DMYTR1:	POP P,RDWRDP
	POPJ P,
;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES.
;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND.
;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI.
;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1)

;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER.
;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS
;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 .

;377 AND 375  ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING.
;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING.

;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS.

;374 STARTS EVERY MACRO-DEFINITION.
;373 STARTS THE BODY OF A REPEAT.

;370 STARTS A WORD STRING:
;THE WORD AFTER THAT WHICH CONTAINS THE 370
; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH,
; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE.
; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL.
; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY.
; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH.
; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING

STRTYP:	PUSHJ P,REDINC	;DEBUGGING AID ONLY
	EXCH A,B
	TRZE A,200
	JRST STRTP1
STRTP2:	PUSHJ P,TYO	;NORMAL CHAR, JUST TYPE OUT
	MOVE A,B
	JRST STRTYP

STRTP1:	PUSH P,A
	MOVEI A,"*	;SPECIAL CHAR, TYPE *
	PUSHJ P,TYO
	POP P,A
	TRNE A,100
	JRST STRTP3	;CONTROL CHAR
	ADDI A,260	;DUMMY, CONVERT TO #
	JRST STRTP2	;TYPE OUT (SINGLE DIGIT) NUMBER

STRTP3:	CAIN A,175
	SKIPA A,C%	;STOP, TYPE %
	MOVEI A,"/	;SOMETHING ELSE, TYPE /
	JRST STRTP2


		;.GSSET, SET GENERATED SYM COUNTER

A.GSSET:	CALL AGETFD
	MOVEM A,GENSM
	JRST ASSEM1
;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE

WRQRR:	PUSHJ P,RCH	;GET CHAR (MAYBE WANT THIS TO BE FASTER YET)
	IDPB A,FREPTB	;DEPOSIT IN MACRO TABLE
	CAMN F,FREPTB	;WAS THIS LAST CHAR IN TABLE?
	JRST WRQRGC	;YES, NEED GARBAGE COLLECTION
WRQRR2:	XCT GDTAB(A)	;DISPATCH ON CHAR
	JFCL		;(MAYBE SKIPS)
	SOJGE D,WRQRR	;LOOP FOR FIRST SEVEN CHARS
	HRRI D,0
	JRST WRQRR

		;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE

WRQRGC:	MOVEM C,WRQTBP	;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D
	MOVE A,MACHI
	PUSHJ P,GCA	;GARBAGE COLLECT
	MOVE F,MACHIB	;RESET F TO POINT TO NEW LAST CHAR IN MACTAB
	MOVEI C,0
	EXCH C,WRQTBP	;GET BACK POINTER TO CHAR BEFORE SYL
	MOVE A,LIMBO1	;RETRIEVE LAST CHAR READ
	JRST WRQRR2	;LOOP BACK, PROCESS CHAR

		;HERE FROM WRQOTE IF .QUOTE SEEN
		;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC.

A.QOT1:	MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE
	PUSHJ P,A.QOTS	;SET UP FREEPT AND FREPTB PROPERLY
	MOVE A,LIMBO1	;NOW GET CHAR AFTER .QUOTE
	CAIE A,^I
	CAIN A,40	;COMPARE WITH SPACE
	PUSHJ P,RCH	;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE
	MOVEM A,A.QOT2	;STORE AS TERMINATOR OF STRING
A.QOT3:	PUSHJ P,RCH	;GET CHAR TO QUOTE
	CAMN A,A.QOT2	;TERMINATOR?
	JRST WRQOT1	;TERMINATOR, BACK FOR MORE DEFINITION
	PUSHJ P,PUTREL	;DEPOSIT CHAR
	JRST A.QOT3
;READ IN BODY OF MACRO, IRP, OR WHATEVER

WRQOTE:	PUSH P,[0]	;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT).
WRQLEN==,-2
	PUSH P,[0]	;THIS WD USED FOR DEFINE/TERMIN COUNT.
WRQLVL==,-1
	PUSH P,[0]	;USED TO REMEMBER BEGINNING OF SYMBOL.
WRQBEG==0
	SETOM INICLB	;CLOBBERED INITS, .SYMTAB NOW ILLEGAL.
	PUSHJ P,RCH	;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE
	TLO FF,FLUNRD	;CAUSE CHAR TO BE RE-INPUT
	MOVE F,MACHIB	;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F
	TRO I,IRSYL\IRLET	;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT
WRQOT0:
WRQOT1:	MOVEI D,6	;SQUOZE COUNTER
	MOVEI SYM,0	;INITIALIZE SYM
	MOVE C,FREPTB	;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ
	PUSHJ P,WRQRR	;READ SYL
	JUMPE SYM,.-2	;LOOP UNTIL NON-NULL
		;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR
	MOVE B,DMYBOT
	CAML B,DMYTOP
	JRST WRQOT2	;NOT DUMMY
	CAME SYM,(B)	;COMPARE WITH DUMMY NAME
	AOJA B,.-3	;LOOP ON NO MATCH
	SUB B,DMYBOT	;DUMMY, CONVERT TO NUMBER + 200
	SUBI B,200
	LDB T,C		;GET LAST CHAR BEFORE SYL
	CAIE T,"!	; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS
	IDPB B,C	;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR
	CAIN T,"!
	DPB B,C		;EXCL, WIPE IT OUT
	MOVEM C,FREPTB	;RESET FREPTB
	CAIE A,"!	;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL
	TLO FF,FLUNRD	;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT
	JRST WRQOT1	;LOOP BACK FOR NEXT SYL

;SYL ISN'T DUMMY, CHECK FOR PSEUDO
WRQOT2:	MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL.
	MOVEM C,WRQBEG(P)
	SETOM ESBK	;EVAL IN CURRENT BLOCK.
	PUSHJ P,ES	;EVALUATE SYM (DOESN'T CLOBBER F)
	 JRST WRQOT0	;NOT SEEN
	CAIE A,PSUDO/40000
	JRST WRQOT0	;NOT PSEUDO
	TLZ B,-1	;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH
	CAIN B,A.QOTE
	JRST A.QOT1	;.QUOTE
	CAIE B,ADEFINE
	CAIN B,AIRP
	AOS WRQLVL(P)	;DEFINE OR IRP
IFN RCHASW,[CAIN B,A.TTYM
	AOS WRQLVL(P)	;.TTYMAC
]
	CAIE B,ATERMIN
	 JRST WRQOT0
	SKIPGE WRQLEN(P)
	 ETR [ASCIZ /TERMIN longer than 6 chars/]
	SOSL WRQLVL(P)	;TERMIN, SKIP IF THE TERMINATING ONE
	 JRST WRQOT0	;NOT MATCHING TERMIN, BACK FOR NEXT SYL
	POP P,A		;GET BACK BP TO LAST CHAR BEFORE TERMIN
	SUB P,[2,,2]	.SEE WRQLVL,WRQBEG
	MOVE T,DMYBOT	;WE'RE NO LONGER USING SPACE IN DMYDEF.
	MOVEM T,DMYTOP
A.QOTS:	LDB T,A		;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN
	CAIE T,"!
	JRST A.QTS2	;NOT EXCLAMATION POINT => OK
	DBPM A,		;EXCLAMATION POINT, DECREMENT POINTER
A.QTS2:	MOVEM A,FREPTB	;STORE AS NEW FREPTB
	CCOMP1 A,-1	;CONVERT TO CHAR ADR
	MOVEM B,FREEPT	;STORE CHAR ADR AS NEW FREEPT
	POPJ P,
;FORMAT OF A MACRO:
;IT STARTS WITH A 374.
;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT.
MCF==777650	;BITS AND FIELDS ARE:
MCFDEF==200	;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET.
MCFGEN==100	;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL.
MCFKWD==40	;ARG IS A KEYWORD ARG, SELECTED BY <ARGNAME>= RATHER THAN POSITION.
MCFSYN==7	;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX.
 MCFNRM==1	;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG
 MCFLIN==2	;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG
 MCFBAL==3	;MCFSYN CONTAINS MCFBAL => BALANCED ARG
 MCFSTR==4	;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ".
 MCFKST==5	;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED.
 MCFEVL==6	;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED).
;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT,
;TERMINATED BY A 377.
;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG,
;TERMINATED BY A 377.
;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST.
;A ZERO BYTE ENDS THE DESCRIPTOR LIST.
;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375.

ADEFINE:	NOVAL	;ERROR IF CONTEXT WANTS A VALUE.
	PUSH P,CASSM1	;RETURN TO ASSEM1 EVENTUALLY
	JSP TM,ERMARK	;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE.
	PUSH P,SYM	;THESE 2 PUSHES ARE FOR NONAME'S SAKE.
	PUSH P,SYM
	CALL GETSLD
	 CALL NONAME
	TLZ FF,FLUNRD
	SUB P,[2,,2]
	PUSH P,SYM
	PUSH P,ESBK	;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE.
IFN CREFSW,XCT CRFMCD
	CALL A.TYM1
	POP P,ESBK
	REST SYM
	PUSHJ P,ESDEF	;FIND SLOT IN SYMBOL TABLE FOR IT
	 TLO C,3MACOK	;NEVER SEEN, OK TO MAKE MACRO.
	TLON C,3MACOK	;ELSE ERROR IF NUMERIC OR ALREADY USED.
	 ETSM [ASCIZ/Non-macro made macro/]
	MOVEI B,MACCL	;RH(VALUE) = MACCL
	HRL B,PRDEF	;LH(VALUE) = CHAR ADR OF MACRO
	CLEARM PRDEF	;NO LONGER NEED PRDEF
	MOVSI T,PSUDO	;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO
	JRST VSM2

IFN RCHASW,[
	;.TTYMAC NAME
	;BODY
	;TERMIN

	;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE)

A.TTYM:	JSP TM,ERMARK	;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC
	CALL A.TYM1	;READ IN A MACRO-DEFINITION.
	MOVEI A,40	;DON'T LET THE CHAR ENDING THE TERMIN
	MOVEM A,LIMBO1	;MAKE MACCL THINK THERE ARE NO ARGS.
	CALL GTYIP1	;PUSH INTO TTY FOR INPUT
	HRLZ B,PRDEF	;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ.
	SETZM PRDEF
	MOVEI A,A.TYM8
	JRST A.TYM2	;CALL THE MACRO:
		;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO
		;AND THEN EXIT TO A.TYM8
]
A.TYM1:	MOVE A,FREEPT
	MOVEM A,PRDEF
	MOVEI LINK,MCFNRM	;INITIALLY, DUMMIES ARE NORMAL.
	MOVEI A,374
	PUSHJ P,PUTREL	;MARK BEGINNING OF MACRO
DEFNI:	MOVE T,LIMBO1
	MOVE A,LINK
DEFNC:	CAIE T,12
	 CAIN T,15
	  JRST DEFNA	;NO MORE ARGS (DONE WITH LINE)
	CAIE T,LBRACE
	 CAIN T,LBRKT
	  JRST DEFNB1
	CAIE T,RBRACE
	 CAIN T,RBRKT
	  JRST DEFNB2
	CAIE T,"<	;OPENS TURN ON BALANCEDNESS.
	 CAIN T,"(
	  JRST DEFNB1
	CAIE T,">	;CLOSES TURN OFF BALANCEDNESS.
	 CAIN T,")
	  JRST DEFNB2
	CAIN T,"?	;? TURNS BALANCEDNESS ON OR OFF.
	 JRST DEFBAL
	CAIN T,"+	;+ COMPLEMENTS KEYWORDNESS
	 XORI LINK,MCFKWD
	CAIN T,"\	;\ COMPLEMENTS GENSYMMEDNESS
	 XORI LINK,MCFGEN
	CAIN T,"-	;- TURNS WHOLELINENESS ON OR OFF.
	 JRST DEFWHL
	CAIN T,"*	;* TURNS ASCIZ-STYLE-NESS ON OR OFF.
	 JRST DEFASC
	CAIN T,"&	;& TURNS KEEP-STRUNGNESS ON OR OFF.
	 JRST DEFKST
	CAIN T,"#	;# TURNS EVALUATEDNESS ON OR OFF.
	 JRST DEFEVL
	CAIN T,":	;: MAKES FOLLOWING ARGS NORMAL
	 MOVEI LINK,MCFNRM	;IN ALL RESPECTS
	CAIN T,";
	 JRST DEFNSM	;ALLOW DEFINE LINE TO BE COMMENTED
DEFND:	PUSH P,A
	CALL GSYL	;READ IN SYMBOL AS SQUOZE IN SYM.
	REST A
	CAIN T,"/	;/ MEANS PREVIOUS ARG IS WHOLE-LINE.
	 XORI LINK,MCFLIN#MCFNRM
	JUMPE SYM,DEFNC	;JUMP IF SYMBOL NAME WAS NULL.
	CALL PDEF1	;ELSE PUSH IT ON LIST OF DUMMIES.
	MOVE A,LINK
	CAIE T,"=
	 JRST DEFNL
	IORI A,MCFDEF	;ONE ARG, WITH DEFAULT VALUE.
	ANDCMI A,MCFGEN	;NOT TO BE GENSYMMED.
DEFNL:	CALL PUTREL	;OUTPUT A DESCRIPTOR FOR THIS ARG
	TRNE LINK,MCFKWD
	 CALL DEFNM	;PUT OUT ARG NAME IF KWD ARG
	CAIE T,"=	;THEN DEFAULT VALUE IF DEFAULTED.
	 JRST DEFNI
	JSP D,RARG	;INIT. FOR READING THE DEFAULT VALUE.
	 CAIA
	CALL RARGCP	;COPY THE ARG INTO MACRO SPACE,
	CALL PUT377	;TERMINATED BY A 377.
	JRST DEFNI	;NOW FOR THE NEXT ARG.

DEFNM:	MOVE D,[440700,,STRSTO]
DEFNM1:	ILDB A,D
	CAMN D,STRPNT
	 JRST PUT377
	CALL PUTREL
	JRST DEFNM1

DEFEVL:	SKIPA A,[MCFEVL]	;TURN EVALUATEDNESS ON OR OFF.
DEFASC:	 MOVEI A,MCFSTR		;TURN ASCIINESS ON OR OFF.
	JRST DEFN9
DEFKST:	MOVEI A,MCFKST		;TURN KEEP-STRUNGNESS ON OR OFF.
	JRST DEFN9
DEFBAL:	SKIPA A,[MCFBAL]	;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF.
DEFWHL:	 MOVEI A,MCFLIN		;SIMILAR FOR WHOLELINENESS.
DEFN9:	LDB B,[.BP MCFSYN,LINK]
	CAMN A,B		;IF CURRENT STATE IS SAME AS IN A,
	 MOVEI A,MCFNRM		;SWITCH TO NORMAL MODE INSTEAD.
	DPB A,[.BP MCFSYN,LINK]
	JRST DEFND

DEFNB2:	SKIPA A,[MCFNRM]	;TURN OFF BALANCEDNESS
DEFNB1:	MOVEI A,MCFBAL		;TURN ON BALANCEDNESS
	DPB A,[.BP MCFSYN,LINK]
	JRST DEFND

DEFNSM:	PUSHJ P,RCH	;SEMICOLON IN DEFINE LINE
	CAIE A,15
	CAIN A,12
DEFNA:	SKIPA A,LINK	;END OF DEFINE LINE, GET COUNT
	JRST DEFNSM
	MOVEI A,0
	PUSHJ P,PUTREL	;DEPOSIT END-OF-DESCRIPTORS MARK
	PUSHJ P,RCH
	CAIE A,12
	TLO FF,FLUNRD	;CHAR AFTER CR NOT LF
	PUSHJ P,WRQOTE	;READ IN BODY
	JRST STPWR
;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING.
;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL).
MACCL:	JSP TM,ERMARK	;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT.
	MOVEI A,RCHSV1
A.TYM2:	PUSH P,I
	AOS PRCALP
	AOS MDEPTH
	PUSH P,RDWRDP
	PUSH P,A		;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA
	MOVEI LINK,0
	HLRZ A,B
	PUSHJ P,REDINC
	CAIE B,374
	 HALT
	MOVEM A,@PRCALP
	PUSHJ P,REDINC
	TLZ I,ILPRN
	JUMPE B,MACCLE		;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER.
	MOVE A,LIMBO1
	CAIE A,")		;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT
	 CAIN A,">		;=> UN-READ THE FOLLOWING CHARACTER.
	  JRST MACCLE
	CAIN A,RBRKT
	 JRST MACCLE
	CAIE A,15		;MACRO NAME ENDED BY A CR OR LF =>
	 CAIN A,12
	  JRST MACCLD		;NO ARGS IN THIS CALL; NULLIFY ALL ARGS.
	CAIE A,"<
	 CAIN A,"(
	  TLO I,ILPRN	;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL,
	CAIN A,LBRKT	;AND WON'T END TILL THE MATCHING CLOSE.
	 TLO I,ILPRN
	CAIE A,40	;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN,
	 CAIN A,^I	;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG.
	  JRST MACNX0
	TLNN I,ILPRN
	 TLO FF,FLUNRD
MACNX0:	TDZ LINK,LINK
MACNXD:	CALL MACDES	;FETCH NEXT DESCRIPTOR
	 JRST MACPUS	;NO MORE => THIS IS END OF THE CALL
	TRNE LINK,MCFKWD
	 JRST MACK	;KEYWORD PARAM => SPECIAL SCANNER
;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD)
MACNRM:	CALL ADDTRN	;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG,
			;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG.
	SOS C,A		;TELL MACRED WHERE THAT WORD IS.
	CALL MACRED	;READ IN THE ARGUMENT VALUE.
	 JRST MACNXD	;THEN HANDLE ANOTHER ARG
	 .VALUE
	JRST MACCLD	;END OF ARG LIST => NULLIFY REMAINING ARGS.

MACCLE:	TLO FF,FLUNRD	;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS
			;AND IF THAT CHAR WAS A CLOSE-BRACKET,
	SKIPE B,ASMOUT	;CLEAR OUT THE CHANGE IT MADE TO ASMDSP.
	 CAIN B,4
	  CAIA
	   JSP LINK,SAVAS2
	SETZ LINK,
	JRST MACCLD	;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT.
;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK.
;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG
;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING.  B AND LINK NOT CLOBBERED.
;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN.
MACRED:	MOVEI D,MACNXR	;RARL3, RARB, RARGBR RETURN TO MACNXR
	CALL RCH
	CAIE A,^M
	 CAIN A,^J
	  JRST MACEND	;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL.
	LDB B,[.BP MCFSYN,LINK]
	CAIN B,MCFLIN
	 JRST RARL3	;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK,
			;SO INIT FOR READING IT IN.
	CAIN A,",
	 JRST MACNUL	;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA
	CAIN A,";	;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG
	 JRST MACEND
	CAIN B,MCFBAL
	 JRST RARB	;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT.
	CAIE B,MCFSTR	;FOR BOTH FLAVORS OF STRUNGNESS,
	 CAIN B,MCFKST	;GO GOBBLE AN ASCIZ-STYLE ARGUMENT.
	  JRST MACSTR
	CAIN B,MCFEVL	;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL.
	 TLOA FF,FLUNRD  ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD.
	CAIN A,"\	;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD
	 JRST MACEVL	 ;STARTS WITH NEXT CHAR.
	CAIN A,LBRKT
	 JRST RARGBR	;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL
IFN BRCFLG,[
	CAIN A,LBRACE
	 JRST RARGRR
]
	MOVEI T,RARGN	;OTHERWISE IT'S A NORMAL ARG
	TLOA FF,FLUNRD	;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT
MACNXR:	 JRST MACEN1	;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL
	CALL RARGCP	;ARG NON-NULL => COPY IT INTO STRING SPACE
	CAIE A,";
CSTPWR:	 JRST STPWR	;AND TERMINATE IT
MACSC:	MOVE A,(C)	;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES
	CAME A,FREEPT	;AND TABS THAT PRECEDE THEM.
	 JRST STPWR	;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST.
;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN.
MACEND:	TLO FF,FLUNRD
MACEN1:	AOS (P)		;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST
	AOS (P)		;END OF ARGLIST => THIS ARG IS NULL.
;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS)
MACNUL:	TRZE LINK,MCFDEF
	 JRST MACDEF	;MAYBE DEFAULT IT
	TRNE LINK,MCFGEN
	 JRST MACGEN	;MAYBE GENSYM IT
	SETZM (C)	;ELSE SET TO NULL STRING.
	RET

MACST1:	CALL RCH
	CAIN A,",
	 JRST MACNUL
MACSTR:	CAIE A,40	;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/.
	 CAIN A,^I	;SKIP ALL SPACES AND TABS BEFORE THE ARG.
	  JRST MACST1
	JSP D,RARB	;FIND END OF LINE, COMMENT, OR CLOSEBRACKET =>
	 JRST MACEND	 ;NULLIFY ARG AND END MACRO CALL.
	MOVEI T,(A)	;ELSE SAVE THIS CHAR;  IT'S THE DELIMITER.
	TLZ FF,FLUNRD	;DON'T RE-READ DELIMITER,
	CAIN B,MCFKST	;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT.
MACST2:	 CALL PUTREL
	CALL RCH	;READ ANOTHER CHARACTER.  IF IT ISN'T THE DELIMITER,
	CAIE A,(T)
	 JRST MACST2	;STORE IT AND READ ANOTHER.
	CAIN B,MCFKST	;HIT DELIMITER, DONE.  BUT IF ARG IS KEEP-STRUNG,
	 CALL PUTREL	;KEEP DELIMITER BY STORING IT TOO.
	CALL STPWR
MACST3:	CALL RCH	;PASS BY SPACES AFTER THE CLOSING DELIMITER
	CAIE A,40
	 CAIN A,^I
	  JRST MACST3
	CAIE A,",	;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL.
	 JSP D,RARB	;ELSE CHECK FOR OTHER TERMINATORS.
	  RET		;WE FOUND AN ACCEPTABLE ARG TERMINATOR.
	ETR [ASCIZ /Garbage in ASCIZ-style macro arg/]
	JRST RARFLS	;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT.
;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE.
;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS
;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT.
;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST.
MACDEF:	TRZN LINK,MCFKWD
	 JRST MACDF1
	MOVE A,@PRCALP
MACDF0:	CALL REDINC	;SKIP ARG NAME IF KEYWORD ARG.
	CAIE B,377
	 JRST MACDF0
	MOVEM A,@PRCALP
MACDF1:	MOVE A,@PRCALP	;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE.
	CALL REDINC	;AS THE ARGUMENT STRING.
	MOVEM A,@PRCALP
	CAIN B,377
	 JRST STPWR	;END OF THE DEFAULT VALUE.
	EXCH A,B
	CALL PUTREL
	EXCH A,B
	JRST MACDF1

;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL.
MACGEN:	MOVEI A,5
	MOVEM A,SCKSUM
	MOVEI A,"G
	PUSHJ P,PUTREL
	PUSH P,CSTPWR
	AOS A,GENSM
	IDIVI A,10
	HRLM B,(P)
	SOSLE SCKSUM
	PUSHJ P,.-3
	JRST MACEV2

;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG.
MACEVL:	CALL RCH	;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL.
	JSP D,RARB
	 JRST MACEN1
	PUSH P,C
	PUSH P,LINK	;SAVE LINK, NEED FLAGS
	PUSHJ P,AGETFD	;GET THE FIELD	
	SKIPE B
	 ETR [ASCIZ /Relocatable \'d macro arg/]
	POP P,LINK
	REST C		;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO
	MOVE CH1,FREEPT	;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY.
	MOVEM CH1,(C)
	MOVE CH1,A	;SAVE VALUE OF FIELD FROM CLOBBERAGE
	PUSH P,CSTPWR
MACEV1:	LSHC CH1,-35.	;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX
	LSH CH2,-1
	DIV CH1,ARADIX
	HRLM CH2,(P)
	JUMPE CH1,.+2
	PUSHJ P,MACEV1
MACEV2:	HLRZ A,(P)
	ADDI A,60
	JRST PUTREL	;OUTPUT TO MACTAB STRING BEING DEFINED
;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN
;THAT SPECIFIES A KEYWORD PARAMETER.
MACK:	PUSH P,RDWRDP
	MOVE A,@PRCALP	;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR
	AOS PRCALP	;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED.
	MOVEM A,@PRCALP
	PUSH P,LINK
;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH.
MACK2:	SETO A,
	CALL ADDTR2
	CALL MACDES	;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR
	 JRST MACK1	;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN.
	TRNE LINK,MCFKWD
	 JRST MACK2
MACK1:	MOVE LINK,(P)	;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
	MOVE B,PRCALP
	MOVE B,-1(B)
	MOVEM B,@PRCALP
MACKLP:	CALL GPASST	;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND
	CAIE A,^M	;IF SO, IT SHOULD START WITH A KEYWORD.
	 CAIN A,^J
	  JRST MACKND	;CR OR LF => NO KEYWORD, AND END SCAN.
	CAIN A,";
	 JRST MACKND
	CAIN A,",
	 JRST MACKN1	;NULL ARG => NO KEYWORD, BUT DON'T END SCAN.
	CAIE A,")
	 CAIN A,">
	  JRST MACKND	;DETECT END OF PARENTHESIZED CALLS, ETC.
	CAIE A,RBRKT
	 CAIN A,RBRACE
	  JRST MACKND
	TLO FF,FLUNRD
	CALL GSYL	;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME
	CALL PASSPS
	MOVE C,-1(P)	;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE
	CAIE A,"=	;WHOSE NAME MATCHES WHAT GSYL READ.
	 JRST MACKL5	;NOT FOLLOWED BY "="??
	DPB A,STRPNT
MACKL4:	MOVE D,[440700,,STRSTO]
	MOVE A,@PRCALP
MACKL1:	CALL REDINC
	ILDB AA,D
	CAIN B,377	;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR
	 JRST MACKL2	;SEE IF ARG'S NAME ALSO OVER.
	CAMN B,AA
	 JRST MACKL1	;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR.
MACKL6:	MOVEM A,@PRCALP
	CALL MACDES	;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT
	 JRST MACKL3	;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD.
	TRNN LINK,MCFKWD
	 JRST MACKL3
	AOJA C,MACKL4
	
MACKL5:	ETR [ASCIZ /Bad format keyword argument/]
	TLOA FF,FLUNRD	;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD
MACKL3:	 ETR [ASCIZ /Arg with undefined keyword/]
	MOVEI T,RARGN
	CALL RARFLS	;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER.
	JRST MACK1

;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG.
;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN)
MACKL2:	TRZ LINK,MCFKWD	;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY)
	CAIE AA,"=
	 JRST MACKL6	;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH
	MOVEMM (C),FREEPT
	CALL MACRED	;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM.
	 JRST MACK1	;THERE ARE MORE ARGS => HANDLE THEM
	 .VALUE
MACKND:	TLO FF,FLUNRD	;MACRO CALL TERMINATOR SEEN.
;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL.
MACKN1:	REST LINK	;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
	SOS PRCALP
	REST C		;GET PTR TO 1ST KWD ARG'S VALUE-WORD
MACKN2:	MOVE A,(C)
	AOJN A,MACKN4	;IF THIS ARG WASN'T SPECIFIED,
	MOVEMM (C),FREEPT
	CALL MACNUL	;NULLIFY IT (MAYBE DEFAULT OR GENSYM)
MACKN4:	CALL MACDES	;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS
	 JRST MACPUS	 ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL.
	TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG.
	 AOJA C,MACKN2
	TLNN FF,FLUNRD	;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG,
	 JRST MACNRM	;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM.
	JRST MACCLS	;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS.
;COME HERE TO FIND THE NEXT DESCRIPTOR.
;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY.
;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER.
MACDES:	MOVE A,@PRCALP
	CALL REDINC	;READ NEXT CHAR OF MACRO
	MOVEM A,@PRCALP
	TRNE LINK,MCFKWD\MCFDEF
	 JRST [	CAIE B,377	;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR
		 JRST MACDES
		TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE
		 TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL
		JRST MACDES]	;SKIP TILL ANOTHER 377
	JUMPE B,CPOPJ	;THIS DESC IS TERMINATOR => RETURN NO SKIP.
	MOVEI LINK,(B)	;ELSE PUT FLAGS IN LINK.
	JRST POPJ1

;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL
;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO.
;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG,
;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR.
MACCLS:	TRNE LINK,MCFDEF\MCFGEN
	 JRST MACCL2
	SETZ A,		;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY
	CALL ADDTR2
MACCLD:	CALL MACDES	;THEN READ THE NEXT DESCRIPTOR.
	 JRST MACPUS	;IF NO MORE ARGS, ENTER THE MACRO.
	JRST MACCLS
	
MACCL2:	CALL ADDTRN	;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG
	SOS C,A
	CALL MACNUL	;THEN WRITE THE DESIRED VALUE THERE
	JRST MACCLD	;THEN HANDLE NEXT DESCRIPTOR.

;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN)
;TO ENTER THE MACRO.
MACPUS:	TLZE I,ILPRN	;SPECIAL PARENTHESIZED CALL?
	 CALL MACPRN	 ;YES, SKIP PAST THE CLOSING PAREN.
	MOVE B,(P)	;IS THIS A .TTYMAC?
	CAIN B,A.TYM8
	 CALL A.INEO	;YES, POP OUT OF TTY AFTER READING ARGS.
	JFCL
	REST B		;RCHSV1 OR A.TYM8
	PUSHJ P,PUSHEM
	MOVE A,@PRCALP
	PUSHJ P,ACPTRS	;SET UP CPTR
	POP P,A
	PUSHJ P,DMYTRN
	SOS PRCALP
	REST I
MACCR:	AOS (P)		;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE
CMACCR:	POPJ P,MACCR

MACPRN:	MOVEI TT,1	;START PAREN-DEPTH AT 1
	JSP D,RARBC	;AND READ CHARS, UPDATING THE DEPTH, UNTIL
	 HALT
	JUMPN TT,.-2	;THE DEPTH GETS TO BE 0.
	RET
A.GOMC:	ILDB B,A	;.GO ROUTINE TO SKIP PAST DESCRIPTORS
	JUMPN B,A.GOMC	;IN HEADER OF MACRO DEFINITION.
	JRST A.GORT

RCHSV1:	SOS MDEPTH	;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS
A.TYM8:	PUSH P,A	;ENTRY FROM .TTYMAC END OF EXPANSION
	MOVE B,TOPP
RCHSV3:	CAMG B,BBASE
	JRST RCHSV2
	HLRZ A,-1(B)
	ADD A,-1(B)
	MOVEI A,1(A)
	CAME A,FREEPT
	JRST RCHSV2
	HRRZ A,-1(B)	;GET NEW FREEPT
	SOJA B,RCHSV3

RCHSV2:	POP P,A
		;RETURN ROUTINE FOR END OF DUMMY
RCHSAV:	MOVE B,BBASE
	MOVEM B,TOPP
	PUSHJ P,POPEM
	HLRM B,BBASE
REPT6:	TRZE FF,FRMRGO
	POPJ P,		;RETURN TO .GO
	JRST RCHTRB
;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE.
;ALL USE 2 FRAMES ON THE MACRO PDL:
; <OLD BBASE>,,<OLD CPTR>
; <SAVED LIMBO1 STATUS>,,<OUTER .IRPCNT>
; <IRP TYPE>\<# GROUPS>,,<CHAR ADDR START OF IRP BODY>
; <SAVED TOPP>,,AIRR
;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE
;   (NIRPO, NIRPC, ETC)
;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS
;   (TRIPLES OF TWO DUMMIES AND A LIST)

.SEE NIRPO	;FOR DEFINITIONS OF IRP TYPE CODES.

AIRP:	JSP TM,ERMARK	;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT.
	PUSH P,I
	PUSH P,RDWRDP
	HLRZ LINK,B	;GET IRP TYPE CODE TO INDEX BY.
	CAIE LINK,NIRPN
	 JRST AIRP0
	CALL AGETFD	;IRPNC, READ THE 3 NUMERIC ARGS.
	PUSH P,A
	CALL AGETFD
	PUSH P,A
	CALL AGETFD
	MOVEM A,AIRPN2	;THE LAST ARG,
	REST AIRPN1	;THE MIDDLE,
	REST AIRPN0	;THE FIRST.
	MOVEI LINK,NIRPN
AIRP0:	SETZM IRPCR	;NO GROUPS SEEN YET.

;FALLS THROUGH.
;FALLS THROUGH.

;TRY TO READ IN ANOTHER GROUP.
AIRP1:	CALL PDEF	;READ IN DUMMY NAME, PUSH ON DMYTOP.
	CAIE T,",	;TERMINATOR WASN'T COMMA AND NAME WAS NULL
	 JUMPE SYM,AIRP2 ;=> NO MORE GROUPS.
	CALL PDEF	;NONNULL GROUP, READ & PUSH 2ND NAME.
	CAIN T,"[	;] TRY TO DETECT "IRP X,[", ETC.  ]
	 CALL [ETR [ASCIZ/Comma missing in IRP/]
		TLO FF,FLUNRD	;GENERATE A COMMA.
		RET]
	CALL ADDTRN	;PUSH CHAR ADDR OF 1ST DUMMY,
	CAIE LINK,NIRPS
	CAIN LINK,NIRPC	;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND.
	 CALL PUT377
	MOVE A,RDWRDP
	CAIN LINK,NIRPS
	 AOS -1(A)	;IRPS - 1ST ARG GOES AFTER NEXT 377.
	CALL ADDTRN	;PUSH CHAR ADDR OF 2ND DUMMY.
	CALL PUT377
	MOVE A,RDWRDP
	XCT AIRP1T-1(LINK)	;MAYBE INCREMENT THAT ADDR.
	AOS IRPCR	;ONE MORE GROUP SEEN.
	JSP D,RARG	;INITIALIZE READING LIST.
	 JRST AIRP3	 ;NO LIST.
	JRST @.(LINK)
	OFFSET 1-.
NIRPO::	AIRPO	;IRP
NIRPC::	AIRPC	;IRPC
NIRPS::	AIRPS	;IRPS
NIRPW::	AIRPW	;IRPW
NIRPN::	AIRPN	;IRPNC
	OFFSET 0

AIRP1T:	AOS -1(A)
	AOS -1(A)	;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC.
	SOS -1(A)
	JFCL		;DECR. FOR IRPS, NOTHING FOR IRPW.
	AOS -1(A)	;INCR. FOR IRPNC.
;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING.
AIRPC:
AIRPO:	CALL RARGCP	;COPY UP TO END OF ARG INTO MACRO SPACE.
	JRST AIRP3

AIRPW3:	CALL PUT377	;END A LINE,
	CAIGE C,
	 CALL PUT377	;IF NO ; YET, MAKE NULL 2ND ARG.
;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE.
AIRPW:	SETO C,		;NO ; SEEN YET IN LINE.
AIRPW1:	JSP D,RARGCH(T)
	 JRST AIRP3	;END OF LIST, GO WRITE 375.
	CAIE A,^M
	CAIN A,^J
	 JRST AIRPW1	;IGNORE NULL LINES.
AIRPW4:	CAIN A,";
	 AOJE C,AIRPW2	;ON 1ST SEMI, SWITCH TO 2ND ARG.
	CAIE A,^J
	CAIN A,^M
	 JRST AIRPW3	;END OF LINE => END BOTH ARGS, START OVER.
AIRPW5:	CALL PUTREL
	JSP D,RARGCH(T)
	 JRST AIRP3	;END OF LIST.
	JRST AIRPW4

AIRPW2:	MOVEI A,377
	JRST AIRPW5

AIRPS:	SETO C,		;NO SQUOZE CHAR SEEN YET.
AIRPS2:	JSP D,RARGCH(T)
	 JRST AIRP3
	HLRZ CH1,GDTAB(A)
	CAIN CH1,(RET)
	CAIN A,"!
	 AOJA C,AIRPS0	;A SQUOZE CHAR OR !.
	JUMPL C,AIRPS2	;NON SQUOZE FOLLOWING ANOTHER, FLUSH.
	DPB A,AIRPSP	;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL.
	SETZM AIRPSP
	CALL PUT377	;FOLLOW SYL WITH 377.
	JRST AIRPS

AIRPS0:	JUMPN C,AIRPS3	;NOT 1ST CHAR IN SYL?
	PUSH P,A
	CALL PUT377	;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR.
	MOVE A,FREPTB
	MOVEM A,AIRPSP	;REMEMBER WHERE THE SPACE IS.
	REST A
AIRPS3:	CALL PUTREL
	JRST AIRPS2
AIRPN:	SKIPG C,AIRPN0	;ANY CHARS TO IGNORE?
	 JRST AIRPN4
	JSP D,RARGCH(T)
	 JRST AIRP3
	SOJG C,.-2
AIRPN4:	SKIPN C,AIRPN2	;GET MAX # GRPS OF CHARS.
	 JRST AIRPN7	 ;0 => IGNORE THE REST.
AIRPN5:	MOVE B,AIRPN1	;DO NEXT GRP, GET # CHARS/GRP.
AIRPN6:	JSP D,RARGCH(T)
	 JRST AIRP3
	CALL PUTREL	;STORE THE NEXT CHAR.
	SOJG B,RARGCH(T) ;COUNT CHARS IN GRP.
	MOVEI A,376
	CALL PUTREL	;FOLLOW GRP BY 376.
	SOJN C,AIRPN5	;MAYBE CAN DO MORE GRPS.
AIRPN7:	CALL RARFLS	;DID AS MANY GRPS AS CAN DO,
			;IGNORE REMAINDER OF LIST.

;COME HERE WHEN EXHAUST THE LIST.
AIRP3:	CALL STPWR
	JRST AIRP1	;READ ANOTHER GROUP.

;ALL GROUPS READ IN; NOW READ IN BODY.
AIRP2:	CAIE T,";	;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT.
	 JRST AIRP4
AIRP5:	CALL RCH
	CAIE A,^M
	 JRST AIRP5
AIRP4:	PUSH P,LINK
	MOVE A,FREEPT	;SAVE CHAR ADDR START OF BODY
	MOVEM A,PRIRP	;WHERE GC WILL RELOCATE IT.
	PUSHJ P,RCH	;IF NEXT CHAR LF, THEN FLUSH IT
	CAIE A,12
	TLO FF,FLUNRD
	PUSHJ P,WRQOTE	;READ BODY OF IRP
	PUSHJ P,STPWR	;WRITE STOP
	PUSHJ P,PUSHEM	;SAVE WORLD
	REST LINK
	POP P,A		;RESTORE RDWRDP FROM LONG AGO
	PUSH P,TOPP	;NOW SAVE TOPP
	PUSHJ P,DMYTRN	;ACTIVATE DUMMYS
	MOVE B,MACP	;NOW GET MACRO PDL POINTER
	MOVE A,CIRPCT	;GET .IRPCNT
	HRRM A,(B)	;CLOBBER "RETURN" ON PDL TO OLD IRPCNT
	SETOM CIRPCT	;INITIALIZE IRPCNT
	MOVS A,IRPCR	;GET # GROUPS
	HRR A,PRIRP	;CHAR ADR OF BEGINNING OF BODY
	SETZM PRIRP
	DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP.
	PUSH B,A	;PUSH <SPECIFICATION BITS\# GROUPS>,,CHAR ADR BEGINNING
	POP P,A		;NOW GET OLD TOPP
	HRLS A		;MOVE TO LEFT HALF
	HRRI A,AIRR	;RETURN TO AIRR ON END OF BODY
	PUSH B,A	;PUSH OLD TOPP,,AIRP4
	MOVEM B,MACP	;STORE BACK UPDATED MACRO PDL POINTER
	MOVE A,STOPPT
	MOVEM A,CPTR	;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING
	REST I
	JRST MACCR
;RECYCLE THROUGH IRP

		;AC ALLOCATIONS:
AIRR:	PUSH P,A	;A GETS BP ILDBING THRU ARG LIST.
	PUSH P,C	;C # GROUPS LEFT
	PUSH P,T	;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS
	PUSH P,TT	;TT TYPE OF IRP (NIRPO, NIRPC, ETC)
	AOS CIRPCT	;INCREMENT .IRPCNT
	HRRZ A,(B)	;GET CHARACTER ADR BEG BODY FROM PDL
	PUSHJ P,ACPTRS	;SET UP CPTR
	SETOM AIRPT
	TRNE FF,FRMRGO
	JRST AIRR9	;RETURN TO .GO
	HLRZ T,1(B)	;DUMMY TAB ADR
	LDB C,[220600,,(B)]	;# GROUPS
	JUMPE C,AIRR9	;JUMP IF NO GROUPS
	LDB TT,[410300,,(B)]	;GET TYPE OF IRP (NIRPO, ETC)
AIRR6:	JRST @.+1(TT)
AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER
AIRRER:	.VALUE

;MOVE 1 ARG THRU 1 GROUP OF IRP.
AIRRO:	HRRZ A,1(T)	;THE 1ST ARG WILL START THIS TIME
	HRRZM A,(T)	;WHERE THE "REST OF STRING" STARTED LAST TIME.
	BCOMP A,-1	;GET BP THAT'LL ILDB THAT CHAR.
	SETO CH1,	;COUNT [-] DEPTH.
AIRRO1:	ILDB B,A
	CAIN B,375
	 JRST AIRRO4	;END OF STRING IS END OF ARG.
	SETZM AIRPT	;THIS GROUP NOT NULL.
	CAIN B,"[
	 AOJE CH1,AIRRO3	;FLUSH OUTERMOST [-] PAIRS.
	CAIN B,"]
	 SOJL CH1,AIRRO3
	JUMPGE CH1,AIRRO1	;DON'T LOOK FOR , WITHIN [-].
	CAIE B,^J
	CAIN B,",
	 JRST AIRRO2	;END OF ARG.
	CAIE B,^M	;^M IS IGNORED (FLUSHED.)
	 JRST AIRRO1
AIRRO3:	MOVEI B,376	;FLUSH A CHAR BY REPLACING WITH 376
	DPB B,A
	JRST AIRRO1

AIRRC4:	SUB P,[1,,1]
AIRRC3:	SETZM (T)	;NULLIFY BOTH ARGS PERMANENTLY.
AIRRO4:	SETZM 1(T)	;NULLIFY 2ND ARG PERMANENTLY
	JRST AIRR8	;DONE WITH THIS GROUP.

AIRRO2:	MOVEI B,377	;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR.
	DPB B,A
AIRRW3:	CCOMP1 A,-1	;GET ADDR OF CHAR AFTER.
	HRRZM B,1(T)	;"REST OF STRING" STARTS THERE.
	JRST AIRR8

AIRRN:	MOVE A,1(T)	;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING".
	MOVEM A,(T)
	BCOMP A,-1	;NEW "REST OF STRING" STARTS AFTER 376,
	JRST AIRRW2	;WHICH WILL BECOME A 377.
AIRRW:	MOVE A,1(T)	;GET CHAR ADDR START OF 2ND HALF OF PREV LINE.
	CALL AIRRM	;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 .
AIRRW2:	ILDB B,A	;MOVE UP TO NEXT 377 OR END OF STRING.
	CAIN B,375	;END OF STRING ENDS 1ST DUMMY'S ARG =>
	 JRST AIRRO4	;NULLIFY THE 2ND DUMMY.
	SETZM AIRPT	;THIS GROUP NOT NULL.
	CAIGE B,376
	 JRST AIRRW2
	JRST AIRRO2	;SET UP 2ND DUMMY -> NEXT CHAR.


;MOVE UP IN 1 GROUP OF IRPS.
AIRRS:	MOVE A,(T)	;MOVE FROM 1ST DUMMY,
	CALL AIRRM	;PUT 1ST DUMMY AFTER NEXT 377,
	AOS (T)		;MOVE IT PAST THE SYL'S TERMINATING CHAR,
	ILDB CH1,A	;GET THAT CHAR,
	MOVE A,1(T)
	JRST AIRRS2	;STORE AS 2ND DUMMY.

AIRRM:	BCOMP A,-1	;A HAS CHAR ADDR; WILL ILDB THAT CHAR.
AIRRM1:	ILDB B,A
	CAIN B,375	;END OF STRING => NULLIFY BOTH ARGS
	 JRST AIRRC4	;AND FINISHED WITH GROUP.
	CAIE B,377
	 JRST AIRRM1
	MOVE CH1,A
	CCOMP1 CH1,-1	;GET CHAR ADDR OF CHAR AFTER 377
	MOVEM CH2,(T)	;PUT 1ST DUMMY THERE.
	RET		;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING.

;MOVE UP IN ONE GROUP OF IRPC.
AIRRC:	AOS A,1(T)	;DELETE 1ST CHAR FROM "REST OF STRING".
	BCOMP A,-1	;GET BP -> THAT CHAR.
	LDB CH1,A	;GET THE CHAR.
	MOVE A,(T)	;GET CHAR ADDR OF PLACE TO PUT IT.
AIRRS2:	CAIN CH1,375	;REACHED END OF STRING =>
	 JRST AIRRC3	;NULLIFY BOTH ARGS.
	BCOMP A,0
	DPB CH1,A	;STORE IT IN THE 1-CHAR ARG.
AIRR7:	SETZM AIRPT	;THIS GROUP NOT EXHAUSTED YET.
AIRR8:	ADDI T,2
	SOJG C,AIRR6	;MORE GROUPS => DO THE NEXT.
AIRR9:	POP P,TT	;RETURN FROM AAIRPC
	POP P,T
	SKIPL AIRPT
	JRST REPT3
	MOVN A,[2,,2]	;ARGS EXHAUSTED, RETURN
	ADDB A,MACP
	HRRZ A,(A)
	MOVEM A,CIRPCT
	POP P,C
	POP P,A
	JRST RCHSAV
;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D,
;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR.
;SKIPS IF NONNULL ARG AVAILABLE.
;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS.
;THE CALLER SHOULDN'T CLOBBER THEM.
RARG:	CALL RCH	;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY.
	CAIN A,LBRKT	;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES.
	 JRST RARGBR
IFN BRCFLG,[
	CAIN A,LBRACE
	 JRST RARGRR
]
	TLO FF,FLUNRD
	JSP T,RARGXT	;CAUSE FAILURE RETURN ON SEMI, CR, LF.
RARGN:	CALL RCH	;RARGCH RTN FOR NORMAL ARG.
RARGX1:	CAIN A,",
	 JRST (D)	;COMMA ENDS ARG.
RARGXT:	CAIN A,";
	 JRST RARGSM	;SEMI ENDS SCAN.
RARGX2:	CAIE A,^M
	CAIN A,^J	;CR, LF END SCAN.
RARGSM:	 TLOA FF,FLUNRD
	JRST 1(D)
	JRST (D)

RARGBR:	SETZ TT,	;TT USED AS BRACKET COUNTER.
	JSP T,1(D)	;RETURN, WITH RARGCH RTN IN T.
;READ-CHAR RTN FOR [-] TYPE ARGS.
RARGBC:	CALL RCH	;READ NEXT CHAR OF ARG.
	CAIN A,LBRKT
	 AOJA TT,1(D)
	CAIN A,RBRKT
	 SOJL TT,(D)
	JRST 1(D)	;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET.

RARGRR:	SETZ TT,	;TT USED AS BRACE COUNTER.
	JSP T,1(D)	;RETURN, WITH RARGCH RTN IN T.
;READ-CHAR RTN FOR {-} TYPE ARGS.
RARGRC:	CALL RCH	;READ NEXT CHAR OF ARG.
	CAIN A,LBRACE
	 AOJA TT,1(D)
	CAIN A,RBRACE
	 SOJL TT,(D)
	JRST 1(D)	;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE.

;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T).
;SKIPS UNLESS NO MORE CHARS TO GET.
;NO SKIP AND  SET => SCAN SHOULD BE TERMINATED.
;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE.
RARGCH==0	;THIS SYMBOL IS FOR CREF'S SAKE.

;COPY THE ARG BEING READ INTO MACRO SPACE.
;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";".
RARGCP:	JSP D,RARGCH(T)
	 JRST RARGC1
	CALL PUTREL
	JRST RARGCH(T)

RARGC1:	CAIE A,";	;IF SEMI ENDED THE ARG, FLUSH THE
	 RET		;SPACES AND TABS BEFORE IT.
RARGC2:	LDB A,FREPTB
	CAIN A,^I
	 JRST RARGC3
	CAIE A,40
	 JRST [	MOVEI A,";	;LAST CHAR OF ARG ISN'T SP OR TAB.
		RET]		;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";".
RARGC3:	SOS FREEPT	;IT IS ONE; BACK OVER IT.
	MOVE A,FREPTB
	DBPM A
	MOVEM A,FREPTB
	JRST RARGC2

;IGNORE THE REST OF THE ARG NOW BEING READ.
RARFLS:	JSP D,RARGCH(T)
	 RET
	JRST RARGCH(T)
;COME HERE TO SET UP TO READ A BALANCED ARG.
;IF THERE'S NO ARG, RETURNS WOTH JRST (D).
;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF.
RARB:	TLO FF,FLUNRD
	SETZ TT,	;TT USED AS BRACKET COUNTER.
	CAIE A,RBRACE
	 CAIN A,")	;IF 1ST CHAR IS A CLOSE,
	  JRST RARB4	;THERE'S NO ARG.
	CAIE A,">
	 CAIN A,RBRKT
	  JRST RARB4
	JSP T,RARGXT	;CHECK FOR CR, LF, SEMI, AND RETURN.
;1-CHAR RTN FOR READING BALANCED ARG.
RARBC:	CALL RCH
	CAIE A,RBRACE
	 CAIN A,">	;FOR CLOSES, MAYBE END ARG.
	  JRST RARB2
	CAIE A,")
	 CAIN A,RBRKT
	  JRST RARB2
	CAIE A,LBRACE
	 CAIN A,"<	;FOR OPEN BRACKETS, INCR. THE COUNT.
	  AOJA TT,1(D)	;OPENS CAN'T END THE ARG.
	CAIE A,"(
	 CAIN A,LBRKT
	  AOJA TT,1(D)
	JUMPN TT,1(D)
	JRST RARGX1	;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC.

RARB2:	SOJGE TT,1(D)	;COME HERE FOR CLOSEBRKTS.
RARB4:	TLO FF,FLUNRD
	JRST (D)

;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC.
;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG.
RARL1:	CALL RCH
RARL2:
IFN BRCFLG,[
RARL4:	CAIN A,LBRACE
	 JRST RARGRR	;1ST CHAR A BRACE => BRACED ARG.
]
	CAIN A,LBRKT	;1ST CHAR A BRKT => BRKT ARG.
	 JRST RARGBR
	TLO FF,FLUNRD

;INIT FOR A 1-LINE ARG.
RARL:	JSP T,1(D)
;1-CHAR RTN FOR 1-LINE ARGS.
RARLC:	CALL RCH
	JRST RARGX2

IFE BRCFLG,[
;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T
;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST.
RARL4:	CAIN A,LBRACE
	 JRST RARGRR
	JRST RARL2
]

;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC,
;AND SKIP OVER THE CR AND LF.
RARL3:	TLO FF,FLUNRD
	JSP T,1(D)
	CALL RCH
	CAIN A,^J
	 JRST (D)	;LF IS THE END - SKIP IT.
	CAIE A,^M
	 JRST 1(D)
	CALL RCH	;CR => SKIP FOLLOWING LF, END ARG.
	CAIE A,^J
	 TLO FF,FLUNRD
	JRST (D)
;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4)
;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY
;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A

A.GST:	MOVEM A,A.GST3	;SAVE BYTE POINTER
A.GST1:	ILDB B,A.GST3	;GET CHAR
	CAIL B,300
	POPJ P,		;END OF STRING => STOP
	CAIE B,".
	JRST A.GST1	;WAIT FOR POINT
	PUSHJ P,A.GSYL	;FOUND POINT, GET REST OF NAME
	JUMPL T,CPOPJ	;RETURN ON END OF STRING
	CAME SYM,[SQUOZE 0,TAG]	;TAG?
	JRST A.GST1	;NO, KEEP GOING
	PUSHJ P,A.GSYL	;GET THE TAG
	JUMPL T,CPOPJ	;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP)
	CAME SYM,A.GST4
	JRST A.GST1	;NOT THE ONE BEING LOOKED FOR
	MOVE A,A.GST3
	LDB B,A		;GET DELIMITER
	CAIE B,15	;CR?
	JRST POPJ1
	ILDB B,A	;CR, GET NEXT CHAR
	CAIE B,12	;LINE FEED?
	MOVE A,A.GST3	;NO, DON'T FLUSH
	JRST POPJ1

		;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A
		;LEAVES  POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B

AG.SP:	MOVE B,(A)	;GET WORD FROM MACTAB
	XOR B,[300_28.+300_20.+300_12.+300_4]	;DO XOR TO ANITIALLY SET UP
	LDB CH1,[400400,,A]	;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD
	JRST A.GSP2-1(CH1)	;DISPATCH ON POSITION FIELD (-1  SINCE BIT SET IN POSITION FIELD)

AG.SP3:	MOVE B,(A)
	XOR B,[300_28.+300_20.+300_12.+300_4]

A.GSP2:	TRNN B,300_4
	JSP CH1,AG.SF
	TLNN B,3
	JSP CH1,AG.SF
	TLNN B,300_2
	JSP CH1,AG.SF
	TLNN B,300_10.
	JSP CH1,AG.SF
	SOJA A,AG.SP3

AG.SF:	SUBI CH1,A.GSP2-1	;GET HERE WHEN STOP CHAR FOUND
	DPB CH1,[400400,,A]	;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN
	ILDB B,A	;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME
	POPJ P,		;THAT'S ALL
A.TAG:	PUSHJ P,GSYL
	CAIE T,15
	JRST MACCR
	PUSHJ P,RCH
	CAIE A,12
	TLO FF,FLUNRD
	JRST MACCR

A.GO:	PUSHJ P,GSYL	;DOESN'T WORK RELIABLY FROM DUMMY
	MOVEM SYM,A.GST4

A.GO1:	TLNN FF,FLMAC
	JRST MACCR	;NOT GETTING CHARS FROM MACRO => STOP
	MOVE A,CPTR
	PUSHJ P,AG.SP	;BACK TO BEGINNING
	CAIN B,374
	JRST A.GOMC	;MACRO, SKIP PAST HEADER
A.GORT:	PUSHJ P,A.GST
	JRST A.GO2	;END OF STRING, TRY POPPING UP ONE
	MOVEM A,CPTR
	JRST MACCR

A.GO2:	PUSHJ P,PMACP
	JRST A.GO1

A.GSYL:	MOVNI D,100000	;GET SYL FOR .GO WHILE LOOKING FOR TAG
	MOVEM D,STRCNT	;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F)
	MOVEI SYM,0
	JSP F,GSYL1
A.GSY3:	ILDB A,A.GST3	;GET CHAR
	TRZN A,200	;CHECK FOR SPECIAL
	JRST A.GSY2	;NO, FALL BACK IN
	CAIG A,100	;BIG ENOUGH TO BE SPECIAL?
	JRST A.GSY3	;NO, MUST BE DUMMY, IGNORE
	HRROI T,(A)	;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE
	POPJ P,		;RETURN TO CALLING ROUTINE
;INITIALIZE MACRO STATUS

MACINI:	MOVEI A,3
	MOVEM A,FREEPT	;FORGET ALL STRINGS IN MACTAB
	PUSHJ P,FCOMP
	MOVE A,MACTAD
	HRLI A,41000	;SET UP CCOMPB THRU CCOMPE
	LSH A,2		;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE
	SUBI A,4	;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC
	MOVSI AA,CCOMPB-CCOMPE	;VERSION THAT CAN'T BE DONE)
MACIN0:	MOVEM A,CCOMPB(AA)
	AOJ A,
	AOBJN AA,MACIN0
	MOVE A,MACTAD
	ADDI A,MACL+1777
	ANDI A,-2000	;ADDR OF 1ST WD AFTER MACTAB.
	CALL MACIN2	;SET UP PTRS TO END OF MACTAB.
	SETZM GCCNT	;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE
MACIN1:	SETZM MDEPTH	;NOW INITIALIZE MACRO EXPANSION STATUS
	SETZM PRSTG	;NOW TO CLEAR OUT BYTE POINTERS
	MOVE A,[PRSTG,,PRSTG+1]
	BLT A,EPRSTT-1
	MOVEI A,DSTG
	MOVEM A,RDWRDP
	MOVEI A,DMYAGT
	MOVEM A,TOPP
	MOVEM A,BBASE
	MOVE A,[-MPDLL,,MACPDL]
	MOVEM A,MACP
	POPJ P,

;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB.
MACIN2:	MOVEM A,MACTND
	SUB A,MACTAD
	LSH A,2		;1ST BYTE MACTAB DOESN'T HAVE.
	MOVEM A,MACHI
	SUBI A,MACRUM*4
	MOVEM A,GCRDHI
	MOVE A,STOPPT
	HRR A,MACTND
	SOS A		;LAST WD IN MACTAB.
	MOVEM A,MACHIB	;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL
	RET

		;MACRO VARIABLE AREA (MOST THEREOF)

VBLK
MACP:	0	;MAC PDL POINTER
BLCODE [MACPDL:	BLOCK MPDLL+1]	;MACRO PDL
FREEPT:	0	;MACRO STG PNTR POINTS TO FREE CHAR
FREPTB:	0	;FREEPT IN BYTE POINTER FORM
MACTAD:	MACTBA	;ADDR OF START OF MACRO TABLE.
MACTND:	0	;ADDR OF 1ST WD AFTER MACTAB.
MACHI:	0	;CHAR ADR ONE ABOVE ACTIVE MACTAB
MACHIB:	0	;POINTS TO LAST BYTE IN MACTAB
SCONDF:	0	;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT
GENSM:	0	;GENERATED SYM COUNT
DEFNPS:	0	;NONZERO => NAME OF PSEUDO NOW READING ITS ARG.
		;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME.
DEFNPN:	0	;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS.
DEFNLN:	0	;LINE # -1.
DEFNFI:	0	;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO.
MDEPTH:	0	;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS
PUTCNT:	0	;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION)
IRPCR:	0	;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " "
AIRPT:	0	;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0
AIRPN0:	0	;1ST NUMERIC ARG TO IRPNC
AIRPN1:	0	;2ND,
AIRPN2:	0	;3RD.
A.QOT2:	0	;DELIMITER FOR .QUOTE
CRPTCT:	-1	;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT)
CIRPCT:	-1	;COUNT THOUGH CURRENT IRP (FOR .IRPCNT)
A.GST3:	0	;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR
A.GST4:	0	;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG
PRCALP:	PRCAL-1	;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY

PRSTG:			;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D

CPTR:	0	;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER
IFE WRQTSW-1,WRQTBP:	0	;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE
AIRPSP:	0	;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN.
GCBPL==.-PRSTG	;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES
PRSCND:	0	;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND
PRSCN1:	0	;CHAR ADR BEG OF FIRST STRING IFSE, IFSN
PRREPT:	0	;CHAR ADR BEG OF BODY OF REPT
PRIRP:	0	;CHAR ADR BEG OF IRP BODY
PRDEF:	0	;CHAR ADR BEG OF MACRO BEING DEFINED
PRCAL:	REPEAT 10,0	;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS
EPRSTT:		;END CHAR ADR WORDS GARBAGE COLLECTED

		;BEGIN GARBAGE COLLECTOR VARIABLES

GCCNT:	0	;CNT OF GC'S
SYMSTR:	0	;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE"
REDPT:	0	;CHAR ADR READING FROM WHEN MOVING STRING DOWN
REDPTB:	0	;REDPT IN BYTE POINTER FORM
	;GC WRITES WITH FREEPT/FREPTB
COFST:	0	;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE
SVF:	0	;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING
FREPTS:	0	;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN
FRPTBS:	0	;FREPTS IN BYTE POINTER FORM
GCENDF:	0	;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT
GCHI:	0	;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT
GCRDHI:	<MACL-MACRUM>*4	;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR
BLCODE [GCSV:	BLOCK 16]	;AC SAVE AREA FOR GC
PBLK
;GARBAGE COLLECT THE MACRO TABLE

GCA1:	MOVE A,FREEPT	;GC ALL IN MACTAB.
GCA:	MOVEM A,GCHI	;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT
IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17!
GC:	MOVEM 16,GCSV+15	; Save all ACs except FF and P.
	MOVE 16,[1,,GCSV]
	BLT 16,GCSV+14
IFN TS,[AOS A,GCCNT
	CAIGE A,4
	PUSHJ P,GCCORQ	;EXPAND CORE ON FIRST THREE GC'S
]	CLEARB T,GCENDF
	MOVEI A,3
	MOVEM A,REDPT	;SET UP FOR READING
	MOVEM A,FREEPT	;ALSO FOR WRITING
	MOVE A,BCOMPU	;ALSO SET UP CORRESPINDING BYTE POINTERS
	MOVEM A,FREPTB
	MOVEM A,REDPTB
	MOVE C,[-GCBPL,,PRSTG]
GCLP1:	SKIPN B,(C)	;NOW CONVERT BYTE POINTERS...
	JRST GCLP1B	;(INACTIVE)
	CCOMP B,-1	;TO CHARACTER ADDRESSES
	MOVEM B,(C)	;STORE BACK CHARACTER ADDRESS
GCLP1B:	AOBJN C,GCLP1	;LOOP FOR ALL SUCH BYTE POINTERS
	MOVE A,SYMAOB	;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION
SYMMG:		;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST
	LDB B,[400400,,ST(A)]	;GET SQUOZE FLAGS THIS SYM
	CAIN B,PSUDO_-14.	;PSEUDO? (=> MAYBE MACRO)
	JRST SYMMG1	;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2)
SYMMG2:	ADD A,WPSTE1
	AOBJN A,SYMMG	;LOOP FOR ENTIRE SYMTAB
	MOVEM T,SYMSTR	;STORE INITIAL LIST ENTRY FOR MACROS
		;DROPS THROUGH
	;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375
	;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE
	;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING
	;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT
		;DROPS THROUGH

MSTG:	MOVE C,REDPT	;SET UP C TO POINT TO BEG OF STRING BEING READ
		;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE)
	MOVE TT,FREEPT
	CAML TT,GCHI	;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW.
	 JRST GCEND
	MOVEM TT,FREPTS	;-> BEGINNING OF WRITTEN STRING
	MOVE TT,FREPTB
	MOVEM TT,FRPTBS	;BYTE POINTER -> BEGINNING OF WRITTEN STRING
	PUSHJ P,RDTRNS	;COPY CHARACTER
	CAIN B,370
	 JRST MSTGB	;THAT WAS NO STRING, THAT WAS MY IO-BUFFER!
	MOVE TT,B	;SAVE CHARACTER JUST COPIED
MSTG1:	CAML LINK,GCHI
	JRST GCEND	;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE
	CAIN B,375
	JRST MSTG2	;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG
	PUSHJ P,RDTRNS	;STRING NOT EXHAUSTED, COPY NEXT CHAR
	JRST MSTG1
SYMMG1:	HRRZ B,ST+1(A)	;PSEUDO FOUND IN SYMTAB, GET "VALUE"
	CAIE B,MACCL	;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH)
	JRST SYMMG2	;NO, JUST FALL BACK INTO LOOP
	HRRM T,ST+1(A)	;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT
	MOVEI T,ST+1(A)	;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED
	PUSH P,A
	HLRZ A,ST+1(A)
	PUSHJ P,REDINC
	CAIE B,374
	HALT
	POP P,A
	JRST SYMMG2

		;COPY CHARACTER DOWN (REDPTB -> FREPTB)
	;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B

RDTRNS:	ILDB B,REDPTB
	IDPB B,FREPTB
	AOS LINK,REDPT
	AOS A,FREEPT
	POPJ P,

MSTGB:	ADDI A,3	;COPY AN IO-BUFFER:
	TRZ A,3
	MOVEM A,FREEPT	;WRITE INTO WORD BOUNDARY.
	ADDI LINK,3
	TRZ LINK,3
	MOVEM LINK,REDPT	;READ FROM WORD BOUNDARY.
	MOVEI B,041000
	HRLM B,REDPTB
	HRLM B,FREPTB
	MOVE B,FREPTB
	MOVE A,REDPTB
	ADDI B,1	;NEW ADDR OF 1ST WD.
	HRRZ LINK,1(A)	;GET ADDR OF POINTER TO STRING.
	MOVEM LINK,SVF	;REMEMBER WHETHER TO FLUSH STRING.
	SKIPE LINK
	HRRM B,(LINK)	;RELOCATE THAT POINTER (IF ANY)
	HRLI B,1(A)	;SET UP AC FOR BLT.
	HLRZ LINK,1(A)	;GET LENGTH OF STRING.
	ADDM LINK,REDPTB
	LSH LINK,2
	ADDM LINK,FREEPT
	ADDM LINK,REDPT
	LSH LINK,-2
	ADDB LINK,FREPTB
	BLT B,(LINK)
	MOVE LINK,REDPT
	CAML LINK,GCHI	;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE,
	 SETOM GCENDF	;DON'T LOOK FOR ANYTHING FOLLOWING IT.
	JRST MSTGB1	;NOW MAYBE FLUSH THIS STRING,  COPY NEXT.
;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN

GCEND1:	IFN TS,[
	MOVE A,FREEPT
	ADDI A,2000*4
	CAML A,MACHI
	PUSHJ P,GCCORQ
]	MOVE A,FREEPT
	CAML A,GCRDHI
	 ETF [ASCIZ /Macro space full/]
	SKIPN T,SYMSTR
	JRST USYMG1	;EMPTY LIST
	MOVEI C,MACCL	;SET UP C FOR HRRM'ING
USYMG:	HRRZ TT,(T)	;GET ADR ON LIST
	HRRM C,(T)	;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL
	HLRZ A,(T)
	PUSHJ P,REDINC
	CAIE B,374
	HALT
	SKIPE T,TT	;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST
	JRST USYMG

USYMG1:	MOVE C,[-GCBPL,,PRSTG]
GCLP2:	MOVE A,(C)	;NOW CONVERT CHARACTER ADDRESSES...
	BCOMP A,-1	;BACK TO BYTE POINTERS
	MOVEM A,(C)
	AOBJN C,GCLP2
IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17!
	MOVS 16,[1,,GCSV]	; Restore all ACs except FF and P.
	BLT 16,16
	POPJ P,		;EXIT FROM GARBAGE COLLECTOR

		;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING
		;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR
		;T POINTS TO LAST WORD IN TABLE + 1
		;RELOCATE POINTERS IN TABLE POINTED TO
		;C POINTS TO BEGINNING OF STRING, B -> END + 1

MSCN:	CAIG T,(CH1)
	POPJ P,		;TABLE EXHAUSTED
	HRRZ TT,-1(T)	;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN)
	CAML TT,C
	CAML TT,B
	JRST MSCN1	;DOESN'T POINT TO CURRENT STRING
	SUB TT,COFST	;POINTS TO STRING, RELOCATE
	HRRM TT,-1(T)	;STORE BACK RELOCATED POINTER
	SETOM SVF	;SET FLAG TO SAVE STRING
MSCN1:	SKIPGE CH1
	SOS T		;CH1 NEGATIVE => SKIP A WORD
	SOJA T,MSCN
GCEND:	SETOM GCENDF	;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING
MSTG2:	CLEARM SVF	;NO POINTERS FOUND TO STRING YET
	MOVE D,REDPT
	SUB D,FREEPT
	MOVEM D,COFST	;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION
	MOVE B,REDPT
	CAIE TT,374
	JRST MSTG3	;NOT A MACRO
	MOVE T,SYMSTR
	JUMPE T,MSTG3	;JUMP IF NO MACROS ON LIST
MSTG5:	HLRZ TT,(T)	;GET CHAR ADR THIS MACRO
	CAML TT,C	;SKIP IF POINTS BELOW BEGINNING THIS STRING
	CAML TT,B	;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ
	JRST MSTG4	;DOESN'T POINT TO THIS STRING
	SETOM SVF	;POINTS TO THIS STRING, SET FLAG TO SAVE STRING
	SUB TT,COFST	;RELOCATE
	HRLM TT,(T)	;STORE BACK UPDATED CHAR ADR THIS MACRO
MSTG4:	HRRZ T,(T)	;NOW GET POINTER TO NEXT MACRO
	JUMPN T,MSTG5	;LOOP FOR ALL MACROS ON LIST

MSTG3:	MOVE T,TOPP
	MOVEI CH1,DMYAGT
	PUSHJ P,MSCN	;RELOCATE POINTERS IN DUMMY ARG TABLE
	HRRZ T,MACP
	HRROI CH1,MACPDL
	PUSHJ P,MSCN	;RELOCATE POINTERS IN MACRO PDL
	HRRZ T,PRCALP
	AOS T
	MOVEI CH1,PRSTG
	PUSHJ P,MSCN	;RELOCATE POINTERS IN PRSTG
	HRRZ T,RDWRDP
	MOVEI CH1,DSTG
	PUSHJ P,MSCN	;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED
	SKIPGE GCENDF
	 JRST GCEND1	;EXIT
MSTGB1:	SKIPE SVF
	 JRST MSTGB2	;FOUND POINTERS TO THIS STRING, DON'T FLUSH
	MOVE TT,FREPTS	;NO POINTERS FOUND, FLUSH STRING
	MOVEM TT,FREEPT
	MOVE TT,FRPTBS
	MOVEM TT,FREPTB
MSTGB2:	SKIPGE GCENDF	;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST
	 JRST GCEND1	;THING IN MACRO SPACE.
	JRST MSTG

]		;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES)
IFN .I.FSW,[	;;.I.F		;ALGEBRAIC COMPILER ROUTINE
;		'ALGEBRAIC' CRUFT MARO DEFINITIONS

DEFINE MOAN ARG/
	MOVEI D,[SIXBIT /ARG!!/]
	JRST ERRCON
TERMIN

DEFINE RETLIN
	MOVEI A,15	;CARRIAGE RETURN
	PUSHJ P,PUTREL
	MOVEI A,12	;LINE FEED
	PUSHJ P,PUTREL
TERMIN

DEFINE NUMBER
	MOVE A,BTPNT
	ILDB I,A
	CAIE I,"#
	CAIGE I,"@
TERMIN

DEFINE RESTOR
	MOVE D,BTPNT
	SETZM STRING
	SETZM STRING+1
	SETZM STRING+2
TERMIN


DEFINE SPECN
	POP P,RANDM
	MOVE A,ENN
	SUB A,RANDM
	MOVEM A,ENN
TERMIN

DEFINE $GET
	EXCH I,ACSVI
	PUSHJ P,RCH
	EXCH I,ACSVI
TERMIN

DEFINE GETT
	EXCH I,ACSVI
	PUSHJ P,RCH
	EXCH I,ACSVI
	IDPB A,TPN
TERMIN
;		START OF COMPILER PROPER

OPDL:	CH?CH?CH?CH?CH?CH?CH?CH	;COMMUTATOR
	CH?SP?CH?CH?CH?CR?CH?CH
	CH?CH?CH?CH?CH?CH?CH?CH
	CH?CH?CH?CH?CH?CH?CH?CH
	SP?CH?CH?CH?DL?CH?CH?CH
	LP?RP?TX?PL?CM?MN?CH?DV
	CH?CH?CH?CH?CH?CH?CH?CH
	CH?CH?CH?KL?LB?EQ?RB?CH

;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?UP?CH
;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?CH?CH
;	CH?CH?CH?CH?CH?CH?CH?CH

VBLK

ENN:	60	;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9

BTPNT:	440700,,STRING	;D
STRING:	BLOCK 10	;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS 

TPN:	0
DIRPNT:	440700,,DIROUT	;TPN
DIROUT:	BLOCK 40	;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS

OPSTKL==40
	0
OPSTK:	BLOCK OPSTKL	;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS
	0



ENDSTT:	0	;ON IF END OF STATEMENT ENCOUNTERED
CHARF:	0	;LAST WAS NOT OPERATOR
NUMFL:	0	;STRING IS NUMERIC CONSTANT (NEEDS [ AND ])
R1SV:	0	;SAVED A
R2SV:	0	;SAVED I, CALLED V EARLIER ON

INTEGR:	0	;INTEGER ARITHMETIC
WARN:	0	;ON AFTER ) TO STOP NON-OPERATOR
RANDM:	0	;DUMP COMMA COUNT HERE
TEMP:	440600,,(D)	;INDIRECT VIA D
BYTPNT:	0
	; Save 7 acs here, done by move(m)s for robustness
IRP AC,,[AA,A,B,C,D,I,P]
ACSV!AC: 0
TERMIN
PBLK
;		ENTRANCE TO 'ALGEBRAIC' TRANSLATOR

A.I:	SETOM INTEGR
	SKIPA
A.F:	SETZM INTEGR
	PUSHJ P,SWINI	;INITIALISE PASSAGE TO MIDAS ASSEMBLER
IRP AC,,[AA,A,B,C,D,I,P]
	MOVEM AC,ACSV!AC
TERMIN
	SETZM ENDSTT	;RESET END OF STMNT FLAG
	SETZM EQHIT'	;RESET LAST CHAR WAS= FLAG
	SETZM WARN	;SET OFF ERROR DETECTOR
	MOVEI A,"0	;INITIALISE POINTERS
	MOVEM A,ENN
	MOVE A,DIRPNT
	MOVEM A,TPN	;POINTER TO SAVED INPUT
	MOVE SYM,[-OPSTKL,,OPSTK]
	PUSH SYM,[0,,ENDSAT]
	PUSH P,[0]	;INITIALISE COMMA-COUNTER
	SETZM CHARF
CLSTR:	RESTOR
RDITTS:	SKIPE ENDSTT
	JRST BDEND
RDITA:	GETT
	CAIGE A,100	;FOR ABBREVIATED DISPATCH TABLE
	JRST @OPDL(A)
	CAIN A,"\
	JRST AB
	CAIN A,"^
	JRST UP

CH:	SETZM EQHIT
	SKIPE WARN
	JRST CHBRT
CHEY:	IDPB A,D
	SETOM CHARF	;NON UNARY FLAG
	JRST RDITA

GAMB:	RESTOR
COMMT:	MOVE I,R2SV
	JRST GOPURT

SHORT:	;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS
	SETZM IMMED'
	SKIPN STRING
	POPJ P,		;NO STRING
	MOVE A,BTPNT
	ILDB I,A
	CAIN I,"#
	JRST APUPJ	;YEPE HE ASKED FOR IT
	SKIPE STRING+1
	POPJ P,		;STRING IS LONG
	SKIPA
TSTSHL:	ILDB I,A
	JUMPE I,APUPJ	;ITS OK FOUND ONLY NUMBERS
	CAILE I,"@
	POPJ P,		;NON-NUMBER IN STRING
	CAIE I,".
	JRST TSTSHL
	ILDB I,A
	SKIPN I		;ANYTHING FOLLOW '.' QST
APUPJ:	SETOM IMMED'	;INDICATE IMMEDIATE USAGE IS POSSIBLE
	POPJ P,

SZPRT:	SETZM CHARF
GOPRT:	SETZM WARN
GOPART:	MOVEM I,R2SV
GOPURT:	HLRZ B,I
	HLRZ C,(SYM)
	CAMLE B,C
	JRST PSOPR	;GO PUSH OPERATOR
	SKIPN INTEGR
	SETOM IMMED	;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE
	PUSHJ P,SHORT	;ESTABLISH IF STRING CAN BE IMMEDIFIED
	POP SYM,A	;POP AN OPERATOR
	JUMPN A,(A)

	MOAN OVERPOPPED OPERATOR STACK

CHEX:	MOVE A,R1SV
	JRST CHEY

RP:	SKIPE EQHIT
	AOS ENN		;TAKE CARE OF UNSATISFIED = AT END
	SKIPN CHARF
	JRST RTONOP
	SETOM CHARF
BUDDY:	SETOM WARN
	MOVEI I,RPAR
	JRST GOPART

RTONOP:	MOVE I,(SYM)
	CAIN I,FUNCT
	JRST BUDDY	;NO ARGUMENT FUNCTION

	MOAN ) FOLLOWS OPERATOR

BDEND:	MOAN TOO MANY ('S

CHBRT:	MOAN NON-OPERATOR FOLLOWS )
CR:	SKIPE EQHIT
	AOS ENN	;HANDLES UNSATISFIED = AT END
	SETOM ENDSTT
	MOVEI I,RCAR
	JRST GOPRT

LP:	SETZM EQHIT
	SKIPE WARN
	JRST LFRHT
	SETZM CHARF
	SKIPE STRING
	JRST INDX
	PUSH P,[0]	;INITIALISE COMMA-COUNTER
	PUSH SYM,[0,,LFTPR]
	JRST RDITA

INDX:	NUMBER
	JRST NUSTRB
	GETT
	CAIG A,"9
	JRST NMRINX
	MOVEI I,"(	
	IDPB I,D
INDY:	IDPB A,D
	GETT
	CAIN A,"+	;IS IT COMPOUND SUBSCRIPT
	JRST CMPNDN
	CAIN A,"-
	JRST CMPNDN
	CAIE A,")	;SEARCH FOR NEXT RP
	JRST INDY
	IDPB A,D
CMBAN:	SETOM CHARF	;MAKE BELIEVE CHARATER LAST
	SETOM WARN	;YET SET ) TRAP
	JRST RDITA

NMRINX:	CAIN A,"-	;IS IT A MINUS
	JRST INDZ
	CAIN A,"+
	JRST INDZ
	MOVEI I,"+	;NUMERICAL SUBSCRIPT
	IDPB I,D
INDZ:	IDPB A,D
	GETT
	CAIN A,"+	;IS IT COMPOUND SUBSCRIPT
	JRST CMPNDC
	CAIE A,")
	JRST INDZ
	JRST CMBAN

CMPNDN:	MOVEI I,")
	IDPB I,D
	JRST INDZ

CMPNDC:	MOVEI I,"(
	IDPB I,D
	JRST INDY

LFRHT:	MOAN ( FOLLOWS DIRECTLY ON )
SP=RDITA	;USE FOR NON ARITH STATS

CM:	MOVE I,[1,,COMMX]
	SKIPN CHARF
	AOS ENN
	JRST SZPRT

EQ:	SETOM EQHIT
	SETZM WARN
	SKIPN CHARF	;TEST FOR EXISTANCE OF  L H S
	JRST EQFLOP
	NUMBER		;IS  L H S A NUMBER
	JRST EQNUMB
	MOVEI I,EQAAL
EQVAL:	SETZM CHARF
	PUSH SYM,I
	PUSH P,STRING
	PUSH P,STRING+1
	PUSH P,STRING+2
	PUSH P,[0]
	JRST CLSTR

PL:	MOVE I,[2,,PLUS]
	SKIPN CHARF
	JRST RDITA	;UNARY PLUS
	JRST SZPRT

MN:	MOVE I,[2,,MINUX]
	SKIPN CHARF
	MOVE I,[5,,UMINU]
	JRST SZPRT

AB:	SKIPE CHARF	;ABSOLUTE VALUE
	JRST ABERR	;NOT UNARY
	MOVE I,[5,,UABS]
	JRST SZPRT

LB:	SKIPN CHARF
	JRST LP	;TREAT LIKE (
	NUMBER
	JRST NUBRST
	MOVEI I,FUNCT
	JRST EQVAL

RB=RP

NUBRST:	MOAN '<' FOLLOWS NUMBER

NUSTRB:	MOAN '(' FOLLOWS NUMBER

EQFLOP:	MOAN '=' FOLLOWS OPERATOR

EQNUMB:	MOAN '=' FOLLOWS NUMBER

ABERR:	MOAN NON-UNARY ABS
TX:	MOVE I,[4,,TIMES]
	SKIPN CHARF
	JRST RDITA	;UNARY TIMES
	JRST SZPRT

DL:	$GET	;CONTINUE STATEMENT RC
	$GET	;LF
	$GET	;.
	CAIE A,".	;DOT
	JRST BDCONT
	$GET	;F OR I
	$GET	;CONTROL I OR SPACE
	MOVE A,DIRPNT
	MOVEM A,TPN	;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER
	MOVEI A,"$
	IDPB A,TPN
	MOVEI A,40
	IDPB A,TPN	
	JRST RDITA

ERRCON:	TRNE FF,FRPSS2	;NO OUTPUT ON SECOND PASS
	JRST CONRBT
;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC
	MOVE B,DIRPNT
OUTRR:	ILDB A,B
	PUSHJ P,TYO
	CAME B,TPN
	JRST OUTRR
	SKIPE ENDSTT
	JRST CONERT
DORSTL:	MOVEI A,40
	PUSHJ P,TYO
	MOVEI A,"?	;POINT AT ERROR
	PUSHJ P,TYO
	MOVEI A,40
	PUSHJ P,TYO
DORSAL:	$GET		;COPY UP TO LINE FEED
	PUSHJ P,TYO
	CAIE A,12	;LF
	JRST DORSAL
CONERT:	PUSHJ P,TIPIS
	PUSHJ P,CRR
CONRAT:
IRP AC,,[AA,A,B,C,D,I,P]
	MOVE AC,ACSV!AC
TERMIN
	JRST SWFLS	;GO BACK AND FLUSH 


CONRBT:	$GET
	CAIE A,12	;LF
	JRST CONRBT
	JRST CONRAT
UP:	SKIPN WARN	;FOR (NUMBER)^N
	SKIPN STRING
	JRST ITSEX
	MOVEM A,R1SV	;SAVE THE ARROW
	NUMBER
	JRST CHEX	;ITS PART OF A NUMBER
ITSEX:	MOVE I,[6,,STRSTR]
	SKIPN CHARF
	JRST EXMB
	JRST SZPRT

EXMB:	MOAN UNARY ^

BDCONT:	MOAN BAD CONTINUATION

KL=CR	;SEMICOLON ACTS LIKE CR IN TERMINATING

STRSTR:	SKIPN STRING
	JRST EXLS
	NUMBER
	SKIPA
	JRST EXLS
	SUBI I,61
	TDNE I,[-1,,777774]
	JRST EXLS
	MOVE A,STRING
	TDNE A,[3777,,-1]
	JRST EXLS
	ADDI I,POWR
	JRST @(I)

EXLS:	PUSH P,[ASCII !EXPLO!]
	PUSH P,[ASCII !G    !]
	PUSH P,[0]
	PUSH P,[1]
	SETOM EXRET'
	JRST FUNET

DV:	MOVE I,[4,,DIVIX]
	SKIPN CHARF
	MOVE I,[5,,UDIVI]
	JRST SZPRT

PSOPR:	PUSH SYM,I	;PUSH OPERATOR FOR LATER EXCECUTION
	SKIPN STRING
	JRST RDITTS
	PUSHJ P,SHORT	;CAN WE IMMEDIFY
	PUSHJ P,MVOI	;AND MOVE OPERAND INTO STACK
	JRST CLSTR
PRODB:	NUMBER		;OUTPUT WHAT IS IN STRING
	SKIPE IMMED	;NO [ & ] IF IMMEDIATE USE
	JRST OVNM
	PUSH P,A
	MOVEI A,"[	;[ FOR CONSTANT
	PUSHJ P,PUTREL
	POP P,A
	SETOM NUMFL
OVNM:	CAIN I,"#
	JRST PRDOC

	EXCH A,I
	PUSHJ P,PUTREL
	MOVE A,I
PRDOC:	ILDB I,A
	JUMPN I,OVNM
	SKIPN NUMFL
	POPJ P,
	MOVEI A,"]	;] FOR CONSTANT
	PUSHJ P,PUTREL
	SETZM NUMFL
	POPJ P,

PRODC:	HRLI A,440700	;MAKE BYTE POINTER
	JRST PRDOC

LFTPR:	SPECN
	JRST RDITTS	;IGNORE LP ON STACK
RCAR:	HALT	;IMPOSSIBLE FOR THESE TO BE ON STACK
RPAR:	HALT

EQAAL:	SPECN
	SKIPE STRING
	PUSHJ P,MVOI
	MOVEI A,[ASCIZ !	MOVEM A!]
	PUSHJ P,PRODC
	POP P,STRING+2
	POP P,STRING+1
	POP P,STRING
	MOVE A,ENN
	SOS A
	PUSHJ P,FINOF
	JRST GAMB

ENDSAT:	SPECN
	SKIPN ENDSTT
	JRST TOEARL
	SKIPE STRING
	PUSHJ P,MVOI
GETLF:	$GET
	CAIE A,12	;LF
	JRST GETLF
IRP AC,,[AA,A,B,C,D,I,P]
	MOVE AC,ACSV!AC
TERMIN
	JRST SWRET	;GO BACK

MVOI:	MOVE A,BTPNT
	ILDB I,A
	CAIN I,"&
	JRST MVOALR	;OPERAND ALREADY THERE
	MOVEI A,[ASCIZ !	MOVE A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	MOVEI A!]
MVOIK:	PUSHJ P,PRODC
	MOVE A,ENN
	AOS ENN
FINOF:	PUSHJ P,PUTREL
	MOVEI A,",
	PUSHJ P,PUTREL
	PUSHJ P,PRODB
	RETLIN
	POPJ P,

MVOALR:	AOS ENN
	POPJ P,

TOEARL:	MOAN TOO MANY )'S
PLUS:	MOVEI A,[ASCIZ !	FADR A!]
	SKIPE INTEGR
	MOVEI A,[ASCIZ !	ADD A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	ADDI A!]
OPERT:	PUSHJ P,PRODC
	SKIPE STRING
	JRST GAINS
	SOS ENN
OPRTE:	MOVE A,ENN
	SOS A
	PUSHJ P,PUTREL
	PUSHJ P,COMMAA
	MOVE A,ENN
	PUSHJ P,PUTREL
	RETLIN
	JRST COMMT

COMMAA:	MOVEI A,",
	PUSHJ P,PUTREL
	MOVEI A,"A
	JRST PUTREL

GAINS:	MOVE A,ENN
	SOS A
	PUSHJ P,FINOF
	JRST GAMB

MINUX:	MOVEI A,[ASCIZ !	FSBR A!]
	SKIPE INTEGR
	MOVEI A,[ASCIZ !	SUB A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	SUBI A!]
	JRST OPERT

TIMES:	PUSHJ P,TMSTR
	SKIPE IMMED
	MOVEI A,[ASCIZ !	IMULI A!]
	JRST OPERT

DIVIX:	MOVEI A,[ASCIZ !	FDVR A!]
	SKIPE INTEGR
	MOVEI A,[ASCIZ !	IDIV A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	IDIVI A!]
	JRST OPERT
UMINU:	CAMN B,C
	JRST BAKWD		;THESE HAVE TO BE STACKED REVERSE
	SKIPE STRING
	JRST MOABC
	MOVEI A,[ASCIZ !	MOVNS A!]
UMINUC:	PUSHJ P,PRODC
	MOVE A,ENN
	SOS A
	PUSHJ P,PUTREL
	RETLIN
	JRST COMMT

MOABC:	MOVEI A,[ASCIZ !	MOVN A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	MOVNI A!]
	PUSHJ P,MVOIK
	JRST GAMB

UABS:	CAMN B,C
	JRST BAKWD
	SKIPE STRING
	JRST MOABS
	MOVEI A,[ASCIZ !	MOVMS A!]
	JRST UMINUC

MOABS:	MOVEI A,[ASCIZ !	MOVM A!]
	SKIPE IMMED
	MOVEI A,[ASCIZ !	MOVMI A!]
	PUSHJ P,MVOIK
	JRST GAMB

MVONT:	MOVEI A,[ASCIZ !	MOVE A!]
	PUSHJ P,PRODC
	MOVE A,ENN
	JRST ONMVS

TMSTR:	MOVEI A,[ASCIZ !	FMPR A!]
	SKIPE INTEGR
	MOVEI A,[ASCIZ !	IMUL A!]
	POPJ P,
BAKWD:	PUSH SYM,A
	JRST PSOPR

UDIVI:	CAMN B,C
	JRST BAKWD	;THESE HAVE TO BE STACKED REVERSE
	SKIPE INTEGR
	JRST UINDV
	SKIPN STRING
	PUSHJ P,MVONT
	MOVEI A,[ASCIZ !	HRLZI A!]
	PUSHJ P,PRODC
	MOVE A,ENN
	SKIPN STRING
	SOS A
	PUSHJ P,PUTREL
	MOVEI A,[ASCIZ !,201400!]
	PUSHJ P,PRODC
	RETLIN
	AOS ENN
	JRST DIVIX

ONTMS:	PUSHJ P,TMSTR
	PUSHJ P,PRODC
	MOVE A,ENN
	SOS A
ONMVS:	PUSHJ P,PUTREL
	PUSHJ P,COMMAA
	MOVE A,ENN
	SOS A
LSTCHX:	PUSHJ P,PUTREL
	RETLIN
	POPJ P,

POWR:	GAMB?POWR2?POWAA?POWR4

POWR4:	PUSHJ P,ONTMS
POWR2:	PUSHJ P,ONTMS
	JRST GAMB

POWAA:	PUSHJ P,MVONT
	AOS ENN
	PUSHJ P,ONTMS
	SOS ENN
	PUSHJ P,TMSTR
	PUSHJ P,PRODC
	RESTOR
	JRST OPRTE

COMMX:	AOS (P)
	SKIPE STRING
	PUSHJ P,MVOI
	JRST GAMB
UINDV:	MOAN INTEGER UNARY DIVIDE

FUNCT:	SETZM EXRET
FUNET:	SKIPE STRING
	PUSHJ P,MVOI
	SPECN
	PUSHJ P,MORFMC
	MOVEI A,[ASCIZ !	PUSHJ P,!]
	POP P,STRING+2
	POP P,STRING+1
	POP P,STRING
	PUSHJ P,PRODC
	PUSHJ P,PRODB
	RESTOR
	RETLIN
	PUSHJ P,MORFNC
	SKIPN EXRET
	JRST RDITTS	;AS USED FROM FUNCT
	JRST COMMT	;AS USED FROM  STRSTR

MORFMC:	MOVE A,RANDM
	MOVEM A,RANSV'
	SKIPN CHARF	;NO ARGUMENTS
	AOS ENN
	SETOM CHARF
	MOVEI A,"1
	CAMN A,ENN	;ARE ARGUMENT ALREADY IN A0 AND UP
	POPJ P,
	SETZM CORDM
MORYLP:	PUSHJ P,ZENBD
	AOS CORDM
	SOSL RANSV
	JRST MORYLP
	POPJ P,

MORFNC:	MOVEI A,"1
	CAMN A,ENN
	POPJ P,
	MOVE A,RANDM
	MOVEM A,CORDM'
MORXLP:	PUSHJ P,ZENBD
	SOSL CORDM
	JRST MORXLP
	POPJ P,

ZENBD:	MOVEI A,[ASCIZ !	EXCH A!]
	PUSHJ P,PRODC
	MOVE A,CORDM
	ADDI A,"0
	PUSHJ P,PUTREL
	PUSHJ P,COMMAA
	MOVE A,ENN
	SOS A
	ADD A,CORDM
	JRST LSTCHX
TIPIS:	MOVE A,TEMP
	MOVEM A,BYTPNT
MORTP:	ILDB A,BYTPNT
	CAIN A,1	;EXCLAMATION
	POPJ P,
	ADDI A," 	;SPACE
	PUSHJ P,TYO
	JRST MORTP

]		;END .I.FSW CONDITIONAL
IFN LISTSW,[

;LISTING ROUTINES.

PNTR:	MOVEM 17,PNTSA+17
	MOVEI 17,PNTSA
	BLT 17,PNTSA+16
	MOVE P,PNTSA+P		; P = 17 so must restore.
IFN P-17, .ERR P=17 assumption at PNTR!
	SKIPL LSTONP
	JRST PNTR5
	AOSE LISTPF
	JRST PNTR1
	SKIPGE T,LISTAD
	JRST PNTR2
	PUSHJ P,P6OD
	HLRZS T
	PUSHJ P,PSOS	;PRINT SPACE OR '
	PUSHJ P,PILPTS
PNTR3:	HLRZ T,LISTWD
	PUSHJ P,P6OD
	MOVS T,LSTRLC
	TLNE T,400000
	AOJ T,
	PUSHJ P,PSOS
	HRRZ T,LISTWD
	PUSHJ P,P6OD
	HRRZ T,LSTRLC
	PUSHJ P,PSOS
	PUSHJ P,PILPTS
	PUSHJ P,PILPTS
PNTR4:	MOVE TT,[440700,,LISTBF]
PNTR6:	CAMN TT,PNTBP
	JRST PNTR5A
	ILDB A,TT
	PUSHJ P,PILPT
	JRST PNTR6

PNTR5A:	CALL PNTCR
	MOVE A,LISTBC
	CAIE A,14
	 JRST PNTR7
PNTR5C:	CALL PILPT	;OUTPUT THE ^L,
	CALL PNTHDR	;AND THE PAGE NUMBER.
	JRST PNTR5D

PNTR7:	MOVEI A,12
	PUSHJ P,PILPT
PNTR5D:	SETOM LISTBC
PNTR5:	MOVNI A,LISTBS*5-1
	MOVEM A,PNTSW	;DETECT OVERFLOW OF LISTBF
	MOVE TT,[440700,,LISTBF]
	MOVEM TT,PNTBP
	MOVSI 17,PNTSA
	BLT 17,17
	POPJ P,
PNTR5B:	MOVE A,LISTBC
	CAIN A,14
	JRST PNTR5C
	JRST PNTR5D

PNTR2:	MOVEI T,8
	MOVEI A,40
	PUSHJ P,PILPT
	SOJG T,.-1
	JRST PNTR3

PNTR1:	MOVE TT,[440700,,LISTBF]
	CAMN TT,PNTBP
	JRST PNTR5B
	MOVEI T,25.
	MOVEI A,40
	PUSHJ P,PILPT
	SOJG T,.-1
	JRST PNTR4

PSOS:	MOVEI A,"'
	TRNN T,-1
PILPTS:	MOVEI A,40
	JRST PILPT

P6OD:	MOVE TT,[220300,,T]
P6OD1:	ILDB A,TT
	ADDI A,"0
	PUSHJ P,PILPT
	TLNE TT,770000
	JRST P6OD1
	POPJ P,

PNTCR:	MOVEI A,^M	;OUTPUT ^M TO LST IF OPEN.
PILPTX:	SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING.
	 JRST PILPT
	RET

PNTHDR:	MOVEI A,^I
	MOVEI B,10.	;MOVE TO COLUMN 80.,
	CALL PILPT
	SOJG B,.-1
	PUSH P,LSTTTY
	HLLOM B,LSTTTY	;POSITIVE SO TYOERR GOES ONLY TO LST.
	TYPR [ASCIZ/Page /]
	MOVE A,CPGN
	CALL [AOJA A,DPNT]
	REST LSTTTY
PNTCRR:	CALL PNTCR	;OUTPUT CRLF TO LST IF OPEN.
PNTLF:	MOVEI A,^J
	JRST PILPTX
DEFINE LSTM %A,B,C
IF1 [	[B] ? [C]   ]
IF2 [	MOVE A,[B]
	MOVEM A,%A
.=.+LSTM0-2
	MOVE A,[C]
	MOVEM A,%A
.=.-LSTM0
]
TERMIN

A.LSTFF:	AOS (P)	;RETURN NO VALUE.
;	   ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING.
LSTOFF:	LSTM LSTONP,0,-1
	LSTM LSTPLM,[TLO B,4^5][JRST PSHLML]
	LSTM RCHLST,RCHLS1,AOSN PNTSW
	LSTM RCH1LS,RET,[CAILE A,^M]
	LSTM POPLML,JFCL,[IDPB A,PNTBP]
	JRST MDSCLR
LSTM0==.-LSTOFF

LSTON:	BLOCK LSTM0-1
	JRST MDSSET

A.LSTN:	SKIPN LISTP1	;IF SHOULD LIST THIS PASS
	 JUMPGE FF,MACCR
	SKIPE LISTP	;AND WANT LISTING,
	 CALL LSTON	;TURN ON LISTING OUTPUT.
	JRST MACCR

IFNDEF LISTBS,LISTBS==50.	;LISTBF SIZE IN WORDS.

VBLK		;LISTING FEATURE VARIABLES

PNTBP:	0	;POINTER TO LISTING LINE BUFFER
LSTONP:	0	;NONZERO WHEN OUTPUTTING TO LISTING FILE.
LISTP:
LISTON:	0	;-1 IF LISTING ON
PNTSW:	0	;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF>
LISTBF:	BLOCK LISTBS
LISTAD:	0	;ADDRESS OR -1 NONE 3.1 RELOC
LISTWD:	0	;WORD
LSTRLC:	0	;RELOCATION
LISTPF:	0	;-1 OTHERS CONTAIN SOMETHING
LISTBC:	0	;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR
LISTTM:	0	;TEMP AT AEND
PNTSA:	BLOCK 20	;AC SAVE AREA FOR LISTING FEATURE
LISTP1:	0	;POSITIVE => WANT TO LIST EVEN ON PASS 1.
] ;END IFN LISTSW,

IFE LISTSW,VBLK

;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0.
LSTTTY:	0	;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0.
LSTPLM:	TLO B,4^5	;OR JRST PSHLML		;XCT'D BY PSHLMB.
POPLML:	JFCL		;OR IDPB A,PNTSW	;XCT'D IN POPLMB.

PBLK
IFE LISTSW, A.LSTN: A.LSTF:	RET
VBLK
IFN CREFSW,[
CREFP:	0	;SET BY C SWITCH TO REQUEST CREFFING.
CRFONP:	0	;SET WHILE CREFFING.
CRFLFL:	0	;LAST PAGNUM,,LINENUM OUTPUT.
CRFINU:	JFCL\PUSHJ P,CRFUSE	;XCT THIS TO CREF NON-DEF OCCUR.
CRFLBL:	JFCL\PUSHJ P,CRFLB1	;XCT FOR DEF. OF NORMAL SYM.
CRFEQL:	JFCL\PUSHJ P,CRFEQ1	;   FOR DEF. OF NORMAL SYM. OR INTSYM.
CRFMCD:	JFCL\PUSHJ P,CRFMC1	;     FOR DEF. OF MACRO.
CRFDEF:	JFCL\PUSHJ P,CRFDF1	;	FOR RANDOM DEF, CHECK FLAGS.
]
CRFILE:	0	;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S
;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT.
PBLK
IFN CREFSW,[
CRFEQ1:	MOVEI T,(B)
	CAIN A,1	;IF NOT PSEUDO OR NOT INTSYM,
	CAIE T,INTSYM
	JRST CRFLB1	;IS NORMAL SYM.
CRFOD1:	MOVSI T,600000	;ELSE DEFINING INSN.
	JRST CRFEQ2

CRFDF2:	MOVEI T,(B)	;DECIDE WHETHER DEFINING MACRO OR PSEUDO.
	CAIE T,MACCL
	JRST CRFOD1
CRFMC1:	SKIPA T,[500000,,]	;DEFINING MACRO.
CRFLB1:	MOVSI T,440000	;DEFINING NORMAL SYM.
CRFEQ2:	PUSH P,A
	MOVE A,T
	JRST CRFMA1

;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM.
CRFUSE:	TLNE C,3NCRF	;SYM MAY HAVE CREFFING SUPPRESSED.
	POPJ P,
	PUSH P,A
	CAIN A,1
	JRST CRFMAC	;PSEUDOS, MACROS.
	MOVSI A,40000	;FLAG FOR NORMAL SYM.
	TRNN C,-1
	MOVSI A,200000	;FLAG FOR INSNS.
CRFMA1:	PUSH P,A
	MOVE A,CLNN
	HRL A,CPGN
	AOBJN A,.+1	;A HAS PAGNUM,,LINENUM .
	SKIPGE CRFILE	;IF SHOULD OUTPUT IT,
	JRST CRFUS1
	CAME A,CRFLFL	;AND HAS CHANGED, DO SO.
	PUSHJ P,CRFOUT
	MOVEM A,CRFLFL
CRFUS1:	POP P,A
	IOR A,SYM	;COMBINE SYM AND CREF FLAG.
	PUSHJ P,CRFOUT
	JRST POPAJ

CRFMAC:	MOVEI A,(B)
	CAIN A,MACCL
	SKIPA A,[100000,,]	;MACRO
	MOVSI A,200000		;PSEUDO-OP.
	JRST CRFMA1
;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM.
CRFDF1:	CAIN A,1	;TYPE 1 => MACRO OR PSEUDO.
	JRST CRFDF2
	TRNE C,-1	;ELSE INSN OR NORMAL SYM.
	JRST CRFLB1
	JRST CRFOD1

DEFINE CRFM %A,B,C
IF1 [	[B]
	[C] ]
IF2 [	MOVE A,[B]
	MOVEM A,%A
.=.+CRFM0-2
	MOVE A,[C]
	MOVEM A,%A
.=.-CRFM0]
TERMIN


A.CRFFF:	AOS (P)	;.CRFOFF - STOP CREFFING. NO VAUE.
;		LOCATION, NORMAL VALUE, VALUE WHILE CREFFING
CRFOFF:	CRFM	CRFONP,0,-1
	CRFM	CRFLBL,JFCL,[PUSHJ P,CRFLB1]
	CRFM	CRFEQL,JFCL,[PUSHJ P,CRFEQ1]
	CRFM	CRFMCD,JFCL,[PUSHJ P,CRFMC1]
	CRFM	CRFINU,JFCL,[PUSHJ P,CRFUSE]
	CRFM	CRFDEF,JFCL,[PUSHJ P,CRFDF1]
	POPJ P,
CRFM0==.-CRFOFF

CRFON:	BLOCK CRFM0-1
	POPJ P,

A.CRFN:	JUMPGE FF,MACCR
	SKIPE CREFP	;.CRFON, IF HAVE CREF FILE, START CREFFING.
	PUSHJ P,CRFON
	JRST MACCR
] ;END IFN CREFSW,
SUBTTL TS Routines for I/O & overall control

IFN TS,.INSRT TSRTNS

FEED1:	SKIPA B,[40]
FEED:	MOVEI B,5
	JRST TFEED

VBLK

IFG PURESW-DECSW,[	;PURIFICATION ROUTINE

PURIFG:	-1		;-1 IF NOT (YET) PURIFIED
]
	VARIAB
VPAT:
VPATCH:	BLOCK 20
VPATCE=.-1

PBLK

CONSTANTS

PAT:
PATCH:	BLOCK 100
PATCHE:	-1

IFG PURESW-DECSW,[LOC <.+1777>&-2000	;SKIP TO NEXT PAGE
	MAXPUR==._-10.	;FIRST PAGE ABOVE PURE PAGES
PRINTA Pure pages = ,\MAXPUR-MINPUR
]

VBLK
PDL:	BLOCK LPDL+1

IFN DECDBG, DECDBB:	BLOCK 8000.	;SPACE FOR DEC DDT'S SYMS.

.NSTGW
BBKCOD==.	;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION
IFG PURESW-DECSW,MINBNK==<.+1777>_-10.	;FIRST PAGE OF BLANK CODE
BNKBLK		;DUMP OUT ACCUMULATED BLANK CODING

		;NOW MORE BLANK CODING

BKBUF:	BLOCK BSIZE+5	;CURRENT BLOCK TO OUTPUT
GLOTB:	BLOCK 20	;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING)
STRSTO:	BLOCK STRL	;STRING STORAGE FOR GSYL AND FRIENDS
IFN FASLP,[
FASB:	BLOCK FASBL	;OUTPUT BUFFER FOR FASL MODE
			;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF
FASAT:	BLOCK FASATL	;ATOM TABLE FOR FASL MODE
			;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD,
			;NAMELY:
			;  HEADER WD. RH LENGTH IN WDS
			;  4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED)
			;  FOLLOWED BY PN OR VALUE
			;-EXCEPT-  IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST

]

EBKCOD==.		;END BLANK CODING
.YSTGW

PRINTA ST = ,\.-RL0

ST:	;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK.
	BLOCK NRMWPS*SYMDSZ

;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS
.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES.		SO DON'T USE THEM!
CONTAB:	BLOCK LCONTB	;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA
CONGLO:	BLOCK LCNGLO	;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS
	;FIRST WD GLOTB ENTRY.  SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS
CONBIT:	BLOCK LCONTB/12.+1	;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK)
				;3 BITS FOR EACH WORD OF CONTAB.
;;INIT		;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT)
IFN ITSSW\TNXSW,MINMAC==./2000	;# OF 1ST PAGE HOLDING PART OF MACTAB.

;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED
;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF
;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED.
;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO.

;MAC PROC TABLES
MACTBA:	773767750000	;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S)
INIT1:	MOVE CH1,MACTAD	;GET ADDR THIS CODE REALLY STARTS AT.
	SUBI CH1,MACTBA	;GET OFFSET FROM WHERE ASSEMBLED.
	SETZM BBKCOD
	MOVE A,[BBKCOD,,BBKCOD+1](CH1)
	BLT A,EBKCOD-1	;CLEAR OUT BLANK CODING
	PUSH P,[SP4](CH1)	;NOW INIT THE SYMTAB & FINISHED.

;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN.
INITS:	MOVE AA,SYMLEN	;SET UP THE OTHER VARS
	IMUL AA,WPSTE	;DEALING WITH SYMTAB SIZE.
	MOVEM AA,SYMSIZ
	ADDI AA,ST	;ADDR OF START OF CONTAB.
	MOVEM AA,CONTBA
	MOVEM AA,PLIM
	ADD AA,CONLEN	;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB.
	MOVEM AA,CONTBE	;WHICH IS ALSO THE END OF CONTAB.
	MOVEM AA,CONGLA
	MOVEM AA,CONGOL
	MOVE A,CONLEN	;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN)
	LSH A,-2
	ADD AA,A
	MOVEM AA,CONGLE	;TO GET END OF CONGLO, AND START OF CONBIT TABLE.
	MOVEM AA,CONBIA
	MOVE A,CONLEN
	ADDI A,11.
	IDIVI A,12.
	ADD AA,A	;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB.
IFN DECSW,[
	PUSH P,AA
	ADDI AA,MACL-1
	IORI AA,1777	;FIX ALLOCATION PROBLEMS ON KI-10
	CORE AA,
	 ETF [ASCIZ /No core for symbols/](CH1)
	REST AA
]
	MOVN A,SYMLEN
	HRLZM A,SYMAOB	;AOBJN -> SYMTAB.
	MOVE A,WPSTE
	SUBI A,1
	MOVEM A,WPSTE1
	MOVN A,WPSTE
	HRRM A,WPSTEB
	CAMG AA,MACTAD	;MOVED MACTAB UP?
	 JRST INITS1(CH1)
IFN ITSSW\TNXSW,[		;YES, GET CORE FOR INCREASE.
	PUSH P,AA
	MOVEI AA,MACL+1777(AA)
	LSH AA,-10.	;1ST PAGE NOT NEEDED BY MACTAB.
	MOVEI A,MACL+1777+MACTBA(CH1)
	LSH A,-10.	;1ST PAGE MACTAB DOESN'T YET HAVE.
	SUBM A,AA	;# PAGES NEEDED.
	HRLZI AA,(AA)
	HRRI AA,(A)	;-<# PAGES>,,<1ST NEEDED>
	JUMPGE AA,INITS3(CH1)	;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE.
IFN TNXSW, PUSHJ P,TCORGT
IFN ITSSW, .CALL INITSB(CH1) ? .VALUE
INITS3:	REST AA
]
	SUBM AA,MACTAD	;MACTAD _ SHIFT IN START OF MACTAB.
	EXCH AA,MACTAD	;MACTAD GETS NEW START, AA HAS SHIFT.
	MOVSI A,PTAB-CCOMPB
	ADDM AA,PTAB(A)	;RELOCATE BYTE-PTRS INTO MACTAB.
	AOBJN A,.-1(CH1)
	MOVNI B,INITS2(CH1)
	HRROI A,@EISYMP(CH1)
	ADDI B,1(A)	;GET # WDS IN SECOND HALF OF INIT CODE.
	HRRM AA,.+1(CH1)	;COPY 2ND HALF UPWARD WITH POP-LOOP.
	POP A,(A)	;THIS INSN IMPURE.
	SOJG B,.-1(CH1)
	ADDI CH1,(AA)	;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE.
	JRST INITS2(CH1)	;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO.
INITS2:	HRROI A,INITS2-1(CH1)	;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2)
	SUBI A,(AA)		;GET WHERE NOW ENDS, NOT WHERE WILL END.
	MOVEI B,INITS2-MACTBA	;UP UNDERNEATH THE 2ND HALF.
	HRRM AA,.+1(CH1)	;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS)
	POP A,(A)
	SOJG B,.-1(CH1)
INITS1:	MOVE AA,SYMSIZ
	SETZM ST
	MOVE A,[ST,,ST+1](CH1)
	BLT A,ST-1(AA)	;CLEAR OUT SYMBOL TABLE
	SETZM ESBK	;DEFINE THEM IN OUTER BLOCK.
	MOVEI AA,ISYMTB(CH1)
	MOVS F,ISMTBB(CH1)	;GET SWAPPED VALUE OF FIRST INSTRUCTION
SP3:	CAIL AA,EISYM1(CH1)
	JRST SP1(CH1)	;DONE WITH INSTRUCTIONS
	MOVE SYM,(AA)
	JUMPE SYM,SP2(CH1)
	TLZ SYM,740000
	PUSHJ P,ES	;WON'T SKIP
	 CAIA
	  .VALUE	;INSTRUCTION PRESENT TWICE IN TABLE!!?!?
	HRLZI T,SYMC
	HRLZ B,F
	MOVSI C,3KILL
	PUSH P,CH1
	PUSHJ P,VSM2
	POP P,CH1
SP2:	ADDI F,1000
	AOJA AA,SP3(CH1)
;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER,
;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE).
EISYMP:		;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT.
SP1:	CAIL AA,EISYMT(CH1)
	 POPJ P,
	MOVE SYM,(AA)
	LDB T,[400400,,SYM](CH1)
	ROT T,-4
	TLZ SYM,740000
	PUSHJ P,ES
	 CAIA
	  JRST SP5(CH1)		;SYM ALREADY DEFINED?  (MIGHT BE .UAI, IN ITS AND IN MIDAS).
	MOVE B,1(AA)
	MOVSI C,3KILL
	CAME T,[GLOETY,,](CH1)	;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING
	CAMN T,[GLOEXT,,](CH1)
	TLO C,3LLV
	PUSH P,CH1
	PUSHJ P,VSM2
	POP P,CH1
SP5:	AOS AA
	AOJA AA,SP1(CH1)
IFN ITSSW,[
INITSB:	SETZ ? 'CORBLK
	MOVEI %CBNDR+%CBNDW	;BOTH READ AND WRITE.
	MOVEI %JSELF ? AA	;INTO SELF, AA IS AOBJN -> PAGES.
	SETZI %JSNEW		;FRESH PAGES.

	;GOBBLE SYMS FROM SYSTEM
	;TABLE AREA IN SYSTEM:
	;FIRST LOC SYSYMB
	;LAST (AS OPPOSED TO LAST + 1) SYSYME

TSYMGT:	MOVE AA,[MXICLR-MXIMAC,,MXICLR]
	.CALL INITSB	;GET MACTAB PAGES NNOT LOADED INTO.
	 .VALUE
IFN PURESW,[
	MOVE AA,[MINBNK-MINMAC,,MINBNK]
	.CALL INITSB	;GET PAGES FOR BLANK CODE & SYMTAB.
	 .VALUE
	SKIPN PURIFG
	 JRST TSYMG3
	JSP F,FLSPGS	;NOT PURIFIED => FLUSH PAGES
	 <MXIMAC-MINPUR>,,MXIMAC	;OF MACTAB CREATED BY LOADING BUT NOT NEEDED.

TSYMG3:
]
	MOVEI A,EISYMT	;EISYMT FIRST LOC FOR ITS SYMS
	MOVE B,[SIXBIT /CALLS/]	;SYSTEM CALLS
	.GETSYS A,	;READ IN SYSTEM CALLS (SHOULD SKIP)
	 .VALUE
	SKIPGE A
	 .VALUE		;.GETSYS DIDN'T UPDATE AOBJN POINTER
	HRRM A,SP1	;MARK END OF SYMS
	ANDI A,-1
	CAIL A,MACTBA+MACL
	 .VALUE		;MACL TOO SMALL!  INITS MIGHT LOSE.
	MOVEI B,EISYMT
	MOVEI AA,SYMC_<-18.+4>	;SQUOZE FLAG FOR SYM
TSYMG2:	DPB AA,[400400,,(B)]
	ADDI B,2
	CAIE B,(A)
	JRST TSYMG2
	POPJ P,
]; IFN ITSSW
SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM

IFN ITSSW\TNXSW,[
IFN PURESW,[	;HERE ARE THE GUTS OF THE PURIFY ROUTINE

PURIFY:	SKIPL NVRRUN
IFN ITSSW,[ .VALUE [ASCIZ /:Already run
/]]
IFN TNXSW,[
	 JRST [	HRROI 1,[ASCIZ /? Already run
/]
		PSOUT
		HALTF
		JRST .+1]	; If continued, go ahead anyway.
] ;IFN TNXSW
PURIF1:	MOVEI P,17	; Start PDL at 20
	JSP F,FLSPGS	; First flush blank-code pages,
	 <MINBNK-MINMAC>,,MINBNK	; incl. symbol table.
	JSP F,FLSPGS
	 <MXICLR-MINPUR>,,MXICLR	; Flush MACTAB pages created by load but not needed.
	JSP F,PURIFD
	 <MINPUR-MAXPUR>,,MINPUR	; Purify pure pages.
	SETZM PURIFG	; Set "purified" flag
	MOVE [1,,2]	; Now clear out remains of data of self
	MOVEI 1,0
	BLT 40
IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/]
IFN TNXSW,[
	HRROI 1,[ASCIZ / Purified, now SAVE
/]
	PSOUT
	HALTF
] ; IFN TNXSW

GAPFLS:	JSP F,FLSPGS	; Flush gap pages created on initial load.
	 <MXIMAC-MINPUR>,,MXIMAC
IFN ITSSW, .BREAK 16,300000
IFN TNXSW, HALTF

	; JSP F,FLSPGS
	;  -<# pgs>,,<page to start>
	;	Flush pages specified by page AOBJN

FLSPGS:	MOVE A,(F)	; Get the page AOBJN
IFN ITSSW,[
	SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A]
	 .LOSE 1000
]
IFN TNXSW,[
	ASH A,1		; Multiply # pages, page # by 2.
	HLRE B,A
	HRLI A,.FHSLF
	MOVNS B
	TLO B,(PM%CNT)	; Say hacking repeat count
FLSPG2:	SYSCAL PMAP,[[-1] ? A ? B]	; Flush these pages.
	TLNN FF,FL20X		; If on 20X, that's all.
	 JRST [	HRRI B,-1(B)	; Else, on 10X, must iterate manually.
		TRNE B,400000	; See if became "negative".
		 JRST .+1	; Yep, done with manual iteration.
		AOJA A,FLSPG2]	; Nope, bump page #.
]
	JRST 1(F)

	; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead.

PURIFD:	MOVE A,(F)	; Get page AOBJN
IFN ITSSW,[
	SYSCAL CORBLK,[MOVEI %CBNDR	; Read access only.
		MOVEI %JSELF ? A]
	 .LOSE 1000
]
IFN TNXSW,[
	ASH A,1		; Double everything.
	HLRE B,A
	MOVNS B
	HRLI A,.FHSLF
PURID1:	SYSCAL SPACS,[A ? [PA%RD+PA%EX]]
	ADDI A,1
	SOJG B,PURID1
]
	JRST 1(F)

IFN TNXSW,[

	; PURSAV - More useful hack for 10X/20X since it preserves page access
PURSV0:	PUSHJ P,RDJERR
PURSAV:	MOVEI P,20
	HRROI R1,[ASCIZ /Pure-Save to file: /]
	PSOUT
	MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS)
	MOVE R2,[.PRIIN,,.PRIOU]
	GTJFN			; Get JFN from TTY
	 JRST PURSV0
	SETZM PURIFG		; Claim purified...
	SETOM MEMDBG		; and keeping watch on memory.
	HRLI R1,.FHSLF
	MOVEI R2,[
		2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE	; Variables/buffers
		2*<MINMAC-MXICLR>,,2*MINMAC+SS%RD+SS%WR+SS%EXE	; MACTAB init
		2*<MINPUR-MAXPUR>,,2*MINPUR+SS%RD+SS%EXE	; Purify pure pages.
		0 ]	; End of SSAVE table
	SETZ R3,
	SSAVE		; Do it!
	HRROI R1,[ASCIZ /Saved./]
	PSOUT
	HALTF
] ; IFN TNXSW

] ; IFN PURESW
] ; IFN ITSSW\TNXSW

IFN DECDBG,[
DECDBM:	0
	HRLZ A,.JBSYM	;GET ADDR OF START OF DDT SYMS,
	HRRI A,DECDBB+200	;LEAVE 200 WD SPACE BEFORE THEM.
	HRRM A,.JBSYM		;MOVE THEM INTO SPACE PROVIDED
	HLRE B,.JBSYM
	MOVMS B
	BLT A,DECDBB+177(B)	;SO THEY WON'T GET IN MACTAB'S WAY.
	JRST @DECDBM
]

CONSTANTS
;;ISYMS		;INITIAL SYMBOL TABLE

IFNDEF JSYS,JSYS=104_33	;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE

ISMTBB:	JSYS		;FIRST OP. CODE IN ISYMTB

ISYMTB:

; 104-177 (JSYS - FDVRB)

SQUOZE 10,JSYS		;BBN PAGER INSTRUCTION
SQUOZE 10,ADJSP		;KL10 INSTRUCTION
	0
	0

SQUOZE 10,DFAD		;KI10 INSTRUCTION
SQUOZE 10,DFSB		;KI10 INSTRUCTION
SQUOZE 10,DFMP		;KI10 INSTRUCTION
SQUOZE 10,DFDV		;KI10 INSTRUCTION
SQUOZE 10,DADD		;KL10 INSTRUCTION
SQUOZE 10,DSUB		;KL10 INSTRUCTION
SQUOZE 10,DMUL		;KL10 INSTRUCTION
SQUOZE 10,DDIV		;KL10 INSTRUCTION
SQUOZE 10,DMOVE		;KI10 INSTRUCTION
SQUOZE 10,DMOVN		;KI10 INSTRUCTION

SQUOZE 10,FIX		;KI10 INSTRUCTION
SQUOZE 10,EXTEND	;KL10 INSTRUCTION
SQUOZE 10,DMOVEM	;KI10 INSTRUCTION
SQUOZE 10,DMOVNM	;KI10 INSTRUCTION
SQUOZE 10,FIXR		;KI10 INSTRUCTION
SQUOZE 10,FLTR		;KI10 INSTRUCTION

SQUOZE 10,UFA		;KA/KI10 INSTRUCTION
SQUOZE 10,DFN		;KA/KI10 INSTRUCTION
SQUOZE 10,FSC

SQUOZE 10,IBP
SQUOZE 10,ILDB
SQUOZE 10,LDB
SQUOZE 10,IDPB
SQUOZE 10,DPB

SQUOZE 10,FAD
SQUOZE 10,FADL		;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FADM
SQUOZE 10,FADB
SQUOZE 10,FADR
SQUOZE 10,FADRI		;PDP10 INSTRUCTION
SQUOZE 10,FADRM
SQUOZE 10,FADRB
SQUOZE 10,FSB
SQUOZE 10,FSBL		;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FSBM
SQUOZE 10,FSBB
SQUOZE 10,FSBR
SQUOZE 10,FSBRI		;PDP10 INSTRUCTION
SQUOZE 10,FSBRM
SQUOZE 10,FSBRB
SQUOZE 10,FMP
SQUOZE 10,FMPL		;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FMPM
SQUOZE 10,FMPB
SQUOZE 10,FMPR
SQUOZE 10,FMPRI		;PDP10 INSTRUCTION
SQUOZE 10,FMPRM
SQUOZE 10,FMPRB
SQUOZE 10,FDV
SQUOZE 10,FDVL		;PDP6/KA/KI INSTRUCTION
SQUOZE 10,FDVM
SQUOZE 10,FDVB
SQUOZE 10,FDVR
SQUOZE 10,FDVRI		;PDP10 INSTRUCTION
SQUOZE 10,FDVRM
SQUOZE 10,FDVRB
; 200-277 (MOVE - SUBB)

SQUOZE 10,MOVE
SQUOZE 10,MOVEI
SQUOZE 10,MOVEM
SQUOZE 10,MOVES
SQUOZE 10,MOVS
SQUOZE 10,MOVSI
SQUOZE 10,MOVSM
SQUOZE 10,MOVSS
SQUOZE 10,MOVN
SQUOZE 10,MOVNI
SQUOZE 10,MOVNM
SQUOZE 10,MOVNS
SQUOZE 10,MOVM
SQUOZE 10,MOVMI
SQUOZE 10,MOVMM
SQUOZE 10,MOVMS

SQUOZE 10,IMUL
SQUOZE 10,IMULI
SQUOZE 10,IMULM
SQUOZE 10,IMULB
SQUOZE 10,MUL
SQUOZE 10,MULI
SQUOZE 10,MULM
SQUOZE 10,MULB
SQUOZE 10,IDIV
SQUOZE 10,IDIVI
SQUOZE 10,IDIVM
SQUOZE 10,IDIVB
SQUOZE 10,DIV
SQUOZE 10,DIVI
SQUOZE 10,DIVM
SQUOZE 10,DIVB

SQUOZE 10,ASH
SQUOZE 10,ROT
SQUOZE 10,LSH
SQUOZE 10,JFFO	;PDP10 INSTRUCTION
SQUOZE 10,ASHC
SQUOZE 10,ROTC
SQUOZE 10,LSHC
SQUOZE 10,CIRC	;AI PDP10 INST.  CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY

SQUOZE 10,EXCH
SQUOZE 10,BLT
SQUOZE 10,AOBJP
SQUOZE 10,AOBJN
SQUOZE 10,JRST
SQUOZE 10,JFCL
SQUOZE 10,XCT
SQUOZE 10,MAP	;KI10 INSTRUCTION

SQUOZE 10,PUSHJ
SQUOZE 10,PUSH
SQUOZE 10,POP
SQUOZE 10,POPJ
SQUOZE 10,JSR
SQUOZE 10,JSP
SQUOZE 10,JSA
SQUOZE 10,JRA

SQUOZE 10,ADD
SQUOZE 10,ADDI
SQUOZE 10,ADDM
SQUOZE 10,ADDB
SQUOZE 10,SUB
SQUOZE 10,SUBI
SQUOZE 10,SUBM
SQUOZE 10,SUBB
; 300-377 (CAI - SOSG)

SQUOZE 10,CAI
SQUOZE 10,CAIL
SQUOZE 10,CAIE
SQUOZE 10,CAILE
SQUOZE 10,CAIA
SQUOZE 10,CAIGE
SQUOZE 10,CAIN
SQUOZE 10,CAIG
SQUOZE 10,CAM
SQUOZE 10,CAML
SQUOZE 10,CAME
SQUOZE 10,CAMLE
SQUOZE 10,CAMA
SQUOZE 10,CAMGE
SQUOZE 10,CAMN
SQUOZE 10,CAMG

SQUOZE 10,JUMP
SQUOZE 10,JUMPL
SQUOZE 10,JUMPE
SQUOZE 10,JUMPLE
SQUOZE 10,JUMPA
SQUOZE 10,JUMPGE
SQUOZE 10,JUMPN
SQUOZE 10,JUMPG
SQUOZE 10,SKIP
SQUOZE 10,SKIPL
SQUOZE 10,SKIPE
SQUOZE 10,SKIPLE
SQUOZE 10,SKIPA
SQUOZE 10,SKIPGE
SQUOZE 10,SKIPN
SQUOZE 10,SKIPG

SQUOZE 10,AOJ
SQUOZE 10,AOJL
SQUOZE 10,AOJE
SQUOZE 10,AOJLE
SQUOZE 10,AOJA
SQUOZE 10,AOJGE
SQUOZE 10,AOJN
SQUOZE 10,AOJG
SQUOZE 10,AOS
SQUOZE 10,AOSL
SQUOZE 10,AOSE
SQUOZE 10,AOSLE
SQUOZE 10,AOSA
SQUOZE 10,AOSGE
SQUOZE 10,AOSN
SQUOZE 10,AOSG
SQUOZE 10,SOJ
SQUOZE 10,SOJL
SQUOZE 10,SOJE
SQUOZE 10,SOJLE
SQUOZE 10,SOJA
SQUOZE 10,SOJGE
SQUOZE 10,SOJN
SQUOZE 10,SOJG
SQUOZE 10,SOS
SQUOZE 10,SOSL
SQUOZE 10,SOSE
SQUOZE 10,SOSLE
SQUOZE 10,SOSA
SQUOZE 10,SOSGE
SQUOZE 10,SOSN
SQUOZE 10,SOSG
; 400-477 (SETZ - SETOB)

SQUOZE 10,SETZ
SQUOZE 10,SETZI
SQUOZE 10,SETZM
SQUOZE 10,SETZB
SQUOZE 10,AND
SQUOZE 10,ANDI
SQUOZE 10,ANDM
SQUOZE 10,ANDB
SQUOZE 10,ANDCA
SQUOZE 10,ANDCAI
SQUOZE 10,ANDCAM
SQUOZE 10,ANDCAB
SQUOZE 10,SETM
SQUOZE 10,SETMI
SQUOZE 10,SETMM
SQUOZE 10,SETMB
SQUOZE 10,ANDCM
SQUOZE 10,ANDCMI
SQUOZE 10,ANDCMM
SQUOZE 10,ANDCMB
SQUOZE 10,SETA
SQUOZE 10,SETAI
SQUOZE 10,SETAM
SQUOZE 10,SETAB
SQUOZE 10,XOR
SQUOZE 10,XORI
SQUOZE 10,XORM
SQUOZE 10,XORB
SQUOZE 10,IOR
SQUOZE 10,IORI
SQUOZE 10,IORM
SQUOZE 10,IORB
SQUOZE 10,ANDCB
SQUOZE 10,ANDCBI
SQUOZE 10,ANDCBM
SQUOZE 10,ANDCBB
SQUOZE 10,EQV
SQUOZE 10,EQVI
SQUOZE 10,EQVM
SQUOZE 10,EQVB
SQUOZE 10,SETCA
SQUOZE 10,SETCAI
SQUOZE 10,SETCAM
SQUOZE 10,SETCAB
SQUOZE 10,ORCA
SQUOZE 10,ORCAI
SQUOZE 10,ORCAM
SQUOZE 10,ORCAB
SQUOZE 10,SETCM
SQUOZE 10,SETCMI
SQUOZE 10,SETCMM
SQUOZE 10,SETCMB
SQUOZE 10,ORCM
SQUOZE 10,ORCMI
SQUOZE 10,ORCMM
SQUOZE 10,ORCMB
SQUOZE 10,ORCB
SQUOZE 10,ORCBI
SQUOZE 10,ORCBM
SQUOZE 10,ORCBB
SQUOZE 10,SETO
SQUOZE 10,SETOI
SQUOZE 10,SETOM
SQUOZE 10,SETOB
; 500-577 (HLL - HLRES)

SQUOZE 10,HLL
SQUOZE 10,HLLI
SQUOZE 10,HLLM
SQUOZE 10,HLLS
SQUOZE 10,HRL
SQUOZE 10,HRLI
SQUOZE 10,HRLM
SQUOZE 10,HRLS
SQUOZE 10,HLLZ
SQUOZE 10,HLLZI
SQUOZE 10,HLLZM
SQUOZE 10,HLLZS
SQUOZE 10,HRLZ
SQUOZE 10,HRLZI
SQUOZE 10,HRLZM
SQUOZE 10,HRLZS
SQUOZE 10,HLLO
SQUOZE 10,HLLOI
SQUOZE 10,HLLOM
SQUOZE 10,HLLOS
SQUOZE 10,HRLO
SQUOZE 10,HRLOI
SQUOZE 10,HRLOM
SQUOZE 10,HRLOS
SQUOZE 10,HLLE
SQUOZE 10,HLLEI
SQUOZE 10,HLLEM
SQUOZE 10,HLLES
SQUOZE 10,HRLE
SQUOZE 10,HRLEI
SQUOZE 10,HRLEM
SQUOZE 10,HRLES
SQUOZE 10,HRR
SQUOZE 10,HRRI
SQUOZE 10,HRRM
SQUOZE 10,HRRS
SQUOZE 10,HLR
SQUOZE 10,HLRI
SQUOZE 10,HLRM
SQUOZE 10,HLRS
SQUOZE 10,HRRZ
SQUOZE 10,HRRZI
SQUOZE 10,HRRZM
SQUOZE 10,HRRZS
SQUOZE 10,HLRZ
SQUOZE 10,HLRZI
SQUOZE 10,HLRZM
SQUOZE 10,HLRZS
SQUOZE 10,HRRO
SQUOZE 10,HRROI
SQUOZE 10,HRROM
SQUOZE 10,HRROS
SQUOZE 10,HLRO
SQUOZE 10,HLROI
SQUOZE 10,HLROM
SQUOZE 10,HLROS
SQUOZE 10,HRRE
SQUOZE 10,HRREI
SQUOZE 10,HRREM
SQUOZE 10,HRRES
SQUOZE 10,HLRE
SQUOZE 10,HLREI
SQUOZE 10,HLREM
SQUOZE 10,HLRES
; 600-677 (TRN - TSON)

SQUOZE 10,TRN
SQUOZE 10,TLN
SQUOZE 10,TRNE
SQUOZE 10,TLNE
SQUOZE 10,TRNA
SQUOZE 10,TLNA
SQUOZE 10,TRNN
SQUOZE 10,TLNN
SQUOZE 10,TDN
SQUOZE 10,TSN
SQUOZE 10,TDNE
SQUOZE 10,TSNE
SQUOZE 10,TDNA
SQUOZE 10,TSNA
SQUOZE 10,TDNN
SQUOZE 10,TSNN
SQUOZE 10,TRZ
SQUOZE 10,TLZ
SQUOZE 10,TRZE
SQUOZE 10,TLZE
SQUOZE 10,TRZA
SQUOZE 10,TLZA
SQUOZE 10,TRZN
SQUOZE 10,TLZN
SQUOZE 10,TDZ
SQUOZE 10,TSZ
SQUOZE 10,TDZE
SQUOZE 10,TSZE
SQUOZE 10,TDZA
SQUOZE 10,TSZA
SQUOZE 10,TDZN
SQUOZE 10,TSZN
SQUOZE 10,TRC
SQUOZE 10,TLC
SQUOZE 10,TRCE
SQUOZE 10,TLCE
SQUOZE 10,TRCA
SQUOZE 10,TLCA
SQUOZE 10,TRCN
SQUOZE 10,TLCN
SQUOZE 10,TDC
SQUOZE 10,TSC
SQUOZE 10,TDCE
SQUOZE 10,TSCE
SQUOZE 10,TDCA
SQUOZE 10,TSCA
SQUOZE 10,TDCN
SQUOZE 10,TSCN
SQUOZE 10,TRO
SQUOZE 10,TLO
SQUOZE 10,TROE
SQUOZE 10,TLOE
SQUOZE 10,TROA
SQUOZE 10,TLOA
SQUOZE 10,TRON
SQUOZE 10,TLON
SQUOZE 10,TDO
SQUOZE 10,TSO
SQUOZE 10,TDOE
SQUOZE 10,TSOE
SQUOZE 10,TDOA
SQUOZE 10,TSOA
SQUOZE 10,TDON
SQUOZE 10,TSON
EISYM1:

; I/O INSTRUCTIONS

SQUOZE 4,BLKI
BLKI IOINST
SQUOZE 4,DATAI
DATAI IOINST
SQUOZE 4,BLKO
BLKO IOINST
SQUOZE 4,DATAO
DATAO IOINST
SQUOZE 4,CONO
CONO IOINST
SQUOZE 4,CONI
CONI IOINST
SQUOZE 4,CONSZ
CONSZ IOINST
SQUOZE 4,CONSO
CONSO IOINST

;EXTEND MNEMONICS

SQUOZE 10,CMPSL
001000,,
SQUOZE 10,CMPSE
002000,,
SQUOZE 10,CMPSLE
003000,,
SQUOZE 10,EDIT
004000,,
SQUOZE 10,CMPSGE
005000,,
SQUOZE 10,CMPSN
006000,,
SQUOZE 10,CMPSG
007000,,
SQUOZE 10,CVTDBO
010000,,
SQUOZE 10,CVTDBT
011000,,
SQUOZE 10,CVTBDO
012000,,
SQUOZE 10,CBTBDT
013000,,
SQUOZE 10,MOVSO
014000,,
SQUOZE 10,MOVST
015000,,
SQUOZE 10,MOVSLJ
016000,,
SQUOZE 10,MOVSRJ
017000,,
SQUOZE 10,XBLT
020000,,
;OLD PROGRAMS USE THESE NAMES

SQUOZE 10,CLEAR
SETZ
SQUOZE 10,CLEARI
SETZI
SQUOZE 10,CLEARM
SETZM
SQUOZE 10,CLEARB
SETZB

;RANDOM ALIAS NAMES

SQUOZE 10,ADJBP		;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT
IBP
SQUOZE 10,JFOV		;PDP10 INSTRUCTION (PC CHANGE ON PDP6)
JFCL 1,
SQUOZE 10,JCRY1
JFCL 2,
SQUOZE 10,JCRY0
JFCL 4,
SQUOZE 10,JCRY
JFCL 6,
SQUOZE 10,JOV
JFCL 10,
SQUOZE 10,PORTAL	;KI10 INSTRUCTION
JRST 1,
SQUOZE 10,JRSTF
JRST 2,
SQUOZE 10,HALT
JRST 4,
SQUOZE 10,XJRSTF	;KL10 INSTRUCTION
JRST 5,
SQUOZE 10,XJEN		;KL10 INSTRUCTION
JRST 6,
SQUOZE 10,XPCW		;KL10 INSTRUCTION
JRST 7,
SQUOZE 10,JEN
JRST 12,
SQUOZE 10,SFM		;KL10 INSTRUCTION
JRST 14,
SQUOZE 10,XMOVEI	;KL10 INSTRUCTION
SETMI
SQUOZE 10,XHLLI		;KL10 INSTRUCTION
HLLI

;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES

IRPS INST,,FAD FSB FMP FDV
 SQUOZE 10,INST!RL
 INST!RI
TERMIN
;; redefines DEFSYM so as to make entry into initial symbol table

DEFINE DEFSYM X/
 IRPS Z,,[X]
  SQUOZE 8.,Z
  Z
  .ISTOP
 TERMIN
TERMIN

IFN DECSW,[
IFE CVTSW,[
.DECDF DEFSYM

IFN DECBSW,.INSRT DECBTS
];IFE CVTSW
IFN CVTSW,[
.INSRT DECDFS
];IFN CVTSW
] ;IFN DECSW

IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION
IFE CVTSW,[
.TNXJS DEFSYM
.INSRT TWXBTS
];IFE CVTSW
IFN CVTSW,[
.INSRT TNXDFS
];IFN CVTSW
] ;IFN TNXSW
SQUOZE 10,.OSMID	; Crock here - in TNX version, SITINI sets value at
OSMID:	OSMIDAS		; runtime before syms spread.
SQUOZE 4,.SITE
A.SITE
SQUOZE 4,RIM10
ARIM10,,SRIM
SQUOZE 4,SBLK
SBLKS,,SRIM
SQUOZE 4,RIM
ARIM,,SRIM
SQUOZE 4,SQUOZE
ASQOZ
SQUOZE 4,.RSQZ
-1,,ASQOZ
SQUOZE 4,XWD
AXWORD
SQUOZE 4,CONSTA
CNSTNT
SQUOZE 4,ASCIC
EOFCH,,AASCIZ
SQUOZE 4,RADIX
ARDIX

SQUOZE 4,END
AEND
SQUOZE 4,TITLE
ATITLE
SQUOZE 4,.BEGIN
A.BEGIN
SQUOZE 4,.END
A.END
SQUOZE 4,VARIAB
AVARIAB
SQUOZE 4,SIXBIT
ASIXBIT
SQUOZE 4,ASCII
AASCII
SQUOZE 4,ASCIZ
AASCIZ
SQUOZE 4,.ASCII
A.ASCII
SQUOZE 4,.ASCVL
A.ASCV
SQUOZE 4,BLOCK
ABLOCK
SQUOZE 4,LOC
ALOC
SQUOZE 4,OFFSET
AOFFSET
SQUOZE 4,.SBLK
SIMBLK
SQUOZE 4,RELOCA
ARELOCA
SQUOZE 4,1PASS
A1PASS
SQUOZE 4,.DECSA
A.DECSA
SQUOZE 4,.DECRE
A.DECRE
SQUOZE 4,.DECTX
A.DCTX
SQUOZE 4,.DECTW
A.DECTW
SQUOZE 4,NOSYMS
ANOSYMS
SQUOZE 4,EXPUNGE
AEXPUNGE
SQUOZE 4,EQUALS
AEQUALS
SQUOZE 4,NULL
ANULL
SQUOZE 4,SUBTTL
ANULL
SQUOZE 4,WORD
AWORD
SQUOZE 4,.SYMTAB
A.SYMTAB
SQUOZE 4,.SEE
A.SEE
SQUOZE 4,.AUXIL
MACCR
SQUOZE 4,.MRUNT
A.MRUNT
SQUOZE 4,.SYMCN
A.SYMC
SQUOZE 4,.TYPE
A.TYPE
SQUOZE 4,.FORMAT
A.FORMAT
SQUOZE 4,.OP
A.OP
SQUOZE 4,.AOP
A.AOP
SQUOZE 4,.RADIX
A.RADIX
SQUOZE 4,.FATAL
A.FATAL
SQUOZE 4,.BP
A.BP
SQUOZE 4,.BM
A.BM
SQUOZE 4,.LZ
A.LZ
SQUOZE 4,.TZ
A.TZ
SQUOZE 4,.DPB
A.DPB
SQUOZE 4,.LDB
A.LDB
SQUOZE 4,.IBP
A.IBP
SQUOZE 4,.1STWD
A.1STWD
SQUOZE 4,.NTHWD
A.NTHWD

IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN]
IFE 1&.IRPCN, SQUOZE 4,X
IFN 1&.IRPCN, X,,A.KILL
TERMIN

SQUOZE 4,.LSTON
A.LSTN
SQUOZE 4,.LSTOF
A.LSTF

IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS
.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT
.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG]
IFE 1&.IRPCN, SQUOZE 4,X
IFN 1&.IRPCN, X,,INTSYM
TERMIN
;CONDITIONALS (SEE ALSO IFSE, IFSN)

SQUOZE 4,IFG
JUMPG A,COND
SQUOZE 4,IFGE
JUMPGE A,COND
SQUOZE 4,IFE
JUMPE A,COND
SQUOZE 4,IFLE
JUMPLE A,COND
SQUOZE 4,IFL
JUMPL A,COND
SQUOZE 4,IFN
JUMPN A,COND
SQUOZE 4,.ELSE
SKIPE A.ELSE
SQUOZE 4,.ALSO
SKIPN A.ELSE

SQUOZE 4,IF1
TRNE FF,COND1
SQUOZE 4,IF2
TRNN FF,COND1
SQUOZE 4,IFDEF	;ASSEMBLE IF SYM DEFINED
JUMPG A,DEFCND
SQUOZE 4,IFNDEF	;ASSEMBLE IF SYM NOT DEFINED
JUMPE A,DEFCND
SQUOZE 4,IFB	;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS)
JUMPLE C,SBCND
SQUOZE 4,IFNB	;ASSEMBLE IF STRING NOT BLANK
JUMPG C,SBCND
SQUOZE 4,IFSQ	;ASSEMBLE IF STRING ARG IS ALL SQUOZE
JUMPLE B,SBCND
SQUOZE 4,IFNSQ	;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE.
JUMPG B,SBCND

SQUOZE 4,PRINTX
APRIN2,,APRINT
SQUOZE 4,PRINTC
APRIN3,,APRINT
SQUOZE 4,COMMEN
APRIN1,,APRINT
SQUOZE 4,.TYO
A.TYO
SQUOZE 4,.TYO6
A.TYO6
SQUOZE 4,.ERR
A.ERR

SQUOZE 4,.RELP
A.RELP
SQUOZE 4,.ABSP
A.ABSP
SQUOZE 4,.RL1
A.RL1
SQUOZE 4,.LIBRA
LLIB,,A.LIB
SQUOZE 4,.LENGTH
A.LENGTH
SQUOZE 4,.LIFS
LTCP,,A.LIB
SQUOZE 4,.ELDC
A.ELDC
IRPS A,,E N G LE GE L
SQUOZE 4,.LIF!A
JUMP!A A.LDCV
TERMIN
SQUOZE 4,.SLDR
A.SLDR
SQUOZE 4,.
GTVLP
SQUOZE 4,.LOP
A.LOP
SQUOZE 40,$.
0
SQUOZE 44,$R.
0
SQUOZE 40,$O.	;(OH) GLOBAL OFFSET
0
SQUOZE 40,$L.	;REAL LOCATION (WITHOUT OFFSET)
0
SQUOZE 40,.LVAL1
0
SQUOZE 40,.LVAL2
0
SQUOZE 4,.LNKOT
A.LNKOT
SQUOZE 4,.NSTGW
1,,STGWS
SQUOZE 4,.YSTGW
-1,,STGWS
SQUOZE 4,.LIBRQ
A.LIBRQ
SQUOZE 4,.GLOBAL
ILGLI,,A.GLOB
SQUOZE 4,.SCALAR
ILVAR,,A.GLOB
SQUOZE 4,.VECTOR
ILVAR\ILFLO,,A.GLOB

SQUOZE 4,.BYTC
NBYTS,,INTSYM
SQUOZE 4,.BYTE
A.BYTE
SQUOZE 4,.WALGN
A.WALGN

;CREF PSEUDO-OPS.
SQUOZE 4,.CRFON
A.CRFN		;START CREFFING.
SQUOZE 4,.CRFOFF
A.CRFFF	;STOP CREFFING.
SQUOZE 4,.CRFIL
CRFILE,,INTSYM

IFE CREFSW,[
	A.CRFN==ASSEM1	;THESE DO NOTHING IF CAN'T CREF.
	A.CRFFF==ASSEM1
]
IFN MACSW,[	;MACRO PROCESSOR PSEUDOS
;MACROS GET DEFINED AS
;SQUOZE 4, <MACRO NAME>
;<CHAR ADR>,, MACCL

SQUOZE 4,REPEAT
AREPEAT
SQUOZE 4,DEFINE
ADEFINE
SQUOZE 4,IRP
NIRPO,,AIRP
SQUOZE 4,IRPC
NIRPC,,AIRP
SQUOZE 4,IRPS
NIRPS,,AIRP
SQUOZE 4,IRPW
NIRPW,,AIRP
SQUOZE 4,IRPNC
NIRPN,,AIRP
SQUOZE 4,TERMIN
ATERMIN
SQUOZE 4,.QUOTE
A.QOTE
SQUOZE 4,.STOP
(400000)A.STOP
SQUOZE 4,.ISTOP
A.STOP
SQUOZE 4,.RPCNT
CRPTCT,,INTSYM
SQUOZE 4,.GSSET
A.GSSET
SQUOZE 4,.GSCNT
GENSM,,INTSYM
SQUOZE 4,.GO
A.GO
SQUOZE 4,.TAG
A.TAG
SQUOZE 4,.IRPCNT
CIRPCT,,INTSYM
IFN RCHASW,[SQUOZE 4,.TTYMAC
A.TTYM
]
SQUOZE 4,IFSE
SKIPN SCOND
SQUOZE 4,IFSN
SKIPE SCOND
]

IFN FASLP,[
SQUOZE 4,.FASL
A.FASL
SQUOZE 4,.ARRAY	;3 INDEX TO AFDMY1 TBL
AFATOM(3)
SQUOZE 4,.ATOM
AFATOM(AFDMAI)	;2 INDEX TO AFDMY1 TBL
AFDMAI==2	;INDEX OF ATOM IN AFDMY1 TBL
SQUOZE 4,.FUNCT
AFATOM(1)	;1   "   "    "     "
SQUOZE 4,.SPECI
AFATOM(0)	;0   "   "    "     "
SQUOZE 4,.SX
AFLIST(1)	;NORMAL LIST
SQUOZE 4,.SXEVA
AFLIST		;EVAL LIST AND THROW VALUE AWAY
SQUOZE 4,.SXE
AFLIST(2)	;EVAL LIST AND "RETURN" VALUE
SQUOZE 4,.ENTRY
AFENTY		;DECLARE LISP ENTRY POINT  (SUBR ETC)
]
IFN TS,[
SQUOZE 4,.FNAM1
RFNAM1,,INTSYM
SQUOZE 4,.FNAM2
RFNAM2,,INTSYM
SQUOZE 4,.FVERS
RFVERS,,INTSYM
SQUOZE 4,.INSRT
A.INSRT
SQUOZE 4,.INEOF
A.INEO
IRPS X,,I O
 IRPS Y,,1 2
  SQUOZE 4,.!X!FNM!Y
  X!FNM!Y,,INTSYM
TERMIN TERMIN
SQUOZE 4,.IFVRS
IFVRS,,INTSYM
SQUOZE 4,.TTYFLG
A.TTYFLG,,INTSYM
]
IFN .I.FSW,[
SQUOZE 4,.F
A.F
SQUOZE 4,.I
A.I
]
IFN ITSSW,[
IRPS X,,UAI UAO BAI BAO UII UIO BII BIO
SQUOZE 10,.!X
.IRPCN
TERMIN

IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+
	SQUOZE 10,..R!X
	.IRPCN+1
IFSN Y,+,[
	SQUOZE 10,..S!X
	400000+.IRPCN+1
] TERMIN
]

EISYMT:	PRINTA \.-MACTBA-1, words initialization coding.
	VARIAB
IFN .-EISYMT,.ERR Non-empty variables area

IFN DECSW,[
 IFGE .-MACTBA-MACL,[
IFN MACL,  PRINTA [MACL too small, set to ]\.-MACTBA
  MACL==.-MACTBA
]]

IFN ITSSW\TNXSW,[
IFGE .+2400-MACTBA-MACL,.ERR MACL too small
	LOC <.+1777>&-2000
MXICLR==./2000	;FIRST PAGE ABOVE INITIALIZING CODING
	LOC <MACTBA+MACL+1777>&-2000
MXIMAC==./2000	;FIRST PAGE ABOVE INITIAL MACTBA
MAXMAC==<CONMAX+CONMAX/4+CONMAX/12+1+MXMACL+SYMMAX*MAXWPS+ST+1777>/2000
	;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE.
IFLE MINPUR-MAXMAC,.ERR Pure too low.
PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC
]

IFN TS,END BEG
END