Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - lnknew.mac
There are 53 other files named lnknew.mac in the archive. Click here to see a list.
TITLE LNKNEW - LOAD NEW BLOCKS MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/TXR/JNG/DZN/PAH/PY		6-Jan-83



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


SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC,OVRPAR	;[1704]
SALL

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


CUSTVR==0		;CUSTOMER VERSION
DECVER==5		;DEC VERSION
DECMVR==1		;DEC MINOR VERSION
DECEVR==2026		;DEC EDIT VERSION


SEGMENT


;LOCAL ACC DEFINITIONS
INTERN	R,RB,WC

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

SUBTTL	REVISION HISTORY


;START OF VERSION 1A
;52	ADD ASCIZ TEXT BLOCK

;START OF VERSION 2
;141	TURN ON AND FIX BUGS IN ASCII TEXT BLOCKS

;START OF VERSION 2B
;253	Correct problems with ASCII blocks: make work with
;	CCL entry; cause multiple line blocks to not lose
;	characters by initializing byte pointer once (here).
;404	Re-insert edits 344 and 340, which got lost.
;405	Recover if EOF encountered while reading ASCII text.
;411	Don't try to free core here that was freed in LNKSCN.

;START OF VERSION 2C
;454	Allow (but ignore) the trace blocks from MAKLIB.
;471	Add code for ALGOL debugging system.
;517	Make first word of ALGOL symbol file be 1044,,count.
;530	Get definition of triplet flag bits right.
;534	Store files from the same .TEXT block in the right order.
;557	Clean up the listing for release.

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)


;START OF VERSION 4
;731	SEARCH MACTEN,UUOSYM
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)

;Start of version 5I
;1000	Add Block 1070

;START OF VERSION 4A
;1174	Label and clean up all error messages.
;1212	Use E$$NEB instead of EOFTS label in T.1003 (in an off conditional).
;1217	Clean up the listings for release.
;1220	Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;1303	Change the LNKLNM message to also include the file name.
;START OF VERSION 5
;1405	New blocks T.1010 thru T.1134 and supporting routines added.
;1426	Delete redundant T.1042-T.1044 routines introduced during merge.
;1430   Remove .NWBLK conditionals forcing an error from T.1060 blocks,
;	 and ignore them.
;1434	New block type 1004 ( byte pointer initialization ) added.
;1440	Apply edit 1240,1237, and 1120 to the new blocks.
;1443	Make sure PDV .REL blocks aren't in LINK-10.
;1445	Typo in block type 1004 corrected.
;1452	Lengthen LITYPE bounds to include all new blocks.

;START OF VERSION 5A
;1467	Change D.IN1 call to D.CNT at T1004C.
;1470	Correct stack discipline in T.1004 and make sure there are
;	no index registers on return from T.1S6
;1471	Remove use of T.11XX and PB.1 from type 1130 blocks, which
;	have no relocation words, also alter type 112x block to
;	handle just one relocation byte.
;1472	Get the right number of chars for a function name and
;	don't lose the count, in T.112X. Use symbols for the
;	offsets.  Also clean up the dispatch macros.
;
;1500-1677	Reserved for Maintenance
;1503	Make 1010-1034 blocks do thirty-bit reloc on their start addresses.
;
;1510	Test for include mode at LNKNEW+4.
;1701	Correct typos in T.1130 introduced during V5A source merge.
;1704	Handle Type 1045 block.
;1706   Handle COMMONs in Type 1045 properly.
;1707	Correct typo in 1706.
;1712	Call WRTPTR not WRTDAT at T1045C+3.
;1714	Remove increment of RC.CV in TNYBTL, this should be done at
;	end of module.
;1720	Change POPJ to POP at REL.TB+2.
;1721	Correct space initialization at TNYBTB+17.
;1722	Fix RLADD not to lose right half is left half is absolute.
;1726	Fixes to 101X block processing to speed up loops and avoid some
;	boundary errors.
;1730	Test limit values and handle overlays okay in Type 101x block
;	processing.
;1742	Don't lose the section number when calling T.1AD from T.1004.
;1745	Don't lose T4 across the call to DY.GET in T.1045 processing.
;1754	Type 1072 block support.
;1770   Change JRST CPOPJ to POPJ P, at TSTSEG+5
;1776	Change call to T.1AD from T.1004, include call in T.1010-1034.
;2005	Store module name for 112x blocks. 
;2007	Give the LNKUCB message a long error message.
;2020	Add a word to the typechecking blocks for linking them together.
;2022	Change tests at T1045C to terminate more surely.
;2026	Update copyright and cleanup listings.

SUBTTL	BLOCK DISPATCH TABLES


	XALL
NDSPTB:	LITYPE	(1000,1137)		;[1452]
NDISPL==.-NDSPTB
	SALL
SUBTTL	DISPATCH TO NEW BLOCK TYPE


;ENTER WITH BLOCK TYPE IN T1
;ALSO IN W1

LNKNEW:	CAILE	T1,1777		;IS IT DEC SUPPLIED
	JRST	LNKCST		;NO, TRY CUSTOMER  LINK ITEMS
	CAIL	T1,1000+NDISPL*2	;IS IT LEGAL TYPE
	JRST	E$$IRB##	;[1174] NO, NOT YET AVAILABLE
	TRNE	FL,R.LIB!R.INC	;[1510] IN LIBRARY SEARCH MODE?
	JRST	T.SRCH		;YES, IGNORE IF NOT ENTRY BLOCK TYPE
	HRREI	T2,-<1000+NDISPL>(T1)	;OFFSET TYPE
	JUMPGE	T2,.+2			;IF NEGATIVE, USE RHS
	SKIPA	T2,NDSPTB+NDISPL(T2)	;USE RIGHT HALF
	HLRZ	T2,NDSPTB(T2)	;USE LEFT HALF
	JRST	(T2)		;DISPATCH



;HERE IF IN LIBRARY SEARCH MODE - TEST FOR BLOCK TYPE 1001, 1002

T.SRCH:	CAIN	T1,1001		;IS IT ENTRY BLOCK?
	JRST	T.1001		;YES, SEE IF WE WANT IT
	CAIN	T1,1002		;OR EXTENDED ENTRY BLOCK?
	JRST	T.1002
	CAIN	T1,1003		;TITLE BLOCK (INCASE /INCLUDE)
	JRST	T.1003
	JRST	T.1000		;IGNORE THIS BLOCK


SUBTTL	BLOCK TYPE 1000 - JUNK WORDS


;	----------------
;	! 1000 ! COUNT !
;	----------------
;	! DATA   WORD  !
;	----------------
;	! DATA   WORDS !
;	----------------

T.1000:	HRRZ	T1,W1		;GET WORD COUNT
	JUMPE	T1,LOAD##	;JUST IGNORE
T1000A:	CAML	T1,DCBUF+2	;ENOUGH WORDS IN BLOCK?
	SOJA	T1,T1000B	;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

T1000B:	SUB	T1,DCBUF+2	;COUNT DOWN WORDS IN BUFFER
	PUSHJ	P,D.INP##	;GET NEXT BUFFER
	JRST	T1000A		;FINISH OFF BLOCK
SUBTTL	BLOCK TYPE 1001 - SINGLE WORD ENTRIES


;	----------------
;	! 1001 ! COUNT !
;	----------------
;	!      SYMBOLS !
;	----------------
;	!      SYMBOLS !
;	----------------

IFE .NWBLK,<
T.1001==E$$IRB##			;[1174] ILLEGAL IF NOT THERE
> ;END IFE .NWBLK

IFN .NWBLK,<
T.1001:	MOVEI	T2,0(W1)	;GET NUMBER OF ENTRIES IN THIS MODULE
	MOVE	R3,T2		;SAFE PLACE FOR COUNT DOWN
	JUMPE	T2,LOAD##	;IGNORE 0 ENTRIES
	SKIPN	ENTPTR		;ALREADY SOME ENTRIES FOR THIS MODULE?
	JRST	T1001E		;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	T1001D		
;HERE WHEN THIS IS THE FIRST BLOCK TYPE 1001,1002 OR 4 SEEN.

T1001E:	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
T1001D:	HRLI	W3,(POINT 36)	;SO USE AS DEPOSIT BYTE POINTER
	TRNN	FL,R.LIB	;IN LIBRARY SEARCH MODE
	JRST	T1001B		;NO, JUST STORE SYMBOLS FOR LATER
T1001A:	SOJLE	R3,LOAD##	;END OF BLOCK
	PUSHJ	P,D.IN1##	;READ A WORD
	MOVE	W2,W1		;PUT SYMBOL IN SYMBOL ACC
	SETZ	W1,		;ZERO FLAGS
	IDPB	W2,W3		;STORE ENTRY
	PUSHJ	P,TRYSYM##	;SEE IF SYMBOL IS IN TABLE
	  JRST	T1001A		;NO, TRY NEXT
	  TRZA	FL,R.LIB	;UNDEF, CLEAR SKIP CONTROL
	JRST	T1001A		;DEFINED, DON'T NEED THIS DEFINITION
T1001B:	SOJL	R3,LOAD##	;END OF BLOCK
	PUSHJ	P,D.IN1##
	IDPB	W1,W3		;STORE
	JRST	T1001B		;LOOP
>
SUBTTL	BLOCK TYPE 1002 - LONG SYMBOL ENTRY


;	----------------
;	! 1002 ! COUNT !
;	----------------
;	!      SYMBOL  !
;	----------------
;	! MORE SYMBOL  !
;	----------------

IFE .NWBLK,<
T.1002==E$$IRB##		;[1174] ERROR UNLESS FIXED
> ;END IFE .NWBLK

IFN .NWBLK,<
T.1002:	MOVEI	R3,0(W1)	;GET NUMBER OF WORDS OF ENTRY IN THIS BLOCK
	CAIG	R3,1		;TREAT 0 AND 1 AS T.1001
	JRST	T.1001		;NOT A LONG SYMBOL
	MOVEI	T2,1		;NEED ONE MORE WORD FOR POINTER
	SKIPN	ENTPTR		;ALREADY SOME ENTRIES FOR THIS MODULE?
	JRST	T1002E		;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,1(T1)	;BUT LEAVE SPACE AT TOP
	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
	HRRZ	W3,ENTPTR	;RESET W3 TO POINT TO TOP ITEM (HOLE)
	JRST	T1002D		
T1002E:	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
T1002D:	MOVEI	T2,-1(R3)	;THESE MANY EXTRA (AFTER FIRST) WORDS
	ROTC	T1,-1		;CUT IN HALF
	SKIPGE	T1		;NO CARRY
	ADDI	T2,1		;EXTRA BLOCK FOR LAST WORD
	IMULI	T2,.L		;THESE MANY WORDS IN TRIPLETS
	ADDI	T2,.L		;PLUS INITIAL ONE
	HRLZM	T2,0(W3)	;STORE WORD COUNT IN EMPTY SLOT
	TRNE	T2,770000	;UNLESS SYMBOL IS SUPER LONG
	ADDI	T2,1		;IN WHICH CASE ONE MORE FOR COUNT
	PUSHJ	P,DY.GET##	;GET SPACE
	HRRM	T1,0(W3)	;STORE POINTER ADDRESS
	TRNE	T2,770000	;FIX IF SUPER LONG
	JRST	[HRRZS	0(W3)	;CLEAR COUNT
		MOVEM	T2,0(T1)	;STORE AS FIRST WORD
		AOJA	T1,.+1]		;PASS OVER IT
	HRRZ	W3,T1		;USE DATA BLOCK TO STORE ENTRY
	HRLI	W3,(POINT 36)	;SO USE AS DEPOSIT BYTE POINTER
	MOVX	W1,PT.SYM!PT.EXT	;SOME FLAGS
	IDPB	W1,W3
	PUSHJ	P,D.IN1##	;GET FIRST 6
	IDPB	W1,W3		;STORE ALSO
	MOVE	W2,W1		;SAVE FIRST 6 CHARS
	SETZ	W1,		;ZERO VALUE
	IDPB	W1,W3
T1002A:	SOJLE	R3,T1002B	;END OF BLOCK
	MOVX	W1,S.LST	;CLEAR LAST TRIPLET FLAG IN PREV
	ANDCAM	W1,-2(W3)	;SINCE WE NOW COME AFTER IT
	MOVX	W1,S.SYM!S.LNM!S.LST	;SECONDARY FLAGS
	IDPB	W1,W3
	PUSHJ	P,D.IN1##	;READ A WORD
	IDPB	W1,W3		;STORE SYMBOL
	SOJLE	R3,T1002B	;END OF BLOCK
	PUSHJ	P,D.IN1##	;NO
	IDPB	W1,W3		;STORE SECOND WORD
	JRST	T1002A		;LOOP
;HERE WHEN SYMBOL STORED

T1002B:	TRNN	FL,R.LIB	;IN LIBRARY SEARCH MODE
	JRST	LOAD##		;YES, SYMBOL STORED SO GET NEXT BLOCK
	MOVE	W3,ENTPTR	;END OF BLOCK, GET POINTER
	TLZE	W3,007777	;SUPER LONG?
	ADDI	W3,1		;YES
	MOVX	W1,PT.EXT	;LONG SYMBOL BIT ON
	MOVE	W2,1(W3)	;FIRST 6 CHARS
	PUSHJ	P,TRYSYM##	;SEE IF SYMBOL IS IN TABLE
	  JRST	LOAD##		;NO, GET NEXT BLOCK
	  TRZ	FL,R.LIB	;UNDEF, CLEAR SKIP CONTROL
	JRST	LOAD##		;DEFINED, DON'T NEED THIS DEFINITION
>
SUBTTL	BLOCK TYPE 1003 - NAME


;	-----------------
;	! 1003	! COUNT	!
;	----------------------
;	! FLAGS	!     0	!	PT.SGN!PT.TTL!PT.EXT
;	-----------------	(PT.EXT OFF IF COUNT=3)
;	! PROGRAM TITLE	!	
;	-----------------
;	!	0	!
;	----------------------
;	! FLAGS	!     0	!	S.TTL
;	-----------------
;	! MORE TITLE	!
;	-----------------
;	! MORE TITLE	!
;	-----------------
;
;		.
;
;		.
;
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.CMT
;	-----------------
;	! ASCII COMMENT !
;	-----------------
;	! MORE  COMMENT !
;	-----------------
;
;		.
;
;		.
;
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.PRC
;	-----------------
;	! COMPILER NAME	!
;	-----------------
;	! CODE  ! CPUS  !
;	----------------------
;	! FLAGS !     0 !	S.TTL!S.PRC
;	-----------------
;	! MORE C. NAME  !
;	-----------------
;	! MORE C. NAME  !
;	-----------------
;
;		.
;
;		.
;
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.CRE
;	-----------------
;	! COMPIL DATIME	!
;	-----------------
;	! COMPILER VERS !
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.DEV
;	-----------------
;	! DEVICE NAME	!
;	-----------------
;	! UFD		!
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.NAM
;	-----------------
;	! FILE NAME	!
;	-----------------
;	! FILE EXT	!
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.SFD
;	-----------------
;	! SFD1		!
;	-----------------
;	! SFD2		!
;	-----------------
;
;		.
;
;		.
;
;	----------------------
;	! FLAGS	!     0	!	S.TTL!S.VER
;	-----------------
;	! SOURCE VER #	!
;	-----------------
;	! DATE  ! TIME  !
;	----------------------
;
;	ALSO S.LST MUST BE ON IN LAST BLOCK IF MORE THAN 1 TRIPLET



IFE .NWBLK,<
T.1003==E$$IRB##
>
;HERE ON A BLOCK TYPE 1003 (NAME BLOCK)

;AC USAGE IN T.1003 ROUTINES:
;
;	P1	AOBJN POINTER TO THE CURRENT SECONDARY TRIPLET
;	P2	OR OF ALL THE SECONDARY TRIPLET FLAG WORDS SEEN
;	P3	BIT MAP OF TRIPLETS WE KNOW WE'VE PASSED
;
;ALSO, THE W'S CONTAIN THE CURRENT TRIPLET AND THE T'S ARE SCRATCH.

IFN .NWBLK,<
T.1003:	RELOCATE (NONE)		;THIS BLOCK TYPE CONTAINS NO RELOCATION
	TRNE	FL,R.LIB!R.INC	;NEED AN EXCUSE TO LOAD THIS?
	SKIPE	INCPTR		;ANY POSSIBILITY WE'LL GET ONE?
	  CAIA			;DON'T NEED AN EXCUSE OR COULD GET ONE
	JRST	T.1000		;NO CHANCE, JUST IGNORE THIS BLOCK
	PUSHJ	P,D.TRIP	;GET THE FIRST TRIPLET
	  PUSHJ	P,T1003E	;ERROR
	TXNE	W1,PT.MSF	;DESCRIBES A SECOND SOURCE FILE?
	  JRST	T1003M		;YES, GO HANDLE SEPERATELY
;	TXNE	W1,PT.BLK	;JUST A LOCAL BLOCK HEADER?
;	  JRST	T1003G		;YES, GO STICK IN THE SYMBOL TABLE
	MOVE	T1,W1		;COPY FLAGS FOR DESTRUCTIVE TESTING
	TXC	T1,PT.SGN!PT.TTL ;THESE BITS SHOULD BE ON
	TXZ	T1,PT.EXT	;IGNORE THIS BIT HOWEVER
	JUMPN	T1,T1003E	;IF ANY BAD BITS, TELL OF ERROR
	TROE	FL,R.LOD	;DID WE SEE AND END BLOCK FOR LAST PRGM?
	  PUSHJ	P,E$$NEB##	;[1212] WARN USER, BUT TRY TO CONTINUE
	TRNE	FL,R.FHS	;FORCED TO HIGH SEGMENT?
	PUSHJ	P,T1003H	;YES, MAKE SURE THERE IS ONE
	MOVE	T1,LSYM		;WORD COUNT IN LOCAL SYMBOL TABLE
	MOVEM	T1,NAMPTR	;POINT TO THIS TITLE BLOCK
	MOVEM	W2,PRGNAM	;STORE 1ST 6 CHARS OF PROGRAM NAME
	SETZM	FBHPTR		;NO LOCAL BLOCK HEADERS YET
	.JDDT	LNKNEW,T.1003,<<CAMN W2,$NAME##>>
	AOS	PRGNO		;COUNT THIS PROGRAM IN TOTAL
