;
; Somehow, in the dim past the source of this program became out of sync
; with the running binary. The binary was version 174 while the source
; was 177; moreover the source had several errors and did not assemble!
;	By using SRCCOM (/$) to compare binaries, a working source was
; re-created and verified to assemble into exactly the same program as 174.
; This new source was installed and blessed with a new number of 200
; to commemorate the establishment of a New Regime on 11-Jun-85.
;		 --KLH

TITLE TSTINKING ODER

.MLLIT==1

ZR=0
P=1
A=2
B=3		;SEE L.OP
C=B+1
D=C+1
T=6
TT=T+1		;SEE CD1, SIXO, ASPT
ADR=10
BOT=11
CKS=12
LL=13
RH=14
MEMTOP=15
NBLKS=16
FF=17

;I/O CHANNELS

TPCHN==1
TYOC==2
TYIC==3
ERCHN==4	;CHANNEL FOR ERROR DEVICE

;RIGHT HALF FLAGS

ALTF==1		;ALT MODE READ FLAG(USED LOCALLY IN COMMMAND READER)
LOSE==2
ARG==4
UNDEF==10	;COMPLAIN ABOUT UNDEF
INDEF==20	;GLOBAL LOC
GLOSYM==40	;ENTER GLOBAL SYMS INTO DDT TABLE
SEARCH==100	;LIBRARY
CODEF==200	;SPECIAL WORD LOADED
GPARAM==400	;ENTER GPA LOCALS
COND==1000	;LOAD TIME CONDITIONAL
ADRREL==2000	;ADR IS RELOCATABLE QUANTITY
LOCF=4000	;LOCAL IN SYM PRT
JBN==10000	;JOB NAME SET BY JCOMMAND
GOF==20000	;LEAVING LDR BY G COMMAND
GETTY==40000	;GE CONSOLE
MLAST==100000	;LAST COMMAND WAS AN "M"
NOTNUM==200000	;USED FOR DUMMY SYMBOL LOGIC
SETDEV==400000	;DEVICE SET LAST TIME

;LEFT HALF FLAGS

HSW==1		;HALF WORD TOGGLE USED TO READ POLISH
NAME==2000	;SET JOB NAME TO PROGRAM NAME

;UUO'S FOR ERRORS

FATAL=3000,,0	;FATAL ERROR WITH NO SYMBOL TYPE OUT
WARN=7000,,0	;WARNING ERROR MESSAGE, NO SYMBOL OR OCTAL TYPE OUT
SYMERR=5000,,0	;ILLEGAL GLOBAL ASSIGNMENT
FATADR==2000,,0	;FATAL ERROR, TYPE ADR

;INSTRUCTIONS

DEFINE HALT
.VALUE
TERMIN

DEFINE OPEN CHANNEL,MODE
	.CALL	[SETZ
		SIXBIT/OPEN/
		3000,,ERRSTS
		5000,,MODE
		1000,,CHANNEL
		DEV
		NM1
		NM2
		SETZ SNAME]
TERMIN


;MISCELLANEOUS CONSTANTS

LOWLOD==0	;LOWEST LOCATION LOADED
CBUFL==2000	;COMMAND BUFFER LENGTH (MOBY LONG!)
FNBLEN==200	;FILE NAME BUFFER LENGTH
ALTMOD==33	;THE ALTMODE CHARACTER
INHASH==151.	; HASH TABLE LENGTH
ICOMM==10000	;INITIAL COMMON
HIREL0==400000	;RELOCATABLE VALUES GE THIS ARE HI SEG

LPDL==20	;LENGTH OF PROCESS PUSH DOWN AREA
PPDL==60	;POLISH PUSH DOWN LENGTH
SATPDL==5	;SATED PUSH DOWN LENGTH
MNLNKS==20	;MAXIMUM NUMBER OF LINKS
STNBLN==200	;STINK INPUT BUFFER SIZE

;REFERENCE WORD FLAGS

FIXRT==1
FIXLT==2
POLREQ==200000	;MARKS GLOGAL REQUEST AS POLISH REQUEST
DEFINT==400000	;DEFERED INTERNAL

MFOR==101000	; FOR .CBLK
MBLKS==301000

BUCK==2		; OFFSETS INTO SYMBOL BLOCKS
LIST==3

	LOC 41
	JSR TYPR
	0	;TSINT

IF2,COMLOD=TPOK	;IS YOUR TAPE OK?

DEFINE CHECK A,B
IF1,[IFN .-A-<B>,[PRINTX \ A LOSES **************
\]]
TERMIN

DEFINE INFORM A,B
IF1,[PRINTX / A = B
/]
TERMIN

DEFINE CONC69 A,B,C,D,E,F,G,H
A!B!C!D!E!F!G!H!TERMIN


LOC 100
REL:	MOVEI TT,1		;RELOCATE RIGHT HALF OF T
	PUSHJ P,RELOCT
	TROA FF,ADRREL		;FLAG TO SAVE ADR WHEN FINISHED LOADING BLOCK
ABS:	TRZ FF,ADRREL
	HRRZ ADR,T
DATABK:	HRRZS ADR
	PUSHJ P,GETBIT
	TRZE TT,4
	JRST DATBK1
	PUSHJ P,RRELOC
COM1:	ADDB T,AWORD
	ADD T,RH
	HLL T,AWORD
	CLEARB RH,AWORD
IFN LOWLOD,[
	CAIGE ADR,LOWLOD
	AOJA ADR,DATABK
]
GCR2:	TRNE	FF,CODEF
	JRST	GCR3
	CAMLE	ADR,MEMTOP
	JRST	GCR1
	MOVEM	T,@ADRPTR
	SKIPA
GCR3:	MOVEM	T,(ADR)
	AOJA	ADR,DATABK

ERR1:
DATBK1:	PUSHJ P,RLKUP
	TRNE TT,2
	JRST DECODE	;LINK OR EXTEND
USE:	ROTC T,3
	HRL ADR,TT
	SKIPE C,TIMES
	CLEARM TIMES
	DPB C,[261200,,ADR]
	JUMPGE D,USE1A
	TLNE B,200000
	JRST USE2	;PREV DEFINED
	TRNE FF,UNDEF
	JRST ERR2
	PUSHJ P,DOWN
	MOVEM ADR,(D)
CDATABK:	JRST DATABK

GCR1:	CAML	ADR,HIORG	; PURE?
	JRST	HIGHSG		; YES, USE HIGH SEG
	PUSHJ	P,GETMEM
	JRST	GCR2

HIGHSG:	CAMLE	ADR,HIGTOP	; WITHIN HIGH BOUND?
	PUSHJ	P,GETHI		; NO, GROW
	MOVEM	T,(ADR)		; STORE
	AOJA	ADR,DATABK

; ROUTINE TO GROW HIGH SEGMENT

GETHI:	PUSH P,A
	MOVEI TT,(ADR)
	SUB	TT,HIORG	;SUBI TT,400000-2000
	ADDI	TT,2000
	ASH TT,-10.
	SUB TT,HIBLK	;NUMBER OF BLOCKS TO GET
	ADDM TT,HIBLK	;NUMBER OF BLOCKS WE ARE GOING TO HAVE
	SKIPG TT
	FATAL [ASCIZ/High Segment Request is Negative/]
	MOVE A,CWORD1
GETHI1:	ADDI A,1000
	.CBLK A,
	PUSHJ P,SCE
	SOJG TT,GETHI1
	MOVEM A,CWORD1
	MOVE TT,HIBLK
	ASH TT,10.
	ADD	TT,HIORG	;ADDI TT,400000-1
	SUBI	TT,1
	MOVEM TT,HIGTOP
	JRST POPAJ

USE2:	MOVE T,1(D)	;FILL REQUEST
	PUSHJ P,DECGEN
	ADDM T,AWORD
	ADDM TT,RH
	JRST DATABK

USE1A:	MOVE T,ADR
USE1:	TLO A,400000
	TRNN FF,UNDEF
	JRST DEF1A	;ENTER DEF
ERR2:	SYMERR [ASCIZ/Undefined Global Assignment/]
	JRST DATABK

DEF1:	TLO A,600000
	TRNN FF,INDEF+GPARAM	;DEFINE ALL SYMBOLS
	TLNE A,40000	;OTHERWISE, FLUSH LOCALS
	JRST ENT
	JRST DEF4

RDEF:	TRO TT,10	;SET FLAG FOR REDEFINITION
DEF:	ROTC T,3
	PUSHJ P,RRELOC
DFSYM1:	PUSH P,CDATABK
DEFSYM:	MOVEM T,T1
DFSYM2:	MOVEM A,CGLOB	;SAVE SQUOOZE IN CASE WE SATISFY POLISH
	JUMPGE D,DEF1	;NOT PREV SEEN
	TLNN B,200000	;PREVIOUSLY DEFINED
	JRST PATCH5	;PREVIOUSLY NEEDED

DEF2:	TRNE TT,100	;REDEFINE NOT OK
DEF3:	MOVEM T,1(D)
	CAME T,1(D)
	SYMERR [ASCIZ/Multiply Defined Global/]
DEF4:	TRZ FF,GPARAM
	POPJ P,

PATCH3:	PUSH	P,PATCH6
PATCH:	PUSH	P,A		; SAVE SYMBOL
	HRRZ	D,T2		; DELETE REFERENCES FROM TABLE
	MOVE	A,(D)		; SQUOOZE
	TLNE	A,200000	; CHECK FOR DEFINED SYMBOL
	JRST	PATCH2		; DON'T DELETE REFERENCES
	HRRZ	A,1(D)		; FIRST REFERENCE
	SETZM	1(D)
; PTCH2A:	;;177
PTCH2B:
	HRRZ	D,(A)
	PUSHJ	P,PARRET
	SKIPE	A,D
;	JRST	PTCH2A	;;177
	JRST	PTCH2B	;;174

PATCH2:	HRRZ	A,T2		; POINT TO SYMBOL TO BE FLUSHED(REFS ARE GONE)
	HRRZ	B,LIST(A)	; GET LIST POINTER LEFT
	HLRZ	C,LIST(A)	; AND RIGHT
	SKIPE	B		; END?
	HRLM	C,LIST(B)	; NO, SPLICE
	SKIPE	C
	HRRM	B,LIST(C)	
	HRRZ	C,BUCK(A)	; NOW GET BUCKET POINTERS
	HLRZ	B,BUCK(A)
	CAMG	B,HTOP		; SEE IF POINTS TO HASH TABLE
	CAMGE	B,HBOT
	JRST	PTCH2A		; NO, SKIP
	HRRM	C,(B)		; IT IS, CLOBBER IN
;	CAIA		;;177
	JRST .+2	;;174
PTCH2A:	HRRM	C,BUCK(B)	; SPLICE BUCKET
	SKIPE	C
	HRLM	B,BUCK(C)	; SPLICE IT ALSO
	CAIN	A,(BOT)		; RESET BOT?
	HRRZ	BOT,LIST(BOT)	; YES
	SETZM	LIST(A)		; CLEAR FOR DEBUGGING
	PUSHJ	P,QUADRT	; RETURN BLOCK
	POP	P,A		; RESTORE SYMBOL
	SKIPE	SATED
	JRST	UNSATE		;DELETE THEM
PATCH6:	POPJ P,	.+1

PATCH7:	PUSHJ	P,LKUP1A
	JUMPGE	D,DEF1
PATCH5:	HRRZM	D,T2

	HRRZ	B,1(D)		; POINT TO REF CHAIN
	MOVEI	D,(B)
PATCH1:	MOVE	T,T1
	JUMPE	D,PATCH3
	MOVE	B,1(D)		; GET REF WORD
	HRRZ	D,(D)
	HLL	ADR,B
	HRRZS	B
	TLZE	ADR,DEFINT
	JRST	DEFIF		;DEFERED INTERNAL
	TLZE	ADR,POLREQ	
	JRST	POLSAT		;POLISH REQUEST
	CAIGE	B,LOWLOD
	JRST	PATCH1
	TLZN	ADR,100000
	JRST	GEN		;GENERAL REQUEST
	PUSH	P,CPTCH1
UNTHR:	PUSH	P,D
	HRRZ	D,B		; VIRUTAL ADDRESS
	PUSHJ	P,MAPD		; GET REAL ADDRESS
	HRL	T,(D)
	HRRM	T,(D)
	POP	P,D
	HLRZ	B,T
	JUMPN	B,UNTHR
CPTCH1:	POPJ P,	PATCH1

DEFIF:	SKIPGE (B)
	JRST DEFIF1		;MUST SATISFY DEFERRED INTERNAL
	TLNE ADR,FIXRT+FIXLT
	HALT
DEFIF6:	EXCH A,B
	PUSHJ P,PARRET
	MOVE A,B		;GET THE SYMBOL BACK
	JRST PATCH1

DEFIF1:	TLNN ADR,FIXRT+FIXLT
	HALT			;SYMBOL FIXED UP BUT NOT EXPUNGED FROM TABLE
	TLC ADR,FIXRT+FIXLT
	TLCN ADR,FIXRT+FIXLT
	 HALT			;BOTH BITS TURNED ON!!
	PUSH P,D
	PUSH P,B		;POINTS TO VALUE PAIR
	MOVE T,1(B)		;SQUOOZE FOR DEFERRED INTERNAL
	PUSHJ P,LKUP
	JUMPGE D,DEFIF4		;PERHAPS ITS'S IN DDT TABLE
	TLNE B,200000
	 HALT			;LOSER
	PUSHJ P,GLOBS3		;FIND THE VALUE
	CAIN B,0
	 HALT
	TLNE ADR,FIXRT
	JRST DEFIFR		;RIGHT HANDED
	TLNN ADR,FIXLT
	JRST DEFIF2		;LEFT HANDED FIXUP
	TLZN A,FIXLT
	 HALT
	HLRE T,1(A)
DEFIF2:	ADD T,T1
	TLZE ADR,FIXRT
	HRRM T,1(A)
	TLZE ADR,FIXLT
	HRLM T,1(A)
	MOVEM A,1(B)		;WRITE THE REFERENCE WORD BACK
	MOVE T,1(A)		;SAVE VALUE OF THIS GLOBAL IN CASE
	MOVE B,A
	POP P,A			;POINTS TO VALUE PAIR
	PUSHJ P,PARRET
	TLNE B,FIXLT+FIXRT
	JRST DEFIF3		;STILL NOT COMPLETELY DEFINED
	MOVE B,(D)		;SIMULATE CALL TO LKUP
	MOVE A,B
	TLZ A,700000
	PUSH P,T1
	PUSH P,T2
	PUSH P,CGLOB
	PUSHJ P,DEFSYM		;HOLD YOUR BREATH
	POP P,CGLOB
	POP P,T2
	POP P,T1
DEFIF3:	POP P,D
	MOVE A,CGLOB
	JRST PATCH1

DEFIFR:	TLZN A,FIXRT
	 HALT
	HRRE T,1(A)
	JRST DEFIF2

DEFIF4:	POP P,B
	POP P,D
	PUSH P,B
	PUSH P,T1	;VALUE TO BE ADDED
	PUSH P,[DEFIF5]	;WHERE TO RETURN
	TLZ T,200000	;ASSUME RIGHT HALF FIX
	TLZE ADR,FIXLT
	TLO T,200000	;ITS LEFT HALF FIX
	TLZ ADR,FIXRT
	JRST GLST2
DEFIF5:	POP P,B
	MOVE A,CGLOB
	JRST DEFIF6

GEN:	PUSHJ P,DECGEN
	PUSH P,D
	HRRZ D,B	; VIRTUAL ADDRESS
	PUSHJ P,MAPD	; REAL ADDRESS
	ADD T,(D)
	ADD TT,T
	HRR T,TT
	MOVEM T,(D)
	POP P,D
	JRST PATCH1

DECGEN:	MOVEI TT,0
	TLNE ADR,10
	MOVNS T
	LDB C,[(261200)ADR]
	SKIPE C
	IMUL T,C
	LDB C,[(220200)ADR]
	TLNE ADR,4
	MOVSS T
	XCT WRDTAB(C)

WRDTAB:	POPJ P,		;FW
	EXCH T,TT	;RH
	HLLZS T		;LH
	ROT T,5		;AC

DECODE:	TRNN TT,1
	JRST THRDR	;6 > LINK REQ
	PUSHJ P,GETBIT
	JRST @.+1(TT)
	DEF	;DEFINE SYMBOL (70)
	COMMON	;COMMON RELOCATION (71)
	LOCGLO	;LOCAL TO GLOBAL RECOVERY (72)
	LIBREQ	;LIBRARY REQUEST (73)
	RDEF	;REDEFINITION (74)
	REPT	;GLOBAL MULTIPLIED BY 1024>N>0 (75)
	DEFPT	;DEFINE AS POINT (76)

RLKUP:	PUSHJ P,RPB

LKUP:	MOVE A,T
LKUP1B:	MOVE D,BOT
LKUP3:	MOVEI B,0(ADR)	;CONTAINS GLOBAL OFFSET
	TRNN FF,CODEF
	MOVEM B,CPOINT+1	;$.
	TLZ A,700000
LKUP1A:	PUSH	P,A
	MOVE	B,HTOP
	SUB	B,HBOT		; COMP LENGTH
	IDIVI	A,(B)		; HASH THE SYMBOL
	ADD	B,HBOT		; POINT TO THE BUCKET
	HRRZ	D,(B)		; SKIP IF NOT EMPTY
	MOVE	A,(P)		; RESTORE SYMBOL
	JRST	LKUP7
