Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - 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	6-Jan-83


;COPYRIGHT (C) 1974, 1983 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==5		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==2026		;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.

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,.+3		;NOT SYMBOLIC
	MOVEI	T1,1		;BLOCK TYPE INCASE ERROR
	PUSHJ	P,T.1S		;SYMBOLIC IF BIT 0 SET
IFN FTFRK2,<
	HLL	W1,LSTRRV	;[1412]
> ;[1473]
	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

IFE FTFRK2,<
	MOVE	T1,LSTRRV	;[1204] GET LAST RH WORD
	CAMG	T1,[1,,0]	;[1204] WAS IT TOO BIG?
	CAMLE	W1,[1,,0]	;[1204] OR IS FIRST UNUSED ADDR TOO BIG?
	PUSHJ	P,E$$PTL	;[1204] YES, ERROR
> ;[1473] IFE FTFRK2
IFN FTFRK2,<
	HLRZ	T1,W1		;[1412] SECTION OF START
	HLRZ	T2,P3		;[1412] SECTION OF END
	DPB	T1,[POINT 9,NONZER,26]
				;[1412] NOTE CURRENT SECTION
	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
> ;[1473] IFN FTFRK2
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
	MOVE	T1,RC.SG(R)	;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:MOVE	T1,LSTRRV	;[1300] GET LAST RH WORD
	CAMG	T1,RC.LM(R)	;[1300] WAS IT TOO BIG?
	CAMLE	W1,RC.LM(R)	;[1300] OR 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
>
	SKIPE	PAG.S1		;PAGING?
	JRST	T.1LP		;YES, SEE IF IN CORE
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
T.1L1:	ADD	P3,LC.LB	;FINALLY FIX THIS INCASE CORE MOVED
	JRST	T1ADX2		;[1776] +2 SKIP RETURN

;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
;[1450] Recalculate requested window size, move IFE TOPS20.
IFE TOPS20,<
	CAILE	T1,2*LN.WD-1	;[732] USE SMALLER OF THE TWO
	MOVEI	T1,2*LN.WD-1	;[732]
	MOVE	P2,T1		;[732]
> ;[1401] END OF IFE TOPS20
IFN TOPS20,<
	MOVE	T1,0(P)		;[1450] HOW MUCH NEEDED?
	SUB	T1,-1(P)	;[1450]
	CAILE	T1,2*LN.WD-1	;[1450] USE SMALLER OF THE TWO
	MOVEI	T1,2*LN.WD-1	;[1450]
> ;[1450]
	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
IFE TOPS20,<
	CAMG	T1,T2		;[732] NEED MORE THAN WE HAVE?
	JRST	T.1LO1		;[743] NO NEED TO EXPAND CORE
> ;[1401] END OF IFE TOPS20
IFN TOPS20,<
	PUSH	P,T1		;[1401] SET ASIDE SPACE NEEDED
	MOVE	T1,P3		;[1401] BRING IN PART OF THE WINDOW
	MOVEM	T1,LW.LC	;[1401] SET UP WINDOWBOUNDS
	HRL	T1,T1		;[1401] SET UP FIRST,,LAST
	ADD	T1,T2		;[1401]
	HRRM	T1,UW.LC	;[1401]
	PUSHJ	P,LC.IN##	;[1401] SET UP PARTIAL WINDOW
	POP	P,T1		;[1401] GET BACK SPACE NEEDED
	MOVE	T2,UW.LC	;[1401] FIND OUT HOW MUCH MORE WE NEED
	SUB	T2,LW.LC	;[1401]
	SUB	T1,T2		;[1401]
	JUMPLE	T1,T.1LO1	;[1401] NO NEED TO EXPAND CORE
	MOVEI	P2,1(T1)	;[1401] ADDITIONAL SPACE NEEDED
> ;[1401] END OF IFN TOPS20
IFE TOPS20,<
	ADDI	P2,1		;[732] YES, EXPAND FIRST
> ;[1401] END OF IFE TOPS20
	PUSHJ	P,LNKCOR##	;[732] GO ALLOCATE THAT MUCH
	  JFCL			;[742]
T.1LO1:	POP	P,P2		;[742] RESTORE TO REAL LOCATION
IFE TOPS20,<
	POP	P,LW.LC		;[742] WINDOW STARTS AT LOWEST LOCATION
> ;[1401] END OF IFE TOPS20
IFN TOPS20,<
	POP	P,(P)		;[1473]
> ;[1473] IFN TOPS20
	MOVE	T1,LC.AB	;[732] CACULATE WINDOW'S UPPER BOUND
	SUB	T1,LC.LB	;[732] FROM CURRENT CORE LENGTH
	ADD	T1,LW.LC	;[732]
IFE FTFRK2,<
	CAILE	T1,777777	;[732] CHECK FOR OVERFLOW INTO LEFT HALF
	MOVEI	T1,777777	;[732]
> ;[1473] IFE FTFRK2
	MOVEM	T1,UW.LC	;[732] AND UPDATE
	POP	P,P3		;[732]
	JRST	T.1AL0		;[732]
