Google
 

Trailing-Edge - PDP-10 Archives - bb-y390o-bm_tops20_v41_atpch_20 - autopatch/lnklod.x19
There are 2 other files named lnklod.x19 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/PAH/PY/HD/RJF 5-Feb-88


;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


SEARCH	LNKPAR,OVRPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,< SEARCH MONSYM >	;[1401]
SALL

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


CUSTVR==0		;CUSTOMER VERSION
DECVER==6		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==2417		;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

;[1477] USEFUL MACROS FROM MACSYM

DEFINE WID(MASK)<<^L<-<<MASK>_<^L<MASK>>>-1>>>	; WIDTH OF MASK

DEFINE POS(MASK)<<^L<<MASK>&<-<MASK>>>>>	; POSITION OF MASK

DEFINE POINTR(LOC,MASK)<<POINT WID(MASK),LOC,POS(MASK)>>
						; BYTE POINTER TO MASK
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).

;START OF VERSION 4B
;1225	Force /UPTO: if GETSEGging OTS, and make OTS origin compiler-specific.
;1226	Remove now redundant test for non-root link in FORNAM.
;1227	Allow multiple COBOL-74 modules to be loaded without LNKCMC.
;1230	Use correct I/O channel for ALGOL symbol file.
;1232	Make E$$USA be a subroutine called also from LNKOV1.
;1234	Fix munged T1 which prints garbage if multiple LNKPOV errors.
;1246	Set up high segment in GO: if /SYMSEG:HIGH was seen.
;1251	Fix test in PG.SU so it doesn't request more core than available.
;1256	Put processor type in P4 before calling QREENT if overlaid.
;1262	Make LNKCMX message print out once only.
;1265	Make ALGCHK label global.
;1271	Cause FORLIB to load /SEG:LOW if main program is not FORTRAN.
;1277	If /LINK is not followed by /NODE, print LNKNSM error.
;1300	Don't do chained fixups if BADCORE is non-zero.
;1305	Use HP.S1 and HP.S2 before sorting psects.
;1312	Load a nonsharable OTS if /SYMSEG:HIGH and edit 1246
;1315	Fix user libraries to use bits for compiler type.
;1320	Fix T3HOLD to know about new rel blocks and ASCII text blocks.


;START OF VERSION 5
;1400	Use OVRPAR.MAC.
;1401	Nativize overflow file handling, fix ?LNKMEF bug in PG.LSG/PG.HSG
;1402	Nativize REL file handling.
;1412	Make SY.CHR,SY.CHL warn user before truncating fullword value.
;1420	Save T2 across error in SY.CHR,SY.CHL, and include missing POPJ.
;1432	Make ?LNKNSM only a warning.
;1433	Distinguish COBOL,COBOL-68 and COBOL-74.
;1434	Support for byte initialization.
;1435	PASCAL support.
;1441	Make sure E$$NSM returns properly.
;1442	Remove hard-wired section-1 limit on PSECT boundaries.
;1450	Fix typo in edit 1442, also ext addr patch in PG.MOV.
;1451	PASCAL support -- force library to lowseg as default.
;1463	Redo deferred fixup handling for nonzero sections.

;Start of Version 5A

;1467	Make D.CNT global for calling from LNKNEW.
;1474	Fix bad test for caller/callee block in SY.TYP.
;1475	Rewrite coercion block processing.
;1476	Fixes to type mismatch checking, char fixup handling.
;	Rewrite SY.TY2 to pick up the right descriptors.
;	Don't mark unknown functions as global requests.
;1477	Fix miscount of 2ndary arg descriptors in ARGSCN.
;1523	Don't define PASDT% as zero if undefined before library search.
;1545	Set continuation bit for errors which will print module names.
;1702	Remove call to LS.ADD in typechecking code.
;1703	Add RTSECT routine to release unneeded 2ndary triplets
;	after typechecking, and don't inhibit bound global searches.
;1711	Put CHKCHX code under FTFRK2 conditional.
;1723	If arg count for caller and function doesn't match, typecheck
;	only the args that exist.
;1724	Add a new action code to the set accepted in the coercion block.
;1725	Change error message E$$CMX to say "GFloating" Fortran.
;1732	Don't clear FXSPTR  as a hint  to CHKCHN that  it should call  CHKCHX.
;	Just recurse to CHKCHN from CHKCHX after the check.
;1733	Don't complain about truncation of section number in section-local
;	halfword fixups, but do complain about negative numbers being
;	truncated if they're large ones.
;1734	Fix edit 1733, which breaks deferred right half fixups.
;1735	Fix typo introduced when installing edit 1733.
;1736	Strip unsupported FMXFOR code.
;1737	Don't lose deferred fixups in nonzero sections.
;1740	Don't create the lower section if the window straddles sections
;	while doing fixups.
;1741	Don't add in section numbers unnecessarily.
;1743	Correct typo in edit 1724 that breaks char fixups.
;1751	Type out argument number in decimal, not octal.
;1753	Make LNKCMX a warning, not a fatal error.
;1777	Fix type checking code to handle nonresident argument blocks.
;2001	Pass the right typechecking triplet pointer to RTSECT.
;2005	Fix some typechecking bugs.
;2007	Give LNKFTH a long error message.
;2012	Fix function return to use arg checking in correct order.
;2013	Fix /NOSYSLIB - Don't insert instructions after a skip.
;2015	Preserve function name length accross TMATCH call.
;2020	Use a linked list to keep track of typechecking blocks.
;2025	Define FOROT% as 400010 for sharable OTS so 5a libraries work.
;2026	Update copyright and cleanup listings.
;2037	Check more carefully for last triplet in SY.RF1
;2045	Fix typechecking to not clobber other secondary triplets.
;2046	Garbage collect the DY area occasionally if many typecheck blocks.
;2053	Argcheck the BG area and defer fixups accross overlays.
;2065	Check .ABS. against zero when computing LOWLOC.
;2074	Calculate page size correctly in PG.MOV.
;2103	Typecheck structure mismatches.

;Start of Version 6
;2200	Use 30 bit addresses in fixups.
;2202	Call xx.IN and xx.OUT with 30 bit addresses, remove NONZER and FTFRK2.
;2203	Handle new style store and halfword fetch operators in type 11 blocks.
;2212	Handle deferred type 1072 polish fixups.
;2214	Add 30 bit fixups, change section default for fullword chained fixups.
;2215	Tell GBCK.L not to BLT areas which have been unmapped.
;2216	Fix long symbols in INSRT and LS.ADD.
;2217	Check for word alligned byte ptrs and fix lost sect numbers at COESPC.
;2220	Handle long symbols in psect names and /UPTO.
;2221	Fix edit 2217 so that it gets section right at SEGCHK. call in COESP2.
;2224	Get ots reentrancy correct if extended addressing or /PVBLOCK:HIGH.
;2226	Remove long /INCLUDE and /EXCLUDE blocks properly.
;2227	Return /PSCOMMON blocks at end of load.
;2242	Make sure all sections in all psects exist.
;2243	Fix off by one, make sure RC.HL not less than RC.CV.
;2247	Don't use LOWLOC, don't LNKPOV .LOW. if it does not exist.
;2255	Use 30 bit addresses for the LS area for symbol fixups.
;2262	Allow PG.xSG to return less than request, don't create extra sections.
;2263	Fix 30 bit additive deferred, set additive bit not chained.
;2264	Fix typo in LNKPMA message which caused it to type out as PMC.
;2266	Don't pass short symbols to TYP.BG as long, overlays can't handle them.
;2267	Remove part of edit 2266, proper fix is in LNKHSH.
;2270	Allow argument typechecking to page, fix conditionals in edit 2262.
;2273	Use 30 bit addresses for type 12 LNKEND blocks.
;2300	Remove F40 code.
;2301	Fix up TOPS-20 errors.
;2305	Add code to support 1070 blocks.
;2310	Rewrite LS.ADE to support long symbols.
;2322	Make LNKCCE a fatal error.
;2331	Always return the last secondary triplet after fixups.
;2342	Fix problems if TP overflows or GS area moves during typechecking.
;2343	Give LNKMMF, not LNKMEF on core manager error.
;2356	Remove unnecessary TOPS20 conditionals.
;2366	Implement extended addressing rules on TOPS-10.
;2374 	Use TPPTR for TP.PT in typchecking code and fix TP paging problem.
;2376	Correct calculation for BLTing long symbol.
;2403	New corporate Copywrite statement.
;2405	Preserve W3 across calls that move mem in TP code. 
;2406	Correct code for section changes in RDBACK
;2407	Edit 2406 not good enouhg
;2417	Update Copywrite statement to 1988.
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
IFN FTOVERLAY,<			;[1277]
	SKIPE	LINKSEEN	;[1277] IN LIMBO BETWEEN OVERLAYS?
	PUSHJ	P,E$$NSM	;[1277] YES, GO PRINT AN ERROR
>				;[1277]
	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

E$$NSM::.ERR.	(MS,0,V%L,L%W,S%W,NSM,</NODE switch missing after /LINK switch>) ;[1277]
	POPJ	P,		;[1441] RETURN TO CALLER
	
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
	MOVEM	T1,CURTYP	;[1434] SAVE CURRENT TYPE FOR ERROR RECOVERY
	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:
	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
	HRRZ	T1,P1		;[2226] LONG SYMBOL, T1=ADDRESS
	HLRZ	T2,P2		;[2226] T2=SIZE
	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
	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.##

SGCHK.::TRNN	FL,R.FLS!R.FHS	;[2203] Forced loading?
	  PJRST	SGCHK0		;[2053] No, no problem
	TRNN	FL,R.FLS	;[2053] Which segment has been faked?
	 SKIPA	T1,[1]		;[2053] Low seg has been faked
	MOVEI	T1,2		;[2053] High seg faked if /SEG:LOW
	HRR	R,T1		;[2053] Setup R For SG.TB; Preserve LH
	MOVE	T1,@SG.TB	;[2053] Get real value for RC table
	EXCH	T1,@RC.TB	;[2053] Restore it, get fake value
	PUSH	P,T1		;[2053] Save fake value to restore later
	PUSH	P,R		;[2053] Remember which segment
	PUSH	P,LL.S2		;[2053] LL.S2 Was also faked by T.3
	HRRZS	LL.S2		;[2053] If we are loading F10, that is
	PUSHJ	P,SGCHK0	;[2053] Now do the fixup
	POP	P,LL.S2		;[2053] Restore LL.S2
	POP	P,R		;[2053] Remember which counter we grabbed
	POP	P,@RC.TB	;[2053] And restore it
	POPJ	P,		;[2053] Return From SY.RF

SGCHK0:	HRRI	R,2		;[2053] ASSUME HIGH SEG
	SKIPE	LL.S2		;[1777] MUST BE LOW SWG IF ONLY ONE SEG
	CAMGE	P3,LL.S2	;[1777] BELOW BOTTOM OF HIGH SEG?
	SOJA	R,ADCHK.
	SUB	P3,LL.S2	;[1777] FORM OFFSET TO HIGH SEG
	CAMGE	P3,HL.S2	;[1777] BEFORE END OF HIGH SEG?
	JRST 	ADCHK.
	MOVE 	P3,0(P)		;[1777] RESTORE ADDRESS
	HRRI	R,1
	
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+PH.ADD	;[1400] REMOVE LINK ORIGIN
>
	MOVE	P2,P3		;GET A COPY
IFE TOPS20,<			;[2262]
	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
>;[2262] IFE TOPS20
IFN TOPS20,<			;[2270]
	PUSHJ	P,@[EXP PG.LSG,PG.HSG]-1(R) ;[2270] MAKE SURE IN MEMORY
>;[2270] IFN TOPS20
ADCHK1:	ADD	P3,LC.LB-1(R)	;FINALLY FIX IN CORE
	POPJ	P,		;RETURN WITH P3 SETUP
IFE TOPS20,<			;[2270]
ADCHK2:	
	PUSHJ	P,@[EXP PG.LSG,PG.HSG]-1(R)
	JRST	ADCHK1		;NOW TRY
>;[2270] IFE TOPS20
SUBTTL	PAGING CORE CONTROL


IFE TOPS20,<
;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:	MOVE	T1,LW.S0(R)	;[2202] SETUP CONTROL WORD
	MOVE	T2,UW.S0(R)	;[2202] 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
	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
IFN TOPS20,<			;[2215] DON'T HAVE GBCK.L ZERO THE AREA
	HRLI	T1,1		;[2215] SINCE IT'S PAGES WERE REMOVED
> ;[2215] IFN TOPS20
	PUSHJ	P,GBCK.L##	;GIVE BACK TO NEXT LOWER
PG.SD2:	MOVE	T1,LW.S0(R)	;[2202] RESET CONTROL WORD
	MOVE	T2,UW.S0(R)	;[2202] 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
	SUB	T1,LW.S0(R)	;[1251] UPPER BOUND - LOWER BOUND
	SUB	T1,FRECOR	;[1251] MINUS WHAT MUST BE KEPT FREE
	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
	MOVE	T1,LW.S0(R)	;CURRENT LOWEST
	ADD	T2,T1		;FIRST TO KEEP
	SUBI	T2,1		;[2202] HIGHEST TO GET RID OF
	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
IFN TOPS20,<			;[2215] DON'T HAVE GBCK.L ZERO THE AREA
	HRLI	T1,1		;[2215] SINCE IT'S PAGES WERE REMOVED
> ;[2215] IFN TOPS20
	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,PGMOV2	;[2366]  CAN'T DO IT, TAKE WHAT'S AVAILABLE
	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
	ADDI	T1,1		;[2202] IT MUST BE ON THE DSK
	MOVE	T2,UW.S0(R)	;[2202] 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
> ;[1401] IFE TOPS20
IFN TOPS20,<

;[1401]  THIS CODE FIXES OCCASIONAL ?LNKMEF.
;HERE TO CHANGE WINDOW TO LOW SEG

PG.LSG::
	CAMGE	P3,LW.S1		;[1401] IS LOWER ADDRESS IN CORE?
	SKIPA				;[1401] NO
	CAMLE	P2,UW.S1		;[1401] IS UPPER ADDRESS IN CORE?
	PUSHJ	P,PG.LSX		;[1401] NO, MOVE THE WINDOW
	SUB	P3,LW.S1		;[1401] REMOVE BASE
	POPJ	P,			;[1401] AND CONTINUE

PG.LSX:	PUSH	P,R			;[1401] SAVE CURRENT R
	MOVEI	R,LC.IX			;[1401] INDEX TO LOW SEG
	CAML	P3,LW.S1		;[1401] SIMPLE EXPANSION POSSIBLE?
	JRST	PG.XPN			;[1401] YES, TRY THAT FIRST
	JRST	PG.MOV			;[1401] GENERAL MOVER

;[1401] SIMILARLY FOR HIGH SEG

PG.HSG::CAMGE	P3,LW.S2	;[1401] SAME AS FOR LOW SEG
	SKIPA
	CAMLE	P2,UW.S2
	PUSHJ	P,PG.HSX
	SUB	P3,LW.S2	;[1401] REMOVE BASE
	POPJ	P,		;[1401] CONTINUE

;[1401] HERE TO CHANGE WINDOW TO HIGH SEG

PG.HSX:	PUSH	P,R		;[1401] SAVE R
	MOVEI	R,HC.IX		;[1401] INDEX TO HIGH
	CAML	P3,LW.S2	;[1401] SIMPLE EXPANSION POSSIBLE?
	JRST	PG.XPN		;[1401] YES, TRY THAT FIRST
	JRST	PG.MOV		;[1401] MOVE DOWN

;[1401]  MINOR NOTE: THE STACK IS CLEANED UP AT RETURN FROM "FIXUP".
;[1401] HERE TO TRY EXPANDING THE WINDOW.

PG.XPN:
	MOVE	T1,TAB.UB(R)
	SUB	T1,TAB.AB(R)		;[1401]  WHAT'S AVAILABLE
	MOVE	T2,P2
	SUB	T2,UW.S0(R)		;[1401]  HOW MUCH MORE WE WANT
	CAMGE	T1,T2			;[1401]  ENOUGH TO SIMPLY EXPAND?
	JRST	PG.MOV			;[1401]  NO, DO GENERAL PURPOSE MOVE
	PUSH	P,P1			;[1401]  SAVE ACS
	PUSH	P,P2
	MOVEI	P1,(R)			;[1401]  NOTE INDEX
	MOVE	P2,T2			;[1401]  AND AMOUNT TO EXPAND BY
	PUSHJ	P,LNKCOR		;[1401]  ASK
	  PUSHJ	P,E$$MEF		;[1401]  NOT ALWAYS GIVEN...
	POP	P,P2			;[1401]  RESTORE
	POP	P,P1
	JRST	PGDONE			;[1401]  ALL SET.
;[1401] HERE TO MOVE THE WINDOW.  OUTPUT THE EXISTING WINDOW AND THEN
;[1401]  BRING IN THE REQUESTED DATA.

