L==1	;LISP SWITCH ON FOR LISP SYSTEM VERSION
	TITLE	LOADER V.057
	SUBTTL	RP GRUEN/NGP/WFW/DMN/WJE	25-MAR-75
;COPYRIGHT 1968,1969,1970,1971,1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.

	VLOADER==57
	VUPDATE==0		;DEC UPDATE LEVEL
	VEDIT==151		;EDIT LEVEL
	VCUSTOM==1		;NON-DEC UPDATE LEVEL
				;(UCI LISP MODIFICATIONS)

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

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

	SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW		GIVES PURE CODE (VARIABLES IN LOW SEG)
REENT		GIVES REENTRANT CAPABILITY PDP-10
	(REENT=0 FOR PDP-10/30 OR PDP-6 OR EARLY PDP-10)
RPGSW		INCLUDE CCL FEATURE
TEMP		INCLUDE TMPCOR FEATURE
DMNSW		 SYMBOL TABLE WILL BE MOVED DOWN FROM TOP OF CORE
KUTSW		 GIVES CORE CUTBACK ON /K
EXPAND		 FOR AUTOMATIC CORE EXPANSION
PP		ALLOW PROJ-PROG #
NAMESW		USE SETNAM UUO TO CHANGE PROGRAM NAME
DIDAL		GIVES DIRECT ACCESS LIBRARY SEARCH MODE
ALGSW		WILL LOAD ALGOL OWN BLOCK (TYPE 15)
COBSW		WILL LOAD COBAL LOCAL SYMBOLS (BLOCK TYPE 37)
SFDSW		NUMBER OF SFDS ALLOWED IF NON-ZERO
CPUSW		LOADER WILL TEST FOR KI/KA-10 AND LOAD CORRECT LIB40
FORSW		DEFAULT VALUE OF FORSE/FOROTS FORTRAN OTS
B11SW		INCLUDE POLISH FIXUP BLOCK (TYPE 11)

	SWITCHES OFF (ZERO) IN DEC VERSION
K		GIVES SMALLER LOADER - NO F4
L		 FOR LISP LOADER
SPMON		GIVES SPMON LOADER (MONITOR LOADER)
MONLOD		GIVES MONITOR LOADER WHICH USES DISK AS CORE IMAGE
TEN30		FOR 10/30 LOADER
STANSW		 GIVES STANFORD FEATURES
LNSSW		GIVES LNS VERSION
FAILSW		INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS.
LDAC		 MEANS LOAD CODE INTO ACS
	(LDAC DOES NOT WORK WITH KUTSW=1.CORE UUO CLEARS JOBBLT)
WFWSW		GIVES BLOCK TYPE 13 (VARIABLS INTO LOW SEG)
SYMARG		ACCEPT SYMBOLIC (GLOBAL) ARGUMENTS FOR SWITCHES
SPCHN		WILL DO SPECIAL OVERLAYING
NELSW		FOR NELIAC COMPILER
SAILSW		GIVES BLOCK TYPE 16 (FORCE LOAD OF REL FILES)
		AND 17 (FORCE SEARCH OF LIBRARIES) FOR SAIL
MANTIS		WILL LOAD BLOCK 401 FOR F4 MANTIS DEBUGGER
SYMDSW		LOADER WILL STORE SYMBOLS ON DSK
TENEX		SPECIAL CODE IF RUNING UNDER TENEX
*
SUBTTL	DEFAULT ASSEMBLY SWITCH SETTINGS

IFNDEF SPMON,<SPMON=0>
IFN SPMON,<	TEN30==1
		K==1>

IFNDEF L,<L=0>

IFNDEF TEN30,<TEN30=0>

IFN TEN30!L,<	RPGSW=0
		PP=0
IFNDEF DMNSW,<	DMNSW=0>
		ALGSW=0
		COBSW=0
		PURESW=0
		REENT=0
		LDAC=0
		KUTSW=0
		NAMESW=0>
IFN TEN30,<	EXPAND=0
IFNDEF DIDAL,<	DIDAL=0>
>

IFN L,<	CPUSW==0
	PP==1>

IFNDEF	MONLOD,<MONLOD=0>
IFN	MONLOD,<K==1
		ALGSW=0
		COBSW=0
		DIDAL=0
		REENT=0
		B11SW==0
		SYMDSW==0
		EXPAND==1>

IFNDEF	K,<K=0>

IFNDEF STANSW,<STANSW=0>
IFN STANSW,<	TEMP==0
		REENT==0
		FAILSW=1>

IFNDEF LNSSW,<LNSSW=0>
IFN LNSSW,<LDAC=1
	PP=0>

IFNDEF FAILSW,<FAILSW==0>
IFN FAILSW,<B11SW==1>

IFNDEF B11SW,<B11SW==1>

IFNDEF RPGSW,<RPGSW==1>
IFN RPGSW,<PP==1>	;REQUIRE DISK FOR CCL
IFE RPGSW,<TEMP=0>

IFNDEF PP,<PP==1>

IFNDEF TEMP,<TEMP==1>

IFNDEF NAMESW,<NAMESW==1>

IFNDEF LDAC,<LDAC=0>
IFN LDAC,<KUTSW=0>

IFNDEF KUTSW,<KUTSW==1>

IFNDEF EXPAND,<	IFN K,<EXPAND==0>
		IFE K,<EXPAND==1>>

IFNDEF DMNSW,<DMNSW==1>
IFN DMNSW!LDAC,<IFNDEF SYMPAT,<SYMPAT==100>
	IFN LDAC,<IFG 20-SYMPAT,<SYMPAT==20>>>

IFNDEF REENT,<REENT==1>

IFNDEF PURESW,<PURESW==1>

IFNDEF WFWSW,<WFWSW==0>

IFN K,<SYMARG=0
	SPCHN=0>

IFNDEF SYMARG,<SYMARG==0>

IFNDEF SPCHN,<SPCHN==0>

IFNDEF DIDAL,<DIDAL==1>

IFNDEF ALGSW,<ALGSW==1>

IFNDEF COBSW,<COBSW==1>

IFNDEF SAILSW,<SAILSW==0>

IFNDEF NELSW,<NELSW==0>

IFN K,<MANTIS==0>
IFNDEF MANTIS,<MANTIS==0>

IFE PP,<SFDSW==0>
IFNDEF SFDSW,<SFDSW==5>
IFNDEF	CPUSW,<CPUSW==1>

IFNDEF FORSW,<FORSW==2>	;1=FORSE, 2=FOROTS

IFNDEF SYMDSW,<SYMDSW==0>
IFN SYMDSW,<DIDAL==0>	;BOTH USE AUX BUFFER
IFNDEF TENEX,<TENEX==0>
SUBTTL	ACCUMULATOR ASSIGNMENTS
	F=0		;FLAGS IN BOTH HALVES OF F
	N=1		;FLAGS IN BOTH HALVES OF N
	X=2		;LOADER OFFSET
	H=3		;HIGHEST LOC LOADED
	S=4		;UNDEFINED POINTER
	R=5		;RELOCATION CONSTANT
	B=6		;SYMBOL TABLE POINTER
	D=7		;COMMAND ARGUMENT (OCTAL) AND WORKSPACE
	T=10
	V=T+1
	W=12		;VALUE
	C=W+1 		;SYMBOL, DECIMAL COMMAND ARGUMENT
	E=C+1 		;DATA WORD COUNTER
	Q=15		;RELOCATION BITS
	A=Q+1 		;SYMBOL SEARCH POINTER
	P=17		;PUSHDOWN POINTER


;MONITOR LOCATIONS IN THE USER AREA

.JBHDA==10
.JBSDD==114		;SAVE POINTER TO JOBDDT
.JBS41==122		;SAVE POINTER TO JOB41

INTERN	.JBVER,.JBHDA,.JBSDD,.JBS41
EXTERN	.JBDDT,.JBFF,.JBSA,.JBREL,.JBSYM,.JBUSY,.JB41,.JBHRL,.JBCOR
EXTERN	.JBCHN,.JBERR,.JBBLT,.JBAPR,.JBDA,.JBHSM

NEGOFF==400		;NEGATIVE OFFSET OF HIGH SEGMENT


PDLSIZ==40		;LENGTH OF PUSHDOWN STACK
PPDL==60	;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
;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
	HIPROG==40	;LOADING HI PROGRAM, SET BY HISEG. CLEARED BY EOF
	ASW==100		;ON - LEFT ARROW ILLEGAL
	FULLSW==200		;ON - STORAGE EXCEEDED
	SLIBSW==400		;ON - LIB SEARCH IN THIS PROG
	RMSMSW==1000		;REMEMBER IF LOADING WITH SYMBOLS DURING LIB SEARCH
	REWSW==2000		;ON - REWIND AFTER INIT
	LIBSW==4000		;ON - LIBRARY SEARCH MODE

	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



;MORE FLAGS IN F (18-35)

SEENHI==1		;HAVE SEEN HI STUFF
NOHI==2			;LOAD AS NON-REENTRANT
NOTTTY==4		;DEV "TTY" IS NOT A TTY
NOHI6==10		;PDP-6 TYPE SYSTEM
HISYM==20		;BLT SYMBOLS INTO HIGH SEGMENT
SEGFL==40		;LOAD INTO HI-SEG
XFLG==100		;INDEX IN CORE (BLOCK TYPE 14)
LSTLOD==200		;LAST PROG WAS LOADED
DTAFLG==400		;LIBRARY DEVICE IS A DTA (NEEDED FOR INDEXING)
DMNFLG==1000		;SYMBOL TABLE TO BE MOVED DOWN
SFULSW==2000		;PRINTED SYMBOL OVERLAP ONCE ALREADY
ARGFL==4000		;TREAT $%. AS RADIX-50 CHAR.
TWOFL==10000		;TWO SEGMENTS IN THIS BINARY FILE
LOCAFL==20000		;PRINT LOCAL SYMBOLS IN MAP
TTYFL==40000		;AUX. DEV. IS TTY
TRMFL==100000		;END OF LOADING SEEN ($ OR /G)
KICPFL==200000		;HOST CPU IS A KI-10
LSYMFL==400000		;STORE LOCAL SYMBOLS ON DSK
;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>
IFN MONLOD,<DISW==10	;DISK IMAGE LOAD IN PROGRESS
	    WOSW==20	;WRITE OUT SWITCH, DATA IN WINDOW HAS CHANGED>
	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
	RPGF==10000		;IN RPG MODE
	AUXSWI==20000		;ON - AUX. DEVICE INITIALIZED
	AUXSWE==40000		;ON - AUX. DEVICE ENTERED
	PPSW==100000		;ON - READING PROJ-PROG #
	PPCSW==200000		;ON - READING PROJ #
	HSW==400000		;USED IN BLOCK 11 POLISH FIXUPS

;MORE FLAGS IN N (18-35)
F4FL==400000		;FORTRAN (F40) SEEN
COBFL==200000		;COBOL SEEN
ALGFL==100000		;ALGOL SEEN
NELFL==40000		;NELIAC SEEN
PL1FL==20000		;PL/1 SEEN
BLIFL==10000		;BLISS-10
SAIFL==4000		;SAIL
FORFL==2000		;FORTRAN-10
F10TFL==1000		;FORTRAN-10 CODE FOR THIS FILE SET NOHI (TEMP)
KI10FL==400		;KI-10 ONLY CODE
KA10FL==200		;KA-10 ONLY CODE
MANTFL==100		;MANTIS SEEN, LOAD SPECIAL DATA
SYMFOR==40		;SYMSW FORCED SET
MAPSUP==20		;SUPRESS SYBOL TABLE OUTPUT
CHNMAP==10		;MAP FOR SPCHN ROOT SEGMENT PRINTED
ATSIGN==4		;AT SIGN - INDIRECT COMMAND
ENDMAP==2		;DELAY MAP TO END
VFLG==1			;DEFAULT LOAD REENTRANT OPERATION SYSTEM

COMFLS==F4FL!COBFL!ALGFL!NELFL!PL1FL!BLIFL!SAIFL!FORFL

DEFINE ERROR (X,Y)<
JSP A,ERRPT'X
XLIST
SIXBIT Y
LIST>

IFN TENEX,<
	OPDEF JSYS [104B8]
	OPDEF SEVEC [JSYS 204]
	OPDEF GEVEC [JSYS 205]
	OPDEF GET [JSYS 200]
	OPDEF GTJFN [JSYS 20]
	OPDEF CIS [JSYS 141]
	OPDEF DIR [JSYS 130]
>

IFN PURESW,<TWOSEGMENTS
	RELOC	400000>

DSKBIT==200000	;FOR USE WITH DEVCHR
DTABIT==100	;DITTO

	DISIZE=2000	;CORE WINDOW SIZE
	.RBEST==10	;ESTIMATED SIZE OF BLOCK (SYMBOL)
	.RBALC==11	;ALLOCATED SIZE OF BLOCK (SYMBOL)
	DALLOC==^D500	;PREALLOCATE SOME SPACE


DSKBLK==200	;LENGTH OF DISK BLOCKS
DTABLK==177	;LENGTH OF DECTAPE BLOCKS (EXCLUDING LINK WORD)
VECLEN==^D25	;LENGTH OF VECTOR TABLE FOR OVERLAYS

RELLEN==^D5	;#NUMBER OF REL FILES OR LIBRARIES (MUST BE SAME)

;BUFFER SIZES
TTYL==52		;TWO TTY BUFFERS
IFNDEF BUFN,<BUFN==2	;TWO DATA BUFFERS FOR LOAD>
IFE LNSSW,<
BUFL==BUFN*203		;'BUFN' DTA BUFFERS FOR LOAD
ABUFL==203		;ONE DTA BUFFER FOR AUX DEV>
IFN LNSSW,<
IFE K,<BUFL==4*203+1>
IFN K,<BUFL==203+1>
ABUFL==2*203+1>

;CALLI DEFINITIONS

OPDEF	RESET	[CALLI	 0]
OPDEF	SETDDT	[CALLI	 2]
OPDEF	DDTOUT	[CALLI	 3]
OPDEF	DEVCHR	[CALLI	 4]
OPDEF	CORE	[CALLI	11]
OPDEF	EXIT	[CALLI	12]
OPDEF	UTPCLR	[CALLI	13]
OPDEF	DATE	[CALLI	14]
OPDEF	MSTIME	[CALLI	23]
OPDEF	PJOB	[CALLI	30]
OPDEF	SETUWP	[CALLI	36]
OPDEF	REMAP	[CALLI	37]
OPDEF	GETSEG	[CALLI	40]
OPDEF	SETNAM	[CALLI	43]
OPDEF	TMPCOR	[CALLI	44]


	ASUPPRESS
	MLON
	SALL
SUBTTL	INITIALIZATION
BEG:	IFE L,<	IFN RPGSW,<
	TDZA	F,F		;NORMAL START
	SETO	F,		;CCL START>
	SETZM	DATBEG		;ZERO FIRST WORD OF DATA STORAGE
	MOVE	N,[DATBEG,,DATBEG+1]
	BLT	N,DATEND-1	;ZERO ENTIRE DATA AREA
IFN RPGSW,<			;IF NO CCL FALL THROUGH TO LD:
	JUMPE	F,LD		;CCL: IF NORMAL START GO TO LD
	RESET			;RESET UUO.
IFN TEMP,<MOVEI F,CTLBUF-1	;USE CCL BUFFER FOR COMMANDS
	HRRM F,CTLIN+1		;DUMMY UP BYTE POINTER
	HRLI F,-200	;MAKE IT AN IOWD
	MOVEM F,TMPFIL+1
	MOVSI F,'LOA'
	MOVEM F,TMPFIL
	MOVE N,[XWD 2,TMPFIL]	;POINTER FOR TMPCOR READ
	TMPCOR	N,		;READ AND DELETE LOA FILE
	JRST RPGTMP		;NO SUCH FILE IN CORE, TRY DISK
	IMULI N,5		;GET CHAR COUNT
	ADDI N,1
	MOVEM N,CTLIN+2		;STORE IN BUFFER HEADER
	MOVEI N,700		;BYTE POINTER FOR LOA FILE
	HRLM N,CTLIN+1		;BYTE POINTER NOW COMPLETE
	SETOM TMPFLG		;MARK THAT A TMPCOR READ WAS DONE
	JRST RPGS3C		;GET BACK IN MAIN STREAM
RPGTMP:				; NOT TMP>
	INIT	17,1	;SET UP DSK FOR COMMAND FILE INPUT.
	SIXBIT /DSK/
	XWD 0,CTLIN
	JRST	NUTS	;CAN'T INIT, GET INPUT FROM TTY.
	MOVEI	F,3
	PJOB	N,	;GET JOB NUMBER
LUP:	IDIVI	N,12	;STRIP OFF LAST DIGIT
	ADDI	N+1,"0"-40	;CONVERT TO SIXBIT
	LSHC	N+1,-6	;SAVE
	SOJG	F,LUP	;3 DIGITS YET?
	HRRI	N+2,'LOA'	;LOADER NAME PART OF FILE NAME.
	MOVEM	N+2,CTLNAM
	MOVSI	'TMP'		;AND EXTENSION.
	MOVEM	CTLNAM+1
	LOOKUP	17,CTLNAM	;FILE THERE?
	JRST	NUTS		;NO.
	INIT 16,1	;GET SET TO DELETE FILE
	SIXBIT /DSK/
	0
	JRST RPGS3A	;GIVE UP
	SETZM CTLNAM+3	;PUT STUFF BACK AS IT WAS
	LOOKUP 16,CTLNAM
	JRST RPGS3B
	SETZM CTLNAM	;SET FOR RENAME
	RENAME 16,CTLNAM
	JFCL		;IGNORE FAILURE
RPGS3B:	RELEASE 16,	;GET RID OF DEVICE
RPGS3A:			;WE HAVE NOT YET STARTED TO SCAN
			;COMMAND IN FILE.
RPGS3:	MOVEI	CTLBUF	
	MOVEM	.JBFF
	INBUF	17,1		;SET UP BUFFER.
RPGS3C:	TTCALL	3,[ASCIZ /LOADING/]	;PRINT MESSAGE THAT WE ARE STARTING.
	SKIPE	NONLOD		;CONTIUATION OF COMMAND?
	JRST	RPGS2		;YES, SPECIAL SETUP.
CCLCHN:	MOVSI	N,RPGF		;@ CHAIN FILES CYCLE FROM HERE
	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  ;AS NAME
		   MOVEM W,DTIN	;STORE AS NAME
		   SETZM W,DTIN1	;TRY BLANK EXTENSION FIRST.
		   JRST LDDT4]
	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,.JBREL
	SETOM	NONLOD		;SET TO -1 AND SKIP CALLI
IFN TEMP,<SETZM TMPFLG>
	MOVE 	0,ILD1
	MOVEM	0,RPG1
	OPEN	17,OPEN1		;KEEP IT PURE
	JRST	[MOVE	W,RPG1
		JRST	ILD5]
	LOOKUP	17,DTIN		;THE FILE NAME.
	JRST	[MOVE	0,SVRPG	;RESTORE AC0=F
		TLOE	F,ESW	;WAS EXT EXPLICIT?
		JRST	ILD9	;YES, DON'T TRY AGAIN.
		MOVEM	0,SVRPG	;SAVE AC0 AGAIN
		MOVSI	0,(SIXBIT /TMP/)	;TRY TMP INSTEAD
		MOVEM	0,DTIN1
		PUSHJ P,LDDT4	;SET UP PPN
		JRST	.-1]	;TRY AGAIN
	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.

NUTS:	TTCALL	3,[ASCIZ /?LOADER command file not found/]
	EXIT
>;END OF IFN RPGSW
>;END OF IFE L

LD:			;HERE AFTER INITIALIZATION IF NO CCL
IFN L,< HRRZM 0,LSPXIT
	HRRZM W,LSPREL#	;SAVE LISP'S RELOCATION
	MOVEI 0,0
	HRRZM R,RINITL
	RESET>
IFE L,<IFN RPGSW,<
	HLLZS	.JBERR		;MAKE SURE ITS CLEAR.>
	RESET			;INITIALIZE THIS JOB
	SETZ	N,		;CLEAR N
CTLSET:	SETZB	F,S		;CLEAR THESE AS WELL
IFN TENEX,<TLO F,SYMSW!RMSMSW	;ASSUME /S
	TRO F,DMNFLG		;ASSUME /B
	SETZM NLSTGL		;PERMIT LST OF UNDEF. GLOBALS>
	HLRZ	X,.JBSA		;TOP OF LOADER
	HRLI	X,V		;PUT IN INDEX
	HRRZI	H,.JBDA(X)	;PROGRAM BREAK
	MOVE	R,[XWD W,.JBDA]	;INITIAL RELOCATION>
	MOVSI	E,'TTY'
	DEVCHR	E,
	TLNN	E,10		;IS IT A REAL TTY?
IFN RPGSW,<JRST	[TLNN	N,RPGF	;IN CCL MODE?>
		EXIT		;NO, EXIT IF NOT TTY
IFN RPGSW,<	TRO F,NOTTTY	;SET FLAG
		JRST	LD1]	;SKIP INIT>
	INIT	3,1 		;INITIALIZE CONSOLE
	SIXBIT    /TTY/
	XWD	BUFO,BUFI
CALLEX:	EXIT			;DEVICE ERROR, FATAL TO JOB
	MOVEI     E,TTY1
	MOVEM     E,.JBFF
	INBUF     3,1
	OUTBUF    3,1 		;INITIALIZE OUTPUT BUFFERS
	OUTPUT    3,			;DO INITIAL REDUNDANT OUTPUT
LD1:
IFE L,<	HRRZ	B,.JBREL	;MUST BE JOBREL FOR LOADING REENTRANT>
IFN L,<	MOVE	B,.JBSYM	;USED INSTEAD OF JOBREL FOR SYMBOL TABLE FIXUPS>
	HRRZM	B,HISTRT
	SUB	B,SE3		;INITIALIZE SYMBOL TABLE POINTER
	CAILE     H,1(B)	;TEST CORE ALLOCATION
IFE L,<	JRST	[HRRZ	B,.JBREL;TOP OF CORE
		ADDI	B,2000	;1K MORE
		CORE	B,	;TRY TO GET IT>
		EXIT		;INSUFFICIENT CORE, FATAL TO JOB
IFE L,<		JRST	LD1]	;TRY AGAIN>
IFN EXPAND,<MOVE S,[10,,12]	;CORMAX IN NSWTBL
	GETTAB	S,		;GET MAX CORE ALLOWED TO A JOB
	MOVSI	S,1		;SET TO VERY LARGE
IFN REENT,<HLRZ	E,.JBHRL	;BUT DON'T INCLUDE HIGH SEGMENT
	SUBI	S,1(E)		;IN LOW SEGMENT MAX>
IFE REENT,<SUBI	S,1		;ONE LESS FOR K BOUND>
	MOVEM	S,ALWCOR	;SAVE IT FOR XPAND TEST>
IFN PURESW,<MOVE S,[XWD HICODE,LOWCOD]
	BLT S,LOWCOD+CODLN-1>
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
	MOVEM	S,NAMPTR		;INITIALIZE PROGRAM NAME POINTER
IFE L,<	HRRI	R,.JBDA		;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>
	MOVEI     E,F.C		;INITIALIZE STATE OF THE LOADER
	BLT	E,B.C
	MOVE	W,[ZBEG,,ZBEG+1]
	SETZM	ZBEG		;CLEAR START OF INITIALIZED DATA
	BLT	W,ZEND		;AND THE REST
IFN CPUSW,<
	MOVNI	W,1		;-1
	AOBJN	W,.+1		;STANDARD TEST
	JUMPN	W,.+2		;KA-10 (OR PDP-6)
	TRO	F,KICPFL	;KI-10>
IFN REENT,<MOVSI W,1
	MOVEM W,HVAL1
	MOVEM W,HVAL
	MOVEM X,LOWX
	MOVEM R,LOWR
	HRRZI	W,1	
	SETUWP	W,		;SETUWP UUO.
	TRO	F,NOHI6		;PDP-6 COMES HERE.>
IFN REENT!CPUSW,<
	MOVEM	F,F.C		;PDP-10 COMES HERE.>
IFN SAILSW,<MOVE W,[XWD -RELLEN-1,LIBFLS-1]	;SET UP POINTERS
	MOVEM W,LIBPNT#	;IN THE FORM OF AOBJN WORDS
	MOVE W,[XWD -RELLEN-1,PRGFLS-1]
	MOVEM W,PRGPNT#>
IFE L,<	MOVSI	W,254200	;STORE HALT IN .JB41
	MOVEM	W,.JB41(X)	;...>
IFN L,<	MOVE W,.JBREL
	HRRZM W,OLDJR>
IFN B11SW,<MOVEI W,440000	;SET UP THE SPECIAL BITS OF HEADNUM(ADD+POLISH)
	MOVEM	W,HEADNM
	MOVEI	W,PDLOV	;ENABLE FOR PDL OV
	MOVEM	W,.JBAPR
	MOVEI	W,200000
	CALLI	W,16
>
IFN DMNSW,<MOVEI W,SYMPAT
	MOVEM W,KORSP>
IFN MONLOD,<IFN PURESW,<
	MOVEI	W,.RBALC	;NUMBER OF WORDS FOR ENTER
	MOVEM	W,DIOUT
	MOVEI	W,DALLOC	;NUMBER OF BLOCKS TO ALLOCATE
	MOVEM	W,DIOUT+.RBEST>>
IFN SFDSW,<GETPPN	W,	;GET USER'S PPN
	MOVEM	W,MYPPN		;SAVE IT FOR [,,] ETC>
IFN FORSW,<MOVEI W,FORSW-1	;GET DEFAULT
	MOVEM	W,FORLIB	;INCASE USER DOESN'T SET IT>
;LOADER SCAN FOR FILE NAMES

LD2Q:	XOR	N,F.C+N		;HERE WE STORE THE TWO BITS FOR
	AND	N,[AUXSWI!AUXSWE,,ENDMAP]	;THE AUX FILE INTO THE
	XORM	N,F.C+N		;SAVED REGISTER 'N'
	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,'DSK'		;ASSUME DSK.
	MOVEM	T,ILD1>
	SETZM	OLDDEV	;TO MAKE IT GO BACK AFTER /D FOR LIBSR

LD2B:	RELEAS    1,			;RELEASE BINARY INPUT DEVICE
IFN PP,<SETZM	PPPN		;CLEAR PERMANENT PPN ON EACH NEW LINE>
IFN RPGSW,<	TLNE	N,RPGF		;NOT IF DOING CCL STUFF
	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
LD2BP:	TLNE	F,LIBSW		;WAS LIBRARY MODE ON?
	TLO	F,SKIPSW	;YES, NORMAL MODE IS SKIPPING
LD2DD:	SETZM	DTIN		;CLEAR FILE NAME AFTER , CR-LF, ETC

LD2D:	SKIPE	W,OLDDEV	;RESET DEVICE IF NEEDED.
	CAMN	W,ILD1		;IS IT SAME?
	JRST	LD2DC		;YES, FORGET IT.
	MOVEM	W,ILD1
LD2DB:	TLZ	F,ISW+DSW+FSW+REWSW
LD2DC:	IFN PP,<SETZM	PPN	;DON'T REMEMBER PPN FROM ONE FILE TO NEXT.>
LD2DA:	SETZB   W,OLDDEV		;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>
	SOSGE	BUFI2		;DECREMENT CHARACTER COUNTER
	JRST	[INPUT	3,	;FILL TTY BUFFER
		JRST	.-1]	;MAKE SURE NOT A NULL BUFFER
	ILDB	T,BUFI1		;LOAD T WITH NEXT CHARACTER
LD3AA:	CAIE	T,175	;OLD ALTMOD
	CAIN	T,176	;EVEN OLDER ONE
	MOVEI	T,33	;NEW ONE
	CAIL	T,140	;LOWER CASE?
	TRZ	T,40	;CONVERT TO UPPER CASE
	MOVE	Q,T
	HRLM	Q,LIMBO		;SAVE THIS CHAR.
	MOVSS	LIMBO		;AND LAST ONE
	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
IFN SYMARG,<CAIL Q,20			;SKIP UNLESS SECOND FORM OF DISPATCH
	JRST	LD3AB			;DIFFERENT 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

;HERE ON ERRORS

LD2C:	POP	P,(P)		;BACKUP ONE LEVEL
LD2:	SETZM	SBRNAM		;CLEAR BLOCK TYPE 6 SEEN
IFN RPGSW,<TLNE	N,RPGF		;IN CCL MODE
	TRNN	F,TRMFL		;YES, /G SEEN?>
	JRST	LD2Q		;NO, START A NEW LINE
IFN RPGSW,<POPJ	P,		;AND RETURN>

;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 SYMARG,<XWD LD7,LD10		;BAD CHAR,&>

IFN SYMARG,<
LD3AB:	ROT	Q,-1			;CUT Q IN HALF
	HRRZ	A,LD3A(Q)		;PULL OFF RIGHT HALF OF TABLE ENTRY
	JUMPGE	Q,@A			;WHICH IS CORRECT FOR EVEN ENTRIES
	HLRZ	A,LD3A(Q)		;BUT USE LEFT HALF FOR ODD ENTRIES
	JRST	@A>

IFN RPGSW,<
RPGRD1:	MOVNI T,5
	ADDM T,CTLIN+2
	AOS	CTLIN+1
RPGRD:	SOSG	CTLIN+2	;CHECK CHARACTER COUNT.
	JRST	RPGRD2
	IBP	CTLIN+1	;ADVANCE POINTER
	MOVE	T,@CTLIN+1	;AND CHECK FOR LINE #
	TRNE	T,1
	JRST	RPGRD1
	LDB	T,CTLIN+1	;GET CHR
	JRST	LD3AA		;PASS IT ON

RPGRD2:
IFN TEMP,<SKIPE	TMPFLG	;TMPCOR UUO READ DONE?
	JRST	RPGRD3	;YES, SO SHOULD NEVER GET HERE>
	IN	17,0
	JRST	RPGRD+2
	STATO	17,740000
	JRST	RPGRD3	;END OF FILE
	ERROR	,</ERROR WHILE READING COMMAND FILE!/>
	EXIT		;AND GIVE UP

RPGRD3:	ERROR	,</END-OF-FILE ON COMMAND FILE!/>
	EXIT
>

SUBTTL	CHARACTER HANDLING

;ALPHANUMERIC CHARACTER, NORMAL MODE
LD4:	SOJL	E,LD3		;JUMP IF NO SPACE FOR CHAR IN W
	CAIGE	T,141		;WORRY ABOUT LOWER CASE LETTERS
	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,LD2DC		;JUMP IF NULL DEVICE IDENTIFIER
	EXCH   W,ILD1		;STORE DEVICE IDENTIFIER
	MOVEM	W,LSTDEV	;SAVE LAST DEVICE SO WE CAN RESTORE IT
	JRST	LD2DB		;RETURN FOR NEXT IDENTIFIER

;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>
LD5A:	IFN SYMARG,<
	TRNE	F,ARGFL		;IS "." SPECIAL
	JRST	LD4		;YES,RADIX-50>
	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	LD2DC		;RETURN FOR NEXT IDENTIFIER

;INPUT SPECIFICATION DELIMITER <,>
LD5B:
IFN PP,<TLZE	N,PPCSW			;READING PP #?
	JRST	[
IFN SFDSW,<	SKIPN	D		;JUST A COMMA SEEN?
		HLRZ	D,MYPPN		;YES, USE OWN PROJ #>
IFE STANSW,<	HRLM	D,PPN		;STORE PROJ #
		JRST	LD6A1		];GET PROG #>
IFN STANSW,<	PUSHJ	P,RJUST		;RIGHT JUSTIFY W
		HRLM	W,PPN		;STORE PROJ NAME
		JRST	LD2D		];GET PROG NAME>
	PUSHJ	P,SFDCK		;CHECK FOR SFD DIRECTORY>
	SETOM	LIMBO		;USED TO INDICATE COMMA SEEN
	TLZN	F,FSW		;SKIP IF PREV. FORCED LOADING
	PUSHJ     P,FSCN2		;LOAD (FSW NOT SET)
	JRST	LD2BP		;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 <]>

LD5C:
IFN SPCHN,<CAIN T,"="	;DO A /= AS SWITCH
	TLNN F,SSW
	SKIPA
	JRST LD6>
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
IFN SFDSW,<	SETZM	SFD		;USED AS A FLAG>
IFE STANSW,<	JRST	LD6A2]>		;READ NUMBERS AS SWITCHES
IFN STANSW,<	JRST	LD2D]>
	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,'MAP'		;ASSUME <.MAP> IN DEFAULT CASE
	HRRI	W,0		;CLEAR RIGHT HALF OF EXTENSION
	CAMN	W,['CHN   ']	;TEST FOR <.CHN> EXTENSION
	MOVSI	W,'MAP'		;AND TURN IT BACK TO MAP
IFN MONLOD,<CAMN W,['XPN   ']	;IS EXTENSION 'XPN'?
	JRST	DIOPEN		;YES, OPEN DISK IMAGE FILE>
IFN SYMDSW,<CAMN W,['SYM   ']	;IF EXT IS SYM
	JRST	SYOPEN		;OPEN AUX FOR SYMBOL FILE>
	MOVEM     W,DTOUT1		;STORE FILE EXTENSION IDENTIFIER
	MOVE	W,DTIN			;LOAD INPUT FILE IDENTIFIER
	MOVEM     W,DTOUT		;USE AS OUTPUT FILE IDENTIFIER
IFN SPCHN,<MOVEM W,CHNENT	;AND FOR SPECAIL CHAINING>
IFN PP,<SKIPN	W,PPN			;PROJ-PROG #
	MOVE	W,PPPN			;TRY PERMANENT ONE
	MOVEM	W,DTOUT+3		;...>
	MOVE	W,ILD1			;LOAD INPUT DEVICE IDENTIFIER
	MOVEM	W,LD5C1			;USE AS OUTPUT DEVICE IDENTIFIER
