Trailing-Edge
-
PDP-10 Archives
-
BB-H138B-BM
-
language-sources/lnkold.mac
There are 50 other files named lnkold.mac in the archive. Click here to see a list.
TITLE LNKOLD - LOAD OLD BLOCKS MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/RKH/JBC/JNG/DCE/MCHC/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,SCNMAC
SALL
ENTRY LNKOLD
EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;DEC EDIT VERSION
SEGMENT
;LOCAL ACC DEFINITIONS
INTERN R,RB,WC
R=R1 ;CURRENT RELOCATION COUNTER
RB=R+1 ;RELOCATION BYTE WORD
WC=R3 ;WORD COUNT
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;43 FORTRAN-10 LOCAL SYMBOLS IN COMMON NOT FIXED UP CORRECTLY
;46 ADD KLUDGE FEATURE
;47 INTEGRATE WITH SCAN %4, ADD DATE75 HACK
;54 ADD KIONLY D.P. INST.
;61 ADD STORE CODE IN CORE FOR T.3 TWOSEG FIXUPS
;62 FIX BUG IN BLOCK TYPE 11 (POLISH FOR FORTRAN-10)
;63 ADD EXTERNAL START ADDRESS IN BLOCK TYPE 7
;71 ADD MORE STANDARD MESSAGES
;72 (11315) CTYPE NOT CLEARED ON UNKNOWN COMPILER TYPE
;75 FIX ALGOL OWN BLOCK, CALL ADCHK. ROUTINE
;101 MORE FIXES FOR FAIL CODE IF UNDEF GLOBAL REQUEST
;102 ADD TEST AND CURE FOR NO END BLOCK
;104 PUT FAIL BLOCK HEADERS IN LOCAL SYMBOL TABLE
;105 MAKE BLOCK TYPE 12 WORK
;106 ALLOW HIGH SEG TO LOAD AT ADDRESS OTHER THAN 400000
;107 REPLACE KLUDGE BY MIXFOR
;111 MAKE MIXFOR WORK EVEN IF NOT SEARCH MODE
;116 FIX UNDEFINED SYMBOL COUNT IN FAIL BLOCKS
;126 CHANGE CALLING SEQUENCE ON ADDRESS CHECKING AND STORING INTO CORE
;130 (12315) NOT ALL SYMBOL COPIED WHEN PREVIOUSLY REQUESTED COMMON IS DEFINED
;133 CAN NOT LOAD LIBSAI (SAIL LIBRARY), RETURN FROM T.11EV IS WRONG
;131 (12431) OCCASIONALLY ABS SYMBOLS SHOW AS REL IN MAP
;START OF VERSION 2
;135 ADD OVERLAY FACILITY
;136 FIX VARIOUS BUGS
;143 MAKE /INCLUDE WORK BETTER
;144 (12772) DON'T STORE SFD FOR MAP IF BOTH WORDS ARE 0
;162 CHANGE W1 TO W3 IN T.14 CODE TO AVOID CONFLICT WITH OVERLAYS
;166 READ BACK RADIX50 SYMBOL FILES (TYPE 776)
;171 (13234) FIX ILL MEM REF IF FORTRAN-10 PROG TOO BIG
;174 FIX BUGS IN RELOCATABLE OVERLAYS
;201 MAKE FORDDT WORK
;206 FIX CHAINED REF IF NOT ALL OF CHAIN IN CORE
;210 (13461) MORE OF #172, FIX BLOCK TYPE 16 CORRECTLY
;212 FIX ZEROS IN SYMBOL TABLE BUG AT T.5XPL
;217 STORE POLISH FIXUP POINTER RELOCATED INCASE CORE MOVES
;START OF VERSION 2B
;225 ADD SUPPORT FOR PSECT (FOR MACRO VERSION 51)
;227 (13779) TEST TEMP LOCAL SWITCH AT T.37
;236 CORE EXP BUG IN SY.RUA, P1 DESTROYED BEFORE BEING USED
;241 SEPARATE LOW SEG REL CODE FROM ABS CODE FOR HIGHEST LOC CALCULATIONS
;250 Correct genereation of header fixups for MAP.
;252 Check each file during a libary search of indexed library
; if /INCLUDE files yet to be loaded.
;274 Fix to load DATA into COMMON in the HGH segment from
; a module placed in the LOW segment.
;275 Fix multiply defined GLOBALS when one program
; .REQUIRES another.
;303 Get page size right for TOPS20 or FTVM
;310 Warn user when high segment is too big
;311 Try to allocate HC on a page boundary for TENEX
;317 Correct initialization before call to TRYSYM
;320 Reinitialize user virtual address before call to
; page in window
; to search symbol table
;325 Prevent loop when forcing TWOSEG into single segment
; and high segment break is same as start (length of 0).
;326 Re-work edit 252 to always work.
; Ignore block 14 when /INCLUDE: is given
;347 INCLUDE EDITS 303,310,311 IN MAINTENANCE SOURCES. LABEL EDITS 227,
; 236,241.
;350 DELETE REFERENCES TO RSYM
;353 REMOVE EDIT 225
;364 If TITLE block is paged out when HISEG block
; is seen, generate a FIXUP instead of giving up.
;366 Only use 18 bit addresses to call CHKSEG from T.2CHK
;371 Move definition of .ERSFU to LNKCOR.
;373 Load COMMON correctly on a /SEGMENT:HIGH.
;375 Make T.COMM store the COMMON in the local symbol table.
;404 Re-insert edits 323, 334, and 340, which got lost.
;START OF VERSION 2C
;437 Prevent LNKDUZ errors by flushing redundent RH fixups
;441 Correct improper loading of COMMON when /SEG:HIGH
;457 Update LIBPRC in T.6 along with PROCSN.
;465 Clean up customer type dispatch, and allow block type 100.
;471 Add code for ALGOL debugging system.
;500 Make RADIX-50 symbol files with more than 255 symbols work.
;506 Don't search bound globals when processing types 4 or 14.
;513 Combine the common functions of T.6 and T.776 into subroutines.
;514 Always set up the left half of R correctly in RB.1
;515 Always respect PH.ADD when loading overlays.
;517 Change ABLLEN to LN.ABL
;523 Get args right on call to PH.HSG to improve loading efficiency.
;527 Save R1 over call to TTLREL in T.776.
;530 Define triplet flags correctly for TXxx macros.
;531 Give error message if user loads universal file.
;532 Get creation time right on MAP.
;543 Fix problems with loading & searching for partial definitions.
;544 SOUP in LINK version 3 stuff for TOPS-20.
;545 Make .LINK work properly when paging.
;546 Delete an extra line inserted by SOUP.
;550 Prevent ILL UUO on polish fixup to non-loaded local.
;552 Organize .REQUEST/.REQUIRE database.
;553 Don't jump to DDT if $LOCATION is 0 (edit 302).
;557 Clean up the listing for release.
;START OF VERSION 3
;445 INSERT OLD EDITS TO POLISH SYMBOL FIXUPS
;446 DELETE HSO ERROR MESSAGE
;447 ADD 3 NEW POLISH OPERATORS
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;562 Fix ?ILL MEM REF searching indexed library when an entry
; point is seen for a symbol already partially defined.
;563 Prevent erroneous ?LNKIMM messages.
;565 Fix block type 10 with /ONLY:LOW.
;567 Prevent ?LNKISP on multiple partial definition.
;571 Prevent ?ILL MEM REF when one require file requires another
;572 Make sure LS addr in core before doing POLISH symbol fixup
;577 Generate LS fixup when local block name chain paged out.
;603 Change all references to PPDL to LN.PPD.
;611 Support COBOL-74
;612 Fix various POLISH bugs.
;626 Don't search bound globals on a partial definition.
;632 Implement $FIXUP.
;633 Never throw a Polish fixup away after symbols point to it.
;650 Use VM on TOPS-10 if available.
;654 Pass relative GS addr to LS.ADE.
;662 Update NAMPTR in T.776.
;673 Change the LIT message to the RBS message.
;700 Put in 2 more PSECT index checks and $SYMBOL check.
;701 Don't do block type 100 when doing library search.
;702 Save AC R in Type 776 processing.
;707 Keep chains separate if the first chain is not less.
;711 Fix bug with MAP when only 1 psect in a module.
;722 Implement PSECT attributes.
;731 SEARCH MACTEN,UUOSYM
;732 Store lowest location and fix bugs related to page 777.
;735 Remove Repeat 0 around polish operators 20-24,-10.
;742 Fix bug with using LOWLOC code.
;745 Adjust symbol table limit when setting up reloc counter .HIGH.
;753 Fix bug in SETRCY, when .HIGH. RC slot is already taken.
;757 Dont clear RC.HL for overlayable PSECTs in Block 5 processing.
;761 Give error if code is loaded into a relocatable PSECT.
;763 Add Block 24. Modify Block 22 and Block 23.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF VERSION 4A
;767 Fix a bug to prevent LINK from looping when forced dump of lc is done.
;777 Fix allocation of COMMON when a block is referenced first, defined later.
;1101 Fix searching indexed libraries that have some modules not
; represented in the index.
;1114 Zero count of COBOL symbols and ALGOL OWNs in T.5A.
;1115 Add LNKHCL message to complain about loading high seg in non-root link.
;1120 Make T.6 handle mask of CPU bits rather than a single value.
;1132 Check for PSECT seen in this module with AT.PS; preserve RC.HL
;1137 Don't change RC.CUR in T.24.
;1140 Clear LSTSYM if a non-loaded local is encountered.
;1153 Give LNKIPX if block 24 is illegal.
;1154 Don't re-order PSECT indices in T.23; general re-write of T.23.
;1155 Allow PSECT .HIGH. to work as TWOSEG.
;1156 Clear RC.CUR before reading data words in T.5.
;1166 Make sure default PSECT index is first half word in T.11.
;1170 Set up HC.S2 in SETRC in case hiseg contains only BLOCKs.
;1174 Label and clean up all error messages.
;1204 Give LNKPTL message if program exceeds 777777, remove LNKHSL.
;1210 Allow 1 word block 5, allow break of exactly 1,,0 (relocated).
;1213 Delete the ISD message, setup special fixup if multiple partial defs.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
COMMENT \
ALL OLD LINK ITEMS (BLOCK TYPES) HAVE THE SAME GENERAL FORMAT.
THE FIRST WORD IS THE BLOCK HEADER
LEFT HALF IS BLOCK TYPE
RIGHT HALF IS DATA WORD COUNT
THEN FOLLOWS ONE OR MORE 18 WORD SUB-BLOCKS.
EACH SUB-BLOCK IS PRECEDED BY A BYTE WORD CONTAINING 18 2-BIT BYTES
THE BYTE WORDS ARE NOT INCLUDED IN THE DATA WORD COUNT
----------------
! TYPE ! COUNT !
----------------
! BYTE WORD !
----------------
! DATA WORDS !
----------------
...
----------------
! BYTE WORD !
----------------
! DATA WORDS !
----------------
\
SUBTTL BLOCK DISPATCH TABLES
ODSPTB: LITYPE (0,37)
ODISPL==.-ODSPTB
XALL
FDSPTB: LITYPE (700,777)
FDISPL==.-FDSPTB
SALL
SUBTTL DISPATCH TO OLD BLOCK TYPE
;ENTER WITH BLOCK TYPE IN T1
;ALSO IN W1
LNKOLD: CAIL T1,ODISPL*2 ;IS IT LEGAL TYPE
JRST OLDERR ;NO, SEE IF CUSTOMER SUPPLIED
TRNE FL,R.LIB!R.INC ;IN LIBRARY SEARCH MODE OR /INC MODE?
JRST T.SRCH ;YES, IGNORE IF NOT BLOCK TYPE 4
CAIGE T1,ODISPL ;SEE WHICH HALF OF TABLE TO USE
SKIPA T2,ODSPTB(T1) ;USE RIGHT HALF
HLRZ T2,ODSPTB-ODISPL(T1) ;USE LEFT HALF
JRST (T2) ;DISPATCH
;HERE TO SEE IF "ILLEGAL" LINK ITEM IS IN LNKCST
OLDERR: CAIL T1,700 ;700-777 (SPECIAL FILE TYPES)?
JRST OLDFIL ;YES, GO HANDLE
CAIL T1,100 ;IN DEC 100-377 RANGE?
JRST OLD100 ;YES, DISPATCH
JRST LNKCST## ;ELSE MUST BE CUSTOMER 40-77
;OR CUSTOMER 402-677
;HERE ON A FILE TYPE. DISPATCH TO THE PROPER ROUTINE.
OLDFIL: CAIL T1,700+FDISPL*2 ;LEGAL FILE TYPE?
JRST E$$IRB## ;[1174] NO, GIVE ERROR MESSAGE
HRREI T2,-<700+FDISPL>(T1) ;GET OFFSET TYPE
JUMPGE T2,.+2 ;IF NEGATIVE, USE RHS
SKIPA T2,FDSPTB+FDISPL(T2) ;USE RIGHT HALF
HLRZ T2,FDSPTB(T2) ;USE LEFT HALF
JRST (T2) ;DISPATCH
;HERE ON TYPES 100-377, EASY SINCE THERE'S ONLY TYPE 100 (SO FAR)
OLD100: CAIN T1,100 ;IS IT .ASSIGN OPERATOR?
JRST T.100 ;YES, NO PROBLEM
JRST E$$IRB## ;[1174] NO, ILLEGAL
;HERE IF IN LIBRARY SEARCH MODE - TEST FOR BLOCK TYPE 4, 6, 14
T.SRCH: CAIN T1,4 ;IS IT ENTRY BLOCK?
JRST T.4 ;YES, SEE IF WE WANT IT
CAIN T1,6 ;TITLE BLOCK (INCASE /INCLUDE)
JRST T.6
CAIN T1,14 ;INDEX BLOCK?
JRST T.14A ;YES, READ INDEX TO SEE IF PROG REQUIRED
CAIE T1,5 ;END BLOCK?
JRST T.0 ;NO, IGNORE THIS BLOCK
PUSHJ P,T.5ENT ;REMOVE ALL ENTRY POINTS STORED FOR THIS PROG
HRR FL,FLAGS ;RESTORE INCASE /EXCL WAS ON
JRST T.0 ;AND IGNORE BLOCK
SUBTTL BLOCK TYPE 0 - ALGOL OR JUNK WORD
; ----------------
; ! 0 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! DATA WORDS !
; ----------------
T.0: HRRZ T1,W1 ;GET WORD COUNT
JUMPE T1,LOAD## ;JUST IGNORE
CAIG T1,^D18 ;ONLY ONE SUB BLOCK?
AOJA T1,T.0A ;YES
IDIVI T1,^D18 ;GET NUMBER OF SUB BLOCKS
IMULI T1,^D19 ;COUNT RELOCATION WORD
JUMPE T2,T.0A ;ANY REMAINDER?
ADDI T1,1(T2) ;IT HAS RELOCATION WORD ALSO
T.0A: CAML T1,DCBUF+2 ;ENOUGH WORDS IN BLOCK?
SOJA T1,T.0B ;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
T.0B: SUB T1,DCBUF+2 ;COUNT DOWN WORDS IN BUFFER
PUSHJ P,D.INP## ;GET NEXT BUFFER
JRST T.0A ;FINISH OFF BLOCK
T.0C: PUSHJ P,RB.1 ;GET NEXT WORD
JRST LOAD## ;ALL DONE
JRST .-2
SUBTTL BLOCK TYPE 1 - CODE AND DATA
; OR
; ---------------- ----------------
; ! 1 ! COUNT ! ! 1 ! COUNT !
; ---------------- ----------------
; ! BYTE WORD ! ! BYTE WORD !
; ---------------- ----------------
; ! ADDRESS ! ! SYMBOL !
; ---------------- ----------------
; ! DATA WORDS ! ! OFFSET !
; ---------------- ----------------
; ! DATA WORDS !
; ----------------
T.1: HRRZI W3,-1(W1) ;GET WORD COUNT OF DATA
PUSHJ P,RB.1 ;READ ONE WORD AND RELOCATE IT
JRST LOAD## ;GET NEXT BLOCK
TLZ R,-1 ;CLEAR LEFT HALF NON-RELOC FLAG
JUMPGE W1,.+3 ;NOT SYMBOLIC
MOVEI T1,1 ;BLOCK TYPE INCASE ERROR
PUSHJ P,T.1S ;SYMBOLIC IF BIT 0 SET
MOVE P3,W1 ;SAVE START ADDRESS IN P3
ADD W1,W3 ;HIGHEST ADDRESS NEEDED
SETO W3, ;NOT TYPE 21
T.1AD: MOVE T1,LSTRRV ;[1204] GET LAST RH WORD
CAMG T1,[1,,0] ;[1204] WAS IT TOO BIG?
CAMLE W1,[1,,0] ;[1204] OR IS FIRST UNUSED ADDR TOO BIG?
PUSHJ P,E$$PTL ;[1204] YES, ERROR
MOVE P2,W1 ;GET LOCATION REQUIRED
.JDDT LNKOLD,T.1AD,<<CAML P2,$LOCATION##>,<CAMLE P3,$LOCATION>,<JRST .+3>,<SKIPE $LOCATION>>
JUMPE R,T.1A ;SPECIAL CHECK IF ABSOLUTE ADDRESS
MOVE T1,RC.SG(R) ;GET SEGMENT NUMBER
CAILE T1,1 ;STORE TO LOW SEGMENT
JRST T.1H ;NO, CHECK HIGH
TRNE FL,R.HSO ;ONLY WANT HIGH SEG CODE?
JRST T.0C ;YES, IGNORE THIS BLOCK
CAMLE P2,HL.S1 ;RESET HIGHEST LOCATION COUNTER
MOVEM P2,HL.S1
CAMLE P2,HC.S1 ;AND HIGHEST DATA LOADED COUNTER
MOVEM P2,HC.S1
CAMLE W1,RC.HL(R) ;TEST AGAINST HIGHEST SEEN SO FAR
MOVEM W1,RC.HL(R) ;A NEW RECORD
T.1AL:
IFN FTOVERLAY,<
CAMGE P3,PH.ADD ;MAKE SURE ADDRESSIS LEGAL
JRST T.1OVE ;NOT IN THIS LINK
SKIPE RT.LB ;RELOCATION TABLE SETUP?
PUSHJ P,RT.P2## ;YES, SETUP BYTE PTR
>
SKIPE PAG.S1 ;PAGING?
JRST T.1LP ;YES, SEE IF IN CORE
IFN FTOVERLAY,<
SUB P2,PH.ADD ;REMOVE BASE
SUB P3,PH.ADD ;SO AS NOT TO WASTE SPACE
>
CAMGE P3,LOWLOC ;[732] GOT THE LOWEST LOCATION?
JRST T.1LOW ;[732] YES, JUMP
T.1AL1: ADD P2,LC.LB ;[732] RELOCATE RELATIVE ADDRESS
CAMG P2,LC.AB ;WILL IT FIT IN EXISTING SPACE?
JRST T.1L1 ;YES
SUB P2,LC.AB ;GET EXTRA REQUIRED
MOVEI P1,LC.IX ;AREA REQUIRED TO EXPAND
PUSHJ P,LNKCOR## ;TRY TO GET MORE SPACE
IFE FTOVERLAY,<
JRST T.1LP ;FAILED BUT MUST BE ON DSK BY NOW
> ;END OF IFE FTOVERLAY
IFN FTOVERLAY,<
JRST [ADD P3,PH.ADD ;DSK RTNS WANT ABS ADDRESS
JRST T.1LP] ;MUST BE ON DSK BY NOW
> ;END OF IFN FTOVERLAY
T.1AL0: SUB P3,LW.S1 ;[732] INCASE WE DUMPED CORE FOR FIRST TIME
T.1L1: ADD P3,LC.LB ;FINALLY FIX THIS INCASE CORE MOVED
; JRST T.1DP
T.1DP: PUSHJ P,RB.1 ;GET THE DATA WORDS
JRST LOAD## ;FINISHED BLOCK
CSTORE ;STORE IN CORE
SOJE W3,CPOPJ ;T.21 RETURN
AOJA P3,T.1DP ;WILL RETURN TO LOAD WHEN RUN OUT
;HERE IF LOWEST LCATION AND NO PAGING(MUST BE THE FIRST TIME)
T.1LOW: PUSH P,P3 ;[732]
TRZ P3,777 ;[732] ROUND DOWN TO PAGE BOUNDARY
MOVEM P3,LOWLOC ;[732] UPDATE LOWEST LOCATION
SKIPN UW.LC ;[732] SKIP TO RETURN IF NOT FIRST TIME
CAIGE P3,400000 ;[732] GREATER THAN 128K?
JRST [POP P,P3 ;[732]
JRST T.1AL1] ;[732] NO, PROCEED AS USUAL
PUSH P,P3 ;[732]
PUSH P,P2 ;[732] YES, SAVE REAL LOCATIONS A WHILE
MOVEI T1,777777 ;[732]
SUBI T1,(P3) ;[732]
SETZ P2, ;[767][732] NO EXPANSION, PREVENT LOOPING
PUSHJ P,LC.DMP## ;[742] FORCE CURRENT WINDOW TO DISK
CAILE T1,2*LN.WD-1 ;[732] USE SMALLER OF THE TWO
MOVEI T1,2*LN.WD-1 ;[732]
MOVE P2,T1 ;[732]
MOVEI P1,LC.IX ;[732] AND THE AREA INDEX
MOVE T2,LC.AB ;[732] DO WE NEED TO EXPAND CORE FIRST?
SUB T2,LC.LB ;[732] GET LENGTH
CAMG T1,T2 ;[732] NEED MORE THAN WE HAVE?
JRST T.1LO1 ;[743] NO NEED TO EXPAND CORE
ADDI P2,1 ;[732] YES, EXAND FIRST
PUSHJ P,LNKCOR## ;[732] GO ALLOCATE THAT MUCH
JFCL ;[742]
T.1LO1: POP P,P2 ;[742] RESTORE TO REAL LOCATION
POP P,LW.LC ;[742] WINDOW STARTS AT LOWEST LOCATION
MOVE T1,LC.AB ;[732] CACULATE WINDOW'S UPPER BOUND
SUB T1,LC.LB ;[732] FROM CURRENT CORE LENGTH
ADD T1,LW.LC ;[732]
CAILE T1,777777 ;[732] CHECK FOR OVERFLOW INTO LEFT HALF
MOVEI T1,777777 ;[732]
MOVEM T1,UW.LC ;[732] AND UPDATE
POP P,P3 ;[732]
JRST T.1AL0 ;[732]
;HERE IF PAGING TO SEE IF ADDRESS IS
;LESS THAN 140
;OR IF IN CORE
;IF GREATER THAN 137 READ IN FROM DSK
T.1LP: MOVE P2,W1 ;RESET VIRTUAL ADDRESS
CAIGE P2,.JBDA ;IN JOBDAT AREA?
SKIPN LW.S1 ;YES, ONLY IN CORE IF ON BLOCK 1
CAIA ;NO SUCH LUCK
JRST T.1LPJ ;LINK TO LIST OF REPLACEMENTS
PUSH P,W3 ;PG.LSG SOMETIMES CRUMPS W3
IFN FTOVERLAY,<
SUB P2,PH.ADD ;PG.LSG WANTS OFFSET ADDRESSES
SUB P3,PH.ADD ;SO BUMP DOWN BY PH.ADD
> ;END OF IFN FTOVERLAY
PUSHJ P,PG.LSG## ;MAKE FULL TEST AND READ IN
POP P,W3
JRST T.1L1 ;NOW IN CORE
T.1LPJ: PUSHJ P,RB.1 ;GET DATA WORD
JRST LOAD## ;ALL DONE
HRRZ T2,P3 ;ADDRESS OF WHERE TO LOAD
EXCH W1,W3 ;DATA IN W3, BUT SAVE OLD W3
HRLI T2,CPF.RF ;LOAD OFFSET FOR FULL REPLACEMENT
MOVEI R,LC.IX ;MUST BE LOW SEG
PUSHJ P,SY.CHP## ;LINK IN LIST
EXCH W1,W3 ;GET W3 BACK INCASE TYPE 21
SOJE W3,CPOPJ ;ALL DONE IF IT WAS
AOJA P3,T.1LPJ ;SEE IF ANY MORE (USUALLY NOT)
;HERE FOR ABSOLUTE CODE THIS CAN GO TO EITHER HIGH OR LOW SEGMENT
;KEYED UPON LL.S2, USUALLY TO LOW SEG
T.1A: MOVEI R,2 ;ASSUME HIGH
CAIE W3,1 ;LOADING FORTRAN DATA STATEMENTS?
JRST .+3 ;NO,SKIP EDIT 441
TRNE FL,R.FHS ;FORCED LOAD TO HIGH SEG?
JRST T.1HA ;YES, SO DO IT
TRNE FL,R.TWSG ;MUST BE LOW IF ONLY ONE SEG
CAMGE P2,LL.S2 ;SEE WHICH SEGMENT
TDZA R,R ;LOW, RESET BACK TO ABS
JRST T.1HA ;HIGH SEG
TRNE FL,R.HSO ;ONLY WANT HIGH SEG CODE?
JRST T.0C ;YES, IGNORE THIS BLOCK
MOVE R,@RC.TB ;SETUP POINTER TO ABS RC BLOCK
CAMLE W1,RC.HL(R) ;KEEP TRACK OF LARGEST ABS ADDRESS
MOVEM W1,RC.HL(R) ;MIGHT BE USEFUL SOME DAY
CAMLE P2,HL.S0 ;RESET HIGHEST LOCATION COUNTER
MOVEM P2,HL.S0
CAMLE P2,HC.S0 ;AND HIGHEST DATA LOADED COUNTER
MOVEM P2,HC.S0
MOVEI R,1 ;TREAT AS LOW SEG
MOVE R,@SG.TB ;SET UP POINTER TO RC BLOCK
JRST T.1AL ;TREAT AS IF LOW SEGMENT DATA
T.1HA: MOVE R,@SG.TB ;FIXUP R FOR ABS TO HIGH
T.1H: TRNE FL,R.LSO ;WANT LOW SEG CODE ONLY
JRST T.0C ;YES, IGNORE THIS BLOCK
SUB P2,LL.S2 ;REMOVE 400000 RELOCATION OFFSET
SUB P3,LL.S2 ;SINCE THE ARE RELATIVE TO 0 NOW
CAMLE P2,HL.S2 ;RESET HIGHEST LOCATION COUNTER
MOVEM P2,HL.S2
CAMLE P2,HC.S2 ;AND HIGHEST DATA LOADED COUNTER
MOVEM P2,HC.S2
SKIPE PAG.S2 ;PAGING?
JRST T.1HP ;YES
ADD P2,HC.LB ;RELOCATE RELATIVE ADDRESS
CAMG P2,HC.AB ;FIT IN WHAT WE HAVE?
JRST T.1H1 ;YES
SUB P2,HC.AB ;GET EXTRA REQUIRED
MOVEI P1,HC.IX ;IN THIS AREA
PUSHJ P,LNKCOR## ;GET IT NOW
JRST T.1HP ;NOW IN CORE
SUB P3,LW.S2 ;INCASE CORE DUMPED FOR FIRST TIME
T.1H1: ADD P3,HC.LB
CAMLE W1,RC.HL(R) ;TEST AGAINST HIGHEST SEEN SO FAR
MOVEM W1,RC.HL(R) ;A NEW RECORD
JRST T.1DP
T.1HP: MOVE P2,W1 ;RESET USER VIRTUAL ADDRESS
SUB P2,LL.S2 ;MAKE RELATIVE TO SEGMENT START
PUSHJ P,PG.HSG## ;MAKE FULL TEST AND READ IN
JRST T.1H1 ;NOW IN CORE
E$$PTL::.ERR. (MS,.EC,V%L,L%F,S%F,PTL,<Program too long>)
.ETC. (JMP,,,,,.ETIMF##) ;[1204]
;HERE IF FIRST WORD IS A SYMBOL
;SECOND WORD IS OFFSET
T.1S: MOVE W2,W1 ;EXPECTED IN W2
LDB T2,[POINT 4,W2,3] ;CHECK CODE NOT JUST SIGN BIT
CAIE T2,14 ;MUST BE RADIX50 60,
JRST E$$IRB## ;[1174] GIVE ERROR MESSAGE
PUSHJ P,R50T6 ;SIXBITIZE IT
MOVX W1,PT.SGN!PT.SYM!PS.GLB ;SET SOME REASONABLE FLAGS
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST T.1ND ;NOT EVEN IN TABLE
JRST T.1UN ;UNDEFINED, SO STILL NO USE
MOVE W2,2(P1) ;GET VALUE
IFN FTOVERLAY,<
CAMGE W2,PH.ADD ;MAKE SURE ARRAY IS IN THIS LINK
JRST T.1SE ;NO, MUST BE COMMON IN FATHER LINK
>
PUSHJ P,RB.1 ;READ OFFSET
JFCL ;CANNOT HAPPEN
ADD W1,W2 ;GET START ADDRESS IN W1
SOJA W3,CPOPJ ;ONE LESS REAL DATA WORD
IFN FTOVERLAY,<
T.1SE: MOVE W2,1(P1) ;ITS NOT, GET NAME
AOS W3,LNKMAX ;POINT TO RIGHT LINK
E$$DSC::.ERR. (MS,.EC,V%L,L%F,S%F,DSC,<Data store to common >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (JMP,.EC,,,,T.1OVG)
T.1OVE: AOS W3,LNKMAX ;POINT TO RIGHT LINK
CAIGE P3,.JBDA ;MAKE ONLY A WARNING IF TO JOB DATA AREA
JRST T.1OVW ;IT WAS
E$$DSL::.ERR. (MS,.EC,V%L,L%F,S%F,DSL,<Data store to location >) ;[1174]
T.1OVF: .ETC. (OCT,.EC!.EP,,,,P3)
T.1OVG: .ETC. (STR,.EC,,,,,< not in link number >)
.ETC. (DEC,.EP!.EC,,,,W3)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
JRST T.0C ;GET RID OF BLOCK
T.1OVW: SOS LNKMAX ;PUT LINK # BACK
E01DSL::.ERR. (MS,.EC,V%L,L%F,S%W,DSL) ;[1174]
.ETC. (JMP,.EC,,,,T.1OVF)
>
;HERE IF SYMBOLIC ADDRESS NOT YET DEFINED
T.1UN: PUSHJ P,T.1FX ;PUT WHOLE BLOCK IN FIXUP TABLE
E01CNW::.ERR. (MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
.ETC. (STR,,,,,,<T.1UN+1>)
;HERE IF SYMBOL NOT EVEN IN TABLE
T.1ND: PUSHJ P,T.1FX ;PUT WHOLE BLOCK IN FIXUP TABLE
MOVEI T2,.L*2 ;NEED AT LEAST 2 TRIPLETS
PUSHJ P,GS.GET## ;IN GLOBAL AREA
MOVX W1,FP.LBT ;LOADER BLOCK TYPE
MOVEM W1,.L(T1) ;STORE FLAGS
MOVEM W3,.L+1(T1) ;AND REL POINTER
MOVX W1,PT.SGN!PT.EXT!PT.SYM!PS.REQ!PS.UDF!PS.FXP
SETZB W3,2(T1) ;ZERO VALUE
DMOVEM W1,0(T1) ;FLAGS & SYMBOL
MOVE W3,T1 ;INSERT EXPECTS POINTER IN W3
SUB W3,NAMLOC ;RELATIVE
HRRZ P1,@HT.PTR ;SETUP P1 AGAIN
ADD P1,NAMLOC
PJRST INSRT## ;AND STORE SYMBOL
;HERE TO PUT WHOLE BLOCK IN FIXUP TABLE
;W3 CONTAINS WORD COUNT -1
;BUT WE HAVE ALREADY READ
;HEADER 1,,WORD COUNT
;BYTE WORD
;FIRST DATA ITEM
;DATA IS STORED WITH ONE OVERHEAD WORD OF FLAG BITS ,, POINTER
T.1FX: MOVEI T1,1(W3) ;GET WORD COUNT BACK
IDIVI T1,^D18 ;BUT IT DOESN'T INCLUDE BYTE WORDS
IMULI T1,^D19 ;AS ONE PER SUB-BLOCK
SKIPE T2
ADDI T1,1(T2) ;PLUS ONE FOR PARTIAL BLOCK
MOVEI T2,2(T1) ;PLUS FLAGS AND HEADER
PUSHJ P,FX.GET## ;THATS WHAT WE NEED
MOVE W3,T1 ;SAVE FOR LATER FIXUP TO GLOBAL
SUB W3,FX.LB ;SO WE DON'T FORGET THAT IT'S RELATIVE
.JDDT LNKOLD,T.1FX,<<CAMN W3,$FIXUP##>> ;[632]
HRLI T1,(POINT 36,) ;EASY WITH A BYTE POINTER
MOVX W1,FP.SGN!FP.PTR ;SOME FLAGS
IDPB W1,T1 ;STORE
POP P,W1 ;RESTORE DATA COUNT
HRLI W1,1 ;FAKE HEADER UP
IDPB W1,T1
MOVE W1,RB ;GET RELOCATION BITS
LSH W1,-2 ;WE'VE ALREADY GOT ONE WORD
IDPB W1,T1
T.1FLP: PUSHJ P,D.IN1## ;READ NEXT DATA WORD
IDPB W1,T1 ;STORE IT
SOJG T2,T.1FLP ;LOOP TIL DONE
POPJ P,
SUBTTL BLOCK TYPE 2 - SYMBOLS
; ----------------
; ! 2 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! SYMBOL !
; ----------------
; ! VALUE !
; ----------------
;READS A PAIR OF WORDS IN W1 AND W2
;CONVERTS THEN TO NEW TRIPLET FORM IN W1, W2, AND W3
;AND CHANGES RADIX-50 SYMBOL IN W2 TO SIXBIT SYMBOL IN W2
T.2: PUSHJ P,RB.2 ;GET TWO WORDS
JRST LOAD## ;GET NEXT BLOCK
MOVE W3,W1 ;PUT VALUE IN W3 WHERE IT BELONGS
MOVX W1,PT.SGN!PT.SYM ;SET SYMBOL FLAGS
LDB P1,[POINT 4,W2,3] ;PICK UP LEADING 4 BITS
PUSHJ P,R50T6 ;CONVERT TO SIXBIT SYMBOL
MOVE P4,T3 ;[1213] SAVE RADIX50 SYMBOL NAME
.JDDT LNKOLD,T.2,<<CAMN W2,$SYMBOL##>>
SKIPE R ;SYMBOL RELOCATABLE?
TXO W1,PS.REL ;YES
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,@T.2STB(P1) ;YES, SEE IF NEEDED
PUSHJ P,@T.2TAB(P1) ;GET TO RIGHT ROUTINE
JRST T.2 ;RETURN FOR NEXT PAIR
;JUMP TABLE TO HANDLE CODE BITS OF RADIX-50 SYMBOL
;UNKNOWN TYPES GIVE ERROR
T.2TAB::E$$URC ;[1174] 0 - 00 NAME (SHOULD NEVER HAPPEN)
SY.GS ; 1 - 04 GLOBAL DEFINITION
SY.LS ; 2 - 10 LOCAL DEFINITION
SY.BH ; 3 - 14 BLOCK HEADER (FAIL)
E$$URC ;[1174] 4 - 20
SY.DGR ; 5 - 24 GLOBAL DEFINITION DEFERED RIGHT HALF
E$$URC ;[1174] 6 - 30
E$$URC ;[1174] 7 - 34
E$$URC ;[1174] 10 - 40
SY.GSS ;11 - 44 GLOBAL DEF. (SUPPRESSED) ! LEFT DEFERED
SY.LSS ;12 - 50 LOCAL DEF. (SUPPRESSED)
E$$URC ;[1174] 13 - 54
SY.RQ ;14 - 60 GLOBAL REQUEST
SY.DGL ;15 - 64 GLOBAL DEFERED DEF (RH) SUPP. ! LEFT HALF
E$$URC ;[1174] 16 - 70
; E$$URC ;[1174] 17 - 74
E$$URC::.ERR. (MS,.EC,V%L,L%F,S%I,URC,<Unknown radix-50 symbol code >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,P1)
.ETC. (STR,.EC,,,,,< >)
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
POPJ P, ;BUT CONTINUE
;JUMP TABLE IF SELECTIVE LOADING OF EITHER LOW OR HIGH SEGMENT
T.2STB::CPOPJ ; 0 - 00 NAME (SHOULD NEVER HAPPEN)
T.2CHK ; 1 - 04 GLOBAL DEFINITION
T.2CHK ; 2 - 10 LOCAL DEFINITION
CPOPJ ; 3 - 14 BLOCK HEADER (FAIL)
CPOPJ ; 4 - 20
T.2CHK ; 5 - 24 GLOBAL DEFINITION DEFERED RIGHT HALF
CPOPJ ; 6 - 30
CPOPJ ; 7 - 34
CPOPJ ;10 - 40
T.2CHK ;11 - 44 GLOBAL DEF. (SUPPRESSED) ! LEFT DEFERED
T.2CHK ;12 - 50 LOCAL DEF. (SUPPRESSED)
CPOPJ ;13 - 54
T.2CHK ;14 - 60 GLOBAL REQUEST
T.2CHK ;15 - 64 GLOBAL DEFERED DEF (RH) SUPP. ! LEFT HALF
CPOPJ ;16 - 70
CPOPJ ;17 - 74
T.2CHK: TXNN W1,PS.REL ;WE CAN ONLY HANDLE RELOC SYMBOLS
POPJ P, ;ALWAYS LOAD ABS ONES
PUSH P,W1 ;SAVE FLAGS
HRRZ W1,W3 ;PUT ADDRESS IN W1
PUSHJ P,CHKSEG ;SEE IF WANTED
CAIA ;YES
AOS -1(P) ;NO
POP P,W1 ;RESTORE FLAGS
POPJ P,
;CONVERTS RADIX-50 IN W2 TO SIXBIT IN W2
;ALSO USES T1, T2, T3
;CODE INLINE FOR EXTRA SPEED SINCE LINK SPENDS ABOUT 10% OF
;ITS TIME IN THIS LOOP.
XALL
R50T6:: TLZ W2,740000 ;CLEAR CODE BITS
MOVE T1,W2 ;PUT IN RIGHT AC
SETZ T3, ;START WITH ZERO
REPEAT 4,<
IDIVI T1,50 ;GET TABLE INDEX
SKIPE T2,R50TAB(T2) ;GET SIXBIT CODE
LSHC T2,-6 ;LEFT JUSTIFIED IN AC T3
CAIG T1,50 ;LAST CHARACTER LEFT?
JRST R50T6X ;LAST CHAR IN T1>
;END OF REPEAT 4
IDIVI T1,50 ;SPLIT LAST 2 CHARS IF WE GET THIS FAR
SKIPE T2,R50TAB(T2) ;GET FIFTH CHAR
LSHC T2,-6 ;STORE IT
R50T6X: SKIPE T2,R50TAB(T1) ;LAST TIME
LSHC T2,-6
EXCH W2,T3 ;[1213] PUT BACK IN W2, LEAVE R50 IN T3
POPJ P,
SALL
DEFINE R50CHR (CHR)<
IRPC CHR,<
''CHR''
>>
XALL
R50TAB: R50CHR ( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% )
SALL
SUBTTL BLOCK TYPE 2 - SYMBOLS (DEFINITION)
;HERE TO SEARCH FOR GLOBAL DEFINITION, CHECK FOR MULTIPLE DEFINITIONS
SY.GSS: TXOA W1,PS.GLB!PS.DDT ;SET SUPPRESSED GLOBAL
SY.GS:: TXO W1,PS.GLB ;SET GLOBAL FLAG
TXNN W1,PS.ENT ;IF KNOWN TO BE ENTRY SKIP SEARCH
SKIPN T1,ENTPTR ;LOAD AOBJN POINTER TO ENTRIES
JRST SYGTRY ;NONE
CAMN W2,0(T1) ;MATCH?
TXOA W1,PS.ENT ;YES, SET FLAG
AOBJN T1,.-2 ;NO, TRY NEXT
IFN FMXFOR,<
TXNE W1,PS.ENT ;ENTRY POINT
SKIPG T2,MIXFOR ;AND WANT MIXFOR FEATURE
JRST SYGTRY ;NO
SUB T1,ENTPTR ;REL POSITION IN ENTRY TABLE
ADDI T2,(T1) ;POSITION IN MIXFOR TABLE
MOVEM W3,(T2) ;STORE CORRESPONDING VALUE
POPJ P, ;AND DEFINE AT LATER DATE
>
SYGTRY:
IFN FTOVERLAY,<
SKIPE T1,BG.SCH ;ABLE TO SEARCH OTHER TABLES?
JRST SYBTRY ;YES, MUST NOT DO IT
>
PUSHJ P,TRYSYM## ;SEE IF ALREADY DEFINED
JRST SY.GS0## ;NO, PUT IT IN
JRST SY.RF## ;UNDEFINED, FILL IN REQUESTS FOR IT
CAMN W3,2(P1) ;CHECK VALUE
POPJ P, ;SAME SO ALL WELL
JRST SY.MDS## ;MULTIPLY DEFINED
IFN FTOVERLAY,<
SYBTRY: SETZM BG.SCH ;TURN OFF ABILITY
PUSHJ P,TRYSYM## ;SEE IF ALREADY DEFINED
JRST [SETOM BG.SCH ;PUT IT BACK
JRST SY.GS0##] ;NO, PUT IT IN
JRST [SETOM BG.SCH
JRST SY.RF##] ;UNDEFINED, FILL IN REQUESTS FOR IT
SETOM BG.SCH
CAMN W3,2(P1) ;CHECK VALUE
POPJ P, ;SAME SO ALL WELL
JRST SY.MDS## ;MULTIPLY DEFINED
>
;ROUTINE TO ADD CONTENTS OF W1, W2, W3 TO LOCAL SYMBOLTABLE
;ALSO USED TO PUT GLOBALS AND OTHER STUFF THERE
;CHECKS FOR DSK OVERFLOW ETC
SY.LSS: TXOA W1,PS.LCL!PS.DDT ;SET SUPPRESSED LOCAL
SY.LS: TXO W1,PS.LCL ;SET LOCAL FLAG
SETZM LSTSYM ;[1140] IN CASE WE DON'T LOAD THIS SYMBOL
TRNN FL,R.SYM ;IN LOCAL SYMBOL MODE
POPJ P, ;NO
PJRST LS.ADD## ;YES, STORE IN TABLE
SUBTTL BLOCK TYPE 2 - LOCAL BLOCK HEADER (FAIL)
;HERE IF SYMBOL IS A BLOCK HEADER
;THE VALUE IS ITS DEPTH
;STORE IN LOCAL SYMBOL TABLE ONLY
;AND LINK THROUGH PREVIOUS BLOCK HEADERS TO NAME POINTER
SY.BH: TXC W1,PT.SYM!PT.TTL!PT.BLK ;SET CORRECT FLAGS
TRNN FL,R.SYM ;IN LOCAL SYMBOL MODE
POPJ P, ;NO
SKIPN T1,FBHPTR ;ALREADY SEEN SOME BLOCK HEADERS?
HRRZ T1,NAMPTR ;NO, GET POINTER TO LOCAL SYMBOL
CAMGE T1,LW.LS ;IN CORE?
JRST SY.BHP ;[577] NO, GO GENERATE FIXUP
SUB T1,LW.LS ;GET ADDRESS IN CORE
ADD T1,LS.LB
SKIPGE T2,(T1) ;MUST BE PRIMARY
TXNN T2,PT.TTL ;AND A TITLE BLOCK
JRST E02SFU ;[1174] NO
MOVE T2,LSYM ;GET CURRENT VALUE
HRLM T2,2(T1) ;STORE PTR
MOVEM T2,FBHPTR ;CURRENT POINTER
PJRST LS.ADD## ;PUT IN TABLE
;HERE WHEN LAST ENTRY IN LOCAL BLOCK NAME CHAIN IS PAGED OUT.
;GENERATE A FIXUP AND DO THE WORK LATER.
SY.BHP: PUSH P,W3 ;[577] SAVE W3 FOR USE BELOW
MOVE T2,T1 ;[577] RH(T2) = ADDRESS TO FIX UP
HRLI T2,SPF.TB ;[577] LH(T2) = TYPE OF FIXUP
MOVE W3,LSYM ;[577] W3 = VALUE TO STORE (PTR TO NEXT)
MOVEM W3,FBHPTR ;[577] SAVE IT FOR NEXT TIME
MOVEI R,FS.SS-FX.S0 ;[577] INDICATE FIXING UP LS AREA
PUSHJ P,SY.CHP## ;[577] STORE FIXUP UNTIL LS PAGED IN
POP P,W3 ;[577] RESTORE W3 FOR LS.ADD
PJRST LS.ADD ;[577] PUT LOCAL BLOCK NAME IN SYM TABLE
SUBTTL BLOCK TYPE 2 - SYMBOLS (PARTIAL DEFINITION)
;HERE FOR "DEFINITION" WHEN SYMBOL NOT FULLY DEFINED
;USUALLY FOLLOWED BY GLOBAL REQUEST FOR SYMBOL FIXUP
;NOTE THERE IS A PROBLEM WITH CONFUSION OVER
; RIGHT HALF DEFERED AND SUPPRESSED
; AND RIGHT AND LEFT HALF DEFERED
; THESE CASES LOOK ALIKE
;THEREFORE TREAT AS RIGHT DEFERED AND SUPPRESSED
; BUT IF A LEFT HALF REQUEST FOLLOWS TURN ON LEFT HALF DEFERED ALSO
;THIS CAN ONLY CAUSE PROBLEMS IF SYMBOL IS LOCAL AND NOT LOADED
SY.DGL: TXO W1,PS.DDT ;SUPPRESS TO DDT
SY.DGR: TXO W1,PS.GLB!PS.UDR
IFN FTOVERLAY,<
PUSH P,BG.SCH ;[626] SAVE STATE OF BOUND GLOBAL SEARCH
SETZM BG.SCH ;[626] DON'T SEARCH THEM FOR THIS
> ;END OF IFN FTOVERLAY
PUSH P,P4 ;[1213] SAVE ORIGINAL SYMBOL IN RADIX50
PUSHJ P,TRYSYM## ;SEE IF IN TABLE
JRST SY.DG0 ;NO, PUT IN
JRST SY.DG1 ;ALREADY IN UNDEF TABLE
POP P,P4 ;[1213] RESTORE SYMBOL NAME IN R50 FORM
IFN FTOVERLAY,<
POP P,BG.SCH ;[626] RESTORE BOUND GLOBAL STATE
> ;END OF IFN FTOVERLAY
JRST SY.DG2 ;[1213] 2ND PARTIAL DEF, SET UP FOR CHECK
;HERE TO PUT REQUEST IN GLOBAL TABLE
;USE EXTENDED BLOCK TO HOLD PARTIAL VALUE
SY.DG0: POP P,P4 ;[1213] RESTORE RADIX 50 FORM
IFN FTOVERLAY,<
POP P,BG.SCH ;[626] RESTORE BG.SCH STATE
> ;END OF IFN FTOVERLAY
AOS USYM ;COUNT IT AS UNDEFINED
MOVEI T2,.L*2 ;NEED TWO BLOCKS TO HOLD
PUSHJ P,GS.GET## ; PARTIAL DEFINITION AND POSSIBLE CHAINED REQUEST
TXO W1,PT.EXT ;MARK AS USING EXTENDED TRIPLET
DMOVEM W1,0(T1) ;PRIMARY FLAGS & SYMBOL
SETZM 2(T1) ;NO REQUESTS YET
MOVX T2,S.LST!S.PVS ;PARTIAL VALUE MARKER
MOVEM T2,.L+0(T1) ;SECONDARY FLAGS
DMOVEM W2,.L+1(T1) ;SYMBOL AGAIN (MAY AS WELL) & PARTIAL VALUE
PUSH P,W3 ;SAVE PARTIAL VALUE
MOVE W3,T1 ;FOR EXTENDED SYMBOLS
SUB W3,NAMLOC ;W3 CONTAINS POINTER TO EXTENDED TRIPLET
PUSHJ P,INSRT## ;PUT IN GLOBAL TABLE
POP P,W3 ;MAKE PARTIAL VALUE "VALUE"
TXZ W1,PT.EXT ;ONLY ONE TRIPLET IN LS AREA
PJRST LS.ADD## ;AND PUT IN LOCAL TABLE
;HERE IF "PARTIALLY DEFINED" SYMBOL IS ALREADY IN UNDEF TABLE
;IT MAY HAVE ADDITIVE GLOBAL FIXUPS AS WELL
;COPY OLD DEF TO NEW LOCATION AND ADD SYMBOL TABLE FIXUP REQUEST
;DELETE OLD SYMBOL SPACE
SY.DG1: POP P,P4 ;[1213] RESTORE RADIX50 SYMBOL NAME
IFN FTOVERLAY,<
POP P,BG.SCH ;[626] RESTORE STATE OF BG SEARCHING
> ;END OF IFN FTOVERLAY
MOVE T1,0(P1) ;GET OLD FLAGS
TXNE T1,PS.UDF ;ANY PREVIOUS PARTIAL DEF'S?
JRST SY.DG2 ;[1213] YES, SET UP FOR COMPARE
MOVEI T1,.L ;NEED 1 EXTRA TRIPLET
PUSHJ P,SY.MOV## ;AND MOVE WHAT WE HAVE
MOVX T2,S.PVS!S.LST ;MARK AS SYMBOL FIXUP
MOVEM T2,0(T1) ;STORE FIXUP FLAG
DMOVEM W2,1(T1) ;SYMBOL NAME & PARTIAL VALUE
TXO W1,PT.EXT ;MARK AS NOW EXTENDED
IORB W1,0(P1) ;YES, SET NEW FLAGS
SUB P1,NAMLOC ;GET REL POSITION OF SYMBOL BLOCK
HRLZM P1,LSTSYM ;INCASE OTHER DEFINITION DEPENDS UPON IT
TXZ W1,PT.EXT ;ONLY 1 TRIPLET IN LOCAL TABLE
PJRST LS.ADD## ;AND PUT IN LOCAL TABLE
;HERE WHEN A DEFINED OR PARTIALLY-DEFINED SYMBOL IS PARTIALLY-DEFINED
;A SECOND TIME. WE NEED TO SET THINGS UP SO THE OLD AND NEW VALUES WILL
;BE COMPARED WHEN (AND IF) THE SECOND PARTIAL DEFINITION IS SATISFIED.
;
;TO DO THIS, MAKE A NEW SYMBOL IN THE GS AREA (BUT NOT POINTED TO BY THE
;HASH TABLE) CONTAINING A PRIMARY TRIPLET COPIED FROM THE FIRST DEFINITION,
;AND A SECONDARY S.PVS TRIPLET FROM THE NEW PARTIAL DEFINITION.
;
;IF THE OLD DEFINITION WAS ONLY A PARTIAL ONE, CREATE A SYMBOL FIXUP FROM
;THE OLD SYMBOL BLOCK TO THE NEW ONE SO THE VALUES WILL BE CHECKED WHEN
;EVERYTHING GETS DEFINED.
;
;CALLED WITH: P1/ PTR TO OLD DEFINITION
; W1-W3/ NEW DEFINITION
; P4/ SYMBOL NAME IN RADIX-50
SY.DG2: MOVX W1,PS.UDF!PS.REQ ;[1213] COPY THESE FROM THE OLD TRIPLET
AND W1,(P1) ;[1213] HERE THEY ARE
IORX W1,PT.EXT!PT.SGN!PT.SYM!PS.GLB ;[1213] USEFUL FLAGS
SUB P1,NAMLOC ;[1213] SAVE IN CASE CORE MOVES
MOVEI T2,.L*2 ;[1213] SPACE FOR NEW TRIPLET PAIR
PUSHJ P,GS.GET## ;[1213] NEW BLOCK NOW POINTED TO BY T1
ADD P1,NAMLOC ;[1213] RESTORE P1
DMOVEM W1,0(T1) ;[1213] STORE FLAGS AND NAME
TXNE W1,PS.UDF ;[1213] SYMBOL DEFINED?
TDZA T2,T2 ;[1213] NO, NO FIXUPS
MOVE T2,2(P1) ;[1213] YES, COPY VALUE FROM OLD TRIPLET
MOVEM T2,2(T1) ;[1213] STORE LAST WORD OF PRIMARY
MOVX W1,S.PVS!S.LST ;[1213] FLAGS FOR SECONDARY TRIPLET
TMOVEM W1,.L(T1) ;[1213] STORE SECONDARY TRIPLET
SUB T1,NAMLOC ;[1213] OFFSET INTO GS AREA
HRLZM T1,LSTSYM ;[1213] ARRANGE FOR SY.RQ TO FIND US
;NOW SEE IF THE ORIGINAL DEFINITION WAS A PARTIAL ONE, AND SETUP AN
;EXTRA FIXUP REQUEST POINTER IF SO.
MOVE T1,0(P1) ;[1213] RESTORE OLD SYMBOL'S FLAGS
TXNN T1,PS.UDF ;[1213] WAS IT A PARTIAL DEFINITION?
POPJ P, ;[1213] NO, DONE
AOS USYM ;[1213] YES, WE CREATED ANOTHER SYMBOL TO FIX UP
MOVX W1,PT.SGN!PT.SYM ;[1213] SOME GOOD FLAGS
MOVE W3,P4 ;[1213] SYMBOL TO FIX UP IN RADIX50 (SAME NAME)
TXO W3,R5.FXS!R5.FXA ;[1213] SOME FAKE REL FILE INPUT
PUSHJ P,SY.RQ ;[1213] SET UP THE EXTRA LINKAGE
ADD W3,FX.LB ;[1213] NOW FIND FIXUP BLOCK CREATED
MOVX T1,FS.FXR!FS.FXF!FS.MDC ;[1213] CHANGE RH FIXUP TO FULL-WORD
XORM T1,0(W3) ;[1213] AND SET FS.MDC BIT FOR SY.STF
POPJ P, ;[1213] DONE
SUBTTL BLOCK TYPE 2 - SYMBOLS (REQUEST)
;HERE IF GLOBAL REQUEST SEEN
SY.RQ:: TXO W1,PS.REQ ;SET REQUEST FLAG (BUT NOT PS.UDF)
PUSHJ P,TRYSYM ;SEE IF ALREADY IN TABLE
JRST SY.RQ0 ;NO, SO PUT IT IN
JRST SY.RU0 ;ALREADY UNDEFINED
;DEFINED, FILL IN CHAIN
;HERE TO FILL IN GLOBAL REQUEST CHAIN
SY.RC0: MOVE T2,W3 ;GET START OF CHAIN
IFN FTOVERLAY,<
IOR W1,0(P1) ;GET FLAGS
TXNN W1,PS.BGS ;FROM A BOUND LINK?
JRST .+3 ;NO
HRRZ R,R ;YES, SO NOT RELOCATABLE W.R.T. THIS LINK
TXZ W1,PS.REL
>
JUMPL W3,SY.RC1 ;ADDITIVE FIXUP?
MOVE W3,2(P1) ;NO, GET VALUE OF SYMBOL
JRST SY.CHR## ;RIGHT-HALF CHAINED FIXUP
;HERE FOR ADDITIVE FIXUP TO ALREADY DEFINED SYMBOL
;SETUP W1 WITH FIXUP FLAGS (FROM W3)
SY.RC1: TXNN W1,PS.REL ;ONLY ONE WE NOW CARE ABOUT
TDZA W1,W1 ;NOT SET
MOVX W1,FS.REL ;INCASE SYMBOL TABLE FIXUP
MOVEM W1,SYMFLG ;AND SAVE IT
TXZ W3,R5.FXA ;ALWAYS CLEAR
TXNN W3,R5.FXL ;LEFT HALF?
TXOA W1,FS.FXR ;NO
TXO W1,FS.FXL ;YES
TXZE W3,R5.FXS ;SYMBOL FIXUP?
JRST SY.RC2 ;YES
TXZE W3,R5.FXC ;MIGHT BE RH CHAINED
TXC W1,FS.FXR!FS.FXC ;YES, CHANGE FLAGS
JRST SY.AD0## ;JUST CODE
SY.RC2: TXO W1,FS.FXS ;YES, SET FLAG
; JRST SY.ADS ;FALL INTO CODE
;HERE FOR SYMBOL TABLE FIXUP
SY.ADS: MOVE W2,W3 ;PUT REQUESTED SYMBOL IN W2
PUSHJ P,R50T6 ;CONVERT TO SIXBIT
.JDDT LNKOLD,SY.ADS,<<CAMN W2,$SYMBOL>>
MOVE W3,W2 ;EXPECTED IN W3
PUSHJ P,SY.RLS## ;REQUESTING LAST SYMBOL?
POPJ P, ;NO, ASSUME NON-LOADED LOCAL
;T1 = ADDRESS IN LOCAL TABLE
;T2 = ADDRESS IN GLOBAL TABLE
MOVX T3,PS.UDR ;ASSUME RIGHT HALF FIXUP
TXNE W1,FS.FXL ;LEFT HALF FIXUP?
TXC T3,PS.UDF ;CHANGE TO PS.UDL
TXNE W1,FS.FXF ;BUT IF FULL WORD
MOVX T3,PS.UDF ;CLEARS BOTH
JUMPE T1,SYADS0 ;CLEAR FLAG IN LOCAL TABLE IF THERE
ANDCAM T3,0(T1) ;CLEAR FLAG IN MEMORY, SET IN ACC
SKIPE T4,SYMFLG ;AND EXTRA FLAGS TO SET
IORM T4,0(T1) ;PS.REL USUALLY
SYADS0: JUMPE T2,SYADS1 ;SAME FOR GLOBAL TABLE
ANDCAM T3,0(T2) ;IF SET
SKIPE T4,SYMFLG
IORM T4,0(T2) ;AND EXTRA FLAGS
SYADS1: JUMPE T1,SYADSG ;NO LOCAL, ONLY GLOBAL
PUSH P,W1 ;SAVE FIXUP FLAGS
PUSH P,T2 ;SAVE T2
MOVE T2,W1 ;PUT FLAGS IN T2
DMOVE W1,0(T1) ;GET FLAGS & SYMBOL WE NOW CARE ABOUT
HRR W3,2(P1) ;GET HALF WORD FIXUP VALUE
;FROM DEFINED SYMBOL
PUSHJ P,SY.AST## ;FIXUP EITHER RH OR LH OF SYMBOL IN T1
POP P,T2 ;RESTORE IT
POP P,W1 ;AND FIXUP FLAGS
SYADSG: JUMPE T2,CPOPJ ;NOT GLOBAL, RETURN
;HERE ON A GLOBAL SYMBOL
PUSH P,W1 ;STORE FLAGS UNTIL P1/P2 SETUP
DMOVE W1,0(T2) ;FLAGS & SYMBOL
HRRZ W3,2(P1) ;HALF WORD VALUE
TXNN W1,PT.EXT ;EXTENDED SYMBOL?
JRST SYADSS ;NO
MOVE T1,.L(T2) ;YES, BUT WE ONLY CARE ABOUT LONG NAMES HERE
TXNE T1,S.SYM
TXNN T1,S.LNM ;SO IGNORE COMMON, ETC
JRST [TXZ W1,PT.EXT ;NOT EXTENDED NAME
JRST SYADSS] ;SO REMOVE FLAG
IFE .EXSYM,<
;[1174] Replace @SYADSS-2L DZN 1-Jun-79
E01ESN::.ERR. (MS,,V%L,L%F,S%F,ESN) ;[1174]
>
HRRZ W3,T2 ;POINT TO SYMBOL
SYADSS: PUSHJ P,TRYSYM## ;SETUP P1 & P2
HALT ;MUST BE DEFINED
JFCL
MOVE T1,P1 ;POINT TO SYMBOL TRIPLET
POP P,T2 ;FIXUP FLAGS
PJRST SY.AS0## ;GO DO THE VALUE FIXUP
;AND ANY CHAINING DEPENDING UPON THIS SYMBOL
SUBTTL BLOCK TYPE 2 - SYMBOLS (UNKNOWN REQUEST)
;HERE FOR GLOBAL SYMBOL SEEN FOR FIRST TIME
SY.RQ0: AOS USYM ;COUNT ONE MORE
TXZ W1,PS.REL ;CLEAR - WON'T KNOW TILL DEFINED
JUMPGE W3,INSRT## ;JUMP IF NON-ADDITIVE GLOBAL
;AND JUST ENTER IN GLOBAL TABLE
;HERE FOR ADDITIVE GLOBAL REQUEST
;FOR SYMBOL NOT YET IN GLOBAL SYMBOL TABLE
;REQUEST MUST BE DEFERED UNTIL SYMBOL IS DEFINED
;PUT SYMBOL IN TABLE WITH REQUEST BIT ON AND ZERO VALUE
;AND PUT GLOBAL REQUEST POINTER IN EXTENDED TRIPLET
;VALUE POINTS TO FIXUP TABLE
;PUT ACTUAL FIXUP REQUEST IN FIXUP AREA AND CHAIN ALL REQUESTS TO
;TOGETHER, SINCE THIS IS FIRST SET POINTER TO ZERO
SY.RQ1: PUSH P,W1 ;SAVE PRIMARY FLAGS
PUSHJ P,SY.RQF ;SET FLAGS IN W1 FROM W3
JRST SY.RQ2 ;NOT SYMBOL TABLE FIXUP
PUSHJ P,SY.RQS ;CONVERT SYMBOL REQUEST TO POINTER
JRST [SOS USYM ;NON LOADED LOCAL
POP P,W1 ;RESTORE W1
POPJ P,] ;REDUCE COUNT AND IGNORE
SY.RQ2: PUSH P,[0] ;VALUE OF REQUEST (PRIMARY)
PUSHJ P,SY.FX0## ;PUT IN FIXUP TABLE
MOVX W1,S.FXP ;EXTENDED TRIPLET FLAG
PUSHJ P,GS.FX0## ;LINK FIXUP TO GLOBAL SYMBOL
POPJ P,
;HERE TO SET FLAGS IN W1 FROM BITS IN W3
;CLEARS BITS 0-3 OF W3
;CALLED BY
; MOVE W3,REQUEST
; PUSHJ P,ST.RQF
;
;RETURNS
;+1 NORMAL ADDITIVE GLOBAL
;+2 SYMBOL TABLE FIXUP
SY.RQF: MOVX W1,FP.SGN!FP.SYM!FP.PTR
TXZ W3,R5.FXA ;CLEAR ADDITIVE FIXUP BIT ALWAYS
TXZE W3,R5.FXL ;LEFT HALF FIXUP?
TXOA W1,FS.FXL ;YES
TXO W1,FS.FXR ;NO, MUST BE RIGHT HALF
TXZE W3,R5.FXS ;SYMBOL TABLE FIXUP?
JRST [TXO W1,FS.FXS ;YES, SET FLAG
JRST CPOPJ1] ;RETURN +2
TXZE W3,R5.FXC ;MIGHT BE RH CHAINED
TXC W1,FS.FXR!FS.FXC ;YES, CHANGE FLAGS
POPJ P, ;RETURN +1
;HERE TO CHANGE RADIX50 SYMBOL TABLE FIXUP REQUEST INTO A POINTER
;CALLED BY
; MOVE W3,RADIX-50 SYMBOL
; PUSHJ P,SY.RQS
;RETURNS
;+1 SYMBOL NOT REQUIRED (NON-LOADED LOCAL)
;+2 W3 IS POINTER (LSTSYM) TO EITHER OR BOTH GLOBAL AND LOCAL DEFINITIONS
;USES T1, T2
SY.RQS: EXCH W2,W3 ;PUT REQUESTED SYMBOL IN W2
PUSHJ P,R50T6 ;SIXBITIZE
.JDDT LNKOLD,SY.RQS,<<CAMN W2,$SYMBOL##>>
EXCH W2,W3 ;PUT THEM BACK
PUSHJ P,SY.RLS## ;ARE WE REQUESTING LAST SYMBOL?
POPJ P, ;ASSUME NON-LOADED LOCAL
JUMPE T2,CPOPJ1 ;NOT A GLOBAL IF T2=0
MOVX T1,PS.UDL ;SET FLAG WE COULD NOT DO BEFORE?
TXNE W1,FS.FXF!FS.FXL ;[612] REQUEST FIX LEFT HALF?
IORM T1,0(T2) ;[612] YES, IT MUST BE UNDEFINED
JRST CPOPJ1 ;AND STORE REQUEST
SUBTTL BLOCK TYPE 2 - SYMBOLS (UNDEFINED REQUEST)
SY.RU0: JUMPE W3,CPOPJ ;DUMMY REQUEST JUST IGNORE
JUMPL W3,SY.RUA ;ADDITIVE GLOBAL REQUEST?
HRRZ T3,W3 ;START OF CURRENT CHAIN
HRRZ T1,2(P1) ;START OF PREVIOUS CHAIN
MOVEM W3,2(P1) ;SAVE NEW ADDRESS AS VALUE
JUMPE T1,CPOPJ ;JUST DUMMY REQUEST IF ZERO
;FALL INTO SY.RU1 TO ADD CHAINS
SY.RU1::CAMLE T1,T3 ;[707] FIRST CHAIN COME BEFORE THE NEW CHAIN?
JRST SY.PGU ;[707] NO, KEEP THEM SEPARATE
SY.RU2: HRRZ T2,T3 ;[707] GET NEXT LINK
PUSHJ P,SEGCHK## ;SETUP ADDRESS FOR CORRECT SEGMENT
JRST SY.PGU ;NOT ALL OF CHAIN IN CURRENT WINDOW
HRRZ T3,(T2) ;GET NEXT ADDRESS
JUMPN T3,SY.RU2 ;[707] NOT FINISHED YET
HRRM T1,(T2) ;STORE OTHER CHAIN OVER 0
POPJ P,
;HERE WHEN TRYING TO COMBINE TWO GLOBAL REQUEST CHAINS
; BUT WHERE NOT ALL OF CHAIN IS IN CURRENT WINDOW
; DO NOT READ IN REQUIRED WINDOW
; INSTEAD PUT OLD CHAIN IN FIXUP TABLE WITH ADDITIVE GLOBALS ETC
SY.PGU: HRRZ W3,T1 ;RESET OLD CHAIN POINTER
TXO W3,R5.FXC ;SET RIGHT HALF CHAINED BIT
; JRST SY.RUA ;HANDLE AS ADDITIVE GLOBAL
;HERE FOR ADDITIVE GLOBAL REQUEST TO SYMBOL ALREADY UNDEFINED
;IF ADDITIVE GLOBAL EXTENDED FIXUP ALREADY SEEN JUST ADD TO CHAIN
;IF NOT DELETE SIMPLE TRIPLET AND ADD EXTENDED TRIPLET
SY.RUA: MOVE W1,0(P1) ;GET FLAGS
TXNE W1,PS.FXP ;ALREADY DEFERED FIXUPS?
JRST SY.RUB ;YES, JUST ADD TO LIST
PUSH P,W1 ;SAVE PRIMARY FLAGS
PUSHJ P,SY.RQF ;SETUP W1 FROM W3
JRST .+3 ;NORMAL RETURN
PUSHJ P,SY.RQS ;SYMBOL TABLE FIXUP, SEE IF WE NEED IT
JRST SY.RUX ;RESTORE STACK AND EXIT
MOVEI T1,.L ;NEED TO EXPAND
PUSHJ P,SY.MOV## ;TO BIGGER AREA
SUB T1,NAMLOC ;INCASE WE MOVE
PUSH P,T1 ;SAVE TO FIXUP GLOBAL SYMBOL
MOVX T1,PT.EXT!PS.FXP ;MARK FIXUP IN PRIMARY
IORM T1,0(P1) ;SO WE KNOW TO EXPECT ADDITIVE GLOBALS
PUSHJ P,SY.FX0## ;PUT REQUEST IN FIXUP TABLE
MOVX W1,S.LST!S.FXP ;SECONDARY FLAGS
POP P,T1
ADD T1,NAMLOC ;FIX IT
TMOVEM W1,0(T1) ;PARTIAL VALUE TRIPLET
SY.RUX: POP P,W1 ;RESTORE W1 (GET STACK BACK IN SHAPE)
POPJ P,
;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN
SY.RUB: MOVEI T1,0(P1) ;GET PRIMARY TRIPLET
SY.RUC: ADDI T1,.L ;GET NEXT TRIPLET
SKIPG W1,0(T1) ;GET SECONDARY FLAGS
JRST E02CNW ;[1174] NOT THE RIGHT SORT OF EXTENDED TRIPLET
TXNN W1,S.FXP ;IS THIS THE ONE
JRST SY.RUC ;NO TRY AGAIN
MOVE P1,T1 ;SAFE TO POINT TO IT NOW
PUSHJ P,SY.RQF ;SETUP LH OF W1
JRST .+3 ;NORMAL RETURN
PUSHJ P,SY.RQS ;SYMBOL TABKE FIXUP, CONVERT TO POINTER
POPJ P, ;NO LOADED LOCAL, IGNORE
HRR W1,2(P1) ;GET LINK
SUB P1,NAMLOC ;INCASE AREA MOVES
PUSHJ P,SY.FX0## ;PUT IN FIXUP AREA
ADD P1,NAMLOC ;RELOCATE IT
HRRM W3,2(P1) ;FIXUP REQUEST POINTER CHAIN
POPJ P,
;HERE IF THERE IS NOT A FIXUP REQUEST SECONDARY TRIPLET
;JUST EXPAND AS IF NO EXTENDED TRIPLETS
E02CNW::.ERR. (MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
.ETC. (STR,,,,,,<SY.RUH>)
SUBTTL BLOCK TYPE 3 - HIGH SEGMENT INDICATOR
; ----------------
; ! 3 ! 1 !
; ----------------
; ! BYTE WORD !
; ----------------
; ! HIGH ! HIORG !
; ----------------
; ! LOW ! LOORG !
; ----------------
T.3:
IFN FTOVERLAY,<
TRNN FL,R.FLS ;[1115] NOT FORCING INTO LOW SEG?
SKIPGE LNKMAX ;[1115] AND NOT ROOT LINK?
JRST T.3C ;[1115] NO
E$$HCL::.ERR. (MS,.EC,V%L,L%F,S%F,HCL,<High segment code not allowed in an overlay link>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
T.3C:
> ;END OF IFN FTOVERLAY
HRRZ W2,W1 ;GET WORD COUNT
PUSHJ P,D.IN1## ;GET A WORD (RELOCATION BYTES)
PUSHJ P,D.IN1## ;GET DATA WORD
SOJE W2,.+4 ;DONE UNLESS FORTRAN-10
MOVE W2,W1 ;SAVE HIGH SEG BREAK AND OFFSET
PUSHJ P,D.IN1## ;GET LOW SEG BREAK
EXCH W1,W2 ;PUT HIGH BACK WHERE EXPECTED
TLNN W1,-1 ;TEST FOR LEFT HALF SET
JRST T.3B ;HISEG PSEUDO-OP IF 0,,400000
TRO FL,R.TWSG ;SIGNAL TWOSEG PSEUDO-OP
TRNE FL,R.FLS!R.FHS ;ANYTHING SPECIAL TO DO?
JRST T.3RC ;YES, ADJUST RC TABLES FOR FORCED HIGH OR LOW
T.3A: PUSHJ P,SETRC ;SETUP THE RELOCATION COUNTER
MOVEI R,2 ;MAKE SURE POINTING TO HIGH SEG
MOVE R,@RC.TB
T.3N: HRLZ W3,RC.CV(R) ;SETUP CURRENT HISEG VALUE
SETO W2, ;MARK WE DON'T CARE ABT LOWSEG
; JRST T.3TTL ;GO STORE SEGMENT ORIGINS
;HERE TO STORE SEGMENT ORIGINS IN TITLE BLOCK (SEGMENT INFO).
;GENERATES A FIXUP IF BLOCK NOT IN CORE, WARNING IF NOT FOUND.
T.3TTL: HLRZ T2,NAMPTR ;GET REL ADDRESS OF NAME TRIPLET
CAMGE T2,LW.LS ;STILL IN CORE?
JRST T.3FIX ;NO
SUB T2,LW.LS
ADD T2,LS.LB ;FIX IN CORE
SKIPL T3,(T2) ;MUST BE SECONDARY
TXNN T3,S.TTL ;AND A TITLE
JRST T.3SER
TXNN T3,S.SEG ;IS THIS IT?
JRST T.3SER ;NO
AOSE W2 ;LOW SEG SPECIFIED?
HLLZM W2,1(T2) ;YES, STORE IT (AOSE KEEPS LH)
AOSE W3 ;HOW ABOUT HIGH SEG?
HLLZM W3,2(T2) ;YES, STORE IT
JRST LOAD## ;DONE
;HERE IF BLOCK PAGED OUT. GENERATE A FIXUP.
T.3FIX: HLR W3,W2 ;SETUP FIXUP AS HI,,LOW
HRLI T2,SPF.SL ;SETUP FIXUP INDEX
MOVEI R,FS.SS-FX.S0 ;POINT TO LS FIXUP
PUSHJ P,SY.CHP## ;GENERATE THE FIXUP
JRST LOAD## ;AND FLY AWAY
T.3SER: POP P,T1 ;GET STACK BACK IN ORDER
E01SFU::.ERR. (MS,0,V%L,L%I,S%I,SFU) ;[1174]
JRST LOAD## ;TRY TO CONTINUE
;HERE FROM HISEG PSEUDO-OP
;TEST IF TWO SEGMENTS ALLOWED (IGNORE IF NOT)
;IF YES, SWAP HIGH AND LOW RELOC COUNTERS
T.3B: TRNE FL,R.FLS ;FORCED LOW SEG?
JRST LOAD## ;YES, JUST USE RC 1
TRO FL,R.FHS ;NO, ALLOW 2 (SET FLAG AND DO IT LATER)
PUSHJ P,SETRC ;SET 2ND RELOC COUNTER
TRNN FL,R.FHS!R.FLS ;NEED TO ADJUST RELOC COUNTERS
JRST LOAD## ;NO, JUST RETURN
MOVEI R,1 ;SET RELOC LOW
MOVE T1,SG.TB+2 ;GET ADDRESS OF 2ND SEGMENT
MOVEM T1,@RC.TB ;AND STORE IN RELOC 1
MOVE R,@RC.TB ;RESET R TO POINT TO RC BLOCK
HRLZ W3,RC.CV(R) ;SETUP CURRENT HISEG VALUE
MOVE R,SG.TB+1 ;GET LOWSEG BLOCK
HRLZ W2,RC.CV(R) ;AND CURRENT LOWSEG VALUE
JRST T.3TTL ;GO STORE OR GENERATE FIXUP
;NOTE WE HAVE ALREADY TAKEN CARE OF FORCED HIGH BY SWAPPING
;RC1 AND RC2 AT T.6RC
T.3RC: HLRZ T1,W1 ;GET LENGTH OF HIGH SEGMENT CODE
SUBI T1,(W1) ;FROM BREAK - ORIGIN
SKIPE DCBUF ;IF PRESCANED, LENGTH IS
; KNOWN (MAY BE ZERO).
JUMPE T1,T.3TST ;NOT AVAILABLE, CANNOT LOAD AS SPECIFIED
HRRZM W1,SO.S2 ;OFFSET FOR RELOCATION
MOVEI T2,RC.INC ;NEED SPACE FOR TEMP RC BLOCK
PUSHJ P,DY.GET##
TRNE FL,R.FHS ;FORCED HIGH?
JRST T.3RC2 ;YES
T.3RC1: MOVEI R,2 ;PUT IN SLOT #2
HRLM R,LL.S2 ;SET ORIGIN GREATER THAN 256K
MOVEM T1,@RC.TB ;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
HRLZ T2,SG.TB+1 ;COPY .LOW.
HRR T2,T1 ;TO SLOT #2
BLT T2,RC.INC-1(T1)
MOVE T2,LL.S2 ;ADD HISEG OFFSET
ADDM T2,RC.IV(T1) ;TO HIGH COUNTERS
ADDM T2,RC.CV(T1)
MOVE T1,SG.TB+1 ;NOW MODIFY RC #1
HLRZ T2,W1 ;BY LENGTH OF HIGH SEG
SUBI T2,(W1)
ADDM T2,RC.CV(T1) ;SO WE LOAD IN CORRECT PLACE
;NOTE THIS SHOULD REALLY BE IN RC.OF
;BUT IT SAVES TIME AT RB.1 TO DO
;IT THIS WAY SINCE FORCED LOADING IS THE SPECIAL CASE
MOVE R,@RC.TB ;AND TO RELOCATION BLOCK
MOVE T2,RC.CV(R) ;GET CURRENT "HIGH" RELOCATION
SUB T2,LL.S2 ;REMOVE HISEG ORIGIN
HRLZ W3,T2 ;SO MAP COMES OUT RIGHT
MOVEI R,1 ;ALSO "LOW" COUNTER IS TOO SMALL
MOVE R,@RC.TB ;SINCE LOW CODE IS ON TOP OF HIGH
HRLZ W2,RC.CV(R) ;REPLACE VALUE SETUP AT T.6
JRST T.3TTL ;GO STORE W2 AND W3
T.3RC2: MOVEI R,1 ;PUT IN SLOT #1
MOVEM T1,@RC.TB ;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
HRLZ T2,SG.TB+2 ;COPY .HIGH.
HRR T2,T1 ;TO SLOT #1
BLT T2,RC.INC-1(T1)
HLRZ T2,W1 ;BY LENGTH OF HIGH SEG
SUBI T2,(W1)
ADDM T2,RC.CV(T1) ;SO WE LOAD IN CORRECT PLACE
MOVN T2,LL.S2 ;REMOVE HIGH SEG OFFSET
ADDM T2,RC.IV(T1)
ADDM T2,RC.CV(T1) ;FROM LOW COUNTERS
MOVE R,@RC.TB ;AND TO RELOCATION BLOCK
MOVE T2,RC.CV(R) ;GET CURRENT "LOW" RELOCATION
ADD T2,LL.S2 ;PUT BACK HISEG ORIGIN
HRLZ W2,T2 ;SO MAP COMES OUT RIGHT
SETO W3, ;NOT CHANGING HI-SEG
JRST T.3TTL ; GO STORE CHANGES
T.3TST: HLRZ T1,W2 ;CHECK FORLENGTH OF LOW SEGMENT
SUBI T1,(W2) ;FROM FORTRAN-10
JUMPG T1,T.3L ;YES
JRST T3HOLD## ;LOAD IT INTO FX CORE UNTIL
;HERE IF LOW SEGMENT LENGTH GIVEN (FORTRAN-10)
;LOAD HIGH SEG ON TOP OF LOW SEG
T.3L: HLRZ T1,W2 ;GET LOW SEG LENGTH
CAIL T1,(W1) ;IS LENGTH LESS THAN HISEG ORIGIN?
PUSHJ P,E$$HSL ;[1174] NO, GIVE FATAL ERROR
HRRZM W1,SO.S2 ;OFFSET FOR RELOCATION
MOVEI T2,RC.INC ;NEED SPACE FOR TEMP RC BLOCK
PUSHJ P,DY.GET##
TRNE FL,R.FHS ;FORCED HIGH?
JRST T.3L2 ;YES
T.3L1: MOVEI R,2 ;PUT IN SLOT #2
HRLM R,LL.S2 ;SET ORIGIN GREATER THAN 256K
MOVEM T1,@RC.TB ;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
HRLZ T2,SG.TB+1 ;COPY .LOW.
HRR T2,T1 ;TO SLOT #2
BLT T2,RC.INC-1(T1)
MOVE T2,LL.S2
ADDM T2,RC.IV(T1)
ADDM T2,RC.CV(T1) ;HIGH COUNTERS HAVE OFFSET
HLRZ T2,W2 ;MODIFY RC #2 BY LENGTH OF LOW SEG
SUBI T2,(W2)
ADDM T2,RC.CV(T1) ;SO WE LOAD IN CORRECT PLACE
;NOTE THIS SHOULD REALLY BE IN RC.OF
;BUT IT SAVES TIME AT RB.1 TO DO
;IT THIS WAY SINCE FORCED LOADING IS THE SPECIAL CASE
MOVE R,@RC.TB ;AND TO RELOCATION BLOCK
MOVE T2,RC.CV(R) ;GET CURRENT "HIGH" RELOCATION
SUB T2,LL.S2 ;REMOVE HISEG ORIGIN
HRLZ W3,T2 ;SO MAP COMES OUT RIGHT
SETO W2, ;NOT CHANGING LOWSEG
JRST T.3TTL ;GO UPDATE TITLE BLOCK
T.3L2: MOVEI R,1 ;PUT IN SLOT #1
MOVEM T1,@RC.TB ;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
HRLZ T2,SG.TB+2 ;COPY .HIGH.
HRR T2,T1 ;TO SLOT #1
BLT T2,RC.INC-1(T1)
MOVN T2,LL.S2 ;REMOVE OFFSET FROM RC #1
ADDM T2,RC.IV(T1)
ADDM T2,RC.CV(T1)
MOVE T1,SG.TB+2 ;NOW MODIFY RC #2
HLRZ T2,W2 ;BY LENGTH OF HIGH SEG
SUBI T2,(W2)
ADDM T2,RC.CV(T1) ;SO WE LOAD IN CORRECT PLACE
MOVEI R,2 ;FOR HIGH SEGMENT RELOCATION
MOVE R,@RC.TB ;AND TO RELOCATION BLOCK
HRLZ W3,RC.CV(R) ;GET LOW RELOCATION FOR MAP
SETO W2, ;NOT CHANGING REAL LOWESEG
JRST T.3TTL ;RECORD CHANGES
;HERE TO SET HIGH SEG RELOC COUNTER (.HIGH.)
;CALLED BY
; MOVE W1,ORG OF HIGH SEG (0 FOR DEFAULT 400000)
; PUSHJ P,SETRC
;ALWAYS RETURNS .+1
SETRC:: HRRZ W1,W1 ;CLEAR HIGH SEG SIZE (IF GIVEN)
SKIPN W1 ;SKIP IF ADDRESS GIVEN
MOVEI W1,400000 ;ASSUME 400000 IF NOT
ANDCM. W1,.PGSIZ ;SET ON PAGE BOUND
MOVEM W1,SO.S2 ;STORE SOFTWARE ORIGIN
MOVEI R,1 ;SET R FOR LOW SEGMENT
MOVE R,@SG.TB ;GET BLOCK POINTER
SKIPE LL.S2 ;HAVE WE ALREADY SETUP SEG ORIGIN?
POPJ P, ;YES, JUST RETURN
CAMG W1,RC.CV(R) ;BUT MUST BE HIGHER THAN LOW SEG
JRST E$$HSL ;[1174] TOO LOW
MOVEI T1,.JBHDA ;[1170] SIZE OF VESTIGIAL JOBDAT
MOVEM T1,HC.S2 ;[1170] STORE IN CASE NOTHING ELSE LOADED
MOVEM W1,LL.S2 ;FOR INPUT ROUTINE ONLY
MOVEI T2,RC.INC ;HERE TO ALLOCATE SPACE FOR RC BLOCK
PUSHJ P,DY.GET## ;IN DYNAMIC AREA
MOVEI R,2 ;NOW FOR RC TABLE ENTRIES
SKIPE @RC.TB ;SLOT ALREADY OCCUPIED?
JSP T2,SETRCX ;CLEAR SLOT, SAVE OCCUPANT FOR LATER
MOVEM T1,@RC.TB ;GET POINTER INTO TABLE
MOVEM T1,@SG.TB
MOVE R,T1 ;SAFER PLACE FOR POINTER
AOS RC.NO ;COUNT ONE MORE
SOS RC.FRE ;AND ONE LESS HOLE
MOVEM W1,RC.IV(R) ;START OF RELOCATION
MOVE T2,['.HIGH.'] ;NAME
MOVEM T2,RC.NM(R)
ADDI W1,.JBHDA ;DON'T FORGET HIGH JOBDATA AREA
MOVEM W1,RC.CV(R) ;AS CURRENT RC
MOVEM W1,RC.HL(R) ;[1132] CONSIDER THESE TO BE LOADED
MOVEI T1,2 ;SEGMENT NUMBER
MOVEM T1,RC.SG(R) ;IN TABLE SO WE KNOW WHERE IT IS
SETZM RC.OF(R) ;ZERO RELATIVE TO HC.LB
MOVEI T1,HC.LB
MOVEM T1,RC.LB(R)
MOVEI T1,LW.S2 ;ADDRESS OF LOWER WINDOW
MOVEM T1,RC.WD(R)
MOVEI T1,UW.S2 ;ADDRESS OF UPPER WINDOW
MOVEM T1,RC.PG(R) ;NON-ZERO IF PAGING
JRST T.3AA ;NOW SETUP HC AREA
;HERE IF DESIRED RC SLOT IS NOT FREE
;STACK CURRENT CONTENTS AND RETURN
;FIND NEW PLACE FOR CURRENT OCCUPANT LATER
SETRCX: PUSH P,@RC.TB ;STACK CURRENT OCCUPANT
PUSH P,[SETRCY] ;RET ADDRESS TO STORE ABOVE RC POINTER
JRSTF (T2) ;RETURN
SETRCY: SOSGE RC.FRE ;ANY FREE SPACE?
PUSHJ P,.SETEX## ;NO, MUST EXPAND
MOVE R,RC.NO ;[753] GET NUMBER
POP P,@RC.TB ;STORE IT
POPJ P, ;RETURN
;NOW TO SETUP HC AREA IF NOT DONE YET
T.3AA: MOVE T1,LC.UB ;TOP OF WHAT WE HAVE
SUB T1,LC.AB ;GIVES FREE SPACE THERE
CAIL T1,2*.IPS ;NEED AT LEAST THIS
JRST T.3AB ;GOT IT
MOVEI P2,2*.IPS ;NO, SO GET IT
MOVEI P1,LC.IX ;IN LOW SEG AREA
PUSHJ P,LNKCOR##
PUSHJ P,E$$MEF## ;[1174]
MOVNI T1,2*.IPS ;BUT LC.AB WAS INCREMENTED
ADDM T1,LC.AB ;SO PUT IT BACK AS IT WAS
ADDM T1,LC.FR ;AND FREE SPACE THERE
JRST T.3AA ;TRY AGAIN
T.3AB: LSH T1,-1 ;[650] SPLIT EXTRA ROOM BETWEEN LC & HC
ANDCMI T1,.IPM ;[650] BUT MAKE SURE AN EVEN PAGE
MOVE T3,LC.AB ;WE NEED THIS MUCH
ADDB T3,T1 ;PLUS HALF OF WHATS SPARE
MOVEI T2,1(T3) ;GET NEXT LOCATION
EXCH T3,LC.UB ;FOR UPPER BOUND
MOVEM T2,HC.LB ;FOR NEW LOWER BOUND
MOVEM T3,HC.UB ;FOR UPPER
ADDI T2,.IPM ;NEED SPACE FOR .JBHDA
MOVEM T2,HC.AB ;SO RESERVE IT
IFN TOPS20&FTFORK,<
MOVE 1,LL.S2 ;ORIGIN ADDRESS
LSH 1,-9 ;IN PAGE #
HRL 1,HC.FRK ;SOURCE FORK IS INFERIOR ONE
MOVE 2,HC.LB
LSH 2,-9 ;DESTINATION PAGE
HRLI 2,(1B0) ;CURRENT FORK
SETZ 3,
PMAP
>
POPJ P, ;RETURN
E$$HSL::.ERR. (MS,.EC,V%L,L%F,S%F,HSL,<Attempt to set high segment origin too low>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SUBTTL BLOCK TYPE 4 - ENTRIES
; ----------------
; ! 4 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! SYMBOLS !
; ----------------
T.4:
IFN FTOVERLAY,<
PUSH P,BG.SCH ;SAVE CURRENT STATE OF NOUNVS
SETZM BG.SCH ;DON'T SEARCH BOUND GLOBALS
> ;END IFN FTOVERLAY
MOVEI T2,0(W1) ;GET NUMBER OF ENTRIES IN THIS MODULE
JUMPE T2,T.4A ;IGNORE 0 ENTRIES
SKIPN ENTPTR ;ALREADY SOME ENTRIES FOR THIS MODULE?
JRST T.4E ;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 T.4D
T.4E: 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
T.4D: HRLI W3,(POINT 36) ;SO USE AS DEPOSIT BYTE POINTER
TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE
JRST T.4B ;NO, JUST STORE SYMBOLS FOR LATER
T.4A: PUSHJ P,RB.1 ;READ A WORD
JRST T.4X ;END OF BLOCK
MOVE W2,W1 ;PUT SYMBOL IN 2ND WORD
SETZ W1, ;ZERO FLAGS
PUSHJ P,R50T6 ;CONVERT TO SIXBIT
IDPB W2,W3 ;STORE ENTRY
PUSHJ P,TRYSYM## ;SEE IF SYMBOL IS IN TABLE
JRST T.4A ;NO, TRY NEXT
JRST T.4C ;UNDEF, SEE IF WE NEED IT
JRST T.4A ;DEFINED, DON'T NEED THIS DEFINITION
T.4C: MOVE W1,0(P1) ;SET UP FLAGS FROM GS AREA
TXNN W1,PS.UDF ;DON'T NEED IF ALREADY PART. DEF.
TXNN W1,PS.REQ ;OR IF NEVER REQUESTED
JRST T.4A ;DON'T NEED THIS SYMBOL
TRZ FL,R.LIB!R.INC ;LOAD THIS MODULE!
T.4B: PUSHJ P,RB.1
JRST T.4X ;END OF BLOCK
MOVE W2,W1 ;PUT IN SYMBOL ACC
PUSHJ P,R50T6 ;SIXBITIZE
IDPB W2,W3 ;STORE
JRST T.4B ;LOOP
T.4X:
IFN FTOVERLAY,<
POP P,BG.SCH ;RESTORE SEARCH BG'S FLAG
> ;END IFN FTOVERLAY
JRST LOAD## ;END OF BLOCK
SUBTTL BLOCK TYPE 5 - END
; OR
; ---------------- ----------------
; ! 5 ! COUNT ! ! 5 ! COUNT !
; ---------------- ----------------
; ! BYTE WORD ! ! BYTE WORD !
; ---------------- ----------------
; ! HIGH RELOC ! ! LOW RELOC !
; ---------------- ----------------
; ! LOW RELOC ! ! ABS LOC !
; ---------------- -----------------
T.5: MOVEI T1,1 ;[1156] BREAKS ARE RELOCATABLE IN .LOW.
SKIPE RC.CUR ;[1156] SO UNLESS NOT LOADING PSECTS,
MOVEM T1,RC.CUR ;[1156] FORCE RELOCATION TO .LOW.
SKIPN POLSTK ;GIVE BACK POLISH STACK IF FINISHED
JRST T.5A
MOVEI T2,LN.PPD ;[603] LENGTH OF STACK
HRRZ T1,POLSTK ;START OF IT
ADDI T1,1 ;WAS AN IOWD
PUSHJ P,DY.RET## ;RETURN IT
SETZM POLSTK ;AVOID CONFUSION
T.5A:
IFN FMXFOR,<
SKIPG MIXFOR ;SKIP IF WE STILL HAVE FIXUP TO DO>
PUSHJ P,T.5ENT ;RETURN SPACE USED BY ENTRY STORE
PUSHJ P,RB.1 ;[1204] GET FIRST WORD
JRST [MOVEI T1,5 ;[1204] NOT THERE, ILLEGAL
JRST E$$RBS] ;[1204] GO COMPLAIN
TLNE W1,-1 ;[1210] BREAK OK IN REL FILE?
JRST E$$PBI ;[1210] NO, GO COMPLAIN
MOVE W2,LSTRRV ;[1204] GET TRUE VALUE
CAMLE W2,[1,,0] ;[1204] TOO BIG?
PUSHJ P,E$$PTL ;[1204] YES, COMPLAIN
T.5PBI: PUSHJ P,RB.1 ;[1210] GET SECOND WORD
JRST [SETZ W1, ;[1210] OK, JUST USE ZERO
JRST T.5BR] ;[1210] WE'VE GOT THE BREAKS
TLNE W1,-1 ;[1210] INVALID?
JRST E01PBI ;[1210] YES, GO COMPLAIN
MOVE W1,LSTRRV ;[1204] TRUE VALUE
CAMLE W1,[1,,0] ;[1204] LEGAL?
PUSHJ P,E$$PTL ;[1204] NO, DIE
T.5BR: SKIPE W3,LOD37 ;[1210] COBOL LOCAL SYMBOLS
;BUT IF THEY'RE LOADED
SUBI W3,3 ; REMOVE EXTRA 3 OVERHEAD WORDS
ADD W3,OWNLNG ;ADD IN ALGOL OWN BLOCK
; ADD W3,VARLNG ;ADD IN LVAR BLOCKS
SETZM LOD37 ;[1114] DONE WITH COBOL SYMBOLS
SETZM OWNLNG ;[1114] AND ALGOL OWNS
; SETZM VARLNG ;[1114] AND LVARS
T.5F40:: ;ENTRY FROM LNKF40
T.5B: TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
TRNN FL,R.TWSG ;TWO SEGMENTS?
CAIA ;NO, FORGET IT
PUSHJ P,T.5ZRO ;YES, MAKE SURE OTHER SEG IS 0 LEN
TRNE FL,R.FHS!R.FLS ;FORCED TO LOAD HIGH, OR LOW, OR HISEG PSEUDO-OP?
JRST T.5FS ;YES, SORT OUT RC TABLES
TRNE FL,R.TWSG ;TWO SEGMENTS ARE SPECIAL
JRST T.5LS ;AS THERE IS NO ABS RC COUNTER
; CAMGE W1,W2 ;SINGLE SEGMENT
T.5LSS: MOVE W1,W2 ;USE LARGER OF REL OR ABS
ADD W1,W3 ;ADD IN EXTRA OVERHEAD FROM COBOL OR ALGOL
T.5LS: MOVEI R,1 ;MAKE SURE R = LOW
MOVE R,@RC.TB
CAMGE W1,RC.HL(R) ;CHECK RELOCATION COUNTER
MOVE W1,RC.HL(R) ;USE GREATER
CAMLE W1,RC.CV(R) ;NEVER DECREASE
MOVEM W1,RC.CV(R) ;FOR NEXT FILE
MOVEM W1,RC.HL(R) ;[1132] MAKE SURE HL IS UP TO DATE TOO
CAMLE W1,HL.S1 ;AND HIGHEST ADDRESS IN THIS SEGMENT
MOVEM W1,HL.S1
TRNN FL,R.TWSG ;TWO SEGMENTS?
JRST T.5END ;GET NEXT BLOCK
T.5THS: MOVEI R,2 ;SET FOR HIGH SEG
MOVE R,@RC.TB
CAMGE W2,RC.HL(R) ;USE GREATER
MOVE W2,RC.HL(R)
CAMLE W2,RC.CV(R)
MOVEM W2,RC.CV(R) ;FOR NEXT FILE
MOVEM W2,RC.HL(R) ;[1132] MAKE SURE HL IS HIGHEST POSSIBLE
MOVE T1,W2 ;GET A COPY
SUB T1,LL.S2 ;REMOVE OFFSET
CAMLE T1,HL.S2 ;CHECK HIGHEST ADDRESS IN THIS SEGMENT
MOVEM T1,HL.S2 ; RESET
T.5END: HRRZ T1,NAMPTR ;POINTER TO START OF FILE
CAMGE T1,LW.LS ;IN CORE?
JRST T.5PAG ;NO, GENERATE FIXUP
SUB T1,LW.LS ;REMOVE OFFSET
ADD T1,LS.LB ;ADD IN BASE
SKIPGE T2,(T1) ;GET PRIMRY TRIPLET
TXNN T2,PT.TTL ;IT BETTER BE A TITLE BLOCK
JRST E02SFU ;[1174] ERROR
MOVE T2,LSYM ;POINT TO END (NEXT FILE)
HRRM T2,2(T1) ;FILL IN POINTER
T.5LP: HLRZ T1,NAMPTR ;POINTER TO START OF SEG INFO
CAMGE T1,LW.LS ;IN CORE?
JRST T.5PSG ;NO, GENERATE FIXUP
SUB T1,LW.LS ;REMOVE OFFSET
ADD T1,LS.LB ;ADD IN BASE
SKIPL T2,(T1) ;MUST BE SECONDARY
TXNN T2,S.TTL ;AND A TITLE BLOCK AT THAT
JRST E02SFU ;[1174]
TXNN T2,S.SEG ;SEG BLOCK?
JRST T.5LP ;NO
TRZN FL,R.FHS ;SLIGHT PROBLEM IF FORCED HIGH
JRST .+4 ;AND A SINGLE SEG PROG
HLRZ T2,1(T1) ;AS PC IN .LOW. IS IN HISEG
CAMGE W1,T2 ;SO UNLESS LOW PC EQUAL OR GREATER
SETZB W1,1(T1) ;ASSUME NO LOW CODE FOR THIS MODULE
HRRM W1,1(T1) ;STORE LOW
TRNN FL,R.LSO ;LOW SEGMENT ONLY LOADED?
TRNN FL,R.TWSG ;WAS THIS A TWO SEG PROG?
SETZB W2,2(T1) ;NO, CLEAR HIGH MARKER
SKIPE 2(T1) ;IF THERE WAS HIGH SEEN
HRRM W2,2(T1) ;STORE HIGH
SKIPN RC.CUR ;DOING PSECT
JRST T.5RET ;NO
MOVE T2,LSYM
MOVEM T2,2(T1)
T.5RET: SKIPE UW.LS ;ARE WE PAGING SYMBOLS?
PUSHJ P,T.5XPL ;SEE IF ANY TO GO OUT
IFN FMXFOR,<
SKIPLE MIXFOR ;NEED TO DO MIXFOR FIXUPS?
PUSHJ P,.MXFOR## ;YES>
TRZ FL,R.LOD ;DONE WITH END BLOCK NOW
SKIPN RC.CUR ;BEEN PROCESSING PSECTS?
JRST T.5PSC ;NO
MOVE R,RC.NO ;START AT END
MOVX W1,PT.SGN!PT.EXT!PT.TTL!PT.PSC ;[711] MARK BLOCK
T.5PSA: MOVE T1,@RC.TB ;RC BLOCK
MOVX T2,AT.PS ;[1132] FLAG FOR PSECT SEEN IN THIS MODULE
TDNN T2,RC.AT(T1) ;[1132] DID WE SEE THIS PSECT IN THIS MODULE?
JRST T.5PSB ;NO
ANDCAB T2,RC.AT(T1) ;[1132] CLEAR FLAG FOR NEXT TIME
MOVE W2,RC.NM(T1) ;GET NAME
HRLZ W3,RC.CV(T1) ;ORIGIN
HRR W3,RC.HL(T1) ;TOP
MOVE T3,RC.HL(T1) ;[1132] GET HIGHEST SEEN
TXNN T2,AT.OV ;[1132] OVERLAID PSECT?
CAMG T3,RC.CV(T1) ;[1132] OR LOWER THAN WHAT WE HAVE?
JRST T.5PSD ;[1132] YES, DONE UPDATE RC.CV
MOVEM T3,RC.CV(T1) ;[1132] UPDATE CV FOR NEXT MODULE
T.5PSD: PUSHJ P,LS.ADD## ;PUT IN LOCAL TABLE
MOVX W1,S.TTL!S.PSC ;RESET SECONDARY FLAGS
T.5PSB: SOJG R,T.5PSA ;LOOP
SETZM RC.CUR ;CLEAR MARKER
MOVE T1,LS.PT ;PTR TO NEXT FREE TRIPLET
SKIPL -.L(T1) ;[711] A PRIMARY?
JRST [MOVX T2,S.LST ;[711] NO, MAKE LAST TRIPLET
IORM T2,-.L(T1) ;[711]
JRST T.5PSC] ;[711]
MOVX T2,PT.EXT ;[711] YES, TURN OFF EXTENDED BIT
ANDCAM T2,-.L(T1) ;[711]
T.5PSC: SKIPE UW.LS ;ARE WE PAGIN SYMBOLS?
PUSHJ P,T.5XPL ;SEE IF ANY TO GO OUT
SKIPN DCBUF ;SPECIAL INCORE READS DONE?
JRST T5FIN## ;YES, RESET INPUT BUFFER
JRST T.LOAD## ;SEE IF IN /SEARCH OR NOT
;HERE TO RETURN SPACE USED BY ENTRY STORE
T.5ENT::SKIPN T1,ENTPTR ;ANY ENTRY SPACE TO RETURN
POPJ P, ;NO, UNUSUAL
IFN .EXSYM,< ;LONG SYMBOLS ARE STORE IN SEPARATE BLOCK
;WITH LENGTH,,POINTER IN ENTPTR TABLE
;IF LENGTH GREATER THAN 7777 WORDS HALT (FOR NOW)
MOVE P1,ENTPTR ;LOAD AOBJN POINTER IN SAFE AC
T5ENT0: MOVE T1,0(P1) ;GET SYMBOL OR POINTER
TLNE T1,770000 ;SYMBOLS ARE LEFT JUSTIFIED
JRST T5ENT1 ;SO NOT A POINTER
TLNN T1,-1 ;CHECK FOR SUPER LONG SYMBOL (GT. 7777)
HALT ;JUST IN CASE?
HLRZ T2,T1 ;GET LENGTH
HRRZ T1,T1 ;ADDRESS ONLY
PUSHJ P,DY.RET## ;GIVE IT BACK
T5ENT1: AOBJN P1,T5ENT0 ;LOOP
MOVE T1,ENTPTR ;RELOAD POINTER
>;END OF .EXSYM
HLRO T2,T1 ;GET -LENGTH
MOVM T2,T2
HRRZ T1,T1 ;ADDRESS ONLY
SETZM ENTPTR ;CLEAR
PJRST DY.RET## ;GIVE BACK AND RETURN
;Insert @ T.5ENT+23L JNG 8-May-76
;HERE TO MAKE SURE THE NON-LOADED SEGMENT IS ZERO LENGTH
T.5ZRO: TRNE FL,R.HSO ;HIGH SEG LOADED?
SKIPA R,[1] ;YES, ZERO LOW SEG
MOVEI R,2 ;NO, ZERO HI SEG
MOVE R,@RC.TB ;POINT TO RC BLOCK
MOVE T1,RC.CV(R) ;SEG BREAK (SAME AS START)
MOVE R,RC.SG(R) ;RESTORE SEGMENT NUMBER
MOVEM T1,W1-1(R) ;SET UP PROPER BREAK
POPJ P,
;HERE WHEN RELOCATION COUNTERS ARE NOT CORRECT
;IE. FORCED HIGH, FORCED LOW, OR HISEG TO HIGH SEGMENT
T.5FS: TRNE FL,R.TWSG ;DO WE REALLY HAVE 2 SEGMENTS
JRST [TRNN FL,R.FHS ;YES, SO MUST BE FORCED
JRST T.5FL ;LOW
JRST T.5FH] ;OR HIGH
TRNN FL,R.FHS ;HISEG WOULD BE FORCED HIGH
JRST T.5LSS ;SINGLE SEGMENT FORCED LOW IS SIMPLE
MOVEI R,2 ;SET FOR HIGH
MOVE T1,SG.TB+2 ;FROM SECOND
MOVEM T1,@RC.TB ;STORE HIGH WHERE IT SHOULD BE
MOVEI R,1 ;SET FOR LOW
MOVE T1,SG.TB+1 ;FROM WHERE IT IS
MOVEM T1,@RC.TB ;TO WHERE IT SHOULD BE
CAMGE W1,RC.CV(T1) ;SETUP LOWSEG BREAK IF NO REAL ABS CODE
MOVE W1,RC.CV(T1) ;SO MAP WILL SHOW ZERO LENGTH
; TRZ FL,R.FHS ;CLEAR FORCED HIGH FLAG
TRO FL,R.TWSG
JRST T.5LS ;AND TREAT AS IF 2 SEG
;HERE FOR FORCED LOW SEGMENT
;HIGH RELOC COUNTER IS INCORRECT
T.5FL: MOVEI R,2 ;POINT TO HIGH
MOVE T1,@RC.TB ;ADDRESS OF RC BLOCK
MOVEI T2,RC.INC ;LENGTH
PUSHJ P,DY.RET## ;GIVE IT BACK
MOVE T1,SG.TB+2 ;POINT TO REAL HIGH SEG BLOCK
MOVEM T1,@RC.TB ;STORE 0 OR REAL ADDRESS
MOVEI R,1 ;MAKE SURE R = LOW
MOVE R,@RC.TB
CAMGE W1,W2 ;USE WHICHEVER IS GREATER
JRST [CAMGE W2,RC.HL(R) ;CHECK RELOCATION COUNTER
MOVE W2,RC.HL(R) ;USE GREATER
CAMLE W2,RC.CV(R) ;NEVER DECREASE
MOVEM W2,RC.CV(R) ;FOR NEXT FILE
MOVEM W2,RC.HL(R) ;[1132] HIGHEST LOCATION LOADED
CAMLE W2,HL.S1 ;AND HIGHEST ADDRESS IN THIS SEGMENT
MOVEM W2,HL.S1
JRST T.5FLZ] ;GET NEXT BLOCK
CAMGE W1,RC.HL(R) ;CHECK RELOCATION COUNTER
MOVE W1,RC.HL(R) ;USE GREATER
CAMLE W1,RC.CV(R) ;NEVER DECREASE
MOVEM W1,RC.CV(R) ;FOR NEXT FILE
MOVEM W1,RC.HL(R) ;[1132] FOR LNKXIT
CAMLE W1,HL.S1 ;AND HIGHEST ADDRESS IN THIS SEGMENT
MOVEM W1,HL.S1
T.5FLZ: HRRZS LL.S2 ;CLEAR FAKE HIGH SEG ORIGIN
JRST T.5END ;GET NEXT BLOCK
;HERE FOR FORCED HIGH SEGMENT
;LOW RELOC COUNTER IS INCORRECT
T.5FH: MOVEI R,1 ;POINT TO LOW
MOVE T1,@RC.TB ;ADDRESS OF BLOCK
MOVEI T2,RC.INC ;LENGTH
PUSHJ P,DY.RET## ;GIVE IT BACK
MOVE T1,SG.TB+1 ;GET ADDRESS OF REAL LOW RC BLOCK
MOVEM T1,@RC.TB ;STORE IN RC TABLE
MOVEI R,2 ;SET FOR HIGH SEG
MOVE R,@RC.TB
CAMGE W2,W1 ;USE GREATER
JRST [CAMGE W1,RC.HL(R) ;USE GREATER
MOVE W1,RC.HL(R)
CAMLE W1,RC.CV(R)
MOVEM W1,RC.CV(R) ;FOR NEXT FILE
MOVEM W1,RC.HL(R) ;[1132] FOR LNKXIT
MOVE T1,W2 ;GET A COPY
SUB T1,LL.S2 ;REMOVE OFFSET
CAMLE T1,HL.S2 ;CHECK HIGHEST ADDRESS IN THIS SEGMENT
MOVEM T1,HL.S2 ; RESET
JRST T.5END]
CAMGE W2,RC.HL(R) ;USE GREATER
MOVE W2,RC.HL(R)
CAMLE W2,RC.CV(R)
MOVEM W2,RC.CV(R) ;FOR NEXT FILE
MOVEM W2,RC.HL(R) ;[1132] FOR LNKXIT
MOVE T1,W2 ;GET A COPY
SUB T1,LL.S2 ;REMOVE OFFSET
CAMLE T1,HL.S2 ;CHECK HIGHEST ADDRESS IN THIS SEGMENT
MOVEM T1,HL.S2 ; RESET
JRST T.5END
;HERE TO OUTPUT BOTTOM OF SYMBOL TABLE AND RETURN SPACE
;TO FREE POOL.
;WE KEEP THE LAST PARTIAL BLOCK IN CORE
T.5XPL: MOVE T1,LW.LS ;GET LOWER WINDOW PTR
MOVE T2,LSYM ;START OF NEXT PROG
ANDCMI T2,.IPM
CAMN T1,T2 ;SAME BLOCK?
POPJ P, ;YES, NOTHING TO DO
HRLZ P1,T1 ;FORM TRANS WORD
HRRI P1,-1(T2) ;FIRST,,LAST
MOVE T1,P1 ;WHERE EXPECTED
PUSHJ P,LS.OUT## ;OUTPUT WINDOW
HRRZI T1,1(P1) ;HIGHEST +1 =NEW LOWEST
SUB T1,LW.LS ;MINUS INITIAL
ADDM T1,LW.LS ;NEW INITIAL
ADD T1,LS.LB ;NEW INCORE BASE
SOJA T1,GBCK.L## ;GIVE IT TO FREE POOL
;HERE TO GENERATE TITLE BLOCK FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS
;WORD 1 BACK PTR,,FORWARD PTR
;WORD 2 INDEX,,NAMPTR (LH)
;WORD 3 LSYM
;
T.5PAG: HRRZ T2,NAMPTR ;AND REL ADDRESS IN SYMBOL TABLE
HRLI T2,SPF.TL ;INDEX
MOVE W3,LSYM ;VALUE
MOVEI R,FS.SS-FX.S0 ;SET INDEX
PUSHJ P,SY.CHP## ;PUT IN LIST
JRST T.5LP ;AND RETURN TO TRY MORE
;HERE TO GENERATE TITLE SEGMENT INFO FIXUP IN A LINKED LIST
;FORMAT OF FIXUP IS
;WORD 1 BACK PTR,,FORWARD PTR
;WORD 2 INDEX,,NAMPTR (RH)
;WORD 3 HIGH LOC,,LOW LOC
;
;ENTER WITH
;W1 = LOW LOC
;W2 = HIGH LOC
T.5PSG: TRNN FL,R.LSO ;LOW SEGMENT ONLY LOADED?
TRNN FL,R.TWSG ;WAS THIS A TWO SEG PROG?
SETZ W2, ;NO, CLEAR HIGH MARKER
HLRZ T2,NAMPTR ;REL ADDRESS IN SYMBOL TABLE
HRLI T2,SPF.SG ;INDEX
HRLZ W3,W2 ;HIGH IN LEFT
HRR W3,W1 ;LOW IN RIGHT
MOVEI R,FS.SS-FX.S0 ;SET INDEX
PUSHJ P,SY.CHP## ;PUT IN LIST
JRST T.5RET ;AND RETURN
;HERE WHEN SYMBOL TABLE FOULED UP, SHOULD NEVER HAPPEN
E02SFU::.ERR. (MS,0,V%L,L%W,S%W,SFU) ;[1174]
JRST T.5RET ;TRY TO CONTINUE
;HERE WHEN PROGRAM BREAK IS INCORRECT, ZERO BREAK AND CONTINUE
E$$PBI::.ERR. (MS,.EC,V%L,L%W,S%W,PBI,<Program break >) ;[1174]
.ETC. (OCT,.EP!.EC,,,,W1)
.ETC. (STR,.EC,,,,,< invalid>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SETZ W2, ;[1210] CLEAR AND CONTINUE
JRST T.5PBI ;[1210] GO READ SECOND WORD
E01PBI::.ERR. (MS,.EC,V%L,L%W,S%W,PBI) ;[1174]
.ETC. (OCT,.EP!.EC,,,,W1) ;[1210] TYPE INVALID BREAK
.ETC. (STR,.EC,,,,,< invalid>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SETZ W1, ;[1210] CLEAR INVALID BREAK
JRST T.5BR ;[1210] CONTINUE
SUBTTL BLOCK TYPE 6 - NAME
; ----------------
; ! 6 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! NAME !
; ----------------
; ! TYPE ! BLANK !
; ----------------
T.6: TROE FL,R.LOD ;SEE IF LAST END WAS SEEN
PUSHJ P,E$$NEB## ;[1174] NO, PREMATURE END OF MODULE
TRNE FL,R.FHS ;NEED TO ADJUST THE RELOC TABLES?
PUSHJ P,T.6RC ;YES
PUSHJ P,RB.2 ;READ THE TWO POSSIBLE WORDS
JRST [MOVEI T1,6
JRST E$$RBS] ;[1174]
PUSH P,W1 ;SAVE VALUE
PUSHJ P,R50T6 ;CONVERT NAME TO SIXBIT
TRNE FL,R.LIB!R.INC ;STILL IN /SEARCH MODE OR /INC MODE?
JRST T.6INC ;YES, SEE IF WE NEED THIS MODULE
SKIPN EXCPTR ;[563] IF ANY /EXCLUDES
SKIPE INCPTR ;[563] NO, BUT MIGHT NEED TO PURGE
;[563] ENTRY IN /INCLUDE LIST
JRST T.6EXC ;SEE IF NOT WANTED
T.6OK: TRZ FL,R.LIB!R.INC ;LOADING FOR SURE
MOVEM W2,PRGNAM ;SAVE SIXBIT NAME
MOVE T1,LSYM ;GET WORD COUNT IN SYMBOL TABLE
MOVEM T1,NAMPTR ;POINTS TO NAME
SETZM FBHPTR ;NO LOCAL BLOCKS YET
.JDDT LNKOLD,T.6OK,<<CAMN W2,$NAME>>
E$$LMN::.ERR. (MS,.EC,V%L,L%I5,S%I,LMN,<Loading module >) ;[1174]
.ETC. (SBX,.EP,,,,PRGNAM)
;HERE TO TAKE PROPER ACTION BASED ON THE CPU TYPE AND COMPILER CODE.
AOS PRGNO ;COUNT THIS PROGRAM
LDB T1,[POINT 6,(P),5] ;[1120] GET RUNNABLE CPU BITS
ANDI T1,CP.MSK ;[1120] CLEAR CPUS WE DON'T KNOW ABOUT
JUMPN T1,.+2 ;[1120] ASKED FOR NONE?
MOVEI T1,CP.MSK ;[1120] YES--MEANS ALL
HRRZM T1,CTYPE ;[1120] SAVE WITH COMPILER TYPE
ANDM T1,OKCPUS ;[1120] ENFORCE CPU FLAGS
SKIPN OKCPUS ;[1120] CAN PROG RUN AT ALL NOW?
JRST E$$CCD ;[1174] NO--CPU CONFLICT DETECTED
LDB T1,[POINT 12,(P),17] ;[1120] NOW GET PROCESSOR TYPE
HRRZS (P) ;[1120] LEAVE JUST BLANK COMMON ON STACK
CAILE T1,CT.LEN ;CHECK FOR RANGE
SETZ T1, ;[1120] MAKE IT UNKNOWN
HRLM T1,CTYPE ;[1120] SAVE COMPILER TYPE
MOVE T2,PROCSN ;[1120] GET LIST OF PROCS SEEN SO FAR
MOVE P1,T1 ;SAFE PLACE
XCT CT.NAM##(T1) ;[1120] PROC ROUTINES EXPECT MANY ACS + (P)
MOVE T1,CT.BIT##(P1) ;[1120] GET CORRESPONDING BIT
IORM T1,PROCSN ;[1120] SIGNAL WE HAVE SEEN THIS ONE
IORM T1,LIBPRC ;[1120] A NEW MODULE THIS LIBRARY PASS
JRST T.6BLK ;[1120] GO HANDLE BLANK COMMON
E$$CCD::.ERR. (MS,.EC,V%L,L%F,S%F,CCD,<CPU conflict>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE TO HANDLE BLANK COMMON ARG IN TITLE BLOCK
T.6BLK: POP P,T1 ;[1120] GET BLANK COMMON BACK
SKIPE BLCOMM ;SEEN BLANK COMMON BEFORE?
JRST T.6BC ;YES
HRROM T1,BLCOMM ;NO, SAVE IT NOW (SIGNAL COMMON SET)
JUMPE T1,T.6M ;BUT DON'T STORE SYMBOL IF NO COMMON
MOVX W1,PT.SGN!PT.EXT!PT.TTL!PT.FAK ;FAKE TITLE
MOVE W2,['BLANK-'] ;FOR BLANK COMMON
SETZ W3,
HLRZ T1,CTYPE ;SPECIAL MESSAGE FOR COBOL
CAIE T1,CT.C74
CAIN T1,CT.CBL
SALL ;OTHERWISE LITERAL IS A MESS
JRST [MOVE W2,['LIBOL-']
PUSHJ P,LS.ADD##
DMOVE W2,[SIXBIT /STATIC-AREA/]
JRST .+3]
PUSHJ P,LS.ADD##
MOVE W2,['COMMON']
MOVX W1,S.TTL
PUSHJ P,LS.ADD## ;REST OF NAME
MOVX W1,S.TTL!S.LST!S.SEG
HRRZ T1,BLCOMM ;GET LENGTH
MOVEI R,1 ;ASSUME LOW SEG FILE FOR NOW
MOVE R,@RC.TB ;PICKUP RELOCATION POINTER
HRLZ W2,RC.CV(R) ;GET CURRENT REL COUNTER
ADD T1,RC.CV(R) ;GET FINAL
HRR W2,T1 ;SO MAP CAN WORK OUT LENGTH
SETZ W3, ;NO HIGH
PUSHJ P,LS.ADD##
MOVE W2,['.COMM.'] ;NAME OF COMMON
HRL W3,BLCOMM ;LENGTH IN LEFT HALF
HRR W3,RC.CV(R) ;CURRENT VALUE
PUSHJ P,T.COMM ;TEST COMMON
JFCL ;NEVER GETS HERE
HRRZ P1,@HT.PTR ;SETUP P1 TO POINT TO SYMBOL
ADD P1,NAMLOC ;IN CORE
PUSH P,.L+2(P1) ;SAVE 2ND TRIPLET INFO
PUSH P,.L+1(P1)
PUSH P,.L+0(P1)
TMOVE W1,0(P1) ;RESET FIRST SYMBOL TRIPLET
PUSHJ P,LS.ADD## ;PUT IN LOCAL TABLE
POP P,W1 ;GET SECONDARY
POP P,W2 ;SAME NAME
POP P,W3 ;LENGTH
PUSHJ P,LS.ADD##
HRRZ T1,BLCOMM ;GET LENGTH
ADDM T1,RC.CV(R) ;AND INCREMENT RELOC COUNTER
JRST T.6M
T.6INC: PUSHJ P,INCCHK ;CHECK /INCLUDES
SKIPA ;CAN'T LOAD THIS
JRST T.6OK ;IN /INCLUDES, GO LOAD IT
TRZA FL,R.LOD ;CLEAR LOADING FLAG SINCE WERE NOT
T.6POP: TRO FL,R.LIB ;CAUSE MODULE TO BE IGNORED ON /EX
POP P,W1 ;RESTORE W1 FROM PUSH
JRST LOAD## ;AND SKIP THIS MODULE
INCCHK::HRRZ T1,INCPTR ;ANY /INCLUDES?
JUMPE T1,T6INC1 ;NO TEMPS, TRY PERMS
MOVEI T1,INCPTR ;SCAN INCLUDE TABLE
PUSHJ P,T.6SCN
JRST T6INC1 ;NOT IN TABLE
T6INC0: MOVSS INCPTR ;[563] REMOVE FROM BOTH SIDES OF LIST
JRST T6INC2
T6INC1: HLRZ T1,INCPTR ;SEE IF ANY PERMS
JUMPE T1,CPOPJ ;NO
MOVEI T1,EXCPTR ;MAKE SURE NOT IN EXCLUDE TABLE
PUSHJ P,T.6SCN ;AS IT MIGHT ALSO BE IN PERM INCLUDES
CAIA ;NO, CONTINUE SEARCH
POPJ P, ;YES, SO DON'T LOAD IT
MOVSS INCPTR ;SWAP PTR
MOVEI T1,INCPTR ;SCAN INCLUDE TABLE
PUSHJ P,T.6SCN
JRST [MOVSS INCPTR ;SWAP BACK
POPJ P,] ;NOT IN TABLE
T6INC2: MOVEI T1,INCPTR ;NOW REMOVE FROM LIST
PUSHJ P,EXCL.0## ;SO WE ONLY LOAD IT ONCE
MOVSS INCPTR ;PUT BACK
MOVEI T1,INCPTR ;NOW REMOVE FROM LIST
PUSHJ P,EXCL.0## ;SO WE ONLY LOAD IT ONCE
JRST CPOPJ1
T.6EXC: PUSHJ P,EXCCHK ;SEE IF EXCLUDED
JRST T.6POP ;YES, DON'T LOAD THIS
JRST T.6OK ;NOT EXCLUDED, GO LOAD
EXCCHK::HRRZ T1,EXCPTR ;SEE IF TEMP
JUMPE T1,T6EXC1 ;NO, TRY PERM
MOVEI T1,EXCPTR ;SEE IF IN EXCLUDE TABLE
PUSHJ P,T.6SCN
JRST T6EXC1 ;NO, LOAD IT
POPJ P, ;DON'T LOAD RETURN
T6EXC1: HLRZ T1,EXCPTR ;SEE IF TEMP
JUMPE T1,T6INC0 ;[563] NO, PURGE /INCLUDES & LOAD IT
MOVEI T1,INCPTR ;SEE IF IN LOCAL INCLUDES
PUSHJ P,T.6SCN ; BEFORE TRYING GLOB EXCLUDES
CAIA ;NO, SO CONTINUE SEARCH
JRST T6INC0 ;[563] YES, SO WE WANT IT
MOVSS EXCPTR ;SWAP
MOVEI T1,EXCPTR ;SEE IF IN EXCLUDE TABLE
PUSHJ P,T.6SCN
JRST [MOVSS EXCPTR ;PUT BACK
JRST T6INC0] ;[563] NO, LOAD IT
MOVSS EXCPTR ;SWAP BACK
POPJ P, ;DON'T LOAD RETURN
T.6SCN: HRRZ T1,(T1) ;GET POINTER
JUMPE T1,CPOPJ ;0 LINK IS END (OR NEVER STARTED)
ADD T1,[-.EXC+1,,1] ;FORM AOBJN POINTER
T6SCN1: SKIPN T2,(T1) ;NOT IN TABLE IF 0
POPJ P, ;FAIL RETURN
IFN .EXSYM,<
TLNN T2,770000 ;SYMBOL OR POINTER?
JRST [TLNN W2,770000 ;IS W2 A POINTER TOO?
PUSHJ P,NAMCMP## ;YES, SEE IF A MATCH
JRST .+3 ;NO, TRY NEXT
JRST CPOPJ1] ;A MATCH!
> ;END OF IFN .EXSYM
CAMN W2,T2 ;TEST
JRST CPOPJ1 ;OK RETURN
AOBJN T1,T6SCN1 ;LOOP
SUBI T1,.EXC ;BACKUP
JRST T.6SCN ;TRY NEXT
;NOW FOR SPECIAL STUFF FOR MAPS ETC
T.6M: MOVX W1,PT.SGN!PT.TTL ;SET FLAGS
MOVE W2,PRGNAM ;RECOVER NAME
SETZ W3, ;POINTER TO END
PUSHJ P,LS.ADD## ;PUT IN LOCAL SYMBOL TABLE
SETZM LSTSYM ;NOT A REAL SYMBOL SO CLEAR POINTER
PUSHJ P,TTLREL ;OUTPUT THE REL FILE INFO
MOVX W1,S.TTL!S.PRC ;OUTPUT PROCESSOR INFO
SETZ W2, ;DON'T KNOW COMPILER NAME
MOVE W3,CTYPE ;GET C. CODE,,CPU CODE
PUSHJ P,LS.ADD## ;PUT IN SYMBOL AREA
MOVX W1,S.TTL!S.CRE ;GET DATE TIME STUFF
LDB T2,[POINT 12,FCRE,35] ;GET LOW 12 BITS OF DATE
LDB T1,[POINT 3,FEXT,20] ;GET HIGH 3 BITS
DPB T1,[POINT 3,T2,23] ;MERGE THE TWO PARTS
LDB T1,[POINT 11,FCRE,23] ;GET TIME
IMULI T1,^D60 ;"MAKE GILBERT HAPPY" - HACRO
HRLZ W2,T2 ;STORE DATE IN TRIPLET
HRR W2,T1 ;FORM DATE,,TIME(SECS)
SETZ W3, ;DON'T KNOW COMPILER VERSION
PUSHJ P,LS.ADD
PUSHJ P,TTLRLC ;PUT OUT RELOCATION COUNTER INFO
IFN FMXFOR,<
HLRE T2,ENTPTR ;GET - LENGTH OF ENTRIES
MOVN T2,T2 ;POSITIVE
JUMPE T2,[HRRES MIXFOR ;RESET SWITCH
JRST LOAD##] ;AND IGNORE
SKIPLE T1,MIXFOR ;ONLY WANT IF POSITIVE ALREADY
PUSHJ P,DY.GET## ;GET TABLE SPACE
MOVEM T1,MIXFOR ;STORE POINTER
>
JRST LOAD## ;GET NEXT BLOCK
T.6BC: HRRZ T2,BLCOMM ;GET COMMON SIZE
CAIG T1,(T2) ;IS IT WITHIN SIZE OF PREVIOUS?
JRST T.6M ;GET NEXT BLOCK
E$$AIC::.ERR. (MS,.EC,V%L,L%F,S%F,AIC,<Attempt to increase size of >) ;[1174]
.ETC. (STR,.EC,,,,,<blank common>) ;[1174]
.ETAIC: .ETC. (STR,.EC,,,,,< from >) ;[1174]
.ETC. (DEC,.EC!.EP,,,,T2)
.ETC. (STR,.EC,,,,,< to >)
.ETC. (DEC,.EC!.EP,,,,T1) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE TO PUT THE REL FILE DESCRIPTOR INFO INTO THE LS AREA
TTLREL::MOVX W1,S.TTL!S.RLD ;DEV & UFD
MOVE W2,FSTR ;DEV
SKIPN W3,UFDPPN ;UFD
JRST .+3 ;NO
TLNN W3,-1 ;FOUND ONE
MOVE W3,SFDDIR ;UNLESS FULL PATH
PUSHJ P,LS.ADD
MOVX W1,S.TTL!S.RLN ;FILE NAME & EXT
MOVE W2,FNAM ;NAME
HLLZ W3,FEXT ;EXT
PUSHJ P,LS.ADD
SKIPE W3,UFDPPN ;WERE THERE SFD'S
TLNE W3,-1
POPJ P, ;NO
MOVEI R,SFDDIR+1 ;POINT TO SFD
T.6S: MOVX W1,S.TTL!S.RLS ;YES, SIGNAL SFD SEEN
DMOVE W2,(R) ;GET SFD
JUMPE W2,CPOPJ ;END IF 0
PUSHJ P,LS.ADD ;OUTPUT IT
ADDI R,2
JUMPN W3,T.6S ;AND CONTINUE
POPJ P, ;DONE, RETURN
;HERE TO OUTPUT THE SEGMENT DESCRIPTORS TO THE LS AREA
TTLRLC::MOVX W1,S.TTL!S.SEG!S.LST ;LOW/HIGH REL COUNTERS
MOVEI R,1 ;LOW SEG FIRST
MOVE R,@RC.TB ;PICKUP RELOCATION POINTER
HRLZ W2,RC.CV(R) ;CURRENT VALUE
MOVEI R,2 ;NOW FOR HIGH
SKIPN R,@RC.TB ;PICKUP RELOCATION POINTER
TDZA W3,W3 ;NO HIGH SEGMENT YET
HRLZ W3,RC.CV(R) ;CURRENT VALUE
MOVE T1,LSYM ;POINTER TO WHERE IT WILL GO
HRLM T1,NAMPTR ;STORE FOR FIXUPS
PJRST LS.ADD## ;PUT IN LS AREA AND RETURN
;HERE TO ADJUST THE RELOC TABLES FOR FORCED HIGH SEGMENT LOADING
;SET BY /SEGMENT:HIGH
T.6RC: SETZ W1, ;USE DEFAULT VALUE
SKIPN SG.TB+2 ;ALREADY HIGH SEG SETUP?
PUSHJ P,SETRC ;NO, SETUP 2ND RELOC COUNTER
MOVEI R,1 ;BUT MAKE RELOC 1 POINT TO SEG 2
MOVE T1,SG.TB+2
MOVEM T1,@RC.TB
POPJ P,
SUBTTL BLOCK TYPE 7 - STARTING ADDRESS
; ----------------
; ! 7 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! ST. ADDRESS !
; ----------------
; ! SYMBOL FIXUP !
; ----------------
T.7: TRNE FL,R.ISA ;IGNORE STARTING ADDRESSES?
JRST T.0 ;YES
PUSHJ P,RB.2 ;READ POSSIBLE TWO DATA WORDS
JRST [MOVEI T1,7
JRST E$$RBS] ;[1174]
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG ;YES, SEE IF WANTED
SKIPA T2,PRGNAM ;GET ACTUAL PROG NAME
JRST LOAD## ;NOT WANTED
MOVEM T2,STANAM ;STORE IT FOR MAP
EXCH W1,W2 ;PUT SYMBOL IN W2
JUMPGE W2,T.7A ;CHECK FOR SYMBOLIC
LDB T2,[POINT 4,W2,3] ;CHECK CODE NOT JUST SIGN BIT
MOVEI T1,7 ;BLOCK TYPE
CAIE T2,14 ;MUST BE RADIX50 60,
JRST E$$IRB## ;[1174] GIVE ERROR MESSAGE
PUSHJ P,R50T6 ;SIXBITIZE IT
PUSH P,W1 ;SAVE CONST.
MOVX W1,PT.SGN!PT.SYM!PS.GLB ;SET SOME REASONABLE FLAGS
SETZ W3, ;NO VALUE
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST T.7B ;NOT EVEN IN TABLE
JRST T.7B ;UNDEFINED, SO STORE IN 6BIT
POP P,W1 ;RESTORE CONST
ADD W1,2(P1) ;ADD VALUE
SETZ W2, ;NO SYMBOL NOW
T.7A: PUSHJ P,SET.ST ;SET STARTING ADDRESS
JRST LOAD## ;GET NEXT BLOCK
T.7B: PUSHJ P,SY.RQ ;PUT REQUEST IN SYMBOL TABLE
POP P,W1 ;RESTORE CONST.
IFN FTOVERLAY,<
DMOVEM W1,STADDR ;STORE NAME AS STARTING ADDRESS
SKIPGE LNKMAX ;ONLY IF IN ROOT
>
PUSHJ P,SET.ST ;DO REST OF STUFF
JRST LOAD## ;GET NEXT BLOCK
SET.ST::DMOVEM W1,STADDR ;STORE AS STARTING ADDRESS
MOVE T2,PRGNAM ;GET PROGRAM NAME (FROM TITLE)
CAME T2,['FORDDT'] ;TEST FOR FORTRAN DEBUGGER
CAMN T2,['ALGOBJ'] ;TEST FOR ALGOL STARTUP ROUTINE
POPJ P, ;AND IGNORE
SKIPN T2 ;IF REAL NAME IN TITLE
MOVE T2,FNAM ;OTHERWISE USE FILE NAME
MOVE T1,CTYPE ;GET CURRENT COMPILER TYPE
MOVEM T1,MNTYPE ;SAVE AS MAIN PROG TYPE
SETZB T1,LODNAM ;CLEAR INITIALLY
SKIPA T3,[POINT 6,LODNAM]
SETST0: IDPB T1,T3 ;STORE VALID CHAR
SETST1: JUMPE T2,SETST2 ;ALL DONE
SETZ T1,
LSHC T1,6 ;GET NEXT CHAR
CAIG T1,'Z' ;SEE IF ALPHA
CAIGE T1,'0'
JRST SETST1 ;NO WAY
CAIGE T1,'A' ;OK
CAIG T1,'9'
JRST SETST0 ;YES
JRST SETST1 ;NO
SETST2: MOVE T1,LODNAM ;SEE WHAT WE ENDED UP WITH
CAMN T1,['MAIN '] ;IF JUST FORTRAN OR MACRO MAIN PROG
SKIPN T1,FNAM ;USE A NON-ZERO FILE NAME INSTEAD
POPJ P, ;NO, USE WHAT WE HAVE
MOVEM T1,LODNAM ;ANYTHING IS BETTER THAN MAIN
POPJ P,
SUBTTL BLOCK TYPE 10 - LOCAL DEFINITION
; ----------------
; ! 10 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! ADDR ! VALUE !
; ----------------
T.10: PUSHJ P,RB.1 ;READ A DATA WORD
JRST LOAD## ;END OF BLOCK
CAMN W1,[-1] ;-1 IS MARKER FOR LEFT HALF FIXUP
JRST T.10L
HRRZ W3,W1 ;[565] VALUE OF SYMBOL
HLRZS T2,W1 ;[565] PUT ADDRESS IN RHS OF T2 & W1
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG ;YES, SEE IF WANTED
CAIA ;YES
JRST T.10 ;NO
IFN FTOVERLAY,<
SETZ P1, ;NOT GLOBAL SYMBOL
>
PUSHJ P,SY.CHR## ;SATISFY REQUEST
JRST T.10 ;LOOP
T.10L: PUSHJ P,RB.1 ;GET FIXUP WORD
JRST [MOVEI T1,10 ;[1174] BLOCK TYPE 10 TOO SHORT
JRST E$$RBS] ;[1174]
HRRZ W3,W1 ;[565] VALUE OF SYMBOL
HLRZS T2,W1 ;[565] PUT ADDRESS IN RHS OF T2 & W1
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG ;YES, SEE IF WANTED
CAIA ;YES
JRST T.10 ;NO
IFN FTOVERLAY,<
SETZ P1, ;NOT GLOBAL SYMBOL
>
PUSHJ P,SY.CHL## ;DO LEFT HALF CHAINING
JRST T.10
SUBTTL BLOCK TYPE 11 - POLISH FIXUPS (FAIL)
; ----------------
; ! 11 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! DATA ! DATA !
; ----------------
;THE POLISH FIXUP BLOCK IS STORED IN THE FX AREA
;THE ACTION IS :-
;(1) READ AND RELOCATE THE FIXUPS
; STORE THEM IN FX AREA
;(1A) FIND THE STORE OPERATOR, AND DELETE THE FIXUP IF
; NOT WANTED (DUE TO NON-LOADED LOCAL OR /ONLY).
;(2) CHECK AND EVALUATE GLOBAL REQUESTS
; STORE VALUES BACK IN FIXUP
;(3) IF THERE ARE NO UNDEFINED GLOBAL REQUESTS
; EVALUATE POLISH AND STORE
;(4) IF THERE ARE UNDEFINED REQUESTS
; LINK GLOBAL SYMBOL TO FIXUP AREA AND CONTINUE
;(5) WHEN LAST UNDEFINED GLOBAL IS DEFINED
; EVALUATE AND STORE
;(6) IF STORE ADDRESS IS PAGED TO DSK
; STORE BACK IN FIXUP AREA AND PROCESS AT END
;HERE TO READ BLOCK AND STORE IN FX AREA
T.11: HRRZI T2,2(W1) ;WORD COUNT
HRLZM T2,T11FA ;STORE BLOCK SIZE
PUSHJ P,FX.GET## ;GET SPACE IN FX AREA
SUB T1,FX.LB ;RELATIVE
.JDDT LNKOLD,T.11,<<CAMN T1,$FIXUP##>> ;[632]
MOVE W2,T1 ;SAFE PLACE FOR POINTER
HRRM T1,T11FA ;STORE STARTING ADDRESS
MOVEI W3,2(W2) ;BYTE POINTER TO START OF FIXUP
HRLI W3,(POINT 18)
MOVEM W3,T11BP ;STORE INITIAL BYTE POINTER
SUBI W3,1 ;W3 ALSO POINTS TO GLOBAL COUNT
HRLI W1,(FP.SGN!FP.POL) ;[612] SET POLISH FIXUP BIT
ADDI W1,2 ;ACCOUNT FOR OVERHEAD WORDS
ADD W2,FX.LB ;FIX IN CORE
ADD W3,FX.LB ;...
MOVEM W1,(W2) ;STORE HEADER WORD PLUS SYMBOLS
SETZM 1(W2) ;CLEAR GLOBAL COUNT
ADDI W2,2 ;BYPASS
PUSH P,RC.CUR ;SAVE CURRENT
SETZ P4, ;STORE RELOC FOR THIS BLOCK HERE
;FALL INTO NEXT PAGE
PUSHJ P,RB.1 ;[1166] READ FIRST WORD
JRST T.11CS ;[1166] EMPTY?
HLRZ T1,W1 ;[1166] GET FIRST HALF WORD
CAILE T1,MXPLOP ;[1166] A PSECT INDEX?
CAIL T1,-STRLEN ;[1166] MAYBE, IS IT?
JRST T11RD2 ;[1166] NO, FORGET IT
MOVEI P4,-377777(T1) ;[1166] YES, SET IT AS DEFAULT
CAMLE P4,RC.NO ;[1166] IN RANGE?
JRST E$$IPX ;[1174] NO, ERROR
MOVEM P4,RC.CUR ;[1166] SET FOR NEXT WORD
JRST T11RD2 ;[1166] ENTER MAIN LOOP
;NOW READ AND RELOCATED EACH HALF WORD
;THIS IS COMPLICATED BY THE FACT THAT IS PSECTS ARE BEING USED
;THE RELOCATION WILL CHANGE
;HOWEVER SINCE THE RELOCATION INFO IS FOLLOWED BY AN OPERATOR
;IT IS SUFFICIENT TO CHECK AFTER EACH WORD AS LOADED AND CHANGE
;THE RELOCATION IF REQUIRED FOR THE NEXT WORD
;THE RELOCATION INDEX IS 400000 + (N-1)
T.11RD: PUSHJ P,RB.1 ;READ AND RELOCATE 2 HALF WORDS
JRST T.11CS ;[633] FINISHED WITH THIS BLOCK
T11RD2: HLRZ T1,W1 ;[1166] GET LHS
HRRZ T2,W1 ;GET RHS
SKIPGE P4 ;ON LAST WORD FOR THIS PSECT
TLZA P4,-1 ;NOT YET, WILL BE NEXT TIME
MOVEM P4,RC.CUR ;RESET PSECT FOR THIS BLOCK
JUMPE T1,[MOVEM P4,RC.CUR ;18 BIT VALUE, RHS OK
JRST T.11RS] ; BUT RESOTRE INCASE SET FOR 2 WORDS
CAIG T1,2 ;TEST FOR 36 BIT OPERAND (1 OR 2)
JRST T11GRH ;YES, ITS OK AND SO IS LHS OF NEXT
CAIGE T1,MXPLOP ;TEST FOR OPERATOR
JRST T11RHS ;IT IS, TEST RHS
CAIL T1,-STRLEN ;[735] STORE OP?
JRST T11LOP ;YES,JUST STORE
HRRZI T1,-377777(T1) ;GET PSECT INDEX
CAMLE T1,RC.NO ;[1166] MAKE SURE VALID
JRST E$$IPX ;[1174] INVALID
MOVEM T1,RC.CUR ;SET FOR NEXT READ
JUMPE P4,E$$IPX ;[1174] PSECT INDEX ILLEGAL IF 1ST BYTE WASN'T
HRRO P4,P4
;FALL THROUGH TO NEXT PAGE
T11RHS: JUMPE T2,T11GRF ;18 BIT VALUE FOLLOWING
CAIG T2,2 ;36 BIT VALUE?
JRST [MOVEM W1,(W2) ;THIS WORD IS OK
PUSHJ P,RB.1 ;AND SO IS NEXT
JRST T.11CS ;RAN OUT
MOVEM P4,RC.CUR ;RESET PSECT
AOJA W2,T.11RS] ;JUST STORE
CAIG T2,MXPLOP ;TEST FOR OPERATOR
JRST T.11RS ;IT IS
CAIL T2,-STRLEN ;[735] STORE OP?
JRST T11ROP ;YES, STORE AND TEST NEXT RIGHT
HRRZI T2,-377777(T2) ;GET PSECT INDEX
CAMLE T2,RC.NO ;[1166] MAKE SURE VALID
JRST E$$IPX ;[1174] INVALID
MOVEM T2,RC.CUR ;SET FOR NEXT READ
JUMPE P4,E$$IPX ;[1174] ENFORCE DEFAULT PSECT INDEX FIRST BYTE
HRRO P4,P4 ;SIGNAL MIGHT TAKE TWO WORDS
T.11RS: MOVEM W1,(W2) ; STORE
AOJA W2,T.11RD ;READ ALL OF BLOCK
T11LOP: CAIL T1,-3 ;SYMBOLIC STORE?
JRST T.11RS ;NO
JRST T11SOP ;YES
T11ROP: CAIL T2,-3 ;SYMBOLIC STORE?
JRST T11GRH ;NO
T11SOP: MOVEM P4,RC.CUR ;RESET PSECT
MOVEM W1,(W2) ;STORE STORE OP
PUSHJ P,RB.1 ;GET SYMBOL
JRST T.11CS ;WILL EVENTUALLY RUN OUT
AOJA W2,.-3 ;STORE
T11GRF: ANDI P4,-1 ;CLEAR LHS SINCE NOT 2 WORDS
T11GRH: MOVEM W1,(W2) ;THIS WORD IS OK
PUSHJ P,RB.1 ;AND SO IS LHS OF NEXT
JRST T.11CS ;RAN OUT
MOVEM P4,RC.CUR ;RESET PSECT
HRRZ T2,W1 ;RHS
AOJA W2,T11RHS ;CHECK RHS
E$$IPX::.ERR. (MS,.EC,V%L,L%F,S%F,IPX,<Invalid psect index>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE TO FIND THE STORE OPERATOR AND CHECK TO SEE IF WE WANT IT.
;IF NOT (/ONLY OR NON-LOADED LOCAL), DELETE THE FIXUP NOW.
T.11CS: POP P,RC.CUR ;RESET ORIGINAL PSECT
MOVE W1,T11BP ;[633] RESET BYTE POINTER
ADD W1,FX.LB ;[633] FIX IN CORE
JRST T.11C1 ;[633] BYPASS FIRST TIME
T.11C0: IBP W1 ;[633] BYPASS NEXT HALF WORD
T.11C1: ILDB T1,W1 ;[633] READ HALF WORD
CAIL T1,MXPLOP ;[633] CHECK FOR VALID OPS
JRST [CAIGE T1,-STRLEN ;[735] STORE OP?
JRST T.11C1 ;[700] NO, MUST BE PSECT INDEX
JRST T.11SP] ;[700] YES, GO CHECK IT
CAIL T1,3 ;[633] IF OPERATOR
JRST T.11C1 ;[633] IGNORE IT
JUMPE T1,T.11C0 ;[633] IGNORE NEXT HALF WORD
AOJA W1,T.11C1 ;[633] OR NEXT FULL WORD IF 36-BIT VALUE
;HERE ON A STORE OPERATOR. SEE IF WE WANT IT.
;IF NOT, DELETE THE POLISH BLOCK AND RETURN.
;IF SO, CHECK STORE OP TO SEE IF DEFINING A SYMBOL
; AND CONVERT THE SYMBOL TO LSTSYM PTR (GLOBAL,,LOCAL) IF SO.
T.11SP: CAIL T1,-3 ;SYMBOL FIXUPS?
JRST [ILDB W1,W1 ;NO, LOAD UP ADDRESS
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG ;YES, SEE IF WE NEED IT
JRST T.11GC ;[633] YES WE DO
PUSHJ P,T.11RT ;NO, RETURN BLOCK
JRST LOAD##] ;AND GIVE UP
CAIGE T1,-STRLEN ;[735] VALID STORE POINTER?
JRST E$$ISO ;[1174] NO
;FALL THROUGH TO NEXT PAGE
;HERE IF STORE OP IS A VALID SYMBOL FIXUP
;IF STORE IS TO SYMBOL TABLE THERE ARE 2 SYMBOLS FOLLOWING
;1 ACTUAL SYMBOL TO BE FIXED UP
;2 BLOCK NAME IT IS IN
MOVE T1,6+[ FS.FXF
FS.FXL
FS.FXR](T1) ;[612] REMEMBER FIXUP TYPE
PUSH P,T1 ;[612] FOR SY.RQS
ILDB T1,W1 ;YES, GET LEFT PART
ILDB W2,W1 ;GET RIGHT
HRL W2,T1 ;FULL SYMBOL
EXCH W1,0(P) ;[612] RESTORE FIXUP TYPE, SAVE BP
EXCH W2,W3 ;PUT SYMBOL IN W3
PUSHJ P,SY.RQS ;[612] SEE IF WE WANT THIS SYMBOL
JRST [POP P,W1 ;[612] NO, NON LOADED LOCAL
PUSHJ P,T.11RT ;[612] SO CLEAN UP FX
JRST LOAD##] ;[612] AND RETURN
POP P,W1 ;[612] RESTORE BYTE PTR TO POLISH
EXCH W2,W3 ;W2 NOW CONTAINS SYMBOL PTRS
SUBI W1,1 ;BACKUP BYTE PTR
HLRZ T1,W2 ;LEFT HALF
IDPB T1,W1
IDPB W2,W1 ;RIGHT HALF
ILDB T1,W1 ;YES, GET LEFT PART
ILDB W2,W1 ;GET RIGHT
HRL W2,T1 ;FULL SYMBOL
SKIPE W2 ;ALWAYS 0 IF MACRO-51
PUSHJ P,R50T6 ;CONVERT NOW
SUBI W1,1 ;BACKUP BYTE PTR
HLRZ T1,W2 ;LEFT HALF
IDPB T1,W1
IDPB W2,W1 ;RIGHT HALF
;FALL THROUGH TO NEXT PAGE
;HERE TO COUNT AND EVALUATE GLOBAL REQUESTS
T.11GC: MOVE W1,T11BP ;RESET BYTE POINTER
ADD W1,FX.LB ;FIX IN CORE
JRST T.11G1 ;BYPASS FIRST TIME
T.11G0: IBP W1 ;BYPASS NEXT HALF WORD
T.11G1: ILDB T1,W1 ;READ HALF WORD
CAIL T1,MXPLOP ;[633] CHECK FOR VALID OPS
JRST [CAIGE T1,-STRLEN ;[735] STORE OP?
JRST T.11G1 ;[700] NO, MUST BE PSECT INDEX
JRST T.11GE] ;[700] DONE--GO TRY TO EVALUATE
CAIL T1,3 ;IF OPERATOR
JRST T.11G1 ;IGNORE IT
JUMPE T1,T.11G0 ;IGNORE NEXT HALF WORD
CAIN T1,1 ;36 BIT VALUE?
AOJA W1,T.11G1 ;YES, GET NEXT HALF WORD AFTER IT
;HERE IF T1=2, GLOBAL SYMBOL REQUEST
ILDB T1,W1 ;GET FIRST PART OF SYMBOL
ILDB W2,W1 ;GET RIGHT HALF PART
HRL W2,T1 ;FULL SYMBOL IN W2
PUSHJ P,R50T6 ;CONVERT TO SIXBIT IN W2
SUB W1,FX.LB ;INCASE IT MOVES
SUB W3,FX.LB ;DITTO
PUSH P,W1 ;SAVE BYTE POINTER
MOVX W1,PT.SGN!PT.SYM ;SET SOME VALID FLAGS
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST T.11ND ;NO, NEED TO DEFINE IT
JRST T.11UN ;UNDF, SO JUST AS BAD
POP P,W1 ;RESTORE BYTE POINTER
ADD W1,FX.LB ;ADD CORE OFFSET
ADD W3,FX.LB
SUBI W1,2 ;BACKUP BYTE POINTER
IBP W1 ;TO POINT TO 2
MOVEI T1,1 ;CHANGE GLOBAL MARKER INTO 36 BIT VALUE MARKER
IDPB T1,W1
MOVS T1,2(P1) ;GET VALUE
T.11G2: IDPB T1,W1 ;STORE IT
MOVSS T1
IDPB T1,W1 ;W1 BACK AS IT WAS
JRST T.11G1 ;GET NEXT HALF WORD
T.11GE: SKIPN (W3) ;[633] ANY UNDEFINED GLOBALS?
PUSHJ P,T.11EV ;[633] NO, EVALUATE FIXUP NOW
JRST LOAD## ;[633] ELSE WAIT TILL ALL DEFINED
E$$ISO::.ERR. (MS,.EC,V%L,L%F,S%F,ISO,<Invalid polish store operator >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T1) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE IF GLOBAL SYMBOL NOT IN GLOBAL SYMBOL TABLE YET
;TREAT AS IF ADDITIVE GLOBAL REQUEST
;GET EXTENDED TRIPLET AND POINT TO FIXUP TRIPLET IN FIXUP AREA
;INTURN THIS TRIPLET POINTS TO THE POLISH FIXUP
;NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;STUFF, THEY MUST BE SAVED
T.11ND: AOS USYM ;INCREMENT UNDEF COUNT
PUSH P,W2 ;SAVE ACCS
PUSH P,W3
TXO W1,PS.REQ ;USUAL FLAGS
PUSH P,W1 ;SAVE PRIMARY FLAGS
PUSH P,[0] ;ZERO VALUE
MOVX W1,S.FXP ;[612] SECONDARY SYMBOL FLAG
PUSHJ P,GS.FX0## ;PUT IN GLOBAL TABLE
MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL
HRRZ W3,T11FA ;ADDRESS (RELATIVE TO FX.LB) OF POLISH
PUSHJ P,SY.FX0## ;NOW PUT INTO FIXUP TABLE
PUSHJ P,SY.GX0## ;LINK TO GLOBAL
T.11GD: POP P,W3
POP P,W2
POP P,W1
ADD W1,FX.LB ;RELOCATE AGAIN
ADD W3,FX.LB ;...
AOS (W3) ;BUMP COUNT OF UNDEFINED SYMBOLS
MOVS T1,W2 ;PUT SYMBOL IN T1 SWAPPED
SOJA W1,T.11G2 ;BACKUP BYTE POINTER AND STORE AS SIXBIT
;OVERWRITING THE RADIX-50
;HERE TO SEE IF FIXUP REQUESTS EXIST FOR THIS SYMBOL
;IF SO ADD TO CHAIN, IF NOT CREATE CHAINED LIST IN EXTENDED SYMBOL
T.11UN: PUSH P,W2 ;SAVE ACCS
PUSH P,W3
MOVE W1,0(P1) ;FLAGS GO IN W1 NOW
TXNE W1,PS.FXP ;ALREADY FIXUPS DEFERED?
JRST T.11DF ;YES, JUST LINK TO CHAIN
MOVEI T1,.L ;[612] NEED ANOTHER TRIPLET
PUSHJ P,SY.MOV## ;[612] SO STRETCH CURRENT ONE
MOVX W1,PS.FXP ;[612] WE NOW HAVE A FIXUP TRIPLET
IORM W1,0(P1) ;[612] SO MARK IT
SUB T1,GS.LB ;[612] GET REL. ADDR OF NEW TRIPLET
PUSH P,T1 ;[612] SAVE IT
MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL ;[612] PTR TO POLISH
HRRZ W3,T11FA ;[612] TO TRY AGAIN WHEN SYMS DEFINED
PUSHJ P,SY.FX0## ;[612] PUT W1-W3 IN FX AREA
POP P,T1 ;[612] RESTORE POINTER INTO GS
ADD T1,GS.LB ;[612] MAKE ABSOLUTE AGAIN
MOVX W1,S.FXP!S.LST ;[612] POINTER TO FIXUP CHAIN
TMOVEM W1,0(T1) ;[612] STORE IN NEW TRIPLET
JRST T.11GD ;[612] RETURN TO SCAN REST OF POLISH
;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN
T.11DF: ADDI P1,.L ;LOOK FOR ADDITIVE GLOBAL REQUEST
SKIPG W1,0(P1) ;GET SECONDARY FLAGS
JRST E$$ISP## ;[1174] PRIMARY OR NO FLAGS SET
TXNN W1,S.FXP ;IS THIS THE ONE
JRST T.11DF ;NO TRY AGAIN
SKIPN W1,2(P1) ;GET POINTER, BETTER BE NON-ZERO
JRST E$$ISP## ;[1174]
HRLI W1,(FP.SGN!FP.SYM!FP.PTR!FP.POL)
HRRZ W3,T11FA ;POINT TO POLISH
SUB P1,NAMLOC ;INCASE CORE MOVES
PUSH P,P1 ;SAVE UNRELOCATED POINTER
PUSHJ P,SY.FX0## ;PUT IN FIXUP AREA
POP P,P1 ;RESTORE POINTER
ADD P1,NAMLOC ;RELOCATE IT
HRRM W3,2(P1) ;FIXUP REQUEST POINTER CHAIN
JRST T.11GD ;GET NEXT HALF-WORD
;HERE TO EVALUATE POLISH FIXUP
T.11EV::SKIPN W3,POLSTK ;GET STACK POINTER
PUSHJ P,T.11PD ;NOT SETUP YET
MOVEI T3,100 ;INCASE OF ON OPERATOR
MOVEM T3,SVSAT
PUSH W3,[MXPLOP] ;FAKE OPERATOR
MOVE W2,T11BP ;SETUP READ BYTE POINTER
IFN DEBSW,<
MOVEI W1,-2(W2) ;[632] POINT TO 1ST WORD OF BLOCK
> ;END IFN DEBSW
.JDDT LNKOLD,T.11EV,<<CAMN W1,$FIXUP##>> ;[632]
ADD W2,FX.LB ;FIX IN CORE
T.11RP: ILDB W1,W2 ;READ A HALF-WORD
CAIL W1,-STRLEN ;[735] STORE OPERATOR?
JRST T.11ST ;YES
CAIL W1,400000 ;PSECT INFO?
JRST T.11RP ;YES, JUST IGNORE
CAIGE W1,2 ;0,1,2 ARE OPERANDS
JRST T.11OP
CAIE W1,2 ;2 IS ILLEGAL AT THIS POINT
CAILE W1,MXPLOP-1 ;IS OPERATOR IN RANGE
JRST E$$IPO ;[1174]
PUSH W3,W1 ;SAVE OPERATOR ON STACK
MOVE T3,DESTB-3(W1) ;GET NUMBER OF OPERANDS NEEDED
MOVEM T3,SVSAT ;ALSO SAVE IT
JRST T.11RP ;BACK FOR MORE
T.11PD: MOVEI T2,LN.PPD ;[603] SIZE REQUIRED
PUSHJ P,DY.GET## ;GET SPACE FOR STACK
MOVEM T1,POLSTK ;START OF STACK
MOVEI W3,-1(T1) ;FORM PUSHDOWN STACK IN W3
HRLI W3,-LN.PPD ;FORM STACK POINTER
MOVEM W3,POLSTK ;STORE FOR NEXT TIME
POPJ P,
E$$IPO::.ERR. (MS,.EC,V%L,L%F,S%F,IPO,<Invalid polish operator >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,W1) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HANDLE OPERANDS
T.11OP: MOVE T1,W1 ;GET THE OPERAND TYPE HERE
ILDB W1,W2 ;THIS IS AT LEAST PART OF THE OPERAND
MOVE T2,W1
JUMPE T1,T.11P0 ;0 IS HALF-WORD OPERAND
ILDB W1,W2 ;NEED FULL WORD GET 2ND HALF
HRL T2,W1 ;GET IN RIGHT ACC
MOVS T2,T2 ;WRONG ORDER
T.11P0: SETZ T1, ;VALUE OPERAND
T.11P1: SOJL T3,T.11ES ;ENOUGH OPERANDS SEEN
PUSH W3,T2 ;SAVE VALUE
HRLI T1,400000 ;PUT IN A VALUE MARKER
PUSH W3,T1
JRST T.11RP ;GET MORE POLISH
;HERE WHEN WE HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
T.11ES: SKIPN SVSAT ;IS IT UNARY
JRST T.11UO ;YES, NO NEED FOR 2ND OPERAND
POP W3,T1 ;POP OFF MARKER
POP W3,T1 ;AND VALUE
T.11UO: POP W3,T3 ;OPERATOR
XCT OPTAB-3(T3) ;BOTH VALUES JUST XCT
MOVE T2,T1 ;GET THE CURRENT VALUE
SKIPG T3,(W3) ;IS THERE A VALUE IN THE STACK?
MOVE T3,-2(W3) ;YES, THIS MUST BE THE OPERATOR
MOVE T3,DESTB-3(T3) ;GET NUMBER OF OPERANDS NEEDED
MOVEM T3,SVSAT ;SAVE IT HERE
SKIPG (W3) ;WAS THERE AN OPERAND
SUBI T3,1 ;HAVE ONE OPERAND ALREADY
JRST T.11P1 ;GO SEE WHAT WE SHOULD DO NOW
;NUMBER OF OPERANDS FOR EACH OPERATOR (LESS 1)
DESTB: EXP 1,1,1,1,1,1,1,1,0,0,0,1,0,1,1,1,1,1,100 ;[735]
;OPERATOR ACTION
OPTAB: ADD T1,T2
SUB T1,T2
IMUL T1,T2
IDIV T1,T2
AND T1,T2
IOR T1,T2
LSH T1,(T2)
XOR T1,T2
SETCM T1,T2
MOVN T1,T2
PUSHJ P,JFFOOP
PUSHJ P,REMOP
MOVM T1,T2
PUSHJ P,MAXOP ;[736] 20
PUSHJ P,MINOP ;[736] 21
PUSHJ P,EQOP ;[736] 22
PUSHJ P,LNKOP ;[736] 23
PUSHJ P,DEFOP ;[736] 24
REPEAT 0,< ;WAITING FOR A DEVELOPMENT RELEASE
PUSHJ P,SKPOP ;25
PUSHJ P,SKEOP ;26
PUSHJ P,MOVOP ;27
> ;END REPEAT 0
MXPLOP==:.-OPTAB+3 ;1 MORE THAN LARGEST LEGAL OPERATOR NUMBER
;JFFO OP (^L)
JFFOOP: JFFO T2,.+2 ;COUNT LEADING BIT
MOVEI T3,^D36 ;FULL WORD OF ZEROS
MOVE T1,T3 ;PUT ANSWER IN T1
POPJ P,
;REMAINDER OPERATOR
REMOP: IDIV T1,T2 ;DIVIDE
MOVE T1,T2 ;PUT REMAINDER IN T1
POPJ P,
MAXOP: CAMGE T1,T2 ;[736]
MOVE T1,T2
POPJ P,
MINOP: CAMLE T1,T2
MOVE T1,T2
POPJ P,
EQOP: CAME T1,T2
TDZA T1,T1
SETO T1,
POPJ P,
LNKOP: PUSH P,W2 ;SAVE AC
HRREI W2,(T2) ;LINK #
JUMPGE W2,.+2
SKIPA T2,[HLRZ T1,@LINKTB] ;FETCH LINK END
MOVE T2,[HRRZ T1,@LINKTB] ;FETCH LINK
MOVMS W2
MOVEI W2,-1(W2)
SKIPE T1,LINKTB ;IF LINKTB NOT SET UP THEN LINK IS ZERO
XCT T2
POP P,W2 ;RETRIEVE AC
POPJ P,
DEFOP: ;DEFINITION STATUS
PUSH P,W2 ;SAVE AC
MOVE W2,T2 ;RADIX50
PUSHJ P,R50T6 ;SIXBITIZE
MOVX W1,PT.SGN!PT.SYM ;SOME VALID BITS
PUSHJ P,TRYSYM## ;LOOK IT UP
JRST [SETZ T1, ;TOTALLY UNKNOWN
JRST .+3]
SKIPA T1,[1] ;KNOWN BUT UNDEFINED
SETO T1, ;KNOWN AND DEFINED
POP P,W2 ;AC BACK
POPJ P,
REPEAT 0,< ;WAITING FOR A DEVELOPMENT RELEASE
SKPOP: ;SKIP T2 HALF WORDS OF POLISH IF T1 NEQ 0, RETURN 0
TDZN T1,T1
POPJ P,
JUMPL T2,SKPOP1 ;IF BACKWARDS SKIP
JRST .+2
IBP W2 ;SKIP HALF WORD
SOJGE T2,.-1 ;UNTIL DONE
POPJ P,
SKPOP1: MOVM T2,T2 ;HOW MANY HALF WORDS
TRNE T2,1 ;IF ODD
IBP W2 ;THEN INCREMENT ONCE
ADDI T2,1 ;NOW FOR PAIRS OF HALF WORDS
LSH T2,-1
SUBI W2,(T2)
POPJ P,
SKEOP: MOVE T1,T2 ;OPERAND INTO RIGHT REG
TDZN T1,T1 ;IF T1=0
POPJ P, ;THEN QUIT, RETURN 0
SKELUP: PUSHJ P,D.IN1## ;READ ONE WORD
HLRZ T1,W1 ;BLOCK TYPE
CAIE T1,5 ;END?
JRST SKEDIS ;NO, DISCARD
MOVNI WC,400000(W1) ;CONTROL WORD
POP P,(P) ;JUNK RETURN WORD
JRST T.0C ;IGNORE REST OF BLOCK AND JRST LOAD##
SKEDIS: CAILE T1,377 ;OLD TYPE?
JRST SKENEW ;NO
MOVEI T1,(W1) ;WORD COUNT
JUMPE T1,SKELUP ;NULL WORD
CAIG T1,22 ;ONE SUBBLOCK?
AOJA T1,SKE.1 ;YES, COUNT ITS RELOC BITS
IDIVI T1,22 ;WHOLE BLOCKS
IMULI T1,23 ;WORDS IN WHOLE BLOCKS
JUMPE T2,.+2 ;IF NO REMAINDER
ADDI T1,1(T2) ;PARTIAL BLOCK HAS RELOC BITS
SKE.1: CAML T1,DCBUF+2 ;ENOUGH IN BUFFER?
SOJA T1,SKE.2 ;NO, BUT WAS ILDB'ED
ADDM T1,DCBUF+1 ;ADVANCE BYTE POINTER
MOVN T1,T1
ADDM T1,DCBUF+2 ;DECR COUNT
JRST SKELUP
SKE.2: SUB T1,DCBUF+2 ;HAD THIS MANY
PUSHJ P,D.INP## ;NEW BUFFER
JRST SKE.1 ;TRY AGAIN
SKENEW: CAIG T1,3777 ;TEST RANGE FOR NEW BLOCK TYPES
CAIGE T1,1000
JRST .+2 ;OK
JRST E$$RBS ;[1174]
MOVEI T1,(W1) ;NUMBER OF WORDS TO SKIP
JRST SKE.1
MOVOP: ;ADDRESS ALREADY IN T2
PUSHJ P,SEGCHK##
HALT . ;I GIVE UP
MOVE T1,(T2)
POPJ P,
> ;END REPEAT 0
;HERE TO STORE THE FINAL VALUE
T.11ST: MOVE T2,-2(W3) ;THIS SHOULD BE THE FAKE OPERATOR
CAIE T2,MXPLOP ;IS IT
JRST E01IPO ;[1174] NO
ILDB T2,W2 ;[572] GET CORE ADDR OR GS POINTER
MOVE W3,-1(W3) ;GET THE VALUE AFTER IGNORING THE FLAG
PUSHJ P,@STRTAB+STRLEN(W1) ;[735] CALL THE CORRECT FIXUP ROUTINE
;ALL DONE, NOW GIVE SPACE BACK
T.11RT: HRRZ T1,T11FA ;START OF FIXUP AREA
ADD T1,FX.LB ;IN REAL CORE
HLRZ T2,T11FA ;LENGTH OF AREA
PUSHJ P,FX.RET## ;RETURN FIXUP BLOCK
SETZM T11FA ;AND CLEAR MARKER
SETZM T11BP ;BYTE POINTER ALSO
POPJ P, ;RETURN TO GET NEXT BLOCK
;STORE OPERATOR ACTION TABLE
STRTAB: ;[735]
REPEAT 0,< T11LNK > ;[735] -10 STORE LINK OR LINK END
T11MVM ;[735] -7 MOVEM
T11SYF ;[735] -6 FULL WORD SYMBOL FIXUP
T11SYL ;-5 LEFT HALF SYMBOL FIXUP
T11SYR ;-4 RIGHT HALF SYMBOL FIXUP
SY.CHF## ;-3 FULL WORD FIXUP CHAIN
SY.CHL## ;-2 LEFT HALF FIXUP CHAIN
SY.CHR## ;-1 RIGHT HALF FIXUP CHAIN
CPOPJ ;0 NO-OP
STRLEN== .-STRTAB-1 ;[735] LENGTH OF STORE OP TABLE
E01IPO::.ERR. (MS,.EC,V%L,L%F,S%F,IPO) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T2) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE TO DISPATCH FOR SYMBOL TABLE FIXUPS
;T2 = ADDRESS OF SYMBOL IN GLOBAL TABLE
;W3 = VALUE
;USES
;W1 = FIXUP FLAGS
T11SYR: MOVX W1,FS.FXR
JRST SY.ASP ;AND DO FIXUP
T11SYL: MOVX W1,FS.FXL
JRST SY.ASP
T11SYF: MOVX W1,FS.FXF
; JRST SY.ASP ;
;HERE TO STORE SYMBOL TABLE FIXUP
SY.ASP: ILDB T1,W2 ;[572] PICK UP LOCAL POINTER
HRL T1,T2 ;[572] FORM STANDARD GLOBAL,,LOCAL
PUSH P,T1 ;[572] SAVE OVER GS.GET
MOVEI T2,.L ;[572] SET UP FAKE DEFINING TRIPLET
PUSHJ P,GS.GET## ;[572] IN GS AREA SO CAN USE SY.STF
MOVE P1,T1 ;[572] P1=ADDR OF FAKE DEFINING TRIPLET
MOVX T1,PT.SGN!PT.SYM!PS.GLB ;[572] SOME GOOD FLAGS
MOVEM T1,0(P1) ;[572] SET IN TRIPLET
;[572] LEAVE NAME BLANK TO CATCH ERRORS
MOVEM W3,2(P1) ;[572] STORE POLISH RESULT AS VALUE
POP P,W3 ;[572] W1=FLAGS, W3=PTR, P1=DEF. TRPLET
PUSHJ P,SY.STF## ;[572] DO ALL NECESSARY SYMBOL FIXUPS
MOVE T1,P1 ;[572] NOW RETURN FAKE BLOCK
MOVEI T2,.L ;[572] T1=ADDR, T2=LENGTH
PJRST GS.RET## ;[572] FREE IT UP AND RETURN
REPEAT 0,< ;[735]
T11LNK:
PUSH P,T2
PUSHJ P,T12GET ;SET UP LINK TABLE
EXCH W2,(P) ;SPECIAL AC
HRRES W2 ;SIGN EXTEND
JUMPGE W2,.+2
SKIPA T2,[HRLM W3,@LINKTB] ;LINK END
MOVE T2,[HRRM W3,@LINKTB] ;LINK
MOVMS W2
SOJL W2,.+2
CAIL W2,LN.12
AOJA W2,E01IPO ;[1174] RANGE CHECK
XCT T2 ;STORE W3
POP P,W2 ;RETRIEVE AC
POPJ P,
> ;END OF REPEAT 0
T11MVM: PUSH P,W3 ;MOVEM W3,(T2)
;ADDR IN T2 LAREADY
PUSHJ P,SEGCHK## ;SEE IF IN CORE
JRST T.11N ;NOT
POP P,W3 ;RETIREVE VALUE
MOVEM W3,(T2)
POPJ P,
T.11N: HRLI T2,CPF.RR ;NOT IN CORE
POP P,W3 ;VALUE
PJRST SY.CHP## ;PUT IN FIXUP LIST
SUBTTL BLOCK TYPE 12 - LINK (FAIL)
; ----------------
; ! 12 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! DATA WORDS !
; ----------------
T.12: SKIPE LINKTB ;LINK TABLE SETUP ?
JRST T.12A ;YES
MOVEI T2,LN.12 ;SIZE WE NEED
PUSHJ P,DY.GET ;GET IT
HRLI T1,W2 ;PUT INDEX IN
MOVEM T1,LINKTB ;SETUP POINTER
HRLZ T2,T1 ;BLT POINTER
HRRI T2,1(T1)
SETZM (T1)
BLT T2,LN.12-1(T1) ;CLEAR ALL LINKS
T.12A: PUSHJ P,RB.2 ;READ 2 WORDS
JRST LOAD##
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG ;YES, SEE IF WANTED
CAIA ;YES
JRST T.12 ;NO
JUMPL W2,T.12E ;THIS IS AN END OF LINK WORD
SOJL W2,.+2 ;ZERO IS ILLEGAL
CAIL W2,LN.12 ;IN RANGE
AOJA W2,E$$ICB ;[1174] ILLEGAL LINK #
TLNN W1,-1 ;THIRD ARG SPECIFIED?
TLO W1,0(W1) ;NO, DEFAULT TO SECOND ARG
HRRZ T2,W1 ;GET ADDRESS WE NEED
PUSHJ P,SEGCHK## ;SEE IF IN CORE
JRST T.12N ;NOT
HRRZ T1,@LINKTB ;GET PREVIOUS LINK ADDRESS
HRRM T1,(T2) ;STORE INCORE
HLRM W1,@LINKTB ;STORE NEW IN LINK TABLE
JRST T.12A ;BACK FOR MORE
;HERE IF THE OLD .LINK ADDRESS IS NO LONGER IN CORE.
T.12N: HRLI T2,CPF.RR ;NOT IN CORE
MOVE W3,W1 ;VALUE
PUSHJ P,SY.CHP## ;PUT IN FIXUP LIST
HLRM W1,@LINKTB ;STORE NEXT FOR NEXT TIME
JRST T.12A ;RETURN FOR MORE
T.12E: MOVNS W2 ;GET ENTRY NUMBER
SUBI W2,1 ;PUT IN RANGE 0-17
CAIL W2,LN.12 ;IN RANGE?
AOJA W2,E$$ICB ;[1174] ILLEGAL
HRLM W1,@LINKTB ;SAVE END OF LINK INFO
JRST T.12A ;BACK FOR MORE
E$$ICB::.ERR. (MS,.EC,V%L,L%W,S%W,ICB,<Invalid chain REL block (type 12) link number >) ;[1174]
.ETC. (OCT,.EC!.EP,.EC,,,,W2) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
JRST T.12A ;TRY TO CONTINUE
SUBTTL BLOCK TYPE 13 - LVAR (WEIHER)
; ----------------
; ! 13 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! DATA WORDS !
; ----------------
T.13:
E$$T13::.ERR. (MS,.EC,V%L,L%F,S%F,T13,<LVAR REL block (type 13) not implemented>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SUBTTL BLOCK TYPE 14 - INDEX
; ----------------
; ! 14 ! COUNT !
; ----------------
; ! 4 ! COUNT !
; ----------------
; ! SYMBOLS !
; ----------------
; ! WORD ! BLOCK !
; ----------------
T.14: SETZM DCBUF+2 ;READ NEXT BUFFER ON NEXT ILDB
T.14ER: SKIPN XBUF ;IF WE HAVE AN INDEX BUFFER
JRST LOAD## ;NO, NOT FIRST TIME HERE
PUSHJ P,ZXBUF## ;GET RID OF IT
E$$LII::.ERR. (MS,,V%L,L%W,S%I,LII,<Library index inconsistent, continuing>) ;[1174]
JRST LOAD## ;AND CONTINUE
T.14I: PUSHJ P,D.IN1## ;READ FIRST WORD
HLRZ T1,W1 ;BLOCK TYPE ONLY
CAIE T1,14 ;IS IT AN INDEX?
JRST T.14ER ;NO, ERROR
JRST T.14J ;DON'T SET FLAG AGAIN
;ENTER HERE IF IN /SEARCH MODE
T.14A: SKIPN XBUF ;[1101] GIVE ERROR IF ALREADY BEEN HERE
TRNE FL,R.INC ;INCLUDE BEING PROCESSED?
JRST T.14 ;PROCESS AS IF NO INDEX
MOVEI T2,^D128 ;SIZE OF INDEX BUFFER
PUSHJ P,DY.GET## ;GET SPACE IN DY AREA
HRRZM T1,XBUF ;SIGNAL SPACE AQUIRED
T.14J: HRRZ T1,XBUF ;AUX BUFFER
HRLI T1,4400 ;MAKE BYTE POINTER
MOVEM T1,XBUF+1 ;AND SAVE IT
HRL T1,DCBUF+1 ;INPUT BUFFER
MOVEI T2,^D127(T1) ;END OF BUFFER
BLT T1,(T2) ;STORE BLOCK
T.14B:: ILDB W3,XBUF+1
JUMPL W3,T.14D ;END OF BLOCK IF NEGATIVE
HRRZ W3,W3 ;WORD COUNT ONLY
IFN FTOVERLAY,<
PUSH P,BG.SCH ;REMEMBER CURRENT STATUS
SETZM BG.SCH ;DON'T SEARCH UNIVERSALS
> ;END IFN FTOVERLAY
T.14C: MOVX W1,PT.SGN!PT.SYM ;VALID SYMBOL BITS
ILDB W2,XBUF+1 ;GET NEXT SYMBOL
PUSHJ P,R50T6 ;SIXBITIZE IT
PUSHJ P,TRYSYM##
CAIA ;NOT IN TABLE, KEEP TRYING
SOJA W3,T.14E ;REQUEST MATCHES
T.14K: SOJG W3,T.14C ;[562] NOT REQUIRED KEEP TRYING
IFN FTOVERLAY,<
POP P,BG.SCH ;RESTORE OLD STATUS
> ;END IFN FTOVERLAY
ILDB W3,XBUF+1 ;GET POINTER WORD
JRST T.14B ;GET NEXT PROG
T.14E: MOVE T1,0(P1) ;UNDEFINED, BUT DO WE WANT IT?
TXNN T1,PS.UDF ;NOT IF ALREADY PARTIAL DEFS
TXNN T1,PS.REQ ;CERTAINLY NOT IF NO REQUESTS
AOJA W3,T.14K ;[562] WAS A=:B##, DON'T WANT A AGAIN
IFN FTOVERLAY,<
POP P,BG.SCH ;RESTORE OLD STATUS
> ;END IFN FTOVERLAY
ADDM W3,XBUF+1
ILDB T1,XBUF+1
HRRZ W3,LSTBLK ;GET LAST BLOCK NUMBER
CAIN W3,(T1) ;IN THIS BLOCK?
JRST THSBLK ;YES
NXTNDX: SKIPGE DTAFLG ;[1101] DIFFERENT TEST FOR DTA
JRST NXTDTA ;CHECK IF NEXT BUFFER IN CORE
CAIN W3,-1(T1) ;NEXT BLOCK?
JRST NXTBLK ;YES,JUST DO INPUT
T.14F: USETI DC,(T1) ;SET ON BLOCK
WAIT DC, ;LET I/O FINISH
MOVSI W2,(1B0) ;CLEAR RING USE BIT IF ON
HRRZ W3,DCBUF
IORM W2,DCBUF ;SET UNUSED RING BIT (HELP OUT MONITOR)
SKIPL (W3)
JRST NXTBLK ;ALL DONE NOW
ANDCAM W2,(W3) ;CLEAR USE BIT
HRRZ W3,(W3) ;GET NEXT BUFFER
JRST .-4 ;LOOP
NXTDTA: WAIT DC, ;LET I/O RUN TO COMPLETION
HRRZ W3,DCBUF ;GET POINTER TO CURRENT BUFFER
HLRZ W3,1(W3) ;FIRST DATA WORD IS LINK
CAIE W3,(T1) ;IS IT BLOCK WE WANT?
JRST T.14F ;NO
NXTBLK: IN DC,
JRST THSBLK ;[1101] IT IS NOW
JRST D.ERR## ;EOF OR ERROR
;HERE WHEN THE DATA WE WANT IS IN THE CURRENT BUFFER.
;IF WE WERE READING A NEW INDEX (T1.LT.0), THEN GO TO T.14I.
;IF NOT, ADJUST THE BYTE COUNT & PTR TO POINT TO THE START OF
;THE MODULE TO BE LOADED, THEN GO TO LOAD TO LOAD IT.
;T1 CONTAINS MODULE POINTER (WORD,,BLOCK) FOR THIS MODULE.
THSBLK: HRRZM T1,LSTBLK ;[1101] WE KNOW WE'RE NOW ON THIS BLOCK
JUMPL T1,T.14I ;[1101] JUMP IF BLOCK CONTAINS AN INDEX
HLRZ T1,T1 ;[1101] NOT AN INDEX, GET WORD OFFSET
HRRZ T2,DCBUF ;[1101] CONSTRUCT NEW BYTE POINTER
HLL T2,DCBUF+1 ;[1101] LH=LH(OLD BYTE PTR)
ADDI T2,1(T1) ;[1101] RH=RH(DCBUF)+OFFSET+1
EXCH T2,DCBUF+1 ;[1101] GET OLD PTR, STORE NEW ONE
SUB T2,DCBUF+1 ;[1101] COMPUTE DIFFERENCE TO UPDATE COUNT
ADDM T2,DCBUF+2 ;[1101] UPDATE BYTE COUNT
JRST LOAD##
T.14D: HRRE T1,W3 ;GET BLOCK # OF NEXT INDEX
JUMPL T1,EOF1## ;FINISHED IF -1
MOVE T1,W3 ;[1101] -1,,BLOCK # INTO T1 FOR THSBLK
HRRZ W3,LSTBLK ;GET LAST BLOCK
JRST NXTNDX ;CHECK IF NEXT BUFFER IN CORE
SUBTTL BLOCK TYPE 15 - ALGOL OWN
; ----------------
; ! 15 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! ORIG ! LENGTH!
; ----------------
; ! ADDR ! VALUE !
; ----------------
T.15: PUSHJ P,RB.1 ;READ 3RD WORD
JRST [MOVEI T1,15
JRST E$$RBS] ;[1174]
MOVEI R,1 ;MUST GO TO LOW SEG
MOVE R,@RC.TB ;SO SETUP R
HLRZ W2,W1 ;ORIGIN OF THIS OWN BLOCK
MOVE P3,W2 ;COPY FOR ADCHK.
SKIPE ASFILE ;FIRST OWN BLOCK?
JRST T.15B ;NO
TLZ W1,-1 ;YES, ZAP ORIGIN
CAIGE W1,LN.ABL+1 ;IS THIS OWN BLOCK LONG ENOUGH?
MOVEI W1,LN.ABL+1 ;NEEDS TO HOLD .SYM FILE DESCRIPTR
T.15B: HRRZM W1,OWNLNG ;TO FIX RELOC AT END
MOVE T1,P3 ;GET START
ADDI T1,(W1) ;+END =HIGHEST LOC LOADED
CAMLE T1,RC.HL(R) ;BIGGEST YET?
MOVEM T1,RC.HL(R) ;YES STORE IT
SKIPE ASFILE ;FIRST OWN BLOCK SEEN?
JRST T.15C ;NO, PROCEED
MOVEI W3,1(W2) ;BYPASS CHAIN WORD
MOVEM W3,ASFILE ;REMEMBER LOC OF DESCRIPTOR BLOCK
T.15C: EXCH W2,%OWN ;EXCH WITH PREVIOUS OWN
HRL W1,W2 ;LAST OWN ADDRESS IN LEFT
;THIS LENGTH IN RIGHT
MOVS W1,W1 ;LENGTH,,ADDRESS
MOVEI R,1 ;SEGMENT #
PUSHJ P,ADCHK.## ;MAKE SURE ADDRESSABLE
CSTORE ;STORE W1
T.15A: PUSHJ P,RB.1 ;GET FIXUP REQUEST
JRST LOAD##
HRRZ W3,W1 ;ADDITIVE CONSTANT
ADD W3,%OWN ;ADD IN BASE OR ARRAY
HLRZ T2,W1 ;START OF CHAIN
PUSHJ P,SY.CHR## ;CHAIN REQUESTS
JRST T.15A
SUBTTL BLOCK TYPES 16 & 17 REQUESTS
; ----------------
; ! 16 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! FILE NAME !
; ----------------
; ! PPN !
; ----------------
; ! DEVICE !
; ----------------
T.16: SKIPA P1,[PRGPTR] ;LOAD ADDRESS OF LIST OF PROGS TO LOAD
T.17: MOVEI P1,LIBPTR ;OR ADDRESS OF LIST OF LIBS TO SEARCH
T.16A: PUSHJ P,RB.2 ;READ FIRST 2 DATA WORDS
JRST LOAD## ;END OF BLOCK
MOVE W3,W1 ;STORE PPN IN W3
PUSHJ P,RB.1 ;READ 3RD DATA WORD
SETZ W1, ;INCASE DEV NOT GIVEN
;W1=DEV, W2=FILE, W3=PPN
MOVEI T2,R.LEN ;NEED A REQUEST BLOCK
PUSHJ P,DY.GET##
TSTORE W1,<R.DEV(T1)>,<R.NAM(T1)>,<R.PPN(T1)>
MOVSI W1,'REL' ;ONLY EXTENSION OLD BLOCKS CAN HAVE
MOVEM W1,R.EXT(T1) ;STORE IT AWAY
PUSHJ P,T.RQST ;GO LINK IT IN TO THE CHAIN
JRST T.16A ;SEE IF MORE GIVEN
;ROUTINE TO CHAIN A REQUEST IN IF HASN'T ALREADY BEEN SEEN
;ENTER WITH T1=ADDR OF BLOCK, P1=ADDR OF CHAIN. USES T1-T4.
T.RQST::HRLI T1,-R.LEN ;SETUP AOBJN POINTER TO SCAN BLOCK
AOBJN T1,.+1 ;BUT NEVER SCAN 1ST WORD
PUSH P,T1 ;SAVE FOR FREQUENT USE
MOVE T2,P1 ;SETUP POINTER TO START OF CHAIN
T.RQS1: MOVX T4,<0,,-1> ;[571] LOOK AT RIGHT HALF ONLY
TDNN T4,0(T2) ;[571] END OF CHAIN YET?
JRST T.LINK ;YES, GO LINK THIS REQUEST IN
MOVE T2,(T2) ;FOLLOW LINK
MOVE T1,(P) ;GET POINTER TO NEW BLOCK
MOVEI T3,1(T2) ;AND TEMP POINTER TO OLD ONE
T.RQS2: MOVE T4,(T1) ;GET A WORD FROM NEW BLOCK
CAME T4,(T3) ;MATCH OLD BLOCK?
JRST T.RQS1 ;NO, SEE IF NEXT BLOCK MATCHES
AOJ T3, ;BUMP POINTERS
AOBJN T1,T.RQS2 ;KEEP CHECKING FOR A MATCH
POP P,T1 ;IT MATCHED, RESTORE ADDR+1
MOVEI T1,-1(T1) ;CONVERT TO REAL ADDR & ZAP LH
MOVEI T2,R.LEN ;LENGTH OF IT
PJRST DY.RET## ;RETURN THE BLOCK SINCE DUPLICATE FOUND
;HERE IF A NEW REQUEST. LINK IT IN TO THE LIST AND RETURN.
T.LINK: POP P,T1 ;RECOVER ADDR+1
MOVEI T1,-1(T1) ;CONVERT TO ADDR
HRRM T1,(T2) ;[571] STORE THIS BLOCK ON THE CHAIN
HRRZS (P1) ;INDICATE SOMETHING NEW ON THE LIST
POPJ P,
SUBTTL BLOCK TYPE 20 - COMMON ALLOCATION
; ----------------
; ! 20 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! SYMBOL !
; ----------------
; ! LENGTH !
; ----------------
COMMENT * THIS BLOCK CONSISTS OF WORD PAIRS (SAME AS TYPE 2)
FIRST WORD IS RADIX50 04,SYMBOL
SECOND WORD IS 0,,COMMON LENGTH
COMMON NAME MUST BE GLOBAL AND UNIQUE
IF NOT ALREADY DEFINED LINK DEFINES SYMBOL AND ALLOCATES
SPACE. IF DEFINED LINK CHECKS FOR TRYING TO INCREASE COMMON
SIZE, AND GIVES ERROR IF SO
NOTE... COMMON BLOCKS MUST COME DEFORE ANY DATA BLOCKS
IE. AFTER BLOCKS 4,6,3 BUT BEFORE 1,2,37,..5
*
T.20: PUSHJ P,RB.2 ;GET COMMON PAIR
JRST LOAD## ;FINISHED
MOVS W3,W1 ;VALUE
TRNE W3,-1 ;[1204] SMALL ENOUGH?
PUSHJ P,E$$PTL ;[1204] NO, COMPLAIN
PUSHJ P,R50T6 ;CONVERT TO SIXBIT
PUSHJ P,T.COMR ;CHECK THIS PAIR
JRST T.20 ;ALREADY DEFINED
HRRZ P1,@HT.PTR ;SETUP P1 TO POINT TO SYMBOL
ADD P1,NAMLOC ;IN CORE
MOVE W3,.L+2(P1) ;GET LENGTH OF THE COMMON BLOCK.
ADDM W3,RC.CV(R) ;BUMP RELOCATION COUNTER
JRST T.20 ;GET NEXT SYMBOL
T.COMR::MOVEI R,1 ;ASSUME FIRST SEGMENT
TRNE FL,R.FHS ;FORCED LOADING TO HIGH SEG
ADDI R,1 ;YES, SO SET R FOR HIGH SEG
MOVE R,@RC.TB ;GET RC BLOCK
HRR W3,RC.CV(R) ;CURRENT VALUE
;FALL INTO T.COMM
;T.COMM TESTS TO SEE IF COMMON ALREADY EXISTS
;IF SO CHECK SIZE
;IF NOT DEFINE (GLOBAL ONLY)
;RETURNS
;+1 COMMON ALREADY DEFINED WITH CORRECT LENGTH
;+2 WAS NOT DEFINED, NOW IS
;THIS ROUTINE PRESERVES R
T.COMM::MOVX W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL ;SET THE FLAGS
PUSHJ P,TRYSYM## ;SEE IF IN TABLE
JRST T.20ND ;NOT IN TABLE
JRST T.20UN ;IN, BUT UNDEF (NOT COMMON)
MOVE T1,(P1) ;GET PRIMARY FLAGS
TXNN T1,PS.COM ;ALREADY COMMON?
JRST E$$SNC ;[1174] NO, ERROR
HRRZ T1,P1 ;GET COPY
ADDI T1,.L ;NEXT TRIPLET
MOVE T2,(T1) ;GET FLAGS
TXNN T2,S.COM ;FOUND COMMON BLOCK YET?
JRST .-3 ;NO
HLRZ T2,W3 ;GET SIZE WE WANT
CAMLE T2,2(T1) ;LESS THAN OR EQUAL TO WHAT WE HAVE?
JRST T.20ER ;NO, GIVE ERROR
MOVE W3,2(P1) ;SET STARTING ADDRESS OF COMMON
POPJ P, ;YES, LEAVE ALONE
T.20ER: MOVE T1,2(T1)
EXCH T1,T2 ;[1174] SWAP FOR .ETAIC ROUTINE
E01AIC::.ERR. (MS,.EC,V%L,L%F,S%F,AIC) ;[1174]
.ETC. (STR,.EC,,,,,<common >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (JMP,.EC,,,,.ETAIC) ;[1174]
E$$SNC::.ERR. (MS,.EC,V%L,L%F,S%F,SNC,<Symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (STR,.EC,,,,,< already defined, but not as common>)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;HERE TO PUT SYMBOL IN TABLE AND GENERATE SPACE
T.20ND: TXO W1,PT.EXT ;TURN ON EXTENDED BIT NOW
MOVEI T2,2*.L ;NEEDS TWO TRIPLETS
PUSHJ P,GS.GET## ;GET SPACE FOR THEM
DMOVEM W1,0(T1) ;FLAGS & NAME
HRRZM W3,2(T1) ;VALUE (ADDRESS IN CORE)
MOVX T2,S.COM!S.LST ;SECONDARY FLAGS
MOVEM T2,.L+0(T1) ;IN SECONDARY TRIPLET
MOVEM W2,.L+1(T1) ;NAME AGGAIN
HLRZM W3,.L+2(T1) ;LENGTH OF COMMON ARRAY
MOVE W3,T1 ;EXPECTS POINTER TO SYMBOL IN W3
SUB W3,NAMLOC ;RELATIVE TO GLOBAL TABLE
AOS (P) ;SKIP RET
PUSHJ P,INSRT## ;PUT SYMBOL IN GLOBAL TABLE
HRRZ P1,@HT.PTR ;GET RELATIVE PTR TO SYMBOL
MOVEI T2,2*.L ;NEED 2 TRIPLETS FOR COMMON
PJRST LS.ADE## ;PUT EXTENDED SYM IN LOCAL TABLE
T.20UN: MOVE T1,(P1) ;GGET PRIMARY FLAGGS
TXNE T1,PS.COM ;ALREADY DEFINED COMMON?
JRST E$$SNC ;[1174] SHOULD NOT HAPPEN
PUSHJ P,SY.CHK## ;SEE HOW LONGG CURRENT SYMBOL IS
ADDI T2,.L ;EXTRA FOR COMMON TRIPLET
PUSHJ P,GS.GET ;GET SPACE
HRRZ P1,@HT.PTR ;RESET P1 INCASE CORE MOVED
ADD P1,NAMLOC ;MAKE FIXED
MOVE T3,(P1) ;GET PRIMARY FLAGS
TXO T3,PS.COM!PT.EXT ;NOW COMMON
MOVEM T3,(T1) ;STORE
MOVEM W2,1(T1) ;SYMBOL NAME
MOVE T3,2(P1) ;GET VALUE (CHAIN POINTER)
MOVEM T3,2(T1)
MOVX T3,S.COM ;SECONDARY FLAG
CAIG T2,2*.L ;ONLY COMMON
TXO T3,S.LST ;YES, THEN THIS IS LAST TRIPLET
MOVEM T3,.L+0(T1) ;STORE COMMON FLAG
MOVEM W2,.L+1(T1) ;SYMBOL
HLRZM W3,.L+2(T1) ;AND COMMON LENGTH
HRRZ W3,W3 ;REMOVE LENGTH, JUST LEAVE VALUE
CAIG T2,2*.L ;MORE TO MOVE STILL
JRST T20UN1 ;NO, JUST ADJUST POINTER
HRLZI T3,.L(P1) ;FROM
HRRI T3,2*.L(T1) ;TO
HRRZI T4,(T1)
ADDI T4,-1(T2) ;LIMIT
BLT T3,(T4)
T20UN1: SUBI T2,.L ;LESS TO GIVE BACK
EXCH T1,P1 ;PUT NEW IN P1
PUSHJ P,GS.RET## ;GIVE BACK OLD SYMBOL
SUB P1,NAMLOC ;MAKE POINTER RELATIVE
HRRM P1,@HT.PTR ;STORE IT
ADD P1,NAMLOC ;PUT OFFSET BACK
PUSH P,P2 ;[777] SAVE COMMON SYMBOL OVER SY.RF
PUSH P,R ;SAVE R OVER SY.RF
PUSHJ P,SY.RF## ;FIXUP ANY COMMON REFERENCES
POP P,R ;PUT R BACK AS IT WAS
POP P,P2 ;[777] RESTORE COMMAND SYMBOL
HRRZ P1,@HT.PTR ;[777] AND RECOMPUTE IN CASE IT'S MOVED
JRST CPOPJ1 ;SKIP RETURN
SUBTTL BLOCK TYPE 21 - SPARSE DATA (FORTRAN-10)
; -----------------
; ! 21 ! COUNT !
; -----------------
; ! BYTE WORD !
; -----------------
; ! COUNT ! ADDR. !
; -----------------
; ! DATA WORDS !
; -----------------
COMMENT *
THIS BLOCK CONSISTS OF SUB BLOCKS OF FORM
WORD COUNT,,ADDRESS
DATA WORDS
ADDRESS CAN BE EITHER RELOCATABLE OR ABSOLUTE
DATA MAY BE EITHER ALSO
CODE IS SIMILAR TO TYPE 1
*
T.21: TRNE FL,R.TWSG ;ALREADY TWO SEG ?
JRST T.21A ;YES, LOAD IT
SKIPE HC.S2 ;POTENTIALLY 2 SEG?
TRO FL,R.TWSG!R.CDT ;YES, FORCE INCASE COMMON
T.21A: PUSHJ P,RB.1 ;READ CNT & LOC
JRST [TRZE FL,R.CDT ;FORCED 2 SEG?
TRZ FL,R.TWSG ;YES, PUT IT BACK
JRST LOAD##] ;ON TO NEXT BLOCK
JUMPGE W1,.+3 ;NOT SYMBOLIC
MOVEI T1,21 ;INCASE OF ERROR
PUSHJ P,T.1S ;SYMBOLIC IF SIGN BIT ON
HLRZ W3,W1 ;WORD COUNT
HRRZ W1,W1 ;ADDRESS ONLY
MOVE P3,W1 ;START ADDRESS
ADD W1,W3 ;HIGHEST NEEDED
PUSHJ P,T.1AD ;CHECK ADDRESS AND LOAD THIS SUB BLOCK
JRST T.21A ;LOOP FOR MORE
SUBTTL BLOCK TYPE 22 - SET PSECT BLOCK
; -----------------
; ! 22 ! COUNT !
; -----------------
; ! BYTE WORD !
; -----------------
; ! PSECT NAME !
; -----------------
; ! ORIGIN !
; -----------------
COMMENT *
THIS BLOCK CONSISTS OF :-
PSECT NAME IN SIXBIT
PSECT ORIGIN
*
T.22: PUSHJ P,RB.2 ;READ NAME AND ORIGIN
JRST [MOVEI T1,20
JRST E$$RBS] ;[1174] ERROR
MOVE W3,W1 ;STORE VALUE IN SAFE PLACE
TLNN W2,600000 ;[763] FIRST SIXBIT NON-ZERO?
JRST T.22C ;[763] IT'S ZERO, MUST BE PSECT INDEX, JUMP
;SEE IF ALREADY DEFINE, IF NOT PUT IN TABLE
MOVE R1,RC.NO ;GET NUMBER
T.22A: MOVE T1,@RC.TB ;GET POINTER TO BLOCK
CAMN W2,RC.NM(T1) ;THIS IT?
JRST T.22B ;YES,
SOJG R1,T.22A ;NOT YET
SETZ W1, ;[763] ZERO ATTRIBUTES
SKIPN W3 ;[763]
TXO W1,AT.RP ;[763] ASSUME RELOC-PSECT IF ORIGIN IS ZERO
PUSHJ P,.SET0## ;NOT YET DEFINED
MOVE R1,RC.NO ;MUST BE LAST
T.22B: MOVEM R1,RC.CUR ;SET FOR RELOCATION
JRST LOAD## ;FINISHED
T.22C: ADDI W2,1 ;[763] PSECT INDEX IS ONE LESS
CAMLE W2,RC.NO ;[763] HERE IF PSECT INDEX USED
JRST E$$IPX ;[1174] MAKE SURE THIS PSECT EXIST
MOVEM W2,RC.CUR ;[763] SWITCH CURRENT RELOC COUNTER TO IT
JRST LOAD## ;[763]
SUBTTL BLOCK TYPE 23 - PSECT END BLOCK
; -----------------
; ! 23 ! COUNT !
; -----------------
; ! BYTE WORD !
; -----------------
; ! PSECT INDEX !
; -----------------
; ! BREAK !
; -----------------
T.23: PUSHJ P,RB.1 ;[1154] GET PSECT INDEX
JRST E$$RBS ;[1174] TOO SHORT
MOVEI R,1(W1) ;[1154] PUT INTERNAL PSECT INDEX INTO R
TXNN W1,77B5 ;[1154] OLD STYLE (NAME IN SIXBIT)?
JRST T.23B ;[1154] NO, WE HAVE THE PSECT INDEX.
;HERE WITH OLD-STYLE NAME IN SIXBIT. LOOP OVER RC BLOCKS LOOKING FOR IT.
MOVE R,RC.NO ;[1154] START AT THE TOP PSECT
T.23A: MOVE T1,@RC.TB ;[1154] POINT TO NEXT RC BLOCK
CAME W1,RC.NM(T1) ;[1154] IS THIS IT?
SOJG R,T.23A ;[1154] NO, LOOP
JUMPE R,[MOVEI T1,23 ;[1154] IF NOT FOUND, GO COMPLAIN
JRST E$$RBS] ;[1174] USUAL MESSAGE
;HERE WITH THE INTERNAL PSECT INDEX IN R. NEED TO PUT THIS IN RC.CUR,
;SO CALL TO RB.1 WILL GET BREAK RELOCATED WITH RESPECT TO THIS PSECT.
T.23B: MOVE P1,RC.CUR ;[1154] SAVE OVER MUNGING BELOW
MOVE P2,@RC.TB ;[1154] SAVE ADDRESS OF RC BLOCK
MOVEM R,RC.CUR ;[1154] SET UP FOR RB.1
PUSHJ P,RB.1 ;[1154] GET BREAK
JRST [MOVEI T1,23 ;[1154] NOT THERE, COMPLAIN
JRST E$$RBS] ;[1174] ..
MOVE W1,LSTRRV ;[1204] GET TRUE VALUE
CAMLE W1,[1,,0] ;[1204] IN BOUNDS?
PUSHJ P,E$$PTL ;[1204] NO, COMPLAIN
MOVEM P1,RC.CUR ;[1154] RESTORE RC.CUR
CAMLE W1,RC.HL(P2) ;[1154] A NEW RECORD FOR THE BREAK?
MOVEM W1,RC.HL(P2) ;[1154] YES, SET HL (CV FIXED IN T.5)
JRST LOAD## ;[1154] DONE, GO GET NEXT BLOCK
SUBTTL BLOCK TYPE 24 - PSECT HEADER BLOCK
; -----------------
; ! 24 ! COUNT !
; -----------------
; ! BYTE WORD !
; -----------------
; ! PSECT NAME !
; -----------------
; !ATTR !PSECT IDX!
; -----------------
; ! ORIGIN !
; -----------------
COMMENT *
THIS BLOCK CONSISTS OF :-
PSECT NAME IN SIXBIT
ATTRIBUTES,,PSECT-INDEX
PSECT ORIGIN
*
T.24: PUSHJ P,RB.2 ;PSECT NAME
JRST E$$RBS ;[1174] BLOCK TOO SHORT
TXO W1,AT.PS ;[1137] REMEMBER THIS PSECT SEEN IN THIS MODULE
HLLZ W3,W1 ;[1137] SAVE ATTRIBUTES IN W3
MOVEI P1,1(W1) ;[1137] SAVE LINK'S PSECT INDEX IN P1
SETZ W1, ;[1137] ASSUME PSECT ORIGIN IS ZERO
JUMPN W2,T.24A ;[1137] IF NAME SPECIFIED, GO CHECK ORIGIN
MOVEI P1,1 ;[1137] DEFAULT PSECT IS AT SLOT 1
MOVE W2,['.LOW. '] ;[1137] AND ITS NAME IS .LOW.
JRST T.24B ;[1137] GO SEE IF ITS ORIGIN IS CORRECT
T.24A: JUMPL W3,T.24B ;[1137] IF NO ORIGIN GIVEN, DON'T TRY TO GET IT
PUSHJ P,RB.1 ;[1137] GET ORIGIN FROM THE REL FILE
JRST E$$RBS ;[1174] NOT THERE?
T.24B: MOVE R,RC.NO ;[1137] LOOP OVER ALL RC BLOCKS
T.24C: MOVE T1,@RC.TB ;[1137] RC BLOCK WHERE THIS PSECT MIGHT BE
CAME W2,RC.NM(T1) ;[1137] IS IT HERE?
SOJG R,T.24C ;[1137] NO, LOOP OVER ALL PSECTS
JUMPE R,T.24D ;[1137] IF NOT FOUND, INSERT A NEW RC BLOCK
TXZ W3,AT.RP ;[1137] WE FOUND IT, SO ALREADY HAVE ORIGIN
;***** SHOULD CHECK HERE FOR CONFLICTING PSECT PROPERTIES *****
IORM W3,RC.AT(T1) ;[1137] ACCUMULATE ATTRIBUTES
JRST T.24E ;[1137] MAKE SURE IT'S WHERE WE EXPECT IT
T.24D: EXCH W1,W3 ;[1137] SET ACS FOR .SET0
PUSHJ P,.SET0## ;[1137] SET UP A NEW RC BLOCK
MOVE R,RC.NO ;[1137] ITS INDEX IS THE LAST PSECT
T.24E: CAMN P1,R ;[1137] IS THE RC BLOCK IN THE RIGHT PLACE?
JRST LOAD## ;[1137] YES, DONE
CAILE P1,1 ;[1153] DISALLOW CHANGING .LOW. OR BELOW
CAMLE P1,RC.NO ;[1153] CATCH GARBAGE PSECT INDICES
JRST E01IPX ;[1174] INDEX IS JUNK, COMPLAIN
MOVE T1,@RC.TB ;[1137] RC BLOCK OF THIS PSECT
EXCH R,P1 ;[1137] POINT TO RC BLOCK IN THE WAY
EXCH T1,@RC.TB ;[1137] PUT OUR RC BLOCK WHERE IT BELONGS
EXCH R,P1 ;[1137] BACK TO WHERE OUR PSECT USED TO BE
MOVEM T1,@RC.TB ;AND OUT OF PLACE BLOCK
JRST LOAD## ;ALL DONE
;HERE ON AN INVALID PSECT INDEX WHEN W2 CONTAINS SIXBIT PSECT NAME.
E01IPX::.ERR. (MS,.EC,V%L,L%F,S%F,IPX) ;[1174]
.ETC. (STR,.EC,,,,,< for psect >)
.ETC. (SBX,.EC!.EP,,,,W2) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
SUBTTL BLOCK TYPE 37 - COBOL LOCAL SYMBOLS
; ----------------
; ! 37 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! ADDRESS !
; ----------------
; ! DATA WORDS !
; ----------------
T.37: TRNN FL,R.SYM ;LOADING WITH SYMBOLS?
JRST T.0 ;NO, IGNORE THIS BLOCK
HRRZI W2,-1(W1) ;GET COUNT OF DATA WORDS
ADDM W2,LOD37 ;COUNT OF BLOCKS LOADED
JRST T.1 ;LOAD AS DATA
SUBTTL BLOCK TYPE 100 -- .ASSIGN OPERATOR IN MACRO
T.100: TRNE FL,R.LIB ;[701] LIBARY SEARCH?
JRST T.0 ;[701] YES, SKIP THIS.
PUSHJ P,RB.1 ;READ FIRST WORD
JRST LOAD## ;SHOULD NOT HAPPEN
PUSH P,W1 ;SAVE FIRST WORD
PUSHJ P,RB.2 ;GET NEXT PAIR
JRST LOAD## ;SHOULD NOT HAPPEN
MOVE W3,W1 ;GET VALUE
MOVX W1,PT.SGN!PT.SYM ;FLAGS
PUSHJ P,R50T6 ;SIXBITIZE IT
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST T.100E ;NOT EVEN IN T\BLE
JRST T.100E ;UNDEFINED STILL
ADD W3,2(P1) ;INCREMENT VALUE
EXCH W3,2(P1) ;SAVE NEW, GET OLD
POP P,W2 ;NEW SYMBOL
PUSHJ P,R50T6 ;SIXBITIZE
PUSHJ P,@T.2TAB+1 ;GLOBAL DEFINITION
JRST T.100R ;RETURN
T.100E: POP P,T1 ;REMOVE JUNK FROM STACK
E$$UAR::.ERR. (MS,.EC,V%L,L%W,S%W,UAR,<Undefined assign for symbol >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
T.100R: PUSHJ P,RB.1 ;IGNORE REST OF BLOCK
JRST LOAD## ;UNTIL WE GET HERE
JRST T.100R ;LOOP
SUBTTL BLOCK TYPE 774, 775, 776 - RADIX50 SYMBOL FILES
; ----------------
; ! 77? ! COUNT !
; ----------------
; ! .JBSYM !
; ----------------
; ! .JBUSY !
; ----------------
; ! SYMBOLS !
; ----------------
T.774::! ;NUMERICALLY SORTED SYMBOL FILE
T.775::! ;ALPHABETICALLY SORTED SYMBOL FILE
T.776:: ;UNSORTED SYMBOL FILE
HRRZI R3,1(W1) ;WORD COUNT + HEADER
MOVEI T2,LN.IO ;NO. OF WORDS REQUIRED
PUSHJ P,DY.GET## ;TO HOLD LOOKUP BLOCK
MOVEM T1,IO.PTR+TC ;ON TEMP CHAN
HRLZI T3,OPENBL ;SAME AS DC CHAN
HRRI T3,(T1)
ADDI T2,-1(T1) ;END OF BLT
BLT T3,(T2) ;MOVE DATA BLOCK
MOVEI T2,.IODPR ;BUT MODE IS DUMP
MOVEM T2,I.MOD(T1)
SETZM I.BUF(T1) ;ZERO DATA WORDS
SETZM I.DVZ(T1) ; NOT REQUIRED
SETZM I.RNG(T1)
MOVSI T2,(Z TC,) ;CHAN
MOVEM T2,I.CHN(T1)
SETZM I.SWT(T1)
MOVEI T1,TC ;CHAN#
MOVEM T1,IO.CHN ;OF NEXT LOOKUP
PUSHJ P,DVCHK.## ;MAKE SURE ITS A DSK
MOVE T1,IO.CHR ;GET IT
TXNN T1,DV.DSK
JRST E01FLE## ;[1174] WILL DO FOR NOW
PUSHJ P,DVOPN.## ;OPEN DEVICE
LOOKUP TC,I.RIB(T1)
JRST E01FLE## ;[1174] FAILED
;HERE WHEN FILE OPENED. ALLOCATE A 1P BUFFER AND READ IT.
;MUST DO IT OURSELVES BECAUSE WE READ THE FILE BACKWARDS.
MOVEI T2,1000 ;BUFFER OF ONE PAGE
PUSHJ P,DY.GET##
MOVE R2,T1 ;SAVE ADDRESS
HRLI R2,R1 ;SETUP @ POINTER TO BUFFER
SETZ R1, ;FLAG NEED NEW INPUT UUO
T776A: PUSHJ P,T776RD ;GET VALUE OF NEXT SYMBOL
MOVE W3,T1 ;STORE AWAY
PUSHJ P,T776RD ;GET SYMBOL ITSELF
MOVE W2,T1 ;PUT IN RIGHT PLACE
LDB P1,[POINT 4,W2,3] ;TYPE CODE
PUSHJ P,R50T6 ;SIXBITIZE
JUMPE P1,T776T ;TITLE BLOCK
TRNE FL,R.LIB!R.INC ;STILL IN LIB SEARCH OR /INC MODE?
JRST T776A ;YES, IGNORE ALL BUT TITLES
MOVX W1,PT.SGN!PT.SYM
.JDDT LNKOLD,T776A,<<CAMN W2,$SYMBOL>>
PUSH P,R ;[702] SAVE R
PUSHJ P,@T.2TAB(P1) ;DO RIGHT THING FOR SYMBOL
POP P,R ;[702] RESTORE R
JRST T776A
;HERE TO READ NEXT WORD FROM 1P INTERNAL BUFFER
T776RD: SOJL R1,T776R1 ;POINT TO NEXT WORD
MOVE T1,@R2 ;LOAD VALUE
POPJ P, ;RETURN IT
T776R1: JUMPE R3,T776R3 ;QUIT IF NO MORE DATA
MOVE T1,R3 ;ELSE GET REMAINING SIZE
IDIVI T1,1000 ;CONVERT TO PAGES & REMAINDER
JUMPN T2,T776R2 ;SKIP THIS IF FIRST TIME
MOVEI T2,1000 ;SIZE OF WINDOW TO READ IN
SUBI T1,1 ;REALLY WANT PREVIOUS PAGE
T776R2: LSH T1,2 ;4 BLOCKS PER PAGE
USETI TC,1(T1) ;GO TO CORRECT BLOCK
SUBI R3,(T2) ;UPDATE WORDS LEFT
MOVE R1,T2 ;REMEMBER HOW MUCH DATA IN BUFFER
MOVN T1,T2 ;FORM IOWD FOR READ-IN
HRLZ T1,T1 ;..
HRRI T1,-1(R2) ;..
SETZ T2, ;TERMINATE IOWD LIST
IN TC,T1 ;READ THE PAGE IN
CAIA
JRST E02EIF ;[1174] HANDLE ERROR
JUMPN R3,T776RD ;DONE UNLESS LAST TIME
SUBI R1,3 ;NEED TO FAKE POINTERS
ADDI R2,3 ;SO WON'T READ HEADER WORDS
JRST T776RD ;GO RETURN THE DATA
T776R3: POP P,(P) ;REMOVE JUNK RETURN ADDR
MOVEI T1,-3(R2) ;ADDR OF BUFFER TO RETURN
MOVEI T2,1000 ;SIZE
PUSHJ P,DY.RET##
PUSHJ P,DVZAP.## ;RETURN TC BLOCK
JRST EOF1## ;END OF SYMBOL FILE
E02EIF::PUSH P,[TC] ;[1174] INDICATE ERROR ON CHANNEL TC
.ERR. (ST,0,V%L,L%F,S%F,EIF) ;[1174] 'ERROR ON INPUT FILE'
;HERE ON A "TITLE" (RADIX50 CODE 0)
T776T: HRR FL,FLAGS ;MAKE SURE FLAGS ARE CORRECT
TRNN FL,R.LIB!R.INC ;NEED AN EXCUSE TO LOAD SYMBOLS?
JRST T776T1 ;NO, MAKE SURE NOT IN /EXCLUDES
PUSHJ P,INCCHK ;YES, DO WE HAVE SUCH AN EXCUSE?
JRST T776A ;NO, SKIP THIS BLOCK OF SYMBOLS
TRZ FL,R.LIB!R.INC ;YES, CLEAR 'DON'T LOAD' FLAGS
JRST T776OK ;AND GO LOAD THIS
T776T1: PUSHJ P,EXCCHK ;IS THIS MODULE IN /EXCLUDES?
JRST [TRO FL,R.LIB ;YES, DON'T LOAD THIS
JRST T776A] ;UNTIL NEXT TITLE BLOCK
;HERE WHEN OK TO "LOAD" THIS MODULE'S SYMBOLS. PUT TITLE IN LS.
T776OK: MOVEM W2,PRGNAM ;STORE FOR ERROR MESSAGES
E02LMN::.ERR. (MS,.EC,V%L,L%I5,S%I,LMN) ;[1174] GIVE INFO MESSAGE
.ETC. (SBX,.EP,,,,PRGNAM) ;FOR LINK DEBUGGERS
MOVE T1,LSYM ;KEEP NAMPTR UP TO DATE
MOVEM T1,NAMPTR ; SO LOCAL BLOCK NAMES WILL WORK
MOVE T1,LSYM ;[662] POINTER TO END OF LS AREA
MOVEM T1,NAMPTR ;[662] REMEMBER WHERE THIS MODULE STARTS
AOS PRGNO ;ONE MORE PROGRAM NAME
.JDDT LNKOLD,T776OK,<<CAMN W2,$NAME>>
MOVX W1,PT.SGN!PT.TTL ;SET FLAGS
PUSHJ P,LS.ADD## ;PUT IN LOCAL SYMBOL TABLE
SETZM LSTSYM ;NOT A REAL SYMBOL SO CLEAR POINTER
MOVX W1,S.TTL!S.PRC ;PROCESSOR TRIPLET
MOVE W2,['LINK '] ;SYMBOL FILES CREATED BY LINK
MOVSI W3,-1 ;LINK IS PROCESSOR -1
PUSHJ P,LS.ADD## ;ADD TO SYMBOL AREA
MOVX W1,S.TTL!S.CRE ;GET DATE TIME STUFF
LDB T2,[POINT 12,FCRE,35] ;GET LOW 12 BITS OF DATE
LDB T1,[POINT 3,FEXT,20] ;GET HIGH 3 BITS
DPB T1,[POINT 3,T2,23] ;MERGE THE TWO PARTS
LDB T1,[POINT 11,FCRE,23] ;GET TIME
IMULI T1,^D60 ;CONVERT TIME TO SECONDS
HRLZ W2,T2 ;STORE DATE IN TRIPLET
HRR W2,T1 ;AND TIME IN SECONDS
SETZ W3, ;DON'T KNOW WHAT VERSION CREATED
PUSHJ P,LS.ADD
PUSH P,R1 ;SAVE R1 OVER TTLREL
PUSHJ P,TTLREL ;PUT OUT REL FILE DESCRIPTOR INFO
POP P,R1 ;RESTORE OUR WORD COUNT
MOVX W1,S.TTL!S.SEG!S.LST ;LOW/HIGH REL COUNTERS
SETZB W2,W3 ;SET BOTH ZERO
PUSHJ P,LS.ADD
JRST T776A ;START READING IN SYMBOLS
SUBTTL BLOCK TYPE 777 - MACRO UNIVERSAL FILE
; ----------------
; ! 777 ! COUNT !
; ----------------
; ! SYMBOL TABLE !
; ----------------
T.777:
E$$UNS::.ERR. (MS,.EC,V%L,L%F,S%F,UNS,<Universal file REL block (type 777) not supported>) ;[1174]
.ETC. (NLN,.EC) ;[1174]
.ETC. (STR,.EC,,,,,<from file >) ;[1174]
.ETC. (FSP,,,,,DC)
SUBTTL RELOCATION AND BLOCK INPUT - OLD BLOCKS
;ENTER WITH WC = WORD COUNT IN AOBJN FORM
;LEFT HALF NEGATIVE NUMBER OF WORDS LEFT IN BLOCK
;RIGHT HALF NEGATIVE NUMBER OF WORDS IN CURRENT SUB-BLOCK
;RB = BYTE WORD UNLESS END OF SUB-BLOCK, IN WHICH CASE RB WILL BE SET UP
;READS TWO WORDS USING RB.1
;RETURNS FIRST WORD IN W2, SECOND WORD IN W1
RB.2:: PUSHJ P,RB.1 ;READ FIRST WORD OF PAIR
POPJ P, ;ERROR RETURN
MOVE W2,W1 ;SAVE IT IN W2
TRNE WC,377777 ;SEE IF SECOND WORD EXISTS
JRST RWORD1 ;INPUT SECOND WORD OF PAIR AND RETURN
SETZ W1, ;NO,RETURN ZERO
JRST CPOPJ1 ;BUT GIVE SKIP RETURN
;RETURN WITH R = POINTER TO RELOCATION BLOCK
;W1 = WORD READ FROM BINARY FILE
;ALSO USES T1
RB.1:: TRNN WC,377777 ;TEST FOR END OF BLOCK
POPJ P, ;NON-SKIP RETURN
RWORD1: AOBJN WC,RWORD2 ;JUMP IF NOT CONTROL WORD
PUSHJ P,D.IN1## ;GET 1 WORD
MOVE RB,W1 ;SAVE RELOCATION BITS
HRLI WC,-^D18 ;RESET WORD COUNT
RWORD2: PUSHJ P,D.IN1## ;READ 1 WORD
SETZ R, ;CLEAR OLD RELOCATION BITS
LSHC R,1 ;GET NEXT
JUMPE R,RWORD3 ;NO RELOCATION REQUIRED
HLRZ T1,W1 ;GET UNRELOCATED ADDRESS
SKIPE RC.CUR ;GET INDEX TO CURRENT PSECT
JRST [MOVE R,RC.CUR
JRST RWORD5]
TRNN FL,R.TWSG ;POSSIBLE TWO SEGMENTS?
JRST RWORD5 ;NO
MOVE T2,SO.S2 ;GET START OF HIGH SEGMENT
CAILE T2,NEGOFF(T1) ;IN HIGH SEG?
JRST RWORD5 ;NO
ADDI R,1 ;YES, INC SEG POINTER
SUB T1,T2 ;REMOVE BASE ADDRESS
RWORD5: MOVE R,@RC.TB ;PICKUP POINTER TO DATA BLOCK
SKIPGE RC.AT(R) ;[1155] DOES THIS PSECT HAVE AN ORIGIN?
JRST R.ERR ;[1155] NO, CAN'T USE IT
SKIPE RC.CUR ;[1155] RELOCATE WRT A PSECT?
JRST [ADD T1,RC.CV(R);[1155] YES, PSECTS ARE SIMPLE
JRST RWORD4] ;[1155] GO STORE AND CHECK RH RELOCATION
MOVE T2,RC.SG(R) ;[1155] OLD LOWSEG/HIGHSEG, GET SEGMENT #
MOVE T2,LL.S0(T2) ;[1155] GET ORIGIN OF SEGMENT
ADD T2,RC.CV(R) ;[1155] ADD CURRENT VALUE OF RELOC. COUNTER
SUB T2,RC.IV(R) ;[1155] T2 NOW HAS RELOCATION FACTOR
ADDI T1,0(T2) ;[1155] RELOCATE THE HALF WORD
RWORD4: HRL W1,T1 ;[1155] STORE THE RESULT
MOVX R,1B1 ;[1155] CLEAR R BUT REMEMBER RELOCATABLE
;HERE TO CHECK RIGHT RELOCATION
RWORD3: SETZM LSTRRV ;[1204] ASSUME ABSOLUTE
LSHC R,1 ;GET RIGHT RELOCATION
TRNN R,-1 ;SEE IF RELOCATABLE
JRST CPOPJ1 ;NOT RELOCATED
HRRZ T1,W1 ;GET UNRELOCATED ADDRESS
SKIPE RC.CUR ;GET INDEX INTO CURRENT PSECT
JRST [MOVE R,RC.CUR
JRST RWORD6]
TRNN FL,R.TWSG ;POSSIBLE TWO SEGMENTS?
JRST RWORD6 ;NO
MOVE T2,SO.S2 ;GET START OF HIGH SEGMENT
CAILE T2,NEGOFF(T1) ;IN HIGH SEG?
JRST RWORD6 ;NO
ADDI R,1 ;YES, INC SEG POINTER
SUB T1,T2 ;REMOVE BASE ADDRESS
RWORD6: HRR R,@RC.TB ;PICKUP POINTER TO DATA BLOCK
TLO R,(1B1) ;MARK RELOCATION
SKIPGE RC.AT(R) ;[1155] DOES THIS PSECT HAVE AN ORIGIN?
JRST R.ERR ;[1155] NO, CAN'T USE IT
SKIPE RC.CUR ;[1155] RELOCATE WRT A PSECT?
JRST [ADD T1,RC.CV(R);[1155] YES, PSECTS ARE SIMPLE
JRST RWORD8] ;[1155] GO STORE
MOVE T2,RC.SG(R) ;[1155] OLD LOWSEG/HIGHSEG, GET SEGMENT #
MOVE T2,LL.S0(T2) ;[1155] GET ORIGIN OF SEGMENT
ADD T2,RC.CV(R) ;[1155] ADD CURRENT VALUE OF RELOC. COUNTER
SUB T2,RC.IV(R) ;[1155] T2 NOW HAS RELOCATION FACTOR
ADD T1,T2 ;[1204] COMPUTE FULL-WORD RESULT
RWORD8: MOVEM T1,LSTRRV ;[1204] STORE FOR BREAK CHECKS
HRR W1,T1 ;[1155] STORE THE RESULT
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P,
R.ERR: MOVE T1,RC.NM(R) ;[761] GET PSECT NAME
E$$SRP::.ERR. (MS,.EC,V%L,L%F,S%F,SRP,</SET: switch required for psect >) ;[1174]
.ETC. (SBX,.EC!.EP,,,,T1) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
;CHKSEG - ROUTINE TO SEE IF ADDRESS IS REQUIRED OR NOT
;ENTER WITH ADDRESS IN W1
;RETURNS
;+1 REQUIRED
;+2 NOT REQUIRED
CHKSEG: TRNN FL,R.TWSG ;MUST BE A TWO SEGMENT PROGRAM
POPJ P,
SKIPE LL.S2 ;AND MUST HAVE SETUP HIGH SEG
CAMGE W1,LL.S2 ;IN HIGH
JRST [TRNN FL,R.LSO ;WANT LOW?
AOS (P) ;NO
POPJ P,]
TRNN FL,R.HSO ;WANT HIGH?
AOS (P) ;NO
POPJ P,
E$$RBS::.ERR. (MS,.EC,V%L,L%F,S%F,RBS,<REL block type >) ;[1174]
.ETC. (OCT,.EC!.EP,,,,T1)
.ETC. (STR,.EC,,,,,< too short>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
IFN DEBSW,<
$NAME:: .-. ;CHANGE TO REQUIRED SIXBIT PROG NAME
>
SUBTTL THE END
OLDLIT: END