Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50073/loader.mac
There are 9 other files named loader.mac in the archive. Click here to see a list.
	SUBTTL	DICK GRUEN: V25 3 AUG 68


L==1			;L=1 MEANS THE LISP LOADER
IFNDEF L,<L=0>

IFNDEF HE,<HE=0>
IFE HE-1,<K=1>		;HE=1 IS HAND EYE 1K LOADER
IFE HE-2,<K=0>		;HE=2 IS HAND-EYE FORTRAN LOADER
;K=1			;K=1  MEANS 1KLOADER
IFNDEF	K,<K=0>		;K=0  MEANS F4 LOADER

STANSW=1		;GIVES STANFORD FEATURES
IFNDEF STANSW,<STANSW=0>
IFN STANSW,<	LDAC=1
		EXPAND=1
		BLTSYM=1
		PP=1
		RPGSW=1
		FAILSW=1>
IFN L,<	RPGSW=0
	BLTSYM=0
	LDAC=0>

UTAHSW=1		;NUMERIC PPN'S, BUT OTHERWISE = STANSW=1.
IFNDEF UTAHSW,<UTAHSW=0>

;FAILSW=1		;MEANS INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS
IFNDEF FAILSW,<FAILSW=0>

;RPGSW=1		;MEANS RPG FEATURE
IFNDEF RPGSW,<RPGSW=0>
;LDAC=1			;MEANS LOAD CODE INTO ACS
IFNDEF LDAC,<LDAC=0>

;BLTSYM=1		;MOVE SYMBOL TABLE DOWN TO END OF PROG
IFNDEF BLTSYM,<BLTSYM=0>

;EXPAND=1		;FOR AUTOMATIC CORE EXPANSION
IFNDEF EXPAND,<	IFN K,<EXPAND=0>
		IFE K,<EXPAND=1>>

;PP=1			;ALLOW PROJ-PROG #
IFNDEF PP,<PP=0>
IFN HE,<RPGSW=0
	PP=0
	LDAC=0
	EXPAND=1
	>

;CHN5=0			;IF CHAIN WHICH DOESN'T SAVES JOB41
IFNDEF CHN5,<CHN5=1>

IFE K,<	TITLE	LOADER - LOADS MACROX AND SIXTRAN FOUR>
IFN K,<	TITLE	1KLOAD - LOADS MACROX>
;ACCUMULATOR ASSIGNMENTS
	F=0		;FLAGS IN LH, SA IN RH
	N=1		;PROGRAM NAME POINTER
	X=2		;LOADER OFFSET
	H=3		;HIGHEST LOC LOADED
	S=4		;UNDEFINED POINTER
	R=5		;RELOCATION CONSTANT
	B=6		;SYMBOL TABLE POINTER
	D=7
	T=10
	V=T+1
	W=12		;VALUE
	C=W+1 		;SYMBOL
	E=C+1 		;DATA WORD COUNTER
	Q=15		;RELOCATION BITS
	A=Q+1 		;SYMBOL SEARCH POINTER
	P=17		;PUSHDOWN POINTER
;FLAGS	F(0 - 17)
	CSW==1	 		;ON - COLON SEEN
	ESW==2	 		;ON - EXPLICIT EXTENSION IDENT.
	SKIPSW==4		;ON - DO NOT LOAD THIS PROGRAM
	FSW==10			;ON - SCAN FORCED TO COMPLETION
	FCONSW==20		;ON - FORCE CONSOLE OUTPUT
	ASW==100		;ON - LEFT ARROW ILLEGAL
	FULLSW==200		;ON - STORAGE EXCEEDED
	SLIBSW==400		;ON - LIB SEARCH IN THIS PROG
	DSYMSW==1000		;ON - LOAD WITH SYMBOLS FOR DDT
	REWSW==2000		;ON - REWIND AFTER INIT
	LIBSW==4000		;ON - LIBRARY SEARCH MODE
	F4LIB==10000		;ON - F4 LIBRARY SEARCH LOOKUP
	ISW==20000		;ON - DO NOT PERFORM INIT
	SYMSW==40000		;ON - LOAD LOCAL SYMBOLS
	DSW==100000		;ON - CHAR IN IDENTIFIER
	NSW==200000		;ON - SUPPRESS LIBRARY SEARCH
	SSW==400000		;ON - SWITCH MODE
;FLAGS	N(0 - 17)
	ALLFLG==1		;ON - LIST ALL GLOBALS
	ISAFLG==2		;ON - IGNORE STARTING ADDRESSES
	COMFLG==4		;ON - SIZE OF COMMON SET
IFE K,<	F4SW==10		;F4 IN PROGRESS
	RCF==20			;READ DATA COUNT
	SYDAT==40		;SYMBOL IN DATA>
	SLASH==100		;SLASH SEEN
IFE K,<	BLKD1==200		;ON- FIRST BLOCK DATA SEEN
	PGM1==400		;ON FIRST F4 PROG SEEN
	DZER==1000		;ON - ZERO SECOND DATA WORD>
	EXEQSW==2000		;IMMEDIATE EXECUTION
	DDSW==4000		;GO TO DDT
IFN RPGSW,<RPGF==10000		;IN RPG MODE>
	AUXSWI==20000		;ON - AUX. DEVICE INITIALIZED
	AUXSWE==40000		;ON - AUX. DEVICE ENTERED
IFN PP,<PPSW==100000		;ON - READING PROJ-PROG #
	PPCSW==200000		;ON - READING PROJ #>
IFN FAILSW,<HSW==400000		;USED IN BLOCK 11 POLISH FIXUPS>
LOC	137
OCT 25		;VERSION #
RELOC
	MLON
	SALL



;MONITOR LOCATIONS IN THE USER AREA

	JOBPRO==140		;PROGRAM ORIGIN
	JOBBLT==134		;BLT ORIGIN
	JOBCHN==131		;RH = PROG BREAK OF FIRST BLOCK DATA
				;LH = PROG BREAK OF FIRST F4 PROG

;CALLI DEFINITIONS

CDDTOUT==3	;CALLI DDTOUT
CEXIT==12	;CALLI EXIT
CDDTGT==5	;CALLI DDTGT
CSETDDT==2	;CALLI SETDDT

;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS

PPDL==60
IFN RPGSW,<
RPGSET:	CALLI 0
	INIT 17,1	;SET UP DSK
	SIXBIT /DSK/
	XWD 0,CTLIN
	JRST NUTS
	MOVE [SIXBIT /QQLOAD/]	;NAME OF COMMAND FILE
	MOVEM CTLNAM
	MOVSI (SIXBIT /RPG/)	;AND EXT
	MOVEM CTLNAM+1
	SETZM CTLNAM+3
	LOOKUP 17,CTLNAM	;THERE?
	JRST NUTS	;NO
	INIT 16,16	;GET SET TO DELETE QQLOAD.RPG
	SIXBIT /DSK/
	0
	JRST LD		;GIVE UP COMPLETELY
	SETZM CTLNAM+3
	HLLZS CTLNAM+1	;CLEAR OUT EXTRA JUNK
	LOOKUP 16,CTLNAM
	JRST LD
	RENAME 16,ZEROS	;DELETE IT
	JFCL		;IGNORE IF IT WILL NOT GO
	RELEASE 16,0	;GET RID OF THIS DEVICE
	SETZM NONLOD	;THIS IS NOT A CONTINUATION
RPGS3:	MOVEI CTLBUF
	MOVEM JOBFF	;SET UP BUFFER
	INBUF 17,1
	MOVEI [ASCIZ /
LOADING
/]		;PRINT MESSAGE THAT WE ARE STARTING
	CALLI CDDTOUT
	SKIPE NONLOD	;CONTINUATION?
	JRST RPGS2	;YES, SPECIAL SETUP
	MOVSI R,F.I	;NOW SO WE CAN SET FLAG
	BLT R,R
	TLO N,RPGF
	JRST CTLSET	;SET UP TTY
RPGS1:	PUSHJ P,[TLNE F,ESW	;HERE FROM FOO* COMMAND, STORE NAME
		JRST LDDT3	;SAVE EXTENSION
		TLZE F,CSW!DSW	 ;OR AS NAME
		MOVEM W,DTIN
		POPJ P,]
	MOVEM 0,SVRPG#	;SAVE 0 JUST IN CASE
	SETZM NONLOD#	;DETERMINE IF CONTINUATION
	MOVEI 0,2(B)	;BY SEEING IF ANY SYMBOLS LOADED
	CAME 0,JOBREL
	SETOM NONLOD	;SET TO -1 AND SKIP CALLI
	MOVE 0,ILD1
	MOVEM 0,RPG1
	INIT 17,1
RPG1:	0
	XWD 0,CTLIN
	JSP A,ILD5
	LOOKUP 17,DTIN	;THE FILE NAME
	JRST ILD9
	JRST RPGS3

RPGS2:	MOVSI 0,RPGF	;SET FLAG
	IORM 0,F.C+N
	TLO N,RPGF
	MOVE 0,SVRPG
	JRST LD2Q	;BACK TO INPUT SCANNING
>
IFN HE, <
.LOAD:	SETZM ERRFLG;		HAND-EYE LOADER INITIALIZATION
	SETZM RESET
	MOVSI R,F.I+1;		INITIALIZE ACS
	AOS R
	BLT R,R
	OR F,F.I
	MOVE B,JOBSYM;		SET UP SYMBOL TABLE POINTER
	HLRZ H,JOBSA
	HLR R,JOBSA;		LOAD STARTING AT PROGRAM BREAK
	MOVS E,R;		CLEAR CORE
	HRRI E,1(R)
	SETZM (R)
	BLT E,(B)
	PUSHJ P,FIXNAM
	MOVE S,JOBUSY
	SKIPN S
	HRRZ S,B
	SOS S
	SOS B
	MOVEM P,SAVP#;		SAVE SUBR POINTER
	JRST BEG;		FINISH INIT

F.I:	XWD SYMSW,0;		INITIAL F
	XWD ALLFLG+ISAFLG+COMFLG,0;	INITIAL N
	XWD V,0;		INITIAL X - LOAD IN PLACE
	Z
	Z
	XWD W,0;		INITIAL R
	Z
.AC:	BLOCK 17
LNKSAV:	BLOCK 21

LD5B1:	HALT
	>
IFN HE,<
.PRMAP:	MOVEM 16,.AC+16;	PRINT STORAGE MAP
	HRRZI 16,.AC;		SAVE ACS
	BLT 16,.AC+15
	MOVE F,F.I+F;		SET UP ACS AS NEEDED
	MOVE N,F.I+N
	HLRZ R,JOBSA
	MOVE S,JOBUSY
	SOS S
	MOVE B,JOBSYM
	SOS B
	INIT 2,1;		INITIALIZE LPT
	SIXBIT /LPT/
	XWD ABUF,0
	JSP A,ILD5
	MOVEI E,AUX
	MOVEM E,JOBFF
	OUTBUF 2,1
	TLO N,AUXSWI
	PUSHJ P,PRMAP;	PRINT MAP
	RELEASE 2,
	HRLZI 16,.AC
	BLT 16,16
	POPJ P,
	>
IFN HE,<
ILD:	MOVEI W,BUF1;		INITIALIZE FILE LOADING
	MOVEM W,JOBFF
	TLOE F,ISW
	JRST ILD6
	INIT 1,14
	SIXBIT /DSK/
	Z BUFR
	JSP A,ILD5;		ERROR RETURN
ILD6:	LOOKUP 1,DTIN;		LOOKUP FILE
	JRST ILD3
	INBUF 1,2
	MOVE 15,..NAME
	MOVEI 12,-2(S)
	SUBI S,2
	POP B,2(12)
	POP B,1(12)
	MOVE 12,.NAME;		RIGHT HALF VALUE IS LINK
	HRL 12,R;		LEFT HALF IS RELOCATION
	MOVEM 12,2(B)
	MOVEM 15,1(B)
	HRRZM B,.NAME
	POPJ P,

ILD3:	PUSHJ P,ILDX;		LOOKUP FAILURE
	JRST ILD9;		NO HOPE
	JRST ILD6;		TRY AGAIN

ILDX:	MOVE W,DTIN2
	CAMN W,[SIXBIT /  H HE/]
	POPJ P,;		IF H,HE THERE IS NO HOPE
	CAMN W,[SIXBIT /  1  3/]
	JRST [	MOVE W,DTIN;	CHECK IF HELIB[1,3]
		CAME W,[SIXBIT /HELIB/]
		POPJ P,;		YES - TRY BACKUP FILE
		JRST IX]
IX:	MOVE W,[SIXBIT /  H HE/]
	MOVEM W,DTIN2;		NOT H,HE - TRY LIBRARY AREA
	AOS (P);		TRY AGAIN
	POPJ P,
	>
IFN HE,<
FIXNAM:	HLRE T,B;		GET END OF PROGRAM NAME LIST
	MOVMS T
	ADDI T,(B)
	SUBI T,3
	HLRZ D,2(T)
	JUMPE D,.+3
	ADD T,D
	JRST .-3
	HRRI N,2(T)
	POPJ P,

LD2:	SKIPN RESET
	JRST LD2Q-2
	CAMN B,F.C+B
	CAME S,F.C+S
	CAIA
	JRST .+4
	MOVEI T,[ASCIZ /
CANNOT RECOVER/]
	CALLI T,CDDTOUT
	CALLI CEXIT
	MOVE T,.NAME;		REMOVE NAME
	HRRZ T,2(T)
	MOVEM T,.NAME
	MOVEI T,1(S)
	ADDI S,2
	PUSH B,1(T)
	PUSH B,2(T)
	AOSA ERRFLG#
	PUSHJ P,LDF
LD2Q:	MOVSI T,F.C
	BLT T,B
>
IFN HE,<
GETF:	MOVE P,SAVP;		RESTORE SUBR POINTER
	SKIPN RESET
	JRST GETF4
	SETZM RESET;		RECOVERABLE ERROR
	PUSHJ P,ILDX;		CHECK FOR ANOTHER COPY
	JRST GETF4;		NO
	MOVEI T,[ASCIZ /_
/]
	CALLI T,CDDTOUT
	JRST LD2Q-1

GETF4:	TLNE F,LIBSW
	JRST GETFY+1;		LIBRARY MODE - CONTINUE
	PUSHJ P,.GETF;		GET NEXT FILE
	SETZM 13
	LSHC 13,6
	CAIE 13,"/"
	JRST GETF1
	ROT 14,6;		FIRST CHAR SLASH - DECODE SWITCH
	CAIN 14,"D"
	JRST .DDT
	CAIN 14,"S"
	JRST [	TLO F,SYMSW
		JRST GETF4+2]
	CAIN 14,"W"
	JRST [	TLZ F,SYMSW+DSYMSW
		JRST GETF4+2]
	CAIN 14,'C'
	JRST GETF4+2;		SAVE /C DECODING FOR LATER
	JSP A,ERRPT8;		UNKNOWN SWITCH - ERROR
	SIXBIT /SYNTAX%/
	JRST LD2

.DDT:	MOVSI W,444464;	LOAD DDT
	MOVEM W,DTIN
	MOVE W,[SIXBIT /  1  3/]
	MOVEM W,DTIN2
	JRST LD2Q-1
	>
IFN HE,<
GETF1:	LSHC 13,-6
	JUMPE 14,GETF2;		FILE NAME ZERO - FINISHED
	OR 15,[XWD 600000,0]
	SKIPN 13,.NAME#
	JRST GETF3;		NO FILES LOADED
	CAMN 15,2(13);		SEARCH FOR FILE NAME
	JRST GETF4+1;		FOUND - DO NOT LOAD
	HRRZ 13,1(13)
	JUMPN 13,.-3
GETF3:	MOVEM 15,..NAME#
	MOVEM 14,DTIN;		SET UP ENTER BLOCK
	MOVEM 16,DTIN2
	JRST LD2Q-1

GETF2:	MOVEI W,3;		END OF FILES - SEARCH LIBRARIES
	MOVEM W,CNT#
	SKIPA
GETFY:	TLZ F,SYMSW+DSYMSW;	TURN OFF LOCAL SYMBOLS AFTER HELIB
	JUMPGE S,GETF11
	TLO F,LIBSW+SKIPSW
	MOVE W,[SIXBIT /  1  3/]
	MOVEM W,DTIN2
	SOSGE W,CNT
	JRST GETF11
	MOVE W,.TAB(W)
	MOVEM W,DTIN
	JRST LD2Q-1

.TAB:	SIXBIT /JOBDAT/
	SIXBIT /LIB40/
	SIXBIT /HELIB/

GETF11:	PUSHJ P,SAS1;		TERMINATE LOADING
	RELEASE 1,
	PUSHJ P,BLTSET
IFN FAILSW,<
	MOVE R,[XWD LINKTB,LNKSAV]
	BLT R,LNKSAV+20>;	SAVE LINK TABLE
	MOVE R,JOBDDT
	CALLI R,CSETDDT
	HLRE 16,S
	MOVMS 16
	LSH 16,-1;		RIGHT HALF AC16 IS # UNDEF SYMBS
	HRL 16,ERRFLG
	POPJ P,
>
IFE HE,<
;MONITOR LOADER CONTROL

BEG:
IFE L,<
LD:	IFN RPGSW,<SKIPA	;NORMAL INITIALIZE
	JRST RPGSET	;SPECIAL INIT>
	HLLZS 42	;GET RID OF ERROR COUNT IF NOT IN RPG MODE
	CALLI	0		;INITIALIZE THIS JOB
NUTS:	MOVSI     R,F.I		;SET UP INITIAL ACCUMULATORS
	BLT	R,R		
>
IFN L,<
LD:	HRRZM 0,LSPXIT#		;RETURN ADDRESS FOR LISP
	MOVEI 0,0
	HRRZM R,RINITL#
	CALLI 0
>
CTLSET:	INIT	3,1 		;INITIALIZE CONSOLE
	SIXBIT    /TTY/
	XWD	BUFO,BUFI
CALLEX:	CALLI	CEXIT		;DEVICE ERROR, FATAL TO JOB
	MOVEI     E,TTY1
	MOVEM     E,JOBFF
	INBUF     3,1
	OUTBUF    3,1 		;INITIALIZE OUTPUT BUFFERS
	OUTPUT    3,			;DO INITIAL REDUNDANT OUTPUT
IFE L,<	HRRZ	B,JOBREL	;PICK UP CORE BOUND
	SKIPE	JOBDDT		;DOES DDT EXIST?
	HRRZ	B,JOBSYM	;USED BOTTOM OF SYMBOL TABLE INSTEAD
>
IFN L,<	MOVE B,JOBSYM>
	SUB	B,SE3		;INITIALIZE SYMBOL TABLE POINTER
	CAILE     H,1(B)		;TEST CORE ALLOCATION
	CALLI	CEXIT		;INSUFFICIENT CORE, FATAL TO JOB
IFE L,<	MOVS	E,X 		;SET UP BLT POINTER
	HRRI	E,1(X)>
