github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-03 01:48:42 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/link/lnkf40.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1031 lines
29 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE LNKF40 - LOAD OLD STYLE FORTRAN COMPILER OUTPUT
SUBTTL D.M.NIXON/DMN/JLd/JNG/DZN/PAH/RJF 5-Feb-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;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
SALL
ENTRY LNKF40
INTERN T.400,T.401
EXTERN LNKCOR,LNKLOG
CUSTVR==0 ;CUSTOMER VERSION
DECVER==5 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==2417 ;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).
;START OF VERSION 5.1
;1744 Strip unsupported FMXFOR code.
;2026 Update copyright notice.
;2417 Update copyright notice to 1988.
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,
REPEAT 0,<
IFN FMXFOR,<
SKIPG MIXFOR ;NEED MIXFOR FEATURE, SAVE ENTRIES>
> ;[1744]
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
Reference in New Issue View Git Blame Copy Permalink