Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-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 27-Feb-78
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
ENTRY LNKOLD
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==765
;LOCAL ACC DEFINITIONS
INTERN R,RB,WC
R=R1 ;CURRENT RELOCATION COUNTER
RB=R+1 ;RELOCATION BYTE WORD
WC=R3 ;WORD COUNT
SEGMENT
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;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)
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
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 T.ERR## ;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 T.ERR## ;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 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 P3, ;[732]
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
JUMPL P3,T1HSTL ;ERROR
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
T1HSTL: .ERR. (MS,,V%L,L%F,S%F,STL,<High segment code too long>)
;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 T.ERR## ;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
.ERR. (MS,.EC,V%L,L%F,S%F,DSC,<Data store to common >)
.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
.ERR. (MS,.EC,V%L,L%F,S%F,DSL,<Data store to location >)
T.1OVF: .ETC. (OCT,.EC!.EP,,,,P3)
T.1OVG: .ETC. (STR,.EC,,,,,< not in link number >)
.ETC. (DEC,.EP!.EC,,,,W3)
.ETC. (STR,.EC,,,,,< for >)
.ETC. (SBX,.EC!.EP,,,,PRGNAM)
.ETC. (STR,.EC,,,,,< in >)
.ETC. (FSP,,,,,DC)
JRST T.0C ;GET RID OF BLOCK
T.1OVW: SOS LNKMAX ;PUT LINK # BACK
.ERR. (MS,.EC,V%L,L%F,S%W,DSL)
.ETC. (JMP,.EC,,,,T.1OVF)
>
;HERE IF SYMBOLIC ADDRESS NOT YET DEFINED
T.1UN: PUSHJ P,T.1FX ;PUT WHOLE BLOCK IN FIXUP TABLE
.ERR. (MS,.EC,V%L,L%F,S%F,CNW)
.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
.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::T.2R5U ; 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)
T.2R5U ; 4 - 20
SY.DGR ; 5 - 24 GLOBAL DEFINITION DEFERED RIGHT HALF
T.2R5U ; 6 - 30
T.2R5U ; 7 - 34
T.2R5U ;10 - 40
SY.GSS ;11 - 44 GLOBAL DEF. (SUPPRESSED) ! LEFT DEFERED
SY.LSS ;12 - 50 LOCAL DEF. (SUPPRESSED)
T.2R5U ;13 - 54
SY.RQ ;14 - 60 GLOBAL REQUEST
SY.DGL ;15 - 64 GLOBAL DEFERED DEF (RH) SUPP. ! LEFT HALF
T.2R5U ;16 - 70
; T.2R5U ;17 - 74
T.2R5U: .ERR. (MS,.EC,V%L,L%F,S%I,URC,<Unknown radix-50 symbol code >)
.ETC. (OCT,.EC!.EP,,,,P1)
.ETC. (STR,.EC,,,,,< >)
.ETC. (SBX,.EC!.EP,,,,W2)
.ETC. (STR,.EC,,,,,< in >)
.ETC. (SBX,.EC!.EP,,,,PRGNAM)
.ETC. (STR,.EC,,,,,< in >)
.ETC. (FSP,,,,,DC)
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
;*;CHANGE @T.2CHK+2 DMN 10-JULY-75
PUSH P,W1 ;SAVE FLAGS
HRRZ W1,W3 ;PUT ADDRESS IN W1
PUSHJ P,CHKSEG ;SEE IF WANTED
CAIA ;YES
;*;CHANGE @T.2CHK+5 DMN 10-JULY-75
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-10 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
MOVE W2,T3 ;PUT BACK IN W2
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
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 T.5SER ;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
PUSHJ P,TRYSYM## ;SEE IF IN TABLE
JRST SY.DG0 ;NO, PUT IN
JRST SY.DG1 ;ALREADY IN UNDEF TABLE
IFN FTOVERLAY,<
POP P,BG.SCH ;[626] RESTORE BOUND GLOBAL STATE
> ;END OF IFN FTOVERLAY
JRST SY.DG2 ;[567] INCONSISTENT SYMBOL DEFINITION
;HERE TO PUT REQUEST IN GLOBAL TABLE
;USE EXTENDED BLOCK TO HOLD PARTIAL VALUE
SY.DG0:
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:
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 ;YES, SECOND PARTIAL DEFINITION
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
SY.DG2: .ERR. (MS,.EC,V%L,L%W,S%W,ISD,<Inconsistent symbol definition for >)
.ETC. (SBX,.EP,,,,W2)
SETZM LSTSYM ;SO WE IGNORE SYMBOL FIXUP FOLLOWING
POPJ P,
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,<
.ERR. (MS,,V%L,L%F,S%F,ESN)>
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 SY.RUH ;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
SY.RUH: .ERR. (MS,.EC,V%L,L%F,S%F,CNW)
.ETC. (STR,,,,,,<SY.RUH>)
SUBTTL BLOCK TYPE 3 - HIGH SEGMENT INDICATOR
; ----------------
; ! 3 ! 1 !
; ----------------
; ! BYTE WORD !
; ----------------
; ! HIGH ! HIORG !
; ----------------
; ! LOW ! LOORG !
; ----------------
T.3: 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
.ERR. (MS,0,V%L,L%I,S%I,SFU)
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
;BLOCK TYPE 5 SEEN
T.3TSO: .ERR. (MS,.EC,V%L,L%F,S%F,TSO,<Cannot load a two segment module in one segment >)
.ETC. (FSP,0,,,,DC)
;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,T.3F ;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
IFE TOPS20,<
; CAIL W1,400000 ;ERROR IF LESS THAN 128K>
CAMG W1,RC.CV(R) ;BUT MUST BE HIGHER THAN LOW SEG
JRST T.3F ;TOO LOW
MOVEI T2,-.FRESP-1(W1) ;[745] RESERVED SOME FREE SPACE
MOVEM T2,SYMLIM ;[745] CORRECT SYMBOL TABLE LIMIT
MOVEI R,2 ;RELOCATION FOR HIGH SEGMENT
MOVE R,@SG.TB ;GET BLOCK POINTER
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
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
SETZM RC.HL(R)
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,NO.COR##
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
T.3F: .ERR. (MS,,V%L,L%F,S%F,HSL,<Attempt to set high segment origin too low>)
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: 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.2 ;GET BOTH WORDS
JRST [MOVEI T1,5
JRST ILIERR]
TLNE W1,-1 ;MAKE SURE VALID
PUSHJ P,T.5W1 ;NOT
TLNE W2,-1
PUSHJ P,T.5W2 ;SAME FOR W2
SKIPE W3,LOD37 ;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
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
SETZM RC.HL(R) ;CLEAR HIGHEST IN PROGRESS
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
SETZM RC.HL(R)
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 T.5SER ;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 T.5SER
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
SKIPN T2,RC.HL(T1) ;DID WE LOAD CODE FOR THIS ONE?
JRST T.5PSB ;NO
MOVE W2,RC.NM(T1) ;GET NAME
HRLZ W3,RC.CV(T1) ;ORIGIN
HRR W3,RC.HL(T1) ;TOP
HLL T3,RC.AT(T1) ;[722] GET ATTRIBUTE
TXNE T3,AT.OV ;[722] TO BE OVERLAYED?
JRST [CAMLE T2,RC.CV(T1) ;[757] THIS MODULE CAUSE AN
JRST T.5PSB ;[757] OVERLAYABLE PSECT TO GROW? NO,
JRST T.5PSD] ;[757] YES, DON'T UPDATE RC.CV
CAMLE T2,RC.CV(T1) ;BIGGER THAN WHAT WE HAVE?
MOVEM T2,RC.CV(T1) ;YES
SETZM RC.HL(T1) ;[757] CLEAR 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
SETZM RC.HL(R) ;CLEAR HIGHEST IN PROGRESS
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
SETZM RC.HL(R) ;CLEAR HIGHEST IN PROGRESS
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
SETZM RC.HL(R)
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
SETZM RC.HL(R)
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
T.5SER: .ERR. (MS,0,V%L,L%W,S%W,SFU) ;
JRST T.5RET ;TRY TO CONTINUE
;HERE WHEN PROGRAM BREAK IS INCORRECT, ZERO BREAK AND CONTINUE
T.5W1: .ERR. (MS,.EC,V%L,L%W,S%W,PBI,<Program break >)
.ETC. (OCT,.EP!.EC,,,,W1)
.ETC. (STR,.EC,,,,,< invalid in >)
.ETC. (SBX,.EP,,,,PRGNAM)
SETZ W1, ;CLEAR AND CONTINUE
POPJ P,
T.5W2: .ERR. (MS,.EC,V%L,L%W,S%W,PBI)
.ETC. (OCT,.EP!.EC,,,,W2)
.ETC. (STR,.EC,,,,,< invalid in >)
.ETC. (SBX,.EP,,,,PRGNAM)
SETZ W2, ;CLEAR AND CONTINUE
POPJ P,
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,EOFTS## ;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 ILIERR]
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>>
.ERR. (MS,.EC,V%L,L%I5,S%I,LMN,<Loading module >)
.ETC. (SBX,.EP,,,,PRGNAM)
;HERE TO TAKE PROPER ACTION BASED ON THE CPU TYPE AND COMPILER CODE.
AOS PRGNO ;COUNT THIS PROGRAM
HLRZ T1,0(P) ;GET TYPE
HRRZS 0(P) ;AND CLEAR IT FROM STACK
HRRZ T2,T1 ;GET CPU TYPE
LSH T2,-^D12 ;RIGHT JUSTIFIED (WAS BITS 0-5)
ANDI T1,7777 ;AND CLEAR FROM COMPILER INDEX
CAILE T1,CT.LEN ;CHECK FOR RANGE
SETZ T1, ;MAKE IT UNKNOWN
CAILE T2,CP.LEN ;SAME FOR CPUS
SETZ T2, ;MAKE ILLEGAL VALUES UNKNOWN
HRLZM T1,CTYPE ;STORE PROCESSOR CODE
HRRM T2,CTYPE ;AND CPU TYPE CODE
MOVE T3,PROCSN ;GET LIST OF DIF PROCESSORS SEEN
MOVE T4,CPUSN ;AND CPUS
MOVE P1,T1 ;SAFE PLACE
MOVE P2,T2
XCT CT.NAM##(T1) ;SEE IF ANYTHING SPECIAL TO DO
MOVE T3,CT.BIT##(P1) ;GET CORRESPONDING BIT
MOVE T4,CP.BIT##(P2) ;ALSO FOR CPU
IORM T3,PROCSN ;SIGNAL WE HAVE SEEN THIS ONE
IORM T3,LIBPRC ;A NEW MODULE THIS LIBRARY PASS
IORM T4,CPUSN
;HERE TO HANDLE BLANK COMMON ARG IN TITLE BLOCK
POP P,T1 ;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
.ERR. (MS,.EC,V%L,L%F,S%F,IBC,<Attempt to increase size of blank common from >)
.ETC. (DEC,.EC!.EP,,,,T2)
.ETC. (STR,.EC,,,,,< to >)
.ETC. (DEC,.EP,,,,T1)
;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 ILIERR]
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 T.ERR## ;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 T.10TS ;SHOULD NOT HAPPEN
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
T.10TS: .ERR. (MS,.EC,V%L,L%W,S%W,RBS,<REL Block Type >)
.ETC. (OCT,.EC,,,,10)
.ETC. (STR,.EC,,,,,< too short for >)
.ETC. (FSP,,,,,DC)
JRST LOAD## ;TRY TO CONTINUE
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 THRU
;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
HLRZ T1,W1 ;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
CAILE T1,RC.NO ;MAKE SURE VALID
JRST T11IPX ;INVALID
MOVEM T1,RC.CUR ;SET FOR NEXT READ
SKIPN P4 ;ALREADY BEEN SET?
MOVE P4,T1 ;NO, THIS IS FIRST TIME
HRRO P4,P4
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
CAILE T2,RC.NO ;MAKE SURE VALID
JRST T11IPX ;INVALID
MOVEM T2,RC.CUR ;SET FOR NEXT READ
SKIPN P4 ;INCASE, THIS IS THE FIRST PSECT INX IN THIS BLK
MOVE P4,T2 ; THEN SAVE IT
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
T11IPX: .ERR. (MS,,V%M,L%F,S%F,IPX,<Invalid PSECT index>)
;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 T11SPE ;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
T11SPE: .ERR. (MS,.EC,V%L,L%F,S%F,ISO,<Invalid store operator >)
.ETC. (OCT,.EP,,,,T1)
;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 T11DFE ;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 T11DFE
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
T11DFE: .ERR. (MS,,V%L,L%F,S%F,ISP)
;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 T11RPE
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
MO