IFN L,<	MOVS E,H
	HRRI E,1(H)>
	SETZM     -1(E) 		;ZERO FIRST WORD
	BLT	E,(B)		;ZERO CORE UP TO THE SYMBOL AREA
	HRRZ	S,B 		;INITIALIZE UNDEF. POINTER
	HRR	N,B 		;INITIALIZE PROGRAM NAME POINTER
IFE L,<HRRI	R,JOBPRO	;INITIALIZE THE LOAD ORIGIN>
	MOVE	E,COMM		;SET .COMM. AS THE FIRST PROGRAM
	MOVEM     E,1(B)		;STORE IN SYMBOL TABLE
	HRRZM     R,2(B)		;STORE COMMON ORIGIN
	>
IFN HE,<BEG:>
	MOVEI     E,F.C		;INITIALIZE STATE OF THE LOADER
	BLT	E,B.C
	SETZM	MDG		;MULTIPLY DEFINED GLOBAL COUNT
IFE HE,<
IFN FAILSW,<	SETZM LINKTB	;ZERO OUT TE LINK TABLE
	MOVE W,[XWD LINKTB,LINKTB+1]
	BLT W,LINKTB+20	;BEFORE STARTING>
IFE L,<	MOVSI	W,254200	;STORE HALT IN JOB41
	MOVEM	W,JOB41(X)>	;...
IFN L,<	MOVE W,JOBREL
	HRRZM W,OLDJR#>>
IFN HE,<IFN FAILSW,<
	MOVE W,[XWD LNKSAV,LINKTB]
	BLT W,LINKTB+20
	>>
IFN STANSW,<SETZM CURNAM#>
IFN FAILSW,<	MOVEI W,440000	;SET UP THE SPECIAL BITS OF HEADNUM (ADD+POLISH)
	MOVEM W,HEADNM#
	SETZM POLSW#	;SWITCH SAYS WE ARE DOING POLISH
	MOVEI W,PDLOV	;ENABLE FOR PDL OV
	MOVEM W,JOBAPR
	MOVEI W,200000
	CALLI W,16

EXTERNAL JOBAPR	>
IFN LDAC!BLTSYM,<MOVEI W,20	;SET UP SPACE TO SAVE FOR ACS AND
	MOVEM W,KORSP#	;USER DEFINITIONS WITH DDT>

IFN HE,<JRST LD2Q>
IFE HE,<
IFN RPGSW,<JRST LD2Q>
LD2:	IFN RPGSW,<MOVSI B,RPGF	;HERE ON ERRORS, TURN OFF RPG
	ANDCAM B,F.C+N	;IN CORE>
;LOADER SCAN FOR FILE NAMES

LD2Q:	MOVSI     B,F.C		;RESTORE ACCUMULATORS
	BLT	B,B
	MOVE	P,PDLPT		;INITIALIZE PUSHDOWN LIST
	SETZM     BUFI2		;CLEAR INPUT BUFFER POINTER
IFE PP,<	SETZM     ILD1		;CLEAR INPUT DEVICE NAME>
IFN PP,<	MOVSI T,(SIXBIT /DSK/)	;ASSUME DSK
	MOVEM T,ILD1
	SETZM OLDDEV#	;TO MAKE IT GO BACK AFTER /D FOR LIBSR>
	SETZM     DTIN		;CLEAR INPUT FILE NAME
IFN PP,<SETZM	PPN#		;CLEAR INPUT PROJ-PROG #>

LD2B:	RELEAS    1,			;RELEASE BINARY INPUT DEVICE
IFN RPGSW,<	TLNE N,RPGF	;NOT IF DOING RPG
	JRST LD2BA>
	MOVEI     T,"*"
	IDPB	T,BUFO1		;OUTPUT ASTERISK TO START INPUT
	OUTPUT    3,
LD2BA:	TLZ	F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW
	TLNE	F,LIBSW		;WAS LIBRARY MODE ON?
	TLO	F,SKIPSW	;YES, NORMAL MODE IS SKIPPING

LD2D:	IFN PP,<SETZM PPN	;DO NOT REMEMBER PPNS FOR NOW
LD2DB:	SKIPE W,OLDDEV	;RESET DEVICE IF NEEDED
	CAMN W,ILD1	;IS IT SAME?
	JRST LD2DA	;YES, FORGET IT
	TLZ F,ISW+DSW+FSW+REWSW
	MOVEM W,ILD1>
LD2DA:
IFN RPGSW,<	SETZM DTIN1	;CLEAR EXTENSION>
	MOVEI     W,0 		;INITIALIZE IDENTIFIER SCAN
	MOVEI     E,6 		;INITIALIZE CHARACTER COUNTER
	MOVE	V,LSTPT		;INITIALIZE BYTE POINTER TO W
	TLZ	F,SSW+DSW+FSW	;LEAVE SWITCH MODE
LD3:	IFN RPGSW,<TLNE N,RPGF	;CHECK RPG FEATURE
	JRST RPGRD>
	SOSG BUFI2	;DECREMENT CHARACTER COUNT
	INPUT     3,			;FILL TTY BUFFER
	ILDB	T,BUFI1		;LOAD T WITH NEXT CHARACTER
LD3AA:	MOVE	Q,T
	IDIVI     Q,11		;TRANSLATE TO 4 BIT CODE
	LDB	Q,LD8(A)		;LOAD CLASSIFICATION CODE
	CAIGE     Q,4 		;MODIFY CODE IF .GE. 4
	TLNN	F,SSW		;MODIFY CODE IF SWITCH MODE OFF
	ADDI	Q,4 		;MODIFY CLASS. CODE FOR DISPATCH
	HRRZ	A,LD3A(Q)		;LOAD RH DISPATCH ENTRY
	CAIL	Q,10		;SKIP IF CORRECT DISPATCH ENTRY
	HLRZ	A,LD3A-10(Q)	;LOAD LH DISPATCH ENTRY
	JRST	@A			;JUMP TO INDICATED LOCATION

;COMMAND DISPATCH TABLE

LD3A:	XWD	LD3,LD7B		;IGNORED CHAR, BAD CHAR (SWITCH)
	XWD	LD6A,LD6		;</> OR <(>, LETTER (SWITCH)
	XWD	LD5,LD6C		;<:>, DIGIT (SWITCH ARG.)
	XWD	LD5A,LD6D		;<.>, ESCAPE SWITCH MODE <)>
	XWD	LD5C,LD7		;<=> OR <L. ARROW>, BAD CHAR.
	XWD	LD5B,LD4		;<,>, ALPHABETIC CHAR.
	XWD	LD5D,LD4		;<CR.>, NUMERIC CHAR.
	XWD	LD5E1,LD7		;<ALT MODE>, BAD CHAR. <)>

IFN RPGSW,<RPGRD:	SOSG CTLIN+2	;CHECK CHARACTER COUNT
	JRST	[IN 17,0
		JRST .+1	;OK
		STATO 17,740000
		JRST LD2
		JSP A,ERRPT
		SIXBIT /ERROR WHILE READING COMMAND FILE%/
		JRST LD2]
	IBP CTLIN+1	;ADVANCE POINTER
	MOVE T,@CTLIN+1	;AND CHECK FOR LINE #
	TRNE T,1
	JRST	[MOVNI T,5
		ADDM T,CTLIN+2
		AOS CTLIN+1
		JRST RPGRD	];GO READ AGAIN
	LDB T,CTLIN+1	;GET CHR
	JRST LD3AA	;PASS IT ON>
	>
;ALPHANUMERIC CHARACTER, NORMAL MODE
IFE HE,<
LD4:	SOJL	E,LD3		;JUMP IF NO SPACE FOR CHAR IN W
	SUBI	T,40		;CONVERT FROM ASCII TO SIXBIT
	IDPB	T,V 		;DEPOSIT CHAR OF IDENTIFIER IN W
	TLO	F,DSW		;SET IDENTIFIER FLAG
	JRST	LD3 		;RETURN FOR NEXT CHARACTER

;DEVICE IDENTIFIER DELIMITER <:>

LD5:	PUSH	P,W 		;SAVE W
	TLOE	F,CSW		;TEST AND SET COLON FLAG
	PUSHJ     P,LDF		;FORCE LOADING
	POP	P,W 		;RESTORE W
	TLNE	F,ESW		;TEST SYNTAX
	JRST	LD7A		;ERROR, MISSING COMMA ASSUMED
	JUMPE     W,LD2D		;JUMP IF NULL DEVICE IDENTIFIER
	MOVEM     W,ILD1		;STORE DEVICE IDENTIFIER
IFN PP,<MOVEM W,OLDDEV	;WE HAVE A NEW ONE SO IGNORE OLD>
	TLZ	F,ISW+DSW+FSW+REWSW	;CLEAR OLD DEVICE FLAGS
IFN PP,<SETZM	PPN		;CLEAR OLD PP #>
	JRST	LD2D		;RETURN FOR NEXT IDENTIFIER

;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>

LD5A:	TLOE	F,ESW		;TEST AND SET EXTENSION FLAG
	JRST	LD7A		;ERROR, TOO MANY PERIODS
	TLZE	F,CSW+DSW	;SKIP IF NULL IDENT AND NO COLON
	MOVEM     W,DTIN	;STORE FILE IDENTIFIER
	JRST	LD2D		;RETURN FOR NEXT IDENTIFIER

;INPUT SPECIFICATION DELIMITER <,>

LD5B:
IFN PP,<TLZE	N,PPCSW			;READING PP #?
	JRST	[
IFLE STANSW-UTAHSW,<	HRLM	D,PPN	;STORE PROJ #
		JRST	LD6A1]	;GET PROG #>
IFG STANSW-UTAHSW,<	PUSHJ	P,RJUST		;RIGHT JUSTIFY W
		HRLM	W,PPN	;STORE PROJ NAME
		JRST	LD2DB		];GET PROG NAME>
	PUSHJ	P,RBRA		;CHECK FOR MISSING RBRA>
	TLZN	F,FSW		;SKIP IF PREV. FORCED LOADING
	PUSHJ     P,FSCN2		;LOAD (FSW NOT SET)
	JRST	LD2D		;RETURN FOR NEXT IDENTIFIER

LD5B1:	TLNE	F,ESW		;TEST EXTENSION FLAG
	JRST	LDDT3		;EXPLICIT EXTENSION IDENTIFIER
	TLZN	F,CSW+DSW		;SKIP IF IDENT. OR COLON
	POPJ	P,
	MOVEM     W,DTIN		;STORE FILE IDENTIFIER
	JRST	LDDT2		;ASSUME <.REL> IN DEFAULT CASE
	>
;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>
;OR PROJ-PROG # BRACKETS <[> AND <]>
IFE HE,<
LD5C:
IFN RPGSW,<CAIN T,"@"	;CHECK  FOR * COMMAND
	JRST RPGS1>
IFN PP,<CAIN	T,"["			;PROJ-PROG #?
	JRST	[TLO	N,PPSW+PPCSW	;SET FLAGS
		MOVEM	W,PPNW#		;SAVE W
		MOVEM	E,PPNE#		;SAVE E
		MOVEM	V,PPNV#		;SAVE V
IFLE STANSW-UTAHSW,<JRST LD6A1-1]	;READ NUMBERS AS SWITCHES >
IFG STANSW-UTAHSW,<	JRST	LD2DB]>
	CAIN	T,"]"			;END OF PP #?
	JRST	[PUSHJ	P,RBRA		;PROCESS RIGHT BRACKET
		JRST	LD3		];READ NEXT IDENT>
	TLOE	F,ASW			;TEST AND SET LEFT ARROW FLAG
	JRST	LD7A			;ERROR, MISPLACED LEFT ARROW
	PUSHJ     P,LD5B1		;STORE IDENTIFIER
	TLZN	F,ESW			;TEST EXTENSION FLAG
	MOVSI     W,554160		;ASSUME <.MAP> IN DEFAULT CASE
	MOVEM     W,DTOUT1		;STORE FILE EXTENSION IDENTIFIER
	MOVE	W,DTIN			;LOAD INPUT FILE IDENTIFIER
	MOVEM     W,DTOUT		;USE AS OUTPUT FILE IDENTIFIER
IFN PP,<MOVE	W,PPN		;PROJ-PROG #
	MOVEM	W,DTOUT+3		;...>
	MOVE	W,ILD1			;LOAD INPUT DEVICE IDENTIFIER
	MOVEM	W,LD5C1			;USE AS OUTPUT DEVICE IDENTIFIER
IFN PP,<	SKIPE W,OLDDEV	;RESTORE OLD
	MOVEM W,ILD1>
;INITIALIZE AUXILIARY OUTPUT DEVICE
	TLZE	N,AUXSWI+AUXSWE		;FLUSH CURRENT DEVICE
	RELEASE	2,			;...
	CALL	W,[SIXBIT ?DEVCHR?]	;IS DEVICE A TTY?
	TLNE	W,10			;...
JRST	LD2D		;YES, SKIP INIT
	INIT	2,1			;INIT THE AUXILIARY DEVICE
LD5C1:	0		;AUXILIARY OUTPUT DEVICE NAME
	XWD	ABUF,0			;BUFFER HEADER
	JSP	A,ILD5			;ERROR RETURN
	TLNE	F,REWSW			;REWIND REQUESTED?
	CALL	2,[SIXBIT /UTPCLR/]		;DECTAPE REWIND
	TLZE	F,REWSW			;SKIP IF NO REWIND REQUESTED
	MTAPE	2,1			;REWIND THE AUX DEV
	MOVEI	E,AUX			;SET BUFFER ORIGIN
	MOVEM     E,JOBFF
	OUTBUF	2,1			;INITIALIZE SINGLE BUFFER
	TLO	N,AUXSWI			;SET INITIALIZED FLAG
	JRST	LD2D			;RETURN TO CONTINUE SCAN

	>
IFE HE,<
;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
IFN PP,<
RBRA:	TLZN	N,PPSW		;READING PP #?
	POPJ	P,		;NOPE, RETURN
	TLZE	N,PPCSW		;COMMA SEEN?
	JRST	LD7A		;NOPE, INDICATE ERROR
IFLE STANSW-UTAHSW,<HRRM	D,PPN		;STASH PROG NUMBER>
IFG STANSW-UTAHSW,<PUSHJ	P,RJUST		;RIGHT JUSTIFY W
	HRRM	W,PPN	;STASH PROG NAME>
	MOVE	W,PPNW#		;PICKUP OLD IDENT
	MOVE	E,PPNE#		;RESTORE CHAR COUNT
	MOVE	V,PPNV#		;RESTORE BYTE PNTR
	POPJ	P,		;TRA 1,4

;RIGHT JUSTIFY W

RJUST:	JUMPE	W,LD7A		;NOTHING TO RIGHT JUSTIFY
	TRNE	W,77		;IS W RJUSTED YET?
	POPJ	P,		;YES, TRA 1,4
	LSH	W,-6		;NOPE, TRY AGAIN
	JRST	.-3		;...>
	>
IFE HE,<
;LINE TERMINATION <CARRIAGE RETURN>

LD5D:
IFN PP,<PUSHJ	P,RBRA		;CHECK FOR UNTERMINATED PP #>
	PUSHJ     P,FSCN		;FORCE SCAN TO COMPLETION
	JRST	LD2B		;RETURN FOR NEXT LINE

;TERMINATE LOADING <ALT MODE>

LD5E:	SKIPE     D			;ENTER FROM G COMMAND
	HRR	F,D 		;USE NUMERIC STARTING ADDRESS
LD5E1:
	PUSHJ     P,CRLF		;START A NEW LINE
	PUSHJ	P,SASYM		;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
IFN LDAC!BLTSYM,<HRRZ A,R		;SET UP BLT OF ACS
	ADDI A,(X)		;END
	ADD A,KORSP		;ADD IN SPACE RESERVED
	CAIL A,(S)
IFN EXPAND,<JRST	[PUSHJ P,XPAND>
			PUSHJ	P,[
IFE EXPAND,<			JSP	A,ERRPT
				SIXBIT	/MORE CORE NEEDED#/>
				CALLI	CEXIT]
IFN EXPAND,<		JRST .-1]>
	HRRM R,BOTACS#		;SAVE FOR LATER
	HRRZ A,R		;SET BLT
	ADD A,X
	HRL A,X
	MOVE Q,A
	BLT A,17(Q)>
IFN BLTSYM,<HRRZ A,R	;PLACE TO BLT TO
	ADD A,KORSP
	MOVE W,A	;SAVE DEST
	ADDI A,(X)	;AFTER ADJUSTMENT
	MOVE Q,S	;UDEF PNTR
	ADD Q,B		;TOTAL UNDEFS AND DEFS IN LEFT
	HLROS Q		;NOW NEG IN RIGHT
	MOVNS Q	;POSITIVE
	ADDI Q,-1(A)	;END OF BLT
	HRLI A,1(S)	;AND GET PLACE TO BLT FROM
	SUBI W,1(S)	;PREST LOC OF SYMBOL TABLE
	ADDM W,JOBSYM(X)
	ADDM W,JOBUSY(X)	;ADJUST POINTERS
	BLT A,(Q)	;MOVE IT
	SKIPN JOBDDT(X)	;IS DDT THERE?
	JRST NODDT
	SUBI Q,-1(X)
	HRRM Q,JOBFF(X)	;RESTET JOBFF IF DDT IS IN
	HRLM Q,JOBSA(X)
NODDT:>
	MOVE	W,[SIXBIT ?LOADER?]	;FINAL MESSAGE
	PUSHJ P,BLTSET		;SETUP FOR FINAL BLT
	RELEASE	2,		;RELEASE AUX. DEV.
IFN RPGSW,<RELEASE 17,0	;RELEASE COMMAND DEVICE>
IFE L,<
IFN STANSW,<MOVE W,JOBREL	;IN CASE NO NAME SET
	MOVE W,-1(W)	;USE FIRRST LOADED
	SKIPN CURNAM
	PUSHJ P,LDNAM
	MOVE W,CURNAM
	JRST LD5E4>>
IFN L,<	JRST @LSPXIT>
LD5E5:	MOVE	W,[BLT Q,(A)]	;BLT OF ALL CODE
	MOVEM	W,JOBBLT	;STASH IN JOB DATA AREA
	MOVEM	W,JOBBLT(X)	;STASH IN RELOCATED JOBDATA AREA
LD5E2:	MOVE	W,CALLEX	;EXIT AFTER BLT
	TLZN	N,EXEQSW	;IMMEDIATE EXECUTION REQUESTED?
	JRST	LD5E3		;NOPE, LET USER TYPE START HIMSELF
	HRRZ	W,JOBSA(X)	;PICKUP USUAL STARTING ADDRESS
	TLNE	N,DDSW		;DDT EXECUTION?
	HRRZ	W,JOBDDT(X)	;USE DDT SA INSTEAD
	JUMPE	W,LD5E2		;IF SA=0, DON'T EXECUTE
	HRLI	W,(JRST)	;INSTRUCTION TO EXECUTE