IFN SPCHN,<SKIPN CHNACB			;ARE WE DOING A SPECIAL CHAIN?
	MOVEM	W,CHNOUT+1		;ALLOW HIM TO CHOOSE SP CHAIN DEV>
	SKIPN	W,LSTDEV		;RESTORE LAST
IFN PP,<MOVSI W,'DSK'			;RESET DEVICE TO DSK>
	SETZM	LSTDEV			;BUT ONLY ONCE
	MOVEM	W,ILD1
;INITIALIZE AUXILIARY OUTPUT DEVICE

IFN SYMDSW,<
	TLNN	F,LSYMFL	;IGNORE IF ALREADY IN USE
	PUSHJ	P,AUXINI
	JRST	LD2DD
AUXINI:>
	TRZ	F,TTYFL
IFE SYMDSW,<TLZE N,AUXSWI+AUXSWE		;FLUSH CURRENT DEVICE
	RELEASE	2,			;...>
	MOVE	W,LD5C1			;GET AUX DEVICE
	DEVCHR	W,			;IS DEVICE A TTY?
	TLNE	W,10			;...
	TRO	F,TTYFL			;YES SET FLAG
	TLNE	W,(1B4)			;IS IT CONTROLING TTY?
IFE SYMDSW,<JRST LD2DD			;YES, SKIP INIT>
IFN SYMDSW,<POPJ P,>
	OPEN	2,OPEN2			;KEEP IT PURE
	JRST	ILD5A
	TLNE	F,REWSW			;REWIND REQUESTED?
	UTPCLR	2,			;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,.JBFF
	OUTBUF	2,1			;INITIALIZE SINGLE BUFFER
	TLO	N,AUXSWI		;SET INITIALIZED FLAG
IFN LNSSW,<EXCH	E,.JBFF
	SUBI	E,AUX
	IDIV	C,E
	OUTBUF	2,(C)>
IFE SYMDSW,<JRST LD2DD			;RETURN TO CONTINUE SCAN>
IFN SYMDSW,<POPJ P,>
;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
IFN PP,<
SFDCK:	IFN SFDSW,<
	TLNN	N,PPSW		;READING PP #?
	POPJ	P,		;NO
	SKIPE	SFD		;READING SFD YET?
	JRST	SFDCK1		;YES
	SKIPN	D		;NUMBER SEEN?
	HRRZ	D,MYPPN		;NO, USE MINE
	HRRM	D,PPN		;STORE IT
	MOVEM	X,SFD		;NEED AN AC, SETS SFD NON-ZERO
	MOVE	X,[-SFDSW,,SFD]	;INITIALIZE POINTER
	JRST	LD2DA		;GET FIRST SFD

SFDCK1:	AOBJP	X,SFDER		;ERROR IF TOO MANY SFDS
	MOVEM	W,(X)		;STORE IN SLOT
	JRST	LD2DA		;GET NEXT SFD

SFDER:	MOVE	X,SFD		;RESTORE X
	ERROR	,</?TOO MANY SFDS SPECIFIED@/>
	JRST	LD2
	
>
RBRA:	TLZN	N,PPSW		;READING PP #?
	POPJ	P,		;NOPE, RETURN
	TLZE	N,PPCSW		;COMMA SEEN?
	JRST	LD7A		;NOPE, INDICATE ERROR
IFN SFDSW,<SKIPN	SFD		;A FULL PATH SPECIFIED?
	JRST	RBRA1		;NO
	AOBJP	X,SFDER		;MUST STORE LAST SFD
	MOVEM	W,(X)
	SETZM	1(X)		;END WITH A ZERO
	MOVE	X,SFD		;RESTORE X
	MOVEI	W,SFDADD	;POINT TO SFD PATH
	EXCH	W,PPN
	MOVEM	W,SFD		;STORE IN BLOCK
	JRST	RBRA2		;CONTINUE
RBRA1:>
IFE STANSW,<HRRM	D,PPN		;STASH PROG NUMBER
		TLZ	F,SSW	;AND TURN OFF SWITCH MODE>
IFN STANSW,<PUSHJ	P,RJUST		;RIGHT JUSTIFY W
	HRRM	W,PPN		;STASH PROG NAME>
	MOVE	W,PPN		;GET PPN
RBRA2:	SKIPN	DTIN		;FILE NAME SEEN IN THIS SPEC?
	SKIPE	PPNW		;OR SOMETHING WAITING IN W?
	JRST	RBRA3		;YES, SO WE'VE GOT A FILE NAME SOMEWHERE
	MOVEM	W,PPPN		;NO , SO MAKE PERMANENT PPN
IFN SFDSW,<MOVE	W,[SFD,,PSFD]
	BLT	W,PSFD+SFDSW	;MOVE FULL PATH
	MOVEI	W,PSFDAD	;POINT TO IT
	SKIPE	SFD		;BUT NOT IF IT'S ZERO
	MOVEM	W,PPPN		;AND STORE>
RBRA3:	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

IFN STANSW,<
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		;...>>

IFN SYMARG,<
;& SELECTS A SYMBOL RATHER THAN ANUMBER FOR A SWITCH ARGUMENT
;& MUST ALSO FOLLOW THW SYMBOL; THE FORM IS /&SYMBOL&SWITHCH
LD10:	TRC	F,ARGFL		;SET OR CLEAR SPECIAL CHARS.
	TLCE	F,SSW		;IF IN SWITCH MODE, EXIT TO GET IDENTIFIER
	JRST	LD10B
	PUSHJ	P,ASCR50	;IF NOT, REENTER IT, CONVERT IDENTIFIER TO R50
	PUSHJ	P,SDEF		;AND SEE IF IT EXISTS
	JRST	LD10A		;YES IT DOES
	PUSHJ	P,PRQ		;NO, COMPLAIN. OUTPUT ?
	PUSHJ	P,SPACE		;FOLLOWED BY A SPACE
	PUSHJ	P,PRNAME	;FOLLOWED BY THIS SYMBOL
	ERROR	0,</ DOESN'T EXIST@/>
	JRST	LD2
LD10A:	MOVE	D,2(A)		;SET D=VALUE OF SYMBOL AS NUMERIC ARG
	TLZ	F,DSW!FSW
	MOVEI	E,6		;INITIALIZE NEW IDENTIFIER SCAN
	MOVE	V,LSTPT		;(W IS ALREADY 0)
	JRST	LD3		;NOW EAT SWITCH AND CONTINUE PROCESSING COMMAND
LD10B:	PUSHJ	P,FSCN1		;FORCE SCAN TO COMPLETION TO MAKE SURE FILE IS LOADED
	JRST	LD2DA>
SUBTTL	CONVERT SYMBOL IN W TO RADIX-50 IN C

IFN SYMARG,<
;ALSO USES A
ASCR50:	MOVEI	A,0
R50A:	MOVEI	C,0
	ROTC	W,6		;C IS NEXT SIXBIT CHAR
	CAIGE	C,20
	JRST	R50B		;UNDER 20, MAY BE ., $, OR %
	CAILE	C,31
	JRST	R50C		;OVER 31
	SUBI	C,20-1		;IS NUMBER
R50D:	IMULI	A,50
	ADD	A,C
	JUMPN	W,R50A		;LOOP FOR ALL CHARS
	MOVE	C,A		;WIND UP WITH CHAR IN C
	TLO	C,040000	;MAKE IT GLOBAL DEFINITION
	POPJ	P,
R50B:	JUMPE	C,R50D		;OK IF SPACE
	CAIE	C,16		;TEST IF .
	JRST	.+3		;NO
	MOVEI	C,45		;YES
	JRST	R50D
	CAIE	C,4		;SKIP IF $
R50E:	MOVEI	C,5		;ASSUME % IF NOTHING ELSE
	ADDI	C,42
	JRST	R50D
R50C:	CAIGE	C,41
	JRST	R50E		;BETWEEN 31 AND 41
	CAILE	C,72
	JRST	R50E		;OVER 72
	SUBI	C,41-13		;IS LETTER
	JRST	R50D>

;DEFINE PUTS A SYMBOL IN THE UNDEFINED SYMBOL TABLE
;SO LOADER CAN SCAN LIBRARY AND LOAD PROGRAMS BEFORE THEY ARE REQUESTED
;THE FORM IS /&SYMBOL# WHERE SYMBOL IS CONVERTED TO RADIX-50
IFN SYMARG,<
DEFINE:	PUSHJ	P,ASCR50	;CONVRT TO R-50
	MOVEI	W,-2(S)		;WHERE SYMBOL WILL GO
	CAIG	W,(H)		;ENOUGH ROOM
IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
		TLOA	F,FULLSW
		JRST	POPJM3
		POPJ	P,]>
