Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - language-sources/lnkold.mac
There are 50 other files named lnkold.mac in the archive. Click here to see a list.
TITLE	LNKOLD - LOAD OLD BLOCKS MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/RKH/JBC/JNG/DCE/MCHC/DZN	24-Aug-79


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


SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL

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


CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==1220		;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.
;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).
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

T.0C:	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
	MOVE	P3,W1		;SAVE START ADDRESS IN P3
	ADD	W1,W3		;HIGHEST ADDRESS NEEDED
	SETO	W3,		;NOT TYPE 21
T.1AD:	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
	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	T.0C		;YES, IGNORE THIS BLOCK
	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:
IFN FTOVERLAY,<
	CAMGE	P3,PH.ADD	;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.ADD	;REMOVE BASE
	SUB	P3,PH.ADD	;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.ADD	;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	T.1DP


T.1DP:	PUSHJ	P,RB.1		;GET THE DATA WORDS
	  JRST	LOAD##		;FINISHED BLOCK
	CSTORE			;STORE IN CORE
	SOJE	W3,CPOPJ	;T.21 RETURN
	AOJA	P3,T.1DP	;WILL RETURN TO LOAD WHEN RUN OUT
;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
	CAILE	T1,2*LN.WD-1	;[732] USE SMALLER OF THE TWO
	MOVEI	T1,2*LN.WD-1	;[732]
	MOVE	P2,T1		;[732]
	MOVEI	P1,LC.IX	;[732] AND THE AREA INDEX
	MOVE	T2,LC.AB	;[732] DO WE NEED TO EXPAND CORE FIRST?
	SUB	T2,LC.LB	;[732] GET LENGTH
	CAMG	T1,T2		;[732] NEED MORE THAN WE HAVE?
	JRST	T.1LO1		;[743] NO NEED TO EXPAND CORE
	ADDI	P2,1		;[732] YES, EXAND FIRST
	PUSHJ	P,LNKCOR##	;[732] GO ALLOCATE THAT MUCH
	  JFCL			;[742]
T.1LO1:	POP	P,P2		;[742] RESTORE TO REAL LOCATION
	POP	P,LW.LC	;[742] WINDOW STARTS AT LOWEST LOCATION
	MOVE	T1,LC.AB	;[732] CACULATE WINDOW'S UPPER BOUND
	SUB	T1,LC.LB	;[732] FROM CURRENT CORE LENGTH
	ADD	T1,LW.LC		;[732]
	CAILE	T1,777777	;[732] CHECK FOR OVERFLOW INTO LEFT HALF
	MOVEI	T1,777777	;[732]
	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	T.1LPJ		;LINK TO LIST OF REPLACEMENTS
	PUSH	P,W3		;PG.LSG SOMETIMES CRUMPS W3
IFN FTOVERLAY,<
	SUB	P2,PH.ADD	;PG.LSG WANTS OFFSET ADDRESSES
	SUB	P3,PH.ADD	;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

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)
;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	T.0C		;YES, IGNORE THIS BLOCK
	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:	TRNE	FL,R.LSO	;WANT LOW SEG CODE ONLY
	JRST	T.0C		;YES, IGNORE THIS BLOCK
	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	T.1DP

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

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
	MOVX	W1,PT.SGN!PT.SYM!PS.GLB	;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.ADD	;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.	(JMP,.EC,,,,T.1OVG)

T.1OVE:	AOS	W3,LNKMAX	;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	T.0C		;GET RID OF BLOCK

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


