Google
 

Trailing-Edge - PDP-10 Archives - bb-r775d-bm_tops20_ks_upd_4 - sources/lnkold.mac
There are 50 other files named lnkold.mac in the archive. Click here to see a list.
TITLE	LNKOLD - LOAD OLD BLOCKS MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/RKH/JBC/JNG/DCE/MCHC/DZN/PY/MFB/PAH/HD/JBS 11-Feb-85


;COPYRIGHT (C) 1974, 1985 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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,LNKLOW,MACTEN,UUOSYM,SCNMAC
SEARCH	OVRPAR			;[1400]
IFN TOPS20,<SEARCH MONSYM>	;[1401]
SALL

ENTRY	LNKOLD
EXTERN	LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST


CUSTVR==0		;CUSTOMER VERSION
DECVER==6		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==2356		;DEC EDIT VERSION

SEGMENT


;LOCAL ACC DEFINITIONS
INTERN	R,RB,WC

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


;START OF VERSION 1A
;43	FORTRAN-10 LOCAL SYMBOLS IN COMMON NOT FIXED UP CORRECTLY
;46	ADD KLUDGE FEATURE
;47	INTEGRATE WITH SCAN %4, ADD DATE75 HACK
;54	ADD KIONLY D.P. INST.
;61	ADD STORE CODE IN CORE FOR T.3 TWOSEG FIXUPS
;62	FIX BUG IN BLOCK TYPE 11 (POLISH FOR FORTRAN-10)
;63	ADD EXTERNAL START ADDRESS IN BLOCK TYPE 7
;71	ADD MORE STANDARD MESSAGES
;72	(11315) CTYPE NOT CLEARED ON UNKNOWN COMPILER TYPE
;75	FIX ALGOL OWN BLOCK, CALL ADCHK. ROUTINE
;101	MORE FIXES FOR FAIL CODE IF UNDEF GLOBAL REQUEST
;102	ADD TEST AND CURE FOR NO END BLOCK
;104	PUT FAIL BLOCK HEADERS IN LOCAL SYMBOL TABLE
;105	MAKE BLOCK TYPE 12 WORK
;106	ALLOW HIGH SEG TO LOAD AT ADDRESS OTHER THAN 400000
;107	REPLACE KLUDGE BY MIXFOR
;111	MAKE MIXFOR WORK EVEN IF NOT SEARCH MODE
;116	FIX UNDEFINED SYMBOL COUNT IN FAIL BLOCKS
;126	CHANGE CALLING SEQUENCE ON ADDRESS CHECKING AND STORING INTO CORE
;130	(12315) NOT ALL SYMBOL COPIED WHEN PREVIOUSLY REQUESTED COMMON IS DEFINED
;133	CAN NOT LOAD LIBSAI (SAIL LIBRARY), RETURN FROM T.11EV IS WRONG
;131	(12431) OCCASIONALLY ABS SYMBOLS SHOW AS REL IN MAP

;START OF VERSION 2
;135	ADD OVERLAY FACILITY
;136	FIX VARIOUS BUGS
;143	MAKE /INCLUDE WORK BETTER
;144	(12772) DON'T STORE SFD FOR MAP IF BOTH WORDS ARE 0
;162	CHANGE W1 TO W3 IN T.14 CODE TO AVOID CONFLICT WITH OVERLAYS
;166	READ BACK RADIX50 SYMBOL FILES (TYPE 776)
;171	(13234) FIX ILL MEM REF IF FORTRAN-10 PROG TOO BIG
;174	FIX BUGS IN RELOCATABLE OVERLAYS
;201	MAKE FORDDT WORK
;206	FIX CHAINED REF IF NOT ALL OF CHAIN IN CORE
;210	(13461) MORE OF #172, FIX BLOCK TYPE 16 CORRECTLY
;212	FIX ZEROS IN SYMBOL TABLE BUG AT T.5XPL
;217	STORE POLISH FIXUP POINTER RELOCATED INCASE CORE MOVES
;START OF VERSION 2B
;225	ADD SUPPORT FOR PSECT (FOR MACRO VERSION 51)
;227	(13779) TEST TEMP LOCAL SWITCH AT T.37
;236	CORE EXP BUG IN SY.RUA, P1 DESTROYED BEFORE BEING USED
;241	SEPARATE LOW SEG REL CODE FROM ABS CODE FOR HIGHEST LOC CALCULATIONS
;250	Correct genereation of header fixups for MAP.
;252	Check each file during a libary search of indexed library
;	if /INCLUDE files yet to be loaded.
;274	Fix to load DATA into COMMON in the HGH segment from
;	a module placed in the LOW segment.
;275	Fix multiply defined GLOBALS when one program
;	.REQUIRES another.
;303	Get page size right for TOPS20 or FTVM
;310	Warn user when high segment is too big
;311	Try to allocate HC on a page boundary for TENEX
;317	Correct initialization before call to TRYSYM
;320	Reinitialize user virtual address before call to
;	page in window
;	to search symbol table
;325	Prevent loop when forcing TWOSEG into single segment
;	and high segment break is same as start (length of 0).
;326	Re-work edit 252 to always work.
;	Ignore block 14 when /INCLUDE: is given
;347	INCLUDE EDITS 303,310,311 IN MAINTENANCE SOURCES. LABEL EDITS 227,
;	236,241.
;350	DELETE REFERENCES TO RSYM
;353	REMOVE EDIT 225
;364	If TITLE block is paged out when HISEG block
;	is seen, generate a FIXUP instead of giving up.
;366	Only use 18 bit addresses to call CHKSEG from T.2CHK
;371	Move definition of .ERSFU to LNKCOR.
;373	Load COMMON correctly on a /SEGMENT:HIGH.
;375	Make T.COMM store the COMMON in the local symbol table.
;404	Re-insert edits 323, 334, and 340, which got lost.
;START OF VERSION 2C
;437	Prevent LNKDUZ errors by flushing redundent RH fixups
;441	Correct improper loading of COMMON when /SEG:HIGH
;457	Update LIBPRC in T.6 along with PROCSN.
;465	Clean up customer type dispatch, and allow block type 100.
;471	Add code for ALGOL debugging system.
;500	Make RADIX-50 symbol files with more than 255 symbols work.
;506	Don't search bound globals when processing types 4 or 14.
;513	Combine the common functions of T.6 and T.776 into subroutines.
;514	Always set up the left half of R correctly in RB.1
;515	Always respect PH.ADD when loading overlays.
;517	Change ABLLEN to LN.ABL
;523	Get args right on call to PH.HSG to improve loading efficiency.
;527	Save R1 over call to TTLREL in T.776.
;530	Define triplet flags correctly for TXxx macros.
;531	Give error message if user loads universal file.
;532	Get creation time right on MAP.
;543	Fix problems with loading & searching for partial definitions.
;544	SOUP in LINK version 3 stuff for TOPS-20.
;545	Make .LINK work properly when paging.
;546	Delete an extra line inserted by SOUP.
;550	Prevent ILL UUO on polish fixup to non-loaded local.
;552	Organize .REQUEST/.REQUIRE database.
;553	Don't jump to DDT if $LOCATION is 0 (edit 302).
;557	Clean up the listing for release.

;START OF VERSION 3
;445	INSERT OLD EDITS TO POLISH SYMBOL FIXUPS
;446	DELETE HSO ERROR MESSAGE
;447	ADD 3 NEW POLISH OPERATORS

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;562	Fix ?ILL MEM REF searching indexed library when an entry
;	point is seen for a symbol already partially defined.
;563	Prevent erroneous ?LNKIMM messages.
;565	Fix block type 10 with /ONLY:LOW.
;567	Prevent ?LNKISP on multiple partial definition.
;571	Prevent ?ILL MEM REF when one require file requires another
;572	Make sure LS addr in core before doing POLISH symbol fixup
;577	Generate LS fixup when local block name chain paged out.
;603	Change all references to PPDL to LN.PPD.
;611	Support COBOL-74
;612	Fix various POLISH bugs.
;626	Don't search bound globals on a partial definition.
;632	Implement $FIXUP.
;633	Never throw a Polish fixup away after symbols point to it.
;650	Use VM on TOPS-10 if available.
;654	Pass relative GS addr to LS.ADE.
;662	Update NAMPTR in T.776.
;673	Change the LIT message to the RBS message.
;700	Put in 2 more PSECT index checks and $SYMBOL check.
;701	Don't do block type 100 when doing library search.
;702	Save AC R in Type 776 processing.
;707	Keep chains separate if the first chain is not less.
;711	Fix bug with MAP when only 1 psect in a module.
;722	Implement PSECT attributes.
;731	SEARCH MACTEN,UUOSYM
;732	Store lowest location and fix bugs related to page 777.
;735	Remove Repeat 0 around polish operators 20-24,-10.
;742	Fix bug with using LOWLOC code.
;745	Adjust symbol table limit when setting up reloc counter .HIGH.
;753	Fix bug in SETRCY, when .HIGH. RC slot is already taken.
;757	Dont clear RC.HL for overlayable PSECTs in Block 5 processing.
;761	Give error if code is loaded into a relocatable PSECT.
;763	Add Block 24. Modify Block 22 and Block 23.
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF VERSION 4A
;767	Fix a bug to prevent LINK from looping when forced dump of lc is done.
;777	Fix allocation of COMMON when a block is referenced first, defined later.
;1000	Add code for block 1070 support.
;1101	Fix searching indexed libraries that have some modules not
;	represented in the index.
;1114	Zero count of COBOL symbols and ALGOL OWNs in T.5A.
;1115	Add LNKHCL message to complain about loading high seg in non-root link.
;1120	Make T.6 handle mask of CPU bits rather than a single value.
;1132	Check for PSECT seen in this module with AT.PS; preserve RC.HL
;1137	Don't change RC.CUR in T.24.
;1140	Clear LSTSYM if a non-loaded local is encountered.
;1153	Give LNKIPX if block 24 is illegal.
;1154	Don't re-order PSECT indices in T.23; general re-write of T.23.
;1155	Allow PSECT .HIGH. to work as TWOSEG.
;1156	Clear RC.CUR before reading data words in T.5.
;1166	Make sure default PSECT index is first half word in T.11.
;1170	Set up HC.S2 in SETRC in case hiseg contains only BLOCKs.
;1174	Label and clean up all error messages.
;1204	Give LNKPTL message if program exceeds 777777, remove LNKHSL.
;1210	Allow 1 word block 5, allow break of exactly 1,,0 (relocated).
;1213	Delete the ISD message, setup special fixup if multiple partial defs.
;1217	Clean up the listings for release.
;1220	Release on both TOPS-10 and TOPS-20 as version 4A(1220).

;START OF VERSION 4B
;1224	Test more carefully for bad polish blocks, and give more messages.
;1231	Initialize HL.S2 in SETRC so high segment really exists with /SET:.HIGH..
;1233	Just consider RC.CV in T.5.
;1237	Make LNKCCD not fatal, print it only once.
;1240	Test bits from /CPU switch when checking for CPU conflict.
;1243	Handle left half fixups to global symbols correctly.
;1245	Fix typo in edit 1224.
;1253	Remove edit 1233, must consider RC.HL
;1273	Make RC.HL for .HIGH. and .LOW. only keep count for current module.
;1274	Add code to handle Polish stack overflow. Build larger stack and BLT.
;1276	Don't set SEG:HIGH up unless module is being loaded.
;1300	Implement RC.LM tests, check AT.RP for Psect which needs address.
;1303	Change the LNKLNM message to also include the file name.
;1304	Use RC.MAP to convert local psect numbers into internal numbers.
;1306	Output LNKMPT error if TWOSEG mixed with PSECT.
;1327	Fix left half fixup case missed by edit 1243.
;1330	Add functions 30, 34 ,70 ,74 to type 2 block.

;START OF VERSION 5
;1400	Use OVRPAR.MAC and implement writable overlays.
;1401	Nativize overflow file handling.
;1402	Nativize REL file handling.
;1417	Fix bug involved in skipping index blocks, broken in 1402.
;1421	Fix bug in displaying .REL file creation dates, broken by 1402.
;1434	Add T.1004 support.
;1442	Don't let high segments be put in nonzero sections.
;1450	Fix ext addr bugs, remove hard-wired sect 0 tests.
;1463	Don't miss the sect number relocation at T.11ST.
;1466	Don't miss the sect number reloaction at T.11RD.

;Start of Version 5.1

;1473	Bracket extended-addressing-specific code if not done already.
; Edits 1500-1677 Reserved for Maintenance
;
;1501	Don't lose section number in PSECT reloc at T.11EV.
;1502	Suppress typeout of garbage names when halfword chained fixup
;	routines are called from T.11ST.
;1504	Fix typo in test at T.2+2 for 30-bit relocation.
;1512	Test MODTYP, not RC.CUR, to determine if PSECTs have been loaded.
;1517	Remove edit 1512.
;1536	Set section number when paging multisection LS area.
;1715	Don't lose PSECT break info.
;1716	Do correct relocation at R.CUR.
;1717	Do left halfword relocation correctly in R.CUR.
;1731	Make TOOBIG and T.1OVE global symbols.
;1736	Strip unsupported FMXFOR code.
;1754	Make symbols global for use by Type 1072 code, also enable new operators
;1756	Make PSECT breaks keep their section numbers during relocation	
;1761	keep user defined start address section numbers during relocation
;1764	Make user specified entry vectors work in non-zero sections
;1765	Put back -10 code removed by edit 1764.
;1766	Remove line inserted in edit 1715
;1772	Change edit 1765 from FTFRK2 conditional to TOPS20 conditional 
;1775	Make absolute start addresses work.
;1776	Restructure T.1AD to be callable as a subroutine.
;2003	Make LNKCCD a warning.
;2026	Update copyright notices and cleanup listing.
;2047	Remove code which makes wrong decision about COMMON block loading.
;2057	Don't hang if symbol table is fouled up.
;2064	Clear P1 in T11CHx to avoid HALT when loading relocatable overlays.

;Start of Version 6
;2200	Use 30 bit addresses in fixups.
;2201	Use fullword replacement deferred fixup for polish fullword store.
;2202	Use 30 bit addresses for xx.IN and xx.OUT, remove FTFRK2 and NONZER.
;2203	In type 11 blocks keep section numbers of relocated halfwords.
;2204	Don't lose section numbers in the type 10 block.
;2205	Allow big common blocks in psects, absolute address loads in psects.
;2207	Don't add 1 to external psect number before converting to internal.
;2212	Make some type 11 block routines global so type 1072 can use them.
;2214	Add 30 bit fixup support.
;2215	Don't have GBCK.L zero pages which have been unmapped.
;2216	Handle long symbols in SY.GS and SY.QS.
;2220	Handle long common block names.
;2222	Add conflicting attributes messages, make routines global for T.105x.
;2223	Add psect redirection.
;2226	Remove unnecessary long compare for /INCLUDE, /EXCLUDE in type 6 block.
;2230	Give ?LNKCMP error if common in multiple incompatible psects.
;2233	Make sure a default psect is set if loading psects.
;2240	Don't merge chains if old chain starts at section,,0.
;2244	Handle big psect breaks correctly in T.23B.
;2247	Don't create .LOW. if not used, don't start paging on TOPS-20.
;2253	Create .LOW. if /SEG:LOW and FORTRAN style type 3 block.
;2254	Use 30 bit fields in LS area, remove FAIL block header chain.
;2255	Use only 30 bit addresses in LS fixups.
;2262	Don't section-check absolute addresses, add global entry for T.1160.
;2264	Don't throw away section number of symbol in type 1 block.
;2272	Create high segment if redirecting it to .HIGH.
;2273	Fix type 12 blocks, use 30 bit addresses.
;2301	Don't use native message for non-native rel file open.
;2305	Make SY.RC0 global so it can be called from 1070 code.
;2307	Remove bad tests which cause incorrect LNKPEL errors.
;2324	Make polish chained fixup handlers clear P1 before calling SY.CHx.
;2326	Change CAMN in T6SCN1 to PUSHJ P,NAMCMP - make T.6RED and T.6RC global.
;2332	Use fullword value in symbol fixups.
;2356	Remove unnecessary TOPS20 conditionals.
COMMENT	\

ALL OLD LINK ITEMS (BLOCK TYPES) HAVE THE SAME GENERAL FORMAT.
THE FIRST WORD IS THE BLOCK HEADER
	LEFT HALF IS BLOCK TYPE
	RIGHT HALF IS DATA WORD COUNT
THEN FOLLOWS ONE OR MORE 18 WORD SUB-BLOCKS.
EACH SUB-BLOCK IS PRECEDED BY A BYTE WORD CONTAINING 18 2-BIT BYTES
THE BYTE WORDS ARE NOT INCLUDED IN THE DATA WORD COUNT

	----------------
	! TYPE ! COUNT !
	----------------
	! BYTE   WORD  !
	----------------
	! DATA   WORDS !
	----------------
	     ...
	----------------
	! BYTE   WORD  !
	----------------
	! DATA   WORDS !
	----------------
\
SUBTTL	BLOCK DISPATCH TABLES


ODSPTB:	LITYPE (0,37)

ODISPL==.-ODSPTB
	XALL
FDSPTB:	LITYPE	(700,777)
FDISPL==.-FDSPTB
	SALL
SUBTTL	DISPATCH TO OLD BLOCK TYPE


;ENTER WITH BLOCK TYPE IN T1
;ALSO IN W1

LNKOLD:	CAIL	T1,ODISPL*2	;IS IT LEGAL TYPE
	JRST	OLDERR		;NO, SEE IF CUSTOMER SUPPLIED
	TRNE	FL,R.LIB!R.INC	;IN LIBRARY SEARCH MODE OR /INC MODE?
	JRST	T.SRCH		;YES, IGNORE IF NOT BLOCK TYPE 4
	CAIGE	T1,ODISPL	;SEE WHICH HALF OF TABLE TO USE
	SKIPA	T2,ODSPTB(T1)	;USE RIGHT HALF
	HLRZ	T2,ODSPTB-ODISPL(T1)	;USE LEFT HALF
	JRST	(T2)		;DISPATCH


;HERE TO SEE IF "ILLEGAL" LINK ITEM IS IN LNKCST
OLDERR:	CAIL	T1,700		;700-777 (SPECIAL FILE TYPES)?
	JRST	OLDFIL		;YES, GO HANDLE
	CAIL	T1,100		;IN DEC 100-377 RANGE?
	JRST	OLD100		;YES, DISPATCH
	JRST	LNKCST##	;ELSE MUST BE CUSTOMER 40-77
				;OR CUSTOMER 402-677


;HERE ON A FILE TYPE. DISPATCH TO THE PROPER ROUTINE.
OLDFIL:	CAIL	T1,700+FDISPL*2	;LEGAL FILE TYPE?
	JRST	E$$IRB##	;[1174] NO, GIVE ERROR MESSAGE
	HRREI	T2,-<700+FDISPL>(T1)	;GET OFFSET TYPE
	JUMPGE	T2,.+2			;IF NEGATIVE, USE RHS
	SKIPA	T2,FDSPTB+FDISPL(T2)	;USE RIGHT HALF
	HLRZ	T2,FDSPTB(T2)	;USE LEFT HALF
	JRST	(T2)		;DISPATCH


;HERE ON TYPES 100-377, EASY SINCE THERE'S ONLY TYPE 100 (SO FAR)
OLD100:	CAIN	T1,100		;IS IT .ASSIGN OPERATOR?
	JRST	T.100		;YES, NO PROBLEM
	JRST	E$$IRB##	;[1174] NO, ILLEGAL
;HERE IF IN LIBRARY SEARCH MODE - TEST FOR BLOCK TYPE 4, 6, 14

T.SRCH:	CAIN	T1,4		;IS IT ENTRY BLOCK?
	JRST	T.4		;YES, SEE IF WE WANT IT
	CAIN	T1,6		;TITLE BLOCK (INCASE /INCLUDE)
	JRST	T.6
	CAIN	T1,14		;INDEX BLOCK?
	JRST	T.14A		;YES, READ INDEX TO SEE IF PROG REQUIRED
	CAIE	T1,5		;END BLOCK?
	JRST	T.0		;NO, IGNORE THIS BLOCK
	PUSHJ	P,T.5ENT	;REMOVE ALL ENTRY POINTS STORED FOR THIS PROG
	HRR	FL,FLAGS	;RESTORE INCASE /EXCL WAS ON
	JRST	T.0		;AND IGNORE BLOCK
SUBTTL	BLOCK TYPE 0 - ALGOL OR JUNK WORD


;	----------------
;	!    0 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! DATA   WORDS !
;	----------------

T.0:	HRRZ	T1,W1		;GET WORD COUNT
	JUMPE	T1,LOAD##	;JUST IGNORE
	CAIG	T1,^D18		;ONLY ONE SUB BLOCK?
	AOJA	T1,T.0A		;YES
	IDIVI	T1,^D18		;GET NUMBER OF SUB BLOCKS
	IMULI	T1,^D19		;COUNT RELOCATION WORD
	JUMPE	T2,T.0A		;ANY REMAINDER?
	ADDI	T1,1(T2)	;IT HAS RELOCATION WORD ALSO
T.0A:	CAML	T1,DCBUF+2	;ENOUGH WORDS IN BLOCK?
	SOJA	T1,T.0B		;NO, BUT ACCOUNT FOR INITIAL ILDB
	ADDM	T1,DCBUF+1	;ADVANCE BYTE POINTER
	MOVN	T1,T1		;NEGATE
	ADDM	T1,DCBUF+2	;COUNT DOWN WORD COUNT
	JRST	LOAD##		;GET NEXT BLOCK

T.0B:	SUB	T1,DCBUF+2	;COUNT DOWN WORDS IN BUFFER
	PUSHJ	P,D.INP##	;GET NEXT BUFFER
	JRST	T.0A		;FINISH OFF BLOCK

;[1434] Called from T.1, T.21, and T.1004

T.0C:	JUMPE	W3,CPOPJ	;[1434] T.1004 RETURN
	PUSHJ	P,RB.1		;GET NEXT WORD
	  JRST	LOAD##		;ALL DONE
	JRST	.-2
SUBTTL	BLOCK TYPE 1 - CODE AND DATA


;			  OR
;	----------------	----------------
;	!    1 ! COUNT !	!    1 ! COUNT !
;	----------------	----------------
;	! BYTE   WORD  !	! BYTE   WORD  !
;	----------------	----------------
;	!      ADDRESS !	!       SYMBOL !
;	----------------	----------------
;	! DATA   WORDS !	!       OFFSET !
;	----------------	----------------
;				! DATA   WORDS !
;				----------------

T.1:	HRRZI	W3,-1(W1)	;GET WORD COUNT OF DATA
	PUSHJ	P,RB.1		;READ ONE WORD AND RELOCATE IT
	  JRST	LOAD##		;GET NEXT BLOCK
	TLZ	R,-1		;CLEAR LEFT HALF NON-RELOC FLAG
	JUMPGE	W1,T.1NS	;[2205] NOT SYMBOLIC
	MOVEI	T1,1		;BLOCK TYPE INCASE ERROR
	PUSHJ	P,T.1S		;SYMBOLIC IF BIT 0 SET
	ADD	W1,W2		;[2205] GET START ADDRESS IN W1
T.1NS:	HLLZ	T1,LSTRRV	;[2264] GET THE SECTION NUMBER
	ADD	W1,T1		;[2264] ADD IT TO THE ADDRESS
	MOVE	P3,W1		;SAVE START ADDRESS IN P3
	ADD	W1,W3		;HIGHEST ADDRESS NEEDED
	SETO	W3,		;[1434] NOT TYPE 21 OR 1004
	PUSHJ	P,T.1AD		;[1776] SET UP WINDOWS AND COUNTERS
	 JRST	T.0C		;[1776] WE DON'T WANT THIS BLOCK
	 JRST	T.1LPJ		;[1776] DEFER THIS DATA
	JRST	T.1DP		;[1776] ALL SET, LOAD IT

T.1AD::

;[1776] Global Routine 
; Used by T.1, T.21, T.1004 and T.1010-T.1034 processing.
; Expects P3 to contain the first address to load.
; Expects W1 to contain the last address to load.
; May call LNKCOR or cause paging of areas.
; Returns three ways:
;	nonskip	- the block should not be loaded
;	skip +1 - the destination is not resident
;	skip +2 - P3 points to the resident destination
 
	POP	P,T1		;[1776] PICK UP RETURN ADDR
	SPUSH	<P1,P2>		;[1776] SAVE PERMANENT REGS
	PUSH	P,T1		;[1776] AND RESTACK THE RETURN

	JUMPE	R,T1AD1		;[2262] SKIP THIS IF ABSOLUTE
	HLRZ	T1,W1		;[1412] SECTION OF START
	HLRZ	T2,P3		;[1412] SECTION OF END
	CAMN	T1,T2		;[1412] CROSSED A BOUNDARY?
	JRST	T1AD1		;[1412] NO, PROCEED AS USUAL
	MOVE	T1,RC.AT(R)	;[1412] CHECK ATTRIBUTES
	TXNE	T1,AT.NZ	;[1776] NONZERO SECTIONS OK?
	TXNE	T1,AT.NC	;[1776] CROSSING OK?
	PUSHJ	P,E$$PTL	;[1412] NO, TELL USER

T1AD1:
	MOVE	P2,W1		;GET LOCATION REQUIRED
	.JDDT	LNKOLD,T.1AD,<<CAML P2,$LOCATION##>,<CAMLE P3,$LOCATION>,<JRST .+3>,<SKIPE $LOCATION>>
	JUMPE	R,T.1A		;SPECIAL CHECK IF ABSOLUTE ADDRESS
T1AD2:	MOVE	T1,RC.SG(R)	;[2205] GET SEGMENT NUMBER
	CAILE	T1,1		;STORE TO LOW SEGMENT
	JRST	T.1H		;NO, CHECK HIGH
	TRNE	FL,R.HSO	;ONLY WANT HIGH SEG CODE?
	JRST	T1ADX0		;[1776] LEAVE NONSKIP
	CAMLE	P2,HL.S1	;RESET HIGHEST LOCATION COUNTER
	MOVEM	P2,HL.S1
	CAMLE	P2,HC.S1	;AND HIGHEST DATA LOADED COUNTER
	MOVEM	P2,HC.S1
	CAMLE	W1,RC.HL(R)	;TEST AGAINST HIGHEST SEEN SO FAR
	MOVEM	W1,RC.HL(R)	;A NEW RECORD
T.1AL:
	CAMLE	W1,RC.LM(R)	;[1300] IS FIRST UNUSED ADDR TOO BIG?
	PUSHJ	P,TOOBIG	;[1300] YES, ERROR
IFN FTOVERLAY,<
	CAMGE	P3,PH+PH.ADD	;[1400] MAKE SURE ADDRESSIS LEGAL
	JRST	T.1OVE		;NOT IN THIS LINK
	SKIPE	RT.LB		;RELOCATION TABLE SETUP?
	PUSHJ	P,RT.P2##	;YES, SETUP BYTE PTR
>
IFE TOPS20,<			;[2247]
	SKIPE	PAG.S1		;PAGING?
>;[2247] IFE TOPS20
	JRST	T.1LP		;YES, SEE IF IN CORE
IFE TOPS20,<			;[2247]
IFN FTOVERLAY,<
	SUB	P2,PH+PH.ADD	;[1400] REMOVE BASE
	SUB	P3,PH+PH.ADD	;[1400] SO AS NOT TO WASTE SPACE
>
	CAMGE	P3,LOWLOC	;[732] GOT THE LOWEST LOCATION?
	JRST	T.1LOW		;[732] YES, JUMP
T.1AL1:	ADD	P2,LC.LB	;[732] RELOCATE RELATIVE ADDRESS
	CAMG	P2,LC.AB	;WILL IT FIT IN EXISTING SPACE?
	JRST	T.1L1		;YES
	SUB	P2,LC.AB	;GET EXTRA REQUIRED
	MOVEI	P1,LC.IX	;AREA REQUIRED TO EXPAND
	PUSHJ	P,LNKCOR##	;TRY TO GET MORE SPACE
IFE FTOVERLAY,<
	  JRST	T.1LP		;FAILED BUT MUST BE ON DSK BY NOW
> ;END OF IFE FTOVERLAY
IFN FTOVERLAY,<
	  JRST	[ADD	P3,PH+PH.ADD	;[1400] DSK RTNS WANT ABS ADDRESS
		JRST	T.1LP]		;MUST BE ON DSK BY NOW
> ;END OF IFN FTOVERLAY
T.1AL0:	SUB	P3,LW.S1	;[732] INCASE WE DUMPED CORE FOR FIRST TIME
>;[2247] IFE TOPS20
T.1L1:	ADD	P3,LC.LB	;FINALLY FIX THIS INCASE CORE MOVED
	JRST	T1ADX2		;[1776] +2 SKIP RETURN
IFE TOPS20,<			;[2247]
;HERE IF LOWEST LCATION AND NO PAGING(MUST BE THE FIRST TIME)
T.1LOW:	PUSH	P,P3		;[732]
	TRZ	P3,777		;[732] ROUND DOWN TO PAGE BOUNDARY
	MOVEM	P3,LOWLOC	;[732] UPDATE LOWEST LOCATION
	SKIPN	UW.LC		;[732] SKIP TO RETURN IF NOT FIRST TIME
	CAIGE	P3,400000	;[732] GREATER THAN 128K?
	JRST	[POP	P,P3		;[732]
		JRST	T.1AL1]		;[732] NO, PROCEED AS USUAL
	PUSH	P,P3		;[732]
	PUSH	P,P2		;[732] YES, SAVE REAL LOCATIONS A WHILE
	MOVEI	T1,777777	;[732]
	SUBI	T1,(P3)		;[732]
	SETZ	P2,		;[767][732] NO EXPANSION, PREVENT LOOPING
	PUSHJ	P,LC.DMP##	;[742] FORCE CURRENT WINDOW TO DISK
	  JFCL
	CAILE	T1,2*LN.WD-1	;[732] USE SMALLER OF THE TWO
	MOVEI	T1,2*LN.WD-1	;[732]
	MOVE	P2,T1		;[732]
	MOVEI	P1,LC.IX	;[732] AND THE AREA INDEX
	MOVE	T2,LC.AB	;[732] DO WE NEED TO EXPAND CORE FIRST?
	SUB	T2,LC.LB	;[732] GET LENGTH
	CAMG	T1,T2		;[732] NEED MORE THAN WE HAVE?
	JRST	T.1LO1		;[743] NO NEED TO EXPAND CORE
	ADDI	P2,1		;[732] YES, EXPAND FIRST
	PUSHJ	P,LNKCOR##	;[732] GO ALLOCATE THAT MUCH
	  JFCL			;[742]
T.1LO1:	POP	P,P2		;[742] RESTORE TO REAL LOCATION
	POP	P,LW.LC		;[742] WINDOW STARTS AT LOWEST LOCATION
	MOVE	T1,LC.AB	;[732] CACULATE WINDOW'S UPPER BOUND
	SUB	T1,LC.LB	;[732] FROM CURRENT CORE LENGTH
	ADD	T1,LW.LC	;[732]
	MOVEM	T1,UW.LC	;[732] AND UPDATE
	POP	P,P3		;[732]
	JRST	T.1AL0		;[732]
> ;[1755] IFE TOPS20
;HERE IF PAGING TO SEE IF ADDRESS IS
;LESS THAN 140
;OR IF IN CORE
;IF GREATER THAN 137 READ IN FROM DSK
T.1LP:	MOVE	P2,W1		;RESET VIRTUAL ADDRESS
	CAIGE	P2,.JBDA	;IN JOBDAT AREA?
	SKIPN	LW.S1		;YES, ONLY IN CORE IF ON BLOCK 1
	CAIA			;NO SUCH LUCK
	JRST	T1ADX1		;[1776] NOT RESIDENT
	PUSH	P,W3		;PG.LSG SOMETIMES CRUMPS W3
IFN FTOVERLAY,<
	SUB	P2,PH+PH.ADD	;[1400] PG.LSG WANTS OFFSET ADDRESSES
	SUB	P3,PH+PH.ADD	;[1400] SO BUMP DOWN BY PH.ADD
> ;END OF IFN FTOVERLAY
	PUSHJ	P,PG.LSG##	;MAKE FULL TEST AND READ IN
	POP	P,W3
	JRST	T.1L1		;NOW IN CORE
;HERE FOR ABSOLUTE CODE THIS CAN GO TO EITHER HIGH OR LOW SEGMENT
;KEYED UPON LL.S2, USUALLY TO LOW SEG
T.1A:	TRNN	FL,R.RED	;[2223] DOING /REDIRECT?
	 SKIPGE	MODTYP		;[2247] OR DOING PSECTS?
	 JRST	T.1AP		;[2205] YES, TRY TO PUT IT IN A PSECT
T.1A1:	MOVEI	R,2		;ASSUME HIGH
	TRNE	FL,R.TWSG	;MUST BE LOW IF ONLY ONE SEG
	CAMGE	P2,LL.S2	;SEE WHICH SEGMENT
	TDZA	R,R		;LOW, RESET BACK TO ABS
	JRST	T.1HA		;HIGH SEG
	TRNE	FL,R.HSO	;ONLY WANT HIGH SEG CODE?
	JRST	T1ADX0		;[1776] YES, NONSKIP RETURN
	MOVE	R,@RC.TB	;SETUP POINTER TO ABS RC BLOCK
	CAMLE	W1,RC.HL(R)	;KEEP TRACK OF LARGEST ABS ADDRESS
	MOVEM	W1,RC.HL(R)	;MIGHT BE USEFUL SOME DAY
	CAMLE	P2,HL.S0	;RESET HIGHEST LOCATION COUNTER
	MOVEM	P2,HL.S0
	CAMLE	P2,HC.S0	;AND HIGHEST DATA LOADED COUNTER
	MOVEM	P2,HC.S0
	MOVEI	R,1		;TREAT AS LOW SEG
	MOVE	R,@SG.TB	;SET UP POINTER TO RC BLOCK
	JRST	T.1AL		;TREAT AS IF LOW SEGMENT DATA

;[2205] Here to figure out psects.  If the area being stored is entirely
;[2205] in one psect, set up as a store to that psect.  This is the case
;[2205] with FORTRAN style COMMON, which uses a symbol+offset load address.
;[2205] treat it the same as non-psected.  This attempts to avoid problems
;[2205] with the memory map in the program data vector, which is psect
;[2205] oriented. An optimization is to try the "current" psect in RC.CUR,
;[2205] before looping through the psects.
;
T.1AP:	MOVE	R,RC.CUR	;[2205] Get the current psect
	MOVE	R,@RC.TB	;[2205] Point to it
	CAML	P3,RC.IV(R)	;[2205] Below the bottom of the psect?
	 CAMLE	W1,RC.CV(R)	;[2205] No, below the top?
	SKIPA	R,RC.NO		;[2205] Not this one, loop through them all
	JRST	T1AD2		;[2205] Now have a value for R
T1AP1:	MOVE	T1,@RC.TB	;[2205] Point to it
	CAML	P3,RC.IV(T1)	;[2205] Below the bottom of the psect?
	 CAMLE	W1,RC.CV(T1)	;[2205] No, below the top?
	SOJG	R,T1AP1		;[2205] Not in this psect
	JUMPE	R,T.1A1		;[2205] If not in a psect, put it in .ABS.
	MOVE	R,T1		;[2205] Put the pointer in R
	JRST	T1AD2		;[2205] Now have a value for R
T.1HA:	MOVE	R,@SG.TB	;FIXUP R FOR ABS TO HIGH
T.1H:	CAMLE	W1,RC.LM(R)	;[1300] IS FIRST UNUSED ADDR TOO BIG?
	PUSHJ	P,TOOBIG	;[1300] YES, ERROR
	TRNE	FL,R.LSO	;WANT LOW SEG CODE ONLY
	JRST	T1ADX0		;[1776] YES, NONSKIP RETURN
	SUB	P2,LL.S2	;REMOVE 400000 RELOCATION OFFSET
	SUB	P3,LL.S2	;SINCE THE ARE RELATIVE TO 0 NOW
	CAMLE	P2,HL.S2	;RESET HIGHEST LOCATION COUNTER
	MOVEM	P2,HL.S2
	CAMLE	P2,HC.S2	;AND HIGHEST DATA LOADED COUNTER
	MOVEM	P2,HC.S2
	SKIPE	PAG.S2		;PAGING?
	JRST	T.1HP		;YES
	ADD	P2,HC.LB	;RELOCATE RELATIVE ADDRESS
	CAMG	P2,HC.AB	;FIT IN WHAT WE HAVE?
	JRST	T.1H1		;YES
	SUB	P2,HC.AB	;GET EXTRA REQUIRED
	MOVEI	P1,HC.IX	;IN THIS AREA
	PUSHJ	P,LNKCOR##	;GET IT NOW
	  JRST	T.1HP		;NOW IN CORE
	SUB	P3,LW.S2	;INCASE CORE DUMPED FOR FIRST TIME
