Google
 

Trailing-Edge - PDP-10 Archives - BB-J713A-BM - language-sources/lnklod.mac
There are 50 other files named lnklod.mac in the archive. Click here to see a list.
TITLE LNKLOD - LOAD MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JBC/RKH/JNG/DCE/MCHC/DZN	24-Aug-79


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION


SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL

ENTRY	LNKLOD
EXTERN	LNKSCN,LNKCOR,LNKWLD,LNKLOG,LNKF40,LNKMAP,LNKXIT


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==1220		;DEC EDIT VERSION

VERSION


SEGMENT


;LOCAL ACC DEFINITIONS
INTERN	R,RB,WC

R=R1		;CURRENT RELOCATION COUNTER
RB=R+1		;RELOCATION BYTE WORD
WC=R3		;WORD COUNT
SUBTTL	REVISION HISTORY


;START OF VERSION 1A
;44	ADD ASCIZ TEXT BLOCK
;45	HASH INITIAL SYMBOLS AT ASSEMBLY TIME
;46	ADD KLUDGE FEATURE
;52	ADD ASCII TEXT BLOCK
;54	ADD KIONLY D.P. INST.
;61	ADD STORE CODE IN FX AREA FOR TWOSEG FORCED HIGH/LOW
;63	STORE MULTIPLY-DEFINED SYMBOLS IN SYMBOL TABLE FOR MAP
;75	ADD ROUTINE TO ADDRESS CHECK A SINGLE WORD
;101	FIXES FOR FAIL CODE WITH UNDEF GLOBALS IN BLOCK 11
;102	ADD TEST FOR END BLOCK NOT SEEN BEFORE EOF
;106	REMOVE HIORG, REPLACE WITH LL.S2 OR SO.S2 AS REQUIRED
;107	REPLACE KLUDGE BY MIXFOR
;111	MAKE MIXFOR WORK EVEN IF NOT IN SEARCH MODE
;112	CHECK PER FILE /SEARCH SWITCH @LODTST
;113	MAKE MIXFOR KNOW ABOUT ARRAY REFERENCES IN ARGS
;115	MAKE /NOSYMS WORK CORRECTLY

;START OF VERSION 1B
;117	(12058) ADD MISSING POPJ P, AT FORKI+2
;130	(12315) PREVIOULY REQUESTED COMMON IS NOT PUT IN LOCAL SYMBOL TABLE CORRECTLY

;START OF VERSION 2
;135	ADD OVERLAY FACILITY
;143	ADD TEST FOR /INCLUDE MODE
;145	IMPLEMENT USER LIBRARIES
;147	TURN ON MIXFOR FEATURE
;152	FIX LOOP IF /NOINIT AND UNDEF SYMBOLS
;157	(12640) ONLY PRINT FSI MESSAGE IF /FORSE GIVEN EXPLICITLY
;161	ADD LANGUAGE SPECIFICATION TO /USERLIB
;163	IF /ONLY IS ON DON'T LOAD F-10 CODE INTO LOW SEG BY DEFAULT
;164	MAKE CPU TEST OF REL FILES MORE GENERAL
;166	READ BACK RADIX50 SYMBOL FILES
;167	CHANGE ARGS TO /OTS SWITCH
;172	(13243) BUG IF MORE THAN 1 BLOCK TYPE 16 (OR 17) SEEN
;173	TEST ASCIZ BLOCK TYPE FOR VALID FIRST CHAR
;174	FIX BUGS IN RELOCATABLE OVERLAYS
;176	MAKE START BLOCK (7) BE TWO WORDS LONG
;200	LOAD REENTRANT OVERLAY HANDLER
;204	FIX CORE EXPANSION BUG IN SYMBOL TABLE FIXUPS
;206	FIX RH CHAINED GLOBAL IF NOT ALL OF CHAIN IN CORE
;210	(13461) MORE OF #172, HANDLE TYPE 16 CORRECTLY
;220	HANDLE COMMON REFERENCED BEFORE BEING DEFINED CORRECTLY
;START OF VERSION 2B
;223	FIXUP PRIMARY TRIPLET AFTER ADDITIVE FIXUPS HAVE BEN DONE
;232	(13920) UNRELOCATE POLISH POINTER BEFORE CALL TO T.11EV
;233	(13932) INFINITE LOOP IF UNDEF SYMBOLS AND TYPE 16 BLOCKS
;251	Setup FX before using for temp storage when /SEG:LOW
;	and no high seg size in REL file
;275	ADD CODE TO LOAD SIMULA LIBRARY
;305	Correct the test for CPU type so it works.
;325	Don't ever eliminate block 3 when saving TWOSEG REL
;	block in DY and FX during force to single segment when
;	high segment break is unknown.
;327	Save 2 locations in F40NAM
;341	INCLUDE EDIT 327 IN MAINTENANCE SOURCES.  LABEL EDITS 223,232,233
;367	KEEP CORRECT W3 ON POLISH FIXUPS WHEN SYMBOL JUST DEFINED
;375	Make LS.ADE internal for use in LNKOLD.
;376	Give error message if trying to overlay F40 code.
;405	Add routine D.RED1, like D.IN1 but POPJ's on EOF.
;412	Preserve W3 when doing fixups.
;422	Shut off /SEG:??? when processing fixups.
;START OF VERSION 2C
;450	Correct code at F40NAM to give error message if illegal
;	mixing of F40 and FORTRAN CODE
;451	Change message for illegal mixing of F40 and Fortran code
;456	Setup P1 in ADCHK. before calling LNKCOR.
;457	REQUEST FORSE. as soon as both FORTRAN's seen  so
;	library searching will work. Don't wipe out PROCSN when
;	searching libraries.
;462	Set up R in .MXFOR after calling SY.RQ, which destroys it.
;464	Implement /MISSING and LNKIMM
;465	Redo some of block type dispatch for block type 100.
;470	Preserve left half of R at SY.FHS for overlays.
;471	Add code for ALGOL debugging system.
;510	Generate correct fixups for relocatable symbols in LS area.
;512	Handle chained fixups (PS.FXC) correctly.
;515	Teach fixup processor about PH.ADD
;517	Change ABLLEN to LN.ABL
;522	Set relocation bit correctly when following paged fixups.
;526	Don't set relocation bits unless loading overlays. fix to 522.
;530	Define triplet flags correctly.
;532	Don't search FORLIB too many times.
;535	Always search user libraries for all links.
;541	Fixup F40 subroutine prologue correctly under /MIXFOR.
;542	Define entry points correctly when paging in MIXFOR processor.
;543	Catch multiple definition for additive second definition.
;544	SOUP in LINK version 3 stuff for TOPS-20.
;555	Always load global symbols into ALGOL programs.
;557	Clean up the listing for release.

;START OF VERSION 3
;445	INSERT OLD EDITS TO POLISH SYMBOL FIXUPS

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;561	Fix the MIXFOR code for F10 subroutines
;572	Make sure LS addr in core before doing fixups
;574	Load OTS into low seg if no high seg and low seg .GT. 128K
;605	Use OUTSTR for ?LNKUGS message.
;611	Support COBOL-74
;612	Fix various polish bugs
;613	Load user libs before system libs to avoid FOROTS screwup.
;614	Re-search a system lib if more modules that want it are seen.
;630	Don't forget INCLUDE/EXCLUDE specs after editing an error.
;632	Fix $LOCATION to always work, add $FIXUP.
;650	Use VM on TOPS-10 if available.
;654	Accept a relative address in LS.ADE incase shuffling.
;661	Make the %LNKMDS message be L%W.
;667	Call correct paging routine to move hi seg  up.
;672	Set FX.DIR correctly in PRGLIB.
;673	Change the FON and ILI messages to MSR and IRB.
;677	Don't default to /SYMSEG:LOW if loading overlays.
;704	Order psect reloc table by order of origin before doing map.
;712	Add check for psect index when a global is defined.
;716	Read in smaller of LN.WD or current size when moving window down.
;731	SEARCH MACTEN,UUOSYM
;734	Don't allow mixing of KL & KA, or KL & KI  compiled code.
;737	Clear link list pointer after it's given back.
;741	Check fixup address against window range.
;746	Add CHKBND routine to check PSECT overlap after reloc table sort.
;747	Update LOWLOC after reloc table sorted and before going to LNKXIT.
;751	Fix bug with calculation of space to give back in PG.SD.
;752	JFFO cpu-code from Block 6 before dispatching to inconsistancy check.
;760	Expand PSECT overlap checks to check each PSECT with all others.
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF LINK 4A
;766	Return cpu table offset in P2 from routine CPUTST.
;777	Comment SY.RF as destroying P1-P4.
;1101	Keep LSTBLK (last block read from current file) up to date.
;1102	Keep window into overflow file in section 0.
;1103	Zero the .REQUEST/.REQUIRE list pointer after freeing its contents.
;1106	Update HL.S1 from RC.CV of the highest PSECT loaded.
;1114	Don't clear COBOL symbols and ALGOL OWNs in LODTST (moved to T.5A).
;1116	When expanding a window in PG.SX, read in any data already in the
;	overflow file for the region being created.  Broken by 716.
;1120	Remove CPUTST routine (T.6 does it now) and all calls to it.
;1131	Force non-reentrant OTS sooner, if low segment is within 40 pages of 400000.
;1132	Teach SEGCHK about PSECTs above the high segment.
;1135	Make PG.SU expand anyway if request crosses page and window only a page.
;1143	Fake a module name if LS.ADD called with a symbol before a module seen.
;1165	Zero LSTSYM in SY.RLS if the symbol was rejected.
;1174	Label and clean up all error messages.
;1175	Fix /UPTO with a symbolic argument.
;1200	If loading reentrant FOROTS, search SYS:FORLIB/SEGMENT:LOW.
;1201	Change reference to $SEGLOW to LC.IX.
;1203	Support extended FORTRAN.
;1204	Complain if any Psects are too long.
;1207	Make the LNKCMX message continue loading.
;1212	Make LNKIVC and LNKPOV consistent with other messages.
;1213	Respect the FS.MDC bit.
;1215	Use RC.HL instead of RC.CV for the LOWLOC check at CHKLLC.
;1217	Clean up the listings for release.
;1220	Release on both TOPS-10 and TOPS-20 as version 4A(1220).
SUBTTL	LOAD CONTROL


;ENTER HERE FROM LNKSCN
;LNKWLD READS A FILE SPEC FROM LIST POINTED TO BY F.INZR
;NON-SKIP RETURN IS END OF LIST
;SKIP RETURN WITH DEVICE INITED AND FILE OPEN OR ENTERED

LNKLOD:	JFCL	.+1		;IN CASE CCL ENTRY
IFN .ASBLK,<
	SKIPE	F.ASCI		;READING INCORE TEXT?
	JRST	LNKWLD##	;YES, SEE IF ANY SWITCHES FOR CURRENT SPEC
>
	HLLZ	FL,FLAGS	;RESET GLOBAL DEFAULTS
E$$LDS::.ERR.	(MS,0,V%L,L%I,S%I,LDS,<LOAD segment>) ;[1174]
LODNXT:	HLR	FL,FL		;CLEAR TEMP FLAGS AND SET FROM GLOBAL ONES
	SKIPN	F.EDIT		;[630] DON'T IF EDITING AN ERROR
	PUSHJ	P,Z.INER	;CLEAR LOCAL STORAGE, GIVE ERRORS
	PUSHJ	P,LNKWLD	;GET NEXT FILE SPEC
	  JRST	LNKSCN		;LIST EMPTY GET MORE
LODTST::JFCL			;INCASE FROM /SYSLIB
	HRRM	FL,FLAGS	;SAVE LOCAL FLAGS AT START OF FILE
	TRNN	FL,R.LIB!R.INC	;IN LIBRARY SEARCH MODE OR /INC MODE?
	JRST	LOAD		;NO
	SKIPN	USYM		;ANY UNDEFINED SYMBOLS
	SKIPE	INCPTR		;OR SOME INCLUDES STILL TO DO?
	CAIA			;YES
	JRST	EOF1		;NO, GET NEXT FILE
	SKIPE	XBUF		;YES, INDEX IN CORE FOR THIS FILE?
	JRST	T.14B##		;YES, USE IT TO FIND PROG TO LOAD
	JRST	LOAD

T.LOAD::HRR	FL,FLAGS	;RESTORE LOCAL FLAGS
	TRNE	FL,R.LIB!R.INC	;IN LIBRARY SEARCH MODE OR /INC MODE?
	JRST	LODTST		;YES,
;	JRST	LOAD
SUBTTL	READ BLOCK TYPE AND DISPATCH


;LOAD READS THE FIRST WORD OF A BLOCK
;IT PUTS THE LENGTH (NEGATIVE) IN WC AND DISPATCHES TO HANDLING ROUTINE

LOAD::	PUSHJ	P,D.IN1		;READ ONE WORD
	MOVNI	WC,400000(W1)	;GET NEG BLOCK LENGTH
	HLRZ	T1,W1		;GET BLOCK TYPE
	CAIG	T1,377		;IS IT OLD BLOCK TYPES
	JRST	LNKOLD##	;YES, HANDLE THERE
	CAIG	T1,003777	;IN RANGE FOR NEW?
	CAIGE	T1,1000
	JRST	T.ERR1		;NO
	JRST	LNKNEW##	;YES


;UNKNOWN BLOCK TYPES

T.ERR1:
	CAILE	T1,777		;IN LNKOLD OR LNKCST?
	JRST	T.ERR2		;NO, MUST BE ASCII TEXT
	CAIL	T1,700		;DEC-DEFINED SPEC. FILE TYPES?
	JRST	LNKOLD##	;YES, GO HANDLE
	CAIL	T1,402		;402-677 (CUSTOMER TYPES) ?
	JRST	LNKCST##	;YES, LET CUSTOMER HANDLE
	CAIE	T1,400		;ONLY CHOICE LEFT IS F40
	JRST	T.401##		;SO ITS T.401 IF NOT T.400
	JRST	T.400##		;USUALLY IS 400

T.ERR2:				;HERE FOR ASCII TEXT OR ILLEGAL
IFN .ASBLK,<
	CAIL	T1,(<ASCII /   />&<-1,,0>)
	CAILE	T1,(<ASCII /zzz/>&<-1,,0>)
	CAIA			;NO
	JRST	LNKASC##	;VALID ASCIZ BLOCK
>
E$$IRB::.ERR.	(MS,.EC,V%L,L%F,S%F,IRB,<Illegal REL block type >) ;[1174]
	.ETC.	(OCT,.EP!.EC,,,,T1)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
SUBTTL	CLEAR INCLUDE/EXCLUDE STORAGE


Z.INER:	HRRZ	P1,INCPTR	;GET POINTER TO FIRST BLOCK
	JUMPE	P1,Z.EXIN	;NONE, GIVE UP
	MOVEI	T1,[ASCIZ	\?LNKIMM \]	;GET PREFIX
	PUSHJ	P,MISNG1##	;TYPE IT AND REST OF MESSAGE
Z.INEX::HRRZ	P1,INCPTR	;GET FIRST
	JUMPE	P1,Z.EXIN	;NONE, TRY EXCLUDES
	HLLZS	INCPTR		;ZERO POINTER SINCE LIST GONE
	PUSHJ	P,Z.ZAP		;WIPE OUT THIS LIST
				;FALL INTO Z.EXIN

Z.EXIN:	HRRZ	P1,EXCPTR	;GET POINTER TO EXCLUDE LIST
	JUMPE	P1,CPOPJ	;ALL DONE
	HLLZS	EXCPTR		;INDICATE LIST ZEROED
Z.ZAP:
IFN .EXSYM,<
	ADD	P1,[-.EXC+1,,1]	;MAKE AOBJN POINTER TO BLOCK
Z.ZAP1:	SKIPE	P2,(P1)		;GET NEXT WORD
	TLNE	P2,770000	;MUST BE A POINTER
	JRST	Z.ZAP2		;NOTHING THERE
	MOVEI	T1,(P1)		;T1=ADDRESS
	AOS	T2,(P2)		;T2=SIZE (INC SIZE WORD)
	PUSHJ	P,DY.RET##	;RETURN THE BLOCK
Z.ZAP2:	AOBJN	P1,Z.ZAP1	;LOOP OVER ENTIRE BLOCK
	SUBI	P1,.EXC		;POINT BACK TO 1ST WORD
> ;END IFN .EXSYM
	MOVEI	T1,(P1)		;POINT TO FIRST WORD
	MOVEI	T2,.EXC		;STANDARD SIZE
	HRRZ	P1,(P1)		;SAVE POINTER WORD
	PUSHJ	P,DY.RET##	;FREE UP THE CORE
	JUMPN	P1,Z.ZAP	;LOOP IF MORE
	POPJ	P,		;ELSE FINISHED
SUBTTL	ADDRESS CHECK A SINGLE WORD


;HERE TO MAKE SURE LOCATION IS IN CORE
;ENTER WITH ADDRESS IN P3
;RETURNS NEW ADDRESS (MAYBE) IN P3
;MAY USE P2 (IF PAGING)
;CALLED BY
;	MOVE	P3,ADDRESS
;	MOVEI	R,SEGMENT NO.
;	PUSHJ	P,ADCHK.##

ADCHK.::
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATION TABLE SETUP?
	PUSHJ	P,RT.P3##	;YES, SET BYTE PTR
	CAIN	R,1		;LOW SEG?
	SUB	P3,PH.ADD	;REMOVE LINK ORIGIN
>
	MOVE	P2,P3		;GET A COPY
	SKIPE	PAG.S0(R)	;PAGING?
	JRST	ADCHK2		;YES, SEE IF IN CORE
	ADD	P2,LC.LB-1(R)	;RELOCATE RELATIVE ADDRESS
	CAMG	P2,LC.AB-1(R)	;WILL IT FIT IN EXISTING SPACE?
	JRST	ADCHK1		;YES
	SUB	P2,LC.AB-1(R)	;GET EXTRA REQUIRED
	MOVEI	P1,LC.IX-1(R)	;POINT TO PROPER AREA
	PUSHJ	P,LNKCOR##	;TRY TO GET MORE SPACE
	  JRST	ADCHK2		;FAILED BUT MUST BE ON DSK
	SUB	P3,LW.S0(R)	;INCASE WE DUMPED CORE FOR FIRST TIME
ADCHK1:	ADD	P3,LC.LB-1(R)	;FINALLY FIX IN CORE
	POPJ	P,		;RETURN WITH P3 SETUP

ADCHK2:	PUSHJ	P,@[EXP PG.LSG,PG.HSG]-1(R)
	JRST	ADCHK1		;NOW TRY
SUBTTL	PAGING CORE CONTROL


;HERE TO CHECK TO SEE IF LOW SEG ADDRESS IS INCORE
;IF NOT CHANGE CORE WINDOW TO INCLUDE NEW ADDRESS

PG.LSG::CAMGE	P3,LW.S1	;IS LOWER ADDRESS IN CORE
	PUSHJ	P,PG.LSD	;NO, MOVE WINDOW DOWN
	CAMLE	P2,UW.S1	;AND UPPER ALSO
	PUSHJ	P,PG.LSU	;NO, NEED TO MOVE WINDOW UP
	SUB	P3,LW.S1	;REMOVE BASE
	POPJ	P,		;AND CONTINUE

;HERE FOR LOW SEG TO MOVE DOWN

PG.LSD:	PUSH	P,R		;SAVE R
	MOVEI	R,LC.IX		;INDEX TO LOW SEG
	JRST	PG.SD		;GENERAL MOVER DOWN


PG.LSU:	PUSH	P,R		;SAVE R
	MOVEI	R,LC.IX		;INDEX TO LOW SEG
	JRST	PG.SU		;GENERAL MOVER UP
;HERE TO MOVE THE WINDOW EITHER UP OR DOWN, BUT WITH NO OVERLAPING. FIRST,
;OUTPUT CURRENT WINDOW, THEN READ BACK THE PORTION WE WILL NEED. WINDOW
;(POTENTIALLY) SHRINKS TO SMALLER OF LN.WD OR ITS CURRENT SIZE. IF NEW WINDOW
;ORIGIN PLUS LENGTH EXCEEDS 512P IN THE FILE'S ADDRESS SPACE, SLIDE THE WINDOW
;DOWN JUST ENOUGH SO IT ENDS AT 512P.

PG.SD:	HRLZ	T1,LW.S0(R)	;SETUP CONTROL WORD
	HRR	T1,UW.S0(R)	;FIRST,,LAST WORD TO MOVE
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R)
	MOVE	T1,P3		;LOWER ADDRESS WE NEED
	ANDCMI	T1,.IPM		;MAKE INTO BLOCK BOUND
	EXCH	T1,LW.S0(R)	;RESET WINDOW
	SUB	T1,UW.S0(R)	;OLD BASE - OLD UPPER
	MOVM	T2,T1		;+LENGTH -1
	MOVE	T1,T2		;[751] SPACE TO GIVE BACK
	SUBI	T1,LN.WD	;[751] IN CASE CURRENT SIZE BIGGER
	CAILE	T2,LN.WD-1	;[717] CURRENT SIZE SMALLER?
	MOVEI	T2,LN.WD-1	;[717] NO, USE LN.WD
	ADD	T2,LW.S0(R)	;[717] GET US TO END
	TLNE	T2,-1		;[1102] BUT IS WINDOW NOW PAST 512P?
	JRST	[SUBI T2,-1		;[1102] YES--COMPUTE HOW MUCH WE'RE OVER
		 SUB T2,LW.S0(R)	;[1102] MOVE WINDOW DOWN BY THAT MUCH
		 MOVNM T2,LW.S0(R)	;[1102]   ..
		 MOVEI T2,-1		;[1102] TOP OF WINDOW IS NOW AT 512P
		 JRST .+1]		;[1102] CONTINUE WITH SAME WINDOW SIZE
	MOVEM	T2,UW.S0(R)	;[717]
	JUMPL	T1,PG.SD2	;[717] JUMP IF NOTHING TO GIVE BACK
	ADD	T1,TAB.LB(R)	;FIX IN CORE
	PUSHJ	P,GBCK.L##	;GIVE BACK TO NEXT LOWER
PG.SD2:	HRLZ	T1,LW.S0(R)	;RESET CONTROL WORD
	HRR	T1,UW.S0(R)	; TO DESIRED AREA
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R)
	PJRST	FIXUP		;FIXUP ALL POSSIBLE CORE CHAINS
;HERE TO MOVE THE WINDOW UP IN MEMORY. IF NECESSARY, DUMP THE LOWER PART OF THE
;WINDOW AND MOVE DOWN THE REST. THEN EXPAND THE END OF THE WINDOW IF NECESSARY
;AND READ IN THE UPPER PART WHICH IS USUALLY ZERO. TRY TO KEEP THE SIZE OF THE
;WINDOW REASONABLE AS A FIRST APPROXIMATION.