LKUP1:	MOVE	B,(D)		; GET A CANDIDATE
	TLZ	B,600000
	CAMN	A,B		; SKIP IF NOT FOUND
	JRST	LKUP5
	HRRZ	D,BUCK(D)	; GO TO NEXT IN BUCKET
LKUP7:	JUMPE	D,LKUP6		; FAIL, GO ON
	HRROI	D,(D)
	JRST	LKUP1

LKUP6:	TROA	FF,LOSE
LKUP5:	MOVE	B,(D)		; SYMBOL WITH ALL FLAGS TO B
	JRST	POPAJ

RRELOC:	PUSHJ P,RPB
RELOC:	HLRZ C,T
	TRNE TT,1		;RELOCATE RIGHT HALF?
	PUSHJ P,RELOCT
	EXCH C,T
	TRNE TT,2
	PUSHJ P,RELOCT		;PERHAPS RELOCATE THE LEFT HALF
	EXCH C,T
	HRL T,C
	POPJ P,

RELOCT:	PUSH P,T		;DON'T CLOBBER THE LEFT HALF OF T
	HRRZS T
	TRNN FF,INDEF		;GLOBAL RELOCATION?
	JRST RT1		;NO
	ADDI T,@RELADR
	JRST RT2
RT1:	CAIGE T,HIREL0
	ADD T,FACTOR		;LOW SEGMENT
	CAIL T,HIREL0
	ADD T,HIFACT		;HI SEGMENT
RT2:	HRRM T,(P)
	POP P,T
	POPJ P,

DOWN:	PUSH	P,A
	PUSHJ	P,PAIR		; GET A REF PAIR
	HRRZ	ZR,1(D)		; SAVE OLD REF
	MOVEM	A,1(D)		; CLOBBER IT
	MOVEM	ZR,(A)		; AND PATCH
	MOVEI	D,1(A)		; POINT D TO DESTINATION OF REF WRD
	JRST	POPAJ

;HERE TO CREATE NEW TABLE ENTRY
;A/	SQUOZE
;T/	VALUE

DEF1A:	PUSH	P,CDATABK
DEF2A:	PUSH	P,A		; SAVE SYMBOL
	PUSHJ	P,PAIR		; GET PAIR FOR REF CHAIN
	MOVEM	T,1(A)		; SAVE REF WORD
	MOVEI	T,(A)		; USE POINTER AS VALUE
	SKIPA	A,(P)
ENT:	PUSH	P,A
	PUSH	P,C
	TLZ	A,700000
	MOVEM	A,GLBFS
	PUSHJ	P,QUAD		; GET A QUADRAD FOR SYMBOL
	MOVE	D,A		; POINT WITH C
	MOVE	A,-1(P)		; RESTORE SYMBOL FOR HASHING
	MOVE	B,HTOP		; -LNTH OF TABLE
	SUB	B,HBOT
	TLZ	A,600000	; CLOBBER FLAGS
	IDIVI	A,(B)		; GET HASH
	ADD	B,HBOT	 	; POINT TO BUCKET
	HRRZ	C,(B)		; GET CONTENTS THEREOF
	HRROM	D,(B)		; PUT NEW ONE IN
	HRRM	C,BUCK(D)	; PUT OLD ONE IN
	HRLM	B,BUCK(D)	; POINT BACK TO TABLE
	SKIPE	C		; SKIP IF NO NEXT
	HRLM	D,BUCK(C)
	SKIPE	BOT
	HRLM	D,LIST(BOT)
	HRRZM	BOT,LIST(D)	; INTO LIST OF ALL SYMBOLS
	MOVEI	BOT,(D)		; AND RESET 
	MOVE	A,-1(P)
	MOVEM	A,(D)
	MOVEM	T,1(D)
	POP	P,C
	JRST	POPAJ

THRDR:	PUSHJ P,RPB
	TLNE T,100000
	PUSHJ P,RELOCT		;RELOCATE RIGHT HALF OF T
	HRLI T,100000
	JUMPGE D,USE1
	MOVE B,(D)
	TLNE B,200000
	JRST THRD2		;PREV DEFINED
	PUSHJ P,DOWN		;ENTER LINK REQUEST
	MOVEM T,(D)
	JRST DATABK

THRD2:	HRRZ B,T
	MOVE T,1(D)
	PUSHJ P,UNTHR
	JRST DATABK

LOCGLO:	JUMPGE T,LG2	;JUMP FOR NORMAL LOCAL TO GLOBAL RECOVERY

;HERE TO EXPUNGE OR RENAME LOCAL IN LOADER TABLE

	JUMPGE D,[		;NO SYMBOL THERE
		WARN [ASCIZ/bad format: symbol missing/]
		JRST DATABK]
	HRRZM D,T2		;TABLE ENTRY TO DELETE
	PUSHJ P,RPB			;SOAK UP ANOTHER WORD
	JUMPGE T,LG1		;JUMP TO RENAME LOCAL
	TLNN B,200000		;MAKE SURE THING IS DEFINED
	 JRST	[WARN [ASCIZ/bad format: symbol undefined/]
		JRST DATABK	;CANNOT HACK UNDEFINED SYMBOL
		]
	PUSHJ P,PATCH
	JRST DATABK

;HERE TO RENAME LOCAL IN LOADER TABLE

LG1:	PUSH P,(D)		;SQUOZE
	PUSH P,1(D)		;VALUE
	MOVSI B,200000		;MARK AS DEFINED SO THAT . . .
	IORM B,(D)		;PATCH WILL NOT HACK REFERENCES
	PUSHJ P,PATCH
	MOVE A,T		;NEW NAME
	POP P,T			;VALUE
	POP P,B			;OLD NAME
	TDZ B,[37777,,-1]	;CLEAR SQUOZE
	TLZ A,700000		;CLEAR FLAGS OF NEW NAME
	IOR A,B			;FOLD FLAGS, NEW NAME
	MOVEI B,DATABK		;ASSUME IT WILL BE LOCAL
	TLZE A,40000		;SEE IF WE MUST RECOVER TO GLOBAL
	MOVEI B,LG1A		;MUST RECOVER TO GLOBAL
	PUSH P,B		;RETURN ADDRESS
	JRST ENT		;ENTER IT
LG1A:	MOVE B,(D)		;SQUOZE AND FLAGS
	MOVE A,B		;SQUOZE WITH . . .
	TLZA A,740000		;FLAGS CLEARED

;HERE FOR NORMAL LOCAL TO GLOBAL RECOVERY

LG2:	JUMPGE D,DATABK	;LOCAL-GLOBAL RECOVERY
	MOVE T,D	;D POINTS TO LOCAL
	TLO A,40000	;GLOBAL
	PUSHJ P,LKUP1B	;FIND OCCURANCE OF GLOBAL
	IORM A,(T)	;SMASH OLD LOCAL OCCURENCE
	JUMPGE D,DATABK
	TLNN B,200000
	JRST DATABK
	MOVE B,1(D)	;ALREADY DEFINED
	MOVEM B,T1
	HRRZM D,T2
	ADDI D,2
	PUSHJ P,PATCH	;CLOBBER DEFINITION
	MOVE D,BOT
	PUSH P,CDATABK
	JRST PATCH7	;FILL IN OLD LOCAL REQ

LIBREQ:	JUMPL D,DATABK	;ALREADY THERE
	MOVEI T,0
	JRST USE1

REPT:	MOVEM T,TIMES
	JRST DATABK

COMMON:	ADD RH,COMLOC
	JRST COM1

DEFPT:	MOVEI T,@LKUP3
	TRO FF,GPARAM
	JRST DFSYM1

LDCND:	TRO FF,COND
	JRST LIB

LIB6:	CAIN A,12	;END OF CONDITIONAL
	JRST .OMIT1
	HRRZS T
	CAIN A,1
	CAIE T,5	;LOADER VALUE CONDITIONAL
	CAIN A,11	;COUNT MATCHING CONDITIONALS
	AOS FLSH
	JRST OMIT

LIB2:	TRNE FF,COND
	JRST LIB6
	CAIN A,5
	JRST LIB7
	PUSHJ P,RPB
	CAIN A,4	;PRGM NAME
	TLNN T,40000	;REAL END
	JRST OMIT
	JRST OMIT1	;LEAVE LIB SEARCH MODE

LIB1:	TRO FF,SEARCH
	PUSHJ P,RPB
	JUMPGE T,.-1
	TRZ FF,SEARCH
LIB4:	PUSHJ P,LKUP
	JUMPGE D,LIB3	;NOT ENTERED
	TRNE FF,COND
	JRST LIB5
	TLNE B,200000	;RQST NOT FILLED
LIB3:	TLC T,200000	;"AND NOT" BIT
LIB5:	TLNE T,200000
	JRST LIB1	;THIS ONE LOSES
LIB:	CLEARM FLSH
LIB7:	PUSHJ P,RPB
	JUMPGE T,LIB4
.OMIT1:	SOSGE FLSH
OMIT1:	TRZ FF,SEARCH+COND;END OF SEGMENT,LOAD THIS PROG
OMIT:	PUSH P,.

RPB:	SOSL TC
	JRST GTWD
	PUSHJ P,GTWD	;SOAK UP CKSUM
	AOJN CKS,RCKS

LOAD:	JRST (LL)	;READ SWITCH
LOAD2:	TRZE FF,ADRREL
	PUSHJ P,SETADR	;SAVE ADR FOR RELOCATION OF OTHER SEGEMT AT PRGEND
	PUSHJ P,GTWD
	AOS BLKCNT	;COUNT BLOCKS
	LDB A,[(220700)T]
	MOVEM A,TC
	MOVSI A,770000
	ANDCAM A,BITPTR
	LDB A,[(310700)T]
LOAD1:	MOVE P,SAVPDL
	JUMPLE T,OUT
	CAIL A,LOADTE-LOADTB
	JRST TPOK
	TRNE FF,SEARCH
	JRST LIB2
	TRZ FF,COND	;FUDGE FOR IMPROPER USE OF .LIBRA
	JRST @.+1(A)
LOADTB:	TPOK
	LDCMD	;LOADER COMMAND (1)
	ABS	;ABSOLUTE (2)
	REL	;RELOCATABLE (3)
	PRGN	;PROGRAM NAME (4)
	LIB	;LIBRARY (5)
	COMLOD	;COMMON LOADING (6)
	GPA	;GLOBAL PARAMETER ASSIGNMENT (7)
SYMSW:	DDSYMS	;LOCAL SYMBOLS (10)
	LDCND	;LOAD TIME CONDITIONAL (11)
SYMFLG:	SETZ OMIT	;END LDCND (12)
	HLFKIL	;HALF KILL A BLOCK OF SYMBOLS
	OMIT	;OMIT BLOCK GENERATED BY LIBRARY CREATOR
	OMIT	;LATER WILL BE .ENTRY
	AEXTER	;BLOCK OF STUFF FOR SDAT OR USDAT
	OMIT	;FOR .LIFND
	GLOBS	;GLOBAL SYMBOLS BLOCK TYPE 20
	FIXES	;FIXUPS BLOCK TYPE 21
	POLFIX	;POLISH FIXUPS BLOCK TYPE 22
	LINK	;LINK LIST HACK (23)
	OMIT	;LOAD FILE (24)
	OMIT	;LOAD LIBRARY (25)
	OMIT	;LVAR (26) OBSOLETE
	OMIT	;INDEX (27) NEW DEC STUFF
	OMIT	;HIGH SEG(30)
LOADTE:
	
OUT:	MOVE P,SAVPDL
	POPJ P,

;HERE TO PROCESS AN .EXTERN

AEXTER:	PUSHJ P,RPB	;READ AND LOOK UP SYMBOL
	TLO T,40000	;TURN ON GLOBAL BIT
	PUSHJ P,LKUP	;NOW LOOK IT UP
	JUMPGE D,AXTER1	;NEVER APPEARED, MUST ENTER
	TLNE B,200000	;SKIP IF NOT DEFINED
	JRST AEXTER	;THIS ONE EXISTS, GO AGAIN
AXTER1:	MOVE B,USDATP	;GET POINTER TO USDAT
	PUSH P,A	;SAVE SYMBOL
	TLZ A,740000	;KILL ALL FLAGS
	MOVE T,B	;SAVE A COPY OF THIS
	ADD T,[3,,3]	;ENOUGH ROOM?
	JUMPGE T,TMX	;NO, BARF AT THE LOSER
	MOVEM T,USDATP	;NOW SAVE
	PUSH P,D
	HRRZ D,B	; VIRTUAL ADDRESS
	PUSHJ P,MAPD	; REAL ADDRESS
	MOVEM A,(D)	; STORE INTO CORE IMAGE BEING BUILT
	POP P,D
	POP P,A		;RESTORE SYMBOL
	MOVEI T,1(B)	;ALSO COMPUTE 'VALUE' OF SYMBOL
	PUSHJ P,DEFSYM
	JRST AEXTER

;USDAT HAS OVERFLOWN

TMX:	FATAL [ASCIZ/Too Many External Symbols/]

GPA:	PUSHJ P,RPB
	MOVEM T,T2
	MOVEI T,0

LDCMD:	ADDI T,LDCMD2+1
	HRRM T,LDCMD2
	ROT T,4
	DPB T,[(330300)LDCVAL]
	MOVEM ADR,ADRM		;SAVE ADR AND RELOCATION
	HRLM FF,ADRM
	TRO FF,UNDEF+CODEF
	TRZ FF,ADRREL
	MOVEI B,@LKUP3
	MOVEM B,CPOINT+1
	MOVEI ADR,T1
	JSP LL,DATABK

LDCMD1:	TRZ FF,UNDEF+CODEF
	MOVE ADR,ADRM
	TLNE ADR,ADRREL		;ADRREL WAS SAVED IN LEFT HALF
	TRO FF,ADRREL
	HRRZS ADR
	CLEARB RH,AWORD
	MOVE D,T1
LDCMD2:	JRST @.
	GPA1
	JMP	;JUMP BLOCK (1)
	GLOBAL	;GLOBAL LOCATION ASSIGNMENT (2)
	COMSET	;COMMON ORIGIN (3)
	RESPNT	;RESET GLOBAL RELOCATION (4)
	LDCVAL	;LOADER VALUE CONDITIONAL (5)
	.OFFSET	;GLOBAL OFFSET (6)
	L.OP	;LOADER EXECUTE (7)
	.RESOF	;RESET GLOBAL OFFSET

JMP:	JUMPE D,JMP1
	TRNN FF,JBN
	TLO FF,NAME
	MOVEM D,SA
JMP1:	MOVEI LL,LOAD2
	JRST LOAD2

GLOBAL:	TRO FF,INDEF
	HRRM D,RELADR
	MOVE ADR,D
				;MOVEI D,RELADR
				;HRRM D,REL
	JRST JMP1

RESPNT:	TRZ FF,INDEF
				;MOVEI D,FACTOR
	HRRZ ADR,FACTOR
				;HRRM D,REL
	JRST JMP1

LDCVAL:	JUMP D,JMP1
	TRO FF,SEARCH+COND
	CLEARM FLSH
	JRST JMP1

.OFFSET:	HRRM D,LKUP3
	JRST JMP1

L.OP:	MOVE B,T1	;B=3 C=4 D=5
	MOVE 4,T1+1
	MOVE 5,T1+2
	TDNN B,[(757)777777]
IFN 0,[	JRST L.OP2
	HRRM ADR,ADRM
	HRRZ ADR,ADRPTR
	MOVEM 4,4(ADR)
	MOVEM 5,5(ADR)
	MOVEM B,20(ADR)
	HRLZI B,(.RETUUO)
	MOVEM B,21(ADR)
	MOVEM B,22(ADR)
	.XCTUUO NBLKS,
	MOVE 4,4(ADR)
	MOVE 5,5(ADR)
	HRRZ ADR,ADRM
	CAIA
L.OP2:]	IOR B,[0 4,5]
	XCT B
	MOVEM 4,.VAL1
	MOVEM 5,.VAL2
	JRST JMP1
.RESOF:	MOVEI	D,0
	JRST	.OFFSET

SETJNM:	MOVEI A,SJNM1
	HRRM A,SPTY
	SETZM A
	MOVE B,[(600)A-1]
	PUSHJ P,SPT
	MOVEM A,JOBNAM
	MOVEI A,TYO
	HRRM A,SPTY
	MOVE A,PRGNAM
	POPJ P,

SJNM1:	TRC T,40
DDT4:	IDPB T,B
	POPJ P,

GPA1:	MOVE T,T2
	PUSHJ P,LKUP
	MOVE T,T1
	MOVEI TT,100	;DON'T GENERATE MDG
	TRO FF,GPARAM
	PUSHJ P,DEFSYM
	JRST JMP1

DDLUP:
DDSYMS:	PUSHJ P,RPB
	LDB TT,[(410300)T]
	TLNE T,40000
	JRST DDLUP2
	TLZ T,240000
	TLO T,100000
DDLUP1:	MOVE	A,T
	PUSHJ P,RRELOC
	PUSHJ	P,ADDDDT
	JRST DDLUP

DDLUP2:	TLZ T,740000	;MARK AS BLOCK NAME
	JRST DDLUP1

;HERE TO HANDLE GLOBAL BLOCK -- BLOCK TYPE #20

GLOBS:	PUSHJ	P,GETBIT		;CODE BITS
	PUSHJ	P,RPB			;SQOOZE
	MOVEM	T,CGLOB
	PUSHJ	P,GETBIT		;CODE BITS
	PUSHJ	P,RRELOC		;VALUE
	MOVEM	T,CGLOBV
	MOVE	T,CGLOB
	TLO	T,40000			;GLOBAL FLAG
	PUSHJ	P,LKUP			;SYMBOL LKUP
	LDB	C,[400400,,CGLOB]	;FLAGS
	CAIN	C,60_-2
	JRST	GLOBRQ			;GLOBAL REQUEST