;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:	MOVEI	R,2		;ASSUME HIGH
	CAIE	W3,1		;LOADING FORTRAN DATA STATEMENTS?
	JRST	.+3		;NO,SKIP EDIT 441
	TRNE	FL,R.FHS	;FORCED LOAD TO HIGH SEG?
	JRST	T.1HA		;YES, SO DO IT
	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


T.1HA:	MOVE	R,@SG.TB	;FIXUP R FOR ABS TO HIGH
T.1H:	MOVE	T1,LSTRRV	;[1300] GET LAST RH WORD
	CAMG	T1,RC.LM(R)	;[1300] WAS IT TOO BIG?
	CAMLE	W1,RC.LM(R)	;[1300] OR 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
	HRLI	T2,CPF.RF	;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)

CHKSIZ:	MOVE	W1,LSTRRV	;[1300] GET THE LAST RIGHT RELOC
CHKSZ0:				;[1715]
IFE FTFRK2,<
	CAMLE	W1,[1,,0]	;[1300] IS PROGRAM TOO BIG?
	PUSHJ	P,E$$PTL	;[1300] YES, PRINT THAT ERROR
> ;[1442] IFE FTFRK2
	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

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
	ADD	W1,W2		;GET START ADDRESS IN W1
	SOJA	W3,CPOPJ	;ONE LESS REAL DATA WORD
IFN FTOVERLAY,<
T.1SE:	MOVE	W2,1(P1)	;ITS NOT, GET NAME
	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]
	JRST	T.0C		;GET RID OF BLOCK
>


;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
IFN FTFRK2,<
	TLNN	W1,-1		;[1504] WAS STRANGE ABSOLUTE?
	IOR	W1,LSTRRV	;[1412] NO, INCLUDE ANY SECTION DATA
> ;[1412] IFN FTFR2
	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
	CAMN	W2,0(T1)	;MATCH?
	TXOA	W1,PS.ENT	;YES, SET FLAG
	AOBJN	T1,.-2		;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

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	LSTSYM		;[1140] IN CASE WE DON'T LOAD THIS SYMBOL
	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
;AND LINK THROUGH PREVIOUS BLOCK HEADERS TO NAME POINTER

SY.BH::	TXC	W1,PT.SYM!PT.TTL!PT.BLK	;SET CORRECT FLAGS
	TRNN	FL,R.SYM	;IN LOCAL SYMBOL MODE
	POPJ	P,		;NO
	SKIPN	T1,FBHPTR	;ALREADY SEEN SOME BLOCK HEADERS?
	HRRZ	T1,NAMPTR	;NO, GET POINTER TO LOCAL SYMBOL
	CAMGE	T1,LW.LS	;IN CORE?
	JRST	SY.BHP		;[577] NO, GO GENERATE FIXUP
	SUB	T1,LW.LS	;GET ADDRESS IN CORE
	ADD	T1,LS.LB
	SKIPGE	T2,(T1)		;MUST BE PRIMARY
	TXNN	T2,PT.TTL	;AND A TITLE BLOCK
	JRST	E02SFU		;[1174] NO
	MOVE	T2,LSYM		;GET CURRENT VALUE
	HRLM	T2,2(T1)	;STORE PTR
	MOVEM	T2,FBHPTR	;CURRENT POINTER
	PJRST	LS.ADD##	;PUT IN TABLE

;HERE WHEN LAST ENTRY IN LOCAL BLOCK NAME CHAIN IS PAGED OUT.
;GENERATE A FIXUP AND DO THE WORK LATER.
SY.BHP:	PUSH	P,W3		;[577] SAVE W3 FOR USE BELOW
	MOVE	T2,T1		;[577] RH(T2) = ADDRESS TO FIX UP
	HRLI	T2,SPF.TB	;[577] LH(T2) = TYPE OF FIXUP
	MOVE	W3,LSYM		;[577] W3 = VALUE TO STORE (PTR TO NEXT)
	MOVEM	W3,FBHPTR	;[577] SAVE IT FOR NEXT TIME
	MOVEI	R,FS.SS-FX.S0	;[577] INDICATE FIXING UP LS AREA
	PUSHJ	P,SY.CHP##	;[577] STORE FIXUP UNTIL LS PAGED IN
	POP	P,W3		;[577] RESTORE W3 FOR LS.ADD
	PJRST	LS.ADD		;[577] PUT LOCAL BLOCK NAME IN SYM 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
	HRLZM	P1,LSTSYM	;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
	HRLZM	T1,LSTSYM	;[1213] ARRANGE FOR SY.RQ TO FIND US
;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		;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
	TXNE	W1,FS.FXF	;BUT IF FULL WORD
	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
	HRR	W3,2(P1)	;GET HALF WORD FIXUP VALUE
				;FROM DEFINED SYMBOL
	PUSHJ	P,SY.AST##	;FIXUP EITHER RH OR LH OF 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
	TXNN	W1,PT.EXT	;EXTENDED SYMBOL?
	JRST	SYADSS		;NO
	MOVE	T1,.L(T2)	;YES, BUT WE ONLY CARE ABOUT LONG NAMES HERE
	TXNE	T1,S.SYM
	TXNN	T1,S.LNM	;SO IGNORE COMMON, ETC
	JRST	[TXZ	W1,PT.EXT	;NOT EXTENDED NAME
		JRST	SYADSS]		;SO REMOVE FLAG
