Google
 

Trailing-Edge - PDP-10 Archives - bb-r775d-bm_tops20_ks_upd_4 - sources/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/HD		11-Dec-84



;COPYRIGHT (C) 1973, 1984 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==6		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==2345		;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.
;2031	Don't set the writable bit in OVERLW unless actually doing overlays.
;2072	Skip unused byte when relocating the address in type 102X blocks.
;2073	Add contents of WRTDAT, not address of WRTDAT in WRTPTR.

;Start of Version 6
;2200	Use 30 bit addresses in fixup blocks for SY.CHP
;2205	Don't add 30 bit address to 18 bit byte pointer.
;2212	Fix problems with type 1072 long polish block.
;2222	Implement the type 1050, 1051, and 1052 rel blocks.
;2223	Implement the type 1131 psect redirection block.
;2231	Fix typo in edit 2223.
;2236	Keep stack straight for long symbols in type 1131.
;2246	Fix chained and additive fixups.
;2247	Allow for .LOW. not existing yet.
;2254	Remove FAIL block header chain, use 30 bit NAMPTR.
;2255	Use 30 bit addresses for LS area fixups.
;2262	Implement the 1160 data block, use common code for the 1004 block.
;2266	Don't truncate type 112x symbol names.
;2270	Allow type 112x blocks to page.
;2272	Default psects to .LOW. and .HIGH. in the type 1131 block.
;2301	Handle error from D.CNT correctly.
;2303	Push correct register in non-symbolic type 1004 blocks.
;2305	Make 1070 blocks work, Make 1002 blocks work
;2307	Fix problem with typechecking routines with six character names.
;2310	Implement the type 1074 long symbol common block.
;2313	Make type 1004 and 1160 work in overlays.
;2324	Make polish chained fixup handlers clear P1 before calling SY.CHx.
;2326	Make 1003 (long title) blocks work
;2327	Fix problem with relocation in type 1160 block.
;2333	Set flags for fixup block in 1070 code.
;2340	Check for invalid psect index in 1074.
;2343	Fix problem with sparse data below address 140.
;2345	Clean up and fix t1003 block code.
SUBTTL	BLOCK DISPATCH TABLES


	XALL
NDSPTB:	LITYPE	(1000,1160)		;[2262]
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

T1000C:	MOVNI	W1,400000(WC)	;[2262] PUT WORD COUNT IN W1
	JRST	T.1000		;[2262] IGNORE REST OF 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
	CAIL	R3,<SYMSIZ-1>	;[2305] IS IT LONGER THAN MAX NAME SIZE?
	 PUSHJ	P,E$$STL	;[2305] YES - GIVE ERROR
	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:	MOVE	T2,R3		;[2305] get count for this entry name
	PUSHJ 	P,DY.GET##	;[2305] get the space we need
	MOVN	T2,T2		;[2305] negate the length
	HRLS	T2		;[2305] make left half of aobjn pointer
	HRR	T2,T1		;[2305] make right half of abojn (addres of dy 
				;[2305] block for name)
T1002L: PUSHJ	P,D.IN1		;[2305]
	MOVEM	W1,(T2)		;[2305] store a word
	AOBJN	T2,T1002L	;[2305]
	JRST	T1002B		;[2305]

	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:	HRL	T1,R3		;[2305] GET THE COUNT
	MOVE	T2,ENTPTR	;[2305]
	MOVEM	T1,(T2)
	TRNN	FL,R.LIB	;IN LIBRARY SEARCH MODE
	JRST	LOAD##		;YES, SYMBOL STORED SO GET NEXT BLOCK
	MOVE	W2,1(W3)	;[2305] COUNT,,ADDRESS OF SYMBOL NAME TO W2
	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          |      Long  count          |
;        -----------------------------------------------------
;	|             1         |   Count of Title words     |
;        -----------------------------------------------------
;	|                  Program Title                     |
;        -----------------------------------------------------
;	|             additional program title               |
;        -----------------------------------------------------
;	|             additional program title               |
;        -----------------------------------------------------
;                             . . .
;        _____________________________________________________
;	|              2        |  # ascii comment words     |
;        -----------------------------------------------------
;	|                  comment word                      |
;        -----------------------------------------------------
;	|                 more comment words                 |
;        -----------------------------------------------------
;			     . . .	      
;        _____________________________________________________
;	|               3        |  count of compiler words  |
;        -----------------------------------------------------
;	|      compiler code     |         CPU bits          |
;	------------------------------------------------------
;	|                   Compiler name (in ascii)	     |
;	------------------------------------------------------
;	|               additional compiler name             |
;	------------------------------------------------------
;	|               additional compiler name             |
;	------------------------------------------------------
;			      . . .
;	______________________________________________________
;	|              4          |            0             |
;	------------------------------------------------------
;	|                 Compile Date and Time              |
;	------------------------------------------------------
;	|                Compiler version number             |
;	------------------------------------------------------
;	|               5         |             0            |
;	------------------------------------------------------
;	|                     Device Name                    |
;	------------------------------------------------------
;	|                  UFD or 0 for TOPS-20              |
;	------------------------------------------------------
;	|               6	  |             0            |
;	------------------------------------------------------
;	|                   Tops-10 file Name                |
;	------------------------------------------------------
;	|       file extention    |             0            |
;	------------------------------------------------------
;	|        	7	  |    number of SFDs        |
;	------------------------------------------------------
;	|			SFD 1                        |
;	------------------------------------------------------
;	|                       SFD 2                        |
;	-----------------------------------------------------
;                                . . .
;	______________________________________________________
;	|             10          | Number of TOPS-20 file   |
;	|                         |  spec words (in ascii)   |
;	------------------------------------------------------
;	|               TOPS-20 file spec                    |
;	------------------------------------------------------
;	|            more TOPS-20 file spec       	     |
;	------------------------------------------------------
;                                . . .
;	______________________________________________________
;	|             11	  |             0            |
;	------------------------------------------------------
;	|                  Source version number             |
;	------------------------------------------------------
;	|           Date          |           Time           |
;	------------------------------------------------------
IFE .NWBLK,<
T.1003==E$$IRB##
>
;HERE ON A BLOCK TYPE 1003 (NAME BLOCK)

;THE W'S CONTAIN THE CURRENT TRIPLET AND THE T'S ARE SCRATCH.


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	T1000C		;[2345] NO CHANCE, JUST IGNORE THIS BLOCK
	PUSHJ	P,D.GET1
	  PUSHJ	P,T1003E	;ERROR
	HLR	T1,W1		;[2326] get the sub-block code
	HRRZS	W1		;[2326] save just sub-block count
	CAIE	T1,1		;[2326] this is first sub-block must be name
				;[2326] sub-block
	 JRST	E$$IRB		;[2326] else the block is bad
	XCT	X03BIT(T1)	;[2326] set the correct bits in flag word (w1)
	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
	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
	PUSHJ	P,X03TTL	;[2326] get the module name

;[2326] Now check /include /exclude to see if we have to load this module

	TRNE	FL,R.LIB!R.INC
	JRST	X03INC
	SKIPN	EXCPTR		;[2326] if any /excludes
	SKIPE	INCPTR		;[2326] no but may have to purge entry in 
				;[2326] include list.
	JRST	X03EXC		;[2326] see if should be excluded (t.6exc)
X03OK:	TRZ	FL,R.LIB!R.INC	;[2326] loading this module for sure
	MOVEM	W2,PRGNAM	;[2326] save name for error messages
	SKIPE	REDLO		;[2326] doing /REDIRECT
	 PUSHJ	P,T.6RED##	;[2326] yes so do it
	TRNE	FL,R.FHS	;[2326] need to adjust relocation tables?
	PUSHJ 	P,T.6RC##	;[2326] yes so do it

	MOVE	T1,LSYM		;WORD COUNT IN LOCAL SYMBOL TABLE
	MOVEM	T1,NAMPTR	;POINT TO THIS TITLE BLOCK

	PUSHJ	P,E$$LMN##	;[2326] tell that this module is being loaded
	SETZM	W3		;[2326] zero w3 
	PUSHJ	P,X03ADD	;[2326] since it is loaded put in local symbol
				;[2326] for map
	AOS	PRGNO		;[2326] one more module seen
X03SRT:	PUSHJ	P,D.GET1	;[2326] get the next word
	 JRST	X03ND		;[2345] go output seg info 
	HRRZ	T1,W1		;[2326] get count if any
	HLRZ	T2,W1		;[2326] get the sub-block code for index
	SKIPLE	T2		;[2345] Index must be greater than 0
	CAIL	T2,MAXBIT	;[2345] but less than maximun index
	 JRST	T1003E		;[2345] Not a valid sub-block index code
	XCT	X03BIT(T2)	;[2326] set the appropriate bits in w1
	XCT	X03JMP(T2)	;[2326] go to the appropriate routine


;[2326] this routine handles the CPU code and the compiler name and code.

X03PRC: HRRZ	P1,T1		;[2326] save count of extra compiler name words
	HLLZS	W1		;[2326] clear the count from flag word
	PUSH 	P,W1		;[2326] put the flags on the stack
	PUSH	P,P1		;[2326] store the count since p1 is used later
	PUSHJ	P,D.GET1	;[2326] get the next word
	 JRST	T1003E		;[2345] something is wrong with rel blk
	MOVE 	W2,W1		;[2326] first compiler & CPU bits to w2
	
	LDB	T1,[POINT 6,W2,5] ;[2345] get runnable cpu bits
	ANDI	T1,CP.MSK	;[2326] clear CPUS we don't know about
	SKIPN	T1		;[2345] asked for none?
	MOVEI	T1,CP.MSK	;[2326] yes--means all
	HRRZM	T1,CTYPE	;[2326] save with compiler type
	MOVE	T2,CPUTGT	;[2326] get target CPUs
	JUMPE	T2,x03TGT	;[2326] the CPU switches are not being used
	TDON	T1,T2		;[2326] test for a good target switch
	JRST	E$$CPU##	;[2326] .DIRECTIVE is for wrong CPU
X03TGT:	SKIPN	OKCPUS		;[2345] can any CPU run this code?
	JRST	X03END		;[2345] no--forget this test
	ANDM	T1,OKCPUS	;[2326] enforce CPU flags
	SKIPN	OKCPUS		;[2326] can prog run at all now?
	PUSHJ	P,E$$CCD##		;[2326] no--CPU conflict detected
X03END:	LDB	T1,[POINT 12,W2,17] ;[2345] now get processor type
	CAILE	T1,CT.LEN	;[2326] check for range
	SETZ	T1,		;[2326] make it unknown
	HRLM	T1,CTYPE	;[2326] save compiler type
	MOVE	T2,PROCSN	;[2326] get list of procs seen so far
	MOVE	P1,T1		;[2326] safe place
	PUSH	P,W2		;[2345] put on stack for CT.NAM(t1) call
	XCT	CT.NAM##(T1)	;[2326] proc routines expect many ACs + (p)
	MOVE	T1,CT.BIT##(P1)	;[2326] get corresponding bit
	IORM	T1,PROCSN	;[2326] signal we have seen this one
	IORM	T1,LIBPRC	;[2326] a new module this library pass
	POP	P,W2		;[2326] clear flags off stack
	POP	P,P1		;[2326] restore count of name words
	JUMPE   P1,NONAME	;[2345] check for no compiler name
	PUSHJ	P,D.GET1	;[2326] get next word - 1st name word
	 JRST	T1003E		;[2345] something is wrong with rel blk
	SKIPA 	W3,W1		;[2345] put first compiler name word in w3
NONAME:	SETZM	W3		;[2345] if no compiler word then put in 0
	POP	P,W1		;[2345] restore compiler type and CPU bits
	PUSHJ	P,LS.ADD##	;[2326] store the triplet
	SOS	P1		;[2326] decrement count of 
	JRST 	RELLP		;[2326] check and put rest of long compiler
				;[2326] name in the ls area

;[2326] this routine takes the string stored as count,,address in w2 and builds
;[2326] triplets then stores them in ls area.

X03ADD:	TLNE	W2,770000	;[2326] is it a long title?
	PJRST	LS.ADD##	;[2345] no - just one words worth - go do it
	HLRZ	P1,W2		;[2326] count of words to p1
	HLLZS	W1		;[2326] clear count form w1 need to set trip 
				;[2326] bits there
	HRRZ	P2,W2		;[2326] the address of string to p2
	CAILE	P1,1		;[2326] do we need extended triplets
	TXC	W1,PS.EXO	;[2326] yes extended triplets to follow
	PUSHJ	P,X031WD	;[2326] build primary triplet
	TXZ	W1,PS.EXO	;[2326] clear secondary following bit
	TXZ	W1,PT.SGN!PT.EXT;[2326] clear primary flags
TRPLP:	JUMPLE	P1,DONE		;[2326] have we finished?
	CAIGE	P1,2		;[2326] need whole triplet?
	JRST	X031WD		;[2326] no - build last triplet
	PUSHJ	P,X03TRP	;[2326] yes - build whole triplet
	JRST	TRPLP		;[2326] go back and check for more
DONE:	POPJ	P,		;[2326] finished 


;[2326] build whole triplet from string address stored in p2, 
;[2326] count stored in p1.

X03TRP:	DMOVE	W2,@P2		;[2326] put the 2 words in w2, w3
	SUBI	P1,2		;[2326] two words stored so decrement count
	ADDI	p2,2		;[2326] got two so bump address
	PUSHJ	P, LS.ADD##	;[2326] put them in the ls area
	POPJ	P,

;[2326] build a triplet with only one word of title left and store in ls area