;HERE TO HANDLE SYMBOL TABLE FIX UPS OR GLOBAL DEFINITION

	TRNN	C,10_-2		;TEST FOR VALID FLAGS
	TRNN	C,4_-2		;FORMAT IS XX01
	 HALT
	LSH	C,-2		;SHIFT OUT GARBAGE
	JUMPE	C,GLBDEF	;FLAGS 04=> GLOBAL DEFINITION
	CAIN	C,40_-4		;*****JUST A GUESS
	JRST	GLBDEF		;*****JUST A GUESS

;DUMP A DEFERRED INTERNAL INTO LOADER TABLE

	JUMPL	D,GDFIT		;JUMP IF IN LOADER TABLE
	PUSHJ	P,PAIR		;GET VALUE PAIR
	MOVSI	T,DEFINT(C)
	HRR	T,A		;REFERENCE WORD POINTS TO PAIR
	MOVE	A,CGLOBV
	SETZM	(T)		;MARK AS VALUE
	MOVEM	A,1(T)		;SECOND WORD IS VALUE
GLOBS0:	MOVE	A,CGLOB		;SQUOOZE
	TLZ	A,300000	;FIX THE FLAGS
	TLO	A,440000
	PUSHJ	P,DEF2A		;PUT IT INTO LOADER TABLE
	JRST	GLOBS

;HERE FOR DEFERRED INTERNAL ALREADY IN TABLE

GDFIT:	TLNE	B,200000
	 HALT			;ALREADY DEFINED
	PUSHJ	P,GLOBS3		;RETURNS REFERENCE WORD IN A
	JUMPE	B,GDFIT1	;MUST ADD DEFERRED VALUE
	HLRZ	B,A
	CAIE	B,DEFINT(C)
	 HALT			;REFERENCE WORDS DON'T MATCH
	MOVE	B,CGLOBV
	CAME	B,1(A)
	 HALT			;VALUES DON'T MATCH
	JRST	GLOBS		;ALL'S WELL THAT ENDS WELL

GDFIT1:	PUSHJ	P,DOWN
	PUSHJ	P,PAIR
	MOVSI	T,DEFINT(C)
	HRR	T,A
	MOVEM	T,(D)
	SETZM	(T)		;MARK AS VALUE
	MOVE	A,CGLOBV
	MOVEM	A,1(T)		;VALUE
	JRST	GLOBS

;HERE TO HANDLE GLOBAL REQUEST -- FLAGS=60

GLOBRQ:	SKIPGE	T,CGLOBV	;SKIP IF THREADED LIST
	JRST	GLOBR1		;SINGLE WORD FIX UP MUST WORK HARDER

;SIMPLE REQUEST

	JUMPE	T,GLOBS		;IGNORE NULL REQUEST
	JUMPGE	D,GLOBNT	;JUMP IF SYMBOL NOT IN TABLE
	TLNE	B,200000	;TEST TO SEE IF DEFINED
	JRST	GLOBPD		;PREVIOUSLY DEFINED
	MOVE	C,CGLOBV
	HRLI	C,100000	;THIS IS A LINK LIST

;BEGIN CROCK
;AVOID DUPLICATE ENTRIES

;	HRRZ A,1(D)
;	JUMPE A,GLBRQ2
;GLBRQ1:	CAMN C,1(A)
;	JRST GLOBS
;	HRRZ A,(A)
;	JUMPN A,GLBRQ1
;GLBRQ2:
;END CROCK

	PUSHJ	P,DOWN		;NOT DEFINED, ENTER REQEST INTO TABLE
	MOVEM	C,(D)
	JRST	GLOBS

;HERE TO DEFINE GLOBAL SYMBOL, FLAGS=04

GLBDEF:	MOVE	T,CGLOBV	;VALUE
	MOVEI	TT,0		;REDEFINE NOT OKAY, SEE DEF2
	PUSHJ	P,DEFSYM	;SQUOOZE+FLAGS ALREADY IN B BECAUSE OF EARLIER LOOK UP
	JRST	GLOBS

; HERE IF GLOBAL DEFINED, UNTHREAD THE CHAIN

GLOBPD:	MOVE	T,1(D)		;VALUE
	MOVE	B,CGLOBV	;POINTER TO CHAIN
	PUSHJ	P,UNTHR
	JRST	GLOBS

; ENTER NEW SYMBOL WITH LINK REQUEST

GLOBNT:	MOVEI	C,44_-2		;PROPER FLAGS, GLOBAL AND THIS HERE SQUOZ
	DPB	C,[400400,,A]
	HRLI	T,100000	;SET LINK BIT IN REQUEST
	PUSHJ	P,DEF2A
	JRST	GLOBS

; SINGLE WORD FIX UP -- FLAGS=60

GLOBR1:	TLNE	T,100000	;TEST FOR SYMBOL TABLE FIX
	JRST	GLOBST		;SYMBOL TABLE FIX
	JUMPGE	D,GLOBR2	;JUMP IF NOT IN TABLE
	TLNN	B,200000
	JRST	GLOBR3		;NOT PREVIOUSLY DEFINED
	HRRZ	B,T		;FIX UP LOCATION
	PUSHJ	P,MAPB		;DO THE RIGHT THING IF B IN HIGH SEGMENT
	TLNE	T,200000	;LEFT OR RIGHT?
	JRST	HWAL		;LEFT 
HWAR:	HRRE	C,(B)		;HALF WORD ADD RIGHT
	ADD	C,1(D)
	HRRM	C,(B)
	JRST	GLOBS

HWAL:	HLRE	C,(B)		;HALF WORD ADD LEFT
	ADD	C,1(D)
	HRLM	C,(B)
	JRST	GLOBS

; HERE FOR SINGLE WORD FIX, SYMBOL UNDEFINED

GLOBR3:	PUSHJ	P,DOWN		;MAKE ROOM IN TABLE
	MOVE	C,T
	HRLI	T,40001		;ASSUME RIGHT HALF
	TLNE	C,200000	;RIGHT OR LEFT?
	HRLI	T,40002		;LEFT
	MOVEM	T,(D)
	JRST	GLOBS

;HERE TO MAPPING ON AC B SO THAT SECOND SEGMENT LOADING WORKS

MAPB:	PUSH	P,D
	HRRZ	D,B
	PUSHJ	P,MAPD
	HRR	B,D
	POP	P,D
	POPJ P,

; HERE FOR SINGLE WORD FIXUP, SYMBOL NOT IN TABLE

GLOBR2:	TLO	A,400000	;SYMBOL FLAG
	MOVE	C,T
	HRLI	T,1		;ASSUME RIGHT HALF FIX
	TLNE	C,200000	;LEFT OR RIGHT?
	HRLI	T,2		;LEFT
	PUSHJ	P,DEF2A
	JRST	GLOBS

; HERE FOR SYMBOL TABLE FIX

GLOBST:
;	MOVE	A,CGLOBV
;	TLZ	A,700000	;MAKE SURE WE ARE STILL FIXING SAME SYMBOL
;	CAME	A,GLBFS
;	 HALT			;DON'T AGREE
	JUMPGE	D,GLOBS5	;JUMP IF FIXUP NOT SEEN
	TLNN	B,200000
	JRST	GLOBS6		;FIXUP NOT EVEN DEFINED
	PUSH	P,1(D)		;SAVE POINTER TO OLD SYMBOL
	PUSH	P,T
	MOVE	T,CGLOBV
	PUSHJ	P,LKUP
	JUMPGE	D,GLST1
	TLNE	B,200000
	 HALT
	PUSHJ	P,GLOBS3		;FIND THE GLOBAL VALUE
	SKIPE	B
	SKIPN	(A)
	 HALT
	POP	P,T
	EXCH	B,(P)		;GET BACK VALUE OF FIXUP SYMBOL
	TLNE	T,200000	;LEFT OR RIGHT?
	JRST	GLOBS1		;LEFT
	HRRE	C,1(A)		;RIGHT
	ADD	C,B
	HRRM	C,1(A)
	TLZN	A,FIXRT		;DID WE REALLY WANT TO DO THIS
	 HALT			;NO
	JRST	GLOBS2		;YES

GLOBS1:	HLRE	C,1(A)		;LEFT HALF FIX
	ADD	C,B
	HRLM	C,1(A)
	TLZN	A,FIXLT		;DID WE REALLY WANT TO DO THIS
	 HALT			;NOPE

; HERE TO FINISH UP SYMBOL TABLE FIX

GLOBS2:	POP	P,B
	MOVEM	A,1(B)		;STORE BACK REFERENCE WORD
	TLNE	A,FIXLT+FIXRT	;DO WE HAVE MORE FIXING
	JRST	GLOBS		;NO
	MOVE	T,1(A)		;FIXED VALUE
	MOVEI	TT,100		;OKAY TO REDEFINE, TT USED AT DEF2
	PUSHJ	P,DEFSYM
	JRST	GLOBS

;HERE TO FIND POINTER TO VALUE OF DEFERRED INTERNAL

GLOBS3:	MOVE	B,1(D)		;FIRST REFERENCE WORD
GLOBS4:	SKIPGE	A,1(B)
	JRST	GLOBS8
GLOBS9:	HRRZ	B,(B)
	JUMPN	B,GLOBS4
	POPJ P,		;REFERENCE WORD NOT FOUND
GLOBS8:	SKIPGE	(A)
	JRST	GLOBS9		;DEFERED INTERNAL FOR ANOTHER SYMBOL
	POPJ P,

GLOBS5:	PUSHJ P,GLOBS7
	JRST GLOBS0

GLOBS6:	PUSHJ P,GLOBS7
	PUSHJ P,DOWN
	MOVEM T,(D)
CGLOBS:	JRST GLOBS

GLOBS7:	PUSHJ P,PAIR
	MOVE B,T
	TLZ T,700000
	MOVEM T,1(A)
	MOVSI T,DEFINT+FIXRT
	TLNE B,200000
	TLC T,FIXRT+FIXLT
	HRR T,A
	MOVSI B,400000
	MOVEM B,(T)	;MARK AS SQUOOZE
	MOVE B,CGLOBV
	MOVEM B,1(T)	;SQUOOZE
	POPJ P,

GLST1:	POP P,(P)	;VALUE TO ADD ON TOP OF STACK
	PUSH P,CGLOBS

;HERE TO FIX UP DIFFERED INTERNAL
;THAT MIGHT BE A LOCAL   CALL WITH STACK
;	-1(P)	VALUE TO ADD
;	  (P)	RETURN ADDRESS
;	   T	SQUOZE FOR FIXUP (20,XXX=>LEFT HALF FIX)

GLST2:	PUSH P,A
	PUSH P,T
	TLNE T,40000
	 HALT		;ITS GLOBAL, THERE'S NO HOPE
	MOVEI B,0	;BLOCK NAME
	MOVE C,T	;SYMBOL TO FIX
	TLZ C,740000
	PUSHJ P,FSYMT2
	 HALT		;CROCK
	MOVE B,1(T)	;VALUE TO FIX
	HLRZ C,B	;THE LEFT HALF
	POP P,A
	TLNN A,200000
	ADD B,-2(P)
	TLNE A,200000
	ADD C,-2(P)
	HRL B,C
	MOVEM B,1(T)
	POP P,A
	POP P,-1(P)
	POPJ P,

; HERE TO HANDLE FIXUPS -- BLOCK TYPE #21

FIXES:	SKIPE	LFTFIX
	JRST	FIXESL		;LEFT HALF FIXUP LEFT OVER FROM PREVIOUS BLOCK
	PUSHJ	P,GETBIT	;CODE BITS
	PUSHJ	P,RRELOC	;FIX UP WORD
	CAMN	T,[-1]		;SKIPS ON RIGHT HALF FIX
	JRST	FIXESL		;LEFT HALF FIX
	HLRZ	B,T		;C(T) = POINTER,,VALUE  C(B)=POINTER
	PUSHJ	P,UNTHR
	JRST	FIXES

FIXESL:	SETOM	LFTFIX		;IN CASE RRELOC GETS US OUT OF BLOCK
	PUSHJ	P,GETBIT
	PUSHJ	P,RRELOC
	SETZM	LFTFIX		;OFF TO THE RACES
	HLRZ	B,T
	PUSHJ	P,UNTHL
	JRST	FIXES

UNTHL:	PUSHJ	P,MAPB
	HLL	T,(B)	;CALL IS POINTER IN B
	HRLM	T,(B)	;        VALUE IN T
	HLRZ	B,T
	JUMPN	B,UNTHL
	POPJ P,

UNTHF:	PUSHJ	P,MAPB
	HRL	B,(B)
	MOVEM	T,(B)
	HLRZS	B
	JUMPN	B,UNTHF
	POPJ P,

;POLISH FIXUPS <BLOCK TYPE 22>

PDLOV:	SKIPE POLSW	;PDL OV ARE WE DOING POLISH?
	JRST COMPOL	;YES
	FATAL [ASCIZ/PDL Overflow/]
COMPOL:	FATAL [ASCIZ/Polish Too Complex/]
LOAD4A:	FATAL [ASCIZ/Illegal Block Format/]

;READ A HALF WORD AT A TIME

RDHLF:	TLON FF,HSW	;WHICH HALF
	JRST NORD
	PUSHJ P,RWORD	;GET A NEW ONE
	TLZ FF,HSW	;SET TO READ OTEHR HALF
	MOVEM T,SVHWD	;SAVE IT
	HLRZS T		;GET LEFT HALF
	POPJ P,		;AND RETURN
NORD:	HRRZ T,SVHWD	;GET RIGHT HALF
	POPJ P,		;AND RETURN

RWORD:	PUSH P,C
	PUSHJ P,GETBIT
	PUSHJ P,RRELOC
	POP P,C
	POPJ P,

;HERE TO ENTER POLISH TOKEN INTO GLOBAL TABLE
;	C/	TOKEN TYPE
;	T/	VALUE (IGNORED IF OPERATOR)

SYM3X2:	PUSH P,A
	PUSHJ P,PAIR	;GET TWO WORDS
	MOVEM T,1(A)	;VALUE
	EXCH T,POLPNT	;POINTER TO CHAIN
	MOVEM T,(A)	;INTO NEW NODE
	HRLM C,(A)	;TOKEN TYPE INTO LEFT HALF OF FIRST WORD
	EXCH T,A
	EXCH T,POLPNT	;RESTORE T, POINTER TO NEW NODE
	JRST POPAJ

;THIS ROUTINE SEARCHES TO SEE IF GLOBAL DEFINED (SKIPES IF UNDEFINED)
;CALL WITH SQUOOZE IN C AND RETURNS WITH POINTER IN A IF DEFINED

SDEF:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,T
	MOVE T,C
	PUSHJ P,LKUP
	SKIPGE D
	TLNN B,200000	;SKIP IF DEFINED
	AOS -5(P)	;INCREMENT ADDRESS
	MOVEM D,-4(P)	;SET POINTER IN A
	POP P,T
	POP P,D
	POP P,C
POPBAJ:	POP P,B
POPAJ:	POP P,A
	POPJ P,

;START READING THE POLISH

POLFIX:	MOVE D,PPDP	;SET UP THE POLISH PUSHDOWN LIST
	SETOM POLSW	;WE ARE DOING POLISH
	TLO FF,HSW	;FIX TO READ A WORD THE FIRST TIME
	SETOM GLBCNT	;NUMBER OF GLOBALS IN THIS FIXUP
	SETZM POLPNT	;NULL POINTER TO POLISH CHAIN
	MOVEI T,MXPLOP	;STORE OPERATOR
	
RPOL0:	PUSH D,T		;SAVE OPERATOR IN STACK
	MOVE B,DESTB-3(T)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM B,SVSAT		;ALSO SAVE IT
RPOL:	PUSHJ P,RDHLF		;GET A HALF WORD
	TRNE T,400000		;IS IT A STORE OP?
	JRST STOROP		;YES, DO IT
	CAIGE T,3		;0,1,2 ARE OPERANDS
	JRST OPND
	CAILE T,MXPLOP-1	;HIGHEST OPERATOR
	JRST LOAD4A		;ILL FORMAT
	JRST RPOL0		;BACK FOR MORE


;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
;GLOBAL REQUESTS

OPND:	MOVE A,T	;GET THE OPERAND TYPE HERE
	PUSHJ P,RDHLF	;THIS IS AT LEAST PART OF THE OPERAND
	MOVE C,T	;GET IT INTO C
	JUMPE A,HLFOP1	;0 IS HALF-WORD OPERAND
	PUSHJ P,RDHLF	;NEED FULL WORD, GET SECOND HALF
	HRL C,T		;GET HALF IN RIGHT PLACE
	MOVSS C		;WELL ALMOST RIGHT
	SOJE A,HLFOP1	;1 IS FULL WORD, 2 IS GLOBAL REQUEST

	LDB A,[400400,,C]
	TLNE C,40000	;CHECK FOR FUNNY LOCAL
	PUSHJ P,SQZCON	;CONVERT TO STINKING SQUOOZE
	DPB A,[400400,,C]
	PUSHJ P,SDEF	;SEE IF IT IS ALREADY DEFINED
	JRST OPND1	;YES, WE WIN
	AOSN GLBCNT	;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
	AOS HEADNM	;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
	PUSH P,C	;SAVE GLOBAL REQUESTS FOR LATER
	MOVEI T,0	;MARK AS SQUOOZE
	EXCH C,T
	PUSHJ P,SYM3X2	;INTO THE LOADER TABLE
	HRRZ C,POLPNT	;NEW "VALUE"
	SKIPA A,[400000];SET UP GLOBAL FLAG