;HERE TO SEE IF WE NEED TO COMPARE THE PROGRAM NAME AGAINST INC/EXC
;BLOCKS, AND IF SO, ALLOCATE A BLOCK TO STORE THE NAME IN AS WE GO
;ALONG. FIRST WORD OF BLOCK IS LENGTH, WORDS FOLLOWING ARE SIXBIT.

	SETZM	TTLADR		;ASSUME NO INC/EXC'S GIVEN
	SKIPN	INCPTR		;ARE THERE? (USUALLY NOT)
	SKIPE	EXCPTR		;MAYBE NEITHER, WHAT ABOUT IT?
	  CAIA			;ONE OR THE OTHER
	JRST	T1003R		;NEITHER, NO NEED TO WATCH TITLE
	MOVEI	T2,LN.SWV+1	;GET STORAGE FOR PROGRAM NAME
	PUSHJ	P,DY.GET##	;ONLY NEED LN.SWV, SINCE LONGER CAN'T
	HRLI	T1,-<LN.SWV-1>	;  BE INCLUDED OR EXCLUDED ANYWAY
	ADDI	T1,1		;BYPASS LENGTH (1ST WORD)
	MOVEM	T1,TTLADR	;AOBJN POINTER TO STORED TITLE
	MOVEM	W2,(T1)		;STORE 1ST 6 CHARS OF NAME
T1003R:	TXON	W1,PT.EXT	;MORE TRIPLETS COMING?
	  JRST	T1003F		;NO, GO FINISH SHORT TRIPLET
T1003A:	PUSHJ	P,LS.ADD##	;STORE THE PRIMARY TRIPLET
	MOVSI	P1,-STLEN	;SETUP TO PROCESS SECONDARY TRIPLETS
	SETZ	P2,		;NO SECONDARY TRIPLETS SEEN YET
	SETO	P3,		;AND NONE HAVE PASSED US BY


;HERE TO LOOP OVER THE INCOMING TRIPLETS, PROCESSING AS NEEDED
T1003L:	PUSHJ	P,D.TRIP	;READ IN THE NEXT TRIPLET
	  PUSHJ	P,T1003E	;SOMETHING'S WRONG
	TRNE	W1,-1		;ANY ILLEGAL BITS SET?
	  PUSHJ	P,T1003E	;YES, ILLEGAL BLOCK TYPE
T1003B:	MOVE	T1,W1		;GET FLAGS FOR DESTRUCTIVE TESTING
	TDC	T1,STBITS(P1)	;THESE BITS SHOULD BE OFF
	TXZ	T1,S.LST	;BUT DON'T CARE ABOUT THIS ONE
	TLNN	T1,-1		;IS THIS THE RIGHT TRIPLET?
	JRST	T1003C		;YES, GO PROCESS IT
	AOBJN	P1,T1003B	;NO, SEE IF IT'S THE NEXT TYPE
	PUSHJ	P,T1003E	;UNRECOGNIZED TRIPLET
;HERE TO PROCESS A RECOGNIZED TRIPLET
T1003C:	JFFO	P3,.+1		;COUNT TRIPLETS WE KNOW WE'VE PASSED
	CAIL	P4,(P1)		;SAME OR BETTER AS THOSE REALLY PASSED?
	JRST	T1003D		;YES, WE'RE OK
	LSH	P3,-1		;NO, FLAG WE'VE SEEN AT LEAST ONE MORE
	TXNN	P2,S.MSF	;NO ACTION NEEDED IN MSF BLOCKS
	PUSHJ	P,@STAFT(P4)	;TAKE THE ACTION NEEDED WHEN PASSING ONE
	JRST	T1003C		;AND GO SEE IF WE'VE MISSED ANY MORE
T1003D:	TXNN	P2,S.MSF	;IN MSF PROCESSING?
	  JRST	T1003W		;NO, PROCEED
	MOVX	T1,S.MSF	;YES, GET OK IN MSF BIT
	TDNN	T1,STBITS(P1)	;SET FOR THIS TRIPLET?
	  PUSHJ	P,T1003E	;NO, ERROR
	JRST	T1003Z		;YES, SKIP STBFR AND PROCEED
T1003W:	PUSHJ	P,@STBFR(P1)	;TAKE ANY ACTION NEEDED FOR THIS TRIPLET
T1003Z:	IOR	P2,W1		;ADD THESE FLAGS TO OUR COLLECTION
	TXNE	W1,S.LST	;IS THIS THE LAST TRIPLET?
	  JRST	T1003F		;YES, GO FINISH UP
	PUSHJ	P,LS.ADD##	;NO, ADD THIS ONE TO THE SYMBOL TABLE
T1003I:	MOVX	T1,S.MUL	;GET 'MULTIPLE OF THIS TYPE OK' BIT
	TXZN	P2,S.LST	;FORCED LAST AT LOWER LEVEL? (STRNAM)
	TDNN	T1,STBITS(P1)	;MORE THAN ONE OF THIS TRIPLET LEGAL?
	  CAIA			;NO, GET NEXT OR ERROR IF LAST
	JRST	T1003L		;YES, LOOK FOR ANOTHER
	AOBJN	P1,T1003L	;WILL FALL THRU TO ERROR IF NONE LEFT


;HERE ON SOME TYPE OF ERROR OR INVALID FORMAT IN THE 1003 BLOCK TYPE
T1003E:	MOVEI	T1,1003		;SHOULD NEVER GET HERE
	JRST	E$$IRB##	;[1174] SO WARN THE USER