PG.MOV:
	MOVE	T1,LW.S0(R)		;[2202]  RETURN CURRENT SPAN
	MOVE	T2,UW.S0(R)		;[2202]  FIRST,,LAST
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R)
;[1401]  IS THERE ENOUGH STORAGE IN THIS AREA TO FIT THE REQUEST?
	MOVE	T1,UW.S0(R)		;[1401] LAST
	SUB	T1,LW.S0(R)		;[1401] -FIRST
	MOVE	T2,P2			;[1401] UPPERBOUND
	TRO	T2,.IPM			;[2074] AT TOP OF A PAGE
	SUB	T2,P3			;[1401] LOWERBOUND
	CAMGE	T1,T2			;[1401] AREA GTRE REQUEST?
	JRST	PGMOV1			;[1401] NO
	MOVE	T1,P3			;[1401] LOWER ADDRESS WE NEED
	ANDCMI	T1,.IPM			;[1401] MAKE INTO BLOCK BOUNDARY
	MOVEM	T1,LW.S0(R)		;[1401] RESET LOWER WINDOWBOUND
	MOVE	T2,P2			;[1401] HIGHEST ADDRESS WE NEED
	ANDCMI	T2,.IPM			;[1401] MAKE INTO BLOCK BOUNDARY
	ADDI	T2,.IPS-1		;[1401] INCLUDE THE PAGE
	MOVEM	T2,UW.S0(R)		;[1401] RESET UPPER WINDOWBOUND
	SUB	T2,T1			;[1401] GET WINDOW LENGTH
	MOVE	T1,TAB.LB(R)		;[1401] RESET AREA BOUNDS
	ADD	T1,T2
	MOVEM	T1,TAB.AB(R)
	MOVE	T1,LW.S0(R)		;[2202] BRING IN THE WINDOW
	MOVE	T2,UW.S0(R)		;[2202]
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R)
	JRST	PGDONE
;[1401] HERE IF MEMORY MUST BE REQUESTED

PGMOV1:

;[1401]
; THERE IS NOT ENOUGH ROOM CURRENTLY ALLOCATED IN MEMORY.  BRING IN ONE
; PAGE'S WORTH OF THE REQUEST, AND ASK LNKCOR TO EXPAND ON IT TO PROVIDE
; THE REST.
	MOVE	T2,TAB.LB(R)	;[2202] GET THE LOWER BOUND
	ADDI	T2,.IPS-1	;[2202] ALLOW ONE PAGE
	MOVEM	T2,TAB.AB(R)	;[2202] NEW UPPER BOUND
	MOVE	T1,P3		;[1401]  LOWER END OF REQUEST
	ANDCMI	T1,.IPM		;[1401]  MAKE INTO BLOCKBOUND
	MOVEM	T1,LW.S0(R)	;[1401]  SET LOWER WINDOWBOUND
	MOVE	T2,T1		;[2202]  GET LOWER BOUND
	ADDI	T2,.IPS-1	;[2202]  END OF PAGE
	MOVEM	T2,UW.S0(R)	;[2202]  SET UPPER WINDOWBOUND
	PUSHJ	P,@[EXP LC.IN,HC.IN]-1(R)
	MOVE	T2,P2		;[1401]  UPPER END OF REQUEST
	ANDCMI	T2,.IPM		;[1401]  MAKE INTO BLOCKBOUND
	ADDI	T2,.IPS-1	;[1401]  THROUGH END OF PAGE
	SUB	T2,UW.S0(R)	;[2202]  ADDITIONAL SPACE NEEDED
	PUSH	P,P1		;[1401]  SAVE ACS USED BY LNKCOR
	PUSH	P,P2		;[1401] 
	MOVEI	P1,(R)		;[1401]  WHAT TO EXPAND
	MOVE	P2,T2		;[1401]  BY HOW MUCH
	PUSHJ	P,LNKCOR##
	  PUSHJ	P,PGMOV2	;[2262]  CAN'T DO IT
	POP	P,P2		;[1401]  RESTORE ACS
	POP	P,P1
;[1401]  THE WINDOW HAS BEEN RESET TO COVER THE REQUEST.
PGDONE:
	PJRST	FIXUP		;[1401]  DO ANY FIXUPS POSSIBLE
> ;[1401]  IFN TOPS20
;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,

;[2262] Here if unable to get requested memory.  Get whatever is
;[2262] available.  The calling routine will have to check to see
;[2262] if it got what it needed.  Note that routines which need
;[2262] only one page will not have to check as they always get it.
PGMOV2:	PUSHJ	P,FR.CNT##	;[2262] FIND OUT WHAT IS AVAILABLE
	SUB	T1,FRECOR	;[2262] MINUS WHAT LNKCOR WILL PRESERVE
	MOVE	P2,T1		;[2262] THAT'S HOW MUCH TO ASK FOR
	PUSHJ	P,LNKCOR##	;[2262] GO GET IT
	 PUSHJ	P,E$$MMF##	;[2343] NOT EXPECTED TO FAIL
	POPJ	P,		;[2262] DONE
SUBTTL PROCESS FIXUPS FOR NEW WINDOW
;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:
	PUSHJ	P,.SAVE1##	;[1737] Save P1 - will point to fixup chain head
	MOVEI	P1,FX.S0(R)	;[1737] Point to the Rth section's fixup header
	CAIE	R,1		;[2200] Low segment fixups?
	 JRST	CHKCHE		;[1737] No, go on and use FX.S0(R)
	HLRZ	P1,LW.LC	;[2200] Get the section number of the window
	MOVEI	P1,FXSPTR(P1)	;[2200] Set the head pointer and process
CHKCHE:	SKIPN	(P1)		;[1737] Anything to do?
	 POPJ	P,		;NO
	SETZM	FXT.S0		;CLEAR TEMP PTR
	HRRZ	T1,(P1)		;[1737] Get pointer to fixup for lowest address
	ADD	T1,FX.LB	;+OFFSET
	LDB	T2,[ADDRESS 1(T1)] ;[2200] GET ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH+PH.ADD	;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	HLRZ	T1,(P1)		;[1737] Pointer to fixup for highest address 
	ADD	T1,FX.LB	;+OFFSET
	LDB	T3,[ADDRESS 1(T1)] ;[2200] ADDRESS
	SUB	T3,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T3,PH+PH.ADD	;[1400] 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,(P1)		;[1737] Get pointer word
	MOVEM	T1,FXT.S0	;MOVE IT ALL OVER
	SETZM	(P1)		;[1737] Remove from list to consider
	JRST	FXTLUP		;AND DO IT
	MOVE	T1,P1		;[1737] Get initial pointer
				;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
	LDB	T2,[ADDRESS 1(T1)] ;[2200] GET 30 BIT ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH+PH.ADD	;[1400] 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,[MOVE T3,P1	;[1737] If link is zero, this is
		    JRST CHKCHM] ;[1737] the top of the chain
	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,[MOVE T1,P1	;[1737] Point to the header if we have
		    JRST CHKFIN] ;[1737] reached the end of the chain
	ADD	T1,FX.LB	;+OFFSET
	LDB	T2,[ADDRESS 1(T1)] ;[2200] ADDRESS
	SUB	T2,LL.S0(R)	;REMOVE ORIGIN
IFN FTOVERLAY,<
	CAIN	R,1		;LOW SEGMENT?
	SUB	T2,PH+PH.ADD	;[1400] 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
	LDB	T1,[HIGH6 T2]	;[2200] GET INDEX
	TLZ	T2,770000	;[2200] AND 30 BIT ADDRESS (CLEAR HIGH 6 BITS)
	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

IFE FTOVERLAY,<
PFF.CR==SY.CHR			;USE NORMAL CHAIN-CHASING ROUTINES
PFF.CL==SY.CHL
PFF.CF==SY.CHF
PFF.CE==SY.CHE			;[2214]
> ;END IFE FTOVERLAY

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

CHNTAB:	CFIXUPS
SUBTTL FIND HIGHEST LOCATION TO FIXUP
;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:	MOVEI	T1,MAXSEC		;[2200] Number of sections
FHALX1:	JUMPE	T1,CPOPJ		;[2200] Done if below table
	SKIPN	FXSPTR-1(T1)		;[2200] Check for nonzero entry
	SOJA	T1,FHALX1		;[2200] Get another if zero
	HLRZ	T1,FXSPTR-1(T1)		;[2200] Check the highest loc
	SETZ	T2,			;[2200] 0 for low segment
	JRST	FHALH1			;[2200] Join common code

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
FHALH1:	ADD	T1,FX.LB	;[2200] +OFFSET
	LDB	T1,[ADDRESS 1(T1)] ;[2200] AND NOTE ADDR TO BE FIXED
IFN FTOVERLAY,<
	JUMPN	T2,CPOPJ	;LOW SEGMENT?
	SUB	T1,PH+PH.ADD	;[1400] YES, REMOVE OVERLAY START ADDR
> ;END OF IFN FTOVERLAY
	POPJ	P,		;RETURN
SUBTTL SCAN WHOLE PROGRAM FOR FIXUPS
;ROUTINE TO READ OVERFLOW FILES BACKWARDS AND DO ALL POSSIBLE CODE FIXUPS

COR.FX::
	SKIPE	FX.S2		;[2200] High seg fixups?
	 JRST	CORFX0		;[2200] Yes, must do fixups
	MOVEI	T1,MAXSEC	;[2200] Get the number of sections
CORFX1:	SKIPE	FXSPTR-1(T1)	;[2200] Fixups for this section?
	 JRST	CORFX0		;[2200] Yes
	SOJG	T1,CORFX1	;[2200] No, try the next section
	POPJ	P,
CORFX0:	PUSH	P,R		;[1463] 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:	MOVE	T2,UW.S0(R)	;[2202] GET THE OLD BOUNDARY
	MOVEM	T1,UW.S0(R)	;[2202] STORE THE NEW UPPER LIMIT
	MOVE	T1,LW.S0(R)	;[2202] WRITE OUT CURRENT IMMAGE
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R)
	MOVE	T1,UW.S0(R)	;NOW FIND BOTTOM
	HLLZM	T1,LW.S0(R)	;[2407] SECTION,,0 OF NEW BOTTOM
	HRRZS	T1		;[2407] UW ADDRESS IN SECTION
	ADD	T1,TAB.LB(R)
	SUB	T1,TAB.AB(R)	;FOR NEW LW.S0(R)
	HRRM	T1,LW.S0(R)	;[2407] SET BASE IN THIS SECTION
	JUMPGE	T1,RDBCK1	;OK IF NOT TOO MUCH
	ADDM	T1,TAB.AB(R)	;TOO MUCH, CUT BACK TOP
	HLLZS	LW.S0(R)	;[2407] GET SECTION,,0 AS LOWER WINDOW
				;[2407] WINDOW NOW ALL IN CORE
IFE TOPS20,<			;[2202] DON'T BLT ON THE -20, IT'S MAPPED AWAY
	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
> ;[2202] IFE TOPS20
RDBCK1:	MOVE	T1,LW.S0(R)	;[2202] NOW FOR READIN
	MOVE	T2,UW.S0(R)	;[2202] 
	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	W3,(T3)		;[2214] PLUS DEFINED SYMBOL
	POPJ	P,

PFF.AE:	JUMPE	T2,CPOPJ	;[2214] Done if zero
	PUSHJ	P,SEGCHK	;[2214] Setup incore address
	  PUSHJ	P,E$$ANM	;[2214] We only get here when page is in core
	LDB	T1,[ADDRESS(T2)] ;[2214] Get 30 bit half value
	ADD	T1,W3		 ;[2214] Plus defined symbol
	DPB	T1,[ADDRESS(T2)] ;[2214] Store new value
	POPJ	P,		;[2214]
;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


PFF.CE:	SKIPE	T1,RT.PT	;[2214] Reloc bits?
	CAMN	T1,RT.LB	;[2214] Or is RT area empty?
	PJRST	SY.CHE		;[2214] Empty, don't worry about it
	PUSH	P,P3		;[2214] Save P3 over RT.P3
	MOVE	P3,T2		;[2214] Address of current fixup
	PUSHJ	P,RT.P3##	;[2214] Setup byte pointer
	ILDB	T1,RT.PT	;[2214] Pick up relocation bits
	LSH	T1,-^D34	;[2214] Move to left justify
	IOR	R,T1		;[2214] Set where RT.T2E can find it
	MOVE	T2,P3		;[2214] Restore chain address
	POP	P,P3		;[2214] And preserved ac
	PJRST	SY.CHE		;[2214] Go chase chain


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

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

;[2214] Thirty bit
PFF.RE:	JUMPE	T2,CPOPJ	;[2214] Done if zero
	PUSHJ	P,SEGCHK	;[2214] Setup incore address
	  PUSHJ	P,E$$ANM	;[2214] We only get here when page is in core
	DPB	W3,[ADDRESS(T2)] ;[2214] 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
	MOVEM	T1,LSTLCL	;[2255] STORE REL POINTER TO NEXT LOCAL SYMBOL
	TXNN	W1,PS.GLB	;IF NOT GLOBAL
	SETZM	LSTGBL		;[2255] CLEAR SPURIOUS GLOBAL POINTER
	TXC	W1,PT.TTL!PT.PSC ;[2220] Could be a long psect
	TXCE	W1,PT.TTL!PT.PSC ;[2220] Was it?
	TXNE	W1,PT.SYM	;[2216] Is it a symbol?
	TLNE	W2,770000	;[2216] And long?
	 CAIA			;[2216] No, short or non-symbl
	 JRST	[PUSH P,W2	;[2216] Yes, save the length and pointer
		 PUSH P,[LSADDL] ;[2216] Where to go to do long symbol
		 MOVE W2,(W2)	;[2216] Get the first six characters
		 JRST .+1]	;[2216]
	MOVEI	T2,.L		;[2216] Short symbol, need one 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,

;[2216] Here on a long symbol to store the secondaries
LSADDL:	MOVE	W2,(P)		;[2216] Get back the pointer
	HLR	T2,W2		;[2216] Get the count
	CAILE	T2,1		;[2216] Check for only one word
	SKIPN	1(W2)		;[2216] Or second word blank
	 JRST	LSADLZ		;[2216] Only one word - Done
	MOVX	T3,PS.EXO	;[2216] Get the bit indicating extended triplet
	IORM	T3,-3(T1)	;[2216] Set it
	MOVNI	T1,-1(T2)	;[2216] Negate it, account for first word
	HRL	W2,T1		;[2216] Build AOBJN pointer (low by one word)
		
;[2216] Get another word, and generate a secondary LS triplet for it
LSADL1:	SKIPN	1(W2)		;[2216] Is this blank?
	 JRST	LSADLD		;[2216] Yes, done
LSADL2:	MOVEI	T2,.L		;[2216] Need another triplet
	MOVE	T1,LS.FR	;[2216] Number of words free
	SUBI	T1,(T2)		;[2216] We need some more for this entry
	JUMPL	T1,[PUSHJ P,LS.XPN ;[2216] Get more memory
		    JRST LSADL2] ;[2216] Go back
	MOVEM	T1,LS.FR	;[2216] Store new count
	MOVE	T1,T2		;[2216] Same number of words
	ADDM	T2,LSYM		;[2216] Count extra words
	ADDB	T1,LS.PT	;[2216] New actual bound
	TXNE	W1,PT.TTL	;[2220] A title block?
	MOVX	T2,S.TTL!S.PSN	;[2220] Yes, this is a psect name
	TXNE	W1,PT.SYM	;[2220] Symbol?
	MOVX	T2,S.SYM!S.LNM	;[2220] Yes, Get the flags for long symbol name
	MOVEM	T2,-3(T1)	;[2216] Store the flags
	MOVE	T2,1(W2)	;[2216] Get a name word
	MOVEM	T2,-2(T1)	;[2216] Store the name word
	AOBJP	W2,LSADLD	;[2216] Check for more
	SKIPN	T2,1(W2)	;[2216] There's more, get the next one
	 JRST	LSADLD		;[2216] Null word, done
	MOVEM	T2,-1(T1)	;[2216] Store another word
	AOBJN	W2,LSADL1	;[2216] Continue
LSADLD:	MOVX	T2,S.LST	;[2216] Get flag indicating end
	IORM	T2,-3(T1)	;[2216] Indicate end
LSADLZ:	POP	P,W2		;[2216] Restore count and pointer
	POPJ	P,		;[2216] Done
;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.

;[2310] NOTE - CURRENTLY ONLY HANDLES ONE EXTENDED SECONDARY

LS.ADE::SPUSH	<W1,W2,W3>	;[2310] Save symbol ACs
	ADD	P1,GS.LB	;[2310] Find the global symbol
	MOVE	W3,2(P1)	;[2310] Get GS area value
	SUB	P1,GS.LB	;[2310] Relocate pointer
	PUSHJ	P,LS.ADD	;[2310] Put in the symbol
	ADD	P1,GS.LB	;[2310] Find the global symbol
	TMOVE	W1,.L(P1)	;[2310] Get the secondary
	TLNN	W2,770000	;[2310] Long symbol?
	MOVE	W2,(W2)		;[2310] Yes, make short
	PUSHJ	P,LS.ADD	;[2310] Insert it too
	SPOP	<W3,W2,W1>	;[2310] Restore symbol ACs	
	POPJ	P,		;[2310] Done

;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	LSTGBL		;[2255] SINCE NOT REALLY A SYMBOL
	SETZM	LSTLCL		;[2255] ZERO THE LAST SYMBOL POINTERS
	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?
	TLNN	W2,770000	;[2216] Do we have a long symbol name?
	 JRST	INSRTE		;[2216] Yes so let's set it up