LD5E3:
IFE LDAC,<MOVEM	W,JOBBLT+1(X)	;STASH FOR EXECUTION>
IFN LDAC,<MOVEM	W,JOBBLT+2(X)	;STASH FOR EXECUTION
	HRLZ	17,JOBFF(X)	;BUT FIRST BLT ACS
	MOVE	W,[BLT 17,17]	;...
	MOVEM	W,JOBBLT+1(X)	;...>
	JRST	JOBBLT		;IF IT WERE DONE, 'TWERE BEST DONE QUICKLY

IFE L,<
IFN STANSW,<LSH W,6	;LEFT JUSTIFY
LD5E4:	TLNN W,770000	;IS IT LEFT JUSTIFIED?
	JRST .-2
	CALL W,[SIXBIT /SETNAM/]
	JRST LD5E5>>

	>
IFE HE, <
;SEARCH LIBRARY, PRINT UNDEFS, SETUP JOBSA,JOBFF,JOBSYM,JOBUSY

SASYM:	TLNN	F,NSW		;SKIP IF NO SEARCH FLAG ON
	PUSHJ	P,LIBF		;SEARCH LIBRARY FILE
	PUSHJ	P,FSCN		;FORCE SCAN TO COMPLETION
	PUSHJ	P,PMS		;PRINT UNDEFINEDS
IFE L,<	HRRZM	F,JOBSA(X)	;RH OF JOBSA :=STARTING ADDRESS>
	>
SAS1:	HRRZ	A,H		;COMPUTE PROG BREAK
	SUBI	A,(X)		;...
	CAIGE	A,(R)		;BUT NO HIGHER THAN RELOC
	HRRZ	A,R		;...
IFE L,<	HRLM	A,JOBSA(X)	;LH OR JOBSA IS PROG BREAK
	HRRZM	A,JOBFF(X)	;RH OF JOBFF CONTAINS PROG BREAK>
	MOVE	A,B		;SET JOBSYM W/ SYMBOL TABLE POINTER
	AOS	A		;...
IFE L,<	MOVEM	A,JOBSYM(X)	;...>
IFN L,<	MOVEM	A,JOBSYM>
	MOVE	A,S		;SET JOBUSY W/ UNDEFINED SYMBOL POINTER
	AOS	A		;...
IFE L,<	MOVEM	A,JOBUSY(X)	;...>
IFN L,<	MOVEM	A,JOBUSY>
	POPJ	P,		;RETURN
IFE HE,<
;PRINT FINAL MESSAGE, SET UP BLT AC'S, SETDDT, RELEAS

BLTSET:	PUSHJ	P,FCRLF		;START FINAL MESSAGE
	PUSHJ	P,PWORD		;PRINT W
	PUSHJ	P,SPACE
	>
IFN HE,<
BLTSET:>
IFN FAILSW<	MOVSI Q,-20	;SET TO FIX UP LINKS
FXEND:	HLRZ V,LINKTB+1(Q)	;GET END LINK INFO
	JUMPE V,NOEND	;DO NOT LINK THIS ONE
	HRRZ A,LINKTB+1(Q)	;GET THE THING TO PUT THERE
IFN L,<	CAML V,RINITL>
	HRRM A,@X	;PUT IT IN
NOEND:	AOBJN Q,FXEND	;FINISH UP>
IFN HE,<POPJ P,>
IFE HE,<
	HRRZ	Q,JOBREL	;PUBLISH HOW MUCH CORE USED
IFN L,<	SUB	Q,OLDJR		;OLD JOBREL>
	LSH	Q,-12		;...
	ADDI	Q,1		;...
	PUSHJ	P,RCNUM		;PUBLISH THE NUMBER
	MOVE	W,[SIXBIT /K CORE/]	;PUBLISH THE UNITS
	PUSHJ	P,PWORD		;...
	PUSHJ	P,CRLF		;...
IFE L,<	MOVSI	Q,20(X)		;HOW MUCH CODE TO BLT
	HRRI	Q,20		;...
	HRRZ A,42		;CHECK ON ERRORS
	JUMPE A,NOEX		;NONE, GO AHEAD
	TLZN N,EXEQSW		;DID HE WANT TO START EXECUTION?
	JRST NOEX		;NO
	JSP A ,ERRPT		;PRINT AN ERROR MESSAGE
	SIXBIT /EXECUTION DELETED@/
NOEX:	HRRZ	A,JOBREL	;WHEN TO STOP BLT
	HRRZM	A,JOBREL(X)	;SETUP FOR POSSIBLE IMMED. XEQ
	SUBI	A,(X)		;...
IFE BLTSYM,<CAIL	A,(S)		;DON'T BLT OVER SYMBOL TABLE
	MOVEI	A,(S)		;OR UNDEFINED TABLE>
>
	RELEAS	1,		;RELEASE DEVICES
	RELEAS	3,		;...
IFE L,<	MOVE	R,JOBDDT(X)	;SET NEW DDT
	CALLI	R,CSETDDT	;...>
	POPJ	P,		;RETURN
	>

IFE HE,<
;WRITE CHAIN FILES

CHNC:	SKIPA	A,JOBCHN(X)	;CHAIN FROM BREAK OF FIRST BLOCK DATA
CHNR:	HLR	A,JOBCHN(X)	;CHAIN FROM BREAK OF FIRST F4 PROG
	HRRZS	A		;ONLY RIGHT HALF IS SIGNIFICANT
	JUMPE	A,LD7C		;DON'T CHAIN IF ZERO
	TLNN	N,AUXSWI	;IS THERE AN AUX DEV?
	JRST	LD7D		;NO, DON'T CHAIN
	PUSH	P,A		;SAVE WHEREFROM TO CHAIN
	SKIPE	D		;STARTING ADDR SPECIFIED?
	HRR	F,D		;USE IT
	PUSHJ	P,SASYM		;DO LIB SEARCH, SETUP JOBSA, ETC.
	POP	P,A		;GET WHEREFROM
	MOVN	W,JOBREL	;CALCULATE IOWD FOR DUMP
	ADDI	W,-1-3-CHN5(A)	;...
	HRLI	W,-4-CHN5(A)	;...
	MOVSM	W,IOWDPP	;...
	ADDI	A,-4-CHN5(X)	;ADD IN OFFSET
IFN CHN5,<PUSH	A,JOBSYM(X)	;SETUP FOUR WORD TABLE
	PUSH	A,JOB41(X)	;...>
	PUSH	A,JOBDDT(X)	;JOBDDT IN ALL CASES
IFE CHN5,<PUSH	A,JOBSYM(X)	;JOBDDT, JOBSYM, JOBSA>
	PUSH	A,JOBSA(X)	;JOBRYM ALWAYS LAST
	CLOSE	2,		;INSURE END OF MAP FILE
	SETSTS	2,17		;SET AUX DEV TO DUMP MODE
	MOVSI	W,435056	;USE .CHN AS EXTENSION
	MOVEM	W,DTOUT1	;...
	PUSHJ	P,IAD2		;DO THE ENTER
	TLZ	N,AUXSWI+AUXSWE	;INSURE NO PRINTED OUTPUT
	MOVE	W,[SIXBIT ?CHAIN?]	;FINAL MESSAGE
	PUSHJ	P,BLTSET		;SETUP BLT PNTR, SETDDT, RELEAS
IFE STANSW,<CALLI	CDDTGT		;START DDT MODE OUTPUT>
	MOVSI	CHNBLT,CHAIN3	;BLT CHAIN3 INTO ACS
	BLT	CHNBLT,CHNBLT	;...
	MOVEI	P,CHNERR	;POINTER TO ERR MESS
	JRST	0		;GO DO CHAIN

	>
IFE HE, <
;THE AC SECTION OF CHAIN

CHAIN3:
	PHASE	0
	BLT	Q,(A)		;USUAL LDRBLT
	OUTPUT	2,IOWDP		;WRITE THE CHAIN FILE
	STATZ	2,IOBAD!IODEND	;CHECK FOR ERROR OR EOF
	JRST	LOSEBIG		;FOUND SAME, GO GRIPE
	CLOSE	2,		;FINISH OUTPUT
	STATZ	2,IOBAD!IODEND	;CHECK FOR FINAL ERROR
LOSEBI:	CALLI	CDDTOUT		;GRIPE ABOUT ERROR
	CALLI	CEXIT		;EXIT
CHNERR:	ASCIZ	?DEVICE ERROR?	;ERROR MESSAGE
IOWDP:	Z			;STORE IOWD FOR DUMP HERE
CHNBLT:				;LAST WORD OF AC CHAIN (ZERO OF I/O POINTER)
	DEPHASE
IOWDPP=.-1			;MEMORY LOC OF AC IOWDP
	Z			;TERMINATOR OF DUMP MODE LIST

>
;EXPAND CORE

IFN EXPAND,<
XPAND:	PUSH P,H	;GET SOME REGISTERS TO USE
	PUSH P,X
	PUSH P,N
IFE HE,<HRRZ X,JOBREL	;WHAT WE WANT
	ADDI X,2000
	CALLI X,11>
IFN HE,<JRST XPAND4;		HAND - EYE CORE FIXUP LATER
	JRST XPAND3
XPAND2:		>;		CORE ALLOCATOR CALLS THIS
	JRST XPAND6
IFE K,<		HRRZ H,MLTP	;GET LOWEST LOCATION
	TLNN N,F4SW	;IS FORTRAN LOADING>
	HRRZ H,S	;NO, USE S
IFE HE,<
	HRRZ X,JOBREL	;NOW MOVE
	SUBI X,2000
XPAND2:	MOVE N,(X)
	MOVEM N,2000(X)
	CAMLE X,H	;TEST FOR END
	SOJA X,XPAND2>;		HAND EYE SYSTEM MOVES TABLE
	HRLI H,-2000
	SETZM (H)	;ZERO NEW CORE
	AOBJN H,.-1
	MOVEI H,2000
	ADDM H,S
	ADDM H,B
	ADDM H,JOBSYM
	POP P,N
	ADDI N,2000
IFE K,<	TLNN N,F4SW	;F4?
	JRST	XPAND3
	ADDM H,PLTP
	ADDM H,BITP
	ADDM H,SDSTP
	ADDM H,MLTP
	TLNE N,SYDAT
	ADDM H,V>
IFN HE,<POPJ P,>
XPAND3:
	POP P,X
	POP P,H
	AOS (P)
	POPJ P,
XPAND6:	JUMPE X,XPAND4
	JSP A,ERRPT
IFE STANSW,<SIXBIT /CORE AVAILABLE, BUT NOT TO YOU#/>
IFN STANSW,<SIXBIT /YOU HAVE BEEN FUCKED BY THE SHIT-EATING SYSTEM#/
	JRST	XPAND5>
XPAND4:	JSP A,ERRPT
	SIXBIT /MORE CORE NEEDED#/
XPAND5:	POP P,N
	POP P,X
	POP P,H
	POPJ P,

XPAND7:	PUSHJ	P,XPAND
	JRST	SFULLC
	JRST	POPJM2

POPJM3:	SOS	(P)		;POPJ TO CALL-2
POPJM2:	SOS	(P)		;POPJ TO CALL-1
	SOS	(P)		;SAME AS POPJ TO
	POPJ	P,		;NORMAL POPJ MINUS TWO
	>
IFE HE,<

;ENTER SWITCH MODE

LD6A:	CAIN	T,57		;WAS CHAR A SLASH?
	TLO	N,SLASH		;REMEBER THAT
	TLO	F,SSW		;ENTER SWITCH MODE
LD6A1:	MOVEI	D,0		;ZERO THE NUBER REGISTER
	JRST	LD3		;EAT A SWITCH

;ALPHABETIC CHARACTER, SWITCH MODE

LD6:	XCT	LD6B-101(T)	;EXECUTE SWITCH FUNCTION
	TLZE	N,SLASH	;SWITCH MODE ENTERED W/ SLASH?
	JRST	LD6D		;LEAVE SWITCH MODE
	JRST	LD6A1		;STAY IN SWITCH MODE

;DISPATCH TABLE FOR SWITCHES

;	THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED

LD6B:	TLO	N,ALLFLG	;A - LIST ALL GLOBALS
	JRST	LD7B		;B - ERROR
	PUSHJ	P,CHNC		;C - CHAIN, START W/ COMMON
	PUSHJ     P,LDDT	;D - DEBUG OPTION, LOAD DDT
	TLO	N,EXEQSW	;E - LOAD AND GO
	PUSHJ     P,LIBF	;F - LIBRARY SEARCH
	PUSHJ     P,LD5E	;G - GO INTO EXECUTION
	PUSHJ P,LRAIDX		;H - LOAD AN START RAID
	TLO	N,ISAFLG	;I - IGNORE STARTING ADDRESSES
	TLZ	N,ISAFLG	;J - USE STARTING ADDRESSES
IFE BLTSYM,<JRST	LD7B		;K - ERROR>
IFN BLTSYM,<PUSHJ P,KORADJ	;K - RESERVE SPACE FOR SYM DEFS>
	TLO	F,LIBSW+SKIPSW	;L - ENTER LIBRARY SEARCH
	PUSHJ     P,PRMAP	;M - PRINT STORAGE MAP
	TLZ	F,LIBSW+SKIPSW	;N - LEAVE LIBRARY SEARCH
	HRR	R,D		;O - NEW PROGRAM ORIGIN
	TLO	F,NSW		;P - PREVENT AUTO. LIB. SEARCH
	TLZ	F,NSW		;Q - ALLOW AUTO. LIB. SEARCH
	PUSHJ	P,CHNR		;R - CHAIN, START W/ RESIDENT
	TLO	F,SYMSW		;S - LOAD WITH SYMBOLS
	PUSHJ	P,LDDTX		;T - LOAD AND GO TO DDT
	PUSHJ     P,PMS		;U - PRINT UNDEFINED LIST
	PUSHJ P,LRAID		;V - LOAD RAID
	TLZ	F,SYMSW+DSYMSW	;W - LOAD WITHOUT SYMBOLS
	TLZ	N,ALLFLG	;X - DO NOT LIST ALL GLOBALS
	TLO	F,REWSW		;Y - REWIND BEFORE USE
	JRST	LD		;Z - RESTART LOADER

>
IFE HE, <
;SWITCH MODE NUMERIC ARGUMENT

LD6C:	LSH	D,3 		;BUILD OCTAL NUMERIC ARGUMENT
	ADDI	D,-60(T)
	JRST	LD3

;EXIT FROM SWITCH MODE

LD6D:	TLZ	F,SSW		;CLEAR SWITCH MODE FLAG
	TLNE	F,FSW		;TEST FORCED SCAN FLAG
	JRST	LD2D		;SCAN FORCED, START NEW IDENT.
	JRST	LD3 		;SCAN NOT FORCED, USE PREV IDENT
;ILLEGAL CHARACTER, NORMAL MODE

LD7:	JSP	A,ERRPT8
	SIXBIT    /CHAR.%/
	JRST	LD2

;SYNTAX ERROR, NORMAL MODE

LD7A:	JSP	A,ERRPT8
	SIXBIT    /SYNTAX%/
	JRST	LD2

;ILLEGAL CHARACTER, SWITCH MODE

LD7B:	JSP	A,ERRPT8
	SIXBIT    /SWITCH%/
	JRST	LD2

;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0

LD7C:	JSP	A,ERRPT		;GRIPE
	SIXBIT	?UNCHAINABLE AS LOADED@?
	JRST	LD2

;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE

LD7D:	JSP	A,ERRPT		;GRIPE
	SIXBIT	?NO CHAIN DEVICE@?
	JRST	LD2

>
IFN BLTSYM,<KORADJ:	CAMLE D,KORSP	;IF SMALLER IGNORE
	MOVEM D,KORSP
	POPJ P,>
IFE HE, <
;CHARACTER CLASSIFICATION TABLE DESCRIPTION:

;	EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE
;	PACKED IN THE CHARACTER CLASSIFICATION TABLE.  THE CHARACTER
;	CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE
;	DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.
;	CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND
;	THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS.  FOUR CODES
;	ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS
;	IN EFFECT.


;CLASSIFICATION BYTE CODES:

;	BYTE DISP CLASSIFICATION

;	00 - 00  ILLEGAL CHARACTER, SWITCH MODE
;	01 - 01  ALPHABETIC CHARACTER, SWITCH MODE
;	02 - 02  NUMERIC CHARACTER, SWITCH MODE
;	03 - 03  SWITCH MODE ESCAPE, SWITCH MODE

;	00 - 04  ILLEGAL CHARACTER, NORMAL MODE
;	01 - 05  ALPHABETIC CHARACTER, NORMAL MODE
;	02 - 06  NUMERIC CHARACTER, NORMAL MODE
;	03 - 07  SWITCH MODE ESCAPE, NORMAL MODE

;	04 - 10  IGNORED CHARACTER
;	05 - 11  ENTER SWITCH MODE CHARACTER
;	06 - 12  DEVICE IDENTIFIER DELIMITER
;	07 - 13  FILE EXTENSION DELIMITER
;	10 - 14  OUTPUT SPECIFICATION DELIMITER
;	11 - 15  INPUT SPECIFICATION DELIMITER
;	12 - 16  LINE TERMINATION
;	13 - 17  JOB TERMINATION

>
IFE HE, <
;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE

LD8:	POINT     4,LD9(Q),3
	POINT     4,LD9(Q),7
	POINT     4,LD9(Q),11
	POINT     4,LD9(Q),15
	POINT     4,LD9(Q),19
	POINT     4,LD9(Q),23
	POINT     4,LD9(Q),27
	POINT     4,LD9(Q),31
	POINT     4,LD9(Q),35

;CHARACTER CLASSIFIACTION TABLE

LD9:	BYTE	(4)4,0,0,0,0,0,0,0,0
	BYTE	(4)4,4,4,4,12,0,0,0,0
	BYTE	(4)0,0,0,0,0,0,0,0,0
	BYTE	(4)13,0,0,0,0,4,0,4,0
	BYTE	(4)0,0,0,0,5,3,0,0,11
	BYTE	(4)0,7,5,2,2,2,2,2,2
	BYTE	(4)2,2,2,2,6,0,0,10,0
IFE RPGSW,<	BYTE	(4)0,0,1,1,1,1,1,1,1>
IFN RPGSW,<	BYTE (4) 0,10,1,1,1,1,1,1,1>
	BYTE	(4)1,1,1,1,1,1,1,1,1
	BYTE	(4)1,1,1,1,1,1,1,1,1
IFE PP,<BYTE	(4)1,0,0,0,0,10,0,0,0>
IFN PP,<BYTE	(4)1,10,0,10,0,10,0,0,0>
	BYTE	(4)0,0,0,0,0,0,0,0,0
	BYTE	(4)0,0,0,0,0,0,0,0,0
	BYTE	(4)0,0,0,0,0,0,0,0,13
	BYTE	(4)13,4

>
IFE HE, <
;INITIALIZE LOADING OF A FILE

ILD:	MOVEI     W,BUF1		;LOAD BUFFER ORIGIN
	MOVEM     W,JOBFF
	TLOE	F,ISW		;SKIP IF INIT REQUIRED
	JRST	ILD6		;DONT DO INIT
	INIT	1,14