PG.SU:	MOVE	T1,P2		;[1135] SEE IF REQUEST CROSSES A PAGE BOUNDARY
	XOR	T1,P3		;[1135]   ..
	TXNN	T1,^-<.IPS-1>	;[1135]   ..
	JRST	PG.SU1		;[1135] NO--NO SWEAT
	MOVE	T1,TAB.AB(R)	;[1135] YES--THEN MAKE SURE AT LEAST 2 PAGES
	SUB	T1,TAB.LB(R)	;[1135]   IN THE WINDOW
	CAIGE	T1,.IPS		;[1135]   ..
	JRST	PG.SU2		;[1135] ONLY 1 PAGE--MUST EXPAND
PG.SU1:	CAMG	P2,TAB.HB(R)	;[1135] THE HIGH ADDR ALREADY OUT ON DISK?
	JRST	PG.SD		;[716] YES, DON'T BOTHER TO EXPAND
PG.SU2:	PUSHJ	P,FR.CNT##	;[1135] SEE HOW MUCH FREE SPACE WE HAVE
	ADD	T1,UW.S0(R)	;IF WE GIVE IT ALL TO THIS AREA
	CAMG	P2,T1		;WILL IT NOW FIT?
	JRST	PG.SX		;YES, JUST EXPAND

;SEE IF BY GIVING AWAY LESSER OF LN.WD OR HALF OF EXISTING AREA
;WE CAN FIT THIS REQUEST IN, IF SO
;DELETE LOWER PART (WRITE OUT FIRST)
;IF NOT, MOVE WINDOW UP AS FAR AS POSSIBLE VIA PG.SD, THEN EXPAND
;AS MUCH AS NEEDED VIA PG.SX

	MOVE	T2,UW.S0(R)	;TOP OF AREA
	SUB	T2,LW.S0(R)	;MINUS BOTTOM
	ADDI	T2,1		;GET EVEN
	LSH	T2,-1		;HALF
	ANDCMI	T2,.IPM		;KEEP IN BLOCKS
	CAILE	T2,LN.WD	;USE THE LESSER
	MOVEI	T2,LN.WD
	ADD	T1,T2		;ADD TO PREVIOUS ACCUMULATION
	CAMLE	P2,T1		;WIL IT NOW FIT?
	JRST	PG.SS		;[650] NO, CENTER MINIMAL WINDOW
	PUSH	P,T2		;SAVE THE EXCESS
	HRRZ	T1,LW.S0(R)	;CURRENT LOWEST
	ADDI	T1,-1(T2)	;HIGHEST TO GET RID OF
	HRL	T1,LW.S0(R)	;TRANS WORD
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R)
	POP	P,T1		;GET EXCESS BACK
	ADDM	T1,LW.S0(R)	;NEW LOWER BOUND
	ADD	T1,TAB.LB(R)	;ADD BASE IN CORE
	SUBI	T1,1		;HIGHEST LOC TO GIVE AWAY
	PUSHJ	P,GBCK.L##	;GIVE EXCESS AWAY
	JRST	PG.SU		;SHOULD NOW FIT (AFTER A SHUFFLE
;HERE IF WE CAN'T FIT THIS REQUEST INTO CURRENT WINDOW.
;MAKE SURE P3 POINTS INTO BOTTOM PAGE OF WINDOW VIA PG.SD, THEN
;EXPAND WINDOW TO ENCOMPASS P2 VIA PG.SX IF NECESSARY.

PG.SS:	MOVE	T1,P3		;[650] LOWEST LOCATION WANTED
	ANDCMI	T1,.IPM		;[650] WHAT LW WOULD BE AT BEST
	CAME	T1,LW.S0(R)	;[650] WINDOW AS HIGH AS POSSIBLE?
	PUSHJ	P,@[EXP PG.LSD,PG.HSD]-1(R)	;[667] NO, MOVE UP
	CAMLE	P2,UW.S0(R)	;[650] WINDOW BIG ENOUGH?
	JRST	PG.SX		;[650] NO, EXPAND VIA LNKCOR
	JRST	RPOPJ		;[650] YES, GOOD ENOUGH
;HERE TO EXPAND CORE BY AS MUCH AS WE NEED
;ALSO CHECK INCASE OVERFLOW FILE ALREADY CONTAINS  THE NEW AREA
;IF SO READ IT IN

PG.SX:	PUSH	P,P1		;SAVE ACCS USED BY LNKCOR
	PUSH	P,P2
	MOVEI	P1,(R)		;WHO WE WANT TO EXPAND
	SUB	P2,UW.S0(R)	;BY HOW MUCH
	PUSHJ	P,LNKCOR##	;GET IT
	  PUSHJ	P,E$$MEF##	;[1174] NOT POSSIBLE
	POP	P,P2		;RESTORE
	POP	P,P1
	MOVE	T1,TAB.AB(R)	;HIGHEST BLOCK IN CORE
	SUB	T1,TAB.LB(R)	;LENGTH OF INCORE AREA
	ADD	T1,LW.S0(R)	;LENGTH FROM ORIGIN
	EXCH	T1,UW.S0(R)	;IS NEW UPPER BOUND
	CAML	T1,HB.S0(R)	;[1116] HOWEVER IF EVEN BIGGER HAS BEEN SEEN?
	JRST	RPOPJ		;NO, RESTORE R AND RETURN
	HRLZI	T1,1(T1)	;[1116] IT MUST BE ON THE DSK
	HRR	T1,UW.S0(R)	;[1116] SO SETUP TRANSFER REQUEST
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R)	;[1116]
	PJRST	FIXUP		;[1116] AND DO ANY FIXUPS
;SIMILARLY FOR HIGH SEG

PG.HSG::CAMGE	P3,LW.S2	;SAME AS FOR LOW SEG
	PUSHJ	P,PG.HSD
	CAMLE	P2,UW.S2
	PUSHJ	P,PG.HSU
	SUB	P3,LW.S2	;REMOVE BASE
	POPJ	P,		;CONTINUE

;HERE TO CHANGE WINDOW TO HIGH SEG
;HERE TO MOVE WINDOW DOWN
;FIRST OUTPUT THE WINDOW, THEN READ BACK WHAT WE NEED
PG.HSD:	PUSH	P,R		;SAVE R
	MOVEI	R,HC.IX		;INDEX TO HIGH
	JRST	PG.SD		;MOVE DOWN


;HERE TO MOVE WINDOW UP IN CORE
;DUMP LOWER PART OF WINDOW, BLT DOWN AND READ IN TOP PART
;THIS PART IS MOST LIKELY ZERO
PG.HSU:	PUSH	P,R		;SAVE R
	MOVEI	R,HC.IX		;INDEX TO HIGH
	JRST	PG.SU		;MOVE UP
;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR LOW SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4


FIXUPL:	PUSH	P,R		;NEED TO SAVE IT
	MOVEI	R,LC.IX		;LOAD INDEX TO LOW
	JRST	FIXUP		;DO THE FIXUPS

;HERE TO SEE IF ANY FIXUPS CAN BE DONE FOR HIGH SEG JUST READ IN
;MUST NOT CHANGE P1-P4 & MUST SAVE R
;USES T1-T4

FIXUPH:	PUSH	P,R		;NEED TO SAVE IT
	MOVEI	R,HC.IX


FIXUP:	PUSHJ	P,CHKCHN	;SEE IF ANYTHING TO DO
RPOPJ:	POP	P,R		;RESTORE R
	POPJ	P,
;CHKCHN - SEE IF ANY FIXUPS EXIST FOR THE NEW CORE WINDOW
;IF SO LINK THEM INTO FXT.S0
;AND DO THEM
;R=2*N+1 FOR LOW, R=2*N+2 FOR HIGH
;DESTROYS R
;USES T1-T4

CHKCHN:	SKIPN	FX.S0(R)	;ANYTHING TO DO?
	POPJ	P,		;NO
	SETZM	FXT.S0		;CLEAR TEMP PTR
	HRRZ	T1,FX.S0(R)	;GET PTR TO LOWEST
	ADD	T1,FX.LB	;+OFFSET
	HRRZ	T2,1(T1)	;GET ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH.ADD	;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	HLRZ	T1,FX.S0(R)	;PTR TO HIGHEST
	ADD	T1,FX.LB	;+OFFSET
	HRRZ	T3,1(T1)	;ADDRESS
	SUB	T3,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T3,PH.ADD	;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	CAMG	T2,UW.S0(R)	;IS LOWEST ADDRESS TOO HIGH?
	CAMGE	T3,LW.S0(R)	;OR HIGHEST TOO LOW?
	POPJ	P,		;YES, JUST GIVE UP
				;MAKE QUICK TEST INCASE ALL CHAIN IN CORE
				;IN WHICH CASE WE NEED NOT CHASE THE CHAIN
	CAML	T2,LW.S0(R)	;IS LOWEST ADDRESS .GT. LOW WINDOW?
	CAMLE	T3,UW.S0(R)	;AND HIGHEST ADDRESS .LE. HIGH WINDOW
	JRST	.+5		;NO, DO THE SLOW WAY
	MOVE	T1,FX.S0(R)	;GET POINTER WORD
	MOVEM	T1,FXT.S0	;MOVE IT ALL OVER
	SETZM	FX.S0(R)	;REMOVE FROM LIST TO CONSIDER
	JRST	FXTLUP		;AND DO IT
	MOVEI	T1,FX.S0(R)	;GET INITIAL PTR
				;START AT BACK SINCE MOST USUAL CASE
				;IS TO READ FILE BACKWARDS
CHKCHL:	HLRZ	T1,(T1)		;GET NEXT
	JUMPE	T1,CPOPJ	;NOTHING TO DO
	ADD	T1,FX.LB	;OFFSET
	HRRZ	T2,1(T1)	;GET ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH.ADD	;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	CAMG	T2,UW.S0(R)	;[741] INCORE?
	CAMGE	T2,LW.S0(R)	;[741] CHECK AGAINST WINDOW RANGE
	JRST	CHKCHL		;NO, LOOP
	HRRZ	T3,(T1)		;GET FORWARD LINK
	JUMPE	T3,[MOVEI T3,FX.S0(R)	;IF ZERO THIS IS TOP OF CHAIN
		JRST	CHKCHM]	;SO WE CAN FIXUP
	HRL	T3,T3		;STORE UNRELOCATED IN LEFT HALF
	ADD	T3,FX.LB	;RELOCATED IN RIGHT
	HLLZS	(T1)		;CLEAR FORWARD PTR OF REMOVED PART
CHKCHM:	SUB	T1,FX.LB	;-OFFSET
	MOVSM	T1,FXT.S0	;TEMP PTR TO HIGHEST TO DO
	ADD	T1,FX.LB	;+OFFSET
CHKCHH:	HLRZ	T1,(T1)		;GET NEXT
	JUMPE	T1,[MOVEI T1,FX.S0(R)	;GET FIRST IF
		JRST	CHKFIN]	;REACHED END OF CHAIN
	ADD	T1,FX.LB	;+OFFSET
	HRRZ	T2,1(T1)	;ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH.ADD	;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	CAML	T2,LW.S0(R)	;STILL IN COREE?
	JRST	CHKCHH		;YES
	MOVE	T2,T1		;GET ABS ADDRESS
	SUB	T2,FX.LB	;REMOVE OFFSET
	HRL	T1,T2		;STORE LINK IN LEFT HALF FOR LATER
CHKFIN:	HRRZ	T2,(T1)		;GET 1ST FIXUP WE CAN DO
	HRRM	T2,FXT.S0	;STORE IN PTR
	ADD	T2,FX.LB	;RELOCATE IN FIXUP BLOCK
	HRRZS	(T2)		;AND CLEAR BACK LINK
				;NOW CLOSE PTRS OVER HOLE
	HLRM	T3,(T1)		;LINK TOP TO BOTTOM
	HLLM	T1,(T3)		;AND BOTTOM TO TOP
;NOW TO EXECUTE THE FIXUPS
;STORE R IN LEFT OF FXT.S0 (NOT USED FOR CHAIN PROCESSING)
FXTLUP:	PUSH	P,W3		;KEEP W3 INTACT
FXTLP1:	SOS	FXC.S0(R)	;COUNT 1 LESS
	HRRZ	T1,FXT.S0	;GET NEXT PTR
	JUMPE	T1,[POP	P,W3	;RESTORE W3
		POPJ	P,]	;ALL DONE FOR THIS LIST
	.JDDT	LNKLOD,FXTLP1,<<CAMN T1,$FIXUP##>>	;[632]
	ADD	T1,FX.LB	;+OFFSET
	PUSH	P,1(T1)		;GET ADDRESS (EXPECTED IN T2)
	MOVE	W3,2(T1)	;VALUE
	HRRZ	T2,(T1)		;NEXT PTR
	HRRM	T2,FXT.S0	;STORED
	MOVEI	T2,3		;SIZE OF BLOCK
	PUSHJ	P,FX.RET##	;RESTORE NOW (INCASE REQUIRED AGAIN)
	POP	P,T2		;ADDRESS IN T2
	HLRZ	T1,T2		;GET INDEX
	HRRZ	T2,T2		;OUT OF T2
	HRLM	R,FXT.S0	;SAVE R SINCE IT WILL POINT TO DATA BLOCK ON RETURN
	PUSHJ	P,@CHNTAB(T1)	;GO TO RIGHT ROUTINE
	HLRZ	R,FXT.S0	;RESTORE R
	JRST	FXTLP1		;AND CONTINUE

DEFINE X (A)<
	EXP	PFF.'A
>

CHNTAB:	CFIXUPS
;ROUTINE TO FIND HIGHEST LOCATION TO FIXUP IN EITHER LOW OR HIGH SEG
;CALLED BY
;	PUSHJ	P,FHA.L/FHA.H
;RETURNS
;T1 = HIGHEST LOC, 0 IF NONE TO DO
;USES T1,T2

FHA.L:	TDZA	T2,T2		;INDEX BY 0 FOR LOW
FHA.H:	MOVEI	T2,1		;1 FOR HIGH
	HLRZ	T1,FX.S1(T2)	;GET PTR TO HIGHEST LOC THIS CHAIN
	JUMPE	T1,CPOPJ	;NOTHING THERE
	ADD	T1,FX.LB	;+OFFSET
	HRRZ	T1,1(T1)	;GET VALUE THERE
IFN FTOVERLAY,<
	JUMPN	T2,CPOPJ	;LOW SEGMENT?
	SUB	T1,PH.ADD	;YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	POPJ	P,		;RETURN
;ROUTINE TO READ OVERFLOW FILES BACKWARDS AND DO ALL POSSIBLE CODE FIXUPS

COR.FX::SKIPN	FX.S1		;SEE IF ANY LOW SEG FIXUPS
	SKIPE	FX.S2		;OR HIGH
	CAIA			;YES
	POPJ	P,
	PUSH	P,R		;SAVE R
E$$FCF::.ERR.	(MS,0,V%L,L%I,S%I,FCF,<Final code fixups>) ;[1174]
CORFXL:				;HERE FOR LOW SEGMENT
	PUSHJ	P,FHA.L		;FIND ADDRESS
	JUMPE	T1,CORFXH	;TRY HIGH
	IORI	T1,.IPM		;ROUNDED UP TO BLOCK BOUND
	MOVEI	R,LC.IX		;SET INDEX
	PUSHJ	P,RDBACK	;READ IN REQUIRED CORE IMAGE
				;AND DO ALL FIXUPS WE CAN
	JRST	CORFXL		;TRY AGAIN

CORFXH:				;HERE FOR HIGH
	PUSHJ	P,FHA.H		;SEE IF ANY HIGH
	JUMPE	T1,CORFXT	;TEST TO SEE IF ANY MORE LOW
	SUB	T1,LL.S2	;REMOVE ORIGIN
	IORI	T1,.IPM
	MOVEI	R,HC.IX		;SET INDEX FOR HIGH
	PUSHJ	P,RDBACK	;READ IN AND FIXUP
	JRST	CORFXH		;LOOP

CORFXT:	PUSHJ	P,FHA.L		;ANY LOW
	JUMPN	T1,CORFXL	;YES, RECYCLE
	POP	P,R		;RESTORE R
	POPJ	P,		;RETURN
;HERE TO DO ACTUAL READ BACK
;ENTER WITH 
;R = 1 FOR LOW
;R = 2 FOR HIGH

RDBACK:	EXCH	T1,UW.S0(R)	;SWAP WITH CURRENT TO SET NEXT UPPER
	HRL	T1,LW.S0(R)	;WRITE OUT CURRENT IMMAGE
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R)
	MOVE	T1,UW.S0(R)	;NOW FIND BOTTOM
	ADD	T1,TAB.LB(R)
	SUB	T1,TAB.AB(R)	;FOR NEW LW.S0(R)
	MOVEM	T1,LW.S0(R)	;SET BASE
	JUMPGE	T1,RDBCK1	;OK IF NOT TOO MUCH
	ADDM	T1,TAB.AB(R)	;TOO MUCH, CUT BACK TOP
	SETZM	LW.S0(R)	;WINDOW NOW ALL IN CORE
	MOVE	T1,TAB.LB(R)	;TOP WE WILL FILL
	HRLI	T1,1(T1)	;FORM BLT PTR
	HRRI	T1,2(T1)
	SETZM	-1(T1)		;AND CLEAR UP TO .UB
	BLT	T1,@TAB.UB(R)	;SO WE DON'T LEAVE JUNK BEHIND
RDBCK1:	HRLZ	T1,LW.S0(R)	;NOW FOR READIN
	HRR	T1,UW.S0(R)
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R)
	PJRST	@[EXP FIXUPL,FIXUPH]-1(R)	;AND DO FIXUPS
;HERE TO DO PAGE FAULT FIXUPS

;ADDITIVE FIXUPS
PFF.AR:	JUMPE	T2,CPOPJ	;DONE IF ZERO
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	HRRZ	T1,(T2)		;GET RIGHT HALF VALUE
	ADD	T1,W3		;PLUS DEFINED SYMBOL
	HRRM	T1,(T2)		;STORE NEW VALUE
	POPJ	P,

PFF.AL:	JUMPE	T2,CPOPJ	;DONE IF ZERO
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	HLRZ	T1,(T2)		;GET LEFT HALF VALUE
	ADD	T1,W3		;PLUS DEFINED SYMBOL
	HRLM	T1,(T2)		;STORE NEW VALUE
	POPJ	P,

PFF.AF:	JUMPE	T2,CPOPJ	;DONE IF ZERO
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	ADDM	T1,W3		;PLUS DEFINED SYMBOL
	POPJ	P,
;CHAINED FIXUPS
IFN FTOVERLAY,<
PFF.CR:	SKIPE	T1,RT.PT	;IS RT AREA SET UP?
	CAMN	T1,RT.LB	;MAYBE, IS IT?
	PJRST	SY.CHR		;NO, NO RELOC BITS TO SET
	PUSH	P,P3		;SAVE P3 OVER RT.P3
	MOVE	P3,T2		;ADDRESS OF CURRENT FIXUP
	PUSHJ	P,RT.P3##	;SETUP BYTE POINTER
	ILDB	T1,RT.PT	;PICK UP RELOCATION BITS
	TRNE	T1,1		;RH RELOCATABLE?
	TXO	R,1B1		;YES, TELL RT.T2R
	MOVE	T2,P3		;RESTORE CHAIN ADDRESS
	POP	P,P3		;AND PRESERVED AC
	PJRST	SY.CHR		;GO CHASE CHAIN


PFF.CL:	SKIPE	T1,RT.PT	;ANY RELOC BITS TO WORRY ABOUT?
	CAMN	T1,RT.LB	;MAYBE, ARE THERE?
	PJRST	SY.CHL		;NO, GO FOLLOW CHAINS
	PUSH	P,P3		;SAVE P3 OVER RT.P3
	MOVE	P3,T2		;ADDRESS OF CURRENT FIXUP
	PUSHJ	P,RT.P3##	;SETUP BYTE POINTER
	ILDB	T1,RT.PT	;PICK UP RELOCATION BITS
	TRNE	T1,2		;LH RELOCATABLE?
	TXO	R,1B0		;YES, TELL RT.T2L
	MOVE	T2,P3		;RESTORE CHAIN ADDRESS
	POP	P,P3		;AND PRESERVED AC
	PJRST	SY.CHL		;GO CHASE CHAIN


PFF.CF:	SKIPE	T1,RT.PT	;RELOC BITS?
	CAMN	T1,RT.LB	;OR IS RT AREA EMPTY?
	PJRST	SY.CHF		;EMPTY, DON'T WORRY ABOUT IT
	PUSH	P,P3		;SAVE P3 OVER RT.P3
	MOVE	P3,T2		;ADDRESS OF CURRENT FIXUP
	PUSHJ	P,RT.P3##	;SETUP BYTE POINTER
	ILDB	T1,RT.PT	;PICK UP RELOCATION BITS
	LSH	T1,-^D34	;MOVE TO LEFT JUSTIFY
	IOR	R,T1		;SET WHERE RT.T2F CAN FIND IT
	MOVE	T2,P3		;RESTORE CHAIN ADDRESS
	POP	P,P3		;AND PRESERVED AC
	PJRST	SY.CHF		;GO CHASE CHAIN
> ;END IFN FTOVERLAY


IFE FTOVERLAY,<
PFF.CR==SY.CHR			;USE NORMAL CHAIN-CHASING ROUTINES
PFF.CL==SY.CHL
PFF.CF==SY.CHF
> ;END IFN FTOVERLAY

E$$ANM::.ERR.	(MS,,V%L,L%F,S%F,ANM,<Address not in memory>)
;REPLACEMENTS

;RIGHT HALF
PFF.RR:	JUMPE	T2,CPOPJ
	PUSHJ	P,SEGCHK
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	HRRM	W3,(T2)		;JUST REPLACE WHATS THERE
	POPJ	P,

;LEFT HALF
PFF.RL:	JUMPE	T2,CPOPJ
	PUSHJ	P,SEGCHK
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	HRLM	W3,(T2)
	POPJ	P,

PFF.RF:	JUMPE	T2,CPOPJ	;DONE IF ZERO
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	MOVEM	W3,(T2)		;REPLACE VALUE
	POPJ	P,
SUBTTL	LOCAL SYMBOL STORE


;ROUTINE TO ADD CONTENTS OF W1, W2, W3 TO LOCAL SYMBOLTABLE
;ALSO USED TO PUT GLOBALS AND OTHER STUFF THERE
;CHECKS FOR DSK OVERFLOW ETC