IFE .EXSYM,<
;[1174] Replace @SYADSS-2L	DZN	1-Jun-79
E01ESN::.ERR.	(MS,,V%L,L%F,S%F,ESN) ;[1174]
>
	HRRZ	W3,T2		;POINT TO SYMBOL
SYADSS:	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
	HRLM	T1,LSTSYM	;[1327] LSTSYM 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
SY.RQ2::PUSH	P,[0]		;VALUE OF REQUEST (PRIMARY)
	PUSHJ	P,SY.FX0##	;PUT IN FIXUP TABLE
	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 W3 IS POINTER (LSTSYM) TO EITHER OR BOTH GLOBAL AND LOCAL DEFINITIONS
;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.FXL	;[612] 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 
	HRLM	T1,LSTSYM	;[1243] LSTSYM 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::HRRZ	T3,W3		;[1000] START OF CURRENT CHAIN
	HRRZ	T1,2(P1)	;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
SY.RU2:	HRRZ	T2,T3		;[707] GET NEXT LINK
	PUSHJ	P,SEGCHK##	;SETUP ADDRESS FOR CORRECT SEGMENT
	  JRST	SY.PGU		;NOT ALL OF CHAIN IN CURRENT WINDOW
	HRRZ	T3,(T2)		;GET NEXT ADDRESS
	JUMPN	T3,SY.RU2	;[707] 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:	HRRZ	W3,T1		;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	.+3		;NORMAL RETURN
	PUSHJ	P,SY.RQS	;SYMBOL TABLE FIXUP, SEE IF WE NEED IT
	  JRST	SY.RUX		;RESTORE STACK AND EXIT
SY.RA::	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
	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	.+3		;NORMAL RETURN
	PUSHJ	P,SY.RQS	;SYMBOL TABKE FIXUP, CONVERT TO POINTER
	  POPJ	P,		;NO LOADED LOCAL, IGNORE
	HRR	W1,2(P1)	;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
	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
	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:	HRLZ	W3,RC.CV(R)	;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:	HLRZ	T2,NAMPTR	;GET REL ADDRESS OF NAME 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
	AOSE	W2		;LOW SEG SPECIFIED?
	HLLZM	W2,1(T2)	;YES, STORE IT (AOSE KEEPS LH)
	AOSE	W3		;HOW ABOUT HIGH SEG?
	HLLZM	W3,2(T2)	;YES, STORE IT
	JRST	LOAD##		;DONE

;HERE IF BLOCK PAGED OUT. GENERATE A FIXUP.
T.3FIX:	HLR	W3,W2		;SETUP FIXUP AS HI,,LOW
	HRLI	T2,SPF.SL	;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
	HRLZ	W3,RC.CV(R)	;SETUP CURRENT HISEG VALUE
	MOVE	R,SG.TB+1	;GET LOWSEG BLOCK
	HRLZ	W2,RC.CV(R)	;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)
	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
	HRLZ	W3,T2		;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
	HRLZ	W2,RC.CV(R)	;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
	HRLZ	W2,T2		;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
T.3L1:	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
	HRLZ	W3,T2		;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
	HRLZ	W3,RC.CV(R)	;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
	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
	PUSHJ	P,DY.GET##	;IN DYNAMIC AREA
	AOS	RC.NO		;[1304] COUNT ONE MORE
	SOS	RC.FRE		;[1304] AND ONE LESS HOLE
	MOVEI	R,2		;[1304] NOW FOR RC TABLE ENTRIES
	SKIPN	@RC.TB		;[1304] SLOT ALREADY OCCUPIED?
	JRST	[ MOVX	T2,<2,,2>  ;[1304] NO, SIMPLE CASE FOR MAP
		  MOVEM	T2,@RC.MAP ;[1304] STORE IT	
		  JRST SETRC3]	   ;[1304]
	PUSHJ	P,T.3FM		;[1304] FIND THE MODULE
SETRC2:	MOVE	T2,RC.NO	;[1304] GET NEW SLOT NUMBER
	HRRM	T2,@RC.MAP	;[1304] FIX UP MAP
	MOVEI	R,2		;[1304] BACK TO HIGH SEG SLOT
	PUSH	P,@RC.TB	;[1304] STACK CURRENT OCCUPANT
	PUSH	P,[SETRCY]	;[1304] RET ADDRESS TO STORE ABOVE RC POINTER
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
SETRCY:	SOSGE	RC.FRE		;ANY FREE SPACE?
	PUSHJ	P,.SETEX##	;NO, MUST EXPAND
	MOVE	R,RC.NO		;[753] GET NUMBER
	MOVEI	T1,2		;[1304] RC.TB FOR .HIGH. IS 2
	HRL	T1,RC.NO	;[1304] RC.NTB IS CURRENT SLOC
	MOVEM	T1,@RC.MAP	;[1304] STORE NEW MAP ENTRY
	POP	P,@RC.TB	;[1304] STORE IT
	POPJ	P,		;[1304] RETURN

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]

