Google
 

Trailing-Edge - PDP-10 Archives - ap-c796e-sb - lnkf40.mac
There are 3 other files named lnkf40.mac in the archive. Click here to see a list.
TITLE LNKF40 - LOAD OLD STYLE FORTRAN COMPILER OUTPUT
SUBTTL	D.M.NIXON/DMN/JLd/JNG	20-Jun-76


;***COPYRIGHT 1973, 1974, 1975, 1976  DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***

ENTRY	LNKF40
INTERN	T.400,T.401
EXTERN	LNKCOR,LNKLOG
SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM


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


SEGMENT

LNKF40:			;ENTRY POINT TO FORCE LOADING





;LOCAL AC DEFINITION
R==R1		;SAME AS LNKLOD
XC==R2		;HOLDS OFFSET (LC.LB OR HC.LB) FOR  CODE REFS
	SALL
DEFINE	LOADRC	<MOVE	R,SAVERC>

.FBS==^D128
.FBM==.FBS-1
SUBTTL	REVISION HISTORY

;START OF VERSION 1A
;40	CALL GARBAGE COLLECTOR FOR DY AREA AT END
;44	REMOVE ALL REFERENCES TO XF (INDEX CONTAINING DY.LB)
;46	ADD KLUDGE FEATURE
;76	FIX BUG IF DWFS. PAGES FOR FIRST TIME
;102	ADD DEFENSIVE TESTS FOR BAD REL FILE
;107	REPLACE KLUDGE BY MIXFOR

;START OF VERSION 1B
;126	CHANGE CALLING SEQUENCE ON ADDRESS CHECKING AND STORING INTO CORE
;127	(12311) BUGS IN FORCED LOAD TO HIGH SEGMENT

;START OF VERSION 2
;142	(12520) FIX BUG IF PROGRAM IS LARGER THAN 36*128 WORDS
;143	ADD TEST FOR /INC MODE
;176	MAKE START BLOCK (7) BE TWO WORDS LONG
;214	(12939) FIX CORE EXPANSION BUG IF IT OCCURS IN MIDDLE OF DATA STATEMENT

;START OF VERSION 2B
;260	Fix to allow loading of large programs in small core.
;274	Fix to allow loading COMMON in the HGH segment from
;	DATA statement in a module placed in the LOW segment.
;361	Fix ILL MEM REF caused by edit 274
;375	Take out some code now duplicated in T.COMM.
;417	Remove the LNKF40 portion of edit 274.
;432	Fix a typo in edit 417.
;435	Update HC.S0 before leaving LNKF40 so don't lose end of program.

;START OF VERSION 2C
;456	Fix the problems addressed by edits 274 and 361, i.e. allow
;	a DATA statement out of segment A to initialize COMMON in
;	segment B.
;474	Print the module name in F40 error messages.
;530	Get the triplet flag definitions right
;533	Correct calculation of bits left in table in BITINI.
;557	Clean up the listing for release.

;START OF VERSION 3A
;	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	INITIALIZE TABLES

;MADE LABELS, PROGRAMMER LABELS, DATA STATEMENTS AND MANTIS CODE
;ARE STORED IN LINKED 128 WORD LISTS
;LINKED BY FIRST WORD OF BLOCK
;DATA STATEMENTS ARE STORED IN LINKED LISTS ONE PER BLOCK

T.401:	TLNE	FL,L.SPD	;ALOWED TO LOAD MANTIS CODE?
	TROA	FL,R.SPD	;YES, LOAD MANTIS CODE
T.400:	TRZ	FL,R.SPD	;NO MANTIS STUFF HERE
	TRNE	FL,R.LIB!R.INC	;ARE WE IN LIBRARY SEARCH MODE OR /INC MODE?
	JRST	REJECT		;YES, DON'T LOAD ANY OF THIS
	ZAPTMP			;ZAP THE TEMP TABLE SPACE
	PUSHJ	P,TABINI	;GET SPACE FOR TABLE
	MOVEM	T1,MLTP		;INITIAL POINTER
	PUSHJ	P,TABINI	;SAME FOR PROGRAMMER LABELS
	MOVEM	T1,PLTP		;STORE INITIAL POINTER
	PUSHJ	P,TABINI	;AND FOR BIT TABLE
	HRLI	T1,(POINT 1,)	;FORM BYTE POINTER
	MOVEM	T1,BITP0	;INITIAL
	ADDI	T1,1
	MOVEM	T1,BITP		;CURRENT
	MOVEI	T2,^D36*.FBM	;BUT THIS TABLE IS A BIT TABLE
	MOVEM	T2,BITC		;BIT COUNT
	MOVEI	R,1		;SETUP R TO POINT TO LOW SEG
	TRNE	FL,R.FHS	;FORCED HIGHSEG?
	ADDI	R,1		;YES, USE 2ND RC
	MOVE	R,@RC.TB
	MOVEM	R,SAVERC	;INCASE R GETS RESET ON CORE OVERFLOWS
	MOVE	T1,RC.CV(R)	;GET CURRENT RELOCATION
	MOVEM	T1,RC.HL(R)	;AS HIGHEST LOCATION STORED SO FAR
	JRST	TEXTR		;START READING INPUT

TABINI:	MOVEI	T2,.FBS		;GET SOME SPACE FROM DY AREA
	PJRST	DY.GET##

SUBTTL	PASS 1 PROCESSING

TEXTR:	PUSHJ	P,D.IN1##;	TEXT BY DEFAULT
	HLRZ	W2,W1
	CAIN	W2,-1
	JRST	HEADER;		HEADER
	MOVEI	W2,1;		RELOCATABLE
	PUSHJ	P,BITW;		SHOVE AND STORE
	JRST	TEXTR;		LOOP FOR NEXT WORD

ABS:	SOSG	BLKSIZ;		MORE TO GET
	JRST	TEXTR;		NOPE
ABSI:	PUSHJ	P,D.IN1##
	MOVEI	W2,0;		NON-RELOCATABLE
	PUSHJ	P,BITW;		TYPE 0
	JRST	ABS

;DISPATCH ON A HEADER

HEADER:	CAMN	W1,[EXP -2];	END OF PASS ONE
	JRST	ENDS
	LDB	W2,[POINT 12,W1,35];	GET SIZE
	MOVEM	W2,BLKSIZ
	ANDI	W1,770000
	JUMPE	W1,PLB;		PROGRAMMER LABEL
	CAIN	W1,500000;	ABSOLUTE BLOCK
	JRST	ABSI;
	CAIN	W1,310000;	MADE LABEL
	JRST	MDLB;		MADE LABEL
	CAIN	W1,600000
	JRST	GLOBDF
	CAIN	W1,700000;	DATA STATEMENT
	JRST	DATAS
	CAIN	W1,770000;	SPECIAL DEBUGGER DATA
	JRST	SPECBUG
	.ERR.	(MS,.EC,V%L,L%F,S%F,I4S,<Illegal F40 sub-block >)
	.ETC.	(OCT,.EC!.EP,,,,W1)	;