;THIS IS WHERE IT ALL GETS DONE

LSADDX:	PUSHJ	P,LS.XPN	;NEED TO EXPAND FIRST
LS.ADD::SKIPN	@GS.LB		;[1143] USER TYPE /NOINITIAL?
	PUSHJ	P,LS.CHK	;[1143] YES, SEE IF NEED A DUMMY MODULE NAME
LSADD:	MOVE	T1,LSYM		;[1143] GET SYMBOL TABLE POINTER
	HRRM	T1,LSTSYM	;STORE REL POINTER TO NEXT SYMBOL
	TXNN	W1,PS.GLB	;IF NOT GLOBAL
	HRRZS	LSTSYM		;CLEAR SPURIOUS GLOBAL POINTER
	MOVEI	T2,.L		;ALWAYS SINGLE TRIPLET
	MOVE	T1,LS.FR	;NUMBER OF WORDS FREE
	SUBI	T1,(T2)		;WE NEED SOME MORE FOR THIS ENTRY
	JUMPL	T1,LSADDX	;NOT ENOUGH
	MOVEM	T1,LS.FR	;STORE NEW COUNT
	MOVE	T1,T2		;SAME NUMBER OF WORDS
	ADDM	T2,LSYM		;COUNT EXTRA WORDS
	ADDB	T1,LS.PT	;NEW ACTUAL BOUND
	TMOVEM	W1,-3(T1)	;FLAGS, NAME, VALUE
	POPJ	P,

;HERE IF WE HAVE TO EXPAND

LS.XPN:	PUSHJ	P,.SAVE2##	;SAVE PRESERVED ACCS
	PUSH	P,T2		;SAVE WORD COUNT
	MOVEI	P1,LS.IX	;LOCAL SYMBOL AREA
	MOVE	P2,T2		;NUMBER OF WORDS REQUIRED
	SUB	P2,LS.FR	;LESS WHAT WE HAVE
	PUSHJ	P,LNKCOR	;GENERAL CORE EXPANDER
	  PUSHJ	P,E$$MEF##	;[1174] CANNOT EXPAND ANY MORE
	POP	P,T2
	POPJ	P,
;HERE TO ADD EXTENDED SYMBOL TRIPLETS (COMMON FOR INSTANCE)
;ENTER WITH P1 CONTAINING A RELATIVE POINTER INTO THE GS AREA
;RETURNS WITH P1 FIXED IN CORE

LSADE1:	PUSHJ	P,LS.XPN	;NO ENOUGH SPACE
LS.ADE::SKIPN	@GS.LB		;[1143] USER TYPE /NOINITIAL?
	PUSHJ	P,LS.CHK	;[1143] YES, SEE IF NEED TO FAKE A MODULE NAME
	MOVE	T1,LSYM		;SYMBOL TABLE PTR.
	HRRM	T1,LSTSYM	;REL PTR. TO NEXT SYMBOL
	TXNN	W1,PS.GLB	;IF NOT GLOBAL
	HRRZS	LSTSYM		;CLEAR PTR.
	MOVE	T1,LS.FR	;NUMBER OF WORDS FREE
	SUBI	T1,(T2)		;WHAT WE NEED FOR THIS ENTRY
	JUMPL	T1,LSADE1	;NO ENOUGH
	MOVEM	T1,LS.FR	;STORE NEW COUNT
	ADDM	T2,LSYM		;COUNT EXTRA WORDS
	MOVE	T1,LS.PT	;FIRST FREE LOCATION
	ADDB	T2,LS.PT	;TOP OF SYMBOL
	ADD	P1,GS.LB	;[654] FIX ADDRESS IN CORE
	HRL	T1,P1		;SOURCE
	BLT	T1,-1(T2)	;MOVE
	POPJ	P,


;HERE IF USER TYPED /NOINITIAL.  IF USER TYPES /SET, /COMMON, ETC. BEFORE
;LOADING ANYTHING, THEN WE NEED TO INSERT A MODULE NAME SO SYMBOLS WILL
;NOT OCCUR OUTSIDE OF A MODULE.  USE THE SYMBOL NAME FOR THE MODULE NAME.

LS.CHK:	MOVE	T1,LSYM		;[1143] GET SIZE OF LS AREA SO FAR
	CAIN	T1,1		;[1143] EMPTY?
	TXNN	W1,PT.SYM	;[1143] YES, BUT IS THIS A SYMBOL?
	POPJ	P,		;[1143] NO, NOT THE SPECIAL CASE
	MOVEM	T1,NAMPTR	;[1143] CREATING A NEW MODULE
	AOS	PRGNO		;[1143] REMEMBER ONE MORE
	SPUSH	<W1,W3,T2>	;[1143] SAVE CALLER'S ARGS
	MOVX	W1,PT.SGN!PT.TTL	;[1143] THIS IS A TITLE
	SETZ	W3,		;[1143] NO PREVIOUS PTR
	PUSHJ	P,LSADD		;[1143] INSERT IN LS AREA
	SPOP	<T2,W3,W1>	;[1143] RESTORE ACS
	SETZM	LSTSYM		;[1143] SINCE NOT REALLY A SYMBOL
	POPJ	P,		;[1143] RETURN TO LS.ADD OR LS.ADE
SUBTTL	GLOBAL SYMBOL STORE


;HERE WHEN SYMBOL MUST BE PUT IN TABLE
;POINTERS IN P1 _ P4
;SYMBOL STILL IN W1, W2, W3

SY.GS0::PUSHJ	P,INSRT		;PUT CURRENT SYMBOL IN GLOBAL TABLE
	MOVEI	T2,.L		;ONLY 3 WORDS LONG
IFN FTOVERLAY,<
	TXNN	W1,PS.BGS	;A BOUND SYMBOL?
>
	SKIPE	NOSYMS		;NOT IN LOCAL IF NOT WANTED
	POPJ	P,
	PJRST	LS.ADD		;PUT IN LOCAL SYMBOL FILE

INSRT::	SKIPE	@HT.PTR		;IS THERE A ZERO IN TABLE
	JRST	E$$SIF		;[1174] NO, ERROR, SHOULD NEVER HAPPEN

INSRT0:	AOS	GSYM		;COUNT SYMBOL
	SOS	HSPACE		;AND DECREMENT SPACE IN HASH TABLE
	.JDDT	LNKLOD,INSRT0,<<CAMN W2,$SYMBOL>>	;ARE WE LOOKING FOR THIS SYMBOL?
	TXNE	W1,PT.EXT	;LONG SYMBOL?
	JRST	INSRTL		;YES, JUST MOVE POINTERS
	MOVEI	T2,.L		;NUMBER OF WORDS REQUIRED
	PUSHJ	P,GS.GET##	;GO GET THEM
	TMOVEM	W1,0(T1)	;STORE TRIPLET SYMBOL
INSRT1:	SUB	T1,NAMLOC	;GET OFFSET TO NAMTAB
	HRL	T1,P3		;HASH TOTAL IN LEFT HALF
	MOVEM	T1,@HT.PTR	;HASH TOTAL,,REL ADDRESS OF SYMBOL
	TXNE	W1,PS.GLB	;DEFINING A GLOBAL?
	HRLZM	T1,LSTSYM	;YES, STORE POINTER TO IT
	POPJ	P,		;RETURN


;HERE IF SYMBOL IS EXTENDED
;SYMBOL IS ALREADY IN CORE POINTER NEED ADJUSTING AND W3 RESET

INSRTL:	MOVE	T1,W3		;W3 POINTS TO INCORE BLOCK
	ADD	T1,NAMLOC	;RELATIVE TO GS.LB
	MOVE	W3,2(T1)	;RESTORE W3 (VALUE)
	JRST	INSRT1		;PUT IN HASH TABLE

E$$SIF::.ERR.	(MS,0,V%L,L%F,S%F,SIF,<Symbol insert failure, non-zero hole found>) ;[1174]
SUBTTL	SATISFY GLOBAL REQUESTS


;HERE TO SATISFY GLOBAL REQUESTS WITH DEFINED VALUE
;FLAGS IN W1
;VALUE IN W3
;ALL CHAINED REQUESTS ARE RIGHT-HALF FIXUPS
;P1-P4 ARE NOT SAVED BY THIS ROUTINE

SY.RF::	SOSGE	USYM		;DECREMENT UNDEFINED GLOBAL COUNT
	PUSHJ	P,E$$DUZ	;[1174] BUT NOT TOO FAR
	TRNE	FL,R.FHS	;ARE RC TABLES SCREWED UP?
	  JRST	SY.FHS		;YES, RESTORE THEM FOR FIXUPS
	TRNE	FL,R.FLS	;BUT MUST SAVE THEM IF RESTORED
	  JRST	SY.FLS		;SINCE OTHERS DEPEND ON THEM
;BOTH SY.FHS & SY.FLS RETURN HERE WITH A PUSHJ
SY.FXX:	IORM	W1,0(P1)	;SEE WHAT WE HAVE IN FLAGS
	MOVX	W1,PS.UDF!PS.REQ	;DON'T NEED THESE NOW
	ANDCAB	W1,0(P1)	;SO CLEAR FROM MEMORY
	MOVE	T2,2(P1)	;PICKUP ADDRESS
	MOVEM	W3,2(P1)	;STORE VALUE
	PUSHJ	P,SY.CHR	;CHAIN THROUGH RIGHT HALF
	MOVEI	T2,.L		;STORE SYMBOL BEFORE WE LOSE IT
	TXNE	W1,PS.COM	;IF COMMON NEED TWO TRIPLETS
	JRST	[ADDI	T2,.L
		SUB	P1,GS.LB	;[654] MAKE POINTER RELATIVE
		PUSHJ	P,LS.ADE	;STORE MULTIPLE WORD
		JRST	.+2]		;SKIP NEXT INST.
	PUSHJ	P,LS.ADD	;IN LOCAL TABLE
	TXNN	W1,PS.FXP	;ANY FIXUPS FOR THIS SYMBOL?
	POPJ	P,		;NO
	JRST	SY.RF1		;YES

E$$DUZ::.ERR.	(MS,,V%L,L%F,S%F,DUZ,<Decreasing undefined symbol count below zero>) ;[1174]

SY.FHS:	SKIPA	T1,[1]		;LOW SEG HAS BEEN FAKED
SY.FLS:	MOVEI	T1,2		;HI SEG FAKED IF /SEG:LOW
	HRR	R,T1		;SETUP R FOR SG.TB; PRESERVE LH
	MOVE	T1,@SG.TB	;GET REAL VALUE FOR RC TABLE
	EXCH	T1,@RC.TB	;RESTORE IT, GET FAKE VALUE
	PUSH	P,T1		;SAVE FAKE VALUE TO RESTORE LATER
	PUSH	P,R		;REMEMBER WHICH SEGMENT
	PUSH	P,LL.S2		;LL.S2 WAS ALSO FAKED BY T.3
	HRRZS	LL.S2		;IF WE ARE LOADING F10, THAT IS
	PUSHJ	P,SY.FXX	;RE-JOIN SY.RF TILL IT POPJS

;HERE WHEN SY.RF RETURNS. RESTORE FORCED LOADING MODE.
	POP	P,LL.S2		;RESTORE LL.S2
	POP	P,R		;REMEMBER WHICH COUNTER WE GRABBED
	POP	P,@RC.TB	;AND RESTORE IT
	POPJ	P,		;RETURN FROM SY.RF
SUBTTL	SATISFY ADDDITIVE GLOBALS


;HERE FOR ADDITIVE GLOBALS
;THE ADDDITIVE GLOBAL REQUESTS ARE STORED IN LINKED LISTS IN AREA FX
;THE INITIAL POINTER TO THEM IS IN AN EXTENDED TRIPLET IN AREA GS

SY.RF1:	HRRZ	P1,@HT.PTR	;SETUP P1 AGAIN
	ADD	P1,NAMLOC	;ABSOLUTE
SY.RF2:	HLLZ	T1,0(P1)	;GET FLAGS AGAIN
	TXNN	T1,PS.REL	;IF THIS SYMBOL IS RELOCATABLE
	TDZA	T1,T1		;NO
	ANDX	T1,PS.REL	;ALL THOSE DEPENDING ON IT ARE TOO
	MOVEM	T1,SYMFLG	;STORE INCASE SYMBOL TABLE FIXUPS
SYRF2A:	ADDI	P1,.L		;POINT TO  EXTENDED SYMBOL
	MOVE	T1,0(P1)	;GET FLAGS
	JUMPL	T1,CPOPJ	;FINISHED IF PRIMARY SYMBOL
	TXNN	T1,S.FXP	;THIS TRIPLET A FIXUP REQUEST?
	JRST	SYRF2A		;NO, TRY NEXT
	MOVE	T1,P1		;REMEMBER WHERE WE ARE
	SUB	T1,NAMLOC
	PUSH	P,T1		;SO WE CAN DELETE FIXUP REQUEST WHEN DONE
	MOVE	P1,2(P1)	;GET POINTER TO FIXUP
SY.RF3:	.JDDT	LNKLOD,SY.RF3,<<CAMN P1,$FIXUP##>>	;[632]
	PUSH	P,P1		;SAVE ADD OF FIXUP BLOCK
	ADD	P1,FX.LB	;IN CORE
	MOVE	W1,(P1)		;GET FLAGS AND NEXT POINTER
	TXNE	W1,FP.POL	;POLISH FIXUP (TYPE 11)?
	JRST	[PUSHJ	P,SY.PF0	;YES, SEE IF FIXUP CAN BE DONE
		POP	P,P1		;RESTORE POINTER
		ADD	P1,FX.LB	;FIX IN CORE
		JRST	SY.RF4]		;AND DELETE THIS REQUEST
	EXCH	W3,2(P1)	;SWAP VALUE WITH REQUEST
	PUSHJ	P,SY.ADG	;DO THIS FIXUP
	POP	P,P1		;RESTORE P1
	ADD	P1,FX.LB	;INCASE CORE MOVED
	MOVE	W3,2(P1)	;RESTORE W3
SY.RF4:	MOVE	T1,P1		;FINISHED WITH IT NOW
	MOVEI	T2,.L
	PUSHJ	P,FX.RET##	;RETURN SPACE
	HRRZ	P1,W1		;GET NEXT REL POINTER
	JUMPE	P1,SY.RF5	;ZERO MARKS END OF CHAIN
	TXNE	W1,FP.SYM
	JRST	SY.RF3		;DO THIS ONE
E$$ISP::.ERR.	(MS,,V%L,L%F,S%F,ISP,<Incorrect symbol pointer>) ;[1174]
SY.RF5:	POP	P,P1
	ADD	P1,NAMLOC	;INCASE MOVED
	MOVX	W1,PS.FXP	;FLAG TO CLEAR
	MOVX	T1,S.LST	;INCASE STILL EXTENDED
	SKIPG	-.L(P1)		;ARE WE POINTING AT PRIMARY?
	TXOA	W1,PT.EXT	;YES, DELETE EXTENDED FLAG ALSO
	IORM	T1,-.L(P1)	;NO, MARK SECONDARY AS LAST
	MOVEI	T1,(P1)
	MOVEI	T2,.L
	PUSHJ	P,GS.RET##	;GIVE BACK TRIPLET
	SKIPL	(P1)		;POINTING TO PRIMARY?
	JRST	[SUBI	P1,.L	;NO, BACKUP
		JRST	.-1]	;TRY AGAIN
	ANDCAM	W1,0(P1)	;CLEAR FLAGS IN PRIMARY
	POPJ	P,
;HERE FOR ADDITIVE GLOBAL REQUEST WITH VALUE ALREADY DEFINED

SY.ADG:	TXNN	W1,FS.FXS	;SYMBOL TABLE FIXUP?
	JRST	SY.AD0		;NO
	OR	W1,SYMFLG	;STORE EXTRA FLAGS (PS.REL)
	JRST	SY.STF		;YES

;HERE TO FILL IN SINGLE ADDITIVE GLOBAL REQUEST

SY.AD0::
	TXNE	W1,FS.FXC	;RH CHAINED FIXUP?
	JRST	SY.ADC		;YES, HANDLE SEPERATELY
IFN FTOVERLAY,<
	MOVE	T1,0(P1)	;GET INCORE FLAGS
	TXNE	T1,PS.RBG	;FROM A RELOCATABLE LINK?
	PUSHJ	P,RT.FX##	;YES, STORE FIXUP FOR RELOCATION
>;END OF IFN FTOVERLAY
	HRRZ	T2,W3		;GET REL ADDRESS OF FIXUP
	PUSHJ	P,SEGCHK	;GET CORE LOCATION
	  JRST	SY.ADP		;OUT ON DSK (PAGED)
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP?
	JRST	SY.ADL		;YES
	TXNE	W1,FS.FXF	;OR FULL WORD?
	JRST	SY.ADF		;YES
SY.ADR:
IFN FTOVERLAY,<
	TXNE	W1,FS.REL	;RELOCATABLE?
	TXO	R,1B1		;YES, RESET BIT IN R
	PUSHJ	P,SY.ADT	;RELOCATABLE OVERLAY?
	JFCL	RT.T2R##	;YES, SET RELOC BIT  CORRECTLY
>
	HRRZ	T1,(T2)		;GET RIGHT HALF VALUE
	ADD	T1,2(P1)	;PLUS DEFINED SYMBOL
	HRRM	T1,(T2)		;STORE NEW VALUE
	POPJ	P,
SY.ADL:
IFN FTOVERLAY,<
	TXNE	W1,FS.REL	;RELOCATABLE?
	TXO	R,1B0		;YES, RESET BIT IN R
	PUSHJ	P,SY.ADT	;RELOCATABLE OVERLAY?
	JFCL	RT.T2L##	;YES, SET RELOC BIT  CORRECTLY
>
	HLRZ	T1,(T2)		;GET LEFT HALF VALUE
	ADD	T1,2(P1)	;PLUS DEFINED SYMBOL
	HRLM	T1,(T2)		;STORE NEW VALUE
	POPJ	P,

SY.ADF:
IFN FTOVERLAY,<
	TXNE	W1,FS.REL	;RELOCATABLE?
	TXO	R,3B1		;YES, RESET BITS IN R
	PUSHJ	P,SY.ADT	;RELOCATABLE OVERLAY?
	JFCL	RT.T2F##	;YES, SET RELOC BIT  CORRECTLY
>
	MOVE	T1,(T2)		;GET FULL WORD VALUE
	ADD	T1,2(P1)	;PLUS DEFINED SYMBOL
	MOVEM	T1,(T2)		;STORE NEW VALUE
	POPJ	P,

SY.ADC:	MOVE	T2,W3		;RETRIEVE ADDRESS OF CHAIN
	MOVE	W3,2(P1)	;GET VALUE TO STORE FOR SY.CHR
	PJRST	SY.CHR		;GO CHASE CHAIN
				;SY.CHR WILL DO RIGHT THING FOR
				;RELOCATABLE OVERLAYS
;HERE WHEN REQUIRED ADDRESS IS NOT IN CORE
;STORE AS A FIXUP REQUEST FOR ADDITIVES, EITHER RH ,LH, OR FULL
;ENTER WITH R = 1 (LOW), OR R = 2 (HIGH)
;W1 = FIXUP FLAGS
;W3 = ADDITIVE REQUEST
;2(P1) = SYMBOL VALUE

;PUT T2 =W3 AND W3 = 2(P1)

SY.ADP:	MOVE	T2,W3		;EXPECTS ADDRESS IN T2
	MOVE	W3,2(P1)	;TRUE VALUE IN W3
	TXNE	W1,FS.FXR	;RIGHT HALF FIXUP?
	HRLI	T2,CPF.AR	;YES
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP
	HRLI	T2,CPF.AL	;YES
	TXNE	W1,FS.FXF	;FULL WORD?
	HRLI	T2,CPF.AF	;YES
	TXNE	W1,FS.FXC	;RIGHT HALF CHAINED?
	HRLI	T2,CPF.CR	;YES
	PJRST	SY.CHP		;LINK IN

IFN FTOVERLAY,<
SY.ADT:	SKIPN	RT.LB		;IS IT RELOCATABLE
	POPJ	P,		;NO
	PUSH	P,P1		;SAVE SYMBOL TABLE PTR
	MOVSI	P1,(Z @)	;TURN ON @ IN STACK
	IORM	P1,-1(P)	;THERE MUST BE AN EASIER WAY?
	SETZ	P1,		;SIGNAL NOT A SYMBOL FIXUP
	HRRZ	T2,W3		;RESET ADDRESS
	PUSHJ	P,@-1(P)	;GO TO CORRECT ROUTINE
	POP	P,P1		;RESTORE
	HRRZ	T2,W3		;RESET ADDRESS
	PUSHJ	P,SEGCHK	;GET CORE LOCATION
	  HALT	.		;CAN NOT HAPPEN
	POPJ	P,		;AND RETURN
>
;HERE FOR SYMBOL TABLE FIXUP
;CALLED BY
;	MOVE	W1,FLAGS
;	MOVE	W3,SYMBOL TABLE POINTER (LSTSYM TYPE)
;				GLOBAL,,LOCAL
;	MOVE	P1,POINTER TO DEFINING TRIPLET (GS OR FX)
;	PUSHJ	P,SY.STF
;USES T1 - T4

SY.STF::SPUSH	<W3,W2,W1,P1>	;SAVE ALL VALUES NEEDED LATER
SYSTF1:	HLRZ	T1,W3		;GET GLOBAL ADDRESS
	JUMPE	T1,SYSTFL	;NO GLOBAL FIXUP REQUIRED
	TXNE	W1,FS.MDC	;[1213] ONLY WANT TO COMPARE VALUES?
	JRST	[MOVE T1,P1	;[1213] YES, USE DEFINING TRIPLET AS VALUE
		JRST	SYSTFC]	;[1213] SKIP SEARCH FOR S.PVS TRIPLET
	ADD	T1,NAMLOC	;RELOCATE
	MOVE	T3,0(T1)	;GET FLAGS
	TXNN	T3,PT.OTH	;NOT SYMBOL?
	JRST	SYSTF3		;YES IT IS
	TXNN	T3,PO.IND	;INDIRECT POINTER PERHAPS?
	PUSHJ	P,E$$ISP	;[1174] NO???
	HRL	W3,2(T1)	;RESET REAL POINTER
	MOVEM	W3,-3(P)	;KEEP STACK UP TO DATE
	MOVEI	T2,.L		;AND GET RID OF THIS DUMMY BLOCK
	PUSHJ	P,GS.RET##
	JRST	SYSTF1		;TRY AGAIN

SYSTF2:	TXNE	T3,S.LST	;MORE TO COME?
	PUSHJ	P,E$$ISP	;[1174] NO, NO PVS TRIPLET???

