Google
 

Trailing-Edge - PDP-10 Archives - bb-d868a-bm - 3-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-10
SUBTTL	D.M.NIXON/DMN/JLd/TXR/JNG	27-Feb-78

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

ENTRY	LNKNEW
SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
EXTERN	LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST



CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==765		;DEC EDIT VERSION




;LOCAL ACC DEFINITIONS
INTERN	R,RB,WC

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

SEGMENT
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)
SUBTTL BLOCK DISPATCH TABLES

NDSPTB:	LITYPE	(1000,1060)

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	T.ERR##		;NO, NOT YET AVAILABLE
	TRNE	FL,R.LIB	;IN LIBRARY SEARCH MODE?
	JRST	T.SRCH		;YES, IGNORE IF NOT ENTRY BLOCK TYPE
	HRREI	T2,-<1000+NDISPL>(T1)	;OFFSET TYPE
	JUMPGE	T2,.+2			;IF NEGATIVE, USE RHS
	SKIPA	T2,NDSPTB+NDISPL(T2)	;USE RIGHT HALF
	HLRZ	T2,NDSPTB(T2)	;USE LEFT HALF
	JRST	(T2)		;DISPATCH



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

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

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

T.1000:	HRRZ	T1,W1		;GET WORD COUNT
	JUMPE	T1,LOAD##	;JUST IGNORE
T1000A:	CAML	T1,DCBUF+2	;ENOUGH WORDS IN BLOCK?
	SOJA	T1,T1000B	;NO, BUT ACCOUNT FOR INITIAL ILDB
	ADDM	T1,DCBUF+1	;ADVANCE BYTE POINTER
	MOVN	T1,T1		;NEGATE
	ADDM	T1,DCBUF+2	;COUNT DOWN WORD COUNT
	JRST	LOAD##		;GET NEXT BLOCK

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

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

IFE .NWBLK,<				;
T.1001==T.ERR##				;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=T.ERR##				;ERROR UNLESS FIXED
> ;END IFE .NWBLK

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

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

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



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

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

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

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


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


;HERE ON SOME TYPE OF ERROR OR INVALID FORMAT IN THE 1003 BLOCK TYPE
T1003E:	MOVEI	T1,1003		;SHOULD NEVER GET HERE
	JRST	T.ERR##		;SO WARN THE USER


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


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



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


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

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

	XALL
DEFINE	SECTTL,<

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

>


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


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

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


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

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



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

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

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


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


;HERE ON THE PROCESSOR NAME TRIPLET(S).
;STORE THE CPU BITS, & CALL COMPILER SPECIFIC ROUTINES.
STRPRC:	TXNE	P2,S.PRC	;IS THIS THE FIRST SUCH TRIPLET?
	POPJ	P,		;NO, JUST STORE EXTENDED C. NAME
	MOVEM	W3,CTYPE	;YES, STORE XWD C.TYPE,CPU BITS
	HLRZ	T1,W3		;RETRIEVE COMPILER TYPE INDEX
	CAILE	T1,CT.LEN	;EVER HEARD OF IT?
	JRST	[SETZ	T1,		;NO, MAKE IT UNKNOWN
		HRRZS	W1,CTYPE	; ..
		JRST	.+1]		;CONTINUE
	HRRZ	T2,W3		;GET CPU TYPE INDEX
	CAILE	T2,CP.LEN	;KNOWN TYPE?
	JRST	[SETZ	T2,		;NO, MAKE UNKNOWN
		HLLZS	W3,CTYPE	; ..
		JRST	.+1]		;CONTINUE
	MOVE	T3,PROCSN	;GET BIT MAP OF COMPILERS SEEN SO FAR
	MOVE	T4,CPUSN	;AND CPUS SEEN (NEITHER COUNTS THIS ONE)
	PUSH	P,[0]		;ALGNAM WANTS -1(P) SET UP
	XCT	CT.NAM##(T1)	;CALL C. SPECIFIC ROUTINE OR JFCL
	POP	P,0(P)		;CLEAR 0 PUSHED ABOVE
	HLRZ	T1,W3		;RETRIEVE COMPILER INDEX
	MOVE	T1,CT.BIT##(T1)	;GET BIT CORRESPONDING TO THIS ONE
	IORM	T1,PROCSN	;INCLUDE IN MASK OF ALL SEEN SO FAR
	IORM	T1,LIBPRC	;ALSO IN SPECIAL MASK FOR LIB SEARCHING
	MOVE	T1,CP.BIT##(W3)	;GET BIT CORRESPONDING TO CPU TYPE
	IORM	T1,CPUSN	;UPDATE MASK OF ALL SEEN SO FAR
	POPJ	P,
