Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-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/DZN 24-Aug-79
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM
SALL
ENTRY LNKF40
INTERN T.400,T.401
EXTERN LNKCOR,LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;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
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)
;START OF VERSION 4A
;1174 Label and clean up all error messages.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
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
E$$I4S::.ERR. (MS,.EC,V%L,L%F,S%F,I4S,<Illegal F40 sub-block >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,W1)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
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,E$$B4R ;[1174] 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,E$$B4R ;[1174] REPORT ERROR
TRNE W1,1 ;DEFENSIVE CHECK FOR PAIRS
JRST [PUSHJ P,E$$B4R ;[1174] 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,E$$B4R ;[1174] 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,E$$B4R ;[1174] REPORT ERROR
TRNE W1,1 ;DEFENSIVE CHECK FOR PAIRS
JRST [PUSHJ P,E$$B4R ;[1174] 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
E$$I4T::.ERR. (MS,.EC,V%L,L%F,S%F,I4T,<Illegal F40 table entry >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,W1)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
TABDIS: PPLT ;PROGRAMMER LABELS
PATO ;ARRAYS OFFSET
E$$I4T ;[1174]
E$$I4T ;[1174]
E$$I4T ;[1174]
PST ;SCALARS
PGS ;GLOBAL SUBPROGRAMS
PAT ;ARRAYS
E$$I4T ;[1174]
PCONS ;CONSTANTS
E$$I4T ;[1174]
PPT ;PERMANENT TEMPORARIES
PTT ;TEMPORARY TEMPORARIES
E$$I4T ;[1174]
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
E$$I4D::.ERR. (MS,.EC,V%L,L%F,S%F,I4D,<Illegal F40 data code >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T1)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
INNER: HRRZ T1,@LOCA; GET ADDRESS
TRZE T1,770000; ZERO TAG?
SOJA T1,CONPOL; NO, CONSTANT POOL
JUMPE T1,E$$FCD; [1174]
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
E$$DSO::.ERR. (MS,.EC,V%L,L%F,S%F,DSO,<Data statement overflow>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
E$$FCD::.ERR. (MS,.EC,V%L,L%F,S%F,FCD,<F40 confused about data statements>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
E$$B4R::.ERR. (MS,.EC,V%L,L%W,S%W,B4R,<Bad F40 produced REL file>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
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 E$$DSO ;[1174] 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
SUBTTL THE END
F40LIT: END