INSRTS:	TXNE	W1,PT.EXT	;[2216] Triplet has secondaries?
	JRST	INSRTL		;[2216] Yes, just move pointers
	MOVEI	T2,.L		;[2216] 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
	TXNN	W1,PS.GLB	;[2255] DEFINING A GLOBAL?
	 POPJ	P,		;[2255] NO, RETURN
	HRRZM	T1,LSTGBL	;[2255] YES, STORE POINTER TO IT
	SETZM	LSTLCL		;[2255] NO LAST LOCAL (YET)
	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

;[2216] Here for long symbol.  Put it in memory
INSRTE:	HLR	T1,W2		;[2216] Count of words in symbol name 
	MOVNS	T1		;[2216] Make it negative for aobjn pointer
	HRLS	T1		;[2216] Into the left half
	HRR	T1,W2		;[2216] Address of symbol in the right half
INSRTZ:	SKIPE	(T1)		;[2216] Zero word?
	AOBJN	T1,INSRTZ	;[2216] No look at the next
	HLRES	T1		;[2216] See it they were all contained sym name
	HLRZ	T2,W2		;[2216] Get the original word count
	ADD	T2,T1		;[2216] Add (neg) count left from the aobjn 
	CAIG	T2,1		;[2216] Actually a short symbol?
	 JRST	[MOVE W2,(W2)	;[2216] Yes, get the symbol
		 JRST INSRTS]	;[2216] Use the short symbol code
	HRL	W2,T2		;[2216] Put the count of non-zero words in w2
	PUSHJ 	P,GS.GET##	;[2216] Get that many words from the gs area
	HRL	T3,W2		;[2216] BLT source address
	HRR	T3,T1		;[2216] BLT dest address
	ADD	T2,T1		;[2376] Add number of word to dest address
	SUBI	T2,1		;[2376] Last location to load into
	BLT	T3,(T2)		;[2216] Go ahead and move it
	SUB	T1,GS.LB	;[2216] Make gs address relative
	HLL	T1,W2		;[2216] Put in the size
	PUSH	P,T1		;[2216] Save the size,,GS pointer
	TXNE	W1,PT.EXT	;[2216] Triplet has secondaries?
	JRST	INSRTM		;[2216] Yes, just move pointers
	MOVEI	T2,.L		;[2216] Number of words required
	PUSHJ	P,GS.GET##	;[2216] Go get them
	MOVEM	W1,0(T1)	;[2216] Store triplet symbol flags
	POP	P,1(T1)		;[2216] And the size,,GS pointer
	MOVEM	W3,2(T1)	;[2216] And the value
	JRST	INSRT1		;[2216] Remember this symbol

;[2216] Here for long symbol in extended triplet.  The triplets are
;[2216] already in the GS area, but the name pointer points to the
;[2216] DY area or static memory.  Fix the pointer in the primary
;[2216] triplet.
INSRTM:	MOVE	T1,W3		;[2216] W3 Points to incore block
	ADD	T1,GS.LB	;[2216] Relative to gs.lb
	POP	P,1(T1)		;[2216] Insert the pointer to the symbol
	MOVE	W3,2(T1)	;[2216] Restore W3 (value)
	JRST	INSRT1		;[2216] 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
	TXNE	T1,S.FXP	;[2037] This triplet a fixup request?
	 JRST	SYRF2B		;[2037] Yes
	TXNN	T1,S.LST	;[2037] Is this the last secondary?
	 JRST	SYRF2A		;[2037] No, try next
	POPJ P,			;[2037] Yes, no additive fixups here
SYRF2B:	MOVE	T1,P1		;[2037] 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	W2,1(P1)	;[2255] SWAP NAME WITH 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	W2,1(P1)	;[2255] RESTORE W2
	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,T1		;[2331] GET THE SYMBOL POINTER
	ADD	T1,NAMLOC	;[2331] IN CASE MOVED
	PJRST	SY.ZST		;[2331] REMOVE THE SECONDARY AND RETURN
;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
	TLZ	W3,770000	;[2200] Remove any leftover radix 50 bits
	MOVE	T2,W3		;[2200] GET 30 BIT 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
	TXNE	W1,FS.FXE	;[2214] OR THIRTY BIT?
	JRST	SY.ADE		;[2214] 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.ADE:				;[2214] Thirty bit
IFN FTOVERLAY,<			;[2214]
	TXNE	W1,FS.REL	;[2214] Relocatable?
	TXO	R,1B1		;[2214] Yes, reset bits in R
	PUSHJ	P,SY.ADT	;[2214] Relocatable overlay?
	JFCL	RT.T2E##	;[2214] Yes, set reloc bit  correctly
>				;[2214]
	LDB	T1,[ADDRESS(T2)] ;[2214] Get full word value
	ADD	T1,2(P1)	 ;[2214] Plus defined symbol
	DPB	T1,[ADDRESS(T2)] ;[2214] Store new value
	POPJ	P,		 ;[2214] Done

SY.ADC:	MOVE	T2,W3		;RETRIEVE ADDRESS OF CHAIN
	MOVE	W3,2(P1)	;GET VALUE TO STORE FOR SY.CHR
	TXNE	W1,FS.FXL	;[2305] is it a left half chain?
	PJRST	SY.CHL		;[2305] yes - go do it
	TXNE	W1,FS.FXE	;[2305] is it a 30 bit chained fixup
	PJRST	SY.CHE		;[2305] yes - go do it
	TXNE	W1,FS.FXF	;[2305] is it a full word chained fixup
	PJRST	SY.CHF		;[2305] yes - go do it
	PJRST	SY.CHR		;[2305] must be right half chain 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?
	TXO	T2,CPF.AR	;[2200] YES
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP
	TXO	T2,CPF.AL	;[2200] YES
	TXNE	W1,FS.FXF	;FULL WORD?
	TXO	T2,CPF.AF	;[2200] YES
	TXNE	W1,FS.FXE	;[2214] THIRTY BIT FIXUP?
	TXO	T2,CPF.AE	;[2263] YES
	TXNE	W1,FS.FXC	;RIGHT HALF CHAINED?
	TXO	T2,CPF.CR	;[2200] 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	W2,GLOBAL SYMBOL TABLE POINTER [2255]
;	MOVE	W3,LOCAL SYMBOL TABLE POINTER [2255]
;	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:	MOVE	T1,W2		;[2255] 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???
	MOVE	W2,2(T1)	;[2255] RESET REAL POINTER
	MOVEM	W2,-2(P)	;[2255] 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
	TXNN	W1,FS.FXF	;[2214] UNLESS FULL WORD
	TXNE	W1,FS.FXE	;[2214] OR 30 BIT
	TXO	T3,PS.UDF	;IN WHICH CASE WE'RE DEFINING ALL
	MOVE	T2,-2(P)	;[2255] 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
	MOVE	T2,W3		;[2255] 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:	MOVE	T2,W3		;[2255] 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
	TXNN	W1,FS.FXF	;[2214] UNLESS FULL WORD
	TXNE	W1,FS.FXE	;[2214] OR THIRTY BIT
	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
	MOVE	T1,(T4)		;[2212] GET THE HEADER WORD
	TXNE	T1,FF.NEW	;[2212] NEW STYLE POLISH BLOCK?
	 JRST	SY.NPF		;[2212] YES
	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	[CAIGE T1,600000	;[2203] PSECT INDEX? 
		  JRST	SYPF2		;[2203] YES, SKIP IT
		 CAIGE T1,610000	;[2203] NEW STYLE HALFWORD FETCH?
		  JRST SYPF1		;[2203] YES, IGNORE NEXT HALFWORD TOO
		 POPJ	P,]	;[712] STORE OPERATOR, IGNORE, NOT ALL DEFINED
	CAIL	T1,3		;IF OPERATOR
	JRST	SYPF2		;IGNORE IT
	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?
	 POPJ	P,		;[2212] NO, CAN'T EVALUATE THIS TIME
;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,


;[2212] Here to handle new style (1072) polish fixup blocks
SY.NPF:	PUSH	P,P1		;[2212] Save some AC's which are used as
	PUSH	P,P2		;[2212] temporaries in the EXTEND instructions
	PUSH	P,P3		;[2212] Save a place for the pointer
	PUSH	P,P4		;[2212] And another place for T1072E
	MOVEI	P3,2(T4)	;[2212] Get the start of the polish
	HRLI	P3,(POINT 18)	;[2212] Make it a byte pointer
	SKIPA	P4,P3		;[2212] Keep the pointer to the beginning
SYNP0:	IBP	P3		;[2212] Eat a halfword
SYNP1:	ILDB	T1,P3		;[2212] Get the next halfword
	CAIL	T1,PL.NSO	;[2212] Store operator (new style)
	 JRST	SYNPR		;[2212] Yes, Go pop and return
	CAIL	T1,PL.NEW	;[2212] Halfword data operator?
	 JRST	SYNP0		;[2212] Yes, eat the next halfword
	CAIL	T1,PL.IL	;[2212] Psect index?
	 JRST	SYNP1		;[2212] Yes, ignore it
	JUMPE	T1,SYNP0	;[2212] If absolute halfword eat 1 halfword
	CAIE	T1,PL.ABF	;[2212] Fullword absolute?
	CAIN	T1,PL.RLF	;[2212] Or fullword relocatable?
	 AOJA	P3,SYNP1	;[2212] Yes, ignore the next 2 halfwords
	CAIL	T1,PL.OL	;[2212] Too low for operator?
	CAILE	T1,PL.OH	;[2212] Or too high?
	 CAIA			;[2212] Not an operator
	JRST	SYNP1		;[2212] An operator, ignore it
	
;[2212] Here if a symbol.  Figure out whether a long symbol test is
;[2212] needed.

	LSH	T1,-^D9		;[2212] Get the count
	TLNN	W2,770000	;[2212] Short symbol
	 JRST	SYNPL		;[2212] Long symbol, must compare strings

;[2212] Check special case of long symbol in polish block.  Must be
;[2212] compared anyways because symbol in polish block could be short
;[2212] symbol padded with null halfwords.

	CAILE	T1,1		;[2212] Short symbol (or converted radix-50)?
	 JRST	SYNPS		;[2212] No, it's special
	
;[2212] Here for a short symbol compare.  Build the symbol in an AC
;[2212] and do a simple compare.
	ILDB	T2,P3		;[2212] Get a symbol halfword
	ILDB	T1,P3		;[2212] And another
	HRL	T1,T2		;[2212] Build entire symbol
	CAME	T1,W2		;[2212] This the symbol?
	 JRST	SYNP1		;[2212] No, try some more
	SUBI	P3,2		;[2212] Back up the byte pointer
	IBP	P3		;[2212] By three bytes
	MOVEI	T2,PL.ABF	;[2212] Get absolute fullword code
	IDPB	T2,P3		;[2212] Store it
	HLR	T2,W3		;[2212] Get the high order value
	IDPB	T2,P3		;[2212] Store it
	IDPB	W3,P3		;[2212] Store the low order value
	 JRST	SYNPE		;[2212] See if ready to evaluate

;[2212] Here to compare a short symbol and a long one.  Build a pointer
;[2212] to the short symbol and use the long symbol code.
SYNPS:	MOVEI	T4,2		;[2212] Count two halfwords for symbol
	MOVE	P1,[POINT 18,W2] ;[2212] Symbol is in W2
	JRST	SYNPX		;[2212] Join the long symbol code

;[2212] Here for long symbols.  Set up and do a string compare.
;[2212] T1 and T2 contain the count and pointer for the polish block.
;[2212] T4 and P1 contain the count and pointer for the symbol.
;[2212] Also adjust the byte pointer to the end of the symbol.
SYNPL:	HRR	P1,W2		;[2212] Get the address of the symbol
	ADD	P1,GS.LB	;[2212] Make it absolute
	HRLI	P1,(POINT 18,)	;[2212] Get the pointer
	HLR	T4,W2		;[2212] Get the count (in words)
	ADD	T4,T4		;[2212] Make count into halfwords
SYNPX:	ADDI	T1,1		;[2212] Get a correct count
	PUSH	P,P3		;[2212] Save the pointer in case of match
	PUSH	P,T1		;[2212] And the length
	MOVE	T2,P3		;[2212] Get the pointer to the string
	MOVE	T3,P3		;[2212] Get the pointer
	MOVE	P3,T1		;[2212] Get the count
	ADJBP	P3,T3		;[2212] Point at the end of the string
	EXTEND	T1,[CMPSE	;[2212] Do the string compare
		    0		;[2212] Pad with zeros if either string
		    0]		;[2212] runs out.
	JRST	[POP P,(P)	;[2212] Not the same, toss the count
		 POP P,(P)	;[2212] And the old pointer
		 JRST SYNP1]	;[2212] Keep looking
	POP	P,T1		;[2212] Get the count
	POP	P,T2		;[2212] And the pointer
	MOVEI	T3,PL.ABF	;[2212] Get the code for absolute fullword
	DPB	T3,T2		;[2212] Store it
	HLR	T3,W3		;[2212] Get the value (left half)
	IDPB	T3,T2		;[2212] Store it
	IDPB	W3,T2		;[2212] Store the right half of the value
	
	MOVEI	T3,PL.IL	;[2212] Get a psect index (no-op)
	SUBI	T1,2		;[2212] Account for the two stored halfwords
SYNPZ:	IDPB	T3,T2		;[2212] Overwrite a symbol halfword
	SOJG	T1,SYNPZ	;[2212] Clear all extra symbol halfwords
;	JRST	SYNPE		;[2212] See if ready to evaluate

;[2212] Here to decide whether to evaluate.  Evaluate if the last
;[2212] Global in the block has just been defined.

SYNPE:	SOSE	-1(P4)		;[2212] Count one more defined, last one?
	 JRST	SYNPR		;[2212] No, can't evaluate this time

;[2212] Here to evaluate a new-style polish fixup.  The evaluation
;[2212] is done in T1072E in LNKNEW.
	SPUSH	<W1,W2,W3>	;[2212] Save the symbol ACs
	HRRZI	T1,-2(P4)	;[2212] Get address of beginning of block
	SUB	P4,FX.LB	;[2212] Relocate
	MOVEM	P4,T11BP	;[2212] Save the byte pointer
	HRL	T1,0(T1)	;[2212] Get the count
	SUB	T1,FX.LB	;[2212] Relocate, make count,,address in FX
	MOVEM	T1,T11FA	;[2212] Save it
	PUSHJ	P,T1072E##	;[2212] Evaluate the polish block
	SPOP	<W3,W2,W1>	;[2212] Restore the symbol ACs
SYNPR:	POP	P,P4		;[2212] Restore the ACs
	POP	P,P3		;[2212]
	POP	P,P2		;[2212]
	POP	P,P1		;[2212]
	POPJ	P,		;[2212] And return
;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 LOCAL SYMBOL PTR
	MOVE	T2,W3		;[2255] AND REL ADDRESS IN SYMBOL TABLE
	MOVE	W3,2(P1)	;FIXUP VALUE FROM ORIGINAL SYMBOL DEF
	TXNE	W1,FS.FXR	;RIGHT HALF FIXUP?
	TXO	T2,SPF.AR	;[2200] YES
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP?
	TXO	T2,SPF.AL	;[2200] YES
	TXNE	W1,FS.FXF	;FULL WORD FIXUP?
	TXO	T2,SPF.AF	;[2200] YES
	TXNE	W1,FS.FXE	;[2214] THIRTY BIT FIXUP?
	TXO	T2,SPF.AE	;[2214] YES
	TXNN	W1,FS.REL	;DEFINING SYMBOL RELOCATABLE?
	  JRST	SYSTP1		;NO, FIXUP TYPE IS OK
	ADD	T2,[SPF.RR-SPF.AR] ;[2200] MAKE CORRESPONDING
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::
	SKIPE	T2		;[1733] NO CHAIN?
	SKIPE	BADCORE##	;[1300] POSSIBLE FIXUP TO OVERLAID PSECT?
	POPJ	P,		;[1300] YES, DON'T DO FIXUP
IFN TOPS20,<			;[2202]
	TLNN	W2,770000	;[1733] SIXBIT symbol ?
	 JRST	SYCHR0		;[1733] No, just store the value
	MOVE	T1,W3		;[1734] Don't hack with real value
	TLCE	T1,-1		;[1734] Is the left half all zeros ?
	 TLCN	T1,-1		;[1734] Or all ones?
	  JRST	SYCHR0		;[1733] Yes, store RH of value
	PUSH	P,T2		;[1420] Save the address
	XOR	T2,W3		;[1733] Clear bits that match
	TLNE	T2,-1		;[1733] Same left half value ?
	 PUSHJ	P,E$$FTH	;[1412] No, warn user of value truncation
	POP	P,T2		;[1420] Get back store address
> ;[2202] IFN TOPS20
SYCHR0:	HLL	T1,T2		;[2200] Get the section number for the chain
SYCHR1:				;[1733]
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2R##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[TXO	T2,CPF.CR	;[2200] PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
	HRR	T1,(T2)		;[2200] GET NEXT LINK, PRESERVING SECTION
;[2200] Here is where section defaulting is done for right halfword
;[2200] fixups. The current rule is to wrap within a section. 
	HRRM	W3,(T2)		;FILL IN VALUE
	MOVE	T2,T1		;SETUP FOR NEXT
	TRNE	T2,-1		;[2200] Any more?
	JRST	SYCHR1		;[2200] Yes, loop back
	POPJ	P,		;[1733] End of chain, return