X031WD:	MOVE	W2,@P2		;[2326] get word form source and put in w2
	SETZM	W3		;[2326] zero w3
	SOS	P1		;[2326] subtract one from count 
	AOS	P2		;[2326] add one to the address
	PJRST	LS.ADD##	;[2345] store the triplet in the ls area


;[2326] This routine builds triplets from the rel file and stores them in the 
;[2326] ls area enters with the flags in w1 and count in right half of w1.
;[2326] Gets the next two words and puts them in w2,and w3.

X03STR:	HRRZ	P1,T1		;[2326] count of words to p1
	PUSHJ	P,X03TRW	;[2326] build primary triplet
RELLP:	JUMPLE	P1,X03SRT	;[2345] go back for next sub-block
	CAIGE	P1,2		;[2326] need whole triplet?
	JRST	X031RW		;[2326] no - build last triplet
	PUSHJ	P,X03TRW	;[2326] yes - build whole triplet
	JRST	RELLP


;[2326] gets a word form the rel block and put it in w2, zeroes w3, then 
;[2326] stores the triplet in the ls area.

X031RW:	PUSH	P,W1		;[2326] save the flags
	PUSHJ	P,D.GET1	;[2326] get the next word from the rel file
	 JRST	T1003E		;[2345] something is wrong with the rel block
	MOVE	W2,W1		;[2326] put the word in w2
	SETZM	W3		;[2326] third word is a zero
	POP	P,W1		;[2326] restore the flags
	SUBI	P1,1		;[2326] decrease the count of words
	PUSHJ	P,LS.ADD##	;[2326] store the triplet in the ls area
	JRST	X03SRT		;[2345] back for the next sub-block

;[2326] gets two words from the rel block and puts them in w2,w3 then 
;[2326] stores the triplet in the ls area.

X03TRW:	PUSH 	P,W1		;[2326] save the flags
	PUSHJ	P,D.GET1	;[2326] get the next word for rel block
	 JRST	T1003E		;[2345] something is wrong
	MOVE	W2,W1		;[2326] word to w2
	PUSHJ	P,D.GET1	;[2326] get the next word from the rel block
	 JRST	T1003E		;[2345] block is bad
	MOVE	W3,W1		;[2326] last word for the triplet
	SUBI	P1,2		;[2326] 2 words gone
	POP	P,W1		;[2326] get back the flags
	PJRST	LS.ADD##	;[2345] store the triplet in the ls area

;[2326] this routine gets the name words and builds the name in NAMBLK for 
;[2326] testing against /INCLUDES, /EXCLUDES


X03TTL: HRRZ	T2,W1		;[2326]* count of title words to t2
	CAIL	T2,SYMSIZ	;[2345] is it longer than max symbol length?
	 PUSHJ	P,E$$STL	;[2326] Yes -  give an error
	PUSH 	P,W1		;[2326] save the flags
	CAIG	T2,1
	JRST	X03SHT		;[2326] just one word so put in w2
	TXC	W1,PT.EXT	;[2326] need additional triplets
	MOVNS	T2		;[2326] negative count
	HRLZS	T2		;[2326] put it in left half for AOBJN ptr
X03LP:	PUSHJ	P,D.GET1	;[2326] get the next name word
	 JRST LOAD		;[2326] end of block
	MOVEM	W1,NAMBLK(T2)	;[2326] store the next word
	AOBJN	T2,X03LP	;[2326] done? - no get the next word
	MOVEI	W2,NAMBLK	;[2326] address of title to w2
	POP	P,W1		;[2326] restore the flags
	HRL	W2,W1		;[2326] count to left of w2
	SETZM	W3		;[2326] zero last word of triplet
	HLLZS	W1		;[2326] don't want count in flag word
	POPJ	P,		;[2326] all done

X03SHT:	PUSHJ	P,D.GET1	;[2326] get the name word
	 JRST	T1003E		;[2345] error bad rel block
	SKIPN	W2,W1		;[2345] put it in w2
	MOVE	W2,[SIXBIT/.MAIN./] ;[2326] yes - use the default name
	SETZM	W3		;[2326] zero w3
	POP	P,W1		;[2326] restore the flags
	POPJ	P,		;[2326] return


;[2326] Now we have the name as count,,ptr in program name and stored in LS.
;[2326] lets see if we need to load this module.

X03INC:	PUSHJ	P,INCCHK##	;[2326] check /INCLUDES
	 SKIPA			;[2326] don't load this module
	JRST	X03OK		;[2326] found it in /INCLUDES so go load it
	TRZA	FL,R.LOD	;[2326] not there clear loading flag
X03POP:	TRO	FL,R.LIB	;[2326] cause module to be ignored by /EXCLUDE
	POP	P,W1		;[2326] restore w1
	JRST	T1000C		;[2326] ignore rest of the block

;[2326] check the /EXCLUDE to see if it's there

X03EXC:	PUSHJ	P,EXCCHK##	;[2326] see if in the /EXCLUDE list
	 JRST	X03POP		;[2326] yes so don't load this module
	JRST	X03OK		;[2326] not excluded so go load

X03STT:	PUSHJ	P,X03TRW	;[2326] store triplet in ls area
	JRST	X03SRT		;[2326] back for the next part

;[2326] table of bits that get set according to left half of sub-block flag 
;[2326] word. The code in the sub-block flag word is the index into the table 
;[2326] and the bits are saved in the first word of the ls triplets generated 
;[2326] by the sub-blocks.

X03BIT: JFCL				;[2326]
	TXO	W1,PT.SGN!PT.TTL!PT.EXT	;[2345] sign, primary title, extended
	MOVX	W1,S.TTL!S.CMT		;[2345] comment
	MOVX	W1,S.TTL!S.PRC!S.CMT	;[2345] Processor
	MOVX	W1,S.TTL!S.CRE		;[2345] Creation date
	MOVX	W1,S.TTL!S.DEV		;[2345] Device
	MOVX	W1,S.TTL!S.NAM		;[2345] File name
	MOVX	W1,S.TTL!S.SFD		;[2345] Sfd
	MOVX	W1,S.TTL!S.FIL		;[2345] TOPS-20 file spec
	MOVX	W1,S.TTL!S.VER		;[2345] Source version number
MAXBIT== . - X03BIT			;[2345] table size

;[2326] Table of routines to execute based on the code in left half of 
;[2326]  sub-block flag word.  Uses that code as index to table.

X03JMP:	JRST T1003E	;[2345] Bad sub-block code
	JRST T1003E	;[2345] Second name sub-block - error
	JRST X03STR	;[2345] Comment sub-block - store ascii text
	JRST X03PRC	;[2345] Compile/CPU sub-block check processor info
	JRST X03STT	;[2345] Compile date/time/version # - 3 word sub-blocks
	JRST X03STT	;[2345] Device/UFD - 3 word sub-block
	JRST X03STT	;[2345] TOPS-10 file spec/ext - 3 word sub-block
	JRST X03STR	;[2345] SFDs
	JRST X03STR	;[2345] TOPS-20 file spec
	JRST X03STT	;[2345] Source version number/date and time

;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 after all sub-blocks have been processed.  Call TTLRCL to put the segment
;descriptor triplets in the LS area.  Then go get the next block.

X03ND:	PUSHJ	P,TTLRLC##	;[2345] build segment info triplets-put in LS
	JRST	LOAD##		;[2345] get the next block

;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
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:	PUSHJ	P,RB.2##	;READ AND RELOCATE FIRST TWO WORDS
	  JRST	LOAD##		;[2262] FAILED, TRY NEXT BLOCK
	SETZ	W3,		;[2205] VALUE OF SYMBOL (ZERO IF NONE)
	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
	SKIPA	W3,W2		;[2262] KEEP THE SYMBOL VALUE
T1004A:	PUSH	P,W2		;[2303] SAVE BYTE COUNT
	LDB	T3,[POINT 6,W1,11]	;GET BYTE SIZE
	MOVEM	T3,BYTSIZ	;[2262] SAVE IT
	LDB	T1,[POINT 6,W1,5]	;[2262] GET BYTE POSITION
	MOVEM	T1,BYTPOS	;[2262] SAVE IT
	MOVEM	W1,BYTADR	;[2262] STORE IT
	MOVEI	T1,1		;[2262] GET THE REPETITION COUNT
	MOVEM	T1,REPCNT	;[2262] SET IT
	SETZM	FILCNT		;[2262] 1004 BLOCKS DON'T FILL
	POP	P,W1		;[2262] GET THE BYTE COUNT
	MOVEM	W1,BYTCNT	;[2262] SAVE IT	
	PUSHJ	P,X160SZ	;[2262] FIX UP THE BYTE POINTER

;[2262] The following calculation deliberately throws away the carry
;[2262] which may have occured by incrementing BYTADR in X160SZ. This
;[2262] is because FORTRAN uses a 777777 address in a byte pointer to
;[2262] point to the beginning of a common block.

	HLLZ	T2,LSTRRV	;[2262] GET THE SECTION NUMBER
	HLLM	T2,BYTADR	;[2205] PUT IT INTO THE ADDRESS (CLOBBER CARRY)
	ADDM	W3,BYTADR	;[2262] AND ADD THE SYMBOL
	JRST	T1160S		;[2262] JOIN THE COMMON CODE

;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)       !	-----
;			--------------------
;				...
   
;**;[2072] Replace 2 lines at T1004Z+25L. PAH 19-Jul-84
	DEFINE NEWBLK(RBSIZ,RBNUM,RELTYP,ROFF<0>)<	;;[2072]

	MOVE	P1,[POINT RBSIZ,RB,<RBSIZ*ROFF>-1]	;;[2072]
	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				;[2262] 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::
;**;[2072] Change 1 line at T.1020+1.  PAH 19-Jul-84
	NEWBLK(2,^D9,RLADD,1)			;[2072]

T.1021::
;**;[2072] Change 1 line at T.1021+1.  PAH 19-Jul-84
	NEWBLK(3,6,RLADD,1)			;[2072]

T.1022::
;**;[2072] Change 1 line at T.1022+1.  PAH 19-Jul-84
	NEWBLK(6,3,RLADD,1)			;[2072]

T.1023::
;**;[2072] Change 1 line at T.1023+1.  PAH 19-Jul-84
	NEWBLK(9,2,RLADD,1)			;[2072]
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?
	 PUSHJ	P,R.ERR##		;[2247] 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
;**;[2072] Change 1 line at RLADD+8L. PAH 19-Jul-84
	HRLM	T1,W1			;[2072] 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
	SKIPE	OVERLW			;[2031] DON'T SET UNLESS DOING OVERLAYS
	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,WRTDAT		;[2073] ADD BASE ADDRESS
	HRLI	T1,(POINT 2,0,35)	;[2073] ADD TEMPLATE BYTE POINTER
	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 1050 - PSECT NAME BLOCK

;	---------------------		---------------------
;	!  1050   !  COUNT  !		!  1050   !  COUNT  !
;	---------------------		---------------------
;	!    0    !  INDEX  !		!    0    !  INDEX  !
;	---------------------		---------------------
;	! SIXBIT PSECT NAME !		! 0 ! MBZ !  COUNT  !
;	---------------------		---------------------
;	!   (ATTRIBUTES)    !		! SIXBIT PSECT NAME !
;	---------------------		---------------------
;	!     (ORIGIN)      !		!  ADDITIONAL NAME  !
;	---------------------		---------------------
;
;						 .
;
;						 .
;
;					---------------------
;					!  ADDITIONAL NAME  !
;					---------------------
;					!   (ATTRIBUTES)    !
;					---------------------
;					!     (ORIGIN)      !
;					---------------------


;[2222] This block sets up W1-W3 and joins common code in the type 24
;[2222] block.