T.3FM:	HRRZ	T2,@RC.MAP	;[1304] GET MAP FOR THIS PSECT NUMBER
	CAIN	T2,2		;[1304] POINT TO SECOND SLOT?	
	POPJ	P,		;[1304] YES, FOUND IT
	AOS	R		;[1304] NO, INCREMENT R
	CAMGE	R,RC.NO		;[1304] STILL VALID?
	JRST	T.3FM		;[1304] YES, TRY AGAIN
	PUSHJ	P,E$$IPX	;[1304] NO??

;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
	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 FTFRK2,<
	SKIPE	EXTFLG		;[1442] NOT IF EXT ADDR!
	JRST	E$$NHN##	;[1442]
> ;[1442] IFN FTFRK2

IFN TOPS20&FTFORK,<
	MOVE	1,LL.S2		;ORIGIN ADDRESS
	LSH	1,-9			;IN PAGE #
	HRL	1,HC.FRK	;SOURCE FORK IS INFERIOR ONE
	MOVE	2,HC.LB
	LSH	2,-9		;DESTINATION PAGE
	HRLI	2,(1B0)		;CURRENT FORK
	SETZ	3,
	PMAP
>
	POPJ	P,		;RETURN

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,RB.1		;[1204] 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
	PUSHJ	P,CHKSIZ	;[1300] CHECK FOR PSECT TOO BIG
	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
	PUSHJ	P,CHKSIZ	;[1300] CHECK FOR PSECT TOO BIG
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
	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]
	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
	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:	HRRZ	T1,NAMPTR	;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)
	HRRM	T2,2(T1)	;FILL IN POINTER
T.5LP:	HLRZ	T1,NAMPTR	;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	T.5LP		;NO
	TRZN	FL,R.FHS	;SLIGHT PROBLEM IF FORCED HIGH
	JRST	.+4		;AND A SINGLE SEG PROG
	HLRZ	T2,1(T1)	;AS PC IN .LOW. IS IN HISEG
	CAMGE	W1,T2		;SO UNLESS LOW PC EQUAL OR GREATER
	SETZB	W1,1(T1)	;ASSUME NO LOW CODE FOR THIS MODULE
	HRRM	W1,1(T1)	;STORE LOW
	TRNN	FL,R.LSO	;LOW SEGMENT ONLY LOADED?
	TRNN	FL,R.TWSG	;WAS THIS A TWO SEG PROG?
	SETZB	W2,2(T1)	;NO, CLEAR HIGH MARKER
	SKIPE	2(T1)		;IF THERE  WAS HIGH SEEN
	HRRM	W2,2(T1)	;STORE HIGH
	SKIPN	RC.CUR		;DOING PSECT
	JRST	T.5RET		;NO
	MOVE	T2,LSYM
	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
	MOVE	R,RC.NO		;START AT END
	MOVX	W1,PT.SGN!PT.EXT!PT.TTL!PT.PSC ;[711] MARK BLOCK
T.5PSA:	MOVE	T1,@RC.TB	;RC BLOCK
	MOVX	T2,AT.PS	;[1132] FLAG FOR PSECT SEEN IN THIS MODULE
	TDNN	T2,RC.AT(T1)	;[1132] DID WE SEE THIS PSECT IN THIS MODULE?
	JRST	T.5PSB		;NO
	ANDCAB	T2,RC.AT(T1)	;[1132] CLEAR FLAG FOR NEXT TIME
	MOVE	W2,RC.NM(T1)	;GET NAME
	HRLZ	W3,RC.CV(T1)	;ORIGIN
	HRR	W3,RC.HL(T1)	;TOP
	MOVE	T3,RC.HL(T1)	;[1132] GET HIGHEST SEEN
	TXNN	T2,AT.OV	;[1132] OVERLAID PSECT?
	CAMG	T3,RC.CV(T1)	;[1132] OR LOWER THAN WHAT WE HAVE?
	JRST	T.5PSD		;[1132] YES, DONE UPDATE RC.CV
	MOVEM	T3,RC.CV(T1)	;[1132] UPDATE CV FOR NEXT MODULE
T.5PSD:	PUSHJ	P,LS.ADD##	;PUT IN LOCAL TABLE
	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
	SKIPN	DCBUF		;SPECIAL INCORE READS DONE?
	JRST	T5FIN##		;YES, RESET INPUT BUFFER
	JRST	T.LOAD##	;SEE IF IN /SEARCH OR NOT
;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



;Insert @ T.5ENT+23L	JNG	8-May-76
;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
	HRLZ	P1,T1		;FORM TRANS WORD
	HRRI	P1,-1(T2)	;FIRST,,LAST
	MOVE	T1,P1		;WHERE EXPECTED
	PUSHJ	P,LS.OUT##	;OUTPUT WINDOW
IFE FTFRK2,<
	HRRZI	T1,1(P1)	;HIGHEST +1 =NEW LOWEST
> ;[1536]
IFN FTFRK2,<
	HRR	T1,P1		;[1536] CALCULATE NEW LOWEST
	HLL	T1,LW.LS	;[1536] PICK UP OLD LOWEST SECTION
	HLRZ	T2,P1		;[1536] COMPARE LAST WITH FIRST
	CAILE	T2,(P1)		;[1536] LAST GTR FIRST?
	ADD	T1,[1,,0]	;[1536] NO, CROSSED SECTION BOUND
	AOS	T1		;[1536] NEW LOWEST=OLD HIGHEST+1