;LEFT HALF
SY.CHL::SKIPE	T2		;[1733] No chain to worry about?
	 SKIPE	BADCORE##	;[1733]  or possible fixup to overlaid psect?
	  POPJ	P,		;[1300] Yes, don't do fixup
IFN TOPS20,<			;[2202]
	TLNN	W2,770000	;[1733] SIXBIT symbol ?
	 JRST	SYCHL0		;[1420] No, just store the value
	MOVE	T1,W3		;[1734] Don't hack with real value
	TLCE	T1,-1		;[1734] Is the left half all zeros ?
	 TLCN	T1,-1		;[1734] Or all ones?
	  JRST	SYCHL0		;[1733] Yes, store RH of value
	PUSH	P,T2		;[1420] SAVE THE ADDRESS
	XOR	T2,W3		;[1733] Clear bits that match
	TLNE	T2,-1		;[1733] Same left half value ?
	 PUSHJ	P,E$$FTH	;[1412] No, warn user of value truncation
	POP	P,T2		;[1420] Get back store address
> ;[2202] IFN TOPS20
SYCHL0:	HLL	T1,T2		;[2200] Get the section number for the chain
SYCHL1:				;[1733]
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2L##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[ TXO	T2,CPF.CL	;[2200] PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
	HLR	T1,(T2)		;[2200] GET NEXT LINK, PRESERVING SECTION
;[2200] Here is where section defaulting is done for left halfword
;[2200] fixups. The current rule is to wrap within a section. 
	HRLM	W3,(T2)		;FILL IN VALUE
	MOVE	T2,T1		;SETUP FOR NEXT
	TRNE	T2,-1		;[2200] Any more?
	JRST	SYCHL1		;[2200] Yes, loop back
	POPJ	P,		;[1733] END OF CHAIN, RETURN
E$$FTH::
	.ERR.	(MS,.EC,V%L,L%W,S%W,FTH,<Fullword value >)	;[2007]
	.ETC.	(SBX,.EC!.EP,,,,W2)				;[1412]
	.ETC.	(STR,,,,,,< being truncated to halfword>)	;[1412]
	POPJ	P,						;[1420]
;FULL WORD 
SY.CHF::SKIPE	BADCORE##	;[1300] POSSIBLE FIXUP TO OVERLAID PSECT?
	POPJ	P,		;[1300] YES, DON'T DO FIXUP
SY.CF1:				;[2200]
IFN FTOVERLAY,<
	SKIPE	RT.LB		;RELOCATABLE OVERLAY?
	PUSHJ	P,RT.T2F##	;YES, SET RELOC BIT  CORRECTLY
>
	PUSHJ	P,SEGCHK	;SETUP INCORE ADDRESS
	  JRST	[TXO	T2,CPF.CF	;[2200] PAGE NOT IN CORE
		JRST	SY.CHP]		;CHAIN REQUESTS TOGETHER
;[2214] Here is where section defaulting is done for fullword chained
;[2214] fixups. The current rule is use the 30 bit address and cross
;[2214] sections as necessary.
	LDB	T1,[ADDRESS(T2)] ;[2214] GET NEXT LINK
	MOVEM	W3,(T2)		;FILL IN VALUE
	MOVE	T2,T1		;SETUP FOR NEXT
	JUMPN	T2,SY.CF1	;[2214] IF MORE TO FIXUP, DO IT
	POPJ	P,		;[2200] DONE IF END OF CHAIN
;Thirty Bit
SY.CHE::SKIPE	BADCORE##	;[2214] Possible fixup to overlaid psect?
	POPJ	P,		;[2214] Yes, don't do fixup
SY.CE1:				;[2214]
IFN FTOVERLAY,<			;[2214]
	SKIPE	RT.LB		;[2214] Relocatable overlay?
	PUSHJ	P,RT.T2F##	;[2214] Yes, set reloc bit  correctly
>				;[2214] 
	PUSHJ	P,SEGCHK	;[2214] Setup incore address
	  JRST	[TXO	T2,CPF.CE	;[2214] Page not in CORE
		JRST	SY.CHP]		;[2214] Chain requests together
;[2214] Here is where section defaulting is done for fullword chained
;[2214] fixups. The current rule is use the 30 bit address and cross
;[2214] sections as necessary.
	LDB	T1,[ADDRESS(T2)] ;[2214] Get next link
	DPB	W3,[ADDRESS(T2)] ;[2214] Fill in value
	MOVE	T2,T1		;[2214] Setup for next
	JUMPN	T2,SY.CE1	;[2214] If more, do it
	POPJ	P,		;[2214] Done if end of chain
SUBTTL DEFER FIXUPS
;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]
	TLZ	T2,770000	;[2200] Addresses are only 30 bits
	PUSH	P,P1		;[2200] Save an accumulator
	HLRZ	T3,T2		;[2200] Get the section number
	MOVEI	P1,FX.S0(R)	;[2200] Point to the correct segment
	HRRZ	T4,R		;[2200] Get the section number
	CAIN	T4,1		;[2200] Pointing to low segment?
	 MOVEI	P1,FXSPTR(T3)	;[2200] Yes, use section specific pointer	
	AOS	FXC.S0(R)	;[2200] Increment count of fixups per segment
	PUSHJ	P,SY.FP0	;[2200] Store the fixup
	POP	P,P1		;[2200] Restore P1
	POPJ	P,		;[2200] Return
SUBTTL FIXUP CHAIN CONSTRUCTION
;NOW TO LINK IN CHAIN, HERE WITH
;P1 = POINTER TO FIXUP CHAIN
;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	(P1)		;[2200] VIRGIN CHAIN?
	JRST	SY.FP1		;NO
	HRL	T1,T1		;BOTH ENDS POINT TO SAME LOC
	MOVEM	T1,(P1)		;[2200] 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,(P1)		;[2200] GET PTR TO TOP OF CHAIN
	ADD	T3,FX.LB	;ADD IN OFFSET
	SETZ	T4,		;PREV PTR WAS START OF CHAIN
	PUSH	P,T1		;[2200] SAVE THE POINTER
	TLZ	T2,770000	;[2200] GET THE 30 BIT ADDRESS PART ONLY
	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:	LDB	T1,[ADDRESS 1(T3)] ;[2200] GET THE 30 BIT ADDRESS
	CAML	T2,T1		;[2200] FIND ADDRESS SMALLER THAN WHAT WE HAVE
	JRST	SY.FP3		;YES, LINK INTO LIST
	JRST	SY.FP2		;NO, TRY AGAIN

SY.FX6:	POP	P,T1		;[2200] AND THE POINTER
	HRLM	T1,(T4)		;[2200] ADD TO END
	HRRM	T1,(P1)		;[2200] AND TO INITIAL PTR
	SUB	T4,FX.LB	;-OFFSET
	ADD	T1,FX.LB	;+OFFSET
	HRRZM	T4,(T1)		;FORWARD LINK
	POPJ	P,

SY.FP3:	POP	P,T1		;[2200] AND THE POINTER
	TRNN	T4,-1		;[2200] 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,(P1)		;[2200] 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	LSTGBL		;[2255] SO WE DON'T DO FIXUPS?
	SETZM	LSTLCL		;[2255] TO LOCAL OR GLOBAL SYMBOL
	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
	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
	TXNE	T2,FS.FXE	;[2214] THIRTY BIT?
	JRST	SY.ASE		;[2214] 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,

SY.ASE:	LDB	T3,[ADDRESS 2(T1)] ;[2214] Get current value
	ADD	T3,W3		   ;[2214] Add, ignore carry
	DPB	T3,[ADDRESS 2(T1)] ;[2214] Store back
	POPJ	P,		   ;[2214] Return
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+PH.ADD	;[1400] 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::MOVE	T1,LSTLCL	;[2255] GET LOCAL ADDRESS
	JUMPE	T1,.+3		;LEAVE ZERO ALONE
	ADD	T1,LS.LB	;RELOCATE
	SUB	T1,LW.LS	;BUT REMOVE WINDOW BASE
	MOVE	T2,LSTGBL	;[2255] AND GLOBAL
	SKIPE	T2
	ADD	T2,NAMLOC	;RELOCATE
	TLNN	W3,770000	;[2216] LONG SYMBOL?
	 JRST	SY.RLL		;[2216] YES
	JUMPE	T1,[JUMPE T2,SYRLSZ	;[1165] NO LOCALS, TRY GLOBAL
		CAME	W3,1(T2)	;IF IN GLOBAL TABLE
		JRST	SYRLSZ		;[1165] NO MATCH
		JRST	CPOPJ1]		;[2255] GOT IT HERE
	CAME	W3,1(T1)	;SAME?
	JRST	SYRLSZ		;[1165] NO
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

;[2216] Here to handle long symbols
SY.RLL:	JUMPE	T2,SYRLL3	;[2216] Check for local
	SPUSH	<T1,T2,P1,P2>	;[2216] Global, save accs for compare
	HLRZ	T4,W3		;[2216] Get the count
	HRRZ	P1,W3		;[2216] And the address
	HRLI	P1,(POINT 36)	;[2216] Build a byte pointer
	MOVE	T2,1(T2)	;[2216] Get the count,,pointer for the global
	TLNE	T2,770000	;[2216] A short symbol?
	JRST	[MOVEI T2,W3	;[2216] Yes, point at symbol
		 MOVEI T1,1	;[2216] Only one word long
		 JRST SYRLL0]	;[2216] Go compare it
	HLRZ	T1,T2		;[2216] Get the count
	ADD	T2,GS.LB	;[2216] Relocate it
SYRLL0:	HRLI	T2,(POINT 36)	;[2216] Make a byte pointer
	EXTEND	T1,[CMPSE	;[2216] Compare the strings
		 0
		 0]
		 JRST	SYRLL2	;[2216] Not the same
SYRLL1:	SPOP	 <P2,P1,T2,T1>	;[2216] A match, restore accs
	JRST	CPOPJ1		;[2255] and return success

SYRLL2:	SPOP	 <P2,P1,T2,T1>	;[2216] Not the same, restore accs
SYRLSZ:	SETZM	LSTGBL		;[2255] DON'T CONFUSE SYMBOLS DOWN THE PIKE
	SETZM	LSTLCL		;[2255] EITHER LOCAL OR GLOBAL
	POPJ	P,		;[1165]

;[2216] Here to handle long local symbols
SYRLL3:	SPUSH	<T1,T2,P1,P2>	;[2216] Save some accs
	HLRZ	P1,W3		;[2216] Get the count
	HRRZ	P2,W3		;[2216] And the address of the symbol
	MOVE	T2,(P2)		;[2216] Get the first six characters
	CAME	T2,1(T1)	;[2216] Same?
	 JRST	SYRLL2		;[2216] No, not a match
	SOJLE	P1,[MOVE T2,(T1)   ;[2216] One word symbol? Get the flags
		    TXNN T2,PS.EXO ;[2216] Extended?
		     JRST SYRLL1   ;[2216] No, it's a match
		    JRST SYRLL2]   ;[2216] Different size, not a match

;[2216] Here for each secondary triplet
SYRLL4:	ADDI	T1,.L		;[2216] Point to next triplet
	ADDI	P2,2		;[2216] Point to next two symbol words
	MOVE	T2,-1(P2)	;[2216] Get the next symbol word
	CAME	T2,1(T1)	;[2216] Same?	
	 JRST	SYRLL2		;[2216] No, not a match
	SOJE	P1,[SKIPN 2(T1) ;[2216] If end of symbol, check extra word
		     JRST SYRLL1   ;[2216] Null word, it's a match
		    JRST SYRLL2]   ;[2216] Different size, not a match
	MOVE	T2,(P2)		;[2216] Get the next symbol word
	CAME	T2,2(T1)	;[2216] Same?
	 JRST	SYRLL2		;[2216] No, not a match
	SOJG	P1,SYRLL4	;[2216] Still OK, last one?
	MOVE	T2,(T1)		;[2216] Get the bits
	TXNN	T2,S.LST	;[2216] Last secondary?
	 JRST	SYRLL1		;[2216] Yes, it's a match
	JRST	SYRLL2		;[2216] Different size, not a match
SUBTTL ADD SECONDARY TYPECHECKING BLOCK

SY.TYP::
IFN FTOVERLAY,<			;[2053]
	SKIPN	OVERLW		;[2053] Overlayed program?
	 JRST	SYTYP		;[2053] No, don't worry about BG area
	MOVE	T3,ABCNT(W3)	;[2053] Compute ptr to flag word	
	IDIVI	T3,5		;[2053] Byte count to word count
	SKIPE	T4		;[2053] If not exact fit
	AOS	T3		;[2053] Count extra in next word
	ADDI	T3,ABNAM(W3)	;[2053] T3 Points to flag word
	MOVE	T3,(T3)		;[2053] Flags
	TXNN	T3,TPWHO	;[2053] Caller?
	PUSHJ	P,TYP.BG##	;[2053] Callee, typecheck the bound globals
;	JRST	SYTYP		;[2053] Check the current overlay
>;[2053] IFN FTOVERLAY

SYTYP::	MOVX	W1,PT.SGN	;[2053] SET UP TYPECHECK BLOCKS IN GS
	SKIPN	R2,PAG.TP	;[2342] REMEMBER IF TP AREA PAGING
	SUB	W3,TP.LB	;[2270] NOT PAGING, RELOCATE POINTER
	PUSHJ	P,TRYSYM##	;[1405] SEE IF IN TABLE
	  JRST	SY.TY0		;[1405] NO, PUT IN
	  JRST	SY.TY1		;[1405] ALREADY IN UNDEF TABLE
	JRST	SY.TY1		;[1405] STORE NEW BLOCK EVEN IF
				;[1405] CALLEE IS KNOWN

SY.TY0: SKIPN	PAG.TP		;[2270] PAGING?
	ADD	W3,TP.LB	;[2270] NO, UNRELOCATE
	SKIPE	PAG.TP		;[2270] PAGING?
	SKIPE	R2		;[2342] AND JUST STARTED PAGING?
	 CAIA			;[2270] NO, IT'S OK
	PUSHJ	P,TPTODY	;[2270] JUST STARTED PAGING - PUT BLOCK IN DY
IFN FTOVERLAY,<			;[2053]
	SKIPE	ARGOVL		;[2053] Argchecking the BG area?
	 POPJ	P,		;[2053] Yes, don't put it in
>;[2053] IFN FTOVERLAY
;[1405] HERE TO PUT UNKNOWN SYMBOL'S ARGBLK DATA PTR IN GLOBAL TABLE
;[1405] USE EXTENDED BLOCK TO HOLD POINTER
	AOS	USYM		;[1405] COUNT FUNCT NAME AS UNDEFINED
	MOVEI	T2,.L*2		;[1405] NEED TWO BLOCKS TO HOLD
	SKIPN	PAG.TP		;[2405] TP PAGING?
	SUB	W3,TP.LB	;[2405]	NO MAKE ADDRESS RELATIVE
	PUSHJ	P,GS.GET##	;[1405]  PARTIAL DEFINITION AND ARGBLK DATA
	SKIPN	PAG.TP		;[2405] TP PAGING?
	ADD	W3,TP.LB	;[2405]	ADD LOWER BOUND - MAKE ABSOLUTE
	SKIPE	PAG.TP		;[2405] PAGING?
	SKIPE	R2		;[2405] AND JUST STARTED PAGING?
	 CAIA			;[2405] NO, IT'S OK
	PUSHJ	P,TPTODY	;[2405] JUST STARTED PAGING - PUT BLOCK IN DY

	TXO	W1,PT.EXT!PS.REQ!PT.SYM
				;[1476] MARK AS USING EXTENDED TRIPLET
	DMOVEM	W1,0(T1)	;[1405] PRIMARY FLAGS & SYMBOL
	SETZM	2(T1)		;[1405] NO REQUESTS YET
	PUSH	P,W2		;[2270] SAVE THE NAME
	PUSHJ	P,SYTY0A	;[2020] BUILD THE SECONDARY TRIPLET
	POP	P,W2		;[2270] RESTORE THE NAME (INSRT WANTS IT)
	MOVE	W3,T1		;[2020] FOR EXTENDED SYMBOLS
	SUB	W3,NAMLOC	;[2020] W3 CONTAINS POINTER TO EXTENDED TRIPLET
	PUSHJ	P,INSRT		;[2020] PUT IN GLOBAL TABLE
	POPJ	P,		;[2020] DONE

SYTY0A:	MOVX	T2,S.LST!S.OTH	;[2020] TYPECHECK MARKER
	MOVE	T3,ABCNT(W3)	;[1474] COMPUTE PTR TO FLAG WORD	
	IDIVI	T3,5		;[1474] BYTE COUNT TO WORD COUNT
	SKIPE	T4		;[1474] IF NOT EXACT FIT
	AOS	T3		;[1474] COUNT EXTRA IN NEXT WORD
 	ADDI	T3,ABNAM(W3)	;[1474] T3 POINTS TO FLAG WORD
	MOVE	T3,(T3)		;[1474] FLAGS,,COUNT		
	PUSHJ	P,TP.REL	;[2270] RELOCATE (AND PUT IN TP AREA IF IN DY)
	SETZ	W2,		;[2270] CLEAR END OF CHAIN POINTER
	TXNE	T3,TPWHO	;[1474] CALLER?
	MOVE	W2,W3		;[2270] YES, POINT TO END OF CHAIN
	MOVEM	T2,.L+0(T1)	;[1405] SECONDARY FLAGS
	DMOVEM	W2,.L+1(T1)	;[1405] SYMBOL AGAIN (MAY AS WELL) & PTR
	POPJ	P,		;[1702] AND RETURN