T.1H1:	ADD	P3,HC.LB
	CAMLE	W1,RC.HL(R)	;TEST AGAINST HIGHEST SEEN SO FAR
	MOVEM	W1,RC.HL(R)	;A NEW RECORD
	JRST	T1ADX2		;SKIP RETURN

T.1HP:	MOVE	P2,W1		;RESET USER VIRTUAL ADDRESS
	SUB	P2,LL.S2	;MAKE RELATIVE TO SEGMENT START
	PUSHJ	P,PG.HSG##	;MAKE FULL TEST AND READ IN
	JRST	T.1H1		;NOW IN CORE

T.1OVE::AOS	W3,LNKMAX	;[1731] POINT TO RIGHT LINK
	CAIGE	P3,.JBDA	;MAKE ONLY A WARNING IF TO JOB DATA AREA
	JRST	T.1OVW		;IT WAS
E$$DSL::.ERR.	(MS,.EC,V%L,L%F,S%F,DSL,<Data store to location >) ;[1174]
T.1OVF:	.ETC.	(OCT,.EC!.EP,,,,P3)
T.1OVG:	.ETC.	(STR,.EC,,,,,< not in link number >)
	.ETC.	(DEC,.EP!.EC,,,,W3)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	JRST	T1ADX0		;[1776] NONSKIP RETURN

T.1OVW:	SOS	LNKMAX		;PUT LINK # BACK
E01DSL::.ERR.	(MS,.EC,V%L,L%F,S%W,DSL) ;[1174]
	.ETC.	(JMP,.EC,,,,T.1OVF)

T1ADX2:	AOS	(P)		;[1776] +2 RETURN
T1ADX1:	AOS	(P)		;[1776] +1 RETURN
T1ADX0:	POP	P,T1		;[1776] NORMAL RETURN
	SPOP	<P2,P1>		;[1776] GET IT ALL BACK
	JRST	(T1)		;[1776] AND RETURN

T.1DP::
;[1776]	JUMPE	W3,CPOPJ1	;[1434] JUST RETURN TO CALLER (T.1004)
IFN FTOVERLAY,<
	SKIPE	RT.LB		;[1401] DOING OVERLAYS?
	SKIPA	P1,[JSP T1,CS.RHS##]
				;[1401] YES, NOTE OVL RELOC
> ;[1401] END OF IFN FTOVERLAY
	MOVE	P1,[MOVEM W1,(P3)]
				;[1401] NO, SIMPLE DEPOSIT
T1DP1:	PUSHJ	P,RB.1		;GET THE DATA WORDS
	  JRST	LOAD##		;FINISHED BLOCK
	XCT	P1		;[1401] DO IT
	SOJE	W3,CPOPJ	;T.21 RETURN
	AOJA	P3,T1DP1	;WILL RETURN TO LOAD WHEN RUN OUT


T.1LPJ:	PUSHJ	P,RB.1		;GET DATA WORD
	  JRST	LOAD##		;ALL DONE
	HRRZ	T2,P3		;ADDRESS OF WHERE TO LOAD
	EXCH	W1,W3		;DATA IN W3, BUT SAVE OLD W3
	TXO	T2,CPF.RF	;[2200] LOAD OFFSET FOR FULL REPLACEMENT
	MOVEI	R,LC.IX		;MUST BE LOW SEG
	PUSHJ	P,SY.CHP##	;LINK IN LIST
	EXCH	W1,W3		;GET W3 BACK INCASE TYPE 21
	SOJE	W3,CPOPJ	;ALL DONE IF IT WAS
	AOJA	P3,T.1LPJ	;SEE IF ANY MORE (USUALLY NOT)

CHKSZ0::			;[2222]
	PUSH	P,R		;[1300] FREE UP REGISTER
	MOVE	R,RC.CUR	;[1300] GET CURRENT BLOCK NUMBER
	MOVE	R,@RC.TB	;[1300] GET POINTER TO BLOCK
	CAMLE	W1,RC.LM(R)	;[1300] PSECT TOO BIG?
	PUSHJ	P,TOOBIG	;[1300] YES
	POP	P,R		;[1300] NO, CLEAN UP
	POPJ	P,		;[1300] AND RETURN
TOOBIG::SPUSH	<T1,T2>		;[1731] SAVE SOME REGISTERS
	MOVE	T1,RC.AT(R)	;[1300] GET THE ATTRIBUTES	
	TXOE	T1,AT.LE	;[1300] LIMIT EXCEEDED BEFORE?
	JRST	TOOBI1		;[1300] YES, DON'T PRINT MESSAGE
	MOVEM	T1,RC.AT(R)	;[1300] SET LIMIT EXCEEDED BIT
	MOVE	T1,RC.LM(R)	;[1300] SET LIMIT TO 1,,0
	MOVE	T2,RC.NM(R)	;[1300] GET THE PSECT NAME
E$$PEL::.ERR.	(MS,.EC,V%L,L%F,S%W,PEL,<PSECT >) ;[1300]
	.ETC.	(SBX,.EC!.EP,,,,T2) ;[1300]
	.ETC.	(STR,.EC,,,,,< exceeded limit of  >) ;[1300]
	.ETC.	(OCT,.EC!.EP,,,,T1)	;[1300]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1300]
	SETOM	BADCORE		;[1300] SET SO NO FIXUPS GET DONE
TOOBI1:	SPOP	<T2,T1>		;[1300] RESTORE THE REGISTERS
	POPJ	P,		;[1300]

E$$PTL::.ERR.	(MS,.EC,V%L,L%F,S%F,PTL,<Program too long>)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1204]
;HERE IF FIRST WORD IS A SYMBOL
;SECOND WORD IS OFFSET
;[2205] Return:
;[2205] W2: Value of symbol
;[2205] W1: Offset

T.1S:	MOVE	W2,W1		;EXPECTED IN W2
	LDB	T2,[POINT 4,W2,3]	;CHECK CODE NOT JUST SIGN BIT
	CAIE	T2,14		;MUST BE RADIX50 60,
	JRST	E$$IRB##	;[1174] GIVE ERROR MESSAGE
	PUSHJ	P,R50T6		;SIXBITIZE IT
T.1S6::	MOVX	W1,PT.SGN!PT.SYM!PS.GLB	;[1434] SET SOME REASONABLE FLAGS
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED
	  JRST	T.1ND		;NOT EVEN IN TABLE
	  JRST	T.1UN		;UNDEFINED, SO STILL NO USE
	MOVE	W2,2(P1)	;GET VALUE
IFN FTOVERLAY,<
	CAMGE	W2,PH+PH.ADD	;[1400] MAKE SURE ARRAY IS IN THIS LINK
	JRST	T.1SE		;NO, MUST BE COMMON IN FATHER LINK
>
	PUSHJ	P,RB.1		;READ OFFSET
	  JFCL			;CANNOT HAPPEN
	SOJA	W3,CPOPJ	;ONE LESS REAL DATA WORD
IFN FTOVERLAY,<
T.1SE::	MOVE	W2,1(P1)	;[2262] ITS NOT, GET NAME
	TLNN	W2,770000	;[2262] A LONG NAME?
	 ADD	W2,GS.LB	;[2262] YES, IT'S IN THE GS AREA
	AOS	W3,LNKMAX	;POINT TO RIGHT LINK