> ;[1536]
	SUB	T1,LW.LS	;MINUS INITIAL
	ADDM	T1,LW.LS	;NEW INITIAL
	ADD	T1,LS.LB	;NEW INCORE BASE
	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 (LH)
;WORD 3		LSYM
;

T.5PAG:	HRRZ	T2,NAMPTR	;AND REL ADDRESS IN SYMBOL TABLE
	HRLI	T2,SPF.TL	;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,,NAMPTR (RH)
;WORD 3		HIGH LOC,,LOW LOC
;
;ENTER WITH
;W1 = LOW LOC
;W2 = HIGH LOC

T.5PSG:	TRNN	FL,R.LSO	;LOW SEGMENT ONLY LOADED?
	TRNN	FL,R.TWSG	;WAS THIS A TWO SEG PROG?
	SETZ	W2,		;NO, CLEAR HIGH MARKER
	HLRZ	T2,NAMPTR	;REL ADDRESS IN SYMBOL TABLE
	HRLI	T2,SPF.SG	;INDEX
	HRLZ	W3,W2		;HIGH IN LEFT
	HRR	W3,W1		;LOW IN RIGHT
	MOVEI	R,FS.SS-FX.S0	;SET INDEX
	PUSHJ	P,SY.CHP##	;PUT IN LIST
	JRST	T.5RET		;AND RETURN
;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
	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
	SETZM	FBHPTR		;NO LOCAL BLOCKS YET
	.JDDT	LNKOLD,T.6OK,<<CAMN	W2,$NAME>>
E$$LMN::.ERR.	(MS,.EC,V%L,L%I5,S%I,LMN,<Loading module >) ;[1174]
	.ETC.	(SBX,.EC!.EP,,,,PRGNAM) ;[1303]
	.ETC.	(STR,.EC,,,,,< from file >) ;[1303]
	.ETC.	(FSP,,,,,DC) ;[1303]

;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]
;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
	HRR	W2,T1		;SO MAP CAN WORK OUT LENGTH
	SETZ	W3,		;NO HIGH
	PUSHJ	P,LS.ADD##
	MOVE	W2,['.COMM.']	;NAME OF COMMON
	HRL	W3,BLCOMM	;LENGTH IN LEFT HALF
	HRR	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
IFN .EXSYM,<
	TLNN	T2,770000	;SYMBOL OR POINTER?
	JRST	[TLNN	W2,770000	;IS W2 A POINTER TOO?
		PUSHJ	P,NAMCMP##	;YES, SEE IF A MATCH
		JRST	.+3		;NO, TRY NEXT
		JRST	CPOPJ1]		;A MATCH!
> ;END OF IFN .EXSYM
	CAMN	W2,T2		;TEST
	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	LSTSYM		;NOT A REAL SYMBOL SO CLEAR POINTER
	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!S.LST	;LOW/HIGH REL COUNTERS
	MOVEI	R,1		;LOW SEG FIRST
	MOVE	R,@RC.TB	;PICKUP RELOCATION POINTER
	HRLZ	W2,RC.CV(R)	;CURRENT VALUE
	MOVEI	R,2		;NOW FOR HIGH
	SKIPN	R,@RC.TB	;PICKUP RELOCATION POINTER
	TDZA	W3,W3		;NO HIGH SEGMENT YET
	HRLZ	W3,RC.CV(R)	;CURRENT VALUE
	MOVE	T1,LSYM		;POINTER TO WHERE IT WILL GO
	HRLM	T1,NAMPTR	;STORE FOR FIXUPS
	PJRST	LS.ADD##	;PUT IN LS AREA AND RETURN
;HERE TO ADJUST THE RELOC TABLES FOR FORCED HIGH SEGMENT LOADING
;SET BY /SEGMENT:HIGH

T.6RC:	SETZ	W1,		;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
IFE TOPS20,<			;[1772]
	PUSHJ	P,RB.2		;READ POSSIBLE TWO DATA WORDS
	  JRST	[MOVEI	T1,7
		 JRST	E$$RBS]		;[1174]
> ;[1765]
IFN TOPS20,<			;[1772]
	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
> ;[1765]
	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
	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
	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.

	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,-377777(T1)	;[1224] 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,-377777(T1)	;[1224] 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

IFN FTFRK2,<

;[1466] SPECIAL CASE COMPLICATION: PSECT ORIGIN MAY BE GREATER THAN 18 BITS.
; TRY TO HANDLE THIS RIGHT IF AND ONLY IF A HALFWORD VALUE OP IS COMING UP.
	SKIPN	EXTFLG		;[1466] EXTENDED ADDRESSING MAYBE?
	JRST	T.11RD		;[1466] DON'T FUSS WITH SPECIAL CASES
	PUSHJ	P,T11SGN	;[1466] GET NEXT HALFWORD
	  PUSHJ	P,E$$NSO	;[1466] NO MORE--FATAL HERE
	JUMPN	T1,T11RD2	;[1466] LEAVE ALL BUT HALFWORD VAL ALONE	
	PUSHJ	P,T11SGN	;[1466] EAT VALUE HALFWORD
	  PUSHJ	P,E$$NSO	;[1466] NOT THERE--DIE