;[1405] Here if "partially defined" symbol is already present.
;[2020] Look for secondary triplet for typechecking.

SY.TY1:
	SKIPN	PAG.TP		;[2270] PAGING?
	ADD	W3,TP.LB	;[2270] NO, UNRELOCATE
	SKIPE	PAG.TP		;[2270] PAGING?
	SKIPE	R2		;[2342] AND JUST STARTED PAGING?
	 CAIA			;[2270] NO, IT'S OK
	PUSHJ	P,TPTODY	;[2270] JUST STARTED PAGING - PUT BLOCK IN DY
	MOVE	T1,(P1)		;[2020] GET PRIMARY FLAGS
	TXNN	T1,PT.EXT	;[2020] EXTENDED?
	 JRST	SYTY1N		;[2020] NO, NO TYPECHECKING SECONDARY
	MOVEI	T2,(P1)		;[2020] POINT TO THE FIRST TRIPLET
SYTY1A:	ADDI	T2,.L		;[2020] ADVANCE TO NEXT TRIPLET
	MOVE	T1,(T2)		;[2020] GET THE FLAGS
	TXNE	T1,S.OTH	;[2020] TYPECHECKING?
	 JRST	SYTY1B		;[2020] YES, FOUND IT
	TXNN	T1,S.LST	;[2045] LAST ONE?
	 JRST	SYTY1A		;[2020] NO, TRY ANOTHER
SYTY1N:				;[2053]
IFN FTOVERLAY,<			;[2053]
	SKIPE	ARGOVL		;[2053] Typechecking the BG area?
	 POPJ	P,		;[2053] Yes, don't put it in
>;[2053] IFN FTOVERLAY
	MOVEI	T1,.L		;[2053] NO TYPCHECKING YET, NEED EXTRA TRIPLET
	SKIPN	PAG.TP		;[2405] TP PAGING?
	SUB	W3,TP.LB	;[2405] NO MAKE ADDRESS RELATIVE
	PUSHJ	P,SY.MOV	;[1405] MOVE WHAT WE HAVE
	PUSH	P,T1		;[2405] SAVE T1
	SKIPN	PAG.TP		;[2405] TP PAGING?
	ADD	W3,TP.LB	;[2405] ADD LOWER BOUND - MAKE ABSOLUTE
	SKIPE	PAG.TP		;[2405] PAGING?
	SKIPE	R2		;[2405] AND JUST STARTED PAGING?
	 CAIA			;[2405] NO, IT'S OK
	PUSHJ	P,TPTODY	;[2405] JUST STARTED PAGING - PUT BLOCK IN DY
	POP	P,T1		;[2405]	RESTORE T1

	SUBI	T1,.L		;[2045] GET POINTER TO PREVIOUS TRIPLET
	JRST	SYTY0A		;[2020] FILL IN NEW SECONDARY

SYTY1B:	MOVEI	W1,(T2)		;[2270] SAVE TYPECHECKING POINTER 
	MOVE	T3,ABCNT(W3)	;[2020] COMPUTE PTR TO FLAG WORD	
	IDIVI	T3,5		;[1474] BYTE COUNT TO WORD COUNT
	SKIPE	T4		;[1474] IF NOT EXACT FIT
	AOS	T3		;[1474] COUNT EXTRA IN NEXT WORD
	MOVE	R,T3		;[1474] REMEMBER THIS OFFSET
	ADDI	T3,ABNAM(W3)	;[1474] T3 POINTS TO FLAG WORD
	MOVE	T2,1(W1)	;[2020] GET POINTER TO END OF LIST
	MOVE	T3,(T3)		;[1474] FLAGS,,COUNT		

; W1 Points To the header word in the argument checking secondary [2270]
;    triplet. The second word of the triplet contains either 0 if [2270]
;    the callee has been seen, or the address of the last caller if no [2270]
;    callee has been seen.  The third word of the triplet contains the [2270]
;    address of the first caller or the address of the callee. [2270]
; W3 Points to the new block. [2020]
; T3 contains the flags for the new block. [2020]
; R  contains the number of words in the name. [2005]
;    must not be touched, TMATCH looks at it. [2005]

	TXNN	T3,TPWHO	;[1474] CALLER?
	 JRST	SYTY1D		;[2020] NO, THIS IS CALLEE
	JUMPE	T2,SYTY1P	;[2020] CHECK FOR CALLER AND CALLEE

;Here if have caller and callee has not been seen. Link it at end of list.
	ADD	T2,TP.LB	;[2270] UNRELOCATE
	SKIPE	PAG.TP		;[2270] PAGING?
	 JRST	SYTY1W		;[2270] YES, LINK IN FRONT OF LIST
	SUB	W3,TP.LB	;[2270] RELOCATE
	MOVEM	W3,ABLNK(T2)	;[2020] ADD TO END OF LIST
	MOVEM	W3,1(W1)	;[2270] REMEMBER NEW LIST END
	POPJ	P,		;[2020] DONE

;[2270] Here if paging the TP area.  Move the block into the TP
;[2270] area and link it to the front of the list.  Linking it
;[2270] to the end of the list is preferred, but would involve
;[2270] doing a fixup to the linked list.

SYTY1W:	PUSHJ	P,TP.REL	;[2270] MOVE IT INTO THE DY AREA
	MOVE	T1,2(W1)	;[2270] GET POINTER TO BEGINNING OF LIST
	MOVEM	W3,2(W1)	;[2270] PUT THE POINTER IN THE FRONT
	SUB	W3,LW.TP	;[2270] SUBTRACT THE WINDOW BOUND
	ADD	W3,TP.LB	;[2270] UNRELOCATE IT
	MOVEM	T1,ABLNK(W3)	;[2270] STORE THE OLD FIRST IN THE LINK WORD
	POPJ	P,		;[2270] DONE

;Here if have caller and callee has been seen. Typecheck it and toss it.
SYTY1P:	PUSH	P,W3		;[2020] SAVE POINTER TO CALLER
	MOVE	P1,W3		;[2020] GET THE CALLER ARG BLOCK
	MOVE	P2,2(W1)	;[2270] GET THE CALLEE ARG BLOCK
	SKIPN	PAG.TP		;[2270] PAGING?
	 JRST	SYTY1R		;[2270] NO, IT'S IN MEMORY
	MOVE	T1,P2		;[2270] GET THE ADDRESS
	MOVE	T2,ABSIZ(P1)	;[2270] AND THE SIZE (FROM THE CALLER)
	PUSHJ	P,PG.TP		;[2270] MAKE SURE IT'S IN MEMORY
	MOVE	T2,ABSIZ(T1)	;[2270] GET THE ACTUAL SIZE
	CAMG	T2,ABSIZ(P1)	;[2270] BIGGER THAN EXPECTED?
	 JRST	SYTY1Q		;[2270] NO, IT'S IN MEMORY
	MOVE	T1,P2		;[2270] GET THE ADDRESS AGAIN
	PUSHJ	P,PG.TP		;[2270] AND ASK FOR THE BIGGER BLOCK	
SYTY1Q:	SKIPA	P2,T1		;[2270] GET THE UNRELOCATED POINTER
SYTY1R:	ADD	P2,TP.LB	;[2270] UNRELOCATE
	PUSHJ	P,TMATCH	;[2020] ARG CHECK IT
	POP	P,T1		;[2020] GET POINTER TO BLOCK
	MOVE	T2,ABSIZ(T1)	;[2270] AND IT'S SIZE
	JRST	SYTY1C		;[2046] RETURN BLOCK

;Here if have callee and callee has not been seen. Typecheck all callers.
SYTY1D:	JUMPE	T2,SYTY1I	;[2020] CHECK FOR ANOTHER CALLER
	MOVE	P2,W3		;[2270] GET POINTER TO CALLEE
	MOVE	P1,2(W1)	;[2270] GET POINTER TO FIRST CALLER
	SUB	W1,GS.LB	;[2342] RELOCATE IN CASE GS AREA MOVES
	PUSH	P,W1		;[2342] SAVE SYMBOL POINTER
SYTY1L:	SKIPN	PAG.TP		;[2270] PAGING?
	 JRST	SYTY1E		;[2270] NO, IT'S IN MEMORY
	MOVE	T1,P1		;[2270] GET THE ADDRESS
	MOVE	T2,ABSIZ(P2)	;[2270] AND THE SIZE (FROM THE CALLEE)
	PUSHJ	P,PG.TP		;[2270] MAKE SURE IT'S IN MEMORY
	MOVE	T2,ABSIZ(T1)	;[2270] GET THE ACTUAL SIZE
	CAMG	T2,ABSIZ(P2)	;[2270] BIGGER THAN EXPECTED?
	 JRST	SYTY1F		;[2270] NO, IT'S IN MEMORY
	MOVE	T1,P1		;[2270] GET THE ADDRESS AGAIN
	PUSHJ	P,PG.TP		;[2270] AND ASK FOR THE BIGGER BLOCK	
SYTY1F:	SKIPA	P1,T1		;[2270] GET THE UNRELOCATED POINTER
SYTY1E:	ADD	P1,TP.LB	;[2270] UNRELOCATE
	SPUSH	<R,P1,P2>	;[2270] SAVE THE ACS FOR TYPECHECKING
	PUSHJ	P,TMATCH	;[2020] ARGCHECK THIS ONE
	SPOP	<P2,P1,R>	;[2020] RESTORE THE REGISTERS
	HRRZ	T1,P1		;[2020] GET ADDRESS OF CALLER BLOCK
	MOVE	T2,ABSIZ(P1)	;[2270] GET THE SIZE OF THE BLOCK
	MOVE	P1,ABLNK(P1)	;[2270] GET POINTER TO NEXT BLOCK
	AOS	TPGCNT		;[2270] COUNT FOR GARBAGE COLLECTION
	SKIPN	PAG.TP		;[2270] PAGING?
	PUSHJ	P,TP.RET##	;[2270] NO, TOSS THE BLOCK
	JUMPN	P1,SYTY1L	;[2020] ARGUMENT CHECK ALL OF THEM
	MOVE	W3,P2		;[2270] GET BACK THE CALLEE BLOCK IN W3
;**; insert at SYTY1E + 12	edit 2374
	PUSH	P,P2		;[2374] SAVE P2
	PUSHJ	P,TP.REL	;[2270] RELOCATE THE POINTER, PUT IN TP
	POP	P,P2		;[2374] RESTORE P2
	POP	P,W1		;[2270] GET BACK GLOBAL SYMBOL POINTER
	ADD	W1,GS.LB	;[2342] ADD AREA BASE
	MOVEM	W3,2(W1)	;[2270] FROM NOW ON, THE CALLER IS KNOWN
	SETZM	1(W1)		;[2270] REMEMBER IT
;**; insert at SYTY1E + 18 	edit 3274
	MOVE	W3,P2		;[2374] CALLEE BLOCK TO W3
	JRST	SYTY1G		;[2046] DONE, CHECK FOR GARBAGE COLLECT

;Here if have callee and callee has been seen. Toss the new block.
SYTY1I:	MOVE	T1,W3		;[2020] GET POINTER TO SECOND CALLEE BLOCK
	MOVE	T2,ABSIZ(T1)	;[2270] GET SIZE OF NEW BLOCK

;[2046] Here to return a block, and to garbage collect if not done recently.
SYTY1C:	AOS	TPGCNT		;[2270] COUNT THE BLOCK
	 SKIPN	PAG.TP		;[2270] PAGING?
	PUSHJ	P,TP.RET##	;[2270] NO, REMOVE IT FROM TP AREA
	 SKIPE	PAG.TP		;[2270] PAGING?
	PUSHJ	P,DY.RET##	;[2270] YES, REMOVE IT FROM DY AREA
SYTY1G:	MOVE	T1,TPGCNT	;[2270] GET THE COUNT OF RETURNED BLOCKS
	CAIGE	T1,TP.MRB	;[2270] CHECK FOR LOTS OF THEM
	 POPJ	P,		;[2046] NOT TOO MANY
	SETZM	TPGCNT		;[2270] LOTS, RESET COUNTER
	SKIPN	PAG.TP		;[2270] PAGING?
	 PJRST	TP.GBC##	;[2270] NO, GARBAGE COLLECT TP AREA
	PJRST	DY.GBC##	;[2270] YES, GARBAGE COLLECT DY AREA

;[2270] Here to relocate the address in W3.  If the block is in the
;[2270] DY area, put it in the TP area.
;[2270] W3 contains the pointer.

TP.REL:	SKIPE	PAG.TP		;[2270] Paging?
	JRST	TPREL1		;[2270] Yes, must move to TP area
	SUB	W3,TP.LB	;[2270] No, relocate
	POPJ	P,		;[2270] Done

TPREL1:	SPUSH	<T1,T2,T3>	;[2270] Get some acs
	PUSHJ	P,DYTOTP	;[2270] Copy the block
;**; Insert AT TPREL1 + 2	edit 2374
	SKIPN	ARGOVL		;[2374] Typchecking the BG area ?
	PUSHJ	P,DY.RET##	;[2270] Give back the DY block
	SPOP	<T3,T2,T1>	;[2270] Restore the acs
	POPJ	P,		;[2270] Done

;[2270] Here to move the block from the DY area to the TP area.
;[2342] W3 contains the address in the TP area.
;[2270] Returns W3 as address of the block in the TP area.
;[2270]         T1 as address of the block in the DY area.
;[2270]         T2 as the length of the block.

DYTOTP:	MOVE	T1,TPPTR	;[2374] Get the "first free" in the TP area
	PUSH	P,TPPTR		;[2374] Remember where the block starts
	MOVE	T2,ABSIZ(W3)	;[2270] Get the size in T2
	PUSHJ	P,PG.TP		;[2270] Get the block in the window
	MOVE	T2,ABSIZ(W3)	;[2270] Restore the size in T2
	ADDM	T2,TPPTR	;[2374] Bump the "first free" pointer
	ADDI	T2,-1(T1)	;[2270] Last address to copy to
	HRL	T1,W3		;[2270] Get the DY address
	BLT	T1,(T2)		;[2270] Copy the block inot the TP area
	MOVE	T1,W3		;[2270] Get the address
	MOVE	T2,ABSIZ(W3)	;[2270] And the size
	POP	P,W3		;[2270] Get the TP address of the block
	POPJ	P,		;[2270] Done

;[2270] Here to move the block from the TP area to the DY area.
;[2270] W3 contains the address in the DY area.
;[2270] Returns W3 as address of the block in the DY area.

TPTODY:	MOVE	T1,W3		;[2270] Get the TP address
	MOVEI	T2,ABOVH	;[2270] Need the overhead words
	PUSHJ	P,PG.TP		;[2270] Get the block in the window
	MOVE	T2,ABSIZ(T1)	;[2270] Get the actual size
	PUSHJ	P,DY.GET##	;[2270] Get a block of DY memory
	EXCH	T1,W3		;[2270] TP Address in T1, DY in W3
	PUSHJ	P,PG.TP		;[2270] Get whole block in window
	MOVE	T2,ABSIZ(T1)	;[2270] Get back the size
	HRL	T1,W3		;[2270] Get DY,,TP address
	MOVSS	T1		;[2270] Make it source,,dest
	ADDI	T2,-1(W3)	;[2270] Last address to copy to
	BLT	T1,(T2)		;[2270] Copy the data
	POPJ	P,		;[2270] Done

;[2270] Here to get an argument typechecking block in memory.
;[2270] This routine will not expand the TP area beyond TP.UB
;[2270] Unless absolutely necessary.
;[2270] T1 contains the address.
;[2270] T2 contains the block size.
;[2270] Return T1 as in-memory address of block.
;[2270] Uses T1,T2,T3

PG.TP:	ADD	T2,T1		;[2270] Add the origin and the size
	SUBI	T2,1		;[2270] Minus one is end of block
	CAMGE	T1,LW.TP	;[2270] Bottom within window?
	 JRST	PG.TPM		;[2270] No, must rewindow
	CAMG	T2,UW.TP	;[2270] Top within window?
	 JRST	PG.TPZ		;[2270] Yes, unrelocate and exit

;[2270] Here to see if expanding the window with LNKCOR will keep it
;[2270] within TP.UB.  If not, don't bother expanding, just move it.

	MOVE	T3,T2		;[2270] Get the upper bound	
	SUB	T3,LW.TP	;[2270] Minus the window
	ADD	T3,TP.LB	;[2270] Where it would be in memory
	CAMG	T3,TP.UB	;[2270] Can it expand easily?
	 JRST	PG.TPU		;[2270] Yes, expand the window


;[2270] Must move the window.  Unmap it and remap within what's
;[2270] available.  If the window is too small, call LNKCOR to
;[2270] expand it.