;HERE WHEN CRE HAS BEEN PASSED. FAKE IT FROM THE REL FILE IF NOT THERE
FAKCRE:	TXNE	P2,S.CRE	;DID WE SEE A REAL S.CRE TRIPLET?
	  POPJ	P,		;YES, NO NEED TO FAKE IT
	LDB	T2,[POINT 12,FCRE,35]	;LOW 12 BITS OF DATE
	LDB	T1,[POINT  3,FEXT,20]	;HIGH 3 BITS
	DPB	T1,[POINT  3,  T2,23]	;MERGE DATE INTO T2
	LDB	T1,[POINT 11,FCRE,23]	;GET TIME (MINS) IN T1
	IMULI	T1,^D60*^D1000	;SCAN WANTS TIME IN MILLISECONDS
	PUSHJ	P,.CNVDT##	;CONVERT TO UNIVERSAL FORMAT
	SPUSH	<W1,W2,W3>	;SAVE NEXT TRIPLET SO WE CAN FAKE ONE
	MOVX	W1,S.TTL!S.CRE	;FLAGS FOR CREATION TIME INFO TRIPLET
	MOVE	W2,T1		;CREATION TIME (UNIVERSAL FORMAT)
	SETZ	W3,		;COMPILER VERSION IS UNKNOWN
	PUSHJ	P,LS.ADD##	;STORE WHERE MAP CAN FIND IT
	SPOP	<W3,W2,W1>	;RESTORE NEXT TRIPLET
	POPJ	P,
SUBTTL	BLOCK TYPES 1042 AND 1043 - PROGRAM AND LIBRARY REQUESTS

;	-----------------
;	! 1042  ! COUNT !
;	-----------------
;	!   DEVICE      !
;	-----------------
;	!  FILE NAME    !
;	-----------------
;	! EXT   !DIR CNT!
;	-----------------
;	! PROJ  ! PROG  !
;	-----------------
;	!     SFD       !
;	-----------------
;
;		.
;
;		.

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

T1042E:	.ERR.	(MS,.EC,V%L,L%W,S%W,IPL,<Illegal request block in module >)
TYPFIL:	.ETC.	(LSP,.EP!.EC,,,,NAMPTR)
	.ETC.	(STR,.EC,,,,,< from >)
	.ETC.	(FSP,,,,,DC)
	JRST	LOAD##		;NOT ALWAYS A FATAL ERROR
> ;END IFN .NWBLK ON PAGE 4
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,NO.COR##	;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
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 !
;	-----------------
;
;		.
;
;		.


IFE .NWBLK,<			;THIS PAGE INSTALLED IN EDIT 454
T.1060==T.1000			;
> ;END IFE .NWBLK

IFN .NWBLK,<			;
T.1060:	JRST	T.ERR##		;SHOULD PUT INFO IN LS FOR MAP
> ;END 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	TOSHRT		;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	RELERR		;RELOCATED TO SEGMENT NOT SET UP
;********* ADD MORE CODE HERE ********************************

RELERR:	.ERR.	(MS,.EC,V%L,L%F,S%F,IRC,<Illegal relocation counter in module >)
	.ETC.	(JMP,,,,,TYPFIL)

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

TOSHRT:	.ERR.	(MS,.EC,V%L,L%F,S%W,PEF,<Premature end of file in >)
	.ETC.	(FSP,,,,,DC)
	POPJ	P,		;TRY TO CONTINUE
SUBTTL	DATA STORAGE

NEWLIT:
END