IFE EXPAND,<TLO	F,FULLSW>
	SUB	S,SE3		;ADJUST POINTER
	MOVEM	C,1(S)		;R-50 SYMBOL
	SETZM	2(S)		;VALUE
	TLZ	F,DSW!SSW	;TURN OFF SWITCHES
	TRZ	F,ARGFL		; DITTO
	TLZN	N,SLASH		;IF NOT /&NAME#
	JRST	LD6A2		;MUST BE (&NAME#), GET )
	JRST	LD2D		;CONTINUE TO SCAN
>

SUBTTL	TERMINATION
;LINE TERMINATION <CARRIAGE RETURN>

LD5D:
IFN PP,<PUSHJ	P,RBRA		;CHECK FOR UNTERMINATED PP #>
	SKIPGE	LIMBO		;WAS LAST CHAR. BEFORE CR A COMMA?
	TLO	F,DSW		;YES ,SO LOAD ONE MORE FILE
	PUSHJ   P,FSCN		;FORCE SCAN TO COMPLETION
	JRST	LD2B		;RETURN FOR NEXT LINE

;TERMINATE LOADING <ALT MODE>

LD5E:	JUMPE	D,LD5E1		;ENTER FROM G COMMAND
	TLO	N,ISAFLG	;AND IGNORE ANY STARTING ADDRESS TO COME
	HRRZM	D,STADDR	;USE NUMERIC STARTING ADDRESS
LD5E1:	PUSHJ	P,CRLF		;START A NEW LINE
IFN RPGSW,<TRO	F,TRMFL		;INDICATE TERMINATION STAGE
	RELEASE 17,0		;RELEASE COMMAND DEVICE>
IFN MANTIS,<TRNN N,MANTFL	;LOADING MANTIS?
	JRST	LD5E2		;NO
IFN KUTSW,<SETOM CORSZ		;DON'T KUT BACK CORE>
IFN DMNSW,<TRZ	F,DMNFLG	;OR MOVE SYMBOLS>
LD5E2:	>
	PUSHJ	P,SASYM		;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
IFE NAMESW,<MOVE W,['LOADER']	;FINAL MESSAGE>
	JUMPL	S,.+2		;UNDEFINED SYMBOLS
	SKIPE	MDG		;OR MULTIPLY DEFINED
	PUSHJ	P,PRQ		;PRINT "?" FOR BATCH
IFN NAMESW,<HRRZ W,HISTRT	;IN CASE NO NAME SET, USE FIRST LOADED
	MOVE	W,-1(W)
	SKIPN	CURNAM
	PUSHJ	P,LDNAM
	MOVE	W,CURNAM
	CAME	W,[SIXBIT /MAIN/]	;FORTRAN MAIN PROG, OR MACRO NO TITLE
	JUMPN	W,.+3		;A USEFUL NAME SEEN
	SKIPE	PRGNAM		;NO, SO TRY BINARY FILE NAME
	MOVE	W,PRGNAM	;USE BINARY FILE NAME IN EITHER CASE
IFE L,<MOVEM	W,CURNAM	;SAVE NAME FOR LATER>
IFN L,<SETNAM W,		;SETNAM>>
IFN MONLOD,<TLNN N,DISW		;SKIP IF LOADING TO DISK?>
	PUSHJ P,BLTSET		;SETUP FOR FINAL BLT
	RELEASE	2,		;RELEASE AUX. DEV.
	RELEASE 1,0	;INPUT DEVICE
	RELEASE 3,0	;TTY
IFN SPCHN,<RELEASE 4,0	;SPECIAL CHAINING CHANEL>

IFN L,<	MOVE	W,LSPREL	;RESTORE LISP'S RELOCATION
	JRST @LSPXIT>
IFE L,<			;NONE OF THIS NEEDED FOR LISP
IFN PURESW,<
	MOVE	V,[XWD HHIGO,HIGO]
	BLT	V,HIGONE	;MOVE DOWN CODE TO EXIT>
	TLNN N,EXEQSW	;DO WE WANT TO START
	JRST LD5E3
IFN RPGSW,<HRRZ	C,.JBERR	;CHECK FOR ERRORS
IFE MANTIS,<TLNN N,DDSW		;ALLOW EXECUTION IF TO DDT>
IFN MANTIS,<TDNN N,[DDSW,,MANTFL]	;OR MANTIS>
	JUMPN	C,EXDLTD	;ERRORS AND NOT TO DDT>
IFN MONLOD,<TLNE N,DISW		;DISK IMAGE LOAD IN PROGRESS?
	MOVE X,XRES		;YES, GET RESIDENT X>
	HRRZ W,.JBSA(X)
IFN MANTIS,<TRNN N,MANTFL	;NO MESSAGE IF STARTING SPECIAL DEBUGGER>
	TLNN N,DDSW	;SHOULD WE START DDT??
IFE TENEX,<JRST	LD5E2	;NO>
IFN TENEX,<JRST	LD5E2	;NO
	 PUSH P,1
	 MOVEI 1,400000	;THIS FORK
	 DIR
	 CIS
	JSYS 147	;TENEX RESET, NOT CALLI 0.  FLUSH PA1050
	 MOVE 1,.JBSYM(X)
	 MOVEM 1,@770001	;GIVE SYMS TO DDT
	 MOVE 1,.JBUSY(X)
	 MOVEM 1,@770002	;AND UNDEF SYMS
	 POP P,1>
	HRRZ W,.JBDDT(X)
	TTCALL	3,[ASCIZ /DDT /]
LD5E2:	IFN MANTIS,<
	SKIPE	V,MNTSYM	;SHOULD WE START SPECIAL DEBUGGER?
	TRNN	N,MANTFL
	JRST	.+3		;NO
	HRRZ	W,.JBREN##(X)	;YES
	MOVEM	V,.JBCN6##(X)	;SETUP AUXILARY SYMBOL POINTER>
IFN RPGSW,<	TLNE	N,RPGF	;IF IN RPG MODE
	JUMPE	W,NOSTAD	;ERROR IF NO STARTING ADDRESS>
	JUMPE	W,LD5E3	;ANYTHING THERE?
	TLOA W,(JRST)	;SET UP A JRST
LD5E3:	SKIPA W,CALLEX	;NO OR NO EXECUTE, SET CALLI 12
IFN MANTIS,<TRNE N,MANTFL	;NO MESSAGE IF STARTING SPECIAL DEBUGGER
	CAIA>
	TTCALL 3,[ASCIZ /EXECUTION
/]
IFN TENEX,<MOVEM X,V		;SAVE AWAY RELOCATION
	MOVE X,.JBSA(X)		;NEW START ADDRESS
	HRLI X,<JRST>B53	;JRST IN LH
	MOVEI N,400000		;THIS FORK
	SEVEC			;SET ENTRY VECTOR
	MOVE X,V		;UNSAVE RELOCATION>
IFN LDAC,<	HRLZ P,BOTACS	;SET UP FOR ACBLT
	MOVEM W,.JBBLT+1(X)	;SET JOBBLT
	MOVE W,[BLT P,P]
	MOVEM W,.JBBLT(X)>
	MOVE	V,.JBVER(X)	;GET VERSION NUMBER
	MOVEM	V,.JBVER	;SET IT UP BEFORE SETNAM UUO
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	JRST DIOVER		;YES, CLEAN UP THE XPN FILE>
	TLNE	F,FULLSW	;DID WE RUN OUT OF CORE?
	HRRZ	A,Q		;YES, NULIFY BLT
	MOVSI LSTAC,LODACS	;SET UP TO BLT BLT CODE INTO ACS
	BLT LSTAC,LSTAC
IFN KUTSW,<SKIPGE E,CORSZ	;DO WE WANT CORE ADJUST
	MOVE CORAC,JFCLAC	;NO, CLEAR COREUUO>
IFE LDAC,<MOVE LSTAC,W		;SET END CONDITION>
IFN PURESW,<
	MOVSI	V,LD		;DOES IT HAVE HISEG
	JUMPG	V,HINOGO	;NO,DON'T DO CORE UUO
	MOVSI	V,1		;SET HISEG CORE NONE ZERO
	JRST	HIGO		;AND GO>
IFE PURESW,<
IFN NAMESW,<MOVE	W,CURNAM	;GET PROGRAM NAME
	SETNAM	W,		;SET IT FOR VERSION WATCHING>
JRST 0>

LODACS:	PHASE 0
	BLT Q,(A)	;BLT CODE DOWN
IFN KUTSW,<CORAC:!	CORE E,	;CUT BACK CORE
JFCLAC:!	JFCL	;SHOULD NEVER HAVE AN ERROR SINCE REDUCING CORE>
	SETZB	0,7		;CLEAR ACCS OTHERWISE USER
	SETZB	11,17		;MIGHT BELIEVE GARBAGE THERE
LSTAC:! IFN LDAC,<JRST .JBBLT>
	IFE LDAC,<EXIT>
DEPHASE

IFN RPGSW,<
NOSTAD:	TTCALL 3,[ASCIZ /NO STARTING ADDRESS
/]
EXDLTD:	TTCALL 3,[ASCIZ /?EXECUTION DELETED
/]
	JRST LD5E3>
>	;END OF IFE L AT BEGINNING OF THIS PAGE

SUBTTL	PRINT FINAL MESSAGE
; SET UP BLT AC'S, SETDDT, RELEAS

BLTSET:	IFN RPGSW,<IFE K,<
	JUMPE	W,BLTST3	;NO MESSAGE FROM CHAIN IN CCL@>>
IFN MANTIS,<TRNE N,MANTFL	;NO MESSAGES IF SPECIAL DEBUGGER
	JRST	NOMAX>
	PUSHJ	P,FCRLF		;A RETURN
	MOVNI	Q,6		;SET CHARACTER COUNT TO 6
	MOVEI	D,77		;CHARACTER MASK
BLTST1:	TDNE	W,D		;TEST FOR SIXBIT BLANK
	JRST	BLTST2		;NO, SO PRINT  THE NAME
	LSH	D,6		;SHIFT MASK LEFT ONE CHAR
	AOJL	Q,BLTST1	;INCR COUNTER & REPEAT
BLTST2:	PUSHJ	P,PWORD1	;OUTPUT PROGRAM NAME
	PUSHJ P,SPACE
BLTST3:
IFN FAILSW,<MOVSI Q,-20	;FINISH UP LINK STUFF
FREND:	HLRZ V,LINKTB+1(Q)
	JUMPE V,NOEND
	HRRZ A,LINKTB+1(Q)
IFN REENT,<CAMGE V,HVAL1
	SKIPA X,LOWX
	MOVE X,HIGHX>
IFN L,<CAML V,RINITL>
	HRRM A,@X	;PUT END OF LINK CHAIN IN PROPER PLACE
NOEND:	AOBJN Q,FREND
IFN REENT,<MOVE X,LOWX	;RESET THINGS>>
IFN KUTSW,<
	SKIPGE C,CORSZ	;NEG MEANS DO NOT KUT BACK CORE
	JRST NOCUT
	JUMPE C,MINCUT	;0 IS KUT TO MIN. POSSIBLE
	LSH C,12	;GET AS A NUMBER OF WORDS
	SUBI C,1
	CAMG C,.JBREL	;DO WE NEED MORE THAN WE HAVE??
	JRST TRYSML	;NO, SEE IF NUMBER REQUESTED IS TOO SMALL
	MOVEI Q,0
	CORE Q,
	JFCL		;WE JUST WANT TO KNOW HOW MUCH
	HRRZS Q
	CAMGE Q,CORSZ
	JRST CORERR
	JRST NOCUT1	;SET FOR DO NOT CHANGE SIZE
TRYSML:	CAIG C,-1(R)	;IS DESIRED AMOUNT BIGGER THAN NEEDED
IFE TENEX,<MINCUT:>
	MOVEI C,-1(R)	;GET MIN AMOUNT
	IORI C,1777	;CONVERT TO A 1K MULTIPLE
IFN DMNSW,<	TRNN F,DMNFLG	;DID WE MOVE SYMBOLS??
	SKIPN .JBDDT(X)	;IF NOT IS DDT THERE??
	JRST	.+2>
IFE DMNSW,<SKIPE .JBDDT(X)	;IF NO SYMBOL MOVING JUST CHECK DDT>
	JRST NOCUT	;DO NOT CUT IF SYMBOLS AT TOP AND DDT
NOCUT1:	MOVEM C,.JBREL(X)	;SAVE FOR CORE UUO
	MOVEM C,CORSZ	;SAVE AWAY FOR LATER
	JRST	.+2
NOCUT:	SETOM CORSZ	;SET FOR NO CUT  BACK>
IFN RPGSW,<IFE K,<
	JUMPE	W,NOMAX	;NO MESSAGE IF CHAIN IN CCL@>>
IFN L,<HRRZ Q,.JBREL
	SUB Q,OLDJR	;PROPER SIZE>
IFE L,<HRRZ Q,.JBREL(X)>
	LSH Q,-12	;GET CORE SIZE TO PRINT
	ADDI Q,1
	PUSHJ P,RCNUM
IFN REENT,<MOVE Q,HVAL
	SUB Q,HVAL1
	HRREI	Q,-1(Q)	;SIZE IS ONE TOO BIG
	CAIG	Q,.JBHDA	;IS THERE ANY CODE LOADED THERE?
	SETZB	Q,HVAL		;NO , CLEAR ALL INDICATIONS OF IT
	JUMPE	Q,NOHY		;NO HIGH SEGMENT
	MOVEI	T,"+"-40	;THERE IS A HISEG
	PUSHJ	P,TYPE
	LSH	Q,-12
	ADDI	Q,1
	PUSHJ	P,RCNUM
NOHY:>
	MOVE W,[SIXBIT /K CORE/]
	PUSHJ P,PWORD
IFE L,<
IFN RPGSW,<TLNN N,RPGF	
	JRST	.+4		;NOT IN CCL MODE SO GIVE ALL INFO
	TLZ	F,FCONSW	;ONLY PUT ON MAP IF IN CCL MODE
	TLNN	N,AUXSWI	;IS THERE AN AUX DEV?
	JRST	NOMESS		;NO, SO SKIP REST OF THIS STUFF>
	MOVSI	W,',  '		;SET DELIMITER CHARACTERS
	MOVNI	Q,2		;SET COUNT TO 2
	PUSHJ	P,PWORD1	;OUTPUT THEM
IFN DMNSW,<TRNN F,DMNFLG>
	SKIPN .JBDDT(X)
	SKIPA Q,.JBREL(X)
	MOVEI Q,1(S)	;FIND THE AMOUNT OF SPACE LEFT OVER
	SUB Q,.JBFF(X)
	ADDI	Q,1	;ONE TWO SMALL
	PUSHJ P,RCNUM
IFN REENT,<
	SKIPN	HVAL		;CREATING A HIGH SEGMENT?
	JRST	NOHIFR		;NO
	MOVEI	T,'+'		;YES, TYPE +
	PUSHJ	P,TYPE
	HLRZ	Q,.JBHRL(X)	;GET HISEG BREAK
	SUBI	Q,1		;1 TOO HIGH (R=NEXT TO LOAD INTO)
	ANDI	Q,1777		;CUT TO WORDS FREE
	XORI	Q,1777
	PUSHJ	P,RCNUM		;TYPE
NOHIFR:>
	MOVE W,[SIXBIT / WORDS/]
	PUSHJ P,PWORD
	MOVE W,[SIXBIT / FREE/]
	PUSHJ P,PWORD
	PUSHJ P,CRLF
	ERROR	0,</LOADER USED !/>	;GIVE EXPLANATION
	MOVE Q,.JBREL
	LSH Q,-12
	ADDI Q,1
	PUSHJ P,RCNUM	;PRINT MAX LOW CORE SIZE
IFN REENT,<	SKIPE Q,.JBHRL	;GET SIZE OF HIGH SEGMENT
	PUSHJ P,[MOVEI Q,400001(Q) ;CLEAR HIGH ORDER BIT
		MOVEI T,"+"-40	;PRINT A HIGH CORE PART
		PUSHJ P,TYPE
		LSH Q,-12
		JRST RCNUM]>
	MOVE W,[SIXBIT /K CORE/]
	PUSHJ P,PWORD
NOMESS:	TLO	F,FCONSW	;FORCE PRINTING OF CRLF>
	PUSHJ	P,CRLF
IFE L,<
IFN REENT,<HLRZ	A,.JBCOR(X)	;GET HIGHEST ACTUAL DATA
	CAIL	A,.JBDA		;SEE IF GREATER THAN JOBDAT
	JRST	NOMAX		;YES, SKIP MESSAGE
	ERROR	0,</[NULL LOW SEGMENT]!/>
	PUSHJ	P,CRLF>
NOMAX:
IFE TENEX,<MOVE W,.JBDDT(X)
	SETDDT W,
	JUMPN	W,DDTSET	;DON'T BOTHER IF DDT SET
	HLRE	Q,.JBSYM(X)	;GET LENGTH OF SYMBOL TABLE
	MOVNS	Q		;AS POSITIVE NUMBER
	HRRZ	W,.JBSYM(X)	;GET START
	ADD	W,Q		;ADDRESS OF HIGHEST LOCATION
	HLRZ	Q,.JBSA(X)	;HIGHEST LOCATION SAVED BY MONITOR
IFN MANTIS,<TRNN N,MANTFL	;DONT CHECK ADR IF SPECIAL DEBUGGER>
	CAIG	W,(Q)		;IN BOUNDS?
	JRST	DDTSET		;YES, ALL OK
IFN REENT,<TRNE	F,SEENHI	;ANY HIGH SEGMENT STUFF?
	CAMGE	W,HVAL1		;YES, IN HI-SEG THEN?
	JRST	.+2		;NO
	JRST	DDTSET		;YES, ALL IS WELL>
	SETZM	.JBSYM(X)	;JOBSYM IS OUT OF BOUNDS
	CAIA			;JOBUSY ALSO, SO CLEAR THEM>
DDTSET:	SKIPLE	.JBUSY(X)	;IF ITS NOT A POINTER
	SETZM	.JBUSY(X)	;DON'T KEEP ADDRESS 

IFE TEN30,<HRLI Q,20(X)	;SET UP BLT FOR CODE
	HRRI Q,20>
IFN TEN30,<HRLI Q,.JBDDT(X)
	HRRI Q,.JBDDT>
>;END OF IFE L
	HRRZ A,R
	POPJ P,		;WE HAVE SET R UP BY CLEVER CODE IN SASYM
IFN KUTSW,<CORERR:	TTCALL 3,[ASCIZ /?NOT ENOUGH CORE
/]
	EXIT>

IFN TENEX,<
;SETUP TO CUT BACK CORE TO MINIMUM
;THIS IS MIN OF R AND TOP OF SYMTAB
MINCUT:	HLRE C,.JBSYM(X)
	MOVNS C
	ADD C,.JBSYM(X)
	HRRZS C
	JRST TRYSML		;GO COMPARE WITH R
>
SUBTTL	SET UP JOBDAT
SASYM:	TLNN F,NSW
	PUSHJ P,LIBF	;SEARCH LIBRARY IF REQUIRED
	PUSHJ P,FSCN	;FORCE END OF SCAN
IFN ALGSW,<MOVE C,[RADIX50 44,%OWN]
	MOVE	W,%OWN		;GET VALUE
	TRNE	N,ALGFL		;IF ALGOL PROG LOADED
	PUSHJ	P,SYMPT		;DEFINE %OWN
IFN REENT,<MOVE	X,LOWX		;MAKE SURE X IS CORRECT>>
IFN RPGSW,<HLRE A,S
	MOVNS A
	LSH A,-1
	ADD A,.JBERR
	HRRM A,.JBERR>
IFN SYMDSW,<PUSHJ P,READSYM	;READ BACK LOCAL SYMBOLS>
IFN SPCHN,<
	SKIPE	CHNACB		;TEST FOR SPECIAL CHAINING
	TRNN	N,CHNMAP	;TEST FOR ROOT SEGMENT PRINTED
	JRST	NOCHMP		;JUMP IF NO TO EITHER CONDITION
	SETZM	LINKNR		;CLEAR OVERLAY LINK NUMBER
	MOVE	A,BEGOV		;GET START OF OVERLAY POINT
IFN REENT,<ADDI A,(X)		;PLUS LOADER CORE BASE
	HRRZS	A		;CLEAR LEFT HALF OF REGISTER
	HRRZ	W,HILOW		;GET CURRENT SPOT IN LOW SEGMENT>
IFE REENT,<HRRZ W,R		;GET CURRENT SPOT IN LOW SEGMENT>
	CAMN	W,R		;TEST FOR ADDED MODULES
	TRZ	N,ENDMAP	;NO, THEN SUPRESS MAP AT END 
NOCHMP:	>			;END OF IFN SPCHN
	TRNE	N,ENDMAP	;WANT MAP AT END?
	PUSHJ	P,PRTMAP	;YES
	TLNN	N,AUXSWE	;TEST FOR MAP PRINTED YET
	TLZ	N,AUXSWI	; NO, THEN DON'T START NOW
	TRNN	N,ENDMAP	;DON'T PRINT UNDEFS TWICE
	PUSHJ P,PMS	;PRINT UNDEFS
	HRRZ A,H	;DO NOT CLOBBER H IF STILL INSERTING SYMBOLS
IFN MONLOD,<TLNN N,DISW	;SKIP IF LOADING TO DISK>
	SUBI A,(X)	;HIGHEST LOC LOADED INCLUDES LOC STMTS
	CAILE A,(R)	;CHECK AGAINST R
	HRR R,A		;AND USE LARGER
IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	MOVE X,XRES		;YES, GET RESIDENT OFFSET>
IFE L,<	HRRZ	A,STADDR	;GET STARTING ADDRESS
	HRRM	A,.JBSA(X)	;STORE STARTING ADDRESS
	HRRZM R,.JBFF(X)	;AND CURRENT END OF PROG
	HRLM R,.JBSA(X)>
IFN DMNSW,<MOVE C,[RADIX50 44,PAT..]	;MARK PATCH SPACE FOR RPG
	MOVEI W,(R)
	PUSHJ P,SYMPT
IFN REENT,<TRNE	F,HISYM		;SHOULD SYMBOLS GO IN HISEG?
	JRST	BLTSYM		;YES>>
IFN DMNSW!LDAC,<		;ONLY ASSEMBLE IF EITHER SET
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	JRST SASYM1		;YES, NO NEED TO EXPAND CORE>
IFE LDAC,<	TRNN F,DMNFLG	;GET EXTRA  SPACE IF SYMBOLS
	JRST	NODDT	;MOVED OR IF LOADING ACS>
IFE DMNSW,<	MOVEI A,20	;FOR LOADING ACS>
IFN DMNSW,<	MOVE A,KORSP
IFN LDAC,<	TRNN F,DMNFLG	;ONLY 20 IF SYMBOLS NOT MOVED
	MOVEI A,20>>
	ADDI A,(R)	;GET ACTUAL PLACE TO PUT END OF SPACE
	ADDI A,(X)
	CAIL A,(S)	;DO NOT OVERWRITE SYMBOLS
IFN EXPAND,<JRST [PUSHJ P,XPAND>
		PUSHJ P,MORCOR
IFN EXPAND,<	JRST .-1]>
IFN LDAC,<HRRM R,BOTACS	;SAVE BOTTOM OF WHERE WE PUT ACS
	HRRZ A,R
	ADDI A,(X)
	HRL A,X	;SET UP BLT FROM (X) TO R(X)
	MOVEI Q,17(A)
	BLT A,(Q)>>
IFN DMNSW,<TRNN F,DMNFLG	;NOW THE CODE TO MOVE SYMBOLS
	JRST NODDT
IFN MONLOD,<SASYM1:>
	HRRZ A,R
	ADD A,KORSP
	MOVE W,A	;SAVE POINTER TO FINAL LOC OF UNDEFS
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	PUSHJ P,DISYM		;YES, GET BREAK ADDRESS INTO CORE>
	ADDI A,(X)
	HLLZ Q,S	;COMPUTE LENGTH OF SYMBOL TABLE
	ADD Q,B
	HLROS Q
	MOVNS Q
	ADDI Q,-1(A)	;GET PLACE TO STOP BLT
	HRLI A,1(S)	;WHERE TO BLT FROM
	SUBI W,1(S)	;GET AMOUNT TO CHANGE S AND B BY
	BLT A,(Q)	;MOVE SYMBOL TABLE
	ADD S,W
	ADD B,W	;CORRECT S AND B FOR MOVE
	HRRI R,1(Q)	;SET R TO POINT TO END OF SYMBOLS
IFN REENT,<HRRM	R,HILOW		;SAVE THIS AS HIGHEST LOC IN LOW SEG TO SAVE>
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	MOVE X,XCUR	;GET CURRENT BUFFER OFFSET>
	SUBI R,(X)
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	MOVE X,XRES		;SET UP OFFSET FOR RESIDENT PORTION>
	HRRM R,.JBFF(X)
	HRLM R,.JBSA(X)	;AND SAVE AWAY NEW JOBFF
IFE REENT,<HRRM	R,.JBCOR(X)	;DON'T LOSE LOW SEGMENT DATA>
IFN LDAC,<SKIPA>	;SKIP THE ADD TO R
NODDT:>
IFN LDAC,<ADDI R,20>	;MAKE SURE R IS CORRECT FOR BLT
	MOVE A,B
	ADDI A,1	;SET UP JOBSYM, JOBUSY
IFE L,<MOVEM A,.JBSYM(X)
IFN REENT,<TRNN	A,(1B0)		;SYMBOL TABLE IN HIGH SEGMENT?
	JRST	NOHYSM		;NO
	EXCH	X,HIGHX		;RELOCATE TO HIGH SEG.
	ADD	X,HVAL1		;ADD IN BASE OF HIGH SEGMENT
	MOVEM	A,.JBHSM(X)	;SINCE MAY NOT START AT 400000
	SUB	X,HVAL1		;BACK AS IT WAS
	EXCH	X,HIGHX
NOHYSM:	>>
IFN L,<MOVEM A,.JBSYM>
	MOVE A,S
	ADDI A,1
IFE L,<MOVEM A,.JBUSY(X)
	MOVE A,HISTRT	;TAKE POSSIBLE REMAP INTO ACCOUNT
IFN MANTIS,<TRNE N,MANTFL	;SPECIAL DEBUGGER?
	MOVE	A,.JBREL	;YES, USE OUR SEGTOP>
	MOVEM A,.JBREL(X)	;SET UP FOR IMEDIATE EXECUTION>
IFN L,<MOVEM A,.JBUSY>
IFN MONLOD,<TLNN N,DISW		;LOADING TO DSK?
	JRST	NOTDSK		;NO
	MOVE	A,.JBDDT(X)	;GET DDT STARTING ADDRESS
	MOVEM	A,.JBSDD(X)	;SO GET WILL RESTORE IT
	MOVE	A,.JB41(X)	;MAY AS WELL SET UP JOB41
	MOVEM	A,.JBS41(X)	;ALSO
NOTDSK:>
IFN REENT,<
	SKIPE A,HILOW	;SET UP TOP LOC OF LOW CORE EXCLUDING BLOCKS
	SUBI A,1(X)	;IF NON-ZERO THEN IT NEEDS RELOCATION
	HRLM A,.JBCOR(X)
	TRNN F,SEENHI
	POPJ P,
	HRRZ A,HVAL
	HRRM A,.JBHRL(X)
	SUB A,HVAL1
IFN DMNSW,<TRNE	F,HISYM		;SYMBOLS IN HISEG?
	ADDI	A,1		;YES, AT TOP OF CORE ALREADY
				;BUT HVAL ONE TOO SMALL>
	HRLM A,.JBHRL(X)>
	POPJ P,

SUBTTL	BLT SYMBOL TABLE INTO HIGH SEGMENT
IFN DMNSW&REENT,<
BLTSYM:	MOVE	Q,HVAL	;GET ORIGIN OF HISEG
	CAMN	Q,HVAL1	;HAS IT CHANGED?
	JRST	NOBLT	;NO
	HLLZ	Q,S	;COMPUTE LENGTH OF SYMBOL TABLE
	HLRS	S	;PUT NEG COUNT IN BOTH HALVES
	JUMPE	S,.+2	;SKIP IF S IS ZERO
	HRLI	S,-1(S)	;SUB 1 FROM LEFT TO FIX CARRY PROBLEM
	ADD	Q,B
	HLROS	Q
	MOVNS	Q
	ADD	Q,HVAL	;ADD LENGTH OF HISEG
	SUB	Q,HVAL1	;BUT REMOVE ORIGIN
	ADD	Q,HISTRT	;START OF HISEG IN CORE
	HRRZS	Q	;CLEAR INDEX FROM Q
	ADD	Q,KORSP	;SAVE SPACE FOR SYMBOL PATCHES
	CORE	Q,	;EXPAND IF NEEDED
	PUSHJ	P,MORCOR
	PUSH	P,B	;SAVE B
	SOJ	B,	;REMOVE CARRY FROM ADD TO FOLLOW
	MOVSS	B	;SWAP SYMBOL POINTER
	ADD	B,.JBREL
	HRRM	B,(P)	;SAVE NEW B
	MOVE	Q,.JBREL
	ADD	B,S	;INCASE ANY UNDEFS.
	BLT	B,(Q)	;MOVE SYMBOLS
	POP	P,B	;GET NEW B
	SUB	B,HISTRT
	ADD	B,HVAL1
	SOJ	B,	;REMOVE CARRY
	ADDI	S,(B)	;SET UP .JBUSY
BLTSY1:	MOVE	Q,.JBREL
	SUB	Q,HISTRT
	ADD	Q,HVAL1
	SUBI	Q,1	;ONE TOO HIGH
	MOVEM	Q,HVAL
	JRST	NODDT

NOBLT:	HRRZ	Q,H	;GET HIGHEST LOC LOADED
	IORI	Q,1777	;MAKE INTO A K BOUND
	MOVEI	A,-.JBHDA(S)	;GET BOTTOM OF UNDF SYMBOLS
	SUB	A,KORSP	;DON'T FORGET PATCH SPACE
	CAIG	A,(Q)	;ARE THEY IN SAME K
IFN EXPAND,<JRST	[PUSHJ	P,XPAND>
		PUSHJ	P,MORCOR
IFN EXPAND,<	JRST	NOBLT]>
	MOVEM	Q,HISTRT	;SAVE AS START OF HIGH
	MOVEI	A,400000	;HISEG ORIGIN
	MOVEM	A,HVAL1		;SAVE AS ORIGIN
	SUB	S,HISTRT	;GET POSITION OF UNDF POINTER
	ADDI	S,377777	;RELATIVE TO ORG
	SUB	B,HISTRT	;SAME FOR SYM POINTER
	ADDI	B,377777
	SUBI	Q,377777
	MOVEM	Q,HIGHX		;SO WE CAN SET HIGH JOB DATA AREA
	TRO	F,SEENHI	;SO JOBHRL WILL BE SET UP
	JRST	BLTSY1		;AND USE COMMON CODE
>

IFN DMNSW!LDAC!MANTIS!SYMDSW,<
MORCOR:	ERROR ,</MORE CORE NEEDED#/>
	EXIT>
SUBTTL	READ BACK LOCAL SYMBOLS
IFN SYMDSW,<
READSYM:
	TRZN	F,LSYMFL	;DID WE WRITE A SYMBOL FILE?
	POPJ	P,		;NO
	RELEASE	2,		;CLOSE IT OUT
	MOVE	W,SYMNAM	;GET NAME
	MOVEM	W,DTIN
	TRNE	N,ENDMAP	;MAP STILL REQUIRED?
	PUSHJ	P,AUXINI	;YES, RE-INIT AUX DEV
	MOVE	W,SYMEXT	;SEE IF EXTENSION SPECIFIED
	HRLZM	W,DTIN1
	TLZ	F,ISW
	TLO	F,ESW
	MOVSI	W,'DSK'
	MOVEM	W,ILD1
	PUSHJ	P,ILD
	PUSH	P,S		;SAVE NUMBER OF UNDEFINED SYMBOLS FOR LATER
	HLRE	V,S		;GET COUNT
	MOVMS	V		;AND CONVERT TO POSITIVE 
	HRLI	B,V		;PUT V IN INDEX FIELD
	HRRZ	S,HISTRT	;TOP OF CORE
	SUB	S,V		;MINUS SIZE
	HRLI	S,V		;V IN INDEX FIELD
				;MOW MOVE FROM  S TO B
	MOVE	W,@B
	MOVEM	W,@S
	SOJG	V,.-2		;FOR ALL ITEMS 
	HRRM	S,(P)		;S IS NOW BOTTOM OF UNDEFINED
	POP	P,S		;SO PUT COUNT BACK INTO S
	HRRZ	B,HISTRT	;POINT B TO TOP OF CORE FOR EXPAND
	MOVE	V,SYMCNT#	;GET  NUMBER OF SYMBOLS
	LSH	V,1		;2 WORDS PER SYMBOL
	SUBI	V,(S)		;BOTTOM OF SYMBOL TABLE
	ADDI	V,(H)		;-TOP OF CODE
	JUMPL	V,.+3
	PUSHJ	P,XPAND9
	  JRST	MORCOR
	MOVE	V,SYMCNT	;GET COUNT AGAIN
	LSH	V,1
	MOVNS	V		;NEGATE
	HRRZ	C,S
	ADD	C,V		;TO
	HRL	C,S		;FROM
	HLRE	W,S		;LENGTH
	MOVMS	W		;POSITIVE
	ADDI	W,(C)		;END OF BLT
	BLT	C,(W)		;MOVE UNDEFS AGAIN
	ADD	S,V		;FIXUP POINTER
	SETZM	NAMPTR		;HAVE NOT SEEN A PROG YET
	MOVE	T,SYMCNT	;NUMBER OF SYMBOL PAIRS TO READ
READS1:	PUSHJ	P,WORDPR
	MOVEM	W,(B)
	MOVEM	C,-1(B)
	SUB	B,SE3
	TLNN	C,740000	;NAME HAS NO  CODE BITS SET
	JRST	READS2		;YES, HANDLE IT
	SOJG	T,READS1	;READ NEXT SYMBOL
	JRST	READS4		;ALL DONE

READS2:	MOVE	W,NAMPTR	;POINT TO PREVIOUS NAME
	HRRZM	B,NAMPTR	;POINT TO THIS ONE
	JUMPE	W,READS3	;FIRST TIME?
	MOVE	C,W		;GET COPY
	SUBM	B,W		;COMPUTE RELATIVE POSITION
	HRLM	W,2(C)		;STORE BACK
READS3:	SOJG	T,READS1

READS4:	MOVEI	T,'SYM'
	CAMN	T,SYMEXT	;IF EXT IS SYM
	JRST	READS5		;DON'T DELETE FILE
	SETZM	DTIN
	SETZM	DTIN+3
	RENAME	1,DTIN
	  JFCL
READS5:	SETOM	SYMEXT		;SIGNAL NOT TO INIT SYMBOL FILE AGAIN
	POPJ	P,
>
SUBTTL	WRITE CHAIN FILES
IFE K,<			;DONT INCLUDE IN 1KLOAD
CHNC:	SKIPA	A,.JBCHN(X)	;CHAIN FROM BREAK OF FIRST BLOCK DATA
CHNR:	HLR	A,.JBCHN(X)	;CHAIN FROM BREAK OF FIRST F4 PROG
	HRRZS	A		;ONLY RIGHT HALF IS SIGNIFICANT
	JUMPE	A,LD7C		;DON'T CHAIN IF ZERO
	TLZN	N,AUXSWI!AUXSWE	;IS THERE AN AUX DEV?
	JRST	LD7D		;NO, DON'T CHAIN
	PUSH	P,A		;SAVE WHEREFROM TO CHAIN
	JUMPE	D,.+2		;STARTING ADDR SPECIFIED?
	HRRZM	D,STADDR	;USE IT
	CLOSE	2,		;INSURE END OF MAP FILE
	PUSHJ	P,SASYM		;DO LIB SEARCH, SETUP JOBSA, ETC.
IFN RPGSW,<TLNE	N,RPGF		;IF IN CCL MODE
	TDZA	W,W		;NO MESSAGES>
	MOVE	W,[SIXBIT ?CHAIN?]	;FINAL MESSAGE
	PUSHJ	P,BLTSET	;SETUP BLT PNTR, SETDDT, RELEAS
	POP	P,A		;GET WHEREFROM
	HRRZ	W,R		;CALCULATE MIN IOWD NECESSARY
	SKIPE	.JBDDT(X)	;IF JOBDDT KEEP SYMBOLS
	CAILE	W,1(S)
	JRST	CHNLW1
	HRRZ	W,.JBREL	;NEED SYMBOLS AND THEY HAVE NOT MOVED DOWN
	SUBI	W,(X)		;BECAUSE WE WILL NOT HAVE BLITTED
	SUBI	B,-1(X)		;SYMBOL TABLE WILL COME OUT IN A
	MOVEM	B,.JBSYM(X)	;DIFFERENT PLACE
CHNLW1:	MOVNS	W
	ADDI	W,-7(A)
	ADDI	A,-7(X)
	PUSH	A,W	;SAVE LENGTH
	HRLI	W,-1(A)
	MOVSM	W,IOWDPP	;...
	SETZM	IOWDPP+1	;JUST IN CASE
	PUSH	A,.JBCHN(X)
	PUSH	A,.JBSA(X)	;SETUP SIX WORD TABLE
	PUSH	A,.JBSYM(X)	;...
	PUSH	A,.JB41(X)
	PUSH	A,.JBDDT(X)
	SETSTS	2,17		;SET AUX DEV TO DUMP MODE
	MOVSI	W,'CHN'		;USE .CHN AS EXTENSION
	MOVEM	W,DTOUT1	;...
	PUSHJ	P,IAD2		;DO THE ENTER
	  JRST	LD2		;ENTER FAILURE
	OUTPUT	2,IOWDPP	;WRITE THE CHAIN FILE
	STATZ	2,IOBAD!IODEND
	JRST	LOSEBIG
	CLOSE	2,
	STATZ	2,IOBAD!IODEND
IFN RPGSW,<JRST	LOSEBIG
	TLNE	N,RPGF		;IF IN CCL MODE
	JRST	CCLCHN		;LOAD NEXT LINK
	EXIT>
LOSEBI:	TTCALL	3,[ASCIZ /?DEVICE ERROR/]
	EXIT>
SUBTTL	SPECIAL CHAINB
IFN SPCHN,<
CHNBG:	PUSHJ	P,FSCN1A	;FORCE SCAN TO COMPLETION FOR CURRENT FILE
	TLNN	N,AUXSWI	;IS THERE AN AUX DEV??
	JRST	CHNBG1		;NO, SKIP THIS CODE
	PUSH	P,W		;PRESERVE W
	MOVE	W,CHNOUT+1	;GET AUX DEV
	DEVCHR	W,		;GET ITS CHARACTERISTICS
	TLNN	W,DSKBIT	;IS IT A REAL DSK?
	TLZA	N,AUXSWI!AUXSWE	;NO, RELEASE MAP DEVICE
	TLNN	N,AUXSWE!AUXSWI	;SHOULD AUX DEVICE BE RELEASED?
	RELEAS	2,		;YES, RELEAS IT SO ENTER WILL NOT FAIL
	POP	P,W		;RESTORE W
CHNBG1:			;LABEL TO SKIP AUX DEV. CHECKING
IFN REENT,<TRO	N,VFLG		;GIVE HIM REENTRANT FORSE UNLESS /-V SEEN>
	HRLZI	W,-1(R)		;CHNTAB-L = ADDRESS OF VECTOR TABLE
	HRRI	W,1		;CHNTAB-R = NEXT DISK BLOCK TO RITE INTO
	MOVEM	W,CHNTAB
	MOVE	C,[RADIX50 4,OVTAB]	;DEFINE GLOBAL SYMBOL OVTAB
	MOVEI	W,(R)		;TO HAVE VALUE THE BEGINNING OF THE VECTOR TABLE
	PUSHJ	P,SYMPT
	ADDI	R,VECLEN	;RESERVE SPACE FOR VECTOR TABLE
	MOVE	C,[RADIX50 4,OVBEG]	;OVBEG IS BEGINNING OF OVERLAY AREA
	MOVEI	W,(R)
	PUSHJ	P,SYMPT
	HRRZM	R,BEGOV		;AND SAVE IN OVBEG
	SETZM	LINKNR		;SET CURRENT LINK # TO ZERO
	TRZ	N,CHNMAP	;SHOW ROOT NOT PRINTED
	OPEN	4,CHNOUT	;OPEN FILE FOR CHAIN
	  JRST	ILD5		;CANT OPEN CHAIN FILE
	SKIPE	CHNENT		;TEST FOR DEFINED CHAIN-FILE NAME
	JRST	CHNBG2		;YES, SKIP
	PUSH	P,W		;SAVE W
IFN NAMESW,<
	SKIPN	W,CURNAM	;GET CURRENT NAME & TEST FOR DEFINED >
	MOVE	W,['CHAIN ']	;SET NAME = 'CHAIN'
	MOVEM	W,CHNENT	;AND STORE AS FILE NAME
	POP	P,W		;RESTORE W
CHNBG2:	ENTER	4,CHNENT	;ENTER CHAIN FILE
	  JRST	CHNBG3		;ERROR 
	HRRZ	W,NAMPTR
	SUB	W,HISTRT	;KEEP N RIGHT HALF AS RELATIVE TO HISTRT
	HRRZM W,CHNACN	;SAVE FOR RESTORING
	MOVEM B,CHNACB	;ALSO B R IS SAVED IN BEGOV
	TRNE	N,ENDMAP	;TEST FOR DEFERED MAP REQUEST
	PUSHJ	P,PRTMAP	;YES, PRINT IT NOW
	AOS	LINKNR		;SET LINE NUMBER TO 1
	POPJ	P,

CHNBG3:	ERROR	,</ERROR WRITING CHAIN@/>
	POPJ	P,

CHNENS:	TLOA N,PPCSW	;THIS FLAG UNUSED AT THIS POINT
CHNEN:	TLZ N,PPCSW	;ON TO NOT DELETE NEW SYMBOLS
	SKIPN CHNACB	;WILL BE NON-ZERO IF WE SAW A /<  (> TO KEEP  MACRO HAPPY)
	JRST LD7D	;ERROR MESSAGE
	PUSHJ P,FSCN1A		;LOAD LIB (IF DESIRED) AND FORCE SCAN
	TRNE	N,ENDMAP	;TEST FOR DEFERED MAP REQUEST
	PUSHJ	P,PRTMAP	;YES, PRINT IT
	AOS	LINKNR		;INCR TO NEXT LINK NUMBER
	SKIPL Q,S	;CHECK SYMBOL TABLE FOR MISSED UNDEFS
	JRST NOER	;NONE THERE
	MOVEI E,0	;COUNT OF ERRORS
ONCK:
	IFN FAILSW,<SKIPL V,1(Q)	;IF HIGH ORDER BIT IS ON
	TLNN V,740000	;OR IF ALL CODE BITS 0
	JRST NXTCK	;THEN NOT TO BE CHECKED>
	MOVE V,2(Q)	;GET FIXUP WORD
	TLNE V,100000	;BIT INDICATES SYMBOL TABLE FIXUP
	JRST SMTBFX
IFN FAILSW,<TLNE V,40000	;BIT INDICATES POLISH FIXUP
	JRST POLCK>
	TLZE V,740000	;THESE BITS WOULD MEAN ADDITIVE
	JRST	[JSP A,CORCKL
		JRST NXTCK]	;ONLY TRY FIRST LOCATION
CORCK:	JSP A,CORCKL
	HRRZ V,@X	;THE WAY TO LINK
CORCKL:	IFN REENT,<CAMGE V,HVAL1>
	CAMGE V,BEGOV
	SKIPA	;NOT IN BAD RANGE
	JRST ERCK	;BAD, GIVE ERROR
	JUMPE V,NXTCK	;CHAIN HAS RUN OUT
IFN REENT,<CAMGE V,HVAL1	;GET CORRECT LINK
	SKIPA X,LOWX
	MOVE X,HIGHX>
	XCT (A)		;TELLS US WHAT TO DO
	JRST CORCKL	;GO ON WITH NEXT LINK

SMTBFX:	TLNE N,PPCSW	;IF NOT CUTTING BACK SYMBOL TABLE
	JRST NXTCK	;THE ALL OK
	ADD V,HISTRT	;GET PLACE TO POINT TO
	HRRZS V
	HLRE D,CHNACB	;OLD LENGTH OF TABLE (NEGATIVE)
	HLRE T,B	;NEW LENGTH
	SUB D,T		;-OLD LEN+NEW LEN
	ADDI D,(B)	;OLD BOTTOM=NEW BOTTOM+NEW LEN-OLD LEN
	CAIG V,(D)	;IS IT IN THE PART WE ARE KEEPING
	JRST ERCK
	JRST NXTCK	;YES
IFN FAILSW,<POLCK:	HLRZ C,V	;FIND HEADER
	PUSHJ P,SREQ
	SKIPA
	JRST LOAD4A	;SHOULD BE THERE
	HRL C,2(A)	;NOW FIRST OPERATOR (STORE)
	MOVSS C
	PUSHJ P,SREQ
	SKIPA
	JRST LOAD4A
	ANDI C,37	;GET OPERATION
	HRRZ V,2(A)	;DESTINATION
	JRST @CKSMTB-15(C)	;DISPATCH
CKSMTB:	EXP SMTBFX,SMTBFX,SMTBFX,CORCK,LCORCK,CORCK,NXTCK
LCORCK:	JSP A,CORCKL
	HLRZ V,@X>
ERCK:	MOVE C,1(Q)	;GET SYMBOL NAME
	PUSHJ P,FCRLF	;FORCE CRLF AND OUTPUT ON TTY
	PUSHJ P,PRNAME	;PRINT IT
	ADDI E,1	;MARK ERROR
NXTCK:	ADD Q,SE3	;TRY ANOTHER
	JUMPL Q,ONCK
IFN REENT,<PUSHJ P,RESTRX	;GET PROPER X BACK>
	JUMPE E,NOER	;DID ANYTHING GO WRONG??
	ERROR	,</UNDEFINED GLOBAL(S) IN LINK@/>
	TRZE	N,ENDMAP	;DELAYED MAP IN PIPELINE
	PUSHJ	P,PRTMAP	;YES, GO DO IT
	JRST LD2	;GIVE UP

NOER:	TRZE	N,ENDMAP	;DELAYED MAP IN PIPELINE
	PUSHJ	P,PRTMAP	;YES, GO DO IT
	MOVE A,BEGOV	;GET START OF OVERLAY
	ADDI A,(X)	;GET ACTUAL CURRENT LOCATION
IFN REENT,<HRRZ	W,HILOW	;AND END OF OVERLAY+1
	HRRZM A,HILOW	;RESET>
IFE REENT,<HRRZ W,R
	ADDI	W,(X)	;A BETTER GUESS>
	SUBM A,W	;W=-LENGTH
	SUBI A,1	;SET TO BASE-1 (FOR IOWD)
	HRL A,W		;GET COUNT
	MOVEM A,IOWDPP
	SETZM	IOWDPP+1
	HRR A,CHNTAB	;BLOCK WE ARE WRITING ON
	HLRZ V,CHNTAB	;POINTER TO SEGMENT TABLE
	ADDI V,1	;NEXT LOCATION
	HRLM V,CHNTAB	;REMEMBER IT
	CAML V,BEGOV	;CHECK FOR OVERRUN
	JRST	[ERROR ,</?TOO MANY LINKS@/>
		JRST LD2];GIVE UP
	MOVEM A,@X	;PUT INTO TABLE
	MOVN W,W	;GET POSITIVE LENGTH
	MOVE	C,CHNOUT+1	;GET CHAIN DEV.
	DEVCHR	C,		;WHAT IS IT?
	MOVEI	A,DSKBLK	;ASSUME DSK
	TRNE	C,DTABIT	;BUT IF DTA
	MOVEI	A,DTABLK	;BLOCK IS 177
	ADDI	W,-1(A)
	IDIV	W,A		;GET NUMBER OF BLOCKS
	ADDM W,CHNTAB	;AND UPDATE
	TLZE N,PPCSW
	JRST NOMVB	;DO NOT ADJUST SYMBOLS
	HLRE W,CHNACB	;GET OLD LENGTH OF DEF SYMBOLS
	HLRE C,B	;AND NEW LENGTH
	SUB W,C		;-OLD LEN+NEW LEN
	HRRZ C,B	;SAVE POINTER TO CURRENT S
	ADD S,W
	HRL W,W
	ADD B,W		;UPDATE B (COUNT AND LOC)
	JUMPGE S,UNLNKD	;JUST IN CASE NOTHING TO MOVE
	HRRZ A,B	;PLACE TO PUT UNDEFS
UNLNK:	MOVE W,(C)
	MOVEM W,(A)	;TRANSFER
	SUBI A,1
	CAIE A,(S)	;HAVE WE MOVED LAST WORD??
	SOJA C,UNLNK	;NO, CONTINUE
UNLNKD:	HRRZ W,CHNACN	;GET SAVED N
	ADD W,HISTRT
	HRRZM	W,NAMPTR	;AND RESET IT
NOMVB:	HRR R,BEGOV	;PICK UP BASE OF AREA
	SETSTS	4,16	;SET DUMP MODE IN CASE OF INTERACTION WITH OTHER CHANNELS
	OUTPUT 4,IOWDPP	;DUMP IT
	STATZ 4,IOBAD!IODEND	;AND ERROR CHECK
	JRST LOSEBI
	HRRZ V,R	;GET AREA TO ZERO
	MOVEI W,@X
	CAIL W,1(S)	;MUST MAKE SURE SOME THERE
	POPJ P,	;DONE
	SETZM (W)
	CAIL W,(S)
	POPJ P,
	HRLS W
	ADDI W,1
	BLT W,(S)	;ZERO WORLD
	POPJ P,
>

SUBTTL	EXPAND CORE

IFN EXPAND,<
XPAND:	TLNE	F,FULLSW	;IF CORE  EXCEEDED
	POPJ	P,		;DON'T WASTE TIME  ON  CORE UUO
	PUSH	P,Q
	HRRZ	Q,.JBREL
	ADDI	Q,2000
XPAND1:	PUSH P,H	;GET SOME REGISTERS TO USE
	PUSH P,X
	PUSH P,N
	PUSH	P,.JBREL	;SAVE PREVIOUS SIZE
	CAMG	Q,ALWCOR	;CHECK TO SEE IF RUNNING OVER
	CORE Q,
	JRST XPANDE
IFE K,<	HRRZ H,MLTP	;GET LOWEST LOCATION
	TLNN N,F4SW	;IS FORTRAN LOADING>
	MOVEI H,1(S)	;NO, USE S
	POP	P,X	;LAST .JBREL
	HRRZ	Q,.JBREL;NEW JOBREL
	SUBI	Q,(X)	;GET DIFFERENCE
	HRLI	Q,X	;PUT X IN INDEX FIELD
XPAND2:	MOVE N,(X)
	MOVEM N,@Q
	CAMLE X,H	;TEST FOR END
	SOJA X,XPAND2
	HRLI	H,-1(Q)
	TLC	H,-1	;MAKE IT NEGATIVE
	SETZM (H)	;ZERO NEW CORE
	AOBJN H,.-1
	MOVEI H,(Q)
XPAND8:	ADD	S,H
	ADD	B,H
	ADDM H,HISTRT	;UPDATE START OF HISEG
IFN REENT,<ADDM H,HIGHX	;AND STORE LOCATION
	TLNE F,HIPROG
	ADDM H,-1(P)	;X IS CURRENTLY IN THE STACK>
	POP P,N
	ADDM	H,NAMPTR
IFE K,<
IFN MANTIS,<SKIPE MNTSYM	;DEBUGGER DATA PRESENT?
	ADDM H,MNTSYM>
	TLNN N,F4SW	;F4?
	JRST	XPAND3
	ADDM H,PLTP
	ADDM H,BITP
	ADDM H,SDSTP
	ADDM H,MLTP
	TLNE N,SYDAT
	ADDM H,V>
XPAND3:	AOSA -3(P)
XPAND5:	POP P,N
	POP P,X
	POP P,H
	POP	P,Q
	POPJ P,

XPANDE:	POP	P,A		;CLEAR JOBREL OUT OF STACK
XPAND6:	ERROR	,</MORE CORE NEEDED#/>
	TLO	F,FULLSW	;ONLY ONCE
	JRST XPAND5

XPAND7:	PUSHJ	P,XPAND
	JRST	SFULLC
IFN MONLOD,<TLNE N,DISW		;LOADING TO DISK?
	JRST	POPJM3		;YES, RETURN TO CALL-2>
	JRST	POPJM2

XPAND9:	PUSH	P,Q		;SAVE Q
	HRRZ	Q,.JBREL	;GET CORE SIZE
	ADDI	Q,(V)		;ADD XTRA NEEDED
	JRST	XPAND1		;AND JOIN COMMON CODE

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
>


SUBTTL	SWITCH HANDLING

;ENTER SWITCH MODE

LD6A:	CAIN	T,57		;WAS CHAR A SLASH?
	TLO	N,SLASH		;REMEBER THAT
LD6A2:	TLO	F,SSW		;ENTER SWITCH MODE
LD6A1:	SETZB	D,C	;ZERO TWO REGS FOR DECIMAL AND OCTAL
IFN SYMARG,<TRZ	F,ARGFL	;CLEAR SPECIAL SYMBOL SWITCH >
	JRST	LD3		;EAT A SWITCH

;ALPHABETIC CHARACTER, SWITCH MODE

LD6:
	CAIL	T,141		;ACCEPT LOWER CASE SWITCHES
	SUBI	T,40
IFN SPCHN,<XCT	LD6B-74(T)	;EXECUTE SWITCH FUNCTION>
IFE SPCHN,<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:
IFN SPCHN,<PUSHJ P,CHNBG	;LESS THAN - BEGINNING OF OVERLAY
	PUSHJ	P,CHNENS	;= - PUT OUT CHAIN RETAINING SYMBOLS
	PUSHJ	P,CHNEN		;GREATER THAN - END OF OVERLAY
	JRST	LD7B		;? - ERROR
	JRST	LD7B		;@ - ERROR>
	PUSHJ	P,ASWTCH	;A - LIST ALL GLOBALS
IFN DMNSW,<PUSHJ P,DMN2		;B - BLOCKS DOWN SYMBOL TABLE >
IFE DMNSW,<JRST	LD7B		;B - ERROR>
IFE K,<	PUSHJ	P,CHNC		;C - CHAIN, START W/ COMMON>
IFN K,<	JRST	LD7B		;C - ILLEGAL IN 1KLOAD>
	PUSHJ   P,LDDT		;D - DEBUG OPTION, LOAD DDT
	TLO	N,EXEQSW	;E - LOAD AND GO
	PUSHJ    P,LIBF0	;F - LIBRARY SEARCH
	PUSHJ    P,LD5E		;G - GO INTO EXECUTION
IFN REENT,<PUSHJ P,HSET		;H - REENTRANT. PROGRAM>
IFE REENT,<JFCL			;JUST IGNORE /H>
	PUSHJ	P,ISWTCH	;I - IGNORE STARTING ADDRESSES
	TLZ	N,ISAFLG	;J - USE STARTING ADDRESSES
IFE KUTSW,<JRST	LD7B		;K - ERROR>
IFN KUTSW,<MOVEM C,CORSZ	;K - SET DESIRED CORE SIZE>
	PUSHJ	P,LSWTCH	;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
	PUSHJ	P,PSWTCH	;P - PREVENT AUTO. LIB. SEARCH
	TLZ	F,NSW		;Q - ALLOW AUTO. LIB. SEARCH
IFE K,<	PUSHJ	P,CHNR		;R - CHAIN, START W/ RESIDENT>
IFN K,<	JRST	LD7B		;R - ILLEGAL IN 1KLOAD>
	PUSHJ	P,SSWTCH	;S - LOAD WITH SYMBOLS
	PUSHJ	P,LDDTX		;T - LOAD AND GO TO DDT
	PUSHJ   P,PMSQ		;U - PRINT UNDEFINED LIST
IFN REENT,<PUSHJ P,VSWTCH	;V - LOAD REENTRANT LIB40>
IFE REENT,<JRST	LD7B		;V - ERROR>
	TLZ	F,SYMSW+RMSMSW	;W - LOAD WITHOUT SYMBOLS
	TLZ	N,ALLFLG	;X - DO NOT LIST ALL GLOBALS
IFE TENEX,<TLO	F,REWSW		;Y - REWIND BEFORE USE>
IFN TENEX,<PUSHJ P,NEWPAG		;Y - ORIGIN TO NEXT PAGE BOUNDARY>
IFE L,<	JRST	LDRSTR		;Z - RESTART LOADER>
IFN L,<	JRST	LD7B		;Z -- ILLEGAL IN LISP LOADER>


; PAIRED SWITCHES ( +,-)

ASWTCH:	JUMPL	D,.+2		;SKIP IF /-A
	TLOA	N,ALLFLG	;LIST ALL GLOBALS
	TLZ	N,ALLFLG	;DON'T
	POPJ	P,

ISWTCH:	JUMPL	D,.+2		;SKIP IF /-I
	TLOA	N,ISAFLG	;IGNORE STARTING ADDRESSES
	TLZ	N,ISAFLG	;DON'T
	POPJ	P,

LSWTCH:	JUMPL	D,.+2		;SKIP IF /-L
	TLOA	F,LIBSW!SKIPSW	;ENTER LIBRARY SEARCH
	TLZ	F,LIBSW!SKIPSW	;DON'T
	POPJ	P,

PSWTCH:	JUMPL	D,.+2		;SKIP IF /-P
	TLOA	F,NSW		;PREVENT AUTO. LIB SEARCH
	TLZ	F,NSW		;ALLOW
	POPJ	P,

SSWTCH:	JUMPL	D,.+2		;SKIP IF /-S
	TLOA	F,SYMSW!RMSMSW	;LOAD WITH SYMBOLS
IFE MANTIS,<TLZ	F,SYMSW!RMSMSW	;DON'T>
IFN MANTIS,<TLZA F,SYMSW!RMSMSW	;DON'T
	TRZ	N,SYMFOR	;SYMBOLS LOAD EXPLICITLY SPECIFIED>
	POPJ	P,

IFN REENT,<
VSWTCH:	JUMPL	D,.+2		;SKIP IF /-V
	MOVEI	D,1		;SET VSW	= +1 FOR /V
	MOVEM	D,VSW		;		= -1 FOR /-V
	POPJ	P,>

IFN TENEX,<
;Y SWITCH - START LOADING AT NEXT PAGE BOUNDARY
NEWPAG:	JUMPL C,NEWLPG		;/-Y BUMPS LOWSEG LOC
	ADDI R,777		;/Y BUMPS HISEG LOC
	ANDCMI R,777
	POPJ P,0

NEWLPG:	MOVE D,LOWR
	ADDI D,777
	ANDCMI D,777
	MOVEM D,LOWR
	POPJ P,0

>
IFN REENT,<
; H SWITCH --- EITHER /H OR /NH
HSET:	JUMPE	D,SETNUM	;/H ALWAYS LEGAL
	CAIGE	D,2		;WANT TO CHANGE SEGMENTS
	JRST	SETSEG		;YES,GO DO IT
	TRNN	F,SEENHI	;STARTED TO LOAD YET?
	JRST	HCONT		;NO, CONTINUE.
IFE TENEX,<ERROR ,<?/H ILLEGAL AFTER FIRST HISEG FILE IS LOADED@?>>
IFN TENEX,<HRRZ C,HVAL
	CAIGE D,0(C)
	JRST HSET69
	HRRM D,HIGHR		;MOVE UP HIGH BREAK
	POPJ P,0

HSET69:	ERROR	,<?/H ILLEGAL: ATTEMPT TO LOWER HISEG BREAK@?>
	POPJ P,0>
>

IFE L,<
LDRSTR:	ERROR	0,</LOADER RESTARTED@/>
	JRST	BEG		;START AGAIN (NO CCL)>
IFN REENT,<
HCONT:	HRRZ C,D
IFE TENEX,<ANDCMI C,1777
	CAIL C,400000>
	CAIG C,(H)
	JRST COROVL	;BEING SET LOWER THAN 400000 OR MORE THAN TOP OF LOW SEG
	HRRZM C,HVAL1	;WE HAVE REMOVED THE ODD BITS TO MAKE A 1K MULT
	ADDI C,.JBHDA
	CAILE C,(D)	;MAKE SURE OF ENOUGH ROOM
	MOVE D,C
	HRLI D,W	;SET UP W IN LEFT HALF
	MOVEM D,HVAL
	POPJ	P,	;RETURN.

COROVL:	ERROR	,</HISEG STARTING ADDRESS TOO LOW@/>
	JRST LDRSTR
SETNUM:	TRO	F,NOHI	;SET NO-HIGH-SEG SWITCH.
	POPJ	P,>
;SWITCH MODE NUMERIC ARGUMENT

LD6C:	LSH	D,3 		;BUILD OCTAL NUMERIC ARGUMENT
	ADDI	D,-60(T)
	IMULI C,^D10
	ADDI C,-"0"(T)	;ACCUMULATE DEC AND OCTAL
	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:	IFN SYMARG,<
	CAIN	T,"#"		;DEFINING THIS SYMBOL
	JRST	DEFINE		;YES 
	TRNN	F,ARGFL		;TREAT AS SPECIAL
	JRST	.+4		;NO
	CAIE	T,"$"
	CAIN	T,"%"
	JRST	LD4		;YES>
	CAIN	T,"Z"-100	;TEST FOR ^Z
	JRST	LD5E1		;TREAT AS ALTMODE FOR BATCH
	ERROR	8,</CHAR.%/>
	JRST	LD2	;TRY TO CONTINUE

;SYNTAX ERROR, NORMAL MODE

LD7A:	ERROR	8,</SYNTAX%/>
	JRST	LD2

;ILLEGAL CHARACTER, SWITCH MODE

LD7B:	CAIN T,"-"	;SPECIAL CHECK FOR -
	JRST	[SETOB C,D
		JRST LD3]
	CAIN	T,"Z"-100	;CHECK FOR /^Z
	JRST	LD5E1		;SAME AS ^Z
	ERROR	8,</SWITCH%/>
	JRST	LD2
;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0

IFE K,<
LD7C:	ERROR	,<?UNCHAINABLE AS LOADED@?>
	JRST	LD2

;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE

LD7D:	ERROR	,<?NO CHAIN DEVICE@?>
	JRST	LD2>

IFN DMNSW,<
DMN2:
IFN REENT,<CAIN	D,1		;SPECIAL CASE
	TROA	F,HISYM		;YES ,BLT SYMBOLS INTO HISEG>
	JUMPL	D,.+2
	TROA	F,DMNFLG	;TURN ON /B
	TRZ	F,DMNFLG	;TURN OFF IF /-B
	CAMLE D,KORSP
	MOVEM D,KORSP
	POPJ	P,		 ;RETURN>


SUBTTL	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

;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 CLASSIFICATION 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
IFE SYMARG,<	BYTE	(4)0,0,0,0,5,3,0,0,11>
IFN SYMARG,<	BYTE	(4)0,0,14,0,5,3,0,0,11>
		BYTE	(4)0,7,5,2,2,2,2,2,2
IFE SPCHN,<	BYTE	(4)2,2,2,2,6,0,0,10,0>
IFN SPCHN,<	BYTE	(4)2,2,2,2,6,0,1,10,1>
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,1,1>
IFN PP,<BYTE	(4)1,10,0,10,0,10,0,1,1>
	BYTE	(4)1,1,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,0,0,13
	BYTE	(4)13,4

SUBTTL	INITIALIZE LOADING OF A FILE

ILD:	MOVEI     W,BUF1		;LOAD BUFFER ORIGIN
	MOVEM     W,.JBFF
	TLOE	F,ISW		;SKIP IF INIT REQUIRED
	JRST	ILD6		;DONT DO INIT
ILD7:	OPEN	1,OPEN3			;KEEP IT PURE
	  JRST	ILD5B
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 LNSSW,<
	INBUF   1,BUFN 		;SET UP BUFFERS>
IFN LNSSW,<INBUF 1,1
	MOVEI	W,BUF1
	EXCH	W,.JBFF
	SUBI	W,BUF1
IFE K,<MOVEI	C,4*203+1>
IFN K,<MOVEI	C,203+1>
	IDIV	C,W
	INBUF	1,(C)>
	TLO	F,ASW		;SET LEFT ARROW ILLEGAL FLAG
	TLZ	F,ESW		;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:
IFN CPUSW,<			;ALLOW LIB40I OR LIB40A TO FIND LIB40
	MOVE	W,DTIN		;GET NAME WE TRIED FOR
	TRZN	W,77		;DELETE 6TH CHARACTER
	JRST	ILD4B		;TRIED ALL CASES IF NULL
IFN REENT,<CAME	W,['IMP40 ']	;IMP40? REQUESTED?>
	CAMN	W,['LIB40 ']	;WAS IT SOME FLAVOUR OF LIB40?
	JRST	[MOVEM	W,DTIN	;YES, SALT NEW NAME
		PUSHJ	P,LDDT2	;SET .REL AGAIN
		TLZ	F,ESW
		JRST	ILD2]
ILD4B:>
	IFE REENT,<IFE TEN30,<	;PDP-6 ONLY
	MOVE	W,[SIXBIT /LIB40/]
	CAME	W,DTIN		;WAS THIS A TRY FOR LIB40?
	JRST	ILD4A		;NO
	TRZ	W,(SIXBIT / 0/)	;YES
	MOVEM	W,DTIN		;TRY LIB4
	PUSHJ	P,LDDT2		;USE .REL EXTENSION
	TLZ	F,ESW		;...
	JRST	ILD2		;GO TRY AGAIN
ILD4A:>>

ILD9:	ERROR	,</CANNOT FIND#/>
	JRST	LD2C

;	DEVICE SELECTION ERROR

ILD5A:	SKIPA	W,LD5C1
ILD5B:	MOVE	W,ILD1
ILD5:	PUSHJ	P,PRQ		;START W/ ?
	PUSHJ   P,PWORD		;PRINT DEVICE NAME
	ERROR	7,</UNAVAILABLE@/>
	JRST	LD2

SUBTTL	LIBRARY SEARCH CONTROL AND LOADER CONTROL

LIBF0:	IFN FORSW,<
	JUMPE	D,LIBF		;MAKE /F WORK SAME WAY
	SOSGE	D		;USER SUPPLIED VALUE?
	MOVEI	D,FORSW-1	;NO, SUPPLY DEFAULT
	MOVEM	D,FORLIB	;STORE VALUE
	POPJ	P,		;RETURN HAVING SETUP FOR /0F>

LIBF:	PUSHJ   P,FSCN1		;FORCE SCAN TO COMPLETION
	PUSH	P,ILD1		;SAVE DEVICE NAME
IFN PP,<SETZM	PPN		;CLEAR LOCAL PPN
	SETZM	PPPN		;AND GLOBAL PPN>
	PUSHJ	P,LIBF1		;LOAD SYS:JOBDAT.REL
IFN SAILSW,<LIBAGN: PUSHJ P,SALOAD	;LOAD RELS AND SEARCH LIBS>
IFN REENT,<SKIPGE W,VSW		;WAS /-V SEEN
	TRZ	N,VFLG		;YES, DOES NOT WANT REENTRANT SYSTEM
	CAILE	W,0		;SKIP IF HE DOESN'T KNOW OR CARE
	TRO	N,VFLG		;DEFINITELY WANTS REENTRANT SYSTEM
	TRNE	F,SEENHI!HISYM	;IF ANY HISEG LOADED NO RE-ENT OP SYSTEM
	TRZ	N,VFLG!MANTFL	;YES, SO FORCE /-V SWITCH
	TRNN	N,VFLG
	JRST	LIBF3
IFN ALGSW,<TRNE	N,ALGFL		;SPECIAL ACTION IF LOADING ALGOL
	PUSHJ	P,SHARE>
IFN FORSW,<TRNN	N,FORFL		;FORTRAN-10 ALWAYS WANTS FOROTS
	TRNE	N,F4FL		;IF F40
	SKIPG	FORLIB		;AND WANTING FORLIB
	JRST	LIBF3		;NOT BOTH TRUE
	MOVE	C,[RADIX50 04,FOROT%]	;SYMBOL
	MOVEI	W,400000+.JBHDA	;VALUE
	PUSHJ	P,SYMPT		;YES, DEFINE SYMBOL>
LIBF3:>
IFN NELSW,<TRNN	N,NELFL		;LOADING NELIAC
	JRST	.+4		;NO
	PUSHJ	P,NELGO		;UNDEFINED SYMBOL NELGO
	MOVE	W,[SIXBIT /LIBNEL/]
	PUSHJ	P,LIBF2		;LOAD NELIAC LIBRARY>
IFN ALGSW,<MOVE	W,[SIXBIT /ALGLIB/]
IFE NAMESW,<TRNE N,ALGFL	;LOADING ALGOL?>
IFN NAMESW,<TRNN N,ALGFL	;ALGOL?
	JRST	LIBF5+1		;NO
	SKIPE	CURNAM		;SEE MAIN PROG YET?
	JRST	LIBF5		;YES
	ERROR	,</ALGOL MAIN PROGRAM NOT LOADED!/>
	EXIT
LIBF5:>
	PUSHJ	P,LIBF2		;YES, LOAD LIBRARY>
IFN COBSW,<MOVE	W,[SIXBIT /LIBOL/]
	TRNE	N,COBFL		;LOADING COBOL?
	PUSHJ	P,LIBF2		;YES, SCAN LIBOL>
IFN REENT,<
IFE CPUSW,<MOVE	W,[SIXBIT /IMP40/]>
IFN CPUSW,<MOVE	W,['IMP40A']	;ASSUME KA-10
	TRNE	F,KICPFL	;BUT IS IT?
	HRRI	W,'40I'		;NO, CHANGE TO IMP40A>
IFN FORSW,<SKIPG FORLIB		;IF LOADING FORLIB WE DON'T WANT IMP40>
	TRNE	N,COMFLS-F4FL	;ANY OTHER COMPILER ?
	JRST	LIBF4		;YES, THEN WE DON'T WANT IMP40
	TRNE	N,VFLG		;WANT REENTRANT OP SYSTEM?
	PUSHJ	P,LIBF2		;YES, TRY REENTRANT FORSE>
LIBF4:
IFE CPUSW,<MOVE	W,[SIXBIT /LIB40/]>
IFN CPUSW,<MOVE	W,['LIB40A']
	TRNE	F,KICPFL
	HRRI	W,'40I'>
IFN FORSW,<SKIPLE FORLIB	;FORSE OR FOROTS
	MOVE	W,['FORLIB']	;YOU GET WHAT YOU ASK FOR>
IFN ALGSW,<TRNN	N,ALGFL		;DON'T NEED LIB40 FOR ALGOL>
	PUSHJ	P,LIBF2		;LOAD LIBRARY
IFN SAILSW,<MOVE W,LIBPNT	;SEE IF ANY MORE TO DO
	CAME W,[XWD -RELLEN-1,LIBFLS-1]
	JRST LIBAGN
	MOVE W,PRGPNT	;IT COULD BE DANGEROUS TO LOAD PROGRAMS HERE
	CAME W,[XWD -RELLEN-1,PRGFLS-1]
	JRST LIBAGN	;MORE TO DO, TRY AGAIN>
	POP P,ILD1	;CALL TO LDDT1 WILL PUT IT IN OLDDEV
LIBF1:	MOVE	W,[SIXBIT /JOBDAT/]	;LOAD SYS:JOBDAT.REL
LIBF2:	PUSHJ     P,LDDT1
LIBGO:	JUMPGE    S,EOF2		;JUMP IF NO UNDEFINED GLOBALS
	TLO	F,SLIBSW+SKIPSW	;ENABLE LIBRARY SEARCH
	TLZ	F,SYMSW	;DISABLE LOADING WITH SYMBOLS
	JRST	LDF 		;INITIALIZE LOADING LIB4
IFN ALGSW!NELSW,<
IFN NELSW,<
NELGO:	SKIPA	C,[RADIX50 60,%NELGO]>
SHARE:	MOVE	C,[RADIX50 60,%SHARE]
	MOVEI	 W,0
	JRST	SYMPT	;DEFINE IT >
;	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
IFN DIDAL,<TRNE	F,XFLG		;INDEX IN CORE?
	JRST	INDEX1		;YES>
	JRST	LOAD		;CONTINUE LIB. SEARCH

LIB1:	CAIE	A,4 		;TEST FOR ENTRY BLOCK
	JRST	LIB29		;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

LIB29:	CAIN	A,14		;INDEX BLOCK?
	JRST	INDEX0		;YES
LIB30:	HRRZ	C,W		;GET WORD COUNT
	JUMPE	C,LOAD1		;IF NUL BLOCK RETURN
	CAILE	C,^D18		;ONLY ONE SUB-BLOCK
	JRST	LIB3		;NO,SO USE OLD SLOW METHOD
	ADDI	C,1		;ONE FOR RELOCATION WORD

LIB31:	CAML	C,BUFR2		;DOES BLOCK OVERLAP BUFFERS?
	SOJA	C,LIB32		;YES,ALLOW FOR INITIAL ILDB
	ADDM	C,BUFR1		;ADD TO BYTE POINTER
	MOVNS	C		;NEGATE
	ADDM	C,BUFR2		;TO SUBTRACT C FROM WORD COUNT
	JRST	LOAD1		;GET NEXT BLOCK

LIB32:	SUB	C,BUFR2		;ACCOUNT FOR REST OF THIS BUFFER
	PUSHJ	P,WORD+1	;GET ANOTHER BUFFERFUL
	JRST	LIB31		;TRY AGAIN

IFN SAILSW,<

COMMENT * BLOCK TYPE 16 AND 17 USED TO SPECIFY PROGRAMS AND
LIBRARIES WHICH MUST BE LOADED (SEARCHED) IF THE PROGRAM
IN WHICH THE BLOCK APPEARS IS LOADED. IT IS NOW TIME TO
LOAD AND SEARCH THESE FILES. IF ANY MAKE REQUESTS, THEY ARE ADDED
TO THE END. WE WILL COME BACK AND LOOK AGAIN IN CASE A
LIBRARY PROGRAM LOAD A REL PROGRAM. ORIGINAL CODE BY DCS*

SALOAD:	MOVE T,[XWD -RELLEN-1,PRGFLS-1]	;TO RESET WITH AT END
	MOVEI D,PRGPNT	;OINTER TO UPPER LIMIT
	PUSHJ P,PRGPRG	;LOAD THEM IF ANY

;NOW FOR LIBRARY SEARCH

	MOVE T,[XWD -RELLEN-1,LIBFLS-1]
	MOVEI D,LIBPNT

PRGPRG:	MOVEM D,LODLIM#	;SAVE POINTER TO LIMIT
	MOVEM T,LODSTP#	;START FOR RESETTING
PRGBAK:	MOVEM T,LODPNT#	;AND START
	CAMN T,@LODLIM	;GOTTEN TO END YET?
	JRST PRGDON	;YES, DUMP IT
	SKIPN W,PRGDEV(T)	;IS DEVICE SPECIFIED?
	MOVSI W,(SIXBIT /DSK/)	;NO, DSK
	MOVEM W,ILD1	;WHERE WE INIT FROM
	MOVSI W,(SIXBIT /REL/)	;EXTENSION
	MOVEM W,DTIN1
	MOVE W,PRGFIL(T)
	MOVEM W,DTIN	;FILE NAME
	MOVE W,PRGPPN(T)	;THE PROJECT PROG
	MOVEM W,DTIN+3
	PUSH P,JRPRG	;A RETURN ADDRESS
	TLZ F,ISW	;FORCE NEW INIT
	HRRZ T,LODLIM
	CAIN T,LIBPNT	;WHICH ONE
	JRST LIBGO
	JRST LDF
PRGRET:	MOVE T,LODPNT	;RETURNS HERE, GET NEXT ONE
	AOBJN T,PRGBAK

PRGDON:	MOVE T,LODSTP	;RESTE POINTER IN CASE MORE ON OTHER LIBS
	MOVEM T,@LODLIM
JRPRG:	POPJ P,PRGRET	;PUSHED TO GET A RETURN ADDRESS

PRGFIL==1	;REL INDEX FOR FILE NAMES
PRGPPN==RELLEN+1	;AND FOR PPNS
PRGDEV==2*RELLEN+1	;AND FOR DEVICES
>	;END OF IFN SAILSW
SUBTTL	LDDT LOADS <SYS:DDT.REL> AND SETS SYMSW

LDDTX:	TLO	N,DDSW+EXEQSW		;T - LOAD AND GO TO DDT
LDDT:					;/D - LOAD DDT
IFN TENEX,<PUSH P,1
	PUSH P,3
	MOVEM 2,3	; X = 2
	MOVSI 1,100001
	HRROI 2,[ASCIZ /<SUBSYS>UDDT.SAV/]
	GTJFN
	 JRST LDDTQ
	PUSH P,1		;DDT JFN
	MOVEI 1,400000
	GEVEC			;LOADER'S EV
	POP P,1
	PUSH P,2
	HRLI 1,400000			;THIS FORK
	GET
	MOVEI 1,400000
	GEVEC			;DDT'S EV
	MOVEM 2,.JBDDT(3)	;3 HAS X IN IT
	POP P,2
	SEVEC			;RESTORE LOADER'S EVEC
	TLO F,SYMSW!RMSMSW	;DO /S  PROBABLY ON BY DEFAULT
	MOVE 2,3
	POP P,3
	POP P,1
	JRST DMN2

LDDTQ:	TTCALL 3,[ASCIZ /
DDT10X NOT AVAILABLE. USING DEC DDT./]
	MOVE 2,3
	POP P,3
	POP P,1>
IFN DMNSW,<	PUSH	P,D		;SAVE INCASE /NNND >
	PUSHJ     P,FSCN1		;FORCE SCAN TO COMPLETION
	MOVSI   W,'DDT'		;FILE IDENTIFIER <DDT>
	TLZ	F,SYMSW!RMSMSW	;DON'T LOAD DDT WITH LOCAL SYMBOLS
	PUSHJ     P,LDDT1
	PUSHJ     P,LDF		;LOAD <SYS:DDT.REL>
	TLO	F,SYMSW!RMSMSW		;ENABLE LOADING WITH SYMBOLS
IFN DMNSW,<	POP	P,D	;RESTORE D
	JRST	DMN2		;MOVE SYMBOL TABLE >
IFE DMNSW,<	POPJ	P,>

LDDT1:	MOVEM     W,DTIN		;STORE FILE IDENTIFIER
	MOVE	W,ILD1		;SAVE OLD DEV
	MOVEM	W,OLDDEV
IFN PP,<SETZM	PPPN		;CLEAR PERM PPN>
	MOVSI   W,'SYS'		;DEVICE IDENTIFIER <SYS>
	MOVEM     W,ILD1		;STORE DEVICE IDENTIFIER
	TLZ	F,ISW+LIBSW+SKIPSW+REWSW	;CLEAR OLD FLAGS
LDDT2:	MOVSI   W,'REL'		;EXTENSION IDENTIFIER <.REL>
LDDT3:	MOVEM     W,DTIN1		;STORE EXTENSION IDENTIFIER
LDDT4:	IFN PP,<
	PUSH	P,W		;SAVE W
	SKIPN	W,PPN		;GET TEMP PPN
	MOVE	W,PPPN		;TRY PERM
	MOVEM	W,DTIN+3	;SET PPN
	POP	P,W		;RESTORE W>
	POPJ	P,

SUBTTL	EOF TERMINATES LOADING OF A FILE

EOF:	MOVE	P,PDSAV		;RESTORE PUSHDOWN POINTER
EOF1:	TLZ F,SLIBSW!SKIPSW	;CLEAR ONE FILE LIB. SEARCH FLAG
IFN DIDAL,<TRZ	F,XFLG!LSTLOD	;CLEAR DIDAL FLAGS
IFN SYMDSW,<TRNE F,LSYMFL	;USING AUX BUF FOR  LOCAL SYMBOLS?
	JRST	EOF2		;YES>
	MOVSI	W,(1B0)		;FOOL MONITOR THAT WE HAVE NOT USED THIS BUFFER
	HLLM	W,ABUF		;THEN NEXT OUTPUT WILL BE A "DUMMY OUTPUT"
	MOVSI	W,700		;RESET BYTE POINTER TO ASCII
	MOVEM	W,ABUF1		;AND HOPE DUMMY OUTPUT WILL CLEAR DIDAL STUFF
	SETZM	ABUF2		;ZERO BYTE COUNT TO FORCE DUMMY OUTPUT>
EOF2:	TLNE F,RMSMSW	;IF REMEMBER LOADING WITH SYMBOLS IS ON
	TLO F,SYMSW	;THEN RESTORE SYMBOL LOADING STATE
	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
IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	MOVE W,DIEND		;YES, GET END OF BUFFER+1>
	SUBI W,1(S) ; COMPUT DEFICIENCY
	JUMPL     W,EOF2		;JUMP IF NO OVERLAP
	PUSHJ	P,PRQ			;START WITH ?
	PUSHJ     P,PRNUM0		;INFORM USER
	ERROR	7,</WORDS OF OVERLAP#/>
	JRST	LD2 		;ERROR RETURN

IFN SPCHN,<FSCN1A:	TLNN F,NSW
	PUSHJ P,LIBF>
FSCN1:	TLON	F,FSW		;SKIP IF NOT FIRST CALL TO FSCN
FSCN2:	TLNN	F,CSW+DSW+ESW	;TEST SCAN FOR COMPLETION
	POPJ	P,
	PUSHJ   P,LD5B1		;STORE FILE OR EXTENSION IDENT.

;	LOADER CONTROL, NORMAL MODE

LDF:	PUSHJ   P,ILD		;INITIALIZE LOADING
	TLNE	F,LIBSW		;IN LIBRARY SEARCH MODE?
	JRST	LIB		;CHECK IF NO UNDFS.

SUBTTL	LOAD SUBROUTINE

LOAD:	MOVEM   P,PDSAV		;SAVE PUSHDOWN POINTER
IFN WFWSW,<SETZM VARLNG		;LENGTH OF VARIABLE AREA-ADDED TO RELOC>
IFN ALGSW,<SETZM OWNLNG		;LENGTH OF OWN AREA-ADDED TO RELOC>
IFN FAILSW,<SETZM LFTHSW	;RESET LOAD LEFT HALF FIXUP SW>
IFN COBSW,<SETZM LOD37.		;CLEAR FLAG>
IFN MANTIS,<TRZE N,SYMFOR	;ZERO LOAD SYMBOLS IF IT WAS FORCED
	TLZ	F,SYMSW>
IFN TENEX,<SETZM NLSTGL		;ALLOW UNDEF. GLOBALS TO LIST>
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 B11SW,<SKIPN POLSW		;ERROR IF STILL DOING POLISH>
	CAIL	A,DISPL*2	;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
	CAIL	A,DISPL		;SKIP IF CORRECT
	HLRZ	T,LOAD2-DISPL(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
IFE B11SW,<POLFIX==LOAD4A>
IFE FAILSW,<LINK==LOAD4A>
IFE WFWSW,<LVARB==LOAD4A>
IFE ALGSW,<ALGBLK==LOAD4A>
IFE SAILSW,<LDPRG==LOAD4A
	LDLIB==LOAD4A>
IFE COBSW,<COBSYM==LOAD4A>

LOAD2:	COMML,,LIB30		;20,,0
	SPDATA,,PROG		;21,,1
	LOAD4A,,SYM		;22,,2
	LOAD4A,,HISEG		;23,,3
	LOAD4A,,LIB30		;24,,4
	LOAD4A,,HIGH		;25,,5
	LOAD4A,,NAME		;26,,6
	LOAD4A,,START		;27,,7
	LOAD4A,,LOCD		;30,,10
	LOAD4A,,POLFIX		;31,,11
	LOAD4A,,LINK		;32,,12
	LOAD4A,,LVARB		;33,,13
	LOAD4A,,INDEX		;34,,14
	LOAD4A,,ALGBLK		;35,,15
	LOAD4A,,LDPRG		;36,,16
	COBSYM,,LDLIB		;37,,17

	DISPL==.-LOAD2

;ERROR EXIT FOR BAD HEADER WORDS

LOAD4:
IFN TENEX,<CAIN A,100		;ASSIGN BLOCK?
	JRST ASGSYM		;YES>
IFE K,<CAIN	A,400		;FORTRAN FOUR BLOCK
IFN MANTIS,<	JRST	F4LD
	CAIE	A,401	;MANTIS DEBUGGER DATA PRESENT IN FORTRAN FILE
	JRST	LOAD4A		;NO
	TLON	F,SYMSW		;YES, FORCE SYMSW SET
	TRO	N,SYMFOR>
	JRST	F4LD>

LOAD4A:	MOVE	W,A		;GET BLOCK TYPE
	ERROR	,</ILL. FORMAT BLOCK TYPE !/>
	PUSHJ	P,PRNUM		;PRINT BLOCK TYPE
	JRST	ILC1		;PRINT SUBROUTINE NAME

SUBTTL	LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
;(BLOCK TYPE 37) TREAT AS BLOCK TYPE 1, BUT ONLY LOAD
;IF IN LOCAL SYMBOLS MODE
IFN COBSW,<
COBSYM:	TLNN	F,SYMSW		;LOCAL SYMBOLS?
	JRST	LIB30		;NO, SKIP OVER THIS BLOCK
	MOVEI	V,-1(W)		;GET BLOCK LENGTH
	ADDM	V,LOD37.	;COUNT EXTRA CODE>

PROG:	MOVEI	V,-1(W)		;LOAD BLOCK LENGTH
	PUSHJ   P,RWORD		;READ BLOCK ORIGIN
	SKIPGE	W
	PUSHJ	P,PROGS		;SYMBOLIC IF 36 BITS
	ADD	V,W 		;COMPUTE NEW PROG. BREAK
IFN REENT,<TLNN F,HIPROG
	JRST	PROGLW	;NOT HIGH SEGMENT
PROG3:
IFN TENEX,<MOVE X,HIGHX>
	CAMGE W,HVAL1	;CHECK TO SEE IF IN TOP SEG
	JRST LOWCOR
	MOVE T,.JBREL	;CHECK FOR OVERFLOW ON HIGH
	CAIL T,@X
	JRST PROG2
	PUSHJ P,HIEXP
	JRST FULLC
	JRST PROG3>

IFN MONLOD,<TLNN N,DISW	;LOADING TO DISK?
	JRST PROGLW		;NO, GO CHECK NEW BREAK
	CAMG H,V		;NEW BREAK?
	MOVE H,V		;YES, UPDATE
	JRST PROG2		;NO NEED TO CHECK FOR ROOM>
IFN REENT,<
LOWCOR:	SUB V,HIGHX	;RELOC FOR PROPER
	ADD V,LOWX	;LOADING OF LOW SEQMENT
	SUB W,HIGHX
	ADD W,LOWX>
PROGLW:	MOVEI T,@X
	CAMG	H,T		;COMPARE WITH PREV. PROG. BREAK
	MOVE H,T
	TLNE F,FULLSW
	JRST FULLC	;NO ERROR MESSAGE
IFN REENT,<CAML H,HVAL1
	JRST COROVL	;WE HAVE OVERFLOWED THE LOW SEGMENT
	CAMLE T,HILOW
	MOVEM T,HILOW	;HIGHEST LOW CODE LOADED INTO>
	CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
		JRST FULLC
IFN REENT,<	TLNE F,HIPROG
		SUBI W,2000	;HISEG LOADING LOW SEG>
IFN EXPAND,<	JRST .-1]>
PROG2:	MOVE	V,W
PROG1:	PUSHJ     P,RWORD		;READ DATA WORD
IFN TEN30,<CAIN V,41	;CHANGE FOR 10/30 JOBDAT
	MOVEI V,.JB41	;JOB41 IS DIFFERENT
	CAIN V,74	;SO IS JOBDAT
	MOVEI V,.JBDDT>
IFN L,<CAML V,RINITL	;CHECK FOR BAD STORE>
IFN MONLOD,<PUSHJ P,DICHK	;MAKE SURE ADDRESS IS IN CORE>
	MOVEM     W,@X		;STORE DATA WORD IN PROG. AT LLC
IFN MONLOD,<TLO N,WOSW	;SET SWITCH TO WRITE OUT BUFFER>
	AOJA	V,PROG1		;ADD ONE TO LOADER LOC. COUNTER

;HERE TO FIND SYMBOLIC ORIGIN
;W CONTAINS RADIX50 60,ORIGIN
;NEXT WORD CONTAINS OFFSET
;NOTE SYMBOL MUST BE GLOBAL AND DEFINED

PROGS:	MOVE	C,W		;PUT SYMBOL IN CORRECT SEARCH AC
	TLC	C,640000	;PERMUTE FROM 60 TO 04
	PUSHJ	P,SDEF		;SEE IF DEFINED
	  SKIPA	C,2(A)		;YES, GET VALUE
	JRST	PROGER		;NO, GIVE WARNING
	HRRZ	C,C		;CLEAR LEFT HALF IN CASE COMMON
	PUSHJ	P,RWORD		;GET NEXT WORD
	ADD	W,C		;FORM ORIGIN
	SOJA	V,CPOPJ		;BUT NOT SO MANY DATA WORDS

PROGER:	MOVEM	C,(P)		;REMOVE RETURN, SAVE C
	ERROR	,</VALUE NOT DEFINED FOR SYMBOLIC RELOCATION COUNTER !/>
	POP	P,C
	PUSHJ	P,PRNAME
	JRST	LIB3		;IGNORE THIS BLOCK

SUBTTL	LOAD SYMBOLS (BLOCK TYPE 2)

SYM:	PUSHJ	P,PRWORD	;READ TWO DATA WORDS
	PUSHJ	P,SYMPT;		PUT INTO TABLE
IFN REENT,<PUSHJ P,RESTRX>
	JRST	SYM

SYMPT:	TLNE C,200000	;GLOBAL REQUEST? WFW
	JUMPL C,SYM3	;CHECK FOR 60 NOT JUST HIGH BIT WFW
	TLNN	C,40000
	JRST	SYM1A		;LOCAL SYMBOL
	TLNE C,100000
	JRST SYM1B
SYMPTQ:	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
IFN RPGSW,<MOVE W,.JBERR	;RECORD THIS AS AN ERROR
	ADDI W,1
	HRRM W,.JBERR>
	MOVE	W,2(A)		;LOAD OLD VALUE
	PUSHJ     P,PRNUM		;PRINT OLD VALUE
	ERROR	7,</MUL. DEF. GLOBAL IN PROG.  !/>
	MOVE	C,SBRNAM	;GET PROGRAM NAME
	PUSHJ	P,PRNAME	;PRINT R-50 NAME
	ERROR	0,</#/>
	POPJ	P,		;IGNORE MUL. DEF. GLOBAL SYM

;	LOCAL SYMBOL

SYM1A:	TLNN	F,SYMSW		;SKIP IF LOAD LOCALS SWITCH ON
	POPJ	P,;		IGNORE LOCAL SYMBOLS
IFN SYMDSW,<
IFE MONLOD,<TRNE F,LSYMFL	;ONLY PUT SYMBOLS ON DSK  IF EXT SYM>
IFN MONLOD,<TLNN N,DISW		;BUT NOT IF LOADING TO DISK>
	JRST	SYM1X		;STORE SYMBOL ON DSK>

SYM1B:	IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	PUSHJ P,SIZCHK		;YES, CHECK FOR OVERLAP>
	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>
SYM1D:	MOVEI	A,-2(S)		;LOAD A TO SAVE INST. AT SYM2
	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
IFE SYMDSW,<POPJ	P,>
IFN SYMDSW,<
SYM1X:
IFN MONLOD,<SKIPL SYMEXT	;BEEN SETUP ONCE?
	TLNE N,DISW		;OR, IF OUTPUTTING TO DSK
	POPJ	P,		;DON'T BOTHER>
IFE MONLOD,<SKIPL SYMEXT	;BEEN SETUP ONCE?>
	TRNN	F,LSYMFL	;OUTPUT FILE SET UP?
IFN MONLOD,<PUSHJ P,INITSYM	;NO, DO IT>
IFE MONLOD,<POPJ P,		;NO, DON'T OUTPUT SYMBOLS>
	SOSG	ABUF2
	OUTPUT	2,
	IDPB	C,ABUF1
	SOSG	ABUF2
	OUTPUT	2,
	IDPB	W,ABUF1
	AOS	SYMCNT#
	POPJ	P,>


IFN SYMDSW,<
SYOPEN:	HLRZM	W,SYMEXT#
	MOVE	W,DTIN		;GET FILE NAME
	MOVEM	W,SYMNAM	;SAVE IT
	PUSHJ	P,INITSYM	;OPEN FILE
	JRST	LD2DD		;AND RETURN TO SCAN

INITSYM:	
	TLZ	N,AUXSWI!AUXSWE
	INIT	2,14
	SIXBIT	/DSK/
	ABUF,,0
	  HALT
	PUSH	P,0
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	MOVEI	0,AUX
	MOVEM	0,.JBFF
	OUTBUF	2,1
	PJOB	0,
	MOVEI	3,3
	IDIVI	0,^D10
	ADDI	1,"0"-40
	LSHC	1,-6
	SOJG	3,.-3
	HRRI	2,'SYM'
	MOVE	0,SYMNAM#	;GET NAME
	JUMPN	0,.+3		;WAS IT SET
	MOVS	0,2		;NO
	MOVEM	0,SYMNAM	;STORE IT
	SKIPN	1,SYMEXT	;ALREADY SET
	MOVEI	1,'TMP'
	HRRZM	1,SYMEXT	;STORE FILE EXTENSION
	HRLZS	1
	SETZB	2,3
	ENTER	2,0
	  HALT
	POP	P,3
	POP	P,2
	POP	P,1
	POP	P,0
	IORI	F,LSYMFL	;SYMBOL FILE SETUP NOW
	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
SYM2W1:	PUSHJ P,SREQ	;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
	JRST SYM2B	;FOUND MORE
SYM2C:	POPJ	P,SYM1D	;RETURN, SEE SYM2 FOR USE OF ADDRESS

;	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

;	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,HISTRT		;AND MAKE RELATIVE
IFN B11SW,<TLZ	W,040000>
SYM3X2:	IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	PUSHJ P,SIZCHK		;YES, CHECK FOR OVERLAP>
	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
SYM3A4:	PUSHJ P,SDEF2	;YES, CONTINUE WFW
	JRST SYM3A	;FOUND ANOTHER WFW
	JRST SYM3X2	;REALLY NO CHAIN THERE WFW
SYM3A1:	SKIPE	V,2(A)	;IF ADDRESS OF CHAIN IS 0, THROW IT AWAY
	JRST	SYM3A2	;AND USE THE NEW ONE, ELSE ADD THE CHAINS
	MOVEM	W,2(A)	;W IS ADDRESS OF NEW CHAIN,STORE ON TOP OF OLD 0
	POPJ	P,
SYM3A2:	
SYM3A3:	MOVE A,2(A)
SYM3B:	HRRZ V,A
IFN L,<CAMGE V,RINITL
	HALT>
IFN REENT,<CAMGE V,HVAL1
	SKIPA X,LOWX
	MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK	; MAKE SURE ADDRESS IN V IS IN CORE>
	HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
	JUMPN A,SYM3B  ; JUMP IF NOT THE LAST ADDR. IN CHAIN
	HRRM	W,@X		;COMBINE CHAINS
IFN MONLOD,<TLO N,WOSW	;SET FLAG TO WRITE OUT BUFFER>
	POPJ	P,;

;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 FO SAME
	TDNE	 T,[XWD 77777,-1]	;EXCEPT FOR HIGH CODE BITS
	POPJ	 P,		;ASSUME NON-LOADED LOCAL
	HRRI	 V,2(B)		;GET LOCATION
	SUBI	 V,(X)		;SO WE CAN USE @X
	JRST FIXW1
FIXW:	IFN REENT,<HRRZ T,V
	CAMGE T,HVAL1
	SKIPA X,LOWX
	MOVE X,HIGHX>
IFN L,<	HRRZ T,V
	CAMGE R,RINITL
	POPJ P,>
FIXW1:	TLNE	V,200000	;IS IT LEFT HALF
	JRST FIXWL
IFN MONLOD,<TLNN V,100000	;SKIP IF USING @X TO FIX SYMBOL TABLE
	PUSHJ	P,DICHK		;MAKE SURE ADDRESS IN V IS IN CORE>
	MOVE T,@X	;GET WORD
	ADD T,W		;VALUE OF GLOBAL
	HRRM T,@X	;FIX WITHOUT CARRY
IFN MONLOD,<TLNN V,100000	;SKIP IF JUST FIXED SYMBOL TABLE
	TLO	N,WOSW		;SET FLAG TO WRITE OUT BUFFER>
	MOVSI	D,200000	;SET UP TO REMOVE DEFERED INTERNAL IF THERE
	JRST	SYMFIX
FIXWL:	HRLZ	T,W		;UPDATE VALUE OF LEFT HALF
IFN MONLOD,<TLNN V,100000	;SKIP IF USING @X TO FIX SYMBOL TABLE
	PUSHJ	P,DICHK		;MAKE SURE ADDRESS IN V IS IN CORE>
	ADDM	T,@X		;BY VALUE OF GLOBAL
IFN MONLOD,<TLNN V,100000	;SKIP IF JUST FIXED SYMBOL TABLE
	TLO	N,WOSW		;SET FLAG TO WRITE OUT BUFFER>
	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
SYMFX1:	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 B11SW,<
	TLNE V,40000	;CHECK FOR POLISH
	JRST POLSAT>
	TLNN V,100000	;SYMBOL TABLE?
	JRST SYM2WA
	ADD V,HISTRT	;MAKE ABSOLUTE
	SUBI V,(X)	;GET READY TO ADD X
	PUSHJ P,FIXW1
	JRST SYM2W1
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,>
IFN REENT,<CAMGE V,HVAL1
	SKIPA X,LOWX
	MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK	;MAKE SURE ADDRESS IN V IS IN CORE>
	HRRZ	T,@X	;LOAD NEXT ADDRESS IN CHAIN
	HRRM	W,@X		;INSERT VALUE INTO PROGRAM
IFN MONLOD,<TLO N,WOSW	;SET FLAG TO WRITE OUT BUFFER>
	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,(H);		ANY ROOM LEFT?
IFN EXPAND,<	JRST	[PUSHJ P,XPAND>
			TLOA F,FULLSW
IFN EXPAND,<		JRST MVDWN
			POPJ P,]>
	TLNE	F,SKIPSW+FULLSW
	POPJ	P,	;	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)
	POPJ	P,