SYSTF3:	ADDI	T1,.L		;LOOK AT NEXT TRIPLET
	SKIPG	T3,0(T1)	;PICK UP FLAGS
	PUSHJ	P,E$$ISP	;[1174] MUSN'T BE PRIMARY
	TXNN	T3,S.PVS	;FOUND THE PVS TRIPLET?
	JRST	SYSTF2		;NO, KEEP LOOKING

;FALL THROUGH TO NEXT PAGE
;HERE WITH ABSOLUTE POINTER TO PVS TRIPLET IN T1. DEFINE GLOBAL SYMBOL.

	MOVE	T2,W1		;GET FIXUP FLAGS FOR SY.AST
	MOVE	W3,2(P1)	;[572] AND FIXUP VALUE
	PUSHJ	P,SY.AST	;SET 2(T1) TO REAL VALUE
SYSTFC:	MOVX	T3,PS.UDR	;[1213] ASSUME RH FIXUP
	TXNE	W1,FS.FXL	;LEFT HALF?
	TXC	T3,PS.UDF	;YES, MAKE DEFINITION LH TOO
	TXNE	W1,FS.FXF	;UNLESS FULL WORD
	TXO	T3,PS.UDF	;IN WHICH CASE WE'RE DEFINING ALL
	HLRZ	T2,-3(P)	;RESTORE PRIMARY TRIPLET ADDR
	ADD	T2,NAMLOC	;MAKE ABSOLUTE
	MOVE	T4,T3		;[612] COPY OF BITS BEING DEFINED
	AND	T4,0(T2)	;[612] WHICH OF THOSE ARE NOW UNDEFINED
	CAME	T3,T4		;[612] ANYTHING WE'RE DEFINING KNOWN?
	JRST	SYSTFM		;YES, MULTIPLE DEFINITION
	PUSHJ	P,SYSTFF	;SET FLAGS AT 0(T2) PROPERLY
	TXNE	T3,PS.UDF	;STILL UNDEFINED ANYWHERE?
	JRST	SYSTFL		;YES, GIVE UP FOR NOW
	SOSGE	USYM		;NO, DECREMENT USYM
	PUSHJ	P,E$$DUZ	;[1174] BUT NOT TOO FAR
	MOVE	W3,2(T1)	;GET NOW-DEFINED VALUE
	MOVE	P1,T2		;POINT TO PRIMARY OF NEW SYMBOL
	TXNN	W1,FS.MDC	;[1213] DON'T ZAP S.PVS IF WE DIDN'T USE IT
	PUSHJ	P,SY.ZST	;AND ZAP 2NDARY 3RPLET
	MOVE	W1,0(P1)	;GET FLAGS FOR SY.FXP
	PUSHJ	P,SY.FXP	;GO DO ALL DEFINITIONS
	JRST	SYSTFL		;AND CORRECT LS AREA TRIPLET

;HERE IF WE FOUND A MULTIPLE DEFINITION, WITH T1 POINTING TO PRIMARY,
;AND T2 POINTING TO S.PVS TRIPLET. WARN USER AND DISCARD NEW VALUE.

SYSTFM:	MOVE	P1,T2		;STORE P.T. ADDR IN P1 FOR SY.MDF
	MOVE	T4,0(T2)	;GET STILL UNDEF BITS IF ANY
	MOVE	T2,2(T1)	;NEW SYMBOL VALUE
	TXNE	T3,PS.UDR	;NOT DEFINING RH?
	TXNE	T4,PS.UDR	;RH STILL UNKNOWN?
	HRR	T2,2(P1)	;YES, CAN'T BE MULTIPLE DEFINITION
	TXNE	T3,PS.UDL	;SAME CASE FOR LH
	TXNE	T4,PS.UDL	;ONLY GIVE MDS IF CONFLICT
	HLL	T2,2(P1)	;NOW HAVE ADJUSTED NEW VAL IN T2
	CAMN	T2,2(P1)	;MULTIPLE DEFINITION?
	JRST	SYSTFL		;NO (WHAT LUCK!) GO FIX LS AREA
	DMOVE	W1,0(P1)	;YES, SET NEW TRIPLET FROM OLD
	MOVE	W3,2(T1)	;BUT WITH DIFFERENT VALUE
	PUSHJ	P,SY.MDF	;WARN USER OF BUG
	SKIPA	T4,[PS.MDF]	;FLAG TO SET IN LOCAL TABLE

;SKIP THROUGH TO FIXUP LOCAL TABLE
;HERE TO FIX THINGS UP IN THE LOCAL SYMBOL TABLE

SYSTFL:	MOVEI	T4,0		;NORMAL ENTRY, NOT MDS
	PUSH	P,T4		;REMEMBER FOR AFTER SYSTF4 RETURNS
	MOVE	P1,-1(P)	;RESTORE EVERYTHING
	MOVE	W1,-2(P)	;. .
	MOVE	W2,-3(P)	;. .
	MOVE	W3,-4(P)	;. .
	PUSHJ	P,SYSTF4	;GO FIXUP LOCAL TABLE
	SPOP	<T4,P1,W1,W2,W3> ;RESTORE THINGS FOR POSTERITY
	HRRZ	T2,W3		;[572] GET RELATIVE LS ADDRESS
	JUMPE	T2,CPOPJ	;[572] GIVE UP IF NONE
	CAML	T2,LW.LS	;[572] IS IT STILL IN CORE?
	IORM	T4,0(T1)	;YES, SET MULTIPLY DEFINED
	POPJ	P,		;DONE

SYSTF4:	HRRZ	T2,W3		;GET ADDRESS IN LOCAL TABLE
	JUMPE	T2,CPOPJ	;FORGET IT IF NOT IN LOCAL TABLE
	CAMGE	T2,LW.LS	;STILL IN CORE?
	JRST	SY.STP		;NO, GO GENERATE FIXUP
	ADD	T2,LS.LB	;YES, MAKE ABSOLUTE ADDRESS
	SUB	T2,LW.LS	;IN CASE PAGING
	MOVX	T3,PS.UDR	;ASSUME RH FIXUP
	TXNE	W1,FS.FXL	;LEFT HALF?
	TXC	T3,PS.UDF	;YES, MAKE DEFINITION LH TOO
	TXNE	W1,FS.FXF	;UNLESS FULL WORD
	TXO	T3,PS.UDF	;IN WHICH CASE WE'RE DEFINING ALL
	PUSHJ	P,SYSTFF	;SET FLAGS AT 0(T2) CORRECTLY
	MOVE	T1,T2		;T1 POINTS TO LS TRIPLET
	MOVE	T2,W1		;T2 CONTAINS FIXUP FLAGS
	MOVE	W3,2(P1)	;[572] W3 IS ADDITIVE DEFINITION
	PJRST	SY.AST		;GO FIXUP LS TRIPLET

;HERE TO SET THE FLAGS AT 0(T2) FROM T3 & W1
SYSTFF:	ANDCAB	T3,0(T2)	;ZAP BITS NOW DEFINED
	MOVX	T4,PS.REQ	;HOPE WE CAN CLEAR THIS NOW
	TXNN	T3,PS.UDF	;ONLY IF COMPLETELY DEFINED
	ANDCAM	T4,0(T2)	;GOT IT!
	MOVX	T4,PS.REL	;MUST ALSO SET RELOC IF OTHER WAS
	TXNE	W1,FS.REL	;WAS IT?
	IORM	T4,0(T2)	;YES, SO NEW SYMBOL IS TOO
	POPJ	P,		;RETURN WITH T3 SET UP
;HERE FOR POLISH FIXUPS CAUSED BY A BLOCK TYPE 11
;CONTAINING ONE OR MORE UNDEFINED GLOBAL SYMBOLS
;REPLACE THE NOW DEFINED SYMBOL BY ITS VALUE
;IF MORE UNDEFS EXIST GIVE UP
;IF ALL SYMBOLS ARE DEFINED DO FIXUP

SY.PF0:	MOVE	T4,2(P1)	;GET REL ADDRESS OF POLISH BLOCK
	ADD	T4,FX.LB	;ADD BASE
	HRLI	T4,(POINT 18)	;FORM BYTE POINTER
	ADDI	T4,2		;BYPASS HEADER AND GLOBAL COUNT
	SKIPA	T3,T4		;USE T3 AS CURRENT, T4 AS INITAL
SYPF1:	IBP	T3		;BYPASS NEXT HALF WORD
SYPF2:	ILDB	T1,T3		;READ HALF WORD
	CAIL	T1,MXPLOP##		;[712] CHECK FOR VALID OPS
	JRST	[CAIG	T1,-6		;[712] PSECT INDEX?
		JRST	SYPF2		;[712] YES, SKIP IT
		POPJ	P,]		;[712] NO, IGNORE, ALL GLOBALS NOT YET DEFINED.
	CAIL	T1,3		;IF OPERATOR
	JRST	SYPF2		;IGNORE IT
	JUMPE	T1,SYPF1	;IGNORE NEXT HALF WORD
	CAIN	T1,1		;36 BIT VALUE?
	AOJA	T3,SYPF2	;YES, GET NEXT HALF WORD AFTER IT
;HERE IF T1=2, GLOBAL SYMBOL REQUEST
	ILDB	T1,T3		;GET FIRST PART OF SYMBOL
	HRLZ	T2,T1		;STORE LEFT HALF PART OF SYMBOL
	ILDB	T1,T3		;GET RIGHT HALF PART
	HRR	T2,T1		;FULL SYMBOL IN W2
	CAME	T2,W2		;IS THIS THE SYMBOL NOW DEFINED?
	JRST	SYPF2		;NO
	SUBI	T3,2		;BACKUP BYTE POINTER
	IBP	T3		;TO POINT TO 2
	MOVEI	T1,1		;CHANGE GLOBAL MARKER INTO 36 BIT VALUE MARKER
	IDPB	T1,T3
	MOVS	T1,W3		;GET VALUE
	IDPB	T1,T3		;STORE IT
	MOVSS	T1
	IDPB	T1,T3		;T3 BACK AS IT WAS
	SOSE	-1(T4)		;ALL UNDEFS NOT DEFINED?
	JRST	SYPF2		;NO, GET NEXT HALF WORD
;NOW TO EVALUATE POLISH FIXUP
;USE T.11EV (IN LNKOLD)
;THIS USES W1, W2, W3 FOR NON-SYMBOL USE
	SPUSH	<W1,W2,W3>	;SAVE SYMBOL ACCS
	SUB	T4,FX.LB	;UNRELOCATE
	MOVEM	T4,T11BP	;SETUP BYTE POINTER
	MOVE	T1,2(P1)	;ADDRESS OF POLISH BLOCK
	ADD	T1,FX.LB	;MAKE ABSOLUTE
	HRLZ	T1,0(T1)	;BLOCK LENGTH
	HRRI	T1,-2(T4)	;START ADDRESS OF BLOCK
	MOVEM	T1,T11FA
	PUSHJ	P,T.11EV##	;EVALUATE
	SPOP	<W3,W2,W1>	;RESTORE ACCS
	POPJ	P,
;HERE TO GENERATE LOCAL SYMBOL  FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS THE SAME AS ALL OTHER PAGED FIXUPS
;WORD 1		BACK PTR,,FORWARD PTR
;WORD 2		INDEX,,SYMPTR
;WORD 3		VALUE
;
;CALLED BY
;	MOVE	W1,DEFINING SYMBOL FLAGS
;	MOVE	W3,SYMBOL PTR
;	MOVE	P1,PTR TO DEFINING SYMBOL
;	PUSHJ	P,SY.STP
;DESTROYS R

SY.STP:	PUSH	P,W3		;SAVE SYMBOL PTRS
	HRRZ	T2,W3		;AND REL ADDRESS IN SYMBOL TABLE
	MOVE	W3,2(P1)	;FIXUP VALUE FROM ORIGINAL SYMBOL DEF
	TXNE	W1,FS.FXR	;RIGHT HALF FIXUP?
	HRLI	T2,SPF.AR	;YES
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP?
	HRLI	T2,SPF.AL	;YES
	TXNE	W1,FS.FXF	;FULL WORD FIXUP?
	HRLI	T2,SPF.AF	;YES
	TXNN	W1,FS.REL	;DEFINING SYMBOL RELOCATABLE?
	  JRST	SYSTP1		;NO, FIXUP TYPE IS OK
	MOVS	T2,T2		;YES, GET FIXUP TYPE IN RH
	ADDI	T2,<SPF.RR-SPF.AR>	;MAKE CORRESPONDING
	MOVS	T2,T2		; RELOCATABLE FIXUP
SYSTP1:	MOVEI	R,FS.SS-FX.S0	;LOAD INDEX
	SUB	P1,FX.LB	;REMOVE OFFSET INCASE CORE MOVES
	PUSHJ	P,SY.CHP	;LINK INTO LIST
	ADD	P1,FX.LB	;...
	POP	P,W3		;RESTORE W3
	POPJ	P,
SUBTTL	ADDRESS CHAINS (RH, LH, FULL WORD)


;FIXUP CHAINING OF SYMBOLS
;ENTER WITH 
;W3 = VALUE
;T2 = ADDRESS OF CHAIN (REL TO PROG ORIGIN)

;RIGHT HALF
SY.CHR::JUMPE	T2,CPOPJ	;DONE IF ZERO LINK
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2R##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[HRLI	T2,CPF.CR	;PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
	HRL	T2,(T2)		;GET NEXT LINK
	HRRM	W3,(T2)		;FILL IN VALUE
	HLRZS	T2		;SETUP FOR NEXT
	JRST	SY.CHR		;DO IT



;LEFT HALF
SY.CHL::JUMPE	T2,CPOPJ	;DONE IF ZERO LINK
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2L##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[HRLI	T2,CPF.CL	;PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
	HLL	T2,(T2)		;GET NEXT LINK
	HRLM	W3,(T2)		;FILL IN VALUE
	HLRZS	T2		;SETUP FOR NEXT
	JRST	SY.CHL		;DO IT
;FULL WORD 
SY.CHF::JUMPE	T2,CPOPJ	;DONE IF ZERO LINK
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2F##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[HRLI	T2,CPF.CF	;PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
	HRL	T2,(T2)		;GET NEXT LINK
	MOVEM	W3,(T2)		;FILL IN VALUE
	HLRZS	T2		;SETUP FOR NEXT
	JRST	SY.CHF		;DO IT

;FULL WORD REPLACEMENT 
RP.CHF::JUMPE	T2,CPOPJ	;DONE IF ZERO
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  PUSHJ	P,E$$ANM	;[1174] WE ONLY GET HERE WHEN PAGE IS IN CORE
	MOVEM	W3,(T2)		;REPLACE VALUE
	POPJ	P,
;HERE IF REQUIRED ADDRESS NOT INCORE
;DO NOT READ PAGE BACK IN, JUST STORE  REQUEST IN FX TABLE
;FILL IN LATER WHEN ENOUGH TO JUSTIFY READING PAGE BACK
;FIXUPS ARE STORED IN DOUBLLY  LINKED LIST IN ASCENDING ORDER
;POINTER IS 	PTR TO HIGHEST ADD,,PTR TO LOWEST ADD
;THE NULL LINK IS 0
;DATA BLOCK IS
;	BACKWARD PTR,,FORWARD PTR
;	FIXUP ADDRESS IN USER CORE
;	FIXUP VALUE

;CALLED BY
;	MOVEI	R,TABLE OFFSET (REL TO FX.S0)
;	MOVE	T2,REL ADDRESS OF FIXUP
;	MOVE	W3,VALUE OF FIXUP
;	PUSHJ	P,SY.CHP

SY.CHP::HRRZ	T1,R		;CLEAR RELOCATION BITS
	CAILE	T1,FS.SS-FX.S0	;VALIDATE INDEX
	PUSHJ	P,INVIDX	;INVALID INDEX
	PUSH	P,T2		;SAVE ADDRESS
	MOVEI	T2,3		;NEED 3 WORD BLOCK
	PUSHJ	P,FX.GET##	;IN FIXUP AREA
	POP	P,T2		;REL ADDRESS (TO SEGMENT) OF REQUEST
	MOVEM	T2,1(T1)	;STORE IN BLOCK
	MOVEM	W3,2(T1)	;AND VALUE
	SUB	T1,FX.LB	;REMOVE SET
	.JDDT	LNKLOD,SY.CHP,<<CAMN T1,$FIXUP##>>	;[632]
	HRRZ	T2,T2		;ADDRESSES ARE ONLY 18 BITS
	AOS	FXC.S0(R)	;INCREMENT COUNT OF FIXUPS PER SEGMENT

;NOW TO LINK IN CHAIN, HERE WITH
;R = OFFSET TO INITIAL POINTER
;T1 = ADDRESS (REL TO FX.LB) OF THIS BLOCK
;T2 = VALUE (ADDRESS REL TO SEG OF FIXUP)
;USES T3, T4 AS POINTERS


SY.FP0:	SKIPE	FX.S0(R)	;VIRGIN CHAIN?
	JRST	SY.FP1		;NO
	HRL	T1,T1		;BOTH ENDS POINT TO SAME LOC
	MOVEM	T1,FX.S0(R)	;STORE LINK
	POPJ	P,		;RETURN


INVIDX:	POP	P,T1		;GET LOCATION
	HRRZS	T1		;CLEAR FLAGS
E$$IVC::.ERR.	(MS,.EC,V%L,L%F,S%F,IVC,<Index validation check failed at address >) ;[1212]
	.ETC.	(OCT,.EP,,,,T1)
;HERE IF CHAIN ALREADY SETUP
SY.FP1:	HLRZ	T3,FX.S0(R)	;GET PTR TO TOP OF CHAIN
	ADD	T3,FX.LB	;ADD IN OFFSET
	SETZ	T4,		;PREV PTR WAS START OF CHAIN
	JRST	SY.FP4		;FIRST TIME THROUGH LOOP

SY.FP2:	HRLZ	T4,T4		;SAVE LAST IN LEFT HALF
	HRR	T4,T3		;SAVE THIS IN RIGHT
	HLRZ	T3,(T4)		;GET NEXT LOWER
	JUMPE	T3,SY.FX6	;END IF ZERO
	ADD	T3,FX.LB	;ADD IN OFFSET
SY.FP4:	HLL	T2,1(T3)	;GET INDEX SO COMPARE WILL WORK
	CAML	T2,1(T3)	;FIND ADDRESS SMALLER THAN WHAT WE HAVE
	JRST	SY.FP3		;YES, LINK INTO LIST
	JRST	SY.FP2		;NO, TRY AGAIN

SY.FX6:	HRLM	T1,(T4)		;ADD TO END
	HRRM	T1,FX.S0(R)	;AND TO INITIAL PTR
	SUB	T4,FX.LB	;-OFFSET
	ADD	T1,FX.LB	;+OFFSET
	HRRZM	T4,(T1)		;FORWARD LINK
	POPJ	P,

SY.FP3:	TRNN	T4,-1		;START OF CHAIN IF 0 ADDRESS
	JRST	SY.FP5		;YES, USE PREV POINTERS
	HRRM	T1,(T3)		;FWD PTR IN NEXT LOWER
	HRLM	T1,(T4)		;BKW PTR IN NEXT HIGHER
	ADD	T1,FX.LB	;ADD OFFSET
	SUB	T4,FX.LB	;REMOVE OFFSET
	SUB	T3,FX.LB	;FROM ADJACENT BLOCKS
	HRRM	T4,(T1)		;STORE IN LINK ADDRESS
	HRLM	T3,(T1)
	POPJ	P,

;HERE IF NEW ADDRESS IS BIGGEST YET
SY.FP5:	HRRM	T1,(T3)		;LINK BACK IN CHAIN
	HRLM	T1,FX.S0(R)	;AND INITIAL PTR
	ADD	T1,FX.LB	;FIX
	SUB	T3,FX.LB	;REMOVE OFFSET
	HRLZM	T3,(T1)		;BACKWARDS PTR
	POPJ	P,
SUBTTL	MULTIPLY DEFINED GLOBAL


;HERE IF MULTIPLY DEFINED GLOBAL SYMBOL
;ENTER WITH W1, W2, W3 CONTAIN NEW SYMBOL
;P1 IS POINTER TO OLD SYMBOL
;USES T1

SY.MDS::PUSHJ	P,SY.MDF	;WARN USER AND SET GLOBAL FLAG
	TXO	W1,PS.MDF	;FLAG MULTIPLE FOR LOCALS
	PJRST	LS.ADD		;AND GO STICK IN LOCAL TABLE


SY.MDF:	MOVE	T1,0(P1)	;GET CURRENT FLAGS
	TXON	T1,PS.MDF	;FLAG IT MULTIPLY DEFINED
	AOS	MSYM		;AND COUNT ONE MORE IF NEW
	MOVEM	T1,0(P1)
	MOVE	T1,2(P1)	;CURRENT VALUE
E$$MDS::.ERR.	(MS,.EC,V%L,L%W,S%W,MDS,<Multiply-defined global symbol >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,W2)	;SYMBOL IN W2
	.ETC.	(JMP,.EC,,,,.ETIMF##) ;[1174] PRINT OFFENDING MODULE
	.ETC.	(NLN,.EC)	;[1174]
	.ETC.	(STR,.EC,,,,,<Defined value = >) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,T1)	;CURRENT VALUE
	.ETC.	(STR,.EC,,,,,<, this value = >)
	.ETC.	(OCT,.EP,,,,W3)	;[1174]
	SETZM	LSTSYM		;SO WE DON'T DO FIXUPS?
	POPJ	P,
;HERE TO FILL IN PARTIAL VALUE SYMBOL (SYM1=SYM2)
;PRIMARY VALUE IS USUAL CHAINED REFERENCES
;SECONDARY VALUE IS ADDITIVE VALUE OF PARTIAL DEFINITION
;THERE MAY ALSO BE ADDITIVE GLOBAL FIXUPS REQUIRED

;CALLED BY
;	MOVE	T1,ADDRESS OF GLOBAL TO FIXUP
;	MOVE	T2,FLAGS FOR FIXUP TYPE
;	MOVE	W1,SYMBOL FLAGS
;	MOVE	W3,FIXUP VALUE
;	PUSHJ	P,SY.AS0

SY.AS1:	TXNE	T3,S.LST	;IF LAST TRIPLET
	JRST	SY.AS4		;GIVE UP

SY.AS0::ADDI	T1,.L		;GET NEXT TRIPLET
	MOVE	T3,(T1)		;GET FLAGS
	JUMPL	T3,SY.AS4	;JUST INCASE
	TXNN	T3,S.PVS	;IS THIS THE ONE WE WANT
	JRST	SY.AS1		;NO, TRY AGAIN
	PUSHJ	P,SY.AST	;FIXUP VALUE
	TXNE	W1,PS.UDF	;IF STILL UNDEFINED
	JRST	SY.AS4		;GIVE UP
	SOSGE	USYM		;ONE LESS UNDEFINED THEN