TYPMOD:	.ETC.	(STR,.EC,,,,,< in module >)	;
	.ETC.	(SBX,.EP,,,,PRGNAM)	;
SUBTTL	PROCESS TABLE ENTRIES

PLB:	SKIPA	T1,PLTP		;GET PROGRAMMER LABEL POINTER
MDLB:	MOVE	T1,MLTP		;GET MADE LABEL POINTER
LBT0:	CAIG	W2,.FBM		;IN THIS BLOCK?
	JRST	LBT2		;YES
	SUBI	W2,.FBM		;NO, REDUCE INDEX (BUT SKIP 0)
	SKIPE	(T1)		;IS THERE ENOUGH SPACE?
	JRST	LBT1		;YES
	PUSH	P,T1		;SAVE RELATIVE TO DY.LB
	PUSHJ	P,TABINI	;GET MORE SPACE
	POP	P,T2		;RESTORE OLD POINTER
	MOVEM	T1,(T2)		;STORE LINK
	JRST	LBT0

LBT1:	MOVE	T1,(T1)		;GET NEXT POINTER
	JRST	LBT0		;AND TRY AGAIN

LBT2:	ADD	T1,W2		;ADD OFFSET
	MOVE	W3,RC.HL(R)	;GET CURRENT LOCATION
	MOVEM	W3,(T1)		;STORE IN TABLE
GLOBDF:	PUSHJ	P,D.IN1##
	MOVE	W2,W1		;RADIX50 SYMBOL
	LDB	P1,[POINT 4,W2,3]
	PUSHJ	P,R50T6##	;CONVRT TO 6BIT
	MOVX	W1,PT.SGN!PT.SYM!PS.REL	;
	MOVE	W3,RC.HL(R)	;CURRENT LOCATION
	PUSHJ	P,@T.2TAB##(P1)	;CALL RIGHT ROUTINE
	LOADRC			;RESTORE RC DATA BLOCK POINTER
	JRST	TEXTR


;DATA STATEMENTS
DATAS:	PUSHJ	P,FSWD		;STORE ALL WORDS IN A NEW BLOCK
	MOVSS	@W3		;PUT WORD COUNT IN LH
	SKIPN	DATP0		;FIRST TIME?
	JRST	DATA0		;YES
	HRRM	W3,@DATP	;STORE LINK
	HRRM	W3,DATP		;UPDATE POINTER
	JRST	TEXTR

DATA0:	MOVEM	W3,DATP0
	MOVEM	W3,DATP
	JRST	TEXTR

;SPECIAL MANTIS STUFF
SPECBUG:
IFN FTMANTIS,<
	TRNN	FL,R.SPD	;REALLY WANT THIS STUFF?
	JRST	NOMANT		;NO
SPECB:	SOSG	MANTC		;ANY SPACE LEFT
	PUSHJ	P,MNTINI	;NO, GET MORE
	PUSHJ	P,D.IN1		;READ ONE WORD
	IDPB	W1,MANTP
	SOJG	W2,SPECB	;LOOP FOR ALL OF TABLE
	JRST	TEXTR		;DONE

;HERE TO GET NEXT  MANTIS BUFFER
MNTINI:	PUSHJ	P,TABINI	;GET SPACE
	SUBI	T2,1		;LAST WORD IS NOT AVAILABLE
	MOVEM	T2,MANTC	;RESET COUNT
	HRLI	T1,(POINT 36)
	HRRZ	T2,T1		;GET POINTER
	IDPB	T2,DATP		;STORE IN DATA BLOCK
	MOVEM	T1,DATP		;RESET POINTER
	POPJ	P,
>;END OF IFN FTMANTIS

;HERE IF NOT LOADING MANTIS - JUST IGNORE

NOMANT:	PUSHJ	P,D.IN1##	;READ WORD
	SOJG	W2,.-1		;LOOP FOR ALL OF BLOCK
	JRST	TEXTR
SUBTTL	STORE WORD AND SET BIT TABLE

STRWRD:	MOVE	P2,RC.HL(R)	;CURRENT RELATIVE LOC
	MOVE	T1,RC.SG(R)	;GET SEGMENT NO.
	SKIPE	@RC.PG(R)	;PAGING THIS SEGMENT?
	JRST	ADCKP2		;YES, ADDRESS CHECK P2
	ADD	P2,@RC.LB(R)	;ADD INCORE ADDRESS
	SUB	P2,LL.S0(T1)	;REMOVE ORIGIN
	CAMLE	P2,TAB.AB(T1)	;FIT IN WHAT WE HAVE?
	JRST	STRWD1		;NO, EXPAND
STRWDM:	MOVEM	W1,(P2)		;STORE WORD
	POPJ	P,

STRWD1:	SUB	P2,TAB.AB(T1)	;EXTRA REQUIRED
	MOVEI	P1,(T1)		;WHERE
	PUSHJ	P,LNKCOR##	;GET IT
	  JRST	STRWRD		;CAN ONLY HAPPEN IF NOT PREV PAGING
	JRST	STRWRD		;TRY AGAIN

;HERE IF PAGING TO DSK

ADCKP2:	CAML	P2,LW.S0(T1)	;ADDRESS TOO LOW
	CAMLE	P2,UW.S0(T1)	;OR TOO HIGH
	JRST	PAGEP2		;YES, GET REQUIRED PAGE IN CORE
	SUB	P2,LW.S0(T1)	;REMOVE BASE
	ADD	P2,@RC.LB(R)	;PLUS START OF WINDOW IN CORE
	JRST	STRWDM		;MEMORY LOC RIGHT NOW