HLFOP:	MOVEI A,0	;VALUE OPERAND FLAG
HLFOP1:	SOJL B,CSAT	;ENOUGH OPERANDS SEEN?
	PUSH D,C	;NO, SAVE VALUE(OR GLOBAL NAME)
	HRLI A,400000	;PUT IN A VALUE MARKER
	PUSH D,A	;TO THE STACK
	JRST RPOL	;GET MORE POLISH

;HERE TO CONVERT TO STINKING SQUOOZE, CAVEAT:  THE FLAG BITS ARE CLEARED

SQZCON:	TLZ C,740000
	JUMPE C,CPOPJ
SQZ1:	CAML C,[50*50*50*50*50]
	POPJ P,
	IMULI C,50
	JRST SQZ1

; HERE IF GLOBAL SYMBOL DEFINED AT POLISH BLOCK READ TIME

OPND1:	MOVE C,1(A)	;SYMBOL VALUE
	JRST HLFOP

;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR

CSAT:	HRRZS A		;KEEP ONLY THE GLOBAL-VALUE HALF
	SKIPN SVSAT	;IS IT UNARY
	JRST UNOP	;YES, NO NEED TO GET 2ND OPERAND
	HRL A,(D)	;GET GLOBAL VALUE MARKER FOR 2ND OP
	POP D,T
	POP D,T		;VALUE OR GLOBAL NAME
UNOP:	POP D,B		;OPERATOR
	JUMPN A,GLOB	;IF EITHER IS A GLOBAL HANDLE SPECIALLY
	XCT OPTAB-3(B)	;IF BOTH VALUES JUST XCT
	MOVE C,T	;GET THE CURRENT VALUE
SETSAT:	SKIPG B,(D)	;IS THERE A VALUE IN THE STACK
	MOVE B,-2(D)	;YES, THIS MUST BE THE OPERATOR
	MOVE B,DESTB-3(B)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM B,SVSAT	;SAVE IT HERE
	SKIPG (D)	;WAS THERE AN OPERAND
	SUBI B,1	;HAVE 1 OPERAND ALREADY
	JRST HLFOP1	;GO SEE WHAT WE SHOULD DO NOW

;HANDLE GLOBALS

GLOB:	TRNE A,-1	;IS IT IN RIGHT HALF
	JRST TLHG	;NO NEED TO SAVE THIS VALUE IF ITS GLOBAL
	PUSH P,T	;SAVE FOR A WHILE
	MOVE T,C	;THE VALUE
	MOVEI C,1	;MARK AS VALUE
	PUSHJ P,SYM3X2
	HRRZ C,POLPNT	;POINTER TO VALUE
	POP P,T		;RETRIEVE THE OTHER VALUE
TLHG:	SKIPE SVSAT	;WAS THIS A UNARY OPERATOR
	TLNE A,-1	;WAS THERE A GLOBAL IN LEFT HALF
	JRST GLSET
	PUSH P,C
	MOVEI C,1	;SEE ABOVE
	PUSHJ P,SYM3X2
	HRRZ T,POLPNT	;POINTER TO VALUE
	POP P,C

GLSET:	EXCH C,B	;OPERATOR INTO RIGHT AC
	SKIPE SVSAT	;SKIP ON UNARY OPERATOR
	HRL B,T		;SECOND,,FIRST
	MOVE T,B	;SET UP FOR CALL TO SYM3X2
	PUSHJ P,SYM3X2
	MOVEI A,400000	;SET UP AS A GLOBAL VALUE
	HRRZ C,POLPNT	;POINTER TO "VALUE"
	JRST SETSAT	;AND SET UP FOR NEXT OPERATOR

;FINALLY WE GET TO STORE THIS MESS

STOROP:	MOVE B,-2(D)	;THIS SHOULD BE THE FAKE OPERATOR
	CAIE B,MXPLOP	;IS IT
	JRST LOAD4A	;NO, ILL FORMAT
	HRRZ B,(D)	;GET THE VALUE TYPE
	JUMPN B,GLSTR	;AND TREAT GLOBALS SPECIAL
	MOVE A,T	;THE TYPE OF STORE OPERATOR
	CAIGE A,-3
	PUSHJ P,FSYMT	;SYMBOL TABLE FIXUP, MUST WORK HARDER
	PUSHJ P,RDHLF	;GET THE ADDRESS
	MOVE B,T	;SET UP FOR FIXUPS
	POP D,T		;GET THE VALUE
	POP D,T		;AFTER IGNORING THE FLAG
	PUSHJ P,@STRTAB+6(A)	;CALL THE CORRECT FIXUP ROUTINE

COMSTR:	SETZM POLSW	;ALL DONE WITH POLISH
	MOVE B,HEADNM
	CAILE B,477777
	JRST COMPOL	;TOO BIG, GIVE ERROR
	PUSHJ P,RWORD	;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
	JRST LOAD4A	;IF NOT, SOMETHING IS WRONG

GLSTR:	MOVE A,T
	CAIGE A,-3
	 HALT		;CL FSYMT	;SYMBOL TABLE FIXUP
	PUSHJ P,RDHLF	;GET THE STORE LOCATION
	SUB D,[2,,2]	;VALUE AND MARKER ON STACK MEANINGLESS
	MOVE C,A	;STORE OP
	PUSHJ P,SYM3X2	;STORE LOC ALREADY IN T
	AOS T,GLBCNT	;WE STARTED AT -1 REMEMBER?
	HRRZ C,HEADNM	;GET HEADER #
	TLO C,440000	;MARK FIXUP AS GLOBAL BEASTIE
	PUSHJ P,SYM3X2	;LAST OF POLISH FIXUP
	HRRZ T,POLPNT	;POINTER TO POLISH BODY
	MOVE A,C	;FIXUP NAME
	PUSHJ P,ENT
GLSTR1:	SOSGE GLBCNT	;MUST PUT GLOBAL REQUESTS IN TABLE
	JRST COMSTR	;AND FINISH
	POP P,T		;SQUOOZE
	PUSHJ P,LKUP
	MOVE A,HEADNM	;SETUP REQUEST WORD
	TLO A,POLREQ	;MARK AS POLISH REQUEST
	JUMPGE D,GLSTR2	;JUMP IF NOT SEEN
	PUSHJ P,DOWN
	MOVEM A,(D)
	JRST GLSTR1

GLSTR2:	EXCH A,T	;NOT PREVIOUSLY SEEN ENTER FULL REQUEST
	TLO A,400000	;MARK AS NEW TABLE ENTRY
	PUSHJ P,DEF2A
	JRST GLSTR1

STRTAB:	ALSYM	;-6 FULL SYMBOL TABLE FIXUP
	LFSYM	;-5 LEFT HALF SYMBOL FIX
	RHSYM	;-4 RIGHT HALF SYMBOL FIX
	UNTHF	;-3 FULL WORD FIXUP
	UNTHL	;-2 LEFT HALF WORD FIXUP
	UNTHR	;-1 RIGHT HALF WIRD FIXUP
	CPOPJ	;0

DESTB:	1	;+
	1	;-
	1	;*
	1	;/
	1	;AND
	1	;OR
	1	;LSH
	1	;XOR
	0	;NOT
	0	;-
	0	;JFFO
	1	;REM
	0	;ABSOLUTE VALUE
	100	;STORE OPERAND
MXPLOP==.-DESTB+3

OPTAB:	ADD T,C
	SUB T,C
	IMUL T,C
	IDIV T,C
	AND T,C
	IOR T,C
	LSH T,(C)
	XOR T,C
	SETCM T,C
	MOVN T,C
	PUSHJ P,JFFOP
	PUSHJ P,REMOP
	MOVM T,C
	HALT		;STORE OP
CHECK OPTAB,MXPLOP-3

JFFOP:	PUSH P,D
	JFFO C,.+2
	MOVEI D,44
	MOVE T,D
POPDJ:	POP P,D
	POPJ P,

REMOP:	IDIV T,C
	MOVE T,TT
	POPJ P,

;HERE TO LOOK UP LOCAL IN SYMBOL TABLE

FSYMT:	PUSHJ P,FSYMT1	;BLOCK NAME
	MOVE B,C	;SAVE SYMBOL
	PUSHJ P,FSYMT1	;SYMBOL NAME
	EXCH B,C	;BLOCK NAME IN B, SYMBOL NAME IN C
FSYMT2:	PUSH P,A	;SAVE IT
	MOVE T,DDPTR	;AOBJN POINTER TO LOCALS
SLCL:	MOVE A,(T)	;SQUOZE
	TLZN A,740000	;CLEAR FLAGS FOR COMPARE
	JRST SLCL3	;BLOCK NAME
	CAMN A,C	;IS THIS THE SYMBOL WE SEEK
	JRST SLCL1	;YES, WE MUST STILL VERIFY THE BLOCK
SLCL4:	ADD T,[1,,1]	;NO KEEP LOOKING
	AOBJN T,SLCL
	HALT		;SYMBOL NOT FOUND

SLCL1:	JUMPE B,POPAJ1	;SYMBOL IS IN THIS BLOCK
	PUSH P,T	;THIS POINTER POSSIBLY A WINNER
SLCL1A:	ADD T,[2,,2]	;NEXT SYMBOL
	CAIL T,0
	 HALT		;WE HAVE RUN OUT OF TABLE
	MOVE A,(T)	;SQUOZE
	TLNE A,740000	;SKIP ON BLOCK NAME
	JRST SLCL1A

; HERE WHEN WE FIND BLOCK NAME

	CAME A,B	;DOES THE BLOCK NAME MATCH
	JRST SLCL2	;NO KEEP LOOKING
	POP P,T		;WINNING SYMBOL TABLE ENTRY
POPAJ1:	POP P,A		;RESTORE A
	AOS (P)		;SKIP THE CL RDHLF THAT FOLLOWS THIS CALL
	POPJ P,

SLCL3:	JUMPN B,SLCL4
	 HALT		;SYMBOL SHOULD BE IN THIS BLOCK

SLCL2:	SUB P,[1,,1]	;FLUSH THE LOSING SYMBOL POINTER
	JRST SLCL

FSYMT1:	PUSHJ P,RDHLF
	HRL C,T
	PUSHJ P,RDHLF
	HRR C,T
	JRST SQZCON

;HERE TO SATISFY GLOBAL REQUEST FOR POLISH

POLSAT:	PUSH P,D		;POINTER TO CURRENTLY PROCESSED GLOBAL REQUEST
	HRRZ T,B		;LOOK UP POLISH TO BE FIXED
	TLO T,440000
	PUSHJ P,LKUP
	CAIL D,0
	 HALT			;CANNOT FIND POLISH
	MOVE T,CGLOB		;SQUOOZE (SET UP AT DFSYM2)
	MOVE B,1(D)		;COUNT
	MOVE B,(B)		;STORE OP
	MOVE B,(B)		;FIRST TOKEN
	PUSHJ P,FIXPOL
	MOVE B,1(D)
	SOSG 1(B)		;UPDATE UNDEFINED GLOBAL COUNT
	JRST PALSAT		;COUNTED OUT FINISH THIS FIXUP
POLRET:	MOVE A,CGLOB
	POP P,D
	JRST PATCH1

;HERE TO FIXUP A SINGLE GLOBAL REQUEST IN POLISH

FIXPOL:	HLRZ A,(B)	;TOKEN TYPE
	JUMPN A,FXP1	;JUMP IF NOT SQUOZE
	CAME T,1(B)
	JRST FXP1	;SQUOOZE DOES NOT MATCH
	HRRI A,1	;MARK AS VALUE
	MOVE T,T1	;VALUE
	HRLM A,(B)	;NEW TOKEN TYPE
	MOVEM T,1(B)	;NEW VALUE
	POPJ P,

FXP1:	HRRZ B,(B)	;POINTER TO NEXT TOKEN
	JUMPN B,FIXPOL
	HALT		;DID NOT FIND SYMBOL

;HERE TO FINISH THE POLISH AFTER ALL REQUESTS ARE SATISFIED

PALSAT:	AOS SATED		;NUMBER OF FIXUPS SATISFIED
	PUSH P,(D)		;SAVE THE NAME OF THIS FIXUP FOR LATER DELETION
	MOVE A,1(D)		;POINTS TO COUNT
	MOVE A,(A)		;STORE OP
	MOVE D,PPDP
	HLLZ B,(A)		;STORE OP
	HRRZ T,1(A)		;PLACE TO STORE
	PUSH D,B		;STORE OP
	PUSH D,T		;STORE ADDRESS
	MOVEI T,-1(D)		;POINTER TO STORE OP
	PUSH D,T
	MOVE A,(A)		;POINTS TO FIRST TOKEN

PSAT1:	HLRE B,(A)	;OPERATOR
	JUMPL B,ENDPOL	;FOUND STORE OP
	CAIGE B,MXPLOP
	CAIGE B,3
	 HALT		;NOT OPERATOR
	MOVE T,1(A)	;OPERANDS (SECOND,,FIRST)
	HLRZ C,(T)	;FIRST OPERAND
	CAIN C,0
	 HALT		;SQUOZE NEVER DEFINED
	CAIE C,1	;SKIP IF DEFINED
	JRST PSDOWN	;GO DOWN A LEVEL IN TREE
	SKIPN DESTB-3(B)
	JRST PSAT2	;IF UNARY OP WE ARE DONE
	MOVSS T
	HLRZ C,(T)	;SECOND OPERAND
	CAIN C,0
	 HALT
	CAIE C,1
	JRST PSDOWN
	MOVSS T

;HERE TO PERFORM OPERATION

PSAT2:	MOVE C,1(T)	;VALUE FIRST OPERAND
	MOVSS T
	SKIPE DESTB-3(B)
	MOVE T,1(T)	;GET SECOND OPERAND ONLY IF NECESSARY
	XCT OPTAB-3(B)	;WOW!
	MOVEM T,1(A)	;NEW VALUE
	MOVEI C,1
	HRLM C,(A)	;MARK AS VALUE
	POP D,A		;GO UP A LEVEL IN TREE
	JRST PSAT1

;HERE TO GO DOWN LEVEL IN TREE

PSDOWN:	PUSH D,A	;SAVE THE OLD NODE
	HRRZ A,T	;NEW NODE
	JRST PSAT1

;HERE TO END PROCESSING OF POLISH IN SYMBOL TABLE (VALUE IN T)

ENDPOL:	POP D,B		;STORE ADDRESS
	MOVS A,(D)	;STORE OP
	PUSHJ P,@STRTAB+6(A)
	POP P,D		;NAME OF THIS FIXUP
	EXCH P,SATPDP	;SAVE THIS NAME FOR LATER DELETION FROM TABLE
	PUSH P,D
	EXCH P,SATPDP
	JRST POLRET

; HERE TO DO SYMBOL TABLE FIXUPS
;	T/	VALUE
;	B/	SYMBOL TABLE POINTER

RHSYM:	HRRM T,1(B)	;RIGHT HALF FIX
	POPJ P,

LFSYM:	HRLM T,1(B)	;LEFT HALF FIX
	POPJ P,

ALSYM:	MOVEM T,1(B)	;FULL WORD FIX
	POPJ P,

;HERE TO REMOVE POLISH FIXUPS FROM SYMBOL TABLE

UNSATE:	PUSH P,T2
	MOVE A,[-SATPDL,,SATPDB-1]
	EXCH A,SATPDP	;SET UP PUSH DOWN POINTER
	MOVE B,SATED	;# FIXUPS TO BE DELETED
	SETZM SATED
	CAILE B,SATPDP	;LIST LONG ENOUGH?
	 HALT		;TIME TO REASSEMBLE
UNSAT1:	SOJL B,UNSAT3
	POP A,T		;FIXUP
	PUSH P,A
	PUSH P,B
	PUSHJ P,LKUP	;LOOK IT UP
	HRRZM D,T2
UNSAT2:	PUSHJ P,PATCH	;REMOVE IT FROM TABLE
	POP P,B
	POP P,A
	JRST UNSAT1

UNSAT3:	POP P,T2	;POINTS TO TABLE ENTRY
	MOVE T,T1	;SYMBOL VALUE
	MOVE A,CGLOB	;SQUOOZE
	POPJ P,

; HERE TO HANDLE LINKS (BLOCK TYPE 23)

LINK:	SETOM LINKDB	;LINKS BEING HACKED
	PUSHJ P,GETBIT	;RELOCATION BITS INTO TT
	PUSHJ P,RRELOC	;LINK #
	MOVE A,T
	JUMPE A,LOAD4A	;ILLEGAL LINK #
	PUSHJ P,GETBIT
	PUSHJ P,RRELOC	;STORE ADDRESS
	HRRZ B,T
	JUMPL A,LNKEND	;JUMP ON LINK END
	CAILE A,MNLNKS
	JRST LOAD4A	;ILLEGAL LINK #

	HRRZ C,LINKDB(A)	;LINK VALUE
	PUSH P,B
	PUSHJ P,MAPB
	HRRM C,(B)		;VALUE INTO STORE ADDRESS
	POP P,B
	HRRM B,LINKDB(A)	;NEW VALUE
	JRST LINK

;END LINK

LNKEND:	MOVNS A			;LINK #
	CAILE A,MNLNKS
	JRST LOAD4A		;ILLEGAL LINK #
	HRLM B,LINKDB(A)	;LINK END ADDRESS
	JRST LINK

;HERE AFTER ALL LOADING TO CLEAN UP LINKS

LNKFIN:	PUSH P,A
	PUSH P,B
	MOVEI A,MNLNKS