E$$DSC::.ERR.	(MS,.EC,V%L,L%F,S%F,DSC,<Data store to common >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(STR,.EC,,,,,< not in link number >)
	.ETC.	(DEC,.EP!.EC,,,,W3)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
>


;HERE IF SYMBOLIC ADDRESS NOT YET DEFINED
T.1UN:	MOVE	T1,CURTYP	;[1434] GET BLOCK TYPE
	CAIN	T1,1004		;[1434] BLOCK TYPE 1004 IS DIFFERENT
	JRST	T1004U##	;[1434] SO DO ERROR RECOVERY THERE
	PUSHJ	P,T.1FX		;[1434] PUT WHOLE BLOCK IN FIXUP TABLE
E01CNW::.ERR.	(MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
	.ETC.	(STR,,,,,,<T.1UN1>)	;[1434]

;HERE IF SYMBOL NOT EVEN IN TABLE
T.1ND:	MOVE	T1,CURTYP	;[1434] GET BLOCK TYPE
	CAIN	T1,1004		;[1434] BLOCK TYPE 1004 IS DIFFERENT
	JRST	T1004U##	;[1434] SO DO ERROR RECOVERY THERE
	PUSHJ	P,T.1FX		;[1434]PUT WHOLE BLOCK IN FIXUP TABLE
T.1ND1:	MOVEI	T2,.L*2		;NEED AT LEAST 2 TRIPLETS
	PUSHJ	P,GS.GET##	;IN GLOBAL AREA
	MOVX	W1,FP.LBT	;LOADER BLOCK TYPE
	MOVEM	W1,.L(T1)	;STORE FLAGS
	MOVEM	W3,.L+1(T1)	;AND REL POINTER
	MOVX	W1,PT.SGN!PT.EXT!PT.SYM!PS.REQ!PS.UDF!PS.FXP
	SETZB	W3,2(T1)	;ZERO VALUE
	DMOVEM	W1,0(T1)	;FLAGS & SYMBOL
	MOVE	W3,T1		;INSERT EXPECTS POINTER IN W3
	SUB	W3,NAMLOC	;RELATIVE
	HRRZ	P1,@HT.PTR	;SETUP P1 AGAIN
	ADD	P1,NAMLOC
	PJRST	INSRT##		;AND STORE SYMBOL
;HERE TO PUT WHOLE BLOCK IN FIXUP  TABLE
;W3 CONTAINS WORD COUNT -1
;BUT WE HAVE ALREADY READ 
;HEADER	1,,WORD COUNT
;BYTE WORD
;FIRST DATA ITEM
;DATA IS STORED WITH ONE OVERHEAD WORD OF FLAG BITS ,, POINTER

T.1FX:	MOVEI	T1,1(W3)	;GET WORD COUNT BACK
	IDIVI	T1,^D18		;BUT IT DOESN'T INCLUDE BYTE WORDS
	IMULI	T1,^D19		;AS ONE PER SUB-BLOCK
	SKIPE	T2
	ADDI	T1,1(T2)	;PLUS ONE FOR PARTIAL BLOCK
	MOVEI	T2,2(T1)	;PLUS FLAGS AND HEADER
	PUSHJ	P,FX.GET##	;THATS WHAT WE NEED
	MOVE	W3,T1		;SAVE FOR LATER FIXUP TO GLOBAL
	SUB	W3,FX.LB	;SO WE DON'T FORGET THAT IT'S RELATIVE
	.JDDT	LNKOLD,T.1FX,<<CAMN W3,$FIXUP##>>	;[632]
	HRLI	T1,(POINT 36,)	;EASY WITH A BYTE POINTER
	MOVX	W1,FP.SGN!FP.PTR	;SOME FLAGS
	IDPB	W1,T1		;STORE
	POP	P,W1		;RESTORE DATA COUNT
	HRLI	W1,1		;FAKE HEADER UP
	IDPB	W1,T1
	MOVE	W1,RB		;GET RELOCATION BITS
	LSH	W1,-2		;WE'VE ALREADY GOT ONE WORD
	IDPB	W1,T1
T.1FLP:	PUSHJ	P,D.IN1##	;READ NEXT DATA WORD
	IDPB	W1,T1		;STORE IT
	SOJG	T2,T.1FLP	;LOOP TIL DONE
	POPJ	P,
SUBTTL	BLOCK TYPE 2 - SYMBOLS


;	----------------
;	!    2 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!       SYMBOL !
;	----------------
;	!        VALUE !
;	----------------

;READS A PAIR OF WORDS IN W1 AND W2
;CONVERTS THEN TO NEW TRIPLET FORM IN W1, W2, AND W3
;AND CHANGES RADIX-50 SYMBOL IN W2 TO SIXBIT SYMBOL IN W2

T.2:	PUSHJ	P,RB.2		;GET TWO WORDS
	  JRST	LOAD##		;GET NEXT BLOCK
	IOR	W1,LSTRRV	;[2200] INCLUDE ANY SECTION DATA
	MOVE	W3,W1		;PUT VALUE IN W3 WHERE IT BELONGS
	MOVX	W1,PT.SGN!PT.SYM	;SET SYMBOL FLAGS
	LDB	P1,[POINT 4,W2,3]	;PICK UP LEADING 4 BITS
	PUSHJ	P,R50T6		;CONVERT TO SIXBIT SYMBOL
	MOVE	P4,T3		;[1213] SAVE RADIX50 SYMBOL NAME
	.JDDT	LNKOLD,T.2,<<CAMN	W2,$SYMBOL##>>
	SKIPE	R		;SYMBOL RELOCATABLE?
	TXO	W1,PS.REL	;YES
	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	PUSHJ	P,@T.2STB(P1)	;YES, SEE IF NEEDED
	  PUSHJ	P,@T.2TAB(P1)	;GET TO RIGHT ROUTINE
	JRST	T.2		;RETURN FOR NEXT PAIR
;JUMP TABLE TO HANDLE CODE BITS OF RADIX-50 SYMBOL
;UNKNOWN TYPES GIVE ERROR

T.2TAB::E$$URC			;[1174]  0 - 00 NAME (SHOULD NEVER HAPPEN)
	SY.GS			; 1 - 04 GLOBAL DEFINITION
	SY.LS			; 2 - 10 LOCAL DEFINITION
	SY.BH			; 3 - 14 BLOCK HEADER (FAIL)
	E$$URC			;[1174]  4 - 20
	SY.DGR			; 5 - 24 [1330] GLOBAL DEFERRED DEF (RH)
	SY.DGL			; 6 - 30 [1330] GLOBAL DEFERRED DEF (LH)
	SY.DGB			; 7 - 34 [1330] GLOBAL DEFERRED DEF (LH,RH)
	E$$URC			;[1174] 10 - 40
	SY.GSS			;[1330] 11 - 44 GLOBAL DEF. (SUPPRESSED)
	SY.LSS			;12 - 50 LOCAL DEF. (SUPPRESSED)
	E$$URC			;[1174] 13 - 54
	SY.RQ			;14 - 60 GLOBAL REQUEST
	SY.DSR			;15 - 64  [1330] GLOBAL DEFERRED DEF (RH) SUPP.
	SY.DSL			;16 - 70 [1330] GLOBAL DEFERRED DEF (LH) SUPP.
	SY.DSB			;17 - 74 [1330] GLOBAL DEFERRED DEF (LH,RH) SUPP.

E$$URC::.ERR.	(MS,.EC,V%L,L%F,S%I,URC,<Unknown radix-50 symbol code >) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,P1)
	.ETC.	(STR,.EC,,,,,< >)
	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	POPJ	P,		;BUT CONTINUE
;JUMP TABLE IF SELECTIVE LOADING OF EITHER LOW OR HIGH SEGMENT

T.2STB::CPOPJ			; 0 - 00 NAME (SHOULD NEVER HAPPEN)
	T.2CHK			; 1 - 04 GLOBAL DEFINITION
	T.2CHK			; 2 - 10 LOCAL DEFINITION
	CPOPJ			; 3 - 14 BLOCK HEADER (FAIL)
	CPOPJ			; 4 - 20
	T.2CHK			; 5 - 24 [1330] GLOBAL DEFERRED DEF (RH)
	T.2CHK			; 6 - 30 [1330] GLOBAL DEFERRED DEF (LH)
	T.2CHK			; 7 - 34 [1330] GLOBAL DEFERRED DEF (LH,RH)
	CPOPJ			;10 - 40
	T.2CHK			;11 - 44 [1330] GLOBAL DEF. (SUPPRESSED)
	T.2CHK			;12 - 50 LOCAL DEF. (SUPPRESSED)
	CPOPJ			;13 - 54
	T.2CHK			;14 - 60 GLOBAL REQUEST
	T.2CHK			;15 - 64 [1330] GLOBAL DEFERRED DEF (RH) SUPP. 
	T.2CHK			;16 - 70 [1330] GLOBAL DEFERRED DEF (LH) SUPP.
	T.2CHK			;17 - 74 [1330] GLOBAL DEFERRED DEF (LH,RH) SUPP.

T.2CHK:	TXNN	W1,PS.REL	;WE CAN ONLY HANDLE RELOC SYMBOLS
	POPJ	P,		;ALWAYS LOAD ABS ONES
	PUSH	P,W1		;SAVE FLAGS
	HRRZ	W1,W3		;PUT ADDRESS IN W1
	PUSHJ	P,CHKSEG	;SEE IF WANTED
	  CAIA			;YES
	AOS	-1(P)		;NO
	POP	P,W1		;RESTORE FLAGS
	POPJ	P,
;CONVERTS RADIX-50 IN W2 TO SIXBIT IN W2
;ALSO USES T1, T2, T3
;CODE INLINE FOR EXTRA SPEED SINCE LINK SPENDS ABOUT 10% OF
;ITS TIME IN THIS LOOP.

	XALL
R50T6::	TLZ	W2,740000	;CLEAR CODE BITS
	MOVE	T1,W2		;PUT IN RIGHT AC
	SETZ	T3,		;START WITH ZERO
REPEAT 4,<
	IDIVI	T1,50		;GET TABLE INDEX
	SKIPE	T2,R50TAB(T2)	;GET SIXBIT CODE
	LSHC	T2,-6		;LEFT JUSTIFIED IN AC T3
	CAIG	T1,50		;LAST CHARACTER LEFT?
	JRST	R50T6X		;LAST CHAR IN T1>
;END OF REPEAT 4
	IDIVI	T1,50		;SPLIT LAST 2 CHARS IF WE GET THIS FAR
	SKIPE	T2,R50TAB(T2)	;GET FIFTH CHAR
	LSHC	T2,-6		;STORE IT
R50T6X:	SKIPE	T2,R50TAB(T1)	;LAST TIME
	LSHC	T2,-6
	EXCH	W2,T3		;[1213] PUT BACK IN W2, LEAVE R50 IN T3
	POPJ	P,

	SALL
DEFINE R50CHR (CHR)<
 IRPC CHR,<
  ''CHR''
>>

	XALL
R50TAB:	R50CHR	( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% )
	SALL
SUBTTL	BLOCK TYPE 2 - SYMBOLS (DEFINITION)


;HERE TO SEARCH FOR GLOBAL DEFINITION, CHECK FOR MULTIPLE DEFINITIONS

SY.GSS:	TXOA	W1,PS.GLB!PS.DDT!PS.GLD	;[1243] SUPPRESSED,GLOBAL,LEFT DEFERED
SY.GS::	TXO	W1,PS.GLB	;SET GLOBAL FLAG
	TXNN	W1,PS.ENT	;IF KNOWN TO BE ENTRY SKIP SEARCH
	SKIPN	T1,ENTPTR	;LOAD AOBJN POINTER TO ENTRIES
	JRST	SYGTRY		;NONE
	TLNN	W2,770000	;[2216] Long symbol?
	 JRST	LCOM		;[2216] Yes
SYGENS:	CAMN	W2,0(T1)	;[2216] Match?
SYGENT:	TXOA	W1,PS.ENT	;[2216] Yes, set flag
	AOBJN	T1,SYGENS	;[2216] No, try next
SYGTRY:
IFN FTOVERLAY,<
	SKIPE	T1,BG.SCH	;ABLE TO SEARCH OTHER TABLES?
	JRST	SYBTRY		;YES, MUST NOT DO IT
>
	PUSHJ	P,TRYSYM##	;SEE IF ALREADY DEFINED
	  JRST	SY.GS0##	;NO, PUT IT IN
	  JRST	SY.RF##		;UNDEFINED, FILL IN REQUESTS FOR IT
	CAMN	W3,2(P1)	;CHECK VALUE
	POPJ	P,		;SAME SO ALL WELL
	JRST	SY.MDS##	;MULTIPLY DEFINED

;[2216] Here to compare long symbols with entries.  The entry table
;[2216] long symbols have had trailing nulls removed.
LCOM:	SPUSH	<P1,P2,P3>	;[2216] Save acs
	MOVE	P3,T1		;[2216] Pointer in more permanent place
LCOM1:	HLRZ	T1,W2		;[2216] Get the count
	HRRZ	T2,W2		;[2216] And the address
	HRLI	T2,(POINT 36)	;[2216] Make it a byte pointer
	MOVE	P1,0(P3)	;[2216] Get count,,address of entptr entry
	TLNE	P1,770000	;[2216] Short symbol?
	 JRST	[MOVE  P1,P3	;[2216] Yes, point to it
		 MOVEI T4,1	;[2216] It's one word long
		 JRST LCOM2]	;[2216] Go compare in case of nulls
	HLRZ	T4,0(P3)	;[2216] Count of words in entptr entry
LCOM2:	HRLI	P1,(POINT 36)	;[2216] Make it a byte pointer
	EXTEND	T1,[CMPSE	;[2216] Are they the same?
		    0
		    0]
	AOBJN	P3,LCOM1	;[2216] No, try them all
	MOVE	T1,P3		;[2216] Get the pointer
	SPOP	<P3,P2,P1>	;[2216] Restore the acs
	JUMPL	T1,SYGENT	;[2216] If pointer still negative it's entry
	JRST	SYGTRY		;[2216] Not an entry





IFN FTOVERLAY,<
SYBTRY:	SETZM	BG.SCH		;TURN OFF ABILITY
	PUSHJ	P,TRYSYM##	;SEE IF ALREADY DEFINED
	  JRST	[SETOM	BG.SCH	;PUT IT BACK
		JRST	SY.GS0##]	;NO, PUT IT IN
	  JRST	[SETOM	BG.SCH
		JRST	SY.RF##]	;UNDEFINED, FILL IN REQUESTS FOR IT
	SETOM	BG.SCH
	CAMN	W3,2(P1)	;CHECK VALUE
	POPJ	P,		;SAME SO ALL WELL
	JRST	SY.MDS##	;MULTIPLY DEFINED
>
;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

SY.LSS:	TXOA	W1,PS.LCL!PS.DDT	;SET SUPPRESSED LOCAL
SY.LS::	TXO	W1,PS.LCL	;SET LOCAL FLAG
	SETZM	LSTGBL		;[2255] IN CASE WE DON'T LOAD THIS SYMBOL
	SETZM	LSTLCL		;[2255] CLEAR LOCAL TOO
	TRNN	FL,R.SYM	;IN LOCAL SYMBOL MODE
	POPJ	P,		;NO
	PJRST	LS.ADD##	;YES, STORE IN TABLE
SUBTTL	BLOCK TYPE 2 - LOCAL BLOCK HEADER (FAIL)


;HERE IF SYMBOL IS A BLOCK HEADER
;THE VALUE IS ITS DEPTH
;STORE IN LOCAL SYMBOL TABLE ONLY

SY.BH::	TXC	W1,PT.SYM!PT.TTL!PT.BLK	;SET CORRECT FLAGS
	TRNN	FL,R.SYM	;IN LOCAL SYMBOL MODE
	POPJ	P,		;NO
	PJRST	LS.ADD##	;PUT IN TABLE
SUBTTL	BLOCK TYPE 2 - SYMBOLS (PARTIAL DEFINITION)


;HERE FOR "DEFINITION" WHEN SYMBOL NOT FULLY DEFINED
;USUALLY FOLLOWED BY GLOBAL REQUEST FOR SYMBOL FIXUP

SY.DSL:	TXO	W1,PS.DDT	;[1330] SUPPRESS TO DDT
SY.DGL:: TXO	W1,PS.GLB!PS.UDL;[1330] LEFT HALF DEFERRED
	JRST	SY.DEF

SY.DSB:	TXO	W1,PS.DDT	;[1330] SUPPRESS TO DDT
SY.DGB:	TXOA	W1,PS.UDL	;[1330] BOTH HALVES DEFERRED
SY.DSR:	TXO	W1,PS.DDT	;[1330] SUPPRESS TO DDT
SY.DGR:: TXO	W1,PS.GLB!PS.UDR;[1330] RIGHT HALF DEFERRED

SY.DEF:				;[1330] DO PARTIAL DEFINITION
IFN FTOVERLAY,<
	PUSH	P,BG.SCH	;[626] SAVE STATE OF BOUND GLOBAL SEARCH
	SETZM	BG.SCH		;[626] DON'T SEARCH THEM FOR THIS
> ;END OF IFN FTOVERLAY
	PUSH	P,P4		;[1213] SAVE ORIGINAL SYMBOL IN RADIX50
	PUSHJ	P,TRYSYM##	;SEE IF IN TABLE
	  JRST	SY.DG0		;NO, PUT IN
	  JRST	SY.DG1		;ALREADY IN UNDEF TABLE
	POP	P,P4		;[1213] RESTORE SYMBOL NAME IN R50 FORM
IFN FTOVERLAY,<
	POP	P,BG.SCH	;[626] RESTORE BOUND GLOBAL STATE
> ;END OF IFN FTOVERLAY
	JRST	SY.DG2		;[1213] 2ND PARTIAL DEF, SET UP FOR CHECK

;HERE TO PUT REQUEST IN GLOBAL TABLE
;USE EXTENDED BLOCK TO HOLD PARTIAL VALUE

SY.DG0:	POP	P,P4		;[1213] RESTORE RADIX 50 FORM
IFN FTOVERLAY,<
	POP	P,BG.SCH	;[626] RESTORE BG.SCH STATE
> ;END OF IFN FTOVERLAY
	AOS	USYM		;COUNT IT AS UNDEFINED
	MOVEI	T2,.L*2		;NEED TWO BLOCKS TO HOLD
	PUSHJ	P,GS.GET##	; PARTIAL DEFINITION AND POSSIBLE CHAINED REQUEST
	TXO	W1,PT.EXT	;MARK AS USING EXTENDED TRIPLET
	DMOVEM	W1,0(T1)	;PRIMARY FLAGS & SYMBOL
	SETZM	2(T1)		;NO REQUESTS YET
	MOVX	T2,S.LST!S.PVS	;PARTIAL VALUE MARKER
	MOVEM	T2,.L+0(T1)	;SECONDARY FLAGS
	DMOVEM	W2,.L+1(T1)	;SYMBOL AGAIN (MAY AS WELL) & PARTIAL VALUE
	PUSH	P,W3		;SAVE PARTIAL VALUE
	MOVE	W3,T1		;FOR EXTENDED SYMBOLS
	SUB	W3,NAMLOC	;W3 CONTAINS POINTER TO EXTENDED TRIPLET
	PUSHJ	P,INSRT##	;PUT IN GLOBAL TABLE
	POP	P,W3		;MAKE PARTIAL VALUE "VALUE"
	TXZ	W1,PT.EXT	;ONLY ONE TRIPLET IN LS AREA
	PJRST	LS.ADD##	;AND PUT IN LOCAL TABLE
;HERE IF "PARTIALLY DEFINED" SYMBOL IS ALREADY IN UNDEF TABLE
;IT MAY HAVE ADDITIVE GLOBAL FIXUPS AS WELL
;COPY OLD DEF TO NEW LOCATION AND ADD SYMBOL TABLE FIXUP REQUEST
;DELETE OLD SYMBOL SPACE

SY.DG1:	POP	P,P4		;[1213] RESTORE RADIX50 SYMBOL NAME
IFN FTOVERLAY,<
	POP	P,BG.SCH	;[626] RESTORE STATE OF BG SEARCHING
> ;END OF IFN FTOVERLAY
	MOVE	T1,0(P1)	;GET OLD FLAGS
	TXNE	T1,PS.UDF	;ANY PREVIOUS PARTIAL DEF'S?
	JRST	SY.DG2		;[1213] YES, SET UP FOR COMPARE
	MOVEI	T1,.L		;NEED 1 EXTRA TRIPLET
	PUSHJ	P,SY.MOV##	;AND MOVE WHAT WE HAVE
	MOVX	T2,S.PVS!S.LST	;MARK AS SYMBOL FIXUP
	MOVEM	T2,0(T1)	;STORE FIXUP FLAG
	DMOVEM	W2,1(T1)	;SYMBOL NAME & PARTIAL VALUE
	TXO	W1,PT.EXT	;MARK AS NOW EXTENDED
	IORB	W1,0(P1)	;YES, SET NEW FLAGS
	SUB	P1,NAMLOC	;GET REL POSITION OF SYMBOL BLOCK
	MOVEM	P1,LSTGBL	;[2255] INCASE OTHER DEFINITION DEPENDS UPON IT
	TXZ	W1,PT.EXT	;ONLY 1 TRIPLET IN LOCAL TABLE
	PJRST	LS.ADD##	;AND PUT IN LOCAL TABLE
;HERE WHEN A DEFINED OR PARTIALLY-DEFINED SYMBOL IS PARTIALLY-DEFINED
;A SECOND TIME.  WE NEED TO SET THINGS UP SO THE OLD AND NEW VALUES WILL
;BE COMPARED WHEN (AND IF) THE SECOND PARTIAL DEFINITION IS SATISFIED.
;
;TO DO THIS, MAKE A NEW SYMBOL IN THE GS AREA (BUT NOT POINTED TO BY THE
;HASH TABLE) CONTAINING A PRIMARY TRIPLET COPIED FROM THE FIRST DEFINITION,
;AND A SECONDARY S.PVS TRIPLET FROM THE NEW PARTIAL DEFINITION.
;
;IF THE OLD DEFINITION WAS ONLY A PARTIAL ONE, CREATE A SYMBOL FIXUP FROM
;THE OLD SYMBOL BLOCK TO THE NEW ONE SO THE VALUES WILL BE CHECKED WHEN
;EVERYTHING GETS DEFINED.
;
;CALLED WITH:	P1/ PTR TO OLD DEFINITION
;		W1-W3/ NEW DEFINITION
;		P4/ SYMBOL NAME IN RADIX-50


SY.DG2:	MOVX	W1,PS.UDF!PS.REQ	;[1213] COPY THESE FROM THE OLD TRIPLET
	AND	W1,(P1)		;[1213] HERE THEY ARE
	IORX	W1,PT.EXT!PT.SGN!PT.SYM!PS.GLB	;[1213] USEFUL FLAGS
	SUB	P1,NAMLOC	;[1213] SAVE IN CASE CORE MOVES
	MOVEI	T2,.L*2		;[1213] SPACE FOR NEW TRIPLET PAIR
	PUSHJ	P,GS.GET##	;[1213] NEW BLOCK NOW POINTED TO BY T1
	ADD	P1,NAMLOC	;[1213] RESTORE P1
	DMOVEM	W1,0(T1)	;[1213] STORE FLAGS AND NAME
	TXNE	W1,PS.UDF	;[1213] SYMBOL DEFINED?
	TDZA	T2,T2		;[1213] NO, NO FIXUPS
	MOVE	T2,2(P1)	;[1213] YES, COPY VALUE FROM OLD TRIPLET
	MOVEM	T2,2(T1)	;[1213] STORE LAST WORD OF PRIMARY
	MOVX	W1,S.PVS!S.LST	;[1213] FLAGS FOR SECONDARY TRIPLET
	TMOVEM	W1,.L(T1)	;[1213] STORE SECONDARY TRIPLET
	SUB	T1,NAMLOC	;[1213] OFFSET INTO GS AREA
	MOVEM	T1,LSTGBL	;[2255] ARRANGE FOR SY.RQ TO FIND US
	SETZM	LSTLCL		;[2255] NO LOCAL DEFINITION
;NOW SEE IF THE ORIGINAL DEFINITION WAS A PARTIAL ONE, AND SETUP AN
;EXTRA FIXUP REQUEST POINTER IF SO.

	MOVE	T1,0(P1)	;[1213] RESTORE OLD SYMBOL'S FLAGS
	TXNN	T1,PS.UDF	;[1213] WAS IT A PARTIAL DEFINITION?
	POPJ	P,		;[1213] NO, DONE
	AOS	USYM		;[1213] YES, WE CREATED ANOTHER SYMBOL TO FIX UP
	MOVX	W1,PT.SGN!PT.SYM	;[1213] SOME GOOD FLAGS
	MOVE	W3,P4		;[1213] SYMBOL TO FIX UP IN RADIX50 (SAME NAME)
	TXO	W3,R5.FXS!R5.FXA	;[1213] SOME FAKE REL FILE INPUT
	PUSHJ	P,SY.RQ		;[1213] SET UP THE EXTRA LINKAGE
	ADD	W3,FX.LB	;[1213] NOW FIND FIXUP BLOCK CREATED
	MOVX	T1,FS.FXR!FS.FXF!FS.MDC	;[1213] CHANGE RH FIXUP TO FULL-WORD
	XORM	T1,0(W3)	;[1213] AND SET FS.MDC BIT FOR SY.STF
	POPJ	P,		;[1213] DONE
SUBTTL	BLOCK TYPE 2 - SYMBOLS (REQUEST)


;HERE IF GLOBAL REQUEST SEEN

SY.RQ::	TXO	W1,PS.REQ	;SET REQUEST FLAG (BUT NOT PS.UDF)
	PUSHJ	P,TRYSYM	;SEE IF ALREADY IN TABLE
	  JRST	SY.RQ0		;NO, SO PUT IT IN
	  JRST	SY.RU0		;ALREADY UNDEFINED
				;DEFINED, FILL IN CHAIN

;HERE TO FILL IN GLOBAL REQUEST CHAIN
SY.RC0::MOVE	T2,W3		;[2305] GET START OF CHAIN
IFN FTOVERLAY,<
	IOR	W1,0(P1)	;GET FLAGS
	TXNN	W1,PS.BGS	;FROM A BOUND LINK?
	JRST	.+3		;NO
	HRRZ	R,R		;YES, SO NOT RELOCATABLE W.R.T. THIS LINK
	TXZ	W1,PS.REL
>
	JUMPL	W3,SY.RC1	;ADDITIVE FIXUP?
	MOVE	W3,2(P1)	;NO, GET VALUE OF SYMBOL
	JRST	SY.CHR##	;RIGHT-HALF CHAINED FIXUP


;HERE FOR ADDITIVE FIXUP TO ALREADY DEFINED SYMBOL
;SETUP W1 WITH FIXUP FLAGS (FROM W3)

SY.RC1:	TXNN	W1,PS.REL	;ONLY ONE WE NOW CARE ABOUT
	TDZA	W1,W1		;NOT SET
	MOVX	W1,FS.REL	;INCASE SYMBOL TABLE FIXUP
	MOVEM	W1,SYMFLG	;AND SAVE IT
	TXZ	W3,R5.FXA	;ALWAYS CLEAR
	TXNN	W3,R5.FXL	;LEFT HALF?
	TXOA	W1,FS.FXR	;NO
	TXO	W1,FS.FXL	;YES
	TXZE	W3,R5.FXS	;SYMBOL FIXUP?
	JRST	SY.RC2		;YES
	TXZE	W3,R5.FXC	;MIGHT BE RH CHAINED
	TXC	W1,FS.FXR!FS.FXC	;YES, CHANGE FLAGS
	JRST	SY.AD0##	;JUST CODE

SY.RC2:	TXO	W1,FS.FXS	;YES, SET FLAG
;	JRST	SY.ADS		;FALL INTO CODE
;HERE FOR SYMBOL TABLE FIXUP
SY.ADS:	MOVE	W2,W3		;PUT REQUESTED SYMBOL IN W2
	PUSHJ	P,R50T6		;CONVERT TO SIXBIT
	MOVE	W3,W2		;EXPECTED IN W3
SY.AS::	.JDDT	LNKOLD,SY.ADS,<<CAMN	W3,$SYMBOL>>	;[1000]
	PUSHJ	P,SY.RLS##	;REQUESTING LAST SYMBOL?
	  POPJ	P,		;NO, ASSUME NON-LOADED LOCAL
				;T1 = ADDRESS IN LOCAL TABLE
				;T2 = ADDRESS IN GLOBAL TABLE
	MOVX	T3,PS.UDR	;ASSUME RIGHT HALF FIXUP
	TXNE	W1,FS.FXL	;LEFT HALF FIXUP?
	TXC	T3,PS.UDF	;CHANGE TO PS.UDL
	TXNN	W1,FS.FXF	;[2214] BUT IF FULL WORD
	TXNE	W1,FS.FXE	;[2214] OR THIRTY BIT
	MOVX	T3,PS.UDF	;CLEARS BOTH
	JUMPE	T1,SYADS0	;CLEAR FLAG IN LOCAL TABLE IF THERE
	ANDCAM	T3,0(T1)	;CLEAR FLAG IN MEMORY, SET IN ACC
	SKIPE	T4,SYMFLG	;AND EXTRA FLAGS TO SET
	IORM	T4,0(T1)	;PS.REL USUALLY
SYADS0:	JUMPE	T2,SYADS1	;SAME FOR GLOBAL TABLE
	ANDCAM	T3,0(T2)	;IF SET
	SKIPE	T4,SYMFLG
	IORM	T4,0(T2)	;AND EXTRA FLAGS
SYADS1:	JUMPE	T1,SYADSG	;NO LOCAL, ONLY GLOBAL
	PUSH	P,W1		;SAVE FIXUP FLAGS
	PUSH	P,T2		;SAVE T2
	MOVE	T2,W1		;PUT FLAGS IN T2
	DMOVE	W1,0(T1)	;GET FLAGS & SYMBOL WE NOW CARE ABOUT
	MOVE	W3,2(P1)	;[2332] GET FIXUP VALUE
				;FROM DEFINED SYMBOL
	PUSHJ	P,SY.AST##	;FIXUP SYMBOL IN T1
	POP	P,T2		;RESTORE IT
	POP	P,W1		;AND FIXUP FLAGS
SYADSG:	JUMPE	T2,CPOPJ	;NOT GLOBAL, RETURN
;HERE ON A GLOBAL SYMBOL

	PUSH	P,W1		;STORE FLAGS UNTIL P1/P2 SETUP
	DMOVE	W1,0(T2)	;FLAGS & SYMBOL
	HRRZ	W3,2(P1)	;HALF WORD VALUE
	PUSHJ	P,TRYSYM##	;SETUP P1 & P2
	  HALT			;MUST BE DEFINED
	  JFCL
	MOVE	T1,P1		;POINT TO SYMBOL TRIPLET
	POP	P,T2		;FIXUP FLAGS
	TXNN	W1,PS.GLD	;[1327] POSSIBLE LEFT HALF?
	PJRST	SY.AS0##	;[1327] NO, GO DO THE VALUE FIXUP
	PUSH	P,T2		;[1327] SAVE T2
	MOVEI	T1,.L		;[1327] NEED ONE MORE TRIPLET
	PUSHJ	P,SY.MOV##	;[1327] MOVE WHAT WE HAVE
	MOVX	T2,S.PVS!S.LST	;[1327] MARK AS SYMBOL FIXUP
	MOVEM	T2,0(T1)	;[1327] STORE SECONDARY FIXUP FLAGS
	DMOVEM	W2,1(T1)	;[1327] SYMBOL AND PARTIAL VALUE
	TXO	W1,PT.EXT	;[1327] MARK AS NOW EXTENDED
	IORB	W1,0(P1)	;[1327] PLACE IN PROMARY FLAGS
	MOVE	T1,P1		;[1327] GET THE ADDRESS OF THE PRIMARY
	SUB	T1,GS.LB	;[1327] CONVERT IT TO AN OFFSET
	HRLM	T1,W3		;[1327] RESET FIXUP PTRS AND
	MOVEM	T1,LSTGBL	;[2255] LSTGBL AFTER MOVING PRIMARY
	AOS	USYM		;[1327] COUNT THIS SYMBOL AS UNDEFINED
	POP	P,T2		;[1327] RESTORE FIXUP FLAGS
	MOVE	T1,P1		;[1327] POINT TO SYMBOL TRIPLET
	PJRST	SY.AS0##	;GO DO THE VALUE FIXUP
				;AND ANY CHAINING DEPENDING UPON THIS SYMBOL
	
SUBTTL	BLOCK TYPE 2 - SYMBOLS (UNKNOWN REQUEST)

;HERE FOR GLOBAL SYMBOL SEEN FOR FIRST TIME
SY.RQ0:	AOS	USYM		;COUNT ONE MORE
	TXZ	W1,PS.REL	;CLEAR - WON'T KNOW TILL DEFINED
	JUMPGE	W3,INSRT##	;JUMP IF NON-ADDITIVE GLOBAL
				;AND JUST ENTER IN GLOBAL TABLE

;HERE FOR ADDITIVE GLOBAL REQUEST
;FOR SYMBOL NOT YET IN GLOBAL SYMBOL TABLE
;REQUEST MUST BE DEFERED UNTIL SYMBOL IS DEFINED
;PUT SYMBOL IN TABLE WITH REQUEST BIT ON AND ZERO VALUE
;AND PUT GLOBAL REQUEST POINTER IN EXTENDED TRIPLET
;VALUE POINTS TO FIXUP TABLE
;PUT ACTUAL FIXUP REQUEST IN FIXUP AREA AND CHAIN ALL REQUESTS TO
;TOGETHER, SINCE THIS IS FIRST SET POINTER TO ZERO

SY.RQ1:	PUSH	P,W1		;SAVE PRIMARY FLAGS
	PUSHJ	P,SY.RQF	;SET FLAGS IN W1 FROM W3
	  JRST	SY.RQ2		;NOT SYMBOL TABLE FIXUP
	PUSHJ	P,SY.RQS	;CONVERT SYMBOL REQUEST TO POINTER
	  JRST	[SOS	USYM	;NON LOADED LOCAL
		POP	P,W1	;RESTORE W1
		POPJ	P,]	;REDUCE COUNT AND IGNORE
	MOVE	T1,LSTGBL	;[2255] GET THE GLOBAL POINTER
	SKIPA	W3,LSTLCL	;[2255] AND THE LOCAL POINTER
SY.RQ2::MOVE	T1,W2		;[2255] WANT THE NAME (NON-SYMBOL) IN FIXUP
	PUSH	P,[0]		;VALUE OF REQUEST (PRIMARY)
	PUSH	P,W2		;[2255] SAVE THE NAME
	MOVE	W2,T1		;[2255] GET GLOBAL POINTER (IF SYMBOL FIXUP)
	PUSHJ	P,SY.FX0##	;PUT IN FIXUP TABLE
	POP	P,W2		;[2255] RESTORE SYMBOL NAME
	MOVX	W1,S.FXP	;EXTENDED TRIPLET FLAG
	PUSHJ	P,GS.FX0##	;LINK FIXUP TO GLOBAL SYMBOL
	POPJ	P,
;HERE TO SET FLAGS IN W1 FROM BITS IN W3
;CLEARS BITS 0-3 OF W3
;CALLED BY
;	MOVE	W3,REQUEST
;	PUSHJ	P,ST.RQF
;
;RETURNS
;+1	NORMAL ADDITIVE GLOBAL
;+2	SYMBOL TABLE FIXUP

SY.RQF:	MOVX	W1,FP.SGN!FP.SYM!FP.PTR
	TXZ	W3,R5.FXA	;CLEAR ADDITIVE FIXUP BIT ALWAYS
	TXZE	W3,R5.FXL	;LEFT HALF FIXUP?
	TXOA	W1,FS.FXL	;YES
	TXO	W1,FS.FXR	;NO, MUST BE RIGHT HALF
	TXZE	W3,R5.FXS	;SYMBOL TABLE FIXUP?
	JRST	[TXO	W1,FS.FXS	;YES, SET FLAG
		JRST	CPOPJ1]		;RETURN +2
	TXZE	W3,R5.FXC	;MIGHT BE RH CHAINED
	TXC	W1,FS.FXR!FS.FXC	;YES, CHANGE FLAGS
	POPJ	P,		;RETURN +1
;HERE TO CHANGE RADIX50 SYMBOL TABLE FIXUP REQUEST INTO A POINTER
;CALLED BY
;	MOVE	W3,RADIX-50 SYMBOL
;	PUSHJ	P,SY.RQS
;RETURNS
;+1 SYMBOL NOT REQUIRED (NON-LOADED LOCAL)
;+2 SYMBOL IS REQUIRED [2255]
;USES T1, T2

SY.RQS:	EXCH	W2,W3		;PUT REQUESTED SYMBOL IN W2
	PUSHJ	P,R50T6		;SIXBITIZE
	EXCH	W2,W3		;PUT THEM BACK
SY.QS::	.JDDT	LNKOLD,SY.QS,<<CAMN	W3,$SYMBOL##>> ;[1000]
	PUSHJ	P,SY.RLS##	;ARE WE REQUESTING LAST SYMBOL?
	  POPJ	P,		;ASSUME NON-LOADED LOCAL
	JUMPE	T2,CPOPJ1	;NOT A GLOBAL IF T2=0
	MOVX	T1,PS.UDL	;SET FLAG WE COULD NOT DO BEFORE?
	TXNE	W1,FS.FXF!FS.FXE!FS.FXL	;[2214] REQUEST FIX LEFT HALF?
	IORM	T1,0(T2)	;[612] YES, IT MUST BE UNDEFINED
	MOVE	T1,0(T2)		;[1243] GET THE PRIMARY FLAGS
	TXNN	T1,PS.GLD	;[1243] POSSIBLE LEFT DEF? 
	JRST	CPOPJ1		;[1243] NO
	SPUSH <W1,W2,W3,P1,P2,P3,P4>	;[1243] SAVE THE AC'S
	MOVE	W1,0(T2)		;[1243] LOAD W1-W3 WITH
	DMOVE	W2,1(T2)	;[1243] THE PRIMARY TRIPLET
	PUSHJ	P,TRYSYM##	;[1243] LOAD P1-P4 FOR THE PRIMARY
	JRST SYRQS1		;[1243] SYMBOL NOT FOUND
	SKIPA			;[1243] FOUND AND UNDEFINED
	JRST	SYRQS1		;[1243] FOUND BUT ALREADY DEFINED
	MOVEI	T1,.L		;[1243] NEED ONE MORE TRIPLET
	PUSHJ	P,SY.MOV##	;[1243] MOVE WHAT WE HAVE
	MOVX	T2,S.PVS!S.LST	;[1243] MARK AS SYMBOL FIXUP
	MOVEM	T2,0(T1)	;[1243] STORE SECONDARY FIXUP FLAGS
	DMOVEM	W2,1(T1)	;[1243] SYMBOL AND PARTIAL VALUE
	TXO	W1,PT.EXT	;[1243] MARK AS NOW EXTENDED
	IORB	W1,0(P1)	;[1243] PLACE IN PRIMARY FLAGS
	MOVE	T1,P1		;[1243] GET THE ADDRESS OF THE PRIMARY
	SUB	T1,GS.LB	;[1243] CONVERT IT TO AN OFFSET
SYRQS1:	SPOP <P4,P3,P2,P1,W3,W2,W1>	;[1243] RESTORE THE AC'S
	HRLM	T1,W3		;[1243] RESET FIXUP PTRS AND 
	MOVEM	T1,LSTGBL	;[2255] LSTGBL AFTER MOVING PRIMARY
	AOS	USYM		;[1243] COUNT THIS SYMBOL AS UNDEFINED
	JRST	CPOPJ1		;AND STORE REQUEST
SUBTTL	BLOCK TYPE 2 - SYMBOLS (UNDEFINED REQUEST)


SY.RU0:	JUMPE	W3,CPOPJ	;DUMMY REQUEST JUST IGNORE
	JUMPL	W3,SY.RUA	;ADDITIVE GLOBAL REQUEST?
SY.RU3::MOVE	T3,W3		;[2200] START OF CURRENT CHAIN
	MOVE	T1,2(P1)	;[2200] START OF PREVIOUS CHAIN
	MOVEM	W3,2(P1)	;SAVE NEW ADDRESS AS VALUE
	JUMPE	T1,CPOPJ	;JUST DUMMY REQUEST IF ZERO
				;FALL INTO SY.RU1 TO ADD CHAINS

SY.RU1::CAMLE	T1,T3		;[707] FIRST CHAIN COME BEFORE THE NEW CHAIN?
	JRST	SY.PGU		;[707] NO, KEEP THEM SEPARATE
	MOVE	T2,T3		;[2200] Get one number
	XOR	T2,T1		;[2200] Get the difference
	TRNE	T1,-1		;[2240] Can't chain if section,,0
	TLNE	T2,-1		;[2200] Same section number?
	 JRST	SY.PGU		;[2200] No, don't chain them

SY.RU2:	MOVE	T2,T3		;[2200] GET NEXT LINK
	PUSHJ	P,SEGCHK##	;SETUP ADDRESS FOR CORRECT SEGMENT
	  JRST	SY.PGU		;NOT ALL OF CHAIN IN CURRENT WINDOW
	 HRR	T3,(T2)		;[2200] GET NEXT ADDRESS, KEEP SECTION NUMBER
;[2200] This code defaults for right halfword fixups.  The current rule
;[2200] is to wrap within a section.
	TRNE	T3,-1		;[2200] END OF CHAIN?
	JRST	SY.RU2		;[2200] NO, NOT FINISHED YET
	HRRM	T1,(T2)		;STORE OTHER CHAIN OVER 0
	POPJ	P,

;HERE WHEN TRYING TO COMBINE TWO GLOBAL REQUEST CHAINS
; BUT WHERE NOT ALL OF CHAIN IS IN CURRENT WINDOW
; DO NOT READ IN REQUIRED WINDOW
; INSTEAD PUT OLD CHAIN IN FIXUP TABLE WITH ADDITIVE GLOBALS ETC
SY.PGU:	MOVE	W3,T1		;[2200] RESET OLD CHAIN POINTER
	TXO	W3,R5.FXC	;SET RIGHT HALF CHAINED BIT
;	JRST	SY.RUA		;HANDLE AS ADDITIVE GLOBAL
;HERE  FOR ADDITIVE GLOBAL REQUEST TO SYMBOL ALREADY UNDEFINED
;IF ADDITIVE GLOBAL EXTENDED FIXUP ALREADY SEEN JUST ADD TO CHAIN
;IF NOT DELETE SIMPLE TRIPLET AND ADD EXTENDED TRIPLET

SY.RUA:	MOVE	W1,0(P1)	;GET FLAGS
	TXNE	W1,PS.FXP	;ALREADY DEFERED FIXUPS?
	JRST	SY.RUB		;YES, JUST ADD TO LIST
	PUSH	P,W1		;SAVE PRIMARY FLAGS
	PUSHJ	P,SY.RQF	;SETUP W1 FROM W3
	  JRST	SY.RA		;[2200] NORMAL RETURN
	PUSHJ	P,SY.RQS	;SYMBOL TABLE FIXUP, SEE IF WE NEED IT
	  JRST	SY.RUX		;RESTORE STACK AND EXIT
	MOVE	T1,LSTGBL	;[2255] GET THE GLOBAL POINTER
	MOVE	W3,LSTLCL	;[2255] AND THE LOCAL POINTER

;[2255] Here to store the first partial secondary fixup.  The
;[2255] local and global pointers are in T1 and W3.  This is
;[2255] because W2 contains the symbol name for the PVS secondary
;[2255] triplet.
SY.RA::	PUSH	P,W2		;[2255] SAVE THE NAME
	MOVE	W2,T1		;[2255] GET THE GLOBAL POINTER
	MOVEI	T1,.L		;[1000] NEED TO EXPAND
	PUSHJ	P,SY.MOV##	;TO BIGGER AREA
	SUB	T1,NAMLOC	;INCASE WE MOVE
	PUSH	P,T1		;SAVE TO FIXUP  GLOBAL SYMBOL
	MOVX	T1,PT.EXT!PS.FXP	;MARK FIXUP IN PRIMARY
	IORM	T1,0(P1)	;SO WE KNOW TO EXPECT ADDITIVE GLOBALS
	PUSHJ	P,SY.FX0##	;PUT REQUEST IN FIXUP TABLE
	MOVX	W1,S.LST!S.FXP	;SECONDARY FLAGS
	POP	P,T1
	ADD	T1,NAMLOC	;FIX IT
	POP	P,W2		;[2255] RESTORE THE NAME
	TMOVEM	W1,0(T1)	;PARTIAL VALUE TRIPLET
SY.RUX:	POP	P,W1		;RESTORE W1 (GET STACK BACK IN SHAPE)
	POPJ	P,
;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN

SY.RUB:	MOVEI	T1,0(P1)	;GET PRIMARY TRIPLET
SY.RUC:	ADDI	T1,.L		;GET NEXT TRIPLET
	SKIPG	W1,0(T1)	;GET SECONDARY FLAGS
	JRST	E02CNW		;[1174] NOT THE RIGHT SORT OF EXTENDED TRIPLET
	TXNN	W1,S.FXP	;IS THIS THE ONE
	JRST	SY.RUC		;NO TRY AGAIN
	MOVE	P1,T1		;SAFE TO POINT TO IT NOW
	PUSHJ	P,SY.RQF	;SETUP LH OF W1
	  JRST	SY.RUD		;[2255] NORMAL RETURN, NOT A SYMBOL FIXUP
	PUSHJ	P,SY.RQS	;SYMBOL TABLE FIXUP, CONVERT TO POINTER
	  POPJ	P,		;NO LOADED LOCAL, IGNORE
	MOVE	W2,LSTGBL	;[2255] GET THE GLOBAL POINTER
	MOVE	W3,LSTLCL	;[2255] AND THE LOCAL POINTER
SY.RUD:	HRR	W1,2(P1)	;[2255] GET LINK
	SUB	P1,NAMLOC	;INCASE AREA MOVES
	PUSHJ	P,SY.FX0##	;PUT IN FIXUP AREA
	ADD	P1,NAMLOC	;RELOCATE IT
	HRRM	W3,2(P1)	;FIXUP REQUEST POINTER CHAIN
	POPJ	P,


;HERE IF THERE IS NOT A FIXUP REQUEST SECONDARY TRIPLET
;JUST EXPAND AS IF  NO EXTENDED TRIPLETS

SY.RUH::
E02CNW::.ERR.	(MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
	.ETC.	(STR,,,,,,<SY.RUH>)
SUBTTL	BLOCK TYPE 3 - HIGH SEGMENT INDICATOR


;	----------------
;	!    3 !     1 !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! HIGH ! HIORG !
;	----------------
;	! LOW  ! LOORG !
;	----------------

T.3:
	SKIPGE	MODTYP		;[1306] PSECTS SEEN IN MODULE?
	PUSHJ	P,E$$MPT	;[1306] YES, ERROR
	HLLOS	MODTYP		;[1306] INDICATE TWOSEG SEEN
IFN FTOVERLAY,<
	TRNN	FL,R.FLS	;[1115] NOT FORCING INTO LOW SEG?
	SKIPGE	LNKMAX		;[1115]   AND NOT ROOT LINK?
	JRST	T.3C		;[1115] NO
E$$HCL::.ERR.	(MS,.EC,V%L,L%F,S%F,HCL,<High segment code not allowed in an overlay link>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

T.3C:
> ;END OF IFN FTOVERLAY
	TRNE	FL,R.RED	;[2223] DOING /REDIRECT?
	 PUSHJ	P,T.3RED	;[2223] YES, SET UP FAKE HIGH SEG
	HRRZ	W2,W1		;GET WORD COUNT
	PUSHJ	P,D.IN1##	;GET A WORD (RELOCATION BYTES)
	PUSHJ	P,D.IN1##	;GET DATA WORD
	SOJE	W2,.+4		;DONE UNLESS FORTRAN-10
	MOVE	W2,W1		;SAVE HIGH SEG BREAK AND OFFSET
	PUSHJ	P,D.IN1##	;GET LOW SEG BREAK
	EXCH	W1,W2		;PUT HIGH BACK WHERE EXPECTED
	MOVEI	R,2		;[2207] SET FOR SLOT #2
	MOVEM	R,@RC.MAP	;[2207] SET MAP FOR NEW-STYLE REL BLOCKS
	TLNN	W1,-1		;TEST FOR LEFT HALF SET
	JRST	T.3B		;HISEG PSEUDO-OP IF 0,,400000
	TRO	FL,R.TWSG	;SIGNAL TWOSEG PSEUDO-OP
	TRNE	FL,R.FLS!R.FHS	;ANYTHING SPECIAL TO DO?
	JRST	T.3RC		;YES, ADJUST RC TABLES FOR FORCED HIGH OR LOW
T.3A:	PUSHJ	P,SETRC		;SETUP THE RELOCATION COUNTER
	MOVEI	R,2		;MAKE SURE POINTING TO HIGH SEG
	MOVE	R,@RC.TB
T.3N:	MOVE	W3,RC.CV(R)	;[2254] SETUP CURRENT HISEG VALUE
	SETO	W2,		;MARK WE DON'T CARE ABT LOWSEG
;	JRST	T.3TTL		;GO STORE SEGMENT ORIGINS
;HERE TO STORE SEGMENT ORIGINS IN TITLE BLOCK (SEGMENT INFO).
;GENERATES A FIXUP IF BLOCK NOT IN CORE, WARNING IF NOT FOUND.

T.3TTL:	MOVE	T2,SEGPTR	;[2254] GET REL ADDRESS OF LOW SEGMENT TRIPLET
	CAMGE	T2,LW.LS	;STILL IN CORE?
	JRST	T.3FIX		;NO
	SUB	T2,LW.LS
	ADD	T2,LS.LB	;FIX IN CORE
	SKIPL	T3,(T2)		;MUST BE SECONDARY
	TXNN	T3,S.TTL	;AND A TITLE
	JRST	T.3SER
	TXNN	T3,S.SEG	;IS THIS IT?
	JRST	T.3SER		;NO
	SKIPL	W2		;[2254] LOW SEG SPECIFIED?
	MOVEM	W2,1(T2)	;[2254] YES, STORE IT (AOSE KEEPS LH)
	ADDI	T2,.L		;[2254] NOW TO HIGH SEG TRIPLET
	SKIPL	T3,(T2)		;[2254] MUST BE SECONDARY
	TXNN	T3,S.TTL	;[2254] AND A TITLE
	JRST	T.3SER		;[2254] NO
	TXNE	T3,S.SEG	;[2254] IS THIS A SEGMENT?
	TXNN	T3,S.SHI	;[2254] AND HIGH SEGMENT
	JRST	T.3SER		;[2254] NO
	SKIPL	W3		;[2254] HOW ABOUT HIGH SEG?
	MOVEM	W3,1(T2)	;[2254] YES, STORE IT
	JRST	LOAD##		;DONE

;HERE IF BLOCK PAGED OUT. GENERATE A FIXUP.
T.3FIX:	HLR	W3,W2		;SETUP FIXUP AS HI,,LOW
	TXO	T2,SPF.SL	;[2200] SETUP FIXUP INDEX
	MOVEI	R,FS.SS-FX.S0	;POINT TO LS FIXUP
	PUSHJ	P,SY.CHP##	;GENERATE THE FIXUP
	JRST	LOAD##		;AND FLY AWAY

T.3SER:	POP	P,T1		;GET STACK BACK IN ORDER
E01SFU::.ERR.	(MS,0,V%L,L%I,S%I,SFU) ;[1174]
	JRST	LOAD##		;TRY TO CONTINUE
;HERE  FROM HISEG PSEUDO-OP
;TEST IF TWO SEGMENTS ALLOWED (IGNORE IF NOT)
;IF YES, SWAP HIGH AND LOW RELOC COUNTERS

T.3B:	TRNE	FL,R.FLS	;FORCED LOW SEG?
	JRST	LOAD##		;YES, JUST USE RC 1
	TRO	FL,R.FHS	;NO, ALLOW 2 (SET FLAG AND DO IT LATER)
	PUSHJ	P,SETRC		;SET 2ND RELOC COUNTER
	TRNN	FL,R.FHS!R.FLS	;NEED TO ADJUST RELOC COUNTERS
	JRST	LOAD##		;NO, JUST RETURN
	MOVEI	R,1		;SET RELOC LOW
	MOVE	T1,SG.TB+2	;GET ADDRESS OF 2ND SEGMENT
	MOVEM	T1,@RC.TB	;AND STORE IN RELOC 1
	MOVE	R,@RC.TB	;RESET R TO POINT TO RC BLOCK
	MOVE	W3,RC.CV(R)	;[2254] SETUP CURRENT HISEG VALUE
	MOVE	R,SG.TB+1	;GET LOWSEG BLOCK
	MOVE	W2,RC.CV(R)	;[2254] AND CURRENT LOWSEG VALUE
	JRST	T.3TTL		;GO STORE OR GENERATE FIXUP
;NOTE WE HAVE ALREADY TAKEN CARE OF FORCED HIGH BY SWAPPING
;RC1 AND RC2 AT T.6RC

T.3RC:	HLRZ	T1,W1		; GET LENGTH OF HIGH SEGMENT CODE
	SUBI	T1,(W1)		;FROM BREAK - ORIGIN
	SKIPE	DCBUF		;IF PRESCANED, LENGTH IS
				;  KNOWN (MAY BE ZERO).
	JUMPE	T1,T.3TST	;NOT AVAILABLE, CANNOT LOAD AS SPECIFIED
	HRRZM	W1,SO.S2	;OFFSET FOR RELOCATION
	MOVEI	T2,RC.INC	;NEED SPACE FOR TEMP RC BLOCK
	PUSHJ	P,DY.GET##
	TRNE	FL,R.FHS	;FORCED HIGH?
	JRST	T.3RC2		;YES
T.3RC1:	PUSHJ	P,T.3CH		;[1304] MAKE SURE SLOT 2 IS EMPTY
	HRLM	R,LL.S2		;SET ORIGIN GREATER THAN 256K
	MOVEM	T1,@RC.TB	;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
	MOVE	R,SG.TB+1	;[2247] GET .LOW. RC BLOCK
	MOVX	T2,AT.RP	;[2247] GET THE RELOCATABLE PSECT ATTRIBUTE
	ANDCAM	T2,RC.AT(R)	;[2247] MAKE SURE .LOW. IS NOT RELOCATABLE
	MOVEI	R,2		;[2247] POINT BACK TO HIGH SEGMENT
	HRLZ	T2,SG.TB+1	;COPY .LOW.
	HRR	T2,T1		;TO SLOT #2
	BLT	T2,RC.INC-1(T1)
	MOVE	T2,LL.S2	;ADD HISEG OFFSET
	ADDM	T2,RC.IV(T1)	;TO HIGH COUNTERS
	ADDM	T2,RC.CV(T1)
	MOVE	T1,SG.TB+1	;NOW MODIFY RC #1
	HLRZ	T2,W1		;BY LENGTH OF HIGH SEG
	SUBI	T2,(W1)
	ADDM	T2,RC.CV(T1)	;SO WE LOAD IN CORRECT PLACE
				;NOTE THIS SHOULD REALLY BE IN RC.OF
				;BUT IT SAVES TIME AT RB.1 TO DO
				;IT THIS WAY SINCE FORCED LOADING IS THE SPECIAL CASE
	MOVE	R,@RC.TB	;AND TO RELOCATION BLOCK
	MOVE	T2,RC.CV(R)	;GET CURRENT "HIGH" RELOCATION
	SUB	T2,LL.S2	;REMOVE HISEG ORIGIN
	MOVE	W3,T2		;[2254] SO  MAP COMES OUT RIGHT
	MOVEI	R,1		;ALSO "LOW" COUNTER IS TOO SMALL
	MOVE	R,@RC.TB	;SINCE LOW CODE IS ON TOP OF HIGH
	MOVE	W2,RC.CV(R)	;[2254] REPLACE VALUE SETUP AT T.6
	JRST	T.3TTL		;GO STORE W2 AND W3
T.3RC2:	MOVEI	R,1		;PUT IN SLOT #1
	MOVEM	T1,@RC.TB	;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
	HRLZ	T2,SG.TB+2	;COPY .HIGH.
	HRR	T2,T1		;TO SLOT #1
	BLT	T2,RC.INC-1(T1)
	HLRZ	T2,W1		;BY LENGTH OF HIGH SEG
	SUBI	T2,(W1)
	ADDM	T2,RC.CV(T1)	;SO WE LOAD IN CORRECT PLACE
	MOVN	T2,LL.S2	;REMOVE HIGH SEG OFFSET
	ADDM	T2,RC.IV(T1)
	ADDM	T2,RC.CV(T1)	;FROM LOW COUNTERS
	MOVE	R,@RC.TB	;AND TO RELOCATION BLOCK
	MOVE	T2,RC.CV(R)	;GET CURRENT "LOW" RELOCATION
	ADD	T2,LL.S2	;PUT BACK HISEG ORIGIN
	MOVE	W2,T2		;[2254] SO MAP COMES OUT RIGHT
	SETO	W3,		;NOT CHANGING HI-SEG
	JRST	T.3TTL		; GO STORE CHANGES

T.3TST:	HLRZ	T1,W2		;CHECK FORLENGTH OF LOW SEGMENT
	SUBI	T1,(W2)		;FROM FORTRAN-10
	JUMPG	T1,T.3L		;YES
	JRST	T3HOLD##	;LOAD IT INTO FX CORE UNTIL
;HERE IF LOW SEGMENT LENGTH GIVEN (FORTRAN-10)
;LOAD HIGH SEG ON TOP OF LOW SEG

T.3L:	HLRZ	T1,W2		;GET LOW SEG LENGTH
	CAIL	T1,(W1)		;IS LENGTH LESS THAN HISEG ORIGIN?
	PUSHJ	P,E$$HSL	;[1174] NO, GIVE FATAL ERROR
	HRRZM	W1,SO.S2	;OFFSET FOR RELOCATION
	MOVEI	T2,RC.INC	;NEED SPACE FOR TEMP RC BLOCK
	PUSHJ	P,DY.GET##
	TRNE	FL,R.FHS	;FORCED HIGH?
	JRST	T.3L2		;YES
	MOVE	R,SG.TB+1	;[2253] GET .LOW. RC BLOCK
	MOVX	T2,AT.RP	;[2253] GET THE RELOCATABLE PSECT ATTRIBUTE
	ANDCAM	T2,RC.AT(R)	;[2253] MAKE SURE .LOW. IS NOT RELOCATABLE
	PUSHJ	P,T.3CH		;[1304] MAKE SURE SLOT 2 IS EMPTY
	HRLM	R,LL.S2		;SET ORIGIN GREATER THAN 256K
	MOVEM	T1,@RC.TB	;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
	HRLZ	T2,SG.TB+1	;COPY .LOW.
	HRR	T2,T1		;TO SLOT #2
	BLT	T2,RC.INC-1(T1)
	MOVE	T2,LL.S2
	ADDM	T2,RC.IV(T1)
	ADDM	T2,RC.CV(T1)	;HIGH COUNTERS HAVE OFFSET
	HLRZ	T2,W2		;MODIFY RC #2 BY LENGTH OF LOW SEG
	SUBI	T2,(W2)
	ADDM	T2,RC.CV(T1)	;SO WE LOAD IN CORRECT PLACE
				;NOTE THIS SHOULD REALLY BE IN RC.OF
				;BUT IT SAVES TIME AT RB.1 TO DO
				;IT THIS WAY SINCE FORCED LOADING IS THE SPECIAL CASE
	MOVE	R,@RC.TB	;AND TO RELOCATION BLOCK
	MOVE	T2,RC.CV(R)	;GET CURRENT "HIGH" RELOCATION
	SUB	T2,LL.S2	;REMOVE HISEG ORIGIN
	MOVE	W3,T2		;[2254] SO MAP COMES OUT RIGHT
	SETO	W2,		;NOT CHANGING LOWSEG
	JRST	T.3TTL		;GO UPDATE TITLE BLOCK

T.3L2:	MOVEI	R,1		;PUT IN SLOT #1
	MOVEM	T1,@RC.TB	;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
	HRLZ	T2,SG.TB+2	;COPY .HIGH.
	HRR	T2,T1		;TO SLOT #1
	BLT	T2,RC.INC-1(T1)
	MOVN	T2,LL.S2	;REMOVE OFFSET FROM RC #1
	ADDM	T2,RC.IV(T1)
	ADDM	T2,RC.CV(T1)
	MOVE	T1,SG.TB+2	;NOW MODIFY RC #2
	HLRZ	T2,W2		;BY LENGTH OF HIGH SEG
	SUBI	T2,(W2)
	ADDM	T2,RC.CV(T1)	;SO WE LOAD IN CORRECT PLACE
	MOVEI	R,2		;FOR HIGH SEGMENT RELOCATION
	MOVE	R,@RC.TB	;AND TO RELOCATION BLOCK
	MOVE	W3,RC.CV(R)	;[2254] GET LOW RELOCATION FOR MAP
	SETO	W2,		;NOT CHANGING REAL LOWESEG
	JRST	T.3TTL		;RECORD CHANGES
;HERE TO SET HIGH SEG RELOC COUNTER (.HIGH.)
;CALLED BY
;	MOVE	W1,ORG OF HIGH SEG (0 FOR DEFAULT 400000)
;	PUSHJ	P,SETRC
;ALWAYS RETURNS .+1

SETRC::	HRRZ	W1,W1		;CLEAR HIGH SEG SIZE (IF GIVEN)
	SKIPN	W1		;SKIP IF ADDRESS GIVEN
	MOVEI	W1,400000	;ASSUME 400000 IF NOT
	ANDCM.	W1,.PGSIZ	;SET ON PAGE BOUND
	MOVEM	W1,SO.S2	;STORE SOFTWARE ORIGIN
	MOVEI	R,1		;SET R FOR LOW SEGMENT
	MOVE	R,@SG.TB	;GET BLOCK POINTER
	TRNE	FL,R.RED	;[2272] DOING /REDIRECT?
	 JRST	[MOVE T1,REDHI	;[2272] YES, GET PSECT NAME
		 CAME T1,['.HIGH.'] ;[2272] IS IT HIGH SEG?
		 POPJ P,	;[2272] NO, DON'T DO ANYTHING
		 JRST .+1]	;[2272] YES, SET UP A HIGH SEG
	SKIPE	LL.S2		;HAVE WE ALREADY SETUP SEG ORIGIN?
	POPJ	P,		;YES, JUST RETURN
	CAMG	W1,RC.CV(R)	;BUT MUST BE HIGHER THAN LOW SEG
	JRST	E$$HSL		;[1174] TOO LOW
	MOVEI	T1,.JBHDA	;[1170] SIZE OF VESTIGIAL JOBDAT
	MOVEM	T1,HC.S2	;[1170] STORE IN CASE NOTHING ELSE LOADED
	MOVEM	T1,HL.S2	;[1231]   ..
	MOVEM	W1,LL.S2	;FOR INPUT ROUTINE ONLY
	MOVEI	T2,RC.INC	;HERE TO ALLOCATE SPACE FOR RC BLOCK
	AOS	RC.NO		;[1304] COUNT ONE MORE
	SOSGE	RC.FRE		;[2207] AND ONE LESS HOLE
	PUSHJ	P,.SETEX##	;[2207] NO SPACE, MUST EXPAND
	PUSHJ	P,DY.GET##	;IN DYNAMIC AREA
	MOVEI	R,2		;[2207] POINT AT HIGH SEGMENT SLOT
	SKIPN	@RC.TB		;[1304] SLOT ALREADY OCCUPIED?
	 JRST SETRC3		;[2207]
	MOVE	T2,@RC.TB	;[2207] SAVE CURRENT OCCUPANT
	MOVE	R,RC.NO		;[2207] GET NUMBER OF NEW SLOT
	MOVEM	T2,@RC.TB	;[2207] PUT THIS PSECT THERE
	MOVEI	R,2		;[2207] BACK TO THE HIGH SEG
SETRC3:	MOVEM	T1,@RC.TB	;[1304] GET POINTER INTO TABLE
	MOVEM	T1,@SG.TB	;[1304]
	MOVE	R,T1		;[1304] SAFER PLACE FOR POINTER
	MOVEM	W1,RC.IV(R)	;[1304] START OF RELOCATION
	MOVE	T2,['.HIGH.']	;NAME
	MOVEM	T2,RC.NM(R)
	ADDI	W1,.JBHDA	;DON'T FORGET HIGH JOBDATA AREA
	MOVEM	W1,RC.CV(R)	;AS CURRENT RC
	MOVEM	W1,RC.HL(R)	;[1132] CONSIDER THESE TO BE LOADED
	MOVEI	T1,2		;SEGMENT NUMBER
	MOVEM	T1,RC.SG(R)	;IN TABLE  SO WE KNOW WHERE IT IS
	SETZM	RC.OF(R)	;ZERO RELATIVE TO HC.LB
	MOVEI	T1,HC.LB
	MOVEM	T1,RC.LB(R)
	MOVEI	T1,LW.S2	;ADDRESS OF LOWER WINDOW
	MOVEM	T1,RC.WD(R)
	MOVEI	T1,UW.S2	;ADDRESS OF UPPER WINDOW
	MOVEM	T1,RC.PG(R)	;NON-ZERO IF PAGING
	MOVX	T1,<1,,0>	;[1300] MAX LIMIT
	MOVEM	T1,RC.LM(R)	;[1300]
	JRST	T.3AA		;NOW SETUP HC AREA

T.3CH:	SETZM	SLOT2		;[1304] ASSUME NO PSECTS
	MOVEI	R,2		;[1304] POINT TO SLOT 2
	CAMLE	R,RC.NO		;[1304] IN USE?
	POPJ	P,		;[1304] NO
	MOVE	T2,@RC.TB	;[1304] GET POINTER TO BLOCK
	MOVE	T2,RC.NM(T2)	;[1304] GET NAME
	CAMN	T2,['.HIGH.']	;[1304] REAL HIGH SEG?
	POPJ	P,		;[1304] YES
	MOVE	T2,@RC.TB	;[1304] NO, GET THE PSECT POINTER
	MOVEM	T2,SLOT2	;[1304] HIDE IT AWAY FOR THIS MODULE
	POPJ	P,		;[1304]
;NOW TO SETUP HC AREA IF NOT DONE YET
T.3AA:	MOVE	T1,LC.UB	;TOP OF WHAT WE HAVE
	SUB	T1,LC.AB	;GIVES FREE SPACE THERE
	CAIL	T1,2*.IPS	;NEED AT LEAST THIS
	JRST	T.3AB		;GOT IT
	MOVEI	P2,2*.IPS	;NO, SO GET IT
	MOVEI	P1,LC.IX	;IN LOW SEG AREA
	PUSHJ	P,LNKCOR##
	  PUSHJ	P,E$$MEF##	;[1174]
	MOVNI	T1,2*.IPS	;BUT LC.AB WAS INCREMENTED
	ADDM	T1,LC.AB	;SO PUT IT BACK AS IT WAS
	ADDM	T1,LC.FR	;AND FREE SPACE THERE
IFN TOPS20,<			;[2202]
	SKIPN	T2,UW.LC	;[2202] IS IT PAGED?
	 JRST	T.3AA		;[2202] NO
	MOVE	T1,LW.LC	;[2202] GET LOWER WINDOW
	ADD	T1,LC.AB	;[2202] PLUS UPPER BOUND
	SUB	T1,LC.LB	;[2202] MINUS LOWER BOUND
	MOVEM	T1,UW.LC	;[2202] NEW UPPER WINDOW
	ADDI	T1,1		;[2202] BOTTOM OF AREA TO REMOVE
	PUSHJ	P,LC.OUT##	;[2202] REMOVE IT
>; [2202] IFN TOPS20
	JRST	T.3AA		;TRY AGAIN

T.3AB:	LSH	T1,-1		;[650] SPLIT EXTRA ROOM BETWEEN LC & HC
	ANDCMI	T1,.IPM		;[650] BUT MAKE SURE AN EVEN PAGE
	MOVE	T3,LC.AB	;WE NEED THIS MUCH
	ADDB	T3,T1		;PLUS HALF OF WHATS SPARE
	MOVEI	T2,1(T3)	;GET NEXT LOCATION
	EXCH	T3,LC.UB	;FOR UPPER BOUND
	MOVEM	T2,HC.LB	;FOR NEW LOWER BOUND
	MOVEM	T3,HC.UB	;FOR UPPER
	ADDI	T2,.IPM		;NEED SPACE FOR .JBHDA
	MOVEM	T2,HC.AB	;SO RESERVE IT

IFN TOPS20,<			;[2202]
	MOVE	T1,LC.JF	;[2247] GET LOW SEGMENT JFN
	MOVEM	T1,HC.JF	;[2247] HIGH SEGMENT GOES IN SAME FORK
	SETZB	T1,LW.HC	;[2247] MAP IN FROM ZERO
	MOVE	T2,HC.AB	;[2247] GET THE UPPER BOUND
	SUB	T2,HC.LB	;[2247] MINUS LOWER IS SIZE
	MOVEM	T2,UW.HC	;[2247] REMEMBER BOUND
	PUSHJ	P,HC.IN##	;[2247] MAP IT IN
> ;[2202] IFN TOPS20

	POPJ	P,		;RETURN

;[2223] Here to handle /REDIRECT of the high segment.

T.3RED:	MOVE	W2,REDHI	;[2223] Get the psect name
	CAMN	W2,['.HIGH.']	;[2272] Is it the real high seg?
	 POPJ	P,		;[2272] Yes, don't bother to look for it
	PUSHJ	P,T.6FPS	;[2223] Find the psect
	MOVEI	R,2		;[2223] Set for low segment psect
	EXCH	T1,@RC.TB	;[2223] Set in the RC table, Get old
	MOVEM	T1,SLOT2	;[2223] Store the old psect
	MOVEI	T1,377777	;[2223] Get something big and positive
	HRLM	T1,LL.S2	;[2223] So nothing goes in high segment
	POPJ	P,


E$$HSL::.ERR.	(MS,.EC,V%L,L%F,S%F,HSL,<Attempt to set high segment origin too low>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
SUBTTL	BLOCK TYPE 4 - ENTRIES


;	----------------
;	!    4 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!      SYMBOLS !
;	----------------

T.4:
IFN FTOVERLAY,<
	PUSH	P,BG.SCH	;SAVE CURRENT STATE OF NOUNVS
	SETZM	BG.SCH		;DON'T SEARCH BOUND GLOBALS
> ;END IFN FTOVERLAY
	MOVEI	T2,0(W1)	;GET NUMBER OF ENTRIES IN THIS MODULE
	JUMPE	T2,T.4A		;IGNORE 0 ENTRIES
	SKIPN	ENTPTR		;ALREADY SOME ENTRIES FOR THIS MODULE?
	JRST	T.4E		;NO
	HLRO	T1,ENTPTR	;GET -NUMBER
	SUB	T2,T1		;NUMBER WE NEED
	PUSHJ	P,DY.GET##	;GET IT
	HRLZ	T3,ENTPTR	;FORM BLT PTR
	HRR	T3,T1
	HLRO	T4,ENTPTR	;-NUMBER OF WORDS
	MOVM	W3,T4
	ADDI	W3,(T1)		;END OF BLT
	BLT	T3,-1(W3)	;MOVE ALL PREVIOUS ENTRIES
	MOVN	T2,T2		;NEGATE NEW LENGTH
	HRL	T1,T2		;FORM AOBJN POINTER
	EXCH	T1,ENTPTR	;SWAP POINTERS
	HRRZ	T1,T1		;ADDRESS ONLY
	MOVM	T2,T4		;AND LENGTH
	PUSHJ	P,DY.RET##	;GIVE SPACE BACK
	JRST	T.4D		
T.4E:	MOVN	T1,T2
	HRLM	T1,ENTPTR	;LEFT HALF OF AOBJN PTR
	PUSHJ	P,DY.GET##	;GET SPACE
	HRRM	T1,ENTPTR	;FINISH POINTER
	HRRZ	W3,T1		;DON'T NEED W3 FOR ANYTHING
T.4D:	HRLI	W3,(POINT 36)	;SO USE AS DEPOSIT BYTE POINTER
	TRNN	FL,R.LIB	;IN LIBRARY SEARCH MODE
	JRST	T.4B		;NO, JUST STORE SYMBOLS FOR LATER
T.4A:	PUSHJ	P,RB.1		;READ A WORD
	  JRST	T.4X		;END OF BLOCK
	MOVE	W2,W1		;PUT SYMBOL IN 2ND WORD
	SETZ	W1,		;ZERO FLAGS
	PUSHJ	P,R50T6		;CONVERT TO SIXBIT
	IDPB	W2,W3		;STORE ENTRY
	PUSHJ	P,TRYSYM##	;SEE IF SYMBOL IS IN TABLE
	  JRST	T.4A		;NO, TRY NEXT
	  JRST	T.4C		;UNDEF, SEE IF WE NEED IT
	JRST	T.4A		;DEFINED, DON'T NEED THIS DEFINITION

T.4C:	MOVE	W1,0(P1)	;SET UP FLAGS FROM GS AREA
	TXNN	W1,PS.UDF	;DON'T NEED IF ALREADY PART. DEF.
	TXNN	W1,PS.REQ	;OR IF NEVER REQUESTED
	JRST	T.4A		;DON'T NEED THIS SYMBOL
	TRZ	FL,R.LIB!R.INC	;LOAD THIS MODULE!
T.4B:	PUSHJ	P,RB.1
	  JRST	T.4X		;END OF BLOCK
	MOVE	W2,W1		;PUT IN SYMBOL ACC
	PUSHJ	P,R50T6		;SIXBITIZE
	IDPB	W2,W3		;STORE
	JRST	T.4B		;LOOP

T.4X:
IFN FTOVERLAY,<
	POP	P,BG.SCH	;RESTORE SEARCH BG'S FLAG
> ;END IFN FTOVERLAY
	JRST	LOAD##		;END OF BLOCK
SUBTTL	BLOCK TYPE 5 - END


;			  OR
;	----------------	----------------
;	!    5 ! COUNT !	!    5 ! COUNT !
;	----------------	----------------
;	! BYTE   WORD  !	! BYTE   WORD  !
;	----------------	----------------
;	! HIGH   RELOC !	!  LOW   RELOC !
;	----------------	----------------
;	!  LOW   RELOC !	!  ABS     LOC  !
;	----------------	-----------------

T.5:	MOVEI	T1,1		;[1156] BREAKS ARE RELOCATABLE IN .LOW.
	SKIPE	RC.CUR		;[1156] SO UNLESS NOT LOADING PSECTS,
	MOVEM	T1,RC.CUR	;[1156] FORCE RELOCATION TO .LOW.
	SKIPN	POLSTK		;GIVE BACK POLISH STACK IF FINISHED
	JRST	T.5A
	MOVE	T2,POLLEN	;[1274] LENGTH OF STACK
	HRRZ	T1,POLSTK	;START OF IT
	ADDI	T1,1		;WAS AN IOWD
	PUSHJ	P,DY.RET##	;RETURN IT
	SETZM	POLSTK		;AVOID CONFUSION
T.5A:
	PUSHJ	P,T.5ENT	;RETURN SPACE USED BY ENTRY STORE
	PUSHJ	P,T.5RB		;[2247] GET FIRST WORD
	JRST	[MOVEI	T1,5	;[1204] NOT THERE, ILLEGAL
		JRST	E$$RBS]	;[1204] GO COMPLAIN
	TLNE	W1,-1		;[1210] BREAK OK IN REL FILE?
	JRST	E$$PBI		;[1210] NO, GO COMPLAIN
	IOR	W1,LSTRRV	;[2223] GET FULLWORD (IN CASE /REDIRECT)
	TRNN	R,-1		;[2223] A PSECT SPECIFIED?
	 HRR	R,@RC.TB	;[2223] NO, USE .ABS.
	CAMLE	W1,RC.LM(R)	;[2223] PSECT TOO BIG?
	PUSHJ	P,TOOBIG	;[2223] YES
	MOVE	W2,W1		;[1300] GET TRUE VALUE (LSTRRV)
T.5PBI:	PUSHJ	P,RB.1		;[1210] GET SECOND WORD
	JRST	[SETZ	W1,	;[1210] OK, JUST USE ZERO
		JRST	T.5BR]	;[1210] WE'VE GOT THE BREAKS
	TLNE	W1,-1		;[1210] INVALID?
	JRST	E01PBI		;[1210] YES, GO COMPLAIN
	IOR	W1,LSTRRV	;[2223] GET FULLWORD (IN CASE /REDIRECT)
	TRNN	R,-1		;[2223] A PSECT SPECIFIED?
	 HRR	R,@RC.TB	;[2223] NO, USE .ABS.
	CAMLE	W1,RC.LM(R)	;[2223] PSECT TOO BIG?
	PUSHJ	P,TOOBIG	;[2223] YES
T.5BR:	SKIPE	W3,LOD37	;[1210] COBOL LOCAL SYMBOLS
				;BUT IF THEY'RE LOADED
	SUBI	W3,3		; REMOVE EXTRA 3 OVERHEAD WORDS
	ADD	W3,OWNLNG	;ADD IN ALGOL OWN BLOCK
;	ADD	W3,VARLNG	;ADD IN LVAR BLOCKS
	SETZM	LOD37		;[1114] DONE WITH COBOL SYMBOLS
	SETZM	OWNLNG		;[1114]   AND ALGOL OWNS
;	SETZM	VARLNG		;[1114]   AND LVARS
T.5F40::			;ENTRY FROM LNKF40
T.5B:	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	TRNN	FL,R.TWSG	;TWO SEGMENTS?
	CAIA			;NO, FORGET IT
	PUSHJ	P,T.5ZRO	;YES, MAKE SURE OTHER SEG IS 0 LEN
	TRNE	FL,R.FHS!R.FLS	;FORCED TO LOAD HIGH, OR LOW, OR HISEG PSEUDO-OP?
	JRST	T.5FS		;YES, SORT OUT RC TABLES
	TRNE	FL,R.TWSG	;TWO SEGMENTS ARE SPECIAL
	JRST	T.5LS		;AS THERE IS NO ABS RC COUNTER
;	CAMGE	W1,W2		;SINGLE SEGMENT
T.5LSS:	MOVE	W1,W2		;USE LARGER OF REL OR ABS
	ADD	W1,W3		;ADD IN EXTRA OVERHEAD FROM COBOL OR ALGOL
T.5LS:	MOVEI	R,1		;MAKE SURE R = LOW
	MOVE	R,@RC.TB
	CAMGE	W1,RC.HL(R)	;[1253] CHECK RELOCATION COUNTER
	MOVE	W1,RC.HL(R)	;[1253] USE GREATER
	CAMLE	W1,RC.CV(R)	;NEVER DECREASE
	MOVEM	W1,RC.CV(R)	;FOR NEXT FILE
	CAML	W1,RC.LM(R)	;[1300] CHECK LIMIT OF .LOW.
	PUSHJ	P,TOOBIG	;[1300] LOW SEG BREAK TOO BIG
	TRNE	FL,R.RED	;[2223] DOING /REDIRECT?
	 JRST	T.5LS1		;[2223] YES, DON'T SET HP.S1 (THIS IS A PSECT)
	SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST ADDRESS IN PROGRESS
	CAMLE	W1,HP.S1	;[1273] UPDATE HIGHEST ADDRESS FOR .LOW.
	MOVEM	W1,HP.S1	;[1273]
T.5LS1:	CAMLE	W1,HL.S1	;AND HIGHEST ADDRESS IN THIS SEGMENT
	MOVEM	W1,HL.S1
	TRNN	FL,R.TWSG	;TWO SEGMENTS?
	JRST	T.5END		;GET NEXT BLOCK

T.5THS:	MOVEI	R,2		;SET FOR HIGH SEG
	MOVE	R,@RC.TB
	CAMGE	W2,RC.HL(R)	;[1253] CHECK RELOCATION COUNTER
	MOVE	W2,RC.HL(R)	;[1253] USE GREATER
	CAMLE	W2,RC.CV(R)
	MOVEM	W2,RC.CV(R)	;FOR NEXT FILE
	CAML	W2,RC.LM(R)	;[1300] CHECK LIMIT OF .HIGH.
	PUSHJ	P,TOOBIG	;[1300] HIGH SEG BREAK TO BIG
	TRNE	FL,R.RED	;[2223] DOING /REDIRECT?
	 JRST	[CAMLE W1,HL.S1	;[2223] YES, THIS IS IN LOW SEGMENT
		 MOVEM W1,HL.S1	;[2223] SO UPDATE POINTERS THERE
		 JRST T.5END]	;[2223] DON'T TOUCH HIGH SEG POINTERS
	CAMLE	W2,HP.S2	;[1273] UPDATE HIGHEST ADDRESS FOR .HIGH.
	MOVEM	W2,HP.S2	;[1273]
	SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST IN PROGRESS
	MOVE	T1,W2		;GET A COPY
	SUB	T1,LL.S2	;REMOVE OFFSET
	CAMLE	T1,HL.S2	;CHECK HIGHEST ADDRESS IN THIS SEGMENT
	MOVEM	T1,HL.S2	; RESET
T.5END:	MOVE	T1,NAMPTR	;[2254] POINTER TO START OF FILE
	CAMGE	T1,LW.LS	;IN CORE?
	JRST	T.5PAG		;NO, GENERATE FIXUP
	SUB	T1,LW.LS	;REMOVE OFFSET
	ADD	T1,LS.LB	;ADD IN BASE
	SKIPGE	T2,(T1)		;GET PRIMRY  TRIPLET
	TXNN	T2,PT.TTL	;IT BETTER BE A TITLE BLOCK
	JRST	E02SFU		;[1174] ERROR
	MOVE	T2,LSYM		;POINT TO END (NEXT FILE)
	MOVEM	T2,2(T1)	;[2254] FILL IN POINTER
T.5LP:	MOVE	T1,SEGPTR	;[2254] POINTER TO START OF SEG INFO
	CAMGE	T1,LW.LS	;IN CORE?
	JRST	T.5PSG		;NO, GENERATE FIXUP
	SUB	T1,LW.LS	;REMOVE OFFSET
	ADD	T1,LS.LB	;ADD IN BASE
	SKIPL	T2,(T1)		;MUST BE SECONDARY
	TXNN	T2,S.TTL	;AND A TITLE BLOCK AT THAT
	JRST	E02SFU		;[1174]
	TXNN	T2,S.SEG	;SEG BLOCK?
	 JRST	E02SFU		;[2057] NO, SYMBOL TABLE FOULED UP
	TRZN	FL,R.FHS	;SLIGHT PROBLEM IF FORCED HIGH
	JRST	T.5L1		;[2254] AND A SINGLE SEG PROG
				;[2254] AS PC IN .LOW. IS IN HISEG
	CAMGE	W1,1(T1)	;[2254] SO UNLESS LOW PC EQUAL OR GREATER
	SETZB	W1,1(T1)	;ASSUME NO LOW CODE FOR THIS MODULE
T.5L1:	MOVEM	W1,2(T1)	;[2254] STORE LOW SEGMENT HIGH VALUE
	ADDI	T1,.L		;[2254] GO TO NEXT TRIPLET
	SKIPL	T2,(T1)		;[2254] MUST BE SECONDARY
	TXNN	T2,S.TTL	;[2254] AND A TITLE BLOCK AT THAT
	JRST	E02SFU		;[2254]
	TXNE	T2,S.SEG	;[2254] SEG BLOCK?
	TXNN	T2,S.SHI	;[2254] FOR HIGH SEG?
	 JRST	E02SFU		;[2254] NO, SYMBOL TABLE FOULED UP
	TRNN	FL,R.LSO	;LOW SEGMENT ONLY LOADED?
	TRNN	FL,R.TWSG	;WAS THIS A TWO SEG PROG?
	SETZB	W2,1(T1)	;[2254] NO, CLEAR HIGH MARKER
	SKIPE	1(T1)		;[2254] IF THERE  WAS HIGH SEEN
	MOVEM	W2,2(T1)	;[2254] STORE HIGH
	SKIPN	RC.CUR		;DOING PSECT
	JRST	T.5RET		;NO
	MOVE	T2,LSYM
	TXO	T2,SS.PS	;[2254] FLAG AS PSECT TRIPLET POINTER
	MOVEM	T2,2(T1)
T.5RET:	SKIPE	UW.LS		;ARE WE PAGING SYMBOLS?
	PUSHJ	P,T.5XPL	;SEE IF ANY TO GO OUT
	TRZ	FL,R.LOD	;DONE WITH END BLOCK NOW
	SETZM	MODTYP		;[1306] RESET PSECT/TWOSEG FLAG
	SKIPN	RC.CUR		;[1517] BEEN PROCESSING PSECTS?
	JRST	T.5PSC		;[1517] NO
	MOVEI	R,1		;[2207] GET LOCATION OF .LOW. IN RC.TB
	HRRZM	R,@RC.MAP	;[2207] RESET THE FIRST MAP SLOT
	MOVE	R,RC.NO		;START AT END
	MOVX	W1,PT.SGN!PT.EXT!PT.TTL!PT.PSC ;[711] MARK BLOCK
T.5PSA:	MOVE	P1,@RC.TB	;[2220] RC BLOCK
	MOVX	P2,AT.PS	;[2220] FLAG FOR PSECT SEEN IN THIS MODULE
	TDNN	P2,RC.AT(P1)	;[2220] DID WE SEE THIS PSECT IN THIS MODULE?
	JRST	T.5PSB		;NO
	ANDCAB	P2,RC.AT(P1)	;[2220] CLEAR FLAG FOR NEXT TIME
	MOVE	W2,RC.NM(P1)	;[2220] GET NAME
	PUSHJ	P,LS.ADD##	;PUT IN LOCAL TABLE
	MOVX	W1,S.TTL!S.PSC!S.PSV ;[2220] SET FLAGS
	MOVE	W2,RC.CV(P1)	;[2220] GET THE ORIGIN
	MOVE	W3,RC.HL(P1)	;[2220] AND THE TOP
	TXNN	P2,AT.OV	;[2220] OVERLAID PSECT?
	 CAMG	W3,RC.CV(P1)	;[2220] OR LOWER THAN WHAT WE HAVE?
	 CAIA			;[2220] YES, DONT UPDATE RC.CV
	MOVEM	W3,RC.CV(P1)	;[2220] UPDATE CV FOR NEXT MODULE
	PUSHJ	P,LS.ADD##	;[2220] 
	MOVX	W1,S.TTL!S.PSC	;RESET SECONDARY FLAGS
T.5PSB:	SOJG	R,T.5PSA	;LOOP
	SETZM	RC.CUR		;CLEAR MARKER
	MOVE	T1,LS.PT	;PTR TO NEXT FREE TRIPLET
	SKIPL	-.L(T1)		;[711] A PRIMARY?
	JRST	[MOVX	T2,S.LST	;[711] NO, MAKE LAST TRIPLET
		IORM	T2,-.L(T1)	;[711]
		JRST	T.5PSC]		;[711]
	MOVX	T2,PT.EXT	;[711] YES, TURN OFF EXTENDED BIT
	ANDCAM T2,-.L(T1)	;[711]
T.5PSC:	SKIPE	UW.LS		;ARE WE PAGIN SYMBOLS?
	PUSHJ	P,T.5XPL		;SEE IF ANY TO GO OUT
	TRNE	FL,R.RED	;[2223] DOING REDIRECTION?
	 PUSHJ	P,T.5RED	;[2223] YES, PUT WORLD BACK TOGETHER
	SKIPN	DCBUF		;SPECIAL INCORE READS DONE?
	JRST	T5FIN##		;YES, RESET INPUT BUFFER
	JRST	T.LOAD##	;SEE IF IN /SEARCH OR NOT

;[2247] Here to read the first break.  Don't change .LOW. attributes 
;[2247] if only 140 (0 relocatable)
T.5RB:	MOVE	W2,SG.TB+1	;[2247] Get the .LOW. RC block
	PUSH	P,RC.AT(W2)	;[2247] Save the attributes
	PUSHJ	P,RB.1		;[2247] Read and relocate the word
	 POPJ	P,		;[2247] Not there, illegal
	CAIE	W1,140		;[2247] Is it 140?
	 JRST	T.5RB1		;[2247] No, don't want to restore attributes
	POP	P,RC.AT(W2)	;[2247] Yes, restore the attributes
	JRST	CPOPJ1		;[2247] Return
T.5RB1:	POP	P,0(P)		;[2247] Toss the old attributes
	JRST	CPOPJ1		;[2247] Return
;HERE TO RETURN SPACE USED BY ENTRY STORE

T.5ENT::SKIPN	T1,ENTPTR	;ANY ENTRY SPACE TO RETURN
	POPJ	P,		;NO, UNUSUAL
IFN .EXSYM,<			;LONG SYMBOLS ARE STORE IN SEPARATE BLOCK
				;WITH LENGTH,,POINTER IN ENTPTR TABLE
				;IF LENGTH GREATER THAN 7777 WORDS HALT (FOR NOW)
	MOVE	P1,ENTPTR	;LOAD AOBJN POINTER IN SAFE AC
T5ENT0:	MOVE	T1,0(P1)	;GET SYMBOL OR POINTER
	TLNE	T1,770000	;SYMBOLS ARE LEFT JUSTIFIED
	JRST	T5ENT1		;SO NOT A POINTER
	TLNN	T1,-1		;CHECK FOR SUPER LONG SYMBOL (GT. 7777)
	HALT			;JUST IN CASE?
	HLRZ	T2,T1		;GET LENGTH
	HRRZ	T1,T1		;ADDRESS ONLY
	PUSHJ	P,DY.RET##	;GIVE IT BACK
T5ENT1:	AOBJN	P1,T5ENT0	;LOOP
	MOVE	T1,ENTPTR	;RELOAD POINTER
>;END OF .EXSYM
	HLRO	T2,T1		;GET -LENGTH
	MOVM	T2,T2
	HRRZ	T1,T1		;ADDRESS ONLY
	SETZM	ENTPTR		;CLEAR
	PJRST	DY.RET##	;GIVE BACK AND RETURN


;HERE TO MAKE SURE THE NON-LOADED SEGMENT IS ZERO LENGTH
T.5ZRO:	TRNE	FL,R.HSO	;HIGH SEG LOADED?
	SKIPA	R,[1]		;YES, ZERO LOW SEG
	MOVEI	R,2		;NO, ZERO HI SEG
	MOVE	R,@RC.TB	;POINT TO RC BLOCK
	MOVE	T1,RC.CV(R)	;SEG BREAK (SAME AS START)
	MOVE	R,RC.SG(R)	;RESTORE SEGMENT NUMBER
	MOVEM	T1,W1-1(R)	;SET UP PROPER BREAK
	POPJ	P,
;HERE WHEN RELOCATION COUNTERS ARE NOT CORRECT
;IE. FORCED HIGH, FORCED LOW, OR HISEG TO HIGH SEGMENT

T.5FS:	TRNE	FL,R.TWSG	;DO WE REALLY HAVE 2 SEGMENTS
	JRST	[TRNN	FL,R.FHS		;YES, SO MUST BE FORCED
		JRST	T.5FL		;LOW
		JRST	T.5FH]		;OR HIGH
	TRNN	FL,R.FHS	;HISEG WOULD BE FORCED HIGH
	JRST	T.5LSS		;SINGLE SEGMENT FORCED LOW IS SIMPLE
	MOVEI	R,2		;SET FOR HIGH
	SKIPN	T1,SLOT2	;[1304] CHECK FOR PSECT
	MOVE	T1,SG.TB+2	;FROM SECOND
	MOVEM	T1,@RC.TB	;STORE HIGH WHERE IT SHOULD BE
	SETZM	SLOT2		;[1304] RESET JUST IN CASE
	MOVEI	R,1		;SET FOR LOW
	MOVE	T1,SG.TB+1	;FROM WHERE IT IS
	MOVEM	T1,@RC.TB	;TO WHERE IT SHOULD BE
	CAMGE	W1,RC.CV(T1)	;SETUP LOWSEG BREAK IF NO REAL ABS CODE
	MOVE	W1,RC.CV(T1)	;SO MAP WILL SHOW ZERO LENGTH
;	TRZ	FL,R.FHS	;CLEAR FORCED HIGH FLAG
	TRO	FL,R.TWSG
	JRST	T.5LS		;AND TREAT AS IF 2 SEG

;HERE FOR FORCED LOW SEGMENT
;HIGH RELOC COUNTER IS INCORRECT

T.5FL:	MOVEI	R,2		;POINT TO HIGH
	MOVE	T1,@RC.TB	;ADDRESS OF RC BLOCK
	MOVEI	T2,RC.INC	;LENGTH
	PUSHJ	P,DY.RET##	;GIVE IT BACK
	SKIPN	T1,SLOT2	;[1304] CHECK FOR PSECT
	MOVE	T1,SG.TB+2	;POINT TO REAL HIGH SEG BLOCK
	MOVEM	T1,@RC.TB	;STORE 0 OR REAL ADDRESS
	SETZM	SLOT2		;[1304] RESET JUST IN CASE
	MOVEI	R,1		;MAKE SURE R = LOW
	MOVE	R,@RC.TB
	CAMGE	W1,W2		;USE WHICHEVER IS GREATER
	JRST	[CAMGE	W2,RC.HL(R)	;CHECK RELOCATION COUNTER
		MOVE	W2,RC.HL(R)	;USE GREATER
		CAMLE	W2,RC.CV(R)	;NEVER DECREASE
		MOVEM	W2,RC.CV(R)	;FOR NEXT FILE
		SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST IN PROGRESS
		CAMLE	W2,HP.S1	;[1273] UPDATE HIGH FOR .LOW.
		MOVEM	W2,HP.S1	;[1273]
		CAMLE	W2,HL.S1	;AND HIGHEST ADDRESS IN THIS SEGMENT
		MOVEM	W2,HL.S1
		JRST	T.5FLZ]		;GET NEXT BLOCK
	CAMGE	W1,RC.HL(R)	;CHECK RELOCATION COUNTER
	MOVE	W1,RC.HL(R)	;USE GREATER
	CAMLE	W1,RC.CV(R)	;NEVER DECREASE
	MOVEM	W1,RC.CV(R)	;FOR NEXT FILE
	SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST IN PROGRESS
	CAMLE	W1,HP.S1	;[1273] UPDATE HIGHEST FOR .LOW.
	MOVEM	W1,HP.S1	;[1273]
	CAMLE	W1,HL.S1	;AND HIGHEST ADDRESS IN THIS SEGMENT
	MOVEM	W1,HL.S1
T.5FLZ:	HRRZS	LL.S2		;CLEAR FAKE HIGH SEG ORIGIN
	JRST	T.5END		;GET NEXT BLOCK
;HERE FOR FORCED HIGH SEGMENT
;LOW RELOC COUNTER IS INCORRECT

T.5FH:	MOVEI	R,1		;POINT TO LOW
	MOVE	T1,@RC.TB	;ADDRESS OF BLOCK
	MOVEI	T2,RC.INC	;LENGTH
	PUSHJ	P,DY.RET##	;GIVE IT BACK
	MOVE	T1,SG.TB+1	;GET ADDRESS OF REAL LOW RC BLOCK
	MOVEM	T1,@RC.TB	;STORE IN RC TABLE
	MOVEI	R,2		;SET FOR HIGH SEG
	MOVE	R,@RC.TB
	CAMGE	W2,W1		;USE GREATER
	JRST	[CAMGE	W1,RC.HL(R)	;USE GREATER
		MOVE	W1,RC.HL(R)
		CAMLE	W1,RC.CV(R)
		MOVEM	W1,RC.CV(R)	;FOR NEXT FILE
		CAMLE	W1,HP.S2	;[1273] UPDATE HIGH ADDRESS FOR .HIGH.
		MOVEM	W1,HP.S2	;[1273]
		SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST IN PROGRESS
		MOVE	T1,W2		;GET A COPY
		SUB	T1,LL.S2	;REMOVE OFFSET
		CAMLE	T1,HL.S2	;CHECK HIGHEST ADDRESS IN THIS SEGMENT
		MOVEM	T1,HL.S2	; RESET
		JRST	T.5END]
	CAMGE	W2,RC.HL(R)	;USE GREATER
	MOVE	W2,RC.HL(R)
	CAMLE	W2,RC.CV(R)
	MOVEM	W2,RC.CV(R)	;FOR NEXT FILE
	CAMLE	W2,HP.S2	;[1273] UPDATE HIGH ADDRESS FOR .HIGH.
	MOVEM	W2,HP.S2	;[1273]
	SETZM	RC.HL(R)	;[1273] CLEAR HIGHEST IN PROGRESS
	MOVE	T1,W2		;GET A COPY
	SUB	T1,LL.S2	;REMOVE OFFSET
	CAMLE	T1,HL.S2	;CHECK HIGHEST ADDRESS IN THIS SEGMENT
	MOVEM	T1,HL.S2	; RESET
	JRST	T.5END
;HERE TO OUTPUT BOTTOM OF SYMBOL TABLE AND RETURN SPACE
;TO FREE POOL.
;WE KEEP THE LAST PARTIAL BLOCK IN CORE

T.5XPL:	MOVE	T1,LW.LS	;GET LOWER WINDOW PTR
	MOVE	T2,LSYM		;START OF NEXT PROG
	ANDCMI	T2,.IPM
	CAMN	T1,T2		;SAME BLOCK?
	POPJ	P,		;YES, NOTHING TO DO
	MOVE	P1,T2		;[2202] GET BOTTOM OF NEW AREA
	SUBI	T2,1		;[2202] TOP OF OLD AREA
	PUSHJ	P,LS.OUT##	;OUTPUT WINDOW
	MOVE	T1,P1		;[2202] BOTTOM OF NEW WINDOW
	SUB	T1,LW.LS	;MINUS INITIAL
	ADDM	T1,LW.LS	;NEW INITIAL
	ADD	T1,LS.LB	;NEW INCORE BASE
IFN TOPS20,<			;[2215] DON'T HAVE GBCK.L ZERO THE AREA
	HRLI	T1,1		;[2215] SINCE LS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
	SOJA	T1,GBCK.L##	;GIVE IT TO FREE POOL
;HERE TO GENERATE TITLE BLOCK FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS
;WORD 1		BACK PTR,,FORWARD PTR
;WORD 2		INDEX!NAMPTR		[2254]
;WORD 3		LSYM
;

T.5PAG:	MOVE	T2,NAMPTR	;AND REL ADDRESS IN SYMBOL TABLE
	TXO	T2,SPF.TL	;[2200] INDEX
	MOVE	W3,LSYM		;VALUE
	MOVEI	R,FS.SS-FX.S0	;SET INDEX
	PUSHJ	P,SY.CHP##	;PUT IN LIST
	JRST	T.5LP		;AND RETURN TO TRY MORE


;HERE TO GENERATE TITLE SEGMENT INFO FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS
;WORD 1		BACK PTR,,FORWARD PTR
;WORD 2		INDEX!SEGPTR for low seg, +.L for high seg or psects
;WORD 3		VALUE OF SEGMENT BREAK
;
;ENTER WITH

T.5PSG:	MOVE	T2,SEGPTR	;[2254] REL ADDRESS OF LOW IN SYMBOL TABLE
	TXO	T2,SPF.SG	;[2200] INDEX
	MOVE	W3,W1		;[2254] PUT LOW SEG BREAK IN W3
	MOVEI	R,FS.SS-FX.S0	;SET INDEX
	PUSHJ	P,SY.CHP##	;PUT IN LIST
	MOVE	W3,W2		;[2254] HIGH SEG BREAK IN W3
	MOVE	T2,SEGPTR	;[2254] REL ADDRESS OF LOW
	ADDI	T2,.L		;[2254] HIGH IS IN NEXT TRIPLET
	TXO	T2,SPF.SG	;[2254] INDEX
	TRNN	FL,R.LSO	;LOW SEGMENT ONLY LOADED?
	TRNN	FL,R.TWSG	;WAS THIS A TWO SEG PROG?
	SETZ	W3,		;[2254] NO, CLEAR HIGH MARKER
	SKIPN	RC.CUR		;[2254] PSECTS LOADED?
	 JRST	T.5PS1		;[2254] NO
	MOVE	W3,LSYM		;[2254] GET POINTER TO PSECT TRIPLETS
	TXO	W3,SS.PS	;[2254] FLAG AS PSECT TRIPLET POINTER
T.5PS1:	MOVEI	R,FS.SS-FX.S0	;[2254] SET INDEX
	PUSHJ	P,SY.CHP##	;[2254] PUT IN LIST
	JRST	T.5RET		;AND RETURN

;[2223] Here to undo the effects of /REDIRECT.
T.5RED:	MOVEI	R,1		;[2223] Point to low segment
	MOVE	T1,SG.TB+1	;[2223] Get .LOW. back
	MOVEM	T1,@RC.TB	;[2223] Restore it
	TRNE	FL,R.TWSG	;[2223] Been loading twoseg?
	 SKIPN	REDHI		;[2223] Doing high segment redirect?
	 POPJ	P,		;[2223] No, done
	MOVEI	R,2		;[2223] Point to high segment
	SKIPE	T1,SLOT2	;[2223] Get original psect (if any)
	 MOVEM	T1,@RC.TB	;[2223] Restore it
	POPJ	P,		;[2223] Done
;HERE WHEN SYMBOL TABLE FOULED UP, SHOULD NEVER HAPPEN
E02SFU::.ERR.	(MS,0,V%L,L%W,S%W,SFU)	;[1174]
	JRST	T.5RET		;TRY TO CONTINUE

;HERE WHEN PROGRAM BREAK IS INCORRECT, ZERO BREAK AND CONTINUE
E$$PBI::.ERR.	(MS,.EC,V%L,L%W,S%W,PBI,<Program break >) ;[1174]
	.ETC.	(OCT,.EP!.EC,,,,W1)
	.ETC.	(STR,.EC,,,,,< invalid>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	SETZ	W2,		;[1210] CLEAR AND CONTINUE
	JRST	T.5PBI		;[1210] GO READ SECOND WORD

E01PBI::.ERR.	(MS,.EC,V%L,L%W,S%W,PBI) ;[1174]
	.ETC.	(OCT,.EP!.EC,,,,W1)	;[1210] TYPE INVALID BREAK
	.ETC.	(STR,.EC,,,,,< invalid>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	SETZ	W1,		;[1210] CLEAR INVALID BREAK
	JRST	T.5BR		;[1210] CONTINUE
SUBTTL	BLOCK TYPE 6 - NAME


;	----------------
;	!    6 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!         NAME !
;	----------------
;	! TYPE ! BLANK !
;	----------------

T.6:	TROE	FL,R.LOD	;SEE IF LAST END WAS SEEN
	PUSHJ	P,E$$NEB##	;[1174] NO, PREMATURE END OF MODULE
	PUSHJ	P,RB.2		;READ THE TWO POSSIBLE WORDS
	  JRST	[MOVEI	T1,6
		 JRST	E$$RBS]		;[1174]
	PUSH	P,W1		;SAVE VALUE
	PUSHJ	P,R50T6		;CONVERT NAME TO SIXBIT
	TRNE	FL,R.LIB!R.INC	;STILL IN /SEARCH MODE OR /INC MODE?
	JRST	T.6INC		;YES, SEE IF WE NEED THIS MODULE
	SKIPN	EXCPTR		;[563] IF ANY /EXCLUDES
	SKIPE	INCPTR		;[563] NO, BUT MIGHT NEED TO PURGE
				;[563] ENTRY IN /INCLUDE LIST
	JRST	T.6EXC		;SEE IF NOT WANTED
T.6OK:	TRZ	FL,R.LIB!R.INC	;LOADING FOR SURE
	MOVEM	W2,PRGNAM	;SAVE SIXBIT NAME
	SKIPE	REDLO		;[2223] DOING /REDIRECT?
	 PUSHJ	P,T.6RED	;[2223] YES	
	TRNE	FL,R.FHS	;[1276] NEED TO ADJUST THE RELOC TABLES?
	PUSHJ	P,T.6RC		;[1276] YES
	MOVE	T1,LSYM		;GET WORD COUNT IN SYMBOL TABLE
	MOVEM	T1,NAMPTR	;POINTS TO NAME
	.JDDT	LNKOLD,T.6OK,<<CAMN	W2,$NAME>>
	PUSHJ 	P,E$$LMN	;[2305] ISSUE INFO MESSAGE
;HERE TO TAKE PROPER ACTION BASED ON THE CPU TYPE AND COMPILER CODE.

	AOS	PRGNO		;COUNT THIS PROGRAM
	LDB	T1,[POINT 6,(P),5] ;[1120] GET RUNNABLE CPU BITS
	ANDI	T1,CP.MSK	;[1120] CLEAR CPUS WE DON'T KNOW ABOUT
	JUMPN	T1,.+2		;[1120] ASKED FOR NONE?
	MOVEI	T1,CP.MSK	;[1120] YES--MEANS ALL
	HRRZM	T1,CTYPE	;[1120] SAVE WITH COMPILER TYPE
	MOVE	T2,CPUTGT	;[1240] GET TARGET CPUS
	JUMPE	T2,NOTGT	;[1240] THE CPU SWITCHES ARE NOT BEING USED
	TDON	T1,T2		;[1240] TEST FOR A GOOD TARGET SWITCH
	JRST	E$$CPU		;[1240] .DIRECTIVE IS FOR WRONG CPU
NOTGT:	SKIPN	OKCPUS		;[1237] CAN ANY CPU RUN THIS CODE?
	JRST	CPUEND		;[1237] NO--FORGET THIS TEST
	ANDM	T1,OKCPUS	;[1120] ENFORCE CPU FLAGS
	SKIPN	OKCPUS		;[1120] CAN PROG RUN AT ALL NOW?
	PUSHJ	P,E$$CCD		;[1237] NO--CPU CONFLICT DETECTED
CPUEND:	LDB	T1,[POINT 12,(P),17] ;[1237] NOW GET PROCESSOR TYPE
	HRRZS	(P)		;[1120] LEAVE JUST BLANK COMMON ON STACK
	CAILE	T1,CT.LEN	;CHECK FOR RANGE
	SETZ	T1,		;[1120] MAKE IT UNKNOWN
	HRLM	T1,CTYPE	;[1120] SAVE COMPILER TYPE
	MOVE	T2,PROCSN	;[1120] GET LIST OF PROCS SEEN SO FAR
	MOVE	P1,T1		;SAFE PLACE
	XCT	CT.NAM##(T1)	;[1120] PROC ROUTINES EXPECT MANY ACS + (P)
	MOVE	T1,CT.BIT##(P1)	;[1120] GET CORRESPONDING BIT
	IORM	T1,PROCSN	;[1120] SIGNAL WE HAVE SEEN THIS ONE
	IORM	T1,LIBPRC	;[1120] A NEW MODULE THIS LIBRARY PASS
	JRST	T.6BLK		;[1120] GO HANDLE BLANK COMMON


E$$CCD::.ERR.	(MS,.EC,V%L,L%W,S%W,CCD,<CPU conflict>) ;[2003]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	POPJ	P,		;[1237] NON-FATAL ERROR
E$$CPU::.ERR.	(MS,.EC,V%L,L%F,S%F,CPU,<Module incompatible with specified CPU>)	;[1240]
	.ETC.	(JMP,,,,,.ETIMF##)	;[1240]

E$$LMN::.ERR.	(MS,.EC,V%L,L%I5,S%I,LMN,<Loading module >) ;[2305]
	.ETC.	(SBX,.EC!.EP,,,,PRGNAM) ;[2305]
	.ETC.	(STR,.EC,,,,,< from file >) ;[2305]
	.ETC.	(FSP,,,,,DC) ;[2305]
	POPJ	P, ;[2305]
;HERE TO HANDLE BLANK COMMON ARG IN TITLE BLOCK

T.6BLK:	POP	P,T1		;[1120] GET BLANK COMMON BACK
	SKIPE	BLCOMM		;SEEN BLANK COMMON BEFORE?
	JRST	T.6BC		;YES
	HRROM	T1,BLCOMM	;NO, SAVE IT NOW (SIGNAL COMMON SET)
	JUMPE	T1,T.6M		;BUT DON'T STORE SYMBOL IF NO COMMON
	MOVX	W1,PT.SGN!PT.EXT!PT.TTL!PT.FAK	;FAKE TITLE
	MOVE	W2,['BLANK-']	;FOR BLANK COMMON
	SETZ	W3,
	HLRZ	T1,CTYPE	;SPECIAL MESSAGE FOR COBOLS
	CAIE	T1,CT.C74
	CAIN	T1,CT.C68
	SALL			;OTHERWISE LITERAL IS A MESS
	JRST	[MOVE	W2,['LIBOL-']
		PUSHJ	P,LS.ADD##
		DMOVE	W2,[SIXBIT /STATIC-AREA/]
		JRST	T.6A]	;[1433]
	CAIN	T1,CT.CBL
	JRST	[MOVE	W2,['COBOTS']
		PUSHJ	P,LS.ADD##
		DMOVE	W2,[SIXBIT /-STATIC-AREA/]
		JRST	T.6A]
	PUSHJ	P,LS.ADD##
	MOVE	W2,['COMMON']
T.6A:	MOVX	W1,S.TTL
	PUSHJ	P,LS.ADD##	;REST OF NAME
	MOVX	W1,S.TTL!S.LST!S.SEG
	HRRZ	T1,BLCOMM	;GET LENGTH
	MOVEI	R,1		;ASSUME LOW SEG FILE FOR NOW
	MOVE	R,@RC.TB	;PICKUP RELOCATION POINTER
	HRLZ	W2,RC.CV(R)	;GET CURRENT REL COUNTER
	ADD	T1,RC.CV(R)	;GET FINAL
	CAML	T1,RC.LM(R)	;[2205] CHECK THE SIZE
	 PUSHJ	P,TOOBIG	;[2205] DOES NOT FIT
	HRR	W2,T1		;SO MAP CAN WORK OUT LENGTH
	SETZ	W3,		;NO HIGH
	PUSHJ	P,LS.ADD##
	MOVE	W2,['.COMM.']	;NAME OF COMMON
	HRRZ	W1,BLCOMM	;[2205] LENGTH
	MOVE	W3,RC.CV(R)	;CURRENT VALUE
	PUSHJ	P,T.COMM	;TEST COMMON
	  JFCL			;NEVER GETS HERE
	HRRZ	P1,@HT.PTR	;SETUP P1 TO POINT TO SYMBOL
	ADD	P1,NAMLOC	;IN CORE
	PUSH	P,.L+2(P1)	;SAVE 2ND TRIPLET INFO
	PUSH	P,.L+1(P1)
	PUSH	P,.L+0(P1)
	TMOVE	W1,0(P1)	;RESET FIRST  SYMBOL TRIPLET
	PUSHJ	P,LS.ADD##	;PUT IN LOCAL TABLE
	POP	P,W1		;GET SECONDARY
	POP	P,W2		;SAME NAME
	POP	P,W3		;LENGTH
	PUSHJ	P,LS.ADD##
	HRRZ	T1,BLCOMM	;GET LENGTH
	ADDM	T1,RC.CV(R)	;AND INCREMENT RELOC COUNTER
	JRST	T.6M
T.6INC:	PUSHJ	P,INCCHK	;CHECK /INCLUDES
	  SKIPA			;CAN'T LOAD THIS
	JRST	T.6OK		;IN /INCLUDES, GO LOAD IT
	TRZA	FL,R.LOD	;CLEAR LOADING FLAG SINCE WERE NOT
T.6POP:	TRO	FL,R.LIB	;CAUSE MODULE TO BE IGNORED ON /EX
	POP	P,W1		;RESTORE W1 FROM PUSH
	JRST	LOAD##		;AND SKIP THIS MODULE

INCCHK::HRRZ	T1,INCPTR	;ANY /INCLUDES?
	JUMPE	T1,T6INC1	;NO TEMPS, TRY PERMS
	MOVEI	T1,INCPTR	;SCAN INCLUDE TABLE
	PUSHJ	P,T.6SCN
	  JRST	T6INC1		;NOT IN TABLE
T6INC0:	MOVSS	INCPTR		;[563] REMOVE FROM BOTH SIDES OF LIST
	JRST	T6INC2

T6INC1:	HLRZ	T1,INCPTR	;SEE IF ANY PERMS
	JUMPE	T1,CPOPJ	;NO
	MOVEI	T1,EXCPTR	;MAKE SURE NOT IN EXCLUDE TABLE
	PUSHJ	P,T.6SCN	;AS IT MIGHT ALSO BE IN PERM INCLUDES
	  CAIA			;NO, CONTINUE SEARCH
	POPJ	P,		;YES, SO DON'T LOAD IT
	MOVSS	INCPTR		;SWAP PTR
	MOVEI	T1,INCPTR	;SCAN INCLUDE TABLE
	PUSHJ	P,T.6SCN
	  JRST	[MOVSS	INCPTR		;SWAP BACK
		POPJ	P,]		;NOT IN TABLE
T6INC2:	MOVEI	T1,INCPTR	;NOW REMOVE FROM LIST
	PUSHJ	P,EXCL.0##	;SO WE ONLY LOAD IT ONCE
	MOVSS	INCPTR		;PUT BACK
	MOVEI	T1,INCPTR	;NOW REMOVE FROM LIST
	PUSHJ	P,EXCL.0##	;SO WE ONLY LOAD IT ONCE
	JRST	CPOPJ1
T.6EXC:	PUSHJ	P,EXCCHK	;SEE IF EXCLUDED
	  JRST	T.6POP		;YES, DON'T LOAD THIS
	JRST	T.6OK		;NOT EXCLUDED, GO LOAD

EXCCHK::HRRZ	T1,EXCPTR	;SEE IF TEMP
	JUMPE	T1,T6EXC1	;NO, TRY PERM
	MOVEI	T1,EXCPTR	;SEE IF IN EXCLUDE TABLE
	PUSHJ	P,T.6SCN
	  JRST	T6EXC1		;NO, LOAD IT
	POPJ	P,		;DON'T LOAD RETURN

T6EXC1:	HLRZ	T1,EXCPTR	;SEE IF TEMP
	JUMPE	T1,T6INC0	;[563] NO, PURGE /INCLUDES & LOAD IT
	MOVEI	T1,INCPTR	;SEE IF IN LOCAL INCLUDES
	PUSHJ	P,T.6SCN	; BEFORE TRYING GLOB EXCLUDES
	  CAIA			;NO, SO CONTINUE SEARCH
	JRST	T6INC0		;[563] YES, SO WE WANT IT
	MOVSS	EXCPTR		;SWAP
	MOVEI	T1,EXCPTR	;SEE IF IN EXCLUDE TABLE
	PUSHJ	P,T.6SCN
	  JRST	[MOVSS	EXCPTR		;PUT BACK
		JRST	T6INC0]		;[563] NO, LOAD IT
	MOVSS	EXCPTR		;SWAP BACK
	POPJ	P,		;DON'T LOAD RETURN

T.6SCN:	HRRZ	T1,(T1)		;GET POINTER
	JUMPE	T1,CPOPJ	;0 LINK IS END (OR NEVER STARTED)
	ADD	T1,[-.EXC+1,,1]	;FORM AOBJN POINTER
T6SCN1:	SKIPN	T2,(T1)		;NOT IN TABLE IF 0
	POPJ	P,		;FAIL RETURN
	PUSHJ	P,NAMCMP##	;[2326] compare names
	JRST	CPOPJ1		;OK RETURN
	AOBJN	T1,T6SCN1	;LOOP
	SUBI	T1,.EXC		;BACKUP
	JRST	T.6SCN		;TRY NEXT
;NOW FOR SPECIAL STUFF FOR MAPS ETC
T.6M:	MOVX	W1,PT.SGN!PT.TTL	;SET FLAGS
	MOVE	W2,PRGNAM	;RECOVER NAME
	SETZ	W3,		;POINTER TO END
	PUSHJ	P,LS.ADD##	;PUT IN LOCAL SYMBOL TABLE
	SETZM	LSTGBL		;[2255] NOT A REAL SYMBOL SO CLEAR POINTER
	SETZM	LSTLCL		;[2255] CLEAR LOCAL SYMBOL POINTER TOO
	PUSHJ	P,TTLREL	;OUTPUT THE REL FILE INFO

	MOVX	W1,S.TTL!S.PRC	;OUTPUT PROCESSOR INFO
	SETZ	W2,		;DON'T KNOW COMPILER NAME
	MOVE	W3,CTYPE	;GET C. CODE,,CPU CODE
	PUSHJ	P,LS.ADD##	;PUT IN SYMBOL AREA
	MOVX	W1,S.TTL!S.CRE	;GET DATE TIME STUFF
IFE TOPS20,<
	LDB	T2,[POINT 12,FCRE,35]	;GET LOW 12 BITS OF DATE
	LDB	T1,[POINT 3,FEXT,20]	;GET HIGH 3 BITS
	DPB	T1,[POINT 3,T2,23]	;MERGE THE TWO PARTS
	LDB	T1,[POINT 11,FCRE,23]	;GET TIME
	IMULI	T1,^D60		;"MAKE GILBERT HAPPY" - HACRO
	HRLZ	W2,T2		;STORE DATE IN TRIPLET
	HRR	W2,T1		;FORM DATE,,TIME(SECS)
> ;[1421] IFE TOPS20
IFN TOPS20,<

;  CALCULATE DATE/TIME FOR TRIPLET

	MOVE	T2,FCRE			;[1446] PICK UP UNIV DATE-TIME
	SETZM	T4			;[1446] NO SPECIAL COMPUTATIONS
	ODCNV%				;[1446] CONV UNIV TIME TO NUMBERS
	  ERJMP .+1			;[1446] 'IMPOSSIBLE'
;
;  T2: YEAR,,MONTH
;  T3: DAY OF MONTH,,WEEKDAY
;  T4: FLAGS,,SECONDS SINCE MIDNIGHT
;
	HLRZ	T1,T2			;[1446] CONVERT YEAR
	SUBI	T1,^D1964		;[1446] TO TOPS-10 STYLE
	IMULI	T1,^D12			;[1446] MULTIPLY BY MONTHS
	ADDI	T1,(T2)			;[1446] AND ADD EXTRA MONTHS
	MOVSS	T3			;[1446] GET READY WITH DAY OF MONTH
	IMULI	T1,^D31			;[1446] CALC NUMBER OF DAYS
	ADDI	T1,(T3)			;[1446] ADD EXTRA DAYS
	HRLZ	W2,T1			;[1446] W2: DATE,,0
	HRR	W2,T4			;[1446] W2: DATE,,TIME(SEC)
> ;[1446] IFN TOPS20
	SETZ	W3,		;DON'T KNOW COMPILER VERSION
	PUSHJ	P,LS.ADD

	PUSHJ	P,TTLRLC	;PUT OUT RELOCATION COUNTER INFO
	JRST	LOAD##		;GET NEXT BLOCK

T.6BC:	HRRZ	T2,BLCOMM	;GET COMMON SIZE
	CAIG	T1,(T2)		;IS IT WITHIN SIZE OF PREVIOUS?
	JRST	T.6M		;GET NEXT BLOCK
E$$AIC::.ERR.	(MS,.EC,V%L,L%F,S%F,AIC,<Attempt to increase size of >) ;[1174]
	.ETC.	(STR,.EC,,,,,<blank common>) ;[1174]
.ETAIC:	.ETC.	(STR,.EC,,,,,< from >) ;[1174]
	.ETC.	(DEC,.EC!.EP,,,,T2)
	.ETC.	(STR,.EC,,,,,< to >)
	.ETC.	(DEC,.EC!.EP,,,,T1) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HERE TO PUT THE REL FILE DESCRIPTOR INFO INTO THE LS AREA

TTLREL::MOVX	W1,S.TTL!S.RLD	;DEV & UFD
	MOVE	W2,FSTR		;DEV
	SKIPN	W3,UFDPPN	;UFD
	JRST	.+3		;NO
	TLNN	W3,-1		;FOUND ONE
	MOVE	W3,SFDDIR	;UNLESS FULL PATH
	PUSHJ	P,LS.ADD

	MOVX	W1,S.TTL!S.RLN	;FILE NAME & EXT
	MOVE	W2,FNAM		;NAME
	HLLZ	W3,FEXT		;EXT
	PUSHJ	P,LS.ADD

	SKIPE	W3,UFDPPN	;WERE THERE SFD'S
	TLNE	W3,-1
	POPJ	P,		;NO
	MOVEI	R,SFDDIR+1	;POINT TO SFD
T.6S:	MOVX	W1,S.TTL!S.RLS	;YES, SIGNAL SFD SEEN
	DMOVE	W2,(R)		;GET SFD
	JUMPE	W2,CPOPJ	;END IF 0
	PUSHJ	P,LS.ADD	;OUTPUT IT
	ADDI	R,2
	JUMPN	W3,T.6S		;AND CONTINUE
	POPJ	P,		;DONE, RETURN


;HERE TO OUTPUT THE SEGMENT DESCRIPTORS TO THE LS AREA

TTLRLC::MOVX	W1,S.TTL!S.SEG	;[2254] LOW REL COUNTERS
	MOVEI	R,1		;LOW SEG FIRST
	MOVE	R,@RC.TB	;PICKUP RELOCATION POINTER
	MOVE	W2,RC.CV(R)	;[2254] CURRENT VALUE
	SETZ	W3,		;[2254] HIGH VALUE NOT KNOWN YET	
	MOVE	T1,LSYM		;[2254] POINTER TO WHERE IT WILL GO
	MOVEM	T1,SEGPTR	;[2254] STORE FOR FIXUPS
	PUSHJ	P,LS.ADD##	;[2254] PUT IN LS AREA
	MOVEI	R,2		;NOW FOR HIGH
	SKIPN	R,@RC.TB	;PICKUP RELOCATION POINTER
	TDZA	W2,W2		;[2254] NO HIGH SEGMENT YET
	MOVE	W2,RC.CV(R)	;[2254] CURRENT VALUE
	MOVX	W1,S.TTL!S.SEG!S.SHI!S.LST ;[2254] HIGH REL COUNTERS
	PJRST	LS.ADD##	;PUT IN LS AREA AND RETURN

;[2223] Here to adjust the reloc tables if /REDIRECT in progress
T.6RED::MOVE	W2,REDLO	;[2226] Get the psect name
	PUSHJ	P,T.6FPS	;[2223] Find the psect
	MOVEI	R,1		;[2223] Set for low segment psect
	MOVEM	T1,@RC.TB	;[2223] Set in the RC table
	TRO	FL,R.RED!R.FNS	;[2223] Indicate in /REDIRECT mode
	TRZ	FL,R.FLS!R.FHS	;[2223] Force to default segments
	POPJ	P,		;[2223] Return

;[2223] Here to find a psect for redirection.
;[2223] Enter with psect name in W2, return with RC address in T1.
T.6FPS:	MOVE	R,RC.NO		;[2223] Loop over all RC blocks
T.6RL1:	MOVE	T1,@RC.TB	;[2223] RC block where this psect might be
	MOVE	T2,RC.NM(T1)	;[2223] Get the name
	PUSHJ	P,NAMCMP##	;[2223] Is it here?
	 CAIA			;[2223] Yes
	SOJG	R,T.6RL1	;[2223] No, loop over all psects
	JUMPN	R,CPOPJ		;[2223] Return if found
	MOVE	T1,W2		;[2223] Not found, get the psect name
	PUSHJ	P,E$$SRP	;[2223] Type an error
;HERE TO ADJUST THE RELOC TABLES FOR FORCED HIGH SEGMENT LOADING
;SET BY /SEGMENT:HIGH

T.6RC::	SETZ	W1,		;[2326] USE DEFAULT VALUE
	SKIPN	SG.TB+2		;ALREADY HIGH SEG SETUP?
	PUSHJ	P,SETRC		;NO, SETUP 2ND RELOC COUNTER
	MOVEI	R,1		;BUT MAKE RELOC 1 POINT TO SEG 2
	MOVE	T1,SG.TB+2
	MOVEM	T1,@RC.TB
	POPJ	P,
SUBTTL	BLOCK TYPE 7 - STARTING ADDRESS


;	----------------
;	!    7 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!  ST. ADDRESS !
;	----------------
;	! SYMBOL FIXUP !
;	----------------

T.7:	TRNE	FL,R.ISA	;IGNORE STARTING ADDRESSES?
	JRST	T.0		;YES
	PUSHJ	P,RB.1		;[1761] read starting address
	  JRST	[MOVEI	T1,7
		 JRST	E$$RBS]		;[1174]
	HLRZM	W1,ENTLEN	;[1764] STORE THE LENGTH OF THE ENTRY VECTOR
	SKIPN	W2,LSTRRV	;[1775] CHECK FOR ABSOLUTE VALUE
	HRRZ	W2,W1		;[1775] IF ABSOLUTE THEN TAKE RIGHT HALF OF W1
	PUSHJ	P,RB.1		;[1761] READ POSSIBLE SYMBOL NAME
	SETZ	W1,		;[1761] NOT THERE ZERO IT
	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	PUSHJ	P,CHKSEG	;YES, SEE IF WANTED
	  SKIPA	T2,PRGNAM	;GET ACTUAL PROG NAME
	JRST	LOAD##		;NOT WANTED
	MOVEM	T2,STANAM	;STORE IT FOR MAP
	EXCH	W1,W2		;PUT SYMBOL IN W2
	JUMPGE	W2,T.7A		;CHECK FOR SYMBOLIC
	LDB	T2,[POINT 4,W2,3]	;CHECK CODE NOT JUST SIGN BIT
	MOVEI	T1,7		;BLOCK TYPE
	CAIE	T2,14		;MUST BE RADIX50 60,
	JRST	E$$IRB##	;[1174] GIVE ERROR MESSAGE
	PUSHJ	P,R50T6		;SIXBITIZE IT
	PUSH	P,W1		;SAVE CONST.
	MOVX	W1,PT.SGN!PT.SYM!PS.GLB	;SET SOME REASONABLE FLAGS
	SETZ	W3,		;NO VALUE
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED
	  JRST	T.7B		;NOT EVEN IN TABLE
	  JRST	T.7B		;UNDEFINED, SO STORE IN 6BIT
	POP	P,W1		;RESTORE CONST
	ADD	W1,2(P1)	;ADD VALUE
	SETZ	W2,		;NO SYMBOL NOW
T.7A:	PUSHJ	P,SET.ST	;SET STARTING ADDRESS
	JRST	LOAD##		;GET NEXT BLOCK

T.7B:	PUSHJ	P,SY.RQ		;PUT REQUEST IN SYMBOL TABLE
	POP	P,W1		;RESTORE CONST.
IFN FTOVERLAY,<
	DMOVEM	W1,STADDR	;STORE NAME AS STARTING ADDRESS
	SKIPGE	LNKMAX		;ONLY IF IN ROOT
>
	PUSHJ	P,SET.ST	;DO REST OF STUFF
	JRST	LOAD##		;GET NEXT BLOCK
SET.ST::DMOVEM	W1,STADDR	;STORE AS STARTING ADDRESS
	MOVE	T2,PRGNAM	;GET PROGRAM NAME (FROM TITLE)
	CAME	T2,['FORDDT']	;TEST FOR FORTRAN DEBUGGER
	CAMN	T2,['ALGOBJ']	;TEST FOR ALGOL STARTUP ROUTINE
	POPJ	P,		;AND IGNORE
	SKIPN	T2		;IF REAL NAME IN TITLE
	MOVE	T2,FNAM		;OTHERWISE USE FILE NAME
	MOVE	T1,CTYPE	;GET CURRENT COMPILER TYPE
	MOVEM	T1,MNTYPE	;SAVE AS MAIN PROG TYPE
	SETZB	T1,LODNAM	;CLEAR INITIALLY
	SKIPA	T3,[POINT 6,LODNAM]
SETST0:	IDPB	T1,T3		;STORE VALID CHAR
SETST1:	JUMPE	T2,SETST2	;ALL DONE
	SETZ	T1,
	LSHC	T1,6		;GET NEXT CHAR
	CAIG	T1,'Z'		;SEE IF ALPHA
	CAIGE	T1,'0'
	JRST	SETST1		;NO WAY
	CAIGE	T1,'A'		;OK
	CAIG	T1,'9'
	JRST	SETST0		;YES
	JRST	SETST1		;NO

SETST2:
IFN TOPS20,<
	MOVE	T1,FCRE		;[1446] PICK UP FILE CREATION DATE
	MOVEM	T1,COMPDT	;[1446] STASH ASIDE FOR LATER USE
> ;[1446] IFN TOPS20
	MOVE	T1,LODNAM	;SEE WHAT WE ENDED UP WITH
	CAMN	T1,['MAIN  ']	;IF JUST FORTRAN OR MACRO MAIN PROG
	SKIPN	T1,FNAM		;USE A NON-ZERO FILE NAME INSTEAD
	POPJ	P,		;NO, USE WHAT WE HAVE
	MOVEM	T1,LODNAM	;ANYTHING IS BETTER THAN MAIN
	POPJ	P,
SUBTTL	BLOCK TYPE 10 - LOCAL DEFINITION


;	----------------
;	!   10 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! ADDR ! VALUE !
;	----------------

T.10:	PUSHJ	P,RB.1		;READ A DATA WORD
	  JRST	LOAD##		;END OF BLOCK
	CAMN	W1,[-1]		;-1 IS MARKER FOR LEFT HALF FIXUP
	JRST	T.10L
	HRRZ	W3,W1		;[565] VALUE OF SYMBOL
	HLRZS	T2,W1		;[565] PUT ADDRESS IN RHS OF T2 & W1
	IOR	T2,LSTLRV	;[2204] GET THE SECTION NUMBER TOO
	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	PUSHJ	P,CHKSEG	;YES, SEE IF WANTED
	  CAIA			;YES
	JRST	T.10		;NO
IFN FTOVERLAY,<
	SETZ	P1,		;NOT GLOBAL SYMBOL
>
	PUSHJ	P,SY.CHR##	;SATISFY REQUEST
	JRST	T.10		;LOOP 

T.10L:	PUSHJ	P,RB.1		;GET FIXUP WORD
	  JRST	[MOVEI T1,10		;[1174] BLOCK TYPE 10 TOO SHORT
		 JRST E$$RBS]		;[1174]
	HRRZ	W3,W1		;[565] VALUE OF SYMBOL
	HLRZS	T2,W1		;[565] PUT ADDRESS IN RHS OF T2 & W1
	IOR	T2,LSTLRV	;[2204] GET THE SECTION NUMBER TOO
	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	PUSHJ	P,CHKSEG	;YES, SEE IF WANTED
	  CAIA			;YES
	JRST	T.10		;NO
IFN FTOVERLAY,<
	SETZ	P1,		;NOT GLOBAL SYMBOL
>
	PUSHJ	P,SY.CHL##	;DO LEFT HALF CHAINING
	JRST	T.10
SUBTTL	BLOCK TYPE 11 - POLISH FIXUPS (FAIL)


;	----------------
;	!   11 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! DATA !  DATA !
;	----------------

;THE POLISH FIXUP BLOCK IS STORED IN THE FX AREA
;THE ACTION IS :-
;(1)	READ AND RELOCATE THE FIXUPS
;	STORE THEM IN FX AREA
;(1A)	FIND THE STORE OPERATOR, AND DELETE THE FIXUP IF
;	NOT WANTED (DUE TO NON-LOADED LOCAL OR /ONLY).
;(2)	CHECK AND EVALUATE GLOBAL REQUESTS
;	STORE VALUES BACK IN FIXUP
;(3)	IF THERE ARE NO UNDEFINED GLOBAL REQUESTS
;	EVALUATE POLISH AND STORE
;(4)	IF THERE ARE UNDEFINED REQUESTS
;	LINK GLOBAL SYMBOL TO FIXUP AREA AND CONTINUE
;(5)	WHEN LAST UNDEFINED GLOBAL IS DEFINED
;	EVALUATE AND STORE
;(6)	IF STORE ADDRESS IS PAGED TO DSK
;	STORE BACK IN FIXUP AREA AND PROCESS AT END

;HERE TO SEE HOW MUCH MEMORY WE NEED FOR THE FIXUP BLOCK, AND TO ALLOCATE IT.

T.11:	HRRZI	T2,2(W1)	;WORD COUNT
	HRLZM	T2,T11FA	;STORE BLOCK SIZE
	PUSHJ	P,FX.GET##	;GET SPACE IN FX AREA
	SUB	T1,FX.LB	;RELATIVE
	.JDDT	LNKOLD,T.11,<<CAMN T1,$FIXUP##>>	;[632]
	MOVE	W2,T1		;SAFE PLACE FOR POINTER
	HRRM	T1,T11FA	;STORE STARTING ADDRESS
	MOVEI	W3,2(W2)	;BYTE POINTER TO START OF FIXUP
	HRLI	W3,(POINT 18)
	MOVEM	W3,T11BP	;STORE INITIAL BYTE POINTER
	SUBI	W3,1		;W3 ALSO POINTS TO GLOBAL COUNT
	HRLI	W1,(FP.SGN!FP.POL)	;[612] SET POLISH FIXUP BIT
	ADDI	W1,2		;ACCOUNT FOR OVERHEAD WORDS
	ADD	W2,FX.LB	;FIX IN CORE
	ADD	W3,FX.LB	;...
	MOVEM	W1,(W2)		;STORE HEADER WORD PLUS SYMBOLS
	SETZM	1(W2)		;CLEAR GLOBAL COUNT
	ADDI	W2,2		;BYPASS
	PUSH	P,RC.CUR	;SAVE CURRENT
	SETZ P4,		;STORE RELOC FOR THIS BLOCK HERE

;  ..
;  ..

;HERE TO READ IN AND COPY THE ENTIRE POLISH BLOCK INTO THE FX AREA, MAKING SOME
;BASIC CONSISTENCY CHECKS. THERE ARE SEVERAL MAJOR COMPLICATIONS HERE. IF PSECT
;INDEXES ARE USED ANYWHERE, THEN THERE MUST BE A PSECT INDEX AS THE FIRST
;HALFWORD TO SET THE POLISH BLOCK DEFAULT, AND THE PSECT USED FOR THE STORE
;OPERATOR. SUBSEQUENT PSECT INDEXES MAY ONLY OCCUR BEFORE THE VALUE OPERATORS
;(CODES 0 AND 1) TO WHICH THEY APPLY, AND THE INDEX ONLY APPLIES TO THAT VALUE.
;SINCE RB.1 RELOCATES ONLY FULLWORDS AT A TIME, WE DEPEND ON THE REQUIREMENT
;THAT A VALUE OPERATOR (NECESSARILY ABSOLUTE) FOLLOWS EACH PSECT INDEX. WE ALSO
;DEPEND ON THE REQUIREMENT THAT THE PSECT INDEX REVERTS BACK TO THE POLISH
;BLOCK'S DEFAULT AFTER EACH VALUE, AND THAT THE STORE OPERATOR IS ABSOLUTE. ALL
;OF THESE CONDITIONS ALLOW US TO SET THE RELOCATION COUNTER FOR THE NEXT POLISH
;WORD, BASED ON THE INFORMATION IN THE CURRENT WORD, WITHOUT MISSING ANY
;RELOCATABLE HALFWORDS.

;[2203] An additional complication is introduced by extended addressing.
;[2203] A halfword which is relocated can have a value of up to 30 bits.
;[2203] This will not fit back in the halfword allocated to the original
;[2203] 18 bit value.  The solution is to store the section number in the
;[2203] previous halfword, where the operator is.  This involves moving the
;[2203] operator information into the high order 6 bits of that halfword.
;[2203] The operators will be changed to a new form.  For the halfword fetch
;[2203] operator, the high order bits will be set to 60.  For store operators,
;[2203] the operator value will be negated. This value will be added to 60,
;[2203] and the result will be shifted into the high order six bits.

	MOVE	P2,T11BP	;[1224] BYTE POINTER WHICH WILL FIND STORE OP
	SETZ	P3,		;[1224] START BY READING THE FIRST HALFWORD
	PUSHJ	P,T11GN		;[1224]   ..
	  PUSHJ	P,E$$NSO	;[1224] NO STORE OPERATOR--CATCH-ALL MESSAGE
	CAILE	T1,MXPLOP	;[1224] IS THIS A PSECT INDEX?
	CAIL	T1,-STRLEN	;[1224]   ..
	JRST	T11RD2		;[1224] NO--ENTER MAIN LOOP
	MOVEI	P4,-400000(T1)	;[2207] YES--REMEMBER AS DEFAULT
	CAMLE	P4,RC.NO	;[1224] IS THE PSECT INDEX IN RANGE?
	PUSHJ	P,E$$IPX	;[1224] NO--DIE
	MOVE	R,P4		;[1304] GET PSECT NUMBER IN R
	HRRZ	P4,@RC.MAP	;[1304] MAP TO INTERNAL PSECT NUMBER
	MOVEM	P4,RC.CUR	;[1224] DEFAULT APPLIES TO FIRST VALUE OP, IF ANY
T.11RD:	PUSHJ	P,T11SGN	;[1224] GET NEXT HALFWORD
	  PUSHJ	P,E$$NSO	;[1224] NO MORE--FATAL HERE
T11RD2:	JUMPE	T1,T11OK1	;[1224] IF HALFWORD VALUE OP, EAT 1 HALFWORD
	CAIG	T1,2		;[1224] IF FULLWORD VALUE OP
	JRST	T11OK2		;[1224] THEN EAT 2 HALFWORDS
	CAIG	T1,MXPLOP	;[1224] REGULAR OPERATOR?
	JRST	T.11RD		;[1224] YES--JUST SKIP IT
	CAIL	T1,-STRLEN	;[1224] STORE OPERATOR THEN?
	JRST	T11SOP		;[1224] YES--GO READ SYMBOL OR ADDR; THIS IS LOOP EXIT
	MOVEI	T2,-400000(T1)	;[2207] NO--MUST BE PSECT INDEX
	SKIPE	P4		;[1224] ALLOWED TO USE PSECT INDEXES?
	CAMLE	T2,RC.NO	;[1224]   AND A GOOD INDEX IF SO?
	PUSHJ	P,E$$IPX	;[1224] NO--DIE
	MOVE	R,T2		;[1304] GET PSECT NUMBER IN R
	HRRZ	T2,@RC.MAP	;[1304] MAP TO INTERNAL PSECT NUMBER
	MOVEM	T2,RC.CUR	;[1245] YES--MAKE IT GOOD FOR NEXT OPERATOR
	JRST	T.11RD		;[1224] LOOP FOR MORE OPERATORS

T11OK2:	PUSHJ	P,T11SGN	;[1224] EAT FIRST HALF OF FULLWORD VALUE
	  PUSHJ	P,E$$NSO	;[1224] NOT THERE--DIE
	PUSHJ	P,T11SGN	;[2203] EAT SECOND HALFWORD
	  PUSHJ	P,E$$NSO	;[1224] NOT THERE--DIE
	MOVEM	P4,RC.CUR	;[1224] RESTORE DEFAULT PSECT INDEX SINCE VALUE DONE
	JRST	T.11RD		;[1224] LOOP FOR MORE OPERATORS
	

T11OK1:	PUSHJ	P,T11SGN	;[2203] Get the halfword value
	 PUSHJ	P,E$$NSO	;[2203] Not there--die
	MOVEM	P4,RC.CUR	;[2203] Restore the default psect index
	JUMPN	P3,T11OKL	;[2203] Check for which halfword

;[2203] Here on a right half. The fetch operator is in the left half of
;[2203] W1. Change it to the new style, and put in the section number.
	HLL	W1,LSTRRV	;[2203] Get it's section number
	TLO	W1,600000	;[2203] Remember it's a halfword new-style load
	JRST	T.11RD		;[2203] Loop for more operators

;[2203] Here on a left half. The fetch operator is in the right half of
;[2203] the previous word.  The current word is pointed to by W2. Change
;[2203] it to the new style, and put in the section number.

T11OKL:	HLR	T1,LSTLRV	;[2203] Get it's section number
	TRO	T1,600000	;[2203] Remember it's a halfword new-style load
	HRRM	T1,-1(W2)	;[2203] Put it in the previous word
	JRST	T.11RD		;[2203] Loop for more operators

E$$NSO::.ERR.	(MS,.EC,V%L,L%F,S%F,NSO,<No store operator in polish block (type 11 or 1072)>) ;[2212]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1224]
;HERE WHEN WE'VE FOUND THE STORE OPERATOR. IF IT'S AN ADDRESS, READ AND STORE
;IT. IF IT'S A SYMBOL STORE, THERE ARE POTENTIALLY TWO FULLWORDS FOR THE SYMBOL
;AND BLOCK NAME. MAKE SURE THAT IF WE GET THE FIRST HALF OF EITHER SYMBOL, WE
;GET THE SECOND HALF. ALSO THAT WE GET AT LEAST ONE SYMBOL. FINALLY, MAKE SURE
;THERE IS NO JUNK AT THE END OF THE REL BLOCK.

;[2203] change to the new-style store operator, so a 30 bit address will fit.
;[2203] Negate it, add 60, and shift it to the high six bits.

T11SOP:	MOVN	T2,T1		;[2203] GET THE STORE OPERATOR
	ADDI	T2,60		;[2203] PUT THE NUMBER IN THE RIGHT FORMAT
	LSH	T2,^D12		;[2203] PUT IT IN THE HIGH BITS
	SKIPE	P3		;[2203] CAME FROM THE LEFT HALF?
	 HRL	W1,T2		;[2203] YES, PUT IT BACK THERE
	SKIPN	P3		;[2203] CAME FROM THE RIGHT HALF?
	 HRR	W1,T2		;[2203] YES, PUT IT BACK THERE
	MOVE	P1,P2		;[1224] SAVE POINTER TO STORE OPERATOR
	CAIL	T1,-6		;[1224] SYMBOL STORE OPERATOR?
	CAILE	T1,-4		;[1224]   ..
	JRST	T11SOA		;[1224] NO--ADDRESS THEN
	PUSHJ	P,T11SGN	;[1224] YES--READ THE SYMBOL BEING FIXED UP
	  PUSHJ	P,E$$ISM	;[1224] THERE MUST BE AT LEAST ONE SYMBOL
	PUSHJ	P,T11SGN	;[1224]   ..
	  PUSHJ	P,E$$ISM	;[1224]   ..
	PUSHJ	P,T11SGN	;[1224] LOOK FOR THE BLOCK NAME SYMBOL
	  JRST	T.11CS		;[1224] NONE--THAT'S OK, AND WE'RE DONE
	PUSH	P,T1		;[1224] THERE'S SOMETHING--SEE IF MORE
	PUSHJ	P,T11SGN	;[1224]   ..
	  JRST	[POP P,T2		;[1224] WASN'T ANY MORE--MAKE SURE LAST
		 JUMPE T2,T.11CS	;[1224]   HALFWORD WAS ZERO; IF SO, WE'RE DONE
		 PUSHJ P,E$$ISM]	;[1224] ELSE IT WAS JUNK
	POP	P,(P)		;[1224] UNWIND STACK
	JRST	T11EAT		;[1224] GO CHECK FOR POSSIBLE LAST HALFWORD

T11SOA:	PUSHJ	P,T11SGN	;[1224] READ THE STORE ADDRESS
	  PUSHJ	P,E$$NAP	;[1224] THERE MUST BE ONE

	JUMPN	P3,T11SOL	;[2203] Check for which halfword

;[2203] Here on a right half. The store operator is in the left half of
;[2203] W1. The right half of LSTRRV contains the address (same as in W1)
;[2203] or zero. Put in the section number.
	IOR	W1,LSTRRV	;[2203] Put section into the store operator
	JRST	T11EAT		;[2203] Go check for possible last halfword

;[2203] Here on a left half. The fetch operator is in the right half of
;[2203] the previous word.  The current word is pointed to by W2. Put
;[2203] in the section number.

T11SOL:	HLRZ	T1,LSTLRV	;[2203] Get the section number
	IORM	T1,-1(W2)	;[2203] Put it in the previous word

;	JRST	T11EAT		;[1224] GO CHECK FOR POSSIBLE LAST HALFWORD

;HERE WHEN ENTIRE POLISH BLOCK HAS BEEN READ, BUT THERE IS STILL THE POSSIBLIITY
;THAT THERE IS A LAST DANGLING HALFWORD TO READ. THIS MUST BE ZERO, AND IT MUST
;BE THE LAST HALFWORD IN THE POLISH BLOCK, OR WE COMPLAIN ABOUT JUNK IN THE
;BLOCK.

T11EAT:	PUSHJ	P,T11SGN	;[1224] LOOK FOR POSSIBLE RHS HALFWORD
	  JRST	T.11CS		;[1224] NOT THERE--ALL'S WELL
	JUMPN	T1,E$$JPB	;[1224] MUST BE ZERO OR COMPLAIN ABOUT JUNK
	PUSHJ	P,T11ZGN	;[1224] WAS ZERO--MAKE SURE NO MORE AT ALL
	  JRST	T.11CS		;[1224] NONE--ALL'S WELL
E$$JPB::.ERR.	(MS,.EC,V%L,L%W,S%W,JPB,<Junk at end of polish block>) ;[1224] 
	.ETC.	(JMP,,,,,.ETIMF##) ;[1224] 
T11EA1:	PUSHJ	P,T11ZGN	;[1224] WE'VE COMPLAINED--EAT THE REST
	  JRST	T.11CS		;[1224] DONE
	JRST	T11EA1		;[1224] MORE--READ MORE JUNK


E$$IPX::.ERR.	(MS,.EC,V%L,L%F,S%F,IPX,<Invalid psect index>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

E$$ISM::.ERR.	(MS,.EC,V%L,L%F,S%F,ISM,<Incomplete symbol in store operator in polish block (type 11 or 1072)>) ;[2212]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1224]

E$$NAP::.ERR.	(MS,.EC,V%L,L%F,S%F,NAP,<No store address in polish block (type 11 or 1072)>) ;[2212]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1224]
;T11SGN - STORE POLISH HALFWORD AND GET NEXT ONE. THIS ROUTINE DE-BLOCKS THE
;FULL WORDS SUPPLIED BY RB.1 INTO HALFWORDS. P3 IS USED AS A FLAG TO TELL WHICH
;HALF OF THE CURRENT WORD TO RETURN, AND WHETHER IT'S TIME TO READ ANOTHER WORD.
;
;	P3/	0	AND CALL T11GN FOR FIRST BYTE
;
;THEN LEAVE P3 ALONE AND CALL T11SGN FOR SUBSEQUENT BYTES. GIVES SKIP RETURN
;UNLESS NO MORE HALFWORDS, THEN NON-SKIP RETURN.

T11SGN:	JUMPN	P3,T11GN1	;[1224] JUST PROCESSED RHS?
	MOVEM	W1,(W2)		;[1224] YES--STORE OLD WORD NOW
	ADDI	W2,1		;[1224] COUNT ANOTHER WORD STORED
T11GN:	JUMPN	P3,T11GN1	;[1224] TIME TO READ A NEW WORD?
	PUSHJ	P,RB.1		;[1224] YES--GET ONE
	  POPJ	P,		;[1224] NO MORE--GIVE NON-SKIP RETURN
	HLRZ	T1,W1		;[1224] FIRST TIME GIVE LHS
	MOVEI	P3,1		;[1224] SIGNAL RHS FOR NEXT TIME
	IBP	P2		;[1224] COUNT ANOTHER BYTE
	JRST	CPOPJ1		;[1224] GIVE GOOD RETURN

T11GN1:	HRRZ	T1,W1		;[1224] TIME FOR RHS
	MOVEI	P3,0		;[1224] SIGNAL LHS FOR NEXT TIME
	IBP	P2		;[1224] COUNT ANOTHER BYTE
	JRST	CPOPJ1		;[1224] GIVE GOOD RETURN

;T11ZGN HAS THE SAME EFFECT AS T11SGN, EXCEPT THAT THE HALFWORD JUST PROCESSED
;IS ZEROED INSTEAD OF STORED IN THE FIXUP AREA. THIS IS ONLY USED TO CLEAN UP
;JUNK AT THE END OF A POLISH BLOCK, SO THERE IS NO NEED FOR SPEED.

T11ZGN:	JUMPN	P3,T11ZG1	;[1224] JUST PROCESSED RHS?
	HLLZS	W1		;[1224] YES--THEN CLEAR IT
	PJRST	T11SGN		;[1224] GO DO OTHER CHECKS

T11ZG1:	HLLZS	W1		;[1224] JUST PROCESSED LHS--CLEAR IT
	PJRST	T11GN		;[1224] WON'T STORE THIS TIME
;HERE WHEN POLISH BLOCK HAS BEEN READ. WE MUST NOW LOOK MORE CLOSELY AT THE
;STORE OPERATOR TO SEE IF WE WANT THIS POLISH EXPRESSION. IF NOT, DELETE THE
;POLISH BLOCK AND RETURN. IF SO, SEE IF THE STORE IS TO A SYMBOL, AND CONVERT TO
;LSTSYM POINTER FORMAT (GLOBAL,,LOCAL) IF SO.
;
;	P1/	BYTE POINTER TO STORE OPERATOR (LDB, NOT ILDB)
;	W3/	BYTE POINTER TO GLOBAL COUNT, FOR FX AREA LATER
;	(P)/	SAVED RELOCATION COUNTER FROM BEGINNING OF T.11

T.11CS:	POP	P,RC.CUR	;[1224] RESTORE RELOCATION COUNTER
	MOVE	W1,P1		;[1224] GET BYTE POINTER TO STORE OPERATOR
	ADD	W1,FX.LB	;[1224] RELOCATE TO FX AREA
	LDB	T1,W1		;[1224] GET BACK THE STORE OPERATOR
	CAIG	T1,667777	;[2203] SYMBOL STORE OPERATOR?
	CAIGE	T1,640000		;[2203]   ..
	JRST	[ILDB	W1,W1		;NO, LOAD UP ADDRESS
		 TRZ	T1,770000	;[2203] GET THE SECTION NUMBER ONLY
		 HRL	W1,T1		;[2203] PUT IT IN THE ADDRESS
		TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
		PUSHJ	P,CHKSEG	;YES, SEE IF WE NEED IT
		  JRST	T.11GC		;[633] YES WE DO
		PUSHJ	P,T.11RT	;NO, RETURN BLOCK
		JRST	LOAD##]		;AND GIVE UP

;HERE IF THE STORE OPERATOR IS A VALID SYMBOL FIXUP. THERE ARE AT MOST TWO
;SYMBOLS FOLLOWING. THE FIRST IS THE SYMBOL TO BE FIXED UP, AND THE SECOND (IF
;THERE) IS THE BLOCK NAME IT'S IN.

	LSH	T1,-^D12	;[2203] GET BACK THE STORE OPERATOR
	SUBI	T1,63		;[2203] GET THE SYMBOL FIXUP TYPE
	MOVE	T1, [	FS.FXR		;[2203] 3 RIGHT HALF
			FS.FXL		;[2203] 4 LEFT HALF
			FS.FXF](T1)	;[2203] 5 RIGHT HALF
	PUSH	P,T1		;[2203] SAVE THE TYPE FOR SY.RQS
	ILDB	T1,W1		;YES, GET LEFT PART
	ILDB	W2,W1		;GET RIGHT
	HRL	W2,T1		;FULL SYMBOL
	EXCH	W1,0(P)		;[612] RESTORE FIXUP TYPE, SAVE BP
	EXCH	W2,W3		;PUT SYMBOL IN W3
	PUSHJ	P,SY.RQS	;[612] SEE IF WE WANT THIS SYMBOL
	  JRST	[POP	P,W1		;[612] NO, NON LOADED LOCAL
		PUSHJ	P,T.11RT	;[612]   SO CLEAN UP FX
		JRST	LOAD##]		;[612]   AND RETURN
	POP	P,W1		;[612] RESTORE BYTE PTR TO POLISH
	MOVE	W3,W2		;[2255] BYTE POINTER IN W3
	SUBI	W1,2		;BACKUP BYTE PTR
	IBP	W1		;[2255] BY 3 HALFWORDS
	ILDB	W2,W1		;[2255] GET THE STORE OPERATOR
	HLRZ	T1,LSTLCL	;[2255] GET THE LOCAL POINTER SECTION NUMBER
	ADD	T1,W2		;[2255] ADD THE STORE OPERATOR
	DPB	T1,W1		;[2255] PUT IT BACK
	HRRZ	W2,LSTLCL	;[2255] GET THE REST OF THE LOCAL POINTER
	IDPB	W2,W1		;[2255] STORE IT NEXT
	MOVE	W2,LSTGBL	;[2255] GET THE GLOBAL POINTER
	IDPB	W2,W1		;[2255] STORE IT TOO
	ILDB	T1,W1		;GET LEFT PART
	ILDB	W2,W1		;GET RIGHT
	HRL	W2,T1		;FULL SYMBOL
	SKIPE	W2		;ALWAYS 0 IF MACRO-51
	PUSHJ	P,R50T6		;CONVERT NOW
	SUBI	W1,1		;BACKUP BYTE PTR
	HLRZ	T1,W2		;LEFT HALF
	IDPB	T1,W1
	IDPB	W2,W1		;RIGHT HALF

;FALL THROUGH TO NEXT PAGE
;HERE TO COUNT AND EVALUATE GLOBAL REQUESTS

T.11GC:	MOVE	W1,T11BP	;RESET BYTE POINTER
	ADD	W1,FX.LB	;FIX IN CORE
	JRST	T.11G1		;BYPASS FIRST TIME

T.11G0:	IBP	W1		;BYPASS NEXT HALF WORD
T.11G1:	ILDB	T1,W1		;READ HALF WORD
	CAIL	T1,MXPLOP	;[633] CHECK FOR VALID OPS
	JRST	[CAIGE	T1,600000 ;[2203] NEW FETCH OR STORE OP?
		  JRST	T.11G1	  ;[2203] NO, MUST BE PSECT INDEX
		 CAIL	T1,610000 ;[2203] NEW STYLE STORE OPERATOR?
		  JRST	T.11GE	  ;[2203] YES, GO TRY TO EVALUATE
		 JRST	T.11G0]	  ;[2203] HALFWORD FETCH, IGNORE VALUE
	CAIL	T1,3		;IF OPERATOR
	JRST	T.11G1		;IGNORE IT
	CAIN	T1,1		;36 BIT VALUE?
	AOJA	W1,T.11G1	;YES, GET NEXT HALF WORD AFTER IT
;HERE IF T1=2, GLOBAL SYMBOL REQUEST
	ILDB	T1,W1		;GET FIRST PART OF SYMBOL
	ILDB	W2,W1		;GET RIGHT HALF PART
	HRL	W2,T1		;FULL SYMBOL IN W2
	PUSHJ	P,R50T6		;CONVERT TO SIXBIT IN W2
	SUB	W1,FX.LB	;INCASE IT MOVES
	SUB	W3,FX.LB	;DITTO
	PUSH	P,W1		;SAVE BYTE POINTER
	MOVX	W1,PT.SGN!PT.SYM	;SET SOME VALID FLAGS
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED
	  JRST	T.11ND		;NO, NEED TO DEFINE IT
	  JRST	T.11UN		;UNDF, SO JUST AS BAD
	POP	P,W1		;RESTORE BYTE POINTER
	ADD	W1,FX.LB	;ADD CORE OFFSET
	ADD	W3,FX.LB
	SUBI	W1,2		;BACKUP BYTE POINTER
	IBP	W1		;TO POINT TO 2
	MOVEI	T1,1		;CHANGE GLOBAL MARKER INTO 36 BIT VALUE MARKER
	IDPB	T1,W1
	MOVS	T1,2(P1)	;GET VALUE
T.11G2:	IDPB	T1,W1		;STORE IT
	MOVSS	T1
	IDPB	T1,W1		;W1 BACK AS IT WAS
	JRST	T.11G1		;GET NEXT HALF WORD

T.11GE:	SKIPN	(W3)		;[633] ANY UNDEFINED GLOBALS?
	PUSHJ	P,T.11EV	;[633] NO, EVALUATE FIXUP NOW
	JRST	LOAD##		;[633] ELSE WAIT TILL ALL DEFINED
;HERE IF GLOBAL SYMBOL NOT IN GLOBAL SYMBOL TABLE YET
;TREAT AS IF ADDITIVE GLOBAL REQUEST
;GET EXTENDED TRIPLET AND POINT TO FIXUP TRIPLET IN FIXUP AREA
;INTURN THIS TRIPLET POINTS TO THE POLISH FIXUP
;NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;STUFF, THEY MUST BE SAVED

T.11ND:	AOS	USYM		;INCREMENT UNDEF COUNT
	PUSH	P,W2		;SAVE ACCS
	PUSH	P,W3
	TXO	W1,PS.REQ	;USUAL FLAGS
	PUSH	P,W1		;SAVE PRIMARY FLAGS
	PUSH	P,[0]		;ZERO VALUE
	MOVX	W1,S.FXP	;[612] SECONDARY SYMBOL FLAG
	PUSHJ	P,GS.FX0##	;PUT IN GLOBAL TABLE
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR!FP.POL
	HRRZ	W3,T11FA	;ADDRESS (RELATIVE TO FX.LB) OF POLISH
	PUSHJ	P,SY.FX0##	;NOW PUT INTO  FIXUP TABLE
	PUSHJ	P,SY.GX0##	;LINK TO GLOBAL
T.11GD:	POP	P,W3
	POP	P,W2
	POP	P,W1
	ADD	W1,FX.LB	;RELOCATE AGAIN
	ADD	W3,FX.LB	;...
	AOS	(W3)		;BUMP COUNT OF UNDEFINED SYMBOLS
	MOVS	T1,W2		;PUT SYMBOL IN T1 SWAPPED
	SOJA	W1,T.11G2	;BACKUP BYTE POINTER AND STORE AS SIXBIT
				;OVERWRITING THE RADIX-50
;HERE TO SEE IF FIXUP REQUESTS EXIST FOR THIS  SYMBOL
;IF SO ADD TO CHAIN, IF NOT CREATE CHAINED LIST IN EXTENDED SYMBOL
T.11UN:	PUSH	P,W2		;SAVE ACCS
	PUSH	P,W3
	MOVE	W1,0(P1)	;FLAGS GO IN W1 NOW
	TXNE	W1,PS.FXP	;ALREADY FIXUPS DEFERED?
	JRST	T.11DF		;YES, JUST LINK TO CHAIN
	MOVEI	T1,.L		;[612] NEED ANOTHER TRIPLET
	PUSHJ	P,SY.MOV##	;[612] SO STRETCH CURRENT ONE
	MOVX	W1,PS.FXP	;[612] WE NOW HAVE A FIXUP TRIPLET
	IORM	W1,0(P1)	;[612] SO MARK IT
	SUB	T1,GS.LB	;[612] GET REL. ADDR OF NEW TRIPLET
	PUSH	P,T1		;[612] SAVE IT
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR!FP.POL	;[612] PTR TO POLISH
	HRRZ	W3,T11FA	;[612] TO TRY AGAIN WHEN SYMS DEFINED
	PUSHJ	P,SY.FX0##	;[612] PUT W1-W3 IN FX AREA
	POP	P,T1		;[612] RESTORE POINTER INTO GS
	ADD	T1,GS.LB	;[612] MAKE ABSOLUTE AGAIN
	MOVX	W1,S.FXP!S.LST	;[612] POINTER TO FIXUP CHAIN
	TMOVEM	W1,0(T1)	;[612] STORE IN NEW TRIPLET
	JRST	T.11GD		;[612] RETURN TO SCAN REST OF POLISH


;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN

T.11DF:	ADDI	P1,.L		;LOOK FOR ADDITIVE  GLOBAL REQUEST
	SKIPG	W1,0(P1)	;GET SECONDARY FLAGS
	JRST	E$$ISP##	;[1174] PRIMARY OR NO FLAGS SET
	TXNN	W1,S.FXP	;IS THIS THE ONE
	JRST	T.11DF		;NO TRY AGAIN
	SKIPN	W1,2(P1)	;GET POINTER, BETTER BE NON-ZERO
	JRST	E$$ISP##	;[1174]
	HRLI	W1,(FP.SGN!FP.SYM!FP.PTR!FP.POL)
	HRRZ	W3,T11FA	;POINT TO POLISH
	SUB	P1,NAMLOC	;INCASE CORE MOVES
	PUSH	P,P1		;SAVE UNRELOCATED POINTER
	PUSHJ	P,SY.FX0##	;PUT IN FIXUP AREA
	POP	P,P1		;RESTORE POINTER
	ADD	P1,NAMLOC	;RELOCATE IT
	HRRM	W3,2(P1)	;FIXUP REQUEST POINTER CHAIN
	JRST	T.11GD		;GET NEXT HALF-WORD
;HERE TO EVALUATE POLISH FIXUP
T.11EV::SKIPN	W3,POLSTK	;GET STACK POINTER
	PUSHJ	P,T.11PD	;NOT SETUP YET
	MOVEI	T3,100		;INCASE OF ON OPERATOR
	MOVEM	T3,SVSAT
	PUSH	W3,[MXPLOP]	;FAKE OPERATOR
	MOVE	W2,T11BP	;SETUP READ BYTE POINTER
IFN DEBSW,<
	MOVEI	W1,-2(W2)	;[632] POINT TO 1ST WORD OF BLOCK
> ;END IFN DEBSW
	.JDDT	LNKOLD,T.11EV,<<CAMN W1,$FIXUP##>>	;[632]
	ADD	W2,FX.LB	;FIX IN CORE
T.11RP:	ILDB	W1,W2		;READ A HALF-WORD
	CAIL	W1,610000	;[2203] STORE OPERATOR?
	JRST	T.11ST		;YES
	CAIL	W1,600000	;[2203] HALFWORD FETCH?
	JRST	T.11OP		;[2203] YES, IT'S AN OPERAND
	CAIL	W1,400000	;PSECT INFO?
	JRST	T.11RP		;YES, JUST IGNORE
	CAIGE	W1,2		;0,1,2 ARE OPERANDS
	JRST	T.11OP
	CAIE	W1,2		;2 IS ILLEGAL AT THIS POINT
	CAILE	W1,MXPLOP-1	;IS OPERATOR IN RANGE
	JRST	E$$IPO		;[1174]
	AOBJN	W3,.+2		;[1274] CHECK FOR OVERFLOW
	PUSHJ	P,T.11PL	;[1274] OVERFLOW-GO ENLARGE STACK
	MOVEM	W1,(W3)		;[1274] SAVE OPERATOR ON STACK
	MOVE	T3,DESTB-3(W1)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM	T3,SVSAT	;ALSO SAVE IT
	JRST	T.11RP		;BACK FOR MORE

T.11PD::MOVEI	T2,LN.PPD	;[2212] SIZE REQUIRED
	MOVEM	T2,POLLEN	;[1274] STORE SIZE
	PUSHJ	P,DY.GET##	;GET SPACE FOR STACK
	MOVEM	T1,POLSTK	;START OF STACK
	MOVEI	W3,-1(T1)	;FORM PUSHDOWN STACK IN W3
	HRLI	W3,-LN.PPD	;FORM STACK POINTER
	MOVEM	W3,POLSTK	;STORE FOR NEXT TIME
	POPJ	P,

T.11PL::PUSH	P,T1		;[2212] SAVE THE TEMPORARY REGS
	PUSH	P,T2		;[1274]
	PUSH	P,T3		;[1274]
	MOVE	T2,POLLEN	;[1274] GET SIZE OF CURRENT STACK
	ADDI	T2,LN.PPD	;[1274] FIGURE SIZE OF NEW STACK
	PUSHJ	P,DY.GET##	;[1274] GET NEW STACK FROM DY AREA
	MOVN	T3,T2		;[1274] MINUS NEW STACK LENGTH
	HRLI	T3,-1(T1)	;[1274] ADDR,,-LEN OF NEW STACK
	EXCH	T2,POLLEN	;[1274] STORE NEW STACK LENGTH	
	MOVEI	W3,-1(T1)	;[1274] BUILD NEW STACK POINTER
	ADDI	W3,(T2)		;[1274] ADD POINTER TO LAST ITEM PUSHED
	HRLI	W3,-LN.PPD	;[1274] SET TO REMAINING STACK SPACE
	AOS	POLSTK		;[1274] POLSTK WAS AN IOWD
	HRL	T1,POLSTK	;[1274] FORM BLT POINTER
	BLT	T1,-1(W3)	;[1274] MOVE STACK TO NEW AREA
	HRRZ	T1,POLSTK	;[1274] GET ADDRESS OF OLD STACK AREA
	MOVSM	T3,POLSTK	;[1274] STORE -LEN,,ADDR OF STACK
	PUSHJ	P,DY.RET##	;[1274] GIVE BACK OLD STACK
	POP	P,T3		;[1274] POP THE TEMPORARY REGISTERS
	POP	P,T2		;[1274]
	POP	P,T1		;[1274]
	POPJ	P,		;[1274] GO COMPLETE THE "PUSH"


E$$IPO::.ERR.	(MS,.EC,V%L,L%F,S%F,IPO,<Invalid polish operator >) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,W1) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HANDLE OPERANDS

T.11OP:	MOVE	T1,W1		;GET THE OPERAND TYPE HERE
	ILDB	W1,W2		;THIS IS AT LEAST PART OF THE OPERAND
	MOVE	T2,W1
	CAIE	T1,1		;[2203] FULLWORD OPERAND?
	 JRST	[ TRZ T1,770000 ;[2203] NO, HALFWORD - GET ONLY THE SECTION
		  HRL T2,T1	;[2203] PUT IT INTO THE VALUE
		  JRST T.11P0]	;[2203] DON'T READ ANOTHER HALFWORD
	ILDB	W1,W2		;NEED FULL WORD GET 2ND HALF
	HRL	T2,W1		;GET IN RIGHT ACC
	MOVS	T2,T2		;WRONG ORDER
T.11P0:	SETZ	T1,		;VALUE OPERAND
T.11P1:	SOJL	T3,T.11ES	;ENOUGH OPERANDS SEEN
	AOBJN	W3,.+2		;[1274] CHECK FOR OVERFLOW
	PUSHJ	P,T.11PL	;[1274] OVERFLOW-GO ENLARGE STACK
	MOVEM	T2,(W3)		;[1274] SAVE VALUE
	HRLI	T1,400000	;PUT IN A VALUE MARKER
	AOBJN	W3,.+2		;[1274] CHECK FOR OVERFLOW
	PUSHJ	P,T.11PL	;[1274] OVERFLOW-GO ENLARGE STACK
	MOVEM	T1,(W3)		;[1274] SAVE VALUE MARKER
	JRST	T.11RP		;GET MORE POLISH

;HERE WHEN WE HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR

T.11ES:	SKIPN	SVSAT		;IS IT UNARY
	JRST	T.11UO		;YES, NO NEED FOR 2ND OPERAND
	POP	W3,T1		;POP OFF MARKER
	POP	W3,T1		;AND VALUE
T.11UO:	POP	W3,T3		;OPERATOR
	XCT	OPTAB-3(T3)	;BOTH VALUES JUST XCT
	MOVE	T2,T1		;GET THE CURRENT VALUE
	SKIPG	T3,(W3)		;IS THERE A VALUE  IN THE STACK?
	MOVE	T3,-2(W3)	;YES, THIS MUST BE THE OPERATOR
	MOVE	T3,DESTB-3(T3)	;GET NUMBER OF OPERANDS NEEDED
	MOVEM	T3,SVSAT	;SAVE IT HERE
	SKIPG	(W3)		;WAS THERE AN OPERAND
	SUBI	T3,1		;HAVE ONE OPERAND ALREADY
	JRST	T.11P1		;GO SEE WHAT WE SHOULD DO NOW


;NUMBER OF OPERANDS FOR EACH OPERATOR (LESS 1)
DESTB::	EXP	1,1,1,1,1,1,1,1,0,0,0,1,0,1,1,1,1,1,1,0,0 ;[2203]
;OPERATOR ACTION
OPTAB::	ADD	T1,T2		;[1754]
	SUB	T1,T2
	IMUL	T1,T2
	IDIV	T1,T2
	AND	T1,T2
	IOR	T1,T2
	LSH	T1,(T2)
	XOR	T1,T2
	SETCM	T1,T2
	MOVN	T1,T2
	PUSHJ	P,JFFOOP
	PUSHJ	P,REMOP
	MOVM	T1,T2
	PUSHJ	P,MAXOP	;[736] 20
	PUSHJ	P,MINOP	;[736] 21
	PUSHJ	P,EQOP	;[736] 22
	PUSHJ	P,LNKOP	;[736] 23
	PUSHJ	P,DEFOP	;[736] 24
	PUSHJ	P,SKPOP	;25
	PUSHJ	P,SKEOP	;26
	PUSHJ	P,MOVOP	;27
MXPLOP==:.-OPTAB+3		;[1754] 1 MORE THAN LARGEST LEGAL OPERATOR NUMBER

;JFFO OP (^L)
JFFOOP:	JFFO	T2,.+2		;COUNT LEADING BIT
	MOVEI	T3,^D36		;FULL WORD OF ZEROS
	MOVE	T1,T3		;PUT ANSWER IN T1
	POPJ	P,

;REMAINDER OPERATOR
REMOP:	IDIV	T1,T2		;DIVIDE
	MOVE	T1,T2		;PUT REMAINDER IN T1
	POPJ	P,

MAXOP:	CAMGE	T1,T2		;[736] 
	 MOVE	T1,T2
	POPJ	P,

MINOP:	CAMLE	T1,T2
	MOVE	T1,T2
	POPJ	P,

EQOP:	CAME	T1,T2
	 TDZA	T1,T1
	SETO	T1,
	POPJ	P,
LNKOP:	PUSH	P,W2		;SAVE AC
	HRREI	W2,(T2)		;LINK #
	MOVE	T2,LINKTB	;[2273] GET THE TABLE ADDRESS
	JUMPGE	W2,.+2		;[2273] NEGATIVE (LNKEND)?
	ADDI	T2,LN.12	;[2273] YES, COMES FROM SECOND HALF OF TABLE
	MOVMS	W2
	SOJL	W2,.+2		;[2273]
	CAIL	W2,LN.12	;[2273]
	 AOJA	W2,E01IPO	;[2273] RANGE CHECK
	SKIPE	T1,LINKTB	;IF LINKTB NOT SET UP THEN LINK IS ZERO
	MOVE	T1,@T2		;[2273] STORE IT
	POP	P,W2		;RETRIEVE AC
	POPJ	P,

DEFOP:			;DEFINITION STATUS
	PUSH	P,W2		;SAVE AC
	MOVE	W2,T2		;RADIX50
	PUSHJ	P,R50T6		;SIXBITIZE
	MOVX	W1,PT.SGN!PT.SYM	;SOME VALID BITS
	PUSHJ	P,TRYSYM##	;LOOK IT UP
	 JRST	[SETZ	T1,	;TOTALLY UNKNOWN
		JRST	.+3]
	 SKIPA	T1,[1]		;KNOWN BUT UNDEFINED
	SETO	T1,		;KNOWN AND DEFINED
	POP	P,W2		;AC BACK
	POPJ	P,

SKPOP:			;SKIP T2 HALF WORDS OF POLISH IF T1 NEQ 0, RETURN 0
	TDZN	T1,T1
	 POPJ	P,
	JUMPL	T2,SKPOP1	;IF BACKWARDS SKIP
	JRST	.+2
	IBP	W2		;SKIP HALF WORD
	SOJGE	T2,.-1		;UNTIL DONE
	POPJ	P,

SKPOP1:	MOVM	T2,T2		;HOW MANY HALF WORDS
	TRNE	T2,1		;IF ODD
	 IBP	W2		;THEN INCREMENT ONCE
	ADDI	T2,1		;NOW FOR PAIRS OF HALF WORDS
	LSH	T2,-1
	SUBI	W2,(T2)
	POPJ	P,
SKEOP:	MOVE	T1,T2		;OPERAND INTO RIGHT REG
	TDZN	T1,T1		;IF T1=0
	 POPJ	P,		;THEN QUIT, RETURN 0
SKELUP:	PUSHJ	P,D.IN1##	;READ ONE WORD
	HLRZ	T1,W1		;BLOCK TYPE
	CAIE	T1,5		;END?
	 JRST	SKEDIS		;NO, DISCARD
	MOVNI	WC,400000(W1)	;CONTROL WORD
	POP	P,(P)	;JUNK RETURN WORD
	JRST	T.0C		;IGNORE REST OF BLOCK AND JRST LOAD##
SKEDIS:	CAILE	T1,377		;OLD TYPE?
	 JRST	SKENEW		;NO
	MOVEI	T1,(W1)		;WORD COUNT
	JUMPE	T1,SKELUP		;NULL WORD
	CAIG	T1,22		;ONE SUBBLOCK?
	 AOJA	T1,SKE.1	;YES, COUNT ITS RELOC BITS
	IDIVI	T1,22		;WHOLE BLOCKS
	IMULI	T1,23		;WORDS IN WHOLE BLOCKS
	JUMPE	T2,.+2		;IF NO REMAINDER
	ADDI	T1,1(T2)	;PARTIAL BLOCK HAS RELOC BITS
SKE.1:	CAML	T1,DCBUF+2	;ENOUGH IN BUFFER?
	 SOJA	T1,SKE.2	;NO, BUT WAS ILDB'ED
	ADDM	T1,DCBUF+1	;ADVANCE BYTE POINTER
	MOVN	T1,T1
	ADDM	T1,DCBUF+2	;DECR COUNT
	JRST	SKELUP
SKE.2:	SUB	T1,DCBUF+2	;HAD THIS MANY
	PUSHJ	P,D.INP##	;NEW BUFFER
	JRST	SKE.1		;TRY AGAIN
SKENEW:	CAIG	T1,3777	;TEST RANGE FOR NEW BLOCK TYPES
	CAIGE	T1,1000
	 JRST	.+2		;OK
	 JRST	E$$RBS		;[1174]
	MOVEI	T1,(W1)		;NUMBER OF WORDS TO SKIP
	JRST	SKE.1

MOVOP:	MOVE	P3,T2		;[2203] Get the address
	PUSHJ	P,SGCHK.##	;[2203] Bring it into memory, relocate
	MOVE	T1,(P3)		;[2203] Get the word
	POPJ	P,
;HERE TO STORE THE FINAL VALUE

T.11ST:	MOVE	T2,-2(W3)	;THIS SHOULD BE THE FAKE OPERATOR
	CAIE	T2,MXPLOP	;IS IT
	JRST	E01IPO		;[1174] NO
	ILDB	T2,W2		;[572]  GET CORE ADDR OR GS POINTER
	HRL	T2,W1		;[2203] GET THE SECTION (IGNORED FOR SYMBOLS)
	TLZ	T2,770000	;[2203] REMOVE HIGH ORDER BITS
	LSH	W1,-^D12	;[2203] GET THE STORE OPERATOR (+60)
	MOVE	W3,-1(W3)	;GET THE VALUE AFTER IGNORING THE FLAG
	PUSHJ	P,@STRTAB-60(W1) ;[2203] CALL THE CORRECT FIXUP ROUTINE
				;ALL DONE, NOW GIVE SPACE BACK
T.11RT::HRRZ	T1,T11FA	;[2212] START OF FIXUP AREA
	ADD	T1,FX.LB	;IN REAL CORE
	HLRZ	T2,T11FA	;LENGTH OF AREA
	PUSHJ	P,FX.RET##	;RETURN FIXUP BLOCK
	SETZM	T11FA		;AND CLEAR MARKER
	SETZM	T11BP		;BYTE POINTER ALSO
	POPJ	P,		;RETURN TO GET NEXT BLOCK

;STORE OPERATOR ACTION TABLE
STRTAB:				;[735]
	CPOPJ			;[2203]  0  NO-OP
	T11CHR			;[2203]  1 RIGHT HALF FIXUP CHAIN
	T11CHL			;[2203]  2 LEFT HALF FIXUP CHAIN
;**;[2324] Change 1 line at STRTAB+4.  PAH 16-Jul-84 
	T11CHF			;[2324]  3 FULL WORD FIXUP CHAIN
	T11SYR			;[2203]  4 RIGHT HALF SYMBOL FIXUP
	T11SYL			;[2203]  5 LEFT HALF SYMBOL FIXUP
	T11SYF			;[2203]  6 FULL WORD SYMBOL FIXUP
	T11MVM			;[2203]  7 MOVEM
	T11LNK			;[2203] 10 STORE LINK OR LINK END
;[2203] Note - The maximum length of this table is 20 octal.  If
;[2203] it is desired to increase beyond 17, the base of the new
;[2203] style store and halfword fetch operators much be moved down
;[2203] from 60.  The lower limit is caused by the psect indices,
;[2203] which go up from 40.  If the base is changed here, it must
;[2203] also be changed in SYPF2 in LNKLOD.
STRLEN== .-STRTAB-1		;[735] LENGTH OF STORE OP TABLE

E01IPO::.ERR.	(MS,.EC,V%L,L%F,S%F,IPO) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,T2) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HERE TO DISPATCH FOR SYMBOL TABLE FIXUPS

;T2 = ADDRESS OF SYMBOL IN GLOBAL TABLE
;W3 = VALUE
;USES
;W1 = FIXUP FLAGS

T11SYR::MOVX	W1,FS.FXR	;[1754]
	JRST	SY.ASP		;AND DO FIXUP

T11SYL::MOVX	W1,FS.FXL	;[1754]
	JRST	SY.ASP

T11SYF::MOVX	W1,FS.FXF	;[1754]
;	JRST	SY.ASP		;

;HERE TO STORE SYMBOL TABLE FIXUP
SY.ASP::ILDB	T1,W2		;[2212] PICK UP GLOBAL POINTER
	PUSH	P,T1		;[572] SAVE OVER GS.GET
	PUSH	P,T2		;[2255] SAVE LOCAL POINTER TOO
	MOVEI	T2,.L		;[572] SET UP FAKE DEFINING TRIPLET
	PUSHJ	P,GS.GET##	;[572]   IN GS AREA SO CAN USE SY.STF
	MOVE	P1,T1		;[572] P1=ADDR OF FAKE DEFINING TRIPLET
	MOVX	T1,PT.SGN!PT.SYM!PS.GLB	;[572] SOME GOOD FLAGS
	MOVEM	T1,0(P1)	;[572] SET IN TRIPLET
				;[572] LEAVE NAME BLANK TO CATCH ERRORS
	MOVEM	W3,2(P1)	;[572] STORE POLISH RESULT AS VALUE
	POP	P,W3		;[572] W1=FLAGS, W3=LOCAL SYMBOL PTR
	POP	P,W2		;[2255] W2=GLOBAL SYMBOL PTR, P1=DEF. TRPLET
	PUSHJ	P,SY.STF##	;[572] DO ALL NECESSARY SYMBOL FIXUPS
	MOVE	T1,P1		;[572] NOW RETURN FAKE BLOCK
	MOVEI	T2,.L		;[572] T1=ADDR, T2=LENGTH
	PJRST	GS.RET##	;[572] FREE IT UP AND RETURN
T11LNK:
	PUSH	P,T2
	SKIPN	LINKTB		;[2203] LINK TABLE SETUP ?
	PUSHJ	P,T12GET	;SET UP LINK TABLE
	POP	P,W2		;SPECIAL AC
	HRRES	W2		;SIGN EXTEND
	MOVE	T2,LINKTB	;[2273] GET THE TABLE ADDRESS
	JUMPGE	W2,.+2		;[2273] NEGATIVE (LNKEND)?
	ADDI	T2,LN.12	;[2273] YES, GOES IN SECOND HALF OF TABLE
	MOVMS	W2
	SOJL	W2,.+2
	CAIL	W2,LN.12
	 AOJA	W2,E01IPO	;[1174] RANGE CHECK
	MOVEM	W3,@T2		;[2273] STORE IT
	POPJ	P,

T11MVM:	PUSH	P,W3		;MOVEM W3,(T2)
				;ADDR IN T2 LAREADY
	PUSHJ	P,SEGCHK##	;SEE IF IN CORE
	 JRST	T.11N		;NOT
	POP	P,W3		;RETIREVE VALUE
	MOVEM	W3,(T2)
	POPJ	P,
T.11N:	TXO	T2,CPF.RF	;[2201] NOT IN CORE
	POP	P,W3		;VALUE
	PJRST	SY.CHP##	;PUT IN FIXUP LIST

;[1502] Here to preserve W2 over calls to the halfword chain routines,
;[1502] which would like it to contain a SIXBIT name to display if a
;[1502] value is being truncated.
T11CHR::PUSH	P,W2		;[2212] Save pointer to polish
	SETZ	W2,		;[1502] Clear it so that it doesn't
				;[1502] look like a symbol for %LNKFTH
;**;[2324] Add two lines at T11CHR+3.  PAH 16-Jul-84
	SETZ	P1,		;[2324] Clear leftover pointer so P1
				;[2324] isn't treated as a fixup pointer
	PUSHJ	P,SY.CHR##	;[1502] Do the right half chained fixup
	POP	P,W2		;[1502]	Restore the pointer to the string
	POPJ	P,		;[1502]	Return to the dispatcher
T11CHL::PUSH	P,W2		;[2212] Save pointer to polish
	SETZ	W2,		;[1502] Clear it so that it doesn't
				;[1502] look like a symbol for %LNKFTH
;**;[2324] Add two lines at T11CHL+3.  PAH 14-Jul-84
	SETZ	P1,		;[2324] Clear leftover pointer so P1
				;[2324] isn't treated as a fixup pointer
	PUSHJ	P,SY.CHL##	;[1502] Do the left half chained fixup
	POP	P,W2		;[1502]	Restore the pointer to the string
	POPJ	P,		;[1502]	Return to the dispatcher

;**;[2324] Add 7 lines at T11CHL+7.  PAH 14-Jul-84
;[2324] Here to clear P1 before going to the fullword chained fixup
;[2324] routine -- that routine calls others which interpret a nonzero
;[2324] value in P1 as a fixup block pointer.
T11CHF::SETZ	P1,		;[2324] Clear leftover pointer so P1
				;[2324] isn't treated as a fixup pointer
	PUSHJ	P,SY.CHF##	;[2324] Do the fullword chained fixup
	POPJ	P,		;[2324] And return to the dispatcher
SUBTTL	BLOCK TYPE 12 - LINK (FAIL)


;	----------------
;	!   12 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! DATA   WORDS !
;	----------------

T.12:	SKIPN	LINKTB		;[2203] LINK TABLE SETUP ?
	PUSHJ	P,T12GET	;[2203] NO, DO IT
	JRST	T.12A		;YES

T12GET:	MOVEI	T2,2*LN.12	;[2273] SIZE WE NEED
	PUSHJ	P,DY.GET	;GET IT
	HRLI	T1,W2		;PUT INDEX IN
	MOVEM	T1,LINKTB	;SETUP POINTER
	HRLZ	T2,T1		;BLT POINTER
	HRRI	T2,1(T1)
	SETZM	(T1)
	BLT	T2,<2*LN.12>-1(T1) ;[2273] CLEAR ALL LINKS
	POPJ	P,		;[2203]

T.12A:	PUSHJ	P,RB.2		;READ 2 WORDS
	  JRST	LOAD##
	HLRZ	W3,W1		;[2273] GET THE CHAIN ADDRESS
	HLL	W3,LSTLRV	;[2273] AS A 30 BIT ADDRESS
	HLL	W1,LSTRRV	;[2273] GET THE 30 BIT STORE ADDRESS
	TRNE	FL,R.LSO!R.HSO	;SELECTIVE LOADING?
	PUSHJ	P,CHKSEG	;YES, SEE IF WANTED
	  CAIA			;YES
	JRST	T.12		;NO
	JUMPL	W2,T.12E	;THIS IS AN END OF LINK WORD
	SOJL	W2,.+2		;ZERO IS ILLEGAL
	CAIL	W2,LN.12	;IN RANGE
	AOJA	W2,E$$ICB	;[1174] ILLEGAL LINK #
	SKIPN	W3		;[2273] THIRD ARG SPECIFIED?
	MOVE	W3,W1		;[2273] NO, DEFAULT TO SECOND ARG
	MOVE	T2,W1		;[2273] GET ADDRESS WE NEED
	PUSHJ	P,SEGCHK##	;SEE IF IN CORE
	  JRST	T.12N		;NOT
	HRRZ	T1,@LINKTB	;GET PREVIOUS LINK ADDRESS
	HRRM	T1,(T2)		;STORE INCORE
	MOVEM	W3,@LINKTB	;[2273] STORE NEW IN LINK TABLE
	JRST	T.12A		;BACK FOR MORE
;HERE IF THE OLD .LINK ADDRESS IS NO LONGER IN CORE.
T.12N:	TXO	T2,CPF.RR	;[2200] NOT IN CORE
	EXCH	W3,@LINKTB	;[2273] STORE NEW LINK, GET PREVIOUS
	PUSHJ	P,SY.CHP##	;PUT IN FIXUP LIST
	JRST	T.12A		;RETURN FOR MORE

T.12E:	MOVNS	W2		;GET ENTRY NUMBER
	SUBI	W2,1		;PUT IN RANGE 0-17
	CAIL	W2,LN.12	;IN RANGE?
	AOJA	W2,E$$ICB	;[1174] ILLEGAL
	MOVE	T1,LINKTB	;[2273] GET THE TABLE BASE
	ADDI	T1,LN.12	;[2273] GOES IN SECOND HALF OF TABLE
	MOVEM	W1,@T1		;[2273] SAVE END OF LINK INFO
	JRST	T.12A		;BACK FOR MORE


E$$ICB::.ERR.	(MS,.EC,V%L,L%W,S%W,ICB,<Invalid chain REL block (type 12) link number >) ;[1174]
	.ETC.	(OCT,.EC!.EP,.EC,,,,W2) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
	JRST	T.12A		;TRY TO CONTINUE
SUBTTL	BLOCK TYPE 13 - LVAR (WEIHER)


;	----------------
;	!   13 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! DATA   WORDS !
;	----------------

T.13:
E$$T13::.ERR.	(MS,.EC,V%L,L%F,S%F,T13,<LVAR REL block (type 13) not implemented>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
SUBTTL	BLOCK TYPE 14 - INDEX


;	----------------
;	!   14 ! COUNT !
;	----------------
;	!    4 ! COUNT !
;	----------------
;	!      SYMBOLS !
;	----------------
;	! WORD ! BLOCK !
;	----------------

T.14:
IFE TOPS20,<
	SETZM	DCBUF+2		;READ NEXT BUFFER ON NEXT ILDB
>  ;[1417]
IFN TOPS20,<
	MOVEI	T1,400000	;[1417] COMPUTE BLOCKSIZE
	SUBI	T1,(WC)		;[1417]
	MOVE	T2,DCBUF+2	;[1417] BUFFER COUNT
	SUB	T2,T1		;[1417] SUBTRACT THIS BLOCK
	MOVEM	T2,DCBUF+2	;[1417]
	IBP	T1,DCBUF+1	;[1417] INCR BUFFER BYTEPOINTER
	MOVEM	T1,DCBUF+1	;[1417] PAST THIS BLOCK
> ;[1417]
T.14ER:	SKIPN	XBUF		;IF WE HAVE AN INDEX BUFFER
	JRST	LOAD##		;NO, NOT FIRST TIME HERE
	PUSHJ	P,ZXBUF##	;GET RID OF IT
E$$LII::.ERR.	(MS,,V%L,L%W,S%I,LII,<Library index inconsistent, continuing>) ;[1174]
	JRST	LOAD##		;AND CONTINUE

T.14I:	PUSHJ	P,D.IN1##	;READ FIRST WORD
	HLRZ	T1,W1		;BLOCK TYPE ONLY
	CAIE	T1,14		;IS IT AN INDEX?
	JRST	T.14ER		;NO, ERROR
	JRST	T.14J		;DON'T SET FLAG AGAIN
;ENTER HERE IF IN /SEARCH MODE
T.14A:	SKIPN	XBUF		;[1101] GIVE ERROR IF ALREADY BEEN HERE
	TRNE	FL,R.INC	;INCLUDE BEING PROCESSED?
	JRST	T.14		;PROCESS AS IF NO INDEX
	MOVEI	T2,^D128	;SIZE OF INDEX BUFFER
	PUSHJ	P,DY.GET##	;GET SPACE IN DY AREA
	HRRZM	T1,XBUF		;SIGNAL SPACE AQUIRED
T.14J:	HRRZ	T1,XBUF		;AUX BUFFER
	HRLI	T1,4400		;MAKE BYTE POINTER
	MOVEM	T1,XBUF+1	;AND SAVE IT
	HRL	T1,DCBUF+1	;INPUT BUFFER
	MOVEI	T2,^D127(T1)	;END OF BUFFER
	BLT	T1,(T2)		;STORE BLOCK
T.14B::	ILDB	W3,XBUF+1
	JUMPL	W3,T.14D	;END OF BLOCK IF NEGATIVE
	HRRZ	W3,W3		;WORD COUNT ONLY
IFN FTOVERLAY,<
	PUSH	P,BG.SCH	;REMEMBER CURRENT STATUS
	SETZM	BG.SCH		;DON'T SEARCH UNIVERSALS
> ;END IFN FTOVERLAY
T.14C:	MOVX	W1,PT.SGN!PT.SYM	;VALID SYMBOL BITS
	ILDB	W2,XBUF+1	;GET NEXT SYMBOL
	PUSHJ	P,R50T6		;SIXBITIZE IT
	PUSHJ	P,TRYSYM##
	  CAIA			;NOT IN TABLE, KEEP TRYING
	  SOJA	W3,T.14E	;REQUEST MATCHES
T.14K:	SOJG	W3,T.14C	;[562] NOT REQUIRED KEEP TRYING
IFN FTOVERLAY,<
	POP	P,BG.SCH	;RESTORE OLD STATUS
> ;END IFN FTOVERLAY
	ILDB	W3,XBUF+1	;GET POINTER WORD
	JRST	T.14B		;GET NEXT PROG
T.14E:	MOVE	T1,0(P1)	;UNDEFINED, BUT DO WE WANT IT?
	TXNN	T1,PS.UDF	;NOT IF ALREADY PARTIAL DEFS
	TXNN	T1,PS.REQ	;CERTAINLY NOT IF NO REQUESTS
	AOJA	W3,T.14K	;[562] WAS A=:B##, DON'T WANT A AGAIN

IFN FTOVERLAY,<
	POP	P,BG.SCH	;RESTORE OLD STATUS
> ;END IFN FTOVERLAY
	ADDM	W3,XBUF+1
	ILDB	T1,XBUF+1
	HRRZ	W3,LSTBLK	;GET LAST BLOCK NUMBER
IFN TOPS20,<
NXTCHK:	HRRZI	T2,-1(T1)	; CONVERT BLOCK TO PAGE
				; SUBTRACTING NONEXISTANT BLOCK 0
	LSH	T2,-2		; PAGE #
	CAILE	W3,(T2)		; PAST END OF BUFFER?
> ;[1402] IFN TOPS20
IFE TOPS20,<	CAIN	W3,(T1)		;IN THIS BLOCK?
> ;[1402] IFE TOPS20
	JRST	THSBLK		;YES
IFE TOPS20,<
NXTNDX:	SKIPGE	DTAFLG		;[1101] DIFFERENT TEST FOR DTA
	JRST	NXTDTA		;CHECK IF NEXT BUFFER IN CORE
	CAIN	W3,-1(T1)	;NEXT BLOCK?
	JRST	NXTBLK		;YES,JUST DO INPUT
T.14F:	USETI	DC,(T1)		;SET ON BLOCK
	WAIT	DC,		;LET I/O FINISH
	MOVSI	W2,(1B0)	;CLEAR RING USE BIT IF ON
	HRRZ	W3,DCBUF
	IORM	W2,DCBUF	;SET UNUSED RING BIT (HELP OUT MONITOR)
	SKIPL	(W3)
	JRST	NXTBLK		;ALL DONE NOW
	ANDCAM	W2,(W3)		;CLEAR USE BIT
	HRRZ	W3,(W3)		;GET NEXT BUFFER
	JRST	.-4		;LOOP
NXTDTA:	WAIT	DC,		;LET I/O RUN TO COMPLETION
	HRRZ	W3,DCBUF	;GET POINTER TO CURRENT BUFFER
	HLRZ	W3,1(W3)	;FIRST DATA WORD IS LINK
	CAIE	W3,(T1)		;IS IT BLOCK WE WANT?
	JRST	T.14F		;NO
> ;[1402] IFE TOPS20

NXTBLK:
IFE TOPS20,<
	IN	DC,
	  JRST	THSBLK		;[1101] IT IS NOW
	JRST	D.ERR##		;EOF OR ERROR
> ;[1402] IFE TOPS20
IFN TOPS20,<
	EXCH	T2,T1			;[1402] T1:PAGE#,T2:BLOCK#
	PUSHJ	P,RDSKP##		;[1402] MOVE THE BUFFER
	SKIPA				;[1402] ALL OK
	JRST	D.ERR##			;[1402] ERROR
	EXCH	T2,T1			;[1402] T1:BLOCK#
;	JRST	THSBLK			;[1402]
> ;[1402] IFN TOPS20

;HERE WHEN THE DATA WE WANT IS IN THE CURRENT BUFFER.
;IF WE WERE READING A NEW INDEX (T1.LT.0), THEN GO TO T.14I.
;IF NOT, ADJUST THE BYTE COUNT & PTR TO POINT TO THE START OF
;THE MODULE TO BE LOADED, THEN GO TO LOAD TO LOAD IT.
;T1 CONTAINS MODULE POINTER (WORD,,BLOCK) FOR THIS MODULE.

THSBLK:
IFE TOPS20,<
	HRRZM	T1,LSTBLK	;[1101] WE KNOW WE'RE NOW ON THIS BLOCK
	JUMPL	T1,T.14I	;[1101] JUMP IF BLOCK CONTAINS AN INDEX
	HLRZ	T1,T1		;[1101] NOT AN INDEX, GET WORD OFFSET
> ;[1402] IFE TOPS20
IFN TOPS20,<
	HRRZI	T2,-1(T1)	;[1402] BLOCK # - NONEXISTANT BLOCK 0
	IDIVI	T2,4		;[1402] DIVIDE BY BLOCKS PER PAGE
	IMULI	T3,^D128	;[1402] REMAINDER (BLOCKS) AS WORDS
	SUB	T2,LSTBLK	;[1402] REMOVE BUFFER ORIGIN
	ADDI	T2,<LN.BF_-9>	;[1402] ...
	LSH	T2,9		;[1402] QUOTIENT (PAGES) AS WORDS
	ADD	T3,T2		;[1402] ADD TO GET PARTIAL OFFSET
	HLRZ	T2,T1		;[1402] OFFSET INTO BLOCK
	CAIN	T2,-1		;[1402] IF OFFSET IS INDEX MARKER
	SETZM	T2		;[1402] USE ZERO AS OFFSET
	ADD	T3,T2		;[1402]  + OFFSET INTO PAGE IS TOTAL OFFSET

> ;[1402] IFN TOPS20
	HRRZ	T2,DCBUF	;[1101] CONSTRUCT NEW BYTE POINTER
IFN TOPS20,<
	ADD	T2,T3		;[1402] RH=RH(DCBUF)+TOTAL OFFSET-1
	HLL	T2,DCBUF+1	;[1402]
	TLNN	T2,440000	;[1402] CHECK BYTE BOUNDS FOR CORRECT COUNT
	SOS	T2		;[1402]

> ;[1402] IFN TOPS20
IFE TOPS20,<
	HLL	T2,DCBUF+1	;[1101] LH=LH(OLD BYTE PTR)
	ADDI	T2,1(T1)	;[1101] RH=RH(DCBUF)+OFFSET+1
> ;[1402] IFE TOPS20
	EXCH	T2,DCBUF+1	;[1101] GET OLD PTR, STORE NEW ONE
	SUB	T2,DCBUF+1	;[1101] COMPUTE DIFFERENCE TO UPDATE COUNT
	ADDM	T2,DCBUF+2	;[1101] UPDATE BYTE COUNT
IFN TOPS20,<
	JUMPL	T1,T.14I	;[1101] JUMP IF BLOCK CONTAINS AN INDEX
> ;[1402] IFN TOPS20
	JRST	LOAD##

T.14D:	HRRE	T1,W3		;GET BLOCK # OF NEXT INDEX
	JUMPL	T1,EOF1##	;FINISHED IF -1
	MOVE	T1,W3		;[1101] -1,,BLOCK # INTO T1 FOR THSBLK
	HRRZ	W3,LSTBLK	;GET LAST BLOCK
IFE TOPS20,<
	JRST	NXTNDX		;CHECK IF NEXT BUFFER IN CORE
> ;[1402] IFE TOPS20
IFN TOPS20,<
	JRST	NXTCHK		;CHECK IF ANOTHER PMAP NEEDED
> ;[1402] IFN TOPS20
SUBTTL	BLOCK TYPE 15 - ALGOL OWN


;	----------------
;	!   15 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	! ORIG ! LENGTH!
;	----------------
;	! ADDR ! VALUE !
;	----------------

T.15:	PUSHJ	P,RB.1		;READ 3RD WORD
	  JRST	[MOVEI	T1,15
		 JRST	E$$RBS]		;[1174]
	MOVEI	R,1		;MUST GO TO LOW SEG
	MOVE	R,@RC.TB	;SO SETUP R
	HLRZ	W2,W1		;ORIGIN OF THIS OWN BLOCK
	MOVE	P3,W2		;COPY FOR ADCHK.
	SKIPE	ASFILE		;FIRST OWN BLOCK?
	JRST	T.15B		;NO
	TLZ	W1,-1		;YES, ZAP ORIGIN
	CAIGE	W1,LN.ABL+1	;IS THIS OWN BLOCK LONG ENOUGH?
	MOVEI	W1,LN.ABL+1	;NEEDS TO HOLD .SYM FILE DESCRIPTR
T.15B:	HRRZM	W1,OWNLNG	;TO FIX RELOC AT END
	MOVE	T1,P3		;GET START 
	ADDI	T1,(W1)		;+END =HIGHEST LOC LOADED
	CAMLE	T1,RC.HL(R)	;BIGGEST YET?
	MOVEM	T1,RC.HL(R)	;YES STORE IT
	SKIPE	ASFILE		;FIRST OWN BLOCK SEEN?
	JRST	T.15C		;NO, PROCEED
	MOVEI	W3,1(W2)	;BYPASS CHAIN WORD
	MOVEM	W3,ASFILE	;REMEMBER LOC OF DESCRIPTOR BLOCK
T.15C:	EXCH	W2,%OWN		;EXCH WITH PREVIOUS OWN
	HRL	W1,W2		;LAST OWN ADDRESS IN LEFT
				;THIS LENGTH IN RIGHT
	MOVS	W1,W1		;LENGTH,,ADDRESS
	MOVEI	R,1		;SEGMENT #
	PUSHJ	P,ADCHK.##	;MAKE SURE ADDRESSABLE
	CSTORE			;STORE W1

T.15A:	PUSHJ	P,RB.1		;GET FIXUP REQUEST
	  JRST	LOAD##
	HRRZ	W3,W1		;ADDITIVE CONSTANT
	ADD	W3,%OWN		;ADD IN BASE OR ARRAY
	HLRZ	T2,W1		;START OF CHAIN
	PUSHJ	P,SY.CHR##	;CHAIN REQUESTS
	JRST	T.15A
SUBTTL	BLOCK TYPES 16 & 17 REQUESTS


;	----------------
;	!   16 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!    FILE NAME !
;	----------------
;	!          PPN !
;	----------------
;	!       DEVICE !
;	----------------

T.16:	SKIPA	P1,[PRGPTR]	;LOAD ADDRESS OF LIST OF PROGS TO LOAD
T.17:	MOVEI	P1,LIBPTR	;OR ADDRESS OF LIST OF LIBS TO SEARCH
T.16A:	PUSHJ	P,RB.2		;READ FIRST 2 DATA WORDS
	  JRST	LOAD##		;END OF BLOCK
	MOVE	W3,W1		;STORE PPN IN W3
	PUSHJ	P,RB.1		;READ 3RD DATA WORD
	  SETZ	W1,		;INCASE DEV NOT GIVEN
				;W1=DEV, W2=FILE, W3=PPN
	MOVEI	T2,R.LEN	;NEED A REQUEST BLOCK
	PUSHJ	P,DY.GET##
	TSTORE	W1,<R.DEV(T1)>,<R.NAM(T1)>,<R.PPN(T1)>
	MOVSI	W1,'REL'	;ONLY EXTENSION OLD BLOCKS CAN HAVE
	MOVEM	W1,R.EXT(T1)	;STORE IT AWAY
	PUSHJ	P,T.RQST	;GO LINK IT IN TO THE CHAIN
	JRST	T.16A		;SEE IF MORE GIVEN
;ROUTINE TO CHAIN A REQUEST IN IF HASN'T ALREADY BEEN SEEN
;ENTER WITH T1=ADDR OF BLOCK, P1=ADDR OF CHAIN. USES T1-T4.


T.RQST::HRLI	T1,-R.LEN	;SETUP AOBJN POINTER TO SCAN BLOCK
	AOBJN	T1,.+1		;BUT NEVER SCAN 1ST WORD
	PUSH	P,T1		;SAVE FOR FREQUENT USE
	MOVE	T2,P1		;SETUP POINTER TO START OF CHAIN
T.RQS1:	MOVX	T4,<0,,-1>	;[571] LOOK AT RIGHT HALF ONLY
	TDNN	T4,0(T2)	;[571] END OF CHAIN YET?
	  JRST	T.LINK		;YES, GO LINK THIS REQUEST IN
	MOVE	T2,(T2)		;FOLLOW LINK
	MOVE	T1,(P)		;GET POINTER TO NEW BLOCK
	MOVEI	T3,1(T2)	;AND TEMP POINTER TO OLD ONE
T.RQS2:	MOVE	T4,(T1)		;GET A WORD FROM NEW BLOCK
	CAME	T4,(T3)		;MATCH OLD BLOCK?
	  JRST	T.RQS1		;NO, SEE IF NEXT BLOCK MATCHES
	AOJ	T3,		;BUMP POINTERS
	AOBJN	T1,T.RQS2	;KEEP CHECKING FOR A MATCH
	POP	P,T1		;IT MATCHED, RESTORE ADDR+1
	MOVEI	T1,-1(T1)	;CONVERT TO REAL ADDR & ZAP LH
	MOVEI	T2,R.LEN	;LENGTH OF IT
	PJRST	DY.RET##	;RETURN THE BLOCK SINCE DUPLICATE FOUND

;HERE IF A NEW REQUEST. LINK IT IN TO THE LIST AND RETURN.
T.LINK:	POP	P,T1		;RECOVER ADDR+1
	MOVEI	T1,-1(T1)	;CONVERT TO ADDR
	HRRM	T1,(T2)		;[571] STORE THIS BLOCK ON THE CHAIN
	HRRZS	(P1)		;INDICATE SOMETHING NEW ON THE LIST
	POPJ	P,
SUBTTL	BLOCK TYPE 20 - COMMON ALLOCATION


;	----------------
;	!   20 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!       SYMBOL !
;	----------------
;	!       LENGTH !
;	----------------

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

T.20:	PUSHJ	P,RB.2		;GET COMMON PAIR
	  JRST	LOAD##		;FINISHED
	PUSHJ	P,R50T6		;CONVERT TO SIXBIT
	PUSHJ	P,T.COMR	;CHECK THIS PAIR
	  JRST	T.20		;ALREADY DEFINED
	HRRZ	P1,@HT.PTR	;SETUP P1 TO POINT TO SYMBOL
	ADD	P1,NAMLOC	;IN CORE
	MOVE	W3,.L+2(P1)	;GET LENGTH OF THE COMMON BLOCK.
	ADDB	W3,RC.CV(R)	;[2205] BUMP RELOCATION COUNTER
	CAML	W3,RC.LM(R)	;[2205] CHECK AGAINST THE LIMIT
	 PUSHJ	P,TOOBIG	;[2205] TOO BIG, GIVE A WARNING
	JRST	T.20		;GET NEXT SYMBOL

T.COMR::MOVEI	R,1		;ASSUME FIRST SEGMENT
	TRNE	FL,R.FHS	;FORCED LOADING TO HIGH SEG
	ADDI	R,1		;YES, SO SET R FOR HIGH SEG
	SKIPGE	MODTYP		;[2205] LOADING PSECTS?
	 MOVE	R,RC.CUR	;[2205] YES
	MOVE	R,@RC.TB	;GET RC BLOCK
	MOVE	W3,RC.CV(R)	;[2205] CURRENT VALUE
				;FALL INTO T.COMM
;T.COMM TESTS TO SEE IF COMMON ALREADY EXISTS
;IF SO CHECK SIZE
;IF NOT DEFINE (GLOBAL ONLY)
;[2205] Arguments:
;[2205] W1/	Size of common block
;[2205] W2/	Name of common block
;[2205] W3/	Origin of common block
;RETURNS
;+1	COMMON ALREADY DEFINED WITH CORRECT LENGTH
;+2	WAS NOT DEFINED, NOW IS
;THIS ROUTINE PRESERVES R

T.COMM::PUSH	P,W1			;[2205] SAVE SIZE
	MOVX	W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL	;[2205] SET THE FLAGS
	PUSHJ	P,TRYSYM##	;SEE IF IN TABLE
	  JRST	T.20ND		;NOT IN TABLE
	  JRST	T.20UN		;IN, BUT UNDEF (NOT COMMON)
	POP	P,W1		;[2205] RESTORE THE COMMON BLOCK SIZE
	MOVE	T1,(P1)		;GET PRIMARY FLAGS
	TXNN	T1,PS.COM	;ALREADY COMMON?
	JRST	E$$SNC		;[1174] NO, ERROR
	HRRZ	T1,P1		;GET COPY
	ADDI	T1,.L		;NEXT TRIPLET
	MOVE	T2,(T1)		;GET FLAGS
	TXNN	T2,S.COM	;FOUND COMMON BLOCK YET?
	JRST	.-3		;NO
	CAMLE	W1,2(T1)	;[2205] LESS THAN OR EQUAL TO WHAT WE HAVE?
	JRST	T.20ER		;NO, GIVE ERROR
	MOVE	W3,2(P1)	;[2230] Set starting address of common
	MOVE	T2,RC.AT(R)	;[2230] Get the primary flags again
	TXNN	T2,AT.NC	;[2230] Allowed to cross section boundaries?
	 POPJ	P,		;[2230] Yes, doesn't matter where it is
	MOVE	T2,W3		;[2230] Get the start address
	XOR	T2,RC.IV(R)	;[2230] Compare it with the current psect
	TLNE	T2,-1		;[2230] Same section number?
	 JRST	E$$CMP		;[2230] No, error
	MOVE	T2,W3		;[2230] Get back the start address
	ADD	T2,W1		;[2230] Add the length
	SUBI	T2,1		;[2230] Minus 1 for last address
	XOR	T2,RC.IV(R)	;[2230] Compare it with the current psect
	TLNN	T2,-1		;[2230] Same section number?
	 POPJ	P,		;[2230] Yes, no problem here

E$$CMP::.ERR.	(MS,.EC,V%L,L%F,S%C,CMP,<Common >) ;[2230] 
	.ETC.	(SBX,.EC!.EP,,,,W2)			 ;[2230]
	.ETC.	(STR,.EC,,,,,< declared in multiple psects>) ;[2230]
	.ETC.	(JMP,,,,,.ETIMF##) ;[2230]
	POPJ	P,		;[2230] Return anyways

T.20ER:	MOVE	T2,2(T1)	;[2205] GET CURRENT SIZE
	MOVE	T1,W1		;[2205] AND REQUESTED SIZE FOR ERROR MSG
E01AIC::.ERR.	(MS,.EC,V%L,L%F,S%F,AIC) ;[1174]
	.ETC.	(STR,.EC,,,,,<common >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(JMP,.EC,,,,.ETAIC) ;[1174]

E$$SNC::.ERR.	(MS,.EC,V%L,L%F,S%F,SNC,<Symbol >) ;[1174] 
	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(STR,.EC,,,,,< already defined, but not as common>)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HERE TO PUT SYMBOL IN TABLE AND GENERATE SPACE
T.20ND:	TXO	W1,PT.EXT	;TURN ON EXTENDED BIT NOW
	MOVEI	T2,2*.L		;NEEDS TWO TRIPLETS
	PUSHJ	P,GS.GET##	;GET SPACE FOR THEM
	DMOVEM	W1,0(T1)	;FLAGS & NAME
	MOVEM	W3,2(T1)	;[2205] VALUE (ADDRESS IN CORE)
	MOVX	T2,S.COM!S.LST	;SECONDARY FLAGS
	MOVEM	T2,.L+0(T1)	;IN SECONDARY TRIPLET
	MOVEM	W2,.L+1(T1)	;NAME AGAIN
	POP	P,.L+2(T1)	;[2205] LENGTH OF COMMON ARRAY
	MOVE	W3,T1		;EXPECTS POINTER TO SYMBOL IN W3
	SUB	W3,NAMLOC	;RELATIVE TO  GLOBAL TABLE
	AOS	(P)		;SKIP RET
	PUSHJ	P,INSRT##	;PUT SYMBOL IN GLOBAL TABLE
	HRRZ	P1,@HT.PTR	;GET RELATIVE PTR TO SYMBOL
	MOVEI	T2,2*.L		;NEED 2 TRIPLETS FOR COMMON
	PJRST	LS.ADE##	;PUT EXTENDED SYM IN LOCAL TABLE
T.20UN:	MOVE	T1,(P1)		;GET PRIMARY FLAGS
	TXNE	T1,PS.COM	;ALREADY DEFINED COMMON?
	JRST	E$$SNC		;[1174] SHOULD NOT HAPPEN
	PUSHJ	P,SY.CHK##	;SEE HOW LONG CURRENT SYMBOL IS
	ADDI	T2,.L		;EXTRA FOR COMMON TRIPLET
	PUSHJ	P,GS.GET	;GET SPACE
	HRRZ	P1,@HT.PTR	;RESET P1 INCASE CORE MOVED
	ADD	P1,NAMLOC	;MAKE FIXED
	MOVE	T3,(P1)		;GET PRIMARY FLAGS
	TXO	T3,PS.COM!PT.EXT	;NOW COMMON
	MOVEM	T3,(T1)		;STORE
	MOVEM	W2,1(T1)	;SYMBOL NAME
	MOVE	T3,2(P1)	;GET VALUE (CHAIN POINTER)
	MOVEM	T3,2(T1)
	MOVX	T3,S.COM	;SECONDARY FLAG
	CAIG	T2,2*.L		;ONLY COMMON
	TXO	T3,S.LST	;YES, THEN THIS IS LAST TRIPLET
	MOVEM	T3,.L+0(T1)	;STORE COMMON FLAG
	MOVEM	W2,.L+1(T1)	;SYMBOL
	POP	P,.L+2(T1)	;[2205] AND COMMON LENGTH
	CAIG	T2,2*.L		;MORE TO MOVE STILL
	JRST	T20UN1		;NO, JUST ADJUST POINTER
	HRLZI	T3,.L(P1)	;FROM
	HRRI	T3,2*.L(T1)	;TO
	HRRZI	T4,(T1)
	ADDI	T4,-1(T2)	;LIMIT
	BLT	T3,(T4)
T20UN1:	SUBI	T2,.L		;LESS TO GIVE BACK
	EXCH	T1,P1		;PUT NEW IN P1
	PUSHJ	P,GS.RET##	;GIVE BACK OLD SYMBOL
	SUB	P1,NAMLOC	;MAKE POINTER RELATIVE
	HRRM	P1,@HT.PTR	;STORE IT
	ADD	P1,NAMLOC	;PUT OFFSET BACK
	PUSH	P,P2		;[777] SAVE COMMON SYMBOL OVER SY.RF
	PUSH	P,R		;SAVE R OVER SY.RF
	PUSHJ	P,SY.RF##	;FIXUP ANY COMMON REFERENCES
	POP	P,R		;PUT R BACK AS IT WAS
	POP	P,P2		;[777] RESTORE COMMAND SYMBOL
	HRRZ	P1,@HT.PTR	;[777]   AND RECOMPUTE IN CASE IT'S MOVED
	JRST	CPOPJ1		;SKIP RETURN
SUBTTL	BLOCK TYPE 21 - SPARSE DATA (FORTRAN-10)


;	-----------------
;	!    21 ! COUNT !
;	-----------------
;	!  BYTE   WORD  !
;	-----------------
;	! COUNT ! ADDR. !
;	-----------------
;	!  DATA   WORDS !
;	-----------------

COMMENT	*
	THIS BLOCK CONSISTS OF SUB BLOCKS OF FORM
	WORD COUNT,,ADDRESS
	DATA WORDS

	ADDRESS CAN BE EITHER RELOCATABLE OR ABSOLUTE
	DATA MAY BE EITHER ALSO
	CODE IS SIMILAR TO TYPE 1
*

T.21:	TRNE	FL,R.TWSG	;ALREADY TWO SEG ?
	JRST	T.21A		;YES, LOAD IT
	SKIPE	HC.S2		;POTENTIALLY 2 SEG?
	TRO	FL,R.TWSG!R.CDT	;YES, FORCE INCASE COMMON
T.21A:	PUSHJ	P,RB.1		;READ CNT & LOC
	  JRST	[TRZE	FL,R.CDT	;FORCED 2 SEG?
		TRZ	FL,R.TWSG	;YES, PUT IT BACK
		JRST	LOAD##]		;ON TO NEXT BLOCK
	JUMPGE	W1,T.21NS	;[2205] NOT SYMBOLIC
	MOVEI	T1,21		;INCASE OF ERROR
	PUSHJ	P,T.1S		;SYMBOLIC IF SIGN BIT ON
	HLRZ	W3,W1		;WORD COUNT
	HRRZ	W1,W1		;ADDRESS ONLY
	IOR	W1,LSTRRV	;[2205] SECTION NUMBER (IF ANY)
	ADD	W1,W2		;[2205] PLUS VALUE OF SYMBOL
	JRST	T.21B		;[2205] AVOID THE NON-SYMBOL STUFF
T.21NS:	HLRZ	W3,W1		;[2205] WORD COUNT
	HRRZ	W1,W1		;ADDRESS ONLY
	IOR	W1,LSTRRV	;
T.21B:	MOVE	P3,W1		;START ADDRESS
	ADD	W1,W3		;HIGHEST NEEDED
	PUSHJ	P,T.1AD		;CHECK ADDRESS AND LOAD THIS SUB BLOCK
	  JRST	T.0C		;[1776] THROW IT AWAY
	  JRST	[ PUSHJ	P,T.1LPJ
		  JRST .+2 ]	;[1776] DEFER IT
	PUSHJ	P,T.1DP		;[1776] LOAD IT		  
	JRST	T.21A		;LOOP FOR MORE
SUBTTL	BLOCK TYPE 22 - SET PSECT BLOCK


;	-----------------
;	!    22 ! COUNT !
;	-----------------
;	!  BYTE   WORD  !
;	-----------------
;	! PSECT  NAME   !
;	-----------------
;	!        ORIGIN !
;	-----------------

COMMENT	*
	THIS BLOCK CONSISTS OF :-
	PSECT NAME IN SIXBIT
	PSECT ORIGIN
*

T.22:	PUSHJ	P,RB.2		;READ NAME AND ORIGIN
	  JRST	[MOVEI	T1,20
		 JRST E$$RBS]		;[1174] ERROR
	MOVE	W3,W1		;STORE VALUE IN SAFE PLACE
	TLNN	W2,600000	;[763] FIRST SIXBIT NON-ZERO?
	JRST	T.22C		;[763] IT'S ZERO, MUST BE PSECT INDEX, JUMP
;SEE IF ALREADY DEFINE, IF NOT PUT IN TABLE
	MOVE	R1,RC.NO	;GET NUMBER
T.22A:	MOVE	T1,@RC.TB		;GET POINTER TO BLOCK
	CAMN	W2,RC.NM(T1)	;THIS IT?
	JRST	T.22E		;[1300] YES,
	SOJG	R1,T.22A	;NOT YET
	SETZ	W1,		;[763] ZERO ATTRIBUTES
T.22D:	SKIPN	W3		;[763]
	TXO	W1,AT.RP	;[763] ASSUME RELOC-PSECT IF ORIGIN IS ZERO
	PUSHJ	P,.SET0##	;NOT YET DEFINED
	MOVE	R1,RC.NO	;MUST BE LAST
	HRRZ	R1,@RC.MAP	;[1304] MAP TO INTERNAL NUMBER (IN CASE .HIGH.)
T.22B:	MOVEM	R1,RC.CUR	;SET FOR RELOCATION
	JRST	LOAD##		;FINISHED
T.22E:	MOVE	W1,RC.AT(T1)	;[1300] GET THE ATTRIBUTES
	TXZN	W1,AT.RP	;[1300] IS THE RELOCATABLE BIT SET?
	JRST	T.22B		;[1300] NO
	MOVEM	R1,RC.CUR	;[1300] SET FOR RELOCATION
	SKIPE	W3		;[1300] DON'T SET UP FOR ZERO ADDRESS
	PUSHJ	P,.SET0##	;[1300] SET UP THE PSECT ADDRESSES
	JRST	LOAD##		;[1300] FINISHED

T.22C:	MOVEI	R,(W2)		;[2207] PSECT INDEX IS ONE LESS
	CAIL	R,0		;[2207] CHECK FOR BELOW .LOW.
	CAMLE	R,RC.NO		;[1304] PSECT INDEX EXIST?
	JRST	E$$IPX		;[1304] NO, GIVE ERROR
	HRRZ	R,@RC.MAP	;[1304] GET INTERNAL PSECT NUMBER
	MOVEM	R,RC.CUR	;[1304] SWITCH CURRENT RELOC COUNTER TO IT
	JRST	LOAD##		;[1304]
SUBTTL	BLOCK TYPE 23 - PSECT END BLOCK


;	-----------------
;	!    23 ! COUNT !
;	-----------------
;	!  BYTE   WORD  !
;	-----------------
;	!  PSECT  INDEX !
;	-----------------
;	!     BREAK     !
;	-----------------


T.23:	PUSHJ	P,RB.1		;[1154] GET PSECT INDEX
	  JRST	E$$RBS		;[1174] TOO SHORT
	MOVEI	R,(W1)		;[2207] PUT INTERNAL PSECT INDEX INTO R
	TXNN	W1,77B5		;[1154] OLD STYLE (NAME IN SIXBIT)?
	JRST	[ HRRZ R,@RC.MAP;[1304] MAP TO INTERNAL PSECT INDEX
		 JRST T.23B ]	;[1304] WE HAVE THE PSECT INDEX.



;HERE WITH OLD-STYLE NAME IN SIXBIT.  LOOP OVER RC BLOCKS LOOKING FOR IT.

	MOVE	R,RC.NO		;[1154] START AT THE TOP PSECT
T.23A:	MOVE	T1,@RC.TB	;[1154] POINT TO NEXT RC BLOCK
	CAME	W1,RC.NM(T1)	;[1154] IS THIS IT?
	SOJG	R,T.23A		;[1154] NO, LOOP
	JUMPE	R,[MOVEI T1,23	;[1154] IF NOT FOUND, GO COMPLAIN
		   JRST E$$RBS]		;[1174] USUAL MESSAGE


;HERE WITH THE INTERNAL PSECT INDEX IN R.  NEED TO PUT THIS IN RC.CUR,
;SO CALL TO RB.1 WILL GET BREAK RELOCATED WITH RESPECT TO THIS PSECT.

T.23B:	MOVE	P1,RC.CUR	;[1154] SAVE OVER MUNGING BELOW
	MOVE	P2,@RC.TB	;[1154] SAVE ADDRESS OF RC BLOCK
	MOVEM	R,RC.CUR	;[1154] SET UP FOR RB.1
	PUSHJ	P,RB.1		;[1154] GET BREAK
	  JRST	[MOVEI T1,23	;[1154] NOT THERE, COMPLAIN
		 JRST E$$RBS]		;[1174]   ..
	HLLZ	T1,LSTRRV	;[2244] GET THE SECTION NUMBER
	ADD	W1,T1		;[2244] ADD IT
	PUSHJ	P,CHKSZ0	;[1715]	CHECK FOR PSECT TOO BIG
	MOVEM	P1,RC.CUR	;[1154] RESTORE RC.CUR
	CAMLE	W1,RC.HL(P2)	;[1154] A NEW RECORD FOR THE BREAK?
	MOVEM	W1,RC.HL(P2)	;[1154] YES, SET HL (CV FIXED IN T.5)
	JRST	LOAD##		;[1154] DONE, GO GET NEXT BLOCK
SUBTTL	BLOCK TYPE 24 - PSECT HEADER BLOCK


;	-----------------
;	!    24 ! COUNT !
;	-----------------
;	!  BYTE   WORD  !
;	-----------------
;	!  PSECT  NAME  !
;	-----------------
;	!ATTR !PSECT IDX!
;	-----------------
;	!   ORIGIN      !
;	-----------------
COMMENT	*
	THIS BLOCK CONSISTS OF :-
	PSECT NAME IN SIXBIT
	ATTRIBUTES,,PSECT-INDEX
	PSECT ORIGIN
*

T.24:	SKIPLE	MODTYP		;[1306] TWOSEG SEEN IN MODULE?
	PUSHJ	P,E$$MPT	;[1306] YES, ERROR
	SETOM	MODTYP		;[1306] FLAG PSECTS SEEN
	PUSHJ	P,RB.2		;PSECT NAME
	  JRST	E$$RBS		;[1174] BLOCK TOO SHORT
	TXO	W1,AT.PS	;[1137] REMEMBER THIS PSECT SEEN IN THIS MODULE
	HLLZ	W3,W1		;[1137] SAVE ATTRIBUTES IN W3
	MOVEI	P1,(W1)		;[2207] SAVE LINK'S PSECT INDEX IN P1
	SETZ	W1,		;[1137] ASSUME PSECT ORIGIN IS ZERO
	JUMPN	W2,T.24A	;[1137] IF NAME SPECIFIED, GO CHECK ORIGIN
	MOVEI	P1,1		;[1137] DEFAULT PSECT IS AT SLOT 1
	MOVE	W2,['.LOW. ']	;[1137] AND ITS NAME IS .LOW.
	JRST	T.24B		;[1137] GO SEE IF ITS ORIGIN IS CORRECT

T.24A:	JUMPL	W3,T.24B	;[1137] IF NO ORIGIN GIVEN, DON'T TRY TO GET IT
	PUSHJ	P,RB.1		;[1137] GET ORIGIN FROM THE REL FILE
	  JRST	E$$RBS		;[1174] NOT THERE?

;[2222] Here to set up an index and insert a new psect if necessary.
;[2222] W1 / origin (if any)
;[2222] W2 / Symbol name
;[2222] W3 / Attributes
;[2222] P1 / User psect index

T.24B::	SKIPN	RC.CUR		;[2233] ALREADY A DEFAULT PSECT?
	 AOS	RC.CUR		;[2233] NO, SET .LOW. AS DEFAULT
	MOVE	R,RC.NO		;[2222] LOOP OVER ALL RC BLOCKS
T.24C:	MOVE	T1,@RC.TB	;[1304] RC BLOCK WHERE THIS PSECT MIGHT BE
	MOVE	T2,RC.NM(T1)	;[2222] GET THE NAME
	PUSHJ	P,NAMCMP##	;[2222] IS IT HERE?
	 CAIA			;[2222] YES
	SOJG	R,T.24C		;[2207] NO, LOOP OVER ALL PSECTS
	JUMPE	R,T.24D		;[2207] IF NOT FOUND, INSERT A NEW RC BLOCK
	TXZ	W3,AT.RP	;[1137] WE FOUND IT, SO ALREADY HAVE ORIGIN
;[2222] Here to check for psect conflicts	
	IOR	W3,RC.AT(T1)	;[2222] Get combined attributes
	TXC	W3,AT.CN!AT.OV	;[2222] Check these bits
	TXCE	W3,AT.CN!AT.OV	;[2222] A conflict?
	JRST	T.24C1		;[2222] No, check other attributes
	TXZ	W3,AT.CN!AT.OV	;[2222] Yes, don't modify them
	PUSH	P,T1		;[2222] Save the psect index

	PUSH	P,T1		    ;[2222] Save the psect index
E$$COE::.ERR.	(MS,.EC,V%L,L%W,S%W,COE,<Both CONCATENATE and OVERLAY attributes specified for psect >) ;[2222]
	.ETC.	(SBX,.EC!.EP,,,,W2) ;[2222]
	.ETC.	(JMP,,,,,.ETIMF##)  ;[2222]
	POP	P,T1		    ;[2222] Restore the psect index

T.24C1:	TXC	W3,AT.RO!AT.RW	;[2222] Check these bits
	TXCE	W3,AT.RO!AT.RW	;[2222] A conflict?
	 JRST	T.24C2		;[2222] No
	TXZ	W3,AT.RO!AT.RW	;[2222] Yes, don't modify them

	PUSH	P,T1		    ;[2222] Save the psect index
E$$RWA::.ERR.	(MS,.EC,V%L,L%W,S%W,RWA,<Both READ-ONLY and WRITABLE attributes specified for psect >) ;[2222]
	.ETC.	(SBX,.EC!.EP,,,,W2) ;[2222]
	.ETC.	(JMP,,,,,.ETIMF##)  ;[2222]
	POP	P,T1		    ;[2222] Restore the psect index

T.24C2:	IORB	W3,RC.AT(T1)	;[1300] ACCUMULATE ATTRIBUTES
	TXZN	W3,AT.RP	;[1300] IS IT RELOCATABLE?
	JRST	T.24E		;[1300] NO MAKE SURE IT'S WHERE WE EXPECT IT
	EXCH	W1,W3		;[1300] SET ACS FOR .SET0
	PUSHJ	P,.SET0##	;[1300] SET THE ADDRESS
	JRST	T.24E		;[1300]
T.24D:	EXCH	W1,W3		;[1137] SET ACS FOR .SET0
	PUSHJ	P,.SET0##	;[1137] SET UP A NEW RC BLOCK
	MOVE	R,RC.NO		;[1304] ITS INDEX IS THE LAST PSECT
T.24E:	CAILE	P1,0		;[2207] DISALLOW CHANGING BELOW .LOW.
	CAMLE	P1,RC.NO	;[1153] CATCH GARBAGE PSECT INDICES
	JRST	E01IPX		;[1174] INDEX IS JUNK, COMPLAIN
	EXCH	R,P1		;[2207] RC.NO SLOT IN P1, RC.MAP SLOT IN R
	HRRZM	P1,@RC.MAP	;[2207] STORE IT
	JRST	LOAD##		;ALL DONE
E$$MPT::.ERR.	(MS,.EC,V%L,L%F,S%F,MPT,<Mixed psect and twoseg code in same module >) ;[1306]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1306]


;HERE ON AN INVALID PSECT INDEX WHEN W2 CONTAINS SIXBIT PSECT NAME.
E01IPX::.ERR.	(MS,.EC,V%L,L%F,S%F,IPX) ;[1174]
	.ETC.	(STR,.EC,,,,,< for psect >)
	.ETC.	(SBX,.EC!.EP,,,,W2) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
SUBTTL	BLOCK TYPE 37 - COBOL LOCAL SYMBOLS


;	----------------
;	!   37 ! COUNT !
;	----------------
;	! BYTE   WORD  !
;	----------------
;	!      ADDRESS !
;	----------------
;	! DATA   WORDS !
;	----------------

T.37:	TRNN	FL,R.SYM	;LOADING WITH SYMBOLS?
	JRST	T.0		;NO, IGNORE THIS BLOCK
	HRRZI	W2,-1(W1)	;GET COUNT OF DATA WORDS
	ADDM	W2,LOD37	;COUNT OF BLOCKS LOADED
	JRST	T.1		;LOAD AS DATA
SUBTTL	 BLOCK TYPE 100 -- .ASSIGN OPERATOR IN MACRO


T.100:	TRNE	FL,R.LIB	;[701] LIBARY SEARCH?
	JRST	T.0		;[701] YES, SKIP THIS.
	PUSHJ	P,RB.1		;READ FIRST WORD
	  JRST	LOAD##		;SHOULD NOT HAPPEN
	PUSH	P,W1		;SAVE FIRST WORD
	PUSHJ	P,RB.2		;GET NEXT PAIR
	  JRST	LOAD##		;SHOULD NOT HAPPEN
	MOVE	W3,W1		;GET VALUE
	MOVX	W1,PT.SGN!PT.SYM	;FLAGS
	PUSHJ	P,R50T6		;SIXBITIZE IT
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED
	  JRST	T.100E		;NOT EVEN IN T\BLE
	  JRST	T.100E		;UNDEFINED STILL
	ADD	W3,2(P1)	;INCREMENT VALUE
	EXCH	W3,2(P1)	;SAVE NEW, GET OLD
	POP	P,W2		;NEW SYMBOL
	PUSHJ	P,R50T6		;SIXBITIZE
	PUSHJ	P,@T.2TAB+1	;GLOBAL DEFINITION
	JRST	T.100R		;RETURN

T.100E:	POP	P,T1		;REMOVE JUNK FROM STACK
E$$UAR::.ERR.	(MS,.EC,V%L,L%W,S%W,UAR,<Undefined assign for symbol >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,W2)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

T.100R:	PUSHJ	P,RB.1		;IGNORE REST OF BLOCK
	  JRST	LOAD##		;UNTIL WE GET HERE
	JRST	T.100R		;LOOP
SUBTTL	BLOCK TYPE 774, 775, 776 - RADIX50 SYMBOL FILES


;	----------------
;	!  77? ! COUNT !
;	----------------
;	!    .JBSYM    !
;	----------------
;	!    .JBUSY    !
;	----------------
;	!    SYMBOLS   !
;	----------------

T.774::!		;NUMERICALLY SORTED SYMBOL FILE
T.775::!		;ALPHABETICALLY SORTED SYMBOL FILE
T.776::			;UNSORTED SYMBOL FILE

	HRRZI	R3,1(W1)	;WORD COUNT + HEADER
	MOVEI	T2,LN.IO	;NO. OF WORDS REQUIRED
	PUSHJ	P,DY.GET##	;TO HOLD LOOKUP BLOCK
	MOVEM	T1,IO.PTR+TC	;ON TEMP CHAN
	HRLZI	T3,OPENBL	;SAME AS DC CHAN
	HRRI	T3,(T1)
	ADDI	T2,-1(T1)	;END OF BLT
	BLT	T3,(T2)		;MOVE DATA BLOCK
	MOVEI	T2,.IODPR	;BUT MODE IS DUMP
	MOVEM	T2,I.MOD(T1)
	SETZM	I.BUF(T1)	;ZERO DATA WORDS
	SETZM	I.DVZ(T1)	; NOT REQUIRED
	SETZM	I.RNG(T1)
	MOVSI	T2,(Z TC,)	;CHAN
	MOVEM	T2,I.CHN(T1)
	SETZM	I.SWT(T1)
	MOVEI	T1,TC		;CHAN#
	MOVEM	T1,IO.CHN	;OF NEXT LOOKUP
	PUSHJ	P,DVCHK.##	;MAKE SURE ITS A DSK
	MOVE	T1,IO.CHR	;GET IT
	TXNN	T1,DV.DSK
	JRST	E02FLE		;[2301] WILL DO FOR NOW
	PUSHJ	P,DVOPN.##	;OPEN DEVICE
	LOOKUP	TC,I.RIB(T1)
	  JRST	E02FLE		;[2301] FAILED
;HERE WHEN FILE OPENED. ALLOCATE A 1P BUFFER AND READ IT.
;MUST DO IT OURSELVES BECAUSE WE READ THE FILE BACKWARDS.

	MOVEI	T2,1000		;BUFFER OF ONE PAGE
	PUSHJ	P,DY.GET##
	MOVE	R2,T1		;SAVE ADDRESS
	HRLI	R2,R1		;SETUP @ POINTER TO BUFFER
	SETZ	R1,		;FLAG NEED NEW INPUT UUO
T776A:	PUSHJ	P,T776RD	;GET VALUE OF NEXT SYMBOL
	MOVE	W3,T1		;STORE AWAY
	PUSHJ	P,T776RD	;GET SYMBOL ITSELF
	MOVE	W2,T1		;PUT IN RIGHT PLACE
	LDB	P1,[POINT 4,W2,3]	;TYPE CODE
	PUSHJ	P,R50T6		;SIXBITIZE
	JUMPE	P1,T776T	;TITLE BLOCK
	TRNE	FL,R.LIB!R.INC	;STILL IN LIB SEARCH OR /INC MODE?
	  JRST	T776A		;YES, IGNORE ALL BUT TITLES
	MOVX	W1,PT.SGN!PT.SYM
	.JDDT	LNKOLD,T776A,<<CAMN	W2,$SYMBOL>>
	PUSH	P,R		;[702] SAVE R
	PUSHJ	P,@T.2TAB(P1)	;DO RIGHT THING FOR SYMBOL
	POP	P,R		;[702] RESTORE R
	JRST	T776A
;HERE TO READ NEXT WORD FROM 1P INTERNAL BUFFER

T776RD:	SOJL	R1,T776R1	;POINT TO NEXT WORD
	MOVE	T1,@R2		;LOAD VALUE
	POPJ	P,		;RETURN IT

T776R1:	JUMPE	R3,T776R3	;QUIT IF NO MORE DATA
	MOVE	T1,R3		;ELSE GET REMAINING SIZE
	IDIVI	T1,1000		;CONVERT TO PAGES & REMAINDER
	JUMPN	T2,T776R2	;SKIP THIS IF FIRST TIME
	MOVEI	T2,1000		;SIZE OF WINDOW TO READ IN
	SUBI	T1,1		;REALLY WANT PREVIOUS PAGE
T776R2:	LSH	T1,2		;4 BLOCKS PER PAGE
	USETI	TC,1(T1)	;GO TO CORRECT BLOCK
	SUBI	R3,(T2)		;UPDATE WORDS LEFT
	MOVE	R1,T2		;REMEMBER HOW MUCH DATA IN BUFFER
	MOVN	T1,T2		;FORM IOWD FOR READ-IN
	HRLZ	T1,T1		;..
	HRRI	T1,-1(R2)	;..
	SETZ	T2,		;TERMINATE IOWD LIST
	IN	TC,T1		;READ THE PAGE IN
	  CAIA
	JRST	E02EIF		;[1174] HANDLE ERROR
	JUMPN	R3,T776RD	;DONE UNLESS LAST TIME
	SUBI	R1,3		;NEED TO FAKE POINTERS
	ADDI	R2,3		;SO WON'T READ HEADER WORDS
	JRST	T776RD		;GO RETURN THE DATA

T776R3:	POP	P,(P)		;REMOVE JUNK RETURN ADDR
	MOVEI	T1,-3(R2)	;ADDR OF BUFFER TO RETURN
	MOVEI	T2,1000		;SIZE
	PUSHJ	P,DY.RET##
	PUSHJ	P,DVZAP.##	;RETURN TC BLOCK
	JRST	EOF1##		;END OF SYMBOL FILE

E02FLE::PUSH	P,IO.CHN	;[2301] REMEMBER WHAT # FAILED
	.ERR.	(LRE,,V%L,S%D,L%D,FLE) ;[2301]

E02EIF::PUSH	P,[TC]		;[1174] INDICATE ERROR ON CHANNEL TC
	.ERR.	(ST,0,V%L,L%F,S%F,EIF) ;[1174] 'ERROR ON INPUT FILE'
;HERE ON A "TITLE" (RADIX50 CODE 0)

T776T:	HRR	FL,FLAGS	;MAKE SURE FLAGS ARE CORRECT
	TRNN	FL,R.LIB!R.INC	;NEED AN EXCUSE TO LOAD SYMBOLS?
	  JRST	T776T1		;NO, MAKE SURE NOT IN /EXCLUDES
	PUSHJ	P,INCCHK	;YES, DO WE HAVE SUCH AN EXCUSE?
	  JRST	T776A		;NO, SKIP THIS BLOCK OF SYMBOLS
	TRZ	FL,R.LIB!R.INC	;YES, CLEAR 'DON'T LOAD' FLAGS
	JRST	T776OK		;AND GO LOAD THIS

T776T1:	PUSHJ	P,EXCCHK	;IS THIS MODULE IN /EXCLUDES?
	  JRST	[TRO	FL,R.LIB	;YES, DON'T LOAD THIS
		JRST	T776A]		;UNTIL NEXT TITLE BLOCK

;HERE WHEN OK TO "LOAD" THIS MODULE'S SYMBOLS. PUT TITLE IN LS.
T776OK:	MOVEM	W2,PRGNAM	;STORE FOR ERROR MESSAGES
E02LMN::.ERR.	(MS,.EC,V%L,L%I5,S%I,LMN) ;[1174] GIVE INFO MESSAGE
	.ETC.	(SBX,.EC!.EP,,,,PRGNAM) ;[1303]
	.ETC.	(STR,.EC,,,,,< from file >) ;[1303]
	.ETC.	(FSP,,,,,DC) ;[1303]
	MOVE	T1,LSYM		;[662] POINTER TO END OF LS AREA
	MOVEM	T1,NAMPTR	;[662] REMEMBER WHERE THIS MODULE STARTS
	AOS	PRGNO		;ONE MORE PROGRAM NAME
	.JDDT	LNKOLD,T776OK,<<CAMN	W2,$NAME>>
	MOVX	W1,PT.SGN!PT.TTL	;SET FLAGS
	PUSHJ	P,LS.ADD##	;PUT IN LOCAL SYMBOL TABLE
	SETZM	LSTGBL		;[2255] NOT A REAL SYMBOL SO CLEAR
	SETZM	LSTLCL		;[2255] GLOBAL AND LOCAL POINTERS
	MOVX	W1,S.TTL!S.PRC	;PROCESSOR TRIPLET
	MOVE	W2,['LINK  ']	;SYMBOL FILES CREATED BY LINK
	MOVSI	W3,-1		;LINK IS PROCESSOR -1
	PUSHJ	P,LS.ADD##	;ADD TO SYMBOL AREA
	MOVX	W1,S.TTL!S.CRE	;GET DATE TIME STUFF
	LDB	T2,[POINT 12,FCRE,35]	;GET LOW 12 BITS OF DATE
	LDB	T1,[POINT 3,FEXT,20]	;GET HIGH 3 BITS
	DPB	T1,[POINT 3,T2,23]	;MERGE THE TWO PARTS
	LDB	T1,[POINT 11,FCRE,23]	;GET TIME
	IMULI	T1,^D60		;CONVERT TIME TO SECONDS
	HRLZ	W2,T2		;STORE DATE IN TRIPLET
	HRR	W2,T1		;AND TIME IN SECONDS
	SETZ	W3,		;DON'T KNOW WHAT VERSION CREATED
	PUSHJ	P,LS.ADD

	PUSH	P,R1		;SAVE R1 OVER TTLREL
	PUSHJ	P,TTLREL	;PUT OUT REL FILE DESCRIPTOR INFO
	POP	P,R1		;RESTORE OUR WORD COUNT

	MOVX	W1,S.TTL!S.SEG!S.LST	;LOW/HIGH REL COUNTERS
	SETZB	W2,W3		;SET BOTH ZERO
	PUSHJ	P,LS.ADD

	JRST	T776A		;START READING IN SYMBOLS
SUBTTL	BLOCK TYPE 777 - MACRO UNIVERSAL FILE


;	----------------
;	!  777 ! COUNT !
;	----------------
;	! SYMBOL TABLE !
;	----------------


T.777:
E$$UNS::.ERR.	(MS,.EC,V%L,L%F,S%F,UNS,<Universal file REL block (type 777) not supported>) ;[1174]
	.ETC.	(NLN,.EC)	;[1174]
	.ETC.	(STR,.EC,,,,,<from file >) ;[1174]
	.ETC.	(FSP,,,,,DC)
SUBTTL	RELOCATION AND BLOCK INPUT - OLD BLOCKS


;ENTER WITH WC = WORD COUNT IN AOBJN FORM
;LEFT HALF NEGATIVE NUMBER OF WORDS LEFT IN BLOCK
;RIGHT HALF NEGATIVE NUMBER OF WORDS IN CURRENT SUB-BLOCK
;RB = BYTE WORD UNLESS END OF SUB-BLOCK, IN WHICH CASE RB WILL BE SET UP

;READS TWO WORDS USING RB.1
;RETURNS FIRST WORD IN W2, SECOND WORD IN W1
RB.2::	PUSHJ	P,RB.1		;READ FIRST WORD OF PAIR
	  POPJ	P,		;ERROR RETURN
	MOVE	W2,W1		;SAVE IT IN W2
	TRNE	WC,377777	;SEE IF SECOND WORD EXISTS
	JRST	RWORD1		;INPUT SECOND WORD OF PAIR AND RETURN
	SETZ	W1, 		;NO,RETURN ZERO
	JRST	CPOPJ1		;BUT GIVE SKIP RETURN

;RETURN WITH R = POINTER TO RELOCATION BLOCK
;W1 = WORD READ FROM BINARY FILE
;ALSO USES T1

RB.1::	TRNN	WC,377777	;TEST FOR END OF BLOCK
	POPJ	P,		;NON-SKIP RETURN
RWORD1:	AOBJN	WC,RWORD2	;JUMP IF NOT CONTROL WORD
	PUSHJ	P,D.IN1##	;GET 1 WORD
	MOVE	RB,W1		;SAVE RELOCATION BITS
	HRLI	WC,-^D18	;RESET WORD COUNT
RWORD2:	PUSHJ	P,D.IN1##	;READ 1 WORD
	SETZ	R,		;CLEAR OLD RELOCATION BITS
	LSHC	R,1		;GET NEXT
	SETZM	LSTLRV		;[1466]
	JUMPE	R,RWORD3	;NO RELOCATION REQUIRED
	HLRZ	T1,W1		;GET UNRELOCATED ADDRESS
	SKIPE	RC.CUR		;GET INDEX TO CURRENT PSECT
	JRST	[MOVE R,RC.CUR
		JRST RWORD5]
	TRNN	FL,R.TWSG	;POSSIBLE TWO SEGMENTS?
	JRST	RWORD5		;NO
	MOVE	T2,SO.S2	;GET START OF HIGH SEGMENT
	CAILE	T2,NEGOFF(T1)	;IN HIGH SEG?
	JRST 	RWORD5		;NO
	ADDI	R,1		;YES, INC SEG POINTER
	SUB	T1,T2		;REMOVE BASE ADDRESS
RWORD5:	MOVE	R,@RC.TB	;PICKUP POINTER TO DATA BLOCK
	SKIPGE	RC.AT(R)	;[1155] DOES THIS PSECT HAVE AN ORIGIN?
	 PUSHJ	P,R.ERR		;[2247] NO, CAN'T USE IT
	TRNN	FL,R.RED	;[2223] DOING /REDIRECT?
	SKIPE	RC.CUR		;[1155] RELOCATE WRT A PSECT?
	JRST	[ADD T1,RC.CV(R);[1155] YES, PSECTS ARE SIMPLE
		JRST RWORD4]	;[1155] GO STORE AND CHECK RH RELOCATION
	MOVE	T2,RC.SG(R)	;[1155] OLD LOWSEG/HIGHSEG, GET SEGMENT #
	MOVE	T2,LL.S0(T2)	;[1155] GET ORIGIN OF SEGMENT
	ADD	T2,RC.CV(R)	;[1155] ADD CURRENT VALUE OF RELOC. COUNTER
	SUB	T2,RC.IV(R)	;[1155] T2 NOW HAS RELOCATION FACTOR
	ADDI	T1,0(T2)	;[1155] RELOCATE THE HALF WORD
RWORD4:	HRL	W1,T1		;[1155] STORE THE RESULT
	MOVEM	T1,LSTLRV	;[1466]
	MOVX	R,1B1		;[1155] CLEAR R BUT REMEMBER RELOCATABLE
;HERE TO CHECK RIGHT RELOCATION

RWORD3:	SETZM	LSTRRV		;[1204] ASSUME ABSOLUTE
	LSHC	R,1		;GET RIGHT RELOCATION
	TRNN	R,-1		;SEE IF RELOCATABLE
	JRST	CPOPJ1		;NOT RELOCATED
	HRRZ	T1,W1		;GET UNRELOCATED ADDRESS
	SKIPE	RC.CUR		;GET INDEX INTO CURRENT PSECT
	JRST 	[MOVE R,RC.CUR
		JRST RWORD6]
	TRNN	FL,R.TWSG	;POSSIBLE TWO SEGMENTS?
	JRST	RWORD6		;NO
	MOVE	T2,SO.S2	;GET START OF HIGH SEGMENT
	CAILE	T2,NEGOFF(T1)	;IN HIGH SEG?
	JRST	RWORD6		;NO
	ADDI	R,1		;YES, INC SEG POINTER
	SUB	T1,T2		;REMOVE BASE ADDRESS
RWORD6:	HRR	R,@RC.TB	;PICKUP POINTER TO DATA BLOCK
	TLO	R,(1B1)		;MARK RELOCATION
	SKIPGE	RC.AT(R)	;[1155] DOES THIS PSECT HAVE AN ORIGIN?
	 PUSHJ	P,R.ERR		;[2247] NO, CAN'T USE IT
	TRNN	FL,R.RED	;[2223] DOING /REDIRECT?
	SKIPE	RC.CUR		;[1155] RELOCATE WRT A PSECT?
	JRST	[ADD T1,RC.CV(R);[1155] YES, PSECTS ARE SIMPLE
		JRST RWORD8]	;[1155] GO STORE
	MOVE	T2,RC.SG(R)	;[1155] OLD LOWSEG/HIGHSEG, GET SEGMENT #
	MOVE	T2,LL.S0(T2)	;[1155] GET ORIGIN OF SEGMENT
	ADD	T2,RC.CV(R)	;[1155] ADD CURRENT VALUE OF RELOC. COUNTER
	SUB	T2,RC.IV(R)	;[1155] T2 NOW HAS RELOCATION FACTOR
	ADD	T1,T2		;[1204] COMPUTE FULL-WORD RESULT
RWORD8:
	MOVEM	T1,LSTRRV	;[1204] STORE FOR BREAK CHECKS
	HRR	W1,T1		;[1155] STORE THE RESULT
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,
;[1000] R.CUR--ROUTINE TO RELOCATE ADDRESS IN T1 WITH RESPECT TO
; CURRENT PSECT.  IF RC.CUR IS ZERO, THE ADDRESS IS RELOCATTED IN
; .LOW. OR .HIGH.
; ENTER WITH:		T1/ADDR
; RETURN WITH:		T1/ABS. ADDR.
; USES ACS:		T1, T2, R
R.CUR::	SKIPE	R,RC.CUR	;[1716] GET CURRENT PSECT, IF ANY
	JRST	R.CUR1		;[1716] HAVE PSECT INDEX, GO USE IT
	MOVEI	R,1		;[1716] THERE'S NONE, ASSUME PSECT 1 (.LOW.)
	TRNN	FL,R.TWSG	;IT'S ZERO, TWO SEGMENTS?
	JRST	R.CUR1		;NO,
	MOVE	T2,SO.S2	;YES, GET START OF HIGH SEGMENT
	CAILE	T2,NEGOFF(T1)	;IN HIGH SEG?
	JRST 	R.CUR1		;NO
	MOVEI	R,2		;[1716] YES, USE .HIGH. PSECT
	SUB	T1,T2		;REMOVE BASE ADDRESS
R.CUR1:	MOVE	R,@RC.TB	;PICKUP POINTER TO DATA BLOCK
	MOVE	T2,RC.CV(R)	;GET CURRENT VALUE
	TLNN	FL,R.RED	;[2223] DOING /REDIRECT?
	 SKIPE	RC.CUR		;[2223] OR PSECTS?
	 CAIA			;[2223] YES, LEAVE IT ALONE
	SUB	T2,RC.IV(R)	;REMOVE BASE ADDRESS
	SKIPGE	RC.AT(R)	;[761] RELOCATABLE PSECT?
	 PUSHJ	P,R.ERR		;[2247] YES, ERROR
	ADD	T1,T2		;[1717] GET RELOCATED VALUE
	MOVE	T2,RC.SG(R)	;GET SEGMENT #
	ADD	T1,LL.S0(T2)	;MAKE RELATIVE TO SEG ORIGIN
	POPJ	P,		;RETURN

R.ERR::	PUSH	P,T1		;[2247] Save a register
	HRRZ	T1,R		;[2247] Get the RC block pointer
	CAMN	T1,SG.TB+1	;[2247] IS THIS .LOW.?
	 JRST	R.LOW		;[2247] YES, GO SET IT RIGHT
	MOVE	T1,RC.NM(R)	;[2247] GET PSECT NAME
E$$SRP::.ERR.	(MS,.EC,V%L,L%F,S%F,SRP,</SET: switch required for psect >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,T1) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

R.LOW:	MOVX	T1,AT.RP	;[2247] Get the relocatable attribute
	ANDCAM	T1,RC.AT(R)	;[2247] Clear the attribute
	POP	P,T1		;[2247] Restore register
	POPJ	P,		;[2247] And return
;CHKSEG - ROUTINE TO SEE IF ADDRESS IS REQUIRED OR NOT
;ENTER WITH ADDRESS IN W1
;RETURNS
;+1	REQUIRED
;+2	NOT REQUIRED

CHKSEG::TRNN	FL,R.TWSG	;[1754] MUST BE A TWO SEGMENT PROGRAM
	POPJ	P,
	SKIPE	LL.S2		;AND MUST HAVE SETUP HIGH SEG
	CAMGE	W1,LL.S2	;IN HIGH
	JRST	[TRNN	FL,R.LSO	;WANT LOW?
		AOS	(P)		;NO
		POPJ	P,]
	TRNN	FL,R.HSO	;WANT HIGH?
	AOS	(P)		;NO
	POPJ	P,


E$$RBS::.ERR.	(MS,.EC,V%L,L%F,S%F,RBS,<REL block type >) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,T1)
	.ETC.	(STR,.EC,,,,,< too short>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]

IFN DEBSW,<
$NAME::	.-.		;CHANGE TO REQUIRED SIXBIT PROG NAME
>

OLDLIT:	END