mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 01:19:17 +00:00
4881 lines
172 KiB
Plaintext
4881 lines
172 KiB
Plaintext
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 5-Feb-88
|
||
|
||
|
||
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
|
||
; ALL RIGHTS RESERVED.
|
||
;
|
||
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
|
||
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
|
||
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
|
||
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
|
||
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
|
||
;TRANSFERRED.
|
||
;
|
||
;
|
||
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
|
||
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
|
||
;CORPORATION.
|
||
;
|
||
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
|
||
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
|
||
|
||
|
||
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,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==2417 ;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.
|
||
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
|
||
JRST LOAD## ;AND SKIP THIS MODULE
|
||
|
||
INCCHK::HRRZ T1,INCPTR ;ANY /INCLUDES?
|
||
JUMPE T1,T6INC1 ;NO TEMPS, TRY PERMS
|
||
MOVEI T1,INCPTR ;SCAN INCLUDE TABLE
|
||
PUSHJ P,T.6SCN
|
||
JRST T6INC1 ;NOT IN TABLE
|
||
T6INC0: MOVSS INCPTR ;[563] REMOVE FROM BOTH SIDES OF LIST
|
||
JRST T6INC2
|
||
|
||
T6INC1: HLRZ T1,INCPTR ;SEE IF ANY PERMS
|
||
JUMPE T1,CPOPJ ;NO
|
||
MOVEI T1,EXCPTR ;MAKE SURE NOT IN EXCLUDE TABLE
|
||
PUSHJ P,T.6SCN ;AS IT MIGHT ALSO BE IN PERM INCLUDES
|
||
CAIA ;NO, CONTINUE SEARCH
|
||
POPJ P, ;YES, SO DON'T LOAD IT
|
||
MOVSS INCPTR ;SWAP PTR
|
||
MOVEI T1,INCPTR ;SCAN INCLUDE TABLE
|
||
PUSHJ P,T.6SCN
|
||
JRST [MOVSS INCPTR ;SWAP BACK
|
||
POPJ P,] ;NOT IN TABLE
|
||
T6INC2: MOVEI T1,INCPTR ;NOW REMOVE FROM LIST
|
||
PUSHJ P,EXCL.0## ;SO WE ONLY LOAD IT ONCE
|
||
MOVSS INCPTR ;PUT BACK
|
||
MOVEI T1,INCPTR ;NOW REMOVE FROM LIST
|
||
PUSHJ P,EXCL.0## ;SO WE ONLY LOAD IT ONCE
|
||
JRST CPOPJ1
|
||
T.6EXC: PUSHJ P,EXCCHK ;SEE IF EXCLUDED
|
||
JRST T.6POP ;YES, DON'T LOAD THIS
|
||
JRST T.6OK ;NOT EXCLUDED, GO LOAD
|
||
|
||
EXCCHK::HRRZ T1,EXCPTR ;SEE IF TEMP
|
||
JUMPE T1,T6EXC1 ;NO, TRY PERM
|
||
MOVEI T1,EXCPTR ;SEE IF IN EXCLUDE TABLE
|
||
PUSHJ P,T.6SCN
|
||
JRST T6EXC1 ;NO, LOAD IT
|
||
POPJ P, ;DON'T LOAD RETURN
|
||
|
||
T6EXC1: HLRZ T1,EXCPTR ;SEE IF TEMP
|
||
JUMPE T1,T6INC0 ;[563] NO, PURGE /INCLUDES & LOAD IT
|
||
MOVEI T1,INCPTR ;SEE IF IN LOCAL INCLUDES
|
||
PUSHJ P,T.6SCN ; BEFORE TRYING GLOB EXCLUDES
|
||
CAIA ;NO, SO CONTINUE SEARCH
|
||
JRST T6INC0 ;[563] YES, SO WE WANT IT
|
||
MOVSS EXCPTR ;SWAP
|
||
MOVEI T1,EXCPTR ;SEE IF IN EXCLUDE TABLE
|
||
PUSHJ P,T.6SCN
|
||
JRST [MOVSS EXCPTR ;PUT BACK
|
||
JRST T6INC0] ;[563] NO, LOAD IT
|
||
MOVSS EXCPTR ;SWAP BACK
|
||
POPJ P, ;DON'T LOAD RETURN
|
||
|
||
T.6SCN: HRRZ T1,(T1) ;GET POINTER
|
||
JUMPE T1,CPOPJ ;0 LINK IS END (OR NEVER STARTED)
|
||
ADD T1,[-.EXC+1,,1] ;FORM AOBJN POINTER
|
||
T6SCN1: SKIPN T2,(T1) ;NOT IN TABLE IF 0
|
||
POPJ P, ;FAIL RETURN
|
||
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
|