PG.TPM:	PUSH	P,T2		;[2270] Save the upper address
	PUSH	P,T1		;[2270] And the lower address
	MOVE	T1,LW.TP	;[2270] Get the window bottom
	MOVE	T2,UW.TP	;[2270] And the top
	PUSHJ	P,TP.OUT##	;[2270] Write it
	MOVE	T1,(P)		;[2270] Recover the lower bound
	TRZ	T1,.IPM		;[2270] Put it on a page bound
	MOVE	T2,TP.AB	;[2270] Get the upper bound
	SUB	T2,TP.LB	;[2270] Minus the lower is size
	ADD	T2,T1		;[2270] Lower plus size is upper bound
	MOVEM	T1,LW.TP	;[2270] Store new lower window
	MOVEM	T2,UW.TP	;[2270] And upper window
	PUSHJ	P,TP.IN##	;[2270] Bring it into memory
	POP	P,T1		;[2270] Get the pointer
	POP	P,T2		;[2270] And the top
	MOVE	T3,T2		;[2270] Get the upper bound	
	SUB	T3,LW.TP	;[2270] Minus the window
	ADD	T3,TP.LB	;[2270] Where it would be in memory
	CAMG	T3,TP.AB	;[2270] Does it fit?
	 JRST	PG.TPZ		;[2270] Yes, unrelocate and exit

PG.TPU:	SUB	T3,TP.AB	;[2270] How much is necessary
	SPUSH	<T1,P1,P2>	;[2270] Save the pointer and some ACs
	MOVEI	P1,TP.IX	;[2270] Want memory in the TP area
	MOVE	P2,T3		;[2270] Get the size
	PUSHJ	P,LNKCOR##	;[2270] Get the memory
	 PUSHJ	P,E$$MEF##	;[2270] No memory available
	SPOP	<P2,P1,T1>	;[2270] Restore the acs and pointer

PG.TPZ:	SUB	T1,LW.TP	;[2270] Remove the window base
	ADD	T1,TP.LB	;[2270] Add the area base
	POPJ	P,		;[2270] Done
; COMPLAIN ABOUT ARG COUNT MISMATCHES.
; THEN FEED THE INDIVIDUAL ENTRIES TO ARGSCN.
; IF THERE ARE 2NDARY DESCRIPTORS FOR AN INDIVIDUAL ENTRY NOTE ANY
; DISAGREEMENTS THERE.

TMATCH:
	MOVE	P3,P1		;[1476] REMEMBER THE CALLER'S ENTIRE ARGBLK
	MOVE	R2,ABMOD(P1)	;[2005] GET CALLERS NAME FOR ERRORS
	ADDI	P1,ABNAM(R)	;[1476] GO STRAIGHT TO THE ARG DESCRIPTORS
	ADDI	P2,ABNAM(R)	;[1476]
	MOVE	T1,(P1)		;[2005] FLAGS,,CALLER COUNT
	MOVNI	T2,(T1)		;[2005] MINUS CALLER COUNT
	TXNN	T1,TPVAL	;[2005] IS IT A FUNCTION
	SUBI	T2,1		;[2005] NO, COUNT LAST ARGUMENT
	HRRZ	W1,P1		;[2005] TEMP PTR FOR CALLER LIST
	HRL	W1,T2		;[2005] AS AN AOBJN POINTER
	MOVE	T1,(P2)		;[2005] FLAGS,,CALLEE COUNT
	MOVNI	T2,(T1)		;[2005] MINUS CALLEE COUNT
	TXNN	T1,TPVAL	;[2005] IS IT A FUNCTION
	SUBI	T2,1		;[2005] NO, COUNT LAST ARGUMENT
	HRRZ	W3,P2		;[2005] TEMP PTR FOR CALLEE LIST
	HRL	W3,T2		;[2005] AS AN AOBJN POINTER
	SETZM	P4		;[1476]
TMTCH1:	AOBJP	W1,TMTCH2	;[2005] BUMP POINTER, SEE IF DONE
	MOVE	T1,(W1)		;[1476] PICK UP ARG DESC
	TXNE	T1,TPIAD	;[2005] IS IT INTRINSIC?
	 JRST	[LDB T1,[TPSND(W1)] ;[2005] GET NUMBER OF SECONDARYS
		 ADD W1,T1	;[2005] ACCOUNT FOR THEM
		 JRST TMTCH1]	;[2005] TRY FOR ANOTHER PRIMARY
TMTCH2:	AOBJP	W3,TMTCH3	;[2005] BUMP POINTER, SEE IF DONE
	MOVE	T2,(W3)		;[2005] PICK UP ARG DESC
	TXNE	T2,TPIAD	;[2005] IS IT INTRINSIC?
	 JRST	[LDB T2,[TPSND(W3)] ;[2005] GET NUMBER OF SECONDARYS
		 ADD W3,T2	;[2005] ACCOUNT FOR THEM
		 JRST TMTCH2]	;[2005] TRY FOR ANOTHER PRIMARY
	JUMPGE	W1,TMTCH3	;[2005] CHECK FOR DONE
	ADDI	P4,1		;[2005] COUNT ANOTHER ARGUMENT
	PUSHJ	P,ARGSCN	;[1476]
	JRST	TMTCH1		;[1476] AND DO IT AGAIN
TMTCH3:	HLRZ	T1,W1		;[2005] GET THE CALLER ARG COUNT
	HLRZ	T2,W3		;[2005] AND THE FUNCTION ARG COUNT
	MOVE	P4,(P1)		;[2005] GET THE FLAGS
	TXNE	P4,TPCNT	;[2005] COMPLAIN ABOUT DIFFERENT COUNTS?
	CAMN	T1,T2		;[2005] YES, ARE THEY DIFFERENT?
	SKIPA			;[2005] NO
	 PUSHJ	P,ARGCNE	;[2005] YES, ERROR
TMTC3A:	MOVE	T1,(P1)		;[2005] GET THE FLAG WORDS
	MOVE	T2,(P2)		;[2005] FOR BOTH LISTS
	TXNE	T1,TPVAL	;[2005] IS CALLER A FUNCTION?
	TXNN	T2,TPVAL	;[2005] AND CALLEE TOO?
	JRST	TMTCH8		;[2005] NO
	JUMPGE	W1,TMTCH5	;[2005] CHECK FOR AT END OF LIST
TMTCH4:	LDB	T1,[TPSND(W1)]	;[2005] GET NUMBER OF SECONDARIES
	ADD	W1,T1		;[2005] ACCOUNT FOR THEM
	AOBJN	W1,TMTCH4	;[2005] GET ANOTHER
TMTCH5:	JUMPGE	W3,TMTCH7	;[2005] CHECK FOR AT END OF LIST
TMTCH6:	LDB	T1,[TPSND(W1)]	;[2005] GET NUMBER OF SECONDARIES
	ADD	W3,T1		;[2005] ACCOUNT FOR THEM
	AOBJN	W3,TMTCH6	;[2005] GET ANOTHER
TMTCH7:	MOVE	T1,(W1)		;[2005] GET PRIMARY DESCRIPTOR
	MOVE	T2,(W3)		;[2005] FOR BOTH
	SETZ	P4,		;[2005] ARGUMENT ZERO IS FUNCTION RETURN
	PUSHJ	P,ARGSCN	;[2005] COMPARE THE RETURN VALUES	
TMTCH8:	MOVE	T1,(P1)		;[2005] GET CALLER ARGUMENT
	TXNN	T1,TPSOF	;[2005] COMPLAIN IF SUBROUTINE/FUNCTION?
	 POPJ	P,		;[2005] NO, DONE
	XOR	T1,(P2)		;[2005] COMPARE THE BITS
	TXNN	T1,TPVAL	;[2005] ARE THEY DIFFERENT?
	 POPJ	P,		;[2005] NO
	MOVE	T1,(P1)		;[2005] GET BACK CALLER ARG
	TXNN	T1,TPVAL	;[2005] WAS CALLER THE FUNCTION?
	 SKIPA	T1,[1,,0]	;[2012] YES, SET FOR COERSION
	MOVX	T1,<0,,1>	;[2012] NO, SET FOR COERSION
	MOVX	T3,FCRTV	;[2005] COERSION BLOCK TYPE
	PJRST	ARGERR		;[2005] CALL THE COERSION ROUTINE
;[1474] Routine ARGSCN.
; Checks for mismatch
; T1: Caller's arg (actual)
; T2: Function arg (formal)
; P1: Pointer to Caller's arglist
; P2: Pointer to Function's arglist
; P3: Pointer to Caller's argblock
; P4: Arg number
; W1: Pointer to current arg descr of Caller
; W2: Sixbit Function name
; W3: Pointer to current arg descr of Function
; Uses T3,T4.


;POINTERS TO FUNCTION ARGUMENT DESCRIPTOR FIELDS

FUNFLD:	POINTR(T2,TPNUP)
	POINTR(T2,TPPASM)
	POINTR(T2,TPTYPM)
	POINTR(T2,TPCTC)

;POINTERS TO CALLER'S ARGUMENT DESCRIPTOR FIELDS

CALFLD:	POINTR(<(P)>,TPNUP)
	POINTR(<(P)>,TPPASM)
	POINTR(<(P)>,TPTYPM)
	POINTR(<(P)>,TPCTC)

;MASKS FOR EACH ARGUMENT DESCRIPTOR FIELD

MSKFLD:	TPNUP
	TPPASM
	TPTYPM
	TPCTC

ARGSCN:	PUSH	P,W3			;[1477] NEED A SPARE REGISTER
	PUSH	P,T1			;[1477] AND SAVE THE CALLER'S ARG
	SETZM	W3			;[1477] USE REGISTER AS COUNTER
	MOVE	T4,T1			;[1477]
	XOR	T4,T2			;[1477] NOTE MISMATCHES
ARGSCL:	CAILE	W3,FCCTC		;[1477] ALL FIELDS EXAMINED?
	JRST	ARGSCX			;[1477] YES
	TDNN	T4,MSKFLD(W3)		;[1477] MISMATCH IN THIS FIELD?
	AOJA	W3,ARGSCL		;[1477] NO, CHECK THE NEXT ONE
	LDB	T1,CALFLD(W3)		;[1477] WHAT DID CALLER GIVE?
	LDB	T3,FUNFLD(W3)		;[1477] WHAT DID FUNC EXPECT?
	HRL	T1,T3			;[1477] FORMAL,,ACTUAL
	MOVE	T3,W3			;[1477] T3 HAS TYPE BEING SENT
	PUSHJ	P,ARGERR		;[1477] TAKE APPROPRIATE ACTION
	AOJA	W3,ARGSCL		;[1477] AND TRY AGAIN

ARGSCX:

;[2103] Check for structure mismatch too.

	TDNN	T4,[TPSTRM]		;[2103]
	JRST	ARGSX0			;[2103] No mismatch seen
	LDB	T1,[POINTR(<(P)>,TPSTRM)]
					;[2103] What did caller expect?
	LDB	T3,[POINTR(T2,TPSTRM)]	;[2103] What did func expect?
	HRL	T1,T3			;[2103] Formal,,actual
	MOVEI	T3,FCSTR		;[2103] This is a structure mismatch
	PUSHJ	P,ARGERR		;[2103] Handle it

ARGSX0:					;[2103]
;[1477] There may be 2ndary descriptors.  Check for them.
	POP	P,T1			;[1477] GET CALLER DESCR BACK
	POP	P,W3			;[1477] RESTORE REGISTER W3 TOO
	ANDI	T1,TPSNDM		;[2005] ISOLATE NUMBER OF SECONDARIES
	ANDI	T2,TPSNDM		;[2005] IN CALLER AND CALLEE
ARGSX1:	JUMPE	T1,ARGSX9		;[2005] CHECK FOR NO SECONDARIES
	JUMPE	T2,ARGSX9		;[2005] IN EITHER DESCRIPTOR
	ADDI	W1,1			;[2005] INCREMENT THE POINTERS
	ADDI	W3,1			;[2005] 
	SUBI	T1,1			;[2005] DECREMENT THE COUNTS
	SUBI	T2,1			;[2005]
	PUSH	P,T2			;[2005] SAVE AN AC
	PUSH	P,T1			;[2005] AND ANOTHER
	LDB	T2,[TPSIZ(W1)]		;[2005] GET THE COUNTS
	LDB	T1,[TPSIZ(W3)]		;[2005] FOR BOTH ARGS
	SUB	T2,T1			;[2005] ACTUAL MINUS FORMAL
	LDB	T4,[TPMCH(W3)]		;[2005] GET THE TYPE TO CHECK FOR
	MOVEI	T3,FCLEN		;[2005] LENGTH CODE
	SETZ	T1,			;[2005] SET FOR ZERO BLOCK
	XCT	ARGSXT(T4)		;[2005] DO THE COMPARISON
	PUSHJ	P,ARGERR		;[2005] FAILED - GIVE MESSAGE
	POP	P,T1			;[2005] RESTORE THE AC
	POP	P,T2			;[2005] AND THE OTHER
	JRST	ARGSX1			;[2005] TRY FOR MORE
ARGSX9:	ADD	W1,T1			;[2005] ACCOUNT FOR THEM
	ADD	W3,T2			;[2005] IN CASE THEY ARE DIFFERENT
	POPJ	P,			;[1477] AND LEAVE

;TABLE OF POSSIBLE ACTIONS - WILL SKIP IF T2 IS PERMISSABLE
ARGSXT:	SKIPA	T2			;[2005] 000 ALWAYS ALLOWED
	SKIPE	T2			;[2005] 001 MUST BE EQUAL
	SKIPL	T2			;[2005] 010 ACTUAL .LT. FORMAL
	SKIPLE	T2			;[2005] 011 ACTUAL .LE. FORMAL
	SKIPG	T2			;[2005] 100 ACTUAL .GT. FORMAL
	SKIPGE	T2			;[2005] 101 ACTUAL .GE. FORMAL
	JFCL				;[2005] 110 NEVER LEGAL (RESERVED)
	JFCL				;[2005] 111 NEVER LEGAL (RESERVED)


ARGCNE:	MOVX	T3,FCWNA		;[2005] LOOKING FOR NUMBER OF ARGS
	SETZ	T1,			;[2005] MUST BE ZERO IN BLOCK
;	PJRST	ARGERR			;[2005] LOOK FOR COERSION BLOCK

ARGERR:	PUSH	P,T2			;[1476]
	MOVE	T2,ABCAL(P3)		;[1476] PREPARE TO COMPLAIN
; If there's a coerblock find out if a mismatch of this kind has some
; particular action specified.
	PUSHJ	P,COETST		;[1476]
	POP	P,T2			;[1476]
	POPJ	P,			;[1470]
;[1474] Routine COETST
;[1474] Scans the coercion block
;[2005] Return -- Error typed if appropriate

COETST:	PUSH	P,T1			;[1474] SAVE IT FOR NOW
	MOVE	R,COERPT		;[2005] STARTING AT THE FIRST
	JUMPE	R,COEDSP		;[2005] IF NO BLOCK, DO INFORMATIONAL
	SKIPA				;[2005] START WITH FIRST PAIR
COETS1: ADD	R,[1,,1] 		;[1474] SKIP THE PAIR
	HLRZ	T1,(R)			;[1474] PICK UP FIELD CODE
	CAMN	T1,T3			;[1474] RIGHT ONE FOUND?
	JRST	COETS3			;[1474] YES
COETS2:	AOBJN	R,COETS1		;[1474] NO, TRY AGAIN
	SETZ	R,			;[2005] DEFAULT INFORMATIONAL
	JRST	COEDSP			;[2005] GIVE INFORMATION MESSAGE
COETS3:	MOVE	T1,1(R)			;[1474] CHECK OUT THE PAIR
	CAME	T1,(P)			;[1474] IS THIS THE MISMATCH SOUGHT?
	JRST	COETS2			;[1474] NO, KEEP LOOKING
	HRRZ	T1,(R)			;[1474] PICK UP ACTION CODE
	MOVEI	R,3			;[1474] 
	CAIN	T1,-1			;[1474] 777777 -- FATAL
	JRST	COEDSP			;[1474] GO DO IT
	CAIN	T1,3			;[1743] SOMETHING SPECIAL
	JRST	COESPC			;[1474] GO DO IT
	MOVE	R,T1			;[2005] 
COEDSP:	POP	P,T1			;[2005] RESTORE FORMAL,,ACTUAL
	CAIN	R,4			;[2005] IS IT "DO NOTHING"?
	 POPJ	P,			;[2005] YES
	PUSH	P,TERLVL(R)		;[1474] PUSH THE SEVERITY
	JRST	@TERDSP(T3)		;[2005] TYPE THE ERROR	

	S%F				;[2012] -1 FATAL
TERLVL:	S%I4				;[2005]  0 INFORMATIONAL
	S%W				;[2005]  1 WARNING
	S%C				;[2005]  2 ERROR
	S%F				;[2005]  3 FATAL (RESERVED)
					;[2005]  4 NO ACTION

TERDSP:	COEUPD				;[2005] 0 UPDATE
	E$$AMM				;[2005] 1 PASSING MECHANISM
	E$$TMM				;[2005] 2 ARGUMENT TYPE CODE
	E$$AMM				;[2005] 3 COMPILE TIME CONSTANT
	E$$WNA				;[2005] 4 WRONG NUMBER OF ARGUMENTS
	COERTV				;[2005] 5 RETURN VALUE
	E$$LMM				;[2005] 6 LENGTH MISMATCH
	E$$AMM				;[2103] 7 STRUCTURE CODE

COERTV: TRNN	T1,-1			;[2005] DOES CALLER EXPECT A VALUE?
	 JRST	E$$URV			;[2012] NO, OTHER MESSAGE
	JRST	E$$NVR			;[2012] YES, GIVE THIS ERROR