ILD1:	0				;LOADER INPUT DEVICE
	XWD	0,BUFR
	JSP	A,ILD5		;ERROR RETURN
ILD6:	TLZE	F,REWSW		;SKIP IF NO REWIND
	MTAPE	1,1		;REWIND
ILD2:	LOOKUP    1,DTIN		;LOOK UP FILE FROM DIRECTORY
	JRST	ILD3		;FILE NOT IN DIRECTORY
IFE K,<	INBUF     1,2 		;SET UP BUFFERS>
IFN K,<	INBUF	1,1		;SET UP BUFFER>
	TLO	F,ASW		;SET LEFT ARROW ILLEGAL FLAG
	TLZ	F,ESW+F4LIB	;CLEAR EXTENSION FLAG
	POPJ	P,

;	LOOKUP FAILURE

ILD3:	TLOE	F,ESW		;SKIP IF .REL WAS ASSUMED
	JRST	ILD4		;FATAL LOOKUP FAILURE
	SETZM     DTIN1		;ZERO FILE EXTENSION
	JRST	ILD2		;TRY AGAIN WITH NULL EXTENSION

ILD4:	TLZE	F,F4LIB		;WAS THIS A TRY FOR F40 LIBRARY?
	JRST	[MOVE	W,[SIXBIT /LIB4/]; YES, TRY LIB4
		MOVEM	W,DTIN		;...
		PUSHJ	P,LDDT2		;USE .REL EXTENSION
		TLZ	F,ESW		;...
		JRST	ILD2		];GO TRY AGAIN
	>
ILD9:	JSP	A,ERRPT
	SIXBIT    /CANNOT FIND#/
	JRST	LD2

;	DEVICE SELECTION ERROR

ILD5:	MOVE	W,-3(A)		;LOAD DEVICE NAME FROM INIT
	TLO	F,FCONSW	;INSURE TTY OUTPUT
	PUSHJ	P,PRQ		;START W/ ?
	PUSHJ     P,PWORD		;PRINT DEVICE NAME
	JSP	A,ERRPT7
	SIXBIT    /UNAVAILABLE@/
	JRST	LD2
IFE HE, <
;LIBRARY SEARCH CONTROL AND LOADER CONTROL

;LIBF ENABLES A LIBRARY SEARCH OF <SYS:LIB4.REL>

LIBF:	PUSHJ     P,FSCN1		;FORCE SCAN TO COMPLETION
	PUSHJ	P,LIBF1			;LOAD SYS:JOBDAT.REL
	TLO	F,F4LIB			;INDICATE FORTRAN LIBRARY SEARCH
	MOVE	W,[SIXBIT /LIB40/]	;FIRST TRY AT NAME
	PUSHJ	P,LIBF2			;LOAD SYS:LIB40.REL
LIBF1:	MOVE	W,[SIXBIT /JOBDAT/]	;LOAD SYS:JOBDAT.REL
LIBF2:	PUSHJ     P,LDDT1
	JUMPGE    S,EOF2		;JUMP IF NO UNDEFINED GLOBALS
	TLO	F,SLIBSW+SKIPSW	;ENABLE LIBRARY SEARCH
	TLZ	F,SYMSW+DSYMSW	;DISABLE LOADING WITH SYMBOLS
	JRST	LDF 		;INITIALIZE LOADING LIB4
>;		HAND - EYE DOES OWN LIB SETUP

;	LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE

LIB:	JUMPGE    S,EOF1		;JUMP IF NO UNDEFINED GLOBALS
	TLO	F,SKIPSW		;SET SKIPSW TO IGNORE MODE
	JRST	LOAD		;CONTINUE LIB. SEARCH

LIB1:	CAIE	A,4 		;TEST FOR ENTRY BLOCK
	JRST	LIB3		;NOT AN ENTRY BLOCK, IGNORE IT
LIB2:	PUSHJ     P,RWORD		;READ ONE DATA WORD
	MOVE	C,W
	TLO	C,040000		;SET CODE BITS FOR SEARCH
	PUSHJ     P,SREQ
	TLZA	F,SKIPSW		;REQUEST MATCHES ENTRY, LOAD
	JRST	LIB2		;NOT FOUND
LIB3:	PUSHJ     P,RWORD		;READ AND IGNORE ONE DATA WORD
	JRST	LIB3		;LOOP TO IGNORE INPUT

IFE HE,<
;LDDT LOADS <SYS:DDT.REL> AND SETS DSYMSW

LRAIDX:	TLO N,DDSW!EXEQSW	;H - LOAD AND START RAID
LRAID:	PUSHJ P,FSCN1		;FORCE END OF SCAN
	MOVE W,[SIXBIT /RAID/]
	JRST LDDT0
LDDTX:	TLO	N,DDSW+EXEQSW	;T - LOAD AND GO TO DDT
LDDT:	PUSHJ     P,FSCN1		;FORCE SCAN TO COMPLETION
	MOVSI     W,444464		;FILE IDENTIFIER <DDT>
LDDT0:	PUSHJ     P,LDDT1
	PUSHJ     P,LDF		;LOAD <SYS:DDT.REL>
	TLO	F,DSYMSW		;ENABLE LOADING WITH SYMBOLS
	POPJ	P,

LDDT1:	MOVEM     W,DTIN		;STORE FILE IDENTIFIER
IFN PP,<MOVE W,ILD1	;SAVE OLD DEV
	MOVEM W,OLDDEV>
	MOVSI     W,637163		;DEVICE IDENTIFIER <SYS>
	MOVEM     W,ILD1		;STORE DEVICE IDENTIFIER
	TLZ	F,ISW+LIBSW+SKIPSW+REWSW	;CLEAR OLD FLAGS
LDDT2:	MOVSI     W,624554		;EXTENSION IDENTIFIER <.REL>
LDDT3:	MOVEM     W,DTIN1		;STORE EXTENSION IDENTIFIER
IFN PP,<MOVE W,PPN	;GET PROJ-PROG #
	MOVEM W,DTIN+3>
	POPJ	P,
>;		HAND - EYE DOES OWN DDT LOAD
;EOF TERMINATES LOADING OF A FILE

EOF:	MOVE	P,PDSAV		;RESTORE PUSHDOWN POINTER
EOF1:	TLZ	F,SLIBSW+SKIPSW	;CLEAR ONE FILE LIB. SEARCH FLAG
EOF2:	POPJ	P,

;	FORCE SCAN TO COMPLETION, LOAD IF NECESSARY

FSCN:	PUSHJ     P,FSCN1		;FORCED LOAD BEFORE TEST
	TLNN	F,FULLSW		;TEST FOR OVERLAP
	POPJ	P,			;NO OVERLAP, RETURN
	MOVE	W,H 		;FETCH CORE SIZE REQUIRED
	SUBI W,1(S) ; COMPUT DEFICIENCY
	JUMPL     W,EOF2		;JUMP IF NO OVERLAP
	TLO	F,FCONSW		;INSURE TTY OUTPUT
	PUSHJ	P,PRQ			;START WITH ?
	PUSHJ     P,PRNUM0		;INFORM USER
	JSP	A,ERRPT7
	SIXBIT    /WORDS OF OVERLAP#/
	JRST	LD2 		;ERROR RETURN

FSCN1:	IFE HE,<TLON	F,FSW		;SKIP IF NOT FIRST CALL TO FSCN
	TLNN	F,CSW+DSW+ESW	;TEST SCAN FOR COMPLETION
	>;		HAND EYE DOES NOT WANT FORCED SCAN
	POPJ	P,
FSCN2:	PUSHJ     P,LD5B1		;STORE FILE OR EXTENSION IDENT.

;	LOADER CONTROL, NORMAL MODE

LDF:	PUSHJ     P,ILD		;INITIALIZE LOADING

;LOAD SUBROUTINE

LOAD:	MOVEM     P,PDSAV		;SAVE PUSHDOWN POINTER
IFN FAILSW,<	SETZM LFTHSW	;RESET LOAD LEFT HALF FIXUP SW>
LOAD1:	MOVE	P,PDSAV		;RESTORE PUSHDOWN POINTER
LOAD1A:   PUSHJ     P,WORD		;INPUT BLOCK HEADER WORD
	MOVNI     E,400000(W) 	;WORD COUNT - FROM RH OF HEADER
	HLRZ	A,W 		;BLOCK TYPE - FROM LH OF HEADER
IFN FAILSW,<	SKIPN POLSW	;ERROR IF STILL DOING POLISH>
	CAILE     A,DISPL*2+1		;TEST BLOCK TYPE NUMBER
	JRST	LOAD4		;ERROR, ILLEGAL BLOCK TYPE
	TLNE	F,SKIPSW		;BLOCK OK - TEST LOAD STATUS
	JRST	LIB1		;RETURN TO LIB. SEARCH CONTROL
	HRRZ	T,LOAD2(A)		;LOAD RH DISPATCH ENTRY
	CAILE     A,DISPL		;SKIP IF CORRECT
	HLRZ	T,LOAD2-DISPL-1(A)	;LOAD LH DISPATCH ENTRY
	TLNE	F,FULLSW		;TEST CORE OVERLAP INDICATOR
	SOJG	A,HIGH0		;IGNORE BLOCK IF NOT TYPE 1
	JRST	@T			;DISPATCH TO BLOCK SUBROUTINE

;DISPATCH TABLE - BLOCK TYPES

LOAD2:	XWD NAME,LOAD1A
	XWD START,PROG
	XWD LOCD,SYM
IFE FAILSW,<	XWD LOAD4A,LOAD4A
	XWD LOAD4A,LIB3>
IFN FAILSW,<	XWD POLFIX,LOAD4A
	XWD LINK,LIB3>
LOAD3:	XWD LOAD4A,HIGH

	DISPL=LOAD3-LOAD2

;ERROR EXIT FOR BAD HEADER WORDS

LOAD4:	IFE K,<
	CAIN	A,400		;FORTRAN FOUR BLOCK
	JRST	F4LD>
IFN HE,<CAIE A,400
	JRST LOAD4A
	JSP 1,ERRPT
	SIXBIT /FORTRAN#/
	SETOM RESET
	JRST LD2>
LOAD4A:   JSP	A,ERRPT		;INCORRECT HEADER WORD
	SIXBIT    /ILL. FORMAT#/
IFN HE,<SETOM RESET#>
	JRST	LD2

;LOAD PROGRAMS AND DATA (BLOCK TYPE 1)

PROG:	HRRZ	V,W 		;LOAD BLOCK LENGTH
	PUSHJ     P,RWORD		;READ BLOCK ORIGIN
IFN HE,<SETZM SFLAG
	CAIG W,140
	CAIN W,JOBDDT
	JRST PROG2
	SETOM SFLAG
	JSP A,ERRPT
	SIXBIT /ADDRESS CONFLICT#/
PROG2:
	>;	HAND-EYE CANNOT HANDLE CODE BELOW 140 
	ADD	V,W 		;COMPUTE NEW PROG. BREAK
	CAIG	H,@X		;COMPARE WITH PREV. PROG. BREAK
	MOVEI     H,@X		;UPDATE PROGRAM BREAK
		TLNE F,FULLSW
		JRST FULLC	;NO ERROR MESSAGE
	CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<	JRST	[PUSHJ P,XPAND>
			JRST FULLC
IFN EXPAND,<		JRST .-1]>
	MOVE	V,W
PROG1:	PUSHJ     P,RWORD		;READ DATA WORD
IFN HE,<SKIPN SFLAG#>
IFN L,<	CAML V,RINITL	;ABSOLUTE >
	MOVEM     W,@X		;STORE DATA WORD IN PROG. AT LLC
	AOJA	V,PROG1		;ADD ONE TO LOADER LOC. COUNTER

;LOAD SYMBOLS (BLOCK TYPE 2)

SYM:	PUSHJ     P,PRWORD		;READ TWO DATA WORDS
	PUSHJ	P,SYMPT;		PUT INTO TABLE
	JRST	SYM

; WFW SYMPT:	JUMPL	C,SYM3;		JUMP IF GLOBAL REQUEST
SYMPT:	TLNE C,200000	;GLOBAL REQUEST? WFW
	JUMPL C,SYM3	;CHECK FOR 60 NOT JUST HIGH BIT WFW
	TLNE	C,100000
	JRST	SYM1A		;LOCAL SYMBOL
	PUSHJ     P,SREQ		;GLOBAL DEF., SEARCH FOR REQUEST
	JRST	SYM2		;REQUEST MATCHES
	PUSHJ     P,SDEF		;SEARCH FOR MULTIPLE DEFINITIONS
	JRST	SYM1		;MULTIPLY DEFINED GLOBAL
	JRST	SYM1B

;	PROCESS MULTIPLY DEFINED GLOBAL

SYM1:	CAMN	W,2(A)		;COMPARE NEW AND OLD VALUE
	POPJ	P,;
	AOS	MDG		;COUNT MULTIPLY DEFINED GLOBALS
	PUSHJ	P,PRQ		;START W/ ?
	PUSHJ     P,PRNAM		;PRINT SYMBOL AND VALUE
	MOVE	W,2(A)		;LOAD OLD VALUE
	PUSHJ     P,PRNUM		;PRINT OLD VALUE
	JSP	A,ERRPT7		;PRINT MESSAGE
	SIXBIT    /MUL. DEF. GLOBAL#/
	POPJ	P,;	IGNORE MUL. DEF. GLOBAL SYM

;	LOCAL SYMBOL

SYM1A:	TLNN	F,SYMSW+DSYMSW	;SKIP IF LOAD LOCALS SWITCH ON
	POPJ	P,;		IGNORE LOCAL SYMBOLS
SYM1B:	CAIL	H,(S)		;STORE DEFINED SYMBOL
IFN EXPAND,<	PUSHJ P,XPAND7>
IFE EXPAND,<	JRST SFULLC>
SYM1C:	IFE K,<
	TLNE	N,F4SW;		FORTRAN FOUR REQUIRES A BLT
	PUSHJ 	P,MVDWN;	OF THE TABLES>
	MOVEI A,-2(S)	;LOAD A TO SAVE INST. AT SYM2
SYM1D:	SUBI	S,2;		UPDATE UNDEFINED POINTER
	POP	B,2(A)		;MOVE UNDEFINED VALUE POINTER
	POP	B,1(A)		;MOVE UNDEFINED SYMBOL
	MOVEM     W,2(B)		;STORE VALUE
	MOVEM     C,1(B)		;STORE SYMBOL
	POPJ	P,;

;	GLOBAL DEFINITION MATCHES REQUEST

SYM2:	PUSH P,SYM2C	;NEXT MUST BE A SUBROUTINE FOR LATER. SET RETURN
SYM2B:	MOVE	V,2(A)		;LOAD REQUEST POINTER
	PUSHJ P,REMSYM
	JUMPL V,SYM2W	;ADDITIVE REQUEST? WFW
	PUSHJ     P,SYM4A		;REPLACE CHAIN WITH DEFINITION
;WFW PATCH TO LOOK FOR MORE THAN ONE REQUEST
SYM2W1:	PUSHJ P,SREQ	;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
	JRST SYM2B	;FOUND MORE
	MOVE A,SVA	;RESTORE A
;END OF PATCH WFW
SYM2C:	POPJ P,SYM1D	;RETURN, SEE SYM2 FOR USE OF ADDRESS
SVA:	0	;A TEMP CELL WFW

;	REQUEST MATCHES GLOBAL DEFINITION

SYM2A:	MOVE	V,W 		;LOAD POINTER TO CHAIN
	MOVE	W,2(A)		;LOAD VALUE
	JUMPL V,FIXWP	;HANDLE ATTITIVE REQUEST WFW
	JRST	SYM4A;		REPLACE CHAIN WITH DEFINITION

;	PROCESS GLOBAL REQUEST

SYM3:	TLNE	C,040000;		COMMON NAME
	JRST	SYM1B
	TLC	C,640000;		PERMUTE BITS FROM 60 TO 04
	PUSHJ     P,SDEF		;SEARCH FOR GLOBAL DEFINITION
	JRST	SYM2A		;MATCHING GLOBAL DEFINITION
	JUMPL W,SYM3X1	;ADDITIVE FIXUP WFW
	PUSHJ     P,SREQ		;SEARCH FOR EXISTING REQUEST WFW
	JRST	SYM3A		;EXISTING REQUEST FOUND WFW
SYM3X1:	TLNN W,100000	;CHECK SYMBOL TABLE FIXUP
	JRST SYM3X2	;NO
	MOVE V,1(B)	;MUST BE LAST SYMBOL DEFINED. GET SYMBOL
	XOR V,W		;CHECK FOR IDENTITY
	TDNE V,[XWD 77777,-1]	;BUT IGNORE HIGH 3 BITS
	POPJ P,		;NOT SAME, ASSUME NOT LOADED LOCAL
	HRRI W,2(B)	;GET LOCATION IN RIGHT HALF
	TLO W,1
	SUB W,JOBREL	;AND MAKE RELATIVE
IFN FAILSW,<	TLZ W,40000>
SYM3X2:	CAIL	H,(S)		;STORE REQUEST IN UNDEF. TABLE WFW
IFN EXPAND,<	PUSHJ P,XPAND7>
IFE EXPAND,<	JRST SFULLC>
SYM3X:	IFE K,<
	TLNE	N,F4SW;		FORTRAN FOUR
	PUSHJ	P,MVDWN;		ADJUST TABLES IF F4>
	SUB	S,SE3		;ADVANCE UNDEFINED POINTER
	MOVEM     W,2(S)		;STORE UNDEFINED VALUE POINTER
	MOVEM     C,1(S)		;STORE UNDEFINED SYMBOL
	POPJ	P,;

;	COMBINE TWO REQUEST CHAINS

SYM3A:	SKIPL 2(A)	;IS IT ADDITIVE WFW
	JRST SYM3A1	;NO, PROCESS WFW
	PUSHJ P,SDEF2	;YES, CONTINUE WFW
	JRST SYM3A	;FOUND ANOTHER WFW
	JRST SYM3X2	;REALLY NO CHAIN THERE WFW
SYM3A1:	SUBI A,-2(X)  ;A=A-(-2+X(18-35)); A RELATIVE TO X WFW
SYM3B:	HRRZ V,A       ; SAVE CHAIN ADDRESS FOR HRRM W,@X
IFN L,<	CAMGE V,RINITL
	HALT	;LOSE LOSE LOSE>
	HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
	JUMPN A,SYM3B  ; JUMP IF NOT THE LAST ADDR. IN CHAIN
	HRRM	W,@X		;COMBINE CHAINS
	POPJ	P,;
;LHQ PATCH FOR LISP ABSOLUTE FIXUP PREVENTION
IFN L,<
VTST:	0
	MOVEM V,VSVV#
	HRRZS V
	CAMGE V,RINITL
	POPJ P,
	MOVE V,VSVV
	JRST @VTST>

;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS

FIXWP:	TLNN V,100000	;CHECK FOR SYMBOL TABLE FIXUP
	JRST FIXW
	MOVE T,1(B)	;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED
	XOR T,V		;CHECK FOR SAME
	TDNE T,[XWD 77777,-1]	;EXCEPT FOR HEGH CODE BITS
	POPJ P,		;ASSUME NON-LOADED LOCAL
	HRRI V,2(B)	;GET LOCATION
	SUBI V,(X)	;SO WE CAN USE @X
FIXW:	TLNE V,200000	;IS IT LEFT HALF
	JRST FIXWL
IFN L,<	JSR VTST>
	MOVE T,@X	;GET WORD
	ADD T,W		;VALUE OF GLOBAL
	HRRM T,@X	;FIX WITHOUT CARRY
	MOVSI D,200000	;SET UP TO REMOVE DEFERED INTERNAL IF THERE
	JRST SYMFIX
FIXWL:	HRLZ	T,W		;UPDATE VALUE OF LEFT HALF
IFN L,<	JSR VTST>
	ADDM	T,@X		;BY VALUE OF GLOBAL
	MOVSI D,400000	;LEFT DEFERED INTERNAL
SYMFIX:	TLNN V,100000	;CHECK FOR SYMBOL TABLE FIXUP
	POPJ P,		;NO, RETURN
	ADDI V,(X)	;GET THE LOCATION
	MOVE T,-1(V)	;GET THE SYMBOL NAME
	TLNN T,40000	;CHECK TO SEE IF INTERNAL
	POPJ P,		;NO, LEAVE
	ANDCAB D,-1(V)	;REMOVE PROPER BIT
	TLNE D,600000	;IS IT STILL DEFERED?
	POPJ P,		;YES, ALL DONE
	EXCH C,D	;NO, CHECK FOR A REQUEST FOR IT
	PUSHJ P,SREQ
	JRST CHNSYM	;YES, WILL HAVE TO CALL THE FIXUP ROUTINE
	MOVE C,D	;GET C BACK
	POPJ P,
CHNSYM:	PUSH P,D	;HAS THE OLD C IN IT
	PUSH P,W	;WE MAY NEED IT LATER
	MOVE W,(V)	;GET VALUE
	PUSHJ P,SYM2B	;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE
	POP P,W
	POP P,C		;RESTORE FOR CALLER
	POPJ P,		;AND GO AWAY

SYM2W:	IFN FAILSW,<	TLNE V,40000	;CHECK FOR POLISH
	JRST POLSAT>
	TLNN V,100000	;SYMBOL TABLE?
	JRST SYM2WA
	ADD V,JOBREL	;MAKE ABSOLUTE
	SUBI V,(X)	;GET READY TO ADD X
	SYM2WA:	PUSHJ P,FIXW	;DO FIXUP
	JRST SYM2W1	;AND LOOK FOR MORE REQUESTS

;END WFW PATCH

;PATCH VALUES INTO CHAINED REQUEST
SYM4:
IFN L,<	CAMGE V,RINITL
	POPJ P,>
	HRRZ	T,@X		;LOAD NEXT ADDRESS IN CHAIN
	HRRM	W,@X		;INSERT VALUE INTO PROGRAM
	MOVE	V,T
SYM4A:	JUMPN     V,SYM4		;JUMP IF NOT LAST ADDR. IN CHAIN
	POPJ	P,

IFE	K,<
MVDWN:	HRRZ T,MLTP
IFN EXPAND,<	SUBI T,2>
	CAIG	T,@X;		ANY ROOM LEFT?
IFN EXPAND,<	JRST	[PUSHJ P,XPAND>
			TLOA F,FULLSW
IFN EXPAND,<		JRST MVDWN
			JRST .+2]>
	TLNE	F,SKIPSW+FULLSW
	JRST 	MVABRT;	ABORT BLT
	HRREI	T,-2
	ADDM	T,PLTP;		ADJUST PROGRAMMER LABEL POINTER
	ADDM	T,BITP;		AND BIT TABLE POINTER
	ADDM	T,SDSTP;	FIRST DATA STATEMENT
	ADDM	T,LTC
	ADDM	T,ITC
	TLNE	N,SYDAT
	ADDM	T,V
	ADDB	T,MLTP;		AND FINALLY TO MADE LABEL TABLE
	HRLS	T;		SET UP BLT POINTER
	ADD	T,[XWD 2,0]
	BLT	T,(S)
MVABRT:	POPJ	P,;
>
;HIGHEST RELOCATABLE POINT (BLOCK TYPE 4)
SFULLC:	TLOE	F,FULLSW	;PREVIOUS OVERFLOW?
	JRST	FULLC		;YES, DON'T PRINT MESSAGE
	JSP	A,ERRPT		;NO, COMPLAIN ABT OVERFLO
	SIXBIT	?SYMBOL TABLE OVERLAP#?
FULLC:	TLO	F,FULLSW	;CORE OVERLAP ERROR RETURN
IFE K,<	TLNE	N,F4SW
	POPJ	P,>
	JRST	LIB3		;LOOK FOR MORE

HIGH0:	CAIE A,4  ; TEST FOR END BLOCK (OVERLAP)
	JRST	LIB3
HIGH:	PUSHJ     P,PRWORD		;READ TWO DATA WORDS
	HRR	R,C 		;SET NEW PROGRAM BREAK
	ADDI	C,X;	BE SURE TO RELOCATE
	CAILE	C,1(S)		;TEST PROGRAM BREAK
IFN EXPAND,<PUSHJ P,[	PUSHJ P,XPAND
			TLOA F,FULLSW
			JRST POPJM2
			POPJ	P,]>
IFE EXPAND,<TLO	F,FULLSW>
HIGH3:	MOVEI	A,F.C		;SAVE CURRENT STATE OF LOADER
	BLT	A,B.C
	TLNE	F,SLIBSW+LIBSW	;NORMAL MODE EXIT THROUGH LOAD1
	JRST	LIB 		;LIBRARY SEARCH EXIT
	JRST LOAD1

;STARTING ADDRESS (BLOCK TYPE 7)

START:	PUSHJ     P,PRWORD		;READ TWO DATA WORDS
	TLNN	N,ISAFLG		;SKIP IF IGNORE SA FLAG ON
	HRR	F,C 		;SET STARTING ADDRESS
IFN STANSW,<MOVE W,1(N)	;SET UP NAME OF THIS PROGRAM
	PUSHJ P,LDNAM>

;PROGRAM NAME (BLOCK TYPE 6)

NAME:	PUSHJ     P,PRWORD		;READ TWO DATA WORDS
	TLOE	N,COMFLG		;SKIP IF COMMON NOT PREV. SET
	JRST	NAME1		;SIZE OF COMMON PREV. SET
	MOVEM     W,COMSAV		;STORE LENGTH OF COMMON
	JUMPE     W,NAME2		;JUMP IF NO COMMON IN THIS JOB
	HRRI	R,@R		;FIRST PROGRAM SET LOAD ORIGIN
NAME1:	CAILE H,-1(S)		;TEST FOR AVAIL. SYMBOL SPACE
IFN EXPAND,<	PUSHJ P,XPAND7>
IFE EXPAND,<	JRST SFULLC>
	SUBI	S,2 		;UPDATE UNDEF. TABLE POINTER
	POP	B,2(S)
	POP	B,1(S)
	HRRZ	V,N 		;POINTER TO PREVIOUS NAME
	SUBM	B,V 		;COMPUTE RELATIVE POSITIONS
	HRLM	V,2(N)		;STORE FORWARD POINTER
	HRR	N,B 		;UPDATE NAME POINTER
NAME2:	MOVEM     C,1(B)		;STORE PROGRAM NAME
	HRRZM	R,2(B)		;STORE PROGRAM ORIGIN
	CAMG	W,COMSAV		;CHECK COMMON SIZE
	JRST	LIB3		;COMMON OK
ILC:	JSP	A,ERRPT
	SIXBIT    /ILL. COMMON#/
IFN HE,<SETOM RESET>
	JRST	LD2
IFN FAILSW,<
LINK:	PUSHJ P,PRWORD	;GET TWO WORDS
	JUMPLE C,ENDLNK	;THIS IS AN END OF LINK WORD
	CAILE C,20	;IS IT IN RANGE?
	JRST LOAD4A
	HRRZ V,W	;GET THE ADDRESS
	HRRZ W,LINKTB(C)	;GET CURRENT LINK
IFN L,<	CAML V,RINITL	;LOSE>
	HRRM W,@X	;PUT INTO CORE
	HRRM V,LINKTB(C)	;SAVE LINK FOR NEXT ONE
	JRST LINK	;GO BACK FOR MORE
ENDLNK:	MOVNS C		;GET ENTRY NUMBER
	JUMPE C,LOAD4A	;0 IS A LOSER
	CAILE C,20	;CHECK RANGE
	JRST LOAD4A
	HRLM W,LINKTB(C)	;SAVE END OF LINK INFO
	JRST LINK	;MORE>
;ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)

			;PMP PATCH FOR LEFT HALF FIXUPS
IFN FAILSW,<
LOCDLH:
IFN L,<	CAMGE V,RINITL
	JRST .+3>
	HLRZ T,@X	;LOAD NEXT ADDRESS IN CHAIN
	HRLM W,@X	;INSERT VALUE INTO PROGRAM
	MOVE V,T
LOCDLF:	JUMPN V,LOCDLH	;JUMP IF NOT LAST ADDR. IN CHAIN
	POPJ P,
LOCDLI:	PUSHJ P,LOCDLF
	AOSA LFTHSW	;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP
LOCDLG:	SETOM LFTHSW	;TURN ON LEFT HALF FIX SW>
			;END PMP PATCH
LOCD:	PUSHJ     P,RWORD		;READ ONE DATA WORD
	HLRZ	V,W 		;STORAGE POINTER IN LEFT HALF
IFN FAILSW,<	SKIPE LFTHSW#	;LEFT HALF CHAINED? PMP
		JRST LOCDLI	;YES PMP
		CAMN W,[-1]	;LEFT HALF NEXT? PMP
		JRST LOCDLG	;YES, SET SWITCH PMP>
	PUSHJ     P,SYM4A		;LINK BACK REFERENCES
	JRST	LOCD
IFN STANSW,<
LDNAM:	MOVE T,[POINT 6,CURNAM]	;POINTER
	MOVNI D,6	;SET COUNT
	TLZ W,740000	;REMOVE CODE BITS
SETNAM:	IDIVI W,50	;CONVERT FROM RAD 50
	HRLM C,(P)
	AOSGE D
	PUSHJ P,SETNAM
	HLRZ C,(P)
	JUMPE C,INAM
	ADDI C,17
	CAILE C,31
	ADDI C,7
	CAILE C,72
	SUBI C,70
	CAIN C,3
	MOVEI C,16
INAM:	IDPB C,T
	POPJ P,	>
IFN FAILSW,<
;POLISH FIXUPS <BLOCK TYPE 11>

PDLOV:	SKIPE POLSW	;PDL OV ARE WE DOING POLISH?
	JRST COMPOL	;YES
	JSP A,ERRPT
	SIXBIT /PUSHDOWN OVERFLOW#/
IFN HE,<SETOM RESET>
	JRST LD2
COMPOL:	JSP A,ERRPT
	SIXBIT /POLISH TOO COMPLEX#/
IFN HE,<SETOM RESET>
	JRST LD2


;READ A HALF WORD AT A TIME

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


POLFIX:	MOVE D,[IOWD PPDL,PPDB]	;SET UP THE POLISH PUSHDOWN LIST
	MOVEI V,100	;IN CASE OF ON OPERATORS
	MOVEM V,SVSAT
	SETOM POLSW	;WE ARE DOING POLISH
	TLO N,HSW	;FIX TO READ A WORD THE FIRST TIME
	SETOM GLBCNT#	;NUMBER OF GLOBALS IN THIS FIXUP
	SETOM OPNUM#	;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP
	PUSH D,[15]	;FAKE OPERATOR SO STORE WILL NOT HACK

RPOL:	PUSHJ P,RDHLF	;GET A HLAF WORD
	TRNE W,400000	;IS IT A STORE OP?
	JRST STOROP	;YES, DO IT
	CAIGE W,3	;0,1,2 ARE OPERANDS
	JRST OPND
	CAILE W,14	;14 IS HIGHEST OPERATOR
	JRST LOAD4A	;ILL FORMAT
	PUSH D,W	;SAVE OPERATOR IN STACK
	MOVE V,DESTB-3(W)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM V,SVSAT#	;ALSO SAVE IT
	JRST RPOL	;BACK FOR MORE

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

OPND:	MOVE A,W	;GET THE OPERAND TYPE HERE
	PUSHJ P,RDHLF	;THIS IS AT LEAST PART OF THE OPERAND
	MOVE C,W	;GET IT INTO C
	JUMPE A,HLFOP	;0 IS HALF-WORD OPERAND
	PUSHJ P,RDHLF	;NEED FULL WORD, GET SECOND HALF
	HRL C,W	;GET HALF IN RIGHT PLACE
	MOVSS C		;WELL ALMOST RIGHT
	SOJE A,HLFOP	;1 IS FULL WORD, 2 IS GLOBAL REQUEST
	PUSHJ P,SDEF	;SEE IF IT IS ALREADY DEFINED
	JRST 	[MOVE C,2(A)	;YES, WE WIN
		JRST HLFOP]
	AOSN GLBCNT	;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
	AOS HEADNM	;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
	AOS W,OPNUM	;GET AN OPERAND NUMBER
	LSH W,4		;SPACE FOR TYPE
	IORI W,2	;TYPE 2 IS GLOBAL 
	HRL W,HEADNM	;GET FIXUP NUMBER
	PUSHJ P,SYM3X2	;AND PUT INTO UDEFINED AREA ALONG WITH NAME
	MOVE C,W	;ALSO PUT THAT PART OF THE FIXUP IN
	PUSHJ P,SYM3X2
	SKIPA A,[400000]	;SET UP GLOBAL FLAG
HLFOP:	MOVEI A,0	;VALUE OPERAND FLAG
HLFOP1:	SOJL V,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

;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,W
	POP D,W		;VALUE OR GLOBAL NAME
UNOP:	POP D,V		;OPERATOR
	JUMPN A,GLOB	;IF EITHER IS A GLOBAL HANDLE SPECIALLY
	XCT OPTAB-3(V)	;IF BOTH VALUES JUST XCT
	MOVE C,W	;GET THE CURRENT VALUE
SETSAT:	SKIPG V,(D)	;IS THERE A VALUE IN THE STACK
	MOVE V,-2(D)	;YES, THIS MUST BE THE OPERATOR
	MOVE V,DESTB-3(V)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM V,SVSAT	;SAVE IT HERE
	SKIPG (D)	;WAS THERE AN OPERAND
	SUBI V,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 PUT THIS VALUE INTO THE FIXUP LIST
	PUSH P,W	;SAVE FOR A WHILE
	MOVE W,C	;THE VALUE
	AOS C,OPNUM	;GET AN OPERAND NUMBER
	LSH C,4		;AND PUT IN TYPE
	IORI C,2	;VALUE TYPE
	HRL C,HEADNM	;THE FIXUP NUMBER
	PUSHJ P,SYM3X2
	POP P,W		;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	;SAVE THE FIRST OPERAND
	AOS C,OPNUM	;SEE ABOVE
	LSH C,4
	IORI C,2
	HRL C,HEADNM
	PUSHJ P,SYM3X2
	MOVE W,C
	POP P,C

GLSET:	EXCH C,W	;GET THEM IN THE OTHER ORDER
	HRL W,C		;SET UP THE OPERATOR LINK
	AOS C,OPNUM
	LSH C,4	;SPACE FOR THYPE
	IOR C,V		;THE OPERATOR
	HRL C,HEADNM
	PUSHJ P,SYM3X2	;INTO THE UNDEF LIST
	MOVEI A,400000	;SET UP AS A GLOBAL VALUE
	JRST SETSAT	;AND SET UP FOR NEXT OPERATOR

;FINALLY WE GET TO STORE THIS MESS

STOROP:	MOVE T,-2(D)	;THIS SHOULD BE THE FAKE OPERATOR
	CAIE T,15	;IS IT
	JRST LOAD4A	;NO, ILL FORMAT
	HRRZ T,(D)	;GET THE VALUE TYPE
	JUMPN T,GLSTR	;AND TREAT GLOBALS SPECIAL
	MOVE A,W	;THE TYPE OF STORE OPERATOR
	PUSHJ P,RDHLF	;GET THE ADDRESS
	MOVE V,W	;SET UP FOR FIXUPS
	POP D,W		;GET THE VALUE
	POP D,W		;AFTER IGNORING THE FLAG
	PUSHJ P,@STRTAB+3(A)	;CALL THE CORRECT FIXUP ROUTINE
COMSTR:	SETZM POLSW	;ALL DONE WITH POLISH
	MOVE T,OPNUM	;CHECK ON SIZES
	MOVE V,HEADNM
	CAIG V,477777
	CAILE T,37777
	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

STRTAB:	EXP ALSTR,LOCDLF,SYM4A

GLSTR:	MOVEI A,20(W)	;CONVERT TO OPERATOR 15-17
	PUSHJ P,RDHLF	;GET THE STORE LOCATION
	POP D,V		;GET VALUE
	POP D,V
	HRLM V,W	;SET UP STORAGE ELEMENT
	AOS C,OPNUM
	LSH C,4
	IOR C,A
	HRL C,HEADNM
	PUSHJ P,SYM3X2
	MOVE W,C	;NOW SET UP THE HEADER
	AOS V,GLBCNT	;WHICH HAS NUMBER OF GLOBALS
	HRLM V,W
	HRRZ C,HEADNM
	PUSHJ P,SYM3X2
	JRST COMSTR	;AND FINISH

ALSTR1:
IFN L,<	CAMGE V,RINITL
	POPJ P,>
	HRRZ T,@X
	MOVEM W,@X	;FULL WORD FIXUPS
	MOVE V,T
ALSTR:	JUMPN V,ALSTR1
	POPJ P,
DESTB:	EXP 1,1,1,1,1,1,1,1,0,0,100

OPTAB:	ADD W,C
	SUB W,C
	IMUL W,C
	IDIV W,C
	AND W,C
	IOR W,C
	LSH W,(C)
	XOR W,C
	SETCM W,C
	MOVN W,C
	REPEAT 3,<JRST STRSAT>


POLSAT:	PUSH P,C	;SAVE SYMBOL
	MOVE C,V	;POINTER
	PUSHJ P,SREQ	;GO FIND IT
	SKIPA
	JRST LOAD4A	;SOMETHING IS ROTTEN IN DENMARK
	MOVEM W,2(A)	;STORE VALUE
	HLRZS C		;NOW FIND HEADER
	PUSHJ P,SREQ
	SKIPA
	JRST LOAD4A
	HRLZI V,-1	;AND DECREMENT COUNT
	ADDB V,2(A)
	TLNN V,-1	;IS IT NOW 0
	JRST PALSAT	;YES, GO DO POLISH
	POP P,C		;RESTORE SYMBOL
	JRST SYM2W1	;AND RETURN