;[1174] Replace @SY.AS0+9L	DZN	30-May-79
	PUSHJ	P,E$$DUZ	;[1174] BUT NOT TOO FAR
	MOVX	T3,PS.REQ	;IF NOW FULLY DEFINED
	ANDCAM	T3,0(P1)	;CLEAR GLOBAL REQUEST FLAG IF SET
	MOVE	W3,2(T1)	;GET FIXUP VALUE (TEMP STORAGE ONLY)
	PUSHJ	P,SY.ZST	;ZAP PVS TRIPLET (T1 POINTS TO IT)
SY.FXP:	EXCH	W3,2(P1)	;GET VALUES RIGHT WAY ROUND
				;AND FIXUP ALL REQUESTS
	MOVE	T2,W3		;GET START OF CHAIN
	DMOVE	W2,1(P1)	;GET NAME AND VALUE OF SYMBOL
	PUSHJ	P,SY.CHR	;RIGHT-HALF CHAINED FIXUP
	TXNN	W1,PS.FXP	;ANY FIXUPS TO BE DONE?
SY.AS4:	POPJ	P,		;NO
	PJRST	SY.RF2		;YES, DO ALL ADDITIVE FIXUPS
;HERE TO GET RID OF A SECONDARY TRIPLET IN THE GS AREA POINTED TO BY T1

SY.ZST:	MOVE	T3,0(T1)	;GET TRIPLET FLAGS
	TXNN	T3,S.LST	;LAST BLOCK?
	PUSHJ	P,SY.ZS1	;NO, GIVE BACK THE MIDDLE FIRST
	MOVEI	T2,.L		;GIVE IT BACK
	PUSH	P,T1		;SAVE ADDRESS
	PUSHJ	P,GS.RET##
	POP	P,T1		;GET BACK POINTER
	MOVE	T3,-.L(T1)	;GET FLAGS
	JUMPL	T3,SY.ZS2	;REACHED PRIMARY
	MOVX	T3,S.LST	;SET THIS IS LAST TRIPLET NOW
	IORM	T3,-.L(T1)
	POPJ	P,		;DONE

SY.ZS2:	MOVX	T3,PT.EXT!PS.FXP	;REMOVE EXTENDED FLAG
	ANDCAM	T3,-.L(T1)	;SINCE WE DON'T HAVE IT NOW
	POPJ	P,		;DONE

;HERE TO MOVE UP THE SECONDARY TRIPLETS
SY.ZS1:	HRLZI	T2,.L(T1)	;NEXT TRIPLET
	HRRI	T2,0(T1)	;THIS TRIPLET
	ADDI	T1,.L		;POINT TO NEXT
	BLT	T2,-1(T1)	;MOVE IT UP
	SKIPG	T2,0(T1)	;GET FLAGS
	PUSHJ	P,E$$ISP	;[1174]
	TXNN	T2,S.LST	;GOT THERE YET
	JRST	SY.ZS1		;NO, TRY AGAIN
	POPJ	P,
;HERE TO FIXUP PARTIAL VALUE EITHER RH OR LH
;ENTER WITH
;	T1 = PTR TO CURRENT EXTENDED TRIPLET
;	T2 = FLAGS (WHICH HALF TO FIXUP)
;	W3 = ADDITIVE VALUE

SY.AST::TXNE	T2,FS.FXR	;RIGHT HALF?
	JRST	SY.ASR		;YES
	TXNE	T2,FS.FXL	;LEFT HALF?
	JRST	SY.ASL		;YES
SY.ASF:	MOVE	T3,2(T1)	;GET CURRENT VALUE
	ADD	T3,W3		;ADD, IGNORE CARRY
	MOVEM	T3,2(T1)	;STORE VALUE BACK
	POPJ	P,

SY.ASR:	HRRZ	T3,2(T1)	;GET CURRENT VALUE
	ADDI	T3,(W3)		;IGNORE CARRY
	HRRM	T3,2(T1)	;STORE VALUE IN RIGHT
	POPJ	P,

SY.ASL:	HLRZ	T3,2(T1)	;GET CURRENT VALUE
	ADDI	T3,(W3)		;IGNORE CARRY
	HRLM	T3,2(T1)	;STORE BACK
	POPJ	P,
SUBTTL	SYMBOL ROUTINES


;HERE TO MOVE A SYMBOL TO ANOTHER (LARGER) AREA
;GENERALLY TO ADD EXTENDED TRIPLETS

;CALLED BY
;	MOVE	T1,EXTRA REQUIRED
;	MOVE	P1,ABS LOC OF PRIMARY
;	MOVE	P2,REL OFFSET OF PRIMARY
;	PUSHJ	P,SY.MOV
;RETURNS
;P1 = NEW ABS ADDRESS
;T1 = LAST SYMBOL TRIPLET IN USE

SY.MOV::PUSH	P,T1		;SAVE EXTRA
	PUSHJ	P,SY.CHK	;SEE HOW MUCH WE ALREADY HAVE
	EXCH	T2,0(P)		;SWAP SO WE SAVE LENGTH
	ADD	T2,0(P)		;THIS IS HOW MUCH WE WANT
	PUSHJ	P,GS.GET##	;GET IT
	HRRZ	P1,@HT.PTR	;RESET P1(INCASE CORE MOVED)
	ADD	P1,NAMLOC	;FIX IN CORE
	HRLZ	T2,P1		;MOVE FROM
	HRR	T2,T1		; TO
	MOVE	T3,T1		;UPTO
	ADD	T3,0(P)		;END
	BLT	T2,-1(T3)
	EXCH	P1,T1		;SWAP
	MOVE	T2,0(P)		;FINISHED WITH OLD AREA
				;UNLESS THERE ARE PARTIAL VALUE FIXUPS
	MOVE	T3,0(T1)	;GET FLAGS
	TXNN	T3,PT.EXT	;EXTENDED?
	JRST	SYMOV2		;NO DON'T WASTE TIME
	MOVE	T3,T1		;YES, MIGHT BE PARTIAL VALUES
SYMOV1:	ADDI	T3,.L		;ADVANCE TO NEXT SECONDARY
	SKIPGE	T4,0(T3)	;GET SECONDARY FLAGS
	JRST	SYMOV2		;DONE
	TXNE	T4,S.PVS	;ONLY WANT PARTIAL VALUE
	JRST	SYMOV3		;YES, MUST SAVE A POINTER TO NEW BLOCK
	TXNN	T4,S.LST	;IF LAST TRIPLET WE ARE FINISHED
	JRST	SYMOV1		;NO TRY AGAIN
	JRST	SYMOV2		;NOTHING WORTH SAVING HERE
;HERE WHEN PVS TRIPLET FOUND

SYMOV3:	MOVX	T4,PT.SGN!PT.OTH!PO.IND	;SET FLAGS
	MOVEM	T4,0(T1)	;IN MEMORY
	MOVE	T4,P1		;GET NEW POINTER
	SUB	T4,NAMLOC	;MINUS OFFSET
	MOVEM	T4,2(T1)	;AS VALUE
	ADDI	T1,.L		;ADDVANCE
	SUBI	T2,.L
SYMOV2:	PUSHJ	P,GS.RET##	;SO GIVE IT BACK
	MOVX	T1,PT.EXT	;[612] TRIPLET IS NOW EXTENDED
	IORM	T1,0(P1)	;[612] SO MARK IT SO
	MOVE	T1,P1		;ABS ADDRESS
	SUB	T1,NAMLOC	;MAKE REL
	HRRM	T1,@HT.PTR	;RESET POINTER
	POP	P,T2		;GET LENGTH BACK
	MOVE	T1,P1
	ADD	T1,T2		;POINT TO END
	MOVX	T3,S.LST	;IS NOT LAST NOW, SO REMOVE FLAG
	SKIPL	-.L(T1)		;BUT NOT IF PRIMARY
	ANDCAM	T3,-.L(T1)
	POPJ	P,
;HERE TO COUNT THE NUNBER OF TRIPLETS IN A SYMBOL
;ENTER WITH P1 = ADDRESS (ABS)
;RETURN T2 = LENGTH
;USES T1
;STOPS ON EITHER LAST TRIPLET (S.LST) OR NEXT PRIMARY (PT.SGN)

SY.CHK::SKIPGE	T1,0(P1)	;SEE IF PRIMARY
	TXNE	T1,PT.EXT	;YES, BUT IS SYMBOL EXTENDED?
	JRST	SYCHK1		;MUST COUNT EXTENDED
	MOVEI	T2,.L		;THE EASY WAY TO GET LENGTH
	POPJ	P,		;JUST RETURN

SYCHK1:	HRRZ	T2,P1		;COPY STARTING ADDRESS
	JUMPGE	T1,SYCHK2	;JUMP IF SECONDARY ON ENTRY
	ADDI	T2,.L		;GET FIRST SECONDARY
SYCHK2:	SKIPGE	T1,0(T2)	;MAKE SURE NOT PRIMARY
	PUSHJ	P,E$$ISP	;[1174] SHOULD NEVER HAPPEN
	ADDI	T2,.L		;ADVANCE PAST
	TXNN	T1,S.LST	;LAST TRIPLET?
	JRST	SYCHK2		;NOT YET
	SUBI	T2,(P1)		;YES, GET LENGTH
	POPJ	P,

;HERE TO RETURN OLD SYMBOL AREA BACK TO POOL
;MAY BE ANY LENGTH (MULTIPLE OF .L)
;ENTER WITH P1 = ADDRESS OF SYMBOL IN CORE
;USES T1, T2

SY.RET::PUSHJ	P,SY.CHK	;SEE HOW LONG IT IS
	HRRZ	T1,P1		;GET START ADDRESS
	SETZM	@HT.PTR		;DELETE IN SYMBOL TABLE
	PJRST	GS.RET##	;RETURN IT
;HERE TO SETUP T2 TO POINT TO INCORE ADDRESS
;ENTER WITH T2 = RELATIVE ADDRESS
;SETS UP RHS OF R, LEAVES RELOC BITS IN LHS
;RETURNS
;+1	ADDRESS NOT IN CORE (PAGING ONLY)
;		T2 UNAFFECTED, R CHANGED
;+2	ADDRESS IN CORE AND T2 POINTS TO IT

SEGCHK::
	PUSH	P,T2		;[1132] SAVE USER VIRTUAL ADDRESS
	HRRI	R,2		;ASSUME IN HIGH SEG
	SKIPE	LL.S2		;[1132] MUST BE LOW IF ONLY ONE SEGMENT
	CAMGE	T2,LL.S2	;[1132]  BELOW BOTTOM OF HIGH SEGMENT?
	SOJA	R,SEGCK2	;[1132] IN LOW SEGMENT
	SUB	T2,LL.S2	;[1132] FORM OFFSET INTO HIGH SEGMENT
	CAMGE	T2,HL.S2	;[1132] BEFORE END OF HIGH SEGMENT?
	JRST	SEGCK4		;[1132] YES, IN HIGH SEGMENT
	MOVE	T2,0(P)		;[1132] RESTORE ADDRESS (OFFSET INTO LOW SEG)
	HRRI	R,1		;[1132] SET R TO LOW SEGMENT
SEGCK2:				;[1132] HERE IF T2 AND R POINT TO LOW SEG
IFN FTOVERLAY,<
	SUB	T2,PH.ADD	;[1132] OFFSET INTO LC IF NOT ROOT LINK
> ;END IFN FTOVERLAY

SEGCK4:	SKIPN	PAG.S0(R)	;[1132] IS THIS AREA PAGING?
	JRST	SEGCK6		;[1132] NO, ADDR CAN'T BE ON DISK
	CAML	T2,LW.S0(R)	;[632] IS ADDRESS IN CORE?
	CAMLE	T2,UW.S0(R)	;[632] MAYBE, IS IT?
	JRST	[POP P,T2	;[1132] NOT IN CORE, RESTORE CALLER'S T2
		POPJ P,]	;[1132] RETURN TO CALLER

;HERE IF ADDRESS IS DEFINITELY IN CORE.
SEGCK6:	EXCH	T2,0(P)		;[1132] GET PHYSICAL ADDRESS FOR .JDDT
	.JDDT	LNKLOD,SEGCK6,<<CAMN T2,$LOCATION>>	;[1132]
	POP	P,T2		;[1132] RESTORE OFFSET INTO SEGMENT
	SUB	T2,LW.S0(R)	;[632] RELATIVE TO IN-CORE PART OF AREA
	HRR	R,@SG.TB	;[632] FIND APPROPRIATE RC BLOCK
	ADD	T2,@RC.LB(R)	;[632] MAKE PHYSICAL LOAD-TIME ADDRESS
	JRST	CPOPJ1		;[632] SUCCESS RETURN TO USER
;HERE TO PUT REQUEST IN GLOBAL SYMBOL TABLE
;ENTER WITH
;W1 = SECONDARY TRIPLET FLAGS
;W2 = SYMBOL NAME
;W3 = FIXUP VALUE (NOT USED)
;+0(P) = RETURN ADDRESS
;-1(P) = VALUE OF PRIMARY TRIPLET
;-2(P) = FLAGS FOR PRIMARY TRIPLET
;
;NOTE, REMOVES 3 ITEMS FROM STACK

GS.FX0::MOVEI	T2,2*.L		;NEED EXTENDED SYMBOL
	PUSHJ	P,GS.GET##	;GET SPACE FOR SYMBOL
	TXO	W1,S.LST	;SIGNAL AS LAST TRIPLET
	TMOVEM	W1,.L(T1)	;STORE SECONDARY TRIPLET FLAGS, NAME, VALUE
	MOVE	W1,-2(P)	;GET PRIMARY FLAGS
	TXO	W1,PS.FXP!PT.EXT	;MARK ADDITIVE REQUESTS IN FIXUP TABLE
	MOVE	W3,-1(P)	;GET VALUE FROM STACK
	TMOVEM	W1,0(T1)	;STORE FLAGS, NAME, VALUE
	MOVE	W3,T1		;POINT TO INCORE BLOCK
	SUB	W3,NAMLOC	;INCASE IT MOVES
	PUSH	P,W3		;SAVE VALUE INCASE CORE MOVES
	PUSHJ	P,INSRT		;PUT IN GLOBAL TABLE
	POP	P,W3		;GET ADDRESS BACK (RELATIVE TO GX.LB)
	POP	P,T2		;GET RETURN ADDRESS
	SUB	P,[2,,2]	;REMOVE JUNK FROM STACK
	JRSTF	@T2		;AND RETURN
;HERE TO LINK FIXUP TRIPLET TO CURRENT GLOBAL TRIPLET
;ENTER WITH FIXUP ADDRESS (RELATIVE TO FX.LB)
;IN W3 (SET BY SY.FX0)
;AND GLOBAL ADDRESS (RELATIVE TO GX.LB)
;IN P2
;NOTE BOTH TABLES MAY MOVE

SY.GX0::HRRZ	T1,@HT.PTR	;FIND OUT WHERE GLOBAL TRIPLET
	ADD	T1,NAMLOC	;IS IN CORE
	HRRZM	W3,.L+2(T1)	;FIXUP POINTER TO FIXUP LIST
	POPJ	P,
;HERE TO PUT SYMBOL INTO FIXUP TABLE
;ENTER WITH
;W1 = FLAGS
;W2 = SYMBOL
;W3 = VALUE
;RETURN WITH
;W3 = POINTER TO LOCATION RELATIVE TO FX.LB

SY.FX0::MOVEI	T2,.L		;SPACE IN 3 WORD CHUNKS
	PUSHJ	P,FX.GET##	;SPECIAL SPACE GETTER
	TMOVEM	W1,0(T1)	;STORE FIXUP REQUEST
	MOVE	W3,T1		;PUT ADDRESS IN W3
	SUB	W3,FX.LB	;MAKE IT RELATIVE TO ORIGIN
	.JDDT	LNKLOD,SY.FX0,<<CAMN W3,$FIXUP##>>	;[632]
	POPJ	P,		;RETURN
;HERE TO SEE IF SYMBOL REQUESTED FOR SYMBOL TABLE FIXUP WAS LAST
;SYMBOL DEFINED (NOT FULLY DEFINED OF COURSE)
;CALLED BY
;	MOVE	W3,SYMBOL
;	PUSHJ	P,SY.RLS
;RETURNS
;+1	NOT LAST SYMBOL DEFINED
;+2	LAST SYMBOL DEFINED
;T1=	ADDRESS OF SYMBOL IN LOCAL TABLE
;T2=	ADDRESS OF SYMBOL IN GLOBAL TABLE

SY.RLS::HRRZ	T1,LSTSYM	;GET LOCAL ADDRESS
	JUMPE	T1,.+3		;LEAVE ZERO ALONE
	ADD	T1,LS.LB	;RELOCATE
	SUB	T1,LW.LS	;BUT REMOVE WINDOW BASE
	HLRZ	T2,LSTSYM	;AND GLOBAL
	SKIPE	T2
	ADD	T2,NAMLOC	;RELOCATE
	JUMPE	T1,[JUMPE T2,SYRLSZ	;[1165] NO LOCALS, TRY GLOBAL
		CAME	W3,1(T2)	;IF IN GLOBAL TABLE
		JRST	SYRLSZ		;[1165] NO MATCH
		JRST	SYRLSM]		;GOT IT HERE
	CAME	W3,1(T1)	;SAME?
	JRST	SYRLSZ		;[1165] NO
SYRLSM:	MOVE	W3,LSTSYM	;YES, SET POINTER IN W3
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

SYRLSZ:	SETZM	LSTSYM		;[1165] DON'T CONFUSE SYMBOLS DOWN THE PIKE
	POPJ	P,		;[1165]
SUBTTL	COMPILER SPECIFIC ROUTINES


DEFINE X(A,B,C)<
  IF1,<BLOCK	1>
  IF2,<
    IFDEF B'NAM,<		;;[1120] CALL PROCESSOR ROUTINE
	PUSHJ	P,B'NAM
    >
    IFNDEF B'NAM,<
	JFCL			;;[1120] NOTHING TO DO
    >
  >
>

	XALL
CT.NAM::PROCESSORS

DEFINE X(A,B,C)<
	B'BIT
>
CT.BIT::PROCESSORS
	SALL
;CALLED BY	PUSHJ	P,xxxNAM
;
;ENTER WITH
;	T1/	INDEX TO CT.TAB
;	T2/	PROCSN (CT.BIT)
;	W2/	PROGRAM NAME
;	-1(P)/	BLANK COMMON

;HERE IF ALGOL MAIN PROGRAM - SETS THIS AS PROGRAM NAME
ALGNAM:	SKIPN	-1(P)		;SEE IF BLANK COMMON SET
	POPJ	P,		;[1120] USES COMMON SIZE AS MAIN PROG MARKER.
	SETZM	-1(P)		;CLEAR COMMON SIZE
	MOVEM	W2,LODNAM	;SAVE NAME
	HRLZM	T1,MNTYPE	;AND SAVE ALGOL AS MAIN PROG TYPE
	POPJ	P,		;[1120] DONE

F40NAM:
IFN FTOVERLAY,<
	SKIPE	OVERLW		;SEEN /OVERLAY?
	JRST	E$$FOV		;[1174] YES
>
IFN FMXFOR,<
	SKIPE	MIXFOR		;WANT TO MIX F40 & F-10?
	JRST	[HRRZS	MIXFOR		;YES
		TXNE	T2,F40BIT	;[1120] 1ST TIME SEEN F40?
		POPJ	P,		;[1120] NO, GO TEST CPU'S
		MOVX	W1,PT.SGN!PT.SYM;[1120] YES,
		MOVE	W2,['FORSE.']	;REQUEST FORSE., SO
		SETZ	W3,		;FORJAK WILL BE LOADED
		PUSH	P,P1		;SAVE PERM ACS
		PUSHJ	P,SY.RQ##	;GENERATE REQUEST
		POP	P,P1		;..
		POPJ	P,]		;[1120] DONE
>
	TXNN	T2,XFRBIT	;[1203] EXTENDED FORTRAN?
	TXNE	T2,FORBIT	;[1120] CAN NOT HAVE BOTH
	JRST	E$$MSR		;[1174] ERROR
	POPJ	P,		;[1120] DONE

IFN FTOVERLAY,<
E$$FOV::.ERR.	(MS,.EC,V%L,L%F,S%F,FOV,<Cannot overlay F40 compiled code>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]>
CBLNAM:	JUMPE	T2,CPOPJ	;[1120] OK FIRST TIME
	TXNE	T2,C74BIT	;[1120] TEST FOR OTHER COBOL
	JRST	E$$CMC		;[1174] NOT ALLOWED
	TXNE	T2,CBLBIT	;[1120] OR IF COBOL ALREADY SEEN
	POPJ	P,		;[1120] DONE