;[1466] IF THE VALUE WAS A LH, LOOK FOR A POSSIBLE SECTION NUMBER IN
; LSTLRV. PUT <1,,SECTNUM> AT -1(W2).  IF IT WAS A RH, LOOK FOR A
; POSSIBLE SECTION NUMBER IN LSTRRV. PUT SECTNUM IN LH OF W1 AND PUT
; SET RIGHT HALF OF -1(W2) TO BE 1.
	JUMPN	P3,[	HLR 	T1,LSTLRV
			HRLI	T1,1
			MOVEM	T1,-1(W2)
			MOVEM	P4,RC.CUR
			JRST	T.11RD ]	;[1466]
	HLL	W1,LSTRRV	;[1466]
	MOVEI	T1,1		;[1466]			
	HRRM	T1,-1(W2)	;[1466]
	MOVEM	P4,RC.CUR	;[1466]
> ;[1466] IFN FTFRK2
	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
T11OK1:	PUSHJ	P,T11SGN	;[1224] EAT SECOND OR ONLY HALF OF VALUE
	  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


E$$NSO::.ERR.	(MS,.EC,V%L,L%F,S%F,NSO,<No store operator in polish block (type 11)>)
	.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.

T11SOP:	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
;	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)>)
	.ETC.	(JMP,,,,,.ETIMF##) ;[1224]

E$$NAP::.ERR.	(MS,.EC,V%L,L%F,S%F,NAP,<No store address in polish block (type 11)>)
	.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
	CAIL	T1,-6		;[1224] SYMBOL STORE OPERATOR?
	CAILE	T1,-4		;[1224]   ..
	JRST	[ILDB	W1,W1		;NO, LOAD UP 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.

	MOVE	T1,6+[	FS.FXF
			FS.FXL
			FS.FXR](T1)	;[612] REMEMBER FIXUP TYPE
	PUSH	P,T1		;[612] 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
	EXCH	W2,W3		;W2 NOW CONTAINS SYMBOL PTRS
	SUBI	W1,1		;BACKUP BYTE PTR
	HLRZ	T1,W2		;LEFT HALF
	IDPB	T1,W1
	IDPB	W2,W1		;RIGHT HALF
	ILDB	T1,W1		;YES, 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,-STRLEN	;[735] STORE OP?
		JRST	T.11G1	;[700] NO, MUST BE PSECT INDEX
		JRST	T.11GE]	;[700] DONE--GO TRY TO EVALUATE
	CAIL	T1,3		;IF OPERATOR
	JRST	T.11G1		;IGNORE IT
	JUMPE	T1,T.11G0	;IGNORE NEXT HALF WORD
	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
IFN FTFRK2,<
	SKIPN	EXTFLG		;[1501] DO DO NOTHING DIFFERENT IF SECT 0
	JRST	T.11RP		;[1501]
	ILDB	W1,W2		;[1501] READ A HALF-WORD
	CAIL	W1,-STRLEN	;[1501] STORE OPERATOR?
	JRST	T.11ST		;[1501] YES
	CAIGE	W1,400000	;[1501] PSECT INFO?
	JRST	T.11RP		;[1501] NO LEAVE IT ALONE
	MOVEI	R,-377777(W1)	;[1501] YES--TAKE IT AT FACE VALUE
	HRRZ	R,@RC.MAP	;[1501] MAP TO INTERNAL PSECT NUMBER
	MOVE	R,@RC.TB	;[1501] PICKUP POINTER TO DATA BLOCK
	MOVE	T1,RC.CV(R)	;[1501]
	MOVEM	T1,LSTRRV	;[1501] PUT IT THERE FOR T.11ST
>;[1501] IFN FTFRK2
T.11RP:	ILDB	W1,W2		;READ A HALF-WORD
	CAIL	W1,-STRLEN	;[735] STORE OPERATOR?
	JRST	T.11ST		;YES
	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	;[603] 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		;[1274] 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
	JUMPE	T1,T.11P0	;0 IS HALF-WORD OPERAND
	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,100 ;[1754]
;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 #
	JUMPGE	W2,.+2
	 SKIPA	T2,[HLRZ T1,@LINKTB]	;FETCH LINK END
	MOVE	T2,[HRRZ T1,@LINKTB]	;FETCH LINK
	MOVMS	W2
	MOVEI	W2,-1(W2)
	SKIPE	T1,LINKTB	;IF LINKTB NOT SET UP THEN LINK IS ZERO
	XCT	T2
	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:		;ADDRESS ALREADY IN T2
	PUSHJ	P,SEGCHK##
	 HALT	.		;I GIVE UP
	MOVE	T1,(T2)
	POPJ	P,

;HERE TO STORE THE FINAL VALUE

T.11ST:
IFN FTFRK2,<
	SKIPN	EXTFLG		;[1463] IF NONZERO SECTIONS INVOLVED
	JRST	T11ST0		;[1463]
	HLRZ	T2,LSTRRV	;[1463] SET UP SECTION NUMBER
	LSH	T2,9		;[1463]
	MOVEM	T2,NONZER	;[1463]
T11ST0: > ;[1463] IFN FTFRK2
	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
	MOVE	W3,-1(W3)	;GET THE VALUE AFTER IGNORING THE FLAG
	PUSHJ	P,@STRTAB+STRLEN(W1)	;[735] CALL THE CORRECT FIXUP ROUTINE
				;ALL DONE, NOW GIVE SPACE BACK
T.11RT:	HRRZ	T1,T11FA	;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]
REPEAT 0,< T11LNK	>	;[735] -10 STORE LINK OR LINK END
	T11MVM			;[735] -7 MOVEM
	T11SYF			;[735] -6 FULL WORD SYMBOL FIXUP
	T11SYL			;-5 LEFT HALF SYMBOL FIXUP
	T11SYR			;-4 RIGHT HALF SYMBOL FIXUP
	SY.CHF##		;-3 FULL WORD FIXUP CHAIN
	T11CHL			;[1502] -2 LEFT HALF FIXUP CHAIN
	T11CHR			;[1502] -1 RIGHT HALF FIXUP CHAIN
	CPOPJ			;0  NO-OP
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		;[572] PICK UP LOCAL POINTER
	HRL	T1,T2		;[572] FORM STANDARD GLOBAL,,LOCAL
	PUSH	P,T1		;[572] SAVE OVER GS.GET
	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=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