COEUPD:	TRNN	T1,-1			;[2005] CALLER NO-UPDATE?
	 JRST	E$$AMM			;[2005] NO, SHOULD BE HARMLESS
	JRST	E$$PMA			;[2005] YES, POSSIBLE MODIFICATION

COESPC:	POP	P,(P)			;[2005] TOSS STACK VALUE
	CAIE	T1,3			;[1474] SPECIAL DESCR-TO-HOLL FIXUP?	
	POPJ	P,			;[1474] NO
;[1474]  Make quite sure we're supposed to do this.
;[1474]  Only caller's compile-time constants can be picked up.
;[1474]  Sneak a peek at descriptor in caller block.
	MOVE	T1,(W1)			;[2005] CURRENT CALLER'S DESCRIPTOR
	TXNN	T1,TPCTC		;[2005] COMPILE-TIME-CONST?
	POPJ	P,			;[1777] FORGET ABOUT IT AND LEAVE

;[1476]  P3: Pointer to Caller's argblock
;[2005]  W1: (left half) Minus number of descriptors left to process
;[2005]  P1: Pointer to flags word (and descriptor count)
;[1476]  Pick up the address of the argblk, and construct a pointer
;[1476]  to the descriptor being passed to the function.

	SPUSH <P1,P2,P3>		;[1777] SAVE SOME ACS
	PUSH	P,T2			;[1474] WILL NEED IT
	HLRE	T2,W1			;[2005] MINUS COUNT OF ARGS TO DO
	ADD	T2,ABABA(P3)		;[2005] ADD ADDR OF CALLERS ARG BLK
	HRRZ	P3,(P1)			;[2005] GET NUMBER OF DESCRIPTORS
	ADDI	T2,-1(P3)		;[2005] CALCULATE THE DESCRIPTOR
	MOVE	P3,(P1)			;[2005] GET THE FLAGS
	TXNN	P3,TPVAL		;[2005] IS IT A FUNCTION?
	ADDI	T2,1			;[2005] NO
	LDB	P3,[POINT 30,T2,35]	;[1777] TAKE 30 BIT ADDRESS
IFN FTOVERLAY,<			;[2053]
	SKIPE	ARGOVL		;[2053] Argchecking the BG area?
	 JRST	COEOVL##	;[2053] Yes, may have to defer this fixup
>;[2053] IFN FTOVERLAY
COESP0::PUSH	P,P3			;[2053] SAVE IT
	PUSHJ	P,SGCHK.		;[1777] FIND OUT WHERE IT IS
	PUSH	P,P3			;[1777] SAVE PTR TO ARG DESCRIPTOR
	HRRZ	P3,(P3)			;[1777] PICK UP PTR TO STRING DESCR
	MOVEI	T1,17			;[1474] CHANGE ARG BITS TO HOLLERITH
	DPB	T1,[POINT 4,@(P),12] 	;[1474] ...
	POP	P,(P)			;[1474] THROW AWAY THE 'FIXED' POINTER
	HLL	P3,0(P)			;[2217] ADD IN SECTION NUNBER
	PUSHJ	P,SGCHK.		;[1777] GET WHERE STRING DESC REALLY IS
	LDB	T1,[POINT 6,(P3),5]	;[2217] GET THE HIGH ORDER SIX BITS
	CAIE	T1,44			;[2217] IS IT A VALID BYTE POINTER
	CAIN	T1,61			;[2217] IS IT A VALID OWGBP
	JRST	COESP2			;[2217] YES
	CAIN	T1,67			;[2217] IS IT A 9-BIT ASCII BP
	JRST	COESP2			;[2217] YES - ITS O.K.
	PUSHJ	P,E$$CCE		;[2217] NO - POINTER NOT WORD ALIGNED
	POP	P,(P)			;[2217] CLEAN UP THE STACK
	JRST	COESP1			;[2217] SKIP FIXUP AND RESTORE ACS
COESP2:	HRRZ	T1,(P3)			;[1777] ABSOLUTE ADDR OF STRING
	EXCH	T1,(P)			;[1777] ABSOLUTE ADDRESS OF STRING TO 
					;STACK REL ADDR OF DISCRIPTOR TO P3
	MOVE	P3,T1			;[1777] SET UP P3 FOR CALL
	PUSHJ	P,SGCHK.		;[1777] FIND OUT WHERE IT IS
	POP	P,T1			;ABSOLUTE ADDR OF STRING TO T1
	HRLI	T1,(<Z 17,>+1B0)	;[2217] HOLLERITH BITS + SECTION LOCAL 
	MOVEM	T1,(P3)			;[2217] PUT IT WHERE IT BELONGS
COESP1::POP	P,T2			;[2053] RESTORE OLD T2 VALUE	
	SPOP	<P3,P2,P1>		;[1777] RESTORE ACS
	POPJ	P,			;[2005] DONE.

;LNKCCE Character constant not word aligned in call to routine FOO
;	called form module BAR at location 123456

E$$CCE::					;[2217]
	.ERR. (MS,.EC,V%L,L%F,S%F,CCE,<Character constant not word aligned >)
	.ETC. (JMP,,,,,.ETMW2) ;[2322]

;LNKWNA Wrong number of arguments in call to routine FOO
;       called from module BAR at location 123456

E$$WNA::				;[2005]
	.ERR.	(MS,.EC,V%L,L%D,S%D,WNA,<Wrong number of arguments>) ;[2005]
	.ETC.	(JMP,,,,,.ETMW2) ;[1474]

;LNKNVR No value returned by routine FOO
;       called from module BAR at location 123456

E$$NVR::				;[2005]
	.ERR.	(MS,.EC,V%L,L%D,S%D,NVR,<No value returned by routine >) ;[2005]
	.ETC.	(JMP,,,,,.ETMW4) ;[2005]

;LNKURV Unexpected return value in call to routine FOO
;       called from module BAR at location 123456

E$$URV::				;[2005]
	.ERR.	(MS,.EC,V%L,L%D,S%D,URV,<Unexpected return value>) ;[2005]
	.ETC.	(JMP,,,,,.ETMW2) ;[2005]

;LNKLMM Length mismatch for argument N in call to routine FOO
;       called from module BAR at location 123456

E$$LMM::				;[2005]
	.ERR.	(MS,.EC,V%L,L%D,S%D,LMM,<Length mismatch for >) ;[2005]
	.ETC.	(JMP,,,,,.ETMW1) ;[2005]


;LNKTMM Type mismatch seen for argument N in call to routine FOO
;       called from module BAR at location 123456


E$$TMM::				;[2005]
	.ERR.	(MS,.EC,V%L,L%D,S%D,TMM,<Type mismatch for >) ;[2005]
	.ETC.	(JMP,,,,,.ETMW1) ;[1474]

;LNKPMA Possible modification of argument N in call to routine FOO
;       called from module BAR at location 123456

E$$PMA::
	.ERR.	(MS,.EC,V%L,L%D,S%D,PMA,<Possible modification of >) ;[2264]
	.ETC.	(JMP,,,,,.ETMW1) ;[2005]

;LNKAMM Argument mismatch in argument N in call to routine FOO
;       called from module BAR at location 123456

E$$AMM::
	.ERR.	(MS,.EC,V%L,L%D,S%D,AMM,<Argument mismatch in >) ;[2005]
;	.ETC.	(JMP,,,,,.ETMW1) ;[2005]

.ETMW1:	.ETC.	(XCT,.EC,,,,<[SKIPN P4]>) ;[2005] FUNCTION ARGUMENT?
	.ETC.	(JMP,,,,,.ETMW3) ;[2005]	;[2005] NO
	.ETC.	(STR,.EC,,,,,<argument >)	;[2005] YES
	.ETC.	(DEC,.EP!.EC,,,,P4)		;[1751]
.ETMW2:	.ETC.	(STR,.EC,,,,,< in call to routine >)
.ETMW4:	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(NLN,.EC)			;[2005]
	.ETC.	(STR,.EC,,,,,<called from module >) ;[2005]
	.ETC.	(SBX,.EC!.EP,,,,R2)		;[2005]
	.ETC.	(STR,.EC,,,,,< at location >)
	.ETC.	(OCT,.EP,,,,T2)
	POPJ	P,
.ETMW3:	.ETC.	(STR,.EC,,,,,<returned value>)	;[2005]
	.ETC.	(JMP,,,,,.ETMW2) 	;[2005]
SUBTTL	COMPILER SPECIFIC ROUTINES


DEFINE X(A,B,C,D)<		;;[1225] ACCOUNT FOR EXTRA ARG
  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,D)<		;;[1225] ACCOUNT FOR EXTRA ARG
	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
;[1433] COBOL

C68NAM:	JUMPE	T2,CPOPJ	;[1120] OK FIRST TIME
	TXNE	T2,C74BIT	;[1433] TEST FOR COBOL-74
	JRST	E$$CMC		;[1174] NOT ALLOWED
	TXNE	T2,CBLBIT	;[1433] TEST FOR COBOL
	JRST	E$$CM6		;[1433] NOT ALLOWED
	TXNE	T2,C68BIT	;[1433] OR IF COBOL-68 ALREADY SEEN
	POPJ	P,		;[1120] DONE
E$$CMF::.ERR.	(MS,.EC,V%L,L%F,S%F,CMF,<COBOL module must be loaded first>) ;[1545]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

C74NAM:	JUMPE	T2,CPOPJ	;[1120] OK FIRST TIME
	TXNE	T2,C68BIT	;[1433] TEST FOR COBOL-68
	JRST	E$$CMC		;[1174] NOT ALLOWED
	TXNE	T2,CBLBIT	;[1433] TEST FOR COBOL
	JRST	E$$CM7		;[1433] NOT ALLOWED
	TXNN	T2,C74BIT	;[1433] OR IF COBOL-74 ALREADY SEEN
	JRST	E$$CMF		;[1174]
	POPJ	P,		;[1227] DONE

CBLNAM:	JUMPE	T2,CPOPJ	;[1433] OK FIRST TIME
	TXNE	T2,C68BIT	;[1433] TEST FOR COBOL-68
	JRST	E$$CM6		;[1433] NOT ALLOWED
	TXNE	T2,C74BIT	;[1433] TEST FOR COBOL-74
	JRST	E$$CM7		;[1433] NOT ALLOWED
	TXNN	T2,CBLBIT	;[1433] OR IF COBOL ALREADY SEEN
	JRST	E$$CMF		;[1433]
	POPJ	P,		;[1433] DONE

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]
E$$CM6::.ERR.	(MS,.EC,V%L,L%F,S%F,CM6,<Cannot mix COBOL-68 and COBOL compiled code>) ;[1433]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1433]

E$$CM7::.ERR.	(MS,.EC,V%L,L%F,S%F,CM7,<Cannot mix COBOL-74 and COBOL compiled code>) ;[1433]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1433]
;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

PASNAM:				;[1435] SAME TEST FOR PASCAL
FOROK:	MOVE	T1,OTSEG	;[2300] DID USER SPECIFY NON-REENT OTS?
	SOJE	T1,CPOPJ	;YES, SO LOAD TWO SEG CODE IN TWO SEGMENTS
	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::SKIPE	NOCMX		;[1262] HAS THIS ERROR BEEN PRINTED BEFORE?
	JRST FOROK		;[1262] YES, DON'T PRINT IT AGAIN
	SETOM	NOCMX		;[1262] FLAG THIS AS SEEN
	.ERR.	(MS,.EC,V%L,L%W,S%W,CMX,<Cannot mix GFloating FORTRAN compiled code with FORTRAN compiled code>)	;[1753]
	.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	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	T2,W1		;[1320] GET TYPE
	CAIN	T2,5		;[1320] 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,FXHLD0	;[1320] STORE ZERO IN CASE ASCII TEXT
	CAILE	T2,3777		;[1320] ASCII TEXT BLOCK?
	SKIPA	T1,[0]		;[1320] YES, STORE ONLY ONE WORD
	CAILE	T2,377		;[1320] OLD STYLE REL BLOCK?
	JRST	FXHLD0		;[1320] NO, LONG COUNT IS OK
	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##	;[2262] 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
	CAIE	T1,$SSGHIGH	;[1246] WANT SYMBOLS IN HIGH SEGMENT?
	JRST	GOSYM		;[1246] NO - CHECK DEFAULT
	SKIPE	HC.LB		;[1246] HIGH SEG EXIST YET?
	JRST	GOSTRT		;[1246] YES - NO NEED TO CREATE ONE
	SETZ	W1,		;[1246] USE DEFAULT ORIGIN
	PUSHJ	P,SETRC##	;[1246] AND SET UP THE HIGH SEGMENT
	MOVEI	T1,$SSGHIGH	;[1246] RESTORE T1 TO /SYMSEG:HIGH
GOSYM:	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	NOSTRT		;[1232] UNDEFINED
	  JRST	NOSTRT		;[1232] 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.

NOSTRT:	PUSHJ	P,E$$USA	;[1232] NOTIFY THE USER
	JRST	GOUPTO		;[1232] GO CHECK /UPTO:

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] ...
	POPJ	P,		;[1232] DONE
;NOW TO CHECK THE /UPTO SYMBOL, IF ANY

GOUPTO:	MOVE	W2,SYMLIM	;[1175] GET /UPTO VALUE
	SKIPN	SYMLMS		;[2220] 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
	SETZM	SYMLMS		;[2220] NO LONGER SYMBOLIC
	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
	SETZM	SYMLMS		;[2220] AND NOT SYMBOLIC
	; ..
	; ..

;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:	MOVEI	T1,TP.IX	;[2270] NOW DELETE TYPECHECKING AREA
	PUSHJ	P,XX.ZAP##	;[2270] GET RID OF IT
	PUSHJ	P,RETPSC	;[2270] RETURN PSECT/COMMON BLOCKS
	MOVEI	R,1		;[1305] SET UP FOR LOW SEG
	MOVE	R,@SG.TB	;[1305]
	MOVE	T1,HP.S1	;[1305] GET .LOW. PSECT BREAK
	CAMLE	T1,RC.HL(R)	;[1305] IS IT HIGHER?
	MOVEM	T1,RC.HL(R)	;[1305] PUT IT IN THE PSECT BLOCK
	SKIPN	LL.S2		;[1305] IS THERE A HIGH SEG?
	JRST	LODXI1		;[1305] NO - IGNORE HP.S2
	MOVEI	R,2		;[1305] SET UP FOR HIGH SEG
	MOVE	R,@SG.TB	;[1305]
	MOVE	T1,HP.S2	;[1305] GET .HIGH. PSECT BREAK
	CAMLE	T1,RC.HL(R)	;[1305] IS IT HIGHER?
	MOVEM	T1,RC.HL(R)	;[1305] PUT IT IN THE PSECT BLOCK
LODXI1:	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
IFN TOPS20,<			;[2242]
	PUSHJ	P,CHK.RC	;[2242] MAKE SURE ALL PAGES EXIST 
> ;[2242] IFN TOPS20
	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

;[2227] Here to return the common/psect blocks
RETPSC:	SKIPN	R,CPSECT	;[2227] Get the base of the list
	 POPJ	P,		;[2227] Nothing to do
RETPS0:	HLRZ	T2,PC.PSC(R)	;[2227] Get the psect name
	TRNE	T2,770000	;[2227] Short symbol?
	 JRST	RETPS1		;[2227] Yes, don't return much
	HRRZ	T1,PC.PSC(R)	;[2227] Get it's address
	 PUSHJ	P,DY.RET##	;[2227] Give it back
RETPS1:	HLRZ	T2,PC.CMN(R)	;[2227] Get the common name
	TRNE	T2,770000	;[2227] Short symbol?
	 JRST	RETPS2		;[2227] Yes, don't return much
	HRRZ	T1,PC.CMN(R)	;[2227] Get it's address
	 PUSHJ	P,DY.RET##	;[2227] Give it back
RETPS2:	MOVE	T1,R		;[2227] Get the block address
	MOVEI	T2,PC.SIZ	;[2227] And the length
	MOVE	R,PC.LNK(R)	;[2227] Point to the next one
	PUSHJ	P,DY.RET##	;[2227] Give this one back
	JUMPN	R,RETPS0	;[2227] Return them all
	POPJ	P,		;[2227] Done