LNKF1:	MOVS B,LINKDB(A)	;VALUE,,STORE ADDRESS
	TRNN B,-1		;DON'T STORE FOR ZERO STORE ADDRESS
	JRST LNKF1A
	PUSHJ P,MAPB
	HLRM B,(B)
LNKF1A:	SOJG A,LNKF1
	JRST POPBAJ

;HERE TO HALF KILL LOCAL SYMBOLS DEFINED BY LOADER

HLFKIL:	MOVE D,DDPTR	;RESTORE POINTER TO LOCAL TABLE
	ADD D,[2,,2]	;BUMP IT
NXTKIL:	MOVE B,D	;PUT POINTER ALSO IN B
	PUSHJ P,RPB	;GET A WORD
	TLZ T,740000	;MAKE SURE NO FLAGS
NXTSYK:	MOVE A,(B)	;GET A SYMBOL
	TLZN A,740000	;IF PROG NAME HIT, TIME TO QUIT
	JRST NXTKIL
	CAME T,A	;IS THIS ONE
	JRST NOKIL	;NO TRY AGAIN
	TLO A,400000	;TURN ON HALF KILL BIT IN DDT
	IORM A,(B)	;RESTORE SYMBOL TO TABLE
	JRST NXTKIL

NOKIL:	AOBJN B,.+1
	AOBJN B,NXTSYK	;TRY ANOTHER
	JRST NXTKIL	;TRY ANOTHER ONE

PRGN:	PUSHJ P,RPB
	MOVE A,T
	MOVEM A,PRGNAM
	TLZE FF,NAME
	PUSHJ P,SETJNM
	MOVE T,FACTOR
	HRL T,ADR
	PUSHJ P,SETADR		;SAVE THIS ADR IN CASE WE RESET RELOCATION CONSTANT
	TLNE A,40000
	PUSHJ P,PRGEND		;REAL PRGM END
	TLO A,740000
	PUSHJ P,ENT
	PUSHJ P,SYMS
	MOVE	A,(BOT)		; GET CURRENT PRG NAME
	MOVSI	T,1		; WANT NON-ZERO, BUT POSITIVE LEFT HALF
	TLZ	A,740000	; MARK AS PROGNAME
	SKIPL	SYMSW
	PUSHJ	P,ADDDDT	; TO DDT TABLE
	SKIPL SYMSW
	PUSHJ P,SHUFLE	;PUT THE SYMBOLS IN THE RIGHT ORDER
	HLLZS LKUP3
	PUSHJ P,RESET
	JRST OMIT

PRGEND:	PUSH P,A
	MOVE A,HIADR
	SUBI A,HIREL0
	MOVEM A,HIFACT
	MOVE A,LOWADR
	MOVEM A,FACTOR
	SETZM LFTFIX
	HRRZ	A,DPTR		; LOW SEGMENT OFFSET
	ADD	A,LOWADR	; LAST WORD OF LOW SEGMENT IN STINK
	CAMGE	A,HIORG		; OVERLAP WITH HIGH SEGMENT?
	JRST	PE1		; NO
	HRRZ	ADR,LOWADR	; FOR ERROR MESSAGE
	FATADR	[ASCIZ/Low Segment Full/]
PE1:	MOVE	A,LOWADR	; LOW SEGMENT MAY END WITH BLOCKS
	CAMG	A,MEMTOP
	JRST	POPAJ
	PUSHJ	P,GETMEM
	JRST	PE1

SETADR:	HRRZS ADR		;THIS ROUTINE SAVES ADR SO THAT RELOCATION FACTORS WIN
	CAMGE ADR,HIORG
	MOVEM ADR,LOWADR
	CAML ADR,HIORG
	MOVEM ADR,HIADR
	POPJ P,

;WE DO ALL OF THE FOLLOWING HACKING TO INSURE THAT THE
;THE SYMBOLS ARE GIVEN TO DDT IN EXACTLY THE SAME ORDER
;THAT STINK READ THEM

SHUFLE:	MOVE	B,DDPTR
	ADD B,[2,,2]	;IGNORE THIS PROGRAM NAME
	JUMPGE B,CPOPJ	;NO LOCALS IN DDT'S TABLE

SHUF1:	MOVE A,(B)	;SQUOOZE
	TLNN A,740000
	JRST SHUF2	;FOUND A BLOCK NAME
SHUF3:	ADD B,[1,,1]
	AOBJN B,SHUF1

SHUF4:	HRRZ A,DDPTR	;EXTENT OF THE SYMBOLS IS KNOWN
			;A/POINTER TO BOTTOM SYMBOLS
			;B/POINTER TO TOP OF SYMBOLS
SHUF5:	ADDI A,2	;SYMBOL AT BOTTOM
	HRRZI B,-2(B)	;SYMBOL AT TOP
	CAMG B,A
	POPJ P,		;WE HAVE MET THE ENEMY AND THEY IS US!

	MOVE C,(A)	;SWAP THESE TWO ENTRIES
	EXCH C,(B)
	MOVEM C,(A)

	MOVE C,1(A)	;VALUE
	EXCH C,1(B)
	MOVEM C,1(A)
	JRST SHUF5

;HERE WHEN WE FIND A BLOCK NAME

SHUF2:	MOVE A,1(B)	;VALUE
	TLNE A,-1	;PROGRAM NAME?
	JRST SHUF4	;YES
	JRST SHUF3	;IGNORE BLOCK NAME

GTWD:	PUSHJ P,RDWRD	;GOBBLE A WORD FROM THE BUFFER
	JFCL 4,.+1
	ADD CKS,T
	JFCL 4,[AOJA CKS,.+1]
RELADR:	POPJ P,

GETBIT:	ILDB TT,BITPTR
	SKIPL BITPTR
	POPJ P,
	EXCH T,BITS
	SOS BITPTR
	PUSHJ P,RPB
	EXCH T,BITS
	LDB TT,BITPTR
	POPJ P,

;SUBROUTINE TO GET A WORD FROM BUFFER (GETS NEW ONE IF NEC.)

RDWRD:	PUSH P,TT	;SAVE TT
	MOVE TT,INPTR	;GOBBLE POINTER
	MOVE T,(TT)	;GOBBLE DATUM
	AOBJN TT,RDRET	;BUFFER EMPTY?
DOREAD:	MOVE TT,[-STNBLN,,STNBUF]	;YES, READ A NEW ONE
	.IOT TPCHN,TT	;GOBBLE IT
	MOVE TT,[-STNBLN,,STNBUF]	;RE GOOBBLE
RDRET:	MOVEM TT,INPTR	;SAVE IT
	POP P,TT
	POPJ P,

;HERE TO START FIRST READ

OPNPTR:	OPEN TPCHN,6
	PUSHJ P,FNF
RDFRST:	PUSH P,TT
	SETOM BLKCNT
	JRST DOREAD	;READ A NEW BUFFER

RCKS:	FATAL [ASCIZ/Checksum Error/]

;LOADER INTERFACE

;UUO HANDLER EFFECTIVE ADDRESS OF UUO IS ASCIZ ERROR MESSAGE
;IF 4.3 IS ZERO THEN ERROR IS FATAL AND LOADER IS RESTARTED
;UUO'S ARE DECODED AS FOLLOWS (ONLY 4.1-4.3 ARE RELEVANT)
;	7 (-1)	NO SYMBOL OR VALUE IS TYPED
;	6 (-2)	TYPE ADR IN OCTAL
;	5 (-3)	TYPE SQUOZE IN A AND ADR

TYPR:	0
	PUSH P,C
	PUSH P,T
	PUSH P,TT
	LDB C,[330300,,40]	;PICKUP LOW ORDER 3 BITS OF UUO CODE
	MOVEI TT,RESTRT
	TRON C,4
	HRRM TT,TYPR		;FATAL ERROR CLOBBER RETURN
	ORCMI C,7		;MAKE IT A SMALL NEGATIVE NUMBER
	HRRZ TT,40		;PICK UP ERROR MESSAGE
	PUSHJ P,TYOS		;PRINT MESSAGE
	AOJE C,TYPR1		;PRINT SQUOZE AND VALUE?
	PUSHJ P,SPC		;YES
	HRRZ T,ADR
	PUSHJ P,OCTPR		;PRINT OCTAL
	AOJE C,TYPR1
	PUSHJ P,SPC
	PUSHJ P,ASPT		;AND SYMBOL
TYPR1:	PUSHJ P,CRL		;GOOD BYE
	POP P,TT
	POP P,T
	POP P,C
	JRST 2,@TYPR

ASPT:	MOVE T,A
SPT:	TLNN T,40000
	TRO FF,LOCF
SPT2:	TLZ T,740000
SPT1:	IDIVI T,50
	HRLM TT,(P)
	JUMPE T,SPT3
	PUSHJ P,SPT1
SPT3:	TRZE FF,LOCF
	PUSH P,["*-"0+1,,.+1]
	HLRE T,(P)
	ADDI T,"0-1
	CAILE T,"9
	ADDI T,"A-"9-1
	CAILE T,"Z
	SUBI T,"Z-"#+1
	CAIN T,"#
	MOVEI T,".
	CAIN T,"/
SPC:	MOVEI T,40
SPTY:	JRST TYO

;SQUOZE CHARACTER CODES
;0    1-12 13-44 45 46 47
;NULL 0-9   A-Z  .  $  %

;HERE TO BUFFER TTY INPUT

FILBUF:	PUSH P,A			;CAN'T CLOBBER A
FILB0:	SETZM CCNT
	MOVE A,[10700,,CBUF-1]
	MOVEM A,CPTR
	PUSHJ P,CRLS				;PROMPT
	TRZ FF,LOCF
FILB1:	TRZ FF,ALTF
FILB2:	PUSHJ P,TYI
	CAIN T,7
	JRST FILB0			;BELL, RESET
	CAIN T,177			;RUBOUT
	JRST RUBOUT 
	IDPB T,A
	AOS CCNT			;CHARACTER COUNT
	CAMN A,[10700,,CBUF+CBUFL]
	JRST BUFFUL			;BUFFER FULL
	CAIE T,ALTMOD
	JRST FILB1
	TRON FF,ALTF
	JRST FILB2
	PUSHJ P,CRL			;GIVE HIM CR AFTER TWO ALTS
	JRST POPAJ

BUFFUL:	MOVEI T,^G			;BUFFER FULL, DING TTY AND RUBOUT LAST CHARACTER
	PUSHJ P,TYO