>
REMSYM:	MOVE T,1(S)
	MOVEM T,1(A)
	MOVE T,2(S)
	MOVEM T,2(A)
	CAIN	S,A		;MOVING TO SELF?
	JRST	REMSY1		;YES, DON'T CLEAR
	SETZM	1(S)		;CLEAR NAME
	SETZM	2(S)		;CLEAR POINTER
REMSY1:	ADD S,SE3
	POPJ P,

SUBTTL	HIGH-SEGMENT (BLOCK TYPE 3)
;THIS PROGRAM IS INTENDED FOR HI SEGMENT IF RUNNING ON A PDP-10.
; THIS BLOCK TYPE OCCURS AFTER ENTRY AND NAME BLOCKS.

HISEG:	HRRZ	C,W		;GET WORD COUNT
	PUSHJ	P,WORD		;GOBBLE UP BYTE WORD.
	PUSHJ	P,WORD		;GET THE HIGH SEG OFSET
	SOJE	C,.+4		;FINISHED IF NOT FORTRAN-10
	MOVE	C,W		;SAVE HIGH INFO
	PUSHJ	P,WORD		;GET LOW BREAK
	EXCH	W,C		;SWAP BACK
IFE REENT,<HISEG2==LOAD1A
	JUMPGE	W,LOAD1A	;NOT TWO SEG PROG.>