;[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:
IFE TOPS20,<			;[2247]
	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
	SKIPN	W1		;[2065] ANYTHING IN .ABS.?
	CAILE	W2,140		;[2065] OR IN .LOW.?
	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
CHKLL1:				;[2247]
>;[2247] IFE TOPS20
;FALL THROUGH TO NEXT PAGE
;HERE TO UPDATE HL.S1 FROM PSECT INFO, IF NEEDED

	MOVE	R,RC.NO		;[2247] 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
	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]
	SKIPGE	RC.AT(T2)	;[2247] HAS THE PSECT BEEN USED?
	 JRST	CHKBN2		;[2247] NO (MUST BE UNUSED .LOW.)
	PUSH	P,T1		;[1234] SAVE PTR TO PSEG
	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]
	POP	P,T1		;[1234] RESTORE PTR TO PSEG
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:	MOVE	T2,LN.12(W1)	;[2273] GET END ADDRESS
	JUMPE	T2,B12END	;NONE
	MOVE	W3,(W1)		;[2273] LAST ADDRESS
	PUSHJ	P,SEGCHK	;GET IN CORE ADDRESS
	  JRST	[TXO	T2,CPF.RR	;[2200] 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,2*LN.12	;[2273] 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

IFN TOPS20,<			;[2242]
;[2242] Here to make sure all sections exist
;[2243] Also insure that that RC.HL is not below RC.CV
;[2242] Uses R, W1, W2, P1, and T1-T4 (in RC.CHK)

CHK.RC:	MOVE	R,RC.NO		;[2242] Start at the last psect
RCCHK0:	MOVE	W1,@RC.TB	;[2242] Get pointer to RC block
	MOVE	W2,RC.CV(W1)	;[2243] Get current value
	CAMLE	W2,RC.HL(W1)	;[2243] Higher than "highest loaded"?
	 MOVEM	W2,RC.HL(W1)	;[2243] Yes, probably /REDIRECT - fix it
	MOVE	W2,RC.IV(W1)	;[2242] Get the base of the psect
	CAML	W2,RC.HL(W1)	;[2262] Empty psect?
	 JRST	RCCHK2		;[2242] Yes, don't create section
	HLLZS	W2		;[2242] Make it section,,0
RCCHK1:	MOVE	P1,W2		;[2242] Put it in in correct AC
	MOVE	T4,RC.SG(W1)	;[2242] Get the index
	SKIPE	P1		;[2242] Don't bother for section zero
	PUSHJ	P,NEWSCT##	;[2242] Make sure it exists
	ADD	W2,[1,,0]	;[2242] Next section
	CAMGE	W2,RC.HL(W1)	;[2243] This section in psect?
	 JRST	RCCHK1		;[2242] Yes, create it too
RCCHK2:	SOJG	R,RCCHK0	;[2242] Done with this one, do others
	POPJ	P,		;[2242] No more
>;[2242] IFN TOPS20
;HERE TO SETUP FILE/SYMBOL:ALGOL IF NEEDED, AND STORE THE
;FILESPEC IN THE FIRST ALGOL OWN BLOCK SEEN THIS LOAD


ALGCHK::SKIPN	NOSYMS		;[1265] /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##	;..
	MOVE	T1,IO.PTR+%SC	;[1230] FORCE ALGOL SYM FILE TO
	MOVX	T2,<Z AC,>	;[1230]   USE CHANNEL AC
	MOVEM	T2,I.CHN(T1)	;[1230]   ..
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
	HLRZ	P4,MNTYPE	;[1256] GET MAIN PROCESSOR TYPE
	JUMPN	P4,LIBOVL	;[1256] IS THERE ONE?
	MOVE	T1,LIBPRC	;[1256] NO - GET THE LIST OF ONES USED
	ANDCM	T1,NOLIBS	;[1256] BUT NOT THE ONES ELIMINATED
	JFFO	T1,.+1		;[1256] FIND THE NUMBER OF THE FIRST ONE
	MOVE	P4,T2		;[1256] PUT IT AS ARG FOR QREENT
LIBOVL:				;[1256]
	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:	MOVE	T1,1(P1)	;[1315] GET LANGUAGE TYPE BITS
	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
	MOVE	P4,T1		;[2013] PASS COMPILER TYPE TO MAIN PRG PROC
	TDNN	T2,NOLIBS	;[2013] 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
	MOVE	P4,T2		;[1225] PASS COMPILER TYPE TO SUBROUTINE PROC
	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,D)<		;;[1225] ACCOUNT FOR EXTRA ARG
 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,D)<		;;[1225] ACCOUNT FOR EXTRA ARG
 IF1,<
	BLOCK	1
 >
 IF2,<
  IFDEF B'.L1,<
	EXP	B'.L1
  >
  IFNDEF B'.L1,<
	EXP	CPOPJ
>>>

PRCTBL:	PROCESSORS
;DEFINE A TABLE OF THE HIGH SEGMENT ORIGIN FOR EACH COMPILER'S OTS, WHEN THE OTS
;IS TO BE BROUGHT IN AT RUNTIME.


DEFINE X(A,B,C,D)<		;;[1225] EXPAND THE OTS ORIGINS
  IFB <D>,<			;;[1225] IF NO ORIGIN, JUST SET TO 0
	EXP	0		;NO RUNTIME OTS FOR C
  >				;;[1225]   ..
  IFNB <D>,<			;;[1225] ELSE EXPAND THE ORIGIN
	EXP	D		;START OF C OTS
  >				;;[1225]   ..
>				;[1225]


OTSTBL:	PROCESSORS		;[1225] GENERATE THE TABLE


	SALL
;HERE TO DO SPECIAL ACTION FOR SOME PROCESSORS
FOR.L0:			;[2300]
	MOVX	P4,CT.FOR	;WE'VE NOW SELECTED FORTRAN'S OTS
	PUSHJ	P,QREENT	;SEE IF WE WANT REENT OTS
	  JRST	FORL03		;[1271] NO
	MOVX	W1,PT.SGN!PT.SYM
	MOVE	W2,['FOROT%']	;SPECIAL SYMBOL
	MOVEI	W3,400000+.JBHDA
				;[2025] Set 5A FOROTS origin,
				;[2025] this is the last using FOROT%
	PUSHJ	P,SY.GS##	;DEFINE IT
	PUSHJ	P,FORL03	;[1271] 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.

FORL04:	MOVE	P2,F.NXZR	;[1271] 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:	PUSHJ	P,FORL03	;[1271] LOAD THE LIBRARY
	SKIPE	T1,OTSEG	;[1271] GET THE /OTS: SWITCH
	CAIE	T1,1		;[1271] /OTS:NONSHAR?
	SKIPE	HL.S2		;[1271] NO - HIGH SEG EXIST?
	POPJ	P,		;[1271] LEAVE IT TWOSEG
	PJRST	FORL04		;[1271] MAKE IT /SEG:LOW
FORL03:	MOVE	P1,['FORLIB']	;[2300] 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
C68.L0:			;[1433]
C68.L1:	MOVE	P1,['LIBOL ']   ;[1433]
	PJRST	LOAD1
C74.L0:
C74.L1:	MOVE	P1,['C74LIB']
	PJRST	LOAD1

CBL.L0:
CBL.L1:	MOVE	P1,['COBLIB']
	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

PAS.L0:	PUSHJ	P,QREENT	;[1435] SEE IF WE WANT REENT OTS
	  SKIPA	W2,['PASOT%']	;[1435] NO, DEFINE SPECIAL SYMBOL
;[1451]	JRST	PASL01		;[1435] YES
	JRST	[ TLO	FL,L.FLS
		  TRO	FL,R.FLS
		  JRST	PASL01 ];[1451] FORCE LIBRARY LOAD TO LOWSEG
	MOVX	W1,PT.SGN!PT.SYM
	SETO	W3,		;[1435] GIVE IT A DEFINITE VALUE
	PUSHJ	P,SY.GS		;[1435] DEFINE IT
PASL01:	MOVX	W1,PT.SGN!PT.SYM	;[1435]
	MOVE	W2,['PASDT%']	;[1435] LOOKUP SPECIAL SYMBOL
	SETZ	W3,		;[1435] PROBABLY NOT REQUIRED
	PUSHJ	P,TRYSYM	;[1435]
	  JRST	PASLUK		;[1435] UNKNOWN
	  JRST	PASLUD		;[1435] UNDEFINED
	JRST	PAS.L1		;[1435] HERE WHEN PASDT% IS ALREADY DEFINED
				;[1435]  USER HAS LOADED PASDDT BY HAND, DO NOTHING
;PASDT% IS UNKNOWN, USER DID NOT COMPILE WITH DEBUGGER SWITCH, DO NOT LOAD PASDDT.
;[1435] GIVE ERROR IF /DEB:PAS SEEN

PASLUK:	SKIPN	PASDFL		;[1435] /DEB:PAS SEEN?
	JRST	PAS.L1		;[1435] NO, DO NOTHING
	.ERR.	(MS,0,V%L,L%W,S%W,PCD,<PASCAL program not compiled with debug switch, PASDDT not loaded>)
	JRST	PAS.L1		;[1435] AND CONTINUE

PASLUD:

PAS.L1:	MOVE	P1,['PASLIB']	;[1435] LOAD PASCAL LIBRARY
	JRST	LOAD1		;[1435]

QREENT:
IFN TOPS20,<			;[2366]
	MOVE	T1,FXSBIT	;[2224] GET THE SECTION BITS
	TDNE	T1,[^-1B0]	;[2224] ANY NON-ZERO SECTIONS?
	 JRST	QREEN2		;[2224] YES
>;[2366] IFN TOPS20

IFE TOPS20,<			;[2366]
	MOVE	T1,HL.S1	;[2366] GET THE HIGHEST LOADED
	TLNE	T1,-1		;[2366] OUTSIDE OF SECTION ZERO?
	 JRST	QREEN2		;[2366] YES
>;[2366] IFE TOPS20

	MOVE	T1,OTSTBL(P4)	;[1225] ARE WE TOO CLOSE TO ORIGIN OF
	SUBX	T1,LN.OTS	;[1225]   OTS IF BROUGHT IN AT RUNTIME?
	CAMLE	T1,HL.S1	;[1225]   ..
	JRST	QREEN1		;[1131] NO--GO TRY FOR SHARABLE RUNTIME 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?
	MOVE	T1,SYMSEG	;[1312] GET /SYMSEG
	SUBI	T1,$SSGHIGH	;[1312] IN CASE /SYMSEG:HIGH
	SKIPN	NOSYMS		;[1312] DON'T CHECK IF NO SYMBOLS
	JUMPE	T1,CPOPJ	;[1312] NONSHARABLE IF /SYMSEG:HIGH
	HLRZ	T1,PRGPDV	;[2224] GET THE PDV KEYWORD
	CAIE	T1,$SSGHIGH	;[2224] /PVBLOCK:HIGH?
	SKIPE	HL.S2		;[1225] NO, GREAT. HIGH SEG EXIST YET?
	POPJ	P,		;[1225] YES--MUST LOAD OTS
	MOVE	T1,OTSTBL(P4)	;[1225] NO--GET OTS AT RUNTIME--MAKE SURE SYMBOL
	SUBI	T1,1		;[1225]   DOESN'T GROW INTO RUNTIME OTS BY
	SKIPN	SYMLIM		;[1225]   FORCING /UPTO: JUST UNDER IT (UNLESS
	MOVEM	T1,SYMLIM	;[1225]   USER SPECIFIED DIFFERENT /UPTO:)
	JRST	CPOPJ1		;[1225] ALLOW GETSEG AT RUNTIME

;[2224] Here if non-zero sections
QREEN2:	SKIPE	T1,OTSEG	;[2224] Has user specified /OTS?
	SOJE	T1,CPOPJ	;[2224] Yes, /OTS:NONSHARABLE?
	JRST	CPOPJ1		;[2224] No, re-entrant 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::
IFE TOPS20,<
	STATZ	DC,IO.EOF	;EOF?
> ;[1402] IFE TOPS20
IFN TOPS20,<
	SKIPG	RFLEN
> ;[1402] IFN TOPS20
	JRST	EOF		;YES
E01EIF::
IFE TOPS20,<
	PUSH	P,[DC]		;[1174] SAVE CHANNEL FOR LNKLOG
	.ERR.	(ST,0,V%L,L%F,S%F,EIF) ;[1174]
> ;[1402] IFE TOPS20
IFN TOPS20,<
	PUSHJ	P,JSERR##	;[2301] SET UP THE JSYS ERROR
	.ERR.	(MS,.EC,V%L,L%F,S%F,EIF)
	.ETC.	(FSP,.EC,,,,DC) ;[2301]
	.ETC.	(NLN,.EC)	;[2301]	NEW LINE FOR ERROR TEXT
	.ETC.	(STR,,,,,ERRJSY) ;[2301] TYPE ERSTR% TEXT

> ;[1402] IFN TOPS20

;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
IFE TOPS20,<
	STATZ	DC,IO.EOF	;EOF?
> ;[1402] IFE TOPS20
IFN TOPS20,<
	SKIPG	RFLEN
> ;[1402] IFN TOPS20
	POPJ	P,		;YES.
	JRST	D.ERR		;NO, INPUT ERROR
;
IFE TOPS20,<
;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		;[1467] 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
> ;[1402] IFE TOPS20
IFN TOPS20,<
;
; THIS ROUTINE MAPS THE REL FILE TO A BUFFER SEVERAL PAGES AT A TIME.
; CURRENT FILE PAGE IS KEPT IN LSTBLK.
; COUNT OF BYTES LEFT IN FILE IS KEPT IN RFLEN
; WHEN RFLEN GOES NEGATIVE END OF FILE HAS BEEN SEEN.
; DCBUF+1 ( BUFFER BYTE POINTER ) AND DCBUF+2 ( BUFFER LENGTH ) ARE SET UP.
; T1,T2 AND T3 ARE USED BUT PRESERVED.
; RETURNS +1 IF ALL OK, +2 IF PMAP FAILED OR END-OF-FILE ON ENTRY.

;[2366] NOTE THAT THIS BUILDS A 444400 STYLE BYTE POINTER, WHICH IS NOT
;[2366] THE SAME AS THE TOPS-10 IN UUO.  IF THIS IS CHANGED HERE, CODE
;[2366] IN X160B2 IN LNKNEW WILL ALSO HAVE TO BE CHANGED.

D.CNT::					;[1467]
	SKIPGE	RFLEN			;END OF FILE ENCOUNTERED ALREADY?
	JRST	CPOPJ1			; +2 RETURN
	SPUSH	<T1,T2,T3>		;WE'LL NEED THE TEMPS
	MOVE	T1,DCBUF		;PICK UP BUFFER BEGINNING
	MOVE	T2,T1			; T2 GETS PAGE #
	LSH	T2,-9
	HLL	T1,[POINT 36,0]		;AND RESET BUFFER BYTE POINTER
	MOVEM	T1,DCBUF+1
	HRLI	T2,.FHSLF		;PROCESS IS SELF
	HRL	T1,DC.JF		;PICK UP FILE JFN
	HRR	T1,LSTBLK		;AND CURRENT FILE BLOCK
	MOVE	T3,[PM%CNT!PM%RD!PM%PLD!<LN.BF_-9>]
	PMAP%
	  ERJMP	[ SPOP <T3,T2,T1>	; RESTORE TEMPS
		  JRST CPOPJ1		; AND PROPAGATE ERROR
		]
	MOVEI	T1,<LN.BF_-9>		; INCREMENT CURRENT FILE BLOCK
	ADDM	T1,LSTBLK
	MOVEI	T1,LN.BF		;
	MOVEM	T1,DCBUF+2		; RESET BUFFER BYTE COUNT
	MOVE	T2,RFLEN		; DECREMENT FILE BYTE COUNT
	CAMGE	T2,T1			; IF LESS THAN A BUFFERFUL IS LEFT
	MOVEM	T2,DCBUF+2		; SAY SO
	SUB	T2,T1
	MOVEM	T2,RFLEN
	SPOP	<T3,T2,T1>		; RESTORE TEMPS
	POPJ	P,
> ;[1402] IFN TOPS20
IFN TOPS20,<

RDSKP::

;	RDSKP
;	Call:
;		MOVEI	T1,<target page>
;		PUSHJ	P,RDSKP
;
;	Action:
;		Moves the rel file buffer to encompass the target page,
;		enabling one to skip intermediate pages.
;		Saves all registers, modifies RFLEN and LSTBLK.
	SPUSH	<T2,T3>			;SAVE ACS FOR SCRATCH USE
	MOVE	T2,LSTBLK		;T2: BUFFER'S END
	SETZM	T3			;T3: COUNTER
RDSKP1:	CAMG	T2,T1			;BUFFER INCLUDES TARGET PAGE?
	  JRST	[ MOVEI T2,<LN.BF_-9>(T2)
		  MOVEI T3,LN.BF(T3)
		  JRST RDSKP1 ]
	MOVEI	T2,-<LN.BF_-9>(T2)
	MOVEI	T3,-LN.BF(T3)		;BACKUP
	CAML	T3,RFLEN		;PAST END OF FILE?
	JRST	[ SPOP <T3,T2>
		  JRST CPOPJ1 ]		;PROPAGATE ERROR SKIP
	MOVNS	T3			;-COUNT
	ADDM	T3,RFLEN		;FUDGE COUNT
	MOVEM	T2,LSTBLK		;FUDGE BUFFER'S END
	SPOP	<T3,T2>			;RESTORE ACS
	PUSHJ	P,D.CNT		;AND CALL THE READER
	JRST	CPOPJ			;PROPAGATE SUCCESS
	JRST	CPOPJ1			; OR FAILURE
					; END OF RDSKP
>	;[1402] IFN TOPS20
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
IFN TOPS20,<
	SPUSH	<T1,T2,T3>	;SET REGISTERS ASIDE
	MOVE	T2,DCBUF	;PICK UP BUFFER PTR
	LSH	T2,-9		;MAKE IT A PAGE
	MOVEI	T1,DC		;PICK UP CHANNEL POINTER
	MOVEM	T1,IO.CHN	;FOR DVCLS.
	HRLI	T2,.FHSLF
	MOVE	T3,[PM%CNT!<LN.BF_-9>]
	SETOM	T1
	PMAP			;LET GO THE MAPPED PAGES
	SETZM	RFLEN		;[1402] ZERO OUT PAGES
	PUSHJ	P,DVCLS.##	;AND CLOSE THE ASSOCIATED FILE
	SPOP	<T3,T2,T1>	;RESTORE REGS
> ; [1402] IFN TOPS20
	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