;HERE IF SYMBOLIC ADDRESS NOT YET DEFINED
T.1UN:	PUSHJ	P,T.1FX		;PUT WHOLE BLOCK IN FIXUP TABLE
E01CNW::.ERR.	(MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
	.ETC.	(STR,,,,,,<T.1UN+1>)

;HERE IF SYMBOL NOT EVEN IN TABLE
T.1ND:	PUSHJ	P,T.1FX		;PUT WHOLE BLOCK IN FIXUP TABLE
	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
	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 GLOBAL DEFINITION DEFERED RIGHT HALF
	E$$URC			;[1174]  6 - 30
	E$$URC			;[1174]  7 - 34
	E$$URC			;[1174] 10 - 40
	SY.GSS			;11 - 44 GLOBAL DEF. (SUPPRESSED) ! LEFT DEFERED 
	SY.LSS			;12 - 50 LOCAL DEF. (SUPPRESSED)
	E$$URC			;[1174] 13 - 54
	SY.RQ			;14 - 60 GLOBAL REQUEST
	SY.DGL			;15 - 64 GLOBAL DEFERED DEF (RH) SUPP. ! LEFT HALF
	E$$URC			;[1174] 16 - 70
;	E$$URC			;[1174] 17 - 74

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 GLOBAL DEFINITION DEFERED RIGHT HALF
	CPOPJ			; 6 - 30
	CPOPJ			; 7 - 34
	CPOPJ			;10 - 40
	T.2CHK			;11 - 44 GLOBAL DEF. (SUPPRESSED) ! LEFT DEFERED 
	T.2CHK			;12 - 50 LOCAL DEF. (SUPPRESSED)
	CPOPJ			;13 - 54
	T.2CHK			;14 - 60 GLOBAL REQUEST
	T.2CHK			;15 - 64 GLOBAL DEFERED DEF (RH) SUPP. ! LEFT HALF
	CPOPJ			;16 - 70
	CPOPJ			;17 - 74

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	;SET SUPPRESSED GLOBAL
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
IFN FMXFOR,<
	TXNE	W1,PS.ENT	;ENTRY POINT
	SKIPG	T2,MIXFOR	;AND WANT MIXFOR FEATURE
	JRST	SYGTRY		;NO
	SUB	T1,ENTPTR	;REL POSITION IN ENTRY TABLE
	ADDI	T2,(T1)		;POSITION IN MIXFOR TABLE
	MOVEM	W3,(T2)		;STORE CORRESPONDING VALUE
	POPJ	P,		;AND DEFINE AT LATER DATE
>
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
;NOTE THERE IS A PROBLEM WITH CONFUSION OVER
; RIGHT HALF DEFERED AND SUPPRESSED
; AND RIGHT AND LEFT HALF DEFERED
; THESE CASES LOOK ALIKE
;THEREFORE TREAT AS RIGHT DEFERED AND SUPPRESSED
; BUT IF A LEFT HALF REQUEST FOLLOWS TURN ON LEFT HALF DEFERED ALSO
;THIS CAN ONLY CAUSE PROBLEMS IF SYMBOL IS LOCAL AND NOT LOADED


SY.DGL:	TXO	W1,PS.DDT	;SUPPRESS TO DDT
SY.DGR:	TXO	W1,PS.GLB!PS.UDR
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
	.JDDT	LNKOLD,SY.ADS,<<CAMN	W2,$SYMBOL>>
	MOVE	W3,W2		;EXPECTED IN W3
	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
	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
	.JDDT	LNKOLD,SY.RQS,<<CAMN	W2,$SYMBOL##>>
	EXCH	W2,W3		;PUT THEM BACK
	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
	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?
	HRRZ	T3,W3		;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
	MOVEI	T1,.L		;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

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:
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:	MOVEI	R,2		;PUT IN SLOT #2
	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:	MOVEI	R,2		;PUT IN SLOT #2
	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	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
	MOVEI	R,2		;NOW FOR RC TABLE ENTRIES
	SKIPE	@RC.TB		;SLOT ALREADY OCCUPIED?
	JSP	T2,SETRCX	;CLEAR SLOT, SAVE OCCUPANT FOR LATER
	MOVEM	T1,@RC.TB	;GET POINTER INTO TABLE
	MOVEM	T1,@SG.TB
	MOVE	R,T1		;SAFER PLACE FOR POINTER
	AOS	RC.NO		;COUNT ONE MORE
	SOS	RC.FRE		;AND ONE LESS HOLE
	MOVEM	W1,RC.IV(R)	;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
	JRST	T.3AA		;NOW SETUP HC AREA
;HERE IF DESIRED RC SLOT IS NOT FREE
;STACK CURRENT CONTENTS AND RETURN
;FIND NEW PLACE FOR CURRENT OCCUPANT LATER

SETRCX:	PUSH	P,@RC.TB	;STACK CURRENT OCCUPANT
	PUSH	P,[SETRCY]	;RET ADDRESS TO STORE ABOVE RC POINTER
	JRSTF	(T2)		;RETURN

SETRCY:	SOSGE	RC.FRE		;ANY FREE SPACE?
	PUSHJ	P,.SETEX##	;NO, MUST EXPAND
	MOVE	R,RC.NO		;[753] GET NUMBER
	POP	P,@RC.TB	;STORE IT
	POPJ	P,		;RETURN
;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 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
	MOVEI	T2,LN.PPD	;[603] 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:
IFN FMXFOR,<
	SKIPG	MIXFOR		;SKIP IF WE STILL HAVE FIXUP TO DO>
	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
	MOVE	W2,LSTRRV	;[1204] GET TRUE VALUE
	CAMLE	W2,[1,,0]	;[1204] TOO BIG?
	PUSHJ	P,E$$PTL	;[1204] YES, COMPLAIN
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
	MOVE	W1,LSTRRV	;[1204] TRUE VALUE
	CAMLE	W1,[1,,0]	;[1204] LEGAL?
	PUSHJ	P,E$$PTL	;[1204] NO, DIE
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)	;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
	MOVEM	W1,RC.HL(R)	;[1132] MAKE SURE HL IS UP TO DATE TOO
	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)	;USE GREATER
	MOVE	W2,RC.HL(R)
	CAMLE	W2,RC.CV(R)
	MOVEM	W2,RC.CV(R)	;FOR NEXT FILE
	MOVEM	W2,RC.HL(R)	;[1132] MAKE SURE HL IS HIGHEST POSSIBLE
	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