T.1050:	SKIPLE	MODTYP		;[2222] Twoseg seen in module?
	 PUSHJ	P,E$$MPT##	;[2222] Yes, error
	SETOM	MODTYP		;[2222] Flag psects seen
	PUSHJ	P,D.GET1	;[2222] Get the index
	 JRST	LOAD##		;[2222] Empty block?
	MOVEI	P1,(W1)		;[2222] Save it in P1
	PUSHJ	P,SYM.IN	;[2222] Get the psect name
	 JRST	[MOVEI T1,1050	;[2222] No name?
		 JRST E$$RBS##]	;[2222] Bad rel block
	PUSHJ	P,D.GET1	;[2222] Get the attributes
	 SETZ	W1,		;[2222] No attributes
	TXO	W1,AT.PS	;[2222] Remember this psect seen in this module
	MOVE	W3,W1		;[2222] Save attributes in W3
	PUSHJ	P,D.GET1	;[2222] Get the origin
	SETZ	W1,		;[2222] No origin
	JRST	T.24B##		;[2222] Join common code


;[2222] Here to read a symbol from the rel file.  Returns symbol
;[2222] in W2 if short, length,,pointer in W2 if long.  Long symbols
;[2222] are placed in SYMBLK.  Returns skip if successful, non-skip
;[2222] if rel block is too short.

SYM.IN:	PUSHJ	P,D.GET1	;[2222] Get the name (first word)
	 POPJ	P,		;[2222] No symbol!
	MOVE	W2,W1		;[2222] Get the symbol
	TLNE	W2,770000	;[2222] Long symbol?
	 JRST	CPOPJ1		;[2222] No, done
	JUMPE	W2,CPOPJ1	;[2223] Done if zero
SYMIN1:	CAIN	W2,1		;[2262] Short symbol in disguise?
	 JRST	[PUSHJ P,D.GET1	;[2223] Yes, get one word
		 POPJ P,	;[2223] No word means bad rel block
		 MOVE W2,W1	;[2223] Put it in W2
		 JRST CPOPJ1]	;[2223] Return with a short symbol
	PUSH	P,W2		;[2222] Save the count
	MOVNS	W2		;[2222] Negate it
	HRLZS	W2		;[2222] Put it in left half for AOBJN
SYMINL:	PUSHJ	P,D.GET1	;[2222] Get a symbol word name
	 JRST	[POP P,W2	;[2222] No more, clear up the stack
		 POPJ P,]	;[2222] And return
	MOVEM	W1,SYMBLK(W2)	;[2222] Store the word
	AOBJN	W2,SYMINL	;[2222] Go back if more
	POP	P,W2		;[2222] Get the count
	HRLZS	W2		;[2222] Count in left half
	HRRI	W2,SYMBLK	;[2222] Address in right half
	JRST	CPOPJ1		;[2222] Successful return
SUBTTL	BLOCK TYPE 1051 - SET CURRENT PSECT

;	---------------------
;	!  1051   !  COUNT  !
;	---------------------
;	!    0    !  INDEX  !
;	---------------------

T.1051:	PUSHJ	P,D.GET1	;[2222] Get the index
	 JRST	LOAD##		;[2222] Empty block?
	MOVEI	R,(W1)		;[2222] Psect index in R
	CAMLE	R,RC.NO		;[2222] Psect index exist?
	JRST	E$$IPX		;[2222] No, give error
	HRRZ	R,@RC.MAP	;[2222] Get internal psect number
	MOVEM	R,RC.CUR	;[2222] Set as the current psect
	 JRST	LOAD##		;[2222] Done
SUBTTL	BLOCK TYPE 1052 - PSECT END BLOCK

;	---------------------
;	!  1052   !  COUNT  !
;	---------------------
;	!    0    !  INDEX  !
;	---------------------
;	!    PSECT BREAK    !
;	---------------------
;
;		 .
;
;		 .
;
;	---------------------
;	!    0    !  INDEX  !
;	---------------------
;	!    PSECT BREAK    !
;	---------------------

T.1052:	PUSHJ	P,D.GET1	;[2222] Get the index
	 JRST	LOAD##		;[2222] No more?
	MOVEI	R,(W1)		;[2222] Psect index in R
	CAMLE	R,RC.NO		;[2222] Psect index exist?
	JRST	E$$IPX		;[2222] No, give error
	HRRZ	R,@RC.MAP	;[2222] Get internal psect number
	PUSHJ	P,D.GET1	;[2222] Give me a break	
	 JRST	[MOVEI T1,1052	;[2222] Rel block should not end here
		 JRST E$$RBS##]	;[2222] Give an error
	PUSH	P,RC.CUR	;[2222] Save the current psect
	MOVEM	R,RC.CUR	;[2222] Set as the current psect
	MOVE	P1,@RC.TB	;[2222] Get pointer to new psect
	MOVE	T1,W1		;[2222] Put the break in T1
	PUSHJ	P,R.CUR##	;[2222]	Relocate it 
	MOVE	W1,T1		;[2222] Get it back
	POP	P,RC.CUR	;[2222] Restore the current psect
	PUSHJ	P,CHKSZ0##	;[2222] Check for psect too big
	CAMLE	W1,RC.HL(P1)	;[2222] A new record for the break?
	MOVEM	W1,RC.HL(P1)	;[2222] Yes, set HL (CV fixed in T.5)
	JRST	T.1052		;[2222] Go back for another
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
	CAIL	W2,<SYMSIZ-1>	;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH?
	 PUSHJ	P,E$$STL	;[2305] YES GIVE AN ERROR
	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##>>
	LDB	T1,[POINT 7,P2,28] ;[2305] IS IT AN EXTENDED VALUE?
	CAIL	T1,<SYMSIZ-1>	;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH?
	 PUSHJ	P,E$$STL	;[2305] YES GIVE AN ERROR
	SKIPE	T1		;[2305]
	PUSHJ	P,EXVAL		;[2305] YES  SET UP COUNT,,PTR TO VALBLK
	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)
		EXVAL		;[2305] 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##		;

;[2305] Here if V is not zero - stores the value symbol in VALBLK and stores
;[2305] count,,valblk in w3

EXVAL:	PUSH 	P,W1		;[2305] save flags
	MOVEM	W3,VALBLK	;[2305] store the first word of extended value
	MOVEI	W3,VALBLK	;[2305] W3 get address of symbol name
	AOS	T1		;[2305] add 1 to count of words (count in block
				;[2305] is number of addtional words)
	HRL	W3,T1		;[2305] W3 gets count,,valblk
	SOS	T1		;[2305] sub 1 from count since one word 
				;[2305] has been stored
	MOVNS	T1		;[2305] negative count for AOBJN
	HRLZS	T1		;[2305] put it in the left half
	AOS	T1		;[2305] add one to right half for word already 
				;[2305] done
EXVAL1:	PUSHJ	P,D.GET1	;[2305] get next word of extended value symbol
	  jfcl
;****	 ;jrst	e$$isn		;[2305] should be more, something is rotten
	MOVEM	W1,VALBLK(T1)	;[2305] store the name word
	AOBJN	T1,EXVAL1	;[2305] done? no go back for next word
	POP	P,W1		;[2305] restore flags
	POPJ 	P,		;[2305] return w3/ count,,valblk
;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
	XCT	T1070S(T3)	;[2246] set the bits for type of fixup
	CAIN	T1,4		;CHAINED FIXUP?
	JRST	X70CH		;[2246] check what type of chained fixup
	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

X70CH:	MOVE	T2,W3		;
   	MOVE	W3,2(P1)
	TXNE	W1,FS.FXR	;[2246] right half chained fixup?
	JRST	SY.CHR##	;[2246] yes
	TXNE	W1,FS.FXL	;[2246] left half chained fixup?
	JRST	SY.CHL##	;[2246] yes
	TXNE	W1,FS.FXE	;[2246] thirty bit chained fixup?
	JRST	SY.CHE##	;[2246] yes
	JRST	SY.CHF##	;[2246] full word is all that's left


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	X70CHF		;[2305] Yes go handle chained request
	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
	MOVE	P1,LSTGBL	;[2255] 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
	MOVE	T1,LSTGBL	;[2255] GET THE GLOBAL POINTER
	MOVE	W3,LSTLCL	;[2255] AND THE LOCAL POINTER
	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

X70CHF:	CAIN	T3,3		;[2305] is it a right half chained request
	JRST 	INSRT##		;[2305] yes - so just put it in
	PUSH 	P,W1		;[2305] save the primary flags
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR ;[2305] 
	TXO	W1,FS.FXC	;[2305] indicate we have a chained request
	XCT	T1070S(T3)	;[2305] set bit for type chained fixup request
	JRST 	SY.RQ2		;[2305] say a prayer and off you go.
;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
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK
	XCT	T1070S(T3)	;SET FLAGS FOR FX BLOCK
	MOVE	T1,W2		;[2255] NAME SHOULD BE IN T1 IF NOT SYMBOL
	CAIE	T2,6		;SKIP IF SYMBOL FIXUP
	JRST	SY.RA##		;JUMP IF ADDITIVE FIXUP
	EXCH	W2,W3		;[2305] GET READY FOR CALL TO SY.QS
	TXO	W1,FS.FXS	;FLAG SYMBOL FIXUP
	PUSHJ	P,SY.QS##
	  JRST	T1070X
	PUSHJ	P,TRYSYM	;[2305]
	 JRST	TX70RD		;[2305]
	 JRST	TX70PD		;[2305]
	 JRST	TX70TD		;[2305]
TX70RD:	AOS	USYM		;[2305]
	JRST	SY.RQ2##	;[2305]
TX70PD:	EXCH	W2,W3		;[2305]
	MOVE	T1,LSTGBL	;[2255] GET THE GLOBAL POINTER
	MOVE	W3,LSTLCL	;[2255] AND THE LOCAL POINTER
	JRST	SY.RA##
TX70TD:	JRST	SY.RC0##	;[2305]

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
	MOVX	W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK
	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
;[2305] stores the symbol name in SYMBLK 
;[2305] stores count,,symblk in W2

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	;[2305] remove ps.exo EXTENDED SYMBOL
	ADDI	T1,1		;[2305] number of words of symbol name
	MOVEM 	W2,SYMBLK	;[2305] store the first word
	HRLZ	W2,T1		;[2305] into the left half of w2
	HRRI	W2,SYMBLK	;[2305] address of symbol to w2
	MOVEI	T1,1		;[2305] set up index to symblk
	POP	P,T2		;[2305] get the second word 
	MOVEM	T2,SYMBLK(T1)	;[2305] store it away
	AOS	T1
	HLRZ	T2,W2		;[2305] get the count to t2
	SUBI	T2,2		;[2305] minus the words already done
	MOVNS	T2		;[2305] -count 
	HRLS	T2
	HRR	T2,T1		;[2305] AOBJN pointer
	PUSH	P,W1		;[2305] save the flags
T1070M:	PUSHJ	P,D.GET1	;[2305] get the next name word
	 JRST LOAD
	MOVEM	W1,SYMBLK(T2)	;[2305] store the next word
	AOBJN	T2,T1070M
	POP	P,W1		;[2305] restore the flags
	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	LNKNEW,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!FF.NEW) ;[2212] SET POLISH FIXUP BITS
	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

;Now read in 2 half words at a time from buffer
;Check to see if a half word is one of the following:
;	1.	Psect index
;	2.	Operator code
;	3.	Store operator code
;	4.	Data operator code
;[2212] The primary purpose here is to do the relocation calculation for
;[2212] a relocatable data when one is encountered, and to change the
;[2212] halfword relocatable operator and the store operators to a
;[2212] different format which allows section numbers to be preserved.

	MOVE	P2,T11BP	;[2212] Byte pointer which will find store op
	SETZ	P3,		;[2212] Start by reading the first halfword
	PUSHJ	P,X72GN		;[2212] Get the first halfword
	 JRST	LOAD##		;[2212] Completely empty block	
	PUSH	P,RC.CUR	;[2212] Save current psect
	JRST	X72RD2		;[2212] Join the main loop

X72RDF:	PUSHJ	P,X72SGN	;[2212] Eat a fullword as two halfwords
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
X72RDH:	PUSHJ	P,X72SGN	;[2212] Eat a halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block

;[2212] Read and decode the next operator
X72RD:	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block

;[2212] Check for a psect index
X72RD2:	CAIL	T1,PL.IL	;[2212] Psect index?
	 JRST	X72PSI		;[2212] Yes

;[2212] Check for a data operator
	JUMPE	T1,X72RDH	;[2212] If absolute halfword, ignore next half
	CAIN	T1,PL.ABF	;[2212] Absolute Fullword?
	 JRST	X72RDF		;[2212] Yes, Ignore two halfwords
	CAIN	T1,PL.RLH	;[2212] Relocatable halfword?
	 JRST	X72RRH		;[2212] Yes, relocate next halfword
	CAIN	T1,PL.RLF	;[2212] Relocatable fullword?
	 JRST	X72RRF		;[2212] Yes, relocate the next fullword

;[2212] Check for an operator
	CAIL	T1,PL.OL	;[2212] Too low for operator?
	CAILE	T1,PL.OH	;[2212] Or too high?
	 CAIA			;[2212] Not an operator
	JRST	X72RD		;[2212] An operator, ignore it

;[2212] Check for a store operator or symbol operator
	MOVE	T2,T1		;[2212] Get the code
	TRZ	T2,LENGTH	;[2212] Ignore the count
	CAIL	T2,PL.SL	;[2212] Store operator?
	 JRST	X72SOP		;[2212] Yes
	CAIN	T2,PL.SYM	;[2212] Symbol operator?
	 JRST	X72RDS		;[2212] Yes, skip a bunch of halfwords
	PUSHJ	P,X72IPO	;[2212] Not a valid operator

;[2212] Here to handle a psect index
X72PSI:	MOVEI	R,-400000(T1)	;[2212] Get the psect index
	CAMLE	R,RC.NO		;[2212] In bounds?
	 PUSHJ	P,E$$IPX	;[2212] No, die
	HRRZ	R,@RC.MAP	;[2212] Get the internal psect index
	MOVEM	R,RC.CUR	;[2212] Set the current index
	JRST	X72RD		;[2212] Read more operators

;[2212] Here to relocate a fullword
X72RRF:	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	MOVE	W3,T1		;[2212] Keep this halfword
	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	HRL	T1,W3		;[2212] Get back the left half
	PUSHJ	P,R.CUR##	;[2212] Relocate it
	JRST	X72BAK		;[2212] Put back the whole word

;[2212] Here to relocate a halfword.  This requires replacing the operator,
;[2212] since part of the operator field must be used to remember the section
;[2212] number.
X72RRH:	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	PUSHJ	P,R.CUR##	;[2212] Relocate it
	TLO	T1,PL.NEW	;[2212] Set new halfword operator bits

;Here to put back a fullword in the polish string
X72BAK: JUMPE	P3,X72BA1	;[2212] Was last a right half?
	HLRM	T1,-1(W2)	;[2212] No, left half is in the previous word
	HRL	W1,T1		;[2212] Right half is in left half of this one
	JRST	X72RD		;[2212] Continue reading the polish string
X72BA1:	MOVE	W1,T1		;[2212] Just replace the entire word
	JRST	X72RD		;[2212] It will be stored soon

;[2212] Here to read a symbol
X72RDS:	LSH	T1,-^D9		;[2212] Get the length
	JUMPE	T1,X72R50	;[2212] Check for radix-50 special case
	CAILE	T1,MAXSYM/3-1	;[2212] Make sure symbol not too big
	 PUSHJ	P,E$$STL	;[2212] Can't handle it
	MOVEI	W3,1(T1)	;[2212] Count of halfwords to read