IFN REENT,<JUMPE W,HISEG2	;IGNORE ZERO
IFE TENEX,<JUMPG W,HISEG3	;NEG. IF TWOSEG PSEUDO-OP>
IFN TENEX,<TLNN W,-1
	JRST HISEG3>
>;END OF IFN REENT
	TRO	F,TWOFL		;SET FLAG
IFN REENT,<
	TRNE	F,NOHI!NOHI6	;TWO SEGMENTS LEGAL?
	JRST	ONESEG		;LOAD AS ONE SEGMENT
HISEG3:	HRRZ	D,W		;GET START OF HISEG 
	JUMPE	D,.+2		;NOT SPECIFIED
	PUSHJ	P,HCONT		;AS IF /H
HISEG2:	PUSHJ	P,HISEG1
	JRST	LOAD1		;GET NEXT BLOCK
FAKEHI:				;AS IF BLOCK TYPE 3
HISEG1:	TRNE	F,NOHI!NOHI6	;LOAD REENT?
	POPJ	P,
	TLOE	F,HIPROG	;LOADING HI PROG
	POPJ	P,		;IGNORE 2'ND HISEG
	TRON	F,SEENHI	;HAVE WE LOADED ANY OTHER HI STUFF?
	PUSHJ	P,SETUPH	;NO,SET UP HI SEG.
	MOVEM R,LOWR
	MOVE R,HIGHR
	MOVE	X,NAMPTR	;GET THE POINTER TO PROGRAM NAME
	HRRM	R,2(X)		;CALL THIS THE START OF THE PROGRAM
	MOVE X,HIGHX
	POPJ	P,

SETUPH:	MOVE X,HVAL1
	CAIGE X,-1	;SEE IF IT HAS BEEN CHANGED FROM ORIG
	JRST SEENHS	;YES, MUST HAVE SEEN /H
	MOVEI X,400000
	MOVEM X,HVAL1
	CAIG X,(H)	;HAVE WE RUN OVER WITH THE LOW SEG
	JRST COROVL
	ADDI X,.JBHDA
	HRLI X,W
	MOVEM X,HVAL
SEENHS:	MOVE X,HVAL
	MOVEM X,HIGHR
	HRRZ X,.JBREL
	SUB X,HVAL1
	ADDI X,1
	HRLI X,V
	MOVEM X,HIGHX
	POPJ P,

SETSEG:	TRZ	F,NOHI!SEGFL	;ALLOW HI-SEG
	JUMPL	D,.+2		;/-H TURNS OFF NOHI ONLY
	TRO	F,SEGFL		;/1H FORCES  HI
	POPJ	P,
>

ONESEG:	HLRZ	D,W		;GET LENGTH OF HISEG
	SUBI	D,(W)		;REMOVE OFSET
	JUMPLE	D,ONELOW	;LENGTH NOT AVAILABLE
	MOVEM	R,LOWR		;SAVE LOW SEGMENT RELOCATION
	ADDM	D,LOWR		;ADD TO LOW SEG RELOCATION
	HRRZM	W,HVAL1		;SO RELOC WILL WORK
	JRST	LOAD1		;GET NEXT BLOCK

ONELOW:	HLRZ	D,C		;TRY LOW SEG BREAK
	SUBI	D,(C)
	JUMPLE	D,TWOERR	;NOT AVAILABLE
	MOVEM	R,LOWR		;SAVE CURRENT BREAK
	ADD	R,D		;ADD LOW LENGTH
	HRRZM	W,HVAL1		;SO RELOC WILL WORK
	JRST	LOAD1

TWOERR:	ERROR	7,</TWO SEGMENTS ILLEGAL#/>
IFE L,<	JRST	LDRSTR>
IFN L,<	JRST	LOAD1>
SUBTTL	HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)

HIGH0:	CAIE	A,4		; TEST FOR END BLOCK (OVERLAP)
	JRST	LIB30

HIGH:	TRNN	F,TWOFL		;IS THIS A TWO SEGMENT PROGRAM?
	JRST	HIGH2A		;NO
HIGH2:	PUSHJ	P,RWORD		;GET HISEG BREAK
	TRZ	F,TWOFL		;CLEAR FLAG NOW
IFE REENT,<MOVE	R,LOWR
	JRST	HIGH2A>
IFN REENT,<TRNE	F,NOHI!NOHI6	;SINGLE SEGMENT LOAD?
	JRST	[MOVE	R,LOWR	;YES,GET LARGER RELOC
		CAILE	W,(R)	;IF FORTRAN-10
		SKIPA	C,W	;HISEG CODE IS ON TOP
		SETZ	C,	;OTHERWISE ZERO ABS VALUE
		MOVE	W,HVAL	;ORIGINAL VALUE
		MOVEM	W,HVAL1	;RESET
		PUSHJ	P,RWORD	;GET LOW SEG BREAK IN W
		CAMGE	C,W	;PUT LARGER VALUE
		MOVE	C,W	;IN C
		JRST	HIGH2B]	;CONTINUE AS IF LOW ONLY
	HRR	R,W		;PUT BREAK IN R
	CAMLE	R,HVAL
	MOVEM	R,HVAL
	MOVEM	R,HIGHR
	MOVE	R,LOWR		;NEXT WORD IS LOW SEG BREAK
	TLZ	F,HIPROG	;CLEAR HIPROG
	PUSHJ	P,PRWORD	;GET WORD PAIR
	HRR	R,C		;GET LOW SEG BREAK
	MOVEM	R,LOWR		;SAVE IT
	MOVE	R,HIGHR		;GET HIGH BREAK
	JRST	HIGHN3		;AND JOIN COMMON CODE>

HIGH2A:	PUSHJ	P,PRWORD	;READ TWO DATA WORDS.
HIGH2B:	IFN REENT,<
	TLZE F,HIPROG
	JRST HIGHNP>
IFN WFWSW,<ADD C,VARLNG		;IF LOW SEG THEN VARIABLES GO AT END>
IFN ALGSW,<ADD	C,OWNLNG	;ADD IN LENGTH OF OWN BLOCK>
IFN COBSW,<ADD	C,LOD37.	;ADD IN LOCAL SYMBOLS
	SKIPE	LOD37.		;BUT WERE THERE ANY?
	SUBI	C,3		;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
IFE TENEX,<CAMGE C,W	;CHECK 2ND WORD (LOC PROG BRK IF PRESENT)
	MOVE C,W>
	HRR R,C		;SET NEW PROGRAM BREAK
HIGH31:	MOVEM	R,LOWR	;SAVE NEW VALUE OF R
IFN MONLOD,<TLNN N,DISW	;SKIP IF LOADING TO DISK>
	ADDI C,(X)
	CAIG H,(C)
	MOVEI H,(C)	;SET UP H
IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	JRST HIGH3		;YES, DON'T WORRY ABOUT EXCEEDING CORE>
	CAILE	H,1(S)	;TEST PROGRAM BREAK
IFN EXPAND,<PUSHJ P,[	PUSHJ P,XPAND
			POPJ	P,
			JRST POPJM2]>
IFE EXPAND,<TLO	F,FULLSW>
HIGH3:	MOVEI A,F.C
	BLT A,B.C
IFN REENT,<TRNE	F,NOHI!NOHI6	;ONE SEGMENT PROGRAM?
	JRST	HIGHN4		;YES
	HRRZ	W,LOWR		;GET LOW  PROG BREAK
	HRL	W,HIGHR		;GET HIGH PROG BREAK
	SETZ	C,		;ZERO SYMBOL NAME
	PUSHJ	P,SYM1B		;PUT IN SYMBOL TABLE
	MOVEM	S,F.C+S		;SAVE NEW S AND B
	MOVEM	B,F.C+B		;INCASE OF ERROR
HIGHN4:>
	TRZE	N,F10TFL	;FORTRAN-10 SET NOHI?
	TRZ	F,NOHI		;YES, CLEAR IT
	SETZM	SBRNAM		;RELAX, RELOCATION BLOCK FOUND
	TLNE	F,SLIBSW+LIBSW	;NORMAL MODE EXIT THROUGH LOAD1
	JRST	LIB 		;LIBRARY SEARCH EXIT
	JRST LOAD1
IFN REENT,<
HIGHNP:	HRR R,C
	CAMG	W,HVAL1	;ABS. ADDRESS IN HIGH SEGMENT?
	JRST	HIGHN1	;NO
	CAIG	C,(W)	;YES, GREATER THAN CURRENT HISEG RELOC?
	HRR	R,W	;YES, USE IT
	SETZ	W,	;DON'T USE IT AGAIN
HIGHN1:	CAMLE R,HVAL
	MOVEM R,HVAL
	MOVEM R,HIGHR
HIGHN3:	PUSH	P,W	;SAVE W,CONTAIN HIGHEST ABSOLUTE ADDRESS
	ADD W,LOWX	;LOC PROG BRK
	CAIGE H,(W)	;CHECK FOR TOP OF LOW CORE
	MOVEI H,(W)
	POP	P,W	;RESTORE
	CAML H,HVAL1
	JRST COROVL	;OVERFLOW OF LOW SEGMENT
HIGHN2:	HRRZ R,HVAL
	SUB R,HVAL1
	ADD R,HISTRT
	CAMLE R,.JBREL
	JRST	[PUSHJ P,HIEXP
		JRST FULLC
		JRST HIGHN2]
	MOVE R,LOWR
	MOVE X,LOWX
IFN WFWSW,<ADD R,VARLNG	;VARIABLES IN LOW SEG>
IFN ALGSW,<ADD R,OWNLNG	;OWN BLOCK IN LOW SEGMENT>
IFN COBSW,<ADD	R,LOD37.	;ADD IN LOCAL SYMBOLS
	SKIPE	LOD37.		;BUT WERE THERE ANY?
	SUBI	R,3		;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
	HRRZ C,R
	CAIGE	C,(W)	;IS ABSOLUTE LOCATION GREATER
	HRR	R,W	;YES USE IT
	HRRZ 	C,R	;SET UP C AGAIN
	JRST HIGH31	;GO CHECK PROGRAM BREAK
>
SFULLC:	TROE	F,SFULSW	;PREVIOUS OVERFLOW?
	JRST	FULLC		;YES, DON'T PRINT MESSAGE
	ERROR	,<?SYMBOL TABLE OVERLAP#?>
FULLC:
IFE K,<	TLNE	N,F4SW
	POPJ	P,>
	JRST	LIB3		;LOOK FOR MORE
SUBTTL	EXPAND HIGH SEGMENT

IFN REENT,<
HIEXP:	TLNE	F,FULLSW
	POPJ	P,
IFN EXPAND,<PUSH P,Q>
	PUSH P,H
	PUSH P,X
	PUSH P,N
IFE K,<HRRZ X,MLTP
	TLNN N,F4SW>
	MOVEI X,1(S)
	HRRZ N,X
	SUB N,H
	CAILE N,1777
	JRST MOVHI
IFE EXPAND,<POPJ P,>
IFN EXPAND,<HRRZ N,.JBREL
	ADDI N,2000
	CAMG	N,ALWCOR
	CORE N,
	JRST XPAND6
	POP P,N
	JRST XPAND3>

MOVHI:	MOVEI N,-2000(X)
	HRL N,X
	HRRZ X,.JBREL
	BLT N,-2000(X)
	MOVNI H,2000
IFN EXPAND,<JRST XPAND8>
IFE EXPAND,<ADDM H,HISTRT
	ADDM H,S
	ADDM H,B
	ADDM H,HIGHX
	TLNE F,HIPROG
	ADDM H,-1(P)
	POP P,N
	ADDM H,NAMPTR	;ADJUST POINTER TO NAME
IFE K,<	TLNN F4SW
	JRST HIXP1
	ADDM H,PLTP
	ADDM H,BITP
	ADDM H,SDSTP
	ADDM H,MLTP
	TLNE N,SYDAT
	ADDM H,V
HIXP1:>
	POP P,X
	POP P,H
	AOS (P)
	POPJ P,>
>

SUBTTL	PROGRAM NAME (BLOCK TYPE 6)

NAME:	SKIPE	SBRNAM		;HAVE WE SEEN TWO IN A ROW?
	JRST	NAMERR		;YES, NO END BLOCK SEEN
NAME0:	PUSHJ	P,PRWORD	;READ TWO DATA WORDS
	MOVEM	C,SBRNAM	;SAVE SUBROUTINE NAME
IFN MANTIS,<CAMN C,[RADIX50 0,MANTIS]
	CAME	R,[W,,.JBDA]	;YES, BUT IS IT TO LOAD AT 140?
	CAIA			;NO, NOT A DEBUG /MANTIS COMMAND
	TRO	N,MANTFL	;HAVE SEEN MANTIS NOW>
NCONT:	HLRZ	V,W		;GET COMPILER TYPE
	ANDI	V,7777		;BITS 6-17
	CAILE	V,CMPLEN	;ONLY IF LEGAL TYPE
	SETZ	V,		;MAKE DEFAULT
	HLL	V,W		;GET CPU TYPE ALSO
	TLZ	V,7777		;BITS 0-5
	HRRZS	W		;CLEAR TYPE
	XCT	CMPLER(V)	;DO SPECIAL FUNCTION
	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:	IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	PUSHJ P,SIZCHK		;YES, CHECK FOR OVERLAP>
	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)
	EXCH	N,NAMPTR	;GET NAME POINTER, SAVE N
	HRRZ	V,N 		;POINTER TO PREVIOUS NAME
	SUBM	B,V 		;COMPUTE RELATIVE POSITIONS
	HRLM	V,2(N)		;STORE FORWARD POINTER
	HRRZ	N,B 		;UPDATE NAME POINTER
	EXCH	N,NAMPTR	;SWAP BACK
NAME2:	MOVEM   C,1(B)		;STORE PROGRAM NAME
	HRRZM	R,2(B)		;STORE PROGRAM ORIGIN
IFN SYMDSW,<PUSH	P,W		;SAVE W
	HRRZ	W,R		;ORIGIN
	PUSHJ	P,SYM1X		;PUT IN DSK FILE ALSO
	POP	P,W>
	CAMG	W,COMSAV	;CHECK COMMON SIZE
IFE REENT,<JRST	LIB3		;COMMON OK>
IFN REENT,<JRST [TRNE F,SEGFL	;LOAD LOW IN HI-SEG
		PUSHJ P,FAKEHI	;YES
		JRST	LIB3]>
	SKIPA	C,COMM
ILC:	MOVE	C,1(A)		;NAME
	PUSH	P,C		;SAVE COMMON NAME
	ERROR	,</ILL. COMMON !/>
	POP	P,C
	PUSHJ	P,PRNAME
ILC1:	SKIPN	SBRNAM
	JRST	ILC2
	ERROR	0,</ PROG. !/>
	MOVE	C,SBRNAM	;RECOVER SUBROUTINE NAME
	PUSHJ	P,PRNAME
ILC2:	ERROR	0,</ #/>
	JRST	LD2

NAMERR:	TLNE	F,FULLSW	;IF NOT ENUF CORE
	JRST	NAME0		;END BLOCK IS NEVER SEEN
	SETZM	DTIN		;CLEAR WRONG FILE NAME FOR MESSAGE
	ERROR	,</NO END BLOCK !/>
	JRST	ILC1

;COMPILER TYPE - DO SPECIAL FUNCTION FOR IT

CMPLER:
	JFCL			; 0 UNKNOWN
	PUSHJ	P,F40NAM	; 1 FORTRAN (F40)
	TRO	N,COBFL!VFLG	; 2 COBOL
	PUSHJ	P,ALGNAM	; 3 ALGOL-60
	TRO	N,NELFL		; 4 NELIAC
	TRO	N,PL1FL		; 5 PL/1
	TRO	N,BLIFL		; 6 BLISS-10
	TRO	N,SAIFL		; 7 SAIL
	PUSHJ	P,FORNAM	;10 FORTRAN-10
				;11 MACRO
				;12 FAIL
CMPLEN==.-CMPLER



F40NAM:	TRNE	N,FORFL		;CANNOT MIX OLD & NEW
	JRST	F40ERR
	TRO	N,F4FL!VFLG	;SET FLAGS
IFE ALGSW,<ALGNAM:;PUT LABEL ON A POPJ>
	POPJ	P,

FORNAM:	TRNE	N,F4FL		;CANNOT MIX OLD & NEW
	JRST	F40ERR
	TRO	N,FORFL!VFLG
IFN FORSW,<SKIPG FORLIB		;IF NOT SET FOR FOROTS
	AOS	FORLIB		;DO SO>
	HLLZ	V,V		;SEE IF ANY CPU BITS
	ROT	V,6		;PUT IN BITS 30-35
	CAILE	V,2		;ONLY 0, 1, 2 VALID
	SETZ	V,		;DEFAULT
	PUSHJ	P,@[EXP CPOPJ,FORNMA,FORNMI](V)
IFN REENT,<SKIPL	VSW		;USER DOES N'T WANT REENT OTS?
	TRNE	F,NOHI!SEGFL!SEENHI	;USER SET SEGMENT OR HI CODE SEEN?
	POPJ	P,>		;YES
	TRO	F,NOHI		;DEFAULT IS ONE SEG
	TRO	N,F10TFL	;BUT ONLY FOR THIS FILE
IFN FORSW,<HRRZM F,FORLIB>	;SET FOROTS BY DEFAULT (FORLIB .GT. 0)
	POPJ	P,

FORNMI:	TRNE	N,KA10FL	;CANNOT MIX KA & KI
	JRST	FORERR
	TRO	N,KI10FL	;SET FLAGS
	POPJ	P,

FORNMA:	TRNE	N,KA10FL	;CANNOT MIX KA & KI
	JRST	FORERR
	TLO	N,KA10FL
	POPJ	P,

F40ERR:	ERROR	,</CANNOT MIX F40 AND FORTRAN-10 COMPILED CODE@/>
FORERR:	ERROR	,</CANNOT MIX KA10 AND KI10 FORTRAN-10 COMPILED CODE@/>

IFN ALGSW,<
ALGNAM:	TRO	N,ALGFL!VFLG	;SET ALGOL SEEN, AND DEFAULT REENT OPSYS
	JUMPE	W,CPOPJ		;NOT ALGOL MAIN PROGRAM
IFN NAMESW,<
	PUSH	P,C		;SAVE NAME
	MOVE	W,C		;EXPECTS NAME IN W
	PUSHJ	P,LDNAM		;USE THIS A PROGRAM NAME
	POP	P,C		;RESTORE C>
	SETZ	W,		;CLEAR COMMON SIZE, ONLY A MARKER
	POPJ	P,		;RETURN
>
SUBTTL	STARTING ADDRESS (BLOCK TYPE 7)


START:	PUSHJ	P,PRWORD	;READ TWO DATA WORDS
	TLNN	N,ISAFLG	;SKIP IF IGNORE SA FLAG ON
	HRRZM	C,STADDR	;SET STARTING ADDRESS
IFN NAMESW,<
	MOVE	W,DTIN		;PICK UP BINARY FILE NAME
	TLNN N,ISAFLG
	MOVEM	W,PRGNAM	;SAVE IT
	MOVE	W,NAMPTR	;GET NAME POINTER
	MOVE	W,1(W)		;SET UP NAME OF THIS PROGRAM
IFE ALGSW,<TLNN	N,ISAFLG	;DONT SET NAME IF IGNORING SA'S>
IFN ALGSW,<TDNN	N,[ISAFLG,,ALGFL]	;OR ALGOL LOADING>
	PUSHJ	P,LDNAM>
	PUSHJ	P,PRWORD	;**OBSCURE RETURN TO LOAD1**

IFN REENT,<
RESTRX:	TLNE F,HIPROG
	SKIPA X,HIGHX
	MOVE X,LOWX
	POPJ P,>

SUBTTL	ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)

				;PMP PATCH FOR LEFT HALF FIXUPS
IFN FAILSW!B11SW!WFWSW,<
LOCDLH:	IFN L,<CAMGE V,RINITL
	POPJ P,>
IFN REENT,<CAMGE V,HVAL1
	SKIPA X,LOWX
	MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK>
	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,>
IFN FAILSW,<
LOCDLI:	PUSHJ	P,LOCDLF
IFN REENT,<PUSHJ P,RESTRX>
	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
IFN REENT,<PUSHJ P,RESTRX>
	JRST	LOCD

SUBTTL	LVAR FIX-UP (BLOCK TYPE 13)
IFN WFWSW,<
LVARB:	PUSHJ P,PRWORD	;THE FIRST TWO WORDS IN THE BLOCK
	MOVEM W,VARLNG	;AR SPECIAL. SECOND IS LENGTH OF VARIABLES
IFN REENT,<	TLNE F,HIPROG
		MOVE C,LOWR	;USE LOW RELOC IF LOADING HI SEG>
		;ELSE C HAS RELOC FOR THIS PROGRAM, USE IT
	HRRZM C,VARREL	;THIS IS LOCATION 0 OF VARIABLE AREA
LVLP:	PUSHJ P,PRWORD	;THINGS COME IN PAIRS
	TLNE C,200000	;BIT ON IF SYMBOL TABLE FIXUP
	JRST LVSYM
	HLRZ V,W	;NO GET LOC FROM LEFTH HALF OF SECOND
	ADD W,VARREL	;AND RELOCATE VARIABLE
	TLNE C,400000	;ON FOR LEFT HALF
	JRST	[PUSHJ P,LOCDLF	;TAKE CARE OF IT
IFN REENT,<	JRST LVLCOM]	;RESET X>
IFE REENT,<	JRST LVLP]	;MUST BE LOW SEG X OK>
	PUSHJ P,SYM4A	;RIGHT HALF CHAIN
IFN REENT,<LVLCOM:	PUSHJ P,RESTRX>
	JRST LVLP
LVSYM:	MOVE V,B	;GET SYMBOL TABLE POINTER
	ADD C,VARREL	;VALUE IS IN FIRST WORD FOR THESE
	TLZ W,740000	;MAKE SURE NO BITS ON
	ADDI V,2	;CORRECT POINTER TO SYMBOL TABLE
SRSYM:	MOVE A,-1(V)	;GET A NAME
	TLZN A,740000	;CHECK FOR PROGRAM NAME
	JRST LVLP	;LEAVE (PROBABLY A NON-LOADED LOCAL)
	CAMN A,W	;IS IT THE RIGHT ONE??
	JRST LVSYMD	;YES
	ADD V,SE3	;CHECK NEXT ONE
	JUMPL V,SRSYM	;BUT ONLY IF SOME ARE THERE
	JRST LVLP	;GIVE UP
LVSYMD:	TLNE C,400000	;WHICH HALF??
	JRST LVSYML	;LEFT
	ADD C,(V)	;ADDITIVE FIXUP
	HRRM C,(V)
	MOVSI D,200000	;DEFERED BITS
LVSM1:	PUSHJ P,COMSFX	;GO TAKE CARE OF IT
	JRST LVLP	;NEXT PLEASE
LVSYML:	HRLZS C
	ADDM C,(V)	;WE DON'T HAVE TO WORRY ABOUT OVERFLOW HERE
	MOVSI D,400000	;LEFT DEFERED BITS
	JRST LVSM1	;GO WORRY ABOUT DEFERED INTERNALS>

SUBTTL	FAIL LOADER
;ONLY LIST IF POLISH FIXUPS REQUIRED
	XLIST
IFN FAILSW!B11SW,<LIST>
REPEAT 0,<IF POLISH FIXUPS CONTAIN GLOBAL REQUESTS WHICH
CAN NOT BE SATISFIED WHEN THEY ARE SEEN, THEY MUST BE
SAVED UNTIL THESE GLOBAL SYMBOLS BECOME DEFINED.
THE POLISH FIXUP IS SAVED IN THE UNDEFINED TABLE (POINTED
TO BY S). THE FIXUP IS SAVED IN TWO WORD BLOCKS THE FIRST
WORD OF WHICH (THE ONE WHICH WOULD NORMALL CONTAIN THE SYMBOL)
HAS SPECIAL BITS ON SO IT WILL NOT BE FOUND BY A SEARCH FOR
A GLOBAL REQUEST. SINCE THE UNDEFINED TABLE MAY BE
SHUFFELED INTO A RANDOM ORDER, IT IS NOT POSSIBLE TO KEEP
ALL OF A POLISH FIXUP TOGETHER OR TO HAVE POINTERS IN
THE USUAL SENCE FROM ONE TWO WORD BLOCK TO ANOTHER.
SUFFICIENT INFORMATION IS THEREFORE GIVEN TO DETERMINE
WHAT THE FIRST WORD OF THE NEXT DESIRED BLOCK IS AND THIS
BLOCK IS FOUND BY SEARCHING THE UNDEFINED TABLE FOR A MATCH.
EACH POLISH FIXUP WHICH IS ENTERED INTO THE UNDEFINED
TABLE IS GIVEN A UNIQUE NUMBER CALLED THE "HEAD NUMBER".
EACH ELEMENT OF THE FIXUP (EITHER OPERAND OR OPERATOR)
IS ASSIGNED A NUMBER CALLED THE "OP NUMBER". THUS
THE OP NUMBER AND HEAD NUMBER TOGETHER DETERMINE
A SPECIFIC ELEMENT OF A SPECIFIC FIXUP. EACH ELEMENT
(TWO WORD BLOCK) IS ARRANGED AS FOLLOWS:
WORD 1:
	BITS 0-4  THESE ARE THE USUAL CODE BITS OF A RADIX50
		SYMBOL AND CONTAIN 44 TO DISTINGUISH
		AN ELEMENT OF A POLISH FIXUP FROM OTHER
		SYMBOLS IN THE UNDEFINED TABLE
	BITS 5-17 THE HEAD NUMBER OF THIS FIXUP
	BITS 18-30 THE OP NUMBER OF THIS ELEMENT
	BITS 31-35 THE OPERAND FOR THIS ELEMENT 
		OPERAND 2 INDICATES A WORD OF DATA
WORD 2:
	IF THE OPERAND IS 2 THIS WORD CONTAINS THE DATA

	IF THIS IS NOT A DATA OPERATOR THEN THE LEFT AND
	RIGHT HALVES OF THIS WORD POINT TO THE TWO OPERANDS
	THE CONTENTS OF THE HALF WORD IS THE RIGHT HALF
	OF THE FIRST WORD OF THE BLOCK POINTED
	TO. THUS THE LEFT HALF OF THE FIRST WORD COMBINED
	WITH ONE OF THESE HALF WORDS IS THE FIRST WORD
	OF THE BLOCK POINTED TO AND CAN BE FOUND BY SEARCHING