PALSAT:	PUSH P,W	;SAVE VALUE
	MOVEM C,HDSAV#	;SAVE THE HEADER NUMBER
	MOVE D,[IOWD PPDL,PPDB]	;SET UP A PDL
	MOVE C,V	;GET THE POINTER
	HRL C,HDSAV	;AND THE FIXUP NUMBER
	PUSHJ P,REMSYM	;REMOVE THE HEADER FORM EXISTANCE
	PUSHJ P,SREQ	;GO FINE THE NEXT LINK
	SKIPA
	JRST LOAD4A	;LOSE
	ANDI C,17	;GET OPERATOR TYPE
	HRRZ V,2(A)	;PLACE TO STORE
	PUSH D,V
	PUSH D,[XWD 400000,0]
	PUSH D,C	;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE
	HLRZ C,2(A)	;GET POINTER TO POLISH CHAIN
PSAT1:	PUSHJ P,REMSYM	;REMOVE SYMBOL

PSAT2:	HRL C,HDSAV	;GET FIXUP NUMBER
	PUSHJ P,SREQ	;LOOK FOR IT
	SKIPA
	JRST LOAD4A
	ANDI C,17	;THE OPERATOR NUMBER
	CAIN C,2	;IS IT AN OPERAND?
	JRST PSOPD	;YES, GO PROCESS
	PUSH D,C	;YES STORE IT
	SKIPN DESTB-3(C)	;IS IT UNARY
	JRST PSUNOP	;YES
	HLRZ C,2(A)	;GET FIRST OPERAND
	HRLI C,600000	;AND MARK AS VALUE
	PUSH D,C
PSUNOP:	HRRZ C,2(A)	;OTHER OPERAND
	JRST PSAT1	;AND AWAY WE GO

PSOPD:	MOVE C,2(A)	;THIS IS A VALUE
	PUSHJ P,REMSYM	;GET RID OF THAT PART OF THE CHAIN
PSOPD1:	SKIPG V,(D)	;IS THERE A VALUE IN THE STACK
	JRST PSOPD2	;YES, TAKE GOOD CARE OF IT
COMOP:	POP D,V		;NO, GET THAT OPERATOR OUT OF THERE
	XCT OPTAB-3(V)	;AND DO IT
	MOVE C,W	;GET RESULT IN RIGHT PLACE
	JRST PSOPD1	;AND TRY FOR MORE
PSOPD2:	TLNE V,200000	;IS IT A POINTER
	JRST DBLOP	;YES, NEEDS MORE WORK
	MOVE W,C	;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W
	POP D,C		;VALUE POINTER
	POP D,C		;2ND OPERAND INTO C
	JRST COMOP	;GO PROCESS OPERATOR

DBLOP:	EXCH C,(D)	;PUT VALUE IN STACK AND RETRIEV POINTER
	PUSH D,[XWD 400000,0]	;MARK AS VALUE
	JRST PSAT2	;AND GO LOOK FOR MORE TROUBLE

STRSAT:	MOVE W,C	;GET VALUE TO STORE IN W
	MOVE C,V	;GET OPERATOR HERE
	POP D,V
	POP D,V		;GET ADDRESS TO STORE
	PUSHJ P,@STRTAB-15(C)
	POP P,W	;RESTORE THINGS
	POP P,C
	JRST SYM2W1

PPDB:	BLOCK PPDL+1>

REMSYM:	MOVE T,1(S)
	MOVEM T,1(A)
	MOVE T,2(S)
	MOVEM T,2(A)
	ADD S,SE3
	MOVEM A,SVA
	POPJ P,

;SYMBOL TABLE SEARCH SUBROUTINES

;	ENTERED WITH SYMBOL IN C
;	RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND
;	OTHERWISE, A SKIP ON RETURN OCCURS

SREQ:	JUMPGE    S,CPOPJ1		;JUMP IF NO UNDEF. SYMBOLS
	SKIPA     A,S 		;LOAD REQUEST SEARCH POINTER
SDEF:	MOVE	A,B 		;LOAD DEF. SYMBOL SEARCH POINTER
SDEF1:	CAMN	C,1(A)
	POPJ	P,			;SYMBOLS MATCH, RETURN
SDEF2:	ADD	A,SE3
	JUMPL     A,SDEF1
IFE K,<	JRST	CPOPJ1		;SYMBOL NOT FOUND SKIPS ON RETURN>
IFN K,<
CPOPJ1:	AOS	(P)		;TRA 2,4
	POPJ	P,		;...>

;RELOCATION AND BLOCK INPUT

PRWORD:   PUSHJ     P,RWORD		;READ A WORD PAIR
	MOVE	C,W 		;LOAD C WITH FIRST DATA WORD
	TRNE	E,377777		;TEST FOR END OF BLOCK
	JRST	RWORD1		;INPUT SECOND WORD OF PAIR
	MOVEI     W,0 		;NO SECOND WORD, ASSUME ZERO
	POPJ	P,

RWORD:	TRNN	E,377777		;TEST FOR END OF BLOCK
	JRST	LOAD1		;RETURN TO LOAD THE NEXT BLOCK
RWORD1:   AOBJN     E,RWORD2		;JUMP IF DATA WORD NEXT
	PUSHJ     P,WORD		;READ CONTROL WORD
	MOVE	Q,W 		;DON'T COUNT RELOCATION WORDS
	HRLI	E,-22		;SET RELOCATION WORD BYTE COUNT
RWORD2:   PUSHJ     P,WORD		;READ INPUT WORD
	JUMPGE    Q,RWORD3		;TEST LH RELOCATION BIT
	HRLZ	T,R
	ADD	W,T 		;LH RELOCATION
RWORD3:   TLNE	Q,200000		;TEST RH RELOCATION BIT
	HRRI	W,@R		;RH RELOCATION
	LSH	Q,2
	POPJ	P,

;PRINT STORAGE MAP SUBROUTINE

PRMAP:	PUSHJ	P,FSCN1	;LOAD OTHER FILES FIRST
	PUSHJ	P,CRLFLF	;START NEW PAGE
	HRRZ	W,R
	PUSHJ     P,PRNUM0
	JSP	A,ERRPT7
	SIXBIT	?IS THE PROGRAM BREAK@?
	PUSHJ	P,CRLF		;START STORAGE MAP
	JSP	A,ERRPT0	;PRINT HEADER
	SIXBIT	?STORAGE MAP@?
	HLRE	A,B
	MOVNS     A
	ADDI	A,(B)
PRMAP1:   SUBI	A,2
	SKIPL     C,1(A)		;LOAD SYMBOL, SKIP IF DELETED
	TLNE	C,300000		;TEST FOR LOCAL SYMBOL
	JRST	PRMAP4		;IGNORE LOCAL SYMBOLS
	TLNN	C,040000
	PUSHJ     P,CRLF		;PROGRAM NAME
	PUSHJ     P,PRNAM1		;PRINT SYMBOL AND VALUE
	TLNE	C,040000
	JRST	PRMAP3		;GLOBAL SYMBOL
	HLRE	C,W 		;POINTER TO NEXT PROG. NAME
	JUMPGE    C,PRMAP2		;JUMP IF LAST PROGRAM NAME
	ADDI	C,2(A)		;COMPUTE LOC. OF FOLLOWING NAME
	SKIPA     T,@C		;LOAD ORIGIN OF FOLLOWING PROG.
PRMAP2:   HRRZ	T,R 		;LOAD PROGRAM BREAK
	SUBM	T,W 		;SUBTRACT ORIGIN TO GET LENGTH
	PUSHJ     P,PRNUM		;PRINT PROGRAM LENGTH
	PUSHJ     P,CRLF
	TLNN	N,ALLFLG		;SKIP IF LIST ALL MODE IS ON
	TRNE	W,777777		;SKIP IF ZERO LENGTH PROGRAM
	JRST	PRMAP3
	JUMPE     C,PRMAP5		;JUMP IF LAST PROGRAM
	SKIPA     A,C 		;SKIP GLOBALS, ZERO LENGTH PROG.
PRMAP3:   PUSHJ     P,CRLF
PRMAP4:   CAILE     A,(B)		;TEST FOR END OF SYMBOL TABLE
	JRST	PRMAP1
PRMAP5:

;LIST UNDEFINED GLOBALS

PMS:	PUSHJ	P,FSCN1	;LOAD FILES FIRST
	JUMPGE	S,PMS3		;JUMP IF NO UNDEFINED GLOBALS
	HLLOS 42		;SET SOME ERROR TO ABORT EXECUTION
	PUSHJ	P,FCRLF		;START THE MESSAGE
	PUSHJ	P,PRQ		;PRINT ?
	HLRE	W,S 		;COMPUTE NO. OF UNDEF. GLOBALS
	MOVMS     W
	LSH	W,-1		;<LENGTH OF LIST>/2
	PUSHJ     P,PRNUM0
	JSP	A,ERRPT7
	SIXBIT    /UNDEFINED GLOBALS@/
	MOVE	A,S 		;LOAD UNDEF. POINTER
PMS2:	PUSHJ     P,CRLF
	PUSHJ	P,PRQ		;PRINT ?
	PUSHJ     P,PRNAM0		;PRINT SYMBOL AND POINTER
	ADD	A,SE3
	JUMPL     A,PMS2
	PUSHJ	P,CRLF		;SPACE AFTER LISTING

;LIST NUMBER OF MULTIPLY DEFINED GLOBALS

PMS3:	SKIPN	W,MDG		;ANY MULTIPLY DEFINED GLOBALS
	JRST	PMS4		;NO, EXCELSIOR
	HLLOS 42		;ANOTHER WAY TO LOSE
	PUSHJ	P,FCRLF		;ROOM AT THE TOP
	PUSHJ	P,PRQ		;PRINT ?
	PUSHJ	P,PRNUM0	;NUMBER OF MULTIPLES
	JSP	A,ERRPT7	;REST OF MESSAGE
	SIXBIT	?MULTIPLY DEFINED GLOBALS@?
PMS4:	TLNE	N,AUXSWE	;AUXILIARY OUTPUT DEVICE?
	OUTPUT	2,		;INSURE A COMPLETE BUFFER
	POPJ	P,		;RETURN

;ENTER FILE ON AUXILIARY OUTPUT DEVICE

IAD2:	ENTER	2,DTOUT		;WRITE FILE NAME IN DIRECTORY
	JRST	IMD3		;NO MORE DIRECTORY SPACE
	POPJ	P,

IMD3:	JSP	A,ERRPT		;DIRECTORY FULL ERROR
	SIXBIT    /DIR. FULL@/
	JRST	LD2

;PRINT THE 6 DIGIT OCTAL ADDRESS IN W

;	ACCUMULATORS USED: D,T,V

PRNAM0:   MOVE	C,1(A)		;LOAD SYMBOL
PRNAM1:   MOVE	W,2(A)		;LOAD VALUE
PRNAM:	PUSHJ     P,PRNAME
PRNUM:	PUSHJ     P,SPACES
PRNUM0:   MOVE	V,PRNUM2		;LOAD BYTE POINTER TO RH. OF W
	MOVNI     D,6 		;LOAD CHAR. COUNT
PRNUM1:   ILDB	T,V 		;LOAD DIGIT TO BE OUTPUT
	ADDI	T,60		;CONVERT FROM BINARY TO ASCII
	PUSHJ     P,TYPE2
	AOJL	D,PRNUM1		;JUMP IF MORE DIGITS REMAIN
	POPJ	P,

PRNUM2:   XWD	220300,W

;YE OLDE RECURSIVE NUMBER PRINTER
;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T

RCNUM:	IDIVI Q,12		;RADIX DECIMAL
	ADDI A,"0"
	HRLM A,(P)
	SKIPE Q
	PUSHJ P,RCNUM
	HLRZ T,(P)
	JRST TYPE2

;PRINT FOUR SPACES

SPACES:   PUSHJ     P,SP1
SP1:	PUSHJ     P,SPACE
SPACE:	MOVEI     T,40
	JRST	TYPE2

;SYMBOL PRINT - RADIX 50

;	ACCUMULATORS USED: D,T

PRNAME:   MOVE	T,C 		;LOAD SYMBOL
	TLZ	T,740000		;ZERO CODE BITS
	MOVNI     D,6 		;LOAD CHAR. COUNT
SPT:	IDIVI     T,50		;THE REMAINDER IS THE NEXT CHAR.
	HRLM	V,(P)		;STORE IN LH. OF PUSHDOWN LIST
	AOSGE     D			;SKIP IF NO CHARS. REMAIN
	PUSHJ     P,SPT		;RECURSIVE CALL FOR NEXT CHAR.
	HLRZ	T,(P)		;LOAD FROM LH. OF PUSHDOWN LIST
	JUMPE     T,TYPE		;BLANK
	ADDI	T,60-1
	CAILE     T,71
	ADDI	T,101-72
	CAILE     T,132
	SUBI	T,134-44
	CAIN	T,43
	MOVEI     T,56
	JRST	TYPE2
;PRINT A WORD OF SIXBIT CHARACTERS IN AC W

;	ACCUMULATORS USED: Q,T,D

PWORD:	MOVNI     Q,6 		;SET CHARACTER COUNT TO SIX
PWORD1:   MOVE	D,LSTPT		;ENTER HERE WITH Q PRESET
PWORD2:   ILDB	T,D 		;LOAD NEXT CHAR. TO BE OUTPUT
	PUSHJ     P,TYPE		;OUTPUT CHARACTER
	AOJL	Q,PWORD2
	POPJ	P,

;ERROR MESSAGE PRINT SUBROUTINE

;	FORM OF CALL:

;	JSP	A,ERRPT
;	SIXBIT    /<MESSAGE>/

;	ACCUMULATORS USED: T,V,C,W

ERRPT:	TLO	F,FCONSW	;INSURE TTY OUTPUT
	PUSHJ	P,CRLF		;ROOM AT THE TOP
	PUSHJ	P,PRQ		;START OFF WITH ?
ERRPT0:   PUSH	P,Q 		;SAVE Q
	SKIPA     V,ERRPT5
ERRPT1:   PUSHJ     P,TYPE
	ILDB	T,V
	CAIN	T,40
	JRST	ERRPT4
	CAIN	T,5
	JRST	ERRPT9
	CAIE	T,3
	JRST	ERRPT1
	SKIPN     C,DTIN
	JRST	ERRPT4
	MOVNI     Q,14
	MOVEI     W,77
ERRPT2:   TDNE	C,W
	JRST	ERRPT3
	LSH	W,6
	AOJL	Q,ERRPT2
ERRPT3:   MOVE	W,ERRPT6
	PUSHJ     P,PWORD1
	SKIPN     W,DTIN1
	JRST	ERRPT4
	LSH	W,-6
	TLO	W,160000
	MOVNI     Q,4
	PUSHJ     P,PWORD1
ERRPT4:   PUSHJ     P,CRLF
ERRP41:	POP	P,Q
	TLZ	F,FCONSW	;ONE ERROR PER CONSOLE
	AOS	V		;PROGRAM BUMMERS BEWARE:
	JRST	@V		;V HAS AN INDEX OF A

ERRPT5:   POINT     6,0(A)
ERRPT6:   SIXBIT    / FILE /

ERRPT8:	TLO	F,FCONSW	;INSURE TTY OUTPUT
	PUSHJ	P,PRQ		;START WITH ?
	CAIGE	T,140		;IS IT A NON-PRINTING CHAR?
	CAIL	T,40
	JRST	ERRP8
	PUSH	P,T
	MOVEI     T,136		;UP ARROW
	PUSHJ     P,TYPE2
	POP	P,T
	ADDI	T,100		;CONVERT TO PRINTING CHAR.
ERRP8:	PUSHJ     P,TYPE2
ERRPT7:   PUSHJ     P,SPACE
	JRST	ERRPT0

ERRPT9:   MOVEI     V,@V
	PUSH	P,V
	JSP	A,ERRPT7
	SIXBIT	?ILLEGAL -LOADER@?
	POP	P,V
	JRST	ERRP41

;PRINT QUESTION MARK

PRQ:	PUSH	P,T		;SAVE
	MOVEI	T,"?"		;PRINT ?
	PUSHJ	P,TYPE2		;...
	POP	P,T		;RESTORE
	POPJ	P,		;RETURN

;INPUT - OUTPUT INTERFACE

;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W
IFE K,<
WORDPR:	PUSHJ	P,WORD		;GET FIRST WORD OF PAIR
	MOVE	C,W		;KEEP IT HANDY>
WORD:	SOSG	BUFR2		;SKIP IF BUFFER NOT EMPTY
	JRST	WORD2
WORD1:	ILDB	W,BUFR1		;PICK UP 36 BIT WORD
	POPJ	P,

WORD2:	INPUT     1,			;GET NEXT BUFFER LOAD
	STATUS    1,W 		;GET DEVICE STATUS FROM MONITOR
	TRNE	W,IODEND		;TEST FOR EOF
	JRST	EOF 		;END OF FILE EXIT
	TRNN	W,IOBAD		;TEST FOR DATA ERROR
	JRST	WORD1		;DATA OK - CONTINUE LOADING
	JSP	A,ERRPT		;DATA ERROR - PRINT MESSAGE
	SIXBIT    /INPUT ERROR#/
IFN HE,<SETOM RESET>
	JRST	LD2 		;GO TO ERROR RETURN
;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII
;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT
;DEVICE

CRLFLF:   PUSHJ     P,CRLF
FCRLF:	TLO	F,FCONSW	;INSURE TTY OUTPUT
CRLF:	MOVEI     T,15		;CARRIAGE RETURN LINE FEED
	PUSHJ     P,TYPE2
	MOVEI     T,12-40		;LINE FEED IN PSEUDO SIXBIT
TYPE:	MOVEI     T,40(T)		;CONVERT SIXBIT TO ASCII
TYPE2:	TLNN	N,AUXSWI	;IS THER AN AUXILIARY DEVICE?
	JRST	TYPE3		;NO, DONT OUTPUT TO IT
	TLON	N,AUXSWE	;IS AUX. DEV. ENTERED?
	PUSHJ	P,IAD2		;NOPE, DO SO!
	SOSG	ABUF2		;SPACE LEFT IN BUFFER?
	OUTPUT	2,		;CREATE A NEW BUFFER
	IDPB	T,ABUF1		;DEPOSIT CHARACTER
	TLNN	F,FCONSW	;FORCE OUTPUT TO CONSOLE TOO?
	POPJ	P,		;NOPE
IFE HE,<
TYPE3:	SKIPN	BUFO2		;END OF BUFFER
	OUTPUT	3,		;FORCE OUTPUT NOW
	IDPB	T,BUFO1		;DEPOSIT CHARACTER
	CAIN	T,12		;END OF LINE
	OUTPUT	3,		;FORCE AN OUTPUT
	>
IFN HE, <
TYPE3:	ROT T,-7
	MOVEM T,FOO1#
	MOVEI T,FOO1
	CALLI T,CDDTOUT>
	POPJ	P,