X72RS1:	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	SOJG	W3,X72RS1	;[2212] Ignore all of them
	JRST	X72RD		;[2212] Go back for next operator
X72R50:	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	MOVE	W3,T1		;[2212] Keep this half around
	PUSHJ	P,X72SGN	;[2212] Get next halfword
	 PUSHJ	P,E$$NSO##	;[2212] Should not fall off end of block
	PUSH	P,W2		;[2212] Keep the pointer safe
	MOVE	W2,T1		;[2212] get the right half
	HRL	W2,W3		;[2212] And the left half
	PUSHJ	P,R50T6##	;[2212] Convert it to sixbit
	MOVE	T1,W2		;[2212] Put it where it belongs
	POP	P,W2		;[2212] Get back the pointer
	JRST	X72BAK		;[2212] Put the word back in the block

;[2212] Here to get a polish halfword and store the previous one.  This
;[2212] routine de-blocks the full words supplied by D.GET1 into halfwords.
;[2212] P3 / 0 to read left half, 1 to read right half
;[2212] P2 / Byte pointer for store op
;[2212] W2 / Byte pointer for store
;[2212] W1 / Full word read (returned)
;[2212] T1 / Next halfword (returned)

;[2212] This routine parallels the T11SGN routine in LNKOLD.

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

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


;[2212] Here on store.
X72SOP:	MOVEM	W1,(W2)		;[2212] Make sure the last halfword is stored
	ADD	P2,FX.LB	;[2212] Relocate the store operator pointer
	TRNE	T1,S.ADR	;[2212] An address?
	 JRST	X72SAD		;[2212] Yes, go handle it

;[2212] Here to test for a symbol and to determine if it is needed
	PUSH	P,T1		;[2212] Save the store operator
	MOVE	T2,T1		;[2212] Get a copy of the store operator
	TRZ	T2,777770	;[2212] Clear all but last digit
	PUSH	P,[FS.FXF	;[2212]   754  Save bit for this fixup type
		    FS.FXE	;[2212]   755
		    FS.FXL	;[2212]   756
		    FS.FXR]-4(T2) ;[2212] 757
	LSH	T1,-^D9		;[2212] Get the length
	JUMPE	T1,X72S50	;[2212] Special if Radix 50
	CAIN	T1,1		;[2212] Short symbol?
	 JRST	X72SSM		;[2212] Yes, handle differently

;[2212] Here for long symbol.  Copy it into SYMBLK.
	CAILE	T1,MAXSYM/3-1	;[2212] Make sure symbol not too big
	 PUSHJ	P,E$$STL	;[2212] Can't handle it
	MOVE	W3,T1		;[2212] Keep the count in a better place
	PUSH	P,T1		;[2212] And save it for SY.RQS call
	MOVE	P1,[POINT 18,SYMBLK] ;[2212] Get a pointer to a static area
X72SOL:	PUSHJ	P,X72BYT	;[2212] Get the next three characters
	 PUSHJ	P,E$$ISM##	;[2212] Not complete?
	IDPB	T1,P1		;[2212] Store the characters
	SOJGE	W3,X72SOL	;[2212] Keep going until all done
	POP	P,W3		;[2212] Get the count back
	ADDI	W3,1		;[2212] Make it a true count
	TRNN	W3,1		;[2212] Is it odd?
	 JRST	X72SEV		;[2212] No, even
	SETZ	T1,		;[2212] Yes,
	IDPB	T1,P1		;[2212] Zero the extra halfword
	ADDI	W3,1		;[2212] Account for it
X72SEV:	LSH	W3,-1		;[2212] Convert to words
	HRLZ	W3,W3		;[2212] Put count in left half
	HRRI	W3,SYMBLK	;[2212] Count,,Pointer
	JRST	X72SYM		;[2212] Go see if needed

;[2212] Here for radix-50 symbols. Replace with SIXBIT, treat as short symbol.
X72S50:	PUSHJ	P,X72BYT	;[2212] Get the next halfword
	 PUSHJ	P,E$$ISM	;[2212] Not complete?
	HRL	W2,T1		;[2212] Hold onto it
	PUSHJ	P,X72BYT	;[2212] Get one more
	 PUSHJ	P,E$$ISM	;[2212] Not complete?
	HRR	W2,T1		;[2212] Get the rest of the symbol
	PUSHJ	P,R50T6##	;[2212] Convert to SIXBIT
	MOVE	W3,W2		;[2212] Get the symbol in the correct AC
	JRST	X72SYM		;[2212] Go see if needed

;[2212] Here for short symbol. Build it in W3.
X72SSM:	PUSHJ	P,X72BYT	;[2212] Get the next halfword
	 PUSHJ	P,E$$ISM##	;[2212] Not complete?
	HRL	W3,T1		;[2212] Hold onto it
	PUSHJ	P,X72BYT	;[2212] Get one more
	 PUSHJ	P,E$$ISM	;[2212] Not complete?
	HRR	W3,T1		;[2212] Get the rest of the symbol
;	JRST	X72SYM		;[2212] See if needed