EACH FIXUP ALSO HAS A HEADER BLOCK. THIS BLOCK CONTAINS THE
FOLLOWING INFORMATION:
WORD 1:
	BITS 0-17 0
	BITS 18-21  44 
	BITS 22-35 THE HEAD NUMBER OF THIS FIXUP

WORD 2:
	BITS 0-17 A COUNT OF THE NUMBER OF UNDEFINED
		GLOBALS REMAINING IN THIS FIXUP
	BITS 18-35 A HALF WORD POINTER OF THE
		SAME TYPE FOUND IN OTHER ELEMENTS POINTING
		TO THE FIRST ELEMENT OF POLISH
		WHICH WILL BE THE STORE OPERATOR

THE REQUESTS FOR THE GLOBAL SYMBOLS NEEDED BY THE FIXUP ARE
ENTERED AS FOLLOWS:

WORD 1:
	BITS 0-4  04
	BITS 5-35  RADIX 50 FOR THE NAME OF THE SYMBOL
(NOTE THIS IS JUST A STANDARD GLOBAL REQUEST)

WORD 2:
	BITS 0-4 44 (THIS IDENTIFIES IT AS "ADITIVE TYPE"
		AND BIT 4 INDICATES POLISH)
	BITS 5-17 THE HEAD NUMBER OF THE FIXUP
		(THIS GIVES ENOUGH INFORMATION TO FIND THE HEADER
		BLOCK AND UPDATE THE COUNT WHEN THE REQUEST IS
		SATISFIED)
	BITS 18-35  A HALF WORD POINTER TO THE ELEMENT OF THE
		FIXUP INTO WHICH THE VALUE OF
		THE SYMBOL SHOULD BE STORED
>

IFN FAILSW!B11SW,<
;POLISH FIXUPS <BLOCK TYPE 11>

PDLOV:	SKIPE POLSW	;PDL OV ARE WE DOING POLISH?
	JRST COMPOL	;YES
	ERROR ,</PUSHDOWN OVERFLOW#/>
	JRST LD2
COMPOL:	ERROR ,</POLISH TOO COMPLEX#/>
	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
IFN WFWSW,<CAIN W,15
	JRST	[PUSHJ P,RDHLF	;THIS TRICK FOR VARIABLES
		ADD W,VARREL	;HOPE SOMEONE HAS DONE
		HRRZ C,W	;A BLOCK TYPE 13
		JRST HLFOP]>
	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,5		;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,5		;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,5
	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,5	;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
	CAIGE A,-3
	PUSHJ P,FSYMT
	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+6(A)	;CALL THE CORRECT FIXUP ROUTINE
COMSTR:	SETZM POLSW	;ALL DONE WITH POLISH
IFN REENT,<PUSHJ P,RESTRX>
	MOVE T,OPNUM	;CHECK ON SIZES
	MOVE V,HEADNM
	CAIG V,477777
	CAILE T,17777
	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 ALSYM,LFSYM,RHSYM,ALSTR,LOCDLF,SYM4A,FAKESY

GLSTR:	MOVE A,W
	CAIGE A,-3
	PUSHJ P,FSYMT
	PUSHJ P,RDHLF	;GET THE STORE LOCATION
	MOVEI A,23(A)
	POP D,V		;GET VALUE
	POP D,V
	HRLM V,W	;SET UP STORAGE ELEMENT
	AOS C,OPNUM
	LSH C,5
	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,>
IFN REENT,<CAMGE V,HVAL1
		SKIPA X,LOWX
	MOVE X,HIGHX>
IFN MONLOD,<PUSHJ P,DICHK>
	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 7,<JRST STRSAT>


FSYMT:	PUSHJ P,RDHLF	;FIRST HALF OF SYMBOL
	HRL V,W
	PUSHJ P,RDHLF
	HRR V,W
	PUSH D,A	;SAVE STORE TYPE
	PUSHJ P,RDHLF	;GET BLOCK NAME
	HRL C,W
	PUSHJ P,RDHLF
	HRR C,W
	TLO C,140000	;MAKE BLOCK NAME
	PUSHJ P,SDEF	;FIND IT
	CAMN A,B
	JRST FNOLOC	;MUST NOT BE LOADING LOCALS
FSLP:	LDB C,[POINT 32,-1(A),35]	;GET NAME
	CAMN C,V
	JRST FNDSYM
	SUB A,SE3
	CAME A,B	;ALL DONE?
	JRST FSLP	;NO
FNOLOC:	POP D,A
	MOVEI A,0	;SET FOR A FAKE FIXUP
	AOS (P)
	POPJ P,
FNDSYM:	MOVEI W,(A)	;LOC OF SYMBOL
	SUB W,HISTRT
	POP D,A
	AOS (P)
	POPJ P,

LFSYM:	ADD V,HISTRT
	HRLM W,(V)
	MOVSI D,400000	;LEFT HALF
	JRST COMSFX
RHSYM:	ADD V,HISTRT
	HRRM W,(V)
	MOVSI D,200000
	JRST COMSFX
FAKESY:	POPJ P,		;IGNORE

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,37	;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,37	;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

IFN FAILSW,<
;BLOCK TYPE 12 LINK
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
IFN REENT,<
	CAMGE	V,HVAL1		;CHECK HISEG ADDRESS
	SKIPA	X,LOWX		;LOW SEGMENT
	MOVE	X,HIGHX		;HIGH SEGMENT BASE
>;IF REENT
IFN MONLOD,<PUSHJ P,DICHK>
	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
IFN REENT,<
	PUSHJ	P,RESTRX	;RESTORE X
>;IF REENT
	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

>	;END OF IFN FAILSW

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)
IFN REENT,<PUSHJ P,RESTRX>
	POP P,W	;RESTORE THINGS
	POP P,C
	JRST SYM2W1

ALSYM:	ADD V,HISTRT
	MOVEM W,(V)
	MOVSI D,600000
>
	LIST		;END OF FAILSW CODE
IFN FAILSW!B11SW!WFWSW,<
COMSFX:	IFN REENT,<PUSHJ P,SYMFX1
	JRST RESTRX>
IFE REENT,<JRST SYMFX1>>

SUBTTL LIBRARY INDEX (BLOCK TYPE 14)

	COMMENT	*	DIRECT ACCESS LIBRARY SEARCH MODE
	INDEX WRITTEN BY FUDGE2.SEE DIDAL DOC (100-540-001-00)
	DESIGN AND CODING BY D.M.NIXON	JUL-AUG 1970
	*

IFN DIDAL,<

INDEX8:	POP	P,LSTBLK	;SET UP LSTBLK FOR NEXT PROG
	PUSHJ	P,WORD		;READ FIRST WORD
	HLRZ	A,W		;BLOCK TYPE ONLY
	CAIE	A,14		;IS IT AN INDEX?
	JRST	INDEXE		;NO, ERROR
	JRST	INDEX9		;DON'T SET FLAG AGAIN

INDEX0:	TRO	F,XFLG		;SIGNAL INDEX IN CORE
	MOVEI	A,1		;START ON BLOCK 1 (DSK)
	HRROM	A,LSTBLK	;BUT INDICATE AN INDEX
	MOVE	A,ILD1		;INPUT DEVICE
	DEVCHR	A,
	TLNE	A,DTABIT	;IS IT A DTA?
	TRO	F,DTAFLG	;YES
INDEX9:	MOVEI	A,AUX+2		;AUX BUFFER
	HRLI	A,4400		;MAKE BYTE POINTER
	MOVEM	A,ABUF1		;AND SAVE IT
	HRL	A,BUFR1		;INPUT BUFFER
	BLT	A,AUX+201	;STORE BLOCK
	TRO	F,LSTLOD	;AND FAKE LAST PROG READ
INDEX1:	ILDB	T,ABUF1
	JUMPL	T,INDEX3	;END OF BLOCK IF NEGATIVE
	HRRZS	T		;WORD COUNT ONLY
INDEX2:	ILDB	C,ABUF1		;GET NEXT SYMBOL
	TLO	C,040000	;
	PUSHJ	P,SREQ		;SEARCH FOR IT
	SOJA	T,INDEX4	;REQUEST MATCHES
	SOJG	T,INDEX2	;KEEP TRYING
	ILDB	T,ABUF1		;GET POINTER WORD
	TRZN	F,LSTLOD	;WAS LAST PROG LOADED?
	JRST	INDEX1		;NO
	TRNN	F,DTAFLG	;ALWAYS SAVE IF DTA???
	SKIPL	LSTBLK		;SKIP IF LAST BLOCK WAS AN INDEX
	MOVEM	T,LSTBLK	;SAVE POINTER FOR CALCULATIONS
	JRST	INDEX1		;GET NEXT PROG
INDEX4:	ADDM	T,ABUF1
	ILDB	A,ABUF1
	PUSH	P,A		;SAVE THIS BLOCK
	TROE	F,LSTLOD	;DID WE LOAD LAST  PROG?
	JRST	[SKIPGE	LSTBLK	;WAS LAST BLOCK AN INDEX?
		JRST	NXTBLK	;YES, SO GET NEXT ONE
		MOVEM	A,LSTBLK
		JRST	LOAD1]	;NEXT PROG IS ADJACENT
	HRRZ	T,LSTBLK	;GET LAST BLOCK NUMBER
	CAIN	T,(A)		;IN THIS BLOCK?
	JRST	THSBLK		;YES
NXTNDX:	TRNE	F,DTAFLG	;DIFFERENT TEST FOR DTA
	JRST	NXTDTA		;CHECK IF NEXT BUFFER IN CORE
	CAIN	T,-1(A)		;NEXT BLOCK?
	JRST	NXTBLK		;YES,JUST DO INPUT
INDEX5:	USETI	1,(A)		;SET ON BLOCK
	WAIT	1,		;LET I/O FINISH
	MOVSI	C,(1B0)		;CLEAR RING USE BIT IF ON
	HRRZ	T,BUFR
	IORM	C,BUFR		;SET UNUSED RING BIT (HELP OUT MONITOR)
	SKIPL	(T)
	JRST	NXTBLK		;ALL DONE NOW
	ANDCAM	C,(T)		;CLEAR USE BIT
	HRRZ	T,(T)		;GET NEXT BUFFER
	JRST	.-4		;LOOP

NXTDTA:	WAIT	1,		;LET I/O RUN TO COMPLETION
	HRRZ	T,BUFR		;GET POINTER TO CURRENT BUFFER
	HLRZ	T,1(T)		;FIRST DATA WORD IS LINK
	CAIE	T,(A)		;IS IT BLOCK WE WANT?
	JRST	INDEX5		;NO
NXTBLK:	IN	1,
	JRST	NEWBLK		;IT IS NOW
	JRST	WORD3		;EOF OR ERROR

NEWBLK:	MOVE	A,(P)		;GET CURRENT BLOCK
	JUMPL	A,INDEX8	;JUST READ AN INDEX
	HLRZS	A		;GET WORD COUNT
	JRST	INDEX6		;WORD COUNT WILL BE CORRECT

THSBLK:	SUB	A,LSTBLK	;GET WORD DIFFERENCE
	MOVSS	A		;INTO RIGHT HALF
INDEX6:	ADDM	A,BUFR1
	MOVNS	A
	ADDM	A,BUFR2
INDEX7:	POP	P,LSTBLK	;STORE THIS AS LAST BLOCK READ
	JRST	LOAD1

INDEX3:	HRRE	A,T		;GET BLOCK # OF NEXT INDEX
	JUMPL	A,EOF		;FINISHED IF -1
	PUSH	P,T		;STACK THIS BLOCK
	HRRZ	T,LSTBLK	;GET LAST BLOCK
	JRST	NXTNDX		;CHECK IF NEXT BUFFER IN CORE

INDEX:	PUSHJ	P,WORD2		;READ FIRST WORD OF NEXT BUFFER
INDEXE:	TRZE	F,XFLG		;INDEX IN CORE?
	TTCALL	3,[ASCIZ /LIBRARY INDEX INCONSISTENT - CONTINUING
/]				;WARNING MESSAGE
	JRST	LOAD1A+1	;AND CONTINUE
>

IFE DIDAL,<INDEX0:
INDEX:	PUSHJ	P,WORD2		;READ FIRST WORD OF NEXT BUFFER
	JRST	LOAD1A+1>

SUBTTL	ALGOL OWN BLOCK (TYPE 15)

IFN ALGSW,<
ALGBLK:	SKIPE	OWNLNG		;FIRST TIME THIS PROG?
	JRST	ALGB1		;NO, JUST CHAINED SYMBOL INFO
	PUSHJ P,RWORD		;READ 3RD WORD
IFN REENT,<TLNE	F,HIPROG	;LOADING INTO HIGH SEGMENT?
	EXCH	X,LOWX	;YES, BUT OWN AREAS ARE IN LOW SEG>
	HLRZ	V,W		;GET START OF OWN BLOCK
IFN REENT,<TLNE	F,HIPROG	;LOADING INTO HIGH SEGMENT?
	HRRZ	V,LOWR		;YES, BUT PUT OWN AREAS IN LOW SEG>
	MOVEI	C,(W)		;GET LENGTH OF OWN BLOCK
	MOVEM	C,OWNLNG	;SAVE IT TO FIX RELOC AT END
	PUSHJ	P,ALGB2		;FIX AND CHECK PROG BREAK
	MOVEI	W,(V)		;GET CURRENT OWN ADDRESS
	EXCH	W,%OWN		;SAVE FOR NEXT TIME
	MOVEM	W,@X		;STORE LAST OWN ADDRESS IN LEFT HALF
	HRLM	C,@X		;LENGTH IN LEFT HALF
IFN REENT,<TLNE	F,HIPROG	;HI-SEG?
	EXCH	X,LOWX		;YES, RESTORE X TO POINT TO HIGH SEG>
ALGB1:	PUSHJ	P,RWORD		;GET DATA WORD
	HLRZ	V,W		;GET ADDRESS TO FIX UP
	ADD	W,%OWN		;ADD IN ADDRESS OF OWN BLOCK
	PUSHJ	P,SYM4A		;FIX UP CHAINED REQUEST
	JRST	ALGB1		;LOOP TIL DONE

ALGB2:	ADDI	H,(W)		;FIX PROG BREAK
IFN REENT,<CAML	H,HILOW
	MOVEM	H,HILOW		;HIGHEST LOW CODE LOADED>
	CAILE	H,1(S)		;SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
		JRST	FULLC
IFN EXPAND,<	JRST	.+1]>
	POPJ	P,


>
SUBTTL	SAIL BLOCK TYPES 16 AND 17

COMMENT * BLOCK TYPE 16 AND 17. SIXBIT FOR  FIL,PPN,DEV
IN THE BLOCK. SEARCH TABLE FOR ALREADY REQUESTED. IF NOT
ENTER REQUEST. ORIGINAL CODE BY DCS REWRITTEN BY WFW*

IFN SAILSW,<
LDPRG:	MOVEI D,PRGFLS-1	;SET UP SOMETHING WE CAN SEARCH WITH
	MOVE W,PRGPNT	;AND CURRENT POINTER
	PUSHJ P,LDSAV	;GO ENTER (WILL NOT RETURN IF RUNS OUT)
	MOVEM D,PRGPNT
	JRST LDPRG	;BACK FOR MORE
LDLIB:	MOVEI D,LIBFLS-1
	MOVE W,LIBPNT
	PUSHJ P,LDSAV
	MOVEM D,LIBPNT
	JRST LDLIB	;LOOKS JUST LIKE THE LAST ONE, DOESN'T IT

LDSAV:	HRLI D,-RELLEN-1	;GET AOBJN SET UP
	MOVEM W,LODPN2#	;SAV IT
	PUSHJ P,PRWORD	;GET FILE,PPN
	MOVE A,W	;SAVE ONE
	PUSHJ P,RWORD	;AND DEVICE
FILSR:	CAMN D,LODPN2
	JRST FENT	;HAVE GOTTEN THERE, ENTER FILE
	CAME C,PRGFIL(D)	;CHECK FOR MATCH
	JRST NOMT	;NOT FILE
	CAME A,PRGPPN(D)
	JRST NOMT	;NO PPN
	CAME W,PRGDEV(D)
NOMT:	AOBJN D,FILSR	;AND NOT DEVICE SHOULD ALWAYS JUMP
	MOVE D,LODPN2
	POPJ P,		;JUST RETURN CURRENT POINTER
FENT:	MOVE D,LODPN2	;ENTER IT
	AOBJP D,WRONG	;THAT IS IF NOT TOO MANY
	MOVEM C,PRGFIL-1(D)	;HAVE ALREADY INDEXED
	MOVEM A,PRGPPN-1(D)	;HENCE THE -1
	MOVEM W,PRGDEV-1(D)
	POPJ P,
WRONG:	ERROR ,</TOO MANY DEMANDED FILES#/>
	JRST LD2
>
SUBTTL	COMMON ALLOCATION (BLOCK TYPE 20)

COMMENT	* THIS BLOCK CONSISTS OF WORD PAIRS (SAME AS TYPE 2)
	FIRST WORD IS RADIX50 04,SYMBOL
	SECOND WORD IS 0,,COMMON LENGTH
	COMMON NAME MUST BE GLOBAL AND UNIQUE
	IF NOT ALREADY DEFINED LOADER DEFINES SYMBOL AND ALLOCATES
	SPACE. IF DEFINED LOADER CHECK FOR TRYING TO INCREASE COMMON
	SIZE, AND GIVES ERROR IF SO
	NOTE... COMMON BLOCKS MUST COME DEFORE ANY DATA BLOCKS
	IE. AFTER BLOCKS 4,6,3 BUT BEFORE 1,2,37,..5
*

IFN K,<COMML==LOAD4A>
IFE K,<
COMML:	PUSHJ	P,PRWORD	;GET WORD PAIR
	TLO	C,400000	;TURN IT INTO 44,SYMBOL (FOR FORTRAN)
	TLO	N,F4SW		;INHIBITS MATCH WITH 04,SYMBOL
	PUSHJ	P,SDEF		;SEE IF ALREADY DEFINED
	  JRST	COMMLD		;YES, JUST CHECK SIZE
	TLZ	N,F4SW		;CLEAR AGAIN
IFN REENT,<TLNN F,HIPROG	;LOADING INTO HIGH SEGMENT?
	JRST	.+3		;NO
	EXCH	R,LOWR		;YES, BUT COMMON ALWAYS GOES TO LOW SEG
	EXCH	X,LOWX>
	HRL	W,R		;CURRENT RELOCATION
	ADDI	R,(W)		;BUMP RELOCATION
	MOVS	W,W		;LENGTH,,START
	PUSH	P,W		;STORE COMMON VALUE
	HRRZS	W		;NORMAL SYMBOL ADDRESS
	TLZ	C,400000	;BACK TO 04,SYMBOL
	PUSHJ	P,SYM1B		;DEFINE IT
	POP	P,W		;RESTORE VALUE
	TLO	C,400000	;AND COMMON SYMBOL
	PUSHJ	P,SYM1B		;AND STORE IT ALSO
IFN REENT,<TLNN F,HIPROG	;LOADING INTO HIGH SEGMENT?
	JRST	COMML		;NO
	EXCH	R,LOWR		;YES, RESTORE RELOCATION TO HIGH
	EXCH	X,LOWX>
	JRST	COMML		;GET NEXT SYMBOL

COMMLD:	TLZ	N,F4SW		;CLEAR AGAIN
	HLRZ	C,2(A)		;PICK UP DEFINITION
	CAMLE	W,C		;CHECK SIZE
	JRST	ILC		;ILLEGAL
	JRST	COMML		;TRY NEXT
>
SUBTTL	SPARSE DATA (BLOCK TYPE 21)

COMMENT *
	THIS BLOCK IS SIMILAR TO TYPE 1 DATA
	THE DATA WORDS ARE
	COUNT,,LOCATION
	DATA WORDS (COUNT NUMBER OF TIMES)
	COUNT,,LOCATION
	DATA WORDS
	ETC.

*

SPDATA:	PUSHJ   P,RWORD		;READ BLOCK ORIGIN
	SKIPGE	W
	PUSHJ	P,PROGS		;SYMBOLIC IF 36 BITS
	HLRZ	C,W		;GET SUB BLOCK COUNT IN C
	HRRZS	W		;CLEAR IT
	HRRZ	V,C		;AND IN V (LENGTH WE NEED)
SPDTO:	ADD	V,W 		;COMPUTE NEW PROG. BREAK
IFN REENT,<TLNN F,HIPROG
	JRST	SPDTLW	;NOT HIGH SEGMENT
SPDT3:	CAMGE W,HVAL1	;CHECK TO SEE IF IN TOP SEG
	JRST LOWSPD
	MOVE T,.JBREL	;CHECK FOR OVERFLOW ON HIGH
	CAIL T,@X
	JRST SPDT2
	PUSHJ P,HIEXP
	JRST FULLC
	JRST SPDT3>

IFN MONLOD,<TLNN N,DISW	;LOADING TO DISK?
	JRST SPDTLW		;NO, GO CHECK NEW BREAK
	CAMG H,V		;NEW BREAK?
	MOVE H,V		;YES, UPDATE
	JRST SPDT2		;NO NEED TO CHECK FOR ROOM>
IFN REENT,<
LOWSPD:	SUB V,HIGHX	;RELOC FOR PROPER
	ADD V,LOWX	;LOADING OF LOW SEQMENT
	SUB W,HIGHX
	ADD W,LOWX
>
SPDTLW:	MOVEI T,@X
	CAMG	H,T		;COMPARE WITH PREV. PROG. BREAK
	MOVE H,T
	TLNE F,FULLSW
	JRST FULLC	;NO ERROR MESSAGE
IFN REENT,<CAML H,HVAL1
	JRST COROVL	;WE HAVE OVERFLOWED THE LOW SEGMENT
	CAMLE T,HILOW
	MOVEM T,HILOW	;HIGHEST LOW CODE LOADED INTO>
	CAILE H,1(S)  ; SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
		JRST FULLC
IFN REENT,<	TLNE F,HIPROG
		SUBI W,2000	;HISEG LOADING LOW SEG>
IFN EXPAND,<	JRST .-1]>
SPDT2:	MOVE	V,W
SPDT1:	PUSHJ     P,RWORD		;READ DATA WORD
IFN L,<CAML V,RINITL	;CHECK FOR BAD STORE>
IFN MONLOD,<PUSHJ P,DICHK	;MAKE SURE ADDRESS IS IN CORE>
	MOVEM     W,@X		;STORE DATA WORD IN PROG. AT LLC
IFN MONLOD,<TLO N,WOSW	;SET SWITCH TO WRITE OUT BUFFER>
	SOJLE	C,SPDATA	;SUB-BLOCK RUN OUT, REFILL IT
	AOJA	V,SPDT1		;ADD ONE TO LOADER LOC. COUNTER

SUBTTL	TENEX ASSIGNMENT (BLOCK TYPE 100)

IFN TENEX,<
;IMPLEMENT THE SPECIAL BLOCK 100 REQUEST FOR ASSIGNING
; AND INCREMENTING OF EXTERNALS

ASGSYM:	PUSHJ P,RWORD		;GET FIRST WORD
	MOVE V,W		;SAVE SYM2
	PUSHJ P,PRWORD		;GET SECOND AND THIRD WORDS
	TLO C,040000		;MAKE INTO GLOBAL
	PUSHJ P,SDEF		;SEE IF DEFINED
	JRST ASGSY1		;OK. IT IS
	PUSH P,PRQ		;IT'S NOT, GENERATE ERROR COMMENT
	PUSHJ P,PRNAME
	JSP A,ERRPT7
	SIXBIT /UNDEFINED ASSIGN IN #/

ASGSY0:	PUSHJ P,RWORD		;SHOULD RETURN TO LOAD1
	JRST ASGSY0		;LOOP UNTIL IT DOES

ASGSY1:	ADD W,2(A)		;INCREMENT VALUE
	EXCH W,2(A)		;SAVE NEW, GET OLD
	MOVE C,V		;GET SYM2
	TLO C,040000		;MAKE INTO GLOBAL
	PUSHJ P,SYMPTQ		;AND CONTINUE AS FOR GLOBAL DEF
	JRST ASGSY0		;AND RETURN

>
SUBTTL	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
IFE K,<	TLNE	N,F4SW		;ARE WE IN FORTRAN?
	JRST	SDEF2		;YES,JUST TRY NEXT SYMBOL>
	TLC	C,400000	;MIGHT BE SUPPRESSED INTERNAL
	CAMN	C,1(A)		;WAS IT?
	JRST	[TLC C,400000	;BACK AS IT WAS
		IORM C,1(A)	;YES, SO ENSURE IT'S SUPPRESSED
		POPJ P,]	;EXIT WITH SYMBOL FOUND
	TLC	C,400000	;NO, TRY NEXT SYMBOL
SDEF2:	ADD	A,SE3
	JUMPL   A,SDEF1
IFE K,<	JRST	CPOPJ1		;SYMBOL NOT FOUND SKIPS ON RETURN>
IFN K,<
CPOPJ1:	AOS	(P)
	POPJ	P,>

SUBTTL	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
	TRNN	F,TWOFL		;POSSIBLE TWO SEGMENTS?
	JRST	RWORD5		;NO
	MOVSS	W
	PUSHJ	P,CHECK		;USE CORRECT RELOCATION
	HRRI	W,@R
	MOVSS	W
	JRST	RWORD3		;AND TEST RIGHT HALF
RWORD5:	HRLZ	T,R
	ADD	W,T 		;LH RELOCATION
RWORD3:	TLNN	Q,200000	;TEST RH RELOCATION BIT
	JRST	RWORD4		;NOT RELOCATABLE
	TRNE	F,TWOFL		;POSSIBLE TWO SEGMENTS?
	PUSHJ	P,CHECK		;USE CORRECT RELOCATION
	HRRI	W,@R		;RH RELOCATION
RWORD4:	LSH	Q,2
	POPJ	P,

CHECK:	MOVE	T,HVAL1		;START OF HISEGMENT
	CAIG	T,NEGOFF(W)	;IN HISEG?
	JRST	[CAILE	W,(W)	;IS ADDRESS BELOW HISEG START?
		JRST	[MOVNS	T	;YES
			ADDI	T,(W)	;THEREFORE WORRY ABOUT CARRY
			HRR	W,T	;INTO LEFT HALF
			POPJ	P,]	
		SUBI	W,(T)	;IN HISEG,  REMOVE OFSET
		POPJ	P,]
	HRRI	W,@LOWR		;USE LOW SEG RELOC
	JRST	CPOPJ1		;SKIP RETURN

SUBTTL	PRINT STORAGE MAP SUBROUTINE

PRMAP:	TRZ	F,LOCAFL	;ASSUME LOCAL SYMBOLS SUPPRESSED
	CAIE	D,1		;IF /1M PRINT LOCAL SYMBOLS
	CAMN	D,[-7]		;TEST FOR /-1M ALSO
	TRO	F,LOCAFL	;YES,TURN ON FLAG
	JUMPL	D,PRTMAP-1	;JUMP IF /-M OR /-1M
	TRO	N,ENDMAP	;ELSE SET DEFERRED MAP FLAG
	POPJ	P,

	TRZ	N,ENDMAP	;CLEAR DELAYED MAP FLAG