SE3:	XWD	2,2 		;SYMBOL POINTER INCREMENT
LSTPT:	POINT     6,W 		;CHARACTER POINTER TO W
PDLPT:	XWD	-41,PDLST-1;	INITIAL PUSHDOWN POINTER
COMM:	SQUOZE    0,.COMM.
PDSAV:	0				;SAVED PUSHDOWN POINTER
COMSAV:   0				;LENGTH OF COMMON
MDG:	0			;COUNTER FOR MUL DEF GLOBALS
PDLST:	IFE HE,<BLOCK	40>
IFN FAILSW,<LINKTB:	BLOCK 21>

F.C:	0
	0	;STORE N HERE
	0	;STORE X HERE
	0	;STORE H HERE
	0	;STORE S HERE
	0	;STORE R HERE
B.C:	0
IFE HE,<
F.I:	0			;INITIAL F - FLAGS
	0			;INITIAL N
	XWD	V,LDEND		;INITIAL X - LOAD PROGRAM AFTER LOADER
	EXP	LDEND+JOBPRO	;INITIAL H - INITIAL PROG BREAK
	0			;INITIAL S
	XWD	W,JOBPRO	;INITIAL R - INITIAL RELOC
	0			;INITIAL B
	>
;BUFFER HEADERS AND HEADER HEADERS

IFE HE,<
BUFO:	0				;CONSOLE INPUT HEADER HEADER
BUFO1:	0
BUFO2:	0

BUFI:	0				;CONSOLE OUTPUT HEADER HEADER
BUFI1:	0
BUFI2:	0
	>
ABUF:	0			;AUXILIARY OUTPUT HEADER HEADER
ABUF1:	0
ABUF2:	0

BUFR:	0				;BINARY INPUT HEADER HEADER
BUFR1:	0
BUFR2:	0

DTIN:	0				;DECTAPE INPUT BLOCK
IFE HE,<DTIN1:	0>
IFN HE,<DTIN1:	SIXBIT /REL   />
	0
DTIN2:	0

DTOUT:	0				;DECTAPE OUTPUT BLOCK
DTOUT1:   0
	0
	0

	TTYL=52			;TWO TTY BUFFERS
IFE K,<	BUFL=406		;TWO DTA BUFFERS FOR LOAD>
IFN K,<	BUFL=203		;ONE DTA BUFFER FOR LOAD>
	ABUFL=203		;ONE DTA BUFFER FOR AUX DEV
IFN HE,<BUFL=406>
IFE HE,<
TTY1:	BLOCK     TTYL		;TTY BUFFER AREA
	>
BUF1:	BLOCK	BUFL		;LOAD BUFFER AREA
AUX:	BLOCK	ABUFL		;AUX BUFFER AREA
ZEROS:	REPEAT 4,<0>

IFN RPGSW,<CTLIN:	BLOCK 3
CTLNAM:	BLOCK 3
CTLBUF:	BLOCK 203+1
>
IOBKTL=40000
IOIMPM=400000
	IODERR=200000
	IODTER=100000
	IODEND=20000

IOBAD=IODERR+IODTER+IOBKTL+IOIMPM

IFE HE,<
	INTERN    PWORD,DTIN,DTOUT,LDEND
	INTERN    WORD,LD,BEG,PDLST,LOAD
	INTERN    CRLF,TYPE,PMS,PRMAP
	INTERN    F,P,X,H,S,R,B,N,T,V,W,C,E,Q,A,D
	>
IFN HE,<
INTERNAL .LOAD, .PRMAP, PMS, .NAME, ERRPT8
EXTERNAL .GETF
	>

	EXTERN	JOBDDT,JOBFF,JOBSA,JOBREL,JOBSYM,JOBUSY,JOB41
IFE HE,<
IFN STANSW,<PATCH:	BLOCK	20		;STANFORD HAS SEMI-INFINITE CORE>
>

;END HERE IF 1K LOADER REQUESTED.
IFN K,	<LITS:	LIT
	VAR
IFE HE, <
LDEND:	END	LD>
IFN HE, <
LDEND:	END >>

;HERE BEGINS FORTRAN FOUR LOADER

F4LD:
	HRRZ	V,R;		SET PROG BREAK INTO V
	MOVEM	V,LLC;		SAVE FIRST WORD ADDRESS
	MOVEI	W,-2(S);	GENERATE TABLES
	TLO	N,F4SW
	HRRZM	W,MLTP;		MADE LABELS
	HRRZM	W,PLTP;		PROGRAMMER LABELS
	ADD	W,[POINT 1,1];	GENERATE BIT-BYTE POINTER
	MOVEM	W,BITP
	MOVEM	W,SDSTP;	FIRST DATA STATEMENT
	AOS	SDSTP;
	MOVE	W,[JRST ALLOVE]	;LAST DATA STATEMENT
	MOVEM	W,(S)
	HRREI	W,-^D36;	BITS PER WORDUM
	MOVEM	W,BITC;		BIT COUNT
	PUSHJ P,BITWX+1		;MAKE SURE OF ENOUGH SPACE

TEXTR:	PUSHJ	P,WORD;		TEXT BY DEFAULT
	HLRZ	C,W
	CAIN	C,-1
	JRST	HEADER;		HEADER
	MOVEI	C,1;		RELOCATABLE
	PUSHJ	P,BITW;		SHOVE AND STORE
	JRST	TEXTR;		LOOP FOR NEXT WORD

ABS:	SOSG	BLKSIZ;	MORE TO GET
	JRST	TEXTR;		NOPE
ABSI:	PUSHJ	P,WORD;
	MOVEI	C,0;		NON-RELOCATABLE
	PUSHJ	P,BITW;		TYPE 0
	JRST	ABS

;PROCESS TABLE ENTRIES

MDLB:	TLNE	F,FULLSW+SKIPSW;	MADE LABEL PROC
	JRST	GLOBDF;		NO ROOM AT THE IN
	HLRZ	C,MLTP;		GET PRESENT SIZE
	CAMGE	C,BLKSIZ;	IF NEW SIZE BIGGER, STR-R-RETCH
	PUSHJ	P,SMLT
	HRRZ	C,MLTP;		GET BASE
MLPLC:	ADD	C,BLKSIZ;	MAKE INDEX
	TLNN	F,FULLSW+SKIPSW;	DONT LOAD
	HRRZM	V,(C);		PUT AWAY DEFINITION
GLOBDF:	PUSHJ	P,WORD
	TLNE	F,FULLSW+SKIPSW	;SKIPPING THIS PROG?
	JRST	TEXTR		;YES, DON'T DEFINE
	MOVEI	C,(V);		AND LOC
	EXCH	W,C
	PUSHJ	P,SYMXX;	PUT IN DDT-SYMBOL TABLE
	PUSHJ	P,BITWX+1
	JRST	TEXTR

PLB:	TLNE	F,FULLSW+SKIPSW
	JRST	GLOBDF
	HLRZ	C,PLTP;		PRESENT SIZE
	CAMGE	C,BLKSIZ
	PUSHJ	P,SPLT
	HRRZ	C,PLTP
	JRST	MLPLC

;STORE WORD AND SET BIT TABLE

BITW:	TLNE	F,FULLSW+SKIPSW;	WE DONT LOAD THIS
	POPJ	P,;
	MOVEM	W,@X;		STORE AWAY OFFSET
	IDPB	C,BITP;		STORE BIT
	AOSGE	BITC;		STEP BIT COUNT
	JRST	BITWX;		SOME MORE ROOM LEFT
	HRREI	C,-^D36;	RESET COUNT
	MOVEM	C,BITC
	SOS	PLTP
	SOS	BITP;		ALL UPDATED
IFE EXPAND,<HRL C,MLTP
	SOS MLTP
	HRR	C,MLTP>
IFN EXPAND,<HRRZ	C,MLTP;		TO ADDRESS
		SUBI C,1
		CAIG C,@X
		PUSHJ P,[PUSHJ P,XPAND
			POPJ P,
			ADDI C,2000
			JRST POPJM2]
		SOS MLTP
		HRLI C,1(C)>
	HRRZ	T,SDSTP;	GET DATA POINTER
	BLT	C,-1(T);	MOVE DOWN LISTS
BITWX:	AOS	V;		STEP LOADER LOCATION
	HRRZ	T,MLTP
	CAIG	T,@X;		OVERFLOW CHECK
IFE EXPAND,<TLO	F,FULLSW>
IFN EXPAND,<PUSHJ P,	[PUSHJ P,XPAND
			TLOA F,FULLSW
			JRST POPJM3
			POPJ P,]>
	POPJ	P,;

SMLT:	SUB	C,BLKSIZ;	STRETCH
	MOVS	W,MLTP		;LEFT HALF HAS OLD BASE
	ADD	C,MLTP		;RIGHT HALF HAS NEW BASE
IFN EXPAND,<	HRRZS C	;GET RID OF COUNT
		CAIG C,@X
		PUSHJ P,[PUSHJ P,XPAND
			POPJ P,
			ADD W,[XWD 2000,0]
			ADDI C,2000
			JRST POPJM2]>
	HRRM C,MLTP		;PUT IN NEW MLTP
	HLL	C,W		;FORM BLT POINTER
	ADDI	W,(C)		;LAST ENTRY OF MLTP
	HRL	W,BLKSIZ	;NEW SIZE OF MLTP
	HLLM	W,MLTP		;...
SLTC:	BLT	C,0(W);		MOVE DOWN (UP?)
	POPJ	P,;

SPLT:	SUB	C,BLKSIZ
	MOVS	W,MLTP;
	ADDM	C,PLTP
	ADD	C,MLTP
IFN EXPAND,<	HRRZS C
		CAIG C,@X
		PUSHJ P,[PUSHJ P,XPAND
			POPJ P,
			ADD W,[XWD 2000,0]
			ADDI C,2000
			JRST POPJM2]>
	HRRM C,MLTP		;PUT IN NEW MLTP
	HLL	C,W
	HLRZ	W,PLTP		;OLD SIZE OF PL TABLE
	ADD	W,PLTP		;NEW BASE OF PL TABLE
	HRL	W,BLKSIZ	;NEW SIZE OF PL TABLE
	HLLM	W,PLTP		;INTO POINTER
	JRST	SLTC

PT1:	0


;PROCESS END CODE WORD

ENDS:	PUSHJ	P,WORD;		GET STARTING ADDRESS
	TLNE F,SKIPSW
	JRST ENDS1	;FOOBAZ!!!!!!!!
	JUMPE	W,ENDS1;	NOT MAIN
	ADDI	W,(R);		RELOCATION OFFSET
	TLNN	N,ISAFLG;	IGNORE STARTING ADDRESS
	HRR	F,W;		SET SA
IFN STANSW,<MOVE W,1(N)	;SET UP NAME
	PUSHJ P,LDNAM>
ENDS1:	PUSHJ	P,WORDPR	;DATA STORE SIZE
	HRRZM	C,PTEMP		;NUMBER OF PERMANENT TEMPS
	MOVEM	V,CCON;		START OF CONSTANTS AREA
	JUMPE	W,E1;		NULL
	MOVEM	W,BLKSIZ	;SAVE COUNT
	MOVEI	W,0(V)		;DEFINE CONST.
	MOVE	C,CNR50		;...
	TLNN F,SKIPSW!FULLSW
	PUSHJ	P,SYMPT		;...
	PUSHJ	P,GSWD		;STORE CONSTANT TABLE
E1:	MOVEI	W,0(V);		GET LOADER LOC
	EXCH	W,PTEMP;	STORE INTO PERM TEMP POINTER
	ADD	W,PTEMP;	FORM TEMP TEMP ADDRESS
	MOVEM	W,TTEMP;	POINTER
	MOVEM	V,GSTAB;	STORE LOADER LOC IN GLOBSUB
	MOVE	C,TTR50		;DEFINE %TEMP.
	TLNE F,SKIPSW!FULLSW
	JRST E1A
	PUSHJ	P,SYMPT		;...
	MOVE	C,PTR50		;DEFINE (IF EXTANT) TEMP.
	MOVEI	W,0(V)		;...
	CAME	W,TTEMP		;ANY PERM TEMPS?
	PUSHJ	P,SYMPT		;YES, DEFINE
E1A:	PUSHJ	P,WORD;		NUMBER OF GLOBSUBS
	JUMPE	W,E11
	MOVEM	W,BLKSIZ	;SIZE OF GLOBSUB
	PUSHJ	P,GSWD		;STORE GLOBSUB TABLE
E11:	MOVEM	V,STAB;		SCALARS
	PUSHJ	P,WORD;		HOW MANY?
	JUMPE	W,E21;		NONE
	PUSHJ	P,GSWDPR	;STORE SCALAR TABLE
E21:	MOVEM	V,ATAB;		ARRAY POINTER
	PUSHJ	P,WORD;		COMMENTS FOR SCALARS APPLY
	JUMPE	W,E31
	PUSHJ	P,GSWDPR	;STORE ARRAY TABLE
E31:	MOVEM	V,AOTAB;	ARRAYS OFFSET
	PUSHJ	P,WORD;		SAME COMMENTS AS ABOVE
	JUMPE	W,E41
	PUSHJ	P,GSWDPR	;STORE ARRAY OFFSET TABLE
E41:	PUSHJ	P,WORD;		TEMP, SCALAR, ARRAY SIZE
	TLNE	F,FULLSW!SKIPSW	;SKIPPING THIS PROG?
	MOVEI	W,0		;DON'T ACCEPT GLOB SUBPROG REQUESTS
	MOVEM	V,CTAB;		SETUP COMMON TABLE POINTER
	ADD	W,GSTAB;	GLOBAL SUBPROG BASE
	MOVEM	W,COMBAS;	START OF COMMON
	PUSHJ	P,WORD;		COMMON BLOCK SIZE
	HRRZM	W,BLKSIZ
	JUMPE	W,PASS2;	NO COMMON
COMTOP:	PUSHJ	P,WORDPR	;GET A COMMON PAIR
	PUSHJ	P,SDEF;		SEARCH
	JRST	COMYES;		ALREADY THERE
	HRLS	W
	HRR	W,COMBAS;	PICK UP THIS COMMON LOC
	TLNN F,SKIPSW!FULLSW
	PUSHJ	P,SYMXX;	DEFINE IT
	MOVS	W,W;		SWAP HALFS
	ADD	W,COMBAS;	UPDATE COMMON LOC
	HRRM	W,COMBAS;	OLD BASE PLUS NEW SIZE
	HLRZS	W;		RETURN ADDRESS
	TLZ	C,400000
	TLNN F,SKIPSW!FULLSW
	PUSHJ	P,SYMXX
COMCOM:	PUSHJ	P,CWSTWX	;STORE A WORD PAIR
	SOS	BLKSIZ
	SOSLE	BLKSIZ
	JRST	COMTOP
	JRST	PASS2

COMYES:	TLNE F,SKIPSW
	JRST COMCOM	;NO ERRORS IF SKIPPING
	HLRZ	C,2(A);		PICK UP DEFINITION
	CAMLE	W,C;		CHECK SIZE
	JRST	ILC;		ILLEGAL COMMON
	MOVE	C,1(A);		NAME
	HRRZ	W,2(A);	BASE
	JRST	COMCOM

PRSTWX:	PUSHJ	P,WORDPR	;GET A WORD PAIR
CWSTWX:	EXCH	C,W		;SPACE TO STORE FIRST WORD OF PAIR?
	PUSHJ	P,WSTWX		;...
	EXCH	C,W		;THERE WAS; IT'S STORED
WSTWX:	TLNE	F,FULLSW!SKIPSW	;SPACE FOR ANOTHER WORD?
	POPJ	P,		;NOPE, RETURN
	MOVEM	W,@X		;YES, STORE IT.
	JRST	BITWX		;TELL THE TABLES ABOUT IT; THEN RETURN


GSWD:	PUSHJ	P,WORD		;GET WORD FROM TABLE
	PUSHJ	P,WSTWX		;STASH IT
	SOSE	BLKSIZ		;FINISHED?
	JRST	GSWD		;NOPE, LOOP
	POPJ	P,		;TRA 1,4

GSWDPR:	MOVEM	W,BLKSIZ	;KEEP COUNT
GSWDP1:	PUSHJ	P,PRSTWX	;GET AND STASH A PAIR
	SOS	BLKSIZ		;FINISHED?
	SOSLE	BLKSIZ		;...
	JRST	GSWDP1		;NOPE, LOOP
	POPJ	P,		;TRA 1,4

;BEGIN HERE PASS2 TEXT PROCESSING

PASS2:	ADDI V,(X)
	MOVEM V,TOPTAB	;SAVE FOR OVERLAP CHECKING
	TLNE	F,FULLSW+SKIPSW;	ABORT?
	JRST	ALLOVE;		YES
	MOVE	V,LLC		;PICK UP PROGRAM ORIGIN
	CAML	V,CCON		;IS THIS A PROGRAM?
	JRST	FBLKD		;NO, GO LOOK FOR FIRST BLK DATA
	TLOE	N,PGM1		;YES, IS THIS FIRST F4 PROG?
	JRST	NOPRG		;NO
	HRR	W,COMBAS	;YES, PLACE PROG BREAK IN LH
IFE L,<	HRLM	W,JOBCHN(X)	;FOR CHAIN>
NOPRG:	HRRZ	W,PLTP;		GET PROG TABLE BASE
	HLRZ	C,PLTP;		AND SIZE
	ADD	W,C;		COMPUTE END OF PROG TABLE
	ADD	W,[POINT 1,1];	AND BEGINNING OF BIT TABLE
	EXCH	W,BITP;		SWAP POINTERS
PASS2B:	ILDB	C,BITP;		GET A BIT
	JUMPE	C,PASS2C;	NO PASS2 PROCESSING
	PUSHJ	P,PROC;		PROCESS A TAG
	JRST	PASS2B;		MORE TO COME
	JRST	ENDTP;

PROC:	LDB	C,[POINT 6,@X,23];	TAG
	SETZM	MODIF;		ZERO TO ADDRESS MODIFIER
	TRZE	C,40;
	AOS	MODIF
	HRLM	C,ENDTAB;	ERROR SETUP
	MOVEI	W,TABDIS;	HEAD OF TABLE
	HLRZ	T,(W);		GET ENTRY
	CAME	T,C;		CHECK
	AOJA	W,.-2
	HRRZ	W,(W);		GET DISPATCH
	LDB	C,[POINT 12,@X,35]
	JRST	(W);		DISPATCH

TABDIS:	XWD 11,PCONS;		CONSTANTS
	XWD 06,PGS;		GLOBAL SUBPROGRAMS
	XWD 20,PST;		SCALARS
	XWD 22,PAT;		ARRAYS
	XWD 01,PATO;		ARRAYS OFFSET
	XWD 00,PPLT;		PROGRAMMER LABELS
	XWD 31,PMLT;		MADE LABESL
	XWD 26,PPT;		PERMANENT TEMPORARYS
	XWD 27,PTT;		TEMPORARY TEMPORARYS
ENDTAB:	XWD 00,LOAD4A;		ERRORS