IFN FMXFOR,<
	SKIPLE	MIXFOR		;NEED TO DO MIXFOR FIXUPS?
	PUSHJ	P,.MXFOR##	;YES>
	TRZ	FL,R.LOD	;DONE WITH END BLOCK NOW
	SKIPN	RC.CUR		;BEEN PROCESSING PSECTS?
	JRST	T.5PSC		;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
	MOVE	T1,SG.TB+2	;FROM SECOND
	MOVEM	T1,@RC.TB	;STORE HIGH WHERE IT SHOULD BE
	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
	MOVE	T1,SG.TB+2	;POINT TO REAL HIGH SEG BLOCK
	MOVEM	T1,@RC.TB	;STORE 0 OR REAL ADDRESS
	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
		MOVEM	W2,RC.HL(R)	;[1132] HIGHEST LOCATION LOADED
		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
	MOVEM	W1,RC.HL(R)	;[1132] FOR LNKXIT
	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
		MOVEM	W1,RC.HL(R)	;[1132] FOR LNKXIT
		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
	MOVEM	W2,RC.HL(R)	;[1132] FOR LNKXIT
	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
	HRRZI	T1,1(P1)	;HIGHEST +1 =NEW LOWEST
	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
	TRNE	FL,R.FHS	;NEED TO ADJUST THE RELOC TABLES?
	PUSHJ	P,T.6RC		;YES
	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
	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,.EP,,,,PRGNAM)
;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
	ANDM	T1,OKCPUS	;[1120] ENFORCE CPU FLAGS
	SKIPN	OKCPUS		;[1120] CAN PROG RUN AT ALL NOW?
	JRST	E$$CCD		;[1174] NO--CPU CONFLICT DETECTED
	LDB	T1,[POINT 12,(P),17] ;[1120] 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%F,S%F,CCD,<CPU conflict>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;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 COBOL
	CAIE	T1,CT.C74
	CAIN	T1,CT.CBL
	SALL			;OTHERWISE LITERAL IS A MESS
	JRST	[MOVE	W2,['LIBOL-']
		PUSHJ	P,LS.ADD##
		DMOVE	W2,[SIXBIT /STATIC-AREA/]
		JRST	.+3]
	PUSHJ	P,LS.ADD##
	MOVE	W2,['COMMON']
	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
	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)
	SETZ	W3,		;DON'T KNOW COMPILER VERSION
	PUSHJ	P,LS.ADD

	PUSHJ	P,TTLRLC	;PUT OUT RELOCATION COUNTER INFO