PRTMAP:	PUSHJ	P,FSCN1		;LOAD OTHER FILES FIRST
IFN SPCHN,<TRZ	N,MAPSUP	;SET MAP NOT SUPPRESSED
	SKIPE	CHNACB		;TEST FOR SPECIAL CHAINING
	TRNN	N,CHNMAP	;TEST FOR ROOT MAP ALREADY PRINTED
	JRST	PRMP0A		; SKIP IF NO TO EITHER QUESTION
	PUSHJ	P,CRLFLF	;SPACE TWO LINE AND FORCE TTY OUTPUT
	TLZ	F,FCONSW	;SUPPRESS TTY OUTPUT
	ERROR	0,</********************   !/>	;PRINT SEPARATOR
	TLO	F,FCONSW	;FORCE TTY OUTPUT AGAIN
	ERROR	0,</LINK  !/>	;PRINT LINK NUMBER
	MOVE	W,LINKNR	;GET CURRENT LINK NUMBER
	PUSHJ	P,RCNUMW	;PRINT IT IN DECIMAL
	TLZ	F,FCONSW	;SUPPRESS TTY OUTPUT
	ERROR	0,</   ********************!/>	;PRINT SEPARATOR
	PUSHJ	P,CRLF		;PUT BLANK LINE ON MAP FILE ONLY
	PUSHJ	P,CRLF		; DITTO
	TLO	F,FCONSW	;FORCE TTY OUTPUT AGAIN
	PUSHJ	P,CRLF
	JRST	.+2		;SKIP NEXT CRLF CALL
PRMP0A: >
	PUSHJ	P,CRLFLF	;START NEW PAGE
	HRRZ	W,R
IFN REENT,<CAIG	W,.JBDA	;LOADED INTO LOW SEGMENT
	JRST	NOLOW		;DON'T PRINT IF NOTHING THERE>
	PUSHJ     P,PRNUM0
IFE REENT,<ERROR 7,<?IS THE PROGRAM BREAK@?>>
IFN REENT,<ERROR 7,<?IS THE LOW  SEGMENT BREAK@?>
	PUSHJ	P,CRLF		;CR-LF ON ALL BUT TTY	
NOLOW:	MOVE	W,HVAL		;HISEG BREAK
	CAMG	W,HVAL1		;HAS IT CHANGED
	JRST	NOHIGH		;NO HI-SEGMENT
	TLO	F,FCONSW	;FORCE OUT HI-SEG BREAK ALSO
	PUSHJ	P,PRNUM0
	ERROR	7,<?IS THE HIGH SEGMENT BREAK@?>
	PUSHJ	P,CRLF
NOHIGH:>
IFN SPCHN,<SKIPE	CHNACB	;TEST FOR SPECIAL CHAINING
	TRNN	N,CHNMAP	;TEST FOR ROOT MAP ALREADY PRINTED
	JRST	.+2		; NO TO EITHER QUESTION, FALL THRU
	JRST	NOADDR		; ELSE SKIP HEADING OUTPUT>
IFE NAMESW,<	MOVE	W,DTOUT	;OUTPUT NAME >
IFN NAMESW,<	SKIPN	W,DTOUT
	MOVE	W,CURNAM	;USE PROGRAM NAME>
	JUMPE	W,.+3		;DON'T PRINT IF NOT THERE
	PUSHJ	P,PWORD
	PUSHJ	P,SPACES	;SOME SPACES

;HERE TO DECODE AND PRINT VERSION NUMBER IN .JBVER
;USES T,V,D,Q
IFN MONLOD,<TLNE N,DISW	;LOADING TO DISK?
	MOVE	X,XRES		;YES, SETUP X >
IFE L,<
	SKIPN	V,.JBVER(X)	;GET VERSION NUMBER
	JRST	NOVER		;WASN'T ONE
	ROT	V,3		;PUT USER BITS LAST
	MOVEI	T,"%"		;TO INDICATE VERSION
	PUSHJ	P,TYPE2		;OUTPUT CHARACTER
	MOVEI	Q,3		;3 BYTES IN MAJOR FIELD
	PUSHJ	P,SHFTL		;SHIFT LEFT, SKIP 0 BYTES
	  JRST	.+3		;NO MAJOR FIELD
	MOVEI	D,"0"		;CONVERT TO ASCII 0-8
	PUSHJ	P,OUTVER	;OUTPUT IT
	MOVEI	Q,2		;2 DIGITS IN MINOR FIELD
	PUSHJ	P,SHFTL
	  JRST	.+3		;NO MINOR FIELD
	MOVEI	D,"@"		;ALPHABETICAL
	PUSHJ	P,OUTVER
	MOVEI	T,"("		;EDIT NUMBER IN PARENS
	TLNN	V,-1		;SEE IF GIVEN
	JRST	NOEDIT		;NO
	PUSHJ	P,TYPE2		;YES
	MOVEI	Q,6
	PUSHJ	P,SHFTL		;LEFT JUSTIFY
	  JRST	.+3		;NEVER GETS HERE
	MOVEI	D,"0"		;0-7 AGAIN
	PUSHJ	P,OUTVER
	MOVEI	T,")"		;CLOSE VERSION
	PUSHJ	P,TYPE2
NOEDIT:	MOVEI	T,"-"		;USER FIELD?
	JUMPE	V,.+4		;NO
	PUSHJ	P,TYPE2		;YES
	MOVEI	Q,1		;ONLY ONE DIGIT
	PUSHJ	P,OUTVER	;OUTPUT IT
	PUSHJ	P,SPACES	;SOME SPACES
NOVER:>;END OF IFE L
	ERROR	0,<?STORAGE MAP!?>
	PUSHJ	P,SPACES		;SOME SPACES
	PUSH	P,N
	PUSH	P,E
	MOVE	N,[POINT 6,DBUF] ;INITIALIZE DATE POINTER
	MSTIME	Q,		;GET THE TIME
	IDIVI	Q,^D60*^D1000
	IDIVI	Q,^D60
	PUSH	P,A		;SAVE MINUTES
	PUSHJ	P,OTOD1		;STORE HOURS
	POP	P,Q		;GET MINUTES
	PUSHJ	P,OTOD		;STORE MINUTES
	DATE	E,		;GET DATE
	IDIVI	E,^D31		;GET DAY
	ADDI	Q,1
	PUSHJ	P,OTOD		;STORE DAY
	IDIVI	E,^D12		;GET MONTH
	ROT	Q,-1		;DIV BY 2
	HRR	A,DTAB(Q)	;GET MNEMONIC
	TLNN	Q,400000
	HLR	A,DTAB(Q)	;OTHER SIDE
	HRRM	A,DBUF+1	;STORE IT
	MOVEI	Q,^D64(E)	;GET YEAR
	MOVE	N,[POINT 6,DBUF+2]
	PUSHJ	P,OTOD		;STORE IT
	POP	P,E
	POP	P,N
	PUSHJ	P,DBUF1
	PUSHJ	P,CRLF
	SKIPN	STADDR		;PRINT STARTING ADDRESS
	JRST	NOADDR		;NO ADDRESS SEEN
	ERROR	0,</STARTING ADDRESS !/>
	PUSHJ	P,SP1
	MOVE	W,STADDR		;GET ST. ADDR.
	PUSHJ	P,PRNUM0		;PRINT IT
IFN NAMESW,<
	PUSHJ	P,SP1
	MOVE	W,[SIXBIT / PROG /]
	PUSHJ	P,PWORD
	MOVE	W,CURNAM		;PROG NAME
	PUSHJ	P,PWORD
	PUSHJ	P,SP1
	MOVE	W,ERRPT6		;SIXBIT / FILE /
	PUSHJ	P,PWORD
	MOVE	W,PRGNAM		;FILE NAME
	PUSHJ	P,PWORD>
NOADDR:	IFN REENT,<
	HRRZ	A,HVAL1		;GET INITIAL HIGH START
	ADDI	A,.JBHDA	;ADD IN OFFSET
IFN SPCHN,<HRL	A,BEGOV	;ASSUME NON-ROOT OVERLAY
	SKIPE	CHNACB		;TEST FOR SPECIAL CHAINING
	TRNN	N,CHNMAP	;TEST FOR ROOT-MAP PRINTED
				;ASSUMPTION CORRECT IF YES TO BOTH
				; SKIP NEXT INSTRUCTION IF SO >
	HRLI	A,.JBDA		;LOW START
	MOVSM	A,SVBRKS	;INITIAL BREAKS>
	HLRE	A,B
	MOVNS     A
	ADDI	A,(B)
PRMAP1: SUBI	A,2
IFN REENT!L,<SKIPN C,1(A)	;LOAD SYMBOL SKIP IF REAL SYMBOL
	JRST	PRMAP4		;IGNORE ZERO NAME(TWOSEG BREAKS)>
IFE REENT!L,<MOVE C,1(A)	;LOAD SYMBOL>
	TLNN	C,300000	;TEST FOR LOCAL SYMBOL
	JRST	.+4		;GLOBAL  (NOT LOCAL ANYWAY)
	TRNN	F,LOCAFL	;PRINT LOCAL SYMBOLS?
	JRST	PRMAP4		;IGNORE LOCAL SYMBOLS
	TLC	C,040000	;MAKE IT LOOK LIKE INTERN
	TLNE	C,040000
	JRST	PRMP1A
IFN SPCHN,<TRZ	N,MAPSUP	;SET MAP NOT SUPPRESSED
	SKIPE	CHNACB		;TEST FOR SPECIAL CHAINING
	TRNN	N,CHNMAP	;TEST FOR ROOT MAP PRINTED
	JRST	PRMP0C		; NO TO EITHER TEST, SKIP AROUND
	HRRZ	T,2(A)		;GET STARTING ADDRESS
	CAML	T,BEGOV		;TEST FOR BELOW OVERLAY
	JRST	PRMP0C		;NO,JUMP
	TRO	N,MAPSUP	;SUPPRESS IF RE-PRINTING ROOT
	JRST	PRMAP4		; & SKIP TO NEXT SYMBOL

PRMP0C:>
	PUSHJ	P,CRLF
	PUSHJ	P,CRLF
	JRST	PRMP1B
PRMP1A:
IFN SPCHN,<TRNE	N,MAPSUP	;TEST FOR SUPPRESSED MAP
	JRST	PRMAP4		; YES, SKIP THIS SYMBOL>
	PUSHJ	P,TAB
	MOVEI	T,40		;SPACE FOR OPEN GLOBAL
	TLNE	C,100000	;LOCAL?
	MOVEI	T,47		;YES, TYPE '
	TLNE	C,400000	;HALF KILLED TO DDT?
	ADDI	T,3		;YES, TYPE # FOR GLOBAL, * FOR LOCAL
	PUSHJ	P,TYPE2		;PRINT CHARACTER
PRMP1B:	PUSHJ   P,PRNAM1	;PRINT SYMBOL AND VALUE
	TLNE	C,040000
	JRST	PRMAP4		;GLOBAL SYMBOL
	HLRE	C,W 		;POINTER TO NEXT PROG. NAME
	HRRZS W		;SO WE ONLY HAVE THE HALF WE WANT
PRMAP7:	JUMPL C,PRMP7A
IFN REENT,<SKIPN 1(B)		;IS IT A ZERO SYMBOL
	JRST	[MOVE	C,B	;SET UP C
		JRST	PRMAP2]	;AND GO
	HRRZ	T,HVAL	;GET TO OF HI PART
	CAML	W,HVAL1	;IS PROGRAM START UP THERE??
	JRST	PRMAP6	;YES
	HRRZ	T,HILOW	;GET HIGHEST LOCATION LOADED IN LOW
	SUBI	T,(X)	;REMOVE OFFSET
	CAIE	T,(W)	;EQUAL IF ZERO LENGTH PROG>
	HRRZ T,R	;GET LOW, HERE ON LAST PROG
	JRST PRMAP6	;GO

PRMP7A:	ADDI C,2(A)	;POINTER TO NEXT PROGRAM NAME
PRMAP2:	IFN REENT,<
	SKIPE	1(C)	;THIS IS A TWO SEG  FILE
	JRST	PRMP2A	;NO
	MOVE	T,2(C)	;GET PROG BREAKS
	TLNN	T,-1		;IF NO HIGH STUFF YET
	HLL	T,SVBRKS	;FAKE IT
	SUB	T,SVBRKS	;SUBTRACT LAST  BREAKS
	HRRZ	W,T	;LOW BREAK
	PUSH	P,T	;SAVE T
	PUSHJ	P,PRNUM	;PRINT IT
	POP	P,T	;RESTORE
	HLRZ	W,T	;GET HIGH BREAK
	JUMPE	W,.+3	;SKIP IF NO HIGH CODE
	PUSHJ	P,TAB	;AND TAB
	PUSHJ	P,PRNUM
	MOVE	T,2(C)
	CAMN	C,B		;EQUAL IF LAST PROG
	SETZ	C,		;SIGNAL END
	TLNN	T,-1
	HLL	T,SVBRKS
IFE TENEX,<CAMN	T,SVBRKS	;ZERO LENGTH IF EQUAL
	JRST	PRMP6A		;SEE IF LIST ALL ON>
	MOVEM	T,SVBRKS	;SAVE FOR NEXT TIME
	JRST	PRMAP3	;AND CONTINUE
PRMP2A:>
	HRRZ T,(C)	;GET ITS STARTING ADRESS
PRMAP6:	SUBM	T,W 		;SUBTRACT ORIGIN TO GET LENGTH
	PUSHJ     P,PRNUM		;PRINT PROGRAM LENGTH
	PUSHJ     P,CRLF
PRMP6A:
IFE TENEX,<TLNN	N,ALLFLG		;SKIP IF LIST ALL MODE IS ON
	TRNE	W,777777		;SKIP IF ZERO LENGTH PROGRAM>
IFN TENEX,<TLNE	N,ALLFLG		;SKIP IF LIST ALL MODE IS ON>
	JRST	PRMAP3
	HLRE	C,2(A)		;GET BACK CORRECT LOCATION IF 0 LENGTH
	JUMPE   C,PRMAP5	;JUMP IF LAST PROGRAM
	ADDI	C,2(A)		;IN CASE WE SKIPPED SOME PROGRAMS
	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:	PUSHJ	P,CRLF	;GIVE AN XTRA CR-LF
IFN SPCHN,<SKIPN CHNACB		;TEST FOR SPECIAL CHAINING
	JRST	PMS		;NO, SKIP
	TRO	N,CHNMAP	;YES, SHOW ROOT-PHASE PRINTED
	JRST	PMS4		; & EXIT>
IFN TENEX,<JRST PMS		;GO PRINT UNDEFINED GLOBALS>


SUBTTL	LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS

;LIST UNDEFINED GLOBALS

PMSQ:
IFN TENEX,<SETZM NLSTGL		;ALLOW UNDEFINED GLOBALS TO LIST>
PMS:	PUSHJ	P,FSCN1		;LOAD FILES FIRST
	JUMPGE	S,PMS4		;JUMP IF NO UNDEFINED GLOBALS
IFN TENEX,<SKIPE NLSTGL		;HAVE UNDEF GLOBALS BEEN LISTED?
	POPJ P,0		;YES
	SETOM NLSTGL	;PREVENT IT FROM HAPPENING AGAIN>
	PUSHJ	P,FCRLF		;START THE MESSAGE
	HLRE	W,S 		;COMPUTE NO. OF UNDEF. GLOBALS
	MOVMS     W
	LSH	W,-1		;<LENGTH OF LIST>/2
	PUSHJ	P,RCNUMW	;PRINT AS DECIMAL NUMBER
	ERROR	7,</UNDEFINED GLOBAL(S)@/>
	MOVE	A,S 		;LOAD UNDEF. POINTER
PMS2:	SKIPL W,1(A)
	TLNN W,40000
	JRST PMS2A
	PUSHJ     P,FCRLF
	PUSHJ     P,PRNAM0		;PRINT SYMBOL AND POINTER
PMS2A:	ADD	A,SE3
	JUMPL   A,PMS2
	PUSHJ	P,CRLF		;NEW LINE

;LIST NUMBER OF MULTIPLY DEFINED GLOBALS

PMS3:	SKIPN	W,MDG		;ANY MULTIPLY DEFINED GLOBALS
	JRST	PMS4		;NO, EXCELSIOR
	PUSHJ	P,FCRLF		;ROOM AT THE TOP
	PUSHJ	P,RCNUMW	;NUMBER OF MULTIPLES IN DECIMAL
	ERROR	7,<?MULTIPLY DEFINED GLOBAL(S)@?>
PMS4:	TLNE	N,AUXSWE	;AUXILIARY OUTPUT DEVICE?
	OUTPUT	2,		;INSURE A COMPLETE BUFFER
CPOPJ:	POPJ	P,		;RETURN

SUBTTL	ENTER FILE ON AUXILIARY OUTPUT DEVICE

IAD2:
IFN SYMDSW,<TRNE F,LSYMFL	;ALREADY USING AUX DEV FOR LOCAL SYMBOLS?
	POPJ	P,		;YES, GIVE ERROR RETURN>
	PUSH	P,A		;SAVE A FOR RETURN
	MOVE	A,LD5C1		;GET AUX. DEV.
	DEVCHR	A,		;GET DEVCHR
	TLNN	A,4		;DOES IT HAVE A DIRECTORY
	JRST	[SKIPN	A,DTOUT	;USE OUTPUT NAME IF GIVEN
		JRST	IAD2C	;FIND A DEFAULT
		JRST	IAD2A]	;JUST DO ENTER
	MOVE	A,DTOUT		;GET OUTPUT NAME
	CAME	A,[SIXBIT /JOBDAT/] ;DON'T USE JOBDAT
	JUMPN	A,IAD2A		;USE ANYTHING NON-ZERO
	MOVSI	A,(SIXBIT /DSK/) ;DEFAULT DEVICE
	CAMN	A,LD5C1		;IS IT AUX. DEV.
	JRST	IAD2C		;YES LEAVE WELL ALONE
	CLOSE	2,		;CLOSE OLD AUX. DEV.
	MOVEM	A,LD5C1		;SET IT TO DSK
	OPEN	2,OPEN2		;OPEN IT FOR DSK
	JRST	IMD4		;FAILED
IAD2C:	IFN NAMESW,<
	SKIPN	A,CURNAM	;USE PROG NAME>
	MOVSI	A,(SIXBIT /MAP/)	;AN UNLIKELY NAME
	MOVEM	A,DTOUT		;SO ENTER WILL NOT FAIL
IAD2A:
IFN SPCHN,<MOVE A,CHNOUT+1	;GET SP CHAIN DEV.
	CAMN	A,LD5C1		;IS IT SAME AS AUX. DEV.
	SKIPN	CHNACB		;YES, ARE WE DOING SP CHAIN?
	JRST	IAD2B		;NO, PHEW!
	DEVCHR	A,		;IS IT REALLY A DSK?
	TLNE	A,DSKBIT
	JRST	IAD2B		;YES, LEAVE ALONE
	RELEAS	2,		;NO, CLEAR OUT ANY RESIDUAL FILE
	JRST	IMD4		;AWAY BEFORE SOMETHING TERRIBLE HAPPENS
IAD2B:>
	POP	P,A		;RECOVER A
	SETZM	DTOUT+2		;CLEAR PROTECTION (LEVEL D)
	ENTER	2,DTOUT		;WRITE FILE NAME IN DIRECTORY
	JRST	IMD3		;NO MORE DIRECTORY SPACE
	AOS	(P)		;SKIP RETURN IF SUCCESSFUL
	POPJ	P,

IMD3:	ERROR	,</ERROR WRITING FILE@/>
	TLZ	N,AUXSWE!AUXSWI	;CLEAR AUX DEVICE SWITCHES
	JRST	LD2

IMD4:	MOVE	P,PDLPT		;RESTORE STACK
	AOBJN	P,.+1		;BUT SAVE RETURN ADDRESS
	TLZ	N,AUXSWE!AUXSWI	;NO AUX.DEV.NOW
	ERROR	,</NO MAP DEVICE@/>
	JRST	PRMAP5		;CONTINUE TO LOAD

SUBTTL MONLOD - DISK IMAGE MONITOR LOADER CODE

IFN MONLOD,<

DIOPEN:	PUSH	P,A		;SAVE AC A
	PUSH	P,H		;SAVE AC H
	PUSH	P,N		;SAVE 3 ACC'S
	PUSH	P,X		;IN A BLOCK
	MOVE	A,ILD1		;GET DEVICE
	MOVE	N,A		;SPARE COPY
	DEVCHR	A,		;SEE WHAT IT IS
	TLNN	A,DSKBIT	;IS IT SOME SORT OF DSK?
	SKIPA	N,DIN1		;NO, GET THE DEFAULT DEVICE (DSK)
	MOVEM	N,DIN1		;YES, OBEY USER AND USE IT
	MOVE	A,[3,,N]	;SET UP BLOCK
	DSKCHR	A,		;WAS DSK, BUT SEE IF GENERIC "DSK"
	  JRST	USEDSK		;NO POINT GOING THROUGH WITH THIS
	TLNE	A,(7B17)	;IS IT GENERIC DSK?
	JRST	USEDSK		;NO USE WHATS IN DIN1
	SETOB	N,H		;REQUEST FIRST F/S
	MOVE	A,[3,,N]	;SET UP A AGAIN
	JOBSTR	A,		;GET FIRST F/S IN SEARCH LIST
	  JRST	USEDSK		;LEVEL C
	JUMPL	H,USEDSK	;SWP BIT SET
	TLNN	H,200000	;IS NO CREATE BIT SET?
	JRST	USEDSK		;NO, GENERIC 'DSK' WILL USE THIS F/S
	DSKCHR	A,		;GET FIRST 3 ARGS
	  JRST	USEDSK		;SHOULD NEVER HAPPEN BUT !!
	TLNN	A,740200	;RHB!OFL!HWP!SWP!NNA SET?
	CAIGE	X,DALLOC	;ENOUGH SPACE?
	JRST	USEDSK		;CANNOT USE FASTEST F/S
	MOVEM	N,DIN1		;USE F/S RATHER THAN 'DSK'
	MOVEM	N,GENERI	;SAVE F/S INCASE ENTER FAILS
USEDSK:	POP	P,X		;RESTORE ACC'S
	POP	P,N
	MOVE	H,(P)		;RESET H
USDSK2:	OPEN	4,OPEN4		;OPEN DEVICE 'DSK', MODE 16
	HALT	.-1		;ERROR, NON-INTELIGENT INDICATION
	MOVEM	W,DIOUT1+1	;STORE EXTENSION 'XPN'
	MOVE	A,DTIN		;GET FILE NAME
	MOVEM	A,DIOUT1	;STORE IN 'LOOKUP-ENTER' BLOCK
	SETZM	DIOUT1+2	;CLEAR PARAMETERS TO BE SUPPLIED BY MONITOR
	SETZM	DIOUT1+3	;ALWAYS USE THIS JOB'S PROJ-PROG NUMBER
	SETZM	DIOUT+1		;SAME AGAIN
	MOVE	A,[17,,11]	;STATES WORD
	GETTAB	A,		;GET IT
	  JRST	.+3		;FAILED, NOT LEVEL D FOR SURE
	TLNE	A,(7B9)		;TEST FOR LEVEL D
	TDZA	A,A		;YES, THIS IS LEVEL D
	MOVEI	A,2		;NOT LEVEL D
	ENTER	4,DIOUT(A)	;CREATE OR SUPERCEDE SAVE FILE
	  JRST	ENTFAI		;ERROR, TRY DSK
	JUMPE	A,LEVELD	;JUMP IF LEVEL D
	HRRZ	A,.JBREL	;GET CURRENT SIZE
	CAIL	A,2000		;NEED AT LEAST 2K
	CAILE	H,-2000(S)	;CHECK FOR 1K FREE
IFN EXPAND,<JRST [PUSHJ	P,XPAND	;GET 1K OF ZEROS, WILL SAVE TIME LATER IN ANYCASE>
		JRST	FULLC	;NO MORE CORE
IFN EXPAND,<	JRST	.-1]>	;OK, TRY AGAIN
	MOVSI	A,-2000		;FORM IOWD
	HRRI	A,(H)		;TO 1K OF BLANK
	MOVEM	A,LOLIST	;STORE IOWD
	SETZM	LOLIST+1	;TERMINATE LIST
	MOVEI	A,DALLOC/10	;PREALLOCATE THE HARD WAY
	OUTPUT	4,LOLIST	;BY DOING OUTPUTS
	SOJG	A,.-1
	MOVEI	A,2		;STILL NOT LEVEL D
LEVELD:	CLOSE	4,4		;WIPE OUT THE OLD FILE IF ONE EXISTS
	LOOKUP	4,DIOUT(A)	;LOOKUP FOLLOWED BY ENTER ENABLES UPDATING
	  HALT	.-1		;ERROR
	JUMPN	A,ALLOK		;NOT LEVEL D
	MOVE	A,DIOUT+.RBALC	;SEE WHAT WE GOT
	SKIPE	GENERI		;IF NOT GENERIC DSK FIRST F/S
	CAIL	A,DALLOC	;WAS IT ENOUGH
	TDZA	A,A		;YES, BUT STILL LEVEL D
	JRST	TRYAGN		;NO JUST USE DSK
ALLOK:	ENTER	4,DIOUT(A)	;FILE CAN BE BOTH READ AND WRITTEN
	HALT	.-1		;ERROR
	MOVE	A,H		;GET HIGHEST ADDRESS LOADED SO FAR
	SUBI	A,-177(X)	;SIZE OF LOW BUFFER MUST BE AN
	ANDI	A,777600	;INTEGRAL MULTIPLE OF BLOCK SIZE
	MOVEM	A,HIRES		;SET UP POINTER FOR LOCATION CHECKING
	ADDI	A,(X)		;GET ADDRESS OF START OF IMAGE BUFFER
	HRRM	A,HILIST	;HILIST IS IOWD FOR FILE WINDOW BUFFER
	SUBI	A,(X)		;A=SIZE OF LOW IMAGE BUFFER (RESIDENT)
	MOVN	A,A		;GET MINUS BUFFER SIZE
	HRLM	A,LOLIST	;SET UP WORD COUNT IN LOW IOWD
	HRRM	X,LOLIST	;ADDRESS FIELD OF IOWD
	MOVEM	X,XRES		;SAVE OFFSET OF RESIDENT PORTION
	MOVE	H,HILIST	;GET HIGH BUFFER ADDRESS
	MOVNI	A,DISIZE	;NEGATIVE SIZE OF FILE WINDOW
	HRLM	A,HILIST	;SET UP WORD COUNT OF HIGH IOWD
	MOVE	A,HIRES		;GET HIGHEST ADDRESS IN RESIDENT PORTION+1
	LSH	A,-7		;CONVERT TO BLOCK NUMBER
	MOVEM	A,RESBLK	;STORE NUMBER OF BLOCKS IN RESIDENT PORTION
	ADDI	H,DISIZE	;H=TOP OF DISK WINDOW BUFFER
	MOVEM	H,DIEND		;LAST LOCATION IN WINDOW BUFFER+1
	CAILE	H,1(S)		;SKIP IF SUFFICIENT CORE AVAILABLE
IFN EXPAND,<JRST [PUSHJ P,XPAND>
		   JRST FULLC
IFN EXPAND,<	   JRST .-1]>
	SOS	HILIST		;IOWD POINTS TO BUFFER-1
	SOS	LOLIST		; "
	SETZM	HILIST+1	;TERMINATOR SHOULD BE ZERO
	SETZM	LOLIST+1	;     "
	TLO	N,DISW		;SET DISK IMAGE IN USE FLAG
	PUSH	P,V		;SAVE CURRENT LOADER LOCATION COUNTER
	MOVE	V,HIRES		;GET FIRST ADDRESS NOT IN RESIDENT BUFFER
	PUSHJ	P,DICHK2	;CALL TO INITIALIZE THE BUFFER HANDLER
	POP	P,V		;RESTORE V
	POP	P,H		;RESTORE H
	SUBI	H,(X)		;CONVERT TO ABSOLUTE FOR DISK IMAGE LOAD
	POP	P,A		;RESTORE AC A
	JRST	LD2D		;RETURN TO CONTINUE SCAN
DICHK:	TLNN	N,DISW		;ARE WE DOING A DISK IMAGE LOAD?
	POPJ	P,		;NO, ALL IS OK
	HRRZ	X,V		;LEFT HALF OF AC 'V' MAY CONTAIN FLAGS
	CAMGE	X,HIRES		;SKIP IF ADDRESS NOT IN RESIDENT PORTION
	JRST	DICHK1		;ADDRESS IN AC X IS IN RESIDENT PORTION
	CAMGE	X,DILADD	;SKIP IF ADDRESS ABOVE CORRENT LOWEST WINDOW ADDRESS
	JRST	DICHK2		;ADDRESS IS NOT RESIDENT
	CAML	X,DIHADD	;SKIP IF ADDRESS IS RESIDENT
	JRST	DICHK2		;NOT RESIDENT
	SKIPA	X,XCUR		;GET OFFSET OF CURRENT WINDOW
DICHK1:	MOVE	X,XRES		;GET OFFSET OF RESIDENT LOW PORTION
	POPJ	P,

DICHK2:	PUSH	P,A		;GET ADDRESS IN AC 'V' INTO CORE
	PUSH	P,Q		;GET SOME AC'S TO WORK WITH
	TLZE	N,WOSW		;CURRENT BUFFER TO BE WRITTEN OUT?
	PUSHJ	P,DICHK3	;YES, GO DO SO
	MOVE	A,HILIST	;GET ADDRESS-1 OF DISK IMAGE BUFFER
	ADDI	A,1		;A NOW POINTS TO START OF BUFFER
	SETZM	(A)		;CLEAR THE FIRST WORD OF THE BUFFER
	MOVS	Q,A		;MOVE ADDRESS TO SOURCE FOR BLT
	HRRI	Q,1(A)		;SOURCE+1 TO DESTINATION
	ADDI	A,DISIZE	;SET A TO TOP OF BUFFER+1
	BLT	Q,-1(A)		;CLEAR THE BUFFER
	HRRZ	Q,V		;GET THE ADDRESS WE'RE LOOKING FOR
	SUB	Q,HIRES		;ACCOUNT FOR RESIDENT PART
	IDIVI	Q,DISIZE	;A=Q+1
	IMULI	Q,DISIZE	;FIRST ADDRESS IN WINDOW
	IDIVI	Q,^D128		;GET BLOCK NUMBER (-NUMBER IN RESIDENT PORTION)
	ADD	Q,RESBLK	;NUMBER OF RESIDENT BLOCKS
	USETI	4,1(Q)		;BLOCK 0 DOES NOT EXIST
	STATZ	4,20000		;END OF FILE?
	JRST	DICHK4		;YES, NO SENSE READING
	INPUT	4,HILIST	;TRY TO FILL THE DISK IMAGE BUFFER
	STATZ	4,740000	;CHECK FOR ERRORS, DON'T CARE ABOUT EOF
	HALT	.-3		;TRY AGAIN ON CONTINUE
DICHK4:	MOVEM	Q,CURSET	;LEAVE BLOCK NUMBER AROUND FOR LATER USETO
	IMULI	Q,^D128		;GET ADDRESS OF FIRST WORD IN CURRENT BUFFER
	MOVEM	Q,DILADD	;STORE FOR FUTURE COMPARES
	ADDI	Q,DISIZE	;ADD SIZE OF DISK IMAGE BUFFER
	MOVEM	Q,DIHADD	;STORE HIGH CURRENT ADDRESS+1
	HRRZ	Q,HILIST	;GET WINDOW ADDRESS-1
	ADDI	Q,1		;NOW EQUAL TO ADDRESS
	SUB	Q,DILADD	;COMPUTE LOADER CURRENT WINDOW OFFSET
	HRLI	Q,V		;SET UP INDEX REGISTER FOR STORED X
	MOVEM	Q,XCUR		;STORE CURRENT OFFSET
	POP	P,Q		;RESTORE
	POP	P,A		;RESTORE
	MOVE	X,XCUR		;SET UP LOADER OFFSET REGISTER
	POPJ	P,		;RETURN, ADDRESS IN 'V' NOW RESIDENT

DICHK3:	MOVE	Q,CURSET	;GET BLOCK NUMBER FOR USETO
	USETO	4,1(Q)		;THERE IS NO BLOCK 0
	OUTPUT	4,HILIST	;WRITE OUT HE IMAGE
	STATZ	4,740000	;ERROR?
	HALT	.-3		;YES, TRY AGAIN ON CONTINUE
	POPJ	P,		;RETURN

SIZCHK:	EXCH	A,DIEND		;SAVE A, GET END OF BUFFER ADDRESS
	AOS	(P)		;DEFAULT IS SKIP RETURN
	CAIGE	A,(S)		;IS SYMBOL TABLE ENCROACHING ON BUFFER?
	AOS	(P)		;NO,DON'T EXPAND CORE
	EXCH	A,DIEND		;RESTORE BOTH A AND DIEND
	POPJ	P,		;RETURN

DISYM:	PUSH	P,V		;SAVE CURRENT ADDRESS
	MOVE	V,A		;GET ADDRESS WERE LOOGING FOR
	PUSHJ	P,DICHK		;MAKE SURE IT IS IN CORE
	POP	P,V		;RESTORE V
	POPJ	P,		;RETURN

DIOVER:	MOVE	X,XRES		;CLEAN UP XPN FILE AND EXIT
	MOVE	A,.JBFF(X)	;GET LAST ADDRESS LOADER
	SUB	A,DILADD	;SUBTRACT CURRENT LOW ADDRESS
	ADDI	A,^D128		;ROUND OFF TO NEAREST BLOCK SIZE
	ANDI	A,777600	;FOR IOWD
	MOVNS	A		;NEGATE
	HRLM	A,HILIST	;PUT IN WINDOW IOWD
	PUSHJ	P,DICHK3	;OUTPUT THE SYMBOL TABLE
	USETO	4,1		;SET UP TO OUTPUT RESIDENT PART
	OUTPUT	4,LOLIST	;AND DO SO
	STATZ	4,740000	;ERROR CHECK
	HALT	.-3		;IF ERROR TRY AGAIN
	CLOSE	4,
	EXIT

TRYAGN:	PUSH	P,DIOUT1	;SAVE NAME
	SETZM	DIOUT1
	RENAME	4,DIOUT(A)	;GET RID OF FILE
	POP	P,DIOUT1	;RESTORE NAME
ENTFAI:	SKIPN	GENERI		;GENERIC DSK?
	HALT	.		;NO, JUST GIVE UP
	MOVSI	A,'DSK'		;TRY WITH JUST DSK
	MOVEM	A,DIN1
	SETZM	GENERI
	SETZM	DIOUT+.RBALC
	JRST	USDSK2		;TRY AGAIN


>
SUBTTL	PRINT SUBROUTINES

;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:
	TRNN	F,TTYFL
	PUSHJ	P,SP1
	PUSHJ	P,SP1 
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:	POINT	3,W,17	;BYTE POINTER FOR OCTAL CONVERSION OF W

;HERE TO LEFT JUSTIFY V, COUNT IN IN Q
	LSH	V,3		;STEP LEFT ONE
SHFTL:	TLNN	V,700000	;LEFT JUSTIFIED?
	SOJGE	Q,.-2		;NO SHIFT IF STILL IN FIELD
	JUMPLE	Q,CPOPJ		;NOTHING IN THIS FIELD
	JRST	CPOPJ1		;SKIP RTETURN, AT LEAST ONE CHAR

;HERE TO OUTPUT CHARACTERS LEFT AFTER SHIFTING LEFT
OUTVER:	SETZ	T,		;CLEAR T TO REMOVE JUNK
	LSHC	T,3		;SHIFT IN FROM T
	ADDI	T,(D)		;EITHER "0" OR "A"
	PUSHJ	P,TYPE2		;PRINT
	SOJG	Q,OUTVER	;MORE?
	POPJ	P,		;NO


IFN NAMESW,<
LDNAM:	MOVE T,[POINT 6,CURNAM]	;POINTER
	SETZM	CURNAM	;CLEAR OLD NAME INCASE FEWER CHARS. IN NEW
	MOVNI D,6	;SET COUNT
	TLZ W,740000	;REMOVE CODE BITS
SETNAM:	IDIVI W,50	;CONVERT FROM RAD 50
	HRLM C,(P)
	AOJGE D,.+2
	PUSHJ P,SETNAM
	HLRZ C,(P)
	JUMPE C,INAM
	ADDI C,17
	CAILE C,31
	ADDI C,7
	CAIG C,72	;REMOVE SPECIAL  CHARS. (. $ %)
	IDPB C,T
INAM:	POPJ P,	>


;SPECIAL ENTRY POINT WITH NUMBER IN REGISTER W, FALLS THRU TO RCNUM
RCNUMW:	MOVE	Q,W		;COPY NUMBER INTO PROPER REGISTER

;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)
	JUMPE Q,.+2
	PUSHJ P,RCNUM
	HLRZ T,(P)
	JRST TYPE2


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

;	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,


;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:	SETZM	TABCNT		;RESET TAB COUNT ON NEW LINE
	MOVEI   T,15		;CARRIAGE RETURN LINE FEED
	PUSHJ   P,TYPE2
	TRCA	T,7		;CR.XOR.7=LF
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
	TLOE	N,AUXSWE	;IS AUX. DEV. ENTERED?
	JRST	TYPE2A		; YES, SKIP
	PUSHJ	P,IAD2		;NOPE, DO SO!
	  JRST	TYPE3		;ERROR RETURN
TYPE2A:	SOSG	ABUF2		;SPACE LEFT IN BUFFER?
	OUTPUT	2,		;CREATE A NEW BUFFER
	IDPB	T,ABUF1		;DEPOSIT CHARACTER
	IFN RPGSW,<
	TRNN	F,NOTTTY	;IF TTY IS ANOTHER DEVICE
				;DON'T OUTPUT TO IT>
	TLNN	F,FCONSW	;FORCE OUTPUT TO CONSOLE TOO?
	POPJ	P,		;NOPE
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
	POPJ	P,

SUBTTL	SYMBOL PRINT - RADIX 50

;	ACCUMULATORS USED: D,T

PRNAME: MOVE	T,C 		;LOAD SYMBOL
	TLZ	T,740000	;ZERO CODE BITS
	CAML	T,[50*50*50*50*50]	;SYMBOL LEFT JUSTIFIED
	JRST	SPT0		;YES
	PUSH	P,T
	PUSH	P,C
	MOVEI	C,6
	MOVEI	D,1
	IDIVI	T,50
	JUMPN	V,.+2
	IMULI	D,50
	SOJN	C,.-3
	POP	P,C
	POP	P,T
	IMUL	T,D
SPT0:	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
	AOJGE   D,.+2		;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

TAB1:	PUSHJ	P,CRLF
TAB:	AOS	T,TABCNT
	CAIN	T,5
	JRST	TAB1
	TLNE	N,AUXSWI	;TTY BY DEFAULT?
	TRNE	F,TTYFL
	JRST	SP1
	MOVEI	T,11
	JRST	TYPE2



OTOD:	IBP	N
OTOD1:	IDIVI	Q,^D10
	ADDI	Q,20		;FORM SIXBIT
	IDPB	Q,N
	ADDI	A,20
	IDPB	A,N
	POPJ	P,

DTAB:	SIXBIT	/JANFEB/
	SIXBIT	/MARAPR/
	SIXBIT	/MAYJUN/
	SIXBIT	/JULAUG/
	SIXBIT	/SEPOCT/
	SIXBIT	/NOVDEC/

SUBTTL	ERROR MESSAGE PRINT SUBROUTINE

;	FORM OF CALL:

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

;	ACCUMULATORS USED: T,V,C,W

ERRPT:	PUSHJ	P,FCRLF		;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,'@'
	JRST	ERRPT4
	CAIN	T,'%'
	JRST	ERRPT9
	CAIN	T,'!'
	JRST	ERRP42		;JUST RETURN,LEAVE FCONSW ON
	CAIE	T,'#'
	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:	TLZ	F,FCONSW	;ONE ERROR PER CONSOLE
ERRP42:	POP	P,Q		;***DMN*** FIX FOR ILC MESSAGE
	AOJ	V,		;PROGRAM BUMMERS BEWARE:
	JRST	@V		;V HAS AN INDEX OF A

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

ERRPT8:	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
	TRC	T,100		;CONVERT TO PRINTING CHAR.
ERRP8:	PUSHJ     P,TYPE2
ERRPT7:   PUSHJ     P,SPACE
	JRST	ERRPT0

ERRPT9: MOVEI   V,@V
	PUSH	P,V
	ERROR	7,<?ILLEGAL -LOADER@?>
	POP	P,V
	JRST	ERRP41

;PRINT QUESTION MARK

PRQ:	PUSH	P,T		;SAVE
	TLO	F,FCONSW	;FORCE TTY OUTPUT ON ANY ERROR
	MOVEI	T,"?"		;PRINT ?
	PUSHJ	P,TYPE2		;...
	POP	P,T		;RESTORE
	POPJ	P,		;RETURN

SUBTTL	INPUT - OUTPUT INTERFACE

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

WORD2:	IN	1,		;GET NEXT BUFFER LOAD
	JRST	WORD		;DATA OK - CONTINUE LOADING
WORD3:	STATZ	1,IODEND	;TEST FOR EOF
	JRST	EOF 		;END OF FILE EXIT
	ERROR	,< /INPUT ERROR#/>
	JRST	LD2 		;GO TO ERROR RETURN


SE3:	XWD	2,2 		;SYMBOL POINTER INCREMENT
PDLPT:	IOWD	PDLSIZ,PDLST	;INITIAL PUSHDOWN STACK
COMM:	SQUOZE    0,.COMM.
LSTPT:	POINT	6,W		;CHARACTER POINTER TO W

IOBKTL==40000
IOIMPM==400000
IODERR==200000
IODTER==100000
IODEND==20000

IOBAD==IODERR!IODTER!IOBKTL!IOIMPM

SUBTTL	IMPURE CODE
IFN PURESW,<	RELOC
LOWCOD:	RELOC
HICODE:
	PHASE LOWCOD>


DBUF1:	JSP	A,ERRPT7
DBUF:	SIXBIT	/TI:ME DY-MON-YR @/
	POPJ	P,

;DATA FOR PURE OPEN UUO'S

IFN SPCHN,<
CHNENT:	0
	SIXBIT .CHN.
	0
	0
CHNOUT:	EXP	16
	SIXBIT /DSK/
	0
>
IFN RPGSW,<
OPEN1:	EXP	1
RPG1:	Z
	XWD	0,CTLIN
>

OPEN2:	EXP	1
LD5C1:	Z
	XWD	ABUF,0

OPEN3:	EXP	14
ILD1:	Z
	XWD	0,BUFR

IFN MONLOD,<
OPEN4:	EXP	16
DIN1:	SIXBIT	/DSK/
	Z
>

IFN PURESW,<DEPHASE
CODLN==.-HICODE>

SUBTTL	DATA STORAGE

IFN PURESW,<	RELOC
LOWCOD:	BLOCK CODLN>
DATBEG:!		;STORAGE AREA CLEARED FROM HERE ON INITIALIZATION
ZBEG:!		;CLEARED FROM HERE TO ZEND ON REINITIALIZATION
MDG:	BLOCK 1			;COUNTER FOR MUL DEF GLOBALS
IFN REENT,<HILOW:	BLOCK	1	;HIGHEST NON-BLOCK STMT IN LOW SEG>
STADDR:	BLOCK 1		;HOLDS STARTING ADDRESS
IFN KUTSW,<CORSZ:	BLOCK 1>
IFN REENT,<VSW:	BLOCK	1>
IFN  NAMESW,<CURNAM:	BLOCK 1>
IFN B11SW,<POLSW:	BLOCK 1>
IFN FAILSW,<LINKTB:	BLOCK 21>
IFN SPCHN,<CHNACB:	BLOCK 1>
ZEND==.-1
PDSAV:	BLOCK 1			;SAVED PUSHDOWN POINTER
COMSAV: BLOCK 1			;LENGTH OF COMMON
PDLST:	BLOCK	PDLSIZ

F.C:	BLOCK 1
	BLOCK 1	;STORE N HERE
	BLOCK 1	;STORE X HERE
	BLOCK 1	;STORE H HERE
	BLOCK 1	;STORE S HERE
	BLOCK 1	;STORE R HERE
B.C:	BLOCK 1

NAMPTR:	BLOCK	1	;POINTER TO PROGRAM NAME
IFN NAMESW,<
PRGNAM:	BLOCK 1	;STORE BINARY FILE NAME-USED TO MAKE SYSTAT MORE MEANINGFUL
>
IFN REENT,<
HIGHX:	BLOCK 1
HIGHR:	BLOCK 1	;HOLD X AND R WHILE LOADING LOW SEG PIECES
LOWX:	BLOCK 1
HVAL:	BLOCK 1	;ORG OF HIGH SEG>
HVAL1:	BLOCK 1	;ACTUAL ORG OF HIGH SEG
LOWR:	BLOCK 1	;HOLD X AND R WHILE LOADING HISEG PIECES
IFN COBSW,<LOD37.:	BLOCK 1>
IFN DMNSW,<KORSP:	BLOCK 1>
IFN LDAC,<BOTACS:	BLOCK 1>
IFN WFWSW,<VARLNG:	BLOCK 1
VARREL:	BLOCK 1>
IFN SAILSW,<LIBFLS:	BLOCK	RELLEN*3
PRGFLS:	BLOCK	RELLEN*3>
IFN MONLOD,<
HIRES:	BLOCK 1	;HIGHEST RESIDENT LOADED ADDRESS+1
XRES:	BLOCK 1	;DISPLACEMENT OF RESIDENT PORTION OF LOADED IMAGE
XCUR:	BLOCK 1	;DISPLACEMENT OF CURRENT PORTION OF LOADED IMAGE (WINDOW)
DILADD:	BLOCK 1	;LOWEST ADDRESS IN CURRENT WINDOW
DIHADD:	BLOCK 1	;HIGHEST ADDRESS IN CURRENT WINDOW+1
DIEND:	BLOCK 1	;ADDRESS+1 OF TOP OF WINDOW BUFFER
CURSET:	BLOCK 1	;CURRENT USETI/USETO NUMBER
RESBLK:	BLOCK 1	;NUMBER OF BLOCKS IN RESIDENT PORTION
GENERI:	BLOCK	1	;NAME OF CURRENT F/S
>
IFN TENEX,<
NLSTGL:	BLOCK 1	;FLAG INHIBITS MULT. LIST OF UNDEF. GLOBALS>
PT1:	BLOCK 1
IFN RPGSW,<
NONLOD:	BLOCK 1
SVRPG:	BLOCK 1
IFN TEMP,<
TMPFIL:	BLOCK 2
TMPFLG:	BLOCK 1>
>
OLDDEV:	BLOCK 1		;OLD DEVICE ON LIBRARY SEARCH
LSTDEV:	BLOCK 1		;LAST DEVICE BEFORE THIS ONE
IFN PP,<
PPPN:	BLOCK	1		;PERM PPN
PPN:	BLOCK	1		;TEMP PPN
PPNE:	BLOCK 1
PPNV:	BLOCK 1
PPNW:	BLOCK 1
IFN SFDSW,<MYPPN:	BLOCK	1	;HOLD USER'S PPN
SFDADD:	BLOCK	2	;DEVICE AND SCAN SWITCH
SFD:	BLOCK	SFDSW+2		;TEMP SFD BLOCK
PSFDAD:	BLOCK	2		;DEV AND SCAN SWITCH
PSFD:	BLOCK	SFDSW+2		;PERM SFD BLOCK>
	>
IFN B11SW,<
GLBCNT:	BLOCK 1
HDSAV:	BLOCK 1
HEADNM:	BLOCK 1
LFTHSW:	BLOCK 1
OPNUM:	BLOCK 1
SVHWD:	BLOCK 1
SVSAT:	BLOCK 1
PPDB:	BLOCK PPDL+1
>
HISTRT:	BLOCK 1	;JOBREL AT START OF LOADING
IFN L,<
LSPXIT:	BLOCK 1
RINITL:	BLOCK 1
OLDJR:	BLOCK 1>
IFN SPCHN,<
LINKNR:	BLOCK	1		;CURRENT OVERLAY LINK NUMBER
CHNTAB:	BLOCK 1			;CHAIN VECTOR TABLE,, NEXT BLOCK
BEGOV:	BLOCK 1			;RELATIVE ADDRESS OF BEGINNING OF OVERLAY
CHNACN:	BLOCK 1			;RELATIVE POINTER FOR SAVED NAMPTR
>
TABCNT:	BLOCK 1
LIMBO:	BLOCK	1	;WHERE OLD CHARS. ARE STORED
IFN DIDAL,<LSTBLK:	BLOCK	1	;POINTER TO LAST PROG LOADED>
IFN EXPAND,<ALWCOR:	BLOCK	1	;CORE AVAILABLE TO USER>
IFN ALGSW,<%OWN: BLOCK	1	;ADDRESS OF ALGOL OWN AREA
	OWNLNG:	BLOCK	1	;LENGTH OF OWN BLOCK>
IFN REENT,<SVBRKS:	BLOCK	1	;XWD HIGH,LOW (PROG BREAKS)>
IFN FORSW,<FORLIB:	BLOCK	1	;0=LIB40,1=FOROTS>

SUBTTL	BUFFER HEADERS AND HEADER HEADERS

BUFO:	BLOCK 1			;CONSOLE INPUT HEADER HEADER
BUFO1:	BLOCK 1
BUFO2:	BLOCK 1

BUFI:	BLOCK 1			;CONSOLE OUTPUT HEADER HEADER
BUFI1:	BLOCK 1
BUFI2:	BLOCK 1

ABUF:	BLOCK 1			;AUXILIARY OUTPUT HEADER HEADER
ABUF1:	BLOCK 1
ABUF2:	BLOCK 1

BUFR:	BLOCK 1			;BINARY INPUT HEADER HEADER
BUFR1:	BLOCK 1
BUFR2:	BLOCK 1

DTIN:	BLOCK 1			;DECTAPE INPUT BLOCK
DTIN1:	BLOCK 3

DTOUT:	BLOCK 1			;DECTAPE OUTPUT BLOCK
DTOUT1: BLOCK 3

IFN MONLOD,<
DIOUT:
IFE PURESW,<EXP	.RBALC		;DISK IMAGE INPUT/OUTPUT BLOCK>
IFN PURESW,<BLOCK	1>
	BLOCK 1
DIOUT1:	BLOCK .RBEST-2		;BIG WASTE OF SPACE IN ORDER TO PRE ALLOCATE SOME DISK
IFE PURESW,<EXP	DALLOC		;PRE ALLOCATE SOME BLOCKS>
IFN PURESW,<BLOCK	1>	;.RBEST
	BLOCK	1		;.RBALC
>

TTY1:	BLOCK   TTYL		;TTY BUFFER AREA
BUF1:	BLOCK	BUFL		;LOAD BUFFER AREA
AUX:	BLOCK	ABUFL		;AUX BUFFER AREA

IFN MONLOD,<
LOLIST:	BLOCK 2			;IOLIST FOR LOW PART OF IMAGE
HILIST:	BLOCK 2			;IOLIST FOR HIGH (VIRTUAL) PART OF LOADED IMAGE
>

IFN RPGSW,<
CTLIN:	BLOCK 3
CTLNAM:	BLOCK 3
CTLBUF:	BLOCK 203+1
>

SUBTTL	FORTRAN DATA STORAGE

IFN STANSW,<PATCH:	BLOCK	20		;STANFORD HAS SEMI-INFINITE CORE>
SBRNAM:	BLOCK 1


IFE K,<
TOPTAB:	BLOCK 1	;TOP OF TABLES
CTAB:	BLOCK 1;	COMMON
ATAB:	BLOCK 1;	ARRAYS
STAB:	BLOCK 1;	SCALARS
GSTAB:	BLOCK 1;	GLOBAL SUBPROGS
AOTAB:	BLOCK 1;	OFFSET ARRAYS
CCON:	BLOCK 1;	CONSTANTS
PTEMP:	BLOCK 1;	PERMANENT TEMPS
TTEMP:	BLOCK 1;	TEMPORARY TEMPS
IFN SPCHN,<
SAVBAS:	BLOCK	1		;HIGHEST RELATIVE ADDRESS IN PROGRAM>
COMBAS:	BLOCK 1;	BASE OF COMMON
LLC:	BLOCK 1;	PROGRAM ORIGIN
BITP:	BLOCK 1;	BIT POINTER
BITC:	BLOCK 1;	BIT COUNT
PLTP:	BLOCK 1;	PROGRAMMER LABEL TABLE
MLTP:	BLOCK 1;	MADE LABEL TABLE
SDS:	BLOCK 1	;START OF DATA STATEMENTS
SDSTP:	BLOCK 1	;START OF DATA STATEMENTS POINTER
BLKSIZ:	BLOCK 1;	BLOCK SIZE
MODIF:	BLOCK 1;	ADDRESS MODIFICATION +1
SVFORH:	BLOCK 1	;SAVE H WHILE LOADING F4 PROGRAMS


IOWDPP:	BLOCK 2
CT1:	BLOCK 1		;TEMP FOR C
LTC:	BLOCK 1
ITC:	BLOCK 1
ENC:	BLOCK 1
WCNT:	BLOCK 1		;DATA WORD COUNT
RCNT:	BLOCK 1		;DATA REPEAT COUNT

LTCTEM:	BLOCK 1		;TEMP FOR LTC
DWCT:	BLOCK 1		;DATA WORD COUNT
IFN MANTIS,<MNTSYM:	BLOCK	1	;HOLDS MANTIS AUX SYMBOL POINTER>
>


	VAR	;DUMP VARIABLES
DATEND:!		;END OF AREA CLEARED ON INITIALIZATION
IFN PURESW,<RELOC>


SUBTTL	REMAP UUO

IFN PURESW,<HHIGO:	PHASE	BUF1	;DON'T NEED BUF1 NOW>

HIGO:	CORE	V,		;CORE UUO
	  JFCL			;NEVER FAILS
HINOGO:
IFN REENT,<MOVE	D,HVAL		;GET CURRENT HIGH SEG TOP
	CAMG	D,HVAL1		;ANYTHING LOADED IN HI-SEG
	JRST	HIRET		;NO
	SUB	D,HVAL1		;SEE HOW MUCH
	TRNE	D,1777		;JUST CROSSED A K BOUND?
	JRST	HIOK		;NO
	HRRZ	V,D		;LENGTH ONLY
	ADD	V,HISTRT	;PLUS BASE
	CAMGE	V,.JBREL	;WE MIGHT HAVE GOT 1K EXTRA
	CORE	V,
	  JFCL
HIOK:	MOVE	V,HISTRT	;NOW REMAP THE HISEG.
	REMAP	V,		;REMAP UUO.
	  JRST	REMPFL		;FATAL ERROR.>
HIRET:	IFN NAMESW,<
IFE TENEX,<MOVE W,CURNAM	;GET PROGRAM NAME>
IFN TENEX,<SKIPA W,.+1
	'(PRIV)'>
	SETNAM	W,		;SET IT FOR VERSION WATCHING>
	JRST	0		;EXECUTE CODE IN ACC'S

IFN REENT,<
REMPFL:	TTCALL	3,SEGMES	;PRINT SEGMES
	EXIT			;AND DIE
SEGMES:	ASCIZ	/?REMAP FAILURE/


>
IFN PURESW,<HIGONE:	DEPHASE>
SUBTTL	LISP LOADER

;END HERE IF 1K LOADER REQUESTED.
IFN K,<IFE L,<END BEG>

IFN L,<	XLIST			;THE LITERALS
	LIT			;MUST DUMP NOW SO THEY GET OUTPUT
	LIST

LODMAK:	MOVEI A,LODMAK
	MOVEM A,137	;SET UP TO SAVE THE LISP LOADER
	INIT 17
	SIXBIT /DSK/
	0
	HALT
	ENTER LMFILE
	HALT
	OUTPUT LMLST
	STATZ 740000
	HALT
	RELEASE
	EXIT
LMFILE:	SIXBIT /LISP/
	SIXBIT /LOD/
	0
	0
LMLST:	IOWD 1,.+1		;IOWD
	IOWD LODMAK-LD+1,137	;AND CORE IMAGE
	0
	END LODMAK>>


SUBTTL	 FORTRAN FOUR LOADER

F4LD:	TLNE	F,SKIPSW!FULLSW ;ARE WE IN SKIP MODE
	JRST	REJECT		;YES,DON'T LOAD ANY OF THIS
	MOVEI	W,-2(S);	GENERATE TABLES
	CAIG	W,(H)		;NEED TO EXPAND?
IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
		POPJ	P,
		JRST	POPJM3]>
IFE EXPAND,<	TLO	F,FULLSW>
	TLO	N,F4SW;		SET FORTRAN FOUR FLAG
	HRRZ	V,R;		SET PROG BREAK INTO V
	MOVEM	V,LLC;		SAVE FIRST WORD ADDRESS
	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;
	HRREI	W,-^D36;	BITS PER WORDUM
	MOVEM	W,BITC;		BIT COUNT
	PUSHJ	P,BITWX		;MAKE SURE OF ENOUGH SPACE
	MOVE	W,[JRST ALLOVE]	;LAST DATA STATEMENT
	MOVEM	W,(S)

TEXTR:	PUSHJ	P,WORD;		TEXT BY DEFAULT
	HLRZ	C,W
	CAIN	C,-1
	JRST	HEADER;		HEADER
	MOVEI	C,1;		RELOCATABLE
	TLNN	F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
	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
	TLNN	F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
	PUSHJ	P,BITW;		TYPE 0
	JRST	ABS

SUBTTL	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
	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

SUBTTL	STORE WORD AND SET BIT TABLE

BITW:	MOVEM	W,@X;		STORE AWAY OFFSET
	IDPB	C,BITP;		STORE BIT
	AOSGE	BITC;		STEP BIT COUNT
	AOJA	V,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,(H)
	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
	AOJ	V,;		STEP LOADER LOCATION
BITWX:	IFN REENT,<
	TLNE	F,HIPROG
	JRST	FORTHI>
	CAIGE H,@X
	MOVEI H,@X	;KEEP H SET RIGHT FOR HISEG STUFF
BITWX2:	HRRZ	T,MLTP
	CAIG	T,(H);		OVERFLOW CHECK
IFE EXPAND,<TLO	F,FULLSW>
IFN EXPAND,<PUSHJ P,	[PUSHJ P,XPAND
			POPJ	P,
			JRST POPJM3]>
	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,(H)
		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,(H)
		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


IFN REENT,<
FORTHI:	HRRZ T,.JBREL	;CHECK FOR CORE OVERFLOW
	CAIGE T,@X
	PUSHJ	P,[PUSHJ P,HIEXP
		POPJ	P,
		JRST POPJM3]	;CHECK AGAIN
	JRST BITWX2>

SUBTTL	PROCESS END CODE WORD

ENDS:	PUSHJ	P,WORD;		GET STARTING ADDRESS
	JUMPE	W,ENDS1;	NOT MAIN
	ADDI	W,(R);		RELOCATION OFFSET
	TLNE	N,ISAFLG;	IGNORE STARTING ADDRESS
	JRST ENDS1
	HRRZM	W,STADDR	;STORE STARTING ADDRESS
IFN NAMESW,<MOVE W,NAMPTR	;GET POINTER
	MOVE	W,1(W)		;SET UP NAME
	PUSHJ	P,LDNAM
	MOVE W,DTIN
	MOVEM W,PRGNAM>
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
	MOVEM H,SVFORH
	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
IFN SPCHN,<MOVEM W,SAVBAS	;SAVE AS HIGHEST ADDRESS IN PROGRAM>
	PUSHJ	P,WORD;		COMMON BLOCK SIZE
	HRRZM	W,BLKSIZ
	JUMPE	W,PASS2;	NO COMMON
COMTOP:	PUSHJ	P,WORDPR	;GET A COMMON PAIR
	TLNE	F,SKIPSW!FULLSW	;IF SKIPPING
	JRST	COMCO1		;DON'T USE
	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
COMCO1:	SOS	BLKSIZ
	SOSLE	BLKSIZ
	JRST	COMTOP
	JRST	PASS2

COMYES:	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.
	AOJA	V,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

SUBTTL	BEGIN HERE PASS2 TEXT PROCESSING

PASS2:	ADDI V,(X)
IFN REENT,<TLNE F,HIPROG
	HRRZ V,H>
	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
IFE L,<IFN REENT,<TLNN F,HIPROG	;DON'T BOTHER IF IN HISEG, CHAIN NOT SMART ENOUGH>
	TLOE	N,PGM1		;YES, IS THIS FIRST F4 PROG?
	JRST	NOPRG		;NO
	HRR	W,COMBAS	;YES, PLACE PROG BREAK IN LH
	HRLM	W,.JBCHN(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
	MOVEI	W,TABDIS;	HEAD OF TABLE
	HRLI W,-TABLNG	;SET UP FOR AOBJN
	HLRZ	T,(W);		GET ENTRY
	CAME	T,C;		CHECK
	AOBJN W,.-2
	JUMPGE W,LOAD4A	;RAN OUT OF ENTRIES
	HRRZ	W,(W);		GET DISPATCH
	LDB	C,[POINT 12,@X,35]
	JRST	(W);		DISPATCH


PASS2C:	PUSHJ	P,PASS2A
	JRST	PASS2B
	JRST	ENDTP

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
TABLNG==.-TABDIS

;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
IFN MANTIS,<CAIN W,770000;	SPECIAL DEBUGGER DATA
	JRST	SPECBUG>
	JRST	LOAD4A;		DATA STATEMENTS WILL GO HERE

TTR50:	RADIX50	10,%TEMP.
PTR50:	RADIX50	10,TEMP.
CNR50:	RADIX50	10,CONST.


IFN MANTIS,<
SPECB:	CAML	W,.JBREL	;ROOM?
	AOJA	W,[CORE W,	;NO, GET IT
		JRST	MORCOR
		 JRST .+1]	;GOT IT
	PUSHJ	P,WORD		;GET SPECIAL DATA
	MOVEM	W,@MNTSYM	;DEPOSIT IT
	SOSG	BLKSIZ		;MORE?
	JRST	TEXTR		;NO
SPECBUG:TRNN	N,MANTFL	;ARE WE LOADING MANTIS DATA?
	JRST	[PUSHJ	P,WORD		;NO, READ A WORD
		SOSG	BLKSIZ		;AND IGNORE IT
		JRST	TEXTR		;BLOCK EXHAUSTED?
		JRST	@.]		;NO, LOOP
	AOS	W,MNTSYM	;STEP SPECIAL POINTER
	SOJG	W,SPECB		;LOOP IF SETUP ALREADY
	HRRZ	W,.JBREL	;SET IT UP NOW
	MOVEM	W,MNTSYM
	JRST	SPECBUG		;AND STEP IT>
SUBTTL	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:	AOJ	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
	TRNN	W,7777	;IGNORE SIX BITS	;U/O-LKS
	JRST	PSTA		;NO COMMON	;U/O-LKS
	PUSHJ	P,COMDID	;PROCESS COMMON
	JRST	PCOM1

COMDID:	ANDI	W,7777	;IGNORE SIX BITS	;U/O-LKS
	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
	TRNN	W,7777	;IGNORE SIX BITS	;U/O-LKS
	JRST	NCO				;U/O-LKS
	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
	JRST	.+2
PPLT:	ADD	C,PLTP
	HRRZ	C,(C)
	JRST	PCOMX

SYMXX:	PUSH	P,V
	PUSHJ	P,SYMPT
	POP	P,V
IFE REENT,<POPJ	P,>
IFN REENT,<JRST RESTRX>

SWAPSY:	MOVEI	T,0;		SET TO EXCHANGE DEFS
	EXCH	T,1(C);		GET NAME
IFN MANTIS,<TRNE N,MANTFL	;LOADING MANTIS DATA?
	SKIPA	C,(C)		;YES, GET FULLWORD VALUE>
	HRRZ	C,(C)		;GET HALFWORD 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
		POPJ	P,
		JRST TBLCHK]>
	POPJ P,

SUBTTL	END OF PASS2

ALLOVE:	TLZ	N,F4SW		;END OF F4 PROG
	HRRZ V,SDSTP	;GET READY TO ZERO OUT DATA STMTS
	SETZM (V)	;AT LEAST ONE THERE
	CAIL V,(S)	;IS THERE MORE THAN ONE??
	JRST NOMODS	;NO
	HRLS V
	ADDI V,1	;SET UP BLT
	BLT V,(S)	;ZERO OUT ALL OF IT
NOMODS:	MOVE H,SVFORH
	TLNE	F,FULLSW!SKIPSW
	JRST	HIGH3A
	HRR	R,COMBAS	;TOP OF THE DATA
	CAMG	H,SDS		;HIGHEST LOC GREATER THAN DATA STATEMENTS?
	JRST	HIGH3A		;NO, RETURN
	ADDI	H,1(S)		;YES, SET UP MEANINGFUL ERROR COMMENT
	SUB	H,SDS		;...
	TLO	F,FULLSW	;INDICATE OVERFLO
HIGH3A:	IFN REENT,<SETZ	W,	;CAUSES TROUBLE OTHERWISE
	TLZE F,HIPROG
	JRST HIGHN1
IFE SPCHN,<HRRZ V,GSTAB>
IFN SPCHN,<HRRZ	V,SAVBAS	;GET END OF PROGRAM RELATIVE  ADDRESS
				;THIS MEANS THAT WITH SPECIAL CHAINING THE
				;ENTIRE LAST PROGRAM OF A LINK WILL BE SAVED
				;BUT COMMON DECLARED FOR THE FIRST TIME
				;IN THAT  PROGRAM WON'T BE. THIS SHOULD NOT
				;CAUSE PROBLEMS BECAUSE IF COMMON APPEARS HERE
				;NOBODY ELSE CAN REFERENCE IT ANYWAY. >
	MOVEI V,@X
	CAMLE V,HILOW
	MOVEM V,HILOW>
	HRRZ C,R
	JRST	HIGH31		;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,(H)
		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
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:	IFE L,<IFN REENT,<
	TLNN F,HIPROG>
	TLOE	N,BLKD1		;IS THIS FIRST BLOCK DATA?
	JRST	ENDTP		;NO
	HRR	V,COMBAS	;PLACE PROG BREAK IN RH FOR
	HRRM	V,.JBCHN(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;	OVERLAP CHECK
	AOJA	V,ENDTP0
ENDTP2:	SETZM	PT1
ENDTPW:	HRRZ	V,SDSTP
IFN EXPAND,<IFN REENT,<TLNE F,HIPROG
		JRST ENDTPI>
		SUBI V,(X)
		CAMG V,COMBAS
		PUSHJ	P,[SUB V,COMBAS
			MOVNS	V
			JRST	XPAND9]
		JFCL		;FOR ERROR RETURN FROM XPAND
ENDTPH:		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
	AOJ	V,
	ADD	W,@X;		ITEMS COUNT
	MOVEM	W,ITC
	MOVE	W,[MOVEM W,LTC]
	MOVEM	W,@X;		SETUP FOR DATA EXECUTION
	AOJ	V,
	MOVSI	W,(MOVEI W,0)
	EXCH	W,@X
	MOVEM	W,ENC;		END COUNT
	AOJ	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
	JUMPE T,FORCNF
	SUB	T,PT1;		SUBTRACT INDUCTION NUMBER
	ASH	T,1
	SUBI T,1
	HRRM	T,@X
	HLRZ	T,@X
	ADDI	T,P
	HRLM	T,@X
	AOJA	V,LOOP
IFN EXPAND,<IFN REENT,<
ENDTPI:	HRRZ V,COMBAS
	MOVEI V,@X
	CAMLE V,.JBREL
	JRST	[PUSHJ	P,HIEXP
		JRST	ENDTPH
		JRST	ENDTPI]
	JRST ENDTPH>>
FORCNF:	ERROR	,</FORTRAN CONFUSED ABOUT DATA STATEMENTS!/>
	JRST	ILC1

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
	AOJ	V,
	TLO	N,SYDAT
	PUSHJ	P,PROC;		PROCESS THE TAG
	JUMPGE	V,DATAOV	;DATA STATEMENT BELOW CODE TOP
	JRST	LOOP		;PROPER RETURN

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

DOEND.:	HLRE	T,@(P)		;RETAIN SIGN OF INCREMENT
	ADDM	T,-2(P);	INCREMENT
	HRRE	T,@(P);		GET FINAL VALUE
	SUB	T,-2(P)		;FINAL - CURRENT
	IMUL	T,@(P)		;INCLUDE SIGN OF INCREMENT
	JUMPL	T,DODONE	;SIGN IS ONLY IMPORTANT THING
	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
	HRRZ C,SDS
IFE EXPAND,<SUBI C,(X)	;CHECK FOR ROOM
	CAMGE C,COMBAS	;IS IT THERE
	TLO F,FULLSW	;NO (DONE EARLIER IF EXPAND)
	HRRZ C,SDS>
	SUBI C,1	;GET ONE LESS (TOP LOCATION TO ZERO)
IFN REENT,<TLNE F,HIPROG
	MOVE C,.JBREL>
SECZER:	CAMLE	W,C		;ANY DATA TO ZERO?
	JRST	@SDS		;NO, DO DATA STATEMENTS
				;FULLSW IS ON IF COMBAS GT. SDS
	TLNN	F,FULLSW+SKIPSW	;SHOULD WE ZERO?
	SETZM	(W)		;YES, DO SO
	TLON	N,DZER		;GO BACK FOR MORE?
	AOJA	W,SECZER	;YES, PLEASE
	HRLI	W,-1(W)		;SET UP BLT POINTER TO ZERO DATA
	TLNN	F,FULLSW+SKIPSW	;SHOULD WE ZERO?
	BLT	W,(C)		;YES, DO SO
	JRST	@SDS		;GO DO DATA STATEMENTS

DATAOV:	ERROR	0,</DATA STATEMENT OVERFLOW!/>
	JRST	ILC1

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
	HRRZS	T
	ADDI	T,(W);		OFFSET
IFN REENT,<HRRZS T		;CLEAR LEFT HALF INCASE OF CARRY
	CAML T,HVAL1
	JRST	[ADD T,HIGHX
		HRRZS T	;MUST GET RID OF LEFT HALF
		CAMLE T,.JBREL
		JRST DATAOV	;IN CASE FORTRAN GOOFS ON LIMITS
		JRST DWFS.1]
	ADD T,LOWX>
	HRRZS T
IFE REENT,<ADDI T,(X)>
	CAML T,SDS
	JRST DATAOV
DWFS.1:	PUSHJ	P,DREAD		;GET A DATA WORD
	HRRZS T
IFN REENT,<CAMG T,.JBREL	;JUST TO MAKE SURE>
	CAMN T,SDS
	JRST DATAOV
	TLNN	F,FULLSW+SKIPSW	;LOAD THE NEXT DATA ITEM?
	MOVEM	W,(T)		;YES, STORE IT
	SOSE	W,DWCT;		STEP DOWN AND TEST
	AOJA T,DWFS.1		;ONE MORE TIME, MOZART BABY!
	POPJ	P,
SUBTTL	ROUTINE TO SKIP FORTRAN OUTPUT

;SUBSECTION OF THE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. CODE TAKEN FROM FUDGE2.

MACHCD:	HRRZ	C,W		;GET THE WORD COUNT
	PUSHJ	P,WORD		;INPUT A WORD
	SOJG	C,.-1		;LOOP BACK FOR REST OF THE BLOCK
				;GO LOOK FOR NEXT BLOCK

REJECT:	PUSHJ	P,WORD		;READ A FORTRAN BLOCK HEADER
	TLC	W,-1		;TURN ONES TO ZEROES IN LEFT HALF
	TLNE	W,-1		;WAS LEFT HALF ALL ONES?
	JRST	REJECT		;NO, IT WAS CALCULATED MACHINE CODE
	CAIN	W,-2		;YES, IS RIGHT HALF = 777776?
	JRST	ENDST		;YES, PROCESS F4 END BLOCK
	LDB	C,[POINT 6,W,23];GET CODE BITS FROM BITS 18-23
	TRZ	W,770000	;THEN WIPE THEM OUT
	CAIN	C,77		;IS IT SPECIAL DEBUGGER DATA?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA
	CAIE	C,70		;IS IT A DATA STATEMENT?
	CAIN	C,50		;IS IT ABSOLUTE MACHINE CODE?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA STATEMENTS
	PUSHJ	P,WORD		;NO, ITS A LABEL OF SOME SORT
	JRST	REJECT		;WHICH CONSISTS OF ONE WORD
				;LOOK FOR NEXT BLOCK HEADER

ENDST:	MOVEI	C,1		;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
	MOVEI	T,6		;TO GO
F4LUP1:	PUSHJ	P,WORD		;GET TABLE MEMBER
F4LUP3:	SOJGE	C,F4LUP1	;LOOP WITHIN A TABLE
	JUMPL	T,LOAD1		;LAST TABLE - RETURN
	SOJG	T,F4LUP2	;FIRST TWO WORDS AND FIVE TABLES
	JUMPE	T,F4LUP1	;COMMON LENGTH WORD
F4LUP2:	PUSHJ	P,WORD		;READ HEADER WORD
	MOVE	C,W		;COUNT TO COUNTER
	JRST	F4LUP3		;STASH
SUBTTL	LISP LOADER

IFE L,<	END	BEG>
IFN L,<	XLIST
	LIT
	LIST

LODMAK:	MOVEI A,LODMAK
	MOVEM A,137	;SET UP TO SAVE THE LISP LOADER
	INIT 17
	SIXBIT /DSK/
	0
	HALT
	ENTER LMFILE
	HALT
	OUTPUT LMLST
	STATZ 740000
	HALT
	RELEASE
	EXIT
LMFILE:	SIXBIT /LISP/
	SIXBIT /LOD/
	0
	0
LMLST:	IOWD 1,.+1		;IOWD
	IOWD LODMAK-LD+1,137	;AND CORE IMAGE
	0
	END LODMAK>