REPEAT 0,<			;[735]
T11LNK:
	PUSH	P,T2
	PUSHJ	P,T12GET	;SET UP LINK TABLE
	EXCH	W2,(P)		;SPECIAL AC
	HRRES	W2		;SIGN EXTEND
	JUMPGE	W2,.+2
	 SKIPA	T2,[HRLM W3,@LINKTB]	;LINK END
	MOVE	T2,[HRRM W3,@LINKTB]	;LINK
	MOVMS	W2
	SOJL	W2,.+2
	CAIL	W2,LN.12
	 AOJA	W2,E01IPO	;[1174] RANGE CHECK
	XCT	T2		;STORE W3
	POP	P,W2		;RETRIEVE AC
	POPJ	P,
> ;END OF REPEAT 0

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:	HRLI	T2,CPF.RR	;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		;[1502] Save pointer to polish
	SETZ	W2,		;[1502] Clear it so that it doesn't
				;[1502] look like a symbol for %LNKFTH
	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		;[1502] Save pointer to polish
	SETZ	W2,		;[1502] Clear it so that it doesn't
				;[1502] look like a symbol for %LNKFTH
	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


SUBTTL	BLOCK TYPE 12 - LINK (FAIL)


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

T.12:	SKIPE	LINKTB		;LINK TABLE SETUP ?
	JRST	T.12A		;YES
	MOVEI	T2,LN.12	;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,LN.12-1(T1)	;CLEAR ALL LINKS

T.12A:	PUSHJ	P,RB.2		;READ 2 WORDS
	  JRST	LOAD##
	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 #
	TLNN	W1,-1		;THIRD ARG SPECIFIED?
	TLO	W1,0(W1)	;NO, DEFAULT TO SECOND ARG
	HRRZ	T2,W1		;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
	HLRM	W1,@LINKTB	;STORE NEW IN LINK TABLE
	JRST	T.12A		;BACK FOR MORE
;HERE IF THE OLD .LINK ADDRESS IS NO LONGER IN CORE.
T.12N:	HRLI	T2,CPF.RR	;NOT IN CORE
	MOVE	W3,W1		;VALUE
	PUSHJ	P,SY.CHP##	;PUT IN FIXUP LIST
	HLRM	W1,@LINKTB	;STORE NEXT FOR NEXT TIME
	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
	HRLM	W1,@LINKTB	;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
	MOVS	W3,W1		;VALUE
	TRNE	W3,-1		;[1204] SMALL ENOUGH?
	PUSHJ	P,E$$PTL	;[1204] NO, COMPLAIN
	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.
	ADDM	W3,RC.CV(R)	;BUMP RELOCATION COUNTER
	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
	MOVE	R,@RC.TB	;GET RC BLOCK
	HRR	W3,RC.CV(R)	;CURRENT VALUE
				;FALL INTO T.COMM
;T.COMM TESTS TO SEE IF COMMON ALREADY EXISTS
;IF SO CHECK SIZE
;IF NOT DEFINE (GLOBAL ONLY)
;RETURNS
;+1	COMMON ALREADY DEFINED WITH CORRECT LENGTH
;+2	WAS NOT DEFINED, NOW IS
;THIS ROUTINE PRESERVES R

T.COMM::MOVX	W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL	;SET THE FLAGS
	PUSHJ	P,TRYSYM##	;SEE IF IN TABLE
	  JRST	T.20ND		;NOT IN TABLE
	  JRST	T.20UN		;IN, BUT UNDEF (NOT COMMON)
	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
	HLRZ	T2,W3		;GET SIZE WE WANT
	CAMLE	T2,2(T1)	;LESS THAN OR EQUAL TO WHAT WE HAVE?
	JRST	T.20ER		;NO, GIVE ERROR
	MOVE	W3,2(P1)	;SET STARTING ADDRESS OF COMMON
	POPJ	P,		;YES, LEAVE ALONE