IFN FMXFOR,<
	HLRE	T2,ENTPTR	;GET - LENGTH OF ENTRIES
	MOVN	T2,T2		;POSITIVE
	JUMPE	T2,[HRRES MIXFOR	;RESET SWITCH
		JRST	LOAD##]		;AND  IGNORE
	SKIPLE	T1,MIXFOR	;ONLY WANT IF POSITIVE ALREADY
	PUSHJ	P,DY.GET##	;GET TABLE SPACE
	MOVEM	T1,MIXFOR	;STORE POINTER
>
	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
	PUSHJ	P,RB.2		;READ POSSIBLE TWO DATA WORDS
	  JRST	[MOVEI	T1,7
		 JRST	E$$RBS]		;[1174]
	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:	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 READ BLOCK AND STORE IN FX AREA
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

;FALL INTO NEXT PAGE
	PUSHJ	P,RB.1		;[1166] READ FIRST WORD
	  JRST	T.11CS		;[1166] EMPTY?
	HLRZ	T1,W1		;[1166] GET FIRST HALF WORD
	CAILE	T1,MXPLOP	;[1166] A PSECT INDEX?
	CAIL	T1,-STRLEN	;[1166] MAYBE, IS IT?
	JRST	T11RD2		;[1166] NO, FORGET IT
	MOVEI	P4,-377777(T1)	;[1166] YES, SET IT AS DEFAULT
	CAMLE	P4,RC.NO	;[1166] IN RANGE?
	JRST	E$$IPX		;[1174] NO, ERROR
	MOVEM	P4,RC.CUR	;[1166] SET FOR NEXT WORD
	JRST	T11RD2		;[1166] ENTER MAIN LOOP


;NOW READ AND RELOCATED EACH HALF WORD
;THIS IS COMPLICATED BY THE FACT THAT IS PSECTS ARE BEING USED
;THE RELOCATION WILL CHANGE
;HOWEVER SINCE THE RELOCATION INFO IS FOLLOWED BY AN OPERATOR
;IT IS SUFFICIENT TO CHECK AFTER EACH WORD AS LOADED AND CHANGE
;THE RELOCATION IF REQUIRED FOR THE NEXT WORD
;THE RELOCATION INDEX IS 400000 + (N-1)

T.11RD:	PUSHJ	P,RB.1		;READ AND RELOCATE 2 HALF WORDS
	  JRST	T.11CS		;[633] FINISHED WITH THIS BLOCK
T11RD2:	HLRZ	T1,W1		;[1166] GET LHS
	HRRZ	T2,W1		;GET RHS
	SKIPGE	P4		;ON LAST WORD FOR THIS PSECT
	TLZA	P4,-1		;NOT YET, WILL BE NEXT TIME
	MOVEM	P4,RC.CUR	;RESET PSECT FOR THIS BLOCK
	JUMPE	T1,[MOVEM P4,RC.CUR	;18 BIT VALUE, RHS OK
		JRST	T.11RS]		; BUT RESOTRE INCASE SET FOR 2 WORDS
	CAIG	T1,2		;TEST FOR 36 BIT OPERAND (1 OR 2)
	JRST	T11GRH		;YES, ITS OK AND SO IS LHS OF NEXT
	CAIGE	T1,MXPLOP	;TEST FOR OPERATOR
	JRST	T11RHS		;IT IS, TEST RHS
	CAIL	T1,-STRLEN	;[735] STORE OP?
	JRST	T11LOP		;YES,JUST STORE
	HRRZI	T1,-377777(T1)	;GET PSECT INDEX
	CAMLE	T1,RC.NO	;[1166] MAKE SURE VALID
	JRST	E$$IPX		;[1174] INVALID
	MOVEM	T1,RC.CUR	;SET FOR NEXT READ
	JUMPE	P4,E$$IPX	;[1174] PSECT INDEX ILLEGAL IF 1ST BYTE WASN'T
	HRRO	P4,P4

;FALL THROUGH TO NEXT PAGE
T11RHS:	JUMPE	T2,T11GRF	;18 BIT VALUE FOLLOWING
	CAIG	T2,2		;36 BIT VALUE?
	JRST	[MOVEM	W1,(W2)		;THIS WORD IS OK
		PUSHJ	P,RB.1		;AND SO IS NEXT
		  JRST	T.11CS		;RAN OUT
		MOVEM	P4,RC.CUR	;RESET PSECT
		AOJA	W2,T.11RS]	;JUST STORE
	CAIG	T2,MXPLOP	;TEST FOR OPERATOR
	JRST	T.11RS		;IT IS
	CAIL	T2,-STRLEN	;[735] STORE OP?
	JRST	T11ROP		;YES, STORE AND TEST NEXT RIGHT
	HRRZI	T2,-377777(T2)	;GET PSECT INDEX
	CAMLE	T2,RC.NO	;[1166] MAKE SURE VALID
	JRST	E$$IPX		;[1174] INVALID
	MOVEM	T2,RC.CUR	;SET FOR NEXT READ
	JUMPE	P4,E$$IPX	;[1174] ENFORCE DEFAULT PSECT INDEX FIRST BYTE
	HRRO	P4,P4		;SIGNAL MIGHT TAKE TWO WORDS
T.11RS:	MOVEM	W1,(W2)		; STORE
	AOJA	W2,T.11RD	;READ ALL OF BLOCK


T11LOP:	CAIL	T1,-3		;SYMBOLIC STORE?
	JRST	T.11RS		;NO
	JRST	T11SOP		;YES

T11ROP:	CAIL	T2,-3		;SYMBOLIC STORE?
	JRST	T11GRH		;NO
T11SOP:	MOVEM	P4,RC.CUR	;RESET PSECT
	MOVEM	W1,(W2)		;STORE STORE OP
	PUSHJ	P,RB.1		;GET SYMBOL
	  JRST	T.11CS		;WILL EVENTUALLY RUN OUT
	AOJA	W2,.-3		;STORE

T11GRF:	ANDI	P4,-1		;CLEAR LHS SINCE NOT 2 WORDS
T11GRH:	MOVEM	W1,(W2)		;THIS WORD IS OK
	PUSHJ	P,RB.1		;AND SO IS LHS OF NEXT
	  JRST	T.11CS		;RAN OUT
	MOVEM	P4,RC.CUR	;RESET PSECT
	HRRZ	T2,W1		;RHS
	AOJA	W2,T11RHS	;CHECK RHS

E$$IPX::.ERR.	(MS,.EC,V%L,L%F,S%F,IPX,<Invalid psect index>) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HERE TO FIND THE STORE OPERATOR AND CHECK TO SEE IF WE WANT IT.
;IF NOT (/ONLY OR NON-LOADED LOCAL), DELETE THE FIXUP NOW.

T.11CS:	POP	P,RC.CUR	;RESET ORIGINAL PSECT
	MOVE	W1,T11BP	;[633] RESET BYTE POINTER
	ADD	W1,FX.LB	;[633] FIX IN CORE
	JRST	T.11C1		;[633] BYPASS FIRST TIME

T.11C0:	IBP	W1		;[633] BYPASS NEXT HALF WORD
T.11C1:	ILDB	T1,W1		;[633] READ HALF WORD
	CAIL	T1,MXPLOP	;[633] CHECK FOR VALID OPS
	JRST	[CAIGE	T1,-STRLEN	;[735] STORE OP?
		JRST	T.11C1	;[700] NO, MUST BE PSECT INDEX
		JRST	T.11SP]	;[700] YES, GO CHECK IT
	CAIL	T1,3		;[633] IF OPERATOR
	JRST	T.11C1		;[633] IGNORE IT
	JUMPE	T1,T.11C0	;[633] IGNORE NEXT HALF WORD
	AOJA	W1,T.11C1	;[633] OR NEXT FULL WORD IF 36-BIT VALUE

;HERE ON A STORE OPERATOR. SEE IF WE WANT IT.
;IF NOT, DELETE THE POLISH BLOCK AND RETURN.
;IF SO, CHECK STORE OP TO SEE IF DEFINING A SYMBOL
;	AND CONVERT THE SYMBOL TO LSTSYM PTR (GLOBAL,,LOCAL) IF SO.

T.11SP:	CAIL	T1,-3		;SYMBOL FIXUPS?
	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
	CAIGE	T1,-STRLEN		;[735] VALID STORE POINTER?
	JRST	E$$ISO		;[1174] NO

;FALL THROUGH TO NEXT PAGE
;HERE IF STORE OP IS A VALID SYMBOL FIXUP
;IF STORE IS TO SYMBOL TABLE THERE ARE 2 SYMBOLS FOLLOWING
;1 ACTUAL SYMBOL TO BE FIXED UP
;2 BLOCK NAME IT IS 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

E$$ISO::.ERR.	(MS,.EC,V%L,L%F,S%F,ISO,<Invalid polish store operator >) ;[1174]
	.ETC.	(OCT,.EC!.EP,,,,T1) ;[1174]
	.ETC.	(JMP,,,,,.ETIMF##) ;[1174]
;HERE IF GLOBAL SYMBOL NOT IN GLOBAL SYMBOL TABLE YET
;TREAT AS IF ADDITIVE GLOBAL REQUEST
;GET EXTENDED TRIPLET AND POINT TO FIXUP TRIPLET IN FIXUP AREA
;INTURN THIS TRIPLET POINTS TO THE POLISH FIXUP
;NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;STUFF, THEY MUST BE SAVED

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


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

T.11DF:	ADDI	P1,.L		;LOOK FOR ADDITIVE  GLOBAL REQUEST
	SKIPG	W1,0(P1)	;GET SECONDARY FLAGS
	JRST	E$$ISP##	;[1174] PRIMARY OR NO FLAGS SET
	TXNN	W1,S.FXP	;IS THIS THE ONE
	JRST	T.11DF		;NO TRY AGAIN
	SKIPN	W1,2(P1)	;GET POINTER, BETTER BE NON-ZERO
	JRST	E$$ISP##	;[1174]
	HRLI	W1,(FP.SGN!FP.SYM!FP.PTR!FP.POL)
	HRRZ	W3,T11FA	;POINT TO POLISH
	SUB	P1,NAMLOC	;INCASE CORE MOVES
	PUSH	P,P1		;SAVE UNRELOCATED POINTER
	PUSHJ	P,SY.FX0##	;PUT IN FIXUP AREA
	POP	P,P1		;RESTORE POINTER
	ADD	P1,NAMLOC	;RELOCATE IT
	HRRM	W3,2(P1)	;FIXUP REQUEST POINTER CHAIN
	JRST	T.11GD		;GET NEXT HALF-WORD
;HERE TO EVALUATE POLISH FIXUP
T.11EV::SKIPN	W3,POLSTK	;GET STACK POINTER
	PUSHJ	P,T.11PD	;NOT SETUP YET
	MOVEI	T3,100		;INCASE OF ON OPERATOR
	MOVEM	T3,SVSAT
	PUSH	W3,[MXPLOP]	;FAKE OPERATOR
	MOVE	W2,T11BP	;SETUP READ BYTE POINTER
IFN DEBSW,<
	MOVEI	W1,-2(W2)	;[632] POINT TO 1ST WORD OF BLOCK
> ;END IFN DEBSW
	.JDDT	LNKOLD,T.11EV,<<CAMN W1,$FIXUP##>>	;[632]
	ADD	W2,FX.LB	;FIX IN CORE
T.11RP:	ILDB	W1,W2		;READ A HALF-WORD
	CAIL	W1,-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]
	PUSH	W3,W1		;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
	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,


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
	PUSH	W3,T2		;SAVE VALUE
	HRLI	T1,400000	;PUT IN A VALUE MARKER
	PUSH	W3,T1
	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 ;[735]
;OPERATOR ACTION
OPTAB:	ADD	T1,T2
	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
REPEAT 0,< ;WAITING FOR A DEVELOPMENT RELEASE
	PUSHJ	P,SKPOP	;25
	PUSHJ	P,SKEOP	;26
	PUSHJ	P,MOVOP	;27
> ;END REPEAT 0
MXPLOP==:.-OPTAB+3		;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,

REPEAT 0,<	;WAITING FOR A DEVELOPMENT RELEASE
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,

> ;END REPEAT 0
;HERE TO STORE THE FINAL VALUE

T.11ST:	MOVE	T2,-2(W3)	;THIS SHOULD BE THE FAKE OPERATOR
	CAIE	T2,MXPLOP	;IS IT
	JRST	E01IPO		;[1174] NO
	ILDB	T2,W2		;[572]  GET CORE ADDR OR GS POINTER
	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
	SY.CHL##		;-2 LEFT HALF FIXUP CHAIN
	SY.CHR##		;-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
	JRST	SY.ASP		;AND DO FIXUP

T11SYL:	MOVX	W1,FS.FXL
	JRST	SY.ASP

T11SYF:	MOVX	W1,FS.FXF
;	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
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:	SETZM	DCBUF+2		;READ NEXT BUFFER ON NEXT ILDB
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
	CAIN	W3,(T1)		;IN THIS BLOCK?
	JRST	THSBLK		;YES
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
NXTBLK:	IN	DC,
	  JRST	THSBLK		;[1101] IT IS NOW
	JRST	D.ERR##		;EOF OR ERROR


;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:	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
	HRRZ	T2,DCBUF	;[1101] CONSTRUCT NEW BYTE POINTER
	HLL	T2,DCBUF+1	;[1101] LH=LH(OLD BYTE PTR)
	ADDI	T2,1(T1)	;[1101] RH=RH(DCBUF)+OFFSET+1
	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
	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
	JRST	NXTNDX		;CHECK IF NEXT BUFFER IN CORE
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.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.22B		;YES,
	SOJG	R1,T.22A	;NOT YET
	SETZ	W1,		;[763] ZERO ATTRIBUTES
	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
T.22B:	MOVEM	R1,RC.CUR	;SET FOR RELOCATION
	JRST	LOAD##		;FINISHED

T.22C:	ADDI	W2,1		;[763] PSECT INDEX IS ONE LESS
	CAMLE	W2,RC.NO	;[763] HERE IF PSECT INDEX USED
	JRST	E$$IPX		;[1174] MAKE SURE THIS PSECT EXIST
	MOVEM	W2,RC.CUR	;[763] SWITCH CURRENT RELOC COUNTER TO IT
	JRST	LOAD##		;[763] 
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)		;[1154] PUT INTERNAL PSECT INDEX INTO R
	TXNN	W1,77B5		;[1154] OLD STYLE (NAME IN SIXBIT)?
	JRST	T.23B		;[1154] NO, 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]   ..
	MOVE	W1,LSTRRV	;[1204] GET TRUE VALUE
	CAMLE	W1,[1,,0]	;[1204] IN BOUNDS?
	PUSHJ	P,E$$PTL	;[1204] NO, COMPLAIN
	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:	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	R,RC.NO		;[1137] LOOP OVER ALL RC BLOCKS