PASS2C:	PUSHJ	P,PASS2A
	JRST	PASS2B
	JRST	ENDTP

;DISPATCH ON A HEADER

HEADER:	CAMN	W,[EXP -2];	END OF PASS ONE
	JRST	ENDS
	LDB	C,[POINT 12,W,35];	GET SIZE
	MOVEM	C,BLKSIZ
	ANDI	W,770000
	JUMPE	W,PLB;	PROGRAMMER LABEL
	CAIN	W,500000;	ABSOLUTE BLOCK
	JRST	ABSI;
	CAIN	W,310000;	MADE LABEL
	JRST	MDLB;		MADE LABEL
	CAIN	W,600000
	JRST	GLOBDF
	CAIN	W,700000;	DATA STATEMENT
	JRST	DATAS
	JRST	LOAD4A;		DATA STATEMENTS WILL GO HERE

TOPTAB:	0	;TOP OF TABLES
CTAB:	0;	COMMON
ATAB:	0;	ARRAYS
STAB:	0;	SCALARS
GSTAB:	0;	GLOBAL SUBPROGS
AOTAB:	0;	OFFSET ARRAYS
CCON:	0;	CONSTANTS
PTEMP:	0;	PERMANENT TEMPS
TTEMP:	0;	TEMPORARY TEMPS
COMBAS:	0;	BASE OF COMMON
LLC:	0;	PROGRAM ORIGIN
BITP:	0;	BIT POINTER
BITC:	0;	BIT COUNT
PLTP:	0;	PROGRAMMER LABEL TABLE
MLTP:	0;	MADE LABEL TABLE
SDS:	0	;START OF DATA STATEMENTS
SDSTP:	0	;START OF DATA STATEMENTS POINTER
BLKSIZ:	0;	BLOCK SIZE
MODIF:	0;	ADDRESS MODIFICATION +1
TTR50:	XWD	136253,114765	;RADIX 50 %TEMP.
PTR50:	XWD	100450,614765	;RADIX 50 TEMP.
CNR50:	XWD	112320,235025	;RADIX 50 CONST.

;ROUTINES TO PROCESS POINTERS

PCONS:	ADD	C,CCON;		GENERATE CONSTANT ADDRESS
	SOJA	C,PCOMX		;ADJUST FOR 1 AS FIRST ENTRY

PSTA:	PUSHJ	P,SWAPSY	;NON-COMMON SCALARS AND ARRAYS
	ADDI	C,(R);		RELOCATE
PCOM1:	PUSHJ	P,SYDEF		;...
PCOMX:	ADD	C,MODIF		;ADDR RELOC FOR DP
	HRRM	C,@X;		REPLACE ADDRESS
PASS2A:	AOS	V;		STEP READOUT POINTER
	CAML	V,CCON		;END OF PROCESSABLES?
CPOPJ1:	AOS	(P);		SKIP
	POPJ	P,;

PAT:	SKIPA	W,ATAB		;ARRAY TABLE BASE
PST:	MOVE	W,STAB		;SCALAR TABLE  BASE
	ROT	C,1		;SCALE BY 2
	ADD	C,W		;ADD IN TABLE BASE
	ADDI	C,-2(X);	TABLE ENTRY
	HLRZ	W,(C);		CHECK FOR COMMON
	JUMPE	W,PSTA;		NO COMMON
	PUSHJ	P,COMDID	;PROCESS COMMON
	JRST	PCOM1

COMDID:	LSH	W,1		;PROCESS COMMON TABLE ENTRIES
	ADD	W,CTAB;		COMMON TAG
	ADDI	W,-2(X);	OFFSET
	PUSHJ	P,SWAPSY;	GET SYMBOL AND SET TO DEFINED
	ADD	C,1(W);		BASE OF COMMON
	POPJ	P,		;RETURN

PATO:	ROT	C,1
	ADD	C,AOTAB;	ARRAY OFFSET
	ADDI	C,-2(X);	LOADER OFFSET
	MOVEM	C,CT1;		SAVE CURRENT POINTER
	HRRZ	C,1(C);		PICK UP REFERENCE POINTER
	ANDI	C,7777;	MASK TO ADDRESS
	ROT	C,1;		ALWAYS A ARRAY
	ADDI	C,-2(X)
	ADD	C,ATAB
	HLRZ	W,(C);		COMMON CHECK
	JUMPE	W,NCO
	PUSHJ	P,COMDID	;PROCESS COMMON
	PUSHJ	P,SYDEF
	MOVE	C,CT1
	HRRE	C,(C)
	ADD	C,1(W)
	JRST	PCOMX

NCO:	PUSHJ	P,SWAPSY;
	ADDI	C,(R)		;DEFINE SYMBOL IN TRUE LOC
	PUSHJ	P,SYDEF		;...
	MOVE	C,CT1
	HRRZ	C,(C)		;OFFSET ADDRESS PICKUP
	ADDI	C,(R)		;WHERE IT WILL BE
	JRST	PCOMX		;STASH ADDR AWAY

PTT:	ADD	C,TTEMP;	TEMPORARY TEMPS
	SOJA	C,PCOMX		;ADJUST FOR 1 AS FIRST ENTRY

PPT:	ADD	C,PTEMP;	PERMANENT TEMPS
	SOJA	C,PCOMX		;ADJUST FOR 1 AS FIRST ENTRY

PGS:	ADD	C,GSTAB;	GLOBSUBS
	ADDI	C,-1(X);	OFFSET
	MOVE	C,(C)
	TLC	C,640000;	MAKE A REQUEST
	PUSHJ P,TBLCHK		;CHECK FOR OVERLAP
	MOVEI	W,(V);		THIS LOC
	HLRM	W,@X;		ZERO RIGHT HALF
	PUSHJ	P,SYMXX
	JRST	PASS2A

SYDEF:	TLNE	N,SYDAT		;SYMBOL WANTS DEFININITION?
	POPJ	P,		;NO, GO AWAY
	PUSH	P,C		;SAVE THE WORLD
	PUSH	P,W
	PUSHJ P,TBLCHK	;CHECK FOR OVERLAP
	MOVE	W,C
	SKIPE	C,T	;PICKUP VALUE
	PUSHJ	P,SYMXX
	POP	P,W
	POP	P,C
	POPJ	P,;

PMLT:	ADD	C,MLTP
	SKIPA
PPLT:	ADD	C,PLTP
	HRRZ	C,(C)
	JRST	PCOMX

SYMXX:	PUSH	P,V
	PUSHJ	P,SYMPT
	POP	P,V
	POPJ	P,;

SWAPSY:	MOVEI	T,0;		SET TO EXCHANGE DEFS
	EXCH	T,1(C);		GET NAME
	HRRZ	C,(C)		;GET VALUE
	POPJ	P,
TBLCHK:	HRRZ W,MLTP	;GETT TOP OV TABLES
	SUBI W,2
	CAMG W,TOPTAB	;WILL IT OVERLAP
IFE EXPAND,<TLO F,FULLSW>
IFN EXPAND,<	JRST	[PUSHJ P,XPAND
			TLOA F,FULLSW
			JRST TBLCHK
			JRST .+1]>
	POPJ P,

;END OF PASS2

ALLOVE:	TLZ	N,F4SW		;END OF F4 PROG
	TLNE F,FULLSW!SKIPSW
	JRST HIGH3
	HRR	R,COMBAS	;TOP OF THE DATA
	HRR	V,R		;IS THIS THE HIGHEST LOC YET?
	CAIG	H,@X		;...
	MOVEI	H,@X		;YES, TELL THE WORLD
	CAMG	H,SDS		;HIGHEST LOC GREATER THAN DATA STATEMENTS?
	JRST	HIGH3		;NO, RETURN
	ADDI	H,1(S)		;YES, SET UP MEANINGFUL ERROR COMMENT
	SUB	H,SDS		;...
	TLO	F,FULLSW	;INDICATE OVERFLO
	JRST	HIGH3		;RETURN

DATAS:	TLNE	F,FULLSW+SKIPSW
	JRST	DAX
	MOVEI	C,(S)		;ADDR OF WORD UNDER SYMBOL TABLE
	MOVN	W,BLKSIZ	;HOW FAR DOWN TO BLT
	ADDM	W,PLTP		;UPDATE TABLE POINTERS
	ADDM	W,BITP		;...
	ADDM	W,SDSTP		;...
	ADD	C,W		;RH(C):= WHEN TO STOP BLT
	HRL	C,MLTP		;SOURCE OF BLTED DATA
	ADD	W,MLTP		;UPDATE, GET DESTINATION OF BLT DATA
IFN EXPAND,<	HRRZS W	;GET RID OF LEFT HALF
		CAIG W,@X
		PUSHJ P,[PUSHJ P,XPAND
			POPJ P,
			ADDI W,2000
			ADD C,[XWD 2000,2000]
			JRST POPJM2]>
	HRRM W,MLTP		;NO SET THIS SO EXTRA CORE NOT ZEROED
	HLL	W,C		;FORM BLT POINTER
	BLT	W,-1(C)		;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)
	PUSHJ	P,BITWX+1
DAX:	PUSHJ	P,WORD;		READ ONE WORD
	TLNN	F,FULLSW+SKIPSW
	MOVEM	W,(C)
	SOSLE	BLKSIZ		;COUNT OF DATA SEQUENCE SIZE
	AOJA	C,DAX		;INCREMENT DATA SEQUENCE DEPOSIT LOC
	JRST	TEXTR;		DONE

FBLKD:	TLOE	N,BLKD1		;IS THIS FIRST BLOCK DATA?
	JRST	ENDTP		;NO
	HRR	V,COMBAS	;PLACE PROG BREAK IN RH FOR
IFE L,<	HRRM	V,JOBCHN(X)	;CHAIN>
ENDTP:	TLNE	F,FULLSW+SKIPSW
	JRST	ALLOVE
	HRR	V,GSTAB
ENDTP0:	CAML	V,STAB;		ANY MORE GLOBSUBS
	JRST	ENDTP2;		NO
	MOVE	C,@X;		GET SUBPROG NAME
	PUSHJ	P,SREQ;		IS IT ALLREADY REQUESTED
	AOJA	V,ENDTP0;	YES
	PUSHJ	P,SDEF;		OR DEFINED
	AOJA	V,ENDTP0;	YES
	PUSHJ P,TBLCHK
	MOVEI W,0		;PREPARE DUMMY LINK
	TLNN	F,FULLSW+SKIPSW;	ABORT
	PUSHJ	P,SYM3X;	PUT IN DUMMY REQUEST
	PUSHJ	P,BITWX+1;	OVERLAP CHECK
	AOJA	V,ENDTP0
ENDTP2:	SETZM	PT1
	HRR V,SDSTP
IFN EXPAND,<	SUBI V,(X)
		CAMG V,COMBAS
		JRST	[PUSHJ P,XPAND
			TLOA F,FULLSW
			JRST .-3
			JRST .+1]
		HRR V,SDSTP>
	HRRZM	V,SDS		;DATA STATEMENT LOC
ENDTP1:	SUBI	V,(X);		COMPENSATE FOR OFFSET
	MOVE	W,@X;	GET WORD
	TLNE	W,-1;		NO LEFT HALF IMPLIES COUNT
	JRST	DODON;		DATA DONE
	ADD	W,[MOVEI W,3]
	ADDI	W,@X
	EXCH	W,@X
	AOS	V
	ADD	W,@X;		ITEMS COUNT
	MOVEM	W,ITC
	MOVE	W,[MOVEM W,LTC]
	MOVEM	W,@X;		SETUP FOR DATA EXECUTION
	AOS	V
	MOVE	W,[MOVEI W,0]
	EXCH	W,@X
	MOVEM	W,ENC;		END COUNT
	AOS	V
	MOVEI	W,@X
	ADDM	W,ITC
LOOP:	MOVE	W,@X
	HLRZ	T,W;		LEFT HALF INST.
	ANDI	T,777000
	CAIN	T,254000	;JRST?
	JRST	WRAP		;END OF DATA
	CAIN	T,260000	;PUSHJ?
	JRST	PJTABL(W)	;DISPATCH VIA TABLE
	CAIN	T,200000;	MOVE?
	AOJA	V,INNER
	CAIN	T,270000;	ADD?
	JRST	ADDOP
	CAIN	T,221000;	IMULI?
	AOJA	V,LOOP
	CAIE	T,220000;	IMUL?
	JRST	LOAD4A;		NOTA
INNER:	HRRZ	T,@X;		GET ADDRESS
	TRZE	T,770000;	ZERO TAG?
	SOJA	T,CONPOL;	NO, CONSTANT POOL
	SUB	T,PT1;		SUBTRACT INDUCTION NUMBER
	ASH	T,1
	SOS	T;		FORM INDUCTION POINTER
	HRRM	T,@X
	HLRZ	T,@X
	ADDI	T,P
	HRLM	T,@X
	AOJA	V,LOOP

CONPOL:	ADD	T,ITC;	CONSTANT BASE
	HRRM	T,@X
	AOJA	V,LOOP

ADDOP:	HRRZ	T,@X
	TRZE	T,770000
	SOJA	T,CONPOL
SKIPIN:	AOJA	V,LOOP

PJTABL:	JRST	DWFS		;PUSHJ 17,0
	AOSA	PT1		;INCREMENT DO COUNT
	SOSA	PT1;		DECREMENT DO COUNT
	SKIPA	W,[EXP DOINT.]
	MOVEI	W,DOEND.
	HRRM	W,@X
	AOJA	V,SKIPIN	;SKIP A WORD

DWFS:	MOVEI	W,DWFS.
	HRRM	W,@X
	AOS	V
	TLO	N,SYDAT
	PUSHJ	P,PROC;		PROCESS THE TAG
	JRST	LOAD4A		;DATA STATEMENT BELOW CODE TOP
	JRST	LOOP		;PROPER RETURN

DOINT.:	POP	P,V;		GET ADDRESS OF INITIAL VALUE
	PUSH	P,(V);		STORE INDUCTION VARIABLE
	AOS	V
	PUSH	P,V;		INITIAL ADDRESS
	JRST	(V)

DOEND.:	HLRZ	T,@(P)
	ADDM	T,-2(P);	INCREMENT
	HRRZ	T,@(P);		GET FINAL VALUE
	CAMGE	T,-2(P);	END CHECK
	JRST	DODONE;		WRAP IT UP
	POP	P,(P);		BACK UP POINTER
	JRST	@(P)

DODONE:	POP	P,-1(P);	BACK UP ADDRESS
	POP	P,-1(P)
	JRST	CPOPJ1		;RETURN

WRAP:	MOVE	W,ENC;		NUMBER OF CONSTANTS
	ADD	W,ITC;		CONSTANT BASE
	MOVEI	C,(W);		CHAIN
	HRRM	C,@X
	MOVEI	V,(W);		READY TO GO
	JRST	ENDTP1

DODON:	TLZ	N,RCF!SYDAT!DZER	;DATA STATEMENT FLAGS
	MOVE	W,PTEMP		;TOP OF PROG
	ADDI	W,(X)		;+OFFSET
	MOVE	C,COMBAS	;TOP OF DATA
	ADDI	C,(X)		;+OFFSET
SECZER:	CAML	W,C		;ANY DATA TO ZERO?
	JRST	@SDS		;NO, DO DATA STATEMENTS
	CAML	W,SDS		;IS DATA BELOW DATA STATEMENTS?
	TLO	F,FULLSW	;NO, INDICATE OVERFLO
	TLNN	F,FULLSW+SKIPSW	;SHOULD WE ZERO?
	SETZM	(W)		;YES, DO SO
	TLON	N,DZER		;GO BACK FOR MORE?
	AOJA	W,SECZER	;YES, PLEASE
	CAMLE	C,SDS		;ALL DATA BELOW DATA STATEMENTS?
	MOVE	C,SDS		;ALL ZEROED DATA MUST BE
	HRLI	W,-1(W)		;SET UP BLT POINTER TO ZERO DATA
	TLNN	F,FULLSW+SKIPSW	;SHOULD WE ZERO?
	BLT	W,-1(C)		;YES, DO SO
	JRST	@SDS		;GO DO DATA STATEMENTS

DREAD:	TLNE	N,RCF;		NEW REPEAT COUNT NEEDED
	JRST	FETCH;		NO
	MOVE	W,LTC
	MOVEM	W,LTCTEM
	MOVE	W,@LTC;		GET A WORD
	HLRZM	W,RCNT;		SET REPEAT COUNT
	HRRZM	W,WCNT;		SET WORD COUNT
	POP	W,(W);		SUBTRACT ONE FROM BOTH HALFS
	HLLM	W,@LTC;		DECREMENT REPEAT COUNT
	AOS	W,LTC;		STEP READOUT
	TLO	N,RCF
FETCH:	MOVE	W,@LTC
	AOS	LTC
	SOSE	WCNT
	POPJ	P,;
	SOSN	RCNT
	JRST	DOFF.
	MOVE	V,LTCTEM;	RESTORE READOUT
	MOVEM	V,LTC
DOFF.:	TLZ	N,RCF;		RESET DATA REPEAT FLAG
	POPJ	P,;

DWFS.:	MOVE	T,(P)
	AOS	(P)
	MOVE	T,(T);		GET ADDRESS
	HLRZM	T,DWCT;		DATA WORD COUNT
	HRRES	T
	ADD	T,W;		OFFSET
	ADDI	T,(X);		LOADER OFFSET
DWFS.1:	PUSHJ	P,DREAD		;GET A DATA WORD
	CAML	T,SDS		;BELOW BEGINNING OF DATA STATEMENTS
	TLO	F,FULLSW	;YES, INDICATE OVERFLO
	TLNN	F,FULLSW+SKIPSW	;LOAD THE NEXT DATA ITEM?
	MOVEM	W,(T)		;YES, STORE IT
	AOS	T
	SOSE	W,DWCT;		STEP DOWN AND TEST
	JRST	DWFS.1		;ONE MORE TIME, MOZART BABY!
	POPJ	P,;


;LITERAL TABLE

LITS:	LIT
	VAR
CT1:	0		;TEMP FOR C
LTC:	0
ITC:	0
ENC:	0
WCNT:	0		;DATA WORD COUNT
RCNT:	0		;DATA REPEAT COUNT

LTCTEM:	0		;TEMP FOR LTC
DWCT:	0		;DATA WORD COUNT
IFE L,<
IFE HE,<
LDEND:	END	LD
	>>
IFN HE,<
LDEND:	END>
IFN L,<
LDEND:
LODMAK:	MOVEI A,LODMAK
	MOVEM A,137
	INIT 17
	SIXBIT /DSK/
	0
	HALT
	ENTER LMFILE
	HALT
	OUTPUT [IOWD 1,LMLST	;OUTPUT LENGTH OF FILE
		0]
	OUTPUT LMLST
	STATZ 740000
	HALT
	RELEASE
	CALL [SIXBIT /EXIT/]

LMFILE:	SIXBIT /LISP/
	SIXBIT /LOD/
	0
	0

LMLST:	IOWD LODMAK+1-LD,137
	0

	END LODMAK>