T.20ER:	MOVE	T1,2(T1)
	EXCH	T1,T2		;[1174] SWAP FOR .ETAIC ROUTINE
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
	HRRZM	W3,2(T1)	;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 AGGAIN
	HLRZM	W3,.L+2(T1)	;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)		;GGET PRIMARY FLAGGS
	TXNE	T1,PS.COM	;ALREADY DEFINED COMMON?
	JRST	E$$SNC		;[1174] SHOULD NOT HAPPEN
	PUSHJ	P,SY.CHK##	;SEE HOW LONGG 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
	HLRZM	W3,.L+2(T1)	;AND COMMON LENGTH
	HRRZ	W3,W3		;REMOVE LENGTH, JUST LEAVE VALUE
	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,.+3		;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
	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,1(W2)		;[1304] PSECT INDEX IS ONE LESS
	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,1(W1)		;[1766] 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]   ..
IFN FTFRK2,<
	TLNN	W1,-1		;[1756] LEFT HALF NON-ZERO ALREADY?
	MOVE	W1,LSTRRV	;[1756] NO, INCLUDE SECTION NUMBER
> ;[1756] IFN FTFRK2
	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,1(W1)	;[1137] 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?

T.24B:	MOVE	T2,RC.NO		;[1304] LOOP OVER ALL RC BLOCKS
T.24C:	MOVE	R,T2		;[1304] GET EXTERNAL PSECT NUMBER IN T2
	HRRZ	R,@RC.MAP	;[1304] MAP INTO INTERNAL NUMBER
	MOVE	T1,@RC.TB	;[1304] RC BLOCK WHERE THIS PSECT MIGHT BE
	CAME	W2,RC.NM(T1)	;[1137] IS IT HERE?
	SOJG	T2,T.24C	;[1304] NO, LOOP OVER ALL PSECTS
	JUMPE	T2,T.24D	;[1304] IF NOT FOUND, INSERT A NEW RC BLOCK
	TXZ	W3,AT.RP	;[1137] WE FOUND IT, SO ALREADY HAVE ORIGIN
;***** SHOULD CHECK HERE FOR CONFLICTING PSECT PROPERTIES *****
	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
	PUSH	P,T2		;[1304] SAVE LOCAL PSECT NUMBER
	PUSHJ	P,.SET0##	;[1300] SET THE ADDRESS
	POP	P,T2		;[1304] RESTORE LOCAL PSECT NUMBER
	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	T2,RC.NO	;[1304] ITS INDEX IS THE LAST PSECT
T.24E:	CAMN	P1,T2		;[1304] IS THE RC BLOCK IN THE RIGHT PLACE?
	JRST	LOAD##		;[1137] YES, DONE
	CAILE	P1,1		;[1153] DISALLOW CHANGING .LOW. OR BELOW
	CAMLE	P1,RC.NO	;[1153] CATCH GARBAGE PSECT INDICES
	JRST	E01IPX		;[1174] INDEX IS JUNK, COMPLAIN
	MOVE	R,T2		;[1304] POINT TO CURRENT MAP SLOT
	MOVE	T1,@RC.MAP	;[1304] GET MAP SLOT FOR THIS PSECT
	MOVE	R,P1		;[1304] POINT TO DESIRED MAP SLOT
	EXCH	T1,@RC.MAP	;[1304] PUT MAP ENTRY IN PROPER SLOT
	MOVE	R,T2		;[1304] BACK TO WHERE OUR PSECT USED TO BE
	MOVEM	T1,@RC.MAP	;[1304] SO WE DON'T LOSE MAP ENTRY
	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	E01FLE##	;[1174] WILL DO FOR NOW
	PUSHJ	P,DVOPN.##	;OPEN DEVICE
	LOOKUP	TC,I.RIB(T1)
	  JRST	E01FLE##	;[1174] 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

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		;KEEP NAMPTR UP TO DATE
	MOVEM	T1,NAMPTR	;  SO LOCAL BLOCK NAMES WILL WORK
	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	LSTSYM		;NOT A REAL SYMBOL SO CLEAR POINTER

	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
IFN FTFRK2,<
	SETZM	LSTLRV		;[1466]
> ;[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?
	JRST	R.ERR		;[1155] NO, CAN'T USE IT
	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
IFN FTFRK2,<
	MOVEM	T1,LSTLRV	;[1466]
> ;[1466] IFN FTFRK2
	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?
	JRST	R.ERR		;[1155] NO, CAN'T USE IT
	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 RESUL
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
	SKIPN	RC.CUR		;IF NOT PSECT
	SUB	T2,RC.IV(R)	;REMOVE BASE ADDRESS
	SKIPGE	RC.AT(R)	;[761] RELOCATABLE PSECT?
	JRST	R.ERR		;[761] 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::	MOVE	T1,RC.NM(R)	;[761] 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]
;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
>
SUBTTL	THE END


OLDLIT:	END