PAGEP2:	MOVE	P3,P2		;SET HIGHEST ADDRESS = LOWEST WE NEED
	PUSHJ	P,@[EXP PG.LSG##,PG.HSG##]-1(T1)	;RESET INCORE PAGES
	LOADRC
	JRST	STRWRD		;TRY AGAIN
BITW:	PUSHJ	P,STRWRD	;STORE WORD IN W1
	SOSGE	BITC		;ANY ROOM FOR BIT?
	PUSHJ	P,BITINI	;NO, GET MORE
	IDPB	W2,BITP		;DEPOSIT BIT
	AOS	RC.HL(R)	;STEP LOADER LOCATION
BITWX:	POPJ	P,;

;HERE TO GET ANOTHER BIT TABLE
BITINI:	PUSHJ	P,TABINI	;GET SPACE
	MOVEI	T2,^D36*.FBM-1	;ONE IDPB ALREADY DONE
	MOVEM	T2,BITC		;RESET COUNT
	HRLI	T1,(POINT 1)
	MOVEI	T2,@BITP	;GET CURRENT POINTER
	SUBI	T2,.FBM		;BACK UP
	MOVEM	T1,(T2)		;STORE IN BIT TABLE
	ADDI	T1,1		;FIRST WORD IS POINTER
	MOVEM	T1,BITP		;RESET POINTER
	POPJ	P,
SUBTTL	PROCESS END CODE WORD

ENDS:
ENDS0:	PUSHJ	P,D.IN1##;	GET STARTING ADDRESS
	JUMPE	W1,ENDS1;	NOT MAIN
	ADD	W1,RC.CV(R)	;RELOCATION OFFSET
	TRNE	FL,R.ISA	;IGNORE STARTING ADDRESS?
	JRST	ENDS1		;YES
	SETZ	W2,		;ZERO SYMBOLIC START ADDRESS
	PUSHJ	P,SET.ST##	;SET STARTING ADDRESS ETC
	MOVE	T1,PRGNAM	;GET PROG NAME
	MOVEM	T1,STANAM	;SAVE FOR MAP
ENDS1:	PUSHJ	P,D.IN2##	;DATA STORE SIZE
	HRRZM	W2,PTEMP	;NUMBER OF PERMANENT TEMPS
	MOVE	W3,RC.HL(R)	;CURRENT ADDRESS
	SUB	W3,RC.CV(R)	;REMOVE RELOCATION
	MOVEM	W3,CCON		;START OF CONSTANT AREA
	ADD	W3,RC.CV(R)	;PUT IT BACK
	JUMPE	W1,E1;		NULL
	MOVEM	W1,BLKSIZ	;SAVE COUNT
	MOVX	W1,PT.SGN!PT.SYM	;
	MOVE	W2,['CONST.']
	PUSHJ	P,@T.2TAB##+2	;LOCAL SYMBOL
	LOADRC
	ADD	W3,BLKSIZ	;ACCOUNT FOR CONSTANTS
	PUSHJ	P,GSWD		;STORE CONSTANT TABLE
E1:	MOVE	W1,W3
	EXCH	W1,PTEMP;	STORE INTO PERM TEMP POINTER
	ADD	W1,PTEMP;	FORM TEMP TEMP ADDRESS
	MOVEM	W1,TTEMP;	POINTER
	MOVX	W1,PT.SGN!PT.SYM	;
	MOVE	W2,['%TEMP.']
	PUSHJ	P,@T.2TAB##+2	;LOCAL
	LOADRC
	MOVE	W2,['TEMP. ']
	CAME	W3,TTEMP	;ANY PERM TEMPS?
	PUSHJ	P,@T.2TAB##+2	;YES, DEFINE
	LOADRC
E1A:	PUSHJ	P,D.IN1##;	NUMBER OF GLOBSUBS
	JUMPE	W1,E11		;NONE
	MOVEM	W1,BLKSIZ
	PUSHJ	P,FSWD		;STORE GLOBAL SUBROUTINE REQUESTS
	MOVEM	W3,GSTAB	;SAVE POINTER
E11:	PUSHJ	P,D.IN1##;	HOW MANY?
	JUMPE	W1,E21;		NONE
	PUSHJ	P,DYSWDP	;STORE SCALAR TABLE
	MOVEM	W3,STAB		;STORE SCALAR TABLE POINTER
E21:	PUSHJ	P,D.IN1##;	COMMENTS FOR SCALARS APPLY
	JUMPE	W1,E31
	PUSHJ	P,DYSWDP	;STORE ARRAY TABLE
	MOVEM	W3,ATAB
E31:	PUSHJ	P,D.IN1##;	SAME COMMENTS AS ABOVE
	JUMPE	W1,E41
	PUSHJ	P,DYSWDP	;STORE ARRAY OFFSET TABLE
	MOVEM	W3,AOTAB
E41:	PUSHJ	P,D.IN1##;	TEMP, SCALAR, ARRAY SIZE
	ADDB	W1,RC.HL(R)	;ADD IN CURRENT HIGHEST LOC
	MOVEM	W1,COMBAS;	START OF COMMON
	PUSHJ	P,D.IN1##;	COMMON BLOCK SIZE
	JUMPE	W1,PASS2;	NO COMMON
;HERE FOR COMMON

	PUSHJ	P,DYSWDP	;STORE WORD PAIRS
	MOVEM	W3,CTAB		;AND POINTER TO COMMON TABLE
				;NOW TO PRECESS COMMON
	MOVE	T1,@W3		;GET BLOCK SIZE
	SUBI	T1,1		;MINUS OVERHEAD WORD
	MOVEM	T1,BLKSIZ	;NUMBER OF DATA WORDS
	PUSH	P,CTAB		;SAVE INITIAL POINTER
	AOS	CTAB		;SKIP WORD COUNT
COMTOP:	MOVE	W2,@CTAB	;GET SYMBOL (RADIX50)
	AOS	CTAB		;POINT TO SIZE
	MOVS	W3,@CTAB	;LENGTH OF COMMON REQUIRED
	TRZE	W3,-1		;DEFENSIVE CHECK FOR TOO BIG
	PUSHJ	P,BADFILE	;REPORT ERROR
	PUSHJ	P,R50T6##	;CONVERT TO 6BIT
	MOVSM	W3,COMSIZ	;SAVE SIZE FOR LATER
	HRR	W3,COMBAS	;TENTATIVE BASE
	PUSHJ	P,T.COMM##	;SEE IF DEFINED, IF NOT DEFINE
				;IF DEFINED RETURN VALUE IN W3
	  JRST	COMCOM		;ALREADY DEFINED
	MOVE	T1,COMSIZ	;GET SIZE
	ADDM	T1,COMBAS	;UPDATE COMMON LOC
	ADDM	T1,RC.HL(R)	;AND HIGHEST LOCATION
	HRRZ	P1,@HT.PTR	;SETUP P1 TO POINT TO SYMBOL
	ADD	P1,NAMLOC	;IN CORE
COMCOM:	MOVEM	W3,@CTAB	;STORE NEW VALUE (START OF COMMON)
	AOS	CTAB		;BYPASS
COMCO1:	SOS	BLKSIZ
	SOSLE	BLKSIZ
	JRST	COMTOP
	POP	P,CTAB		;RESTORE ORRIGINAL
	JRST	PASS2



PRSTWX:	PUSHJ	P,D.IN2##	;GET A WORD PAIR
CWSTWX:	EXCH	W2,W1		;SPACE TO STORE FIRST WORD OF PAIR?
	PUSHJ	P,WSTWX		;...
	EXCH	W2,W1		;THERE WAS; IT'S STORED
WSTWX:	PUSHJ	P,STRWRD	;STORE 1 WORD
	AOS	RC.HL(R)	;INCREMENT THE LOAD LOCATION
	POPJ	P,		;AND RETURN


GSWD:	PUSHJ	P,D.IN1##	;GET WORD FROM TABLE
	PUSHJ	P,WSTWX		;STASH IT
	SOSLE	BLKSIZ		;FINISHED?
	JRST	GSWD		;NOPE, LOOP
	POPJ	P,

GSWDPR:	TLZE	W1,-1		;DEFENSIVE CHECK FOR TOO BIG
	PUSHJ	P,BADFILE	;REPORT ERROR
	TRNE	W1,1		;DEFENSIVE CHECK FOR PAIRS
	JRST	[PUSHJ	P,BADFILE	;REPORT ERROR
		AOJA	W1,.+1]		;MAKE EVEN
	MOVEM	W1,BLKSIZ	;KEEP COUNT
GSWDP1:	PUSHJ	P,PRSTWX	;GET AND STASH A PAIR
	SOS	BLKSIZ		;FINISHED?
	SOSLE	BLKSIZ		;...
	JRST	GSWDP1		;NOPE, LOOP
	POPJ	P,
;HERE TO STORE SINGLE WORDS IN DY AREA
;ENTER WITH BLKSIZ SETUP
;RETURNS RELATIVE ADDRESS  W1
FSWD:	AOS	T2,BLKSIZ	;WHAT WE NEED
	TLZE	T2,-1		;DEFENSIVE CHECK
	PUSHJ	P,BADFILE	;REPORT ERROR
	PUSHJ	P,DY.GET##	;FROM DY AREA
	MOVE	W3,T1		;SAVE A COPY
	SKIPA	W1,BLKSIZ	;STORE BLOCK LENGTH
	PUSHJ	P,D.IN1##	;GET WORD
	MOVEM	W1,(T1)		;STORE
	SOSLE	BLKSIZ
	AOJA	T1,.-3		;LOOP FOR ALL BLOCK
	POPJ	P,

;HERE FOR WORD PAIRS
DYSWDP:	TLZE	W1,-1		;DEFENSIVE CHECK FOR TOO BIG
	PUSHJ	P,BADFILE	;REPORT ERROR
	TRNE	W1,1		;DEFENSIVE CHECK FOR PAIRS
	JRST	[PUSHJ	P,BADFILE	;REPORT ERROR
		AOJA	W1,.+1]		;MAKE EVEN
	MOVEM	W1,BLKSIZ	;SAVE BLOCK SIZE
	MOVEI	T2,1(W1)	;WHAT WE NEED
	PUSHJ	P,DY.GET##	;FROM DY AREA
	MOVE	W3,T1		;SAVE A COPY
	MOVEM	T2,(T1)		;STORE SIZE
DYGWDP:	PUSHJ	P,D.IN2##	;GET WORD PAIR
	MOVEM	W2,1(T1)	;STORE
	MOVEM	W1,2(T1)
	ADDI	T1,2		;INCREMENT OVER PAIR
	SOS	BLKSIZ
	SOSLE	BLKSIZ
	JRST	DYGWDP		;GET NEXT PAIR
	POPJ	P,
SUBTTL	BEGIN HERE PASS2 TEXT PROCESSING

PASS2:	MOVE	T1,BITP0	;GET INITIAL BIT POINTER
	ADDI	T1,1		;FIRST ITEM IS POINTER
	CAMN	T1,BITP		;ANY FIXUPS TO DO?
	JRST	FBLKD		;NO, MUST BE BLOCK DATA
	MOVEM	T1,BITP		;RESET CURRENT POINTER
NOPRG:	MOVEI	T1,^D36*.FBM+2	;INITIAL COUNT + FUDGE FACTOR
	SUB	T1,BITC		;MINUS WHAT'S LEFT
	MOVEM	T1,BITCP	;SAVE PARTIAL COUNT OF LAST BLOCK
	SKIPE	@BITP0		;UNLESS LAST  BLOCK
	MOVEI	T1,^D36*.FBM	;USE INITIAL COUNT
	MOVEM	T1,BITC		;RESET COUNT OF BITS LEFT
	MOVE	W3,RC.CV(R)	;PUT CURRENT R.C. IN LOCA
	MOVE	T1,RC.SG(R)	;GET SEGMENT NO.
	SUB	W3,LL.S0(T1)	;REMOVE ORIGIN
	HRLI	W3,XC		;SET XC AS INDEX IN W3
	MOVEM	W3,LOCA		;INITIALIZE LOCATION COUNTER
	PUSHJ	P,SETADD	;SET UP ADDRESS INDEX
PASS2B:	MOVE	W3,LOCA		;MAKE SURE LOCATION COUNTER SET UP
	ILDB	W2,BITP		;GET A BIT
	JUMPE	W2,PASS2C;	NO PASS2 PROCESSING
	SKIPE	@RC.PG(R)	;PAGING THIS SEGMENT?
	PUSHJ	P,ADCKW3	;YES, ADDRESS CHECK W3
	PUSHJ	P,PROC;		PROCESS A TAG
	  JRST	PASS2B;		MORE TO COME
	JRST	ENDTP;

PASS2C:	PUSHJ	P,PASS2A
	  JRST	PASS2B
	JRST	ENDTP

SETADD:	SETZM	COREFL		;CLEAR CORE MOVED FLAG
	MOVE	XC,RC.SG(R)	;GET SEGMENT NO.
	MOVE	XC,TAB.LB(XC)	;BASE OF SEGMENT
	POPJ	P,
;HERE TO CHECK ADDRESS FOR "IN CORE" IF PAGING
;ENTER WITH 
;RC POINTER IN R (NOT SEGMENT NUMBER)
;W3 = ADDRESS (RELOCATED)


ADCKW3:	MOVE	T1,@RC.WD(R)	;GET LOWER BOUND
	MOVE	T2,@RC.PG(R)	;AND UPPER BOUND
	CAIG	T1,(W3)		;IF TOO SMALL
	CAIGE	T2,(W3)		;OR TOO BIG
	JRST	PAGEW3		;NOT IN CORE
	SUBI	W3,(T1)		;REMOVE BASE
	POPJ	P,
PAGEW3:	MOVE	T1,RC.SG(R)	;GET SEGMENT NUMBER
	HRRZ	P2,W3		;LOWEST ADDRESS WE NEED
	MOVE	P3,P2		;SET HIGHEST ADDRESS = LOWEST WE NEED
	PUSHJ	P,@[EXP PG.LSG##,PG.HSG##]-1(T1)	;RESET INCORE PAGES
	LOADRC
	MOVE	XC,@RC.LB(R)	;REFRESH INCASE IT MOVED
	JRST	ADCKW3		;TRY AGAIN

PROC:	LDB	W1,[POINT 6,@W3,23];	TAG
	SETZM	MODIF;		ZERO TO ADDRESS MODIFIER
	TRZE	W1,40
	AOS	MODIF
	LDB	W2,[POINT 12,@W3,35]
	CAILE	W1,13		;IN FIRST PART OF TABLE
	SUBI	W1,13		;NO, REDUCE
	CAIG	W1,TABLNG	;IN TABLE
	JRST	@TABDIS(W1)	;YES, DISPATCH
STOP:	.ERR.	(MS,.EC,V%L,L%F,S%F,I4T,<Illegal F40 table entry >)
	.ETC.	(OCT,.EC!.EP,,,,W1)	;
	.ETC.	(JMP,.EC,,,,TYPMOD)	;

TABDIS:	PPLT			;PROGRAMMER LABELS
	PATO			;ARRAYS OFFSET
	STOP
	STOP
	STOP
	PST			;SCALARS
	PGS			;GLOBAL SUBPROGRAMS
	PAT			;ARRAYS
	STOP
	PCONS			;CONSTANTS
	STOP
	PPT			;PERMANENT TEMPORARIES
	PTT			;TEMPORARY TEMPORARIES
	STOP
	PMLT			;MADE LABELS
TABLNG==.-TABDIS
SUBTTL	ROUTINES TO PROCESS POINTERS

PCONS:	ADD	W2,CCON		;GENERATE CONSTANT ADDRESS
	SOJA	W2,PCOMR	;ADJUST FOR 1 AS FIRST ENTRY

PSTA:	MOVE	W2,@W2		;NON-COMMON SCALARS AND ARRAYS
PCOMR:	ADD	W2,RC.CV(R)	;RELOCATE
PCOMX:	ADD	W2,MODIF	;ADDR RELOC FOR DP
	HRRM	W2,@W3		;REPLACE ADDRESS
PASS2A:	AOS	W3,LOCA		;STEP READOUT POINTER
	SKIPE	COREFL		;CORE MOVED ON US?
	PUSHJ	P,SETADD	;YES, RESET POINTERS
	SOSLE	BITC		;MORE TO COME?
	POPJ	P,		;YES
	MOVEI	T1,@BITP0	;GET ADDRESS  OF THIS BLOCK
	MOVE	T2,(T1)		;AND CONTENTS
	SKIPN	T2		;IGNORE 0
	SETZM	BITP0		;BUT MARK END OF LIST
	HRRM	T2,BITP0	;SAVE AS NEW
	HRLI	T2,(POINT 1)	;RESET ORIGINAL BYTE POINTER FIELDS
	ADDI	T2,1		;BYPASS FIRST WORD
	MOVEM	T2,BITP		;POINTS TO NEXT BIT
	MOVEI	T2,.FBS		;SIZE OF THIS BLOCK
	PUSHJ	P,DY.RET##	;RETURN TO POOL
	SKIPN	@BITP0		;IF LAST BLOCK
	SKIPA	T1,BITCP	;USE PARTIAL COUNT
	MOVEI	T1,^D36*.FBM	;OTHERWISE USE INITIAL COUNT
	MOVEM	T1,BITC		;OF BITS IN THIS BLOCK
	SKIPN	BITP0		;END OF LIST?
CPOPJ1:	AOS	(P)		;YES
	POPJ	P,		;RETURN

PAT:	SKIPA	W1,ATAB		;ARRAY TABLE BASE
PST:	MOVE	W1,STAB		;SCALAR TABLE  BASE
	ROT	W2,1		;SCALE BY 2
	ADD	W2,W1		;ADD IN TABLE BASE
	SUBI	W2,1		;FIRST ITEM IS COUNT
	HLRZ	W1,@W2		;CHECK FOR COMMON
	TRNN	W1,7777		;IGNORE SIX BITS	;U/O-LKS
	JRST	PSTA		;NO COMMON
	PUSHJ	P,COMDID	;PROCESS COMMON
	MOVE	W2,@W2		;GET OFFSET INTO COMMON
	ADD	W2,@W1		;ADD BASE OF COMMON
	JRST	PCOMX

COMDID:	ANDI	W1,7777		;IGNORE SIX BITS	;U/O-LKS
	LSH	W1,1		;PROCESS COMMON TABLE ENTRIES
	ADD	W1,CTAB;		COMMON TAG
	POPJ	P,		;RETURN

PATO:	ROT	W2,1
	ADD	W2,AOTAB;	ARRAY OFFSET
	MOVEM	W2,CT1;		SAVE CURRENT POINTER
	SOS	CT1		;BUT POINT TO VALUE
	HRRZ	W2,@W2		;PICK UP REFERENCE POINTER
	ANDI	W2,7777;	MASK TO ADDRESS
	ROT	W2,1;		ALWAYS AN ARRAY
	ADD	W2,ATAB
	SUBI	W2,1		;FIRST WORD IS COUNT
	HLRZ	W1,@W2		;COMMON CHECK
	TRNN	W1,7777		;IGNORE SIX BITS	;U/O-LKS
	JRST	NCO					;U/O-LKS
	PUSHJ	P,COMDID	;PROCESS COMMON
	MOVE	W2,CT1
	HRRE	W2,@W2
	ADD	W2,@W1
	JRST	PCOMX

NCO:	HRRZ	W2,@CT1		;OFFSET ADDRESS PICKUP
	JRST	PCOMR		;STASH ADDR AWAY

PTT:	ADD	W2,TTEMP;	TEMPORARY TEMPS
	SOJA	W2,PCOMX		;ADJUST FOR 1 AS FIRST ENTRY

PPT:	ADD	W2,PTEMP;	PERMANENT TEMPS
	SOJA	W2,PCOMX		;ADJUST FOR 1 AS FIRST ENTRY

PGS:	ADD	W2,GSTAB;	GLOBSUBS
	MOVE	W2,@W2		;GET RADIX50 SYMBOL
	TLC	W2,640000;	MAKE A REQUEST
	MOVE	T1,LOCA		;GET STORE POINTER
	MOVE	T2,RC.SG(R)	;GET SEGMENT NO.
	MOVE	T2,LL.S0(T2)	;GET ORIGIN
	ADDI	T2,(T1)		;PLUS REL ADDRESS
	HRRZ	W3,T2		;SYMBOL ADDRESS
	SUB	T1,@RC.WD(R)	;INCASE PAGING
	HLLZS	@T1		;ZERO RIGHT HALF IN MEMORY
	PUSHJ	P,SYMXX
	JRST	PASS2A


PMLT:	SKIPA	T1,MLTP
PPLT:	MOVE	T1,PLTP
PPMLT:	CAIG	W2,.FBM		;IN THIS BLOCK?
	JRST	PPMLT0		;YES
	SUBI	W2,.FBM		;NO, TRY NEXT
	MOVE	T1,@T1		;GET NEXT POINTER
	JRST	PPMLT		;TRY THIS

PPMLT0:	ADD	W2,T1
	HRRZ	W2,@W2
	JRST	PCOMX

SYMXX:	LDB	P1,[POINT 4,W2,3]
	PUSHJ	P,R50T6##	;SIXBIT IN W2
IFN DEBSW,<CAMN W2,$SYMBOL##
$V4:	JFCL>
	MOVX	W1,PT.SGN!PT.SYM	;
	PUSHJ	P,@T.2TAB##(P1)	;CALL RIGHT ROUTINE
	LOADRC
	POPJ	P,
SUBTTL	ROUTINES TO PROCESS DATA STATEMENTS

FBLKD:
ENDTP:	SETZM	PT1
	MOVEI	T1,377777	;A VERY LARGE NUMBER
	HRLOM	T1,BITC		;SO TEST AT PASS2A NEVER FAILS
ENDTPW:	MOVE	W3,DATP0	;GET ORIGINAL POINTER
	JUMPE	W3,NODATA	;NO DATA STATEMENTS
	MOVEM	W3,DATP		;SET POINTER TO LINK WORD
	ADDI	W3,1		;FIRST ITEM IS COUNT
	MOVEM	W3,LOCA		;RESET CURRENT TO IT
ENDTP1:	MOVE	W1,@LOCA	;GET WORD
	ADD	W1,[MOVEI W2,3]
	ADDI	W1,@LOCA
	EXCH	W1,@LOCA
	AOS	LOCA
	ADD	W1,@LOCA;		ITEMS COUNT
	MOVEM	W1,ITC
	MOVE	W1,[MOVEM W2,LTC]
	MOVEM	W1,@LOCA;		SETUP FOR DATA EXECUTION
	AOS	LOCA
	MOVSI	W1,(MOVEI W2,0)
	EXCH	W1,@LOCA
	MOVEM	W1,ENC;		END COUNT
	AOS	LOCA
	MOVEI	W1,@LOCA
	ADDM	W1,ITC
LOOP:	MOVE	W1,@LOCA
	HLRZ	T1,W1		;LEFT HALF INST.
	ANDI	T1,777000
	CAIN	T1,(JRST)
	JRST	WRAP		;END OF DATA
	CAIN	T1,(PUSHJ)
	JRST	PJTABL(W1)	;DISPATCH VIA TABLE
	CAIN	T1,(MOVE)
	JRST	[AOS	LOCA
		JRST	INNER]
	CAIN	T1,(ADD)
	JRST	ADDOP
	CAIN	T1,(IMULI)
	JRST	SKIPIN
	CAIN	T1,(IMUL)
	JRST	INNER
	.ERR.	(MS,.EC,V%L,L%F,S%F,I4D,<Illegal F40 DATA code >)
	.ETC.	(OCT,.EC!.EP,,,,T1)	;
	.ETC.	(JMP,.EC,,,,TYPMOD)	;
INNER:	HRRZ	T1,@LOCA;		GET ADDRESS
	TRZE	T1,770000;	ZERO TAG?
	SOJA	T1,CONPOL;	NO, CONSTANT POOL
	JUMPE	T1,FORCNF
	SUB	T1,PT1;		SUBTRACT INDUCTION NUMBER
	ASH	T1,1
	SUBI	T1,1
	HRRM	T1,@LOCA
	HLRZ	T1,@LOCA
	ADDI	T1,P
	HRLM	T1,@LOCA
	JRST	SKIPIN


CONPOL:	ADD	T1,ITC;	CONSTANT BASE
	HRRM	T1,@LOCA
	JRST	SKIPIN

ADDOP:	HRRZ	T1,@LOCA
	TRZE	T1,770000
	SOJA	T1,CONPOL
SKIPIN:	AOS	LOCA
	JRST	LOOP

PJTABL:	JRST	DWFS		;PUSHJ 17,0
	AOSA	PT1		;INCREMENT DO COUNT
	SOSA	PT1;		DECREMENT DO COUNT
	SKIPA	W1,[EXP DOINT.]
	MOVEI	W1,DOEND.
	HRRM	W1,@LOCA
	AOS	LOCA
	JRST	SKIPIN		;SKIP A WORD

DWFS:	MOVEI	W1,DWFS.
	HRRM	W1,@LOCA
	AOS	W3,LOCA
	SETOM	SYDAT
	PUSHJ	P,PROC;		PROCESS THE TAG
	JRST	LOOP		;PROPER RETURN

WRAP:	MOVE	W1,ENC;		NUMBER OF CONSTANTS
	ADD	W1,ITC;		CONSTANT BASE
	MOVEI	W2,(W1);		CHAIN
	HLRZ	T1,@DATP	;GET LENGTH OF THIS BLOCK
	MOVEI	T2,@DATP	;AND STARTING ADDRESS
	ADD	T1,T2		;GETS END OF IT
	CAIL	W2,(T1)		;IF LINK WORD IS OUTSIDE THIS BLOCK?
	JRST	WRAPUP		; GET NEXT BLOCK
	HRRM	W2,@LOCA
	JRST	ENDTP1

;HERE TO LINK TO NEXT DATA STATEMENT BLOCK
WRAPUP:	HRRZ	T1,@DATP	;GET NEXT ADDRESS
	JUMPE	T1,DODON	;END IF ZERO LINK
	HRRM	T1,DATP		;UPDATE POINTER
	MOVEI	T1,@DATP	;GET ADDRESS
	ADDI	T1,1		;BYPASS COUNT
	HRRM	T1,@LOCA	;FIXUP JRST
	HRRM	T1,LOCA		;AND POINTER TO IT
	JRST	ENDTP1		;DO NEXT STATEMENT

DODON:	MOVEI	T1,ALLOVE	;END ADDRESS
	HRRM	T1,@LOCA	;FIXUP LAST JRST IN CHAIN
	SETZM	SYDAT
	SETZM	RCF
	MOVEI	T1,@DATP0	;GET START OF DATA STATEMENTS
	JRST	1(T1)		;GO DO DATA STATEMENTS

DATAOV:	.ERR.	(MS,.EC,V%L,L%F,S%F,DSO,<Data statement overflow>)
	.ETC.	(JMP,.EC,,,,TYPMOD)	;
FORCNF:	.ERR.	(MS,.EC,V%L,L%F,S%F,FCD,<FORTRAN confused about data statements>)
	.ETC.	(JMP,.EC,,,,TYPMOD)	;
BADFIL:	.ERR.	(MS,.EC,V%M,L%W,S%W,B4R,<Bad F40 produced REL file for >)
	.ETC.	(SBX,.EP,,,,PRGNAM)
	POPJ	P,
SUBTTL	ROUTINES TO EXECUTE DATA STATEMENTS

DOINT.:	PORTAL	.+1		;INCASE EXECUTE ONLY
	POP	P,LOCA		;GET ADDRESS OF INITIAL VALUE
	PUSH	P,@LOCA		;STORE INDUCTION VARIABLE
	AOS	LOCA
	PUSH	P,LOCA		;INITIAL ADDRESS
	JRST	@LOCA

DOEND.:	PORTAL	.+1		;INCASE EXECUTE ONLY
	HLRE	T1,@(P)		;RETAIN SIGN OF INCREMENT
	ADDM	T1,-2(P)	;INCREMENT
	HRRE	T1,@(P)		;GET FINAL VALUE
	SUB	T1,-2(P)	;FINAL - CURRENT
	IMUL	T1,@(P)		;INCLUDE SIGN OF INCREMENT
	JUMPL	T1,DODONE	;SIGN IS ONLY IMPORTANT THING
	POP	P,(P)		;BACK UP POINTER
	JRST	@(P)

DWFS.:	PORTAL	.+1		;INCASE EXECUTE ONLY
	MOVE	T1,(P)
	AOS	(P)
	MOVE	T1,(T1)		;GET ADDRESS
	HLRZM	T1,DWCT		;DATA WORD COUNT
	HRRZ	T2,T1		;GET USER'S ADDRESS IN CORE
	ADDI	T2,(W2)		;ADD ANY OFFSET FOR F40
	PUSHJ	P,SEGCHK##	;CONVERT TO ABS ADDR IN LINK
	  JRST	DWFS.2		;NOT IN CORE (PAGED OR OFF END)
	MOVE	R,RC.SG(R)	;WE REALLY WANT THE SEGMENT NUMBER
	HRRZ	P3,T2		;PUT ADDR INTO COMMON AC
DWFS.1:	PUSHJ	P,DREAD		;GET A DATA WORD
	CAMLE	P3,LC.AB-1(R)	;FIT IN WHAT WE HAVE?
	PUSHJ	P,LDCKP3	;ADDRESS CHECK P3 AND FIX IT UP
	MOVEM	W1,(P3)		;YES, STORE IT
	SOSE	W2,DWCT		;STEP DOWN AND TEST
	AOJA	P3,DWFS.1	;ONE MORE TIME, MOZART BABY!
	SUB	P3,LC.LB-1(R)	;NOW TEST HC.S? AGAINST END
	ADD	P3,LW.S0(R)	;MAKE OFFSET FROM SEG START
	CAMLE	P3,HC.S0(R)	;SINCE ARRAY MAY BE AT END
	MOVEM	P3,HC.S0(R)	;A NEW RECORD
	POPJ	P,

;HERE WHEN P3 NOT IN BOUNDS. EXPAND CORE (OR PAGE) AND RETURN.
LDCKP3:	SUB	P3,LC.LB-1(R)	;CONVERT TO ADDRESS IN SEGMENT
	ADD	P3,LW.S0(R)	;..
	PJRST	ADCHK.##	;GO BRING IT INTO CORE

;HERE WHEN SEGCHK SAYS NO. CONVERT TO ADDR IN SEGMENT AND BRING IN
DWFS.2:	SUB	T2,LL.S0(R)	;CONVERT TO ADDR IN SEGMENT
	MOVE	P3,T2		;PUT WHERE ADCHK. EXPECTS IT
	PUSHJ	P,ADCHK.##	;READ IN AND RETURN PHYS ADDR
	JRST	DWFS.1		;NOW GO STORE DATA
DREAD:	SKIPE	RCF;		NEW REPEAT COUNT NEEDED
	JRST	FETCH;		NO
	MOVE	W1,LTC
	MOVEM	W1,LTCTEM
	MOVE	W1,@LTC;	GET A WORD
	HLRZM	W1,RCNT;	SET REPEAT COUNT
	HRRZM	W1,WCNT;	SET WORD COUNT
	TLNN	W1,-1		;CHECK FOR 0 REPEAT COUNT
	JRST	DATAOV		;AND GIVE ERROR ELSE PDLOV WILL OCCUR
	POP	W1,(W1);	SUBTRACT ONE FROM BOTH HALFS
	HLLM	W1,@LTC;	DECREMENT REPEAT COUNT
	AOS	W1,LTC;		STEP READOUT
	SETOM	RCF
FETCH:	MOVE	W1,@LTC
	AOS	LTC
	SOSE	WCNT
	POPJ	P,;
	SOSN	RCNT
	JRST	DOFF.
	MOVE	W3,LTCTEM;	RESTORE READOUT
	MOVEM	W3,LTC
DOFF.:	SETZM	RCF;		RESET DATA REPEAT FLAG
	POPJ	P,;

DODONE:	POP	P,-1(P);	BACK UP ADDRESS
	POP	P,-1(P)
	JRST	CPOPJ1		;RETURN

SUBTTL	END OF PASS2

ALLOVE:	PORTAL	.+1		;ENTER HERE FROM DATA STATEMENTS
	LOADRC			;RESTORE R FROM DWFS.
	MOVE	W1,DATP0	;GET INITIAL POINTER
RETDAT:	MOVEI	T1,@W1		;ADDRESS
	HLRZ	T2,@W1		;AND LENGTH
	HRR	W1,(T1)		;NEXT LINK
	PUSHJ	P,DY.RET##	;RETURN SPACE
	TRNE	W1,-1		;ANY MORE?
	JRST	RETDAT		;YES
NODATA:	SKIPE	T1,AOTAB	;DONE WITH ARRAY OFFSETS
	PUSHJ	P,RETBLK	;RETURN DATA BLOCK
	SKIPE	T1,ATAB		;SAME FOR ARRAY TABLE
	PUSHJ	P,SYDEF		;RETURN DATA BLOCK AND DEFINE LOCAL SYMBOLS
	SKIPE	T1,STAB		;SAME FOR SCALAR TABLE
	PUSHJ	P,SYDEF		;DEFINE LOCAL SYMBOLS
	SKIPE	T1,CTAB		;COMMON?
	PUSHJ	P,RETBLK
	SKIPN	GSTAB		;ANY GLOBAL REQUESTS?
	JRST	ALLDN		;NO
	MOVE	T1,@GSTAB	;NOW FOR GLOBAL REQUESTS
	MOVEM	T1,BLKSIZ	;SAVE COUNT
	SUBI	T1,1
	ADDM	T1,GSTAB	;START AT BACK
NXTGLB:	SOSG	BLKSIZ		;MORE TO DO
	JRST	ENDTP0		;NO
	MOVE	W2,@GSTAB	;GET SYMBOL
	TLC	W2,640000	;TURN INTO REQUEST
	SETZ	W3,		;ZERO VALUE FOR DUMMY REQUEST
	PUSHJ	P,SYMXX		;DEFINE IT
	SOS	GSTAB		;BACKUP POINTER
	JRST	NXTGLB		;LOOP

SYDEF:	TRNN	FL,R.SYM	;WANT LOCAL SYMBOLS?
	JRST	RETBLK		;NO, JUST DELETE TABLE
	PUSH	P,T1		;SAVE  ADDRESS
	MOVE	T2,@T1		;GET WORD COUNT
	SUBI	T2,1		;ONLY LOOK FOR DATA
	MOVEM	T2,BLKSIZ	;STORE FOR LOOP
	MOVEM	T1,SYMPOS	;POINTS TO TABLE ENTRIES
SYDEF0:	AOS	SYMPOS		;GET NEXT DATUM
	MOVE	W3,@SYMPOS	;GET VALUE OR COMMON POINTER
	TLNN	W3,007777	;CHECK FOR COMMON
	JRST	SYDEFR		;NO COMMON
	HLRZ	W1,W3		;GET COMMON OFFSET
	PUSHJ	P,COMDID	;PROCESS COMMON
	TLZ	W3,-1		;OFFSET INTO COMMON ONLY
	ADD	W3,@W1		;ADD BASE OF COMMON
	CAIA			;RELOCATED ALREADY
SYDEFR:	ADD	W3,RC.CV(R)	;RELOCATE
	AOS	SYMPOS		;NOW FOR SYMBOL NAME
	MOVE	W2,@SYMPOS	;IN RADIX 50
	PUSHJ	P,SYMXX		;DEFINE IT
	SOS	BLKSIZ
	SOSLE	BLKSIZ		;SEE IF MORE TO DO
	JRST	SYDEF0		;YES
	POP	P,T1		;DONE, DELETE BLOCK
	JRST	RETBLK		;AND RETURN

ENDTP0:	SKIPE	T1,GSTAB	;IGNORE IF NO GLOBALS
	PUSHJ	P,RETBLK	;RETURN
ALLDN:	SKIPE	W1,MLTP		;DELETE MAKE LABEL TABLE
	PUSHJ	P,RETTBL
	SKIPE	W1,PLTP		;AND PROGRAMMER TABLE
	PUSHJ	P,RETTBL
	SETZB	W1,W2		;RELOCATION COUNTERS ARE CORRECT
	SETZ	W3,
IFN FMXFOR,<
	SKIPG	MIXFOR		;NEED MIXFOR FEATURE, SAVE ENTRIES>
	PUSHJ	P,T.5ENT##	;RETURN ENTRY SPACE
	PUSHJ	P,DY.GBC##	;GARBAGE COLLECT JUNK AREA
	MOVE	W2,(R)		;PICKUP SEGMENT NUMBER
	MOVE	W3,RC.HL(R)	;GET HIGHEST ADDRESS SEEN
	SUB	W3,LL.S0(W2)	;SUBTRACT SEGMENT ORIGIN
	CAMLE	W3,HC.S0(W2)	;NEVER REDUCE HC.S0
	MOVEM	W3,HC.S0(W2)	;AVOID PROGRAM ZEROING IN LNKXIT
	SETZB	W2,W3		;DON'T OFFEND ANYBODY
	JRST	T.5F40##	;AND CLOSE OUT

RETBLK:	MOVEI	T1,@T1		;GET REAL ADDRESS
	MOVE	T2,(T1)		;AND SIZE
	PJRST	DY.RET##	;RETURN

RETTBL:	MOVEI	T1,@W1		;GET ADDRESS
	MOVEI	T2,.FBS		;LENGTH
	MOVE	W1,(T1)		;NEXT POINTER
	PUSHJ	P,DY.RET##	;RETURN THIS BLOCK
	JUMPN	W1,RETTBL	;LOOP FOR ALL STORAGE
	POPJ	P,
SUBTTL	ROUTINE TO SKIP FORTRAN OUTPUT

;SUBSECTION OF THE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. CODE TAKEN FROM FUDGE2.

MACHCD:	HRRZ	W2,W1		;GET THE WORD COUNT
	PUSHJ	P,D.IN1##	;INPUT A WORD
	SOJG	W2,.-1		;LOOP BACK FOR REST OF THE BLOCK
				;GO LOOK FOR NEXT BLOCK

REJECT:	PUSHJ	P,D.IN1##	;READ A FORTRAN BLOCK HEADER
	TLC	W1,-1		;TURN ONES TO ZEROES IN LEFT HALF
	TLNE	W1,-1		;WAS LEFT HALF ALL ONES?
	JRST	REJECT		;NO, IT WAS CALCULATED MACHINE CODE
	CAIN	W1,-2		;YES, IS RIGHT HALF = 777776?
	JRST	ENDST		;YES, PROCESS F4 END BLOCK
	LDB	W2,[POINT 6,W1,23];GET CODE BITS FROM BITS 18-23
	TRZ	W1,770000	;THEN WIPE THEM OUT
	CAIN	W2,77		;IS IT SPECIAL DEBUGGER DATA?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA
	CAIE	W2,70		;IS IT A DATA STATEMENT?
	CAIN	W2,50		;IS IT ABSOLUTE MACHINE CODE?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA STATEMENTS
	PUSHJ	P,D.IN1##	;NO, ITS A LABEL OF SOME SORT
	JRST	REJECT		;WHICH CONSISTS OF ONE WORD
				;LOOK FOR NEXT BLOCK HEADER

ENDST:	MOVEI	W2,1		;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
	MOVEI	T1,6		;TO GO
F4LUP1:	PUSHJ	P,D.IN1##	;GET TABLE MEMBER
F4LUP3:	SOJGE	W2,F4LUP1	;LOOP WITHIN A TABLE
	JUMPL	T1,[PUSHJ P,T.5ENT##	;RETURN ANY ENTRY SPACE
		JRST	LOAD##]		;LAST TABLE - RETURN
	SOJG	T1,F4LUP2	;FIRST TWO WORDS AND FIVE TABLES
	JUMPE	T1,F4LUP1	;COMMON LENGTH WORD
F4LUP2:	PUSHJ	P,D.IN1##	;READ HEADER WORD
	MOVE	W2,W1		;COUNT TO COUNTER
	JRST	F4LUP3		;STASH

;DATA STORAGE ITEMS  PRESERVED ONLY WHILE LOADING FORTRAN


.ZZ==.TEMP
U	(SAVERC)		;POINTER TO RC DATA BLOCK (LOW OR HIGH)
U	(MLTP)			;MADE LABEL POINTER TABLE
U	(PLTP)			;PROGRAMMER LABEL TABLE POINTER
U	(BITP0)			;INITIAL BIT TABLE POINTER
U	(BITP)			;CURRENT
U	(BITC)			;COUNT OF REMAINING BYTES
U	(BITCP)			;PARTIAL COUNT OF LAST BLOCK
U	(DATP0)			;INITIAL DATA STATEMENT POINTER
U	(DATP)			;CURRENT
U	(BLKSIZ)		;SIZE OF CURRENT F4 BLOCK
U	(PTEMP)			;PERM TEMP POINTER
U	(TTEMP)			;TEMP TEMP POINTER
U	(LOCA)			;CURRENT LOCATION COUNTER IN PASS2
U	(CT1)	
U	(CCON)	
U	(STAB)	
U	(ATAB)	
U	(AOTAB)	
U	(CTAB)	
U	(GSTAB)	
U	(COMBAS)	
U	(COMSIZ)
U	(MODIF)	
U	(PT1)	
U	(SYDAT)	
U	(LTC)	
U	(ITC)	
U	(ENC)	
LTCTEM=BLKSIZ
RCF=BITP
RCNT=BITP0
WCNT=BITC
DWCT=BITCP
SYMPOS==DATP			;USED AT END TO POINT TO LOCAL SYMBOLS


F40LIT:
	END