E$$CMF::.ERR.	(MS,0,V%L,L%F,S%F,CMF,<COBOL module must be loaded first>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

C74NAM:	JUMPE	T2,CPOPJ	;[1120] OK FIRST TIME
	TXNE	T2,CBLBIT	;[1120] TEST FOR OTHER COBOL
	JRST	E$$CMC		;[1174] NOT ALLOWED
	TXNN	T2,C74BIT	;[1174] OR IF COBOL ALREADY SEEN
	JRST	E$$CMF		;[1174]

E$$CMC::.ERR.	(MS,.EC,V%L,L%F,S%F,CMC,<Cannot mix COBOL-68 and COBOL-74 compiled code>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;FORTRAN

XFRNAM:	TXNE	T2,FORBIT	;[1203] SEEN OTHER FORTRAN?
	JRST	E$$CMX		;[1203] YES, ERROR
	JRST	FOROK		;[1203] NO, PROCEED
FORNAM:	TXNE	T2,XFRBIT	;[1203] OTHER FORTRAN?
	JRST	E$$CMX		;[1203] YES, COMPLAIN
FOROK:
IFN FMXFOR,<
	SKIPE	MIXFOR		;DO WE NEED MIXFOR FEATURE?
	JRST	FORKLG		;YES
>
	TXNN	T2,F40BIT	;[1120] F40 SEEN ALREADY?
	JRST	FORSEG		;[1120] SEE IF WE CARE ABOUT CPU
E$$MSR::.ERR.	(MS,0,V%L,L%F,S%F,MSR,</MIXFOR switch required to mix F40 and FORTRAN code>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

IFN FMXFOR,<
FORKLG:	HRRZS	MIXFOR		;MAKE IT POSITIVE
>
FORSEG:	MOVE	T1,OTSEG	;[1120] DID USER SPECIFY NON-REENT OTS?
	SOJE	T1,CPOPJ	;YES, SO LOAD TWO SEG CODE IN TWO SEGMENTS
IFN FTOVERLAY,<
	SKIPGE	LNKMAX		;ONLY IF WE ARE IN ROOT TEST
>
	SKIPN	HC.LB		; IF ANY HIGH LOADED
	TRNE	FL,R.FNS!R.FLS!R.FHS!R.LSO!R.HSO	;ANY REASON TO KEEP SEGMENTS DISTINCT?
	POPJ	P,		;EITHER USER HAS SPECIFIED WHICH, OR ALREADY LOADED HIGH
				;IN EITHER CASE RIGHT THING HAPPENS
	TRO	FL,R.FLS	;NO, SO FORCE LOW SEGMENT
	POPJ	P,		;SO FOROTS WILL BE SHAREABLE


E$$CMX::.ERR.	(MS,.EC,V%L,L%F,S%C,CMX,<Cannot mix Extended FORTRAN compiled code with FORTRAN compiled code>)
	.ETC.	(JMP,,,,,.ETIMF##)	;[1203]
	AOS	.JBERR			;[1207] STOP EXECUTION
	JRST	FOROK			;[1207] BUT KEEP LOADING
;SITGO

STGNAM:
E$$SNS::.ERR.	(MS,.EC,V%L,L%F,S%F,SNS,<SITGO not supported>)
	.ETC.	(JMP,,,,,.ETIMF##)	;[1203]
SUBTTL	MIXFOR FEATURE


IFN FMXFOR,<
.MXFOR::MOVE	R2,ENTPTR	;GET AOBJN POINTER TO NAMES
	MOVE	R3,MIXFOR	;GET POINTER TO ADDRESSES
MXFOR1:	HRRZ	P4,(R3)		;GET ENTRY ADDRESS
	JUMPE	P4,MXFOR5	;IGNORE 0 (F-10 MAIN PROG)
	PUSHJ	P,ADCKMX	;GET WORD IT POINTS TO
	MOVS	T1,T1		;SHOULD BE ONLY LEFT HALF
	CAIE	T1,(JFCL)	;F-10 MAIN
	CAIN	T1,015000	;F40 MAIN (RESET.)
	JRST	MXFOR5		;YES, IGNORE
	MOVEI	R,1		;ALWAYS STORE IN LOW SEGMENT
	MOVE	R,@RC.TB	;SINCE JSA CODE IS INPURE
	MOVEI	P2,4		;NEED 4 WORDS
	PUSHJ	P,MXFCOR	;GET CORE FOR FIXUP
	MOVSI	W1,(CAIA)	;SKIP IF PUSHJ, DON'T IF JSA
	CSTORE			;STORE IN CORE
	MOVSI	W1,(PUSHJ 17,)	;PUSHJ 17,.MXFOR##
	ADDI	P3,1		;INCREMENT DEPOSIT POINTER
	CSTORE
	ADDI	P3,1		;FOR PUSHJ 17,.SAV15##
	CSTORE
	MOVSI	W1,(JRST)	;JUMP TO ENTRY POINT
	HRR	W1,(R3)		;ADDRESS OF ENTRY
	ADDI	P3,1
	CSTORE
	MOVX	W1,PT.SGN!PT.SYM!PS.ENT	;SET PS.ENT TO BYPASS TEST AT SY.GS
	MOVE	W2,(R2)		;SYMBOL
	MOVEI	W3,-3(P3)	;NEW VALUE OF ENTRY POINT
	SUB	W3,LC.LB	;MINUS OFFSET
	ADD	W3,LW.S1	;PLUS BASE INCASE PAGING LC AREA
	PUSHJ	P,SY.GS##	;DEFINE ENTRY NOW
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['.MXFOR']	;NOW FOR REQUEST
	ADDI	W3,1		;ADDRESS FOR PUSH P,.MXFOR
	PUSHJ	P,SY.RQ##
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['.SAV15']
	ADDI	W3,1
	PUSHJ	P,SY.RQ##
	MOVEI	R,1		;RESTORE R TO LOW SEG
	MOVE	R,@RC.TB	;SINCE SY.RQ (SEGCHK) DESTROYS IT
	HRRZ	P4,(R3)		;GET ADDRESS OF UNMODIFIED ENTRY POINT
	PUSHJ	P,ADCKMX	;ADDRESS CHECK INCASE ON DSK
	TLC	T1,(JUMP)	;F40 SUBROUTINE HAS ARG OPCODE HERE
	JUMPN	T1,MXFOR6	;NO, NON-ZERO IS FORTRAN-10
;HERE FOR F40 CODE

MXFOR2:	PUSHJ	P,ADCKL1	;GET NEXT WORD
	TLC	T1,(JRST)	;SEE IF END OF ARGS
	TLNN	T1,-1		;BY JRST 2M
	JRST	MXFR2A		;YES
	TLC	T1,035016	;JRST XOR PUSH 0(16)
	TLNE	T1,-1		;LOOK FOR PUSH 0,N(16)
	JRST	MXFOR2		;NO
	PUSH	P,T1		;SAVE ADDRESS
	MOVE	T1,RC.CV(R)	;GET NEXT FREE LOC
	HRLI	T1,(JRST)	;JRST [CODE]
	MOVEM	T1,(P3)		;STORE
	MOVEI	P2,3		;NEED 3 WORDS
	PUSHJ	P,MXFCOR	;FROM FREE CORE
	POP	P,W1		;GET ADDRESS
	HRLI	W1,(MOVEI 1,@(16))	;GET ADDRESS IN AC 1
	CSTORE
	MOVE	W1,[PUSH 0,1]	;STACK IT
	ADDI	P3,1
	CSTORE
	HRRZI	W1,1(P4)	;GET ADDRESS TO RETURN TO
	HRLI	W1,(JRST)
	ADDI	P3,1
	CSTORE
	JRST	MXFOR2		;TRY AGAIN
;HERE AT THE END OF THE ARGS IN THE SUBROUTINE PROLOGUE.
;NOW PUT ALL PATCH CODE IN PATCH AREA, AND HANDLE POSSIBLE MULT RETURN

MXFR2A:	HRRZ	P4,(R3)		;GET ADDRESS OF UNMODIFIED ENTRY POINT
	SUBI	P4,1		;BACKUP 1
	PUSHJ	P,ADCKMX	;MAKE SURE ITS IN CORE
	MOVE	P4,(P3)		;SHOULD BE JRST 2M
	TLC	P4,(JRST)	;MASK LEFT 18 BITS
	TLNE	P4,-1		;ALL ZERO
	JRST	E$$FSF		;[1174] NO, SO GIVE UP
MXFOR3:	PUSHJ	P,ADCKMX	;GET NEXT DATA WORD
	TLC	T1,(JRA 16,(16))	;LOOK FOR RETURN INST
	TLNE	T1,-1
	AOJA	P4,MXFOR3	;NOT YET, INCR AND TRY AGAIN
	MOVSI	T1,(POPJ 17,)	;CHANGE TO POPJ RETURN
	MOVEM	T1,(P3)
	PUSHJ	P,ADCKL1	;GET NEXT DATA WORD
				;INCASE MULTIPLE RETURNS
	TLC	T1,(ADD 16,)	;COMPILED CODE IS ALWAYS ADD 16,TEMP#
	TLNE	T1,-1		;WHERE TEMP# CONTAINS NUMBER OF RETURN
	JRST	MXFOR5		;SINGLE RETURN ONLY
	PUSHJ	P,ADCKL1	;GET NEXT WORD
	TLC	T1,(JRA 16,@(16))	;MULTIPLE RETURN HAS INDIRECT BIT ON
	TLNE	T1,-1
	JRST	E$$FSF		;[1174] ERROR
	MOVSI	T1,(SOJA 16,)	;CHANGE INST TO SOJA 16,.JRA16##
MXFOR4:	MOVEM	T1,(P3)
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['.JRA16']
	MOVE	W3,P4		;LOCATION
	PUSHJ	P,SY.RQ##	;REQUEST CHAINED FIXUP
MXFOR5:	ADDI	R3,1		;GO ON TO NEXT
	AOBJN	R2,MXFOR1	;IF THERE IS ONE
	MOVE	T1,MIXFOR	;ADDRESS OF MIXFOR BLOCK
	HLRE	T2,ENTPTR	;-LENGTH OF IT
	MOVM	T2,T2		;+LENGTH
	PUSHJ	P,DY.RET##	;RESTORE
	SETOM	MIXFOR		;RESET MIXFOR CONTROL
	PJRST	T.5ENT##	;RESTORE AND RETURN
;HERE IF FORTRAN-10, TEST FOR MULTIPLE RETURN

MXFOR6:	MOVEI	W1,-2(W3)	;[561] SEARCH UNTIL END OF SUBROUTINE
MXFOR7:	PUSHJ	P,ADCKMX	;GET NEXT DATA WORD
	TLC	T1,(POP 17,(17))	;LOOK FOR WHERE MULTIPLE RETURN
	TLNN	T1,-1		;CLEARS THE STACK
	JRST	MXFOR8		;FOUND IT, WE NEED TO KEEP THIS ON STACK
	TLC	T1,(POP 17,(17))	;PUT INST BACK AS IT WAS
	TLC	T1,(HRRM 1,(17))	;INCASE NEWER FORM OF RETURM
	JUMPE	T1,[MOVEI T1,-2		;YES, SO STORE RETURN
		HRRM	T1,(P3)		;AT RIGHT PLACE ON STACK
		JRST	MXFOR5]		;AND TRY NEXT
	CAIGE	P4,(W1)		;DON'T GO TOO FAR
	AOJA	P4,MXFOR7	;BUT LOOK FAR ENOUGH
	JRST	MXFOR5		;CANNOT FIND MULTIPLE RETURN

MXFOR8:	MOVSI	T1,(JFCL)	;REPLACE POP BY NOOP
	MOVEM	T1,(P3)
MXFOR9:	PUSHJ	P,ADCKMX	;GET NEXT DATA WORD
	TLC	T1,(JRST @(16))	;LOOK FOR MULTIPLE RETURN
	TLNN	T1,-1
	JRST	[MOVSI	T1,(JRST)	;FOUND IT
		JRST	MXFOR4]		;REPLACE BY JRST .JRA16##
	CAIGE	P4,(W1)		;GONE TOO FAR?
	AOJA	P4,MXFOR9	;NOT YET
;	JRST	E$$FSF		;[1174] SHOULD HAVE FOUND IT BY NOW
;HERE IF SUBROUTINE IS NOT STANDARD FORM
E$$FSF::.ERR.	(MS,.EC,V%L,L%W,S%W,FSF,<FORTRAN subroutine not in expected format, /MIXFOR fixup not done>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174] RETURNS WHEN MODULE AND FILE PRINTED
	JRST	MXFOR5		;TRY NEXT

MXFCOR:	MOVE	P3,RC.CV(R)	;GET CURRENT RELOC COUNTER
	ADDB	P2,RC.CV(R)	;NEW RELOC COUNTER
	CAMLE	P2,HL.S1	;RESET HIGHEST LOCATION COUNTER
	MOVEM	P2,HL.S1
	CAMLE	P2,HC.S1	;AND HIGHEST DATA LOADED COUNTER
	MOVEM	P2,HC.S1
	SKIPE	PAG.S1		;PAGING?
	JRST	MXFPAG		;YES, SEE IF IN CORE
	ADD	P2,LC.LB	;RELOCATE RELATIVE ADDRESS
	CAMG	P2,LC.AB	;WILL IT FIT IN EXISTING SPACE?
	JRST	MXFINC		;YES
	SUB	P2,LC.AB	;GET EXTRA REQUIRED
	MOVEI	P1,LC.IX	;AREA REQUIRED TO EXPAND
	PUSHJ	P,LNKCOR##	;TRY TO GET MORE SPACE
	  JRST	MXFPAG		;FAILED, BUT MUST BE ON DSK BY NOW
	SUB	P3,LW.S1	;INCASE WE DUMPED CORE FOR FIRST TIME
MXFINC:	ADD	P3,LC.LB	;FINALLY FIX THIS INCASE CORE MOVED
	POPJ	P,

MXFPAG:	PUSHJ	P,PG.LSG	;TEST IF IN CORE
	JRST	MXFINC		;NOW IN CORE

;HERE TO ADDRESS CHECK FIXUP LOCATION
;ENTER WITH ADDRESS (REL) IN P4
;RETURN WITH ABS ADDRESS IN P3
;CONTENTS OF P3 IN T1
;
ADCKL1:	ADDI	P4,1		;GET NEXT LOCATION
ADCKMX:	MOVE	P2,P4		;GET UPPER ADDRESS REQUIRED
	MOVE	P3,P4		;AND LOWER
	SKIPE	PAG.S1		;PAGING?
	PUSHJ	P,PG.LSG	;YES, MAKE SURE IN CORE
	ADD	P3,LC.LB	;FIXUP ADDRESS IN CORE
	MOVE	T1,(P3)		;GET CONTENTS
	POPJ	P,

>;END IFN FMXFOR
SUBTTL	STORE CODE IN FX AREA


T3HOLD::MOVEI	T2,.IPS		;STORE CODE IN INTERNAL PAGES
	PUSHJ	P,DY.GET##	;FIRST BLOCK IN DY, REST IN FX
	MOVE	T2,[3,,1]	;BLOCK HEADER
	MOVEM	T2,1(T1)	;FOR RE-READ
	MOVEM	W1,3(T1)	;STORE HIGH SEG ORIGIN
	MOVEI	W2,3(T1)	;POINT TO NEXT FREE LOC
	HRLI	W2,-.IPS+3	;AOBJN WORD FOR THIS BLOCK
	PUSH	P,T1		;SAVE ORIGIN
T3HEDR:	PUSHJ	P,D.IN1		;GET NEXT HEADER
	HLRZ	T1,W1		;GET TYPE
	CAIN	T1,5		;NEED END BLOCK
	JRST	T5FND		;FOUND IT
	PUSHJ	P,FXHOLD	;HOLD CODE IN FX AREA
	JRST	T3HEDR		;AND CONTINUE

;HERE TO STORE BLOCK IN CORE (FX)
;ENTER WITH W1 = FIRST DATA WORD

FXHOLD:	HRRZ	T1,W1		;GET WORD COUNT
	JUMPE	T1,CPOPJ	;IGNORE 0
	CAIG	T1,^D18		;ONLY 1 SUB BLOCK
	AOJA	T1,FXHLD0	;YES
	IDIVI	T1,^D18		;NO, COUNT NO.
	IMULI	T1,^D19		;ADD RELOCATION WORD
	JUMPE	T2,FXHLD0	;NO REMAINDER
	ADDI	T1,1(T2)	;ADD REMAINDER + BYTE WORD
FXHLD0:	SKIPA	W3,T1		;NO OF WORDS IN THIS BLOCK
FXHLD1:	PUSHJ	P,D.IN1		;GET NEXT WORD
	AOBJP	W2,FXHLD3	;RAN OUT OF SPACE
FXHLD2:	MOVEM	W1,(W2)		;STORE IT
	SOJGE	W3,FXHLD1	;LOOP FOR ALL OF BLOCK
	POPJ	P,		;GET NEXT BLOCK

FXHLD3:	SUBI	W2,.IPS		;BACKUP POINTER TO START OF BLOCK
	SKIPE	FX.LB		;LIST IN DY IF NOT SETUP
	CAMGE	W2,FX.LB	;IS LIST IN FX OR DY
	TLOA	W2,-1		;IN DY
	SUB	W2,FX.LB	;IN FX, REMOVE OFFSET
	MOVEI	T2,.IPS		;GET NEXT BLOCK
	PUSHJ	P,FX.GET##	;IN FIXUP AREA
	TLZN	W2,-1		;WAS IT IN DY
	ADD	W2,FX.LB	;NO, PUT BACK OFFSET
	EXCH	T1,W2		;NEW POINTER IN W2, OLD IN T1
	MOVE	T2,W2		;COPY IT
	SUB	T2,FX.LB	;REMOVE OFFSET
	.JDDT	LNKLOD,FXHLD3,<<CAMN T2,$FIXUP##>>	;[632]
	SUB	T2,LW.FX	;INCASE PAGING
	MOVEM	T2,(T1)		;FIXUP POINTER
	HRLI	W2,-.IPS	;FORM AOBJN POINTER
	AOBJN	W2,FXHLD2	;STORE CURRENT WORD IN NEW BLOCK
;HERE WHEN END BLOCK FOUND

T5FND:	MOVEI	T1,2		;ONLY STORE FIRST 3 WORDS
	PUSHJ	P,FXHLD0
	PUSH	P,W1		;SAVE HIGH SEG BREAK
	PUSHJ	P,FXHLD1	;FINISH OFF BLOCK
	POP	P,W1		;DATA WORD BACK
				;NOW GET FIRST BLOCK BACK
	POP	P,W2
	HRLM	W1,3(W2)	;NOW WE HAVE A VALID BREAK
T5FND1:	PUSH	P,DCBUF		;STACK REAL BUFFER HEADER
	PUSH	P,DCBUF+1
	PUSH	P,DCBUF+2
	MOVEI	T1,.IPS-1	;MAX NO. OF WORDS IN BUFFER
	MOVEM	T1,DCBUF+2
	HRRM	W2,DCBUF+1	;NEW BUFFER HEADER
	SETZM	DCBUF		;SIGNAL INCORE
	JRST	LOAD		;AND TRY AGAIN
;HERE TO GET NEXT BUFFER
;MOVE IT FROM FX AREA TO DY AREA (FIXED ADDRESS)

FXRED1:	PUSHJ	P,FXREAD	;CALLED FROM D.INP
	JRST	D.IN1		;SO RETURN THERE

FXRED2:	PUSHJ	P,FXREAD	;CALLED FROM D.READ
	JRST	D.RED1		;SO RETURN TO THE CALLER

FXREAD:	PUSHJ	P,.PSH4T##	;NEED SOME TEMP ACCS
	HRRZ	T1,DCBUF+1	;GET FINAL BYTE POINTER
	SUBI	T1,.IPS-1	;BACKUP
	HRRM	T1,DCBUF+1
	MOVEI	T2,.IPS-1	;NO OF WORDS IN BUFFER
	MOVEM	T2,DCBUF+2
	SKIPN	T1,(T1)		;GET FIRST WORD (POINTER)
	HALT
	SKIPE	PAG.FX		;PAGING?
	HALT
	.JDDT	LNKLOD,FXREAD,<<CAMN T1,$FIXUP##>>	;[632]
	ADD	T1,FX.LB	;ADD IN BASE
	HRRZ	T2,DCBUF+1	;ADDRESS OF FIXED DY AREA ARRAY
	HRLZ	T3,T1		;FROM
	HRR	T3,T2		;TO
	BLT	T3,.IPS-1(T2)	;UNTIL
	MOVEI	T2,.IPS		;NOW GIVE BACK
	PUSHJ	P,FX.RET##
	PUSHJ	P,.POP4T##	;RESTORE T1-T4
	POPJ	P,		;AND RETURN

;HERE WHEN ALL DONE
T5FIN::	PUSHJ	P,FX.GBC##	;GARBAGE COLLECT FX AREA
	HRRZ	T1,DCBUF+1	;WHERE WE ARE NOW
	ADD	T1,DCBUF+2	;+ WHATS LEFT
	SUBI	T1,.IPS-1	;BACKUP
	SKIPE	(T1)		;BETTER HAVE FINISHED
	HALT
	MOVEI	T2,.IPS		;GIVE BLOCK BACK
	PUSHJ	P,DY.RET##
	POP	P,DCBUF+2
	POP	P,DCBUF+1
	POP	P,DCBUF
	JRST	T.LOAD		;GET NEXT BLOCK
SUBTTL	HERE TO TERMINATE LOAD


GO::	PUSHJ	P,LIBRARY	;LOAD DEFAULT LIBS
	MOVE	T1,SYMSEG	;GET /SYMSEG
	SKIPN	NOSYMS		;NO SYMBOLS AVAILABLE?
	CAIN	T1,$SSGNONE	;[1201] USER GIVE /SYMSEG:NONE?
	JRST	[SETZM	SYMSEG	;YES, TELL LNKXIT
		JRST	GOSTRT]	;DEFINE START ADDRESS
	JUMPN	T1,GOSTRT	;OK IF USER SPECIFIED
IFN TOPS20,<
	MOVEI	T1,$SSGLOW	;[1201] OTHERWISE, DEFAULT TO LOW
	MOVEM	T1,SYMSEG	;STORE FOR LNKXIT
> ;END IFN TOPS20
GOSTRT:	SKIPN	W2,STADDR+1	;IS START ADDRESS STILL SYMBOLIC?
	JRST	GOUPTO		;[1175] NO
	MOVX	W1,PT.SGN!PT.SYM
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED BY NOW
	  JRST	E$$USA		;[1175] UNDEFINED
	  JRST	E$$USA		;[1175] UNDEFINED
	MOVE	T1,2(P1)	;GET VALUE
	ADDM	T1,STADDR	;CALCULATE VALUE
	SETZM	STADDR+1	;NOW KNOWN
	JRST	GOUPTO		;[1175] GO CHECK /UPTO
;HERE WHEN THE START ADDRESS IS UNDEFINED.

E$$USA::.ERR.	(MS,.EC,V%L,L%W,S%W,USA,<Undefined start address >) ;[1174]
	.ETC.	(SBX,.EP,,,,W2) ;[1174]
	SETZM	STADDR		;[1175] CLEAR ADDRESS
	SETZM	STADDR+1	;[1175] ...


;NOW TO CHECK THE /UPTO SYMBOL, IF ANY

GOUPTO:	MOVE	W2,SYMLIM	;[1175] GET /UPTO VALUE
	TXNN	W2,77B5		;[1175] SYMBOLIC?
	JRST	GOUSYM		;[1175] NO
	MOVX	W1,PT.SGN!PT.SYM	;[1175] FLAGS
	PUSHJ	P,TRYSYM##	;[1175] SEE IF DEFINED
	  JRST	E$$UUA		;[1175] NO
	  JRST	E$$UUA		;[1175] NO
	MOVE	T1,2(P1)	;[1175] YES, FETCH VALUE
	MOVEM	T1,SYMLIM	;[1175] STORE FOR LNKXIT
	JRST	GOUSYM		;[1175] GO CHECK UNDEFINED SYMBOLS


;HERE IF THE /UPTO ADDRESS IS UNDEFINED.

E$$UUA::.ERR.	(MS,.EC,V%L,L%W,S%W,UUA,<Undefined /UPTO: address >)
	.ETC.	(SBX,.EP,,,,W2)	;[1175]
	SETZM	SYMLIM		;[1175] NO LIMIT
	; ..
	; ..

;HERE TO MAKE A LAST-DITCH TRY AT DEFINING THE LAST UNDEFINED SYMBOL.

GOUSYM:	SKIPN	USYM		;STILL SOME UNDEFS?
	JRST	LODXIT		;NO, GIVE UP
	MOVX	W1,PT.SGN!PT.SYM	;MIGHT BE ALGOL REFERENCE
	MOVE	W2,['%OWN  ']
	SETZ	W3,
	PUSHJ	P,TRYSYM##	;SEE IF PENDING REQUEST
	  CAIA			;NOT IN TABLE
	  JRST	DEFOWN		;YES, NEEDS DEFINING


;HERE TO EXIT
;GO EITHER TO LNKMAP OR LNKXIT

LODXIT:	SKIPE	USYM		;ANY UNDEFINED SYMBOLS?
	PUSHJ	P,LODUGS	;[1174] PRINT UNDEFINED GLOBALS MESSAGE
	HLRZ	P1,INCPTR	;GET GLOBAL INCLUDE POINTER
	JUMPN	P1,[TLO	P1,100	;SET LH POSITIVE AS ERROR
		MOVEI	T1,[ASCIZ	\?LNKIMM \]
		PUSHJ	P,MISNG1##
		JRST	.+1]	;AND REENTER MAIN STREAM
	RELEASE	DC,		;CLOSE INPUT I/O
	MOVEI	T1,DC		;FINISHED WITH INPUT BUFFERS NOW
	MOVEM	T1,IO.CHN
	PUSHJ	P,DVRET.##	;RETURN TO FREE POOL
	SETZM	IO.PTR+DC	;FORGET ABOUT IT
	PUSHJ	P,LODFIX	;DO ALL FIXUPS WE NEED
	PUSHJ	P,ALGCHK	;SEE IF ALGOL SYMBOL FILE NEEDED
	MOVEI	T3,1		;[704] USED FOR LOOP CONTROL IN SRT.RC
	PUSHJ	P,SRT.RC	;[704] YES, GO SORT THE RELOC TABLES
	MOVE	T1,MAPSW	;SEE IF WE NEED A MAP
	CAME	T1,[$MAPEND]	;AT THE END
	JRST	LNKXIT		;NO
	JRST	LNKMAP		;YES

LODUGS:	MOVE	T1,[PUSHJ P,UNDNXT##] ;[1174] SET UP NEXT SYMBOL ROUTINE
	MOVEM	T1,NXTGLB	;[1174]   ..
	MOVE	W3,HT.PRM	;[1174] SET UP INDEX TO HASH TABLE
	ADDI	W3,1		;[1174] START 1 UP FOR SOSGE IN UGSNXT
E01UGS::.ERR.	(MS,.EC,V%L,L%F,S%C,UGS) ;[1174]
	.ETC.	(JMP,,,,,.ETUGS##) ;[1174] PRINT UNDEF'ED GLOBALS AND RETURN
;[704] HERE TO SORT THE PSECT RELOCATION TABLES BY ORDER OF
;[704] THEIR ORIGINS BEFORE DOING THE MAP OR EXIT.
;[704] USES T1,T2,T3,W1 AND R
;[747] ONCE THE SORT IS DONE, UPDATE LOWLOC and then
;[746] jump to check PSECT boundaries for any overlap.
 
SRT.RC:	CAML	T3,RC.NO	;[704] FINISHED?
	JRST	CHKLLC		;[747] YES, UPDATE LOWLOC
	MOVE	R,RC.NO		;[704] NO, START FROM THE END
SRT.R2:	MOVE	T1,@RC.TB	;[704] GET TABLE ADDRESS
	SUBI	R,1		;[704] NEXT TABLE DOWN
	MOVE	T2,@RC.TB	;[704] ITS ADDRESS
	MOVE	W2,T2		;[704] SAVE IT ALSO IN W2, INCASE OF EXCHANGE
	MOVE	W1,RC.IV(T1)	;[704] GET ORIGIN OF FIRST ONE
	CAMGE	W1,RC.IV(T2)	;[704] COMPARE WITH THE ORIGIN OF THE SECOND
	JRST	[ADDI	R,1		;[704] FIRST ON IS LESS, SO SWAP
		EXCH	W2,@RC.TB	;[704] THE TABLE ADDRESSES
		SUBI	R,1		;[704]
		MOVEM	W2,@RC.TB	;[704]
		JRST	.+1]		;[704]
	JUMPG	R,SRT.R2		;[704] LOOP BACK IF MORE TABLES
	AOJA	T3,SRT.RC		;[704] LOOP FOR ANOTHER SORT PASS


;[747] HERE TO UPDATE LOWLOC.

CHKLLC:	SKIPN	LOWLOC		;[747] IF LOWLOC IS ZERO ALREADY
	JRST	CHKLL1		;[760][747] DON'T NEED TO CHECK
	SETZ	R,		;[747] GET .ABS.
	MOVE	T1,@RC.TB	;[747]
	MOVE	W1,RC.HL(T1)	;[1215] USE HIGHEST LOC EVER SEEN
	MOVEI 	R,1		;[747]  GET .LOW.
	MOVE 	T2,@RC.TB	;[747]
	MOVE	W2,RC.HL(T2)	;[1215] USE HIGHEST LOCATION EVER SEEN
	IOR	W1,W2		;[747] ANY THING IN EITHER .ABS. OR .LOW.?
	CAILE	W1,140		;[747]
	JRST	[SETZM	LOWLOC	;[747] YES,
		JRST	CHKLL1]	;[760][747] NOW, GO CHECK PSECT OVERLAP
	AOS	R		;[747] NOTHING IN .LOW.
	CAMLE	R,RC.NO		;[1132] NEXT PSECT ORG MUST BE LOWEST
	JRST	[SETZM	LOWLOC	;[1132] NO NEXT, LOWLOC IS ZERO
		JRST	CHKLL1]	;[1132] DONE
	MOVE	T1,@RC.TB	;[1132] GET POINTER TO RC BLOCK
	MOVE	W1,RC.IV(T1)	;[747]
	CAMGE	W1,LOWLOC	;[747]
	MOVEM	W1,LOWLOC	;[747] IN THAT CASE, UPDATE

;FALL THROUGH TO NEXT PAGE
;HERE TO UPDATE HL.S1 FROM PSECT INFO, IF NEEDED

CHKLL1:	MOVE	R,RC.NO		;[1106] POINT TO HIGHEST PSECT
CHKLL2:	MOVE	T1,@RC.TB	;[1106] GET POINTER TO THIS RC BLOCK
	MOVE	T2,RC.SG(T1)	;[1106] GET SEGMENT NUMBER
	CAIN	T2,1		;[1106] LOW SEG?
	JRST	CHKLL3		;[1106] GOT HIGHEST PSECT, GO FIX HL.S1
	SOJGE	R,CHKLL2	;[1106] NO, LOOP OVER OTHER RELOC. COUNTERS
	JRST	CHKLL4		;[1106] NONE FOUND, DONE

;HERE WHEN WE HAVE FOUND THE HIGHEST RC IN THE LOW SEG (A PSECT)
CHKLL3:	SKIPN	T2,RC.HL(T1)	;[1106] GET HL IF AVAILABLE
	MOVE	T2,RC.CV(T1)	;[1106] OR CV IF ITS NOT
	CAMLE	T2,HL.S1	;[1106] POINT BEYOND CURRENT HL.S1?
	MOVEM	T2,HL.S1	;[1106] YES, UPDATE WITH NEW VALUE
CHKLL4:	MOVE	R2,RC.NO	;[1106] USED IN CHKBND FOR LOOP CONTROL
;	JRST	CHKBND		;[760]
;[746] HERE TO CHECK FOR PSECT OVERLAP.  IF OVERLAP IS FOUND
;A WARNING IS OUTPUT AND RETURN.

CHKBND:	MOVE	R,R2		;[760][746] START FROM THE END
	MOVE	T1,@RC.TB	;[760][746] GET RELOC TABLE POINTER
	MOVE	T2,RC.HL(T1)	;[1204] HIGHEST EVER LOADED
	MOVE	T3,RC.CV(T1)	;[1204] WHERE NEXT WORD GOES
	CAMG	T2,[1,,0]	;[1204] TOO BIG?
	CAMLE	T3,[1,,0]	;[1204] MAYBE, IS IT?
	PUSHJ	P,E$$PTL##	;[1204] YES, DIE
	MOVE	W1,RC.IV(T1)	;[746] GET THE ORIGIN
CHKBN1:	SOJLE	R,CHKBN2+1	;[760] CHECK WITH ALL LOWER PSECTS
	MOVE	T2,@RC.TB	;[746] GET TABLE PTR TO PSECT BEFORE
	MOVE	W2,RC.CV(T2)	;[760][746] AND ITS CURRENT VALUE
	CAML	W1,W2		;[746] ANY OVERLAP?
	JRST	CHKBN2		;[760][746] NO, LOOP
	CAMLE	W2,RC.CV(T1)	;[760] MIN OF THE TWO RC.CV'S
	MOVE	W2,RC.CV(T1)	;[760]
	CAMGE	W1,RC.IV(T2)	;[760] MAX OF THE TWO RC.IV'S
	MOVE	W1,RC.IV(T2)	;[760]
	MOVE	T1,RC.NM(T1)	;[746] SET UP TO OUTPUT WARNING
	MOVE	T2,RC.NM(T2)	;[746] GET THE TWO PSECT NAMES
E$$POV::.ERR.	(MS,.EC,V%L,L%W,S%W,POV,<Psects >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,T1) ;[1174]
	.ETC.	(STR,.EC,,,,,< and >)
	.ETC.	(SBX,.EC!.EP,,,,T2) ;[1174]
	.ETC.	(STR,.EC,,,,,< overlap from address >) ;[1212]
	.ETC.	(OCT,.EC!.EP,,,,W1) ;[1174]
	.ETC.	(STR,.EC,,,,,< to >)
	.ETC.	(OCT,.EP,,,,W2) ;[1174]
CHKBN2:	JUMPG	R,CHKBN1	;[760] LOOP DOWN IF MORE IN THIS SWEEP
	SOJG	R2,CHKBND	;[760] NEXT PSECT
	POPJ	P,		;[760] ALL DONE
LODFIX::SKIPN	W1,LINKTB	;ANY BLOCK TYPE 12 LINKS?
	JRST	B12NOT		;NO
	HRLI	W1,-LN.12	;FORM AOBJN WORD
B12LUP:	HLRZ	T2,(W1)		;GET END ADDRESS
	JUMPE	T2,B12END	;NONE
	HRRZ	W3,(W1)		;LAST ADDRESS
	PUSHJ	P,SEGCHK	;GET IN CORE ADDRESS
	  JRST	[HRLI	T2,CPF.RR	;NOT IN CORE
		PUSHJ	P,SY.CHP	;SO PUT IN FIXUP LIST
		JRST	B12END]		;AND RETURN FOR NEXT
	HRRM	W3,(T2)		;STORE IN CORE
B12END:	AOBJN	W1,B12LUP	;LOOP FOR ALL ITEMS
	HRRZ	T1,LINKTB	;ADDRESS  OF TABLE
	MOVEI	T2,LN.12	;LENGTH
	PUSHJ	P,DY.RET##	;GIVE IT BACK
	SETZM	LINKTB		;[737] CLEAR POINTER
B12NOT:	SKIPN	P1,PRGPTR	;ANY BLOCK TYPE 16 TO RETURN?
	JRST	B16NOT		;NO
B16RET:	MOVEI	T1,(P1)		;ADDRESS
	MOVEI	T2,4		;SIZE
	HRRZ	P1,(P1)		;NEXT
	PUSHJ	P,DY.RET##	;RETURN SPACE
	JUMPN	P1,B16RET	;LOOP
	SETZM	PRGPTR		;[1103] REMEMBER THAT WE'RE DONE
B16NOT:	PJRST	COR.FX		;FIXUP ALL CODE CHAINS
;HERE TO SETUP FILE/SYMBOL:ALGOL IF NEEDED, AND STORE THE
;FILESPEC IN THE FIRST ALGOL OWN BLOCK SEEN THIS LOAD


ALGCHK:	SKIPN	NOSYMS		;/NOSYMS? (AFTER 1044 SEEN)
	  JRST	ALGCH2		;NO
ALGCH1:	MOVEI	T1,AC		;POINT TO ALGOL CHANNEL
	SKIPE	PAG.AS		;AS AREA PAGING?
	PUSHJ	P,DVDEL.##	;YES, DELETE OVERFLOW FILE
	SETZM	LW.AS		;ZAP PAGING POINTERS
	SETZM	UW.AS		;..
	MOVEI	T1,AS.IX	;NOW DELETE AREA
	PJRST	XX.ZAP##	;SO LNKXIT WILL HAVE MORE ROOM

;HERE IF NOT /NOSYMBOLS
ALGCH2:	SKIPE	T1,SYMFRM	;USER SAY /SYMBOL?
	CAIN	T1,2		;YES, /SYMBOL:ALGOL?
	  CAIA			;YES, GIVE IT TO HIM
	JRST	ALGCH1		;NO, FORGET WE EVER SAW 1044
	JUMPN	T1,ALGCH3	;DON'T DEFAULT IF USER SPECIFIED
	MOVX	T1,ALGBIT	;GET BIT FOR ALGOL
	TDNE	T1,MNSEEN	;SEEN AN ALGOL MAIN PROGRAM?
	SKIPN	AS.LB		;AND SOME ALGOL SYMBOLS?
	  JRST	ALGCH1		;NO
	MOVEI	T1,2		;DEFAULT TO /SYMBOL:ALGOL
	MOVEM	T1,SYMFRM	;SINCE USER DIDN'T SAY
	MOVEI	T2,F.LEN	;NEED A TEMP IO DATA BLOCK
	PUSHJ	P,DY.GET##	;FROM THE DY AREA
	MOVE	P1,T1		;SAVE ADDR FOR DV.OUT
	MOVE	T1,LODNAM	;USE MAIN PROG NAME AS FILE NAME
	MOVEM	T1,F.NAME(P1)	;SAVE IN BLOCK
	MOVSI	T1,'SYM'	;EXTENSION '.SYM'
	MOVEM	T1,F.EXT(P1)	;SAVE FOR LNKFIO
	PUSHJ	P,DVOUT.##	;MAKE SCAN BLOCK INTO IO BLOCK
	  %SC,,.IODPR		;SYMBOL CHANNEL, DUMP RECORDS MODE
	MOVE	T1,P1		;DONE WITH SCAN BLOCK
	MOVEI	T2,F.LEN	;SO RETURN IT TO DY AREA
	PUSHJ	P,DY.RET##	;..
ALGCH3:	SKIPN	SYMSEG		;USER SPECIFY WHERE SYMBOLS GO?
	AOS	SYMSEG		;NO, PUT THEM IN LOW SEG (ALGOL 7)
	SKIPN	P3,ASFILE	;LOW ADDRESS OF DESCRIPTOR
	  POPJ	P,		;NO TYPE 15 SEEN, DON'T FILL IN
	MOVEI	P2,LN.ABL(P3)	;TOP ADDRESS OF DESCRIPTOR
	SKIPE	PAG.S1		;PAGING LOWSEG?
	PUSHJ	P,PG.LSG	;YES, MAKE SURE BLOCK ADDRESSABLE
	ADD	P3,LC.LB	;MAKE ABSOLUTE PHYSICAL ADDRESS
	HRRZ	T1,IO.PTR+%SC	;ADDRESS OF FILE INFO
	MOVE	T2,I.DEV(T1)	;GET DEVICE OUT OF IO BLOCK
	MOVEM	T2,0(P3)	;MAKE 1ST WORD OF OTS DESCRIPTOR
	MOVE	T2,I.NAM(T1)	;SAME FOR FILE NAME
	MOVEM	T2,1(P3)	;IT BECOMES 2ND WORD
	HLLZ	T2,I.EXT(T1)	;EXTENSION...
	MOVEM	T2,2(P3)	;...INTO 3RD WORD
	SKIPN	T2,I.PPN(T1)	;GET PPN IF SPECIFIED
	  JRST	ALGCH5		;NOT, USE DEFAULT PATH
	TLNE	T2,-1		;POINTER TO PATH?
	JRST	ALGCH4		;NO
	SKIPN	T3,2(T2)	;YES, GET PPN
	MOVE	T3,PTHDIR	;OR DEFAULT PATH IF NOT SPECIFIED
	MOVEM	T3,3(P3)	;STORE AS WORD 4 FOR ALGOL
	MOVSI	T3,3(T2)	;MAKE BLT POINTER FOR SFD'S
	HRRI	T3,4(P3)	;INTO WORDS 5-9 OF BLOCK
	BLT	T3,11(P3)	;COPY SFD'S & TRAILING ZERO
	POPJ	P,		;FINISHED

ALGCH4:	MOVEM	T2,3(P3)	;STORE PPN IN CORE
	SETZM	4(P3)		;INDICATE NO SFD'S
	POPJ	P,		;DONE

ALGCH5:	MOVSI	T2,PTHDIR	;WANTS DEFAULT - BLT OUR DEFAULT
	HRRI	T2,3(P3)	; PATH INTO THE ALGOL OWN BLOCK
	BLT	T2,11(P3)	;BLLLLLLLLLLIIIIIIIITTTTTTTT
	POPJ	P,		;DONE AT LAST
LIBRARY::
	POP	P,T1		;RESTACK TOP 2 ITEMS
	EXCH	T1,(P)		;SO WE RETURN TO MAIN CALLER
	PUSH	P,T1		;UNTIL ALL LOADED
IFN FTOVERLAY,<
	SKIPE	OVERLW		;SEEN /OVERLAY?
	SKIPL	LNKMAX		;AND STILL IN ROOT?
	JRST	PRGTST		;NO
	TDO	FL,[L.LIB,,R.LIB]	;FORCE LIBRARY SEARCH MODE
	PUSHJ	P,QREENT	;WANT REENTRANT VERSION?
	  CAIA			;NO, LOAD AS IS
	TRO	FL,R.FLS	;YES, FORCE LOW SEG
	MOVEI	T2,F.LEN	;GET SPACE
	PUSHJ	P,DY.GET##	;FOR FILE SPEC
	MOVSI	T3,'SYS'	;DEFAULT DEVICE
	MOVE	T4,['OVRLAY']	;FILE NAME
	DSTORE	T3,F.DEV(T1),F.NAME(T1)
	MOVSI	T3,'REL'
	SETOM	F.NAMM(T1)	;SET MASK
	HLLOM	T3,F.EXT(T1)
	PUSHJ	P,LNKPRG	;PUT IN LIST
;	JRST	PRGTST
>
PRGTST:	SKIPG	PRGPTR		;ANYTHING TO DO HERE
	JRST	LIBTST		;NO, SEE IF ANY LIBRARIES
	TDZ	FL,[L.LIB,,R.LIB]	;INCASE WE WERE IN SEARCH MODE
	PUSH	P,P1		;NEED AN ACC
	MOVE	P1,PRGPTR	;GET START
PRGTS1:	SKIPGE	(P1)		;WANT THIS ONE?
	JRST	PRGTS2		;NO, ALREADY LOADED
	MOVEI	T2,F.LEN	;GET SPACE FOR DATA BLOCK
	PUSHJ	P,DY.GET##
	MOVE	T2,P1		;GET POINTER TO TYPE 16 BLOCK
	PUSHJ	P,PRGLIB	;TRANSFORM AND LINK IN
	HRROS	(P1)		;MARK AS LOADED
PRGTS2:	HRRZ	P1,(P1)		;GET NEXT ADDRESS
	JUMPN	P1,PRGTS1	;NOT DONE YET IF NON-ZERO
	HRROS	PRGPTR		;MARK WHOLE LIST DONE
	POP	P,P1
	PUSHJ	P,NXTLIB	;SETUP RETURN ADDRESS
	JRST	PRGTST		;SEE IF WE LOADED ANY MORE TYPE 16 BLOCKS

LIBTST:	SKIPN	LIBPTR		;ANY LIBRARIES
	JRST	USETST		;NO TRY USER DEFAULT LIBRARY(S)
	SKIPN	USYM		;YES, BUT ANY NEED FOR THEM
	JRST	REMLIB		;NO REMOVE THE SPACE THEY OCCUPY
	TDO	FL,[L.LIB,,R.LIB]	;GET INTO LIBRARY SEARCH MODE
	MOVEI	T2,F.LEN	;GET SPACE FOR DATA BLOCK
	PUSHJ	P,DY.GET##
	MOVE	T2,LIBPTR	;GET POINTER TO TYPE 17 BLOCK
	PUSHJ	P,PRGLIB	;TRANSFORM AND LINK IN
	MOVE	T1,LIBPTR	;GET POINTER BACK
	MOVE	T2,(T1)		;GET NEXT ADDRESS
	MOVEM	T2,LIBPTR	;AND STORE IT (ZERO IS END)
	MOVEI	T2,4		;GIVE BACK BLOCK
	PUSHJ	P,DY.RET##
	SKIPN	LIBPTR		;NOT DONE YET IF NON-ZERO
	PUSHJ	P,NXTLIB
	JRST	PRGTST		;INCASE WE LOADED ANY MORE TYPE 16 OR 17
;HERE FOR USER DEFINED DEFAULT LIBRARIES

USETST:	SKIPE	USYM		;ANY UNDEFS LEFT?
	SKIPG	USEPTR		;ANY LIBRARIES
	JRST	DEFTST		;NO, TRY SYSTEM DEFAULTS
	HRROS	USEPTR		;ONLY ONCE THOUGH
	PUSH	P,P1		;NEED A SAFE ACC
	MOVE	P1,USEPTR	;TO HOLD PTR TO LIST
USETS1:	MOVX	T1,1B0
	MOVN	T2,1(P1)	;GET LANGUAGE TYPE
	JUMPE	T2,USETS2	;ALWAYS WANTED
	LSH	T1,(T2)		;SHIFT INTO POSSITION
	TDNN	T1,PROCSN	;HAVE WE LOADED THIS TYPE?
	JRST	USETS3		;NO, GIVE IT A MISS
USETS2:	MOVEI	T2,F.LEN	;SPACE WE NEED
	PUSHJ	P,DY.GET##	;FOR LOOKUP BLOCK
	ADDI	T2,-1(T1)	;END OF BLT
	MOVEI	T3,2(T1)	;BYPASS FIRST 2 WORDS
	HRLI	T3,2(P1)	;BLT PTR
	BLT	T3,(T2)		;MOVE TO TEMP BLOCK
	PUSHJ	P,LNKPRG	;PUT IN LIST
USETS3:	HRRZ	P1,(P1)		;GET NEXT
	JUMPN	P1,USETS1	;DO IT
	POP	P,P1
	TDO	FL,[L.LIB,,R.LIB]	;[613] MAKE SURE IN /SEARCH MODE
	PUSHJ	P,NXTLIB	;[613] LOAD THE USER LIBRARIES
;	JRST	DEFTST		;NOW FOR SYSTEM DEFAULT LIBS
DEFTST:	SKIPN	USYM		;ANYTHING TO DO?
	JRST	DEFXIT		;NO, RETURN TO LNKOV1 OR LNKLOD
	TDO	FL,[L.LIB,,R.LIB]	;MAKE SURE
	PUSHJ	P,DEFLOD	;YES, TRY DEFAULT LIBS
	PUSHJ	P,NXTLIB
	SKIPG	PRGPTR		;SEE IF WE LOADED ANYMORE 16
	SKIPE	LIBPTR		;OR 17 BLOCKS
	JRST	PRGTST		;YES, CYCLE AGAIN
	SKIPE	LIBPRC		;DID WE LOAD ANYTHING?
	JRST	DEFTST		;YES, TRY AGAIN
	MOVX	W1,PT.SGN!PT.SYM	;FLAGS
	MOVE	W2,['%OWN  ']	;SYMBOL
	SETZ	W3,		;TRY AGAIN FOR %OWN
	PUSHJ	P,TRYSYM##
	  CAIA			;NOT IN TABLE
	  JRST	DEFOWN		;UNDEFINED
DEFXIT:	SETZM	GOTO		;BACK TO NORMAL SCANNING
	HRRZS	USEPTR		;BACK AS IT WAS
TPOPJ:	POP	P,T1		;REMOVE TOP RETURN
	POPJ	P,		;RETURN TO REAL CALLER

DEFOWN:	MOVE	W3,%OWN		;GET BASE
	PUSHJ	P,SY.GS##	;DEFINE
	JRST	DEFXIT


NXTLIB:	POP	P,GOTO		;STORE RETURN ADDRESS
	JRST	LNKWLD		;AND LOAD THIS
PRGLIB:	DGET	T3,<R.DEV(T2)>,<R.NAM(T2)> ;GET DEV & FILE NAME
	DSTORE	T3,F.DEV(T1),F.NAME(T1)
	SETOM	F.NAMM(T1)	;SET MASK
	MOVE	T3,R.EXT(T2)	;GET USER EXTENSION
	HLLOM	T3,F.EXT(T1)	;STORE WITH -1 MASK
	MOVX	T4,FX.DIR	;[672] BIT THAT SAYS DIR SPECIFIED
	MOVEM	T4,F.MODM(T1)	;[672] SAY TO LOOK AT IT
	SKIPE	T3,R.PPN(T2)	;[672] GET PPN, IF ANY
	MOVEM	T4,F.MOD(T1)	;[672] THERE WAS, REMEMBER IT
	MOVEM	T3,F.DIR(T1)
	SETOM	F.DIRM(T1)	;MUST MATCH EXACTLY
	HRLI	T2,-5		;SET UP TO COPY ANY SFD'S
	MOVE	T4,T1
PRGSFD:	SKIPN	T3,R.SFD(T2)	;ANY MORE THERE?
	  JRST	LNKPRG		;NO...WE'RE DONE
	MOVEM	T3,F.SFD(T4)	;STORE THE SFD
	SETOM	F.SFDM(T4)	;MUST MATCH EXACTLY
	ADDI	T4,2		;SFD'S COME IN BIWORDS FOR SCAN
	AOBJN	T2,PRGSFD	;LOOP FOR ALL SFD'S
				;NOW TO LINK INTO LIST
LNKPRG:	SKIPN	F.INZR		;FIRST TIME?
	JRST	FSTPRG		;YES
	MOVE	T2,F.NXZR	;GET CURRENT
	MOVEM	T1,(T2)		;STORE FORWARD POINTER
	MOVEM	T1,F.NXZR	;AND POINT TO IT
	POPJ	P,


FSTPRG:	MOVEM	T1,F.INZR	;SET FIRST POINTER
	MOVEM	T1,F.NXZR	;AND CURRENT
	POPJ	P,
DEFLOD:	MOVE	T1,NOLIBS	;GET MASK OF PROCESSORS NOT TO LOOK AT
	ANDCAM	T1,LIBPRC
	SKIPE	@GS.LB		;LOAD JOBDAT UNLESS LOADED ORIGINALLY BY DEFAULT
	JRST	DEFLD2		; OR IF BEEN THROUGH LOOP ONCE ALREADY
	MOVE	P1,['JOBDAT']
	PUSHJ	P,LOAD1		;LOAD JOBDAT
	SETOM	@GS.LB		; BUT ONLY ONCE
DEFLD2:	HLRZ	T1,MNTYPE	;GET COMPILER OF MAIN PROG
	JUMPE	T1,DEFLD1	;NO MAIN (MAYBE 2ND TIME ROUND)
	MOVE	T2,CT.BIT(T1)	;GET CORRESPONDING BIT
	ANDCAM	T2,LIBPRC	;REMOVE FROM LIST TO LOOK AT
	IORM	T2,MNSEEN	;[614] A NEW MAIN PROG TYPE SEEN
	TDNN	T2,NOLIBS	;NOT TO SEARCH THIS LIBRARY?
	PUSHJ	P,@MNTBL(T1)	;DO WHAT WE HAVE TO FOR IT
DEFLD1:	SKIPN	T1,LIBPRC	;GET LIST OF OTHER  PROCS SEEN
	POPJ	P,		;ALL DONE
	JFFO	T1,.+1		;GET LEADING BIT
	MOVE	T1,CT.BIT(T2)	;GET BIT
	ANDCAM	T1,LIBPRC	;CLEAR IT
	PUSHJ	P,@PRCTBL(T2)	;DO ACTION FOR THIS PROCESSOR
	JRST	DEFLD1		;LOOP
;HERE TO SEE IF LIBRARY IS ALREADY REQUESTED
;IF NOT PUT IN LIST OF FILES TO LOAD (IN SEARCH MODE)
;ENTER WITH P1 = SIXBIT \FILE.NAME\

LOAD1:	SKIPN	T1,F.INZR	;GET BASE OF LIST
	JRST	LOAD2		;NO LIST NO REQUESTS YET
	CAMN	P1,F.NAME(T1)	;ALREADY IN LIST
	POPJ	P,		;YES JUST RETURN
	MOVE	T1,F.NXT(T1)	;GET NEXT POINTER
	JUMPN	T1,.-3		;TRY IT
LOAD2:	MOVEI	T2,F.LEN	;GET SPACE
	PUSHJ	P,DY.GET##	;FOR DATA BLOCK
	MOVSI	T2,'SYS'	;ALL DEFAULT LIBS LIVE ON SYS (FOR NOW)
	MOVEM	T2,F.DEV(T1)
	MOVEM	P1,F.NAME(T1)	;STORE NAME
	SETOM	F.NAMM(T1)		;SET MASK
	MOVSI	T2,'REL'	;DEFAULT EXT IS REL
	HLLOM	T2,F.EXT(T1)
	PJRST	LNKPRG		;PUT IN LIST AND RETURN

REMLIB:	SKIPN	T1,LIBPTR	;GET SPACE TO REMOVE
	JRST	DEFXIT		;ALL DONE
	MOVE	T2,(T1)		;GET NEXT BLOCK
	HRRZM	T2,LIBPTR	;RESET POINTER
	MOVEI	T2,4		;SIZE OF BLOCK
	PUSHJ	P,DY.RET##	;GIVE IT BACK
	JRST	REMLIB		;LOOP
DEFINE X(A,B,C)<
 IF1,<
	BLOCK 1
 >
 IF2,<
  IFDEF B'.L0,<
	EXP	B'.L0
  >
  IFNDEF B'.L0,<
	EXP	CPOPJ
>>>
;HERE FOR TABLE FOR MAIN COMPILER
	XALL
MNTBL:	PROCESSORS
;HERE FOR ALL OTHER PROCESSORS SEEN
DEFINE X(A,B,C)<
 IF1,<
	BLOCK	1
 >
 IF2,<
  IFDEF B'.L1,<
	EXP	B'.L1
  >
  IFNDEF B'.L1,<
	EXP	CPOPJ
>>>

PRCTBL:	PROCESSORS
	SALL
;HERE TO DO SPECIAL ACTION FOR SOME PROCESSORS

F40.L0:	SKIPL	FORLIB		;SEE WHICH LIBRARY WE WANT
	JRST	FORL00		;NEW FOROTS
IFN FMXFOR,<
	MOVE	T1,PROCSN	;GET LIST OF PROCESSORS SEEN
	TXNN	T1,XFRBIT	;[1203] EXTENDED FORTRAN CODE?
	TXNE	T1,FORBIT	;HAVE WE SEEN ANY FORTRAN-10 CODE?
	JRST	FOR.L2		;YES, NEED FOROTS THEN?
>
	PUSHJ	P,QREENT	;SEE IF WE WANT REENT OTS
	  JRST	F40L11		;NO
	MOVE	P1,['IMP40 ']	;LOAD REENT PART
	PUSHJ	P,LOAD1	
F40.L1:	SKIPL	FORLIB		;WANT FOROTS?
	JRST	FORL00		;YES
F40L11:	MOVE	P1,['LIB40 ']	;AND NON-RENT PART
	PJRST	LOAD1
FOR.L0:	SKIPL	FORLIB		;TEST TO SEE IF USER GAVE /FORSE
	JRST	FORL00		;NO
IFN FMXFOR,<
FOR.L2:>
IFL .FORLB,<
	AOSE	FORLIB		;SEE IF SET BY SWITCH OR DEFAULT
	JRST	FORL02		;DEFAULT, DON'T PRINT MESSAGE
>
E$$FSI::.ERR.	(MS,0,V%L,L%W,S%W,FSI,<FORTRAN requires FOROTS, /FORSE switch ignored>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
FORL02:	SETZM	FORLIB		;IGNORE STUPID USER REQUEST
FORL00:	IFN FMXFOR,<
	MOVE	T1,PROCSN	;GET PROCESSORS SEEN
	SKIPE	MIXFOR		;IF WE DON'T WANT MIXFOR FIXUP
	TXNN	T1,F40BIT	;OR NO F40 CODE LOADED
	JRST	FORL01		;DON'T NEED FORJAK
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['FORSE.']	;GET IT BY REQUESTING FORSE
	SETZ	W3,
	PUSHJ	P,SY.RQ##	;GENERATE REQUEST
FORL01:>
	PUSHJ	P,QREENT	;SEE IF WE WANT REENT OTS
	  JRST	FOR.L1		;NO
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['FOROT%']	;SPECIAL SYMBOL
	MOVEI	W3,400000+.JBHDA	;VALUE
	PUSHJ	P,SY.GS##	;DEFINE IT
	PUSHJ	P,FOR.L1	;[1200] PUT FORLIB IN LIST OF LIBRARIES
	; ..
;SINCE WE'RE LOADING REENTRANT FOROTS, LOAD SYS:FORLIB/SEGMENT:LOW.
;THIS IS REQUIRED BY FOROTS VERSION 6 AND LATER.

	MOVE	P2,F.NXZR	;[1200] LAST LIBRARY PUT ON LIST
	CAMN	P1,F.NAME(P2)	;[1200] WAS IT FORLIB?
	SKIPE	F.SWP(P2)	;[1200] WITH NO SWITCHES YET?
	POPJ	P,		;[1200] NO, RETURN FROM FOR.L0
	MOVEI	T2,3		;[1200] YES, ALLOCATE A SWITCH BLOCK
	PUSHJ	P,DY.GET##	;[1200] IN DY AREA
	MOVEM	T1,F.SWP(P2)	;[1200] PUT SWITCH IN FILE BLOCK
	HRLZM	T2,0(T1)	;[1200] STORE BLOCK SIZE
	DMOVE	T2,[EXP %SEG%,$SSGLOW]	;[1201] SWITCH AND ARGUMENT
	DMOVEM	T2,1(T1)	;[1200] STORE IN SWITCH BLOCK
	POPJ	P,		;[1200] DONE


;DEFINE %SEG%.  MUST CALL SWTCHS MACRO.

	..SEG==0

DEFINE	SWMAC(A,B,C,D,E,F,G,H,I)<

	IFIDN <B>,<SEGMENT>,<%SEG%==..SEG>
	..SEG==..SEG+1>

	SWTCHS			;[1200] LOOK FOR /SEGMENT


;HERE WHEN FORTRAN CODE IS SEEN, BUT NO MAIN PROGRAM.

FOR.L1:	SKIPL	FORLIB		;TEST FOR USER SCREW-UP
	JRST	FORL10		;NO
E01FSI::.ERR.	(MS,0,V%L,L%W,S%W,FSI) ;[1174]
	.ETC.	(STR,,,,,.ETIMF##) ;[1174]
	SETZM	FORLIB
FORL10:	MOVE	P1,['FORLIB']	;COMMON LIBRARY
	PJRST	LOAD1


;HERE WHEN EXTENDED FORTRAN IS SEEN.  SAME AS FORTRAN.

	XFR.L0==FOR.L0		;[1203] MAIN PROGRAM ENTRY
	XFR.L1==FOR.L1		;[1203] ANY CODE SEEN ENTRY
CBL.L0:
CBL.L1:	MOVE	P1,['LIBOL ']
	PJRST	LOAD1
C74.L0:
C74.L1:	MOVE	P1,['C74LIB']
	PJRST	LOAD1

ALG.L0:	PUSHJ	P,QREENT	;SEE IF WE WANT REENT VERSION
	  JRST	ALG.L2		;NO
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['%SHARE']
	SETZ	W3,
	PUSHJ	P,SY.RQ##	;PUT IN REQUEST
ALG.L1:	SKIPE	LODNAM		;SEE THE MAIN PROGRAM YET?
	JRST	ALG.L2		;YES
E$$AMP::.ERR.	(MS,,V%L,L%W,S%W,AMP,<ALGOL main program not loaded>) ;[1174]
ALG.L2:	MOVE	P1,['ALGLIB']
	PJRST	LOAD1

NLI.L0:
NLI.L1:	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['%NELGO']	;DEFINE SYMBOL
	SETZ	W3,		;WITH ZERO VALUE
	PUSHJ	P,SY.RQ##	;PUT IN REQUEST FOR IT
	MOVE	P1,['LIBNEL']	;AND SPECIAL LIBRARY
	JRST	LOAD1		;NOW LOAD IT

BCL.L0:
BCP.L1:	MOVE	P1,['BCPLIB']
	PJRST	LOAD1

SIM.L1:	SKIPE	LODNAM		;MAIN PROGRAM SEEN YET?
	JRST	SIM.L0		;YES
E$$SMP::.ERR.	(MS,,V%L,L%W,S%W,SMP,<SIMULA main program not loaded>) ;[1174]
SIM.L0:	MOVE	P1,['SIMLIB']
	PJRST	LOAD1

QREENT:	MOVE	T1,HL.S1	;[1131] GET CURRENT END OF LOW SEGMENT
	CAIGE	T1,400000-50000	;[1131] SEE IF WITHIN 40 DECIMAL PAGES OF HISEG
	JRST	QREEN1		;[1131] YES--GO TRY TO FOR NON-SHARABLE OTS
	SKIPN	HL.S2		;[574] NON-SHARABLE OTS. HIGH SEG EXIST?
	TDO	FL,[L.FLS,,R.FLS]	;[574] NO, DON'T START ONE
	POPJ	P,		;[574] NON-SKIP RETURN

;HERE IF LOW SEG .LT. 128K. CHECK /OTS AND HI SEG EXISTANCE
QREEN1:	SKIPE	T1,OTSEG	;[574] HAS USER SPECIFIED /OTS?
	SOJE	T1,CPOPJ	;[574] YES, /OTS:NONSHARABLE?
	SKIPN	HL.S2		;[574] NO, GREAT. HIGH SEG EXIST YET?
	AOS	0(P)		;[574] NO, GETSEG OTS AT RUNTIME
	POPJ	P,		;[574] HIGH SEG EXISTS, MUST LOAD OTS
SUBTTL	COMMON I/O ROUTINES


;THESE ROUTINES POP OFF THE RETURN AND GO TO LODNXT ON EOF.

D.IN2::	PUSHJ	P,D.IN1		;GET A WORD
	MOVE	W2,W1		;IN W2
D.IN1::	SOSGE	DCBUF+2		;ANYTHING IN BUFFER?
	JRST	D.INP		;NO DO INPUT
	ILDB	W1,DCBUF+1	;GET NEXT WORD
	POPJ	P,

D.INP::	SKIPN	DCBUF		;IF 0 THEN READING FROM CORE
	JRST	FXRED1		;GET NEXT BUFFER
	PUSHJ	P,D.CNT		;[1101] DO IN UUO AND COUNT BLOCK
	  JRST	D.IN1		;AND RETURN
D.ERR::	STATZ	DC,IO.EOF	;EOF?
	JRST	EOF		;YES
E01EIF::PUSH	P,[DC]		;[1174] SAVE CHANNEL FOR LNKLOG
	.ERR.	(ST,0,V%L,L%F,S%F,EIF) ;[1174]

;THESE ROUTINES ARE LIKE THE CORRESPONDING D.IN? ROUTINES, EXCEPT
;THAT THEY RETURN CPOPJ1 WITH DATA OR CPOPJ ON EOF FROM REL FILE.

D.RED2::PUSHJ	P,D.RED1	;GET A WORD
	POPJ	P,		;NONE TO GET
	MOVE	W2,W1		;SAVE IN W2
D.RED1::SOSGE	DCBUF+2		;ANYTHING IN BUFFER?
	  JRST	D.READ		;NO, GO GET ANOTHER BUFFER
	ILDB	W1,DCBUF+1	;YES, GET THE NEXT DATA WORD
	JRST	CPOPJ1		;AND RETURN IT

D.READ::SKIPN	DCBUF		;READING FROM CORE?
	JRST	FXRED2		;YES, GO GET NEXT BUFFER
	PUSHJ	P,D.CNT		;[1101] DO IN UUO AND COUNT BLOCK #
	  JRST	D.RED1		;THAT WAS EASY
	STATZ	DC,IO.EOF	;EOF?
	POPJ	P,		;YES.
	JRST	D.ERR		;NO, INPUT ERROR
;THIS ROUTINE DOES AN IN UUO AND KEEPS TRACK OF THE CURRENT BLOCK
;NUMBER.  BLOCK NUMBER IS RELATIVE (LIKE USETI) ON DISK, ABSOLUTE
;ON DTA.
;RETURNS +1 IF IN UUO WORKED, +2 IF FAILED (LIKE IN UUO DOES).
;DESTROYS W1 ONLY.


D.CNT:	SKIPN	DTAFLG		;[1101] READING FROM DECtape?
	JRST	D.CNT2		;[1101] NO, JUST AOS THE COUNT FOR DISK

;HERE ON DECtape
	SKIPGE	LSTBLK		;[1101] IS THIS THE FIRST IN FROM DTA?
	JRST	D.CNT1		;[1101] YES, MUST GET THE BLOCK DIFFERENTLY
	MOVE	W1,DCBUF	;[1101] NORMAL CASE, GET PTR TO NEXT
	LDB	W1,[POINT 18,1(W1),17]	;[1101] OUT OF OLD BUFFER
	MOVEM	W1,LSTBLK	;[1101] STORE IN LSTBLK
	JRST	D.CNT3		;[1101] SKIP DISK'S AOS, GO DO IN UUO

;HERE ON FIRST IN FROM DECtape.  GET FIRST BLOCK NUMBER FROM LOOKUP
D.CNT1:	LDB	W1,[POINT 10,FEXT,35]	;[1101] ON FIRST IN,
	MOVEM	W1,LSTBLK	;[1101] GET FROM LOOKUP BLOCK
	JRST	D.CNT3		;[1101] GO DO IN UUO

;HERE ON DISK
D.CNT2:	AOS	LSTBLK		;[1101] ON DISK, JUST AOS LSTBLK
D.CNT3:	IN	DC,		;[1101] DO THE IN UUO
	  POPJ	P,		;[1101] SUCCESS, RETURN
	JRST	CPOPJ1		;[1101] IN UUO SKIPPED, PROPOGATE IT
EOF::	TRZE	FL,R.LOD	;ENS BLOCK SEEN?
	PUSHJ	P,E$$NEB	;[1174] NO GIVE WARNING
	POP	P,(P)		;POP OFF RETURN
EOF1::	SKIPE	XBUF		;USING INDEXED LIBRARY
	PUSHJ	P,ZXBUF		;YES, GET RID OF IT
	JRST	LODNXT		;GET NEXT FILE

E$$NEB::.ERR.	(MS,.EC,V%L,L%W,S%W,NEB,<No end block seen>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	MOVEI	R,1		;NOW TRY TO FIXUP RELOC TABLES
	MOVE	R,@RC.TB	;DO LOW SEG FIRST
	MOVE	T1,RC.HL(R)	;HIGHEST LOC SEEN
	CAMLE	T1,RC.CV(R)	;GREATER THAN CURRENT?
	MOVEM	T1,RC.CV(R)	;STORE HIGHEST
	MOVEI	R,2		;NO FOR HIGH SEGMENT
	SKIPN	R,@RC.TB
	JRST	CPOPJ		;NO HIGH SEG
	MOVE	T1,RC.HL(R)	;HIGHEST LOC SEEN
	CAMLE	T1,RC.CV(R)	;GREATER THAN CURRENT?
	MOVEM	T1,RC.CV(R)	;STORE HIGHEST
	SETZM	LOD37		;[1114] DONE WITH COBOL SYMBOLS
	SETZM	OWNLNG		;[1114]   AND ALGOL OWNS
;	SETZM	VARLNG		;[1114]   AND LVARS
	POPJ	P,

;HERE TO REMOVE XBUF (FAKE BUFFER USED FOR LIBRARY INDEX)

ZXBUF::	HRRZ	T1,XBUF		;ADDRESS IN CORE
	MOVEI	T2,^D128	;SIZE
	SETZM	XBUF		;DONE WITH IT NOW
	PJRST	DY.RET##	;GIVE SPACE BACK AND RETURN

IFN DEBSW,<
$LOCATION::	0		;STORE ADDRESS TO BREAK ON
$SYMBOL::	0		;STORE 6BIT SYMBOL TO BREAK ON
>
SUBTTL	THE END


LITLOD:	END	LNKLOD