;HERE IF /SEG:HIGH. MAKE SURE HIGH SEG EXISTS, THEN FAKE THE RC TABLES.
T1003H:	PUSH	P,W1		;SAVE OVER SETRC CALL
	SETZ	W1,		;CREATE HIGH SEGMENT WITH DEFAULT ORIGIN
	SKIPN	SG.TB+2		;HIGH SEGMENT EXIST ALREADY?
	PUSHJ	P,SETRC##	;NO, CREATE ONE
	MOVEI	R,1		;NOW MAKE .LOW. POINT TO HIGH SEG
	MOVE	T1,SG.TB+2	;ADDR OF HIGH SEG DATA BLOCK
	MOVEM	T1,@RC.TB	;MAKE .LOW. (RC #1) POINT TO IT
	POP	P,W1		;RESTORE FLAGS OF NEXT TRIPLET
	POPJ	P,
;HERE AT END OF SECONDARY TRIPLETS OR IF ONLY PRIMARY PRESENT
T1003F:	TXNN	P2,S.MSF	;MSF TRIPLET?
	TXZ	W1,S.LST	;NO, MORE TRIPLETS WILL FOLLOW
	PUSHJ	P,LS.ADD##	;OUTPUT THE LAST SECONDARY TRIPLET
	TXNE	P2,S.MSF	;CHECK FOR MSF AGAIN
	  JRST	T1003T		;IF SO, JUST TEST FOR LAST & QUIT
T1003X:	JFFO	P3,.+1		;MUST CHECK THESE BITS AGAIN
	CAIL	P4,STLEN	;DO WE KNOW WE'RE DONE?
	  JRST	T1003Q		;YES, GO DUMP S.SEG BLOCK & EXIT
	LSH	P3,-1		;WE'RE GETTING THERE
	PUSHJ	P,@STAFT(P4)	;FILL IN DEFAULTS ETC.
	JRST	T1003X		;MUST CHECK FOR BEING SURE WE'RE DONE


T1003Q:	PUSHJ	P,TTLRLC##	;DUMP RELOCATION COUNTER INFO
T1003T:	PUSHJ	P,D.GET1	;MAKE SURE S.LST DIDN'T LIE
	  JRST	LOAD##		;ALL OK, ******* EXIT FROM T.1003 ******
	PUSHJ	P,T1003E	;SOMETHING'S WRONG



;HERE WHEN THE 1ST TRIPLET OF A MSF BLOCK IS SEEN
T1003M:	MOVE	T1,W1		;GET FLAGS FOR DESTRUCTIVE TESTING
	TXC	T1,PT.SGN!PT.TTL!PT.MSF!PT.EXT	;FLAGS THAT MUST BE ON
	JUMPN	T1,T1003E	;SOMETHING'S WRONG
	HRRZ	T1,NAMPTR	;GET ADDR OF LAST TITLE BLOCK
	ADDI	T1,2		;POINT TO 3RD WORD (POINTER TO NEXT)
	SUB	T1,LW.LS	;CONVERT TO OFFSET FROM LS.LB
	JUMPL	T1,T1003P	;GO DO PAGING IF NOT IN CORE
	ADD	T1,LS.LB	;CONVERT TO PHYSICAL ADDRESS
	MOVE	T2,LSYM		;SETUP POINTER TO THIS TRIPLET
	HRROM	T2,(T1)		;STORE IN LAST BLOCK
T1003O:	HRRM	T2,NAMPTR	;UPDATE NAMPTR
	PUSHJ	P,LS.ADD##	;ADD PRIMARY TRIPLET TO THE LS AREA
	MOVSI	P1,-STLEN	;NOW SETUP TO PROCESS AS NORMAL
	MOVX	P2,S.MSF	;EXCEPT FLAG MSF BLOCK IN PROGRESS
	SETO	P3,		;NO TRIPLETS HAVE YET PASSED US BY
	JRST	T1003L		;AND JOIN MAIN LOOP


;HERE IF 3RD WORD OF PREVIOUS TITLE IS PAGED OUT. GENERATE A FIXUP
;INSTEAD OF READING IT BACK IN. PAGING ROUTINES WILL DO IT FOR US.

T1003P:	HRRZ	T2,NAMPTR	;ADDRESS OF TRIPLET TO BE FIXED UP
	HRLI	T2,SPF.TL	;TYPE OF FIXUP
	PUSH	P,W3		;VALUE GOES IN W3, BUT WE STILL NEED IT
	HRRO	W3,LSYM		;ADDR OF NEXT, LH MEANS THIS IS MSF
	MOVEI	R,FS.SS-FX.S0	;FIXUP IS TO LS AREA
	PUSHJ	P,SY.CHP##	;GENERATE THE FIXUP
	POP	P,W3		;RESTORE VALUE FROM NEXT 3RPLET
	MOVE	T2,LSYM		;POINTER TO NEW TITLE BLOCK
	JRST	T1003O		;RE-JOIN MAIN ROUTINE
;MACRO TO DESCRIBE THE PROPERTIES OF THE 2NDARY TITLE TRIPLETS.
;
;CALL:	X	(<NAME OF S.??? BIT>,<NON-BLANK IF EXTRA FLAGS>, 
			<TRIPLET SEEN ROUTINE>,<TRIPLET PASSED ROUTINE>)

	XALL
DEFINE	SECTTL,<

X	(,S.MUL!S.MSF,STRNAM,NAMRED);;	ADDITIONAL TITLE (SIXBIT)
X	(CMT,S.MUL,,MAPREL);;		ASCII COMMENT (REST OF TITLE)
X	(PRC,S.MUL,STRPRC,);;		PROCESSOR (COMPILER) INFO
X	(CRE,,,FAKCRE);;		COMPILATION TIME & COMP VERSION
X	(DEV,S.MSF,,);;			SOURCE DEVICE & UFD
X	(NAM,S.MSF,,);;			SOURCE NAME & EXTENSION
X	(SFD,S.MUL!S.MSF,,);;		SOURCE SFD'S
X	(VER,S.MSF,,);;			SOURCE FILE VERSION & CREATION

>


DEFINE	X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <FLGBIT>,<IFB <XFLAG>,<
	EXP	S.TTL			;FLGBIT
>
IFNB <XFLAG>,<
	EXP	S.TTL!'XFLAG		;FLGBIT
>>
IFNB <FLGBIT>,<IFB <XFLAG>,<
	EXP	S.TTL!S.'FLGBIT		;FLGBIT
>
IFNB <XFLAG>,<
	EXP	S.TTL!S.'FLGBIT!'XFLAG	;FLGBIT
>>>


;SECONDARY TRIPLET FLAG BITS IN THE ORDER EXPECTED IN THE .REL FILE
STBITS:	SECTTL
STLEN==.-STBITS
DEFINE	X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <SEEN>,<
	EXP	CPOPJ		;FLGBIT
>
IFNB <SEEN>,<
	EXP	SEEN		;FLGBIT
>>

;ROUTINES TO EXECUTE WHEN WE SEE A PARTICULAR TRIPLET
STBFR:	SECTTL


DEFINE	X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <PASSED>,<
	EXP	CPOPJ		;FLGBIT
>
IFNB <PASSED>,<
	EXP	PASSED		;FLGBIT
>>

;ROUTINES TO EXECUTE AFTER WE KNOW WE'VE PASSED A TRIPLET
STAFT:	SECTTL



	SALL
;HERE WHEN A NAME TRIPLET IS SEEN. STORE NAME FOR INCLUDE/EXCLUDE.
STRNAM:	SKIPN	T1,TTLADR	;STILL IN BUSINESS?
	POPJ	P,		;NO, NOTHING TO STORE
	AOBJP	T1,UNSTOR	;ANY ROOM LEFT?
	MOVEM	W2,(T1)		;YES, STORE FIRST WORD
	JUMPE	W3,[IORX P2,S.LST	;IS THIS THE LAST ONE?
		JRST	.+3]	;YES, FORCE LAST & RETURN FOR NEXT
	AOBJP	T1,UNSTOR	;NO, ANY ROOM?
	MOVEM	W3,(T1)		;YES, STORE HIM TOO
	MOVEM	T1,TTLADR	;RESET AOBJN PTR
	POPJ	P,

;HERE TO FREE THE INC/EXC BLOCK AND FLAG NOT TO CHECK INC/EXC.
UNSTOR:	HLRO	T2,TTLADR	;FIND LENGTH USED SO FAR
	ADDI	T2,LN.SWV	;SO WE CAN FIND 1ST WORD IN BLOCK
	HRRZ	T1,TTLADR	;POINT TO CURRENT WORD
	SUBI	T1,0(T2)	;BACK UP TO FIRST ONE
	MOVEI	T2,LN.SWV+1	;WHOLE BLOCK IS THIS LONG
	SETZM	TTLADR		;FLAG WE'RE NO LONGER LOOKING
	PUSHJ	P,DY.RET##	;FREE THE BLOCK
	TRNN	FL,R.LIB!R.INC	;GOING TO LOAD THIS?
	POPJ	P,		;YES, KEEP GOING
;	PJRST	UNLOAD		;NO, STOP IT NOW

;HERE WHEN WE HAVE DECIDED NOT TO LOAD AFTER ALL. ABORT EVERYTHING.
UNLOAD:	SOS	PRGNO		;UNDO OUR PREVIOUS WORK
	MOVE	T1,NAMPTR	;POINTS TO WHERE LSYM USED TO BE
	SUB	T1,LSYM		;DON'T NEED TO WORRY ABOUT PAGING
	ADDM	T1,LSYM		;SINCE ALL TRIPLETS WILL STILL BE IN
	ADDM	T1,LS.FR	;SINCE (3/2)*LN.SWV .LT. .IPS
IFL <.IPS>-<<3*LN.SWV>/2>,<PRINTX ?HORRIBLE ERROR>	;SEE?
	ADDB	T1,LS.PT	;IF MSG APPEARS, LN.SWV IS TOO BIG!!
	HRL	T1,T1		;NOW ZERO ALL THE UNUSED DATA
	ADDI	T1,1		;THAT USED TO CONTAIN OUR TRIPLETS
	SETZM	-1(T1)		;ZAP FIRST WORD
	BLT	T1,@LS.AB	;AND THE REST
	TRZ	FL,R.LOD	;NO LONGER LOADING
	TRO	FL,R.LIB	;MAKE SURE REST OF MODULE IS IGNORED
	HRROI	W1,400000(WC)	;PUT WORD COUNT WHERE T.1000 CAN GET IT
	MOVN	W1,W1		;MAKE POSITIVE
	POP	P,0(P)		;RE-ADJUST STACK
	JRST	T.1000		;IGNORE REST OF THIS BLOCK
;HERE WHEN THE PROGRAM NAME HAS BEEN READ IN COMPLETELY
NAMRED:	SKIPN	TTLADR		;LOADING A SUPER-LONG TITLE?
	JRST	E01LMN		;[1174] YES, BROADCAST ITS NAME AND RETURN
	PUSH	P,W2		;SAVE OVER CALLS TO LNKOLD
	HLRO	T1,TTLADR	;GET WORDS LEFT IN AOBJN PTR
	ADDI	T1,LN.SWV	;CONVERT TO WORDS USED
	HRRZ	W2,TTLADR	;RH(W2) IS PTR TO START OF NAME
	SUBI	W2,(T1)		;RESET W2 FROM AOBJN'S
	MOVEM	T1,0(W2)	;BLOCK IS CNT, THEN <SIXBIT LIST>
	CAIN	T1,1		;UNLESS THIS IS A SHORT TITLE
	MOVE	W2,1(W2)	;IN WHICH CASE WE WANT THE TITLE ITSELF
	TRNE	FL,R.LIB!R.INC	;NEED AN EXCUSE TO LOAD THIS MODULE?
	  JRST	NAMINC		;YES, SEE IF WE HAVE ONE
	PUSHJ	P,EXCCHK##	;CONVERSELY, MAKE SURE NOT FORBIDDEN
	  JRST	NAMPOP		;IT IS, ABORT LOADING NOW
LOADIT:	TRZ	FL,R.LIB!R.INC	;LOADING FOR SURE
	POP	P,W2		;RESTORE SYMBOL FROM NEXT TRIPLET
E01LMN::.ERR.	(MS,.EC,V%L,L%I5,S%I,LMN) ;[1174] TELL WHAT WE'RE LOADING
	.ETC.	(LSP,.EC!.EP,,,,NAMPTR)	;[1303]
	.ETC.	(STR,.EC,,,,,< from file >) ;[1303]
	.ETC.	(FSP,,,,,DC) ;[1303]
	POPJ	P,


;HERE WHEN WE NEED AN EXCUSE TO LOAD THIS MODULE
NAMINC:	PUSHJ	P,INCCHK##	;IN /INCLUDES?
	  CAIA			;NO, ABORT
	JRST	LOADIT		;YES, PROCEED
NAMPOP:	POP	P,W2		;RESTORE W2 (FIX STACK)
	TRO	FL,R.LIB	;FLAG TO NOT LOAD
	JRST	UNSTOR		;AND ABORT LOADING
;HERE WHEN TIME TO OUTPUT THE REL FILE INFO.
MAPREL:	SPUSH	<W1,W2,W3>	;SECREL USES THESE AC'S
	PUSHJ	P,TTLREL##	;OUTPUT THE REL FILE INFO
	SPOP	<W3,W2,W1>	;RESTORE CURRENT TRIPLET
	POPJ	P,		;DONE


;HERE ON THE PROCESSOR NAME TRIPLET(S).
;STORE THE CPU BITS, & CALL COMPILER SPECIFIC ROUTINES.
STRPRC:	TXNE	P2,S.PRC	;IS THIS THE FIRST SUCH TRIPLET?
	POPJ	P,		;NO, JUST STORE EXTENDED C. NAME
REPEAT 0,<
	MOVEM	W3,CTYPE	;YES, STORE XWD C.TYPE,CPU BITS
	HLRZ	T1,W3		;RETRIEVE COMPILER TYPE INDEX
	CAILE	T1,CT.LEN	;EVER HEARD OF IT?
	JRST	[SETZ	T1,		;NO, MAKE IT UNKNOWN
		HRRZS	W1,CTYPE	; ..
		JRST	.+1]		;CONTINUE
	HRRZ	T2,W3		;GET CPU TYPE INDEX
	CAILE	T2,CP.LEN	;KNOWN TYPE?
	JRST	[SETZ	T2,		;NO, MAKE UNKNOWN
		HLLZS	W3,CTYPE	; ..
		JRST	.+1]		;CONTINUE
	MOVE	T3,PROCSN	;GET BIT MAP OF COMPILERS SEEN SO FAR
	MOVE	T4,CPUSN	;AND CPUS SEEN (NEITHER COUNTS THIS ONE)
> ;[1440]
	LDB	T1,[POINT 6,W3,5] ;[1440] GET RUNNABLE CPU BITS
	ANDI	T1,CP.MSK	;[1440] CLEAR CPUS WE DON'T KNOW ABOUT
	JUMPN	T1,.+2		;[1440] ASKED FOR NONE?
	MOVEI	T1,CP.MSK	;[1440] YES--MEANS ALL
	HRRZM	T1,CTYPE	;[1440] SAVE WITH COMPILER TYPE
	MOVE	T2,CPUTGT	;[1440] GET TARGET CPUS
	JUMPE	T2,NOTGT	;[1440] THE CPU SWITCHES ARE NOT BEING USED
	TDON	T1,T2		;[1440] TEST FOR A GOOD TARGET SWITCH
	JRST	E$$CPU##	;[1440] .DIRECTIVE IS FOR WRONG CPU
NOTGT:	SKIPN	OKCPUS		;[1440] CAN ANY CPU RUN THIS CODE?
	JRST	CPUEND		;[1440] NO--FORGET THIS TEST
	ANDM	T1,OKCPUS	;[1440] ENFORCE CPU FLAGS
	SKIPN	OKCPUS		;[1440] CAN PROG RUN AT ALL NOW?
	PUSHJ	P,E$$CCD##	;[1440] NO--CPU CONFLICT DETECTED
CPUEND:	LDB	T1,[POINT 12,W3,17] ;[1440] NOW GET PROCESSOR TYPE
	HRRZS	(P)		;[1440] LEAVE JUST BLANK COMMON ON STACK
	CAILE	T1,CT.LEN	;CHECK FOR RANGE
	SETZ	T1,		;[1440] MAKE IT UNKNOWN
	HRLM	T1,CTYPE	;[1440] SAVE COMPILER TYPE
	MOVE	T2,PROCSN	;[1440] GET LIST OF PROCS SEEN SO FAR
	MOVE	P1,T1		;SAFE PLACE
	PUSH	P,[0]		;ALGNAM WANTS -1(P) SET UP
	XCT	CT.NAM##(T1)	;CALL C. SPECIFIC ROUTINE OR JFCL
	POP	P,0(P)		;CLEAR 0 PUSHED ABOVE
	HLRZ	T1,W3		;RETRIEVE COMPILER INDEX
	MOVE	T1,CT.BIT##(T1)	;GET BIT CORRESPONDING TO THIS ONE
	IORM	T1,PROCSN	;INCLUDE IN MASK OF ALL SEEN SO FAR
	IORM	T1,LIBPRC	;ALSO IN SPECIAL MASK FOR LIB SEARCHING
REPEAT 0,<	MOVE	T1,CP.BIT##(W3)	;GET BIT CORRESPONDING TO CPU TYPE
	IORM	T1,CPUSN	;UPDATE MASK OF ALL SEEN SO FAR
>	;[1440]
	POPJ	P,
;HERE WHEN CRE HAS BEEN PASSED. FAKE IT FROM THE REL FILE IF NOT THERE
FAKCRE:	TXNE	P2,S.CRE	;DID WE SEE A REAL S.CRE TRIPLET?
	  POPJ	P,		;YES, NO NEED TO FAKE IT
	LDB	T2,[POINT 12,FCRE,35]	;LOW 12 BITS OF DATE
	LDB	T1,[POINT  3,FEXT,20]	;HIGH 3 BITS
	DPB	T1,[POINT  3,  T2,23]	;MERGE DATE INTO T2
	LDB	T1,[POINT 11,FCRE,23]	;GET TIME (MINS) IN T1
	IMULI	T1,^D60*^D1000	;SCAN WANTS TIME IN MILLISECONDS
	PUSHJ	P,.CNVDT##	;CONVERT TO UNIVERSAL FORMAT
	SPUSH	<W1,W2,W3>	;SAVE NEXT TRIPLET SO WE CAN FAKE ONE
	MOVX	W1,S.TTL!S.CRE	;FLAGS FOR CREATION TIME INFO TRIPLET
	MOVE	W2,T1		;CREATION TIME (UNIVERSAL FORMAT)
	SETZ	W3,		;COMPILER VERSION IS UNKNOWN
	PUSHJ	P,LS.ADD##	;STORE WHERE MAP CAN FIND IT
	SPOP	<W3,W2,W1>	;RESTORE NEXT TRIPLET
	POPJ	P,
> ;END IFN .NWBLK ON PAGE 13

SUBTTL	BLOCK TYPE 1004 - BYTE ARRAY INITIALIZATION


;				or
;
;	----------------		----------------
;	! 1004 ! count !		! 1004 ! count !
;	----------------		----------------
;	!   relocation !		!   relocation !
;	----------------		----------------
;	!   byte count !		! global symbol!
;	----------------		----------------
;	! byte pointer !		!   byte count !
;	----------------		----------------
;	!  byte string !		! byte pointer !
;	----------------		----------------
;	!      ...     !		!  byte string !
;	----------------		----------------
;					!      ...     !
;					----------------

T.1004:	HRRZS	WC,W1		;FAKE UP OLD TYPE RELOC WORD
	JUMPE	W1,LOAD##	;IGNORE 0 ENTRIES
	PUSH	P,W1		;SAVE NO. OF WORDS LEFT
	PUSHJ	P,RB.2##	;READ AND RELOCATE FIRST TWO WORDS
	  JRST	LOAD		;FAILED, TRY NEXT BLOCK
	TLNN	W2,770000	;IS IT A 6-BIT GLOBAL SYMBOL?
	JRST	T1004A		;NO
	PUSH	P,W1		;YES, SAVE BYTE COUNT
	PUSHJ	P,T.1S6##	;CALL T.1 CODE TO EVALUATE SYMBOL
	TLZ	W1,77		;[1470] NO BOGUS INDEX REGISTERS	
	POP	P,W2		;RESTORE BYTE COUNT
	SOS	(P)		;ONE LESS DATA WORD
T1004A:	POP	P,R3		;SAFE PLACE FOR WORD COUNT
	SUBI	R3,3		;NO. OF DATA WORDS LEFT
	LDB	T3,[POINT 6,W1,11]	;GET BYTE SIZE
	MOVEI	T1,^D36
	IDIVI	T1,(T3)		;GET NO. OF BYTES PER WORD
	MOVE	P3,T1		;PUT NO. OF BYTE PER WORD IN SAFE PLACE
	LDB	T1,[POINT 6,W1,5]
				;[1445]
	IDIVI	T1,(T3)		;SEE HOW MANY BYTES LEFT IN FIRST WORD
	JUMPE	T1,[TLZ	W1,770000	;WANTS TO POINT TO NEXT WORD
		TLO	W1,440000	;SO CHANGE BYTE POINTER
		AOJA	W1,T1004B]	;AND ADDRESS
	CAIN	T1,(P3)		;IS IT A FULL WORD?
	SETZ	T1,		;YES, THEN NO EXTRA BYTES NEEDED
T1004B:	ADD	T1,W2		;TOTAL NO. OF BYTES
	IDIVI	T1,(P3)		;GET NO. OF WORDS
	SKIPE	T2
	ADDI	T1,1		;PLUS 1 FOR LAST PARTIAL WORD
	PUSH	P,P3		;[1470] SAVE BYTES PER WORD
	PUSH	P,W2		;SAVE BYTE COUNT
	PUSH	P,W1		;SAVE BYTE POINTER
	HRRZS	P3,W1		;START ADDRESS OF ARRAY
	HLL	P3,LSTRRV	;[1742] Insert section number
	ADDI	W1,(T1)		;END ADDRESS OF ARRAY
	HLL	W1,LSTRRV	;[1742] Insert section number
	SETZ	W3,		;SIGNAL JUST RETURN FROM T.1 CODE
	PUSHJ	P,T.1AD##	;SET UP FOR DATA STORE
	  JRST	T1004Z		;[1776] THROW IT AWAY
	  JRST	T1004Z		;[1776] THROW IT AWAY
	HRRM	P3,(P)		;FIXUP READ BYTE POINTER ON STACK
	SKIPG	DCBUF+2		;IF REL BLOCK EMPTY?
T1004C:	PUSHJ	P,D.CNT##	;[1467] YES, GET A NEW BLOCK
	POP	P,P1		;GET DESTINATION BYTE POINTER
	POP	P,T4		;GET DESTINATION COUNT
	POP	P,P3		;[1470] GET BYTES PER WORD
	CAMG	R3,DCBUF+2	;ARE THERE ENOUGH WORDS IN REL BUFFER?
	JRST	T1004D		;YES
	MOVE	T1,R3		;[1470] NO. OF WORDS IN REL FILE
	SUB	T1,DCBUF+2	;[1470] LESS WHATS IN REL BUFFER
	PUSH	P,T1		;[1470] NO. LEFT TO DO NEXT TIME
	MOVE	T1,DCBUF+2	;NO. OF WORDS IN REL BUFFER
	IMULI	T1,(P3)		;NO. OF BYTES IN REL BUFFER
	EXCH	T1,T4		;T4 = NO. OF BYTES WE CAN DO THIS TIME
	SUBI	T1,(T4)		;DIFFERENCE
	PUSH	P,T1		;STORE DIFFERENCE FOR NEXT TIME
	SKIPA	R3,DCBUF+2	;NO. WE WILL DO THIS TIME
T1004D:	PUSH	P,[0]		;SIGNAL ALL DONE
	MOVE	T1,T4		;SET BOTH COUNTS THE SAME
	HRRZ	T2,DCBUF+1	;GET SOURCE BYTE ADDRESS
	HLL	T2,P1		;CONVERT TO BYTE POINTER
	TLZ	T2,770000	;CLEAR STORE BYTE START
	ADD	T2,[440000,,1]	;FORM BYTE POINTER WE REALLY WANT
	ADDM	R3,DCBUF+1	;ADVANCE REL POINTER
	MOVN	T3,R3
	ADDM	T3,DCBUF+2	;DECREMENT REL COUNT
	SETZB	T3,P2		;JUST TO BE SAFE
IFN TOPS20,<
	EXTEND	T1,[MOVSLJ]	;MOVE THE STRING
	  JFCL
>
IFE TOPS20,<
	ILDB	T3,T2		;GET A BYTE
	IDPB	T3,P1		;STORE IT
	SOJG	T1,.-2		;LOOP
>
	POP	P,T4		;NO. OF BYTES LEFT TO MOVE
	JUMPE	T4,LOAD		;ALL DONE
	POP	P,R3		;NO. OF WORDS LEFT IN REL BLOCK
	PUSH	P,P3		;[1470] SAVE BYTES PER WORD
	PUSH	P,T4		;SAVE COUNT
	PUSH	P,P1		;SAVE DESTINATION POINTER
	JRST	T1004C		;GET NEXT REL BUFFER

;Enter here from error in T.1S code
;Clean up and just ignore this block.

T1004U::.ERR.	(MS,.EC,V%L,L%W,S%W,USB,<Undefined symbol in byte array (type 1004) block>)
	.ETC.	(JMP,,,,,.ETIMF##)
	POP	P,T1		;POP OFF THE RETURN ADDRESS
	MOVE	R3,-1(P)	;RESTORE THE WORD COUNT
	SUBI	R3,3		;ACCOUNT FOR THE WORDS WE HAVE ALREADY READ
T1004Z:	POP	P,T1		;CLEAN UP THE STACK
	POP	P,T1		; ...
	POP	P,P3		;[1470]  ...
	MOVE	W1,R3		;RESTORE WORD COUNT
	JRST	T.1000		;AND JUST IGNORE THE BLOCK

SUBTTL BLOCK TYPE 1010-1014 RIGHT HALF RELOCATION


;
;			--------------------
;			!  101X  !    n    !	header word
;			!------------------!
;			!b1!b2!  ...    !bi!	-----
;			!------------------!	     !
;			! beginning addr.  !	     !
;			!------------------!	     !
;			! data 1           !	     !--- subblock
;			!------------------!	     !    
;			//      ....      //	     !
;			!------------------!
;			!  data(i-1)       !	-----
;			--------------------
;				...
	DEFINE NEWBLK(RBSIZ,RBNUM,RELTYP)<

	MOVE	P1,[POINT RBSIZ,RB,-1]		;;HOW TO ACCESS RELOC BYTES
	MOVEI	P2,RBNUM			;;NUMBER OF RELOC BYTES
	MOVE	P4,[ RELTYP ]			;;HOW TO DO THE RELOC
	JRST	T.NYBT				;;COMMON CODE TO INTERPRET THIS
	>	;[1405]
						
	CPSECT=.TEMP##				;[1405] TEMPORARY

T.1010::
	NEWBLK(2,^D18,RADD)			;[1405]

T.1011::
	NEWBLK(3,^D12,RADD)			;[1405]

T.1012::
	NEWBLK(6,6,RADD)			;[1405]

T.1013::
	NEWBLK(9,4,RADD)			;[1405]

T.1014::
	NEWBLK(18,2,RADD)			;[1405]

SUBTTL BLOCK TYPES 1020-1023 LEFT/RIGHT HALFWORD RELOCATION

;
;			--------------------
;			!  102X  !    n    !
;			!------------------!
;			!l1,r1! ...  !li,ri!   --
;			!------------------!    |
;			! beginning addr.  !    |
;			!------------------!    |
;			! data 1           !    |
;			!------------------!    | -- subblock
;			//      ....      //    |
;			!------------------!    |
;			!  data(i-1)       !    |
;			--------------------   --
;				...
;

T.1020::
	NEWBLK(2,^D9,RLADD)			;[1405]

T.1021::
	NEWBLK(3,6,RLADD)			;[1405]

T.1022::
	NEWBLK(6,3,RLADD)			;[1405]

T.1023::
	NEWBLK(9,2,RLADD)			;[1405]

SUBTTL BLOCK TYPES 1030-1034 FOR 30-BIT RELOCATION
;
;			--------------------
;			!  103X  !    n    !	header word
;			!------------------!
;			!b1!b2!  ...    !bi!	-----
;			!------------------!	     !
;			! beginning addr.  !	     !
;			!------------------!	     !
;			! data 1           !	     !--- subblock
;			!------------------!	     !    
;			//      ....      //	     !
;			!------------------!
;			!  data(i-1)       !	-----
;			--------------------
;
						

T.1030::
	NEWBLK(2,^D18,THADD)			;[1405]

T.1031::
	NEWBLK(3,^D12,THADD)			;[1405]

T.1032::
	NEWBLK(6,6,THADD)			;[1405]

T.1033::
	NEWBLK(9,4,THADD)			;[1405]

T.1034::
	NEWBLK(18,2,THADD)			;[1405]

SUBTTL SUBROUTINES SUPPORTING BLOCK TYPES 1010-1034

PB.1:
;
; This routine can return in one of three ways:
; +1	means the end of the REL block has been seen.
; +2	means the end of the sub-block has been seen.
; +3	means that a word has been placed in W1 and its
;	corresponding psect index is found in R
;
	TRNN	WC,377777		;[1405] END OF BLOCK?
	JRST	PB0			;[1405] YES, RETURN +1
	PUSHJ	P,D.IN1##		;[1471] PICK UP A WORD
	AOBJP	WC,PB1			;[1471] END OF SUBBLOCK?
	ILDB	R,P1			;[1405] AND A PSECT INDEX
PB2:	AOS	(P)			;[1405]
PB1:	AOS	(P)			;[1405]
PB0:	POPJ	P,			;[1405]

PSORGN:
;
;	On entry, R contains a psect index.
;	Check this index against the total number seen.
;	Return in R the pointer to this psect's relocation counter

	JUMPE	R,CPOPJ			;[1444] LEAVE ABS DATA ALONE	
	CAMG	R,RC.NO			;PSECT INDEX EXIST?
	JRST	PSORG0			;[1405] YES
	CAIG	R,2			;[1405] MIGHT BE TWOSEG?
	TRNN	FL,R.TWSG		;[1405]
	JRST	E$$IPX##		;NO, GIVE ERROR
	SKIPA				;[1405] YES, FETCH COUNTER DIRECTLY
PSORG0:	HRRZ	R,@RC.MAP		;[1444] GET INTERNAL PSECT NUMBER
	MOVE	R,@RC.TB		;[1405] FETCH COUNTER
	SKIPGE	RC.AT(R)		;[1405] ORIGIN SET?
	JRST	R.ERR##			;[1405] NO, NEEDS AN ORIGIN
	POPJ	P,			;[1405] RETURN

RADD:
; 
;	Right-half relocation.
;
	JUMPE	R,CPOPJ			;[1444] LEAVE ABS VALUES ALONE
	HRR	T2,W1			;[1444] PICK UP THE HALFWORD
	PUSHJ	P,TSTSEG		;[1444]
	ADD	T1,T2			;[1444] ADD IN THE PSECT ORIGIN
	HRR	W1,T1			;[1405] RELOCATED HALFWORD
	POPJ	P,
THADD:
;
;	Thirty-bit relocation.
;
	JUMPE	R,CPOPJ			;[1444] LEAVE ABS VALUES ALONE
	LDB	T2,[POINT 30,W1,35]	;[1405] PICK UP EXTENDED ADDR
	PUSHJ	P,TSTSEG		;[1444]
	ADD	T1,T2			;[1444] ADD IN THE PSECT ORIGIN
	DPB	T1,[POINT 30,W1,35]	;[1405] AND PUT IT BACK
	POPJ	P,
RLADD:
;
;	Relocation of left and right halfwords.
;
	JUMPE	R,LADD			;[1722] LEAVE ABS VALUES ALONE
	HLR	T2,W1			;[1444] PICK UP LEFT HALF
	PUSHJ	P,TSTSEG		;[1444]
	ADD	T1,T2			;[1444] ADD IN THE PSECT ORIGIN
	HLRM	T1,W1			;[1405] RELOCATED LEFT HALF
LADD:	ILDB	R,P1			;[1722] FETCH NEXT RELOC BYTE
	PUSHJ	P,PSORGN		;[1405] CHECK IT OVER
	JRST	RADD			;[1405] FINISH WITH RIGHTHALF

TSTSEG:
; [1444] This routine picks up the value to be added in for relocating
; a word against a psect -- special case code for .HIGH. and .LOW. is
; here.

	MOVE	T1,RC.NM(R)		;[1444] WHAT IS IT?
	CAME	T1,[SIXBIT /.HIGH./]	;[1444] HIGHSEG?
	CAMN	T1,[SIXBIT /.LOW./]	;[1444] OR LOWSEG?
	JRST	[ MOVE	T1,RC.SG(R)	;[1444] IF SO,
		  MOVE	T1,LL.S0(T1)	;[1444] CALCULATE RELOCATION
		  ADD	T1,RC.CV(R)	;[1444] SOMEWHAT DIFFERENTLY
		  SUB	T1,RC.IV(R)	;[1444]
		  JRST	CPOPJ	]	;[1444] AND RETURN
	MOVE	T1,RC.CV(R)		;[1727] ELSE RELOC WRT. ORIGIN
	POPJ	P,			;[1770]

T.NYBT:
;
;  T.1010 through T.1037 come here after setting up ACs as follows:
;	P1	-an initialized byte pointer for the relocation bytes
;	P2	-number of relocation bytes in the word
;	P4	-dispatch address for type of relocation (left,right,30bit)
;
	SPUSH <P1,P2>			;[1405] SAVE REGISTERS
TNYBTB:	MOVN	T1,P2			;[1726] WC GETS SUBBLOCK COUNT AGAIN
	HRLI	WC,-2(T1)		;[1726] COUNT INCLUDES RELOC WORD
; BEGIN PROCESSING A SUB-BLOCK
	PUSHJ	P,PB.1			;[1405] FETCH FIRST WORD OF BLOCK
	  JRST	[ SPOP	<P2,P1>
		  JRST	LOAD	]	;[1405] NO MORE IN BLOCK
	  JFCL				;[1405] "IMPOSSIBLE"
	MOVE	RB,W1			;[1405] SETUP RELOC BYTE
	MOVE	P1,-1(P)		;[1405] RESET BYTEPOINTER
	PUSHJ	P,PB.1			;[1405] FETCH START ADDRESS
	  JRST	[ SPOP <P2,P1>
		  JRST LOAD	]	;[1405] NO MORE
	  JFCL				;[1405] "IMPOSSIBLE"
	PUSHJ	P,PSORGN		;[1405] FETCH THE RELOC COUNTER PTR
	MOVEM	R,CPSECT		;[1405] "CURRENT PSECT" COUNTER PTR
	PUSHJ	P,THADD			;[1503] RELOCATE THE START ADDR
	MOVE	P3,W1			;[1405] PICK UP START ADDRESS
;
;[1721] Here compute the size of the subblock into P2 The number of
;[1721] of words in the rest of the block is in the right half of WC and the
;[1721] subblock cannot have more than P2-1 words in it.
;
	HRROI	T1,400000(WC)		;[1721] RECOVER SIZE OF BLOCK ( RH OF
	MOVN	T1,T1			;[1721] WC CONTAINS -( SIZE + 400000 )
	SUBI	P2,2			;[1721] SIZE OF SUBBLOCK IN P2 INCLUDES
					;[1721] REL WORD, SO DECR IT ONCE AND
					;[1721] AGAIN FOR THE FENCE IN
					;[1721] "FINISH=START+SIZE-1" BELOW
	CAIL	P2,-1(T1)		;[1721] SHORT SUBBLOCK?
	MOVEI	P2,-1(T1)		;[1721] YES, USE SIZE OF BLOCK-1
	ADDB	P2,W1			;[1776] HIGHEST LOCATION TO BE LOADED
	PUSHJ	P,T.1AD			;[1776]	
	  JFCL				;[1776] THROW IT AWAY
	  JFCL				;[1776] DEFER IT AWHILE
TNYBTL:	PUSHJ	P,PB.1			;[1405] FETCH A DATA WORD
	  JRST	[ SPOP <P2,P1>
		  JRST	LOAD	]	;[1405] NO MORE
	  JRST	[ DMOVE P1,-1(P)	;[1726] FETCH PTR AND COUNT AGAIN
		  JRST	TNYBTB  ]	;[1405] RESET FOR NEXT SUBBLOCK
	PUSHJ	P,PSORGN		;[1405] GET ANY PSECT INDICES
	PUSHJ	P,@P4			;[1405] DO THE RELOCATION
IFN FTOVERLAY,<
	SKIPE	RT.LB			;[1730] DOING OVERLAYS?
	SKIPA	W3,[JSP T1,CS.RHS##]	;[1730] YES, NOTE OVL RELOC
> ;[1401] END OF IFN FTOVERLAY
	MOVE	W3,[MOVEM W1,(P3)]	;[1730] NO, SIMPLE DEPOSIT
	XCT	W3			;[1730]
	AOJA	P3,TNYBTL		;[1714] INCR DESTINATION PTR AND
					;[1714] DO IT AGAIN

SUBTTL	BLOCK TYPES 1042 AND 1043 - PROGRAM AND LIBRARY REQUESTS

;	-----------------
;	! 1042  ! COUNT !
;	-----------------
;	!   DEVICE      !
;	-----------------
;	!  FILE NAME    !
;	-----------------
;	! EXT   !DIR CNT!
;	-----------------
;	! PROJ  ! PROG  !
;	-----------------
;	!     SFD       !
;	-----------------
;
;		.
;
;		.
IFN .NWBLK,<
T.1042:	SKIPA	P1,[PRGPTR]	;TYPE 1042 IS PROGRAMS TO LOAD
T.1043:	MOVEI	P1,LIBPTR	;TYPE 1043 IS LIBRARIES TO SEARCH
	RELOCATE (NONE)		;FILE NAMES ETC ARE NOT RELOCATABLE
	PUSHJ	P,D.TRIP	;GET THE 1ST THREE WORDS (REQUIRED)
	  JRST	E$$IRR		;[1174] ERROR - NOT ENOUGH DATA WORDS
T1042A:	MOVEI	T2,R.LEN	;LENGTH OF A REQUEST/REQUIRE BLOCK
	PUSHJ	P,DY.GET##	;ALLOCATE ONE
	DSTORE	W1,<R.DEV(T1)>,<R.NAM(T1)>	;STORE DEVICE & FILENAME
	HLLZM	W3,R.EXT(T1)	;STORE EXTENSION, BUT NOT COUNT
	HRRZ	P2,W3		;REMEMBER DIRECTORY LENGTH IN P2
	JUMPE	P2,T1042X	;DONE IF NO DIRECTORY GIVEN
	PUSHJ	P,D.GET1	;GET THE PPN
	  JRST	E$$IRR		;[1174] ERROR
	MOVEM	W1,R.PPN(T1)	;REMEMBER IT
	SOJLE	P2,T1042X	;DONE IF NO SFD'S
	MOVE	T2,T1		;GET A COPY OF REQUEST BLOCK POINTER
	HRLI	T2,-5		;MAKE AN AOBJN POINTER FOR SFD'S
T1042L:	PUSHJ	P,D.GET1	;GET THE NEXT SFD
	  JRST	E$$IRR		;[1174] NONE THERE, COUNT LIED
	MOVEM	W1,R.SFD(T2)	;STORE THIS SFD
	SOJLE	P2,T1042X	;QUIT IF COUNT RUNS OUT
	AOBJN	T2,T1042L	;OR IF NO MORE ROOM IN OUR BUFFERS
T1042X:	PUSHJ	P,T.RQST##	;GO CHAIN THIS REQUEST IN IF UNIQUE
	PUSHJ	P,D.TRIP	;ANYTHING ELSE THERE?
	  JRST	LOAD##		;NO, LOAD NEXT BLOCK
	JRST	T1042A		;YES, LOAD IT TOO

E$$IRR::.ERR.	(MS,.EC,V%L,L%W,S%W,IRR,<Illegal request/require block>) ;[1174]
	.ETC.	(JMP,,,,,.ETNMF##) ;[1174]
	JRST	LOAD##		;NOT ALWAYS A FATAL ERROR

SUBTTL	BLOCK TYPE 1044 - BLOCK STRUCTURED ALGOL LOCAL SYMBOLS

;	-----------------
;	! 1044  ! COUNT !
;	-----------------
;	!  STRUCTURED   !
;	-----------------
;	! ALGOL SYMBOLS !
;	-----------------
;	!  SIXBIT - MAY !
;	-----------------
;	!  BE EXTENDED  !
;	-----------------
;
;		.
;
;		.


;THIS BLOCK TYPE INSERTED IN EDIT 471
T.1044:	SKIPE	NOSYMS		;NO SYMBOLS REQUESTED?
	PJRST	T.1000		;YES, DUMP THIS BLOCK
	RELOCATE (NONE)		;NO RELOCATION INFO IN ALGOL SYMBOLS
T1044L:	PUSHJ	P,D.GET1	;READ NEXT WORD OF DATA
	  JRST	LOAD##		;END OF BLOCK
	SKIPG	AS.FR		;ENOUGH ROOM LEFT IN AS AREA?
	  JRST	T1044G		;NO, GET SOME MORE
T1044P:	MOVEM	W1,@AS.PT	;PUT CURRENT DATUM IN PLACE
	AOS	AS.PT		;UPDATE FREE POINTER
	SOS	AS.FR		;AND FREE COUNT
	AOS	ASYM		;COUNT ONE MORE WORD OF ALGOL SYMBOLS
	JRST	T1044L		;LOOP OVER ENTIRE ALGOL SYMBOL BLOCK

;HERE TO GET MORE FREE SPACE IN THE AS AREA
T1044G:	MOVEI	P1,AS.IX	;POINT TO THE AS AREA FOR LNKCOR
	SKIPN	AS.LB		;HAS AREA BEEN SETUP?
	  JRST	T1044I		;NO, GO INITIALIZE IT
	MOVEI	P2,1		;EXPAND BY ONE BLOCK
	PUSHJ	P,LNKCOR##	;GET THE CORE
	  PUSHJ	P,E$$MEF##	;CAN'T???
	JRST	T1044P		;NOW GO PUT THE SYMBOL INTO THE FILE

;HERE TO INITIALIZE THE AS AREA (FIRST TIME TYPE 1044 SEEN).
T1044I:	PUSHJ	P,XX.INI##	;CALL GENERAL INITIALIZER
	AOS	AS.PT		;RESERVE ROOM FOR COUNT WORD
	SOS	AS.FR		;  BY DECREMENTING ALL COUNTS
	AOS	ASYM		;  AS IF ONE WORD HAD BEEN USED
	JRST	T1044P		;NOW PUT AWAY THE DATA
 >  ;IFN .NWBLK

SUBTTL	BLOCK TYPE 1045 - DECLARE WRITABLE OVERLAY LINKS

T.1045::
	PUSHJ	P,STDATA		;[1704] USE GENERAL ROUTINE
	PUSH	P,W2			;[1704] SAVE THE BLOCK IOWD
	MOVE	T4,W2			;[1707] PUT THE IOWD IN W1
	MOVX	T1,$OVWRITABLE		;[1704] WRITABLE OVERLAY IS INDICATED
	IORM	T1,OVERLW		;[1704] REMEMBER THIS
	SKIPN	WRTDAT			;[1704] HAS A TABLE BEEN SET UP?
	JRST	[	MOVEI	T2,WR.LEN	;[1704] FETCH WORDS NEEDED
			PUSH	P,T4		;[1745] SAVE POINTER
			PUSHJ	P,DY.GET##	;[1704] ...
			POP	P,T4		;[1745] RESTORE POINTER
			MOVEM	T1,WRTDAT	;[1704]
			JRST	.+1	]	;[1704]
	MOVE	T1,(T4)			;[1704] CHECK WRITABLE BIT OF BLOCK
	TLNN	T1,200000		;[1704]
	JRST	T1045A			;[1704] CURRENT LINK NOT WRITABLE
	HRLZI	T1,400000		;[1704] SET SIGN BIT IN WRTDAT
	IORM	T1,WRTDAT		;[1704] SO /LINK CAN DEAL WITH IT
T1045A:	AOBJP	T4,T1045X		;[1704] UNTIL NO MORE
	MOVE	W2,(T4)			;[1704] PICK UP FIRST NAME
	MOVX	W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL	
					;[1706] SET SOME LIKELY FLAGS
	PUSHJ	P,TRYSYM##		;[1706] SEE IF KNOWN COMMON NAME
	  JRST	E$$UCB			;[1706] WHOLLY UNKNOWN
	  JRST	E$$UCB			;[1706] UNDEFINED ( NOT COMMON )
	MOVE	T1,(P1)			;[1706] GET PRIMARY FLAGS
	TXNN	T1,PS.COM		;[1706] ALREADY COMMON?
	JRST	E$$SNC##		;[1706] NO, ERROR
;IN WHAT LINK DOES THIS COMMON RESIDE?
	TXNE	T1,PS.BGS		;[1706] FROM SOMEPLACE ELSE?
	JRST	T1045B			;[1706] YES! WHERE?
	HRLZI	T1,400000		;[1706] SET SIGN BIT IN WRTDAT
	IORM	T1,WRTDAT		;[1706] SO /LINK CAN DEAL WITH IT
	JRST	T1045A			;[1706] AND LOOK AT THE NEXT ONE
T1045B:	MOVS	P1,LSTPTR		;[1706] WALK BACKWARDS THROUGH TREE
T1045C:
	TRNN	P1,-1			;[2022] REACHED ROOT?
	JRST	T1045A			;[2022] YES, CHECK THE NEXT
	HRRZ	T1,(P1)			;[1706] GET LINK#
	HRRZ	P1,1(P1)		;[2022] AND NEXT PTR
	PUSHJ	P,WRTPTR		;[1712] SET IT WRITABLE	
	MOVX	T2,OW.WRT		;[1706]  ...
	DPB	T2,T1			;[1706]  ...
	JRST	T1045C			;[1706] DO IT AGAIN
T1045X:	POP	P,W2			;[1704] THROW AWAY THE BLOCK 
	HLRZ	T2,W2			;[1704] 
	MOVN	T2,T2			;[1704]
	HRRZ	T1,W2			;[1704]
	PUSHJ	P,DY.RET##		;[1704]
	JRST	LOAD##			;[1704] ALL DONE
 
E$$UCB::.ERR.	(MS,.EC,V%L,L%W,S%W,UCB,<Unknown COMMON />) ;[2007]
	.ETC.	(SBX,.EC!.EP,,,,W2)		;[1706]
	.ETC.	(STR,,,,,,</ referenced >)	;[1706]
	JRST	T1045A				;[1706] TRY TO GET ANOTHER

;WRTPTR RETURNS A BYTE POINTER TO THE WRITABLE LINK FLAGS FOR A SPECIFIED LINK.
;THIS IS USED TO TEST AND SET THE WRITABLE STATUS OF A LINK. THE CALL IS:
;
;	T1/	LINK NUMBER
;
;ON RETURN, T1 CONTAINS THE BYTE POINTER. T2 IS USED.

WRTPTR::
	IDIVI	T1,^D18			;[1704] FLAGS ARE 2 BITS PER LINK
	ADD	T1,[POINT 2,@WRTDAT,35]	;[1704] ADD TEMPLATE BYTE POINTER TO ADDR
	IMULI	T2,-2			;[1704] COMPUTE P FIELD OF BYTE POINTER
	ADDI	T2,^D36			;[1704]   ..
	DPB	T2,[POINT 6,T1,5]	;[1704] STORE IN P FIELD
	POPJ	P,			;[1704] DONE

SUBTTL	BLOCK TYPE 1060 - BINARY PATCH TRACE BLOCK (MAKLIB)

;	-----------------
;	! 1060  ! COUNT !
;	-----------------
;	!   EDIT NAME   !
;	-----------------
;	! ACTIV ! LASTA !
;	-----------------
;	! CREAT ! DATE  !
;	-----------------
;	! INSTL ! DATE  !
;	-----------------
;	!  (RESERVED)   !
;	-----------------
;	! # ASC ! # PCO !
;	-----------------     !
;	! ASC EDIT NAME !     !	MAY BE ZERO OR MORE OF
;	-----------------     ! THESE ASSOC. EDIT BLOCKS
;	! B0 IF INCLUDE !     !
;	-----------------     !
;
;		.	     MAY BE ANY # AND COMBINATION OF BELOW
;			     -------------------------------------
;		.
;
;	   (INSERT PCO)		(REMOVE PCO)  	     (RE-INSERT PCO)
;
;	-----------------     -----------------     -----------------
;	!   1   ! COUNT !     !   2   ! COUNT !     !   3   ! COUNT !
;	-----------------     -----------------     -----------------
;	! RELOC ! ADDR  !     !  EDIT NAME    !     !  EDIT NAME    !
;	-----------------     -----------------     -----------------
;	!  ORG  ! P ADR !
;	-----------------
;
;		.
;
;		.



T.1060==T.1000		;[1430] IGNORE BLOCK.  SHOULD SOMEDAY GO INTO
			; LS AREA FOR .MAP FILE.

SUBTTL	BLOCK TYPE 1070 - LONG SYMBOL NAME

;	-----------------		-----------------
;	! 1070  ! COUNT !		! 1070  ! COUNT !
;	-----------------	OR	-----------------
;	!CODE! N!R!  0  !		!CODE! N!R!  0  !
;	-----------------		-----------------
;	!     VALUE     !		!  (  PSECTS  ) !
;	-----------------		-----------------
;	!      NAME     !		!     VALUE     !
;	-----------------		-----------------
;					!     NAME      !
;					-----------------
;					!  (   . . .  ) !
;					-----------------
;					! (ADD. VALUE ) !
;					-----------------
;					!  (   . . .  ) !
;					-----------------

IFN .NWBLK,<
;THIS BLOCK TYPE INSERTED IN EDIT 1000
T.1070:	PUSHJ	P,D.GET1	;GET FLAG WORD
	  JRST LOAD##		;END OF BLOCK
	MOVE	P2,W1		;SAVE ORIGINAL FLAG WORD IN P2
	SETO	R,		;ASSUME NO EXPLICIT PSECTS
	TRZN	W1,400000	;IS THERE A PSECT-WORD?
	JRST	T1070A		;NO, JUMP
	PUSHJ	P,D.GET1	;YES, GET IT
	  JRST	LOAD##		;??
	MOVE 	R,W1		;R CONTAINS TEMPORARY PSECTS
T1070A:	LDB 	RB,[POINT 3,P2,21]	;RB/ RELOC TYPE
	PUSHJ	P,REL.1		;GET RELOCATED VALUE-- W1/FLAG, W3/VALUE
	  JRST	LOAD##		;??
	TXO	W1,PT.SGN!PT.SYM	;FLAG IT SYMBOL
	LDB	W2,[POINT 7,P2,17]	;GET N--SYMBOL LENGTH
	JUMPG	W2,[PUSHJ	P,T1070E
		JRST	T1070B]
	PUSH	P,W1		;SAVE	FLAG
	PUSHJ	P,D.GET1	;READ NAME (1 WORD)
	  JRST	LOAD##		;??
	MOVE	W2,W1		;MOVE TO RIGHT AC
	POP	P,W1		;RECOVER FLAGS(PRIMARY SYMBOL FLAGS)
				;THE ORIGINAL FLAG WORD STILL IN P2
T1070B:
	.JDDT	LNKNEW,T1070B,<<CAMN	W2,$SYMBOL##>>
	SETZ	P1,		;P1 & P2 USED IN LSHC FOR DECODING
	LSHC	P1,3		;GET FIRST DIGIT OF CODE
	PUSHJ	P,@T1070T(P1)	;DISPATCH
	JRST	T.1070		;LOOP BACK FOR NEXT ENTRY

;FIRST DIGIT DISPATCH TABLE
T1070T:	T.1070U			;0XX - NAME (NEVER SHOULD HAPPEN)
	T1070L			;1XX - LOCAL
	T1070G			;2XX - GLOBAL
	SY.BH##			;3XX - BLOCK HEADER (FAIL)
	REPEAT 4,<T1070U>	;4XX - 7XX UNDEFINED

;UNDEFINE CODE -- GIVE ERROR MSSG
T1070W:	POP	P,W1		;RESTORE FLAG AND THEN ERROR
T1070U:	JRST	E$$URC##	;OUT WITH ERROR MESSAGE

;L - LOCAL SYMBOL
T1070L:	TXO	W1,PS.LCL	;DOING LOCAL DEFINITION
	SETZ	P1,		;SETUP FOR NEXT DIGIT
	LSHC	P1,3		;OF 9-BIT CODE
	XCT	[JFCL			;10X
		TXO	W1,PS.DDT	;11X - SUPPRESSED TO DDT
		TXO	W1,PS.MPO	;12X - MAP ONLY
		REPEAT 5,<JRST T1070U>](P1)	;13X - 17X NOT DEFINED
	SETZ	P1,		;SET UP TO GET 3RD DIGIT OF THE 9-BIT CODE
	LSHC	P1,3		;
	JRST	SY.LS##		;FOR ALL 1XX CODE

;G - GLOBAL SYMBOL
T1070G:	SETZ	P1,		;P1 & P2 USED TO DECODE 9-BIT CODE
	LSHC	P1,3		;GET 1ST DIGIT
	XCT	[JFCL			;20X
		TXO	W1,PS.DDT	;21X - SUPPRESSED TO DDT
		TXO	W1,PS.MPO	;22X - MAP ONLY
		JRST	T1070U		;23X - UNDEFINED
		JRST	T1070Q		;24X - GLOBAL REQUEST FOR CHIN FIXUP
		JRST	T1070Q		;25X - GLOBAL REQEST FOR ADDITIVE FIXUP
		JRST	T1070Q		;26X - GLOBAL REQUEST FOR SYMBOL FIXUP
		JRST	T1070U](P1)	;27X - UNDEFINED
	SETZ	P1,		;2ND DIGIT
	LSHC	P1,3		;
	JRST	@[SY.GS##	;200,210,220 - GLOBAL DEFINITION (1WORD VALUE)
		SY.GS##		;201,211,221 - (EXTENDED VALUE-NOT IMPLEMNETED)
		T1070U		;202,212,222 - NOT DEFINED
		SY.DGR##	;3 - RIGHT HALF DEFERRED
		SY.DGL##	;4 - LEFT HALF DEFERRED
		T1070D		;5 - BOTH HALVES DEFERRED
		T1070D		;6 - 30BIT DEFERRED
		T1070D](P1)	;7 - FULL WORD DEFERRED
T1070D:	TXO	W1,PS.UDF	;FULL WORD DEFERRED
	JRST	SY.DGR##		;

;Q - GLOBAL REQUESTS (CODES 24X, 25X, 26X)
T1070Q:	PUSH	P,P1		;STORE 2ND DIGIT
	SETZ	P1,		;SET UP FOR 3RD DIGIT
	LSHC	P1,3		;
	PUSH	P,P1		;STORE 3RD DIGIT ALSO
	TXO	W1,PS.REQ	;SET REQUEST FLAG
	PUSHJ	P,TRYSYM##	;LOCATE THE GLOBAL SYMBOL
	  JRST	T1070I		;NOT FOUND, GO PUT IN
	  JRST	T1070J		;FOUND BUT UNDEFINED, MUST WAIT
	JUMPE	W3,[ POP	P,0(P)	;RESTORE STACK AND RETURN
		POP	P,0(P)		;FOR A FAKE REQUEST
		POPJ	P,]		;
	IOR	W1,0(P1)	;GET FLAGS
	TXNN	W1,PS.REL	;RELOCATABLE?
	TDZA	W1,W1		;NO, CLEAR FLAGS
	MOVX	W1,FS.REL
	MOVEM	W1,SYMFLG	;SAVE IT FOR SYMBOL TABLE FIXUP
	POP	P,T3		;RESTORE 3RD DIGIT
	POP	P,T1		;RESTORE 2ND DIGIT
	CAIN	T1,4		;CHAINED FIXUP?
	JRST	[MOVE	T2,W3
		MOVE	W3,2(P1)
		JRST 	SY.CHR##]	;YES, JUMP
	CAIE	T1,6		;SKIPE IF SYMBOL FIXUP
	PJRST	SY.AD0##	;JUMP IF ADDITIVE
	MOVE	W2,W3		;[1002] EXPECT DEFINING SYMBOL IN W3 & REQUEST IN W2
	PJRST	SY.AS##		;GO DO SYMBOL TABLE FIXUP

T1070S:	JRST	T1070X	;2X0 - NOT A REAL FIXUP, RESTORE W1 AND RETURN
	JRST	T1070W		;2X1 - NOT DEFINED
	JRST	T1070W		;2X2 - NOT DEFINED
	TXO	W1,FS.FXR	;2X3 - RIGHT HALF FIXUP
	TXO	W1,FS.FXL	;2X4 - LEFT HALF FIXUP
	JRST	T1070W		;2X5 - NOT DEFINED
	TXO	W1,FS.FXE	;2X6 - EXTENDED(30-BIT) FIXUP
	TXO	W1,FS.FXF	;2X7 - FULL WORD FIXUP
T1070X:	POP	P,W1		;RESTORE W1, THEN RETURN
	POPJ	P,

;GLOBAL SYMBOL NOT IN TABLE
T1070I:	POP	P,T3		;GET BACK 3RD DIGIT
	POP	P,T2		;GET 2ND DIGIT
	AOS	USYM		;COUNT ONE MORE UNDEFINED
	CAIN	T2,4		;CHAINED FIXUP
	JRST	INSRT##		;YES, JUMP
	JUMPE	T3,INSRT##	;NOT A REAL FIXUP
	TXO	W1,PS.FXP!PT.EXT	;SET FIXUP FLAG
	PUSH	P,W1		;FLAGS ON STACK
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR	;THESE ARE FOR THE FX BLOCK
	XCT	T1070S(T3)	;MORE FLAGS
	CAIE	T2,6		;SKIPE IF SYMBOL FIXUP
	JRST	T1070Y	;JUMP IF ADDITIVE FIXUP
	TXO	W1,FS.FXS	;FLAG SYMBOL FIXUP
	PUSHJ	P,SY.QS##	;
	  JRST	[SOS	USYM	;NON LOADED LOCAL
		POP	P,W1		;
		POPJ	P,]
T1070Y:	TXNN	W1,PS.EXO	;A LONG SYMBOL NAME?
	JRST	SY.RQ2##	;NO, JUMP
	HRRZ	P1,W3		;[1002] GET GS POINTER INTO P1
	ADD	P1,GS.LB	;MAKE IT ABS
	PUSHJ	P,INSRT##	;GO INSRT THE SYMBOL FIRST
	MOVE	W3,2(P1)	;REQUEST ADDR IN W3
	PUSHJ	P,SY.RA##	;GO EXTEND THE ENTRY
	MOVE	W3,P1		;GET POINTER TO GS
	SUB	W3,GS.LB	;MAKE IT RELATIVE, NEEDED FOR INSRTL
	POPJ	P,		;RETURN

;GLOBAL SYMBOL FOUND IN TABLE BUT UNDEFINED
T1070J:	POP	P,T3		;GET 3RD DIGIT
	POP	P,T2		;GET 2ND DIGIT
	JUMPE	W3,CPOPJ	;DUMMY REQUEST
	CAIN	T2,4		;CHAINED REQUEST
	JRST	[IORM	W1,0(P1)
		JRST	SY.RU3##]	;YES, JUMP
	MOVE	W1,0(P1)
	TXOE	W1,PS.FXP	;ALREADY DEFERED FIXUPS?
	JRST	T1070K		;YES,
	PUSH	P,W1		;NO, SAVE PRIMARY FLAGS
	XCT	T1070S(T3)	;SET FLAGS FOR FX BLOCK
	CAIE	T2,6		;SKIP IF SYMBOL FIXUP
	JRST	SY.RA##		;JUMP IF ADDITIVE FIXUP
	TXO	W1,FS.FXS	;FLAG SYMBOL FIXUP
	PUSHJ	P,SY.QS##
	  JRST	T1070X
	JRST	SY.RA##

T1070K:	MOVEI	T1,0(P1)
	ADDI	T1,.L
	SKIPG	W1,0(T1)
	JRST	SY.RUH##
	TXNN	W1,S.FXP
	JRST	T1070K+1
	MOVE	P1,T1
	XCT	T1070S(T3)
	CAIE	T2,6		;SKIP IF SYMBOL FIXUP
	JRST	T1070F		;JUMP IF ADDITIVE
	TXO	W1,FS.FXS	;FLAG SYMBOL FIXUP
	PUSHJ	P,SY.QS##
	  POPJ	P,
T1070F:	HRR	W1,2(P1)
	SUB	P1,NAMLOC
	PUSHJ	P,SY.FX0##
	ADD	P1,NAMLOC
	HRRM	W3,2(P1)
	POPJ	P,


;E - EXTENDED SYMBOL NAME
T1070E:	MOVEI	T1,0(W2)	;N (NAME LENGTH ) IN W2
	PUSH	P,W1		;SAVE FLAGS
	PUSHJ	P,D.GET1	;GET 1ST WORD OF NAME
	  JRST	LOAD##		;
	PUSH	P,W1		;SAVE 1ST WORDS OF NAME
	PUSHJ	P,D.GET1	;GET 2ND WORD OF NAME
	  JRST	LOAD##		;
	JUMPN	W1,LNGNM	;WE DO HAVE A LONG NAME, JUMP
	POP	P,W2		;ONLY A SHORT NAME , INTO W2
	SOJLE	T1,.+4		;FINISHED?
	PUSHJ	P,D.GET1	;NO, MORE NULLS PADDED
	  JRST	LOAD##		;
	JRST	.-3		;SKIPE OVER THEM
	POP	P,W1		;RECOVER FLAGS
	POPJ	P,		;AND RETURN

;HERE IF WE REALLY HAVE A LONG NAME
;	0(P)/	1ST WORD OF NAME
;	-1(P)/	FLAGS
LNGNM:	POP	P,W2		;1ST WORD OF NAME
	EXCH	W1,0(P)		;FLAGS INTO W1, AND 2ND WORD OF NAME ON STACK
	TXO	W1,PT.EXT!PS.EXO	;EXTENDED SYMBOL
	PUSH	P,T1		;KEEP N ON STACK FOR A WHILE
	SETZ	T2,		;
	LSHC	T1,-1		;HALF OF N
	JUMPE	T2,.+2		;ANY REMAINDER?
	ADDI	T1,1		;ONE MORE FOR ODD N
	ADDI	T1,1		;ONE MORE FOR PRIMARY TRIPLET
	IMULI	T1,3		;THAT MANY TRIPLETS NEEDED
	MOVE	T2,T1		;NEEDED SPACE IN T2
	PUSH	P,T1		;ACTUAL GS WORD COUNT
	PUSHJ	P,GS.GET##	;GET IT IN GLOBAL SYMBOL AREA
	TMOVEM	W1,0(T1)	;STORE PRIMARY TRIPLET
	POP	P,W2		;POP OFF GS WORD COUNT
	POP	P,T2		;POP OFF N
	EXCH	W2,0(P)		;2ND WORD OF NAME INTO W2,& GS WORD CNT BACK ON STACK
	PUSH	P,T1		;SAVE PTR
	ADDI	T1,.L		;NEXT TRIPLET
	JRST	T1070N		;GO GET 3RD WORD

T1070M:	ADDI	T1,.L		;NEXT TRIPLET
	PUSHJ	P,D.GET1	;NEXT WORD OF NAME
	  JRST	LOAD##		;??
	MOVE	W2,W1
T1070N:	PUSHJ	P,D.GET1	;NEXT WORD
	  SETZ	W1,		;
	MOVX	W3,S.SYM!S.LNM	;SECONDARY FLAGS
	SUBI	T2,2		;INCREMENT BY 2 EACH TIME
	JUMPG	T2,.+2		;SKIP IF MORE
	TXO	W3,S.LST!S.LLN	;IT IS THE LAST WORD
	EXCH	W1,W3		;GET INTO THE ORDER WE WANT
	TMOVEM	W1,0(T1)	;INTO THE TRIPLET
	JUMPG	T2,T1070M	;LOOP BACK IF MORE
	POP	P,T1		;RESTORE POINTER
	DMOVE	W1,0(T1)	;GET PRIMARY TRIPLET ALSO IN ACS
	SUB	T1,NAMLOC	;CONVERT ADR TO GS OFFSET
	MOVEM	T1,W3		;AND INTO THE VALUE AC
	POP	P,T2		;RECOVER NUMBER OF WORDS IN GS AREA
	SKIPN	NOSYMS		;NO LOCAL SYMBOLS?
	MOVEM	T2,SYMLEN	;USED BY LS.ADD(ROUTINE TO ADD TO LS)
	HRL	W3,T2		;GS WORD COUNT ALSO IN LH OF W3 FOR TRYSYM
	POPJ	P,		;
SUBTTL	BLOCK TYPE 1072 - POLISH FIXUPS (SUPPORT LONG SYMBOLS)

;	----------------
;	!  1072! COUNT !
;	----------------
;	! BYTE !  BYTE !
;	----------------

;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.1072:	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.1072,<<CAMN T1,$FIXUP##>>	
	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)	;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 THRU
;NOW READ IN 2 HALF WORDS AT A TIME FROM BUFFER
;CHECK TO SEE IF A HALF WORD IS ONE OF THE FOLLOWIN:
;	1.	PSECT INDEX
;	2.	OPERATOR CODE
;	3.	STORE OPERATOR CODE
;	4.	DATA OPERATOR CODE
;THE PRIMARY PURPOSE HERE IS TO DO THE RELOCATION CALCULATION FOR
;A RELOCATABLE DATA WHEN ONE IS ENCOUNTERED.


T1072R:	GET.2H			;GET 2 HALF WORDS INTO T1 AND T2
	MOVEM	T1,SAVCOD	;INCASE ERROR
	JMP.IN	(T1, PL.IL, PL.IH, GOT.I1)	;JUMP IF PSECT INDEX
	JMP.IN	(T1, PL.OL, PL.OH, RHALF,1)	;JUMP IF OPERATOR
	JMP.IN	(T1, PL.SL, PL.SH, GOT.S1, 1)	;JUMP IF STORE OPERATOR
GOT.D1:	TRNE	T1,INVALID	;NONE OF THE ABOVE, VALID DATA CODE?
	JRST	T11IPO		;NO, ERROR
	TRNE	T1,RELOC	;RELOCATABLE DATA COMING UP?
	JRST	[PUSHJ	P,GOT.R1	;GOT A RELOC DATA CODE ON THE LEFT
		  JRST	RHALF		;RETURN HERE TO PROCESS RIGHT HALF NEXT
		HRR W1,T1	;[1001] UPDATE TO ABS ADDR
		JRST STOR1W]	;NEXT WORD
	LSH	T1,-9		;NO, ABSOLUTE.  RIGHT-JUSTIFY DATA LEN
	MOVEM	W1,(W2)		;STORE CURRENT WORD
	AOJ	W2,		;ADVANCE POINTER
	JUMPE	T1,T1072R	;ONLY HALF WORD DATA.  
	MOVE	T3,T1		;USE T3
GOT.D2:	GET.2H			;GET NEXT WORD
	SOJLE	T3,RHALF	;[1001] DECREMENT LENGTH AND JUMP IF FINISHED
GOT.D3:	MOVEM	W1,(W2)		;NOT FINISHED, STORE
	AOJ	W2,
	SOJLE	T3,T1072R	;[1001] DECREMENT LENGTH AND JUMP IF FINISHED
	JRST	GOT.D2		;NOT FINISHED, LOOP

RHALF:	MOVEM	T2,SAVCOD	;INCASE OF ERROR
	JMP.IN	(T2, PL.IL, PL.IH, GOT.I2)	;JUMP IF PSECT INDEX
	JMP.IN	(T2, PL.OL, PL.OH, STOR1W, 1)	;[1001] JUMP IF OPERATOR TO RIGHT HALF
	JMP.IN	(T2, PL.SL, PL.SH, GOT.S2, 1)	;JUMP IF STORE OPERATOR
	TRNE	T2,INVALID	;NONE OF THE ABOVE, VALID DATA CODE?
	JRST	T11IPO		;NO, ERROR
	MOVEM	W1,0(W2)	;STORE
	AOJ	W2,		;ADVANCE POINTER
	TRNE	T2,RELOC	;RELOCATABLE DATA COMING UP?
	JRST	[PUSHJ	P,GOT.R2	;GOT RELOC DATA CODE ON THE RIGHT
		  JRST	RHALF		;CONTINUE WITH RIGHT HALF
		JRST	STOR1W]
	LSH	T2,-9		;NO, RIGHT JUSTIFY DATA LENGTH
	JUMPE	T2,[JMP.2H	RHALF]	;NEXT 2 HALF WORDS AND JUMP
	MOVE	T3,T2		;USE T3
	GET.2H			;[1001] GET 2 HALF WORDS
	SOJLE	T3,STOR1W	;[1001] JUMPE IF FULL WORD
	JRST	GOT.D2		;


STOR1W:	MOVEM	W1,(W2)
	AOJA	W2,T1072R

	
;HERE TO RELOC STARTING AT RIGHT HALF
GOT.R1:	LSH	T1,-9		;YES, RELOC DATA
	JUMPE	T1,[PUSH P,W1		;MUST RELOC ONE HALF WORD
		MOVE	T1,T2		;GET VALUE IN T1
		PUSHJ	P,R.CUR		;GO RELOCATE IT WITH CURRENT PSECT
		HLL	W1,0(P)		;RESTORE LEFT HALF AS IS
		POP	P,0(P)		;ADJUST STACK
		AOS	0(P)	;SKIP-RETURN
		POPJ	P,]	;FOR NEXT WORD
	PUSH	P,W1		;SAVE CURRENT WORD, NEED W1 FOR RELOC CALC.
	PUSH	P,T2		;SAVE RIGHT HALF FOR A WHILE
	GET.2H			;GET ANOTHER 2 HALF WORDS
	HRL	T1,0(P)		;GET 1ST HALF INTO LEFT HALF
	POP	P,(P)		;FIX STACK
	PUSHJ	P,R.CUR		;RELOCATE
	MOVE	T1,W1
	POP	P,W1		;RESTORE LAST WORD
	HLR	W1,T1		;RELOCATED VALUE IN RIGHT HALF
	MOVEM	W1,(W2)		;STORE IT
	AOJ	W2,		;ADVANCE POINTER
	HRLZ	W1,T1		;2ND HALF WORD IN LEFT HALF 
	HRR	W1,T2		;RESTORE RIGHT HALF ALSO
	POPJ	P,		;NON-SKIP RETURN, GO PROCESS RIGHT HALF

;HERE TO RELOCATE STARTING A WORD BOUNDARY
GOT.R2:	LSH	T2,-9
	JUMPE	T2,[GET.2H
		PUSH	P,T2	;[1001] R.CUR USES T2
		PUSHJ	P,R.CUR
		POP	P,T2	;[1001] 
		HRL	W1,T1	;ADDRESS RETURNED IN T1
		POPJ	P,]
	GET.2H
	MOVE	T1,W1
	PUSHJ	P,R.CUR
	MOVEM	T1,(W2)
	AOJ	W2,
	AOS	(P)
	POPJ	P,

;HERE WHEN WE GOT PSECT INDEX IN THE LEFT HALF
GOT.I1:	PUSHJ	P,GOT.ID
	JRST	RHALF

;HERE WHEN WE GOT SPECT INDEX IN THE RIGHT 
GOT.I2:	EXCH	T1,T2
	PUSH	P,GOT.ID
	EXCH	T1,T2
	JRST	STOR1W

GOT.ID:	HRRZI	T1,-377777(T1)
	CAILE	T1,RC.NO
	JRST	E$$IPX##
	MOVEM	T1,RC.CUR
	SKIPN	P4
	MOVE	P4,AC
	HRRO	P4,P4
	POPJ	P,

;HERE ON STORE
GOT.S1:	TRNE	T1,S.ADR	;AN ADDRESS?
	TRZN	T1,S.REL	;NEED TO RELOCATE?
	JRST	GOTSOP		;NO,
	HRL	W1,T1		;OFF WITH RELOCATION BIT
	MOVEM	P4,RC.CUR
	PUSHJ	P,GOT.R1	
	  JRST	GOTSOP
	HRR	W1,T1		;ADDR IN T1
GOTSOP:	MOVEM	W1,(W2)
	PUSHJ	P,D.GET1
	  JRST	T1072C
	AOJA	W2,.+3

GOT.S2:	TRNE	T2,S.ADR	;ADDRESS?
	TRZN	T2,S.REL	;NEED TO RELOCATE
	JRST	GOTSOP		;NO,
	HRR	W1,T2		;OFF WITH RELOCA BIT
	MOVEM	W1,(W2)
	AOJ	W2,
	MOVEM	P4,RC.CUR
	PUSHJ	P,GOT.R2
	 JRST	GOTSOP
	HRL	W1,T1		;UPDATE LEFT WITH ADDR
	JRST	GOTSOP

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

T1072C:	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
	MOVEM	T1,SAVCOD	;INCASE OF ERROR
	JMP.IN (T1,PL.SL,PL.SH,T.11SP, 1)	;JUMPE IF STORE OPERATOR
	JMP.IN (T1,PL.IL,PL.IH,T.11C1)	;IGNORE PSECT INDEX
	JMP.IN (T1,PL.OL,PL.OH,T.11C1, 1)	;IGNORE OPERATORS
	TRNE	T1,INVALID	;NONE OF THE ABOVE, VALID DATA CODE?
	JRST	T11IPO		;NO, ERROR
	TRNE	T1,SYMBOL	;SYMBOL?
	JRST	[LSH	T1,-9		;YES,
		JUMPN	T1,T.11C2	;JUMP IF IN SIXBIT
		AOJA	W1,T.11C1]		;JUMP IF IN RADIX 50
	LSH	T1,-9		;RIGHT JUSTIFY LENGTH
	JUMPE	T1,T.11C0	;SKIP HALF WORD
T.11C2:	IBP	W1		;INCREMENT POINTER TO SKIP OVER THE LONG DATA
	SOJG	T1,.-1
	JRST	T.11C0		;LOOP

;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:	JMP.IN(T1,PL.SSL,PL.SSH,T1072S, 1)		;JUMP IF SYMBOL FIXUP
	JMP.IN(T1,PL.SNL,PL.SNH,T11SPE, 1)		;JUMPE IF UNDEFINED STORE OP
	LSH	T1,-9		;GET LENGTH
	JUMPN	T1,[ILDB	T2,W1
		ILDB 	W1,W1
		HRL	W1,T2
		JRST	.+2]
	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

;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

T1072S:	MOVE	T2,T1
	TRZ	T2,777770	;CLEAR ALL BUT LAST DIGIT
	MOVE	T2,[0		;750
		0		;751
		0		;752
		0		;753
		FS.FXF		;754
		FS.FXE		;755
		FS.FXL		;756
		FS.FXR](T2)
	LSH	T1,-9		;GET DATA LENGTH
	PUSH	P,T1		;SAVE DATA LENGTH FOR LATER
	PUSH	P,W1		;SAVE POINTER TO START OF SYMBOL NAME
	PUSH	P,T2		;SAVE FLAGS FOR SY.QS
	ILDB	T2,W1		;YES, GET LEFT PART
	ILDB	W2,W1		;GET RIGHT
	HRL	W2,T2		;FULL SYMBOL
	JUMPN	T1,.+4		;SKIPE IF NOT ZERO, ALREADY SIXBIT
	PUSH	P,T1
	PUSHJ	P,R50T6		;IF 0, WE HAVE RADIX 50 SYMBOL
	POP	P,T1
	MOVE	T3,W1		;FX POINTER IN T3 FOR GET.LS
	POP	P,W1		;RESTORE FLAGS FOR GET.LS
	SOJLE	T1,.+2		;IF 1, FULL WORDS SIXBIT
	PUSHJ	P,GET.LS	;IF .GT.1, LONG SYMBOL NAME IN SIXBIT
	EXCH	W2,W3		;PUT SYMBOL IN W3
	PUSHJ	P,SY.QS##	;SEE IF WE WANT THIS SYMBOL
	  JRST	[POP	P,W1	;RESTORE STACK
		POP	P,T1		;[612] NO, NON LOADED LOCAL
		PUSHJ	P,T.11RT	;[612]   SO CLEAN UP FX
		JRST	LOAD##]		;[612]   AND RETURN
	POP	P,W1		;RESTORE BYTE POINTER AT SYMBOL NAME START
	POP	P,T1		;RESTORE SYMBOL NAME LENGTH
	EXCH	W2,W3		;W2 NOW CONTAINS SYMBOL PTRS
	HLRZ	T2,W2		;LEFT HALF
	IDPB	T2,W1
	IDPB	W2,W1		;RIGHT HALF
	SETZ	T3,
	SOJLE	T1,.+3
	IDPB	T3,W1
	JRST	.-2
	ILDB	T1,W1		;YES, GET LEFT PART
	ILDB	W2,W1		;GET RIGHT
	HRL	W2,T1		;FULL SYMBOL
	JUMPE	W2,T.11GC	;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
	MOVEM	T1,SAVCOD
	JMP.IN (T1,PL.OL,PL.OH,T.11G1,1)		;IGNORE OPERATORS
	JMP.IN (T1,PL.IL,PL.IH,T.11G1)		;IGNORE PSECT INDEX
	JMP.IN (T1,PL.SL,PL.SH,T.11GE,1)		;JUMPE IF STORE OPERATOR
	TRNE	T1,INVALID	;INVALID DATA CODE
	JRST	T11IPO		;ERROR
	TRNE	T1,SYMBOL	;SYMBOL REQUEST?
	JRST	T1072G		;YES, JUMP
	LSH	T1,-9		;NO, ADDRESS FIXUP
	JUMPE	T1,T.11G0	;HALF WORD ADDR.
	AOJA	W1,T.11G1	;FULL WORD ADDR.

;HERE IF GLOBAL SYMBOL REQUEST
T1072G:	ILDB	T2,W1		;GET FIRST PART OF SYMBOL
	ILDB	W2,W1		;GET RIGHT HALF PART
	HRL	W2,T2		;FULL SYMBOL IN W2
	LSH	T1,-9		;GET DATA LENGTH
	JUMPN	T1,.+4		;SKIP IF NOT ZERO, ALREADY SIXBIT
	PUSH	P,T1		;
	PUSHJ	P,R50T6##	;IF 0, RADIX 50 SYMBOL--CONVERT TO SIXBIT IN W2
	POP	P,T1
	.JDDT	LNKNEW,T1072G,<< CAMN	W2,$SYMBOL##>>
	SETZ	W3,
	MOVE	T3,W1		;POINTER IN T3 FOR GET.LS
	SUB	W1,FX.LB	;INCASE FX AREA MOVES
	PUSH	P,W1		;SAVE RELA FX PTR OF START OF SYMBOL
	MOVX	W1,PT.SGN!PT.SYM
	SOJLE	T1,.+3		;SKIP OVER GET.LS
	PUSHJ	P,GET.LS	;IF .GT. 1, LONG SYMBOL IN SIXBIT
	HRL	W3,T2
	SUB	T3,FX.LB	;INCASE FX AREA MOVES
	PUSH	P,T3		;SAVE RELA FX PTR OF END OF SYMBOL
	PUSHJ	P,TRYSYM##	;SEE IF DEFINED
	  JRST	T.11ND		;NO, NEED TO DEFINE IT
	  JRST	T.11UN		;UNDF, SO JUST AS BAD
	POP	P,0(P)		;FIX STACK, DON'T NEED PTR TO END OF SYMBOL
	POP	P,W1		;RESTORE BYTE POINTER TO START OF SYMBOL
	ADD	W1,FX.LB	;ADD CORE OFFSET
	SUBI	W1,2		;BACKUP BYTE POINTER
	IBP	W1		;TO POINT TO 2
	ILDB	T1,W1		;GET THE CODE AGAIN
	MOVE	T2,T1
	LSH	T2,-9		;GET DATA LENGTH
	JUMPN	T2,.+2		;SKIPE IF LENGTH NOT ZERO
	MOVEI	T1,001000	;ZERO IS A SPECIAL CASE
	TRZ	T1,SYMBOL	;CHANGE SYMBOL MARKER TO 36BIT VALUE
	DPB	T1,W1		;UPDATE, KEEP LENGTH INFO AS BEFORE
	MOVS	T1,2(P1)	;GET VALUE
	IDPB	T1,W1
	MOVSS	T1
	IDPB	T1,W1
	SOJLE	T2,T.11G1
	SETZ	T1,
	JRST	.-3

T.11GE:	MOVE	W3,T11BP
	ADD	W3,FX.LB
	SKIPN	-1(W3)		;[633] ANY UNDEFINED GLOBALS?
	PUSHJ	P,T.11EV	;[633] NO, EVALUATE FIXUP NOW
	JRST	LOAD##		;[633] ELSE WAIT TILL ALL DEFINED

T11SPE:	.ERR.	(MS,.EC,V%L,L%F,S%F,ISO,<Invalid store operator >)
	.ETC.	(OCT,.EP,,,,T1)
;HERE TO EXTRACT A LONG SYMBOL IN GS AREA FROM FX AREA AS PART
;OF THE BLOCK 1072.
;ENTER WITH:
;
;	T1/	#OF HALF WORDS-2
;	T3/	POINTER INTO FX AREA
;
;RETURN WITH W1,W2,W3 SETUP FOR TRYSYM.

GET.LS:PUSH	P,T1		;SAVE DATA LENGTH FOR A WHILE
	PUSH	P,T3		;SAVE IT FOR A WHILE
	ILDB	T3,T3		;A REAL LONG SYMBOL, NOT JUST PADDING?
	JUMPN	T3,GET.L2	;JUMP IF YES
	POP	P,T3		;NO, GOT A NULL
	POP	P,T1		;RECOVER LENGTH
	IBP	T3		;JUST SKIP OVER THE NULL PADDING
	SOJG	T1,.-1		;FINISHED?
	TXZ	W1,PS.EXO	;MAKE SURE FLAG FOR LONG NAME IS OFF
	POPJ	P,		;AND RETURN

GET.L2:	POP	P,T3		;GET BACK THE ORIGINAL POINTER INTO FX
	LSH	T1,-1		;CONVERT #OF HALF WORDS TO # OF WORDS
	SETZ	T2,
	LSHC	T1,-1		;2 WORDS TO EACH ADDITIONAL TRIPLET
	JUMPE	T2,.+2		;ANY REMAINDER?
	ADDI	T1,1		;YES, ONE ADDITIONAL TRIPLET
	ADDI	T1,1		;ONE MORE FOR PRIMARY TRIPLET
	IMULI	T1,3		;THAT MANY WORDS NEEDED
	MOVE	T2,T1		;NEEDED SPACE IN T2
	PUSH	P,T2		;SAVE ACTUAL GS WORD COUNT
	PUSH	P,T3		;GS.GET USES T3
	PUSHJ	P,GS.GET##	;GO GET IN GS AREA
	POP	P,T3		;RESTORE BYTE POINTER
	TXO	W1,PT.SGN!PT.SYM!PT.EXT!PS.EXO	;SET SOME VALID FLAGS
	TMOVEM	W1,(T1)		;PRIMARY TRIPLET
	POP	P,T2		;POP OFF GS WORD COUNT
	EXCH	T2,0(P)		;ORIGINAL DATA LENGTH IN T2, CNT BACK ON STACK
	PUSH	P,T1		;SAVE POINTER IN GS
GET.L1:	ADDI	T1,.L		;NEXT TRIPLET
	ILDB	W1,T3		;NEXT HALF WORD FROM FX
	SOJLE	T2,[HRLZ W2,W1		;IF FINISHED, JUMP OUT
		SETZ	W3,
		JRST	GET.L3]
	ILDB	W2,T3		;NOT FINISHED, NEXT HALF WORD FROM FX
	HRL	W2,W1
	SOJLE	T2,[SETZ W3,		;IF FINISHED, JUMP OUT
		JRST	GET.L3]
	ILDB	W1,T3		;NEXT HALF WORD FROM FX
	SOJLE	T2,[HRLZ W3,W1		;IF FINISHED, RESTORE FIRST WORD
		JRST	GET.L3]
	ILDB	W3,T3		;NOT FINISHED, NEXT HALF WORD FROM FX
	HRL	W3,W1		;
	SOJLE	T2,GET.L3	;FINISHED
	MOVX	W1,S.SYM!S.LNM	;SET FLAGS
	TMOVEM	W1,0(T1)	;ADDITIONAL TRIPLET
	JUMPG	T2,GET.L1	;LOOP BACK IF NOT FINISHED

GET.L3:	MOVX	W1,S.SYM!S.LNM!S.LST!S.LLN	;SET FLAGS
	TMOVEM	W1,0(T1)	;THE LAST  TRIPLET
	POP	P,T1		;GET BEGINNING POINTER INTO GS
	DMOVE	W1,0(T1)	;UPDATE CURRENT W1,W2
	SUB	T1,NAMLOC	;RELATIVE GS POINTER IN T1
	MOVEM	T1,W3		;AND UPDATE W3 WITH IT
	POP	P,T2		;GS WORD COUNT IN T2
	POPJ	P,		;RETURN
;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
	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,W2
	POP	P,W1		;RESTORE RELA FX PTR TO END OF SYMBOL
	POP	P,0(P)		;DON'T NEED PTR TO START OF SYMBOL
	ADD	W1,FX.LB	;RELOCATE AGAIN
	MOVE	W3,T11BP
	ADD	W3,FX.LB	;...
	AOS	-1(W3)		;BUMP COUNT OF UNDEFINED SYMBOLS
	MOVE	T1,SAVCOD
	TRNE	T1,LENGTH
	JRST	T.11G1		;ALREADY IN SIXBIT
	SUBI	W1,2		;NEED TO UPDATE STORE CODE ALSO
	IBP	W1		;
	ADDI	T1,001000	;UPDATE LENGTH TO 1
	IDPB	T1,W1		; NEW CODE
	MOVS	T1,W2		;PUT SYMBOL IN T1 SWAPPED
				;OVERWRITING THE RADIX-50
	IDPB	T1,W1		;STORE IT
	MOVSS	T1
	IDPB	T1,W1		;W1 BACK AS IT WAS
	JRST	T.11G1		;GET NEXT HALF WORD
;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
	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	;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	T11DFE		;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	T11DFE
	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

T11DFE:	.ERR.	(MS,,V%L,L%F,S%F,ISP)
;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
	MOVEM	W1,SAVCOD
	JMP.IN (W1,PL.SL,PL.SH,T.11ST,1)		;JUMP IF STORE OPERATOR
	JMP.IN (W1,PL.IL,PL.IH,T.11RP)		;IGORE PSECT INDEX
	JMP.IN (W1,PL.OL,PL.OH,SAVOP,1)		;JUMP IF OPERATOR
	TRNN	W1,INVALID	;INVALID DATA CODE?
	TRNE	W1,SYMBOL	;SYMBOL REQUEST? SHOULD BE DONE BY NOW
	JRST	T11IPO		;YES, ERROR
	JRST	T.11OP		;GOT AN OPERAND

SAVOP:	PUSH	W3,W1		;SAVE OPERATOR ON STACK
	MOVE	T3,DESTB-100(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,


T11IPO:	MOVE	W1,SAVCOD	
T11RPE: JRST	E$$IPO##	;INVALID POLISH OPERATOR
;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
	LSH	T1,-9		;GET DATA LENGTH
	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
	SOJLE	T1,T.11P0
	IBP	W2
	JRST	.-2
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##-100(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##-100(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

;HERE TO STORE THE FINAL VALUE

T.11ST:	MOVE	T2,-2(W3)	;THIS SHOULD BE THE FAKE OPERATOR
	CAIE	T2,MXPLOP	;IS IT
	JRST	T11STE		;NO
	ILDB	T2,W2		;[572]  GET CORE ADDR OR GS POINTER
	MOVE	W3,-1(W3)	;GET THE VALUE AFTER IGNORING THE FLAG
	TRZ	W1,777000	;DON'T USE LENGTH IN INDEXING INTO THE TABLE
	XCT	STRTAB-PL.SSL(W1)	;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
REPEAT 0,<PUSHJ	P,T11MVM##>	;[735] -7 MOVEM
	JRST	T11SPE		;750 NOT DEFINED
	JRST	T11SPE		;751 NOT DEFINED
	JRST	T11SPE		;752 NOT DEFINED
	JRST	T11SPE		;753 NOT DEFINED
	PUSHJ	P,T11SYF##	;754 FULL WORD SYMBOL FIXUP
	PUSHJ	P,T11SYF##	;755 30-BIT  SYMBOL FIXUP
	PUSHJ	P,T11SYL##	;756 LEFT HALF SYMBOL FIXUP
	PUSHJ	P,T11SYR##	;757 RIGHT HALF SYMBOL FIXUP
	JRST	T11SPE		;760 NOT DEFINED
	JRST	T11SPE		;761 NOT DEFINED
	JRST	T11SPE		;762 NOT DEFINED
	JRST	T11SPE		;763 NOT DEFINED
	PUSHJ	P,SY.CHF##	;764 FULL WORDS SYMBOL FIXUP
	PUSHJ	P,SY.CHF##	;765 30-BIT SYMBOL FIXUP
	PUSHJ	P,SY.CHL##	;766 LEFT HALF SYMBOL FIXUP
	PUSHJ	P,SY.CHR##	;767 RIGHT HALF SYMBOL FIXUP
STRLEN== .-STRTAB-1		;[735] LENGTH OF STORE OP TABLE

T11STE:	.ERR.	(MS,.EC,V%L,L%F,S%F,IPO)
	.ETC.	(OCT,.EP,,,,T2)
;HERE TO DISPATCH FOR SYMBOL TABLE FIXUPS

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

;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


T11PSF:	.ERR.	(MS,,V%L,L%W,S%W,PSF,<Polish symbol fixups not yet implemented>)
	SETZ	W1,		;NO-OP
	POPJ	P,		;CONTINUE

;HERE IF FAIL INNER BLOCK LABELED LITERALS
;HERE TO SEE IF REQUESTED BLOCK HAS BEEN LOADED FOR THIS PROGRAM

T11FBH:	SKIPN	T1,FBHPTR	;GET POINTER TO BLOCK HEADERS
	POPJ	P,		;NONE LOADED
	HRRZ	T1,NAMPTR	;GET POINTER TO LOCAL SYMBOL
	CAIA			;ALREADY IN T1 FIRST TIME
T11FBL:	HLRZ	T1,2(T1)	;GET POINTER TO BLOCK HEADER
	JUMPE	T1,CPOPJ	;END OF CHAIN
	CAMGE	T1,LW.LS	;IN CORE?
	JRST	T11PSF		;NOT AVAILABLE YET
	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	E01SFU##	;NO
	CAME	W2,1(T1)	;SEE IF THIS IS THE BLOCK
	JRST	T11FBL		;NOT YET
	MOVE	W2,W3		;PUT SYMBOL WE WANT IN W2
T11FBS:	ADDI	T1,.L		;ADVANCE
	CAML	T1,LS.AB	;MAKE SURE WE DON'T GO TOO FAR
	POPJ	P,		;DIDN'T FIND IT
	SKIPLE	T2,(T1)		;ONLY WANT PRIMARIES (OR 0)
	JRST	T11FBS		;IGNORE ALL SECONDARY STUFF
	JUMPE	T2,.+2		;0 MARKS END
	TXNE	T2,PT.TTL	;STOP AT NEXT BLOCK
	POPJ	P,
	TXNE	T2,PT.SYM	;MUST BE A SYMBOL
	CAME	W2,1(T1)	;YES, BUT IS IT ONE WE WANT?
	JRST	T11FBS		;NO REQUIRED SYMBOL
	SUB	T1,LS.LB	;RELATIVE-IZE THIS POINTER
	ADD	T1,LW.LS
	SETZ	T2,		;CLEAR GLOBAL SYMBOL PTR
	JRST	CPOPJ1		;OK RETURN

 >  ;IFN .NWBLK

SUBTTL	ASCIZ TEXT BLOCK


;	-------------
;	! A S C I I !
;	-------------
;	! T E X T 0 !
;	-------------

IFN .ASBLK,<
LNKASC::TRNE	FL,R.LIB!R.INC	;[602] ARE WE LOADING?
	JRST	ASCSKP		;[602] NO, SKIP OVER THIS TEXT BLOCK
	MOVEI	T2,^D128	;USE STANDARD BUFFER OF 200 WORDS
	PUSHJ	P,DY.GET##
	MOVEM	T1,F.ASCC	;USE COUNT TO HOLD CURRENT POINTER
	HRLI	T1,(POINT 7,,35) ;BUILD THE BYTE POINTER
	MOVEM	T1,F.ASCI	;INITIAL AREA POINTER
ASCT0:	MOVEI	P1,1(T1)	;FIRST WORK IS USED AS A LINK IF MORE DATA
	TLO	P1,-^D127	;FORM AOBJN POINTER
	JRST	ASCT2		;JUMP INTO WORD STASHING LOOP
ASCT1:	PUSHJ	P,D.RED1##	;GET WORD FROM REL FILE
	JRST	ASCFIN		;END OF FILE
ASCT2:	MOVEM	W1,(P1)		;STORE TEXT WORD
	TRNN	W1,177B34	;FINISHED IF NULL BYTE
	JRST	ASCFIN		;YES
	AOBJN	P1,ASCT1	;NO, LOOP UNLESS BLOCK FULL
	MOVEI	T2,^D128	;GET ANOTHER BLOCK
	PUSHJ	P,DY.GET##
	MOVEM	T1,@F.ASCC	;STORE POINTER
	MOVEM	T1,F.ASCC	;POINT TO NEW BLOCK
	MOVEI	P1,1(T1)	;FORM BYTE POINTER AGAIN
	HRLI	P1,-^D127
	JRST	ASCT1		;AND CONTINUE

ASCFIN:	MOVEI	T1,^D127*5	;CHARACTERS PER BLOCK
	MOVEM	T1,F.ASCC	;SET COUNT FOR FIRST BLOCK
	PUSH	P,F.NXZR	;REMEMBER POINTER TO END
	PUSH	P,F.INZR	;SAVE CURRENT FILE SPEC POINTERS
	PUSH	P,SWFLAG	;AND SWITCHES
INZLOC:	SETZM	F.INZR		;NOW CLEAR THEM
	SETZM	F.NXZR
SWFLOC:	SETZM	SWFLAG
ASZLOC:	HLLZM	FL,F.ASZR	;STORE GLOBAL FLAGS IN LH
	JRST	LNKSCN##	;GO TO SCANNER FOR INCORE COMMAND


;HERE TO PROCESS ASCII TEXT IN /INCLUDE OR /SEARCH MODE. JUST IGNORE IT.
ASCSKP:	TRNN	W1,177B34	;[602] END OF ASCIZ STRING?
	JRST	LOAD##		;[602] YES, PROCESS NEXT BLOCK TYPE
	PUSHJ	P,D.IN1##	;[602] GET NEXT WORD, GOTO LOAD IF EOF
	JRST	ASCSKP		;[602] AND CONTINUE IGNORING IT
;RETURN HERE
ASCRET::HRRZ	T1,F.ASZR	;SEEN ANY FILE NAMES YET?
	JUMPN	T1,ASCRT2	;YES, NOT LOOKING AT SWITCHES
	POP	P,T1		;RESTORE OLD SWFLAG
	EXCH	T1,SWFLAG	;PUT INCORE ONES FIRST
	SKIPA	T3,SWFLOC	;LOOK FOR END OF LIST
ASCRT1:	MOVE	T3,T2		;STORE OLD
	MOVE	T2,(T3)		;GET NEXT POINTER
	TRNE	T2,-1		;0 LINK IS END
	JRST	ASCRT1		;NOT YET
	HRRM	T1,(T3)		;LINK OLD SWITCHES IN
	PUSH	P,SWFLAG	;NOW SAVE REVISED SWITCH LIST
ASCRT2:	PUSHJ	P,ASZCHN	;LINK NEW SPECS TO OLD F.ASZR
	TRNE	T1,-1		;ANY SPECS SEEN THIS PASS?
	PUSHJ	P,INSEOL	;YES, INSERT /CRLF FOR SWITCHES
	SETZM	F.INZR		;NOW CLEAR VARIABLES FOR NEXT TIME
	SETZM	F.NXZR		;SO WON'T CONFUSE CLANS
	MOVE	T1,F.ASCI	;PICK UP POINTER TO CURRENT TEXT
	CAME	T1,[-1]		;REACHED EOF YET?
	JRST	LNKSCN##	;NO, GO PROCESS NEXT LINE
	POP	P,SWFLAG	;YES, RESTORE THINGS TO EARLIER
	POP	P,F.INZR	;OLD F.INZR (REST REAL COMMAND)
	PUSHJ	P,ASZCHN	;CHAIN OLD LINE TO END OF NEW
	TRNE	T1,-1		;ANY MORE THIS REAL COMMAND LINE?
	PUSHJ	P,INSEOL	;YES, INSERT /CRLF
	HLLO	T2,F.ASZR	;LAST TIME, SO RESET GLOBAL FLAGS
	TRNE	T1,-1		;T1 EITHER 0 OR ADDR OF SWITCH
	MOVEM	T2,2(T1)	;SWITCH, STORE VALUE
	POP	P,F.NXZR	;END OF NEW CHAIN SAME AS OLD
	MOVE	T1,F.ASZR	;PUT WHOLE CHAIN IN F.INZR
	HRRZM	T1,F.INZR	;SO LNKWLD CAN FIND IT
	SETZM	F.ASZR		;NOW CLEAN UP ASCII TEXT DATA BASE
	SETZM	F.ASCI		;..
	SETZM	F.ASCC		;..
	SETZM	F.ASCK
	JRST	LOAD		;CONTINUE WITH CURRENT .REL FILE

;HERE TO FOLLOW THE F.ASZR CHAIN, AND APPEND THE F.INZR CHAIN
;  TO IT. RETURNS OLD F.INZR IN T1

ASZCHN:	SKIPA	T3,ASZLOC	;GET ADDR OF HEAD OF LIST
ASZCN1:	MOVE	T3,T2		;REMEMBER LAST ADDR IN CASE END
	HRRZ	T2,F.NXT(T3)	;FOLLOW CHAIN
	JUMPN	T2,ASZCN1	;IF NOT DONE, CONTINUE
	MOVE	T1,F.INZR	;GET START OF F.INZR CHAIN
	HRRM	T1,F.NXT(T3)	;STORE AT END OF F.ASZR CHAIN
	POPJ	P,		;DONE
;HERE TO PUT A GLOBAL SWITCH BLOCK ONTO THE SCAN BLOCK POINTED TO BY
;  F.INZR TO INDICATE THAT /CRLF PROCESSING IS NEEDED BEFORE THIS FILE
;  SPEC IS PROCESSED. THIS RESETS EOL DEFAULTS, ETC. SINCE THE POSITION
;  OF CRLFS IS FORGOTTEN DURING ASCII BLOCK PROCESSING. THIS ROUTINE
;  RETURNS THE ADDRESS OF THE ADDED SWITCH BLOCK IN T1.

INSEOL:	MOVEI	T2,3		;SWITCH BLOCKS ARE 3 WORDS
	PUSHJ	P,DY.GET##	;GRAB ONE
	MOVSI	T2,3		;1ST WORD IS LEN,,ADDR OF NEXT
	MOVEM	T2,0(T1)	;STORE IN BLOCK
	MOVEI	T2,%CRLF%	;2ND WORD IS TOKEN VALUE
	MOVEM	T2,1(T1)	;STORE IT TOO
	HRRZ	T2,F.INZR	;GET POINTER TO NEW SCAN BLOCK
	HLRZ	T3,F.SWP(T2)	;GET ADDR OF CURRENT SWITCHES
	HRLM	T1,F.SWP(T2)	;REPLACE WITH ADDR OF THIS BLOCK
	HRRM	T3,0(T1)	;LINK IN ANY OLD SWITCHES
	POPJ	P,

;NOW CALCULATE THE VALUE OF %CRLF% FROM THE SWMAC MACRO.

DEFINE	SWMAC(A,B,C,D,E,F,G,H,I),<
 IF1,<
  IFIDN <B><CRLF>,<
   IFNDEF %CRLF%,<
    %CRLF%==TK.
  >>
  TK.==TK.+1
>>

TK.==0				;INITIAL CONDITION
SWTCHS

>;END IFN .ASBLK
SUBTTL	NEW BLOCK TYPE INPUT ROUTINES


COMMENT	^

THESE ROUTINES COUNT BLOCK LENGTH AND DO RELOCATION AS FOLLOWS:

     AC WC CONTAINS THE NEGATIVE COUNT OF WORDS LEFT UNTIL THE NEXT
RELOCATION WORD IN THE LEFT HALF, AND THE NEGATIVE COUNT OF WORDS LEFT
IN THE CURRENT BLOCK IN THE RIGHT HALF. BIT 18 IS OFF SO THAT THE
OVERFLOW OF THE RIGHT HALF WILL NOT AFFECT THE LEFT HALF ON KA10'S.
THE ROUTINES FOR THOSE BLOCK TYPES THAT DO NOT EXPECT RELOCATION
WORDS SHOULD SET THE LEFT HALF OF WC TO 400000 (BY USE OF THE
RELOCATE MACRO) SO THAT THE CURRENT "RELOCATION BLOCK" WILL NEVER
EXPIRE.
     AC RB CONTAINS THE CURRENT RELOCATION WORD.  EACH TIME THAT
A NEW RELOCATION BYTE IS REQUIRED, RB (= R+1) IS SHIFTED C(RELSIZ)
BITS TO THE LEFT, THEREBY SETTING UP R.  IF WE ARE NOT LOADING DATA
THAT CONTAINS RELOCATION WORDS, THIS CODE IS STILL EXECUTED, BUT
SINCE RB ALWAYS CONTAINS ZERO, THE CODE IS ALWAYS CONSIDERED ABSOLUTE.
	NOTE THAT LH(WC) IS NOT KEPT UP TO DATE IF LOADING A BLOCK
TYPE THAT DOES NOT INCLUDE RELOCATION WORDS, AND PROCESSING ROUTINES
FOR THOSE BLOCK TYPES MAY SAVE OVERHEAD BY CALLING D.GET? INSTEAD OF
D.REL?, ALTHOUGH D.REL? WILL WORK CORRECTLY IF CALLED.

	^

IFN .NWBLK,<

;SUBROUTINE TO READ IN A TRIPLET FROM THE CURRENT BLOCK.
;CALL IS:
;
;	PUSHJ	P,D.TRIP
;	  NO DATA RETURN	(END OF BLOCK OR END OF FILE)
;	HERE WITH W1-W3 SETUP
;
;USES W1-W3, T1-T2.

D.TRIP::PUSHJ	P,D.GET1	;GET NEXT WORD, CHECKING FOR END OF DATA
	  POPJ	P,		;NONE LEFT
	MOVE	W3,W1		;SAVE FLAGS FOR LATER
	PUSHJ	P,D.GET1	;GET SYMBOL, IF THERE
	  POPJ	P,		;IT'S NOT
	MOVE	W2,W1		;POSITION SYMBOL CORRECTLY
	PUSHJ	P,D.REL1	;NOW READ VALUE, POSSIBLY RELOCATING
	  POPJ	P,		;OH WELL
	EXCH	W1,W3		;PUT FLAGS & VALUE IN CORRECT PLACES
	JRST	CPOPJ1		;GOOD RETURN
;ROUTINES TO GET THE NEXT WORD FROM THE DATA FILE AND DO ANY
;RELOCATION NECESSARY AS INDICATED BY RELSIZ, WC, AND RB. CALL IS:
;
;	PUSHJ	P,D.REL?
;	  NO DATA RETURN
;	OK RETURN
;
;RETURNS THE NEXT WORD IN W1, OR W2 & W1. USES T1-T2.


D.REL2::PUSHJ	P,D.REL1	;GET THE FIRST WORD
	  POPJ	P,		;NONE LEFT
	MOVE	W2,W1		;SAVE FIRST WORD
				;FALL IN TO GET SECOND WORD
D.REL1::TRNN	WC,377777	;MORE DATA IN THIS BLOCK?
	  POPJ	P,		;NO, RETURN NO DATA
	PUSHJ	P,D.RED1##	;YES, GET NEXT WORD
	  JRST	E$$PEF		;[1174] WORD COUNT WAS WRONG
	AOBJN	WC,DRELN	;GO RELOCATE UNLESS NEED NEW SUB-BLOCK
	MOVE	RB,W1		;SAVE THE NEW RELOCATION WORD
	MOVNI	T1,^D36		;FIND SIZE OF THIS SUB-BLOCK
	IDIV	T1,RELSIZ	;FROM THE BYTE SIZE
	TRNE	FL,R.LHR	;LEFT HALF RELOCATION DATA TOO?
	ASH	T1,-1		;YES, ONLY 1/2 AS MANY WORDS IN BLOCK
	HRL	WC,T1		;AND RESET SUB-BLOCK COUNT
	PUSHJ	P,D.GET1	;NOW GET 1ST DATA WORD OF NEW BLOCK
	  POPJ	P,		;???
DRELN:	SETZ	R,		;ZAP SOME BITS
	LSHC	R,@RELSIZ	;GRAB RELOCATION BYTE
	JUMPE	R,CPOPJ1	;IF ABSOLUTE, WE'RE DONE
;	SKIPN	R,@RC.TB	;ELSE SET UP R FOR RELOCATION BLOCK
;	JRST	E$$IRC		;[1174] RELOCATED TO SEGMENT NOT SET UP
;********* ADD MORE CODE HERE ********************************

E$$IRC::.ERR.	(MS,.EC,V%L,L%F,S%F,IRC,<Illegal relocation counter>) ;[1174]
	.ETC.	(JMP,,,,,.ETNMF##)

> ;END IFN .NWBLK<
;HERE TO GET THE NEXT WORD FROM THE CURRENT BLOCK. RETURNS NON-SKIP
;ON END OF BLOCK OR END OF FILE. EXPECTS WC TO BE SET UP FROM LNKLOD.

D.GET1::TRNN	WC,377777	;END OF BLOCK ON LAST WORD?
	  POPJ	P,		;YES, NO MORE DATA
	PUSHJ	P,D.RED1##	;NO, GET NEXT WORD
	  JRST	E$$PEF		;[1174] PREMATURE END OF FILE
	AOJA	WC,CPOPJ1	;COUNT WORD & GIVE GOOD RETURN

CPOPJ1:	AOS	0(P)		;THE USUAL
CPOPJ:	POPJ	P,


;HERE WHEN THE .REL FILE HAS A PREMATURE EOF.

E$$PEF::.ERR.	(MS,.EC,V%L,L%F,S%W,PEF,<Premature end of file from file >) ;[1174]
	.ETC.	(FSP,,,,,DC)
	POPJ	P,		;TRY TO CONTINUE
SUBTTL WORD RELOCATION FOR BLOCK 1070
;ROUTINE TO RELOCATE A WORD (USED BY BLOCK 1070)
;
;	PUSHJ	P,REL.1
;	  NO DATA RETURN
;	OK RETURN (W1/ RETURN VALUE)
;
;ENTER WITH:
;
;	R/	TEMP. PSECTS  (-1 IF NOT USED)
;	RB/	RELOCATION TYPE 
;	RC.CUR/	CUREENT PSECT
;
;ACS USED:	R,RB,T1,W1,W3
;
;RETURN VALUES:	
;	W1/	FLAG
;	W3/	VALUE

IFN .NWBLK,<
;[1000]
REL.1::TRNN	WC,377777	;MORE DATA IN THIS BLOCK?
	  POPJ	P,		;NO, RETURN NO DATA
	PUSHJ	P,D.GET1	;GO GET A WORDS
	  POPJ	P,		;???
	MOVE	W3,W1		;RETURN VALUE IN W3
	SETZ	W1,		;CLEAR RETURN FLAG WORD
	JUMPE	RB,CPOPJ1	;IF ABS, OK RETURN
	MOVX	W1,PS.REL	;RELOCATABLE SYMBOL
	JUMPGE	R,REL.T		;JUMP IF TEMPORARY PSECTS SPECIFIED
	PUSHJ	P,@[	REL.R		;1 - RIGHT HALF
			REL.L		;2 - LEFT HALF
			REL.B		;3 - BOTH HAVES
			REL.E		;4 - EXTENDED(30BIT) 
			REL.F]-1(RB)	;5 - FULL WORD
	JRST	CPOPJ1		;SKIP RETURN

REL.T:	PUSH	P,RC.CUR	;USE TEMP. PSECTS INSTEAD OF CURRENT ONE
	PUSHJ	P,@[	REL.TR		;1 - RIGHT HALF
			REL.TL		;2 - LEFT HALF
			REL.TB		;3 - BOTH HALVES
			REL.TE		;4 - EXTENDED(30 BIT)
			REL.TF]-1(RB)	;5 - FULL WORD
	POP	P,RC.CUR	;RESTORE ORIGINAL PSECT
	JRST	CPOPJ1		;AND SKIP RETURN

REL.B:	PUSHJ	P,REL.L		;RELOCATE LEFT WITH CUREENT PSECT FIRST
	JRST	REL.R		;THEN DO THE SAME WITH RIGHT HALF

REL.TB:	PUSH	P,R		;SAVE FOR RIGHT
	PUSHJ	P,REL.TL	;RELOCATE LEFT WITH TEMP. PSECT
	POP	P,R		;[1720]
REL.TR:	HRRZ	R,@RC.MAP	;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
	HRRM	R,RC.CUR	;TEMPORARILY SWITCH CURRENT PSECT 
REL.R:	HRR	T1,W3		;ADDRESS IN T1
	PUSHJ	P,R.CUR##	;GO RELOCATE IT WITH CURRENT PSECT
	HRR	W3,T1		;RETURN VALUE IN W3
	POPJ	P,		;

REL.TL:	HLRZ	R,R		;[1716] GET LH PSECT INDEX
	HRRZ	R,@RC.MAP	;[1716] TRANSLATE TO INTERNAL PSECT INDEX
	HRRM	R,RC.CUR	;[1716] SWITCH CURRENT PSECT
REL.L:	HLR	T1,W3		;SET UP ADDRESS IN T1
	PUSHJ	P,R.CUR##	;GO RELOCATE IT
	HRL	W3,T1		;RETURN VALUE IN W3
	POPJ	P,		;

REL.TE:	HRRZ	R,@RC.MAP	;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
	HRRM	R,RC.CUR	;SWITCH CURRENT PSECT
REL.E:	LDB	T1,[POINT 30,W3,35]
	PUSHJ	P,R.CUR##	;
	LDB	W3,[POINT 30,T1,35]
	POPJ	P,

REL.TF:	HRRZ	R,@RC.MAP	;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
	HRRM	R,RC.CUR	;SWITCH CURRENT PSECT
REL.F:	MOVE	T1,W3		;SET UP ADDRESS IN T1
	PUSHJ	P,R.CUR##	;GO RELOCATE IT
	MOVE	W3,T1		;RETURN VALUE IN W3
	POPJ	P,		;
>  ;IFN .NWBLK
SUBTTL SUPPORT CODE FOR 11XX BLOCKS

DEFINE NEWBLX(SIZ,NUM,TYP,DSP,PRC,XIT)<
	SETZM	NORBYT				;;[1456]
	PUSH	P,[ PRC ]			;;DATA WORD PROCESSOR
	MOVE	P1,[POINT SIZ,RB]		;;HOW TO ACCESS RELOC BYTES
	MOVEI	P2,NUM				;;NUMBER OF RELOC BYTES
	MOVE	P4,[ TYP ]			;;HOW TO DO THE RELOC
	PUSHJ	P,DSP				;;COMMON CODE TO INTERPRET THIS
	IFNB	<XIT>,<PUSHJ P,XIT>		;;[1471]
	JRST	LOAD				;;TO GET BACK TO MAIN LOOP
	>	;[1423]




T.11XX::
;
;  T.1100 through T.1137 come here after setting up ACs as follows:
;	P1	-an initialized byte pointer for the relocation bytes
;	P2	-number of relocation bytes in the word
;	P4	-dispatch address for type of relocation (30bit)
;
;  First set up stack.

	POP	P,T1			;[1405] UNSTACK RETURN ADDRESS
	EXCH	T1,(P)			;[1405] SWAP WITH PROCESSOR ADDRESS
	PUSH	P,T1			;[1405] RETURN ONLY WHEN THRU
	AOS	P2			;[1423] SUBBLOCK INCLUDING RELOC WORD
	SPUSH <P1,P2>			;[1423] SAVE REGISTERS
	MOVN	T1,(P)			;[1423] SETUP WC
	HRL	WC,T1			;[1423]

; Note the data blocksize as some processors need this data.

	HRRZ	P3,WC			;[1405]
	TDO	P3,[-1,,400000]		;[1405] REAL NEGATIVE NUMBER
	MOVNS	P3			;[1405] NOW POSITIVE
	PUSH	P,P4			;[1405] SAVE P4
	IDIVI	P3,1(P2)		;[1405] INCLUDE HEADER IN BLOCKSIZE
	IMULI	P3,1(P2)		;[1405] MAXIMUM DATA BLOCKSIZE
	SKIPE	P4			;[1405] IF NONZERO RESIDUE
	ADDI	P3,-1(P4)		;[14YY] ADD IT, MINUS HEADER
	POP	P,P4			;[1405] GET P4 BACK

T11XXR:
; BEGIN PROCESSING A SUB-BLOCK

	PUSHJ	P,PB.1			;[1405] FETCH FIRST WORD OF BLOCK
	  JRST	[ SPOP	<T1,P2,P1>
		  POPJ	P,	]	;[1405] NO MORE IN BLOCK
	  JFCL				;[1405] IMPOSSIBLE"
	MOVE	RB,W1			;[1405] SETUP RELOC BYTE
	MOVE	P1,-1(P)		;[1405] RESET BYTEPOINTER

; BEGIN PROCESSING THE LIST

T11XXL:	PUSHJ	P,PB.1			;[1423] FETCH A DATA WORD
	  JRST	[ SPOP <T1,P2,P1>
		  POPJ	P,	]	;[1423] NO MORE
	  JRST	[ SKIPE RB,NORBYT	;[1456]
		  JRST  T11XXA		;[1456]		  
		  MOVE	P2,(P)
		  MOVE	P1,-1(P)
		  MOVN	T1,P2
		  HRL	WC,T1
		  JRST	T11XXR  ]	;[1423] RESET FOR NEXT SUBBLOCK
T11XXA:	PUSHJ	P,PSORGN		;[1456] GET ANY PSECT INDICES
	PUSHJ	P,@P4			;[1423] DO THE RELOCATION
	PUSHJ	P,@-2(P)		;[1405] AND THE PROCESSING
	JRST	T11XXL			;[1423] DO IT AGAIN

SUBTTL	BLOCK TYPES 1100-1104 - PROGRAM DATA VECTORS



T.1100::
	NEWBLX(2,^D18,THADD,T.11XX,T.110X)	;[1423]

T.1101::
	NEWBLX(3,^D12,THADD,T.11XX,T.110X)	;[1423]

T.1102::
	NEWBLX(6,6,THADD,T.11XX,T.110X)		;[1423]

T.1103::
	NEWBLX(9,4,THADD,T.11XX,T.110X)		;[1423]

T.1104::
	NEWBLX(18,2,THADD,T.11XX,T.110X)	;[1423]



T.110X: SKIPE	W1			;[1423] IGNORE ZEROS
	MOVEM	W1,PDVADR##		;[1423] STORE PDV ADDR
;** MAKE THIS WORK RIGHT FOR MULTIPLE PDVS **
	POPJ	P,

SUBTTL BLOCK TYPES 1120-1124  -- TYPE CHECKING BLOCKS

DEFINE T112XM(N)<
	NEWBLX(N,<^D36/N>,THADD,T.11XX,T.112X,T112XP) >	;[1472]

T.1120::
	T112XM(2)			;[1472]
T.1121::
	T112XM(3)			;[1472]
T.1122::
	T112XM(6)			;[1472]
T.1123::
	T112XM(^D9)			;[1472]
T.1124::
	T112XM(^D18)			;[1472]

T.112X: SETOM	NORBYT			;[1456] DON'T READ ANY MORE RELOC BYTES
	SKIPGE	P3			;[1405] FIRST TIME THRU?
	JRST	T112X			;[1405] NO
	MOVEI	T2,2(P3)		;[2020] ALLOCATE A STORAGE BLOCK
	PUSHJ	P,DY.GET##		;[1405] TO HOLD THE INFO
	HRLZM	T2,ABLNK(T1)		;[2020] STORE SIZE,,0 IN LINK WORD
	MOVE	W3,PRGNAM		;[2005] GET THE MODULE NAME
	MOVEM	W3,ABMOD(T1)		;[2020] SAVE IT
	MOVEI	W3,ABABA(T1)		;[2020] SAVE A PTR
	MOVN	T2,P3			;[1405]
	HRL	W3,T2			;[1405] MAKE W3 AN AOBJN PTR
	MOVE	W2,W3			;[1405] W2 IS A BASE PTR
	SUB	W2,[2,,2]		;[2020] POINT AT ACTUAL BASE
	SETOM	P3			;[1405] SAY WE'VE BEEN HERE
T112X:	MOVEM	W1,(W3)			;[1405] STORE THE DATA
	ADD	W3,[1,,1]		;[1471]
	POPJ	P,			;[1405] GET MORE
T112XP:
	MOVE	T4,ABCNT(W2)		;[1472] NOTE COUNT
	CAILE	T4,6			;[1472] NO MORE THAN SIX PLEASE
	MOVEI	T4,6			;[1472] 
	MOVE	T2,[POINT 7,ABNAM(W2)] 	;[1472]
	MOVE	T3,[POINT 6,W3]		;[1472] PUT IT IN W3
	SETZM	W3			;[1472]
T112X0:	SOJL	T4,T112X1		;[1472] STOP WHEN ALL CHARS DONE
	ILDB	T1,T2			;[1472] PICK UP ASCII
	JUMPE	T1,T112X1		;[1472] NUL MUST BE END OF ASCIZ
	SUBI	T1," "			;[1472] ASCII TO SIXBIT
	IDPB	T1,T3			;[1472] ACCUMULATE
	JRST	T112X0			;[1472] 
T112X1:	EXCH	W3,W2			;[1472] W2/SIXBIT,W3/PTR
	PUSHJ	P,SY.TYP##		;[1472]
	POPJ	P,

SUBTTL BLOCK TYPES 1130-1134  --  COERCION BLOCKS

T.1130::
	PUSHJ	P,STDATA		;[1704] USE GENERAL ROUTINE
	MOVEM	W2,COERPT		;[1405]
	JRST	LOAD##			;[1701]



STDATA::
; Reads data out of a block without doing any relocation.
; Returns IOWD to storage in DY area holding the data in register W2.
; Uses T1-T2 and W1-W3.

	HRRZ	T2,WC			;[1471] GET BLOCKSIZE
	TDO	T2,[-1,,400000]		;[1471]
	HRLM	T2,WC			;[1471] SUBBLOCK=BLOCK
	MOVNS	T2			;[1471] NOW POSITIVE
	PUSHJ	P,DY.GET##		;[1471] TO HOLD THE INFO
	MOVE	W3,T1			;[1701] SAVE A PTR
	MOVNS	T2			;[1701]
	HRL	W3,T2			;[1701] MAKE W3 AN AOBJN PTR
	MOVE	W2,W3			;[1701] W2 IS A BASE PTR
STDATL:	PUSHJ	P,D.IN1##		;[1471] PICK UP A WORD
	MOVEM	W1,(W3)			;[1471] STORE THE DATA
	AOBJP	W3,CPOPJ		;[1704] ALL DATA READ, NOW PROCESS IT
	JRST	STDATL			;[1471] GET ANOTHER WORD


SUBTTL	THE END


NEWLIT:	END