RUBOUT:	LDB T,A				;THE CHARACTER TO RUBOUT
	PUSHJ P,DECBP			;DECREMENT BYTE POINTER
	SKIPGE CCNT
	JRST FILB0			;CCNT WENT NEGATIVE
	TRNN FF,GETTY
	JRST [	.IOT TYOC,T
		JRST FILB1]
	CAIE T,15			;CARRIAGE RETURNS ARE A PAIN!!!
	JRST [	.IOT TYOC,[^P]		;BACK UP CURSOR
		.IOT TYOC,["X]
		JRST FILB1]
	PUSH P,CCNT
	PUSH P,A
	.IOT TYOC,[^P]
	.IOT TYOC,["U]			;MOVE TO BEGINNING OF PREVIOUS LINE
RUBCR:	PUSHJ P,DECBP			;DECREMENT BYTE POINTER
	LDB T,A				;THE PRECEEDING CHARACTER
	SKIPGE CCNT			;AT BEGINNING OF BUFFER?
	JRST RUBCR1
	.IOT TYOC,[^P]
	.IOT TYOC,["F]			;MOVE FORWARD ONE
	CAIE T,15			;END OF LINE?
	JRST RUBCR
RUBCR1:	POP P,A
	POP P,CCNT
	JRST FILB1

DECBP:	SOS CCNT
	ADD A,[70000,,0]		;DECREMENT BYTE POINTER AND ECHO
	SKIPGE A
	SUB A,[430000,,1]
	POPJ P,

TYI:	.IOT TYIC,T
	CAIN T,12
	MOVEI T,15			;NO LINE FEEDS IN BUFFER
	CAIN T,15
	JRST TYO
	CAIE T,^L
	POPJ P,
	PUSH P,CCNT			;FORM FEED RETYPES BUFFER
	PUSH P,A
	MOVE A,[440700,,CBUF]
	TRNE FF,GETTY
	PUSHJ P,FORMF			;CLEAR DISPLAY SCREEN
	PUSHJ P,CRL
TYI1:	SOSGE CCNT
	JRST [	POP P,A
		POP P,CCNT
		JRST TYI]
	ILDB T,A
	PUSHJ P,TYO
	TRNN FF,GETTY
	JRST TYI1			;DON'T WORRY ABOUT ^P IF NOT DISPLAY
	CAIN T,^P			;^P IS CONTROL CODE
	PUSHJ P,TYO			;WHICH QUOTES ITSELF
	JRST TYI1

LIS:	ANDI FF,GETTY
	SKIPA			;DON'T CLOBBER DDT STYLE COMMANDS
RESTRT:	SETZM CCNT		;FLUSH STALE TYPE IN
	MOVE P,[-LPDL,,PDL-1]	;RESTART AFTER VARIOUS ERRORS
RESTR1:	SOSL UDEPTH
	JRST [	.IOPOP TYIC,	;UNWIND THE IO PDL
		JRST RESTR1]
	SETZM UDEPTH		;FOR SAFETY SACK
CD:	MOVEI D,0
CD3:	TRZ FF,ARG

;THE MAIN READ LOOP

CD2:	PUSHJ P,GETCC
	CAIL T,"0
	CAILE T,"9
	JRST CD1
	LSH D,3			;ACCUMULATE NUMERIC ARGS
	ADDI D,-"0(T)
VALRET:	TRO FF,ARG
	JRST CD2

CD1:	CAIN T,ALTMOD		;STRAY ALTMODE?
	JRST RESTRT
	CAIL T,"<		;LEGAL COMMAND?
	CAILE T,"[
	JRST CD			;NO, FORGIVE AND FORGET
	SUBI T,"<
	IDIVI T,2
	HLRZ A,DTB(T)
	CAIE TT,0		;GET ADDRESS OF ROUTINE INTO A
	HRRZ A,DTB(T)
	MOVE T,A
	CAIE	A,DUMPY		;IS IT A DUMP
	TRZ FF,MLAST+SETDEV	;NO, KILL FUNNY FLAGS
	CAIE	A,HASHS		; HASH SET?
	PUSHJ	P,HASHS1		; MAYBE DO IT
	PUSHJ P,(T)			;DISPATCH TO ACTION ROUTINE
	JRST CD
	JRST VALRET

DEFINE FOUR A,B,C,D
	A,,B ? C,,D
TERMIN

DTB:	FOUR LBRAK,EQLS,ERR,MLIS,	;< = > ?
	FOUR GETCOM,SHIORG,BEG,COMSET,	;@ A B C
	FOUR DDT,NTS,NTS,GOCOM,		;D E F G
	FOUR HASHS,ERR,JOB,KILL,	;H I J K
	FOUR LOADG,MCOM,LOADN,SOFSET,	;L M N O
	FOUR PAPER,COMVAL,SFACT,SLIS,	;P Q R S
	FOUR CPOPJ,ERR,ERR,WASH,	;T U V W
	FOUR SADR,DUMPY,ZERO,EXAM,	;X Y Z [

SLIS:	TDZA C,C
MLIS:	MOVEI C,2
	TRNE FF,ARG
	JUMPL D,LISTER
	MOVE D,BOT

LISTER:	MOVE A,(D)
	TLZ A,740000
	CAMGE A,[50*50*50*50*50]
	JRST LIST6		; IGNORE POLISH FIXUPS
	MOVE A,(D)
	LDB TT,[(410300)A]
	ORCMI	TT,7		; -1 -> PROGNAME, -2 DEFINED , -4 UNDEFINED
	AOJN	TT,LIST2	; NOT PROG NAME
LIST4:	MOVEM	D,CPROTE
	SKIPN	C
	PUSHJ	P,ASPT
LIST5:	SKIPN	C
	PUSHJ	P,VALPT
	JRST	LIST6

LIST2:	XOR	TT,C		; TT/ -1 IF S AND DEF, OR ? AND UNDEF
	AOJE	TT,LIST7	; PRINT VALUES
LIST6:	HRRZ	D,LIST(D)	; NEXT SYMBOL
	JUMPN	D,LISTER	; MORE, GO ON
	JRST	CRL		; DONE

LIST7:	SKIPN	C
	JRST	LIST10
	SKIPN	CPROTE
	JRST	LIST10
	EXCH	D,CPROTE
	MOVE	A,(D)
	PUSHJ	P,ASPT
	PUSHJ	P,VALPT
	EXCH	D,CPROTE
	SETZM	CPROTE
	MOVE	A,(D)

LIST10:	PUSHJ	P,SPC		; PRINT UNDEFINED SYMBOL
	PUSHJ	P,ASPT		; PRINT SYMBOL
	PUSH	P,D
	TRNE	FF,ARG		; SKIP IF 1?
	JUMPN	C,LIST9		; JUMP IF ?
	PUSHJ	P,VALPT
	JRST	LIST8
LIST9:	MOVE	D,1(D)		; POINT TO CHAIN
	PUSHJ	P,VALPT
	HRRZ	D,(D)
	JUMPN	D,.-2
LIST8:	POP	P,D
	JRST	LIST6

VALPT:	PUSHJ	P,TAB
	HRRZ	T,1(D)		; SMALL VAL
	TRNN	FF,ARG		; ARG GIVEN?
	SKIPN	C		; OR SS COMM
	MOVE	T,1(D)		; USE FULL WORD
	JRST	OPTCR		; PRINT

WASH:	SETOM PURE	;MAKE HIGH SEG PURE
	POPJ P,

;WASH PURIFIES THE HIGH SEGMENT

DOWASH:	SKIPG	A,HIBLK
	POPJ P,		; DON'T BOTHER IF NO HIGH SEG BLOCKS
	HRRZ	B,HIORG
	LSH	B,-10.
	MOVE	0,B
	LSH	0,9.
	IOR	B,0
	IORI	B,400000
WASH1:	.CBLK	B,
	FATAL	[ASCIZ/Purification Failure/]
	ADDI	B,1001
	SOJG	A,WASH1
	POPJ P,

; INITIALIZES ALL AREAS OF CORE

HASHS:	MOVE	A,D		; SIZE TO A
	TRNN	FF,ARG		; SKI IF ARG GIVEN
HASHS1:	MOVEI	A,INHASH	; USE INITIAL
	SKIPE	HBOT		; SKIP IF NOT DONE
	POPJ P,
	PUSH	P,A		; NOW SAVEE IT
	PUSH	P,T
	PUSH	P,B

	MOVEI	B,LOSYM	; CURRENT TOP
	ADDI	A,LOSYM
	CAIG	A,<INITCR*2000>	; MORE CORE NEEDED?
	JRST	HASHS3		; NO, OK
	SUBI	A,<INITCR*2000>+1777
	ASH	A,-10.
HASHS2:	PUSHJ	P,CORRUP		; UP THE CORE
	SOJN	A,.-1		; FOR ALL BLOCKS

HASHS3:	MOVEM	B,HBOT		; STORE AS BOTTOM OF HASH TABLE
	ADD	B,-2(P)		; ADD LENGTH
	MOVEM	B,HTOP		; INTOTOP

	ADDI	B,1		; BUMP
	MOVEM	B,PARBOT	; SAVE AS BOTTOM OF LOADER TABLE AREA
	MOVEM	B,PARCUR	; ALSO AS  CURRENT PLACE

	MOVE	B,LOBLKS	; CURRENT TOP OF CORE
	PUSHJ	P,CORRUP
	ASH	B,10.		; WORDS
	SUBI	B,1
	MOVEM	B,PARTOP
	ADDI	B,1		; NOW DDT TABLE
	MOVEM	B,DDBOT
	ADDI	B,1777
	MOVEM	B,DDPTR
	MOVEM	B,DDTOP		; TOP OF DDT TABLE
	ADDI	B,1
	HRRM	B,ADRPTR	; INTO CORE SLOTS
	HRRM	B,BPTR
	HRRM	B,DPTR

	PUSHJ	P,CORRUP	; INITIAL CCORE BLOCK

	PUSHJ	P,GETMEM

; SET UP INIT SYMBOLS

	MOVE	C,[EISYM-EISYME,,EISYM]

SYMINT:	MOVE	A,(C)
	TLZ	A,600000
	MOVE	B,HTOP
	SUB	B,HBOT
	IDIVI	A,(B)		; HASH IT
	ADD	B,HBOT
	HRRZ	A,(B)		; GET CONTENTS
	HRROM	C,(B)
	HRRM	A,BUCK(C)
	HRLM	B,BUCK(C)
	SKIPE	A
	HRLM	C,(A)
	ADD	C,[3,,3]
	JUMPL	C,SYMINT

	POP	P,B
	POP	P,T
	POP	P,A
	POPJ P,

CORRUP:	PUSHJ P,GETCOR
	PUSHJ	P,SCE
	SKIPE	KEEP
	PUSHJ	P,WINP		; WE HAVE THE CORE, TELL LOSER
	AOS	NBLKS
	AOS	LOBLKS
CCRL:	POPJ P,	CRL

TMSERR:	JRST	SCE

EQLS:	MOVE T,D
OPTCR:	PUSH P,CCRL
OCTPR:	MOVEI TT,10
	HRRM TT,OPT1
OPT2:	LSHC T,-43
	LSH TT,-1
OPT1:	DIVI T,10
	HRLM TT,(P)
	JUMPE T,.+2
	PUSHJ P,OPT2
	HLRZ T,(P)
	ADDI T,260
TYOM:	JRST TYO

TYOS:	PUSH P,T
	HRLI TT,440700
TYOS1:	ILDB T,TT
	CAIN T,0
	JRST TYOS2
	PUSHJ P,TYO
	JRST TYOS1
TYOS2:	POP P,T
	POPJ P,

TAB:	PUSHJ P,SPC
	.IOT TYOC,T
	JRST TYO

CRLS:	TRNE FF,GETTY
	PUSH P,[CRLS1]
CRL:	MOVEI T,15
	.IOT TYOC,T
CRT:	SKIPA T,C.12
FORMF1:	MOVEI T,"C
TYO:	ANDI T,177	;YET ANOTHER INCOMPATIBLE CHANGES TO ITS BY RMS
	.IOT TYOC,T
C.12:	POPJ P,	12

CRLS1:	MOVEI T,"*
	JRST TYO

FORMF:	MOVEI T,^P
	PUSHJ P,TYO
	JRST FORMF1

;	THIS CALLED BEFORE DUMPING OR RETURNING TO DDT

TDDT:	SKIPE LINKDB	;TEST FOR LINK HACKAGE
	PUSHJ P,LNKFIN	;CLEAN UP LINKS
	PUSH P,[TDDTEX]	;MAKE SURE 1ST SYM IS A PROGRAM NAME, FOR DDT'S SAKE.
	HRRZ D,BOT
	TRO FF,GLOSYM

SYMS:	JUMPE	D,SYMS5		; DONE, QUIT
	MOVE	A,(D)		; GET SYMBOL
	TLNN	A,200000	; SKIP IF DEFINED
	JRST	SYMS6
	TLNE	A,40000		; SKIP IF LOCAL
	TRNE	FF,GLOSYM	; SKIP IF GLOBALS NOT ACCEPTABLE
	TLNE	A,100000	; HERE IF LOCAL OR WINNING GLOBAL, SKIP IF NOT PROG NAME
	JRST	SYMS6		; LOSER, OMIT
	TRNN	FF,GLOSYM	; SKIP IF GLOBAL
	SKIPL	SYMSW		; SKIP IF NO LOCALS
	JRST	SYMS3		; WINNER!!!, MOVE IT OUT

SYMS8:	HRRZ	A,LIST(D)	; POINT TO NEXT
	PUSH	P,A		; AND SAVE
	MOVEM	D,T2		; SAVE FOR PATCH
	PUSHJ	P,PATCH		; FLUSH FROM TABLE
	POP	P,D		; POINT TO NEXT
	JRST	SYMS

SYMS6:	HRRZ	D,LIST(D)	; POINT TO NEXT SYMBOL
	JRST	SYMS		; AND CONTINUE

SYMS3:	TRZ FF,NOTNUM	;ASSUME ALL NUMERIC
	TLZ A,740000
	MOVE T,A	;SEE IF IT IS A FUNNY SYMBOL
	IDIVI T,50	;GET LAST CHAR IN TT
	JUMPE TT,OKSYM
DIVSYM:	CAIG TT,12	;IS THE SYMBOL > 9
	CAIGE TT,1	;AND LESS THAN OR EQUAL TO 0
	TRO FF,NOTNUM	;NO, SAY NOT A NUMBER
	IDIVI T,50	;CHECK NEXT
	JUMPE TT,SYMS8	;NULL IN THE MIDDLE LOSES
	JUMPN T,DIVSYM	;DIVIDE UNTIL T IS 0
	CAIN TT,21	;IS THIS A "G"
	TRNE FF,NOTNUM	;YES, SKIP IF SYMBOL OF FORM "GXXXXX" X IS A DIGGIT
	JRST  OKSYM	;WIN
	JRST SYMS8	;LOSE
OKSYM:	MOVE T,1(D)
	HRRZ	C,LIST(D)	; POINT TO NEXT
	PUSH	P,C
	MOVEM	D,T2
	PUSHJ	P,PATCH		; FLUSH IT
	POP	P,D
	TLO A,40000
	TRNN FF,GLOSYM
	TLC A,140000	;DDT LOCAL
	TLNN A,37777	;IF SQUOZE "NAME" < 1000000,
	PUSHJ P,ADDDD2	;TREAT SPECIALLY (IT IS MIDAS'S SYMTAB IDX)
	TLNE A,37777
	PUSHJ	P,ADDDDT
	JRST SYMS

SYMS5:	POPJ P,

GOCOM:	TRNE FF,ARG
	MOVEM D,SA
	TRO FF,GOF
	JRST DDT

MAPD:			; MAP VIRTUAL LOC IN D TO REAL LOC
	CAMGE D,MEMTOP	; MUST BE IN HIGH SEGMENT
	JRST MD1	; IS IN LOW SEGMENT
	CAML D,HIORG	; SKIP IF NOT IN HIGH SEGMENT
	CAMLE D,HIGTOP	; SKIP IF IN HIGH SEGMENT
	FATAL [ASCIZ/Non-existent Memory/]
	POPJ P,
MD1:	HRRZ 0,DPTR	; GET FUDGE FACTOR
	ADD D,0		; ACTUAL ADDRESS
	SKIPN HIBLK	; ANY HIGH SEGMENT?
	POPJ P,		; NO, NOTHING TO CHECK
	CAMGE D,HIORG	; OVERLAP WITH HIGH SEGMENT
	POPJ P,		; NO
	SUB D,0		; VIRTUAL ADDRESS
	HRRZM D,ADR	; FOR ERROR MESSAGE
	FATADR [ASCIZ/Low Segment Full/]

EXAM:			; GET CONTENTS SPEC BY VIRTUAL ADDR IN D
	PUSHJ P,MAPD
	MOVE T,(D)
	JRST OPTCR

C.CD2:	POPJ P,	CD2

GETCOM:	MOVE P,[-LPDL,,PDL-1]
	PUSH P,C.CD2
	MOVEM P,SAVPDL
	.IOPUSH TYIC,
	MOVE T,NM2	;DON'T USE REL FOR COMMAND FILE
	CAMN T,DEFFN2
	MOVE T,[SIXBIT /LOADER/]
	MOVEM T,NM2
	OPEN TYIC,0
	PUSHJ P,FNF		;LOSE
	AOS UDEPTH
	POPJ P,

TPOK:	SKIPA T,BELL
ERR:	MOVEI T,"?
	.IOT TYOC,T
	JRST RESTRT

PAPER:	MOVE A,[SIXBIT /PTR/]
	MOVEM A,DEV
	POPJ P,		;REAL OPEN WILL OCCUR LATER

MCOM:	TRZN FF,ARG
	JRST OPNTP
	TRO FF,SETDEV	;SETTING DEVICE
	MOVE A,DEVTBL(D)
	MOVEM A,DEV
OPNTP:	TRO FF,MLAST	;SET M LAST COMMAND
	PUSHJ P,FRD
	POPJ P,		;REAL OPEN WILL OCCUR LATER

NTS:	FATAL [ASCIZ/Non-Time Sharing Command/]

SIXTYO:	JUMPE TT,CPOPJ
	MOVEI T,0
	LSHC T,6
	ADDI T,40
	PUSHJ P,TYO
	JRST SIXTYO

JOB:	PUSH P,DEV
	PUSH P,SNAME
	PUSH P,NM1
	PUSH P,NM2
	PUSHJ P,FRD
	MOVE B,NM1
	MOVEM B,JOBNAM
	TRO FF,JBN
	POP P,NM2
	POP P,NM1
	POP P,SNAME
	POP P,DEV
	POPJ P,

FNF:	PUSHJ P,TYPFIL
	PUSHJ P,SPC
	PUSHJ P,SPC
	.CALL	[SETZ
		SIXBIT/OPEN/
		5000,,0
		1000,,ERCHN
		[SIXBIT/ERR/]
		1000,,4
		SETZ ERRSTS]
	JRST .-1			;DON'T TAKE NO FOR AN ANSWER

ERLP:	.IOT ERCHN,A	;READ A CHAR
	CAIE A,14	;IF FORM FEED
	CAIN A,3	;OR ^C
	JRST ERDON	;STOP

	.IOT TYOC,A	;PRINT
	JRST ERLP

ERDON:	.CLOSE ERCHN,

	PUSH P,C
	MOVEI TT,[ASCIZ/ Use What Filename Instead? /]
	PUSHJ P,TYOS
	PUSHJ P,GTYIP	;GET TYPEIN
	PUSHJ P,RFD	;GET NEW FILE DESCRIPTION
	POP P,C
	POP P,A		;ADDRESS OF .CALL OPEN+2
	JRST -2(A)	;RETRY .CALL OPEN

TYPFIL:	MOVE A,[-4,,0]		; TYPE OUT CURRENT FILE NAME
TYPF2:	SKIPN TT,DEV(A)
	JRST TYPF3
	PUSHJ P,SIXTYO
	MOVE T,TYPFTB(A)
	PUSHJ P,TYO
TYPF3:	AOBJN A,TYPF2
	POPJ P,

TYPFTB:	":
	";
	40
	40

LOADN:	SKIPA C,SYMFLG
LOADG:	MOVEI C,DDSYMS
	PUSHJ P,OPNPTR	;DO THE REAL OPEN (AND FIRST READ)

	MOVEM C,SYMSW

RESTAR:	MOVEM P,SAVPDL
	CLEARB CKS,TC
	CLEARB RH,AWORD
	PUSH P,CJMP1
RESET:			;LEAVE GLOBAL LOCATION MODE
			;	MOVEI A,FACTOR
			;	HRRM A,REL
	TRZ FF,UNDEF+GPARAM+INDEF+GLOSYM+SEARCH+CODEF+COND+ADRREL
	POPJ P,

SHIORG:	SKIPE	HIBLK
	FATAL	[ASCIZ/Too Late to Change High Segment Origin/]
	HRRZ	D,D
	ADDI	D,1777
	ANDI	D,776000
	MOVEM	D,HIORG
	MOVEM	D,HIADR
	SUBI	D,HIREL0
	MOVEM	D,HIFACT
	MOVE	D,HIORG
	LSH	D,-10.
	SUBI	D,1
	LSH	D,9.
	IORI	D,400000
	HRRM	D,CWORD1
	JRST	CJMP1

SFACT:	HRRZS D
	CAIL D,HIORG
	JRST SF1
	MOVEM D,FACTOR
	JRST CJMP1
SF1:	SUB D,HIORG
	MOVEM D,HIFACT
CJMP1:	POPJ P,	JMP1

KILL:	POPJ P,
COMVAL:	SKIPA	COMLOC
SADR:	HRRZ D,SA
POPJ1:	AOSA (P)
COMSET:	MOVEM D,COMLOC
BELL:	POPJ P,	7

LBRAK:	MOVEM D,T1
	TRZ FF,LOSE
	PUSHJ P,ISYM
	MOVE T,T1
	TRO FF,GPARAM
	TRZE FF,ARG
	JRST DFSYM2
	TLNN B,200000
	FATAL [ASCIZ/Undefined Symbol/]
	MOVE D,1(D)
	TRZN FF,LOSE
	JRST POPJ1
	FATADR [ASCIZ/Undefined Symbol/] ;TYPES ADR, BUT I DON'T KNOW WHY

SOFSET:	HRRM D,LKUP3
CPOPJ:	POPJ P,

BEG:	MOVE D,FACTOR
	JRST POPJ1

DDT:	SKIPN JOBNAM
	JRST NJN

	MOVE	B,LOWSIZ	; PUT LOW-SEGMENT TOP IN LOCATION 20
	SUBI	B,(NBLKS)
	LSH	B,10.
	SUBI	B,1
	MOVEM	B,20

	HRLZ	B,HIORG		; PUT HIORG,,HIGTOP IN LOCATION 21
	HRR	B,HIGTOP
	MOVEM	B,21

	PUSHJ P,TDDT
	.IOPDL			;RESET THE I/O PUSH DOWN LIST
	SKIPE PURE
	PUSHJ P,DOWASH		;PURIFY HIGH SEGMENT
	MOVE A,JOBNAM
	HRR B,BPTR
	ADDI B,30
	HRRM B,YPTR
	HRLI B,440700
	MOVEI D,^W
	IDPB D,B
	MOVE C,[(000600)A-1]
	MOVEI T,6
DDT2:	ILDB D,C
	JUMPE D,DDT1
	ADDI D,40
	IDPB D,B
	SOJG T,DDT2

DDT1:	MOVE T,SA	;GET STARTING ADDRESS
	TLNN T,777000	;IF INSTRUCTION PART ZERO,
	TLO T,(JRST)	;THEN TURN INTO JRST
	MOVEM T,SA	;USE AS STARTING ADDRESS
	TRNE FF,GOF	;IF G COMMAND,
	MOVEM T,EXIT	;THEN USE AS LOADER EXIT
	MOVEI T,DDT4	;MAKE OCTPR GO TO DDT4
	HRRM T,TYOM	;INSTEAD OF TYO
	MOVEI C,[ASCIZ \J9B/#0î#1P\]
			;# CAUSES FOLLOWING DIGIT TO BE INTERPRETED AS INDEX INTO DDTST
	HRLI C,440700
	PUSHJ P,DDTSG	;GENERATE REST OF STRING
	MOVE B,LOWSIZ	;GET CURRENT CORE ALLOCATION
	SUBI B,(NBLKS)	;REDUCE TO PROGRAM CORE ALLOCATION
	MOVE C,B	;SAVE OUR SIZE
	LSH B,10.	;SHIFT TO MEMORY LOCATION
	SUBI B,1	;REDUCE TO TOP LOCATION IN CORE OF PROGRAM
	HRRM B,PMEMT	;SAVE FOR MAIN PROGRAM BLT
			;(DON'T LET NON-ZERO CORE ABOVE PROGRAM STAY AROUND)
	SUB C,LOWSIZ
	MOVNM C,PALL0	;NUMBER OF BLOCKS TO FLUSH
	MOVE C,LOWSIZ
	SUBI C,1
	LSH C,9.
	HRRZM C,PALL1
	HRLZ 17,BPTR	;GET LOCATION OF BEGINNING OF PROGRAM IN LH(17)
	ADDM 17,PSV17	;17 BLT POINTER FOR AC'S, TURN SV17 INTO BLT POINTER FOR PROGRAM
	MOVE B,EXBLTP	;GET EXIT ROUTINE BLT POINTER
YPTR:	.VALUE		;ADDRESS POINTS TO VALRET STRING
			;DON'T TRY TO STOP THEN START STINK AFTER HERE
			;	(AFTER BREAKPOINT OR WITH $G)
	BLT B,LEXEND	;BLT IN EXIT ROUTINE
	BLT 17,17	;BLT IN PROGRAM AC'S
	EXCH 17,SV17	;SAVE PROGRAM LOCATION 17, SET UP BLT POINTER
	.CLOSE TYOC,
	.CLOSE TYIC,
	.CLOSE TPCHN,
	JRST LEXIT

DDTST:	MOVE T,SA	;#0
	MOVE T,DDPTR	;#1

DDTSN:	ILDB T,C	;GET DIGIT AFTER NUMBER SIGN
	XCT DDTST-"0(T)	;GET VALUE IN T
	PUSHJ P,OCTPR	;"TYPE OUT" INTO VALRET STRING IN OCTAL
DDTSG:	ILDB T,C	;GET CHAR FROM INPUT STRING
	CAIN T,"#	;NUMBER SIGN?
	JRST DDTSN	;NUMBER SIGN, INTERPRET FOLLOWING DIGIT
	IDPB T,B	;DEPOSIT IN OUTPUT STRING
	JUMPN T,DDTSG	;LOOP ON NOT DONE YET
	POPJ P,

		;EXIT ROUTINE FROM LOADER
		;BLT'ED INTO 22 - 22+N

EXBLTP:	.+1,,LEXIT		;BLT POINTER
	OFST==22-.		;OFFSET, THIS CODE DESTINED FOR LEXIT
LEXIT=.+OFST			;LEXIT=22

PMEMT:	BLT 17,			;BLT DOWN MAIN PROGRAM
	MOVE 17,PALL1+OFST
	.CBLK 17,
PSV17:	40,,40			;40 FIRST PROGRAM ADDRESS LOADED INTO
	SUBI 17,1000
	SOSLE PALL0+OFST
	JRST .+OFST-4
	MOVE 17,PSV17+OFST	;GIVE USER HIS LOCATION 17
EXIT:	.VALUE .+OFST+1
PALL0:	0
PALL1:	0

LEXEND=.+OFST-1			;END OF EXIT ROUTINE
SV17=PSV17+OFST			;LOCATION TO SAVE 17

NJN:	TRZ FF,GOF
	FATAL [ASCIZ/No Job Name/]

ZERO:	MOVEI A,(NBLKS)
	MOVEM A,LOBLKS
	PUSHJ P,GETCOR
	PUSHJ P,SCE	;GO TO ERROR
	SKIPE	KEEP
	PUSHJ	P,WINP
	SETOM MEMTOP
	MOVEI A,1(NBLKS)
	MOVEM A,LOBLKS
GETMEM:	PUSHJ P,GETCOR
	PUSHJ P,SCE
	SKIPE	KEEP
	PUSHJ	P,WINP
	ADDI MEMTOP,2000
	AOS LOBLKS
	POPJ P,

GETCOR:	PUSH	P,A
	PUSH	P,B
	MOVE	B,LOWSIZ	; NUMBER OF BLOCKS WE HAVE
	SUB	B,LOBLKS	; NEGATIVE NUMBER OF BLOCKS TO GET
	SKIPL	B		; WANT TO GIVE SOME UP?
	FATAL	[ASCIZ/Low Segment Request is Negative/]
	AOS	-2(P)		; SET UP FOR SKIP RETURN (SUCCESSFUL)
	JUMPE	B,POPBAJ	; THAT WAS EASY
	HRLZ	B,B		; NOW IN LEFT HALF
	HRR	B,LOWSIZ	; FIRST PAGE TO GET IN RIGHT HALF
	.CALL	[SETZ
		'CORBLK
		1000,,300000	; GET READ AND WRITE ACCESS
		1000,,-1	; PUT PAGES IN MY JOB
		B		; CPTR
		401000,,400001	; GET FRESH PAGES
		]
	SOS	-2(P)		; GUESS WE LOST AFTER ALL
	HRRZM	B,LOWSIZ	; NEW NUMBER OF LOW BLOCKS
	JRST	POPBAJ		; RETURN

SCE:	SOS (P)		;MAKE POPJ BE A "GO .-1"
	SOS (P)
	PUSHJ P,COREQ	;ASK LOSER
	POPJ P,		;HE SAID YES
	FATADR [ASCIZ/Storage Capacity Exceeded/]

COREQ:	PUSH P,A	;SAVE SOME ACS
	SKIPE	KEEP	; SKIP IF NOT LOOPING
	JRST	COREQ3
COREQ0:	MOVEI A,[ASCIZ /No Core:
	Type C to try indefinately
	Type Y to try once
	Type N to lose/]

	PUSHJ P,LINOUT
	.IOT TYIC,A	;READ A CHARACTER
	.RESET	TYIC,
	CAIN	A,"N	; WANTS LOSSAGE?
	JRST	COREQ2
	CAIN	A,"Y
	JRST	POPAJ
	CAIE	A,"C
	JRST	COREQ0
	AOSA	KEEP
COREQ2:	AOS	-1(P)
	JRST	POPAJ

COREQ3:	MOVEI	A,1
	.SLEEP	A,
	JRST	POPAJ

;ROUTINE TO PRINT A LINE

LINOUT:	PUSH P,C
	PUSH P,B
	MOVSI B,440700+A	;BYTE POINTER TO INDEX OF A

LINO1:	ILDB C,B	;GET CHAR
	JUMPE C,LINO2	;ZERO, END
	.IOT TYOC,C
	JRST LINO1

LINO2:	MOVEI A,15	;PUT OUT CR
	.IOT TYOC,A
	POP P,B
	POP P,C
	POPJ P,

WINP:	PUSH	P,A
	MOVEI	A,[ASCIZ /WIN!!!/]
	PUSHJ	P,LINOUT
	SETZM	KEEP
	JRST	POPAJ

;THIS CODE DUMPS THE LOADED CORE IMAGE INTO A DISK FILE AND THEN CAUSES
;STINK TO KILL ITSELF.

DUMPY:	SKIPE PURE
	WARN [ASCIZ/Must do PDUMP to Get Pure High Segment/]
	TRZN FF,MLAST	;WAS "M" THE LAST COMMAND?
	PUSHJ P,FIXFIL	;FIX UP THE FILE NAME
	MOVE A,[SIXBIT /DSK/]
	TRZN FF,SETDEV	;WAS DEVICE SET?
	MOVEM A,DEV	;NO, SET IT
	MOVSI A,'REL
	CAME A,NM2	;IS THAT ANY NAME FOR A BIN FILE
	JRST DUMPY1
	MOVSI A,'BIN
	MOVEM A,NM2

DUMPY1:	OPEN TPCHN,6
	JRST OPNOK	;DOES NOT EXIST, WIN
	.CLOSE TPCHN,	;CLOSE IT
	.CALL	[SETZ
		SIXBIT/DELETE/
		DEV
		NM1
		NM2
		SETZ SNAME]
	JFCL		;IGNORE LOSSAGE

OPNOK:	OPEN TPCHN,7
	PUSHJ P,FNF

	PUSHJ P,TDDT	;MOVE ALL SYMBOLS TO DDT TABLE
	MOVE B,[JRST 1]	;START FILE WITH "GO 1"
	PUSHJ P,OUTWRD	;PUT IT OUT

	MOVE	B,LOWSIZ	; PUT LOW-SEGMENT TOP IN LOCATION 20
	SUBI	B,(NBLKS)
	LSH	B,10.
	SUBI	B,1
	MOVEI	ADR,20
	MOVEM	B,@ADRPTR

	HRLZ	B,HIORG		; PUT HIORG,,HIGTOP IN LOCATION 21
	HRR	B,HIGTOP
	MOVEI	ADR,21
	MOVEM	B,@ADRPTR

	MOVN ADR,MEMTOP	;GET -<LENGTH OF CORE IMAGE>
	HRLZS ADR  	;AOBJN POINTER

DMP2:	SKIPN B,@ADRPTR	;LOOK FOR THE FIRST NON-ZERO WORD
	AOBJN ADR,.-1	;UNTIL THE WORLD IS EXHAUSTED
	JUMPGE ADR,CHKHI	;DROPPED THROUGH, JUMP IF CORE EMPTY

	MOVEI C,(ADR)	;SAVE POINTER TO NON ZERO WORD
	MOVEI A,(C)	;AND ANOTHER COPY

DMP1:	SKIPE B,@ADRPTR	;NOW LOOK FOR END OF NON ZERO BLOCK
	AOBJN ADR,.-1	;UNTIL WORLD EXHAUSTED
	JUMPGE ADR,DMPLST	;IF WORLD EMPTY, QUIT

	AOBJP ADR,DMPLST	;CHECK NEXT WORD
	SKIPE B,@ADRPTR	;FOR BEING ZERO
	JRST DMP1	;ONE LONE ZERO, DON'T END BLOCK

DMPLST:	MOVEI D,(ADR)	;POINT TO END
	SUB C,D	;C/ -<LENGTH OF BLOCK>
	HRL A,C	;A/ AOBJN TO BLOCK
	MOVE B,A	;COPY TO B FOR OUTWRD
	PUSHJ P,OUTWRD	;PUT IT OUT

	HRRI B,@BPTR	;NOW POINT TO REAL CORE
	.IOT TPCHN,B	;BARF IT OUT

	MOVE B,A	;GET POINTER BACK IN B
	MOVE C,B	;FIRST WORD IN CHECK SUM
	HRRI B,@BPTR	;POINT TO REAL CORE

	ROT C,1	;ROTATE CKS
	ADD C,(B)	;ADD
	AOBJN B,.-2	;AND DO FOR ENTIRE BLOCK

	MOVE B,C	;CKS TO B
	PUSHJ P,OUTWRD	;AND PUT IT OUT

	JUMPL ADR,DMP2	;IF MORE, GO DO IT

CHKHI:	SKIPN	MEMTOP,HIGTOP	; ANY HIGH SEG
	JRST	DMPSYMS		; NO, GO ON TO SYMS
	SETZM	HIGTOP		; RESET IT
	HLLZS	ADRPTR		; FIX UP POINTERS
	HLLZS	BPTR
	HLLZS	DPTR
	HRRZ	ADR,MEMTOP	; GET NO. OF WORDS
	SUB	ADR,HIORG
	MOVNS	ADR		; NEGATE
	MOVSI	ADR,(ADR)
	HRR	ADR,HIORG	; START OF HIGH SEG
	JRST	DMP2

;HERE TO DO START ADDRESS

DMPSYMS:	HRRZ B,SA	;GET START ADR
	HRLI B,(JUMPA)	;USE "JUMPA" TO MAKE DDT HAPPY
	PUSHJ P,OUTWRD

;HERE TO DO SYMBOLS

	HLLZ B,DDPTR	;GET NUMBER
	PUSHJ P,OUTWRD	;PUT IT OUT

	MOVE C,DDPTR	;FOR CKS
	.IOT TPCHN,DDPTR	;OUT GOES THE WHOLE TABLE

	ROT B,1	;ACCUMULATE IN B
	ADD B,(C)	;ADD IT
	AOBJN C,.-2

	PUSHJ P,OUTWRD	;PUT OUT THE CKS

	MOVSI B,(JRST)	;FINISH WITH "GO 0"
	PUSHJ P,OUTWRD

	MOVNI B,1	;FINISH WITH NEGATIVE
	PUSHJ P,OUTWRD

	.CLOSE TPCHN,	;CLOSE THE FILE

	.BREAK	16,60000	; GOOD-BYE

;SUBROUTINE TO PUT OUT ONE WORD

OUTWRD:	HRROI T,B	;AOBJN POINTER TO B
	.IOT TPCHN,T
	POPJ P,

;HERE TO BUILD DEFAULT OUTPUT FILE NAME

FIXFIL:	MOVE A,[SIXBIT /_STNK_/]	;DEFAULT NAME 1
	MOVEM A,NM1
	MOVE A,[SIXBIT /DUMP/]	;AND NAME 2
	MOVEM A,NM2
	POPJ P,

; CORE AND TABLE MANAGEMENT ROUTINES FOR HASH CODED TABLE STINK.

PAIR:	PUSH	P,B
	SKIPN	A,PARLST	; ANY ON FREE LIST?
	JRST	PAIR1		; NO, TRY FREE AREA
	HRRZ	B,(A)		; YES, CDR THE LIST
	MOVEM	B,PARLST
PAIR3A:	SETZM	(A)	; CLEAR 1ST WORD
PAIR3:	POP	P,B
	POPJ P,

PAIR1:	MOVE	A,PARCUR	; TRY FREE AREA
	ADDI	A,2		; WORDS NEEDED
	CAML	A,PARTOP	; SKIP IF ROOM EXISTS
	JRST	PAIR2
PAIR4:	EXCH	A,PARCUR	; RETURN POINTER AND RESET PARCUR
	JRST	PAIR3A

QUAD:	PUSH	P,B
	SKIPN	A,QUADLS	; SKIP IF ANY THERE
	JRST	QUAD1
	HRRZ	B,(A)		; CDR THE QUAD LIST
	MOVEM	B,QUADLS
	JRST	PAIR3A

QUAD1:	MOVE	A,PARCUR	; GET TOP
	ADDI	A,4
	CAML	A,PARTOP	; OVERFLOW?
	JRST	QUAD2		; YES, GET MORE
	JRST	PAIR4		; NO, WIN

PAIR2:	PUSHJ	P,MORPAR	; GET MORE CORE
	JRST	PAIR1

QUAD2:	PUSHJ	P,MORPAR
	JRST	QUAD1

PARRET:	PUSH	P,B
	HRRZ	B,PARLST	; SPLICE IT INTO FREE LIST
	HRRM	B,(A)
	MOVEM	A,PARLST
	JRST	PAIR3		; RETURN POPPING B

QUADRT:	PUSH	P,B
	HRRZ	B,QUADLS
	HRRM	B,(A)
	MOVEM	A,QUADLS
	JRST	PAIR3

; HERE TO ALLOCATE MORE STORAGE (1 BLOCK) FOR SYMBOL TABLE STUFF

MORPAR:	PUSHJ P,GETCOR		; TRY AND GET A BLOCK
	PUSHJ	P,TMSERR		; COMPLAIN
	SKIPE	KEEP
	PUSHJ	P,WINP

	AOS	NBLKS
	PUSHJ	P,MOVCOD	; TRY AND GET CODE OUT OF THE WAY
	PUSHJ	P,MOVDD		; ALSO GET DDT SYMBOLS OUT
	MOVEI	A,2000		; INCREASE PARTOP
	ADDM	A,PARTOP
	AOS	LOBLKS
	POPJ P,

; HERE TO MOVE CODE

MOVCOD:	PUSH	P,C
	PUSH	P,B
	HRRZ	A,ADRPTR	; POINT TO CURRENT START
	ADDI	A,2000		; NEW START
	MOVE	C,A
	HRRM	A,ADRPTR	; FIX POINTERS
	HRRM	A,BPTR
	HRRM	A,DPTR
	MOVE	B,LOBLKS	; GEV(CURRENT TOP (IN BLOCKS)
	ASH	B,10.		; CONVERT TO WORDS

MOVCO3:	MOVEI	A,-2000(B)	; A/ POINT TO LAST DESTINATION
	CAIG	B,(C)		; SKIP IF NOT DONE
	JRST	MOVCO2
	HRLI	A,-2000(A)	; B/ FIRST SOURCE,,FIRST DESTINATION
	BLT	A,-1(B)
	SUBI	B,2000
	JRST	MOVCO3

MOVCO2:	POP	P,B
	POP	P,C
	POPJ P,

; HERE TO MOVE DDT SYMBOLS

MOVDD:	PUSH	P,C
	PUSH	P,C
	HRRZ	A,DDPTR		; GET CURRENT POINTER
	ADDI	A,2000
	HRRM	A,DDPTR
	HRRZ	A,DDTOP		; TOP OF DDT TABLE
	ADDI	A,2000
	MOVEM	A,DDTOP

	MOVEI	B,1(A)		; SET UP FOR BLT LOOP
	HRRZ	C,DDBOT
	ADDI	C,2000	; BUMP
	MOVEM	C,DDBOT
	JRST	MOVCO3		; FALL INTO BLT LOOP

;HAVE NAME W/ FLAGS IN A, VALUE IN T,
;PUT SYM IN DDT SYMBOL TABLE.
ADDDDT:	PUSH	P,A
	PUSH	P,B
ADDDD1:	MOVE	A,DDPTR
	SUB	A,[2,,2]
	HRRZ	B,DDBOT
	CAILE	B,(A)		; SKIP IF OK
	JRST	GROWDD		; MUST GROW DDT TABLE
	MOVEM	A,DDPTR
	MOVEM	T,1(A)		; CLOBBER AWAY
	POP	P,B
	POP	P,(A)
	MOVE	A,(A)		; RESTORE A
	POPJ P,

GROWDD:	PUSHJ P,GETCOR
	PUSHJ	P,TMSERR
	SKIPE	KEEP
	PUSHJ	P,WINP
	AOS	NBLKS
	PUSHJ	P,MOVCOD	; MOVE THE CODE
	PUSHJ	P,MOVDD
	MOVNI	A,2000
	ADDM	A,DDBOT
	AOS	LOBLKS
	JRST	ADDDD1

ADDDD2:	PUSH P,A	;CALL HERE FROM SYMS OR TDDT.
	PUSH P,B
	SKIPA B,DDPTR	;SPECIAL LOCAL SYM, LOOK FOR STE WITH SAME "NAME".
ADDDD3:	ADD B,[2,,2]
	JUMPGE B,POPBAJ	;NO ENTRY, THROW AWAY SYM.
	HLL A,(B)
	CAME A,(B)
	 JRST ADDDD3	;NOT THIS ONE.
	MOVE A,1(B)	;SYM'S REAL NAME IS IN 2ND WD OF STE,
	MOVEM A,(B)
	MOVEM T,1(B)	;PUT IN THE VALUE.
	JRST POPBAJ

;TDDT EXITS THROUGH HERE.
TDDTEX:	PUSH P,A	;MAKE SURE 1ST STE IN FILE IS PROGRAM NAME.
	PUSH P,B
	SKIPA A,DDPTR
TDDTE1:	ADD A,[2,,2]
	JUMPGE A,POPBAJ	;NO PROGRAM NAMES AT ALL => NO PROBLEM.
	MOVE B,(A)
	TLNE B,740000
	 JRST TDDTE1	;THIS NOT PROGRAM NAME.
	CAMN A,DDPTR
	 JRST POPBAJ	;IF IT'S ALREADY 1ST, NO PROBLEM.
	MOVE B,DDPTR
REPEAT 2,[
	EXCH T,.RPCNT(A) ;EXCHANGE PROGRAM NAME WITH 1ST STE.
	EXCH T,.RPCNT(B)
	EXCH T,.RPCNT(A)]
	JRST POPBAJ

ISYM:	MOVSI C,(50*50*50*50*50*50)
	MOVSI T,40000	;GLOBAL BIT

ISYM0:	PUSH P,T
	PUSHJ P,GETCC
	MOVE A,T
	POP P,T
	CAIN A,"*
	TLZ T,40000	;LOCAL
	CAIN A,"*
	JRST ISYM0
	CAIN A,">
	JRST LKUP
	SUBI A,"0-1
	CAIL A,"A-"0+1
	SUBI A,"A-"0+1-13
	JUMPGE A,ISYM2
	ADDI A,61
	CAIN A,60
	MOVEI A,45	;.
ISYM2:	IDIVI C,50
	IMUL A,C
	ADDM A,T
	JRST ISYM0

;READ SINGLE FILE DESCRIPTION 
;USES A,B,C,D,T
;REGISTER A USED TO CONTAIN INSTRUCTION TO GET NEXT CHARACTER

RFD:	; READ FROM FILE-NAME-BUFFER -- DEFAULT NM2 IS PREVIOUS
	MOVE T,[440700,,FNBUF]
	MOVEM T,FNPTR
	MOVE A,[ILDB T,FNPTR]
	JRST RFD8

FRD:	; READ FROM COMMAND STRING -- DEFAULT NM2 IS 'REL'
	SETZM NM2
	MOVE A,[PUSHJ P,GETCC]

RFD8:	SETZ D,		;D COUNTS FILENAMES. 0 BEFORE 1ST.
RFD1:	MOVEI C,0	;INITIALIZE SIXBIT NAME.
	MOVE B,[440600,,C]	;SET UP BP FOR INPUT
RFD2:	XCT A		;GET CHARACTER IN T
	CAIN T,":	;IF COLON...
	JRST RFDCOL	;THEN PROCESS AS SUCH
	CAIN T,";	;SIMILARLY FOR SEMICOLON
	JRST RFDSEM
	CAIN T,^Q	;IF CONTROL Q...
	JRST RFDCQ	;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL
	CAILE T,40	;LOGICAL SPACE? (INCLUDING CR)
	JRST RFDC		;NO
RFD6:	JUMPE C,RFD5	;IGNORE NULL FILENAMES
	XCT RFDTAB(D)	;STORE THE NAME (MAY SKIP)
	 ADDI D,1	;NEXT NAME PUT ELSEWHERE
RFD5:	CAIE T,ALTMOD
	 JRST RFD1	;NEXT NAME
	CAIL D,2	;SECOND NAME SPECIFIED?
	 POPJ P,	;YES
	SKIPE NM2	;USE OLD SECOND NAME?
	 POPJ P,	;YES
	MOVE T,DEFFN2	;NO, USE DEFAULT
	MOVEM T,NM2
	POPJ P,

RFDCOL:	JUMPE C,RFD1	;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN
	MOVEM C,DEV	;MOVE TO DEVICE LOCATION
	TRO FF,SETDEV
	JRST RFD1		;LOOP

RFDSEM:	JUMPE C,RFD1	;NO NULL SYSTEM NAMES PLEASE
	MOVEM C,SNAME	;MOVE TO SYSTEM NAME LOCATION
	JRST RFD1		;LOOP

RFDCQ:	XCT A		;CONTROL Q EATS UP THE NEXT CHARACTER
	CAIN T,15
	JRST RFD6		;BUT NOT IF CR
RFDC:	CAIL T,140	;CONVERT LOWER CASE TO UPPER.
	SUBI T,40
	SUBI T,40	;CONVERT CHARACTER TO SIXBIT
	TLNE B,770000	;TOO MANY CHARACTERS?
	IDPB T,B	;NO
	JRST RFD2		;LOOP

RFDTAB:	MOVEM C,NM1	;1ST NAME.
	MOVEM C,NM2	;2ND NAME.
	CAIA		;3RD AND ON IGNORED, DON'T INCR. D.


;GET COMMAND CHARACTER
;RETURNS CHARACTER IN T
;DOES NOT MODIFY A, B, C, D

GETCC:	SKIPN T,UDEPTH
	JRST GETTTY		;GET GOODIES FROM TTY BUFFER
	.IOT TYIC,T
	JUMPG T,UPPER
	JUMPE T,.-2		;IGNORE NULLS
	SOSGE UDEPTH		;FOUND EOF ON TYIC
	 HALT			;OVER POPPING IOPDL
	.IOPOP TYIC,
	JRST GETCC

;HERE TO GET COMMAND GOODIES FROM TTY

GETTY0:	PUSHJ P,FILBUF		;GET BUFFER GOODIES FROM TTY
GETTTY:	SOSGE CCNT
	JRST GETTY0
	ILDB T,CPTR
UPPER:	ANDI T,177
	CAIN T,"$
	MOVEI T,"
	CAIL T,"a		;IF LOWER CASE THEN CONVERT TO UPPER CASE
	CAILE T,"z
	POPJ P,
	SUBI T,40
	POPJ P,


; READ TTY LINE INTO FILE-NAME-BUFFER

GTYIP:	MOVE A,[440700,,FNBUF]
	.IOPUSH TYIC,
	.OPEN TYIC,TTYI
	.VALUE
GTYI1:	PUSHJ P,TYI
	CAIN T,15
	JRST GTYICR
	CAIN T,177	;RUBOUT
	JRST GTYRUB
	IDPB T,A
	JRST GTYI1
GTYICR:	MOVEI T,33
	IDPB T,A
	.IOPOP TYIC,
	POPJ P,

GTYRUB:	CAMN A,[(10700)FNBUF-1]
	JRST GTYI1
	LDB T,A
	ADD A,[(70000)]
	SKIPGE A
	SUB A,[(430000)1]
	TRNN FF,GETTY
	JRST [	.IOT TYOC,T
		JRST GTYI1]
	.IOT TYOC,[^P]
	.IOT TYOC,["X]
	JRST GTYI1

LITTER:	CONSTANTS
VARS::	VARIABLES

;IMPURE STORAGE 

EISYM:	;INITIAL SYMBOLS

CRELPT:	SQUOZE 64,$R.
FACTOR:	100
	0
HIFACT:	SQUOZE 64,$R.H
	0
	0
CPOINT:	SQUOZE 64,$.
	100
	0
	SQUOZE 64,.LVAL1
.VAL1:	0
	0
	SQUOZE 64,.LVAL2
.VAL2:	0
	0
	SQUOZE 64,USDATL
USDATP:	0
	0
EISYME:

BLKCNT:	0			;SEQUENTIAL BLOCK OF THIS FILE (FIRST ONE IS ZERO)
POLSW:	0			;-1=>WE ARE DOING POLISH
PPDP:	-PPDL,,PPDB-1		;INITIAL POLISH PUSH DOWN POINTER
PPDB:	BLOCK	PPDL+1		;POLISH PUSH DOWN BLOCK
SATED:	0			;COUNT OF POLISH FIXUPS TO BE DELETED
SATPDP:	-SATPDL,,SATPDB-1	;POINTER TO POLISH FIXUPS TO BE DELETED
SATPDB:	BLOCK	SATPDL+1	;LIST OF POLISH FIXUPS TO BE DELETED
SVSAT:	0			;# OF OPERANDS NEEDED
POLPNT:	0			;POINTER TO POLISH CHAIN
CGLOB:	0			;CURRENT GLOBAL IN SOME SENSE
CGLOBV:	0			;CURRENT GLOBAL VALUE IN SOME SENSE
CPROTE:	0			;SYMTAB ENTRY OF CURRENT PROGRM WHILE LISTING
GLBFS:	0			;GLOBAL BEING FIXED UP DURINGS DEFERED REQUEST
SVHWD:	0			;WORD CURRENTLY BEING READ BY POLISH
GLBCNT:	0			;# UNDEFINED FIXUPS DURING READING PHASE OF POLISH
HEADNM:	0			;# POLISH FIXUPS SEEN
LFTFIX:	0			;-1=> LEFT HALF FIXUP IN PROGRESS
LINKDB:	BLOCK	MNLNKS+1	;LINK DATA BLOCK (END LINK,,CURRENT VALUE)
HIBLK:	0			; BLOCKS IN HIGH SEG
PURE:	0			;NON-ZERO IF HIGH SEG PURE
KEEP:	0			; FLAG SAYING WE ARE IN A CORE LOOP
HIGTOP:	0			; TOP OF HIGH SEG
INPTR:	0			;HOLDS CURRENT IO POINTER
STNBUF:	BLOCK STNBLN		;BUFFER FOR BLOCK READS
PAT:	BLOCK	100
PATEND==.+1
CPTR:	0			;BYTE POINTER INTO COMMAND BUFFER
CCNT:	0			;# CHARACTERS IN COMAND BUFFER

DEV:	SIXBIT /DSK/		;ARGS FOR OPEN AND DELETE
SNAME:	0
NM1:	SIXBIT /BIN/
NM2:	SIXBIT /BIN/
ERRSTS:	0			;FOR OPEN ERROR CODE

DEFFN2: SIXBIT /REL/		;DEFAULT FILE NAME 2
UDEPTH:	0			;# TIMES TYIC PUSHED
DEVTBL:	IRPS DEV,,[DSK UT1 UT2 UT3 UT4 UT5 UT6 UT7 UT8]
	SIXBIT /DEV/
	TERMIN
JOBNAM:	0			;NAME OF JOB
HIORG:	0			;ORIGIN OF HIGH SEGMENT
LOWADR:	0			;FIRST FREE LOCATION IN LOW SEGMENT
HIADR:	0			;FIRST FREE IN HIGH SEGMENT
ADRM:	0			;TEMPORY CELL TO SAVE ADR AND ADRREL
AWORD:	0
ADRPTR:	<INITCR*2000>(ADR)
BPTR:	<INITCR*2000>(B)
DPTR:	<INITCR*2000>(D)
SA:	0
TC:	0
BITS:	0
BITPTR:	(300)BITS
SAVPDL:	0
LBOT:	INITCR*2000
TIMES:	0
COMLOC:	ICOMM
T1:	0
T2:	0
FLSH:	0
PRGNAM:	0

; CORE MANAGEMENT VARIABLES

;CWORD0:	4000,,400000+<<INITCR-1>_9.>
CWORD1:	4000,,600000-1000
LOWSIZ:	INITCR		; NUMBER BLOCKS WE GOT (IN LOW SEGMENT)
LOBLKS:	INITCR+1	; NUMBER OF BLOCKS OF CORE WE WANT
PARBOT:	0		; POINT TO BOTTOM OF SYMBOL TABLES
PARTOP:	0		; POINT TO TOP OF SAME
PARLST:	0		; LIST OF AVAILABLE 2 WORD BLOCKS
QUADLS:	0		; LIST OF AVAILABLE 4 WORD BLOCKS
PARCUR:	0		; TOP CURRENTLY IN USE SYMBOL TABLE CORE

DDPTR:	0		; AOBJN POINTER TO CURRENT DDT SYMBOL TABLE
DDTOP:	0		; HIGHEST ALLOCATED FOR DDT
DDBOT:	0		; LOWEST ALLOCATED FOR DDT

HTOP:	0		; TOP OF HASH TABLE
HBOT:	0		; BOTTOM OF HASH TABLE

;INITITALIZATION CODE

OPTCMD==40000		;IF .OPTIO HAS THIS TURNED ON THEN DDT HAS COMMAND

INIT:
PDL:	.SUSET [.RSNAM,,SNAME]	;GET INITIAL SYSTEM NAME
	MOVEI A,100
	MOVEM A,FACTOR
	SETZM HIFACT
	MOVEI A,400000		;ORIGIN OF HIGH SEGEMNT
	MOVEM A,HIORG
	MOVEM A,HIADR
	SETZM LOWADR
	MOVE NBLKS,[20,,INITCR]
	MOVEI A,ICOMM
	MOVEM A,COMLOC
	HLLZS LKUP3
	SETOM MEMTOP
				;	MOVEI A,FACTOR
				;	HRRM A,REL
	MOVE P,[-10,,PDL]
	PUSHJ P,KILL
	.OPEN TYOC,TTYO
	.VALUE	[ASCIZ/: CAN'T OPEN TTY OUTPUT /]
	.OPEN TYIC,TTYI
	.VALUE	[ASCIZ/: CAN'T OPEN TTY INPUT /]
	.STATUS TYIC,T
	ANDI T,77
	CAIN T,2
	TRO FF,GETTY
	MOVE TT,[SIXBIT /STINK./]
	PUSHJ P,SIXTYO
	MOVE TT,[.FNAM2]
	PUSHJ P,SIXTYO
	.IOT TYOC,[15]
	.IOT TYOC,[12]
	.SUSET [.RMEMT,,TT]
	LSH TT,-10.
	MOVEM TT,LOWSIZ
;	SUBI TT,1
;	LSH TT,9.
;	TDO TT,[4000,,400000]
;	MOVEM TT,CWORD0
	.SUSET [.ROPTI,,TT]
	TLNN TT,OPTCMD		;IS DDT TRYING TO GIVE US A COMMAND?
	JRST LIS		;NO, READ TTY COMMAND
	.BREAK 12,[5,,DDTBUF+1]	;ZAP
	MOVE T,[440700,,DDTBUF+1]
INIT0:	MOVEM T,B
	ILDB TT,T
	CAIE TT,40		;IGNORE LEADING SPACES AND TABS
	CAIN TT,11
	JRST INIT0
	CAIE TT,12
	CAIN TT,15
	JRST LIS		;NULL COMMAND LINE
	CAIN TT,ALTMOD		;FLUSH LEADING ALTMODES
	JRST INIT0
	MOVE A,[440700,,DDTBUF]
	MOVEM A,CPTR
	MOVEI T,"M		;SET UP FILE OF FORM M<loader command file>$@$$
INIT1:	CAIE T,12
	CAIN T,15
	JRST INIT2		;END OF COMMAND
	CAIN T,ALTMOD
	JRST INIT2		;ALTMODE STOPS ALL THIS NON-SENSE TOO
	IDPB T,A
	AOS CCNT
	ILDB T,B
	JRST INIT1  
INIT2:	MOVEI T,ALTMOD
	MOVEI TT,"@
	IDPB T,A
	IDPB TT,A
	IDPB T,A
	IDPB T,A
	MOVEI TT,4		;WE TACKED ON 4 EXTRA CHARACTERS AT END
	ADDM TT,CCNT
	JRST LIS

TTYO==.
	21,,(SIXBIT /TTY/)
	SIXBIT /STINK/
	SIXBIT /OUTPUT/

TTYI==.
	30,,(SIXBIT /TTY/)
	SIXBIT /STINK/
	SIXBIT /INPUT/

CONSTANTS

DDTBUF:	BLOCK 20			; DDT COMMAND BUFFER GOES HERE
	-1

LOC PDL+LPDL

CBUF:	BLOCK CBUFL-1
	0
FNBUF:	BLOCK FNBLEN
FNPTR:	BLOCK 1

LOSYM:				;LOWEST LOC AVAIL FOR SYM TBL
IFG DDTBUF+80.-LOSYM,INFORM [DDT BUFFER OVERFLOWS SYMBOLS]\DDTBUF+80.-LOSYM

INITCR==<LOSYM+3000>/2000	;LDR LENGTH IN BLOCKS

INFORM [HIGHEST USED]\LOSYM
INFORM [LOWEST LOCATION LOADED ]\LOWLOD
INFORM [COMMAND BUFFER LENGTH]\<CBUFL*5>
INFORM [INITIAL CORE ALLOCATION]\INITCR

END PDL