T.24C:	MOVE	T1,@RC.TB	;[1137] RC BLOCK WHERE THIS PSECT MIGHT BE
	CAME	W2,RC.NM(T1)	;[1137] IS IT HERE?
	SOJG	R,T.24C		;[1137] NO, LOOP OVER ALL PSECTS
	JUMPE	R,T.24D		;[1137] 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 *****
	IORM	W3,RC.AT(T1)	;[1137] ACCUMULATE ATTRIBUTES
	JRST	T.24E		;[1137] MAKE SURE IT'S WHERE WE EXPECT IT
T.24D:	EXCH	W1,W3		;[1137] SET ACS FOR .SET0
	PUSHJ	P,.SET0##	;[1137] SET UP A NEW RC BLOCK
	MOVE	R,RC.NO		;[1137] ITS INDEX IS THE LAST PSECT

T.24E:	CAMN	P1,R		;[1137] 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	T1,@RC.TB	;[1137] RC BLOCK OF THIS PSECT
	EXCH	R,P1		;[1137] POINT TO RC BLOCK IN THE WAY
	EXCH	T1,@RC.TB	;[1137] PUT OUR RC BLOCK WHERE IT BELONGS
	EXCH	R,P1		;[1137] BACK TO WHERE OUR PSECT USED TO BE
	MOVEM	T1,@RC.TB	;AND OUT OF PLACE BLOCK
	JRST	LOAD##		;ALL DONE


;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,.EP,,,,PRGNAM)	;FOR LINK DEBUGGERS
	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
	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
	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 RESULT
RWORD8:	MOVEM	T1,LSTRRV	;[1204] STORE FOR BREAK CHECKS
	HRR	W1,T1		;[1155] STORE THE RESULT
CPOPJ1:	AOS	(P)		;SKIP RETURN
CPOPJ:	POPJ	P,

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