;[2255] Here for a symbol.  See if it is needed, and if so replace
;[2255] the symbol name and old store operator with the new store
;[2255] operator and the section number of the symbol in the LS area,
;[2255] followed by the rest of the LS pointer for the symbol, followed
;[2255] by the GS pointer to the symbol.
X72SYM:	POP	P,W1		;[2212] Restore the bits
	PUSHJ	P,SY.QS##	;[2212] See if we want this symbol
	 JRST	[POP P,0(P)	;[2212] Non-loaded local, clean up stack
 		 PUSHJ P,T.11RT## ;[2212] Return block
		 JRST LOAD##]	;[2212] And exit
	POP	P,T1		;[2212] Restore the op code
	TRZ	T1,^-7		;[2212] Get the last digit
	ADDI	T1,PL.NSS	;[2212] Add the base for new fullword operator
	LSH	T1,^D12		;[2212] Put it in the high order bits
	HLRZ	T2,LSTLCL	;[2255] Get the local symbols section number
	ADD	T1,T2		;[2255] Put it in the opcode word
	DPB	T1,P2		;[2212] Store the new store op code
	HRRZ	T2,LSTLCL	;[2212] Get the right half of the LS pointer
	IDPB	T2,P2		;[2212] Store it
	MOVE	T2,LSTGBL	;[2255] Get the Global symbols pointer 
	IDPB	T2,P2		;[2212] Store it
;[2212] If this block is to be extended to handle FAIL block names
;[2212] code should be added here.
;[2212] It should read the symbol and store it into the block using P2
;[2212] so that it can be recognized correctly.  This may make the
;[2212] block shorter but that should not matter.
	JRST	X72GC		;[2212] Check for undefined symbols


;[2212] Set up address for memory fixup
X72SAD:	MOVE	P1,T1		;[2212] Save the store operator
	TRNN	T1,LENGTH	;[2212] Non-zero length?
	 JRST	X72SAH		;[2212] No, it's a halfword store

;[2212] Here to handle fullword (possibly relocatable)
	PUSHJ	P,X72BYT	;[2212] Get a halfword
	 PUSHJ	P,E$$NAP##	;[2212] Not complete?
	MOVE	W3,T1		;[2212] Hold on to it
	PUSHJ	P,X72BYT	;[2212] Get another halfword
	 PUSHJ	P,E$$NAP	;[2212] Not complete?
	HRL	T1,W3		;[2212] Put fullword in T1
	TRNE	P1,S.REL	;[2212] Is this relocatable?
	 PUSHJ	P,R.CUR		;[2212] Yes, relocate it
	TRZ	P1,^-7		;[2212] Get the last digit
	ADDI	P1,PL.NSF	;[2212] Add the base for new fullword operator
	LSH	P1,^D12		;[2212] Put it in the high order bits
	DPB	P1,P2		;[2212] Store the new operator
	HLRZ	T2,T1		;[2212] Get left half (section number)
	IDPB	T2,P2		;[2212] Store it
	IDPB	T1,P2		;[2212] Store right half (address)
	JRST	X72GC		;[2212] Check for undefined symbols

;[2212] Here to handle halfword (possibly relocatable)
X72SAH:	PUSHJ	P,X72BYT	;[2212] Get a halfword
	 PUSHJ	P,E$$NAP	;[2212] Not complete?
	TRNE	P1,S.REL	;[2212] Is this relocatable?
	 PUSHJ	P,R.CUR		;[2212] Yes, relocate it
	TRZ	P1,^-7		;[2212] Get the last digit
	ADDI	P1,PL.NSH	;[2212] Add the base for new fullword operator
	LSH	P1,^D12		;[2212] Put it in the high order bits
	HLRZ	T2,T1		;[2212] Get left half (section)
	ADD	T2,P1		;[2212] Add in the opcode
	DPB	T2,P2		;[2212] Store it
	IDPB	T1,P2		;[2212] Store right half (address)
	JRST	X72GC		;[2212] Check for undefined symbols


;[2212] Here to read a byte into T1. Similar to X72SGN except that
;[2212] the word is not stored and the byte pointers are not updated.
X72BYT:	JUMPN	P3,X72BT1	;[2212] Just processed RHS?
	PUSHJ	P,D.GET1	;[2212] Yes--get one
	  POPJ	P,		;[2212] No more--Give non-skip return
	HLRZ	T1,W1		;[2212] First time give LHS
	MOVEI	P3,1		;[2212] Signal RHS for next time
	JRST	CPOPJ1		;[2212] Give good return

X72BT1:	HRRZ	T1,W1		;[2212] Time for RHS
	MOVEI	P3,0		;[2212] Signal LHS for next time
	JRST	CPOPJ1		;[2212] Give good return

;[2212] Here to count and evaluate global requests.  This routine uses
;[2212] P1 and P2 as temporaries, and assumes that they are the accumulators
;[2212] after T4, since the extend instructions require 6 contiguous ACs.

X72GC:	POP	P,RC.CUR	;[2212] Restore the psect index
	MOVE	W1,T11BP	;[2212] Reset byte pointer
	ADD	W1,FX.LB	;[2212] Fix in core
	JRST	X72G1		;[2212] Bypass first time

X72G0:	IBP	W1		;[2212] Bypass next half word
X72G1:	ILDB	T1,W1		;[2212] Read half word
	CAIL	T1,PL.NSO	;[2212] Store operator (new style)
	 JRST	X72GE		;[2212] Yes
	CAIL	T1,PL.NEW	;[2212] Halfword data operator?
	 JRST	X72G0		;[2212] Yes, eat the next halfword
	CAIL	T1,PL.IL	;[2212] Psect index?
	 JRST	X72G1		;[2212] Yes, ignore it
	JUMPE	T1,X72G0	;[2212] If absolute halfword eat 1 halfword
	CAIE	T1,PL.ABF	;[2212] Fullword absolute?
	CAIN	T1,PL.RLF	;[2212] Or fullword relocatable?
	 AOJA	W1,X72G1	;[2212] Yes, ignore the next 2 halfwords
	CAIL	T1,PL.OL	;[2212] Too low for operator?
	CAILE	T1,PL.OH	;[2212] Or too high?
	 CAIA			;[2212] Not an operator
	JRST	X72G1		;[2212] An operator, ignore it

;[2212] Here if global symbol request. Find out if long or short, and
;[2212] prepare for TRYSYM.
	MOVE	T2,W1		;[2212] Save the pointer for ILDB or MOVSLJ
	SUB	W1,FX.LB	;[2212] In case the area moves
	PUSH	P,W1		;[2212] Save the pointer
	LSH	T1,-^D9		;[2212] Get the length
	PUSH	P,T1		;[2212] Save the length
	CAIG	T1,1		;[2212] Short symbol (or converted radix-50)?
	 JRST	X72GS		;[2212] Yes

;[2212] Here if long symbol. Copy it into SYMBLK and build a pointer to it
	ADDI	T1,1		;[2212] Make into correct count
	MOVE	T4,T1		;[2212] Also destination count
	TLNE	T4,1		;[2212] Is it odd?
	ADDI	T4,1		;[2212] Make it even (fullword for TRYSYM)
	HRLZ	W2,T4		;[2212] Save the destination size
	MOVE	P1,[POINT 18,SYMBLK] ;[2212] Destination
	EXTEND	T1,[MOVSLJ T1,	;[2212] Move to word-aligned static area
		 0]		;[2212] Fill with zero byte if necessary
	 JFCL			;[2212] Destination is always largest
	LSH	W2,-1		;[2212] Make the size in words
	HRRI	W2,SYMBLK	;[2212] Count,,pointer for TRYSYM
	JRST	X72TRY		;[2212] See if it's defined

;[2212] Here for short symbol
X72GS:	ILDB	T1,T2		;[2212] Get left half of symbol
	ILDB	W2,T2		;[2212] Get right half part
	HRL	W2,T1		;[2212] Full symbol in W2

X72TRY:	.JDDT	LNKNEW,X72GS,<< CAMN	W2,$SYMBOL##>>
	MOVX	W1,PT.SGN!PT.SYM ;[2212] Set the bits
	PUSHJ	P,TRYSYM##	;[2212] See if defined
	 JRST	X72ND		;[2212] No, need to define it
	 JRST	X72UN		;[2212] Undf, so just as bad
	POP	P,T1		;[2212] Get the count back
	POP	P,W1		;[2212] Restore byte pointer to start of symbol
	ADD	W1,FX.LB	;[2212] Add core offset
	MOVEI	T2,PL.ABF	;[2212] Get an absolute fullword operator
	DPB	T2,W1		;[2212] Replace the symbol operator
	MOVS	T2,2(P1)	;[2212] Get value (reversed)
	IDPB	T2,W1		;[2212] Store left half of value
	MOVSS	T2		;[2212] Swap the value back
	IDPB	T2,W1		;[2212] Store right half of value
	SOJLE	T1,X72G1	;[2212] Find out how many words left
				;[2212] (done if short symbol)
	MOVEI	T2,PL.IL	;[2212] Get a no-op (psect index is good here)
X72GZ:	IDPB	T2,W1		;[2212] Clobber extra symbol name halfword
	SOJG	T1,X72GZ	;[2212] Continue until none left
	JRST	X72G1		;[2212] Done with this symbol

X72GE:	MOVE	W3,T11BP	;[2212] Get pointer back to beginning
	ADD	W3,FX.LB	;[2212] Add base of area
	SKIPN	-1(W3)		;[2212] Any undefined globals?
	PUSHJ	P,T1072E	;[2212] No, evaluate fixup now
	JRST	LOAD##		;[2212] Else wait till all defined

;[2212] Here if global symbol not in global symbol table yet
;[2212] Treat as if additive global request
;[2212] Get extended triplet and point to fixup triplet in fixup area
;[2212] In turn this triplet points to the polish fixup
;[2212] NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;[2212] STUFF, THEY MUST BE SAVED

X72ND:	AOS	USYM		;[2212] Increment undef count
	TXO	W1,PS.REQ	;Usual flags
	PUSH	P,W1		;Save primary flags
	PUSH	P,[0]		;Zero value
	MOVX	W1,S.FXP	;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
X72GD:	POP	P,W1		;[2212] Get back the length
	POP	P,T1		;[2212] And the byte pointer in a temporary
	ADD	T1,FX.LB	;[2212] Relocate again
	SKIPN	W1		;[2212] Was this radix-50?
	MOVEI	W1,1		;[2212] Yes, set to length-1
	ADDI	W1,1		;[2212] Get the actual length
	ADJBP	W1,T1		;[2212] Pass the symbol, result back in W1
	MOVE	W3,T11BP
	ADD	W3,FX.LB	;...
	AOS	-1(W3)		;Bump count of undefined symbols
	JRST	X72G1		;Get next half word

;[2212] Here to see if fixup requests exist for this  symbol
;[2212] If so add to chain, if not create chained list in extended symbol
X72UN:	MOVE	W1,0(P1)	;Flags go in W1 now
	TXNE	W1,PS.FXP	;Already fixups defered?
	JRST	X72DF		;[2212] 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	X72GD		;[612] Return to scan rest of polish


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

X72DF:	ADDI	P1,.L		;[2212] Look for additive  global request
	SKIPG	W1,0(P1)	;Get secondary flags
	PUSHJ	P,E$$ISP##	;[2212] Primary or no flags set
	TXNN	W1,S.FXP	;Is this the one
	JRST	X72DF		;[2212] No try again
	SKIPN	W1,2(P1)	;Get pointer, better be non-zero
	PUSHJ	P,E$$ISP##	;[2212] Bad pointer
	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	X72GD		;Get next half-word
;HERE TO EVALUATE POLISH FIXUP
T1072E::SKIPN	W3,POLSTK	;[2212] Get stack pointer
	PUSHJ	P,T.11PD##	;[2212] Not setup yet
	MOVEI	T3,100		;Incase of on operator
	MOVEM	T3,SVSAT
	PUSH	W3,[MXPLOP##+100] ;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,T1072E,<<CAMN W1,$FIXUP##>>	;[632]
	ADD	W2,FX.LB	;Fix in core
X72RP:	ILDB	W1,W2		;Read a half-word
	MOVEM	W1,SAVCOD
	CAIL	W1,PL.NSO	;[2212] Store operator (new style)
	 JRST	X72ST		;[2212] Yes
	CAIL	W1,PL.NEW	;[2212] Halfword data operator?
	 JRST	X72RH		;[2212] Yes, eat the next halfword
	CAIL	W1,PL.IL	;[2212] Psect index?
	 JRST	X72RP		;[2212] Yes, ignore it
	JUMPE	W1,X72AH	;[2212] If absolute halfword eat 1 halfword
	CAIE	W1,PL.ABF	;[2212] Fullword absolute?
	CAIN	W1,PL.RLF	;[2212] Or fullword relocatable?
	 JRST	X72FO		;[2212] Yes, ignore the next 2 halfwords
	CAIL	W1,PL.OL	;[2212] Too low for operator?
	CAILE	W1,PL.OH	;[2212] Or too high?
	 JRST	X72IPO		;[2212] Not an operator, illegal
;	JRST	X72OP		;[2212] An operator, stack it

;[2212] Handle operators
X72OP:	AOBJN	W3,.+2		;[2212] Check for overflow
	PUSHJ	P,T.11PL#	;[2212] Overflow-go enlarge stack
	MOVEM	W1,(W3)		;[2212] Save operator on stack
	MOVE	T3,DESTB##-100(W1) ;Get number of operands needed
	MOVEM	T3,SVSAT	;Also save it
	JRST	X72RP		;[2212] Back for more

X72IPO:	MOVE	W1,SAVCOD	;[2212] Remember what's the problem
X72RPE: PUSHJ	P,E$$IPO##	;[2212] Invalid polish operator

;[2212] Handle operands

;[2212] Absolute halfword
X72AH:	ILDB	T2,W2		;[2212] Get the operand
	JRST	X72P0		;[2212] Handle the value

;[2212] Relocatable halfword - Looks sort of like a fullword
X72RH:	TRZA	W1,PL.NEW	;[2212] Get rid of opcode, leaving section

;[2212] Relocatable or absolute Fullword
X72FO:	ILDB	W1,W2		;[2212] Get the first halfword
	ILDB	T2,W2		;[2212] Get the second halfword
	HRL	T2,W1		;[2212] Put both together
;	JRST	X72P0		;[2212] Handle the value

X72P0:	SETZ	T1,		;[2212] Value operand
X72P1:	SOJL	T3,X72ES	;[2212] Enough operands seen
	AOBJN	W3,.+2		;[2212] Check for overflow
	PUSHJ	P,T.11PL#	;[2212] Overflow-go enlarge stack
	MOVEM	T2,(W3)		;[2212] Save operator on stack
	HRLI	T1,400000	;Put in a value marker
	AOBJN	W3,.+2		;[2212] Check for overflow
	PUSHJ	P,T.11PL#	;[2212] Overflow-go enlarge stack
	MOVEM	T1,(W3)		;[2212] Save operator on stack
	JRST	X72RP		;Get more polish

;Here when we have enough operands for the current operator

X72ES:	SKIPN	SVSAT		;[2212] Is it unary
	JRST	X72UO		;[2212] Yes, no need for 2nd operand
	POP	W3,T1		;[2212] Pop off marker
	POP	W3,T1		;And value
X72UO:	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	X72P1		;[2212] Go see what we should do now
;Here to store the final value

X72ST:	MOVE	T2,-2(W3)	;[2212] This should be the fake operator
	CAIE	T2,MXPLOP##+100	;[2212] Is it
	 PUSHJ	P,X72IPO	;[2212] No
	ILDB	T2,W2		;[572]  Get core addr or LS pointer
	HRL	T2,W1		;[2212] Get the section (zero for symbols)
	TLZ	T2,PL.NMX	;[2212] Remove the high order (opcode) bits
	MOVE	W3,-1(W3)	;Get the value after ignoring the flag
	LSH	W1,-^D12	;[2212] Get the opcode
	PUSHJ	P,@STRT72-PL.NS(W1) ;[2212] Call the correct fixup routine
	PJRST	T.11RT##	;[2212] All done, now give space back

;Store operator action table
;**;[2324] Change 2 lines at STRT72.  PAH 16-Jul-84
STRT72: T11CHF##		;[2324] 0764 0774 Fullword chained
	X72CHE  		;[2324] 0765 0775 Thirty bit chained
	T11CHL##		;[2212] 0766 0776 Left half chained
	T11CHR##		;[2212] 0767 0777 Right half chained
	X72FWS			;[2212] 1764 1774 Fullword chained
	X72FWS			;[2212] 1765 1775 Thirty bit chained
	X72FWS			;[2212] 1766 1776 Left half chained
	X72FWS			;[2212] 1767 1777 Right half chained
	T11SYF##		;[2212] xxx754 Fullword symbol
	X72SYE			;[2212] xxx755 Thirty bit symbol
	T11SYL##		;[2212] xxx756 Left half symbol
	T11SYR##		;[2212] xxx757 Right half symbol

;**;[2324] Add 7 lines at STRT72+13. PAH 14-Jul-84
;[2324] Here to clear P1 before going to the thirty-bit chained fixup
;[2324] routine -- that routine calls others which interpret a nonzero
;[2324] value in P1 as a fixup block pointer.
X72CHE::SETZ	P1,		;[2324] Clear leftover pointer so P1
				;[2324] isn't treated as a fixup pointer
	PUSHJ	P,SY.CHF##	;[2324] Do the fullword chained fixup
	POPJ	P,		;[2324] And return to the dispatcher

X72SYE:	MOVX	W1,FS.FXE	;[2212] Thirty bit fixup
	JRST	SY.ASP##	;[2212] Join symbol fixup code

X72FWS:	ILDB	W2,W2		;[2212] Get the next byte
	HRL	T2,W2		;[2212] Put it in T2
	MOVSS	T2		;[2212] Correct order
	SUBI	W1,<PL.NSF-PL.NSH> ;[2212] Fix up store opcode
	PJRST	@STRT72-PL.NS(W1) ;[2212] Go to the correct fixup routine

E$$STL::.ERR.	(MS,.EC,V%L,L%F,S%F,STL,<Symbol too long>) ;[2007]
	.ETC.	(JMP,,,,,.ETIMF##)
SUBTTL	BLOCK TYPE 1074 - FORTRAN COMMON BLOCK

;	---------------------------------
;	!     1074      !     COUNT     !
;	---------------------------------
;	!  PSECT INDEX  ! SYMBOL LENGTH !
;	---------------------------------
;	!      COMMON BLOCK LENGTH      !
;	---------------------------------
;	!    SIXBIT COMMON BLOCK NAME   !
;	---------------------------------
;	!      (MORE SIXBIT NAME)       !
;	---------------------------------

T.1074::PUSHJ	P,D.GET1	;[2310] Get the index,,length
	 JRST	LOAD##		;[2310] Empty block
	HLRZ	R,W1		;[2310] Get the psect index
	CAMLE	R,RC.NO		;[2340] In bounds?
	 PUSHJ	P,E$$IPX	;[2340] No, die
	HRRZ	R,@RC.MAP	;[2310] Convert to internal psect index
	MOVE	R,@RC.TB	;[2310] Get the RC block
	MOVE	W3,RC.CV(R)	;[2310] Get the current value
	HRRZ	W2,W1		;[2310] Get number of characters
	PUSHJ	P,D.GET1	;[2310] Get the COMMON block size
	 JRST	[MOVEI T1,1074	;[2310] No next word?
		 JRST E$$RBS##]	;[2310] Bad rel block
	PUSH	P,W1		;[2310] Save the length
	PUSHJ	P,SYMIN1	;[2310] Read the symbol
	 JRST	[MOVEI T1,1074	;[2310] Symbol fouled up?
		 JRST E$$RBS##]	;[2310] Bad rel block
	POP	P,W1		;[2310] Restore the length
	PUSHJ	P,T.COMM##	;[2310] Build the common block
	 JRST	LOAD##		;[2310] Done
	HRRZ	P1,@HT.PTR	;[2310] Set up pointer to symbol
	ADD	P1,GS.LB	;[2310] Unrelocate it
	MOVE	W3,.L+2(P1)	;[2310] Get the common length
	ADDB	W3,RC.CV(R)	;[2310] Bump relocation counter
	CAML	W3,RC.LM(R)	;[2310] Check against the limit
	 PUSHJ	P,TOOBIG##	;[2310] Too big, give a warning
	JRST	LOAD##		;[2310]
 >  ;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,ABOVH(P3)		;[2270] MUST ALLOCATE A STORAGE BLOCK
	SKIPE	PAG.TP			;[2270] TP AREA PAGING?
	 JRST	T112P			;[2270] YES
	PUSHJ	P,TP.GET##		;[2270] NO, ALLOCATE IN TP AREA
	SKIPE	PAG.TP			;[2270] DID IT JUST START PAGING?
T112P:	 PUSHJ	P,DY.GET##		;[2270] PAGING, GET SPACE IN DY AREA
	MOVEM	T2,ABSIZ(T1)		;[2270] STORE SIZE
	MOVE	W3,PRGNAM		;[2005] GET THE MODULE NAME
	MOVEM	W3,ABMOD(T1)		;[2020] SAVE IT
	MOVE	W2,T1			;[2270] ADDRESS OF THE BLOCK
	MOVEI	W3,ABABA(T1)		;[2020] SAVE A PTR
	MOVN	T2,P3			;[1405]
	HRL	W3,T2			;[1405] MAKE W3 AN AOBJN PTR
	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	T1,ABCNT(W2)		;[2266] GET THE CHARACTER COUNT
	SUBI	T1,1			;[2307] ACCOUNT FOR THE NULL
	IDIVI	T1,6			;[2307] IN WORDS
	SKIPE	T2			;[2266] ANY LEFT?
	ADDI	T1,1			;[2266] YES, NEED ONE MORE WORD
	HRLZ	W3,T1			;[2266] PUT IT IN AS THE SYMBOL LENGTH
	HRRI	W3,SYMBLK		;[2266] THE SYMBOL IN WILL BE IN SYMBLK
	SETZM	SYMBLK-1(T1)		;[2266] MAKE SURE NO JUNK IN LAST WORD
	MOVE	T4,ABCNT(W2)		;[1472] NOTE COUNT
	MOVE	T2,[POINT 7,ABNAM(W2)] 	;[1472]
	MOVE	T3,[POINT 6,SYMBLK]	;[2266] PUT IT IN SYMBLK
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 TYPE 1130  --  COERCION BLOCK

T.1130::
	PUSHJ	P,STDATA		;[1704] USE GENERAL ROUTINE
	MOVEM	W2,COERPT		;[1405]
	JRST	LOAD##			;[1701]
SUBTTL	BLOCK TYPE 1131 - PSECT REDIRECTION

;	---------------------
;	!  1131   !  COUNT  !
;	---------------------
;	!    0    !  INDEX  !
;	---------------------
;	! LOWSEG PSECT NAME !
;	---------------------
;	! HIGHSEG PSECT NAME!
;	---------------------

;Where a psect name is:

;	---------------------		---------------------
;	! SIXBIT PSECT NAME !		! 0 ! MBZ !  COUNT  !
;	---------------------		---------------------
;	!   (ATTRIBUTES)    !		! SIXBIT PSECT NAME !
;	---------------------		---------------------
;					!  ADDITIONAL NAME  !
;					---------------------
;
;						 .
;
;						 .
;
;					---------------------
;					!  ADDITIONAL NAME  !
;					---------------------


T.1131:	PUSHJ	P,X131GT		;[2223] Get the low psect
	 JRST	[MOVEI T1,1131		;[2223] No psect name is
		 JRST E$$RBS##]		;[2223] an error
	JUMPE	W2,X131HI		;[2223] No symbol, try high segment
	EXCH	W2,REDLO		;[2223] Save it, get old
	PUSHJ	P,X131RT		;[2223] Return the old symbol
X131HI:	PUSHJ	P,X131GT		;[2223] Get the high psect
	 JRST	[MOVEI T1,1131		;[2223] No psect name is
		 JRST E$$RBS##]		;[2223] an error
	JUMPE	W2,X131DF		;[2272] Done if no symbol
	EXCH	W2,REDHI		;[2223] Save it, get old
	PUSHJ	P,X131RT		;[2223] Return the old symbol
X131DF:	MOVE	T1,['.LOW. ']		;[2272] Get the default low seg psect
	SKIPN	REDLO			;[2272] Is there a low seg psect?
	MOVEM	T1,REDLO		;[2272] No, default it
	MOVE	T1,['.HIGH.']		;[2272] Get the default high seg psect
	SKIPN	REDHI			;[2272] Is there a high seg psect?
	MOVEM	T1,REDHI		;[2272] No, default it
	JRST	LOAD##			;[2223] Done

;[2223] Here to read a possibly long symbol into the DY area.
;[2223] On exit, W2 contains the symbol.
X131GT:	PUSHJ	P,D.GET1		;[2223] Get the symbol
	 POPJ	P,			;[2223] Not there
	MOVE	W2,W1			;[2223] Put it in W2
	TLNE	W2,770000		;[2223] Long symbol?
	 JRST	CPOPJ1			;[2223] No, done
	CAIN	W2,1			;[2223] Short symbol in disguise?
	 JRST	[PUSHJ P,D.GET1		;[2223] Yes, get one word
		 POPJ P,		;[2223] No word means bad rel block
		 MOVE W2,W1		;[2223] Put it in W2
		 JRST CPOPJ1]		;[2223] Return with a short symbol
	MOVE	T2,W2			;[2223] Get the length
	JUMPE	T2,CPOPJ1		;[2223] Zero, no symbol
	PUSHJ	P,DY.GET		;[2223] Allocate some space
	HRL	T1,T2			;[2223] Build length,,address
	PUSH	P,T1			;[2223] Store it
	MOVNS	W2			;[2223] Negate the count
	HRLZS	W2			;[2223] Put it in the left half
	HRR	W2,T1			;[2223] Make an AOBJN word
X131GL:	PUSHJ	P,D.GET1		;[2223] Get a word
	JRST	[POP P,W2		;[2223] No more, clear up stack
		 POPJ	P,]		;[2223] Return
	MOVEM	W1,(W2)			;[2223] Save the word
	AOBJN	W2,X131GL		;[2223] Do all words
	POP	P,W2			;[2236] Restore count,,address
	JRST	CPOPJ1			;[2223] Done, return OK

;[2223] Here to return a possibly long symbol in the DY area.
;[2223] On entry, W2 contains the symbol.
X131RT:	HLRZ	T2,W2			;[2231] Get the count
	JUMPE	T2,CPOPJ		;[2223] Done if empty
	 TRNE	T2,770000		;[2223] Long symbol?
	POPJ	P,			;[2223] No, done
	HRRZ	T1,W2			;[2223] Long symbol
	PJRST	DY.RET##		;[2223] Return the space
SUBTTL BLOCK TYPE 1160  --  SPARSE DATA

;	--------------------------------
;	|     1160     |   Long Count  |
;	--------------------------------
;	|R|F|B|P|Symlen|     Psect     |
;	--------------------------------
;	|     Symbol (Symlen words)    |
;	--------------------------------
;	|S|      Origin address        |
;	--------------------------------
;	|    Repetition Count if R=1   |
;	--------------------------------
;	|      Fill Count if F=1       |
;	--------------------------------
;	|      Fill Byte if F=1        |
;	--------------------------------
;	|       Byte Count if B=1      |
;	--------------------------------
;	|          Data Bytes          |
;	--------------------------------

T.1160:	PUSHJ	P,D.GET1	;[2262] Get the first word of the rel block
	 JRST	LOAD##		;[2262] Empty block
	MOVE	R,W1		;[2262] Save the psect number etc.
	LDB	T1,[POINTR R,X60.P] ;[2262] Get the byte position
	MOVEM	T1,BYTPOS	;[2262] Save it	
	LDB	W2,[POINTR R,X60.SL] ;[2262] Get the symbol length
	SETZ	W3,		;[2262] Zero the symbol value
	JUMPE	W2,X160NS	;[2262] Is there a symbol?
	PUSHJ	P,SYMIN1	;[2262] Read the symbol
	 JRST	[MOVEI T1,1160	;[2262] No symbol?
		 JRST E$$RBS##]	;[2262] Bad rel block
	MOVX	W1,PT.SGN!PT.SYM!PS.GLB	;[2262] Set the flags
	PUSHJ	P,TRYSYM##	;[2262] See if defined
	 JRST	E$$USD		;[2262] Not even in table
	 JRST	E$$USD		;[2262] Undefined, so still no use
	MOVE	W3,2(P1)	;[2262] Get value
IFN FTOVERLAY,<			;[2262]
	CAMGE	W3,PH+PH.ADD	;[2262] Make sure array is in this link
	 JRST	T.1SE##		;[2262] No, must be common in father link
>;[2262] IFN FTOVERLAY
X160NS:	PUSHJ	P,D.GET1	;[2262] Get the next word
	 JRST	[MOVEI T1,1160	;[2262] No next word?
		 JRST E$$RBS##]	;[2262] Bad rel block
	LDB	T1,[POINTR W1,X60.S] ;[2262] Get the byte size
	MOVEM	T1,BYTSIZ	;[2262] Save it
	LDB	T1,[ADDRES W1]	;[2262] Get the address part
	ADD	W3,T1		;[2262] Add the symbol part
	TRNN	R,-1		;[2262] Psect relocation required?
	 JRST	X160NP		;[2262] No
	PUSH	P,R		;[2262] Keep the bits around
	PUSH	P,RC.CUR	;[2327] Save the current psect
	PUSHJ	P,REL.TE	;[2262] Relocate the address (30 bit)
	POP	P,RC.CUR	;[2327] Restore the current psect
	HRRM	R,0(P)		;[2262] Keep the RC block pointer
	POP	P,R		;[2262] Get them back
X160NP:	MOVEM	W3,BYTADR	;[2262] Save the low address for the data	
	MOVEI	W1,1		;[2262] Get the default repetition count
	TXNN	R,X60.R		;[2262] Repetition count?
	 JRST	X160NR		;[2262] No
	PUSHJ	P,D.GET1	;[2262] Get the repetition count
	 JRST	[MOVEI T1,1160	;[2262] No count?
		 JRST E$$RBS##]	;[2262] Bad rel block
	JUMPE	W1,T1000C	;[2262] If zero, don't bother
X160NR:	MOVEM	W1,REPCNT	;[2262] Save the repetition count
	SETZM	FILCNT		;[2262] Assume no fill
	TXNN	R,X60.F		;[2262] Fill required?
	 JRST	X160NF		;[2262] No
	PUSHJ	P,D.GET1	;[2262] Get fill count
	 JRST	[MOVEI T1,1160	;[2262] No count?
		 JRST E$$RBS##]	;[2262] Bad rel block
	MOVEM	W1,FILCNT	;[2262] Save it	
	PUSHJ	P,D.GET1	;[2262] Get fill character
	 JRST	[MOVEI T1,1160	;[2262] No character?
		 JRST E$$RBS##]	;[2262] Bad rel block
	MOVEM	W1,FILCHR	;[2262] Save it	
X160NF:	MOVEI	W1,1		;[2262] Default byte count
	TXNN	R,X60.B		;[2262] Byte count given?
	 JRST	X160NB		;[2262] No, no byte count
	PUSHJ	P,D.GET1	;[2262] Get byte count
	 JRST	[MOVEI T1,1160	;[2262] No count?
		 JRST E$$RBS##]	;[2262] Bad rel block
X160NB:	MOVEM	W1,BYTCNT	;[2262] Save it	
	PUSHJ	P,X160SZ	;[2262] Set up for size calculations
T1160S:	SUB	W1,T1		;[2262] Minus number of bytes in first word
	IDIV	W1,BYTPWD	;[2262] Number of extra words needed
	SKIPE	W2		;[2262] Any extra bytes?
	 ADDI	W1,1		;[2262] Yes, account for them
	ADD	W1,BYTADR	;[2262] Add first address to get last
	MOVEM	W1,LSTBYT	;[2262] Remember it
	MOVE	P3,BYTADR	;[2262] Get the first byte address
	HRRZS	R		;[2262] Get only the psect number
	SETOM	TP.PP		;[2270] Don't page the TP area for this
	PUSHJ	P,T.1AD##	;[2262] Try and allocate all of it
	 JRST	[SETZM TP.PP	;[2270] Allow TP area paging
		 JRST T1000C]	;[2270] And ignore it (/ONLY switch in use)
	 PUSHJ	P,T160DF	;[2262] Move window if deferred (less than 140)
	SETZM	TP.PP		;[2270] Allow the TP area to page
IFN FTOVERLAY,<			;[2313]
	MOVN	T1,PH+PH.ADD	;[2313] Get -base of overlay
	ADDM	T1,BYTADR	;[2313] Offset the first address
	ADDM	T1,LSTBYT	;[2313] Offset the last address
>;[2313] IFN FTOVERLAY

;[2262] Memory has been allocated.  Set up for the loop to copy from the
;[2262] rel file buffer into memory.

;[2262] Set up number of bytes available in current source buffer
	MOVE	R,RC.SG(R)	;[2262] Get the high/low segment index
	MOVE	T1,DCBUF+2	;[2262] Get the number of words in the buffer
	IMUL	T1,BYTPWD	;[2262] Number of bytes in buffer
	MOVEM	T1,SRCCNT	;[2262] Remember it

;[2262] Set up number of bytes which can be stored into in current
;[2262] destination buffer

	MOVE	T4,TAB.AB(R)	;[2262] Get the top of the area
	SUB	T4,TAB.LB(R)	;[2262] Minus bottom equals size
	ADD	T4,TAB.LW(R)	;[2262] Add the value of the bottom to get top
	SUB	T4,BYTADR	;[2262] Minus start address is what's left
	IMUL	T4,BYTPWD	;[2262] Number of bytes available
	MOVE	T1,BYTPOS	;[2262] Save it	
	MOVE	T3,BYTSIZ	;[2262] Get the byte size
	IDIVI	T1,(T3)		;[2262] See how many bytes left in first word
	ADD	T1,T4		;[2262] Add bytes in first word
	MOVEM	T1,DSTCNT	;[2262] Destination count

;[2262] Build the source byte pointer.  Note that pointer is to end of
;[2262] previous word, and will be bumped by the MOVSLJ.

	MOVE	T1,BYTSIZ	;[2262] Get the byte size
	HRRZ	T2,DCBUF+1	;[2262] Get the source pointer to the buffer
	DPB	T1,[POINT 6,T2,11] ;[2262] Set up the byte size

;[2262] Build the destination byte pointer
	MOVE	P1,BYTADR	;[2262] Get the byte address
	SUB	P1,TAB.LW(R)	;[2262] Minus the window offset
	ADD	P1,TAB.LB(R)	;[2262] Relocate
	DPB	T1,[POINT 6,P1,11] ;[2262] Put byte size in the byte pointer
	MOVE	T1,BYTPOS	;[2262] Get the byte position
	DPB	T1,[POINT 6,P1,5] ;[2262] Put it in the byte pointer

	MOVE	W3,BYTCNT	;[2262] Get number of bytes to move

	DMOVE	T3,DCBUF+1	;[2262] Get location and size of buffer
	DMOVEM	T3,BUFBEG	;[2262] Remember them

;[2262] Loop to copy from the input buffers to the output windows.

X160NX:	PUSHJ	P,X160BF	;[2262] Make sure the buffer is not empty
	PUSHJ	P,X160CW	;[2262] Check the window

;[2262] Find the number of bytes which can be copied	
	MOVE	T4,W3		;[2262] Get the number of bytes desired
	CAMLE	T4,SRCCNT	;[2262] More than in the source buffer?
	 MOVE	T4,SRCCNT	;[2262] Yes, can't do more than that
	CAMLE	T4,DSTCNT	;[2262] More than can fit in window?
	 MOVE	T4,DSTCNT	;[2262] Yes, do only that much
	MOVN	T1,T4		;[2262] Get minus what will be copied
	ADDM	T1,SRCCNT	;[2262] Update the source count
	ADDM	T1,DSTCNT	;[2262] And the destination count
	MOVE	T1,T4		;[2262] Put count in both places
	SUB	W3,T4		;[2262] Remember how many have been done
	SETZB	T3,P2		;[2262] Just to be safe
	EXTEND	T1,[MOVSLJ]	;[2262] Copy the string
	  JFCL			;[2262] Should not run out
	JUMPN	W3,X160NX	;[2262] Continue until all bytes copied

;[2262] Now fix up the source buffer pointers.  Use stored original
;[2262] pointers and the source byte pointer.

	SKIPGE	DCBUF+1		;[2262] Is it new buffer pointer never ILDB'd?
	ADDI	T2,1		;[2262] Yes, Point at next word
	HRRM	T2,DCBUF+1	;[2262] And fix up the pointer
	HRRZ	T3,BUFBEG	;[2262] Get the beginning of the buffer
	ADD	T3,BUFLEN	;[2262] Plus length is end of buffer
	SUBI	T3,(T2)		;[2262] Minus how far was used
	MOVEM	T3,DCBUF+2	;[2262] Restore it into DCBUF

;[2262] Here to do fill if necessary
	SKIPN	W3,FILCNT	;[2262] Get the fill count
	 JRST	X160RP		;[2262] None, go do repeat count
	MOVX	P3,<MOVSLJ>	;[2262] Get the op code for the fill
	MOVE	P4,FILCHR	;[2262] And the fill byte

X160FL:	PUSHJ	P,X160CW	;[2262] Check the window

;[2262] Find the number of bytes which can filled this time
	MOVE	T4,W3		;[2262] Get the number of bytes desired
	CAMLE	T4,DSTCNT	;[2262] More than can fit in window?
	 MOVE	T4,DSTCNT	;[2262] Yes, do only that much
	SUB	W3,T4		;[2262] Remember how many have been done
	MOVN	T3,T4		;[2262] Get minus what will be copied
	ADDM	T3,DSTCNT	;[2262] Update the destination count
	SETZ	T1,		;[2262] No source characters
	SETZB	T3,P2		;[2262] Just to be safe
	EXTEND	T1,P3		;[2262] Fill as many as possible
	 JFCL			;[2262] Skips if filling
	JUMPN	W3,X160FL	;[2262] Do them all

;[2262] Here to handle the repeat count

X160RP: SOSG	REPCNT		;[2262] Need to copy again?
	 JRST	LOAD##		;[2262] No, done

;[2262] Here to pick a method for handling the repeat count.
;[2262] If all of the data will fit in the current window, just
;[2262] copy it  with the MOVSLJ.  If one copy of the data will
;[2262] fit in memory, and there is more than about 1/4 of the
;[2262] window (must be at least 1 page) free, copy what is
;[2262] possible with the MOVSLJ, move the window, and continue
;[2262] copying.  Otherwise, split the window into two smaller
;[2262] windows, get a copy of the data into one, and copy it
;[2262] to the other.

	MOVE	W3,FILCNT	;[2262] Get the fill count
	ADDB	W3,BYTCNT	;[2262] Include it in the byte count
	IMUL	W3,REPCNT	;[2262] Total number of bytes to move
	MOVE	T3,BYTADR	;[2262] Get the origin address
	CAMGE	T3,TAB.LW(R)	;[2262] Outside of the window?
	 JRST	X160CX		;[2262] Yes, too big for one window
	CAMG	W3,DSTCNT	;[2262] That many bytes left?
	 JRST	X160SM		;[2262] Yes, it will fit in one window
	MOVE	T1,TAB.AB(R)	;[2262] Get the upper bound
	SUBI	T1,(P1)		;[2262] Minus what is left
	CAIG	T1,.IPS		;[2262] More than a page?
	 JRST	X160CX		;[2262] No, too big for one window
	IMULX	T1,4		;[2262] 4 times what's left
	MOVE	T3,TAB.AB(R)	;[2262] Get the upper bound
	SUB	T3,TAB.LB(R)	;[2262] Minus the lower
	CAMGE	T1,T3		;[2262] More than a quarter of the window left?
	 JRST	X160CX		;[2262] No, use two windows
X160SM:	MOVE	T2,BYTADR	;[2262] Get the first copy's address
	SUB	T2,TAB.LW(R)	;[2262] Minus the window bound
	ADD	T2,TAB.LB(R)	;[2262] Relocate it
	MOVE	T3,BYTSIZ	;[2262] Get the byte size
	DPB	T3,[POINT 6,T2,11] ;[2262] Put byte size in the byte pointer
	MOVE	T3,BYTPOS	;[2262] Get the byte position
	DPB	T3,[POINT 6,T2,5] ;[2262] Put it in the byte pointer
X160SL:	MOVE	T1,W3		;[2262] Get the number of bytes left to copy
	CAML	T1,DSTCNT	;[2262] Less than what can be done?
	MOVE	T1,DSTCNT	;[2262] Yes, do that many
	SUB	W3,T1		;[2262] Update what's left to do
	MOVN	T4,T1		;[2262] Get minus how many to do
	ADDM	T4,DSTCNT	;[2262] Update count of what's left
	MOVE	T4,T1		;[2262] Both counts the same
	SETZB	T3,P2		;[2262] Just to be safe
	EXTEND	T1,[MOVSLJ]	;[2262] Copy the string
	  JFCL			;[2262] Should not run out
	JUMPE	W3,LOAD##	;[2262] Check for done
	PUSH	P,T2		;[2262] Save the source pointer
	PUSH	P,P1		;[2262] And the destination pointer
	PUSH	P,TAB.LW(R)	;[2262] And the current window bottom
	HRRZ	P3,T2		;[2262] Get the source
	SUB	P3,TAB.LB(R)	;[2262] Unrelocate it
	ADD	P3,TAB.LW(R)	;[2262] Get the true address
	TXZ	P3,.IPM		;[2262] Put on a page boundary
	MOVE	P2,P3		;[2262] Get the bottom of the window area
	ADD	P2,TAB.AB(R)	;[2262] Plus the upper area limit
	SUB	P2,TAB.LB(R)	;[2262] Minus the lower
	CAMLE	P2,LSTBYT	;[2262] Is this more than necessary?
	MOVE	P2,LSTBYT	;[2262] Yes, only get this much
	TXO	P2,.IPM		;[2262] Put on a page boundary
	PUSHJ	P,@[EXP PG.LSG##,PG.HSG##]-1(R) ;[2262] Move the window
	POP	P,T1		;[2262] Get back the old lower bound
	SUB	T1,TAB.LW(R)	;[2262] How far the window moved
	MOVNS	T1		;[2262] Make it positive
	POP	P,P1		;[2262] Get back the destination pointer
	SUB	P1,T1		;[2262] Adjust the pointer
	POP	P,T2		;[2262] Get back the source pointer
	SUB	T2,T1		;[2262] Adjust the pointer

;[2262] Note that this calculation is incorrect for the last time the window
;[2262] is moved, since the window may be shrunk.  This is not important, as
;[2262] LSTBYT guarantees the bytes which will be moved will fit in the window.

	IMUL	T1,BYTPWD	;[2262] In bytes
	ADDM	T1,DSTCNT	;[2262] Update the destination counter
	JRST	X160SL		;[2262] Go back and copy more bytes

;[2262] Here to handle the case where multiple copies will not fit
;[2262] in the window. Split the window, and use half for the source
;[2262] and half for the destination.

X160CX:	MOVE	T1,TAB.LW(R)	;[2262] Get the lower window bound
	MOVE	T2,TAB.UW(R)	;[2262] And the upper bound
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Empty the window
	MOVE	T2,TAB.AB(R)	;[2262] Get the maximum address
	SUB	T2,TAB.LB(R)	;[2262] Minus the minimum address
	ADDI	T2,1		;[2262] Get actual window size
	CAIGE	T2,2*.IPS	;[2262] At least two pages in area?
	 JRST	E$$MEF		;[2262] No, not enough space for this
	LSH	T2,-1		;[2262] Get size of half window
	TRO	T2,.IPM		;[2262] Put at end of page
	MOVE	T1,TAB.LB(R)	;[2262] Get the lower bound
	ADD	T2,TAB.LB(R)	;[2262] End of lower window half
	DMOVEM	T1,DST.LB	;[2262] Save as the destination bounds
	MOVEI	T3,1(T2)	;[2262] Source LB is destination UB+1
	MOVE	T4,TAB.AB(R)	;[2262] Get upper bound	
	DMOVEM	T3,SRC.LB	;[2262] Save as the source bounds
	MOVEM	T2,TAB.AB(R)	;[2262] Set up destination window

	HRRZ	T1,P1		;[2262] Get the destination address
	SUB	T1,TAB.LB(R)	;[2262] Relocate 
	ADD	T1,TAB.LW(R)	;[2262] Make into an address
	PUSH	P,T1		;[2262] Keep the address
	TXZ	T1,.IPM		;[2262] Set on block boundary
	MOVEM	T1,TAB.LW(R)	;[2262] New lower bound
	MOVE	T2,T1		;[2262] Get the lower bound
	ADD	T2,DST.AB	;[2262] Add the destination upper bound
	SUB	T2,DST.LB	;[2262] Minus the lower is high address
	MOVEM	T2,TAB.UW(R)	;[2262] Save it
	DMOVEM	T1,DST.LW	;[2262] Save the window addresses
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
	POP	P,T1		;[2262] Get back the destination address
	SUB	T1,DST.LW	;[2262] Subtract the lower window bound
	ADD	T1,DST.LB	;[2262] Unrelocate it
	HRR	P1,T1		;[2262] Put it back in the byte pointer
	MOVE	W1,P1		;[2262] Get the destination byte pointer
	PUSHJ	P,X160CB	;[2262] Count the remaining bytes in the window
	MOVEM	T1,DSTCNT	;[2262] Remember it

	DMOVE	T1,SRC.LB	;[2262] Now switch to the source window
	MOVEM	T1,TAB.LB(R)	;[2262] Store the source lower bound
	MOVEM	T2,TAB.AB(R)	;[2262] And upper
	MOVE	T1,BYTADR	;[2262] Get the source address
	TXZ	T1,.IPM		;[2262] Set on a page boundary
	MOVEM	T1,TAB.LW(R)	;[2262] Save the lower window
	ADD	T2,T1		;[2262] Lower window plus upper bound
	SUB	T2,SRC.LB	;[2262] Minus lower bound is upper window
	MOVEM	T2,TAB.UW(R)	;[2262] Save it
	DMOVEM	T1,SRC.LW	;[2262] Save it
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
	MOVE	W1,BYTADR	;[2262] Get the source address
	SUB	W1,SRC.LW	;[2262] Subtract the lower window bound
	ADD	W1,SRC.LB	;[2262] Unrelocate it
	MOVE	T1,BYTSIZ	;[2262] Get the byte size
	DPB	T1,[POINT 6,W1,11] ;[2262] Put it in the byte pointer
	MOVE	T1,BYTPOS	;[2262] Get the source byte position
	DPB	T1,[POINT 6,W1,5] ;[2262] Put it in the byte pointer
	PUSHJ	P,X160CB	;[2262] Count the remaining bytes in the window
	MOVEM	T1,SRCCNT	;[2262] Remember it
	MOVE	T2,W1		;[2262] Get the source address in memory

X160MB:	PUSHJ	P,X160SC	;[2262] Check the source window
	PUSHJ	P,X160DS	;[2262] And the destination window

;[2262] Find the number of bytes which can be copied	
	MOVE	T4,W3		;[2262] Get the number of bytes desired
	CAMLE	T4,SRCCNT	;[2262] More than in the source buffer?
	 MOVE	T4,SRCCNT	;[2262] Yes, can't do more than that
	CAMLE	T4,DSTCNT	;[2262] More than can fit in window?
	 MOVE	T4,DSTCNT	;[2262] Yes, do only that much
	MOVN	T1,T4		;[2262] Get minus what will be copied
	ADDM	T1,SRCCNT	;[2262] Update the source count
	ADDM	T1,DSTCNT	;[2262] And the destination count
	MOVE	T1,T4		;[2262] Put count in both places
	SUB	W3,T4		;[2262] Remember how many have been done
	SETZB	T3,P2		;[2262] Just to be safe
	EXTEND	T1,[MOVSLJ]	;[2262] Copy the string
	  JFCL			;[2262] Should not run out
	JUMPN	W3,X160MB	;[2262] Continue until all bytes copied

;[2262] Now unscrew the windows and return.  Remove the source window,
;[2262] and leave the destination window only.
IFN TOPS20,<			;[2262]
	DMOVE	T1,SRC.LB	;[2262] Get the source bounds
	MOVEM	T1,TAB.LB(R)	;[2262] Set the lower bound
	MOVEM	T2,TAB.AB(R)	;[2262] And the upper
	DMOVE	T1,SRC.LW	;[2262] Get the window limits
	MOVEM	T1,TAB.LW(R)	;[2262] Set the lower window
	MOVEM	T2,TAB.UW(R)	;[2262] And the upper
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Write the window
> ;[2262] IFN TOPS20
IFE TOPS20,<
	MOVE	T1,SRC.LB	;[2262] Get the lower bound	
	HRL	T1,SRC.LB	;[2262] In both halves
	SETZM	(T1)		;[2262] Zero the first word
	ADDI	T1,1		;[2262] From,,to for zero
	MOVE	T2,SRC.AB	;[2262] How far to go
	BLT	T1,(T2)		;[2262] Zero the memory
>
	DMOVE	T1,DST.LB	;[2262] Get the source bounds
	MOVEM	T1,TAB.LB(R)	;[2262] Set the lower bound
	MOVEM	T2,TAB.AB(R)	;[2262] And the upper
	DMOVE	T1,DST.LW	;[2262] Get the window limits
	MOVEM	T1,TAB.LW(R)	;[2262] Set the lower window
	MOVEM	T2,TAB.UW(R)	;[2262] And the upper
	JRST	LOAD##		;[2262] Done	

;[2262] Here if deferred.  What this really means is that it goes
;[2262] below address 140. Since this block cannot be deferred, move
;[2262] the window to page zero.  Note that this must be in the low seg
;[2262] because the high segment cannot start below 140.
;[2343] Uses R, T1, T2

T160DF:	MOVE	R,SG.TB+1	;[2343] In low segment
	MOVE	T1,LW.LC	;[2262] Get the low bound
	MOVE	T2,UW.LC	;[2262] And the high bound
	PUSHJ	P,LC.OUT##	;[2262] Write the window
	MOVE	T1,LC.LB	;[2262] Get the base of the area
	IORI	T1,.IPM		;[2262] Want only one block
	MOVEM	T1,LC.AB	;[2262] Allocate it
	SETZB	T1,LW.LC	;[2343] Starting at address zero
	MOVEI	T2,.IPM		;[2262] Want one page
	MOVEM	T2,UW.LC	;[2343] Set the window correctly
	PJRST	LC.IN##		;[2262] Go get it

;[2262] Here to compute the byte size, and diddle the byte pointer
;[2262] if necessary.
;[2343] On input W1 contains the byte count
;[2343] On return W1 contains the total number of bytes
;[2343] Uses T1,T2,T3

X160SZ:	MOVE	T3,BYTSIZ	;[2262] Get the byte size
	MOVEI	T1,^D36		;[2262] Bits per wordt
	IDIVI	T1,(T3)		;[2262] Bytes per word
	MOVEM	T1,BYTPWD	;[2262] Save it
	ADD	W1,FILCNT	;[2262] Byte count plus fill bytes
	IMUL	W1,REPCNT	;[2262] Times the repetition count
	MOVE	T1,BYTPOS	;[2262] Get the byte position
	MOVE	T3,BYTSIZ	;[2262] Get the byte size
	IDIVI	T1,(T3)		;[2262] See how many bytes left in first word
	JUMPN	T1,CPOPJ	;[2262] Done if something in first word
	MOVEI	T1,^D36		;[2262] Need to point to beginning
	MOVEM	T1,BYTPOS	;[2262] of word
	AOS	BYTADR		;[2262] Next word
	MOVE	T1,BYTPWD	;[2262] Number of bytes in first word
	POPJ	P,		;[2262] Continue calculation


;[2262] Here to check that there is something in the rel
;[2262] file buffer.  If it is empty, read some more.
;[2262] Also updates the source pointer in T2.

;[2262] Uses T1,T2,T3,T4

X160BF:	SKIPLE	SRCCNT		;[2262] Rel buffer empty?
	POPJ	P,		;[2262] No, return
	SKIPN	DCBUF		;[2262] If zero, reading from core
	 JRST	X160B1		;[2262] Read buffer from FX area
	PUSHJ	P,D.CNT##	;[2262] Get the next buffer from disk
	 JRST	X160B2		;[2262] Not expected to skip
IFN TOPS20,<			;[2301]
	SKIPLE	RFLEN		;[2301] But it did, is it EOF?
>;[2301] IFN TOPS20
IFE TOPS20,<
	STATO	DC,IO.EOF	;[2301] EOF?
>;[2301] IFE TOPS20
	 JRST	D.ERR##		;[2262] It's an error
	MOVEI	T1,1160		;[2301] EOF, get the block type
	PUSHJ	P,E$$RBS##	;[2301] Give an error
X160B1:	PUSHJ	P,FXREAD##	;[2262] Read buffer from FX area
X160B2:	TLZ	T2,770000	;[2262] Clear the byte pointer
	TLO	T2,440000	;[2262] And set for beginning of word
	HRR	T2,DCBUF+1	;[2262] At the beginning of the buffer
	MOVE	T1,DCBUF+2	;[2262] Number of words in buffer
	IMUL	T1,BYTPWD	;[2262] Number of bytes in buffer
	MOVEM	T1,SRCCNT	;[2262] Remember what's available
	DMOVE	T3,DCBUF+1	;[2262] Get location and size of buffer
	DMOVEM	T3,BUFBEG	;[2262] Remember them
	POPJ	P,		;[2262] Return

;[2262] Here to check that the start of the destination transfer is within
;[2262] the window, and to move the window if it is not.
;[2262] Also updates the destination pointer in P1.

;[2262]	Uses T1,T3

X160CW:	SKIPLE	DSTCNT		;[2262] Any more space in the window?
	 POPJ	P,		;[2262] Yes
	PUSHJ	P,X160PU	;[2262] Push up the window
	MOVEM	T1,DSTCNT	;[2262] Save destination count
	POPJ	P,


;[2262] Here to check that the start of the source transfer is within
;[2262] the window when using half-windows, and to move the window
;[2262] if it is not.  Also updates the source pointer in T2.

;[2262]	Uses T1,T3,T4

X160SC: SKIPLE	SRCCNT		;[2262] Any more space in the window?
	 POPJ	P,		;[2262] Yes
	DMOVE	T3,SRC.LB	;[2262] Get the source bounds
	MOVEM	T3,TAB.LB(R)	;[2262] Set the lower bound
	MOVEM	T4,TAB.AB(R)	;[2262] And the upper
	DMOVE	T3,SRC.LW	;[2262] Get the window limits
	MOVEM	T3,TAB.LW(R)	;[2262] Set the lower window
	MOVEM	T4,TAB.UW(R)	;[2262] And the upper
	EXCH	P1,T2		;[2262] Swap pointers (X160P1 updates P1)
	PUSHJ	P,X160P1	;[2262] Get new window	
	MOVEM	T1,SRCCNT	;[2262] Update source count
	EXCH	P1,T2		;[2262] Swap back pointers
	MOVE	T3,TAB.LB(R)	;[2262] Get the lower bound
	MOVE	T4,TAB.AB(R)	;[2262] And the upper
	DMOVEM	T3,SRC.LB	;[2262] Save the new source bounds
	MOVE	T3,TAB.LW(R)	;[2262] Get the lower window
	MOVE	T4,TAB.UW(R)	;[2262] And the upper
	DMOVEM	T3,SRC.LW	;[2262] Save the window limits
	POPJ	P,		;[2262] Done		

;[2262] Here to check that the start of the source transfer is within
;[2262] the window when using half-windows, and to move the window
;[2262] if it is not.  Also updates the source pointer in T2.

;[2262]	Uses T1,T3,T4

X160DS: SKIPLE	DSTCNT		;[2262] Any more space in the window?
	 POPJ	P,		;[2262] Yes
	DMOVE	T3,DST.LB	;[2262] Get the destination bounds
	MOVEM	T3,TAB.LB(R)	;[2262] Set the lower bound
	MOVEM	T4,TAB.AB(R)	;[2262] And the upper
	DMOVE	T3,DST.LW	;[2262] Get the window limits
	MOVEM	T3,TAB.LW(R)	;[2262] Set the lower window
	MOVEM	T4,TAB.UW(R)	;[2262] And the upper
	PUSHJ	P,X160PU	;[2262] Get new window	
	MOVEM	T1,DSTCNT	;[2262] Update source count
	MOVE	T3,TAB.LB(R)	;[2262] Get the lower bound
	MOVE	T4,TAB.AB(R)	;[2262] And the upper
	DMOVEM	T3,DST.LB	;[2262] Save the destination bounds
	MOVE	T3,TAB.LW(R)	;[2262] Set the lower window
	MOVE	T4,TAB.UW(R)	;[2262] And the upper
	DMOVEM	T3,DST.LW	;[2262] Get the window limits
	POPJ	P,		;[2262] Done		

;[2262] Routine to actually move the window up.
;[2262] Returns updated destination count in T1
;[2262]	Uses T1,T3

X160P1:	PUSH	P,T2		;[2262] Save the destination byte pointer
	JRST	X160P2		;[2262] And don't write the window

X160PU:	PUSH	P,T2		;[2262] Save the source byte pointer
	MOVE	T1,TAB.LW(R)	;[2262] Get the lower bound
	MOVE	T2,TAB.UW(R)	;[2262] And the upper bound
	PUSHJ	P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Write the window
X160P2:	MOVE	T1,TAB.UW(R)	;[2262] Get current upper window
	ADDI	T1,1		;[2262] Plus one is new lower window
	MOVE	T2,T1		;[2262] Get the low address
	ADD	T2,TAB.AB(R)	;[2262] Plus the upper area limit
	SUB	T2,TAB.LB(R)	;[2262] Minus the lower
	CAMLE	T2,LSTBYT	;[2262] Is this more than necessary?
	MOVE	T2,LSTBYT	;[2262] Yes, only get this much
	TXO	T2,.IPM		;[2262] Put on a block boundary
	MOVEM	T1,TAB.LW(R)	;[2262] Set the new lower bound
	MOVEM	T2,TAB.UW(R)	;[2262] And the new upper bound
	PUSHJ	P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
	MOVE	T1,TAB.UW(R)	;[2262] Get the upper bound
	SUB	T1,TAB.LW(R)	;[2262] Minus the lower gives area size
	MOVE	T2,T1		;[2262] Hold onto the size
	ADD	T2,TAB.LB(R)	;[2262] Plus the lower bound gives actual bound
	MOVEM	T2,TAB.AB(R)	;[2262] Store it
	TLZ	P1,770000	;[2262] Clear the position bits
	TLO	P1,440000	;[2262] Point to beginning of word
	HRR	P1,TAB.LB(R)	;[2262] Address is beginning of window
	ADDI	T1,1		;[2262] Number of words in window
	IMUL	T1,BYTPWD	;[2262] How many bytes in window
	POP	P,T2		;[2262] Get back the source byte pointer
	POPJ	P,		;[2262]	


;[2262] Here to compute the number of bytes left in the current window.
;[2262] Assumes the area is paging.
;[2262] Accepts a byte pointer in W1
;[2262] Returns a byte count in T1
;[2262] Uses T1-T4

X160CB:	MOVE	T4,TAB.AB(R)	;[2262] Get the upper bound
	SUBI	T4,(W1)		;[2262] Minus start address is what's left
	IMUL	T4,BYTPWD	;[2262] Number of bytes available
	LDB	T1,[POINT 6,W1,5] ;[2262] Get the byte position
	MOVE	T3,BYTSIZ	;[2262] Get the byte size
	IDIVI	T1,(T3)		;[2262] See how many bytes left in first word
	ADD	T1,T4		;[2262] Add bytes in first word
	POPJ	P,		;[2262] Return

E$$USD::.ERR.	(MS,.EC,V%L,L%W,S%W,USD,<Undefined symbol >) ;[2262]
	.ETC.	(SBX,.EC!.EP,,,,W2)		;[2262]
	.ETC.	(STR,.EC,,,,,< in sparse data (type 1160) block>) ;[2262]
	.ETC.	(JMP,,,,,.ETIMF##) ;[2262] Type the filename
	JRST	T1000C		;[2262] Ignore this block
	
.ZZ==.TEMP			;[2262] Allocate .TEMP space
U	(BYTADR)		;[2262] First address for data store
U	(BYTSIZ)		;[2262] Byte size
U	(BYTCNT)		;[2262] Byte count
U	(BYTPOS)		;[2262] Byte position
U	(BYTPWD)		;[2262] Bytes per word
U	(SRCCNT)		;[2262] Number of source bytes in buffer
U	(DSTCNT)		;[2262] Number of destination bytes in window
U	(LSTBYT)		;[2262] Last byte address
U	(FILCHR)		;[2262] Fill Character
U	(FILCNT)		;[2262] Fill count
U	(REPCNT)		;[2262] Repetition count

;[2262] The next two words must be contiguous
U	(BUFBEG)		;[2262] Beginning of buffer area copied
U	(BUFLEN)		;[2262] Amount in buffer at beginning of copy

;[2262] The following four words must be contiguous
U	(SRC.LB)		;[2262] TAB.LB(R) FOR SOURCE
U	(SRC.AB)		;[2262] TAB.AB(R) FOR SOURCE
U	(SRC.LW)		;[2262] TAB.LW(R) FOR SOURCE
U	(SRC.UW)		;[2262] TAB.UW(R) FOR SOURCE

;[2262] The following four words must be contiguous
U	(DST.LB)		;[2262] TAB.LB(R) FOR DESTINATION
U	(DST.AB)		;[2262] TAB.AB(R) FOR DESTINATION
U	(DST.LW)		;[2262] TAB.LW(R) FOR DESTINATION
U	(DST.UW)		;[2262] TAB.UW(R) FOR DESTINATION

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