Trailing-Edge
-
PDP-10 Archives
-
BB-Y390T-BM
-
lngsrc/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/PY/MFB/PAH/HD/JBS/RJF 14-Jul-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SEARCH OVRPAR ;[1400]
IFN TOPS20,<SEARCH MONSYM> ;[1401]
SALL
ENTRY LNKOLD
EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2421 ;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.
;1000 Add code for block 1070 support.
;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).
;START OF VERSION 4B
;1224 Test more carefully for bad polish blocks, and give more messages.
;1231 Initialize HL.S2 in SETRC so high segment really exists with /SET:.HIGH..
;1233 Just consider RC.CV in T.5.
;1237 Make LNKCCD not fatal, print it only once.
;1240 Test bits from /CPU switch when checking for CPU conflict.
;1243 Handle left half fixups to global symbols correctly.
;1245 Fix typo in edit 1224.
;1253 Remove edit 1233, must consider RC.HL
;1273 Make RC.HL for .HIGH. and .LOW. only keep count for current module.
;1274 Add code to handle Polish stack overflow. Build larger stack and BLT.
;1276 Don't set SEG:HIGH up unless module is being loaded.
;1300 Implement RC.LM tests, check AT.RP for Psect which needs address.
;1303 Change the LNKLNM message to also include the file name.
;1304 Use RC.MAP to convert local psect numbers into internal numbers.
;1306 Output LNKMPT error if TWOSEG mixed with PSECT.
;1327 Fix left half fixup case missed by edit 1243.
;1330 Add functions 30, 34 ,70 ,74 to type 2 block.
;START OF VERSION 5
;1400 Use OVRPAR.MAC and implement writable overlays.
;1401 Nativize overflow file handling.
;1402 Nativize REL file handling.
;1417 Fix bug involved in skipping index blocks, broken in 1402.
;1421 Fix bug in displaying .REL file creation dates, broken by 1402.
;1434 Add T.1004 support.
;1442 Don't let high segments be put in nonzero sections.
;1450 Fix ext addr bugs, remove hard-wired sect 0 tests.
;1463 Don't miss the sect number relocation at T.11ST.
;1466 Don't miss the sect number reloaction at T.11RD.
;Start of Version 5.1
;1473 Bracket extended-addressing-specific code if not done already.
; Edits 1500-1677 Reserved for Maintenance
;
;1501 Don't lose section number in PSECT reloc at T.11EV.
;1502 Suppress typeout of garbage names when halfword chained fixup
; routines are called from T.11ST.
;1504 Fix typo in test at T.2+2 for 30-bit relocation.
;1512 Test MODTYP, not RC.CUR, to determine if PSECTs have been loaded.
;1517 Remove edit 1512.
;1536 Set section number when paging multisection LS area.
;1715 Don't lose PSECT break info.
;1716 Do correct relocation at R.CUR.
;1717 Do left halfword relocation correctly in R.CUR.
;1731 Make TOOBIG and T.1OVE global symbols.
;1736 Strip unsupported FMXFOR code.
;1754 Make symbols global for use by Type 1072 code, also enable new operators
;1756 Make PSECT breaks keep their section numbers during relocation
;1761 keep user defined start address section numbers during relocation
;1764 Make user specified entry vectors work in non-zero sections
;1765 Put back -10 code removed by edit 1764.
;1766 Remove line inserted in edit 1715
;1772 Change edit 1765 from FTFRK2 conditional to TOPS20 conditional
;1775 Make absolute start addresses work.
;1776 Restructure T.1AD to be callable as a subroutine.
;2003 Make LNKCCD a warning.
;2026 Update copyright notices and cleanup listing.
;2047 Remove code which makes wrong decision about COMMON block loading.
;2057 Don't hang if symbol table is fouled up.
;2064 Clear P1 in T11CHx to avoid HALT when loading relocatable overlays.
;Start of Version 6
;2200 Use 30 bit addresses in fixups.
;2201 Use fullword replacement deferred fixup for polish fullword store.
;2202 Use 30 bit addresses for xx.IN and xx.OUT, remove FTFRK2 and NONZER.
;2203 In type 11 blocks keep section numbers of relocated halfwords.
;2204 Don't lose section numbers in the type 10 block.
;2205 Allow big common blocks in psects, absolute address loads in psects.
;2207 Don't add 1 to external psect number before converting to internal.
;2212 Make some type 11 block routines global so type 1072 can use them.
;2214 Add 30 bit fixup support.
;2215 Don't have GBCK.L zero pages which have been unmapped.
;2216 Handle long symbols in SY.GS and SY.QS.
;2220 Handle long common block names.
;2222 Add conflicting attributes messages, make routines global for T.105x.
;2223 Add psect redirection.
;2226 Remove unnecessary long compare for /INCLUDE, /EXCLUDE in type 6 block.
;2230 Give ?LNKCMP error if common in multiple incompatible psects.
;2233 Make sure a default psect is set if loading psects.
;2240 Don't merge chains if old chain starts at section,,0.
;2244 Handle big psect breaks correctly in T.23B.
;2247 Don't create .LOW. if not used, don't start paging on TOPS-20.
;2253 Create .LOW. if /SEG:LOW and FORTRAN style type 3 block.
;2254 Use 30 bit fields in LS area, remove FAIL block header chain.
;2255 Use only 30 bit addresses in LS fixups.
;2262 Don't section-check absolute addresses, add global entry for T.1160.
;2264 Don't throw away section number of symbol in type 1 block.
;2272 Create high segment if redirecting it to .HIGH.
;2273 Fix type 12 blocks, use 30 bit addresses.
;2301 Don't use native message for non-native rel file open.
;2305 Make SY.RC0 global so it can be called from 1070 code.
;2307 Remove bad tests which cause incorrect LNKPEL errors.
;2324 Make polish chained fixup handlers clear P1 before calling SY.CHx.
;2326 Change CAMN in T6SCN1 to PUSHJ P,NAMCMP - make T.6RED and T.6RC global.
;2332 Use fullword value in symbol fixups.
;2356 Remove unnecessary TOPS20 conditionals.
;2366 Remove bad code which tries to keep LC area within section zero.
;2367 Subtract lower LC window in case LNKCOR overflows.
;2372 Use right half of LL.S2 to calculate seg origin for title info.
;2376 Handle long program name correctly for output in execution message.
;2403 New corporate copywrite statement.
;2404 Store long load name in PRGBLK.
;2411 Correct count when comparing long symbols.
;2412 Add code to keep track of the closest PSECT above us for type-24,
; so we can give a warning when psects overlap.
;2414 Fix SETNH to check for the same relocation pointer in RC.TB twice.
; Fortran programs and /REDIRECT can cause this.
;2417 Update copywrite statement to 1988.
;2421 /EXCLUDing a module from an indexed library caused the index
; to never be used again.
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
;[1434] Called from T.1, T.21, and T.1004
T.0C: JUMPE W3,CPOPJ ;[1434] T.1004 RETURN
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,T.1NS ;[2205] NOT SYMBOLIC
MOVEI T1,1 ;BLOCK TYPE INCASE ERROR
PUSHJ P,T.1S ;SYMBOLIC IF BIT 0 SET
ADD W1,W2 ;[2205] GET START ADDRESS IN W1
T.1NS: HLLZ T1,LSTRRV ;[2264] GET THE SECTION NUMBER
ADD W1,T1 ;[2264] ADD IT TO THE ADDRESS
MOVE P3,W1 ;SAVE START ADDRESS IN P3
ADD W1,W3 ;HIGHEST ADDRESS NEEDED
SETO W3, ;[1434] NOT TYPE 21 OR 1004
PUSHJ P,T.1AD ;[1776] SET UP WINDOWS AND COUNTERS
JRST T.0C ;[1776] WE DON'T WANT THIS BLOCK
JRST T.1LPJ ;[1776] DEFER THIS DATA
JRST T.1DP ;[1776] ALL SET, LOAD IT
T.1AD::
;[1776] Global Routine
; Used by T.1, T.21, T.1004 and T.1010-T.1034 processing.
; Expects P3 to contain the first address to load.
; Expects W1 to contain the last address to load.
; May call LNKCOR or cause paging of areas.
; Returns three ways:
; nonskip - the block should not be loaded
; skip +1 - the destination is not resident
; skip +2 - P3 points to the resident destination
POP P,T1 ;[1776] PICK UP RETURN ADDR
SPUSH <P1,P2> ;[1776] SAVE PERMANENT REGS
PUSH P,T1 ;[1776] AND RESTACK THE RETURN
JUMPE R,T1AD1 ;[2262] SKIP THIS IF ABSOLUTE
HLRZ T1,W1 ;[1412] SECTION OF START
HLRZ T2,P3 ;[1412] SECTION OF END
CAMN T1,T2 ;[1412] CROSSED A BOUNDARY?
JRST T1AD1 ;[1412] NO, PROCEED AS USUAL
MOVE T1,RC.AT(R) ;[1412] CHECK ATTRIBUTES
TXNE T1,AT.NZ ;[1776] NONZERO SECTIONS OK?
TXNE T1,AT.NC ;[1776] CROSSING OK?
PUSHJ P,E$$PTL ;[1412] NO, TELL USER
T1AD1:
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
T1AD2: MOVE T1,RC.SG(R) ;[2205] 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 T1ADX0 ;[1776] LEAVE NONSKIP
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
CAMG W1,RC.HL(R) ;[2412] TEST AGAINST HIGHEST SEEN SO FAR
JRST T.1AL ;[2412] NOT THE HIGHEST SO FAR
MOVEM W1,RC.HL(R) ;A NEW RECORD
T.1CO: SKIPN T1,RC.NH(R) ;[2412] RELOC PTR FOR NEXT HEGHEST PSECT
JRST T.1AL ;[2412] NONE HIGHER
CAMG W1,RC.IV(T1) ;[2412] OVERLAP WITH NEXT HIGHER
JRST T.1AL ;[2412] NO - ALL'S COOL
MOVX T2,AT.OM ;[2412] OVERLAP MESSAGE GIVEN BIT
TDNE T2,RC.AT(R) ;[2412] ALREADY KNOWN TO BE OVERLAPPING?
JRST T.1AL ;[2412] YES - JUST CONTINUE
IORM T2,RC.AT(R) ;[2412] IT WILL BE NOW
PUSH P,W1 ;[2412] SAVE W1
MOVE W1,RC.IV(T1) ;[2412] ORG OF PSECT BEING OVERLAPPED
MOVE T2,RC.NM(T1) ;[2412] NAME OF PSECT BEING OVERLAPPED
MOVE T1,RC.NM(R) ;[2412] OUR PSECT NAME
PUSHJ P,E$$POP ;[2412] REPORT THE WARNING
POP P,W1 ;[2412] RESTORE W1
T.1AL:
CAMLE W1,RC.LM(R) ;[1300] IS FIRST UNUSED ADDR TOO BIG?
PUSHJ P,TOOBIG ;[1300] YES, ERROR
IFN FTOVERLAY,<
CAMGE P3,PH+PH.ADD ;[1400] 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
>
IFE TOPS20,< ;[2247]
SKIPE PAG.S1 ;PAGING?
>;[2247] IFE TOPS20
JRST T.1LP ;YES, SEE IF IN CORE
IFE TOPS20,< ;[2247]
IFN FTOVERLAY,<
SUB P2,PH+PH.ADD ;[1400] REMOVE BASE
SUB P3,PH+PH.ADD ;[1400] 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+PH.ADD ;[1400] DSK RTNS WANT ABS ADDRESS
JRST T.1LP] ;MUST BE ON DSK BY NOW
> ;END OF IFN FTOVERLAY
SUB P3,LW.S1 ;[2367] INCASE WE DUMPED CORE FOR FIRST TIME
>;[2247] IFE TOPS20
T.1L1: ADD P3,LC.LB ;FINALLY FIX THIS INCASE CORE MOVED
JRST T1ADX2 ;[1776] +2 SKIP RETURN
IFE TOPS20,< ;[2247]
;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
POP P,P3 ;[2366] RESTORE THE AC
JRST T.1AL1 ;[2366] CONTINUE
> ;[1755] IFE TOPS20
;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 T1ADX1 ;[1776] NOT RESIDENT
PUSH P,W3 ;PG.LSG SOMETIMES CRUMPS W3
IFN FTOVERLAY,<
SUB P2,PH+PH.ADD ;[1400] PG.LSG WANTS OFFSET ADDRESSES
SUB P3,PH+PH.ADD ;[1400] 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
;HERE FOR ABSOLUTE CODE THIS CAN GO TO EITHER HIGH OR LOW SEGMENT
;KEYED UPON LL.S2, USUALLY TO LOW SEG
T.1A: TRNN FL,R.RED ;[2223] DOING /REDIRECT?
SKIPGE MODTYP ;[2247] OR DOING PSECTS?
JRST T.1AP ;[2205] YES, TRY TO PUT IT IN A PSECT
T.1A1: MOVEI R,2 ;ASSUME HIGH
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 T1ADX0 ;[1776] YES, NONSKIP RETURN
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
;[2205] Here to figure out psects. If the area being stored is entirely
;[2205] in one psect, set up as a store to that psect. This is the case
;[2205] with FORTRAN style COMMON, which uses a symbol+offset load address.
;[2205] treat it the same as non-psected. This attempts to avoid problems
;[2205] with the memory map in the program data vector, which is psect
;[2205] oriented. An optimization is to try the "current" psect in RC.CUR,
;[2205] before looping through the psects.
;
T.1AP: MOVE R,RC.CUR ;[2205] Get the current psect
MOVE R,@RC.TB ;[2205] Point to it
CAML P3,RC.IV(R) ;[2205] Below the bottom of the psect?
CAMLE W1,RC.CV(R) ;[2205] No, below the top?
SKIPA R,RC.NO ;[2205] Not this one, loop through them all
JRST T1AD2 ;[2205] Now have a value for R
T1AP1: MOVE T1,@RC.TB ;[2205] Point to it
CAML P3,RC.IV(T1) ;[2205] Below the bottom of the psect?
CAMLE W1,RC.CV(T1) ;[2205] No, below the top?
SOJG R,T1AP1 ;[2205] Not in this psect
JUMPE R,T.1A1 ;[2205] If not in a psect, put it in .ABS.
MOVE R,T1 ;[2205] Put the pointer in R
JRST T1AD2 ;[2205] Now have a value for R
T.1HA: MOVE R,@SG.TB ;FIXUP R FOR ABS TO HIGH
T.1H: CAMLE W1,RC.LM(R) ;[1300] IS FIRST UNUSED ADDR TOO BIG?
PUSHJ P,TOOBIG ;[1300] YES, ERROR
TRNE FL,R.LSO ;WANT LOW SEG CODE ONLY
JRST T1ADX0 ;[1776] YES, NONSKIP RETURN
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 T1ADX2 ;SKIP RETURN
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
T.1OVE::AOS W3,LNKMAX ;[1731] 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 T1ADX0 ;[1776] NONSKIP RETURN
T.1OVW: SOS LNKMAX ;PUT LINK # BACK
E01DSL::.ERR. (MS,.EC,V%L,L%F,S%W,DSL) ;[1174]
.ETC. (JMP,.EC,,,,T.1OVF)
T1ADX2: AOS (P) ;[1776] +2 RETURN
T1ADX1: AOS (P) ;[1776] +1 RETURN
T1ADX0: POP P,T1 ;[1776] NORMAL RETURN
SPOP <P2,P1> ;[1776] GET IT ALL BACK
JRST (T1) ;[1776] AND RETURN
T.1DP::
;[1776] JUMPE W3,CPOPJ1 ;[1434] JUST RETURN TO CALLER (T.1004)
IFN FTOVERLAY,<
SKIPE RT.LB ;[1401] DOING OVERLAYS?
SKIPA P1,[JSP T1,CS.RHS##]
;[1401] YES, NOTE OVL RELOC
> ;[1401] END OF IFN FTOVERLAY
MOVE P1,[MOVEM W1,(P3)]
;[1401] NO, SIMPLE DEPOSIT
T1DP1: PUSHJ P,RB.1 ;GET THE DATA WORDS
JRST LOAD## ;FINISHED BLOCK
XCT P1 ;[1401] DO IT
SOJE W3,CPOPJ ;T.21 RETURN
AOJA P3,T1DP1 ;WILL RETURN TO LOAD WHEN RUN OUT
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
TXO T2,CPF.RF ;[2200] 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)
CHKSZ0:: ;[2222]
PUSH P,R ;[1300] FREE UP REGISTER
MOVE R,RC.CUR ;[1300] GET CURRENT BLOCK NUMBER
MOVE R,@RC.TB ;[1300] GET POINTER TO BLOCK
CAMLE W1,RC.LM(R) ;[1300] PSECT TOO BIG?
PUSHJ P,TOOBIG ;[1300] YES
POP P,R ;[1300] NO, CLEAN UP
POPJ P, ;[1300] AND RETURN
TOOBIG::SPUSH <T1,T2> ;[1731] SAVE SOME REGISTERS
MOVE T1,RC.AT(R) ;[1300] GET THE ATTRIBUTES
TXOE T1,AT.LE ;[1300] LIMIT EXCEEDED BEFORE?
JRST TOOBI1 ;[1300] YES, DON'T PRINT MESSAGE
MOVEM T1,RC.AT(R) ;[1300] SET LIMIT EXCEEDED BIT
MOVE T1,RC.LM(R) ;[1300] SET LIMIT TO 1,,0
MOVE T2,RC.NM(R) ;[1300] GET THE PSECT NAME
E$$PEL::.ERR. (MS,.EC,V%L,L%F,S%W,PEL,<PSECT >) ;[1300]
.ETC. (SBX,.EC!.EP,,,,T2) ;[1300]
.ETC. (STR,.EC,,,,,< exceeded limit of >) ;[1300]
.ETC. (OCT,.EC!.EP,,,,T1) ;[1300]
.ETC. (JMP,,,,,.ETIMF##) ;[1300]
SETOM BADCORE ;[1300] SET SO NO FIXUPS GET DONE
TOOBI1: SPOP <T2,T1> ;[1300] RESTORE THE REGISTERS
POPJ P, ;[1300]
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
;[2205] Return:
;[2205] W2: Value of symbol
;[2205] W1: 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
T.1S6:: MOVX W1,PT.SGN!PT.SYM!PS.GLB ;[1434] 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+PH.ADD ;[1400] 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
SOJA W3,CPOPJ ;ONE LESS REAL DATA WORD
IFN FTOVERLAY,<
T.1SE:: MOVE W2,1(P1) ;[2262] ITS NOT, GET NAME
TLNN W2,770000 ;[2262] A LONG NAME?
ADD W2,GS.LB ;[2262] YES, IT'S IN THE GS AREA
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. (STR,.EC,,,,,< not in link number >)
.ETC. (DEC,.EP!.EC,,,,W3)
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
>
;HERE IF SYMBOLIC ADDRESS NOT YET DEFINED
T.1UN: MOVE T1,CURTYP ;[1434] GET BLOCK TYPE
CAIN T1,1004 ;[1434] BLOCK TYPE 1004 IS DIFFERENT
JRST T1004U## ;[1434] SO DO ERROR RECOVERY THERE
PUSHJ P,T.1FX ;[1434] PUT WHOLE BLOCK IN FIXUP TABLE
E01CNW::.ERR. (MS,.EC,V%L,L%F,S%F,CNW) ;[1174]
.ETC. (STR,,,,,,<T.1UN1>) ;[1434]
;HERE IF SYMBOL NOT EVEN IN TABLE
T.1ND: MOVE T1,CURTYP ;[1434] GET BLOCK TYPE
CAIN T1,1004 ;[1434] BLOCK TYPE 1004 IS DIFFERENT
JRST T1004U## ;[1434] SO DO ERROR RECOVERY THERE
PUSHJ P,T.1FX ;[1434]PUT WHOLE BLOCK IN FIXUP TABLE
T.1ND1: 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
IOR W1,LSTRRV ;[2200] INCLUDE ANY SECTION DATA
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 [1330] GLOBAL DEFERRED DEF (RH)
SY.DGL ; 6 - 30 [1330] GLOBAL DEFERRED DEF (LH)
SY.DGB ; 7 - 34 [1330] GLOBAL DEFERRED DEF (LH,RH)
E$$URC ;[1174] 10 - 40
SY.GSS ;[1330] 11 - 44 GLOBAL DEF. (SUPPRESSED)
SY.LSS ;12 - 50 LOCAL DEF. (SUPPRESSED)
E$$URC ;[1174] 13 - 54
SY.RQ ;14 - 60 GLOBAL REQUEST
SY.DSR ;15 - 64 [1330] GLOBAL DEFERRED DEF (RH) SUPP.
SY.DSL ;16 - 70 [1330] GLOBAL DEFERRED DEF (LH) SUPP.
SY.DSB ;17 - 74 [1330] GLOBAL DEFERRED DEF (LH,RH) SUPP.
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 [1330] GLOBAL DEFERRED DEF (RH)
T.2CHK ; 6 - 30 [1330] GLOBAL DEFERRED DEF (LH)
T.2CHK ; 7 - 34 [1330] GLOBAL DEFERRED DEF (LH,RH)
CPOPJ ;10 - 40
T.2CHK ;11 - 44 [1330] GLOBAL DEF. (SUPPRESSED)
T.2CHK ;12 - 50 LOCAL DEF. (SUPPRESSED)
CPOPJ ;13 - 54
T.2CHK ;14 - 60 GLOBAL REQUEST
T.2CHK ;15 - 64 [1330] GLOBAL DEFERRED DEF (RH) SUPP.
T.2CHK ;16 - 70 [1330] GLOBAL DEFERRED DEF (LH) SUPP.
T.2CHK ;17 - 74 [1330] GLOBAL DEFERRED DEF (LH,RH) SUPP.
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!PS.GLD ;[1243] SUPPRESSED,GLOBAL,LEFT DEFERED
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
TLNN W2,770000 ;[2216] Long symbol?
JRST LCOM ;[2216] Yes
SYGENS: CAMN W2,0(T1) ;[2216] Match?
SYGENT: TXOA W1,PS.ENT ;[2216] Yes, set flag
AOBJN T1,SYGENS ;[2216] No, try next
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
;[2216] Here to compare long symbols with entries. The entry table
;[2216] long symbols have had trailing nulls removed.
LCOM: SPUSH <P1,P2,P3> ;[2216] Save acs
MOVE P3,T1 ;[2216] Pointer in more permanent place
LCOM1: HLRZ T1,W2 ;[2216] Get the count
HRRZ T2,W2 ;[2216] And the address
HRLI T2,(POINT 36) ;[2216] Make it a byte pointer
MOVE P1,0(P3) ;[2216] Get count,,address of entptr entry
TLNE P1,770000 ;[2216] Short symbol?
JRST [MOVE P1,P3 ;[2216] Yes, point to it
MOVEI T4,1 ;[2216] It's one word long
JRST LCOM2] ;[2216] Go compare in case of nulls
HLRZ T4,0(P3) ;[2216] Count of words in entptr entry
SOS T4 ;[2411] Real count of words in symbol
LCOM2: HRLI P1,(POINT 36) ;[2216] Make it a byte pointer
EXTEND T1,[CMPSE ;[2216] Are they the same?
0
0]
AOBJN P3,LCOM1 ;[2216] No, try them all
MOVE T1,P3 ;[2216] Get the pointer
SPOP <P3,P2,P1> ;[2216] Restore the acs
JUMPL T1,SYGENT ;[2216] If pointer still negative it's entry
JRST SYGTRY ;[2216] Not an entry
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 LSTGBL ;[2255] IN CASE WE DON'T LOAD THIS SYMBOL
SETZM LSTLCL ;[2255] CLEAR LOCAL TOO
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
SY.BH:: TXC W1,PT.SYM!PT.TTL!PT.BLK ;SET CORRECT FLAGS
TRNN FL,R.SYM ;IN LOCAL SYMBOL MODE
POPJ P, ;NO
PJRST LS.ADD## ;PUT IN TABLE
SUBTTL BLOCK TYPE 2 - SYMBOLS (PARTIAL DEFINITION)
;HERE FOR "DEFINITION" WHEN SYMBOL NOT FULLY DEFINED
;USUALLY FOLLOWED BY GLOBAL REQUEST FOR SYMBOL FIXUP
SY.DSL: TXO W1,PS.DDT ;[1330] SUPPRESS TO DDT
SY.DGL:: TXO W1,PS.GLB!PS.UDL;[1330] LEFT HALF DEFERRED
JRST SY.DEF
SY.DSB: TXO W1,PS.DDT ;[1330] SUPPRESS TO DDT
SY.DGB: TXOA W1,PS.UDL ;[1330] BOTH HALVES DEFERRED
SY.DSR: TXO W1,PS.DDT ;[1330] SUPPRESS TO DDT
SY.DGR:: TXO W1,PS.GLB!PS.UDR;[1330] RIGHT HALF DEFERRED
SY.DEF: ;[1330] DO PARTIAL DEFINITION
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
MOVEM P1,LSTGBL ;[2255] 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
MOVEM T1,LSTGBL ;[2255] ARRANGE FOR SY.RQ TO FIND US
SETZM LSTLCL ;[2255] NO LOCAL DEFINITION
;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 ;[2305] 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
MOVE W3,W2 ;EXPECTED IN W3
SY.AS:: .JDDT LNKOLD,SY.ADS,<<CAMN W3,$SYMBOL>> ;[1000]
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
TXNN W1,FS.FXF ;[2214] BUT IF FULL WORD
TXNE W1,FS.FXE ;[2214] OR THIRTY BIT
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
MOVE W3,2(P1) ;[2332] GET FIXUP VALUE
;FROM DEFINED SYMBOL
PUSHJ P,SY.AST## ;FIXUP 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
PUSHJ P,TRYSYM## ;SETUP P1 & P2
HALT ;MUST BE DEFINED
JFCL
MOVE T1,P1 ;POINT TO SYMBOL TRIPLET
POP P,T2 ;FIXUP FLAGS
TXNN W1,PS.GLD ;[1327] POSSIBLE LEFT HALF?
PJRST SY.AS0## ;[1327] NO, GO DO THE VALUE FIXUP
PUSH P,T2 ;[1327] SAVE T2
MOVEI T1,.L ;[1327] NEED ONE MORE TRIPLET
PUSHJ P,SY.MOV## ;[1327] MOVE WHAT WE HAVE
MOVX T2,S.PVS!S.LST ;[1327] MARK AS SYMBOL FIXUP
MOVEM T2,0(T1) ;[1327] STORE SECONDARY FIXUP FLAGS
DMOVEM W2,1(T1) ;[1327] SYMBOL AND PARTIAL VALUE
TXO W1,PT.EXT ;[1327] MARK AS NOW EXTENDED
IORB W1,0(P1) ;[1327] PLACE IN PROMARY FLAGS
MOVE T1,P1 ;[1327] GET THE ADDRESS OF THE PRIMARY
SUB T1,GS.LB ;[1327] CONVERT IT TO AN OFFSET
HRLM T1,W3 ;[1327] RESET FIXUP PTRS AND
MOVEM T1,LSTGBL ;[2255] LSTGBL AFTER MOVING PRIMARY
AOS USYM ;[1327] COUNT THIS SYMBOL AS UNDEFINED
POP P,T2 ;[1327] RESTORE FIXUP FLAGS
MOVE T1,P1 ;[1327] POINT TO SYMBOL TRIPLET
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
MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER
SKIPA W3,LSTLCL ;[2255] AND THE LOCAL POINTER
SY.RQ2::MOVE T1,W2 ;[2255] WANT THE NAME (NON-SYMBOL) IN FIXUP
PUSH P,[0] ;VALUE OF REQUEST (PRIMARY)
PUSH P,W2 ;[2255] SAVE THE NAME
MOVE W2,T1 ;[2255] GET GLOBAL POINTER (IF SYMBOL FIXUP)
PUSHJ P,SY.FX0## ;PUT IN FIXUP TABLE
POP P,W2 ;[2255] RESTORE SYMBOL NAME
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 SYMBOL IS REQUIRED [2255]
;USES T1, T2
SY.RQS: EXCH W2,W3 ;PUT REQUESTED SYMBOL IN W2
PUSHJ P,R50T6 ;SIXBITIZE
EXCH W2,W3 ;PUT THEM BACK
SY.QS:: .JDDT LNKOLD,SY.QS,<<CAMN W3,$SYMBOL##>> ;[1000]
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.FXE!FS.FXL ;[2214] REQUEST FIX LEFT HALF?
IORM T1,0(T2) ;[612] YES, IT MUST BE UNDEFINED
MOVE T1,0(T2) ;[1243] GET THE PRIMARY FLAGS
TXNN T1,PS.GLD ;[1243] POSSIBLE LEFT DEF?
JRST CPOPJ1 ;[1243] NO
SPUSH <W1,W2,W3,P1,P2,P3,P4> ;[1243] SAVE THE AC'S
MOVE W1,0(T2) ;[1243] LOAD W1-W3 WITH
DMOVE W2,1(T2) ;[1243] THE PRIMARY TRIPLET
PUSHJ P,TRYSYM## ;[1243] LOAD P1-P4 FOR THE PRIMARY
JRST SYRQS1 ;[1243] SYMBOL NOT FOUND
SKIPA ;[1243] FOUND AND UNDEFINED
JRST SYRQS1 ;[1243] FOUND BUT ALREADY DEFINED
MOVEI T1,.L ;[1243] NEED ONE MORE TRIPLET
PUSHJ P,SY.MOV## ;[1243] MOVE WHAT WE HAVE
MOVX T2,S.PVS!S.LST ;[1243] MARK AS SYMBOL FIXUP
MOVEM T2,0(T1) ;[1243] STORE SECONDARY FIXUP FLAGS
DMOVEM W2,1(T1) ;[1243] SYMBOL AND PARTIAL VALUE
TXO W1,PT.EXT ;[1243] MARK AS NOW EXTENDED
IORB W1,0(P1) ;[1243] PLACE IN PRIMARY FLAGS
MOVE T1,P1 ;[1243] GET THE ADDRESS OF THE PRIMARY
SUB T1,GS.LB ;[1243] CONVERT IT TO AN OFFSET
SYRQS1: SPOP <P4,P3,P2,P1,W3,W2,W1> ;[1243] RESTORE THE AC'S
HRLM T1,W3 ;[1243] RESET FIXUP PTRS AND
MOVEM T1,LSTGBL ;[2255] LSTGBL AFTER MOVING PRIMARY
AOS USYM ;[1243] COUNT THIS SYMBOL AS 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?
SY.RU3::MOVE T3,W3 ;[2200] START OF CURRENT CHAIN
MOVE T1,2(P1) ;[2200] 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
MOVE T2,T3 ;[2200] Get one number
XOR T2,T1 ;[2200] Get the difference
TRNE T1,-1 ;[2240] Can't chain if section,,0
TLNE T2,-1 ;[2200] Same section number?
JRST SY.PGU ;[2200] No, don't chain them
SY.RU2: MOVE T2,T3 ;[2200] GET NEXT LINK
PUSHJ P,SEGCHK## ;SETUP ADDRESS FOR CORRECT SEGMENT
JRST SY.PGU ;NOT ALL OF CHAIN IN CURRENT WINDOW
HRR T3,(T2) ;[2200] GET NEXT ADDRESS, KEEP SECTION NUMBER
;[2200] This code defaults for right halfword fixups. The current rule
;[2200] is to wrap within a section.
TRNE T3,-1 ;[2200] END OF CHAIN?
JRST SY.RU2 ;[2200] NO, 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: MOVE W3,T1 ;[2200] 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 SY.RA ;[2200] NORMAL RETURN
PUSHJ P,SY.RQS ;SYMBOL TABLE FIXUP, SEE IF WE NEED IT
JRST SY.RUX ;RESTORE STACK AND EXIT
MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER
MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER
;[2255] Here to store the first partial secondary fixup. The
;[2255] local and global pointers are in T1 and W3. This is
;[2255] because W2 contains the symbol name for the PVS secondary
;[2255] triplet.
SY.RA:: PUSH P,W2 ;[2255] SAVE THE NAME
MOVE W2,T1 ;[2255] GET THE GLOBAL POINTER
MOVEI T1,.L ;[1000] 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
POP P,W2 ;[2255] RESTORE THE NAME
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 SY.RUD ;[2255] NORMAL RETURN, NOT A SYMBOL FIXUP
PUSHJ P,SY.RQS ;SYMBOL TABLE FIXUP, CONVERT TO POINTER
POPJ P, ;NO LOADED LOCAL, IGNORE
MOVE W2,LSTGBL ;[2255] GET THE GLOBAL POINTER
MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER
SY.RUD: HRR W1,2(P1) ;[2255] 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::
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:
SKIPGE MODTYP ;[1306] PSECTS SEEN IN MODULE?
PUSHJ P,E$$MPT ;[1306] YES, ERROR
HLLOS MODTYP ;[1306] INDICATE TWOSEG SEEN
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
TRNE FL,R.RED ;[2223] DOING /REDIRECT?
PUSHJ P,T.3RED ;[2223] YES, SET UP FAKE HIGH SEG
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
MOVEI R,2 ;[2207] SET FOR SLOT #2
MOVEM R,@RC.MAP ;[2207] SET MAP FOR NEW-STYLE REL BLOCKS
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: MOVE W3,RC.CV(R) ;[2254] 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: MOVE T2,SEGPTR ;[2254] GET REL ADDRESS OF LOW SEGMENT 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
SKIPL W2 ;[2254] LOW SEG SPECIFIED?
MOVEM W2,1(T2) ;[2254] YES, STORE IT (AOSE KEEPS LH)
ADDI T2,.L ;[2254] NOW TO HIGH SEG TRIPLET
SKIPL T3,(T2) ;[2254] MUST BE SECONDARY
TXNN T3,S.TTL ;[2254] AND A TITLE
JRST T.3SER ;[2254] NO
TXNE T3,S.SEG ;[2254] IS THIS A SEGMENT?
TXNN T3,S.SHI ;[2254] AND HIGH SEGMENT
JRST T.3SER ;[2254] NO
SKIPL W3 ;[2254] HOW ABOUT HIGH SEG?
MOVEM W3,1(T2) ;[2254] YES, STORE IT
JRST LOAD## ;DONE
;HERE IF BLOCK PAGED OUT. GENERATE A FIXUP.
T.3FIX: HLR W3,W2 ;SETUP FIXUP AS HI,,LOW
TXO T2,SPF.SL ;[2200] 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
MOVE W3,RC.CV(R) ;[2254] SETUP CURRENT HISEG VALUE
MOVE R,SG.TB+1 ;GET LOWSEG BLOCK
MOVE W2,RC.CV(R) ;[2254] 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: PUSHJ P,T.3CH ;[1304] MAKE SURE SLOT 2 IS EMPTY
HRLM R,LL.S2 ;SET ORIGIN GREATER THAN 256K
MOVEM T1,@RC.TB ;IN RELOCATION TABLES (BUT NOT SEGMENT TABLE)
MOVE R,SG.TB+1 ;[2247] GET .LOW. RC BLOCK
MOVX T2,AT.RP ;[2247] GET THE RELOCATABLE PSECT ATTRIBUTE
ANDCAM T2,RC.AT(R) ;[2247] MAKE SURE .LOW. IS NOT RELOCATABLE
MOVEI R,2 ;[2247] POINT BACK TO HIGH SEGMENT
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
MOVE W3,T2 ;[2254] 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
MOVE W2,RC.CV(R) ;[2254] 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
MOVE W2,T2 ;[2254] 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
MOVE R,SG.TB+1 ;[2253] GET .LOW. RC BLOCK
MOVX T2,AT.RP ;[2253] GET THE RELOCATABLE PSECT ATTRIBUTE
ANDCAM T2,RC.AT(R) ;[2253] MAKE SURE .LOW. IS NOT RELOCATABLE
PUSHJ P,T.3CH ;[1304] MAKE SURE SLOT 2 IS EMPTY
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)
HRRZ T2,LL.S2 ;[2372]
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
HRRZ T1,LL.S2 ;[2372] GET HI SEG ORIGIN
SUB T2,T1 ;[2372] REMOVE HISEG ORIGIN
MOVE W3,T2 ;[2254] 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
MOVE W3,RC.CV(R) ;[2254] 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
TRNE FL,R.RED ;[2272] DOING /REDIRECT?
JRST [MOVE T1,REDHI ;[2272] YES, GET PSECT NAME
CAME T1,['.HIGH.'] ;[2272] IS IT HIGH SEG?
POPJ P, ;[2272] NO, DON'T DO ANYTHING
JRST .+1] ;[2272] YES, SET UP A HIGH SEG
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 T1,HL.S2 ;[1231] ..
MOVEM W1,LL.S2 ;FOR INPUT ROUTINE ONLY
MOVEI T2,RC.INC ;HERE TO ALLOCATE SPACE FOR RC BLOCK
AOS RC.NO ;[1304] COUNT ONE MORE
SOSGE RC.FRE ;[2207] AND ONE LESS HOLE
PUSHJ P,.SETEX## ;[2207] NO SPACE, MUST EXPAND
PUSHJ P,DY.GET## ;IN DYNAMIC AREA
MOVEI R,2 ;[2207] POINT AT HIGH SEGMENT SLOT
SKIPN @RC.TB ;[1304] SLOT ALREADY OCCUPIED?
JRST SETRC3 ;[2207]
MOVE T2,@RC.TB ;[2207] SAVE CURRENT OCCUPANT
MOVE R,RC.NO ;[2207] GET NUMBER OF NEW SLOT
MOVEM T2,@RC.TB ;[2207] PUT THIS PSECT THERE
MOVEI R,2 ;[2207] BACK TO THE HIGH SEG
SETRC3: MOVEM T1,@RC.TB ;[1304] GET POINTER INTO TABLE
MOVEM T1,@SG.TB ;[1304]
MOVE R,T1 ;[1304] SAFER PLACE FOR POINTER
MOVEM W1,RC.IV(R) ;[1304] 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
MOVX T1,<1,,0> ;[1300] MAX LIMIT
MOVEM T1,RC.LM(R) ;[1300]
JRST T.3AA ;NOW SETUP HC AREA
T.3CH: SETZM SLOT2 ;[1304] ASSUME NO PSECTS
MOVEI R,2 ;[1304] POINT TO SLOT 2
CAMLE R,RC.NO ;[1304] IN USE?
POPJ P, ;[1304] NO
MOVE T2,@RC.TB ;[1304] GET POINTER TO BLOCK
MOVE T2,RC.NM(T2) ;[1304] GET NAME
CAMN T2,['.HIGH.'] ;[1304] REAL HIGH SEG?
POPJ P, ;[1304] YES
MOVE T2,@RC.TB ;[1304] NO, GET THE PSECT POINTER
MOVEM T2,SLOT2 ;[1304] HIDE IT AWAY FOR THIS MODULE
POPJ P, ;[1304]
;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
IFN TOPS20,< ;[2202]
SKIPN T2,UW.LC ;[2202] IS IT PAGED?
JRST T.3AA ;[2202] NO
MOVE T1,LW.LC ;[2202] GET LOWER WINDOW
ADD T1,LC.AB ;[2202] PLUS UPPER BOUND
SUB T1,LC.LB ;[2202] MINUS LOWER BOUND
MOVEM T1,UW.LC ;[2202] NEW UPPER WINDOW
ADDI T1,1 ;[2202] BOTTOM OF AREA TO REMOVE
PUSHJ P,LC.OUT## ;[2202] REMOVE IT
>; [2202] IFN TOPS20
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,< ;[2202]
MOVE T1,LC.JF ;[2247] GET LOW SEGMENT JFN
MOVEM T1,HC.JF ;[2247] HIGH SEGMENT GOES IN SAME FORK
SETZB T1,LW.HC ;[2247] MAP IN FROM ZERO
MOVE T2,HC.AB ;[2247] GET THE UPPER BOUND
SUB T2,HC.LB ;[2247] MINUS LOWER IS SIZE
MOVEM T2,UW.HC ;[2247] REMEMBER BOUND
PUSHJ P,HC.IN## ;[2247] MAP IT IN
> ;[2202] IFN TOPS20
POPJ P, ;RETURN
;[2223] Here to handle /REDIRECT of the high segment.
T.3RED: MOVE W2,REDHI ;[2223] Get the psect name
CAMN W2,['.HIGH.'] ;[2272] Is it the real high seg?
POPJ P, ;[2272] Yes, don't bother to look for it
PUSHJ P,T.6FPS ;[2223] Find the psect
MOVEI R,2 ;[2223] Set for low segment psect
EXCH T1,@RC.TB ;[2223] Set in the RC table, Get old
MOVEM T1,SLOT2 ;[2223] Store the old psect
MOVEI T1,377777 ;[2223] Get something big and positive
HRLM T1,LL.S2 ;[2223] So nothing goes in high segment
POPJ P,
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
MOVE T2,POLLEN ;[1274] 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:
PUSHJ P,T.5ENT ;RETURN SPACE USED BY ENTRY STORE
PUSHJ P,T.5RB ;[2247] 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
IOR W1,LSTRRV ;[2223] GET FULLWORD (IN CASE /REDIRECT)
TRNN R,-1 ;[2223] A PSECT SPECIFIED?
HRR R,@RC.TB ;[2223] NO, USE .ABS.
CAMLE W1,RC.LM(R) ;[2223] PSECT TOO BIG?
PUSHJ P,TOOBIG ;[2223] YES
MOVE W2,W1 ;[1300] GET TRUE VALUE (LSTRRV)
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
IOR W1,LSTRRV ;[2223] GET FULLWORD (IN CASE /REDIRECT)
TRNN R,-1 ;[2223] A PSECT SPECIFIED?
HRR R,@RC.TB ;[2223] NO, USE .ABS.
CAMLE W1,RC.LM(R) ;[2223] PSECT TOO BIG?
PUSHJ P,TOOBIG ;[2223] YES
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) ;[1253] CHECK RELOCATION COUNTER
MOVE W1,RC.HL(R) ;[1253] USE GREATER
CAMLE W1,RC.CV(R) ;NEVER DECREASE
MOVEM W1,RC.CV(R) ;FOR NEXT FILE
CAML W1,RC.LM(R) ;[1300] CHECK LIMIT OF .LOW.
PUSHJ P,TOOBIG ;[1300] LOW SEG BREAK TOO BIG
TRNE FL,R.RED ;[2223] DOING /REDIRECT?
JRST T.5LS1 ;[2223] YES, DON'T SET HP.S1 (THIS IS A PSECT)
SETZM RC.HL(R) ;[1273] CLEAR HIGHEST ADDRESS IN PROGRESS
CAMLE W1,HP.S1 ;[1273] UPDATE HIGHEST ADDRESS FOR .LOW.
MOVEM W1,HP.S1 ;[1273]
T.5LS1: 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) ;[1253] CHECK RELOCATION COUNTER
MOVE W2,RC.HL(R) ;[1253] USE GREATER
CAMLE W2,RC.CV(R)
MOVEM W2,RC.CV(R) ;FOR NEXT FILE
CAML W2,RC.LM(R) ;[1300] CHECK LIMIT OF .HIGH.
PUSHJ P,TOOBIG ;[1300] HIGH SEG BREAK TO BIG
TRNE FL,R.RED ;[2223] DOING /REDIRECT?
JRST [CAMLE W1,HL.S1 ;[2223] YES, THIS IS IN LOW SEGMENT
MOVEM W1,HL.S1 ;[2223] SO UPDATE POINTERS THERE
JRST T.5END] ;[2223] DON'T TOUCH HIGH SEG POINTERS
CAMLE W2,HP.S2 ;[1273] UPDATE HIGHEST ADDRESS FOR .HIGH.
MOVEM W2,HP.S2 ;[1273]
SETZM RC.HL(R) ;[1273] CLEAR HIGHEST IN PROGRESS
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: MOVE T1,NAMPTR ;[2254] 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)
MOVEM T2,2(T1) ;[2254] FILL IN POINTER
T.5LP: MOVE T1,SEGPTR ;[2254] 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 E02SFU ;[2057] NO, SYMBOL TABLE FOULED UP
TRZN FL,R.FHS ;SLIGHT PROBLEM IF FORCED HIGH
JRST T.5L1 ;[2254] AND A SINGLE SEG PROG
;[2254] AS PC IN .LOW. IS IN HISEG
CAMGE W1,1(T1) ;[2254] SO UNLESS LOW PC EQUAL OR GREATER
SETZB W1,1(T1) ;ASSUME NO LOW CODE FOR THIS MODULE
T.5L1: MOVEM W1,2(T1) ;[2254] STORE LOW SEGMENT HIGH VALUE
ADDI T1,.L ;[2254] GO TO NEXT TRIPLET
SKIPL T2,(T1) ;[2254] MUST BE SECONDARY
TXNN T2,S.TTL ;[2254] AND A TITLE BLOCK AT THAT
JRST E02SFU ;[2254]
TXNE T2,S.SEG ;[2254] SEG BLOCK?
TXNN T2,S.SHI ;[2254] FOR HIGH SEG?
JRST E02SFU ;[2254] NO, SYMBOL TABLE FOULED UP
TRNN FL,R.LSO ;LOW SEGMENT ONLY LOADED?
TRNN FL,R.TWSG ;WAS THIS A TWO SEG PROG?
SETZB W2,1(T1) ;[2254] NO, CLEAR HIGH MARKER
SKIPE 1(T1) ;[2254] IF THERE WAS HIGH SEEN
MOVEM W2,2(T1) ;[2254] STORE HIGH
SKIPN RC.CUR ;DOING PSECT
JRST T.5RET ;NO
MOVE T2,LSYM
TXO T2,SS.PS ;[2254] FLAG AS PSECT TRIPLET POINTER
MOVEM T2,2(T1)
T.5RET: SKIPE UW.LS ;ARE WE PAGING SYMBOLS?
PUSHJ P,T.5XPL ;SEE IF ANY TO GO OUT
TRZ FL,R.LOD ;DONE WITH END BLOCK NOW
SETZM MODTYP ;[1306] RESET PSECT/TWOSEG FLAG
SKIPN RC.CUR ;[1517] BEEN PROCESSING PSECTS?
JRST T.5PSC ;[1517] NO
MOVEI R,1 ;[2207] GET LOCATION OF .LOW. IN RC.TB
HRRZM R,@RC.MAP ;[2207] RESET THE FIRST MAP SLOT
MOVE R,RC.NO ;START AT END
MOVX W1,PT.SGN!PT.EXT!PT.TTL!PT.PSC ;[711] MARK BLOCK
T.5PSA: MOVE P1,@RC.TB ;[2220] RC BLOCK
MOVX P2,AT.PS ;[2220] FLAG FOR PSECT SEEN IN THIS MODULE
TDNN P2,RC.AT(P1) ;[2220] DID WE SEE THIS PSECT IN THIS MODULE?
JRST T.5PSB ;NO
ANDCAB P2,RC.AT(P1) ;[2220] CLEAR FLAG FOR NEXT TIME
MOVE W2,RC.NM(P1) ;[2220] GET NAME
PUSHJ P,LS.ADD## ;PUT IN LOCAL TABLE
MOVX W1,S.TTL!S.PSC!S.PSV ;[2220] SET FLAGS
MOVE W2,RC.CV(P1) ;[2220] GET THE ORIGIN
MOVE W3,RC.HL(P1) ;[2220] AND THE TOP
TXNN P2,AT.OV ;[2220] OVERLAID PSECT?
CAMG W3,RC.CV(P1) ;[2220] OR LOWER THAN WHAT WE HAVE?
CAIA ;[2220] YES, DONT UPDATE RC.CV
MOVEM W3,RC.CV(P1) ;[2220] UPDATE CV FOR NEXT MODULE
PUSHJ P,LS.ADD## ;[2220]
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
TRNE FL,R.RED ;[2223] DOING REDIRECTION?
PUSHJ P,T.5RED ;[2223] YES, PUT WORLD BACK TOGETHER
SKIPN DCBUF ;SPECIAL INCORE READS DONE?
JRST T5FIN## ;YES, RESET INPUT BUFFER
JRST T.LOAD## ;SEE IF IN /SEARCH OR NOT
;[2247] Here to read the first break. Don't change .LOW. attributes
;[2247] if only 140 (0 relocatable)
T.5RB: MOVE W2,SG.TB+1 ;[2247] Get the .LOW. RC block
PUSH P,RC.AT(W2) ;[2247] Save the attributes
PUSHJ P,RB.1 ;[2247] Read and relocate the word
POPJ P, ;[2247] Not there, illegal
CAIE W1,140 ;[2247] Is it 140?
JRST T.5RB1 ;[2247] No, don't want to restore attributes
POP P,RC.AT(W2) ;[2247] Yes, restore the attributes
JRST CPOPJ1 ;[2247] Return
T.5RB1: POP P,0(P) ;[2247] Toss the old attributes
JRST CPOPJ1 ;[2247] Return
;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
;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
SKIPN T1,SLOT2 ;[1304] CHECK FOR PSECT
MOVE T1,SG.TB+2 ;FROM SECOND
MOVEM T1,@RC.TB ;STORE HIGH WHERE IT SHOULD BE
SETZM SLOT2 ;[1304] RESET JUST IN CASE
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
SKIPN T1,SLOT2 ;[1304] CHECK FOR PSECT
MOVE T1,SG.TB+2 ;POINT TO REAL HIGH SEG BLOCK
MOVEM T1,@RC.TB ;STORE 0 OR REAL ADDRESS
SETZM SLOT2 ;[1304] RESET JUST IN CASE
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) ;[1273] CLEAR HIGHEST IN PROGRESS
CAMLE W2,HP.S1 ;[1273] UPDATE HIGH FOR .LOW.
MOVEM W2,HP.S1 ;[1273]
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) ;[1273] CLEAR HIGHEST IN PROGRESS
CAMLE W1,HP.S1 ;[1273] UPDATE HIGHEST FOR .LOW.
MOVEM W1,HP.S1 ;[1273]
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
CAMLE W1,HP.S2 ;[1273] UPDATE HIGH ADDRESS FOR .HIGH.
MOVEM W1,HP.S2 ;[1273]
SETZM RC.HL(R) ;[1273] CLEAR HIGHEST IN PROGRESS
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
CAMLE W2,HP.S2 ;[1273] UPDATE HIGH ADDRESS FOR .HIGH.
MOVEM W2,HP.S2 ;[1273]
SETZM RC.HL(R) ;[1273] CLEAR HIGHEST IN PROGRESS
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
MOVE P1,T2 ;[2202] GET BOTTOM OF NEW AREA
SUBI T2,1 ;[2202] TOP OF OLD AREA
PUSHJ P,LS.OUT## ;OUTPUT WINDOW
MOVE T1,P1 ;[2202] BOTTOM OF NEW WINDOW
SUB T1,LW.LS ;MINUS INITIAL
ADDM T1,LW.LS ;NEW INITIAL
ADD T1,LS.LB ;NEW INCORE BASE
IFN TOPS20,< ;[2215] DON'T HAVE GBCK.L ZERO THE AREA
HRLI T1,1 ;[2215] SINCE LS.OUT REMOVED IT'S PAGES
> ;[2215] IFN TOPS20
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 [2254]
;WORD 3 LSYM
;
T.5PAG: MOVE T2,NAMPTR ;AND REL ADDRESS IN SYMBOL TABLE
TXO T2,SPF.TL ;[2200] 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!SEGPTR for low seg, +.L for high seg or psects
;WORD 3 VALUE OF SEGMENT BREAK
;
;ENTER WITH
T.5PSG: MOVE T2,SEGPTR ;[2254] REL ADDRESS OF LOW IN SYMBOL TABLE
TXO T2,SPF.SG ;[2200] INDEX
MOVE W3,W1 ;[2254] PUT LOW SEG BREAK IN W3
MOVEI R,FS.SS-FX.S0 ;SET INDEX
PUSHJ P,SY.CHP## ;PUT IN LIST
MOVE W3,W2 ;[2254] HIGH SEG BREAK IN W3
MOVE T2,SEGPTR ;[2254] REL ADDRESS OF LOW
ADDI T2,.L ;[2254] HIGH IS IN NEXT TRIPLET
TXO T2,SPF.SG ;[2254] INDEX
TRNN FL,R.LSO ;LOW SEGMENT ONLY LOADED?
TRNN FL,R.TWSG ;WAS THIS A TWO SEG PROG?
SETZ W3, ;[2254] NO, CLEAR HIGH MARKER
SKIPN RC.CUR ;[2254] PSECTS LOADED?
JRST T.5PS1 ;[2254] NO
MOVE W3,LSYM ;[2254] GET POINTER TO PSECT TRIPLETS
TXO W3,SS.PS ;[2254] FLAG AS PSECT TRIPLET POINTER
T.5PS1: MOVEI R,FS.SS-FX.S0 ;[2254] SET INDEX
PUSHJ P,SY.CHP## ;[2254] PUT IN LIST
JRST T.5RET ;AND RETURN
;[2223] Here to undo the effects of /REDIRECT.
T.5RED: MOVEI R,1 ;[2223] Point to low segment
MOVE T1,SG.TB+1 ;[2223] Get .LOW. back
MOVEM T1,@RC.TB ;[2223] Restore it
TRNE FL,R.TWSG ;[2223] Been loading twoseg?
SKIPN REDHI ;[2223] Doing high segment redirect?
POPJ P, ;[2223] No, done
MOVEI R,2 ;[2223] Point to high segment
SKIPE T1,SLOT2 ;[2223] Get original psect (if any)
MOVEM T1,@RC.TB ;[2223] Restore it
POPJ P, ;[2223] Done
;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
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
SKIPE REDLO ;[2223] DOING /REDIRECT?
PUSHJ P,T.6RED ;[2223] YES
TRNE FL,R.FHS ;[1276] NEED TO ADJUST THE RELOC TABLES?
PUSHJ P,T.6RC ;[1276] YES
MOVE T1,LSYM ;GET WORD COUNT IN SYMBOL TABLE
MOVEM T1,NAMPTR ;POINTS TO NAME
.JDDT LNKOLD,T.6OK,<<CAMN W2,$NAME>>
PUSHJ P,E$$LMN ;[2305] ISSUE INFO MESSAGE
;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
MOVE T2,CPUTGT ;[1240] GET TARGET CPUS
JUMPE T2,NOTGT ;[1240] THE CPU SWITCHES ARE NOT BEING USED
TDON T1,T2 ;[1240] TEST FOR A GOOD TARGET SWITCH
JRST E$$CPU ;[1240] .DIRECTIVE IS FOR WRONG CPU
NOTGT: SKIPN OKCPUS ;[1237] CAN ANY CPU RUN THIS CODE?
JRST CPUEND ;[1237] NO--FORGET THIS TEST
ANDM T1,OKCPUS ;[1120] ENFORCE CPU FLAGS
SKIPN OKCPUS ;[1120] CAN PROG RUN AT ALL NOW?
PUSHJ P,E$$CCD ;[1237] NO--CPU CONFLICT DETECTED
CPUEND: LDB T1,[POINT 12,(P),17] ;[1237] 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%W,S%W,CCD,<CPU conflict>) ;[2003]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
POPJ P, ;[1237] NON-FATAL ERROR
E$$CPU::.ERR. (MS,.EC,V%L,L%F,S%F,CPU,<Module incompatible with specified CPU>) ;[1240]
.ETC. (JMP,,,,,.ETIMF##) ;[1240]
E$$LMN::.ERR. (MS,.EC,V%L,L%I5,S%I,LMN,<Loading module >) ;[2305]
.ETC. (SBX,.EC!.EP,,,,PRGNAM) ;[2305]
.ETC. (STR,.EC,,,,,< from file >) ;[2305]
.ETC. (FSP,,,,,DC) ;[2305]
POPJ P, ;[2305]
;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 COBOLS
CAIE T1,CT.C74
CAIN T1,CT.C68
SALL ;OTHERWISE LITERAL IS A MESS
JRST [MOVE W2,['LIBOL-']
PUSHJ P,LS.ADD##
DMOVE W2,[SIXBIT /STATIC-AREA/]
JRST T.6A] ;[1433]
CAIN T1,CT.CBL
JRST [MOVE W2,['COBOTS']
PUSHJ P,LS.ADD##
DMOVE W2,[SIXBIT /-STATIC-AREA/]
JRST T.6A]
PUSHJ P,LS.ADD##
MOVE W2,['COMMON']
T.6A: 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
CAML T1,RC.LM(R) ;[2205] CHECK THE SIZE
PUSHJ P,TOOBIG ;[2205] DOES NOT FIT
HRR W2,T1 ;SO MAP CAN WORK OUT LENGTH
SETZ W3, ;NO HIGH
PUSHJ P,LS.ADD##
MOVE W2,['.COMM.'] ;NAME OF COMMON
HRRZ W1,BLCOMM ;[2205] LENGTH
MOVE 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
SKIPN XBUF ;[2421] USING IN-CORE INDEX?
JRST LOAD## ;NO, JUST SKIP ALL REL BLOCKS IN THIS MODULE
PUSHJ P,T.5ENT ;[2421] YES, REMOVE ENTRY POINTS T.4 STORED
HRR FL,FLAGS ;[2421] RESTORE LOCAL FLAGS
JRST T.14B ;[2421] AND PUNT THIS MODULE, LOOK AT NEXT.
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
PUSHJ P,NAMCMP## ;[2326] compare names
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 LSTGBL ;[2255] NOT A REAL SYMBOL SO CLEAR POINTER
SETZM LSTLCL ;[2255] CLEAR LOCAL SYMBOL POINTER TOO
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
IFE TOPS20,<
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)
> ;[1421] IFE TOPS20
IFN TOPS20,<
; CALCULATE DATE/TIME FOR TRIPLET
MOVE T2,FCRE ;[1446] PICK UP UNIV DATE-TIME
SETZM T4 ;[1446] NO SPECIAL COMPUTATIONS
ODCNV% ;[1446] CONV UNIV TIME TO NUMBERS
ERJMP .+1 ;[1446] 'IMPOSSIBLE'
;
; T2: YEAR,,MONTH
; T3: DAY OF MONTH,,WEEKDAY
; T4: FLAGS,,SECONDS SINCE MIDNIGHT
;
HLRZ T1,T2 ;[1446] CONVERT YEAR
SUBI T1,^D1964 ;[1446] TO TOPS-10 STYLE
IMULI T1,^D12 ;[1446] MULTIPLY BY MONTHS
ADDI T1,(T2) ;[1446] AND ADD EXTRA MONTHS
MOVSS T3 ;[1446] GET READY WITH DAY OF MONTH
IMULI T1,^D31 ;[1446] CALC NUMBER OF DAYS
ADDI T1,(T3) ;[1446] ADD EXTRA DAYS
HRLZ W2,T1 ;[1446] W2: DATE,,0
HRR W2,T4 ;[1446] W2: DATE,,TIME(SEC)
> ;[1446] IFN TOPS20
SETZ W3, ;DON'T KNOW COMPILER VERSION
PUSHJ P,LS.ADD
PUSHJ P,TTLRLC ;PUT OUT RELOCATION COUNTER INFO
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 ;[2254] LOW REL COUNTERS
MOVEI R,1 ;LOW SEG FIRST
MOVE R,@RC.TB ;PICKUP RELOCATION POINTER
MOVE W2,RC.CV(R) ;[2254] CURRENT VALUE
SETZ W3, ;[2254] HIGH VALUE NOT KNOWN YET
MOVE T1,LSYM ;[2254] POINTER TO WHERE IT WILL GO
MOVEM T1,SEGPTR ;[2254] STORE FOR FIXUPS
PUSHJ P,LS.ADD## ;[2254] PUT IN LS AREA
MOVEI R,2 ;NOW FOR HIGH
SKIPN R,@RC.TB ;PICKUP RELOCATION POINTER
TDZA W2,W2 ;[2254] NO HIGH SEGMENT YET
MOVE W2,RC.CV(R) ;[2254] CURRENT VALUE
MOVX W1,S.TTL!S.SEG!S.SHI!S.LST ;[2254] HIGH REL COUNTERS
PJRST LS.ADD## ;PUT IN LS AREA AND RETURN
;[2223] Here to adjust the reloc tables if /REDIRECT in progress
T.6RED::MOVE W2,REDLO ;[2226] Get the psect name
PUSHJ P,T.6FPS ;[2223] Find the psect
MOVEI R,1 ;[2223] Set for low segment psect
MOVEM T1,@RC.TB ;[2223] Set in the RC table
TRO FL,R.RED!R.FNS ;[2223] Indicate in /REDIRECT mode
TRZ FL,R.FLS!R.FHS ;[2223] Force to default segments
POPJ P, ;[2223] Return
;[2223] Here to find a psect for redirection.
;[2223] Enter with psect name in W2, return with RC address in T1.
T.6FPS: MOVE R,RC.NO ;[2223] Loop over all RC blocks
T.6RL1: MOVE T1,@RC.TB ;[2223] RC block where this psect might be
MOVE T2,RC.NM(T1) ;[2223] Get the name
PUSHJ P,NAMCMP## ;[2223] Is it here?
CAIA ;[2223] Yes
SOJG R,T.6RL1 ;[2223] No, loop over all psects
JUMPN R,CPOPJ ;[2223] Return if found
MOVE T1,W2 ;[2223] Not found, get the psect name
PUSHJ P,E$$SRP ;[2223] Type an error
;HERE TO ADJUST THE RELOC TABLES FOR FORCED HIGH SEGMENT LOADING
;SET BY /SEGMENT:HIGH
T.6RC:: SETZ W1, ;[2326] 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.1 ;[1761] read starting address
JRST [MOVEI T1,7
JRST E$$RBS] ;[1174]
HLRZM W1,ENTLEN ;[1764] STORE THE LENGTH OF THE ENTRY VECTOR
SKIPN W2,LSTRRV ;[1775] CHECK FOR ABSOLUTE VALUE
HRRZ W2,W1 ;[1775] IF ABSOLUTE THEN TAKE RIGHT HALF OF W1
PUSHJ P,RB.1 ;[1761] READ POSSIBLE SYMBOL NAME
SETZ W1, ;[1761] NOT THERE ZERO IT
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
MOVEM T2,LODNAM ;[2376] LOAD LODNAM
;**; Change 1 line at SET.ST +11
TLNN T2,770000 ;[2376] IS IT A LONG NAME?
JRST SETLNG ;[2404] YES
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:
IFN TOPS20,<
MOVE T1,FCRE ;[1446] PICK UP FILE CREATION DATE
MOVEM T1,COMPDT ;[1446] STASH ASIDE FOR LATER USE
> ;[1446] IFN TOPS20
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,
;Add lines at SETST2+11
;Long name gets moved to PRGBLK for LNKXCT message and Control T messages
;otherwise NAMBLK gets over written by next 1003 block
SETLNG: PUSH P,T2 ;[2404] Save T2
MOVSS T2 ;[2404] Switch count,,addr to addr,,count
MOVEI T1,PRGBLK ;[2404] Get address to store load name
ADD T1,T2 ;[2404] Add number of name words
HRRZS T1 ;[2404] Zero the left half
HRRI T2,PRGBLK ;[2404] Destination of BLT
BLT T2,-1(T1) ;[2404] Move name to safe place
POP P,T2 ;[2404] Get back count,, address
HRRI T2,PRGBLK ;[2404] Put in new address
MOVEM T2,LODNAM ;[2404] Store new address in LODNAM
JRST SETST2 ;[2404] Continue on
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
IOR T2,LSTLRV ;[2204] GET THE SECTION NUMBER TOO
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
IOR T2,LSTLRV ;[2204] GET THE SECTION NUMBER TOO
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 SEE HOW MUCH MEMORY WE NEED FOR THE FIXUP BLOCK, AND TO ALLOCATE IT.
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
; ..
; ..
;HERE TO READ IN AND COPY THE ENTIRE POLISH BLOCK INTO THE FX AREA, MAKING SOME
;BASIC CONSISTENCY CHECKS. THERE ARE SEVERAL MAJOR COMPLICATIONS HERE. IF PSECT
;INDEXES ARE USED ANYWHERE, THEN THERE MUST BE A PSECT INDEX AS THE FIRST
;HALFWORD TO SET THE POLISH BLOCK DEFAULT, AND THE PSECT USED FOR THE STORE
;OPERATOR. SUBSEQUENT PSECT INDEXES MAY ONLY OCCUR BEFORE THE VALUE OPERATORS
;(CODES 0 AND 1) TO WHICH THEY APPLY, AND THE INDEX ONLY APPLIES TO THAT VALUE.
;SINCE RB.1 RELOCATES ONLY FULLWORDS AT A TIME, WE DEPEND ON THE REQUIREMENT
;THAT A VALUE OPERATOR (NECESSARILY ABSOLUTE) FOLLOWS EACH PSECT INDEX. WE ALSO
;DEPEND ON THE REQUIREMENT THAT THE PSECT INDEX REVERTS BACK TO THE POLISH
;BLOCK'S DEFAULT AFTER EACH VALUE, AND THAT THE STORE OPERATOR IS ABSOLUTE. ALL
;OF THESE CONDITIONS ALLOW US TO SET THE RELOCATION COUNTER FOR THE NEXT POLISH
;WORD, BASED ON THE INFORMATION IN THE CURRENT WORD, WITHOUT MISSING ANY
;RELOCATABLE HALFWORDS.
;[2203] An additional complication is introduced by extended addressing.
;[2203] A halfword which is relocated can have a value of up to 30 bits.
;[2203] This will not fit back in the halfword allocated to the original
;[2203] 18 bit value. The solution is to store the section number in the
;[2203] previous halfword, where the operator is. This involves moving the
;[2203] operator information into the high order 6 bits of that halfword.
;[2203] The operators will be changed to a new form. For the halfword fetch
;[2203] operator, the high order bits will be set to 60. For store operators,
;[2203] the operator value will be negated. This value will be added to 60,
;[2203] and the result will be shifted into the high order six bits.
MOVE P2,T11BP ;[1224] BYTE POINTER WHICH WILL FIND STORE OP
SETZ P3, ;[1224] START BY READING THE FIRST HALFWORD
PUSHJ P,T11GN ;[1224] ..
PUSHJ P,E$$NSO ;[1224] NO STORE OPERATOR--CATCH-ALL MESSAGE
CAILE T1,MXPLOP ;[1224] IS THIS A PSECT INDEX?
CAIL T1,-STRLEN ;[1224] ..
JRST T11RD2 ;[1224] NO--ENTER MAIN LOOP
MOVEI P4,-400000(T1) ;[2207] YES--REMEMBER AS DEFAULT
CAMLE P4,RC.NO ;[1224] IS THE PSECT INDEX IN RANGE?
PUSHJ P,E$$IPX ;[1224] NO--DIE
MOVE R,P4 ;[1304] GET PSECT NUMBER IN R
HRRZ P4,@RC.MAP ;[1304] MAP TO INTERNAL PSECT NUMBER
MOVEM P4,RC.CUR ;[1224] DEFAULT APPLIES TO FIRST VALUE OP, IF ANY
T.11RD: PUSHJ P,T11SGN ;[1224] GET NEXT HALFWORD
PUSHJ P,E$$NSO ;[1224] NO MORE--FATAL HERE
T11RD2: JUMPE T1,T11OK1 ;[1224] IF HALFWORD VALUE OP, EAT 1 HALFWORD
CAIG T1,2 ;[1224] IF FULLWORD VALUE OP
JRST T11OK2 ;[1224] THEN EAT 2 HALFWORDS
CAIG T1,MXPLOP ;[1224] REGULAR OPERATOR?
JRST T.11RD ;[1224] YES--JUST SKIP IT
CAIL T1,-STRLEN ;[1224] STORE OPERATOR THEN?
JRST T11SOP ;[1224] YES--GO READ SYMBOL OR ADDR; THIS IS LOOP EXIT
MOVEI T2,-400000(T1) ;[2207] NO--MUST BE PSECT INDEX
SKIPE P4 ;[1224] ALLOWED TO USE PSECT INDEXES?
CAMLE T2,RC.NO ;[1224] AND A GOOD INDEX IF SO?
PUSHJ P,E$$IPX ;[1224] NO--DIE
MOVE R,T2 ;[1304] GET PSECT NUMBER IN R
HRRZ T2,@RC.MAP ;[1304] MAP TO INTERNAL PSECT NUMBER
MOVEM T2,RC.CUR ;[1245] YES--MAKE IT GOOD FOR NEXT OPERATOR
JRST T.11RD ;[1224] LOOP FOR MORE OPERATORS
T11OK2: PUSHJ P,T11SGN ;[1224] EAT FIRST HALF OF FULLWORD VALUE
PUSHJ P,E$$NSO ;[1224] NOT THERE--DIE
PUSHJ P,T11SGN ;[2203] EAT SECOND HALFWORD
PUSHJ P,E$$NSO ;[1224] NOT THERE--DIE
MOVEM P4,RC.CUR ;[1224] RESTORE DEFAULT PSECT INDEX SINCE VALUE DONE
JRST T.11RD ;[1224] LOOP FOR MORE OPERATORS
T11OK1: PUSHJ P,T11SGN ;[2203] Get the halfword value
PUSHJ P,E$$NSO ;[2203] Not there--die
MOVEM P4,RC.CUR ;[2203] Restore the default psect index
JUMPN P3,T11OKL ;[2203] Check for which halfword
;[2203] Here on a right half. The fetch operator is in the left half of
;[2203] W1. Change it to the new style, and put in the section number.
HLL W1,LSTRRV ;[2203] Get it's section number
TLO W1,600000 ;[2203] Remember it's a halfword new-style load
JRST T.11RD ;[2203] Loop for more operators
;[2203] Here on a left half. The fetch operator is in the right half of
;[2203] the previous word. The current word is pointed to by W2. Change
;[2203] it to the new style, and put in the section number.
T11OKL: HLR T1,LSTLRV ;[2203] Get it's section number
TRO T1,600000 ;[2203] Remember it's a halfword new-style load
HRRM T1,-1(W2) ;[2203] Put it in the previous word
JRST T.11RD ;[2203] Loop for more operators
E$$NSO::.ERR. (MS,.EC,V%L,L%F,S%F,NSO,<No store operator in polish block (type 11 or 1072)>) ;[2212]
.ETC. (JMP,,,,,.ETIMF##) ;[1224]
;HERE WHEN WE'VE FOUND THE STORE OPERATOR. IF IT'S AN ADDRESS, READ AND STORE
;IT. IF IT'S A SYMBOL STORE, THERE ARE POTENTIALLY TWO FULLWORDS FOR THE SYMBOL
;AND BLOCK NAME. MAKE SURE THAT IF WE GET THE FIRST HALF OF EITHER SYMBOL, WE
;GET THE SECOND HALF. ALSO THAT WE GET AT LEAST ONE SYMBOL. FINALLY, MAKE SURE
;THERE IS NO JUNK AT THE END OF THE REL BLOCK.
;[2203] change to the new-style store operator, so a 30 bit address will fit.
;[2203] Negate it, add 60, and shift it to the high six bits.
T11SOP: MOVN T2,T1 ;[2203] GET THE STORE OPERATOR
ADDI T2,60 ;[2203] PUT THE NUMBER IN THE RIGHT FORMAT
LSH T2,^D12 ;[2203] PUT IT IN THE HIGH BITS
SKIPE P3 ;[2203] CAME FROM THE LEFT HALF?
HRL W1,T2 ;[2203] YES, PUT IT BACK THERE
SKIPN P3 ;[2203] CAME FROM THE RIGHT HALF?
HRR W1,T2 ;[2203] YES, PUT IT BACK THERE
MOVE P1,P2 ;[1224] SAVE POINTER TO STORE OPERATOR
CAIL T1,-6 ;[1224] SYMBOL STORE OPERATOR?
CAILE T1,-4 ;[1224] ..
JRST T11SOA ;[1224] NO--ADDRESS THEN
PUSHJ P,T11SGN ;[1224] YES--READ THE SYMBOL BEING FIXED UP
PUSHJ P,E$$ISM ;[1224] THERE MUST BE AT LEAST ONE SYMBOL
PUSHJ P,T11SGN ;[1224] ..
PUSHJ P,E$$ISM ;[1224] ..
PUSHJ P,T11SGN ;[1224] LOOK FOR THE BLOCK NAME SYMBOL
JRST T.11CS ;[1224] NONE--THAT'S OK, AND WE'RE DONE
PUSH P,T1 ;[1224] THERE'S SOMETHING--SEE IF MORE
PUSHJ P,T11SGN ;[1224] ..
JRST [POP P,T2 ;[1224] WASN'T ANY MORE--MAKE SURE LAST
JUMPE T2,T.11CS ;[1224] HALFWORD WAS ZERO; IF SO, WE'RE DONE
PUSHJ P,E$$ISM] ;[1224] ELSE IT WAS JUNK
POP P,(P) ;[1224] UNWIND STACK
JRST T11EAT ;[1224] GO CHECK FOR POSSIBLE LAST HALFWORD
T11SOA: PUSHJ P,T11SGN ;[1224] READ THE STORE ADDRESS
PUSHJ P,E$$NAP ;[1224] THERE MUST BE ONE
JUMPN P3,T11SOL ;[2203] Check for which halfword
;[2203] Here on a right half. The store operator is in the left half of
;[2203] W1. The right half of LSTRRV contains the address (same as in W1)
;[2203] or zero. Put in the section number.
IOR W1,LSTRRV ;[2203] Put section into the store operator
JRST T11EAT ;[2203] Go check for possible last halfword
;[2203] Here on a left half. The fetch operator is in the right half of
;[2203] the previous word. The current word is pointed to by W2. Put
;[2203] in the section number.
T11SOL: HLRZ T1,LSTLRV ;[2203] Get the section number
IORM T1,-1(W2) ;[2203] Put it in the previous word
; JRST T11EAT ;[1224] GO CHECK FOR POSSIBLE LAST HALFWORD
;HERE WHEN ENTIRE POLISH BLOCK HAS BEEN READ, BUT THERE IS STILL THE POSSIBLIITY
;THAT THERE IS A LAST DANGLING HALFWORD TO READ. THIS MUST BE ZERO, AND IT MUST
;BE THE LAST HALFWORD IN THE POLISH BLOCK, OR WE COMPLAIN ABOUT JUNK IN THE
;BLOCK.
T11EAT: PUSHJ P,T11SGN ;[1224] LOOK FOR POSSIBLE RHS HALFWORD
JRST T.11CS ;[1224] NOT THERE--ALL'S WELL
JUMPN T1,E$$JPB ;[1224] MUST BE ZERO OR COMPLAIN ABOUT JUNK
PUSHJ P,T11ZGN ;[1224] WAS ZERO--MAKE SURE NO MORE AT ALL
JRST T.11CS ;[1224] NONE--ALL'S WELL
E$$JPB::.ERR. (MS,.EC,V%L,L%W,S%W,JPB,<Junk at end of polish block>) ;[1224]
.ETC. (JMP,,,,,.ETIMF##) ;[1224]
T11EA1: PUSHJ P,T11ZGN ;[1224] WE'VE COMPLAINED--EAT THE REST
JRST T.11CS ;[1224] DONE
JRST T11EA1 ;[1224] MORE--READ MORE JUNK
E$$IPX::.ERR. (MS,.EC,V%L,L%F,S%F,IPX,<Invalid psect index>) ;[1174]
.ETC. (JMP,,,,,.ETIMF##) ;[1174]
E$$ISM::.ERR. (MS,.EC,V%L,L%F,S%F,ISM,<Incomplete symbol in store operator in polish block (type 11 or 1072)>) ;[2212]
.ETC. (JMP,,,,,.ETIMF##) ;[1224]
E$$NAP::.ERR. (MS,.EC,V%L,L%F,S%F,NAP,<No store address in polish block (type 11 or 1072)>) ;[2212]
.ETC. (JMP,,,,,.ETIMF##) ;[1224]
;T11SGN - STORE POLISH HALFWORD AND GET NEXT ONE. THIS ROUTINE DE-BLOCKS THE
;FULL WORDS SUPPLIED BY RB.1 INTO HALFWORDS. P3 IS USED AS A FLAG TO TELL WHICH
;HALF OF THE CURRENT WORD TO RETURN, AND WHETHER IT'S TIME TO READ ANOTHER WORD.
;
; P3/ 0 AND CALL T11GN FOR FIRST BYTE
;
;THEN LEAVE P3 ALONE AND CALL T11SGN FOR SUBSEQUENT BYTES. GIVES SKIP RETURN
;UNLESS NO MORE HALFWORDS, THEN NON-SKIP RETURN.
T11SGN: JUMPN P3,T11GN1 ;[1224] JUST PROCESSED RHS?
MOVEM W1,(W2) ;[1224] YES--STORE OLD WORD NOW
ADDI W2,1 ;[1224] COUNT ANOTHER WORD STORED
T11GN: JUMPN P3,T11GN1 ;[1224] TIME TO READ A NEW WORD?
PUSHJ P,RB.1 ;[1224] YES--GET ONE
POPJ P, ;[1224] NO MORE--GIVE NON-SKIP RETURN
HLRZ T1,W1 ;[1224] FIRST TIME GIVE LHS
MOVEI P3,1 ;[1224] SIGNAL RHS FOR NEXT TIME
IBP P2 ;[1224] COUNT ANOTHER BYTE
JRST CPOPJ1 ;[1224] GIVE GOOD RETURN
T11GN1: HRRZ T1,W1 ;[1224] TIME FOR RHS
MOVEI P3,0 ;[1224] SIGNAL LHS FOR NEXT TIME
IBP P2 ;[1224] COUNT ANOTHER BYTE
JRST CPOPJ1 ;[1224] GIVE GOOD RETURN
;T11ZGN HAS THE SAME EFFECT AS T11SGN, EXCEPT THAT THE HALFWORD JUST PROCESSED
;IS ZEROED INSTEAD OF STORED IN THE FIXUP AREA. THIS IS ONLY USED TO CLEAN UP
;JUNK AT THE END OF A POLISH BLOCK, SO THERE IS NO NEED FOR SPEED.
T11ZGN: JUMPN P3,T11ZG1 ;[1224] JUST PROCESSED RHS?
HLLZS W1 ;[1224] YES--THEN CLEAR IT
PJRST T11SGN ;[1224] GO DO OTHER CHECKS
T11ZG1: HLLZS W1 ;[1224] JUST PROCESSED LHS--CLEAR IT
PJRST T11GN ;[1224] WON'T STORE THIS TIME
;HERE WHEN POLISH BLOCK HAS BEEN READ. WE MUST NOW LOOK MORE CLOSELY AT THE
;STORE OPERATOR TO SEE IF WE WANT THIS POLISH EXPRESSION. IF NOT, DELETE THE
;POLISH BLOCK AND RETURN. IF SO, SEE IF THE STORE IS TO A SYMBOL, AND CONVERT TO
;LSTSYM POINTER FORMAT (GLOBAL,,LOCAL) IF SO.
;
; P1/ BYTE POINTER TO STORE OPERATOR (LDB, NOT ILDB)
; W3/ BYTE POINTER TO GLOBAL COUNT, FOR FX AREA LATER
; (P)/ SAVED RELOCATION COUNTER FROM BEGINNING OF T.11
T.11CS: POP P,RC.CUR ;[1224] RESTORE RELOCATION COUNTER
MOVE W1,P1 ;[1224] GET BYTE POINTER TO STORE OPERATOR
ADD W1,FX.LB ;[1224] RELOCATE TO FX AREA
LDB T1,W1 ;[1224] GET BACK THE STORE OPERATOR
CAIG T1,667777 ;[2203] SYMBOL STORE OPERATOR?
CAIGE T1,640000 ;[2203] ..
JRST [ILDB W1,W1 ;NO, LOAD UP ADDRESS
TRZ T1,770000 ;[2203] GET THE SECTION NUMBER ONLY
HRL W1,T1 ;[2203] PUT IT IN THE 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
;HERE IF THE STORE OPERATOR IS A VALID SYMBOL FIXUP. THERE ARE AT MOST TWO
;SYMBOLS FOLLOWING. THE FIRST IS THE SYMBOL TO BE FIXED UP, AND THE SECOND (IF
;THERE) IS THE BLOCK NAME IT'S IN.
LSH T1,-^D12 ;[2203] GET BACK THE STORE OPERATOR
SUBI T1,63 ;[2203] GET THE SYMBOL FIXUP TYPE
MOVE T1, [ FS.FXR ;[2203] 3 RIGHT HALF
FS.FXL ;[2203] 4 LEFT HALF
FS.FXF](T1) ;[2203] 5 RIGHT HALF
PUSH P,T1 ;[2203] SAVE THE TYPE 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
MOVE W3,W2 ;[2255] BYTE POINTER IN W3
SUBI W1,2 ;BACKUP BYTE PTR
IBP W1 ;[2255] BY 3 HALFWORDS
ILDB W2,W1 ;[2255] GET THE STORE OPERATOR
HLRZ T1,LSTLCL ;[2255] GET THE LOCAL POINTER SECTION NUMBER
ADD T1,W2 ;[2255] ADD THE STORE OPERATOR
DPB T1,W1 ;[2255] PUT IT BACK
HRRZ W2,LSTLCL ;[2255] GET THE REST OF THE LOCAL POINTER
IDPB W2,W1 ;[2255] STORE IT NEXT
MOVE W2,LSTGBL ;[2255] GET THE GLOBAL POINTER
IDPB W2,W1 ;[2255] STORE IT TOO
ILDB T1,W1 ;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,600000 ;[2203] NEW FETCH OR STORE OP?
JRST T.11G1 ;[2203] NO, MUST BE PSECT INDEX
CAIL T1,610000 ;[2203] NEW STYLE STORE OPERATOR?
JRST T.11GE ;[2203] YES, GO TRY TO EVALUATE
JRST T.11G0] ;[2203] HALFWORD FETCH, IGNORE VALUE
CAIL T1,3 ;IF OPERATOR
JRST T.11G1 ;IGNORE IT
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
;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,610000 ;[2203] STORE OPERATOR?
JRST T.11ST ;YES
CAIL W1,600000 ;[2203] HALFWORD FETCH?
JRST T.11OP ;[2203] YES, IT'S AN OPERAND
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]
AOBJN W3,.+2 ;[1274] CHECK FOR OVERFLOW
PUSHJ P,T.11PL ;[1274] OVERFLOW-GO ENLARGE STACK
MOVEM W1,(W3) ;[1274] 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 ;[2212] SIZE REQUIRED
MOVEM T2,POLLEN ;[1274] STORE SIZE
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,
T.11PL::PUSH P,T1 ;[2212] SAVE THE TEMPORARY REGS
PUSH P,T2 ;[1274]
PUSH P,T3 ;[1274]
MOVE T2,POLLEN ;[1274] GET SIZE OF CURRENT STACK
ADDI T2,LN.PPD ;[1274] FIGURE SIZE OF NEW STACK
PUSHJ P,DY.GET## ;[1274] GET NEW STACK FROM DY AREA
MOVN T3,T2 ;[1274] MINUS NEW STACK LENGTH
HRLI T3,-1(T1) ;[1274] ADDR,,-LEN OF NEW STACK
EXCH T2,POLLEN ;[1274] STORE NEW STACK LENGTH
MOVEI W3,-1(T1) ;[1274] BUILD NEW STACK POINTER
ADDI W3,(T2) ;[1274] ADD POINTER TO LAST ITEM PUSHED
HRLI W3,-LN.PPD ;[1274] SET TO REMAINING STACK SPACE
AOS POLSTK ;[1274] POLSTK WAS AN IOWD
HRL T1,POLSTK ;[1274] FORM BLT POINTER
BLT T1,-1(W3) ;[1274] MOVE STACK TO NEW AREA
HRRZ T1,POLSTK ;[1274] GET ADDRESS OF OLD STACK AREA
MOVSM T3,POLSTK ;[1274] STORE -LEN,,ADDR OF STACK
PUSHJ P,DY.RET## ;[1274] GIVE BACK OLD STACK
POP P,T3 ;[1274] POP THE TEMPORARY REGISTERS
POP P,T2 ;[1274]
POP P,T1 ;[1274]
POPJ P, ;[1274] GO COMPLETE THE "PUSH"
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
CAIE T1,1 ;[2203] FULLWORD OPERAND?
JRST [ TRZ T1,770000 ;[2203] NO, HALFWORD - GET ONLY THE SECTION
HRL T2,T1 ;[2203] PUT IT INTO THE VALUE
JRST T.11P0] ;[2203] DON'T READ ANOTHER HALFWORD
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
AOBJN W3,.+2 ;[1274] CHECK FOR OVERFLOW
PUSHJ P,T.11PL ;[1274] OVERFLOW-GO ENLARGE STACK
MOVEM T2,(W3) ;[1274] SAVE VALUE
HRLI T1,400000 ;PUT IN A VALUE MARKER
AOBJN W3,.+2 ;[1274] CHECK FOR OVERFLOW
PUSHJ P,T.11PL ;[1274] OVERFLOW-GO ENLARGE STACK
MOVEM T1,(W3) ;[1274] SAVE VALUE MARKER
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,1,0,0 ;[2203]
;OPERATOR ACTION
OPTAB:: ADD T1,T2 ;[1754]
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
PUSHJ P,SKPOP ;25
PUSHJ P,SKEOP ;26
PUSHJ P,MOVOP ;27
MXPLOP==:.-OPTAB+3 ;[1754] 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 #
MOVE T2,LINKTB ;[2273] GET THE TABLE ADDRESS
JUMPGE W2,.+2 ;[2273] NEGATIVE (LNKEND)?
ADDI T2,LN.12 ;[2273] YES, COMES FROM SECOND HALF OF TABLE
MOVMS W2
SOJL W2,.+2 ;[2273]
CAIL W2,LN.12 ;[2273]
AOJA W2,E01IPO ;[2273] RANGE CHECK
SKIPE T1,LINKTB ;IF LINKTB NOT SET UP THEN LINK IS ZERO
MOVE T1,@T2 ;[2273] STORE IT
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,
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: MOVE P3,T2 ;[2203] Get the address
PUSHJ P,SGCHK.## ;[2203] Bring it into memory, relocate
MOVE T1,(P3) ;[2203] Get the word
POPJ P,
;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
HRL T2,W1 ;[2203] GET THE SECTION (IGNORED FOR SYMBOLS)
TLZ T2,770000 ;[2203] REMOVE HIGH ORDER BITS
LSH W1,-^D12 ;[2203] GET THE STORE OPERATOR (+60)
MOVE W3,-1(W3) ;GET THE VALUE AFTER IGNORING THE FLAG
PUSHJ P,@STRTAB-60(W1) ;[2203] CALL THE CORRECT FIXUP ROUTINE
;ALL DONE, NOW GIVE SPACE BACK
T.11RT::HRRZ T1,T11FA ;[2212] 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]
CPOPJ ;[2203] 0 NO-OP
T11CHR ;[2203] 1 RIGHT HALF FIXUP CHAIN
T11CHL ;[2203] 2 LEFT HALF FIXUP CHAIN
;**;[2324] Change 1 line at STRTAB+4. PAH 16-Jul-84
T11CHF ;[2324] 3 FULL WORD FIXUP CHAIN
T11SYR ;[2203] 4 RIGHT HALF SYMBOL FIXUP
T11SYL ;[2203] 5 LEFT HALF SYMBOL FIXUP
T11SYF ;[2203] 6 FULL WORD SYMBOL FIXUP
T11MVM ;[2203] 7 MOVEM
T11LNK ;[2203] 10 STORE LINK OR LINK END
;[2203] Note - The maximum length of this table is 20 octal. If
;[2203] it is desired to increase beyond 17, the base of the new
;[2203] style store and halfword fetch operators much be moved down
;[2203] from 60. The lower limit is caused by the psect indices,
;[2203] which go up from 40. If the base is changed here, it must
;[2203] also be changed in SYPF2 in LNKLOD.
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 ;[1754]
JRST SY.ASP ;AND DO FIXUP
T11SYL::MOVX W1,FS.FXL ;[1754]
JRST SY.ASP
T11SYF::MOVX W1,FS.FXF ;[1754]
; JRST SY.ASP ;
;HERE TO STORE SYMBOL TABLE FIXUP
SY.ASP::ILDB T1,W2 ;[2212] PICK UP GLOBAL POINTER
PUSH P,T1 ;[572] SAVE OVER GS.GET
PUSH P,T2 ;[2255] SAVE LOCAL POINTER TOO
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=LOCAL SYMBOL PTR
POP P,W2 ;[2255] W2=GLOBAL SYMBOL 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
T11LNK:
PUSH P,T2
SKIPN LINKTB ;[2203] LINK TABLE SETUP ?
PUSHJ P,T12GET ;SET UP LINK TABLE
POP P,W2 ;SPECIAL AC
HRRES W2 ;SIGN EXTEND
MOVE T2,LINKTB ;[2273] GET THE TABLE ADDRESS
JUMPGE W2,.+2 ;[2273] NEGATIVE (LNKEND)?
ADDI T2,LN.12 ;[2273] YES, GOES IN SECOND HALF OF TABLE
MOVMS W2
SOJL W2,.+2
CAIL W2,LN.12
AOJA W2,E01IPO ;[1174] RANGE CHECK
MOVEM W3,@T2 ;[2273] STORE IT
POPJ P,
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: TXO T2,CPF.RF ;[2201] NOT IN CORE
POP P,W3 ;VALUE
PJRST SY.CHP## ;PUT IN FIXUP LIST
;[1502] Here to preserve W2 over calls to the halfword chain routines,
;[1502] which would like it to contain a SIXBIT name to display if a
;[1502] value is being truncated.
T11CHR::PUSH P,W2 ;[2212] Save pointer to polish
SETZ W2, ;[1502] Clear it so that it doesn't
;[1502] look like a symbol for %LNKFTH
;**;[2324] Add two lines at T11CHR+3. PAH 16-Jul-84
SETZ P1, ;[2324] Clear leftover pointer so P1
;[2324] isn't treated as a fixup pointer
PUSHJ P,SY.CHR## ;[1502] Do the right half chained fixup
POP P,W2 ;[1502] Restore the pointer to the string
POPJ P, ;[1502] Return to the dispatcher
T11CHL::PUSH P,W2 ;[2212] Save pointer to polish
SETZ W2, ;[1502] Clear it so that it doesn't
;[1502] look like a symbol for %LNKFTH
;**;[2324] Add two lines at T11CHL+3. PAH 14-Jul-84
SETZ P1, ;[2324] Clear leftover pointer so P1
;[2324] isn't treated as a fixup pointer
PUSHJ P,SY.CHL## ;[1502] Do the left half chained fixup
POP P,W2 ;[1502] Restore the pointer to the string
POPJ P, ;[1502] Return to the dispatcher
;**;[2324] Add 7 lines at T11CHL+7. PAH 14-Jul-84
;[2324] Here to clear P1 before going to the fullword chained fixup
;[2324] routine -- that routine calls others which interpret a nonzero
;[2324] value in P1 as a fixup block pointer.
T11CHF::SETZ P1, ;[2324] Clear leftover pointer so P1
;[2324] isn't treated as a fixup pointer
PUSHJ P,SY.CHF## ;[2324] Do the fullword chained fixup
POPJ P, ;[2324] And return to the dispatcher
SUBTTL BLOCK TYPE 12 - LINK (FAIL)
; ----------------
; ! 12 ! COUNT !
; ----------------
; ! BYTE WORD !
; ----------------
; ! DATA WORDS !
; ----------------
T.12: SKIPN LINKTB ;[2203] LINK TABLE SETUP ?
PUSHJ P,T12GET ;[2203] NO, DO IT
JRST T.12A ;YES
T12GET: MOVEI T2,2*LN.12 ;[2273] 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,<2*LN.12>-1(T1) ;[2273] CLEAR ALL LINKS
POPJ P, ;[2203]
T.12A: PUSHJ P,RB.2 ;READ 2 WORDS
JRST LOAD##
HLRZ W3,W1 ;[2273] GET THE CHAIN ADDRESS
HLL W3,LSTLRV ;[2273] AS A 30 BIT ADDRESS
HLL W1,LSTRRV ;[2273] GET THE 30 BIT STORE ADDRESS
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 #
SKIPN W3 ;[2273] THIRD ARG SPECIFIED?
MOVE W3,W1 ;[2273] NO, DEFAULT TO SECOND ARG
MOVE T2,W1 ;[2273] 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
MOVEM W3,@LINKTB ;[2273] STORE NEW IN LINK TABLE
JRST T.12A ;BACK FOR MORE
;HERE IF THE OLD .LINK ADDRESS IS NO LONGER IN CORE.
T.12N: TXO T2,CPF.RR ;[2200] NOT IN CORE
EXCH W3,@LINKTB ;[2273] STORE NEW LINK, GET PREVIOUS
PUSHJ P,SY.CHP## ;PUT IN FIXUP LIST
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
MOVE T1,LINKTB ;[2273] GET THE TABLE BASE
ADDI T1,LN.12 ;[2273] GOES IN SECOND HALF OF TABLE
MOVEM W1,@T1 ;[2273] 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:
IFE TOPS20,<
SETZM DCBUF+2 ;READ NEXT BUFFER ON NEXT ILDB
> ;[1417]
IFN TOPS20,<
MOVEI T1,400000 ;[1417] COMPUTE BLOCKSIZE
SUBI T1,(WC) ;[1417]
MOVE T2,DCBUF+2 ;[1417] BUFFER COUNT
SUB T2,T1 ;[1417] SUBTRACT THIS BLOCK
MOVEM T2,DCBUF+2 ;[1417]
IBP T1,DCBUF+1 ;[1417] INCR BUFFER BYTEPOINTER
MOVEM T1,DCBUF+1 ;[1417] PAST THIS BLOCK
> ;[1417]
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
IFN TOPS20,<
NXTCHK: HRRZI T2,-1(T1) ; CONVERT BLOCK TO PAGE
; SUBTRACTING NONEXISTANT BLOCK 0
LSH T2,-2 ; PAGE #
CAILE W3,(T2) ; PAST END OF BUFFER?
> ;[1402] IFN TOPS20
IFE TOPS20,< CAIN W3,(T1) ;IN THIS BLOCK?
> ;[1402] IFE TOPS20
JRST THSBLK ;YES
IFE TOPS20,<
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
> ;[1402] IFE TOPS20
NXTBLK:
IFE TOPS20,<
IN DC,
JRST THSBLK ;[1101] IT IS NOW
JRST D.ERR## ;EOF OR ERROR
> ;[1402] IFE TOPS20
IFN TOPS20,<
EXCH T2,T1 ;[1402] T1:PAGE#,T2:BLOCK#
PUSHJ P,RDSKP## ;[1402] MOVE THE BUFFER
SKIPA ;[1402] ALL OK
JRST D.ERR## ;[1402] ERROR
EXCH T2,T1 ;[1402] T1:BLOCK#
; JRST THSBLK ;[1402]
> ;[1402] IFN TOPS20
;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:
IFE TOPS20,<
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
> ;[1402] IFE TOPS20
IFN TOPS20,<
HRRZI T2,-1(T1) ;[1402] BLOCK # - NONEXISTANT BLOCK 0
IDIVI T2,4 ;[1402] DIVIDE BY BLOCKS PER PAGE
IMULI T3,^D128 ;[1402] REMAINDER (BLOCKS) AS WORDS
SUB T2,LSTBLK ;[1402] REMOVE BUFFER ORIGIN
ADDI T2,<LN.BF_-9> ;[1402] ...
LSH T2,9 ;[1402] QUOTIENT (PAGES) AS WORDS
ADD T3,T2 ;[1402] ADD TO GET PARTIAL OFFSET
HLRZ T2,T1 ;[1402] OFFSET INTO BLOCK
CAIN T2,-1 ;[1402] IF OFFSET IS INDEX MARKER
SETZM T2 ;[1402] USE ZERO AS OFFSET
ADD T3,T2 ;[1402] + OFFSET INTO PAGE IS TOTAL OFFSET
> ;[1402] IFN TOPS20
HRRZ T2,DCBUF ;[1101] CONSTRUCT NEW BYTE POINTER
IFN TOPS20,<
ADD T2,T3 ;[1402] RH=RH(DCBUF)+TOTAL OFFSET-1
HLL T2,DCBUF+1 ;[1402]
TLNN T2,440000 ;[1402] CHECK BYTE BOUNDS FOR CORRECT COUNT
SOS T2 ;[1402]
> ;[1402] IFN TOPS20
IFE TOPS20,<
HLL T2,DCBUF+1 ;[1101] LH=LH(OLD BYTE PTR)
ADDI T2,1(T1) ;[1101] RH=RH(DCBUF)+OFFSET+1
> ;[1402] IFE TOPS20
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
IFN TOPS20,<
JUMPL T1,T.14I ;[1101] JUMP IF BLOCK CONTAINS AN INDEX
> ;[1402] IFN TOPS20
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
IFE TOPS20,<
JRST NXTNDX ;CHECK IF NEXT BUFFER IN CORE
> ;[1402] IFE TOPS20
IFN TOPS20,<
JRST NXTCHK ;CHECK IF ANOTHER PMAP NEEDED
> ;[1402] IFN TOPS20
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
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.
ADDB W3,RC.CV(R) ;[2205] BUMP RELOCATION COUNTER
CAML W3,RC.LM(R) ;[2205] CHECK AGAINST THE LIMIT
PUSHJ P,TOOBIG ;[2205] TOO BIG, GIVE A WARNING
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
SKIPGE MODTYP ;[2205] LOADING PSECTS?
MOVE R,RC.CUR ;[2205] YES
MOVE R,@RC.TB ;GET RC BLOCK
MOVE W3,RC.CV(R) ;[2205] CURRENT VALUE
;FALL INTO T.COMM
;T.COMM TESTS TO SEE IF COMMON ALREADY EXISTS
;IF SO CHECK SIZE
;IF NOT DEFINE (GLOBAL ONLY)
;[2205] Arguments:
;[2205] W1/ Size of common block
;[2205] W2/ Name of common block
;[2205] W3/ Origin of common block
;RETURNS
;+1 COMMON ALREADY DEFINED WITH CORRECT LENGTH
;+2 WAS NOT DEFINED, NOW IS
;THIS ROUTINE PRESERVES R
T.COMM::PUSH P,W1 ;[2205] SAVE SIZE
MOVX W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL ;[2205] SET THE FLAGS
PUSHJ P,TRYSYM## ;SEE IF IN TABLE
JRST T.20ND ;NOT IN TABLE
JRST T.20UN ;IN, BUT UNDEF (NOT COMMON)
POP P,W1 ;[2205] RESTORE THE COMMON BLOCK SIZE
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
CAMLE W1,2(T1) ;[2205] LESS THAN OR EQUAL TO WHAT WE HAVE?
JRST T.20ER ;NO, GIVE ERROR
MOVE W3,2(P1) ;[2230] Set starting address of common
MOVE T2,RC.AT(R) ;[2230] Get the primary flags again
TXNN T2,AT.NC ;[2230] Allowed to cross section boundaries?
POPJ P, ;[2230] Yes, doesn't matter where it is
MOVE T2,W3 ;[2230] Get the start address
XOR T2,RC.IV(R) ;[2230] Compare it with the current psect
TLNE T2,-1 ;[2230] Same section number?
JRST E$$CMP ;[2230] No, error
MOVE T2,W3 ;[2230] Get back the start address
ADD T2,W1 ;[2230] Add the length
SUBI T2,1 ;[2230] Minus 1 for last address
XOR T2,RC.IV(R) ;[2230] Compare it with the current psect
TLNN T2,-1 ;[2230] Same section number?
POPJ P, ;[2230] Yes, no problem here
E$$CMP::.ERR. (MS,.EC,V%L,L%F,S%C,CMP,<Common >) ;[2230]
.ETC. (SBX,.EC!.EP,,,,W2) ;[2230]
.ETC. (STR,.EC,,,,,< declared in multiple psects>) ;[2230]
.ETC. (JMP,,,,,.ETIMF##) ;[2230]
POPJ P, ;[2230] Return anyways
T.20ER: MOVE T2,2(T1) ;[2205] GET CURRENT SIZE
MOVE T1,W1 ;[2205] AND REQUESTED SIZE FOR ERROR MSG
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
MOVEM W3,2(T1) ;[2205] 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 AGAIN
POP P,.L+2(T1) ;[2205] 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) ;GET PRIMARY FLAGS
TXNE T1,PS.COM ;ALREADY DEFINED COMMON?
JRST E$$SNC ;[1174] SHOULD NOT HAPPEN
PUSHJ P,SY.CHK## ;SEE HOW LONG 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
POP P,.L+2(T1) ;[2205] AND COMMON LENGTH
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,T.21NS ;[2205] 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
IOR W1,LSTRRV ;[2205] SECTION NUMBER (IF ANY)
ADD W1,W2 ;[2205] PLUS VALUE OF SYMBOL
JRST T.21B ;[2205] AVOID THE NON-SYMBOL STUFF
T.21NS: HLRZ W3,W1 ;[2205] WORD COUNT
HRRZ W1,W1 ;ADDRESS ONLY
IOR W1,LSTRRV ;
T.21B: MOVE P3,W1 ;START ADDRESS
ADD W1,W3 ;HIGHEST NEEDED
PUSHJ P,T.1AD ;CHECK ADDRESS AND LOAD THIS SUB BLOCK
JRST T.0C ;[1776] THROW IT AWAY
JRST [ PUSHJ P,T.1LPJ
JRST .+2 ] ;[1776] DEFER IT
PUSHJ P,T.1DP ;[1776] LOAD IT
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.22E ;[1300] YES,
SOJG R1,T.22A ;NOT YET
SETZ W1, ;[763] ZERO ATTRIBUTES
T.22D: 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
HRRZ R1,@RC.MAP ;[1304] MAP TO INTERNAL NUMBER (IN CASE .HIGH.)
T.22B: MOVEM R1,RC.CUR ;SET FOR RELOCATION
JRST LOAD## ;FINISHED
T.22E: MOVE W1,RC.AT(T1) ;[1300] GET THE ATTRIBUTES
TXZN W1,AT.RP ;[1300] IS THE RELOCATABLE BIT SET?
JRST T.22B ;[1300] NO
MOVEM R1,RC.CUR ;[1300] SET FOR RELOCATION
SKIPE W3 ;[1300] DON'T SET UP FOR ZERO ADDRESS
PUSHJ P,.SET0## ;[1300] SET UP THE PSECT ADDRESSES
JRST LOAD## ;[1300] FINISHED
T.22C: MOVEI R,(W2) ;[2207] PSECT INDEX IS ONE LESS
CAIL R,0 ;[2207] CHECK FOR BELOW .LOW.
CAMLE R,RC.NO ;[1304] PSECT INDEX EXIST?
JRST E$$IPX ;[1304] NO, GIVE ERROR
HRRZ R,@RC.MAP ;[1304] GET INTERNAL PSECT NUMBER
MOVEM R,RC.CUR ;[1304] SWITCH CURRENT RELOC COUNTER TO IT
JRST LOAD## ;[1304]
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,(W1) ;[2207] PUT INTERNAL PSECT INDEX INTO R
TXNN W1,77B5 ;[1154] OLD STYLE (NAME IN SIXBIT)?
JRST [ HRRZ R,@RC.MAP;[1304] MAP TO INTERNAL PSECT INDEX
JRST T.23B ] ;[1304] 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] ..
HLLZ T1,LSTRRV ;[2244] GET THE SECTION NUMBER
ADD W1,T1 ;[2244] ADD IT
PUSHJ P,CHKSZ0 ;[1715] CHECK FOR PSECT TOO BIG
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: SKIPLE MODTYP ;[1306] TWOSEG SEEN IN MODULE?
PUSHJ P,E$$MPT ;[1306] YES, ERROR
SETOM MODTYP ;[1306] FLAG PSECTS SEEN
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,(W1) ;[2207] 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?
;[2222] Here to set up an index and insert a new psect if necessary.
;[2222] W1 / origin (if any)
;[2222] W2 / Symbol name
;[2222] W3 / Attributes
;[2222] P1 / User psect index
T.24B:: SKIPN RC.CUR ;[2233] ALREADY A DEFAULT PSECT?
AOS RC.CUR ;[2233] NO, SET .LOW. AS DEFAULT
MOVE R,RC.NO ;[2222] LOOP OVER ALL RC BLOCKS
T.24C: MOVE T1,@RC.TB ;[1304] RC BLOCK WHERE THIS PSECT MIGHT BE
MOVE T2,RC.NM(T1) ;[2222] GET THE NAME
PUSHJ P,NAMCMP## ;[2222] IS IT HERE?
CAIA ;[2222] YES
SOJG R,T.24C ;[2207] NO, LOOP OVER ALL PSECTS
JUMPE R,T.24D ;[2207] IF NOT FOUND, INSERT A NEW RC BLOCK
TXZ W3,AT.RP ;[1137] WE FOUND IT, SO ALREADY HAVE ORIGIN
;[2222] Here to check for psect conflicts
IOR W3,RC.AT(T1) ;[2222] Get combined attributes
TXC W3,AT.CN!AT.OV ;[2222] Check these bits
TXCE W3,AT.CN!AT.OV ;[2222] A conflict?
JRST T.24C1 ;[2222] No, check other attributes
TXZ W3,AT.CN!AT.OV ;[2222] Yes, don't modify them
PUSH P,T1 ;[2222] Save the psect index
PUSH P,T1 ;[2222] Save the psect index
E$$COE::.ERR. (MS,.EC,V%L,L%W,S%W,COE,<Both CONCATENATE and OVERLAY attributes specified for psect >) ;[2222]
.ETC. (SBX,.EC!.EP,,,,W2) ;[2222]
.ETC. (JMP,,,,,.ETIMF##) ;[2222]
POP P,T1 ;[2222] Restore the psect index
T.24C1: TXC W3,AT.RO!AT.RW ;[2222] Check these bits
TXCE W3,AT.RO!AT.RW ;[2222] A conflict?
JRST T.24C2 ;[2222] No
TXZ W3,AT.RO!AT.RW ;[2222] Yes, don't modify them
PUSH P,T1 ;[2222] Save the psect index
E$$RWA::.ERR. (MS,.EC,V%L,L%W,S%W,RWA,<Both READ-ONLY and WRITABLE attributes specified for psect >) ;[2222]
.ETC. (SBX,.EC!.EP,,,,W2) ;[2222]
.ETC. (JMP,,,,,.ETIMF##) ;[2222]
POP P,T1 ;[2222] Restore the psect index
T.24C2: IORB W3,RC.AT(T1) ;[1300] ACCUMULATE ATTRIBUTES
TXZN W3,AT.RP ;[1300] IS IT RELOCATABLE?
JRST T.24E ;[1300] NO MAKE SURE IT'S WHERE WE EXPECT IT
EXCH W1,W3 ;[1300] SET ACS FOR .SET0
PUSHJ P,.SET0## ;[1300] SET THE ADDRESS
JRST T.24E ;[1300]
T.24D: EXCH W1,W3 ;[1137] SET ACS FOR .SET0
PUSHJ P,.SET0## ;[1137] SET UP A NEW RC BLOCK
MOVE R,RC.NO ;[1304] ITS INDEX IS THE LAST PSECT
T.24E: CAILE P1,0 ;[2207] DISALLOW CHANGING BELOW .LOW.
CAMLE P1,RC.NO ;[1153] CATCH GARBAGE PSECT INDICES
JRST E01IPX ;[1174] INDEX IS JUNK, COMPLAIN
EXCH R,P1 ;[2207] RC.NO SLOT IN P1, RC.MAP SLOT IN R
HRRZM P1,@RC.MAP ;[2207] STORE IT
PUSHJ P,SETNH ;[2412] REMEMBER NEXT PSECT ABOVE & BELOW US
;[2412] AND GIVE WARNING IF WE ARE OVERLAPPING
JRST LOAD## ;ALL DONE
E$$MPT::.ERR. (MS,.EC,V%L,L%F,S%F,MPT,<Mixed psect and twoseg code in same module >) ;[1306]
.ETC. (JMP,,,,,.ETIMF##) ;[1306]
;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]
;[2412] ROUTINE TO SETUP RC.NH OF THIS PSECT TO POINT TO THE NEXT HIGHEST
;[2412] PSECT ABOVE US, AND POINT THE NEXT LOWER PSECT TO US.
;[2412] ALSO REPORTS OVERLAPPING WITH LOWER PSECTS.
;[2412] MOVEI P1,<OUR PSECT INDEX (=RC.NO)>
;[2412] PUSHJ P,SETNH
;[2412] RETURNS WITH OUR RC.NH SET TO THE NEXT HIGHER PSECT ABOVE US,
;[2412] AND THE NEXT LOWER PSECT'S RC.NH POINTING TO US.
SETNH: SPUSH <P2,W1> ;[2412] SAVE SOME STUFF
MOVE R,P1 ;[2412] GET OUR INDEX
MOVE T4,@RC.TB ;[2412] OUR RELOCATION TABLE POINTER
MOVE W1,RC.IV(T4) ;[2412] OUR ORG
SETO T1, ;[2412] INIT ORG OF NEXT LOWEST
HRLOI T2,377777 ;[2412] INIT ORG OF NEXT HIGHEST
SETZ P2, ;[2412] INIT RELOCATION POINTER OF NEXT LOWEST
SETNH0: SOJLE R,SETNHR ;[2412] GET NEXT LOWER INDEX
MOVE T3,@RC.TB ;[2412] ITS RELOCATION POINTER
CAMN T4,T3 ;[2414] JUST US IN TWICE FROM /REDIRECT?
JRST SETNH0 ;[2414] YES - JUST LOOK AT NEXT
CAMG W1,RC.IV(T3) ;[2412] ORG BELOW US?
JRST SETNHH ;[2412] NO - SEE IF CLOSEST ABOVE US
CAML W1,RC.HL(T3) ;[2412] YES - OUR ORG BELOW ITS TOP?
JRST SETNH1 ;[2412] NO - CONTINUE
SPUSH <T1,T2,T3,T4> ;[2412] YES - GET READY FOR MESSAGE
MOVE T1,RC.NM(T4) ;[2412] OUR PSECT NAME
MOVE T2,RC.NM(T3) ;[2412] NAME OF PSECT ABOUT TO BE OVERLAPPED
PUSHJ P,E$$POP ;[2412] GIVE THE WARNING
SPOP <T4,T3,T2,T1> ;[2412] RESTORE ACS
SETNH1: CAML T1,RC.IV(T3) ;[2412] HIGHER THAN ANY SO FAR?
JRST SETNH0 ;[2412] NO - DO NEXT
MOVE T1,RC.IV(T3) ;[2412] YES - MAKE IT THE HIGHEST BELOW US
MOVE P2,T3 ;[2412] AND REMEMBER ITS RELOCATION POINTER
JRST SETNH0 ;[2412] AND TEST NEXT
SETNHH: CAMG T2,RC.IV(T3) ;[2412] LOWEST ABOVE US SO FAR?
JRST SETNH0 ;[2412] NO - GO TEST NEXT
MOVE T2,RC.IV(T3) ;[2412] YES - MAKE IT THE LOWEST ABOVE US
MOVEM T3,RC.NH(T4) ;[2412] AND REMEMBER ITS RELOCATION PTR
JRST SETNH0 ;[2412] GO TEST NEXT RELOCATION TABLE
SETNHR: SKIPE P2 ;[2412] WAS THERE ONE BELOW US?
MOVEM T4,RC.NH(P2) ;[2412] YES - POINT HIGHEST BELOW US AT US
SPOP <W1,P2> ;[2412] RESTORE WHAT WE USED
POPJ P, ;[2412] RETURN
;[2412] ROUTINE TO REPORT A PSECT OVERLAP DETECTED WHEN LOADING CODE OR
;[2412] WHEN SETTING A PSECT ORG.
;[2412] CALL WITH T1/PSECT NAME1, T2/HIGHER PSECT NAME2,
;[2412] W1/ADDRESS OF OVERLAP
E$$POP::.ERR. (MS,.EC,V%L,L%W,S%W,POP,<Psect >) ;[2412]
.ETC. (SBX,.EC!.EP,,,,T1) ;[2412]
.ETC. (STR,.EC,,,,,< overlapping psect >);[2412]
.ETC. (SBX,.EC!.EP,,,,T2) ;[2412]
.ETC. (STR,.EC,,,,,< at address >) ;[1212]
.ETC. (OCT,.EP,,,,W1) ;[2412]
POPJ P, ;[2412] RETURN
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 E02FLE ;[2301] WILL DO FOR NOW
PUSHJ P,DVOPN.## ;OPEN DEVICE
LOOKUP TC,I.RIB(T1)
JRST E02FLE ;[2301] 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
E02FLE::PUSH P,IO.CHN ;[2301] REMEMBER WHAT # FAILED
.ERR. (LRE,,V%L,S%D,L%D,FLE) ;[2301]
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,.EC!.EP,,,,PRGNAM) ;[1303]
.ETC. (STR,.EC,,,,,< from file >) ;[1303]
.ETC. (FSP,,,,,DC) ;[1303]
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 LSTGBL ;[2255] NOT A REAL SYMBOL SO CLEAR
SETZM LSTLCL ;[2255] GLOBAL AND LOCAL POINTERS
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
SETZM LSTLRV ;[1466]
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?
PUSHJ P,R.ERR ;[2247] NO, CAN'T USE IT
TRNN FL,R.RED ;[2223] DOING /REDIRECT?
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
MOVEM T1,LSTLRV ;[1466]
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?
PUSHJ P,R.ERR ;[2247] NO, CAN'T USE IT
TRNN FL,R.RED ;[2223] DOING /REDIRECT?
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,
;[1000] R.CUR--ROUTINE TO RELOCATE ADDRESS IN T1 WITH RESPECT TO
; CURRENT PSECT. IF RC.CUR IS ZERO, THE ADDRESS IS RELOCATTED IN
; .LOW. OR .HIGH.
; ENTER WITH: T1/ADDR
; RETURN WITH: T1/ABS. ADDR.
; USES ACS: T1, T2, R
R.CUR:: SKIPE R,RC.CUR ;[1716] GET CURRENT PSECT, IF ANY
JRST R.CUR1 ;[1716] HAVE PSECT INDEX, GO USE IT
MOVEI R,1 ;[1716] THERE'S NONE, ASSUME PSECT 1 (.LOW.)
TRNN FL,R.TWSG ;IT'S ZERO, TWO SEGMENTS?
JRST R.CUR1 ;NO,
MOVE T2,SO.S2 ;YES, GET START OF HIGH SEGMENT
CAILE T2,NEGOFF(T1) ;IN HIGH SEG?
JRST R.CUR1 ;NO
MOVEI R,2 ;[1716] YES, USE .HIGH. PSECT
SUB T1,T2 ;REMOVE BASE ADDRESS
R.CUR1: MOVE R,@RC.TB ;PICKUP POINTER TO DATA BLOCK
MOVE T2,RC.CV(R) ;GET CURRENT VALUE
TLNN FL,R.RED ;[2223] DOING /REDIRECT?
SKIPE RC.CUR ;[2223] OR PSECTS?
CAIA ;[2223] YES, LEAVE IT ALONE
SUB T2,RC.IV(R) ;REMOVE BASE ADDRESS
SKIPGE RC.AT(R) ;[761] RELOCATABLE PSECT?
PUSHJ P,R.ERR ;[2247] YES, ERROR
ADD T1,T2 ;[1717] GET RELOCATED VALUE
MOVE T2,RC.SG(R) ;GET SEGMENT #
TLNN FL,R.RED ;[2372] DOING /REDIRECT?
SKIPE RC.CUR ;[2372] OR PSECTS?
CAIA ;[2372] YES SO LEAVE IT ALONE
ADD T1,LL.S0(T2) ;MAKE RELATIVE TO SEG ORIGIN
POPJ P, ;RETURN
R.ERR:: PUSH P,T1 ;[2247] Save a register
HRRZ T1,R ;[2247] Get the RC block pointer
CAMN T1,SG.TB+1 ;[2247] IS THIS .LOW.?
JRST R.LOW ;[2247] YES, GO SET IT RIGHT
MOVE T1,RC.NM(R) ;[2247] 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]
R.LOW: MOVX T1,AT.RP ;[2247] Get the relocatable attribute
ANDCAM T1,RC.AT(R) ;[2247] Clear the attribute
POP P,T1 ;[2247] Restore register
POPJ P, ;[2247] And return
;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 ;[1754] 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
>
OLDLIT: END