perm filename FAIL.FAI[X,AIL] blob sn#058531 filedate 1973-08-18 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00161 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00013 00002	TITLE FAIL -- NEW STUFF
C00014 00003	AC'S, PDL'S, AND INITIAL CONSTANTS
C00021 00004	DEFINITION OF FLAGS   FLAGS  FLAGS
C00026 00005	BEGIN INIT ↔	SUBTTL OPCODE TABLE AND DEVICE INITIALIZATION
C00030 00006	ITS,<
C00034 00007		BEGIN INITIT
C00036 00008	↑INITL:	0
C00040 00009	ERR3:	MOVEI 6,[ASCIZ /INPUT SYNTAX ERROR/]
C00042 00010	↑SWITCH:0
C00045 00011	ZER:
C00047 00012		JRST FAT
C00051 00013	BEGIN OPTBL
C00058 00014	ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM
C00063 00015	BEGIN RPG ↔	SUBTTL INITIALIZATION OF PROGRAM
C00067 00016	STRT:
C00074 00017	ITS,<
C00078 00018	OUT:	0
C00079 00019	NOFSL:	JSR HERE WHEN OUT OF FREE STORAGE
C00084 00020	CHARACTER TABLE (FOR SCANNER)
C00088 00021	BEGIN SCAN ↔ SUBTTL SCANNER AND FRIENDS
C00090 00022	NUMS:	MOVEI N,-20(B)	PUT VALUE IN N
C00091 00023	↑SPCSKP:0
C00093 00024	DEFINE EMPS  (A)
C00094 00025	↑RTBFND:HRRI B,TP2F!RBCF
C00096 00026	LNUM:	JSR SLNUM
C00098 00027	DEFINE DHAN!(A)
C00099 00028	DEFINE   QUOT  7 (M)
C00101 00029	EQLS:	PUSH P,SRAD	SAVE CURRENT RADIX
C00105 00030	DNOTB:	JRST DNDH	DELETE
C00107 00031	BSH:	PUSHJ P,SCAN1	GET NUM
C00108 00032	LVMAC:	POP M,C		GET OLD MTBPNT
C00111 00033	NTST:	CAMGE B,-3(M)	DONE?
C00113 00034	↑SCAN1:	TLZE SFL	AHEAD?
C00115 00035	↑SCNTIL:TLZE SFL	AHEAD?
C00117 00036	↑SLURP:	PUSH P,BROKCT	ROUTINE TO EAT TEXT UP TO MATCHING BROKET
C00119 00037		JRST SLRPX
C00120 00038	SCANM	GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED
C00123 00039	↑Q%IF:	DPB N,[POINT 3,Q%T,8]DEPOSIT TEST
C00125 00040	↑QIF%D:	HRREM N,Q%SV	SAVE VALUE
C00127 00041		SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP
C00130 00042	PT2:	TLO SOPF	OPCODE FOUND
C00132 00043	PT69:	MOVEI PN,(TAC)	OOPS - WRONG AC
C00134 00044	VRHN:	TRNE B,UDARF
C00136 00045	SPCCHK:	TLNN NFLG
C00138 00046	TCALL:	ACALL	CALL ASSEMBL
C00142 00047	IRBO:	PUSH P,[0]
C00144 00048	BEGIN INP
C00148 00049	REVAL  -- EVALUATES EXPRESION INTO LIST-POLISH
C00151 00050	SPC2:	TLNE B,UNOF	UNARY OPERATOR?
C00154 00051	SPC1:	TLNE N,UNOF	UNARY OPERATOR?
C00156 00052	REDUC -- REDUCES THE LIST STRUCTURE POLISH
C00159 00053	ADOP:	AROP(ADD,,,ADD,12)
C00160 00054		SUBTTL MEVAL -- MAIN EVALUATER  -------
C00164 00055	NONSIM:	TLZ RELEF!REUNBF	CLEAR FLAGS
C00167 00056	↑DBLUP:	0
C00169 00057	PTQ1:	MOVE N,LSTLAB+2SET UP...
C00171 00058	LADF:	MOVEI O,	INITIALIZE COUNT
C00173 00059	LNMM:	PUSH P,O	SAVE COUNT
C00175 00060	SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO
C00177 00061	POLFIX:	MOVE T,MTBPNT	GET NEXT FREE AREA
C00179 00062	POLMOV:	SKIPL N,(FS)	OPERATOR OR OPERAND?
C00181 00063	BEGIN LABINS
C00184 00064	GFIX:	CALL WITH POINTER TO DEFINED SYMBOL IN PN AND
C00186 00065	FINCFX:	MOVE TAC,3(N)	GET PLACE
C00188 00066	↑SYMFXP:	XWD 11,4
C00190 00067	PFIX:	CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH
C00192 00068	PFULX:	MOVE T,4(N)	GET VALUE
C00194 00069	HALOUT:	HRROM L,HALP1	DEPOSIT RIGHT HALF OF POINTER
C00195 00070	↑POLOUT:	HRRZ L,MTBPNT	GET A FREE PLACE TO PUT FIXUP
C00197 00071	PPTT1:	MOVS FS,-1(FS)	GET ARG POINTER
C00200 00072	ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE
C00202 00073	EMP:	MOVEM N,WRD	DEPOSIT VALUE
C00204 00074	IXFLD:	TLNE UNDF	DEFINED?
C00206 00075	CCOM:	TLZ SFL		SKIP THE ,
C00208 00076	SPCL:	TLNE N,CRFG!LNFDCR?
C00209 00077		SUBTTL  PSEUDO-OP ROUTINES
C00212 00078	↑%ASCII:	TLZ SFL	CLEAR SCAN AHEAD
C00214 00079	↑%XWD:	TLO MLFT	LEFT HALF
C00216 00080	↑%LIT:	MOVE N,OPCNT+1
C00217 00081	↑%CON:	MOVE TAC,SRAD	SAVE CURRENT RADIX
C00219 00082	↑DPHAZ:	MOVE N,OPCNT+1
C00220 00083	↑%BYTE:	TRNN B,LFPF	( NEXT?
C00223 00084	↑%POINT:PUSH P,SRAD	SAVE CURRENT RADIX
C00225 00085	PAWT:	MOVSS N		SWAP HALVES
C00227 00086	↑%SIX:	TLZ SFL		SKIP CHR.
C00229 00087	↑%OPDEF:PUSHJ P,SCAN	GET SIXBIT
C00232 00088		DEFINE TIT $(TITCNT,Q,EXTRA,X1)
C00234 00089	↑%TITLE:MOVEI FS,
C00236 00090	↑%EXT:		PUSHJ P,SCANS	GET IDENT
C00238 00091	↑%NOSYM:SETZM SYMOUT
C00241 00092	↑%ENTRY:SKIPE CODEM	WAS CODE EMITTED?
C00244 00093	↑%ENDL:	PUSHJ P,BFRC	FOURCE OUT BINARY
C00246 00094	↑%RAD5:	TRO NOFXF
C00248 00095		SUBTTL  THIS HERE IS THE ASSEMBLER !!!!!!!!!
C00250 00096		SUBTTL UUO HANDLER AND OUTPUT ROUTINES
C00253 00097	 BINARY I/O HANDLING ROUTINES
C00255 00098	↑UBBOUT:MOVEM BC,UBBSV
C00257 00099	↑UFOUT:	MOVE TAC,@40	GET WORD
C00258 00100	↑FFX:	MOVEI TAC,(FC)	ADDRESS GETS FIXED UP TO -(FBLK+2)
C00260 00101	↑R5CON:	MOVEM FS,R5C1
C00261 00102		LISTING I/O STUFF
C00263 00103		PUSHJ P, OCON	CONVER
C00264 00104	↑VBLOUT:TRNN LDEV	LIST DEVICE?
C00266 00105	↑XPNDSW:0
C00268 00106	HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED
C00270 00107	LOUTDL:	SKIPLE LNCNT
C00273 00108	PTIM:	PUSH P,N
C00276 00109	FLST:	SKIPN ERCNT	ANY ERRORS?
C00280 00110	YESL:	SKIPN XPNDSW	NOT EXPANDING NOW?
C00282 00111	OTAB:	DPB TAC,NA
C00284 00112	ERSCN:	SKIPN ERCNT	NONE?
C00286 00113	RCQ:	MOVEI N,LABPRT
C00290 00114	↑CREFPT:0
C00294 00115		SUBTTL ..END, BEND, BEGIN..
C00296 00116	EINT:	MOVE FS,(PN)	GET SIXBIT
C00298 00117	LAST:	MOVEI FS,5(N)	SET UP POINTER
C00300 00118	EUND:	MOVE FS,(PN)	GET SIXBIT
C00303 00119	SPC:	TLNN N,CRFG	CR?
C00305 00120	BEGIN BEND
C00307 00121	LOOP1:	MOVEM NA,NASAV	SAVE
C00309 00122	DEL:	MOVE T,FSTPNT	GET FREE STRG PNTR.
C00312 00123	MERER:	ASCII /MULTIPLY DEFINED BY ↑  
C00314 00124	NFND:	MOVE T,2(PN)	GET FLAGS
C00316 00125	LITLAB:	TLNE N,DAF!GLOBF	BOY ARE THESE A PAIN
C00319 00126		MOVSI FS,20	RESTORE LOST FS
C00321 00127	PSYM:	TRNN LDEV	LIST DEV?
C00323 00128	SPT1:	ADDI PN,3	GO TO NEXT
C00325 00129	%BEG:	MOVE N,BLOCK	GET BLOCK...
C00326 00130	%BPT:	AOS %BCUR	INCREMENT
C00328 00131	LITOUT -- TO OUTPUT LITTERALS
C00330 00132	LOP1:	SKIPN 4(L)	ANYTHING HERE?
C00332 00133	POLHAN:	MOVE TAC,OPCNT	GET PLACE WHERE THIS IS...
C00334 00134	LPQ3:	SKIPN FS,1(L)
C00336 00135	↑VAR:	PUSHJ P,BFRC	FORCE OUT BIN
C00337 00136		SUBTTL ..ORG..  INCLUDES ORG, LOC, RELOC, USE, AND SET
C00340 00137	BEGIN USE
C00342 00138	↑NULN:	BLOCK 5
C00343 00139	↑%SET:	MOVE N,OPCNT+1
C00345 00140		SUBTTL MACROS, FOR, REPEAT, IF'S
C00347 00141	ALOP:	PUSHJ P,SCAN	GET ARG
C00350 00142	TXTIN:	CALL, TO READ TEXT INTO CORE, WITH PLACE IT IS TO GO
C00353 00143	ARGIN:	CALL TO READ IN ARGS.  USES NEXT FREE SPACES
C00355 00144	BKR2:	TRNN B,RTPF	)?
C00357 00145	GALL1:	PUSHJ P,SCAN1	GET CHR.
C00359 00146	SARGIN:	CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR
C00361 00147	ROUTINE TO RETURN MACRO TABLE SPACE
C00363 00148	MACRL:	JUMPL N,[MOVEM B,LGARB↔JRST .+3]	UPDATE LGARB, AVOID TEST IF AT END
C00365 00149	REPEAT CODE IS HERE ------------
C00368 00150	REP0:	MOVE TAC,TLBLK
C00370 00151	↑%FOR:	MOVE O,MTBPNT
C00372 00152	CONE:	TRNN N,ATF	@?
C00374 00153	NOTHRD:	MOVEI N,1
C00376 00154		HRRZI N,6(N)	INCREMENT
C00378 00155	NOTIM:	SUB P,[2(2)]	CLEAR STACK
C00380 00156	IFLOP:	MOVEI N,4(O)	GET...
C00382 00157	↑IFORSH:MOVE B,(M)	GET ARG POINTER
C00384 00158	FINIT:	POP P,N	RESTORE
C00386 00159	EFLOP:	PUSH P,FS	PUSH CONCAT
C00388 00160	↑EFORSH:MOVE B,(M)	GET ARG POINTER
C00390 00161
C00391 ENDMK
C⊗;
TITLE FAIL -- NEW STUFF
SUBTTL CONDITIONAL ASSEMBLY

XALL

;ITS ASSEMBLY ADDED 6/18/73 --PJ

IFNDEF ITSSW,<
↓ITSSW←←0
IFDEF .IOT,<↓ITSSW←←1>	;WE'RE AT MIT!
>

DEFINE SETSW(SWIT,VAL)<IFNDEF SWIT,<↓SWIT←←VAL>>

DEFINE ITS,<IFN ITSSW,>
DEFINE NOITS,<IFE ITSSW,>

DEFINE STINK,<IFN STNKSW,>
DEFINE NOSTINK,<IFE STNKSW,>

NOITS,<
SETSW(STANSW,0) ;by sail hackers for export
SETSW(EDITSW,0)	;TO TURN ON OPTION TO INVOKE AN EDITOR	  TVR - OCT '72
SETSW(STNKSW,0)	;ON FOR STINK STYLE OUTPUT
>;NOITS

ITS,<
SETSW(STANSW,0)
SETSW(EDITSW,0)
SETSW(STNKSW,1)
>;ITS
SUBTTL AC'S, PDL'S, AND INITIAL CONSTANTS

;AC'S
↓P←17
↓N←4
↓NA←N+1
↓PN←NA+1
↓B←10
↓C←B+1
↓L←12
↓T←1
↓FS←T+1
↓O←FS+1
↓CP←7
↓TAC←13
↓BC←14
↓FC←15
↓M←16

↓ERPLEN←←100	;NO. OF ERROR MESSAGES
LNPP←←=54	;LINES PER PAGE
chrpl:	=120	;CHaRacters Per Line - normally =120, but reduced
		;  by eight for CREFFing. - JHS
↓HASH←←=101;HASH SIZE
PLEN←←200
CPLEN←←200
RPGSW:	0
CPDL:	BLOCK CPLEN
PDL:	BLOCK PLEN
LSTLAB:	BLOCK 5
↓EFSLEN←←500;LENGTH OF AREA FOR POLISH
EFS:	BLOCK EFSLEN
MACRT:	BLOCK HASH
SYMTAB:	BLOCK HASH
	0
LITPNT:	BLOCK HASH
	-1
LOB:	BLOCK 3
ODB:	BLOCK 3
OPCDS:	BLOCK HASH

NOITS,<	0
IBUF1:	201,,IBUF2
	BLOCK 201+1
	0
IBUF2:	201,,IBUF3
	BLOCK 201+1
	0
IBUF3:	201,,IBUF4
	BLOCK 201+1
	0
IBUF4:	201,,IBUF5
	BLOCK 201+1
	0
IBUF5:	201,,IBUF1
	BLOCK 201+1
>;NOITS

ITS,<
SRCSTS:	BLOCK 10	;FOR CHANNEL STATUS
IBUF1:	BLOCK 201
>;ITS

IDB:	0
INPNT:	BLOCK 2

;MACRO TO MARK CURRENT PC AS LEGAL PLACE FOR MPV INTERRUPT
DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{↑↑%$L!X::}↑↑LEGNUM←←LEGNUM+1 }
↓LEGNUM←←0

	DEFINE DELHN
<	DPB B,LSTPNT
	ILDB C,INPNT
	XCT DELTAB(C)
	ILDB C,INPNT
	DPB C,LSTPNT>

	DEFINE GFST(A,B)
<	SKIPN A,B
	JSR NOFSL
>
	DEFINE SRC1 (A,B,C,D)
<	CAMN A,(B)
	JRST C
	SKIPN B,1(B)
	D
	CAMN A,(B)
	JRST C
	SKIPN B,1(B)
	D
	JRST .-10
>
	DEFINE SRC2 (A,B,C,D)
<	CAMN A,(B)
	JRST C
	HRRZ B,1(B)
	JUMPN B,.-3
	D
>
	DEFINE ACALL	;TO CALL ASSMBL
<	PUSHJ P,[POPJ CP,]>
	DEFINE RETN	;TO RETURN FROM ASSMBL
<	PUSHJ CP,[PUSH CP,[ASSMBL]
		POP CP,-2(CP)
		POPJ P,]>
	DEFINE EDEPO (AC,PNT,NUM)
<	MOVEI AC,177
LEG	IDPB AC,PNT
	MOVEI AC,NUM
LEG	IDPB AC,PNT
>
	DEFINE RVALUA	;TO CALL REVAL
<	PUSH P,[16]
	PUSHJ P,REVAL
	MOVE FS,(P)
	TRZE POLERF
	SETZM (FS)
>

ITS,<
OPDEF RELEASE [1B8]
OPDEF CLOSE [2B8]
OPDEF TTYUUO [3B8]
OPDEF PTYUUO [4B8]
OPDEF CALLI [5B8]
OPDEF INIT [6B8]
OPDEF LOOKUP [7B8]
OPDEF ENTER [10B8]
>;ITS
OPDEF ERROR[11B8]
OPDEF FATAL[12B8]
OPDEF FOUT[13B8]
OPDEF OUTP[14B8]
OPDEF POUT[15B8]
OPDEF TRAN[16B8]
OPDEF BBOUT[17B8]
OPDEF CREF6 [20B8]
OPDEF CREF66 [21B8]
OPDEF CREF7 [22B8]
ITS,<
OPDEF IN [23B8]
OPDEF OUT [24B8]
OPDEF INPUT [25B8]
OPDEF OUTPUT [26B8]
OPDEF INBUF [27B8]
OPDEF OUTBUF [30B8]
OPDEF STATO [31B8]
OPDEF STATZ [32B8]
OPDEF GETSTS [33B8]
OPDEF MTAPE [34B8]	;ILLUUO

OPDEF TTCALL [TTYUUO]
OPDEF INCHRW [TTYUUO 0,]
OPDEF OUTCHR [TTYUUO 1,]
OPDEF INCHRS [TTYUUO 2,]
OPDEF OUTSTR [TTYUUO 3,]
OPDEF INCHWL [TTYUUO 4,]
OPDEF INCHSL [TTYUUO 5,]
OPDEF GETLIN [TTYUUO 6,]
OPDEF SETLIN [TTYUUO 7,]
OPDEF RESCAN [TTYUUO 10,]
OPDEF CLRBFI [TTYUUO 11,]
OPDEF CLRBFO [TTYUUO 12,]
OPDEF INSKIP [TTYUUO 13,]
OPDEF INWAIT [TTYUUO 14,]

OPDEF APRENB [CALLI 16]

OPDEF PTWR1S [PTYUUO 7,]
OPDEF PTWRS9 [PTYUUO 12,]

COMMENT ⊗

OPDEF .OPEN [41000,,0]
OPDEF .IOT [40000,,0]
OPDEF .CORE [43300,,0]	;43 6,0
OPDEF .RESET [42000,,37]
OPDEF .SUSET [43540,,0]	;43 13,0
OPDEF .DISMI [43040,,0]	;43 1,0
OPDEF .VALUE [43200,,0]	;43 4,0
OPDEF .CLOSE [42000,,7]
OPDEF .RDATE [42000,,46]
OPDEF .RTIME [42000,,45]
OPDEF .RCHST [42000,,103]
OPDEF .IOPUSH [42000,,13]
OPDEF .IOPOP [42000,,14]
OPDEF .GETSYS [42000,,23]
OPDEF .EVAL [42000,,73]

↓.SMASK←400006
↓.SSNAM←400016
↓.RMEMT←←12
⊗

INTERNAL  USAVEA,USAVEB,USAVEC,USAVED,USAVEE,USAVEP
INTERNAL CTRL,META,CTLMTA,UUOCON,UUOXIT,ILLUUO,GBOUT1

EXTERNAL ITSGO,.TTYUUO,.PTYUUO,.INIT,.RELSE,.CLS,.LOOK,.ENTER,.CALLI
EXTERNAL .OUTBUF,.INBUF,.IN,.OUT,.INPUT,.OUTPUT,.STATO,.STATZ,.GETSTS
EXTERNAL STKTRN

CTRL←←0		;CHARACTERS WHICH SET META BITS
META←←0
CTLMTA←←0

USAVEA:	0	;UUO AC SAVE AREA
USAVEB:	0
USAVEC:	0
USAVED:	0
USAVEE:	0
USAVEP:	0

LSUUO:	0	;UUO AND PC FOR REENTRANT UUO'S
LSUUPC:	0
UUORET:	0
>;ITS

EXTERN JOBREL,JOBFF,JOBSA,JOBAPR,JOBTPC

↓SNB←←400000	;VERY HANDY NUMBER WHICH ONE GETS TIRED OF TYPING

LABLTP:	0
LABLTC:	0
LSTPNT:	0

IBUFR1←IBUF1
BLOCK:	1
DBLCK:	XWD DAF,-1

PCNT:	BLOCK 2		;LEAVE CONTIGUOUS & IN THIS ORDER
OPCNT:	BLOCK 2
WRD:	BLOCK 2
DPCNT:	BLOCK 2
	
SUBTTL DEFINITION OF FLAGS   FLAGS  FLAGS
;AC 0 IS FLAG REGISTER
;AC 0 FLAGS (LEFT HALF):

↓SFL←←200000	;SCANNER AHEAD ONE CHR.
↓IFLG←←100000	;SCAN SAW IDENT
↓NFLG←←40000	;SCAN SAW NUMBER
↓SCFL←←20000	;SCAN SAW SPC.CHR.
↓FLTFL←←10000	;SCAN -- FLOATING POINT NUMBER
↓ESNG←←4000	;EVAL SAW ONLY SINGLE THING
↓ESPF←←2000	;EVAL SAW ONLY SPC CHR
↓REUNBF	←←1000	;REVAL TEMP BIT -- UNBAL PARENS
↓OPFLG←←400	;AN OPCODE WAS SEEN
↓RELEF←←200	;REDUC -- RELOC ERROR
↓SOPF←←100	;SCANS -- OPCODE FOUND
↓PSOPF←←40	;SCANS -- PSEUDO-OP FOUND
↓MLFT←←20	;LEFT HALF FIXUPS SHOULD BE GENERATED
↓UNDF←←10	;MEVAL -- UNDEF.
↓PAWF←←4	;PARENS AROUND WHOLE -- MEVAL
↓AUNDF←←2	;ASSMBL -- PART IS UNDEFINED

;RIGHT HALF BITS:

↓NOFXF←←200000	;MEVAL -- DONT GENERATE FIXUPS
↓IOSW←←100000	;ASSMBL -- IO OPCODE
↓BDEV←←40000	;BIN DEVICE EXISTS
↓LDEV←←20000	;LIST DEVICE EXISTS
↓BLOSW←←10000	;TEMP BIT FOR LISTING SYNC
↓ADFL←←4000	;TEMP BIT USED BY ASSMBLE TO KEEP TRACK OF # OF ADRSES
↓FLFXF←←2000	;USED BY ASSMBL TO TELL MEVAL TO MAKE FULL WORD FIXUPS
↓TRBF←←1000	;ASSMBL -- TERMINATED BY ]
↓POLERF←←400	;POLISH ERROR
↓MACUNF←←200	;A MACRO WAS ENTERED (FOR UNDERLINING)
↓IOFLGS←←BDEV!LDEV!BLOSW	;FLAGS PERTAINING TO I/O

;THE FOLLOWING ARE BITS USED TO IDENTIFY CHARACTERS IN THE TABLE
;LEFT HALF BITS:
;SNB OR 400000 (SIGN) ;NUMBER OR LETTER
↓NMFLG←←200000	;NUMBER
↓SPFL←←100000	;SPACE(TAB)
↓SPCLF←←40000	;ANY SPC. CHR.
↓ARFL←←20000	;ARITH OPERATOR
↓ARMD←←10000	;ARITH OP MODIFIER (-,/,&,∧,UN -)
↓ARMD1←←4000	;ADDITIONAL MODIFIER
↓UNOF←←2000	;UNARY OP (- , ¬)
↓BFL←←1000	;B
↓EFL←←400	;E
↓DLETF←←200	;DELETE
↓CRFG←←100	;CR RET
↓LBRF←←40	;< OR [
↓RBRF←←20	;> OR ]
↓.FL←←10	;.
↓LNFD←←4	;LINE FEED
↓ENMF←←2	;INDICATES THAT ANY STRING STARTING WITH
		;THIS CHR. WILL BE SCANNED AS A NUMERICAL VALUE
↓SCRF←←1	;SPC.CHR. REQUIRING HANDLING BY SCANNER


;THE FOLLOWING ARE RIGHT HALF BITS

↓SHRPF←←400000	;#
↓BSLF←←200000	;\ (BACKSLASH) (→)
↓UDARF←←100000	;↑ OR ↓
↓LACF←←40000	;← OR :
↓COMF←←20000	;,
↓LFPF←←10000	;(
↓RTPF←←4000	;)
↓ATF←←2000	;@
↓RBCF←←1000
↓LBCF←←400
↓INF←←200	;⊂
↓EPSF←←100	;ε
↓TP2F←←2	;SUB-CLASS 2
↓TP1F←←1	;SUB-CLASS 1

;THE FOLLOWING ARE NUMBER (FLAG PART) BITS USED TO TELL
;	ABOUT NUMBERS AND SYMBOLS
;LEFT HALF:
↓DEFFL←←200000	;UNDEFINED IF ON
↓VARF←←100000	;"VAR"--(DEFINED WITH #)
↓INCF←←20000	;"IN CORE" VALUE (IN ASSEMBLER CORE)
↓UPARF←←10000	;UP ARROW (SYMBOL ONLY)
↓DAF←←4000	;DOWN ARROW(SYMBOL ONLY)
↓DBLF←←2000	;DOUBLE ← (←←) (SYMBOL ONLY)
↓GLOBF←←1000	;GLOBAL
↓INTF←←400	;INTERNAL
↓EXTF←←200	;EXTERNAL
↓UDSF←←100	;SYMBOL HAS BEEN DEFINED WITH AN UNDEFINED DEFINITION
↓SYMFIX←←40	;WE NEED A SYMBOL TABLE FIXUP FOR THIS SYMBOL
↓DBLUPF←←20	;THIS IS A DOUBLE UPARROWED SYMBOL (SYMBOL ONLY);;;;
↓COLONF←←10	;SYM WAS DEFINED WITH :
↓REFBIT←←4	;SYM HAS BEEN REFERENCED
ITS,<↓ANONF←←2>	;THIS SYMBOL ANONYMOUS TO LOADER

;RIGHT HALF HAS BITS FOR LEVELS AT WHICH DEFINED.

NOLIT
BEGIN INIT ↔	SUBTTL OPCODE TABLE AND DEVICE INITIALIZATION

NOITS,<

BEGIN NAME

↑NAME:	0
IFE STANSW,<SETZM 13>
NA1:	JSR IN
	CAIE 2,11
	CAIN 2," "
	JRST NA1
	TDZA 6,6	;HAVING IGNORED SPACES AND TABS-WE
LOOP1:	JSR IN	;GET A CHR
	CAIE 2,"."
	SKIPL 7,CTAB(2)	;CHECK FOR NUMBER OR LETTER
	JRST STOPN	;NO, ALL DONE
	TLNE 6,770000	;SEEN 6
	JRST LOOP1	;YES, IGNORE THIS
	LSH 6,6		;PUT IT IN
	ANDI 7,77	;SIXBIT FROM TABLE
	IORI 6,(7)
	MOVEI 2,40(7)	;MAKE SURE WE GET UPPER CASE VERSION OF CHAR
	IDPB 2,10	;SAVE CHR IN FILE NAME
IFE STANSW,<LSH 13,3
	IORI	13,-'0' (7)	;MAKE OCTAL PPN>
	JRST LOOP1
STOPN:	JUMPE 6,@NAME	;IF 0 RETURN
	SKIPA
STOPN2:	JSR IN
	CAIE 2," "
	CAIN 2,11
	JRST STOPN2
IFE STANSW,<MOVEM 13,SVNAM>
IFN STANSW,<MOVEM 6,SVNAM>;FOR PPNS
STOPN1:	TLNE 6,770000	;ELSE LEFT JUSTIFY
	JRST @NAME
	LSH 6,6
	JRST STOPN1

BEND NAME

BEGIN GETFIL

↑SVNAM:	0

↑GETFIL:0
	MOVE 10,[ASCII/ /]
	MOVEM 10,FILNM	;INITIALIZE FILE NAME
	SETZM FILNM+1
	MOVE 10,[POINT 7,FILNM,6]	;AND POINTER
	JSR NAME	;READ A NAME
	JUMPE 6,@GETFIL	;RETURN IF NONE THERE
	AOS GETFIL	;ELSE SET FOR SKIP RETURN
	CAIE 2,":"	;DEVICE NAME?
	JRST NODEV	;NO, TRY FILE NAME
	MOVE 1,6	;SET DEVICE
	MOVE 10,[ASCII / /]
	MOVEM 10,FILNM
	SETZM FILNM+1
	MOVE 10,[POINT 7,FILNM,6]
	JSR NAME	;GET ANOTHER NAME
	JUMPE 6,@GETFIL	;NONE, END
NODEV:	MOVE 5,6	;FILE NAME
	MOVEI 10,0	;NO MORE STUFF
	CAIN 2,"["	;POSSIBLE PPN
	JRST INPPN
	CAIE 2,"."	;ELSE MAYBE EXTENSION
	JRST @GETFIL	;NEITHER, PASS IT ON
	JSR NAME	;GET EXT
	JUMPE 6,ERR3	;LOSE IF NONE THERE
	HLLZ 3,6	;SET EXTENSION
	CAIE 2,"["	;CHECK FOR PPN	;2 CHANGED FROM C, REG 8-4-71
	JRST @GETFIL	;NO, RETURN
INPPN:	JSR NAME	;GET LEFT HALF
	JUMPE 6,ERR3	;NOT THERE
	HRLZ 4,SVNAM	;GET LEFT HALF
	CAIE 2,","	;SHOULD BE THERE
	JRST ERR3
	JSR NAME
	HRR 4,SVNAM		;FOR RIGHT HALF
	CAIE 2,"]"	;MUST END RIGHT
	JRST ERR3
	JSR IN
	JRST @GETFIL
	BEND GETFIL
>;NOITS
ITS,<
begin itsscn

;its style command line scanner

dev←1
fn1←5
fn2←3
sname←4
break←2
char←7
acptr←10
ac←6

getcc:	0			;get character for command line scanner
	skipe limbo
	skipa break,limbo
	jsr in
	setzm limbo
	jrst @getcc

name:	0			;break off word from input stream
na1:	jsr getcc
	caie break," "		;ignore leading spaces
	cain break,11		;tabs too
	jrst na1
	move acptr,[440600,,ac]
	tdza ac,ac
name1:	jsr getcc
	jsr brktst
	jrst nambrk		;found a break character
name2:	tlne acptr,770000	;ignore everything after 6 characters
	idpb char,acptr
	jrst name1

nambrk:	jumpn char,@name	;no trailing spaces
nambr1:	jsr getcc
	caie break," "		;ignore trailing spaces
	cain break,11
	jrst nambr1
	jsr brktst
	jrst @name		;a break character
	movem break,limbo		;space broke us
	movei break," "
	jrst @name

;converts break to sixbit and puts result in char
;↑Q quotes next character
;fails to skip on break character <non-sixbit space , : ; @ ← ( ) >

brktst:	0
	cain break,11
	movei break," "
	jsr sixtst
	jumpl char,[	caie break,21		;↑Q
			jrst @brktst		;non-sixbit breaks us
			jsr getcc
			jsr sixtst
			jumpl char,@brktst	;non-sixbit
			jrst brkt1]
	jumpe char,@brktst
	caie char,','
	cain char,'←'
	jrst @brktst
	caie char,':'
	cain char,';'
	jrst @brktst
	caie char,'('
	cain char,')'
	jrst @brktst
	caie char,'@'
	cain char,'/'
	jrst @brktst
brkt1:	aos brktst		;whew!
	jrst @brktst

;convert break to sixbit

sixtst:	0
	movni char,1
	cail break," "
	caile break,"←"
	jrst sixt1	;might be lower case
	movei char,-" "(break)
	jrst @sixtst
sixt1:	cail break,"a"
	caile break,"z"
	jrst @sixtst
	movei char,<"A"-"a"-" ">(break)
	jrst @sixtst

;this routine scans command line for file specification

↑getfil:0
	jsr name
	jumpe ac,@getfil
	aosa getfil
getf1:	jsr name		;break off first name
	jumpe ac,@getfil	;let initl worry about it
	cain break,":"
	jrst [	move dev,ac
		jrst getf1]
	cain break,";"
	jrst [	move sname,ac
		jrst getf1]

;this must be fn1 or fn2

	caie break," "
	jrst [	jumpn fn1,[	move fn2,ac
				jrst @getfil]

		move fn1,ac
		jrst @getfil]
	jumpn fn1,[	move fn2,ac
			jrst getf1]
	move fn1,ac
	jrst getf1

↑limbo:	0	;scanner read ahead character
		;scanner will not let us leave until non-zero

	bend itsscn
>;ITS
	BEGIN INITIT

↑INITIT:0
	DPB 6,[POINT 4,INIT1,12]
	SETZM FPPN	;IN CASE WE DO NOT STORE
	MOVEM 1,NAM	;SET NAME
	MOVEM 5,FNAM	;AND FILE NAME
	MOVEM 3,FEXT
NOITS,<
	CAIGE 6,5	;PPNS FOR SPECIAL ONES
	CAIN 6,2	;NO PPN UNLESS INPUT
>;NOITS
	MOVEM 4,FPPN
	MOVEM 4,SAVPPN	;SAVE PPN SO WE CAN INVOKE AN EDITOR	TVR - OCT '72

IFN STANSW,<
	MOVSI	1,400000	;REG. THESE 4 INSTRUCTIONS. 11-14-72
	CAIE	6,4		;SKIP IF IO CODE 4 - LIST FILE.
>
	MOVEI	1,0		;THIS IS NOT LST OR REL. 
	MOVEM	1,FEXT+1	;AT STANFORD, LIST FILE PROT=400, DUMP NEVER.

	MOVE 1,TBL1-2(6)	;GET BUFFER INFO
	MOVEM 1,INIT2
INIT1:	INIT @TBL3-2(6)
↑NAM:	0
INIT2:	0
	JRST ERR1
INIT3:	XCT TBL2-2(6)	;LOOKUP OR ENTER
	JRST [	CAIN 6,2
		SKIPE 3
		JRST ERR2
		ITS,<MOVSI 3,360000>	;GREATER THAN
		NOITS,<MOVSI 3,'FAI'>
		MOVEM 3,FEXT
		JRST RENT1]
	JRST @INITIT

TBL3:	OCT 1,14,1,16,1
TBL1:	IDB
	XWD ODB,0
	XWD LOB,0
	0
	CTLBUF
TBL2:	LOOKUP 2,FNAM
	ENTER 3,FNAM
	ENTER 4,FNAM
	LOOKUP 5,FNAM
	LOOKUP 6,FNAM
↑↑FNAM:	0
FEXT:	OCT 0,0
↑FPPN:	0
↑↑SAVPPN: 0
↑REENT:	MOVEM 1,INITIT
RENT1:	MOVEM 4,FPPN
	JRST INIT3
	BEND INITIT
↑RELFIL:BLOCK 5

↑INITL:	0
	MOVEI 1,
NOITS,<	HRLOI 3,'REL'	>
ITS,<
	SETZM LIMBO
	HRLZI 3,'REL'
>;ITS
	SETZB 5,4	;NO FILE NAME, PPN
	JSR GETFIL
	JRST NOBIN	;NO FILE THERE
	CAIN 2,"!"	;CHECK FOR LOAD COMMAND
	JRST DOLOD
	JUMPN 1,.+2
	MOVSI 1,'DSK'
	CAIN 2,"@"
	JRST DOAT
	MOVEM 5,RELFIL	;FILE NAME
NOITS,<	HLLZM 3,RELFIL+1	>
ITS,<	MOVEM 3,RELFIL+1	>
	MOVEM 1,RELFIL+4
	MOVEI 6,3	;DEVICE 4
	JSR INITIT
	OUTBUF 3,2
	TRO BDEV	;INDICATE WE HAVE ONE
	CAIE 2,"/"	;CHECK FOR SWITCHES
	CAIN 2,"("
	JSR SWITCH
NOBIN:	CAIN 2,"←"	;DOES HE WANT LISTING
	JRST NOLST	;APPEARANTLY NNT
	CAIE 2,","
	JRST ERR3	;HE IS A LOSER
	MOVSI 1,'DSK'
	MOVEI 5,0	;NO FILE
IFN STANSW,<MOVSI 3,'LST'>	;ASSUME LST
IFE STANSW,<MOVSI 3,'CRF'>	;FOR CREF.
	JSR GETFIL
	JRST NOL1	;MUST BE ,←
	MOVEI 6,4
	JSR INITIT
	TRO LDEV
	SETOM LISTSW
	OUTBUF 4,5
	CAIE 2,"/"
	CAIN 2,"("
	JSR SWITCH
NOL1:	CAIE 2,"←"
	JRST ERR3
NOLST:	MOVSI 1,'DSK'
NOLS2:	MOVEI 4,0	;NO PPN FOR THIS ONE
	SETZB 5,3	;NO FILE OR EXT
	JSR GETFIL
	JFCL		;MUST BE OF FORM ,
ITS,<
	JUMPE 5,[CAIE 2,12
		JRST .+1
		JRST NOLST]	;NULL FILE NAME, LF; MAYBE MORE ON NEXT LINE
>;ITS
	MOVEM 1,SAVDEV#	;SAVE FOR NEXT TIME
	MOVEI 6,2
	JSR INITIT
ITS,<
	MOVE 6,[2,,SRCSTS]
	.RCHST 6,
	MOVE 6,[440600,,SRCSTS+1]	;FILE NAME
	MOVE 5,[440700,,FILNM]
	MOVEI 3," "
	IDPB 3,5
	JSR NOLS3
	MOVEI 3," "
	IDPB 3,5			;SPACE BETWEEN FILE NAMES
	JSR NOLS3
	MOVEI 3,0
	IDPB 3,5	;NULL MARKS END OF FILE NAME
	OUTSTR FILNM
	OUTSTR [ASCIZ /
/]
>;ITS
	MOVEI 12,IBUFR1
	TLO 12,400000
	MOVEM 12,IDB	;SET UP BUFFER
	SETZM MOINSW#
	CAIE 2,"/"
	CAIN 2,"("
	JSR SWITCH
	CAIN 2,","
	SETOM MOINSW	;SAY HE HAS MORE TO COME
	AOS INITL
	MOVEM 17,INSV+17	;SAVE ACS
	MOVEI 17,INSV
	BLT 17,INSV+16
	MOVE 17,INSV+17
	JRST @INITL

ITS,<
NOLS3:	0
	MOVEI 4,6
	ILDB 3,6
	ADDI 3,40	;CONVERT TO ASCII
	IDPB 3,5
	SOJG 4,.-3
	JRST @NOLS3
>;ITS
ERR3:	MOVEI 6,[ASCIZ /INPUT SYNTAX ERROR/]
ERR:	JSR MESS
	MOVEI 4,0
	SKIPN RPGSW	;IF IN RPG MODE, SCAN TO END OF LINE
	JRST @INITL
ERRL:	CAIN 2,12
	JRST @INITL
	JSR IN
	JRST ERRL
ERR1:	MOVEI 6,[ASCIZ /DEVICE NOT AVAILABLE/]
	JSR MESS
	MOVE 6,NAM
ERRM:	MOVEI 7,0
	JSP 4,MS6
	MOVEI 4,0
	JRST @INITL
ERR2:	MOVEI 6,[ASCIZ /FILE NOT FOUND/]
	JSR MESS
	MOVE 6,FNAM
	JRST ERRM
BEGIN MS6
↑MS6:	MOVEM 4,MESS
	MOVE 1,[POINT 6,6]
	MOVE 2,[POINT 7,MBUF]
LOOP:	ILDB 7,1
	JUMPE 7,[IDPB 7,2
		MOVEI 6,MBUF
		JRST ENDM]
	ADDI 7,40
	IDPB 7,2
	JRST LOOP
BEND MS6
MESS:	0
ENDM:	CALLI 6,3	;DO A DDTOUT OF MESSAGE
	MOVEI 6,[ASCIZ /
/]
	CALLI 6,3
	JRST @MESS
MBUF:	BLOCK 2
	BEGIN SWITCH
↑SWITCH:0
	SETZM LPARF#	;NOT IN A ()
	CAIN 2,"("
	SETOM LPARF
	MOVEI 10,0	;NUMBER COUNT
SW1:	JSR IN		;GET A SWITCH
	CAIN 2,")"	;SEE IF END
	JRST RPAR
	CAIG 2,"9"
	CAIGE 2,"0"
	SKIPA
	JRST	[IMULI 10,=10	;ACCUMULATE NUUMBERS
		ADDI 10,-"0"(2)
		JRST SW1]
	CAIL 2,140
	SUBI 2,40
	MOVEI 7,0	;SEARCH
LOOP1:	SKIPN TBL1(7)
	JRST ERR4
	CAME 2,TBL1(7)
	AOJA 7,LOOP1
	SKIPG TBL2(7)	;PROHIBITED ON INPUT?
	JRST OK		;NO
	CAIN 6,2	;INPUT?
	JRST ERR5
OK:	XCT TBL3(7)
SW4:	MOVEI 10,0	;RESET NUMBER
	SKIPE LPARF	;IN ()
	JRST SW1	;YES
SW3:	MOVNI 7,3	;POINT BACK TO COMPARE
	ADDM 7,SWITCH
	JSR IN		;GET ANOTHER CHR
	JRST @SWITCH

RPAR:	SKIPE LPARF	;IN ()
	JRST SW3	;YES, EXIT
	JRST ERR3	;NO, LOSAGE
ERR4:	MOVEI 6,[ASCIZ /UNREC SWITCH/]
ERRF:	JSR MESS
	ROT 2,-7
	MOVEM 2,MBUF
	MOVEI 6,MBUF
	JRST ERR
ERR5:	MOVEI 6,[ASCIZ /ILLEGAL SWITCH POSITION/]
	JRST ERRF
	DEFINE TABLE
<FOR B IN (<Z,1,ZER>,<W,-1,WND>,<A,-1,ADV>,<B,-1,BSP>
	,<T,-1,LND>,<N,0,TTYERR>,<X,0,NOEXP>,<S,0,SYMOUT>
	,<I,0,XL1IG>,<P,1,SLSHP>,<L,0,NOLTSW>,<C,1,CREFST>
	,<Q,0,NOCNSW>,<U,0,UNDLNS>,<J,-1,ONCRF>,<K,-1,OFCRF>,<R,0,ERSTSW>
	,<F,-1,NOSTOP>)
<TRBL (B)
>
>
	DEFINE TRBL (A,B,C)
<"A"
>
TBL1:	TABLE
	0
	DEFINE TRBL(A,B,C)
<B
	>
TBL2:	TABLE
	0
	DEFINE TRBL(A,B,C)
<IFE B,<SETOM C>
IFN B,<JRST C>
>
TBL3:	TABLE
	0
ZER:
	DPB 6,[POINT 4,ZERA,12]
	DPB 6,[POINT 4,ZERA+1,12]
ZERA:	CALLI 13
	CLOSE
	JSP 1,REENT	;GO DO ENTER AGAIN
	JRST SW4
	DEFINE MAG (A,B)
<
	DPB 6,[POINT 4,.+1,12]
	MTAPE A
	SOJG 10,.-1	;DO IT A NUMBER OF TIMES
	IFN B,<XCT .-2
	DPB 6,[POINT 4,.+3,12]
	DPB 6,[POINT 4,.+3,12]
	DPB 6,[POINT 4,.+3,12]
	MTAPE 0
	STATO 1B24
	MTAPE 16>
	JRST SW4
>
WND:	MAG 1,0
ADV:	MAG 16,0
BSP:	MAG 17,1
LND:	MAG 10,0
CREFST:	SETOM CREFSW
	SETOM XCRFSW
	movei 10,=112	;choose acc#10 because SW4 clobbers it anyway
	movem 10,chrpl	;set chrpl so CREF listings won't overflow - JHS
	JRST SW4
ONCRF:	SKIPE CREFSW
	SETOM XCRFSW
	JRST SW4
OFCRF:	SETZM XCRFSW
	JRST SW4
SLSHP:	SKIPN 10
	MOVEI 10,1
	ADDM 10,PSWIT
	JRST SW4
NOSTOP:	SETZM ERSTSW
	JRST SW4
BEND SWITCH
INSV:	BLOCK 20
TSV:	BLOCK 20
↑EOF:	0
	SKIPN MOINSW	;MORE INPUT FIELDS?
	JRST FAT
	RELEAS 2,
	MOVEM 17,TSV+17
	MOVEI 17,TSV
	BLT 17,TSV+16
	MOVSI 17,INSV
	BLT 17,17
	MOVEI 17,EOFRT
	MOVEM 17,INITL
ITS,<	MOVE 17,TPDP	>	;I WANT A PUSH DOWN POINTER!!!!!!!!!!!!!!
	MOVE 1,SAVDEV
	JRST NOLS2
EOFRT:	JRST FAT
	MOVSI 17,TSV
	BLT 17,17
	JRST @EOF

ITS,<
TPDP:	-20,,TPDL-1
TPDL:	BLOCK 20
>;ITS

DOLOD:	JUMPN 1,.+2	;CHANGE DEFAULT TO SYS
	MOVSI 1,'SYS'
	TRNE 3,-1
	MOVSI 3,'DMP'	;AND DMP
	MOVEM 1,SWPR
	MOVEM 5,SWPR+1
	MOVEM 3,SWPR+2
IFN STANSW,<
	MOVEM 4,SWPR+4
	SETZM SWPR+3
	SKIPE RPGSW
	AOS SWPR+3	;SET FOR RPG CALL
	MOVEI 1,SWPR
	CALL 1,[SIXBIT /SWAP/]
	CALLI 12
>;IFN STANSW
IFE STANSW,<
	MOVEI	1,SWPR
	SKIPE	RPGSW
	HRLI	1,1	;START IN RPG MODE
	CALLI	1,35
	JRST	4,
>;IFE STANSW
SWPR:	BLOCK 5		;PUT PARAMS FOR SWAP HERE
IFE STANSW,<0>

↑ERRLK:	MOVEI 6,[ASCIZ /NOT ENOUGH CORE FOR LINKAGE/]
	CALLI 6,3
	CALLI 12

DOAT:	CALLI
NOITS,<	TLZ 3,(3)>	;NULL EXTENSION IF NONE GIVEN
	MOVEI 6,6	;DEVICE 6
	JSR INITIT	;GO GET IT SET UP
	JRST RPGS1
FAT:	SKIPN LITPG
	JRST NOTLIT
	MOVEI 3,LITMS
	PUSHJ P,FMES
NOTLIT:	MOVEI 3,0
	SKIPE TXTPG
	MOVEI 3,TXTMS
	SKIPE SARGPG
	MOVEI 3,SARMS
	SKIPE REP0PG
	MOVEI 3,REPMS
	SKIPE TXTIPG
	MOVEI 3,TXTIMS
	JUMPE 3,FAT1
	MOVE 1,SVLIN
	MOVEM 1,@-1(3)
	PUSHJ P,FMES
FAT1:	FATAL [ASCIZ /END OF FILE & NO END STMT/]

FMES:	MOVE 1,-2(3)
	MOVE 2,[ASCII /     /]
	SKIPN @-1(3)
	MOVEM 2,@-1(3)
	MOVE 4,-1(3)
	ADDI 4,2
	HRLI 4,(<POINT 7,0,6>)
	PUSHJ P,RNUM
	MOVEI 1,0
	IDPB 1,4
	ERROR (3)
	POPJ P,
RNUM:	IDIVI 1,=10
	HRLM 2,(P)
	SKIPE 1
	PUSHJ P,RNUM
	HLRZ 1,(P)
	ADDI 1,"0"
	IDPB 1,4
	POPJ P,

↑LITPG:	0
	LITLIN
LITMS:	ASCII /  LITERAL LINE /
↑LITLIN:0
	ASCII / PAGE /
	BLOCK 3
↑TXTPG:	0
	TXLIN
TXTMS:	ASCII /TEXT STATEMENT LINE /
TXLIN:	0
	ASCII / PAGE /
	BLOCK 3
↑SARGPG:	0
	SARLN
SARMS:	ASCII /REPEAT OR MACRO ARGUMENT LINE /
SARLN:	0
	ASCII / PAGE /
	BLOCK 3
↑REP0PG:0
	REPPG
REPMS:	ASCII /   REPEAT OR CONDITIONAL LINE /
REPPG:	0
	ASCII / PAGE /
	BLOCK 3
↑TXTIPG:0
	TXTIL
TXTIMS:	ASCII / FOR OR DEFINE LINE /
TXTIL:	0
	ASCII / PAGE /
	BLOCK 3
↑SVLIN:	0
BEND INIT
BEGIN OPTBL
GLOBAL HASH
XLIST
;XCREF
	FOR @$ I←0,HASH-1
<	IBQ$I←0
>
	DEFINE ENT $(A,B,C)
<	IBQ←'A'-'A'/HASH*HASH
	IFL IBQ,<IBQ←-IBQ>
	EN1(A,\IBQ,B,C)
>
	DEFINE EN1 $(A,B,C,D)
<	'A'
	IFIDN <>,<C>,<A IBQ$B>
	IFDIF <>,<D>,<XWD -1,IBQ$B>
	IFDIF <>,<C>,
	  <IFIDN <>,<D>,<C$IBQ$B>>
	IBQ$B←.-2
	IFDIF <>,<D>,<D
C>
	>
	DEFINE EMO(A)
<	FOR @$ B IN(A)
<	ENT(B)
	ENT(B$I)
	ENT(B$M)
	ENT(B$S)
>
>
	DEFINE ERG(A)
<FOR @$ Q IN (A)
<ENT(Q$B)
ENT(Q$I)
ENT(Q$M)
ENT(Q)
>
>
ERG(<SETM,SETA>)
ENT (PHASE,0,PHAZ)
ENT (DEPHAS,0,DPHAZ)
ENT(PZE, ,)
ENT(PAGE,0,%PAGE)
ENT(SUBTTL,0,%SUB)
ENT(RADIX,0,%RADIX)
ENT(TITLE,0,%TITLE)
ENT(END,9,%END)
ENT(PRGEND,0,%PRGEN)
	DEFINE IO(A)
<FOR B IN(A)
<ENT (B,B,%IO)
	>
>
IO(<CONSO,CONSZ,BLKI,BLKO,DATAI,DATAO,CONI,CONO>)
FOR @$ QRN IN (USE,SET,NOSYM,LIT,VAR,LIST,LALL)
<ENT(QRN,0,%$QRN)
>
ENT(XLIST,-1,%LIST)
ENT(XALL,-1,%LALL)
ENT(XLIST1,1,%LIST)
ENT(LOC,0,%ORG)
ENT(RELOC,-1,%ORG)
ENT(ORG,1,%ORG)
	DEFINE ENQ(A)
<	FOR B IN(A)
<ENT(B)
>
>
IFE STANSW<
ENQ(<CALL,INIT,ENTER,LOOKUP,USETO,USETI,UGETF,MTAPE,RELEAS>)
ENQ(<CLOSE,OUTBUF,INBUF,CALLI,STATO,STATZ,GETSTS,SETSTS>)
ENQ(<INPUT,OUTPUT>)
>	;IFE STANSW
ENT(INTERN,0,%INT)
ENT(OPDEF,0,%OPDEF)
ENT(ENTRY,0,%ENTRY)
ENT(LINK,0,%LINK)
ENT(LINKEN,0,%ENDL)
ENT(RADIX5,0,%RAD5)
ENT(CREF,0,%ONCRF)
ENT(XCREF,0,%OFCRF)
ENT(NOLIT,0,%NOLIT)
ENT(ARRAY,0,%ARAY)
ENT(INTEGE,0,%INTEG)
ENT(GLOBAL,0,%GLOB)
	DEFINE MAT $(B)
<ENQ(<B$N,B$NE,B$NN,B$NA,B$O,B$ON,B$OE,B$OA>)
ENQ(<B$Z,B$ZE,B$ZN,B$ZA,B$C,B$CN,B$CE,B$CA>)
>
MAT(TS)
FOR @$ C IN(FAD,FSB,FMP,FDV)
<ENQ(<C,C$L,C$M,C$B,C$R,C$RL,C$RM,C$RB>)
>
ENQ(<AOBJN,AOBJP,FSC,IBP,BLT,JFCL,XCT>)
ENT(TTCALL,51B8+)
IFN STANSW,<
ENT(DPYOUT,703B8+)
>
IFE STANSW<
ENT(OPEN,50B8+)
ENT(RENAME,55B8+)
ENT(INCHRW,<<TTCALL 0,>>)
ENT(OUTCHR,<<TTCALL 1,>>)
ENT(INCHRS,<<TTCALL 2,>>)
ENT(OUTSTR,<<TTCALL 3,>>)
ENT(INCHWL,<<TTCALL 4,>>)
ENT(INCHSL,<<TTCALL 5,>>)
ENT(GETLIN,<<TTCALL 6,>>)
ENT(SETLIN,<<TTCALL 7,>>)
ENT(RESCAN,<<TTCALL 10,>>)
ENT(CLRBFI,<<TTCALL 11,>>)
ENT(CLRBFO,<<TTCALL 12,>>)
ENT(INSKIP,<<TTCALL 13,>>)
ENT(IN,56B8+)
ENT(OUT,57B8+)
>	;IFE STANSW
ENT(CONS,257B8+)
ENT(JFFO,243B8+)
ENT(UFA,130B8+)
ENT(DFN,131B8+)
ENT(FADRI,145B8+)
ENT(FSBRI,155B8+)
ENT(FMPRI,165B8+)
ENT(FDVRI,175B8+)
ENT(FIX,247B8+)
ENT(JEN,<<JRST 12,>>)
ENT(HALT,<<JRST 4,>>)
ENT(JOV,<<JFCL 10,>>)
ENT(JCRY,<<JFCL 6,>>)
ENT(JCRY0,<<JFCL 4,>>)
ENT(JCRY1,<<JFCL 2,>>)
ENT(DEFINE,0,%DEF)
ENT(HISEG,0,%HISEG)
ENT(TWOSEG,0,%TWOSEG)
ENT(REPEAT,0,%REP)
ENT(FOR,0,%FOR)
ENT(POINT,0,%POINT)
ENT(BYTE,0,%BYTE)
ENT(OCT,10,%CON)
ENT(DEC,12,%CON)
ENQ(<JSP,JSA,JRA,ASH,ASHC,ROT,ROTC>)
ERG(<ANDCB,ORCM,ORCB,ORCA>)
MAT(TD)
DEFINE MAH $(A)
<EMO(<HRR$A,HRL$A,HLR$A,HLL$A>)
>
MAH(E)
MAH(O)
ERG(<AND,ANDCA,ANDCM,EQV,SETCA,SETCM,SETO,OR,IOR,XOR>)
ERG(<IMUL,MUL,DIV,IDIV>)
ENT(COMMEN,0,%COMM)
ENT(EXTERN,0,%EXT)
DEFINE JSK(A)
<FOR @$ Q IN(A)
<ENQ(<Q,Q$L,Q$LE,Q$G,Q$GE,Q$N,Q$E,Q$A>)
>
>
JSK(<AOJ,SOJ,AOS,SOS>)
ENT(JSR)
JSK(CAM)
MAH()
JSK(CAI)
ENQ(<LDB,DPB,ILDB,IDPB>)
EMO(<MOVS,MOVM,MOVN>)
ERG(SETZ)
ENT(BLOCK,0,%BLOCK)
ENT(EXCH)
MAH(Z)
ENT(BEGIN,0,%BEG)
ENT(BEND,0,%BEND)
JSK(SKIP)
ERG(SUB)
ENQ(<LSH,LSHC>)
ERG(ADD)
JSK(JUMP)
MAT(TR)
MAT(TL)
ENQ(<PUSH,POP,POPJ,PUSHJ>)
ENT(ASCII,0,%ASCII)
ENT(ASCIZ,1,%ASCII)
ENT(ASCID,-1,%ASCII)
ENT(SIXBIT,0,%SIX)
ENT(XWD,0,%XWD)
EMO(MOVE)
ENT(JRST)
↑OPCDS1:FOR @$ I←0,HASH-1
<IBQ$I
>
FOR @$I←0,HASH-1
<IBQ$I←0
>
DEFINE MENT (AR,BR,QR)
<'AR'
IBQ←'AR'-'AR'/HASH*HASH
IFL IBQ,<IBQ←-IBQ>
MENQ (\IBQ)
0
XWD -1,BR
QR
	>
DEFINE MENQ $(A)
<IBQ$A
IBQ$A←.-2
>
FOR ROM IN (<IFE,2>,<IFG,7>,<IFN,6>,<IFL,1>,<IFGE,5>,<IFLE,3>)
<MENT (ROM,Q%IF)
>
FOR FOO IN (<IFIDN,-1,Q%IFD>,<IFDIF,0,Q%IFD>,<IFDEF,-1,QIF%D>,<IFNDEF,0,QIF%D>,<IFAVL,-1,QIF%A>,<IFNAVL,0,QIF%A>)
	<MENT(FOO)
>
↑%IOWD:	'IOWD'
IBQ←'IOWD'-'IOWD'/HASH*HASH
MENQ (\IBQ)
0
2
.+1
%IOWD
ASCII/ XWD /
BYTE (7)"-","(",177,1,0,")",",",177,1,1,"-","1",40,177,3
FOR @! X IN(.,$.)
<	'X'
↑HASH!X←←'X'-'X'/HASH*HASH
MENQ \HASH!X
0
-2,,SCAN!X
SCNMPT
>
↑MACRT1: FOR @$ I←0,HASH-1
<IBQ$I
>
;CREF
LIST
BEND
;ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM
IFN STANSW<
CALLPT←←272
SYS←←400000

OPSET:	MOVEI T,37		;GET SIZE OF MEMORY
	PEEK T,
	CAIL T,377777		;NO MORE THAN 128K
	MOVEI T,377777
	ANDCMI T,1777
	MOVSI T,1(T)		;MAKE PR WORD (WITH UWP BIT)
	SETPR2 T,
	JRST OPSLZ2
	MOVE C,SYS+CALLPT
	LDB NA,[221100,,C]	;# DEC CALLIS
	MOVEM NA,UCLDLN#
	SUBI NA,400000
	MOVNM NA,SCLOFF#
	LDB N,[331100,,C]	;TOTAL # CALLIS
	CAIG N,300
	CAIG N,400000(NA)
	JRST OPSLUZ		;UNREASONABLE CRAP
	MOVN NA,N
	MOVSI T,(NA)		;MAKE AOBJN PNTR
	MOVE L,SYS(C)
	CAME L,['RESET ']
	JRST OPSLUZ		;TABLE LOOKS WRONG
	MOVE O,JOBFF
	SETZM OPCDS		;INITIALIZE THIS
	MOVE N,[OPCDS,,OPCDS+1]	;IT WILL KEEP TRACK OF THE ENDS OF THE HASH CHAINS
	BLT N,OPCDS+HASH-1	;AS THEY ARE NEEDED
	MOVEI L,10		;BIT FOR CALLI OPCODE ENTRIES
	HRLI C,T
	MOVEI B,40		;INCREMENT
	PUSHJ P,OPST1		;DEFINE CALLIS
	HRR C,@C		;GET MAJOR OPCODE TABLE ADR
	MOVSI T,-40		;# LOW UUOS
	MOVEI L,40000		;STARTING VAL
	MOVEI B,1000		;INC
	PUSHJ P,OPST1		;DEFINE LOW UUOS
	HLL T,SYS-1(C)		;GET # HIGH UUOS IN LH
	TLC T,-1
	ADDI T,SYS		;CARRY WILL MAKE 2'S COMP
	MOVEI L,700000		;NEW INIT VAL (PNTR & INC SAME AS BEFORE)
	PUSHJ P,OPST1		;DEFINE HIGH UUOS
	MOVEI B,40		;NOW SET UP INC FOR SECONDARY OPCODES
OPSLP1:	HRR C,SYS-1(C)		;GET NEXT TABLE LOC
	TRNN C,-1
	JRST OPSDON		;DONE IF ADR 0
	HLRZ L,SYS-1(C)		;ELSE GET BASE VAL & CNT
	LDB T,[50400,,L]	;GET CNT-1
	MOVNI T,1(T)
	MOVSI T,(T)		;MAKE AOBJN PNTR
	ANDI L,777000		;ISOLATE STARTING VAL
	PUSHJ P,OPST1		;DEFINE THIS SECONDARY SET
	JRST OPSLP1		;AND TRY FOR ANOTHER GRP

OPSDON:	MOVEM O,JOBFF		;UPDATE BOTH
	HRLM O,JOBSA		;COPIES OF JOBFF
OPSTX:	SETOM OPSOK		;DON'T NEED TO DO THIS AGAIN
	MOVEI T,
	CORE2 T,		;FLUSH PR2
	POPJ P,
	POPJ P,

OPST1:	TRNN C,600000
	TRNN C,-200
	JRST OPSLUZ		;BAD ADDRESS
	IORI T,SYS		;PUT OFFSET IN PNTR
OPSTL:	SKIPA N,@C
	LSH N,-6
	TRNN N,77		;RIGHT-JUSTIFY IF NECESSARY (SIGH)
	JUMPN N,.-2		;BUT AVOID LOOP ON 0
	JUMPE N,OPSNXT		;IGNORE 0'S
LEG	MOVEM N,(O)		;STORE NAME
	IDIVI N,HASH
	MOVM NA,NA
	SKIPE PN,OPCDS(NA)	;DO WE ALREADY KNOW THE END OF THIS CHAIN?
	JRST OPSTL2		;YES
	TROA PN,OPCDS1-1(NA)	;NO - FIND IT SO THESE CAN GO AT END
	MOVEI PN,(FS)		;WHERE THEY WON'T INTERFERE WITH
	HRRZ FS,1(PN)		;NORMAL OPCODES
	JUMPN FS,.-2
OPSTL2:	HRRM O,1(PN)		;LINK IN
LEG	MOVSM L,1(O)		;STORE VALUE
	MOVEM O,OPCDS(NA)	;THIS IS NOW END OF LIST
	ADDI O,2
OPSNXT:	ADDI L,(B)		;COUNT VALUE FIELD
	AOBJN T,OPSTL
	POPJ P,

OPSLUZ:	OUTSTR [ASCIZ /GARBAGEY DATA IN SYSTEM CALL TABLE/]
OPSLZ3:	OUTSTR [ASCIZ /, YOU LOSE!
/]
	EXIT

OPSLZ2:	OUTSTR [ASCIZ /SETPR2 TO GET CALLI NAMES FAILED/]
	JRST OPSLZ3

OPSEND←←.	;OPSOK THRU HERE THROWN AWAY AFTER FIRST TIME

OPSOK:	0
>
BEGIN RPG ↔	SUBTTL INITIALIZATION OF PROGRAM
↑SETRPG:
IFE STANSW,<
	MOVSI	1,(<SIXBIT /FAI/>)
	MOVEM	1,RPGNAM
	HRLI	1,-170
	HRR	1,JOBFF
	MOVEM	1,RPGNAM+1
	HRLI	1,700
	MOVEM	1,CTLBUF+1	;BYTE POINTER
	HRLI	1,2		;READ AND DELETE
	HRRI	1,RPGNAM
	CALLI	1,44		;TEMPCORE
	JRST	DSKRPG		;NOT IN SERVICE
	MOVEI	1,170*5
	MOVEM	1,CTLBUF+2
	SETOM	TMPCOR#
	MOVEI	1,200
	ADDM	1,JOBFF		;BUMP TO PAST BUFFER
	JRST	RPGS5
DSKRPG:
>;IFE STANSW
	MOVSI 1,'DSK'
	MOVEM 1,RPGDV
IFE STANSW,<MOVSI	1,'FAI'
	CALLI	2,30	;JOB NUMBER
	MOVEI	4,3
	IDIVI	2,=10
	IORI	1,20(3)
	ROT	1,-6
	SOJG	4,.-3	;FAKE A JOB NUMBER.
>
IFN STANSW,<
	MOVE 1,[SIXBIT /QQFAIL/]
>
	MOVEM 1,RPGNAM
IFE STANSW,<MOVSI 1,'TMP'>
IFN STANSW,<MOVSI 1,'RPG'>
	MOVEM 1,RPGNAM+1
	SETZM RPGNAM+3
	INIT 6,1
RPGDV:	0
	CTLBUF
	JRST STRT1	;SEE US LOSE
	LOOKUP 6,RPGNAM	;NOW SEE IF FILE IS THERE
	JRST STRT
	INIT 7,16	;GET RID OF INPUT FILE
	SIXBIT /DSK/
	0
	JRST STRT
	SETZM RPGNAM+3	;GET RID OF EXTRA JUNK
	HLLZS RPGNAM+1
	LOOKUP 7,RPGNAM
	JRST STRT
	RENAME 7,ZEROS
	JFCL
↑RPGS1:	INBUF	6,1
RPGS5:
ITS,<	SETOM RPGSW	>
	MOVE 1,JOBFF
	MOVEM 1,SVJFF	;SAVE FOR NEXT ASSEMBLY
	JRST RPGRS1
↑RPGRS:	LDB 2,CTLBUF+1	;SCAN TO END OF LINE
RPGRS2:	CAIN 2,12
	JRST RPGRS1
	JSR IN
	JRST RPGRS2
RPGRS1:
	MOVE 1,SVJFF
	MOVEM 1,JOBFF
	JRST RPGGO	;AND AWAY WE GO

↑RPGIN:	SOSG CTLBUF+2
	JRST	[IFE STANSW,<SKIPE TMPCOR
		  CALLI 12>
		 IN  6,0
		JRST .+1
		STATZ 6,20000	;EOF?
		CALLI 12
		MOVEI 1,[ASCIZ /ERROR READING COMMAND FILE/]
		CALLI 1,3
		CALLI 12]
	IBP CTLBUF+1
	MOVE 2,@CTLBUF+1
	TRNE 2,1
	JRST	[AOS CTLBUF+1
		MOVNI 2,5
		ADDM 2,CTLBUF+2
		JRST RPGIN]
	LDB 2,CTLBUF+1
	JUMPE 2,RPGIN
ITS,<
	CAIN 2,3
	CALLI 12	;↑C IS EOF
	CAIE 2,14	;IGNORE FORM FEEDS
>;ITS
	CAIN 2,15	;IGNORE CR'S
	JRST RPGIN
	JRST @IN
↑CTLBUF:BLOCK 3
RPGNAM:	BLOCK 4
SVJFF:	0
ZEROS:	REPEAT 4,<0>
BEND
STRT:
NOITS,<
	TDZA T,T
	MOVNI T,1
	MOVEM T,RPGSW
	MOVE P,[-PLEN,,PDL-1]
>;NOITS
ITS,<	JFCL
	MOVE P,[JSR UUO]
	MOVEM P,41
	MOVE P,[-PLEN,,PDL-1]
	SETZM RPGSW
	PUSHJ P,ITSGO
>;ITS
	PUSHJ P,CORINI	;SET UP MPV INTERRUPTS
IFN STANSW,<
	SKIPN OPSOK
	PUSHJ P,OPSET	;DEFINE SYSTEM OPCODES IF NOT DONE YET
>
	SKIPE RPGSW
	JRST SETRPG
NOITS,<	HLLZS 42>	;CLEAR OUT ERROR IF NOT IN RPG MODE
STRT1:	
	SKIPE RPGSW
	JRST RPGRS
	CALLI
RPGGO:	MOVE P,[-PLEN,,PDL-1]
	FOR A IN (NOEXP#,TTYERR#,SYMOUT#,XL1IG#,PSWIT#,<LISTSW#>
	,NOLTSW#,CREFSW#,XCRFSW#,INLINE#,NOCNSW#,UNDLNS#,<ERSTSW#>
	,PGNM,SPGNM,TTYPTR)
<	SETZM A
>
	MOVSI 1
	MOVEM CHRCNT#
	SETOM LNCNT	;SET THESE TWO CELLS TO FORCE HEADING
ITS,<	SETZM NEWFIL>
	AOS PGNM
	MOVEI
	SKIPN RPGSW
NOITS,<	JSR SOUT	>
ITS,<
	JRST [	MOVEI 1,[.FNAM1]
		PUSHJ P,FNMOUT
		OUTCHR ["."]
		MOVEI 1,[.FNAM2]
		PUSHJ P,FNMOUT
		JSR SOUT
		JRST .+1]
>;ITS
	JSR INITL		;DECODE COMMAND FILE, SET UP BUFFERS..
	JRST FEND1		;SOMETHING IS AMISS.
IFN STANSW,<	PUSHJ P,TVSKIP	;MAYBE SKIP DIRECTORY AT STANFORD
;>	PUSHJ P,INP		;READ INITIAL RECORD
STRT2:	SETZM SYMTAB
	MOVE 1,[XWD SYMTAB,SYMTAB+1]
	BLT 1,HASH-1+SYMTAB
	MOVE 1,[XWD OPCDS1,OPCDS]
	BLT 1,HASH-1+OPCDS
	MOVE 1,[XWD MACRT1,MACRT]
	BLT 1,HASH-1+MACRT
ITS,<	PUSHJ P,GETSYS	>	;GET SYSTEM SYMBOLS
	ANDI IOFLGS		;CLEAR ALL BUT I/O FLAGS
	FOR A IN (HICNT#,LOCNT#,%BCUR,POLPNT#,BRK#,SEG#,<RTFLST#>
	,SYMEM#,CODEM#,VARLST#,LGARB)
<	SETZM A
>
	SETOM XPNDSW
	SETOM INMCSW#
	SETOM TITLSW#
	MOVE FS,['.MAIN']
	MOVEM FS,BNAM		;SET INITIAL PROGRAM NAME
	MOVEM FS,LSTLAB+3
NOITS,<
	SKIPE RPGSW
	OUTSTR [ASCIZ /FAIL:  /]	;PRINT OUT IF IN RPG MODE.
>;NOITS
	MOVE 2,[XWD -ERPLEN,ERPD-1]
	MOVEM 2,ERPNT
	MOVE 2,[JSR UUO]
	MOVEM 2,41
	MOVE 1,PSWIT
	ADDI 1,1
	LSH 1,7		;FORM MACRO PDL LENGTH
	MOVE M,JOBFF
	MOVEI	2,=1024*5(M)	;SEE IF AT LEAST 5K AVAILABLE.
	CALLI	2,11		;GET THE CORE.  IF ANYONE NEEDS LESS THAN
	PUSHJ	P,COERR		;5 K, HE DESERVES OUR CONGRATULATIONS.
	ADDM 1,JOBFF
	SUBI M,1
	MOVNS 1
	HRL M,1
	HRRZ 2,JOBREL	;GET END OF CORE
	MOVEI 3,-1(2)
	HRRZ 5,JOBFF	;GET END OF PROGRAM
	SUB 3,5		;FORM LENGTH OF FREE AREA
	ASH 3,-1
	MOVEM 2,MTBLST#	;SET END OF FREE AREA
	MOVE 2,5
	ADD 2,3
	MOVEM 2,MTBPNT#	;FORM START OF FREE AREA
	IDIVI 3,5	;FORM COUNT
	MOVEM 5,FSTPNT#	;START OF FREE STRG
	ADDI 5,5	;INCREMENT TO NEXT
	MOVEM 5,-4(5)	;STORE LINK
	SOJG 3,.-2	;LOOP
	SETZM -4(5)	;TERMINATE
	SETZM LOCNT
	MOVEI CP,400000
	MOVEM CP,HICNT
	MOVEM CP,BRK
	SETZM SEG
	SETZM PCNT
	SETOM PCNT+1
	MOVNS PCNT+1	;INIT LOCATION COUNTERS
	SETZM OPCNT
	SETOM OPCNT+1
	MOVNS OPCNT+1
	SETZM DPCNT
	SETOM DPCNT+1
	MOVNS DPCNT+1
	MOVEI CP,ASSMBL	;GET ADDRESS
	MOVEM CP,CPDL	;INITIALIZE THE SPECIAL...
	MOVE CP,[XWD CPDL,CPDL+1];USED FOR THE...
	BLT CP,CPDL+CPLEN-1;CO-ROUTINE ASSMBL
	MOVE CP,[XWD SNB+CPLEN-3,CPDL+CPLEN-2]
	SETZB BC,FBLK+1
	MOVE FC,[XWD -22,FBLK+2]
	PUSHJ	P,SBINI		;INITIALIZE SYMBOL OUTPUT.
	MOVNI B,BBLK+2
	HRRM B,BFX
	MOVNI B,FBLK+2
	HRRM B,FFX
	MOVE B,[POINT 7,TLBLK+1,6]
	MOVEM B,LSTPNT
	MOVSI B,(<ASCII /	/>)
	MOVEM B,TLBLK+1
	MOVE B,[POINT 7,CREFTB,13]
	MOVEM B,CREFPT
	MOVE B,[LSH N,3]
	MOVEM B,SRAD
	movei b,=120	;120 chars/line normally - JHS
	skipe crefsw	;are we CREFFing?
	movei b,=112	;  yes
	movem b,chrpl
	MOVE B,[LITPNT-1,,LITPNT]
	BLT B,LITPNT+HASH-1
	MOVEI B,1
	MOVEM B,BLOCK
	MOVE B,[XWD DAF,-1]
	MOVEM B,DBLCK
	MOVE B,[XWD SNULN,NULN]
	BLT B,NULN+5
	MOVE B,[XWD -EFSLEN,EFS-1]
	MOVEM B,EFSPNT#
	SETZM TITCNT+1
	MOVE B,[XWD -1,TITCNT+1]
	MOVEM B,TITCNT
	MOVE B,[XWD -1,SUBCNT+1]
	MOVEM B,SUBCNT
	MOVE B,[BYTE (7)15,12,15,12]
	MOVEM B,SUBCNT+1
	SETZM GARBAG
IFN STANSW,<
	MOVEI C,OPSET
	MOVEI B,OPSEND
	PUSHJ P,MACRET	;GIVE OPCODE-GETTER TO FREE STORAGE
>
	JRST MAIN
ITS,<
FNMOUT:	HRLI 1,440600
	MOVEI 2,6
	ILDB 3,1
	JUMPE 3,.+4
	ADDI 3,40
	OUTCHR 3
	SOJG 2,.-4
	POPJ P,

;CALLED AT INITIALIZATION TIME TO GOBBLE
;SYSTEM SYMBOLS INTO SYMBOL TABLE

	BEGIN GETSYS

↑GETSYS:MOVE TAC,[RADIX50 0,SYSYMB]
	.EVAL TAC,
	JRST 4,.
	MOVE T,[RADIX50 0,SYSYME]
	.EVAL T,
	JRST 4,.
	ADDI T,1
	SUBB T,TAC		;LENGTH OF GETSYS AREA
	ASH TAC,-1		;GUESS AT CORE NEEDED
	IMULI TAC,5
	ADD TAC,JOBFF		;END OF GETSYS AREA
	CAMG TAC,JOBFF
	JRST NONEED		;NO EXTRA CORE NEEDED
	CALLI TAC,11
	JRST 4,.
NONEED:	MOVE B,TAC		;BEGINING OF GETSYS AREA
	SUB B,T
	MOVN C,T
	HRL B,C			;AOBJN POINTER TO GETSYS AREA
	PUSH P,B
	MOVE C,[SIXBIT /CALLS/]
	.GETSYS B,
	JRST 4,.
	POP P,B		;B/ AOBJN POINTER TO GETSYS AREA
	MOVE C,JOBFF	;C/ POINTER TO ORIGIN OF FREE STORAGE
GETLOP:	CAIL C,(B)
	JRST 4,.
	MOVE N,(B)	;SQUOZE
	PUSHJ P,R50TOX	;CONVERT TO SIXBIT
	MOVEM L,(C)	;SAVE SIXBIT
	MOVE N,L
	IDIVI N,HASH
	MOVE N,1(B)			;VALUE
	TDNN N,[777000,,0]		;OPCODE OR SYMBOL
	JRST [	MOVEI PN,SYMTAB(NA)	;SYMBOL
		SETZM 1(C)
		HRLOI NA,ANONF!UPARF!DBLUPF
		JRST LONG]
	MOVEI PN,OPCDS(NA)	;OPCODE
	TDNN N,[0,,-1]		;LONG OR SHORT ENTRY
	JRST [	MOVEM N,1(C)	;SHORT 
		MOVEI NA,2	;ENTRY LENGTH
		JRST GETLP1]
	MOVSI NA,20	;MARK AS LONG ENTRY OPCODE
	MOVEM NA,1(C)
	MOVE NA,[ANONF,,1]
LONG:	MOVEM NA,2(C)
	MOVEM N,3(C)	;VALUE
	SETZM 4(C)	;NO RELOCATION
	MOVEI NA,5	;ENTRY SIZE
GETLP1:	MOVE N,(PN)	;POINTER TO CHAIN
	HRRM N,1(C)	;NEW ENTRY POINTING TO CHAIN
	MOVEM C,(PN)	;POINTER TO CHAIN
	ADD C,NA	;UPDATE FREE STORAGE POINTER
	ADD B,[1,,1]
	AOBJN B,GETLOP	;MORE
	MOVEM C,JOBFF
	POPJ P,

;RADIX50 TO SIXBIT CONVERSION
;	CALLED WITH SQUOZE IN N
;	RETURNS SIXBIT IN L
;	NA CLOBBERED

R50TOX:	TLZ N,740000		;CLEAR FLAGS FOR SPITE
	MOVEI L,0
	JUMPE N,CPOPJ		;AVOID INFINITE LOOP
R50TX1:	IDIVI N,50
	JUMPE NA,R50XF1		;NULL
	CAIG NA,12
	JRST [	ADDI NA,'0'-1	;ITS A DIGIT
		JRST R50XF]
	CAIG NA,44
	JRST [	ADDI NA,'A'-13	;ITS A LETTER
		JRST R50XF]
	MOVE NA,.$%-45(NA)	;SPECIAL CHARATCER
R50XF:	OR L,NA
	ROT L,-6
R50XF1:	JUMPN N,R50TX1
	TRNE L,77
	POPJ P,
	LSH L,-6
	JRST .-3

.$%:	'.'
	'$'
	'%'

	BEND GETSYS

>;ITS
OUT:	0
	OUTCHR T
	JRST @OUT

SOUT:	0
	OUTSTR [ASCIZ /
*/]
	JRST @SOUT

IN:	0
	SKIPE RPGSW
	JRST RPGIN
IN1:	ILDB 2,TTYPTR
	JUMPN 2,@IN
	MOVE 2,[440700,,TTYBUF]
	MOVEM 2,TTYPTR
	MOVEM 2,SOUT
IN2:	INCHWL 2
	ANDI 2,177
	JUMPE 2,IN2
	CAIN 2,15
	JRST IN2
	IDPB 2,SOUT
	CAIE 2,12
	JRST IN2
	MOVEI 2,
	IDPB 2,SOUT
	JRST IN1

TTYPTR:	0
TTYBUF:	BLOCK 40

PDLOV:	MOVE P,[XWD -2,.+2]
	PUSH P,.
	JRST .-1
	BLOCK 4

;NOFSL:	JSR HERE WHEN OUT OF FREE STORAGE

CELCNT:	0
NOFSL:	0
	BEGIN NOFSL
	PUSH P,O
	PUSH P,T	;SAVE
	PUSH P,FS	;...
	PUSH P,N
	PUSH P,NA
	MOVEI NA,GARBAG-1
	SKIPN T,GARBAG	;GET GARBAGE LIST
	JRST NOGAR	;NONE
	SETZB FS,CELCNT	;ZERO CELL COUNT
LOOP2:	MOVE O,2(T)	;GET START ADDRESS
	MOVE N,(T)	;GET COUNT
	CAIGE N,5	;BIG ENOUGH?
	JRST NOMO	;NO
LOOP1:	MOVEM FS,1(O)	;DEPOSIT POINTER
	MOVE FS,O	;FORM NEW ONE
	ADDI O,5
	SUBI N,5	;DECREASE COUNT
	AOS CELCNT	
	CAIL N,5	;ROOM FOR MORE?
	JRST LOOP1	;YES
NOMO:	JUMPE N,USET	;USED IT ALL?
	MOVEM N,(T)	;NO, DEPOSIT NEW COUNT
	MOVEM O,2(T)	;DEPOSIT NEW START
	MOVE NA,T
	SKIPN T,1(T)	;GET NEXT
	JRST NOMGAR	;NO MORE GARBAGE
	JRST LOOP2
USET:	MOVE O,1(T)	;GET POINTER
	MOVEM O,1(NA)	;REMOVE THIS CELL...
	MOVEM FS,1(T)	;& PUT IN...
	MOVE FS,T	;FREE STRG
	AOS CELCNT
	SKIPE T,O
	JRST LOOP2
NOMGAR:	SKIPE T,GARBAG
	MOVE T,3(T)
	MOVEM T,LGARB
	MOVE T,CELCNT
	CAIGE T,20	;WERE AT LEAST 20 CELLS CREATED?
	JRST NOTNUF	;NO
LOOP4:	MOVE T,NOFSL	;GET ADDRESS
	LDB O,[POINT 4,-2(T),12];GET AC FLD
	DPB O,[POINT 4,RSET,12];DEPOSIT
	POP P,NA
	POP P,N		;RESTORE
	HRRM FS,RSET	;DEPOSIT FREE STORAGE POINTER
	POP P,FS
	POP P,T
	POP P,O
RSET:	MOVEI 		;LOAD NEW POINTER
	JRST @NOFSL	;RETURN
NOGAR:	MOVEI FS,
NOTNUF:	MOVE T,JOBREL	;GET END OF CORE
	SUB T,MTBPNT	;SUB CURRENT START OF FREE AREA
	CAIGE T,300	;AT LEAST 300 WORDS LEFT?
	PUSHJ P,COEXP	;NO, EXPAND CORE
	MOVE T,JOBREL	;GET DIF
	SUB T,MTBPNT	;...
	LSH T,-1	;DIV BY 2
	ADD T,MTBPNT	;USE HALF FOR FREE STRG
	MOVE O,MTBPNT	;GET START
LOOP3:	MOVEM FS,1(O)	;DEPOSIT POINTER
	MOVE FS,O	;GET NEW ONE
	ADDI O,5	;GO TO NEXT
	CAMGE O,T	;FAR ENOUGH?
	JRST LOOP3	;NO
	MOVEM O,MTBPNT	;YES, DEPOSIT NEW MTBPNT
	JRST LOOP4	

COEXP:	MOVE T,JOBREL	;GET CURRENT END OF CORE
	ADDI T,2000	;EXPAND BY 1K
	CALLI T,11	;EXPAND
	JRST COERR	;NO CORE
	POPJ P,

↑COERR:	OUTSTR [ASCIZ/
NO CORE AVAIL.  STRIKE ANY KEY TO TRY AGAIN:/]
	PUSHJ P,WAIT
	JRST COEXP	;TRY AGAIN ON STRIKING ANY KEY

WAIT:	CLRBFI
	INCHRW T
	CAIN T,15
	INCHRW T
↑↑CPOPJ:POPJ P,

↑CORINI:MOVEI T,IFE STANSW,<420000;>20000
	APRENB T,
	MOVEI T,JOBAPR-1
	PUSHJ T,CORI2
	HRRZS O,T	;TRAP HERE TO SEE HOW MUCH PC CHANGED
	SUBI O,@JOBTPC
	JRST 2,1(T)	;SKIP TEST INSTR, CLEAR FLAGS (ESP. BIS)

CORI2:	JSP T,.+1
	SETZM -1	;GET PC OFFSET FOR WRITE INSTRUCTIONS
	MOVEM O,REGOFF#
	JSP T,.+1
	DPB [,-1]	;GET OFFSET FOR BYTE INSTRUCTIONS
	MOVEM O,BYTOFF#
	MOVEI T,JOBAPR-1
	PUSHJ T,CPOPJ		;SET TO COME HERE ON MPV INTS
↑NOMOCO:MOVEM FS,SV	;SAVE
	MOVEM T,SV+1
	MOVE FS,JOBTPC	;GET PC WORD
	TLNE FS,20000	;TEST BIS FLAG TO SEE IF LOSING INST WAS BYTE INST
	SKIPA FS,BYTOFF	;SELECT APPROPRIATE OFFSET
	MOVE FS,REGOFF
	ADDB FS,JOBTPC	;ADD OFFSET TO PC WORD
	ANDI FS,-1	;GET RID OF FLAGS
	MOVSI T,-LEGCNT
LOP1:	CAME FS,LEGTAB(T)	;SEE IF LEGAL PC
	AOBJN T,LOP1
	JUMPL T,MPVOK
	OUTSTR [ASCIZ/
ASSEMBLER ERROR OR SYSTEM HACK. TYPE ANY KEY TO PROCEED ANYWAY:/]
	PUSHJ P,WAIT
MPVOK:	PUSHJ P,COEXP	;EXPAND CORE
	MOVE FS,SV
	MOVE T,SV+1	;RESTORE
	JRST 2,@JOBTPC	;& RETURN

SV:	BLOCK 2
	BEND
SUBTTL CHARACTER TABLE (FOR SCANNER)

CTAB:	0
	XWD SPCLF,UDARF!TP1F	;↓
(SPCLF)
(SPCLF)
	XWD SPCLF!ARFL!ARMD,6	;∧
	XWD SPCLF!ARFL!UNOF,12	;¬
	XWD SPCLF,EPSF		;ε
FOR I←7,10
<(SPCLF)
>
	XWD SCRF!SPFL!SPCLF,5	;TAB
	XWD SPCLF!LNFD!SCRF,1	;LINE FEED
(SPCLF)
	SPCLF!SCRF!LNFD,,7	;FF LOOKS SORT OF LIKE LF
	XWD SPCLF!CRFG,6	;CR RET (6 IS FOR LOUT)
FOR I←16,17
<(SPCLF)
>
	XWD SPCLF,INF	;⊂
	FOR I←21,25
<(SPCLF)
>
	XWD SPCLF!ARFL,4	;⊗
	XWD SPCLF!LNFD!CRFG,2	;BOTH WAYS ARROW (↑W) LINE FEED AND CR RET
	SNB!.FL!ENMF,,'.'	;_ (MAKE IT LOOK LIKE . IN SYMS)
	XWD SPCLF,BSLF		;→(\)
	XWD SPCLF,UDARF!TP2F	;↑
	XWD SPCLF!ARFL!ARMD1,6	;(NOT EQLS)(XOR)
	(SPCLF)
	XWD SPCLF!ARFL!ARMD1,6	;CTRL ] TEMP USE AS XOR ***  ≥≥≥
	(SPCLF)
	XWD SPCLF!ARFL,6	;∨
	XWD SCRF!SPCLF!SPFL,5	;SPACE
	XWD SPCLF!ARFL,6	;!
	XWD SPCLF!SCRF!ENMF,2	;"
	XWD SPCLF,SHRPF		;#
	XWD SNB!ENMF,'$'	;$
	XWD SNB!ENMF,'%'	;%
	XWD SPCLF!ARFL!ARMD,6	;&
	XWD SPCLF!SCRF!ENMF,3	;'
	XWD SPCLF,LFPF		;(
	XWD SPCLF,RTPF		;)
	XWD SPCLF!ARFL,10	;*
	XWD SPCLF!ARFL,12	;+
	XWD SPCLF,COMF		;,
	XWD SPCLF!ARFL!ARMD!UNOF,12	;-
	XWD SNB!.FL!ENMF,'.'	;.
	XWD ARFL!SPCLF!ARMD,10	;/
FOR I←20,31
<XWD SNB!NMFLG!ENMF,I
>
	XWD SPCLF,LACF!TP2F	;:
	XWD SPCLF!CRFG,2	;;
	XWD SPCLF!SCRF!ENMF!LBRF,10	;WILL BE XWD SPCLF!ENMF!LBRF,LBCF!TP2F;<
	XWD SPCLF!SCRF!ENMF,4	;=
	XWD SPCLF!SCRF!RBRF,11	;WILL BE XWD SPCLF!RBRF,TP2F!RBCF;>
	XWD SPCLF,UDARF!TP1F	;?
	XWD SPCLF,ATF		;@
	XWD SNB!ENMF,'A'	;A
	XWD SNB!ENMF!BFL,'B'	;B
	XWD SNB!ENMF,'C'	;C
	XWD SNB!ENMF,'D'	;D
	XWD SNB!ENMF!EFL,'E'	;E
FOR I←'F','Z'
<XWD SNB!ENMF,I
	>
	XWD SPCLF!ENMF!LBRF,TP1F;[
	XWD SPCLF,BSLF		;\
	XWD SPCLF!RBRF,TP1F	;]
	XWD SPCLF,UDARF!TP2F	;↑
	XWD SPCLF,LACF!TP1F	;←
	XWD SPCLF,ATF		;@(140)
	XWD SNB!ENMF,'A'	;A
	XWD SNB!ENMF!BFL,'B'	;B
	XWD SNB!ENMF,'C'	;C
	XWD SNB!ENMF,'D'	;D
	XWD SNB!ENMF!EFL,'E'	;E
	FOR I←'F','Z'
<XWD SNB!ENMF,I
>
	XWD SPCLF!SCRF,10	;WILL BE XWD SPCLF,LBCF!TP2F;{
	(SPCLF)
	XWD SPCLF!SCRF,11	;WILL BE XWD SPCLF,RBCF!TP2F;}
	XWD SPCLF!SCRF,11	;AS ABOVE
	XWD SPCLF!SCRF!DLETF,0	;DELETE
0
COMBTS←←SCRF!SPCLF!ENMF!LBRF!RBRF!DLETF!LNFD	;OR OF BITS FOR LF DEL <>{}
BEGIN SCAN ↔ SUBTTL SCANNER AND FRIENDS

	;RETURNS WITH NEXT THING
;IF AN IDENTIFIER -- SIXBIT IN L
;IF A NUMBER -- VALUE IN N AND NA
;IF A SPC. CHR. -- BITS FOR CHR IN N
;IN ALL CASES, THE NEXT NON-BLANK CHR. AFTER THE
;	THING RETURNED IS IN C AND ITS BITS ARE IN B.

↑SCAN:	MOVEI L,1	;PREPARE TO TEST FOR LINE NUM
	TLZE SFL	;SHOULD WE RETURN CURRENT THING?
	JRST AHEDW	;YES
LOOP3:	ILDB C,INPNT	;GET CHR.
LOOP3A:	IDPB C,LSTPNT	;DEPOSIT FOR LISTING
↑AHED:	TDNE L,@INPNT	;LINE NUM?
	JRST LNUM	;YES
	SKIPL B,CTAB(C)	;GET BITS, IS IT NUM OR LET?
AHEDW:	JUMPGE B,SPCRET	;NO
	TLNE B,NMFLG	;NUM?
	JRST NUMS	;YES
	HRRZ L,B	;IT'S A LETTER, PUT IN L
REPEAT 5,<	ILDB C,INPNT	;GET NEXT
	IDPB C,LSTPNT	;DEPOSIT FOR LIST
	SKIPL B,CTAB(C)	;GET BITS
	JSR NOLT	;NOT LET OR NUM
	LSH L,6
	ORI L,(B)	;OR IN SIXBIT>
LOOP1:	ILDB C,INPNT	;GET NEXT CHR.
	IDPB C,LSTPNT	;DEPOSIT FOR LIST
	SKIPL B,CTAB(C)	;GET BITS, LET OR NUM?
	JSR NOLT	;NO
	JRST LOOP1	;YES,SKIP
NOLT:	0
	JUMPE B,[JSP B,NULSKP
		ILDB C,INPNT
		IDPB C,LSTPNT
		SKIPL B,CTAB(C)
		JRST NOLT+1
		JRST @NOLT]
	TLNE B,SCRF	;SPC HANDLING?
	XCT NOLB(B);YES
	TLO SFL!IFLG	;SET 'SCAN AHEAD' AND 'IDENT'
	TLZ NFLG!SCFL!FLTFL;CLEAR NUM & SPC.CHR.
	POPJ P,
NUMS:	MOVEI N,-20(B)	;PUT VALUE IN N
	SKIPA NA,FLTB-20(B);FLOAT
LOOP2A:	JSP B,NULSKP
LOOP2:	ILDB C,INPNT	;GET NEXT CHR.
	IDPB C,LSTPNT
	SKIPL B,CTAB(C)	;GET BITS
	JRST NONM	;NOT NUM
NLOP:	TLNN B,NMFLG	;NUM?
	JRST NLET	;NO, LET
↑SRAD:	LSH N,3		;MULT BY RADIX
	ADDI N,-20(B)	;ADD IN THIS DIGIT
	FMPR NA,[10.0]	;MULT FLOATING BY 10
	FADR NA,FLTB-20(B);ADD IN THIS DIGIT
	JRST LOOP2
FLTB:	DEC 0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0
↑SPCSKP:0
	PUSH P,L
	MOVEI L,1
SPCCN1:	ILDB C,INPNT	;GET NEXT
SPCCN2:	IDPB C,LSTPNT	;DEPOSIT
	XCT AHED
	JRST	[JSR SLNUM
		JRST SPCCN1]
	SKIPGE B,CTAB(C)	;GET BITS
	JRST SPCKRT	;NNUM OR LET
SPCCON:	JUMPE B,SPCNUL
	TLNE B,SCRF	;SPC. HAND?
	XCT SPKT(B)	;YES
SPCKRT:	POP P,L
	JRST @SPCSKP
NONM:	JUMPE B,LOOP2A	;NULL TYPE CHR?
NONM1:	TLNE B,SCRF	;SPC HAND?
	XCT NOTB(B)	;YES
	MOVEI NA,
	TLO SFL!NFLG	;SET 'AHEAD' AND NUM
	TLZ SCFL!IFLG!FLTFL;CLEAR SPC,CHR & IDENT
	POPJ P,
SPCRET:	JUMPE B,LOOP3Q	;IGNORE CHR?
	TLNE B,SCRF	;DOES THIS CHR REQUIRE SPEC. ATT. BY SCAN?
	XCT SPCTB(B)	;YES, HANDLE
SPCRT2:	TLZ IFLG!NFLG!FLTFL;CLEAR IDENT ,NUM
	TLO SCFL!SFL	;SET SPC CHR,AHEAD
	MOVE N,B	;PUT BITS IN N
	JSR SPCSKP	;SKIP TO NEXT NON-BLANK CHR.
	POPJ P,

SPCNUL:	JSP B,NULSKP
	JRST SPCCN1
	JRST SPCCN2

LOOP3Q:	JSP B,NULSKP
	JRST LOOP3
	JRST LOOP3A

NULSKP:	JUMPN C,(B)	;IF NOT A NULL
	SKIPE @INPNT	;ZERO WORD?
	JRST LOOP3Z	;NO
	MOVSI TAC,700	;SKIP REST OF WORD
	HRR TAC,INPNT	;AND PREPARE TO SKIP MORE
	SKIPN 1(TAC)
	AOJA TAC,.-1
	MOVEM TAC,INPNT
LOOP3Z:	ILDB C,INPNT	;NO, A NULL, GET NEXT
	JRST 2,@[20000,,1(B)]	;SET BIS & GO TO IDPB FOR LISTING
DEFINE EMPS  (A)
<	PUSHJ P,LBROK
	JRST A>

BSPCTB:	PUSHJ P,RTBFND
	JRST SPCRET
	JRST LOOP3
LBROK:	HRRI B,LBCF!TP2F
	TLZ B,SCRF
	AOS BROKCT
	POPJ P,
SPCTB:	JRST DELT	;DELETE -- HANDLE
	PUSHJ P,LSTLF	;HANDLE LINE FEED
	JRST DQT	;HANDLE DOUBLE QUOTE
	JRST SQT	;HANDLE SINGLE QUOTE
	JRST EQLS	;HANDLE =
	JRST LOOP3	;SKIP SPACES
	JFCL
	PUSHJ P,NEWPAG
	EMPS BSPCTB
↑BROKCT:0
↑RTBFND:HRRI B,TP2F!RBCF
	TLZ B,SCRF
	SKIPN RTFLST	;ANY TO CHECK?
	POPJ P,		;NO
	PUSH P,N	;SAVE
	MOVE N,BROKCT	;GET CURRENT COUNT
	CAMN N,@RTFLST	;SAME?
	JRST RFNDQ	;YES
	SOS BROKCT	;NO, DECREMENT COUNT AND RETURN
	POP P,N
	POPJ P,
RFNDQ:	PUSH P,L
	MOVE L,RTFLST	;GET POINTER
	MOVE N,FSTPNT	;PUT THIS ONE...
	EXCH N,1(L)	;BACK ON FREE STRG.
	MOVEM L,FSTPNT	;...
	MOVEM N,RTFLST	;...
	SOS BROKCT	;DECREMENT COUNT
	POP P,L
	POP P,N
	AOS (P)	;SET FOR SKIP REUTRN
	POPJ P,

NLET:	TLNE B,.FL	;.?
	JRST DOT
	TLNE B,BFL	;B?
	JRST BSH
	TLNE B,EFL	;E?
	JRST EXP
	ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
	JRST NONM
LNUM:	JSR SLNUM
	JRST LOOP3
↑SLNUM:	0
	CAIGE C,60
	JRST POPMK	;YES
LNMC:	MOVE C,@INPNT
	MOVEM C,TLBLK
	AOS INPNT	;SKIP LINE NUM WD
	SKIPL @INPNT	;SEE IF WE RAN OFF BUFFER (RUBOUT WD WILL BE NEG)
	JRST .+3
	PUSHJ P,INP	;YES - READ ANOTHER
	IBP INPNT	;AND SKIP TAB
	MOVEI C,0
	DPB C,LSTPNT
	JRST @SLNUM
QURN:	PUSH P,B
	PUSHJ P,INP
	POP P,B
	ILDB C,INPNT
	POPJ P,
POPMK:	MOVE C,[ASCID/     /]
	CAME C,@INPNT	;PAGE MARK?
	JRST LNMC	;NO
	AOS INPNT	;SKIP FIRST PAGE MARK WD
	SKIPGE @INPNT
	PUSHJ P,INP	;READ ANOTHER BUFFER IF NEEDED
	AOS INPNT	;SKIP SECOND PAGE MARK WD
	MOVSI C,440700
	HLLM C,INPNT
	TRNE LDEV	;MAKE SURE THERE IS A LIST DEV
	SKIPE XPNDSW	;AND THE WE HAVE NOT SAID XLIST
	TDZA C,C
	MOVEI C,14	;IN THAT CASE WE WILL MAKE A PAGE HEADING
	DPB C,LSTPNT		;NULL OUT THAT SPACE
	PUSH P,SLNUM	;PREPARE TO RETURN
↑NEWPAG:SKIPL AHED	;DON'T UPDATE THESE CELLS IF TEXT IS FROM MACRO
	JRST LSTFRC
	SETZM INLINE
	AOS PGNM
	SETZM SPGNM
	JRST LSTFRC

DELT:	DPB B,LSTPNT	;PUT ZERO(NULL)OVER DELETE IN LISTING
	ILDB C,INPNT	;GET NEXT CHR.
	XCT DELTAB(C)	;HANDLE
	ILDB C,INPNT
	DPB C,LSTPNT
	JRST AHED
DEFINE DHAN!(A)
<DPB B,LSTPNT;PUT ZERO OVER DELETE
ILDB C,INPNT	;GET NEXT
XCT DELTAB(C);HANDLE
ILDB C,INPNT;GET NEXT
DPB C,LSTPNT;DEPOSIT FOR LIST
A!SKIPL B,CTAB(C)
>
NOLD:	DHAN
	JRST NOLT+1
	JRST @NOLT
NOND:	DHAN
	JRST NONM
	JRST NLOP
↑DELTAB:PUSHJ P,INP	;GET NEXT BUFFER
	PUSHJ P,GETARG	;GO TO MACRO ARGUMENT
	POP M,INPNT	;LEAVE ARGUMENT
	PUSHJ P,LVMAC	;LEAVE MACRO
	PUSHJ P,LVREP	;LEAVE REPEAT
	PUSHJ P,LVFORL	;LEAVE NUMERIC FOR
	PUSHJ P,LVFORI	;LEAVE "IN" FOR
	PUSHJ P,EFORSH	;LEAVE "E" FOR
0

DEFINE   QUOT  7 (M)
<	MOVEI L,1
	SETZB N,NA
QP7M:	ILDB C,INPNT
QQ7M:	IDPB C,LSTPNT
QT7M:	XCT AHED
	JRST	[JSR SLNUM
		JRST QP7M]
	JUMPE C,QN7M
	MOVE B,CTAB(C)
	TLNE B,SCRF
	XCT SCQT7M(B)
QU7M:	IFE M,<TRZN C,100
		TRZA C,40
		TRO C,40>
	LSH N,6+M
	OR N,C
	JRST QP7M

BSCQT7M:PUSHJ P,RTBFND
	JRST QU7M
	JRST QP7M

QN7M:	JSP B,NULSKP
	JRST QP7M
	JRST QQ7M
>
SCQT1:	JRST DH1
	PUSHJ P,LSTLF
	JRST SCR1
	JFCL
	JFCL
	JFCL
	JFCL
	PUSHJ P,NEWPAG
	EMPS BSCQT1
SCQT0:	JRST DH0
	PUSHJ P,LSTLF
	JFCL
	JRST SCR0
		JFCL
	JFCL
	JFCL
	PUSHJ P,NEWPAG
	EMPS BSCQT0
DQT:	QUOT(1)
DEFINE   QUOTS  = (A)
<SCR=A:	JSR SPCSKP
		TLO SFL!NFLG
	TLZ SCFL!IFLG
	POPJ P,
DH=A:	DPB B,LSTPNT
	ILDB C,INPNT
	XCT DELTAB(C)
	ILDB C,INPNT
	DPB C,LSTPNT
	JRST QT=A
>
	QUOTS (1)
SQT:	QUOT(0)
		QUOTS(0)
EQLS:	PUSH P,SRAD	;SAVE CURRENT RADIX
	MOVE N,[IMULI N,12];SET TO 10...
	MOVEM N,SRAD	;...
	PUSHJ P,SCAN	;SCAN NUMBER
	POP P,SRAD	;RESTORE RADIZ
	POPJ P,

DOT:	MOVE N,NA	;GET FLOATING NUM SO FAR
	SKIPA NA,[10.0];GET 10
LOOP5A:	JSP B,NULSKP
LOOP5:	ILDB C,INPNT	;GET NEXT
	IDPB C,LSTPNT	;DEPOSIT
		SKIPL B,CTAB(C)	;GET BITS
	JRST DNONM	;NOT NUM
DNLOP:	TLNN B,NMFLG	;NUM?
	JRST DNLET	;NO,LETTER
		MOVE B,FLTB-20(B);FLOAT
	FDVR B,NA	;SCALE
	FADR N,B	;ADD IN
	FMPR NA,[10.0]	;SCALE THE SCALE
		JRST LOOP5
DNLET:	TLNE B,EFL	;E?
	JRST EXP1	;YES
	ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
	JRST DNONM1
EXP:	MOVE N,NA	;GET FLOATING VERSION
EXP1:	PUSHJ P,SCAN1	;GET NEXT CHR.
	MOVEI NA,EXT1
	HRRM NA,EXTP
	TLNN B,UNOF	;- OR ¬(TREAT BOTH THE SAME)?
	JRST PT5	;NO
	MOVEI NA,EXT2	;YES, HANDLE...
	HRRM NA,EXTP	;...
	PUSHJ P,SCAN1	;GET NEXT
PT5:	TLNN B,NMFLG	;NUM?
	ERROR[ASCIZ/NO NUM AFTER E/]
	MOVEI NA,-20(B)	;GET VALUE
	PUSHJ P,SCAN1	;GET NEXT
	TLNN B,NMFLG	;NUM?
	JRST PT6	;NO
	ADDI NA,12	;SECOND HALF OF TABLE
	FMPR N,@EXTP	;SCALE
		MOVEI NA,-20(B)	;GET VALUE
	PUSHJ P,SCAN1	;GET NEXT
PT6:	FMPR N,@EXTP	;SCALE
	TLNE B,NMFLG
	ERROR[ASCIZ/TOO MANY NUMS AFTER E/]
	JRST DNONM1
EXTP:	XWD NA,EXT1
EXT1:	1.0
10.0
100.0
1000.0
10000.0
100000.0
1000000.0
10000000.0
100000000.0
1000000000.0
1.0
1.0E10
1.0E20
1.0E30
1.0E40
1.0E50
1.0E60
1.0E70
1.0E80
	1.0E90

EXT2:	1.0
0.1
0.01
0.001
	0.0001
	0.00001
0.000001
0.0000001
0.00000001
0.000000001
1.0
1.0E-10
1.0E-20
1.0E-30
1.0E-40
1.0E-50
1.0E-60
1.0E-70
1.0E-80
1.0E-90

DNONM:	JUMPE B,LOOP5A	;NULL TYPE?
DNONM1:	TLNE B,SCRF	;SPECIAL AHNDLE?
	XCT DNOTB(B)	;YES, HANDLE
	MOVSI NA,FLTFL	;SET AS FLOATING
	TLO SFL!NFLG!FLTFL;SET NUM&FLOATING & AHEAD
	TLZ IFLG!SCFL	;CLEAR SPC CHR. & IDENT
	POPJ P,
DNOTB:	JRST DNDH	;DELETE
	PUSHJ P,LSTLF	;LF
	JFCL
		JFCL
	JFCL
	JSR SPCSKP
	JFCL
	PUSHJ P,NEWPAG
	EMPS BDNOTB
BDNOTB:	PUSHJ P,RTBFND
	JRST DNONM1
	JRST LOOP5
DNDH:	DHAN
	JRST DNONM
	JRST DNLOP

NOTB:	JRST NOND
	PUSHJ P,LSTLF
	JFCL
	JFCL
	JFCL
	JSR SPCSKP
	JFCL
	PUSHJ P,NEWPAG
	EMPS BNOTB
BNOTB:	PUSHJ P,RTBFND
	JRST NONM
	JRST LOOP2

NOLB:	JRST NOLD
	PUSHJ P,LSTLF
	JFCL
	JFCL
	MOVE B,CTAB+"←"	;MAKE = LOOK LIKE ← AFTER SYMS
	JSR SPCSKP
	JFCL
	PUSHJ P,NEWPAG
	EMPS BNOLB
BNOLB:	PUSHJ P,RTBFND
	JRST NOLT+1
	ILDB C,INPNT
	IDPB C,LSTPNT
	SKIPL B,CTAB(C)
	JRST NOLT+1
	JRST @NOLT

SPKT:	JRST SPCDEL
	JFCL
	JFCL
	JFCL
	JFCL
	JRST SPCCN1
	JFCL
	JFCL
	EMPS BSPKT
BSPKT:	PUSHJ P,RTBFND
	JRST SPCKRT
	JRST SPCCN1

SPCDEL:	DHAN
	JRST SPCCON
	JRST SPCKRT

BSH:	PUSHJ P,SCAN1	;GET NUM
	TLNN B,NMFLG	;NUM?
	ERROR[ASCIZ/NO NUM AFTER B/]
	MOVNI NA,-20(B)	;GET VALUE
	PUSHJ P,SCAN1	;GET NEXT
	TLNN B,NMFLG	;NUM?
	JRST BPT	;NO
	IMULI NA,12	;CONVERT TO ...
	SUBI NA,-20(B)	;DECIMAL
	PUSHJ P,SCAN1	;GET NEXT
BPT:	LSH N,=35(NA)	;DO SHIFT
	JRST NONM1
LVMAC:	POP M,C		;GET OLD MTBPNT
	JUMPE C,LVNO	;NO ARGS?
	POP M,B		;GET OLD NEW MTBPNT
	PUSHJ P,MACRET
		SKIPA
LVNO:	SUB M,[1(1)]
	POP M,INPNT	;SET SCAN POINTER BACK
	POP M,C		;RESTORE CHR. SIZE FOR
	DPB C,[POINT 6,LSTPNT,11];LISTING
	HRRZM C,XPNDSW
	HLRZM C,INMCSW
	POP M,C
	MOVEM C,AHED
	MOVEM C,LOOP6
	SKIPE UNDLNS	;UNDERLINING?
	SKIPE NOEXP	;NO EXPAND?
	JRST ARNMC	;NO
	SKIPN INMCSW	;IN A MACRO?
	JRST ARNMC	;YES
	HRR C,LSTPNT
	ADDI C,TLBLK-MBLK;GO BACK TO NORMAL POINTER
	HRRM C,LSTPNT
ARNMC:	POP M,C		;GET CHR.
	AOS (P)		;SKIP NEXT ILDB
	POPJ P,
GETARG:	ILDB C,INPNT	;GET ARG #
	ADD C,(M)	;GET POINTER
	PUSH M,INPNT	;SAVE OLD PNTR.
	MOVE C,(C)
	MOVEM C,INPNT
	POPJ P,
		SUBTTL SCAN1,SCNTIL, SCANM
LVREP:	SOSG -1(M)	;DECREMENT COUNT
		JRST LRDON	;DONE
	MOVE C,(M)	;GET...
	HRLI C,440700	;POINTER
	MOVEM C,INPNT
	POPJ P,
LRDON:	POP M,C	;GET POINTER
	SUB M,[1(1)]
	POP M,B		;GET OLD NEW MTBPNT
	PUSHJ P,MACRET
ALDON:	POP M,INPNT	;RESTORE SCAN POINTER
	POP M,C		;RESTORE...
	DPB C,[POINT 6,LSTPNT,11];LISTING
	HRRZM C,XPNDSW
	HLRZM C,INMCSW
	POP M,C
	MOVEM C,AHED	;RESTORE LINE NUM SKIPPING
	MOVEM C,LOOP6
	SKIPE UNDLNS	;UNDERLINING?
	SKIPE NOEXP	;NO EXPAND?
	POPJ P,
	SKIPN INMCSW	;IN A MACRO?
	POPJ P,
	HRR C,LSTPNT
	ADDI C,TLBLK-MBLK
	HRRM C,LSTPNT
	POPJ P,
NTST:	CAMGE B,-3(M)	;DONE?
	JRST LFDON	;YES
	JRST NLFD	;NO
LVFORL:	MOVE B,-4(M)	;GET INCREMENT
	ADDB B,-2(M)	;ADD NUM
	SKIPG -4(M)	;NEG INCREMENT?
	JRST NTST	;YES
	CAMLE B,-3(M)	;DONE?
	JRST LFDON	;YES
NLFD:	MOVE C,(M)	;GET ARG POINTER
	ADD C,[XWD 440700,2]
	PUSHJ P,BKSLSH	;CON TO ASCII
	EDEPO (B,C,2)	;DEPOSIT END OF ARG
	MOVE B,-1(M)	;GET START
	ADD B,[XWD 440700,2]
	MOVEM B,INPNT
	POPJ P,
LFDON:	HRRZ C,-1(M)	;GET START OF THROW-AWAY
	SUB M,[5(5)]	
		POP M,B		;GET OLD NEW MTBPNT
	PUSHJ P,MACRET
	JRST ALDON
LVFORI:	MOVE B,(M)	;GET ARG POINTER
	MOVE B,1(B)	;GET POINTER
	ILDB C,B	;GET FIRST CHR. OF SECOND ARG
	CAIE C,177	;IS IT DELETE?
	JRST IFORSH	;NO, GET NEXT ARG SETUP
	SUB M,[2(2)]	;YES, NO MORE ITERATIONS
	POP M,C		;GET START OF THROW-AWAY
	POP M,B		;GET OLD NEW MTBPNT
	PUSHJ P,MACRET
	JRST ALDON
↑SCAN1:	TLZE SFL	;AHEAD?
	JRST S1PT	;YES
↑SCAN1A:MOVEI L,1	;PREPARE TO TEST FOR LINE NUM
LOOP4:	ILDB C,INPNT	;GET CHR.
LOOP4A:	IDPB C,LSTPNT	;DEPOSIT FOR LISTING
↑LOOP6:	TDNE L,@INPNT	;LINE NUM?
	JRST	[JSR SLNUM
		JRST LOOP4]
	SKIPN B,CTAB(C)	;GET BITS, NULL CHR?
	JRST LOOP4Q	;YES, NULL CHR.
S1PT:	TLNE B,SCRF	;SPECIAL HANDLING?
	XCT SC1T(B)	;YES, AHNDLE
	POPJ P,

LOOP4Q:	JSP B,NULSKP
	JRST LOOP4
	JRST LOOP4A

SC1T:	JRST SC1DH
	PUSHJ P,LSTLF
	JFCL
	JFCL
	JFCL
	JFCL
	JFCL
	PUSHJ P,NEWPAG
	EMPS BSC1T
BSC1T:	PUSHJ P,RTBFND
	POPJ P,
	JRST LOOP4

SC1DH:	DPB B,LSTPNT
	ILDB C,INPNT
	XCT DELTAB(C)
	ILDB C,INPNT
	DPB C,LSTPNT
	JRST LOOP6
↑SCNTIL:TLZE SFL	;AHEAD?
		JRST LOPP3	;YES
LOPP1:	ILDB C,INPNT	;GET CHR.
LOPP1A:	IDPB C,LSTPNT	;DEPOSIT
LOPP2:	SKIPN B,CTAB(C)	;GET BITS
		JRST LOPP1Q	;NULL CHR
LOPP3:	TLNE B,SCRF	;SPECIAL?
	XCT STTB(B)	;YES
	MOVSI B,¬COMBTS	;WATCH US SKIP COMMENTS FAST
	MOVE TAC,INPNT
LOP69:REPEAT 5,<
	ILDB C,TAC
	IDPB C,LSTPNT
	TDNN B,CTAB(C)
	JRST LOP105	>
	JRST LOP69

LOP105:	MOVEM TAC,INPNT
	JRST LOPP2

LOPP1Q:	JSP B,NULSKP
	JRST LOPP1
	JRST LOPP1A

STTB:	JRST STDH	;DELETE
	JRST LSTLF	;LINE FEED, FORCE LISTING AND RETURN
	JFCL
	JFCL
	JFCL
	JFCL
	JFCL
	JRST NEWPAG	;FORM FEED, ADVANCE PAGE AND RETURN
	EMPS BSTTB

BSTTB:	PUSHJ P,RTBFND
	JRST LOPP1
	JRST LOPP1

STDH:	DPB B,LSTPNT	;CLEAR THE DELETE
	ILDB C,INPNT	;GET CHR.
	XCT DELTAB(C)	;HANDLE
	ILDB C,INPNT	;GET NEXT CHR.
	DPB C,LSTPNT
	JRST LOPP2
↑SLURP:	PUSH P,BROKCT	;ROUTINE TO EAT TEXT UP TO MATCHING BROKET
	SETZM BROKCT
	JSP TAC,SLRP0
	SOSL BROKCT
	JRST SLRP1
	POP P,TAC
	ADDM TAC,BROKCT
	POPJ P,

↑SLURPC:MOVE TAC,CTAB(C)	;EATS TEXT UP TO MATCHING CHAR
	TLNN TAC,¬COMBTS
	TLNN TAC,SCRF
	JRST .+3
	ERROR [ASCIZ /ILLEGAL DELIMETER/]
	POPJ P,
	PUSH P,TAC
	HRLOI TAC,SCRF
	MOVEM TAC,CTAB(C)
	TLZ SFL
	JSP TAC,SLRP0
	PUSHJ P,RTBFND
	JRST SLRP1
	JRST SLRP1

SLRP0:	HRRM TAC,SRBINS
	TLZE SFL
	JRST SLRP2
SLRP1:	ILDB C,INPNT
SLRP1A:	IDPB C,LSTPNT
SLRP2:	SKIPN B,CTAB(C)
	JRST SLRPN
SLRP3:	TLNE B,SCRF
	XCT SLTB(B)
	MOVSI B,¬COMBTS	;PREPARE TO IGNORE ALMOST EVERYTHING
	MOVE TAC,INPNT
SLRP4:	REPEAT 5,<
	ILDB C,TAC
	IDPB C,LSTPNT
	TDNN B,CTAB(C)
	JRST SLRP5
>
	JRST SLRP4

SLRP5:	MOVEM TAC,INPNT
	JRST SLRP2
	JRST SLRPX
SLTB:	JRST SLDH
	PUSHJ P,LSTLF
	REPEAT 7-2,<JFCL>
	PUSHJ P,NEWPAG
	AOS BROKCT
SRBINS:	JRST

SLRPN:	JSP B,NULSKP
	JRST SLRP1
	JRST SLRP1A

SLDH:	DHAN <;>
	JRST SLRP2

SLRPX:	POP P,B
	MOVEM B,CTAB(C)
	POPJ P,
;SCANM	GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED
↑SCANM:	PUSHJ P,SCAN
	TLNN IFLG	;IDENTIFIER?
	POPJ P,		;NO
	MOVE N,L	;GET SIXBIT
	IDIVI N,HASH	;HASH
	MOVMS NA
	SKIPN TAC,MACRT(NA);GET START OF CHAIN
	POPJ P,
	SRC1(L,TAC,SCNMF,<POPJ P,>)
SCNMF:	MOVEI NA,(TAC)
	SKIPN N,3(NA)	;ANY ARGS?
	JRST NOAG	;NO
	JUMPL N,SCNMPO	;MACRO "PSEUDO OP"?('PSEUDO MACRO')
;	PUSH P,B
	PUSH P,NA	;SAVE POINTER
	PUSH P,MTBPNT	;SAVE ARG POINTER
	PUSHJ P,ARGIN	;GET ARGS
	POP P,N		;GET POINTER
	HRRZM NA,MTBPNT	;DEPOSIT NEW ONE
	POP P,NA	;GET POINTER
;	POP P,B
NOAG:	SKIPE XCRFSW
	JRST	[CAIN NA,%IOWD
		CREF7 5,(NA)
		CAIE NA,%IOWD
		CREF6 5,(NA)
		JRST .+1]
	PUSH M,C	;SAVE CHR.
;	TRNE B,LBCF!RBCF	;DID WE FUCK UP BROKCT?
;	JRST [	TRNE B,LBCF
;		SOSA BROKCT
;		AOS BROKCT
;		JRST .+1]
	PUSH M,AHED	;SAVE STATE OF LINE NUMBER LOOKING FOR
	LDB C,[POINT 6,LSTPNT,11];SAVE STATE...
	HRL C,INMCSW	;IN MACRO &...
	PUSH M,C	;OF LISTING
	PUSH M,INPNT	;SAVE SCAN POINTER
	PUSH M,MTBPNT
	PUSH M,N	;DEPOSIT ARG POINTER
	TLZ SFL		;CLEAR "SCAN AHEAD"
	MOVEI N,"⊃"
	DPB N,LSTPNT	;ERASE LAST CHR IN LISTING
	MOVEI N,
	SKIPE NOEXP	;NO MACRO EXPAND?
	DPB N,[POINT 6,LSTPNT,11];YES,DISCONTINUE LISTING
	SKIPE NOEXP
	SETZM XPNDSW
	SETZM INMCSW
	MOVE N,4(NA)	;GET TEXT POINTER
	HRLI N,700	;MAKE INTO BYTE POINTER
	MOVEM N,INPNT	;DEPOSIT
	MOVSI N,(<SKIPA>)
	MOVEM N,AHED	;AVOID SKIPING...
	MOVEM N,LOOP6	;LINE NUMBERS
	SKIPN NOEXP	;NO EXPAND?
	SKIPN UNDLNS	;UNDERLINE?
	JRST SCANM	;NO
	HRRZ N,LSTPNT	;GET LIST. POINTER
	CAIL N,TLBLK	;ALREADY CHANGED?
	SUBI N,TLBLK-MBLK;NO,CHANGE IT
	HRRM N,LSTPNT
	TRO MACUNF	;SET BIT
	JRST SCANM

SCNMPO:	TLNE N,1
	SKIPN XCRFSW
	JRST @4(NA)
	CREF7 5,(NA)
	JRST @4(NA)

↑SCNMPT:TLZ IFLG
	POPJ P,
↑Q%IF:	DPB N,[POINT 3,Q%T,8];DEPOSIT TEST
	MOVEI N,1(P)
	BLT N,4(P)	;SAVE AC'S
	ADD P,[4(4)]
	TDO [XWD OPFLG,NOFXF]
	PUSHJ P,MEVAL	;GET VALUE
	TLNN UNDF!ESPF
	TRNE NA,17	;CHECK FOR DEFINED
	PUSHJ P,IFER
	MOVSI NA,-3(P)
	BLT NA,3	;RESTORE AC'S
	SUB P,[4(4)]
Q%T:	SKIP N
	SKIPA N,[0]
	MOVEI N,1
	SETZM REPSW	;DO NOT INSERT CR LF AT END
	PUSHJ P,REP	;DO THE REPEAT
	JRST SCANM
IFER:	ERROR [ASCIZ /UNDEFINED IF ARGUMENT-TAKEN AS 0/]
	MOVEI N,0
	POPJ P,
↑Q%IFD:	HRREM N,Q%SV	;SAVE "VALUE"
	JSR LGET	;GET THE {
	MOVE NA,MTBPNT	;MAKE POINTER
		HRLI NA,440700	;...
	PUSHJ P,SARGIN	;READ IN FIRST ARG.
	MOVEI N,
REPEAT 5,<LEG	IDPB N,NA>
	HRRZ N,NA
	HRLI NA,440700	;MAKE POINTER
	JSR LGET	;GET THE {
	PUSHJ P,SARGIN	;READ IN SECOND ARG
	MOVEI TAC,
REPEAT 5,<LEG	IDPB TAC,NA>
	HRRZS NA
	SUB NA,N
	ADD NA,MTBPNT
	CAME NA,N	;SAME LENGTH?
	JRST NOSAML	;NO
	MOVE NA,MTBPNT	;GET POINTER
	MOVE PN,N	;SAVE END
Q%LOP:	MOVE TAC,(N)	;GET WORD
	TRZ TAC,1
	EXCH TAC,(NA)	;GET OTHER WORD
		TRZ TAC,1
	CAME TAC,(NA)	;SAME?
	JRST NOSAML	;NO
	ADDI N,1
	ADDI NA,1
	CAMGE NA,PN	;DONE?
	JRST Q%LOP	;NO
	SETCMM Q%SV	;SAME, COMPLEMENT
NOSAML:	AOS N,Q%SV	;GET VALUE
	SETZM REPSW	;NO CR LF AT END
	PUSHJ P,REP	;DO IT
	JRST SCANM
↑REPSW:	0
Q%SV:	0
↑QIF%D:	HRREM N,Q%SV	;SAVE VALUE
	PUSHJ P,SCAN	;GET SYMBOL
	TLNN IFLG	;IDENT?
	JRST QERR	;NO
	MOVE NA,L	;GET SIXBIT
	IDIVI NA,HASH	;HASH
		MOVMS PN
	SKIPN PN,SYMTAB(PN);GET START OF CHAIN
	JRST QICOM	;NONE
		SRC1(L,PN,DFND,JRST QICOM)
DFND:	MOVE N,2(PN)	;GET FLAGS
	TDNN N,BLOCK	;THHS BLOCK?
	JRST QICOM	;NO
	TLNE N,DEFFL	;DEFINED?
	JRST QICOM	;NO
TR:	SETCMM Q%SV	;YES
FLS:	AOS N,Q%SV	;GET VALUE
	SETZM REPSW	;NO CR LF AT END
	PUSHJ P,REP	;DO IT
	JRST SCANM
QERR:	ERROR[ASCIZ/NOT IDENT AFTER IFDEF/]
	JRST SCANM
↑QIF%A:	HRREM N,Q%SV	;SAVE VALUE
	PUSHJ P,SCAN	;GET SYMBOL
	TLNN IFLG	;IDENT?
	JRST QERR	;NO
	MOVE NA,L	;GET SIXBIT
		IDIVI NA,HASH	;HASH
	MOVMS PN
	SKIPN PN,SYMTAB(PN);GET START
	JRST QICOM	;NONE
	SRC1(L,PN,AFND,JRST QICOM)
AFND:	MOVE N,2(PN)	;GET FLAGS
	TLNN N,DEFFL	;DEFINED?
	JRST TR		;YES
QICOM:	MOVE NA,L	;GET SIXBIT
	IDIVI NA,HASH	;HASH
	MOVMS PN
		SKIPN PN,MACRT(PN);GET START
	JRST QIOP	;NONE
	SRC1(L,PN,TR,JRST QIOP)
QIOP:	MOVE NA,L	;GET SIXBIT
		IDIVI NA,HASH	;HASH
	MOVMS PN
	SKIPN PN,OPCDS(PN);GET START
	JRST FLS	;NONE
	SRC2(L,PN,TR)
	JRST FLS
	SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP

;SCANS 	GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED AND
;	SYMBOLS ARE TO BE LOOKED UP


↑SCANS:	PUSHJ P,SCANM
	TLNN IFLG	;IDENT?
	JRST SPCCHK	;NO, SPC CHR.
ITS,<
	CAMN L,['.FNAM1']
	JRST [	MOVE N,SRCSTS+1
		MOVEI NA,0
		POPJ P,]
	CAMN L,['.FNAM2']
	JRST [	MOVE N,SRCSTS+2
		MOVEI NA,0
		POPJ P,]
>;ITS
	TLNN OPFLG	;HAS AN OPCODE BEEN SEEN?
	SKIPN PN,OPCDS(NA);GET START OF CHAIN
	JRST PT1	;NONE
	SRC2(L,PN,PT2)
PT1:	SKIPN TAC,SYMTAB(NA)
	JRST PT4		;NONE THERE AT ALL
	CAMN L,(TAC)
	JRST PT69		;IS FIRST, DON'T BOTHER TO MOVE
SR:	SKIPN PN,1(TAC)
	JRST PT4		;END OF LIST
	CAMN L,(PN)		;IF IT MATCHES
	JRST PT3
	SKIPN TAC,1(PN)		;ELSE TRY NEXT
	JRST PT4		;HERE IF SYM FOUND
	CAME L,(TAC)		;SEE US PLAY LEAPFROG WITH AC'S
	JRST SR			;KEEP LOOKING
	EXCH TAC,PN		;STRAIGHTEN OUT AC'S
;HERE PN IS SYM FOUND, AND TAC IS PREVIOUS SYM IN LIST
;SYM IS MOVED TO FRONT OF LIST TO FIND "POPULAR" SYMS FAST
PT3:	MOVE N,2(PN)
	TDNN N,BLOCK		;RIGHT BLOCK?
	JRST PT4		;NO - MUST NOT BE THERE
	EXCH N,1(PN)		;NEXT GUY
	EXCH N,1(TAC)		;DELINK & GET CURRENT (SAME AS PN)
	EXCH N,SYMTAB(NA)	;SWAP CURRENT WITH FIRST
	EXCH N,1(PN)		;AND POINT CURRENT AT REST OF LIST (RESTORING N)
PT69R:	SKIPE XCRFSW
	CREF6 1,(PN)
PT3B:	TRNE B,SHRPF!UDARF	;# OR ↑ NEXT?
	JRST VRHN	;YES
PT3A:	TLNE N,DEFFL	;DEFINED?
	JRST NODF	;NO
	TLON N,REFBIT
	MOVEM N,2(PN)	;SYM HAS NOW BEEN REFERENCED
	MOVE N,3(PN)	;YES,GET VALUE ...
	MOVE NA,4(PN)	;....
	POPJ P,
PT2:	TLO SOPF	;OPCODE FOUND
↑OPVAL:	MOVEI NA,	;ZERO NA
	HLLZ N,1(PN)	;GET FLAGS (VALUE)
	TLNN N,30	;REGULAR OPCODE?
	POPJ P,		;YES, RETURN
	JUMPL N,PSOP	;PSEUDO-OP?
IFN STANSW<
	TLZE N,10
	JRST CALLOP>
	MOVE N,3(PN)	;NO, GET VALUE
	MOVE NA,4(PN)	;...
	POPJ P,		;RETURN

PSOP:	TLO PSOPF	;PSEUDO-OP SEEN
	MOVE NA,2(PN)	;GET PSEUDO-OP ROUTINE ADDRESS
	MOVE N,3(PN)	;GET VALUE
	POPJ P,

IFN STANSW<
CALLOP:	ROT N,15
	CAML N,UCLDLN
	ADD N,SCLOFF
	HRLI N,(<CALLI>)
	POPJ P,>

↑MKNEW:	PUSH P,N	;SAVE
	PUSH P,NA
	PUSH P,L
	MOVE L,(PN)	;GET SIXBIT
	MOVE N,L
	IDIVI N,HASH	;HASH
	MOVMS NA
	PUSHJ P,PT4	;MAKE A PLACE
	POP P,L		;RESTORE
	POP P,NA
	POP P,N
	POPJ  P,
PT69:	MOVEI PN,(TAC)	;OOPS - WRONG AC
	MOVE N,2(PN)
	TDNE N,BLOCK
	JRST PT69R	;OK FOR THIS BLOCK
PT4:	GFST PN,FSTPNT	;GET SOME FREE STRG
	SKIPE XCRFSW
	CREF6 1,(PN)
	MOVEM L,(PN)	;DEPOSIT SIXBIT
	MOVE N,SYMTAB(NA);GET CURRENT POINTER
	MOVEM PN,SYMTAB(NA);REPLACE WITH POINTER HERE
	EXCH N,1(PN)	;POINT NEW TO OLD AND ...
	MOVEM N,FSTPNT	;ADVANCE FREE STRG PNT.
	SETZM 3(PN)	;NO FIXUPS YET
	SETZM 4(PN)	;NO POLFIX'S YET
	MOVSI N,DEFFL	;UNDEFINED
	OR N,BLOCK	;GET BLOCK BIT
PT4A:	TRNE B,SHRPF!UDARF	;# OR ↑ NEXT?
	JRST VARH	;YES
	MOVEM N,2(PN)	;SET FLAGS
	HLLZ NA,N
	MOVEI N,(PN)	;VALUE IS POINTER
	POPJ P,

EXHN:	PUSHJ P,MAKEXT
	MOVEM N,2(PN)
	JRST PT3B

EXTH:	PUSHJ P,MAKEXT
	JRST PT4A

MAKEXT:	PUSHJ P,SCAN1A
	MOVE L,(PN)	;RESTORE SIXBIT IN CASE LABEL
	TLNN N,DEFFL
	TLOA N,INTF
	TLO N,EXTF
	POPJ P,

NODF:	MOVE N,PN	;VALUE IS POINTER
	HLLZ NA,2(PN)
	POPJ P,
VRHN:	TRNE B,UDARF
	JRST EXHN
	SKIPE XCRFSW
	PUSHJ P,[MOVEI NA,2
		SKIPE LISTSW
		IDPB NA,CREFPT
		POPJ P,]
	PUSHJ P,SCAN1A	;PASS THE #
	TLNN N,DEFFL
	JRST PT3A	;ALREADY DEFINED, JUST LEAVE IT
	TLOE N,UDSF!VARF	;TURN ON AND CHECK
	JRST PT3P
	MOVEM N,2(PN)	;SAVE FLAGS
	GFST NA,FSTPNT		;GET FREE STORAGE
	MOVEM PN,(NA)		;SAVE PNTR TO SYMBOL
	MOVE N,VARLST
	MOVEM NA,VARLST		;PUT ON VARIABLE LIST
	EXCH N,1(NA)
	MOVEM N,FSTPNT
	SETZM 2(NA)	;MARK AS ONE WORD VARIABLE
	SKIPA N,2(PN)
PT3P:	MOVEM N,2(PN)	;SAVE FLAGS
	JRST PT3A

VARH:	TRNE B,UDARF
	JRST EXTH
	TLO N,VARF!UDSF	;SET # BIT
	MOVEM N,2(PN)	;& STORE
	PUSHJ P,SCAN1A	;PASS THE #
	SKIPE XCRFSW
	PUSHJ P,[MOVEI NA,2	;GIVE # TO CREF
		SKIPE LISTSW
		IDPB NA,CREFPT
		POPJ P,]
	GFST NA,FSTPNT
	MOVEM PN,(NA)
	MOVE N,VARLST
	MOVEM NA,VARLST
	EXCH N,1(NA)
	MOVEM N,FSTPNT
	SETZM 2(NA)	;ONE WORD
	HLLZ NA,2(PN)	;GET FLAGS
	MOVE N,PN	;VALUE IS POINTER
	POPJ P,		;RETURN
SPCCHK:	TLNN NFLG
	TLNN N,LBRF	;[ OR < OR . KLUDGE?
	POPJ P,		;NO
	TLNN SCFL
	JRST (N)
	PUSH P,EFSPNT
	MOVEM FS,EFSPNT
	ADD P,[XWD 12,12]
	JUMPGE P,PDLOV
	MOVSI TAC,PCNT	;PUSH PCNT & +1...
	HRRI TAC,-11(P)	; OPCNT & +1...
	BLT TAC,-4(P)	;& WRD & +1
	HRRZI TAC,-3(P)
	BLT TAC,(P)	;SAVE AC'S
	TLZ MLFT	;...0 TO 3
	TRNN N,TP1F	;[ OR <?
	JRST IRBO	;<?
	GFST T,FSTPNT	;GET FREE STRG.
	SETZM (T)	;ZERO COUNT
	GFST(N,<1(T)>)	;GET NEXT
	MOVEM N,2(T)	;DEPOSIT POINTER TO VALUE
	MOVEM N,OPCNT	;SET CURRENT LOC. TO IN CORE &...
	MOVEM N,PCNT	;HERE
	MOVSI TAC,INCF	;AND TO "IN CORE"
	MOVEM TAC,OPCNT+1;...
	MOVEM TAC,PCNT+1;...
	SETZM (N)	;ZERO REVERSE FIXUP POINTER FOR VALUE
	SETZM 2(N)	;NO FLAGS
	SETZM 3(N)	;NO BACK PNTR
	MOVE TAC,1(N)	;GET POINTER TO REST OF FREE STRG
	MOVEM TAC,FSTPNT	;& DEPOSIT
	SETZM 3(T)	;NO FIXUPS YET
	SETZM 4(T)	;...
	FOR QRN IN(LITPG,LITLIN,LABLTP,LABLTC,N,T)
<	PUSH P,QRN
	>
	SETZM LABLTP	;INIT FOR ANY LABELS...
	SETZM LABLTC	;IN THIS LITTERAL
	MOVE T,TLBLK
	MOVEM T,LITLIN
	MOVE T,PGNM
	MOVEM T,LITPG
TCALL:	ACALL	;CALL ASSEMBL
	SKIPN WRD+1	;EMPTY?
		JRST LEMP	;YES
	AOS @(P)	;COUNT # OF WORDS IN LIT.
	AOS LABLTC
LEMCON:	MOVE N,-1(P)	;GET POINTER TO VALUE
	MOVE TAC,WRD
	MOVEM TAC,3(N)	;SET VALUE...
	MOVE TAC,WRD+1
	MOVEM TAC,4(N)	;...
	TRZE TRBF	;TERM BY ]?
	JRST ANOBR	;YES
	GFST T,FSTPNT	;GET FREE STRG.
	MOVEM T,1(N)	;POINT TO HERE
	MOVEM N,3(T)	;POINT BACK
	MOVEM T,PCNT	;SET LOC...
	MOVEM T,OPCNT	;COUNTERS
	MOVE N,1(T)	;GET REST OF FREE STRG.
	MOVEM N,FSTPNT	;SET FSTPNT
	MOVEM T,-1(P)	;SET NEW POINTER
	SETZM (T)	;ZERO REVERSE FIXUP POINTER
		SETZM 2(T)	;NO FLAGS
	JRST TCALL
ANOBR:		SETZM 1(N)	;ZERO VALUE POINTER(NO MORE)
	POP P,NA
	MOVE T,LABLTP
	HRLM T,2(NA)	;STORE PNTR TO LABELS
	MOVE T,3(N)
	IDIVI T,HASH
	MOVMS FS
	MOVE O,LITPNT(FS)
	MOVEM NA,LITPNT(FS)
	PUSHJ P,LITCOM
	MOVEM O,1(NA)
	MOVE PN,NA
LITNUL:	MOVE T,-10(P)	;GET OLD FLAGS
	TDZ REFLAG
	AND T,REFLAG
	OR T		;RESTORE CERTAIN FLAGS
	TDZ [XWD NFLG!SCFL!PSOPF!SOPF,TRBF]
	TLO IFLG
	SUB P,[(1)1]
	POP P,LABLTC	;RESTORE OLD COUNT
	POP P,LABLTP	;RESTORE OLD
	POP P,LITLIN
	POP P,LITPG
	HRLZI N,-2(P)
	ADDI N,1
	BLT N,3		;RESTORE AC'S
	MOVSI N,-11(P)
	HRRI N,PCNT
		BLT N,PCNT+5	;RESTORE PCNT ETC.
	SUB P,[XWD 12,12]
	PUSHJ P,SCAN1	;GET A PEEK AT NEXT (FOR CALLER)
	TLO SFL		;BUT ONLY A PEEK
	MOVSI NA,DEFFL
	MOVE N,PN	;MARK AS UNDEFINED LABEL
	POP P,EFSPNT
	JUMPN N,.+3
	MOVEI NA,
	TLC IFLG!NFLG	;JUST GIVE 0 IF NULL
	POPJ P,
LEMP:	TRNN TRBF	;TERM BY > OR ]?
	JRST TCALL	;NO
	MOVE T,-1(P)	;PNTR TO VAL
	MOVE N,FSTPNT
	MOVEM N,1(T)
	MOVEM T,FSTPNT	;RETURN UNUSED BLK
	SKIPE N,3(T)	;GET LAST PNTR
	JRST ANOBR	;FINISH IT OFF
	ERROR[ASCIZ/NULL LITERAL/]	;OOPS
	POP P,PN
	MOVEM T,1(PN)
	MOVEM PN,FSTPNT	;RETURN HEADER
	MOVEI PN,
	JRST LITNUL

↑SCAN.:	MOVE N,DPCNT	;HERE FOR .
	MOVE NA,DPCNT+1
	TLO IFLG
	POPJ P,

↑SCAN$.:TLO IFLG	;HERE FOR $.
	MOVE N,OPCNT
	MOVE NA,OPCNT+1
	TLNN NA,INCF
	POPJ P,		;NOT IN LIT - EASY
	GFST PN,FSTPNT	;IN LIT - KLUDGE UP A PSEUDO LITLAB
	MOVEI T,
	EXCH T,1(PN)
	MOVEM T,FSTPNT
	SETZM (PN)	;THIS WILL DISTINGUISH IT
	SETZM 3(PN)
	SETZM 4(PN)
	MOVSI T,DEFFL!UDSF
	PUSHJ P,MAKLL
	MOVEI N,(PN)
	MOVSI NA,DEFFL!UDSF
	POPJ P,
IRBO:	PUSH P,[0]
	PUSH P,[0]
DRIBL:	TRO NOFXF	;NO FIXUPS
	ACALL
	TLNE AUNDF
	ERROR [ASCIZ /UNDEFINED WORD IN <>/]
	TRZN TRBF	;TERM BY ] OR >?
	JRST NIRBO	;NO
NEMP:	TLON SFL	;HAVE WE SCANNED AHEAD?
	PUSHJ P,SCAN	;NO, DO IT
	MOVE T,-5(P)	;GET OLD FLAGS
	TDZ REFLAG
	AND T,REFLAG	;RESTORE APPROPRIATE FLAGS
		OR T
	TDZ [XWD SOPF!SCFL!PSOPF!IFLG,TRBF]
	TLO NFLG
	MOVE N,WRD
	MOVE NA,WRD+1	;RETURN VALUE
	HRLZI L,-4(P)
	ADDI L,1
	BLT L,3		;RESTORE AC'S
	MOVSI L,-13(P)
	HRRI L,PCNT
	BLT L,PCNT+5	;RESTORE PCNT ETC.
	SUB P,[XWD 14,14]
	POP P,EFSPNT
	POPJ P,
NIRBO:	MOVEI N,-1(P)	;NO, SAVE VALUE
	HRLI N,WRD	;...
	BLT N,(P)	
SLOP:	TRO NOFXF	;NO FIXUPS
	ACALL
	TRZN TRBF	;TERM BY ] OR >?
	JRST SLOP	;NO
	MOVSI N,-1(P)	;PUT OLD VALUE...
	HRRI N,WRD	;IN...
	BLT N,WRD+1	;WRD
	JRST NEMP
↑REFLAG:XWD OPFLG!RELEF!MLFT!UNDF!ESPF!PAWF,NOFXF!IOSW!ADFL!FLFXF
BEGIN INP
;INP  USED BY SCAN TO GET NEXT BUFFER
NXTFL:	JSR EOF	;GET NEXT FILE IF ANY
	SETZM PGNM
	AOS PGNM
	SETZM SPGNM
	SETZM TLBLK	;FLUSH SOS LINE #
	HRROI TAC,[BYTE (7) 14]
	TRNE LDEV
	SKIPN XPNDSW
	SKIPA
	PUSHJ P,LOUT
IFN STANSW,<
↑↑TVSKIP:		;ROUTINE TO SKIP TVEDIT DIRECTORY COMPLETELY
	IN 2,		;READ FIRST REC
	JRST .+2
	JRST INP0	;LOSE
	MOVSI B,-LTVTXT
	MOVSI TAC,B
	ADD TAC,INPNT
	IBP TAC
TVSKP1:	MOVE C,@TAC	;SEE IF THIS IS A DIRECTORY
	XOR C,TVTXT(B)
	TDNN C,TVMSK(B)
	AOBJN B,TVSKP1
	JUMPL B,INP0A
TVSKP2:	IN 2,		;REALLY IS - SKIP TO NEXT RECORD BEGINNING WITH FF
	JRST .+2
	JRST INP0
	ILDB C,INPNT
	CAIE C,14
	JRST TVSKP2
	AOS PGNM	;WE ARE NOW ON PAGE 2
	SOS INPNT+1	;1 CHAR IS GONE
	JRST INP0A

TVTXT:	ASCII /COMMENT ⊗   VALID 00000 PAGES/
LTVTXT←←.-TVTXT
TVMSK:	ASCII /←←←←←←←←←←⊂⊂←←←←←←00000←←←←←←/
>;STANSW
↑↑INP:	INPUT 2,
NOITS,<
INP0:	STATZ 2,740000
	FATAL [ASCIZ \I/O ERROR ON INPUT\]
	STATZ 2,20000
	JRST NXTFL
INP0A:	MOVE B,INPNT
	IBP B
	HRRM B,INP1
	MOVE B,IDB+2
	MOVEM B+1,INTEM
	ADDI B,4
	IDIVI B,5
INP1:	ADDI B,
	MOVE B+1,[BYTE(7)177,0]
	MOVEM B+1,(B)
	MOVE B+1,INTEM
	POPJ P,
>;NOITS
ITS,<
	AOSN NEWFIL
	JRST NXTFL
	MOVE B,INPNT
	MOVEM B,INTEM
INP1:	SOSGE INPNT+1
	JRST EOB	;NO END OF FILE SEEN
	ILDB B,INTEM
	CAIN B,3	;↑C IS EOF CHARACTER
	JRST EOF
	CAIE B,177	;LOOK FOR RUBOUT
	JRST INP1
	OUTSTR [ASCIZ/
THERE IS A RUBOUT IN YOUR SOURCE FILE.  YOU SHOULD THINK
LONG AND HARD ABOUT WANTING IT THERE.  IT'S BEING IGNORED.
/]
	MOVEI B,0
	DPB B,INTEM	;OVER WRITE WITH NULL
	JRST INP1

EOB:	MOVEI B,200*5	;CHARACTER COUNT
	MOVEM B,INPNT+1
	MOVE B,[BYTE(7)177,0]
	MOVEM B,IBUF1+200
	POPJ P,

EOF:	MOVEI B,177	;MARK END OF BUFFER AS RUBOUT FOLLOWED BY NULL
	DPB B,INTEM
	MOVEI B,0
	IDPB B,INTEM
	MOVE B,INPNT+1
	SUBI B,200*5-1	;BL-(CC-1)-BL=BL-CC-(BL-1)
	MOVNS B		;WHERE BL=BLOCK LENGTH AND CC=CHARACTER COUNT
	MOVEM B,INPNT+1
	SETOM NEWFIL
	POPJ P,

↑↑NEWFIL:	0
>;ITS

INTEM:0

BEND INP

↑RESCN:	MOVE N,L	;GET SIXBIT
	IDIVI N,HASH	;HASH
	MOVMS NA
	JRST PT1

BEND SCAN
SUBTTL REVAL  -- EVALUATES EXPRESION INTO LIST-POLISH
BEGIN REVAL
↑REVAL:	MOVE O,FS	;INITIALIZE
		TLNE SCFL	;SPC CHR?
	JRST SPC1	;YES
	PUSH FS,N	;PUT NUM...
	PUSH FS,NA	;INT STRG
	TLNN B,ARFL	;ARITH OP COMING UP?
	JRST NOA1	;NO
	TLZ B,UNOF
REVALU:	MOVE T,B	
	TLO T,SNB	;MARK AS OPERATOR
	PUSH FS,FS	;STORE POINTER TO NUM...
	PUSH FS,T	;WITH OPERATOR
		HRRZ O,FS	;SET "OLD OP" POINTER
LOOP2:	PUSHJ P,SCANS	;GET A PREVIEW
LOOP4:	TLNN B,ENMF	;NOT A NUM COMING?
	JRST SPC2	;NOT A NUM COMING
	PUSHJ P,SCANS	;GET NEXT NUM
	HRRZ T,B
	TLNN B,ARFL	;ARITH OP COMING?
	MOVEI T,16	;NO,SET LEVEL=16
LOOP3:	CAIGE T,@(O)	;COMPARE NEW OP LEVEL WITH OLD
	JRST NLOW	;NEW ONE LOWER
	PUSH FS,N	;PUT NUM...
	PUSH FS,NA	;IN STRG
	HRLM FS,-1(O)	;AND POINT OLD OP AT IT
LOOP1:	CAML T,-1(P)	;COMPARE NEW OP WITH LIMIT
	JRST NGL	;NEW GREATER OR EQUAL LIMIT
	MOVE T,B	;MARK NEW OP ...
	TLO T,SNB	;AS OPERATOR
	TLZ T,UNOF
	PUSH FS,O	;POINT TO OLD OP
	PUSH FS,T	;WITH NEW
	HRRZ O,FS	;SET "OLD OP"
	JRST LOOP2
NGL:	MOVEM O,-1(P)	;RETURN "OLD OP"
	POPJ P,
NLOW:	PUSH P,O	;SAVE "OLD OP"
		MOVEI O,@(O)	;GET LEVEL OF OLD OP
	PUSH P,O	;USE AS LIMIT
	PUSHJ P,REVAL	;CALL REVAL
	MOVE O,-1(P)	;GET OD OP POINTER
	EXCH T,(P)	;GET RETURNED VALUE
	HRLM T,-1(O)	;POINT OLD OP AT IT
	POP P,T		;RESTORE T
	SUB P,[XWD 1,1]	;POP
	JRST LOOP1
SPC2:	TLNE B,UNOF	;UNARY OPERATOR?
	JRST UNAR	;YES
	TRNE B,LFPF	;(?
	JRST LFTP
	TRO POLERF	;SET ERROR FLAG
	ERROR [ASCIZ/ILLEGAL CHR AFTER OPERATOR/]
	JRST NGL	;RETURN
UNAR:	HRRI B,2	;MARK AS UNARY
	PUSH P,O	;SAVE OLD OP PNT
	MOVEI O,@(O)	;GET LEVEL OF OLD OP
	PUSH P,O	;USE AS LIMIT IN CALL
	PUSHJ P,REVALU	;CALL REVAL(OTHER ENTRANCE)
OLF:	MOVE O,-1(P)	;GET OLD OP
	EXCH T,(P)	;GET RETURNED VALUE
	HRLM T,-1(O)	;PNT OLD OP AT IT
	POP P,T		;RESTORE T
	SUB P,[XWD 1,1];POP
	JRST LOOP1
LFTP:	TLZ SFL		;IGNORE PAREN
	PUSHJ P,SCANS	;GET NEXT
	PUSH P,O	;SAVE O
	PUSH P,[16]	;SET LIMIT =16
	PUSHJ P,REVAL	;CALL REVAL
	MOVE O,-1(P)	;GET OLD OP
	EXCH T,(P)	;GET RETURNED VALUE
	HRLM T,-1(O)	;PNT OLD OP AT IT
	POP P,T		;RESTORE T
	SUB P,[XWD 1,1]
	TRNN B,RTPF	;RIGHT PAREN LAST THING?
	JRST NRP	;NO
	PUSHJ P,SCANS	;GET THE RIGHT PAREN FF.
		TLNN B,ARFL	;ARITH OP NEXT?
	JRST NGL	;NO
	HRRZ T,B	;YES, SET T ...
	CAIL T,@(O)	;COMPARE LEVEL
	JRST LOOP1	;AND PROCEED
	MOVE T,B
	TLO T,SNB
	TLZ T,UNOF
	PUSH P,O	;SAVE OLD OP
	HLRZ O,-1(O)	;GET RETURNED VALUE BACK
	PUSH FS,O	;POINT NEW OP AT IT
	PUSH FS,T	;PUSH OP
	HRRZ O,FS	;SET OLD OP
	HRRZ T,@(P)	;GET LEVEL
	PUSH P,T
	PUSHJ P,LOOP2
	JRST OLF
NRP:	TLON REUNBF	;SET UNBAL FLAG
	ERROR [ASCIZ/UNBAL PARENS/]
		TRO POLERF	;SET ERROR FLAG
	JRST NGL	;RETURN
SPC1:	TLNE N,UNOF	;UNARY OPERATOR?
	JRST UNAR1	;YES
	TRNE N,LFPF	;(?
	JRST LFTP1	;YES
	ERROR[ASCIZ/ILLEGAL CHR STARTS EXPRESSION/]
	TRO POLERF	;SET ERROR FLAG
	MOVEI T,16
		JRST NGL
UNAR1:	PUSH FS,FS	;PUSH ANY OLD THING
	HLLZ T,N
	OR T,[XWD SNB,2];MARK AS UNARY OP
	PUSH FS,T
	HRRZ O,FS
	JRST LOOP4
LFTP1:	PUSHJ P,SCANS	;GET
↑LFTP2:	PUSH P,[16]	;SET LIMIT=16
	PUSHJ P,REVAL	;GET VALUE
	POP P,O	;GET VALUE
	TRNN B,RTPF	;)?
		JRST NRP	;NO
	PUSHJ P,SCANS	;GET PAST THE )
	TLNE B,ARFL	;ARITH OP NEXT?
	JRST PARAR	;YES
	TLO O,SNB	;MARK VALUE AS "PARENS AROUND WHOLE"
	MOVEM O,-1(P)	;RETURN
		POPJ P,
↑PARAR:	PUSH FS,O	;POINT TO VALUE...
	MOVE T,B	;...
	TLO T,SNB	;...
	TLZ T,UNOF
	PUSH FS,T	;FROM CURRENT OP
	HRRZ O,FS	;SET OLD OP
	JRST LOOP2

NOA1:	HRRZM FS,-1(P)	;RETURN OPERAND
	MOVEI T,16	;SET LEVEL=16
	POPJ P,		;RETURN

BEND

;REDUC -- REDUCES THE LIST STRUCTURE POLISH
	;	POINTED TO BY FS


BEGIN REDUC
↑REDUC:	SKIPL (FS)	;SINGLE OPERAND?
	POPJ P,		;YES
	PUSH P,FS	;SAVE POINTER
	MOVE O,(FS)	;GET BITS
		TLNE O,UNOF	;UNARY OP?
	JRST PT1	;YES
		MOVE FS,-1(FS)	;GET POINTER TO FIRST OPERAND
	SKIPGE (FS)	;OPERATOR OR OPERAND?
	PUSHJ P,REDUC	;OPERATOR, REDUCE
PT1:	MOVE FS,(P)	;GET POINTER
	MOVS FS,-1(FS)	;GET POINTER TO SECOND OPERAND
	SKIPGE (FS)	;OPERATOR?
	PUSHJ P,REDUC	;YES, REDUCE
	MOVE FS,(P)	;GET POINTER
	MOVE O,(FS)	;GET BITS
	TLNE O,UNOF	;UNARY OP?
	JRST PT2	;YES
	MOVE O,-1(FS)	;GET PNTR TO FIRST OP
	SKIPGE FS,(O)	;OPERAND?
	JRST CPOP	;NO, CAN'T REDUCE
	TLNE FS,DEFFL	;DEFINED?
	JRST CPOP	;NO, CAN'T REDUCE
PT2:	MOVE FS,(P)	;GET PNTR.
	MOVS FS,-1(FS)	;GET PNTR TO SECOND OP
	SKIPGE T,(FS)	;OPERAND?
	JRST CPOP	;NO, CAN'T REDUCE
	TLNE T,DEFFL	;DEFINED?
	JRST CPOP	;NO, CAN'T REDUCE
	MOVE T,(P)	;GET POINTER
	MOVE T,(T)	;GET OPERATION
	DPB T,[POINT 5,T,4];TACK ARMD & ARMD1 ...
	LDB T,[POINT 7,T,6];ONTO LEVEL
	JRST @OPRT	;DO IT
RRETT:	POP P,FS	;GET POINTER
	MOVEM T,-1(FS)	;DEPOSIT VALUE
	MOVEM O,(FS)	;DEPOSIT BITS
	POPJ P,		;RETURN
CPOP:	POP P,O
	POPJ P,

OPRT:	@OPTB1(T)
OPTB1:	REPEAT 10,<0>
FOR QN IN (UNNOT,0,UNMIN,0,0,0,0,0,LSHF,0,0,0,0,0,0,0,<OROP>
,XROP,ANOP,0,0,0,0,0,MULOP,0,DIVOP,0,0,0,0,0,ADOP,O,SBOP)
<QN
>

DEFINE AROP(BOP,SPC1,SPC2,BTOP,MGNM,Q)
<	MOVE T,-1(O)	;GET SECOND OP
	SPC1
		BOP T,-1(FS)	;BOP FIRST OP
	SPC2
	MOVE O,(O)	;GET BITS FOR SECOND OP
	BTOP O,(FS)	;BTOP BITS FOR FIRST
	TRNE O,MGNM	;LEGAL RELOC?
	JRST CPOP	;NO
Q	DPB O,[POINT 4,(FS),35]
Q	MOVE O,(FS)	;GET NEW BITS
	JRST RRETT
>
ADOP:	AROP(ADD,,,ADD,12)
SBOP:	AROP(SUB,,,SUB,12)
MULOP:	AROP(IMUL,,,OR,17,<;>)
DIVOP:	AROP(IDIV,<MOVEM FS,TM>,<MOVE FS,TM>,OR,17,<;>)
ANOP:	AROP(AND,,,OR,17,<;>)
OROP:	AROP(OR,,,OR,17,<;>)
LSHF:	AROP(LSH @ ,<HRRZS -1(FS)>,,OR,17,<;>)
UNMIN:	MOVN T,-1(FS)	;NEGATE NUM
	MOVE O,(FS)	;GET BITS
	TRNE O,17	;RELOC LEGAL?
	JRST CPOP	;NO
	JRST RRETT
UNNOT:	SETCM T,-1(FS)	;INVERT NUM
	MOVE O,(FS)	;GET BITS
	TRNE O,17	;RELOC LEGAL?
	JRST CPOP	;NO
	JRST RRETT
XROP:	AROP(XOR,,,OR,17,<;>)
TM:	0

BEND
	SUBTTL MEVAL -- MAIN EVALUATER  -------

;MEVAL -- EVALUATES AN ADDRESS FIELD EXPRESSION & GENERATES
;FIXUPS.   RETURNS OPCODES UNTOUCHED.
;IF MLFT IS ON, GENERATES LEFT HALF FIXUPS INSTEAD OF RIGHT.

BEGIN MEVAL
↑MEVAL:	TLZ SOPF!PSOPF!PAWF!ESPF!UNDF
	MOVE FS,EFSPNT
	PUSHJ P,SCANS ;GET THING
	TLNE SCFL	;SPEC. CHR?
	JRST MSPEC	;YES
	TLNE NFLG	;NUM?
		JRST MNUM	;YES
	TRNE B,LACF	;TERM BY ← OR :?
	JRST DEFN	;YES
	TLNE SOPF	;OPCODE?
	TLOA OPFLG
MNUM:	TLOA OPFLG	;STOP OPCODE LOOKUP
	POPJ P,
	TLNE B,ARFL	;ARITH OP NEXT?
	JRST NONSIM	;YES
	TLNN NA,DEFFL	;DEFINED?
	POPJ P,		;YES
	TLO UNDF	;NO, SET BIT
	TRNE NOFXF	;GENERATE FIXUPS?
	POPJ P,		;NO
	MOVE T,OPCNT+1	;GET CURRENT OUTPUT LOC. COUNTER BITS
	TLNE T,INCF	;IN CORE?
	JRST NOTHER	;YES
	SKIPN O,3(PN)	;GET FIXUP POINTER
	JRST NOTHER	;NONE
LOOP1:	SKIPN (O)	;ZERO DEVIATION?
		JRST FND1	;YES, FOUND
LOOP2:	SKIPE O,1(O)	;END OF CHAIN?
	JRST LOOP1	;NO
NOTHER:	GFST O,FSTPNT	;GET SOME FREE STRG
		SETZM (O)	;ZERO DEVIATION
LOOP4:	MOVEM T,4(O)	;DEPOSIT CURRENT LOCAT. CNT.FLAGS
	MOVE TAC,OPCNT	;GET CURRENT LOC. CNT.
	MOVEM TAC,3(O)	;DEPOSIT
	SETZM 2(O)	;MAKE FLAGS
	TLNE MLFT	;LEFT HALF?
	JRST [AOS 2(O)	;YES SET BIT
		TLNE T,INCF	;IN CORE?
		MOVEM O,2(TAC)	;YES
		JRST SARND]
	TLNE T,INCF	;IN CORE?
	MOVEM O,(TAC)	;YES, SET REVERSE FIXUP PNTR.
	MOVEI T,2
	TRNE FLFXF	;FULL WORD FIXUPS?
	ORM T,2(O)	;YES, MARK
SARND:	MOVE T,3(PN)	;FIXUP PNTR.
	EXCH T,1(O)	;PUT NEW THINGS...
	MOVEM O,3(PN)	;INTO CHAIN
	MOVEM T,FSTPNT	;ADVANCE FREE STRG PNTR.
	SETZB N,NA	;VALUE IS 0
	HRRZS O
	POPJ P,
FND1:	MOVE TAC,4(O)	;GET NUM FLAGS
	TLNE TAC,INCF	;IN CORE?
	JRST LOOP2	;YES
	MOVE TAC,2(O)	;GET FLAGS
	TLNN MLFT	;LEFT HALF NOW?
	TRCN TAC,1	;IS THIS LEFT HALF?
	TRNN TAC,1	;OR THIS?
	JRST LOOP2	;NO MATCH
	TRNN FLFXF	;FULL WORD NOW?
	TRCN TAC,2	;IS THIS FULL WORD?
	TRNN TAC,2	;OR THIS?
	JRST LOOP2	;NO MATCH
FND1A:	MOVE N,OPCNT	;GET NEW...
	MOVE NA,OPCNT+1	;VALUE...
	EXCH N,3(O)	;AND SWITCH...
	EXCH NA,4(O)	;WITH OLD
	HRRZS O
	POPJ P,
NONSIM:	TLZ RELEF!REUNBF	;CLEAR FLAGS
	TLO OPFLG	;INHIBIT OPCODE LOOKUP
	MOVE FS,EFSPNT
NONSM2←.+2		;RET FROM REVAL
	RVALUA
	PUSHJ P,REDUC	;REDUCE TO VALUE IF POS.
	TLNE RELEF	;RELOC ERROR?
	ERROR [ASCIZ/RELOCATION ERROR/]
	POP P,FS	;GET POINTER TO POLISH
	SKIPGE FS	;PARENS AROUND WHOLE?
	TLO PAWF	;YES
	SKIPGE O,(FS)	;DEFINED?
	JRST NOTDF	;NO
	MOVE N,-1(FS)	;GET VALUE...
	MOVE NA,O	;AND VALUE FLAGS
	TLNE NA,DEFFL	;MAKE SURE UNDEF HAS BEEN SET RIGHT
	TLO UNDF
	POPJ P,
NOTDF:	TLO UNDF	;UNDEF.
	TRNE NOFXF	;GENERATE NO FIXUPS?
	POPJ P,		;NO
	HRRZ T,O	;GET LEVEL
	CAIE T,12	;+ OR -?
	JRST POLFIX	;NO
	MOVE PN,-1(FS)	;GET POINTER TO RIGHT ARG.
	MOVS T,PN	;GET POINTER TO LEFT ARG.
	SKIPGE N,(PN)	;GET RIGHT ARG -- OPERAND?
	JRST POLFIX	;NO
	SKIPGE NA,(T)	;GET LEFT ARG. -- OPERAND?
	JRST POLFIX	;NO
	TLNN NA,DEFFL	;LEFT ARG DEFINED?
	JRST OK1	;YES
	TLNE N,DEFFL	;RIGHT ARG DEFINED?
	JRST POLFIX	;NO
	TLNE O,ARMD	;+ OR -?
	JRST POLFIX	;-
	EXCH PN,T
	EXCH NA,N	;SWITCH ARGS
OK1:	TRNE NA,17	;ANY RELOC ON LEFT ARG?
	JRST POLFIX	;YES
	TLNN O,ARMD	;-?
	SKIPA NA,-1(T)	;NO, GET VALUE
	MOVN NA,-1(T)	;YES, GET NEGATIVE VALUE
	MOVE PN,-1(PN)	;GET SYMBOL TABLE POINTER
↑CCFIX:	MOVE T,OPCNT+1	;GET FLAGS
	TLNE T,INCF	;IN CORE?
	JRST NOF	;YES
	SKIPN O,3(PN)	;GET FIXUP CHAIN
	JRST NOF	;NONE
SRC:	SRC1(NA,O,FND2,JRST NOF)
↑DBLUP:	0
FND2:	MOVE TAC,4(O)	;GET NUM FLAGS
	TLNE TAC,INCF	;IN CORE?
	JRST SRC+2	;YES
	MOVE TAC,2(O)	;GET FLAGS
	TLNN MLFT	;LEFT HALF NOW?
	TRCN TAC,1	;IS THIS LEFT HALF?
	TRNN TAC,1	;OR THIS?
	JRST SRC+2	;NO MATCH, CONTINUE SEARCH
	TRNN FLFXF	;FULL WORD NOW?
	TRCN TAC,2	;IS THIS FULL WORD?
		TRNN TAC,2	;OR THIS?
	JRST SRC+2	;NO MATCH
	JRST FND1A
NOF:	GFST O,FSTPNT	;GET SOME FREE STRG.
	MOVEM NA,(O)	;STORE DEVIATION
	JRST LOOP4
MSPEC:	TDNN N,[XWD UNOF,LFPF!UDARF];( OR ↑ OR ↓ OR UNARY OP?
	JRST  [TLO OPFLG!ESPF
		POPJ P,]
	TRNE N,LFPF
	JRST IXTST		;( SEE IF INDEX
	TLNE N,UNOF
	JRST NONSIM		;UNARY OP
	SETZM	DBLUP		;NO DOUBLE UP ARROW YET.
	PUSH P,		;SAVE FLAGS
	PUSH P,N	;SAVE ↑ OR ↓
	TLO OPFLG	;INHIBIT OPCODE SEZRCH
MSPE2:	PUSHJ P,SCANS	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST	[TRNN N,TP2F ;ANOTHER ↑
		 JRST ERR1	;NO -- LOSE
		 SETOM DBLUP
		 JRST MSPE2]
	MOVEM L,LSTLAB+2;SAVE SIXBIT
	POP P,L		;GET ↑ OR ↓
	ANDI L,TP1F!TP2F;CLEAR REST
	TRNN B,LACF	;: OR ← NEXT?
	JRST ERR1	;NO
	TRNE B,TP1F	;← OR :?
	JRST LADF	;←
PTQ1:	MOVE N,LSTLAB+2;SET UP...
	MOVEM N,LSTLAB	;LABEL NAME AND...
	MOVE N,LSTLAB+3	;BLOCK FOR...
	MOVEM N,LSTLAB+1;ERROR MESSAGE PRINTER
	EXCH L,(P)	;GET OLD FLAGS, SAVE LABINS FLAGS
	ANDCA L,[XWD OPFLG,0];CLEAR ALL BUT OPFLG
	ANDCM L		;TURN OFF OPFLG IF IT WAS OFF
	MOVE N,PCNT	;GET CURRENT LOC...
	MOVE NA,PCNT+1	;...
	MOVEM N,LSTLAB+4;DEPOSIT FOR ERROR PRINT
	PUSHJ P,SCAN1A	;LOOK FOR ANOTHER :
	POP P,L		;GET BACK FLAGS FOR LABINS
	TLO L,COLONF	;MARK : TYPE
	TRNN B,LACF	;ANOTHER :?
	JRST .+3	;NO
	TLZ SFL		;SKIP SECOND :
	TLO L,DBLF	;MARK ←← TYPE (::)
	PUSHJ P,LABINS	;INSERT (DEFINE) LABEL
	SKIPE XCRFSW	;CREF?
	JRST	[SKIPN LISTSW	;LISTING?
		JRST .+1	;NO
		MOVEI N,2	;YES
		IDPB N,CREFPT
		JRST .+1]
	JRST MEVAL
ERR1:	SUB P,[1,,1]
	ERROR [ASCIZ/NO IDENT OR NO : OR ← AFTER ↑ OR ↓/]
	POP P,N
	ANDCA N,[XWD OPFLG,0];GETSTORE ...
	ANDCM N		;OLD OPFLG
	JRST MEVAL
DEFN:	PUSH P,		;SAVE OLD FLAGS
		TLO OPFLG	;INHIBIT OPCODE LOOKUP
	TLNE SOPF	;FOUD AS OPCODE?
	PUSHJ P,RESCN	;YES , FIND AS LABEL
	MOVEM L,LSTLAB+2;SAVE SIXBIT
	MOVEI L,	;NO FLAGS (NO ↑ OR ↓)
	TRNN B,TP1F	;← OR :?
	JRST PTQ1	;:
LADF:	MOVEI O,	;INITIALIZE COUNT
LLOP:	SKIPE XCRFSW	;CREF?
	JRST	[SKIPN LISTSW	;LISTING?
		JRST .+1	;NO
		MOVEI TAC,7	;YES DELETE PRVIOUS SYMBOL OUTPUT
		IDPB TAC,CREFPT
		JRST .+1]
	PUSH P,PN	;SAVE POINTER INTO SYMTAB
	PUSH P,L	;SAVE FLAGS
	ADDI O,1	;COUNT
	TLZ SFL		;SKIP THE ←
	CAIN C,"="	;IF CHAR WAS REALLY =
	JRST EQLDEF
LLOP1:	PUSHJ P,SCANS	;GET NEXT
		TLNE SCFL	;SPC CHR?
	JRST SCHAN	;YES
	TLNN IFLG	;IDENT?
	JRST LNMM	;NO, NUM
	TRNN B,LACF	;← OR : NEXT?
	JRST LNMM	;NO
	MOVEI L,	;YES
	JRST LLOP
SCHAN:	TRNN N,LACF	;← OR : NEXT?
	JRST SCNT	;NO
SCHLA:	MOVSI N,DBLF	;SET ←←
	ORM N,(P)	;...
	JRST LLOP1
SCNT:	TRNN N,UDARF	;↑ OR ↓?
	JRST LNMM	;NO
	PUSH P,N	;SAVE CHR.
	PUSHJ P,SCANS	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST ERR2	;NO
	TRNN B,LACF	;← OR :?
	JRST ERR2	;NO
	POP P,L		;GET ↑ OR ↓
	ANDI L,TP1F!TP2F	;CLEAR REST
	JRST LLOP
ERR2:	ERROR[ASCIZ/NO IDENT OR NO ← AFTER ↑ OR ↓/]
	JRST LLOP1	;TRY AGAIN

EQLDEF:	PUSHJ P,SCAN1	;KLUDGE TO MAKE == WORK
	CAIN C,"="
	JRST SCHLA	;IF VERY NEXT CHAR IS =, TREAT IT AS ←
	TLO SFL		;OTHERWISE REPROCESS IT NORMALLY
	JRST LLOP1
LNMM:	PUSH P,O	;SAVE COUNT
	MOVE FS,EFSPNT
	TLZ RELEF!REUNBF	;CLEAR FLAGS
	RVALUA
	PUSHJ P,REDUC	;REDUCE TO VALUE
	POP P,FS	;GET POINTER
	TLNE RELEF	;RELOC ERROR?
	ERROR[ASCIZ/RELOCATION ERROR/]
	SKIPGE NA,(FS)	;DEFINED?
	JRST [	ERROR[ASCIZ/UNDEFINED VALUE AFTER←/]
		MOVEI NA,;THIS IS TO FIX MYSTERIOUS BUG
		JRST .+1]
	TLZE NA,DEFFL	;DEFINED?
	JRST .-2	;NO , ERROR
	MOVE N,-1(FS)	;GET VALUE
	POP P,O		;GET COUNT
LLOP2:	POP P,L		;GET FLAGS
	POP P,PN	;GET POINTER
	SKIPE XCRFSW
	CREF6 1,(PN)
	PUSHJ P,LABINS	;INSERT DEFINITION
	SKIPE XCRFSW
	JRST	[MOVEI L,2
		SKIPE LISTSW
		IDPB L,CREFPT
		JRST .+1]
	SOJG O,LLOP2	;COUNT, DONE?
	EXCH N,WRD
	EXCH NA,WRD+1
	PUSHJ P,LBLOUT	;LIST VALUE
	MOVEM N,WRD
	MOVEM NA,WRD+1
	POP P,N		;YES, RESTORE OPFLG ...
	ANDCA N,[XWD OPFLG,0]	;...
	ANDCM	N	;...
	JRST MEVAL
;SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO
IXTST:	TLO OPFLG
	PUSHJ P,SCANS	;SEE WHAT FOLLOWS
	TRNE B,RTPF
	TLNE SCFL
	JRST IXTST2	;SPEC CHR AFTER ( OR NOT ) AFTER THAT
	PUSHJ P,SCAN1A
	TLNE B,ARFL
	JRST IXTST3	;ARITH OP AFTER )
	TLO PAWF	;HURRAY, IT'S AN INDEX
	TLNE B,SPFL
	JSR SPCSKP	;MAKE SURE WE'RE PAST BLANK
	TLNE NA,DEFFL
	TLO UNDF
	POPJ P,		;SEE HOW EASY THAT WAS

;HERE WE SIMULATE HAVING GOTTEN THIS FAR INTO REVAL
IXTST2:	TLZ RELEF!REUNBF
	MOVE FS,EFSPNT
	PUSH P,[16]
	PUSHJ P,LFTP2
	JRST NONSM2

;HERE WE SIMULATE HAVING GOTTEN EVEN FARTHER INTO REVAL
IXTST3:	TLZ RELEF!REUNBF
	MOVE FS,EFSPNT
	PUSH FS,N
	PUSH FS,NA
	MOVEI O,(FS)
	PUSH P,[16]
	PUSHJ P,PARAR
	JRST NONSM2
POLFIX:	MOVE T,MTBPNT	;GET NEXT FREE AREA
	MOVE N,OPCNT	;GET FIXUP LOCATION
LEG	MOVEM N,2(T)	;DEPOSIT
		MOVE O,OPCNT+1	;GET FLAGS
LEG	MOVEM O,3(T)	;DEPOSIT
	TLNN O,INCF	;IN CORE?
	JRST NOINCF	;NO
		TLNE MLFT	;LEFT HALF?
	JRST [HRROM T,2(N);YES -- SET REVERSE PNTR
	JRST NOINCF]
	HRROM T,(N)	;SET REVERSE POINTER
NOINCF:	SETZM 1(T)	;CLEAR COUNT
	HRRO O,T	;GET STRT POINTER
	ADDI T,5	;INCREMENT POINTER
	PUSHJ P,POLMOV	;MOVE POLISH
	SUBI T,1
	MOVEM T,MTBPNT	;UPDATE FREE AREA POINTER
	SUBI T,(O)		;FORM LENGTH
	TLNE MLFT	;LEFT HALF?
	TLO T,1		;YES
	TRNE FLFXF	;FULL WORD FIXUP?
	TLO T,2		;YES
	MOVSM T,(O)	;DEPOSIT
	SETZB N,NA	;"VALUE" IS 0
	SKIPE 1(O)	;NO UNDEFS?
	POPJ P,
	MOVE T,3(O)	;GET FIXUP LOC FLAGS
	TLNE T,INCF	;IN CORE?
	POPJ P,		;YES
	MOVE T,POLPNT	;GET CURRENT POINTER
	MOVEM T,1(O)	;PUT IN...
	HRRZM O,POLPNT	;CHAIN..
	POPJ P,
POLMOV:	SKIPL N,(FS)	;OPERATOR OR OPERAND?
	JRST OPRD	;OPERAND
LEG	MOVEM N,(T)	;DEPOSIT
	TLNE N,UNOF	;UNARY OP?
	JRST UNPT	;YES
	MOVE N,-1(FS)	;GET POINTERS
	ADDI T,2	;INCREMENT POINTER
LEG	MOVSM T,-3(T)	;DEPOSIT FIRST POINTER
	PUSH P,T	;SAVE NEW POINTER
	PUSH P,N	;SAVE OLD POINTER
	HLRZ FS,N	;SET NEW OLD POINTER
	PUSHJ P,POLMOV	;PUT IN FIRST OPERAND
	POP P,FS	;GET LEFT OPERAND OLD POINTER
	POP P,N		;GET OLD NEW POINTER
	HRRM T,-3(N)	;DEPOSIT NEW LEFT POINTER
	JRST POLMOV	;MOVE LEFT OPERAND
UNPT:	MOVE N,-1(FS)	;GET OPERANDS
		ADDI T,2
LEG	MOVSM T,-3(T)	;DEPOSIT NEW POINTER
	HLRZ FS,N	;SET UP POINTER
	JRST POLMOV
OPRD:	TLNN N,DEFFL	;DEFINED?
	JRST DEFND	;YES
LEG	MOVEM N,(T)	;DEPOSIT FLAGS
	MOVE N,-1(FS)	;GET "VALUE"
LEG	MOVEM N,-1(T)	;DEPOSIT
	MOVE NA,O	;GET STRT OF POLFIX
	HRLI NA,-1(T)	;GET POINTER
	EXCH NA,4(N)	;INSERT POLFIX IN CHAIN
LEG	MOVEM NA,1(T)	;...
	ADDI T,3	;INCREMENT
	AOS 1(O)		;COUNT UNDEF SYMBOL
	POPJ P,
DEFND:	LEG	MOVEM N,(T)	;DEPOSIT FLAGS
	MOVE N,-1(FS)	;GET VALUE
LEG	MOVEM N,-1(T)	;DEPOSIT
	ADDI T,2	;INCR. POINTER
	POPJ P,
BEND
BEGIN LABINS

COMMENT +
LABINS	-- CALL, TO DEFINE A LABEL, WITH THE VALUE
	IN N & NA, THE POINTER TO THE TABLE ENTRY IN
	PN  AND FLAGS (AS FOLLOWS) IN L (LH SAME AS IN SYM)
	RH:	TP1F -- ↓
		TP2F -- ↑
	LH:	DBLF -- ←← OR ::
		COLONF -- : TYPE (ERR ON REDEF)
+
↑↑LVDEF:MOVEI L,	;HER TO DEFINE LITERALS & VARIABLES
	MOVSI T,UDSF!VARF
	ANDCAB T,2(PN)
↑↑LABINS:
	HLLZ T,L
	IOR T,2(PN)	;GET FLAGS
	TLZE T,EXTF
	TLO T,INTF	;TURN EXTERNAL → INTERNAL IF DEFINED
	TLNE T,UDSF	;UNDEFINED - DEFINED
	JRST ERR	;YES
	TLZN T,DEFFL	;DEFINED?
	JRST DEFD	;YES
	TRNE L,TP1F	;↓?
	OR T,DBLCK
	TRNE L,TP2F	;↑?
	TLO T,UPARF	;YES
	SKIPE	DBLUP
	TLO T,DBLUPF	;DOUBLE UP ARROW FLAG.
	TLNE NA,INCF	;IN CORE VALUE
	JRST LILHN	;YES
	MOVEM T,2(PN)
	EXCH N,3(PN)	;SWITCH VALUE WITH FIXUP POINTER
	EXCH NA,4(PN)	;SWITCH VALUE FLAGS WITH POLFIX PNTR.
	JUMPE N,NOFX	;NO FIXUPS?
	PUSHJ P,GFIX
	JRST NOFX
LILHN:	TLO T,DEFFL!UDSF;MARK AS UNDEFINED - DEFINED
↑MAKLL:	MOVEM T,2(PN)	;DEPOSIT FLAGS
	GFST T,FSTPNT
	MOVE FS,LABLTP	;GET POINTER TO LIST OF LIT. LABS
	EXCH FS,1(T)	;CONS ON
	MOVEM FS,FSTPNT
	MOVEM T,LABLTP
	MOVE FS,(PN)	;GET SIXBIT
	MOVEM FS,(T)	;DEPOSIT
	MOVE FS,LABLTC	;GET COUNT
	MOVEM FS,3(T)	;DEPOSIT
	MOVEM PN,4(T)	;THE LOCATION OF THE SYMBOL BLOCK
	POPJ P,
;GFIX:	CALL WITH POINTER TO DEFINED SYMBOL IN PN AND
;   FIRST FIXUP POINTER IN N.   USES T,FS,L,TAC

↑GFIX:	MOVSI T,REFBIT
	IORM T,2(PN)	;MUST BE REFERENCED IF FIXUP NEEDED
	MOVE FS,4(PN)	;GET FLAGS
LOOP1:	MOVE TAC,2(N)	;GET FIXUP FLAGS
	MOVE L,4(N)	;GET VALUE FLAGS
	MOVE T,3(PN)	;GET VALUE
		ADD T,(N)	;ADD DEVIATION
	TRNE TAC,2	;FULL WORD?
	JRST FULFX	;YES
	DPB L,[POINT 1,FS,34];SET LEFT HALF RELOC BIT
	HRL T,3(N)	;PUT IN POINTER
	TLNE L,INCF	;IN CORE?
	JRST INCFX	;YES
	TRNE TAC,1	;LEFT HALF?
	FOUT LFX	;YES
	FOUT T		;OUTPUT FIXUP
LOOP2:	MOVE L,FSTPNT	;PUT BACK ON ...
	MOVE FS,4(PN)	;GET RELOC FLAGS BACK
	EXCH L,1(N)	;FREE ...
	MOVEM N,FSTPNT	;STRG
	SKIPE N,L	;GET NEXT, DONE?
	JRST LOOP1	;NO
	POPJ P,
FULFX:	TLNE L,INCF	;IN CORE?
	JRST FINCFX	;YES
	HRLM T,FULF+3	;DEPOSIT VALUE
	HLRM T,FULF+2	;...
	DPB FS,[POINT 1,FULF+1,2];DEP. RELOC.
	LSH FS,-2
	DPB FS,[POINT 1,FULF+1,1];...
	MOVE T,3(N)	;GET FIXUP PLACE
		HRLM T,FULF+4	;DEPOSIT
	DPB L,[POINT 1,FULF+1,4];DEP. RELOC.
		PUSHJ P,BFRC	;FORCE OUT BIN
	POUT 5,FULF	;OUTPUT POLFIX
	JRST LOOP2
FULF:	XWD 11,3
		0
	XWD 1,0
	XWD 0,-3
	0
FINCFX:	MOVE TAC,3(N)	;GET PLACE
	MOVEM T,3(TAC)	;DEPOSIT VALUE...
	ORM FS,4(TAC)	;& RELOC.
	SETZM (TAC)
	JRST LOOP2
INCFX:	TRNE TAC,1	;LEFT HALF?
	JRST LINCFX	;YES
	MOVS TAC,T
	HRRM T,3(TAC)	;DEPOSIT VALUE
	DPB FS,[POINT 1,4(TAC),35];DEPOSIT RELOC.
	SETZM (TAC)	;ZERO REVERSE POINTER
		JRST LOOP2
LINCFX:	MOVS TAC,T
	HRLM T,3(TAC)	;DEPOSIT VALUE
	DPB FS,[POINT 1,4(TAC),33];DEPOSIT RELOC.
	SETZM 2(TAC)	;ZERO REVERSE POINTER
	JRST LOOP2
NOFX:	JUMPE NA,NOPFX	;POLFIXES?
	MOVE N,NA
	PUSHJ P,PFIX
NOPFX:	MOVE N,3(PN)	;RESTORE N ...
	MOVE NA,4(PN)	;AND NA
	MOVE T,2(PN)	;GET FLAGS
	TLNN T,SYMFIX	;SEE IF SYMBOL TABLE FIXUP NEEDED
	POPJ P,		;NO
	MOVE FS,1(PN)	;BLOCK NAME
	PUSHJ P,R5CON
	MOVEM FS,SYMFXP+5
	MOVE FS,(PN)	;SYMBOL NAME
	PUSHJ P,R5CON
	MOVEM FS,SYMFXP+4
	MOVE N,3(PN)
	HLRM N,SYMFXP+2	;VALUE IN 2 HALVES
	HRLM N,SYMFXP+3
	DPB NA,[POINT 1,SYMFXP+1,2]	;RELOC
	LSH NA,-2
	DPB NA,[POINT 1,SYMFXP+1,1]
	POUT 6,SYMFXP
	MOVE NA,4(PN)	;GET RELOC BACK
	POPJ P,
↑SYMFXP:	XWD 11,4
	0
	XWD 1,0
	XWD 0,-6
	BLOCK 2
LFX:	-1	;WORDS FOR LEFT HALF FIXUP
	0
DAREDF:	MOVE FS,BLOCK	;GET BLOCK BIT
	TRNE L,TP2F
	LSH FS,-1
	SKIPE DBLUP
	MOVEI FS,1
	SUBI FS,1	;FORM ALL HIGHER BLOCK BITS
	AND FS,T	;ANY HIGHER LEVEL BITS ON
	JUMPE FS,DEFD1	;NO
	SKIPE XCRFSW
	JRST	[MOVEI FS,7
		SKIPE LISTSW
		IDPB FS,CREFPT
		JRST .+1]
	PUSHJ P,MKNEW	;CREATE A NEW ENTRY
	ERROR [ASCIZ /WARNING - ↓ SYMBOL REDEFINED/]
	JRST LABINS
DEFD:	TLNE T,DAF	;DOWN ARROW
	JRST DAREDF	;YES
DEFD1:	TLZ T,UPARF	;CLEAR UPARROW BIT
	TLNN T,COLONF
	TLNE L,COLONF
	JRST CHKDEF	;PROBABLY ERR IF EITHER NEW OR OLD IS : TYPE
DEFOK:	TRNE L,TP1F	;↓?
	OR T,DBLCK
	TRNE L,TP2F	;↑?
	TLO T,UPARF	;YES
	SKIPE DBLUP
	TLO T,DBLUPF
	MOVEM T,2(PN)	;STORE FLAGS
	MOVEM N,3(PN)	;DEPOSIT VALUE
	MOVEM NA,4(PN)	;...
	POPJ P,

CHKDEF:	CAMN N,3(PN)
	CAME NA,4(PN)
	JRST ERR
	JRST DEFOK	;NOT ERR IF REDEF WITH SAME VAL

ERR:	ERROR[ASCIZ/MULTIPLE DEFINITION/]
	POPJ P,
;PFIX:	CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH
;	FIXUP CHAIN POINTER IN N.   USES T,FS,TAC,L

↑PFIX:	MOVSI T,REFBIT
	IORM T,2(PN)	;INDICATE REFERENCED
PFIX1:	MOVS T,N	;GET OPERAND POINTER
	MOVE FS,3(PN)	;GET VALUE
	MOVEM FS,(T)	;DEPOSIT
	MOVE FS,4(PN)	;GET FLAGS
	MOVEM FS,1(T)	;DEPOSIT
	MOVE FS,2(T)	;SAVE NEXT...
	MOVEM FS,T2SAV	;POINTER
	SOSLE 1(N)	;DECREMENT UNDEF SYM COUNT
	JRST SUL	;Some Undefs. Left
	MOVEI FS,5(N)	;GET START OF POLISH
	PUSH P,O	;SAVE O
	PUSHJ P,REDUC	;REDUCE
	POP P,O		;RESTORE O
	SKIPGE FS,5(N)	;VALUE OR OPERATOR?
	JRST PLOUT	;OPERATOR
	MOVE L,3(N)	;GET FIXUP FLAGS
	TLNE L,INCF	;IN CORE FIXUP?
	JRST PINC	;YES
	MOVE TAC,(N)	;GET LEFT HALF FLAG
	TRNE TAC,2	;FULL WORD?
	JRST PFULX	;YES
	TRNE TAC,1	;LEFT HALF FIXUP?
	FOUT LFX	;YES
	MOVE T,4(N)	;GET VALUE
	HRL T,2(N)	;GET FIXUP
	DPB L,[POINT 1,FS,34];DEPOSIT FIXUP RELOC
	FOUT T		;PUT OUT FIXUP
PPT1:	PUSH P,B	;SAVE
	PUSH P,C
	HRRZ C,N	;GET START ADDRESS
	HLRZ B,(N)	;GET LENGTH
	ADD B,C		;GET END
	PUSHJ P,MACRET	;RETURN SPACE
	POP P,C		;RESTORE
	POP P,B
SUL:	SKIPE N,T2SAV	;GET NEXT POLFIX
	JRST PFIX1
	POPJ P,		;NO MORE
PFULX:	MOVE T,4(N)	;GET VALUE
	HLRM T,FULF+2	;DEPOSIT
	HRLM T,FULF+3	;...
	DPB FS,[POINT 1,FULF+1,2];DEPOSIT RELOC
	LSH FS,-2
	DPB FS,[POINT 1,FULF+1,1]
	MOVE T,2(N)	;GET FIXUP
		HRLM T,FULF+4	;DEPOSIT
	DPB L,[POINT 1,FULF+1,4];DEPO. RELOC
	PUSHJ P,BFRC	;FORCE OUT BIN
	POUT 5,FULF	;PUT OUT FIXUP
	JRST PPT1
PINF:	MOVE T,4(N)	;GET VALUE
		MOVE TAC,2(N)	;GET LIT LOC
	MOVEM T,3(TAC)	;DEPOSIT VALUE
	ORM FS,4(TAC)	;DEPOSIT RELOC
	SETZM (TAC)
	JRST PPT1
PINC:	MOVE TAC,(N)	;GET FLAGS
	TRNE TAC,2	;FULL WORD?
	JRST PINF	;YES
	TRNE TAC,1	;LEFT HALF?
	JRST PINCL	;YES
	MOVE TAC,2(N)	;GET LIT LOC.
	MOVE T,4(N)	;GET VALUE
	HRRM T,3(TAC)	;DEPOSIT
		SETZM (TAC)	;CLEAR REVERSE POINTER
	DPB FS,[POINT 2,4(TAC),35];DEP RELOC.
	JRST PPT1
PINCL:	MOVE TAC,2(N)	;GET LIT LOC.
	MOVE T,4(N)	;GET VALUE
	HRLM T,3(TAC)	;DEPOSIT
	SETZM 2(TAC)	;CLEAR REV. PNTR.
	DPB FS,[POINT 2,4(TAC),33];DEP RELOC.
	JRST PPT1
HALOUT:	HRROM L,HALP1	;DEPOSIT RIGHT HALF OF POINTER
	SETCMM HALP1	;AND COMPLEMENT IT
	IBP L		;INCREMENT RELOC POINTER
		TDNE L,HALP1	;DID IT GO TO NEXT WORD?
	JRST HALP2	;YES
HALRET:	LEG	IDPB TAC,HALP3	;DEPOSIT HALFWORD
	MOVSS TAC
LEG	DPB TAC,L	;DEPOSIT RELOC
	AOS HALP4	;COUNT
	POPJ P,
HALP2:	ADDI L,=18	;INCREMENT RELOC POINTER
	AOS HALP3	;INCREMENT HALFWORD POINTER
	JRST HALRET
T2SAV:	0
HALP1:	0
HALP3:	0
HALP4:	0
PLOUT:	MOVE L,3(N)	;GET FIXUP FLAGS
		TLNE L,INCF	;IN CORE?
	JRST SUL	;YES
	MOVEI FS,5(N)
	PUSHJ P,POLOUT
	JRST PPT1
↑POLOUT:	HRRZ L,MTBPNT	;GET A FREE PLACE TO PUT FIXUP
	PUSH P,N	;SAVE N
	ADD L,[XWD 442200,2];MAKE HALFWORD POINTER
	SETZM HALP4	;ZERO COUNT
	MOVEM L,HALP3	;DEPOSIT
	ADD L,[440100000001-442200000002];MAKE RELOC POINTER
	PUSHJ P,PPFFXX	;DO FIXUP
		POP P,N		;GET N
	HRRZ T,(N)	;GET FLAGS
	MOVN TAC,T	;FORM...
	ADDI TAC,-1	;STORE OP
	PUSHJ P,HALOUT	;OUTPUT IT
	MOVE TAC,2(N)	;GET FIXUP
	HRL TAC,3(N)	;& RELOC
	PUSHJ P,HALOUT	;OUTPUT IT
	MOVE T,MTBPNT	;GET START
	MOVE FS,HALP4	;GET COUNT
	ADDI FS,1
		LSH FS,-1	;FORM REAL COUNT
	HRLI FS,11	;BLOCK TYPE
LEG	MOVEM FS,(T)	;DEPOSIT
	PUSHJ P,BFRC	;FORCE OUT BINARY
	MOVN TAC,HALP3	;FORM...
	ADDI TAC,-1(T)	;LENGTH
	HRL TAC,T	;GET START
	MOVSM TAC,HALP3
	BBOUT HALP3
	POPJ P,		;RETURN

	DEFINE TBB (A)
<	IFL A-10,<FOR Q1←1,A
	<	0
>
>
	IFGE A-10,<A/10>
>
PPTAB:	FOR Q IN (7,1,130,1,140,5,110,7,100,120,70,5,<50>
	,1,60,5,30,1,40)
<TBB (Q)
>

PPTT1:	MOVS FS,-1(FS)	;GET ARG POINTER
PPFFXX:	SKIPL T,(FS)	;OPERAND OR OPERATOR?
	JRST POPND	;OPERAND
	DPB T,[POINT 5,T,4];FIND OUT WHAT...
	LDB T,[POINT 7,T,6];OPERATOR IT...
	MOVE TAC,PPTAB(T);IS
	PUSHJ P,HALOUT	;OUT OUT OPERATOR
	MOVE T,(FS)
	TLNE T,UNOF	;UNARY OP?
	JRST PPTT1	;YES
	MOVE FS,-1(FS)	;GET FIRST ARG POINTER
	PUSH P,FS	;SAVE
	PUSHJ P,PPFFXX	;PUT OUT
	MOVS FS,(P)	;GET SECOND ARG POINTER
	SUB P,[1(1)]
	JRST PPFFXX	;PUT OUT & RETURN
POPND:	TLNE T,DEFFL	;DEFINED?
	JRST POPUN	;NO
	MOVE TAC,-1(FS)	;GET VALUE
	TLNN TAC,-1	;SHORT OR LONG WORD?
	TRNE T,14	;LEFT RELOC?
	JRST POPLNG	;LONG
	MOVEI TAC,	;GET FLAGS
	PUSHJ P,HALOUT	;PUT OUT
	MOVE TAC,-1(FS)	;GET WORD
	DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
	JRST HALOUT	;PUT OUT HALFWORD & RETURN
POPLNG:	LDB N,[POINT 2,T,32];GET LEFT RELOC
	MOVEI TAC,1
	PUSHJ P,HALOUT
		MOVS TAC,-1(FS)
	HRL TAC,N
	PUSHJ P,HALOUT	;PUT OUT LEFT HALF
	HRRZ TAC,-1(FS)	;GET RIGHT HALF
	DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
	JRST HALOUT	;PUT IT OUT & RETURN
POPUN:	MOVEI TAC,2
	PUSHJ P,HALOUT
	MOVE N,-1(FS)	;GET POINTER
	MOVE FS,(N)	;GET SIXBIT
	PUSHJ P,R5CON	;CON TO RADIX50
	TLO FS,40000	;MARK AS EXTERNAL (POLISH TYPE)
	HLRZ TAC,FS	;PUT OUT LEFT HALF
	PUSHJ P,HALOUT
	HRRZ TAC,FS	;PUT OUT RIGHT HALF...
	JRST HALOUT	;AND RETURN
BEND
SUBTTL ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE
;	CALLED IN A STRANGE FASHION BECAUSE IT IS
;	RECURSIVE AND A CO-ROUTINE

BEGIN ASSMBL
	↑NONEM←←10	;TEMP BIT USED TO MAKE NONZERO INDICATION
↑RBARET:TRO TRBF	;TERM BY ]
	TRNE NOFXF	;NO FIXUPS?
	JRST ARET	;YES, DONT LIST
	SKIPE WRD+1
	PUSHJ P,BLOUT
↑ARET:	RETN
↑ASSMBL:TDZ[XWD OPFLG!AUNDF,ADFL!TRBF!IOSW]
	SETZM WRD	;CLEAR WRD
	SETZM WRD+1
LOOP1:
LOOP2:	SKIPN WRD+1	;EMPTY SO FAR?
	TRO FLFXF	;YES, TELL MEVAL TO GENERATE FULL WORD FIXUPS
		PUSHJ P,MEVAL	;GET NEXT THING
	TRZ FLFXF
	TLNE SOPF	;OPCODE?
	JRST OPCD	;YES
	TLNE ESPF	;SPC CHR?
	JRST SPCL	;YES
	TLNE PAWF	;()?
	JRST IXFLD	;YES
	TRNE B,COMF	;TERM BY ,?
	JRST ACFLD	;YES
	TROE ADFL	;ALREADY GOT AN ADDRESS?
	JRST LERRA	;YES
	TLNE UNDF	;DEFINED?
	TLO AUNDF	;NO
	SKIPN WRD+1	;ANYTHING YET?
	JRST EMP	;NO
	HRRM N,WRD	;DEPOSIT AS ADDRESS
	ANDI NA,1	;GET RELOCATION
LOOP69:	ORM NA,WRD+1	;DEPOSIT
	JRST LOOP2	
EMP:	MOVEM N,WRD	;DEPOSIT VALUE
	HLL NA,		;GET AUNDF FLAG (MEANS FW FIXUP GENERATED)
	AND NA,[AUNDF,,5]	;ISOLATE FLAG & RELOCATION
	TLO NA,NONEM	;SET "NON EMPTY"
	MOVEM NA,WRD+1	;DEPOSIT
	JRST LOOP2	
LERRA:	ERROR[ASCIZ/TWO ADDRESS FIELDS OR UNDEF OPCODE/]
	JRST LOOP1	;NO OR NO
OPCD:	SKIPN XCRFSW	;CREF?
	JRST OPCD2
	MOVE FS,1(PN)	;PN STILL POINTS TO ENTRY, GET FLAGS
	JUMPL FS,ORDOP
	TLNN FS,20	;IS IT REGULAR TYPE?
	JRST ORDOP	;YES
	HRRZ FS,2(PN)	;BLOCK BITS
	JUMPE FS,ORDOP
	CREF6 5,(PN)	;OPDEF, PUT OUT AS MACRO
	SKIPA
ORDOP:	CREF7 3,L	;YES
OPCD2:	TLNE PSOPF	;PSEUDO OP?
	JRST (NA)	;YES
↑OPCDR:	MOVEM N,WRD	;DEPOSIT IN WRD
		TLO NA,NONEM	;SET NON-EMPTY
	MOVEM NA,WRD+1	;DEPOSIT
	JRST LOOP2
IXFLD:	TLNE UNDF	;DEFINED?
	ERROR[ASCIZ/UNDEFINED INDEX FIELD/]
	MOVSS N
	TRNE N,-1	;RIGHT HALF ZERO?
	TRON ADFL	;GOT AN ADDRESS?
	SKIPA
	TRZ N,-1	;YES
	ORM N,WRD	;OR INTO WRD
	TRZE NA,17	;RELOC?
	ERROR [ASCIZ/RELOCATABLE INDEX FIELD/]
	TLOA NA,NONEM	;SET "NON-EMPTY"
ACFL2:	DPB N,[270400,,WRD]	;STORE AC FIELD
ACFL3:	ORB NA,WRD+1	;OR IN, GET OLD FLAGS
	TLNE NA,AUNDF
	ERROR [ASCIZ /AC OR INDEX FIELD CLOBBERED BY FIXUP/]
	JRST LOOP1

ACFLD:	PUSHJ P,SCAN1A	;GET NEXT
	TRNE B,COMF	;ANOTHER ,?
	JRST CCOM	;YES
	TLNE UNDF	;DEFINED?
	ERROR[ASCIZ/UNDEFINED AC FIELD/]
	TRZE NA,17	;RELOC?
	ERROR[ASCIZ/RELOC AC FLD/]
	TLO NA,NONEM	;SET "NON-EMPTY"
	TRNN IOSW	;IO OP?
	JRST ACFL2	;NO
	LSH N,-2
	DPB N,[POINT 7,WRD,9]
	JRST ACFL3
CCOM:	TLZ SFL		;SKIP THE ,
	SKIPE WRD+1	;ANYTHING ASSEMBLED YET?
	ERROR [ASCIZ /ILLEGAL ,,/]	;YES -- COMPLAIN
	TLNN UNDF	;UNDEFINED?
	JRST CCOM2	;NO -- JUST STORE VALUE
	TLO AUNDF	;YES -- TELL SOMEONE
	JUMPL O,CCPOL	;HAVE WE SCREWED POLISH FIXUPS?
	MOVE T,4(O)	;NO -- REGULAR
	JUMPE NA,CCFOK	;OK IF NEW FIXUP CREATED
	MOVEM N,3(O)	;RESTORE
	MOVEM NA,4(O)	;OLD VALUE
	MOVE NA,(O)	;LINKED TO WRONG THING -- GET OFFSET
	TLO MLFT	;LET'S DO IT LEFT THIS TIME
	PUSHJ P,CCFIX	;HAVE TO DO THIS OVER AGAIN
	JRST CCOM2	;NOW FINISH

CCFOK:	MOVEI T,1	;LH ONLY
	DPB T,[(200)2(O)]	;FIX FLAGS
	MOVE T,4(O)	;SEE IF
	TLNN T,INCF	;IN CORE
	JRST CCOM2	;NO -- OK
	MOVE T,3(O)	;YES -- WHERE?
CCRFX:	SETZM (T)	;NO LONGER RH
	MOVEM O,2(T)	;NOW LH REV PNTR
	JRST CCOM2	;NOW STORE

CCPOL:	MOVEI T,1	;LH ONLY
	DPB T,[(200+O)]	;FIX FLAGS IN FIXUP
	MOVE T,3(O)	;SEE WHAT IT'S FOR
	TLNN T,INCF	;SOMETHING IN CORE?
	JRST CCOM2	;NO -- ALL DONE
	MOVE T,2(O)	;YES -- FIND OUT WHERE
	JRST CCRFX	;NOW FIX REV PNTRS
CCOM2:	HRLM N,WRD	;STORE LH
	DPB NA,[20200,,NA]	;MOVE RELOC BITS
	TRZ NA,3	;& FLUSH FROM RH
	TLO NA,NONEM	;SOMETHING THERE
	TLO OPFLG	;STOP OPCODE LOOKUP
	JRST LOOP69	;SET FLAGS & GO ON
SPCL:	TLNE N,CRFG!LNFD;CR?
	JRST SCR	;YES
	TRNE N,ATF	;@?
	JRST SAT
	TLNE N,RBRF	;> OR ]?
	JRST RBARET	;YES, RETURN
	MOVSI NA,NONEM	;PREPARE TO MAKE NON-EMPTY
	TRNE N,COMF	;IF COMMA
	JRST LOOP69	;CAUSE 18-BIT TRUNCATION
		ERROR[ASCIZ/UNREC SPC CHR/]
	JRST LOOP1
↑ASCR:
SCR:	TRNE NOFXF	;NO FIXUPS TO BE GEN'D?
	JRST .+3	;YES, DON'T LIST BINARY
	SKIPE WRD+1	;ANYTHING?
	PUSHJ P,BLOUT	;YES, DEPOSIT BINARY
	TLNN N,LNFD	;LINE FEED?
	PUSHJ P,SCNTIL	;NO, SKIP TO IT
	JRST ARET

SAT:	MOVSI N,20	;GET @ BIT
	MOVSI NA,NONEM	;GET NON-EMPTY BIT
	ORM N,WRD	;DEPOSIT
	ORM NA,WRD+1	;...
	JRST LOOP1
BEND
	SUBTTL  PSEUDO-OP ROUTINES
BEGIN POPS
↑%BLOCK:MOVE N,OPCNT+1	;ILLEGAL IN LIT
	TLNE N,INCF
	JRST PSLIT
	TRO NOFXF	;NO FIXUPS IF UNDEF
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE ESPF!UNDF	;SPC. CHR?
	JRST BERR	;YES
	JUMPGE N,.+2
	ERROR [ASCIZ/NEGATIVE ARGUMENT TO BLOCK/]
	PUSHJ P,BFRC	;FORCE OUT BINARY
	PUSHJ P,FXFRC	;FORCE OUT FIXUPS
	ADDM N,PCNT	;ADD TO LOC CNTRS
	ADDM N,OPCNT	;....
	HRRZS PCNT
	HRRZS OPCNT
	SETZM WRD+1
	SOS OPCNT
	PUSHJ P,VBLOUT
	AOS OPCNT
	MOVE N,OPCNT
	CAMGE N,BRK	;HIGH SEGMENT?
	JRST .+5	;NO,LOW SEG
	CAMGE N,HICNT	;YES, IS OPCNT≥HICNT?
	JRST .+5	;NO
	MOVEM N,HICNT	;YES,INCREMENT HIGH
	JRST .+3
	CAML N,LOCNT	;IS OPCNT≥LOCNT?
	MOVEM N,LOCNT	;YES,INCREMENT LOW
	JRST SPCFN
BERR:	ERROR[ASCIZ/NOT EXPRESSION AFTER BLOCK/]
	SETZM WRD+1
	JRST SPCFN


↑%HISEG:SETZM WRD+1
	SETOM SEG
	MOVEI N,400000
	MOVEM N,OPCNT
	MOVEM N,PCNT
	MOVEM N,DPCNT
	MOVEI N,1
	MOVEM N,OPCNT+1
	MOVEM N,PCNT+1
	MOVEM N,DPCNT+1
	POUT 3,.+2
	JRST SPCFN
	XWD 3,1
	XWD 200000,0
	XWD 400000,400000
↑%TWOSEG:TRO NOFXF
	SETOM SEG
	PUSHJ P, MEVAL
	MOVEM N,NA
	SETZM WRD+1
	TLNE 0,ESPF	;ARGUMENT?
	MOVEI N,400000	;NO
	TLNE 0,UNDF	;YES. DEFINED?
	JRST .+12	;NO. ERROR
	HRRM N,.+10
	POUT 3,.+5	;YES
	MOVE N,NA
	TLNN 0,ESPF
	JRST SPCFN
	JRST NSPCFN
	XWD 3,1
	XWD 200000,0
	XWD 400000,0
	ERROR[ASCIZ/TWOSEG ARGUMENT UNDEFINED./]
	JRST SPCFN
↑%ASCII:	TLZ SFL	;CLEAR SCAN AHEAD
	MOVEM N,TM1	;SAVE VALUE
	HRRM C,TM2	;SAVE TERM CHR.
	MOVE C,TLBLK
	MOVEM C,SVLIN
	MOVE C,PGNM
	MOVEM C,TXTPG
LOOP2:	MOVEI N,	;CLEAR
	MOVEI NA,5	;COUNT
LOOP1:	PUSHJ P,SCAN1	;GET CHR.
TM2:	CAIN C,		;TERM CHR?
	JRST FND	;YES
		LSH N,7		;NO,SHIFT
	OR N,C		;AND INSERT
		SOJG NA,LOOP1	;5 CHRS?
	LSH N,1		;YES
	SKIPGE TM1	;ASCID?
	ORI N,1		;YES
	MOVEM N,WRD	;DEPOSIT VALUE
	MOVSI N,NONEM	;PREPARE FLAGS
	MOVEM N,WRD+1	;DEPOSIT
	PUSHJ P,BLOUT	;LIST BINARY
	RETN	;RETURN
		JRST LOOP2	;CONTINUE
FND:	SETZM TXTPG
	CAIN NA,5	;NONE IN THIS WORD?
	JRST NONW	;YES, NONE
	LSH N,7		;ADJUST
	SOJG NA,.-1	;...
		LSH N,1
	SKIPGE TM1	;ASCID?
	ORI N,1		;YES
	MOVEM N,WRD	;DEPOSIT VALUE
LOP1:	MOVSI N,NONEM
		MOVEM N,WRD+1	;SET FLAGS
↑SPCFN:	TRZ NOFXF
	PUSHJ P,SCAN1	;GET CHR.
	TLNN B,CRFG!RBRF;   CR OR ] OR >?
	JRST SPCFN	;NO
	TLNE B,CRFG	;CR?
	JRST SCR	;YES
	TLNE B,RBRF	;> OR ]?
	JRST RBARET	;YES
NONW:	SETZM WRD	;ZERO WORD
	SKIPLE TM1	;ASCIZ?
	JRST LOP1	;YES, RETURN 0
	SETZM WRD+1	;"NOTHING ON LINE"
	JRST SPCFN	;RETURN
↑SCR:	SKIPE WRD+1
	PUSHJ P,BLOUT
	TLNN B,LNFD	;LF?
	PUSHJ P,SCNTIL	;NO, GET TO IT
	JRST ARET
TM1:	0
↑%XWD:	TLO MLFT	;LEFT HALF
	PUSHJ P,MEVAL
	TLNE ESPF	;SPC CHR?
	JRST XER	;YES
	TRNN B,COMF	;TERM BY ,?
	ERROR [ASCIZ/NO COMMA AFTER XWD OR BLANK FIELD/]
	TRNE NA,14	;LEFT HALF RELOC?
	ERROR[ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
	PUSH P,N	;SAVE
	PUSH P,NA	;SAVE
	PUSHJ P,SCAN	;SKIP THE ,
	TLNE B,CRFG!RBRF	;NOTHING MORE?
	JRST [	SETZB N,NA	;INDEED -- THINK UP 0
		JRST XWD3]	;FOR RIGHT HALF
	TLZ MLFT	;NO LONGER LEFT HALF
	PUSHJ P,MEVAL
	TLNE ESPF	;SPC CHR?
	JRST XERQ	;YES
	TRNE NA,14	;LEFT HALF RELOC?
		ERROR[ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
XWD3:	TLO NA,NONEM
	MOVEM N,WRD	;DEPOSIT VALUE
	MOVEM NA,WRD+1
	POP P,NA	;GET BITS
	DPB NA,[POINT 2,WRD+1,33];DEPOSIT RELOC
	POP P,NA	;GET VALUE
	HRLM NA,WRD	;DEPOSIT
	JRST SPCFN
XERQ:	SUB P,[2(2)]
XER:	ERROR[ASCIZ/NO EXPRESSION AFTER XWD/]
↑NSPCFN:TLNN N,CRFG!RBRF;CR RET?
	JRST SPCFN	;NO
	TRZ NOFXF
	TLNE N,CRFG	;CR?
	JRST ASCR
	JRST RBARET
↑%LIT:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT	;NOT IN LIT
	PUSHJ P,LITOUT
	SETZM WRD+1
	JRST SPCFN

↑%RADIX:TRO NOFXF
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE ESPF!UNDF	;SPC. CHR?
		BEGIN RAD
		JRST RERR	;YES
	PUSHJ P,RADX	;SET RADIX
	SETZM WRD+1
	JRST SPCFN
RERR:	ERROR[ASCIZ/NOT EXPRESSION AFTER RADIX/]
	TLNE ESPF
	JRST NSPCFN
		JRST SPCFN
BEND
↑RADX:	MOVE NA,[IMULI N,];PREPARE INSTRUCTION
	HRR NA,N
	CAIN N,10	;OCTAL?
	MOVE NA,[LSH N,3];YES
	MOVEM NA,SRAD	;SET RADIX
	POPJ P,
↑%CON:	MOVE TAC,SRAD	;SAVE CURRENT RADIX
	BEGIN CON
	MOVEM TAC,SVRAD
	PUSHJ P,RADX	;SET RADIX
	MOVSI N,NONEM
	MOVEM N,WRD+1
LOP:	PUSHJ P,SCANM	;GET NUM
	TLNN NFLG	;NUM?
	JRST CERR	;NO
	MOVEM N,WRD	;DEPOSIT NUMBER
		TRNN B,COMF	;TERM BY ,?
	JRST LAST	;NO, LAST ONE
	PUSHJ P,BLOUT	;PRINT BINARY
		RETN		;RETURN THIS ONE
	TLZ SFL		;SKIP THE ,
	JRST LOP
CERR:	ERROR[ASCIZ/NOT A NUMBER/]
LAST:	MOVE TAC,SVRAD	;RESTORE RADIX
	MOVEM TAC,SRAD
	JRST SPCFN
SVRAD:	0
		BEND
↑%IO:	TRO IOSW	;TURN ON IO SWITCH
	MOVEI NA,	;CLEAR OUT BITS
	JRST OPCDR	;PROCEED
↑PHAZ:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT
	TRO NOFXF
	PUSHJ P,MEVAL	;GET VALUE
	TLNE UNDF!ESPF	;DEFINED?
	JRST PERR	;NO
	MOVEM N,PCNT	;DEPOSIT VALUE...
	MOVEM NA,PCNT+1	;...
		JRST SPCFN
PERR:	ERROR[ASCIZ/UNDEFINED OR SPECIAL CHR -- PHASE/]
	JRST SPCFN
↑PSLIT:	ERROR [ASCIZ /ILLEGAL PSEUDOOP IN LITERAL/]
	SETZM WRD+1
	JRST SPCFN
↑DPHAZ:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT
	MOVE N,[XWD OPCNT,PCNT]
	BLT N,PCNT+1
	JRST SPCFN

↑%LIST:	JUMPE N,LST1	;LIST?
	JUMPG N,LST2	;XLIST1?
	TRZ LDEV	;TERMINATE LISTING
	JRST SPCFN

LST2:	SKIPN XL1IG	;/I SWITCH?(IGNORE XLIST1)
	TRZ LDEV
	JRST SPCFN

LST1:	SKIPE LISTSW	;DEVICE EXIST?
	TRO LDEV	;YES, START LISTING
	JRST SPCFN

↑%COMM:	PUSHJ P,SLURPC	;EAT EVERYTHING UP TO MATCHING CHAR
	JRST SPCFN
↑%BYTE:	TRNN B,LFPF	;( NEXT?
	JRST BERR1	;NO
	SETZM WRD
	TRO NOFXF	;NO FIXUPS
	MOVE N,[POINT 3,WRD]
	MOVEM N,PNTR
PARLOP:	PUSH P,SRAD	;SAVE RADIX
	MOVEI N,12
	PUSHJ P,RADX	;CONVERT TO DEC.
	PUSHJ P,MEVAL	;GET VALUE
	TLNN PAWF	;()?
	ERROR[ASCIZ/AMBIGUITY ERROR/]
	TLNE UNDF!ESPF	;UNDEF OR SPC CHR?
	ERROR[ASCIZ/UNREC OR UNDEF SIZE/]
	TRNE NA,17	;RELOC FIELD?
	ERROR[ASCIZ/RELOC SIZE/]
	POP P,SRAD	;RESTORE RADIX
	DPB N,[POINT 6,PNTR,11];DEPOSIT SIZE
	TRNE B,LFPF	;( NEXT?
	JRST PARLOP	;YES
	TRNE B,COMF	;, NEXT?
	JRST NULF	;YES
BLOP:	PUSHJ P,MEVAL	;GET NEXT BYTE
	TLNE UNDF	;UNDEF?
	ERROR[ASCIZ/UNDEF BYTE/]
	TRNE NA,17	;RELOC?
	ERROR[ASCIZ/RELOC BYTE/]
	TLNE ESPF	;SPC CHR?
	ERROR[ASCIZ/SPC. CHR. IN BYTE FIELD/]
DBYT:	IDPB N,PNTR	;DEPOSIT
	HRRZ NA,PNTR	;DID WE ADVANCE...
	CAIE NA,WRD	;TO NEXT WORD?
	JSR GOTWRD	;YES
	TRNN B,COMF	;, NEXT?
	JRST NOCOM	;NO
	PUSHJ P,SCAN 	;GET THE ,
	TRNE B,COMF	;, NEXT?
	JRST NULF	;YES
	TRNN B,LFPF	;( NEXT?
	JRST BLOP	;NO
NULF:	SETZB N,NA	;ZERO BYTE
	JRST DBYT
NOCOM:	TRNE B,LFPF	;(NEXT?
	JRST PARLOP	;YES
	MOVSI N,NONEM
	MOVEM N,WRD+1
	TRZ NOFXF	;RESTORE
	JRST SPCFN	;LEAVE, THROUGH
GOTWRD:	0
	MOVSI N,NONEM	;MARK WRD+1...
	EXCH N,WRD+1	;AND GET NEXT BYTE...
	MOVEM N,NSAV	;& SAVE
	PUSHJ P,BLOUT	;LIST BINARY
	RETN	;RETURN THIS WORD
	MOVE N,NSAV
	MOVEM N,WRD	;GET SAVED BYTE
	SOS PNTR	;ADJUST PNTR
	JRST @GOTWRD
BERR1:	ERROR[ASCIZ/NOT SIZE FIELD AFTER BYTE/]
	JRST SPCFN
PNTR:	0
NSAV:	0
↑%POINT:PUSH P,SRAD	;SAVE CURRENT RADIX
	MOVEI N,12
	PUSHJ P,RADX	;SET RADIX TO DEC.
	TRO NOFXF	;NO FIXUPS THIS FIELD
	PUSHJ P,MEVAL
	TRNN NA,17
	TLNE UNDF!ESPF	;SPC CHR. OR UNDEF?
	JRST PER1	;YES
	POP P,SRAD	;RESTORE RADIX
	SETZM WRD
	SETZM WRD+1
	DPB N,[POINT 6,WRD,11];DEPOSIT SIZE
	TRNN B,COMF	;, NEXT?
	JRST PER2	;NO
	TLZ SFL		;SKIP THE ,
PPT3:	TRZ ADFL!NOFXF	;FIXUPS OK NOW
PLOP:	PUSHJ P,MEVAL	;GET NEXT EXPR.
	TLNE ESPF	;SPC. CHR?
	JRST PSPC	;YES
	TLNE PAWF	;()?
	JRST PAWT	;YES
	TROE ADFL	;GOT AN ADDRESS ALREADY?
	JRST LERR	;YES
	HRRM N,WRD	;DEPOSIT ADDRS.
	ORM NA,WRD+1	;DEPOSIT RELOC
PPT:	TLNE B,CRFG!RBRF	;CR OR ] OR >?
	JRST PEND	;YES
	TRNN B,COMF	;TERM BY ,?
	JRST PLOP	;NO
	TLZ SFL		;SKIP THE ,
PPT2:	MOVSI NA,NONEM
	ORM NA,WRD+1
	TRO NOFXF
	PUSH P,SRAD	;SAVE RADIX
	MOVEI N,12
	PUSHJ P,RADX	;SET TO DEC.
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE ESPF!UNDF	;SPC CHR. OR UNDEF?
	JRST PER3	;YES
	MOVNS N		;INVERT & ADD...
	ADDI N,43	;43
	DPB N,[POINT 6,WRD,5]	;& DEPOSIT
PPT1:	POP P,SRAD
	TRZ NOFXF
	JRST SPCFN
PAWT:	MOVSS N		;SWAP HALVES
	TRNE NA,17	;RELOC?
	ERROR[ASCIZ/RELOC INDEX FIELD/]
	TLZ N,777760	;CLEAR PART
	ORM N,WRD	;OR IN
	TLNE UNDF	;DEFINED?
	ERROR[ASCIZ/UNDEF INDEX FIELD/]
	JRST PPT
PSPC:	TRNE N,COMF	;,?
	JRST PPT2	;YES
	TRNE N,ATF	;@?
	JRST PSAT	;YES
	ERROR[ASCIZ/UNREC SPC CHR/]
	JRST PPT
PSAT:	MOVSI N,20	;GET @ BIT
	ORM N,WRD	;DEPOSIT
	JRST PPT
PEND:	MOVEI NA,44	;GET 44
	DPB NA,[POINT 6,WRD,5];DEPOSIT AS POSITION
	MOVSI NA,NONEM	;MARK NONEMPTY
	ORM NA,WRD+1
	JRST SPCFN
PER1:	ERROR[ASCIZ/UNREC, UNDEF, OR RELOC SIZE/]
	JRST PPT1
PER2:	ERROR[ASCIZ/NO COMMA AFTER SIZE/]
	JRST PPT3
PER3:	ERROR[ASCIZ/UNREC, UNDEF, OR RELOC POSITION/]
	JRST PPT1
LERR:	ERROR[ASCIZ/UNREC SYNTAX/]
	JRST PPT
↑%SIX:	TLZ SFL		;SKIP CHR.
	MOVEM N,TM1	;SAVE VALUE (OF OP)
	HRRM C,TM3	;SAVE TERM CHR.
	MOVE C,TLBLK
	MOVEM C,SVLIN
	MOVE C,PGNM
	MOVEM C,TXTPG
LOPS2:	MOVEI N,	;CLEAR
	MOVEI NA,6	;COUNT
LOPS1:	PUSHJ P,SCAN1	;GET CHR.
TM3:	CAIN C,		;TERM CHR?
	JRST SFND	;YES
	LSH N,6		;NO, SHIFT
	TRZN C,100	;CONVERT...
	TRZA C,40	;TO...
	TRO C,40	;SIXBIT
	OR N,C		;INSERT
	SOJG NA,LOPS1	;6 CHRS?
	MOVEM N,WRD	;YES
	MOVSI NA,NONEM	;PREPARE FLAGS
	MOVEM NA,WRD+1	;DEPOSIT
	PUSHJ P,BLOUT	;LIST BINARY
	RETN	;RETURN WRD
	JRST LOPS2
SFND:	SETZM TXTPG
	CAIN NA,6	;NONE IN THIS WORD?
	JRST SNON	;NONE
	LSH N,6		;ADJUST
	SOJG NA,.-1	;...
	MOVEM N,WRD	;DEPOSIT VALUE
	MOVSI NA,NONEM	;AND...
	MOVEM NA,WRD+1	;FLAGS
	JRST SPCFN	;RETURN
SNON:	SETZM WRD+1
	JRST SPCFN
↑%OPDEF:PUSHJ P,SCAN	;GET SIXBIT
	TLNN IFLG	;IDENT?
	JRST OPERR1	;NO
	PUSH P,L	;SAVE SIXBIT
	PUSHJ P,SCAN	;GET NEXT
	TLNN SCFL	;SPC. CHR?
	JRST .-2	;NO
	TLNN N,LBRF	;[ OR <?
	JRST .-4	;NO
	TRO NOFXF	;YES, NO FIXUPS
	ACALL
	TLNE AUNDF	;DEFINED?
	JRST OPERR2	;NO
	TRZN TRBF	;TERM BY ] OR >?
	ERROR[ASCIZ/UNREC TERMINATION CHR. -- OPDEF/]
	POP P,L		;GET SIXBIT
	MOVE N,L
	IDIVI N,HASH	;HASH
	MOVM NA,NA
	SKIPN PN,OPCDS(NA)
	JRST OPDF2
	SRC2 L,PN,OPDFF	;CHECK FOR OLD DEF
OPDF2:	GFST PN,FSTPNT
	MOVEM L,(PN)	;DEPOSIT SIXBIT
	MOVSI N,20
	HRR N,OPCDS(NA);INSERT...
	EXCH N,1(PN)	;IN LIST
	MOVEM PN,OPCDS(NA)
	MOVEM N,FSTPNT
	MOVE N,BLOCK
	MOVEM N,2(PN)	;SET BLOCK BIT
OPDF3:	MOVSI N,WRD	
	HRRI N,3(PN)
	BLT N,4(PN)	;DEPOSIT VALUE
OPDF4:	SKIPE XCRFSW
	CREF6 6,(PN)
	PUSHJ P,LBLOUT
	TRZ NOFXF
	SETZM WRD+1
	JRST SPCFN
OPERR1:	ERROR[ASCIZ/NO IDENTIFIER AFTER OPDEF/]
	JRST .+2
OPERR2:	ERROR[ASCIZ/VALUE OF OPDEF MUST BE DEFINED -- USE A MACRO/]
	SETZM WRD+1
	JRST SPCFN

;HERE IF OLD DEF EXISTS
OPDFF:	REPEAT 0,<		;LEAVE THIS HACK OUT UNTIL RAID IS FIXED
OPDFF:	MOVEI O,(NA)	;SAVE HASH
	PUSHJ P,OPVAL	;GET OLD VAL
	TLO NA,NONEM
	CAMN N,WRD
	CAME NA,WRD+1
	SKIPA NA,O
	JRST OPDF4	;OLD VAL SAME - DON'T DO MUCH
>	SKIPL N,1(PN)	;CHECK TYPE OF OLD
	TLNN N,20
	JRST OPDF2	;OLD IS PERMANENT - MUST INSERT NEW
	HRRZ T,2(PN)
	CAME T,BLOCK
	JRST OPDF2	;DIFFERENT BLOCK - INSERT NEW
	JRST OPDF3	;SAME BLOCK - JUST CLOBBER VAL
	DEFINE TIT $(TITCNT,Q,EXTRA,X1)
<	MOVE T,[POINT 7,TITCNT+1]
IFN X1,<TLOP:	PUSHJ P,SCAN1	;GET CHR.
	JUMPGE B,TPOL	;NUM OR LET?
	LSH FS,6	;CON TO SIXBIT...
	ORI FS,(B)	;...
	TLNE FS,770000	;6 CHRS?
	JRST TPOL	;YES
	IDPB C,T	;NO
	JRST TLOP	
TPOL:	AOSE TITLSW
	ERROR [ASCIZ /EXTRA TITLE STATEMENT/]
	SKIPN RPGSW
	JRST TPOL1
	PUSH P,C
	PUSH P,T
	IDPB C,T
	MOVEI C,15
	IDPB C,T
	MOVEI C,12
	IDPB C,T
	MOVEI C,0
	IDPB C,T
ITS,<	OUTSTR [ASCIZ /FAIL:  /]	>
	OUTSTR TITCNT+1
	POP P,T
	POP P,C
TPOL1:	MOVEM FS,BNAM	;DEPOSIT BLOCK NAME
	MOVEM FS,LSTLAB+3
	PUSHJ P,R5CON	;CON TO RAD 50
	MOVEM FS,.+5
	POUT 4,.+2
	JRST TLOP$Q+1
	XWD 6,2
	0
	0
		0
>
TLOP$Q:	PUSHJ P,SCAN1	;GET CHR.
	TLNE B,CRFG	;CR?
	JRST .+3	;YES
	IDPB C,T	;DEPOSIT
	JRST TLOP$Q
	EXTRA
	MOVEI N,
	REPEAT 5,<	IDPB N,T>
	SUBI T,TITCNT+1	;FORM COUNT
		MOVNS T		;NEGATE
	HRLM T,TITCNT	;DEPOSIT
	JRST SCR
>
↑%TITLE:MOVEI FS,
	TIT(TITCNT,1,,1)
↑%SUB:	TIT(SUBCNT,A,<MOVEI N,15
		IDPB N,T
	MOVEI NA,12
	IDPB NA,T
	IDPB N,T
	IDPB NA,T>,0)
↑%GLOB:	PUSHJ P,SCANM	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST NOIG	;NO
	MOVE N,L	;GET SIXBIT
	IDIVI N,HASH	;HASH
	MOVMS NA
	SKIPN PN,SYMTAB(NA);GET POINTER
	JRST GER1	;NONE
GSR:	SRC1(L,PN,FNDG,JRST GER1)
GER1:	ERROR[ASCIZ/GLOBAL -- NO PREVIOUS DEFINITION/]
	JRST CONTG
FNDG:	MOVE N,2(PN)	;GET FLAGS
	TLNE N,UDSF	;UDEFINED-DEFINED IS GOOD ENOUGH
	JRST GLDEF
	TLNE N,DEFFL	;DEFINED?
	JRST GSR+2	;NO, TRY AGAIN
GLDEF:	OR N,BLOCK	;TURN ON BLOCK BIT
	TLNN N,DAF	;DOWN ARROW?
	TLO N,GLOBF	;NO, SET GLOBAL
	MOVEM N,2(PN)	;RESTORE FLAGS
CONTG:	TRNN B,COMF	;, NEXT?
	JRST SPCFN	;NO, DONE
	TLZ SFL		;SKIP THE ,
	JRST %GLOB	;CONTINUE
NOIG:	ERROR[ASCIZ/NOT IDENT AFTER GLOBAL/]
	JRST NSPCFN

↑%EXT:		PUSHJ P,SCANS	;GET IDENT
		TLNN IFLG	;IDENT?
	JRST NOIE	;NO
	MOVE T,2(PN)	;GET FLAGS
	TLNN T,DEFFL	;DEFINED?
	JRST EER1	;YES
	TLNE T,INTF
	JRST EER2
	TLO T,EXTF	;TURN ON EXT FLAG
	MOVEM T,2(PN)	;DEPOSIT
CONTE:	TRNN B,COMF	;, NEXT?
	JRST SPCFN	;NO, DONE
	TLZ SFL		;SKIP THE ,
	JRST %EXT
EER1:	ERROR[ASCIZ/EXTERNAL -- ALREADY DEFINED/]
	JRST CONTE
EER2:	ERROR [ASCIZ /EXTERNAL -- ALREADY INTERNAL/]
	JRST CONTE
NOIE:	ERROR[ASCIZ/NOT IDENT AFTER EXTERN/]
	JRST NSPCFN
↑%INT:	PUSHJ P,SCANS	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST NOII	;NO
	MOVE T,2(PN)
	TLNE T,EXTF
	JRST IER1
	TLO T,INTF
	MOVEM T,2(PN)
CONTI:	TRNN B,COMF	;, NEXT?
	JRST SPCFN	;NO
	TLZ SFL		;YES, SKIP THE ,
	JRST %INT
IER1:	ERROR [ASCIZ /INTERNAL -- ALREADY EXTERNAL/]
	JRST CONTI
NOII:	ERROR[ASCIZ/NOT IDENT AFTER INTERN/]
	JRST NSPCFN
↑%PAGE:	MOVEI TAC,14
	IDPB TAC,LSTPNT
		JRST SPCFN
↑%LALL:	JUMPL N,LAL
		SETZM NOEXP
	JRST SPCFN
LAL:	SETOM NOEXP
	JRST SPCFN
↑%NOSYM:SETZM SYMOUT
	JRST SPCFN
↑%NOLIT:SETOM NOLTSW
	JRST SPCFN
↑%INTEG:PUSHJ P,SCANS	;GET A SYMBOL
	TLNN IFLG
	JRST NOII2	;NOT IDENT
	MOVE T,2(PN)
	TLON T,UDSF!VARF	;SET FLAGS
	TLNN T,DEFFL
	JRST NXT	;BUT IGNORE IF DEFINED
	MOVEM T,2(PN)
	GFST TAC,FSTPNT	;GET FREE BLOCK
	MOVE T,VARLST
	MOVEM TAC,VARLST
	EXCH T,1(TAC)
	MOVEM T,FSTPNT
	MOVEM PN,(TAC)
	SETZM 2(TAC)	;ONE WORD
NXT:	TRNN B,COMF	;IS IT A COMMA NEXT
	JRST SPCFN	;GO AWAY
	TLZ SFL		;GET PAST IT
	JRST %INTEG	;AND TRY FOR MORE
NOII2:	ERROR [ASCIZ /NOT IDENT AFTER INTEGER/]
	JRST NSPCFN

↑%ARAY:	SETZM ARCNT#	;NUMBER OF THINGS PUSHED INTO STACK
%ARAY1:	PUSHJ P,SCANS	;GET A SYMBOL
	TLNN IFLG
	JRST NOAR	;NOT IDENT SO LOSE
	MOVE T,2(PN)	;CHECK FLAGS
	TLON T,UDSF!VARF
	TLNN T,DEFFL
	ERROR [ASCIZ /ARRAY NAME ALREADY DEFINED/]
	MOVEM T,2(PN)	;BUT THEM BACK
	GFST TAC,FSTPNT
	MOVE T,VARLST
	MOVEM TAC,VARLST
	EXCH T,1(TAC)
	MOVEM T,FSTPNT
	MOVEM PN,(TAC)
	PUSH P,TAC
	AOS ARCNT
	TLNE B,LBRF	;CHECK FOR < OR [
	TRNN B,TP1F	;AND THEN MAKE SURE OF [
	JRST ARR3
	TLZ SFL		;STOP SCANNING AHED
	TRO NOFXF
	PUSHJ P,MEVAL
	TRNN NA,17
	TLNE UNDF!ESPF	;CHECK SPECIAL OR UNDEF
	JRST ARAYER
	SUBI N,1	;STORE ONE LESS
ARRY:	POP P,TAC	;GET BACK A POINTER
	MOVEM N,2(TAC)
	SOSLE ARCNT
	JRST ARRY	;GET MORE
	TLNE B,RBRF
	TRNN B,TP1F
	JRST ARR2
	PUSHJ P,SCAN
	TRNN B,COMF
	JRST SPCFN
	TLZ SFL
	JRST %ARAY
ARR3:	TRNN B,COMF
	JRST ARR1
	TLZ SFL
	JRST %ARAY1	;GO GET ANOTHER NAME
ARR1:	ERROR [ASCIZ /NO [ AFTER ARRAY/]
	JRST COMAER	;GO GET STUFF OFF STACK
ARAYER:	ERROR [ASCIZ /NO EXPRESSION AFTER [ - ARRAY/]
	JRST COMAER
ARR2:	ERROR [ASCIZ /NO ] AFTER ARRAY/]
	JRST COMAER
NOAR:	ERROR [ASCIZ /NOT IDENT AFTER ARRAY/]
	JRST COMAER
	POP P,TAC
COMAER:	SOSL ARCNT
	JRST .-2
	JRST NSPCFN
↑%ENTRY:SKIPE CODEM	;WAS CODE EMITTED?
	BEGIN ENTRY
	ERROR [ASCIZ /ENTRY AFTER CODE EMITTED/]
	PUSH P,BC	;USE THIS REGISTER AS AOBJN POINTER
	MOVE BC,[XWD -=18,ENTBLK]	;FOR STORING ENTRIES
ENTR1:	PUSHJ P,SCANS	;FIND A SYMBOL
	TLNN IFLG	;WAS THERE A SYMBOL THERE?
	JRST NOII	;NO, GIVE ERROR
	MOVSI T,INTF	;SET AS INTERNAL
	ORM T,2(PN)	;INTO FLAGS
	MOVE FS,(PN)	;GET THE SIXBIT FOR THIS ONE
	PUSHJ P,R5CON	;CONVERT TO RADIX50
	MOVEM FS,(BC)	;PUT INTO ENTRY BLOCK
	AOBJP BC,EMIT	;PUT OUT BLOCK IF OUT OF ROOM
GOENT:	TRNN B,COMF	;COMMA FOLLOWING?
	JRST ENDENT	;ALL DONE
	TLZ SFL		;SET TO IGNORE COMMA
	JRST ENTR1	;AND GET MORE

ENDENT:	HLRZ TAC,BC	;GET THE CURRENT COUNT
	CAIN TAC,-=18	;SEE IF ANY HAVE BEEN PUT IN
	JRST FINENT	;NO, MUST HAVE BEEN A MULTIPLE OF 18
	ADDI TAC,=18	;GET COUNT (IF YOU IGNORE LEFT HALF
	HRRM TAC,ENTWHO	;PUT IN BLOCK HEADER
	ADDI TAC,2
	MOVNS TAC
	HRLM TAC,ENTHD	;AND -COUNT INTO OUTPUT POINTER
	BBOUT ENTHD	;DO THE OUTPUT
FINENT:	POP P,BC	;RESTORE THIS
	SETZM WRD+1	;TELL THEM NOTHING THERE
	JRST SPCFN	;FINISH UP LINE

NOII:	ERROR [ASCIZ /NOT IDENT AFTER ENTRY/]
	JRST FINENT	;FINISH UP

EMIT:	MOVE TAC,[XWD -=20,ENTWHO]	;AMOUTN TO DUMP
	MOVEM TAC, ENTHD
	MOVEI TAC,=18	;NUMBER OF WORDS IN THE BLOCK
	HRRM TAC,ENTWHO	;INTO BLOCK HEADER
	BBOUT ENTHD	;OUTPUT IT
	MOVE BC,[XWD -=18,ENTBLK]
	JRST GOENT	;AND CONTINUE

ENTHD:	ENTWHO
ENTWHO:	XWD 4,0
	0	;RELOCATION BITS
ENTBLK:	BLOCK =18

BEND ENTRY

↑%ENDL:	PUSHJ P,BFRC	;FOURCE OUT BINARY
	PUSHJ P,FXFRC	;AND FIXUPS
	TRO NOFXF
	PUSHJ P,MEVAL
	MOVNS N		;USE NEGATIVE OF NUMBER
	JRST LINK1	;GO CHECK AND GET REST OF JUNK

↑%LINK:	PUSHJ P,BFRC	;FORC OUT
	PUSHJ P,FXFRC
	TRO NOFXF
	PUSHJ P,MEVAL
LINK1:	TLNN ESPF!UNDF
	TRNE NA,17	;IF SPECIAL CHR OR UNDEF EXPR
	JRST LNKERR	;GIVE ERROR MESSAGE
	MOVEM N,LNKNUM	;STORE NUMBER FOR OUTPUT
	TRNN B,COMF	;THERE SHOULD BE A COMMA THERE
	ERROR [ASCIZ /NO COMMA AFTER LINK NUMBER/]
	TLZ SFL		;SKIP THE COMMA
	PUSHJ P,MEVAL	;GET THE ADDRESS
	TLNE UNDF!ESPF
	JRST LNKERR	;UNDEF OR SPECIAL NOT PERMITTED
	DPB NA,[POINT 1,LKRLC,3]	;PUT IN RELOC BIT
	HRRZM N,LNKADR	;AND ADDRESS
	POUT 4,LNKBLK	;OUTPUT IT
	SKIPA
LNKERR:	ERROR [ASCIZ /NOT EXPRESSION AFTER LINK OR LINKEND/]
	SETZM WRD+1	;RETURN NOTHING
	JRST SPCFN	;DONE

LNKBLK:	XWD 12,2	;HEADER
LKRLC:	0		;RELOC BITS
LNKNUM:	0	;NUMBER OR LINK
LNKADR:	0		;ADDRESS OF LINK

↑%RAD5:	TRO NOFXF
	PUSHJ P,MEVAL	;GET NUMBER
	TRNN NA,17
	TLNE UNDF!ESPF	;IF UNDEF OR SPECIAL CHR
	JRST RAD5ER
	TRNN B,COMF
	ERROR [ASCIZ /NO COMMA AFTER RADIX50/]
	LSH N,-2	;JUSTIFY
	DPB N,[POINT 4,WRD,3]	;SAVE IN WORD
	TLZ SFL	;IGNORE COMMA
	PUSHJ P,SCAN	;GET IDENT
	TLNN IFLG
	ERROR [ASCIZ /NO IDENT AFTER RADIX50/]
	MOVE FS,L	;GET SIXBIT
	PUSHJ P,R5CON	;AND CONVERT
	IORM FS,WRD	;PUT IN
	MOVSI N,NONEM	;THERE IS SOMETHING THERE
	MOVEM N,WRD+1	;WITH NO RELOC
	JRST SPCFN	;AND AWAY WE GO

RAD5ER:	ERROR [ASCIZ /NOT EXPRESSION AFTER RADIX50/]
	SETZM WRD+1
	JRST SPCFN

↑%ONCRF:SKIPE CREFSW
	SETOM XCRFSW
	JRST SPCFN
↑%OFCRF:SETZM XCRFSW
	JRST SPCFN
BEND
	SUBTTL  THIS HERE IS THE ASSEMBLER !!!!!!!!!

;MAIN:	THIS HERE IS THE ASSEMBLER
MAINQ:	MOVE N,PCNT+1	;GET RELOC
	MOVEM N,DPCNT+1	;AND SET RELOC OF .
	MOVE N,PCNT
	MOVEM N,DPCNT
MAIN:	TLZ OPFLG!MLFT
	ACALL	;CALL ASSMBL
	SKIPN WRD+1	;ANYTHING ON LINE?
	JRST MAINQ	;NO, NOTHING
	OUTP WRD	;OUTPUT THE STUFF
	AOS OPCNT	;INCREMENT
	MOVE N,OPCNT
	CAMGE N,BRK	;HIGH SEGMENT?
	JRST .+5	;NO,LOW SEGMENT
	CAMGE N, HICNT	;YES. IS OPCNT≥HICNT?
	JRST .+5	;NO
	MOVEM N,HICNT 	;YES. INCREMENT HIGH
	JRST .+3
	CAML N,LOCNT	;IS OPCNT≥LOCNT?
	MOVEM N,LOCNT	;YES, INCREMENT LOW
	AOS N,PCNT	;INCREMENT
	MOVEM N,DPCNT	;SET ADDRESS OF  .
	SKIPN N,POLPNT	;ANY POLFIXES FOR NOW?
	JRST MAIN	;NO
	SETZM POLPNT	;CLEAR POINTER
	PUSHJ P,BFRC	;FORCE OUT BIN
MAINL:	MOVEI FS,5(N)	;SET UP POINTER
	MOVE NA,1(N)	;GET NEXT PNTR.
	PUSHJ P,POLOUT	;PUT OUT POLFIX
	SKIPN N,NA	;ANY MORE?
	JRST MAIN	;NO
	JRST MAINL	;YES
	SUBTTL UUO HANDLER AND OUTPUT ROUTINES
;UUO  HANDLER IS HERE

BEGIN UUO
↑UUO:	0
NOITS,<
	LDB TAC,[POINT 5,40,8]	;GET UUO #
	PUSHJ P,@UUOTB(TAC)	;CALL ROUTINE
	JRST @UUO
>;NOITS
ITS,<
↑↑UUOCON←UUO

	PUSH P,2
	LDB 2,[POINT 5,40,8]	;GET UUO #
	SKIPGE UUOTB(2)
	JRST [	POP P,USAVEA
		MOVEM P,USAVEP
		JRST @UUOTB(2)]	;DIFFERENT CALL FOR SIMULATOR
	MOVE TAC,2
	POP P,2
	PUSH P,40
	PUSH P,UUO
	POP P,LSUUPC
	POP P,LSUUO
	PUSHJ P,@UUOTB(TAC)	;CALL ROUTINE
	JRST @UUO

↑↑UUOXIT:

	MOVE 2,UUO
	MOVEM 2,UUORET
	MOVE 2,LSUUO		;RESTORE IN CASE USER UUO WAS IN PROGRESS
	MOVEM 2,40
	MOVE 2,LSUUPC
	MOVEM 2,UUO
	MOVE P,USAVEP		;RESTORE AC'S
	MOVE 2,USAVEA
	MOVE 3,USAVEB
	MOVE 4,USAVEC
	MOVE 5,USAVED
	MOVE 6,USAVEE
	JRST 2,@UUORET		;RETURN
>;ITS

UUOTB:

;UUO DISPATCH TABLE

NOITS,<
FOR I←0,10
<ILUUO
>
UERR
UFAT
UFOUT
UOUTP
UPOUT
UTRAN
UBBOUT
UCREF6
UCRF66
UCREF7
FOR I←23,37
<ILUUO
>
ILUUO:	JRST 4,.
>;NOITS

ITS,<
SNB,,ILLUUO	;0
SNB,,.RELSE	;1
SNB,,.CLS	;2
SNB,,.TTYUUO	;3
SNB,,.PTYUUO	;4
SNB,,.CALLI	;5
SNB,,.INIT	;6
SNB,,.LOOK	;7
SNB,,.ENTER	;10
UERR		;11
UFAT		;12
UFOUT		;13
UOUTP		;14
UPOUT		;15
UTRAN		;16
UBBOUT		;17
UCREF6		;20
UCRF66		;21
UCREF7		;22
SNB,,.IN	;23
SNB,,.OUT	;24
SNB,,.INPUT	;25
SNB,,.OUTPUT	;26
SNB,,.INBUF	;27
SNB,,.OUTBUF	;30
SNB,,.STATO	;31
SNB,,.STATZ	;32
SNB,,.GETSTS	;33

FOR I←34,37
<SNB,,ILLUUO
>
↑↑ILLUUO:
	.VALUE [ASCIZ /:≠ ILLEGAL UUO ≠
/]
>;ITS

BEND UUO
; BINARY I/O HANDLING ROUTINES


BEGIN BIO
↑BBLK:	XWD 1,0
	BLOCK 23
↑FBLK:	XWD 10,0
	BLOCK 23
↑UOUTP:	JUMPN BC,NOINI	;NOT FIRST WORD?
	MOVE TAC,OPCNT	;GET OUTPUT ADDRESS
	MOVEM TAC,BBLK+2	;STORE
	MOVE TAC,OPCNT+1	;GET RELOCATION
	LSH TAC,2	;SHIFT
	MOVEM TAC,BBLK+1	;STORE
	MOVE BC,[XWD -21,BBLK+3]
NOINI:	MOVE TAC,@40	;GET WORD
	MOVEM TAC,(BC)	;STORE
	AOS 40
	MOVE TAC,@40	;GET RELOC
		DPB TAC,[POINT 1,TAC,34]
	LDB TAC,[POINT 2,TAC,34]
	OR TAC,BBLK+1	;OR IN
	AOBJP BC,FULL	;FULL?
	LSH TAC,2	;NO
	MOVEM TAC,BBLK+1	;STORE
	POPJ P,
FULL:	MOVEM TAC,BBLK+1;STORE RELOCATION
	MOVEI TAC,22
	HRRM TAC,BBLK	;SET COUNT
	MOVE BC,[XWD -24,BBLK];OUTPUT COUNT
	PUSHJ P,GBOUT	;OUTPUT THE BLOCK
		PUSHJ P,FXFRC	;OUTPUT ANY FIXUPS
	MOVEI BC,
	POPJ P,
↑UBBOUT:MOVEM BC,UBBSV
	MOVE BC,40
	MOVE BC,(BC)
	PUSHJ P,GBOUT
	MOVE BC,UBBSV
	POPJ P,
UBBSV:	0
↑GBOUT:	HLRZ TAC,(BC)	;GET BLOCK TYPE
	CAIE TAC,4	;IGNORE IF ENTRY
	SETOM CODEM	;FLAG THAT CODE WAS PUT OUT
	CAIN TAC,2	;ALSO CHECK SYMBOLS
	SETOM SYMEM
	TRNN BDEV	;BIN DEVICE?
	POPJ P,		;NO
STINK,<
	PUSHJ P,STKTRN	;TRANSLATE TO STINK FORMAT
	PUSHJ P,GBOUT1
	POPJ P,		;STKTRN SKIPS UPON OCCASION

↑↑GBOUT1:
>;STINK

GBOUT2:	MOVE TAC,(BC)	
	SOSLE ODB+2
	JRST GBPT
	OUTPUT 3,
	STATZ 3,740000
	JRST .-2
GBPT:	IDPB TAC,ODB+1
	AOBJN BC,GBOUT2
	POPJ P,
↑BFRC:	JUMPE BC,[POPJ P,]
↑BFX:	MOVEI TAC,(BC);ADDRESS GETS FIXED UP TO -(BBLK+2)
	HRRM TAC,BBLK	;COUNT
	MOVE TAC,BBLK+1	;GET RELOC BITS
	LSH TAC,-2
	LSH TAC,2
	AOBJN BC,.-1	;SHIFT RELOC BITS
	MOVEM TAC,BBLK+1
	MOVN BC,BBLK	;GET - COUNT
	HRLI BC,-2(BC)	;SUBTRACT 2 & PUT IN LEFT HALF
	HRRI BC,BBLK	;SET ADRESS
	PUSHJ P,GBOUT
	MOVEI BC,
	POPJ P,
↑UFOUT:	MOVE TAC,@40	;GET WORD
		MOVEM TAC,(FC)	;DEPOSIT
	AOS 40
	MOVE TAC,@40	;GET RELOC
	ANDI TAC,3	
	OR TAC,FBLK+1	;OR IN
	AOBJP FC,FFUL	;FULL?
	LSH TAC,2	;NO, SHIFT
	MOVEM TAC,FBLK+1	;STORE
	POPJ P,
FFUL:	MOVEM TAC,FBLK+1	;STORE RELOC BITS
	MOVEI TAC,22
	HRRM TAC,FBLK	;SET COUNT
	PUSHJ P,BFRC	;FORCE OUT BIN
	MOVE BC,[XWD -24,FBLK]
	PUSHJ P,GBOUT	;OUTPUT IT
	MOVE FC,[XWD -22,FBLK+2];INIT
	SETZB BC,FBLK+1
	POPJ P,
↑FXFRC:	CAMN FC,[XWD -22,FBLK+2];NONE?
	POPJ P,
↑FFX:	MOVEI TAC,(FC)	;ADDRESS GETS FIXED UP TO -(FBLK+2)
	HRRM TAC,FBLK	;SET COUNT
	MOVE TAC,FBLK+1	;GET RELOC BITS
	LSH TAC,-2
		LSH TAC,2	;SHIFT
	AOBJN FC,.-1	;LOOP
	MOVEM TAC,FBLK+1
	MOVN FC,FBLK	;GET  -COUNT
	HRLI FC,-2(FC)	;SUB 2 & PUT IN LEFT
	HRRI FC,FBLK	;SET ADDRESS
	EXCH FC,BC
	PUSHJ P,GBOUT	;OUTPUT IT
	MOVE BC,FC
	MOVE FC,[XWD -22,FBLK+2];INIT
	SETZM FBLK+1
	POPJ P,
↑UPOUT:	PUSH P,BC	;SAVE
	MOVE BC,40	;GET ADDRESS
	LDB TAC,[POINT 4,BC,12];GET COUNT
	MOVNS TAC	;NEGATE
	HRL BC,TAC	;PUT IN LEFT
	PUSHJ P,GBOUT	;OUTPUT IT
	POP P,BC	;RESTORE
	POPJ P,
↑BNAM:	BLOCK =20	;BLOCK NAMES
;R5CON:	COMVERTS SIXBIT IN FS TO RADIX50 & PUTS RESULT
;	IN FS,   USES N
↑R5CON:	MOVEM FS,R5C1
		MOVE FS,[POINT 6,R5C1]
	MOVEM FS,R5C1+1
	ILDB FS,R5C1+1	;GET FIRST CHR.
	MOVE FS,R5TAB(FS);CON TO R5
REPEAT 5,<	ILDB N,R5C1+1
	IMULI FS,50
	ADD FS,R5TAB(N)>
	POPJ P,
R5C1:	BLOCK 2
R5TAB:	FOR I←0,'$'-1
	<0
	>
	46
	47
		FOR I←'%'+1,'.'-1
<0
>
	45
	FOR I←'.'+1,'0'-1
<0
>
	FOR I←1,12
<I
>
	FOR I←'9'+1,'A'-1
<0
>
	FOR I←13,44
<I
>
	FOR I←'Z'+1,77
<0
>

BEND
	;LISTING I/O STUFF
BEGIN LIO
↑UERR:	LDB TAC,LSTPNT	;GET CURRENT CHR
	PUSH P,TAC	;SAVE
	MOVEI TAC,177	;GET DELETE
	DPB TAC,LSTPNT	;OUTPUT
	MOVEI TAC,13	;PRINT...
	IDPB TAC,LSTPNT	;INTEGRAL SIGN
ARNT:	POP P,TAC	;GET BACK THAT CHR
	IDPB TAC,LSTPNT
	MOVE TAC,ERPNT	;GET ERROR POINTER
	PUSH TAC,40	;SAVE ADDRESS
	AOS ERCNT#	;COUNT
		MOVEM TAC,ERPNT
	POPJ P,
↑UFAT:	PUSHJ P,UERR	;PUT OUT MESSAGE
	MOVE TAC,ERPNT
	PUSH TAC,FAT
		AOS ERCNT
	MOVEM TAC,ERPNT
	PUSHJ P,LSTFRC
	JRST FEND
FAT:	[ASCIZ/FATAL/]
↑BLOUT:	TRNN LDEV	;LIST DEVICE?
	POPJ P,		;NO
	MOVE TAC,PCNT+1
	TLNE TAC,INCF	;IN CORE?
	JRST LBLOUT	;YES
	TROE BLOSW	;SET & TEST
	JSR BLOT	;NO LSTFRC SINCE LAST BLOUT
BLRET:	PUSH P,T	;SAVE T
	PUSH P,FS	;SAVE FS
	MOVS FS,OPCNT	;GET OUTPUT LOCATION
	MOVE TAC,OPCNT+1;GET RELOC
	PUSHJ P,OCON	;CONVERT TO ASCII OCTAL
	MOVEM T,LBLK	;STORE IN BUFFER
	MOVEM FS,LBLK+1	;...
LBCON:	MOVE FS,WRD	;GET LEFT HALF
	MOVE TAC,WRD+1	;GET RELOC...
	LSH TAC,-2	;...
	PUSHJ P,OCON	;CONVERT
	MOVEM T,LBLK+2
	MOVEM FS,LBLK+3
	MOVS FS,WRD	;GET RIGHT HALF
	MOVE TAC,WRD+1	;GET RELOC
	PUSHJ P, OCON	;CONVER
	MOVEM T,LBLK+4
	MOVEM FS,LBLK+5
	POP P,FS	;RESTORE...
	POP P,T		;....
	POPJ P,
BLOT:	0
	MOVE TAC,[XWD -6,LBLK]
	PUSHJ P,LOUT	;OUTPUT THE BINARY OCTAL...
	MOVE TAC,[XWD -1,LCR]
	PUSHJ P,LOUT	;AND A CR LF
	JRST @BLOT
↑LBLOUT:TRNE LDEV	;LIST DEVICE?
	SKIPE NOLTSW	;NO LITTERAL LIST?
	POPJ P,		;NO
	TROE BLOSW	;SET & TEST
	JSR BLOT	;NO LSTFRC SINCE...
	PUSH P,T	;SAVE
	PUSH P,FS
	MOVE T,[XWD BLNKS,LBLK]
	BLT T,LBLK+1	;BLANK LOCATION FIELD
	JRST LBCON
BLNKS:	ASCII /     /
	BYTE (7)40,40,11
	ASCII /     /
	BYTE (7)40,40,11
↑VBLOUT:TRNN LDEV	;LIST DEVICE?
	POPJ P,		;NO
	TROE BLOSW	;ANY LSTFRC SINCE?
	JSR BLOT	;NO
	PUSH P,T	;SAVE
	PUSH P,FS
	MOVS FS,OPCNT	;GET LOCATION
	MOVE TAC,OPCNT+1;&RELOC
	PUSHJ P,OCON	;CONVERT TO ASCII
	MOVEM T,LBLK
	MOVEM FS,LBLK+1
	MOVE T,[XWD BLNKS,LBLK+2]
	BLT T,LBLK+5	;BLANK VALUE
	POP P,FS
	POP P,T
	POPJ P,
↑UTRAN:	TRNN LDEV	;LIST DEV EXIST?
	POPJ P,		;NO
	TROE BLOSW	;SET & TEST
	JSR BLOT	;EXTRA BINARY, DUMP IT
	MOVS TAC,40	;GET ADDRESS
		HRRI TAC,LBLK	;SET UP BLT WRD
	BLT TAC,LBLK+5	;BLT
	POPJ P,

LCR:	BYTE(7)15,12
↑OCON:	MOVEI T,6
		HRRI FS,
REPEAT 4,<	LSHC T,3
	LSH T,4
	ORI T,6>
	LSHC T,3
	LSH T,1
	LSH FS,-4
	OR FS,[BYTE(7)60,40,11,0,0]
	TRNE TAC,1	;RELOC?
	ADD FS,[("'"-40)⊗26]
	POPJ P,
↑XPNDSW:0
↑LSTLF:	SKIPGE AHED	;LINE FEED SEEN -- IF NOT FROM MACRO
	AOS INLINE	;UPDATE LINE NUM (FOR NON-SOS FILES)
↑LSTFRC:MOVNI TAC,1
	CAMN TAC,LTEST	;OVERRUN
	JRST FLST	;NO
	OUTSTR [ASCIZ/LINE TOO LONG, CAN'T CONTINUE,
I DIE NOW/]
	MOVE TAC,[JRST LSTFRC]
	MOVEM TAC,STRT
	JRST 4,.

	BYTE (7)11,11,11
↑MBLK:	BLOCK 1000
↑LBLK:	BLOCK 6
↑TLBLK:	BLOCK 1000
LTEST:	-1

;ROUTINE TO OUTPUT TO LISTING FILE - AOBJN PNTR IN TAC
↑LOUT:	PUSH P,T	;SAVE
	PUSH P,FS	;SAVE
LOUT0:	PUSH P,TAC
	MOVE FS,(TAC)
LOUT1:	MOVEI T,
	LSHC T,7
LOUT1A:	SKIPL TAC,CTAB(T)
	JRST LOUTS	;MIGHT BE SPECIAL
LOUT2:	AOS TAC,CHRCNT
	CAML TAC,CHRPL
	JRST LOUTOV	;OVERFLEW LINE
LOUT3:	SOSG LOB+2
	OUTPUT 4,
	IDPB T,LOB+1
LOUT4:	JUMPN FS,LOUT1
	POP P,TAC
	AOBJN TAC,LOUT0
	POP P,FS
	POP P,T
	POPJ P,

LOUTS:	TLNE TAC,SCRF!CRFG
	XCT LOUTTB(TAC)	;THIS CHAR NEEDS WORRYING
	JUMPN TAC,LOUT2	;JUST ORDINARY SPEC CHR?
	JRST LOUT4	;FLUSH NULLS
;HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED
	JRST LOUT2	;FOR SLURP HACK ETC.
LOUTTB:	JRST LOUTDL	;RUBOUT
	JRST LOUTLF	;LF
	JRST LOUT2	;"↔;
	JRST LOUT2	;'
	JRST LOUT2	;=
	JRST LOUTSP	;SP & TAB
	JRST LOUTCR	;CR
	JRST LOUTFF	;FF
	JRST LOUT2	;<{
	JRST LOUT2	;>}

LOUTLF:	SOSLE LNCNT
	JRST LOUT3	;JUST OUTPUT IF NO PAGE OFLO
	SKIPL LNCNT	;DON'T CLOBBER CHAR IF ABOUT TO DO HEADING
	MOVEI T,14	;ELSE TURN INTO FF
LOUTFF:	SKIPGE LNCNT	;IF ALREADY OFF PAGE
	JRST LOUTH	;THEN DO HEADING
	SKIPGE CHRCNT	;SEE IF DOING CREF STUFF
	JRST LOUT3	;AND AVOID SPECIAL TREATMENT FOR FF
	MOVSI TAC,1	;OTHERWISE USE A BIG NUMBER
	MOVEM TAC,CHRCNT;TO GET US TO LOUTH ON THE NEXT CHAR
	SETOM LNCNT	;MARK US OFF PAGE
	JRST LOUT3	;AND GO OUTPUT FF

LOUTCR:	HLLZS CHRCNT	;CR RESETS POS EXCEPT HEADING FLAG
	JRST LOUT3

LOUTSP:	CAIE T,11	;SEE IF THIS "SPACE" IS A TAB
	JRST LOUT2	;NO
	MOVEI TAC,7	;YES - UPDATE POS TO TAB STOP
	IORM TAC,CHRCNT	;(ACTUALLY 1 SHORT)
	JRST LOUT2	;AOS AT LOUT2 WILL MAKE IT RIGHT

LOUTOV:	TLNE TAC,-1	;CHECK IF THIS IS REALLY HEADING FLAG
	JRST LOUTH	;YES
	HRROI TAC,[ASCIZ /
/]
	PUSHJ P,LOUT	;JUST OFLO - STICK IN CRLF
	JRST LOUT1A	;& REPROCESS CURRENT CHAR
LOUTDL:	SKIPLE LNCNT
	JRST LOUT3	;PASS RUBOUT QUIETLY IF HEADING NOT NEEDED
LOUTH:	PUSHJ P,LOUTH1	;DO HEADING STUFF
	JRST LOUT1A	;REPROCESS CURRENT CHAR

LOUTH1:	HRROI TAC,[BYTE (7)15]	;HEADING TIME - FIRST OUTPUT CR
	PUSHJ P,LOUT
	SETZM CHRCNT	;& CLEAR FLAG
	MOVEI TAC,LNPP
	MOVEM TAC,LNCNT	;RESET LINE COUNTER
	MOVE TAC,TITCNT
	PUSHJ P,LOUT
	PUSHJ P,PTIM
	MOVE TAC,HEDCNT
	PUSHJ P,LOUT
	MOVE TAC,SUBCNT
	JRST LOUT

	DEFINE DEP
<	ADDI N,60
	ADDI NA,60
	IDPB N,PTPNT
	IDPB NA,PTPNT
>
↑TITCNT:	XWD -1,.+1
	0
	BLOCK 40

HEDCNT:	XWD -LHEAD,.+1
	ASCII /		FAIL	/
HEAD:	BLOCK 4
↑FILNM:	BLOCK 3
	ASCII /   Page/
PG:	ASCII /  /
	BLOCK 3		;ALLOW ROOM FOR BLOCK NAME TOO
	11*200*2	;FINISH WITH A TAB
LHEAD←←.-HEDCNT-1

↑SUBCNT:	XWD -1,.+1
	BYTE (7)15,12,15,12
	BLOCK 40
PTPNT:	0
PTIM:	PUSH P,N
	PUSH P,NA
	CALLI N,14	;GET DATE
	MOVE NA,[POINT 7,HEAD]
	MOVEM NA,PTPNT
	IDIVI N,=31	;GET DAY
		MOVEM N,PG+1	;SAVE
	MOVEI N,(NA)1	;GET DAY
	IDIVI N,12	;CON TO DEC
	SKIPN N		;ZERO LEADING DIGIT?
	MOVNI N,20	;YES, CON TO BLANK
	DEP
	MOVEI N,"-"
	IDPB N,PTPNT
	MOVE N,PG+1	
	IDIVI N,=12	;GET MONTH & YEAR
	MOVE NA,MOTAB(NA);GET MONTH NAME
	IDPB NA,PTPNT	;DEPOSIT
	LSH NA,-7
	IDPB NA,PTPNT
	LSH NA,-7
	IDPB NA,PTPNT
	MOVEI NA,"-"
	IDPB NA,PTPNT
	ADDI N,=64
	IDIVI N,12
	DEP
		MOVEI N,40
	IDPB N,PTPNT
	IDPB N,PTPNT
		CALLI N,23	;GET TIME
	IDIVI N,=60000	;THROW AWAY M.S & SEC
	IDIVI N,=60	;GET HRS & MINS
	MOVEM NA,PG+1	;SAVE MINS
	IDIVI N,12	;CON TO DEC
		SKIPN N
	MOVNI N,20
		DEP
	MOVE N,PG+1
	MOVEI NA,":"
	IDPB NA,PTPNT
	IDIVI N,12
	DEP
	SETZM PG+1
	SETZM PG+2
	SETZM PG+3
	HRRZS PG+4
	MOVE N,[POINT 7,PG,13]
	MOVEM N,PTPNT
	MOVE N,PGNM	;GET PAGE NUM
	PUSHJ P,PGCON
	AOS N,SPGNM
	CAIG N,1
	JRST PTIM2
	MOVEI NA,"-"
	IDPB NA,PTPNT
	PUSHJ P,PGCON
PTIM2:	MOVEI N,15
	IDPB N,PTPNT
	MOVEI N,12
	IDPB N,PTPNT
	MOVE NA,[440600,,LSTLAB+3]	;TO GET BLOCK NAME
REPEAT 6,<	ILDB N,NA
		ADDI N,40
		IDPB N,PTPNT>
	POP P,NA
	POP P,N
	POPJ P,
PGCON:	IDIVI N,12	;CON TO DEC
	JUMPE N,PGCOA	;0?
		HRLM NA,(P)	;SAVE REMAINDER
	PUSHJ P,PGCON
	HLRZ NA,(P)	;GET REMAINDER
PGCOA:	ORI NA,60
	IDPB NA,PTPNT
	POPJ P,
MOTAB:	FOR AARDVARK IN (NAJ,BEF,RAM,RPA,YAM,NUJ,LUJ,<GUA>
	,PES,TCO,VON,CED)
<	"AARDVARKSESHOHOHO"
>
↑SPGNM:	0
↑PGNM:	0
↑LNCNT:	0
↑ERPD:	BLOCK ERPLEN
↑ERPNT:0
↑PGBF:	0↔0	;FOR TYPING PAGE NUMBERS IN ERROR MESSAGES--DCS 2/6/70
FLST:	SKIPN ERCNT	;ANY ERRORS?
	JRST	QLST	; NO
	SKIPN	TTYERR	;IF ANYBODY WILL WANT MESSAGE,
	 JRST	 LSTAR	; THEN PRINT STARS
	SKIPN	LISTSW
	 JRST	 QLST	; DON'T EVEN CONSIDER IT
LSTAR:	PUSH	P,N
	MOVEI	N,[ASCIZ /#####/]
	PUSHJ	P,ERLST	;PRINT STARS
	POP	P,N
	SKIPE TTYERR	;LIST ERRORS ON TTY?
	JRST QLST	;NO
	MOVE TAC,LSTPNT
	TLO TAC,700	;SIZE MIGHT BE 0 IN MACRO
	CAMN TAC,[350700,,TLBLK+1]
	JRST QLST

; PRINT FILE NAME AND PAGE NUMBER -- DCS 2/6/70

	PUSH P,T
	MOVEI T,15	;MAKE SURE WE GET A CR-LF
	IDPB T,TAC
	MOVEI T,12
	IDPB T,TAC
	MOVE	TAC,[POINT 7,FILNM]
	JSR	ASCFIL		     ; SEE BELOW
	MOVE	TAC,[POINT 7,[ASCIZ /,  PAGE  /]]
	JSR	ASCFIL		     ;PRINT THAT TOO
	PUSH	P,N
	PUSH	P,NA
	MOVE N,PGNM
	PUSHJ P,PGOUT
	SKIPE TLBLK
	JRST FLPG2	;SOS LINE NUM EXISTS -- USE IT
	MOVE TAC,[440700,,[ASCIZ /,  LINE  /]]
	JSR ASCFIL
	MOVE N,INLINE
	PUSHJ P,PGOUT	;NO NUM -- USE OUR OWN
FLPG2:	POP P,NA
	POP P,N
	MOVE	TAC,[POINT 7,[BYTE (7) 15,12]]
	JSR	ASCFIL		    ;AND CRLF PRECEDING LINE PRINTOUT

; END OF DCS PATCH -- T SAVED ABOVE FOR POP BELOW

	SKIPE TLBLK			;ANY SOS LINE NUM?
	SKIPA TAC,[POINT 7,TLBLK]	;YES, PRINT IT
	MOVE TAC,[350700,,TLBLK+1]	;NO, SKIP IT
CLOP3:	ILDB T,TAC	;GET CHR OF LINE
	CAIN T,177	;DELETE?
	JRST CLOP2	;YES
CLOP4:	JSR OUT	;TYPE IT
	CAIE T,12	;DONE IF IT'S LF
	JRST CLOP3
	POP P,T
	JRST QLST

CLOP2:	ILDB T,TAC
	CAIN T,13	;INTEGAL SIGN?
	HRROI T,12	;YES, USE LINE-FEED (BUT AVOID COMPARE)
	JRST CLOP4

QLST:	TRNE LDEV	;LISTING?
	JRST YESL	;YES
	HRRZ TAC,LSTPNT
	CAIGE TAC,TLBLK	;POINTER IN MACRO?
	SKIPA TAC,[POINT 7,MBLK+1,6];YES
	MOVE TAC,[POINT 7,TLBLK+1,6]
	MOVEM TAC,LSTPNT	;RESET LSTPNT
	SKIPN UNDLNS	;UNDERLINING?
	JRST ERSCN	;NO
	SETZM MBLK
	MOVE TAC,[XWD MBLK,MBLK+1]
	BLT TAC,LTEST-1;CLEAR BUFFER
	MOVE TAC,[BYTE (7) 11]
	MOVEM TAC,TLBLK+1
	JRST ERSCN	;PRINT ERRORS

; TYPE ASCIZ STRING WHOSE BYTE POINTER IS IN TAC

ASCFIL:	0		;JSR
ASCF1:	ILDB	T,TAC	;GET A CHR
	JUMPE	T,@ASCFIL ;RETURN WHEN DONE
	JSR	OUT	; TYPE IT
	JRST	ASCF1	; RETURN FOR MORE

PGOUT:	IDIVI N,12
	JUMPE N,.+4
	HRLM NA,(P)
	PUSHJ P,PGOUT
	HLRZ NA,(P)
	MOVEI T,"0"(NA)
	JSR OUT
	POPJ P,
YESL:	SKIPN XPNDSW	;NOT EXPANDING NOW?
	POPJ P,		;YES
	TRNN MACUNF	;WAS A MACRO SEEN?
	JRST LARND	;NO
	PUSH P,N
	PUSH P,NA
	MOVE N,[POINT 7,MBLK]
	MOVE NA,[POINT 7,TLBLK]
LOOP1:	ILDB TAC,NA	;GET CHR FROM PRIMARY BUFFER
	JUMPE TAC,LNUL	;NULL?
	CAIN TAC,177	;DELETE?
	JRST LDEL	;YES
	CAIN TAC,11	;TAB?
	JRST LSPA	;YES
	CAIN TAC,15	;CR?
	JRST LCRE	;YES
	MOVEI TAC,40	;NONE OF THE ABOVE  (USE SPACE)
LSPA:	IDPB TAC,N	;DEPOSIT IN SECONDARY BUFFER
	JRST LOOP1
LDEL:	IBP N
	ILDB TAC,NA
	JRST LSPA
LNUL:	ILDB TAC,N	;GET OTHER CHR.
	JUMPE TAC,LOOP1	;BOTH NULL?
	CAIN TAC,177	;DELETE?
	JRST LOOP1	;YES
	CAIN TAC,11	;TAB?
	JRST OTAB	;YES
	CAIN TAC,15	;CR?
	JRST OCRE	;YES
	CAIN TAC,40	;SPACE?
	JRST OTAB	;YES
	MOVEI TAC,30	;UNDERLINE
OTAB:	DPB TAC,NA
	JRST LOOP1
LCRE:	IDPB TAC,N
OCRE:	DPB TAC,NA
	MOVEI TAC,
	IDPB TAC,N
	MOVEI TAC,12
	IDPB TAC,NA
LARND:	SKIPN CREFSW	;CREFING?
	JRST NOCREF	;NO
	MOVEI TAC,177	;DEPOSIT...
	IDPB TAC,CREFPT	;END...
	MOVEI TAC,101	;OF...
	IDPB TAC,CREFPT	;CREF
	PUSHJ P,CREFR	;DUMP THE INFO
NOCREF:	TRNN MACUNF
	JRST NOMAC
	MOVN TAC,N
	ADDI TAC,MBLK-2
	HRLI TAC,MBLK-1
	MOVSS TAC
	PUSHJ P,LOUT
	MOVN TAC,NA
	SKIPA
NOMAC:	MOVN TAC,LSTPNT	;FORM...
	ADDI TAC,LBLK-1	;COUNT
	HRLI TAC,LBLK
	TRZE BLOSW	;ANY BINARY
	JRST BYES	;YES
	ADDI TAC,5	;REDUCE COUNT
	PUSH P,[BYTE (7)11,11,11];TAB ACROSS
	POP P,LBLK+5
	HRLI TAC,LBLK+5	;SET ADDRESS
BYES:	MOVSS TAC	;SET UP CONTROL WORD FOR...
	PUSHJ P,LOUT	;LOUT
	SETZM MBLK
	MOVE TAC,[XWD MBLK,MBLK+1]
	BLT TAC,LTEST-1;CLEAR BUFFERS
	MOVE TAC,[BYTE (7) 11]
	MOVEM TAC,TLBLK+1
	HRRZ TAC,LSTPNT
	TRNN MACUNF
	JRST .+3
	POP P,NA
	POP P,N
	CAIL TAC,TLBLK
	SKIPA TAC,[POINT 7,TLBLK+1,6]
	SKIPA TAC,[POINT 7,MBLK+1,6]
	TRZ MACUNF	;CLEAR FLAG
	MOVEM TAC,LSTPNT;RESET LSTPNT
ERSCN:	SKIPN ERCNT	;NONE?
	POPJ P,		;NONE
	SKIPN LISTSW	;LIST DEVICE?
	SKIPN TTYERR	;ERRORS ON TTY?
	JRST ERS1	;SOMEONE WANTS ERROR MEXXAGES
NOITS,<	HLLOS 42>	;MARK THAT ERRORS HAVE HAPPENED
	MOVE TAC,[XWD -ERPLEN,ERPD-1]
	MOVEM TAC,ERPNT	;NO ONE IS INTERESTED IN THESE LONELY...
	SETZM ERCNT	;ERROR MESSAGES
	POPJ P,
ERS1:	PUSH P,N	;SAVE
	PUSH P,NA	;SAVE NA
	PUSH P,T
	PUSH P,FS
	MOVE FS,LSTLAB+1;GET BLOCK NAME
		PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,LABPRT	;SAVE
	MOVE N,FS	;SAVE LAST CHR
	MOVE FS,LSTLAB	;GET LABEL NAME
	PUSHJ P,AFROM6	;CON TO ASCII
	OR N,[BYTE(7)0,40,"&",40]
	ROT T,7
	DPB T,[POINT 7,N,34]
	MOVEM N,LABPRT+1;DEPOSIT SECOND WORD
	ROT FS,7
	DPB FS,[POINT 7,T,34]
	MOVEM T,LABPRT+2;DEPOSIT THRID WORD
	MOVE N,PCNT	
	SUB N,LSTLAB+4	;GET DEVIATION
	SETZM LABPRT+3
	JUMPE N,RCQ
	MOVE T,[POINT 7,LABPRT+3];SET UP POINTER
	MOVEI NA,"+"
	IDPB NA,T	;DEPOSIT +
	PUSHJ P,RCR	;CONVERT
	MOVEI NA,
	IDPB NA,T
RCQ:	MOVEI N,LABPRT
		PUSHJ P,ERLST
	POP P,FS
	POP P,T
	MOVE NA,ERPNT	;GET ERROR POINTER
ELOP:	POP NA,N	;GET MESSAGE
	PUSHJ P,ERLST	;LIST IT
	SOSLE ERCNT	;ANY MORE?
	JRST ELOP	;YES
	MOVEM NA,ERPNT	;RESTORE
	POP P,NA
	POP P,N
	SKIPN	ERSTSW		;SHOULD WE STOP?
	POPJ	 P,		; NO
IFE EDITSW,<
	OUTSTR [ASCIZ /TYPE CR OR LF TO CONTINUE 
*/]
>

IFN EDITSW <
; BEGIN TVR PATCH	OCT '72
	OUTSTR [
ASCIZ /REPLY 'E' - EDIT, [CR] TO CONTINUE, [LF] TO CONTINUE AUTOMATICALLY
→/]
>
	CLRBFI		;CLEAR TYPEAHEAD
	INCHWL TAC	;WAIT FOR ACTIVATION
	CLRBFI		;CLEAR TTY INPUT BUFFER
IFN EDITSW <
	CAIE TAC,"e"
	CAIN TAC,"E"
	JRST EDGO
; END TVR PATCH
>
	CAIN	TAC,12		;TURN OFF ERSTSW?
	SETZM	 ERSTSW		; YES
	POPJ	P,

; END DCS PATCH
	
IFN EDITSW <
;INVOKE AN EDITOR	TVR - OCT '72
EDGO:	MOVE 14,FNAM		;GET FILENAME
	HLLZ 13,FNAM+1		;GET EXTENSION
	MOVE 11,SAVPPN		;GET PPN
	MOVE 16,PGNM		;GET PAGE NUMBER
	MOVE 0,[XWD [SIXBIT/SYS/	;GET READY TO SWAP
	EDSWAP:	 SIXBIT/SOS/
		 SIXBIT/DMP/
		 1		;RPG OFFSET
		 0],1]		;SYSTEM AREA
	BLT 0,5
	SKIPN 15,TLBLK		;DOES IT HAVE LINE NUMBERS?
	SKIPA 2,[SIXBIT/E/]	;NO, ASSUME IT'S A TV FILE (POOR TECO LOSES!)
	SKIPA 2,[SIXBIT/SOS/]	;YES, USE SOS
	MOVE 15,INLINE		;NO LINENUMBERS, GET COUNT INSTEAD
	MOVEI 0,1
	SWAP 0,			;SWAP
	HALT .-1		;IN CASE IT LOSES
>

LABPRT:	BLOCK 6
RCR:	IDIVI N,10
		JUMPE N,.+4
	HRLM NA,(P)
	PUSHJ P,RCR
	HLRZ NA,(P)
	ORI NA,60
	IDPB NA,T
	POPJ P,
↑ERLST:	SETZM SW1
NOITS,<	HLLOS 42>	;MARK THAT ERRORS HAVE HAPPENED
	PUSH P,T
	PUSH P,FS	
	PUSH P,O
ELOP2:	HRROI TAC,(N)
	SKIPE LISTSW	;LIST DEVICE?
	PUSHJ P,LOUT	;YES
	MOVEI O,5
	MOVE FS,(N)	;GET FIRST WORD
ELOP1:	MOVEI T,
	LSHC T,7	;GET CHR.
	JUMPE T,EDON	;DONE?
	SKIPN TTYERR	;NO, TTY ERR LIST?
	JSR OUT	;YES,LIST
	SOJG O,ELOP1	;MORE THIS WORD?
	AOJA N,ELOP2	;NO, GET NEXT WORD
SW1:	0
EDON:	SKIPE SW1
	JRST EDON1
	SETOM SW1
	MOVEI N,[BYTE(7)15,12]
	JRST ELOP2
EDON1:	POP P,O
	POP P,FS
	POP P,T
	POPJ P,
↑CREFPT:0
↑CREFTB:BYTE (7)177,102
	BLOCK 100
↑UCREF6:SKIPN LISTSW	;LISTING?
	POPJ P,		;NO
	LDB TAC,[POINT 4,40,12]	;NO SIZE CHECK IF 0
	JUMPE TAC,OENT	;AND NO IDPB CREFPT EITHER
	HRRZ TAC,CREFPT	;GET THE POINTER ADRESS
	CAIGE TAC,CREFTB+70	;SEE IF WE ARE ALMOST AT THE END
	JRST NOCDM	;NO, GO ON
	MOVEI TAC,177
	IDPB TAC,CREFPT
	MOVEI TAC,104
	IDPB TAC,CREFPT	;GIVE IT A JUST EAT OP
	PUSHJ P,CREFR	;AND DUMP
NOCDM:	LDB TAC,[POINT 4,40,12];GET TYPE
	IDPB TAC,CREFPT	;DEPOSIT
OENT:	HRRZ TAC,40	;GET SIXBIT
	PUSH P,L	;SAVE L
	MOVEI L,6	;INIT SIZE
	IDPB L,CREFPT	;DEPOSIT SIZE
	PUSH P,T	;SAVE T
CLOOP1:	LDB T,[POINT 3,TAC,20];GET CHR.
	ADDI T,"0"
	IDPB T,CREFPT	;DEPOSIT CHR.
	LSH TAC,3	;SHIFT
	SOJG L,CLOOP1	;DONE?
CRFRT:	POP P,T		;YES, RESTORE
	POP P,L
	POPJ P,
↑UCREF7:SKIPN LISTSW
	POPJ P,
	HRRZ TAC,CREFPT	;GET THE POINTER ADRESS
	CAIGE TAC,CREFTB+70	;SEE IF WE ARE ALMOST AT THE END
	JRST NOCDM7	;NO, GO ON
	MOVEI TAC,177
	IDPB TAC,CREFPT
	MOVEI TAC,104
	IDPB TAC,CREFPT	;GIVE IT A JUST EAT OP
	PUSHJ P,CREFR	;AND DUMP
NOCDM7:	LDB TAC,[POINT 4,40,12]
	IDPB TAC,CREFPT
	JRST UCRF67
↑UCRF66:SKIPN LISTSW	;LISTING?
	POPJ P,		;NO
	PUSHJ P,UCREF6
UCRF67:	MOVE TAC,@40	;NOW GET THE SIXBIT
	PUSH P,L
	MOVEI L,5
	TLNE TAC,770000	;JUSTIFY
	AOJA L,LADJ
	LSH TAC,6
	SOJG L,.-3
	MOVEI L,1
LADJ:	IDPB L,CREFPT
	PUSH P,T
CLOOP2:	LDB T,[POINT 6,TAC,5]
	ADDI T,40
	IDPB T,CREFPT
	LSH TAC,6
	SOJG L,CLOOP2
	JRST CRFRT
CREFR:	MOVEI TAC,	;PUT OUT THE CREF INFO
	REPEAT 5,<IDPB TAC,CREFPT>
	SKIPG LNCNT
	PUSHJ P,LOUTH1	;OUTPUT HEADING IF NEEDED (BEFORE CREF JUNK)
	MOVN TAC,CREFPT	;FORM...
	ADDI TAC,CREFTB	;COUNT
	HRLI TAC,CREFTB	;ADDRS
	MOVSS TAC
	PUSH P,CHRCNT
	PUSH P,LNCNT
	HLLZM TAC,CHRCNT	;SET COUNTS TO PREVENT
	HRRZM TAC,LNCNT		;OVERFLOW DETECTION
	PUSHJ P,LOUT	;PUT OUT CREF
	POP P,LNCNT		;RESTORE COUNTS
	POP P,CHRCNT
	MOVE TAC,[POINT 7,CREFTB,13]
	MOVEM TAC,CREFPT
	POPJ P,
	BEND
	SUBTTL ..END, BEND, BEGIN..

BEGIN ENDS

;BEGIN AND END AND BEND ROUTINES

DOEND:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST [SUB P,[1,,1]↔JRST PSLIT]
	PUSHJ P,VAR
	PUSHJ P,LITOUT	;PUT OUT LITTERALS
	HRRZ N,BLOCK
	CAIE N,1	;AT OUTER LEVEL?
	ERROR[ASCIZ/YOU ARE SUFFERING FROM THE UNFORTUNATE FACT THAT YOUR
INCOMPLETE PROGRAM HAS AN INSUFFICIENT
NUMBER OF STATEMENTS CONSISTING OF OR STARTING WITH
THE PSEUDO-OP  BEND/]
	TRO NOFXF
	PUSHJ P,MEVAL	;GET ADDRESS
	TLNE ESPF	;SPECIAL CHR?
	JRST SPC	;YES
	TLNE UNDF	;DEFINED?
	ERROR[ASCIZ/UNDEFINED ADDRESS -- END/]
	MOVEM N,EN1+2	;DEPOSIT STARTING ADDRESS
	ANDI NA,1	;FORM...
	ROT NA,-2	;RELOCATION
	MOVEM NA,EN1+1	;AND DEPOSIT
	POUT 3,EN1	;PUT OUT THE STARTING ADDRESS NOW
EZERF:	PUSHJ P,BEND	;DOO SYMBOL THINGS
	PUSHJ P,BFRC	;FORCE OUT BINARY
	PUSHJ P,FXFRC	;FORCE OUT FIXUPS
	MOVEI O,HASH-1	;INIT COUNT
ELOOP2:	SKIPN PN,SYMTAB(O);GET START OF CHAIN
	JRST NONTE	;NONE
ELOOP1:	SKIPE CREFSW
	CREF66 11,(PN)
	MOVE N,2(PN)	;GET FLAGS
	TLNE N,EXTF	;EXTERNAL?
	JRST EEXT	;YES
	TLNE N,DEFFL	;DEFINED?
	JRST EUND	;NO
	TLNE N,INTF	;INTERNAL?
	JRST EINT	;YES
ECON:	SKIPE PN,1(PN)	;GET NEXT
	JRST ELOOP1
NONTE:	SOJGE O,ELOOP2	;NO MORE, GET NEXT CHAIN
	JRST EPNT	;DONE
EINT:	MOVE FS,(PN)	;GET SIXBIT
	PUSHJ P,R5CON	;CON TO R5
	TLO FS,40000	;MARK AS INTERNAL
	MOVE N,2(PN)
	TLNE N,DBLF
	TLO FS,SNB	;THESE CAN BE HALF-KILLED, TOO
	MOVEM FS,IOU+2	;DEPOSIT
	MOVE L,3(PN)	;GET VALUE
	MOVEM L,IOU+3	;DEPOSIT
	MOVE L,4(PN)	;GET RELOC
	DPB L,[POINT 1,IOU+1,3];DEPOSIT
	POUT 4,IOU	;OUTPUT IT
	JRST ECON
IOU:	XWD 2,2
		BLOCK 3
EEXT:	MOVE FS,(PN)	;GET SIXBIT
	PUSHJ P,R5CON	;CON TO R5
	TLO FS,600000	;MARK AS EXT
	MOVEM FS,IOU+2	;DEPOSIT
	SKIPN N,3(PN)	;GET FIXUP POINTER
	JRST	[SETZM IOU+1	;ISSUE NULL REQUEST
		SETZM IOU+3	;TO ABS 0
		POUT 4,IOU
		JRST ECONN]
EXCON:	SKIPE NA,(N)	;GET DEVIATION
	JRST POLEX	;NOT 0
	MOVE TAC,2(N)	;GET FLAGS
	TRNE TAC,3	;LEFT HALF OR FULL?
	JRST POLEX	;YES
	MOVE TAC,3(N)	;GET VALUE
	MOVEM TAC,IOU+3	;DEPOSIT
	MOVE TAC,4(N)	;RELOC
	DPB TAC,[POINT 1,IOU+1,3];DEPOSIT
	POUT 4,IOU	;OUTPUT
		SKIPE N,1(N)	;GET NEXT
	JRST EXCON	
ECONN:	SKIPN N,4(PN)	;ANY POLFIXES?
	JRST ECON	;NO
ECLOP:	SOSG 1(N)	;LAST SYM?
	JRST LAST	;YES
	MOVSS N
	SKIPN N,2(N)	;GET NEXT
		JRST ECON
	JRST ECLOP	;MORE
LAST:	MOVEI FS,5(N)	;SET UP POINTER
	PUSH P,O
	PUSHJ P,REDUC	;REDUCE POLISH
	POP P,O
	PUSHJ P,BFRC	;FORCE OUT BIN
	MOVEI FS,5(N)	;SET UP POINTER
	MOVS NA,N	;GET NEXT
	MOVE NA,2(NA)	;...
	PUSHJ P,POLOUT	;PUT OUT POLISH
	SKIPN N,NA	;ANY MORE?
	JRST ECON	;NO
	JRST ECLOP	;YES
EXPOL:	(11)5
	0
	2(3)
	0
	(1)
	0
	0
POLEX:	MOVE NA,N
	MOVE FS,(PN)	;GET SIXBIT
	PUSHJ P,R5CON	;CON TO RADIX50
	TLO FS,40000
	MOVEM FS,EXPOL+3;DEPOSIT
		MOVE FS,(NA)	;GET DEVIATION
	HRLM FS,EXPOL+5	;DEPOSIT
	HLRM FS,EXPOL+4	;...
	MOVE FS,2(NA)	;GET FLAGS
	ANDI FS,3
	SETCA FS,	;FORM STORE OP
	HRRM FS,EXPOL+5	;DEPOSIT
	MOVE FS,3(NA)	;GET FIXUP LOC.
	HRLM FS,EXPOL+6	;DEPOSIT
	MOVE FS,4(NA)	;GET RELOC
	DPB FS,[POINT 1,EXPOL+1,8];DEP.
	POUT 7,EXPOL	;OUTPUT IT
	SKIPE N,1(NA)	;GET NEXT
	JRST EXCON	;MORE
	JRST ECONN	;NO MORE
EUND:	MOVE FS,(PN)	;GET SIXBIT
	PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,EUOUT	;DEPOSIT
	OR FS,[BYTE (7)0,11,"U","N","D"]
	MOVEM FS,EUOUT+1;DEPOSIT
		SKIPE FS,3(PN)	;GET FIXUP POINTER
	SKIPA TAC,4(FS)	;GET RELOC
	SKIPA TAC,[0]	;NO RELOC(NO FIXUP)
	MOVE FS,3(FS)	;GET FIXUP VALUE
	MOVSS FS
	PUSHJ P,OCON	;CON TO OCTAL ASCII
	MOVEM T,EUOUT+3	;DEPOSIT
	MOVEM FS,EUOUT+4;...
	MOVEI N,EUOUT
	PUSHJ P,ERLST	;LIST
	JRST ECON
EPNT:
EN3:	PUSHJ	P,SBFRC	;FORCE OUT SYMBOLS
	 MOVE N,SEG
	CAIN N,0	;SEGMENTED PROGRAM?
	JRST .+7	;NO
EN4:	MOVE N,HICNT	;YES GET HIGH BREAK
	MOVEM N,EN5+2	;DEPOSIT IT
	MOVE N,LOCNT	;GET LOW BREAK
	MOVEM N,EN5+3	;DEPOSIT IT
	POUT 4,EN5
	JRST .+4
NBK:	MOVE N,OPCNT	;GET PROGRAM BREAK
	MOVEM N,EN2+2	;DEPOSIT
	POUT 3,EN2	;OUTPUT IT
	MOVEM N,WRD
	PUSHJ P,BLOUT
	PUSHJ P,SCNTIL	;GET TO LF AND FORCE LISTING
	POPJ P,

↑%END:	PUSHJ P,DOEND
↑FEND:	CLOSE 1,
↑FEND1:	RELEAS 4,
	RELEAS 2,
NOITS,<
	MOVS N,RELFIL+4
	TRNE BDEV
	CAIE N,'DSK'
	JRST FEND2
	CLOSE 3,	;GODDAM DSKSER SCREWS FILE IF RENAME BEFORE CLOSE
IFE STANSW,<
	CALLI N,22	;GET TIME
	IDIVI N,=60*=60	;IN MINS
	CALLI NA,14	;& DATE
	DPB N,[141300,,NA]
	TLO NA,(<14,>)	;KEEP THE MODE HONEST
>
IFN STANSW,<
	DSKTIM NA,	;GET DATE & TIME
	TLO NA,(<SETZ 14,>)	;MODE 14, PROT 400 (DUMP NEVER)
>
	MOVEM NA,RELFIL+2
	SETZM RELFIL+3
	RENAME 3,RELFIL	;ADJUST DATE & TIME TO END OF ASSEMBLY (LESS RPG LOSSAGE)
	JFCL
>;NOITS
FEND2:	RELEAS 3,
ITS,<	CALLI 12	>
	JRST STRT1

EUOUT:	BLOCK 2
	ASCII /EF  	/
	BLOCK 2
EN1:	XWD 7,1
	0
	0
EN2:	XWD 5,1
	MOVE
	0
EN5:	XWD 5,2
	XWD 240000,0
	0
	0

;PRGEND -- DOES END STUFF & RESTARTS PAST I/O INITIALIZATION
↑%PRGEN:PUSHJ P,DOEND
	HRROI TAC,[BYTE (7)14]
	TRNE LDEV
	PUSHJ P,LOUT	;DO PAGE HEADING IF NECC
	JRST STRT2
SPC:	TLNN N,CRFG	;CR?
	ERROR[ASCIZ/SPECIAL CHR IN ADDRESS FIELD -- END/]
	JRST EZERF
BDOUT:	XWD 2,22
	0		;RELOCATION INFORMATION
	BLOCK	22	;ROOM FOR MANY MANY SYMBOLS.....
BNPT:	ASCII /       	/
	BLOCK 3
	ASCII /    	/

COMMENT ⊗

ROUTINE TO PUT OUT SYMBOLS IN REASONABLE FASHION.

CALL IS WITH:
	FS		RADIX 50 FOR SYMBOL.
	NA		VALUE
	L		IF NON-ZERO, RELOCATED.

⊗

↓SBOUT:
	PUSH	P,O	;NEED AN AC.
	AOS	BDOUT
	AOS	O,BDOUT
	MOVEM	FS,BDOUT(O)	;NAME.
	MOVEM	NA,BDOUT+1(O)	;VALUE
	TRZ	L,12
	TRZE	L,4		;CHANGE RELOCATION BITS.
	TRO	L,2
	IDPB	L,BYTPT		;STORE SAME.
	CAME	O,[XWD 2,22]	;DONE?
	JRST	STSQM		;DONE THIS SOON.
	PUSH	P,SBRRT
SBFRC:	PUSH	P,TAC
	PUSH	P,BC
	MOVEI	BC,BDOUT
	HRRZ	TAC,BDOUT	;COUNT
	TRNN	TAC,-1
	JRST	SBDON
	MOVNS	TAC		;- COUNT.
	HRLI	BC,-2(TAC)	;NEW COUNT.
	PUSHJ	P,GBOUT		;WRITE IT OUT.
SBDON:	POP	P,BC
	POP	P,TAC
SBRRT:	POPJ	P,.+1
STSYM:	HLLZS	BDOUT		;RESTART COUNT.
	MOVE	O,[POINT 4,BDOUT+1]
	MOVEM	O,BYTPT		;RESTART BYTE POINTER.
STSQM:	POP	P,O
	POPJ	P,

↑SBINI:	PUSH	P,O
	JRST	STSYM

BYTPT:	0
BEGIN BEND

↑↑BEND:	MOVE NA,BLOCK
	SUBI NA,1	;FORM WORD WITH ALL...
	MOVEM NA,OBLK	;HIGHER LEVEL BITS ON
	MOVE NA,BLOCK
	LSH NA,-1	;FORM WORD WITH NEXT...
	MOVEM NA,BLOCKN	;BIT ON
	MOVE NA,BLOCK	;GET BLOCK...
	FAD NA,[0]	;NUMBER
	LDB NA,[POINT 8,NA,8]
	MOVE FS,BNAM-347(NA);GET NEXT BLOCK NAME UP
	MOVEM FS,LSTLAB+3	;DEP FOR ERROR PRINT
	MOVE FS,BNAM-346(NA);GET BLOCK NAME
	PUSHJ P,R5CON	;CON TO R5
	TLO FS,140000
	SUBI NA,345
	PUSH	P,L
	SETZM	L		;NO RELOCATION.
	PUSHJ	P,SBOUT		;OUTPUT SYMBOL.
	POP	P,L
	MOVE FS,BNAM-1(NA)	;GET NAME
	MOVEM FS,NMBLK	;SAVE THE NAME
	SKIPE CREFSW	;CREF?
	CREF7 16,FS	;YES
	PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,BNPT+2	;DEPOSIT
	ORI FS,20000+22
	MOVEM FS,BNPT+3
	IDIVI NA,12	;CONVERT LEVEL TO...
	ORI PN,60	;DECIMAL...
	SKIPN NA	;...
	SUBI NA,20
	ADDI NA,60	;...
	DPB PN,[POINT 7,BNPT+4,13];AND..
	DPB NA,[POINT 7,BNPT+4,6];DEPOSIT
	MOVE NA,MTBPNT	;SET UP...
	MOVEM NA,SPNT	;FOR PSYM
	MOVEM NA,SSPNT	;...
	SETZM SCOUNT	;...
	SETOM MERCNT	;INIT MULT...
	MOVEI NA,MERSTR	;DEF. LAB...
	MOVEM NA,MERPNT	;MESSAGE AREA
	MOVEI NA,HASH	;INITIAL SYMTAB COUNTER
LOOP1:	MOVEM NA,NASAV	;SAVE
	MOVEI NA,SYMTAB-1(NA);GET FIRST OF CHAIN
	SKIPN O,(NA)
	JRST NONC	;NONE
LOOP2:	MOVE N,2(O)	;GET FLAGS
		TDNN N,BLOCK	;THIS BLOCK?
	JRST NOTHS	;NO
	TLNE N,UDSF	;IS THIS A DEFINED-UNDEFINED?
	JRST LITLAB	;YES, SPECIAL CODE FOR ALL OF IT
	TLNE N,DEFFL	;DEFINED?
	JRST NODEF	;NO
		TLNE N,DAF!GLOBF;IS IT GLOBAL OR DOWN ARROW?
	JRST DGLOB	;YES
CONT:	SKIPE SYMOUT	;SYMBOL TABLE LISTING?
	PUSHJ P,PSYM	;YES
	TLNE N,INTF	;INTERNAL?
	JRST UPAR1	;YES, DON'T PUT OUT DEFN.
	TLNE N,UPARF	;UPAROW?
	SKIPN BLOCKN	;AND NOT AT OUTER LEVEL
	SKIPA
	JRST UPAR1	;THEN DO NOT PUT OUT DEF
	MOVE FS,(O)	;GET SIXBIT
	SKIPE CREFSW
	CREF66 11,(O)
	PUSHJ P,R5CON	;CON TO R5
	TLO FS,100000	;BITS
		MOVE N,2(O)	;GET FLAGS
	TLNE N,DBLF	;←←?
	TLO FS,SNB	;YES
	PUSH	P,NA
	MOVE NA,3(O)	;GET VALUE
	MOVE L,4(O)	;GET RELOC
;	DPB L,[POINT 1,BDOUT+1,3]
;	LSH L,-2
;	DPB L,[POINT 1,BDOUT+1,2]
ITS,<	TLNN N,ANONF>	;DON'T PUT IT OUT IF ANONYMOUS
	PUSHJ	P,SBOUT
	POP	P,NA
	TLNE N,UPARF!INTF
	JRST UPAR1
DEL:	MOVE T,FSTPNT	;GET FREE STRG PNTR.
	EXCH T,1(O)	;PUT THIS BACK ON FREE STRG.
	MOVEM O,FSTPNT	;...
DEL2:	MOVEM T,(NA)	;& REMOVE FROM CHAIN
	SKIPE O,T	;ANY MORE?
	JRST LOOP2	;YES
NONC:	SOSLE NA,NASAV	;GET NEXT SYMTAB CHAIN
	JRST LOOP1
	JRST LDON
UPAR1:	MOVE L,(O)	;GET SIXBIT
	SKIPN PN,1(O)	;ANY MORE?
	JRST UPAR	;NO
	MOVE T,O
	CAMN L,(PN)
	JRST UNFD
	MOVE T,PN
	SKIPN PN,1(PN)
	JRST UPAR
	JRST .-5	;PN WILL POINT TO SYMBOL AND T WILL BE THE TLINK TO IT
UNFD:	MOVEM T,SVLNK	;SAVE LINK
	MOVE T,2(PN)	;GET FLAGS
	TDNN T,BLOCKN	;NEXT BLOCK?
	JRST UPAR	;NO
	TLNN T,UDSF	;OR IF DEFINED-UNDEFINE
	TLZN T,DEFFL	;DEFINED?
	JRST MERR	;YES
	TLNE N,DBLUPF
	TRZA N,-1	;DON'T CLEAR ↑ FLAG IF ↑↑
	TDZ N,[XWD UPARF,-1]
	OR T,N	;TRANSFER BITS
	TLNE T,UDSF
	JRST	[MOVEM T,2(O)
		MOVE T,SVLNK	;ELIM UPPER BLOCK
		MOVE N,FSTPNT	;GET SECOND BLOCK ONTO FREE STORAGE
		EXCH N,1(PN)
		MOVEM N,1(T)
		MOVEM PN,FSTPNT
		EXCH PN,O	;EXCHANGE SO FIXUP COMBINE DONE RIGHT
		JRST UPNOD1]	;AND AWAY WE GO
	MOVEM T,2(PN)	;DEPOSIT
	EXCH PN,O
		SKIPE N,3(O)	;FIXUPS?
	PUSHJ P,GFIX	;YES
	SKIPE N,4(O)	;POL-FIXES?
	PUSHJ P,PFIX	;YES
	EXCH PN,O
	SKIPN CREFSW
	JRST .+3
	CREF6 10,(O)	;COMBINE TWO CHAINS
	CREF6 0,(PN)
	HRLI N,3(O)	;DEFINE..
	HRRI N,3(PN)	;IT ...
	BLT N,4(PN)	;ABOVE
	JRST DEL	;AND DELETE IT BELOW
MERER:	ASCII /MULTIPLY DEFINED BY ↑  
/
MERSTR:	BLOCK 57
MEREND:	BLOCK 2
MERCNT:	0
MERPNT:	0
MERR:	AOSN MERCNT	;ANY YET?
	ERROR MERER	;NO, THIS IS FIRST
	MOVEI FS,MEREND
	CAMGE FS,MERPNT	;TOO MANY FOR TABLE?
	JRST DEL	;YES, IGNORE
		MOVE FS,(PN)	;NO, GET SIXBIT
	PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,@MERPNT	;DEPOSIT
	AOS MERPNT	;INCREMENT
	OR FS,[BYTE(7)0,40,40,15,12]
	MOVEM FS,@MERPNT;DEPOSIT
	AOS MERPNT	;INCREMENT
	SETZM @MERPNT
	JRST DEL
UPAR:	HRRES N		;GET BLOCK BIT
	LSH N,-1	;SHIFT
	HLL N,2(O)	;GET FLAGS
	TLNN N,DBLUPF		;NOT IF DOUBLE UP ARROW.
	TLZ N,UPARF	;CLEAR UPARROW BIT
	MOVEM N,2(O)	;REDEPOSIT
NOTHS:	MOVEI NA,1(O)	;PAS THIS ONE...
	SKIPE O,1(O)	;AND LEAVE...
	JRST LOOP2	;ALONE
	JRST NONC	;NO MORE THIS CHAIN
DGLOB:	TDNN N,OBLK	;ANY OTHER BLOCK BITS ON?
	JRST CONT	;NO
GLB1:	TLNN N,DAF	;↓?
	TDZ N,BLOCK	;NO, GLOBAL, TURN OFF THIS BIT
	MOVEM N,2(O)	;DEPOSIT
	JRST NOTHS
NODEF:	MOVE L,(O)	;GET SIXBIT
	SKIPN PN,1(O)	;ANY MORE?
	JRST UPAR	;NO
	SRC1(L,PN,NFND,JRST UPAR)
NFND:	MOVE T,2(PN)	;GET FLAGS
		TDNN T,BLOCKN	;NEXT BLOCK UP?
	JRST UPAR	;NO
	TLNE T,DEFFL	;DEFINED?
	JRST UPNOD	;NO
		TLNE T,UDSF	;UNDEFINE - DEFINED SYMBOL
	JRST MERR	;YES
	SKIPN CREFSW
	JRST .+3
	CREF6 10,(O)
	CREF6 0,(PN)
	SKIPE N,3(O)	;ANY FIXUPS?
	PUSHJ P,GFIX	;YES, PUT OUT
	SKIPE N,4(O)	;ANY POLFIXES?
	PUSHJ P,PFIX	;YES, DO
		JRST DEL
UPNOD:	MOVE L,2(O)	;GET FLAGS
	AND L,[XWD EXTF!INTF!VARF!UDSF,0]
	ORM L,2(PN)	;DEPOSIT CERTAIN FLAGS
UPNOD1:	SKIPN CREFSW
	JRST .+3
	CREF6 10,(O)
	CREF6 0,(PN)
	SKIPN L,3(O)	;APPEND...
	JRST AHD
	MOVE T,3(PN)	;FIXUPS...
	MOVEM L,3(PN)	;FOR...
ALOP:	SKIPN FS,1(L)	;ONE...
	JRST EFND	;OCCURANCE...
	MOVE L,FS	;ONTO THOSE...
	JRST ALOP	;OF THE...
EFND:	MOVEM T,1(L)	;OTHER
AHD:	SKIPN L,4(O)	;APPEND...
	JRST PFND1
	MOVE T,4(PN)	;POLFIXES...
	MOVEM L,4(PN)	;FOR...
	MOVSS L
PLOP:	MOVEM PN,(L)	;ONE...
	SKIPN FS,2(L)	;OCCURANCE...
	JRST PFND	;ONTO...
	MOVS L,FS	;THOSE...
	JRST PLOP	;OF THE...
PFND:	MOVEM T,2(L)	;OTHER
PFND1:	MOVE T,2(PN)	;MORE FLAGS
	CAME O,FSTPNT	;THIS WILL BE TRUE ONLY IF WE CAME FROM ↑UDSF
	JRST DEL
	EXCH PN,O
	JRST NOTHS	;SKIP DELETING THIS
OBLK:	0
NASAV:	0
BLOCKN:	0
NMBLK:	0
SVLNK:	0
LITLAB:	TLNE N,DAF!GLOBF	;BOY ARE THESE A PAIN
	JRST LITGLB
	SKIPE SYMOUT
	PUSHJ P,PSYM
	TLNE N,INTF!UPARF	;BUT THESE ARE WORSE
	JRST UPAR1		;BEACUSE OF THE PAIN THEY CAUSE HERE
LITCNT:	MOVE FS,(O)	;GET SIXBIT
	SKIPE CREFSW
	CREF66 11,(O)
	PUSHJ P,R5CON
	TLO FS,100000	;SET TO LOCAL
	MOVSI N,SYMFIX	;SAY WE NEED SYMBOL TABLE FIXUP
	IORB N,2(O)	;GET FLAGS
	TLNE N,DBLF
	TLO FS,SNB	;SET DELETE FLAG
	PUSH	P,L
	PUSH	P,NA
	SETZB	L,NA
	PUSHJ	P,SBOUT
	POP	P,NA
	POP	P,L
	MOVE T,NMBLK
	EXCH T,1(O)	;PUT BLOCK NAME IN
	JRST DEL2	;GO FINISH THE DELETE
LITGLB:	TDNN N,OBLK
	JRST LITCNT
	JRST GLB1
LDON:	PUSH P,B
	PUSH P,C
	MOVEI NA,HASH	;PREPARE TO CUT BACK OPDEFS.
	MOVE T,BLOCK	;TEST WORD
	MOVSI FS,20	;@ BIT
OLOP1:	SKIPN N,OPCDS-1(NA);GET FIRST CHAIN
	JRST NONT	;NONE
OLOP:	TDNN FS,1(N)	;ORDINARY OP?
	JRST ENDF	;YES, GO NO FURTHER
	SKIPGE 1(N)	;PSEUDO-OP?
	JRST ENDF	;YES
	TDNN T,2(N)	;THIS BLOCK?
	JRST ENDF	;NO, QUIT
	PUSH P,N	;SAVE POINTER
	MOVE FS,(N)	;GET OPDEF NAME
	SKIPE CREFSW
	CREF66 13,(N)
	PUSHJ P,R5CON	;TO RADIX50 FOR DDT
	POP P,N
	TLO FS,100000	;SET AS LOCAL
	PUSH	P,NA		;SAVE IT.....
	PUSH	P,L
	MOVE NA,3(N)	;GET VALUE
	MOVE L,4(N)	;AND FLAGS FOR RELOC
ITS,<
	PUSH P,T
	MOVE T,2(N)
	TLNN T,ANONF	;DON'T HACK ANONYMOUS OPDEFS
	PUSHJ	P,SBOUT
	POP P,T
>;ITS
NOITS,<	PUSHJ P,SBOUT	>
	POP	P,L
	POP	P,NA
	MOVSI FS,20	;RESTORE LOST FS
	MOVE O,FSTPNT
	EXCH O,1(N)
	MOVEM N,FSTPNT	;PUT BACK IN FREE STRG
	HRRZ N,O	;GET NEXT
	JUMPN N,OLOP	;ANY MORE?
ENDF:	MOVEM N,OPCDS-1(NA)
NONT:	SOJG NA,OLOP1	;CONTINUE WITH NEXT CHAIN
		MOVEI NA,HASH	;PREPARE TO CUT BACK MACROS
MLOP1:	SKIPN N,MACRT-1(NA);GET CHAIN
	JRST MNON	;NONE
MLOP:	TDNN T,2(N)	;THIS BLOCK?
	JRST ENDM	;NO, QUIT
	SKIPE CREFSW
	CREF66 13,(N)
	MOVE C,4(N)	;GET START
	HLRZ B,(C)	;GET LENGTH
	ADD B,C		;GET END
	PUSHJ P,MACRET
	MOVE O,FSTPNT	;PUT BACK ON FREE STRG.
	EXCH O,1(N)	;...
	MOVEM N,FSTPNT	;...
	SKIPE N,O	
	JRST MLOP
ENDM:	MOVEM N,MACRT-1(NA)
MNON:	SOJG NA,MLOP1	;GET NEXT CHAIN
	MOVE N,BLOCK	;SHIFT...
	LSH N,-1	;BLOCK...
	MOVEM N,BLOCK	
	SUBI N,1	;AND...
	SETCA N,
	HRLI N,DAF
	MOVEM N,DBLCK	;DBLCK
	SKIPE SYMOUT	;SYMBOL LISTING?
	PUSHJ P,PSYMGO	;YES
	TRAN BNPT	;LIST BLOCK NAME
	POP P,C
	POP P,B
	POPJ P,
PSYM:	TRNN LDEV	;LIST DEV?
	POPJ P,		;NO
SNBN←←377777
	HRRZ T,SPNT	;SET UP...
	HRLI T,2(O)	;BLT WRD
	MOVEI L,3	;INCREMENT...
	ADDB L,SPNT	;POINTER
LEG	SETZM -1(L)	;TO GET INTERRUPT IF CORE EXCEEDED
	BLT T,-1(L)	;SAVE VALUE
	MOVE T,(O)	;GET SIXBIT
	TLNN T,770000	;LEFT ADJUST
	LSH T,6
	TLNN T,770000
	JRST .-2
	TLC T,SNB	;INVERT SIGN FOR COMPARE
	MOVEM T,-3(L)	;DEPOSIT
	AOS SCOUNT	;...
	POPJ P,
PSYMGO:	SKIPN SCOUNT	;ANY?
	POPJ P,		;NO
	MOVEI TAC,[BYTE (7)15,12]
	PUSHJ P,LOUT
SLOOP2:	HRLOI FS,SNBN	;INIT
	MOVE NA,SCOUNT	;GET COUNT
	MOVE PN,SSPNT	;GET START
SLOOP1:	CAMG FS,(PN)	;COMPARE
	JRST SPT1	;NEW ONE LARGER
	MOVE N,PN	;SAVE POINTER
	MOVE FS,(PN)	;GET NEW SIXBIT
SPT1:	ADDI PN,3	;GO TO NEXT
	SOJG NA,SLOOP1	;LOOP
	CAMN FS,[XWD SNBN,-1];DONE?
	JRST [MOVEI TAC,[BYTE (7)15,12]
		JRST LOUT]
	HRLOI NA,SNBN	;REMOVE...
	MOVEM NA,(N)	;THIS ONE
		TLC FS,SNB	;REINVERT SIGN
	PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,SOUT	;DEPOSIT
	TLO FS,220	;PUT IN TAB
	MOVEM FS,SOUT+1	;DEPOSIT
	MOVS FS,1(N)	;GET VALUE...
	MOVE TAC,2(N)	;& RELOC
	SETZM SOUT+2
	MOVEI T,22
	MOVEM T,SOUT+3
	TRNN FS,-1	;LEFT HALF =0?
	JRST SPT2	;YES
	MOVSS FS	;GET LEFT HALF
	LSH TAC,-2	;& RELOC
	PUSHJ P,OCON	;CON TO OCTAL ASCII
		MOVEM T,SOUT+2	;DEPOSIT
	MOVEM FS,SOUT+3	;...
	MOVS FS,1(N)	;GET RIGHT HALF
	MOVE TAC,2(N)	;& RELOC
SPT2:	PUSHJ P,OCON	;CONVERT
	MOVEM T,SOUT+4	;DEPOSIT
	MOVEM FS,SOUT+5	;...
	MOVE TAC,[XWD -7,SOUT]
	PUSHJ P,LOUT	;OUTPUT IT
		JRST SLOOP2
SOUT:	BLOCK 6
	BYTE (7)15,12

;AFROM6:  CONVERTS 6-BIT TO ASCII.  CALL WITH 6-BIT IN FS.
;	RETURNS ASCII IN T & FS.
↑AFROM6:MOVEI T,
ALE1:	LSHC T,6	;GET CHR.
	TRCE T,40	;CON TO ASCII
	TRO T,100	;...
	LSH T,1		;LEAVE ROOM
	TLNN T,700000	;5 CHRS?
	JRST ALE1	;NO
	LSH FS,-1	;ADJUST FINAL CHR.
	TLCE FS,200000	;CON TO ...
	TLO FS,SNB	;ASCII
	POPJ P,
SCOUNT:	0
SPNT:	0
SSPNT:	0
	BEND
↑AFROM6←AFROM6
	BEND
%BEG:	MOVE N,BLOCK	;GET BLOCK...
	TRNE N,600000	;LEGAL BEGIN?
	ERROR[ASCIZ/BLOCKS NESTED TOO DEEP/]
	LSH N,1		;SHIFT
	MOVEM N,BLOCK	;RESTORE
	MOVNS N	;FORM DBLK...
	HRLI N,DAF	;...
	MOVEM N,DBLCK	;...
	PUSHJ P,SCAN	;GET NAME, IF ANY
		TLNE IFLG	;IDENT?
		JRST %BPT	;YES
	MOVE L,['A.000'];GET BASIC
	MOVE FS,%BCUR	;GET CURRENT NUM
	DPB FS,[POINT 3,L,35]
	LSH FS,-3
	DPB FS,[POINT 3,L,29]
	LSH FS,-3
	DPB FS,[POINT 3,L,23]
%BPT:	AOS %BCUR	;INCREMENT
	MOVEM L,LSTLAB+3;DEPOSIT FOR ERROR MESSAGE PRINTER
	MOVE T,BLOCK
	FAD T,[0]
	LDB T,[POINT 8,T,8];GET NUM
	MOVEM L,BNAM-346(T);DEPOSIT NAME
	SKIPE CREFSW	;CREF?
	CREF7 15,L	;YES
	MOVE FS,L	;GET NAME
	MOVE NA,T
	PUSHJ P,AFROM6	;CON TO ASCII
	MOVEM T,%BQ+2	;DEPOSIT
	ORI FS,20022	;...
	MOVEM FS,%BQ+3	;...
	SUBI NA,345	;GET LEVEL NUMBER
	IDIVI NA,12	;CON TO...
	SKIPN NA		;DECIMAL...
	SUBI NA,20	;...
	ADDI NA,60	;...
		ADDI PN,60	;...
	DPB NA,[POINT 7,%BQ+4,6]
	DPB PN,[POINT 7,%BQ+4,13]
	TRAN %BQ		;LIST BLOCK NAME & LEVEL
	JRST NSPCFN
%BCUR:	0
%BQ:	ASCII /       	/
	BLOCK 3
	ASCII /    	/

%BEND:	MOVE T,BLOCK
	SOJLE T,BERR	;BARF IF ALREADY OUTER BLOCK
	PUSHJ P,SCAN	;GET OPTIONAL BLOCK NAME
	TLNN IFLG
	JRST BENDNA
	MOVE T,BLOCK
	FSC T,32
	ROT T,9
	CAME L,BNAM(T)
	ERROR [ASCIZ /BLOCK NAME MISMATCH/]
BENDNA:	PUSH P,N
	PUSHJ P,BEND
	POP P,N
	JRST NSPCFN

BERR:	ERROR [ASCIZ /TOO MANY BENDS/]
	JRST NSPCFN
;LITOUT -- TO OUTPUT LITTERALS

BEGIN LITOUT

↑LITOUT:
	MOVSI NA,-HASH	;HERE WE MAKE ALL THE BUCKETS INTO ONE BIG LIST
	MOVEI O,LITPNT-1
	SKIPN T,LITPNT(NA)
LITLP1:	AOBJN NA,.-1
	JUMPGE NA,LITGO
	SETZM LITPNT(NA)
	MOVEM T,1(O)
LITLP2:	SKIPN T,1(O)
	JRST LITLP1
	SKIPE O,1(T)
	JRST LITLP2
	MOVE O,T
	JRST LITLP1
LITGO:	SKIPN NA,LITPNT	;GET LITERAL LIST
	POPJ P,		;NONE
LOP2:	MOVE O,1(NA)	;GET NEXT
	PUSHJ P,LITCOM	;COMPARE WITH OTHER LITS & TACK TOGETHER
	HLRZ L,2(NA)	;ANY LABELS
	JUMPE L,NOLBS	;NO
	PUSH P,O
	PUSH P,NA
	MOVE O,L
PT1:	MOVE PN,4(O)	;GET POINTER TO SYMBOL TABLE ENTRY
	MOVE N,PCNT	;GET VALUE
	MOVE NA,PCNT+1
	ADD N,3(O)	;ADD COUNT
	PUSHJ P,LVDEF	;DEFINE IT
	MOVE N,FSTPNT
	SKIPE (O)	;CHECK FOR $. KLUDGE
	JRST LLOK	;NOPE
	MOVEM N,1(PN)	;RETURN "SYM" TO FS
	MOVEI N,(PN)
LLOK:	EXCH N,1(O)	;NOW RET LITLAB BLK
	MOVEM O,FSTPNT
	SKIPE O,N
	JRST PT1
	POP P,NA	;RESTORE
	POP P,O
NOLBS:	MOVEI PN,PCNT-3;SET UP "VALUE" POINTER FOR GFIX
	SKIPE N,3(NA)	;GET FIXUP POINTER
	PUSHJ P,GFIX	;PUT OUT FIXUPS
	SKIPE N,4(NA)
	PUSHJ P,PFIX
	MOVE N,FSTPNT	;GET FREE STRG
		MOVEM N,1(NA)	;PUT THIS BACK ON FREE STRG
	MOVEM NA,FSTPNT	;...
	HRRZ L,2(NA)	;GET VALUES
LOP1:	SKIPN 4(L)	;ANYTHING HERE?
	JRST LPT3	;NO
	HRLI PN,3(L)	;GET POINTER TO VALUE
	HRRI PN,WRD
	BLT PN,WRD+1	;PUT IN WRD
	PUSHJ P,BLOUT	;LIST VALUE
	OUTP 3(L)	;OUTPUT VALUE
	SKIPN N,(L)	;REVERSE FIXUP?
	JRST LPT1	;NO
	JUMPGE N,.+3	;POLISH FIXUP?
	PUSHJ P,POLHAN	;YES, HANDLE
	JRST LPT1
	HRRI TAC,3(N)
	HRLI TAC,OPCNT
	BLT TAC,4(N)	;SET FIXUP WHICH POINTS HERE TO
			;POINT TO CORE
LPT1:	SKIPN N,2(L)	;REVERSE FIXUP, LEFT HALF?
	JRST LPT2	;NO
	JUMPGE N,.+3
	PUSHJ P,POLHAN
	JRST LPT2
	HRRI TAC,3(N)	
	HRLI TAC,OPCNT
	BLT TAC,4(N)	;SET THIS ONE
LPT2:	AOS OPCNT	;INCREMENT
	MOVE N,OPCNT
	CAMGE N,BRK
	JRST .+5
	CAMGE N,HICNT
	JRST .+5
	MOVEM N,HICNT
	JRST .+3
	CAML N,LOCNT
	MOVEM N,LOCNT
	AOS PCNT	;...
LPT3:	MOVE N,FSTPNT
	EXCH N,1(L)	;PUT THIS BACK...
	MOVEM L,FSTPNT	;IN FREE STRG.
	SKIPE L,N	;ANY MORE
	JRST LOP1	;YES
	SKIPE NA,O	;GET NEXT LITTERAL, MORE?
	JRST LOP2	;THERE ARE MORE
	SETZM LITPNT
	POPJ P,
POLHAN:	MOVE TAC,OPCNT	;GET PLACE WHERE THIS IS...
	MOVEM TAC,2(N)	;GOING & MAKE POLFIX...
	MOVE TAC,OPCNT+1;POINT THERE
	MOVEM TAC,3(N)
	SKIPLE 1(N)	;NO UNDEF SYMS LEFT?
		POPJ P,		;SOME LEFT
	MOVEI FS,5(N)	;SET UP POINTER
	PUSH P,O	;SAVE
	PUSH P,L
	PUSHJ P,REDUC	;REDUCE THE POLISH
	PUSHJ P,BFRC	;FORCE OUT BINARY
	MOVEI FS,5(N)	;SET UP POINTER
	PUSHJ P,POLOUT	;PUT OUT POLFIX
	POP P,L
	POP P,O
	POPJ P,
↑LITCOM:SKIPN O		;ANY?
	POPJ P,
	MOVEI PN,O	;FIRST POINTER IS IN O
	MOVE N,O	;GET FIRST POINTER
LOOP1:	PUSHJ P,LCOM	;LITS AT N & NA SAME?
	JRST SAM	;YES
	MOVEI PN,1(N)	;NEXT POINTER IS HERE
LOOP3:	SKIPE N,(PN)	;GET NEXT POINTER, MORE?
	JRST LOOP1	;YES
	POPJ P,		;NO
SAM:	SKIPN L,3(N)	;GET FIXUPS FOR ONE
	JRST NOTN1
	MOVE T,3(NA)	;GET FIXUPS FOR OTHER
	MOVEM L,3(NA)	;DO AN APPEND
	JUMPE T,NOTN1
LOOP2:	SKIPN FS,1(L)	;...
	JRST EFND
	MOVE L,FS
	JRST LOOP2
EFND:	MOVEM T,1(L)	;...
NOTN1:	SKIPN L,4(N)	;ALSO APPEND POLFIXES
	JRST NOTN2
	MOVE T,4(NA)
	MOVEM L,4(NA)
	JUMPE T,NOTN2
LPQ2:	SKIPN FS,1(L)
	JRST Q2FND
	MOVE L,FS
	JRST LPQ2
Q2FND:	MOVEM T,1(L)
NOTN2:	HLRZ L,2(N)	;ALSO APPEND LABELS
	JUMPE L,NOTN3
	HLRZ T,2(NA)
	HRLM L,2(NA)
	JUMPE T,NOTN3
LPQ3:	SKIPN FS,1(L)
	JRST Q3FND
	MOVE L,FS
	JRST LPQ3
Q3FND:	MOVEM T,1(L)
NOTN3:
	MOVE T,1(N)	;SKIP THIS ONE...
	MOVEM T,(PN)	;IN CHAIN
	MOVE FS,FSTPNT	;& PUT BACK ON FREE STRG. ...
	MOVEM FS,1(N)	;...
	HRRZ FS,2(N)	;GET VALUE CHAIN
	MOVEM FS,FSTPNT	;POINT FREE STRG AT IT
LOOP4:	SKIPN T,1(FS)	;SEARCH FOR END OF VALUE CHAIN
	JRST VFND	;FOUND
	MOVE FS,T
	JRST LOOP4
VFND:	MOVEM N,1(FS)	;POINT TI TO REST OF FREE STRG.
	JRST LOOP3	;PROCEED
LCOM:	MOVE T,(N)	;GET COUNT
	CAME T,(NA)	;SAME?
	JRST NOSAM	;NO
	MOVE FS,2(N)	;GET VALUE ...
	MOVE L,2(NA)	;CHAINS
LOOP5:	MOVE TAC,3(FS)	;COMPARE FIRST
	CAME TAC,3(L)	;VALUE WORD
	JRST NOSAM	;DIFFERENT
	MOVE TAC,4(FS)	;ALSO COMP...
	CAME TAC,4(L)	;FLAGS
	JRST NOSAM	;DIFF
	SKIPN (FS)	;DEFINED?
	SKIPE 2(FS)	;...
		JRST NOSAM	;NO
	SKIPN (L)	;DEFF?...
	SKIPE 2(L)	;...
	JRST NOSAM	;NO
	MOVE FS,1(FS)	;GET NEXT...
	MOVE L,1(L)	;...
	SOJG T,LOOP5	;DONE
	POPJ P,		;YES, SAME
NOSAM:	AOS(P)
	POPJ P,
VCNT:	0
↑VAR:	PUSHJ P,BFRC	;FORCE OUT BIN
	MOVE NA,PCNT+1	;GET READY
	SKIPN TAC,VARLST
	POPJ P,		;NONE THERE
LOOP.1:	MOVE PN,FSTPNT	;PUT BACK ON FREE STORAGE
	EXCH PN,1(TAC)
	MOVEM PN,VARLST	;KEEP VARLST UP TO DATE
	MOVEM TAC,FSTPNT
	MOVE PN,(TAC)	;POINTER TO SYMBOL
	AOS N,2(TAC)
	ADDM N,OPCNT
	EXCH N,PCNT
	ADDM N,PCNT
	PUSHJ P,LVDEF
	MOVE N,OPCNT
	CAMGE N,BRK
	JRST .+5
	CAMGE N,HICNT
	JRST .+5
	MOVEM N,HICNT
	JRST .+3
	CAML N,LOCNT
	MOVEM N,LOCNT
	SKIPE TAC,VARLST
	JRST LOOP.1
	POPJ P,
↑%VAR:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT
	PUSHJ P,VAR
	JRST SPCFN
BEND
	SUBTTL ..ORG..  INCLUDES ORG, LOC, RELOC, USE, AND SET
;ORG 	INCLUDES ORG, LOC, RELOC, PHASE, DEPHASE, USE, AND SET

BEGIN ORG
↑%ORG:	MOVE NA,OPCNT+1
	TLNE NA,INCF
	JRST PSLIT
	MOVEM N,SV	;SAVE VALUE
		PUSHJ P,BFRC	;FORCE OUT BINARY
	PUSHJ P,FXFRC	;FORCE OUT FIXUPS
	TRO NOFXF
	PUSHJ P,MEVAL	;GET VALUE
	TLNE UNDF	;DEFINED?
	JRST OERR	;NO
	TLNE ESPF	;SPC. CHR?
	JRST SCR	;YES
	MOVE T,[XWD PCNT,PCSAV]
	BLT T,PCSAV+3	;SAVE OLD LOC.
	SKIPN SV	;IS IT LOC?
	MOVEI NA,	;YES
	SKIPGE SV	;IS IT RELOC?
	MOVEI NA,1	;YES
ORG2:	ANDI N,777777	;LEAVE US NOT GET CONFUSED
	XOR NA,PCNT+1	;SET
	TRNE NA,1	;CHANGING RELOCATION?
	JRST ORG4
ORG5:	SUB N,PCNT
	ADDM N,PCNT
	ADDB N,OPCNT
ORG3:	CAMGE N,BRK	;HIGH SEG?
	JRST .+5	;NO,LOW
	CAMGE N,HICNT	;YES,IS OPCNT≥HICNT
	JRST .+5	;NO
	MOVEM N,HICNT	;YES, INCREMENT HIGH
	JRST .+3
	CAML N,LOCNT	;IS OPCNT≥LOCNT?
	MOVEM N,LOCNT	;YES, INCREMENT LOW
	JRST SPCFN

ORG4:	XORB NA,PCNT+1	;STORE RELOC, GET BACK ORIGINAL VALUE
	MOVEM NA,DPCNT+1;AND STORE HERE ALSO
	XOR NA,OPCNT+1	;TEST THIS ONE
	XORM NA,OPCNT+1	;AND STORE IT
	TRNE NA,1
	JRST ORG5
			;SORRY, PCNT AND OPCNT HAVE DIFFERENT RELOCATION
	ERROR[ASCIZ/INDETERMINATE PHASE DUE TO RELOC, WILL DEPHASE/]
	MOVE NA,PCNT+1
	MOVEM NA,OPCNT+1
	MOVEM N,PCNT
	MOVEM N,OPCNT
	JRST ORG3

SCR:	MOVE T,[XWD PCNT,PCSAV+4]
	MOVE O,[XWD PCSAV,PCNT]
	MOVE NA,[XWD PCSAV+4,PCSAV]
	BLT T,PCSAV+7
	BLT O,PCNT+3	;EXCHANGE OLD & REAL OLD
	BLT NA,PCSAV+3
	MOVE NA,PCNT+1
	MOVEM NA,DPCNT+1
	JRST NSPCFN

SV:	0
PCSAV:	BLOCK 10
OERR:	ERROR[ASCIZ/UNDEFINED FIELD -- ORG/]
	JRST SPCFN

BEGIN USE
↑↑%USE:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT
	PUSHJ P,BFRC	;FORCE OUT BIN
	PUSHJ P,FXFRC	;   "   "  FIXUPS
	TLNE B,SPCLF	;SPCL CHR NEXT?
	JRST SPCL	;YES
	PUSHJ P,SCAN	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST ERR	;NO
	MOVE N,CURNT	;GET CURRENT POINTER
	MOVSI O,PCNT
	HRRI O,2(N)	;RESET...
	BLT O,4(N)	;...
	MOVE O,OPCNT+1	;CURRENT...
	HRLM O,3(N)	;ONE...
	SKIPN N,NULN+1	;GET CHAIN POINTER
	JRST NON
LOOP1:	CAMN L,(N)	;THIS ONE?
	JRST FND	;YES
	SKIPE N,1(N)	;NO, GET NEXT, ANY?
	JRST LOOP1
NON:	GFST NA,FSTPNT	;GET FREE STRG
	MOVE N,NULN+1	;GET POINTER
	EXCH N,1(NA)	;INSERT NEW ONE
	MOVEM N,FSTPNT
	MOVEM NA,NULN+1
	MOVEM L,(NA)	;DEPOSIT SIXBIT
	MOVEM NA,CURNT	;THIS ONE NOW CURRENT
	JRST SPCFN
SPCL:	MOVE N,CURNT	;GET CURRENT
	MOVSI O,PCNT	;AND RESET
	HRRI O,2(N)
	BLT O,4(N)
	MOVE O,OPCNT+1
	HRLM O,3(N)
	MOVEI N,NULN
FND:	MOVSI O,2(N)	;GET SOURCE
	HRRI O,PCNT	;GET DEST.
	MOVEM N,CURNT	;THIS ONE NOW CURRENT
	BLT O,PCNT+2	;BLT IN...
	HLR O,PCNT+1	;...
	HRRZM O,OPCNT+1	;;;
	HRRZS PCNT+1	;...
	MOVE O,PCNT+1
	MOVEM O,DPCNT+1
	JRST SPCFN
↑NULN:	BLOCK 5
↑CURNT:	0
↑SNULN:	0
	0
	0
	1(1)
	0
	NULN
ERR:	ERROR[ASCIZ/ILL. FORMAT -- USE/]
	JRST SPCFN	;RETURN
	BEND



↑NULN←NULN
↑SNULN←SNULN

↑%SET:	MOVE N,OPCNT+1
	TLNE N,INCF
	JRST PSLIT
	TLNE B,SPCLF	;SPC CHR NEXT
	BEGIN SET
	JRST SPCL	;YES ITS FOR NULL
	PUSHJ P,SCAN	;GET IDENT
	TLNN IFLG	;IDENT?
	JRST ERR	;NO
	SKIPN N,NULN+1	;GET LIST, ANY?
	JRST NON	;NO
LOOP1:	CAMN L,(N)	;THIS ONE?
	JRST FND	;YES
	SKIPE N,1(N)	
	JRST LOOP1
NON:	GFST N,FSTPNT	;GET FREE STRG
	MOVE NA,NULN+1
	EXCH NA,1(N)	;PUT ON LIST
	MOVEM NA,FSTPNT
	MOVEM N,NULN+1
	MOVEM L,(N)	;DEPOSIT SIXBIT
FND:	PUSH P,N
	TRNE B,COMF	;,?
	PUSHJ P,SCAN	;YES, SKIP
	TDO [XWD OPFLG,NOFXF]
	PUSHJ P,MEVAL	;EVALUATE EXPRESSION
	POP P,T		;GET POINTER
	TLNE UNDF!ESPF	;DEFINED?
	JRST ERR	;NO
	CAMN T,CURNT	;CURRENT ONE?
	JRST ORG2	;YES
	HRRZM N,2(T)	;DEPOSIT VALUE...
	HRRZM N,4(T)	;...
	MOVEM NA,3(T)	;DEPOSIT RELOC
	HRLM NA,3(T)	;...
	JRST SPCFN
SPCL:	MOVEI N,NULN
	JRST FND
ERR:	ERROR[ASCIZ/ILL. FORMAT -- SET/]
	JRST SPCFN
BEND

BEND

	SUBTTL MACROS, FOR, REPEAT, IF'S

BEGIN MAC

↑%DEF:	PUSHJ P,SCAN	;GET NAME OF MACRO
	TLNN IFLG	;IDENT?
	JRST DERR1	;NO
	MOVE T,L	;GET SIXBIT
	IDIVI T,HASH	;HASH
	MOVMS FS
	SKIPN O,MACRT(FS)
	JRST DEF2
	SRC2 L,O,REDEF
DEF2:	GFST O,FSTPNT	;GET FREE STRG
	MOVE T,MACRT(FS);PUT INTO CHAIN
	EXCH T,1(O)	;...
	MOVEM T,FSTPNT
	MOVEM O,MACRT(FS)
	MOVEM L,(O)	;DEPOSIT SIXBIT
	MOVE N,BLOCK
	MOVEM N,2(O)	;DEPOSIT BLOCK BIT
DEF3:	SKIPE XCRFSW	;CREF?
	CREF6 6,(O)	;YES
	MOVE FS,MTBPNT	;GET POINTER TO FREE MACRO AREA
	MOVEM FS,4(O)	;DEPOSIT POINTER
	MOVEI T,	;ZERO ARG COUNT
	TDNE B,[XWD CRFG,LBCF];CR OR { NEXT?
	JRST NOCAT	;YES, NO CONCAT
	TRNE B,LFPF	;(NEXT?
	JRST NOCAT	;YES, NO CONCAT
	TRNE B,RBCF	;} ?
	JRST [ERROR[ASCIZ/ILLEGAL CONCATENATION CHR/]
		JRST NOCAT]
	PUSH P,C	;SAVE CONCAT CHR.
	TLZ SFL		;SKIP CONCAT CHR.
	SKIPA
NOCAT:	PUSH P,[200]	;NO CONCAT CHR.
	PUSHJ P,SCAN	;GET TO THE (
	TLNN SCFL	;SPC. CHR?
	JRST .-2	;NO
	TRNN N,LFPF!LBCF;( OR { ?
	JRST .-4	;NO
	TRNE N,LBCF	;{ ?
	JRST NOARG	;YES, NO ARGS
	TRNE B,RTPF	;) NEXT?
	JRST AEND	;YES
ALOP:	PUSHJ P,SCAN	;GET ARG
		TLNN IFLG	;IDENT?
	ERROR[ASCIZ/ARGUMENT NOT IDENT/]
LEG	MOVEM L,(FS)	;DEPOSIT ARG
	ADDI FS,1	;INCREMNT STRG PNTR.
CLOP:	TRNN B,COMF	;, NEXT?
	JRST .+3	;NO
	TLZ SFL		;YES, SKIP THE ,
	AOJA T,ALOP
	TRNE B,RTPF	;) NEXT?
	AOJA T,AEND	;YES
	PUSHJ P,SCAN	;GET NEXT
	JRST CLOP
AEND:	PUSHJ P,SCAN	;GET TO THE {
	TLNN SCFL	;SPC CHR?
	JRST .-2	;NO
	TRNN N,LBCF	;{ ?
	JRST .-4	;NO
NOARG:	POP P,NA	;GET CONCAT CHR.
	CAIN NA,200	;ANY?
	JRST NOCTA	;NO
	PUSH P,CTAB(NA)	;SAVE OLD BITS
	MOVSI N,SPCLF!SPFL;GET NEW BITS
	MOVEM N,CTAB(NA);DEPOSIT
NOCTA:	PUSH P,NA	;SAVE CHR
	MOVE N,FS	;POINT TO PLACE TEXT...
	HRLI N,700	;SHOULD GO
		MOVE NA,MTBPNT	;ARG POINTER
	PUSHJ P,TXTIN	;GET TEXT IN
	MOVEI L,177
LEG	IDPB L,N	;DEPOSIT END...
	MOVEI L,3	;OF MACRO...
LEG	IDPB L,N	;INDICATION
	MOVEM T,3(O)	;DEPOSIT ARG COUNT
	MOVEM O,(FS)	;DEPOSIT REVERSE POINTER
	MOVEI L,1(N)	;GET END
	SUB L,FS	;FORM LENGTH
	HRLM L,(FS)	;DEPOSIT
	JUMPE T,BNOA	;NO ARGS?
	MOVS TAC,FS	;PREPARE TO MOVE UP
	HRR TAC,MTBPNT	;...
	SUBI N,(T)
	BLT TAC,(N)
BNOA:	ADDI N,1
	HRRZM N,MTBPNT	;ADVANCE POINTER
	POP P,N		;GET CONCAT CHR.
	CAIE N,200	;NO CONCAT?
	POP P,CTAB(N)	;RESTORE BITS
	JRST SPCFN
DERR1:	ERROR[ASCIZ/NOT IDENT AFTER DEFINE/]
	JRST SPCFN

;HERE IF REDEFINING MACRO
REDEF:	HRRZ N,2(O)
	CAME N,BLOCK
	JRST DEF2	;DIFFERENT BLOCK
	PUSH P,B	;SAME BLOCK - FLUSH OLD TEXT & RE-USE SYM BLK
	PUSH P,C
	MOVE C,4(O)
	HLRZ B,(C)
	ADDI B,(C)
	PUSHJ P,MACRET
	POP P,C
	POP P,B
	JRST DEF3
;TXTIN:	CALL, TO READ TEXT INTO CORE, WITH PLACE IT IS TO GO
	;IN N,  ARG POINTER IN NA,  ARG COUNT IT T,  CONCAT
		;CHR. ON TOP OF STACK.   USES PN,TAC,L

↑TXTIN:	SETZM BCNT	;INIT { } COUNT
	MOVE PN,PGNM
	MOVEM PN,TXTIPG
	MOVE PN,TLBLK
	MOVEM PN,SVLIN
	SKIPA
NLOOP1:	LEG	IDPB C,N
NLOOP:	PUSHJ P,SCAN1	;GET CHR.
	JUMPGE B,SPCCHR	;SPC. CHR?
		TLNE B,NMFLG	;NUM?
	JRST SNUMS	;YES
	MOVEM N,NSTO
LEG	IDPB C,N
		MOVEI PN,(B)	;GET SIXBIT
ILOOP:	PUSHJ P,SCAN1	;GET CHR.
	JUMPGE B,ISPC	;SPC CHR?
LEG	IDPB C,N	;NO, DEPOSIT
	TLNE PN,770000	;6 CHRS?
	JRST ILOOP	;YES
	LSH PN,6
	ORI PN,(B)	;INSERT
	JRST ILOOP
ISPC:	JUMPE T,SPCCHR	;NO ARGS?
	MOVE TAC,T	;GET COUNT
	MOVE L,NA	;GET POINTER
ALOOP:	CAMN PN,(L)	;ARG?
	JRST YUP	;YUP
	ADDI L,1
	SOJG TAC,ALOOP	;LOOP
SPCCHR:	CAMN C,-1(P)	;CONCAT CHR?
	JRST NLOOP	;YES
	TRNE B,LBCF	;{ ?
	AOS BCNT	;YES, COUNT
	TRNE B,RBCF	;} ?
	SOSL BCNT	;YES,COUNT
	JRST NLOOP1	;RETURN
	SETZM TXTIPG
	POPJ P,		;RETURN
YUP:	MOVEI PN,177	;DEPOSIT ARG POINTER...
	MOVE N,NSTO	;GET POINTER
LEG	IDPB PN,N	;...
	MOVEI PN,1	;...
LEG	IDPB PN,N	;...
	MOVE L,T	;FORM ARG NUMBER...
	SUB L,TAC	;...
LEG	IDPB L,N	;AND DEPOSIT
	JRST SPCCHR
SNUMS:	LEG	IDPB C,N	;DEPOSIT
	PUSHJ P,SCAN1	;GET CHR.
	JUMPL B,SNUMS	;NOT SPC CHR?
	JRST SPCCHR	;SPCCHR
NSTO:	0
BCNT:	0

;ARGIN:	CALL TO READ IN ARGS.  USES NEXT FREE SPACES
	;	IN CONTIGUAOUS AREA. USES N,PN,TAC,NA  ;# OF ARGS
;	SHOULD BE IN N

↑ARGIN:	HRRZ NA,MTBPNT	;GET FREE AREA
BEGIN ARGIN
	PUSH P,NA	;SAVE ON PDL (RECURSIVE)
		ADD NA,N		;ADD # OF ARGS
	HRLI NA,440700	;MAKE INTO POINTER
	PUSHJ P,SCAN1	;GET NEXT CHR.
	TRNN B,LFPF	;(?
	JRST CRMOD	;NO
LOOP2:	PUSHJ P,SCAN1	;YES,PASS IT
LEG	MOVEM NA,@(P)	;DEPOSIT POINTER TO FIRST ARG
	TRNE B,BSLF	;\ (→)?
	JRST BKS1	;YES
	PUSHJ P,SARGIN	;GET ARG
BKR1:	TRNN B,RBCF	;}?
	TLNN B,CRFG!RBRF	;DID IT STOP ON CR?
	JRST .+3	;NO
	PUSHJ P,SARCON	;YES, CONTINUE
	JRST .-3
	MOVEI TAC,177	;DEPOSIT...
LEG	IDPB TAC,NA	;END...
	MOVEI TAC,2	;OF ARG...
LEG	IDPB TAC,NA	;INDICATION
		ADDI NA,1	
	HRLI NA,440700	;NEXT AREA
LOOP1:	TRNE B,COMF	;,?
	JRST GNXT1	;YES
	TRNE B,RTPF	;)?
	JRST GTERM1	;YES
	PUSHJ P,SCAN1	;NO, IT MUST BE }
	JRST LOOP1
GNXT1:	SOJLE N,GALL1	;NO MORE ALLOWED?
	AOS (P)	;YES, MORE , ADVANCE POINTER
	JRST LOOP2
CRMOD:	LEG	MOVEM NA,@(P)	;DEPOSIT POINTER
	TRNE B,BSLF	;L (→)?
	JRST BKS2	;YES
	PUSHJ P,SARGIN	;GET ARG
BKR2:	TRNN B,RTPF	;)?
	JRST .+3	;NO
	PUSHJ P,SARCON	;YES, CONTINUE
	JRST .-3
	MOVEI TAC,177	;DEPOSIT...
LEG	IDPB TAC,NA	;END...
	MOVEI TAC,2	;OF ARG...
LEG	IDPB TAC,NA	;INDICATION
	ADDI NA,1	
	HRLI NA,440700	
LOOP3:	TRNE B,COMF	;,?
	JRST GNXT2	;YES
	TLNE B,CRFG!RBRF	;CR?
	JRST GTERM2	;YES
	PUSHJ P,SCAN1	;MUST BE }
	JRST LOOP3
GNXT2:	SOJLE N,GALL2	;NO MORE ALLOWED?
	AOS (P)	;YES, MORE
	PUSHJ P,SCAN1
	JRST CRMOD
GTERM1:	SETZB B,C	;PASS THE ) (RETURNING NOTHING)
GTERM2:	SOJLE N,GL	;GOTTEM ALL
	MOVEI TAC,177	;NO, DEPOSIT
LEG	IDPB TAC,NA	;A NULL...
	MOVEI TAC,2	;ARG...
LEG	IDPB TAC,NA	;...
	HRLI NA,440700
LOOP4:	AOS (P)	;INCREMNT POINTER
LEG	MOVEM NA,@(P)	;DEPOSIT
	SOJG N,LOOP4	
	ADDI NA,1
GL:	SUB P,[1,,1]	;FLUSH PNTR FROM PDL
	POPJ P,
GALL1:	PUSHJ P,SCAN1	;GET CHR.
	TRNN B,RTPF	;)?
	JRST GALL1	;NO
GALL2:	SUB P,[1,,1]	;FLUSH PNTR
	JRST SCAN1	;EAT THE ) OR , AND RETURN

BKHAN:	HRRZM NA,MTBPNT	;UPDATE IN CASE MEVAL CAUSES MACRO HACKING
	MOVEI TAC,1(P)
	BLT TAC,7(P)	;SAVE AC'S
	ADD P,[7(7)]
	TRO NOFXF	;NO FIXUPS
	PUSHJ P,MEVAL	;GET VALUE
	TLNN UNDF!ESPF
	TRNE NA,17
	JRST	[ERROR[ ASCIZ /UNDEFINED \ ARGUMENT/]
		MOVEI N,0
		JRST .+1]
	EXCH N,B	;GET NUMBER
	MOVEM C,NA-6(P)	;"EXCHANGE" CHAR WITH
	HRRZ C,MTBPNT	;PNTR (CREATE AGAIN IN CASE
	HRLI C,440700	;CHANGED DURING MEVAL)
	MOVEM C,@-7-1(P)	;MAKE SURE ARG PNTR IS UP TO DATE
	PUSHJ P,BKSLSH	;CON TO aSCII
	EXCH B,N
	EXCH C,NA-6(P)	;RESTORE CHAR, PUT BACK NEW PNTR
	SUB P,[7(7)]
	MOVSI TAC,2(P)
	HRRI TAC,1
	BLT TAC,6	;RESTORE AC'S
	MOVE TAC,1(P)
	TDZ REFLAG
	AND TAC,REFLAG
	OR TAC		;RESTORE FLAGS
	TLZ SFL		;SKIP THE , OR ) OR WHATEVER
	POPJ P,

BKS1:	PUSHJ P,BKHAN
	JRST BKR1
BKS2:	PUSHJ P,BKHAN
	JRST BKR2
BEND

;SARGIN:	CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR
		;DEPOSIT SHOULD BE IN NA.
;	STARTS WITH CURRENT CHR. & TERMINATES ON , OR CR OR ) OR > OR ].
;	USES TAC .  IF FIRST IS { , TERMS ON }

↑SARGIN:PUSH P,TAC
	MOVE TAC,TLBLK
	MOVEM TAC,SVLIN
	MOVEM TAC,SARLIN
	MOVE TAC,PGNM
	MOVEM TAC,SARGPG
	MOVEM TAC,SARPG
	POP P,TAC
	TRNE B,LBCF	;{ ?
	JRST BROK	;YES
SLOOP:	TRZ B,RBCF
	TDNE B,[XWD RBRF!CRFG,RTPF!COMF];, OR CR OR ) OR > OR ]?
	JRST BFND	;YES
SARCO:	LEG	IDPB C,NA	;NO, DEPOSIT
	PUSHJ P,SCAN1	;GET NEXT
	JRST SLOOP
BROK:	SETZM SARTAC
BLOOP:	PUSHJ P,SCAN1	;GET CHR.
	TRNE B,LBCF	;{ ?
	AOS SARTAC	;YES
	TRNE B,RBCF	;} ?
	JRST [SOSL SARTAC	;YES
			JRST .+1
		TLZ B,RBRF	;NOT END OF LINE
		JRST BFND]
LEG	IDPB C,NA	;DEPOSIT CHR.
	JRST BLOOP
SARTAC:	0
SARLIN:	0
SARPG:	0
↑SARCON:PUSH P,SARLIN
	POP P,SVLIN
	PUSH P,SARPG
	POP P,SARGPG
	JRST SARCO
BFND:	SETZM SARGPG
	POPJ P,
;ROUTINE TO RETURN MACRO TABLE SPACE
↑MACRET:CAME B,MTBPNT
	JRST MACR2
	MOVEM C,MTBPNT	;AT END - JUST BACK UP MTBPNT
	CAME C,LGARB
	POPJ P,
	MOVE B,GARBAG	;ADJOINS OLD FREE AREA - WE CAN BACK UP MTBPNT SOME MORE
	MOVE C,2(B)
	MOVEM C,MTBPNT
	MOVE C,FSTPNT	;RETURN GARBAGE PNTR
	EXCH C,1(B)
	MOVEM C,GARBAG
	MOVEM B,FSTPNT
	JUMPE C,.+2
	MOVE C,3(C)
	MOVEM C,LGARB	;SET UP NEW "LAST GARBAGE" PNTR
	POPJ P,

;NOT AT END - INSERT IN ORDERED LIST, COMBINING WITH OLD ENTRIES IF POSSIBLE
MACR2:	PUSH M,T
	PUSH M,N
MACR2A:	SKIPA N,[-1,,GARBAG-1]
MACR3:	MOVEI N,(T)
	SKIPN T,1(N)
	JRST MACRE	;RAN OFF END
	CAMG B,3(T)
	JRST MACR3
	CAMN C,3(T)	;HERE WE HAVE PROPER POSITION
	JRST MACRL	;LOW END MATCHES OLD
MACRE:	JUMPL N,.+3
	CAMN B,2(N)
	JRST MACRH	;HIGH END MATCHES OLD
	EXCH N,FSTPNT	;NEITHER MATCHES - CREATE NEW ENTRY
	JUMPE N,MACRLZ	;TEST FOR NO FS
	EXCH T,1(N)
	EXCH T,FSTPNT
	MOVEM N,1(T)
	SETZM (N)	;ZERO SIZE FOR UPCOMING "COMBINE"
	JUMPGE T,.+2
	MOVEM B,LGARB	;UPDATE END ADR IF HIGHEST POS
	MOVEM B,3(N)
MACRH:	MOVEM C,2(N)
	SUBI B,(C)
	ADDM B,(N)
MACRX:	POP M,N
	POP M,T
	POPJ P,
MACRL:	JUMPL N,[MOVEM B,LGARB↔JRST .+3]	;UPDATE LGARB, AVOID TEST IF AT END
	CAMN B,2(N)
	JRST MACRB	;BOTH ENDS MATCH - WE HAVE CLOSED A HOLE!
	MOVEM B,3(T)
MACRL2:	SUBI B,(C)
	ADDM B,(T)
	JRST MACRX

MACRB:	MOVE C,2(T)	;COMBINE ALL 3 PIECES INTO ONE, RETURN ONE OLD PNTR BLK
	MOVEM C,2(N)
	EXCH N,FSTPNT
	EXCH N,1(T)
	EXCH T,FSTPNT
	MOVEM N,1(T)
	JRST MACRL2

;HERE IF NO FS FOR PNTR
	N,		;ARG FOR NOFSL
MACRLZ:	JSR NOFSL	;THIS MAY CHANGE LIST, SO ...
	MOVEM N,FSTPNT	;PUT BACK FS
	JRST MACR2A	;AND START SCAN OVER

↑GARBAG:0
↑LGARB:	0

↑LGET:	0
	PUSHJ P,SCAN1	;GET CHR.
	TRNN B,LBCF	;{ ?
	JRST .-2	;NO
	JRST @LGET	;YES
;REPEAT CODE IS HERE ------------

	DEFINE MACEX (AC)
<	LDB AC,[POINT 6,LSTPNT,11]
	HRL AC,INMCSW
	PUSH M,AC
	MOVEI AC,
	SKIPN NOEXP
	JRST .+3
	DPB AC,[POINT 6,LSTPNT,11]
	SETZM XPNDSW
	SETZM INMCSW
>
↑%REP:	TRO NOFXF	;GENERATE NO FIXUPS
	PUSHJ P,MEVAL	;EVALUATE EXPR.
	TRNN NA,17
	TLNE UNDF!ESPF	;DEFINED & NOT SPC. CHR?
	JRST REPER	;NO
	JUMPL N,REPER	;NEG. COUNT?
	SETOM REPSW	;SET REPEAT SWITCH (PUT CR LF AT END)
	PUSHJ P,REP	;GO DO
	TRZ NOFXF
	JRST ASSMBL	;PROCEED

	PUSHJ P,SCAN1	;GET NEXT
↑REP:	TRNN B,LBCF	;{ ?
	JRST REP-1	;NO
	TLZ SFL
LBFN:	JUMPE N,REP0	;REPEAT 0?
	CAIN N,1	;REPEAT 1?
	JRST REP1	;YES
	MOVE NA,MTBPNT	;MAKE READ-IN POINTER
	HRLI NA,440700	;...
	PUSHJ P,SARGIN	;READ IN
		SKIPN REPSW	;REPEAT?
	JRST NOREP	;NO
	MOVEI TAC,15	;YES, INSERT CR LF
LEG	IDPB TAC,NA
	MOVEI TAC,12
LEG	IDPB TAC,NA
NOREP:	MOVEI TAC,177	;DEPOSIT...
LEG	IDPB TAC,NA	;END...
	MOVEI TAC,4	;OF REPEAT...
LEG	IDPB TAC,NA	;...
	PUSH M,AHED	;PUSH LINE NUMBET TEST
		MOVSI TAC,(<SKIPA>)
	MOVEM TAC,AHED	;INHIBIT...
	MOVEM TAC,LOOP6	;LINE NUMBER SKIPPING
		MACEX (TAC)
	PUSH M,INPNT	;SAVE OLD SCAN POINTER
	HRRZI NA,1(NA)	;INCREMENT & ZERO LEFT
	PUSH M,NA	;SAVE NEW MTBPNT
	PUSH M,N	;SAVE COUNT
	PUSH M,MTBPNT	;SAVE OLD MTBPNT (POINTS TO STRT)
	MOVEM NA,MTBPNT	;RESET MTBPNT
	MOVE NA,(M)	;GET POINTER
	HRLI NA,440700
	MOVEM NA,INPNT	;POINT TO STRT
	DEFINE MACUND (ZORCHL)
<	SKIPN NOEXP
	SKIPN UNDLNS
	ZORCHLYZNOTFORPRESIDENT
	HRRZ TAC,LSTPNT
	CAIL TAC,TLBLK
	SUBI TAC,TLBLK-MBLK
	HRRM TAC,LSTPNT
	TRO MACUNF>
	MACUND (<POPJ P,>)
	POPJ P,
REP0:	MOVE TAC,TLBLK
	MOVEM TAC,SVLIN
	MOVE TAC,PGNM
	MOVEM TAC,REP0PG
	PUSHJ P,SLURP	;EAT ALL THE TEXT
	SETZM REP0PG
	POPJ P,
REP1:	SKIPN TAC,RTFLST	;GET POINTER
	SETZM BROKCT	;ZERO COUNT IF AT OUTSIDE LEVEL
	GFST NA,FSTPNT
	HRRZM NA,RTFLST	;GET FREE STRG.
	EXCH TAC,1(NA)
	MOVEM TAC,FSTPNT
	MOVE TAC,BROKCT	;GET COUNT
	MOVEM TAC,@RTFLST	;DEPOSIT
	POPJ P,
REPER:	ERROR[ASCIZ/REPEAT -- ILLEGAL EXPRESSION FOR COUNT/]
	JRST SPCFN
;BKSLSH:	CALL, WITH BYTE POINTER IN C & NUM IN B.
;	PUTS ASCII FOR NUM (IN CURRENT RADIX) AT PLACE POINTED TO BY C.
↑BKSLSH:JUMPE B,BKZER	;HANDLE ZERO SPECIALLY
	MOVEM C,BKPNT	;DEPOSIT BYTE POINTER
	PUSH P,N	;SAVE N
	MOVEI N,1	;
	XCT SRAD	;GET RADIX
	MOVEM N,BKRAD	;SAVE
	POP P,N		;RESTORE N
	JUMPL B,BKNEG	;NEG?
NLOPN:	PUSHJ P,BKCON	;DO IT
		MOVE C,BKPNT	;RESTORE POINTER
	POPJ P,		;LEAVE
BKNEG:	MOVEI C,"-"	;GET - SIGN
LEG	IDPB C,BKPNT
	MOVMS B
	JRST NLOPN
BKRAD:	0
BKPNT:	0
BKCON:	IDIV B,BKRAD	;DIVIDE BY RADIX
	JUMPE B,BZER	;ZERO?
	HRLM C,(P)	;NO, SAVE REMAINDER
	PUSHJ P,BKCON	;CONVERT REST OF NUM
	HLRZ C,(P)	;GET REMAINDER BACK
BZER:	ORI C,60	;CON TO ASCII
LEG	IDPB C,BKPNT	;PUT OUT
	POPJ P,		;LEAVE
BKZER:	MOVEI B,"0"	;HANDLE ZERO...
LEG	IDPB B,C	;AS A SPECIAL...
	POPJ P,		;CASE
↑%FOR:	MOVE O,MTBPNT
	PUSHJ P,SCAN	;GET FIRST ARG
	TLNN IFLG	;IDENT?
	JRST FERR1	;NO
	MOVEI FS,200	;NO CONCAT CHR.
F1RT:	LEG	MOVEM L,(O)	;SAVE
LEG	SETZM 1(O)	;MAKE SURE THIS CELL EXISTS, THO WE MAY NOT USE IT
	MOVEI T,1	;ARG COUNT
	TRNN B,COMF	;, NEXT?
	JRST NOSEC	
	TLZ SFL		;SKIP THE ,
	PUSHJ P,SCAN	;GET NEXT
	TLNN IFLG	;IDENT?
	JRST FERR2	;NO
LEG	MOVEM L,1(O)	;SAVE
	MOVEI T,2	;ARG COUNT
NOSEC:	PUSHJ P,SCAN	;GET NEXT
	TLNE IFLG	;IDENT?
		JRST ICHK	;YES
	TLNN SCFL	;SPC. CHR?
	JRST FERR3	;NO
	TRNE N,LACF	;←?
	JRST LFOR	;YES
	TRNE N,EPSF	;?
		JRST EFOR	;YES
	TRNE N,INF	;⊂?
	JRST INFOR	;YES
	ERROR[ASCIZ/UNREC CHR. AFTER ARGS -- FOR/]
	JRST SPCFN
ICHK:	CAIN L,'IN'	;IN?
	JRST INFOR	;YES
	CAIN L,'E'	;E?
	JRST EFOR	;YES
	ERROR[ASCIZ/UNREC IDENT AFTER ARGS -- FOR/]
	JRST SPCFN
FERR1:	TLNE SCFL	;SPC CHR?
	JRST CONE	;YES
FER1A:	ERROR[ASCIZ/NO IDENT AFTER FOR/]
	JRST SPCFN
FERR2:	ERROR[ASCIZ/NO IDENT FOR SECOND ARG -- FOR/]
	JRST SPCFN
FERR3:	ERROR[ASCIZ/NUMBER AFTER ARGS -- FOR/]
	JRST SPCFN
FERR5:	ERROR [ASCIZ /ILLEGAL CONCATENATION CHR -- FOR/]
	JRST SPCFN
CONE:	TRNN N,ATF	;@?
	JRST FER1A	;NO
		MOVE FS,C	;YES, GET CONCAT CHR.
	TRNE B,RBCF	;IS IT A > OR A ⎇
	JRST FERR5
	TLZ SFL		;SKIP CHR.
	PUSHJ P,SCAN	;GET NEXT
	TLNE IFLG	;IDENT?
	JRST F1RT	;YES
	JRST FER1A	;NO
OSAV:	BLOCK 2
CONSAV:	0
FSVV:	0
TSVV:	0
LFOR:	MOVEM FSVV	;SAVE FLAGS
	TRO NOFXF	;NO FIXUPS
	MOVEM T,TSVV	;SAVE ARG COUNT
	MOVEM FS,CONSAV	;SAVE CONCAT CHR.
	MOVE T,(O)	;SAVE...
	MOVEM T,OSAV	;ARGS
	MOVE T,1(O)	
		MOVEM T,OSAV+1
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE UNDF!ESPF	;DEFINED?
	JRST FERR4	;NO
	PUSH P,N	;SAVE
	TLZ SFL	
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE UNDF!ESPF	;DEFINE?
	JRST FERR4A	;NO
	PUSH P,N	;SAVE
	TRNN B,COMF	;, NEXT?
	JRST NOTHRD	;NO
	TLZ SFL
	PUSHJ P,MEVAL	;GET VALUE
	TRNN NA,17
	TLNE UNDF!ESPF	;DEFINED?
	JRST FERR4B	;NO
	SKIPA
NOTHRD:	MOVEI N,1
	MOVE T,TSVV	;GET ARG COUNT
	MOVE O,FSVV	;GET OLD FLAGS
	TDZ REFLAG
	AND O,REFLAG
	OR T		;RESTORE FLAGS
		MOVE O,MTBPNT	;GET POINTER
	MOVE NA,OSAV	;REDEPOSIT ARGS
LEG	MOVEM NA,(O)	;THIS IS DONE IN CASE...
	MOVE NA,OSAV+1	;MEVAL RAN OUT OF...
LEG	MOVEM NA,1(O)	;FREE STRG & MTBPNT CHANGED
	MOVE NA,(P)	;GET TERM #
	JUMPL N,.+4
	CAML NA,-1(P)	;ZERO TIMES?
	JRST .+4	;NO
	JRST NOTIM	;YES
	CAMLE NA,-1(P)	;ZERO TIMES?
	JRST NOTIM	;YES
	PUSH P,N	;SAVE N
	MOVEI N,2(O)	;MAKE POINTER
	HRLI N,440700	;...
	MOVE FS,CONSAV
	CAIN FS,200	;CONCAT CHR?
	JRST FLOP1	;NO
		PUSH P,CTAB(FS)	;SAVE BITS
	MOVSI NA,SPFL!SPCLF;GET NEW BITS
	MOVEM NA,CTAB(FS)
FLOP1:	PUSH P,FS	;SAVE CONCAT CHR.
	MOVE NA,O	;ARG POINTER
	JSR LGET	;GET TO THE {
	PUSHJ P,TXTIN	;GET TEXT
	PUSH M,AHED	;SAVE LINE NUM SKIP
	MOVSI FS,(<SKIPA>)
	MOVEM FS,AHED
	MOVEM FS,LOOP6	;INHIBIT LINE NUM SKIP
		MACEX (FS)
	PUSH M,INPNT	;SAVE OLD INPNT
	EDEPO(L,N,5)	;DEPOSIT END OF FOR
	HRRZI N,6(N)	;INCREMENT
	PUSH M,N	;SAVE
	POP P,FS	;GET CONCAT CHR
	CAIE FS,200	;ANY?
	POP P,CTAB(FS)	;YES, RESTORE BITS
	PUSH M,(P)	;SAVE INCREMENT
	PUSH M,-1(P)	;SAVE TERM NUM
	PUSH M,-2(P)	;SAVE STARTING #
	PUSH M,O	;SAVE STARTING ADDRS -2
	MOVEI FS,-5(N)	;GET ARG POINTER
	PUSH M,FS	;SAVE
	SUB P,[3(3)]
	MOVEM N,MTBPNT	;RESET MTBPNT
	MOVEI C,-3(N)	
	HRLI C,440700
LEG	MOVEM C,-5(N)	;DEPOSIT ARG ...
LEG	MOVEM C,-4(N)	;POINTERS
	MOVE B,-2(M)	;GET NUMBER
	PUSHJ P,BKSLSH	;CONVERT TO ASCII
	EDEPO (TAC,C,2)	;DEPOSIT END OF ARG
		ADD O,[XWD 440700,2]
	MOVEM O,INPNT	;DEPOSIT
	MACUND JRST ASSMBL
	JRST ASSMBL	;GO, MAN
NOTIM:	SUB P,[2(2)]	;CLEAR STACK
	MOVEI N,	;REPEAT 0
	PUSHJ P,REP
	JRST ASSMBL
FERR4B:	POP P,N
FERR4A:	POP P,N
FERR4:	ERROR[ASCIZ/UNDEFINED ARG -- FOR/]
	JRST SPCFN
INFOR:	PUSHJ P,SCAN	;GET TO THE (
	TLNN SCFL	;SPCL CHR?
	JRST .-2	;NO
	TRNN N,LFPF	;(?
	JRST .-4	;NO
	PUSHJ P,SCAN1	;GET NEXT CHR.
		MOVEI NA,5(O)	;GET POINTER FOR ARGS
	HRLI NA,440700	;...
LEG	MOVEM NA,3(O)	;DEPOSIT SECOND ARG POINTER
INLOP2:	TRNE B,LBCF	;{?
LEG	IDPB C,NA	;YES, DEPOSIT IT
	PUSHJ P,SARGIN	;GET FIRST ARG.
INLOP1:	TRNE B,RTPF	;TERM BY )?
	JRST RTERM	;YES
	TRNE B,COMF	;TERM BY COMMA?
	JRST MYCON	;YES
	PUSHJ P,SARCON	;NO, CONTINUE
	JRST INLOP1
MYCON:	LEG	IDPB C,NA
	PUSHJ P,SCAN1
	TRNE B,LBCF	;{?
LEG	IDPB C,NA	;YES, DEPOSIT
	PUSHJ P,SARGIN
	JRST INLOP1
RTERM:	EDEPO (N,NA,2)	;DEPOSIT END OF ARG
		CAIN FS,200	;ANY CONCAT CHR?
	JRST IFLOP	;NO
	PUSH P,CTAB(FS)	;SAVE BITS
	MOVSI N,SPFL!SPCLF;MAKE...
	MOVEM N,CTAB(FS);NEW BITS
IFLOP:	MOVEI N,4(O)	;GET...
	HRLI N,440700	;FIRST ARG...
	MOVEM N,2(O)	;POINTER
		MOVEI N,1(NA)	;MAKE TEXT...
	HRLI N,440700	;POINTER
	PUSH P,FS	;SAVE CONCAT CHR.
	MOVE FS,N	;& SAVE
	JSR LGET	;GET TO THE {
	MOVE NA,O	;SET ARG POINTER
	PUSHJ P,TXTIN	;GET TEXT IN
	PUSH M,AHED	;SAVE LINE NUM TEST
	MACEX (L)
	PUSH M,INPNT	;SAVE
	MOVSI L,(<SKIPA>)
	MOVEM L,AHED	;INIHIBIT LINE NUM...
	MOVEM L,LOOP6	;SKIPPING
	EDEPO (L,N,6)	;DEPOSIT END OF FOR-IN
	HRRZI N,1(N)	;FORM NEW MTBPNT
	PUSH M,N	;SAVE
	PUSH M,MTBPNT	;SAVE OLD
	MOVEM N,MTBPNT
	PUSH M,FS	;SAVE STRT OF TEXT
	MOVEI N,2(O)	;GET ARG POINTER
	PUSH M,N	;SAVE
	POP P,FS	;GET CONCAT
	CAIE FS,200	;ANY?
	POP P,CTAB(FS)	;YES, RESTORE
	PUSHJ P,IFORSH	;SET UP ARGS
	MACUND JRST ASSMBL
	JRST ASSMBL
↑IFORSH:MOVE B,(M)	;GET ARG POINTER
	MOVE C,1(B)	;GET SECOND ARG POINTER
	PUSH P,N	;SAVE N
	MOVE B,(B)	;GET FIRST ARG POINTER
	ILDB TAC,C	;GET CHR.
	SKIPGE N,CTAB(TAC)	;GET BITS
	JRST ILOPI2	
	TLNE N,SCRF	;CHECK FOR SPECIAL ({ AND < AND > AND ⎇)
	XCT IFORT(N)
	TRNE N,LBCF	;{?
	JRST LBRK	;YES
ILOPI1:	TRNE N,COMF	;,?
	JRST COMTOM	;YES
	TLNE N,DLETF	;DELETE?
		JRST DELTOM	;YES
ILOPI2:	IDPB TAC,B	;DEPOSIT
	ILDB TAC,C	;GET NEXT
	SKIPL N,CTAB(TAC);GET BITS
	JRST ILOPI1
	JRST ILOPI2
IFORT:	FOR I←0,7 <JFCL
>
	HRRI N,LBCF!TP2F	;< OR {
	HRRI N,RBCF!TP2F	;> OR ⎇
DELTOM:	MOVE C,(M)	;GET ARG POINTER
	MOVEM B,1(C)	;DEPOSIT SECOND ARG POINTER
	EDEPO (TAC,B,2)
	JRST FINIT
COMTOM:	EDEPO (N,B,2)
	MOVE N,(M)	;GET ARG POINTER
	MOVEM C,1(N)	;DEPOSIT SECOND ARG POINTER
FINIT:	POP P,N	;RESTORE
	MOVE B,-1(M)	;GET START
	MOVEM B,INPNT	;DEPOSIT
	POPJ P,
LBRK:	SETZM IFOCNT	;ZERO {} COUNT
	SKIPA
LILO1:	IDPB TAC,B
	ILDB TAC,C	;GET CHR.
	SKIPGE N,CTAB(TAC);GET BITS
	JRST LILO1	;NOT SPC CHR.
	TLNE N,SCRF
	XCT IFORT(N)
	TRNE N,LBCF	;{?
	AOS IFOCNT	;YES
	TRNE N,RBCF	;}?
	SOSL IFOCNT	;YES, DONE?
	JRST LILO1	;NO
LILO2:	ILDB TAC,C	;GET NEXT
	SKIPGE N,CTAB(TAC);GET BITS
	JRST LILO2	
	TRNE N,COMF	;,?
	JRST COMTOM	;YES
	TLNE N,DLETF	;DELETE?
	JRST DELTOM	;YES
	JRST LILO2	;NO
IFOCNT:	0
EFOR:	JSR LGET	;GET TO THE {
	MOVEI NA,5(O)	;SET UP POINTER...
	HRLI NA,440700	;TO READ IN ARG...
LEG	MOVEM NA,3(O)	;DEPOSIT
	PUSHJ P,SARGIN	;GET ARG.
	EDEPO (TAC,NA,2);DEPOSIT END OF ARG
	MOVEI TAC,4(O)	;FORM FIRST ARG...
	HRLI TAC,440700	;POINTER
	MOVEM TAC,2(O)	;DEPOSIT
	JSR LGET	;GET TO THE {
	MOVEI N,1(NA)	;FORM TEXT POINTER
	HRLI N,440700	;...
	PUSH P,N	;SAVE
	CAIN FS,200	;ANY CONCAT CHR?
	JRST EFLOP	;NO
	PUSH P,CTAB(FS)	;SAVE BITS
	MOVSI NA,SPFL!SPCLF;MAKE...
	MOVEM NA,CTAB(FS);NEW BITS
EFLOP:	PUSH P,FS	;PUSH CONCAT
	MOVE NA,O	;ARG POINTER
	PUSHJ P,TXTIN	;READ IN BODY OF TEXT
		EDEPO (L,N,7);DEPOSIT END OF FOR
	PUSH M,AHED	;SAVE LINE NUM SKIPPING
	MACEX (L)
	MOVSI L,(<SKIPA>)
	MOVEM L,AHED
	MOVEM L,LOOP6
	PUSH M,INPNT	;SAVE SCAN POINTER
	POP P,L		;GET CONCAT
	CAIE L,200	;ANY?
	POP P,CTAB(L)	;YES, RESTORE BITS
	ADDI N,1	;FORM NEW...
	HRRZS N		;MTBPNT
	PUSH M,N	;SAVE
	MOVEM N,MTBPNT	;DEPOSIT
	MOVE N,2(O)	;GET FIRST ARG POINTER
	IBP N
	EDEPO (TAC,N,2);DEPOSIT END OF ARG
	POP P,L		;GET START OF TEXT
	PUSH M,L	;SAVE
	MOVEI L,2(O)	;GET ARG POINTER
	PUSH M,L	;SAVE
	PUSHJ P,EFORSH	;SET UP FIRST
	MACUND (JRST ASSMBL)
	JRST ASSMBL
↑EFORSH:MOVE B,(M)	;GET ARG POINTER
	ILDB C,1(B)	;GET NEXT CHR.
	MOVE B,(B)	;GET FIRST ARG POINTER
	IDPB C,B	;DEPOSIT CHR.
	CAIN C,177	;DONE?
	JRST DYES	;YES
		MOVE B,-1(M)	;GET TEXT POINTER
	MOVEM B,INPNT	;DEPOSIT
	POPJ P,
DYES:	POP M,C		;GET STRT OF REMOVABLE AREA
	SUBI C,2	;ADJUST
	POP M,B		;GET END
	POP M,B
	PUSHJ P,MACRET
	POP M,INPNT	;RESET INPNT
	POP M,C		;GET LSTPNT
	DPB C,[POINT 6,LSTPNT,11];RESTORE
	HLRZM C,INMCSW	;RESTORE...
	HRRZM C,XPNDSW	;SWITCHES
	POP M,C
	MOVEM C,AHED	;RESTORE...
	MOVEM C,LOOP6
	SKIPE UNDLNS	;UNDERLINING?
	SKIPE NOEXP	;NO EXPAND?
	POPJ P,
	SKIPN INMCSW	;INA MACRO?
	POPJ P,
	HRR C,LSTPNT
	ADDI C,TLBLK-MBLK
	HRRM C,LSTPNT
	POPJ P,

BEND MAC

LEGTAB:	FOR @! X←0,LEGNUM-1{,%$L!X
}LEGCNT←←LEGNUM

XLIST
LIT
VAR
LIST

END STRT